From 350adcb4b28481f4ae121a996c9f43dc019da18b Mon Sep 17 00:00:00 2001 From: blaise Date: Fri, 20 Jan 2012 16:59:47 +0000 Subject: starting from r20123 git-svn-id: http://svn.freepascal.org/svn/fpc/branches/blaise@20126 3ad0048d-3df7-0310-abae-a5850022a9f2 --- closures/compiler/COPYING.txt | 340 ++ closures/compiler/MPWMake | 1 + closures/compiler/Makefile | 3596 ++++++++++++ closures/compiler/Makefile.fpc | 789 +++ closures/compiler/README.txt | 63 + closures/compiler/aasmbase.pas | 435 ++ closures/compiler/aasmdata.pas | 525 ++ closures/compiler/aasmsym.pas | 71 + closures/compiler/aasmtai.pas | 2654 +++++++++ closures/compiler/aggas.pas | 1636 ++++++ closures/compiler/alpha/aasmcpu.pas | 281 + closures/compiler/alpha/agaxpgas.pas | 126 + closures/compiler/alpha/aoptcpu.pas | 38 + closures/compiler/alpha/aoptcpub.pas | 115 + closures/compiler/alpha/aoptcpuc.pas | 38 + closures/compiler/alpha/aoptcpud.pas | 39 + closures/compiler/alpha/cgcpu.pas | 167 + closures/compiler/alpha/cpubase.pas | 430 ++ closures/compiler/alpha/cpuinfo.pas | 68 + closures/compiler/alpha/cpunode.pas | 54 + closures/compiler/alpha/cpupara.pas | 290 + closures/compiler/alpha/cpupi.pas | 43 + closures/compiler/alpha/cputarg.pas | 51 + closures/compiler/alpha/radirect.pas | 0 closures/compiler/alpha/rasm.pas | 65 + closures/compiler/alpha/rgcpu.pas | 69 + closures/compiler/alpha/tgcpu.pas | 42 + closures/compiler/aopt.pas | 277 + closures/compiler/aoptbase.pas | 242 + closures/compiler/aoptcs.pas | 848 +++ closures/compiler/aoptda.pas | 165 + closures/compiler/aoptobj.pas | 1156 ++++ closures/compiler/arm/aasmcpu.pas | 2807 ++++++++++ closures/compiler/arm/agarmgas.pas | 326 ++ closures/compiler/arm/aoptcpu.pas | 343 ++ closures/compiler/arm/aoptcpub.pas | 120 + closures/compiler/arm/aoptcpuc.pas | 38 + closures/compiler/arm/aoptcpud.pas | 40 + closures/compiler/arm/armatt.inc | 208 + closures/compiler/arm/armatts.inc | 208 + closures/compiler/arm/armins.dat | 628 +++ closures/compiler/arm/armnop.inc | 2 + closures/compiler/arm/armop.inc | 208 + closures/compiler/arm/armreg.dat | 108 + closures/compiler/arm/armtab.inc | 745 +++ closures/compiler/arm/cgcpu.pas | 3709 +++++++++++++ closures/compiler/arm/cpubase.pas | 581 ++ closures/compiler/arm/cpuinfo.pas | 1034 ++++ closures/compiler/arm/cpunode.pas | 47 + closures/compiler/arm/cpupara.pas | 592 ++ closures/compiler/arm/cpupi.pas | 128 + closures/compiler/arm/cputarg.pas | 93 + closures/compiler/arm/itcpugas.pas | 93 + closures/compiler/arm/narmadd.pas | 434 ++ closures/compiler/arm/narmcal.pas | 74 + closures/compiler/arm/narmcnv.pas | 343 ++ closures/compiler/arm/narmcon.pas | 140 + closures/compiler/arm/narminl.pas | 337 ++ closures/compiler/arm/narmmat.pas | 357 ++ closures/compiler/arm/narmset.pas | 256 + closures/compiler/arm/pp.lpi.template | 90 + closures/compiler/arm/raarm.pas | 56 + closures/compiler/arm/raarmgas.pas | 1176 ++++ closures/compiler/arm/rarmcon.inc | 92 + closures/compiler/arm/rarmdwa.inc | 92 + closures/compiler/arm/rarmnor.inc | 2 + closures/compiler/arm/rarmnum.inc | 92 + closures/compiler/arm/rarmrni.inc | 92 + closures/compiler/arm/rarmsri.inc | 92 + closures/compiler/arm/rarmsta.inc | 92 + closures/compiler/arm/rarmstd.inc | 92 + closures/compiler/arm/rarmsup.inc | 92 + closures/compiler/arm/rgcpu.pas | 404 ++ closures/compiler/asmutils.pas | 131 + closures/compiler/assemble.pas | 1669 ++++++ closures/compiler/avr/aasmcpu.pas | 456 ++ closures/compiler/avr/agavrgas.pas | 216 + closures/compiler/avr/aoptcpu.pas | 100 + closures/compiler/avr/aoptcpub.pas | 120 + closures/compiler/avr/aoptcpud.pas | 40 + closures/compiler/avr/avrreg.dat | 41 + closures/compiler/avr/cgcpu.pas | 1752 ++++++ closures/compiler/avr/cpubase.pas | 474 ++ closures/compiler/avr/cpuinfo.pas | 226 + closures/compiler/avr/cpunode.pas | 43 + closures/compiler/avr/cpupara.pas | 527 ++ closures/compiler/avr/cpupi.pas | 73 + closures/compiler/avr/cputarg.pas | 70 + closures/compiler/avr/itcpugas.pas | 101 + closures/compiler/avr/navradd.pas | 251 + closures/compiler/avr/navrcnv.pas | 59 + closures/compiler/avr/navrmat.pas | 265 + closures/compiler/avr/raavr.pas | 52 + closures/compiler/avr/raavrgas.pas | 693 +++ closures/compiler/avr/ravrcon.inc | 34 + closures/compiler/avr/ravrdwa.inc | 34 + closures/compiler/avr/ravrnor.inc | 2 + closures/compiler/avr/ravrnum.inc | 34 + closures/compiler/avr/ravrrni.inc | 34 + closures/compiler/avr/ravrsri.inc | 34 + closures/compiler/avr/ravrsta.inc | 34 + closures/compiler/avr/ravrstd.inc | 34 + closures/compiler/avr/ravrsup.inc | 34 + closures/compiler/avr/rgcpu.pas | 169 + closures/compiler/browcol.pas | 2291 ++++++++ closures/compiler/bsdcompile | 3 + closures/compiler/catch.pas | 87 + closures/compiler/ccharset.pas | 294 + closures/compiler/cclasses.pas | 3035 ++++++++++ closures/compiler/cfidwarf.pas | 429 ++ closures/compiler/cfileutl.pas | 1301 +++++ closures/compiler/cg64f32.pas | 971 ++++ closures/compiler/cgbase.pas | 693 +++ closures/compiler/cgobj.pas | 4395 +++++++++++++++ closures/compiler/cgutils.pas | 248 + closures/compiler/cmsgs.pas | 475 ++ closures/compiler/comphook.pas | 408 ++ closures/compiler/compiler.pas | 372 ++ closures/compiler/compinnr.inc | 128 + closures/compiler/comprsrc.pas | 523 ++ closures/compiler/constexp.pas | 585 ++ closures/compiler/cp1251.pas | 282 + closures/compiler/cp1252.pp | 282 + closures/compiler/cp437.pas | 282 + closures/compiler/cp850.pas | 282 + closures/compiler/cp866.pas | 282 + closures/compiler/cp8859_1.pas | 282 + closures/compiler/cp8859_5.pas | 282 + closures/compiler/cpid.pas | 191 + closures/compiler/crefs.pas | 65 + closures/compiler/cresstr.pas | 323 ++ closures/compiler/cstreams.pas | 641 +++ closures/compiler/cutils.pas | 1363 +++++ closures/compiler/cwindirs.pp | 123 + closures/compiler/dbgbase.pas | 626 +++ closures/compiler/dbgdwarf.pas | 4139 ++++++++++++++ closures/compiler/dbgstabs.pas | 1732 ++++++ closures/compiler/defcmp.pas | 1942 +++++++ closures/compiler/defutil.pas | 1164 ++++ closures/compiler/export.pas | 269 + closures/compiler/expunix.pas | 189 + closures/compiler/finput.pas | 726 +++ closures/compiler/fmodule.pas | 1017 ++++ closures/compiler/fpccrc.pas | 76 + closures/compiler/fpcdefs.inc | 179 + closures/compiler/fppu.pas | 1732 ++++++ closures/compiler/gendef.pas | 163 + closures/compiler/generic/cpuinfo.pas | 51 + closures/compiler/globals.pas | 1549 ++++++ closures/compiler/globtype.pas | 563 ++ closures/compiler/html/i386/readme.txt | 5 + closures/compiler/html/powerpc/readme.txt | 5 + closures/compiler/htypechk.pas | 2968 ++++++++++ closures/compiler/i386/aopt386.pas | 119 + closures/compiler/i386/cgcpu.pas | 862 +++ closures/compiler/i386/cpubase.inc | 147 + closures/compiler/i386/cpuinfo.pas | 114 + closures/compiler/i386/cpunode.pas | 60 + closures/compiler/i386/cpupara.pas | 762 +++ closures/compiler/i386/cpupi.pas | 103 + closures/compiler/i386/cputarg.pas | 132 + closures/compiler/i386/csopt386.pas | 2255 ++++++++ closures/compiler/i386/daopt386.pas | 2816 ++++++++++ closures/compiler/i386/i386att.inc | 688 +++ closures/compiler/i386/i386atts.inc | 688 +++ closures/compiler/i386/i386int.inc | 688 +++ closures/compiler/i386/i386nop.inc | 2 + closures/compiler/i386/i386op.inc | 688 +++ closures/compiler/i386/i386prop.inc | 688 +++ closures/compiler/i386/i386tab.inc | 8438 ++++++++++++++++++++++++++++ closures/compiler/i386/n386add.pas | 448 ++ closures/compiler/i386/n386cal.pas | 120 + closures/compiler/i386/n386inl.pas | 42 + closures/compiler/i386/n386mat.pas | 473 ++ closures/compiler/i386/n386mem.pas | 98 + closures/compiler/i386/n386set.pas | 73 + closures/compiler/i386/popt386.pas | 2262 ++++++++ closures/compiler/i386/r386ari.inc | 73 + closures/compiler/i386/r386att.inc | 73 + closures/compiler/i386/r386con.inc | 73 + closures/compiler/i386/r386dwrf.inc | 73 + closures/compiler/i386/r386int.inc | 73 + closures/compiler/i386/r386iri.inc | 73 + closures/compiler/i386/r386nasm.inc | 73 + closures/compiler/i386/r386nor.inc | 2 + closures/compiler/i386/r386nri.inc | 73 + closures/compiler/i386/r386num.inc | 73 + closures/compiler/i386/r386op.inc | 73 + closures/compiler/i386/r386ot.inc | 73 + closures/compiler/i386/r386rni.inc | 73 + closures/compiler/i386/r386sri.inc | 73 + closures/compiler/i386/r386stab.inc | 73 + closures/compiler/i386/r386std.inc | 73 + closures/compiler/i386/ra386att.pas | 59 + closures/compiler/i386/ra386int.pas | 74 + closures/compiler/i386/rgcpu.pas | 71 + closures/compiler/i386/rropt386.pas | 371 ++ closures/compiler/ia64/aasmcpu.pas | 287 + closures/compiler/ia64/cpubase.pas | 149 + closures/compiler/ia64/cpuinfo.pas | 83 + closures/compiler/ia64/ia64reg.dat | 268 + closures/compiler/impdef.pas | 473 ++ closures/compiler/import.pas | 130 + closures/compiler/link.pas | 1398 +++++ closures/compiler/m68k/aasmcpu.pas | 579 ++ closures/compiler/m68k/ag68kgas.pas | 385 ++ closures/compiler/m68k/aoptcpu.pas | 41 + closures/compiler/m68k/aoptcpub.pas | 120 + closures/compiler/m68k/aoptcpud.pas | 36 + closures/compiler/m68k/cgcpu.pas | 1751 ++++++ closures/compiler/m68k/cpuasm.pas | 26 + closures/compiler/m68k/cpubase.pas | 520 ++ closures/compiler/m68k/cpuinfo.pas | 87 + closures/compiler/m68k/cpunode.pas | 52 + closures/compiler/m68k/cpupara.pas | 599 ++ closures/compiler/m68k/cpupi.pas | 41 + closures/compiler/m68k/cputarg.pas | 61 + closures/compiler/m68k/itcpugas.pas | 138 + closures/compiler/m68k/m68kreg.dat | 44 + closures/compiler/m68k/n68kadd.pas | 546 ++ closures/compiler/m68k/n68kcal.pas | 86 + closures/compiler/m68k/n68kcnv.pas | 257 + closures/compiler/m68k/n68kmat.pas | 361 ++ closures/compiler/m68k/r68kcon.inc | 35 + closures/compiler/m68k/r68kgas.inc | 35 + closures/compiler/m68k/r68kgri.inc | 35 + closures/compiler/m68k/r68knor.inc | 2 + closures/compiler/m68k/r68knum.inc | 35 + closures/compiler/m68k/r68krni.inc | 35 + closures/compiler/m68k/r68ksri.inc | 35 + closures/compiler/m68k/r68ksta.inc | 35 + closures/compiler/m68k/r68kstd.inc | 35 + closures/compiler/m68k/r68ksup.inc | 35 + closures/compiler/m68k/ra68k.pas | 371 ++ closures/compiler/m68k/ra68kmot.pas | 1835 +++++++ closures/compiler/m68k/rgcpu.pas | 40 + closures/compiler/macho.pas | 2103 +++++++ closures/compiler/machoutils.pas | 1466 +++++ closures/compiler/mips/aasmcpu.pas | 449 ++ closures/compiler/mips/aoptcpu.pas | 41 + closures/compiler/mips/aoptcpub.pas | 119 + closures/compiler/mips/aoptcpud.pas | 36 + closures/compiler/mips/cgcpu.pas | 1980 +++++++ closures/compiler/mips/cpubase.pas | 397 ++ closures/compiler/mips/cpugas.pas | 265 + closures/compiler/mips/cpuinfo.pas | 79 + closures/compiler/mips/cpunode.pas | 41 + closures/compiler/mips/cpupara.pas | 371 ++ closures/compiler/mips/cpupi.pas | 76 + closures/compiler/mips/cputarg.pas | 53 + closures/compiler/mips/itcpugas.pas | 101 + closures/compiler/mips/mipsreg.dat | 83 + closures/compiler/mips/ncpuadd.pas | 598 ++ closures/compiler/mips/ncpucall.pas | 62 + closures/compiler/mips/ncpucnv.pas | 286 + closures/compiler/mips/ncpuinln.pas | 138 + closures/compiler/mips/ncpumat.pas | 302 + closures/compiler/mips/ncpuset.pas | 130 + closures/compiler/mips/opcode.inc | 241 + closures/compiler/mips/rgcpu.pas | 165 + closures/compiler/mips/rmipscon.inc | 75 + closures/compiler/mips/rmipsdwf.inc | 75 + closures/compiler/mips/rmipsgas.inc | 75 + closures/compiler/mips/rmipsgri.inc | 75 + closures/compiler/mips/rmipsgss.inc | 75 + closures/compiler/mips/rmipsnor.inc | 2 + closures/compiler/mips/rmipsnum.inc | 75 + closures/compiler/mips/rmipsrni.inc | 75 + closures/compiler/mips/rmipssri.inc | 75 + closures/compiler/mips/rmipssta.inc | 75 + closures/compiler/mips/rmipsstd.inc | 75 + closures/compiler/mips/rmipssup.inc | 75 + closures/compiler/mips/strinst.inc | 241 + closures/compiler/msg/errorct.msg | 2357 ++++++++ closures/compiler/msg/errord.msg | 3417 ++++++++++++ closures/compiler/msg/errorda.msg | 2501 +++++++++ closures/compiler/msg/errordu.msg | 3418 ++++++++++++ closures/compiler/msg/errore.msg | 3445 ++++++++++++ closures/compiler/msg/errores.msg | 2375 ++++++++ closures/compiler/msg/errorf.msg | 1899 +++++++ closures/compiler/msg/errorfi.msg | 2517 +++++++++ closures/compiler/msg/errorhe.msg | 2708 +++++++++ closures/compiler/msg/errorheu.msg | 2708 +++++++++ closures/compiler/msg/errorid.msg | 2715 +++++++++ closures/compiler/msg/erroriu.msg | 3048 +++++++++++ closures/compiler/msg/errorn.msg | 2372 ++++++++ closures/compiler/msg/errorpl.msg | 2385 ++++++++ closures/compiler/msg/errorpli.msg | 2385 ++++++++ closures/compiler/msg/errorpt.msg | 3447 ++++++++++++ closures/compiler/msg/errorptu.msg | 3447 ++++++++++++ closures/compiler/msg/errorr.msg | 2832 ++++++++++ closures/compiler/msg/errorru.msg | 2832 ++++++++++ closures/compiler/msg/errorues.msg | 2369 ++++++++ closures/compiler/msgidx.inc | 926 ++++ closures/compiler/msgtxt.inc | 1453 +++++ closures/compiler/nadd.pas | 3070 +++++++++++ closures/compiler/nbas.pas | 1130 ++++ closures/compiler/ncal.pas | 3888 +++++++++++++ closures/compiler/ncgadd.pas | 854 +++ closures/compiler/ncgbas.pas | 558 ++ closures/compiler/ncgcal.pas | 976 ++++ closures/compiler/ncgcnv.pas | 760 +++ closures/compiler/ncgcon.pas | 493 ++ closures/compiler/ncgflw.pas | 1662 ++++++ closures/compiler/ncginl.pas | 835 +++ closures/compiler/ncgld.pas | 1286 +++++ closures/compiler/ncgmat.pas | 519 ++ closures/compiler/ncgmem.pas | 1005 ++++ closures/compiler/ncgobjc.pas | 102 + closures/compiler/ncgopt.pas | 188 + closures/compiler/ncgrtti.pas | 1244 +++++ closures/compiler/ncgset.pas | 879 +++ closures/compiler/ncgutil.pas | 3252 +++++++++++ closures/compiler/ncnv.pas | 3703 +++++++++++++ closures/compiler/ncon.pas | 1314 +++++ closures/compiler/nflw.pas | 2144 ++++++++ closures/compiler/ninl.pas | 3375 ++++++++++++ closures/compiler/nld.pas | 1269 +++++ closures/compiler/nmat.pas | 1131 ++++ closures/compiler/nmem.pas | 1099 ++++ closures/compiler/nobj.pas | 1593 ++++++ closures/compiler/nobjc.pas | 169 + closures/compiler/node.pas | 1301 +++++ closures/compiler/nopt.pas | 394 ++ closures/compiler/nset.pas | 1015 ++++ closures/compiler/nstate.pas | 123 + closures/compiler/nutils.pas | 1222 +++++ closures/compiler/objcdef.pas | 653 +++ closures/compiler/objcgutl.pas | 1625 ++++++ closures/compiler/objcutil.pas | 291 + closures/compiler/ogbase.pas | 2862 ++++++++++ closures/compiler/ogcoff.pas | 3158 +++++++++++ closures/compiler/ogelf.pas | 1318 +++++ closures/compiler/oglx.pas | 394 ++ closures/compiler/ogmacho.pas | 1223 +++++ closures/compiler/ogmap.pas | 162 + closures/compiler/ognlm.pas | 1521 ++++++ closures/compiler/optbase.pas | 216 + closures/compiler/optcse.pas | 335 ++ closures/compiler/optdead.pas | 424 ++ closures/compiler/optdfa.pas | 616 +++ closures/compiler/options.pas | 2958 ++++++++++ closures/compiler/optloop.pas | 487 ++ closures/compiler/opttail.pas | 212 + closures/compiler/optutils.pas | 327 ++ closures/compiler/optvirt.pas | 1181 ++++ closures/compiler/owar.pas | 522 ++ closures/compiler/owbase.pas | 304 ++ closures/compiler/parabase.pas | 372 ++ closures/compiler/paramgr.pas | 484 ++ closures/compiler/parser.pas | 529 ++ closures/compiler/pass_1.pas | 253 + closures/compiler/pass_2.pas | 234 + closures/compiler/pbase.pas | 379 ++ closures/compiler/pdecl.pas | 874 +++ closures/compiler/pdecobj.pas | 1281 +++++ closures/compiler/pdecsub.pas | 3388 ++++++++++++ closures/compiler/pdecvar.pas | 1864 +++++++ closures/compiler/pexports.pas | 249 + closures/compiler/pexpr.pas | 3430 ++++++++++++ closures/compiler/pgenutil.pas | 558 ++ closures/compiler/pinline.pas | 784 +++ closures/compiler/pmodules.pas | 2523 +++++++++ closures/compiler/powerpc/agppcmpw.pas | 1248 +++++ closures/compiler/powerpc/agppcvasm.pas | 406 ++ closures/compiler/powerpc/aoptcpu.pas | 535 ++ closures/compiler/powerpc/aoptcpub.pas | 121 + closures/compiler/powerpc/aoptcpuc.pas | 40 + closures/compiler/powerpc/aoptcpud.pas | 40 + closures/compiler/powerpc/cgcpu.pas | 1820 ++++++ closures/compiler/powerpc/cpubase.pas | 575 ++ closures/compiler/powerpc/cpuinfo.pas | 88 + closures/compiler/powerpc/cpunode.pas | 51 + closures/compiler/powerpc/cpupara.pas | 709 +++ closures/compiler/powerpc/cpupi.pas | 207 + closures/compiler/powerpc/cputarg.pas | 99 + closures/compiler/powerpc/itcpugas.pas | 151 + closures/compiler/powerpc/nppcadd.pas | 965 ++++ closures/compiler/powerpc/nppccal.pas | 147 + closures/compiler/powerpc/nppccnv.pas | 231 + closures/compiler/powerpc/nppcmat.pas | 721 +++ closures/compiler/powerpc/ppcins.dat | 68 + closures/compiler/powerpc/ppcreg.dat | 120 + closures/compiler/powerpc/rappc.pas | 41 + closures/compiler/powerpc/rappcgas.pas | 799 +++ closures/compiler/powerpc/rppccon.inc | 111 + closures/compiler/powerpc/rppcdwrf.inc | 111 + closures/compiler/powerpc/rppcgas.inc | 111 + closures/compiler/powerpc/rppcgri.inc | 111 + closures/compiler/powerpc/rppcgss.inc | 111 + closures/compiler/powerpc/rppcmot.inc | 111 + closures/compiler/powerpc/rppcmri.inc | 111 + closures/compiler/powerpc/rppcnor.inc | 2 + closures/compiler/powerpc/rppcnum.inc | 111 + closures/compiler/powerpc/rppcrni.inc | 111 + closures/compiler/powerpc/rppcsri.inc | 111 + closures/compiler/powerpc/rppcstab.inc | 111 + closures/compiler/powerpc/rppcstd.inc | 111 + closures/compiler/powerpc/rppcsup.inc | 111 + closures/compiler/powerpc64/aoptcpu.pas | 41 + closures/compiler/powerpc64/aoptcpub.pas | 123 + closures/compiler/powerpc64/aoptcpuc.pas | 40 + closures/compiler/powerpc64/aoptcpud.pas | 40 + closures/compiler/powerpc64/cgcpu.pas | 2199 ++++++++ closures/compiler/powerpc64/cpubase.pas | 572 ++ closures/compiler/powerpc64/cpuinfo.pas | 82 + closures/compiler/powerpc64/cpunode.pas | 52 + closures/compiler/powerpc64/cpupara.pas | 526 ++ closures/compiler/powerpc64/cpupi.pas | 130 + closures/compiler/powerpc64/cputarg.pas | 83 + closures/compiler/powerpc64/itcpugas.pas | 160 + closures/compiler/powerpc64/nppcadd.pas | 360 ++ closures/compiler/powerpc64/nppccal.pas | 63 + closures/compiler/powerpc64/nppccnv.pas | 235 + closures/compiler/powerpc64/nppcld.pas | 62 + closures/compiler/powerpc64/nppcmat.pas | 446 ++ closures/compiler/powerpc64/ppcins.dat | 75 + closures/compiler/powerpc64/ppcreg.dat | 143 + closures/compiler/powerpc64/rappc.pas | 42 + closures/compiler/powerpc64/rappcgas.pas | 799 +++ closures/compiler/powerpc64/rppccon.inc | 111 + closures/compiler/powerpc64/rppcdwrf.inc | 111 + closures/compiler/powerpc64/rppcgas.inc | 111 + closures/compiler/powerpc64/rppcgri.inc | 111 + closures/compiler/powerpc64/rppcgss.inc | 111 + closures/compiler/powerpc64/rppcmot.inc | 111 + closures/compiler/powerpc64/rppcmri.inc | 111 + closures/compiler/powerpc64/rppcnor.inc | 2 + closures/compiler/powerpc64/rppcnum.inc | 111 + closures/compiler/powerpc64/rppcrni.inc | 111 + closures/compiler/powerpc64/rppcsri.inc | 111 + closures/compiler/powerpc64/rppcstab.inc | 111 + closures/compiler/powerpc64/rppcstd.inc | 111 + closures/compiler/powerpc64/rppcsup.inc | 111 + closures/compiler/pp.lpi | 86 + closures/compiler/pp.pas | 229 + closures/compiler/ppc.cfg | 40 + closures/compiler/ppc.conf | 39 + closures/compiler/ppc.dof | 95 + closures/compiler/ppc68k.lpi | 79 + closures/compiler/ppcarm.lpi | 93 + closures/compiler/ppcavr.lpi | 84 + closures/compiler/ppcgen/aasmcpu.pas | 602 ++ closures/compiler/ppcgen/agppcgas.pas | 456 ++ closures/compiler/ppcgen/cgppc.pas | 962 ++++ closures/compiler/ppcgen/ngppcadd.pas | 543 ++ closures/compiler/ppcgen/ngppccnv.pas | 208 + closures/compiler/ppcgen/ngppcinl.pas | 237 + closures/compiler/ppcgen/ngppcset.pas | 243 + closures/compiler/ppcgen/rgcpu.pas | 200 + closures/compiler/ppcmipsel.lpi | 95 + closures/compiler/ppcppc.lpi | 79 + closures/compiler/ppcsparc.lpi | 79 + closures/compiler/ppheap.pas | 147 + closures/compiler/ppu.pas | 1373 +++++ closures/compiler/ppx86_64.lpi | 82 + closures/compiler/procinfo.pas | 292 + closures/compiler/pstatmnt.pas | 1397 +++++ closures/compiler/psub.pas | 2073 +++++++ closures/compiler/psystem.pas | 625 +++ closures/compiler/ptconst.pas | 1570 ++++++ closures/compiler/ptype.pas | 1590 ++++++ closures/compiler/raatt.pas | 1645 ++++++ closures/compiler/rabase.pas | 107 + closures/compiler/rasm.pas | 68 + closures/compiler/rautils.pas | 1640 ++++++ closures/compiler/regvars.pas | 666 +++ closures/compiler/rescmn.pas | 59 + closures/compiler/rgbase.pas | 80 + closures/compiler/rgobj.pas | 2162 ++++++++ closures/compiler/scandir.pas | 1542 ++++++ closures/compiler/scanner.pas | 4734 ++++++++++++++++ closures/compiler/script.pas | 526 ++ closures/compiler/sparc/aasmcpu.pas | 318 ++ closures/compiler/sparc/aoptcpu.pas | 41 + closures/compiler/sparc/aoptcpub.pas | 120 + closures/compiler/sparc/aoptcpud.pas | 36 + closures/compiler/sparc/cgcpu.pas | 1598 ++++++ closures/compiler/sparc/cpubase.pas | 455 ++ closures/compiler/sparc/cpugas.pas | 237 + closures/compiler/sparc/cpuinfo.pas | 89 + closures/compiler/sparc/cpunode.pas | 38 + closures/compiler/sparc/cpupara.pas | 357 ++ closures/compiler/sparc/cpupi.pas | 76 + closures/compiler/sparc/cputarg.pas | 76 + closures/compiler/sparc/itcpugas.pas | 98 + closures/compiler/sparc/ncpuadd.pas | 376 ++ closures/compiler/sparc/ncpucall.pas | 56 + closures/compiler/sparc/ncpucnv.pas | 336 ++ closures/compiler/sparc/ncpuinln.pas | 143 + closures/compiler/sparc/ncpumat.pas | 332 ++ closures/compiler/sparc/ncpuset.pas | 126 + closures/compiler/sparc/opcode.inc | 75 + closures/compiler/sparc/racpu.pas | 54 + closures/compiler/sparc/racpugas.pas | 688 +++ closures/compiler/sparc/rgcpu.pas | 164 + closures/compiler/sparc/rspcon.inc | 140 + closures/compiler/sparc/rspdwrf.inc | 140 + closures/compiler/sparc/rspnor.inc | 2 + closures/compiler/sparc/rspnum.inc | 140 + closures/compiler/sparc/rsprni.inc | 140 + closures/compiler/sparc/rspsri.inc | 140 + closures/compiler/sparc/rspstab.inc | 140 + closures/compiler/sparc/rspstd.inc | 140 + closures/compiler/sparc/rspsup.inc | 140 + closures/compiler/sparc/spreg.dat | 173 + closures/compiler/sparc/strinst.inc | 72 + closures/compiler/switches.pas | 369 ++ closures/compiler/symbase.pas | 441 ++ closures/compiler/symconst.pas | 660 +++ closures/compiler/symdef.pas | 5947 ++++++++++++++++++++ closures/compiler/symnot.pas | 63 + closures/compiler/symsym.pas | 2109 +++++++ closures/compiler/symtable.pas | 3217 +++++++++++ closures/compiler/symtype.pas | 1034 ++++ closures/compiler/symutil.pas | 97 + closures/compiler/systems.inc | 216 + closures/compiler/systems.pas | 872 +++ closures/compiler/systems/i_amiga.pas | 167 + closures/compiler/systems/i_atari.pas | 91 + closures/compiler/systems/i_beos.pas | 114 + closures/compiler/systems/i_bsd.pas | 858 +++ closures/compiler/systems/i_embed.pas | 235 + closures/compiler/systems/i_emx.pas | 118 + closures/compiler/systems/i_gba.pas | 102 + closures/compiler/systems/i_go32v2.pas | 101 + closures/compiler/systems/i_haiku.pas | 113 + closures/compiler/systems/i_linux.pas | 909 +++ closures/compiler/systems/i_macos.pas | 100 + closures/compiler/systems/i_morph.pas | 101 + closures/compiler/systems/i_nativent.pas | 106 + closures/compiler/systems/i_nds.pas | 102 + closures/compiler/systems/i_nwl.pas | 101 + closures/compiler/systems/i_nwm.pas | 101 + closures/compiler/systems/i_os2.pas | 118 + closures/compiler/systems/i_palmos.pas | 189 + closures/compiler/systems/i_sunos.pas | 245 + closures/compiler/systems/i_symbian.pas | 174 + closures/compiler/systems/i_watcom.pas | 101 + closures/compiler/systems/i_wdosx.pas | 103 + closures/compiler/systems/i_wii.pas | 101 + closures/compiler/systems/i_win.pas | 320 ++ closures/compiler/systems/mac_crea.txt | 71 + closures/compiler/systems/t_amiga.pas | 273 + closures/compiler/systems/t_atari.pas | 43 + closures/compiler/systems/t_beos.pas | 500 ++ closures/compiler/systems/t_bsd.pas | 855 +++ closures/compiler/systems/t_embed.pas | 910 +++ closures/compiler/systems/t_emx.pas | 531 ++ closures/compiler/systems/t_gba.pas | 632 +++ closures/compiler/systems/t_go32v2.pas | 407 ++ closures/compiler/systems/t_haiku.pas | 500 ++ closures/compiler/systems/t_linux.pas | 1188 ++++ closures/compiler/systems/t_macos.pas | 255 + closures/compiler/systems/t_morph.pas | 260 + closures/compiler/systems/t_nativent.pas | 94 + closures/compiler/systems/t_nds.pas | 780 +++ closures/compiler/systems/t_nwl.pas | 631 +++ closures/compiler/systems/t_nwm.pas | 988 ++++ closures/compiler/systems/t_os2.pas | 556 ++ closures/compiler/systems/t_palmos.pas | 218 + closures/compiler/systems/t_sunos.pas | 666 +++ closures/compiler/systems/t_symbian.pas | 199 + closures/compiler/systems/t_watcom.pas | 179 + closures/compiler/systems/t_wdosx.pas | 84 + closures/compiler/systems/t_wii.pas | 597 ++ closures/compiler/systems/t_win.pas | 1882 +++++++ closures/compiler/tgobj.pas | 663 +++ closures/compiler/tokens.pas | 651 +++ closures/compiler/utils/Makefile | 2469 +++++++++ closures/compiler/utils/Makefile.fpc | 93 + closures/compiler/utils/README.txt | 20 + closures/compiler/utils/dummyas.pp | 112 + closures/compiler/utils/fixlog.pp | 174 + closures/compiler/utils/fixmsg.pp | 66 + closures/compiler/utils/fixnasm.pp | 76 + closures/compiler/utils/fixtab.pp | 367 ++ closures/compiler/utils/fpc.mpw | 2 + closures/compiler/utils/fpc.pp | 267 + closures/compiler/utils/fpcsubst.pp | 243 + closures/compiler/utils/fpimpdef.pp | 92 + closures/compiler/utils/gia64reg.pp | 14 + closures/compiler/utils/gppc386.pp | 195 + closures/compiler/utils/mk68kreg.pp | 308 ++ closures/compiler/utils/mkarmins.pp | 404 ++ closures/compiler/utils/mkarmreg.pp | 276 + closures/compiler/utils/mkavrreg.pp | 272 + closures/compiler/utils/mkmpsreg.pp | 318 ++ closures/compiler/utils/mkppcreg.pp | 370 ++ closures/compiler/utils/mkspreg.pp | 275 + closures/compiler/utils/mkx86ins.pp | 442 ++ closures/compiler/utils/mkx86reg.pp | 443 ++ closures/compiler/utils/msg2inc.pp | 823 +++ closures/compiler/utils/msgdif.pp | 529 ++ closures/compiler/utils/msgused.pl | 42 + closures/compiler/utils/ppudump.pp | 3034 ++++++++++ closures/compiler/utils/ppufiles.pp | 246 + closures/compiler/utils/ppumove.pp | 651 +++ closures/compiler/utils/samplecfg | 101 + closures/compiler/utils/usubst.pp | 109 + closures/compiler/verbose.pas | 987 ++++ closures/compiler/version.pas | 96 + closures/compiler/vis/aasmcpu.pas | 248 + closures/compiler/vis/cpubase.pas | 608 +++ closures/compiler/vis/cpuinfo.pas | 56 + closures/compiler/vis/cpunode.pas | 47 + closures/compiler/vis/cpupara.pas | 74 + closures/compiler/widestr.pas | 326 ++ closures/compiler/wpo.pas | 79 + closures/compiler/wpobase.pas | 829 +++ closures/compiler/wpoinfo.pas | 329 ++ closures/compiler/x86/aasmcpu.pas | 2626 +++++++++ closures/compiler/x86/agx86att.pas | 437 ++ closures/compiler/x86/agx86int.pas | 1018 ++++ closures/compiler/x86/agx86nsm.pas | 1145 ++++ closures/compiler/x86/cga.pas | 132 + closures/compiler/x86/cgx86.pas | 2299 ++++++++ closures/compiler/x86/cpubase.pas | 511 ++ closures/compiler/x86/itcpugas.pas | 167 + closures/compiler/x86/itx86int.pas | 97 + closures/compiler/x86/nx86add.pas | 1080 ++++ closures/compiler/x86/nx86cnv.pas | 378 ++ closures/compiler/x86/nx86con.pas | 90 + closures/compiler/x86/nx86inl.pas | 534 ++ closures/compiler/x86/nx86mat.pas | 309 ++ closures/compiler/x86/nx86mem.pas | 108 + closures/compiler/x86/nx86set.pas | 649 +++ closures/compiler/x86/rax86.pas | 782 +++ closures/compiler/x86/rax86att.pas | 920 ++++ closures/compiler/x86/rax86int.pas | 2238 ++++++++ closures/compiler/x86/rgx86.pas | 413 ++ closures/compiler/x86/x86ins.dat | 3439 ++++++++++++ closures/compiler/x86/x86reg.dat | 140 + closures/compiler/x86_64/aoptcpu.pas | 41 + closures/compiler/x86_64/aoptcpub.pas | 120 + closures/compiler/x86_64/aoptcpud.pas | 36 + closures/compiler/x86_64/cgcpu.pas | 368 ++ closures/compiler/x86_64/cpubase.inc | 134 + closures/compiler/x86_64/cpuinfo.pas | 103 + closures/compiler/x86_64/cpunode.pas | 63 + closures/compiler/x86_64/cpupara.pas | 1251 +++++ closures/compiler/x86_64/cpupi.pas | 166 + closures/compiler/x86_64/cputarg.pas | 94 + closures/compiler/x86_64/nx64add.pas | 126 + closures/compiler/x86_64/nx64cal.pas | 82 + closures/compiler/x86_64/nx64cnv.pas | 175 + closures/compiler/x86_64/nx64flw.pas | 559 ++ closures/compiler/x86_64/nx64inl.pas | 42 + closures/compiler/x86_64/nx64mat.pas | 213 + closures/compiler/x86_64/r8664ari.inc | 126 + closures/compiler/x86_64/r8664att.inc | 126 + closures/compiler/x86_64/r8664con.inc | 126 + closures/compiler/x86_64/r8664dwrf.inc | 126 + closures/compiler/x86_64/r8664int.inc | 126 + closures/compiler/x86_64/r8664iri.inc | 126 + closures/compiler/x86_64/r8664nor.inc | 2 + closures/compiler/x86_64/r8664num.inc | 126 + closures/compiler/x86_64/r8664op.inc | 126 + closures/compiler/x86_64/r8664ot.inc | 126 + closures/compiler/x86_64/r8664rni.inc | 126 + closures/compiler/x86_64/r8664sri.inc | 126 + closures/compiler/x86_64/r8664stab.inc | 126 + closures/compiler/x86_64/r8664std.inc | 126 + closures/compiler/x86_64/rax64att.pas | 243 + closures/compiler/x86_64/rax64int.pas | 70 + closures/compiler/x86_64/rgcpu.pas | 53 + closures/compiler/x86_64/win64unw.pas | 408 ++ closures/compiler/x86_64/x8664ats.inc | 688 +++ closures/compiler/x86_64/x8664att.inc | 688 +++ closures/compiler/x86_64/x8664int.inc | 688 +++ closures/compiler/x86_64/x8664nop.inc | 2 + closures/compiler/x86_64/x8664op.inc | 688 +++ closures/compiler/x86_64/x8664pro.inc | 688 +++ closures/compiler/x86_64/x8664tab.inc | 8508 +++++++++++++++++++++++++++++ 674 files changed, 404058 insertions(+) create mode 100644 closures/compiler/COPYING.txt create mode 100644 closures/compiler/MPWMake create mode 100644 closures/compiler/Makefile create mode 100644 closures/compiler/Makefile.fpc create mode 100644 closures/compiler/README.txt create mode 100644 closures/compiler/aasmbase.pas create mode 100644 closures/compiler/aasmdata.pas create mode 100644 closures/compiler/aasmsym.pas create mode 100644 closures/compiler/aasmtai.pas create mode 100644 closures/compiler/aggas.pas create mode 100644 closures/compiler/alpha/aasmcpu.pas create mode 100644 closures/compiler/alpha/agaxpgas.pas create mode 100644 closures/compiler/alpha/aoptcpu.pas create mode 100644 closures/compiler/alpha/aoptcpub.pas create mode 100644 closures/compiler/alpha/aoptcpuc.pas create mode 100644 closures/compiler/alpha/aoptcpud.pas create mode 100644 closures/compiler/alpha/cgcpu.pas create mode 100644 closures/compiler/alpha/cpubase.pas create mode 100644 closures/compiler/alpha/cpuinfo.pas create mode 100644 closures/compiler/alpha/cpunode.pas create mode 100644 closures/compiler/alpha/cpupara.pas create mode 100644 closures/compiler/alpha/cpupi.pas create mode 100644 closures/compiler/alpha/cputarg.pas create mode 100644 closures/compiler/alpha/radirect.pas create mode 100644 closures/compiler/alpha/rasm.pas create mode 100644 closures/compiler/alpha/rgcpu.pas create mode 100644 closures/compiler/alpha/tgcpu.pas create mode 100644 closures/compiler/aopt.pas create mode 100644 closures/compiler/aoptbase.pas create mode 100644 closures/compiler/aoptcs.pas create mode 100644 closures/compiler/aoptda.pas create mode 100644 closures/compiler/aoptobj.pas create mode 100644 closures/compiler/arm/aasmcpu.pas create mode 100644 closures/compiler/arm/agarmgas.pas create mode 100644 closures/compiler/arm/aoptcpu.pas create mode 100644 closures/compiler/arm/aoptcpub.pas create mode 100644 closures/compiler/arm/aoptcpuc.pas create mode 100644 closures/compiler/arm/aoptcpud.pas create mode 100644 closures/compiler/arm/armatt.inc create mode 100644 closures/compiler/arm/armatts.inc create mode 100644 closures/compiler/arm/armins.dat create mode 100644 closures/compiler/arm/armnop.inc create mode 100644 closures/compiler/arm/armop.inc create mode 100644 closures/compiler/arm/armreg.dat create mode 100644 closures/compiler/arm/armtab.inc create mode 100644 closures/compiler/arm/cgcpu.pas create mode 100644 closures/compiler/arm/cpubase.pas create mode 100644 closures/compiler/arm/cpuinfo.pas create mode 100644 closures/compiler/arm/cpunode.pas create mode 100644 closures/compiler/arm/cpupara.pas create mode 100644 closures/compiler/arm/cpupi.pas create mode 100644 closures/compiler/arm/cputarg.pas create mode 100644 closures/compiler/arm/itcpugas.pas create mode 100644 closures/compiler/arm/narmadd.pas create mode 100644 closures/compiler/arm/narmcal.pas create mode 100644 closures/compiler/arm/narmcnv.pas create mode 100644 closures/compiler/arm/narmcon.pas create mode 100644 closures/compiler/arm/narminl.pas create mode 100644 closures/compiler/arm/narmmat.pas create mode 100644 closures/compiler/arm/narmset.pas create mode 100644 closures/compiler/arm/pp.lpi.template create mode 100644 closures/compiler/arm/raarm.pas create mode 100644 closures/compiler/arm/raarmgas.pas create mode 100644 closures/compiler/arm/rarmcon.inc create mode 100644 closures/compiler/arm/rarmdwa.inc create mode 100644 closures/compiler/arm/rarmnor.inc create mode 100644 closures/compiler/arm/rarmnum.inc create mode 100644 closures/compiler/arm/rarmrni.inc create mode 100644 closures/compiler/arm/rarmsri.inc create mode 100644 closures/compiler/arm/rarmsta.inc create mode 100644 closures/compiler/arm/rarmstd.inc create mode 100644 closures/compiler/arm/rarmsup.inc create mode 100644 closures/compiler/arm/rgcpu.pas create mode 100644 closures/compiler/asmutils.pas create mode 100644 closures/compiler/assemble.pas create mode 100644 closures/compiler/avr/aasmcpu.pas create mode 100644 closures/compiler/avr/agavrgas.pas create mode 100644 closures/compiler/avr/aoptcpu.pas create mode 100644 closures/compiler/avr/aoptcpub.pas create mode 100644 closures/compiler/avr/aoptcpud.pas create mode 100644 closures/compiler/avr/avrreg.dat create mode 100644 closures/compiler/avr/cgcpu.pas create mode 100644 closures/compiler/avr/cpubase.pas create mode 100644 closures/compiler/avr/cpuinfo.pas create mode 100644 closures/compiler/avr/cpunode.pas create mode 100644 closures/compiler/avr/cpupara.pas create mode 100644 closures/compiler/avr/cpupi.pas create mode 100644 closures/compiler/avr/cputarg.pas create mode 100644 closures/compiler/avr/itcpugas.pas create mode 100644 closures/compiler/avr/navradd.pas create mode 100644 closures/compiler/avr/navrcnv.pas create mode 100644 closures/compiler/avr/navrmat.pas create mode 100644 closures/compiler/avr/raavr.pas create mode 100644 closures/compiler/avr/raavrgas.pas create mode 100644 closures/compiler/avr/ravrcon.inc create mode 100644 closures/compiler/avr/ravrdwa.inc create mode 100644 closures/compiler/avr/ravrnor.inc create mode 100644 closures/compiler/avr/ravrnum.inc create mode 100644 closures/compiler/avr/ravrrni.inc create mode 100644 closures/compiler/avr/ravrsri.inc create mode 100644 closures/compiler/avr/ravrsta.inc create mode 100644 closures/compiler/avr/ravrstd.inc create mode 100644 closures/compiler/avr/ravrsup.inc create mode 100644 closures/compiler/avr/rgcpu.pas create mode 100644 closures/compiler/browcol.pas create mode 100644 closures/compiler/bsdcompile create mode 100644 closures/compiler/catch.pas create mode 100644 closures/compiler/ccharset.pas create mode 100644 closures/compiler/cclasses.pas create mode 100644 closures/compiler/cfidwarf.pas create mode 100644 closures/compiler/cfileutl.pas create mode 100644 closures/compiler/cg64f32.pas create mode 100644 closures/compiler/cgbase.pas create mode 100644 closures/compiler/cgobj.pas create mode 100644 closures/compiler/cgutils.pas create mode 100644 closures/compiler/cmsgs.pas create mode 100644 closures/compiler/comphook.pas create mode 100644 closures/compiler/compiler.pas create mode 100644 closures/compiler/compinnr.inc create mode 100644 closures/compiler/comprsrc.pas create mode 100644 closures/compiler/constexp.pas create mode 100644 closures/compiler/cp1251.pas create mode 100644 closures/compiler/cp1252.pp create mode 100644 closures/compiler/cp437.pas create mode 100644 closures/compiler/cp850.pas create mode 100644 closures/compiler/cp866.pas create mode 100644 closures/compiler/cp8859_1.pas create mode 100644 closures/compiler/cp8859_5.pas create mode 100644 closures/compiler/cpid.pas create mode 100644 closures/compiler/crefs.pas create mode 100644 closures/compiler/cresstr.pas create mode 100644 closures/compiler/cstreams.pas create mode 100644 closures/compiler/cutils.pas create mode 100644 closures/compiler/cwindirs.pp create mode 100644 closures/compiler/dbgbase.pas create mode 100644 closures/compiler/dbgdwarf.pas create mode 100644 closures/compiler/dbgstabs.pas create mode 100644 closures/compiler/defcmp.pas create mode 100644 closures/compiler/defutil.pas create mode 100644 closures/compiler/export.pas create mode 100644 closures/compiler/expunix.pas create mode 100644 closures/compiler/finput.pas create mode 100644 closures/compiler/fmodule.pas create mode 100644 closures/compiler/fpccrc.pas create mode 100644 closures/compiler/fpcdefs.inc create mode 100644 closures/compiler/fppu.pas create mode 100644 closures/compiler/gendef.pas create mode 100644 closures/compiler/generic/cpuinfo.pas create mode 100644 closures/compiler/globals.pas create mode 100644 closures/compiler/globtype.pas create mode 100644 closures/compiler/html/i386/readme.txt create mode 100644 closures/compiler/html/powerpc/readme.txt create mode 100644 closures/compiler/htypechk.pas create mode 100644 closures/compiler/i386/aopt386.pas create mode 100644 closures/compiler/i386/cgcpu.pas create mode 100644 closures/compiler/i386/cpubase.inc create mode 100644 closures/compiler/i386/cpuinfo.pas create mode 100644 closures/compiler/i386/cpunode.pas create mode 100644 closures/compiler/i386/cpupara.pas create mode 100644 closures/compiler/i386/cpupi.pas create mode 100644 closures/compiler/i386/cputarg.pas create mode 100644 closures/compiler/i386/csopt386.pas create mode 100644 closures/compiler/i386/daopt386.pas create mode 100644 closures/compiler/i386/i386att.inc create mode 100644 closures/compiler/i386/i386atts.inc create mode 100644 closures/compiler/i386/i386int.inc create mode 100644 closures/compiler/i386/i386nop.inc create mode 100644 closures/compiler/i386/i386op.inc create mode 100644 closures/compiler/i386/i386prop.inc create mode 100644 closures/compiler/i386/i386tab.inc create mode 100644 closures/compiler/i386/n386add.pas create mode 100644 closures/compiler/i386/n386cal.pas create mode 100644 closures/compiler/i386/n386inl.pas create mode 100644 closures/compiler/i386/n386mat.pas create mode 100644 closures/compiler/i386/n386mem.pas create mode 100644 closures/compiler/i386/n386set.pas create mode 100644 closures/compiler/i386/popt386.pas create mode 100644 closures/compiler/i386/r386ari.inc create mode 100644 closures/compiler/i386/r386att.inc create mode 100644 closures/compiler/i386/r386con.inc create mode 100644 closures/compiler/i386/r386dwrf.inc create mode 100644 closures/compiler/i386/r386int.inc create mode 100644 closures/compiler/i386/r386iri.inc create mode 100644 closures/compiler/i386/r386nasm.inc create mode 100644 closures/compiler/i386/r386nor.inc create mode 100644 closures/compiler/i386/r386nri.inc create mode 100644 closures/compiler/i386/r386num.inc create mode 100644 closures/compiler/i386/r386op.inc create mode 100644 closures/compiler/i386/r386ot.inc create mode 100644 closures/compiler/i386/r386rni.inc create mode 100644 closures/compiler/i386/r386sri.inc create mode 100644 closures/compiler/i386/r386stab.inc create mode 100644 closures/compiler/i386/r386std.inc create mode 100644 closures/compiler/i386/ra386att.pas create mode 100644 closures/compiler/i386/ra386int.pas create mode 100644 closures/compiler/i386/rgcpu.pas create mode 100644 closures/compiler/i386/rropt386.pas create mode 100644 closures/compiler/ia64/aasmcpu.pas create mode 100644 closures/compiler/ia64/cpubase.pas create mode 100644 closures/compiler/ia64/cpuinfo.pas create mode 100644 closures/compiler/ia64/ia64reg.dat create mode 100644 closures/compiler/impdef.pas create mode 100644 closures/compiler/import.pas create mode 100644 closures/compiler/link.pas create mode 100644 closures/compiler/m68k/aasmcpu.pas create mode 100644 closures/compiler/m68k/ag68kgas.pas create mode 100644 closures/compiler/m68k/aoptcpu.pas create mode 100644 closures/compiler/m68k/aoptcpub.pas create mode 100644 closures/compiler/m68k/aoptcpud.pas create mode 100644 closures/compiler/m68k/cgcpu.pas create mode 100644 closures/compiler/m68k/cpuasm.pas create mode 100644 closures/compiler/m68k/cpubase.pas create mode 100644 closures/compiler/m68k/cpuinfo.pas create mode 100644 closures/compiler/m68k/cpunode.pas create mode 100644 closures/compiler/m68k/cpupara.pas create mode 100644 closures/compiler/m68k/cpupi.pas create mode 100644 closures/compiler/m68k/cputarg.pas create mode 100644 closures/compiler/m68k/itcpugas.pas create mode 100644 closures/compiler/m68k/m68kreg.dat create mode 100644 closures/compiler/m68k/n68kadd.pas create mode 100644 closures/compiler/m68k/n68kcal.pas create mode 100644 closures/compiler/m68k/n68kcnv.pas create mode 100644 closures/compiler/m68k/n68kmat.pas create mode 100644 closures/compiler/m68k/r68kcon.inc create mode 100644 closures/compiler/m68k/r68kgas.inc create mode 100644 closures/compiler/m68k/r68kgri.inc create mode 100644 closures/compiler/m68k/r68knor.inc create mode 100644 closures/compiler/m68k/r68knum.inc create mode 100644 closures/compiler/m68k/r68krni.inc create mode 100644 closures/compiler/m68k/r68ksri.inc create mode 100644 closures/compiler/m68k/r68ksta.inc create mode 100644 closures/compiler/m68k/r68kstd.inc create mode 100644 closures/compiler/m68k/r68ksup.inc create mode 100644 closures/compiler/m68k/ra68k.pas create mode 100644 closures/compiler/m68k/ra68kmot.pas create mode 100644 closures/compiler/m68k/rgcpu.pas create mode 100644 closures/compiler/macho.pas create mode 100644 closures/compiler/machoutils.pas create mode 100644 closures/compiler/mips/aasmcpu.pas create mode 100644 closures/compiler/mips/aoptcpu.pas create mode 100644 closures/compiler/mips/aoptcpub.pas create mode 100644 closures/compiler/mips/aoptcpud.pas create mode 100644 closures/compiler/mips/cgcpu.pas create mode 100644 closures/compiler/mips/cpubase.pas create mode 100644 closures/compiler/mips/cpugas.pas create mode 100644 closures/compiler/mips/cpuinfo.pas create mode 100644 closures/compiler/mips/cpunode.pas create mode 100644 closures/compiler/mips/cpupara.pas create mode 100644 closures/compiler/mips/cpupi.pas create mode 100644 closures/compiler/mips/cputarg.pas create mode 100644 closures/compiler/mips/itcpugas.pas create mode 100644 closures/compiler/mips/mipsreg.dat create mode 100644 closures/compiler/mips/ncpuadd.pas create mode 100644 closures/compiler/mips/ncpucall.pas create mode 100644 closures/compiler/mips/ncpucnv.pas create mode 100644 closures/compiler/mips/ncpuinln.pas create mode 100644 closures/compiler/mips/ncpumat.pas create mode 100644 closures/compiler/mips/ncpuset.pas create mode 100644 closures/compiler/mips/opcode.inc create mode 100644 closures/compiler/mips/rgcpu.pas create mode 100644 closures/compiler/mips/rmipscon.inc create mode 100644 closures/compiler/mips/rmipsdwf.inc create mode 100644 closures/compiler/mips/rmipsgas.inc create mode 100644 closures/compiler/mips/rmipsgri.inc create mode 100644 closures/compiler/mips/rmipsgss.inc create mode 100644 closures/compiler/mips/rmipsnor.inc create mode 100644 closures/compiler/mips/rmipsnum.inc create mode 100644 closures/compiler/mips/rmipsrni.inc create mode 100644 closures/compiler/mips/rmipssri.inc create mode 100644 closures/compiler/mips/rmipssta.inc create mode 100644 closures/compiler/mips/rmipsstd.inc create mode 100644 closures/compiler/mips/rmipssup.inc create mode 100644 closures/compiler/mips/strinst.inc create mode 100644 closures/compiler/msg/errorct.msg create mode 100644 closures/compiler/msg/errord.msg create mode 100644 closures/compiler/msg/errorda.msg create mode 100644 closures/compiler/msg/errordu.msg create mode 100644 closures/compiler/msg/errore.msg create mode 100644 closures/compiler/msg/errores.msg create mode 100644 closures/compiler/msg/errorf.msg create mode 100644 closures/compiler/msg/errorfi.msg create mode 100644 closures/compiler/msg/errorhe.msg create mode 100644 closures/compiler/msg/errorheu.msg create mode 100644 closures/compiler/msg/errorid.msg create mode 100644 closures/compiler/msg/erroriu.msg create mode 100644 closures/compiler/msg/errorn.msg create mode 100644 closures/compiler/msg/errorpl.msg create mode 100644 closures/compiler/msg/errorpli.msg create mode 100644 closures/compiler/msg/errorpt.msg create mode 100644 closures/compiler/msg/errorptu.msg create mode 100644 closures/compiler/msg/errorr.msg create mode 100644 closures/compiler/msg/errorru.msg create mode 100644 closures/compiler/msg/errorues.msg create mode 100644 closures/compiler/msgidx.inc create mode 100644 closures/compiler/msgtxt.inc create mode 100644 closures/compiler/nadd.pas create mode 100644 closures/compiler/nbas.pas create mode 100644 closures/compiler/ncal.pas create mode 100644 closures/compiler/ncgadd.pas create mode 100644 closures/compiler/ncgbas.pas create mode 100644 closures/compiler/ncgcal.pas create mode 100644 closures/compiler/ncgcnv.pas create mode 100644 closures/compiler/ncgcon.pas create mode 100644 closures/compiler/ncgflw.pas create mode 100644 closures/compiler/ncginl.pas create mode 100644 closures/compiler/ncgld.pas create mode 100644 closures/compiler/ncgmat.pas create mode 100644 closures/compiler/ncgmem.pas create mode 100644 closures/compiler/ncgobjc.pas create mode 100644 closures/compiler/ncgopt.pas create mode 100644 closures/compiler/ncgrtti.pas create mode 100644 closures/compiler/ncgset.pas create mode 100644 closures/compiler/ncgutil.pas create mode 100644 closures/compiler/ncnv.pas create mode 100644 closures/compiler/ncon.pas create mode 100644 closures/compiler/nflw.pas create mode 100644 closures/compiler/ninl.pas create mode 100644 closures/compiler/nld.pas create mode 100644 closures/compiler/nmat.pas create mode 100644 closures/compiler/nmem.pas create mode 100644 closures/compiler/nobj.pas create mode 100644 closures/compiler/nobjc.pas create mode 100644 closures/compiler/node.pas create mode 100644 closures/compiler/nopt.pas create mode 100644 closures/compiler/nset.pas create mode 100644 closures/compiler/nstate.pas create mode 100644 closures/compiler/nutils.pas create mode 100644 closures/compiler/objcdef.pas create mode 100644 closures/compiler/objcgutl.pas create mode 100644 closures/compiler/objcutil.pas create mode 100644 closures/compiler/ogbase.pas create mode 100644 closures/compiler/ogcoff.pas create mode 100644 closures/compiler/ogelf.pas create mode 100644 closures/compiler/oglx.pas create mode 100644 closures/compiler/ogmacho.pas create mode 100644 closures/compiler/ogmap.pas create mode 100644 closures/compiler/ognlm.pas create mode 100644 closures/compiler/optbase.pas create mode 100644 closures/compiler/optcse.pas create mode 100644 closures/compiler/optdead.pas create mode 100644 closures/compiler/optdfa.pas create mode 100644 closures/compiler/options.pas create mode 100644 closures/compiler/optloop.pas create mode 100644 closures/compiler/opttail.pas create mode 100644 closures/compiler/optutils.pas create mode 100644 closures/compiler/optvirt.pas create mode 100644 closures/compiler/owar.pas create mode 100644 closures/compiler/owbase.pas create mode 100644 closures/compiler/parabase.pas create mode 100644 closures/compiler/paramgr.pas create mode 100644 closures/compiler/parser.pas create mode 100644 closures/compiler/pass_1.pas create mode 100644 closures/compiler/pass_2.pas create mode 100644 closures/compiler/pbase.pas create mode 100644 closures/compiler/pdecl.pas create mode 100644 closures/compiler/pdecobj.pas create mode 100644 closures/compiler/pdecsub.pas create mode 100644 closures/compiler/pdecvar.pas create mode 100644 closures/compiler/pexports.pas create mode 100644 closures/compiler/pexpr.pas create mode 100644 closures/compiler/pgenutil.pas create mode 100644 closures/compiler/pinline.pas create mode 100644 closures/compiler/pmodules.pas create mode 100644 closures/compiler/powerpc/agppcmpw.pas create mode 100644 closures/compiler/powerpc/agppcvasm.pas create mode 100644 closures/compiler/powerpc/aoptcpu.pas create mode 100644 closures/compiler/powerpc/aoptcpub.pas create mode 100644 closures/compiler/powerpc/aoptcpuc.pas create mode 100644 closures/compiler/powerpc/aoptcpud.pas create mode 100644 closures/compiler/powerpc/cgcpu.pas create mode 100644 closures/compiler/powerpc/cpubase.pas create mode 100644 closures/compiler/powerpc/cpuinfo.pas create mode 100644 closures/compiler/powerpc/cpunode.pas create mode 100644 closures/compiler/powerpc/cpupara.pas create mode 100644 closures/compiler/powerpc/cpupi.pas create mode 100644 closures/compiler/powerpc/cputarg.pas create mode 100644 closures/compiler/powerpc/itcpugas.pas create mode 100644 closures/compiler/powerpc/nppcadd.pas create mode 100644 closures/compiler/powerpc/nppccal.pas create mode 100644 closures/compiler/powerpc/nppccnv.pas create mode 100644 closures/compiler/powerpc/nppcmat.pas create mode 100644 closures/compiler/powerpc/ppcins.dat create mode 100644 closures/compiler/powerpc/ppcreg.dat create mode 100644 closures/compiler/powerpc/rappc.pas create mode 100644 closures/compiler/powerpc/rappcgas.pas create mode 100644 closures/compiler/powerpc/rppccon.inc create mode 100644 closures/compiler/powerpc/rppcdwrf.inc create mode 100644 closures/compiler/powerpc/rppcgas.inc create mode 100644 closures/compiler/powerpc/rppcgri.inc create mode 100644 closures/compiler/powerpc/rppcgss.inc create mode 100644 closures/compiler/powerpc/rppcmot.inc create mode 100644 closures/compiler/powerpc/rppcmri.inc create mode 100644 closures/compiler/powerpc/rppcnor.inc create mode 100644 closures/compiler/powerpc/rppcnum.inc create mode 100644 closures/compiler/powerpc/rppcrni.inc create mode 100644 closures/compiler/powerpc/rppcsri.inc create mode 100644 closures/compiler/powerpc/rppcstab.inc create mode 100644 closures/compiler/powerpc/rppcstd.inc create mode 100644 closures/compiler/powerpc/rppcsup.inc create mode 100644 closures/compiler/powerpc64/aoptcpu.pas create mode 100644 closures/compiler/powerpc64/aoptcpub.pas create mode 100644 closures/compiler/powerpc64/aoptcpuc.pas create mode 100644 closures/compiler/powerpc64/aoptcpud.pas create mode 100644 closures/compiler/powerpc64/cgcpu.pas create mode 100644 closures/compiler/powerpc64/cpubase.pas create mode 100644 closures/compiler/powerpc64/cpuinfo.pas create mode 100644 closures/compiler/powerpc64/cpunode.pas create mode 100644 closures/compiler/powerpc64/cpupara.pas create mode 100644 closures/compiler/powerpc64/cpupi.pas create mode 100644 closures/compiler/powerpc64/cputarg.pas create mode 100644 closures/compiler/powerpc64/itcpugas.pas create mode 100644 closures/compiler/powerpc64/nppcadd.pas create mode 100644 closures/compiler/powerpc64/nppccal.pas create mode 100644 closures/compiler/powerpc64/nppccnv.pas create mode 100644 closures/compiler/powerpc64/nppcld.pas create mode 100644 closures/compiler/powerpc64/nppcmat.pas create mode 100644 closures/compiler/powerpc64/ppcins.dat create mode 100644 closures/compiler/powerpc64/ppcreg.dat create mode 100644 closures/compiler/powerpc64/rappc.pas create mode 100644 closures/compiler/powerpc64/rappcgas.pas create mode 100644 closures/compiler/powerpc64/rppccon.inc create mode 100644 closures/compiler/powerpc64/rppcdwrf.inc create mode 100644 closures/compiler/powerpc64/rppcgas.inc create mode 100644 closures/compiler/powerpc64/rppcgri.inc create mode 100644 closures/compiler/powerpc64/rppcgss.inc create mode 100644 closures/compiler/powerpc64/rppcmot.inc create mode 100644 closures/compiler/powerpc64/rppcmri.inc create mode 100644 closures/compiler/powerpc64/rppcnor.inc create mode 100644 closures/compiler/powerpc64/rppcnum.inc create mode 100644 closures/compiler/powerpc64/rppcrni.inc create mode 100644 closures/compiler/powerpc64/rppcsri.inc create mode 100644 closures/compiler/powerpc64/rppcstab.inc create mode 100644 closures/compiler/powerpc64/rppcstd.inc create mode 100644 closures/compiler/powerpc64/rppcsup.inc create mode 100644 closures/compiler/pp.lpi create mode 100644 closures/compiler/pp.pas create mode 100644 closures/compiler/ppc.cfg create mode 100644 closures/compiler/ppc.conf create mode 100644 closures/compiler/ppc.dof create mode 100644 closures/compiler/ppc68k.lpi create mode 100644 closures/compiler/ppcarm.lpi create mode 100644 closures/compiler/ppcavr.lpi create mode 100644 closures/compiler/ppcgen/aasmcpu.pas create mode 100644 closures/compiler/ppcgen/agppcgas.pas create mode 100644 closures/compiler/ppcgen/cgppc.pas create mode 100644 closures/compiler/ppcgen/ngppcadd.pas create mode 100644 closures/compiler/ppcgen/ngppccnv.pas create mode 100644 closures/compiler/ppcgen/ngppcinl.pas create mode 100644 closures/compiler/ppcgen/ngppcset.pas create mode 100644 closures/compiler/ppcgen/rgcpu.pas create mode 100644 closures/compiler/ppcmipsel.lpi create mode 100644 closures/compiler/ppcppc.lpi create mode 100644 closures/compiler/ppcsparc.lpi create mode 100644 closures/compiler/ppheap.pas create mode 100644 closures/compiler/ppu.pas create mode 100644 closures/compiler/ppx86_64.lpi create mode 100644 closures/compiler/procinfo.pas create mode 100644 closures/compiler/pstatmnt.pas create mode 100644 closures/compiler/psub.pas create mode 100644 closures/compiler/psystem.pas create mode 100644 closures/compiler/ptconst.pas create mode 100644 closures/compiler/ptype.pas create mode 100644 closures/compiler/raatt.pas create mode 100644 closures/compiler/rabase.pas create mode 100644 closures/compiler/rasm.pas create mode 100644 closures/compiler/rautils.pas create mode 100644 closures/compiler/regvars.pas create mode 100644 closures/compiler/rescmn.pas create mode 100644 closures/compiler/rgbase.pas create mode 100644 closures/compiler/rgobj.pas create mode 100644 closures/compiler/scandir.pas create mode 100644 closures/compiler/scanner.pas create mode 100644 closures/compiler/script.pas create mode 100644 closures/compiler/sparc/aasmcpu.pas create mode 100644 closures/compiler/sparc/aoptcpu.pas create mode 100644 closures/compiler/sparc/aoptcpub.pas create mode 100644 closures/compiler/sparc/aoptcpud.pas create mode 100644 closures/compiler/sparc/cgcpu.pas create mode 100644 closures/compiler/sparc/cpubase.pas create mode 100644 closures/compiler/sparc/cpugas.pas create mode 100644 closures/compiler/sparc/cpuinfo.pas create mode 100644 closures/compiler/sparc/cpunode.pas create mode 100644 closures/compiler/sparc/cpupara.pas create mode 100644 closures/compiler/sparc/cpupi.pas create mode 100644 closures/compiler/sparc/cputarg.pas create mode 100644 closures/compiler/sparc/itcpugas.pas create mode 100644 closures/compiler/sparc/ncpuadd.pas create mode 100644 closures/compiler/sparc/ncpucall.pas create mode 100644 closures/compiler/sparc/ncpucnv.pas create mode 100644 closures/compiler/sparc/ncpuinln.pas create mode 100644 closures/compiler/sparc/ncpumat.pas create mode 100644 closures/compiler/sparc/ncpuset.pas create mode 100644 closures/compiler/sparc/opcode.inc create mode 100644 closures/compiler/sparc/racpu.pas create mode 100644 closures/compiler/sparc/racpugas.pas create mode 100644 closures/compiler/sparc/rgcpu.pas create mode 100644 closures/compiler/sparc/rspcon.inc create mode 100644 closures/compiler/sparc/rspdwrf.inc create mode 100644 closures/compiler/sparc/rspnor.inc create mode 100644 closures/compiler/sparc/rspnum.inc create mode 100644 closures/compiler/sparc/rsprni.inc create mode 100644 closures/compiler/sparc/rspsri.inc create mode 100644 closures/compiler/sparc/rspstab.inc create mode 100644 closures/compiler/sparc/rspstd.inc create mode 100644 closures/compiler/sparc/rspsup.inc create mode 100644 closures/compiler/sparc/spreg.dat create mode 100644 closures/compiler/sparc/strinst.inc create mode 100644 closures/compiler/switches.pas create mode 100644 closures/compiler/symbase.pas create mode 100644 closures/compiler/symconst.pas create mode 100644 closures/compiler/symdef.pas create mode 100644 closures/compiler/symnot.pas create mode 100644 closures/compiler/symsym.pas create mode 100644 closures/compiler/symtable.pas create mode 100644 closures/compiler/symtype.pas create mode 100644 closures/compiler/symutil.pas create mode 100644 closures/compiler/systems.inc create mode 100644 closures/compiler/systems.pas create mode 100644 closures/compiler/systems/i_amiga.pas create mode 100644 closures/compiler/systems/i_atari.pas create mode 100644 closures/compiler/systems/i_beos.pas create mode 100644 closures/compiler/systems/i_bsd.pas create mode 100644 closures/compiler/systems/i_embed.pas create mode 100644 closures/compiler/systems/i_emx.pas create mode 100644 closures/compiler/systems/i_gba.pas create mode 100644 closures/compiler/systems/i_go32v2.pas create mode 100644 closures/compiler/systems/i_haiku.pas create mode 100644 closures/compiler/systems/i_linux.pas create mode 100644 closures/compiler/systems/i_macos.pas create mode 100644 closures/compiler/systems/i_morph.pas create mode 100644 closures/compiler/systems/i_nativent.pas create mode 100644 closures/compiler/systems/i_nds.pas create mode 100644 closures/compiler/systems/i_nwl.pas create mode 100644 closures/compiler/systems/i_nwm.pas create mode 100644 closures/compiler/systems/i_os2.pas create mode 100644 closures/compiler/systems/i_palmos.pas create mode 100644 closures/compiler/systems/i_sunos.pas create mode 100644 closures/compiler/systems/i_symbian.pas create mode 100644 closures/compiler/systems/i_watcom.pas create mode 100644 closures/compiler/systems/i_wdosx.pas create mode 100644 closures/compiler/systems/i_wii.pas create mode 100644 closures/compiler/systems/i_win.pas create mode 100644 closures/compiler/systems/mac_crea.txt create mode 100644 closures/compiler/systems/t_amiga.pas create mode 100644 closures/compiler/systems/t_atari.pas create mode 100644 closures/compiler/systems/t_beos.pas create mode 100644 closures/compiler/systems/t_bsd.pas create mode 100644 closures/compiler/systems/t_embed.pas create mode 100644 closures/compiler/systems/t_emx.pas create mode 100644 closures/compiler/systems/t_gba.pas create mode 100644 closures/compiler/systems/t_go32v2.pas create mode 100644 closures/compiler/systems/t_haiku.pas create mode 100644 closures/compiler/systems/t_linux.pas create mode 100644 closures/compiler/systems/t_macos.pas create mode 100644 closures/compiler/systems/t_morph.pas create mode 100644 closures/compiler/systems/t_nativent.pas create mode 100644 closures/compiler/systems/t_nds.pas create mode 100644 closures/compiler/systems/t_nwl.pas create mode 100644 closures/compiler/systems/t_nwm.pas create mode 100644 closures/compiler/systems/t_os2.pas create mode 100644 closures/compiler/systems/t_palmos.pas create mode 100644 closures/compiler/systems/t_sunos.pas create mode 100644 closures/compiler/systems/t_symbian.pas create mode 100644 closures/compiler/systems/t_watcom.pas create mode 100644 closures/compiler/systems/t_wdosx.pas create mode 100644 closures/compiler/systems/t_wii.pas create mode 100644 closures/compiler/systems/t_win.pas create mode 100644 closures/compiler/tgobj.pas create mode 100644 closures/compiler/tokens.pas create mode 100644 closures/compiler/utils/Makefile create mode 100644 closures/compiler/utils/Makefile.fpc create mode 100644 closures/compiler/utils/README.txt create mode 100644 closures/compiler/utils/dummyas.pp create mode 100644 closures/compiler/utils/fixlog.pp create mode 100644 closures/compiler/utils/fixmsg.pp create mode 100644 closures/compiler/utils/fixnasm.pp create mode 100644 closures/compiler/utils/fixtab.pp create mode 100644 closures/compiler/utils/fpc.mpw create mode 100644 closures/compiler/utils/fpc.pp create mode 100644 closures/compiler/utils/fpcsubst.pp create mode 100644 closures/compiler/utils/fpimpdef.pp create mode 100644 closures/compiler/utils/gia64reg.pp create mode 100644 closures/compiler/utils/gppc386.pp create mode 100644 closures/compiler/utils/mk68kreg.pp create mode 100644 closures/compiler/utils/mkarmins.pp create mode 100644 closures/compiler/utils/mkarmreg.pp create mode 100644 closures/compiler/utils/mkavrreg.pp create mode 100644 closures/compiler/utils/mkmpsreg.pp create mode 100644 closures/compiler/utils/mkppcreg.pp create mode 100644 closures/compiler/utils/mkspreg.pp create mode 100644 closures/compiler/utils/mkx86ins.pp create mode 100644 closures/compiler/utils/mkx86reg.pp create mode 100644 closures/compiler/utils/msg2inc.pp create mode 100644 closures/compiler/utils/msgdif.pp create mode 100644 closures/compiler/utils/msgused.pl create mode 100644 closures/compiler/utils/ppudump.pp create mode 100644 closures/compiler/utils/ppufiles.pp create mode 100644 closures/compiler/utils/ppumove.pp create mode 100644 closures/compiler/utils/samplecfg create mode 100644 closures/compiler/utils/usubst.pp create mode 100644 closures/compiler/verbose.pas create mode 100644 closures/compiler/version.pas create mode 100644 closures/compiler/vis/aasmcpu.pas create mode 100644 closures/compiler/vis/cpubase.pas create mode 100644 closures/compiler/vis/cpuinfo.pas create mode 100644 closures/compiler/vis/cpunode.pas create mode 100644 closures/compiler/vis/cpupara.pas create mode 100644 closures/compiler/widestr.pas create mode 100644 closures/compiler/wpo.pas create mode 100644 closures/compiler/wpobase.pas create mode 100644 closures/compiler/wpoinfo.pas create mode 100644 closures/compiler/x86/aasmcpu.pas create mode 100644 closures/compiler/x86/agx86att.pas create mode 100644 closures/compiler/x86/agx86int.pas create mode 100644 closures/compiler/x86/agx86nsm.pas create mode 100644 closures/compiler/x86/cga.pas create mode 100644 closures/compiler/x86/cgx86.pas create mode 100644 closures/compiler/x86/cpubase.pas create mode 100644 closures/compiler/x86/itcpugas.pas create mode 100644 closures/compiler/x86/itx86int.pas create mode 100644 closures/compiler/x86/nx86add.pas create mode 100644 closures/compiler/x86/nx86cnv.pas create mode 100644 closures/compiler/x86/nx86con.pas create mode 100644 closures/compiler/x86/nx86inl.pas create mode 100644 closures/compiler/x86/nx86mat.pas create mode 100644 closures/compiler/x86/nx86mem.pas create mode 100644 closures/compiler/x86/nx86set.pas create mode 100644 closures/compiler/x86/rax86.pas create mode 100644 closures/compiler/x86/rax86att.pas create mode 100644 closures/compiler/x86/rax86int.pas create mode 100644 closures/compiler/x86/rgx86.pas create mode 100644 closures/compiler/x86/x86ins.dat create mode 100644 closures/compiler/x86/x86reg.dat create mode 100644 closures/compiler/x86_64/aoptcpu.pas create mode 100644 closures/compiler/x86_64/aoptcpub.pas create mode 100644 closures/compiler/x86_64/aoptcpud.pas create mode 100644 closures/compiler/x86_64/cgcpu.pas create mode 100644 closures/compiler/x86_64/cpubase.inc create mode 100644 closures/compiler/x86_64/cpuinfo.pas create mode 100644 closures/compiler/x86_64/cpunode.pas create mode 100644 closures/compiler/x86_64/cpupara.pas create mode 100644 closures/compiler/x86_64/cpupi.pas create mode 100644 closures/compiler/x86_64/cputarg.pas create mode 100644 closures/compiler/x86_64/nx64add.pas create mode 100644 closures/compiler/x86_64/nx64cal.pas create mode 100644 closures/compiler/x86_64/nx64cnv.pas create mode 100644 closures/compiler/x86_64/nx64flw.pas create mode 100644 closures/compiler/x86_64/nx64inl.pas create mode 100644 closures/compiler/x86_64/nx64mat.pas create mode 100644 closures/compiler/x86_64/r8664ari.inc create mode 100644 closures/compiler/x86_64/r8664att.inc create mode 100644 closures/compiler/x86_64/r8664con.inc create mode 100644 closures/compiler/x86_64/r8664dwrf.inc create mode 100644 closures/compiler/x86_64/r8664int.inc create mode 100644 closures/compiler/x86_64/r8664iri.inc create mode 100644 closures/compiler/x86_64/r8664nor.inc create mode 100644 closures/compiler/x86_64/r8664num.inc create mode 100644 closures/compiler/x86_64/r8664op.inc create mode 100644 closures/compiler/x86_64/r8664ot.inc create mode 100644 closures/compiler/x86_64/r8664rni.inc create mode 100644 closures/compiler/x86_64/r8664sri.inc create mode 100644 closures/compiler/x86_64/r8664stab.inc create mode 100644 closures/compiler/x86_64/r8664std.inc create mode 100644 closures/compiler/x86_64/rax64att.pas create mode 100644 closures/compiler/x86_64/rax64int.pas create mode 100644 closures/compiler/x86_64/rgcpu.pas create mode 100644 closures/compiler/x86_64/win64unw.pas create mode 100644 closures/compiler/x86_64/x8664ats.inc create mode 100644 closures/compiler/x86_64/x8664att.inc create mode 100644 closures/compiler/x86_64/x8664int.inc create mode 100644 closures/compiler/x86_64/x8664nop.inc create mode 100644 closures/compiler/x86_64/x8664op.inc create mode 100644 closures/compiler/x86_64/x8664pro.inc create mode 100644 closures/compiler/x86_64/x8664tab.inc diff --git a/closures/compiler/COPYING.txt b/closures/compiler/COPYING.txt new file mode 100644 index 0000000000..5b6e7c66c2 --- /dev/null +++ b/closures/compiler/COPYING.txt @@ -0,0 +1,340 @@ + 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. + + + Copyright (C) + + 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. + + , 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. diff --git a/closures/compiler/MPWMake b/closures/compiler/MPWMake new file mode 100644 index 0000000000..8591f382fc --- /dev/null +++ b/closures/compiler/MPWMake @@ -0,0 +1 @@ +# Make file for MPW make. # To run it, use: # Make -f MPWMake > Makeout ; Makeout # where should be replaced with actual make target. ############################################# # TIPS (TODO move to Wiki or something # # Defined variables: No quoting # Command lines: quote paths, dont quote option strings, since # they might contain several options, which must be separated. # Recursive call to Make: # - give options as -d XXX="{XXX}" # - in same dir, remember to ensure to have different Makeout files, # e g Makeout2. # # NOTE Currently cycle is stopped after three rounds, no diff is checked. FPC = {FPCDIR}bin:ppcppc # Default language for the compiler (english): FPCLANG = e MSGFILE = :msg:error{FPCLANG}.msg msg2inc Ä :utils:msg2inc.pp {FPC} -FE: -WT :utils: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 -f MPWMake > Makeout3 ; Makeout3 msg2inc {MSGFILE} msg msg msg Ä msgtxt.inc compiler Ä msg Set Exit 0 NewFolder :powerpc:units: ³ Dev:Null NewFolder :powerpc:units:powerpc-macos: ³ Dev:Null Set Exit 1 "{FPC}" {OPT} "-Fu{RTLDIR}" -Fu:systems: -Fu:powerpc: -Fu:ppcgen -dGDB -dBROWSERLOG -dNOOPT ¶ -dpowerpc -WT -FE: -FU:powerpc:units:powerpc-macos: pp.pas Rename -y pp ppcppc clean Ä utils_clean Set Exit 0 Delete -y :powerpc:units:powerpc-macos Delete -y ppcppc oldfpc msg2inc Delete -y Å.xcoff Set Exit 1 cycleclean Ä Set Exit 0 Delete -y :powerpc:units:powerpc-macos Set Exit 1 install Ä If {FPCDIR} == '' Set -e FPCDIR `GetFileName -wd -m 'Select where to install the FreePascal folder'`FreePascal: Set -e Commands "{Commands},{FPCDIR}bin:" Echo "Set -e FPCDIR ¶'{FPCDIR}¶'" > "{MPW}Startup Items:FPC Startup" Echo 'Set -e Commands "{Commands},{FPCDIR}bin:"' >> "{MPW}Startup Items:FPC Startup" End Set Exit 0 NewFolder "{FPCDIR}" ³ Dev:Null NewFolder "{FPCDIR}bin:" ³ Dev:Null Set Exit 1 Duplicate -y :ppcppc :utils:ppudump :utils:ppufiles :utils:ppumove ¶ :utils:fpc "{FPCDIR}bin:" Echo "# Configuration file for Free Pascal for MPW" > "{FPCDIR}bin:fpc.cfg" Echo "-Fu¶'{FPCDIR}units:rtl:¶'" >> "{FPCDIR}bin:fpc.cfg" Echo "-l" >> "{FPCDIR}bin:fpc.cfg" Echo "-vi" >> "{FPCDIR}bin:fpc.cfg" cycle Ä Directory ::rtl:macos Make clean -f MPWMake > Makeout ; Makeout Make all -d FPC="{FPC}" -d OPT="{OPT}" -f MPWMake > Makeout ; Makeout Directory :::compiler Make clean -f MPWMake > Makeout2 ; Makeout2 Make compiler -d FPC="{FPC}" -d OPT="{OPT}" -d RTLDIR=::rtl:units:powerpc-macos -f MPWMake > Makeout2 ; Makeout2 # Echo '******************** SECOND ROUND *********************' Rename -y ppcppc oldfpc Directory ::rtl:macos Make clean -f MPWMake > Makeout ; Makeout Make all -d FPC=:::compiler:oldfpc -d OPT="{OPT}" -f MPWMake > Makeout ; Makeout Directory :::compiler Make cycleclean -f MPWMake > Makeout2 ; Makeout2 Make compiler -d FPC=oldfpc -d OPT="{OPT}" -d RTLDIR=::rtl:units:powerpc-macos -f MPWMake > Makeout2 ; Makeout2 # Echo '********************* THIRD ROUND *********************' Rename -y ppcppc oldfpc Directory ::rtl:macos Make clean -f MPWMake > Makeout ; Makeout Make all -d FPC=:::compiler:oldfpc -d OPT="{OPT}" -f MPWMake > Makeout ; Makeout Directory :::compiler Make cycleclean -f MPWMake > Makeout2 ; Makeout2 Make compiler -d FPC=oldfpc -d OPT="{OPT}" -d RTLDIR=::rtl:units:powerpc-macos -f MPWMake > Makeout2 ; Makeout2 # Make utils_clean -f MPWMake > Makeout2 ; Makeout2 Make utils_all -d FPC=::oldfpc -d OPT="{OPT}" -d RTLDIR=:::rtl:units:powerpc-macos -f MPWMake > Makeout2 ; Makeout2 utils_all Ä Directory :utils Set Exit 0 NewFolder :units: ³ Dev:Null NewFolder :units:powerpc-macos: ³ Dev:Null Set Exit 1 "{FPC}" {OPT} "-Fu{RTLDIR}" -FE: -FU:units:powerpc-macos -Fu:: -WT ppudump.pp "{FPC}" {OPT} "-Fu{RTLDIR}" -FE: -FU:units:powerpc-macos -Fu:: -WT ppufiles.pp "{FPC}" {OPT} "-Fu{RTLDIR}" -FE: -FU:units:powerpc-macos -Fu:: -WT ppumove.pp Duplicate -y fpc.mpw fpc Directory :: utils_clean Ä Directory :utils Set Exit 0 Delete -y :units:powerpc-macos Delete -y fpc ppudump ppufiles ppumove msg2inc Delete -y Å.xcoff Set Exit 1 Directory :: \ No newline at end of file diff --git a/closures/compiler/Makefile b/closures/compiler/Makefile new file mode 100644 index 0000000000..0226d078e1 --- /dev/null +++ b/closures/compiler/Makefile @@ -0,0 +1,3596 @@ +# +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2012/01/14] +# +default: all +MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux +BSDs = freebsd netbsd openbsd darwin +UNIXs = linux $(BSDs) solaris qnx haiku +LIMIT83fs = go32v2 os2 emx watcom +OSNeedsComspecToRunBatch = go32v2 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 COMSPEC +ifneq ($(findstring $(OS_SOURCE),$(OSNeedsComspecToRunBatch)),) +ifndef RUNBATCH +RUNBATCH=$(COMSPEC) /C +endif +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)) +ifneq ($(CPU_TARGET),) +FPC:=$(shell $(FPCPROG) -P$(CPU_TARGET) -PB) +else +FPC:=$(shell $(FPCPROG) -PB) +endif +ifneq ($(findstring Error,$(FPC)),) +override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) +else +ifeq ($(strip $(wildcard $(FPC))),) +FPC:=$(firstword $(FPCPROG)) +endif +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 +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) +ifeq ($(CPU_TARGET),armeb) +ARCH=arm +override FPCOPT+=-Cb +else +ifeq ($(CPU_TARGET),armel) +ARCH=arm +override FPCOPT+=-CaEABI +else +ARCH=$(CPU_TARGET) +endif +endif +ifeq ($(FULL_TARGET),arm-embedded) +ifeq ($(SUBARCH),) +$(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t or SUBARCH=armv7m) must be defined) +endif +override FPCOPT+=-Cp$(SUBARCH) +endif +ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),) +TARGETSUFFIX=$(OS_TARGET) +SOURCESUFFIX=$(OS_SOURCE) +else +ifneq ($(findstring $(OS_TARGET),$(LIMIT83fs)),) +TARGETSUFFIX=$(OS_TARGET) +else +TARGETSUFFIX=$(FULL_TARGET) +endif +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 ARCH 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 +ifneq ($(findstring $(OS_TARGET),darwin iphonesim),) +ifeq ($(OS_SOURCE),darwin) +DARWIN2DARWIN=1 +endif +endif +ifndef BINUTILSPREFIX +ifndef CROSSBINDIR +ifdef CROSSCOMPILE +ifndef DARWIN2DARWIN +BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)- +endif +endif +endif +endif +UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX)) +ifeq ($(UNITSDIR),) +UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET)) +endif +PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) +ifndef FPCFPMAKE +ifdef CROSSCOMPILE +ifeq ($(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR)))),) +FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH)))) +ifneq ($(FPCPROG),) +FPCPROG:=$(firstword $(FPCPROG)) +FPCFPMAKE:=$(shell $(FPCPROG) -PB) +ifeq ($(strip $(wildcard $(FPCFPMAKE))),) +FPCFPMAKE:=$(firstword $(FPCPROG)) +endif +else +override FPCFPMAKE=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) +endif +else +FPCFPMAKE=$(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR)))) +FPMAKE_SKIP_CONFIG=-n +export FPCFPMAKE +export FPMAKE_SKIP_CONFIG +endif +else +FPMAKE_SKIP_CONFIG=-n +FPCFPMAKE=$(FPC) +endif +endif +override PACKAGE_NAME=compiler +override PACKAGE_VERSION=2.7.1 +unexport FPC_VERSION FPC_COMPILERINFO +CYCLETARGETS=i386 powerpc sparc arm x86_64 powerpc64 m68k armeb mipsel mips avr +ALLTARGETS=$(CYCLETARGETS) +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 +ifdef ARMEB +PPC_TARGET=armeb +endif +ifdef MIPS +PPC_TARGET=mips +endif +ifdef MIPSEL +PPC_TARGET=mipsel +endif +ifdef AVR +PPC_TARGET=avr +endif +ifndef PPC_TARGET +PPC_TARGET=$(CPU_TARGET) +endif +ifeq ($(PPC_TARGET),armeb) +CPC_TARGET=arm +else +CPC_TARGET=$(PPC_TARGET) +endif +ifndef PPC_OS +PPC_OS=$(OS_TARGET) +endif +CPU_UNITDIR=$(CPC_TARGET) +UTILSDIR=../utils +COMPILERSOURCEDIR=$(CPC_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 ($(CPC_TARGET),i386) +CPUSUF=386 +endif +ifeq ($(CPC_TARGET),alpha) +CPUSUF=axp +endif +ifeq ($(CPC_TARGET),m68k) +CPUSUF=68k +endif +ifeq ($(CPC_TARGET),powerpc) +CPUSUF=ppc +endif +ifeq ($(CPC_TARGET),powerpc64) +CPUSUF=ppc64 +endif +ifeq ($(CPC_TARGET),sparc) +CPUSUF=sparc +endif +ifeq ($(CPC_TARGET),x86_64) +CPUSUF=x64 +endif +ifeq ($(CPC_TARGET),arm) +CPUSUF=arm +endif +ifeq ($(CPC_TARGET),mips) +CPUSUF=mips +endif +ifeq ($(CPC_TARGET),mipsel) +CPUSUF=mipsel +endif +ifeq ($(CPC_TARGET),avr) +CPUSUF=avr +endif +NOCPUDEF=1 +MSGFILE=msg/error$(FPCLANG).msg +SVNVERSION:=$(wildcard $(addsuffix /svnversion$(SRCEXEEXT),$(SEARCHPATH))) +REVINC:=$(wildcard revision.inc) +ifneq ($(REVINC),) +override LOCALOPT+=-dREVINC +ifeq ($(REVSTR),) +ifneq ($(SVNVERSION),) +REVSTR:=$(shell $(SVNVERSION) -c .) +export REVSTR +else +ifeq ($(REVINC),force) +REVSTR:=exported +export REVSTR +endif +endif +endif +endif +override LOCALOPT+=-d$(CPC_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+=-Fuppcgen +endif +ifeq ($(PPC_TARGET),powerpc64) +override LOCALOPT+=-Fuppcgen +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+= +endif +ifeq ($(PPC_TARGET),mipsel) +override LOCALOPT+=-Fumips +endif +OPTWPOCOLLECT=-OWdevirtcalls,optvmts -FW$(BASEDIR)/pp1.wpo +OPTWPOPERFORM=-Owdevirtcalls,optvmts -Fw$(BASEDIR)/pp1.wpo +ifneq ($(findstring $(OS_TARGET),darwin linux freebsd solaris),) +ifdef LINKSMART +ifdef CREATESMART +OPTWPOCOLLECT+=-OWsymbolliveness -Xs- +OPTWPOPERFORM+=-Owsymbolliveness +endif +endif +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-haiku) +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-darwin) +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),i386-embedded) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),i386-symbian) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),i386-nativent) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),i386-iphonesim) +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),m68k-embedded) +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-amiga) +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),powerpc-embedded) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),powerpc-wii) +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),sparc-embedded) +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-solaris) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),arm-linux) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),arm-palmos) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),arm-darwin) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),arm-wince) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),arm-gba) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),arm-nds) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),arm-embedded) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),arm-symbian) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),avr-embedded) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),armeb-linux) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),armeb-embedded) +override TARGET_DIRS+=utils +endif +ifeq ($(FULL_TARGET),mipsel-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-haiku) +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-darwin) +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),i386-embedded) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),i386-symbian) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),i386-nativent) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),i386-iphonesim) +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),m68k-embedded) +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-amiga) +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),powerpc-embedded) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),powerpc-wii) +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),sparc-embedded) +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-solaris) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),arm-linux) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),arm-palmos) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),arm-darwin) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),arm-wince) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),arm-gba) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),arm-nds) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),arm-embedded) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),arm-symbian) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),avr-embedded) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),armeb-linux) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),armeb-embedded) +override TARGET_PROGRAMS+=pp +endif +ifeq ($(FULL_TARGET),mipsel-linux) +override TARGET_PROGRAMS+=pp +endif +override INSTALL_FPCPACKAGE=y +ifeq ($(FULL_TARGET),i386-linux) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-win32) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-os2) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-beos) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-haiku) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-solaris) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-qnx) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-netware) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-darwin) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-emx) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-watcom) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-wince) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-embedded) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-symbian) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-nativent) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),i386-iphonesim) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),m68k-linux) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),m68k-atari) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),m68k-embedded) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),powerpc-wii) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),sparc-linux) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),sparc-embedded) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),x86_64-solaris) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),arm-linux) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),arm-palmos) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),arm-darwin) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),arm-wince) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),arm-gba) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),arm-nds) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),arm-embedded) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),arm-symbian) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),avr-embedded) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),armeb-linux) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),armeb-embedded) +override COMPILER_INCLUDEDIR+=$(CPC_TARGET) +endif +ifeq ($(FULL_TARGET),mipsel-linux) +override COMPILER_INCLUDEDIR+=$(CPC_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-haiku) +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-darwin) +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),i386-embedded) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),i386-symbian) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),i386-nativent) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),i386-iphonesim) +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),m68k-embedded) +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-amiga) +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),powerpc-embedded) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),powerpc-wii) +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),sparc-embedded) +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-solaris) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),arm-linux) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),arm-palmos) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),arm-darwin) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),arm-wince) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),arm-gba) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),arm-nds) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),arm-embedded) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),arm-symbian) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),avr-embedded) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),armeb-linux) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),armeb-embedded) +override COMPILER_UNITDIR+=$(COMPILERSOURCEDIR) +endif +ifeq ($(FULL_TARGET),mipsel-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-haiku) +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-darwin) +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),i386-embedded) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-symbian) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-nativent) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),i386-iphonesim) +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),m68k-embedded) +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-amiga) +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),powerpc-embedded) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),powerpc-wii) +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),sparc-embedded) +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-solaris) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),arm-linux) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),arm-palmos) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),arm-darwin) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),arm-wince) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),arm-gba) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),arm-nds) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),arm-embedded) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),arm-symbian) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),avr-embedded) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),armeb-linux) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),armeb-embedded) +override COMPILER_TARGETDIR+=. +endif +ifeq ($(FULL_TARGET),mipsel-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-haiku) +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-darwin) +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),i386-embedded) +override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET) +endif +ifeq ($(FULL_TARGET),i386-symbian) +override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET) +endif +ifeq ($(FULL_TARGET),i386-nativent) +override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET) +endif +ifeq ($(FULL_TARGET),i386-iphonesim) +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),m68k-embedded) +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-amiga) +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),powerpc-embedded) +override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET) +endif +ifeq ($(FULL_TARGET),powerpc-wii) +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),sparc-embedded) +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-solaris) +override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET) +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +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),x86_64-embedded) +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-palmos) +override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET) +endif +ifeq ($(FULL_TARGET),arm-darwin) +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),arm-gba) +override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET) +endif +ifeq ($(FULL_TARGET),arm-nds) +override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET) +endif +ifeq ($(FULL_TARGET),arm-embedded) +override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET) +endif +ifeq ($(FULL_TARGET),arm-symbian) +override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET) +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET) +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET) +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET) +endif +ifeq ($(FULL_TARGET),avr-embedded) +override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET) +endif +ifeq ($(FULL_TARGET),armeb-linux) +override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET) +endif +ifeq ($(FULL_TARGET),armeb-embedded) +override COMPILER_UNITTARGETDIR+=$(CPU_UNITDIR)/units/$(FULL_TARGET) +endif +ifeq ($(FULL_TARGET),mipsel-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 +ifndef INSTALL_SHAREDDIR +INSTALL_SHAREDDIR=$(INSTALL_PREFIX)/lib +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 +SHAREDLIBPREFIX=libfp +STATICLIBPREFIX=libp +IMPORTLIBPREFIX=libimp +RSTEXT=.rst +EXEDBGEXT=.dbg +ifeq ($(OS_TARGET),go32v1) +STATICLIBPREFIX= +SHORTSUFFIX=v1 +endif +ifeq ($(OS_TARGET),go32v2) +STATICLIBPREFIX= +SHORTSUFFIX=dos +IMPORTLIBPREFIX= +endif +ifeq ($(OS_TARGET),watcom) +STATICLIBPREFIX= +OEXT=.obj +ASMEXT=.asm +SHAREDLIBEXT=.dll +SHORTSUFFIX=wat +IMPORTLIBPREFIX= +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 +IMPORTLIBPREFIX= +endif +ifeq ($(OS_TARGET),emx) +BATCHEXT=.cmd +AOUTEXT=.out +STATICLIBPREFIX= +SHAREDLIBEXT=.dll +SHORTSUFFIX=emx +ECHO=echo +IMPORTLIBPREFIX= +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),haiku) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=hai +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 +IMPORTLIBPREFIX=imp +endif +ifeq ($(OS_TARGET),netwlibc) +EXEEXT=.nlm +STATICLIBPREFIX= +SHORTSUFFIX=nwl +IMPORTLIBPREFIX=imp +endif +ifeq ($(OS_TARGET),macos) +BATCHEXT= +EXEEXT= +DEBUGSYMEXT=.xcoff +SHORTSUFFIX=mac +IMPORTLIBPREFIX=imp +endif +ifneq ($(findstring $(OS_TARGET),darwin iphonesim),) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=dwn +EXEDBGEXT=.dSYM +endif +ifeq ($(OS_TARGET),gba) +EXEEXT=.gba +SHAREDLIBEXT=.so +SHORTSUFFIX=gba +endif +ifeq ($(OS_TARGET),symbian) +SHAREDLIBEXT=.dll +SHORTSUFFIX=symbian +endif +ifeq ($(OS_TARGET),NativeNT) +SHAREDLIBEXT=.dll +SHORTSUFFIX=nativent +endif +ifeq ($(OS_TARGET),wii) +EXEEXT=.dol +SHAREDLIBEXT=.so +SHORTSUFFIX=wii +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 /gtar$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(TARPROG),) +TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(TARPROG),) +TARPROG= __missing_command_TARPROG +else +TARPROG:=$(firstword $(TARPROG)) +endif +else +TARPROG:=$(firstword $(TARPROG)) +endif +endif +export TARPROG +ASNAME=$(BINUTILSPREFIX)as +LDNAME=$(BINUTILSPREFIX)ld +ARNAME=$(BINUTILSPREFIX)ar +RCNAME=$(BINUTILSPREFIX)rc +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 +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-haiku) +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-darwin) +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),i386-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-symbian) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-nativent) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-iphonesim) +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),m68k-embedded) +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-amiga) +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),powerpc-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc-wii) +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),sparc-embedded) +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-solaris) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),x86_64-win64) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-palmos) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-darwin) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-wince) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-gba) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-nds) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-symbian) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),avr-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),armeb-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),armeb-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),mipsel-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 +ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX)),) +UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX) +else +ifneq ($(wildcard $(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX)),) +UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX) +else +UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL) +endif +endif +ifdef CHECKDEPEND +$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE): + $(MAKE) -C $(PACKAGEDIR_RTL)/$(OS_TARGET) $(FPCMADE) +override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(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 +ifdef UNITDIR_FPMAKE_RTL +override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_RTL) +endif +endif +ifndef NOCPUDEF +override FPCOPTDEF=$(ARCH) +endif +ifneq ($(OS_TARGET),$(OS_SOURCE)) +override FPCOPT+=-T$(OS_TARGET) +endif +ifneq ($(CPU_TARGET),$(CPU_SOURCE)) +override FPCOPT+=-P$(ARCH) +endif +ifeq ($(OS_SOURCE),openbsd) +override FPCOPT+=-FD$(NEW_BINUTILS_PATH) +override FPCMAKEOPT+=-FD$(NEW_BINUTILS_PATH) +endif +ifndef CROSSBOOTSTRAP +ifneq ($(BINUTILSPREFIX),) +override FPCOPT+=-XP$(BINUTILSPREFIX) +endif +ifneq ($(BINUTILSPREFIX),) +override FPCOPT+=-Xr$(RLINKPATH) +endif +endif +ifndef CROSSCOMPILE +ifneq ($(BINUTILSPREFIX),) +override FPCMAKEOPT+=-XP$(BINUTILSPREFIX) +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 +ifneq ($(findstring 2.0.,$(FPC_VERSION)),) +ifeq ($(CPU_TARGET),i386) +FPCCPUOPT:=-OG2p3 +endif +ifeq ($(CPU_TARGET),powerpc) +FPCCPUOPT:=-O1r +endif +else +FPCCPUOPT:=-O2 +endif +override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n +override FPCOPTDEF+=RELEASE +endif +ifdef STRIP +override FPCOPT+=-Xs +endif +ifdef OPTIMIZE +override FPCOPT+=-O2 +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 +ifdef CREATESHARED +override FPCOPT+=-Cg +ifeq ($(CPU_TARGET),i386) +override FPCOPT+=-Aas +endif +endif +ifeq ($(findstring 2.0.,$(FPC_VERSION)),) +ifneq ($(findstring $(OS_TARGET),freebsd openbsd netbsd linux solaris),) +ifeq ($(CPU_TARGET),x86_64) +override FPCOPT+=-Cg +endif +endif +endif +ifdef LINKSHARED +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 AFULL_TARGET=$(CPU_TARGET)-$(OS_TARGET) +override AFULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE) +ifneq ($(AFULL_TARGET),$(AFULL_SOURCE)) +override ACROSSCOMPILE=1 +endif +ifdef ACROSSCOMPILE +override FPCOPT+=$(CROSSOPT) +endif +override COMPILER:=$(FPC) $(FPCOPT) +ifeq (,$(findstring -s ,$(COMPILER))) +EXECPPAS= +else +ifeq ($(FULL_SOURCE),$(FULL_TARGET)) +ifdef RUNBATCH +EXECPPAS:=@$(RUNBATCH) $(PPAS) +else +EXECPPAS:=@$(PPAS) +endif +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))) $(addprefix $(IMPORTLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS))) +override EXEDBGFILES:=$(addsuffix $(EXEDBGEXT),$(TARGET_PROGRAMS)) +override ALLTARGET+=fpc_exes +override INSTALLEXEFILES+=$(EXEFILES) +override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES) +override CLEANEXEDBGFILES+=$(EXEDBGFILES) +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 fpc_shared +$(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 %.inc $(COMPILER_INCLUDEDIR) +vpath %$(OEXT) $(COMPILER_UNITTARGETDIR) +vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR) +.PHONY: fpc_shared +override INSTALLTARGET+=fpc_shared_install +ifndef SHARED_LIBVERSION +SHARED_LIBVERSION=$(FPC_VERSION) +endif +ifndef SHARED_LIBNAME +SHARED_LIBNAME=$(PACKAGE_NAME) +endif +ifndef SHARED_FULLNAME +SHARED_FULLNAME=$(SHAREDLIBPREFIX)$(SHARED_LIBNAME)-$(SHARED_LIBVERSION)$(SHAREDLIBEXT) +endif +ifndef SHARED_LIBUNITS +SHARED_LIBUNITS:=$(TARGET_UNITS) $(TARGET_IMPLICITUNITS) +override SHARED_LIBUNITS:=$(filter-out $(INSTALL_BUILDUNIT),$(SHARED_LIBUNITS)) +endif +fpc_shared: +ifdef HASSHAREDLIB + $(MAKE) all CREATESHARED=1 LINKSHARED=1 CREATESMART=1 +ifneq ($(SHARED_BUILD),n) + $(PPUMOVE) -q $(SHARED_LIBUNITS) -i$(COMPILER_UNITTARGETDIR) -o$(SHARED_FULLNAME) -d$(COMPILER_UNITTARGETDIR) +endif +else + @$(ECHO) Shared Libraries not supported +endif +fpc_shared_install: +ifneq ($(SHARED_BUILD),n) +ifneq ($(SHARED_LIBUNITS),) +ifneq ($(wildcard $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME)),) + $(INSTALL) $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME) $(INSTALL_SHAREDDIR) +endif +endif +endif +.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))) $(addprefix $(IMPORTLIBPREFIX),$(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) + $(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) c$(TAROPT)f $(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 +ifdef RUNBATCH + $(RUNBATCH) $(ZIPWRAPPER) +else + $(ZIPWRAPPER) +endif +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)) +override CLEANEXEDBGFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEDBGFILES)) +endif +ifdef CLEAN_PROGRAMS +override CLEANEXEFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEEXT), $(CLEAN_PROGRAMS))) +override CLEANEXEDBGFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEDBGEXT), $(CLEAN_PROGRAMS))) +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))) $(addprefix $(IMPORTLIBPREFIX),$(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 CLEANEXEDBGFILES + -$(DELTREE) $(CLEANEXEDBGFILES) +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 +ifdef CLEAN_FILES + -$(DEL) $(CLEAN_FILES) +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) FPC fpmake... $(FPCFPMAKE) + @$(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) 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-haiku) +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-darwin) +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),i386-embedded) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),i386-symbian) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),i386-nativent) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),i386-iphonesim) +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),m68k-embedded) +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-amiga) +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),powerpc-embedded) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),powerpc-wii) +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),sparc-embedded) +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-solaris) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),x86_64-win64) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),arm-linux) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),arm-palmos) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),arm-darwin) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),arm-wince) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),arm-gba) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),arm-nds) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),arm-embedded) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),arm-symbian) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),avr-embedded) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),armeb-linux) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),armeb-embedded) +TARGET_DIRS_UTILS=1 +endif +ifeq ($(FULL_TARGET),mipsel-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: fpc_shared +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) +USE_CMP_FOR_DIFF=1 +endif +ifeq ($(OS_TARGET),win64) +USE_CMP_FOR_DIFF=1 +endif +ifdef USE_CMP_FOR_DIFF +ifdef CMP +override DIFF:=$(CMP) -i218 +endif +endif +ifeq ($(findstring 2.4.,$(FPC_VERSION)),) +ifndef ALLOW_WARNINGS +override LOCALOPT+=-Sew +endif +endif +override COMPILER+=$(LOCALOPT) +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) +TEMPWPONAME1=ppcwpo1$(EXEEXT) +TEMPWPONAME2=ppcwpo2$(EXEEXT) +MAKEDEP=ppdep$(EXEEXT) +MSG2INC=./msg2inc$(EXEEXT) +ifdef CROSSINSTALL +INSTALLEXEFILE=$(PPCROSSNAME) +else +INSTALLEXEFILE=$(EXENAME) +endif +PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 alpha vis ia64 mips mipsel avr +INSTALL_TARGETS=$(addsuffix _exe_install,$(sort $(CYCLETARGETS) $(PPC_TARGETS))) +.PHONY: $(PPC_TARGETS) $(INSTALL_TARGETS) +$(PPC_TARGETS): + $(MAKE) PPC_TARGET=$@ CPU_UNITDIR=$@ all +$(INSTALL_TARGETS): + $(MAKE) all exeinstall PPC_TARGET=$(subst _exe_install,,$@) CPU_UNITDIR=$(subst _exe_install,,$@) +alltargets: $(ALLTARGETS) +.NOTPARALLEL: +.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) pp1.wpo pp2.wpo +execlean : + -$(DEL) ppc386$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) ppcppc64$(EXEEXT) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) $(EXENAME) $(TEMPWPONAME1) $(TEMPWPONAME2) +$(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) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) ppcppc64$(EXEEXT) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) $(EXENAME)) +cycleclean: cleanall $(addsuffix _clean,$(CPC_TARGET)) + -$(DEL) $(EXENAME) +clean: tempclean execlean cleanall $(addsuffix _clean,$(CPC_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 +insdatx86 : $(COMPILER_UNITTARGETDIR) x86/x86ins.dat + $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkx86ins.pp + cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86ins$(SRCEXEEXT) && mv -f *.inc ../i386 + cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86ins$(SRCEXEEXT) x86_64 && mv -f *.inc ../x86_64 + $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkx86reg.pp + cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86reg$(SRCEXEEXT) + mv -f x86/r386*.inc i386 + cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86reg$(SRCEXEEXT) x86_64 + mv -f x86/r8664*.inc x86_64 +insdatarm : arm/armins.dat + $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkarmins.pp + cd arm && ..$(PATHSEP)utils$(PATHSEP)mkarmins$(SRCEXEEXT) +insdat: insdatx86 insdatarm +regdatarm : arm/armreg.dat + $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkarmreg.pp + cd arm && ..$(PATHSEP)utils$PATHSEP)mkarmreg$(SRCEXEEXT) +revision.inc : +ifneq ($(REVSTR),) +ifdef USEZIPWRAPPER +ifneq ($(ECHOREDIR),echo) + $(ECHOREDIR) "'$(REVSTR)'" > revision.inc +else + $(ECHOREDIR) '$(REVSTR)' > revision.inc +endif +else + $(ECHOREDIR) "'$(REVSTR)'" > revision.inc +endif +else + $(MAKE) revision.inc REVINC=force +endif +.PHONY : revision +revision : + $(DEL) revision.inc + $(MAKE) revision.inc +$(EXENAME) : $(wildcard *.pas) $(wildcard *.inc) msg \ + $(wildcard systems/*.pas) $(wilcard systems/*.inc) \ + $(wildcard $(CPC_TARGET)/*.pas) $(wildcard $(CPC_TARGET)/*.inc) \ + $(COMPILER_UNITTARGETDIR) $(COMPILER_TARGETDIR) +ifneq ($(REVSTR),) +ifdef USEZIPWRAPPER +ifneq ($(ECHOREDIR),echo) + $(ECHOREDIR) "'$(REVSTR)'" > revision.inc +else + $(ECHOREDIR) '$(REVSTR)' > revision.inc +endif +else + $(ECHOREDIR) "'$(REVSTR)'" > revision.inc +endif + $(COMPILER) version.pas +endif + $(COMPILER) pp.pas + $(EXECPPAS) + $(MOVE) $(COMPILER_TARGETDIR)/$(PPEXENAME) $(EXENAME) +ifeq ($(CPU_SOURCE),$(PPC_TARGET)) +ifeq ($(OS_SOURCE),$(OS_TARGET)) +ifndef NOWPOCYCLE +ifdef RELEASE +DOWPOCYCLE=1 +wpocycle: + $(RM) $(EXENAME) + $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(LOCALOPT) $(OPTWPOCOLLECT)' compiler + $(RM) $(EXENAME) + $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(RTLOPT) $(OPTWPOPERFORM)' rtlclean rtl + $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(LOCALOPT) $(OPTWPOPERFORM) $(subst pp1.wpo,pp2.wpo,$(OPTWPOCOLLECT))' $(addsuffix _clean,$(ALLTARGETS)) compiler + $(MOVE) $(EXENAME) $(TEMPWPONAME1) + $(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(RTLOPT) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM))' rtlclean rtl + $(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(LOCALOPT) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM))' $(addsuffix _clean,$(ALLTARGETS)) compiler + $(COPY) $(EXENAME) $(TEMPWPONAME2) +endif +endif +ifndef DOWPOCYCLE +wpocycle: +endif +ifdef DIFF +ifdef OLDFPC +ifneq ($(OS_TARGET),darwin) +DIFFRESULT:=$(shell $(DIFF) $(OLDFPC) $(FPC)) +else +DIFFRESULT:=$(shell cp $(OLDFPC) $(OLDFPC).tmp; cp $(FPC) $(FPC).tmp; strip -no_uuid $(OLDFPC).tmp; strip -no_uuid $(FPC).tmp; $(DIFF) $(OLDFPC).tmp $(FPC).tmp; rm $(OLDFPC).tmp $(FPC).tmp) +endif +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) wpocycle + $(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 +ifneq ($(OS_TARGET),embedded) +ifneq ($(OS_TARGET),gba) + $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' cycleclean compiler +endif +endif +endif +endif +else +cycle: override FPC= +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)' 'OPT=$(OPT) $(CROSSOPT)' rtlclean rtl +ifneq ($(OS_TARGET),embedded) +ifneq ($(OS_TARGET),gba) + $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(OPT) $(CROSSOPT)' cycleclean compiler +endif +endif +endif +endif +cycledep: + $(MAKE) cycle USEDEPEND=1 +extcycle: + $(MAKE) cycle OPT='-n -OG2p3 -glttt -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 exeinstall 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)) + $(MAKE) exeinstall +exeinstall: +ifneq ($(INSTALLEXEFILE),) +ifdef UPXPROG + -$(UPXPROG) $(INSTALLEXEFILE) +endif + $(MKDIR) $(PPCCPULOCATION) + $(INSTALLEXE) $(INSTALLEXEFILE) $(PPCCPULOCATION)/$(INSTALLEXEFILE) +endif +fullinstall: + $(MAKE) $(addsuffix _exe_install,$(filter-out $(PPC_TARGET),$(CYCLETARGETS))) +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 +PPUDIR=$(COMPILER_UNITTARGETDIR) +ALLPPUDIR=$(CPU_TARGET)/units/* +PPULIST=$(wildcard $(PPUDIR)/*.ppu) +PPULOGLIST=$(subst .ppu,.log-ppu,$(PPULIST)) +RTLPPUDIR=../rtl/units/$(FULL_TARGET) +RTLPPULIST=$(wildcard $(RTLPPUDIR)/*.ppu) +RTLPPULOGLIST=$(subst .ppu,.log-ppu,$(RTLPPULIST)) +.PHONY : ppulogs cleanppulogs rtlppulogs cleanrtlppulogs testppudump +ppulogs : $(PPULOGLIST) +rtlppulogs : $(RTLPPULOGLIST) +vpath %.ppu $(PPUDIR) $(RTLPPUDIR) $(ALLPPUDIR) +vpath %.log-ppu $(PPUDIR) $(RTLPPUDIR) $(ALLPPUDIR) +%.log-ppu : %.ppu ./utils/ppudump$(EXEEXT) + .$(PATHSEP)utils$(PATHSEP)ppudump -VA -M $< > $@ +./utils/ppudump$(EXEEXT): + $(MAKE) -C $(COMPILERUTILSDIR) ppudump$(EXEEXT) +ppuinfo : + echo PPU list is "$(PPULIST)" + echo PPULOG list is "$(PPULOGLIST)" +cleanppulogs : + -$(RMPROG) $(PPULOGLIST) +cleanrtlppulogs : + -$(RMPROG) $(RTLPPULOGLIST) +testppudump : + $(MAKE) cleanrtlppulogs cleanppulogs ppulogs rtlppulogs +localmake:=$(strip $(wildcard makefile.loc)) +ifdef localmake +include ./$(localmake) +endif diff --git a/closures/compiler/Makefile.fpc b/closures/compiler/Makefile.fpc new file mode 100644 index 0000000000..b3d7719a16 --- /dev/null +++ b/closures/compiler/Makefile.fpc @@ -0,0 +1,789 @@ +# +# Makefile.fpc for Free Pascal Compiler +# + +[package] +name=compiler +version=2.7.1 + +[target] +programs=pp +dirs=utils + +[compiler] +targetdir=. +unittargetdir=$(CPU_UNITDIR)/units/$(FULL_TARGET) +unitdir=$(COMPILERSOURCEDIR) +includedir=$(CPC_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 m68k armeb mipsel mips avr + +# All supported targets used for clean +ALLTARGETS=$(CYCLETARGETS) + +# 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 +ifdef ARMEB +PPC_TARGET=armeb +endif +ifdef MIPS +PPC_TARGET=mips +endif +ifdef MIPSEL +PPC_TARGET=mipsel +endif +ifdef AVR +PPC_TARGET=avr +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 + +ifeq ($(PPC_TARGET),armeb) +CPC_TARGET=arm +else +CPC_TARGET=$(PPC_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=$(CPC_TARGET) + +# RTL +UTILSDIR=../utils + +# Directories containing compiler sources +COMPILERSOURCEDIR=$(CPC_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 ($(CPC_TARGET),i386) +CPUSUF=386 +endif +ifeq ($(CPC_TARGET),alpha) +CPUSUF=axp +endif +ifeq ($(CPC_TARGET),m68k) +CPUSUF=68k +endif +ifeq ($(CPC_TARGET),powerpc) +CPUSUF=ppc +endif +ifeq ($(CPC_TARGET),powerpc64) +CPUSUF=ppc64 +endif +ifeq ($(CPC_TARGET),sparc) +CPUSUF=sparc +endif +ifeq ($(CPC_TARGET),x86_64) +CPUSUF=x64 +endif +ifeq ($(CPC_TARGET),arm) +CPUSUF=arm +endif +ifeq ($(CPC_TARGET),mips) +CPUSUF=mips +endif +ifeq ($(CPC_TARGET),mipsel) +CPUSUF=mipsel +endif +ifeq ($(CPC_TARGET),avr) +CPUSUF=avr +endif + +# Do not define the default -d$(CPU_TARGET) because that +# will conflict with our -d$(CPC_TARGET) +NOCPUDEF=1 + +# Default message file +MSGFILE=msg/error$(FPCLANG).msg + + +SVNVERSION:=$(wildcard $(addsuffix /svnversion$(SRCEXEEXT),$(SEARCHPATH))) +# Check if revision.inc is present +REVINC:=$(wildcard revision.inc) +ifneq ($(REVINC),) +# File revision.inc is present +#Use it to compile version.pas unit +override LOCALOPT+=-dREVINC +# Automatically update revision.inc if +# svnversion executable is available +ifeq ($(REVSTR),) +ifneq ($(SVNVERSION),) +REVSTR:=$(shell $(SVNVERSION) -c .) +export REVSTR +else +ifeq ($(REVINC),force) +REVSTR:=exported +export REVSTR +endif +endif +endif +endif + +# set correct defines (-d$(CPU_TARGET) is automatically added in makefile.fpc) +override LOCALOPT+=-d$(CPC_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+=-Fuppcgen +endif + +# PowerPC64 specific +ifeq ($(PPC_TARGET),powerpc64) +override LOCALOPT+=-Fuppcgen +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+= +endif + +# mipsel specific +ifeq ($(PPC_TARGET),mipsel) +override LOCALOPT+=-Fumips +endif + + +OPTWPOCOLLECT=-OWdevirtcalls,optvmts -FW$(BASEDIR)/pp1.wpo +OPTWPOPERFORM=-Owdevirtcalls,optvmts -Fw$(BASEDIR)/pp1.wpo +# symbol liveness WPO requires nm, smart linking and no stripping (the latter +# is forced by the Makefile when necessary) +ifneq ($(findstring $(OS_TARGET),darwin linux freebsd solaris),) +ifdef LINKSMART +ifdef CREATESMART +OPTWPOCOLLECT+=-OWsymbolliveness -Xs- +OPTWPOPERFORM+=-Owsymbolliveness +endif +endif +endif + + +[rules] +##################################################################### +# Setup Targets +##################################################################### + +ifeq ($(OS_TARGET),win32) +USE_CMP_FOR_DIFF=1 +endif +ifeq ($(OS_TARGET),win64) +USE_CMP_FOR_DIFF=1 +endif + +ifdef USE_CMP_FOR_DIFF +ifdef CMP +override DIFF:=$(CMP) -i218 +endif +endif + +# Use -Sew option by default +# Allow disabling by setting ALLOW_WARNINGS=1 +ifeq ($(findstring 2.4.,$(FPC_VERSION)),) +ifndef ALLOW_WARNINGS +override LOCALOPT+=-Sew +endif +endif + +# Add Local options +override COMPILER+=$(LOCALOPT) + + +##################################################################### +# 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) +TEMPWPONAME1=ppcwpo1$(EXEEXT) +TEMPWPONAME2=ppcwpo2$(EXEEXT) +MAKEDEP=ppdep$(EXEEXT) +MSG2INC=./msg2inc$(EXEEXT) +ifdef CROSSINSTALL +INSTALLEXEFILE=$(PPCROSSNAME) +else +INSTALLEXEFILE=$(EXENAME) +endif + +##################################################################### +# CPU targets +##################################################################### + +PPC_TARGETS=i386 m68k powerpc sparc arm armeb x86_64 powerpc64 alpha vis ia64 mips mipsel avr +INSTALL_TARGETS=$(addsuffix _exe_install,$(sort $(CYCLETARGETS) $(PPC_TARGETS))) + +.PHONY: $(PPC_TARGETS) $(INSTALL_TARGETS) + +$(PPC_TARGETS): + $(MAKE) PPC_TARGET=$@ CPU_UNITDIR=$@ all + +$(INSTALL_TARGETS): + $(MAKE) all exeinstall PPC_TARGET=$(subst _exe_install,,$@) CPU_UNITDIR=$(subst _exe_install,,$@) + +alltargets: $(ALLTARGETS) + + +##################################################################### +# Default makefile +##################################################################### + +.NOTPARALLEL: + +.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) pp1.wpo pp2.wpo + +execlean : + -$(DEL) ppc386$(EXEEXT) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) ppcppc64$(EXEEXT) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) $(EXENAME) $(TEMPWPONAME1) $(TEMPWPONAME2) + +$(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) ppc68k$(EXEEXT) ppcx64$(EXEEXT) ppcppc$(EXEEXT) ppcsparc$(EXEEXT) ppcppc64$(EXEEXT) ppcarm$(EXEEXT) ppcmips$(EXEEXT) ppcmipsel$(EXEEXT) $(EXENAME)) + +cycleclean: cleanall $(addsuffix _clean,$(CPC_TARGET)) + -$(DEL) $(EXENAME) + +clean: tempclean execlean cleanall $(addsuffix _clean,$(CPC_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 + +insdatx86 : $(COMPILER_UNITTARGETDIR) x86/x86ins.dat + $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkx86ins.pp + cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86ins$(SRCEXEEXT) && mv -f *.inc ../i386 + cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86ins$(SRCEXEEXT) x86_64 && mv -f *.inc ../x86_64 + $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkx86reg.pp + cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86reg$(SRCEXEEXT) + mv -f x86/r386*.inc i386 + cd x86 && ..$(PATHSEP)utils$(PATHSEP)mkx86reg$(SRCEXEEXT) x86_64 + mv -f x86/r8664*.inc x86_64 + +insdatarm : arm/armins.dat + $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkarmins.pp + cd arm && ..$(PATHSEP)utils$(PATHSEP)mkarmins$(SRCEXEEXT) + +insdat: insdatx86 insdatarm + +regdatarm : arm/armreg.dat + $(COMPILER) -FE$(COMPILERUTILSDIR) $(COMPILERUTILSDIR)/mkarmreg.pp + cd arm && ..$(PATHSEP)utils$PATHSEP)mkarmreg$(SRCEXEEXT) + +# revision.inc rule +revision.inc : +ifneq ($(REVSTR),) +ifdef USEZIPWRAPPER +ifneq ($(ECHOREDIR),echo) + $(ECHOREDIR) "'$(REVSTR)'" > revision.inc +else + $(ECHOREDIR) '$(REVSTR)' > revision.inc +endif +else + $(ECHOREDIR) "'$(REVSTR)'" > revision.inc +endif +else + $(MAKE) revision.inc REVINC=force +endif + +.PHONY : revision + +revision : + $(DEL) revision.inc + $(MAKE) revision.inc + +# Make only the compiler +# ECHOREDIR sometimes does not remove double quotes +$(EXENAME) : $(wildcard *.pas) $(wildcard *.inc) msg \ + $(wildcard systems/*.pas) $(wilcard systems/*.inc) \ + $(wildcard $(CPC_TARGET)/*.pas) $(wildcard $(CPC_TARGET)/*.inc) \ + $(COMPILER_UNITTARGETDIR) $(COMPILER_TARGETDIR) +ifneq ($(REVSTR),) +ifdef USEZIPWRAPPER +ifneq ($(ECHOREDIR),echo) + $(ECHOREDIR) "'$(REVSTR)'" > revision.inc +else + $(ECHOREDIR) '$(REVSTR)' > revision.inc +endif +else + $(ECHOREDIR) "'$(REVSTR)'" > revision.inc +endif + $(COMPILER) version.pas +endif + $(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 +# + +ifndef NOWPOCYCLE +ifdef RELEASE +DOWPOCYCLE=1 +# Two WPO cycles in case of RELEASE=1 +wpocycle: +# don't use cycle_clean, it will delete the compiler utilities again + $(RM) $(EXENAME) + $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(LOCALOPT) $(OPTWPOCOLLECT)' compiler + $(RM) $(EXENAME) + $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(RTLOPT) $(OPTWPOPERFORM)' rtlclean rtl + $(MAKE) 'FPC=$(BASEDIR)/$(TEMPNAME3)' 'OPT=$(LOCALOPT) $(OPTWPOPERFORM) $(subst pp1.wpo,pp2.wpo,$(OPTWPOCOLLECT))' $(addsuffix _clean,$(ALLTARGETS)) compiler + $(MOVE) $(EXENAME) $(TEMPWPONAME1) + $(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(RTLOPT) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM))' rtlclean rtl + $(MAKE) 'FPC=$(BASEDIR)/$(TEMPWPONAME1)' 'OPT=$(LOCALOPT) $(subst pp1.wpo,pp2.wpo,$(OPTWPOPERFORM))' $(addsuffix _clean,$(ALLTARGETS)) compiler + $(COPY) $(EXENAME) $(TEMPWPONAME2) +endif +endif + +ifndef DOWPOCYCLE +wpocycle: +endif + +# Used to avoid unnecessary steps +ifdef DIFF +ifdef OLDFPC +ifneq ($(OS_TARGET),darwin) +DIFFRESULT:=$(shell $(DIFF) $(OLDFPC) $(FPC)) +else +DIFFRESULT:=$(shell cp $(OLDFPC) $(OLDFPC).tmp; cp $(FPC) $(FPC).tmp; strip -no_uuid $(OLDFPC).tmp; strip -no_uuid $(FPC).tmp; $(DIFF) $(OLDFPC).tmp $(FPC).tmp; rm $(OLDFPC).tmp $(FPC).tmp) +endif +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) wpocycle + $(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 (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 (target native) +ifndef CROSSINSTALL + $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' rtlclean rtl +# building a native compiler for embedded targets is not possible +ifneq ($(OS_TARGET),embedded) +# building a native compiler for the arm-gba target is not possible +ifneq ($(OS_TARGET),gba) + $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' cycleclean compiler +endif +endif +endif + +endif + +else + +########################## +# Cross CPU cycle +# +# ppc1 = native +# ppc2 = cross running on this platform +# ppc3/ppcXXX = native (skipped for cross installation) +# + +cycle: override FPC= +cycle: +# ppc (source native) +# Clear detected compiler binary, because it can be existing crosscompiler binary, but we need native compiler here + $(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 (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 (target native) +ifndef CROSSINSTALL + $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(OPT) $(CROSSOPT)' rtlclean rtl +# building a native compiler for embedded targets is not possible +ifneq ($(OS_TARGET),embedded) +# building a native compiler for the arm-gba target is not possible +ifneq ($(OS_TARGET),gba) + $(MAKE) 'FPC=$(BASEDIR)/$(PPCROSSNAME)' 'OPT=$(OPT) $(CROSSOPT)' cycleclean compiler +endif +endif +endif + +endif + +cycledep: + $(MAKE) cycle USEDEPEND=1 + +extcycle: + $(MAKE) cycle OPT='-n -OG2p3 -glttt -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 exeinstall 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)) + $(MAKE) exeinstall + +# 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 +exeinstall: +ifneq ($(INSTALLEXEFILE),) +ifdef UPXPROG + -$(UPXPROG) $(INSTALLEXEFILE) +endif + $(MKDIR) $(PPCCPULOCATION) + $(INSTALLEXE) $(INSTALLEXEFILE) $(PPCCPULOCATION)/$(INSTALLEXEFILE) +endif + +fullinstall: + $(MAKE) $(addsuffix _exe_install,$(filter-out $(PPC_TARGET),$(CYCLETARGETS))) + +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 + +##################################################################### +# PPU testing targets +##################################################################### + +PPUDIR=$(COMPILER_UNITTARGETDIR) +ALLPPUDIR=$(CPU_TARGET)/units/* +PPULIST=$(wildcard $(PPUDIR)/*.ppu) +PPULOGLIST=$(subst .ppu,.log-ppu,$(PPULIST)) + +RTLPPUDIR=../rtl/units/$(FULL_TARGET) +RTLPPULIST=$(wildcard $(RTLPPUDIR)/*.ppu) +RTLPPULOGLIST=$(subst .ppu,.log-ppu,$(RTLPPULIST)) + +.PHONY : ppulogs cleanppulogs rtlppulogs cleanrtlppulogs testppudump + +ppulogs : $(PPULOGLIST) + +rtlppulogs : $(RTLPPULOGLIST) + +vpath %.ppu $(PPUDIR) $(RTLPPUDIR) $(ALLPPUDIR) +vpath %.log-ppu $(PPUDIR) $(RTLPPUDIR) $(ALLPPUDIR) + +%.log-ppu : %.ppu ./utils/ppudump$(EXEEXT) + .$(PATHSEP)utils$(PATHSEP)ppudump -VA -M $< > $@ + + +./utils/ppudump$(EXEEXT): + $(MAKE) -C $(COMPILERUTILSDIR) ppudump$(EXEEXT) + +ppuinfo : + echo PPU list is "$(PPULIST)" + echo PPULOG list is "$(PPULOGLIST)" + +cleanppulogs : + -$(RMPROG) $(PPULOGLIST) + +cleanrtlppulogs : + -$(RMPROG) $(RTLPPULOGLIST) + +testppudump : + $(MAKE) cleanrtlppulogs cleanppulogs ppulogs rtlppulogs + +##################################################################### +# local user configurable file +# in makefile.loc you can add any desired target +##################################################################### + +localmake:=$(strip $(wildcard makefile.loc)) + +ifdef localmake +include ./$(localmake) +endif diff --git a/closures/compiler/README.txt b/closures/compiler/README.txt new file mode 100644 index 0000000000..745695cc1e --- /dev/null +++ b/closures/compiler/README.txt @@ -0,0 +1,63 @@ +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 haiku +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 + cpu64bitaddr The targets use a 64-bit address space (pointers and + the default integer type are 64 bit) + cpu64bitalu The target cpu has 64-bit registers available (unless + cpu64bitaddr is also defined, pointers and default + integer type remain 32 bit, but the cpu can perform + 64 bit calculations directly without needing helpers) + ----------------------------------------------------------------- + + 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 diff --git a/closures/compiler/aasmbase.pas b/closures/compiler/aasmbase.pas new file mode 100644 index 0000000000..7cc2e56c16 --- /dev/null +++ b/closures/compiler/aasmbase.pas @@ -0,0 +1,435 @@ +{ + 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 overridden 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 + TAsmsymbind=( + AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL,AB_WEAK_EXTERNAL, + { global in the current program/library, but not visible outside it } + AB_PRIVATE_EXTERN,AB_LAZY,AB_IMPORT); + + TAsmsymtype=( + AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL, + { + the address of this code label is taken somewhere in the code + so it must be taken care of it when creating pic + } + AT_ADDR + ); + + { is the label only there for getting an DataOffset (e.g. for i/o + checks -> alt_addr) or is it a jump target (alt_jump), for debug + info alt_dbgline and alt_dbgfile, etc. } + TAsmLabelType = (alt_jump,alt_addr,alt_data,alt_dbgline,alt_dbgfile,alt_dbgtype,alt_dbgframe); + + const + asmlabeltypeprefix : array[TAsmLabeltype] of char = ('j','a','d','l','f','t','c'); + + type + TAsmSectiontype=(sec_none, + { this section type allows to define a user named section } + sec_user, + sec_code, + sec_data, + { read-only, but may contain relocations } + sec_rodata, + { read-only and cannot contain relocations } + sec_rodata_norel, + sec_bss, + sec_threadvar, + { used for wince exception handling } + sec_pdata, + { used for darwin import stubs } + sec_stub, + sec_data_nonlazy, + sec_data_lazy, + sec_init_func, + sec_term_func, + { 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, + sec_debug_info, + sec_debug_line, + sec_debug_abbrev, + { Yury: "sec_fpc is intended for storing fpc specific data + which must be recognized and processed specially by linker. + Currently fpc version string, dummy links to stab sections + and elf resources are stored in .fpc sections." + "If special .fpc section cannot be used on some target, + .text can be used instead." } + sec_fpc, + { Table of contents section } + sec_toc, + sec_init, + sec_fini, + {Objective-C common and fragile ABI } + sec_objc_class, + sec_objc_meta_class, + sec_objc_cat_cls_meth, + sec_objc_cat_inst_meth, + sec_objc_protocol, + sec_objc_string_object, + sec_objc_cls_meth, + sec_objc_inst_meth, + sec_objc_cls_refs, + sec_objc_message_refs, + sec_objc_symbols, + sec_objc_category, + sec_objc_class_vars, + sec_objc_instance_vars, + sec_objc_module_info, + sec_objc_class_names, + sec_objc_meth_var_types, + sec_objc_meth_var_names, + sec_objc_selector_strs, + sec_objc_protocol_ext, + sec_objc_class_ext, + sec_objc_property, + sec_objc_image_info, + sec_objc_cstring_object, + sec_objc_sel_fixup, + { Objective-C non-fragile ABI } + sec_objc_data, + sec_objc_const, + sec_objc_sup_refs, + sec_data_coalesced, + sec_objc_classlist, + sec_objc_nlclasslist, + sec_objc_catlist, + sec_objc_nlcatlist, + sec_objc_protolist + ); + + TAsmSectionOrder = (secorder_begin,secorder_default,secorder_end); + + TAsmSymbol = class(TFPHashObject) + private + { this need to be incremented with every symbol loading into the + TAsmList with loadsym/loadref/const_symbol (PFV) } + refs : longint; + public + { on avr the compiler needs to replace cond. jumps with too large offsets + so we have to store an offset somewhere to calculate jump distances } +{$ifdef AVR} + offset : longint; +{$endif AVR} + bind : TAsmsymbind; + typ : TAsmsymtype; + { Alternate symbol which can be used for 'renaming' needed for + asm inlining. Also used for external and common solving during linking } + altsymbol : TAsmSymbol; + { Cached objsymbol } + cachedobjsymbol : TObject; + constructor Create(AList:TFPHashObjectList;const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype); + function getaltcopy(AList:TFPHashObjectList;altnr: longint): TAsmSymbol; virtual; + function is_used:boolean; + procedure increfs; + procedure decrefs; + function getrefs: longint; + end; + TAsmSymbolClass = class of TAsmSymbol; + + TAsmLabel = class(TAsmSymbol) + protected + function getname:string;override; + public + labelnr : longint; + labeltype : TAsmLabelType; + is_set : boolean; + constructor Createlocal(AList:TFPHashObjectList;nr:longint;ltyp:TAsmLabelType); + constructor Createglobal(AList:TFPHashObjectList;const modulename:string;nr:longint;ltyp:TAsmLabelType); + function getaltcopy(AList:TFPHashObjectList;altnr: longint): TAsmSymbol; override; + end; + + function create_smartlink_sections:boolean;inline; + function create_smartlink_library:boolean;inline; + function create_smartlink:boolean;inline; + + function LengthUleb128(a: qword) : byte; + function LengthSleb128(a: int64) : byte; + function EncodeUleb128(a: qword;out buf) : byte; + function EncodeSleb128(a: int64;out buf) : byte; + + +implementation + + uses + SysUtils, + verbose; + + + function create_smartlink_sections:boolean;inline; + begin + result:=(af_smartlink_sections in target_asm.flags) and + (tf_smartlink_sections in target_info.flags); + end; + + + function create_smartlink_library:boolean;inline; + begin + result:=(cs_Create_smart in current_settings.moduleswitches) and + (tf_smartlink_library in target_info.flags) and + not create_smartlink_sections; + end; + + + function create_smartlink:boolean;inline; + begin + result:=( + (af_smartlink_sections in target_asm.flags) and + (tf_smartlink_sections in target_info.flags) + ) or + ( + (cs_Create_smart in current_settings.moduleswitches) and + (tf_smartlink_library in target_info.flags) + ); + end; + + + function LengthUleb128(a: qword) : byte; + begin + result:=0; + repeat + a := a shr 7; + inc(result); + if a=0 then + break; + until false; + end; + + + function LengthSleb128(a: int64) : byte; + var + b, size: byte; + asign : int64; + neg, more: boolean; + begin + more := true; + neg := a < 0; + size := sizeof(a)*8; + result:=0; + repeat + b := a and $7f; + a := a shr 7; + if neg then + begin + { Use a variable to be sure that the correct or mask is generated } + asign:=1; + asign:=asign shl (size - 7); + a := a or -asign; + end; + if (((a = 0) and + (b and $40 = 0)) or + ((a = -1) and + (b and $40 <> 0))) then + more := false; + inc(result); + if not(more) then + break; + until false; + end; + + + function EncodeUleb128(a: qword;out buf) : byte; + var + b: byte; + pbuf : pbyte; + begin + result:=0; + pbuf:=@buf; + repeat + b := a and $7f; + a := a shr 7; + if a<>0 then + b := b or $80; + pbuf^:=b; + inc(pbuf); + inc(result); + if a=0 then + break; + until false; + end; + + + function EncodeSleb128(a: int64;out buf) : byte; + var + b, size: byte; + asign : int64; + neg, more: boolean; + pbuf : pbyte; + begin + more := true; + neg := a < 0; + size := sizeof(a)*8; + result:=0; + pbuf:=@buf; + repeat + b := a and $7f; + a := a shr 7; + if neg then + begin + { Use a variable to be sure that the correct or mask is generated } + asign:=1; + asign:=asign shl (size - 7); + a := a or -asign; + end; + if (((a = 0) and + (b and $40 = 0)) or + ((a = -1) and + (b and $40 <> 0))) then + more := false + else + b := b or $80; + pbuf^:=b; + inc(pbuf); + inc(result); + if not(more) then + break; + until false; + end; + + +{***************************************************************************** + TAsmSymbol +*****************************************************************************} + + constructor TAsmSymbol.Create(AList:TFPHashObjectList;const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype); + begin; + inherited Create(AList,s); + bind:=_bind; + typ:=_typ; + { used to remove unused labels from the al_procedures } + refs:=0; + end; + + + function TAsmSymbol.getaltcopy(AList:TFPHashObjectList;altnr: longint): TAsmSymbol; + begin + result := TAsmSymbol(TAsmSymbolClass(classtype).Create(AList,name+'_'+tostr(altnr),bind,typ)); + 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; + + +{***************************************************************************** + TAsmLabel +*****************************************************************************} + + constructor TAsmLabel.Createlocal(AList:TFPHashObjectList;nr:longint;ltyp:TAsmLabelType); + var + asmtyp: TAsmsymtype; + begin + case ltyp of + alt_addr: + asmtyp:=AT_ADDR; + alt_data: + asmtyp:=AT_DATA; + else + asmtyp:=AT_LABEL; + end; + inherited Create(AList,target_asm.labelprefix+asmlabeltypeprefix[ltyp]+tostr(nr),AB_LOCAL,asmtyp); + labelnr:=nr; + labeltype:=ltyp; + is_set:=false; + end; + + + constructor TAsmLabel.Createglobal(AList:TFPHashObjectList;const modulename:string;nr:longint;ltyp:TAsmLabelType); + begin + inherited Create(AList,'_$'+modulename+'$_L'+asmlabeltypeprefix[ltyp]+tostr(nr),AB_GLOBAL,AT_DATA); + labelnr:=nr; + labeltype:=ltyp; + is_set:=false; + { write it always } + increfs; + end; + + + function TAsmLabel.getaltcopy(AList:TFPHashObjectList;altnr: longint): TAsmSymbol; + begin; + result := inherited getaltcopy(AList,altnr); + TAsmLabel(result).labelnr:=labelnr; + TAsmLabel(result).labeltype:=labeltype; + TAsmLabel(result).is_set:=false; + case bind of + AB_GLOBAL, + AB_PRIVATE_EXTERN: + result.increfs; + AB_LOCAL: + ; + else + internalerror(2006053101); + end; + end; + + + function TAsmLabel.getname:string; + begin + getname:=inherited getname; + increfs; + end; + +end. diff --git a/closures/compiler/aasmdata.pas b/closures/compiler/aasmdata.pas new file mode 100644 index 0000000000..bc9065ca5d --- /dev/null +++ b/closures/compiler/aasmdata.pas @@ -0,0 +1,525 @@ +{ + Copyright (c) 1998-2006 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 overridden for each assembler writer to actually write the data in these + classes to an assembler file. +} + +unit aasmdata; + +{$i fpcdefs.inc} + +interface + + uses + cutils,cclasses, + globtype,globals,systems, + cpuinfo,cpubase, + cgbase,cgutils, + symtype, + aasmbase,ogbase; + + type + { 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) } + TAsmListType=( + al_start, + al_stabs, + al_procedures, + al_globals, + al_const, + al_typedconsts, + al_rotypedconsts, + al_threadvars, + al_imports, + al_exports, + al_resources, + al_rtti, + al_dwarf_frame, + al_dwarf_info, + al_dwarf_abbrev, + al_dwarf_line, + al_picdata, + al_resourcestrings, + { Objective-C related sections } + al_objc_data, + { keep pool data separate, so we can generate new pool entries + while emitting other data } + al_objc_pools, + al_end + ); + + { Type of constant 'pools'. Mostly for string types, but usable for + floating point and large set constants, too. } + + TConstPoolType = ( + sp_invalid, + sp_conststr, + sp_shortstr, + sp_longstr, + sp_ansistr, + sp_widestr, + sp_unicodestr, + sp_objcclassnamerefs, + sp_varnamerefs, + sp_objcclassnames, + sp_objcvarnames, + sp_objcvartypes, + sp_objcprotocolrefs, + sp_varsets, + sp_floats + ); + + const + AsmListTypeStr : array[TAsmListType] of string[24] =( + 'al_begin', + 'al_stabs', + 'al_procedures', + 'al_globals', + 'al_const', + 'al_typedconsts', + 'al_rotypedconsts', + 'al_threadvars', + 'al_imports', + 'al_exports', + 'al_resources', + 'al_rtti', + 'al_dwarf_frame', + 'al_dwarf_info', + 'al_dwarf_abbrev', + 'al_dwarf_line', + 'al_picdata', + 'al_resourcestrings', + 'al_objc_data', + 'al_objc_pools', + 'al_end' + ); + + type + TAsmList = class(tlinkedlist) + constructor create; + function empty : boolean; + function getlasttaifilepos : pfileposinfo; + end; + + TAsmCFI=class + public + constructor create;virtual; + destructor destroy;override; + procedure generate_code(list:TAsmList);virtual; + procedure start_frame(list:TAsmList);virtual; + procedure end_frame(list:TAsmList);virtual; + procedure cfa_offset(list:TAsmList;reg:tregister;ofs:longint);virtual; + procedure cfa_restore(list:TAsmList;reg:tregister);virtual; + procedure cfa_def_cfa_register(list:TAsmList;reg:tregister);virtual; + procedure cfa_def_cfa_offset(list:TAsmList;ofs:longint);virtual; + end; + TAsmCFIClass=class of TAsmCFI; + + { TAsmData } + + TAsmData = class + private + { Symbols } + FAsmSymbolDict : TFPHashObjectList; + FAltSymbolList : TFPObjectList; + FNextAltNr : longint; + FNextLabelNr : array[TAsmLabeltype] of longint; + { Call Frame Information for stack unwinding} + FAsmCFI : TAsmCFI; + FConstPools : array[TConstPoolType] of THashSet; + function GetConstPools(APoolType: TConstPoolType): THashSet; + public + name, + realname : string[80]; + NextVTEntryNr : longint; + { Assembler lists } + AsmLists : array[TAsmListType] of TAsmList; + CurrAsmList : TAsmList; + WideInits : TLinkedList; + ResStrInits : TLinkedList; + constructor create(const n:string); + destructor destroy;override; + { asmsymbol } + function DefineAsmSymbol(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol; + function WeakRefAsmSymbol(const s : string) : TAsmSymbol; + function RefAsmSymbol(const s : string) : TAsmSymbol; + function GetAsmSymbol(const s : string) : TAsmSymbol; + { create new assembler label } + procedure getlabel(out l : TAsmLabel;alt:TAsmLabeltype); + procedure getjumplabel(out l : TAsmLabel); + procedure getglobaljumplabel(out l : TAsmLabel); + procedure getaddrlabel(out l : TAsmLabel); + procedure getdatalabel(out l : TAsmLabel); + { generate an alternative (duplicate) symbol } + procedure GenerateAltSymbol(p:TAsmSymbol); + procedure ResetAltSymbols; + property AsmSymbolDict:TFPHashObjectList read FAsmSymbolDict; + property AsmCFI:TAsmCFI read FAsmCFI; + { hash tables for reusing constant storage } + property ConstPools[APoolType:TConstPoolType]: THashSet read GetConstPools; + end; + + TTCInitItem = class(TLinkedListItem) + sym: tsym; + offset: aint; + datalabel: TAsmSymbol; + constructor Create(asym: tsym; aoffset: aint; alabel: TAsmSymbol); + end; + + var + CAsmCFI : TAsmCFIClass; + current_asmdata : TAsmData; + + +implementation + + uses + verbose, + aasmtai; + +{$ifdef MEMDEBUG} + var + memasmsymbols, + memasmcfi, + memasmlists : TMemDebug; +{$endif MEMDEBUG} + + +{***************************************************************************** + TAsmCFI +*****************************************************************************} + + constructor TAsmCFI.create; + begin + end; + + + destructor TAsmCFI.destroy; + begin + end; + + + procedure TAsmCFI.generate_code(list:TAsmList); + begin + end; + + + procedure TAsmCFI.start_frame(list:TAsmList); + begin + end; + + + procedure TAsmCFI.end_frame(list:TAsmList); + begin + end; + + + procedure TAsmCFI.cfa_offset(list:TAsmList;reg:tregister;ofs:longint); + begin + end; + + + procedure TAsmCFI.cfa_restore(list:TAsmList;reg:tregister); + begin + end; + + + procedure TAsmCFI.cfa_def_cfa_register(list:TAsmList;reg:tregister); + begin + end; + + + procedure TAsmCFI.cfa_def_cfa_offset(list:TAsmList;ofs:longint); + begin + end; + +{***************************************************************************** + TTCInitItem +*****************************************************************************} + + + constructor TTCInitItem.Create(asym: tsym; aoffset: aint; alabel: TAsmSymbol); + begin + inherited Create; + sym:=asym; + offset:=aoffset; + datalabel:=alabel; + end; + +{***************************************************************************** + TAsmList +*****************************************************************************} + + constructor TAsmList.create; + begin + inherited create; + { make sure the optimizer won't remove the first tai of this list} + insert(tai_marker.create(mark_BlockStart)); + end; + + + function TAsmList.empty : boolean; + begin + { there is always a mark_BlockStart available, + see TAsmList.create } + result:=(count<=1); + end; + + + function TAsmList.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; + + +{**************************************************************************** + TAsmData +****************************************************************************} + + function TAsmData.GetConstPools(APoolType: TConstPoolType): THashSet; + begin + if FConstPools[APoolType] = nil then + case APoolType of + sp_ansistr: FConstPools[APoolType] := TTagHashSet.Create(64, True, False); + else + FConstPools[APoolType] := THashSet.Create(64, True, False); + end; + Result := FConstPools[APoolType]; + end; + + constructor TAsmData.create(const n:string); + var + alt : TAsmLabelType; + hal : TAsmListType; + begin + inherited create; + realname:=n; + name:=upper(n); + { symbols } + FAsmSymbolDict:=TFPHashObjectList.create(true); + FAltSymbolList:=TFPObjectList.Create(false); + { labels } + FNextAltNr:=1; + for alt:=low(TAsmLabelType) to high(TAsmLabelType) do + FNextLabelNr[alt]:=1; + { AsmLists } + CurrAsmList:=TAsmList.create; + for hal:=low(TAsmListType) to high(TAsmListType) do + AsmLists[hal]:=TAsmList.create; + WideInits :=TLinkedList.create; + ResStrInits:=TLinkedList.create; + { CFI } + FAsmCFI:=CAsmCFI.Create; + end; + + + destructor TAsmData.destroy; + var + hal : TAsmListType; + hp : TConstPoolType; + begin + { Symbols } +{$ifdef MEMDEBUG} + memasmsymbols.start; +{$endif} + FAltSymbolList.free; + FAsmSymbolDict.free; +{$ifdef MEMDEBUG} + memasmsymbols.stop; +{$endif} + { CFI } +{$ifdef MEMDEBUG} + memasmcfi.start; +{$endif} + FAsmCFI.free; +{$ifdef MEMDEBUG} + memasmcfi.stop; +{$endif} + { Lists } +{$ifdef MEMDEBUG} + memasmlists.start; +{$endif} + ResStrInits.free; + WideInits.free; + for hal:=low(TAsmListType) to high(TAsmListType) do + AsmLists[hal].free; + CurrAsmList.free; +{$ifdef MEMDEBUG} + memasmlists.stop; +{$endif} + for hp := low(TConstPoolType) to high(TConstPoolType) do + FConstPools[hp].Free; + end; + + + function TAsmData.DefineAsmSymbol(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : TAsmSymbol; + var + hp : TAsmSymbol; + begin + hp:=TAsmSymbol(FAsmSymbolDict.Find(s)); + if assigned(hp) then + begin + { Redefine is allowed, but the types must be the same. The redefine + is needed for Darwin where the labels are first allocated } + if (hp.bind<>AB_EXTERNAL) then + begin + if (hp.bind<>_bind) and + (hp.typ<>_typ) then + internalerror(200603261); + end; + hp.typ:=_typ; + hp.bind:=_bind; + end + else + begin + { Not found, insert it. } + hp:=TAsmSymbol.create(AsmSymbolDict,s,_bind,_typ); + end; + result:=hp; + end; + + + function TAsmData.RefAsmSymbol(const s : string) : TAsmSymbol; + begin + result:=TAsmSymbol(FAsmSymbolDict.Find(s)); + if not assigned(result) then + result:=TAsmSymbol.create(AsmSymbolDict,s,AB_EXTERNAL,AT_NONE) + { one normal reference removes the "weak" character of a symbol } + else if (result.bind=AB_WEAK_EXTERNAL) then + result.bind:=AB_EXTERNAL; + end; + + + function TAsmData.WeakRefAsmSymbol(const s : string) : TAsmSymbol; + begin + result:=TAsmSymbol(FAsmSymbolDict.Find(s)); + if not assigned(result) then + result:=TAsmSymbol.create(AsmSymbolDict,s,AB_WEAK_EXTERNAL,AT_NONE); + end; + + + function TAsmData.GetAsmSymbol(const s : string) : TAsmSymbol; + begin + result:=TAsmSymbol(FAsmSymbolDict.Find(s)); + end; + + + procedure TAsmData.GenerateAltSymbol(p:TAsmSymbol); + begin + if not assigned(p.altsymbol) then + begin + p.altsymbol:=p.getaltcopy(AsmSymbolDict,FNextAltNr); + FAltSymbolList.Add(p); + end; + end; + + + procedure TAsmData.ResetAltSymbols; + var + i : longint; + begin + for i:=0 to FAltSymbolList.Count-1 do + TAsmSymbol(FAltSymbolList[i]).altsymbol:=nil; + FAltSymbolList.Clear; + end; + + + procedure TAsmData.getlabel(out l : TAsmLabel;alt:TAsmLabeltype); + begin + if (target_info.system in (systems_linux + systems_bsd)) and + (cs_create_smart in current_settings.moduleswitches) and + (alt = alt_dbgline) then + l:=TAsmLabel.createglobal(AsmSymbolDict,name,FNextLabelNr[alt],alt) + else + l:=TAsmLabel.createlocal(AsmSymbolDict,FNextLabelNr[alt],alt); + inc(FNextLabelNr[alt]); + end; + + + procedure TAsmData.getjumplabel(out l : TAsmLabel); + begin + l:=TAsmLabel.createlocal(AsmSymbolDict,FNextLabelNr[alt_jump],alt_jump); + inc(FNextLabelNr[alt_jump]); + end; + + procedure TAsmData.getglobaljumplabel(out l : TAsmLabel); + begin + l:=TAsmLabel.createglobal(AsmSymbolDict,name,FNextLabelNr[alt_jump],alt_jump); + inc(FNextLabelNr[alt_jump]); + end; + + procedure TAsmData.getdatalabel(out l : TAsmLabel); + begin + l:=TAsmLabel.createglobal(AsmSymbolDict,name,FNextLabelNr[alt_data],alt_data); + inc(FNextLabelNr[alt_data]); + end; + + + procedure TAsmData.getaddrlabel(out l : TAsmLabel); + begin + l:=TAsmLabel.createlocal(AsmSymbolDict,FNextLabelNr[alt_addr],alt_addr); + inc(FNextLabelNr[alt_addr]); + end; + +initialization +{$ifdef MEMDEBUG} + memasmsymbols:=TMemDebug.create('AsmSymbols'); + memasmsymbols.stop; + memasmcfi:=TMemDebug.create('AsmCFI'); + memasmcfi.stop; + memasmlists:=TMemDebug.create('AsmLists'); + memasmlists.stop; +{$endif MEMDEBUG} + CAsmCFI:=TAsmCFI; + +finalization +{$ifdef MEMDEBUG} + memasmsymbols.free; + memasmcfi.free; + memasmlists.free; +{$endif MEMDEBUG} + +end. diff --git a/closures/compiler/aasmsym.pas b/closures/compiler/aasmsym.pas new file mode 100644 index 0000000000..f9287ce1f8 --- /dev/null +++ b/closures/compiler/aasmsym.pas @@ -0,0 +1,71 @@ +{ + Copyright (c) 1998-2007 by Florian Klaempfl and Peter Vreman + + Contains abstract assembler instructions for all processor + types, including routines which depend on the symbol table. + These cannot be in aasmtai, because the symbol table units + depend on that one. + + * Portions of this code was inspired by the NASM sources + The Netwide Assembler is Copyright (c) 1996 Simon Tatham and + Julian Hall. All rights reserved. + + 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 aasmsym; + +{$i fpcdefs.inc} + +interface + + uses + aasmtai; + + type + tai_cpu_abstract_sym = class(tai_cpu_abstract) + protected + procedure ppubuildderefimploper(var o:toper);override; + procedure ppuderefoper(var o:toper);override; + end; + +implementation + + uses + symsym; + + + procedure tai_cpu_abstract_sym.ppubuildderefimploper(var o:toper); + begin + case o.typ of + top_local : + o.localoper^.localsymderef.build(tlocalvarsym(o.localoper^.localsym)); + end; + end; + + + procedure tai_cpu_abstract_sym.ppuderefoper(var o:toper); + begin + case o.typ of + top_ref : + begin + end; + top_local : + o.localoper^.localsym:=tlocalvarsym(o.localoper^.localsymderef.resolve); + end; + end; + +end. \ No newline at end of file diff --git a/closures/compiler/aasmtai.pas b/closures/compiler/aasmtai.pas new file mode 100644 index 0000000000..7b511a8b2b --- /dev/null +++ b/closures/compiler/aasmtai.pas @@ -0,0 +1,2654 @@ +{ + Copyright (c) 1998-2006 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 overridden 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,systems, + cpuinfo,cpubase, + cgbase,cgutils, + symtype, + aasmbase,aasmdata,ogbase; + + type + { keep the number of elements in this enumeration less or equal than 32 as long + as FPC knows only 4 byte and 32 byte sets (FK) } + taitype = ( + ait_none, + ait_align, + ait_section, + ait_comment, + ait_string, + ait_instruction, + ait_datablock, + ait_symbol, + { needed to calc the size of a symbol } + ait_symbol_end, + ait_directive, + ait_label, + ait_const, + 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} +{$ifdef arm} + ait_thumb_func, +{$endif arm} + { used to split into tiny assembler files } + ait_cutobject, + ait_regalloc, + ait_tempalloc, + { used to mark assembler blocks and inlined functions } + ait_marker, + { used to describe a new location of a variable } + ait_varloc, + { SEH directives used in ARM,MIPS and x86_64 COFF targets } + ait_seh_directive + ); + + taiconst_type = ( + aitconst_128bit, + aitconst_64bit, + aitconst_32bit, + aitconst_16bit, + aitconst_8bit, + aitconst_sleb128bit, + aitconst_uleb128bit, + { win32 only } + aitconst_rva_symbol, + aitconst_secrel32_symbol, + { darwin only } + { From gcc/config/darwin.c (darwin_asm_output_dwarf_delta): + *** + Output a difference of two labels that will be an assembly time + constant if the two labels are local. (.long lab1-lab2 will be + very different if lab1 is at the boundary between two sections; it + will be relocated according to the second section, not the first, + so one ends up with a difference between labels in different + sections, which is bad in the dwarf2 eh context for instance.) + *** + We cannot use this everywhere, because older versions of the + darwin assembler don't support the construct used for these + relsyms (nor do they support dwarf, for that matter) + } + aitconst_darwin_dwarf_delta64, + aitconst_darwin_dwarf_delta32, + { ARM Thumb-2 only } + aitconst_half16bit { used for table jumps. The actual value is the 16bit value shifted left once } + ); + + const +{$ifdef cpu64bitaddr} + aitconst_ptr = aitconst_64bit; +{$else cpu64bitaddr} + aitconst_ptr = aitconst_32bit; +{$endif cpu64bitaddr} + +{$ifdef cpu64bitalu} + aitconst_aint = aitconst_64bit; +{$else cpu64bitaddr} + aitconst_aint = aitconst_32bit; +{$endif cpu64bitaddr} + + taitypestr : array[taitype] of string[24] = ( + '', + 'align', + 'section', + 'comment', + 'string', + 'instruction', + 'datablock', + 'symbol', + 'symbol_end', + 'symbol_directive', + 'label', + 'const', + '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} +{$ifdef arm} + 'thumb_func', +{$endif arm} + 'cut', + 'regalloc', + 'tempalloc', + 'marker', + 'varloc', + 'seh_directive' + ); + + 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 + ,top_conditioncode + ,top_modeflags +{$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:tcgint); + top_bool : (b:boolean); + { local varsym that will be inserted in pass_generate_code } + top_local : (localoper:plocaloper); + {$ifdef arm} + top_regset : (regset:^tcpuregisterset; regtyp: tregistertype; subreg: tsubregister); + top_shifterop : (shifterop : pshifterop); + top_conditioncode : (cc : TAsmCond); + top_modeflags : (modeflags : tcpumodeflags); + {$endif arm} + {$ifdef m68k} + top_regset : (regset:^tcpuregisterset); + {$endif m68k} + end; + poper=^toper; + + const + { 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! } + 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_varloc,ait_seh_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_varloc,ait_align,ait_section,ait_comment, + ait_const, +{$ifdef arm} + ait_thumb_func, +{$endif arm} + ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_real_128bit, + ait_symbol, + ait_seh_directive + ]; + + + type + { cut type, required for alphanumeric ordering of the assembler filenames } + TCutPlace=(cut_normal,cut_begin,cut_end); + + TAsmMarker = ( + mark_NoPropInfoStart,mark_NoPropInfoEnd, + mark_AsmBlockStart,mark_AsmBlockEnd, + mark_NoLineInfoStart,mark_NoLineInfoEnd,mark_BlockStart, + mark_Position + ); + + TRegAllocType = (ra_alloc,ra_dealloc,ra_sync,ra_resize); + + TStabType = (stab_stabs,stab_stabn,stab_stabd); + + TAsmDirective=( + asd_indirect_symbol, + asd_extern,asd_nasm_import, asd_toc_entry, + asd_reference,asd_no_dead_strip,asd_weak_reference,asd_lazy_reference, + asd_weak_definition + ); + + TAsmSehDirective=( + ash_proc,ash_endproc, + ash_endprologue,ash_handler,ash_handlerdata, + ash_eh,ash_32,ash_no32, + ash_setframe,ash_stackalloc,ash_pushreg, + ash_savereg,ash_savexmm,ash_pushframe + ); + + + const + 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[23]=( + 'indirect_symbol', + 'extern','nasm_import', 'tc', 'reference', + 'no_dead_strip','weak_reference','lazy_reference','weak_definition' + ); + sehdirectivestr : array[TAsmSehDirective] of string[16]=( + '.seh_proc','.seh_endproc', + '.seh_endprologue','.seh_handler','.seh_handlerdata', + '.seh_eh','.seh_32','seh_no32', + '.seh_setframe','.seh_stackalloc','.seh_pushreg', + '.seh_savereg','.seh_savexmm','.seh_pushframe' + ); + + type + { 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(tai) + sym : tasmsymbol; + value : puint; + size : longint; + is_global, + has_value : boolean; + 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 Createname_global_value(const _name : string;_symtyp:Tasmsymtype;siz:longint;val:ptruint); + 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; + + tai_directive = class(tailineinfo) + name : pshortstring; + 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; + labsym : tasmlabel; + constructor Create(_labsym : 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; + secorder : TasmSectionorder; + secalign : byte; + name : pshortstring; + sec : TObjSection; { used in binary writer } + destructor Destroy;override; + constructor ppuload(t:taitype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; +{$push}{$warnings off} + private + { this constructor is made private on purpose } + { because sections should be created via new_section() } + constructor Create(Asectype:TAsmSectiontype;const Aname:string;Aalign:byte;Asecorder:TasmSectionorder=secorder_default); +{$pop} + end; + + + { Generates an uninitializised data block } + tai_datablock = class(tailineinfo) + is_global : boolean; + sym : tasmsymbol; + size : asizeint; + constructor Create(const _name : string;_size : aint); + constructor Create_global(const _name : string;_size : asizeint); + constructor ppuload(t:taitype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure derefimpl;override; + end; + + + { Generates an integer const } + tai_const = class(tai) + sym, + endsym : tasmsymbol; + { if symbols and offset are provided the symofs is used, + the value is calculated during assembling } + symofs, + value : int64; + consttype : taiconst_type; + { 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:taiconst_type;_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_char(size: integer; _value: dword); + constructor Create_sleb128bit(_value : int64); + constructor Create_uleb128bit(_value : qword); + constructor Create_aint(_value : aint); + constructor Create_pint(_value : pint); + constructor Create_sym(_sym:tasmsymbol); + constructor Create_type_sym(_typ:taiconst_type;_sym:tasmsymbol); + constructor Create_sym_offset(_sym:tasmsymbol;ofs:aint); + constructor Create_rel_sym(_typ:taiconst_type;_sym,_endsym:tasmsymbol); + constructor Create_rva_sym(_sym:tasmsymbol); + constructor Createname(const name:string;ofs:aint); + 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; + savesize : byte; + constructor Create(_value : ts80real; _savesize: byte); + 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; + + { tai_stab } + + tai_stab = class(tai) + str : pchar; + stabtype : TStabType; + constructor Create(_stabtype:TStabType;_str : pchar); + constructor Create_str(_stabtype:TStabType;const s:string); + constructor create_ansistr(_stabtype: TStabType; const s: ansistring); + destructor Destroy;override; + end; + + tai_force_line = class(tailineinfo) + constructor Create; + end; + + tai_function_name = class(tai) + funcname : pshortstring; + 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: TAsmMarker; + Constructor Create(_Kind: TAsmMarker); + constructor ppuload(t:taitype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + end; + + tai_tempalloc = class(tai) + allocation : boolean; +{$ifdef EXTDEBUG} + problem : pshortstring; +{$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; + + tadd_reg_instruction_proc=procedure(instr:Tai;r:tregister) of object; + + { Class template for assembler instructions + } + tai_cpu_abstract = class(tailineinfo) + protected + procedure ppuloadoper(ppufile:tcompilerppufile;var o:toper);virtual; + procedure ppuwriteoper(ppufile:tcompilerppufile;const o:toper);virtual; + 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); + procedure freeop(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(objdata:TObjData):longint;virtual; + procedure Pass2(objdata:TObjData);virtual; + + procedure resetpass1; virtual; + procedure resetpass2; virtual; + end; + tai_cpu_class = class of tai_cpu_abstract; + + { Buffer type used for alignment } + tfillbuffer = array[0..63] of char; + + { 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;executable : boolean):pchar;virtual; + end; + tai_align_class = class of tai_align_abstract; + + tai_varloc = class(tai) + newlocation, + newlocationhi : tregister; + varsym : tsym; + constructor create(sym : tsym;loc : tregister); + constructor create64(sym : tsym;loc,lochi : tregister); + constructor ppuload(t:taitype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + end; + + TSehDirectiveDatatype=(sd_none,sd_string,sd_reg,sd_offset,sd_regoffset); + + TSehDirectiveData=record + case typ: TSehDirectiveDatatype of + sd_none: (); + sd_string: (name:pshortstring;flags:byte); + sd_reg,sd_offset,sd_regoffset: (reg:TRegister;offset:dword); + end; + + tai_seh_directive = class(tai) + kind: TAsmSehDirective; + data: TSehDirectiveData; + constructor create(_kind:TAsmSehDirective); + constructor create_name(_kind:TAsmSehDirective;const _name: string); + constructor create_reg(_kind:TAsmSehDirective;r:TRegister); + constructor create_offset(_kind:TAsmSehDirective;ofs:dword); + constructor create_reg_offset(_kind:TAsmSehDirective;r:TRegister;ofs:dword); + constructor ppuload(t:taitype;ppufile:tcompilerppufile);override; + destructor destroy;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure generate_code(objdata:TObjData);virtual; + property datatype: TSehDirectiveDatatype read data.typ; + end; + tai_seh_directive_class=class of tai_seh_directive; + + var + { array with all class types for tais } + aiclass : taiclassarray; + + { target specific tais, possibly overwritten in target specific aasmcpu } + cai_align : tai_align_class = tai_align_abstract; + cai_cpu : tai_cpu_class = tai_cpu_abstract; + cai_seh_directive: tai_seh_directive_class = tai_seh_directive; + + { hook to notify uses of registers } + add_reg_instruction_hook : tadd_reg_instruction_proc; + + procedure maybe_new_object_file(list:TAsmList); + procedure new_section(list:TAsmList;Asectype:TAsmSectiontype;const Aname:string;Aalign:byte;Asecorder:TasmSectionorder=secorder_default); + procedure section_symbol_start(list:TAsmList;const Aname:string;Asymtyp:Tasmsymtype; + Aglobal:boolean;Asectype:TAsmSectiontype;Aalign:byte); + procedure section_symbol_end(list:TAsmList;const Aname:string); + + function ppuloadai(ppufile:tcompilerppufile):tai; + procedure ppuwriteai(ppufile:tcompilerppufile;n:tai); + + +implementation + + uses + SysUtils, + verbose, + globals, + fmodule; + + const + pputaimarker = 254; + + +{**************************************************************************** + Helpers + ****************************************************************************} + + procedure maybe_new_object_file(list:TAsmList); + begin + if create_smartlink_library then + list.concat(tai_cutobject.create); + end; + + + procedure new_section(list:TAsmList;Asectype:TAsmSectiontype;const Aname:string;Aalign:byte;Asecorder:TasmSectionorder=secorder_default); + begin + list.concat(tai_section.create(Asectype,Aname,Aalign,Asecorder)); + list.concat(cai_align.create(Aalign)); + end; + + + procedure section_symbol_start(list:TAsmList;const Aname:string;Asymtyp:Tasmsymtype; + Aglobal:boolean;Asectype:TAsmSectiontype;Aalign:byte); + begin + maybe_new_object_file(list); + new_section(list,Asectype,Aname,Aalign); + if Aglobal or + create_smartlink 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:TAsmList;const Aname:string); + begin + list.concat(tai_symbol_end.createname(Aname)); + end; + + + 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; + + + constructor tai_varloc.create(sym: tsym; loc: tregister); + begin + inherited Create; + typ:=ait_varloc; + newlocation:=loc; + newlocationhi:=NR_NO; + varsym:=sym; + end; + + + constructor tai_varloc.create64(sym: tsym; loc: tregister;lochi : tregister); + begin + inherited Create; + typ:=ait_varloc; + newlocation:=loc; + newlocationhi:=lochi; + varsym:=sym; + end; + + + constructor tai_varloc.ppuload(t: taitype; ppufile: tcompilerppufile); + begin + inherited ppuload(t, ppufile); + end; + + + procedure tai_varloc.ppuwrite(ppufile: tcompilerppufile); + begin + inherited ppuwrite(ppufile); + end; + + + procedure tai_varloc.buildderefimpl; + begin + inherited buildderefimpl; + end; + + + procedure tai_varloc.derefimpl; + begin + inherited derefimpl; + 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; + fileinfo:=current_filepos; + 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;const Aname:string;Aalign:byte;Asecorder:TasmSectionorder=secorder_default); + begin + inherited Create; + typ:=ait_section; + sectype:=asectype; + secalign:=Aalign; + secorder:=Asecorder; + 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 : aint); + + begin + inherited Create; + typ:=ait_datablock; + sym:=current_asmdata.DefineAsmSymbol(_name,AB_LOCAL,AT_DATA); + { keep things aligned } + if _size<=0 then + _size:=sizeof(aint); + size:=_size; + is_global:=false; + end; + + + constructor tai_datablock.Create_global(const _name : string;_size : asizeint); + begin + inherited Create; + typ:=ait_datablock; + sym:=current_asmdata.DefineAsmSymbol(_name,AB_GLOBAL,AT_DATA); + { keep things aligned } + if _size<=0 then + _size:=sizeof(aint); + size:=_size; + is_global:=true; + end; + + + constructor tai_datablock.ppuload(t:taitype;ppufile:tcompilerppufile); + begin + inherited Create; + sym:=ppufile.getasmsymbol; + size:=ppufile.getaint; + is_global:=boolean(ppufile.getbyte); + end; + + + procedure tai_datablock.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putasmsymbol(sym); + ppufile.putaint(size); + ppufile.putbyte(byte(is_global)); + end; + + + procedure tai_datablock.derefimpl; + begin + end; + + +{**************************************************************************** + TAI_SYMBOL + ****************************************************************************} + + constructor tai_symbol.Create(_sym:tasmsymbol;siz:longint); + begin + inherited Create; + typ:=ait_symbol; + sym:=_sym; + size:=siz; + sym.bind:=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; + { don't override PRIVATE_EXTERN with GLOBAL } + if not(sym.bind in [AB_GLOBAL,AB_PRIVATE_EXTERN]) then + sym.bind:=AB_GLOBAL; + is_global:=true; + end; + + + constructor tai_symbol.Createname(const _name : string;_symtyp:Tasmsymtype;siz:longint); + begin + inherited Create; + typ:=ait_symbol; + sym:=current_asmdata.DefineAsmSymbol(_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:=current_asmdata.DefineAsmSymbol(_name,AB_GLOBAL,_symtyp); + size:=siz; + is_global:=true; + end; + + + constructor tai_symbol.createname_global_value(const _name: string;_symtyp: tasmsymtype; siz: longint; val: ptruint); + begin + Createname_global(_name,_symtyp,siz); + value:=val; + has_value:=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 + 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:=current_asmdata.RefAsmSymbol(_name); + 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 + 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:taiconst_type;_value : int64); + begin + inherited Create; + typ:=ait_const; + consttype:=_typ; + value:=_value; + sym:=nil; + endsym:=nil; + end; + + + constructor tai_const.Create_128bit(_value : int64); + begin + inherited Create; + typ:=ait_const; + consttype:=aitconst_128bit; + value:=_value; + sym:=nil; + endsym:=nil; + end; + + + constructor tai_const.Create_64bit(_value : int64); + begin + inherited Create; + typ:=ait_const; + consttype:=aitconst_64bit; + value:=_value; + sym:=nil; + endsym:=nil; + end; + + + constructor tai_const.Create_32bit(_value : longint); + begin + inherited Create; + typ:=ait_const; + consttype:=aitconst_32bit; + value:=_value; + sym:=nil; + endsym:=nil; + end; + + + constructor tai_const.Create_16bit(_value : word); + begin + inherited Create; + typ:=ait_const; + consttype:=aitconst_16bit; + value:=_value; + sym:=nil; + endsym:=nil; + end; + + + constructor tai_const.Create_8bit(_value : byte); + begin + inherited Create; + typ:=ait_const; + consttype:=aitconst_8bit; + value:=_value; + sym:=nil; + endsym:=nil; + end; + + + constructor tai_const.Create_char(size: integer; _value: dword); + begin + inherited Create; + typ:=ait_const; + case size of + 1: + begin + consttype:=aitconst_8bit; + value:=byte(_value) + end; + 2: + begin + consttype:=aitconst_16bit; + value:=word(_value) + end + else + InternalError(2010030701) + end + end; + + + constructor tai_const.Create_sleb128bit(_value : int64); + begin + inherited Create; + typ:=ait_const; + consttype:=aitconst_sleb128bit; + value:=_value; + sym:=nil; + endsym:=nil; + end; + + + constructor tai_const.Create_uleb128bit(_value : qword); + begin + inherited Create; + typ:=ait_const; + consttype:=aitconst_uleb128bit; + value:=int64(_value); + sym:=nil; + endsym:=nil; + end; + + + constructor tai_const.Create_aint(_value : aint); + begin + inherited Create; + typ:=ait_const; + consttype:=aitconst_aint; + value:=_value; + sym:=nil; + endsym:=nil; + end; + + + constructor tai_const.Create_pint(_value : pint); + begin + inherited Create; + typ:=ait_const; + consttype:=aitconst_ptr; + value:=_value; + sym:=nil; + endsym:=nil; + end; + + + constructor tai_const.Create_type_sym(_typ:taiconst_type;_sym:tasmsymbol); + begin + inherited Create; + typ:=ait_const; + consttype:=_typ; + sym:=_sym; + endsym:=nil; + value:=0; + { update sym info } + if assigned(sym) then + sym.increfs; + end; + + + constructor tai_const.Create_sym(_sym:tasmsymbol); + begin + self.create_sym_offset(_sym,0); + end; + + + constructor tai_const.Create_sym_offset(_sym:tasmsymbol;ofs:aint); + begin + inherited Create; + typ:=ait_const; + consttype:=aitconst_ptr; + { sym is allowed to be nil, this is used to write nil pointers } + sym:=_sym; + endsym:=nil; + { store the original offset in symofs so that we can recalculate the + value field in the assembler } + symofs:=ofs; + value:=ofs; + { update sym info } + if assigned(sym) then + sym.increfs; + end; + + + constructor tai_const.Create_rel_sym(_typ:taiconst_type;_sym,_endsym:tasmsymbol); + begin + self.create_sym_offset(_sym,0); + consttype:=_typ; + endsym:=_endsym; + endsym.increfs; + end; + + + constructor tai_const.Create_rva_sym(_sym:tasmsymbol); + begin + self.create_sym_offset(_sym,0); + consttype:=aitconst_rva_symbol; + end; + + + constructor tai_const.Createname(const name:string;ofs:aint); + begin + self.create_sym_offset(current_asmdata.RefAsmSymbol(name),ofs); + end; + + + constructor tai_const.ppuload(t:taitype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + consttype:=taiconst_type(ppufile.getbyte); + sym:=ppufile.getasmsymbol; + endsym:=ppufile.getasmsymbol; + value:=ppufile.getint64; + end; + + + procedure tai_const.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putbyte(byte(consttype)); + ppufile.putasmsymbol(sym); + ppufile.putasmsymbol(endsym); + ppufile.putint64(value); + end; + + + procedure tai_const.derefimpl; + begin + 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 consttype of + aitconst_8bit : + result:=1; + aitconst_16bit : + result:=2; + aitconst_32bit,aitconst_darwin_dwarf_delta32: + result:=4; + aitconst_64bit,aitconst_darwin_dwarf_delta64: + result:=8; + aitconst_secrel32_symbol, + aitconst_rva_symbol : + if target_info.system=system_x86_64_win64 then + result:=sizeof(longint) + else + result:=sizeof(pint); + aitconst_uleb128bit : + result:=LengthUleb128(qword(value)); + aitconst_sleb128bit : + result:=LengthSleb128(value); + aitconst_half16bit: + result:=2; + else + internalerror(200603253); + 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; _savesize: byte); + + begin + inherited Create; + typ:=ait_real_80bit; + value:=_value; + savesize:=_savesize; + end; + + + constructor tai_real_80bit.ppuload(t:taitype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + value:=ppufile.getreal; + savesize:=ppufile.getbyte; + end; + + + procedure tai_real_80bit.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putreal(value); + ppufile.putbyte(savesize); + 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(_labsym : tasmlabel); + begin + inherited Create; + typ:=ait_label; + labsym:=_labsym; + labsym.is_set:=true; + is_global:=(labsym.bind in [AB_GLOBAL,AB_PRIVATE_EXTERN]); + end; + + + constructor tai_label.ppuload(t:taitype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + labsym:=tasmlabel(ppufile.getasmsymbol); + is_global:=boolean(ppufile.getbyte); + end; + + + procedure tai_label.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putasmsymbol(labsym); + ppufile.putbyte(byte(is_global)); + end; + + + procedure tai_label.derefimpl; + begin + labsym.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 + freemem(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; + + constructor tai_stab.create_ansistr(_stabtype:TStabType;const s:ansistring); + begin + inherited create; + typ:=ait_stab; + stabtype:=_stabtype; + getmem(str,length(s)+1); + move(s[1],str^,length(s)+1); + end; + + destructor tai_stab.destroy; + begin + freemem(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: TAsmMarker); + begin + Inherited Create; + typ := ait_marker; + Kind := _Kind; + end; + + + constructor Tai_Marker.ppuload(t:taitype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + kind:=TAsmMarker(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 + freeop(i); + 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,1); + 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} + if (cs_create_pic in current_settings.moduleswitches) and + assigned(r.symbol) and + not assigned(r.relsymbol) and + (r.refaddr=addr_no) +{$ifdef ARM} + and not(r.base=NR_R15) +{$endif ARM} + then + internalerror(200502052); + 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; + if assigned(ref^.relsymbol) then + ref^.relsymbol.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; + + + procedure tai_cpu_abstract.freeop(opidx:longint); + begin + clearop(opidx); + dispose(oper[opidx]); + 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 overridden, 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; + + + procedure tai_cpu_abstract.resetpass1; + begin + end; + + + procedure tai_cpu_abstract.resetpass2; + begin + end; + + + function tai_cpu_abstract.Pass1(objdata:TObjData):longint; + begin + result:=0; + end; + + + procedure tai_cpu_abstract.Pass2(objdata:TObjData); + begin + end; + + + procedure tai_cpu_abstract.ppuloadoper(ppufile:tcompilerppufile;var o:toper); + begin + o.typ:=toptype(ppufile.getbyte); + o.ot:=ppufile.getlongint; + case o.typ of + top_reg : + ppufile.getdata(o.reg,sizeof(Tregister)); + top_ref : + begin + new(o.ref); +{$ifdef x86} + ppufile.getdata(o.ref^.segment,sizeof(Tregister)); +{$endif x86} + ppufile.getdata(o.ref^.base,sizeof(Tregister)); + ppufile.getdata(o.ref^.index,sizeof(Tregister)); + ppufile.getdata(o.ref^.refaddr,sizeof(o.ref^.refaddr)); + o.ref^.scalefactor:=ppufile.getbyte; + o.ref^.offset:=ppufile.getaint; + o.ref^.symbol:=ppufile.getasmsymbol; + o.ref^.relsymbol:=ppufile.getasmsymbol; + end; + top_const : + o.val:=ppufile.getaint; + top_local : + begin + new(o.localoper); + with o.localoper^ do + begin + ppufile.getderef(localsymderef); + localsymofs:=ppufile.getaint; + localindexreg:=tregister(ppufile.getlongint); + localscale:=ppufile.getbyte; + localgetoffset:=(ppufile.getbyte<>0); + end; + end; + else + internalerror(2007010210); + end; + end; + + + procedure tai_cpu_abstract.ppuwriteoper(ppufile:tcompilerppufile;const o:toper); + begin + ppufile.putbyte(byte(o.typ)); + ppufile.putlongint(o.ot); + case o.typ of + top_reg : + ppufile.putdata(o.reg,sizeof(Tregister)); + top_ref : + begin +{$ifdef x86} + ppufile.putdata(o.ref^.segment,sizeof(Tregister)); +{$endif x86} + ppufile.putdata(o.ref^.base,sizeof(Tregister)); + ppufile.putdata(o.ref^.index,sizeof(Tregister)); + ppufile.putdata(o.ref^.refaddr,sizeof(o.ref^.refaddr)); + ppufile.putbyte(o.ref^.scalefactor); + ppufile.putaint(o.ref^.offset); + ppufile.putasmsymbol(o.ref^.symbol); + ppufile.putasmsymbol(o.ref^.relsymbol); + end; + top_const : + ppufile.putaint(o.val); + top_local : + begin + with o.localoper^ do + begin + ppufile.putderef(localsymderef); + ppufile.putaint(localsymofs); + ppufile.putlongint(longint(localindexreg)); + ppufile.putbyte(localscale); + ppufile.putbyte(byte(localgetoffset)); + end; + end; + else + internalerror(2007010211); + end; + end; + +{**************************************************************************** + tai_align_abstract + ****************************************************************************} + + constructor tai_align_abstract.Create(b: byte); + begin + inherited Create; + typ:=ait_align; +{$ifdef EXTDEBUG} + if upper(classname)='TAI_ALIGN_ABSTRACT' then + internalerror(200709191); +{$endif EXTDEBUG} + 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;executable : boolean):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; + +{**************************************************************************** + tai_seh_directive + ****************************************************************************} + + const + datatypemap: array[TAsmSehDirective] of TSehDirectiveDatatype=( + sd_string, { proc } + sd_none, { endproc } + sd_none, { endprologue } + sd_string, { handler } + sd_none, { handlerdata } + sd_none,sd_none,sd_none, { eh, 32, no32 } + sd_regoffset, { setframe } + sd_offset, { stackalloc } + sd_reg, { pushreg } + sd_regoffset, { savereg } + sd_regoffset, { savexmm } + sd_none { pushframe } + ); + + constructor tai_seh_directive.create(_kind:TAsmSehDirective); + begin + inherited Create; + typ:=ait_seh_directive; + kind:=_kind; + data.typ:=datatypemap[_kind]; + end; + + constructor tai_seh_directive.create_name(_kind:TAsmSehDirective;const _name:string); + begin + create(_kind); + data.name:=stringdup(_name); + end; + + constructor tai_seh_directive.create_reg(_kind:TAsmSehDirective;r:TRegister); + begin + create(_kind); + data.reg:=r; + end; + + constructor tai_seh_directive.create_offset(_kind:TAsmSehDirective;ofs:dword); + begin + create(_kind); + data.offset:=ofs; + end; + + constructor tai_seh_directive.create_reg_offset(_kind:TAsmSehDirective; + r:TRegister;ofs:dword); + begin + create(_kind); + data.offset:=ofs; + data.reg:=r; + end; + + constructor tai_seh_directive.ppuload(t:taitype;ppufile:tcompilerppufile); + begin + inherited ppuload(t, ppufile); + kind:=TAsmSehDirective(ppufile.getbyte); + data.typ:=datatypemap[kind]; + case data.typ of + sd_none: ; + sd_string: + begin + data.name:=stringdup(ppufile.getstring); + data.flags:=ppufile.getbyte; + end; + + sd_reg,sd_offset,sd_regoffset: + begin + ppufile.getdata(data.reg,sizeof(TRegister)); + data.offset:=ppufile.getdword; + end; + else + InternalError(2011091201); + end; + end; + + destructor tai_seh_directive.destroy; + begin + if data.typ=sd_string then + stringdispose(data.name); + inherited destroy; + end; + + procedure tai_seh_directive.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putbyte(ord(kind)); + case data.typ of + sd_none: ; + sd_string: + begin + ppufile.putstring(data.name^); + ppufile.putbyte(data.flags); + end; + + sd_reg,sd_offset,sd_regoffset: + begin + ppufile.putdata(data.reg,sizeof(TRegister)); + ppufile.putdword(data.offset); + end; + else + InternalError(2011091202); + end; + end; + + procedure tai_seh_directive.generate_code(objdata:TObjData); + begin + end; + +begin +{$push}{$warnings off} + { taitype should fit into a 4 byte set for speed reasons } + if ord(high(taitype))>31 then + internalerror(201108181); +{$pop} +end. diff --git a/closures/compiler/aggas.pas b/closures/compiler/aggas.pas new file mode 100644 index 0000000000..1fed1d0b79 --- /dev/null +++ b/closures/compiler/aggas.pas @@ -0,0 +1,1636 @@ +{ + Copyright (c) 1998-2006 by the Free Pascal team + + This unit implements the generic part of the GNU assembler + (v2.8 or later) writer + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +{ Base unit for writing GNU assembler output. +} +unit aggas; + +{$i fpcdefs.inc} + +interface + + uses + cclasses, + globtype,globals, + aasmbase,aasmtai,aasmdata,aasmcpu, + assemble; + + type + TCPUInstrWriter = class; + {# This is a derived class which is used to write + GAS styled assembler. + } + + { TGNUAssembler } + + TGNUAssembler=class(texternalassembler) + protected + function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;virtual; + function sectionattrs_coff(atype:TAsmSectiontype):string;virtual; + procedure WriteSection(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder); + procedure WriteExtraHeader;virtual; + procedure WriteInstruction(hp: tai); + procedure WriteWeakSymbolDef(s: tasmsymbol); virtual; + public + function MakeCmdLine: TCmdStr; override; + procedure WriteTree(p:TAsmList);override; + procedure WriteAsmList;override; + destructor destroy; override; + private + setcount: longint; + procedure WriteDecodedSleb128(a: int64); + procedure WriteDecodedUleb128(a: qword); + function NextSetLabel: string; + protected + InstrWriter: TCPUInstrWriter; + end; + + + {# This is the base class for writing instructions. + + The WriteInstruction() method must be overridden + to write a single instruction to the assembler + file. + } + TCPUInstrWriter = class + constructor create(_owner: TGNUAssembler); + procedure WriteInstruction(hp : tai); virtual; abstract; + protected + owner: TGNUAssembler; + end; + + + { TAppleGNUAssembler } + + TAppleGNUAssembler=class(TGNUAssembler) + protected + function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override; + procedure WriteWeakSymbolDef(s: tasmsymbol); override; + + end; + + + TAoutGNUAssembler=class(TGNUAssembler) + function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override; + end; + + +implementation + + uses + SysUtils, + cutils,cfileutl,systems, + fmodule,finput,verbose, + itcpugas,cpubase; + + const + line_length = 70; + + var + 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 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[aitconst_128bit..aitconst_half16bit] 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'.secrel32'#9,#9'.quad'#9,#9'.long'#9,#9'.short'#9 + ); + +{****************************************************************************} +{ GNU Assembler writer } +{****************************************************************************} + + destructor TGNUAssembler.Destroy; + begin + InstrWriter.free; + inherited destroy; + end; + + + function TGNUAssembler.MakeCmdLine: TCmdStr; + begin + result := inherited MakeCmdLine; + // MWE: disabled again. It generates dwarf info for the generated .s + // files as well. This conflicts with the info we generate + // if target_dbg.id = dbg_dwarf then + // result := result + ' --gdwarf-2'; + end; + + + function TGNUAssembler.NextSetLabel: string; + begin + inc(setcount); + result := target_asm.labelprefix+'$set$'+tostr(setcount); + end; + + function is_smart_section(atype:TAsmSectiontype):boolean; + begin + { For bss we need to set some flags that are target dependent, + it is easier to disable it for smartlinking. It doesn't take up + filespace } + result:=not(target_info.system in systems_darwin) and + create_smartlink_sections and + (atype<>sec_toc) and + (atype<>sec_user) and + { on embedded systems every byte counts, so smartlink bss too } + ((atype<>sec_bss) or (target_info.system in systems_embedded)); + end; + + function TGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string; + const + secnames : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','', + '.text', + '.data', +{ why doesn't .rodata work? (FK) } +{ sometimes we have to create a data.rel.ro instead of .rodata, e.g. for } +{ vtables (and anything else containing relocations), otherwise those are } +{ not relocated properly on e.g. linux/ppc64. g++ generates there for a } +{ vtable for a class called Window: } +{ .section .data.rel.ro._ZTV6Window,"awG",@progbits,_ZTV6Window,comdat } +{ TODO: .data.ro not yet working} +{$if defined(arm) or defined(powerpc)} + '.rodata', +{$else arm} + '.data', +{$endif arm} +{$if defined(m68k)} { Amiga/m68k GNU AS doesn't seem to like .rodata (KB) } + '.data', +{$else} + '.rodata', +{$endif} + '.bss', + '.threadvar', + '.pdata', + '', { stubs } + '__DATA,__nl_symbol_ptr', + '__DATA,__la_symbol_ptr', + '__DATA,__mod_init_func', + '__DATA,__mod_term_func', + '.stab', + '.stabstr', + '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata', + '.eh_frame', + '.debug_frame','.debug_info','.debug_line','.debug_abbrev', + '.fpc', + '.toc', + '.init', + '.fini', + '.objc_class', + '.objc_meta_class', + '.objc_cat_cls_meth', + '.objc_cat_inst_meth', + '.objc_protocol', + '.objc_string_object', + '.objc_cls_meth', + '.objc_inst_meth', + '.objc_cls_refs', + '.objc_message_refs', + '.objc_symbols', + '.objc_category', + '.objc_class_vars', + '.objc_instance_vars', + '.objc_module_info', + '.objc_class_names', + '.objc_meth_var_types', + '.objc_meth_var_names', + '.objc_selector_strs', + '.objc_protocol_ext', + '.objc_class_ext', + '.objc_property', + '.objc_image_info', + '.objc_cstring_object', + '.objc_sel_fixup', + '__DATA,__objc_data', + '__DATA,__objc_const', + '.objc_superrefs', + '__DATA, __datacoal_nt,coalesced', + '.objc_classlist', + '.objc_nlclasslist', + '.objc_catlist', + '.obcj_nlcatlist', + '.objc_protolist' + ); + secnames_pic : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','', + '.text', + '.data.rel', + '.data.rel', + '.data.rel', + '.bss', + '.threadvar', + '.pdata', + '', { stubs } + '__DATA,__nl_symbol_ptr', + '__DATA,__la_symbol_ptr', + '__DATA,__mod_init_func', + '__DATA,__mod_term_func', + '.stab', + '.stabstr', + '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata', + '.eh_frame', + '.debug_frame','.debug_info','.debug_line','.debug_abbrev', + '.fpc', + '.toc', + '.init', + '.fini', + '.objc_class', + '.objc_meta_class', + '.objc_cat_cls_meth', + '.objc_cat_inst_meth', + '.objc_protocol', + '.objc_string_object', + '.objc_cls_meth', + '.objc_inst_meth', + '.objc_cls_refs', + '.objc_message_refs', + '.objc_symbols', + '.objc_category', + '.objc_class_vars', + '.objc_instance_vars', + '.objc_module_info', + '.objc_class_names', + '.objc_meth_var_types', + '.objc_meth_var_names', + '.objc_selector_strs', + '.objc_protocol_ext', + '.objc_class_ext', + '.objc_property', + '.objc_image_info', + '.objc_cstring_object', + '.objc_sel_fixup', + '__DATA, __objc_data', + '__DATA, __objc_const', + '.objc_superrefs', + '__DATA, __datacoal_nt,coalesced', + '.objc_classlist', + '.objc_nlclasslist', + '.objc_catlist', + '.obcj_nlcatlist', + '.objc_protolist' + ); + var + sep : string[3]; + secname : string; + begin + if (cs_create_pic in current_settings.moduleswitches) and + not(target_info.system in systems_darwin) then + secname:=secnames_pic[atype] + else + secname:=secnames[atype]; +{$ifdef m68k} + { old Amiga GNU AS doesn't support .section .fpc } + if (atype=sec_fpc) and (target_info.system = system_m68k_amiga) then + secname:=secnames[sec_data]; +{$endif} + if (atype=sec_fpc) and (Copy(aname,1,3)='res') then + begin + result:=secname+'.'+aname; + exit; + end; + + if (atype=sec_threadvar) and + (target_info.system in (systems_windows+systems_wince)) then + secname:='.tls'; + + { go32v2 stub only loads .text and .data sections, and allocates space for .bss. + Thus, data which normally goes into .rodata and .rodata_norel sections must + end up in .data section } + if (atype in [sec_rodata,sec_rodata_norel]) and + (target_info.system=system_i386_go32v2) then + secname:='.data'; + + { section type user gives the user full controll on the section name } + if atype=sec_user then + secname:=aname; + + if is_smart_section(atype) and (aname<>'') then + begin + case aorder of + secorder_begin : + sep:='.b_'; + secorder_end : + sep:='.z_'; + else + sep:='.n_'; + end; + result:=secname+sep+aname + end + else + result:=secname; + end; + + + function TGNUAssembler.sectionattrs_coff(atype:TAsmSectiontype):string; + begin + case atype of + sec_code, sec_init, sec_fini, sec_stub: + result:='x'; + + { TODO: must be individual for each section } + sec_user: + result:='d'; + + sec_data, sec_data_lazy, sec_data_nonlazy, sec_fpc, + sec_idata2, sec_idata4, sec_idata5, sec_idata6, sec_idata7: + result:='d'; + + { TODO: these need a fix to become read-only } + sec_rodata, sec_rodata_norel: + result:='d'; + + sec_bss: + result:='b'; + + { TODO: Somewhat questionable. FPC does not allow initialized threadvars, + so no sense to mark it as containing data. But Windows allows it to + contain data, and Linux even has .tdata and .tbss } + sec_threadvar: + result:='b'; + + sec_pdata, sec_edata, sec_eh_frame, sec_toc: + result:='r'; + + sec_stab,sec_stabstr, + sec_debug_frame,sec_debug_info,sec_debug_line,sec_debug_abbrev: + result:='n'; + else + result:=''; { defaults to data+load } + end; + end; + + + procedure TGNUAssembler.WriteSection(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder); + var + s : string; + begin + AsmLn; + case target_info.system of + system_i386_OS2, + system_i386_EMX, + system_m68k_amiga, { amiga has old GNU AS (2.14), which blews up from .section (KB) } + system_m68k_linux: ; + system_powerpc_darwin, + system_i386_darwin, + system_i386_iphonesim, + system_powerpc64_darwin, + system_x86_64_darwin, + system_arm_darwin: + begin + if (atype in [sec_stub,sec_objc_data,sec_objc_const,sec_data_coalesced]) then + AsmWrite('.section '); + end + else + AsmWrite('.section '); + end; + s:=sectionname(atype,aname,aorder); + AsmWrite(s); + case atype of + sec_fpc : + if aname = 'resptrs' then + AsmWrite(', "a", @progbits'); + sec_stub : + begin + case target_info.system of + { there are processor-independent shortcuts available } + { for this, namely .symbol_stub and .picsymbol_stub, but } + { they don't work and gcc doesn't use them either... } + system_powerpc_darwin, + system_powerpc64_darwin: + if (cs_create_pic in current_settings.moduleswitches) then + AsmWriteln('__TEXT,__picsymbolstub1,symbol_stubs,pure_instructions,32') + else + AsmWriteln('__TEXT,__symbol_stub1,symbol_stubs,pure_instructions,16'); + system_i386_darwin, + system_i386_iphonesim: + AsmWriteln('__IMPORT,__jump_table,symbol_stubs,self_modifying_code+pure_instructions,5'); + system_arm_darwin: + if (cs_create_pic in current_settings.moduleswitches) then + AsmWriteln('.section __TEXT,__picsymbolstub4,symbol_stubs,none,16') + else + AsmWriteln('.section __TEXT,__symbol_stub4,symbol_stubs,none,12') + { darwin/x86-64 uses RIP-based GOT addressing, no symbol stubs } + else + internalerror(2006031101); + end; + end; + else + { GNU AS won't recognize '.text.n_something' section name as belonging + to '.text' and assigns default attributes to it, which is not + always correct. We have to fix it. + + TODO: This likely applies to all systems which smartlink without + creating libraries } + if (target_info.system in [system_i386_win32,system_x86_64_win64]) and + is_smart_section(atype) and (aname<>'') then + begin + s:=sectionattrs_coff(atype); + if (s<>'') then + AsmWrite(',"'+s+'"'); + end; + end; + AsmLn; + LastSecType:=atype; + end; + + + procedure TGNUAssembler.WriteDecodedUleb128(a: qword); + var + i,len : longint; + buf : array[0..63] of byte; + begin + len:=EncodeUleb128(a,buf); + for i:=0 to len-1 do + begin + if (i > 0) then + AsmWrite(','); + AsmWrite(tostr(buf[i])); + end; + end; + + + procedure TGNUAssembler.WriteDecodedSleb128(a: int64); + var + i,len : longint; + buf : array[0..255] of byte; + begin + len:=EncodeSleb128(a,buf); + for i:=0 to len-1 do + begin + if (i > 0) then + AsmWrite(','); + AsmWrite(tostr(buf[i])); + end; + end; + + + procedure TGNUAssembler.WriteTree(p:TAsmList); + + function needsObject(hp : tai_symbol) : boolean; + begin + needsObject := + ( + assigned(hp.next) and + (tai(hp.next).typ in [ait_const,ait_datablock, + ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit]) + ) or + (hp.sym.typ=AT_DATA); + + end; + + + procedure doalign(alignment: byte; use_op: boolean; fillop: byte; out last_align: longint); + var + i: longint; + begin + last_align:=alignment; + if alignment>1 then + begin + if not(target_info.system in systems_darwin) then + begin + AsmWrite(#9'.balign '+tostr(alignment)); + if use_op then + AsmWrite(','+tostr(fillop)) +{$ifdef x86} + { force NOP as alignment op code } + else if LastSecType=sec_code then + AsmWrite(',0x90'); +{$endif x86} + end + else + begin + { darwin as only supports .align } + if not ispowerof2(alignment,i) then + internalerror(2003010305); + AsmWrite(#9'.align '+tostr(i)); + last_align:=i; + end; + AsmLn; + end; + end; + + var + ch : char; + hp : tai; + constdef : taiconst_type; + s,t : 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 current_settings.globalswitches) or + ((cs_lineinfo in current_settings.moduleswitches) + and (p=current_asmdata.asmlists[al_procedures])); + hp:=tai(p.first); + while assigned(hp) do + begin + prefetch(pointer(hp.next)^); + if not(hp.typ in SkipLineInfo) then + begin + current_filepos:=tailineinfo(hp).fileinfo; + { no line info for inlined code } + if do_line and (inlinelevel=0) then + WriteSourceLine(hp as tailineinfo); + end; + + case hp.typ of + + ait_comment : + Begin + AsmWrite(target_asm.comment); + AsmWritePChar(tai_comment(hp).str); + AsmLn; + End; + + ait_regalloc : + begin + if (cs_asm_regalloc in current_settings.globalswitches) then + begin + AsmWrite(#9+target_asm.comment+'Register '); + repeat + AsmWrite(std_regname(Tai_regalloc(hp).reg)); + if (hp.next=nil) or + (tai(hp.next).typ<>ait_regalloc) or + (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then + break; + hp:=tai(hp.next); + AsmWrite(','); + until false; + AsmWrite(' '); + AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]); + end; + end; + + ait_tempalloc : + begin + if (cs_asm_tempalloc in current_settings.globalswitches) then + WriteTempalloc(tai_tempalloc(hp)); + end; + + ait_align : + begin + doalign(tai_align_abstract(hp).aligntype,tai_align_abstract(hp).use_op,tai_align_abstract(hp).fillop,last_align); + end; + + ait_section : + begin + if tai_section(hp).sectype<>sec_none then +{$ifdef avr} + WriteSection(tai_section(hp).sectype,ReplaceForbiddenChars(tai_section(hp).name^),tai_section(hp).secorder) +{$else avr} + WriteSection(tai_section(hp).sectype,tai_section(hp).name^,tai_section(hp).secorder) +{$endif avr} + else + begin +{$ifdef EXTDEBUG} + AsmWrite(target_asm.comment); + AsmWriteln(' sec_none'); +{$endif EXTDEBUG} + end; + end; + + ait_datablock : + begin + if (target_info.system in systems_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. + } + 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(LastSecType in [sec_data,sec_none]) then + writesection(LastSecType,'',secorder_default); + end + else + begin + asmwrite(#9'.lcomm'#9); + asmwrite(tai_datablock(hp).sym.name); + asmwrite(','+tostr(tai_datablock(hp).size)); + asmwrite(','+tostr(last_align)); + asmln; + end; + end + else + begin +{$ifdef USE_COMM_IN_BSS} + if writingpackages then + begin + { The .comm is required for COMMON symbols. These are used + in the shared library loading. All the symbols declared in + the .so file need to resolve to the data allocated in the main + program (PFV) } + if tai_datablock(hp).is_global then + begin + asmwrite(#9'.comm'#9); +{$ifdef avr} + asmwrite(ReplaceForbiddenChars(tai_datablock(hp).sym.name)); +{$else avr} + asmwrite(tai_datablock(hp).sym.name); +{$endif avr} + asmwrite(','+tostr(tai_datablock(hp).size)); + asmwrite(','+tostr(last_align)); + asmln; + end + else + begin + asmwrite(#9'.lcomm'#9); +{$ifdef avr} + asmwrite(ReplaceForbiddenChars(tai_datablock(hp).sym.name)); +{$else avr} + asmwrite(tai_datablock(hp).sym.name); +{$endif avr} + asmwrite(','+tostr(tai_datablock(hp).size)); + asmwrite(','+tostr(last_align)); + asmln; + end + end + else +{$endif USE_COMM_IN_BSS} + begin + if Tai_datablock(hp).is_global then + begin + asmwrite(#9'.globl '); +{$ifdef avr} + asmwriteln(ReplaceForbiddenChars(Tai_datablock(hp).sym.name)); +{$else avr} + asmwriteln(Tai_datablock(hp).sym.name); +{$endif avr} + end; + if (target_info.system <> system_arm_linux) then + sepChar := '@' + else + sepChar := '%'; +{$ifdef avr} + if (tf_needs_symbol_type in target_info.flags) then + asmwriteln(#9'.type '+ReplaceForbiddenChars(Tai_datablock(hp).sym.name)+','+sepChar+'object'); + if (tf_needs_symbol_size in target_info.flags) and (tai_datablock(hp).size > 0) then + asmwriteln(#9'.size '+ReplaceForbiddenChars(Tai_datablock(hp).sym.name)+','+tostr(Tai_datablock(hp).size)); + asmwrite(ReplaceForbiddenChars(Tai_datablock(hp).sym.name)); +{$else avr} + if (tf_needs_symbol_type in target_info.flags) then + asmwriteln(#9'.type '+Tai_datablock(hp).sym.name+','+sepChar+'object'); + if (tf_needs_symbol_size in target_info.flags) and (tai_datablock(hp).size > 0) then + asmwriteln(#9'.size '+Tai_datablock(hp).sym.name+','+tostr(Tai_datablock(hp).size)); + asmwrite(Tai_datablock(hp).sym.name); +{$endif avr} + asmwriteln(':'); + asmwriteln(#9'.zero '+tostr(Tai_datablock(hp).size)); + end; + end; + end; + + ait_const: + begin + constdef:=tai_const(hp).consttype; + case constdef of +{$ifndef cpu64bitaddr} + aitconst_128bit : + begin + internalerror(200404291); + end; + + aitconst_64bit : + begin + if assigned(tai_const(hp).sym) then + internalerror(200404292); + AsmWrite(ait_const2str[aitconst_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 cpu64bitaddr} + aitconst_uleb128bit, + aitconst_sleb128bit, +{$ifdef cpu64bitaddr} + aitconst_128bit, + aitconst_64bit, +{$endif cpu64bitaddr} + aitconst_32bit, + aitconst_16bit, + aitconst_8bit, + aitconst_rva_symbol, + aitconst_secrel32_symbol, + aitconst_darwin_dwarf_delta32, + aitconst_darwin_dwarf_delta64, + aitconst_half16bit: + begin + if (target_info.system in systems_darwin) and + (constdef in [aitconst_uleb128bit,aitconst_sleb128bit]) then + begin + AsmWrite(ait_const2str[aitconst_8bit]); + case tai_const(hp).consttype of + aitconst_uleb128bit: + WriteDecodedUleb128(qword(tai_const(hp).value)); + aitconst_sleb128bit: + WriteDecodedSleb128(int64(tai_const(hp).value)); + end + end + else + begin + AsmWrite(ait_const2str[constdef]); + l:=0; + t := ''; + repeat + if assigned(tai_const(hp).sym) then + begin + if assigned(tai_const(hp).endsym) then + begin + if (constdef in [aitconst_darwin_dwarf_delta32,aitconst_darwin_dwarf_delta64]) then + begin + s := NextSetLabel; + t := #9'.set '+s+','+tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name; + end + else + s:=tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name + end + else + s:=tai_const(hp).sym.name; +{$ifdef avr} + s:=ReplaceForbiddenChars(s); +{$endif avr} + if tai_const(hp).value<>0 then + s:=s+tostr_with_plus(tai_const(hp).value); + end + else +{$ifdef cpu64bitaddr} + s:=tostr(tai_const(hp).value); +{$else cpu64bitaddr} + { 64 bit constants are already handled above in this case } + s:=tostr(longint(tai_const(hp).value)); +{$endif cpu64bitaddr} + if constdef = aitconst_half16bit then + s:='('+s+')/2'; + + 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(LastSecType in [sec_data,sec_rodata,sec_rodata_norel]) or + (l>line_length) or + (hp.next=nil) or + (tai(hp.next).typ<>ait_const) or + (tai_const(hp.next).consttype<>constdef) or + assigned(tai_const(hp.next).sym) then + break; + hp:=tai(hp.next); + AsmWrite(','); + until false; + if (t <> '') then + begin + AsmLn; + AsmWrite(t); + end; + end; + AsmLn; + end; + else + internalerror(200704251); + end; + end; + + { the "and defined(FPC_HAS_TYPE_EXTENDED)" isn't optimal but currently the only solution + it prevents proper cross compilation to i386 though + } +{$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)} + 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; + for i:=11 to tai_real_80bit(hp).savesize do + AsmWrite(',0'); + 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} + 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 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); + co:=comp(tai_comp_64bit(hp).value); + { 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).labsym.is_used) then + begin + if (tai_label(hp).labsym.bind=AB_PRIVATE_EXTERN) then + begin + AsmWrite(#9'.private_extern '); + AsmWriteln(tai_label(hp).labsym.name); + end; + if tai_label(hp).labsym.bind in [AB_GLOBAL,AB_PRIVATE_EXTERN] then + begin + AsmWrite('.globl'#9); +{$ifdef avr} + AsmWriteLn(ReplaceForbiddenChars(tai_label(hp).labsym.name)); +{$else avr} + AsmWriteLn(tai_label(hp).labsym.name); +{$endif avr} + end; +{$ifdef avr} + AsmWrite(ReplaceForbiddenChars(tai_label(hp).labsym.name)); +{$else avr} + AsmWrite(tai_label(hp).labsym.name); +{$endif avr} + AsmWriteLn(':'); + end; + end; + + ait_symbol : + begin + if (tai_symbol(hp).sym.bind=AB_PRIVATE_EXTERN) then + begin + AsmWrite(#9'.private_extern '); +{$ifdef avr} + AsmWriteln(ReplaceForbiddenChars(tai_symbol(hp).sym.name)); +{$else avr} + AsmWriteln(tai_symbol(hp).sym.name); +{$endif avr} + end; + if (target_info.system = system_powerpc64_linux) and + (tai_symbol(hp).sym.typ = AT_FUNCTION) and (cs_profile in current_settings.moduleswitches) then + AsmWriteLn('.globl _mcount'); + + if tai_symbol(hp).is_global then + begin + AsmWrite('.globl'#9); +{$ifdef avr} + AsmWriteln(ReplaceForbiddenChars(tai_symbol(hp).sym.name)); +{$else avr} + AsmWriteln(tai_symbol(hp).sym.name); +{$endif avr} + 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'); + if (tai_symbol(hp).is_global) then + 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 entry } + AsmWrite('.'); + end + else + begin + if (target_info.system <> system_arm_linux) then + sepChar := '@' + else + sepChar := '#'; + 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 + AsmWriteLn(',' + sepChar + 'object') + else + AsmWriteLn(',' + sepChar + 'function'); + end; + end; +{$ifdef avr} + if not(tai_symbol(hp).has_value) then + AsmWriteLn(ReplaceForbiddenChars(tai_symbol(hp).sym.name + ':')) + else + AsmWriteLn(ReplaceForbiddenChars(tai_symbol(hp).sym.name + '=' + tostr(tai_symbol(hp).value))); +{$else avr} + if not(tai_symbol(hp).has_value) then + AsmWriteLn(tai_symbol(hp).sym.name + ':') + else + AsmWriteLn(tai_symbol(hp).sym.name + '=' + tostr(tai_symbol(hp).value)); +{$endif avr} + end; +{$ifdef arm} + ait_thumb_func: + begin + AsmWriteLn(#9'.thumb_func'); + end; +{$endif arm} + + 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 + AsmWrite('.'); +{$ifdef avr} + AsmWrite(ReplaceForbiddenChars(tai_symbol_end(hp).sym.name)); +{$else avr} + AsmWrite(tai_symbol_end(hp).sym.name); +{$endif avr} + AsmWrite(', '+s+' - '); + if (target_info.system = system_powerpc64_linux) and (tai_symbol_end(hp).sym.typ = AT_FUNCTION) then + AsmWrite('.'); +{$ifdef avr} + AsmWriteLn(ReplaceForbiddenChars(tai_symbol_end(hp).sym.name)); +{$else avr} + AsmWriteLn(tai_symbol_end(hp).sym.name); +{$endif avr} + 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 + LastSecType:=tai_section(hp.next).sectype; + hp:=tai(hp.next); + end; + if LastSecType<>sec_none then + WriteSection(LastSecType,'',secorder_default); + AsmStartSize:=AsmSize; + end; + end; + + ait_marker : + if tai_marker(hp).kind=mark_NoLineInfoStart then + inc(InlineLevel) + else if tai_marker(hp).kind=mark_NoLineInfoEnd then + dec(InlineLevel); + + ait_directive : + begin + AsmWrite('.'+directivestr[tai_directive(hp).directive]+' '); + if assigned(tai_directive(hp).name) then + AsmWrite(tai_directive(hp).name^); + AsmLn; + end; + + ait_seh_directive : + begin +{$ifdef TEST_WIN64_SEH} + AsmWrite(sehdirectivestr[tai_seh_directive(hp).kind]); + case tai_seh_directive(hp).datatype of + sd_none:; + sd_string: + begin + AsmWrite(' '+tai_seh_directive(hp).data.name^); + if (tai_seh_directive(hp).data.flags and 1)<>0 then + AsmWrite(',@except'); + if (tai_seh_directive(hp).data.flags and 2)<>0 then + AsmWrite(',@unwind'); + end; + sd_reg: + AsmWrite(' '+gas_regname(tai_seh_directive(hp).data.reg)); + sd_offset: + AsmWrite(' '+tostr(tai_seh_directive(hp).data.offset)); + sd_regoffset: + AsmWrite(' '+gas_regname(tai_seh_directive(hp).data.reg)+', '+ + tostr(tai_seh_directive(hp).data.offset)); + end; + AsmLn; +{$endif TEST_WIN64_SEH} + end; + + else + internalerror(2006012201); + end; + hp:=tai(hp.next); + end; + end; + + + procedure TGNUAssembler.WriteExtraHeader; + begin + end; + + + procedure TGNUAssembler.WriteInstruction(hp: tai); + begin + InstrWriter.WriteInstruction(hp); + end; + + + procedure TGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol); + begin + AsmWriteLn(#9'.weak '+s.name); + end; + + + procedure TGNUAssembler.WriteAsmList; + var + n : string; + hal : tasmlisttype; + i: longint; + begin +{$ifdef EXTDEBUG} + if assigned(current_module.mainsource) then + Comment(V_Debug,'Start writing gas-styled assembler output for '+current_module.mainsource^); +{$endif} + + if assigned(current_module.mainsource) then + n:=ExtractFileName(current_module.mainsource^) + else + n:=InputFileName; + + { gcc does not add it either for Darwin (and AIX). Grep for + TARGET_ASM_FILE_START_FILE_DIRECTIVE in gcc/config/*.h + } + if not(target_info.system in systems_darwin) then + AsmWriteLn(#9'.file "'+FixFileName(n)+'"'); + + WriteExtraHeader; + AsmStartSize:=AsmSize; + symendcount:=0; + + for hal:=low(TasmlistType) to high(TasmlistType) do + begin + AsmWriteLn(target_asm.comment+'Begin asmlist '+AsmlistTypeStr[hal]); + writetree(current_asmdata.asmlists[hal]); + AsmWriteLn(target_asm.comment+'End asmlist '+AsmlistTypeStr[hal]); + end; + + { add weak symbol markers } + for i:=0 to current_asmdata.asmsymboldict.count-1 do + if (tasmsymbol(current_asmdata.asmsymboldict[i]).bind=AB_WEAK_EXTERNAL) then + writeweaksymboldef(tasmsymbol(current_asmdata.asmsymboldict[i])); + + if create_smartlink_sections and + (target_info.system in systems_darwin) then + AsmWriteLn(#9'.subsections_via_symbols'); + + { "no executable stack" marker for Linux } + if (target_info.system in systems_linux) and + not(cs_executable_stack in current_settings.moduleswitches) then + begin + AsmWriteLn('.section .note.GNU-stack,"",%progbits'); + 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; + + +{****************************************************************************} +{ Apple/GNU Assembler writer } +{****************************************************************************} + + function TAppleGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string; + begin + if (target_info.system in systems_darwin) then + case atype of + sec_bss: + { all bss (lcomm) symbols are automatically put in the right } + { place by using the lcomm assembler directive } + atype := sec_none; + sec_debug_frame, + sec_eh_frame: + begin + result := '.section __DWARF,__debug_info,regular,debug'; + exit; + end; + sec_debug_line: + begin + result := '.section __DWARF,__debug_line,regular,debug'; + exit; + end; + sec_debug_info: + begin + result := '.section __DWARF,__debug_info,regular,debug'; + exit; + end; + sec_debug_abbrev: + begin + result := '.section __DWARF,__debug_abbrev,regular,debug'; + exit; + end; + sec_rodata: + begin + result := '.const_data'; + exit; + end; + sec_rodata_norel: + begin + result := '.const'; + exit; + end; + sec_fpc: + begin + result := '.section __TEXT, .fpc, regular, no_dead_strip'; + exit; + end; + sec_code: + begin + if (aname='fpc_geteipasebx') or + (aname='fpc_geteipasecx') then + begin + result:='.section __TEXT,__textcoal_nt,coalesced,pure_instructions'#10'.weak_definition '+aname+ + #10'.private_extern '+aname; + exit; + end; + end; + sec_data_nonlazy: + begin + result:='.section __DATA, __nl_symbol_ptr,non_lazy_symbol_pointers'; + exit; + end; + sec_data_lazy: + begin + result:='.section __DATA, __la_symbol_ptr,lazy_symbol_pointers'; + exit; + end; + sec_init_func: + begin + result:='.section __DATA, __mod_init_func, mod_init_funcs'; + exit; + end; + sec_term_func: + begin + result:='.section __DATA, __mod_term_func, mod_term_funcs'; + exit; + end; + sec_objc_protocol_ext: + begin + result:='.section __OBJC, __protocol_ext, regular, no_dead_strip'; + exit; + end; + sec_objc_class_ext: + begin + result:='.section __OBJC, __class_ext, regular, no_dead_strip'; + exit; + end; + sec_objc_property: + begin + result:='.section __OBJC, __property, regular, no_dead_strip'; + exit; + end; + sec_objc_image_info: + begin + result:='.section __OBJC, __image_info, regular, no_dead_strip'; + exit; + end; + sec_objc_cstring_object: + begin + result:='.section __OBJC, __cstring_object, regular, no_dead_strip'; + exit; + end; + sec_objc_sel_fixup: + begin + result:='.section __OBJC, __sel_fixup, regular, no_dead_strip'; + exit; + end; + sec_objc_message_refs: + begin + if (target_info.system in systems_objc_nfabi) then + begin + result:='.section __DATA, __objc_selrefs, literal_pointers, no_dead_strip'; + exit; + end; + end; + sec_objc_cls_refs: + begin + if (target_info.system in systems_objc_nfabi) then + begin + result:='.section __DATA, __objc_clsrefs, regular, no_dead_strip'; + exit; + end; + end; + sec_objc_meth_var_names, + sec_objc_class_names: + begin + if (target_info.system in systems_objc_nfabi) then + begin + result:='.cstring'; + exit + end; + end; + sec_objc_inst_meth, + sec_objc_cls_meth, + sec_objc_cat_inst_meth, + sec_objc_cat_cls_meth: + begin + if (target_info.system in systems_objc_nfabi) then + begin + result:='.section __DATA, __objc_const'; + exit; + end; + end; + sec_objc_meta_class, + sec_objc_class: + begin + if (target_info.system in systems_objc_nfabi) then + begin + result:='.section __DATA, __objc_data'; + exit; + end; + end; + sec_objc_sup_refs: + begin + result:='.section __DATA, __objc_superrefs, regular, no_dead_strip'; + exit + end; + sec_objc_classlist: + begin + result:='.section __DATA, __objc_classlist, regular, no_dead_strip'; + exit + end; + sec_objc_nlclasslist: + begin + result:='.section __DATA, __objc_nlclasslist, regular, no_dead_strip'; + exit + end; + sec_objc_catlist: + begin + result:='.section __DATA, __objc_catlist, regular, no_dead_strip'; + exit + end; + sec_objc_nlcatlist: + begin + result:='.section __DATA, __objc_nlcatlist, regular, no_dead_strip'; + exit + end; + sec_objc_protolist: + begin + result:='.section __DATA, __objc_protolist, coalesced, no_dead_strip'; + exit; + end; + end; + result := inherited sectionname(atype,aname,aorder); + end; + + + procedure TAppleGNUAssembler.WriteWeakSymbolDef(s: tasmsymbol); + begin + AsmWriteLn(#9'.weak_reference '+s.name); + end; + + +{****************************************************************************} +{ a.out/GNU Assembler writer } +{****************************************************************************} + + function TAoutGNUAssembler.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string; + const +(* Translation table - replace unsupported section types with basic ones. *) + SecXTable: array[TAsmSectionType] of TAsmSectionType = ( + sec_none, + sec_none, + sec_code, + sec_data, + sec_data (* sec_rodata *), + sec_data (* sec_rodata_norel *), + sec_bss, + sec_data (* sec_threadvar *), + { used for wince exception handling } + sec_code (* sec_pdata *), + { used for darwin import stubs } + sec_code (* sec_stub *), + sec_data,(* sec_data_nonlazy *) + sec_data,(* sec_data_lazy *) + sec_data,(* sec_init_func *) + sec_data,(* sec_term_func *) + { stabs } + sec_stab,sec_stabstr, + { win32 } + sec_data (* sec_idata2 *), + sec_data (* sec_idata4 *), + sec_data (* sec_idata5 *), + sec_data (* sec_idata6 *), + sec_data (* sec_idata7 *), + sec_data (* sec_edata *), + { C++ exception handling unwinding (uses dwarf) } + sec_eh_frame, + { dwarf } + sec_debug_frame, + sec_debug_info, + sec_debug_line, + sec_debug_abbrev, + { ELF resources (+ references to stabs debug information sections) } + sec_code (* sec_fpc *), + { Table of contents section } + sec_code (* sec_toc *), + sec_code (* sec_init *), + sec_code (* sec_fini *), + sec_none (* sec_objc_class *), + sec_none (* sec_objc_meta_class *), + sec_none (* sec_objc_cat_cls_meth *), + sec_none (* sec_objc_cat_inst_meth *), + sec_none (* sec_objc_protocol *), + sec_none (* sec_objc_string_object *), + sec_none (* sec_objc_cls_meth *), + sec_none (* sec_objc_inst_meth *), + sec_none (* sec_objc_cls_refs *), + sec_none (* sec_objc_message_refs *), + sec_none (* sec_objc_symbols *), + sec_none (* sec_objc_category *), + sec_none (* sec_objc_class_vars *), + sec_none (* sec_objc_instance_vars *), + sec_none (* sec_objc_module_info *), + sec_none (* sec_objc_class_names *), + sec_none (* sec_objc_meth_var_types *), + sec_none (* sec_objc_meth_var_names *), + sec_none (* sec_objc_selector_strs *), + sec_none (* sec_objc_protocol_ext *), + sec_none (* sec_objc_class_ext *), + sec_none (* sec_objc_property *), + sec_none (* sec_objc_image_info *), + sec_none (* sec_objc_cstring_object *), + sec_none (* sec_objc_sel_fixup *), + sec_none (* sec_objc_data *), + sec_none (* sec_objc_const *), + sec_none (* sec_objc_sup_refs *), + sec_none (* sec_data_coalesced *), + sec_none (* sec_objc_classlist *), + sec_none (* sec_objc_nlclasslist *), + sec_none (* sec_objc_catlist *), + sec_none (* sec_objc_nlcatlist *), + sec_none (* sec_objc_protlist *) + ); + begin + Result := inherited SectionName (SecXTable [AType], AName, AOrder); + end; + + +{****************************************************************************} +{ Abstract Instruction Writer } +{****************************************************************************} + + constructor TCPUInstrWriter.create(_owner: TGNUAssembler); + begin + inherited create; + owner := _owner; + end; + +end. diff --git a/closures/compiler/alpha/aasmcpu.pas b/closures/compiler/alpha/aasmcpu.pas new file mode 100644 index 0000000000..6e1ef8d02b --- /dev/null +++ b/closures/compiler/alpha/aasmcpu.pas @@ -0,0 +1,281 @@ +{ + Copyright (c) 1998-2000 by Florian Klaempfl + + Implements the assembler classes specific for the Alpha + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +{ + Implements the assembler classes specific for the Alpha. +} +unit aasmcpu; + +{$i fpcdefs.inc} + + interface + + uses + aasmbase,globals,verbose, + cpubase,aasmtai,aasmdata,aasmsym; + + type + tai_frame = class(tai) + G,R : TRegister; + LS,LU : longint; + Constructor Create (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint); + end; + + tai_ent = class(tai) + Name : string; + Constructor Create (const ProcName : String); + end; + + + taicpu = class(tai_cpu_abstract_sym) + constructor op_none(op : tasmop); + + constructor op_reg(op : tasmop;_op1 : tregister); + constructor op_const(op : tasmop;_op1 : longint); + constructor op_ref(op : tasmop;_op1 : preference); + + constructor op_reg_reg(op : tasmop;_op1,_op2 : tregister); + constructor op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference); + constructor op_reg_const(op:tasmop; _op1: tregister; _op2: longint); + + constructor op_const_reg(op : tasmop;_op1 : longint;_op2 : tregister); + constructor op_const_const(op : tasmop;_op1,_op2 : longint); + constructor op_const_ref(op : tasmop;_op1 : longint;_op2 : preference); + + constructor op_ref_reg(op : tasmop;_op1 : preference;_op2 : tregister); + { this is only allowed if _op1 is an int value (_op1^.isintvalue=true) } + constructor op_ref_ref(op : tasmop;_op1,_op2 : preference); + + constructor op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister); + constructor op_reg_const_reg(op : tasmop;_op1 : tregister;_op2 : longint;_op3 : tregister); + constructor op_const_ref_reg(op : tasmop;_op1 : longint;_op2 : preference;_op3 : tregister); + constructor op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister; _op3 : preference); + constructor op_const_reg_ref(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : preference); + constructor op_reg_ref_const(op : tasmop;_op1 : tregister;_op2 : preference;_op3 : longint); + + { this is for Jmp instructions } + constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol); + + constructor op_sym(op : tasmop;_op1 : tasmsymbol); + constructor op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint); + constructor op_sym_ofs_reg(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister); + constructor op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference); + end; + + tai_align = class(tai_align_abstract) + { nothing to add } + end; + + procedure InitAsm; + procedure DoneAsm; + +implementation + + +{***************************************************************************** + taicpu Constructors +*****************************************************************************} + + + constructor taicpu.op_none(op : tasmop); + begin + inherited create(op); + end; + + + constructor taicpu.op_reg(op : tasmop;_op1 : tregister); + begin + inherited create(op); + ops:=1; + end; + + + constructor taicpu.op_const(op : tasmop;_op1 : longint); + begin + inherited create(op); + ops:=1; + end; + + + constructor taicpu.op_ref(op : tasmop;_op1 : preference); + begin + inherited create(op); + ops:=1; + end; + + + constructor taicpu.op_reg_reg(op : tasmop;_op1,_op2 : tregister); + begin + inherited create(op); + ops:=2; + end; + + + constructor taicpu.op_reg_const(op:tasmop; _op1: tregister; _op2: longint); + begin + inherited create(op); + ops:=2; + end; + + + constructor taicpu.op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference); + begin + inherited create(op); + ops:=2; + end; + + + constructor taicpu.op_const_reg(op : tasmop;_op1 : longint;_op2 : tregister); + begin + inherited create(op); + ops:=2; + end; + + + constructor taicpu.op_const_const(op : tasmop;_op1,_op2 : longint); + begin + inherited create(op); + ops:=2; + end; + + + constructor taicpu.op_const_ref(op : tasmop;_op1 : longint;_op2 : preference); + begin + inherited create(op); + ops:=2; + end; + + constructor taicpu.op_ref_reg(op : tasmop;_op1 : preference;_op2 : tregister); + begin + inherited create(op); + ops:=2; + end; + + + constructor taicpu.op_ref_ref(op : tasmop;_op1,_op2 : preference); + begin + inherited create(op); + ops:=2; + end; + + + constructor taicpu.op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister); + begin + inherited create(op); + ops:=3; + end; + + constructor taicpu.op_reg_const_reg(op : tasmop;_op1 : tregister;_op2 : longint;_op3 : tregister); + begin + inherited create(op); + ops:=3; + end; + + constructor taicpu.op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister;_op3 : preference); + begin + inherited create(op); + ops:=3; + end; + + constructor taicpu.op_const_ref_reg(op : tasmop;_op1 : longint;_op2 : preference;_op3 : tregister); + begin + inherited create(op); + ops:=3; + end; + + constructor taicpu.op_const_reg_ref(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : preference); + begin + inherited create(op); + ops:=3; + end; + + constructor taicpu.op_reg_ref_const(op : tasmop;_op1 : tregister;_op2 : preference;_op3 : longint); + begin + inherited create(op); + ops:=3; + end; + + + constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol); + begin + inherited create(op); + condition:=cond; + ops:=1; + end; + + + constructor taicpu.op_sym(op : tasmop;_op1 : tasmsymbol); + begin + inherited create(op); + ops:=1; + end; + + + constructor taicpu.op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint); + begin + inherited create(op); + ops:=1; + end; + + + constructor taicpu.op_sym_ofs_reg(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister); + begin + inherited create(op); + ops:=2; + end; + + + constructor taicpu.op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference); + begin + inherited create(op); + ops:=2; + end; + + Constructor tai_frame.create (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint); + + begin + Inherited Create; + typ:=ait_frame; + G:=GP; + R:=RA; + LS:=LocalSize; + LU:=L; + end; + + 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. diff --git a/closures/compiler/alpha/agaxpgas.pas b/closures/compiler/alpha/agaxpgas.pas new file mode 100644 index 0000000000..eefa51a367 --- /dev/null +++ b/closures/compiler/alpha/agaxpgas.pas @@ -0,0 +1,126 @@ +{ + Copyright (c) 1998-2000 by Florian Klaempfl + + This unit implements an asm for the DEC Alpha + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit agaxpgas; + + {$i fpcdefs.inc} + + interface + + uses + globals,systems,aasmbase,aasmtai,aasmdata, + aggas,cpubase; + + type + TAXPGNUAssembler=class(TGNUAssembler) + procedure WriteInstruction(hp : tai);override; + end; + + const + gas_reg2str : array[tregister] of string[4] = ( + '', + '','','','','','','','','','', + '','','','','','','','','','', + '','','','','','','','','','', + '','', + '','','','','','','','','','', + '','','','','','','','','','', + '','','','','','','','','','', + '','' + ); + + implementation + + const + op2str : array[tasmop] of string[14] = ( + 'addf','addg','addl','addq', + 'adds','addt','amask','and','beq','bge', + 'bgt','bic','bis','blbc','blbs','ble', + 'blt','bne','br','bsr','call_pal','cmoveq', + 'cmovge','cmovgt','cmovlbc','cmovlbs','cmovle','cmovlt', + 'cmovne','cmpbge','cmpeq','cmpgeq','cmpgle','cmpglt', + 'cmple','cmplt','cmpteq','cmptle','cmptlt','cmptun', + 'cmpule','cmpult','cpys','cpyse','cpysn','ctlz', + 'ctpop','cttz','cvtdg','cvtgd','cvtgf','cvtgq', + 'cvtlq','cvtqf','cvtqg','cvtql','cvtqs','cvtqt', + 'cvtst','cvttq','cvtts','divf','divg','divs', + 'divt','ecb','eqv','excb','extbl','extlh', + 'extll','extqh','extql','extwh','extwl','fbeq', + 'fbge','fbgt','fble','fblt','fbne','fcmoveq', + 'fcmovge','fcmovgt','fcmovle','fcmovlt','fcmovne','fetch', + 'fetch_m','ftois','ftoit','implver','insbl','inslh', + 'insll','insqh','insql','inswh','inswl','itoff', + 'itofs','itoft','jmp','jsr','jsr_coroutine','lda', + 'ldah','ldbu','ldwu','ldf','ldg','ldl', + 'ldl_l','ldq','ldq_l','ldq_u','lds','ldt', + 'maxsb8','maxsw4','maxub8','maxuw4','mb','mf_fpcr', + 'minsb8','minsw4','minub8','minuw4','mskbl','msklh', + 'mskll','mskqh','mskql','mskwh','mskwl','mt_fpcr', + 'mulf','mulg','mull','mulq', + 'muls','mult','ornot','perr','pklb','pkwb', + 'rc','ret','rpcc','rs','s4addl','s4addq', + 's4subl','s4subq','s8addl','s8addq','s8subl','s8subq', + 'sextb','sextw','sll','sqrtf','sqrtg','sqrts', + 'sqrtt','sra','srl','stb','stf','stg', + 'sts','stl','stl_c','stq','stq_c','stq_u', + 'stt','stw','subf','subg','subl', + 'subq','subs','subt','trapb','umulh','unpkbl', + 'unpkbw','wh64','wmb','xor','zap','zapnot', + 'ldgp'); + + procedure TAXPGNUAssembler.WriteInstruction (hp : tai); + begin +(* + op:=paicpu(hp)^.opcode; + calljmp:=is_calljmp(op); + { call maybe not translated to calll } + s:=#9+att_op2str[op]+cond2str[paicpu(hp)^.condition]; + if (not calljmp) and + (not att_nosuffix[op]) and + not( + (paicpu(hp)^.oper[0].typ=top_reg) and + (paicpu(hp)^.oper[0].reg in [R_ST..R_ST7]) + ) then + s:=s+att_opsize2str[paicpu(hp)^.opsize]; + { process operands } + if paicpu(hp)^.ops<>0 then + begin + { call and jmp need an extra handling } + { this code is only called if jmp isn't a labeled instruction } + if calljmp then + s:=s+#9+getopstr_jmp(paicpu(hp)^.oper[0]) + else + begin + for i:=0to paicpu(hp)^.ops-1 do + begin + if i=0 then + sep:=#9 + else + sep:=','; + s:=s+sep+getopstr(paicpu(hp)^.oper[i]) + end; + end; + end; + AsmWriteLn(s); +*) + end; + +end. diff --git a/closures/compiler/alpha/aoptcpu.pas b/closures/compiler/alpha/aoptcpu.pas new file mode 100644 index 0000000000..494edf948c --- /dev/null +++ b/closures/compiler/alpha/aoptcpu.pas @@ -0,0 +1,38 @@ +{ + 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. diff --git a/closures/compiler/alpha/aoptcpub.pas b/closures/compiler/alpha/aoptcpub.pas new file mode 100644 index 0000000000..aaad2910c3 --- /dev/null +++ b/closures/compiler/alpha/aoptcpub.pas @@ -0,0 +1,115 @@ + { + 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. diff --git a/closures/compiler/alpha/aoptcpuc.pas b/closures/compiler/alpha/aoptcpuc.pas new file mode 100644 index 0000000000..121a45370f --- /dev/null +++ b/closures/compiler/alpha/aoptcpuc.pas @@ -0,0 +1,38 @@ + { + 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. diff --git a/closures/compiler/alpha/aoptcpud.pas b/closures/compiler/alpha/aoptcpud.pas new file mode 100644 index 0000000000..c3ea9fe5f9 --- /dev/null +++ b/closures/compiler/alpha/aoptcpud.pas @@ -0,0 +1,39 @@ +{ + 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. diff --git a/closures/compiler/alpha/cgcpu.pas b/closures/compiler/alpha/cgcpu.pas new file mode 100644 index 0000000000..6706e90e48 --- /dev/null +++ b/closures/compiler/alpha/cgcpu.pas @@ -0,0 +1,167 @@ +{ + Copyright (c) 1998-2000 by Florian Klaempfl + + This unit implements the code generator for the Alpha + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +{ + This unit implements the code generator for the Alpha. +} +unit cgcpu; + +{$i fpcdefs.inc} + +interface + +uses + cgbase,cgobj,aasmbase,aasmtai,aasmdata,aasmcpu,cginfo,cpubase,cpuinfo; + +type +pcgalpha = ^tcgalpha; +tcgalpha = class(tcg) + procedure a_call_name(list : TAsmList;const s : string);override; + procedure a_load_const_reg(list : TAsmList;size : tcgsize;a : aword;register : tregister);override; + procedure a_load_reg_ref(list : TAsmList;size : tcgsize;register : tregister;const ref : treference);override; + procedure a_load_ref_reg(list : TAsmList;size : tcgsize;const ref : treference;register : tregister);override; + procedure a_load_reg_reg(list : TAsmList;fromsize, tosize : tcgsize;reg1,reg2 : tregister);override; + procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : aword; + reg : tregister; l : tasmlabel);override; + procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); + procedure a_cmp_reg_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg : tregister;l : tasmlabel); + procedure a_cmp_ref_const_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : aword; + reg : tregister; l : tasmlabel); + procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override; + procedure g_stackframe_entry(list : TAsmList;localsize : longint);override; + procedure g_maybe_loadself(list : TAsmList);override; + procedure g_restore_frame_pointer(list : TAsmList);override; +end; + +procedure create_codegen; + +implementation + +uses + globtype,globals; + +procedure tcgalpha.g_stackframe_entry(list : TAsmList;localsize : longint); + +begin + list.concat(taicpu.op_reg_ref(A_LDGP,Global_pointer,new_reference(R_27,0))); + list.concat(taicpu.op_reg_ref(A_LDA,stack_pointer_reg,new_reference(stack_pointer_reg,-LocalSize))); + If LocalSize<>0 then + list.concat(tai_frame.create(Global_pointer,LocalSize,R_27,0)); + { Always generate a frame pointer. } + list.concat(taicpu.op_reg_reg_reg(A_BIS,stack_pointer_reg,stack_pointer_reg,frame_pointer_reg)); +end; + +procedure g_exitcode(list : TAsmList;parasize : longint; nostackframe,inlined : boolean); + +begin + { Restore stack pointer from frame pointer } + list.Concat (taicpu.op_reg_reg_reg(A_BIS,frame_pointer_reg,frame_pointer_reg,stack_pointer_reg)); + { Restore previous stack position} + list.Concat (taicpu.op_reg_const_reg(A_ADDQ,stack_pointer_reg,Parasize,stack_pointer_reg)); + { return... } + list.Concat(taicpu.op_reg_ref_const(A_RET,stack_pointer_reg,new_reference(Return_pointer,0),1)); + { end directive + Concat (paiend,init('')); + } +end; + +procedure tcgalpha.a_call_name(list : TAsmList;const s : string); + + begin + { list^.concat(taicpu,op_sym(A_CALL,S_NO,newasmsymbol(s,AB_EXTERNAL,AT_FUNCTION)))); } + {!!!!!!!!!1 offset is ignored } + abstract; + end; + +procedure tcgalpha.a_load_const_reg(list : TAsmList;size : tcgsize;a : aword;register : tregister); + +begin +end; + + +procedure tcgalpha.a_load_reg_ref(list : TAsmList;size : tcgsize;register : tregister;const ref : treference); + +begin +end; + + +procedure tcgalpha.a_load_ref_reg(list : TAsmList;size : tcgsize;const ref : treference;register : tregister); + +begin +end; + + +procedure tcgalpha.a_load_reg_reg(list : TAsmList;fromsize, tosize : tcgsize;reg1,reg2 : tregister); + +begin +end; + + +procedure tcgalpha.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; + l : tasmlabel); + +begin +end; + + +procedure tcgalpha.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); + +begin +end; + + +procedure tcgalpha.a_cmp_reg_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg : tregister;l : tasmlabel); + +begin +end; + + +procedure tcgalpha.a_cmp_ref_const_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : aword; + reg : tregister; l : tasmlabel); + +begin +end; + + +procedure tcgalpha.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister); + +begin +end; + + +procedure tcgalpha.g_maybe_loadself(list : TAsmList); + +begin +end; + + +procedure tcgalpha.g_restore_frame_pointer(list : TAsmList); + +begin +end; + + +procedure create_codegen; + begin + cg:=tcgalpha.create; + end; + +end. diff --git a/closures/compiler/alpha/cpubase.pas b/closures/compiler/alpha/cpubase.pas new file mode 100644 index 0000000000..1136e1d7de --- /dev/null +++ b/closures/compiler/alpha/cpubase.pas @@ -0,0 +1,430 @@ +{ + 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; + + maxfpuregs = 32; + + max_operands = 4; + + registers_saved_on_cdecl = [R_9..R_14,R_F2..R_F9]; + + maxvarregs = 6; + varregs : Array [1..maxvarregs] of Tregister = + (R_9,R_10,R_11,R_12,R_13,R_14); + + maxfpuvarregs = 8; + + { Registers which are defined as scratch and no need to save across + routine calls or in assembler blocks. + } + max_scratch_regs = 2; + scratch_regs : array[1..max_scratch_regs] of tregister = (R_1,R_2); + +{***************************************************************************** + GDB Information +*****************************************************************************} + + { Register indexes for stabs information, when some + parameters or variables are stored in registers. + } + stab_regindex : array[tregister] of shortint = + (0, + 0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0, + 0,0, + 0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0, + 0,0 + ); + +{***************************************************************************** + Flags +*****************************************************************************} + type + { The Alpha doesn't have flags but some generic code depends on this type. } + TResFlags = (F_NO); + + + { reference record } + pparareference = ^tparareference; + tparareference = packed record + index : tregister; + offset : longint; + end; + + trefoptions=(ref_none,ref_parafixup,ref_localfixup,ref_selffixup); + + TReference = record + offset : aword; + symbol : tasmsymbol; + base : tregister; + { The index isn't used by the alpha port, but some generic code depends on it } + index : tregister; + is_immediate : boolean; + offsetfixup : word; {needed for inline} + options : trefoptions; + { the boundary to which the reference is surely aligned } + alignment : byte; + end; + PReference = ^TReference; + + TLoc=( + LOC_INVALID, { added for tracking problems} + LOC_CONSTANT, { constant value } + LOC_JUMP, { boolean results only, jump to false or true label } + LOC_FLAGS, { boolean results only, flags are set } + LOC_CREFERENCE, { in memory constant value reference (cannot change) } + LOC_REFERENCE, { in memory value } + LOC_REGISTER, { in a processor register } + LOC_CREGISTER, { Constant register which shouldn't be modified } + LOC_FPUREGISTER, { FPU stack } + LOC_CFPUREGISTER, { if it is a FPU register variable on the fpu stack } + LOC_SSEREGISTER, + LOC_CSSEREGISTER, + LOC_CMMREGISTER, + LOC_MMREGISTER + ); + + { tparamlocation describes where a parameter for a procedure is stored. + References are given from the caller's point of view. The usual + TLocation isn't used, because contains a lot of unnessary fields. + } + tparalocation = packed record + size : TCGSize; + loc : TLoc; + sp_fixup : longint; + case TLoc of + LOC_REFERENCE : (reference : tparareference); + { segment in reference at the same place as in loc_register } + LOC_REGISTER,LOC_CREGISTER : ( + case longint of + 1 : (register,register64.reghi : tregister); + { overlay a register64.reglo } + 2 : (register64.reglo : tregister); + { overlay a 64 Bit register type } + 3 : (reg64 : tregister64); + 4 : (register64 : tregister64); + ); + end; + + tlocation = packed record + loc : TLoc; + size : TCGSize; + case TLoc of + LOC_CONSTANT : ( + case longint of + 1 : (value : AWord); + { can't do this, this layout depends on the host cpu. Use } + { lo(valueqword)/hi(valueqword) instead (JM) } + { 2 : (valuelow, valuehigh:AWord); } + { overlay a complete 64 Bit value } + 3 : (valueqword : qword); + ); + LOC_CREFERENCE, + LOC_REFERENCE : (reference : treference); + { segment in reference at the same place as in loc_register } + LOC_REGISTER,LOC_CREGISTER : ( + case longint of + 1 : (register,register64.reghi,segment : tregister); + { overlay a register64.reglo } + 2 : (register64.reglo : tregister); + { overlay a 64 Bit register type } + 3 : (reg64 : tregister64); + 4 : (register64 : tregister64); + ); + end; + +{***************************************************************************** + Operands +*****************************************************************************} + + + { Types of operand } + toptype=(top_none,top_reg,top_ref,top_const,top_symbol); + + toper=record + ot : longint; + case typ : toptype of + top_none : (); + top_reg : (reg:tregister); + top_ref : (ref:preference); + top_const : (val:longint); + top_symbol : (sym:tasmsymbol;symofs:longint); + end; + + const + { Registers which must be saved when calling a routine declared as + cppdecl, cdecl, stdcall, safecall, palmossyscall. The registers + saved should be the ones as defined in the target ABI and / or GCC. + + This value can be deduced from the CALLED_USED_REGISTERS array in the + GCC source. + } + std_saved_registers = []; + { Required parameter alignment when calling a routine declared as + stdcall and cdecl. The alignment value should be the one defined + by GCC or the target ABI. + + The value of this constant is equal to the constant + PARM_BOUNDARY / BITS_PER_UNIT in the GCC source. + } + std_param_align = 8; + + { offsets for the integer and floating point registers } + INT_REG = 0; + FLOAT_REG = 32; + + { operator qualifiers } + OQ_CHOPPED_ROUNDING = $01; { /C } + OQ_ROUNDING_MODE_DYNAMIC = $02; { /D } + OQ_ROUND_TOWARD_MINUS_INFINITY = $04; { /M } + OQ_INEXACT_RESULT_ENABLE = $08; { /I } + OQ_SOFTWARE_COMPLETION_ENABLE = $10; { /S } + OQ_FLOATING_UNDERFLOW_ENABLE = $20; { /U } + OQ_INTEGER_OVERFLOW_ENABLE = $40; { /V } + + +{***************************************************************************** + Opcode propeties (needed for optimizer) +*****************************************************************************} + +{$ifndef NOOPT} +Type +{What an instruction can change} + TInsChange = (Ch_None); +{$endif} + + +{ resets all values of ref to defaults } +procedure reset_reference(var ref : treference); +{ set mostly used values of a new reference } +function new_reference(base : tregister;offset : longint) : preference; +function newreference(const r : treference) : preference; +procedure disposereference(var r : preference); + +function reg2str(r : tregister) : string; + +{***************************************************************************** + Init/Done +*****************************************************************************} + + procedure InitCpu; + procedure DoneCpu; + +implementation + +uses + verbose; + +function reg2str(r : tregister) : string; + + begin + if r in [R_0..R_31] then + reg2str:='R'+tostr(longint(r)-longint(R_0)) + else if r in [R_F0..R_F31] then + reg2str:='F'+tostr(longint(r)-longint(R_F0)) + else internalerror(38991); + end; + +procedure reset_reference(var ref : treference); +begin + FillChar(ref,sizeof(treference),0); +end; + + +function new_reference(base : tregister;offset : longint) : preference; +var + r : preference; +begin + new(r); + FillChar(r^,sizeof(treference),0); + r^.offset:=offset; + r^.alignment:=8; + new_reference:=r; +end; + +function newreference(const r : treference) : preference; + +var + p : preference; +begin + new(p); + p^:=r; + newreference:=p; +end; + +procedure disposereference(var r : preference); + +begin + dispose(r); + r:=Nil; +end; + +{***************************************************************************** + Init/Done +*****************************************************************************} + + procedure InitCpu; + begin + end; + + procedure DoneCpu; + begin + end; + +end. diff --git a/closures/compiler/alpha/cpuinfo.pas b/closures/compiler/alpha/cpuinfo.pas new file mode 100644 index 0000000000..4779b4a73a --- /dev/null +++ b/closures/compiler/alpha/cpuinfo.pas @@ -0,0 +1,68 @@ +{ + 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 } + tcputype = + (cpu_none, + ClassEV7, + ClassEV8 + ); + +Const + { Size of native extended type } + extended_size = 16; + {# Size of a pointer } + aint_size = 8; + {# Size of a multimedia register } + mmreg_size = 8; + + { target cpu string (used by compiler options) } + target_cpu_string = 'alpha'; + +Implementation + +end. diff --git a/closures/compiler/alpha/cpunode.pas b/closures/compiler/alpha/cpunode.pas new file mode 100644 index 0000000000..c62bc9c303 --- /dev/null +++ b/closures/compiler/alpha/cpunode.pas @@ -0,0 +1,54 @@ +{ + 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. diff --git a/closures/compiler/alpha/cpupara.pas b/closures/compiler/alpha/cpupara.pas new file mode 100644 index 0000000000..fe7de008a8 --- /dev/null +++ b/closures/compiler/alpha/cpupara.pas @@ -0,0 +1,290 @@ +{ + 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.typ of + orddef: + getparaloc:=LOC_REGISTER; + floatdef: + getparaloc:=LOC_FPUREGISTER; + enumdef: + getparaloc:=LOC_REGISTER; + pointerdef: + getparaloc:=LOC_REGISTER; + formaldef: + getparaloc:=LOC_REGISTER; + classrefdef: + getparaloc:=LOC_REGISTER; + recorddef: + getparaloc:=LOC_REFERENCE; + objectdef: + if is_object(p) then + getparaloc:=LOC_REFERENCE + else + getparaloc:=LOC_REGISTER; + stringdef: + if is_shortstring(p) or is_longstring(p) then + getparaloc:=LOC_REFERENCE + else + getparaloc:=LOC_REGISTER; + procvardef: + if (po_methodpointer in tprocvardef(p).procoptions) then + getparaloc:=LOC_REFERENCE + else + getparaloc:=LOC_REGISTER; + filedef: + getparaloc:=LOC_REGISTER; + arraydef: + getparaloc:=LOC_REFERENCE; + setdef: + if is_smallset(p) then + getparaloc:=LOC_REGISTER + else + getparaloc:=LOC_REFERENCE; + variantdef: + getparaloc:=LOC_REFERENCE; + { avoid problems with errornous definitions } + errordef: + getparaloc:=LOC_REGISTER; + else + internalerror(2002071001); + end; + end; + + procedure 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.returndef) then + begin + if not(ret_in_reg(p.returndef)) then + inc(nextintreg); + end; + + { frame pointer for nested procedures? } + { inc(nextintreg); } + { constructor? } + { destructor? } + hp:=tparaitem(p.para.last); + while assigned(hp) do + begin + loc:=getparaloc(hp.paratype.def); + hp.paraloc.sp_fixup:=0; + case loc of + LOC_REGISTER: + begin + hp.paraloc.size := def_cgsize(hp.paratype.def); + { for things like formaldef } + if hp.paraloc.size = OS_NO then + hp.paraloc.size := OS_ADDR; + is_64bit := hp.paraloc.size in [OS_64,OS_S64]; + if nextintreg<=tregister(ord(R_10)-ord(is_64bit)) then + begin + hp.paraloc.loc:=LOC_REGISTER; + hp.paraloc.register64.reglo:=nextintreg; + inc(nextintreg); + if is_64bit then + begin + hp.paraloc.register64.reghi:=nextintreg; + inc(nextintreg); + end; + end + else + begin + nextintreg := R_11; + hp.paraloc.loc:=LOC_REFERENCE; + hp.paraloc.reference.index:=stack_pointer_reg; + hp.paraloc.reference.offset:=stack_offset; + if not is_64bit then + inc(stack_offset,4) + else + inc(stack_offset,8); + end; + end; + LOC_FPUREGISTER: + begin + if hp.paratyp in [vs_var,vs_out] then + begin + if nextintreg<=R_10 then + begin + hp.paraloc.size:=OS_ADDR; + hp.paraloc.loc:=LOC_REGISTER; + hp.paraloc.register:=nextintreg; + inc(nextintreg); + end + else + begin + {!!!!!!!} + hp.paraloc.size:=def_cgsize(hp.paratype.def); + internalerror(2002071006); + end; + end + else if nextfloatreg<=R_F10 then + begin + hp.paraloc.size:=def_cgsize(hp.paratype.def); + hp.paraloc.loc:=LOC_FPUREGISTER; + hp.paraloc.register:=nextfloatreg; + inc(nextfloatreg); + end + else + begin + {!!!!!!!} + hp.paraloc.size:=def_cgsize(hp.paratype.def); + internalerror(2002071004); + end; + end; + LOC_REFERENCE: + begin + hp.paraloc.size:=OS_ADDR; + if push_addr_param(hp.paratype.def,p.proccalloption in [pocall_cdecl,pocall_cppdecl]) or (hp.paratyp in [vs_var,vs_out]) then + begin + if nextintreg<=R_10 then + begin + hp.paraloc.loc:=LOC_REGISTER; + hp.paraloc.register:=nextintreg; + inc(nextintreg); + end + else + begin + hp.paraloc.loc:=LOC_REFERENCE; + hp.paraloc.reference.index:=stack_pointer_reg; + hp.paraloc.reference.offset:=stack_offset; + inc(stack_offset,4); + end; + end + else + begin + hp.paraloc.loc:=LOC_REFERENCE; + hp.paraloc.reference.index:=stack_pointer_reg; + hp.paraloc.reference.offset:=stack_offset; + inc(stack_offset,hp.paratype.def.size); + end; + end; + else + internalerror(2002071002); + end; + hp:=tparaitem(hp.previous); + end; + end; + + function talphaparamanager.getfuncretparaloc(p : tabstractprocdef) : tparalocation; + begin + case p.returndef.typ of + orddef, + enumdef: + begin + getfuncretparaloc.loc:=LOC_REGISTER; + getfuncretparaloc.register:=R_3; + getfuncretparaloc.size:=def_cgsize(p.returndef); + if getfuncretparaloc.size in [OS_S64,OS_64] then + getfuncretparaloc.register64.reghi:=R_4; + end; + floatdef: + begin + getfuncretparaloc.loc:=LOC_FPUREGISTER; + getfuncretparaloc.register:=R_F1; + getfuncretparaloc.size:=def_cgsize(p.returndef); + end; + pointerdef, + formaldef, + classrefdef, + recorddef, + objectdef, + stringdef, + procvardef, + filedef, + arraydef, + errordef: + begin + getfuncretparaloc.loc:=LOC_REGISTER; + getfuncretparaloc.register:=R_3; + getfuncretparaloc.size:=OS_ADDR; + end; + else + internalerror(2002090903); + end; + end; + + +begin + paramanager:=talphaparamanager.create; +end. diff --git a/closures/compiler/alpha/cpupi.pas b/closures/compiler/alpha/cpupi.pas new file mode 100644 index 0000000000..6b1470cde0 --- /dev/null +++ b/closures/compiler/alpha/cpupi.pas @@ -0,0 +1,43 @@ +{ + 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. diff --git a/closures/compiler/alpha/cputarg.pas b/closures/compiler/alpha/cputarg.pas new file mode 100644 index 0000000000..f7e38332c7 --- /dev/null +++ b/closures/compiler/alpha/cputarg.pas @@ -0,0 +1,51 @@ +{ + 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. diff --git a/closures/compiler/alpha/radirect.pas b/closures/compiler/alpha/radirect.pas new file mode 100644 index 0000000000..e69de29bb2 diff --git a/closures/compiler/alpha/rasm.pas b/closures/compiler/alpha/rasm.pas new file mode 100644 index 0000000000..b157752923 --- /dev/null +++ b/closures/compiler/alpha/rasm.pas @@ -0,0 +1,65 @@ +{ + Copyright (c) 1998-2002 by The Free Pascal Team + + This unit does the parsing process for the inline assembler + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +{ + This unit does the parsing process for the inline assembler. +} +Unit Rasm; + +{$i fpcdefs.inc} + +Interface + +uses + node; + + { + This routine is called to parse the instructions in assembler + blocks. It returns a complete list of directive and instructions + } + function assemble: tnode; + + +Implementation + + uses + { common } + cutils,cclasses, + { global } + globtype,globals,verbose, + systems, + { aasm } + cpubase,aasmbase,aasmtai,aasmdata,aasmcpu, + { symtable } + symconst,symbase,symtype,symsym,symtable, + { pass 1 } + nbas, + { parser } + scanner + // ,rautils + ; + + function assemble : tnode; + begin + end; + +Begin +end. diff --git a/closures/compiler/alpha/rgcpu.pas b/closures/compiler/alpha/rgcpu.pas new file mode 100644 index 0000000000..94bcc197a2 --- /dev/null +++ b/closures/compiler/alpha/rgcpu.pas @@ -0,0 +1,69 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements the powerpc specific class for the register + allocator + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} + +unit rgcpu; + +{$i fpcdefs.inc} + + interface + + uses + aasmbase,aasmtai,aasmdata, + cpubase, + rgobj; + + type + trgcpu = class(trgobj) + function getcpuregisterint(list: TAsmList; reg: tregister): tregister; override; + procedure ungetregisterint(list: TAsmList; reg: tregister); override; + end; + + implementation + + uses + cgobj; + + function trgcpu.getcpuregisterint(list: TAsmList; reg: tregister): tregister; + + begin + if reg = R_0 then + begin + cg.a_reg_alloc(list,reg); + result := reg; + end + else result := inherited getcpuregisterint(list,reg); + end; + + + procedure trgcpu.ungetregisterint(list: TAsmList; reg: tregister); + + begin + if reg = R_0 then + cg.a_reg_dealloc(list,reg) + else + inherited ungetregisterint(list,reg); + end; + +initialization + rg := trgcpu.create; +end. diff --git a/closures/compiler/alpha/tgcpu.pas b/closures/compiler/alpha/tgcpu.pas new file mode 100644 index 0000000000..90c4ac5175 --- /dev/null +++ b/closures/compiler/alpha/tgcpu.pas @@ -0,0 +1,42 @@ +{ + 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. diff --git a/closures/compiler/aopt.pas b/closures/compiler/aopt.pas new file mode 100644 index 0000000000..8f39aa2a25 --- /dev/null +++ b/closures/compiler/aopt.pas @@ -0,0 +1,277 @@ +{ + 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,aasmdata,aasmcpu, + aoptobj; + + Type + TAsmOptimizer = class(TAoptObj) + + { _AsmL is the PAasmOutpout list that has to be optimized } + Constructor create(_AsmL: TAsmList); virtual; reintroduce; + + { call the necessary optimizer procedures } + Procedure Optimize; + Destructor destroy;override; + + private + procedure FindLoHiLabels; + Procedure BuildLabelTableAndFixRegAlloc; + procedure clear; + procedure pass_1; + End; + TAsmOptimizerClass = class of TAsmOptimizer; + + var + casmoptimizer : TAsmOptimizerClass; + + procedure Optimize(AsmL:TAsmList); + + Implementation + + uses + globtype, globals, + verbose, + aoptda,aoptcpu,aoptcpud; + + Constructor TAsmOptimizer.create(_AsmL: TAsmList); + 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: tai; + Begin + LabelInfo^.LowLabel := High(longint); + LabelInfo^.HighLabel := 0; + LabelInfo^.LabelDif := 0; + LabelInfo^.LabelTable:=nil; + LabelFound := False; + P := BlockStart; + With LabelInfo^ Do + Begin + While Assigned(P) And + ((P.typ <> Ait_Marker) Or + (tai_Marker(P).Kind <> mark_AsmBlockStart)) Do + Begin + If (p.typ = ait_label) and + (tai_Label(p).labsym.labeltype=alt_jump) and + (tai_Label(p).labsym.is_used) Then + Begin + LabelFound := True; + If (tai_Label(p).labsym.labelnr < LowLabel) Then + LowLabel := tai_Label(p).labsym.labelnr; + If (tai_Label(p).labsym.labelnr > HighLabel) Then + HighLabel := tai_Label(p).labsym.labelnr + End; + GetNextInstruction(p, p) + End; + blockend:=p; + 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 TAsmList. } + { Also fixes some RegDeallocs like "# %eax released; push (%eax)" } + Var p{, hp1, hp2}: tai; + {UsedRegs: TRegSet;} + LabelIdx : longint; + 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: + begin + If tai_label(p).labsym.is_used and + (tai_Label(p).labsym.labeltype=alt_jump) then + begin + LabelIdx:=tai_label(p).labsym.labelnr-LowLabel; + if LabelIdx>int64(LabelDif) then + internalerror(200604202); + LabelTable^[LabelIdx].PaiObj := p; + end; + end; + 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 assigned(LabelInfo^.labeltable) then + begin + freemem(LabelInfo^.labeltable); + LabelInfo^.labeltable := nil; + end; + LabelInfo^.labeldif:=0; + LabelInfo^.lowlabel:=high(longint); + LabelInfo^.highlabel:=0; + 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_opt_asmcse in current_settings.optimizerswitches) Then + Begin +// DFA:=TAOptDFACpu.Create(AsmL,BlockStart,BlockEnd,LabelInfo); + { data flow analyzer } +// DFA.DoDFA; + { common subexpression elimination } + { CSE;} + End; + { more peephole optimizations } + 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 = mark_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 <> mark_AsmBlockEnd)) Do; + { blockstart now contains a tai_marker(mark_AsmBlockEnd) } + If GetNextInstruction(BlockStart, HP) And + ((HP.typ <> ait_Marker) Or + (Tai_Marker(HP).Kind <> mark_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:TAsmList); + var + p : TAsmOptimizer; + begin + p:=casmoptimizer.Create(AsmL); + p.Optimize; + p.free + end; + + +end. diff --git a/closures/compiler/aoptbase.pas b/closures/compiler/aoptbase.pas new file mode 100644 index 0000000000..9c461c76c9 --- /dev/null +++ b/closures/compiler/aoptbase.pas @@ -0,0 +1,242 @@ +{ + 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,aasmdata, + 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; Abstract; + { returns whether P is a load constant instruction (load a constant } + { into a register) } + Function IsLoadConstReg(p: tai): Boolean; Virtual; Abstract; + { 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; Abstract; + + { create a paicpu Object that loads the contents of reg1 into reg2 } + Function a_load_reg_reg(reg1, reg2: TRegister): taicpu; Virtual; Abstract; + + 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 labelCanBeSkipped(p: tai_label): boolean; + begin + labelCanBeSkipped := not(p.labsym.is_used) or (p.labsym.labeltype<>alt_jump); + 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 + labelCanBeSkipped(Tai_Label(Current)))) Do + Current := tai(Current.Next); + If Assigned(Current) And + (Current.typ = ait_Marker) And + (Tai_Marker(Current).Kind = mark_NoPropInfoStart) Then + Begin + While Assigned(Current) And + ((Current.typ <> ait_Marker) Or + (Tai_Marker(Current).Kind <> mark_NoPropInfoEnd)) Do + Current := Tai(Current.Next); + End; + Until Not(Assigned(Current)) Or + (Current.typ <> ait_Marker) Or + (Tai_Marker(Current).Kind <> mark_NoPropInfoEnd); + Next := Current; + If Assigned(Current) And + Not((Current.typ In SkipInstr) or + ((Current.typ = ait_label) And + labelCanBeSkipped(Tai_Label(Current)))) + 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 [mark_AsmBlockEnd,mark_NoPropInfoEnd])) or + (Current.typ In SkipInstr) or + ((Current.typ = ait_label) And + labelCanBeSkipped(Tai_Label(Current)))) Do + Current := Tai(Current.previous); + If Assigned(Current) And + (Current.typ = ait_Marker) And + (Tai_Marker(Current).Kind = mark_NoPropInfoEnd) Then + Begin + While Assigned(Current) And + ((Current.typ <> ait_Marker) Or + (Tai_Marker(Current).Kind <> mark_NoPropInfoStart)) Do + Current := Tai(Current.previous); + End; + Until Not(Assigned(Current)) Or + (Current.typ <> ait_Marker) Or + (Tai_Marker(Current).Kind <> mark_NoPropInfoStart); + If Not(Assigned(Current)) or + (Current.typ In SkipInstr) or + ((Current.typ = ait_label) And + labelCanBeSkipped(Tai_Label(Current))) or + ((Current.typ = ait_Marker) And + (Tai_Marker(Current).Kind = mark_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; + +end. diff --git a/closures/compiler/aoptcs.pas b/closures/compiler/aoptcs.pas new file mode 100644 index 0000000000..d50a57aaba --- /dev/null +++ b/closures/compiler/aoptcs.pas @@ -0,0 +1,848 @@ +{ + 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: } +{ " , , ..." } + 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(mark_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(mark_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. diff --git a/closures/compiler/aoptda.pas b/closures/compiler/aoptda.pas new file mode 100644 index 0000000000..e7e0030ae2 --- /dev/null +++ b/closures/compiler/aoptda.pas @@ -0,0 +1,165 @@ +{ + 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,aasmdata,aasmcpu, + aoptcpub, aoptbase; + + Type + TAOptDFA = class + { uses the same constructor as TAoptCpu = constructor from TAoptObj } + + { How many instructions are between the current instruction and the } + { last one that modified the register } + InstrSinceLastMod: TInstrSinceLastMod; + + { 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; Abstract; + + { 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; Abstract; + 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; + +End. diff --git a/closures/compiler/aoptobj.pas b/closures/compiler/aoptobj.pas new file mode 100644 index 0000000000..b9c53e76be --- /dev/null +++ b/closures/compiler/aoptobj.pas @@ -0,0 +1,1156 @@ +{ + 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,aasmdata, + 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(const 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; reintroduce; + + { 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; + + TLabelTable = Array[0..2500000] Of TLabelTableItem; + PLabelTable = ^TLabelTable; + PLabelInfo = ^TLabelInfo; + TLabelInfo = Record + { the highest and lowest label number occurring in the current code } + { fragment } + LowLabel, HighLabel: longint; + LabelDif: cardinal; + { 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: TAsmList; + + { 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: TAsmList; _BlockStart, _BlockEnd: Tai; + _LabelInfo: PLabelInfo); virtual; reintroduce; + + { 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 + + l1: becomes l1: + je l2 je l3 + + 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; virtual; + 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).labsym.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).labsym.is_used))); + End; + + Function TUsedRegs.IsUsed(Reg: TRegister): Boolean; + Begin + //!!!!!!!!!!! IsUsed := Reg in UsedRegs + Result:=False; { unimplemented } + 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 + Result:=False; { unimplemented } + (*!!!!!!!!!!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 + Result:=False; { unimplemented } + (*!!!!!!!!!! + 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 := @RefsEqual + Else + { local variable which is an array } + RefsEq := @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_opt_size in current_settings.optimizerswitches) 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_opt_size in current_settings.optimizerswitches) 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 + Result:=0; { unimplemented } + //!!!! GetWState := Regs[Reg].WState + End; + + Function TPaiProp.GetRState(Reg: TRegister): TStateInt; {$ifdef inl} inline;{$endif inl} + Begin + Result:=0; { unimplemented } + //!!!! GetRState := Regs[Reg].RState + End; + + Function TPaiProp.GetRegContentType(Reg: TRegister): Byte; {$ifdef inl} inline;{$endif inl} + Begin + Result:=0; { unimplemented } + //!!!! 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, @references_equal) + Then TmpResult := True; + Inc(Counter); + GetNextInstruction(p,p) + End; + RefInSequence := TmpResult + End; + + { ************************************************************************* } + { ***************************** TAoptObj ********************************** } + { ************************************************************************* } + + Constructor TAoptObj.create(_AsmL: TAsmList; _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).labsym <> 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 = mark_AsmBlockEnd)) Then + GetNextInstruction(P, P) + Else If ((P.Typ = Ait_Marker) And + (Tai_Marker(P).Kind = mark_NoPropInfoStart)) Then + { a marker of the type mark_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 = mark_AsmBlockStart) Then + Begin + P := Tai(P.Next); + While (P.typ <> Ait_Marker) Or + (Tai_Marker(P).Kind <> mark_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).labsym.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).labsym; + end + end; + + +{$push} +{$r-} + function tAOptObj.getlabelwithsym(sym: tasmlabel): tai; + begin + if (int64(sym.labelnr) >= int64(labelinfo^.lowlabel)) and + (int64(sym.labelnr) <= int64(labelinfo^.highlabel)) then { range check, a jump can go past an assembler block! } + getlabelwithsym := labelinfo^.labeltable^[sym.labelnr-labelinfo^.lowlabel].paiobj + else + getlabelwithsym := nil; + end; +{$pop} + + function TAOptObj.GetFinalDestination(hp: taicpu; level: longint): boolean; + {traces sucessive jumps to their final destination and sets it, e.g. + je l1 je l3 + + l1: becomes l1: + je l2 je l3 + + 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 +{$ifdef arm} + (taicpu(p1).condition = C_None) and +{$endif arm} + (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 +{$ifdef arm} + (taicpu(p1).condition = C_None) and +{$endif arm} + (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} + current_asmdata.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; + tasmlabel(hp.oper[0]^.ref^.symbol).decrefs; + 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 +{$ifdef arm} + (taicpu(p).condition = C_None) and +{$endif arm} + (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 + if (hp1.typ = ait_instruction) and + taicpu(hp1).is_jmp and + (taicpu(hp1).oper[0]^.typ = top_ref) and + assigned(taicpu(hp1).oper[0]^.ref^.symbol) and + (taicpu(hp1).oper[0]^.ref^.symbol is TAsmLabel) then + TAsmLabel(taicpu(hp1).oper[0]^.ref^.symbol).decrefs; + asml.remove(hp1); + hp1.free; + end + 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 + { TODO: FIXME removing the first instruction fails} + (p<>blockstart) then + begin + hp2:=tai(hp1.next); + asml.remove(p); + tasmlabel(taicpu(p).oper[0]^.ref^.symbol).decrefs; + 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 +{$ifdef arm} + (taicpu(hp1).condition=C_None) and +{$endif arm} + (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) +{$ifdef arm} + and (taicpu(p).condition<>C_None) +{$endif arm} + then + begin + taicpu(p).condition:=inverse_cond(taicpu(p).condition); + tai_label(hp2).labsym.decrefs; + taicpu(p).oper[0]^.ref^.symbol:=taicpu(hp1).oper[0]^.ref^.symbol; + { when freeing hp1, the reference count + isn't decreased, so don't increase + + 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. diff --git a/closures/compiler/arm/aasmcpu.pas b/closures/compiler/arm/aasmcpu.pas new file mode 100644 index 0000000000..5ced8fc361 --- /dev/null +++ b/closures/compiler/arm/aasmcpu.pas @@ -0,0 +1,2807 @@ +{ + 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,aasmdata,aasmsym, + ogbase, + 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_REGF = $00201020; { coproc 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; + { IT instruction } + OT_CONDITION = $00100000; + + 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_sym) + oppostfix : TOpPostfix; + wideformat : boolean; + roundingmode : troundingmode; + procedure loadshifterop(opidx:longint;const so:tshifterop); + procedure loadregset(opidx:longint; regsetregtype: tregistertype; regsetsubregtype: tsubregister; const s:tcpuregisterset); + procedure loadconditioncode(opidx:longint;const cond:tasmcond); + procedure loadmodeflags(opidx:longint;const flags:tcpumodeflags); + constructor op_none(op : tasmop); + + constructor op_reg(op : tasmop;_op1 : tregister); + constructor op_ref(op : tasmop;const _op1 : treference); + 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; regtype: tregistertype; subreg: tsubregister; _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); + constructor op_reg_reg_reg_shifterop(op : tasmop;_op1,_op2,_op3 : tregister;_op4 : tshifterop); + { SFM/LFM } + constructor op_reg_const_ref(op : tasmop;_op1 : tregister;_op2 : aint;_op3 : treference); + + { ITxxx } + constructor op_cond(op: tasmop; cond: tasmcond); + + { CPSxx } + constructor op_modeflags(op: tasmop; flags: tcpumodeflags); + constructor op_modeflags_const(op: tasmop; flags: tcpumodeflags; a: aint); + + { *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;override; + procedure ResetPass2;override; + function CheckIfValid:boolean; + function GetString:string; + function Pass1(objdata:TObjData):longint;override; + procedure Pass2(objdata:TObjData);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(objdata:TObjData); + function Matches(p:PInsEntry):longint; + function calcsize(p:PInsEntry):shortint; + procedure gencode(objdata:TObjData); + function NeedAddrPrefix(opidx:byte):boolean; + procedure Swapoperands; + function FindInsentry(objdata:TObjData):boolean; + end; + + tai_align = class(tai_align_abstract) + { nothing to add } + end; + + tai_thumb_func = class(tai) + constructor create; + end; + + function spilling_create_load(const ref:treference;r:tregister):Taicpu; + function spilling_create_store(r:tregister; const ref:treference):Taicpu; + + 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 + and transforms special instructions to valid instruction encodings } + procedure finalizearmcode(list,listtoinsert : TAsmList); + { inserts .pdata section and dummy function prolog needed for arm-wince exception handling } + procedure InsertPData; + + 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; regsetregtype: tregistertype; regsetsubregtype: tsubregister; const s:tcpuregisterset); + var + i : byte; + begin + allocate_oper(opidx+1); + with oper[opidx]^ do + begin + if typ<>top_regset then + begin + clearop(opidx); + new(regset); + end; + regset^:=s; + regtyp:=regsetregtype; + subreg:=regsetsubregtype; + typ:=top_regset; + case regsetregtype of + R_INTREGISTER: + 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,regsetsubregtype)); + end; + R_MMREGISTER: + { both RS_S0 and RS_D0 range from 0 to 31 } + for i:=RS_D0 to RS_D31 do + begin + if assigned(add_reg_instruction_hook) and (i in regset^) then + add_reg_instruction_hook(self,newreg(R_MMREGISTER,i,regsetsubregtype)); + end; + end; + end; + end; + + + procedure taicpu.loadconditioncode(opidx:longint;const cond:tasmcond); + begin + allocate_oper(opidx+1); + with oper[opidx]^ do + begin + if typ<>top_conditioncode then + clearop(opidx); + cc:=cond; + typ:=top_conditioncode; + end; + end; + + procedure taicpu.loadmodeflags(opidx: longint; const flags: tcpumodeflags); + begin + allocate_oper(opidx+1); + with oper[opidx]^ do + begin + if typ<>top_modeflags then + clearop(opidx); + modeflags:=flags; + typ:=top_modeflags; + end; + end; + +{***************************************************************************** + taicpu Constructors +*****************************************************************************} + + constructor taicpu.op_none(op : tasmop); + begin + inherited create(op); + end; + + + { for pld } + constructor taicpu.op_ref(op : tasmop;const _op1 : treference); + begin + inherited create(op); + ops:=1; + loadref(0,_op1); + 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; regtype: tregistertype; subreg: tsubregister; _op2: tcpuregisterset); + begin + inherited create(op); + ops:=2; + loadref(0,_op1); + loadregset(1,regtype,subreg,_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_cond(op: tasmop; cond: tasmcond); + begin + inherited create(op); + ops:=0; + condition := cond; + end; + + constructor taicpu.op_modeflags(op: tasmop; flags: tcpumodeflags); + begin + inherited create(op); + ops := 1; + loadmodeflags(0,flags); + end; + + constructor taicpu.op_modeflags_const(op: tasmop; flags: tcpumodeflags; a: aint); + begin + inherited create(op); + ops := 2; + loadmodeflags(0,flags); + loadconst(1,a); + 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_reg_reg_reg_shifterop(op : tasmop;_op1,_op2,_op3 : tregister;_op4 : tshifterop); + begin + inherited create(op); + ops:=4; + loadreg(0,_op1); + loadreg(1,_op2); + loadreg(2,_op3); + loadshifterop(3,_op4); + 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 (oppostfix in [PF_None,PF_D])) or + (((opcode=A_FCPYS) or (opcode=A_FCPYD)) and (regtype = R_MMREGISTER)) + ) 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):Taicpu; + var + op: tasmop; + 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); + R_MMREGISTER : + begin + case getsubreg(r) of + R_SUBFD: + op:=A_FLDD; + R_SUBFS: + op:=A_FLDS; + else + internalerror(2009112905); + end; + result:=taicpu.op_reg_ref(op,r,ref); + end; + else + internalerror(200401041); + end; + end; + + + function spilling_create_store(r:tregister; const ref:treference):Taicpu; + var + op: tasmop; + 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); + R_MMREGISTER : + begin + case getsubreg(r) of + R_SUBFD: + op:=A_FSTD; + R_SUBFS: + op:=A_FSTS; + else + internalerror(2009112904); + end; + result:=taicpu.op_reg_ref(op,r,ref); + end; + 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, + A_FLDS,A_FLDD, + A_FMRX,A_FMXR,A_FMSTAT, + A_FMSR,A_FMRS,A_FMDRR, + A_FCPYS,A_FCPYD,A_FCVTSD,A_FCVTDS, + A_FABSS,A_FABSD,A_FSQRTS,A_FSQRTD,A_FMULS,A_FMULD, + A_FADDS,A_FADDD,A_FSUBS,A_FSUBD,A_FDIVS,A_FDIVD, + A_FMACS,A_FMACD,A_FMSCS,A_FMSCD,A_FNMACS,A_FNMACD, + A_FNMSCS,A_FNMSCD,A_FNMULS,A_FNMULD, + A_FMDHR,A_FMRDH,A_FMDLR,A_FMRDL, + A_FNEGS,A_FNEGD, + A_FSITOS,A_FSITOD,A_FTOSIS,A_FTOSID, + A_FTOUIS,A_FTOUID,A_FUITOS,A_FUITOD: + 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, + A_FCMPS,A_FCMPD,A_FCMPES,A_FCMPED,A_FCMPEZS,A_FCMPEZD, + A_FCMPZS,A_FCMPZD: + result:=operand_read; + A_SMLAL,A_UMLAL: + if opnr in [0,1] then + result:=operand_readwrite + else + result:=operand_read; + A_SMULL,A_UMULL, + A_FMRRD: + 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, + A_FSTS,A_FSTD: + { important is what happens with the involved registers } + if opnr=0 then + result := operand_read + else + { check for pre/post indexed } + result := operand_read; + //Thumb2 + A_LSL, A_LSR, A_ROR, A_ASR, A_SDIV, A_UDIV,A_MOVT: + if opnr in [0] then + result:=operand_write + else + result:=operand_read; + A_LDREX: + if opnr in [0] then + result:=operand_write + else + result:=operand_read; + A_STREX: + if opnr in [0,1,2] then + result:=operand_write; + else + internalerror(200403151); + end; + end; + + + procedure BuildInsTabCache; + var + i : longint; + begin + new(instabcache); + FillChar(instabcache^,sizeof(tinstabcache),$ff); + i:=0; + while (ihp2.typ then + exit; + case hp1.typ of + tai_const: + result:= + (tai_const(hp2).sym=tai_const(hp).sym) and + (tai_const(hp2).value=tai_const(hp).value) and + (tai(hp2.previous).typ=ait_label); + tai_const: + result:= + (tai_const(hp2).sym=tai_const(hp).sym) and + (tai_const(hp2).value=tai_const(hp).value) and + (tai(hp2.previous).typ=ait_label); + end; + end; +*) + + procedure insertpcrelativedata(list,listtoinsert : TAsmList); + var + curinspos, + penalty, + lastinspos, + { increased for every data element > 4 bytes inserted } + extradataoffset, + limit: longint; + curop : longint; + curtai : tai; + curdatatai,hp,hp2 : tai; + curdata : TAsmList; + l : tasmlabel; + doinsert, + removeref : boolean; + begin + curdata:=TAsmList.create; + lastinspos:=-1; + curinspos:=0; + extradataoffset:=0; + limit:=1016; + curtai:=tai(list.first); + doinsert:=false; + while assigned(curtai) do + begin + { instruction? } + case curtai.typ of + ait_instruction: + 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) and + { move only if we're at the first reference of a label } + (taicpu(curtai).oper[curop]^.ref^.offset=0) then + begin + { check if symbol already used. } + { if yes, reuse the symbol } + hp:=tai(curdatatai.next); + removeref:=false; + if assigned(hp) then + begin + case hp.typ of + ait_const: + begin + if (tai_const(hp).consttype=aitconst_64bit) then + inc(extradataoffset); + end; + ait_comp_64bit, + ait_real_64bit: + begin + inc(extradataoffset); + end; + ait_real_80bit: + begin + inc(extradataoffset,2); + end; + end; + if (hp.typ=ait_const) then + begin + hp2:=tai(curdata.first); + while assigned(hp2) do + begin + { if armconstequal(hp2,hp) then } + if (hp2.typ=ait_const) and (tai_const(hp2).sym=tai_const(hp).sym) + and (tai_const(hp2).value=tai_const(hp).value) and (tai(hp2.previous).typ=ait_label) + then + begin + with taicpu(curtai).oper[curop]^.ref^ do + begin + symboldata:=hp2.previous; + symbol:=tai_label(hp2.previous).labsym; + end; + removeref:=true; + break; + end; + hp2:=tai(hp2.next); + end; + end; + end; + { move or remove symbol reference } + repeat + hp:=tai(curdatatai.next); + listtoinsert.remove(curdatatai); + if removeref then + curdatatai.free + else + curdata.concat(curdatatai); + curdatatai:=hp; + until (curdatatai=nil) or (curdatatai.typ=ait_label); + if lastinspos=-1 then + lastinspos:=curinspos; + end; + end; + end; + inc(curinspos); + end; + ait_const: + begin + inc(curinspos); + if (tai_const(curtai).consttype=aitconst_64bit) then + inc(curinspos); + end; + ait_real_32bit: + begin + inc(curinspos); + end; + ait_comp_64bit, + ait_real_64bit: + begin + inc(curinspos,2); + end; + ait_real_80bit: + begin + inc(curinspos,3); + end; + end; + { special case for case jump tables } + if SimpleGetNextInstruction(curtai,hp) and + (tai(hp).typ=ait_instruction) and + (taicpu(hp).opcode=A_LDR) and + (taicpu(hp).oper[0]^.typ=top_reg) and + (taicpu(hp).oper[0]^.reg=NR_PC) then + begin + penalty:=1; + hp:=tai(hp.next); + while assigned(hp) and (hp.typ=ait_const) do + begin + inc(penalty); + hp:=tai(hp.next); + end; + end + else + penalty:=0; + + { FLD/FST VFP instructions have a limit of +/- 1024, not 4096 } + if SimpleGetNextInstruction(curtai,hp) and + (tai(hp).typ=ait_instruction) and + ((taicpu(hp).opcode=A_FLDS) or + (taicpu(hp).opcode=A_FLDD)) then + limit:=254; + + { don't miss an insert } + doinsert:=doinsert or + (not(curdata.empty) and + (curinspos-lastinspos+penalty+extradataoffset>limit)); + + { split only at real instructions else the test below fails } + if doinsert 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 + lastinspos:=-1; + extradataoffset:=0; + limit:=1016; + doinsert:=false; + hp:=tai(curtai.next); + current_asmdata.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; + + + procedure ensurethumb2encodings(list: TAsmList); + var + curtai: tai; + op2reg: TRegister; + begin + { Do Thumb-2 16bit -> 32bit transformations } + curtai:=tai(list.first); + while assigned(curtai) do + begin + case curtai.typ of + ait_instruction: + begin + case taicpu(curtai).opcode of + A_ADD: + begin + { Set wide flag for ADD Rd,Rn,Rm where registers are over R7(high register set) } + if taicpu(curtai).ops = 3 then + begin + if taicpu(curtai).oper[2]^.typ in [top_reg,top_shifterop] then + begin + if taicpu(curtai).oper[2]^.typ = top_reg then + op2reg := taicpu(curtai).oper[2]^.reg + else if taicpu(curtai).oper[2]^.shifterop^.rs <> NR_NO then + op2reg := taicpu(curtai).oper[2]^.shifterop^.rs + else + op2reg := NR_NO; + + if op2reg <> NR_NO then + begin + if (taicpu(curtai).oper[0]^.reg >= NR_R8) or + (taicpu(curtai).oper[1]^.reg >= NR_R8) or + (op2reg >= NR_R8) then + begin + taicpu(curtai).wideformat:=true; + + { Handle special cases where register rules are violated by optimizer/user } + { if d == 13 || (d == 15 && S == ‘0’) || n == 15 || m IN [13,15] then UNPREDICTABLE; } + + { Transform ADD.W Rx, Ry, R13 into ADD.W Rx, R13, Ry } + if (op2reg = NR_R13) and (taicpu(curtai).oper[2]^.typ = top_reg) then + begin + taicpu(curtai).oper[2]^.reg := taicpu(curtai).oper[1]^.reg; + taicpu(curtai).oper[1]^.reg := op2reg; + end; + end; + end; + end; + end; + end; + end; + end; + end; + + + curtai:=tai(curtai.Next); + end; + end; + + procedure finalizearmcode(list, listtoinsert: TAsmList); + begin + insertpcrelativedata(list, listtoinsert); + + { Do Thumb-2 16bit -> 32bit transformations } + if current_settings.cputype in cpu_thumb2 then + ensurethumb2encodings(list); + end; + + procedure InsertPData; + var + prolog: TAsmList; + begin + prolog:=TAsmList.create; + new_section(prolog,sec_code,'FPC_EH_PROLOG',sizeof(pint),secorder_begin); + prolog.concat(Tai_const.Createname('_ARM_ExceptionHandler', 0)); + prolog.concat(Tai_const.Create_32bit(0)); + prolog.concat(Tai_symbol.Createname_global('FPC_EH_CODE_START',AT_DATA,0)); + { dummy function } + prolog.concat(taicpu.op_reg_reg(A_MOV,NR_R15,NR_R14)); + current_asmdata.asmlists[al_start].insertList(prolog); + prolog.Free; + new_section(current_asmdata.asmlists[al_end],sec_pdata,'',sizeof(pint)); + current_asmdata.asmlists[al_end].concat(Tai_const.Createname('FPC_EH_CODE_START', 0)); + current_asmdata.asmlists[al_end].concat(Tai_const.Create_32bit(longint($ffffff01))); + 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 + Result:=False; { unimplemented } + end; + + + function taicpu.Pass1(objdata:TObjData):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:=ObjData.CurrObjSec.Size; + { Error? } + if (Insentry=nil) and (InsSize=-1) then + exit; + { set the file postion } + current_filepos:=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(objdata) then + begin + InsSize:=4; + LastInsOffset:=InsOffset; + Pass1:=InsSize; + exit; + end; + LastInsOffset:=-1; + end; + + + procedure taicpu.Pass2(objdata:TObjData); + begin + { error in pass1 ? } + if insentry=nil then + exit; + current_filepos:=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 + Result:=0; { unimplemented } + end; + + + procedure taicpu.create_ot(objdata:TObjData); + var + i,l,relsize : longint; + dummy : byte; + currsym : TObjSymbol; + 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; + currsym:=ObjData.symbolref(ref^.symbol); + if assigned(currsym) then + inc(l,currsym.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 + Result:=False; { unimplemented } + end; + + + procedure taicpu.Swapoperands; + begin + end; + + + function taicpu.FindInsentry(objdata:TObjData):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(objdata); + { set the file postion } + current_filepos:=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:TObjData); + 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 dword(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; + + +{$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,Rs + case 6: // AND Rd,Rn,Rm,imm + case 7: // AND Rd,Rn,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] + } + // + 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,Rs + case 0xA: // MOV Rd,Rm,imm + case 0xB: // MOV Rd,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] + } + // + 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,Rs + case 0xE: // CMP Rn,Rm,imm + case 0xF: // CMP Rn,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] + } + // + 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, + ++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 ,Rm + case 0x12: // MSR ,Rm + case 0x13: // MSR ,#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} + + constructor tai_thumb_func.create; + begin + inherited create; + typ:=ait_thumb_func; + end; + +begin + cai_align:=tai_align; +end. + diff --git a/closures/compiler/arm/agarmgas.pas b/closures/compiler/arm/agarmgas.pas new file mode 100644 index 0000000000..af037b2ab8 --- /dev/null +++ b/closures/compiler/arm/agarmgas.pas @@ -0,0 +1,326 @@ +{ + 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 + globtype, + aasmtai,aasmdata, + aggas, + cpubase; + + type + TARMGNUAssembler=class(TGNUassembler) + constructor create(smart: boolean); override; + function MakeCmdLine: TCmdStr; override; + procedure WriteExtraHeader; override; + end; + + TArmInstrWriter=class(TCPUInstrWriter) + procedure WriteInstruction(hp : tai);override; + end; + + TArmAppleGNUAssembler=class(TAppleGNUassembler) + constructor create(smart: boolean); override; + end; + + + const + gas_shiftmode2str : array[tshiftmode] of string[3] = ( + '','lsl','lsr','asr','ror','rrx'); + + implementation + + uses + cutils,globals,verbose, + systems, + assemble, + cpuinfo,aasmcpu, + itcpugas, + cgbase,cgutils; + +{****************************************************************************} +{ GNU Arm Assembler writer } +{****************************************************************************} + + constructor TArmGNUAssembler.create(smart: boolean); + begin + inherited create(smart); + InstrWriter := TArmInstrWriter.create(self); + end; + + + function TArmGNUAssembler.MakeCmdLine: TCmdStr; + begin + result:=inherited MakeCmdLine; + if (current_settings.fputype = fpu_soft) then + result:='-mfpu=softvfp '+result; + + if current_settings.cputype = cpu_armv7m then + result:='-march=armv7m -mthumb -mthumb-interwork '+result; + end; + + procedure TArmGNUAssembler.WriteExtraHeader; + begin + inherited WriteExtraHeader; + if current_settings.cputype in cpu_thumb2 then + AsmWriteLn(#9'.syntax unified'); + end; + +{****************************************************************************} +{ GNU/Apple ARM Assembler writer } +{****************************************************************************} + + constructor TArmAppleGNUAssembler.create(smart: boolean); + begin + inherited create(smart); + InstrWriter := TArmInstrWriter.create(self); + end; + + +{****************************************************************************} +{ Helper routines for Instruction Writer } +{****************************************************************************} + + 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(o.regtyp,r,o.subreg)); + first:=false; + end; + getopstr:=getopstr+'}'; + end; + top_conditioncode: + getopstr:=cond2str[o.cc]; + top_modeflags: + begin + getopstr:=''; + if mfA in o.modeflags then getopstr:=getopstr+'a'; + if mfI in o.modeflags then getopstr:=getopstr+'i'; + if mfF in o.modeflags then getopstr:=getopstr+'f'; + 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 TArmInstrWriter.WriteInstruction(hp : tai); + var op: TAsmOp; + postfix,s: string; + i: byte; + sep: string[3]; + begin + op:=taicpu(hp).opcode; + if current_settings.cputype in cpu_thumb2 then + begin + postfix:=''; + if taicpu(hp).wideformat then + postfix:='.w'; + + if taicpu(hp).ops = 0 then + s:=#9+gas_op2str[op]+' '+cond2str[taicpu(hp).condition]+oppostfix2str[taicpu(hp).oppostfix] + else + s:=#9+gas_op2str[op]+oppostfix2str[taicpu(hp).oppostfix]+postfix+cond2str[taicpu(hp).condition]; // Conditional infixes are deprecated in unified syntax + end + else + 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,A_FSTM,A_FLDM]) 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; + owner.AsmWriteLn(s); + end; + + + const + as_arm_gas_info : tasminfo = + ( + id : as_gas; + + idtxt : 'AS'; + asmbin : 'as'; + asmcmd : '-o $OBJ $ASM'; + supported_targets : [system_arm_linux,system_arm_wince,system_arm_gba,system_arm_palmos,system_arm_nds,system_arm_embedded,system_arm_symbian]; + flags : [af_allowdirect,af_needar,af_smartlink_sections]; + labelprefix : '.L'; + comment : '# '; + ); + + as_arm_gas_darwin_info : tasminfo = + ( + id : as_darwin; + idtxt : 'AS-Darwin'; + asmbin : 'as'; + asmcmd : '-o $OBJ $ASM -arch $ARCH'; + supported_targets : [system_arm_darwin]; + flags : [af_allowdirect,af_needar,af_smartlink_sections,af_supports_dwarf,af_stabs_use_function_absolute_addresses]; + labelprefix : 'L'; + comment : '# '; + ); + + +begin + RegisterAssembler(as_arm_gas_info,TARMGNUAssembler); + RegisterAssembler(as_arm_gas_darwin_info,TArmAppleGNUAssembler); +end. diff --git a/closures/compiler/arm/aoptcpu.pas b/closures/compiler/arm/aoptcpu.pas new file mode 100644 index 0000000000..3f116a5dfd --- /dev/null +++ b/closures/compiler/arm/aoptcpu.pas @@ -0,0 +1,343 @@ +{ + 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, aasmtai, aopt, aoptcpub; + +Type + TCpuAsmOptimizer = class(TAsmOptimizer) + { uses the same constructor as TAopObj } + function PeepHoleOptPass1Cpu(var p: tai): boolean; override; + procedure PeepHoleOptPass2;override; + End; + + + TCpuThumb2AsmOptimizer = class(TCpuAsmOptimizer) + { uses the same constructor as TAopObj } + procedure PeepHoleOptPass2;override; + End; + +Implementation + + uses + verbose, + aasmbase,aasmcpu; + + function CanBeCond(p : tai) : boolean; + begin + result:= + (p.typ=ait_instruction) and + (taicpu(p).condition=C_None) and + ((taicpu(p).opcode<>A_BLX) or + (taicpu(p).oper[0]^.typ=top_reg)); + end; + + + function TCpuAsmOptimizer.PeepHoleOptPass1Cpu(var p: tai): boolean; + var + next1: tai; + hp1: tai; + begin + result := false; + case p.typ of + ait_instruction: + begin + case taicpu(p).opcode of + A_MOV: + begin + { fold + mov reg1,reg0, shift imm1 + mov reg1,reg1, shift imm2 + to + mov reg1,reg0, shift imm1+imm2 + } + if (taicpu(p).ops=3) and + (taicpu(p).oper[0]^.typ = top_reg) and + (taicpu(p).oper[2]^.typ = top_shifterop) and + (taicpu(p).oper[2]^.shifterop^.rs = NR_NO) and + getnextinstruction(p,next1) and + (next1.typ = ait_instruction) and + (taicpu(next1).opcode = A_MOV) and + (taicpu(p).condition=taicpu(next1).condition) and + (taicpu(next1).ops=3) and + (taicpu(next1).oper[0]^.typ = top_reg) and + (taicpu(p).oper[0]^.reg=taicpu(next1).oper[0]^.reg) and + (taicpu(next1).oper[1]^.typ = top_reg) and + (taicpu(p).oper[0]^.reg=taicpu(next1).oper[1]^.reg) and + (taicpu(next1).oper[2]^.typ = top_shifterop) and + (taicpu(next1).oper[2]^.shifterop^.rs = NR_NO) and + (taicpu(p).oper[2]^.shifterop^.shiftmode=taicpu(next1).oper[2]^.shifterop^.shiftmode) then + begin + inc(taicpu(p).oper[2]^.shifterop^.shiftimm,taicpu(next1).oper[2]^.shifterop^.shiftimm); + { avoid overflows } + if taicpu(p).oper[2]^.shifterop^.shiftimm>31 then + case taicpu(p).oper[2]^.shifterop^.shiftmode of + SM_ROR: + taicpu(p).oper[2]^.shifterop^.shiftimm:=taicpu(p).oper[2]^.shifterop^.shiftimm and 31; + SM_ASR: + taicpu(p).oper[2]^.shifterop^.shiftimm:=31; + SM_LSR, + SM_LSL: + begin + hp1:=taicpu.op_reg_const(A_MOV,taicpu(p).oper[0]^.reg,0); + InsertLLItem(p.previous, p.next, hp1); + p.free; + p:=hp1; + end; + else + internalerror(2008072803); + end; + asml.remove(next1); + next1.free; + result := true; + end; + end; + A_AND: + begin + { + change + and reg2,reg1,const1 + and reg2,reg2,const2 + to + and reg2,reg1,(const1 and const2) + } + if (taicpu(p).oper[0]^.typ = top_reg) and + (taicpu(p).oper[1]^.typ = top_reg) and + (taicpu(p).oper[2]^.typ = top_const) and + GetNextInstruction(p, hp1) and + (tai(hp1).typ = ait_instruction) and + (taicpu(hp1).opcode = A_AND) and + (taicpu(p).condition=taicpu(hp1).condition) and + (taicpu(p).oppostfix=PF_None) and + (taicpu(hp1).oper[0]^.typ = top_reg) and + (taicpu(hp1).oper[1]^.typ = top_reg) and + (taicpu(hp1).oper[2]^.typ = top_const) and + (taicpu(p).oper[0]^.reg = taicpu(hp1).oper[0]^.reg) and + (taicpu(hp1).oper[0]^.reg = taicpu(hp1).oper[1]^.reg) then + begin + taicpu(p).loadConst(2,taicpu(p).oper[2]^.val and taicpu(hp1).oper[2]^.val); + taicpu(p).oppostfix:=taicpu(hp1).oppostfix; + asml.remove(hp1); + hp1.free; + end; + end; + end; + end; + end; + end; + + + { instructions modifying the CPSR can be only the last instruction } + function MustBeLast(p : tai) : boolean; + begin + Result:=(p.typ=ait_instruction) and + ((taicpu(p).opcode in [A_BL,A_BLX,A_CMP,A_CMN,A_SWI,A_TEQ,A_TST,A_CMF,A_CMFE {,A_MSR}]) or + ((taicpu(p).ops>=1) and (taicpu(p).oper[0]^.typ=top_reg) and (taicpu(p).oper[0]^.reg=NR_PC)) or + (taicpu(p).oppostfix=PF_S)); + end; + + + procedure TCpuAsmOptimizer.PeepHoleOptPass2; + var + p,hp1,hp2: tai; + l : longint; + condition : tasmcond; + hp3: tai; + WasLast: boolean; + { UsedRegs, TmpUsedRegs: TRegSet; } + + begin + p := BlockStart; + { UsedRegs := []; } + while (p <> BlockEnd) Do + begin + { UpdateUsedRegs(UsedRegs, tai(p.next)); } + case p.Typ Of + Ait_Instruction: + begin + case taicpu(p).opcode Of + A_B: + if taicpu(p).condition<>C_None then + begin + { check for + Bxx xxx + + xxx: + } + l:=0; + WasLast:=False; + GetNextInstruction(p, hp1); + while assigned(hp1) and + (l<=4) and + CanBeCond(hp1) and + { stop on labels } + not(hp1.typ=ait_label) do + begin + inc(l); + if MustBeLast(hp1) then + begin + WasLast:=True; + GetNextInstruction(hp1,hp1); + break; + end + else + GetNextInstruction(hp1,hp1); + end; + if assigned(hp1) then + begin + if FindLabel(tasmlabel(taicpu(p).oper[0]^.ref^.symbol),hp1) then + begin + if (l<=4) and (l>0) then + begin + condition:=inverse_cond(taicpu(p).condition); + hp2:=p; + GetNextInstruction(p,hp1); + p:=hp1; + repeat + if hp1.typ=ait_instruction then + taicpu(hp1).condition:=condition; + if MustBeLast(hp1) then + begin + GetNextInstruction(hp1,hp1); + break; + end + else + GetNextInstruction(hp1,hp1); + until not(assigned(hp1)) or + not(CanBeCond(hp1)) or + (hp1.typ=ait_label); + { wait with removing else GetNextInstruction could + ignore the label if it was the only usage in the + jump moved away } + tasmlabel(taicpu(hp2).oper[0]^.ref^.symbol).decrefs; + asml.remove(hp2); + hp2.free; + continue; + end; + end + else + { do not perform further optimizations if there is inctructon + in block #1 which can not be optimized. + } + if not WasLast then + begin + { check further for + Bcc xxx + + B yyy + xxx: + + yyy: + } + { hp2 points to jmp yyy } + hp2:=hp1; + { skip hp1 to xxx } + GetNextInstruction(hp1, hp1); + if assigned(hp2) and + assigned(hp1) and + (l<=3) and + (hp2.typ=ait_instruction) and + (taicpu(hp2).is_jmp) and + (taicpu(hp2).condition=C_None) and + { real label and jump, no further references to the + label are allowed } + (tasmlabel(taicpu(p).oper[0]^.ref^.symbol).getrefs=2) and + FindLabel(tasmlabel(taicpu(p).oper[0]^.ref^.symbol),hp1) then + begin + l:=0; + { skip hp1 to } + GetNextInstruction(hp1, hp1); + while assigned(hp1) and + CanBeCond(hp1) do + begin + inc(l); + GetNextInstruction(hp1, hp1); + end; + { hp1 points to yyy: } + if assigned(hp1) and + FindLabel(tasmlabel(taicpu(hp2).oper[0]^.ref^.symbol),hp1) then + begin + condition:=inverse_cond(taicpu(p).condition); + GetNextInstruction(p,hp1); + hp3:=p; + p:=hp1; + repeat + if hp1.typ=ait_instruction then + taicpu(hp1).condition:=condition; + GetNextInstruction(hp1,hp1); + until not(assigned(hp1)) or + not(CanBeCond(hp1)); + { hp2 is still at jmp yyy } + GetNextInstruction(hp2,hp1); + { hp2 is now at xxx: } + condition:=inverse_cond(condition); + GetNextInstruction(hp1,hp1); + { hp1 is now at } + repeat + taicpu(hp1).condition:=condition; + GetNextInstruction(hp1,hp1); + until not(assigned(hp1)) or + not(CanBeCond(hp1)) or + (hp1.typ=ait_label); + { + asml.remove(hp1.next) + hp1.next.free; + asml.remove(hp1); + hp1.free; + } + { remove Bcc } + tasmlabel(taicpu(hp3).oper[0]^.ref^.symbol).decrefs; + asml.remove(hp3); + hp3.free; + { remove jmp } + tasmlabel(taicpu(hp2).oper[0]^.ref^.symbol).decrefs; + asml.remove(hp2); + hp2.free; + continue; + end; + end; + end; + end; + end; + end; + end; + end; + p := tai(p.next) + end; + end; + + + procedure TCpuThumb2AsmOptimizer.PeepHoleOptPass2; + begin + { TODO: Add optimizer code } + end; + +begin + casmoptimizer:=TCpuAsmOptimizer; +End. diff --git a/closures/compiler/arm/aoptcpub.pas b/closures/compiler/arm/aoptcpub.pas new file mode 100644 index 0000000000..e85f7bea7d --- /dev/null +++ b/closures/compiler/arm/aoptcpub.pas @@ -0,0 +1,120 @@ + { + 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. diff --git a/closures/compiler/arm/aoptcpuc.pas b/closures/compiler/arm/aoptcpuc.pas new file mode 100644 index 0000000000..7532a77fa3 --- /dev/null +++ b/closures/compiler/arm/aoptcpuc.pas @@ -0,0 +1,38 @@ + { + 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. diff --git a/closures/compiler/arm/aoptcpud.pas b/closures/compiler/arm/aoptcpud.pas new file mode 100644 index 0000000000..2df7e2e49e --- /dev/null +++ b/closures/compiler/arm/aoptcpud.pas @@ -0,0 +1,40 @@ +{ + 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. diff --git a/closures/compiler/arm/armatt.inc b/closures/compiler/arm/armatt.inc new file mode 100644 index 0000000000..efc974dd25 --- /dev/null +++ b/closures/compiler/arm/armatt.inc @@ -0,0 +1,208 @@ +{ 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', +'cps', +'cpsid', +'cpsie', +'dvf', +'eor', +'exp', +'fdv', +'flt', +'fix', +'fml', +'frd', +'ldc', +'ldm', +'ldrbt', +'ldrb', +'ldr', +'ldrh', +'ldrsb', +'ldrsh', +'ldrt', +'ldf', +'lfm', +'lgn', +'log', +'mcr', +'mla', +'mov', +'mrs', +'msr', +'mnf', +'muf', +'mul', +'mvf', +'mvn', +'nop', +'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', +'ldrd', +'mcrr', +'mrrc', +'pld', +'qadd', +'qdadd', +'qdsub', +'qsub', +'smlabb', +'smlabt', +'smlatb', +'smlatt', +'smlalbb', +'smlalbt', +'smlaltb', +'smlaltt', +'smlawb', +'smlawt', +'smulbb', +'smulbt', +'smultb', +'smultt', +'smulwb', +'smulwt', +'strd', +'fabsd', +'fabss', +'faddd', +'fadds', +'fcmpd', +'fcmped', +'fcmpes', +'fcmpezd', +'fcmpezs', +'fcmps', +'fcmpzd', +'fcmpzs', +'fcpyd', +'fcpys', +'fcvtds', +'fcvtsd', +'fdivd', +'fdivs', +'fldd', +'fldm', +'flds', +'fmacd', +'fmacs', +'fmdhr', +'fmdlr', +'fmrdh', +'fmrdl', +'fmrs', +'fmrx', +'fmscd', +'fmscs', +'fmsr', +'fmstat', +'fmuld', +'fmuls', +'fmxr', +'fnegd', +'fnegs', +'fnmacd', +'fnmacs', +'fnmscd', +'fnmscs', +'fnmuld', +'fnmuls', +'fsitod', +'fsitos', +'fsqrtd', +'fsqrts', +'fstd', +'fstm', +'fsts', +'fsubd', +'fsubs', +'ftosid', +'ftosis', +'ftouid', +'ftouis', +'fuitod', +'fuitos', +'fmdrr', +'fmrrd', +'asr', +'lsr', +'lsl', +'ror', +'sdiv', +'udiv', +'movt', +'ldrex', +'strex', +'it', +'ite', +'itt', +'itee', +'itte', +'itet', +'ittt', +'iteee', +'ittee', +'itete', +'ittte', +'iteet', +'ittet', +'itett', +'itttt', +'tbb', +'tbh' +); diff --git a/closures/compiler/arm/armatts.inc b/closures/compiler/arm/armatts.inc new file mode 100644 index 0000000000..b11094b987 --- /dev/null +++ b/closures/compiler/arm/armatts.inc @@ -0,0 +1,208 @@ +{ 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, +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, +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 +); diff --git a/closures/compiler/arm/armins.dat b/closures/compiler/arm/armins.dat new file mode 100644 index 0000000000..39a3b15d56 --- /dev/null +++ b/closures/compiler/arm/armins.dat @@ -0,0 +1,628 @@ +; +; 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,reg [-"-] +; \6 - reg,reg,reg,#imm [-"-] +; \7 - reg,reg,#imm [-"-] +; +; \x8 - reg,reg [MOV,MVN] +; \x9 - reg,reg,reg [-"-] +; \xA - reg,reg,#imm [-"-] +; \xB - reg,#imm [-"-] +; +; \xC - reg,reg [CMP,CMN,TEQ,TST] +; \xD - reg,reg,reg [-"-] +; \xE - reg,reg,#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] + +[CPS] +[CPSID] +[CPSIE] + +[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 + +[NOP] + +[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] + +; EDSP instructions +[LDRDcc] + +[MCRRcc] + +[MRRCcc] + +[PLD] + +[QADDcc] + +[QDADDcc] + +[QDSUBcc] + +[QSUBcc] + +[SMLABBcc] + +[SMLABTcc] + +[SMLATBcc] + +[SMLATTcc] + +[SMLALBBcc] + +[SMLALBTcc] + +[SMLALTBcc] + +[SMLALTTcc] + +[SMLAWBcc] + +[SMLAWTcc] + +[SMULBBcc] + +[SMULBTcc] + +[SMULTBcc] + +[SMULTTcc] + +[SMULWBcc] + +[SMULWTcc] + +[STRDcc] + +; +; vfp instructions +; +[FABSDcc] + +[FABSScc] + +[FADDDcc] + +[FADDScc] + +[FCMPDcc] + +[FCMPEDcc] + +[FCMPEScc] + +[FCMPEZDcc] + +[FCMPEZScc] + +[FCMPScc] + +[FCMPZDcc] + +[FCMPZScc] + +[FCPYDcc] + +[FCPYScc] + +[FCVTDScc] + +[FCVTSDcc] + +[FDIVDcc] + +[FDIVScc] + +[FLDDcc] + +[FLDMcc] + +[FLDScc] + +[FMACDcc] + +[FMACScc] + +[FMDHRcc] + +[FMDLRcc] + +[FMRDHcc] + +[FMRDLcc] + +[FMRScc] + +[FMRXcc] + +[FMSCDcc] + +[FMSCScc] + +[FMSRcc] + +[FMSTATcc] + +[FMULDcc] + +[FMULScc] + +[FMXRcc] + +[FNEGDcc] + +[FNEGScc] + +[FNMACDcc] + +[FNMACScc] + +[FNMSCDcc] + +[FNMSCScc] + +[FNMULDcc] + +[FNMULScc] + +[FSITODcc] + +[FSITOScc] + +[FSQRTDcc] + +[FSQRTScc] + +[FSTDcc] + +[FSTMcc] + +[FSTScc] + +[FSUBDcc] + +[FSUBScc] + +[FTOSIDcc] + +[FTOSIScc] + +[FTOUIDcc] + +[FTOUIScc] + +[FUITODcc] + +[FUITOScc] + +[FMDRRcc] + +[FMRRDcc] + +; Thumb-2 + +[ASRcc] + +[LSRcc] + +[LSLcc] + +[RORcc] + +[SDIVcc] + +[UDIVcc] + +[MOVTcc] + +[LDREXcc] + +[STREXcc] + +[IT] + +[ITE] + +[ITT] + +[ITEE] + +[ITTE] + +[ITET] + +[ITTT] + +[ITEEE] + +[ITTEE] + +[ITETE] + +[ITTTE] + +[ITEET] + +[ITTET] + +[ITETT] + +[ITTTT] + +[TBB] +[TBH] diff --git a/closures/compiler/arm/armnop.inc b/closures/compiler/arm/armnop.inc new file mode 100644 index 0000000000..60560b933e --- /dev/null +++ b/closures/compiler/arm/armnop.inc @@ -0,0 +1,2 @@ +{ don't edit, this file is generated from armins.dat } +106; diff --git a/closures/compiler/arm/armop.inc b/closures/compiler/arm/armop.inc new file mode 100644 index 0000000000..ec5d50029e --- /dev/null +++ b/closures/compiler/arm/armop.inc @@ -0,0 +1,208 @@ +{ 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_CPS, +A_CPSID, +A_CPSIE, +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_MRS, +A_MSR, +A_MNF, +A_MUF, +A_MUL, +A_MVF, +A_MVN, +A_NOP, +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, +A_LDRD, +A_MCRR, +A_MRRC, +A_PLD, +A_QADD, +A_QDADD, +A_QDSUB, +A_QSUB, +A_SMLABB, +A_SMLABT, +A_SMLATB, +A_SMLATT, +A_SMLALBB, +A_SMLALBT, +A_SMLALTB, +A_SMLALTT, +A_SMLAWB, +A_SMLAWT, +A_SMULBB, +A_SMULBT, +A_SMULTB, +A_SMULTT, +A_SMULWB, +A_SMULWT, +A_STRD, +A_FABSD, +A_FABSS, +A_FADDD, +A_FADDS, +A_FCMPD, +A_FCMPED, +A_FCMPES, +A_FCMPEZD, +A_FCMPEZS, +A_FCMPS, +A_FCMPZD, +A_FCMPZS, +A_FCPYD, +A_FCPYS, +A_FCVTDS, +A_FCVTSD, +A_FDIVD, +A_FDIVS, +A_FLDD, +A_FLDM, +A_FLDS, +A_FMACD, +A_FMACS, +A_FMDHR, +A_FMDLR, +A_FMRDH, +A_FMRDL, +A_FMRS, +A_FMRX, +A_FMSCD, +A_FMSCS, +A_FMSR, +A_FMSTAT, +A_FMULD, +A_FMULS, +A_FMXR, +A_FNEGD, +A_FNEGS, +A_FNMACD, +A_FNMACS, +A_FNMSCD, +A_FNMSCS, +A_FNMULD, +A_FNMULS, +A_FSITOD, +A_FSITOS, +A_FSQRTD, +A_FSQRTS, +A_FSTD, +A_FSTM, +A_FSTS, +A_FSUBD, +A_FSUBS, +A_FTOSID, +A_FTOSIS, +A_FTOUID, +A_FTOUIS, +A_FUITOD, +A_FUITOS, +A_FMDRR, +A_FMRRD, +A_ASR, +A_LSR, +A_LSL, +A_ROR, +A_SDIV, +A_UDIV, +A_MOVT, +A_LDREX, +A_STREX, +A_IT, +A_ITE, +A_ITT, +A_ITEE, +A_ITTE, +A_ITET, +A_ITTT, +A_ITEEE, +A_ITTEE, +A_ITETE, +A_ITTTE, +A_ITEET, +A_ITTET, +A_ITETT, +A_ITTTT, +A_TBB, +A_TBH +); diff --git a/closures/compiler/arm/armreg.dat b/closures/compiler/arm/armreg.dat new file mode 100644 index 0000000000..0874db8ebb --- /dev/null +++ b/closures/compiler/arm/armreg.dat @@ -0,0 +1,108 @@ +; +; ARM registers +; +; layout +; ,,,,,, +; +NO,$00,$00,$00,INVALID,-1,-1 +; Integer registers +R0,$01,$00,$00,r0,0,0 +R1,$01,$00,$01,r1,1,1 +R2,$01,$00,$02,r2,2,2 +R3,$01,$00,$03,r3,3,3 +R4,$01,$00,$04,r4,4,4 +R5,$01,$00,$05,r5,5,5 +R6,$01,$00,$06,r6,6,6 +R7,$01,$00,$07,r7,7,7 +R8,$01,$00,$08,r8,8,8 +R9,$01,$00,$09,r9,9,9 +R10,$01,$00,$0a,r10,10,10 +R11,$01,$00,$0b,r11,11,11 +R12,$01,$00,$0c,r12,12,12 +R13,$01,$00,$0d,r13,13,13 +R14,$01,$00,$0e,r14,14,14 +R15,$01,$00,$0f,r15,15,15 + +; Float registers +F0,$02,$00,$00,f0,32,16 +F1,$02,$00,$01,f1,32,17 +F2,$02,$00,$02,f2,32,18 +F3,$02,$00,$03,f3,32,19 +F4,$02,$00,$04,f4,32,20 +F5,$02,$00,$05,f5,32,21 +F6,$02,$00,$06,f6,32,22 +F7,$02,$00,$07,f7,32,23 + +; MM registers +; S0/S1/D0 etc have the same register number because the register allocated +; cannot deal with D0 conflicting with both S0 and S1. This unfortunately +; means that we can only use 16 single precision registers instead of 32, +; even if no double precision ones are used... +S0,$04,$06,$00,s0,0,0 +S1,$04,$06,$00,s1,0,0 +D0,$04,$07,$00,d0,0,0 +S2,$04,$06,$01,s2,0,0 +S3,$04,$06,$01,s3,0,0 +D1,$04,$07,$01,d1,0,0 +S4,$04,$06,$02,s4,0,0 +S5,$04,$06,$02,s5,0,0 +D2,$04,$07,$02,d2,0,0 +S6,$04,$06,$03,s6,0,0 +S7,$04,$06,$03,s7,0,0 +D3,$04,$07,$03,d3,0,0 +S8,$04,$06,$04,s8,0,0 +S9,$04,$06,$04,s9,0,0 +D4,$04,$07,$04,d4,0,0 +S10,$04,$06,$05,s10,0,0 +S11,$04,$06,$05,s11,0,0 +D5,$04,$07,$05,d5,0,0 +S12,$04,$06,$06,s12,0,0 +S13,$04,$06,$06,s13,0,0 +D6,$04,$07,$06,d6,0,0 +S14,$04,$06,$07,s14,0,0 +S15,$04,$06,$07,s15,0,0 +D7,$04,$07,$07,d7,0,0 +S16,$04,$06,$08,s16,0,0 +S17,$04,$06,$08,s17,0,0 +D8,$04,$07,$08,d8,0,0 +S18,$04,$06,$09,s18,0,0 +S19,$04,$06,$09,s19,0,0 +D9,$04,$07,$09,d9,0,0 +S20,$04,$06,$0A,s20,0,0 +S21,$04,$06,$0A,s21,0,0 +D10,$04,$07,$0A,d10,0,0 +S22,$04,$06,$0B,s22,0,0 +S23,$04,$06,$0B,s23,0,0 +D11,$04,$07,$0B,d11,0,0 +S24,$04,$06,$0C,s24,0,0 +S25,$04,$06,$0C,s25,0,0 +D12,$04,$07,$0C,d12,0,0 +S26,$04,$06,$0D,s26,0,0 +S27,$04,$06,$0D,s27,0,0 +D13,$04,$07,$0D,d13,0,0 +S28,$04,$06,$0E,s28,0,0 +S29,$04,$06,$0E,s29,0,0 +D14,$04,$07,$0E,d14,0,0 +S30,$04,$06,$0F,s20,0,0 +S31,$04,$06,$0F,s21,0,0 +D15,$04,$07,$0F,d15,0,0 +D16,$04,$07,$10,d16,0,0 +D17,$04,$07,$11,d17,0,0 +D18,$04,$07,$12,d18,0,0 +D19,$04,$07,$13,d19,0,0 +D20,$04,$07,$14,d20,0,0 +D21,$04,$07,$15,d21,0,0 +D22,$04,$07,$16,d22,0,0 +D23,$04,$07,$17,d23,0,0 +D24,$04,$07,$18,d24,0,0 +D25,$04,$07,$19,d25,0,0 +D26,$04,$07,$1A,d26,0,0 +D27,$04,$07,$1B,d27,0,0 +D28,$04,$07,$1C,d28,0,0 +D29,$04,$07,$1D,d29,0,0 +D30,$04,$07,$1E,d30,0,0 +D31,$04,$07,$1F,d31,0,0 + +; special registers +CPSR_C,$05,$00,$00,cpsr_c,0,0 +FPSCR,$05,$00,$01,fpscr,0,0 diff --git a/closures/compiler/arm/armtab.inc b/closures/compiler/arm/armtab.inc new file mode 100644 index 0000000000..d1543befa2 --- /dev/null +++ b/closures/compiler/arm/armtab.inc @@ -0,0 +1,745 @@ +{ 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_MRS; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #16#1#15; + flags : if_arm7 + ), + ( + opcode : A_MSR; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #17#1#41#240; + flags : if_arm7 + ), + ( + opcode : A_MSR; + ops : 2; + optypes : (ot_regf,ot_reg32,ot_none,ot_none); + code : #18#1#40#240; + flags : if_arm7 + ), + ( + opcode : A_MSR; + ops : 2; + optypes : (ot_regf,ot_immediate,ot_none,ot_none); + code : #19#3#40#240; + 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_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 + ) +); diff --git a/closures/compiler/arm/cgcpu.pas b/closures/compiler/arm/cgcpu.pas new file mode 100644 index 0000000000..595dde2126 --- /dev/null +++ b/closures/compiler/arm/cgcpu.pas @@ -0,0 +1,3709 @@ +{ + + 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,aasmdata, + parabase, + cpubase,cpuinfo,node,cg64f32,rgcpu; + + + type + tcgarm = class(tcg) + { true, if the next arithmetic operation should modify the flags } + cgsetflags : boolean; + + procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const paraloc : TCGPara);override; + procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);override; + procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : TCGPara);override; + + procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override; + procedure a_call_reg(list : TAsmList;reg: tregister);override; + procedure a_call_ref(list : TAsmList;ref: treference);override; + + procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); override; + procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister); override; + + procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg; + size: tcgsize; a: tcgint; src, dst: tregister); override; + procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; + size: tcgsize; src1, src2, dst: tregister); override; + procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);override; + procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);override; + + { move instructions } + procedure a_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);override; + procedure a_load_reg_reg(list : TAsmList; fromsize, tosize : tcgsize;reg1,reg2 : tregister);override; + function a_internal_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference):treference; + function a_internal_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister):treference; + + { fpu move instructions } + procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override; + procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override; + procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override; + + procedure a_loadfpu_ref_cgpara(list : TAsmList;size : tcgsize;const ref : treference;const paraloc : TCGPara);override; + { comparison operations } + procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; + l : tasmlabel);override; + procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override; + + procedure a_jmp_name(list : TAsmList;const s : string); override; + procedure a_jmp_always(list : TAsmList;l: tasmlabel); override; + procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); override; + + procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); override; + + procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override; + procedure g_proc_exit(list : TAsmList;parasize : longint;nostackframe:boolean); override; + + procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override; + + procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);override; + procedure g_concatcopy_unaligned(list : TAsmList;const source,dest : treference;len : tcgint);override; + procedure g_concatcopy_move(list : TAsmList;const source,dest : treference;len : tcgint); + procedure g_concatcopy_internal(list : TAsmList;const source,dest : treference;len : tcgint;aligned : boolean); + + procedure g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef); override; + procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation);override; + + procedure g_save_registers(list : TAsmList);override; + procedure g_restore_registers(list : TAsmList);override; + + procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel); + procedure fixref(list : TAsmList;var ref : treference); + function handle_load_store(list:TAsmList;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference):treference; virtual; + + procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override; + procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint); override; + procedure g_stackpointer_alloc(list : TAsmList;size : longint);override; + + procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize : tcgsize;reg1, reg2: tregister;shuffle : pmmshuffle); override; + procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); override; + procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize : tcgsize;reg: tregister; const ref: treference;shuffle : pmmshuffle); override; + procedure a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize : tcgsize;intreg, mmreg: tregister; shuffle: pmmshuffle); override; + procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize : tcgsize;mmreg, intreg: tregister; shuffle : pmmshuffle); override; + + procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size : tcgsize;src,dst: tregister;shuffle : pmmshuffle); override; + { Transform unsupported methods into Internal errors } + procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override; + private + { clear out potential overflow bits from 8 or 16 bit operations } + { the upper 24/16 bits of a register after an operation } + procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister); + function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol; + end; + + tarmcgarm = class(tcgarm) + procedure init_register_allocators;override; + procedure done_register_allocators;override; + + procedure a_load_const_reg(list : TAsmList; size: tcgsize; a : tcgint;reg : tregister);override; + procedure a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);override; + end; + + tcg64farm = class(tcg64f32) + procedure a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);override; + procedure a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);override; + procedure a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);override; + procedure a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);override; + procedure a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override; + procedure a_op64_reg_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override; + procedure a_loadmm_intreg64_reg(list: TAsmList; mmsize: tcgsize; intreg: tregister64; mmreg: tregister);override; + procedure a_loadmm_reg_intreg64(list: TAsmList; mmsize: tcgsize; mmreg: tregister; intreg: tregister64);override; + end; + + Tthumb2cgarm = class(tcgarm) + procedure init_register_allocators;override; + procedure done_register_allocators;override; + + procedure a_call_reg(list : TAsmList;reg: tregister);override; + + procedure a_load_const_reg(list : TAsmList; size: tcgsize; a : tcgint;reg : tregister);override; + procedure a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);override; + + procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);override; + procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);override; + + procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); override; + + procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override; + procedure g_proc_exit(list : TAsmList;parasize : longint;nostackframe:boolean); override; + + function handle_load_store(list:TAsmList;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference):treference; override; + end; + + tthumb2cg64farm = class(tcg64farm) + procedure a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);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); + + winstackpagesize = 4096; + + function get_fpu_postfix(def : tdef) : toppostfix; + procedure create_codegen; + + implementation + + + uses + globals,verbose,systems,cutils, + aopt,aoptcpu, + fmodule, + symconst,symsym, + tgobj, + procinfo,cpupi, + paramgr; + + + function get_fpu_postfix(def : tdef) : toppostfix; + begin + if def.typ=floatdef then + begin + case tfloatdef(def).floattype of + s32real: + result:=PF_S; + s64real: + result:=PF_D; + s80real: + result:=PF_E; + else + internalerror(200401272); + end; + end + else + internalerror(200401271); + end; + + + procedure tarmcgarm.init_register_allocators; + begin + inherited init_register_allocators; + { currently, we save R14 always, so we can use it } + if (target_info.system<>system_arm_darwin) then + 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,[]) + else + { r9 is not (always) available on Darwin according to the llvm code + generator. } + 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_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,[]); + { The register allocator currently cannot deal with multiple + non-overlapping subregs per register, so we can only use + half the single precision registers for now (as sub registers of the + double precision ones). } + if current_settings.fputype=fpu_vfpv3 then + rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBFD, + [RS_D0,RS_D1,RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7, + RS_D16,RS_D17,RS_D18,RS_D19,RS_D20,RS_D21,RS_D22,RS_D23,RS_D24,RS_D25,RS_D26,RS_D27,RS_D28,RS_D29,RS_D30,RS_D31, + RS_D8,RS_D9,RS_D10,RS_D11,RS_D12,RS_D13,RS_D14,RS_D15 + ],first_mm_imreg,[]) + else + rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBFD, + [RS_D0,RS_D1,RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7,RS_D8,RS_D9,RS_D10,RS_D11,RS_D12,RS_D13,RS_D14,RS_D15],first_mm_imreg,[]); + end; + + + procedure tarmcgarm.done_register_allocators; + begin + rg[R_INTREGISTER].free; + rg[R_FPUREGISTER].free; + rg[R_MMREGISTER].free; + inherited done_register_allocators; + end; + + + procedure tarmcgarm.a_load_const_reg(list : TAsmList; size: tcgsize; a : tcgint;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))) + { loading of constants with mov and orr } + else if (is_shifter_const(a-byte(a),imm_shift)) then + begin + list.concat(taicpu.op_reg_const(A_MOV,reg,a-byte(a))); + list.concat(taicpu.op_reg_reg_const(A_ORR,reg,reg,byte(a))); + end + else if (is_shifter_const(a-word(a),imm_shift)) and (is_shifter_const(word(a),imm_shift)) then + begin + list.concat(taicpu.op_reg_const(A_MOV,reg,a-word(a))); + list.concat(taicpu.op_reg_reg_const(A_ORR,reg,reg,word(a))); + end + else if (is_shifter_const(a-(dword(a) shl 8) shr 8,imm_shift)) and (is_shifter_const((dword(a) shl 8) shr 8,imm_shift)) then + begin + list.concat(taicpu.op_reg_const(A_MOV,reg,a-(dword(a) shl 8) shr 8)); + list.concat(taicpu.op_reg_reg_const(A_ORR,reg,reg,(dword(a) shl 8) shr 8)); + end + else + begin + reference_reset(hr,4); + + current_asmdata.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; + hr.base:=NR_PC; + list.concat(taicpu.op_reg_ref(A_LDR,reg,hr)); + end; + end; + + + procedure tarmcgarm.a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister); + var + oppostfix:toppostfix; + usedtmpref: treference; + tmpreg,tmpreg2 : tregister; + so : tshifterop; + dir : integer; + begin + if (TCGSize2Size[FromSize] >= TCGSize2Size[ToSize]) then + FromSize := ToSize; + 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(200308297); + end; + if (ref.alignment in [1,2]) and (ref.alignmentNR_NO) or + (ref.offset<-4095) or + (ref.offset>4094) or + { sometimes the compiler reused registers } + (reg=ref.index) or + (reg=ref.base) then + begin + tmpreg2:=getintregister(list,OS_INT); + a_loadaddr_ref_reg(list,ref,tmpreg2); + reference_reset_base(usedtmpref,tmpreg2,0,ref.alignment); + end + else + usedtmpref:=ref; + + if target_info.endian=endian_big then + inc(usedtmpref.offset,1); + shifterop_reset(so);so.shiftmode:=SM_LSL;so.shiftimm:=8; + tmpreg:=getintregister(list,OS_INT); + a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,reg); + inc(usedtmpref.offset,dir); + if FromSize=OS_16 then + a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg) + else + a_internal_load_ref_reg(list,OS_S8,OS_S8,usedtmpref,tmpreg); + list.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,reg,reg,tmpreg,so)); + end; + OS_32,OS_S32: + begin + tmpreg:=getintregister(list,OS_INT); + + { only complicated references need an extra loadaddr } + if assigned(ref.symbol) or + (ref.index<>NR_NO) or + (ref.offset<-4095) or + (ref.offset>4092) or + { sometimes the compiler reused registers } + (reg=ref.index) or + (reg=ref.base) then + begin + tmpreg2:=getintregister(list,OS_INT); + a_loadaddr_ref_reg(list,ref,tmpreg2); + reference_reset_base(usedtmpref,tmpreg2,0,ref.alignment); + end + else + usedtmpref:=ref; + + shifterop_reset(so);so.shiftmode:=SM_LSL; + if ref.alignment=2 then + begin + if target_info.endian=endian_big then + inc(usedtmpref.offset,2); + a_internal_load_ref_reg(list,OS_16,OS_16,usedtmpref,reg); + inc(usedtmpref.offset,dir*2); + a_internal_load_ref_reg(list,OS_16,OS_16,usedtmpref,tmpreg); + so.shiftimm:=16; + list.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,reg,reg,tmpreg,so)); + end + else + begin + if target_info.endian=endian_big then + inc(usedtmpref.offset,3); + a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,reg); + inc(usedtmpref.offset,dir); + a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg); + so.shiftimm:=8; + list.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,reg,reg,tmpreg,so)); + inc(usedtmpref.offset,dir); + a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg); + so.shiftimm:=16; + list.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,reg,reg,tmpreg,so)); + inc(usedtmpref.offset,dir); + a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg); + so.shiftimm:=24; + list.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,reg,reg,tmpreg,so)); + end; + end + else + handle_load_store(list,A_LDR,oppostfix,reg,ref); + end; + end + else + handle_load_store(list,A_LDR,oppostfix,reg,ref); + + if (fromsize=OS_S8) and (tosize = OS_16) then + a_load_reg_reg(list,OS_16,OS_32,reg,reg); + end; + + + procedure tcgarm.a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const paraloc : TCGPara); + var + ref: treference; + begin + paraloc.check_simple_location; + paramanager.allocparaloc(list,paraloc.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,paraloc.alignment); + 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_load_ref_cgpara(list : TAsmList;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 + paramanager.allocparaloc(list,location); + 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,paraloc.alignment); + { doubles in softemu mode have a strange order of registers and references } + if location^.size=OS_32 then + g_concatcopy(list,tmpref,ref,4) + else + begin + g_concatcopy(list,tmpref,ref,sizeleft); + if assigned(location^.next) then + internalerror(2005010710); + end; + end; + LOC_FPUREGISTER,LOC_CFPUREGISTER: + case location^.size of + OS_F32, OS_F64: + a_loadfpu_ref_reg(list,location^.size,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_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : TCGPara); + var + ref: treference; + tmpreg: tregister; + begin + paraloc.check_simple_location; + paramanager.allocparaloc(list,paraloc.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,paraloc.alignment); + 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 : TAsmList;const s : string; weak: boolean); + var + branchopcode: tasmop; + begin + { check not really correct: should only be used for non-Thumb cpus } + if (current_settings.cputypesystem_arm_darwin then + if not weak then + list.concat(taicpu.op_sym(branchopcode,current_asmdata.RefAsmSymbol(s))) + else + list.concat(taicpu.op_sym(branchopcode,current_asmdata.WeakRefAsmSymbol(s))) + else + list.concat(taicpu.op_sym(branchopcode,get_darwin_call_stub(s,weak))); +{ + the compiler does not properly set this flag anymore in pass 1, and + for now we only need it after pass 2 (I hope) (JM) + 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 : TAsmList;reg: tregister); + begin + { check not really correct: should only be used for non-Thumb cpus } + if (current_settings.cputype-2147483648) and{$endif} is_shifter_const(-a,shift) then + case op of + OP_ADD: + begin + op:=OP_SUB; + a:=aint(dword(-a)); + end; + OP_SUB: + begin + op:=OP_ADD; + a:=aint(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: + internalerror(200308281); + OP_SHL: + begin + if a>32 then + internalerror(200308294); + 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_ROL: + begin + if a>32 then + internalerror(200308294); + if a<>0 then + begin + shifterop_reset(so); + so.shiftmode:=SM_ROR; + so.shiftimm:=32-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_ROR: + begin + if a>32 then + internalerror(200308294); + if a<>0 then + begin + shifterop_reset(so); + so.shiftmode:=SM_ROR; + 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(200308295); + 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 + {if (op in [OP_SUB, OP_ADD]) and + ((a < 0) or + (a > 4095)) then + begin + tmpreg:=getintregister(list,size); + list.concat(taicpu.op_reg_const(A_MOVT, tmpreg, (a shr 16) and $FFFF)); + list.concat(taicpu.op_reg_const(A_MOV, tmpreg, a and $FFFF)); + list.concat(setoppostfix(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],dst,src,tmpreg),toppostfix(ord(cgsetflags or setflags)*ord(PF_S)) + )); + 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,OP_DIV,OP_IDIV]) 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,OP_IDIV]) 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) + { for example : b=a*5 -> b=a*4+a with add instruction and shl } + else if (op in [OP_MUL,OP_IMUL]) and ispowerof2(a-1,l1) and not(cgsetflags or setflags) then + begin + if l1>32 then{roozbeh does this ever happen?} + internalerror(200308296); + shifterop_reset(so); + so.shiftmode:=SM_LSL; + so.shiftimm:=l1; + list.concat(taicpu.op_reg_reg_reg_shifterop(A_ADD,dst,src,src,so)); + end + 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; + maybeadjustresult(list,op,size,dst); + end; + + + procedure tcgarm.a_op_reg_reg_reg_checkoverflow(list: TAsmList; 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_ROL: + begin + if not(size in [OS_32,OS_S32]) then + internalerror(2008072801); + { simulate ROL by ror'ing 32-value } + tmpreg:=getintregister(list,OS_32); + list.concat(taicpu.op_reg_const(A_MOV,tmpreg,32)); + list.concat(taicpu.op_reg_reg_reg(A_SUB,src1,tmpreg,src1)); + shifterop_reset(so); + so.rs:=src1; + so.shiftmode:=SM_ROR; + list.concat(taicpu.op_reg_reg_shifterop(A_MOV,dst,src2,so)); + end; + OP_ROR: + begin + if not(size in [OS_32,OS_S32]) then + internalerror(2008072802); + shifterop_reset(so); + so.rs:=src1; + so.shiftmode:=SM_ROR; + 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; + maybeadjustresult(list,op,size,dst); + end; + + + function tcgarm.handle_load_store(list:TAsmList;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference):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,A_FLDS,A_FLDD,A_FSTS,A_FSTD]) and + ((ref.offset<-1020) or + (ref.offset>1020) or + ((abs(ref.offset) mod 4)<>0) or + { the usual pc relative symbol handling assumes possible offsets of +/- 4095 } + assigned(ref.symbol) + ) + ) then + begin + reference_reset(tmpref,4); + + { load symbol } + tmpreg:=getintregister(list,OS_INT); + if assigned(ref.symbol) then + begin + current_asmdata.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)); + + { in case of LDF/STF, we got rid of the NR_R15 } + if is_pc(ref.base) then + ref.base:=NR_NO; + if is_pc(ref.index) then + ref.index:=NR_NO; + 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,A_FLDS,A_FLDD,A_FSTS,A_FSTD]) 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)); + Result := ref; + end; + + + procedure tcgarm.a_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference); + var + oppostfix:toppostfix; + usedtmpref: treference; + tmpreg : tregister; + so : tshifterop; + dir : integer; + begin + if (TCGSize2Size[FromSize] >= TCGSize2Size[ToSize]) then + FromSize := ToSize; + case ToSize of + { signed integer registers } + OS_8, + OS_S8: + oppostfix:=PF_B; + OS_16, + OS_S16: + oppostfix:=PF_H; + OS_32, + OS_S32, + { for vfp value stored in integer register } + OS_F32: + oppostfix:=PF_None; + else + InternalError(200308295); + end; + if (ref.alignment in [1,2]) and (ref.alignment32) or (tcgsize2size[tosize]>32) or (fromsize=OS_NO) or (tosize=OS_NO) then + internalerror(2002090901); + + conv_done:=false; + if tosize<>fromsize then + begin + shifterop_reset(so); + conv_done:=true; + if tcgsize2size[tosize]<=tcgsize2size[fromsize] then + fromsize:=tosize; + case fromsize of + OS_8: + list.concat(taicpu.op_reg_reg_const(A_AND,reg2,reg1,$ff)); + OS_S8: + begin + do_shift(SM_LSL,24,reg1); + if tosize=OS_16 then + begin + do_shift(SM_ASR,8,reg2); + do_shift(SM_LSR,16,reg2); + end + else + do_shift(SM_ASR,24,reg2); + end; + OS_16: + begin + do_shift(SM_LSL,16,reg1); + do_shift(SM_LSR,16,reg2); + end; + OS_S16: + begin + do_shift(SM_LSL,16,reg1); + do_shift(SM_ASR,16,reg2) + end; + else + conv_done:=false; + end; + end; + if not conv_done and (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; + + + procedure tcgarm.a_loadfpu_ref_cgpara(list : TAsmList;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: + begin + paramanager.allocparaloc(list,paraloc.location); + a_loadfpu_ref_reg(list,size,size,ref,hloc^.register); + end; + LOC_REGISTER : + case hloc^.size of + OS_32, + OS_F32: + begin + paramanager.allocparaloc(list,paraloc.location); + a_load_ref_reg(list,OS_32,OS_32,href,hloc^.register); + end; + OS_64, + OS_F64: + cg64.a_load64_ref_cgpara(list,href,paraloc); + else + a_load_ref_reg(list,hloc^.size,hloc^.size,href,hloc^.register); + end; + LOC_REFERENCE : + begin + reference_reset_base(href2,hloc^.reference.index,hloc^.reference.offset,paraloc.alignment); + { concatcopy should choose the best way to copy the data } + g_concatcopy(list,href,href2,tcgsize2size[hloc^.size]); + end; + else + internalerror(200408241); + end; + inc(href.offset,tcgsize2size[hloc^.size]); + hloc:=hloc^.next; + end; + end; + + + procedure tcgarm.a_loadfpu_reg_reg(list: TAsmList; fromsize,tosize: tcgsize; reg1, reg2: tregister); + begin + list.concat(setoppostfix(taicpu.op_reg_reg(A_MVF,reg2,reg1),cgsize2fpuoppostfix[tosize])); + end; + + + procedure tcgarm.a_loadfpu_ref_reg(list: TAsmList; fromsize,tosize: tcgsize; const ref: treference; reg: tregister); + var + oppostfix:toppostfix; + begin + case fromsize of + OS_32, + OS_F32: + oppostfix:=PF_S; + OS_64, + OS_F64: + oppostfix:=PF_D; + OS_F80: + oppostfix:=PF_E; + else + InternalError(200309021); + end; + handle_load_store(list,A_LDF,oppostfix,reg,ref); + if fromsize<>tosize then + a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg); + end; + + + procedure tcgarm.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); + var + oppostfix:toppostfix; + begin + case tosize 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 : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;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_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); + begin + Comment(V_Error,'tcgarm.a_bit_scan_reg_reg method not implemented'); + end; + + procedure tcgarm.a_cmp_reg_reg_label(list : TAsmList;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 : TAsmList;const s : string); + var + ai : taicpu; + begin + ai:=taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(s)); + ai.is_jmp:=true; + list.concat(ai); + end; + + + procedure tcgarm.a_jmp_always(list : TAsmList;l: tasmlabel); + var + ai : taicpu; + begin + ai:=taicpu.op_sym(A_B,l); + ai.is_jmp:=true; + list.concat(ai); + end; + + + procedure tcgarm.a_jmp_flags(list : TAsmList;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: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); + 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 : TAsmList;localsize : longint;nostackframe:boolean); + var + ref : treference; + shift : byte; + firstfloatreg,lastfloatreg, + r : byte; + mmregs, + regs : tcpuregisterset; + stackmisalignment : pint; + postfix: toppostfix; + begin + LocalSize:=align(LocalSize,4); + { call instruction does not put anything on the stack } + stackmisalignment:=0; + if not(nostackframe) then + begin + firstfloatreg:=RS_NO; + mmregs:=[]; + case current_settings.fputype of + fpu_fpa, + fpu_fpa10, + fpu_fpa11: + begin + { save floating point registers? } + regs:=rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall); + for r:=RS_F0 to RS_F7 do + if r in regs then + begin + if firstfloatreg=RS_NO then + firstfloatreg:=r; + lastfloatreg:=r; + inc(stackmisalignment,12); + end; + end; + fpu_vfpv2, + fpu_vfpv3: + begin; + mmregs:=rg[R_MMREGISTER].used_in_proc-paramanager.get_volatile_registers_mm(pocall_stdcall); + end; + end; + a_reg_alloc(list,NR_STACK_POINTER_REG); + if current_procinfo.framepointer<>NR_STACK_POINTER_REG then + begin + 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)); + end; + { save int registers } + reference_reset(ref,4); + ref.index:=NR_STACK_POINTER_REG; + ref.addressmode:=AM_PREINDEXED; + regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall); + { the (old) ARM APCS requires saving both the stack pointer (to + crawl the stack) and the PC (to identify the function this + stack frame belongs to) -> also save R12 (= copy of R13 on entry) + and R15 -- still needs updating for EABI and Darwin, they don't + need that } + if current_procinfo.framepointer<>NR_STACK_POINTER_REG then + regs:=regs+[RS_FRAME_POINTER_REG,RS_R12,RS_R14,RS_R15] + else + if (regs<>[]) or (pi_do_call in current_procinfo.flags) then + include(regs,RS_R14); + if regs<>[] then + begin + for r:=RS_R0 to RS_R15 do + if (r in regs) then + inc(stackmisalignment,4); + list.concat(setoppostfix(taicpu.op_ref_regset(A_STM,ref,R_INTREGISTER,R_SUBWHOLE,regs),PF_FD)); + end; + + if current_procinfo.framepointer<>NR_STACK_POINTER_REG then + begin + { the framepointer now points to the saved R15, so the saved + framepointer is at R11-12 (for get_caller_frame) } + list.concat(taicpu.op_reg_reg_const(A_SUB,NR_FRAME_POINTER_REG,NR_R12,4)); + a_reg_dealloc(list,NR_R12); + end; + + stackmisalignment:=stackmisalignment mod current_settings.alignment.localalignmax; + if (LocalSize<>0) or + ((stackmisalignment<>0) and + ((pi_do_call in current_procinfo.flags) or + (po_assembler in current_procinfo.procdef.procoptions))) then + begin + localsize:=align(localsize+stackmisalignment,current_settings.alignment.localalignmax)-stackmisalignment; + if not(is_shifter_const(localsize,shift)) then + begin + if current_procinfo.framepointer=NR_STACK_POINTER_REG then + a_reg_alloc(list,NR_R12); + 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; + end; + + if (mmregs<>[]) or + (firstfloatreg<>RS_NO) then + begin + reference_reset(ref,4); + if (tg.direction*tarmprocinfo(current_procinfo).floatregstart>=1023) or + (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3]) then + begin + if not is_shifter_const(tarmprocinfo(current_procinfo).floatregstart,shift) then + begin + a_reg_alloc(list,NR_R12); + a_load_const_reg(list,OS_ADDR,-tarmprocinfo(current_procinfo).floatregstart,NR_R12); + list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_R12,current_procinfo.framepointer,NR_R12)); + a_reg_dealloc(list,NR_R12); + end + else + list.concat(taicpu.op_reg_reg_const(A_SUB,NR_R12,current_procinfo.framepointer,-tarmprocinfo(current_procinfo).floatregstart)); + ref.base:=NR_R12; + end + else + begin + ref.base:=current_procinfo.framepointer; + ref.offset:=tarmprocinfo(current_procinfo).floatregstart; + end; + + case current_settings.fputype of + fpu_fpa, + fpu_fpa10, + fpu_fpa11: + begin + list.concat(taicpu.op_reg_const_ref(A_SFM,newreg(R_FPUREGISTER,firstfloatreg,R_SUBWHOLE), + lastfloatreg-firstfloatreg+1,ref)); + end; + fpu_vfpv2, + fpu_vfpv3: + begin + ref.index:=ref.base; + ref.base:=NR_NO; + { FSTMX is deprecated on ARMv6 and later } + if (current_settings.cputypeRS_NO) or + (mmregs<>[]) then + begin + reference_reset(ref,4); + if (tg.direction*tarmprocinfo(current_procinfo).floatregstart>=1023) or + (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3]) then + begin + if not is_shifter_const(tarmprocinfo(current_procinfo).floatregstart,shift) then + begin + a_reg_alloc(list,NR_R12); + a_load_const_reg(list,OS_ADDR,-tarmprocinfo(current_procinfo).floatregstart,NR_R12); + list.concat(taicpu.op_reg_reg_reg(A_SUB,NR_R12,current_procinfo.framepointer,NR_R12)); + a_reg_dealloc(list,NR_R12); + end + else + list.concat(taicpu.op_reg_reg_const(A_SUB,NR_R12,current_procinfo.framepointer,-tarmprocinfo(current_procinfo).floatregstart)); + ref.base:=NR_R12; + end + else + begin + ref.base:=current_procinfo.framepointer; + ref.offset:=tarmprocinfo(current_procinfo).floatregstart; + end; + case current_settings.fputype of + fpu_fpa, + fpu_fpa10, + fpu_fpa11: + begin + list.concat(taicpu.op_reg_const_ref(A_LFM,newreg(R_FPUREGISTER,firstfloatreg,R_SUBWHOLE), + lastfloatreg-firstfloatreg+1,ref)); + end; + fpu_vfpv2, + fpu_vfpv3: + begin + ref.index:=ref.base; + ref.base:=NR_NO; + { FLDMX is deprecated on ARMv6 and later } + if (current_settings.cputype[]) then + begin + exclude(regs,RS_R14); + include(regs,RS_R15); + end; + { restore saved stack pointer to SP (R13) and saved lr to PC (R15). + The saved PC came after that but is discarded, since we restore + the stack pointer } + if (current_procinfo.framepointer<>NR_STACK_POINTER_REG) then + regs:=regs+[RS_FRAME_POINTER_REG,RS_R13,RS_R15]; + + for r:=RS_R0 to RS_R15 do + if (r in regs) then + inc(stackmisalignment,4); + stackmisalignment:=stackmisalignment mod current_settings.alignment.localalignmax; + if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then + begin + LocalSize:=current_procinfo.calc_stackframe_size; + if (LocalSize<>0) or + ((stackmisalignment<>0) and + ((pi_do_call in current_procinfo.flags) or + (po_assembler in current_procinfo.procdef.procoptions))) then + begin + localsize:=align(localsize+stackmisalignment,current_settings.alignment.localalignmax)-stackmisalignment; + if not(is_shifter_const(LocalSize,shift)) then + begin + a_reg_alloc(list,NR_R12); + a_load_const_reg(list,OS_ADDR,LocalSize,NR_R12); + list.concat(taicpu.op_reg_reg_reg(A_ADD,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R12)); + a_reg_dealloc(list,NR_R12); + end + else + begin + list.concat(taicpu.op_reg_reg_const(A_ADD,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,LocalSize)); + end; + end; + + if regs=[] then + begin + if (current_settings.cputypeAM_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.base=NR_NO then + a_load_const_reg(list,OS_ADDR,tmpref.offset,r) + else + if tmpref.offset<>0 then + a_op_const_reg_reg(list,OP_ADD,OS_ADDR,tmpref.offset,tmpref.base,r) + 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 : TAsmList;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,4); + current_asmdata.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 + if ref.base<>NR_PC then + begin + ref.index:=tmpreg; + ref.shiftimm:=0; + ref.signindex:=1; + ref.shiftmode:=SM_None; + end + else + ref.base:=tmpreg; + end + else + ref.base:=tmpreg; + ref.offset:=0; + ref.symbol:=nil; + end; + + + procedure tcgarm.g_concatcopy_move(list : TAsmList;const source,dest : treference;len : tcgint); + 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); + a_load_const_cgpara(list,OS_INT,len,paraloc3); + a_loadaddr_ref_cgpara(list,dest,paraloc2); + a_loadaddr_ref_cgpara(list,source,paraloc1); + paramanager.freecgpara(list,paraloc3); + paramanager.freecgpara(list,paraloc2); + paramanager.freecgpara(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',false); + dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); + dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); + paraloc3.done; + paraloc2.done; + paraloc1.done; + end; + + + procedure tcgarm.g_concatcopy_internal(list : TAsmList;const source,dest : treference;len : tcgint;aligned : boolean); + const + maxtmpreg=10;{roozbeh: can be reduced to 8 or lower if might conflick with reserved ones,also +2 is used becouse of regs required for referencing} + + var + srcref,dstref,usedtmpref,usedtmpref2:treference; + srcreg,destreg,countreg,r,tmpreg:tregister; + helpsize:aint; + copysize:byte; + cgsize:Tcgsize; + tmpregisters:array[1..maxtmpreg] of tregister; + tmpregi,tmpregi2:byte; + + { will never be called with count<=4 } + 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 + current_asmdata.getjumplabel(l); + if count 0) and (tmpregi0 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 of while} + end + else + begin + cgsize:=OS_32; + if (len<=4) then{len<=4 and not aligned} + begin + r:=getintregister(list,cgsize); + usedtmpref:=a_internal_load_ref_reg(list,OS_8,OS_8,srcref,r); + if Len=1 then + a_load_reg_ref(list,OS_8,OS_8,r,dstref) + else + begin + tmpreg:=getintregister(list,cgsize); + usedtmpref2:=a_internal_load_reg_ref(list,OS_8,OS_8,r,dstref); + inc(usedtmpref.offset,1); + a_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg); + inc(usedtmpref2.offset,1); + a_load_reg_ref(list,OS_8,OS_8,tmpreg,usedtmpref2); + if len>2 then + begin + inc(usedtmpref.offset,1); + a_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg); + inc(usedtmpref2.offset,1); + a_load_reg_ref(list,OS_8,OS_8,tmpreg,usedtmpref2); + if len>3 then + begin + inc(usedtmpref.offset,1); + a_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg); + inc(usedtmpref2.offset,1); + a_load_reg_ref(list,OS_8,OS_8,tmpreg,usedtmpref2); + end; + end; + end; + end{end of if len<=4} + else + begin{unaligned & 4helpsize} + destreg:=getintregister(list,OS_ADDR); + a_loadaddr_ref_reg(list,dest,destreg); + reference_reset_base(dstref,destreg,0,dest.alignment); + + srcreg:=getintregister(list,OS_ADDR); + a_loadaddr_ref_reg(list,source,srcreg); + reference_reset_base(srcref,srcreg,0,source.alignment); + + countreg:=getintregister(list,OS_32); + +// if cs_opt_size in current_settings.optimizerswitches then + { roozbeh : it seems loading 1 byte is faster becouse of caching/fetching(?) } + {if aligned then + genloop(len,4) + else} + genloop(len,1); + end; + end; + end; + + procedure tcgarm.g_concatcopy_unaligned(list : TAsmList;const source,dest : treference;len : tcgint); + begin + g_concatcopy_internal(list,source,dest,len,false); + end; + + + procedure tcgarm.g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint); + begin + if (source.alignment in [1..3]) or + (dest.alignment in [1..3]) then + g_concatcopy_internal(list,source,dest,len,false) + else + g_concatcopy_internal(list,source,dest,len,true); + end; + + + procedure tcgarm.g_overflowCheck(list : TAsmList;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:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation); + var + hl : tasmlabel; + ai:TAiCpu; + hflags : tresflags; + begin + if not(cs_check_overflow in current_settings.localswitches) then + exit; + current_asmdata.getjumplabel(hl); + case ovloc.loc of + LOC_VOID: + begin + ai:=taicpu.op_sym(A_B,hl); + ai.is_jmp:=true; + + if not((def.typ=pointerdef) or + ((def.typ=orddef) and + (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar, + pasbool8,pasbool16,pasbool32,pasbool64]))) then + ai.SetCondition(C_VC) + else + if TAiCpu(List.Last).opcode in [A_RSB,A_RSC,A_SBC,A_SUB] then + ai.SetCondition(C_CS) + 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',false); + a_label(list,hl); + end; + + + procedure tcgarm.g_save_registers(list : TAsmList); + begin + { this work is done in g_proc_entry } + end; + + + procedure tcgarm.g_restore_registers(list : TAsmList); + begin + { this work is done in g_proc_exit } + end; + + + procedure tcgarm.a_jmp_cond(list : TAsmList;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_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint); + var + hsym : tsym; + href : treference; + paraloc : Pcgparalocation; + shift : byte; + begin + { calculate the parameter info for the procdef } + procdef.init_paraloc_info(callerside); + hsym:=tsym(procdef.parast.Find('self')); + if not(assigned(hsym) and + (hsym.typ=paravarsym)) then + internalerror(200305251); + paraloc:=tparavarsym(hsym).paraloc[callerside].location; + while paraloc<>nil do + with paraloc^ do + begin + case loc of + LOC_REGISTER: + begin + if is_shifter_const(ioffset,shift) then + a_op_const_reg(list,OP_SUB,size,ioffset,register) + else + begin + a_load_const_reg(list,OS_ADDR,ioffset,NR_R12); + a_op_reg_reg(list,OP_SUB,size,NR_R12,register); + end; + end; + LOC_REFERENCE: + begin + { offset in the wrapper needs to be adjusted for the stored + return address } + reference_reset_base(href,reference.index,reference.offset+sizeof(aint),sizeof(pint)); + if is_shifter_const(ioffset,shift) then + a_op_const_ref(list,OP_SUB,size,ioffset,href) + else + begin + a_load_const_reg(list,OS_ADDR,ioffset,NR_R12); + a_op_reg_ref(list,OP_SUB,size,NR_R12,href); + end; + end + else + internalerror(200309189); + end; + paraloc:=next; + end; + end; + + procedure tcgarm.g_stackpointer_alloc(list: TAsmList; size: longint); + begin + internalerror(200807237); + end; + + + function get_scalar_mm_op(fromsize,tosize : tcgsize) : tasmop; + const + convertop : array[OS_F32..OS_F128,OS_F32..OS_F128] of tasmop = ( + (A_FCPYS,A_FCVTSD,A_NONE,A_NONE,A_NONE), + (A_FCVTDS,A_FCPYD,A_NONE,A_NONE,A_NONE), + (A_NONE,A_NONE,A_NONE,A_NONE,A_NONE), + (A_NONE,A_NONE,A_NONE,A_NONE,A_NONE), + (A_NONE,A_NONE,A_NONE,A_NONE,A_NONE)); + begin + result:=convertop[fromsize,tosize]; + if result=A_NONE then + internalerror(200312205); + end; + + + procedure tcgarm.a_loadmm_reg_reg(list: tasmlist; fromsize,tosize: tcgsize; reg1,reg2: tregister; shuffle: pmmshuffle); + var + instr: taicpu; + begin + if shuffle=nil then + begin + if fromsize=tosize then + { needs correct size in case of spilling } + case fromsize of + OS_F32: + instr:=taicpu.op_reg_reg(A_FCPYS,reg2,reg1); + OS_F64: + instr:=taicpu.op_reg_reg(A_FCPYD,reg2,reg1); + else + internalerror(2009112405); + end + else + internalerror(2009112406); + end + else if shufflescalar(shuffle) then + instr:=taicpu.op_reg_reg(get_scalar_mm_op(tosize,fromsize),reg2,reg1) + else + internalerror(2009112407); + list.concat(instr); + case instr.opcode of + A_FCPYS, + A_FCPYD: + add_move_instruction(instr); + end; + end; + + + procedure tcgarm.a_loadmm_ref_reg(list: tasmlist; fromsize,tosize: tcgsize; const ref: treference; reg: tregister; shuffle: pmmshuffle); + var + intreg, + tmpmmreg : tregister; + reg64 : tregister64; + op : tasmop; + begin + if assigned(shuffle) and + not(shufflescalar(shuffle)) then + internalerror(2009112413); + + case fromsize of + OS_32,OS_S32: + begin + fromsize:=OS_F32; + { since we are loading an integer, no conversion may be required } + if (fromsize<>tosize) then + internalerror(2009112801); + end; + OS_64,OS_S64: + begin + fromsize:=OS_F64; + { since we are loading an integer, no conversion may be required } + if (fromsize<>tosize) then + internalerror(2009112901); + end; + end; + + if (fromsize<>tosize) then + tmpmmreg:=getmmregister(list,fromsize) + else + tmpmmreg:=reg; + if (ref.alignment in [1,2]) then + begin + case fromsize of + OS_F32: + begin + intreg:=getintregister(list,OS_32); + a_load_ref_reg(list,OS_32,OS_32,ref,intreg); + a_loadmm_intreg_reg(list,OS_32,OS_F32,intreg,tmpmmreg,mms_movescalar); + end; + OS_F64: + begin + reg64.reglo:=getintregister(list,OS_32); + reg64.reghi:=getintregister(list,OS_32); + cg64.a_load64_ref_reg(list,ref,reg64); + cg64.a_loadmm_intreg64_reg(list,OS_F64,reg64,tmpmmreg); + end; + else + internalerror(2009112412); + end; + end + else + begin + case fromsize of + OS_F32: + op:=A_FLDS; + OS_F64: + op:=A_FLDD; + else + internalerror(2009112415); + end; + handle_load_store(list,op,PF_None,tmpmmreg,ref); + end; + + if (tmpmmreg<>reg) then + a_loadmm_reg_reg(list,fromsize,tosize,tmpmmreg,reg,shuffle); + end; + + + procedure tcgarm.a_loadmm_reg_ref(list: tasmlist; fromsize,tosize: tcgsize; reg: tregister; const ref: treference; shuffle: pmmshuffle); + var + intreg, + tmpmmreg : tregister; + reg64 : tregister64; + op : tasmop; + begin + if assigned(shuffle) and + not(shufflescalar(shuffle)) then + internalerror(2009112416); + + case tosize of + OS_32,OS_S32: + begin + tosize:=OS_F32; + { since we are loading an integer, no conversion may be required } + if (fromsize<>tosize) then + internalerror(2009112801); + end; + OS_64,OS_S64: + begin + tosize:=OS_F64; + { since we are loading an integer, no conversion may be required } + if (fromsize<>tosize) then + internalerror(2009112901); + end; + end; + + if (fromsize<>tosize) then + begin + tmpmmreg:=getmmregister(list,tosize); + a_loadmm_reg_reg(list,fromsize,tosize,reg,tmpmmreg,shuffle); + end + else + tmpmmreg:=reg; + if (ref.alignment in [1,2]) then + begin + case tosize of + OS_F32: + begin + intreg:=getintregister(list,OS_32); + a_loadmm_reg_intreg(list,OS_F32,OS_32,tmpmmreg,intreg,shuffle); + a_load_reg_ref(list,OS_32,OS_32,intreg,ref); + end; + OS_F64: + begin + reg64.reglo:=getintregister(list,OS_32); + reg64.reghi:=getintregister(list,OS_32); + cg64.a_loadmm_reg_intreg64(list,OS_F64,tmpmmreg,reg64); + cg64.a_load64_reg_ref(list,reg64,ref); + end; + else + internalerror(2009112417); + end; + end + else + begin + case fromsize of + OS_F32: + op:=A_FSTS; + OS_F64: + op:=A_FSTD; + else + internalerror(2009112418); + end; + handle_load_store(list,op,PF_None,tmpmmreg,ref); + end; + end; + + + procedure tcgarm.a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize : tcgsize; intreg, mmreg: tregister; shuffle: pmmshuffle); + begin + { this code can only be used to transfer raw data, not to perform + conversions } + if (tosize<>OS_F32) then + internalerror(2009112419); + if not(fromsize in [OS_32,OS_S32]) then + internalerror(2009112420); + if assigned(shuffle) and + not shufflescalar(shuffle) then + internalerror(2009112516); + list.concat(taicpu.op_reg_reg(A_FMSR,mmreg,intreg)); + end; + + + procedure tcgarm.a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize : tcgsize; mmreg, intreg: tregister;shuffle : pmmshuffle); + begin + { this code can only be used to transfer raw data, not to perform + conversions } + if (fromsize<>OS_F32) then + internalerror(2009112430); + if not(tosize in [OS_32,OS_S32]) then + internalerror(2009112420); + if assigned(shuffle) and + not shufflescalar(shuffle) then + internalerror(2009112514); + list.concat(taicpu.op_reg_reg(A_FMRS,intreg,mmreg)); + end; + + + procedure tcgarm.a_opmm_reg_reg(list: tasmlist; op: topcg; size: tcgsize; src, dst: tregister; shuffle: pmmshuffle); + var + tmpreg: tregister; + begin + { the vfp doesn't support xor nor any other logical operation, but + this routine is used to initialise global mm regvars. We can + easily initialise an mm reg with 0 though. } + case op of + OP_XOR: + begin + if (src<>dst) or + (reg_cgsize(src)<>size) or + assigned(shuffle) then + internalerror(2009112907); + tmpreg:=getintregister(list,OS_32); + a_load_const_reg(list,OS_32,0,tmpreg); + case size of + OS_F32: + list.concat(taicpu.op_reg_reg(A_FMSR,dst,tmpreg)); + OS_F64: + list.concat(taicpu.op_reg_reg_reg(A_FMDRR,dst,tmpreg,tmpreg)); + else + internalerror(2009112908); + end; + end + else + internalerror(2009112906); + end; + end; + + + procedure tcgarm.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); + + procedure loadvmttor12; + var + href : treference; + begin + reference_reset_base(href,NR_R0,0,sizeof(pint)); + 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,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint)); + 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 + make_global : boolean; + begin + if not(procdef.proctypeoption in [potype_function,potype_procedure]) then + Internalerror(200006137); + if not assigned(procdef.struct) 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 + create_smartlink 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)); + + { the wrapper might need aktlocaldata for the additional data to + load the constant } + current_procinfo:=cprocinfo.create(nil); + + { set param1 interface to self } + g_adjust_self_value(list,procdef,ioffset); + + { case 4 } + if (po_virtualmethod in procdef.procoptions) and + not is_objectpascal_helper(procdef.struct) then + begin + loadvmttor12; + op_onr12methodaddr; + end + { case 0 } + else + list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname))); + list.concatlist(current_procinfo.aktlocaldata); + + current_procinfo.Free; + current_procinfo:=nil; + + list.concat(Tai_symbol_end.Createname(labelname)); + end; + + + procedure tcgarm.maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister); + const + overflowops = [OP_MUL,OP_SHL,OP_ADD,OP_SUB,OP_NOT,OP_NEG]; + begin + if (op in overflowops) and + (size in [OS_8,OS_S8,OS_16,OS_S16]) then + a_load_reg_reg(list,OS_32,size,dst,dst); + end; + + + function tcgarm.get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol; + var + stubname: string; + l1: tasmsymbol; + href: treference; + begin + stubname := 'L'+s+'$stub'; + result := current_asmdata.getasmsymbol(stubname); + if assigned(result) then + exit; + + if current_asmdata.asmlists[al_imports]=nil then + current_asmdata.asmlists[al_imports]:=TAsmList.create; + + new_section(current_asmdata.asmlists[al_imports],sec_stub,'',4); + result := current_asmdata.RefAsmSymbol(stubname); + current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0)); + { register as a weak symbol if necessary } + if weak then + current_asmdata.weakrefasmsymbol(s); + current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s)); + + if not(cs_create_pic in current_settings.moduleswitches) then + begin + l1 := current_asmdata.RefAsmSymbol('L'+s+'$slp'); + reference_reset_symbol(href,l1,0,sizeof(pint)); + href.refaddr:=addr_full; + current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LDR,NR_R12,href)); + reference_reset_base(href,NR_R12,0,sizeof(pint)); + current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LDR,NR_R15,href)); + current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(l1,0)); + l1 := current_asmdata.RefAsmSymbol('L'+s+'$lazy_ptr'); + current_asmdata.asmlists[al_imports].concat(tai_const.create_sym(l1)); + end + else + internalerror(2008100401); + + new_section(current_asmdata.asmlists[al_imports],sec_data_lazy,'',sizeof(pint)); + current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(l1,0)); + current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s)); + current_asmdata.asmlists[al_imports].concat(tai_const.createname('dyld_stub_binding_helper',0)); + end; + + + procedure tcg64farm.a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64); + 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 : TAsmList;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: TAsmList;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: TAsmList;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_loadmm_intreg64_reg(list: TAsmList; mmsize: tcgsize; intreg: tregister64; mmreg: tregister); + begin + { this code can only be used to transfer raw data, not to perform + conversions } + if (mmsize<>OS_F64) then + internalerror(2009112405); + list.concat(taicpu.op_reg_reg_reg(A_FMDRR,mmreg,intreg.reglo,intreg.reghi)); + end; + + + procedure tcg64farm.a_loadmm_reg_intreg64(list: TAsmList; mmsize: tcgsize; mmreg: tregister; intreg: tregister64); + begin + { this code can only be used to transfer raw data, not to perform + conversions } + if (mmsize<>OS_F64) then + internalerror(2009112406); + list.concat(taicpu.op_reg_reg_reg(A_FMRRD,intreg.reglo,intreg.reghi,mmreg)); + end; + + + procedure tcg64farm.a_op64_const_reg_reg_checkoverflow(list: TAsmList;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,aint(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,aint(lo(value)),regsrc.reglo,regdst.reglo); + cg.a_op_const_reg_reg(list,op,OS_32,aint(hi(value)),regsrc.reghi,regdst.reghi); + end; + OP_ADD: + begin + if is_shifter_const(aint(lo(value)),b) then + list.concat(setoppostfix(taicpu.op_reg_reg_const(A_ADD,regdst.reglo,regsrc.reglo,aint(lo(value))),PF_S)) + else + begin + tmpreg:=cg.getintregister(list,OS_32); + cg.a_load_const_reg(list,OS_32,aint(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(aint(hi(value)),b) then + list.concat(taicpu.op_reg_reg_const(A_ADC,regdst.reghi,regsrc.reghi,aint(hi(value)))) + else + begin + tmpreg:=cg.getintregister(list,OS_32); + cg.a_load_const_reg(list,OS_32,aint(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(aint(lo(value)),b) then + list.concat(setoppostfix(taicpu.op_reg_reg_const(A_SUB,regdst.reglo,regsrc.reglo,aint(lo(value))),PF_S)) + else + begin + tmpreg:=cg.getintregister(list,OS_32); + cg.a_load_const_reg(list,OS_32,aint(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(aint(hi(value)),b) then + list.concat(taicpu.op_reg_reg_const(A_SBC,regdst.reghi,regsrc.reghi,aint(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: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation); + 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_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_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; + + + procedure Tthumb2cgarm.init_register_allocators; + begin + inherited init_register_allocators; + { currently, we save R14 always, so we can use it } + if (target_info.system<>system_arm_darwin) then + rg[R_INTREGISTER]:=trgintcputhumb2.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,[]) + else + { r9 is not available on Darwin according to the llvm code generator } + rg[R_INTREGISTER]:=trgintcputhumb2.create(R_INTREGISTER,R_SUBWHOLE, + [RS_R0,RS_R1,RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8, + RS_R10,RS_R12,RS_R14],first_int_imreg,[]); + rg[R_FPUREGISTER]:=trgcputhumb2.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]:=trgcputhumb2.create(R_MMREGISTER,R_SUBNONE, + [RS_S0,RS_S1,RS_R2,RS_R3,RS_R4,RS_S31],first_mm_imreg,[]); + end; + + + procedure Tthumb2cgarm.done_register_allocators; + begin + rg[R_INTREGISTER].free; + rg[R_FPUREGISTER].free; + rg[R_MMREGISTER].free; + inherited done_register_allocators; + end; + + + procedure Tthumb2cgarm.a_call_reg(list : TAsmList;reg: tregister); + begin + list.concat(taicpu.op_reg(A_BLX, 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 Tthumb2cgarm.a_load_const_reg(list : TAsmList; size: tcgsize; a : tcgint;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)) + { loading of constants with mov and orr } + else if (is_shifter_const(a-byte(a),imm_shift)) then + begin + list.concat(taicpu.op_reg_const(A_MOV,reg,a-byte(a))); + list.concat(taicpu.op_reg_reg_const(A_ORR,reg,reg,byte(a))); + end + else if (is_shifter_const(a-word(a),imm_shift)) and (is_shifter_const(word(a),imm_shift)) then + begin + list.concat(taicpu.op_reg_const(A_MOV,reg,a-word(a))); + list.concat(taicpu.op_reg_reg_const(A_ORR,reg,reg,word(a))); + end + else if (is_shifter_const(a-(dword(a) shl 8) shr 8,imm_shift)) and (is_shifter_const((dword(a) shl 8) shr 8,imm_shift)) then + begin + list.concat(taicpu.op_reg_const(A_MOV,reg,a-(dword(a) shl 8) shr 8)); + list.concat(taicpu.op_reg_reg_const(A_ORR,reg,reg,(dword(a) shl 8) shr 8)); + end + else + begin + reference_reset(hr,4); + + current_asmdata.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 Tthumb2cgarm.a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister); + var + oppostfix:toppostfix; + usedtmpref: treference; + tmpreg,tmpreg2 : tregister; + so : tshifterop; + dir : integer; + begin + if (TCGSize2Size[FromSize] >= TCGSize2Size[ToSize]) then + FromSize := ToSize; + 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(200308297); + end; + if (ref.alignment in [1,2]) and (ref.alignmentNR_NO) or + (ref.offset<-255) or + (ref.offset>4094) or + { sometimes the compiler reused registers } + (reg=ref.index) or + (reg=ref.base) then + begin + tmpreg2:=getintregister(list,OS_INT); + a_loadaddr_ref_reg(list,ref,tmpreg2); + reference_reset_base(usedtmpref,tmpreg2,0,ref.alignment); + end + else + usedtmpref:=ref; + + if target_info.endian=endian_big then + inc(usedtmpref.offset,1); + shifterop_reset(so);so.shiftmode:=SM_LSL;so.shiftimm:=8; + tmpreg:=getintregister(list,OS_INT); + a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,reg); + inc(usedtmpref.offset,dir); + if FromSize=OS_16 then + a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg) + else + a_internal_load_ref_reg(list,OS_S8,OS_S8,usedtmpref,tmpreg); + list.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,reg,reg,tmpreg,so)); + end; + OS_32,OS_S32: + begin + tmpreg:=getintregister(list,OS_INT); + + { only complicated references need an extra loadaddr } + if assigned(ref.symbol) or + (ref.index<>NR_NO) or + (ref.offset<-255) or + (ref.offset>4092) or + { sometimes the compiler reused registers } + (reg=ref.index) or + (reg=ref.base) then + begin + tmpreg2:=getintregister(list,OS_INT); + a_loadaddr_ref_reg(list,ref,tmpreg2); + reference_reset_base(usedtmpref,tmpreg2,0,ref.alignment); + end + else + usedtmpref:=ref; + + shifterop_reset(so);so.shiftmode:=SM_LSL; + if ref.alignment=2 then + begin + if target_info.endian=endian_big then + inc(usedtmpref.offset,2); + a_internal_load_ref_reg(list,OS_16,OS_16,usedtmpref,reg); + inc(usedtmpref.offset,dir*2); + a_internal_load_ref_reg(list,OS_16,OS_16,usedtmpref,tmpreg); + so.shiftimm:=16; + list.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,reg,reg,tmpreg,so)); + end + else + begin + if target_info.endian=endian_big then + inc(usedtmpref.offset,3); + a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,reg); + inc(usedtmpref.offset,dir); + a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg); + so.shiftimm:=8; + list.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,reg,reg,tmpreg,so)); + inc(usedtmpref.offset,dir); + a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg); + so.shiftimm:=16; + list.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,reg,reg,tmpreg,so)); + inc(usedtmpref.offset,dir); + a_internal_load_ref_reg(list,OS_8,OS_8,usedtmpref,tmpreg); + so.shiftimm:=24; + list.concat(taicpu.op_reg_reg_reg_shifterop(A_ORR,reg,reg,tmpreg,so)); + end; + end + else + handle_load_store(list,A_LDR,oppostfix,reg,ref); + end; + end + else + handle_load_store(list,A_LDR,oppostfix,reg,ref); + + if (fromsize=OS_S8) and (tosize = OS_16) then + a_load_reg_reg(list,OS_16,OS_32,reg,reg); + end; + + + procedure Tthumb2cgarm.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); + var + shift : byte; + tmpreg : tregister; + so : tshifterop; + l1 : longint; + begin + ovloc.loc:=LOC_VOID; + if {$ifopt R+}(a<>-2147483648) and{$endif} is_shifter_const(-a,shift) then + case op of + OP_ADD: + begin + op:=OP_SUB; + a:=aint(dword(-a)); + end; + OP_SUB: + begin + op:=OP_ADD; + a:=aint(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(200308294); + 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_ROL: + begin + if a>32 then + internalerror(200308294); + if a<>0 then + begin + shifterop_reset(so); + so.shiftmode:=SM_ROR; + so.shiftimm:=32-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_ROR: + begin + if a>32 then + internalerror(200308294); + if a<>0 then + begin + shifterop_reset(so); + so.shiftmode:=SM_ROR; + 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(200308295); + 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 + if (op in [OP_SUB, OP_ADD]) and + ((a < 0) or + (a > 4095)) then + begin + tmpreg:=getintregister(list,size); + a_load_const_reg(list, size, a, tmpreg); + list.concat(setoppostfix(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],dst,src,tmpreg),toppostfix(ord(cgsetflags or setflags)*ord(PF_S)) + )); + 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) + { for example : b=a*5 -> b=a*4+a with add instruction and shl } + else if (op in [OP_MUL,OP_IMUL]) and ispowerof2(a-1,l1) and not(cgsetflags or setflags) then + begin + if l1>32 then{roozbeh does this ever happen?} + internalerror(200308296); + shifterop_reset(so); + so.shiftmode:=SM_LSL; + so.shiftimm:=l1; + list.concat(taicpu.op_reg_reg_reg_shifterop(A_ADD,dst,src,src,so)); + end + 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; + maybeadjustresult(list,op,size,dst); + end; + + + const + op_reg_reg_opcg2asmopThumb2: array[TOpCG] of tasmop = + (A_NONE,A_MOV,A_ADD,A_AND,A_UDIV,A_SDIV,A_MUL,A_MUL,A_NONE,A_MVN,A_ORR, + A_ASR,A_LSL,A_LSR,A_SUB,A_EOR,A_NONE,A_ROR); + + + procedure Tthumb2cgarm.a_op_reg_reg_reg_checkoverflow(list: TAsmList; 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: + internalerror(200308281); + OP_ROL: + begin + if not(size in [OS_32,OS_S32]) then + internalerror(2008072801); + { simulate ROL by ror'ing 32-value } + tmpreg:=getintregister(list,OS_32); + list.concat(taicpu.op_reg_const(A_MOV,tmpreg,32)); + list.concat(taicpu.op_reg_reg_reg(A_SUB,src1,tmpreg,src1)); + list.concat(taicpu.op_reg_reg_reg(A_ROR, dst, src2, src1)); + end; + OP_ROR: + begin + if not(size in [OS_32,OS_S32]) then + internalerror(2008072802); + list.concat(taicpu.op_reg_reg_reg(A_ROR, dst, src2, src1)); + 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_opcg2asmopThumb2[op],dst,src2,src1),toppostfix(ord(cgsetflags or setflags)*ord(PF_S)) + )); + end; + maybeadjustresult(list,op,size,dst); + end; + + + procedure Tthumb2cgarm.g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); + var item: taicpu; + begin + item := setcondition(taicpu.op_reg_const(A_MOV,reg,1),flags_to_cond(f)); + list.concat(item); + list.insertbefore(taicpu.op_cond(A_IT, flags_to_cond(f)), item); + + item := setcondition(taicpu.op_reg_const(A_MOV,reg,0),inverse_cond(flags_to_cond(f))); + list.concat(item); + list.insertbefore(taicpu.op_cond(A_IT, inverse_cond(flags_to_cond(f))), item); + end; + + + procedure Tthumb2cgarm.g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); + var + ref : treference; + shift : byte; + firstfloatreg,lastfloatreg, + r : byte; + regs : tcpuregisterset; + stackmisalignment: pint; + begin + LocalSize:=align(LocalSize,4); + { call instruction does not put anything on the stack } + stackmisalignment:=0; + 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; + inc(stackmisalignment,12); + end; + + a_reg_alloc(list,NR_STACK_POINTER_REG); + if current_procinfo.framepointer<>NR_STACK_POINTER_REG then + begin + 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)); + end; + { save int registers } + reference_reset(ref,4); + ref.index:=NR_STACK_POINTER_REG; + ref.addressmode:=AM_PREINDEXED; + + regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall); + + if current_procinfo.framepointer<>NR_STACK_POINTER_REG then + regs:=regs+[RS_FRAME_POINTER_REG,RS_R14] + else if (regs<>[]) or (pi_do_call in current_procinfo.flags) then + include(regs,RS_R14); + + if regs<>[] then + begin + for r:=RS_R0 to RS_R15 do + if (r in regs) then + inc(stackmisalignment,4); + list.concat(setoppostfix(taicpu.op_ref_regset(A_STM,ref,R_INTREGISTER,R_SUBWHOLE,regs),PF_FD)); + end; + + if current_procinfo.framepointer<>NR_STACK_POINTER_REG then + begin + { the framepointer now points to the saved R15, so the saved + framepointer is at R11-12 (for get_caller_frame) } + list.concat(taicpu.op_reg_reg_const(A_SUB,NR_FRAME_POINTER_REG,NR_R12,4)); + a_reg_dealloc(list,NR_R12); + end; + + stackmisalignment:=stackmisalignment mod current_settings.alignment.localalignmax; + if (LocalSize<>0) or + ((stackmisalignment<>0) and + ((pi_do_call in current_procinfo.flags) or + (po_assembler in current_procinfo.procdef.procoptions))) then + begin + localsize:=align(localsize+stackmisalignment,current_settings.alignment.localalignmax)-stackmisalignment; + if not(is_shifter_const(localsize,shift)) then + begin + if current_procinfo.framepointer=NR_STACK_POINTER_REG then + a_reg_alloc(list,NR_R12); + 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; + end; + + if firstfloatreg<>RS_NO then + begin + reference_reset(ref,4); + if tg.direction*tarmprocinfo(current_procinfo).floatregstart>=1023 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,current_procinfo.framepointer,NR_R12)); + ref.base:=NR_R12; + end + else + begin + ref.base:=current_procinfo.framepointer; + 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 Tthumb2cgarm.g_proc_exit(list : TAsmList;parasize : longint;nostackframe:boolean); + var + ref : treference; + firstfloatreg,lastfloatreg, + r : byte; + shift : byte; + regs : tcpuregisterset; + LocalSize : longint; + stackmisalignment: pint; + begin + if not(nostackframe) then + begin + stackmisalignment:=0; + { 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; + { floating point register space is already included in + localsize below by calc_stackframe_size + inc(stackmisalignment,12); + } + end; + + if firstfloatreg<>RS_NO then + begin + reference_reset(ref,4); + if tg.direction*tarmprocinfo(current_procinfo).floatregstart>=1023 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,current_procinfo.framepointer,NR_R12)); + ref.base:=NR_R12; + end + else + begin + ref.base:=current_procinfo.framepointer; + 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; + + regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall); + if (pi_do_call in current_procinfo.flags) or (regs<>[]) then + begin + exclude(regs,RS_R14); + include(regs,RS_R15); + end; + if (current_procinfo.framepointer<>NR_STACK_POINTER_REG) then + regs:=regs+[RS_FRAME_POINTER_REG,RS_R15]; + + for r:=RS_R0 to RS_R15 do + if (r in regs) then + inc(stackmisalignment,4); + + stackmisalignment:=stackmisalignment mod current_settings.alignment.localalignmax; + if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then + begin + LocalSize:=current_procinfo.calc_stackframe_size; + if (LocalSize<>0) or + ((stackmisalignment<>0) and + ((pi_do_call in current_procinfo.flags) or + (po_assembler in current_procinfo.procdef.procoptions))) then + begin + localsize:=align(localsize+stackmisalignment,current_settings.alignment.localalignmax)-stackmisalignment; + if not(is_shifter_const(LocalSize,shift)) then + begin + a_reg_alloc(list,NR_R12); + a_load_const_reg(list,OS_ADDR,LocalSize,NR_R12); + list.concat(taicpu.op_reg_reg_reg(A_ADD,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,NR_R12)); + a_reg_dealloc(list,NR_R12); + end + else + begin + list.concat(taicpu.op_reg_reg_const(A_ADD,NR_STACK_POINTER_REG,NR_STACK_POINTER_REG,LocalSize)); + end; + end; + + if regs=[] then + list.concat(taicpu.op_reg_reg(A_MOV,NR_R15,NR_R14)) + else + begin + reference_reset(ref,4); + ref.index:=NR_STACK_POINTER_REG; + ref.addressmode:=AM_PREINDEXED; + list.concat(setoppostfix(taicpu.op_ref_regset(A_LDM,ref,R_INTREGISTER,R_SUBWHOLE,regs),PF_FD)); + end; + end + else + begin + { restore int registers and return } + list.concat(taicpu.op_reg_reg(A_MOV, NR_STACK_POINTER_REG, NR_FRAME_POINTER_REG)); + { Add 4 to SP to make it point to an "imaginary PC" which the paramanager assumes is there(for normal ARM) } + list.concat(taicpu.op_reg_const(A_ADD, NR_STACK_POINTER_REG, 4)); + + reference_reset(ref,4); + ref.index:=NR_STACK_POINTER_REG; + list.concat(setoppostfix(taicpu.op_ref_regset(A_LDM,ref,R_INTREGISTER,R_SUBWHOLE,regs),PF_DB)); + end; + end + else + list.concat(taicpu.op_reg_reg(A_MOV,NR_PC,NR_R14)); + end; + + + function Tthumb2cgarm.handle_load_store(list:TAsmList;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference):treference; + var + tmpreg : tregister; + tmpref : treference; + l : tasmlabel; + so: tshifterop; + 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<-255) 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,A_FLDS,A_FLDD,A_FSTS,A_FSTD]) and + ((ref.offset<-1020) or + (ref.offset>1020) or + { the usual pc relative symbol handling assumes possible offsets of +/- 4095 } + assigned(ref.symbol) + ) + ) then + begin + reference_reset(tmpref,4); + + { load symbol } + tmpreg:=getintregister(list,OS_INT); + if assigned(ref.symbol) then + begin + current_asmdata.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)); + + { in case of LDF/STF, we got rid of the NR_R15 } + if is_pc(ref.base) then + ref.base:=NR_NO; + if is_pc(ref.index) then + ref.index:=NR_NO; + 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; + + { Hack? Thumb2 doesn't allow PC indexed addressing modes(although it does in the specification) } + if (ref.base=NR_R15) and (ref.index<>NR_NO) and (ref.shiftmode <> sm_none) then + begin + tmpreg:=getintregister(list,OS_ADDR); + + list.concat(taicpu.op_reg_reg(A_MOV, tmpreg, NR_R15)); + + ref.base := tmpreg; + end; + + { floating point operations have only limited references + we expect here, that a base is already set } + if (op in [A_LDF,A_STF,A_FLDS,A_FLDD,A_FSTS,A_FSTD]) 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)); + Result := ref; + end; + + + procedure tthumb2cg64farm.a_op64_reg_reg(list : TAsmList;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)); + tmpreg:=cg.getintregister(list,OS_32); + list.concat(taicpu.op_reg_const(A_MOV,tmpreg,0)); + list.concat(taicpu.op_reg_reg_reg(A_SBC,regdst.reghi,tmpreg,regsrc.reghi)); + end; + else + inherited a_op64_reg_reg(list, op, size, regsrc, regdst); + end; + end; + + + procedure create_codegen; + begin + if current_settings.cputype in cpu_thumb2 then + begin + cg:=tthumb2cgarm.create; + cg64:=tthumb2cg64farm.create; + + casmoptimizer:=TCpuThumb2AsmOptimizer; + end + else + begin + cg:=tarmcgarm.create; + cg64:=tcg64farm.create; + + casmoptimizer:=TCpuAsmOptimizer; + end; + end; + +end. diff --git a/closures/compiler/arm/cpubase.pas b/closures/compiler/arm/cpubase.pas new file mode 100644 index 0000000000..351ea20789 --- /dev/null +++ b/closures/compiler/arm/cpubase.pas @@ -0,0 +1,581 @@ +{ + 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; + +{ 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_R14]; + VOLATILE_FPUREGISTERS = [RS_F0..RS_F3]; + VOLATILE_MMREGISTERS = [RS_D0..RS_D7,RS_D16..RS_D31]; + + VOLATILE_INTREGISTERS_DARWIN = [RS_R0..RS_R3,RS_R9,RS_R12..RS_R14]; + + 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, + { multiple load/store vfp address modes } + PF_IAD,PF_DBD,PF_FDD,PF_EAD, + PF_IAS,PF_DBS,PF_FDS,PF_EAS, + PF_IAX,PF_DBX,PF_FDX,PF_EAX + ); + + TRoundingMode = (RM_None,RM_P,RM_M,RM_Z); + + const + cgsize2fpuoppostfix : array[OS_NO..OS_F128] of toppostfix = ( + PF_None, + 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[3] = ('', + 's', + 'd','e','p','ep', + 'b','sb','bt','h','sh','t', + 'ia','ib','da','db','fd','fa','ed','ea', + 'iad','dbd','fdd','ead', + 'ias','dbs','fds','eas', + 'iax','dbx','fdx','eax'); + + 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; + + tcpumodeflag = (mfA, mfI, mfF); + tcpumodeflags = set of tcpumodeflag; + +{***************************************************************************** + Constants +*****************************************************************************} + + const + max_operands = 4; + + maxintregs = 15; + maxfpuregs = 8; + maxaddrregs = 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; + { 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; + + 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; + + { Low part of 64bit return value } + function NR_FUNCTION_RESULT64_LOW_REG: tregister; + function RS_FUNCTION_RESULT64_LOW_REG: shortint; + { High part of 64bit return value } + function NR_FUNCTION_RESULT64_HIGH_REG: tregister; + function RS_FUNCTION_RESULT64_HIGH_REG: shortint; + +{***************************************************************************** + 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); + + { this is only for the generic code which is not used for this architecture } + saved_mm_registers : array[0..0] of tsuperregister = (RS_NO); + + { 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(regtype: tregistertype; 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; + function dwarf_reg(r:tregister):shortint; + + implementation + + uses + systems,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(regtype: tregistertype; s:Tcgsize):Tsubregister; + begin + case regtype of + R_MMREGISTER: + begin + case s of + OS_F32: + cgsize2subreg:=R_SUBFS; + OS_F64: + cgsize2subreg:=R_SUBFD; + else + internalerror(2009112701); + end; + end; + else + cgsize2subreg:=R_SUBWHOLE; + end; + end; + + + function reg_cgsize(const reg: tregister): tcgsize; + begin + case getregtype(reg) of + R_INTREGISTER : + reg_cgsize:=OS_32; + R_FPUREGISTER : + reg_cgsize:=OS_F80; + R_MMREGISTER : + begin + case getsubreg(reg) of + R_SUBFD, + R_SUBWHOLE: + result:=OS_F64; + R_SUBFS: + result:=OS_F32; + else + internalerror(2009112903); + end; + end; + 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 + if current_settings.cputype in cpu_thumb2 then + begin + for i:=0 to 24 do + begin + if (dword(d) and not($ff shl i))=0 then + begin + imm_shift:=i; + result:=true; + exit; + end; + end; + end + else + 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; + end; + result:=false; + end; + + + function dwarf_reg(r:tregister):shortint; + begin + result:=regdwarf_table[findreg_by_number(r)]; + if result=-1 then + internalerror(200603251); + end; + + { Low part of 64bit return value } + function NR_FUNCTION_RESULT64_LOW_REG: tregister; + begin + if target_info.endian=endian_little then + result:=NR_R0 + else + result:=NR_R1; + end; + + function RS_FUNCTION_RESULT64_LOW_REG: shortint; + begin + if target_info.endian=endian_little then + result:=RS_R0 + else + result:=RS_R1; + end; + + { High part of 64bit return value } + function NR_FUNCTION_RESULT64_HIGH_REG: tregister; + begin + if target_info.endian=endian_little then + result:=NR_R1 + else + result:=NR_R0; + end; + + function RS_FUNCTION_RESULT64_HIGH_REG: shortint; + begin + if target_info.endian=endian_little then + result:=RS_R1 + else + result:=RS_R0; + end; + +end. diff --git a/closures/compiler/arm/cpuinfo.pas b/closures/compiler/arm/cpuinfo.pas new file mode 100644 index 0000000000..1b2accfa1c --- /dev/null +++ b/closures/compiler/arm/cpuinfo.pas @@ -0,0 +1,1034 @@ +{ + 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 } + tcputype = + (cpu_none, + cpu_armv3, + cpu_armv4, + cpu_armv4t, + cpu_armv5, + cpu_armv6, + cpu_armv7, + cpu_armv7m + ); + +Const + cpu_arm = [cpu_none,cpu_armv3,cpu_armv4,cpu_armv4t,cpu_armv5]; + cpu_thumb = []; + cpu_thumb2 = [cpu_armv7m]; + +Type + tfputype = + (fpu_none, + fpu_soft, + fpu_libgcc, + fpu_fpa, + fpu_fpa10, + fpu_fpa11, + fpu_vfpv2, + fpu_vfpv3 + ); + + tcontrollertype = + (ct_none, + + { Phillips } + ct_lpc2114, + ct_lpc2124, + ct_lpc2194, + ct_lpc1768, + + { ATMEL } + ct_at91sam7s256, + ct_at91sam7se256, + ct_at91sam7x256, + ct_at91sam7xc256, + + { STMicroelectronics } + ct_stm32f103rb, + ct_stm32f103re, + ct_stm32f103c4t, + + { TI - Fury Class - 64 K Flash, 16 K SRAM Devices } + ct_lm3s1110, + ct_lm3s1133, + ct_lm3s1138, + ct_lm3s1150, + ct_lm3s1162, + ct_lm3s1165, + ct_lm3s1166, + ct_lm3s2110, + ct_lm3s2139, + ct_lm3s6100, + ct_lm3s6110, + + { TI - Fury Class - 128K Flash, 32K SRAM devices } + ct_lm3s1601, + ct_lm3s1608, + ct_lm3s1620, + ct_lm3s1635, + ct_lm3s1636, + ct_lm3s1637, + ct_lm3s1651, + ct_lm3s2601, + ct_lm3s2608, + ct_lm3s2620, + ct_lm3s2637, + ct_lm3s2651, + ct_lm3s6610, + ct_lm3s6611, + ct_lm3s6618, + ct_lm3s6633, + ct_lm3s6637, + ct_lm3s8630, + + { TI - Fury Class - 256K Flash, 64K SRAM devices } + ct_lm3s1911, + ct_lm3s1918, + ct_lm3s1937, + ct_lm3s1958, + ct_lm3s1960, + ct_lm3s1968, + ct_lm3s1969, + ct_lm3s2911, + ct_lm3s2918, + ct_lm3s2919, + ct_lm3s2939, + ct_lm3s2948, + ct_lm3s2950, + ct_lm3s2965, + ct_lm3s6911, + ct_lm3s6918, + ct_lm3s6938, + ct_lm3s6950, + ct_lm3s6952, + ct_lm3s6965, + ct_lm3s8930, + ct_lm3s8933, + ct_lm3s8938, + ct_lm3s8962, + ct_lm3s8970, + ct_lm3s8971, + + { TI - Tempest Tempest - 256 K Flash, 64 K SRAM } + ct_lm3s5951, + ct_lm3s5956, + ct_lm3s1b21, + ct_lm3s2b93, + ct_lm3s5b91, + ct_lm3s9b81, + ct_lm3s9b90, + ct_lm3s9b92, + ct_lm3s9b95, + ct_lm3s9b96, + + { SAMSUNG } + ct_sc32442b, + + // generic Thumb2 target + ct_thumb2bare + ); + + +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_safecall, + 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, + { same as stdcall (requires that all const records are passed by + reference, but that's already done for stdcall) } + pocall_mwpascal, + { used for interrupt handling } + pocall_interrupt + ]; + + cputypestr : array[tcputype] of string[8] = ('', + 'ARMV3', + 'ARMV4', + 'ARMV4T', + 'ARMV5', + 'ARMV6', + 'ARMV7', + 'ARMV7M' + ); + + fputypestr : array[tfputype] of string[6] = ('', + 'SOFT', + 'LIBGCC', + 'FPA', + 'FPA10', + 'FPA11', + 'VFPV2', + 'VFPV3' + ); + + + { We know that there are fields after sramsize + but we don't care about this warning } + {$WARN 3177 OFF} + + embedded_controllers : array [tcontrollertype] of tcontrollerdatatype = + (( + controllertypestr:''; + controllerunitstr:''; + interruptvectors:0; + flashbase:0; + flashsize:0; + srambase:0; + sramsize:0 + ), + + ( + controllertypestr:'LPC2114'; + controllerunitstr:'LPC21x4'; + interruptvectors:8; + flashbase:$00000000; + flashsize:$00040000; + srambase:$40000000; + sramsize:$00004000 + ), + + ( + controllertypestr:'LPC2124'; + controllerunitstr:'LPC21x4'; + interruptvectors:8; + flashbase:$00000000; + flashsize:$00040000; + srambase:$40000000; + sramsize:$00004000 + ), + + ( + controllertypestr:'LPC2194'; + controllerunitstr:'LPC21x4'; + interruptvectors:8; + flashbase:$00000000; + flashsize:$00040000; + srambase:$40000000; + sramsize:$00004000 + ), + + ( + controllertypestr:'LPC1768'; + controllerunitstr:'LPC1768'; + interruptvectors:12; + flashbase:$00000000; + flashsize:$00040000; + srambase:$10000000; + sramsize:$00008000 + ), + + ( + controllertypestr:'AT91SAM7S256'; + controllerunitstr:'AT91SAM7x256'; + interruptvectors:8; + flashbase:$00000000; + flashsize:$00040000; + srambase:$00200000; + sramsize:$00010000 + ), + + ( + controllertypestr:'AT91SAM7SE256'; + controllerunitstr:'AT91SAM7x256'; + interruptvectors:8; + flashbase:$00000000; + flashsize:$00040000; + srambase:$00200000; + sramsize:$00010000 + ), + + ( + controllertypestr:'AT91SAM7X256'; + controllerunitstr:'AT91SAM7x256'; + interruptvectors:8; + flashbase:$00000000; + flashsize:$00040000; + srambase:$00200000; + sramsize:$00010000 + ), + + ( + controllertypestr:'AT91SAM7XC256'; + controllerunitstr:'AT91SAM7x256'; + interruptvectors:8; + flashbase:$00000000; + flashsize:$00040000; + srambase:$00200000; + sramsize:$00010000 + ), + + // ct_stm32f103rb, + ( + controllertypestr:'STM32F103RB'; + controllerunitstr:'STM32F103'; + interruptvectors:12; + flashbase:$08000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00005000 + ), + // ct_stm32f103re, + ( + controllertypestr:'STM32F103RE'; + controllerunitstr:'STM32F103'; + interruptvectors:12; + flashbase:$08000000; + flashsize:$00080000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_stm32f103re, + ( + controllertypestr:'STM32F103C4T'; + controllerunitstr:'STM32F103'; + interruptvectors:12; + flashbase:$08000000; + flashsize:$00004000; + srambase:$20000000; + sramsize:$00001800 + ), + + { TI - 64 K Flash, 16 K SRAM Devices } + // ct_lm3s1110, + ( + controllertypestr:'LM3S1110'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00010000; + srambase:$20000000; + sramsize:$00004000 + ), + // ct_lm3s1133, + ( + controllertypestr:'LM3S1133'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00010000; + srambase:$20000000; + sramsize:$00004000 + ), + // ct_lm3s1138, + ( + controllertypestr:'LM3S1138'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00010000; + srambase:$20000000; + sramsize:$00004000 + ), + // ct_lm3s1150, + ( + controllertypestr:'LM3S1150'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00010000; + srambase:$20000000; + sramsize:$00004000 + ), + // ct_lm3s1162, + ( + controllertypestr:'LM3S1162'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00010000; + srambase:$20000000; + sramsize:$00004000 + ), + // ct_lm3s1165, + ( + controllertypestr:'LM3S1165'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00010000; + srambase:$20000000; + sramsize:$00004000 + ), + // ct_lm3s1166, + ( + controllertypestr:'LM3S1166'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00010000; + srambase:$20000000; + sramsize:$00004000 + ), + // ct_lm3s2110, + ( + controllertypestr:'LM3S2110'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00010000; + srambase:$20000000; + sramsize:$00004000 + ), + // ct_lm3s2139, + ( + controllertypestr:'LM3S2139'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00010000; + srambase:$20000000; + sramsize:$00004000 + ), + // ct_lm3s6100, + ( + controllertypestr:'LM3S6100'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00010000; + srambase:$20000000; + sramsize:$00004000 + ), + // ct_lm3s6110, + ( + controllertypestr:'LM3S6110'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00010000; + srambase:$20000000; + sramsize:$00004000 + ), + + { TI - 128K Flash, 32K SRAM devices } + // ct_lm3s1601, + ( + controllertypestr:'LM3S1601'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00008000 + ), + // ct_lm3s1608, + ( + controllertypestr:'LM3S1608'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00008000 + ), + // ct_lm3s1620, + ( + controllertypestr:'LM3S1620'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00008000 + ), + // ct_lm3s1635, + ( + controllertypestr:'LM3S1635'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00008000 + ), + // ct_lm3s1636, + ( + controllertypestr:'LM3S1636'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00008000 + ), + // ct_lm3s1637, + ( + controllertypestr:'LM3S1637'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00008000 + ), + // ct_lm3s1651, + ( + controllertypestr:'LM3S1651'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00008000 + ), + // ct_lm3s2601, + ( + controllertypestr:'LM3S2601'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00008000 + ), + // ct_lm3s2608, + ( + controllertypestr:'LM3S2608'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00008000 + ), + // ct_lm3s2620, + ( + controllertypestr:'LM3S2620'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00008000 + ), + // ct_lm3s2637, + ( + controllertypestr:'LM3S2637'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00008000 + ), + // ct_lm3s2651, + ( + controllertypestr:'LM3S2651'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00008000 + ), + // ct_lm3s6610, + ( + controllertypestr:'LM3S6610'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00008000 + ), + // ct_lm3s6611, + ( + controllertypestr:'LM3S6611'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00008000 + ), + // ct_lm3s6618, + ( + controllertypestr:'LM3S6618'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00008000 + ), + // ct_lm3s6633, + ( + controllertypestr:'LM3S6633'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00008000 + ), + // ct_lm3s6637, + ( + controllertypestr:'LM3S6637'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00008000 + ), + // ct_lm3s8630, + ( + controllertypestr:'LM3S8630'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00020000; + srambase:$20000000; + sramsize:$00008000 + ), + + { TI - 256K Flash, 64K SRAM devices } + // ct_lm3s1911, + ( + controllertypestr:'LM3S1911'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s1918, + ( + controllertypestr:'LM3S1918'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s1937, + ( + controllertypestr:'LM3S1937'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s1958, + ( + controllertypestr:'LM3S1958'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s1960, + ( + controllertypestr:'LM3S1960'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s1968, + ( + controllertypestr:'LM3S1968'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s1969, + ( + controllertypestr:'LM3S1969'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s2911, + ( + controllertypestr:'LM3S2911'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s2918, + ( + controllertypestr:'LM3S2918'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s2919, + ( + controllertypestr:'LM3S2919'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s2939, + ( + controllertypestr:'LM3S2939'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s2948, + ( + controllertypestr:'LM3S2948'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s2950, + ( + controllertypestr:'LM3S2950'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s2965, + ( + controllertypestr:'LM3S2965'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s6911, + ( + controllertypestr:'LM3S6911'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s6918, + ( + controllertypestr:'LM3S6918'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s6938, + ( + controllertypestr:'LM3S6938'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s6950, + ( + controllertypestr:'LM3S6950'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s6952, + ( + controllertypestr:'LM3S6952'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s6965, + ( + controllertypestr:'LM3S6965'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s8930, + ( + controllertypestr:'LM3S8930'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s8933, + ( + controllertypestr:'LM3S8933'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s8938, + ( + controllertypestr:'LM3S8938'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s8962, + ( + controllertypestr:'LM3S8962'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s8970, + ( + controllertypestr:'LM3S8970'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s8971, + ( + controllertypestr:'LM3S8971'; + controllerunitstr:'LM3FURY'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + + { TI - Tempest parts - 256 K Flash, 64 K SRAM } + // ct_lm3s5951, + ( + controllertypestr:'LM3S5951'; + controllerunitstr:'LM3TEMPEST'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s5956, + ( + controllertypestr:'LM3S5956'; + controllerunitstr:'LM3TEMPEST'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s1b21, + ( + controllertypestr:'LM3S1B21'; + controllerunitstr:'LM3TEMPEST'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s2b93, + ( + controllertypestr:'LM3S2B93'; + controllerunitstr:'LM3TEMPEST'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s5b91, + ( + controllertypestr:'LM3S5B91'; + controllerunitstr:'LM3TEMPEST'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s9b81, + ( + controllertypestr:'LM3S9B81'; + controllerunitstr:'LM3TEMPEST'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s9b90, + ( + controllertypestr:'LM3S9B90'; + controllerunitstr:'LM3TEMPEST'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s9b92, + ( + controllertypestr:'LM3S9B92'; + controllerunitstr:'LM3TEMPEST'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s9b95, + ( + controllertypestr:'LM3S9B95'; + controllerunitstr:'LM3TEMPEST'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + // ct_lm3s9b96, + ( + controllertypestr:'LM3S9B96'; + controllerunitstr:'LM3TEMPEST'; + interruptvectors:72; + flashbase:$00000000; + flashsize:$00040000; + srambase:$20000000; + sramsize:$00010000 + ), + + //ct_SC32442b, + ( + controllertypestr:'SC32442B'; + controllerunitstr:'sc32442b'; + interruptvectors:7; + flashbase:$00000000; + flashsize:$00000000; + srambase:$00000000; + sramsize:$08000000 + ), + + // bare bones Thumb2 + ( + controllertypestr:'THUMB2_BARE'; + controllerunitstr:'THUMB2_BARE'; + interruptvectors:128; + flashbase:$00000000; + flashsize:$00100000; + srambase:$20000000; + sramsize:$00100000 + ) + ); + + vfp_scalar = [fpu_vfpv2,fpu_vfpv3]; + + { Supported optimizations, only used for information } + supported_optimizerswitches = genericlevel1optimizerswitches+ + genericlevel2optimizerswitches+ + genericlevel3optimizerswitches- + { no need to write info about those } + [cs_opt_level1,cs_opt_level2,cs_opt_level3]+ + [cs_opt_regvar,cs_opt_loopunroll,cs_opt_tailrecursion, + cs_opt_stackframe,cs_opt_nodecse]; + + level1optimizerswitches = genericlevel1optimizerswitches; + level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + + [cs_opt_regvar,cs_opt_stackframe,cs_opt_tailrecursion,cs_opt_nodecse]; + level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches + [{,cs_opt_loopunroll}]; + +Implementation + +end. diff --git a/closures/compiler/arm/cpunode.pas b/closures/compiler/arm/cpunode.pas new file mode 100644 index 0000000000..d015d46163 --- /dev/null +++ b/closures/compiler/arm/cpunode.pas @@ -0,0 +1,47 @@ +{ + 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,ncgobjc, + { 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, + narmset + ; + + +end. diff --git a/closures/compiler/arm/cpupara.pas b/closures/compiler/arm/cpupara.pas new file mode 100644 index 0000000000..338e2d5216 --- /dev/null +++ b/closures/compiler/arm/cpupara.pas @@ -0,0 +1,592 @@ +{ + 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,aasmdata, + cpuinfo,cpubase,cgbase,cgutils, + 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 get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;override; + function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override; + function ret_in_param(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; + function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;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; + procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); + end; + + implementation + + uses + verbose,systems,cutils, + rgobj, + defutil,symsym; + + + function tarmparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset; + begin + if (target_info.system<>system_arm_darwin) then + result:=VOLATILE_INTREGISTERS + else + result:=VOLATILE_INTREGISTERS_DARWIN; + end; + + + function tarmparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset; + begin + result:=VOLATILE_FPUREGISTERS; + end; + + + function tarmparamanager.get_volatile_registers_mm(calloption: tproccalloption): tcpuregisterset; + begin + result:=VOLATILE_MMREGISTERS; + 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_ADDR; + cgpara.intsize:=sizeof(pint); + 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.typ of + orddef: + getparaloc:=LOC_REGISTER; + floatdef: + if (calloption in [pocall_cdecl,pocall_cppdecl,pocall_softfloat]) or + (cs_fp_emulation in current_settings.moduleswitches) or + (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3]) then + { the ARM eabi also allows passing VFP values via VFP registers, + but at least neither Mac OS X nor Linux seems to do that } + 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_REGISTER; + objectdef: + getparaloc:=LOC_REGISTER; + stringdef: + if is_shortstring(p) or is_longstring(p) then + getparaloc:=LOC_REFERENCE + else + getparaloc:=LOC_REGISTER; + procvardef: + 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_REGISTER; + { 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,vs_constref] then + begin + result:=true; + exit; + end; + case def.typ of + objectdef: + result:=is_object(def) and ((varspez=vs_const) or (def.size=0)); + recorddef: + { note: should this ever be changed, make sure that const records + are always passed by reference for calloption=pocall_mwpascal } + result:=(varspez=vs_const) or (def.size=0); + variantdef, + formaldef: + 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); + setdef : + result:=not is_smallset(def); + stringdef : + result:=tstringdef(def).stringtype in [st_shortstring,st_longstring]; + end; + end; + + + function tarmparamanager.ret_in_param(def : tdef;calloption : tproccalloption) : boolean; + begin + case def.typ of + recorddef: + result:=def.size>4; + procvardef: + if not tprocvardef(def).is_addressonly then + result:=true + else + result:=false + else + result:=inherited ret_in_param(def,calloption); + 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; + firstparaloc: boolean; + + procedure assignintreg; + begin + { In case of po_delphi_nested_cc, the parent frame pointer + is always passed on the stack. } + if (nextintreg<=RS_R3) and + (not(vo_is_parentfp in hp.varoptions) or + not(po_delphi_nested_cc in p.procoptions)) 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]); + paradef:=hp.vardef; + + hp.paraloc[side].reset; + + { 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(paradef) 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 (hp.varspez in [vs_var,vs_out]) or + push_addr_param(hp.varspez,paradef,p.proccalloption) or + is_open_array(paradef) or + is_array_of_const(paradef) then + begin + paradef:=voidpointertype; + loc:=LOC_REGISTER; + paracgsize := OS_ADDR; + paralen := tcgsize2size[OS_ADDR]; + end + else + begin + if not is_special_array(paradef) then + paralen := paradef.size + else + paralen := tcgsize2size[def_cgsize(paradef)]; + loc := getparaloc(p.proccalloption,paradef); + if (paradef.typ in [objectdef,arraydef,recorddef]) and + not is_special_array(paradef) and + (hp.varspez in [vs_value,vs_const]) then + paracgsize := int_cgsize(paralen) + else + begin + paracgsize:=def_cgsize(paradef); + { for things like formaldef } + if (paracgsize=OS_NO) then + begin + paracgsize:=OS_ADDR; + paralen := tcgsize2size[OS_ADDR]; + end; + end + end; + + hp.paraloc[side].size:=paracgsize; + hp.paraloc[side].Alignment:=std_param_align; + hp.paraloc[side].intsize:=paralen; + firstparaloc:=true; + +{$ifdef EXTDEBUG} + if paralen=0 then + internalerror(200410311); +{$endif EXTDEBUG} + while paralen>0 do + begin + paraloc:=hp.paraloc[side].add_location; + + 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_32; + else + internalerror(2005082901); + end + else if (paracgsize in [OS_NO,OS_64,OS_S64]) then + paraloc^.size := OS_32 + else + paraloc^.size:=paracgsize; + case loc of + LOC_REGISTER: + begin + { align registers for eabi } + if (target_info.abi=abi_eabi) and + firstparaloc and + (paradef.alignment=8) then + begin + if (nextintreg in [RS_R1,RS_R3]) then + inc(nextintreg) + else if nextintreg>RS_R3 then + stack_offset:=align(stack_offset,8); + end; + { this is not abi compliant + why? (FK) } + 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 always contains everything that's left } + 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 + if push_addr_param(hp.varspez,paradef,p.proccalloption) then + begin + paraloc^.size:=OS_ADDR; + assignintreg + end + else + begin + { align stack for eabi } + if (target_info.abi=abi_eabi) and + firstparaloc and + (paradef.alignment=8) then + stack_offset:=align(stack_offset,8); + + paraloc^.size:=paracgsize; + paraloc^.loc:=LOC_REFERENCE; + paraloc^.reference.index:=NR_STACK_POINTER_REG; + paraloc^.reference.offset:=stack_offset; + inc(stack_offset,align(paralen,4)); + paralen:=0 + 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]); + firstparaloc:=false + end; + end; + curintreg:=nextintreg; + curfloatreg:=nextfloatreg; + curmmreg:=nextmmreg; + cur_stack_offset:=stack_offset; + result:=cur_stack_offset; + end; + + + procedure tarmparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); + begin + p.funcretloc[side]:=get_funcretloc(p,side,p.returndef); + end; + + + function tarmparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara; + var + paraloc : pcgparalocation; + retcgsize : tcgsize; + begin + result.init; + result.alignment:=get_para_align(p.proccalloption); + { void has no location } + if is_void(def) then + begin + paraloc:=result.add_location; + result.size:=OS_NO; + result.intsize:=0; + paraloc^.size:=OS_NO; + paraloc^.loc:=LOC_VOID; + exit; + end; + { Constructors return self instead of a boolean } + if (p.proctypeoption=potype_constructor) then + begin + retcgsize:=OS_ADDR; + result.intsize:=sizeof(pint); + end + else + begin + retcgsize:=def_cgsize(def); + result.intsize:=def.size; + end; + result.size:=retcgsize; + { Return is passed as var parameter } + if ret_in_param(def,p.proccalloption) then + begin + paraloc:=result.add_location; + paraloc^.loc:=LOC_REFERENCE; + paraloc^.size:=retcgsize; + exit; + end; + + paraloc:=result.add_location; + { Return in FPU register? } + if def.typ=floatdef then + begin + if (p.proccalloption in [pocall_softfloat]) or + (cs_fp_emulation in current_settings.moduleswitches) or + (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3]) then + begin + case retcgsize of + OS_64, + OS_F64: + begin + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG; + paraloc^.size:=OS_32; + paraloc:=result.add_location; + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG; + paraloc^.size:=OS_32; + end; + OS_32, + OS_F32: + begin + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=NR_FUNCTION_RETURN_REG; + paraloc^.size:=OS_32; + end; + else + internalerror(2005082603); + end; + end + else + begin + paraloc^.loc:=LOC_FPUREGISTER; + paraloc^.register:=NR_FPU_RESULT_REG; + paraloc^.size:=retcgsize; + end; + end + { Return in register } + else + begin + if retcgsize in [OS_64,OS_S64] then + begin + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG; + paraloc^.size:=OS_32; + paraloc:=result.add_location; + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG; + paraloc^.size:=OS_32; + end + else + begin + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=NR_FUNCTION_RETURN_REG; + if (result.intsize<>3) then + paraloc^.size:=retcgsize + else + paraloc^.size:=OS_32; + end; + end; + end; + + + function tarmparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):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,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset); + + create_funcretloc_info(p,side); + 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. diff --git a/closures/compiler/arm/cpupi.pas b/closures/compiler/arm/cpupi.pas new file mode 100644 index 0000000000..2b67bb9e40 --- /dev/null +++ b/closures/compiler/arm/cpupi.pas @@ -0,0 +1,128 @@ +{ + 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; + function calc_stackframe_size:longint;override; + end; + + + implementation + + uses + globals,systems, + cpubase, + aasmtai,aasmdata, + 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 } + if tg.direction = -1 then + begin + if (target_info.system<>system_arm_darwin) then + { Non-Darwin, worst case: r4-r10,r11,r13,r14,r15 is saved -> -28-16, but we + always adjust the frame pointer to point to the first stored + register (= last register in list above) -> + 4 } + tg.setfirsttemp(-28-16+4) + else + { on Darwin r9 is not usable -> one less register to save } + tg.setfirsttemp(-24-16+4) + end + else + tg.setfirsttemp(maxpushedparasize); + end; + + + function tarmprocinfo.calc_stackframe_size:longint; + var + firstfloatreg,lastfloatreg, + r : byte; + floatsavesize : aword; + regs: tcpuregisterset; + begin + maxpushedparasize:=align(maxpushedparasize,max(current_settings.alignment.localalignmin,4)); + floatsavesize:=0; + case current_settings.fputype of + fpu_fpa, + fpu_fpa10, + fpu_fpa11: + begin + { save floating point registers? } + firstfloatreg:=RS_NO; + regs:=cg.rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall); + for r:=RS_F0 to RS_F7 do + if r in regs then + begin + if firstfloatreg=RS_NO then + firstfloatreg:=r; + lastfloatreg:=r; + end; + if firstfloatreg<>RS_NO then + floatsavesize:=(lastfloatreg-firstfloatreg+1)*12; + end; + fpu_vfpv2, + fpu_vfpv3: + begin + floatsavesize:=0; + regs:=cg.rg[R_MMREGISTER].used_in_proc-paramanager.get_volatile_registers_mm(pocall_stdcall); + for r:=RS_D0 to RS_D31 do + if r in regs then + inc(floatsavesize,8); + end; + end; + floatsavesize:=align(floatsavesize,max(current_settings.alignment.localalignmin,4)); + result:=Align(tg.direction*tg.lasttemp,max(current_settings.alignment.localalignmin,4))+maxpushedparasize+aint(floatsavesize); + floatregstart:=tg.direction*result+maxpushedparasize; + if tg.direction=1 then + dec(floatregstart,floatsavesize); + end; + + +begin + cprocinfo:=tarmprocinfo; +end. diff --git a/closures/compiler/arm/cputarg.pas b/closures/compiler/arm/cputarg.pas new file mode 100644 index 0000000000..fa005ff686 --- /dev/null +++ b/closures/compiler/arm/cputarg.pas @@ -0,0 +1,93 @@ +{ + 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} + {$ifndef NOTARGETPALMOS} + ,t_palmos + {$endif} + {$ifndef NOTARGETNDS} + ,t_nds + {$endif} + {$ifndef NOTARGETEMBEDDED} + ,t_embed + {$endif} + {$ifndef NOTARGETSYMBIAN} + ,t_symbian + {$endif} + {$ifndef NOTARGETBSD} + ,t_bsd + {$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. diff --git a/closures/compiler/arm/itcpugas.pas b/closures/compiler/arm/itcpugas.pas new file mode 100644 index 0000000000..74a186a20e --- /dev/null +++ b/closures/compiler/arm/itcpugas.pas @@ -0,0 +1,93 @@ +{ + 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. diff --git a/closures/compiler/arm/narmadd.pas b/closures/compiler/arm/narmadd.pas new file mode 100644 index 0000000000..5aea26a11d --- /dev/null +++ b/closures/compiler/arm/narmadd.pas @@ -0,0 +1,434 @@ +{ + 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; + public + function pass_1 : tnode;override; + 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,aasmdata,aasmcpu,defutil,htypechk, + cgbase,cgutils,cgcpu, + cpuinfo,pass_1,pass_2,regvars,procinfo, + 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_swapped 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_swapped 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; + singleprec: boolean; + begin + pass_left_right; + if (nf_swapped in flags) then + swapleftright; + + case current_settings.fputype of + fpu_fpa, + fpu_fpa10, + fpu_fpa11: + begin + { force fpureg as location, left right doesn't matter + as both will be in a fpureg } + location_force_fpureg(current_asmdata.CurrAsmList,left.location,true); + location_force_fpureg(current_asmdata.CurrAsmList,right.location,(left.location.loc<>LOC_CFPUREGISTER)); + + location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); + if left.location.loc<>LOC_CFPUREGISTER then + location.register:=left.location.register + else + location.register:=right.location.register; + + case nodetype of + addn : + op:=A_ADF; + muln : + op:=A_MUF; + subn : + op:=A_SUF; + slashn : + op:=A_DVF; + else + internalerror(200308313); + end; + + current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(op, + location.register,left.location.register,right.location.register), + cgsize2fpuoppostfix[def_cgsize(resultdef)])); + end; + fpu_vfpv2, + fpu_vfpv3: + begin + { force mmreg as location, left right doesn't matter + as both will be in a fpureg } + location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,true); + location_force_mmregscalar(current_asmdata.CurrAsmList,right.location,true); + + location_reset(location,LOC_MMREGISTER,def_cgsize(resultdef)); + if left.location.loc<>LOC_CMMREGISTER then + location.register:=left.location.register + else if right.location.loc<>LOC_CMMREGISTER then + location.register:=right.location.register + else + location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size); + + singleprec:=tfloatdef(left.resultdef).floattype=s32real; + case nodetype of + addn : + if singleprec then + op:=A_FADDS + else + op:=A_FADDD; + muln : + if singleprec then + op:=A_FMULS + else + op:=A_FMULD; + subn : + if singleprec then + op:=A_FSUBS + else + op:=A_FSUBD; + slashn : + if singleprec then + op:=A_FDIVS + else + op:=A_FDIVD; + else + internalerror(2009111401); + end; + + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op, + location.register,left.location.register,right.location.register)); + end; + fpu_soft: + { this case should be handled already by pass1 } + internalerror(200308252); + else + internalerror(200308251); + end; + end; + + + procedure tarmaddnode.second_cmpfloat; + var + op: TAsmOp; + begin + pass_left_right; + if (nf_swapped in flags) then + swapleftright; + + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=getresflags(true); + + case current_settings.fputype of + fpu_fpa, + fpu_fpa10, + fpu_fpa11: + begin + { force fpureg as location, left right doesn't matter + as both will be in a fpureg } + location_force_fpureg(current_asmdata.CurrAsmList,left.location,true); + location_force_fpureg(current_asmdata.CurrAsmList,right.location,true); + + if nodetype in [equaln,unequaln] then + current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_CMF, + left.location.register,right.location.register), + cgsize2fpuoppostfix[def_cgsize(resultdef)])) + else + current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_CMFE, + left.location.register,right.location.register), + cgsize2fpuoppostfix[def_cgsize(resultdef)])); + end; + fpu_vfpv2, + fpu_vfpv3: + begin + location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,true); + location_force_mmregscalar(current_asmdata.CurrAsmList,right.location,true); + + if (tfloatdef(left.resultdef).floattype=s32real) then + if nodetype in [equaln,unequaln] then + op:=A_FCMPS + else + op:=A_FCMPES + else if nodetype in [equaln,unequaln] then + op:=A_FCMPD + else + op:=A_FCMPED; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op, + left.location.register,right.location.register)); + current_asmdata.CurrAsmList.concat(taicpu.op_none(A_FMSTAT)); + end; + fpu_soft: + { this case should be handled already by pass1 } + internalerror(2009112404); + end; + + 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 + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register,right.location.register)); + location.resflags:=F_EQ; + end; + unequaln: + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register,right.location.register)); + location.resflags:=F_NE; + end; + lten, + gten: + begin + if (not(nf_swapped in flags) and + (nodetype = lten)) or + ((nf_swapped in flags) and + (nodetype = gten)) then + swapleftright; + tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,location.size); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_AND,tmpreg,left.location.register,right.location.register)); + current_asmdata.CurrAsmList.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; + oldnodetype : tnodetype; + begin + pass_left_right; + force_reg_left_right(false,false); + + unsigned:=not(is_signed(left.resultdef)) or + not(is_signed(right.resultdef)); + + { 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); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reghi,right.location.register64.reghi)); + if current_settings.cputype in cpu_thumb2 then + current_asmdata.CurrAsmList.concat(taicpu.op_cond(A_IT, C_EQ)); + current_asmdata.CurrAsmList.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); + current_asmdata.CurrAsmList.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(current_asmdata.CurrAsmList,getresflags(false),current_procinfo.CurrTrueLabel); + { cheat a little bit for the negative test } + toggleflag(nf_swapped); + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(false),current_procinfo.CurrFalseLabel); + toggleflag(nf_swapped); + end; + lten,gten: + begin + oldnodetype:=nodetype; + if nodetype=lten then + nodetype:=ltn + else + nodetype:=gtn; + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrTrueLabel); + { cheat for the negative test } + if nodetype=ltn then + nodetype:=gtn + else + nodetype:=ltn; + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrFalseLabel); + nodetype:=oldnodetype; + end; + end; + current_asmdata.CurrAsmList.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(current_asmdata.CurrAsmList,getresflags(true),current_procinfo.CurrTrueLabel); + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + end; + end; + + + function tarmaddnode.pass_1 : tnode; + var + unsigned : boolean; + begin + result:=inherited pass_1; + + if not(assigned(result)) then + begin + unsigned:=not(is_signed(left.resultdef)) or + not(is_signed(right.resultdef)); + + if is_64bit(left.resultdef) and + ((nodetype in [equaln,unequaln]) or + (unsigned and (nodetype in [ltn,lten,gtn,gten])) + ) then + expectloc:=LOC_FLAGS; + 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.resultdef)) or + not(is_signed(right.resultdef)); + + if right.location.loc = LOC_CONSTANT then + begin + if is_shifter_const(right.location.value,b) then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CMP,left.location.register,right.location.value)) + else + begin + tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,location.size); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT, + right.location.value,tmpreg); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register,tmpreg)); + end; + end + else + current_asmdata.CurrAsmList.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. diff --git a/closures/compiler/arm/narmcal.pas b/closures/compiler/arm/narmcal.pas new file mode 100644 index 0000000000..da2b510187 --- /dev/null +++ b/closures/compiler/arm/narmcal.pas @@ -0,0 +1,74 @@ +{ + 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 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 narmcal; + +{$i fpcdefs.inc} + +interface + + uses + symdef,node,ncal,ncgcal; + + type + tarmcallnode = class(tcgcallnode) + procedure set_result_location(realresdef: tstoreddef);override; + end; + +implementation + + uses + verbose,globtype,globals,aasmdata, + symconst, + cgbase, + cpubase,cpuinfo, + ncgutil, + paramgr; + + procedure tarmcallnode.set_result_location(realresdef: tstoreddef); + begin + if (realresdef.typ=floatdef) and + ((cs_fp_emulation in current_settings.moduleswitches) or + (current_settings.fputype in [fpu_vfpv2,fpu_vfpv3])) then + begin + { keep the fpu values in integer registers for now, the code + generator will move them to memory or an mmregister when necessary + (avoids double moves in case a function result is assigned to + another function result, or passed as a parameter) } + case retloc.size of + OS_32, + OS_F32: + location_allocate_register(current_asmdata.CurrAsmList,location,s32inttype,false); + OS_64, + OS_F64: + location_allocate_register(current_asmdata.CurrAsmList,location,s64inttype,false); + else + internalerror(2010053008); + end + end + else + inherited; + end; + + +begin + ccallnode:=tarmcallnode; +end. diff --git a/closures/compiler/arm/narmcnv.pas b/closures/compiler/arm/narmcnv.pas new file mode 100644 index 0000000000..9dcfe1b48f --- /dev/null +++ b/closures/compiler/arm/narmcnv.pas @@ -0,0 +1,343 @@ +{ + 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,aasmdata, + defutil, + cgbase,cgutils, + pass_1,pass_2,procinfo, + ncon,ncal, + ncgutil, + cpubase,cpuinfo,aasmcpu, + rgobj,tgobj,cgobj,cgcpu; + + +{***************************************************************************** + FirstTypeConv +*****************************************************************************} + + function tarmtypeconvnode.first_int_to_real: tnode; + var + fname: string[19]; + begin + if cs_fp_emulation in current_settings.moduleswitches then + result:=inherited first_int_to_real + else + begin + { converting a 64bit integer to a float requires a helper } + if is_64bitint(left.resultdef) or + is_currency(left.resultdef) then + begin + { hack to avoid double division by 10000, as it's + already done by typecheckpass.resultdef_int_to_real } + if is_currency(left.resultdef) then + left.resultdef := s64inttype; + if is_signed(left.resultdef) then + fname := 'fpc_int64_to_double' + else + fname := 'fpc_qword_to_double'; + result := ccallnode.createintern(fname,ccallparanode.create( + left,nil)); + left:=nil; + if (tfloatdef(resultdef).floattype=s32real) then + inserttypeconv(result,s32floattype); + firstpass(result); + exit; + end + else + { other integers are supposed to be 32 bit } + begin + if is_signed(left.resultdef) then + inserttypeconv(left,s32inttype) + else + inserttypeconv(left,u32inttype); + firstpass(left); + end; + result := nil; + case current_settings.fputype of + fpu_fpa, + fpu_fpa10, + fpu_fpa11: + expectloc:=LOC_FPUREGISTER; + fpu_vfpv2, + fpu_vfpv3: + expectloc:=LOC_MMREGISTER; + else + internalerror(2009112702); + end; + end; + end; + + + procedure tarmtypeconvnode.second_int_to_real; + const + signedprec2vfpop: array[boolean,OS_F32..OS_F64] of tasmop = + ((A_FUITOS,A_FUITOD), + (A_FSITOS,A_FSITOD)); + var + instr : taicpu; + href : treference; + l1,l2 : tasmlabel; + hregister : tregister; + signed : boolean; + begin + case current_settings.fputype of + fpu_fpa, + fpu_fpa10, + fpu_fpa11: + begin + { convert first to double to avoid precision loss } + location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); + location_force_reg(current_asmdata.CurrAsmList,left.location,OS_32,true); + location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size); + instr:=taicpu.op_reg_reg(A_FLT,location.register,left.location.register); + if is_signed(left.resultdef) then + begin + instr.oppostfix:=cgsize2fpuoppostfix[def_cgsize(resultdef)]; + current_asmdata.CurrAsmList.concat(instr); + end + else + begin + { flt does a signed load, fix this } + case tfloatdef(resultdef).floattype of + s32real, + s64real: + begin + { converting dword to s64real first and cut off at the end avoids precision loss } + instr.oppostfix:=PF_D; + current_asmdata.CurrAsmList.concat(instr); + + current_asmdata.getdatalabel(l1); + current_asmdata.getjumplabel(l2); + reference_reset_symbol(href,l1,0,const_align(8)); + + current_asmdata.CurrAsmList.concat(Taicpu.op_reg_const(A_CMP,left.location.register,0)); + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_GE,l2); + + hregister:=cg.getfpuregister(current_asmdata.CurrAsmList,OS_F64); + new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,l1.name,const_align(8)); + current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l1)); + { I got this constant from a test program (FK) } + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit($41f00000)); + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit(0)); + + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,OS_F64,OS_F64,href,hregister); + current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ADF,location.register,hregister,location.register),PF_D)); + cg.a_label(current_asmdata.CurrAsmList,l2); + + { cut off if we should convert to single } + if tfloatdef(resultdef).floattype=s32real then + begin + hregister:=location.register; + location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size); + current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_MVF,location.register,hregister),PF_S)); + end; + end; + else + internalerror(200410031); + end; + end; + end; + fpu_vfpv2, + fpu_vfpv3: + begin + location_reset(location,LOC_MMREGISTER,def_cgsize(resultdef)); + signed:=left.location.size=OS_S32; + location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,false); + if (left.location.size<>OS_F32) then + internalerror(2009112703); + if left.location.size<>location.size then + location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size) + else + location.register:=left.location.register; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg( + signedprec2vfpop[signed,location.size],location.register,left.location.register)); + end; + end; + end; + + + procedure tarmtypeconvnode.second_int_to_bool; + var + hreg1, + hregister : tregister; + href : treference; + resflags : tresflags; + hlabel,oldTrueLabel,oldFalseLabel : tasmlabel; + newsize : tcgsize; + begin + oldTrueLabel:=current_procinfo.CurrTrueLabel; + oldFalseLabel:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + secondpass(left); + if codegenerror then + exit; + + { Explicit typecasts from any ordinal type to a boolean type } + { must not change the ordinal value } + if (nf_explicit in flags) and + not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then + begin + location_copy(location,left.location); + newsize:=def_cgsize(resultdef); + { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend } + if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or + ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then + location_force_reg(current_asmdata.CurrAsmList,location,newsize,true) + else + location.size:=newsize; + current_procinfo.CurrTrueLabel:=oldTrueLabel; + current_procinfo.CurrFalseLabel:=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(current_asmdata.CurrAsmList,OS_INT); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,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(current_asmdata.CurrAsmList,OP_OR,OS_32,href,hregister); + tcgarm(cg).cgsetflags:=false; + end + else + begin + location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,true); + tcgarm(cg).cgsetflags:=true; + cg.a_op_reg_reg(current_asmdata.CurrAsmList,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(current_asmdata.CurrAsmList,OS_32); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.register64.reglo,hregister); + tcgarm(cg).cgsetflags:=true; + cg.a_op_reg_reg(current_asmdata.CurrAsmList,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(current_asmdata.CurrAsmList,OP_OR,left.location.size,left.location.register,left.location.register); + tcgarm(cg).cgsetflags:=false; + end; + end; + LOC_JUMP : + begin + hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + current_asmdata.getjumplabel(hlabel); + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hregister); + cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel); + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hregister); + cg.a_label(current_asmdata.CurrAsmList,hlabel); + tcgarm(cg).cgsetflags:=true; + cg.a_op_reg_reg(current_asmdata.CurrAsmList,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(resultdef)); + hreg1:=cg.getintregister(current_asmdata.CurrAsmList,location.size); + cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,hreg1); + if (is_cbool(resultdef)) then + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,hreg1,hreg1); + +{$ifndef cpu64bitalu} + if (location.size in [OS_64,OS_S64]) then + begin + location.register64.reglo:=hreg1; + location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + if (is_cbool(resultdef)) then + { reglo is either 0 or -1 -> reghi has to become the same } + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,location.register64.reglo,location.register64.reghi) + else + { unsigned } + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reghi); + end + else +{$endif cpu64bitalu} + location.register:=hreg1; + + current_procinfo.CurrTrueLabel:=oldTrueLabel; + current_procinfo.CurrFalseLabel:=oldFalseLabel; + end; + + +begin + ctypeconvnode:=tarmtypeconvnode; +end. diff --git a/closures/compiler/arm/narmcon.pas b/closures/compiler/arm/narmcon.pas new file mode 100644 index 0000000000..edfeedc529 --- /dev/null +++ b/closures/compiler/arm/narmcon.pas @@ -0,0 +1,140 @@ +{ + 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_generate_code;override; + end; + + implementation + + uses + verbose, + globtype,globals, + cpuinfo, + aasmbase,aasmtai,aasmdata, + symconst,symdef, + defutil, + cgbase,cgutils, + procinfo, + ncon; + +{***************************************************************************** + TARMREALCONSTNODE +*****************************************************************************} + + procedure tarmrealconstnode.pass_generate_code; + { 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_real_80bit,ait_comp_64bit,ait_comp_64bit,ait_real_128bit); + var + lastlabel : tasmlabel; + realait : taitype; + hiloswapped : boolean; + + begin + location_reset_ref(location,LOC_CREFERENCE,def_cgsize(resultdef),4); + lastlabel:=nil; + realait:=floattype2ait[tfloatdef(resultdef).floattype]; + hiloswapped:=is_double_hilo_swapped; + { const already used ? } + if not assigned(lab_real) then + begin + current_asmdata.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 current_settings.localswitches) or + (cs_check_overflow in current_settings.localswitches)) and + (tai_real_32bit(current_procinfo.aktlocaldata.last).value=MathInf.Value) 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 current_settings.localswitches) or + (cs_check_overflow in current_settings.localswitches)) and + (tai_real_64bit(current_procinfo.aktlocaldata.last).value=MathInf.Value) then + Message(parser_e_range_check_error); + end; + + ait_real_80bit : + begin + current_procinfo.aktlocaldata.concat(Tai_real_80bit.Create(value_real,tfloatdef(resultdef).size)); + + { range checking? } + if ((cs_check_range in current_settings.localswitches) or + (cs_check_overflow in current_settings.localswitches)) and + (tai_real_80bit(current_procinfo.aktlocaldata.last).value=MathInf.Value) 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 current_settings.localswitches) or + (cs_check_overflow in current_settings.localswitches)) and + (tai_real_128bit(current_procinfo.aktlocaldata.last).value=MathInf.Value) 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. diff --git a/closures/compiler/arm/narminl.pas b/closures/compiler/arm/narminl.pas new file mode 100644 index 0000000000..28fce33de9 --- /dev/null +++ b/closures/compiler/arm/narminl.pas @@ -0,0 +1,337 @@ +{ + 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; + } + procedure second_prefetch; override; + private + procedure load_fpu_location(out singleprec: boolean); + end; + + +implementation + + uses + globtype,systems, + cutils,verbose,globals,fmodule, + cpuinfo, + symconst,symdef, + aasmbase,aasmtai,aasmdata,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(out singleprec: boolean); + begin + secondpass(left); + case current_settings.fputype of + fpu_fpa, + fpu_fpa10, + fpu_fpa11: + begin + location_force_fpureg(current_asmdata.CurrAsmList,left.location,true); + location_copy(location,left.location); + if left.location.loc=LOC_CFPUREGISTER then + begin + location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size); + location.loc := LOC_FPUREGISTER; + end; + end; + fpu_vfpv2, + fpu_vfpv3: + begin + location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,true); + location_copy(location,left.location); + if left.location.loc=LOC_CMMREGISTER then + begin + location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size); + location.loc := LOC_MMREGISTER; + end; + end; + else + internalerror(2009111801); + end; + singleprec:=tfloatdef(left.resultdef).floattype=s32real; + end; + + + function tarminlinenode.first_abs_real : tnode; + begin + if (cs_fp_emulation in current_settings.moduleswitches) then + result:=inherited first_abs_real + else + begin + case current_settings.fputype of + fpu_fpa, + fpu_fpa10, + fpu_fpa11: + expectloc:=LOC_FPUREGISTER; + fpu_vfpv2, + fpu_vfpv3: + expectloc:=LOC_MMREGISTER; + else + internalerror(2009112401); + end; + first_abs_real:=nil; + end; + end; + + + function tarminlinenode.first_sqr_real : tnode; + begin + if (cs_fp_emulation in current_settings.moduleswitches) then + result:=inherited first_sqr_real + else + begin + case current_settings.fputype of + fpu_fpa, + fpu_fpa10, + fpu_fpa11: + expectloc:=LOC_FPUREGISTER; + fpu_vfpv2, + fpu_vfpv3: + expectloc:=LOC_MMREGISTER; + else + internalerror(2009112402); + end; + first_sqr_real:=nil; + end; + end; + + + function tarminlinenode.first_sqrt_real : tnode; + begin + if cs_fp_emulation in current_settings.moduleswitches then + result:=inherited first_sqrt_real + else + begin + case current_settings.fputype of + fpu_fpa, + fpu_fpa10, + fpu_fpa11: + expectloc:=LOC_FPUREGISTER; + fpu_vfpv2, + fpu_vfpv3: + expectloc:=LOC_MMREGISTER; + else + internalerror(2009112403); + end; + 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; + result:=nil; + end; + + + function tarminlinenode.first_ln_real: tnode; + begin + expectloc:=LOC_FPUREGISTER; + result:=nil; + end; + + function tarminlinenode.first_cos_real: tnode; + begin + expectloc:=LOC_FPUREGISTER; + result:=nil; + end; + + + function tarminlinenode.first_sin_real: tnode; + begin + expectloc:=LOC_FPUREGISTER; + result:=nil; + end; + } + + + procedure tarminlinenode.second_abs_real; + var + singleprec: boolean; + op: TAsmOp; + begin + load_fpu_location(singleprec); + case current_settings.fputype of + fpu_fpa, + fpu_fpa10, + fpu_fpa11: + current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_ABS,location.register,left.location.register),get_fpu_postfix(resultdef))); + fpu_vfpv2, + fpu_vfpv3: + begin + if singleprec then + op:=A_FABSS + else + op:=A_FABSD; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,location.register,left.location.register)); + end; + else + internalerror(2009111402); + end; + end; + + + procedure tarminlinenode.second_sqr_real; + var + singleprec: boolean; + op: TAsmOp; + begin + load_fpu_location(singleprec); + case current_settings.fputype of + fpu_fpa, + fpu_fpa10, + fpu_fpa11: + current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(A_MUF,location.register,left.location.register,left.location.register),get_fpu_postfix(resultdef))); + fpu_vfpv2, + fpu_vfpv3: + begin + if singleprec then + op:=A_FMULS + else + op:=A_FMULD; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,location.register,left.location.register,left.location.register)); + end; + else + internalerror(2009111403); + end; + end; + + + procedure tarminlinenode.second_sqrt_real; + var + singleprec: boolean; + op: TAsmOp; + begin + load_fpu_location(singleprec); + case current_settings.fputype of + fpu_fpa, + fpu_fpa10, + fpu_fpa11: + current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_SQT,location.register,left.location.register),get_fpu_postfix(resultdef))); + fpu_vfpv2, + fpu_vfpv3: + begin + if singleprec then + op:=A_FSQRTS + else + op:=A_FSQRTD; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,location.register,left.location.register)); + end; + else + internalerror(2009111402); + end; + end; + + + { atn, sin, cos, lgn isn't supported by the linux fpe + procedure tarminlinenode.second_arctan_real; + begin + load_fpu_location; + current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_ATN,location.register,left.location.register),get_fpu_postfix(resultdef))); + end; + + + procedure tarminlinenode.second_ln_real; + begin + load_fpu_location; + current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_LGN,location.register,left.location.register),get_fpu_postfix(resultdef))); + end; + + procedure tarminlinenode.second_cos_real; + begin + load_fpu_location; + current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_COS,location.register,left.location.register),get_fpu_postfix(resultdef))); + end; + + + procedure tarminlinenode.second_sin_real; + begin + load_fpu_location; + current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_SIN,location.register,left.location.register),get_fpu_postfix(resultdef))); + end; + } + + procedure tarminlinenode.second_prefetch; + var + ref : treference; + r : tregister; + begin + if current_settings.cputype>=cpu_armv5 then + begin + secondpass(left); + case left.location.loc of + LOC_CREFERENCE, + LOC_REFERENCE: + begin + r:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,r); + reference_reset_base(ref,r,0,left.location.reference.alignment); + { since the address might be nil we can't use ldr for older cpus } + current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_PLD,ref)); + end; + else + internalerror(200402021); + end; + end; + end; + + +begin + cinlinenode:=tarminlinenode; +end. diff --git a/closures/compiler/arm/narmmat.pas b/closures/compiler/arm/narmmat.pas new file mode 100644 index 0000000000..90e7abc2f0 --- /dev/null +++ b/closures/compiler/arm/narmmat.pas @@ -0,0 +1,357 @@ +{ + 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 + tarmmoddivnode = class(tmoddivnode) + function first_moddivint: tnode;override; + procedure pass_generate_code;override; + end; + + tarmnotnode = class(tcgnotnode) + procedure second_boolean;override; + end; + + tarmunaryminusnode = class(tcgunaryminusnode) + procedure second_float;override; + end; + + +implementation + + uses + globtype,systems, + cutils,verbose,globals,constexp, + aasmbase,aasmcpu,aasmtai,aasmdata, + defutil, + cgbase,cgobj,cgutils, + pass_2,procinfo, + ncon, + cpubase,cpuinfo, + ncgutil,cgcpu, + nadd,pass_1,symdef; + +{***************************************************************************** + TARMMODDIVNODE +*****************************************************************************} + + function tarmmoddivnode.first_moddivint: tnode; + var + power : longint; + begin + if (right.nodetype=ordconstn) and + (nodetype=divn) and + (ispowerof2(tordconstnode(right).value,power) or + (tordconstnode(right).value=1) or + (tordconstnode(right).value=int64(-1)) + ) and + not(is_64bitint(resultdef)) then + result:=nil + else if (current_settings.cputype in [cpu_armv7m]) and + (nodetype=divn) and + not(is_64bitint(resultdef)) then + result:=nil + else if (current_settings.cputype in [cpu_armv7m]) and + (nodetype=modn) and + not(is_64bitint(resultdef)) then + begin + if (right.nodetype=ordconstn) and + ispowerof2(tordconstnode(right).value,power) and + (tordconstnode(right).value<=256) and + (tordconstnode(right).value>0) then + result:=caddnode.create(andn,left,cordconstnode.create(tordconstnode(right).value-1,sinttype,false)) + else + begin + result:=caddnode.create(subn,left,caddnode.create(muln,right.getcopy, cmoddivnode.Create(divn,left.getcopy,right.getcopy))); + right:=nil; + end; + left:=nil; + end + else + result:=inherited first_moddivint; + end; + + + procedure tarmmoddivnode.pass_generate_code; + var + power : longint; + numerator, + helper1, + helper2, + resultreg : tregister; + size : Tcgsize; + so : tshifterop; + + procedure genOrdConstNodeDiv; + begin + if tordconstnode(right).value=0 then + internalerror(2005061701) + else if tordconstnode(right).value=1 then + cg.a_load_reg_reg(current_asmdata.CurrAsmList, OS_INT, OS_INT, numerator, resultreg) + else if (tordconstnode(right).value = int64(-1)) then + begin + // note: only in the signed case possible..., may overflow + current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_MVN, + resultreg,numerator),toppostfix(ord(cs_check_overflow in current_settings.localswitches)*ord(PF_S)))); + end + else if ispowerof2(tordconstnode(right).value,power) then + begin + if (is_signed(right.resultdef)) then + begin + helper1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + helper2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + shifterop_reset(so); + so.shiftmode:=SM_ASR; + so.shiftimm:=31; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_shifterop(A_MOV,helper1,numerator,so)); + shifterop_reset(so); + so.shiftmode:=SM_LSR; + so.shiftimm:=32-power; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_shifterop(A_ADD,helper2,numerator,helper1,so)); + shifterop_reset(so); + so.shiftmode:=SM_ASR; + so.shiftimm:=power; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_shifterop(A_MOV,resultreg,helper2,so)); + end + else + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_INT,power,numerator,resultreg) + end; + end; + +{ + procedure genOrdConstNodeMod; + var + modreg, maskreg, tempreg : tregister; + begin + if (tordconstnode(right).value = 0) then begin + internalerror(2005061702); + end + else if (abs(tordconstnode(right).value.svalue) = 1) then + begin + // x mod +/-1 is always zero + cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, 0, resultreg); + end + else if (ispowerof2(tordconstnode(right).value, power)) then + begin + if (is_signed(right.resultdef)) then begin + + tempreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + maskreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + modreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + + cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, abs(tordconstnode(right).value.svalue)-1, modreg); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SAR, OS_INT, 31, numerator, maskreg); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, numerator, modreg, tempreg); + + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ANDC, maskreg, maskreg, modreg)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBFIC, modreg, tempreg, 0)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBFE, modreg, modreg, modreg)); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, modreg, maskreg, maskreg); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_OR, OS_INT, maskreg, tempreg, resultreg); + end else begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, tordconstnode(right).value.svalue-1, numerator, resultreg); + end; + end else begin + genOrdConstNodeDiv(); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_MUL, OS_INT, tordconstnode(right).value.svalue, resultreg, resultreg); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_SUB, OS_INT, resultreg, numerator, resultreg); + end; + end; +} + + begin + secondpass(left); + secondpass(right); + + if (current_settings.cputype in [cpu_armv7m]) and + (nodetype=divn) and + not(is_64bitint(resultdef)) then + begin + size:=def_cgsize(left.resultdef); + location_force_reg(current_asmdata.CurrAsmList,left.location,size,true); + + location_copy(location,left.location); + location.loc := LOC_REGISTER; + location.register := cg.getintregister(current_asmdata.CurrAsmList,size); + resultreg:=location.register; + + if (right.nodetype=ordconstn) and + ((tordconstnode(right).value=1) or + (tordconstnode(right).value=int64(-1)) or + (tordconstnode(right).value=0) or + ispowerof2(tordconstnode(right).value,power)) then + begin + numerator:=left.location.register; + + genOrdConstNodeDiv; + end + else + begin + location_force_reg(current_asmdata.CurrAsmList,right.location,size,true); + + if is_signed(left.resultdef) or + is_signed(right.resultdef) then + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_IDIV,OS_INT,right.location.register,left.location.register,location.register) + else + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_DIV,OS_INT,right.location.register,left.location.register,location.register); + end; + end + else + begin + location_copy(location,left.location); + + { put numerator in register } + size:=def_cgsize(left.resultdef); + location_force_reg(current_asmdata.CurrAsmList,left.location, + size,true); + location_copy(location,left.location); + numerator:=location.register; + resultreg:=location.register; + if location.loc=LOC_CREGISTER then + begin + location.loc := LOC_REGISTER; + location.register := cg.getintregister(current_asmdata.CurrAsmList,size); + resultreg:=location.register; + end + else if (nodetype=modn) or (right.nodetype=ordconstn) then + begin + // for a modulus op, and for const nodes we need the result register + // to be an extra register + resultreg:=cg.getintregister(current_asmdata.CurrAsmList,size); + end; + + if right.nodetype=ordconstn then + begin + if nodetype=divn then + genOrdConstNodeDiv + else + // genOrdConstNodeMod; + end; + + location.register:=resultreg; + end; + + { unsigned division/module can only overflow in case of division by zero } + { (but checking this overflow flag is more convoluted than performing a } + { simple comparison with 0) } + if is_signed(right.resultdef) then + cg.g_overflowcheck(current_asmdata.CurrAsmList,location,resultdef); + end; + +{***************************************************************************** + TARMNOTNODE +*****************************************************************************} + + procedure tarmnotnode.second_boolean; + var + hl : tasmlabel; + begin + { if the location is LOC_JUMP, we do the secondpass after the + labels are allocated + } + if left.expectloc=LOC_JUMP then + begin + hl:=current_procinfo.CurrTrueLabel; + current_procinfo.CurrTrueLabel:=current_procinfo.CurrFalseLabel; + current_procinfo.CurrFalseLabel:=hl; + secondpass(left); + maketojumpbool(current_asmdata.CurrAsmList,left,lr_load_regvars); + hl:=current_procinfo.CurrTrueLabel; + current_procinfo.CurrTrueLabel:=current_procinfo.CurrFalseLabel; + current_procinfo.CurrFalseLabel:=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, + LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF : + begin + location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),true); + current_asmdata.CurrAsmList.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; + var + op: tasmop; + begin + secondpass(left); + case current_settings.fputype of + fpu_fpa, + fpu_fpa10, + fpu_fpa11: + begin + location_force_fpureg(current_asmdata.CurrAsmList,left.location,false); + location:=left.location; + current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_const(A_RSF, + location.register,left.location.register,0), + cgsize2fpuoppostfix[def_cgsize(resultdef)])); + end; + fpu_vfpv2, + fpu_vfpv3: + begin + location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,true); + location:=left.location; + if (left.location.loc=LOC_CMMREGISTER) then + location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size); + if (location.size=OS_F32) then + op:=A_FNEGS + else + op:=A_FNEGD; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op, + location.register,left.location.register)); + end; + else + internalerror(2009112602); + end; + end; + + +begin + cmoddivnode:=tarmmoddivnode; + cnotnode:=tarmnotnode; + cunaryminusnode:=tarmunaryminusnode; +end. diff --git a/closures/compiler/arm/narmset.pas b/closures/compiler/arm/narmset.pas new file mode 100644 index 0000000000..7dd3fec264 --- /dev/null +++ b/closures/compiler/arm/narmset.pas @@ -0,0 +1,256 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate arm assembler for in set/case 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 narmset; + +{$i fpcdefs.inc} + +interface + + uses + globtype, + node,nset,pass_1,ncgset; + + type + tarmcasenode = class(tcgcasenode) + procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);override; + function has_jumptable : boolean;override; + procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override; + procedure genlinearlist(hp : pcaselabel);override; + end; + + +implementation + + uses + systems, + verbose,globals,constexp, + symconst,symdef,defutil, + aasmbase,aasmtai,aasmdata,aasmcpu, + cgbase,pass_2, + ncon, + cpubase,cpuinfo,procinfo, + cgutils,cgobj,ncgutil, + cgcpu; + + +{***************************************************************************** + TARMCASENODE +*****************************************************************************} + + procedure tarmcasenode.optimizevalues(var max_linear_list:aint;var max_dist:aword); + begin + inc(max_linear_list,2) + end; + + + function tarmcasenode.has_jumptable : boolean; + begin + has_jumptable:=true; + end; + + + procedure tarmcasenode.genjumptable(hp : pcaselabel;min_,max_ : aint); + var + last : TConstExprInt; + indexreg : tregister; + href : treference; + tablelabel: TAsmLabel; + + procedure genitem(list:TAsmList;t : pcaselabel); + var + i : aint; + begin + if assigned(t^.less) then + genitem(list,t^.less); + { fill possible hole } + for i:=last.svalue+1 to t^._low.svalue-1 do + list.concat(Tai_const.Create_sym(elselabel)); + for i:=t^._low.svalue to t^._high.svalue do + list.concat(Tai_const.Create_sym(blocklabel(t^.blockid))); + last:=t^._high.svalue; + if assigned(t^.greater) then + genitem(list,t^.greater); + end; + + procedure genitem_thumb2(list:TAsmList;t : pcaselabel); + var + i : aint; + begin + if assigned(t^.less) then + genitem_thumb2(list,t^.less); + { fill possible hole } + for i:=last.svalue+1 to t^._low.svalue-1 do + list.concat(Tai_const.Create_rel_sym(aitconst_half16bit,tablelabel,elselabel)); + for i:=t^._low.svalue to t^._high.svalue do + list.concat(Tai_const.Create_rel_sym(aitconst_half16bit,tablelabel,blocklabel(t^.blockid))); + last:=t^._high.svalue; + if assigned(t^.greater) then + genitem_thumb2(list,t^.greater); + end; + + begin + if not(jumptable_no_range) then + begin + { case expr less than min_ => goto elselabel } + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,jmp_lt,aint(min_),hregister,elselabel); + { case expr greater than max_ => goto elselabel } + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,jmp_gt,aint(max_),hregister,elselabel); + end; + { make it a 32bit register } + indexreg:=cg.makeregsize(current_asmdata.CurrAsmList,hregister,OS_INT); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,opsize,OS_INT,hregister,indexreg); + + if current_settings.cputype in cpu_thumb2 then + begin + { adjust index } + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_ADDR,min_,indexreg,indexreg); + { create reference and generate jump table } + reference_reset(href,4); + href.base:=NR_PC; + href.index:=indexreg; + href.shiftmode:=SM_LSL; + href.shiftimm:=1; + current_asmdata.CurrAsmList.Concat(taicpu.op_ref(A_TBH,href)); + { generate jump table } + current_asmdata.getjumplabel(tablelabel); + cg.a_label(current_asmdata.CurrAsmList,tablelabel); + last:=min_; + genitem_thumb2(current_asmdata.CurrAsmList,hp); + end + else + begin + { adjust index } + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_ADDR,min_+1,indexreg,indexreg); + { create reference and generate jump table } + reference_reset(href,4); + href.base:=NR_PC; + href.index:=indexreg; + href.shiftmode:=SM_LSL; + href.shiftimm:=2; + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,NR_PC); + { generate jump table } + last:=min_; + genitem(current_asmdata.CurrAsmList,hp); + end; + end; + + + procedure tarmcasenode.genlinearlist(hp : pcaselabel); + var + first : boolean; + lastrange : boolean; + last : TConstExprInt; + cond_lt,cond_le : tresflags; + + procedure genitem(t : pcaselabel); + begin + if assigned(t^.less) then + genitem(t^.less); + { need we to test the first value } + if first and (t^._low>get_min_value(left.resultdef)) then + begin + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,jmp_lt,aint(t^._low.svalue),hregister,elselabel); + end; + if t^._low=t^._high then + begin + if t^._low-last=0 then + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_EQ,0,hregister,blocklabel(t^.blockid)) + else + begin + tcgarm(cg).cgsetflags:=true; + cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, aint(int64(t^._low-last)), hregister); + tcgarm(cg).cgsetflags:=false; + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_EQ,blocklabel(t^.blockid)); + end; + last:=t^._low; + lastrange:=false; + end + else + begin + { it begins with the smallest label, if the value } + { is even smaller then jump immediately to the } + { ELSE-label } + if first then + begin + { have we to ajust the first value ? } + if (t^._low>get_min_value(left.resultdef)) or (get_min_value(left.resultdef)<>0) then + begin + tcgarm(cg).cgsetflags:=true; + cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, aint(int64(t^._low)), hregister); + tcgarm(cg).cgsetflags:=false; + end; + end + else + begin + { if there is no unused label between the last and the } + { present label then the lower limit can be checked } + { immediately. else check the range in between: } + + tcgarm(cg).cgsetflags:=true; + cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, aint(int64(t^._low-last)), hregister); + tcgarm(cg).cgsetflags:=false; + { no jump necessary here if the new range starts at } + { at the value following the previous one } + if ((t^._low-last) <> 1) or + (not lastrange) then + cg.a_jmp_flags(current_asmdata.CurrAsmList,cond_lt,elselabel); + end; + tcgarm(cg).cgsetflags:=true; + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,opsize,aint(int64(t^._high-t^._low)),hregister); + tcgarm(cg).cgsetflags:=false; + cg.a_jmp_flags(current_asmdata.CurrAsmList,cond_le,blocklabel(t^.blockid)); + + last:=t^._high; + lastrange:=true; + end; + first:=false; + if assigned(t^.greater) then + genitem(t^.greater); + end; + + begin + if with_sign then + begin + cond_lt:=F_LT; + cond_le:=F_LE; + end + else + begin + cond_lt:=F_CC; + cond_le:=F_LS; + end; + { do we need to generate cmps? } + if (with_sign and (min_label<0)) then + genlinearcmplist(hp) + else + begin + last:=0; + lastrange:=false; + first:=true; + genitem(hp); + cg.a_jmp_always(current_asmdata.CurrAsmList,elselabel); + end; + end; + +begin + ccasenode:=tarmcasenode; +end. diff --git a/closures/compiler/arm/pp.lpi.template b/closures/compiler/arm/pp.lpi.template new file mode 100644 index 0000000000..11b4a97b66 --- /dev/null +++ b/closures/compiler/arm/pp.lpi.template @@ -0,0 +1,90 @@ + + + + + + + + + + + + + + + + <ActiveEditorIndexAtStart Value="1"/> + </General> + <PublishOptions> + <Version Value="2"/> + <DestinationDirectory Value="c:/temp/publishedproject/"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <CommandLineParams Value="-?"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <Units Count="1"> + <Unit0> + <Filename Value="../pp.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="pp"/> + <EditorIndex Value="0"/> + <Loaded Value="True"/> + </Unit0> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="5"/> + <Target> + <Filename Value="arm/pp"/> + </Target> + <SearchPaths> + <IncludeFiles Value="../"/> + <OtherUnitFiles Value="../;../systems/"/> + <UnitOutputDirectory Value="lazbuild"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <D2Extensions Value="False"/> + <CStyleOperator Value="False"/> + <AllowLabel Value="False"/> + <CPPInline Value="False"/> + </SyntaxOptions> + </Parsing> + <CodeGeneration> + <Generate Value="Faster"/> + <TargetProcessor Value="3"/> + </CodeGeneration> + <Linking> + <Debugging> + <GenerateDebugInfo Value="True"/> + </Debugging> + </Linking> + <Other> + <Verbosity> + <ShowWarn Value="False"/> + <ShowNotes Value="False"/> + <ShowHints Value="False"/> + </Verbosity> + <ConfigFile> + <StopAfterErrCount Value="50"/> + </ConfigFile> + <CustomOptions Value="-dGDB +-darm +"/> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> + <Debugging> + <Exceptions Count="1"> + <Item1> + <Name Value="ECompilerAbortSilent"/> + </Item1> + </Exceptions> + </Debugging> +</CONFIG> diff --git a/closures/compiler/arm/raarm.pas b/closures/compiler/arm/raarm.pas new file mode 100644 index 0000000000..f696f2dd6b --- /dev/null +++ b/closures/compiler/arm/raarm.pas @@ -0,0 +1,56 @@ +{ + 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,aasmdata, + rautils; + + type + TARMOperand=class(TOperand) + end; + + TARMInstruction=class(TInstruction) + oppostfix : toppostfix; + wideformat : boolean; // For wide(32bit) instructions of the thumb-2 instruction set + function ConcatInstruction(p:TAsmList) : tai;override; + end; + + implementation + + uses + aasmcpu; + + function TARMInstruction.ConcatInstruction(p:TAsmList) : tai; + begin + result:=inherited ConcatInstruction(p); + (result as taicpu).oppostfix:=oppostfix; + (result as taicpu).wideformat:=wideformat; + end; + + +end. diff --git a/closures/compiler/arm/raarmgas.pas b/closures/compiler/arm/raarmgas.pas new file mode 100644 index 0000000000..9c52022a02 --- /dev/null +++ b/closures/compiler/arm/raarmgas.pas @@ -0,0 +1,1176 @@ +{ + 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; + actwideformat : boolean; + 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,aasmdata,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, mangledname : 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,mangledname,false); + if (mangledname<>'') then + Message(asmr_e_invalid_reference_syntax); + inc(oper.opr.ref.offset,l); + end; + end; + + + Procedure tarmattreader.BuildReference(oper : tarmoperand); + + procedure do_error; + begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end; + + + procedure test_end(require_rbracket : boolean); + begin + if require_rbracket then begin + if not(actasmtoken=AS_RBRACKET) then + begin + do_error; + exit; + end + else + Consume(AS_RBRACKET); + if (actasmtoken=AS_NOT) then + begin + oper.opr.ref.addressmode:=AM_PREINDEXED; + Consume(AS_NOT); + end; + end; + if not(actasmtoken in [AS_SEPARATOR,AS_end]) then + do_error + else + begin +{$IFDEF debugasmreader} + writeln('TEST_end_FINAL_OK. Created the following ref:'); + writeln('oper.opr.ref.shiftimm=',oper.opr.ref.shiftimm); + writeln('oper.opr.ref.shiftmode=',ord(oper.opr.ref.shiftmode)); + writeln('oper.opr.ref.index=',ord(oper.opr.ref.index)); + writeln('oper.opr.ref.base=',ord(oper.opr.ref.base)); + writeln('oper.opr.ref.signindex=',ord(oper.opr.ref.signindex)); + writeln('oper.opr.ref.addressmode=',ord(oper.opr.ref.addressmode)); + writeln; +{$endIF debugasmreader} + end; + end; + + + function is_shifter_ref_operation(var a : tshiftmode) : boolean; + begin + a := SM_NONE; + if (actasmpattern='LSL') then + a := SM_LSL + else if (actasmpattern='LSR') then + a := SM_LSR + else if (actasmpattern='ASR') then + a := SM_ASR + else if (actasmpattern='ROR') then + a := SM_ROR + else if (actasmpattern='RRX') then + a := SM_RRX; + is_shifter_ref_operation := not(a=SM_NONE); + end; + + + procedure read_index_shift(require_rbracket : boolean); + var + shift : aint; + begin + case actasmtoken of + AS_COMMA : + begin + Consume(AS_COMMA); + if not(actasmtoken=AS_ID) then + do_error; + if is_shifter_ref_operation(oper.opr.ref.shiftmode) then + begin + Consume(AS_ID); + if not(oper.opr.ref.shiftmode=SM_RRX) then + begin + if not(actasmtoken=AS_HASH) then + do_error; + Consume(AS_HASH); + shift := BuildConstExpression(false,true); + if (shift<0) or (shift>32) then + do_error; + oper.opr.ref.shiftimm := shift; + test_end(require_rbracket); + end; + end + else + begin + do_error; + exit; + end; + end; + AS_RBRACKET : + if require_rbracket then + test_end(require_rbracket) + else + begin + do_error; + exit; + end; + AS_SEPARATOR,AS_END : + if not require_rbracket then + test_end(false) + else + do_error; + else + begin + do_error; + exit; + end; + end; + end; + + + procedure read_index(require_rbracket : boolean); + var + recname : string; + o_int,s_int : aint; + begin + case actasmtoken of + AS_REGISTER : + begin + oper.opr.ref.index:=actasmregister; + Consume(AS_REGISTER); + read_index_shift(require_rbracket); + exit; + end; + AS_PLUS,AS_MINUS : + begin + if actasmtoken=AS_PLUS then + begin + Consume(AS_PLUS); + end + else + begin + oper.opr.ref.signindex := -1; + Consume(AS_MINUS); + end; + if actasmtoken=AS_REGISTER then + begin + oper.opr.ref.index:=actasmregister; + Consume(AS_REGISTER); + read_index_shift(require_rbracket); + exit; + end + else + begin + do_error; + exit; + end; + test_end(require_rbracket); + exit; + end; + AS_HASH : // constant + begin + Consume(AS_HASH); + o_int := BuildConstExpression(false,true); + if (o_int>4095) or (o_int<-4095) then + begin + Message(asmr_e_constant_out_of_bounds); + RecoverConsume(false); + exit; + end + else + begin + inc(oper.opr.ref.offset,o_int); + test_end(require_rbracket); + exit; + end; + end; + AS_ID : + begin + recname := actasmpattern; + Consume(AS_ID); + BuildRecordOffsetSize(recname,o_int,s_int,recname,false); + if (o_int>4095)or(o_int<-4095) then + begin + Message(asmr_e_constant_out_of_bounds); + RecoverConsume(false); + exit; + end + else + begin + inc(oper.opr.ref.offset,o_int); + test_end(require_rbracket); + exit; + end; + end; + AS_AT: + begin + do_error; + exit; + end; + AS_DOT : // local label + begin + oper.opr.ref.signindex := BuildConstExpression(true,false); + test_end(require_rbracket); + exit; + end; + AS_RBRACKET : + begin + if require_rbracket then + begin + test_end(require_rbracket); + exit; + end + else + begin + do_error; // unexpected rbracket + exit; + end; + end; + AS_SEPARATOR,AS_end : + begin + if not require_rbracket then + begin + test_end(false); + exit; + end + else + begin + do_error; + exit; + end; + end; + else + begin + // unexpected token + do_error; + exit; + end; + end; // case + end; + + + procedure try_prepostindexed; + begin + Consume(AS_RBRACKET); + case actasmtoken of + AS_COMMA : + begin // post-indexed + Consume(AS_COMMA); + oper.opr.ref.addressmode:=AM_POSTINDEXED; + read_index(false); + exit; + end; + AS_NOT : + begin // pre-indexed + Consume(AS_NOT); + oper.opr.ref.addressmode:=AM_PREINDEXED; + test_end(false); + exit; + end; + else + begin + test_end(false); + exit; + end; + end; // case + end; + + var + lab : TASMLABEL; + begin + Consume(AS_LBRACKET); + oper.opr.ref.addressmode:=AM_OFFSET; // assume "neither PRE nor POST inc" + if actasmtoken=AS_REGISTER then + begin + oper.opr.ref.base:=actasmregister; + Consume(AS_REGISTER); + case actasmtoken of + AS_RBRACKET : + begin + try_prepostindexed; + exit; + end; + AS_COMMA : + begin + Consume(AS_COMMA); + read_index(true); + exit; + end; + else + begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end; + end; + end + else +{ + if base isn't a register, r15=PC is implied base, so it must be a local label. + pascal constants don't make sense, because implied r15 + record offsets probably don't make sense, too (a record offset of code?) + + TODO: However, we could make the Stackpointer implied. + +} + + Begin + case actasmtoken of + AS_ID : + begin + if is_locallabel(actasmpattern) then + begin + CreateLocalLabel(actasmpattern,lab,false); + oper.opr.ref.symbol := lab; + oper.opr.ref.base := NR_PC; + Consume(AS_ID); + test_end(true); + exit; + end + else + begin + // TODO: Stackpointer implied, + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + exit; + end; + end; + else + begin // elsecase + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + exit; + end; + end; + 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; + oper.opr.ref.base:=NR_PC; + end; + end; + + + procedure MaybeRecordOffset; + var + mangledname: string; + 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,mangledname,false); + if (oper.opr.typ<>OPR_CONSTANT) and + (mangledname<>'') then + Message(asmr_e_wrong_sym_type); + 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 : + if (mangledname<>'') then + begin + if (oper.opr.val<>0) then + Message(asmr_e_wrong_sym_type); + oper.opr.typ:=OPR_SYMBOL; + oper.opr.symbol:=current_asmdata.RefAsmSymbol(mangledname); + end + else + inc(oper.opr.val,l); + OPR_SYMBOL: + Message(asmr_e_invalid_symbol_ref); + 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; + + + function is_ConditionCode(hs: string): boolean; + var icond: tasmcond; + begin + is_ConditionCode := false; + + if actopcode in [A_IT,A_ITE,A_ITT, + A_ITEE,A_ITTE,A_ITET,A_ITTT, + A_ITEEE,A_ITTEE,A_ITETE,A_ITTTE,A_ITEET,A_ITTET,A_ITETT,A_ITTTT] then + begin + { 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; + oper.opr.typ := OPR_COND; + oper.opr.cc := icond; + exit(true); + end; + end; + end; + end; + end; + + + function is_modeflag(hs : string): boolean; + var + i: longint; + flags: tcpumodeflags; + begin + is_modeflag := false; + + flags:=[]; + hs:=lower(hs); + + if (actopcode in [A_CPSID,A_CPSIE]) and (length(hs) >= 1) then + begin + for i:=1 to length(hs) do + begin + case hs[i] of + 'a': + Include(flags,mfA); + 'f': + Include(flags,mfF); + 'i': + Include(flags,mfI); + else + exit; + end; + end; + oper.opr.typ := OPR_MODEFLAGS; + oper.opr.flags := flags; + exit(true); + end; + end; + + var + tempreg : tregister; + ireg : tsuperregister; + regtype: tregistertype; + subreg: tsubregister; + 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 + if is_modeflag(actasmpattern) then + begin + consume(AS_ID); + end + else + { Condition code? } + if is_conditioncode(actasmpattern) then + begin + consume(AS_ID); + end + else + { 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,A_FLDM,A_FSTM]) 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:=[]; + regtype:=R_INVALIDREGISTER; + subreg:=R_SUBNONE; + while true do + begin + if actasmtoken=AS_REGISTER then + begin + include(registerset,getsupreg(actasmregister)); + if regtype<>R_INVALIDREGISTER then + begin + if (getregtype(actasmregister)<>regtype) or + (getsubreg(actasmregister)<>subreg) then + Message(asmr_e_mixing_regtypes); + end + else + begin + regtype:=getregtype(actasmregister); + subreg:=getsubreg(actasmregister); + end; + 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.regtype:=regtype; + oper.opr.subreg:=subreg; + oper.opr.regset:=registerset; + if (registerset=[]) then + Message(asmr_e_empty_regset); + 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; + wideformat:=actwideformat; + 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,A_MLA])) then + begin + Consume(AS_COMMA); + if not(TryBuildShifterOp(instr.Operands[operandnum+1] 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..31] of string[3] = ( + 'IAD','DBD','FDD','EAD', + 'IAS','DBS','FDS','EAS', + 'IAX','DBX','FDX','EAX', + 'EP','SB','BT','SH', + 'IA','IB','DA','DB','FD','FA','ED','EA', + 'B','D','E','P','T','H','S'); + + postfixsorted : array[1..31] of TOpPostfix = ( + PF_IAD,PF_DBD,PF_FDD,PF_EAD, + PF_IAS,PF_DBS,PF_FDS,PF_EAS, + PF_IAX,PF_DBX,PF_FDX,PF_EAX, + 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 + j : 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); + actopcode:=A_NONE; + for j:=maxlen downto 1 do + begin + actopcode:=tasmop(PtrUInt(iasmops.Find(copy(hs,1,j)))); + if actopcode<>A_NONE then + begin + actasmtoken:=AS_OPCODE; + { strip op code } + delete(hs,1,j); + break; + end; + end; + if actopcode=A_NONE 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; + { check for format postfix } + if length(hs)>0 then + begin + if upcase(copy(hs,1,2)) = '.W' then + begin + actwideformat:=true; + delete(hs,1,2); + 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; + actwideformat:=false; + 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. diff --git a/closures/compiler/arm/rarmcon.inc b/closures/compiler/arm/rarmcon.inc new file mode 100644 index 0000000000..fc820f5dcb --- /dev/null +++ b/closures/compiler/arm/rarmcon.inc @@ -0,0 +1,92 @@ +{ 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($04060000); +NR_S1 = tregister($04060000); +NR_D0 = tregister($04070000); +NR_S2 = tregister($04060001); +NR_S3 = tregister($04060001); +NR_D1 = tregister($04070001); +NR_S4 = tregister($04060002); +NR_S5 = tregister($04060002); +NR_D2 = tregister($04070002); +NR_S6 = tregister($04060003); +NR_S7 = tregister($04060003); +NR_D3 = tregister($04070003); +NR_S8 = tregister($04060004); +NR_S9 = tregister($04060004); +NR_D4 = tregister($04070004); +NR_S10 = tregister($04060005); +NR_S11 = tregister($04060005); +NR_D5 = tregister($04070005); +NR_S12 = tregister($04060006); +NR_S13 = tregister($04060006); +NR_D6 = tregister($04070006); +NR_S14 = tregister($04060007); +NR_S15 = tregister($04060007); +NR_D7 = tregister($04070007); +NR_S16 = tregister($04060008); +NR_S17 = tregister($04060008); +NR_D8 = tregister($04070008); +NR_S18 = tregister($04060009); +NR_S19 = tregister($04060009); +NR_D9 = tregister($04070009); +NR_S20 = tregister($0406000A); +NR_S21 = tregister($0406000A); +NR_D10 = tregister($0407000A); +NR_S22 = tregister($0406000B); +NR_S23 = tregister($0406000B); +NR_D11 = tregister($0407000B); +NR_S24 = tregister($0406000C); +NR_S25 = tregister($0406000C); +NR_D12 = tregister($0407000C); +NR_S26 = tregister($0406000D); +NR_S27 = tregister($0406000D); +NR_D13 = tregister($0407000D); +NR_S28 = tregister($0406000E); +NR_S29 = tregister($0406000E); +NR_D14 = tregister($0407000E); +NR_S30 = tregister($0406000F); +NR_S31 = tregister($0406000F); +NR_D15 = tregister($0407000F); +NR_D16 = tregister($04070010); +NR_D17 = tregister($04070011); +NR_D18 = tregister($04070012); +NR_D19 = tregister($04070013); +NR_D20 = tregister($04070014); +NR_D21 = tregister($04070015); +NR_D22 = tregister($04070016); +NR_D23 = tregister($04070017); +NR_D24 = tregister($04070018); +NR_D25 = tregister($04070019); +NR_D26 = tregister($0407001A); +NR_D27 = tregister($0407001B); +NR_D28 = tregister($0407001C); +NR_D29 = tregister($0407001D); +NR_D30 = tregister($0407001E); +NR_D31 = tregister($0407001F); +NR_CPSR_C = tregister($05000000); +NR_FPSCR = tregister($05000001); diff --git a/closures/compiler/arm/rarmdwa.inc b/closures/compiler/arm/rarmdwa.inc new file mode 100644 index 0000000000..42a6432848 --- /dev/null +++ b/closures/compiler/arm/rarmdwa.inc @@ -0,0 +1,92 @@ +{ 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, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0 diff --git a/closures/compiler/arm/rarmnor.inc b/closures/compiler/arm/rarmnor.inc new file mode 100644 index 0000000000..00c1301ae9 --- /dev/null +++ b/closures/compiler/arm/rarmnor.inc @@ -0,0 +1,2 @@ +{ don't edit, this file is generated from armreg.dat } +91 diff --git a/closures/compiler/arm/rarmnum.inc b/closures/compiler/arm/rarmnum.inc new file mode 100644 index 0000000000..ceb5304995 --- /dev/null +++ b/closures/compiler/arm/rarmnum.inc @@ -0,0 +1,92 @@ +{ 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($04060000), +tregister($04060000), +tregister($04070000), +tregister($04060001), +tregister($04060001), +tregister($04070001), +tregister($04060002), +tregister($04060002), +tregister($04070002), +tregister($04060003), +tregister($04060003), +tregister($04070003), +tregister($04060004), +tregister($04060004), +tregister($04070004), +tregister($04060005), +tregister($04060005), +tregister($04070005), +tregister($04060006), +tregister($04060006), +tregister($04070006), +tregister($04060007), +tregister($04060007), +tregister($04070007), +tregister($04060008), +tregister($04060008), +tregister($04070008), +tregister($04060009), +tregister($04060009), +tregister($04070009), +tregister($0406000A), +tregister($0406000A), +tregister($0407000A), +tregister($0406000B), +tregister($0406000B), +tregister($0407000B), +tregister($0406000C), +tregister($0406000C), +tregister($0407000C), +tregister($0406000D), +tregister($0406000D), +tregister($0407000D), +tregister($0406000E), +tregister($0406000E), +tregister($0407000E), +tregister($0406000F), +tregister($0406000F), +tregister($0407000F), +tregister($04070010), +tregister($04070011), +tregister($04070012), +tregister($04070013), +tregister($04070014), +tregister($04070015), +tregister($04070016), +tregister($04070017), +tregister($04070018), +tregister($04070019), +tregister($0407001A), +tregister($0407001B), +tregister($0407001C), +tregister($0407001D), +tregister($0407001E), +tregister($0407001F), +tregister($05000000), +tregister($05000001) diff --git a/closures/compiler/arm/rarmrni.inc b/closures/compiler/arm/rarmrni.inc new file mode 100644 index 0000000000..a8a9d0fd7e --- /dev/null +++ b/closures/compiler/arm/rarmrni.inc @@ -0,0 +1,92 @@ +{ 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, +29, +28, +31, +32, +35, +34, +37, +38, +41, +40, +43, +44, +47, +46, +49, +50, +53, +52, +55, +56, +59, +58, +61, +62, +65, +64, +67, +68, +71, +70, +27, +30, +33, +36, +39, +42, +45, +48, +51, +54, +57, +60, +63, +66, +69, +72, +73, +74, +75, +76, +77, +78, +79, +80, +81, +82, +83, +84, +85, +86, +87, +88, +89, +90 diff --git a/closures/compiler/arm/rarmsri.inc b/closures/compiler/arm/rarmsri.inc new file mode 100644 index 0000000000..b3e6f5d76f --- /dev/null +++ b/closures/compiler/arm/rarmsri.inc @@ -0,0 +1,92 @@ +{ don't edit, this file is generated from armreg.dat } +0, +89, +27, +30, +57, +60, +63, +66, +69, +72, +73, +74, +75, +76, +33, +77, +78, +79, +80, +81, +82, +83, +84, +85, +86, +36, +87, +88, +39, +42, +45, +48, +51, +54, +17, +18, +19, +20, +21, +22, +23, +24, +90, +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 diff --git a/closures/compiler/arm/rarmsta.inc b/closures/compiler/arm/rarmsta.inc new file mode 100644 index 0000000000..4180c8a244 --- /dev/null +++ b/closures/compiler/arm/rarmsta.inc @@ -0,0 +1,92 @@ +{ 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, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0, +0 diff --git a/closures/compiler/arm/rarmstd.inc b/closures/compiler/arm/rarmstd.inc new file mode 100644 index 0000000000..f6f071afca --- /dev/null +++ b/closures/compiler/arm/rarmstd.inc @@ -0,0 +1,92 @@ +{ 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', +'d16', +'d17', +'d18', +'d19', +'d20', +'d21', +'d22', +'d23', +'d24', +'d25', +'d26', +'d27', +'d28', +'d29', +'d30', +'d31', +'cpsr_c', +'fpscr' diff --git a/closures/compiler/arm/rarmsup.inc b/closures/compiler/arm/rarmsup.inc new file mode 100644 index 0000000000..cfcf09bbaa --- /dev/null +++ b/closures/compiler/arm/rarmsup.inc @@ -0,0 +1,92 @@ +{ 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 = $01; +RS_S3 = $01; +RS_D1 = $01; +RS_S4 = $02; +RS_S5 = $02; +RS_D2 = $02; +RS_S6 = $03; +RS_S7 = $03; +RS_D3 = $03; +RS_S8 = $04; +RS_S9 = $04; +RS_D4 = $04; +RS_S10 = $05; +RS_S11 = $05; +RS_D5 = $05; +RS_S12 = $06; +RS_S13 = $06; +RS_D6 = $06; +RS_S14 = $07; +RS_S15 = $07; +RS_D7 = $07; +RS_S16 = $08; +RS_S17 = $08; +RS_D8 = $08; +RS_S18 = $09; +RS_S19 = $09; +RS_D9 = $09; +RS_S20 = $0A; +RS_S21 = $0A; +RS_D10 = $0A; +RS_S22 = $0B; +RS_S23 = $0B; +RS_D11 = $0B; +RS_S24 = $0C; +RS_S25 = $0C; +RS_D12 = $0C; +RS_S26 = $0D; +RS_S27 = $0D; +RS_D13 = $0D; +RS_S28 = $0E; +RS_S29 = $0E; +RS_D14 = $0E; +RS_S30 = $0F; +RS_S31 = $0F; +RS_D15 = $0F; +RS_D16 = $10; +RS_D17 = $11; +RS_D18 = $12; +RS_D19 = $13; +RS_D20 = $14; +RS_D21 = $15; +RS_D22 = $16; +RS_D23 = $17; +RS_D24 = $18; +RS_D25 = $19; +RS_D26 = $1A; +RS_D27 = $1B; +RS_D28 = $1C; +RS_D29 = $1D; +RS_D30 = $1E; +RS_D31 = $1F; +RS_CPSR_C = $00; +RS_FPSCR = $01; diff --git a/closures/compiler/arm/rgcpu.pas b/closures/compiler/arm/rgcpu.pas new file mode 100644 index 0000000000..bad81c5e7f --- /dev/null +++ b/closures/compiler/arm/rgcpu.pas @@ -0,0 +1,404 @@ +{ + 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,aasmdata,aasmcpu, + cgbase,cgutils, + cpubase, + rgobj; + + type + trgcpu = class(trgobj) + procedure do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override; + procedure do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override; + procedure add_constraints(reg:tregister);override; + function get_spill_subreg(r:tregister) : tsubregister;override; + end; + + trgcputhumb2 = class(trgobj) + procedure do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override; + procedure do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override; + end; + + trgintcputhumb2 = class(trgcputhumb2) + procedure add_cpu_interferences(p : tai);override; + end; + + trgintcpu = class(trgcpu) + procedure add_cpu_interferences(p : tai);override; + end; + + implementation + + uses + verbose, cutils,globtype, + cgobj, + procinfo; + + procedure trgintcputhumb2.add_cpu_interferences(p: tai); + var + r : tregister; + begin + if p.typ=ait_instruction then + begin + case taicpu(p).opcode of + A_ADD: + begin + if taicpu(p).ops = 3 then + begin + if (taicpu(p).oper[0]^.typ = top_reg) and + (taicpu(p).oper[1]^.typ = top_reg) and + (taicpu(p).oper[2]^.typ in [top_reg, top_shifterop]) then + begin + { if d == 13 || (d == 15 && S == ‘0’) || n == 15 || m IN [13,15] then UNPREDICTABLE; } + add_edge(getsupreg(taicpu(p).oper[0]^.reg), RS_R13); + if taicpu(p).oppostfix <> PF_S then + add_edge(getsupreg(taicpu(p).oper[0]^.reg), RS_R15); + + add_edge(getsupreg(taicpu(p).oper[1]^.reg), RS_R15); + + if (taicpu(p).oper[2]^.typ = top_shifterop) and + (taicpu(p).oper[2]^.shifterop^.rs <> NR_NO) then + begin + add_edge(getsupreg(taicpu(p).oper[2]^.shifterop^.rs), RS_R13); + add_edge(getsupreg(taicpu(p).oper[2]^.shifterop^.rs), RS_R15); + end + else if (taicpu(p).oper[2]^.typ = top_reg) then + begin + add_edge(getsupreg(taicpu(p).oper[2]^.reg), RS_R13); + add_edge(getsupreg(taicpu(p).oper[2]^.reg), RS_R15); + end; + end; + end; + end; + A_LDRB, + A_STRB, + A_STR, + A_LDR, + A_LDRH, + A_STRH, + A_LDRSB, + A_LDRSH, + A_LDRD, + A_STRD: + { don't mix up the framepointer and stackpointer with pre/post indexed operations } + if (taicpu(p).oper[1]^.typ=top_ref) and + (taicpu(p).oper[1]^.ref^.addressmode in [AM_PREINDEXED,AM_POSTINDEXED]) then + begin + add_edge(getsupreg(taicpu(p).oper[1]^.ref^.base),getsupreg(current_procinfo.framepointer)); + { FIXME: temp variable r is needed here to avoid Internal error 20060521 } + { while compiling the compiler. } + r:=NR_STACK_POINTER_REG; + if current_procinfo.framepointer<>r then + add_edge(getsupreg(taicpu(p).oper[1]^.ref^.base),getsupreg(r)); + end; + end; + end; + end; + + + procedure trgcpu.do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister); + var + tmpref : treference; + helplist : TAsmList; + l : tasmlabel; + hreg : tregister; + begin + { don't load spilled register between + mov lr,pc + mov pc,r4 + but befure the mov lr,pc + } + if assigned(pos.previous) and + (pos.typ=ait_instruction) and + (taicpu(pos).opcode=A_MOV) and + (taicpu(pos).oper[0]^.typ=top_reg) and + (taicpu(pos).oper[0]^.reg=NR_R14) and + (taicpu(pos).oper[1]^.typ=top_reg) and + (taicpu(pos).oper[1]^.reg=NR_PC) then + pos:=tai(pos.previous); + + if abs(spilltemp.offset)>4095 then + begin + helplist:=TAsmList.create; + reference_reset(tmpref,sizeof(aint)); + { create consts entry } + current_asmdata.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,current_procinfo.framepointer,0,sizeof(aint)); + tmpref.index:=hreg; + + if spilltemp.index<>NR_NO then + internalerror(200401263); + + helplist.concat(spilling_create_load(tmpref,tempreg)); + if getregtype(tempreg)=R_INTREGISTER then + ungetregisterinline(helplist,hreg); + + list.insertlistafter(pos,helplist); + helplist.free; + end + else + inherited do_spill_read(list,pos,spilltemp,tempreg); + end; + + + procedure trgcpu.do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister); + var + tmpref : treference; + helplist : TAsmList; + l : tasmlabel; + hreg : tregister; + begin + if abs(spilltemp.offset)>4095 then + begin + helplist:=TAsmList.create; + reference_reset(tmpref,sizeof(aint)); + { create consts entry } + current_asmdata.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,current_procinfo.framepointer,0,sizeof(pint)); + tmpref.index:=hreg; + + helplist.concat(spilling_create_store(tempreg,tmpref)); + + if getregtype(tempreg)=R_INTREGISTER then + ungetregisterinline(helplist,hreg); + + list.insertlistafter(pos,helplist); + helplist.free; + end + else + inherited do_spill_written(list,pos,spilltemp,tempreg); + end; + + + procedure trgcpu.add_constraints(reg:tregister); + var + supreg,i : Tsuperregister; + begin + case getsubreg(reg) of + { Let 32bit floats conflict with all double precision regs > 15 + (since these don't have 32 bit equivalents) } + R_SUBFS: + begin + supreg:=getsupreg(reg); + for i:=RS_D16 to RS_D31 do + add_edge(supreg,i); + end; + end; + end; + + + function trgcpu.get_spill_subreg(r:tregister) : tsubregister; + begin + if (getregtype(r)<>R_MMREGISTER) then + result:=defaultsub + else + result:=getsubreg(r); + end; + + + procedure trgcputhumb2.do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister); + var + tmpref : treference; + helplist : TAsmList; + l : tasmlabel; + hreg : tregister; + begin + { don't load spilled register between + mov lr,pc + mov pc,r4 + but befure the mov lr,pc + } + if assigned(pos.previous) and + (pos.typ=ait_instruction) and + (taicpu(pos).opcode=A_MOV) and + (taicpu(pos).oper[0]^.typ=top_reg) and + (taicpu(pos).oper[0]^.reg=NR_R14) and + (taicpu(pos).oper[1]^.typ=top_reg) and + (taicpu(pos).oper[1]^.reg=NR_PC) then + pos:=tai(pos.previous); + + if (spilltemp.offset>4095) or (spilltemp.offset<-255) then + begin + helplist:=TAsmList.create; + reference_reset(tmpref,sizeof(aint)); + { create consts entry } + current_asmdata.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,current_procinfo.framepointer,0,sizeof(aint)); + tmpref.index:=hreg; + + if spilltemp.index<>NR_NO then + internalerror(200401263); + + helplist.concat(spilling_create_load(tmpref,tempreg)); + if getregtype(tempreg)=R_INTREGISTER then + ungetregisterinline(helplist,hreg); + + list.insertlistafter(pos,helplist); + helplist.free; + end + else + inherited do_spill_read(list,pos,spilltemp,tempreg); + end; + + + procedure trgcputhumb2.do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister); + var + tmpref : treference; + helplist : TAsmList; + l : tasmlabel; + hreg : tregister; + begin + if (spilltemp.offset>4095) or (spilltemp.offset<-255) then + begin + helplist:=TAsmList.create; + reference_reset(tmpref,sizeof(aint)); + { create consts entry } + current_asmdata.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,current_procinfo.framepointer,0,sizeof(pint)); + tmpref.index:=hreg; + + helplist.concat(spilling_create_store(tempreg,tmpref)); + + if getregtype(tempreg)=R_INTREGISTER then + ungetregisterinline(helplist,hreg); + + list.insertlistafter(pos,helplist); + helplist.free; + end + else + inherited do_spill_written(list,pos,spilltemp,tempreg); + end; + + + procedure trgintcpu.add_cpu_interferences(p : tai); + var + r : tregister; + 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; + A_LDRB, + A_STRB, + A_STR, + A_LDR, + A_LDRH, + A_STRH: + { don't mix up the framepointer and stackpointer with pre/post indexed operations } + if (taicpu(p).oper[1]^.typ=top_ref) and + (taicpu(p).oper[1]^.ref^.addressmode in [AM_PREINDEXED,AM_POSTINDEXED]) then + begin + add_edge(getsupreg(taicpu(p).oper[1]^.ref^.base),getsupreg(current_procinfo.framepointer)); + { FIXME: temp variable r is needed here to avoid Internal error 20060521 } + { while compiling the compiler. } + r:=NR_STACK_POINTER_REG; + if current_procinfo.framepointer<>r then + add_edge(getsupreg(taicpu(p).oper[1]^.ref^.base),getsupreg(r)); + end; + end; + end; + end; + + +end. diff --git a/closures/compiler/asmutils.pas b/closures/compiler/asmutils.pas new file mode 100644 index 0000000000..570f598016 --- /dev/null +++ b/closures/compiler/asmutils.pas @@ -0,0 +1,131 @@ +{ + Copyright (c) 1998-2006 by Florian Klaempfl + + This unit contains utility functions for assembler 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. + + **************************************************************************** +} +unit asmutils; + +interface + +{$i fpcdefs.inc} + +uses + globtype, + aasmbase, + aasmdata; + + + function emit_ansistring_const(list:TAsmList;data:PChar;len:LongInt;encoding:tstringencoding;NewSection:Boolean=True):TAsmLabel; + function emit_unicodestring_const(list:TAsmList;data:Pointer;encoding:tstringencoding;Winlike:Boolean):TAsmLabel; + + +implementation + +uses + globals, + systems, + verbose, + aasmtai, + widestr, + symdef; + + function emit_ansistring_const(list:TAsmList;data:PChar;len:LongInt;encoding:tstringencoding;NewSection:Boolean): TAsmLabel; + var + referencelab: TAsmLabel; + s: PChar; + begin + current_asmdata.getdatalabel(result); + if NewSection then + new_section(list,sec_rodata,result.name,const_align(sizeof(pint))); + referencelab := nil; + if target_info.system in systems_darwin then + begin + current_asmdata.getdatalabel(referencelab); + list.concat(tai_label.create(referencelab)); + end; + list.concat(tai_const.create_16bit(encoding)); + list.concat(tai_const.create_16bit(1)); +{$ifdef cpu64bitaddr} + { dummy for alignment } + list.concat(tai_const.create_32bit(0)); +{$endif cpu64bitaddr} + list.concat(tai_const.create_pint(-1)); + list.concat(tai_const.create_pint(len)); + { make sure the string doesn't get dead stripped if the header is referenced } + if target_info.system in systems_darwin then + list.concat(tai_directive.create(asd_reference,result.name)); + list.concat(tai_label.create(result)); + { and vice versa } + if target_info.system in systems_darwin then + list.concat(tai_directive.create(asd_reference,referencelab.name)); + + getmem(s,len+1); + move(data^,s^,len); + s[len]:=#0; + list.concat(tai_string.create_pchar(s,len+1)); { terminating zero included } + end; + + + function emit_unicodestring_const(list:TAsmList;data:Pointer;encoding:tstringencoding;Winlike:Boolean):TAsmLabel; + var + referencelab: TAsmLabel; + i, strlength: SizeInt; + begin + current_asmdata.getdatalabel(result); + new_section(list,sec_rodata,result.name,const_align(sizeof(pint))); + referencelab := nil; + if target_info.system in systems_darwin then + begin + current_asmdata.getdatalabel(referencelab); + list.concat(tai_label.create(referencelab)); + end; + strlength := getlengthwidestring(pcompilerwidestring(data)); + if Winlike then + list.concat(Tai_const.Create_32bit(strlength*cwidechartype.size)) + else + begin + list.concat(tai_const.create_16bit(encoding)); + list.concat(tai_const.create_16bit(2)); + {$ifdef cpu64bitaddr} + { dummy for alignment } + list.concat(Tai_const.Create_32bit(0)); + {$endif cpu64bitaddr} + list.concat(Tai_const.Create_pint(-1)); + list.concat(Tai_const.Create_pint(strlength)); + end; + { make sure the string doesn't get dead stripped if the header is referenced } + if (target_info.system in systems_darwin) then + list.concat(tai_directive.create(asd_reference,result.name)); + list.concat(Tai_label.Create(result)); + { ... and vice versa } + if (target_info.system in systems_darwin) then + list.concat(tai_directive.create(asd_reference,referencelab.name)); + if cwidechartype.size = 2 then + begin + for i:=0 to strlength-1 do + list.concat(Tai_const.Create_16bit(pcompilerwidestring(data)^.data[i])); + { ending #0 } + list.concat(Tai_const.Create_16bit(0)); + end + else + InternalError(200904271); { codegeneration for other sizes must be written } + end; + + +end. diff --git a/closures/compiler/assemble.pas b/closures/compiler/assemble.pas new file mode 100644 index 0000000000..5bf009404a --- /dev/null +++ b/closures/compiler/assemble.pas @@ -0,0 +1,1669 @@ +{ + 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 + SysUtils, + systems,globtype,globals,aasmbase,aasmtai,aasmdata,ogbase,finput; + + const + { maximum of aasmoutput lists there will be } + maxoutputlists = ord(high(tasmlisttype))+1; + { buffer size for writing the .s file } + AsmOutSize=32768*4; + + type + TAssembler=class(TAbstractAssembler) + public + {filenames} + path : string; + name : string; + AsmFileName, { current .s and .o file } + ObjFileName, + 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 overridden 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; + {input source info} + lastfileinfo : tfileposinfo; + infile, + lastinfile : tinputfile; + {last section type written} + lastsectype : TAsmSectionType; + procedure WriteSourceLine(hp: tailineinfo); + procedure WriteTempalloc(hp: tai_tempalloc); + 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 overridden for each assembler, it is used + to actually write the abstract assembler stream to file.} + procedure WriteTree(p:TAsmList);virtual; + + {# This routine should be overridden 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; + + {# Constructs the command line for calling the assembler } + function MakeCmdLine: TCmdStr; virtual; + public + Constructor Create(smart:boolean);override; + procedure MakeObject;override; + end; + + { TInternalAssembler } + + TInternalAssembler=class(TAssembler) + private + FCObjOutput : TObjOutputclass; + { the aasmoutput lists that need to be processed } + lists : byte; + list : array[1..maxoutputlists] of TAsmList; + { current processing } + currlistidx : byte; + currlist : TAsmList; + procedure WriteStab(p:pchar); + function MaybeNextList(var hp:Tai):boolean; + function SetIndirectToSymbol(hp: Tai; const indirectname: string): Boolean; + function TreePass0(hp:Tai):Tai; + function TreePass1(hp:Tai):Tai; + function TreePass2(hp:Tai):Tai; + procedure writetree; + procedure writetreesmart; + protected + ObjData : TObjData; + ObjOutput : tObjOutput; + property CObjOutput:TObjOutputclass read FCObjOutput write FCObjOutput; + public + constructor create(smart:boolean);override; + destructor destroy;override; + procedure MakeObject;override; + end; + + TAssemblerClass = class of TAssembler; + + Procedure GenerateAsm(smart:boolean); + Procedure OnlyAsm; + + procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass); + + +Implementation + + uses +{$ifdef hasunix} + unix, +{$endif} + cutils,cfileutl, +{$ifdef memdebug} + cclasses, +{$endif memdebug} + script,fmodule,verbose, +{$if defined(m68k) or defined(arm)} + cpuinfo, +{$endif m68k or arm} + aasmcpu, + owbase,owar + ; + + var + CAssembler : array[tasm] of TAssemblerClass; + + 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; + +{***************************************************************************** + TAssembler +*****************************************************************************} + + Constructor TAssembler.Create(smart:boolean); + begin + { load start values } + AsmFileName:=current_module.AsmFilename^; + ObjFileName:=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; + AsmFileName:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.asmext); + ObjFileName:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.objext); + { insert in container so it can be cleared after the linking } + SmartLinkOFiles.Insert(ObjFileName); + end; + + +{***************************************************************************** + TExternalAssembler +*****************************************************************************} + + Function DoPipe:boolean; + begin + DoPipe:=(cs_asm_pipe in current_settings.globalswitches) and + (([cs_asm_extern,cs_asm_leave,cs_link_on_target] * current_settings.globalswitches) = []) and + ((target_asm.id in [as_gas,as_ggas,as_darwin])); + end; + + + Constructor TExternalAssembler.Create(smart:boolean); + begin + inherited Create(smart); + if SmartAsm then + begin + path:=FixPath(ChangeFileExt(AsmFileName,target_info.smartext),false); + CreateSmartLinkPath(path); + end; + Outcnt:=0; + end; + + + procedure TExternalAssembler.CreateSmartLinkPath(const s:string); + + procedure DeleteFilesWithExt(const AExt:string); + var + dir : TSearchRec; + begin + if findfirst(s+source_info.dirsep+'*'+AExt,faAnyFile,dir) = 0 then + begin + repeat + DeleteFile(s+source_info.dirsep+dir.name); + until findnext(dir) <> 0; + end; + findclose(dir); + end; + + var + hs : string; + begin + if PathExists(s,false) then + begin + { the path exists, now we clean only all the .o and .s files } + DeleteFilesWithExt(target_info.objext); + DeleteFilesWithExt(target_info.asmext); + end + else + begin + hs:=s; + if hs[length(hs)] in ['/','\'] then + delete(hs,length(hs),1); + {$push} {$I-} + mkdir(hs); + {$pop} + if ioresult<>0 then; + end; + end; + + + const + lastas : byte=255; + var + LastASBin : TCmdStr; + Function TExternalAssembler.FindAssembler:string; + var + asfound : boolean; + UtilExe : string; + begin + asfound:=false; + if cs_link_on_target in current_settings.globalswitches then + begin + { If linking on target, don't add any path PM } + FindAssembler:=utilsprefix+ChangeFileExt(target_asm.asmbin,target_info.exeext); + exit; + end + else + UtilExe:=utilsprefix+ChangeFileExt(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,false,LastASBin); + if not AsFound then + asfound:=FindExe(UtilExe,false,LastASBin); + if (not asfound) and not(cs_asm_extern in current_settings.globalswitches) then + begin + Message1(exec_e_assembler_not_found,LastASBin); + current_settings.globalswitches:=current_settings.globalswitches+[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; + var + DosExitCode : Integer; + begin + result:=true; + if (cs_asm_extern in current_settings.globalswitches) then + begin + AsmRes.AddAsmCommand(command,para,name); + exit; + end; + try + FlushOutput; + DosExitCode := ExecuteProcess(command,para); + if DosExitCode <>0 + then begin + Message1(exec_e_error_while_assembling,tostr(dosexitcode)); + result:=false; + end; + except on E:EOSError do + begin + Message1(exec_e_cant_call_assembler,tostr(E.ErrorCode)); + current_settings.globalswitches:=current_settings.globalswitches+[cs_asm_extern]; + result:=false; + end; + end; + end; + + + procedure TExternalAssembler.RemoveAsm; + var + g : file; + begin + if cs_asm_leave in current_settings.globalswitches then + exit; + if cs_asm_extern in current_settings.globalswitches then + AsmRes.AddDeleteCommand(AsmFileName) + else + begin + assign(g,AsmFileName); + {$push} {$I-} + erase(g); + {$pop} + if ioresult<>0 then; + end; + end; + + + Function TExternalAssembler.DoAssemble:boolean; + begin + DoAssemble:=true; + if DoPipe then + exit; + if not(cs_asm_extern in current_settings.globalswitches) then + begin + if SmartAsm then + begin + if (SmartFilesCount<=1) then + Message1(exec_i_assembling_smart,name); + end + else + Message1(exec_i_assembling,name); + end; + + if CallAssembler(FindAssembler,MakeCmdLine) then + RemoveAsm + else + begin + DoAssemble:=false; + GenerateError; + end; + end; + + + Procedure TExternalAssembler.AsmFlush; + begin + if outcnt>0 then + begin + { suppress i/o error } + {$push} {$I-} + BlockWrite(outfile,outbuf,outcnt); + {$pop} + 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 current_settings.globalswitches) 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; + + + function TExternalAssembler.MakeCmdLine: TCmdStr; + begin + result:=target_asm.asmcmd; +{$ifdef m68k} + if current_settings.cputype = cpu_MC68020 then + result:='-m68020 '+result + else + result:='-m68000 '+result; +{$endif} +{$ifdef arm} + if (target_info.system=system_arm_darwin) then + Replace(result,'$ARCH',lower(cputypestr[current_settings.cputype])); +{$endif arm} + if (cs_link_on_target in current_settings.globalswitches) then + begin + Replace(result,'$ASM',maybequoted(ScriptFixFileName(AsmFileName))); + Replace(result,'$OBJ',maybequoted(ScriptFixFileName(ObjFileName))); + end + else + begin +{$ifdef hasunix} + if DoPipe then + Replace(result,'$ASM','') + else +{$endif} + Replace(result,'$ASM',maybequoted(AsmFileName)); + Replace(result,'$OBJ',maybequoted(ObjFileName)); + end; + end; + + + procedure TExternalAssembler.AsmCreate(Aplace:tcutplace); + begin + if SmartAsm then + NextSmartName(Aplace); +{$ifdef hasunix} + if DoPipe then + begin + if SmartAsm then + begin + if (SmartFilesCount<=1) then + Message1(exec_i_assembling_smart,name); + end + else + Message1(exec_i_assembling_pipe,AsmFileName); + POpen(outfile,maybequoted(FindAssembler)+' '+MakeCmdLine,'W'); + end + else +{$endif} + begin + Assign(outfile,AsmFileName); + {$push} {$I-} + Rewrite(outfile,1); + {$pop} + if ioresult<>0 then + begin + ioerror:=true; + Message1(exec_d_cant_create_asmfile,AsmFileName); + 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); + {$push} {$I-} + reset(f,1); + {$pop} + if ioresult=0 then + begin + FileAge := FileGetDate(GetFileHandle(f)); + close(f); + reset(outfile,1); + FileSetDate(GetFileHandle(outFile),FileAge); + end; + end; + close(outfile); + end; + end; + + procedure TExternalAssembler.WriteSourceLine(hp: tailineinfo); + begin + { load infile } + if lastfileinfo.fileindex<>hp.fileinfo.fileindex then + begin + infile:=current_module.sourcefiles.get_file(hp.fileinfo.fileindex); + if assigned(infile) then + begin + { open only if needed !! } + if (cs_asm_source in current_settings.globalswitches) then + infile.open; + end; + { avoid unnecessary reopens of the same file !! } + lastfileinfo.fileindex:=hp.fileinfo.fileindex; + { be sure to change line !! } + lastfileinfo.line:=-1; + end; + { write source } + if (cs_asm_source in current_settings.globalswitches) and + assigned(infile) then + begin + if (infile<>lastinfile) then + begin + AsmWriteLn(target_asm.comment+'['+infile.name^+']'); + if assigned(lastinfile) then + lastinfile.close; + end; + if (hp.fileinfo.line<>lastfileinfo.line) and + (hp.fileinfo.line<infile.maxlinebuf) then + begin + if (hp.fileinfo.line<>0) and + (infile.linebuf^[hp.fileinfo.line]>=0) then + AsmWriteLn(target_asm.comment+'['+tostr(hp.fileinfo.line)+'] '+ + fixline(infile.GetLineStr(hp.fileinfo.line))); + { set it to a negative value ! + to make that is has been read already !! PM } + if (infile.linebuf^[hp.fileinfo.line]>=0) then + infile.linebuf^[hp.fileinfo.line]:=-infile.linebuf^[hp.fileinfo.line]-1; + end; + end; + lastfileinfo:=hp.fileinfo; + lastinfile:=infile; + end; + + procedure TExternalAssembler.WriteTempalloc(hp: tai_tempalloc); + begin +{$ifdef EXTDEBUG} + if assigned(hp.problem) then + AsmWriteLn(target_asm.comment+'Temp '+tostr(hp.temppos)+','+ + tostr(hp.tempsize)+' '+hp.problem^) + else +{$endif EXTDEBUG} + AsmWriteLn(target_asm.comment+'Temp '+tostr(hp.temppos)+','+ + tostr(hp.tempsize)+' '+tempallocstr[hp.allocation]); + end; + + procedure TExternalAssembler.WriteTree(p:TAsmList); + begin + end; + + + procedure TExternalAssembler.WriteAsmList; + begin + end; + + + procedure TExternalAssembler.MakeObject; + begin + AsmCreate(cut_normal); + FillChar(lastfileinfo, sizeof(lastfileinfo), 0); + lastfileinfo.line := -1; + lastinfile := nil; + lastsectype := sec_none; + WriteAsmList; + AsmClose; + if not(ioerror) then + DoAssemble; + end; + + +{***************************************************************************** + TInternalAssembler +*****************************************************************************} + + constructor TInternalAssembler.create(smart:boolean); + begin + inherited create(smart); + ObjOutput:=nil; + ObjData:=nil; + SmartAsm:=smart; + end; + + + destructor TInternalAssembler.destroy; + begin + if assigned(ObjData) then + ObjData.free; + if assigned(ObjOutput) then + ObjOutput.free; + end; + + + procedure TInternalAssembler.WriteStab(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:tobjsymbol;out value:longint):boolean; + var + hs : string; + len, + code : integer; + pstart : pchar; + sym : tobjsymbol; + exprvalue : longint; + gotmin, + have_first_symbol, + have_second_symbol, + dosub : boolean; + begin + result:=false; + value:=0; + relocsym:=nil; + gotmin:=false; + have_first_symbol:=false; + have_second_symbol:=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); + if code<>0 then + internalerror(200702251); + 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:=objdata.symbolref(hs); + have_first_symbol:=true; + { Second symbol? } + if assigned(relocsym) then + begin + if have_second_symbol then + internalerror(2007032201); + have_second_symbol:=true; + if not have_first_symbol then + internalerror(2007032202); + { second symbol should substracted to first } + if not dosub then + internalerror(2007032203); + if (relocsym.objsection<>sym.objsection) then + internalerror(2005091810); + exprvalue:=relocsym.address-sym.address; + relocsym:=nil; + dosub:=false; + end + else + begin + relocsym:=sym; + if assigned(sym.objsection) then + begin + { first symbol should be + } + if not have_first_symbol and dosub then + internalerror(2007032204); + have_first_symbol:=true; + end; + end; + 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; + + var + stabstrlen, + ofs, + nline, + nidx, + nother, + i : longint; + stab : TObjStabEntry; + relocsym : TObjSymbol; + pstr, + pcurr, + pendquote : pchar; + oldsec : TObjSection; + begin + pcurr:=nil; + pstr:=nil; + pendquote:=nil; + relocsym:=nil; + ofs:=0; + + { 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 ObjData.currpass=1 then + begin + ObjData.StabsSec.Alloc(sizeof(TObjStabEntry)); + if assigned(pstr) and (pstr[0]<>#0) then + ObjData.StabStrSec.Alloc(strlen(pstr)+1); + end + 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); + + { Generate stab entry } + if assigned(pstr) and (pstr[0]<>#0) then + begin + stabstrlen:=strlen(pstr); +{$ifdef optimizestabs} + StabStrEntry:=nil; + if (nidx=N_SourceFile) or (nidx=N_IncludeFile) then + begin + hs:=strpas(pstr); + StabstrEntry:=StabStrDict.Find(hs); + if not assigned(StabstrEntry) then + begin + StabstrEntry:=TStabStrEntry.Create(hs); + StabstrEntry:=StabStrSec.Size; + StabStrDict.Insert(StabstrEntry); + { generate new stab } + StabstrEntry:=nil; + end; + end; + if assigned(StabstrEntry) then + stab.strpos:=StabstrEntry.strpos + else +{$endif optimizestabs} + begin + stab.strpos:=ObjData.StabStrSec.Size; + ObjData.StabStrSec.write(pstr^,stabstrlen+1); + end; + end + else + stab.strpos:=0; + stab.ntype:=byte(nidx); + stab.ndesc:=word(nline); + stab.nother:=byte(nother); + stab.nvalue:=ofs; + + { Write the stab first without the value field. Then + write a the value field with relocation } + oldsec:=ObjData.CurrObjSec; + ObjData.SetSection(ObjData.StabsSec); + ObjData.Writebytes(stab,sizeof(TObjStabEntry)-4); + ObjData.Writereloc(stab.nvalue,4,relocsym,RELOC_ABSOLUTE32); + ObjData.setsection(oldsec); + 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.SetIndirectToSymbol(hp: Tai; const indirectname: string): Boolean; + var + objsym : TObjSymbol; + indsym : TObjSymbol; + begin + Result:= + Assigned(hp) and + (hp.typ=ait_symbol); + if not Result then + Exit; + objsym:=Objdata.SymbolRef(tai_symbol(hp).sym); + objsym.size:=0; + + indsym := TObjSymbol(ObjData.ObjSymbolList.Find(indirectname)); + if not Assigned(indsym) then + begin + { it's possible that indirect symbol is not present in the list, + so we must create it as undefined } + indsym:=TObjSymbol.Create(ObjData.ObjSymbolList, indirectname); + indsym.typ:=AT_NONE; + indsym.bind:=AB_NONE; + end; + objsym.indsymbol:=indsym; + Result:=true; + end; + + + function TInternalAssembler.TreePass0(hp:Tai):Tai; + var + objsym, + objsymend : TObjSymbol; + begin + while assigned(hp) do + begin + case hp.typ of + ait_align : + begin + if tai_align_abstract(hp).aligntype>1 then + begin + { always use the maximum fillsize in this pass to avoid possible + short jumps to become out of range } + Tai_align_abstract(hp).fillsize:=Tai_align_abstract(hp).aligntype; + ObjData.alloc(Tai_align_abstract(hp).fillsize); + end + else + Tai_align_abstract(hp).fillsize:=0; + end; + ait_datablock : + begin +{$ifdef USE_COMM_IN_BSS} + if writingpackages and + Tai_datablock(hp).is_global then + ObjData.SymbolDefine(Tai_datablock(hp).sym) + else +{$endif USE_COMM_IN_BSS} + begin + ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign)); + ObjData.SymbolDefine(Tai_datablock(hp).sym); + ObjData.alloc(Tai_datablock(hp).size); + end; + end; + ait_real_80bit : + ObjData.alloc(tai_real_80bit(hp).savesize); + ait_real_64bit : + ObjData.alloc(8); + ait_real_32bit : + ObjData.alloc(4); + ait_comp_64bit : + ObjData.alloc(8); + ait_const: + begin + { if symbols are provided we can calculate the value for relative symbols. + This is required for length calculation of leb128 constants } + if assigned(tai_const(hp).sym) then + begin + objsym:=Objdata.SymbolRef(tai_const(hp).sym); + { objsym already defined and there is endsym? } + if assigned(objsym.objsection) and assigned(tai_const(hp).endsym) then + begin + objsymend:=Objdata.SymbolRef(tai_const(hp).endsym); + { objsymend already defined? } + if assigned(objsymend.objsection) then + begin + if objsymend.objsection<>objsym.objsection then + internalerror(200404124); + Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs; + end; + end; + end; + ObjData.alloc(tai_const(hp).size); + end; + ait_directive: + begin + case tai_directive(hp).directive of + asd_indirect_symbol: + { handled in TreePass1 } + ; + asd_lazy_reference: + begin + if tai_directive(hp).name = nil then + Internalerror(2009112101); + objsym:=ObjData.symbolref(tai_directive(hp).name^); + objsym.bind:=AB_LAZY; + end; + asd_reference: + { ignore for now, but should be added} + ; + else + internalerror(2010011101); + end; + end; + ait_section: + begin + ObjData.CreateSection(Tai_section(hp).sectype,Tai_section(hp).name^,Tai_section(hp).secorder); + Tai_section(hp).sec:=ObjData.CurrObjSec; + end; + ait_symbol : + begin + { needs extra support in the internal assembler } + { the value is just ignored } + {if tai_symbol(hp).has_value then + internalerror(2009090804); ;} + ObjData.SymbolDefine(Tai_symbol(hp).sym); + end; + ait_label : + ObjData.SymbolDefine(Tai_label(hp).labsym); + ait_string : + ObjData.alloc(Tai_string(hp).len); + ait_instruction : + begin + { reset instructions which could change in pass 2 } + Taicpu(hp).resetpass2; + ObjData.alloc(Taicpu(hp).Pass1(ObjData)); + end; + ait_cutobject : + if SmartAsm then + break; + end; + hp:=Tai(hp.next); + end; + TreePass0:=hp; + end; + + + function TInternalAssembler.TreePass1(hp:Tai):Tai; + var + objsym, + objsymend : TObjSymbol; + begin + while assigned(hp) do + begin + case hp.typ of + ait_align : + begin + if tai_align_abstract(hp).aligntype>1 then + begin + { here we must determine the fillsize which is used in pass2 } + Tai_align_abstract(hp).fillsize:=align(ObjData.CurrObjSec.Size,Tai_align_abstract(hp).aligntype)- + ObjData.CurrObjSec.Size; + ObjData.alloc(Tai_align_abstract(hp).fillsize); + end; + end; + ait_datablock : + begin + if (oso_data in ObjData.CurrObjSec.secoptions) then + Message(asmw_e_alloc_data_only_in_bss); +{$ifdef USE_COMM_IN_BSS} + if writingpackages and + Tai_datablock(hp).is_global then + begin + objsym:=ObjData.SymbolDefine(Tai_datablock(hp).sym); + objsym.size:=Tai_datablock(hp).size; + objsym.bind:=AB_COMMON; + objsym.alignment:=needtowritealignmentalsoforELF; + end + else +{$endif USE_COMM_IN_BSS} + begin + ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign)); + objsym:=ObjData.SymbolDefine(Tai_datablock(hp).sym); + objsym.size:=Tai_datablock(hp).size; + ObjData.alloc(Tai_datablock(hp).size); + end; + end; + ait_real_80bit : + ObjData.alloc(tai_real_80bit(hp).savesize); + ait_real_64bit : + ObjData.alloc(8); + ait_real_32bit : + ObjData.alloc(4); + ait_comp_64bit : + ObjData.alloc(8); + ait_const: + begin + { Recalculate relative symbols } + if assigned(tai_const(hp).sym) and + assigned(tai_const(hp).endsym) then + begin + objsym:=Objdata.SymbolRef(tai_const(hp).sym); + objsymend:=Objdata.SymbolRef(tai_const(hp).endsym); + if objsymend.objsection<>objsym.objsection then + internalerror(200905042); + Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs; + end; + ObjData.alloc(tai_const(hp).size); + end; + ait_section: + begin + { use cached value } + ObjData.setsection(Tai_section(hp).sec); + end; + ait_stab : + begin + if assigned(Tai_stab(hp).str) then + WriteStab(Tai_stab(hp).str); + end; + ait_symbol : + ObjData.SymbolDefine(Tai_symbol(hp).sym); + ait_symbol_end : + begin + objsym:=ObjData.SymbolRef(Tai_symbol_end(hp).sym); + objsym.size:=ObjData.CurrObjSec.Size-objsym.offset; + end; + ait_label : + ObjData.SymbolDefine(Tai_label(hp).labsym); + ait_string : + ObjData.alloc(Tai_string(hp).len); + ait_instruction : + ObjData.alloc(Taicpu(hp).Pass1(ObjData)); + ait_cutobject : + if SmartAsm then + break; + ait_directive : + begin + case tai_directive(hp).directive of + asd_indirect_symbol: + if tai_directive(hp).name = nil then + Internalerror(2009101103) + else if not SetIndirectToSymbol(Tai(hp.Previous), tai_directive(hp).name^) then + Internalerror(2009101102); + asd_lazy_reference: + { handled in TreePass0 } + ; + asd_reference: + { ignore for now, but should be added} + ; + else + internalerror(2010011102); + end; + end; + end; + hp:=Tai(hp.next); + end; + TreePass1:=hp; + end; + + + function TInternalAssembler.TreePass2(hp:Tai):Tai; + var + fillbuffer : tfillbuffer; +{$ifdef x86} + co : comp; +{$endif x86} + leblen : byte; + lebbuf : array[0..63] of byte; + objsym, + objsymend : TObjSymbol; + zerobuf : array[0..63] of byte; + begin + fillchar(zerobuf,sizeof(zerobuf),0); + { main loop } + while assigned(hp) do + begin + case hp.typ of + ait_align : + begin + if oso_data in ObjData.CurrObjSec.secoptions then + ObjData.writebytes(Tai_align_abstract(hp).calculatefillbuf(fillbuffer,oso_executable in ObjData.CurrObjSec.secoptions)^, + Tai_align_abstract(hp).fillsize) + else + ObjData.alloc(Tai_align_abstract(hp).fillsize); + end; + ait_section : + begin + { use cached value } + ObjData.setsection(Tai_section(hp).sec); + end; + ait_symbol : + begin + ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_symbol(hp).sym)); + end; + ait_symbol_end : + begin + { recalculate size, as some preceding instructions + could have been changed to smaller size } + objsym:=ObjData.SymbolRef(Tai_symbol_end(hp).sym); + objsym.size:=ObjData.CurrObjSec.Size-objsym.offset; + end; + ait_datablock : + begin + ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_datablock(hp).sym)); +{$ifdef USE_COMM_IN_BSS} + if not(writingpackages and + Tai_datablock(hp).is_global) then +{$endif USE_COMM_IN_BSS} + begin + ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign)); + ObjData.alloc(Tai_datablock(hp).size); + end; + end; + ait_real_80bit : + begin + ObjData.writebytes(Tai_real_80bit(hp).value,10); + ObjData.writebytes(zerobuf,Tai_real_80bit(hp).savesize-10); + end; + ait_real_64bit : + ObjData.writebytes(Tai_real_64bit(hp).value,8); + ait_real_32bit : + ObjData.writebytes(Tai_real_32bit(hp).value,4); + ait_comp_64bit : + begin +{$ifdef x86} + co:=comp(Tai_comp_64bit(hp).value); + ObjData.writebytes(co,8); +{$endif x86} + end; + ait_string : + ObjData.writebytes(Tai_string(hp).str^,Tai_string(hp).len); + ait_const : + begin + { Recalculate relative symbols, addresses of forward references + can be changed in treepass1 } + if assigned(tai_const(hp).sym) and + assigned(tai_const(hp).endsym) then + begin + objsym:=Objdata.SymbolRef(tai_const(hp).sym); + objsymend:=Objdata.SymbolRef(tai_const(hp).endsym); + Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs; + end; + case tai_const(hp).consttype of + aitconst_64bit, + aitconst_32bit, + aitconst_16bit, + aitconst_8bit : + begin + if assigned(tai_const(hp).sym) and + not assigned(tai_const(hp).endsym) then + ObjData.writereloc(Tai_const(hp).symofs,tai_const(hp).size,Objdata.SymbolRef(tai_const(hp).sym),RELOC_ABSOLUTE) + else + ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size); + end; + aitconst_rva_symbol : + begin + { PE32+? } + if target_info.system=system_x86_64_win64 then + ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA) + else + ObjData.writereloc(Tai_const(hp).symofs,sizeof(pint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA); + end; + aitconst_secrel32_symbol : + begin + { Required for DWARF2 support under Windows } + ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_SECREL32); + end; + aitconst_uleb128bit, + aitconst_sleb128bit : + begin + if tai_const(hp).consttype=aitconst_uleb128bit then + leblen:=EncodeUleb128(qword(Tai_const(hp).value),lebbuf) + else + leblen:=EncodeSleb128(Tai_const(hp).value,lebbuf); + if leblen<>tai_const(hp).size then + internalerror(200709271); + ObjData.writebytes(lebbuf,leblen); + end; + aitconst_darwin_dwarf_delta32, + aitconst_darwin_dwarf_delta64: + ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size); + else + internalerror(200603254); + end; + end; + ait_label : + begin + { exporting shouldn't be necessary as labels are local, + but it's better to be on the safe side (PFV) } + ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_label(hp).labsym)); + end; + ait_instruction : + Taicpu(hp).Pass2(ObjData); + ait_stab : + WriteStab(Tai_stab(hp).str); + ait_function_name, + ait_force_line : ; + ait_cutobject : + if SmartAsm then + break; +{$ifdef TEST_WIN64_SEH} + ait_seh_directive : + tai_seh_directive(hp).generate_code(objdata); +{$endif TEST_WIN64_SEH} + end; + hp:=Tai(hp.next); + end; + TreePass2:=hp; + end; + + + procedure TInternalAssembler.writetree; + label + doexit; + var + hp : Tai; + ObjWriter : TObjectWriter; + begin + ObjWriter:=TObjectwriter.create; + ObjOutput:=CObjOutput.Create(ObjWriter); + ObjData:=ObjOutput.newObjData(ObjFileName); + + { Pass 0 } + ObjData.currpass:=0; + ObjData.createsection(sec_code); + ObjData.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; + ObjData.afteralloc; + { leave if errors have occured } + if errorcount>0 then + goto doexit; + + { Pass 1 } + ObjData.currpass:=1; + ObjData.resetsections; + ObjData.beforealloc; + ObjData.createsection(sec_code); + { start with list 1 } + currlistidx:=1; + currlist:=list[currlistidx]; + hp:=Tai(currList.first); + while assigned(hp) do + begin + hp:=TreePass1(hp); + MaybeNextList(hp); + end; + ObjData.createsection(sec_code); + ObjData.afteralloc; + + { leave if errors have occured } + if errorcount>0 then + goto doexit; + + { Pass 2 } + ObjData.currpass:=2; + ObjData.resetsections; + ObjData.beforewrite; + ObjData.createsection(sec_code); + { start with list 1 } + currlistidx:=1; + currlist:=list[currlistidx]; + hp:=Tai(currList.first); + while assigned(hp) do + begin + hp:=TreePass2(hp); + MaybeNextList(hp); + end; + ObjData.createsection(sec_code); + ObjData.afterwrite; + + { don't write the .o file if errors have occured } + if errorcount=0 then + begin + { write objectfile } + ObjOutput.startobjectfile(ObjFileName); + ObjOutput.writeobjectfile(ObjData); + end; + + doexit: + { Cleanup } + ObjData.free; + ObjData:=nil; + ObjWriter.free; + end; + + + procedure TInternalAssembler.writetreesmart; + var + hp : Tai; + startsectype : TAsmSectiontype; + place: tcutplace; + ObjWriter : TObjectWriter; + begin + if not(cs_asm_leave in current_settings.globalswitches) then + ObjWriter:=TARObjectWriter.create(current_module.staticlibfilename^) + else + ObjWriter:=TObjectwriter.create; + + NextSmartName(cut_normal); + ObjOutput:=CObjOutput.Create(ObjWriter); + startsectype:=sec_code; + + { start with list 1 } + currlistidx:=1; + currlist:=list[currlistidx]; + hp:=Tai(currList.first); + while assigned(hp) do + begin + ObjData:=ObjOutput.newObjData(ObjFileName); + + { Pass 0 } + ObjData.currpass:=0; + ObjData.resetsections; + ObjData.beforealloc; + ObjData.createsection(startsectype); + TreePass0(hp); + ObjData.afteralloc; + { leave if errors have occured } + if errorcount>0 then + break; + + { Pass 1 } + ObjData.currpass:=1; + ObjData.resetsections; + ObjData.beforealloc; + ObjData.createsection(startsectype); + TreePass1(hp); + ObjData.afteralloc; + + { leave if errors have occured } + if errorcount>0 then + break; + + { Pass 2 } + ObjData.currpass:=2; + ObjOutput.startobjectfile(ObjFileName); + ObjData.resetsections; + ObjData.beforewrite; + ObjData.createsection(startsectype); + hp:=TreePass2(hp); + ObjData.afterwrite; + + { leave if errors have occured } + if errorcount>0 then + break; + + { write the current objectfile } + ObjOutput.writeobjectfile(ObjData); + ObjData.free; + ObjData:=nil; + + { 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 } + startsectype:=sec_code; + 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; + if (Tai(hp).typ=ait_cutobject) then + place:=Tai_cutobject(hp).place; + hp:=Tai(hp.next); + end; + + if not MaybeNextList(hp) then + break; + + { start next objectfile } + NextSmartName(place); + end; + ObjData.free; + ObjData:=nil; + ObjWriter.free; + end; + + + procedure TInternalAssembler.MakeObject; + + var to_do:set of TasmlistType; + i:TasmlistType; + + procedure addlist(p:TAsmList); + begin + inc(lists); + list[lists]:=p; + end; + + begin + to_do:=[low(Tasmlisttype)..high(Tasmlisttype)]; + if usedeffileforexports then + exclude(to_do,al_exports); + if not(tf_section_threadvars in target_info.flags) then + exclude(to_do,al_threadvars); + for i:=low(TasmlistType) to high(TasmlistType) do + if (i in to_do) and (current_asmdata.asmlists[i]<>nil) then + addlist(current_asmdata.asmlists[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; + +end. diff --git a/closures/compiler/avr/aasmcpu.pas b/closures/compiler/avr/aasmcpu.pas new file mode 100644 index 0000000000..7d4f77e9c1 --- /dev/null +++ b/closures/compiler/avr/aasmcpu.pas @@ -0,0 +1,456 @@ +{ + Copyright (c) 1999-2008 by Mazen Neifer and Florian Klaempfl + + Contains the assembler object for the AVR + + 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,aasmdata,aasmsym, + cgbase,cgutils,cpubase,cpuinfo, + ogbase; + + const + { "mov reg,reg" source operand number } + O_MOV_SOURCE = 1; + { "mov reg,reg" source operand number } + O_MOV_DEST = 0; + + maxinfolen = 5; + + type + tinsentry = record + opcode : tasmop; + ops : byte; + optypes : array[0..3] of longint; + code : array[0..maxinfolen] of char; + flags : longint; + end; + + pinsentry=^tinsentry; + + taicpu = class(tai_cpu_abstract_sym) + constructor op_none(op : tasmop); + + constructor op_reg(op : tasmop;_op1 : tregister); + constructor op_const(op : tasmop;_op1 : LongInt); + constructor op_ref(op : tasmop;const _op1 : treference); + + 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: LongInt); + constructor op_const_reg(op:tasmop; _op1: LongInt; _op2: tregister); + constructor op_ref_reg(op : tasmop;const _op1 : treference;_op2 : 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); + procedure loadbool(opidx:longint;_b:boolean); + { register allocation } + function is_same_reg_move(regtype: Tregistertype):boolean; override; + + { register spilling code } + 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;override; + procedure ResetPass2;override; +{ function CheckIfValid:boolean; + function GetString:string; } + function Pass1(objdata:TObjData):longint;override; +// procedure Pass2(objdata:TObjData);override; + function calcsize(p:PInsEntry):shortint; + private + { next fields are filled in pass1, so pass2 is faster } + inssize : shortint; + insoffset : longint; + insentry : PInsEntry; + LastInsOffset : longint; { need to be public to be reset } + function FindInsentry(objdata:TObjData):boolean; + end; + + tai_align = class(tai_align_abstract) + { nothing to add } + end; + + procedure InitAsm; + procedure DoneAsm; + + function spilling_create_load(const ref:treference;r:tregister):Taicpu; + function spilling_create_store(r:tregister; const ref:treference):Taicpu; + + function setcondition(i : taicpu;c : tasmcond) : taicpu; + + { replaces cond. branches by rjmp/jmp and the inverse cond. branch if needed + and transforms special instructions to valid instruction encodings } + procedure finalizeavrcode(list : TAsmList); + +implementation + +{***************************************************************************** + taicpu Constructors +*****************************************************************************} + + procedure taicpu.loadbool(opidx:longint;_b:boolean); + begin + if opidx>=ops then + ops:=opidx+1; + with oper[opidx]^ do + begin + if typ=top_ref then + dispose(ref); + b:=_b; + typ:=top_bool; + end; + end; + + + 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_ref(op : tasmop;const _op1 : treference); + begin + inherited create(op); + ops:=1; + loadref(0,_op1); + end; + + + constructor taicpu.op_const(op : tasmop;_op1 : LongInt); + begin + inherited create(op); + ops:=1; + loadconst(0,_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: LongInt); + begin + inherited create(op); + ops:=2; + loadreg(0,_op1); + loadconst(1,aint(_op2)); + end; + + constructor taicpu.op_const_reg(op:tasmop; _op1: LongInt; _op2: tregister); + begin + inherited create(op); + ops:=2; + loadconst(0,_op1); + loadreg(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_ref_reg(op : tasmop;const _op1 : treference;_op2 : tregister); + begin + inherited create(op); + ops:=2; + loadref(0,_op1); + loadreg(1,_op2); + end; + + + constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol); + begin + inherited create(op); + is_jmp:=op in jmp_instructions; + condition:=cond; + ops:=1; + loadsymbol(0,_op1,0); + end; + + + constructor taicpu.op_sym(op : tasmop;_op1 : tasmsymbol); + begin + inherited create(op); + is_jmp:=op in jmp_instructions; + 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; + + + function taicpu.is_same_reg_move(regtype: Tregistertype):boolean; + begin + result:=( + ((opcode in [A_MOV,A_MOVW]) and (regtype = R_INTREGISTER)) + ) and + (ops=2) and + (oper[0]^.typ=top_reg) and + (oper[1]^.typ=top_reg) and + (oper[0]^.reg=oper[1]^.reg); + end; + + + function taicpu.spilling_get_operation_type(opnr: longint): topertype; + begin + result:=operand_read; + case opcode of + A_CP,A_CPC,A_CPI,A_PUSH : + ; + else + begin + if opnr=0 then + result:=operand_write; + end; + end; + end; + + + function taicpu.calcsize(p:PInsEntry):shortint; + begin + case opcode of + A_CALL, + A_JMP: + result:=4; + A_LDS: + if (getsupreg(oper[0]^.reg)>=RS_R16) and (getsupreg(oper[0]^.reg)<=RS_R31) and + (oper[1]^.val>=0) and (oper[1]^.val<=127) then + result:=2 + else + result:=4; + A_STS: + if (getsupreg(oper[1]^.reg)>=RS_R16) and (getsupreg(oper[1]^.reg)<=RS_R31) and + (oper[0]^.val>=0) and (oper[0]^.val<=127) then + result:=2 + else + result:=4; + else + result:=2; + end; + 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.FindInsentry(objdata:TObjData):boolean; + begin + result:=false; + end; + + + function taicpu.Pass1(objdata:TObjData):longint; + begin + Pass1:=0; + { Save the old offset and set the new offset } + InsOffset:=ObjData.CurrObjSec.Size; + InsSize:=calcsize(InsEntry); + { Error? } + if (Insentry=nil) and (InsSize=-1) then + exit; + { set the file postion } + current_filepos:=fileinfo; + + { Get InsEntry } + if FindInsEntry(objdata) then + begin + LastInsOffset:=InsOffset; + Pass1:=InsSize; + exit; + end; + LastInsOffset:=-1; + end; + + + function spilling_create_load(const ref:treference;r:tregister):Taicpu; + begin + case getregtype(r) of + R_INTREGISTER : + if ref.offset<>0 then + result:=taicpu.op_reg_ref(A_LDD,r,ref) + else + result:=taicpu.op_reg_ref(A_LD,r,ref); + R_ADDRESSREGISTER : + if ref.offset<>0 then + result:=taicpu.op_reg_ref(A_LDD,r,ref) + else + result:=taicpu.op_reg_ref(A_LD,r,ref); + else + internalerror(200401041); + end; + end; + + + function spilling_create_store(r:tregister; const ref:treference):Taicpu; + begin + case getregtype(r) of + R_INTREGISTER : + if ref.offset<>0 then + result:=taicpu.op_ref_reg(A_STD,ref,r) + else + result:=taicpu.op_ref_reg(A_ST,ref,r); + R_ADDRESSREGISTER : + if ref.offset<>0 then + result:=taicpu.op_ref_reg(A_STD,ref,r) + else + result:=taicpu.op_ref_reg(A_ST,ref,r); + else + internalerror(200401041); + end; + end; + + + procedure InitAsm; + begin + end; + + + procedure DoneAsm; + begin + end; + + + function setcondition(i : taicpu;c : tasmcond) : taicpu; + begin + i.condition:=c; + result:=i; + end; + + + procedure finalizeavrcode(list : TAsmList); + var + CurrOffset : longint; + curtai : tai; + again : boolean; + l : tasmlabel; + begin + again:=true; + while again do + begin + again:=false; + CurrOffset:=0; + curtai:=tai(list.first); + while assigned(curtai) do + begin + { instruction? } + if not(curtai.typ in SkipInstr) then + case curtai.typ of + ait_instruction: + begin + taicpu(curtai).InsOffset:=CurrOffset; + inc(CurrOffset,taicpu(curtai).calcsize(nil)); + end; + ait_align: + inc(CurrOffset,tai_align(curtai).aligntype); + ait_marker: + ; + ait_label: + begin + tai_label(curtai).labsym.offset:=CurrOffset; + end; + else + internalerror(2011082401); + end; + curtai:=tai(curtai.next); + end; + + curtai:=tai(list.first); + while assigned(curtai) do + begin + if (curtai.typ=ait_instruction) and + (taicpu(curtai).opcode in [A_BRxx]) and + ((taicpu(curtai).InsOffset-taicpu(curtai).oper[0]^.ref^.symbol.offset>64) or + (taicpu(curtai).InsOffset-taicpu(curtai).oper[0]^.ref^.symbol.offset<-63) + ) then + begin + current_asmdata.getjumplabel(l); + list.insertafter(tai_label.create(l),curtai); + list.insertafter(taicpu.op_sym(A_JMP,taicpu(curtai).oper[0]^.ref^.symbol),curtai); + taicpu(curtai).oper[0]^.ref^.symbol:=l; + taicpu(curtai).condition:=inverse_cond(taicpu(curtai).condition); + again:=true; + end; + curtai:=tai(curtai.next); + end; + end; + end; + + +begin + cai_cpu:=taicpu; + cai_align:=tai_align; +end. diff --git a/closures/compiler/avr/agavrgas.pas b/closures/compiler/avr/agavrgas.pas new file mode 100644 index 0000000000..74b95429de --- /dev/null +++ b/closures/compiler/avr/agavrgas.pas @@ -0,0 +1,216 @@ +{ + 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 agavrgas; + +{$i fpcdefs.inc} + + interface + + uses + globtype, + aasmtai,aasmdata, + aggas, + cpubase; + + type + + { TAVRGNUAssembler } + + TAVRGNUAssembler=class(TGNUassembler) + constructor create(smart: boolean); override; + function MakeCmdLine: TCmdStr; override; + end; + + TAVRInstrWriter=class(TCPUInstrWriter) + procedure WriteInstruction(hp : tai);override; + end; + + + implementation + + uses + cutils,globals,verbose, + systems, + assemble, + aasmcpu, + itcpugas, + cpuinfo, + cgbase,cgutils; + +{****************************************************************************} +{ GNU Arm Assembler writer } +{****************************************************************************} + + constructor TAVRGNUAssembler.create(smart: boolean); + begin + inherited create(smart); + InstrWriter := TAVRInstrWriter.create(self); + end; + + +{****************************************************************************} +{ Helper routines for Instruction Writer } +{****************************************************************************} + + + Procedure TAVRInstrWriter.WriteInstruction(hp : tai); + + 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 index<>NR_NO then + internalerror(2011021701) + else if base<>NR_NO then + begin + if addressmode=AM_PREDRECEMENT then + s:='-' + else + s:=''; + case base of + NR_R26: + s:=s+'X'; + NR_R28: + s:=s+'Y'; + NR_R30: + s:=s+'Z'; + else + s:=gas_regname(base); + end; + if addressmode=AM_POSTINCREMENT then + s:=s+'+'; + + if offset>0 then + s:=s+'+'+tostr(offset) + else if offset<0 then + s:=s+tostr(offset) + end + else if assigned(symbol) or (offset<>0) then + begin + if assigned(symbol) then + s:=ReplaceForbiddenChars(symbol.name) + else + s:=''; + + if offset<0 then + s:=s+tostr(offset) + else if offset>0 then + s:=s+'+'+tostr(offset); + case refaddr of + addr_hi8: + s:='hi8('+s+')'; + addr_lo8: + s:='lo8('+s+')'; + else + s:='('+s+')'; + end; + end; + end; + getreferencestring:=s; + end; + + + 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_const: + getopstr:=tostr(longint(o.val)); + top_ref: + if o.ref^.refaddr=addr_full then + begin + hs:=ReplaceForbiddenChars(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; + + var op: TAsmOp; + s: string; + i: byte; + sep: string[3]; + begin + op:=taicpu(hp).opcode; + s:=#9+gas_op2str[op]+cond2str[taicpu(hp).condition]; + if taicpu(hp).ops<>0 then + begin + sep:=#9; + for i:=0 to taicpu(hp).ops-1 do + begin + s:=s+sep+getopstr(taicpu(hp).oper[i]^); + sep:=','; + end; + end; + owner.AsmWriteLn(s); + end; + + + function TAVRGNUAssembler.MakeCmdLine: TCmdStr; + begin + result := '-mmcu='+lower(cputypestr[current_settings.cputype])+' '+inherited MakeCmdLine; + end; + + + const + as_arm_gas_info : tasminfo = + ( + id : as_gas; + + idtxt : 'AS'; + asmbin : 'as'; + asmcmd : '-o $OBJ $ASM'; + supported_targets : [system_avr_embedded]; + flags : [af_allowdirect,af_needar,af_smartlink_sections]; + labelprefix : '.L'; + comment : '# '; + ); + + +begin + RegisterAssembler(as_arm_gas_info,TAVRGNUAssembler); +end. diff --git a/closures/compiler/avr/aoptcpu.pas b/closures/compiler/avr/aoptcpu.pas new file mode 100644 index 0000000000..90611a1e78 --- /dev/null +++ b/closures/compiler/avr/aoptcpu.pas @@ -0,0 +1,100 @@ +{ + 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, aasmtai, aopt, aoptcpub; + +Type + TCpuAsmOptimizer = class(TAsmOptimizer) + { uses the same constructor as TAopObj } + function PeepHoleOptPass1Cpu(var p: tai): boolean; override; + procedure PeepHoleOptPass2;override; + End; + +Implementation + + uses + aasmbase,aasmcpu,cgbase; + + function CanBeCond(p : tai) : boolean; + begin + result:=(p.typ=ait_instruction) and (taicpu(p).condition=C_None); + end; + + + function TCpuAsmOptimizer.PeepHoleOptPass1Cpu(var p: tai): boolean; + var + next1: tai; + begin + result := false; + case p.typ of + ait_instruction: + begin + case taicpu(p).opcode of + A_MOV: + begin + { fold + mov reg2,reg0 + mov reg3,reg1 + to + movw reg2,reg0 + } + if (taicpu(p).ops=2) and + (taicpu(p).oper[0]^.typ = top_reg) and + (taicpu(p).oper[1]^.typ = top_reg) and + getnextinstruction(p,next1) and + (next1.typ = ait_instruction) and + (taicpu(next1).opcode = A_MOV) and + (taicpu(next1).ops=2) and + (taicpu(next1).oper[0]^.typ = top_reg) and + (taicpu(next1).oper[1]^.typ = top_reg) and + (getsupreg(taicpu(next1).oper[0]^.reg)=getsupreg(taicpu(p).oper[0]^.reg)+1) and + ((getsupreg(taicpu(p).oper[0]^.reg) mod 2)=0) and + ((getsupreg(taicpu(p).oper[1]^.reg) mod 2)=0) and + (getsupreg(taicpu(next1).oper[1]^.reg)=getsupreg(taicpu(p).oper[1]^.reg)+1) then + begin + taicpu(p).opcode:=A_MOVW; + asml.remove(next1); + next1.free; + result := true; + end; + end; + end; + end; + end; + end; + + + procedure TCpuAsmOptimizer.PeepHoleOptPass2; + begin + end; + +begin + casmoptimizer:=TCpuAsmOptimizer; +End. diff --git a/closures/compiler/avr/aoptcpub.pas b/closures/compiler/avr/aoptcpub.pas new file mode 100644 index 0000000000..c56bd8b31f --- /dev/null +++ b/closures/compiler/avr/aoptcpub.pas @@ -0,0 +1,120 @@ + { + 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 = 2; + +{ the maximum number of operands an instruction has } + + MaxOps = 2; + +{Oper index of operand that contains the source (reference) with a load } +{instruction } + + LoadSrc = 1; + +{Oper index of operand that contains the destination (register) with a load } +{instruction } + + LoadDst = 0; + +{Oper index of operand that contains the source (register) with a store } +{instruction } + + StoreSrc = 1; + +{Oper index of operand that contains the destination (reference) with a load } +{instruction } + + StoreDst = 0; + + aopt_uncondjmp = A_JMP; + aopt_condjmp = A_BRxx; + +Implementation + +{ ************************************************************************* } +{ **************************** TCondRegs ********************************** } +{ ************************************************************************* } +Constructor TCondRegs.init; +Begin +End; + +Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl} +Begin +End; + +End. diff --git a/closures/compiler/avr/aoptcpud.pas b/closures/compiler/avr/aoptcpud.pas new file mode 100644 index 0000000000..2df7e2e49e --- /dev/null +++ b/closures/compiler/avr/aoptcpud.pas @@ -0,0 +1,40 @@ +{ + 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. diff --git a/closures/compiler/avr/avrreg.dat b/closures/compiler/avr/avrreg.dat new file mode 100644 index 0000000000..83c71dec1d --- /dev/null +++ b/closures/compiler/avr/avrreg.dat @@ -0,0 +1,41 @@ +; +; AVR registers +; +; layout +; <name>,<type>,<value>,<stdname>,<stab idx>,<dwarf idx> +; +NO,$00,$00,INVALID,-1,-1 + +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 +R16,$01,$10,r16,16,16 +R17,$01,$11,r17,17,17 +R18,$01,$12,r18,18,18 +R19,$01,$13,r19,19,19 +R20,$01,$14,r20,20,20 +R21,$01,$15,r21,21,21 +R22,$01,$16,r22,22,22 +R23,$01,$17,r23,23,23 +R24,$01,$18,r24,24,24 +R25,$01,$19,r25,25,25 +R26,$01,$1a,r26,26,26 +R27,$01,$1b,r27,27,27 +R28,$01,$1c,r28,28,28 +R29,$01,$1d,r29,29,29 +R30,$01,$1e,r30,30,30 +R31,$01,$1f,r31,31,31 + diff --git a/closures/compiler/avr/cgcpu.pas b/closures/compiler/avr/cgcpu.pas new file mode 100644 index 0000000000..21d0d8a5b5 --- /dev/null +++ b/closures/compiler/avr/cgcpu.pas @@ -0,0 +1,1752 @@ +{ + + Copyright (c) 2008 by Florian Klaempfl + Member of the Free Pascal development team + + This unit implements the code generator for the AVR + + 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,aasmdata, + parabase, + cpubase,cpuinfo,node,cg64f32,rgcpu; + + type + + { tcgavr } + + tcgavr = class(tcg) + { true, if the next arithmetic operation should modify the flags } + cgsetflags : boolean; + procedure init_register_allocators;override; + procedure done_register_allocators;override; + + function getintregister(list:TAsmList;size:Tcgsize):Tregister;override; + function getaddressregister(list:TAsmList):TRegister;override; + + procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const paraloc : TCGPara);override; + procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara);override; + procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : TCGPara);override; + + procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override; + procedure a_call_reg(list : TAsmList;reg: tregister);override; + procedure a_call_ref(list : TAsmList;ref: treference);override; + + procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); override; + procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister); override; + + { move instructions } + procedure a_load_const_reg(list : TAsmList; size: tcgsize; a : tcgint;reg : tregister);override; + procedure a_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);override; + procedure a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);override; + procedure a_load_reg_reg(list : TAsmList; fromsize, tosize : tcgsize;reg1,reg2 : tregister);override; + + { fpu move instructions } + procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override; + procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override; + procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override; + + { comparison operations } + procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; + l : tasmlabel);override; + procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override; + + procedure a_jmp_name(list : TAsmList;const s : string); override; + procedure a_jmp_always(list : TAsmList;l: tasmlabel); override; + procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); override; + + procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); override; + + procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override; + procedure g_proc_exit(list : TAsmList;parasize : longint;nostackframe:boolean); override; + + procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override; + + procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);override; + procedure g_concatcopy_move(list : TAsmList;const source,dest : treference;len : tcgint); + + procedure g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef); override; + + procedure g_save_registers(list : TAsmList);override; + procedure g_restore_registers(list : TAsmList);override; + + procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel); + procedure fixref(list : TAsmList;var ref : treference); + function normalize_ref(list : TAsmList;ref : treference; + tmpreg : tregister) : treference; + + procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override; + procedure g_stackpointer_alloc(list : TAsmList;size : longint);override; + procedure emit_mov(list: TAsmList;reg2: tregister; reg1: tregister); + + procedure a_adjust_sp(list: TAsmList; value: longint); + function GetLoad(const ref : treference) : tasmop; + function GetStore(const ref: treference): tasmop; + + procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override; + end; + + tcg64favr = class(tcg64f32) + procedure a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);override; + procedure a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);override; + end; + + procedure create_codegen; + + const + TOpCG2AsmOp: Array[topcg] of TAsmOp = (A_NONE,A_MOV,A_ADD,A_AND,A_NONE, + A_NONE,A_MUL,A_MULS,A_NEG,A_COM,A_OR, + A_ASR,A_LSL,A_LSR,A_SUB,A_EOR,A_ROL,A_ROR); + implementation + + uses + globals,verbose,systems,cutils, + fmodule, + symconst,symsym, + tgobj,rgobj, + procinfo,cpupi, + paramgr; + + + procedure tcgavr.init_register_allocators; + begin + inherited init_register_allocators; + rg[R_INTREGISTER]:=trgintcpu.create(R_INTREGISTER,R_SUBWHOLE, + [RS_R8,RS_R9, + RS_R10,RS_R11,RS_R12,RS_R13,RS_R14,RS_R15,RS_R16,RS_R17,RS_R18,RS_R19, + RS_R20,RS_R21,RS_R22,RS_R23,RS_R24,RS_R25, + RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7],first_int_imreg,[]); + { rg[R_ADDRESSREGISTER]:=trgintcpu.create(R_ADDRESSREGISTER,R_SUBWHOLE, + [RS_R26,RS_R30],first_int_imreg,[]); } + end; + + + procedure tcgavr.done_register_allocators; + begin + rg[R_INTREGISTER].free; + // rg[R_ADDRESSREGISTER].free; + inherited done_register_allocators; + end; + + + function tcgavr.getintregister(list: TAsmList; size: Tcgsize): Tregister; + var + tmp1,tmp2,tmp3 : TRegister; + begin + case size of + OS_8,OS_S8: + Result:=inherited getintregister(list, size); + OS_16,OS_S16: + begin + Result:=inherited getintregister(list, OS_8); + { ensure that the high register can be retrieved by + GetNextReg + } + if inherited getintregister(list, OS_8)<>GetNextReg(Result) then + internalerror(2011021331); + end; + OS_32,OS_S32: + begin + Result:=inherited getintregister(list, OS_8); + tmp1:=inherited getintregister(list, OS_8); + { ensure that the high register can be retrieved by + GetNextReg + } + if tmp1<>GetNextReg(Result) then + internalerror(2011021332); + tmp2:=inherited getintregister(list, OS_8); + { ensure that the upper register can be retrieved by + GetNextReg + } + if tmp2<>GetNextReg(tmp1) then + internalerror(2011021333); + tmp3:=inherited getintregister(list, OS_8); + { ensure that the upper register can be retrieved by + GetNextReg + } + if tmp3<>GetNextReg(tmp2) then + internalerror(2011021334); + end; + else + internalerror(2011021330); + end; + end; + + + function tcgavr.getaddressregister(list: TAsmList): TRegister; + begin + Result:=getintregister(list,OS_ADDR); + end; + + + procedure tcgavr.a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const paraloc : TCGPara); + var + ref: treference; + begin + paraloc.check_simple_location; + paramanager.allocparaloc(list,paraloc.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,paraloc.alignment); + 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 tcgavr.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const paraloc : TCGPara); + var + tmpref, ref: treference; + location: pcgparalocation; + sizeleft: tcgint; + begin + location := paraloc.location; + tmpref := r; + sizeleft := paraloc.intsize; + while assigned(location) do + begin + paramanager.allocparaloc(list,location); + 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,paraloc.alignment); + { doubles in softemu mode have a strange order of registers and references } + if location^.size=OS_32 then + g_concatcopy(list,tmpref,ref,4) + else + begin + g_concatcopy(list,tmpref,ref,sizeleft); + if assigned(location^.next) then + internalerror(2005010710); + end; + 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 tcgavr.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : TCGPara); + var + ref: treference; + tmpreg: tregister; + begin + paraloc.check_simple_location; + paramanager.allocparaloc(list,paraloc.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,paraloc.alignment); + 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 tcgavr.a_call_name(list : TAsmList;const s : string; weak: boolean); + begin + list.concat(taicpu.op_sym(A_RCALL,current_asmdata.RefAsmSymbol(s))); +{ + 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 tcgavr.a_call_reg(list : TAsmList;reg: tregister); + begin + a_reg_alloc(list,NR_ZLO); + a_reg_alloc(list,NR_ZHI); + list.concat(taicpu.op_reg_reg(A_MOV,NR_ZLO,reg)); + list.concat(taicpu.op_reg_reg(A_MOV,NR_ZHI,GetHigh(reg))); + list.concat(taicpu.op_none(A_ICALL)); + a_reg_dealloc(list,NR_ZLO); + a_reg_dealloc(list,NR_ZHI); + + include(current_procinfo.flags,pi_do_call); + end; + + + procedure tcgavr.a_call_ref(list : TAsmList;ref: treference); + begin + a_reg_alloc(list,NR_ZLO); + a_reg_alloc(list,NR_ZHI); + a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,NR_ZLO); + list.concat(taicpu.op_none(A_ICALL)); + a_reg_dealloc(list,NR_ZLO); + a_reg_dealloc(list,NR_ZHI); + + include(current_procinfo.flags,pi_do_call); + end; + + + procedure tcgavr.a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); + var + mask : qword; + shift : byte; + i : byte; + tmpreg : tregister; + begin + mask:=$ff; + shift:=0; + case op of + OP_OR: + begin + for i:=1 to tcgsize2size[size] do + begin + list.concat(taicpu.op_reg_const(A_ORI,reg,(a and mask) shr shift)); + reg:=GetNextReg(reg); + mask:=mask shl 8; + inc(shift,8); + end; + end; + OP_AND: + begin + for i:=1 to tcgsize2size[size] do + begin + list.concat(taicpu.op_reg_const(A_ANDI,reg,(a and mask) shr shift)); + reg:=GetNextReg(reg); + mask:=mask shl 8; + inc(shift,8); + end; + end; + OP_SUB: + begin + list.concat(taicpu.op_reg_const(A_SUBI,reg,a)); + if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then + begin + for i:=2 to tcgsize2size[size] do + begin + reg:=GetNextReg(reg); + mask:=mask shl 8; + inc(shift,8); + list.concat(taicpu.op_reg_const(A_SBCI,reg,(a and mask) shr shift)); + end; + end; + end; + else + begin + tmpreg:=getintregister(list,size); + a_load_const_reg(list,size,a,tmpreg); + a_op_reg_reg(list,op,size,tmpreg,reg); + end; + end; + end; + + + procedure tcgavr.a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister); + var + countreg, + tmpreg: tregister; + i : integer; + instr : taicpu; + paraloc1,paraloc2,paraloc3 : TCGPara; + l1,l2 : tasmlabel; + begin + case op of + OP_ADD: + begin + list.concat(taicpu.op_reg_reg(A_ADD,dst,src)); + if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then + begin + for i:=2 to tcgsize2size[size] do + begin + dst:=GetNextReg(dst); + src:=GetNextReg(src); + list.concat(taicpu.op_reg_reg(A_ADC,dst,src)); + end; + end + else + end; + + OP_SUB: + begin + list.concat(taicpu.op_reg_reg(A_SUB,dst,src)); + if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then + begin + for i:=2 to tcgsize2size[size] do + begin + dst:=GetNextReg(dst); + src:=GetNextReg(src); + list.concat(taicpu.op_reg_reg(A_SBC,dst,src)); + end; + end; + end; + + OP_NEG: + begin + if src<>dst then + a_load_reg_reg(list,size,size,src,dst); + + if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then + begin + tmpreg:=GetNextReg(dst); + for i:=2 to tcgsize2size[size] do + begin + list.concat(taicpu.op_reg(A_COM,tmpreg)); + tmpreg:=GetNextReg(tmpreg); + end; + list.concat(taicpu.op_reg(A_NEG,dst)); + tmpreg:=GetNextReg(dst); + for i:=2 to tcgsize2size[size] do + begin + list.concat(taicpu.op_reg_const(A_SBCI,dst,-1)); + tmpreg:=GetNextReg(tmpreg); + end; + end + else + list.concat(taicpu.op_reg(A_NEG,dst)); + end; + + OP_NOT: + begin + for i:=1 to tcgsize2size[size] do + begin + if src<>dst then + a_load_reg_reg(list,OS_8,OS_8,src,dst); + list.concat(taicpu.op_reg(A_COM,dst)); + src:=GetNextReg(src); + dst:=GetNextReg(dst); + end; + end; + + OP_MUL,OP_IMUL: + begin + if size in [OS_8,OS_S8] then + list.concat(taicpu.op_reg_reg(topcg2asmop[op],dst,src)) + else if size=OS_16 then + 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); + a_load_const_cgpara(list,OS_8,0,paraloc3); + a_load_reg_cgpara(list,OS_16,src,paraloc2); + a_load_reg_cgpara(list,OS_16,dst,paraloc1); + paramanager.freecgpara(list,paraloc3); + paramanager.freecgpara(list,paraloc2); + paramanager.freecgpara(list,paraloc1); + alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); + a_call_name(list,'FPC_MUL_WORD',false); + dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); + cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG); + cg.a_load_reg_reg(list,OS_16,OS_16,NR_FUNCTION_RESULT_REG,dst); + paraloc3.done; + paraloc2.done; + paraloc1.done; + end + else + internalerror(2011022002); + end; + + OP_DIV,OP_IDIV: + { special stuff, needs separate handling inside code } + { generator } + internalerror(2011022001); + + OP_SHR,OP_SHL,OP_SAR,OP_ROL,OP_ROR: + begin + current_asmdata.getjumplabel(l1); + current_asmdata.getjumplabel(l2); + countreg:=getintregister(list,OS_8); + a_load_reg_reg(list,size,OS_8,src,countreg); + list.concat(taicpu.op_reg_const(A_CP,countreg,0)); + a_jmp_flags(list,F_EQ,l2); + cg.a_label(list,l1); + case op of + OP_SHR: + list.concat(taicpu.op_reg(A_LSR,GetOffsetReg(dst,tcgsize2size[size]-1))); + OP_SHL: + list.concat(taicpu.op_reg(A_LSL,dst)); + OP_SAR: + list.concat(taicpu.op_reg(A_ASR,GetOffsetReg(dst,tcgsize2size[size]-1))); + OP_ROR: + begin + { load carry? } + if not(size in [OS_8,OS_S8]) then + begin + list.concat(taicpu.op_none(A_CLC)); + list.concat(taicpu.op_reg_const(A_SBRC,src,0)); + list.concat(taicpu.op_none(A_SEC)); + end; + list.concat(taicpu.op_reg(A_ROR,GetOffsetReg(dst,tcgsize2size[size]-1))); + end; + OP_ROL: + begin + { load carry? } + if not(size in [OS_8,OS_S8]) then + begin + list.concat(taicpu.op_none(A_CLC)); + list.concat(taicpu.op_reg_const(A_SBRC,GetOffsetReg(dst,tcgsize2size[size]-1),7)); + list.concat(taicpu.op_none(A_SEC)); + end; + list.concat(taicpu.op_reg(A_ROL,dst)) + end; + else + internalerror(2011030901); + end; + if size in [OS_S16,OS_16,OS_S32,OS_32,OS_S64,OS_64] then + begin + for i:=2 to tcgsize2size[size] do + begin + case op of + OP_ROR, + OP_SHR: + list.concat(taicpu.op_reg(A_ROR,GetOffsetReg(dst,tcgsize2size[size]-i))); + OP_ROL, + OP_SHL: + list.concat(taicpu.op_reg(A_ROL,GetOffsetReg(dst,i-1))); + OP_SAR: + list.concat(taicpu.op_reg(A_ROR,GetOffsetReg(dst,tcgsize2size[size]-i))); + else + internalerror(2011030902); + end; + end; + end; + + a_op_const_reg(list,OP_SUB,OS_8,1,countreg); + a_jmp_flags(list,F_NE,l1); + // keep registers alive + list.concat(taicpu.op_reg_reg(A_MOV,countreg,countreg)); + cg.a_label(list,l2); + end; + + OP_AND,OP_OR,OP_XOR: + begin + for i:=1 to tcgsize2size[size] do + begin + list.concat(taicpu.op_reg_reg(topcg2asmop[op],dst,src)); + dst:=GetNextReg(dst); + src:=GetNextReg(src); + end; + end; + else + internalerror(2011022004); + end; + end; + + + procedure tcgavr.a_load_const_reg(list : TAsmList; size: tcgsize; a : tcgint;reg : tregister); + var + mask : qword; + shift : byte; + i : byte; + begin + mask:=$ff; + shift:=0; + for i:=1 to tcgsize2size[size] do + begin + if ((qword(a) and mask) shr shift)=0 then + emit_mov(list,reg,NR_R1) + else + list.concat(taicpu.op_reg_const(A_LDI,reg,(qword(a) and mask) shr shift)); + + mask:=mask shl 8; + inc(shift,8); + reg:=GetNextReg(reg); + end; + end; + + + function tcgavr.normalize_ref(list:TAsmList;ref: treference;tmpreg : tregister) : treference; + + procedure maybegetcpuregister(list:tasmlist;reg : tregister); + begin + { allocate the register only, if a cpu register is passed } + if getsupreg(reg)<first_int_imreg then + getcpuregister(list,reg); + end; + + var + tmpref : treference; + l : tasmlabel; + begin + Result:=ref; + + if ref.addressmode<>AM_UNCHANGED then + internalerror(2011021701); + + { Be sure to have a base register } + if (ref.base=NR_NO) then + begin + { only symbol+offset? } + if ref.index=NR_NO then + exit; + ref.base:=ref.index; + ref.index:=NR_NO; + end; + if assigned(ref.symbol) or (ref.offset<>0) then + begin + reference_reset(tmpref,0); + tmpref.symbol:=ref.symbol; + tmpref.offset:=ref.offset; + tmpref.refaddr:=addr_lo8; + maybegetcpuregister(list,tmpreg); + list.concat(taicpu.op_reg_ref(A_LDI,tmpreg,tmpref)); + tmpref.refaddr:=addr_hi8; + maybegetcpuregister(list,GetNextReg(tmpreg)); + list.concat(taicpu.op_reg_ref(A_LDI,GetNextReg(tmpreg),tmpref)); + if (ref.base<>NR_NO) then + begin + list.concat(taicpu.op_reg_reg(A_ADD,tmpreg,ref.base)); + list.concat(taicpu.op_reg_reg(A_ADC,GetNextReg(tmpreg),GetNextReg(ref.base))); + end; + if (ref.index<>NR_NO) then + begin + list.concat(taicpu.op_reg_reg(A_ADD,tmpreg,ref.index)); + list.concat(taicpu.op_reg_reg(A_ADC,GetNextReg(tmpreg),GetNextReg(ref.index))); + end; + ref.symbol:=nil; + ref.offset:=0; + ref.base:=tmpreg; + ref.index:=NR_NO; + end + else if (ref.base<>NR_NO) and (ref.index<>NR_NO) then + begin + maybegetcpuregister(list,tmpreg); + emit_mov(list,tmpreg,ref.index); + maybegetcpuregister(list,GetNextReg(tmpreg)); + emit_mov(list,GetNextReg(tmpreg),GetNextReg(ref.index)); + list.concat(taicpu.op_reg_reg(A_ADD,tmpreg,ref.base)); + list.concat(taicpu.op_reg_reg(A_ADC,GetNextReg(tmpreg),GetNextReg(ref.base))); + ref.base:=tmpreg; + ref.index:=NR_NO; + end + else if (ref.base<>NR_NO) then + begin + maybegetcpuregister(list,tmpreg); + emit_mov(list,tmpreg,ref.base); + maybegetcpuregister(list,GetNextReg(tmpreg)); + emit_mov(list,GetNextReg(tmpreg),GetNextReg(ref.base)); + ref.base:=tmpreg; + ref.index:=NR_NO; + end + else if (ref.index<>NR_NO) then + begin + maybegetcpuregister(list,tmpreg); + emit_mov(list,tmpreg,ref.index); + maybegetcpuregister(list,GetNextReg(tmpreg)); + emit_mov(list,GetNextReg(tmpreg),GetNextReg(ref.index)); + ref.base:=tmpreg; + ref.index:=NR_NO; + end; + Result:=ref; + end; + + + procedure tcgavr.a_load_reg_ref(list : TAsmList; fromsize, tosize: tcgsize; reg : tregister;const ref : treference); + var + href : treference; + conv_done: boolean; + tmpreg : tregister; + i : integer; + QuickRef : Boolean; + begin + QuickRef:=false; + if not((Ref.addressmode=AM_UNCHANGED) and + (Ref.symbol=nil) and + ((Ref.base=NR_R28) or + (Ref.base=NR_R29)) and + (Ref.Index=NR_No) and + (Ref.Offset in [0..64-tcgsize2size[tosize]])) and + not((Ref.Base=NR_NO) and (Ref.Index=NR_NO)) then + href:=normalize_ref(list,Ref,NR_R30) + else + begin + QuickRef:=true; + href:=Ref; + end; + + if (tcgsize2size[fromsize]>32) or (tcgsize2size[tosize]>32) or (fromsize=OS_NO) or (tosize=OS_NO) then + internalerror(2011021307); + + conv_done:=false; + if tosize<>fromsize then + begin + conv_done:=true; + if tcgsize2size[tosize]<=tcgsize2size[fromsize] then + fromsize:=tosize; + case fromsize of + OS_8: + begin + if not(QuickRef) and (tcgsize2size[tosize]>1) then + href.addressmode:=AM_POSTINCREMENT; + + list.concat(taicpu.op_ref_reg(GetStore(href),href,reg)); + for i:=2 to tcgsize2size[tosize] do + begin + if QuickRef then + inc(href.offset); + + if not(QuickRef) and (i<tcgsize2size[fromsize]) then + href.addressmode:=AM_POSTINCREMENT + else + href.addressmode:=AM_UNCHANGED; + + list.concat(taicpu.op_ref_reg(GetStore(href),href,NR_R1)); + end; + end; + OS_S8: + begin + if not(QuickRef) and (tcgsize2size[tosize]>1) then + href.addressmode:=AM_POSTINCREMENT; + list.concat(taicpu.op_ref_reg(GetStore(href),href,reg)); + + if tcgsize2size[tosize]>1 then + begin + tmpreg:=getintregister(list,OS_8); + list.concat(taicpu.op_reg(A_CLR,tmpreg)); + list.concat(taicpu.op_reg_const(A_SBRC,reg,7)); + list.concat(taicpu.op_reg(A_COM,tmpreg)); + for i:=2 to tcgsize2size[tosize] do + begin + if QuickRef then + inc(href.offset); + + if not(QuickRef) and (i<tcgsize2size[fromsize]) then + href.addressmode:=AM_POSTINCREMENT + else + href.addressmode:=AM_UNCHANGED; + list.concat(taicpu.op_ref_reg(GetStore(href),href,tmpreg)); + end; + end; + end; + OS_16: + begin + if not(QuickRef) and (tcgsize2size[tosize]>1) then + href.addressmode:=AM_POSTINCREMENT; + + list.concat(taicpu.op_ref_reg(GetStore(href),href,reg)); + if QuickRef then + inc(href.offset) + else if not(QuickRef) and (tcgsize2size[fromsize]>2) then + href.addressmode:=AM_POSTINCREMENT + else + href.addressmode:=AM_UNCHANGED; + + reg:=GetNextReg(reg); + list.concat(taicpu.op_ref_reg(GetStore(href),href,reg)); + + for i:=3 to tcgsize2size[tosize] do + begin + if QuickRef then + inc(href.offset); + + if not(QuickRef) and (i<tcgsize2size[fromsize]) then + href.addressmode:=AM_POSTINCREMENT + else + href.addressmode:=AM_UNCHANGED; + + list.concat(taicpu.op_ref_reg(GetStore(href),href,NR_R1)); + end; + end; + OS_S16: + begin + if not(QuickRef) and (tcgsize2size[tosize]>1) then + href.addressmode:=AM_POSTINCREMENT; + + list.concat(taicpu.op_ref_reg(GetStore(href),href,reg)); + if QuickRef then + inc(href.offset) + else if not(QuickRef) and (tcgsize2size[fromsize]>2) then + href.addressmode:=AM_POSTINCREMENT + else + href.addressmode:=AM_UNCHANGED; + + reg:=GetNextReg(reg); + list.concat(taicpu.op_ref_reg(GetStore(href),href,reg)); + + if tcgsize2size[tosize]>2 then + begin + tmpreg:=getintregister(list,OS_8); + list.concat(taicpu.op_reg(A_CLR,tmpreg)); + list.concat(taicpu.op_reg_const(A_SBRC,reg,7)); + list.concat(taicpu.op_reg(A_COM,tmpreg)); + for i:=3 to tcgsize2size[tosize] do + begin + if QuickRef then + inc(href.offset); + + if not(QuickRef) and (i<tcgsize2size[fromsize]) then + href.addressmode:=AM_POSTINCREMENT + else + href.addressmode:=AM_UNCHANGED; + list.concat(taicpu.op_ref_reg(GetStore(href),href,tmpreg)); + end; + end; + end; + else + conv_done:=false; + end; + end; + if not conv_done then + begin + for i:=1 to tcgsize2size[fromsize] do + begin + if not(QuickRef) and (i<tcgsize2size[fromsize]) then + href.addressmode:=AM_POSTINCREMENT + else + href.addressmode:=AM_UNCHANGED; + + list.concat(taicpu.op_ref_reg(GetStore(href),href,reg)); + + if QuickRef then + inc(href.offset); + + reg:=GetNextReg(reg); + end; + end; + + if not(QuickRef) then + begin + ungetcpuregister(list,href.base); + ungetcpuregister(list,GetNextReg(href.base)); + end; + end; + + + procedure tcgavr.a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize; + const Ref : treference;reg : tregister); + var + href : treference; + conv_done: boolean; + tmpreg : tregister; + i : integer; + QuickRef : boolean; + begin + QuickRef:=false; + if not((Ref.addressmode=AM_UNCHANGED) and + (Ref.symbol=nil) and + ((Ref.base=NR_R28) or + (Ref.base=NR_R29)) and + (Ref.Index=NR_No) and + (Ref.Offset in [0..64-tcgsize2size[fromsize]])) and + not((Ref.Base=NR_NO) and (Ref.Index=NR_NO)) then + href:=normalize_ref(list,Ref,NR_R30) + else + begin + QuickRef:=true; + href:=Ref; + end; + + if (tcgsize2size[fromsize]>32) or (tcgsize2size[tosize]>32) or (fromsize=OS_NO) or (tosize=OS_NO) then + internalerror(2011021307); + + conv_done:=false; + if tosize<>fromsize then + begin + conv_done:=true; + if tcgsize2size[tosize]<=tcgsize2size[fromsize] then + fromsize:=tosize; + case fromsize of + OS_8: + begin + list.concat(taicpu.op_reg_ref(GetLoad(href),reg,href)); + for i:=2 to tcgsize2size[tosize] do + begin + reg:=GetNextReg(reg); + list.concat(taicpu.op_reg(A_CLR,reg)); + end; + end; + OS_S8: + begin + list.concat(taicpu.op_reg_ref(GetLoad(href),reg,href)); + tmpreg:=reg; + + if tcgsize2size[tosize]>1 then + begin + reg:=GetNextReg(reg); + list.concat(taicpu.op_reg(A_CLR,reg)); + list.concat(taicpu.op_reg_const(A_SBRC,tmpreg,7)); + list.concat(taicpu.op_reg(A_COM,reg)); + tmpreg:=reg; + for i:=3 to tcgsize2size[tosize] do + begin + reg:=GetNextReg(reg); + emit_mov(list,reg,tmpreg); + end; + end; + end; + OS_16: + begin + if not(QuickRef) then + href.addressmode:=AM_POSTINCREMENT; + list.concat(taicpu.op_reg_ref(GetLoad(href),reg,href)); + + if QuickRef then + inc(href.offset); + href.addressmode:=AM_UNCHANGED; + + reg:=GetNextReg(reg); + list.concat(taicpu.op_reg_ref(GetLoad(href),reg,href)); + + for i:=3 to tcgsize2size[tosize] do + begin + reg:=GetNextReg(reg); + list.concat(taicpu.op_reg(A_CLR,reg)); + end; + end; + OS_S16: + begin + if not(QuickRef) then + href.addressmode:=AM_POSTINCREMENT; + list.concat(taicpu.op_reg_ref(GetLoad(href),reg,href)); + if QuickRef then + inc(href.offset); + href.addressmode:=AM_UNCHANGED; + + reg:=GetNextReg(reg); + list.concat(taicpu.op_reg_ref(GetLoad(href),reg,href)); + tmpreg:=reg; + + reg:=GetNextReg(reg); + list.concat(taicpu.op_reg(A_CLR,reg)); + list.concat(taicpu.op_reg_const(A_SBRC,tmpreg,7)); + list.concat(taicpu.op_reg(A_COM,reg)); + tmpreg:=reg; + for i:=4 to tcgsize2size[tosize] do + begin + reg:=GetNextReg(reg); + emit_mov(list,reg,tmpreg); + end; + end; + else + conv_done:=false; + end; + end; + if not conv_done then + begin + for i:=1 to tcgsize2size[fromsize] do + begin + if not(QuickRef) and (i<tcgsize2size[fromsize]) then + href.addressmode:=AM_POSTINCREMENT + else + href.addressmode:=AM_UNCHANGED; + + list.concat(taicpu.op_reg_ref(GetLoad(href),reg,href)); + + if QuickRef then + inc(href.offset); + + reg:=GetNextReg(reg); + end; + end; + + if not(QuickRef) then + begin + ungetcpuregister(list,href.base); + ungetcpuregister(list,GetNextReg(href.base)); + end; + end; + + + procedure tcgavr.a_load_reg_reg(list : TAsmList; fromsize, tosize : tcgsize;reg1,reg2 : tregister); + var + conv_done: boolean; + tmpreg : tregister; + i : integer; + begin + if (tcgsize2size[fromsize]>32) or (tcgsize2size[tosize]>32) or (fromsize=OS_NO) or (tosize=OS_NO) then + internalerror(2011021310); + + conv_done:=false; + if tosize<>fromsize then + begin + conv_done:=true; + if tcgsize2size[tosize]<=tcgsize2size[fromsize] then + fromsize:=tosize; + case fromsize of + OS_8: + begin + emit_mov(list,reg2,reg1); + for i:=2 to tcgsize2size[tosize] do + begin + reg2:=GetNextReg(reg2); + list.concat(taicpu.op_reg(A_CLR,reg2)); + end; + end; + OS_S8: + begin + { dest is always at least 16 bit at this point } + emit_mov(list,reg2,reg1); + + reg2:=GetNextReg(reg2); + list.concat(taicpu.op_reg(A_CLR,reg2)); + list.concat(taicpu.op_reg_const(A_SBRC,reg1,7)); + list.concat(taicpu.op_reg(A_COM,reg2)); + tmpreg:=reg2; + for i:=3 to tcgsize2size[tosize] do + begin + reg2:=GetNextReg(reg2); + emit_mov(list,reg2,tmpreg); + end; + end; + OS_16: + begin + emit_mov(list,reg2,reg1); + + reg1:=GetNextReg(reg1); + reg2:=GetNextReg(reg2); + emit_mov(list,reg2,reg1); + + for i:=3 to tcgsize2size[tosize] do + begin + reg2:=GetNextReg(reg2); + list.concat(taicpu.op_reg(A_CLR,reg2)); + end; + end; + OS_S16: + begin + { dest is always at least 32 bit at this point } + emit_mov(list,reg2,reg1); + + reg1:=GetNextReg(reg1); + reg2:=GetNextReg(reg2); + emit_mov(list,reg2,reg1); + + reg2:=GetNextReg(reg2); + list.concat(taicpu.op_reg(A_CLR,reg2)); + list.concat(taicpu.op_reg_const(A_SBRC,reg1,7)); + list.concat(taicpu.op_reg(A_COM,reg2)); + tmpreg:=reg2; + for i:=4 to tcgsize2size[tosize] do + begin + reg2:=GetNextReg(reg2); + emit_mov(list,reg2,tmpreg); + end; + end; + else + conv_done:=false; + end; + end; + if not conv_done and (reg1<>reg2) then + begin + for i:=1 to tcgsize2size[fromsize] do + begin + emit_mov(list,reg2,reg1); + reg1:=GetNextReg(reg1); + reg2:=GetNextReg(reg2); + end; + end; + end; + + + procedure tcgavr.a_loadfpu_reg_reg(list: TAsmList; fromsize,tosize: tcgsize; reg1, reg2: tregister); + begin + internalerror(2012010702); + end; + + + procedure tcgavr.a_loadfpu_ref_reg(list: TAsmList; fromsize,tosize: tcgsize; const ref: treference; reg: tregister); + begin + internalerror(2012010703); + end; + + + procedure tcgavr.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); + begin + internalerror(2012010704); + end; + + + { comparison operations } + procedure tcgavr.a_cmp_const_reg_label(list : TAsmList;size : tcgsize; + cmp_op : topcmp;a : tcgint;reg : tregister;l : tasmlabel); + var + swapped : boolean; + tmpreg : tregister; + i : byte; + begin + if a=0 then + begin + { swap parameters? } + case cmp_op of + OC_GT: + begin + swapped:=true; + cmp_op:=OC_LT; + end; + OC_LTE: + begin + swapped:=true; + cmp_op:=OC_GTE; + end; + OC_BE: + begin + swapped:=true; + cmp_op:=OC_AE; + end; + OC_A: + begin + swapped:=true; + cmp_op:=OC_A; + end; + end; + + if swapped then + list.concat(taicpu.op_reg_reg(A_CP,reg,NR_R1)) + else + list.concat(taicpu.op_reg_reg(A_CP,NR_R1,reg)); + + for i:=2 to tcgsize2size[size] do + begin + reg:=GetNextReg(reg); + if swapped then + list.concat(taicpu.op_reg_reg(A_CPC,reg,NR_R1)) + else + list.concat(taicpu.op_reg_reg(A_CPC,NR_R1,reg)); + end; + + a_jmp_cond(list,cmp_op,l); + end + else + inherited a_cmp_const_reg_label(list,size,cmp_op,a,reg,l); + end; + + + procedure tcgavr.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize; + cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); + var + swapped : boolean; + tmpreg : tregister; + i : byte; + begin + { swap parameters? } + case cmp_op of + OC_GT: + begin + swapped:=true; + cmp_op:=OC_LT; + end; + OC_LTE: + begin + swapped:=true; + cmp_op:=OC_GTE; + end; + OC_BE: + begin + swapped:=true; + cmp_op:=OC_AE; + end; + OC_A: + begin + swapped:=true; + cmp_op:=OC_A; + end; + end; + if swapped then + begin + tmpreg:=reg1; + reg1:=reg2; + reg2:=tmpreg; + end; + list.concat(taicpu.op_reg_reg(A_CP,reg1,reg2)); + + for i:=2 to tcgsize2size[size] do + begin + reg1:=GetNextReg(reg1); + reg2:=GetNextReg(reg2); + list.concat(taicpu.op_reg_reg(A_CPC,reg1,reg2)); + end; + + a_jmp_cond(list,cmp_op,l); + end; + + + procedure tcgavr.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); + begin + Comment(V_Error,'tcgarm.a_bit_scan_reg_reg method not implemented'); + end; + + + procedure tcgavr.a_jmp_name(list : TAsmList;const s : string); + var + ai : taicpu; + begin + ai:=taicpu.op_sym(A_JMP,current_asmdata.RefAsmSymbol(s)); + ai.is_jmp:=true; + list.concat(ai); + end; + + + procedure tcgavr.a_jmp_always(list : TAsmList;l: tasmlabel); + var + ai : taicpu; + begin + ai:=taicpu.op_sym(A_JMP,l); + ai.is_jmp:=true; + list.concat(ai); + end; + + + procedure tcgavr.a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); + var + ai : taicpu; + begin + ai:=setcondition(taicpu.op_sym(A_BRxx,l),flags_to_cond(f)); + ai.is_jmp:=true; + list.concat(ai); + end; + + + procedure tcgavr.g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); + var + l : TAsmLabel; + tmpflags : TResFlags; + begin + current_asmdata.getjumplabel(l); + { + if flags_to_cond(f) then + begin + tmpflags:=f; + inverse_flags(tmpflags); + list.concat(taicpu.op_reg(A_CLR,reg)); + a_jmp_flags(list,tmpflags,l); + list.concat(taicpu.op_reg_const(A_LDI,reg,1)); + end + else + } + begin + list.concat(taicpu.op_reg_const(A_LDI,reg,1)); + a_jmp_flags(list,f,l); + list.concat(taicpu.op_reg(A_CLR,reg)); + end; + cg.a_label(list,l); + end; + + + procedure tcgavr.a_adjust_sp(list : TAsmList; value : longint); + var + i : integer; + begin + case value of + 0: + ; + -14..-1: + begin + if ((-value) mod 2)<>0 then + list.concat(taicpu.op_reg(A_PUSH,NR_R0)); + for i:=1 to (-value) div 2 do + list.concat(taicpu.op_const(A_RCALL,0)); + end; + 1..7: + begin + for i:=1 to value do + list.concat(taicpu.op_reg(A_POP,NR_R0)); + end; + else + begin + list.concat(taicpu.op_reg_const(A_SUBI,NR_R28,lo(word(-value)))); + list.concat(taicpu.op_reg_const(A_SBCI,NR_R29,hi(word(-value)))); + // get SREG + list.concat(taicpu.op_reg_const(A_IN,NR_R0,NIO_SREG)); + + // block interrupts + list.concat(taicpu.op_none(A_CLI)); + + // write high SP + list.concat(taicpu.op_const_reg(A_OUT,NIO_SP_HI,NR_R29)); + + // release interrupts + list.concat(taicpu.op_const_reg(A_OUT,NIO_SREG,NR_R0)); + + // write low SP + list.concat(taicpu.op_const_reg(A_OUT,NIO_SP_LO,NR_R28)); + end; + end; + end; + + + function tcgavr.GetLoad(const ref: treference) : tasmop; + begin + if (ref.base=NR_NO) and (ref.index=NR_NO) then + result:=A_LDS + else if (ref.base<>NR_NO) and (ref.offset<>0) then + result:=A_LDD + else + result:=A_LD; + end; + + + function tcgavr.GetStore(const ref: treference) : tasmop; + begin + if (ref.base=NR_NO) and (ref.index=NR_NO) then + result:=A_STS + else if (ref.base<>NR_NO) and (ref.offset<>0) then + result:=A_STD + else + result:=A_ST; + end; + + + procedure tcgavr.g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); + var + regs : tcpuregisterset; + reg : tsuperregister; + begin + if not(nostackframe) then + begin + { save int registers } + regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall); + if current_procinfo.framepointer<>NR_STACK_POINTER_REG then + regs:=regs+[RS_R28,RS_R29]; + + for reg:=RS_R31 downto RS_R0 do + if reg in regs then + list.concat(taicpu.op_reg(A_PUSH,newreg(R_INTREGISTER,reg,R_SUBWHOLE))); + + if current_procinfo.framepointer<>NR_STACK_POINTER_REG then + begin + list.concat(taicpu.op_reg_const(A_IN,NR_R28,NIO_SP_LO)); + list.concat(taicpu.op_reg_const(A_IN,NR_R29,NIO_SP_HI)); + end + else + { the framepointer cannot be omitted on avr because sp + is not a register but part of the i/o map + } + internalerror(2011021901); + + a_adjust_sp(list,-localsize); + end; + end; + + + procedure tcgavr.g_proc_exit(list : TAsmList;parasize : longint;nostackframe:boolean); + var + regs : tcpuregisterset; + reg : TSuperRegister; + LocalSize : longint; + begin + if not(nostackframe) then + begin + if current_procinfo.framepointer<>NR_STACK_POINTER_REG then + begin + LocalSize:=current_procinfo.calc_stackframe_size; + a_adjust_sp(list,LocalSize); + regs:=rg[R_INTREGISTER].used_in_proc-paramanager.get_volatile_registers_int(pocall_stdcall); + + for reg:=RS_R0 to RS_R31 do + if reg in regs then + list.concat(taicpu.op_reg(A_POP,newreg(R_INTREGISTER,reg,R_SUBWHOLE))); + + end + else + { the framepointer cannot be omitted on avr because sp + is not a register but part of the i/o map + } + internalerror(2011021902); + end; + list.concat(taicpu.op_none(A_RET)); + end; + + + procedure tcgavr.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister); + var + tmpref : treference; + begin + if ref.addressmode<>AM_UNCHANGED then + internalerror(2011021701); + + if assigned(ref.symbol) or (ref.offset<>0) then + begin + reference_reset(tmpref,0); + tmpref.symbol:=ref.symbol; + tmpref.offset:=ref.offset; + tmpref.refaddr:=addr_lo8; + list.concat(taicpu.op_reg_ref(A_LDI,r,tmpref)); + tmpref.refaddr:=addr_hi8; + list.concat(taicpu.op_reg_ref(A_LDI,GetNextReg(r),tmpref)); + if (ref.base<>NR_NO) then + begin + list.concat(taicpu.op_reg_reg(A_ADD,r,ref.base)); + list.concat(taicpu.op_reg_reg(A_ADC,GetNextReg(r),GetNextReg(ref.base))); + end; + if (ref.index<>NR_NO) then + begin + list.concat(taicpu.op_reg_reg(A_ADD,r,ref.index)); + list.concat(taicpu.op_reg_reg(A_ADC,GetNextReg(r),GetNextReg(ref.index))); + end; + end + else if (ref.base<>NR_NO)then + begin + emit_mov(list,r,ref.base); + emit_mov(list,GetNextReg(r),GetNextReg(ref.base)); + if (ref.index<>NR_NO) then + begin + list.concat(taicpu.op_reg_reg(A_ADD,r,ref.index)); + list.concat(taicpu.op_reg_reg(A_ADC,GetNextReg(r),GetNextReg(ref.index))); + end; + end + else if (ref.index<>NR_NO) then + begin + emit_mov(list,r,ref.index); + emit_mov(list,GetNextReg(r),GetNextReg(ref.index)); + end; + end; + + + procedure tcgavr.fixref(list : TAsmList;var ref : treference); + begin + internalerror(2011021320); + end; + + + procedure tcgavr.g_concatcopy_move(list : TAsmList;const source,dest : treference;len : tcgint); + 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); + a_load_const_cgpara(list,OS_INT,len,paraloc3); + a_loadaddr_ref_cgpara(list,dest,paraloc2); + a_loadaddr_ref_cgpara(list,source,paraloc1); + paramanager.freecgpara(list,paraloc3); + paramanager.freecgpara(list,paraloc2); + paramanager.freecgpara(list,paraloc1); + alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); + a_call_name_static(list,'FPC_MOVE'); + dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); + paraloc3.done; + paraloc2.done; + paraloc1.done; + end; + + + procedure tcgavr.g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint); + var + countreg,tmpreg : tregister; + srcref,dstref : treference; + copysize,countregsize : tcgsize; + l : TAsmLabel; + i : longint; + SrcQuickRef, DestQuickRef : Boolean; + begin + if len>16 then + begin + current_asmdata.getjumplabel(l); + + reference_reset(srcref,0); + reference_reset(dstref,0); + srcref.base:=NR_R30; + srcref.addressmode:=AM_POSTINCREMENT; + dstref.base:=NR_R26; + dstref.addressmode:=AM_POSTINCREMENT; + + copysize:=OS_8; + if len<256 then + countregsize:=OS_8 + else if len<65536 then + countregsize:=OS_16 + else + internalerror(2011022007); + countreg:=getintregister(list,countregsize); + a_load_const_reg(list,countregsize,len,countreg); + a_loadaddr_ref_reg(list,source,NR_R30); + tmpreg:=getaddressregister(list); + a_loadaddr_ref_reg(list,dest,tmpreg); + + { X is used for spilling code so we can load it + only by a push/pop sequence, this can be + optimized later on by the peephole optimizer + } + list.concat(taicpu.op_reg(A_PUSH,tmpreg)); + list.concat(taicpu.op_reg(A_PUSH,GetNextReg(tmpreg))); + list.concat(taicpu.op_reg(A_POP,NR_R27)); + list.concat(taicpu.op_reg(A_POP,NR_R26)); + cg.a_label(list,l); + list.concat(taicpu.op_reg_ref(GetLoad(srcref),NR_R0,srcref)); + list.concat(taicpu.op_ref_reg(GetStore(dstref),dstref,NR_R0)); + a_op_const_reg(list,OP_SUB,countregsize,1,countreg); + a_jmp_flags(list,F_NE,l); + // keep registers alive + list.concat(taicpu.op_reg_reg(A_MOV,countreg,countreg)); + end + else + begin + SrcQuickRef:=false; + DestQuickRef:=false; + if not((source.addressmode=AM_UNCHANGED) and + (source.symbol=nil) and + ((source.base=NR_R28) or + (source.base=NR_R29)) and + (source.Index=NR_NO) and + (source.Offset in [0..64-len])) and + not((source.Base=NR_NO) and (source.Index=NR_NO)) then + srcref:=normalize_ref(list,source,NR_R30) + else + begin + SrcQuickRef:=true; + srcref:=source; + end; + + if not((dest.addressmode=AM_UNCHANGED) and + (dest.symbol=nil) and + ((dest.base=NR_R28) or + (dest.base=NR_R29)) and + (dest.Index=NR_No) and + (dest.Offset in [0..64-len])) and + not((dest.Base=NR_NO) and (dest.Index=NR_NO)) then + begin + if not(SrcQuickRef) then + begin + tmpreg:=getaddressregister(list); + dstref:=normalize_ref(list,dest,tmpreg); + + { X is used for spilling code so we can load it + only by a push/pop sequence, this can be + optimized later on by the peephole optimizer + } + list.concat(taicpu.op_reg(A_PUSH,tmpreg)); + list.concat(taicpu.op_reg(A_PUSH,GetNextReg(tmpreg))); + list.concat(taicpu.op_reg(A_POP,NR_R27)); + list.concat(taicpu.op_reg(A_POP,NR_R26)); + dstref.base:=NR_R26; + end + else + dstref:=normalize_ref(list,dest,NR_R30); + end + else + begin + DestQuickRef:=true; + dstref:=dest; + end; + + for i:=1 to len do + begin + if not(SrcQuickRef) and (i<len) then + srcref.addressmode:=AM_POSTINCREMENT + else + srcref.addressmode:=AM_UNCHANGED; + + if not(DestQuickRef) and (i<len) then + dstref.addressmode:=AM_POSTINCREMENT + else + dstref.addressmode:=AM_UNCHANGED; + + list.concat(taicpu.op_reg_ref(GetLoad(srcref),NR_R0,srcref)); + list.concat(taicpu.op_ref_reg(GetStore(dstref),dstref,NR_R0)); + + if SrcQuickRef then + inc(srcref.offset); + if DestQuickRef then + inc(dstref.offset); + end; + if not(SrcQuickRef) then + begin + ungetcpuregister(list,srcref.base); + ungetcpuregister(list,GetNextReg(srcref.base)); + end; + end; + end; + + + procedure tcgavr.g_overflowCheck(list : TAsmList;const l : tlocation;def : tdef); + var + hl : tasmlabel; + ai : taicpu; + cond : TAsmCond; + begin + if not(cs_check_overflow in current_settings.localswitches) then + exit; + current_asmdata.getjumplabel(hl); + if not ((def.typ=pointerdef) or + ((def.typ=orddef) and + (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar, + pasbool8,pasbool16,pasbool32,pasbool64]))) then + cond:=C_VC + else + cond:=C_CC; + ai:=Taicpu.Op_Sym(A_BRxx,hl); + ai.SetCondition(cond); + ai.is_jmp:=true; + list.concat(ai); + + a_call_name(list,'FPC_OVERFLOW',false); + a_label(list,hl); + end; + + + procedure tcgavr.g_save_registers(list: TAsmList); + begin + { this is done by the entry code } + end; + + + procedure tcgavr.g_restore_registers(list: TAsmList); + begin + { this is done by the exit code } + end; + + + procedure tcgavr.a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel); + var + ai1,ai2 : taicpu; + hl : TAsmLabel; + begin + ai1:=Taicpu.Op_sym(A_BRxx,l); + ai1.is_jmp:=true; + hl:=nil; + case cond of + OC_EQ: + ai1.SetCondition(C_EQ); + OC_GT: + begin + { emulate GT } + current_asmdata.getjumplabel(hl); + ai2:=Taicpu.Op_Sym(A_BRxx,hl); + ai2.SetCondition(C_EQ); + ai2.is_jmp:=true; + list.concat(ai2); + + ai1.SetCondition(C_GE); + end; + OC_LT: + ai1.SetCondition(C_LT); + OC_GTE: + ai1.SetCondition(C_GE); + OC_LTE: + begin + { emulate LTE } + ai2:=Taicpu.Op_Sym(A_BRxx,l); + ai2.SetCondition(C_EQ); + ai2.is_jmp:=true; + list.concat(ai2); + + ai1.SetCondition(C_LT); + end; + OC_NE: + ai1.SetCondition(C_NE); + OC_BE: + begin + { emulate BE } + ai2:=Taicpu.Op_Sym(A_BRxx,l); + ai2.SetCondition(C_EQ); + ai2.is_jmp:=true; + list.concat(ai2); + + ai1.SetCondition(C_LO); + end; + OC_B: + ai1.SetCondition(C_LO); + OC_AE: + ai1.SetCondition(C_SH); + OC_A: + begin + { emulate A (unsigned GT) } + current_asmdata.getjumplabel(hl); + ai2:=Taicpu.Op_Sym(A_BRxx,hl); + ai2.SetCondition(C_EQ); + ai2.is_jmp:=true; + list.concat(ai2); + + ai1.SetCondition(C_SH); + end; + else + internalerror(2011082501); + end; + list.concat(ai1); + if assigned(hl) then + a_label(list,hl); + end; + + + procedure tcgavr.g_stackpointer_alloc(list: TAsmList; size: longint); + begin + internalerror(201201071); + end; + + + procedure tcgavr.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); + begin + internalerror(2011021324); + end; + + + procedure tcgavr.emit_mov(list: TAsmList;reg2: tregister; reg1: tregister); + var + instr: taicpu; + begin + 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; + + + procedure tcg64favr.a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64); + begin + { TODO : a_op64_reg_reg } + end; + + + procedure tcg64favr.a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;reg : tregister64); + begin + { TODO : a_op64_const_reg } + end; + + + procedure create_codegen; + begin + cg:=tcgavr.create; + cg64:=tcg64favr.create; + end; + +end. diff --git a/closures/compiler/avr/cpubase.pas b/closures/compiler/avr/cpubase.pas new file mode 100644 index 0000000000..6e04d858ce --- /dev/null +++ b/closures/compiler/avr/cpubase.pas @@ -0,0 +1,474 @@ +{ + Copyright (c) 2006 by Florian Klaempfl + + Contains the base types for the AVR + + 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=(A_None, + A_ADD,A_ADC,A_ADIW,A_SUB,A_SUBI,A_SBC,A_SBCI,A_SBRC,A_SBRS,A_CLC,A_SEC,A_SBIW,A_AND,A_ANDI, + A_OR,A_ORI,A_EOR,A_COM,A_NEG,A_SBR,A_CBR,A_INC,A_DEC,A_TST,A_CLR, + A_SER,A_MUL,A_MULS,A_FMUL,A_FMULS,A_FMULSU,A_RJMP,A_IJMP, + A_EIJMP,A_JMP,A_RCALL,A_ICALL,R_EICALL,A_CALL,A_RET,A_RETI,A_CPSE, + A_CP,A_CPC,A_CPI,A_SBIC,A_SBIS,A_BRxx,A_MOV,A_MOVW,A_LDI,A_LDS,A_LD,A_LDD, + A_STS,A_ST,A_STD,A_LPM,A_ELPM,A_SPM,A_IN,A_OUT,A_PUSH,A_POP, + A_LSL,A_LSR,A_ROL,A_ROR,A_ASR,A_SWAP,A_BSET,A_BCLR,A_SBI,A_CBI, + A_BST,A_BLD,A_Sxx,A_CLI,A_BRAK,A_NOP,A_SLEEP,A_WDR); + + + { 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); + + jmp_instructions = [A_BRxx,A_SBIC,A_SBIS,A_JMP,A_RCALL,A_ICALL,A_EIJMP, + A_RJMP,A_CALL,A_RET,A_RETI,A_CPSE,A_IJMP]; + +{***************************************************************************** + Registers +*****************************************************************************} + + type + { Number of registers used for indexing in tables } + tregisterindex=0..{$i ravrnor.inc}-1; + + const + { Available Superregisters } + {$i ravrsup.inc} + + { No Subregisters } + R_SUBWHOLE = R_SUBNONE; + + { Available Registers } + {$i ravrcon.inc} + + NR_XLO = NR_R26; + NR_XHI = NR_R27; + NR_YLO = NR_R28; + NR_YHI = NR_R29; + NR_ZLO = NR_R30; + NR_ZHI = NR_R31; + + NIO_SREG = $3f; + NIO_SP_LO = $3d; + NIO_SP_HI = $3e; + + { Integer Super registers first and last } + first_int_supreg = RS_R0; + first_int_imreg = $20; + + { Float Super register first and last } + first_fpu_supreg = RS_INVALID; + first_fpu_imreg = RS_INVALID; + + { MM Super register first and last } + first_mm_supreg = RS_INVALID; + first_mm_imreg = RS_INVALID; + + regnumber_count_bsstart = 32; + + regnumber_table : array[tregisterindex] of tregister = ( + {$i ravrnum.inc} + ); + + regstabs_table : array[tregisterindex] of shortint = ( + {$i ravrsta.inc} + ); + + regdwarf_table : array[tregisterindex] of shortint = ( + {$i ravrdwa.inc} + ); + { registers which may be destroyed by calls } + VOLATILE_INTREGISTERS = [RS_R0,RS_R1,RS_R8..RS_R27,RS_R30,RS_R31]; + VOLATILE_FPUREGISTERS = []; + + type + totherregisterset = set of tregisterindex; + +{***************************************************************************** + Conditions +*****************************************************************************} + + type + TAsmCond=(C_None, + C_CC,C_CS,C_EQ,C_GE,C_HC,C_HS,C_ID,C_IE,C_LO,C_LT, + C_MI,C_NE,C_PL,C_SH,C_TC,C_TS,C_VC,C_VS + ); + + const + cond2str : array[TAsmCond] of string[2]=('', + 'cc','cs','eq','ge','hc','hs','id','ie','lo','lt', + 'mi','ne','pl','sh','tc','ts','vc','vs' + ); + + uppercond2str : array[TAsmCond] of string[2]=('', + 'CC','CS','EQ','GE','HC','HS','ID','IE','LO','LT', + 'MI','NE','PL','SH','TC','TS','VC','VS' + ); + +{***************************************************************************** + Flags +*****************************************************************************} + + type + TResFlags = (F_NotPossible,F_CC,F_CS,F_EQ,F_GE,F_LO,F_LT, + F_NE,F_SH,F_VC,F_VS); + +{***************************************************************************** + Operands +*****************************************************************************} + + taddressmode = (AM_UNCHANGED,AM_POSTINCREMENT,AM_PREDRECEMENT); + +{***************************************************************************** + Constants +*****************************************************************************} + + const + max_operands = 4; + + maxintregs = 15; + maxfpuregs = 0; + maxaddrregs = 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_INVALID; + lastsavefpureg = RS_INVALID; + firstsavemmreg = RS_INVALID; + lastsavemmreg = RS_INVALID; + + maxvarregs = 7; + varregs : Array [1..maxvarregs] of tsuperregister = + (RS_R4,RS_R5,RS_R6,RS_R7,RS_R8,RS_R9,RS_R10); + + maxfpuvarregs = 1; + fpuvarregs : Array [1..maxfpuvarregs] of tsuperregister = + (RS_INVALID); + +{***************************************************************************** + Default generic sizes +*****************************************************************************} + + { Defines the default address size for a processor, } + OS_ADDR = OS_16; + { the natural int size for a processor, } + OS_INT = OS_16; + OS_SINT = OS_S16; + { 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_R28; + NR_FRAME_POINTER_REG = NR_R28; + { 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_NO; + + 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. + } + { on avr, gen_entry/gen_exit code saves/restores registers, so + we don't need this array } + saved_standard_registers : array[0..0] of tsuperregister = + (RS_INVALID); + { 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; + + saved_mm_registers : array[0..0] of tsuperregister = (RS_INVALID); + +{***************************************************************************** + Helpers +*****************************************************************************} + + { Returns the tcgsize corresponding with the size of reg.} + function reg_cgsize(const reg: tregister) : tcgsize; + function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister; + 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} + + function dwarf_reg(r:tregister):byte; + function GetHigh(const r : TRegister) : TRegister; + + { returns the next virtual register } + function GetNextReg(const r : TRegister) : TRegister; + + { returns the last virtual register } + function GetLastReg(const r : TRegister) : TRegister; + + function GetOffsetReg(const r : TRegister;ofs : shortint) : TRegister; + + function ReplaceForbiddenChars(const s: string): string; + + implementation + + uses + rgBase,verbose; + + + const + std_regname_table : array[tregisterindex] of string[7] = ( + {$i ravrstd.inc} + ); + + regnumber_index : array[tregisterindex] of tregisterindex = ( + {$i ravrrni.inc} + ); + + std_regname_index : array[tregisterindex] of tregisterindex = ( + {$i ravrsri.inc} + ); + + + function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister; + begin + cgsize2subreg:=R_SUBWHOLE; + end; + + + function reg_cgsize(const reg: tregister): tcgsize; + begin + case getregtype(reg) of + R_INTREGISTER : + reg_cgsize:=OS_8; + R_ADDRESSREGISTER : + reg_cgsize:=OS_16; + else + internalerror(2011021905); + end; + end; + + + procedure inverse_flags(var f: TResFlags); + const + inv_flags: array[TResFlags] of TResFlags = + (F_NotPossible,F_CS,F_CC,F_NE,F_LT,F_SH,F_GE, + F_NE,F_LO,F_VS,F_VC); + begin + f:=inv_flags[f]; + end; + + + function flags_to_cond(const f: TResFlags) : TAsmCond; + const + flag_2_cond: array[F_CC..F_VS] of TAsmCond = + (C_CC,C_CS,C_EQ,C_GE,C_LO,C_LT, + C_NE,C_SH,C_VC,C_VS); + begin + if f=F_NotPossible then + internalerror(2011022101); + if f>high(flag_2_cond) then + internalerror(200112301); + result:=flag_2_cond[f]; + 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; + + + function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE} + const + inverse: array[TAsmCond] of TAsmCond=(C_None, + C_CS,C_CC,C_NE,C_LT,C_HS,C_HC,C_IE,C_ID,C_SH,C_GE, + C_PL,C_EQ,C_MI,C_LO,C_TS,C_TC,C_VS,C_VC); + begin + result := inverse[c]; + end; + + + 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 dwarf_reg(r:tregister):byte; + var + reg : shortint; + begin + reg:=regdwarf_table[findreg_by_number(r)]; + if reg=-1 then + internalerror(200603251); + result:=reg; + end; + + + function GetHigh(const r : TRegister) : TRegister; + begin + result:=TRegister(longint(r)+1) + end; + + + function GetNextReg(const r: TRegister): TRegister; + begin + result:=TRegister(longint(r)+1); + end; + + + function GetLastReg(const r: TRegister): TRegister; + begin + result:=TRegister(longint(r)-1); + end; + + + function GetOffsetReg(const r: TRegister;ofs : shortint): TRegister; + begin + result:=TRegister(longint(r)+ofs); + end; + + + function ReplaceForbiddenChars(const s: string): string; + var + i : longint; + begin + Result:=s; + for i:=1 to Length(Result) do + if Result[i]='$' then + Result[i]:='s'; + end; + +end. diff --git a/closures/compiler/avr/cpuinfo.pas b/closures/compiler/avr/cpuinfo.pas new file mode 100644 index 0000000000..70c4e70886 --- /dev/null +++ b/closures/compiler/avr/cpuinfo.pas @@ -0,0 +1,226 @@ +{ + Copyright (c) 2008 by the Free Pascal development team + + Basic Processor information for the AVR + + 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 } + tcputype = + (cpu_none, + cpu_avr1, + cpu_avr2, + cpu_avr25, + cpu_avr3, + cpu_avr31, + cpu_avr35, + cpu_avr4, + cpu_avr5, + cpu_avr51, + cpu_avr6 + ); + + tcpuflags = + (AVR_HAS_JMP_CALL, + AVR_HAS_MOVW, + AVR_HAS_LPMX, + AVR_HAS_MUL, + AVR_HAS_RAMPZ, + AVR_HAS_ELPM, + AVR_HAS_ELPMX, + AVR_2_BYTE_PC, + AVR_3_BYTE_PC + ); + + tfputype = + (fpu_none, + fpu_soft, + fp_libgcc + ); + + tcontrollertype = + (ct_none, + + ct_atmega16, + ct_atmega32, + ct_atmega48, + ct_atmega64, + ct_atmega128 + ); + +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 = 'avr'; + + { calling conventions supported by the code generator } + supported_calling_conventions : tproccalloptions = [ + pocall_internproc, + pocall_safecall, + 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 + ]; + + cputypestr : array[tcputype] of string[5] = ('', + 'AVR1', + 'AVR2', + 'AVR25', + 'AVR3', + 'AVR31', + 'AVR35', + 'AVR4', + 'AVR5', + 'AVR51', + 'AVR6' + ); + + fputypestr : array[tfputype] of string[6] = ( + 'NONE', + 'SOFT', + 'LIBGCC' + ); + + embedded_controllers : array [tcontrollertype] of tcontrollerdatatype = + (( + controllertypestr:''; + controllerunitstr:''; + interruptvectors:0; + flashbase:0; + flashsize:0; + srambase:0; + sramsize:0; + eeprombase:0; + eepromsize:0 + ), + ( + controllertypestr:'ATMEGA16'; + controllerunitstr:'ATMEGA16'; + interruptvectors:0; + flashbase:0; + flashsize:$4000; + srambase:0; + sramsize:1024; + eeprombase:0; + eepromsize:512 + ), + ( + controllertypestr:'ATMEGA32'; + controllerunitstr:'ATMEGA32'; + interruptvectors:0; + flashbase:0; + flashsize:$8000; + srambase:0; + sramsize:1024; + eeprombase:0; + eepromsize:512 + ), + ( + controllertypestr:'ATMEGA48'; + controllerunitstr:'ATMEGA48'; + interruptvectors:0; + flashbase:0; + flashsize:$1000; + srambase:0; + sramsize:512; + eeprombase:0; + eepromsize:256; + ), + ( + controllertypestr:'ATMEGA64'; + controllerunitstr:'ATMEGA64'; + interruptvectors:0; + flashbase:0; + flashsize:$10000; + srambase:0; + sramsize:4096; + eeprombase:0; + eepromsize:2048; + ), + ( + controllertypestr:'ATMEGA128'; + controllerunitstr:'ATMEGA128'; + interruptvectors:0; + flashbase:0; + flashsize:$20000; + srambase:0; + sramsize:4096; + eeprombase:0; + eepromsize:4096; + ) + ); + + { Supported optimizations, only used for information } + supported_optimizerswitches = genericlevel1optimizerswitches+ + genericlevel2optimizerswitches+ + genericlevel3optimizerswitches- + { no need to write info about those } + [cs_opt_level1,cs_opt_level2,cs_opt_level3]+ + [cs_opt_regvar,cs_opt_loopunroll,cs_opt_tailrecursion, + cs_opt_stackframe,cs_opt_nodecse]; + cpuflagsstr : array[tcpuflags] of string[20] = + ('AVR_HAS_JMP_CALL', + 'AVR_HAS_MOVW', + 'AVR_HAS_LPMX', + 'AVR_HAS_MUL', + 'AVR_HAS_RAMPZ', + 'AVR_HAS_ELPM', + 'AVR_HAS_ELPMX', + 'AVR_2_BYTE_PC', + 'AVR_3_BYTE_PC' + ); + + + level1optimizerswitches = genericlevel1optimizerswitches; + level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + + [cs_opt_regvar,cs_opt_stackframe,cs_opt_tailrecursion]; + level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches + [{,cs_opt_loopunroll}]; + + cpu_capabilities : array[tcputype] of set of tcpuflags = + ( { cpu_none } [], + { cpu_avr1 } [], + { cpu_avr2 } [], + { cpu_avr25 } [], + { cpu_avr3 } [], + { cpu_avr31 } [], + { cpu_avr35 } [], + { cpu_avr4 } [], + { cpu_avr5 } [], + { cpu_avr51 } [], + { cpu_avr6 } [] + ); + +Implementation + +end. diff --git a/closures/compiler/avr/cpunode.pas b/closures/compiler/avr/cpunode.pas new file mode 100644 index 0000000000..64090a192b --- /dev/null +++ b/closures/compiler/avr/cpunode.pas @@ -0,0 +1,43 @@ +{ + Copyright (c) 2000-2008 by Florian Klaempfl + + This unit includes the AVR 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,ncgadd + { to be able to only parts of the generic code, + the processor specific nodes must be included + after the generic one (FK) + } + ,navradd + ,navrmat + ,navrcnv + ; + + +end. diff --git a/closures/compiler/avr/cpupara.pas b/closures/compiler/avr/cpupara.pas new file mode 100644 index 0000000000..d313d24896 --- /dev/null +++ b/closures/compiler/avr/cpupara.pas @@ -0,0 +1,527 @@ +{ + Copyright (c) 2008 by Florian Klaempfl + + AVR specific calling conventions, it follows the GCC AVR 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,aasmdata, + cpuinfo,cpubase,cgbase,cgutils, + symconst,symbase,symtype,symdef,parabase,paramgr; + + type + tavrparamanager = 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; + function ret_in_param(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; + function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;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; + procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); + end; + + implementation + + uses + verbose,systems, + rgobj, + defutil,symsym; + + + function tavrparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset; + begin + result:=VOLATILE_INTREGISTERS; + end; + + + function tavrparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset; + begin + result:=VOLATILE_FPUREGISTERS; + end; + + + procedure tavrparamanager.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<=9 then + begin + loc:=LOC_REGISTER; + register:=newreg(R_INTREGISTER,RS_R25-(nr-1)*2,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-10)*2; + 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.typ of + orddef: + getparaloc:=LOC_REGISTER; + floatdef: + getparaloc:=LOC_REGISTER; + enumdef: + getparaloc:=LOC_REGISTER; + pointerdef: + getparaloc:=LOC_REGISTER; + formaldef: + getparaloc:=LOC_REGISTER; + classrefdef: + getparaloc:=LOC_REGISTER; + recorddef: + getparaloc:=LOC_REGISTER; + objectdef: + getparaloc:=LOC_REGISTER; + stringdef: + if is_shortstring(p) or is_longstring(p) then + getparaloc:=LOC_REFERENCE + else + getparaloc:=LOC_REGISTER; + procvardef: + 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_REGISTER; + { avoid problems with errornous definitions } + errordef: + getparaloc:=LOC_REGISTER; + else + internalerror(2002071001); + end; + end; + + + function tavrparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; + begin + result:=false; + if varspez in [vs_var,vs_out,vs_constref] then + begin + result:=true; + exit; + end; + case def.typ of + objectdef: + result:=is_object(def) and ((varspez=vs_const) or (def.size=0)); + recorddef: + result:=(varspez=vs_const) or (def.size=0); + variantdef, + formaldef: + 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); + setdef : + result:=not is_smallset(def); + stringdef : + result:=tstringdef(def).stringtype in [st_shortstring,st_longstring]; + end; + end; + + + function tavrparamanager.ret_in_param(def : tdef;calloption : tproccalloption) : boolean; + begin + case def.typ of + recorddef: + { this is how gcc 4.0.4 on linux seems to do it, it doesn't look like being + ARM ABI standard compliant + } + result:=not((trecorddef(def).symtable.SymList.count=1) and + not(ret_in_param(tabstractvarsym(trecorddef(def).symtable.SymList[0]).vardef,calloption))); + { + objectdef + arraydef: + result:=not(def.size in [1,2,4]); + } + else + result:=inherited ret_in_param(def,calloption); + end; + end; + + + procedure tavrparamanager.init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword); + begin + curintreg:=RS_R25; + curfloatreg:=RS_INVALID; + curmmreg:=RS_INVALID; + cur_stack_offset:=0; + end; + + + { TODO : fix tavrparamanager.create_paraloc_info_intern } + function tavrparamanager.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 + { In case of po_delphi_nested_cc, the parent frame pointer + is always passed on the stack. } + if (nextintreg>RS_R8) and + (not(vo_is_parentfp in hp.varoptions) or + not(po_delphi_nested_cc in p.procoptions)) 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; + dec(stack_offset,2); + 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]); + paradef:=hp.vardef; + + hp.paraloc[side].reset; + + { 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(paradef) 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_R25; + paraloc^.size:=OS_ADDR; + break; + end; + + if (hp.varspez in [vs_var,vs_out]) or + push_addr_param(hp.varspez,paradef,p.proccalloption) or + is_open_array(paradef) or + is_array_of_const(paradef) then + begin + paradef:=voidpointertype; + loc:=LOC_REGISTER; + paracgsize := OS_ADDR; + paralen := tcgsize2size[OS_ADDR]; + end + else + begin + if not is_special_array(paradef) then + paralen := paradef.size + else + paralen := tcgsize2size[def_cgsize(paradef)]; + loc := getparaloc(p.proccalloption,paradef); + if (paradef.typ in [objectdef,arraydef,recorddef]) and + not is_special_array(paradef) and + (hp.varspez in [vs_value,vs_const]) then + paracgsize := int_cgsize(paralen) + else + begin + paracgsize:=def_cgsize(paradef); + { for things like formaldef } + if (paracgsize=OS_NO) then + begin + paracgsize:=OS_ADDR; + paralen := tcgsize2size[OS_ADDR]; + end; + end + end; + + hp.paraloc[side].size:=paracgsize; + hp.paraloc[side].Alignment:=std_param_align; + 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; + + 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_32; + else + internalerror(2005082901); + end + else if (paracgsize in [OS_NO,OS_64,OS_S64]) then + paraloc^.size := OS_32 + else + paraloc^.size:=paracgsize; + case loc of + LOC_REGISTER: + begin + { this is not abi compliant + why? (FK) } + if nextintreg>=RS_R8 then + begin + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBWHOLE); + dec(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_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.vardef.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,2); + end; + end; + dec(paralen,tcgsize2size[paraloc^.size]); + end; + end; + curintreg:=nextintreg; + curfloatreg:=nextfloatreg; + curmmreg:=nextmmreg; + cur_stack_offset:=stack_offset; + result:=cur_stack_offset; + end; + + + function tavrparamanager.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); + + create_funcretloc_info(p,side); + end; + + + procedure tavrparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); + begin + p.funcretloc[side]:=get_funcretloc(p,side,p.returndef); + end; + + + { TODO : fix tavrparamanager.get_funcretloc } + function tavrparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara; + var + retcgsize : tcgsize; + paraloc : pcgparalocation; + begin + result.init; + result.alignment:=get_para_align(p.proccalloption); + { void has no location } + if is_void(def) then + begin + paraloc:=result.add_location; + result.size:=OS_NO; + result.intsize:=0; + paraloc^.size:=OS_NO; + paraloc^.loc:=LOC_VOID; + exit; + end; + { Constructors return self instead of a boolean } + if (p.proctypeoption=potype_constructor) then + begin + retcgsize:=OS_ADDR; + result.intsize:=sizeof(pint); + end + else + begin + retcgsize:=def_cgsize(def); + result.intsize:=def.size; + end; + result.size:=retcgsize; + { Return is passed as var parameter } + if ret_in_param(def,p.proccalloption) then + begin + paraloc:=result.add_location; + paraloc^.loc:=LOC_REFERENCE; + paraloc^.size:=retcgsize; + exit; + end; + + paraloc:=result.add_location; + { Return in FPU register? } + if def.typ=floatdef then + begin + if (p.proccalloption in [pocall_softfloat]) or (cs_fp_emulation in current_settings.moduleswitches) then + begin + case retcgsize of + OS_64, + OS_F64: + begin + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG; + paraloc^.size:=OS_32; + paraloc:=result.add_location; + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG; + paraloc^.size:=OS_32; + end; + OS_32, + OS_F32: + begin + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=NR_FUNCTION_RETURN_REG; + paraloc^.size:=OS_32; + end; + else + internalerror(2005082603); + end; + end + else + begin + paraloc^.loc:=LOC_FPUREGISTER; + paraloc^.register:=NR_FPU_RESULT_REG; + paraloc^.size:=retcgsize; + end; + end + { Return in register } + else + begin + if retcgsize in [OS_64,OS_S64] then + begin + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG; + paraloc^.size:=OS_32; + paraloc:=result.add_location; + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG; + paraloc^.size:=OS_32; + end + else + begin + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=NR_FUNCTION_RETURN_REG; + paraloc^.size:=OS_32; + end; + end; + end; + + + function tavrparamanager.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:=tavrparamanager.create; +end. diff --git a/closures/compiler/avr/cpupi.pas b/closures/compiler/avr/cpupi.pas new file mode 100644 index 0000000000..676fb27541 --- /dev/null +++ b/closures/compiler/avr/cpupi.pas @@ -0,0 +1,73 @@ +{ + Copyright (c) 2008 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 + tavrprocinfo = class(tcgprocinfo) + // procedure handle_body_start;override; + // procedure after_pass1;override; + procedure set_first_temp_offset;override; + function calc_stackframe_size:longint;override; + end; + + + implementation + + uses + globals,systems, + cpubase, + aasmtai,aasmdata, + tgobj, + symconst,symsym,paramgr, + cgbase, + cgobj; + + procedure tavrprocinfo.set_first_temp_offset; + begin + if tg.direction = -1 then + tg.setfirsttemp(0) + else + tg.setfirsttemp(maxpushedparasize); + end; + + + function tavrprocinfo.calc_stackframe_size:longint; + begin + maxpushedparasize:=align(maxpushedparasize,max(current_settings.alignment.localalignmin,4)); + result:=0; + end; + + +begin + cprocinfo:=tavrprocinfo; +end. + diff --git a/closures/compiler/avr/cputarg.pas b/closures/compiler/avr/cputarg.pas new file mode 100644 index 0000000000..db2b0e6726 --- /dev/null +++ b/closures/compiler/avr/cputarg.pas @@ -0,0 +1,70 @@ +{ + Copyright (c) 2001-2008 by Peter Vreman + + Includes the AVR 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 NOTARGETEMBEDDED} + ,t_embed + {$endif} + +{************************************** + Assemblers +**************************************} + + {$ifndef NOAGARMGAS} + ,agavrgas + {$endif} + +{************************************** + Assembler Readers +**************************************} + + {$ifndef NoRaarmgas} + ,raavrgas + {$endif NoRaarmgas} + +{************************************** + Debuginfo +**************************************} + + {$ifndef NoDbgStabs} + ,dbgstabs + {$endif NoDbgStabs} + {$ifndef NoDbgDwarf} + ,dbgdwarf + {$endif NoDbgDwarf} + ; + +end. diff --git a/closures/compiler/avr/itcpugas.pas b/closures/compiler/avr/itcpugas.pas new file mode 100644 index 0000000000..6af73515c7 --- /dev/null +++ b/closures/compiler/avr/itcpugas.pas @@ -0,0 +1,101 @@ +{ + Copyright (c) 2008 by Florian Klaempfl + + This unit contains the AVR 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 = ('', + 'add','adc','adiw','sub','subi','sbc','sbci','sbrc','sbrs','clc','sec','sbiw','and','andi', + 'or','ori','eor','com','neg','sbr','cbr','inc','dec','tst','clr', + 'ser','mul','muls','fmul','fmuls','fmulsu','rjmp','ijmp', + 'eijmp','jmp','rcall','icall','eicall','call','ret','reti','cpse', + 'cp','cpc','cpi','sbic','sbis','br','mov','movw','ldi','lds','ld','ldd', + 'sts','st','std','lpm','elpm','spm','in','out','push','pop', + 'lsl','lsr','rol','ror','asr','swap','bset','bclr','sbi','cbi', + 'bst','bld','s','cli','brak','nop','sleep','wdr'); + + 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 ravrstd.inc} + ); + + gas_regname_index : array[tregisterindex] of tregisterindex = ( + {$i ravrsri.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. diff --git a/closures/compiler/avr/navradd.pas b/closures/compiler/avr/navradd.pas new file mode 100644 index 0000000000..aefa78955b --- /dev/null +++ b/closures/compiler/avr/navradd.pas @@ -0,0 +1,251 @@ +{ + Copyright (c) 2008 by Florian Klaempfl + + Code generation for add nodes on the AVR + + 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 navradd; + +{$i fpcdefs.inc} + +interface + + uses + node,ncgadd,cpubase; + + type + tavraddnode = class(tcgaddnode) + private + function GetResFlags(unsigned:Boolean):TResFlags; + protected + function pass_1 : tnode;override; + procedure second_cmpordinal;override; + procedure second_cmpsmallset;override; + procedure second_cmp64bit;override; + procedure second_cmp; + end; + + implementation + + uses + globtype,systems, + cutils,verbose,globals, + symconst,symdef,paramgr, + aasmbase,aasmtai,aasmdata,aasmcpu,defutil,htypechk, + cgbase,cgutils,cgcpu, + cpuinfo,pass_1,pass_2,regvars,procinfo, + cpupara, + ncon,nset,nadd, + ncgutil,tgobj,rgobj,rgcpu,cgobj,cg64f32; + +{***************************************************************************** + TSparcAddNode +*****************************************************************************} + + function tavraddnode.GetResFlags(unsigned:Boolean):TResFlags; + begin + case NodeType of + equaln: + GetResFlags:=F_EQ; + unequaln: + GetResFlags:=F_NE; + else + if not(unsigned) then + begin + if nf_swapped in flags then + case NodeType of + ltn: + GetResFlags:=F_NotPossible; + lten: + GetResFlags:=F_GE; + gtn: + GetResFlags:=F_LT; + gten: + GetResFlags:=F_NotPossible; + end + else + case NodeType of + ltn: + GetResFlags:=F_LT; + lten: + GetResFlags:=F_NotPossible; + gtn: + GetResFlags:=F_NotPossible; + gten: + GetResFlags:=F_GE; + end; + end + else + begin + if nf_swapped in Flags then + case NodeType of + ltn: + GetResFlags:=F_NotPossible; + lten: + GetResFlags:=F_CS; + gtn: + GetResFlags:=F_CC; + gten: + GetResFlags:=F_NotPossible; + end + else + case NodeType of + ltn: + GetResFlags:=F_CC; + lten: + GetResFlags:=F_NotPossible; + gtn: + GetResFlags:=F_NotPossible; + gten: + GetResFlags:=F_CS; + end; + end; + end; + end; + + + procedure tavraddnode.second_cmpsmallset; + + procedure gencmp(tmpreg1,tmpreg2 : tregister); + var + i : byte; + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CP,tmpreg1,tmpreg2)); + for i:=2 to tcgsize2size[left.location.size] do + begin + tmpreg1:=GetNextReg(tmpreg1); + tmpreg2:=GetNextReg(tmpreg2); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CPC,tmpreg1,tmpreg2)); + end; + end; + + 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 + gencmp(left.location.register,right.location.register); + location.resflags:=F_EQ; + end; + unequaln: + begin + gencmp(left.location.register,right.location.register); + location.resflags:=F_NE; + end; + lten, + gten: + begin + if (not(nf_swapped in flags) and + (nodetype = lten)) or + ((nf_swapped in flags) and + (nodetype = gten)) then + swapleftright; + tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,location.size); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_AND,location.size, + left.location.register,right.location.register,tmpreg); + gencmp(tmpreg,right.location.register); + location.resflags:=F_EQ; + end; + else + internalerror(2004012401); + end; + end; + + + procedure tavraddnode.second_cmp; + var + unsigned : boolean; + tmpreg1,tmpreg2 : tregister; + i : longint; + begin + pass_left_right; + force_reg_left_right(true,false); + + unsigned:=not(is_signed(left.resultdef)) or + not(is_signed(right.resultdef)); + + if getresflags(unsigned)=F_NotPossible then + swapleftright; + + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CP,left.location.register,right.location.register)); + tmpreg1:=left.location.register; + tmpreg2:=right.location.register; + + for i:=2 to tcgsize2size[left.location.size] do + begin + tmpreg1:=GetNextReg(tmpreg1); + tmpreg2:=GetNextReg(tmpreg2); + if i=5 then + begin + tmpreg1:=left.location.registerhi; + tmpreg2:=right.location.registerhi; + end; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CPC,tmpreg1,tmpreg2)); + end; + + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=getresflags(unsigned); + end; + + + procedure tavraddnode.second_cmp64bit; + begin + second_cmp; + end; + + + function tavraddnode.pass_1 : tnode; + begin + result:=inherited pass_1; +{ + if not(assigned(result)) then + begin + unsigned:=not(is_signed(left.resultdef)) or + not(is_signed(right.resultdef)); + + if is_64bit(left.resultdef) and + ((nodetype in [equaln,unequaln]) or + (unsigned and (nodetype in [ltn,lten,gtn,gten])) + ) then + expectloc:=LOC_FLAGS; + end; + { handling boolean expressions } + if not(assigned(result)) and + ( + not(is_boolean(left.resultdef)) or + not(is_boolean(right.resultdef)) or + is_dynamic_array(left.resultdef) + ) then + expectloc:=LOC_FLAGS; +} + end; + + + procedure tavraddnode.second_cmpordinal; + begin + second_cmp; + end; + +begin + caddnode:=tavraddnode; +end. diff --git a/closures/compiler/avr/navrcnv.pas b/closures/compiler/avr/navrcnv.pas new file mode 100644 index 0000000000..4afaf6bc95 --- /dev/null +++ b/closures/compiler/avr/navrcnv.pas @@ -0,0 +1,59 @@ +{ + Copyright (c) 1998-2009 by Florian Klaempfl + + Generate AVR 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 navrcnv; + +{$i fpcdefs.inc} + +interface + + uses + node,ncnv,ncgcnv,defcmp; + + type + tarmtypeconvnode = class(tcgtypeconvnode) + protected + { 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; } + { 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 + +begin + ctypeconvnode:=tarmtypeconvnode; +end. diff --git a/closures/compiler/avr/navrmat.pas b/closures/compiler/avr/navrmat.pas new file mode 100644 index 0000000000..d4482a62e4 --- /dev/null +++ b/closures/compiler/avr/navrmat.pas @@ -0,0 +1,265 @@ +{ + Copyright (c) 1998-2008 by Florian Klaempfl + + Generates AVR 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 navrmat; + +{$i fpcdefs.inc} + +interface + + uses + node,nmat,ncgmat; + + type + tavrmoddivnode = class(tmoddivnode) + function first_moddivint: tnode;override; + procedure pass_generate_code;override; + end; + + tavrnotnode = class(tcgnotnode) + procedure second_boolean;override; + end; + +implementation + + uses + globtype,systems, + cutils,verbose,globals,constexp, + aasmbase,aasmcpu,aasmtai,aasmdata, + defutil, + cgbase,cgobj,cgutils, + pass_2,procinfo, + ncon, + cpubase, + ncgutil,cgcpu; + +{***************************************************************************** + TAVRMODDIVNODE +*****************************************************************************} + + function tavrmoddivnode.first_moddivint: tnode; + var + power : longint; + begin + if (right.nodetype=ordconstn) and + (nodetype=divn) and + (ispowerof2(tordconstnode(right).value,power) or + (tordconstnode(right).value=1) or + (tordconstnode(right).value=int64(-1)) + ) and + not(is_64bitint(resultdef)) then + result:=nil + else + result:=inherited first_moddivint; + end; + + + procedure tavrmoddivnode.pass_generate_code; + var + power : longint; + numerator, + helper1, + helper2, + resultreg : tregister; + size : Tcgsize; + procedure genOrdConstNodeDiv; + begin +{ + if tordconstnode(right).value=0 then + internalerror(2005061701) + else if tordconstnode(right).value=1 then + cg.a_load_reg_reg(current_asmdata.CurrAsmList, OS_INT, OS_INT, numerator, resultreg) + else if (tordconstnode(right).value = int64(-1)) then + begin + // note: only in the signed case possible..., may overflow + current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_MVN, + resultreg,numerator),toppostfix(ord(cs_check_overflow in current_settings.localswitches)*ord(PF_S)))); + end + else if ispowerof2(tordconstnode(right).value,power) then + begin + if (is_signed(right.resultdef)) then + begin + helper1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + helper2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + shifterop_reset(so); + so.shiftmode:=SM_ASR; + so.shiftimm:=31; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_shifterop(A_MOV,helper1,numerator,so)); + shifterop_reset(so); + so.shiftmode:=SM_LSR; + so.shiftimm:=32-power; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_shifterop(A_ADD,helper2,numerator,helper1,so)); + shifterop_reset(so); + so.shiftmode:=SM_ASR; + so.shiftimm:=power; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_shifterop(A_MOV,resultreg,helper2,so)); + end + else + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_INT,power,numerator,resultreg) + end; +} + end; + + + procedure genOrdConstNodeMod; + var + modreg, maskreg, tempreg : tregister; + begin +{ + if (tordconstnode(right).value = 0) then begin + internalerror(2005061702); + end + else if (abs(tordconstnode(right).value.svalue) = 1) then + begin + // x mod +/-1 is always zero + cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, 0, resultreg); + end + else if (ispowerof2(tordconstnode(right).value, power)) then + begin + if (is_signed(right.resultdef)) then begin + + tempreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + maskreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + modreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + + cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, abs(tordconstnode(right).value.svalue)-1, modreg); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SAR, OS_INT, 31, numerator, maskreg); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, numerator, modreg, tempreg); + + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ANDC, maskreg, maskreg, modreg)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBFIC, modreg, tempreg, 0)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBFE, modreg, modreg, modreg)); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, modreg, maskreg, maskreg); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_OR, OS_INT, maskreg, tempreg, resultreg); + end else begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, tordconstnode(right).value.svalue-1, numerator, resultreg); + end; + end else begin + genOrdConstNodeDiv(); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_MUL, OS_INT, tordconstnode(right).value.svalue, resultreg, resultreg); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_SUB, OS_INT, resultreg, numerator, resultreg); + end; +} + end; + + begin + secondpass(left); + secondpass(right); + location_copy(location,left.location); + +{ + { put numerator in register } + size:=def_cgsize(left.resultdef); + location_force_reg(current_asmdata.CurrAsmList,left.location, + size,true); + location_copy(location,left.location); + numerator:=location.register; + resultreg:=location.register; + if location.loc=LOC_CREGISTER then + begin + location.loc := LOC_REGISTER; + location.register := cg.getintregister(current_asmdata.CurrAsmList,size); + resultreg:=location.register; + end + else if (nodetype=modn) or (right.nodetype=ordconstn) then + begin + // for a modulus op, and for const nodes we need the result register + // to be an extra register + resultreg:=cg.getintregister(current_asmdata.CurrAsmList,size); + end; + + if right.nodetype=ordconstn then + begin + if nodetype=divn then + genOrdConstNodeDiv + else + genOrdConstNodeMod; + end; + + location.register:=resultreg; + + { unsigned division/module can only overflow in case of division by zero } + { (but checking this overflow flag is more convoluted than performing a } + { simple comparison with 0) } + if is_signed(right.resultdef) then + cg.g_overflowcheck(current_asmdata.CurrAsmList,location,resultdef); +} + end; + +{***************************************************************************** + TAVRNOTNODE +*****************************************************************************} + + procedure tavrnotnode.second_boolean; + var + hl : tasmlabel; + tmpreg : tregister; + i : longint; + begin + { if the location is LOC_JUMP, we do the secondpass after the + labels are allocated + } + if left.expectloc=LOC_JUMP then + begin + hl:=current_procinfo.CurrTrueLabel; + current_procinfo.CurrTrueLabel:=current_procinfo.CurrFalseLabel; + current_procinfo.CurrFalseLabel:=hl; + secondpass(left); + maketojumpbool(current_asmdata.CurrAsmList,left,lr_load_regvars); + hl:=current_procinfo.CurrTrueLabel; + current_procinfo.CurrTrueLabel:=current_procinfo.CurrFalseLabel; + current_procinfo.CurrFalseLabel:=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, + LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF : + begin + location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),true); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CPI,left.location.register,0)); + tmpreg:=left.location.register; + + { avr has no cpci, so we use the first register as "zero" register } + for i:=2 to tcgsize2size[left.location.size] do + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CPC,tmpreg,left.location.register)); + end; + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=F_EQ; + end; + else + internalerror(2003042401); + end; + end; + end; + +begin + cmoddivnode:=tavrmoddivnode; + cnotnode:=tavrnotnode; +end. diff --git a/closures/compiler/avr/raavr.pas b/closures/compiler/avr/raavr.pas new file mode 100644 index 0000000000..b837b02bef --- /dev/null +++ b/closures/compiler/avr/raavr.pas @@ -0,0 +1,52 @@ +{ + 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 raavr; + +{$i fpcdefs.inc} + + interface + + uses + cpubase, + aasmtai,aasmdata, + rautils; + + type + TAVROperand=class(TOperand) + end; + + TAVRInstruction=class(TInstruction) + function ConcatInstruction(p:TAsmList) : tai;override; + end; + + implementation + + uses + aasmcpu; + + function TAVRInstruction.ConcatInstruction(p:TAsmList) : tai; + begin + result:=inherited ConcatInstruction(p); + end; + + +end. diff --git a/closures/compiler/avr/raavrgas.pas b/closures/compiler/avr/raavrgas.pas new file mode 100644 index 0000000000..3cefacaedf --- /dev/null +++ b/closures/compiler/avr/raavrgas.pas @@ -0,0 +1,693 @@ +{ + Copyright (c) 1998-2008 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 raavrgas; + +{$i fpcdefs.inc} + + Interface + + uses + raatt,raavr, + cpubase; + + type + tavrattreader = class(tattreader) + function is_asmopcode(const s: string):boolean;override; + function is_register(const s:string):boolean;override; + procedure handleopcode;override; + procedure BuildReference(oper : tavroperand); + procedure BuildOperand(oper : tavroperand); + procedure BuildOpCode(instr : tavrinstruction); + procedure ReadSym(oper : tavroperand); + procedure ConvertCalljmp(instr : tavrinstruction); + end; + + + Implementation + + uses + { helpers } + cutils, + { global } + globtype,globals,verbose, + systems, + { aasm } + cpuinfo,aasmbase,aasmtai,aasmdata,aasmcpu, + { symtable } + symconst,symbase,symtype,symsym,symtable, + { parser } + scanner, + procinfo, + itcpugas, + rabase,rautils, + cgbase,cgobj + ; + + + function tavrattreader.is_register(const s:string):boolean; + type + treg2str = record + name : string[2]; + reg : tregister; + end; +{ + const + extraregs : array[0..19] of treg2str = ( + (name: 'X'; reg : NR_Z), + (name: 'Y'; reg : NR_R1), + (name: 'Z'; reg : NR_R2), + ); +} + 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 tavrattreader.ReadSym(oper : tavroperand); + var + tempstr, mangledname : string; + typesize,l,k : aint; + 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,mangledname,false); + if (mangledname<>'') then + Message(asmr_e_invalid_reference_syntax); + inc(oper.opr.ref.offset,l); + end; + end; + + + Procedure tavrattreader.BuildReference(oper : tavroperand); + + procedure Consume_RParen; + begin + if actasmtoken<>AS_RPAREN then + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(true); + end + else + begin + Consume(AS_RPAREN); + 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_LPAREN); + if actasmtoken=AS_REGISTER then + begin + oper.opr.ref.base:=actasmregister; + Consume(AS_REGISTER); + { can either be a register or a right parenthesis } + { (reg) } + if actasmtoken=AS_LPAREN then + Begin + Consume_RParen; + exit; + end; + if actasmtoken=AS_PLUS then + begin + consume(AS_PLUS); + oper.opr.ref.addressmode:=AM_POSTINCREMENT; + end; + end {end case } + else + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end; + end; + + + Procedure tavrattreader.BuildOperand(oper : tavroperand); + var + expr : string; + typesize,l : aint; + + + 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 + mangledname: string; + hasdot : boolean; + l, + toffset, + tsize : aint; + 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,mangledname,false); + if (oper.opr.typ<>OPR_CONSTANT) and + (mangledname<>'') then + Message(asmr_e_wrong_sym_type); + 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 : + if (mangledname<>'') then + begin + if (oper.opr.val<>0) then + Message(asmr_e_wrong_sym_type); + oper.opr.typ:=OPR_SYMBOL; + oper.opr.symbol:=current_asmdata.RefAsmSymbol(mangledname); + end + else + inc(oper.opr.val,l); + OPR_SYMBOL: + Message(asmr_e_invalid_symbol_ref); + 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; + tempstr : string; + tempsymtyp : tasmsymtype; + Begin + expr:=''; + case actasmtoken of + AS_LBRACKET: { Memory reference or constant expression } + Begin + oper.InitRef; + BuildReference(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); + + { absolute memory addresss? } + if actopcode in [A_LDS,A_STS] then + BuildReference(oper) + else + begin + ofs:=oper.opr.ref.offset; + BuildConstantOperand(oper); + inc(oper.opr.val,ofs); + end; + end; + + AS_ID: { A constant expression, or a Variable ref. } + Begin + if (actasmpattern='LO8') or (actasmpattern='HI8') then + begin + { Low or High part of a constant (or constant + memory location) } + oper.InitRef; + if actasmpattern='LO8' then + oper.opr.ref.refaddr:=addr_lo8 + else + oper.opr.ref.refaddr:=addr_hi8; + Consume(actasmtoken); + Consume(AS_LPAREN); + BuildConstSymbolExpression(false, true,false,l,tempstr,tempsymtyp); + if not assigned(oper.opr.ref.symbol) then + oper.opr.ref.symbol:=current_asmdata.RefAsmSymbol(tempstr) + else + Message(asmr_e_cant_have_multiple_relocatable_symbols); + 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; + Consume(AS_RPAREN); + end + { Local Label ? } + else if is_locallabel(actasmpattern) then + begin + CreateLocalLabel(actasmpattern,hl,false); + Consume(AS_ID); + AddLabelOperand(hl); + end + { Check for label } + else 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 + Message(asmr_e_syn_operand); + end; + + AS_END, + AS_SEPARATOR, + AS_COMMA: ; + else + Begin + Message(asmr_e_syn_operand); + Consume(actasmtoken); + end; + end; { end case } + end; + + +{***************************************************************************** + tavrattreader +*****************************************************************************} + + procedure tavrattreader.BuildOpCode(instr : tavrinstruction); + 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; + 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 operandnum>Max_Operands then + Message(asmr_e_too_many_operands) + else + Inc(operandnum); + Consume(AS_COMMA); + end; + AS_SEPARATOR, + AS_END : { End of asm operands for this opcode } + begin + break; + end; + else + BuildOperand(instr.Operands[operandnum] as tavroperand); + end; { end case } + until false; + instr.Ops:=operandnum; + end; + + + function tavrattreader.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'); + + var + 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 ((copy(hs,1,2)='BR') and (length(hs)=4)) then + begin + for icond:=low(tasmcond) to high(tasmcond) do + begin + if copy(hs,2,3)=uppercond2str[icond] then + begin + actopcode:=A_BRxx; + actasmtoken:=AS_OPCODE; + actcondition:=icond; + is_asmopcode:=true; + exit; + end; + end; + end; + maxlen:=max(length(hs),5); + actopcode:=A_NONE; + for j:=maxlen downto 1 do + begin + actopcode:=tasmop(PtrInt(iasmops.Find(copy(hs,1,j)))); + if actopcode<>A_NONE then + begin + actasmtoken:=AS_OPCODE; + { strip op code } + delete(hs,1,j); + break; + end; + end; + if actopcode=A_NONE 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; + { if we stripped all postfixes, it's a valid opcode } + is_asmopcode:=length(hs)=0; + end; + + + procedure tavrattreader.ConvertCalljmp(instr : tavrinstruction); + 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 tavrattreader.handleopcode; + var + instr : tavrinstruction; + begin + instr:=tavrinstruction.Create(tavroperand); + BuildOpcode(instr); +{ if is_calljmp(instr.opcode) then + ConvertCalljmp(instr); } + { + instr.AddReferenceSizes; + instr.SetInstructionOpsize; + instr.CheckOperandSizes; + } + instr.ConcatInstruction(curlist); + instr.Free; + end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +const + asmmode_avr_att_info : tasmmodeinfo = + ( + id : asmmode_avr_gas; + idtxt : 'GAS'; + casmreader : tavrattreader; + ); + + asmmode_avr_standard_info : tasmmodeinfo = + ( + id : asmmode_standard; + idtxt : 'STANDARD'; + casmreader : tavrattreader; + ); + +initialization + RegisterAsmMode(asmmode_avr_att_info); + RegisterAsmMode(asmmode_avr_standard_info); +end. diff --git a/closures/compiler/avr/ravrcon.inc b/closures/compiler/avr/ravrcon.inc new file mode 100644 index 0000000000..b5f01d44a4 --- /dev/null +++ b/closures/compiler/avr/ravrcon.inc @@ -0,0 +1,34 @@ +{ don't edit, this file is generated from avrreg.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_R16 = tregister($01000010); +NR_R17 = tregister($01000011); +NR_R18 = tregister($01000012); +NR_R19 = tregister($01000013); +NR_R20 = tregister($01000014); +NR_R21 = tregister($01000015); +NR_R22 = tregister($01000016); +NR_R23 = tregister($01000017); +NR_R24 = tregister($01000018); +NR_R25 = tregister($01000019); +NR_R26 = tregister($0100001a); +NR_R27 = tregister($0100001b); +NR_R28 = tregister($0100001c); +NR_R29 = tregister($0100001d); +NR_R30 = tregister($0100001e); +NR_R31 = tregister($0100001f); diff --git a/closures/compiler/avr/ravrdwa.inc b/closures/compiler/avr/ravrdwa.inc new file mode 100644 index 0000000000..4231ab6f18 --- /dev/null +++ b/closures/compiler/avr/ravrdwa.inc @@ -0,0 +1,34 @@ +{ don't edit, this file is generated from avrreg.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, +24, +25, +26, +27, +28, +29, +30, +31 diff --git a/closures/compiler/avr/ravrnor.inc b/closures/compiler/avr/ravrnor.inc new file mode 100644 index 0000000000..6640bf866a --- /dev/null +++ b/closures/compiler/avr/ravrnor.inc @@ -0,0 +1,2 @@ +{ don't edit, this file is generated from avrreg.dat } +33 diff --git a/closures/compiler/avr/ravrnum.inc b/closures/compiler/avr/ravrnum.inc new file mode 100644 index 0000000000..92e62c897f --- /dev/null +++ b/closures/compiler/avr/ravrnum.inc @@ -0,0 +1,34 @@ +{ don't edit, this file is generated from avrreg.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($01000010), +tregister($01000011), +tregister($01000012), +tregister($01000013), +tregister($01000014), +tregister($01000015), +tregister($01000016), +tregister($01000017), +tregister($01000018), +tregister($01000019), +tregister($0100001a), +tregister($0100001b), +tregister($0100001c), +tregister($0100001d), +tregister($0100001e), +tregister($0100001f) diff --git a/closures/compiler/avr/ravrrni.inc b/closures/compiler/avr/ravrrni.inc new file mode 100644 index 0000000000..9f5aa02027 --- /dev/null +++ b/closures/compiler/avr/ravrrni.inc @@ -0,0 +1,34 @@ +{ don't edit, this file is generated from avrreg.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 diff --git a/closures/compiler/avr/ravrsri.inc b/closures/compiler/avr/ravrsri.inc new file mode 100644 index 0000000000..771be07f06 --- /dev/null +++ b/closures/compiler/avr/ravrsri.inc @@ -0,0 +1,34 @@ +{ don't edit, this file is generated from avrreg.dat } +0, +1, +2, +11, +12, +13, +14, +15, +16, +17, +18, +19, +20, +3, +21, +22, +23, +24, +25, +26, +27, +28, +29, +30, +4, +31, +32, +5, +6, +7, +8, +9, +10 diff --git a/closures/compiler/avr/ravrsta.inc b/closures/compiler/avr/ravrsta.inc new file mode 100644 index 0000000000..4231ab6f18 --- /dev/null +++ b/closures/compiler/avr/ravrsta.inc @@ -0,0 +1,34 @@ +{ don't edit, this file is generated from avrreg.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, +24, +25, +26, +27, +28, +29, +30, +31 diff --git a/closures/compiler/avr/ravrstd.inc b/closures/compiler/avr/ravrstd.inc new file mode 100644 index 0000000000..a29e9cf2a9 --- /dev/null +++ b/closures/compiler/avr/ravrstd.inc @@ -0,0 +1,34 @@ +{ don't edit, this file is generated from avrreg.dat } +'INVALID', +'r0', +'r1', +'r2', +'r3', +'r4', +'r5', +'r6', +'r7', +'r8', +'r9', +'r10', +'r11', +'r12', +'r13', +'r14', +'r15', +'r16', +'r17', +'r18', +'r19', +'r20', +'r21', +'r22', +'r23', +'r24', +'r25', +'r26', +'r27', +'r28', +'r29', +'r30', +'r31' diff --git a/closures/compiler/avr/ravrsup.inc b/closures/compiler/avr/ravrsup.inc new file mode 100644 index 0000000000..da781e0718 --- /dev/null +++ b/closures/compiler/avr/ravrsup.inc @@ -0,0 +1,34 @@ +{ don't edit, this file is generated from avrreg.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_R16 = $10; +RS_R17 = $11; +RS_R18 = $12; +RS_R19 = $13; +RS_R20 = $14; +RS_R21 = $15; +RS_R22 = $16; +RS_R23 = $17; +RS_R24 = $18; +RS_R25 = $19; +RS_R26 = $1a; +RS_R27 = $1b; +RS_R28 = $1c; +RS_R29 = $1d; +RS_R30 = $1e; +RS_R31 = $1f; diff --git a/closures/compiler/avr/rgcpu.pas b/closures/compiler/avr/rgcpu.pas new file mode 100644 index 0000000000..602ec1c2ff --- /dev/null +++ b/closures/compiler/avr/rgcpu.pas @@ -0,0 +1,169 @@ +{ + Copyright (c) 1998-2008 by Florian Klaempfl + + This unit implements the avr specific class for the register + allocator + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} + +unit rgcpu; + +{$i fpcdefs.inc} + + interface + + uses + aasmbase,aasmtai,aasmdata,aasmcpu, + cgbase,cgutils, + cpubase, + rgobj; + + type + trgcpu = class(trgobj) + procedure add_constraints(reg:tregister);override; + procedure do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override; + procedure do_spill_written(list:TAsmList;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.add_constraints(reg:tregister); + var + supreg,i : Tsuperregister; + begin + case getsubreg(reg) of + { Let 64bit floats conflict with all odd float regs } + R_SUBFD: + begin + { + supreg:=getsupreg(reg); + i:=RS_F1; + while (i<=RS_F31) do + begin + add_edge(supreg,i); + inc(i,2); + end; + } + end; + { Let 64bit ints conflict with all odd int regs } + R_SUBQ: + begin + supreg:=getsupreg(reg); + { + i:=RS_G1; + while (i<=RS_I7) do + begin + add_edge(supreg,i); + inc(i,2); + end; + } + end; + end; + end; + + + procedure trgcpu.do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister); + var + helpins : tai; + tmpref : treference; + helplist : TAsmList; + hreg : tregister; + begin + if abs(spilltemp.offset)>63 then + begin + helplist:=TAsmList.create; + + helplist.concat(taicpu.op_reg_const(A_LDI,NR_R26,lo(word(spilltemp.offset)))); + helplist.concat(taicpu.op_reg_const(A_LDI,NR_R27,hi(word(spilltemp.offset)))); + helplist.concat(taicpu.op_reg_reg(A_ADD,NR_R26,spilltemp.base)); + helplist.concat(taicpu.op_reg_reg(A_ADC,NR_R27,GetNextReg(spilltemp.base))); + + reference_reset_base(tmpref,NR_R26,0,1); + helpins:=spilling_create_load(tmpref,tempreg); + helplist.concat(helpins); + list.insertlistafter(pos,helplist); + helplist.free; + end + else + inherited do_spill_read(list,pos,spilltemp,tempreg); + end; + + + procedure trgcpu.do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister); + var + tmpref : treference; + helplist : TAsmList; + hreg : tregister; + begin + if abs(spilltemp.offset)>63 then + begin + helplist:=TAsmList.create; + + helplist.concat(taicpu.op_reg_const(A_LDI,NR_R26,lo(word(spilltemp.offset)))); + helplist.concat(taicpu.op_reg_const(A_LDI,NR_R27,hi(word(spilltemp.offset)))); + helplist.concat(taicpu.op_reg_reg(A_ADD,NR_R26,spilltemp.base)); + helplist.concat(taicpu.op_reg_reg(A_ADC,NR_R27,GetNextReg(spilltemp.base))); + + reference_reset_base(tmpref,NR_R26,0,1); + helplist.concat(spilling_create_store(tempreg,tmpref)); + list.insertlistafter(pos,helplist); + helplist.free; + end + else + inherited do_spill_written(list,pos,spilltemp,tempreg); + end; + + + procedure trgintcpu.add_cpu_interferences(p : tai); + var + r : tsuperregister; + begin + if p.typ=ait_instruction then + begin + case taicpu(p).opcode of + A_CPI, + A_ANDI, + A_ORI, + A_SUBI, + A_SBCI, + A_LDI: + for r:=RS_R0 to RS_R15 do + add_edge(r,GetSupReg(taicpu(p).oper[0]^.reg)); + A_MULS: + begin + for r:=RS_R0 to RS_R15 do + add_edge(r,GetSupReg(taicpu(p).oper[0]^.reg)); + for r:=RS_R0 to RS_R15 do + add_edge(r,GetSupReg(taicpu(p).oper[1]^.reg)); + end; + end; + end; + end; + + +end. diff --git a/closures/compiler/browcol.pas b/closures/compiler/browcol.pas new file mode 100644 index 0000000000..183063be35 --- /dev/null +++ b/closures/compiler/browcol.pas @@ -0,0 +1,2291 @@ +{ + 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; + +{$i fpcdefs.inc} +{ $define use_refs} +{$H-} + +interface + +uses + SysUtils, + CUtils, + objects, + cclasses, + symconst,symtable; + +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; + varoptions : tvaroptions; + varspez : tvarspez; { sets the type of access } + 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; + procedure SetVarSpez(const AVarSpez : TVarSpez); + procedure SetVarOptions(const AVarOptions : TVarOptions); + 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 + globtype,globals,comphook,constexp, +{$ifdef DEBUG} + verbose, +{$endif DEBUG} + finput,fmodule, + crefs,cpuinfo,cgbase, + aasmbase,aasmtai,aasmdata,paramgr, + symsym,symdef,symtype,symbase,defutil; + +const + RModuleNameCollection: TStreamRec = ( + ObjType: 3001; + VmtLink: Ofs(TypeOf(TModuleNameCollection)^); + Load: @TModuleNameCollection.Load; + Store: @TModuleNameCollection.Store; + Next: nil + ); + RTypeNameCollection: TStreamRec = ( + ObjType: 3002; + VmtLink: Ofs(TypeOf(TTypeNameCollection)^); + Load: @TTypeNameCollection.Load; + Store: @TTypeNameCollection.Store; + Next: nil + ); + RReference: TStreamRec = ( + ObjType: 3003; + VmtLink: Ofs(TypeOf(TReference)^); + Load: @TReference.Load; + Store: @TReference.Store; + Next: nil + ); + RSymbol: TStreamRec = ( + ObjType: 3004; + VmtLink: Ofs(TypeOf(TSymbol)^); + Load: @TSymbol.Load; + Store: @TSymbol.Store; + Next: nil + ); + RObjectSymbol: TStreamRec = ( + ObjType: 3005; + VmtLink: Ofs(TypeOf(TObjectSymbol)^); + Load: @TObjectSymbol.Load; + Store: @TObjectSymbol.Store; + Next: nil + ); + RSymbolCollection: TStreamRec = ( + ObjType: 3006; + VmtLink: Ofs(TypeOf(TSymbolCollection)^); + Load: @TSymbolCollection.Load; + Store: @TSymbolCollection.Store; + Next: nil + ); + RSortedSymbolCollection: TStreamRec = ( + ObjType: 3007; + VmtLink: Ofs(TypeOf(TSortedSymbolCollection)^); + Load: @TSortedSymbolCollection.Load; + Store: @TSortedSymbolCollection.Store; + Next: nil + ); + RIDSortedSymbolCollection: TStreamRec = ( + ObjType: 3008; + VmtLink: Ofs(TypeOf(TIDSortedSymbolCollection)^); + Load: @TIDSortedSymbolCollection.Load; + Store: @TIDSortedSymbolCollection.Store; + Next: nil + ); + RObjectSymbolCollection: TStreamRec = ( + ObjType: 3009; + VmtLink: Ofs(TypeOf(TObjectSymbolCollection)^); + Load: @TObjectSymbolCollection.Load; + Store: @TObjectSymbolCollection.Store; + Next: nil + ); + RReferenceCollection: TStreamRec = ( + ObjType: 3010; + VmtLink: Ofs(TypeOf(TReferenceCollection)^); + Load: @TReferenceCollection.Load; + Store: @TReferenceCollection.Store; + Next: nil + ); + RModuleSymbol: TStreamRec = ( + ObjType: 3011; + VmtLink: Ofs(TypeOf(TModuleSymbol)^); + Load: @TModuleSymbol.Load; + Store: @TModuleSymbol.Store; + Next: nil + ); + + SymbolCount : longint = 0; + +{**************************************************************************** + 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 + begin + { Handle overloaded functions } + if (K1^.Typ=procsym) then + begin + S1:=K1^.GetText; + S2:=K2^.GetText; + if S1<S2 then R:=-1 else + if S1>S2 then R:=1 else + R:=0; + end + else + R:=0; + end + 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 PtrUInt(K1^.Symbol)<PtrUInt(K2^.Symbol) then R:=-1 else + if PtrUInt(K1^.Symbol)>PtrUInt(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; + inc(SymbolCount); + VarSpez:=vs_value; + VarOptions:=[]; + 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.SetVarSpez(const AVarSpez : TVarSpez); +begin + VarSpez:=AVarSpez; +end; + +procedure TSymbol.SetVarOptions(const AVarOptions : TVarOptions); +begin + VarOptions:=AVarOptions; +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; + if Typ=ProcSym then + S:=S+';'; + GetText:=S; +end; + +function TSymbol.GetTypeName: string; +var S: string; +begin + case Typ of + abstractsym : S:='abst'; + fieldvarsym : S:='member'; + staticvarsym, + localvarsym, + paravarsym : + begin + if (vo_is_hidden_para in varoptions) then + S:='hidden' + else + S:='var'; + end; + typesym : S:='type'; + procsym : if VType=nil then + S:='proc' + else + S:='func'; + unitsym : S:='unit'; + constsym : S:='const'; + enumsym : S:='enum'; + errorsym : S:='error'; + syssym : S:='sys'; + labelsym : S:='label'; + absolutevarsym : + if (vo_is_funcret in varoptions) then + S:='ret' + else + S:='abs'; + propertysym : S:='prop'; + macrosym : S:='macro'; + else S:=''; + end; + GetTypeName:=S; +end; + +destructor TSymbol.Done; +begin + 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);} + dec(SymbolCount); + inherited Done; +end; + +constructor TSymbol.Load(var S: TStream); +var MI: TSymbolMemInfo; + W: word; +begin + TObject.Init; + inc(SymbolCount); + + S.Read(Typ,SizeOf(Typ)); + case Typ of + abstractsym, + absolutevarsym, + staticvarsym, + localvarsym, + paravarsym : + begin + S.Read(VarSpez,SizeOf(VarSpez)); + S.Read(VarOptions,SizeOf(VarOptions)); + end; + else + begin + VarSpez:=vs_value; + VarOptions:=[]; + end; + end; + 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)); + case Typ of + abstractsym, + absolutevarsym, + staticvarsym, + localvarsym, + paravarsym : + begin + S.Write(VarSpez,SizeOf(VarSpez)); + S.Write(VarOptions,SizeOf(VarOptions)); + end; + end; + 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 + 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); + inherited 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 I: longint; + Sym: TSym; + pd : TProcDef; + Symbol: PSymbol; + Reference: PReference; + inputfile : Tinputfile; + Ref : TRefItem; + DefPos : TFilePosInfo; + 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; + i: integer; + begin + Name:='('; + for i := 0 to def.symtable.SymList.Count - 1 do + begin + if i>0 then + Name:=Name+', '; + Name:=Name+tenumsym(def.symtable.SymList[i]).name; + 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.elementdef) then + Name:=Name+GetDefinitionStr(def.elementdef); + 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.typedfiledef); + end; + GetFileDefStr:=Name; + end; + function GetStringDefStr(def: tstringdef): string; + var Name: string; + begin + Name:=''; + case def.stringtype 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'; + st_unicodestring : + Name:='unicodestring'; + else ; + end; + GetStringDefStr:=Name; + end; + function retdefassigned(def: tabstractprocdef): boolean; + var OK: boolean; + begin + OK:=false; + if assigned(def.returndef) then + if UpcaseStr(GetDefinitionStr(def.returndef))<>'VOID' then + OK:=true; + retdefassigned:=OK; + end; + function GetAbsProcParmDefStr(def: tabstractprocdef): string; + var Name: string; + dc: tabstractvarsym; + i, + Count: integer; + CurName: string; + begin + Name:=''; + Count:=0; + for i:=0 to def.paras.count-1 do + begin + dc:=tabstractvarsym(def.paras[i]); + if not (vo_is_hidden_para in dc.VarOptions) then + begin + CurName:=''; + if assigned(dc.vardef) then + CurName:=': '+GetDefinitionStr(dc.vardef); + CurName:=dc.RealName+CurName; + case dc.varspez of + vs_Value : ; + vs_Const : CurName:='const '+CurName; + vs_Var : CurName:='var '+CurName; + vs_Out : CurName:='out '+CurName; + vs_Constref : CurName:='constref '+CurName; + end; + if Count>0 then + CurName:='; '+CurName; + Name:=Name+CurName; + Inc(Count); + end; + 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.returndef)+';' + 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:='set of '+GetDefinitionStr(def.elementdef); + GetSetDefStr:=Name; + end; + function GetPointerDefStr(def: tpointerdef): string; + begin + GetPointerDefStr:='^'+GetDefinitionStr(def.pointeddef); + 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.typ 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.constdef.typ=enumdef then + Name:=sym.constdef.typesym.name+'('+tostr(sym.value.valueord)+')' + else + if is_boolean(sym.constdef) then + Name:='Longbool('+tostr(sym.value.valueord)+')' + else + if is_char(sym.constdef) or + is_widechar(sym.constdef) then + Name:=''''+chr(sym.value.valueord.svalue)+'''' + else + Name:=tostr(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 useful for unamed types PM } + if assigned(definition) and not assigned(definition.typesym) then + begin + case definition.typ 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; + symidx : longint; + begin + if not Assigned(Table) then + Exit; + Symbol:=nil; + if Owner=nil then + Owner:=New(PSortedSymbolCollection, Init(10,50)); + for symidx:=0 to Table.SymList.Count-1 do + begin + sym:=tsym(Table.SymList[symidx]); + New(Symbol, Init(Sym.Name,Sym.Typ,'',nil)); + case Sym.Typ of + staticvarsym, + localvarsym, + absolutevarsym, + paravarsym : + begin + Symbol^.SetVarOptions(tabstractvarsym(sym).VarOptions); + Symbol^.SetVarSpez(tabstractvarsym(sym).VarSpez); + end; + end; + case Sym.Typ of + staticvarsym, + localvarsym, + paravarsym : + with tabstractvarsym(sym) do + begin + if (vo_is_funcret in varoptions) then + begin + if Assigned(OwnerSym) then + if assigned(vardef) then + if assigned(vardef.typesym) then + SetVType(OwnerSym,vardef.typesym.name) + else + SetVType(OwnerSym,GetDefinitionStr(vardef)); + end; + if assigned(vardef) then + if assigned(vardef.typesym) then + SetVType(Symbol,vardef.typesym.name) + else + SetVType(Symbol,GetDefinitionStr(vardef)); + ProcessDefIfStruct(vardef); + if assigned(vardef) then + if (vardef.typ=pointerdef) and + assigned(tpointerdef(vardef).pointeddef) then + begin + Symbol^.Flags:=(Symbol^.Flags or sfPointer); + Symbol^.RelatedTypeID:=Ptrint(tpointerdef(vardef).pointeddef); + 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(vardef) and (vardef.typ=arraydef) then + begin + if tarraydef(vardef).highrange<tarraydef(vardef).lowrange then + MemInfo.Size:=-1 + else + MemInfo.Size:=getsize; + end + else + MemInfo.Size:=getsize; + { this is not completely correct... } + if assigned(vardef) then + MemInfo.PushSize:=paramanager.push_size(varspez,vardef,pocall_default) + else + begin + { This can happen, why? } + MemInfo.PushSize:=0; + end; + Symbol^.SetMemInfo(MemInfo); + end; + fieldvarsym : + with tfieldvarsym(sym) do + begin + if assigned(vardef) and (vardef.typ=arraydef) then + begin + if tarraydef(vardef).highrange<tarraydef(vardef).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 + for i:=0 to tprocsym(sym).ProcdefList.Count-1 do + begin + if i>0 then + begin + if Assigned(Symbol) then + Owner^.Insert(Symbol); + New(Symbol, Init(Sym.Name,Sym.Typ,'',nil)); + end; + with tprocsym(sym) do + begin + pd:=tprocdef(procdeflist[i]); + if assigned(pd) then + begin + ProcessSymTable(Symbol,Symbol^.Items,pd.parast); + if assigned(pd.parast) then + begin + Symbol^.Params:=TypeNames^.Add( + GetAbsProcParmDefStr(pd)); + end + else { param-definition is NOT assigned } + if assigned(Table.Name) and + (Table.Name^='SYSTEM') then + begin + Symbol^.Params:=TypeNames^.Add('...'); + end; + if cs_local_browser in current_settings.moduleswitches then + begin + if assigned(pd.localst) and + (pd.localst.symtabletype<>staticsymtable) then + ProcessSymTable(Symbol,Symbol^.Items,pd.localst); + end; + end; + end; + end; + end; + typesym : + begin + with ttypesym(sym) do + if assigned(typedef) then + begin + Symbol^.TypeID:=Ptrint(typedef); + case typedef.typ of + arraydef : + SetDType(Symbol,GetArrayDefStr(tarraydef(typedef))); + enumdef : + SetDType(Symbol,GetEnumDefStr(tenumdef(typedef))); + procdef : + SetDType(Symbol,GetProcDefStr(tprocdef(typedef))); + procvardef : + SetDType(Symbol,GetProcVarDefStr(tprocvardef(typedef))); + objectdef : + with tobjectdef(typedef) do + begin + ObjDef:=childof; + if ObjDef<>nil then + Symbol^.RelatedTypeID:=Ptrint(ObjDef);{TypeNames^.Add(S);} + Symbol^.Flags:=(Symbol^.Flags or sfObject); + if tobjectdef(typedef).objecttype=odt_class then + Symbol^.Flags:=(Symbol^.Flags or sfClass); + ProcessSymTable(Symbol,Symbol^.Items,tobjectdef(typedef).symtable); + end; + recorddef : + begin + Symbol^.Flags:=(Symbol^.Flags or sfRecord); + ProcessSymTable(Symbol,Symbol^.Items,trecorddef(typedef).symtable); + end; + pointerdef : + begin + Symbol^.Flags:=(Symbol^.Flags or sfPointer); + Symbol^.RelatedTypeID:=Ptrint(tpointerdef(typedef).pointeddef);{TypeNames^.Add(S);} + SetDType(Symbol,GetPointerDefStr(tpointerdef(typedef))); + end; + + filedef : + SetDType(Symbol,GetFileDefStr(tfiledef(typedef))); + setdef : + SetDType(Symbol,GetSetDefStr(tsetdef(typedef))); + end; + end; + end; + end; + if assigned(sym) then + begin + DefPos:=tstoredsym(sym).FileInfo; + inputfile:=get_source_file(defpos.moduleindex,defpos.fileindex); + if Assigned(inputfile) and Assigned(inputfile.name) then + begin + New(Reference, Init(ModuleNames^.Add(inputfile.name^), + DefPos.line,DefPos.column)); + Symbol^.References^.Insert(Reference); + end; + end; + if assigned(Symbol) and assigned(sym.RefList) then + begin + Ref:=TRefItem(tstoredsym(sym).RefList.First); + while assigned(Ref) do + begin + inputfile:=get_source_file(ref.refinfo.moduleindex,ref.refinfo.fileindex); + if Assigned(inputfile) and Assigned(inputfile.name) then + begin + New(Reference, Init(ModuleNames^.Add(inputfile.name^), + ref.refinfo.line,ref.refinfo.column)); + Symbol^.References^.Insert(Reference); + end; + Ref:=TRefItem(Ref.next); + end; + 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; + end; + end; + +function SearchModule(const Name: string): PModuleSymbol; +function Match(P: PModuleSymbol): boolean; +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 + path,module, + name,msource : string; + + T: TSymTable; + UnitS,PM: PModuleSymbol; + hp : tmodule; + puu: tused_unit; + pdu: tdependent_unit; + pif: tinputfile; +begin + DisposeBrowserCol; + if (cs_browser in current_settings.moduleswitches) then + NewBrowserCol; + hp:=tmodule(loaded_units.first); + if (cs_browser in current_settings.moduleswitches) then + while assigned(hp) do + begin + if hp.is_unit then + t:=tsymtable(hp.globalsymtable) + else + t:=tsymtable(hp.localsymtable); + if assigned(t) then + begin + name:=GetStr(T.Name); + msource:=GetStr(hp.mainsource); + New(UnitS, Init(Name,msource)); + 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 + path:=GetStr(pif.path); + name:=GetStr(pif.name); + UnitS^.AddSourceFile(path+name); + pif:=pif.next; + end; + end; + + Modules^.Insert(UnitS); + ProcessSymTable(UnitS,UnitS^.Items,T); + if hp.is_unit then + if cs_local_browser in current_settings.moduleswitches 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 current_settings.moduleswitches) then + while assigned(hp) do + begin + t:=tsymtable(hp.globalsymtable); + if assigned(t) then + begin + name:=GetStr(T.Name); + UnitS:=SearchModule(Name); + puu:=tused_unit(hp.used_units.first); + while (puu<>nil) do + begin + module:=GetStr(puu.u.modulename); + PM:=SearchModule(module); + 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 + name:=GetStr(tsymtable(pdu.u.globalsymtable).name); + PM:=SearchModule(Name); + if Assigned(PM) then + UnitS^.AddDependentUnit(PM); + pdu:=tdependent_unit(pdu.next); + end; + end; + hp:=tmodule(hp.next); + end; + + if (cs_browser in current_settings.moduleswitches) 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 or sfClass))<>0 then + C^.Insert(P); + if (P^.typ=typesym) then + D^.Insert(P); + if (P^.typ in [staticvarsym,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: 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:=ExpandFileName(m.objfilename^); + ppu:=''; source:=''; + if m.is_unit then + ppu:=ExpandFileName(m.ppufilename^); + if (m.is_unit=false) and (m.islibrary=false) then + ppu:=ExpandFileName(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:=ExpandFileName(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; +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 PtrUInt(K1^.PtrValue)<PtrUInt(K2^.PtrValue) then R:=-1 else + if PtrUInt(K1^.PtrValue)>PtrUInt(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); +begin + PD^.Resolve(P^.FileName); +end; +procedure FixupSymbol(P: PSymbol); +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); +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); +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. diff --git a/closures/compiler/bsdcompile b/closures/compiler/bsdcompile new file mode 100644 index 0000000000..1260d53da6 --- /dev/null +++ b/closures/compiler/bsdcompile @@ -0,0 +1,3 @@ +#!/bin/sh +ppc386 -OG3p3 -Ch8000000 -dI386 -dGDB -dBROWSERLOG -Sg pp.pas -a -s -g %1 %2 %3 %4 %5 %6 %7 %8 %9 + diff --git a/closures/compiler/catch.pas b/closures/compiler/catch.pas new file mode 100644 index 0000000000..002d559280 --- /dev/null +++ b/closures/compiler/catch.pas @@ -0,0 +1,87 @@ +{ + 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 +{ you cannot safely raise an exception inside a signal handler on any OS, + and on darwin this even often crashes +} +{$if defined(unix) and not defined(darwin) } + {$ifndef darwin} + {$define has_signal} + BaseUnix,Unix, + {$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} + +Implementation + +uses + comphook; + +{$ifdef has_signal} +{$ifdef unix} +Procedure CatchSignal(Sig : Longint);cdecl; +{$else} +Function CatchSignal(Sig : longint):longint; cdecl; +{$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 Unix}fpSignal{$else}Signal{$endif}(SIGINT,NewSignal); + {$endif} +{$endif nocatch} +end. diff --git a/closures/compiler/ccharset.pas b/closures/compiler/ccharset.pas new file mode 100644 index 0000000000..bb6073c8a6 --- /dev/null +++ b/closures/compiler/ccharset.pas @@ -0,0 +1,294 @@ +{ + 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. + + **********************************************************************} +{$mode objfpc} +unit ccharset; + + 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]; + cp : word; + map : punicodecharmapping; + lastchar : longint; + next : punicodemap; + internalmap : boolean; + end; + + tcp2unicode = class(tcsconvert) + end; + + const + DefaultSystemCodePage = 437; + + function loadunicodemapping(const cpname,f : string; cp :word) : punicodemap; + procedure registermapping(p : punicodemap); + function getmap(const s : string) : punicodemap; + function getmap(cp : word) : punicodemap; + function mappingavailable(const s : string) : boolean; + function mappingavailable(cp :word) : 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; cp :word) : punicodemap; + + var + data : punicodecharmapping; + datasize : longint; + t : text; + s,hs : string; + scanpos,charpos,unicodevalue : longint; + code : word; + 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^.cp:=cp; + 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 + mapcache : string = ''; + mapcachep : punicodemap = nil; + + begin + if (mapcache=s) and 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; + mapcache:=s; + mapcachep:=hp; + exit; + end; + hp:=hp^.next; + end; + getmap:=nil; + end;//////// + + function getmap(cp : word) : punicodemap; + + var + hp : punicodemap; + + const + mapcache : word = 0; + mapcachep : punicodemap = nil; + + begin + if (mapcache=cp) and assigned(mapcachep) and (mapcachep^.cp=cp) then + begin + getmap:=mapcachep; + exit; + end; + hp:=mappings; + while assigned(hp) do + begin + if hp^.cp=cp then + begin + getmap:=hp; + mapcache:=cp; + mapcachep:=hp; + exit; + end; + hp:=hp^.next; + end; + getmap:=nil; + end; + + function mappingavailable(const s : string) : boolean; + + begin + mappingavailable:=getmap(s)<>nil; + end; + + function mappingavailable(cp : word) : boolean; + + begin + mappingavailable:=getmap(cp)<>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 '?' } + getascii:=#63; + 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. diff --git a/closures/compiler/cclasses.pas b/closures/compiler/cclasses.pas new file mode 100644 index 0000000000..7df8bc326c --- /dev/null +++ b/closures/compiler/cclasses.pas @@ -0,0 +1,3035 @@ +{ + 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} + +{$ifndef VER2_0} + {$define CCLASSESINLINE} +{$endif} + +interface + + uses +{$IFNDEF USE_FAKE_SYSUTILS} + SysUtils, +{$ELSE} + fksysutl, +{$ENDIF} + globtype, + CUtils,CStreams; + +{******************************************** + TMemDebug +********************************************} + + type + tmemdebug = class + private + totalmem, + startmem : int64; + infostr : string[40]; + public + constructor Create(const s:string); + destructor Destroy;override; + procedure show; + procedure start; + procedure stop; + end; + +{******************************************************* + TFPList (From rtl/objpas/classes/classesh.inc) +********************************************************} + +const + SListIndexError = 'List index exceeds bounds (%d)'; + SListCapacityError = 'The maximum list capacity is reached (%d)'; + SListCapacityPower2Error = 'The capacity has to be a power of 2, but is set to %d'; + SListCountError = 'List count too large (%d)'; +type + EListError = class(Exception); + +const + MaxListSize = Maxint div 16; +type + PPointerList = ^TPointerList; + TPointerList = array[0..MaxListSize - 1] of Pointer; + TListSortCompare = function (Item1, Item2: Pointer): Integer; + TListCallback = procedure(data,arg:pointer) of object; + TListStaticCallback = procedure(data,arg:pointer); + + TFPList = class(TObject) + private + FList: PPointerList; + FCount: Integer; + FCapacity: Integer; + protected + function Get(Index: Integer): Pointer; + procedure Put(Index: Integer; Item: Pointer); + procedure SetCapacity(NewCapacity: Integer); + procedure SetCount(NewCount: Integer); + Procedure RaiseIndexError(Index : Integer); + public + destructor Destroy; override; + function Add(Item: Pointer): Integer; + procedure Clear; + procedure Delete(Index: Integer); + class procedure Error(const Msg: string; Data: PtrInt); + procedure Exchange(Index1, Index2: Integer); + function Expand: TFPList; + function Extract(item: Pointer): Pointer; + function First: Pointer; + function IndexOf(Item: Pointer): Integer; + procedure Insert(Index: Integer; Item: Pointer); + function Last: Pointer; + procedure Move(CurIndex, NewIndex: Integer); + procedure Assign(Obj:TFPList); + function Remove(Item: Pointer): Integer; + procedure Pack; + procedure Sort(Compare: TListSortCompare); + procedure ForEachCall(proc2call:TListCallback;arg:pointer); + procedure ForEachCall(proc2call:TListStaticCallback;arg:pointer); + 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; + + +{******************************************************* + TFPObjectList (From fcl/inc/contnrs.pp) +********************************************************} + + TObjectListCallback = procedure(data:TObject;arg:pointer) of object; + TObjectListStaticCallback = procedure(data:TObject;arg:pointer); + + TFPObjectList = class(TObject) + private + FFreeObjects : Boolean; + FList: TFPList; + function GetCount: integer; {$ifdef CCLASSESINLINE}inline;{$endif} + procedure SetCount(const AValue: integer); + protected + function GetItem(Index: Integer): TObject; {$ifdef CCLASSESINLINE}inline;{$endif} + procedure SetItem(Index: Integer; AObject: TObject); + procedure SetCapacity(NewCapacity: Integer); {$ifdef CCLASSESINLINE}inline;{$endif} + function GetCapacity: integer; {$ifdef CCLASSESINLINE}inline;{$endif} + public + constructor Create; + constructor Create(FreeObjects : Boolean); + destructor Destroy; override; + procedure Clear; + function Add(AObject: TObject): Integer; {$ifdef CCLASSESINLINE}inline;{$endif} + procedure Delete(Index: Integer); + procedure Exchange(Index1, Index2: Integer); {$ifdef CCLASSESINLINE}inline;{$endif} + function Expand: TFPObjectList;{$ifdef CCLASSESINLINE}inline;{$endif} + function Extract(Item: TObject): TObject; {$ifdef CCLASSESINLINE}inline;{$endif} + function Remove(AObject: TObject): Integer; + function IndexOf(AObject: TObject): Integer; {$ifdef CCLASSESINLINE}inline;{$endif} + function FindInstanceOf(AClass: TClass; AExact: Boolean; AStartAt: Integer): Integer; + procedure Insert(Index: Integer; AObject: TObject); {$ifdef CCLASSESINLINE}inline;{$endif} + function First: TObject; {$ifdef CCLASSESINLINE}inline;{$endif} + function Last: TObject; {$ifdef CCLASSESINLINE}inline;{$endif} + procedure Move(CurIndex, NewIndex: Integer); {$ifdef CCLASSESINLINE}inline;{$endif} + procedure Assign(Obj:TFPObjectList); + procedure Pack; {$ifdef CCLASSESINLINE}inline;{$endif} + procedure Sort(Compare: TListSortCompare); {$ifdef CCLASSESINLINE}inline;{$endif} + procedure ForEachCall(proc2call:TObjectListCallback;arg:pointer); {$ifdef CCLASSESINLINE}inline;{$endif} + procedure ForEachCall(proc2call:TObjectListStaticCallback;arg:pointer); {$ifdef CCLASSESINLINE}inline;{$endif} + property Capacity: Integer read GetCapacity write SetCapacity; + property Count: Integer read GetCount write SetCount; + property OwnsObjects: Boolean read FFreeObjects write FFreeObjects; + property Items[Index: Integer]: TObject read GetItem write SetItem; default; + property List: TFPList read FList; + end; + +type + THashItem=record + HashValue : LongWord; + StrIndex : Integer; + NextIndex : Integer; + Data : Pointer; + end; + PHashItem=^THashItem; + +const + MaxHashListSize = Maxint div 16; + MaxHashStrSize = Maxint; + MaxHashTableSize = Maxint div 4; + MaxItemsPerHash = 3; + +type + PHashItemList = ^THashItemList; + THashItemList = array[0..MaxHashListSize - 1] of THashItem; + PHashTable = ^THashTable; + THashTable = array[0..MaxHashTableSize - 1] of Integer; + + TFPHashList = class(TObject) + private + { ItemList } + FHashList : PHashItemList; + FCount, + FCapacity : Integer; + FCapacityMask: LongWord; + { Hash } + FHashTable : PHashTable; + FHashCapacity : Integer; + { Strings } + FStrs : PChar; + FStrCount, + FStrCapacity : Integer; + function InternalFind(AHash:LongWord;const AName:shortstring;out PrevIndex:Integer):Integer; + protected + function Get(Index: Integer): Pointer; + procedure Put(Index: Integer; Item: Pointer); + procedure SetCapacity(NewCapacity: Integer); + procedure SetCount(NewCount: Integer); + Procedure RaiseIndexError(Index : Integer); + function AddStr(const s:shortstring): Integer; + procedure AddToHashTable(Index: Integer); + procedure StrExpand(MinIncSize:Integer); + procedure SetStrCapacity(NewCapacity: Integer); + procedure SetHashCapacity(NewCapacity: Integer); + procedure ReHash; + public + constructor Create; + destructor Destroy; override; + function Add(const AName:shortstring;Item: Pointer): Integer; + procedure Clear; + function NameOfIndex(Index: Integer): ShortString; + function HashOfIndex(Index: Integer): LongWord; + function GetNextCollision(Index: Integer): Integer; + procedure Delete(Index: Integer); + class procedure Error(const Msg: string; Data: PtrInt); + function Expand: TFPHashList; + function Extract(item: Pointer): Pointer; + function IndexOf(Item: Pointer): Integer; + function Find(const AName:shortstring): Pointer; + function FindIndexOf(const AName:shortstring): Integer; + function FindWithHash(const AName:shortstring;AHash:LongWord): Pointer; + function Rename(const AOldName,ANewName:shortstring): Integer; + function Remove(Item: Pointer): Integer; + procedure Pack; + procedure ShowStatistics; + procedure ForEachCall(proc2call:TListCallback;arg:pointer); + procedure ForEachCall(proc2call:TListStaticCallback;arg:pointer); + 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: PHashItemList read FHashList; + property Strs: PChar read FStrs; + end; + + +{******************************************************* + TFPHashObjectList (From fcl/inc/contnrs.pp) +********************************************************} + + TFPHashObjectList = class; + + { TFPHashObject } + + TFPHashObject = class + private + FOwner : TFPHashObjectList; + FCachedStr : pshortstring; + FStrIndex : Integer; + procedure InternalChangeOwner(HashObjectList:TFPHashObjectList;const s:shortstring); + protected + function GetName:shortstring;virtual; + function GetHash:Longword;virtual; + public + constructor CreateNotOwned; + constructor Create(HashObjectList:TFPHashObjectList;const s:shortstring); + procedure ChangeOwner(HashObjectList:TFPHashObjectList); + procedure ChangeOwnerAndName(HashObjectList:TFPHashObjectList;const s:shortstring); {$ifdef CCLASSESINLINE}inline;{$endif} + procedure Rename(const ANewName:shortstring); + property Name:shortstring read GetName; + property Hash:Longword read GetHash; + end; + + TFPHashObjectList = class(TObject) + private + FFreeObjects : Boolean; + FHashList: TFPHashList; + function GetCount: integer; {$ifdef CCLASSESINLINE}inline;{$endif} + procedure SetCount(const AValue: integer); + protected + function GetItem(Index: Integer): TObject; {$ifdef CCLASSESINLINE}inline;{$endif} + procedure SetItem(Index: Integer; AObject: TObject); + procedure SetCapacity(NewCapacity: Integer); {$ifdef CCLASSESINLINE}inline;{$endif} + function GetCapacity: integer; {$ifdef CCLASSESINLINE}inline;{$endif} + public + constructor Create(FreeObjects : boolean = True); + destructor Destroy; override; + procedure Clear; + function Add(const AName:shortstring;AObject: TObject): Integer; {$ifdef CCLASSESINLINE}inline;{$endif} + function NameOfIndex(Index: Integer): ShortString; {$ifdef CCLASSESINLINE}inline;{$endif} + function HashOfIndex(Index: Integer): LongWord; {$ifdef CCLASSESINLINE}inline;{$endif} + function GetNextCollision(Index: Integer): Integer; {$ifdef CCLASSESINLINE}inline;{$endif} + procedure Delete(Index: Integer); + function Expand: TFPHashObjectList; {$ifdef CCLASSESINLINE}inline;{$endif} + function Extract(Item: TObject): TObject; {$ifdef CCLASSESINLINE}inline;{$endif} + function Remove(AObject: TObject): Integer; + function IndexOf(AObject: TObject): Integer; {$ifdef CCLASSESINLINE}inline;{$endif} + function Find(const s:shortstring): TObject; {$ifdef CCLASSESINLINE}inline;{$endif} + function FindIndexOf(const s:shortstring): Integer; {$ifdef CCLASSESINLINE}inline;{$endif} + function FindWithHash(const AName:shortstring;AHash:LongWord): Pointer; + function Rename(const AOldName,ANewName:shortstring): Integer; {$ifdef CCLASSESINLINE}inline;{$endif} + function FindInstanceOf(AClass: TClass; AExact: Boolean; AStartAt: Integer): Integer; + procedure Pack; {$ifdef CCLASSESINLINE}inline;{$endif} + procedure ShowStatistics; {$ifdef CCLASSESINLINE}inline;{$endif} + procedure ForEachCall(proc2call:TObjectListCallback;arg:pointer); {$ifdef CCLASSESINLINE}inline;{$endif} + procedure ForEachCall(proc2call:TObjectListStaticCallback;arg:pointer); {$ifdef CCLASSESINLINE}inline;{$endif} + property Capacity: Integer read GetCapacity write SetCapacity; + property Count: Integer read GetCount write SetCount; + property OwnsObjects: Boolean read FFreeObjects write FFreeObjects; + property Items[Index: Integer]: TObject read GetItem write SetItem; default; + property List: TFPHashList read FHashList; + 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; {$ifdef CCLASSESINLINE}inline;{$endif} + { 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; + +{******************************************** + TCmdStrList +********************************************} + + { string containerItem } + TCmdStrListItem = class(TLinkedListItem) + FPStr : TCmdStr; + public + constructor Create(const s:TCmdStr); + destructor Destroy;override; + function GetCopy:TLinkedListItem;override; + function Str:TCmdStr; {$ifdef CCLASSESINLINE}inline;{$endif} + end; + + { string container } + TCmdStrList = 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:TCmdStr); + { concats an Item } + procedure Concat(const s:TCmdStr); + { deletes an Item } + procedure Remove(const s:TCmdStr); + { Gets First Item } + function GetFirst:TCmdStr; + { Gets last Item } + function GetLast:TCmdStr; + { true if string is in the container, compare case sensitive } + function FindCase(const s:TCmdStr):TCmdStrListItem; + { true if string is in the container } + function Find(const s:TCmdStr):TCmdStrListItem; + { inserts an item } + procedure InsertItem(item:TCmdStrListItem); {$ifdef CCLASSESINLINE}inline;{$endif} + { concats an item } + procedure ConcatItem(item:TCmdStrListItem); {$ifdef CCLASSESINLINE}inline;{$endif} + property Doubles:boolean read FDoubles write FDoubles; + end; + + +{******************************************** + DynamicArray +********************************************} + + type + { can't use sizeof(integer) because it crashes gdb } + tdynamicblockdata=array[0..1024*1024-1] of byte; + + pdynamicblock = ^tdynamicblock; + tdynamicblock = record + pos, + size, + used : longword; + Next : pdynamicblock; + data : tdynamicblockdata; + end; + + const + dynamicblockbasesize = sizeof(tdynamicblock)-sizeof(tdynamicblockdata); + mindynamicblocksize = 8*sizeof(pointer); + + type + tdynamicarray = class + private + FPosn : longword; + FPosnblock : pdynamicblock; + FCurrBlocksize, + FMaxBlocksize : longword; + FFirstblock, + FLastblock : pdynamicblock; + procedure grow; + public + constructor Create(Ablocksize:longword); + destructor Destroy;override; + procedure reset; + function size:longword; + procedure align(i:longword); + procedure seek(i:longword); + function read(var d;len:longword):longword; + procedure write(const d;len:longword); + procedure writestr(const s:string); {$ifdef CCLASSESINLINE}inline;{$endif} + procedure readstream(f:TCStream;maxlen:longword); + procedure writestream(f:TCStream); + property CurrBlockSize : longword read FCurrBlocksize; + property FirstBlock : PDynamicBlock read FFirstBlock; + property Pos : longword read FPosn; + end; + + +{****************************************************************** + THashSet (keys not limited to ShortString, no indexed access) +*******************************************************************} + + PPHashSetItem = ^PHashSetItem; + PHashSetItem = ^THashSetItem; + THashSetItem = record + Next: PHashSetItem; + Key: Pointer; + KeyLength: Integer; + HashValue: LongWord; + Data: TObject; + end; + + THashSet = class(TObject) + private + FCount: LongWord; + FOwnsObjects: Boolean; + FOwnsKeys: Boolean; + function Lookup(Key: Pointer; KeyLen: Integer; var Found: Boolean; + CanCreate: Boolean): PHashSetItem; + procedure Resize(NewCapacity: LongWord); + protected + FBucket: PPHashSetItem; + FBucketCount: LongWord; + class procedure FreeItem(item:PHashSetItem); virtual; + class function SizeOfItem: Integer; virtual; + public + constructor Create(InitSize: Integer; OwnKeys, OwnObjects: Boolean); + destructor Destroy; override; + procedure Clear; + { finds an entry by key } + function Find(Key: Pointer; KeyLen: Integer): PHashSetItem; + { finds an entry, creates one if not exists } + function FindOrAdd(Key: Pointer; KeyLen: Integer; + var Found: Boolean): PHashSetItem; + { finds an entry, creates one if not exists } + function FindOrAdd(Key: Pointer; KeyLen: Integer): PHashSetItem; + { returns Data by given Key } + function Get(Key: Pointer; KeyLen: Integer): TObject; + { removes an entry, returns False if entry wasn't there } + function Remove(Entry: PHashSetItem): Boolean; + property Count: LongWord read FCount; + end; + +{****************************************************************** + TTagHasSet +*******************************************************************} + PPTagHashSetItem = ^PTagHashSetItem; + PTagHashSetItem = ^TTagHashSetItem; + TTagHashSetItem = record + Next: PTagHashSetItem; + Key: Pointer; + KeyLength: Integer; + HashValue: LongWord; + Data: TObject; + Tag: LongWord; + end; + + TTagHashSet = class(THashSet) + private + function Lookup(Key: Pointer; KeyLen: Integer; Tag: LongWord; var Found: Boolean; + CanCreate: Boolean): PTagHashSetItem; + protected + class procedure FreeItem(item:PHashSetItem); override; + class function SizeOfItem: Integer; override; + public + { finds an entry by key } + function Find(Key: Pointer; KeyLen: Integer; Tag: LongWord): PTagHashSetItem; reintroduce; + { finds an entry, creates one if not exists } + function FindOrAdd(Key: Pointer; KeyLen: Integer; Tag: LongWord; + var Found: Boolean): PTagHashSetItem; reintroduce; + { finds an entry, creates one if not exists } + function FindOrAdd(Key: Pointer; KeyLen: Integer; Tag: LongWord): PTagHashSetItem; reintroduce; + { returns Data by given Key } + function Get(Key: Pointer; KeyLen: Integer; Tag: LongWord): TObject; reintroduce; + end; + + +{****************************************************************** + tbitset +*******************************************************************} + + tbitset = class + private + fdata: pbyte; + fdatasize: longint; + public + constructor create(initsize: longint); + constructor create_bytesize(bytesize: longint); + destructor destroy; override; + procedure clear; + procedure grow(nsize: longint); + { sets a bit } + procedure include(index: longint); + { clears a bit } + procedure exclude(index: longint); + { finds an entry, creates one if not exists } + function isset(index: longint): boolean; + + procedure addset(aset: tbitset); + procedure subset(aset: tbitset); + + property data: pbyte read fdata; + property datasize: longint read fdatasize; + end; + + + function FPHash(const s:shortstring):LongWord; + function FPHash(P: PChar; Len: Integer): LongWord; + function FPHash(P: PChar; Len: Integer; Tag: LongWord): LongWord; + + +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; + + +{***************************************************************************** + TFPObjectList (Copied from rtl/objpas/classes/lists.inc) +*****************************************************************************} + +procedure TFPList.RaiseIndexError(Index : Integer); +begin + Error(SListIndexError, Index); +end; + +function TFPList.Get(Index: Integer): Pointer; +begin + If (Index < 0) or (Index >= FCount) then + RaiseIndexError(Index); + Result:=FList^[Index]; +end; + +procedure TFPList.Put(Index: Integer; Item: Pointer); +begin + if (Index < 0) or (Index >= FCount) then + RaiseIndexError(Index); + Flist^[Index] := Item; +end; + +function TFPList.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 TFPList.SetCapacity(NewCapacity: Integer); +begin + If (NewCapacity < FCount) or (NewCapacity > MaxListSize) then + Error (SListCapacityError, NewCapacity); + if NewCapacity = FCapacity then + exit; + ReallocMem(FList, SizeOf(Pointer)*NewCapacity); + FCapacity := NewCapacity; +end; + +procedure TFPList.SetCount(NewCount: Integer); +begin + if (NewCount < 0) or (NewCount > MaxListSize)then + Error(SListCountError, NewCount); + If NewCount > FCount then + begin + If NewCount > FCapacity then + SetCapacity(NewCount); + If FCount < NewCount then + FillChar(Flist^[FCount], (NewCount-FCount) * sizeof(Pointer), 0); + end; + FCount := Newcount; +end; + +destructor TFPList.Destroy; +begin + Self.Clear; + inherited Destroy; +end; + +function TFPList.Add(Item: Pointer): Integer; +begin + if FCount = FCapacity then + Self.Expand; + FList^[FCount] := Item; + Result := FCount; + inc(FCount); +end; + +procedure TFPList.Clear; +begin + if Assigned(FList) then + begin + SetCount(0); + SetCapacity(0); + FList := nil; + end; +end; + +procedure TFPList.Delete(Index: Integer); +begin + If (Index<0) or (Index>=FCount) then + Error (SListIndexError, Index); + dec(FCount); + System.Move (FList^[Index+1], FList^[Index], (FCount - Index) * SizeOf(Pointer)); + { Shrink the list if appropriate } + if (FCapacity > 256) and (FCount < FCapacity shr 2) then + begin + FCapacity := FCapacity shr 1; + ReallocMem(FList, SizeOf(Pointer) * FCapacity); + end; +end; + +class procedure TFPList.Error(const Msg: string; Data: PtrInt); +begin + Raise EListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame); +end; + +procedure TFPList.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 TFPList.Expand: TFPList; +var + IncSize : Longint; +begin + Result := Self; + if FCount < FCapacity then + exit; + IncSize := sizeof(ptrint)*2; + if FCapacity > 127 then + Inc(IncSize, FCapacity shr 2) + else if FCapacity > sizeof(ptrint)*4 then + Inc(IncSize, FCapacity shr 1) + else if FCapacity >= sizeof(ptrint) then + inc(IncSize,sizeof(ptrint)); + SetCapacity(FCapacity + IncSize); +end; + +function TFPList.First: Pointer; +begin + If FCount<>0 then + Result := Items[0] + else + Result := Nil; +end; + +function TFPList.IndexOf(Item: Pointer): Integer; +var + psrc : PPointer; + Index : Integer; +begin + Result:=-1; + psrc:=@FList^[0]; + For Index:=0 To FCount-1 Do + begin + if psrc^=Item then + begin + Result:=Index; + exit; + end; + inc(psrc); + end; +end; + +procedure TFPList.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 TFPList.Last: Pointer; +begin + If FCount<>0 then + Result := Items[FCount - 1] + else + Result := nil +end; + +procedure TFPList.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); + Self.Insert(NewIndex, nil); + FList^[NewIndex] := Temp; +end; + +function TFPList.Remove(Item: Pointer): Integer; +begin + Result := IndexOf(Item); + If Result <> -1 then + Self.Delete(Result); +end; + +procedure TFPList.Pack; +var + NewCount, + i : integer; + pdest, + psrc : PPointer; +begin + NewCount:=0; + psrc:=@FList^[0]; + pdest:=psrc; + For I:=0 To FCount-1 Do + begin + if assigned(psrc^) then + begin + pdest^:=psrc^; + inc(pdest); + inc(NewCount); + end; + inc(psrc); + end; + FCount:=NewCount; +end; + + +Procedure QuickSort(FList: PPointerList; L, R : Longint;Compare: TListSortCompare); +var + I, J, P: Longint; + PItem, Q : Pointer; +begin + repeat + I := L; + J := R; + P := (L + R) div 2; + repeat + PItem := FList^[P]; + while Compare(PItem, FList^[i]) > 0 do + I := I + 1; + while Compare(PItem, FList^[J]) < 0 do + J := J - 1; + If I <= J then + begin + Q := FList^[I]; + Flist^[I] := FList^[J]; + FList^[J] := Q; + if P = I then + P := J + else if P = J then + P := I; + 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 TFPList.Sort(Compare: TListSortCompare); +begin + if Not Assigned(FList) or (FCount < 2) then exit; + QuickSort(Flist, 0, FCount-1, Compare); +end; + +procedure TFPList.Assign(Obj: TFPList); +var + i: Integer; +begin + Clear; + for I := 0 to Obj.Count - 1 do + Add(Obj[i]); +end; + + +procedure TFPList.ForEachCall(proc2call:TListCallback;arg:pointer); +var + i : integer; + p : pointer; +begin + For I:=0 To Count-1 Do + begin + p:=FList^[i]; + if assigned(p) then + proc2call(p,arg); + end; +end; + + +procedure TFPList.ForEachCall(proc2call:TListStaticCallback;arg:pointer); +var + i : integer; + p : pointer; +begin + For I:=0 To Count-1 Do + begin + p:=FList^[i]; + if assigned(p) then + proc2call(p,arg); + end; +end; + + +{***************************************************************************** + TFPObjectList (Copied from rtl/objpas/classes/lists.inc) +*****************************************************************************} + +constructor TFPObjectList.Create(FreeObjects : boolean); +begin + Create; + FFreeObjects := Freeobjects; +end; + +destructor TFPObjectList.Destroy; +begin + if (FList <> nil) then + begin + Clear; + FList.Destroy; + end; + inherited Destroy; +end; + +procedure TFPObjectList.Clear; +var + i: integer; +begin + if FFreeObjects then + for i := 0 to FList.Count - 1 do + TObject(FList[i]).Free; + FList.Clear; +end; + +constructor TFPObjectList.Create; +begin + inherited Create; + FList := TFPList.Create; + FFreeObjects := True; +end; + +function TFPObjectList.GetCount: integer; +begin + Result := FList.Count; +end; + +procedure TFPObjectList.SetCount(const AValue: integer); +begin + if FList.Count <> AValue then + FList.Count := AValue; +end; + +function TFPObjectList.GetItem(Index: Integer): TObject; +begin + Result := TObject(FList[Index]); +end; + +procedure TFPObjectList.SetItem(Index: Integer; AObject: TObject); +begin + if OwnsObjects then + TObject(FList[Index]).Free; + FList[index] := AObject; +end; + +procedure TFPObjectList.SetCapacity(NewCapacity: Integer); +begin + FList.Capacity := NewCapacity; +end; + +function TFPObjectList.GetCapacity: integer; +begin + Result := FList.Capacity; +end; + +function TFPObjectList.Add(AObject: TObject): Integer; +begin + Result := FList.Add(AObject); +end; + +procedure TFPObjectList.Delete(Index: Integer); +begin + if OwnsObjects then + TObject(FList[Index]).Free; + FList.Delete(Index); +end; + +procedure TFPObjectList.Exchange(Index1, Index2: Integer); +begin + FList.Exchange(Index1, Index2); +end; + +function TFPObjectList.Expand: TFPObjectList; +begin + FList.Expand; + Result := Self; +end; + +function TFPObjectList.Extract(Item: TObject): TObject; +begin + Result := TObject(FList.Extract(Item)); +end; + +function TFPObjectList.Remove(AObject: TObject): Integer; +begin + Result := IndexOf(AObject); + if (Result <> -1) then + begin + if OwnsObjects then + TObject(FList[Result]).Free; + FList.Delete(Result); + end; +end; + +function TFPObjectList.IndexOf(AObject: TObject): Integer; +begin + Result := FList.IndexOf(Pointer(AObject)); +end; + +function TFPObjectList.FindInstanceOf(AClass: TClass; AExact: Boolean; AStartAt : Integer): Integer; +var + I : Integer; +begin + I:=AStartAt; + Result:=-1; + If AExact then + while (I<Count) and (Result=-1) do + If Items[i].ClassType=AClass then + Result:=I + else + Inc(I) + else + while (I<Count) and (Result=-1) do + If Items[i].InheritsFrom(AClass) then + Result:=I + else + Inc(I); +end; + +procedure TFPObjectList.Insert(Index: Integer; AObject: TObject); +begin + FList.Insert(Index, Pointer(AObject)); +end; + +procedure TFPObjectList.Move(CurIndex, NewIndex: Integer); +begin + FList.Move(CurIndex, NewIndex); +end; + +procedure TFPObjectList.Assign(Obj: TFPObjectList); +var + i: Integer; +begin + Clear; + for I := 0 to Obj.Count - 1 do + Add(Obj[i]); +end; + +procedure TFPObjectList.Pack; +begin + FList.Pack; +end; + +procedure TFPObjectList.Sort(Compare: TListSortCompare); +begin + FList.Sort(Compare); +end; + +function TFPObjectList.First: TObject; +begin + Result := TObject(FList.First); +end; + +function TFPObjectList.Last: TObject; +begin + Result := TObject(FList.Last); +end; + +procedure TFPObjectList.ForEachCall(proc2call:TObjectListCallback;arg:pointer); +begin + FList.ForEachCall(TListCallBack(proc2call),arg); +end; + +procedure TFPObjectList.ForEachCall(proc2call:TObjectListStaticCallback;arg:pointer); +begin + FList.ForEachCall(TListStaticCallBack(proc2call),arg); +end; + + +{***************************************************************************** + TFPHashList +*****************************************************************************} + + function FPHash(const s:shortstring):LongWord; + Var + p,pmax : pchar; + begin +{$push} +{$q-,r-} + result:=0; + p:=@s[1]; + pmax:=@s[length(s)+1]; + while (p<pmax) do + begin + result:=LongWord(LongInt(result shl 5) - LongInt(result)) xor LongWord(P^); + inc(p); + end; +{$pop} + end; + + function FPHash(P: PChar; Len: Integer): LongWord; + Var + pmax : pchar; + begin +{$push} +{$q-,r-} + result:=0; + pmax:=p+len; + while (p<pmax) do + begin + result:=LongWord(LongInt(result shl 5) - LongInt(result)) xor LongWord(P^); + inc(p); + end; +{$pop} + end; + + function FPHash(P: PChar; Len: Integer; Tag: LongWord): LongWord; + Var + pmax : pchar; + begin +{$push} +{$q-,r-} + result:=Tag; + pmax:=p+len; + while (p<pmax) do + begin + result:=LongWord(LongInt(result shl 5) - LongInt(result)) xor LongWord(P^); + inc(p); + end; +{$pop} + end; + +procedure TFPHashList.RaiseIndexError(Index : Integer); +begin + Error(SListIndexError, Index); +end; + + +function TFPHashList.Get(Index: Integer): Pointer; +begin + If (Index < 0) or (Index >= FCount) then + RaiseIndexError(Index); + Result:=FHashList^[Index].Data; +end; + + +procedure TFPHashList.Put(Index: Integer; Item: Pointer); +begin + if (Index < 0) or (Index >= FCount) then + RaiseIndexError(Index); + FHashList^[Index].Data:=Item; +end; + + +function TFPHashList.NameOfIndex(Index: Integer): shortstring; +begin + If (Index < 0) or (Index >= FCount) then + RaiseIndexError(Index); + with FHashList^[Index] do + begin + if StrIndex>=0 then + Result:=PShortString(@FStrs[StrIndex])^ + else + Result:=''; + end; +end; + + +function TFPHashList.HashOfIndex(Index: Integer): LongWord; +begin + If (Index < 0) or (Index >= FCount) then + RaiseIndexError(Index); + Result:=FHashList^[Index].HashValue; +end; + + +function TFPHashList.GetNextCollision(Index: Integer): Integer; +begin + Result:=-1; + if ((Index > -1) and (Index < FCount)) then + Result:=FHashList^[Index].NextIndex; +end; + + +function TFPHashList.Extract(item: Pointer): Pointer; +var + i : Integer; +begin + result := nil; + i := IndexOf(item); + if i >= 0 then + begin + Result := item; + Delete(i); + end; +end; + + +procedure TFPHashList.SetCapacity(NewCapacity: Integer); +var + power: longint; +begin + { use a power of two to be able to quickly calculate the hash table index } + if NewCapacity <> 0 then + NewCapacity := nextpowerof2((NewCapacity+(MaxItemsPerHash-1)) div MaxItemsPerHash, power) * MaxItemsPerHash; + if (NewCapacity < FCount) or (NewCapacity > MaxHashListSize) then + Error (SListCapacityError, NewCapacity); + if NewCapacity = FCapacity then + exit; + ReallocMem(FHashList, NewCapacity*SizeOf(THashItem)); + FCapacity := NewCapacity; + { Maybe expand hash also } + if FCapacity>FHashCapacity*MaxItemsPerHash then + SetHashCapacity(FCapacity div MaxItemsPerHash); +end; + + +procedure TFPHashList.SetCount(NewCount: Integer); +begin + if (NewCount < 0) or (NewCount > MaxHashListSize)then + Error(SListCountError, NewCount); + If NewCount > FCount then + begin + If NewCount > FCapacity then + SetCapacity(NewCount); + If FCount < NewCount then + { FCapacity is NewCount rounded up to the next power of 2 } + FillChar(FHashList^[FCount], (FCapacity-FCount) div Sizeof(THashItem), 0); + end; + FCount := Newcount; +end; + + +procedure TFPHashList.SetStrCapacity(NewCapacity: Integer); +begin +{$push}{$warnings off} + If (NewCapacity < FStrCount) or (NewCapacity > MaxHashStrSize) then + Error (SListCapacityError, NewCapacity); +{$pop} + if NewCapacity = FStrCapacity then + exit; + ReallocMem(FStrs, NewCapacity); + FStrCapacity := NewCapacity; +end; + + +procedure TFPHashList.SetHashCapacity(NewCapacity: Integer); +var + power: longint; +begin + If (NewCapacity < 1) then + Error (SListCapacityError, NewCapacity); + if FHashCapacity=NewCapacity then + exit; + if (NewCapacity<>0) and + not ispowerof2(NewCapacity,power) then + Error(SListCapacityPower2Error, NewCapacity); + FHashCapacity:=NewCapacity; + ReallocMem(FHashTable, FHashCapacity*sizeof(Integer)); + FCapacityMask:=(1 shl power)-1; + ReHash; +end; + + +procedure TFPHashList.ReHash; +var + i : Integer; +begin + FillDword(FHashTable^,FHashCapacity,LongWord(-1)); + For i:=0 To FCount-1 Do + AddToHashTable(i); +end; + + +constructor TFPHashList.Create; +begin + SetHashCapacity(1); +end; + + +destructor TFPHashList.Destroy; +begin + Clear; + if assigned(FHashTable) then + FreeMem(FHashTable); + inherited Destroy; +end; + + +function TFPHashList.AddStr(const s:shortstring): Integer; +var + Len : Integer; +begin + len:=length(s)+1; + if FStrCount+Len >= FStrCapacity then + StrExpand(Len); + System.Move(s[0],FStrs[FStrCount],Len); + result:=FStrCount; + inc(FStrCount,Len); +end; + + +procedure TFPHashList.AddToHashTable(Index: Integer); +var + HashIndex : Integer; +begin + with FHashList^[Index] do + begin + if not assigned(Data) then + exit; + HashIndex:=HashValue and FCapacityMask; + NextIndex:=FHashTable^[HashIndex]; + FHashTable^[HashIndex]:=Index; + end; +end; + + +function TFPHashList.Add(const AName:shortstring;Item: Pointer): Integer; +begin + if FCount = FCapacity then + Expand; + with FHashList^[FCount] do + begin + HashValue:=FPHash(AName); + Data:=Item; + StrIndex:=AddStr(AName); + end; + AddToHashTable(FCount); + Result := FCount; + inc(FCount); +end; + +procedure TFPHashList.Clear; +begin + if Assigned(FHashList) then + begin + FCount:=0; + SetCapacity(0); + FHashList := nil; + end; + SetHashCapacity(1); + FHashTable^[0]:=-1; // sethashcapacity does not always call rehash + if Assigned(FStrs) then + begin + FStrCount:=0; + SetStrCapacity(0); + FStrs := nil; + end; +end; + +procedure TFPHashList.Delete(Index: Integer); +begin + If (Index<0) or (Index>=FCount) then + Error (SListIndexError, Index); + { Remove from HashList } + dec(FCount); + System.Move (FHashList^[Index+1], FHashList^[Index], (FCount - Index) * Sizeof(THashItem)); + { All indexes are updated, we need to build the hashtable again } + Rehash; + { Shrink the list if appropriate } + if (FCapacity > 256) and (FCount < FCapacity shr 2) then + begin + FCapacity := FCapacity shr 1; + ReallocMem(FHashList, Sizeof(THashItem) * FCapacity); + end; +end; + +function TFPHashList.Remove(Item: Pointer): Integer; +begin + Result := IndexOf(Item); + If Result <> -1 then + Self.Delete(Result); +end; + +class procedure TFPHashList.Error(const Msg: string; Data: PtrInt); +begin + Raise EListError.CreateFmt(Msg,[Data]) at get_caller_addr(get_frame); +end; + +function TFPHashList.Expand: TFPHashList; +var + IncSize : Longint; +begin + Result := Self; + if FCount < FCapacity then + exit; + IncSize := sizeof(ptrint)*2; + SetCapacity(FCapacity + IncSize); +end; + +procedure TFPHashList.StrExpand(MinIncSize:Integer); +var + IncSize : Longint; +begin + if FStrCount+MinIncSize < FStrCapacity then + exit; + IncSize := 64; + if FStrCapacity > 255 then + Inc(IncSize, FStrCapacity shr 2); + SetStrCapacity(FStrCapacity + IncSize + MinIncSize); +end; + +function TFPHashList.IndexOf(Item: Pointer): Integer; +var + psrc : PHashItem; + Index : integer; +begin + Result:=-1; + psrc:=@FHashList^[0]; + For Index:=0 To FCount-1 Do + begin + if psrc^.Data=Item then + begin + Result:=Index; + exit; + end; + inc(psrc); + end; +end; + +function TFPHashList.InternalFind(AHash:LongWord;const AName:shortstring;out PrevIndex:Integer):Integer; +begin + prefetch(AName); + Result:=FHashTable^[AHash and FCapacityMask]; + PrevIndex:=-1; + while Result<>-1 do + begin + with FHashList^[Result] do + begin + if assigned(Data) and + (HashValue=AHash) and + (AName=PShortString(@FStrs[StrIndex])^) then + exit; + PrevIndex:=Result; + Result:=NextIndex; + end; + end; +end; + + +function TFPHashList.Find(const AName:shortstring): Pointer; +var + Index, + PrevIndex : Integer; +begin + Result:=nil; + Index:=InternalFind(FPHash(AName),AName,PrevIndex); + if Index=-1 then + exit; + Result:=FHashList^[Index].Data; +end; + + +function TFPHashList.FindIndexOf(const AName:shortstring): Integer; +var + PrevIndex : Integer; +begin + Result:=InternalFind(FPHash(AName),AName,PrevIndex); +end; + + +function TFPHashList.FindWithHash(const AName:shortstring;AHash:LongWord): Pointer; +var + Index, + PrevIndex : Integer; +begin + Result:=nil; + Index:=InternalFind(AHash,AName,PrevIndex); + if Index=-1 then + exit; + Result:=FHashList^[Index].Data; +end; + + +function TFPHashList.Rename(const AOldName,ANewName:shortstring): Integer; +var + PrevIndex, + Index : Integer; + OldHash : LongWord; +begin + Result:=-1; + OldHash:=FPHash(AOldName); + Index:=InternalFind(OldHash,AOldName,PrevIndex); + if Index=-1 then + exit; + { Remove from current Hash } + if PrevIndex<>-1 then + FHashList^[PrevIndex].NextIndex:=FHashList^[Index].NextIndex + else + FHashTable^[OldHash and FCapacityMask]:=FHashList^[Index].NextIndex; + { Set new name and hash } + with FHashList^[Index] do + begin + HashValue:=FPHash(ANewName); + StrIndex:=AddStr(ANewName); + end; + { Insert back in Hash } + AddToHashTable(Index); + { Return Index } + Result:=Index; +end; + +procedure TFPHashList.Pack; +var + NewCount, + i : integer; + pdest, + psrc : PHashItem; +begin + NewCount:=0; + psrc:=@FHashList^[0]; + pdest:=psrc; + For I:=0 To FCount-1 Do + begin + if assigned(psrc^.Data) then + begin + pdest^:=psrc^; + inc(pdest); + inc(NewCount); + end; + inc(psrc); + end; + FCount:=NewCount; + { We need to ReHash to update the IndexNext } + ReHash; + { Release over-capacity } + SetCapacity(FCount); + SetStrCapacity(FStrCount); +end; + + +procedure TFPHashList.ShowStatistics; +var + HashMean, + HashStdDev : Double; + Index, + i,j : Integer; +begin + { Calculate Mean and StdDev } + HashMean:=0; + HashStdDev:=0; + for i:=0 to FHashCapacity-1 do + begin + j:=0; + Index:=FHashTable^[i]; + while (Index<>-1) do + begin + inc(j); + Index:=FHashList^[Index].NextIndex; + end; + HashMean:=HashMean+j; + HashStdDev:=HashStdDev+Sqr(j); + end; + HashMean:=HashMean/FHashCapacity; + HashStdDev:=(HashStdDev-FHashCapacity*Sqr(HashMean)); + If FHashCapacity>1 then + HashStdDev:=Sqrt(HashStdDev/(FHashCapacity-1)) + else + HashStdDev:=0; + { Print info to stdout } + Writeln('HashSize : ',FHashCapacity); + Writeln('HashMean : ',HashMean:1:4); + Writeln('HashStdDev : ',HashStdDev:1:4); + Writeln('ListSize : ',FCount,'/',FCapacity); + Writeln('StringSize : ',FStrCount,'/',FStrCapacity); +end; + + +procedure TFPHashList.ForEachCall(proc2call:TListCallback;arg:pointer); +var + i : integer; + p : pointer; +begin + For I:=0 To Count-1 Do + begin + p:=FHashList^[i].Data; + if assigned(p) then + proc2call(p,arg); + end; +end; + + +procedure TFPHashList.ForEachCall(proc2call:TListStaticCallback;arg:pointer); +var + i : integer; + p : pointer; +begin + For I:=0 To Count-1 Do + begin + p:=FHashList^[i].Data; + if assigned(p) then + proc2call(p,arg); + end; +end; + + +{***************************************************************************** + TFPHashObject +*****************************************************************************} + +procedure TFPHashObject.InternalChangeOwner(HashObjectList:TFPHashObjectList;const s:shortstring); +var + Index : integer; +begin + FOwner:=HashObjectList; + Index:=HashObjectList.Add(s,Self); + FStrIndex:=HashObjectList.List.List^[Index].StrIndex; + FCachedStr:=PShortString(@FOwner.List.Strs[FStrIndex]); +end; + + +constructor TFPHashObject.CreateNotOwned; +begin + FStrIndex:=-1; +end; + + +constructor TFPHashObject.Create(HashObjectList:TFPHashObjectList;const s:shortstring); +begin + InternalChangeOwner(HashObjectList,s); +end; + + +procedure TFPHashObject.ChangeOwner(HashObjectList:TFPHashObjectList); +begin + InternalChangeOwner(HashObjectList,PShortString(@FOwner.List.Strs[FStrIndex])^); +end; + + +procedure TFPHashObject.ChangeOwnerAndName(HashObjectList:TFPHashObjectList;const s:shortstring); +begin + InternalChangeOwner(HashObjectList,s); +end; + + +procedure TFPHashObject.Rename(const ANewName:shortstring); +var + Index : integer; +begin + Index:=FOwner.Rename(PShortString(@FOwner.List.Strs[FStrIndex])^,ANewName); + if Index<>-1 then + begin + FStrIndex:=FOwner.List.List^[Index].StrIndex; + FCachedStr:=PShortString(@FOwner.List.Strs[FStrIndex]); + end; +end; + + +function TFPHashObject.GetName:shortstring; +begin + if FOwner<>nil then + begin + FCachedStr:=PShortString(@FOwner.List.Strs[FStrIndex]); + Result:=FCachedStr^; + end + else + Result:=''; +end; + + +function TFPHashObject.GetHash:Longword; +begin + if FOwner<>nil then + Result:=FPHash(PShortString(@FOwner.List.Strs[FStrIndex])^) + else + Result:=$ffffffff; +end; + + +{***************************************************************************** + TFPHashObjectList (Copied from rtl/objpas/classes/lists.inc) +*****************************************************************************} + +constructor TFPHashObjectList.Create(FreeObjects : boolean = True); +begin + inherited Create; + FHashList := TFPHashList.Create; + FFreeObjects := Freeobjects; +end; + +destructor TFPHashObjectList.Destroy; +begin + if (FHashList <> nil) then + begin + Clear; + FHashList.Destroy; + end; + inherited Destroy; +end; + +procedure TFPHashObjectList.Clear; +var + i: integer; +begin + if FFreeObjects then + for i := 0 to FHashList.Count - 1 do + TObject(FHashList[i]).Free; + FHashList.Clear; +end; + +function TFPHashObjectList.GetCount: integer; +begin + Result := FHashList.Count; +end; + +procedure TFPHashObjectList.SetCount(const AValue: integer); +begin + if FHashList.Count <> AValue then + FHashList.Count := AValue; +end; + +function TFPHashObjectList.GetItem(Index: Integer): TObject; +begin + Result := TObject(FHashList[Index]); +end; + +procedure TFPHashObjectList.SetItem(Index: Integer; AObject: TObject); +begin + if OwnsObjects then + TObject(FHashList[Index]).Free; + FHashList[index] := AObject; +end; + +procedure TFPHashObjectList.SetCapacity(NewCapacity: Integer); +begin + FHashList.Capacity := NewCapacity; +end; + +function TFPHashObjectList.GetCapacity: integer; +begin + Result := FHashList.Capacity; +end; + +function TFPHashObjectList.Add(const AName:shortstring;AObject: TObject): Integer; +begin + Result := FHashList.Add(AName,AObject); +end; + +function TFPHashObjectList.NameOfIndex(Index: Integer): shortstring; +begin + Result := FHashList.NameOfIndex(Index); +end; + +function TFPHashObjectList.HashOfIndex(Index: Integer): LongWord; +begin + Result := FHashList.HashOfIndex(Index); +end; + +function TFPHashObjectList.GetNextCollision(Index: Integer): Integer; +begin + Result := FHashList.GetNextCollision(Index); +end; + +procedure TFPHashObjectList.Delete(Index: Integer); +begin + if OwnsObjects then + TObject(FHashList[Index]).Free; + FHashList.Delete(Index); +end; + +function TFPHashObjectList.Expand: TFPHashObjectList; +begin + FHashList.Expand; + Result := Self; +end; + +function TFPHashObjectList.Extract(Item: TObject): TObject; +begin + Result := TObject(FHashList.Extract(Item)); +end; + +function TFPHashObjectList.Remove(AObject: TObject): Integer; +begin + Result := IndexOf(AObject); + if (Result <> -1) then + begin + if OwnsObjects then + TObject(FHashList[Result]).Free; + FHashList.Delete(Result); + end; +end; + +function TFPHashObjectList.IndexOf(AObject: TObject): Integer; +begin + Result := FHashList.IndexOf(Pointer(AObject)); +end; + + +function TFPHashObjectList.Find(const s:shortstring): TObject; +begin + result:=TObject(FHashList.Find(s)); +end; + + +function TFPHashObjectList.FindIndexOf(const s:shortstring): Integer; +begin + result:=FHashList.FindIndexOf(s); +end; + + +function TFPHashObjectList.FindWithHash(const AName:shortstring;AHash:LongWord): Pointer; +begin + Result:=TObject(FHashList.FindWithHash(AName,AHash)); +end; + + +function TFPHashObjectList.Rename(const AOldName,ANewName:shortstring): Integer; +begin + Result:=FHashList.Rename(AOldName,ANewName); +end; + + +function TFPHashObjectList.FindInstanceOf(AClass: TClass; AExact: Boolean; AStartAt : Integer): Integer; +var + I : Integer; +begin + I:=AStartAt; + Result:=-1; + If AExact then + while (I<Count) and (Result=-1) do + If Items[i].ClassType=AClass then + Result:=I + else + Inc(I) + else + while (I<Count) and (Result=-1) do + If Items[i].InheritsFrom(AClass) then + Result:=I + else + Inc(I); +end; + + +procedure TFPHashObjectList.Pack; +begin + FHashList.Pack; +end; + + +procedure TFPHashObjectList.ShowStatistics; +begin + FHashList.ShowStatistics; +end; + + +procedure TFPHashObjectList.ForEachCall(proc2call:TObjectListCallback;arg:pointer); +begin + FHashList.ForEachCall(TListCallBack(proc2call),arg); +end; + + +procedure TFPHashObjectList.ForEachCall(proc2call:TObjectListStaticCallback;arg:pointer); +begin + FHashList.ForEachCall(TListStaticCallBack(proc2call),arg); +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, Next : TLinkedListItem; + begin + NewNode:=FFirst; + while assigned(NewNode) do + begin + Next:=NewNode.Next; + prefetch(next.next); + NewNode.Free; + NewNode:=Next; + 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.Last; + while assigned(NewNode) do + begin + NewNode2:=NewNode.Getcopy; + if assigned(NewNode2) then + Insert(NewNode2); + NewNode:=NewNode.Previous; + 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; + + +{**************************************************************************** + TCmdStrListItem + ****************************************************************************} + + constructor TCmdStrListItem.Create(const s:TCmdStr); + begin + inherited Create; + FPStr:=s; + end; + + + destructor TCmdStrListItem.Destroy; + begin + FPStr:=''; + end; + + + function TCmdStrListItem.Str:TCmdStr; + begin + Str:=FPStr; + end; + + + function TCmdStrListItem.GetCopy:TLinkedListItem; + begin + Result:=(inherited GetCopy); + { TLinkedListItem.GetCopy performs a "move" to copy all data -> reinit + the ansistring, so the refcount is properly increased } + Initialize(TCmdStrListItem(Result).FPStr); + TCmdStrListItem(Result).FPStr:=FPstr; + end; + + +{**************************************************************************** + TCmdStrList + ****************************************************************************} + + constructor TCmdStrList.Create; + begin + inherited Create; + FDoubles:=true; + end; + + + constructor TCmdStrList.Create_no_double; + begin + inherited Create; + FDoubles:=false; + end; + + + procedure TCmdStrList.insert(const s : TCmdStr); + begin + if (s='') or + ((not FDoubles) and (find(s)<>nil)) then + exit; + inherited insert(TCmdStrListItem.create(s)); + end; + + + procedure TCmdStrList.concat(const s : TCmdStr); + begin + if (s='') or + ((not FDoubles) and (find(s)<>nil)) then + exit; + inherited concat(TCmdStrListItem.create(s)); + end; + + + procedure TCmdStrList.remove(const s : TCmdStr); + var + p : TCmdStrListItem; + begin + if s='' then + exit; + p:=find(s); + if assigned(p) then + begin + inherited Remove(p); + p.Free; + end; + end; + + + function TCmdStrList.GetFirst : TCmdStr; + var + p : TCmdStrListItem; + begin + p:=TCmdStrListItem(inherited GetFirst); + if p=nil then + GetFirst:='' + else + begin + GetFirst:=p.FPStr; + p.free; + end; + end; + + + function TCmdStrList.Getlast : TCmdStr; + var + p : TCmdStrListItem; + begin + p:=TCmdStrListItem(inherited Getlast); + if p=nil then + Getlast:='' + else + begin + Getlast:=p.FPStr; + p.free; + end; + end; + + + function TCmdStrList.FindCase(const s:TCmdStr):TCmdStrListItem; + var + NewNode : TCmdStrListItem; + begin + result:=nil; + if s='' then + exit; + NewNode:=TCmdStrListItem(FFirst); + while assigned(NewNode) do + begin + if NewNode.FPStr=s then + begin + result:=NewNode; + exit; + end; + NewNode:=TCmdStrListItem(NewNode.Next); + end; + end; + + + function TCmdStrList.Find(const s:TCmdStr):TCmdStrListItem; + var + NewNode : TCmdStrListItem; + begin + result:=nil; + if s='' then + exit; + NewNode:=TCmdStrListItem(FFirst); + while assigned(NewNode) do + begin + if SysUtils.CompareText(s, NewNode.FPStr)=0 then + begin + result:=NewNode; + exit; + end; + NewNode:=TCmdStrListItem(NewNode.Next); + end; + end; + + + procedure TCmdStrList.InsertItem(item:TCmdStrListItem); + begin + inherited Insert(item); + end; + + + procedure TCmdStrList.ConcatItem(item:TCmdStrListItem); + begin + inherited Concat(item); + end; + + +{**************************************************************************** + tdynamicarray +****************************************************************************} + + constructor tdynamicarray.create(Ablocksize:longword); + begin + FPosn:=0; + FPosnblock:=nil; + FFirstblock:=nil; + FLastblock:=nil; + FCurrBlockSize:=0; + { Every block needs at least a header and alignment slack, + therefore its size cannot be arbitrarily small. However, + the blocksize argument is often confused with data size. + See e.g. Mantis #20929. } + if Ablocksize<mindynamicblocksize then + Ablocksize:=mindynamicblocksize; + FMaxBlockSize:=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:longword; + 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; + OptBlockSize, + IncSize : integer; + begin + if CurrBlockSize<FMaxBlocksize then + begin + IncSize := mindynamicblocksize; + if FCurrBlockSize > 255 then + Inc(IncSize, FCurrBlockSize shr 2); + inc(FCurrBlockSize,IncSize); + end; + if CurrBlockSize>FMaxBlocksize then + FCurrBlockSize:=FMaxBlocksize; + { Calculate the most optimal size so there is no alignment overhead + lost in the heap manager } + OptBlockSize:=cutils.Align(CurrBlockSize+dynamicblockbasesize,16)-dynamicblockbasesize-sizeof(ptrint); + Getmem(nblock,OptBlockSize+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^.size; + end; + nblock^.used:=0; + nblock^.size:=OptBlockSize; + nblock^.Next:=nil; + fillchar(nblock^.data,nblock^.size,0); + FLastblock:=nblock; + end; + + + procedure tdynamicarray.align(i:longword); + var + j : longword; + begin + j:=(FPosn mod i); + if j<>0 then + begin + j:=i-j; + if FPosnblock^.used+j>FPosnblock^.size then + begin + dec(j,FPosnblock^.size-FPosnblock^.used); + FPosnblock^.used:=FPosnblock^.size; + grow; + FPosnblock:=FLastblock; + end; + inc(FPosnblock^.used,j); + inc(FPosn,j); + end; + end; + + + procedure tdynamicarray.seek(i:longword); + begin + if (i<FPosnblock^.pos) or (i>=FPosnblock^.pos+FPosnblock^.size) 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+FPosnblock^.size>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:=FLastblock^.size; + grow; + FPosnblock:=FLastblock; + until FPosnblock^.pos+FPosnblock^.size>=i; + end; + end; + FPosn:=i; + if FPosn-FPosnblock^.pos>FPosnblock^.used then + FPosnblock^.used:=FPosn-FPosnblock^.pos; + end; + + + procedure tdynamicarray.write(const d;len:longword); + var + p : pchar; + i,j : longword; + begin + p:=pchar(@d); + while (len>0) do + begin + i:=FPosn-FPosnblock^.pos; + if i+len>=FPosnblock^.size then + begin + j:=FPosnblock^.size-i; + move(p^,FPosnblock^.data[i],j); + inc(p,j); + inc(FPosn,j); + dec(len,j); + FPosnblock^.used:=FPosnblock^.size; + 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-FPosnblock^.pos; + 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:longword):longword; + var + p : pchar; + i,j,res : longword; + begin + res:=0; + p:=pchar(@d); + while (len>0) do + begin + i:=FPosn-FPosnblock^.pos; + 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:longword); + var + i,left : longword; + begin + repeat + left:=FPosnblock^.size-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=FPosnblock^.size 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; + +{**************************************************************************** + thashset +****************************************************************************} + + constructor THashSet.Create(InitSize: Integer; OwnKeys, OwnObjects: Boolean); + var + I: Integer; + begin + inherited Create; + FOwnsObjects := OwnObjects; + FOwnsKeys := OwnKeys; + I := 64; + while I < InitSize do I := I shl 1; + FBucketCount := I; + FBucket := AllocMem(I * sizeof(PHashSetItem)); + end; + + + destructor THashSet.Destroy; + begin + Clear; + FreeMem(FBucket); + inherited Destroy; + end; + + + procedure THashSet.Clear; + var + I: Integer; + item, next: PHashSetItem; + begin + for I := 0 to FBucketCount-1 do + begin + item := FBucket[I]; + while Assigned(item) do + begin + next := item^.Next; + if FOwnsObjects then + item^.Data.Free; + if FOwnsKeys then + FreeMem(item^.Key); + FreeItem(item); + item := next; + end; + end; + FillChar(FBucket^, FBucketCount * sizeof(PHashSetItem), 0); + end; + + + function THashSet.Find(Key: Pointer; KeyLen: Integer): PHashSetItem; + var + Dummy: Boolean; + begin + Result := Lookup(Key, KeyLen, Dummy, False); + end; + + + function THashSet.FindOrAdd(Key: Pointer; KeyLen: Integer; + var Found: Boolean): PHashSetItem; + begin + Result := Lookup(Key, KeyLen, Found, True); + end; + + + function THashSet.FindOrAdd(Key: Pointer; KeyLen: Integer): PHashSetItem; + var + Dummy: Boolean; + begin + Result := Lookup(Key, KeyLen, Dummy, True); + end; + + + function THashSet.Get(Key: Pointer; KeyLen: Integer): TObject; + var + e: PHashSetItem; + Dummy: Boolean; + begin + e := Lookup(Key, KeyLen, Dummy, False); + if Assigned(e) then + Result := e^.Data + else + Result := nil; + end; + + + function THashSet.Lookup(Key: Pointer; KeyLen: Integer; + var Found: Boolean; CanCreate: Boolean): PHashSetItem; + var + Entry: PPHashSetItem; + h: LongWord; + begin + h := FPHash(Key, KeyLen); + Entry := @FBucket[h mod FBucketCount]; + while Assigned(Entry^) and + not ((Entry^^.HashValue = h) and (Entry^^.KeyLength = KeyLen) and + (CompareByte(Entry^^.Key^, Key^, KeyLen) = 0)) do + Entry := @Entry^^.Next; + Found := Assigned(Entry^); + if Found or (not CanCreate) then + begin + Result := Entry^; + Exit; + end; + if FCount > FBucketCount then { arbitrary limit, probably too high } + begin + { rehash and repeat search } + Resize(FBucketCount * 2); + Result := Lookup(Key, KeyLen, Found, CanCreate); + end + else + begin + New(Result); + if FOwnsKeys then + begin + GetMem(Result^.Key, KeyLen); + Move(Key^, Result^.Key^, KeyLen); + end + else + Result^.Key := Key; + Result^.KeyLength := KeyLen; + Result^.HashValue := h; + Result^.Data := nil; + Result^.Next := nil; + Inc(FCount); + Entry^ := Result; + end; + end; + + + procedure THashSet.Resize(NewCapacity: LongWord); + var + p, chain: PPHashSetItem; + i: Integer; + e, n: PHashSetItem; + begin + p := AllocMem(NewCapacity * SizeOfItem); + for i := 0 to FBucketCount-1 do + begin + e := FBucket[i]; + while Assigned(e) do + begin + chain := @p[e^.HashValue mod NewCapacity]; + n := e^.Next; + e^.Next := chain^; + chain^ := e; + e := n; + end; + end; + FBucketCount := NewCapacity; + FreeMem(FBucket); + FBucket := p; + end; + + class procedure THashSet.FreeItem(item: PHashSetItem); + begin + Dispose(item); + end; + + class function THashSet.SizeOfItem: Integer; + begin + Result := SizeOf(THashSetItem); + end; + + function THashSet.Remove(Entry: PHashSetItem): Boolean; + var + chain: PPHashSetItem; + begin + chain := @FBucket[Entry^.HashValue mod FBucketCount]; + while Assigned(chain^) do + begin + if chain^ = Entry then + begin + chain^ := Entry^.Next; + if FOwnsObjects then + Entry^.Data.Free; + if FOwnsKeys then + FreeMem(Entry^.Key); + FreeItem(Entry); + Dec(FCount); + Result := True; + Exit; + end; + chain := @chain^^.Next; + end; + Result := False; + end; + + +{**************************************************************************** + ttaghashset +****************************************************************************} + + function TTagHashSet.Lookup(Key: Pointer; KeyLen: Integer; + Tag: LongWord; var Found: Boolean; CanCreate: Boolean): PTagHashSetItem; + var + Entry: PPTagHashSetItem; + h: LongWord; + begin + h := FPHash(Key, KeyLen, Tag); + Entry := @PPTagHashSetItem(FBucket)[h mod FBucketCount]; + while Assigned(Entry^) and + not ((Entry^^.HashValue = h) and (Entry^^.KeyLength = KeyLen) and + (Entry^^.Tag = Tag) and (CompareByte(Entry^^.Key^, Key^, KeyLen) = 0)) do + Entry := @Entry^^.Next; + Found := Assigned(Entry^); + if Found or (not CanCreate) then + begin + Result := Entry^; + Exit; + end; + if FCount > FBucketCount then { arbitrary limit, probably too high } + begin + { rehash and repeat search } + Resize(FBucketCount * 2); + Result := Lookup(Key, KeyLen, Tag, Found, CanCreate); + end + else + begin + New(Result); + if FOwnsKeys then + begin + GetMem(Result^.Key, KeyLen); + Move(Key^, Result^.Key^, KeyLen); + end + else + Result^.Key := Key; + Result^.KeyLength := KeyLen; + Result^.HashValue := h; + Result^.Tag := Tag; + Result^.Data := nil; + Result^.Next := nil; + Inc(FCount); + Entry^ := Result; + end; + end; + + class procedure TTagHashSet.FreeItem(item: PHashSetItem); + begin + Dispose(PTagHashSetItem(item)); + end; + + class function TTagHashSet.SizeOfItem: Integer; + begin + Result := SizeOf(TTagHashSetItem); + end; + + function TTagHashSet.Find(Key: Pointer; KeyLen: Integer; Tag: LongWord): PTagHashSetItem; + var + Dummy: Boolean; + begin + Result := Lookup(Key, KeyLen, Tag, Dummy, False); + end; + + function TTagHashSet.FindOrAdd(Key: Pointer; KeyLen: Integer; Tag: LongWord; + var Found: Boolean): PTagHashSetItem; + begin + Result := Lookup(Key, KeyLen, Tag, Found, True); + end; + + function TTagHashSet.FindOrAdd(Key: Pointer; KeyLen: Integer; Tag: LongWord): PTagHashSetItem; + var + Dummy: Boolean; + begin + Result := Lookup(Key, KeyLen, Tag, Dummy, True); + end; + + function TTagHashSet.Get(Key: Pointer; KeyLen: Integer; Tag: LongWord): TObject; + var + e: PTagHashSetItem; + Dummy: Boolean; + begin + e := Lookup(Key, KeyLen, Tag, Dummy, False); + if Assigned(e) then + Result := e^.Data + else + Result := nil; + end; + +{**************************************************************************** + tbitset +****************************************************************************} + + constructor tbitset.create(initsize: longint); + begin + create_bytesize((initsize+7) div 8); + end; + + + constructor tbitset.create_bytesize(bytesize: longint); + begin + fdatasize:=bytesize; + getmem(fdata,fdataSize); + clear; + end; + + + destructor tbitset.destroy; + begin + freemem(fdata,fdatasize); + inherited destroy; + end; + + + procedure tbitset.clear; + begin + fillchar(fdata^,fdatasize,0); + end; + + + procedure tbitset.grow(nsize: longint); + begin + reallocmem(fdata,nsize); + fillchar(fdata[fdatasize],nsize-fdatasize,0); + fdatasize:=nsize; + end; + + + procedure tbitset.include(index: longint); + var + dataindex: longint; + begin + { don't use bitpacked array, not endian-safe } + dataindex:=index shr 3; + if (dataindex>=datasize) then + grow(dataindex+16); + fdata[dataindex]:=fdata[dataindex] or (1 shl (index and 7)); + end; + + + procedure tbitset.exclude(index: longint); + var + dataindex: longint; + begin + dataindex:=index shr 3; + if (dataindex>=datasize) then + exit; + fdata[dataindex]:=fdata[dataindex] and not(1 shl (index and 7)); + end; + + + function tbitset.isset(index: longint): boolean; + var + dataindex: longint; + begin + dataindex:=index shr 3; + result:= + (dataindex<datasize) and + (((fdata[dataindex] shr (index and 7)) and 1)<>0); + end; + + + procedure tbitset.addset(aset: tbitset); + var + i: longint; + begin + if (aset.datasize>datasize) then + grow(aset.datasize); + for i:=0 to aset.datasize-1 do + fdata[i]:=fdata[i] or aset.data[i]; + end; + + + procedure tbitset.subset(aset: tbitset); + var + i: longint; + begin + for i:=0 to min(datasize,aset.datasize)-1 do + fdata[i]:=fdata[i] and not(aset.data[i]); + end; + + +end. diff --git a/closures/compiler/cfidwarf.pas b/closures/compiler/cfidwarf.pas new file mode 100644 index 0000000000..5a1bfc3b62 --- /dev/null +++ b/closures/compiler/cfidwarf.pas @@ -0,0 +1,429 @@ +{ + Copyright (c) 2003-2004 by Peter Vreman and Florian Klaempfl + + This units contains special support for DWARF debug info + + 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 cfidwarf; + +{$i fpcdefs.inc} + +interface + + uses + cclasses, + globtype, + cgbase,cpubase, + aasmbase,aasmtai,aasmdata; + + const + maxdwarfops = 2; + + type + tdwarfoperenc=(doe_uleb,doe_sleb,doe_ptr,doe_32bit,doe_16bit,doe_8bit); + tdwarfopertype=(dop_reg,dop_const,dop_sym,dop_reloffset); + + tdwarfoper=record + enc : tdwarfoperenc; + case typ:tdwarfopertype of + dop_reg : (register:tregister); + dop_const : (value:int64); + dop_sym : (sym:tasmsymbol); + dop_reloffset : (beginsym,endsym:tasmsymbol); + end; + + tdwarfitem=class(TLinkedListItem) + op : byte; + ops : byte; + oper : array[0..maxdwarfops-1] of tdwarfoper; + constructor create(aop:byte); + constructor create_reg(aop:byte;enc1:tdwarfoperenc;reg:tregister); + constructor create_const(aop:byte;enc1:tdwarfoperenc;val:int64); + constructor create_reloffset(aop:byte;enc1:tdwarfoperenc;beginlab,endlab:tasmsymbol); + constructor create_reg_const(aop:byte;enc1:tdwarfoperenc;reg:tregister;enc2:tdwarfoperenc;val:longint); + procedure generate_code(list:TAsmList); + end; + + TDwarfAsmCFI=class(TAsmCFI) + private + FDwarfList : TLinkedList; + FFrameStartLabel, + FFrameEndLabel, + FLastloclabel : tasmlabel; + procedure cfa_advance_loc(list:TAsmList); + procedure generate_initial_instructions(list:TAsmList);virtual; + protected + code_alignment_factor, + data_alignment_factor : shortint; + property DwarfList:TlinkedList read FDwarfList; + public + constructor create;override; + destructor destroy;override; + procedure generate_code(list:TAsmList);override; + { operations } + procedure start_frame(list:TAsmList);override; + procedure end_frame(list:TAsmList);override; + procedure cfa_offset(list:TAsmList;reg:tregister;ofs:longint);override; + procedure cfa_restore(list:TAsmList;reg:tregister);override; + procedure cfa_def_cfa_register(list:TAsmList;reg:tregister);override; + procedure cfa_def_cfa_offset(list:TAsmList;ofs:longint);override; + end; + + +implementation + + uses + systems, + verbose; + + const + { Call frame information } + DW_CFA_set_loc = $01; + DW_CFA_advance_loc1 = $02; + DW_CFA_advance_loc2 = $03; + DW_CFA_advance_loc4 = $04; + DW_CFA_offset_extended = $05; + DW_CFA_restore_extended = $06; + DW_CFA_def_cfa = $0c; + DW_CFA_def_cfa_register = $0d; + DW_CFA_def_cfa_offset = $0e; + { Own additions } + DW_CFA_start_frame = $f0; + DW_CFA_end_frame = $f1; + + DW_LNS_copy = $01; + DW_LNS_advance_pc = $02; + DW_LNS_advance_line = $03; + DW_LNS_set_file = $04; + DW_LNS_set_column = $05; + DW_LNS_negate_stmt = $06; + DW_LNS_set_basic_block = $07; + DW_LNS_const_add_pc = $08; + + DW_LNS_fixed_advance_pc = $09; + DW_LNS_set_prologue_end = $0a; + DW_LNS_set_epilogue_begin = $0b; + DW_LNS_set_isa = $0c; + + DW_LNE_end_sequence = $01; + DW_LNE_set_address = $02; + DW_LNE_define_file = $03; + DW_LNE_lo_user = $80; + DW_LNE_hi_user = $ff; + + +{**************************************************************************** + TDWARFITEM +****************************************************************************} + + constructor tdwarfitem.create(aop:byte); + begin + inherited create; + op:=aop; + ops:=0; + end; + + + constructor tdwarfitem.create_reg(aop:byte;enc1:tdwarfoperenc;reg:tregister); + begin + inherited create; + op:=aop; + ops:=1; + oper[0].typ:=dop_reg; + oper[0].enc:=enc1; + oper[0].register:=reg; + end; + + + constructor tdwarfitem.create_const(aop:byte;enc1:tdwarfoperenc;val:int64); + begin + inherited create; + op:=aop; + ops:=1; + oper[0].typ:=dop_const; + oper[0].enc:=enc1; + oper[0].value:=val; + end; + + + constructor tdwarfitem.create_reloffset(aop:byte;enc1:tdwarfoperenc;beginlab,endlab:tasmsymbol); + begin + inherited create; + op:=aop; + ops:=1; + { relative offsets are passed } + oper[0].typ:=dop_reloffset; + oper[0].enc:=enc1; + oper[0].beginsym:=beginlab; + oper[0].endsym:=endlab; + end; + + + constructor tdwarfitem.create_reg_const(aop:byte;enc1:tdwarfoperenc;reg:tregister;enc2:tdwarfoperenc;val:longint); + begin + inherited create; + op:=aop; + ops:=2; + oper[0].typ:=dop_reg; + oper[0].enc:=enc1; + oper[0].register:=reg; + oper[1].typ:=dop_const; + oper[1].enc:=enc2; + oper[1].value:=val; + end; + + + procedure tdwarfitem.generate_code(list:TAsmList); + const + enc2ait_const : array[tdwarfoperenc] of taiconst_type = ( + aitconst_uleb128bit,aitconst_sleb128bit,aitconst_ptr, + aitconst_32bit,aitconst_16bit,aitconst_8bit + ); + var + i : integer; + begin + list.concat(tai_const.create_8bit(op)); + for i:=0 to ops-1 do + begin + case oper[i].typ of + dop_const : + list.concat(tai_const.create(enc2ait_const[oper[i].enc],oper[i].value)); + dop_sym : + begin + if oper[i].enc<>doe_ptr then + internalerror(200404127); + list.concat(tai_const.create_sym(oper[i].sym)); + end; + dop_reloffset : + list.concat(tai_const.create_rel_sym(enc2ait_const[oper[i].enc],oper[i].beginsym,oper[i].endsym)); + dop_reg : + list.concat(tai_const.create(enc2ait_const[oper[i].enc],dwarf_reg(oper[i].register))); + else + internalerror(200404128); + end; + end; + end; + + +{**************************************************************************** + TDwarfAsmCFI +****************************************************************************} + + constructor TDwarfAsmCFI.create; + begin + inherited create; + FFrameStartLabel:=nil; + FFrameEndLabel:=nil; + FLastLocLabel:=nil; + code_alignment_factor:=1; + data_alignment_factor:=-4; + FDwarfList:=TLinkedList.Create; + end; + + + destructor TDwarfAsmCFI.destroy; + begin + FDwarfList.Free; + end; + + +{$ifdef i386} + { if more cpu dependend stuff is implemented, this needs more refactoring } + procedure TDwarfAsmCFI.generate_initial_instructions(list:TAsmList); + begin + list.concat(tai_const.create_8bit(DW_CFA_def_cfa)); + list.concat(tai_const.create_uleb128bit(dwarf_reg(NR_STACK_POINTER_REG))); + list.concat(tai_const.create_uleb128bit(sizeof(aint))); + list.concat(tai_const.create_8bit(DW_CFA_offset_extended)); + list.concat(tai_const.create_uleb128bit(dwarf_reg(NR_RETURN_ADDRESS_REG))); + list.concat(tai_const.create_uleb128bit((-sizeof(aint)) div data_alignment_factor)); + end; +{$else i386} + { if more cpu dependend stuff is implemented, this needs more refactoring } + procedure TDwarfAsmCFI.generate_initial_instructions(list:TAsmList); + begin + list.concat(tai_const.create_8bit(DW_CFA_def_cfa)); + list.concat(tai_const.create_uleb128bit(dwarf_reg(NR_STACK_POINTER_REG))); + list.concat(tai_const.create_uleb128bit(sizeof(aint))); + list.concat(tai_const.create_8bit(DW_CFA_offset_extended)); + list.concat(tai_const.create_uleb128bit(dwarf_reg(NR_RETURN_ADDRESS_REG))); + list.concat(tai_const.create_uleb128bit((-sizeof(aint)) div data_alignment_factor)); + end; +{$endif i386} + + procedure TDwarfAsmCFI.generate_code(list:TAsmList); + var + hp : tdwarfitem; + cielabel, + lenstartlabel, + lenendlabel : tasmlabel; + tc : tai_const; + begin + new_section(list,sec_debug_frame,'',0); + { CIE + DWORD length + DWORD CIE_Id = 0xffffffff + BYTE version = 1 + STRING augmentation = "" = BYTE 0 + ULEB128 code alignment factor = 1 + ULEB128 data alignment factor = -1 + BYTE return address register + <...> start sequence + } + current_asmdata.getlabel(cielabel,alt_dbgframe); + list.concat(tai_label.create(cielabel)); + current_asmdata.getlabel(lenstartlabel,alt_dbgframe); + current_asmdata.getlabel(lenendlabel,alt_dbgframe); + list.concat(tai_const.create_rel_sym(aitconst_32bit,lenstartlabel,lenendlabel)); + list.concat(tai_label.create(lenstartlabel)); + list.concat(tai_const.create_32bit(longint($ffffffff))); + list.concat(tai_const.create_8bit(1)); + list.concat(tai_const.create_8bit(0)); { empty string } + list.concat(tai_const.create_uleb128bit(code_alignment_factor)); + list.concat(tai_const.create_sleb128bit(data_alignment_factor)); + list.concat(tai_const.create_8bit(dwarf_reg(NR_RETURN_ADDRESS_REG))); + { Generate standard code + def_cfa(stackpointer,sizeof(aint)) + cfa_offset_extended(returnaddres,-sizeof(aint)) + } + generate_initial_instructions(list); + + list.concat(cai_align.create_zeros(4)); + list.concat(tai_label.create(lenendlabel)); + lenstartlabel:=nil; + lenendlabel:=nil; + + hp:=TDwarfItem(DwarfList.first); + while assigned(hp) do + begin + case hp.op of + DW_CFA_Start_Frame : + begin + if assigned(lenstartlabel) then + internalerror(200404125); + if (hp.ops<>1) or + (hp.oper[0].typ<>dop_reloffset) then + internalerror(200404126); + current_asmdata.getlabel(lenstartlabel,alt_dbgframe); + current_asmdata.getlabel(lenendlabel,alt_dbgframe); + { FDE + DWORD length + DWORD CIE-pointer = cielabel relative to section start + PTRSIZE initial location = oper[0] + PTRSIZE function size = oper[1] + } + list.concat(tai_const.create_rel_sym(aitconst_32bit,lenstartlabel,lenendlabel)); + list.concat(tai_label.create(lenstartlabel)); + tc:=tai_const.create_sym(cielabel); + { force label offset to secrel32 for windows systems } + if (target_info.system in systems_windows+systems_wince) then + tc.consttype:=aitconst_secrel32_symbol; + list.concat(tc); + list.concat(tai_const.create_sym(hp.oper[0].beginsym)); + list.concat(tai_const.create_rel_sym(aitconst_ptr,hp.oper[0].beginsym,hp.oper[0].endsym)); + end; + DW_CFA_End_Frame : + begin + list.concat(cai_align.create_zeros(4)); + list.concat(tai_label.create(lenendlabel)); + lenstartlabel:=nil; + lenendlabel:=nil; + end; + else + hp.generate_code(list); + end; + hp:=TDwarfItem(hp.next); + end; + { Check for open frames } + if assigned(lenstartlabel) then + internalerror(2004041210); + { DwarfList is processed, remove items } + DwarfList.Clear; + end; + + + procedure TDwarfAsmCFI.start_frame(list:TAsmList); + begin + if assigned(FFrameStartLabel) then + internalerror(200404129); + current_asmdata.getlabel(FFrameStartLabel,alt_dbgframe); + current_asmdata.getlabel(FFrameEndLabel,alt_dbgframe); + FLastloclabel:=FFrameStartLabel; + list.concat(tai_label.create(FFrameStartLabel)); + DwarfList.concat(tdwarfitem.create_reloffset(DW_CFA_start_frame,doe_32bit,FFrameStartLabel,FFrameEndLabel)); + end; + + + procedure TDwarfAsmCFI.end_frame(list:TAsmList); + begin + if not assigned(FFrameStartLabel) then + internalerror(2004041213); + DwarfList.concat(tdwarfitem.create(DW_CFA_end_frame)); + list.concat(tai_label.create(FFrameEndLabel)); + FFrameStartLabel:=nil; + FFrameEndLabel:=nil; + FLastLocLabel:=nil; + end; + + + procedure TDwarfAsmCFI.cfa_advance_loc(list:TAsmList); + var + currloclabel : tasmlabel; + begin + if FLastloclabel=nil then + internalerror(200404082); + current_asmdata.getlabel(currloclabel,alt_dbgframe); + list.concat(tai_label.create(currloclabel)); + DwarfList.concat(tdwarfitem.create_reloffset(DW_CFA_advance_loc4,doe_32bit,FLastloclabel,currloclabel)); + FLastloclabel:=currloclabel; + end; + + + procedure TDwarfAsmCFI.cfa_offset(list:TAsmList;reg:tregister;ofs:longint); + begin + cfa_advance_loc(list); +{ TODO: check if ref is a temp} + { offset must be positive } + DwarfList.concat(tdwarfitem.create_reg_const(DW_CFA_offset_extended,doe_uleb,reg,doe_uleb,ofs div data_alignment_factor)); + end; + + + procedure TDwarfAsmCFI.cfa_restore(list:TAsmList;reg:tregister); + begin + cfa_advance_loc(list); + DwarfList.concat(tdwarfitem.create_reg(DW_CFA_restore_extended,doe_uleb,reg)); + end; + + + procedure TDwarfAsmCFI.cfa_def_cfa_register(list:TAsmList;reg:tregister); + begin + cfa_advance_loc(list); + DwarfList.concat(tdwarfitem.create_reg(DW_CFA_def_cfa_register,doe_uleb,reg)); + end; + + + procedure TDwarfAsmCFI.cfa_def_cfa_offset(list:TAsmList;ofs:longint); + begin + cfa_advance_loc(list); + DwarfList.concat(tdwarfitem.create_const(DW_CFA_def_cfa_offset,doe_uleb,ofs)); + end; + + +begin + CAsmCFI:=TDwarfAsmCFI; +end. diff --git a/closures/compiler/cfileutl.pas b/closures/compiler/cfileutl.pas new file mode 100644 index 0000000000..f15b8e588e --- /dev/null +++ b/closures/compiler/cfileutl.pas @@ -0,0 +1,1301 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl and Peter Vreman + + This module provides some basic file/dir handling utils and 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 cfileutl; + +{$i fpcdefs.inc} + +{$define usedircache} + +interface + + uses +{$ifdef hasunix} + Baseunix,unix, +{$endif hasunix} +{$ifdef win32} + Windows, +{$endif win32} +{$if defined(go32v2) or defined(watcom)} + Dos, +{$endif} +{$IFNDEF USE_FAKE_SYSUTILS} + SysUtils, +{$ELSE} + fksysutl, +{$ENDIF} + GlobType, + CUtils,CClasses, + Systems; + + type + TCachedDirectory = class(TFPHashObject) + private + FDirectoryEntries : TFPHashList; + FCached : Boolean; + procedure FreeDirectoryEntries; + function GetItemAttr(const AName: TCmdStr): longint; + function TryUseCache: boolean; + procedure ForceUseCache; + procedure Reload; + public + constructor Create(AList:TFPHashObjectList;const AName:TCmdStr); + destructor destroy;override; + function FileExists(const AName:TCmdStr):boolean; + function FileExistsCaseAware(const path, fn: TCmdStr; out FoundName: TCmdStr):boolean; + function DirectoryExists(const AName:TCmdStr):boolean; + property DirectoryEntries:TFPHashList read FDirectoryEntries; + end; + + TCachedSearchRec = record + Name : TCmdStr; + Attr : byte; + Pattern : TCmdStr; + CachedDir : TCachedDirectory; + EntryIndex : longint; + end; + + PCachedDirectoryEntry = ^TCachedDirectoryEntry; + TCachedDirectoryEntry = record + RealName: TCmdStr; + Attr : longint; + end; + + TDirectoryCache = class + private + FDirectories : TFPHashObjectList; + function GetDirectory(const ADir:TCmdStr):TCachedDirectory; + public + constructor Create; + destructor destroy;override; + function FileExists(const AName:TCmdStr):boolean; + function FileExistsCaseAware(const path, fn: TCmdStr; out FoundName: TCmdStr):boolean; + function DirectoryExists(const AName:TCmdStr):boolean; + function FindFirst(const APattern:TCmdStr;var Res:TCachedSearchRec):boolean; + function FindNext(var Res:TCachedSearchRec):boolean; + function FindClose(var Res:TCachedSearchRec):boolean; + end; + + TSearchPathList = class(TCmdStrList) + procedure AddPath(s:TCmdStr;addfirst:boolean);overload; + procedure AddPath(SrcPath,s:TCmdStr;addfirst:boolean);overload; + procedure AddList(list:TSearchPathList;addfirst:boolean); + function FindFile(const f : TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean; + end; + + function bstoslash(const s : TCmdStr) : TCmdStr; + {Gives the absolute path to the current directory} + function GetCurrentDir:TCmdStr; + {Gives the relative path to the current directory, + with a trailing dir separator. E. g. on unix ./ } + function CurDirRelPath(systeminfo: tsysteminfo): TCmdStr; + function path_absolute(const s : TCmdStr) : boolean; + Function PathExists (const F : TCmdStr;allowcache:boolean) : Boolean; + Function FileExists (const F : TCmdStr;allowcache:boolean) : Boolean; + function FileExistsNonCase(const path,fn:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean; + Function RemoveDir(d:TCmdStr):boolean; + Function FixPath(const s:TCmdStr;allowdot:boolean):TCmdStr; + function FixFileName(const s:TCmdStr):TCmdStr; + function TargetFixPath(s:TCmdStr;allowdot:boolean):TCmdStr; + function TargetFixFileName(const s:TCmdStr):TCmdStr; + procedure SplitBinCmd(const s:TCmdStr;var bstr: TCmdStr;var cstr:TCmdStr); + function FindFile(const f : TCmdStr; const path : TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean; +{ function FindFilePchar(const f : TCmdStr;path : pchar;allowcache:boolean;var foundfile:TCmdStr):boolean;} + function FindExe(const bin:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean; + function GetShortName(const n:TCmdStr):TCmdStr; + + procedure InitFileUtils; + procedure DoneFileUtils; + + +{ * Since native Amiga commands can't handle Unix-style relative paths used by the compiler, + and some GNU tools, Unix2AmigaPath is needed to handle such situations (KB) * } + +{$IF DEFINED(MORPHOS) OR DEFINED(AMIGA)} +{ * PATHCONV is implemented in the Amiga/MorphOS system unit * } +{$WARNING TODO Amiga: implement PathConv() in System unit, which works with AnsiString} +function Unix2AmigaPath(path: ShortString): ShortString; external name 'PATHCONV'; +{$ELSE} +function Unix2AmigaPath(path: String): String;{$IFDEF USEINLINE}inline;{$ENDIF} +{$ENDIF} + + + +implementation + + uses + Comphook, + Globals; + +{$undef AllFilesMaskIsInRTL} + +{$if (FPC_VERSION > 2)} + {$define AllFilesMaskIsInRTL} +{$endif FPC_VERSION} + +{$if (FPC_VERSION = 2) and (FPC_RELEASE > 2)} + {$define AllFilesMaskIsInRTL} +{$endif} + +{$if (FPC_VERSION = 2) and (FPC_RELEASE = 2) and (FPC_PATCH > 0)} + {$define AllFilesMaskIsInRTL} +{$endif} + +{$ifndef AllFilesMaskIsInRTL} + {$if defined(go32v2) or defined(watcom)} + const + AllFilesMask = '*.*'; + {$else} + const + AllFilesMask = '*'; + {$endif not (go32v2 or watcom)} +{$endif not AllFilesMaskIsInRTL} + var + DirCache : TDirectoryCache; + + +{$IF NOT (DEFINED(MORPHOS) OR DEFINED(AMIGA))} +{ Stub function for Unix2Amiga Path conversion functionality, only available in + Amiga/MorphOS RTL. I'm open for better solutions. (KB) } +function Unix2AmigaPath(path: String): String;{$IFDEF USEINLINE}inline;{$ENDIF} +begin + Unix2AmigaPath:=path; +end; +{$ENDIF} + + + +{**************************************************************************** + TCachedDirectory +****************************************************************************} + + constructor TCachedDirectory.create(AList:TFPHashObjectList;const AName:TCmdStr); + begin + inherited create(AList,AName); + FDirectoryEntries:=TFPHashList.Create; + FCached:=False; + end; + + + destructor TCachedDirectory.destroy; + begin + FreeDirectoryEntries; + FDirectoryEntries.Free; + inherited destroy; + end; + + + function TCachedDirectory.TryUseCache:boolean; + begin + Result:=True; + if FCached then + exit; + if not current_settings.disabledircache then + ForceUseCache + else + Result:=False; + end; + + + procedure TCachedDirectory.ForceUseCache; + begin + if not FCached then + begin + FCached:=True; + Reload; + end; + end; + + + procedure TCachedDirectory.FreeDirectoryEntries; + var + i: Integer; + begin + if not(tf_files_case_aware in source_info.flags) then + exit; + for i := 0 to DirectoryEntries.Count-1 do + dispose(PCachedDirectoryEntry(DirectoryEntries[i])); + end; + + + function TCachedDirectory.GetItemAttr(const AName: TCmdStr): longint; + var + entry: PCachedDirectoryEntry; + begin + if not(tf_files_case_sensitive in source_info.flags) then + if (tf_files_case_aware in source_info.flags) then + begin + entry:=PCachedDirectoryEntry(DirectoryEntries.Find(Lower(AName))); + if assigned(entry) then + Result:=entry^.Attr + else + Result:=0; + end + else + Result:=PtrUInt(DirectoryEntries.Find(Lower(AName))) + else + Result:=PtrUInt(DirectoryEntries.Find(AName)); + end; + + + procedure TCachedDirectory.Reload; + var + dir : TSearchRec; + entry : PCachedDirectoryEntry; + begin + FreeDirectoryEntries; + DirectoryEntries.Clear; + if findfirst(IncludeTrailingPathDelimiter(Name)+AllFilesMask,faAnyFile or faDirectory,dir) = 0 then + begin + repeat + if ((dir.attr and faDirectory)<>faDirectory) or + ((dir.Name<>'.') and + (dir.Name<>'..')) then + begin + { Force Archive bit so the attribute always has a value. This is needed + to be able to see the difference in the directoryentries lookup if a file + exists or not } + Dir.Attr:=Dir.Attr or faArchive; + if not(tf_files_case_sensitive in source_info.flags) then + if (tf_files_case_aware in source_info.flags) then + begin + new(entry); + entry^.RealName:=Dir.Name; + entry^.Attr:=Dir.Attr; + DirectoryEntries.Add(Lower(Dir.Name),entry) + end + else + DirectoryEntries.Add(Lower(Dir.Name),Pointer(Ptrint(Dir.Attr))) + else + DirectoryEntries.Add(Dir.Name,Pointer(Ptrint(Dir.Attr))); + end; + until findnext(dir) <> 0; + end; + findclose(dir); + end; + + + function TCachedDirectory.FileExists(const AName:TCmdStr):boolean; + var + Attr : Longint; + begin + if not TryUseCache then + begin + { prepend directory name again } + result:=cfileutl.FileExists(Name+AName,false); + exit; + end; + Attr:=GetItemAttr(AName); + if Attr<>0 then + Result:=((Attr and faDirectory)=0) + else + Result:=false; + end; + + + function TCachedDirectory.FileExistsCaseAware(const path, fn: TCmdStr; out FoundName: TCmdStr):boolean; + var + entry : PCachedDirectoryEntry; + begin + if (tf_files_case_aware in source_info.flags) then + begin + if not TryUseCache then + begin + Result:=FileExistsNonCase(path,fn,false,FoundName); + exit; + end; + entry:=PCachedDirectoryEntry(DirectoryEntries.Find(Lower(ExtractFileName(fn)))); + if assigned(entry) and + (entry^.Attr<>0) and + ((entry^.Attr and faDirectory) = 0) then + begin + FoundName:=ExtractFilePath(path+fn)+entry^.RealName; + Result:=true + end + else + Result:=false; + end + else + { should not be called in this case, use plain FileExists } + Result:=False; + end; + + + function TCachedDirectory.DirectoryExists(const AName:TCmdStr):boolean; + var + Attr : Longint; + begin + if not TryUseCache then + begin + Result:=PathExists(Name+AName,false); + exit; + end; + Attr:=GetItemAttr(AName); + if Attr<>0 then + Result:=((Attr and faDirectory)=faDirectory) + else + Result:=false; + end; + + +{**************************************************************************** + TDirectoryCache +****************************************************************************} + + constructor TDirectoryCache.create; + begin + inherited create; + FDirectories:=TFPHashObjectList.Create(true); + end; + + + destructor TDirectoryCache.destroy; + begin + FDirectories.Free; + inherited destroy; + end; + + + function TDirectoryCache.GetDirectory(const ADir:TCmdStr):TCachedDirectory; + var + CachedDir : TCachedDirectory; + DirName : TCmdStr; + begin + if ADir='' then + DirName:='.'+source_info.DirSep + else + DirName:=ADir; + CachedDir:=TCachedDirectory(FDirectories.Find(DirName)); + if not assigned(CachedDir) then + CachedDir:=TCachedDirectory.Create(FDirectories,DirName); + Result:=CachedDir; + end; + + + function TDirectoryCache.FileExists(const AName:TCmdStr):boolean; + var + CachedDir : TCachedDirectory; + begin + Result:=false; + CachedDir:=GetDirectory(ExtractFilePath(AName)); + if assigned(CachedDir) then + Result:=CachedDir.FileExists(ExtractFileName(AName)); + end; + + + function TDirectoryCache.FileExistsCaseAware(const path, fn: TCmdStr; out FoundName: TCmdStr):boolean; + var + CachedDir : TCachedDirectory; + begin + Result:=false; + CachedDir:=GetDirectory(ExtractFilePath(path+fn)); + if assigned(CachedDir) then + Result:=CachedDir.FileExistsCaseAware(path,fn,FoundName); + end; + + + function TDirectoryCache.DirectoryExists(const AName:TCmdStr):boolean; + var + CachedDir : TCachedDirectory; + begin + Result:=false; + CachedDir:=GetDirectory(ExtractFilePath(AName)); + if assigned(CachedDir) then + Result:=CachedDir.DirectoryExists(ExtractFileName(AName)); + end; + + + function TDirectoryCache.FindFirst(const APattern:TCmdStr;var Res:TCachedSearchRec):boolean; + begin + Res.Pattern:=ExtractFileName(APattern); + Res.CachedDir:=GetDirectory(ExtractFilePath(APattern)); + Res.CachedDir.ForceUseCache; + Res.EntryIndex:=0; + if assigned(Res.CachedDir) then + Result:=FindNext(Res) + else + Result:=false; + end; + + + function TDirectoryCache.FindNext(var Res:TCachedSearchRec):boolean; + var + entry: PCachedDirectoryEntry; + begin + if Res.EntryIndex<Res.CachedDir.DirectoryEntries.Count then + begin + if (tf_files_case_aware in source_info.flags) then + begin + entry:=Res.CachedDir.DirectoryEntries[Res.EntryIndex]; + Res.Name:=entry^.RealName; + Res.Attr:=entry^.Attr; + end + else + begin + Res.Name:=Res.CachedDir.DirectoryEntries.NameOfIndex(Res.EntryIndex); + Res.Attr:=PtrUInt(Res.CachedDir.DirectoryEntries[Res.EntryIndex]); + end; + inc(Res.EntryIndex); + Result:=true; + end + else + Result:=false; + end; + + + function TDirectoryCache.FindClose(var Res:TCachedSearchRec):boolean; + begin + { nothing todo } + result:=true; + end; + + +{**************************************************************************** + Utils +****************************************************************************} + + function bstoslash(const s : TCmdStr) : TCmdStr; + { + return TCmdStr s with all \ changed into / + } + var + i : longint; + begin + setlength(bstoslash,length(s)); + for i:=1to length(s) do + if s[i]='\' then + bstoslash[i]:='/' + else + bstoslash[i]:=s[i]; + end; + + + {Gives the absolute path to the current directory} + var + CachedCurrentDir : TCmdStr; + function GetCurrentDir:TCmdStr; + begin + if CachedCurrentDir='' then + begin + GetDir(0,CachedCurrentDir); + CachedCurrentDir:=FixPath(CachedCurrentDir,false); + end; + result:=CachedCurrentDir; + end; + + {Gives the relative path to the current directory, + with a trailing dir separator. E. g. on unix ./ } + function CurDirRelPath(systeminfo: tsysteminfo): TCmdStr; + + begin + if systeminfo.system <> system_powerpc_macos then + CurDirRelPath:= '.'+systeminfo.DirSep + else + CurDirRelPath:= ':' + end; + + + function path_absolute(const s : TCmdStr) : boolean; + { + is path s an absolute path? + } + begin + result:=false; +{$if defined(unix)} + if (length(s)>0) and (s[1] in AllowDirectorySeparators) then + result:=true; +{$elseif defined(amiga) or defined(morphos)} + (* An Amiga path is absolute, if it has a volume/device name in it (contains ":"), + otherwise it's always a relative path, no matter if it starts with a directory + separator or not. (KB) *) + if (length(s)>0) and (Pos(':',s) <> 0) then + result:=true; +{$elseif defined(macos)} + if IsMacFullPath(s) then + result:=true; +{$elseif defined(netware)} + if (Pos (DriveSeparator, S) <> 0) or + ((Length (S) > 0) and (S [1] in AllowDirectorySeparators)) then + result:=true; +{$elseif defined(win32) or defined(win64) or defined(go32v2) or defined(os2) or defined(watcom)} + if ((length(s)>0) and (s[1] in AllowDirectorySeparators)) or +(* The following check for non-empty AllowDriveSeparators assumes that all + other platforms supporting drives and not handled as exceptions above + should work with DOS-like paths, i.e. use absolute paths with one letter + for drive followed by path separator *) + ((length(s)>2) and (s[2] in AllowDriveSeparators) and (s[3] in AllowDirectorySeparators)) then + result:=true; +{$else} + if ((length(s)>0) and (s[1] in AllowDirectorySeparators)) or +(* The following check for non-empty AllowDriveSeparators assumes that all + other platforms supporting drives and not handled as exceptions above + should work with DOS-like paths, i.e. use absolute paths with one letter + for drive followed by path separator *) + ((AllowDriveSeparators <> []) and (length(s)>2) and (s[2] in AllowDriveSeparators) and (s[3] in AllowDirectorySeparators)) then + result:=true; +{$endif unix} + end; + + Function FileExists ( Const F : TCmdStr;allowcache:boolean) : Boolean; + begin +{$ifdef usedircache} + if allowcache then + Result:=DirCache.FileExists(F) + else +{$endif usedircache} + Result:=SysUtils.FileExists(F); + if do_checkverbosity(V_Tried) then + begin + if Result then + do_comment(V_Tried,'Searching file '+F+'... found') + else + do_comment(V_Tried,'Searching file '+F+'... not found'); + end; + end; + + + function FileExistsNonCase(const path,fn:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean; + var + fn2 : TCmdStr; + begin + result:=false; + if tf_files_case_sensitive in source_info.flags then + begin + { + Search order for case sensitive systems: + 1. NormalCase + 2. lowercase + 3. UPPERCASE + } + FoundFile:=path+fn; + If FileExists(FoundFile,allowcache) then + begin + result:=true; + exit; + end; + fn2:=Lower(fn); + if fn2<>fn then + begin + FoundFile:=path+fn2; + If FileExists(FoundFile,allowcache) then + begin + result:=true; + exit; + end; + end; + fn2:=Upper(fn); + if fn2<>fn then + begin + FoundFile:=path+fn2; + If FileExists(FoundFile,allowcache) then + begin + result:=true; + exit; + end; + end; + end + else + if tf_files_case_aware in source_info.flags then + begin + { + Search order for case aware systems: + 1. NormalCase + } +{$ifdef usedircache} + if allowcache then + begin + result:=DirCache.FileExistsCaseAware(path,fn,fn2); + if result then + begin + FoundFile:=fn2; + exit; + end; + end + else +{$endif usedircache} + begin + FoundFile:=path+fn; + If FileExists(FoundFile,allowcache) then + begin + { don't know the real name in this case } + result:=true; + exit; + end; + end; + end + else + begin + { None case sensitive only lowercase } + FoundFile:=path+Lower(fn); + If FileExists(FoundFile,allowcache) then + begin + result:=true; + exit; + end; + end; + { Set foundfile to something useful } + FoundFile:=fn; + end; + + + Function PathExists (const F : TCmdStr;allowcache:boolean) : Boolean; + Var + i: longint; + hs : TCmdStr; + begin + if F = '' then + begin + result := true; + exit; + end; + hs := ExpandFileName(F); + I := Pos (DriveSeparator, hs); + if (hs [Length (hs)] = DirectorySeparator) and + (((I = 0) and (Length (hs) > 1)) or (I <> Length (hs) - 1)) then + Delete (hs, Length (hs), 1); +{$ifdef usedircache} + if allowcache then + Result:=DirCache.DirectoryExists(hs) + else +{$endif usedircache} + Result:=SysUtils.DirectoryExists(hs); + end; + + + Function RemoveDir(d:TCmdStr):boolean; + begin + if d[length(d)]=source_info.DirSep then + Delete(d,length(d),1); + {$push}{$I-} + rmdir(d); + {$pop} + RemoveDir:=(ioresult=0); + end; + + + Function FixPath(const s:TCmdStr;allowdot:boolean):TCmdStr; + var + i, L : longint; + P: PChar; + begin + Result := s; + L := Length(Result); + if L=0 then + exit; + { Fix separator } + P := @Result[1]; + for i:=0 to L-1 do + begin + if p^ in ['/','\'] then + p^:=source_info.DirSep; + inc(p); + end; + { Fix ending / } + if (L>0) and (Result[L]<>source_info.DirSep) and + (Result[L]<>DriveSeparator) then + Result:=Result+source_info.DirSep; { !still results in temp AnsiString } + { Remove ./ } + if (not allowdot) and ((Length(Result)=2) and (Result[1]='.') and (Result[2] = source_info.DirSep)) then + begin + Result:=''; + Exit; + end; + { return } + if not ((tf_files_case_aware in source_info.flags) or + (tf_files_case_sensitive in source_info.flags)) then + Result := lower(Result); + end; + + {Actually the version in macutils.pp could be used, + but that would not work for crosscompiling, so this is a slightly modified + version of it.} + function TranslatePathToMac (const path: TCmdStr; mpw: Boolean): TCmdStr; + + function GetVolumeIdentifier: TCmdStr; + + begin + GetVolumeIdentifier := '{Boot}' + (* + if mpw then + GetVolumeIdentifier := '{Boot}' + else + GetVolumeIdentifier := macosBootVolumeName; + *) + end; + + var + slashPos, oldpos, newpos, oldlen, maxpos: Longint; + + begin + oldpos := 1; + slashPos := Pos('/', path); + if (slashPos <> 0) then {its a unix path} + begin + if slashPos = 1 then + begin {its a full path} + oldpos := 2; + TranslatePathToMac := GetVolumeIdentifier; + end + else {its a partial path} + TranslatePathToMac := ':'; + end + else + begin + slashPos := Pos('\', path); + if (slashPos <> 0) then {its a dos path} + begin + if slashPos = 1 then + begin {its a full path, without drive letter} + oldpos := 2; + TranslatePathToMac := GetVolumeIdentifier; + end + else if (Length(path) >= 2) and (path[2] = ':') then {its a full path, with drive letter} + begin + oldpos := 4; + TranslatePathToMac := GetVolumeIdentifier; + end + else {its a partial path} + TranslatePathToMac := ':'; + end; + end; + + if (slashPos <> 0) then {its a unix or dos path} + begin + {Translate "/../" to "::" , "/./" to ":" and "/" to ":" } + newpos := Length(TranslatePathToMac); + oldlen := Length(path); + SetLength(TranslatePathToMac, newpos + oldlen); {It will be no longer than what is already} + {prepended plus length of path.} + maxpos := Length(TranslatePathToMac); {Get real maxpos, can be short if String is ShortString} + + {There is never a slash in the beginning, because either it was an absolute path, and then the} + {drive and slash was removed, or it was a relative path without a preceding slash.} + while oldpos <= oldlen do + begin + {Check if special dirs, ./ or ../ } + if path[oldPos] = '.' then + if (oldpos + 1 <= oldlen) and (path[oldPos + 1] = '.') then + begin + if (oldpos + 2 > oldlen) or (path[oldPos + 2] in ['/', '\']) then + begin + {It is "../" or ".." translates to ":" } + if newPos = maxPos then + begin {Shouldn't actually happen, but..} + Exit(''); + end; + newPos := newPos + 1; + TranslatePathToMac[newPos] := ':'; + oldPos := oldPos + 3; + continue; {Start over again} + end; + end + else if (oldpos + 1 > oldlen) or (path[oldPos + 1] in ['/', '\']) then + begin + {It is "./" or "." ignor it } + oldPos := oldPos + 2; + continue; {Start over again} + end; + + {Collect file or dir name} + while (oldpos <= oldlen) and not (path[oldPos] in ['/', '\']) do + begin + if newPos = maxPos then + begin {Shouldn't actually happen, but..} + Exit(''); + end; + newPos := newPos + 1; + TranslatePathToMac[newPos] := path[oldPos]; + oldPos := oldPos + 1; + end; + + {When we come here there is either a slash or we are at the end.} + if (oldpos <= oldlen) then + begin + if newPos = maxPos then + begin {Shouldn't actually happen, but..} + Exit(''); + end; + newPos := newPos + 1; + TranslatePathToMac[newPos] := ':'; + oldPos := oldPos + 1; + end; + end; + + SetLength(TranslatePathToMac, newpos); + end + else if (path = '.') then + TranslatePathToMac := ':' + else if (path = '..') then + TranslatePathToMac := '::' + else + TranslatePathToMac := path; {its a mac path} + end; + + + function FixFileName(const s:TCmdStr):TCmdStr; + var + i : longint; + begin + if source_info.system = system_powerpc_MACOS then + FixFileName:= TranslatePathToMac(s, true) + else + if (tf_files_case_aware in source_info.flags) or + (tf_files_case_sensitive in source_info.flags) then + begin + setlength(FixFileName,length(s)); + for i:=1 to length(s) do + begin + case s[i] of + '/','\' : + FixFileName[i]:=source_info.dirsep; + else + FixFileName[i]:=s[i]; + end; + end; + end + else + begin + setlength(FixFileName,length(s)); + for i:=1 to length(s) do + begin + case s[i] of + '/','\' : + FixFileName[i]:=source_info.dirsep; + 'A'..'Z' : + FixFileName[i]:=char(byte(s[i])+32); + else + FixFileName[i]:=s[i]; + end; + end; + end; + end; + + + Function TargetFixPath(s:TCmdStr;allowdot:boolean):TCmdStr; + var + i : longint; + begin + { Fix separator } + for i:=1 to length(s) do + if s[i] in ['/','\'] then + s[i]:=target_info.DirSep; + { Fix ending / } + if (length(s)>0) and (s[length(s)]<>target_info.DirSep) and + (s[length(s)]<>':') then + s:=s+target_info.DirSep; + { Remove ./ } + if (not allowdot) and (s='.'+target_info.DirSep) then + s:=''; + { return } + if (tf_files_case_aware in target_info.flags) or + (tf_files_case_sensitive in target_info.flags) then + TargetFixPath:=s + else + TargetFixPath:=Lower(s); + end; + + + function TargetFixFileName(const s:TCmdStr):TCmdStr; + var + i : longint; + begin + if target_info.system = system_powerpc_MACOS then + TargetFixFileName:= TranslatePathToMac(s, true) + else + if (tf_files_case_aware in target_info.flags) or + (tf_files_case_sensitive in target_info.flags) then + begin + setlength(TargetFixFileName,length(s)); + for i:=1 to length(s) do + begin + case s[i] of + '/','\' : + TargetFixFileName[i]:=target_info.dirsep; + else + TargetFixFileName[i]:=s[i]; + end; + end; + end + else + begin + setlength(TargetFixFileName,length(s)); + for i:=1 to length(s) do + begin + case s[i] of + '/','\' : + TargetFixFileName[i]:=target_info.dirsep; + 'A'..'Z' : + TargetFixFileName[i]:=char(byte(s[i])+32); + else + TargetFixFileName[i]:=s[i]; + end; + end; + end; + end; + + + procedure SplitBinCmd(const s:TCmdStr;var bstr:TCmdStr;var cstr:TCmdStr); + var + i : longint; + begin + i:=pos(' ',s); + if i>0 then + begin + bstr:=Copy(s,1,i-1); + cstr:=Copy(s,i+1,length(s)-i); + end + else + begin + bstr:=s; + cstr:=''; + end; + end; + + + procedure TSearchPathList.AddPath(s:TCmdStr;addfirst:boolean); + begin + AddPath('',s,AddFirst); + end; + + + procedure TSearchPathList.AddPath(SrcPath,s:TCmdStr;addfirst:boolean); + var + staridx, + i,j : longint; + prefix, + suffix, + CurrentDir, + currPath : TCmdStr; + subdirfound : boolean; +{$ifdef usedircache} + dir : TCachedSearchRec; +{$else usedircache} + dir : TSearchRec; +{$endif usedircache} + hp : TCmdStrListItem; + + procedure WarnNonExistingPath(const path : TCmdStr); + begin + if do_checkverbosity(V_Tried) then + do_comment(V_Tried,'Path "'+path+'" not found'); + end; + + procedure AddCurrPath; + begin + if addfirst then + begin + Remove(currPath); + Insert(currPath); + end + else + begin + { Check if already in path, then we don't add it } + hp:=Find(currPath); + if not assigned(hp) then + Concat(currPath); + end; + end; + + begin + if s='' then + exit; + { Support default macro's } + DefaultReplacements(s); +{$warnings off} + if PathSeparator <> ';' then + for i:=1 to length(s) do + if s[i]=PathSeparator then + s[i]:=';'; +{$warnings on} + { get current dir } + CurrentDir:=GetCurrentDir; + repeat + { get currpath } + if addfirst then + begin + j:=length(s); + while (j>0) and (s[j]<>';') do + dec(j); + currPath:= TrimSpace(Copy(s,j+1,length(s)-j)); + if j=0 then + s:='' + else + System.Delete(s,j,length(s)-j+1); + end + else + begin + j:=Pos(';',s); + if j=0 then + j:=length(s)+1; + currPath:= TrimSpace(Copy(s,1,j-1)); + System.Delete(s,1,j); + end; + + { fix pathname } + DePascalQuote(currPath); + currPath:=SrcPath+FixPath(currPath,false); + if currPath='' then + currPath:= CurDirRelPath(source_info) + else + begin + currPath:=FixPath(ExpandFileName(currpath),false); + if (CurrentDir<>'') and (Copy(currPath,1,length(CurrentDir))=CurrentDir) then + begin +{$if defined(amiga) and defined(morphos)} + currPath:= CurrentDir+Copy(currPath,length(CurrentDir)+1,length(currPath)); +{$else} + currPath:= CurDirRelPath(source_info)+Copy(currPath,length(CurrentDir)+1,length(currPath)); +{$endif} + end; + end; + { wildcard adding ? } + staridx:=pos('*',currpath); + if staridx>0 then + begin + prefix:=ExtractFilePath(Copy(currpath,1,staridx)); + suffix:=Copy(currpath,staridx+1,length(currpath)); + subdirfound:=false; +{$ifdef usedircache} + if DirCache.FindFirst(Prefix+AllFilesMask,dir) then + begin + repeat + if (dir.attr and faDirectory)<>0 then + begin + subdirfound:=true; + currpath:=prefix+dir.name+suffix; + if (suffix='') or PathExists(currpath,true) then + begin + hp:=Find(currPath); + if not assigned(hp) then + AddCurrPath; + end; + end; + until not DirCache.FindNext(dir); + end; + DirCache.FindClose(dir); +{$else usedircache} + if findfirst(prefix+AllFilesMask,faDirectory,dir) = 0 then + begin + repeat + if (dir.name<>'.') and + (dir.name<>'..') and + ((dir.attr and faDirectory)<>0) then + begin + subdirfound:=true; + currpath:=prefix+dir.name+suffix; + if (suffix='') or PathExists(currpath,false) then + begin + hp:=Find(currPath); + if not assigned(hp) then + AddCurrPath; + end; + end; + until findnext(dir) <> 0; + end; + FindClose(dir); +{$endif usedircache} + if not subdirfound then + WarnNonExistingPath(currpath); + end + else + begin + if PathExists(currpath,true) then + AddCurrPath + else + WarnNonExistingPath(currpath); + end; + until (s=''); + end; + + + procedure TSearchPathList.AddList(list:TSearchPathList;addfirst:boolean); + var + s : TCmdStr; + hl : TSearchPathList; + hp,hp2 : TCmdStrListItem; + begin + if list.empty then + exit; + { create temp and reverse the list } + if addfirst then + begin + hl:=TSearchPathList.Create; + hp:=TCmdStrListItem(list.first); + while assigned(hp) do + begin + hl.insert(hp.Str); + hp:=TCmdStrListItem(hp.next); + end; + while not hl.empty do + begin + s:=hl.GetFirst; + Remove(s); + Insert(s); + end; + hl.Free; + end + else + begin + hp:=TCmdStrListItem(list.first); + while assigned(hp) do + begin + hp2:=Find(hp.Str); + { Check if already in path, then we don't add it } + if not assigned(hp2) then + Concat(hp.Str); + hp:=TCmdStrListItem(hp.next); + end; + end; + end; + + + function TSearchPathList.FindFile(const f :TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean; + Var + p : TCmdStrListItem; + begin + FindFile:=false; + p:=TCmdStrListItem(first); + while assigned(p) do + begin + result:=FileExistsNonCase(p.Str,f,allowcache,FoundFile); + if result then + exit; + p:=TCmdStrListItem(p.next); + end; + { Return original filename if not found } + FoundFile:=f; + end; + + + function FindFile(const f : TCmdStr; const path : TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean; + Var + StartPos, EndPos, L: LongInt; + begin + Result:=False; + StartPos := 1; + L := Length(Path); + repeat + EndPos := StartPos; + while (EndPos <= L) and ((Path[EndPos] <> PathSeparator) and (Path[EndPos] <> ';')) do + Inc(EndPos); + Result := FileExistsNonCase(FixPath(Copy(Path, StartPos, EndPos-StartPos), False), f, allowcache, FoundFile); + if Result then + Exit; + StartPos := EndPos + 1; + until StartPos > L; + FoundFile:=f; + end; + +{ + function FindFilePchar(const f : TCmdStr;path : pchar;allowcache:boolean;var foundfile:TCmdStr):boolean; + Var + singlepathstring : TCmdStr; + startpc,pc : pchar; + begin + FindFilePchar:=false; + if Assigned (Path) then + begin + pc:=path; + repeat + startpc:=pc; + while (pc^<>PathSeparator) and (pc^<>';') and (pc^<>#0) do + inc(pc); + SetLength(singlepathstring, pc-startpc); + move(startpc^,singlepathstring[1],pc-startpc); + singlepathstring:=FixPath(ExpandFileName(singlepathstring),false); + result:=FileExistsNonCase(singlepathstring,f,allowcache,FoundFile); + if result then + exit; + if (pc^=#0) then + break; + inc(pc); + until false; + end; + foundfile:=f; + end; +} + + function FindExe(const bin:TCmdStr;allowcache:boolean;var foundfile:TCmdStr):boolean; + var + Path : TCmdStr; + found : boolean; + begin + found:=FindFile(FixFileName(ChangeFileExt(bin,source_info.exeext)),exepath,allowcache,foundfile); + if not found then + begin +{$ifdef macos} + Path:=GetEnvironmentVariable('Commands'); +{$else} + Path:=GetEnvironmentVariable('PATH'); +{$endif} + found:=FindFile(FixFileName(ChangeFileExt(bin,source_info.exeext)),Path,allowcache,foundfile); + end; + FindExe:=found; + end; + + + function GetShortName(const n:TCmdStr):TCmdStr; +{$ifdef win32} + var + hs,hs2 : TCmdStr; + i : longint; +{$endif} +{$if defined(go32v2) or defined(watcom)} + var + hs : shortstring; +{$endif} + begin + GetShortName:=n; +{$ifdef win32} + hs:=n+#0; + { may become longer in case of e.g. ".a" -> "a~1" or so } + setlength(hs2,length(hs)*2); + i:=Windows.GetShortPathName(@hs[1],@hs2[1],length(hs)*2); + if (i>0) and (i<=length(hs)*2) then + begin + setlength(hs2,strlen(@hs2[1])); + GetShortName:=hs2; + end; +{$endif} +{$if defined(go32v2) or defined(watcom)} + hs:=n; + if Dos.GetShortName(hs) then + GetShortName:=hs; +{$endif} + end; + + +{**************************************************************************** + Init / Done +****************************************************************************} + + procedure InitFileUtils; + begin + DirCache:=TDirectoryCache.Create; + end; + + + procedure DoneFileUtils; + begin + DirCache.Free; + end; + +end. diff --git a/closures/compiler/cg64f32.pas b/closures/compiler/cg64f32.pas new file mode 100644 index 0000000000..2da012c2e9 --- /dev/null +++ b/closures/compiler/cg64f32.pas @@ -0,0 +1,971 @@ +{ + 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,aasmdata,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 : TAsmList;value : int64;const ref : treference);override; + procedure a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference);override; + procedure a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64);override; + procedure a_load64_reg_reg(list : TAsmList;regsrc,regdst : tregister64);override; + procedure a_load64_const_reg(list : TAsmList;value: int64;reg : tregister64);override; + + procedure a_load64_subsetref_reg(list : TAsmList; const sref: tsubsetreference; destreg: tregister64);override; + procedure a_load64_reg_subsetref(list : TAsmList; fromreg: tregister64; const sref: tsubsetreference);override; + procedure a_load64_const_subsetref(list: TAsmlist; a: int64; const sref: tsubsetreference);override; + procedure a_load64_ref_subsetref(list : TAsmList; const fromref: treference; const sref: tsubsetreference);override; + procedure a_load64_subsetref_subsetref(list: TAsmlist; const fromsref, tosref: tsubsetreference);override; + procedure a_load64_subsetref_ref(list : TAsmList; const sref: tsubsetreference; const destref: treference);override; + + procedure a_load64_loc_reg(list : TAsmList;const l : tlocation;reg : tregister64);override; + procedure a_load64_loc_ref(list : TAsmList;const l : tlocation;const ref : treference);override; + procedure a_load64_const_loc(list : TAsmList;value : int64;const l : tlocation);override; + procedure a_load64_reg_loc(list : TAsmList;reg : tregister64;const l : tlocation);override; + + + + procedure a_load64high_reg_ref(list : TAsmList;reg : tregister;const ref : treference);override; + procedure a_load64low_reg_ref(list : TAsmList;reg : tregister;const ref : treference);override; + procedure a_load64high_ref_reg(list : TAsmList;const ref : treference;reg : tregister);override; + procedure a_load64low_ref_reg(list : TAsmList;const ref : treference;reg : tregister);override; + procedure a_load64high_loc_reg(list : TAsmList;const l : tlocation;reg : tregister);override; + procedure a_load64low_loc_reg(list : TAsmList;const l : tlocation;reg : tregister);override; + + procedure a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);override; + procedure a_op64_reg_ref(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64; const ref: treference);override; + procedure a_op64_const_loc(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;const l: tlocation);override; + procedure a_op64_reg_loc(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64;const l : tlocation);override; + procedure a_op64_loc_reg(list : TAsmList;op:TOpCG;size : tcgsize;const l : tlocation;reg : tregister64);override; + procedure a_op64_const_ref(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;const ref : treference);override; + + procedure a_load64_reg_cgpara(list : TAsmList;reg : tregister64;const paraloc : tcgpara);override; + procedure a_load64_const_cgpara(list : TAsmList;value : int64;const paraloc : tcgpara);override; + procedure a_load64_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara);override; + procedure a_load64_loc_cgpara(list : TAsmList;const l : tlocation;const paraloc : tcgpara);override; + + procedure a_loadmm_intreg64_reg(list: TAsmList; mmsize: tcgsize; intreg: tregister64; mmreg: tregister);override; + procedure a_loadmm_reg_intreg64(list: TAsmList; mmsize: tcgsize; mmreg: tregister; intreg: tregister64);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: TAsmList; var op: topcg; var a : int64; var reg: tregister64): boolean;override; + + procedure g_rangecheck64(list: TAsmList; 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,constexp, + verbose,cutils, + symbase,symconst,symdef,symtable,defutil,paramgr, + tgobj; + +{**************************************************************************** + 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 + begin + inc(cgparalo.location^.reference.offset,4); + cgparalo.alignment:=newalignment(cgparalo.alignment,4); + end + else + begin + inc(cgparahi.location^.reference.offset,4); + cgparahi.alignment:=newalignment(cgparahi.alignment,4); + end; + 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 : TAsmList;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 : TAsmList;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 : TAsmList;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 : TAsmList;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 : TAsmList;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_subsetref_reg(list : TAsmList; const sref: tsubsetreference; destreg: tregister64); + + var + tmpreg: tregister; + tmpsref: tsubsetreference; + begin + if (sref.bitindexreg <> NR_NO) or + (sref.bitlen <> 64) then + internalerror(2006082310); + if (sref.startbit = 0) then + begin + a_load64_ref_reg(list,sref.ref,destreg); + exit; + end; + + if target_info.endian = endian_big then + begin + tmpreg := destreg.reglo; + destreg.reglo := destreg.reghi; + destreg.reghi := tmpreg; + end; + tmpsref:=sref; + if (tmpsref.ref.base=destreg.reglo) then + begin + tmpreg:=cg.getaddressregister(list); + cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpsref.ref.base,tmpreg); + tmpsref.ref.base:=tmpreg; + end + else + if (tmpsref.ref.index=destreg.reglo) then + begin + tmpreg:=cg.getaddressregister(list); + cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpsref.ref.index,tmpreg); + tmpsref.ref.index:=tmpreg; + end; + tmpsref.bitlen:=32; + cg.a_load_subsetref_reg(list,OS_32,OS_32,tmpsref,destreg.reglo); + inc(tmpsref.ref.offset,4); + cg.a_load_subsetref_reg(list,OS_32,OS_32,tmpsref,destreg.reghi); + end; + + + procedure tcg64f32.a_load64_reg_subsetref(list : TAsmList; fromreg: tregister64; const sref: tsubsetreference); + + var + tmpreg: tregister; + tmpsref: tsubsetreference; + begin + if (sref.bitindexreg <> NR_NO) or + (sref.bitlen <> 64) then + internalerror(2006082311); + if (sref.startbit = 0) then + begin + a_load64_reg_ref(list,fromreg,sref.ref); + exit; + end; + + if target_info.endian = endian_big then + begin + tmpreg:=fromreg.reglo; + fromreg.reglo:=fromreg.reghi; + fromreg.reghi:=tmpreg; + end; + tmpsref:=sref; + tmpsref.bitlen:=32; + cg.a_load_reg_subsetref(list,OS_32,OS_32,fromreg.reglo,tmpsref); + inc(tmpsref.ref.offset,4); + cg.a_load_reg_subsetref(list,OS_32,OS_32,fromreg.reghi,tmpsref); + end; + + + procedure tcg64f32.a_load64_const_subsetref(list: TAsmlist; a: int64; const sref: tsubsetreference); + + var + tmpsref: tsubsetreference; + begin + if (sref.bitindexreg <> NR_NO) or + (sref.bitlen <> 64) then + internalerror(2006082312); + if target_info.endian = endian_big then + swap64(a); + tmpsref := sref; + tmpsref.bitlen := 32; + cg.a_load_const_subsetref(list,OS_32,aint(lo(a)),tmpsref); + inc(tmpsref.ref.offset,4); + cg.a_load_const_subsetref(list,OS_32,aint(hi(a)),tmpsref); + end; + + + + + procedure tcg64f32.a_load64_subsetref_subsetref(list: TAsmlist; const fromsref, tosref: tsubsetreference); + + var + tmpreg64 : tregister64; + begin + tmpreg64.reglo:=cg.getintregister(list,OS_32); + tmpreg64.reghi:=cg.getintregister(list,OS_32); + a_load64_subsetref_reg(list,fromsref,tmpreg64); + a_load64_reg_subsetref(list,tmpreg64,tosref); + end; + + + procedure tcg64f32.a_load64_subsetref_ref(list : TAsmList; const sref: tsubsetreference; const destref: treference); + + var + tmpreg64 : tregister64; + begin + tmpreg64.reglo:=cg.getintregister(list,OS_32); + tmpreg64.reghi:=cg.getintregister(list,OS_32); + a_load64_subsetref_reg(list,sref,tmpreg64); + a_load64_reg_ref(list,tmpreg64,destref); + end; + + + procedure tcg64f32.a_load64_ref_subsetref(list : TAsmList; const fromref: treference; const sref: tsubsetreference); + + var + tmpreg64 : tregister64; + begin + tmpreg64.reglo:=cg.getintregister(list,OS_32); + tmpreg64.reghi:=cg.getintregister(list,OS_32); + a_load64_ref_reg(list,fromref,tmpreg64); + a_load64_reg_subsetref(list,tmpreg64,sref); + end; + + + procedure tcg64f32.a_load64_loc_reg(list : TAsmList;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); + LOC_SUBSETREF, LOC_CSUBSETREF: + a_load64_subsetref_reg(list,l.sref,reg); + else + internalerror(200112292); + end; + end; + + + procedure tcg64f32.a_load64_loc_ref(list : TAsmList;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); + LOC_SUBSETREF, LOC_CSUBSETREF: + a_load64_subsetref_ref(list,l.sref,ref); + else + internalerror(200203288); + end; + end; + + + procedure tcg64f32.a_load64_const_loc(list : TAsmList;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); + LOC_SUBSETREF, LOC_CSUBSETREF: + a_load64_const_subsetref(list,value,l.sref); + else + internalerror(200112293); + end; + end; + + + procedure tcg64f32.a_load64_reg_loc(list : TAsmList;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); + LOC_SUBSETREF, LOC_CSUBSETREF: + a_load64_reg_subsetref(list,reg,l.sref); + LOC_MMREGISTER, LOC_CMMREGISTER: + a_loadmm_intreg64_reg(list,l.size,reg,l.register); + else + internalerror(200112293); + end; + end; + + + procedure tcg64f32.a_load64high_reg_ref(list : TAsmList;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 : TAsmList;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 : TAsmList;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 : TAsmList;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 : TAsmList;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 : TAsmList;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,aint(hi(l.value64)),reg); + else + internalerror(200203244); + end; + end; + + + procedure tcg64f32.a_op64_const_loc(list : TAsmList;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 : TAsmList;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 : TAsmList;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 : TAsmList;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 : TAsmList;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 : TAsmList;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_load64_reg_cgpara(list : TAsmList;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_load_reg_cgpara(list,OS_32,reg.reghi,tmplochi); + cg.a_load_reg_cgpara(list,OS_32,reg.reglo,tmploclo); + tmploclo.done; + tmplochi.done; + end; + + + procedure tcg64f32.a_load64_const_cgpara(list : TAsmList;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_load_const_cgpara(list,OS_32,aint(hi(value)),tmplochi); + cg.a_load_const_cgpara(list,OS_32,aint(lo(value)),tmploclo); + tmploclo.done; + tmplochi.done; + end; + + + procedure tcg64f32.a_load64_ref_cgpara(list : TAsmList;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_load_ref_cgpara(list,OS_32,tmprefhi,tmplochi); + cg.a_load_ref_cgpara(list,OS_32,tmpreflo,tmploclo); + tmploclo.done; + tmplochi.done; + end; + + + procedure tcg64f32.a_load64_loc_cgpara(list : TAsmList;const l:tlocation;const paraloc : tcgpara); + begin + case l.loc of + LOC_REGISTER, + LOC_CREGISTER : + a_load64_reg_cgpara(list,l.register64,paraloc); + LOC_CONSTANT : + a_load64_const_cgpara(list,l.value64,paraloc); + LOC_CREFERENCE, + LOC_REFERENCE : + a_load64_ref_cgpara(list,l.reference,paraloc); + else + internalerror(200203287); + end; + end; + + + procedure tcg64f32.a_loadmm_intreg64_reg(list: TAsmList; mmsize: tcgsize; intreg: tregister64; mmreg: tregister); + var + tmpref: treference; + begin + if (tcgsize2size[mmsize]<>8) then + internalerror(2009112501); + tg.gettemp(list,8,8,tt_normal,tmpref); + a_load64_reg_ref(list,intreg,tmpref); + cg.a_loadmm_ref_reg(list,mmsize,mmsize,tmpref,mmreg,mms_movescalar); + tg.ungettemp(list,tmpref); + end; + + + procedure tcg64f32.a_loadmm_reg_intreg64(list: TAsmList; mmsize: tcgsize; mmreg: tregister; intreg: tregister64); + var + tmpref: treference; + begin + if (tcgsize2size[mmsize]<>8) then + internalerror(2009112502); + tg.gettemp(list,8,8,tt_normal,tmpref); + cg.a_loadmm_reg_ref(list,mmsize,mmsize,mmreg,tmpref,mms_movescalar); + a_load64_ref_reg(list,tmpref,intreg); + tg.ungettemp(list,tmpref); + end; + + + procedure tcg64f32.g_rangecheck64(list : TAsmList;const l:tlocation;fromdef,todef:tdef); + + var + neglabel, + poslabel, + endlabel: tasmlabel; + hreg : tregister; + hdef : torddef; + opsize : tcgsize; + 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 + { 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; + current_asmdata.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 + current_asmdata.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',false); + + { 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 + begin + inc(temploc.reference.offset,4); + temploc.reference.alignment:=newalignment(temploc.reference.alignment,4); + end; + + cg.g_rangecheck(list,temploc,hdef,todef); + hdef.owner.deletedef(hdef); + + if from_signed and to_signed then + begin + current_asmdata.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) } + current_asmdata.getjumplabel(neglabel); + cg.a_cmp_const_reg_label(list,OS_32,OC_LT,0,hreg,neglabel); + + cg.a_call_name(list,'FPC_RANGEERROR',false); + + { if we get here, the 64bit value lies between } + { longint($80000000) and -1 (JM) } + cg.a_label(list,neglabel); + hdef:=torddef.create(s32bit,int64(longint($80000000)),int64(-1)); + location_copy(temploc,l); + temploc.size:=OS_32; + cg.g_rangecheck(list,temploc,hdef,todef); + hdef.owner.deletedef(hdef); + cg.a_label(list,endlabel); + end; + 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).ordtype = 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:=OS_32; + + if l.size in [OS_64,OS_S64] then + a_load64high_ref_reg(list,l.reference,hreg) + else + cg.a_load_ref_reg(list,l.size,OS_32,l.reference,hreg); + end; + current_asmdata.getjumplabel(poslabel); + cg.a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel); + + cg.a_call_name(list,'FPC_RANGEERROR',false); + cg.a_label(list,poslabel); + end; + end; + + + function tcg64f32.optimize64_op_const_reg(list: TAsmList; 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. diff --git a/closures/compiler/cgbase.pas b/closures/compiler/cgbase.pas new file mode 100644 index 0000000000..08f130bad8 --- /dev/null +++ b/closures/compiler/cgbase.pas @@ -0,0 +1,693 @@ +{ + 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_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, + { contiguous subset of bits of an integer register } + LOC_SUBSETREG, + LOC_CSUBSETREG, + { contiguous subset of bits in memory } + LOC_SUBSETREF, + LOC_CSUBSETREF, + { keep these last for range checking purposes } + LOC_CREFERENCE, { in memory constant value reference (cannot change) } + LOC_REFERENCE { in memory value } + ); + + TCGNonRefLoc=low(TCGLoc)..pred(LOC_CREFERENCE); + TCGRefLoc=LOC_CREFERENCE..LOC_REFERENCE; + + { 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, + addr_pic, + addr_pic_no_got + {$IF defined(POWERPC) or defined(POWERPC64) or defined(SPARC) or defined(MIPS)} + , + addr_low, // bits 48-63 + addr_high, // bits 32-47 + {$IF defined(POWERPC64)} + addr_higher, // bits 16-31 + addr_highest, // bits 00-15 + {$ENDIF} + addr_higha // bits 16-31, adjusted + {$IF defined(POWERPC64)} + , + addr_highera, // bits 32-47, adjusted + addr_highesta // bits 48-63, adjusted + {$ENDIF} + {$ENDIF} + {$IFDEF AVR} + ,addr_lo8 + ,addr_hi8 + {$ENDIF} + ); + + + {# Generic opcodes, which must be supported by all processors + } + topcg = + ( + OP_NONE, + OP_MOVE, { replaced operation with direct load } + 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 } + OP_ROL, { rotate left } + OP_ROR { rotate right } + ); + + {# 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 } + R_SUBMMWHOLE { = 11; complete MM register, size depends on CPU } + ); + TSubRegisterSet = set of TSubRegister; + + 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 cpu64bitalu} + tregister64 = tregister; +{$else cpu64bitalu} + tregister64 = record + reglo,reghi : tregister; + end; +{$endif cpu64bitalu} + + 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 addnodup(s:tsuperregister): boolean; + function get:tsuperregister; + function readidx(i:word):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_F80,OS_C64,OS_C64,OS_F128); + + tcgsize2tfloat: array[OS_F32..OS_C64] of tfloattype = + (s32real,s64real,s80real,s64comp); + + tvarregable2tcgloc : array[tvarregable] of tcgloc = (LOC_VOID, + LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMREGISTER,LOC_CREGISTER); + + { 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[12] = ( + 'LOC_INVALID', + 'LOC_VOID', + 'LOC_CONST', + 'LOC_JUMP', + 'LOC_FLAGS', + 'LOC_REG', + 'LOC_CREG', + 'LOC_FPUREG', + 'LOC_CFPUREG', + 'LOC_MMXREG', + 'LOC_CMMXREG', + 'LOC_MMREG', + 'LOC_CMMREG', + 'LOC_SSETREG', + 'LOC_CSSETREG', + 'LOC_SSETREF', + 'LOC_CSSETREF', + 'LOC_CREF', + 'LOC_REF' + ); + + 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: tcgint): tcgsize;{$ifdef USEINLINE}inline;{$endif} + function int_float_cgsize(const a: tcgint): tcgsize; + + { return the inverse condition of opcmp } + function inverse_opcmp(opcmp: topcmp): topcmp;{$ifdef USEINLINE}inline;{$endif} + + { return the opcmp needed when swapping the operands } + function swap_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; + + + function tsuperregisterworklist.addnodup(s:tsuperregister): boolean; + + begin + addnodup := false; + if indexword(buf^,length,s) = -1 then + begin + add(s); + addnodup := true; + end; + end; + + + procedure tsuperregisterworklist.clear; + + begin + length:=0; + end; + + + procedure tsuperregisterworklist.deleteidx(i:word); + + begin + if i>=length then + internalerror(200310144); + buf^[i]:=buf^[length-1]; + dec(length); + end; + + + function tsuperregisterworklist.readidx(i:word):tsuperregister; + begin + if (i >= length) then + internalerror(2005010601); + result := buf^[i]; + 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; + R_ADDRESSREGISTER: + result:='areg'+nr; + R_SPECIALREGISTER: + result:='sreg'+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'; + R_SUBMMWHOLE: + result:=result+'ma'; + else + internalerror(200308252); + end; + end; + + + function int_cgsize(const a: tcgint): tcgsize;{$ifdef USEINLINE}inline;{$endif} + const + size2cgsize : array[0..8] of tcgsize = ( + OS_NO,OS_8,OS_16,OS_NO,OS_32,OS_NO,OS_NO,OS_NO,OS_64 + ); + begin + if a>8 then + result:=OS_NO + else + result:=size2cgsize[a]; + end; + + + function int_float_cgsize(const a: tcgint): tcgsize; + begin + case a of + 4 : + result:=OS_F32; + 8 : + result:=OS_F64; + 10 : + result:=OS_F80; + 16 : + result:=OS_F128; + else + internalerror(200603211); + end; + 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 swap_opcmp(opcmp: topcmp): topcmp;{$ifdef USEINLINE}inline;{$endif} + const + list: array[TOpCmp] of TOpCmp = + (OC_NONE,OC_EQ,OC_LT,OC_GT,OC_LTE,OC_GTE,OC_NE,OC_AE,OC_A, + OC_BE,OC_B); + begin + swap_opcmp := list[opcmp]; + end; + + + function commutativeop(op: topcg): boolean;{$ifdef USEINLINE}inline;{$endif} + const + list: array[topcg] of boolean = + (true,false,true,true,false,false,true,true,false,false, + true,false,false,false,false,true,false,false); + 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 4) 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 $f) or ((shuffle.shuffles[i] and $f0) shr 4); + end; + + +initialization + new(mms_movescalar); + mms_movescalar^.len:=0; +finalization + dispose(mms_movescalar); +end. diff --git a/closures/compiler/cgobj.pas b/closures/compiler/cgobj.pas new file mode 100644 index 0000000000..7f78586aff --- /dev/null +++ b/closures/compiler/cgobj.pas @@ -0,0 +1,4395 @@ +{ + 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,constexp, + cpubase,cgbase,cgutils,parabase, + aasmbase,aasmtai,aasmdata,aasmcpu, + symconst,symtype,symdef,rgobj + ; + + type + talignment = (AM_NATURAL,AM_NONE,AM_2BYTE,AM_4BYTE,AM_8BYTE); + tsubsetloadopt = (SL_REG,SL_REGNOSRCMASK,SL_SETZERO,SL_SETMAX); + + {# @abstract(Abstract code generator) + This class implements an abstract instruction generator. Some of + the methods of this class are generic, while others must + be overridden for all new processors which will be supported + by Free Pascal. For 32-bit processors, the base class + should be @link(tcg64f32) and not @var(tcg). + } + tcg = class + public + { how many times is this current code executed } + executionweight : longint; + alignment : talignment; + rg : array[tregistertype] of trgobj; + {$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; + {# Set whether live_start or live_end should be updated when allocating registers, needed when e.g. generating initcode after the rest of the code. } + procedure set_regalloc_live_range_direction(dir: TRADirection); + + {$ifdef flowgraph} + procedure init_flowgraph; + procedure done_flowgraph; + {$endif} + {# Gets a register suitable to do integer operations on.} + function getintregister(list:TAsmList;size:Tcgsize):Tregister;virtual; + {# Gets a register suitable to do integer operations on.} + function getaddressregister(list:TAsmList):Tregister;virtual; + function getfpuregister(list:TAsmList;size:Tcgsize):Tregister;virtual; + function getmmregister(list:TAsmList;size:Tcgsize):Tregister;virtual; + function getflagregister(list:TAsmList;size:Tcgsize):Tregister;virtual; + {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:TAsmList;r:Tregister);virtual; + procedure ungetcpuregister(list:TAsmList;r:Tregister);virtual; + {# Get multiple registers specified.} + procedure alloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset);virtual; + {# Free multiple registers specified.} + procedure dealloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset);virtual; + + procedure allocallcpuregisters(list:TAsmList);virtual; + procedure deallocallcpuregisters(list:TAsmList);virtual; + procedure do_register_allocation(list:TAsmList;headertai:tai);virtual; + procedure translate_register(var reg : tregister); + + function makeregsize(list:TAsmList;reg:Tregister;size:Tcgsize):Tregister; + + {# Emit a label to the instruction stream. } + procedure a_label(list : TAsmList;l : tasmlabel);virtual; + + {# Allocates register r by inserting a pai_realloc record } + procedure a_reg_alloc(list : TAsmList;r : tregister); + {# Deallocates register r by inserting a pa_regdealloc record} + procedure a_reg_dealloc(list : TAsmList;r : tregister); + { Synchronize register, make sure it is still valid } + procedure a_reg_sync(list : TAsmList;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. + It must generate register allocation information for the cgpara in + case it consists of cpuregisters. + + @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_load_reg_cgpara(list : TAsmList;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 overridden for optimization purposes if the cpu + permits directly sending this type of parameter. + It must generate register allocation information for the cgpara in + case it consists of cpuregisters. + + @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_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;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 overridden for optimization purposes if the cpu + permits directly sending this type of parameter. + It must generate register allocation information for the cgpara in + case it consists of cpuregisters. + + @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_load_ref_cgpara(list : TAsmList;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_load_loc_cgpara(list : TAsmList;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. + It must generate register allocation information for the cgpara in + case it consists of cpuregisters. + + A generic version is provided. This routine should + be overridden 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_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : TCGPara);virtual; + + {# Load a cgparaloc into a memory reference. + It must generate register allocation information for the cgpara in + case it consists of cpuregisters. + + @param(paraloc the source parameter sublocation) + @param(ref the destination reference) + @param(sizeleft indicates the total number of bytes left in all of + the remaining sublocations of this parameter (the current + sublocation and all of the sublocations coming after it). + In case this location is also a reference, it is assumed + to be the final part sublocation of the parameter and that it + contains all of the "sizeleft" bytes).) + @param(align the alignment of the paraloc in case it's a reference) + } + procedure a_load_cgparaloc_ref(list : TAsmList;const paraloc : TCGParaLocation;const ref : treference;sizeleft : tcgint;align : longint); + + {# Load a cgparaloc into any kind of register (int, fp, mm). + + @param(regsize the size of the destination register) + @param(paraloc the source parameter sublocation) + @param(reg the destination register) + @param(align the alignment of the paraloc in case it's a reference) + } + procedure a_load_cgparaloc_anyreg(list : TAsmList;regsize : tcgsize;const paraloc : TCGParaLocation;reg : tregister;align : longint); + + { 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 overridden for each new target cpu. + } + procedure a_call_name(list : TAsmList;const s : string; weak: boolean);virtual; abstract; + procedure a_call_reg(list : TAsmList;reg : tregister);virtual; abstract; + procedure a_call_ref(list : TAsmList;ref : treference);virtual; + { same as a_call_name, might be overridden on certain architectures to emit + static calls without usage of a got trampoline } + procedure a_call_name_static(list : TAsmList;const s : string);virtual; + + { move instructions } + procedure a_load_const_reg(list : TAsmList;size : tcgsize;a : tcgint;register : tregister);virtual; abstract; + procedure a_load_const_ref(list : TAsmList;size : tcgsize;a : tcgint;const ref : treference);virtual; + procedure a_load_const_loc(list : TAsmList;a : tcgint;const loc : tlocation); + procedure a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);virtual; abstract; + procedure a_load_reg_ref_unaligned(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);virtual; + procedure a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister);virtual; abstract; + procedure a_load_reg_loc(list : TAsmList;fromsize : tcgsize;reg : tregister;const loc: tlocation); + procedure a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);virtual; abstract; + procedure a_load_ref_reg_unaligned(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);virtual; + procedure a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);virtual; + procedure a_load_loc_reg(list : TAsmList;tosize: tcgsize; const loc: tlocation; reg : tregister); + procedure a_load_loc_ref(list : TAsmList;tosize: tcgsize; const loc: tlocation; const ref : treference); + procedure a_load_loc_subsetreg(list : TAsmList;subsetsize: tcgsize; const loc: tlocation; const sreg : tsubsetregister); + procedure a_load_loc_subsetref(list : TAsmList;subsetsize: tcgsize; const loc: tlocation; const sref : tsubsetreference); + procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);virtual; abstract; + + procedure a_load_subsetreg_reg(list : TAsmList; subsetsize, tosize: tcgsize; const sreg: tsubsetregister; destreg: tregister); virtual; + procedure a_load_reg_subsetreg(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sreg: tsubsetregister); virtual; + procedure a_load_subsetreg_subsetreg(list: TAsmlist; fromsubsetsize, tosubsetsize : tcgsize; const fromsreg, tosreg: tsubsetregister); virtual; + procedure a_load_subsetreg_ref(list : TAsmList; subsetsize, tosize: tcgsize; const sreg: tsubsetregister; const destref: treference); virtual; + procedure a_load_ref_subsetreg(list : TAsmList; fromsize, subsetsize: tcgsize; const fromref: treference; const sreg: tsubsetregister); virtual; + procedure a_load_const_subsetreg(list: TAsmlist; subsetsize: tcgsize; a: tcgint; const sreg: tsubsetregister); virtual; + procedure a_load_subsetreg_loc(list: TAsmlist; subsetsize: tcgsize; const sreg: tsubsetregister; const loc: tlocation); virtual; + + procedure a_load_subsetref_reg(list : TAsmList; subsetsize, tosize: tcgsize; const sref: tsubsetreference; destreg: tregister); virtual; + procedure a_load_reg_subsetref(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sref: tsubsetreference); + procedure a_load_subsetref_subsetref(list: TAsmlist; fromsubsetsize, tosubsetsize : tcgsize; const fromsref, tosref: tsubsetreference); virtual; + procedure a_load_subsetref_ref(list : TAsmList; subsetsize, tosize: tcgsize; const sref: tsubsetreference; const destref: treference); virtual; + procedure a_load_ref_subsetref(list : TAsmList; fromsize, subsetsize: tcgsize; const fromref: treference; const sref: tsubsetreference); virtual; + procedure a_load_const_subsetref(list: TAsmlist; subsetsize: tcgsize; a: tcgint; const sref: tsubsetreference); virtual; + procedure a_load_subsetref_loc(list: TAsmlist; subsetsize: tcgsize; const sref: tsubsetreference; const loc: tlocation); virtual; + procedure a_load_subsetref_subsetreg(list: TAsmlist; fromsubsetsize, tosubsetsize : tcgsize; const fromsref: tsubsetreference; const tosreg: tsubsetregister); virtual; + procedure a_load_subsetreg_subsetref(list: TAsmlist; fromsubsetsize, tosubsetsize : tcgsize; const fromsreg: tsubsetregister; const tosref: tsubsetreference); virtual; + + { bit test instructions } + procedure a_bit_test_reg_reg_reg(list : TAsmList; bitnumbersize,valuesize,destsize: tcgsize;bitnumber,value,destreg: tregister); virtual; + procedure a_bit_test_const_ref_reg(list: TAsmList; destsize: tcgsize; bitnumber: tcgint; const ref: treference; destreg: tregister); virtual; + procedure a_bit_test_const_reg_reg(list: TAsmList; setregsize, destsize: tcgsize; bitnumber: tcgint; setreg, destreg: tregister); virtual; + procedure a_bit_test_const_subsetreg_reg(list: TAsmList; setregsize, destsize: tcgsize; bitnumber: tcgint; const setreg: tsubsetregister; destreg: tregister); virtual; + procedure a_bit_test_reg_ref_reg(list: TAsmList; bitnumbersize, destsize: tcgsize; bitnumber: tregister; const ref: treference; destreg: tregister); virtual; + procedure a_bit_test_reg_loc_reg(list: TAsmList; bitnumbersize, destsize: tcgsize; bitnumber: tregister; const loc: tlocation; destreg: tregister); + procedure a_bit_test_const_loc_reg(list: TAsmList; destsize: tcgsize; bitnumber: tcgint; const loc: tlocation; destreg: tregister); + + { bit set/clear instructions } + procedure a_bit_set_reg_reg(list : TAsmList; doset: boolean; bitnumbersize, destsize: tcgsize; bitnumber,dest: tregister); virtual; + procedure a_bit_set_const_ref(list: TAsmList; doset: boolean;destsize: tcgsize; bitnumber: tcgint; const ref: treference); virtual; + procedure a_bit_set_const_reg(list: TAsmList; doset: boolean; destsize: tcgsize; bitnumber: tcgint; destreg: tregister); virtual; + procedure a_bit_set_const_subsetreg(list: TAsmList; doset: boolean; destsize: tcgsize; bitnumber: tcgint; const destreg: tsubsetregister); virtual; + procedure a_bit_set_reg_ref(list: TAsmList; doset: boolean; bitnumbersize: tcgsize; bitnumber: tregister; const ref: treference); virtual; + procedure a_bit_set_reg_loc(list: TAsmList; doset: boolean; bitnumbersize: tcgsize; bitnumber: tregister; const loc: tlocation); + procedure a_bit_set_const_loc(list: TAsmList; doset: boolean; bitnumber: tcgint; const loc: tlocation); + + { bit scan instructions } + procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tcgsize; src, dst: TRegister); virtual; abstract; + + { fpu move instructions } + procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize:tcgsize; reg1, reg2: tregister); virtual; abstract; + procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); virtual; abstract; + procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); virtual; abstract; + procedure a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tcgsize; const ref1,ref2: treference); + procedure a_loadfpu_loc_reg(list: TAsmList; tosize: tcgsize; const loc: tlocation; const reg: tregister); + procedure a_loadfpu_reg_loc(list: TAsmList; fromsize: tcgsize; const reg: tregister; const loc: tlocation); + procedure a_loadfpu_reg_cgpara(list : TAsmList;size : tcgsize;const r : tregister;const cgpara : TCGPara);virtual; + procedure a_loadfpu_ref_cgpara(list : TAsmList;size : tcgsize;const ref : treference;const cgpara : TCGPara);virtual; + + { vector register move instructions } + procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize : tcgsize;reg1, reg2: tregister;shuffle : pmmshuffle); virtual; + procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); virtual; + procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize : tcgsize;reg: tregister; const ref: treference;shuffle : pmmshuffle); virtual; + procedure a_loadmm_loc_reg(list: TAsmList; size: tcgsize; const loc: tlocation; const reg: tregister;shuffle : pmmshuffle); + procedure a_loadmm_reg_loc(list: TAsmList; size: tcgsize; const reg: tregister; const loc: tlocation;shuffle : pmmshuffle); + procedure a_loadmm_reg_cgpara(list: TAsmList; size: tcgsize; reg: tregister;const cgpara : TCGPara;shuffle : pmmshuffle); virtual; + procedure a_loadmm_ref_cgpara(list: TAsmList; size: tcgsize; const ref: treference;const cgpara : TCGPara;shuffle : pmmshuffle); virtual; + procedure a_loadmm_loc_cgpara(list: TAsmList; const loc: tlocation; const cgpara : TCGPara;shuffle : pmmshuffle); virtual; + procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size : tcgsize;src,dst: tregister;shuffle : pmmshuffle); virtual; + procedure a_opmm_ref_reg(list: TAsmList; Op: TOpCG; size : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); virtual; + procedure a_opmm_loc_reg(list: TAsmList; Op: TOpCG; size : tcgsize;const loc: tlocation; reg: tregister;shuffle : pmmshuffle); virtual; + procedure a_opmm_reg_ref(list: TAsmList; Op: TOpCG; size : tcgsize;reg: tregister;const ref: treference; shuffle : pmmshuffle); virtual; + + procedure a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize : tcgsize; intreg, mmreg: tregister; shuffle: pmmshuffle); virtual; + procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize : tcgsize; mmreg, intreg: tregister; 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 : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); virtual; abstract; + procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); virtual; + procedure a_op_const_subsetreg(list : TAsmList; Op : TOpCG; size, subsetsize : TCGSize; a : tcgint; const sreg: tsubsetregister); virtual; + procedure a_op_const_subsetref(list : TAsmList; Op : TOpCG; size, subsetsize : TCGSize; a : tcgint; const sref: tsubsetreference); virtual; + procedure a_op_const_loc(list : TAsmList; Op: TOpCG; a: tcgint; const loc: tlocation); + procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); virtual; abstract; + procedure a_op_reg_ref(list : TAsmList; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference); virtual; + procedure a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); virtual; + procedure a_op_reg_subsetreg(list : TAsmList; Op : TOpCG; opsize, subsetsize : TCGSize; reg: TRegister; const sreg: tsubsetregister); virtual; + procedure a_op_reg_subsetref(list : TAsmList; Op : TOpCG; opsize, subsetsize : TCGSize; reg: TRegister; const sref: tsubsetreference); virtual; + procedure a_op_reg_loc(list : TAsmList; Op: TOpCG; reg: tregister; const loc: tlocation); + procedure a_op_ref_loc(list : TAsmList; 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: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister); virtual; + procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister); virtual; + procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); virtual; + procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); virtual; + + { comparison operations } + procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; + l : tasmlabel); virtual; + procedure a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const ref : treference; + l : tasmlabel); virtual; + procedure a_cmp_const_loc_label(list: TAsmList; size: tcgsize;cmp_op: topcmp; a: tcgint; const loc: tlocation; + l : tasmlabel); + procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); virtual; abstract; + procedure a_cmp_ref_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel); virtual; + procedure a_cmp_reg_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg : tregister; const ref: treference; l : tasmlabel); virtual; + procedure a_cmp_subsetreg_reg_label(list : TAsmList; subsetsize, cmpsize : tcgsize; cmp_op : topcmp; const sreg: tsubsetregister; reg : tregister; l : tasmlabel); virtual; + procedure a_cmp_subsetref_reg_label(list : TAsmList; subsetsize, cmpsize : tcgsize; cmp_op : topcmp; const sref: tsubsetreference; reg : tregister; l : tasmlabel); virtual; + + procedure a_cmp_loc_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp; const loc: tlocation; reg : tregister; l : tasmlabel); + procedure a_cmp_reg_loc_label(list : TAsmList;size : tcgsize;cmp_op : topcmp; reg: tregister; const loc: tlocation; l : tasmlabel); + procedure a_cmp_ref_loc_label(list: TAsmList; size: tcgsize;cmp_op: topcmp; const ref: treference; const loc: tlocation; + l : tasmlabel); + + procedure a_jmp_name(list : TAsmList;const s : string); virtual; abstract; + procedure a_jmp_always(list : TAsmList;l: tasmlabel); virtual; abstract; +{$ifdef cpuflags} + procedure a_jmp_flags(list : TAsmList;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: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister); virtual; abstract; + procedure g_flags2ref(list: TAsmList; size: TCgSize; const f: tresflags; const ref:TReference); virtual; +{$endif cpuflags} + + { + This routine tries to optimize the op_const_reg/ref opcode, and should be + called at the start of a_op_const_reg/ref. It returns the actual opcode + to emit, and the constant value to emit. This function can opcode OP_NONE to + remove the opcode and OP_MOVE to replace it with a simple load + + @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) + } + procedure optimize_op_const(var op: topcg; var a : tcgint);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 : TAsmList; 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 : TAsmList; const href : treference; a: tcgint);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 : TAsmList; const href : treference);virtual; + + procedure g_maybe_testself(list : TAsmList;reg:tregister); + procedure g_maybe_testvmt(list : TAsmList;reg:tregister;objdef:tobjectdef); + {# This should emit the opcode to copy len bytes from the source + to destination. + + It must be overridden for each new target processor. + + @param(source Source reference of copy) + @param(dest Destination reference of copy) + + } + procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);virtual; abstract; + {# This should emit the opcode to copy len bytes from the an unaligned source + to destination. + + It must be overridden for each new target processor. + + @param(source Source reference of copy) + @param(dest Destination reference of copy) + + } + procedure g_concatcopy_unaligned(list : TAsmList;const source,dest : treference;len : tcgint);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 : TAsmList;const source,dest : treference;len:byte); + procedure g_copyvariant(list : TAsmList;const source,dest : treference); + + procedure g_incrrefcount(list : TAsmList;t: tdef; const ref: treference); + procedure g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation; + const name: string); + procedure g_initialize(list : TAsmList;t : tdef;const ref : treference); + procedure g_finalize(list : TAsmList;t : tdef;const ref : treference); + + {# Generates range checking code. It is to note + that this routine does not need to be overridden, + 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: TAsmList; const l:tlocation; fromdef,todef: tdef); virtual; + + {# Generates overflow checking code for a node } + procedure g_overflowcheck(list: TAsmList; const Loc:tlocation; def:tdef); virtual;abstract; + procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation);virtual; + + procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;destreg:tregister);virtual; + procedure g_releasevaluepara_openarray(list : TAsmList;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 overridden as required. + } + procedure g_profilecode(list : TAsmList);virtual; + {# Emits instruction for allocating @var(size) bytes at the stackpointer + + @param(size Number of bytes to allocate) + } + procedure g_stackpointer_alloc(list : TAsmList;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 : TAsmList;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 : TAsmList;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_registers(list:TAsmList);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_registers(list:TAsmList);virtual; + + procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);virtual;abstract; + procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint);virtual; + + function g_indirect_sym_load(list:TAsmList;const symname: string; weak: boolean): tregister;virtual; + { generate a stub which only purpose is to pass control the given external method, + setting up any additional environment before doing so (if required). + + The default implementation issues a jump instruction to the external name. } + procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string); virtual; + + { initialize the pic/got register } + procedure g_maybe_got_init(list: TAsmList); virtual; + { allocallcpuregisters, a_call_name, deallocallcpuregisters sequence } + procedure g_call(list: TAsmList; const s: string); + { Generate code to exit an unwind-protected region. The default implementation + produces a simple jump to destination label. } + procedure g_local_unwind(list: TAsmList; l: TAsmLabel);virtual; + protected + procedure get_subsetref_load_info(const sref: tsubsetreference; out loadsize: tcgsize; out extra_load: boolean); + procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); virtual; + procedure a_load_subsetref_regs_index(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg: tregister); virtual; + + procedure a_load_regconst_subsetref_intern(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sref: tsubsetreference; slopt: tsubsetloadopt); virtual; + procedure a_load_regconst_subsetreg_intern(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt); virtual; + + function get_bit_const_ref_sref(bitnumber: tcgint; const ref: treference): tsubsetreference; + function get_bit_const_reg_sreg(setregsize: tcgsize; bitnumber: tcgint; setreg: tregister): tsubsetregister; + function get_bit_reg_ref_sref(list: TAsmList; bitnumbersize: tcgsize; bitnumber: tregister; const ref: treference): tsubsetreference; + end; + +{$ifndef cpu64bitalu} + {# @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 : TAsmList;value : int64;const ref : treference);virtual;abstract; + procedure a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference);virtual;abstract; + procedure a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64);virtual;abstract; + procedure a_load64_reg_reg(list : TAsmList;regsrc,regdst : tregister64);virtual;abstract; + procedure a_load64_const_reg(list : TAsmList;value : int64;reg : tregister64);virtual;abstract; + procedure a_load64_loc_reg(list : TAsmList;const l : tlocation;reg : tregister64);virtual;abstract; + procedure a_load64_loc_ref(list : TAsmList;const l : tlocation;const ref : treference);virtual;abstract; + procedure a_load64_const_loc(list : TAsmList;value : int64;const l : tlocation);virtual;abstract; + procedure a_load64_reg_loc(list : TAsmList;reg : tregister64;const l : tlocation);virtual;abstract; + + + procedure a_load64_subsetref_reg(list : TAsmList; const sref: tsubsetreference; destreg: tregister64);virtual;abstract; + procedure a_load64_reg_subsetref(list : TAsmList; fromreg: tregister64; const sref: tsubsetreference);virtual;abstract; + procedure a_load64_const_subsetref(list: TAsmlist; a: int64; const sref: tsubsetreference);virtual;abstract; + procedure a_load64_ref_subsetref(list : TAsmList; const fromref: treference; const sref: tsubsetreference);virtual;abstract; + procedure a_load64_subsetref_subsetref(list: TAsmlist; const fromsref, tosref: tsubsetreference); virtual;abstract; + procedure a_load64_subsetref_ref(list : TAsmList; const sref: tsubsetreference; const destref: treference); virtual;abstract; + procedure a_load64_loc_subsetref(list : TAsmList; const l: tlocation; const sref : tsubsetreference); + procedure a_load64_subsetref_loc(list: TAsmlist; const sref: tsubsetreference; const l: tlocation); + + procedure a_load64high_reg_ref(list : TAsmList;reg : tregister;const ref : treference);virtual;abstract; + procedure a_load64low_reg_ref(list : TAsmList;reg : tregister;const ref : treference);virtual;abstract; + procedure a_load64high_ref_reg(list : TAsmList;const ref : treference;reg : tregister);virtual;abstract; + procedure a_load64low_ref_reg(list : TAsmList;const ref : treference;reg : tregister);virtual;abstract; + procedure a_load64high_loc_reg(list : TAsmList;const l : tlocation;reg : tregister);virtual;abstract; + procedure a_load64low_loc_reg(list : TAsmList;const l : tlocation;reg : tregister);virtual;abstract; + + procedure a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);virtual;abstract; + procedure a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);virtual;abstract; + procedure a_op64_reg_ref(list : TAsmList;op:TOpCG;size : tcgsize;regsrc : tregister64;const ref : treference);virtual;abstract; + procedure a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;regdst : tregister64);virtual;abstract; + procedure a_op64_const_ref(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;const ref : treference);virtual;abstract; + procedure a_op64_const_loc(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;const l: tlocation);virtual;abstract; + procedure a_op64_reg_loc(list : TAsmList;op:TOpCG;size : tcgsize;reg : tregister64;const l : tlocation);virtual;abstract; + procedure a_op64_loc_reg(list : TAsmList;op:TOpCG;size : tcgsize;const l : tlocation;reg64 : tregister64);virtual;abstract; + procedure a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);virtual; + procedure a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);virtual; + procedure a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);virtual; + procedure a_op64_reg_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);virtual; + + procedure a_op64_const_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; a : int64; const sref: tsubsetreference); + procedure a_op64_reg_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; reg: tregister64; const sref: tsubsetreference); + procedure a_op64_ref_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; const ref: treference; const sref: tsubsetreference); + procedure a_op64_subsetref_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; const ssref,dsref: tsubsetreference); + + procedure a_load64_reg_cgpara(list : TAsmList;reg64 : tregister64;const loc : TCGPara);virtual;abstract; + procedure a_load64_const_cgpara(list : TAsmList;value : int64;const loc : TCGPara);virtual;abstract; + procedure a_load64_ref_cgpara(list : TAsmList;const r : treference;const loc : TCGPara);virtual;abstract; + procedure a_load64_loc_cgpara(list : TAsmList;const l : tlocation;const loc : TCGPara);virtual;abstract; + + procedure a_loadmm_intreg64_reg(list: TAsmList; mmsize: tcgsize; intreg: tregister64; mmreg: tregister); virtual;abstract; + procedure a_loadmm_reg_intreg64(list: TAsmList; mmsize: tcgsize; mmreg: tregister; intreg: tregister64); 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: TAsmList; var op: topcg; var a : int64; var reg: tregister64): boolean;virtual;abstract; + + + { override to catch 64bit rangechecks } + procedure g_rangecheck64(list: TAsmList; const l:tlocation; fromdef,todef: tdef);virtual;abstract; + end; +{$endif cpu64bitalu} + + var + {# Main code generator class } + cg : tcg; +{$ifndef cpu64bitalu} + {# Code generator class for all operations working with 64-Bit operands } + cg64 : tcg64; +{$endif cpu64bitalu} + + procedure destroy_codegen; + +implementation + + uses + globals,options,systems, + verbose,defutil,paramgr,symsym, + tgobj,cutils,procinfo, + ncgrtti; + + +{***************************************************************************** + 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; + executionweight:=1; + 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:TAsmList;size:Tcgsize):Tregister; + begin + if not assigned(rg[R_INTREGISTER]) then + internalerror(200312122); + result:=rg[R_INTREGISTER].getregister(list,cgsize2subreg(R_INTREGISTER,size)); + end; + + + function tcg.getfpuregister(list:TAsmList;size:Tcgsize):Tregister; + begin + if not assigned(rg[R_FPUREGISTER]) then + internalerror(200312123); + result:=rg[R_FPUREGISTER].getregister(list,cgsize2subreg(R_FPUREGISTER,size)); + end; + + + function tcg.getmmregister(list:TAsmList;size:Tcgsize):Tregister; + begin + if not assigned(rg[R_MMREGISTER]) then + internalerror(2003121214); + result:=rg[R_MMREGISTER].getregister(list,cgsize2subreg(R_MMREGISTER,size)); + end; + + + function tcg.getaddressregister(list:TAsmList):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:TAsmList;reg:Tregister;size:Tcgsize):Tregister; + var + subreg:Tsubregister; + begin + subreg:=cgsize2subreg(getregtype(reg),size); + result:=reg; + setsubreg(result,subreg); + { notify RA } + if result<>reg then + list.concat(tai_regalloc.resize(result)); + end; + + + procedure tcg.getcpuregister(list:TAsmList;r:Tregister); + begin + if not assigned(rg[getregtype(r)]) then + internalerror(200312125); + rg[getregtype(r)].getcpuregister(list,r); + end; + + + procedure tcg.ungetcpuregister(list:TAsmList;r:Tregister); + begin + if not assigned(rg[getregtype(r)]) then + internalerror(200312126); + rg[getregtype(r)].ungetcpuregister(list,r); + end; + + + procedure tcg.alloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset); + begin + if assigned(rg[rt]) then + rg[rt].alloccpuregisters(list,r) + else + internalerror(200310092); + end; + + + procedure tcg.allocallcpuregisters(list:TAsmList); + begin + alloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); +{$if not(defined(i386)) and not(defined(avr))} + 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 not(defined(i386)) and not(defined(avr))} + end; + + + procedure tcg.dealloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset); + begin + if assigned(rg[rt]) then + rg[rt].dealloccpuregisters(list,r) + else + internalerror(200310093); + end; + + + procedure tcg.deallocallcpuregisters(list:TAsmList); + begin + dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); +{$if not(defined(i386)) and not(defined(avr))} + 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 not(defined(i386)) and not(defined(avr))} + 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,cg.executionweight); + 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.set_regalloc_live_range_direction(dir: TRADirection); + var + rt : tregistertype; + begin + for rt:=low(rg) to high(rg) do + begin + if assigned(rg[rt]) then + rg[rt].live_range_direction:=dir; + end; + end; + + + procedure tcg.do_register_allocation(list:TAsmList;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.translate_register(var reg : tregister); + begin + rg[getregtype(reg)].translate_register(reg); + end; + + + procedure tcg.a_reg_alloc(list : TAsmList;r : tregister); + begin + list.concat(tai_regalloc.alloc(r,nil)); + end; + + + procedure tcg.a_reg_dealloc(list : TAsmList;r : tregister); + begin + list.concat(tai_regalloc.dealloc(r,nil)); + end; + + + procedure tcg.a_reg_sync(list : TAsmList;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 : TAsmList;l : tasmlabel); + begin + list.concat(tai_label.create(l)); + end; + + +{***************************************************************************** + for better code generation these methods should be overridden +******************************************************************************} + + procedure tcg.a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : TCGPara); + var + ref : treference; + begin + cgpara.check_simple_location; + paramanager.alloccgpara(list,cgpara); + 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,cgpara.alignment); + a_load_reg_ref(list,size,cgpara.location^.size,r,ref); + end; + LOC_MMREGISTER,LOC_CMMREGISTER: + a_loadmm_intreg_reg(list,size,cgpara.location^.size,r,cgpara.location^.register,mms_movescalar); + LOC_FPUREGISTER,LOC_CFPUREGISTER: + begin + tg.GetTemp(list,TCGSize2Size[size],TCGSize2Size[size],tt_normal,ref); + a_load_reg_ref(list,size,size,r,ref); + a_loadfpu_ref_cgpara(list,cgpara.location^.size,ref,cgpara); + tg.Ungettemp(list,ref); + end + else + internalerror(2002071004); + end; + end; + + + procedure tcg.a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : TCGPara); + var + ref : treference; + begin + cgpara.check_simple_location; + paramanager.alloccgpara(list,cgpara); + 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,cgpara.alignment); + a_load_const_ref(list,cgpara.location^.size,a,ref); + end + else + internalerror(2010053109); + end; + end; + + + procedure tcg.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : TCGPara); + var + tmpref, ref: treference; + tmpreg: tregister; + location: pcgparalocation; + orgsizeleft, + sizeleft: tcgint; + reghasvalue: boolean; + begin + location:=cgpara.location; + tmpref:=r; + sizeleft:=cgpara.intsize; + while assigned(location) do + begin + paramanager.allocparaloc(list,location); + case location^.loc of + LOC_REGISTER,LOC_CREGISTER: + begin + { Parameter locations are often allocated in multiples of + entire registers. If a parameter only occupies a part of + such a register (e.g. a 16 bit int on a 32 bit + architecture), the size of this parameter can only be + determined by looking at the "size" parameter of this + method -> if the size parameter is <= sizeof(aint), then + we check that there is only one parameter location and + then use this "size" to load the value into the parameter + location } + if (size<>OS_NO) and + (tcgsize2size[size]<=sizeof(aint)) then + begin + cgpara.check_simple_location; + a_load_ref_reg(list,size,location^.size,tmpref,location^.register); + end + { there's a lot more data left, and the current paraloc's + register is entirely filled with part of that data } + else if (sizeleft>sizeof(aint)) then + begin + a_load_ref_reg(list,location^.size,location^.size,tmpref,location^.register); + end + { we're at the end of the data, and it can be loaded into + the current location's register with a single regular + load } + else if (sizeleft in [1,2{$ifndef cpu16bitalu},4{$endif}{$ifdef cpu64bitalu},8{$endif}]) then + begin + a_load_ref_reg(list,int_cgsize(sizeleft),location^.size,tmpref,location^.register); + end + { we're at the end of the data, and we need multiple loads + to get it in the register because it's an irregular size } + else + begin + { should be the last part } + if assigned(location^.next) then + internalerror(2010052907); + { load the value piecewise to get it into the register } + orgsizeleft:=sizeleft; + reghasvalue:=false; +{$ifdef cpu64bitalu} + if sizeleft>=4 then + begin + a_load_ref_reg(list,OS_32,location^.size,tmpref,location^.register); + dec(sizeleft,4); + if target_info.endian=endian_big then + a_op_const_reg(list,OP_SHL,location^.size,sizeleft*8,location^.register); + inc(tmpref.offset,4); + reghasvalue:=true; + end; +{$endif cpu64bitalu} + if sizeleft>=2 then + begin + tmpreg:=getintregister(list,location^.size); + a_load_ref_reg(list,OS_16,location^.size,tmpref,tmpreg); + dec(sizeleft,2); + if reghasvalue then + begin + if target_info.endian=endian_big then + a_op_const_reg(list,OP_SHL,location^.size,sizeleft*8,tmpreg) + else + a_op_const_reg(list,OP_SHL,location^.size,(orgsizeleft-(sizeleft+2))*8,tmpreg); + a_op_reg_reg(list,OP_OR,location^.size,tmpreg,location^.register); + end + else + begin + if target_info.endian=endian_big then + a_op_const_reg_reg(list,OP_SHL,location^.size,sizeleft*8,tmpreg,location^.register) + else + a_load_reg_reg(list,location^.size,location^.size,tmpreg,location^.register); + end; + inc(tmpref.offset,2); + reghasvalue:=true; + end; + if sizeleft=1 then + begin + tmpreg:=getintregister(list,location^.size); + a_load_ref_reg(list,OS_8,location^.size,tmpref,tmpreg); + dec(sizeleft,1); + if reghasvalue then + begin + if target_info.endian=endian_little then + a_op_const_reg(list,OP_SHL,location^.size,(orgsizeleft-(sizeleft+1))*8,tmpreg); + a_op_reg_reg(list,OP_OR,location^.size,tmpreg,location^.register) + end + else + a_load_reg_reg(list,location^.size,location^.size,tmpreg,location^.register); + inc(tmpref.offset); + end; + { the loop will already adjust the offset and sizeleft } + dec(tmpref.offset,orgsizeleft); + sizeleft:=orgsizeleft; + end; + end; + LOC_REFERENCE,LOC_CREFERENCE: + begin + if assigned(location^.next) then + internalerror(2010052906); + reference_reset_base(ref,location^.reference.index,location^.reference.offset,newalignment(cgpara.alignment,cgpara.intsize-sizeleft)); + if (size <> OS_NO) and + (tcgsize2size[size] <= sizeof(aint)) then + a_load_ref_ref(list,size,location^.size,tmpref,ref) + else + { use concatcopy, because the parameter can be larger than } + { what the OS_* constants can handle } + g_concatcopy(list,tmpref,ref,sizeleft); + end; + LOC_MMREGISTER,LOC_CMMREGISTER: + begin + case location^.size of + OS_F32, + OS_F64, + OS_F128: + a_loadmm_ref_reg(list,location^.size,location^.size,tmpref,location^.register,mms_movescalar); + OS_M8..OS_M128, + OS_MS8..OS_MS128: + a_loadmm_ref_reg(list,location^.size,location^.size,tmpref,location^.register,nil); + else + internalerror(2010053101); + end; + end + else + internalerror(2010053111); + end; + inc(tmpref.offset,tcgsize2size[location^.size]); + dec(sizeleft,tcgsize2size[location^.size]); + location:=location^.next; + end; + end; + + + procedure tcg.a_load_loc_cgpara(list : TAsmList;const l:tlocation;const cgpara : TCGPara); + begin + case l.loc of + LOC_REGISTER, + LOC_CREGISTER : + a_load_reg_cgpara(list,l.size,l.register,cgpara); + LOC_CONSTANT : + a_load_const_cgpara(list,l.size,l.value,cgpara); + LOC_CREFERENCE, + LOC_REFERENCE : + a_load_ref_cgpara(list,l.size,l.reference,cgpara); + else + internalerror(2002032211); + end; + end; + + + procedure tcg.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : TCGPara); + var + hr : tregister; + begin + cgpara.check_simple_location; + if cgpara.location^.loc in [LOC_CREGISTER,LOC_REGISTER] then + begin + paramanager.allocparaloc(list,cgpara.location); + a_loadaddr_ref_reg(list,r,cgpara.location^.register) + end + else + begin + hr:=getaddressregister(list); + a_loadaddr_ref_reg(list,r,hr); + a_load_reg_cgpara(list,OS_ADDR,hr,cgpara); + end; + end; + + + procedure tcg.a_load_cgparaloc_ref(list : TAsmList;const paraloc : TCGParaLocation;const ref : treference;sizeleft : tcgint;align : longint); + var + href : treference; + begin + case paraloc.loc of + LOC_REGISTER : + begin +{$IFDEF POWERPC64} + if (paraloc.shiftval <> 0) then + a_op_const_reg_reg(list, OP_SHL, OS_INT, paraloc.shiftval, paraloc.register, paraloc.register); +{$ENDIF POWERPC64} + a_load_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref); + end; + LOC_MMREGISTER : + begin + case paraloc.size of + OS_F32, + OS_F64, + OS_F128: + a_loadmm_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref,mms_movescalar); + OS_M8..OS_M128, + OS_MS8..OS_MS128: + a_loadmm_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref,nil); + else + internalerror(2010053102); + end; + end; + LOC_FPUREGISTER : + cg.a_loadfpu_reg_ref(list,paraloc.size,paraloc.size,paraloc.register,ref); + LOC_REFERENCE : + begin + reference_reset_base(href,paraloc.reference.index,paraloc.reference.offset,align); + { use concatcopy, because it can also be a float which fails when + load_ref_ref is used. Don't copy data when the references are equal } + if not((href.base=ref.base) and (href.offset=ref.offset)) then + g_concatcopy(list,href,ref,sizeleft); + end; + else + internalerror(2002081302); + end; + end; + + + procedure tcg.a_load_cgparaloc_anyreg(list: TAsmList;regsize: tcgsize;const paraloc: TCGParaLocation;reg: tregister;align: longint); + var + href : treference; + begin + case paraloc.loc of + LOC_REGISTER : + begin + case getregtype(reg) of + R_INTREGISTER: + a_load_reg_reg(list,paraloc.size,regsize,paraloc.register,reg); + R_MMREGISTER: + a_loadmm_intreg_reg(list,paraloc.size,regsize,paraloc.register,reg,mms_movescalar); + else + internalerror(2009112422); + end; + end; + LOC_MMREGISTER : + begin + case getregtype(reg) of + R_INTREGISTER: + a_loadmm_reg_intreg(list,paraloc.size,regsize,paraloc.register,reg,mms_movescalar); + R_MMREGISTER: + begin + case paraloc.size of + OS_F32, + OS_F64, + OS_F128: + a_loadmm_reg_reg(list,paraloc.size,regsize,paraloc.register,reg,mms_movescalar); + OS_M8..OS_M128, + OS_MS8..OS_MS128: + a_loadmm_reg_reg(list,paraloc.size,paraloc.size,paraloc.register,reg,nil); + else + internalerror(2010053102); + end; + end; + else + internalerror(2010053104); + end; + end; + LOC_FPUREGISTER : + a_loadfpu_reg_reg(list,paraloc.size,regsize,paraloc.register,reg); + LOC_REFERENCE : + begin + reference_reset_base(href,paraloc.reference.index,paraloc.reference.offset,align); + case getregtype(reg) of + R_INTREGISTER : + a_load_ref_reg(list,paraloc.size,regsize,href,reg); + R_FPUREGISTER : + a_loadfpu_ref_reg(list,paraloc.size,regsize,href,reg); + R_MMREGISTER : + { not paraloc.size, because it may be OS_64 instead of + OS_F64 in case the parameter is passed using integer + conventions (e.g., on ARM) } + a_loadmm_ref_reg(list,regsize,regsize,href,reg,mms_movescalar); + else + internalerror(2004101012); + end; + end; + else + internalerror(2002081302); + end; + end; + + +{**************************************************************************** + some generic implementations +****************************************************************************} + +{$push} +{$r-} +{$q-} + + procedure tcg.a_load_subsetreg_reg(list : TAsmList; subsetsize, tosize: tcgsize; const sreg: tsubsetregister; destreg: tregister); + var + bitmask: aword; + tmpreg: tregister; + stopbit: byte; + begin + tmpreg:=getintregister(list,sreg.subsetregsize); + if (subsetsize in [OS_S8..OS_S128]) then + begin + { sign extend in case the value has a bitsize mod 8 <> 0 } + { both instructions will be optimized away if not } + a_op_const_reg_reg(list,OP_SHL,sreg.subsetregsize,(tcgsize2size[sreg.subsetregsize]*8)-sreg.startbit-sreg.bitlen,sreg.subsetreg,tmpreg); + a_op_const_reg(list,OP_SAR,sreg.subsetregsize,(tcgsize2size[sreg.subsetregsize]*8)-sreg.bitlen,tmpreg); + end + else + begin + a_op_const_reg_reg(list,OP_SHR,sreg.subsetregsize,sreg.startbit,sreg.subsetreg,tmpreg); + stopbit := sreg.startbit + sreg.bitlen; + // on x86(64), 1 shl 32(64) = 1 instead of 0 + // use aword to prevent overflow with 1 shl 31 + if (stopbit - sreg.startbit <> AIntBits) then + bitmask := (aword(1) shl (stopbit - sreg.startbit)) - 1 + else + bitmask := high(aword); + a_op_const_reg(list,OP_AND,sreg.subsetregsize,tcgint(bitmask),tmpreg); + end; + tmpreg := makeregsize(list,tmpreg,subsetsize); + a_load_reg_reg(list,tcgsize2unsigned[subsetsize],subsetsize,tmpreg,tmpreg); + a_load_reg_reg(list,subsetsize,tosize,tmpreg,destreg); + end; + + + procedure tcg.a_load_reg_subsetreg(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sreg: tsubsetregister); + begin + a_load_regconst_subsetreg_intern(list,fromsize,subsetsize,fromreg,sreg,SL_REG); + end; + + + procedure tcg.a_load_regconst_subsetreg_intern(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt); + var + bitmask: aword; + tmpreg: tregister; + stopbit: byte; + begin + stopbit := sreg.startbit + sreg.bitlen; + // on x86(64), 1 shl 32(64) = 1 instead of 0 + if (stopbit <> AIntBits) then + bitmask := not(((aword(1) shl stopbit)-1) xor ((aword(1) shl sreg.startbit)-1)) + else + bitmask := not(high(aword) xor ((aword(1) shl sreg.startbit)-1)); + if not(slopt in [SL_SETZERO,SL_SETMAX]) then + begin + tmpreg:=getintregister(list,sreg.subsetregsize); + a_load_reg_reg(list,fromsize,sreg.subsetregsize,fromreg,tmpreg); + a_op_const_reg(list,OP_SHL,sreg.subsetregsize,sreg.startbit,tmpreg); + if (slopt <> SL_REGNOSRCMASK) then + a_op_const_reg(list,OP_AND,sreg.subsetregsize,tcgint(not(bitmask)),tmpreg); + end; + if (slopt <> SL_SETMAX) then + a_op_const_reg(list,OP_AND,sreg.subsetregsize,tcgint(bitmask),sreg.subsetreg); + + case slopt of + SL_SETZERO : ; + SL_SETMAX : + if (sreg.bitlen <> AIntBits) then + a_op_const_reg(list,OP_OR,sreg.subsetregsize, + tcgint(((aword(1) shl sreg.bitlen)-1) shl sreg.startbit), + sreg.subsetreg) + else + a_load_const_reg(list,sreg.subsetregsize,-1,sreg.subsetreg); + else + a_op_reg_reg(list,OP_OR,sreg.subsetregsize,tmpreg,sreg.subsetreg); + end; + end; + + + procedure tcg.a_load_subsetreg_subsetreg(list: TAsmlist; fromsubsetsize, tosubsetsize : tcgsize; const fromsreg, tosreg: tsubsetregister); + var + tmpreg: tregister; + bitmask: aword; + stopbit: byte; + begin + if (fromsreg.bitlen >= tosreg.bitlen) then + begin + tmpreg := getintregister(list,tosreg.subsetregsize); + a_load_reg_reg(list,fromsreg.subsetregsize,tosreg.subsetregsize,fromsreg.subsetreg,tmpreg); + if (fromsreg.startbit <= tosreg.startbit) then + a_op_const_reg(list,OP_SHL,tosreg.subsetregsize,tosreg.startbit-fromsreg.startbit,tmpreg) + else + a_op_const_reg(list,OP_SHR,tosreg.subsetregsize,fromsreg.startbit-tosreg.startbit,tmpreg); + stopbit := tosreg.startbit + tosreg.bitlen; + // on x86(64), 1 shl 32(64) = 1 instead of 0 + if (stopbit <> AIntBits) then + bitmask := not(((aword(1) shl stopbit)-1) xor ((aword(1) shl tosreg.startbit)-1)) + else + bitmask := (aword(1) shl tosreg.startbit) - 1; + a_op_const_reg(list,OP_AND,tosreg.subsetregsize,tcgint(bitmask),tosreg.subsetreg); + a_op_const_reg(list,OP_AND,tosreg.subsetregsize,tcgint(not(bitmask)),tmpreg); + a_op_reg_reg(list,OP_OR,tosreg.subsetregsize,tmpreg,tosreg.subsetreg); + end + else + begin + tmpreg := getintregister(list,tosubsetsize); + a_load_subsetreg_reg(list,fromsubsetsize,tosubsetsize,fromsreg,tmpreg); + a_load_reg_subsetreg(list,tosubsetsize,tosubsetsize,tmpreg,tosreg); + end; + end; + + + procedure tcg.a_load_subsetreg_ref(list : TAsmList; subsetsize, tosize: tcgsize; const sreg: tsubsetregister; const destref: treference); + var + tmpreg: tregister; + begin + tmpreg := getintregister(list,tosize); + a_load_subsetreg_reg(list,subsetsize,tosize,sreg,tmpreg); + a_load_reg_ref(list,tosize,tosize,tmpreg,destref); + end; + + + procedure tcg.a_load_ref_subsetreg(list : TAsmList; fromsize, subsetsize: tcgsize; const fromref: treference; const sreg: tsubsetregister); + var + tmpreg: tregister; + begin + tmpreg := getintregister(list,subsetsize); + a_load_ref_reg(list,fromsize,subsetsize,fromref,tmpreg); + a_load_reg_subsetreg(list,subsetsize,subsetsize,tmpreg,sreg); + end; + + + procedure tcg.a_load_const_subsetreg(list: TAsmlist; subsetsize: tcgsize; a: tcgint; const sreg: tsubsetregister); + var + bitmask: aword; + stopbit: byte; + begin + stopbit := sreg.startbit + sreg.bitlen; + // on x86(64), 1 shl 32(64) = 1 instead of 0 + if (stopbit <> AIntBits) then + bitmask := not(((aword(1) shl stopbit)-1) xor ((aword(1) shl sreg.startbit)-1)) + else + bitmask := (aword(1) shl sreg.startbit) - 1; + if (((aword(a) shl sreg.startbit) and not bitmask) <> not bitmask) then + a_op_const_reg(list,OP_AND,sreg.subsetregsize,tcgint(bitmask),sreg.subsetreg); + a_op_const_reg(list,OP_OR,sreg.subsetregsize,tcgint((aword(a) shl sreg.startbit) and not(bitmask)),sreg.subsetreg); + end; + + + procedure tcg.a_load_loc_subsetref(list : TAsmList;subsetsize: tcgsize; const loc: tlocation; const sref : tsubsetreference); + begin + case loc.loc of + LOC_REFERENCE,LOC_CREFERENCE: + a_load_ref_subsetref(list,loc.size,subsetsize,loc.reference,sref); + LOC_REGISTER,LOC_CREGISTER: + a_load_reg_subsetref(list,loc.size,subsetsize,loc.register,sref); + LOC_CONSTANT: + a_load_const_subsetref(list,subsetsize,loc.value,sref); + LOC_SUBSETREG,LOC_CSUBSETREG: + a_load_subsetreg_subsetref(list,loc.size,subsetsize,loc.sreg,sref); + LOC_SUBSETREF,LOC_CSUBSETREF: + a_load_subsetref_subsetref(list,loc.size,subsetsize,loc.sref,sref); + else + internalerror(200608053); + end; + end; + + +(* + Subsetrefs are used for (bit)packed arrays and (bit)packed records stored + in memory. They are like a regular reference, but contain an extra bit + offset (either constant -startbit- or variable -bitindexreg-, always OS_INT) + and a bit length (always constant). + + Bit packed values are stored differently in memory depending on whether we + are on a big or a little endian system (compatible with at least GPC). The + size of the basic working unit is always the smallest power-of-2 byte size + which can contain the bit value (so 1..8 bits -> 1 byte, 9..16 bits -> 2 + bytes, 17..32 bits -> 4 bytes etc). + + On a big endian, 5-bit: values are stored like this: + 11111222 22333334 44445555 56666677 77788888 + The leftmost bit of each 5-bit value corresponds to the most significant + bit. + + On little endian, it goes like this: + 22211111 43333322 55554444 77666665 88888777 + In this case, per byte the left-most bit is more significant than those on + the right, but the bits in the next byte are all more significant than + those in the previous byte (e.g., the 222 in the first byte are the low + three bits of that value, while the 22 in the second byte are the upper + two bits. + + Big endian, 9 bit values: + 11111111 12222222 22333333 33344444 ... + + Little endian, 9 bit values: + 11111111 22222221 33333322 44444333 ... + This is memory representation and the 16 bit values are byteswapped. + Similarly as in the previous case, the 2222222 string contains the lower + bits of value 2 and the 22 string contains the upper bits. Once loaded into + registers (two 16 bit registers in the current implementation, although a + single 32 bit register would be possible too, in particular if 32 bit + alignment can be guaranteed), this becomes: + 22222221 11111111 44444333 33333322 ... + (l)ow u l l u l u + + The startbit/bitindex in a subsetreference always refers to + a) on big endian: the most significant bit of the value + (bits counted from left to right, both memory an registers) + b) on little endian: the least significant bit when the value + is loaded in a register (bit counted from right to left) + + Although a) results in more complex code for big endian systems, it's + needed for compatibility both with GPC and with e.g. bitpacked arrays in + Apple's universal interfaces which depend on these layout differences). + + Note: when changing the loadsize calculated in get_subsetref_load_info, + make sure the appropriate alignment is guaranteed, at least in case of + {$defined cpurequiresproperalignment}. +*) + + procedure tcg.get_subsetref_load_info(const sref: tsubsetreference; out loadsize: tcgsize; out extra_load: boolean); + var + intloadsize: tcgint; + begin + intloadsize := packedbitsloadsize(sref.bitlen); + + if (intloadsize = 0) then + internalerror(2006081310); + + if (intloadsize > sizeof(aint)) then + intloadsize := sizeof(aint); + loadsize := int_cgsize(intloadsize); + + if (loadsize = OS_NO) then + internalerror(2006081311); + if (sref.bitlen > sizeof(aint)*8) then + internalerror(2006081312); + + extra_load := + (sref.bitlen <> 1) and + ((sref.bitindexreg <> NR_NO) or + (byte(sref.startbit+sref.bitlen) > byte(intloadsize*8))); + end; + + + procedure tcg.a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); + var + restbits: byte; + begin + if (target_info.endian = endian_big) then + begin + { valuereg contains the upper bits, extra_value_reg the lower } + restbits := (sref.bitlen - (loadbitsize - sref.startbit)); + if (subsetsize in [OS_S8..OS_S128]) then + begin + { sign extend } + a_op_const_reg(list,OP_SHL,OS_INT,AIntBits-loadbitsize+sref.startbit,valuereg); + a_op_const_reg(list,OP_SAR,OS_INT,AIntBits-sref.bitlen,valuereg); + end + else + begin + a_op_const_reg(list,OP_SHL,OS_INT,restbits,valuereg); + { mask other bits } + if (sref.bitlen <> AIntBits) then + a_op_const_reg(list,OP_AND,OS_INT,tcgint((aword(1) shl sref.bitlen)-1),valuereg); + end; + a_op_const_reg(list,OP_SHR,OS_INT,loadbitsize-restbits,extra_value_reg) + end + else + begin + { valuereg contains the lower bits, extra_value_reg the upper } + a_op_const_reg(list,OP_SHR,OS_INT,sref.startbit,valuereg); + if (subsetsize in [OS_S8..OS_S128]) then + begin + a_op_const_reg(list,OP_SHL,OS_INT,AIntBits-sref.bitlen+loadbitsize-sref.startbit,extra_value_reg); + a_op_const_reg(list,OP_SAR,OS_INT,AIntBits-sref.bitlen,extra_value_reg); + end + else + begin + a_op_const_reg(list,OP_SHL,OS_INT,loadbitsize-sref.startbit,extra_value_reg); + { mask other bits } + if (sref.bitlen <> AIntBits) then + a_op_const_reg(list,OP_AND,OS_INT,tcgint((aword(1) shl sref.bitlen)-1),extra_value_reg); + end; + end; + { merge } + a_op_reg_reg(list,OP_OR,OS_INT,extra_value_reg,valuereg); + end; + + + procedure tcg.a_load_subsetref_regs_index(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg: tregister); + var + hl: tasmlabel; + tmpref: treference; + extra_value_reg, + tmpreg: tregister; + begin + tmpreg := getintregister(list,OS_INT); + tmpref := sref.ref; + inc(tmpref.offset,loadbitsize div 8); + extra_value_reg := getintregister(list,OS_INT); + + if (target_info.endian = endian_big) then + begin + { since this is a dynamic index, it's possible that the value } + { is entirely in valuereg. } + + { get the data in valuereg in the right place } + a_op_reg_reg(list,OP_SHL,OS_INT,sref.bitindexreg,valuereg); + if (subsetsize in [OS_S8..OS_S128]) then + begin + a_op_const_reg(list,OP_SHL,OS_INT,AIntBits-loadbitsize,valuereg); + a_op_const_reg(list,OP_SAR,OS_INT,AIntBits-sref.bitlen,valuereg) + end + else + begin + a_op_const_reg(list,OP_SHR,OS_INT,loadbitsize-sref.bitlen,valuereg); + if (loadbitsize <> AIntBits) then + { mask left over bits } + a_op_const_reg(list,OP_AND,OS_INT,tcgint((aword(1) shl sref.bitlen)-1),valuereg); + end; + tmpreg := getintregister(list,OS_INT); + + { ensure we don't load anything past the end of the array } + current_asmdata.getjumplabel(hl); + a_cmp_const_reg_label(list,OS_INT,OC_BE,loadbitsize-sref.bitlen,sref.bitindexreg,hl); + + { the bits in extra_value_reg (if any) start at the most significant bit => } + { extra_value_reg must be shr by (loadbitsize-sref.bitlen)+(loadsize-sref.bitindex) } + { => = -(sref.bitindex+(sref.bitlen-2*loadbitsize)) } + a_op_const_reg_reg(list,OP_ADD,OS_INT,sref.bitlen-2*loadbitsize,sref.bitindexreg,tmpreg); + a_op_reg_reg(list,OP_NEG,OS_INT,tmpreg,tmpreg); + + { load next "loadbitsize" bits of the array } + a_load_ref_reg(list,int_cgsize(loadbitsize div 8),OS_INT,tmpref,extra_value_reg); + + a_op_reg_reg(list,OP_SHR,OS_INT,tmpreg,extra_value_reg); + { if there are no bits in extra_value_reg, then sref.bitindex was } + { < loadsize-sref.bitlen, and therefore tmpreg will now be >= loadsize } + { => extra_value_reg is now 0 } + { merge } + a_op_reg_reg(list,OP_OR,OS_INT,extra_value_reg,valuereg); + { no need to mask, necessary masking happened earlier on } + a_label(list,hl); + end + else + begin + a_op_reg_reg(list,OP_SHR,OS_INT,sref.bitindexreg,valuereg); + + { ensure we don't load anything past the end of the array } + current_asmdata.getjumplabel(hl); + a_cmp_const_reg_label(list,OS_INT,OC_BE,loadbitsize-sref.bitlen,sref.bitindexreg,hl); + + { Y-x = -(Y-x) } + a_op_const_reg_reg(list,OP_SUB,OS_INT,loadbitsize,sref.bitindexreg,tmpreg); + a_op_reg_reg(list,OP_NEG,OS_INT,tmpreg,tmpreg); + + { load next "loadbitsize" bits of the array } + a_load_ref_reg(list,int_cgsize(loadbitsize div 8),OS_INT,tmpref,extra_value_reg); + + { tmpreg is in the range 1..<cpu_bitsize>-1 -> always ok } + a_op_reg_reg(list,OP_SHL,OS_INT,tmpreg,extra_value_reg); + { merge } + a_op_reg_reg(list,OP_OR,OS_INT,extra_value_reg,valuereg); + a_label(list,hl); + { sign extend or mask other bits } + if (subsetsize in [OS_S8..OS_S128]) then + begin + a_op_const_reg(list,OP_SHL,OS_INT,AIntBits-sref.bitlen,valuereg); + a_op_const_reg(list,OP_SAR,OS_INT,AIntBits-sref.bitlen,valuereg); + end + else + a_op_const_reg(list,OP_AND,OS_INT,tcgint((aword(1) shl sref.bitlen)-1),valuereg); + end; + end; + + + procedure tcg.a_load_subsetref_reg(list : TAsmList; subsetsize, tosize: tcgsize; const sref: tsubsetreference; destreg: tregister); + var + tmpref: treference; + valuereg,extra_value_reg: tregister; + tosreg: tsubsetregister; + loadsize: tcgsize; + loadbitsize: byte; + extra_load: boolean; + begin + + get_subsetref_load_info(sref,loadsize,extra_load); + loadbitsize := tcgsize2size[loadsize]*8; + + { load the (first part) of the bit sequence } + valuereg := getintregister(list,OS_INT); + a_load_ref_reg(list,loadsize,OS_INT,sref.ref,valuereg); + + if not extra_load then + begin + { everything is guaranteed to be in a single register of loadsize } + if (sref.bitindexreg = NR_NO) then + begin + { use subsetreg routine, it may have been overridden with an optimized version } + tosreg.subsetreg := valuereg; + tosreg.subsetregsize := OS_INT; + { subsetregs always count bits from right to left } + if (target_info.endian = endian_big) then + tosreg.startbit := loadbitsize - (sref.startbit+sref.bitlen) + else + tosreg.startbit := sref.startbit; + tosreg.bitlen := sref.bitlen; + a_load_subsetreg_reg(list,subsetsize,tosize,tosreg,destreg); + exit; + end + else + begin + if (sref.startbit <> 0) then + internalerror(2006081510); + if (target_info.endian = endian_big) then + begin + a_op_reg_reg(list,OP_SHL,OS_INT,sref.bitindexreg,valuereg); + if (subsetsize in [OS_S8..OS_S128]) then + begin + { sign extend to entire register } + a_op_const_reg(list,OP_SHL,OS_INT,AIntBits-loadbitsize,valuereg); + a_op_const_reg(list,OP_SAR,OS_INT,AIntBits-sref.bitlen,valuereg); + end + else + a_op_const_reg(list,OP_SHR,OS_INT,loadbitsize-sref.bitlen,valuereg); + end + else + begin + a_op_reg_reg(list,OP_SHR,OS_INT,sref.bitindexreg,valuereg); + if (subsetsize in [OS_S8..OS_S128]) then + begin + a_op_const_reg(list,OP_SHL,OS_INT,AIntBits-sref.bitlen,valuereg); + a_op_const_reg(list,OP_SAR,OS_INT,AIntBits-sref.bitlen,valuereg); + end + end; + { mask other bits/sign extend } + if not(subsetsize in [OS_S8..OS_S128]) then + a_op_const_reg(list,OP_AND,OS_INT,tcgint((aword(1) shl sref.bitlen)-1),valuereg); + end + end + else + begin + { load next value as well } + extra_value_reg := getintregister(list,OS_INT); + + if (sref.bitindexreg = NR_NO) then + begin + tmpref := sref.ref; + inc(tmpref.offset,loadbitsize div 8); + a_load_ref_reg(list,loadsize,OS_INT,tmpref,extra_value_reg); + { can be overridden to optimize } + a_load_subsetref_regs_noindex(list,subsetsize,loadbitsize,sref,valuereg,extra_value_reg) + end + else + begin + if (sref.startbit <> 0) then + internalerror(2006080610); + a_load_subsetref_regs_index(list,subsetsize,loadbitsize,sref,valuereg); + end; + end; + + { store in destination } + { avoid unnecessary sign extension and zeroing } + valuereg := makeregsize(list,valuereg,OS_INT); + destreg := makeregsize(list,destreg,OS_INT); + a_load_reg_reg(list,OS_INT,OS_INT,valuereg,destreg); + destreg := makeregsize(list,destreg,tosize); + end; + + + procedure tcg.a_load_reg_subsetref(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sref: tsubsetreference); + begin + a_load_regconst_subsetref_intern(list,fromsize,subsetsize,fromreg,sref,SL_REG); + end; + + + procedure tcg.a_load_regconst_subsetref_intern(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sref: tsubsetreference; slopt: tsubsetloadopt); + var + hl: tasmlabel; + tmpreg, tmpindexreg, valuereg, extra_value_reg, maskreg: tregister; + tosreg, fromsreg: tsubsetregister; + tmpref: treference; + bitmask: aword; + loadsize: tcgsize; + loadbitsize: byte; + extra_load: boolean; + begin + { the register must be able to contain the requested value } + if (tcgsize2size[fromsize]*8 < sref.bitlen) then + internalerror(2006081613); + + get_subsetref_load_info(sref,loadsize,extra_load); + loadbitsize := tcgsize2size[loadsize]*8; + + { load the (first part) of the bit sequence } + valuereg := getintregister(list,OS_INT); + a_load_ref_reg(list,loadsize,OS_INT,sref.ref,valuereg); + + { constant offset of bit sequence? } + if not extra_load then + begin + if (sref.bitindexreg = NR_NO) then + begin + { use subsetreg routine, it may have been overridden with an optimized version } + tosreg.subsetreg := valuereg; + tosreg.subsetregsize := OS_INT; + { subsetregs always count bits from right to left } + if (target_info.endian = endian_big) then + tosreg.startbit := loadbitsize - (sref.startbit+sref.bitlen) + else + tosreg.startbit := sref.startbit; + tosreg.bitlen := sref.bitlen; + a_load_regconst_subsetreg_intern(list,fromsize,subsetsize,fromreg,tosreg,slopt); + end + else + begin + if (sref.startbit <> 0) then + internalerror(2006081710); + { should be handled by normal code and will give wrong result } + { on x86 for the '1 shl bitlen' below } + if (sref.bitlen = AIntBits) then + internalerror(2006081711); + + { zero the bits we have to insert } + if (slopt <> SL_SETMAX) then + begin + maskreg := getintregister(list,OS_INT); + if (target_info.endian = endian_big) then + begin + a_load_const_reg(list,OS_INT,tcgint((aword(1) shl sref.bitlen)-1) shl (loadbitsize-sref.bitlen),maskreg); + a_op_reg_reg(list,OP_SHR,OS_INT,sref.bitindexreg,maskreg); + end + else + begin + a_load_const_reg(list,OS_INT,tcgint((aword(1) shl sref.bitlen)-1),maskreg); + a_op_reg_reg(list,OP_SHL,OS_INT,sref.bitindexreg,maskreg); + end; + a_op_reg_reg(list,OP_NOT,OS_INT,maskreg,maskreg); + a_op_reg_reg(list,OP_AND,OS_INT,maskreg,valuereg); + end; + + { insert the value } + if (slopt <> SL_SETZERO) then + begin + tmpreg := getintregister(list,OS_INT); + if (slopt <> SL_SETMAX) then + a_load_reg_reg(list,fromsize,OS_INT,fromreg,tmpreg) + else if (sref.bitlen <> AIntBits) then + a_load_const_reg(list,OS_INT,tcgint((aword(1) shl sref.bitlen) - 1), tmpreg) + else + a_load_const_reg(list,OS_INT,-1,tmpreg); + if (target_info.endian = endian_big) then + begin + a_op_const_reg(list,OP_SHL,OS_INT,loadbitsize-sref.bitlen,tmpreg); + if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then + begin + if (loadbitsize <> AIntBits) then + bitmask := (((aword(1) shl loadbitsize)-1) xor ((aword(1) shl (loadbitsize-sref.bitlen))-1)) + else + bitmask := (high(aword) xor ((aword(1) shl (loadbitsize-sref.bitlen))-1)); + a_op_const_reg(list,OP_AND,OS_INT,bitmask,tmpreg); + end; + a_op_reg_reg(list,OP_SHR,OS_INT,sref.bitindexreg,tmpreg); + end + else + begin + if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then + a_op_const_reg(list,OP_AND,OS_INT,tcgint((aword(1) shl sref.bitlen)-1),tmpreg); + a_op_reg_reg(list,OP_SHL,OS_INT,sref.bitindexreg,tmpreg); + end; + a_op_reg_reg(list,OP_OR,OS_INT,tmpreg,valuereg); + end; + end; + { store back to memory } + valuereg := makeregsize(list,valuereg,loadsize); + a_load_reg_ref(list,loadsize,loadsize,valuereg,sref.ref); + exit; + end + else + begin + { load next value } + extra_value_reg := getintregister(list,OS_INT); + tmpref := sref.ref; + inc(tmpref.offset,loadbitsize div 8); + + { should maybe be taken out too, can be done more efficiently } + { on e.g. i386 with shld/shrd } + if (sref.bitindexreg = NR_NO) then + begin + a_load_ref_reg(list,loadsize,OS_INT,tmpref,extra_value_reg); + + fromsreg.subsetreg := fromreg; + fromsreg.subsetregsize := fromsize; + tosreg.subsetreg := valuereg; + tosreg.subsetregsize := OS_INT; + + { transfer first part } + fromsreg.bitlen := loadbitsize-sref.startbit; + tosreg.bitlen := fromsreg.bitlen; + if (target_info.endian = endian_big) then + begin + { valuereg must contain the upper bits of the value at bits [0..loadbitsize-startbit] } + + { upper bits of the value ... } + fromsreg.startbit := sref.bitlen-(loadbitsize-sref.startbit); + { ... to bit 0 } + tosreg.startbit := 0 + end + else + begin + { valuereg must contain the lower bits of the value at bits [startbit..loadbitsize] } + + { lower bits of the value ... } + fromsreg.startbit := 0; + { ... to startbit } + tosreg.startbit := sref.startbit; + end; + case slopt of + SL_SETZERO, + SL_SETMAX: + a_load_regconst_subsetreg_intern(list,fromsize,subsetsize,fromreg,tosreg,slopt); + else + a_load_subsetreg_subsetreg(list,subsetsize,subsetsize,fromsreg,tosreg); + end; + valuereg := makeregsize(list,valuereg,loadsize); + a_load_reg_ref(list,loadsize,loadsize,valuereg,sref.ref); + + { transfer second part } + if (target_info.endian = endian_big) then + begin + { extra_value_reg must contain the lower bits of the value at bits } + { [(loadbitsize-(bitlen-(loadbitsize-startbit)))..loadbitsize] } + { (loadbitsize-(bitlen-(loadbitsize-startbit))) = 2*loadbitsize } + { - bitlen - startbit } + + fromsreg.startbit := 0; + tosreg.startbit := 2*loadbitsize - sref.bitlen - sref.startbit + end + else + begin + { extra_value_reg must contain the upper bits of the value at bits [0..bitlen-(loadbitsize-startbit)] } + + fromsreg.startbit := fromsreg.bitlen; + tosreg.startbit := 0; + end; + tosreg.subsetreg := extra_value_reg; + fromsreg.bitlen := sref.bitlen-fromsreg.bitlen; + tosreg.bitlen := fromsreg.bitlen; + + case slopt of + SL_SETZERO, + SL_SETMAX: + a_load_regconst_subsetreg_intern(list,fromsize,subsetsize,fromreg,tosreg,slopt); + else + a_load_subsetreg_subsetreg(list,subsetsize,subsetsize,fromsreg,tosreg); + end; + extra_value_reg := makeregsize(list,extra_value_reg,loadsize); + a_load_reg_ref(list,loadsize,loadsize,extra_value_reg,tmpref); + exit; + end + else + begin + if (sref.startbit <> 0) then + internalerror(2006081812); + { should be handled by normal code and will give wrong result } + { on x86 for the '1 shl bitlen' below } + if (sref.bitlen = AIntBits) then + internalerror(2006081713); + + { generate mask to zero the bits we have to insert } + if (slopt <> SL_SETMAX) then + begin + maskreg := getintregister(list,OS_INT); + if (target_info.endian = endian_big) then + begin + a_load_const_reg(list,OS_INT,tcgint(((aword(1) shl sref.bitlen)-1) shl (loadbitsize-sref.bitlen)),maskreg); + a_op_reg_reg(list,OP_SHR,OS_INT,sref.bitindexreg,maskreg); + end + else + begin + a_load_const_reg(list,OS_INT,tcgint((aword(1) shl sref.bitlen)-1),maskreg); + a_op_reg_reg(list,OP_SHL,OS_INT,sref.bitindexreg,maskreg); + end; + + a_op_reg_reg(list,OP_NOT,OS_INT,maskreg,maskreg); + a_op_reg_reg(list,OP_AND,OS_INT,maskreg,valuereg); + end; + + { insert the value } + if (slopt <> SL_SETZERO) then + begin + tmpreg := getintregister(list,OS_INT); + if (slopt <> SL_SETMAX) then + a_load_reg_reg(list,fromsize,OS_INT,fromreg,tmpreg) + else if (sref.bitlen <> AIntBits) then + a_load_const_reg(list,OS_INT,tcgint((aword(1) shl sref.bitlen) - 1), tmpreg) + else + a_load_const_reg(list,OS_INT,-1,tmpreg); + if (target_info.endian = endian_big) then + begin + a_op_const_reg(list,OP_SHL,OS_INT,loadbitsize-sref.bitlen,tmpreg); + if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then + { mask left over bits } + a_op_const_reg(list,OP_AND,OS_INT,tcgint(((aword(1) shl sref.bitlen)-1) shl (loadbitsize-sref.bitlen)),tmpreg); + a_op_reg_reg(list,OP_SHR,OS_INT,sref.bitindexreg,tmpreg); + end + else + begin + if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then + { mask left over bits } + a_op_const_reg(list,OP_AND,OS_INT,tcgint((aword(1) shl sref.bitlen)-1),tmpreg); + a_op_reg_reg(list,OP_SHL,OS_INT,sref.bitindexreg,tmpreg); + end; + a_op_reg_reg(list,OP_OR,OS_INT,tmpreg,valuereg); + end; + valuereg := makeregsize(list,valuereg,loadsize); + a_load_reg_ref(list,loadsize,loadsize,valuereg,sref.ref); + + { make sure we do not read/write past the end of the array } + current_asmdata.getjumplabel(hl); + a_cmp_const_reg_label(list,OS_INT,OC_BE,loadbitsize-sref.bitlen,sref.bitindexreg,hl); + + a_load_ref_reg(list,loadsize,OS_INT,tmpref,extra_value_reg); + tmpindexreg := getintregister(list,OS_INT); + + { load current array value } + if (slopt <> SL_SETZERO) then + begin + tmpreg := getintregister(list,OS_INT); + if (slopt <> SL_SETMAX) then + a_load_reg_reg(list,fromsize,OS_INT,fromreg,tmpreg) + else if (sref.bitlen <> AIntBits) then + a_load_const_reg(list,OS_INT,tcgint((aword(1) shl sref.bitlen) - 1), tmpreg) + else + a_load_const_reg(list,OS_INT,-1,tmpreg); + end; + + { generate mask to zero the bits we have to insert } + if (slopt <> SL_SETMAX) then + begin + maskreg := getintregister(list,OS_INT); + if (target_info.endian = endian_big) then + begin + a_op_const_reg_reg(list,OP_ADD,OS_INT,sref.bitlen-2*loadbitsize,sref.bitindexreg,tmpindexreg); + a_op_reg_reg(list,OP_NEG,OS_INT,tmpindexreg,tmpindexreg); + a_load_const_reg(list,OS_INT,tcgint((aword(1) shl sref.bitlen)-1),maskreg); + a_op_reg_reg(list,OP_SHL,OS_INT,tmpindexreg,maskreg); + end + else + begin + { Y-x = -(x-Y) } + a_op_const_reg_reg(list,OP_SUB,OS_INT,loadbitsize,sref.bitindexreg,tmpindexreg); + a_op_reg_reg(list,OP_NEG,OS_INT,tmpindexreg,tmpindexreg); + a_load_const_reg(list,OS_INT,tcgint((aword(1) shl sref.bitlen)-1),maskreg); + a_op_reg_reg(list,OP_SHR,OS_INT,tmpindexreg,maskreg); + end; + + a_op_reg_reg(list,OP_NOT,OS_INT,maskreg,maskreg); + a_op_reg_reg(list,OP_AND,OS_INT,maskreg,extra_value_reg); + end; + + if (slopt <> SL_SETZERO) then + begin + if (target_info.endian = endian_big) then + a_op_reg_reg(list,OP_SHL,OS_INT,tmpindexreg,tmpreg) + else + begin + if not(slopt in [SL_REGNOSRCMASK,SL_SETMAX]) then + a_op_const_reg(list,OP_AND,OS_INT,tcgint((aword(1) shl sref.bitlen)-1),tmpreg); + a_op_reg_reg(list,OP_SHR,OS_INT,tmpindexreg,tmpreg); + end; + a_op_reg_reg(list,OP_OR,OS_INT,tmpreg,extra_value_reg); + end; + extra_value_reg := makeregsize(list,extra_value_reg,loadsize); + a_load_reg_ref(list,loadsize,loadsize,extra_value_reg,tmpref); + + a_label(list,hl); + end; + end; + end; + + + procedure tcg.a_load_subsetref_subsetref(list: TAsmlist; fromsubsetsize, tosubsetsize : tcgsize; const fromsref, tosref: tsubsetreference); + var + tmpreg: tregister; + begin + tmpreg := getintregister(list,tosubsetsize); + a_load_subsetref_reg(list,fromsubsetsize,tosubsetsize,fromsref,tmpreg); + a_load_reg_subsetref(list,tosubsetsize,tosubsetsize,tmpreg,tosref); + end; + + + procedure tcg.a_load_subsetref_ref(list : TAsmList; subsetsize, tosize: tcgsize; const sref: tsubsetreference; const destref: treference); + var + tmpreg: tregister; + begin + tmpreg := getintregister(list,tosize); + a_load_subsetref_reg(list,subsetsize,tosize,sref,tmpreg); + a_load_reg_ref(list,tosize,tosize,tmpreg,destref); + end; + + + procedure tcg.a_load_ref_subsetref(list : TAsmList; fromsize, subsetsize: tcgsize; const fromref: treference; const sref: tsubsetreference); + var + tmpreg: tregister; + begin + tmpreg := getintregister(list,subsetsize); + a_load_ref_reg(list,fromsize,subsetsize,fromref,tmpreg); + a_load_reg_subsetref(list,subsetsize,subsetsize,tmpreg,sref); + end; + + + procedure tcg.a_load_const_subsetref(list: TAsmlist; subsetsize: tcgsize; a: tcgint; const sref: tsubsetreference); + var + tmpreg: tregister; + slopt: tsubsetloadopt; + begin + { perform masking of the source value in advance } + slopt := SL_REGNOSRCMASK; + if (sref.bitlen <> AIntBits) then + a := tcgint(aword(a) and ((aword(1) shl sref.bitlen) -1)); + if ( + { broken x86 "x shl regbitsize = x" } + ((sref.bitlen <> AIntBits) and + ((aword(a) and ((aword(1) shl sref.bitlen) -1)) = (aword(1) shl sref.bitlen) -1)) or + ((sref.bitlen = AIntBits) and + (a = -1)) + ) then + slopt := SL_SETMAX + else if (a = 0) then + slopt := SL_SETZERO; + tmpreg := getintregister(list,subsetsize); + if not(slopt in [SL_SETZERO,SL_SETMAX]) then + a_load_const_reg(list,subsetsize,a,tmpreg); + a_load_regconst_subsetref_intern(list,subsetsize,subsetsize,tmpreg,sref,slopt); + end; + + + procedure tcg.a_load_subsetref_loc(list: TAsmlist; subsetsize: tcgsize; const sref: tsubsetreference; const loc: tlocation); + begin + case loc.loc of + LOC_REFERENCE,LOC_CREFERENCE: + a_load_subsetref_ref(list,subsetsize,loc.size,sref,loc.reference); + LOC_REGISTER,LOC_CREGISTER: + a_load_subsetref_reg(list,subsetsize,loc.size,sref,loc.register); + LOC_SUBSETREG,LOC_CSUBSETREG: + a_load_subsetref_subsetreg(list,subsetsize,loc.size,sref,loc.sreg); + LOC_SUBSETREF,LOC_CSUBSETREF: + a_load_subsetref_subsetref(list,subsetsize,loc.size,sref,loc.sref); + else + internalerror(200608054); + end; + end; + + + procedure tcg.a_load_subsetref_subsetreg(list: TAsmlist; fromsubsetsize, tosubsetsize : tcgsize; const fromsref: tsubsetreference; const tosreg: tsubsetregister); + var + tmpreg: tregister; + begin + tmpreg := getintregister(list,tosubsetsize); + a_load_subsetref_reg(list,fromsubsetsize,tosubsetsize,fromsref,tmpreg); + a_load_reg_subsetreg(list,tosubsetsize,tosubsetsize,tmpreg,tosreg); + end; + + + procedure tcg.a_load_subsetreg_subsetref(list: TAsmlist; fromsubsetsize, tosubsetsize : tcgsize; const fromsreg: tsubsetregister; const tosref: tsubsetreference); + var + tmpreg: tregister; + begin + tmpreg := getintregister(list,tosubsetsize); + a_load_subsetreg_reg(list,fromsubsetsize,tosubsetsize,fromsreg,tmpreg); + a_load_reg_subsetref(list,tosubsetsize,tosubsetsize,tmpreg,tosref); + end; + + +{$pop} + + { generic bit address calculation routines } + + function tcg.get_bit_const_ref_sref(bitnumber: tcgint; const ref: treference): tsubsetreference; + begin + result.ref:=ref; + inc(result.ref.offset,bitnumber div 8); + result.bitindexreg:=NR_NO; + result.startbit:=bitnumber mod 8; + result.bitlen:=1; + end; + + + function tcg.get_bit_const_reg_sreg(setregsize: tcgsize; bitnumber: tcgint; setreg: tregister): tsubsetregister; + begin + result.subsetreg:=setreg; + result.subsetregsize:=setregsize; + { subsetregs always count from the least significant to the most significant bit } + if (target_info.endian=endian_big) then + result.startbit:=(tcgsize2size[setregsize]*8)-bitnumber-1 + else + result.startbit:=bitnumber; + result.bitlen:=1; + end; + + + function tcg.get_bit_reg_ref_sref(list: TAsmList; bitnumbersize: tcgsize; bitnumber: tregister; const ref: treference): tsubsetreference; + var + tmpreg, + tmpaddrreg: tregister; + begin + result.ref:=ref; + result.startbit:=0; + result.bitlen:=1; + + tmpreg:=getintregister(list,bitnumbersize); + a_op_const_reg_reg(list,OP_SHR,bitnumbersize,3,bitnumber,tmpreg); + tmpaddrreg:=getaddressregister(list); + a_load_reg_reg(list,bitnumbersize,OS_ADDR,tmpreg,tmpaddrreg); + if (result.ref.base=NR_NO) then + result.ref.base:=tmpaddrreg + else if (result.ref.index=NR_NO) then + result.ref.index:=tmpaddrreg + else + begin + a_op_reg_reg(list,OP_ADD,OS_ADDR,result.ref.index,tmpaddrreg); + result.ref.index:=tmpaddrreg; + end; + tmpreg:=getintregister(list,OS_INT); + a_op_const_reg_reg(list,OP_AND,OS_INT,7,bitnumber,tmpreg); + result.bitindexreg:=tmpreg; + end; + + + { bit testing routines } + + procedure tcg.a_bit_test_reg_reg_reg(list : TAsmList; bitnumbersize,valuesize,destsize: tcgsize;bitnumber,value,destreg: tregister); + var + tmpvalue: tregister; + begin + tmpvalue:=getintregister(list,valuesize); + + if (target_info.endian=endian_little) then + begin + { rotate value register "bitnumber" bits to the right } + a_op_reg_reg_reg(list,OP_SHR,valuesize,bitnumber,value,tmpvalue); + { extract the bit we want } + a_op_const_reg(list,OP_AND,valuesize,1,tmpvalue); + end + else + begin + { highest (leftmost) bit = bit 0 -> shl bitnumber results in wanted } + { bit in uppermost position, then move it to the lowest position } + { "and" is not necessary since combination of shl/shr will clear } + { all other bits } + a_op_reg_reg_reg(list,OP_SHL,valuesize,bitnumber,value,tmpvalue); + a_op_const_reg(list,OP_SHR,valuesize,tcgsize2size[valuesize]*8-1,tmpvalue); + end; + a_load_reg_reg(list,valuesize,destsize,tmpvalue,destreg); + end; + + + procedure tcg.a_bit_test_const_ref_reg(list: TAsmList; destsize: tcgsize; bitnumber: tcgint; const ref: treference; destreg: tregister); + begin + a_load_subsetref_reg(list,OS_8,destsize,get_bit_const_ref_sref(bitnumber,ref),destreg); + end; + + + procedure tcg.a_bit_test_const_reg_reg(list: TAsmList; setregsize, destsize: tcgsize; bitnumber: tcgint; setreg, destreg: tregister); + begin + a_load_subsetreg_reg(list,setregsize,destsize,get_bit_const_reg_sreg(setregsize,bitnumber,setreg),destreg); + end; + + + procedure tcg.a_bit_test_const_subsetreg_reg(list: TAsmList; setregsize, destsize: tcgsize; bitnumber: tcgint; const setreg: tsubsetregister; destreg: tregister); + var + tmpsreg: tsubsetregister; + begin + { the first parameter is used to calculate the bit offset in } + { case of big endian, and therefore must be the size of the } + { set and not of the whole subsetreg } + tmpsreg:=get_bit_const_reg_sreg(setregsize,bitnumber,setreg.subsetreg); + { now fix the size of the subsetreg } + tmpsreg.subsetregsize:=setreg.subsetregsize; + { correct offset of the set in the subsetreg } + inc(tmpsreg.startbit,setreg.startbit); + a_load_subsetreg_reg(list,setregsize,destsize,tmpsreg,destreg); + end; + + + procedure tcg.a_bit_test_reg_ref_reg(list: TAsmList; bitnumbersize, destsize: tcgsize; bitnumber: tregister; const ref: treference; destreg: tregister); + begin + a_load_subsetref_reg(list,OS_8,destsize,get_bit_reg_ref_sref(list,bitnumbersize,bitnumber,ref),destreg); + end; + + + procedure tcg.a_bit_test_reg_loc_reg(list: TAsmList; bitnumbersize, destsize: tcgsize; bitnumber: tregister; const loc: tlocation; destreg: tregister); + var + tmpreg: tregister; + begin + case loc.loc of + LOC_REFERENCE,LOC_CREFERENCE: + a_bit_test_reg_ref_reg(list,bitnumbersize,destsize,bitnumber,loc.reference,destreg); + LOC_REGISTER,LOC_CREGISTER, + LOC_SUBSETREG,LOC_CSUBSETREG, + LOC_CONSTANT: + begin + case loc.loc of + LOC_REGISTER,LOC_CREGISTER: + tmpreg:=loc.register; + LOC_SUBSETREG,LOC_CSUBSETREG: + begin + tmpreg:=getintregister(list,loc.size); + a_load_subsetreg_reg(list,loc.size,loc.size,loc.sreg,tmpreg); + end; + LOC_CONSTANT: + begin + tmpreg:=getintregister(list,loc.size); + a_load_const_reg(list,loc.size,loc.value,tmpreg); + end; + end; + a_bit_test_reg_reg_reg(list,bitnumbersize,loc.size,destsize,bitnumber,tmpreg,destreg); + end; + { LOC_SUBSETREF is not possible, because sets are not (yet) bitpacked } + else + internalerror(2007051701); + end; + end; + + + procedure tcg.a_bit_test_const_loc_reg(list: TAsmList; destsize: tcgsize; bitnumber: tcgint; const loc: tlocation; destreg: tregister); + begin + case loc.loc of + LOC_REFERENCE,LOC_CREFERENCE: + a_bit_test_const_ref_reg(list,destsize,bitnumber,loc.reference,destreg); + LOC_REGISTER,LOC_CREGISTER: + a_bit_test_const_reg_reg(list,loc.size,destsize,bitnumber,loc.register,destreg); + LOC_SUBSETREG,LOC_CSUBSETREG: + a_bit_test_const_subsetreg_reg(list,loc.size,destsize,bitnumber,loc.sreg,destreg); + { LOC_SUBSETREF is not possible, because sets are not (yet) bitpacked } + else + internalerror(2007051702); + end; + end; + + { bit setting/clearing routines } + + procedure tcg.a_bit_set_reg_reg(list : TAsmList; doset: boolean; bitnumbersize, destsize: tcgsize; bitnumber,dest: tregister); + var + tmpvalue: tregister; + begin + tmpvalue:=getintregister(list,destsize); + + if (target_info.endian=endian_little) then + begin + a_load_const_reg(list,destsize,1,tmpvalue); + { rotate bit "bitnumber" bits to the left } + a_op_reg_reg(list,OP_SHL,destsize,bitnumber,tmpvalue); + end + else + begin + { highest (leftmost) bit = bit 0 -> "$80/$8000/$80000000/ ... } + { shr bitnumber" results in correct mask } + a_load_const_reg(list,destsize,1 shl (tcgsize2size[destsize]*8-1),tmpvalue); + a_op_reg_reg(list,OP_SHR,destsize,bitnumber,tmpvalue); + end; + { set/clear the bit we want } + if (doset) then + a_op_reg_reg(list,OP_OR,destsize,tmpvalue,dest) + else + begin + a_op_reg_reg(list,OP_NOT,destsize,tmpvalue,tmpvalue); + a_op_reg_reg(list,OP_AND,destsize,tmpvalue,dest) + end; + end; + + + procedure tcg.a_bit_set_const_ref(list: TAsmList; doset: boolean;destsize: tcgsize; bitnumber: tcgint; const ref: treference); + begin + a_load_const_subsetref(list,OS_8,ord(doset),get_bit_const_ref_sref(bitnumber,ref)); + end; + + + procedure tcg.a_bit_set_const_reg(list: TAsmList; doset: boolean; destsize: tcgsize; bitnumber: tcgint; destreg: tregister); + begin + a_load_const_subsetreg(list,OS_8,ord(doset),get_bit_const_reg_sreg(destsize,bitnumber,destreg)); + end; + + + procedure tcg.a_bit_set_const_subsetreg(list: TAsmList; doset: boolean; destsize: tcgsize; bitnumber: tcgint; const destreg: tsubsetregister); + var + tmpsreg: tsubsetregister; + begin + { the first parameter is used to calculate the bit offset in } + { case of big endian, and therefore must be the size of the } + { set and not of the whole subsetreg } + tmpsreg:=get_bit_const_reg_sreg(destsize,bitnumber,destreg.subsetreg); + { now fix the size of the subsetreg } + tmpsreg.subsetregsize:=destreg.subsetregsize; + { correct offset of the set in the subsetreg } + inc(tmpsreg.startbit,destreg.startbit); + a_load_const_subsetreg(list,OS_8,ord(doset),tmpsreg); + end; + + + procedure tcg.a_bit_set_reg_ref(list: TAsmList; doset: boolean; bitnumbersize: tcgsize; bitnumber: tregister; const ref: treference); + begin + a_load_const_subsetref(list,OS_8,ord(doset),get_bit_reg_ref_sref(list,bitnumbersize,bitnumber,ref)); + end; + + + procedure tcg.a_bit_set_reg_loc(list: TAsmList; doset: boolean; bitnumbersize: tcgsize; bitnumber: tregister; const loc: tlocation); + var + tmpreg: tregister; + begin + case loc.loc of + LOC_REFERENCE: + a_bit_set_reg_ref(list,doset,bitnumbersize,bitnumber,loc.reference); + LOC_CREGISTER: + a_bit_set_reg_reg(list,doset,bitnumbersize,loc.size,bitnumber,loc.register); + { e.g. a 2-byte set in a record regvar } + LOC_CSUBSETREG: + begin + { hard to do in-place in a generic way, so operate on a copy } + tmpreg:=getintregister(list,loc.size); + a_load_subsetreg_reg(list,loc.size,loc.size,loc.sreg,tmpreg); + a_bit_set_reg_reg(list,doset,bitnumbersize,loc.size,bitnumber,tmpreg); + a_load_reg_subsetreg(list,loc.size,loc.size,tmpreg,loc.sreg); + end; + { LOC_SUBSETREF is not possible, because sets are not (yet) bitpacked } + else + internalerror(2007051703) + end; + end; + + + procedure tcg.a_bit_set_const_loc(list: TAsmList; doset: boolean; bitnumber: tcgint; const loc: tlocation); + begin + case loc.loc of + LOC_REFERENCE: + a_bit_set_const_ref(list,doset,loc.size,bitnumber,loc.reference); + LOC_CREGISTER: + a_bit_set_const_reg(list,doset,loc.size,bitnumber,loc.register); + LOC_CSUBSETREG: + a_bit_set_const_subsetreg(list,doset,loc.size,bitnumber,loc.sreg); + { LOC_SUBSETREF is not possible, because sets are not (yet) bitpacked } + else + internalerror(2007051704) + end; + end; + + + { memory/register loading } + + procedure tcg.a_load_reg_ref_unaligned(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference); + var + tmpref : treference; + tmpreg : tregister; + i : longint; + begin + if ref.alignment<tcgsize2size[fromsize] then + begin + tmpref:=ref; + { we take care of the alignment now } + tmpref.alignment:=0; + case FromSize of + OS_16,OS_S16: + begin + tmpreg:=getintregister(list,OS_16); + a_load_reg_reg(list,fromsize,OS_16,register,tmpreg); + if target_info.endian=endian_big then + inc(tmpref.offset); + tmpreg:=makeregsize(list,tmpreg,OS_8); + a_load_reg_ref(list,OS_8,OS_8,tmpreg,tmpref); + tmpreg:=makeregsize(list,tmpreg,OS_16); + a_op_const_reg(list,OP_SHR,OS_16,8,tmpreg); + if target_info.endian=endian_big then + dec(tmpref.offset) + else + inc(tmpref.offset); + tmpreg:=makeregsize(list,tmpreg,OS_8); + a_load_reg_ref(list,OS_8,OS_8,tmpreg,tmpref); + end; + OS_32,OS_S32: + begin + { could add an optimised case for ref.alignment=2 } + tmpreg:=getintregister(list,OS_32); + a_load_reg_reg(list,fromsize,OS_32,register,tmpreg); + if target_info.endian=endian_big then + inc(tmpref.offset,3); + tmpreg:=makeregsize(list,tmpreg,OS_8); + a_load_reg_ref(list,OS_8,OS_8,tmpreg,tmpref); + tmpreg:=makeregsize(list,tmpreg,OS_32); + for i:=1 to 3 do + begin + a_op_const_reg(list,OP_SHR,OS_32,8,tmpreg); + if target_info.endian=endian_big then + dec(tmpref.offset) + else + inc(tmpref.offset); + tmpreg:=makeregsize(list,tmpreg,OS_8); + a_load_reg_ref(list,OS_8,OS_8,tmpreg,tmpref); + tmpreg:=makeregsize(list,tmpreg,OS_32); + end; + end + else + a_load_reg_ref(list,fromsize,tosize,register,tmpref); + end; + end + else + a_load_reg_ref(list,fromsize,tosize,register,ref); + end; + + + procedure tcg.a_load_ref_reg_unaligned(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister); + var + tmpref : treference; + tmpreg, + tmpreg2 : tregister; + i : longint; + begin + if ref.alignment in [1,2] then + begin + tmpref:=ref; + { we take care of the alignment now } + tmpref.alignment:=0; + case FromSize of + OS_16,OS_S16: + if ref.alignment=2 then + a_load_ref_reg(list,fromsize,tosize,tmpref,register) + else + begin + { first load in tmpreg, because the target register } + { may be used in ref as well } + if target_info.endian=endian_little then + inc(tmpref.offset); + tmpreg:=getintregister(list,OS_8); + a_load_ref_reg(list,OS_8,OS_8,tmpref,tmpreg); + tmpreg:=makeregsize(list,tmpreg,OS_16); + a_op_const_reg(list,OP_SHL,OS_16,8,tmpreg); + if target_info.endian=endian_little then + dec(tmpref.offset) + else + inc(tmpref.offset); + a_load_ref_reg(list,OS_8,OS_16,tmpref,register); + a_op_reg_reg(list,OP_OR,OS_16,tmpreg,register); + end; + OS_32,OS_S32: + if ref.alignment=2 then + begin + if target_info.endian=endian_little then + inc(tmpref.offset,2); + tmpreg:=getintregister(list,OS_32); + a_load_ref_reg(list,OS_16,OS_32,tmpref,tmpreg); + a_op_const_reg(list,OP_SHL,OS_32,16,tmpreg); + if target_info.endian=endian_little then + dec(tmpref.offset,2) + else + inc(tmpref.offset,2); + a_load_ref_reg(list,OS_16,OS_32,tmpref,register); + a_op_reg_reg(list,OP_OR,OS_32,tmpreg,register); + end + else + begin + if target_info.endian=endian_little then + inc(tmpref.offset,3); + tmpreg:=getintregister(list,OS_32); + a_load_ref_reg(list,OS_8,OS_32,tmpref,tmpreg); + tmpreg2:=getintregister(list,OS_32); + for i:=1 to 3 do + begin + a_op_const_reg(list,OP_SHL,OS_32,8,tmpreg); + if target_info.endian=endian_little then + dec(tmpref.offset) + else + inc(tmpref.offset); + a_load_ref_reg(list,OS_8,OS_32,tmpref,tmpreg2); + a_op_reg_reg(list,OP_OR,OS_32,tmpreg2,tmpreg); + end; + a_load_reg_reg(list,OS_32,OS_32,tmpreg,register); + end + else + a_load_ref_reg(list,fromsize,tosize,tmpref,register); + end; + end + else + a_load_ref_reg(list,fromsize,tosize,ref,register); + end; + + + procedure tcg.a_load_ref_ref(list : TAsmList;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 : TAsmList;size : tcgsize;a : tcgint;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 : TAsmList;a : tcgint;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); + LOC_SUBSETREG,LOC_CSUBSETREG: + a_load_const_subsetreg(list,loc.size,a,loc.sreg); + LOC_SUBSETREF,LOC_CSUBSETREF: + a_load_const_subsetref(list,loc.size,a,loc.sref); + else + internalerror(200203272); + end; + end; + + + procedure tcg.a_load_reg_loc(list : TAsmList;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); + LOC_SUBSETREG,LOC_CSUBSETREG: + a_load_reg_subsetreg(list,fromsize,loc.size,reg,loc.sreg); + LOC_SUBSETREF,LOC_CSUBSETREF: + a_load_reg_subsetref(list,fromsize,loc.size,reg,loc.sref); + LOC_MMREGISTER,LOC_CMMREGISTER: + a_loadmm_intreg_reg(list,fromsize,loc.size,reg,loc.register,mms_movescalar); + else + internalerror(200203271); + end; + end; + + + procedure tcg.a_load_loc_reg(list : TAsmList; 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); + LOC_SUBSETREG,LOC_CSUBSETREG: + a_load_subsetreg_reg(list,loc.size,tosize,loc.sreg,reg); + LOC_SUBSETREF,LOC_CSUBSETREF: + a_load_subsetref_reg(list,loc.size,tosize,loc.sref,reg); + else + internalerror(200109092); + end; + end; + + + procedure tcg.a_load_loc_ref(list : TAsmList;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); + LOC_SUBSETREG,LOC_CSUBSETREG: + a_load_subsetreg_ref(list,loc.size,tosize,loc.sreg,ref); + LOC_SUBSETREF,LOC_CSUBSETREF: + a_load_subsetref_ref(list,loc.size,tosize,loc.sref,ref); + else + internalerror(200109302); + end; + end; + + + procedure tcg.a_load_loc_subsetreg(list : TAsmList; subsetsize: tcgsize; const loc: tlocation; const sreg : tsubsetregister); + begin + case loc.loc of + LOC_REFERENCE,LOC_CREFERENCE: + a_load_ref_subsetreg(list,loc.size,subsetsize,loc.reference,sreg); + LOC_REGISTER,LOC_CREGISTER: + a_load_reg_subsetreg(list,loc.size,subsetsize,loc.register,sreg); + LOC_CONSTANT: + a_load_const_subsetreg(list,subsetsize,loc.value,sreg); + LOC_SUBSETREG,LOC_CSUBSETREG: + a_load_subsetreg_subsetreg(list,loc.size,subsetsize,loc.sreg,sreg); + LOC_SUBSETREF,LOC_CSUBSETREF: + a_load_subsetref_subsetreg(list,loc.size,subsetsize,loc.sref,sreg); + else + internalerror(2006052310); + end; + end; + + + procedure tcg.a_load_subsetreg_loc(list: TAsmlist; subsetsize: tcgsize; const sreg: tsubsetregister; const loc: tlocation); + begin + case loc.loc of + LOC_REFERENCE,LOC_CREFERENCE: + a_load_subsetreg_ref(list,subsetsize,loc.size,sreg,loc.reference); + LOC_REGISTER,LOC_CREGISTER: + a_load_subsetreg_reg(list,subsetsize,loc.size,sreg,loc.register); + LOC_SUBSETREG,LOC_CSUBSETREG: + a_load_subsetreg_subsetreg(list,subsetsize,loc.size,sreg,loc.sreg); + LOC_SUBSETREF,LOC_CSUBSETREF: + a_load_subsetreg_subsetref(list,subsetsize,loc.size,sreg,loc.sref); + else + internalerror(2006051510); + end; + end; + + + procedure tcg.optimize_op_const(var op: topcg; var a : tcgint); + var + powerval : longint; + begin + case op of + OP_OR : + begin + { or with zero returns same result } + if a = 0 then + op:=OP_NONE + else + { or with max returns max } + if a = -1 then + op:=OP_MOVE; + end; + OP_AND : + begin + { and with max returns same result } + if (a = -1) then + op:=OP_NONE + else + { and with 0 returns 0 } + if a=0 then + op:=OP_MOVE; + end; + OP_DIV : + begin + { division by 1 returns result } + if a = 1 then + op:=OP_NONE + else if ispowerof2(int64(a), powerval) and not(cs_check_overflow in current_settings.localswitches) then + begin + a := powerval; + op:= OP_SHR; + end; + end; + OP_IDIV: + begin + if a = 1 then + op:=OP_NONE; + end; + OP_MUL,OP_IMUL: + begin + if a = 1 then + op:=OP_NONE + else + if a=0 then + op:=OP_MOVE + else if ispowerof2(int64(a), powerval) and not(cs_check_overflow in current_settings.localswitches) then + begin + a := powerval; + op:= OP_SHL; + end; + end; + OP_ADD,OP_SUB: + begin + if a = 0 then + op:=OP_NONE; + end; + OP_SAR,OP_SHL,OP_SHR,OP_ROL,OP_ROR: + begin + if a = 0 then + op:=OP_NONE; + end; + end; + end; + + + procedure tcg.a_loadfpu_loc_reg(list: TAsmList; tosize: tcgsize; const loc: tlocation; const reg: tregister); + begin + case loc.loc of + LOC_REFERENCE, LOC_CREFERENCE: + a_loadfpu_ref_reg(list,loc.size,tosize,loc.reference,reg); + LOC_FPUREGISTER, LOC_CFPUREGISTER: + a_loadfpu_reg_reg(list,loc.size,tosize,loc.register,reg); + else + internalerror(200203301); + end; + end; + + + procedure tcg.a_loadfpu_reg_loc(list: TAsmList; fromsize: tcgsize; const reg: tregister; const loc: tlocation); + begin + case loc.loc of + LOC_REFERENCE, LOC_CREFERENCE: + a_loadfpu_reg_ref(list,fromsize,loc.size,reg,loc.reference); + LOC_FPUREGISTER, LOC_CFPUREGISTER: + a_loadfpu_reg_reg(list,fromsize,loc.size,reg,loc.register); + else + internalerror(48991); + end; + end; + + + procedure tcg.a_loadfpu_ref_ref(list: TAsmList; fromsize, tosize: tcgsize; const ref1,ref2: treference); + var + reg: tregister; + regsize: tcgsize; + begin + if (fromsize>=tosize) then + regsize:=fromsize + else + regsize:=tosize; + reg:=getfpuregister(list,regsize); + a_loadfpu_ref_reg(list,fromsize,regsize,ref1,reg); + a_loadfpu_reg_ref(list,regsize,tosize,reg,ref2); + end; + + + procedure tcg.a_loadfpu_reg_cgpara(list : TAsmList;size : tcgsize;const r : tregister;const cgpara : TCGPara); + var + ref : treference; + begin + paramanager.alloccgpara(list,cgpara); + case cgpara.location^.loc of + LOC_FPUREGISTER,LOC_CFPUREGISTER: + begin + cgpara.check_simple_location; + a_loadfpu_reg_reg(list,size,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,cgpara.alignment); + a_loadfpu_reg_ref(list,size,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],TCGSize2Size[size],tt_normal,ref); + a_loadfpu_reg_ref(list,size,size,r,ref); + a_loadfpu_ref_cgpara(list,size,ref,cgpara); + tg.Ungettemp(list,ref); + end; + else + internalerror(2010053112); + end; + end; + + + procedure tcg.a_loadfpu_ref_cgpara(list : TAsmList;size : tcgsize;const ref : treference;const cgpara : TCGPara); + var + href : treference; + hsize: tcgsize; + begin + case cgpara.location^.loc of + LOC_FPUREGISTER,LOC_CFPUREGISTER: + begin + cgpara.check_simple_location; + paramanager.alloccgpara(list,cgpara); + a_loadfpu_ref_reg(list,size,size,ref,cgpara.location^.register); + end; + LOC_REFERENCE,LOC_CREFERENCE: + begin + cgpara.check_simple_location; + reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment); + { concatcopy should choose the best way to copy the data } + g_concatcopy(list,ref,href,tcgsize2size[size]); + end; + LOC_REGISTER,LOC_CREGISTER: + begin + { force integer size } + hsize:=int_cgsize(tcgsize2size[size]); +{$ifndef cpu64bitalu} + if (hsize in [OS_S64,OS_64]) then + cg64.a_load64_ref_cgpara(list,ref,cgpara) + else +{$endif not cpu64bitalu} + begin + cgpara.check_simple_location; + a_load_ref_cgpara(list,hsize,ref,cgpara) + end; + end + else + internalerror(200402201); + end; + end; + + + procedure tcg.a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; 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_subsetreg(list : TAsmList; Op : TOpCG; size, subsetsize : TCGSize; a : tcgint; const sreg: tsubsetregister); + var + tmpreg: tregister; + begin + tmpreg := getintregister(list, size); + a_load_subsetreg_reg(list,subsetsize,size,sreg,tmpreg); + a_op_const_reg(list,op,size,a,tmpreg); + a_load_reg_subsetreg(list,size,subsetsize,tmpreg,sreg); + end; + + + procedure tcg.a_op_const_subsetref(list : TAsmList; Op : TOpCG; size, subsetsize : TCGSize; a : tcgint; const sref: tsubsetreference); + var + tmpreg: tregister; + begin + tmpreg := getintregister(list, size); + a_load_subsetref_reg(list,subsetsize,size,sref,tmpreg); + a_op_const_reg(list,op,size,a,tmpreg); + a_load_reg_subsetref(list,size,subsetsize,tmpreg,sref); + end; + + + procedure tcg.a_op_const_loc(list : TAsmList; Op: TOpCG; a: tcgint; 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); + LOC_SUBSETREG, LOC_CSUBSETREG: + a_op_const_subsetreg(list,op,loc.size,loc.size,a,loc.sreg); + LOC_SUBSETREF, LOC_CSUBSETREF: + a_op_const_subsetref(list,op,loc.size,loc.size,a,loc.sref); + else + internalerror(200109061); + end; + end; + + + procedure tcg.a_op_reg_ref(list : TAsmList; 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 : TAsmList; 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_subsetreg(list : TAsmList; Op : TOpCG; opsize, subsetsize : TCGSize; reg: TRegister; const sreg: tsubsetregister); + var + tmpreg: tregister; + begin + tmpreg := getintregister(list, opsize); + a_load_subsetreg_reg(list,subsetsize,opsize,sreg,tmpreg); + a_op_reg_reg(list,op,opsize,reg,tmpreg); + a_load_reg_subsetreg(list,opsize,subsetsize,tmpreg,sreg); + end; + + + procedure tcg.a_op_reg_subsetref(list : TAsmList; Op : TOpCG; opsize, subsetsize : TCGSize; reg: TRegister; const sref: tsubsetreference); + var + tmpreg: tregister; + begin + tmpreg := getintregister(list, opsize); + a_load_subsetref_reg(list,subsetsize,opsize,sref,tmpreg); + a_op_reg_reg(list,op,opsize,reg,tmpreg); + a_load_reg_subsetref(list,opsize,subsetsize,tmpreg,sref); + end; + + + procedure tcg.a_op_reg_loc(list : TAsmList; 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); + LOC_SUBSETREG, LOC_CSUBSETREG: + a_op_reg_subsetreg(list,op,loc.size,loc.size,reg,loc.sreg); + LOC_SUBSETREF, LOC_CSUBSETREF: + a_op_reg_subsetref(list,op,loc.size,loc.size,reg,loc.sref); + else + internalerror(200109061); + end; + end; + + + procedure tcg.a_op_ref_loc(list : TAsmList; 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; + LOC_SUBSETREG, LOC_CSUBSETREG: + begin + tmpreg:=getintregister(list,loc.size); + a_load_subsetreg_reg(list,loc.size,loc.size,loc.sreg,tmpreg); + a_op_ref_reg(list,op,loc.size,ref,tmpreg); + a_load_reg_subsetreg(list,loc.size,loc.size,tmpreg,loc.sreg); + end; + LOC_SUBSETREF, LOC_CSUBSETREF: + begin + tmpreg:=getintregister(list,loc.size); + a_load_subsetreF_reg(list,loc.size,loc.size,loc.sref,tmpreg); + a_op_ref_reg(list,op,loc.size,ref,tmpreg); + a_load_reg_subsetref(list,loc.size,loc.size,tmpreg,loc.sref); + end; + else + internalerror(200109061); + end; + end; + + + procedure Tcg.a_op_const_reg_reg(list:TAsmList;op:Topcg;size:Tcgsize; + a:tcgint;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: TAsmList; 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 + { can we do a direct operation on the target register ? } + if op in [OP_ADD,OP_MUL,OP_AND,OP_MOVE,OP_XOR,OP_IMUL,OP_OR] then + a_op_reg_reg(list,op,size,src2,dst) + 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; + end; + + + procedure tcg.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; 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: TAsmList; 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_reg_label(list: TAsmList; size: tcgsize; + cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel); + var + tmpreg: tregister; + begin + tmpreg:=getintregister(list,size); + a_load_const_reg(list,size,a,tmpreg); + a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l); + end; + + + procedure tcg.a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;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 : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const loc : tlocation; + l : tasmlabel); + var + tmpreg : tregister; + 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); + LOC_SUBSETREG, LOC_CSUBSETREG: + begin + tmpreg:=getintregister(list,size); + a_load_subsetreg_reg(list,loc.size,size,loc.sreg,tmpreg); + a_cmp_const_reg_label(list,size,cmp_op,a,tmpreg,l); + end; + LOC_SUBSETREF, LOC_CSUBSETREF: + begin + tmpreg:=getintregister(list,size); + a_load_subsetref_reg(list,loc.size,size,loc.sref,tmpreg); + a_cmp_const_reg_label(list,size,cmp_op,a,tmpreg,l); + end; + else + internalerror(200109061); + end; + end; + + + procedure tcg.a_cmp_ref_reg_label(list : TAsmList;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 : TAsmList;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_reg_loc_label(list : TAsmList;size : tcgsize;cmp_op : topcmp; reg: tregister; const loc: tlocation; l : tasmlabel); + begin + a_cmp_loc_reg_label(list,size,swap_opcmp(cmp_op),loc,reg,l); + end; + + + procedure tcg.a_cmp_loc_reg_label(list : TAsmList;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); + LOC_SUBSETREG, + LOC_CSUBSETREG: + a_cmp_subsetreg_reg_label(list,loc.size,size,cmp_op,loc.sreg,reg,l); + LOC_SUBSETREF, + LOC_CSUBSETREF: + a_cmp_subsetref_reg_label(list,loc.size,size,cmp_op,loc.sref,reg,l); + else + internalerror(200203231); + end; + end; + + + procedure tcg.a_cmp_subsetreg_reg_label(list : TAsmList; subsetsize : tcgsize; cmpsize : tcgsize; cmp_op : topcmp; const sreg: tsubsetregister; reg : tregister; l : tasmlabel); + var + tmpreg: tregister; + begin + tmpreg:=getintregister(list, cmpsize); + a_load_subsetreg_reg(list,subsetsize,cmpsize,sreg,tmpreg); + a_cmp_reg_reg_label(list,cmpsize,cmp_op,tmpreg,reg,l); + end; + + + procedure tcg.a_cmp_subsetref_reg_label(list : TAsmList; subsetsize, cmpsize : tcgsize; cmp_op : topcmp; const sref: tsubsetreference; reg : tregister; l : tasmlabel); + var + tmpreg: tregister; + begin + tmpreg:=getintregister(list, cmpsize); + a_load_subsetref_reg(list,subsetsize,cmpsize,sref,tmpreg); + a_cmp_reg_reg_label(list,cmpsize,cmp_op,tmpreg,reg,l); + end; + + + procedure tcg.a_cmp_ref_loc_label(list : TAsmList;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; + LOC_SUBSETREG, LOC_CSUBSETREG: + begin + tmpreg:=getintregister(list, size); + a_load_ref_reg(list,size,size,loc.reference,tmpreg); + a_cmp_subsetreg_reg_label(list,loc.size,size,swap_opcmp(cmp_op),loc.sreg,tmpreg,l); + end; + LOC_SUBSETREF, LOC_CSUBSETREF: + begin + tmpreg:=getintregister(list, size); + a_load_ref_reg(list,size,size,loc.reference,tmpreg); + a_cmp_subsetref_reg_label(list,loc.size,size,swap_opcmp(cmp_op),loc.sref,tmpreg,l); + end; + else + internalerror(200109061); + end; + end; + + + procedure tcg.a_loadmm_loc_reg(list: TAsmList; 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); + LOC_REGISTER,LOC_CREGISTER: + a_loadmm_intreg_reg(list,loc.size,size,loc.register,reg,shuffle); + else + internalerror(200310121); + end; + end; + + + procedure tcg.a_loadmm_reg_loc(list: TAsmList; 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_loadmm_reg_cgpara(list: TAsmList; size: tcgsize; reg: tregister;const cgpara : TCGPara;shuffle : pmmshuffle); + var + href : treference; +{$ifndef cpu64bitalu} + tmpreg : tregister; + reg64 : tregister64; +{$endif not cpu64bitalu} + begin +{$ifndef cpu64bitalu} + if not(cgpara.location^.loc in [LOC_REGISTER,LOC_CREGISTER]) or + (size<>OS_F64) then +{$endif not cpu64bitalu} + cgpara.check_simple_location; + paramanager.alloccgpara(list,cgpara); + 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,cgpara.alignment); + a_loadmm_reg_ref(list,size,cgpara.location^.size,reg,href,shuffle); + end; + LOC_REGISTER,LOC_CREGISTER: + begin + if assigned(shuffle) and + not shufflescalar(shuffle) then + internalerror(2009112510); +{$ifndef cpu64bitalu} + if (size=OS_F64) then + begin + if not assigned(cgpara.location^.next) or + assigned(cgpara.location^.next^.next) then + internalerror(2009112512); + case cgpara.location^.next^.loc of + LOC_REGISTER,LOC_CREGISTER: + tmpreg:=cgpara.location^.next^.register; + LOC_REFERENCE,LOC_CREFERENCE: + tmpreg:=getintregister(list,OS_32); + else + internalerror(2009112910); + end; + if (target_info.endian=ENDIAN_BIG) then + begin + { paraloc^ -> high + paraloc^.next -> low } + reg64.reghi:=cgpara.location^.register; + reg64.reglo:=tmpreg; + end + else + begin + { paraloc^ -> low + paraloc^.next -> high } + reg64.reglo:=cgpara.location^.register; + reg64.reghi:=tmpreg; + end; + cg64.a_loadmm_reg_intreg64(list,size,reg,reg64); + if (cgpara.location^.next^.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then + begin + if not(cgpara.location^.next^.size in [OS_32,OS_S32]) then + internalerror(2009112911); + reference_reset_base(href,cgpara.location^.next^.reference.index,cgpara.location^.next^.reference.offset,cgpara.alignment); + a_load_reg_ref(list,OS_32,cgpara.location^.next^.size,tmpreg,href); + end; + end + else +{$endif not cpu64bitalu} + a_loadmm_reg_intreg(list,size,cgpara.location^.size,reg,cgpara.location^.register,mms_movescalar); + end + else + internalerror(200310123); + end; + end; + + + procedure tcg.a_loadmm_ref_cgpara(list: TAsmList; 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_loadmm_reg_cgpara(list,cgpara.location^.size,hr,cgpara,@hs); + end + else + a_loadmm_reg_cgpara(list,cgpara.location^.size,hr,cgpara,shuffle); + end; + + + procedure tcg.a_loadmm_loc_cgpara(list: TAsmList;const loc: tlocation; const cgpara : TCGPara;shuffle : pmmshuffle); + begin + case loc.loc of + LOC_MMREGISTER,LOC_CMMREGISTER: + a_loadmm_reg_cgpara(list,loc.size,loc.register,cgpara,shuffle); + LOC_REFERENCE,LOC_CREFERENCE: + a_loadmm_ref_cgpara(list,loc.size,loc.reference,cgpara,shuffle); + else + internalerror(200310123); + end; + end; + + + procedure tcg.a_opmm_ref_reg(list: TAsmList; 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: TAsmList; 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_loadmm_intreg_reg(list: tasmlist; fromsize,tosize: tcgsize; intreg,mmreg: tregister; shuffle: pmmshuffle); + var + tmpref: treference; + begin + if (tcgsize2size[fromsize]<>4) or + (tcgsize2size[tosize]<>4) then + internalerror(2009112503); + tg.gettemp(list,4,4,tt_normal,tmpref); + a_load_reg_ref(list,fromsize,fromsize,intreg,tmpref); + a_loadmm_ref_reg(list,tosize,tosize,tmpref,mmreg,shuffle); + tg.ungettemp(list,tmpref); + end; + + + procedure tcg.a_loadmm_reg_intreg(list: tasmlist; fromsize,tosize: tcgsize; mmreg,intreg: tregister; shuffle: pmmshuffle); + var + tmpref: treference; + begin + if (tcgsize2size[fromsize]<>4) or + (tcgsize2size[tosize]<>4) then + internalerror(2009112504); + tg.gettemp(list,8,8,tt_normal,tmpref); + cg.a_loadmm_reg_ref(list,fromsize,fromsize,mmreg,tmpref,shuffle); + a_load_ref_reg(list,tosize,tosize,tmpref,intreg); + tg.ungettemp(list,tmpref); + end; + + + procedure tcg.a_opmm_loc_reg(list: TAsmList; 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 : TAsmList;const source,dest : treference;len : tcgint); + begin + g_concatcopy(list,source,dest,len); + end; + + + procedure tcg.g_copyshortstring(list : TAsmList;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); + a_loadaddr_ref_cgpara(list,dest,cgpara3); + a_loadaddr_ref_cgpara(list,source,cgpara2); + a_load_const_cgpara(list,OS_INT,len,cgpara1); + paramanager.freecgpara(list,cgpara3); + paramanager.freecgpara(list,cgpara2); + paramanager.freecgpara(list,cgpara1); + allocallcpuregisters(list); + a_call_name(list,'FPC_SHORTSTR_ASSIGN',false); + deallocallcpuregisters(list); + cgpara3.done; + cgpara2.done; + cgpara1.done; + end; + + + procedure tcg.g_copyvariant(list : TAsmList;const source,dest : treference); + var + cgpara1,cgpara2 : TCGPara; + begin + cgpara1.init; + cgpara2.init; + paramanager.getintparaloc(pocall_default,1,cgpara1); + paramanager.getintparaloc(pocall_default,2,cgpara2); + a_loadaddr_ref_cgpara(list,dest,cgpara2); + a_loadaddr_ref_cgpara(list,source,cgpara1); + paramanager.freecgpara(list,cgpara2); + paramanager.freecgpara(list,cgpara1); + allocallcpuregisters(list); + a_call_name(list,'FPC_VARIANT_COPY_OVERWRITE',false); + deallocallcpuregisters(list); + cgpara2.done; + cgpara1.done; + end; + + + procedure tcg.g_incrrefcount(list : TAsmList;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_or_dispinterface(t) then + incrfunc:='FPC_INTF_INCR_REF' + else if is_ansistring(t) then + incrfunc:='FPC_ANSISTR_INCR_REF' + else if is_widestring(t) then + incrfunc:='FPC_WIDESTR_INCR_REF' + else if is_unicodestring(t) then + incrfunc:='FPC_UNICODESTR_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 + { widestrings aren't ref. counted on all platforms so we need the address + to create a real copy } + if is_widestring(t) then + a_loadaddr_ref_cgpara(list,ref,cgpara1) + else + { these functions get the pointer by value } + a_load_ref_cgpara(list,OS_ADDR,ref,cgpara1); + paramanager.freecgpara(list,cgpara1); + allocallcpuregisters(list); + a_call_name(list,incrfunc,false); + deallocallcpuregisters(list); + end + else + begin + if is_open_array(t) then + InternalError(201103054); + reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint)); + a_loadaddr_ref_cgpara(list,href,cgpara2); + a_loadaddr_ref_cgpara(list,ref,cgpara1); + paramanager.freecgpara(list,cgpara1); + paramanager.freecgpara(list,cgpara2); + allocallcpuregisters(list); + a_call_name(list,'FPC_ADDREF',false); + deallocallcpuregisters(list); + end; + cgpara2.done; + cgpara1.done; + end; + + + procedure tcg.g_array_rtti_helper(list: TAsmList; t: tdef; const ref: treference; const highloc: tlocation; const name: string); + var + cgpara1,cgpara2,cgpara3: TCGPara; + href: TReference; + hreg, lenreg: TRegister; + begin + cgpara1.init; + cgpara2.init; + cgpara3.init; + paramanager.getintparaloc(pocall_default,1,cgpara1); + paramanager.getintparaloc(pocall_default,2,cgpara2); + paramanager.getintparaloc(pocall_default,3,cgpara3); + + reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint)); + if highloc.loc=LOC_CONSTANT then + a_load_const_cgpara(list,OS_INT,highloc.value+1,cgpara3) + else + begin + if highloc.loc in [LOC_REGISTER,LOC_CREGISTER] then + hreg:=highloc.register + else + begin + hreg:=getintregister(list,OS_INT); + a_load_loc_reg(list,OS_INT,highloc,hreg); + end; + { increment, converts high(x) to length(x) } + lenreg:=getintregister(list,OS_INT); + a_op_const_reg_reg(list,OP_ADD,OS_INT,1,hreg,lenreg); + a_load_reg_cgpara(list,OS_INT,lenreg,cgpara3); + end; + + a_loadaddr_ref_cgpara(list,href,cgpara2); + a_loadaddr_ref_cgpara(list,ref,cgpara1); + paramanager.freecgpara(list,cgpara1); + paramanager.freecgpara(list,cgpara2); + paramanager.freecgpara(list,cgpara3); + allocallcpuregisters(list); + a_call_name(list,name,false); + deallocallcpuregisters(list); + + cgpara3.done; + cgpara2.done; + cgpara1.done; + end; + + procedure tcg.g_initialize(list : TAsmList;t : tdef;const ref : treference); + var + href : treference; + cgpara1,cgpara2 : TCGPara; + begin + cgpara1.init; + cgpara2.init; + if is_ansistring(t) or + is_widestring(t) or + is_unicodestring(t) or + is_interfacecom_or_dispinterface(t) or + is_dynamic_array(t) then + a_load_const_ref(list,OS_ADDR,0,ref) + else if t.typ=variantdef then + begin + paramanager.getintparaloc(pocall_default,1,cgpara1); + a_loadaddr_ref_cgpara(list,ref,cgpara1); + paramanager.freecgpara(list,cgpara1); + allocallcpuregisters(list); + a_call_name(list,'FPC_VARIANT_INIT',false); + deallocallcpuregisters(list); + end + else + begin + if is_open_array(t) then + InternalError(201103052); + paramanager.getintparaloc(pocall_default,1,cgpara1); + paramanager.getintparaloc(pocall_default,2,cgpara2); + reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint)); + a_loadaddr_ref_cgpara(list,href,cgpara2); + a_loadaddr_ref_cgpara(list,ref,cgpara1); + paramanager.freecgpara(list,cgpara1); + paramanager.freecgpara(list,cgpara2); + allocallcpuregisters(list); + a_call_name(list,'FPC_INITIALIZE',false); + deallocallcpuregisters(list); + end; + cgpara1.done; + cgpara2.done; + end; + + + procedure tcg.g_finalize(list : TAsmList;t : tdef;const ref : treference); + var + href : treference; + cgpara1,cgpara2 : TCGPara; + decrfunc : string; + begin + if is_interfacecom_or_dispinterface(t) then + decrfunc:='FPC_INTF_DECR_REF' + else if is_ansistring(t) then + decrfunc:='FPC_ANSISTR_DECR_REF' + else if is_widestring(t) then + decrfunc:='FPC_WIDESTR_DECR_REF' + else if is_unicodestring(t) then + decrfunc:='FPC_UNICODESTR_DECR_REF' + else if t.typ=variantdef then + decrfunc:='FPC_VARIANT_CLEAR' + else + begin + cgpara1.init; + cgpara2.init; + if is_open_array(t) then + InternalError(201103051); + paramanager.getintparaloc(pocall_default,1,cgpara1); + paramanager.getintparaloc(pocall_default,2,cgpara2); + reference_reset_symbol(href,RTTIWriter.get_rtti_label(t,initrtti),0,sizeof(pint)); + a_loadaddr_ref_cgpara(list,href,cgpara2); + a_loadaddr_ref_cgpara(list,ref,cgpara1); + paramanager.freecgpara(list,cgpara1); + paramanager.freecgpara(list,cgpara2); + if is_dynamic_array(t) then + g_call(list,'FPC_DYNARRAY_CLEAR') + else + g_call(list,'FPC_FINALIZE'); + cgpara1.done; + cgpara2.done; + exit; + end; + cgpara1.init; + paramanager.getintparaloc(pocall_default,1,cgpara1); + a_loadaddr_ref_cgpara(list,ref,cgpara1); + paramanager.freecgpara(list,cgpara1); + g_call(list,decrfunc); + cgpara1.done; + end; + + + procedure tcg.g_rangecheck(list: TAsmList; 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.resultdef) } + { 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; + fromsize, tosize: cardinal; + from_signed, to_signed: boolean; + begin + { range checking on and range checkable value? } + if not(cs_check_range in current_settings.localswitches) or + not(fromdef.typ in [orddef,enumdef]) or + { C-style booleans can't really fail range checks, } + { all values are always valid } + is_cbool(todef) then + exit; +{$ifndef cpu64bitalu} + { 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 cpu64bitalu} + { 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); + to_signed := is_signed(todef); + { check the rangedef of the array, not the array itself } + { (only change now, since getrange needs the arraydef) } + if (todef.typ = arraydef) then + todef := tarraydef(todef).rangedef; + { 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 cpu64bitalu} + if (fromdef = todef) and + (fromdef.typ=orddef) and + (((((torddef(fromdef).ordtype = s64bit) and + (lfrom = low(int64)) and + (hfrom = high(int64))) or + ((torddef(fromdef).ordtype = u64bit) and + (lfrom = low(qword)) and + (hfrom = high(qword))) or + ((torddef(fromdef).ordtype = scurrency) and + (lfrom = low(int64)) and + (hfrom = high(int64)))))) then + exit; +{$else cpu64bitalu} + if (fromdef = todef) and + (fromdef.typ=orddef) and + (((((torddef(fromdef).ordtype = s32bit) and + (lfrom = int64(low(longint))) and + (hfrom = int64(high(longint)))) or + ((torddef(fromdef).ordtype = u32bit) and + (lfrom = low(cardinal)) and + (hfrom = high(cardinal)))))) then + exit; +{$endif cpu64bitalu} + + { optimize some range checks away in safe cases } + fromsize := fromdef.size; + tosize := todef.size; + if ((from_signed = to_signed) or + (not from_signed)) and + (lto<=lfrom) and (hto>=hfrom) and + (fromsize <= tosize) then + begin + { if fromsize < tosize, and both have the same signed-ness or } + { fromdef is unsigned, then all bit patterns from fromdef are } + { valid for todef as well } + if (fromsize < tosize) then + exit; + if (fromsize = tosize) and + (from_signed = to_signed) then + { only optimize away if all bit patterns which fit in fromsize } + { are valid for the todef } + begin +{$push} +{$Q-} +{$R-} + if to_signed then + begin + { calculation of the low/high ranges must not overflow 64 bit + otherwise we end up comparing with zero for 64 bit data types on + 64 bit processors } + if (lto = (int64(-1) << (tosize * 8 - 1))) and + (hto = (-((int64(-1) << (tosize * 8 - 1))+1))) then + exit + end + else + begin + { calculation of the low/high ranges must not overflow 64 bit + otherwise we end up having all zeros for 64 bit data types on + 64 bit processors } + if (lto = 0) and + (qword(hto) = (qword(-1) >> (64-(tosize * 8))) ) then + exit + end; +{$pop} + end + end; + + { 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 } + + if from_signed xor to_signed 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',false); + 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',false); + 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,tcgint(int64(lto)),hreg); + current_asmdata.getjumplabel(neglabel); + { + if from_signed then + a_cmp_const_reg_label(list,OS_INT,OC_GTE,aint(hto-lto),hreg,neglabel) + else + } +{$ifdef cpu64bitalu} + if qword(hto-lto)>qword(aintmax) then + a_cmp_const_reg_label(list,OS_INT,OC_BE,aintmax,hreg,neglabel) + else +{$endif cpu64bitalu} + a_cmp_const_reg_label(list,OS_INT,OC_BE,tcgint(int64(hto-lto)),hreg,neglabel); + a_call_name(list,'FPC_RANGEERROR',false); + a_label(list,neglabel); + end; + + + procedure tcg.g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation); + begin + g_overflowCheck(list,loc,def); + end; + + +{$ifdef cpuflags} + procedure tcg.g_flags2ref(list: TAsmList; 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; +{$endif cpuflags} + + + procedure tcg.g_maybe_testself(list : TAsmList;reg:tregister); + var + OKLabel : tasmlabel; + cgpara1 : TCGPara; + begin + if (cs_check_object in current_settings.localswitches) or + (cs_check_range in current_settings.localswitches) then + begin + current_asmdata.getjumplabel(oklabel); + a_cmp_const_reg_label(list,OS_ADDR,OC_NE,0,reg,oklabel); + cgpara1.init; + paramanager.getintparaloc(pocall_default,1,cgpara1); + a_load_const_cgpara(list,OS_INT,tcgint(210),cgpara1); + paramanager.freecgpara(list,cgpara1); + a_call_name(list,'FPC_HANDLEERROR',false); + a_label(list,oklabel); + cgpara1.done; + end; + end; + + + procedure tcg.g_maybe_testvmt(list : TAsmList;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 current_settings.localswitches) then + begin + reference_reset_symbol(hrefvmt,current_asmdata.RefAsmSymbol(objdef.vmt_mangledname),0,sizeof(pint)); + a_loadaddr_ref_cgpara(list,hrefvmt,cgpara2); + a_load_reg_cgpara(list,OS_ADDR,reg,cgpara1); + paramanager.freecgpara(list,cgpara1); + paramanager.freecgpara(list,cgpara2); + allocallcpuregisters(list); + a_call_name(list,'FPC_CHECK_OBJECT_EXT',false); + deallocallcpuregisters(list); + end + else + if (cs_check_range in current_settings.localswitches) then + begin + a_load_reg_cgpara(list,OS_ADDR,reg,cgpara1); + paramanager.freecgpara(list,cgpara1); + allocallcpuregisters(list); + a_call_name(list,'FPC_CHECK_OBJECT',false); + deallocallcpuregisters(list); + end; + cgpara1.done; + cgpara2.done; + end; + + +{***************************************************************************** + Entry/Exit Code Functions +*****************************************************************************} + + procedure tcg.g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;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); + a_load_reg_cgpara(list,OS_INT,sizereg,cgpara1); + paramanager.freecgpara(list,cgpara1); + allocallcpuregisters(list); + a_call_name(list,'FPC_GETMEM',false); + 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 } + a_load_reg_cgpara(list,OS_INT,sizereg,cgpara3); + { load destination } + a_load_reg_cgpara(list,OS_ADDR,destreg,cgpara2); + { load source } + a_load_reg_cgpara(list,OS_ADDR,sourcereg,cgpara1); + paramanager.freecgpara(list,cgpara3); + paramanager.freecgpara(list,cgpara2); + paramanager.freecgpara(list,cgpara1); + allocallcpuregisters(list); + a_call_name(list,'FPC_MOVE',false); + deallocallcpuregisters(list); + cgpara3.done; + cgpara2.done; + cgpara1.done; + end; + + + procedure tcg.g_releasevaluepara_openarray(list : TAsmList;const l:tlocation); + var + cgpara1 : TCGPara; + begin + { do move call } + cgpara1.init; + paramanager.getintparaloc(pocall_default,1,cgpara1); + { load source } + a_load_loc_cgpara(list,l,cgpara1); + paramanager.freecgpara(list,cgpara1); + allocallcpuregisters(list); + a_call_name(list,'FPC_FREEMEM',false); + deallocallcpuregisters(list); + cgpara1.done; + end; + + + procedure tcg.g_save_registers(list:TAsmList); + var + href : treference; + size : longint; + r : integer; + begin + { calculate temp. size } + 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)); + + { mm registers } + if uses_registers(R_MMREGISTER) then + begin + { Make sure we reserve enough space to do the alignment based on the offset + later on. We can't use the size for this, because the alignment of the start + of the temp is smaller than needed for an OS_VECTOR } + inc(size,tcgsize2size[OS_VECTOR]); + + for r:=low(saved_mm_registers) to high(saved_mm_registers) do + if saved_mm_registers[r] in rg[R_MMREGISTER].used_in_proc then + inc(size,tcgsize2size[OS_VECTOR]); + end; + + if size>0 then + begin + tg.GetTemp(list,size,sizeof(aint),tt_noreuse,current_procinfo.save_regs_ref); + include(current_procinfo.flags,pi_has_saved_regs); + + { Copy registers to temp } + 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; + + if uses_registers(R_MMREGISTER) then + begin + if (href.offset mod tcgsize2size[OS_VECTOR])<>0 then + inc(href.offset,tcgsize2size[OS_VECTOR]-(href.offset mod tcgsize2size[OS_VECTOR])); + + for r:=low(saved_mm_registers) to high(saved_mm_registers) do + begin + if saved_mm_registers[r] in rg[R_MMREGISTER].used_in_proc then + begin + a_loadmm_reg_ref(list,OS_VECTOR,OS_VECTOR,newreg(R_MMREGISTER,saved_mm_registers[r],R_SUBNONE),href,nil); + inc(href.offset,tcgsize2size[OS_VECTOR]); + end; + include(rg[R_MMREGISTER].preserved_by_proc,saved_mm_registers[r]); + end; + end; + end; + end; + + + procedure tcg.g_restore_registers(list:TAsmList); + var + href : treference; + r : integer; + hreg : tregister; + begin + if not(pi_has_saved_regs in current_procinfo.flags) then + exit; + { 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 not 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; + + if uses_registers(R_MMREGISTER) then + begin + if (href.offset mod tcgsize2size[OS_VECTOR])<>0 then + inc(href.offset,tcgsize2size[OS_VECTOR]-(href.offset mod tcgsize2size[OS_VECTOR])); + + for r:=low(saved_mm_registers) to high(saved_mm_registers) do + begin + if saved_mm_registers[r] in rg[R_MMREGISTER].used_in_proc then + begin + hreg:=newreg(R_MMREGISTER,saved_mm_registers[r],R_SUBNONE); + { Allocate register so the optimizer does not remove the load } + a_reg_alloc(list,hreg); + a_loadmm_ref_reg(list,OS_VECTOR,OS_VECTOR,href,hreg,nil); + inc(href.offset,tcgsize2size[OS_VECTOR]); + end; + end; + end; + tg.UnGetTemp(list,current_procinfo.save_regs_ref); + end; + + + procedure tcg.g_profilecode(list : TAsmList); + begin + end; + + + procedure tcg.g_exception_reason_save(list : TAsmList; 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 : TAsmList; const href : treference; a: tcgint); + begin + a_load_const_ref(list, OS_INT, a, href); + end; + + + procedure tcg.g_exception_reason_load(list : TAsmList; const href : treference); + begin + cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG); + a_load_ref_reg(list, OS_INT, OS_INT, href, NR_FUNCTION_RESULT_REG); + end; + + + procedure tcg.g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint); + var + hsym : tsym; + href : treference; + paraloc : Pcgparalocation; + begin + { calculate the parameter info for the procdef } + procdef.init_paraloc_info(callerside); + hsym:=tsym(procdef.parast.Find('self')); + if not(assigned(hsym) and + (hsym.typ=paravarsym)) then + internalerror(200305251); + paraloc:=tparavarsym(hsym).paraloc[callerside].location; + while paraloc<>nil do + with paraloc^ do + begin + case loc of + LOC_REGISTER: + a_op_const_reg(list,OP_SUB,size,ioffset,register); + LOC_REFERENCE: + begin + { offset in the wrapper needs to be adjusted for the stored + return address } + reference_reset_base(href,reference.index,reference.offset+sizeof(pint),sizeof(pint)); + a_op_const_ref(list,OP_SUB,size,ioffset,href); + end + else + internalerror(200309189); + end; + paraloc:=next; + end; + end; + + + procedure tcg.g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string); + begin + a_jmp_name(list,externalname); + end; + + + procedure tcg.a_call_name_static(list : TAsmList;const s : string); + begin + a_call_name(list,s,false); + end; + + + procedure tcg.a_call_ref(list : TAsmList;ref: treference); + var + tempreg : TRegister; + begin + tempreg := getintregister(list, OS_ADDR); + a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,tempreg); + a_call_reg(list,tempreg); + end; + + + function tcg.g_indirect_sym_load(list:TAsmList;const symname: string; weak: boolean): tregister; + var + l: tasmsymbol; + ref: treference; + nlsymname: string; + begin + result := NR_NO; + case target_info.system of + system_powerpc_darwin, + system_i386_darwin, + system_i386_iphonesim, + system_powerpc64_darwin, + system_arm_darwin: + begin + nlsymname:='L'+symname+'$non_lazy_ptr'; + l:=current_asmdata.getasmsymbol(nlsymname); + if not(assigned(l)) then + begin + new_section(current_asmdata.asmlists[al_picdata],sec_data_nonlazy,'',sizeof(pint)); + l:=current_asmdata.DefineAsmSymbol(nlsymname,AB_LOCAL,AT_DATA); + current_asmdata.asmlists[al_picdata].concat(tai_symbol.create(l,0)); + if not(weak) then + current_asmdata.asmlists[al_picdata].concat(tai_directive.Create(asd_indirect_symbol,current_asmdata.RefAsmSymbol(symname).Name)) + else + current_asmdata.asmlists[al_picdata].concat(tai_directive.Create(asd_indirect_symbol,current_asmdata.WeakRefAsmSymbol(symname).Name)); +{$ifdef cpu64bitaddr} + current_asmdata.asmlists[al_picdata].concat(tai_const.create_64bit(0)); +{$else cpu64bitaddr} + current_asmdata.asmlists[al_picdata].concat(tai_const.create_32bit(0)); +{$endif cpu64bitaddr} + end; + result := getaddressregister(list); + reference_reset_symbol(ref,l,0,sizeof(pint)); + { a_load_ref_reg will turn this into a pic-load if needed } + a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,result); + end; + end; + end; + + + procedure tcg.g_maybe_got_init(list: TAsmList); + begin + end; + + procedure tcg.g_call(list: TAsmList;const s: string); + begin + allocallcpuregisters(list); + a_call_name(list,s,false); + deallocallcpuregisters(list); + end; + + procedure tcg.g_local_unwind(list: TAsmList; l: TAsmLabel); + begin + a_jmp_always(list,l); + end; + + procedure tcg.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister; shuffle: pmmshuffle); + begin + internalerror(200807231); + end; + + + procedure tcg.a_loadmm_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister; shuffle: pmmshuffle); + begin + internalerror(200807232); + end; + + + procedure tcg.a_loadmm_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference; shuffle: pmmshuffle); + begin + internalerror(200807233); + end; + + + procedure tcg.a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size: tcgsize; src, dst: tregister; shuffle: pmmshuffle); + begin + internalerror(200807234); + end; + + + function tcg.getflagregister(list: TAsmList; size: Tcgsize): Tregister; + begin + Result:=TRegister(0); + internalerror(200807238); + end; + +{***************************************************************************** + TCG64 +*****************************************************************************} + +{$ifndef cpu64bitalu} + procedure tcg64.a_op64_const_reg_reg(list: TAsmList;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: TAsmList;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_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; a : int64; const sref: tsubsetreference); + var + tmpreg64 : tregister64; + begin + tmpreg64.reglo:=cg.getintregister(list,OS_32); + tmpreg64.reghi:=cg.getintregister(list,OS_32); + a_load64_subsetref_reg(list,sref,tmpreg64); + a_op64_const_reg(list,op,size,a,tmpreg64); + a_load64_reg_subsetref(list,tmpreg64,sref); + end; + + + procedure tcg64.a_op64_reg_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; reg: tregister64; const sref: tsubsetreference); + var + tmpreg64 : tregister64; + begin + tmpreg64.reglo:=cg.getintregister(list,OS_32); + tmpreg64.reghi:=cg.getintregister(list,OS_32); + a_load64_subsetref_reg(list,sref,tmpreg64); + a_op64_reg_reg(list,op,size,reg,tmpreg64); + a_load64_reg_subsetref(list,tmpreg64,sref); + end; + + + procedure tcg64.a_op64_ref_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; const ref: treference; const sref: tsubsetreference); + var + tmpreg64 : tregister64; + begin + tmpreg64.reglo:=cg.getintregister(list,OS_32); + tmpreg64.reghi:=cg.getintregister(list,OS_32); + a_load64_subsetref_reg(list,sref,tmpreg64); + a_op64_ref_reg(list,op,size,ref,tmpreg64); + a_load64_reg_subsetref(list,tmpreg64,sref); + end; + + + procedure tcg64.a_op64_subsetref_subsetref(list : TAsmList; Op : TOpCG; size : TCGSize; const ssref,dsref: tsubsetreference); + var + tmpreg64 : tregister64; + begin + tmpreg64.reglo:=cg.getintregister(list,OS_32); + tmpreg64.reghi:=cg.getintregister(list,OS_32); + a_load64_subsetref_reg(list,ssref,tmpreg64); + a_op64_reg_subsetref(list,op,size,tmpreg64,dsref); + end; + + + procedure tcg64.a_op64_const_reg_reg_checkoverflow(list: TAsmList;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: TAsmList;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; + + + procedure tcg64.a_load64_loc_subsetref(list : TAsmList;const l: tlocation; const sref : tsubsetreference); + begin + case l.loc of + LOC_REFERENCE, LOC_CREFERENCE: + a_load64_ref_subsetref(list,l.reference,sref); + LOC_REGISTER,LOC_CREGISTER: + a_load64_reg_subsetref(list,l.register64,sref); + LOC_CONSTANT : + a_load64_const_subsetref(list,l.value64,sref); + LOC_SUBSETREF,LOC_CSUBSETREF: + a_load64_subsetref_subsetref(list,l.sref,sref); + else + internalerror(2006082210); + end; + end; + + + procedure tcg64.a_load64_subsetref_loc(list: TAsmlist; const sref: tsubsetreference; const l: tlocation); + begin + case l.loc of + LOC_REFERENCE, LOC_CREFERENCE: + a_load64_subsetref_ref(list,sref,l.reference); + LOC_REGISTER,LOC_CREGISTER: + a_load64_subsetref_reg(list,sref,l.register64); + LOC_SUBSETREF,LOC_CSUBSETREF: + a_load64_subsetref_subsetref(list,sref,l.sref); + else + internalerror(2006082211); + end; + end; +{$endif cpu64bitalu} + + + procedure destroy_codegen; + begin + cg.free; + cg:=nil; +{$ifndef cpu64bitalu} + cg64.free; + cg64:=nil; +{$endif cpu64bitalu} + end; + +end. diff --git a/closures/compiler/cgutils.pas b/closures/compiler/cgutils.pas new file mode 100644 index 0000000000..5426f7b3c6 --- /dev/null +++ b/closures/compiler/cgutils.pas @@ -0,0 +1,248 @@ +{ + 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 : asizeint; + symbol, + relsymbol : tasmsymbol; +{$if defined(x86) or defined(m68k)} + segment, +{$endif defined(x86) or defined(m68k)} + base, + index : tregister; + refaddr : trefaddr; + scalefactor : byte; +{$ifdef arm} + symboldata : tlinkedlistitem; + signindex : shortint; + shiftimm : byte; + addressmode : taddressmode; + shiftmode : tshiftmode; +{$endif arm} +{$ifdef avr} + addressmode : taddressmode; +{$endif avr} +{$ifdef m68k} + { indexed increment and decrement mode } + { (An)+ and -(An) } + direction : tdirection; +{$endif m68k} + alignment : byte; + end; + + tsubsetregister = record + subsetreg : tregister; + startbit, bitlen: byte; + subsetregsize: tcgsize; + end; + + tsubsetreference = record + ref: treference; + bitindexreg: tregister; + startbit, bitlen: byte; + end; + + tlocation = record + loc : TCGLoc; + size : TCGSize; + case TCGLoc of +{$ifdef cpuflags} + LOC_FLAGS : (resflags : tresflags); +{$endif cpuflags} + 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; + { some x86_64 targets require two function result registers } + registerhi : 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 cpu64bitalu} + { overlay a 64 Bit register type } + 2 : (register64 : tregister64); +{$endif cpu64bitalu} +{$ifdef avr} + 3 : (registers : array[0..3] of tregister); +{$endif avr} + ); + LOC_SUBSETREG, + LOC_CSUBSETREG : ( + sreg: tsubsetregister; + ); + LOC_SUBSETREF : ( + sref: tsubsetreference; + ) + end; + + + { trerefence handling } + + {# Clear to zero a treference } + procedure reference_reset(var ref : treference; alignment: longint); + {# Clear to zero a treference, and set is base address + to base register. + } + procedure reference_reset_base(var ref : treference;base : tregister;offset, alignment : longint); + procedure reference_reset_symbol(var ref : treference;sym : tasmsymbol;offset, alignment : longint); + { This routine verifies if two references are the same, and + if so, returns TRUE, otherwise returns false. + } + function references_equal(const sref,dref : treference) : boolean; + + { tlocation handling } + + { cannot be used for loc_(c)reference, because that one requires an alignment } + procedure location_reset(var l : tlocation;lt:TCGNonRefLoc;lsize:TCGSize); + { for loc_(c)reference } + procedure location_reset_ref(var l : tlocation;lt:TCGRefLoc;lsize:TCGSize; alignment: longint); + procedure location_copy(var destloc:tlocation; const sourceloc : tlocation); + procedure location_swap(var destloc,sourceloc : tlocation); + + { returns r with the given alignment } + function setalignment(const r : treference;b : byte) : treference; + + +implementation + +uses + systems, + verbose; + +{**************************************************************************** + TReference +****************************************************************************} + + procedure reference_reset(var ref : treference; alignment: longint); + begin + FillChar(ref,sizeof(treference),0); +{$ifdef arm} + ref.signindex:=1; +{$endif arm} + ref.alignment:=alignment; + end; + + + procedure reference_reset_base(var ref : treference;base : tregister;offset, alignment : longint); + begin + reference_reset(ref,alignment); + ref.base:=base; + ref.offset:=offset; + end; + + + procedure reference_reset_symbol(var ref : treference;sym : tasmsymbol;offset, alignment : longint); + begin + reference_reset(ref,alignment); + ref.symbol:=sym; + ref.offset:=offset; + end; + + + function references_equal(const sref,dref : treference):boolean; + begin + references_equal:=CompareByte(sref,dref,sizeof(treference))=0; + end; + + + { returns r with the given alignment } + function setalignment(const r : treference;b : byte) : treference; + begin + result:=r; + result.alignment:=b; + end; + +{**************************************************************************** + TLocation +****************************************************************************} + + procedure location_reset(var l : tlocation;lt:TCGNonRefLoc;lsize:TCGSize); + begin + FillChar(l,sizeof(tlocation),0); + l.loc:=lt; + l.size:=lsize; + if l.loc in [LOC_REFERENCE,LOC_CREFERENCE] then + { call location_reset_ref instead } + internalerror(2009020705); + end; + + procedure location_reset_ref(var l: tlocation; lt: tcgrefloc; lsize: tcgsize; + alignment: longint); + begin + FillChar(l,sizeof(tlocation),0); + l.loc:=lt; + l.size:=lsize; +{$ifdef arm} + l.reference.signindex:=1; +{$endif arm} + l.reference.alignment:=alignment; + 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. + diff --git a/closures/compiler/cmsgs.pas b/closures/compiler/cmsgs.pas new file mode 100644 index 0000000000..eb550f5a94 --- /dev/null +++ b/closures/compiler/cmsgs.pas @@ -0,0 +1,475 @@ +{ + 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 + +uses + globtype; + +const + maxmsgidxparts = 20; + +type + ppchar=^pchar; + TMsgStr = AnsiString; + + TArrayOfPChar = array[0..1000] of pchar; + PArrayOfPChar = ^TArrayOfPChar; + + TArrayOfState = array[0..1000] of tmsgstate; + PArrayOfState = ^TArrayOfState; + + 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; + msgstates : array[1..maxmsgidxparts] of PArrayOfState; + { set if changes with $WARN need to be cleared at next module change } + has_local_changes : boolean; + 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 ResetStates; + procedure CreateIdx; + function GetPChar(nr:longint):pchar; + { function ClearVerbosity(nr:longint):boolean; not used anymore } + function SetVerbosity(nr:longint;newstate:tmsgstate):boolean; + function Get(nr:longint;const args:array of TMsgStr):ansistring; + end; + +{ this will read a line until #10 or #0 and also increase p } +function GetMsgLine(var p:pchar):string; + + +implementation + +uses + SysUtils, + cutils; + + +function MsgReplace(const s:TMsgStr;const args:array of TMsgStr):ansistring; +var + last, + i : longint; + hs : TMsgStr; + +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,j : longint; +begin + msgtxt:=nil; + has_local_changes:=false; + msgsize:=0; + msgparts:=n; + if n<>high(idxmax)+1 then + fail; + for i:=1 to n do + begin + msgidxmax[i]:=idxmax[i-1]; + { create array of msgidx } + getmem(msgidx[i],msgidxmax[i]*sizeof(pointer)); + fillchar(msgidx[i]^,msgidxmax[i]*sizeof(pointer),0); + { create array of states } + getmem(msgstates[i],msgidxmax[i]*sizeof(tmsgstate)); + { default value for msgstate is ms_on_global } + for j:=0 to msgidxmax[i]-1 do + msgstates[i]^[j]:=ms_on_global; + end; +end; + + +destructor TMessage.Done; +var + i : longint; +begin + for i:=1 to msgparts do + begin + freemem(msgidx[i],msgidxmax[i]*sizeof(pointer)); + freemem(msgstates[i],msgidxmax[i]*sizeof(tmsgstate)); + end; + 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; +const + bufsize=8192; +var + f : text; + error,multiline : boolean; + line,i,j : longint; + ptxt : pchar; + s,s1 : string; + buf : pointer; + + procedure err(const msgstr:TMsgStr); + 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); + {$push}{$I-} + reset(f); + {$pop} + 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); + { set default verbosity to off is '-' is found just after the '_' } + if hp1^='-' then + begin + msgstates[numpart]^[numidx]:=ms_off_global; + inc(hp1); + end; + { 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<256) 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 + if (nr div 1000 < msgparts) and + (nr mod 1000 < msgidxmax[nr div 1000]) then + GetPChar:=msgidx[nr div 1000]^[nr mod 1000] + else + GetPChar:=''; +end; + +function TMessage.SetVerbosity(nr:longint;newstate:tmsgstate):boolean; +var + i: longint; + oldstate : tmsgstate; + is_global : boolean; +begin + result:=false; + i:=nr div 1000; + if (i < low(msgstates)) or + (i > msgparts) then + exit; + if (nr mod 1000 < msgidxmax[i]) then + begin + is_global:=(ord(newstate) and ms_global_mask) <> 0; + oldstate:=msgstates[i]^[nr mod 1000]; + if not is_global then + newstate:= tmsgstate((ord(newstate) and ms_local_mask) or (ord(oldstate) and ms_global_mask)); + if newstate<>oldstate then + has_local_changes:=true; + msgstates[i]^[nr mod 1000]:=newstate; + result:=true; + end; +end; + +{ +function TMessage.ClearVerbosity(nr:longint):boolean; +begin + ClearVerbosity:=SetVerbosity(nr,ms_off); +end; +} + +function TMessage.Get(nr:longint;const args:array of TMsgStr):ansistring; +var + hp : pchar; +begin + if (nr div 1000 < msgparts) and + (nr mod 1000 < msgidxmax[nr div 1000]) then + hp:=msgidx[nr div 1000]^[nr mod 1000] + else + hp:=nil; + if hp=nil then + Get:='msg nr '+tostr(nr) + else + Get:=MsgReplace(system.strpas(hp),args); +end; + +procedure TMessage.ResetStates; +var + i,j,glob : longint; + state : tmsgstate; +begin + if not has_local_changes then + exit; + for i:=1 to msgparts do + for j:=0 to msgidxmax[i] - 1 do + begin + state:=msgstates[i]^[j]; + glob:=(ord(state) and ms_global_mask) shr ms_shift; + state:=tmsgstate((glob shl ms_shift) or glob); + msgstates[i]^[j]:=state; + end; + has_local_changes:=false; +end; + + +end. diff --git a/closures/compiler/comphook.pas b/closures/compiler/comphook.pas new file mode 100644 index 0000000000..f6d7323f98 --- /dev/null +++ b/closures/compiler/comphook.pas @@ -0,0 +1,408 @@ +{ + 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 USE_FAKE_SYSUTILS} + sysutils, +{$ELSE} + fksysutl, +{$ENDIF} + globtype, + 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_TimeStamps = $80000; + 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 } + currentmodulestate : string[20]; + { Total Status } + compiledlines : longint; { the number of lines which are compiled } + errorcount, + countWarnings, + countNotes, + countHints : longint; { number of found errors/warnings/notes/hints } + codesize, + datasize : qword; + { program info } + isexe, + ispackage, + islibrary : boolean; + { Settings for the output } + showmsgnrs : boolean; + verbosity : longint; + maxerrorcount : longint; + errorwarning, + errornote, + errorhint, + skip_error, + use_stderr, + use_redir, + use_bugreport, + use_gccoutput, + print_source_path : boolean; + { Redirection support } + redirfile : text; + { Special file for bug report } + reportbugfile : text; + end; + +type + EControlCAbort=class(Exception) + constructor Create; + end; + ECompilerAbort=class(Exception) + constructor Create; + end; + ECompilerAbortSilent=class(Exception) + constructor Create; + end; + +var + status : tcompilerstatus; + +{ Default Functions } +Function def_status:boolean; +Function def_comment(Level:Longint;const s:ansistring):boolean; +function def_internalerror(i:longint):boolean; +function def_CheckVerbosity(v: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:ansistring):boolean; + tinternalerrorfunction = function(i:longint):boolean; + tcheckverbosityfunction = 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_checkverbosity : tcheckverbosityfunction = @def_checkverbosity; + + do_initsymbolinfo : tinitsymbolinfoproc = @def_initsymbolinfo; + do_donesymbolinfo : tdonesymbolinfoproc = @def_donesymbolinfo; + do_extractsymbolinfo : textractsymbolinfoproc = @def_extractsymbolinfo; + needsymbolinfo : boolean =false; + + do_openinputfile : topeninputfilefunc = @def_openinputfile; + do_getnamedfiletime : tgetnamedfiletimefunc = @def_getnamedfiletime; + +implementation + + uses + cutils, systems, globals + ; + +{**************************************************************************** + 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' : if not (tf_files_case_aware in source_info.flags) and + not (tf_files_case_sensitive in source_info.flags) then + gccfilename[i]:=chr(ord(s[i])+32) + else + gccfilename[i]:=s[i]; + 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 + inherited Create('Ctrl-C Signaled!'); + end; + + +constructor ECompilerAbort.Create; + begin + inherited Create('Compilation Aborted'); + end; + + +constructor ECompilerAbortSilent.Create; + begin + inherited Create('Compilation Aborted'); + 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:ansistring):boolean; +const + rh_errorstr = 'error:'; + rh_warningstr = 'warning:'; +var + hs : ansistring; + hs2 : ansistring; +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; + end; + if status.print_source_path then + hs:=status.currentsourcepath+hs; + 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; + if (status.verbosity and V_TimeStamps)<>0 then + begin + system.str(getrealtime-starttime:0:3,hs2); + hs:='['+hs2+'] '+s; + end; + + { Display line } + if (Level<>V_None) and + ((status.verbosity and (Level and V_LevelMask))=(Level and V_LevelMask)) then + begin + if status.use_stderr then + begin + writeln(stderr,hs); + flush(stderr); + end + else + 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 + Write(status.reportbugfile,hexstr(level,8)+':'); + Writeln(status.reportbugfile,hs); + end; +end; + + +function def_internalerror(i : longint) : boolean; +begin + do_comment(V_Fatal+V_LineInfo,'Internal error '+tostr(i)); +{$ifdef EXTDEBUG} + { Internalerror() and def_internalerror() do not + have a stackframe } + dump_stack(stdout,get_caller_frame(get_frame)); +{$endif EXTDEBUG} + def_internalerror:=true; +end; + +function def_CheckVerbosity(v:longint):boolean; +begin + result:=status.use_bugreport or + ((v<>V_None) and + ((status.verbosity and (v and V_LevelMask))=(v and V_LevelMask))); +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; +begin + Result:=FileAge(F); +end; + +end. diff --git a/closures/compiler/compiler.pas b/closures/compiler/compiler.pas new file mode 100644 index 0000000000..f30fbc172b --- /dev/null +++ b/closures/compiler/compiler.pas @@ -0,0 +1,372 @@ +{ + 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} + +interface + +uses +{$ifdef GO32V2} + emu387, +{$endif GO32V2} +{$ifdef WATCOM} + emu387, +{$endif WATCOM} +{$IFNDEF USE_FAKE_SYSUTILS} + sysutils,math, +{$ELSE} + fksysutl, +{$ENDIF} + verbose,comphook,systems, + cutils,cfileutl,cclasses,globals,options,fmodule,parser,symtable, + assemble,link,dbgbase,import,export,tokens,pass_1,wpobase,wpo + { 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 nds} + ,i_nds +{$endif nds} +{$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 wii} + ,i_wii +{$endif wii} +{$ifdef win32} + ,i_win +{$endif win32} +{$ifdef symbian} + ,i_symbian +{$endif symbian} +{$ifdef nativent} + ,i_nativent +{$endif nativent} + ,globtype; + +function Compile(const cmd:TCmdStr):longint; + +implementation + +uses + aasmcpu; + +{$if defined(EXTDEBUG) or defined(MEMDEBUG)} + {$define SHOWUSEDMEM} +{$endif} + +var + CompilerInitedAfterArgs, + CompilerInited : boolean; + + +{**************************************************************************** + Compiler +****************************************************************************} + +procedure DoneCompiler; +begin + if not CompilerInited then + exit; +{ Free compiler if args are read } + if CompilerInitedAfterArgs then + begin + CompilerInitedAfterArgs:=false; + DoneParser; + DoneImport; + DoneExport; + DoneLinker; + DoneAsm; + DoneWpo; + end; +{ Free memory for the others } + CompilerInited:=false; + do_doneSymbolInfo; + DoneSymtable; + DoneGlobals; + DoneFileUtils; + donetokens; +end; + + +procedure InitCompiler(const cmd:TCmdStr); +begin + if CompilerInited then + DoneCompiler; +{ inits which need to be done before the arguments are parsed } + InitSystems; + { fileutils depends on source_info so it must be after systems } + InitFileUtils; + { globals depends on source_info so it must be after systems } + InitGlobals; + { verbose depends on exe_path and must be after globals } + InitVerbose; + inittokens; + IniTSymtable; {Must come before read_arguments, to enable macrosymstack} + do_initSymbolInfo; + CompilerInited:=true; +{ this is needed here for the IDE + in case of compilation failure + at the previous compile } + set_current_module(nil); +{ read the arguments } + read_arguments(cmd); +{ inits which depend on arguments } + InitParser; + InitImport; + InitExport; + InitLinker; + InitAsm; + InitWpo; + + CompilerInitedAfterArgs:=true; +end; + + +function Compile(const cmd:TCmdStr):longint; + +{$maxfpuregisters 0} + + procedure writepathlist(w:longint;l:TSearchPathList); + var + hp : TCmdStrListItem; + begin + hp:=TCmdStrListItem(l.first); + while assigned(hp) do + begin + Message1(w,hp.str); + hp:=TCmdStrListItem(hp.next); + end; + end; + +var + timestr : string[20]; + linkstr : string[64]; +{$ifdef SHOWUSEDMEM} + hstatus : TFPCHeapStatus; +{$endif SHOWUSEDMEM} + ExceptionMask : TFPUExceptionMask; + totaltime : real; +begin + try + try + ExceptionMask:=GetExceptionMask; + SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, + exOverflow, exUnderflow, exPrecision]); + + starttime:=getrealtime; + + { 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); + + { Compile the program } + {$ifdef PREPROCWRITE} + if parapreprocess then + parser.preprocess(inputfilepath+inputfilename) + else + {$endif PREPROCWRITE} + parser.compile(inputfilepath+inputfilename); + + { Show statistics } + if status.errorcount=0 then + begin + totaltime:=getrealtime-starttime; + if totaltime<0 then + totaltime:=totaltime+3600.0*24.0; + timestr:=tostr(trunc(totaltime))+'.'+tostr(round(frac(totaltime)*10)); + if status.codesize<>aword(-1) then + linkstr:=', '+tostr(status.codesize)+' ' +strpas(MessagePChar(general_text_bytes_code))+', '+tostr(status.datasize)+' '+strpas(MessagePChar(general_text_bytes_data)) + else + linkstr:=''; + Message3(general_i_abslines_compiled,tostr(status.compiledlines),timestr,linkstr); + if (Status.Verbosity and V_Warning = V_Warning) and + (Status.CountWarnings <> 0) then + Message1 (general_i_number_of_warnings, tostr (Status.CountWarnings)); + if (Status.Verbosity and V_Hint = V_Hint) and + (Status.CountHints <> 0) then + Message1 (general_i_number_of_hints, tostr (Status.CountHints)); + if (Status.Verbosity and V_Note = V_Note) and + (Status.CountNotes <> 0) then + Message1 (general_i_number_of_notes, tostr (Status.CountNotes)); + end; + finally + { no message possible after this !! } + DoneCompiler; + + SetExceptionMask(ExceptionMask); + end; + DoneVerbose; + 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 EOutOfMemory do + begin + try + Message(general_f_no_memory_left); + except + on ECompilerAbort do + ; + end; + DoneVerbose; + end; + on e : EInOutError do + begin + try + Message1(general_f_ioerror,e.message); + except + on ECompilerAbort do + ; + end; + DoneVerbose; + end; + on e : EOSError do + begin + try + Message1(general_f_oserror,e.message); + except + on ECompilerAbort do + ; + end; + 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. diff --git a/closures/compiler/compinnr.inc b/closures/compiler/compinnr.inc new file mode 100644 index 0000000000..ae13aea213 --- /dev/null +++ b/closures/compiler/compinnr.inc @@ -0,0 +1,128 @@ +{ + 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; + in_unaligned_x = 54; + in_get_frame = 56; + in_get_caller_addr = 57; + in_get_caller_frame = 58; + in_pack_x_y_z = 59; + in_unpack_x_y_z = 60; + in_bitsizeof_x = 61; + in_writestr_x = 62; + in_readstr_x = 63; + in_abs_long = 64; + in_ror_x = 65; + in_ror_x_y = 66; + in_rol_x = 67; + in_rol_x_y = 68; + in_objc_selector_x = 69; + in_objc_protocol_x = 70; + in_objc_encode_x = 71; + in_sar_x_y = 72; + in_sar_x = 73; + in_bsf_x = 74; + in_bsr_x = 75; + +{ 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 } + diff --git a/closures/compiler/comprsrc.pas b/closures/compiler/comprsrc.pas new file mode 100644 index 0000000000..8988263bf0 --- /dev/null +++ b/closures/compiler/comprsrc.pas @@ -0,0 +1,523 @@ +{ + Copyright (c) 1998-2008 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 + + uses + Systems, cstreams, Script; + +type + tresoutput = (roRES, roOBJ); + + tresourcefile = class(TAbstractResourceFile) + private + fname : ansistring; + protected + function SetupCompilerArguments(output: tresoutput; const OutName : + ansistring; respath: ansistring; out ObjUsed : boolean) : ansistring; virtual; + public + constructor Create(const fn : ansistring);override; + function Compile(output: tresoutput; const OutName: ansistring) : boolean; virtual; + procedure PostProcessResourcefile(const s : ansistring);virtual; + function IsCompiled(const fn : ansistring) : boolean;virtual; + procedure Collect(const fn : ansistring);virtual; + procedure EndCollect; virtual; + end; + + TWinLikeResourceFile = class(tresourcefile) + private + fResScript : TScript; + fScriptName : ansistring; + fCollectCount : integer; + protected + function SetupCompilerArguments(output: tresoutput; const OutName : + ansistring; respath: ansistring; out ObjUsed : boolean) : ansistring; override; + public + constructor Create(const fn : ansistring);override; + destructor Destroy; override; + function Compile(output: tresoutput; const OutName: ansistring) : boolean; override; + function IsCompiled(const fn : ansistring) : boolean;override; + procedure Collect(const fn : ansistring);override; + procedure EndCollect; override; + end; + +procedure CompileResourceFiles; +procedure CollectResourceFiles; + +Var + ResCompiler : String; + RCCompiler : String; + +implementation + +uses + SysUtils, + cutils,cfileutl,cclasses, + Globtype,Globals,Verbose,Fmodule, comphook,cpuinfo; + +{**************************************************************************** + TRESOURCEFILE +****************************************************************************} + +constructor tresourcefile.create(const fn : ansistring); +begin + fname:=fn; +end; + + +procedure tresourcefile.PostProcessResourcefile(const s : ansistring); +begin +end; + + +function tresourcefile.IsCompiled(const fn: ansistring): boolean; +begin + Result:=CompareText(ExtractFileExt(fn), target_info.resobjext) = 0; +end; + +procedure tresourcefile.Collect(const fn: ansistring); +begin + if fn='' then + exit; + fname:=fn; + Compile(roOBJ, ChangeFileExt(fn, target_info.resobjext)); +end; + +procedure tresourcefile.EndCollect; +begin + +end; + +function tresourcefile.SetupCompilerArguments(output: tresoutput; const OutName + : ansistring; respath: ansistring; out ObjUsed : boolean) : ansistring; +var + s : TCmdStr; +begin + if output=roRES then + begin + s:=target_res.rccmd; + Replace(s,'$RES',maybequoted(OutName)); + Replace(s,'$RC',maybequoted(fname)); + ObjUsed:=False; + end + else + begin + s:=target_res.rescmd; + ObjUsed:=(pos('$OBJ',s)>0); + Replace(s,'$OBJ',maybequoted(OutName)); + Replace(s,'$RES',maybequoted(fname)); + end; + Result:=s; +end; + +function tresourcefile.compile(output: tresoutput; const OutName: ansistring) + : boolean; + + Function SelectBin(Const Bin1,Bin2 : String) : String; + begin + If (Bin1<>'') then + SelectBin:=Bin1 + else + SelectBin:=Bin2; + end; + +var + respath, + s, + bin, + resbin : TCmdStr; + resfound, + objused : boolean; +begin + Result:=true; + if output=roRES then + Bin:=SelectBin(RCCompiler,target_res.rcbin) + else + Bin:=SelectBin(ResCompiler,target_res.resbin); + if bin='' then + begin + Result:=false; + exit; + end; + resfound:=false; + if utilsdirectory<>'' then + resfound:=FindFile(utilsprefix+bin+source_info.exeext,utilsdirectory,false,resbin); + if not resfound then + begin + resfound:=FindExe(utilsprefix+bin,false,resbin); + if not resfound and (utilsprefix<>'') and ( (output=roRES) or (Pos('$ARCH', target_res.rescmd)<>0) ) then + { Search for resource compiler without utilsprefix, if RC->RES compiler is called } + { or RES->OBJ compiler supports different architectures. } + resfound:=FindExe(bin,false,resbin); + end; + { get also the path to be searched for the windres.h } + respath:=ExtractFilePath(resbin); + if (not resfound) and not(cs_link_nolink in current_settings.globalswitches) then + begin + Message1(exec_e_res_not_found, utilsprefix+bin+source_info.exeext); + current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink]; + Result:=false; + end; + s:=SetupCompilerArguments(output,OutName,respath,objused); +{ Execute the command } +{ Always try to compile resources. but don't complain if cs_link_nolink } + if resfound then + begin + Message1(exec_i_compilingresource,fname); + Message2(exec_d_resbin_params,resbin,s); + FlushOutput; + try + if ExecuteProcess(resbin,s) <> 0 then + begin + if not (cs_link_nolink in current_settings.globalswitches) then + Message(exec_e_error_while_compiling_resources); + current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink]; + Result:=false; + end; + except + on E:EOSError do + begin + if not (cs_link_nolink in current_settings.globalswitches) then + Message1(exec_e_cant_call_resource_compiler, resbin); + current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink]; + Result:=false; + end + end; + end; + { Update asmres when externmode is set and resource compiling failed } + if (not Result) and (cs_link_nolink in current_settings.globalswitches) then + AsmRes.AddLinkCommand(resbin,s,OutName); + if Result and (output=roOBJ) and ObjUsed then + current_module.linkunitofiles.add(OutName,link_always); +end; + +constructor TWinLikeResourceFile.Create(const fn : ansistring); +begin + inherited Create(fn); + fResScript:=nil; + fCollectCount:=0; + if (tf_use_8_3 in target_info.flags) then + fScriptName:=ChangeFileExt(fn,'.rls') + else + fScriptName:=ChangeFileExt(fn,'.reslst'); +end; + +destructor TWinLikeResourceFile.Destroy; +begin + if fResScript<>nil then + fResScript.Free; + inherited; +end; + +function TWinLikeResourceFile.SetupCompilerArguments(output: tresoutput; const + OutName : ansistring; respath : ansistring; out ObjUsed : boolean) : ansistring; +var + srcfilepath, + preprocessorbin, + s : TCmdStr; + arch, + subarch: ansistring; + + function WindresFileName(filename: TCmdStr): TCmdStr; + // to be on the safe side, for files that are passed to the preprocessor, + // only give short file names with forward slashes to windres + var + i: longint; + begin + Result := GetShortName(filename); + for I:=1 to Length(Result) do + if Result[I] in AllowDirectorySeparators then + Result[i]:='/'; + end; + +begin + srcfilepath:=ExtractFilePath(current_module.mainsource^); + if output=roRES then + begin + s:=target_res.rccmd; + if target_res.rcbin = 'windres' then + Replace(s,'$RC',WindresFileName(fname)) + else + Replace(s,'$RC',maybequoted(fname)); + Replace(s,'$RES',maybequoted(OutName)); + ObjUsed:=False; + end + else + begin + s:=target_res.rescmd; + if (res_external_file in target_res.resflags) then + ObjUsed:=false + else + ObjUsed:=(pos('$OBJ',s)>0); + Replace(s,'$OBJ',maybequoted(OutName)); + subarch:='all'; + arch:=cpu2str[target_cpu]; + if (source_info.cpu=systems.cpu_arm) then + begin + //Differentiate between arm and armeb + if (source_info.endian=endian_big) then + arch:=arch+'eb'; + end; + Replace(s,'$ARCH',arch); + if target_info.system=system_arm_darwin then + subarch:=lower(cputypestr[current_settings.cputype]); + Replace(s,'$SUBARCH',subarch); + case target_info.endian of + endian_little : Replace(s,'$ENDIAN','littleendian'); + endian_big : Replace(s,'$ENDIAN','bigendian'); + end; + //call resource compiler with debug switch + if (status.verbosity and V_Debug)<>0 then + Replace(s,'$DBG','-v') + else + Replace(s,'$DBG',''); + if fCollectCount=0 then + s:=s+' '+maybequoted(fname) + else + s:=s+' '+maybequoted('@'+fScriptName); + end; + { windres doesn't like empty include paths } + if respath='' then + respath:='.'; + Replace(s,'$INC',maybequoted(respath)); + if (output=roRes) and (target_res.rcbin='windres') then + begin + { try to find a preprocessor } + preprocessorbin := respath+'cpp'+source_info.exeext; + if FileExists(preprocessorbin,true) then + s:='--preprocessor='+preprocessorbin+' '+s; + if (srcfilepath<>'') then + s:='--include '+WindresFileName(srcfilepath)+' '+s; + end; + Result:=s; +end; + +function TWinLikeResourceFile.compile(output: tresoutput; + const OutName: ansistring) : boolean; +begin + Result:=inherited compile(output,OutName); + //delete fpc-res.lst file if things went well + if Result and (output=roOBJ) then + DeleteFile(fScriptName); +end; + +function TWinLikeResourceFile.IsCompiled(const fn: ansistring): boolean; +const + ResSignature : array [1..32] of byte = + ($00,$00,$00,$00,$20,$00,$00,$00,$FF,$FF,$00,$00,$FF,$FF,$00,$00, + $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00); + knownexts : array[1..4] of string[4] = ('.lfm', '.dfm', '.xfm', '.tlb'); +var + f : file; + oldfmode : byte; + buf: array[1..32] of byte; + i: longint; + ext : shortstring; +begin + ext:=lower(ExtractFileExt(fn)); + Result:=CompareText(ext, target_info.resext) = 0; + if not Result then + for i:=1 to high(knownexts) do + begin + Result:=CompareText(ext, knownexts[i]) = 0; + if Result then break; + end; + + if Result or not FileExists(fn, False) then exit; + oldfmode:=Filemode; + Filemode:=0; + assign(f,fn); + reset(f,1); + BlockRead(f, buf, SizeOf(buf), i); + close(f); + Filemode:=oldfmode; + + if i<>SizeOf(buf) then + exit; + + for i:=1 to 32 do + if buf[i]<>ResSignature[i] then + exit; + + Result:=True; +end; + +procedure TWinLikeResourceFile.Collect(const fn: ansistring); +begin + if fResScript=nil then + fResScript:=TScript.Create(fScriptName); + fResScript.Add(MaybeQuoted(fn)); + inc(fCollectCount); +end; + +procedure TWinLikeResourceFile.EndCollect; +begin + if fResScript<>nil then + begin + fResScript.WriteToDisk; + FreeAndNil(fResScript); + Compile(roOBJ,ChangeFileExt(fname,target_info.resobjext)); + end; +end; + + +function CopyResFile(inf,outf : TCmdStr) : boolean; +var + src,dst : TCCustomFileStream; +begin + { Copy .res file to units output dir. } + Result:=false; + src:=CFileStreamClass.Create(inf,fmOpenRead or fmShareDenyNone); + if CStreamError<>0 then + begin + Message1(exec_e_cant_open_resource_file, src.FileName); + Include(current_settings.globalswitches, cs_link_nolink); + exit; + end; + dst:=CFileStreamClass.Create(current_module.outputpath^+outf,fmCreate); + if CStreamError<>0 then + begin + Message1(exec_e_cant_write_resource_file, dst.FileName); + Include(current_settings.globalswitches, cs_link_nolink); + exit; + end; + dst.CopyFrom(src,src.Size); + dst.Free; + src.Free; + Result:=true; +end; + +procedure CompileResourceFiles; +var + resourcefile : tresourcefile; + res: TCmdStrListItem; + p,s : TCmdStr; + outfmt : tresoutput; +begin + { Don't do anything for systems supporting resources without using resource + file classes (e.g. Mac OS). They process resources elsewhere. } + if (target_info.res<>res_none) and (target_res.resourcefileclass=nil) then + exit; + + p:=ExtractFilePath(ExpandFileName(current_module.mainsource^)); + res:=TCmdStrListItem(current_module.ResourceFiles.First); + while res<>nil do + begin + if target_info.res=res_none then + Message(scan_e_resourcefiles_not_supported); + s:=res.FPStr; + if not path_absolute(s) then + s:=p+s; + if not FileExists(s, True) then + begin + Message1(exec_e_cant_open_resource_file, s); + Include(current_settings.globalswitches, cs_link_nolink); + exit; + end; + resourcefile:=TResourceFile(resinfos[target_info.res]^.resourcefileclass.create(s)); + if resourcefile.IsCompiled(s) then + begin + resourcefile.free; + if AnsiCompareFileName(IncludeTrailingPathDelimiter(ExpandFileName(current_module.outputpath^)), p) <> 0 then + begin + { Copy .res file to units output dir. Otherwise .res file will not be found + when only compiled units path is available } + res.FPStr:=ExtractFileName(res.FPStr); //store file name only in PPU. + if not CopyResFile(s,res.FPStr) then exit; + end; + end + else + begin + res.FPStr:=ExtractFileName(res.FPStr); + if (target_res.rcbin='') and (RCCompiler='') then + begin + { if target does not have .rc to .res compiler, create obj } + outfmt:=roOBJ; + res.FPStr:=ChangeFileExt(res.FPStr,target_info.resobjext); + end + else + begin + outfmt:=roRES; + res.FPStr:=ChangeFileExt(res.FPStr,target_info.resext); + end; + resourcefile.compile(outfmt, current_module.outputpath^+res.FPStr); + resourcefile.free; + end; + res:=TCmdStrListItem(res.Next); + end; +end; + + +procedure CollectResourceFiles; +var + resourcefile : tresourcefile; + + procedure ProcessModule(u : tmodule); + var + res : TCmdStrListItem; + s : TCmdStr; + begin + res:=TCmdStrListItem(u.ResourceFiles.First); + while assigned(res) do + begin + if path_absolute(res.FPStr) then + s:=res.FPStr + else + begin + s:=u.path^+res.FPStr; + if not FileExists(s,True) then + s:=u.outputpath^+res.FPStr; + end; + resourcefile.Collect(s); + res:=TCmdStrListItem(res.Next); + end; + end; + +var + hp : tused_unit; + s : TCmdStr; +begin + if (target_info.res=res_none) or ((target_res.resbin='') + and (ResCompiler='')) then + exit; +// if cs_link_nolink in current_settings.globalswitches then +// exit; + s:=ChangeFileExt(current_module.ppufilename^,target_info.resobjext); + if (res_arch_in_file_name in target_res.resflags) then + s:=ChangeFileExt(s,'.'+cpu2str[target_cpu]+target_info.resobjext); + resourcefile:=TResourceFile(resinfos[target_info.res]^.resourcefileclass.create(s)); + hp:=tused_unit(usedunits.first); + while assigned(hp) do + begin + ProcessModule(hp.u); + hp:=tused_unit(hp.next); + end; + ProcessModule(current_module); + { Finish collection } + resourcefile.EndCollect; + resourcefile.free; +end; + +end. diff --git a/closures/compiler/constexp.pas b/closures/compiler/constexp.pas new file mode 100644 index 0000000000..95ddd7a28a --- /dev/null +++ b/closures/compiler/constexp.pas @@ -0,0 +1,585 @@ +{ + Copyright (c) 2007 by Daniel Mantione + + This unit implements a Tconstexprint type. This type simulates an integer + type that can handle numbers from low(int64) to high(qword) calculations. + + 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 constexp; + +{$i fpcdefs.inc} + +interface + +{ bootstrapping with 2.0.x } +{$ifdef VER2_0} + {$Q-} + {$R-} +{$endif} + + +type Tconstexprint=record + overflow:boolean; + case signed:boolean of + false: + (uvalue:qword); + true: + (svalue:int64); + end; + + Tconststring = type pchar; + + errorproc=procedure (i:longint); + +{"Uses verbose" gives a dependency on cpuinfo through globals. This leads + build trouble when compiling the directory utils, since the cpu directory + isn't searched there. Therefore we use a procvar and make verbose install + the errorhandler. A dependency from verbose on this unit is no problem.} +var internalerror:errorproc; + +{Same issue, avoid dependency on cpuinfo because the cpu directory isn't + searched during utils building.} +{$ifdef GENERIC_CPU} +type bestreal=extended; +{$else} +{$ifdef x86} +type bestreal=extended; +{$else} +type bestreal=double; +{$endif} +{$endif} + +operator := (const u:qword):Tconstexprint;inline; +operator := (const s:int64):Tconstexprint;inline; +operator := (const c:Tconstexprint):qword; +operator := (const c:Tconstexprint):int64; +operator := (const c:Tconstexprint):bestreal; + +operator + (const a,b:Tconstexprint):Tconstexprint; +operator - (const a,b:Tconstexprint):Tconstexprint; +operator - (const a:Tconstexprint):Tconstexprint; +operator * (const a,b:Tconstexprint):Tconstexprint; +operator div (const a,b:Tconstexprint):Tconstexprint; +operator mod (const a,b:Tconstexprint):Tconstexprint; +operator / (const a,b:Tconstexprint):bestreal; + +operator = (const a,b:Tconstexprint):boolean; +operator > (const a,b:Tconstexprint):boolean; +operator >= (const a,b:Tconstexprint):boolean; +operator < (const a,b:Tconstexprint):boolean; +operator <= (const a,b:Tconstexprint):boolean; + +operator and (const a,b:Tconstexprint):Tconstexprint; +operator or (const a,b:Tconstexprint):Tconstexprint; +operator xor (const a,b:Tconstexprint):Tconstexprint; +operator shl (const a,b:Tconstexprint):Tconstexprint; +operator shr (const a,b:Tconstexprint):Tconstexprint; + +function tostr(const i:Tconstexprint):shortstring;overload; + +{****************************************************************************} +implementation +{****************************************************************************} + + + +operator := (const u:qword):Tconstexprint; + +begin + result.overflow:=false; + result.signed:=false; + result.uvalue:=u; +end; + +operator := (const s:int64):Tconstexprint; + +begin + result.overflow:=false; + result.signed:=true; + result.svalue:=s; +end; + +operator := (const c:Tconstexprint):qword; + +begin + if c.overflow then + internalerror(200706091) + else if not c.signed then + result:=c.uvalue + else if c.svalue<0 then + internalerror(200706092) + else + result:=qword(c.svalue); +end; + +operator := (const c:Tconstexprint):int64; + +begin + if c.overflow then + internalerror(200706093) + else if c.signed then + result:=c.svalue + else if c.uvalue>qword(high(int64)) then + internalerror(200706094) + else + result:=int64(c.uvalue); +end; + +operator := (const c:Tconstexprint):bestreal; + +begin + if c.overflow then + internalerror(200706095) + else if c.signed then + result:=c.svalue + else + result:=c.uvalue; +end; + +function add_to(const a:Tconstexprint;b:qword):Tconstexprint; + +var sspace,uspace:qword; + +label try_qword; + +begin + result.overflow:=false; + + {Try if the result fits in an int64.} + if (a.signed) and (a.svalue<0) then + {$push}{$Q-} + sspace:=qword(high(int64))+qword(-a.svalue) + {$pop} + else if not a.signed and (a.uvalue>qword(high(int64))) then + goto try_qword + else + sspace:=qword(high(int64))-a.svalue; + + if sspace>=b then + begin + result.signed:=true; + {$push} {$Q-} + result.svalue:=a.svalue+int64(b); + {$pop} + exit; + end; + + {Try if the result fits in a qword.} +try_qword: + if (a.signed) and (a.svalue<0) then + uspace:=high(qword)-qword(-a.svalue) +{ else if not a.signed and (a.uvalue>qword(high(int64))) then + uspace:=high(qword)-a.uvalue} + else + uspace:=high(qword)-a.uvalue; + if uspace>=b then + begin + result.signed:=false; + {$push} {$Q-} + result.uvalue:=a.uvalue+b; + {$pop} + exit; + end; + result.overflow:=true; +end; + +function sub_from(const a:Tconstexprint;b:qword):Tconstexprint; + +const abs_low_int64=qword(9223372036854775808); {abs(low(int64)) -> overflow error} + +var sspace:qword; + +label try_qword,ov; + +begin + result.overflow:=false; + + {Try if the result fits in an int64.} + if (a.signed) and (a.svalue<0) then + {$push} {$Q-} + sspace:=qword(a.svalue)+abs_low_int64 + {$pop} + else if not a.signed and (a.uvalue>qword(high(int64))) then + goto try_qword + else + sspace:=a.uvalue+qword(abs(low(int64))); + if sspace>=b then + begin + result.signed:=true; + {$push} {$Q-} + result.svalue:=a.svalue-int64(b); + {$pop} + exit; + end; + + {Try if the result fits in a qword.} +try_qword: + if not(a.signed and (a.svalue<0)) and (a.uvalue>=b) then + begin + result.signed:=false; + {$push} {$Q-} + result.uvalue:=a.uvalue-b; + {$pop} + exit; + end; +ov: + result.overflow:=true; +end; + +operator + (const a,b:Tconstexprint):Tconstexprint; + +begin + if a.overflow or b.overflow then + begin + result.overflow:=true; + exit; + end; + if b.signed and (b.svalue<0) then + {$push} {$Q-} + result:=sub_from(a,qword(-b.svalue)) + {$pop} + else + result:=add_to(a,b.uvalue); +end; + +operator - (const a,b:Tconstexprint):Tconstexprint; + +begin + if a.overflow or b.overflow then + begin + result.overflow:=true; + exit; + end; + if b.signed and (b.svalue<0) then + {$push} {$Q-} + result:=add_to(a,qword(-b.svalue)) + {$pop} + else + result:=sub_from(a,b.uvalue); +end; + +operator - (const a:Tconstexprint):Tconstexprint; + +begin + if not a.signed and (a.uvalue>qword(high(int64))) then + result.overflow:=true + else + begin + result.overflow:=false; + result.signed:=true; + result.svalue:=-a.svalue; + end; +end; + + +operator * (const a,b:Tconstexprint):Tconstexprint; + +var aa,bb,r:qword; + sa,sb:boolean; + +begin + if a.overflow or b.overflow then + begin + result.overflow:=true; + exit; + end; + result.overflow:=false; + sa:=a.signed and (a.svalue<0); + if sa then + aa:=qword(-a.svalue) + else + aa:=a.uvalue; + sb:=b.signed and (b.svalue<0); + if sb then + bb:=qword(-b.svalue) + else + bb:=b.uvalue; + + if (bb<>0) and (high(qword) div bb<aa) then + result.overflow:=true + else + begin + r:=aa*bb; + if sa xor sb then + begin + result.signed:=true; + if r>qword(high(int64)) then + result.overflow:=true + else + result.svalue:=-int64(r); + end + else + begin + result.signed:=false; + result.uvalue:=r; + end; + end; +end; + +operator div (const a,b:Tconstexprint):Tconstexprint; + +var aa,bb,r:qword; + sa,sb:boolean; + +begin + if a.overflow or b.overflow then + begin + result.overflow:=true; + exit; + end; + result.overflow:=false; + sa:=a.signed and (a.svalue<0); + if sa then + {$push} {$Q-} + aa:=qword(-a.svalue) + {$pop} + else + aa:=a.uvalue; + sb:=b.signed and (b.svalue<0); + if sb then + {$push} {$Q-} + bb:=qword(-b.svalue) + {$pop} + else + bb:=b.uvalue; + + if bb=0 then + result.overflow:=true + else + begin + r:=aa div bb; + if sa xor sb then + begin + result.signed:=true; + if r>qword(high(int64)) then + result.overflow:=true + else + result.svalue:=-int64(r); + end + else + begin + result.signed:=false; + result.uvalue:=r; + end; + end; +end; + +operator mod (const a,b:Tconstexprint):Tconstexprint; + +var aa,bb,r:qword; + sa,sb:boolean; + +begin + if a.overflow or b.overflow then + begin + result.overflow:=true; + exit; + end; + result.overflow:=false; + sa:=a.signed and (a.svalue<0); + if sa then + {$push} {$Q-} + aa:=qword(-a.svalue) + {$pop} + else + aa:=a.uvalue; + sb:=b.signed and (b.svalue<0); + if sb then + {$push} {$Q-} + bb:=qword(-b.svalue) + {$pop} + else + bb:=b.uvalue; + if bb=0 then + result.overflow:=true + else + begin + { the sign of a modulo operation only depends on the sign of the + dividend } + r:=aa mod bb; + result.signed:=sa; + if not sa then + result.uvalue:=r + else + result.svalue:=-int64(r); + end; +end; + +operator / (const a,b:Tconstexprint):bestreal; + +var aa,bb:bestreal; + +begin + if a.overflow or b.overflow then + internalerror(200706096); + if a.signed then + aa:=a.svalue + else + aa:=a.uvalue; + if b.signed then + bb:=b.svalue + else + bb:=b.uvalue; + result:=aa/bb; +end; + +operator = (const a,b:Tconstexprint):boolean; + +begin + if a.signed and (a.svalue<0) then + if b.signed and (b.svalue<0) then + result:=a.svalue=b.svalue + else if b.uvalue>qword(high(int64)) then + result:=false + else + result:=a.svalue=b.svalue + else + if not (b.signed and (b.svalue<0)) then + result:=a.uvalue=b.uvalue + else if a.uvalue>qword(high(int64)) then + result:=false + else + result:=a.svalue=b.svalue +end; + +operator > (const a,b:Tconstexprint):boolean; + +begin + if a.signed and (a.svalue<0) then + if b.signed and (b.svalue<0) then + result:=a.svalue>b.svalue + else if b.uvalue>qword(high(int64)) then + result:=false + else + result:=a.svalue>b.svalue + else + if not (b.signed and (b.svalue<0)) then + result:=a.uvalue>b.uvalue + else if a.uvalue>qword(high(int64)) then + result:=true + else + result:=a.svalue>b.svalue +end; + +operator >= (const a,b:Tconstexprint):boolean; + +begin + if a.signed and (a.svalue<0) then + if b.signed and (b.svalue<0) then + result:=a.svalue>=b.svalue + else if b.uvalue>qword(high(int64)) then + result:=false + else + result:=a.svalue>=b.svalue + else + if not (b.signed and (b.svalue<0)) then + result:=a.uvalue>=b.uvalue + else if a.uvalue>qword(high(int64)) then + result:=true + else + result:=a.svalue>=b.svalue +end; + +operator < (const a,b:Tconstexprint):boolean; + +begin + if a.signed and (a.svalue<0) then + if b.signed and (b.svalue<0) then + result:=a.svalue<b.svalue + else if b.uvalue>qword(high(int64)) then + result:=true + else + result:=a.svalue<b.svalue + else + if not (b.signed and (b.svalue<0)) then + result:=a.uvalue<b.uvalue + else if a.uvalue>qword(high(int64)) then + result:=false + else + result:=a.svalue<b.svalue +end; + +operator <= (const a,b:Tconstexprint):boolean; + +begin + if a.signed and (a.svalue<0) then + if b.signed and (b.svalue<0) then + result:=a.svalue<=b.svalue + else if b.uvalue>qword(high(int64)) then + result:=true + else + result:=a.svalue<=b.svalue + else + if not (b.signed and (b.svalue<0)) then + result:=a.uvalue<=b.uvalue + else if a.uvalue>qword(high(int64)) then + result:=false + else + result:=a.svalue<=b.svalue +end; + +operator and (const a,b:Tconstexprint):Tconstexprint; + +begin + result.overflow:=false; + result.signed:=a.signed or b.signed; + result.uvalue:=a.uvalue and b.uvalue; +end; + +operator or (const a,b:Tconstexprint):Tconstexprint; + +begin + result.overflow:=false; + result.signed:=a.signed or b.signed; + result.uvalue:=a.uvalue or b.uvalue; +end; + +operator xor (const a,b:Tconstexprint):Tconstexprint; + +begin + result.overflow:=false; + result.signed:=a.signed or b.signed; + result.uvalue:=a.uvalue xor b.uvalue; +end; + +operator shl (const a,b:Tconstexprint):Tconstexprint; + +begin + result.overflow:=false; + result.signed:=a.signed; + result.uvalue:=a.uvalue shl b.uvalue; +end; + +operator shr (const a,b:Tconstexprint):Tconstexprint; + +begin + result.overflow:=false; + result.signed:=a.signed; + result.uvalue:=a.uvalue shr b.uvalue; +end; + +function tostr(const i:Tconstexprint):shortstring;overload; + +begin + if i.signed then + str(i.svalue,result) + else + str(i.uvalue,result); +end; + +end. diff --git a/closures/compiler/cp1251.pas b/closures/compiler/cp1251.pas new file mode 100644 index 0000000000..c13a667956 --- /dev/null +++ b/closures/compiler/cp1251.pas @@ -0,0 +1,282 @@ +{ This is an automatically created file, so don't edit it } +unit cp1251; + + interface + + implementation + + uses + {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif}; + + 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 : 1026; flag : umf_noinfo; reserved : 0), + (unicode : 1027; flag : umf_noinfo; reserved : 0), + (unicode : 8218; flag : umf_noinfo; reserved : 0), + (unicode : 1107; flag : umf_noinfo; reserved : 0), + (unicode : 8222; flag : umf_noinfo; reserved : 0), + (unicode : 8230; flag : umf_noinfo; reserved : 0), + (unicode : 8224; flag : umf_noinfo; reserved : 0), + (unicode : 8225; flag : umf_noinfo; reserved : 0), + (unicode : 8364; flag : umf_noinfo; reserved : 0), + (unicode : 8240; flag : umf_noinfo; reserved : 0), + (unicode : 1033; flag : umf_noinfo; reserved : 0), + (unicode : 8249; flag : umf_noinfo; reserved : 0), + (unicode : 1034; flag : umf_noinfo; reserved : 0), + (unicode : 1036; flag : umf_noinfo; reserved : 0), + (unicode : 1035; flag : umf_noinfo; reserved : 0), + (unicode : 1039; flag : umf_noinfo; reserved : 0), + (unicode : 1106; flag : umf_noinfo; reserved : 0), + (unicode : 8216; flag : umf_noinfo; reserved : 0), + (unicode : 8217; flag : umf_noinfo; reserved : 0), + (unicode : 8220; flag : umf_noinfo; reserved : 0), + (unicode : 8221; flag : umf_noinfo; reserved : 0), + (unicode : 8226; flag : umf_noinfo; reserved : 0), + (unicode : 8211; flag : umf_noinfo; reserved : 0), + (unicode : 8212; flag : umf_noinfo; reserved : 0), + (unicode : 65535; flag : umf_unused; reserved : 0), + (unicode : 8482; flag : umf_noinfo; reserved : 0), + (unicode : 1113; flag : umf_noinfo; reserved : 0), + (unicode : 8250; flag : umf_noinfo; reserved : 0), + (unicode : 1114; flag : umf_noinfo; reserved : 0), + (unicode : 1116; flag : umf_noinfo; reserved : 0), + (unicode : 1115; flag : umf_noinfo; reserved : 0), + (unicode : 1119; flag : umf_noinfo; reserved : 0), + (unicode : 160; flag : umf_noinfo; reserved : 0), + (unicode : 1038; flag : umf_noinfo; reserved : 0), + (unicode : 1118; flag : umf_noinfo; reserved : 0), + (unicode : 1032; flag : umf_noinfo; reserved : 0), + (unicode : 164; flag : umf_noinfo; reserved : 0), + (unicode : 1168; flag : umf_noinfo; reserved : 0), + (unicode : 166; flag : umf_noinfo; reserved : 0), + (unicode : 167; flag : umf_noinfo; reserved : 0), + (unicode : 1025; flag : umf_noinfo; reserved : 0), + (unicode : 169; flag : umf_noinfo; reserved : 0), + (unicode : 1028; 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 : 1031; flag : umf_noinfo; reserved : 0), + (unicode : 176; flag : umf_noinfo; reserved : 0), + (unicode : 177; flag : umf_noinfo; reserved : 0), + (unicode : 1030; flag : umf_noinfo; reserved : 0), + (unicode : 1110; flag : umf_noinfo; reserved : 0), + (unicode : 1169; 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 : 1105; flag : umf_noinfo; reserved : 0), + (unicode : 8470; flag : umf_noinfo; reserved : 0), + (unicode : 1108; flag : umf_noinfo; reserved : 0), + (unicode : 187; flag : umf_noinfo; reserved : 0), + (unicode : 1112; flag : umf_noinfo; reserved : 0), + (unicode : 1029; flag : umf_noinfo; reserved : 0), + (unicode : 1109; flag : umf_noinfo; reserved : 0), + (unicode : 1111; flag : umf_noinfo; reserved : 0), + (unicode : 1040; flag : umf_noinfo; reserved : 0), + (unicode : 1041; flag : umf_noinfo; reserved : 0), + (unicode : 1042; flag : umf_noinfo; reserved : 0), + (unicode : 1043; flag : umf_noinfo; reserved : 0), + (unicode : 1044; flag : umf_noinfo; reserved : 0), + (unicode : 1045; flag : umf_noinfo; reserved : 0), + (unicode : 1046; flag : umf_noinfo; reserved : 0), + (unicode : 1047; flag : umf_noinfo; reserved : 0), + (unicode : 1048; flag : umf_noinfo; reserved : 0), + (unicode : 1049; flag : umf_noinfo; reserved : 0), + (unicode : 1050; flag : umf_noinfo; reserved : 0), + (unicode : 1051; flag : umf_noinfo; reserved : 0), + (unicode : 1052; flag : umf_noinfo; reserved : 0), + (unicode : 1053; flag : umf_noinfo; reserved : 0), + (unicode : 1054; flag : umf_noinfo; reserved : 0), + (unicode : 1055; flag : umf_noinfo; reserved : 0), + (unicode : 1056; flag : umf_noinfo; reserved : 0), + (unicode : 1057; flag : umf_noinfo; reserved : 0), + (unicode : 1058; flag : umf_noinfo; reserved : 0), + (unicode : 1059; flag : umf_noinfo; reserved : 0), + (unicode : 1060; flag : umf_noinfo; reserved : 0), + (unicode : 1061; flag : umf_noinfo; reserved : 0), + (unicode : 1062; flag : umf_noinfo; reserved : 0), + (unicode : 1063; flag : umf_noinfo; reserved : 0), + (unicode : 1064; flag : umf_noinfo; reserved : 0), + (unicode : 1065; flag : umf_noinfo; reserved : 0), + (unicode : 1066; flag : umf_noinfo; reserved : 0), + (unicode : 1067; flag : umf_noinfo; reserved : 0), + (unicode : 1068; flag : umf_noinfo; reserved : 0), + (unicode : 1069; flag : umf_noinfo; reserved : 0), + (unicode : 1070; flag : umf_noinfo; reserved : 0), + (unicode : 1071; flag : umf_noinfo; reserved : 0), + (unicode : 1072; flag : umf_noinfo; reserved : 0), + (unicode : 1073; flag : umf_noinfo; reserved : 0), + (unicode : 1074; flag : umf_noinfo; reserved : 0), + (unicode : 1075; flag : umf_noinfo; reserved : 0), + (unicode : 1076; flag : umf_noinfo; reserved : 0), + (unicode : 1077; flag : umf_noinfo; reserved : 0), + (unicode : 1078; flag : umf_noinfo; reserved : 0), + (unicode : 1079; flag : umf_noinfo; reserved : 0), + (unicode : 1080; flag : umf_noinfo; reserved : 0), + (unicode : 1081; flag : umf_noinfo; reserved : 0), + (unicode : 1082; flag : umf_noinfo; reserved : 0), + (unicode : 1083; flag : umf_noinfo; reserved : 0), + (unicode : 1084; flag : umf_noinfo; reserved : 0), + (unicode : 1085; flag : umf_noinfo; reserved : 0), + (unicode : 1086; flag : umf_noinfo; reserved : 0), + (unicode : 1087; flag : umf_noinfo; reserved : 0), + (unicode : 1088; flag : umf_noinfo; reserved : 0), + (unicode : 1089; flag : umf_noinfo; reserved : 0), + (unicode : 1090; flag : umf_noinfo; reserved : 0), + (unicode : 1091; flag : umf_noinfo; reserved : 0), + (unicode : 1092; flag : umf_noinfo; reserved : 0), + (unicode : 1093; flag : umf_noinfo; reserved : 0), + (unicode : 1094; flag : umf_noinfo; reserved : 0), + (unicode : 1095; flag : umf_noinfo; reserved : 0), + (unicode : 1096; flag : umf_noinfo; reserved : 0), + (unicode : 1097; flag : umf_noinfo; reserved : 0), + (unicode : 1098; flag : umf_noinfo; reserved : 0), + (unicode : 1099; flag : umf_noinfo; reserved : 0), + (unicode : 1100; flag : umf_noinfo; reserved : 0), + (unicode : 1101; flag : umf_noinfo; reserved : 0), + (unicode : 1102; flag : umf_noinfo; reserved : 0), + (unicode : 1103; flag : umf_noinfo; reserved : 0) + ); + + unicodemap : tunicodemap = ( + cpname : 'cp1251'; + cp : 1251; + map : @map; + lastchar : 255; + next : nil; + internalmap : true + ); + + begin + registermapping(@unicodemap) + end. diff --git a/closures/compiler/cp1252.pp b/closures/compiler/cp1252.pp new file mode 100644 index 0000000000..dc538efc83 --- /dev/null +++ b/closures/compiler/cp1252.pp @@ -0,0 +1,282 @@ +{ This is an automatically created file, so don't edit it } +unit CP1252; + + interface + + implementation + + uses + {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif}; + + 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 : 8364; flag : umf_noinfo; reserved: 0), + (unicode : 65535; flag : umf_unused; reserved: 0), + (unicode : 8218; flag : umf_noinfo; reserved: 0), + (unicode : 402; flag : umf_noinfo; reserved: 0), + (unicode : 8222; flag : umf_noinfo; reserved: 0), + (unicode : 8230; flag : umf_noinfo; reserved: 0), + (unicode : 8224; flag : umf_noinfo; reserved: 0), + (unicode : 8225; flag : umf_noinfo; reserved: 0), + (unicode : 710; flag : umf_noinfo; reserved: 0), + (unicode : 8240; flag : umf_noinfo; reserved: 0), + (unicode : 352; flag : umf_noinfo; reserved: 0), + (unicode : 8249; flag : umf_noinfo; reserved: 0), + (unicode : 338; flag : umf_noinfo; reserved: 0), + (unicode : 65535; flag : umf_unused; reserved: 0), + (unicode : 381; flag : umf_noinfo; reserved: 0), + (unicode : 65535; flag : umf_unused; reserved: 0), + (unicode : 65535; flag : umf_unused; reserved: 0), + (unicode : 8216; flag : umf_noinfo; reserved: 0), + (unicode : 8217; flag : umf_noinfo; reserved: 0), + (unicode : 8220; flag : umf_noinfo; reserved: 0), + (unicode : 8221; flag : umf_noinfo; reserved: 0), + (unicode : 8226; flag : umf_noinfo; reserved: 0), + (unicode : 8211; flag : umf_noinfo; reserved: 0), + (unicode : 8212; flag : umf_noinfo; reserved: 0), + (unicode : 732; flag : umf_noinfo; reserved: 0), + (unicode : 8482; flag : umf_noinfo; reserved: 0), + (unicode : 353; flag : umf_noinfo; reserved: 0), + (unicode : 8250; flag : umf_noinfo; reserved: 0), + (unicode : 339; flag : umf_noinfo; reserved: 0), + (unicode : 65535; flag : umf_unused; reserved: 0), + (unicode : 382; flag : umf_noinfo; reserved: 0), + (unicode : 376; 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 : 'CP1252'; + cp : 1252; + map : @map; + lastchar : 255; + next : nil; + internalmap : true + ); + + begin + registermapping(@unicodemap) + end. diff --git a/closures/compiler/cp437.pas b/closures/compiler/cp437.pas new file mode 100644 index 0000000000..4776c5ef0e --- /dev/null +++ b/closures/compiler/cp437.pas @@ -0,0 +1,282 @@ +{ This is an automatically created file, so don't edit it } +unit cp437; + + interface + + implementation + + uses + {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif}; + + 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'; + cp : 437; + map : @map[0]; + lastchar : 255; + next : nil; + internalmap : true + ); + + begin + registermapping(@unicodemap) + end. diff --git a/closures/compiler/cp850.pas b/closures/compiler/cp850.pas new file mode 100644 index 0000000000..c624590d5f --- /dev/null +++ b/closures/compiler/cp850.pas @@ -0,0 +1,282 @@ +{ This is an automatically created file, so don't edit it } +unit cp850; + + interface + + implementation + + uses + {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif}; + + 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'; + cp : 850; + map : @map[0]; + lastchar : 255; + next : nil; + internalmap : true + ); + + begin + registermapping(@unicodemap) + end. diff --git a/closures/compiler/cp866.pas b/closures/compiler/cp866.pas new file mode 100644 index 0000000000..d36527aee7 --- /dev/null +++ b/closures/compiler/cp866.pas @@ -0,0 +1,282 @@ +{ This is an automatically created file, so don't edit it } +unit cp866; + + interface + + implementation + + uses + {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif}; + + 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 : 1040; flag : umf_noinfo; reserved : 0), + (unicode : 1041; flag : umf_noinfo; reserved : 0), + (unicode : 1042; flag : umf_noinfo; reserved : 0), + (unicode : 1043; flag : umf_noinfo; reserved : 0), + (unicode : 1044; flag : umf_noinfo; reserved : 0), + (unicode : 1045; flag : umf_noinfo; reserved : 0), + (unicode : 1046; flag : umf_noinfo; reserved : 0), + (unicode : 1047; flag : umf_noinfo; reserved : 0), + (unicode : 1048; flag : umf_noinfo; reserved : 0), + (unicode : 1049; flag : umf_noinfo; reserved : 0), + (unicode : 1050; flag : umf_noinfo; reserved : 0), + (unicode : 1051; flag : umf_noinfo; reserved : 0), + (unicode : 1052; flag : umf_noinfo; reserved : 0), + (unicode : 1053; flag : umf_noinfo; reserved : 0), + (unicode : 1054; flag : umf_noinfo; reserved : 0), + (unicode : 1055; flag : umf_noinfo; reserved : 0), + (unicode : 1056; flag : umf_noinfo; reserved : 0), + (unicode : 1057; flag : umf_noinfo; reserved : 0), + (unicode : 1058; flag : umf_noinfo; reserved : 0), + (unicode : 1059; flag : umf_noinfo; reserved : 0), + (unicode : 1060; flag : umf_noinfo; reserved : 0), + (unicode : 1061; flag : umf_noinfo; reserved : 0), + (unicode : 1062; flag : umf_noinfo; reserved : 0), + (unicode : 1063; flag : umf_noinfo; reserved : 0), + (unicode : 1064; flag : umf_noinfo; reserved : 0), + (unicode : 1065; flag : umf_noinfo; reserved : 0), + (unicode : 1066; flag : umf_noinfo; reserved : 0), + (unicode : 1067; flag : umf_noinfo; reserved : 0), + (unicode : 1068; flag : umf_noinfo; reserved : 0), + (unicode : 1069; flag : umf_noinfo; reserved : 0), + (unicode : 1070; flag : umf_noinfo; reserved : 0), + (unicode : 1071; flag : umf_noinfo; reserved : 0), + (unicode : 1072; flag : umf_noinfo; reserved : 0), + (unicode : 1073; flag : umf_noinfo; reserved : 0), + (unicode : 1074; flag : umf_noinfo; reserved : 0), + (unicode : 1075; flag : umf_noinfo; reserved : 0), + (unicode : 1076; flag : umf_noinfo; reserved : 0), + (unicode : 1077; flag : umf_noinfo; reserved : 0), + (unicode : 1078; flag : umf_noinfo; reserved : 0), + (unicode : 1079; flag : umf_noinfo; reserved : 0), + (unicode : 1080; flag : umf_noinfo; reserved : 0), + (unicode : 1081; flag : umf_noinfo; reserved : 0), + (unicode : 1082; flag : umf_noinfo; reserved : 0), + (unicode : 1083; flag : umf_noinfo; reserved : 0), + (unicode : 1084; flag : umf_noinfo; reserved : 0), + (unicode : 1085; flag : umf_noinfo; reserved : 0), + (unicode : 1086; flag : umf_noinfo; reserved : 0), + (unicode : 1087; 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 : 1088; flag : umf_noinfo; reserved : 0), + (unicode : 1089; flag : umf_noinfo; reserved : 0), + (unicode : 1090; flag : umf_noinfo; reserved : 0), + (unicode : 1091; flag : umf_noinfo; reserved : 0), + (unicode : 1092; flag : umf_noinfo; reserved : 0), + (unicode : 1093; flag : umf_noinfo; reserved : 0), + (unicode : 1094; flag : umf_noinfo; reserved : 0), + (unicode : 1095; flag : umf_noinfo; reserved : 0), + (unicode : 1096; flag : umf_noinfo; reserved : 0), + (unicode : 1097; flag : umf_noinfo; reserved : 0), + (unicode : 1098; flag : umf_noinfo; reserved : 0), + (unicode : 1099; flag : umf_noinfo; reserved : 0), + (unicode : 1100; flag : umf_noinfo; reserved : 0), + (unicode : 1101; flag : umf_noinfo; reserved : 0), + (unicode : 1102; flag : umf_noinfo; reserved : 0), + (unicode : 1103; flag : umf_noinfo; reserved : 0), + (unicode : 1025; flag : umf_noinfo; reserved : 0), + (unicode : 1105; flag : umf_noinfo; reserved : 0), + (unicode : 1028; flag : umf_noinfo; reserved : 0), + (unicode : 1108; flag : umf_noinfo; reserved : 0), + (unicode : 1031; flag : umf_noinfo; reserved : 0), + (unicode : 1111; flag : umf_noinfo; reserved : 0), + (unicode : 1038; flag : umf_noinfo; reserved : 0), + (unicode : 1118; 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 : 8470; flag : umf_noinfo; reserved : 0), + (unicode : 164; flag : umf_noinfo; reserved : 0), + (unicode : 9632; flag : umf_noinfo; reserved : 0), + (unicode : 160; flag : umf_noinfo; reserved : 0) + ); + + unicodemap : tunicodemap = ( + cpname : 'cp866'; + cp : 866; + map : @map; + lastchar : 255; + next : nil; + internalmap : true + ); + + begin + registermapping(@unicodemap) + end. diff --git a/closures/compiler/cp8859_1.pas b/closures/compiler/cp8859_1.pas new file mode 100644 index 0000000000..ed4f04d3b6 --- /dev/null +++ b/closures/compiler/cp8859_1.pas @@ -0,0 +1,282 @@ +{ This is an automatically created file, so don't edit it } +unit cp8859_1; + + interface + + implementation + + uses + {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif}; + + 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'; + cp : 28591; + map : @map[0]; + lastchar : 255; + next : nil; + internalmap : true + ); + + begin + registermapping(@unicodemap) + end. diff --git a/closures/compiler/cp8859_5.pas b/closures/compiler/cp8859_5.pas new file mode 100644 index 0000000000..641c1c0582 --- /dev/null +++ b/closures/compiler/cp8859_5.pas @@ -0,0 +1,282 @@ +{ This is an automatically created file, so don't edit it } +unit cp8859_5; + + interface + + implementation + + uses + {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif}; + + 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 : 1025; flag : umf_noinfo; reserved : 0), + (unicode : 1026; flag : umf_noinfo; reserved : 0), + (unicode : 1027; flag : umf_noinfo; reserved : 0), + (unicode : 1028; flag : umf_noinfo; reserved : 0), + (unicode : 1029; flag : umf_noinfo; reserved : 0), + (unicode : 1030; flag : umf_noinfo; reserved : 0), + (unicode : 1031; flag : umf_noinfo; reserved : 0), + (unicode : 1032; flag : umf_noinfo; reserved : 0), + (unicode : 1033; flag : umf_noinfo; reserved : 0), + (unicode : 1034; flag : umf_noinfo; reserved : 0), + (unicode : 1035; flag : umf_noinfo; reserved : 0), + (unicode : 1036; flag : umf_noinfo; reserved : 0), + (unicode : 173; flag : umf_noinfo; reserved : 0), + (unicode : 1038; flag : umf_noinfo; reserved : 0), + (unicode : 1039; flag : umf_noinfo; reserved : 0), + (unicode : 1040; flag : umf_noinfo; reserved : 0), + (unicode : 1041; flag : umf_noinfo; reserved : 0), + (unicode : 1042; flag : umf_noinfo; reserved : 0), + (unicode : 1043; flag : umf_noinfo; reserved : 0), + (unicode : 1044; flag : umf_noinfo; reserved : 0), + (unicode : 1045; flag : umf_noinfo; reserved : 0), + (unicode : 1046; flag : umf_noinfo; reserved : 0), + (unicode : 1047; flag : umf_noinfo; reserved : 0), + (unicode : 1048; flag : umf_noinfo; reserved : 0), + (unicode : 1049; flag : umf_noinfo; reserved : 0), + (unicode : 1050; flag : umf_noinfo; reserved : 0), + (unicode : 1051; flag : umf_noinfo; reserved : 0), + (unicode : 1052; flag : umf_noinfo; reserved : 0), + (unicode : 1053; flag : umf_noinfo; reserved : 0), + (unicode : 1054; flag : umf_noinfo; reserved : 0), + (unicode : 1055; flag : umf_noinfo; reserved : 0), + (unicode : 1056; flag : umf_noinfo; reserved : 0), + (unicode : 1057; flag : umf_noinfo; reserved : 0), + (unicode : 1058; flag : umf_noinfo; reserved : 0), + (unicode : 1059; flag : umf_noinfo; reserved : 0), + (unicode : 1060; flag : umf_noinfo; reserved : 0), + (unicode : 1061; flag : umf_noinfo; reserved : 0), + (unicode : 1062; flag : umf_noinfo; reserved : 0), + (unicode : 1063; flag : umf_noinfo; reserved : 0), + (unicode : 1064; flag : umf_noinfo; reserved : 0), + (unicode : 1065; flag : umf_noinfo; reserved : 0), + (unicode : 1066; flag : umf_noinfo; reserved : 0), + (unicode : 1067; flag : umf_noinfo; reserved : 0), + (unicode : 1068; flag : umf_noinfo; reserved : 0), + (unicode : 1069; flag : umf_noinfo; reserved : 0), + (unicode : 1070; flag : umf_noinfo; reserved : 0), + (unicode : 1071; flag : umf_noinfo; reserved : 0), + (unicode : 1072; flag : umf_noinfo; reserved : 0), + (unicode : 1073; flag : umf_noinfo; reserved : 0), + (unicode : 1074; flag : umf_noinfo; reserved : 0), + (unicode : 1075; flag : umf_noinfo; reserved : 0), + (unicode : 1076; flag : umf_noinfo; reserved : 0), + (unicode : 1077; flag : umf_noinfo; reserved : 0), + (unicode : 1078; flag : umf_noinfo; reserved : 0), + (unicode : 1079; flag : umf_noinfo; reserved : 0), + (unicode : 1080; flag : umf_noinfo; reserved : 0), + (unicode : 1081; flag : umf_noinfo; reserved : 0), + (unicode : 1082; flag : umf_noinfo; reserved : 0), + (unicode : 1083; flag : umf_noinfo; reserved : 0), + (unicode : 1084; flag : umf_noinfo; reserved : 0), + (unicode : 1085; flag : umf_noinfo; reserved : 0), + (unicode : 1086; flag : umf_noinfo; reserved : 0), + (unicode : 1087; flag : umf_noinfo; reserved : 0), + (unicode : 1088; flag : umf_noinfo; reserved : 0), + (unicode : 1089; flag : umf_noinfo; reserved : 0), + (unicode : 1090; flag : umf_noinfo; reserved : 0), + (unicode : 1091; flag : umf_noinfo; reserved : 0), + (unicode : 1092; flag : umf_noinfo; reserved : 0), + (unicode : 1093; flag : umf_noinfo; reserved : 0), + (unicode : 1094; flag : umf_noinfo; reserved : 0), + (unicode : 1095; flag : umf_noinfo; reserved : 0), + (unicode : 1096; flag : umf_noinfo; reserved : 0), + (unicode : 1097; flag : umf_noinfo; reserved : 0), + (unicode : 1098; flag : umf_noinfo; reserved : 0), + (unicode : 1099; flag : umf_noinfo; reserved : 0), + (unicode : 1100; flag : umf_noinfo; reserved : 0), + (unicode : 1101; flag : umf_noinfo; reserved : 0), + (unicode : 1102; flag : umf_noinfo; reserved : 0), + (unicode : 1103; flag : umf_noinfo; reserved : 0), + (unicode : 8470; flag : umf_noinfo; reserved : 0), + (unicode : 1105; flag : umf_noinfo; reserved : 0), + (unicode : 1106; flag : umf_noinfo; reserved : 0), + (unicode : 1107; flag : umf_noinfo; reserved : 0), + (unicode : 1108; flag : umf_noinfo; reserved : 0), + (unicode : 1109; flag : umf_noinfo; reserved : 0), + (unicode : 1110; flag : umf_noinfo; reserved : 0), + (unicode : 1111; flag : umf_noinfo; reserved : 0), + (unicode : 1112; flag : umf_noinfo; reserved : 0), + (unicode : 1113; flag : umf_noinfo; reserved : 0), + (unicode : 1114; flag : umf_noinfo; reserved : 0), + (unicode : 1115; flag : umf_noinfo; reserved : 0), + (unicode : 1116; flag : umf_noinfo; reserved : 0), + (unicode : 167; flag : umf_noinfo; reserved : 0), + (unicode : 1118; flag : umf_noinfo; reserved : 0), + (unicode : 1119; flag : umf_noinfo; reserved : 0) + ); + + unicodemap : tunicodemap = ( + cpname : '8859-5'; + cp : 28595; + map : @map; + lastchar : 255; + next : nil; + internalmap : true + ); + + begin + registermapping(@unicodemap) + end. diff --git a/closures/compiler/cpid.pas b/closures/compiler/cpid.pas new file mode 100644 index 0000000000..0811a36570 --- /dev/null +++ b/closures/compiler/cpid.pas @@ -0,0 +1,191 @@ +{ + Copyright (c) 2008 by Florian Klaempfl + + Basic stuff for encoding sensitive strings + + 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 cpid; + + +{$i fpcdefs.inc} + + interface + + type + TEncodingEntry = record + id : TStringEncoding; + name : Ansistring; + end; + + const Encodings : array[0..150] of TEncodingEntry = ( + id : 037; name : 'IBM037'; + id : 437; name : 'IBM437'; + id : 500; name : 'IBM500'; + id : 708; name : 'ASMO-708'; + id : 709; name : 'ASMO-449+'; + id : 710; name : 'Arabic'; + id : 720; name : 'DOS-720'; + id : 737; name : 'ibm737'; + id : 775; name : 'ibm775'; + id : 850; name : 'ibm850'; + id : 852; name : 'ibm852'; + id : 855; name : 'IBM855'; + id : 857; name : 'ibm857'; + id : 858; name : 'IBM00858'; + id : 860; name : 'IBM860'; + id : 861; name : 'ibm861'; + id : 862; name : 'DOS-862'; + id : 863; name : 'IBM863'; + id : 864; name : 'IBM864'; + id : 865; name : 'IBM865'; + id : 866; name : 'cp866'';; + id : 869; name : 'ibm869'; + id : 870; name : 'IBM870'; + id : 874; name : 'windows-874'; + id : 875; name : 'cp875'; + id : 932; name : 'shift_jis'; + id : 936; name : 'gb2312'; + id : 949; name : 'ks_c_5601-1987'; + id : 950; name : 'big5'; + id : 1026; name : 'IBM1026'; + id : 1047; name : 'IBM01047'; + id : 1140; name : 'IBM01140'; + id : 1141; name : 'IBM01141'; + id : 1142; name : 'IBM01142'; + id : 1143; name : 'IBM01143'; + id : 1144; name : 'IBM01144'; + id : 1145; name : 'IBM01145'; + id : 1146; name : 'IBM01146'; + id : 1147; name : 'IBM01147'; + id : 1148; name : 'IBM01148'; + id : 1149; name : 'IBM01149'; + id : 1200; name : 'utf-16'; + id : 1201; name : 'unicodeFFFE'; + id : 1250; name : 'windows-1250'; + id : 1251; name : 'windows-1251'; + id : 1252; name : 'windows-1252'; + id : 1253; name : 'windows-1253'; + id : 1254; name : 'windows-1254'; + id : 1255; name : 'windows-1255'; + id : 1256; name : 'windows-1256'; + id : 1257; name : 'windows-1257'; + id : 1258; name : 'windows-1258'; + id : 1361; name : 'Johab'; + id : 10000; name : 'macintosh'; + id : 10001; name : 'x-mac-japanese'; + id : 10002; name : 'x-mac-chinesetrad'; + id : 10003; name : 'x-mac-korean'; + id : 10004; name : 'x-mac-arabic'; + id : 10005; name : 'x-mac-hebrew'; + id : 10006; name : 'x-mac-greek'; + id : 10007; name : 'x-mac-cyrillic'; + id : 10008; name : 'x-mac-chinesesimp'; + id : 10010; name : 'x-mac-romanian'; + id : 10017; name : 'x-mac-ukrainian'; + id : 10021; name : 'x-mac-thai'; + id : 10029; name : 'x-mac-ce'; + id : 10079; name : 'x-mac-icelandic'; + id : 10081; name : 'x-mac-turkish'; + id : 10082; name : 'x-mac-croatian'; + id : 12000; name : 'utf-32'; + id : 12001; name : 'utf-32BE'; + id : 20000; name : 'x-Chinese_CNS'; + id : 20001; name : 'x-cp20001'; + id : 20002; name : 'x_Chinese-Eten'; + id : 20003; name : 'x-cp20003'; + id : 20004; name : 'x-cp20004'; + id : 20005; name : 'x-cp20005'; + id : 20105; name : 'x-IA5'; + id : 20106; name : 'x-IA5-German'; + id : 20107; name : 'x-IA5-Swedish'; + id : 20108; name : 'x-IA5-Norwegian'; + id : 20127; name : 'us-ascii'; + id : 20261; name : 'x-cp20261'; + id : 20269; name : 'x-cp20269'; + id : 20273; name : 'IBM273'; + id : 20277; name : 'IBM277'; + id : 20278; name : 'IBM278'; + id : 20280; name : 'IBM280'; + id : 20284; name : 'IBM284'; + id : 20285; name : 'IBM285'; + id : 20290; name : 'IBM290'; + id : 20297; name : 'IBM297'; + id : 20420; name : 'IBM420'; + id : 20423; name : 'IBM423'; + id : 20424; name : 'IBM424'; + id : 20833; name : 'x-EBCDIC-KoreanExtended'; + id : 20838; name : 'IBM-Thai'; + id : 20866; name : 'koi8-r'; + id : 20871; name : 'IBM871'; + id : 20880; name : 'IBM880'; + id : 20905; name : 'IBM905'; + id : 20924; name : 'IBM00924'; + id : 20932; name : 'EUC-JP'; + id : 20936; name : 'x-cp20936'; + id : 20949; name : 'x-cp20949'; + id : 21025; name : 'cp1025'; + id : 21866; name : 'koi8-u'; + id : 28591; name : 'iso-8859-1'; + id : 28592; name : 'iso-8859-2'; + id : 28593; name : 'iso-8859-3'; + id : 28594; name : 'iso-8859-4'; + id : 28595; name : 'iso-8859-5'; + id : 28596; name : 'iso-8859-6'; + id : 28597; name : 'iso-8859-7'; + id : 28598; name : 'iso-8859-8'; + id : 28599; name : 'iso-8859-9'; + id : 28603; name : 'iso-8859-13'; + id : 28605; name : 'iso-8859-15'; + id : 29001; name : 'x-Europa'; + id : 38598; name : 'iso-8859-8-i'; + id : 50220; name : 'iso-2022-jp'; + id : 50221; name : 'csISO2022JP'; + id : 50222; name : 'iso-2022-jp'; + id : 50225; name : 'iso-2022-kr'; + id : 50227; name : 'x-cp50227'; + id : 50229; name : 'ISO 2022'; + { not unique + id : 50930; name : 'EBCDIC + id : 50931; name : 'EBCDIC + id : 50933; name : 'EBCDIC + id : 50935; name : 'EBCDIC + id : 50936; name : 'EBCDIC + id : 50937; name : 'EBCDIC + id : 50939; name : 'EBCDIC + } + id : 51932; name : 'euc-jp'; + id : 51936; name : 'EUC-CN'; + id : 51949; name : 'euc-kr'; + id : 51950; name : 'EUC'; + id : 52936; name : 'hz-gb-2312'; + id : 54936; name : 'GB18030'; + id : 57002; name : 'x-iscii-de'; + id : 57003; name : 'x-iscii-be'; + id : 57004; name : 'x-iscii-ta'; + id : 57005; name : 'x-iscii-te'; + id : 57006; name : 'x-iscii-as'; + id : 57007; name : 'x-iscii-or'; + id : 57008; name : 'x-iscii-ka'; + id : 57009; name : 'x-iscii-ma'; + id : 57010; name : 'x-iscii-gu'; + id : 57011; name : 'x-iscii-pa'; + id : 65000; name : 'utf-7'; + id : 65001; name : 'utf-8'); + + implementation + +end. diff --git a/closures/compiler/crefs.pas b/closures/compiler/crefs.pas new file mode 100644 index 0000000000..c3284eba60 --- /dev/null +++ b/closures/compiler/crefs.pas @@ -0,0 +1,65 @@ +{ + Copyright (c) 2007 by Pierre Muller + + Common reference 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. + **************************************************************************** +} + +unit crefs; + +{$i fpcdefs.inc} + +interface + +uses + globtype, + cclasses; + + type + + TrefItem = class (TLinkedListItem) + refinfo : tfileposinfo; + constructor create(const ARefInfo : tfileposinfo); + Function GetCopy:TLinkedListItem;virtual;reintroduce; + end; + + TRefLinkedList = class(TLinkedList) + procedure WriteToPPU; + end; + +implementation + +constructor TRefItem.Create(const ARefInfo : tfileposinfo); +begin + Inherited Create; + RefInfo:=ARefInfo; +end; + +Function TRefItem.GetCopy : TLinkedListItem; +var + NR : TRefItem; +begin + NR.Create(RefInfo); + GetCopy:=NR; +end; + +procedure TRefLinkedList.WriteToPPU; +begin +end; + +begin +end. diff --git a/closures/compiler/cresstr.pas b/closures/compiler/cresstr.pas new file mode 100644 index 0000000000..a4c4109265 --- /dev/null +++ b/closures/compiler/cresstr.pas @@ -0,0 +1,323 @@ +{ + 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 + + Procedure GenerateResourceStrings; + + +implementation + +uses + SysUtils, + cclasses, + cutils,globtype,globals,systems, + symconst,symtype,symdef,symsym, + verbose,fmodule,ppu, + aasmbase,aasmtai,aasmdata, + aasmcpu, +{$if FPC_FULLVERSION<20700} + ccharset, +{$endif} + asmutils; + + Type + { These are used to form a singly-linked list, ordered by hash value } + TResourceStringItem = class(TLinkedListItem) + Sym : TConstSym; + Name : String; + Value : Pchar; + Len : Longint; + hash : Cardinal; + constructor Create(asym:TConstsym); + destructor Destroy;override; + procedure CalcHash; + end; + + Tresourcestrings=class + private + List : TLinkedList; + procedure ConstSym_Register(p:TObject;arg:pointer); + public + constructor Create; + destructor Destroy;override; + procedure CreateResourceStringData; + Procedure WriteResourceFile; + procedure RegisterResourceStrings; + end; + + + +{ --------------------------------------------------------------------- + TRESOURCESTRING_ITEM + ---------------------------------------------------------------------} + + constructor TResourceStringItem.Create(asym:TConstsym); + begin + inherited Create; + Sym:=Asym; + Name:=lower(asym.owner.name^+'.'+asym.Name); + Len:=asym.value.len; + GetMem(Value,Len); + Move(asym.value.valueptr^,Value^,Len); + CalcHash; + end; + + + destructor TResourceStringItem.Destroy; + begin + FreeMem(Value); + 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:=TLinkedList.Create; + end; + + + Destructor Tresourcestrings.Destroy; + begin + List.Free; + end; + + + procedure Tresourcestrings.CreateResourceStringData; + Var + namelab, + valuelab : tasmlabel; + resstrlab : tasmsymbol; + endsymlab : tasmsymbol; + R : TResourceStringItem; + begin + { Put resourcestrings in a new objectfile. Putting it in multiple files + makes the linking too dependent on the linker script requiring a SORT(*) for + the data sections } + maybe_new_object_file(current_asmdata.asmlists[al_const]); + new_section(current_asmdata.asmlists[al_const],sec_data,make_mangledname('RESSTRTABLE',current_module.localsymtable,''),sizeof(pint)); + + maybe_new_object_file(current_asmdata.asmlists[al_resourcestrings]); + new_section(current_asmdata.asmlists[al_resourcestrings],sec_data,make_mangledname('RESSTR',current_module.localsymtable,'1_START'),sizeof(pint)); + current_asmdata.AsmLists[al_resourcestrings].concat(tai_symbol.createname_global( + make_mangledname('RESSTR',current_module.localsymtable,'START'),AT_DATA,0)); + + { Write unitname entry } + namelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],@current_module.localsymtable.name^[1],length(current_module.localsymtable.name^),getansistringcodepage,False); + current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(namelab)); + current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(nil)); + current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(nil)); + current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_32bit(0)); +{$ifdef cpu64bitaddr} + current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_32bit(0)); +{$endif cpu64bitaddr} + + { Add entries } + R:=TResourceStringItem(List.First); + while assigned(R) do + begin + new_section(current_asmdata.asmlists[al_const],sec_rodata,make_mangledname('RESSTR',current_module.localsymtable,'d_'+r.name),sizeof(pint)); + { Write default value } + if assigned(R.value) and (R.len<>0) then + valuelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],R.Value,R.Len,getansistringcodepage,False) + else + valuelab:=nil; + { Append the name as a ansistring. } + current_asmdata.asmlists[al_const].concat(cai_align.Create(const_align(sizeof(pint)))); + namelab:=emit_ansistring_const(current_asmdata.asmlists[al_const],@R.Name[1],length(R.name),getansistringcodepage,False); + + { + Resourcestring index: + TResourceStringRecord = Packed Record + Name, + CurrentValue, + DefaultValue : AnsiString; + HashValue : LongWord; + end; + } + new_section(current_asmdata.asmlists[al_resourcestrings],sec_data,make_mangledname('RESSTR',current_module.localsymtable,'2_'+r.name),sizeof(pint)); + resstrlab:=current_asmdata.DefineAsmSymbol(make_mangledname('RESSTR',R.Sym.owner,R.Sym.name),AB_GLOBAL,AT_DATA); + current_asmdata.asmlists[al_resourcestrings].concat(tai_symbol.Create_global(resstrlab,0)); + current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(namelab)); + current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(valuelab)); + current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_sym(valuelab)); + current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_32bit(longint(R.Hash))); +{$ifdef cpu64bitaddr} + current_asmdata.asmlists[al_resourcestrings].concat(tai_const.create_32bit(0)); +{$endif cpu64bitaddr} + current_asmdata.asmlists[al_resourcestrings].concat(tai_symbol_end.create(resstrlab)); + R:=TResourceStringItem(R.Next); + end; + new_section(current_asmdata.asmlists[al_resourcestrings],sec_data,make_mangledname('RESSTR',current_module.localsymtable,'3_END'),sizeof(pint)); + endsymlab:=current_asmdata.DefineAsmSymbol(make_mangledname('RESSTR',current_module.localsymtable,'END'),AB_GLOBAL,AT_DATA); + current_asmdata.AsmLists[al_resourcestrings].concat(tai_symbol.create_global(endsymlab,0)); + { The darwin/ppc64 assembler or linker seems to have trouble } + { if a section ends with a global label without any data after it. } + { So for safety, just put a dummy value here. } + { Further, the regular linker also kills this symbol when turning } + { on smart linking in case no value appears after it, so put the } + { dummy byte there always } + { Update: the Mac OS X 10.6 linker orders data that needs to be } + { relocated before all other data, so make this data relocatable, } + { otherwise the end label won't be moved with the rest } + if (target_info.system in systems_darwin) then + current_asmdata.asmlists[al_resourcestrings].concat(Tai_const.create_sym(endsymlab)); + end; + + + Procedure Tresourcestrings.WriteResourceFile; + Type + TMode = (quoted,unquoted); + Var + F : Text; + Mode : TMode; + R : TResourceStringItem; + C : char; + Col,i : longint; + ResFileName : string; + + Procedure Add(Const S : String); + begin + Write(F,S); + inc(Col,length(s)); + end; + + begin + ResFileName:=ChangeFileExt(current_module.ppufilename^,'.rst'); + message1 (general_i_writingresourcefile,ExtractFileName(ResFileName)); + Assign(F,ResFileName); + {$push}{$i-} + Rewrite(f); + {$pop} + If IOresult<>0 then + begin + message1(general_e_errorwritingresourcefile,ResFileName); + 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; + + + procedure Tresourcestrings.ConstSym_Register(p:TObject;arg:pointer); + begin + if (tsym(p).typ=constsym) and + (tconstsym(p).consttyp=constresourcestring) then + List.Concat(tResourceStringItem.Create(TConstsym(p))); + end; + + + procedure Tresourcestrings.RegisterResourceStrings; + begin + if assigned(current_module.globalsymtable) then + current_module.globalsymtable.SymList.ForEachCall(@ConstSym_Register,nil); + current_module.localsymtable.SymList.ForEachCall(@ConstSym_Register,nil); + end; + + + Procedure GenerateResourceStrings; + var + resstrs : Tresourcestrings; + begin + resstrs:=Tresourcestrings.Create; + resstrs.RegisterResourceStrings; + if not resstrs.List.Empty then + begin + current_module.flags:=current_module.flags or uf_has_resourcestrings; + resstrs.CreateResourceStringData; + resstrs.WriteResourceFile; + end; + resstrs.Free; + end; + +end. diff --git a/closures/compiler/cstreams.pas b/closures/compiler/cstreams.pas new file mode 100644 index 0000000000..d0cd536051 --- /dev/null +++ b/closures/compiler/cstreams.pas @@ -0,0 +1,641 @@ +{ + 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; + +{ TCCustomFileStream class } + + TCCustomFileStream = class(TCStream) + protected + FFileName : String; + public + constructor Create(const AFileName: string;{shortstring!} Mode: Word); virtual; abstract; + function EOF: boolean; virtual; abstract; + property FileName : String Read FFilename; + end; + +{ TFileStream class } + + TCFileStream = class(TCCustomFileStream) + Private + FHandle: File; + protected + procedure SetSize(NewSize: Longint); override; + public + constructor Create(const AFileName: string; Mode: Word); override; + 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; + function EOF: boolean; override; + end; + + TCFileStreamClass = class of TCCustomFileStream; +var + CFileStreamClass: TCFileStreamClass = TCFileStream; + +type +{ 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 well 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); +var + oldfilemode : byte; +begin + FFileName:=AFileName; + If Mode=fmcreate then + begin + system.assign(FHandle,AFileName); + {$push} {$I-} + system.rewrite(FHandle,1); + {$pop} + CStreamError:=IOResult; + end + else + begin + oldfilemode:=filemode; + filemode:=$40 or Mode; + system.assign(FHandle,AFileName); + {$push} {$I-} + system.reset(FHandle,1); + {$pop} + CStreamError:=IOResult; + filemode:=oldfilemode; + end; +end; + + +destructor TCFileStream.Destroy; +begin + {$push} {$I-} + System.Close(FHandle); + {$pop} + 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 + {$push} {$I-} + System.Seek(FHandle,NewSize); + System.Truncate(FHandle); + {$pop} + CStreamError:=IOResult; +end; + + +function TCFileStream.Seek(Offset: Longint; Origin: Word): Longint; +var + l : longint; +begin + {$push} {$I-} + case Origin of + soFromBeginning : + begin + System.Seek(FHandle,Offset); + l:=Offset; + end; + 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; + {$pop} + CStreamError:=IOResult; + Result:=l; +end; + +function TCFileStream.EOF: boolean; +begin + EOF:=system.eof(FHandle); +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(PtrUInt(FMemory)+PtrUInt(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 : TCCustomFileStream; + +begin + Try + S:=CFileStreamClass.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 : TCCustomFileStream; + +begin + Try + S:=CFileStreamClass.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(Ptruint(FMemory)+PtrUInt(FPosition))^,Count); + FPosition:=NewPos; + Result:=Count; +end; + +end. diff --git a/closures/compiler/cutils.pas b/closures/compiler/cutils.pas new file mode 100644 index 0000000000..1f05c5cad5 --- /dev/null +++ b/closures/compiler/cutils.pas @@ -0,0 +1,1363 @@ +{ + 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 + 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} + {# Return value @var(i) aligned on @var(a) boundary } + function align(i,a:longint):longint;{$ifdef USEINLINE}inline;{$endif} + { if you have an address aligned using "oldalignment" and add an + offset of (a multiple of) offset to it, this function calculates + the new minimally guaranteed alignment + } + function newalignment(oldalignment: longint; offset: int64): longint; + {# Return @var(b) with the bit order reversed } + function reverse_byte(b: byte): byte; + + function used_align(varalign,minalign,maxalign:shortint):shortint; + function isbetteralignedthan(new, org, limit: cardinal): boolean; + function size_2_align(len : longint) : shortint; + function packedbitsloadsize(bitlen: int64) : int64; + procedure Replace(var s:string;s1:string;const s2:string); + procedure Replace(var s:AnsiString;s1:string;const s2:AnsiString); + procedure ReplaceCase(var s:string;const s1,s2:string); + Function MatchPattern(const pattern,what:string):boolean; + function upper(const c : char) : char; + function upper(const s : string) : string; + function upper(const s : ansistring) : ansistring; + function lower(const c : char) : char; + function lower(const s : string) : string; + function lower(const s : ansistring) : ansistring; + 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 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 nextpowerof2(value : int64; out power: longint) : int64; + 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; + function maybequoted(const s:ansistring):ansistring; + + {# 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: ansistring): Boolean; + function CompareStr(const S1, S2: string): Integer; + function CompareText(S1, S2: string): integer; + + { releases the string p and assignes nil to p } + { if p=nil then freemem isn't called } + procedure stringdispose(var p : pshortstring);{$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) : pshortstring;{$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; + + {# 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 pchar2pshortstring(p : pchar) : pshortstring; + + { inverse of pchar2pshortstring } + function pshortstring2pchar(p : pshortstring) : pchar; + + { allocate a new pchar with the contents of a} + function ansistring2pchar(const a: ansistring) : pchar; + + { 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; + + Function nextafter(x,y:double):double; + +implementation + + uses + SysUtils; + + 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:=a + else + min:=b; + end; + + + function min(a,b : int64) : int64;{$ifdef USEINLINE}inline;{$endif} + { + return the minimal of a and b + } + begin + if a<=b then + min:=a + else + min:=b; + end; + + + function max(a,b : longint) : longint;{$ifdef USEINLINE}inline;{$endif} + { + return the maximum of a and b + } + begin + if a>=b then + max:=a + else + max:=b; + end; + + + function max(a,b : int64) : int64;{$ifdef USEINLINE}inline;{$endif} + { + return the maximum of a and b + } + begin + if a>=b then + max:=a + else + max:=b; + end; + + + function newalignment(oldalignment: longint; offset: int64): longint; + var + localoffset: longint; + begin + localoffset:=longint(offset); + while (localoffset mod oldalignment)<>0 do + oldalignment:=oldalignment div 2; + newalignment:=oldalignment; + end; + + + function reverse_byte(b: byte): byte; + const + reverse_nible:array[0..15] of 0..15 = + (%0000,%1000,%0100,%1100,%0010,%1010,%0110,%1110, + %0001,%1001,%0101,%1101,%0011,%1011,%0111,%1111); + begin + reverse_byte:=(reverse_nible[b and $f] shl 4) or reverse_nible[b shr 4]; + 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) : shortint; + 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 packedbitsloadsize(bitlen: int64) : int64; + begin + case bitlen of + 1,2,4,8: + result := 1; + { 10 bits can never be split over 3 bytes via 1-8-1, because it } + { always starts at a multiple of 10 bits. Same for the others. } + 3,5,6,7,9,10,12,16: + result := 2; + {$ifdef cpu64bitalu} + { performance penalty for unaligned 8 byte access is much } + { higher than for unaligned 4 byte access, at least on ppc, } + { so use 4 bytes even in some cases where a value could } + { always loaded using a single 8 byte load (e.g. in case of } + { 28 bit values) } + 11,13,14,15,17..32: + result := 4; + else + result := 8; + {$else cpu64bitalu} + else + result := 4; + {$endif cpu64bitalu} + end; + end; + + + function isbetteralignedthan(new, org, limit: cardinal): boolean; + var + cnt: cardinal; + begin + cnt:=2; + while (cnt <= limit) do + begin + if (org and (cnt-1)) > (new and (cnt-1)) then + begin + result:=true; + exit; + end + else if (org and (cnt-1)) < (new and (cnt-1)) then + begin + result:=false; + exit; + end; + cnt:=cnt*2; + end; + result:=false; + end; + + + function used_align(varalign,minalign,maxalign:shortint):shortint; + 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:AnsiString); + 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 MatchPattern(const pattern,what:string):boolean; + var + found : boolean; + i1,i2 : longint; + begin + i1:=0; + i2:=0; + if pattern='' then + begin + result:=(what=''); + exit; + end; + found:=true; + repeat + inc(i1); + if (i1>length(pattern)) then + break; + inc(i2); + if (i2>length(what)) then + break; + case pattern[i1] of + '?' : + found:=true; + '*' : + begin + found:=true; + if (i1=length(pattern)) then + i2:=length(what) + else + if (i1<length(pattern)) and (pattern[i1+1]<>what[i2]) then + begin + if i2<length(what) then + dec(i1) + end + else + if i2>1 then + dec(i2); + end; + else + found:=(pattern[i1]=what[i2]) or (what[i2]='?'); + end; + until not found; + if found then + begin + found:=(i2>=length(what)) and + ( + (i1>length(pattern)) or + ((i1=length(pattern)) and + (pattern[i1]='*')) + ); + end; + result:=found; + end; + + + function upper(const c : char) : char; + { + return uppercase of c + } + begin + upper:=uppertbl[c]; + 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 upper(const s : ansistring) : ansistring; + { + return uppercased string of s + } + var + i : longint; + begin + setlength(upper,length(s)); + for i:=1 to length(s) do + upper[i]:=uppertbl[s[i]]; + end; + + + function lower(const c : char) : char; + { + return lowercase of c + } + begin + lower:=lowertbl[c]; + 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; + + + function lower(const s : ansistring) : ansistring; + { + return lowercased string of s + } + var + i : longint; + begin + setlength(lower,length(s)); + for i:=1 to length(s) do + lower[i]:=lowertbl[s[i]]; + 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 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; + quote : char; + begin + GetToken:=''; + s:=TrimSpace(s); + if (length(s)>0) and + (s[1] in ['''','"']) then + begin + quote:=s[1]; + i:=1; + while (i<length(s)) do + begin + inc(i); + if s[i]=quote then + begin + { Remove double quote } + if (i<length(s)) and + (s[i+1]=quote) 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); + // remove warning + l:=l; + 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 nextpowerof2(value : int64; out power: longint) : int64; + { + returns the power of 2 >= value + } + var + i : longint; + begin + result := 0; + power := -1; + if ((value <= 0) or + (value >= $4000000000000000)) then + exit; + result := 1; + for i:=0 to 63 do + begin + if result>=value then + begin + power := i; + exit; + end; + result:=result shl 1; + end; + 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:ansistring):ansistring; + const + {$IFDEF MSWINDOWS} + FORBIDDEN_CHARS = ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')', + '{', '}', '''', '`', '~']; + {$ELSE} + FORBIDDEN_CHARS = ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')', + '{', '}', '''', ':', '\', '`', '~']; + {$ENDIF} + var + s1 : ansistring; + 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 begin + if s[i] in FORBIDDEN_CHARS then + quoted:=True; + s1:=s1+s[i]; + end; + end; + end; + if quoted then + maybequoted:=s1+'"' + else + maybequoted:=s; + end; + + + function maybequoted(const s:string):string; + const + {$IFDEF MSWINDOWS} + FORBIDDEN_CHARS = ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')', + '{', '}', '''', '`', '~']; + {$ELSE} + FORBIDDEN_CHARS = ['!', '@', '#', '$', '%', '^', '&', '*', '(', ')', + '{', '}', '''', ':', '\', '`', '~']; + {$ENDIF} + 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 begin + if s[i] in FORBIDDEN_CHARS then + quoted:=True; + s1:=s1+s[i]; + end; + end; + end; + if quoted then + maybequoted:=s1+'"' + else + maybequoted:=s; + end; + + + function DePascalQuote(var s: ansistring): 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 pchar2pshortstring(p : pchar) : pshortstring; + var + w,i : longint; + begin + w:=strlen(p); + for i:=w-1 downto 0 do + p[i+1]:=p[i]; + p[0]:=chr(w); + pchar2pshortstring:=pshortstring(p); + end; + + + function pshortstring2pchar(p : pshortstring) : pchar; + var + w,i : longint; + begin + w:=length(p^); + for i:=1 to w do + p^[i-1]:=p^[i]; + p^[w]:=#0; + pshortstring2pchar:=pchar(p); + end; + + + function ansistring2pchar(const a: ansistring) : pchar; + var + len: ptrint; + begin + len:=length(a); + getmem(result,len+1); + if (len<>0) then + move(a[1],result[0],len); + result[len]:=#0; + 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); + move(s[1],p^,length(s)); + p[length(s)]:=#0; + result:=p; + end; + + + procedure stringdispose(var p : pshortstring);{$ifdef USEINLINE}inline;{$endif} + begin + if assigned(p) then + begin + freemem(p); + p:=nil; + end; + end; + + + function stringdup(const s : string) : pshortstring;{$ifdef USEINLINE}inline;{$endif} + begin + getmem(result,length(s)+1); + result^:=s; + end; + + + function CompareStr(const S1, S2: string): Integer; + var + count, count1, count2: integer; + begin + result := 0; + Count1 := Length(S1); + Count2 := Length(S2); + if Count1>Count2 then + Count:=Count2 + else + Count:=Count1; + result := CompareChar(S1[1],S2[1], Count); + if result=0 then + result:=Count1-Count2; + end; + + + function CompareText(S1, S2: string): integer; + begin + UpperVar(S1); + UpperVar(S2); + Result:=CompareStr(S1,S2); + end; + + +{***************************************************************************** + Ansistring (PChar+Length) +*****************************************************************************} + + procedure ansistringdispose(var p : pchar;length : longint); + begin + if assigned(p) then + begin + freemem(p); + 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:=''; + fillchar(data,sizeof(data),#0); + fillchar(previous,sizeof(previous),#0); + 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:=''; + fillchar(data,sizeof(data),#0); + fillchar(previous,sizeof(previous),#0); + 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; + + Function Nextafter(x,y:double):double; + // Returns the double precision number closest to x in + // the direction toward y. + + // Initial direct translation by Soeren Haastrup from + // www.netlib.org/fdlibm/s_nextafter.c according to + // ==================================================== + // Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. + // Developed at SunSoft, a Sun Microsystems, Inc. business. + // Permission to use, copy, modify, and distribute this + // software is freely granted, provided that this notice + // is preserved. + // ==================================================== + // and with all signaling policies preserved as is. + + type + {$if defined(ENDIAN_LITTLE) and not defined(FPC_DOUBLE_HILO_SWAPPED)} + twoword=record + lo,hi:longword; // Little Endian split of a double. + end; + {$else} + twoword=record + hi,lo:longword; // Big Endian split of a double. + end; + {$endif} + + var + hx,hy,ix,iy:longint; + lx,ly:longword; + + Begin + hx:=twoword(x).hi; // high and low words of x and y + lx:=twoword(x).lo; + hy:=twoword(y).hi; + ly:=twoword(y).lo; + ix:=hx and $7fffffff; // absolute values + iy:=hy and $7fffffff; + + // Case x=NAN or y=NAN + + if ( (ix>=$7ff00000) and ((longword(ix-$7ff00000) or lx) <> 0) ) + or ( (iy>=$7ff00000) and ((longword(iy-$7ff00000) OR ly) <> 0) ) + then exit(x+y); + + // Case x=y + + if x=y then exit(x); // (implies Nextafter(0,-0) is 0 and not -0...) + + // Case x=0 + + if (longword(ix) or lx)=0 + then begin + twoword(x).hi:=hy and $80000000; // return +-minimalSubnormal + twoword(x).lo:=1; + y:=x*x; // set underflow flag (ignored in FPC as default) + if y=x + then exit(y) + else exit(x); + end; + + // all other cases + + if hx>=0 // x>0 + then begin + if (hx>hy) or ( (hx=hy) and (lx>ly) ) // x>y , return x-ulp + then begin + if (lx=0) then hx:=hx-1; + lx:=lx-1; + end + else begin // x<y, return x+ulp + lx:=lx+1; + if lx=0 then hx:=hx+1; + end + end + else begin // x<0 + if (hy>=0) or (hx>=hy) or ( (hx=hy) and (lx>ly)) // x<y, return x-ulp + then begin + if (lx=0) then hx:=hx-1; + lx:=lx-1; + end + else begin // x>y , return x+ulp + lx:=lx+1; + if lx=0 then hx:=hx+1; + end + end; + + // finally check if overflow or underflow just happend + + hy:=hx and $7ff00000; + if (hy>= $7ff00000) then exit(x+x); // overflow and signal + if (hy<$0010000) // underflow + then begin + y:=x*x; // raise underflow flag + if y<>x + then begin + twoword(y).hi:=hx; + twoword(y).lo:=lx; + exit(y); + end + end; + + twoword(x).hi:=hx; + twoword(x).lo:=lx; + nextafter:=x; + + end; + + +initialization + internalerrorproc:=@defaulterror; + initupperlower; +end. diff --git a/closures/compiler/cwindirs.pp b/closures/compiler/cwindirs.pp new file mode 100644 index 0000000000..077697d2a8 --- /dev/null +++ b/closures/compiler/cwindirs.pp @@ -0,0 +1,123 @@ +{ this unit is temporarily included in the compiler sources till stable releases with + windirs from the rtl are shipped +} +unit cwindirs; + +{$mode objfpc} +{$H+} + +interface + +uses + windows, + strings; + +Const + CSIDL_PROGRAMS = $0002; { %SYSTEMDRIVE%\Program Files } + CSIDL_PERSONAL = $0005; { %USERPROFILE%\My Documents } + CSIDL_FAVORITES = $0006; { %USERPROFILE%\Favorites } + CSIDL_STARTUP = $0007; { %USERPROFILE%\Start menu\Programs\Startup } + CSIDL_RECENT = $0008; { %USERPROFILE%\Recent } + CSIDL_SENDTO = $0009; { %USERPROFILE%\Sendto } + CSIDL_STARTMENU = $000B; { %USERPROFILE%\Start menu } + CSIDL_MYMUSIC = $000D; { %USERPROFILE%\Documents\My Music } + CSIDL_MYVIDEO = $000E; { %USERPROFILE%\Documents\My Videos } + CSIDL_DESKTOPDIRECTORY = $0010; { %USERPROFILE%\Desktop } + CSIDL_NETHOOD = $0013; { %USERPROFILE%\NetHood } + CSIDL_TEMPLATES = $0015; { %USERPROFILE%\Templates } + CSIDL_COMMON_STARTMENU = $0016; { %PROFILEPATH%\All users\Start menu } + CSIDL_COMMON_PROGRAMS = $0017; { %PROFILEPATH%\All users\Start menu\Programs } + CSIDL_COMMON_STARTUP = $0018; { %PROFILEPATH%\All users\Start menu\Programs\Startup } + CSIDL_COMMON_DESKTOPDIRECTORY = $0019; { %PROFILEPATH%\All users\Desktop } + CSIDL_APPDATA = $001A; { %USERPROFILE%\Application Data (roaming) } + CSIDL_PRINTHOOD = $001B; { %USERPROFILE%\Printhood } + CSIDL_LOCAL_APPDATA = $001C; { %USERPROFILE%\Local Settings\Application Data (non roaming) } + CSIDL_COMMON_FAVORITES = $001F; { %PROFILEPATH%\All users\Favorites } + CSIDL_INTERNET_CACHE = $0020; { %USERPROFILE%\Local Settings\Temporary Internet Files } + CSIDL_COOKIES = $0021; { %USERPROFILE%\Cookies } + CSIDL_HISTORY = $0022; { %USERPROFILE%\Local settings\History } + CSIDL_COMMON_APPDATA = $0023; { %PROFILESPATH%\All Users\Application Data } + CSIDL_WINDOWS = $0024; { %SYSTEMROOT% } + CSIDL_SYSTEM = $0025; { %SYSTEMROOT%\SYSTEM32 (may be system on 95/98/ME) } + CSIDL_PROGRAM_FILES = $0026; { %SYSTEMDRIVE%\Program Files } + CSIDL_MYPICTURES = $0027; { %USERPROFILE%\My Documents\My Pictures } + CSIDL_PROFILE = $0028; { %USERPROFILE% } + CSIDL_PROGRAM_FILES_COMMON = $002B; { %SYSTEMDRIVE%\Program Files\Common } + CSIDL_COMMON_TEMPLATES = $002D; { %PROFILEPATH%\All Users\Templates } + CSIDL_COMMON_DOCUMENTS = $002E; { %PROFILEPATH%\All Users\Documents } + CSIDL_COMMON_ADMINTOOLS = $002F; { %PROFILEPATH%\All Users\Start Menu\Programs\Administrative Tools } + CSIDL_ADMINTOOLS = $0030; { %USERPROFILE%\Start Menu\Programs\Administrative Tools } + CSIDL_COMMON_MUSIC = $0035; { %PROFILEPATH%\All Users\Documents\my music } + CSIDL_COMMON_PICTURES = $0036; { %PROFILEPATH%\All Users\Documents\my pictures } + CSIDL_COMMON_VIDEO = $0037; { %PROFILEPATH%\All Users\Documents\my videos } + CSIDL_CDBURN_AREA = $003B; { %USERPROFILE%\Local Settings\Application Data\Microsoft\CD Burning } + CSIDL_PROFILES = $003E; { %PROFILEPATH% } + + CSIDL_FLAG_CREATE = $8000; { (force creation of requested folder if it doesn't exist yet) } + +Function GetWindowsSpecialDir(ID : Integer) : String; + +implementation + +uses + sysutils; + +Type + PFNSHGetFolderPath = Function(Ahwnd: HWND; Csidl: Integer; Token: THandle; Flags: DWord; Path: PChar): HRESULT; stdcall; + + +var + SHGetFolderPath : PFNSHGetFolderPath = Nil; + CFGDLLHandle : THandle = 0; + +Procedure InitDLL; + +Var + pathBuf: array[0..MAX_PATH-1] of char; + pathLength: Integer; +begin + { Load shfolder.dll using a full path, in order to prevent spoofing (Mantis #18185) + Don't bother loading shell32.dll because shfolder.dll itself redirects SHGetFolderPath + to shell32.dll whenever possible. } + pathLength:=GetSystemDirectory(pathBuf, MAX_PATH); + if (pathLength>0) and (pathLength<MAX_PATH-14) then { 14=length('\shfolder.dll'#0) } + begin + StrLCopy(@pathBuf[pathLength],'\shfolder.dll',MAX_PATH-pathLength-1); + CFGDLLHandle:=LoadLibrary(pathBuf); + + if (CFGDLLHandle<>0) then + begin + Pointer(ShGetFolderPath):=GetProcAddress(CFGDLLHandle,'SHGetFolderPathA'); + If @ShGetFolderPath=nil then + begin + FreeLibrary(CFGDLLHandle); + CFGDllHandle:=0; + end; + end; + end; + If (@ShGetFolderPath=Nil) then + Raise Exception.Create('Could not determine SHGetFolderPath Function'); +end; + +Function GetWindowsSpecialDir(ID : Integer) : String; + +Var + APath : Array[0..MAX_PATH] of char; + +begin + Result:=''; + if (CFGDLLHandle=0) then + InitDLL; + If (SHGetFolderPath<>Nil) then + begin + if SHGetFolderPath(0,ID or CSIDL_FLAG_CREATE,0,0,@APATH[0])=S_OK then + Result:=IncludeTrailingPathDelimiter(StrPas(@APath[0])); + end; +end; + +Initialization +Finalization + if CFGDLLHandle<>0 then + FreeLibrary(CFGDllHandle); +end. + diff --git a/closures/compiler/dbgbase.pas b/closures/compiler/dbgbase.pas new file mode 100644 index 0000000000..f6b7b15171 --- /dev/null +++ b/closures/compiler/dbgbase.pas @@ -0,0 +1,626 @@ +{ + Copyright (c) 2003-2006 by Peter Vreman and Florian Klaempfl + + This units contains the base class 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 + cclasses, + systems, + parabase, + symconst,symbase,symdef,symtype,symsym,symtable, + fmodule, + aasmtai,aasmdata; + + type + TDebugInfo=class + protected + { definitions } + { collect all defs in one list so we can reset them easily } + defnumberlist : TFPObjectList; + deftowritelist : TFPObjectList; + procedure appenddef(list:TAsmList;def:tdef); + procedure beforeappenddef(list:TAsmList;def:tdef);virtual; + procedure afterappenddef(list:TAsmList;def:tdef);virtual; + procedure appenddef_ord(list:TAsmList;def:torddef);virtual; + procedure appenddef_float(list:TAsmList;def:tfloatdef);virtual; + procedure appenddef_file(list:TAsmList;def:tfiledef);virtual; + procedure appenddef_enum(list:TAsmList;def:tenumdef);virtual; + procedure appenddef_array(list:TAsmList;def:tarraydef);virtual; + procedure appenddef_record(list:TAsmList;def:trecorddef);virtual; + procedure appenddef_object(list:TAsmList;def:tobjectdef);virtual; + procedure appenddef_classref(list:TAsmList;def: tclassrefdef);virtual; + procedure appenddef_pointer(list:TAsmList;def:tpointerdef);virtual; + procedure appenddef_string(list:TAsmList;def:tstringdef);virtual; + procedure appenddef_procvar(list:TAsmList;def:tprocvardef);virtual; + procedure appenddef_variant(list:TAsmList;def:tvariantdef);virtual; + procedure appenddef_set(list:TAsmList;def:tsetdef);virtual; + procedure appenddef_formal(list:TAsmList;def:tformaldef);virtual; + procedure appenddef_undefined(list:TAsmList;def: tundefineddef);virtual; + procedure appendprocdef(list:TAsmList;def:tprocdef);virtual; + procedure write_remaining_defs_to_write(list:TAsmList); + { symbols } + procedure appendsym(list:TAsmList;sym:tsym); + procedure beforeappendsym(list:TAsmList;sym:tsym);virtual; + procedure afterappendsym(list:TAsmList;sym:tsym);virtual; + procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);virtual; + procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);virtual; + procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);virtual; + procedure appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);virtual; + procedure appendsym_unit(list:TAsmList;sym:tunitsym);virtual; + procedure appendsym_const(list:TAsmList;sym:tconstsym);virtual; + procedure appendsym_type(list:TAsmList;sym:ttypesym);virtual; + procedure appendsym_label(list:TAsmList;sym:tlabelsym);virtual; + procedure appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);virtual; + procedure appendsym_property(list:TAsmList;sym:tpropertysym);virtual; + { symtable } + procedure write_symtable_parasyms(list:TAsmList;paras: tparalist); + procedure write_symtable_syms(list:TAsmList;st:TSymtable); + procedure write_symtable_defs(list:TAsmList;st:TSymtable); + procedure write_symtable_procdefs(list:TAsmList;st:TSymtable); + procedure reset_unit_type_info; + procedure write_used_unit_type_info(list:TAsmList;hp:tmodule); + public + constructor Create;virtual; + procedure inserttypeinfo;virtual; + procedure insertmoduleinfo;virtual; + procedure insertlineinfo(list:TAsmList);virtual; + procedure referencesections(list:TAsmList);virtual; + end; + TDebugInfoClass=class of TDebugInfo; + + var + CDebugInfo : array[tdbg] of TDebugInfoClass; + current_debuginfo : tdebuginfo; + + procedure InitDebugInfo(hp:tmodule); + procedure DoneDebugInfo(hp:tmodule); + procedure RegisterDebugInfo(const r:tdbginfo;c:TDebugInfoClass); + + +implementation + + uses + cutils, + verbose; + + + constructor TDebugInfo.Create; + begin + end; + + + procedure TDebugInfo.insertmoduleinfo; + begin + end; + + + procedure TDebugInfo.inserttypeinfo; + begin + end; + + + procedure TDebugInfo.insertlineinfo(list:TAsmList); + begin + end; + + + procedure TDebugInfo.referencesections(list:TAsmList); + begin + end; + + +{************************************** + Definition +**************************************} + + procedure TDebugInfo.appendprocdef(list:TAsmList;def:tprocdef); + begin + end; + + + procedure TDebugInfo.beforeappenddef(list:TAsmList;def:tdef); + begin + end; + + + procedure TDebugInfo.afterappenddef(list:TAsmList;def:tdef); + begin + end; + + + procedure TDebugInfo.appenddef_ord(list:TAsmList;def:torddef); + begin + end; + + + procedure TDebugInfo.appenddef_float(list:TAsmList;def:tfloatdef); + begin + end; + + + procedure TDebugInfo.appenddef_formal(list:TAsmList;def: tformaldef); + begin + end; + + + procedure TDebugInfo.appenddef_undefined(list:TAsmList;def: tundefineddef); + begin + end; + + + procedure TDebugInfo.appenddef_set(list:TAsmList;def: tsetdef); + begin + end; + + + procedure TDebugInfo.appenddef_object(list:TAsmList;def: tobjectdef); + begin + end; + + + procedure TDebugInfo.appenddef_classref(list:TAsmList;def: tclassrefdef); + begin + appenddef_pointer(list,tpointerdef(pvmttype)); + end; + + + procedure TDebugInfo.appenddef_variant(list:TAsmList;def: tvariantdef); + begin + end; + + + procedure TDebugInfo.appenddef_enum(list:TAsmList;def:tenumdef); + begin + end; + + + procedure TDebugInfo.appenddef_file(list:TAsmList;def: tfiledef); + begin + end; + + + procedure TDebugInfo.appenddef_array(list:TAsmList;def:tarraydef); + begin + end; + + + procedure TDebugInfo.appenddef_record(list:TAsmList;def:trecorddef); + begin + end; + + + procedure TDebugInfo.appenddef_pointer(list:TAsmList;def:tpointerdef); + begin + end; + + + procedure TDebugInfo.appenddef_string(list:TAsmList;def:tstringdef); + begin + end; + + + procedure TDebugInfo.appenddef_procvar(list:TAsmList;def:tprocvardef); + begin + end; + + + procedure TDebugInfo.appenddef(list:TAsmList;def:tdef); + begin + if (def.dbg_state in [dbg_state_writing,dbg_state_written]) then + exit; + { never write generic template defs } + if df_generic in def.defoptions then + begin + def.dbg_state:=dbg_state_written; + exit; + end; + { to avoid infinite loops } + def.dbg_state := dbg_state_writing; + beforeappenddef(list,def); + { queued defs have to be written later } + if (def.dbg_state=dbg_state_queued) then + exit; + case def.typ of + stringdef : + appenddef_string(list,tstringdef(def)); + enumdef : + appenddef_enum(list,tenumdef(def)); + orddef : + appenddef_ord(list,torddef(def)); + pointerdef : + appenddef_pointer(list,tpointerdef(def)); + floatdef : + appenddef_float(list,tfloatdef(def)); + filedef : + appenddef_file(list,tfiledef(def)); + recorddef : + appenddef_record(list,trecorddef(def)); + variantdef : + appenddef_variant(list,tvariantdef(def)); + classrefdef : + appenddef_classref(list,tclassrefdef(def)); + setdef : + appenddef_set(list,tsetdef(def)); + formaldef : + appenddef_formal(list,tformaldef(def)); + arraydef : + appenddef_array(list,tarraydef(def)); + procvardef : + appenddef_procvar(list,tprocvardef(def)); + objectdef : + appenddef_object(list,tobjectdef(def)); + undefineddef : + appenddef_undefined(list,tundefineddef(def)); + procdef : + begin + { procdefs are already written in a separate step. procdef + support in appenddef is only needed for beforeappenddef to + write all local type defs } + end; + else + internalerror(200601281); + end; + afterappenddef(list,def); + def.dbg_state := dbg_state_written; + end; + + + procedure TDebugInfo.write_remaining_defs_to_write(list:TAsmList); + var + n : integer; + looplist, + templist: TFPObjectList; + def : tdef; + begin + templist := TFPObjectList.Create(False); + looplist := deftowritelist; + while looplist.count > 0 do + begin + deftowritelist := templist; + for n := 0 to looplist.count - 1 do + begin + def := tdef(looplist[n]); + case def.dbg_state of + dbg_state_written: + continue; + dbg_state_writing: + internalerror(200610052); + dbg_state_unused: + internalerror(200610053); + dbg_state_used: + appenddef(list,def); + else + internalerror(200610054); + end; + end; + looplist.clear; + templist := looplist; + looplist := deftowritelist; + end; + templist.free; + end; + + +{************************************** + Symbols +**************************************} + + procedure TDebugInfo.beforeappendsym(list:TAsmList;sym:tsym); + begin + end; + + + procedure TDebugInfo.afterappendsym(list:TAsmList;sym:tsym); + begin + end; + + + procedure TDebugInfo.appendsym_staticvar(list:TAsmList;sym:tstaticvarsym); + begin + end; + + + procedure TDebugInfo.appendsym_paravar(list:TAsmList;sym: tparavarsym); + begin + end; + + + procedure TDebugInfo.appendsym_localvar(list:TAsmList;sym: tlocalvarsym); + begin + end; + + + procedure TDebugInfo.appendsym_fieldvar(list:TAsmList;sym: tfieldvarsym); + begin + end; + + + procedure TDebugInfo.appendsym_const(list:TAsmList;sym:tconstsym); + begin + end; + + + procedure TDebugInfo.appendsym_label(list:TAsmList;sym: tlabelsym); + begin + end; + + + procedure TDebugInfo.appendsym_property(list:TAsmList;sym: tpropertysym); + begin + end; + + + procedure TDebugInfo.appendsym_type(list:TAsmList;sym: ttypesym); + begin + end; + + + procedure TDebugInfo.appendsym_unit(list:TAsmList;sym: tunitsym); + begin + end; + + + procedure TDebugInfo.appendsym_absolute(list:TAsmList;sym:tabsolutevarsym); + begin + end; + + + procedure TDebugInfo.appendsym(list:TAsmList;sym:tsym); + begin + if sym.isdbgwritten then + exit; + beforeappendsym(list,sym); + case sym.typ of + staticvarsym : + appendsym_staticvar(list,tstaticvarsym(sym)); + unitsym: + appendsym_unit(list,tunitsym(sym)); + labelsym : + appendsym_label(list,tlabelsym(sym)); + localvarsym : + appendsym_localvar(list,tlocalvarsym(sym)); + paravarsym : + appendsym_paravar(list,tparavarsym(sym)); + constsym : + appendsym_const(list,tconstsym(sym)); + typesym : + appendsym_type(list,ttypesym(sym)); + enumsym : + { ignore enum syms, they are written by the owner } + ; + syssym : + { ignore sys syms, they are only of internal use } + ; + procsym : + { ignore proc syms, they are written by procdefs } + ; + absolutevarsym : + appendsym_absolute(list,tabsolutevarsym(sym)); + propertysym : + appendsym_property(list,tpropertysym(sym)); + namespacesym : + { ignore namespace syms, they are only of internal use } + ; + else + internalerror(200601242); + end; + afterappendsym(list,sym); + sym.isdbgwritten:=true; + end; + + +{************************************** + Symtables +**************************************} + + procedure TDebugInfo.write_symtable_defs(list:TAsmList;st:TSymtable); + var + def : tdef; + i : longint; + nonewadded : 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; + repeat + nonewadded:=true; + for i:=0 to st.DefList.Count-1 do + begin + def:=tdef(st.DefList[i]); + if (def.dbg_state in [dbg_state_used,dbg_state_queued]) then + begin + appenddef(list,def); + nonewadded:=false; + end; + end; + until nonewadded; + 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 TDebugInfo.write_symtable_parasyms(list:TAsmList;paras: tparalist); + var + i : longint; + sym : tsym; + begin + for i:=0 to paras.Count-1 do + begin + sym:=tsym(paras[i]); + if (sym.visibility<>vis_hidden) then + begin + appendsym(list,sym); + { if we ever write this procdef again for some reason (this + can happen with DWARF), then we want to write all the + parasyms again as well. } + sym.isdbgwritten:=false; + end; + end; + end; + + + procedure TDebugInfo.write_symtable_syms(list:TAsmList;st:TSymtable); + var + i : longint; + sym : 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; + for i:=0 to st.SymList.Count-1 do + begin + sym:=tsym(st.SymList[i]); + if (sym.visibility<>vis_hidden) and + (not sym.isdbgwritten) then + appendsym(list,sym); + 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; + + + procedure TDebugInfo.write_symtable_procdefs(list:TAsmList;st:TSymtable); + var + i : longint; + def : tdef; + begin + for i:=0 to st.DefList.Count-1 do + begin + def:=tdef(st.DefList[i]); + case def.typ of + procdef : + begin + appendprocdef(list,tprocdef(def)); + if assigned(tprocdef(def).localst) then + write_symtable_procdefs(list,tprocdef(def).localst); + end; + objectdef,recorddef : + begin + write_symtable_procdefs(list,tabstractrecorddef(def).symtable); + end; + end; + end; + end; + + + procedure TDebugInfo.reset_unit_type_info; + var + hp : tmodule; + begin + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + hp.is_dbginfo_written:=false; + hp:=tmodule(hp.next); + end; + end; + + + procedure TDebugInfo.write_used_unit_type_info(list:TAsmList;hp:tmodule); + var + pu : tused_unit; + begin + pu:=tused_unit(hp.used_units.first); + while assigned(pu) do + begin + if not pu.u.is_dbginfo_written then + begin + { prevent infinte loop for circular dependencies } + pu.u.is_dbginfo_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; + + +{**************************************************************************** + Init / Done +****************************************************************************} + + procedure InitDebugInfo(hp:tmodule); + begin + if not assigned(CDebugInfo[target_dbg.id]) then + begin + Comment(V_Fatal,'cg_f_debuginfo_output_not_supported'); + exit; + end; + hp.DebugInfo:=CDebugInfo[target_dbg.id].Create; + end; + + + procedure DoneDebugInfo(hp:tmodule); + begin + if assigned(hp.DebugInfo) then + begin + hp.DebugInfo.Free; + hp.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. diff --git a/closures/compiler/dbgdwarf.pas b/closures/compiler/dbgdwarf.pas new file mode 100644 index 0000000000..797a71db01 --- /dev/null +++ b/closures/compiler/dbgdwarf.pas @@ -0,0 +1,4139 @@ +{ + Copyright (c) 2003-2006 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. + + **************************************************************************** +} +{ + This units contains support for DWARF debug info generation. + + Currently a lot of code looks like being mergable with dbgstabs. This might + change however when improved dwarf info is generated, so the stuff shouldn't be + merged yet. (FK) + + The easiest way to debug dwarf debug info generation is the usage of + readelf --debug-dump <executable> + This works only with elf targets though. + + There is a similar utility called dwarfdump which is not elf-specific and + which has been ported to most systems. +} +unit dbgdwarf; + +{$i fpcdefs.inc} + +interface + + uses + cclasses,globtype, + aasmbase,aasmtai,aasmdata, + symbase,symconst,symtype,symdef,symsym, + finput, + DbgBase; + + type + { Tag names and codes. } + tdwarf_tag = (DW_TAG_padding := $00,DW_TAG_array_type := $01, + DW_TAG_class_type := $02,DW_TAG_entry_point := $03, + DW_TAG_enumeration_type := $04,DW_TAG_formal_parameter := $05, + DW_TAG_imported_declaration := $08,DW_TAG_label := $0a, + DW_TAG_lexical_block := $0b,DW_TAG_member := $0d, + DW_TAG_pointer_type := $0f,DW_TAG_reference_type := $10, + DW_TAG_compile_unit := $11,DW_TAG_stringtypee := $12, + DW_TAG_structure_type := $13,DW_TAG_subroutine_type := $15, + DW_TAG_typedef := $16,DW_TAG_union_type := $17, + DW_TAG_unspecified_parameters := $18, + DW_TAG_variant := $19,DW_TAG_common_block := $1a, + DW_TAG_common_inclusion := $1b,DW_TAG_inheritance := $1c, + DW_TAG_inlined_subroutine := $1d,DW_TAG_module := $1e, + DW_TAG_ptr_to_member_type := $1f,DW_TAG_set_type := $20, + DW_TAG_subrange_type := $21,DW_TAG_with_stmt := $22, + DW_TAG_access_declaration := $23,DW_TAG_base_type := $24, + DW_TAG_catch_block := $25,DW_TAG_const_type := $26, + DW_TAG_constant := $27,DW_TAG_enumerator := $28, + DW_TAG_file_type := $29,DW_TAG_friend := $2a, + DW_TAG_namelist := $2b,DW_TAG_namelist_item := $2c, + DW_TAG_packed_type := $2d,DW_TAG_subprogram := $2e, + DW_TAG_template_type_param := $2f,DW_TAG_template_value_param := $30, + DW_TAG_thrown_type := $31,DW_TAG_try_block := $32, + DW_TAG_variant_part := $33,DW_TAG_variable := $34, + DW_TAG_volatile_type := $35, + { DWARF 3. } + DW_TAG_dwarf_procedure := $36, + DW_TAG_restrict_type := $37,DW_TAG_interface_type := $38, + DW_TAG_namespace := $39,DW_TAG_imported_module := $3a, + DW_TAG_unspecified_type := $3b,DW_TAG_partial_unit := $3c, + DW_TAG_imported_unit := $3d, + DW_TAG_condition := $3f, + DW_TAG_shared_type := $40, + + { DWARF 4 } + DW_TAG_type_unit := $41, + DW_TAG_rvalue_reference_type := $42, + DW_TAG_template_alias := $43, + + + { SGI/MIPS Extensions. } + DW_TAG_MIPS_loop := $4081, + + { HP extensions. See: ftp://ftp.hp.com/pub/lang/tools/WDB/wdb-4.0.tar.gz . } + DW_TAG_HP_array_descriptor := $4090, + + { GNU extensions. } + { For FORTRAN 77 and Fortran 90. } + DW_TAG_format_label := $4101, + { For C++. } + DW_TAG_function_template := $4102,DW_TAG_class_template := $4103, + + DW_TAG_GNU_BINCL := $4104,DW_TAG_GNU_EINCL := $4105, + { Extensions for UPC. See: http://upc.gwu.edu/~upc. } + DW_TAG_upc_shared_type := $8765,DW_TAG_upc_strict_type := $8766, + DW_TAG_upc_relaxed_type := $8767, + + { PGI (STMicroelectronics) extensions. No documentation available. } + DW_TAG_PGI_kanji_type := $A000, + DW_TAG_PGI_interface_block := $A020 + ); + +{$notes off} + { Attribute names and codes. } + tdwarf_attribute = (DW_AT_sibling := $01,DW_AT_location := $02, + DW_AT_name := $03,DW_AT_ordering := $09, + DW_AT_subscr_data := $0a,DW_AT_byte_size := $0b, + DW_AT_bit_offset := $0c,DW_AT_bit_size := $0d, + DW_AT_element_list := $0f,DW_AT_stmt_list := $10, + DW_AT_low_pc := $11,DW_AT_high_pc := $12, + DW_AT_language := $13,DW_AT_member := $14, + DW_AT_discr := $15,DW_AT_discr_value := $16, + DW_AT_visibility := $17,DW_AT_import := $18, + DW_AT_string_length := $19,DW_AT_common_reference := $1a, + DW_AT_comp_dir := $1b,DW_AT_const_value := $1c, + DW_AT_containing_type := $1d,DW_AT_default_value := $1e, + DW_AT_inline := $20,DW_AT_is_optional := $21, + DW_AT_lower_bound := $22,DW_AT_producer := $25, + DW_AT_prototyped := $27,DW_AT_return_addr := $2a, + DW_AT_start_scope := $2c,DW_AT_stride_size := $2e, + DW_AT_upper_bound := $2f,DW_AT_abstract_origin := $31, + DW_AT_accessibility := $32,DW_AT_address_class := $33, + DW_AT_artificial := $34,DW_AT_base_types := $35, + DW_AT_calling_convention := $36,DW_AT_count := $37, + DW_AT_data_member_location := $38,DW_AT_decl_column := $39, + DW_AT_decl_file := $3a,DW_AT_decl_line := $3b, + DW_AT_declaration := $3c,DW_AT_discr_list := $3d, + DW_AT_encoding := $3e,DW_AT_external := $3f, + DW_AT_frame_base := $40,DW_AT_friend := $41, + DW_AT_identifier_case := $42,DW_AT_macro_info := $43, + DW_AT_namelist_items := $44,DW_AT_priority := $45, + DW_AT_segment := $46,DW_AT_specification := $47, + DW_AT_static_link := $48,DW_AT_type := $49, + DW_AT_use_location := $4a,DW_AT_variable_parameter := $4b, + DW_AT_virtuality := $4c,DW_AT_vtable_elem_location := $4d, + + { DWARF 3 values. } + DW_AT_allocated := $4e,DW_AT_associated := $4f, + DW_AT_data_location := $50,DW_AT_byte_stride := $51, + DW_AT_entry_pc := $52,DW_AT_use_UTF8 := $53, + DW_AT_extension := $54,DW_AT_ranges := $55, + DW_AT_trampoline := $56,DW_AT_call_column := $57, + DW_AT_call_file := $58,DW_AT_call_line := $59, + DW_AT_description := $5a, { string } + DW_AT_binary_scale := $5b, { constant } + DW_AT_decimal_scale := $5c, { constant } + DW_AT_small := $5d, { reference } + DW_AT_decimal_sign := $5e, { constant } + DW_AT_digit_count := $5f, { constant } + DW_AT_picture_string := $60, { string } + DW_AT_mutable := $61, { flag } + DW_AT_threads_scaled := $62, { flag } + DW_AT_explicit := $63, { flag } + DW_AT_object_pointer := $64, { reference } + DW_AT_endianity := $65, { constant } + DW_AT_elemental := $66, { flag } + DW_AT_pure := $67, { flag } + DW_AT_recursive := $68, { flag } + + { DWARF 4 values } + DW_AT_signature := $69, { reference } + DW_AT_main_subprogram := $6a, { flag } + DW_AT_data_bit_offset := $6b, { constant } + DW_AT_const_expr := $6c, { flag } + DW_AT_enum_class := $6d, { flag } + DW_AT_linkage_name := $6e, { string } + + + { SGI/MIPS extensions. } + DW_AT_MIPS_fde := $2001,DW_AT_MIPS_loop_begin := $2002, + DW_AT_MIPS_tail_loop_begin := $2003,DW_AT_MIPS_epilog_begin := $2004, + DW_AT_MIPS_loop_unroll_factor := $2005, + DW_AT_MIPS_software_pipeline_depth := $2006, + DW_AT_MIPS_linkage_name := $2007,DW_AT_MIPS_stride := $2008, + DW_AT_MIPS_abstract_name := $2009,DW_AT_MIPS_clone_origin := $200a, + DW_AT_MIPS_has_inlines := $200b, + + { HP extensions. } + DW_AT_HP_block_index := $2000, + DW_AT_HP_unmodifiable := $2001,DW_AT_HP_actuals_stmt_list := $2010, + DW_AT_HP_proc_per_section := $2011,DW_AT_HP_raw_data_ptr := $2012, + DW_AT_HP_pass_by_reference := $2013,DW_AT_HP_opt_level := $2014, + DW_AT_HP_prof_version_id := $2015,DW_AT_HP_opt_flags := $2016, + DW_AT_HP_cold_region_low_pc := $2017,DW_AT_HP_cold_region_high_pc := $2018, + DW_AT_HP_all_variables_modifiable := $2019, + DW_AT_HP_linkage_name := $201a,DW_AT_HP_prof_flags := $201b, + + { GNU extensions. } + DW_AT_sf_names := $2101,DW_AT_src_info := $2102, + DW_AT_mac_info := $2103,DW_AT_src_coords := $2104, + DW_AT_body_begin := $2105,DW_AT_body_end := $2106, + DW_AT_GNU_vector := $2107, + + { VMS extensions. } + DW_AT_VMS_rtnbeg_pd_address := $2201, + + { UPC extension. } + DW_AT_upc_threads_scaled := $3210, + + { PGI (STMicroelectronics) extensions. } + DW_AT_PGI_lbase := $3a00, + DW_AT_PGI_soffset := $3a01,DW_AT_PGI_lstride := $3a02, + + { Apple extensions } + DW_AT_APPLE_optimized := $3fe1, + DW_AT_APPLE_flags := $3fe2, + DW_AT_APPLE_major_runtime_vers := $3fe5, + DW_AT_APPLE_runtime_class := $3fe6 + ); +{$notes on} + + { Form names and codes. } + Tdwarf_form = (DW_FORM_addr := $01,DW_FORM_block2 := $03, + DW_FORM_block4 := $04,DW_FORM_data2 := $05, + DW_FORM_data4 := $06,DW_FORM_data8 := $07, + DW_FORM_string := $08,DW_FORM_block := $09, + DW_FORM_block1 := $0a,DW_FORM_data1 := $0b, + DW_FORM_flag := $0c,DW_FORM_sdata := $0d, + DW_FORM_strp := $0e,DW_FORM_udata := $0f, + DW_FORM_ref_addr := $10,DW_FORM_ref1 := $11, + DW_FORM_ref2 := $12,DW_FORM_ref4 := $13, + DW_FORM_ref8 := $14,DW_FORM_ref_udata := $15, + DW_FORM_indirect := $16, + + { DWARF 4 } + DW_FORM_sec_offset := $17, { lineptr, loclistptr, macptr, rangelistptr } + DW_FORM_exprloc := $18, { exprloc } + DW_FORM_flag_present := $19, { flag } + DW_FORM_ref_sig8 := $20 { reference } + ); + + TDwarfFile = record + Index: integer; + Name: PChar; + end; + + { flags for emitting variables/parameters } + tdwarfvarsymflag = + { force the sym to be emitted as a local variable regardless of its + type; used for "absolute" local variables referring to parameters. + } + (dvf_force_local_var + ); + tdwarfvarsymflags = set of tdwarfvarsymflag; + + pAbbrevSearchTreeItem = ^tAbbrevSearchTreeItem; + tAbbrevSearchTreeItem = record + value: QWord; + Abbrev: longint; + // When this item does not match the abbrev-value, look for it + // in the next SearchItem + SearchItem: pAbbrevSearchTreeItem; + // Next and prior item of the abbrev-section + NextItem: pAbbrevSearchTreeItem; + PriorItem: pAbbrevSearchTreeItem; + bit8: boolean; + end; + + { TDebugInfoDwarf } + + TDebugInfoDwarf = class(TDebugInfo) + private + currabbrevnumber : longint; + + { use this defs to create info for variants and file handles } + { unused (MWE) + filerecdef, + textrecdef : tdef; + } + + dirlist: TFPHashObjectList; + filesequence: Integer; + loclist: tdynamicarray; + asmline: TAsmList; + + // The current entry in dwarf_info with the link to the abbrev-section + dwarf_info_abbref_tai: tai_const; + // Empty start-item of the abbrev-searchtree + AbbrevSearchTree: pAbbrevSearchTreeItem; + // The current abbrev-item + CurrentSearchTreeItem: pAbbrevSearchTreeItem; + // Is true when the abbrev-section is newly created + NewAbbrev: boolean; + procedure StartAbbrevSearch; + procedure AddConstToAbbrev(Value: QWord; bit8:boolean=false); + procedure StartAbbrevSectionFromSearchtree; + procedure WriteSearchItemToAbbrevSection(SI: pAbbrevSearchTreeItem); + function FinishAbbrevSearch: longint; + + function def_dwarf_lab(def:tdef) : tasmsymbol; + function def_dwarf_ref_lab(def:tdef) : tasmsymbol; + function def_dwarf_class_struct_lab(def:tobjectdef) : tasmsymbol; + function get_file_index(afile: tinputfile): Integer; + function relative_dwarf_path(const s:tcmdstr):tcmdstr; + protected + // set if we should use 64bit headers (dwarf3 and up) + _use_64bit_headers: Boolean; + // set to ait_const32bit if use_64bit_headers is false, otherwise + // to ait_const64bit + offsetreltype, + offsetabstype : taiconst_type; + // set if we generated any lineinfo at all. If not, we have to terminate + // when insertmoduleinfo is called. + generated_lineinfo: boolean; + + vardatadef: trecorddef; + + procedure set_use_64bit_headers(state: boolean); + property use_64bit_headers: Boolean read _use_64bit_headers write set_use_64bit_headers; + + procedure set_def_dwarf_labs(def:tdef); + + { Convenience version of the method below, so the compiler creates the + tvarrec for us (must only pass one element in the last parameter). } + procedure append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const values: array of const); + procedure append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const value: tvarrec); + procedure append_entry(tag : tdwarf_tag;has_children : boolean;data : array of const); + procedure append_block1(attr: tdwarf_attribute; size: aint); + procedure append_labelentry(attr : tdwarf_attribute;sym : tasmsymbol); + procedure append_labelentry_addr_ref(attr : tdwarf_attribute;sym : tasmsymbol); virtual; + procedure append_labelentry_ref(attr : tdwarf_attribute;sym : tasmsymbol); + procedure append_labelentry_dataptr_abs(attr : tdwarf_attribute;sym : tasmsymbol); + procedure append_labelentry_dataptr_rel(attr : tdwarf_attribute;sym,endsym : tasmsymbol); + procedure append_labelentry_dataptr_common(attr : tdwarf_attribute); + + procedure beforeappenddef(list:TAsmList;def:tdef);override; + procedure afterappenddef(list:TAsmList;def:tdef);override; + procedure appenddef_ord(list:TAsmList;def:torddef);override; + procedure appenddef_float(list:TAsmList;def:tfloatdef);override; + procedure appenddef_enum(list:TAsmList;def:tenumdef);override; + procedure appenddef_array(list:TAsmList;def:tarraydef);override; + procedure appenddef_record_named(list:TAsmList;def:trecorddef;const name: shortstring); + procedure appenddef_record(list:TAsmList;def:trecorddef);override; + procedure appenddef_pointer(list:TAsmList;def:tpointerdef);override; + procedure appenddef_string(list:TAsmList;def:tstringdef);override; + procedure appenddef_procvar(list:TAsmList;def:tprocvardef);override; + procedure appendprocdef(list:TAsmList;def:tprocdef);override; + + function get_symlist_sym_offset(symlist: ppropaccesslistitem; out sym: tabstractvarsym; out offset: pint): boolean; + procedure appendsym_var(list:TAsmList;sym:tabstractnormalvarsym); + procedure appendsym_var_with_name_type_offset(list:TAsmList; sym:tabstractnormalvarsym; const name: string; def: tdef; offset: pint; const flags: tdwarfvarsymflags); + { used for fields and properties mapped to fields } + procedure appendsym_fieldvar_with_name_offset(list:TAsmList;sym: tfieldvarsym;const name: string; def: tdef; offset: pint); + procedure appendsym_const_member(list:TAsmList;sym:tconstsym;ismember:boolean); + + procedure beforeappendsym(list:TAsmList;sym:tsym);override; + procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override; + procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override; + procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);override; + procedure appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);override; + procedure appendsym_const(list:TAsmList;sym:tconstsym);override; + procedure appendsym_type(list:TAsmList;sym:ttypesym);override; + procedure appendsym_label(list:TAsmList;sym:tlabelsym);override; + procedure appendsym_absolute(list:TAsmList;sym:tabsolutevarsym);override; + procedure appendsym_property(list:TAsmList;sym:tpropertysym);override; + + function symdebugname(sym:tsym): String; virtual; + function symname(sym:tsym): String; virtual; + procedure append_visibility(vis: tvisibility); + + procedure enum_membersyms_callback(p:TObject;arg:pointer); + + procedure finish_children; + procedure finish_entry; + procedure finish_lineinfo; + public + constructor Create;override; + destructor Destroy;override; + procedure insertmoduleinfo;override; + procedure inserttypeinfo;override; + procedure referencesections(list:TAsmList);override; + procedure insertlineinfo(list:TAsmList);override; + function dwarf_version: Word; virtual; abstract; + end; + + { TDebugInfoDwarf2 } + + TDebugInfoDwarf2 = class(TDebugInfoDwarf) + private + protected + procedure appenddef_set_intern(list:TAsmList;def:tsetdef; force_tag_set: boolean); + procedure append_object_struct(def: tobjectdef; const createlabel: boolean; const objectname: PShortString); + + procedure appenddef_file(list:TAsmList;def:tfiledef); override; + procedure appenddef_formal(list:TAsmList;def:tformaldef); override; + procedure appenddef_object(list:TAsmList;def:tobjectdef); override; + procedure appenddef_set(list:TAsmList;def:tsetdef); override; + procedure appenddef_undefined(list:TAsmList;def:tundefineddef); override; + procedure appenddef_variant(list:TAsmList;def:tvariantdef); override; + public + function dwarf_version: Word; override; + end; + + { TDebugInfoDwarf3 } + + TDebugInfoDwarf3 = class(TDebugInfoDwarf2) + private + protected + procedure append_labelentry_addr_ref(attr : tdwarf_attribute;sym : tasmsymbol); override; + procedure appenddef_array(list:TAsmList;def:tarraydef); override; + procedure appenddef_string(list:TAsmList;def:tstringdef);override; + procedure appenddef_file(list:TAsmList;def:tfiledef); override; + procedure appenddef_formal(list:TAsmList;def:tformaldef); override; + procedure appenddef_object(list:TAsmList;def:tobjectdef); override; + procedure appenddef_set(list:TAsmList;def: tsetdef); override; + procedure appenddef_undefined(list:TAsmList;def:tundefineddef); override; + procedure appenddef_variant(list:TAsmList;def:tvariantdef); override; + + function symdebugname(sym:tsym): String; override; + public + function dwarf_version: Word; override; + end; + + + TDebugInfoDwarf4 = class(TDebugInfoDwarf3) + public + function dwarf_version: Word; override; + end; + + +implementation + + uses + sysutils,cutils,cfileutl,constexp, + version,globals,verbose,systems, + cpubase,cpuinfo,cgbase,paramgr, + fmodule, + defutil,symtable,ppu + ; + + const + LINE_BASE = 1; + OPCODE_BASE = 13; + + const + DW_TAG_lo_user = $4080; + DW_TAG_hi_user = $ffff; + + { Flag that tells whether entry has a child or not. } + DW_children_no = 0; + DW_children_yes = 1; + + const + { Implementation-defined range start. } + DW_AT_lo_user = $2000; + { Implementation-defined range end. } + DW_AT_hi_user = $3ff0; + + type + { Source language names and codes. } + tdwarf_source_language = (DW_LANG_C89 := $0001,DW_LANG_C := $0002,DW_LANG_Ada83 := $0003, + DW_LANG_C_plus_plus := $0004,DW_LANG_Cobol74 := $0005, + DW_LANG_Cobol85 := $0006,DW_LANG_Fortran77 := $0007, + DW_LANG_Fortran90 := $0008,DW_LANG_Pascal83 := $0009, + DW_LANG_Modula2 := $000a,DW_LANG_Java := $000b, + + { DWARF 3. } + DW_LANG_C99 := $000c,DW_LANG_Ada95 := $000d, + DW_LANG_Fortran95 := $000e, + + { Objective-C } + DW_LANG_ObjC := $10, + + { MIPS. } + DW_LANG_Mips_Assembler := $8001, + + { UPC. } + DW_LANG_Upc := $8765 + ); + + const + { Implementation-defined range start. } + DW_LANG_lo_user = $8000; + + { Implementation-defined range start. } + DW_LANG_hi_user = $ffff; + + type + { Names and codes for macro information. } + tdwarf_macinfo_record_type = (DW_MACINFO_define := 1,DW_MACINFO_undef := 2, + DW_MACINFO_start_file := 3,DW_MACINFO_end_file := 4, + DW_MACINFO_vendor_ext := 255); + + + type + { Type encodings. } + Tdwarf_type = (DW_ATE_void := $0,DW_ATE_address := $1, + DW_ATE_boolean := $2,DW_ATE_complex_float := $3, + DW_ATE_float := $4,DW_ATE_signed := $5, + DW_ATE_signed_char := $6,DW_ATE_unsigned := $7, + DW_ATE_unsigned_char := $8,DW_ATE_imaginary_float := $9, + + { HP extensions. } + DW_ATE_HP_float80 := $80,DW_ATE_HP_complex_float80 := $81, + DW_ATE_HP_float128 := $82,DW_ATE_HP_complex_float128 := $83, + DW_ATE_HP_floathpintel := $84,DW_ATE_HP_imaginary_float80 := $85, + DW_ATE_HP_imaginary_float128 := $86 + ); + + + const + DW_ATE_lo_user = $80; + DW_ATE_hi_user = $ff; + + + type + Tdwarf_array_dim_ordering = (DW_ORD_row_major := 0,DW_ORD_col_major := 1 + ); + + { Access attribute. } + Tdwarf_access_attribute = (DW_ACCESS_public := 1,DW_ACCESS_protected := 2, + DW_ACCESS_private := 3); + + { Visibility. } + Tdwarf_visibility_attribute = (DW_VIS_local := 1,DW_VIS_exported := 2, + DW_VIS_qualified := 3); + + { Virtuality. } + Tdwarf_virtuality_attribute = (DW_VIRTUALITY_none := 0,DW_VIRTUALITY_virtual := 1, + DW_VIRTUALITY_pure_virtual := 2); + + { Case sensitivity. } + Tdwarf_id_case = (DW_ID_case_sensitive := 0,DW_ID_up_case := 1, + DW_ID_down_case := 2,DW_ID_case_insensitive := 3 + ); + + { Calling convention. } + Tdwarf_calling_convention = (DW_CC_normal := $1,DW_CC_program := $2, + DW_CC_nocall := $3,DW_CC_GNU_renesas_sh := $40, DW_CC_GNU_borland_fastcall_i386 := $41 + ); +{$notes off} + { Location atom names and codes. } + Tdwarf_location_atom = (DW_OP_addr := $03,DW_OP_deref := $06,DW_OP_const1u := $08, + DW_OP_const1s := $09,DW_OP_const2u := $0a, + DW_OP_const2s := $0b,DW_OP_const4u := $0c, + DW_OP_const4s := $0d,DW_OP_const8u := $0e, + DW_OP_const8s := $0f,DW_OP_constu := $10, + DW_OP_consts := $11,DW_OP_dup := $12,DW_OP_drop := $13, + DW_OP_over := $14,DW_OP_pick := $15,DW_OP_swap := $16, + DW_OP_rot := $17,DW_OP_xderef := $18,DW_OP_abs := $19, + DW_OP_and := $1a,DW_OP_div := $1b,DW_OP_minus := $1c, + DW_OP_mod := $1d,DW_OP_mul := $1e,DW_OP_neg := $1f, + DW_OP_not := $20,DW_OP_or := $21,DW_OP_plus := $22, + DW_OP_plus_uconst := $23,DW_OP_shl := $24, + DW_OP_shr := $25,DW_OP_shra := $26,DW_OP_xor := $27, + DW_OP_bra := $28,DW_OP_eq := $29,DW_OP_ge := $2a, + DW_OP_gt := $2b,DW_OP_le := $2c,DW_OP_lt := $2d, + DW_OP_ne := $2e,DW_OP_skip := $2f,DW_OP_lit0 := $30, + DW_OP_lit1 := $31,DW_OP_lit2 := $32,DW_OP_lit3 := $33, + DW_OP_lit4 := $34,DW_OP_lit5 := $35,DW_OP_lit6 := $36, + DW_OP_lit7 := $37,DW_OP_lit8 := $38,DW_OP_lit9 := $39, + DW_OP_lit10 := $3a,DW_OP_lit11 := $3b, + DW_OP_lit12 := $3c,DW_OP_lit13 := $3d, + DW_OP_lit14 := $3e,DW_OP_lit15 := $3f, + DW_OP_lit16 := $40,DW_OP_lit17 := $41, + DW_OP_lit18 := $42,DW_OP_lit19 := $43, + DW_OP_lit20 := $44,DW_OP_lit21 := $45, + DW_OP_lit22 := $46,DW_OP_lit23 := $47, + DW_OP_lit24 := $48,DW_OP_lit25 := $49, + DW_OP_lit26 := $4a,DW_OP_lit27 := $4b, + DW_OP_lit28 := $4c,DW_OP_lit29 := $4d, + DW_OP_lit30 := $4e,DW_OP_lit31 := $4f, + DW_OP_reg0 := $50,DW_OP_reg1 := $51,DW_OP_reg2 := $52, + DW_OP_reg3 := $53,DW_OP_reg4 := $54,DW_OP_reg5 := $55, + DW_OP_reg6 := $56,DW_OP_reg7 := $57,DW_OP_reg8 := $58, + DW_OP_reg9 := $59,DW_OP_reg10 := $5a,DW_OP_reg11 := $5b, + DW_OP_reg12 := $5c,DW_OP_reg13 := $5d, + DW_OP_reg14 := $5e,DW_OP_reg15 := $5f, + DW_OP_reg16 := $60,DW_OP_reg17 := $61, + DW_OP_reg18 := $62,DW_OP_reg19 := $63, + DW_OP_reg20 := $64,DW_OP_reg21 := $65, + DW_OP_reg22 := $66,DW_OP_reg23 := $67, + DW_OP_reg24 := $68,DW_OP_reg25 := $69, + DW_OP_reg26 := $6a,DW_OP_reg27 := $6b, + DW_OP_reg28 := $6c,DW_OP_reg29 := $6d, + DW_OP_reg30 := $6e,DW_OP_reg31 := $6f, + DW_OP_breg0 := $70,DW_OP_breg1 := $71, + DW_OP_breg2 := $72,DW_OP_breg3 := $73, + DW_OP_breg4 := $74,DW_OP_breg5 := $75, + DW_OP_breg6 := $76,DW_OP_breg7 := $77, + DW_OP_breg8 := $78,DW_OP_breg9 := $79, + DW_OP_breg10 := $7a,DW_OP_breg11 := $7b, + DW_OP_breg12 := $7c,DW_OP_breg13 := $7d, + DW_OP_breg14 := $7e,DW_OP_breg15 := $7f, + DW_OP_breg16 := $80,DW_OP_breg17 := $81, + DW_OP_breg18 := $82,DW_OP_breg19 := $83, + DW_OP_breg20 := $84,DW_OP_breg21 := $85, + DW_OP_breg22 := $86,DW_OP_breg23 := $87, + DW_OP_breg24 := $88,DW_OP_breg25 := $89, + DW_OP_breg26 := $8a,DW_OP_breg27 := $8b, + DW_OP_breg28 := $8c,DW_OP_breg29 := $8d, + DW_OP_breg30 := $8e,DW_OP_breg31 := $8f, + DW_OP_regx := $90,DW_OP_fbreg := $91,DW_OP_bregx := $92, + DW_OP_piece := $93,DW_OP_deref_size := $94, + DW_OP_xderef_size := $95,DW_OP_nop := $96, + + { DWARF 3 extensions. } + DW_OP_push_object_address := $97,DW_OP_call2 := $98, + DW_OP_call4 := $99,DW_OP_call_ref := $9a, + + { DWARF 4 extensions. } + DW_OP_implicit_value := $9e, DW_OP_stack_value := $9f, + + { GNU extensions. } + DW_OP_GNU_push_tls_address := $e0, + + { HP extensions. } + DW_OP_HP_unknown := $e0, + DW_OP_HP_is_value := $e1,DW_OP_HP_fltconst4 := $e2, + DW_OP_HP_fltconst8 := $e3,DW_OP_HP_mod_range := $e4, + DW_OP_HP_unmod_range := $e5,DW_OP_HP_tls := $e6 + ); +{$notes on} + + const + { Implementation-defined range start. } + DW_OP_lo_user = $e0; + { Implementation-defined range end. } + DW_OP_hi_user = $ff; + + + const + DW_LNS_extended_op = $00; + + { next copied from cfidwarf, need to go to something shared } + DW_LNS_copy = $01; + DW_LNS_advance_pc = $02; + DW_LNS_advance_line = $03; + DW_LNS_set_file = $04; + DW_LNS_set_column = $05; + DW_LNS_negate_stmt = $06; + DW_LNS_set_basic_block = $07; + DW_LNS_const_add_pc = $08; + + DW_LNS_fixed_advance_pc = $09; + DW_LNS_set_prologue_end = $0a; + DW_LNS_set_epilogue_begin = $0b; + DW_LNS_set_isa = $0c; + + DW_LNE_end_sequence = $01; + DW_LNE_set_address = $02; + DW_LNE_define_file = $03; + DW_LNE_lo_user = $80; + DW_LNE_hi_user = $ff; + + type + { TDirIndexItem } + + TDirIndexItem = class(TFPHashObject) + private + FFiles: TFPHashObjectList; + public + IndexNr : Integer; + constructor Create(AList:TFPHashObjectList;const AName: String; AIndex: Integer); + destructor Destroy;override; + property Files: TFPHashObjectList read FFiles; + end; + + { TFileIndexItem } + + TFileIndexItem = class(TFPHashObject) + private + FDirIndex: Integer; + public + IndexNr : Integer; + constructor Create(AList:TFPHashObjectList;const AName: String; ADirIndex, AIndex: Integer); + property DirIndex: Integer read FDirIndex; + end; + + +{**************************************************************************** + procs +****************************************************************************} + + function DirListSortCompare(AItem1, AItem2: Pointer): Integer; + begin + Result := TDirIndexItem(AItem1).IndexNr - TDirIndexItem(AItem2).IndexNr; + end; + + + function FileListSortCompare(AItem1, AItem2: Pointer): Integer; + begin + Result := TFileIndexItem(AItem1).IndexNr - TFileIndexItem(AItem2).IndexNr; + end; + + + function AllocateNewAiSearchItem: pAbbrevSearchTreeItem; + begin + new(result); + FillChar(result^,sizeof(result^),#0); + end; + + procedure FreeSearchItem(SI: pAbbrevSearchTreeItem); + begin + if assigned(SI^.NextItem) then + FreeSearchItem(SI^.NextItem); + if assigned(SI^.SearchItem) then + FreeSearchItem(SI^.SearchItem); + Dispose(SI); + end; + +{**************************************************************************** + TDirIndexItem +****************************************************************************} + + constructor TDirIndexItem.Create(AList:TFPHashObjectList;const AName: String; AIndex: Integer); + begin + inherited Create(AList,AName); + FFiles := TFPHashObjectList.Create; + IndexNr := AIndex; + end; + + + destructor TDirIndexItem.Destroy; + begin + FFiles.Free; + inherited Destroy; + end; + + +{**************************************************************************** + TFileIndexItem +****************************************************************************} + + constructor TFileIndexItem.Create(AList:TFPHashObjectList;const AName: String; ADirIndex, AIndex: Integer); + begin + inherited Create(AList,Aname); + FDirIndex := ADirIndex; + IndexNr := AIndex; + end; + + +{**************************************************************************** + TDebugInfoDwarf +****************************************************************************} + + procedure TDebugInfoDwarf.StartAbbrevSearch; + begin + CurrentSearchTreeItem:=AbbrevSearchTree; + end; + + + procedure TDebugInfoDwarf.WriteSearchItemToAbbrevSection(SI: pAbbrevSearchTreeItem); + begin + if SI^.bit8 then + current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.Create_8bit(SI^.value)) + else + current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.Create_uleb128bit(SI^.value)); + end; + + + procedure TDebugInfoDwarf.StartAbbrevSectionFromSearchtree; + + procedure AddCurrentAndPriorItemsToAbrev(SI: pAbbrevSearchTreeItem); + begin + if assigned(SI^.PriorItem) then + AddCurrentAndPriorItemsToAbrev(SI^.PriorItem); + WriteSearchItemToAbbrevSection(SI); + end; + + begin + NewAbbrev:=true; + inc(currabbrevnumber); + current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_comment.Create(strpnew('Abbrev '+tostr(currabbrevnumber)))); + current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_uleb128bit(currabbrevnumber)); + + if CurrentSearchTreeItem<>AbbrevSearchTree then + AddCurrentAndPriorItemsToAbrev(CurrentSearchTreeItem); + end; + + + function TDebugInfoDwarf.FinishAbbrevSearch: longint; + + procedure FinalizeAbbrevSection; + begin + current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0)); + current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0)); + CurrentSearchTreeItem^.Abbrev:=currabbrevnumber; + NewAbbrev := false; + end; + + begin + if NewAbbrev then + FinalizeAbbrevSection; + result := CurrentSearchTreeItem^.Abbrev; + if result=0 then + begin + // In this case the abbrev-section equals an existing longer abbrev section. + // So a new abbrev-section has to be made which ends on the current + // searchtree item + StartAbbrevSectionFromSearchtree; + FinalizeAbbrevSection; + result := CurrentSearchTreeItem^.Abbrev; + end; + end; + + + procedure TDebugInfoDwarf.AddConstToAbbrev(Value: QWord; bit8:boolean); + + procedure AddCurrentItemToAbbrev; + begin + CurrentSearchTreeItem^.value:=value; + CurrentSearchTreeItem^.bit8:=bit8; + WriteSearchItemToAbbrevSection(CurrentSearchTreeItem); + end; + + var si: pAbbrevSearchTreeItem; + begin + // Instead of adding this value directly to the ai-tree, search if an + // abbrev section with the same values already exist, and use the existing + // one or create one. + if NewAbbrev then + begin + // The current abbrev-section is new, so add the value to the abbrev-section + // and add it to the search-list. + CurrentSearchTreeItem^.NextItem:=AllocateNewAiSearchItem; + CurrentSearchTreeItem^.NextItem^.PriorItem:=CurrentSearchTreeItem; + CurrentSearchTreeItem := CurrentSearchTreeItem^.NextItem; + AddCurrentItemToAbbrev; + end + else + begin + // Search for the value which is added in the next sections of the + // searchtree for a match + si := CurrentSearchTreeItem^.NextItem; + while assigned(si) do + begin + if (SI^.value=Value) and (si^.bit8=bit8) then + begin + // If a match is found, set the current searchtree item to the next item + CurrentSearchTreeItem:=SI; + Exit; + end + else if si^.SearchItem=nil then + begin + // If no match is found, add a new item to the searchtree and write + // a new abbrev-section. + StartAbbrevSectionFromSearchtree; + + si^.SearchItem:=AllocateNewAiSearchItem; + if currentsearchtreeitem<>AbbrevSearchTree then + si^.SearchItem^.PriorItem:=CurrentSearchTreeItem; + CurrentSearchTreeItem := si^.SearchItem; + + AddCurrentItemToAbbrev; + Exit; + end; + Si := SI^.SearchItem; + end; + // The abbrev section we are looking for is longer than the one + // which is already in the search-tree. So expand the searchtree with + // the new value and write a new abbrev section + StartAbbrevSectionFromSearchtree; + + CurrentSearchTreeItem^.NextItem:=AllocateNewAiSearchItem; + if currentsearchtreeitem^.PriorItem<>AbbrevSearchTree then + CurrentSearchTreeItem^.NextItem^.PriorItem:=CurrentSearchTreeItem; + CurrentSearchTreeItem := CurrentSearchTreeItem^.NextItem; + + AddCurrentItemToAbbrev; + end; + end; + + + function TDebugInfoDwarf.relative_dwarf_path(const s:tcmdstr):tcmdstr; + begin + { Make a clean path for gdb. Remove trailing / and ./ prefixes and + use always a / } + result:=BsToSlash(ExcludeTrailingPathDelimiter(ExtractRelativePath(GetCurrentDir,FixFileName(ExpandFileName(s))))); + end; + + + procedure TDebugInfoDwarf.set_use_64bit_headers(state: boolean); + begin + _use_64bit_headers:=state; + if not(state) then + begin + if (target_info.system in systems_windows+systems_wince) then + offsetabstype:=aitconst_secrel32_symbol + else + offsetabstype:=aitconst_32bit; + if (target_info.system in systems_darwin) then + offsetreltype:=aitconst_darwin_dwarf_delta32 + else + offsetreltype:=aitconst_32bit; + end + else + begin + if (target_info.system in systems_darwin) then + offsetreltype:=aitconst_darwin_dwarf_delta64 + else + offsetreltype:=aitconst_64bit; + offsetabstype:=aitconst_64bit; + end; + end; + + + procedure TDebugInfoDwarf.set_def_dwarf_labs(def:tdef); + begin + { Keep track of used dwarf entries, this info is only useful for dwarf entries + referenced by the symbols. Definitions will always include all + required stabs } + if def.dbg_state=dbg_state_unused then + def.dbg_state:=dbg_state_used; + { Need a new label? } + if not assigned(def.dwarf_lab) then + begin + if not(tf_dwarf_only_local_labels in target_info.flags) then + begin + if (ds_dwarf_dbg_info_written in def.defstates) then + begin + if not assigned(def.typesym) then + internalerror(200610011); + def.dwarf_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym))); + def.dwarf_ref_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym))); + if is_class_or_interface_or_dispinterface(def) or is_objectpascal_helper(def) then + tobjectdef(def).dwarf_struct_lab:=current_asmdata.RefAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym))); + def.dbg_state:=dbg_state_written; + end + else + begin + { Create an exported DBG symbol if we are generating a def defined in the + globalsymtable of the current unit } + if assigned(def.typesym) and + (def.owner.symtabletype=globalsymtable) and + (def.owner.iscurrentunit) then + begin + def.dwarf_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG',def.owner,symname(def.typesym)),AB_GLOBAL,AT_DATA); + def.dwarf_ref_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBGREF',def.owner,symname(def.typesym)),AB_GLOBAL,AT_DATA); + if is_class_or_interface_or_dispinterface(def) or is_objectpascal_helper(def) then + tobjectdef(def).dwarf_struct_lab:=current_asmdata.DefineAsmSymbol(make_mangledname('DBG2',def.owner,symname(def.typesym)),AB_GLOBAL,AT_DATA); + include(def.defstates,ds_dwarf_dbg_info_written); + end + else + begin + { The pointer typecast is needed to prevent a problem with range checking + on when the typecast is changed to 'as' } + current_asmdata.getdatalabel(TAsmLabel(pointer(def.dwarf_lab))); + current_asmdata.getdatalabel(TAsmLabel(pointer(def.dwarf_ref_lab))); + if is_implicit_pointer_object_type(def) then + current_asmdata.getdatalabel(TAsmLabel(pointer(tobjectdef(def).dwarf_struct_lab))); + end; + end; + end + else + begin + { The pointer typecast is needed to prevent a problem with range checking + on when the typecast is changed to 'as' } + { addrlabel instead of datalabel because it must be a local one } + current_asmdata.getaddrlabel(TAsmLabel(pointer(def.dwarf_lab))); + current_asmdata.getaddrlabel(TAsmLabel(pointer(def.dwarf_ref_lab))); + if is_implicit_pointer_object_type(def) then + current_asmdata.getaddrlabel(TAsmLabel(pointer(tobjectdef(def).dwarf_struct_lab))); + end; + if def.dbg_state=dbg_state_used then + deftowritelist.Add(def); + defnumberlist.Add(def); + end; + end; + + function TDebugInfoDwarf.def_dwarf_lab(def: tdef): tasmsymbol; + begin + set_def_dwarf_labs(def); + result:=def.dwarf_lab; + end; + + function TDebugInfoDwarf.def_dwarf_class_struct_lab(def: tobjectdef): tasmsymbol; + begin + set_def_dwarf_labs(def); + result:=def.dwarf_struct_lab; + end; + + function TDebugInfoDwarf.def_dwarf_ref_lab(def: tdef): tasmsymbol; + begin + set_def_dwarf_labs(def); + result:=def.dwarf_ref_lab; + end; + + constructor TDebugInfoDwarf.Create; + begin + inherited Create; + { 64bit headers are only supported for dwarf3 and up, so default off } + use_64bit_headers := false; + { we haven't generated any lineinfo yet } + generated_lineinfo := false; + + dirlist := TFPHashObjectList.Create; + { add current dir as first item (index=0) } + TDirIndexItem.Create(dirlist,'.', 0); + asmline := TAsmList.create; + loclist := tdynamicarray.Create(4096); + + AbbrevSearchTree:=AllocateNewAiSearchItem; + + vardatadef := nil; + end; + + + destructor TDebugInfoDwarf.Destroy; + begin + dirlist.Free; + if assigned(AbbrevSearchTree) then + FreeSearchItem(AbbrevSearchTree); + dirlist := nil; + asmline.free; + asmline:=nil; + loclist.Free; + loclist := nil; + inherited Destroy; + end; + + + procedure TDebugInfoDwarf.enum_membersyms_callback(p:TObject; arg: pointer); + begin + case tsym(p).typ of + fieldvarsym: + appendsym_fieldvar(TAsmList(arg),tfieldvarsym(p)); + propertysym: + appendsym_property(TAsmList(arg),tpropertysym(p)); + constsym: + appendsym_const_member(TAsmList(arg),tconstsym(p),true); + end; + end; + + + function TDebugInfoDwarf.get_file_index(afile: tinputfile): Integer; + var + dirname: String; + diritem: TDirIndexItem; + diridx: Integer; + fileitem: TFileIndexItem; + begin + if afile.path^ = '' then + dirname := '.' + else + begin + { add the canonical form here already to avoid problems with } + { paths such as './' etc } + dirname := relative_dwarf_path(afile.path^); + if dirname = '' then + dirname := '.'; + end; + diritem := TDirIndexItem(dirlist.Find(dirname)); + if diritem = nil then + diritem := TDirIndexItem.Create(dirlist,dirname, dirlist.Count); + diridx := diritem.IndexNr; + + fileitem := TFileIndexItem(diritem.files.Find(afile.name^)); + if fileitem = nil then + begin + Inc(filesequence); + fileitem := TFileIndexItem.Create(diritem.files,afile.name^, diridx, filesequence); + end; + Result := fileitem.IndexNr; + end; + + + procedure TDebugInfoDwarf.append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const values: array of const); + begin + if length(values)<>1 then + internalerror(2009040402); + append_attribute(attr,form,values[0]); + end; + + + procedure TDebugInfoDwarf.append_attribute(attr: tdwarf_attribute; form: tdwarf_form; const value: tvarrec); + begin + { attribute } + AddConstToAbbrev(cardinal(attr)); + + { form } + AddConstToAbbrev(cardinal(form)); + + { info itself } + case form of + DW_FORM_string: + case value.VType of + vtChar: + current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(value.VChar)); + vtString: + current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(value.VString^)); + vtAnsistring: + current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create(Ansistring(value.VAnsiString))); + else + internalerror(200601264); + end; + + DW_FORM_flag: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(byte(value.VBoolean))); + + DW_FORM_data1: + case value.VType of + vtInteger: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VInteger)); + vtInt64: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VInt64^)); + vtQWord: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VQWord^)); + else + internalerror(200602143); + end; + + DW_FORM_data2: + case value.VType of + vtInteger: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(value.VInteger)); + vtInt64: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(value.VInt64^)); + vtQWord: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(value.VQWord^)); + else + internalerror(200602144); + end; + + DW_FORM_data4: + case value.VType of + vtInteger: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(value.VInteger)); + vtInt64: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(value.VInt64^)); + vtQWord: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(value.VQWord^)); + else + internalerror(200602145); + end; + + DW_FORM_data8: + case value.VType of + vtInteger: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(value.VInteger)); + vtInt64: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(value.VInt64^)); + vtQWord: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(value.VQWord^)); + else + internalerror(200602146); + end; + + DW_FORM_sdata: + case value.VType of + vtInteger: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(value.VInteger)); + vtInt64: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(value.VInt64^)); + vtQWord: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(value.VQWord^)); + else + internalerror(200601285); + end; + + DW_FORM_udata: + case value.VType of + vtInteger: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(value.VInteger)); + vtInt64: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(value.VInt64^)); + vtQWord: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(value.VQWord^)); + else + internalerror(200601284); + end; + + { block gets only the size, the rest is appended manually by the caller } + DW_FORM_block1: + case value.VType of + vtInteger: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VInteger)); + vtInt64: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VInt64^)); + vtQWord: + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(value.VQWord^)); + else + internalerror(200602141); + end; + else + internalerror(200601263); + end; + end; + + + { writing the data through a few simply procedures allows to create easily extra information + for debugging of debug info } + procedure TDebugInfoDwarf.append_entry(tag : tdwarf_tag;has_children : boolean;data : array of const); + var + i : longint; + begin + { abbrev number } + // Store the ai with the reference to the abbrev number and start a search + // to find the right abbrev-section. (Or create one) + dwarf_info_abbref_tai := tai_const.create_uleb128bit(currabbrevnumber); + current_asmdata.asmlists[al_dwarf_info].concat(dwarf_info_abbref_tai); + StartAbbrevSearch; + + { tag } + AddConstToAbbrev(ord(tag)); + + { children? } + AddConstToAbbrev(ord(has_children),true); + + i:=0; + while i<=high(data) do + begin + if (i+2 > high(data)) then + internalerror(2009040401); + if data[i].VType<>vtInteger then + internalerror(200601261); + if data[i+1].VType<>vtInteger then + internalerror(200601261); + append_attribute(tdwarf_attribute(data[i].VInteger),tdwarf_form(data[i+1].VInteger),data[i+2]); + inc(i,3); + end; + end; + + + procedure TDebugInfoDwarf.append_block1(attr: tdwarf_attribute; size: aint); + begin + AddConstToAbbrev(ord(attr)); + AddConstToAbbrev(ord(DW_FORM_block1)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(size)); + end; + + + procedure TDebugInfoDwarf.append_labelentry(attr : tdwarf_attribute;sym : tasmsymbol); + begin + AddConstToAbbrev(ord(attr)); + AddConstToAbbrev(ord(DW_FORM_addr)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sym(sym)); + end; + + procedure TDebugInfoDwarf.append_labelentry_addr_ref(attr : tdwarf_attribute;sym : tasmsymbol); + begin + AddConstToAbbrev(ord(DW_FORM_ref_addr)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sym(sym)) + end; + + procedure TDebugInfoDwarf.append_labelentry_ref(attr : tdwarf_attribute;sym : tasmsymbol); + begin + AddConstToAbbrev(ord(attr)); + if not(tf_dwarf_only_local_labels in target_info.flags) then + append_labelentry_addr_ref(attr, sym) + else + begin + AddConstToAbbrev(ord(DW_FORM_ref4)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_info0'),sym)); + end; + end; + + + procedure TDebugInfoDwarf.append_labelentry_dataptr_common(attr : tdwarf_attribute); + begin + AddConstToAbbrev(ord(attr)); + if use_64bit_headers then + AddConstToAbbrev(ord(DW_FORM_data8)) + else + AddConstToAbbrev(ord(DW_FORM_data4)); + end; + + + procedure TDebugInfoDwarf.append_labelentry_dataptr_abs(attr : tdwarf_attribute;sym : tasmsymbol); + begin + { + used for writing dwarf lineptr, loclistptr, macptr and rangelistptr classes as FORM_dataN + The size of these depend on the header format + Must be relative to another symbol on tf_dwarf_relative_addresses + targets + } + if (tf_dwarf_relative_addresses in target_info.flags) then + { use append_labelentry_dataptr_rel instead } + internalerror(2007020210); + append_labelentry_dataptr_common(attr); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(offsetabstype,sym)) + end; + + + procedure TDebugInfoDwarf.append_labelentry_dataptr_rel(attr : tdwarf_attribute;sym,endsym : tasmsymbol); + begin + { + used for writing dwarf lineptr, loclistptr, macptr and rangelistptr classes as FORM_dataN + The size of these depend on the header format + Must be relative to another symbol on tf_dwarf_relative_addresses + targets + } + append_labelentry_dataptr_common(attr); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype,sym,endsym)); + end; + + + procedure TDebugInfoDwarf.finish_entry; + begin + dwarf_info_abbref_tai.value:=FinishAbbrevSearch; + end; + + + procedure TDebugInfoDwarf.finish_children; + begin + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0)); + end; + + procedure TDebugInfoDwarf.appenddef_ord(list:TAsmList;def:torddef); + var + basedef : tdef; + sign : tdwarf_type; + signform : tdwarf_form; + fullbytesize : byte; + begin + case def.ordtype of + s8bit, + s16bit, + s32bit, + u8bit, + u16bit, + u32bit : + begin + { generate proper signed/unsigned info for types like 0..3 } + { these are s8bit, but should be identified as unsigned } + { because otherwise they are interpreted wrongly when used } + { in a bitpacked record } + if (def.low<0) then + begin + sign:=DW_ATE_signed; + signform:=DW_FORM_sdata + end + else + begin + sign:=DW_ATE_unsigned; + signform:=DW_FORM_udata + end; + fullbytesize:=def.size; + case fullbytesize of + 1: + if (sign=DW_ATE_signed) then + basedef:=s8inttype + else + basedef:=u8inttype; + 2: + if (sign=DW_ATE_signed) then + basedef:=s16inttype + else + basedef:=u16inttype; + 4: + if (sign=DW_ATE_signed) then + basedef:=s32inttype + else + basedef:=u32inttype; + else + internalerror(2008032201); + end; + + if (def.low=torddef(basedef).low) and + (def.high=torddef(basedef).high) then + { base type such as byte/shortint/word/... } + if assigned(def.typesym) then + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,symname(def.typesym)+#0, + DW_AT_encoding,DW_FORM_data1,sign, + DW_AT_byte_size,DW_FORM_data1,fullbytesize]) + else + append_entry(DW_TAG_base_type,false,[ + DW_AT_encoding,DW_FORM_data1,sign, + DW_AT_byte_size,DW_FORM_data1,fullbytesize]) + else + begin + { subrange type } + { note: don't do this 64 bit int types, they appear } + { to be always clipped to s32bit for some reason } + if assigned(def.typesym) then + append_entry(DW_TAG_subrange_type,false,[ + DW_AT_name,DW_FORM_string,symname(def.typesym)+#0, + DW_AT_lower_bound,signform,int64(def.low), + DW_AT_upper_bound,signform,int64(def.high) + ]) + else + append_entry(DW_TAG_subrange_type,false,[ + DW_AT_lower_bound,signform,int64(def.low), + DW_AT_upper_bound,signform,int64(def.high) + ]); + append_labelentry_ref(DW_AT_type,def_dwarf_lab(basedef)); + end; + + finish_entry; + end; + uvoid : + begin + { gdb 6.4 doesn't support DW_TAG_unspecified_type so we + replace it with a unsigned type with size 0 (FK) + } + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,'Void'#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned, + DW_AT_byte_size,DW_FORM_data1,0 + ]); + finish_entry; + end; + uchar : + begin + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,'Char'#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned_char, + DW_AT_byte_size,DW_FORM_data1,1 + ]); + finish_entry; + end; + uwidechar : + begin + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,'WideChar'#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned_char, + DW_AT_byte_size,DW_FORM_data1,2 + ]); + finish_entry; + end; + pasbool8 : + begin + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,'Boolean'#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean, + DW_AT_byte_size,DW_FORM_data1,1 + ]); + finish_entry; + end; + bool8bit : + begin + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,'ByteBool'#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean, + DW_AT_byte_size,DW_FORM_data1,1 + ]); + finish_entry; + end; + pasbool16 : + begin + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,'Boolean16'#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean, + DW_AT_byte_size,DW_FORM_data1,2 + ]); + finish_entry; + end; + bool16bit : + begin + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,'WordBool'#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean, + DW_AT_byte_size,DW_FORM_data1,2 + ]); + finish_entry; + end; + pasbool32 : + begin + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,'Boolean32'#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean, + DW_AT_byte_size,DW_FORM_data1,4 + ]); + finish_entry; + end; + bool32bit : + begin + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,'LongBool'#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean, + DW_AT_byte_size,DW_FORM_data1,4 + ]); + finish_entry; + end; + pasbool64 : + begin + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,'Boolean64'#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean, + DW_AT_byte_size,DW_FORM_data1,8 + ]); + finish_entry; + end; + bool64bit : + begin + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,'QWordBool'#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_boolean, + DW_AT_byte_size,DW_FORM_data1,8 + ]); + finish_entry; + end; + u64bit : + begin + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,'QWord'#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned, + DW_AT_byte_size,DW_FORM_data1,8 + ]); + finish_entry; + end; + scurrency : + begin + { we should use DW_ATE_signed_fixed, however it isn't supported yet by GDB (FK) } + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,'Currency'#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_signed, + DW_AT_byte_size,DW_FORM_data1,8 + ]); + finish_entry; + end; + s64bit : + begin + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,'Int64'#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_signed, + DW_AT_byte_size,DW_FORM_data1,8 + ]); + finish_entry; + end; + else + internalerror(200601287); + end; + end; + + procedure TDebugInfoDwarf.appenddef_float(list:TAsmList;def:tfloatdef); + begin + case def.floattype of + s32real, + s64real, + s80real, + sc80real: + if assigned(def.typesym) then + begin + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,symname(def.typesym)+#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_float, + DW_AT_byte_size,DW_FORM_data1,def.size + ]); + if (def.floattype in [s80real,sc80real]) and + (def.size<>10) then + begin + append_attribute(DW_AT_bit_size,DW_FORM_data1,[10*8]); + { "The bit offset attribute describes the offset in bits + of the high order bit of a value of the given type + from the high order bit of the storage unit used to + contain that value." } + if target_info.endian=endian_little then + append_attribute(DW_AT_bit_offset,DW_FORM_data1,[(def.size-10)*8]); + end; + end + else + append_entry(DW_TAG_base_type,false,[ + DW_AT_encoding,DW_FORM_data1,DW_ATE_float, + DW_AT_byte_size,DW_FORM_data1,def.size + ]); + s64currency: + { we should use DW_ATE_signed_fixed, however it isn't supported yet by GDB (FK) } + if assigned(def.typesym) then + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,symname(def.typesym)+#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_signed, + DW_AT_byte_size,DW_FORM_data1,8 + ]) + else + append_entry(DW_TAG_base_type,false,[ + DW_AT_encoding,DW_FORM_data1,DW_ATE_signed, + DW_AT_byte_size,DW_FORM_data1,8 + ]); + s64comp: + if assigned(def.typesym) then + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,symname(def.typesym)+#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_signed, + DW_AT_byte_size,DW_FORM_data1,8 + ]) + else + append_entry(DW_TAG_base_type,false,[ + DW_AT_encoding,DW_FORM_data1,DW_ATE_signed, + DW_AT_byte_size,DW_FORM_data1,8 + ]); + else + internalerror(200601289); + end; + finish_entry; + end; + + + procedure TDebugInfoDwarf.appenddef_enum(list:TAsmList;def:tenumdef); + var + hp : tenumsym; + i : integer; + begin + if assigned(def.typesym) then + append_entry(DW_TAG_enumeration_type,true,[ + DW_AT_name,DW_FORM_string,symname(def.typesym)+#0, + DW_AT_byte_size,DW_FORM_data1,def.size + ]) + else + append_entry(DW_TAG_enumeration_type,true,[ + DW_AT_byte_size,DW_FORM_data1,def.size + ]); + if assigned(def.basedef) then + append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.basedef)); + finish_entry; + + { write enum symbols } + for i := 0 to def.symtable.SymList.Count - 1 do + begin + hp:=tenumsym(def.symtable.SymList[i]); + if hp.value<def.minval then + continue + else + if hp.value>def.maxval then + break; + append_entry(DW_TAG_enumerator,false,[ + DW_AT_name,DW_FORM_string,symname(hp)+#0, + DW_AT_const_value,DW_FORM_data4,hp.value + ]); + finish_entry; + end; + + finish_children; + end; + + + procedure TDebugInfoDwarf.appenddef_array(list:TAsmList;def:tarraydef); + var + size : aint; + elesize : aint; + elestrideattr : tdwarf_attribute; + labsym: tasmlabel; + begin + if is_dynamic_array(def) then + begin + { It's a pointer to the actual array } + current_asmdata.getaddrlabel(labsym); + append_entry(DW_TAG_pointer_type,false,[]); + append_labelentry_ref(DW_AT_type,labsym); + finish_entry; + current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0)); + end; + + if not is_packed_array(def) then + begin + elestrideattr := DW_AT_byte_stride; + elesize := def.elesize; + end + else + begin + elestrideattr := DW_AT_stride_size; + elesize := def.elepackedbitsize; + end; + + if is_special_array(def) then + begin + { no known size, no known upper bound } + if assigned(def.typesym) then + append_entry(DW_TAG_array_type,true,[ + DW_AT_name,DW_FORM_string,symname(def.typesym)+#0 + ]) + else + append_entry(DW_TAG_array_type,true,[]); + append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef)); + finish_entry; + { a missing upper bound means "unknown"/default } + append_entry(DW_TAG_subrange_type,false,[ + DW_AT_lower_bound,DW_FORM_sdata,def.lowrange, + elestrideattr,DW_FORM_udata,elesize + ]); + end + else + begin + size:=def.size; + if assigned(def.typesym) then + append_entry(DW_TAG_array_type,true,[ + DW_AT_name,DW_FORM_string,symname(def.typesym)+#0, + DW_AT_byte_size,DW_FORM_udata,size + ]) + else + append_entry(DW_TAG_array_type,true,[ + DW_AT_byte_size,DW_FORM_udata,size + ]); + append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef)); + finish_entry; + { to simplify things, we don't write a multidimensional array here } + append_entry(DW_TAG_subrange_type,false,[ + DW_AT_lower_bound,DW_FORM_sdata,def.lowrange, + DW_AT_upper_bound,DW_FORM_sdata,def.highrange, + elestrideattr,DW_FORM_udata,elesize + ]); + end; + append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.rangedef)); + finish_entry; + finish_children; + end; + + + procedure TDebugInfoDwarf.appenddef_record(list:TAsmList;def:trecorddef); + begin + if assigned(def.objname) then + appenddef_record_named(list,def,def.objname^) + else + appenddef_record_named(list,def,''); + end; + + + procedure TDebugInfoDwarf.appenddef_record_named(list:TAsmList;def:trecorddef;const name: shortstring); + begin + if (name<>'') then + append_entry(DW_TAG_structure_type,true,[ + DW_AT_name,DW_FORM_string,name+#0, + DW_AT_byte_size,DW_FORM_udata,def.size + ]) + else + append_entry(DW_TAG_structure_type,true,[ + DW_AT_byte_size,DW_FORM_udata,def.size + ]); + finish_entry; + def.symtable.symList.ForEachCall(@enum_membersyms_callback,nil); + { don't know whether external record declaration is allow but if it so then + do the same as we do for other object types - skip procdef info generation + for external defs (Paul Ishenin) } + if not(oo_is_external in def.objectoptions) then + write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.symtable); + finish_children; + end; + + + procedure TDebugInfoDwarf.appenddef_pointer(list:TAsmList;def:tpointerdef); + begin + append_entry(DW_TAG_pointer_type,false,[]); + if not(is_voidpointer(def)) then + append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.pointeddef)); + finish_entry; + end; + + + procedure TDebugInfoDwarf.appenddef_string(list:TAsmList;def:tstringdef); + + procedure addnormalstringdef(const name: shortstring; lendef: tdef; maxlen: asizeuint); + var + { maxlen can be > high(int64) } + slen : asizeuint; + arr : tasmlabel; + begin + { fix length of openshortstring } + slen:=aword(def.len); + if (slen=0) or + (slen>maxlen) then + slen:=maxlen; + + { create a structure with two elements } + if not(tf_dwarf_only_local_labels in target_info.flags) then + current_asmdata.getdatalabel(arr) + else + current_asmdata.getaddrlabel(arr); + append_entry(DW_TAG_structure_type,true,[ + DW_AT_name,DW_FORM_string,name+#0, + DW_AT_byte_size,DW_FORM_udata,qword(lendef.size)+slen + ]); + finish_entry; + + { length entry } + append_entry(DW_TAG_member,false,[ + DW_AT_name,DW_FORM_string,'length'#0, + DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0) + ]); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0)); + append_labelentry_ref(DW_AT_type,def_dwarf_lab(lendef)); + finish_entry; + + { string data entry } + append_entry(DW_TAG_member,false,[ + DW_AT_name,DW_FORM_string,'st'#0, + DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(1) + ]); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(lendef.size)); + append_labelentry_ref(DW_AT_type,arr); + finish_entry; + + finish_children; + + { now the data array } + current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(arr,0)); + append_entry(DW_TAG_array_type,true,[ + DW_AT_byte_size,DW_FORM_udata,def.size, + DW_AT_byte_stride,DW_FORM_udata,1 + ]); + append_labelentry_ref(DW_AT_type,def_dwarf_lab(cchartype)); + finish_entry; + append_entry(DW_TAG_subrange_type,false,[ + DW_AT_lower_bound,DW_FORM_udata,0, + DW_AT_upper_bound,DW_FORM_udata,qword(slen) + ]); + append_labelentry_ref(DW_AT_type,def_dwarf_lab(lendef)); + finish_entry; + finish_children; + end; + + begin + case def.stringtype of + st_shortstring: + begin + addnormalstringdef('ShortString',u8inttype,255); + end; + st_longstring: + begin + { a) we don't actually support variables of this type currently + b) this type is only used as the type for constant strings + > 255 characters + c) in such a case, gdb will allocate and initialise enough + memory to hold the maximum size for such a string + -> don't use high(qword)/high(cardinal) as maximum, since that + will cause exhausting the VM space, but some "reasonably high" + number that should be enough for most constant strings + } +{$ifdef cpu64bitaddr} + addnormalstringdef('LongString',u64inttype,qword(1024*1024)); +{$endif cpu64bitaddr} +{$ifdef cpu32bitaddr} + addnormalstringdef('LongString',u32inttype,cardinal(1024*1024)); +{$endif cpu32bitaddr} +{$ifdef cpu16bitaddr} + addnormalstringdef('LongString',u16inttype,cardinal(1024)); +{$endif cpu16bitaddr} + end; + st_ansistring: + begin + { looks like a pchar } + append_entry(DW_TAG_pointer_type,false,[]); + append_labelentry_ref(DW_AT_type,def_dwarf_lab(cchartype)); + finish_entry; + end; + st_unicodestring, + st_widestring: + begin + { looks like a pwidechar } + append_entry(DW_TAG_pointer_type,false,[]); + append_labelentry_ref(DW_AT_type,def_dwarf_lab(cwidechartype)); + finish_entry; + end; + end; + end; + + procedure TDebugInfoDwarf.appenddef_procvar(list:TAsmList;def:tprocvardef); + + procedure doappend; + var + i : longint; + begin + if assigned(def.typesym) then + append_entry(DW_TAG_subroutine_type,true,[ + DW_AT_name,DW_FORM_string,symname(def.typesym)+#0, + DW_AT_prototyped,DW_FORM_flag,true + ]) + else + append_entry(DW_TAG_subroutine_type,true,[ + DW_AT_prototyped,DW_FORM_flag,true + ]); + if not(is_void(tprocvardef(def).returndef)) then + append_labelentry_ref(DW_AT_type,def_dwarf_lab(tprocvardef(def).returndef)); + finish_entry; + + { write parameters } + for i:=0 to def.paras.count-1 do + begin + append_entry(DW_TAG_formal_parameter,false,[ + DW_AT_name,DW_FORM_string,symname(tsym(def.paras[i]))+#0 + ]); + append_labelentry_ref(DW_AT_type,def_dwarf_lab(tparavarsym(def.paras[i]).vardef)); + finish_entry; + end; + + finish_children; + end; + + var + proc : tasmlabel; + + begin + if not def.is_addressonly then + begin + { create a structure with two elements } + if not(tf_dwarf_only_local_labels in target_info.flags) then + current_asmdata.getdatalabel(proc) + else + current_asmdata.getaddrlabel(proc); + append_entry(DW_TAG_structure_type,true,[ + DW_AT_byte_size,DW_FORM_data1,2*sizeof(pint) + ]); + finish_entry; + + { proc entry } + append_entry(DW_TAG_member,false,[ + DW_AT_name,DW_FORM_string,'Proc'#0, + DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0) + ]); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0)); + append_labelentry_ref(DW_AT_type,proc); + finish_entry; + + { self entry } + append_entry(DW_TAG_member,false,[ + DW_AT_name,DW_FORM_string,'Self'#0, + DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(sizeof(pint)) + ]); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(sizeof(pint))); + append_labelentry_ref(DW_AT_type,def_dwarf_lab(class_tobject)); + finish_entry; + + finish_children; + + current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(proc,0)); + doappend; + end + else + doappend; + end; + + + procedure TDebugInfoDwarf.beforeappenddef(list:TAsmList;def:tdef); + var + labsym : tasmsymbol; + begin + current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Definition '+def.typename))); + + labsym:=def_dwarf_lab(def); + if ds_dwarf_dbg_info_written in def.defstates then + current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0)) + else + current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0)); + + { On Darwin, dwarf info is not linked in the final binary, + but kept in the individual object files. This allows for + faster linking, but means that you have to keep the object + files for debugging and also that gdb only loads in the + debug info of a particular object file once you step into + or over a procedure in it. + + To solve this, there is a tool called dsymutil which can + extract all the dwarf info from a program's object files. + This utility however performs "smart linking" on the dwarf + info and throws away all unreferenced dwarf entries. Since + variables' types always point to the dwarfinfo for a tdef + and never to that for a typesym, this means all debug + entries generated for typesyms are thrown away. + + The problem with that is that we translate typesyms into + DW_TAG_typedef, and gdb's dwarf-2 reader only makes types + globally visibly if they are defined using a DW_TAG_typedef. + So as a result, before running dsymutil types only become + available once you stepped into/over a function in the object + file where they are declared, and after running dsymutil they + are all gone (printing variables still works because the + tdef dwarf info is still available, but you cannot typecast + anything outside the declaring units because the type names + are not known there). + + The solution: if a tdef has an associated typesym, let the + debug label for the tdef point to a DW_TAG_typedef instead + of directly to the tdef itself. And don't write anything + special for the typesym itself. + + Update: we now also do this for other platforms, because + otherwise if you compile unit A without debug info and + use one of its types in unit B, then no typedef will be + generated and hence gdb will not be able to give a definition + of the type. + } + + if is_objc_class_or_protocol(def) then + begin + { for Objective-C classes, the typedef must refer to the + struct itself, not to the pointer of the struct; Objective-C + classes are not implicit pointers in Objective-C itself, only + in FPC. So make the def label point to a pointer to the + typedef, which in turn refers to the actual struct (for Delphi- + style classes, the def points to the typedef, which refers to + a pointer to the actual struct) } + + { implicit pointer } + current_asmdata.getaddrlabel(TAsmLabel(pointer(labsym))); + append_entry(DW_TAG_pointer_type,false,[]); + append_labelentry_ref(DW_AT_type,labsym); + finish_entry; + current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0)); + end; + + if assigned(def.typesym) and + not(df_generic in def.defoptions) then + begin + current_asmdata.getaddrlabel(TAsmLabel(pointer(labsym))); + append_entry(DW_TAG_typedef,false,[ + DW_AT_name,DW_FORM_string,symname(def.typesym)+#0 + ]); + append_labelentry_ref(DW_AT_type,labsym); + finish_entry; + current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0)); + end + end; + + + procedure TDebugInfoDwarf.afterappenddef(list:TAsmList;def:tdef); + var + labsym : tasmsymbol; + begin + { create a derived reference type for pass-by-reference parameters } + { (gdb doesn't support DW_AT_variable_parameter yet) } + labsym:=def_dwarf_ref_lab(def); + if ds_dwarf_dbg_info_written in def.defstates then + current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(labsym,0)) + else + current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(labsym,0)); + append_entry(DW_TAG_reference_type,false,[]); + append_labelentry_ref(DW_AT_type,def_dwarf_lab(def)); + finish_entry; + end; + + + procedure TDebugInfoDwarf.appendprocdef(list:TAsmList; def:tprocdef); + + function dwarf_calling_convention(def: tprocdef): Tdwarf_calling_convention; + begin + case def.proccalloption of + pocall_register: + result:=DW_CC_GNU_borland_fastcall_i386; + pocall_cdecl, + pocall_stdcall, + pocall_cppdecl, + pocall_mwpascal: + result:=DW_CC_normal; + else + result:=DW_CC_nocall; + end + end; + + var + procendlabel : tasmlabel; + procentry : string; + cc : Tdwarf_calling_convention; + st : tsymtable; + vmtoffset : pint; + in_currentunit : boolean; + begin + { only write debug info for procedures defined in the current module, + except in case of methods (gcc-compatible) + } + in_currentunit:=def.in_currentunit; + + if not in_currentunit and + not (def.owner.symtabletype in [objectsymtable,recordsymtable]) then + exit; + + { happens for init procdef of units without init section } + if in_currentunit and + not assigned(def.procstarttai) then + exit; + + { Procdefs are not handled by the regular def writing code, so + dbg_state is not set/checked for them. Do it here. } + if (def.dbg_state in [dbg_state_writing,dbg_state_written]) then + exit; + defnumberlist.Add(def); + + { Write methods and only in the scope of their parent objectdefs. } + if (def.owner.symtabletype in [objectsymtable,recordsymtable]) then + begin + { this code can also work for nested procdefs, but is not yet + activated for those because there is no clear advantage yet to + limiting the scope of nested procedures to that of their parent, + and it makes it impossible to set breakpoints in them by + referring to their name. } + st:=def.owner; + while assigned(st.defowner) and + (tdef(st.defowner).typ = procdef) do + st:=tprocdef(st.defowner).owner; + if assigned(st) and + (tdef(st.defowner).dbg_state<>dbg_state_writing) then + exit; + end; + + def.dbg_state:=dbg_state_writing; + + current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Procdef '+def.fullprocname(true)))); + if not is_objc_class_or_protocol(def.struct) then + append_entry(DW_TAG_subprogram,true, + [DW_AT_name,DW_FORM_string,symname(def.procsym)+#0 + { data continues below } + { problem: base reg isn't known here + DW_AT_frame_base,DW_FORM_block1,1 + } + ]) + else + append_entry(DW_TAG_subprogram,true, + [DW_AT_name,DW_FORM_string,def.mangledname+#0 + { data continues below } + { problem: base reg isn't known here + DW_AT_frame_base,DW_FORM_block1,1 + } + ]); + + { Append optional flags. } + + { All Pascal procedures are prototyped } + append_attribute(DW_AT_prototyped,DW_FORM_flag,[true]); + { Calling convention. } + cc:=dwarf_calling_convention(def); + if (cc<>DW_CC_normal) then + append_attribute(DW_AT_calling_convention,DW_FORM_data1,[ord(cc)]); + { Externally visible. } + if (po_global in def.procoptions) and + (def.parast.symtablelevel<=normal_function_level) then + append_attribute(DW_AT_external,DW_FORM_flag,[true]); + { Abstract or virtual/overriding method. } + if (([po_abstractmethod, po_virtualmethod, po_overridingmethod] * def.procoptions) <> []) and + not is_objc_class_or_protocol(def.struct) and + not is_objectpascal_helper(def.struct) then + begin + if not(po_abstractmethod in def.procoptions) then + append_attribute(DW_AT_virtuality,DW_FORM_data1,[ord(DW_VIRTUALITY_virtual)]) + else + append_attribute(DW_AT_virtuality,DW_FORM_data1,[ord(DW_VIRTUALITY_pure_virtual)]); + { Element number in the vmt (needs to skip stuff coming before the + actual method addresses in the vmt, so we use vmtmethodoffset() + and then divide by sizeof(pint)). } + vmtoffset:=tobjectdef(def.owner.defowner).vmtmethodoffset(def.extnumber); + append_attribute(DW_AT_vtable_elem_location,DW_FORM_block1,[3+LengthUleb128(vmtoffset)]); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_constu))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_uleb128bit(vmtoffset)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus))); + end; + + { accessibility: public/private/protected } + if (def.owner.symtabletype in [objectsymtable,recordsymtable]) then + append_visibility(def.visibility); + + { Return type. } + if not(is_void(tprocdef(def).returndef)) then + append_labelentry_ref(DW_AT_type,def_dwarf_lab(tprocdef(def).returndef)); + + { we can only write the start/end if this procedure is implemented in + this module + } + if in_currentunit then + begin + { mark end of procedure } + current_asmdata.getlabel(procendlabel,alt_dbgtype); + current_asmdata.asmlists[al_procedures].insertbefore(tai_label.create(procendlabel),def.procendtai); + + if (target_info.system = system_powerpc64_linux) then + procentry := '.' + def.mangledname + else + procentry := def.mangledname; + + append_labelentry(DW_AT_low_pc,current_asmdata.RefAsmSymbol(procentry)); + append_labelentry(DW_AT_high_pc,procendlabel); + end; + + { Don't write the funcretsym explicitly, it's also in the + localsymtable and/or parasymtable. + } + finish_entry; + + if assigned(def.parast) then + begin + { First insert self, because gdb uses the fact whether or not the + first parameter of a method is artificial to distinguish static + from regular methods. } + + { fortunately, self is the always the first parameter in the + paralist, since it has the lowest paranr. Note that this is not + true for Objective-C, but those methods are detected in + another way (by reading the ObjC run time information) } + write_symtable_parasyms(current_asmdata.asmlists[al_dwarf_info],def.paras); + end; + { local type defs and vars should not be written + inside the main proc } + if in_currentunit and + assigned(def.localst) and + (def.localst.symtabletype=localsymtable) then + write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],def.localst); + + { last write the types from this procdef } + if assigned(def.parast) then + write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.parast); + { only try to write the localst if the routine is implemented here } + if in_currentunit and + assigned(def.localst) and + (def.localst.symtabletype=localsymtable) then + begin + write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],def.localst); + { Write nested procedures -- disabled, see scope check at the + beginning; currently, these are still written in the global + scope. } + // write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.localst); + end; + + finish_children; + end; + + + function TDebugInfoDwarf.get_symlist_sym_offset(symlist: ppropaccesslistitem; out sym: tabstractvarsym; out offset: pint): boolean; + var + elesize : pint; + currdef : tdef; + indirection: boolean; + begin + result:=false; + if not assigned(symlist) then + exit; + sym:=nil; + offset:=0; + currdef:=nil; + indirection:=false; + repeat + case symlist^.sltype of + sl_load: + begin + if assigned(sym) then + internalerror(2009031203); + if not(symlist^.sym.typ in [paravarsym,localvarsym,staticvarsym,fieldvarsym]) then + { can't handle... } + exit; + sym:=tabstractvarsym(symlist^.sym); + currdef:=tabstractvarsym(sym).vardef; + if ((sym.typ=paravarsym) and + paramanager.push_addr_param(tparavarsym(sym).varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption)) then + indirection:=true; + end; + sl_subscript: + begin + if not assigned(currdef) then + internalerror(2009031301); + if (symlist^.sym.typ<>fieldvarsym) then + internalerror(2009031202); + { can't handle offsets with indirections yet } + if indirection then + exit; + if is_packed_record_or_object(currdef) then + begin + { can't calculate the address of a non-byte aligned field } + if (tfieldvarsym(symlist^.sym).fieldoffset mod 8) <> 0 then + exit; + inc(offset,tfieldvarsym(symlist^.sym).fieldoffset div 8) + end + else + inc(offset,tfieldvarsym(symlist^.sym).fieldoffset); + currdef:=tfieldvarsym(symlist^.sym).vardef; + end; + sl_absolutetype, + sl_typeconv: + begin + currdef:=tfieldvarsym(symlist^.sym).vardef; + { ignore, these don't change the address } + end; + sl_vec: + begin + if not assigned(currdef) or + (currdef.typ<>arraydef) then + internalerror(2009031201); + { can't handle offsets with indirections yet } + if indirection then + exit; + if not is_packed_array(currdef) then + elesize:=tarraydef(currdef).elesize + else + begin + elesize:=tarraydef(currdef).elepackedbitsize; + { can't calculate the address of a non-byte aligned element } + if (elesize mod 8)<>0 then + exit; + elesize:=elesize div 8; + end; + inc(offset,(symlist^.value.svalue-tarraydef(currdef).lowrange)*elesize); + currdef:=tarraydef(currdef).elementdef; + end; + else + internalerror(2009031401); + end; + symlist:=symlist^.next; + until not assigned(symlist); + if not assigned(sym) then + internalerror(2009031205); + result:=true; + end; + + + procedure TDebugInfoDwarf.appendsym_var(list:TAsmList;sym:tabstractnormalvarsym); + begin + appendsym_var_with_name_type_offset(list,sym,symname(sym),sym.vardef,0,[]); + end; + + + procedure TDebugInfoDwarf.appendsym_var_with_name_type_offset(list:TAsmList; sym:tabstractnormalvarsym; const name: string; def: tdef; offset: pint; const flags: tdwarfvarsymflags); + var + templist : TAsmList; + blocksize : longint; + tag : tdwarf_tag; + dreg : byte; + begin + { external symbols can't be resolved at link time, so we + can't generate stabs for them + + not sure if this applies to dwarf as well (FK) + } + if vo_is_external in sym.varoptions then + exit; + + { There is no space allocated for not referenced locals } + if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then + exit; + + templist:=TAsmList.create; + + case sym.localloc.loc of + LOC_REGISTER, + LOC_CREGISTER, + LOC_MMREGISTER, + LOC_CMMREGISTER, + LOC_FPUREGISTER, + LOC_CFPUREGISTER : + begin + templist.concat(tai_const.create_8bit(ord(DW_OP_regx))); + dreg:=dwarf_reg(sym.localloc.register); + templist.concat(tai_const.create_uleb128bit(dreg)); + blocksize:=1+Lengthuleb128(dreg); + end; + else + begin + case sym.typ of + staticvarsym: + begin + if (vo_is_thread_var in sym.varoptions) then + begin +{ TODO: !!! FIXME: dwarf for thread vars !!!} + blocksize:=0; + end + else + begin + templist.concat(tai_const.create_8bit(ord(DW_OP_addr))); + templist.concat(tai_const.createname(sym.mangledname,offset)); + blocksize:=1+sizeof(puint); + end; + end; + paravarsym, + localvarsym: + begin + { Happens when writing debug info for paras of procdefs not + implemented in the current module. Can't add a general check + for LOC_INVALID above, because staticvarsyms may also have it. + } + if sym.localloc.loc<> LOC_INVALID then + begin + dreg:=dwarf_reg(sym.localloc.reference.base); + templist.concat(tai_const.create_8bit(ord(DW_OP_breg0)+dreg)); + templist.concat(tai_const.create_sleb128bit(sym.localloc.reference.offset+offset)); + blocksize:=1+Lengthsleb128(sym.localloc.reference.offset); +{$ifndef gdb_supports_DW_AT_variable_parameter} + { Parameters which are passed by reference. (var and the like) + Hide the reference-pointer and dereference the pointer + in the DW_AT_location block. + } + if (sym.typ=paravarsym) and + paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and + not(vo_has_local_copy in sym.varoptions) and + not is_open_string(sym.vardef) then + begin + templist.concat(tai_const.create_8bit(ord(DW_OP_deref))); + inc(blocksize); + end +{$endif not gdb_supports_DW_AT_variable_parameter} + end; + end + else + internalerror(200601288); + end; + end; + end; + + { function results must not be added to the parameter list, + as they are not part of the signature of the function + (gdb automatically adds them according to the ABI specifications + when calling the function) + } + if (sym.typ=paravarsym) and + not(dvf_force_local_var in flags) and + not(vo_is_funcret in sym.varoptions) then + tag:=DW_TAG_formal_parameter + else + tag:=DW_TAG_variable; + + { must be parasym of externally implemented procdef, but + the parasymtable can con also contain e.g. absolutevarsyms + -> check symtabletype} + if (sym.owner.symtabletype=parasymtable) and + (sym.localloc.loc=LOC_INVALID) then + begin + if (sym.owner.symtabletype<>parasymtable) then + internalerror(2009101001); + append_entry(tag,false,[ + DW_AT_name,DW_FORM_string,name+#0 + { + DW_AT_decl_file,DW_FORM_data1,0, + DW_AT_decl_line,DW_FORM_data1, + } + ]) + end + else if not(sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_MMREGISTER, + LOC_CMMREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER]) and + ((sym.owner.symtabletype = globalsymtable) or + (sp_static in sym.symoptions) or + (vo_is_public in sym.varoptions)) then + append_entry(tag,false,[ + DW_AT_name,DW_FORM_string,name+#0, + { + DW_AT_decl_file,DW_FORM_data1,0, + DW_AT_decl_line,DW_FORM_data1, + } + DW_AT_external,DW_FORM_flag,true, + { data continues below } + DW_AT_location,DW_FORM_block1,blocksize + ]) +{$ifdef gdb_supports_DW_AT_variable_parameter} + else if (sym.typ=paravarsym) and + paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and + not(vo_has_local_copy in sym.varoptions) and + not is_open_string(sym.vardef) then + append_entry(tag,false,[ + DW_AT_name,DW_FORM_string,name+#0, + DW_AT_variable_parameter,DW_FORM_flag,true, + { + DW_AT_decl_file,DW_FORM_data1,0, + DW_AT_decl_line,DW_FORM_data1, + } + { data continues below } + DW_AT_location,DW_FORM_block1,blocksize + ]) +{$endif gdb_supports_DW_AT_variable_parameter} + else + append_entry(tag,false,[ + DW_AT_name,DW_FORM_string,name+#0, + { + DW_AT_decl_file,DW_FORM_data1,0, + DW_AT_decl_line,DW_FORM_data1, + } + { data continues below } + DW_AT_location,DW_FORM_block1,blocksize + ]); + { append block data } + current_asmdata.asmlists[al_dwarf_info].concatlist(templist); + { Mark self as artificial for methods, because gdb uses the fact + whether or not the first parameter of a method is artificial to + distinguish regular from static methods (since there are no + no vo_is_self parameters for static methods, we don't have to check + that). } + if (vo_is_self in sym.varoptions) then + append_attribute(DW_AT_artificial,DW_FORM_flag,[true]); + append_labelentry_ref(DW_AT_type,def_dwarf_lab(def)); + + templist.free; + + finish_entry; + end; + + + procedure TDebugInfoDwarf.appendsym_staticvar(list:TAsmList;sym:tstaticvarsym); + begin + appendsym_var(list,sym); + end; + + + procedure TDebugInfoDwarf.appendsym_localvar(list:TAsmList;sym:tlocalvarsym); + begin + appendsym_var(list,sym); + end; + + + procedure TDebugInfoDwarf.appendsym_paravar(list:TAsmList;sym:tparavarsym); + begin + appendsym_var(list,sym); + end; + + + procedure TDebugInfoDwarf.appendsym_fieldvar(list:TAsmList;sym: tfieldvarsym); + begin + appendsym_fieldvar_with_name_offset(list,sym,symname(sym),sym.vardef,0); + end; + + + procedure TDebugInfoDwarf.appendsym_fieldvar_with_name_offset(list:TAsmList;sym: tfieldvarsym;const name: string; def: tdef; offset: pint); + var + bitoffset, + fieldoffset, + fieldnatsize: asizeint; + begin + if (sp_static in sym.symoptions) or + (sym.visibility=vis_hidden) then + exit; + + if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) or + { only ordinals are bitpacked } + not is_ordinal(sym.vardef) then + begin + { other kinds of fields can however also appear in a bitpacked } + { record, and then their offset is also specified in bits rather } + { than in bytes } + if (tabstractrecordsymtable(sym.owner).usefieldalignment<>bit_alignment) then + fieldoffset:=sym.fieldoffset + else + fieldoffset:=sym.fieldoffset div 8; + inc(fieldoffset,offset); + append_entry(DW_TAG_member,false,[ + DW_AT_name,DW_FORM_string,name+#0, + DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset) + ]); + end + else + begin + if (sym.vardef.packedbitsize > 255) then + internalerror(2007061201); + + { we don't bitpack according to the ABI, but as close as } + { possible, i.e., equivalent to gcc's } + { __attribute__((__packed__)), which is also what gpc } + { does. } + fieldnatsize:=max(sizeof(pint),sym.vardef.size); + fieldoffset:=(sym.fieldoffset div (fieldnatsize*8)) * fieldnatsize; + inc(fieldoffset,offset); + bitoffset:=sym.fieldoffset mod (fieldnatsize*8); + if (target_info.endian=endian_little) then + bitoffset:=(fieldnatsize*8)-bitoffset-sym.vardef.packedbitsize; + append_entry(DW_TAG_member,false,[ + DW_AT_name,DW_FORM_string,symname(sym)+#0, + { gcc also generates both a bit and byte size attribute } + { we don't support ordinals >= 256 bits } + DW_AT_byte_size,DW_FORM_data1,fieldnatsize, + { nor >= 256 bits (not yet, anyway, see IE above) } + DW_AT_bit_size,DW_FORM_data1,sym.vardef.packedbitsize, + { data1 and data2 are unsigned, bitoffset can also be negative } + DW_AT_bit_offset,DW_FORM_data4,bitoffset, + DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(fieldoffset) + ]); + end; + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(fieldoffset)); + if (sym.owner.symtabletype in [objectsymtable,recordsymtable]) then + append_visibility(sym.visibility); + + append_labelentry_ref(DW_AT_type,def_dwarf_lab(def)); + finish_entry; + end; + + procedure TDebugInfoDwarf.appendsym_const(list:TAsmList;sym:tconstsym); + begin + appendsym_const_member(list,sym,false); + end; + + procedure TDebugInfoDwarf.appendsym_const_member(list:TAsmList;sym:tconstsym;ismember:boolean); + var + i, + size: aint; + usedef: tdef; + begin + { These are default values of parameters. These should be encoded + via DW_AT_default_value, not as a separate sym. Moreover, their + type is not available when writing the debug info for external + procedures. + } + if (sym.owner.symtabletype=parasymtable) then + exit; + + if ismember then + append_entry(DW_TAG_member,false,[ + DW_AT_name,DW_FORM_string,symname(sym)+#0, + { The DW_AT_declaration tag is invalid according to the DWARF specifications. + But gcc adds this to static const members and gdb checks + for this flag. So we have to set it also. + } + DW_AT_declaration,DW_FORM_flag,true, + DW_AT_external,DW_FORM_flag,true + ]) + else + append_entry(DW_TAG_variable,false,[ + DW_AT_name,DW_FORM_string,symname(sym)+#0 + ]); + { for string constants, constdef isn't set because they have no real type } + case sym.consttyp of + conststring: + begin + { if DW_FORM_string is used below one day, this usedef should + probably become nil } + { note: < 255 instead of <= 255 because we have to store the + entire length of the string as well, and 256 does not fit in + a byte } + if (sym.value.len<255) then + usedef:=cshortstringtype + else + usedef:=clongstringtype; + end; + constresourcestring, + constwstring: + usedef:=nil; + else + usedef:=sym.constdef; + end; + if assigned(usedef) then + append_labelentry_ref(DW_AT_type,def_dwarf_lab(usedef)); + AddConstToAbbrev(ord(DW_AT_const_value)); + case sym.consttyp of + conststring: + begin + { DW_FORM_string isn't supported yet by the Pascal value printer + -> create a string using raw bytes } + if (sym.value.len<255) then + begin + AddConstToAbbrev(ord(DW_FORM_block1)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sym.value.len+1)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sym.value.len)); + end + else + begin + AddConstToAbbrev(ord(DW_FORM_block)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(sym.value.len+sizeof(pint))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_pint(sym.value.len)); + end; + i:=0; + size:=sym.value.len; + while(i<size) do + begin + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit((pbyte(sym.value.valueptr+i)^))); + inc(i); + end; + end; + constguid, + constset: + begin + AddConstToAbbrev(ord(DW_FORM_block1)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(usedef.size)); + i:=0; + size:=sym.constdef.size; + while (i<size) do + begin + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit((pbyte(sym.value.valueptr+i)^))); + inc(i); + end; + end; + constwstring, + constresourcestring: + begin + { write dummy for now } + AddConstToAbbrev(ord(DW_FORM_string)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_string.create('')); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(0)); + end; + constord: + begin + if (sym.value.valueord<0) then + begin + AddConstToAbbrev(ord(DW_FORM_sdata)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_sleb128bit(sym.value.valueord.svalue)); + end + else + begin + AddConstToAbbrev(ord(DW_FORM_udata)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(sym.value.valueord.uvalue)); + end; + end; + constnil: + begin +{$ifdef cpu64bitaddr} + AddConstToAbbrev(ord(DW_FORM_data8)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(0)); +{$else cpu64bitaddr} + AddConstToAbbrev(ord(DW_FORM_data4)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(0)); +{$endif cpu64bitaddr} + end; + constpointer: + begin +{$ifdef cpu64bitaddr} + AddConstToAbbrev(ord(DW_FORM_data8)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(int64(sym.value.valueordptr))); +{$else cpu64bitaddr} + AddConstToAbbrev(ord(DW_FORM_data4)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(longint(sym.value.valueordptr))); +{$endif cpu64bitaddr} + end; + constreal: + begin + AddConstToAbbrev(ord(DW_FORM_block1)); + case tfloatdef(sym.constdef).floattype of + s32real: + begin + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(4)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_real_32bit.create(pbestreal(sym.value.valueptr)^)); + end; + s64real: + begin + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(8)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_real_64bit.create(pbestreal(sym.value.valueptr)^)); + end; + s64comp, + s64currency: + begin + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(8)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_64bit(trunc(pbestreal(sym.value.valueptr)^))); + end; + s80real, + sc80real: + begin + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sym.constdef.size)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_real_80bit.create(pextended(sym.value.valueptr)^,sym.constdef.size)); + end; + else + internalerror(200601291); + end; + end; + else + internalerror(200601292); + end; + finish_entry; + end; + + + procedure TDebugInfoDwarf.appendsym_label(list:TAsmList;sym: tlabelsym); + begin + { ignore label syms for now, the problem is that a label sym + can have more than one label associated e.g. in case of + an inline procedure expansion } + end; + + + procedure TDebugInfoDwarf.appendsym_property(list:TAsmList;sym: tpropertysym); + var + symlist: ppropaccesslistitem; + tosym: tabstractvarsym; + offset: pint; + begin + if assigned(sym.propaccesslist[palt_read]) and + not assigned(sym.propaccesslist[palt_read].procdef) then + symlist:=sym.propaccesslist[palt_read].firstsym + else + { can't handle } + exit; + + if not get_symlist_sym_offset(symlist,tosym,offset) then + exit; + + if not (tosym.owner.symtabletype in [objectsymtable,recordsymtable]) then + begin + if (tosym.typ=fieldvarsym) then + internalerror(2009031404); + appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym),sym.propdef,offset,[]) + end + else + appendsym_fieldvar_with_name_offset(list,tfieldvarsym(tosym),symname(sym),sym.propdef,offset) + end; + + + function TDebugInfoDwarf.symdebugname(sym: tsym): String; + begin + result := sym.name; + end; + + + procedure TDebugInfoDwarf.appendsym_type(list:TAsmList;sym: ttypesym); + begin + { just queue the def if needed, beforeappenddef will + emit the typedef if necessary } + def_dwarf_lab(sym.typedef); + end; + + + procedure TDebugInfoDwarf.appendsym_absolute(list:TAsmList;sym:tabsolutevarsym); + var + templist : TAsmList; + blocksize : longint; + symlist : ppropaccesslistitem; + tosym: tabstractvarsym; + offset: pint; + flags: tdwarfvarsymflags; + begin + templist:=TAsmList.create; + case tabsolutevarsym(sym).abstyp of + toaddr : + begin + { MWE: replaced ifdef i368 } + (* + if target_cpu = cpu_i386 then + begin + { in theory, we could write a DW_AT_segment entry here for sym.absseg, + however I doubt that gdb supports this (FK) } + end; + *) + templist.concat(tai_const.create_8bit(3)); + templist.concat(tai_const.create_pint(sym.addroffset)); + blocksize:=1+sizeof(puint); + end; + toasm : + begin + templist.concat(tai_const.create_8bit(3)); + templist.concat(tai_const.createname(sym.mangledname,0)); + blocksize:=1+sizeof(puint); + end; + tovar: + begin + symlist:=tabsolutevarsym(sym).ref.firstsym; + if get_symlist_sym_offset(symlist,tosym,offset) then + begin + if (tosym.typ=fieldvarsym) then + internalerror(2009031402); + flags:=[]; + if (sym.owner.symtabletype=localsymtable) then + include(flags,dvf_force_local_var); + appendsym_var_with_name_type_offset(list,tabstractnormalvarsym(tosym),symname(sym),tabstractvarsym(sym).vardef,offset,flags); + end; + templist.free; + exit; + end; + end; + + append_entry(DW_TAG_variable,false,[ + DW_AT_name,DW_FORM_string,symname(sym)+#0, + { + DW_AT_decl_file,DW_FORM_data1,0, + DW_AT_decl_line,DW_FORM_data1, + } + DW_AT_external,DW_FORM_flag,true, + { data continues below } + DW_AT_location,DW_FORM_block1,blocksize + ]); + { append block data } + current_asmdata.asmlists[al_dwarf_info].concatlist(templist); + append_labelentry_ref(DW_AT_type,def_dwarf_lab(sym.vardef)); + + templist.free; + + finish_entry; + end; + + + procedure TDebugInfoDwarf.beforeappendsym(list:TAsmList;sym:tsym); + begin + current_asmdata.asmlists[al_dwarf_info].concat(tai_comment.Create(strpnew('Symbol '+symname(sym)))); + end; + + + procedure TDebugInfoDwarf.insertmoduleinfo; + var + templist: TAsmList; + linelist: TAsmList; + lbl : tasmlabel; + n,m : Integer; + ditem : TDirIndexItem; + fitem : TFileIndexItem; + flist : TFPList; + dbgname : String; + begin + { insert DEBUGSTART and DEBUGEND labels } + dbgname:=make_mangledname('DEBUGSTART',current_module.localsymtable,''); + { Darwin's linker does not like two global labels both pointing to the + end of a section, which can happen in case of units without code -> + make them local; we don't need the debugtable stuff there either, + so it doesn't matter that they are not global. + } + if (target_info.system in systems_darwin) then + dbgname:='L'+dbgname; + new_section(current_asmdata.asmlists[al_start],sec_code,dbgname,0,secorder_begin); + if not(target_info.system in systems_darwin) then + current_asmdata.asmlists[al_start].concat(tai_symbol.Createname_global(dbgname,AT_DATA,0)) + else + current_asmdata.asmlists[al_start].concat(tai_symbol.Createname(dbgname,AT_DATA,0)); + + dbgname:=make_mangledname('DEBUGEND',current_module.localsymtable,''); + { See above. } + if (target_info.system in systems_darwin) then + dbgname:='L'+dbgname; + new_section(current_asmdata.asmlists[al_end],sec_code,dbgname,0,secorder_end); + if not(target_info.system in systems_darwin) then + current_asmdata.asmlists[al_end].concat(tai_symbol.Createname_global(dbgname,AT_DATA,0)) + else + current_asmdata.asmlists[al_end].concat(tai_symbol.Createname(dbgname,AT_DATA,0)); + + { insert .Ldebug_abbrev0 label } + templist:=TAsmList.create; + new_section(templist,sec_debug_abbrev,'',0); + templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_abbrevsection0',AT_DATA,0)); + { add any extra stuff which needs to be in the abbrev section, but before } + { the actual abbreviations, in between the symbol above and below, i.e. here } + templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_abbrev0',AT_DATA,0)); + current_asmdata.asmlists[al_start].insertlist(templist); + templist.free; + + { insert .Ldebug_line0 label } + templist:=TAsmList.create; + new_section(templist,sec_debug_line,'',0); + templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_linesection0',AT_DATA,0)); + { add any extra stuff which needs to be in the line section, but before } + { the actual line info, in between the symbol above and below, i.e. here } + templist.concat(tai_symbol.createname(target_asm.labelprefix+'debug_line0',AT_DATA,0)); + current_asmdata.asmlists[al_start].insertlist(templist); + templist.free; + + { finalize line info if the unit doesn't contain any function/ } + { procedure/init/final code } + finish_lineinfo; + + { debug line header } + linelist := current_asmdata.asmlists[al_dwarf_line]; + new_section(linelist,sec_debug_line,'',0); + linelist.concat(tai_comment.Create(strpnew('=== header start ==='))); + + { size } + current_asmdata.getlabel(lbl,alt_dbgfile); + if use_64bit_headers then + linelist.concat(tai_const.create_32bit(longint($FFFFFFFF))); + linelist.concat(tai_const.create_rel_sym(offsetreltype, + lbl,current_asmdata.RefAsmSymbol(target_asm.labelprefix+'edebug_line0'))); + linelist.concat(tai_label.create(lbl)); + + { version } + linelist.concat(tai_const.create_16bit(dwarf_version)); + + { header length } + current_asmdata.getlabel(lbl,alt_dbgfile); + linelist.concat(tai_const.create_rel_sym(offsetreltype, + lbl,current_asmdata.RefAsmSymbol(target_asm.labelprefix+'ehdebug_line0'))); + linelist.concat(tai_label.create(lbl)); + + { minimum_instruction_length } + linelist.concat(tai_const.create_8bit(1)); + + { default_is_stmt } + linelist.concat(tai_const.create_8bit(1)); + + { line_base } + linelist.concat(tai_const.create_8bit(LINE_BASE)); + + { line_range } + { only line increase, no adress } + linelist.concat(tai_const.create_8bit(255)); + + { opcode_base } + linelist.concat(tai_const.create_8bit(OPCODE_BASE)); + + { standard_opcode_lengths } + { MWE: sigh... why adding the default lengths (and make those sizes sense with LEB encoding) } + { DW_LNS_copy } + linelist.concat(tai_const.create_8bit(0)); + { DW_LNS_advance_pc } + linelist.concat(tai_const.create_8bit(1)); + { DW_LNS_advance_line } + linelist.concat(tai_const.create_8bit(1)); + { DW_LNS_set_file } + linelist.concat(tai_const.create_8bit(1)); + { DW_LNS_set_column } + linelist.concat(tai_const.create_8bit(1)); + { DW_LNS_negate_stmt } + linelist.concat(tai_const.create_8bit(0)); + { DW_LNS_set_basic_block } + linelist.concat(tai_const.create_8bit(0)); + { DW_LNS_const_add_pc } + linelist.concat(tai_const.create_8bit(0)); + { DW_LNS_fixed_advance_pc } + linelist.concat(tai_const.create_8bit(1)); + { DW_LNS_set_prologue_end } + linelist.concat(tai_const.create_8bit(0)); + { DW_LNS_set_epilogue_begin } + linelist.concat(tai_const.create_8bit(0)); + { DW_LNS_set_isa } + linelist.concat(tai_const.create_8bit(1)); + + { Create single list of filenames sorted in IndexNr } + flist:=TFPList.Create; + for n := 0 to dirlist.Count - 1 do + begin + ditem := TDirIndexItem(dirlist[n]); + for m := 0 to ditem.Files.Count - 1 do + flist.Add(ditem.Files[m]); + end; + flist.Sort(@FileListSortCompare); + + { include_directories } + linelist.concat(tai_comment.Create(strpnew('include_directories'))); + for n := 0 to dirlist.Count - 1 do + begin + ditem := TDirIndexItem(dirlist[n]); + if ditem.Name = '.' then + Continue; + { Write without trailing path delimiter and also don't prefix with ./ for current dir (already done while adding to dirlist } + + linelist.concat(tai_string.create(ditem.Name+#0)); + end; + linelist.concat(tai_const.create_8bit(0)); + + { file_names } + linelist.concat(tai_comment.Create(strpnew('file_names'))); + for n := 0 to flist.Count - 1 do + begin + fitem := TFileIndexItem(flist[n]); + { file name } + linelist.concat(tai_string.create(fitem.Name+#0)); + { directory index } + linelist.concat(tai_const.create_uleb128bit(fitem.DirIndex)); + { last modification } + linelist.concat(tai_const.create_uleb128bit(0)); + { file length } + linelist.concat(tai_const.create_uleb128bit(0)); + end; + linelist.concat(tai_const.create_8bit(0)); + + { end of debug line header } + linelist.concat(tai_symbol.createname(target_asm.labelprefix+'ehdebug_line0',AT_DATA,0)); + linelist.concat(tai_comment.Create(strpnew('=== header end ==='))); + + { add line program } + linelist.concatList(asmline); + + { end of debug line table } + linelist.concat(tai_symbol.createname(target_asm.labelprefix+'edebug_line0',AT_DATA,0)); + + flist.free; + end; + + + procedure TDebugInfoDwarf.inserttypeinfo; + + + var + storefilepos : tfileposinfo; + lenstartlabel : tasmlabel; + i : longint; + def: tdef; + dbgname: string; + vardatatype: ttypesym; + begin + current_module.flags:=current_module.flags or uf_has_dwarf_debuginfo; + storefilepos:=current_filepos; + current_filepos:=current_module.mainfilepos; + + currabbrevnumber:=0; + + defnumberlist:=TFPObjectList.create(false); + deftowritelist:=TFPObjectList.create(false); + + { not exported (FK) + FILEREC + TEXTREC + } + vardatatype:=try_search_system_type('TVARDATA'); + if assigned(vardatatype) then + vardatadef:=trecorddef(vardatatype.typedef); + + { write start labels } + new_section(current_asmdata.asmlists[al_dwarf_info],sec_debug_info,'',0); + current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.createname(target_asm.labelprefix+'debug_info0',AT_DATA,0)); + + { start abbrev section } + new_section(current_asmdata.asmlists[al_dwarf_abbrev],sec_debug_abbrev,'',0); + + { debug info header } + current_asmdata.getlabel(lenstartlabel,alt_dbgfile); + { size } + if use_64bit_headers then + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_32bit(longint($FFFFFFFF))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype, + lenstartlabel,current_asmdata.RefAsmSymbol(target_asm.labelprefix+'edebug_info0'))); + + current_asmdata.asmlists[al_dwarf_info].concat(tai_label.create(lenstartlabel)); + { version } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(dwarf_version)); + { abbrev table (=relative from section start)} + if not(tf_dwarf_relative_addresses in target_info.flags) then + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_type_sym(offsetabstype, + current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_abbrev0'))) + else + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_rel_sym(offsetreltype, + current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_abbrevsection0'), + current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_abbrev0'))); + + { address size } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(sizeof(pint))); + + { first manadatory compilation unit TAG } + append_entry(DW_TAG_compile_unit,true,[ + DW_AT_name,DW_FORM_string,relative_dwarf_path(current_module.sourcefiles.get_file(1).path^+current_module.sourcefiles.get_file(1).name^)+#0, + DW_AT_producer,DW_FORM_string,'Free Pascal '+full_version_string+' '+date_string+#0, + DW_AT_comp_dir,DW_FORM_string,BSToSlash(FixPath(GetCurrentDir,false))+#0, + DW_AT_language,DW_FORM_data1,DW_LANG_Pascal83, + DW_AT_identifier_case,DW_FORM_data1,DW_ID_case_insensitive]); + + { reference to line info section } + if not(tf_dwarf_relative_addresses in target_info.flags) then + append_labelentry_dataptr_abs(DW_AT_stmt_list,current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_line0')) + else + append_labelentry_dataptr_rel(DW_AT_stmt_list, + current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_linesection0'), + current_asmdata.RefAsmSymbol(target_asm.labelprefix+'debug_line0')); + + if (m_objectivec1 in current_settings.modeswitches) then + append_attribute(DW_AT_APPLE_major_runtime_vers,DW_FORM_data1,[1]); + + dbgname:=make_mangledname('DEBUGSTART',current_module.localsymtable,''); + if (target_info.system in systems_darwin) then + dbgname:='L'+dbgname; + append_labelentry(DW_AT_low_pc,current_asmdata.RefAsmSymbol(dbgname)); + dbgname:=make_mangledname('DEBUGEND',current_module.localsymtable,''); + if (target_info.system in systems_darwin) then + dbgname:='L'+dbgname; + append_labelentry(DW_AT_high_pc,current_asmdata.RefAsmSymbol(dbgname)); + + finish_entry; + + { write all global/local variables. This will flag all required tdefs } + if assigned(current_module.globalsymtable) then + write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable); + if assigned(current_module.localsymtable) then + write_symtable_syms(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable); + + { write all procedures and methods. This will flag all required tdefs } + if assigned(current_module.globalsymtable) then + write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable); + if assigned(current_module.localsymtable) then + write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable); + + { reset unit type info flag } + reset_unit_type_info; + + { write used types from the used units } + write_used_unit_type_info(current_asmdata.asmlists[al_dwarf_info],current_module); + + { last write the types from this unit } + if assigned(current_module.globalsymtable) then + write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.globalsymtable); + if assigned(current_module.localsymtable) then + write_symtable_defs(current_asmdata.asmlists[al_dwarf_info],current_module.localsymtable); + + { write defs not written yet } + write_remaining_defs_to_write(current_asmdata.asmlists[al_dwarf_info]); + + { close compilation unit entry } + finish_children; + + { end of debug info table } + current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.createname(target_asm.labelprefix+'edebug_info0',AT_DATA,0)); + + { end of abbrev table } + current_asmdata.asmlists[al_dwarf_abbrev].concat(tai_const.create_8bit(0)); + + { reset all def labels } + for i:=0 to defnumberlist.count-1 do + begin + def := tdef(defnumberlist[i]); + if assigned(def) then + begin + def.dwarf_lab:=nil; + def.dbg_state:=dbg_state_unused; + end; + end; + + defnumberlist.free; + defnumberlist:=nil; + deftowritelist.free; + deftowritelist:=nil; + + current_filepos:=storefilepos; + end; + + + procedure TDebugInfoDwarf.referencesections(list:TAsmList); + var + hp : tmodule; + begin + { Reference all DEBUGINFO sections from the main .fpc section } + { to prevent eliminating them by smartlinking } + if (target_info.system in ([system_powerpc_macos]+systems_darwin)) then + exit; + new_section(list,sec_fpc,'links',0); + + { include reference to all debuginfo sections of used units } + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + If (hp.flags and uf_has_dwarf_debuginfo)=uf_has_dwarf_debuginfo then + begin + list.concat(Tai_const.Createname(make_mangledname('DEBUGSTART',hp.localsymtable,''),0)); + list.concat(Tai_const.Createname(make_mangledname('DEBUGEND',hp.localsymtable,''),0)); + end; + hp:=tmodule(hp.next); + end; + end; + + + function TDebugInfoDwarf.symname(sym: tsym): String; + begin + if (sym.typ=paravarsym) and + (vo_is_self in tparavarsym(sym).varoptions) then + { We use 'this' for regular methods because that's what gdb triggers + on to automatically search fields. Don't do this for class methods, + because search class fields is not supported, and gdb 7.0+ fails + in this case because "this" is not a record in that case (it's a + pointer to a vmt) } + if not is_objc_class_or_protocol(tdef(sym.owner.defowner.owner.defowner)) and + not(po_classmethod in tabstractprocdef(sym.owner.defowner).procoptions) then + result:='this' + else + result:='self' + else if (sym.typ=typesym) and + is_objc_class_or_protocol(ttypesym(sym).typedef) then + result:=tobjectdef(ttypesym(sym).typedef).objextname^ + else if (ds_dwarf_method_class_prefix in current_settings.debugswitches) and + (sym.typ=procsym) and + (tprocsym(sym).owner.symtabletype in [objectsymtable,recordsymtable]) then + result:=tprocsym(sym).owner.name^+'__'+symdebugname(sym) + else + result:=symdebugname(sym); + end; + + + procedure tdebuginfodwarf.append_visibility(vis: tvisibility); + begin + case vis of + vis_private, + vis_strictprivate: + append_attribute(DW_AT_accessibility,DW_FORM_data1,[ord(DW_ACCESS_private)]); + vis_protected, + vis_strictprotected: + append_attribute(DW_AT_accessibility,DW_FORM_data1,[ord(DW_ACCESS_protected)]); + vis_public: + { default }; + end; + end; + + + procedure TDebugInfoDwarf.insertlineinfo(list:TAsmList); + var + currfileinfo, + lastfileinfo : tfileposinfo; + currfuncname : pshortstring; + currsectype : TAsmSectiontype; + hp, hpend : tai; + infile : tinputfile; + prevcolumn, + diffline, + prevline, + prevfileidx, + currfileidx, + nolineinfolevel : Integer; + prevlabel, + currlabel : tasmlabel; + begin + { this function will always terminate the lineinfo block } + generated_lineinfo := true; + FillChar(lastfileinfo,sizeof(lastfileinfo),0); + currfuncname:=nil; + currsectype:=sec_code; + hp:=Tai(list.first); + prevcolumn := 0; + prevline := 1; + prevfileidx := 1; + prevlabel := nil; + nolineinfolevel:=0; + while assigned(hp) do + begin + case hp.typ of + ait_section : + currsectype:=tai_section(hp).sectype; + ait_function_name : + begin + currfuncname:=tai_function_name(hp).funcname; + asmline.concat(tai_comment.Create(strpnew('function: '+currfuncname^))); + end; + ait_force_line : + begin + lastfileinfo.line:=-1; + end; + ait_marker : + begin + case tai_marker(hp).kind of + mark_NoLineInfoStart: + inc(nolineinfolevel); + mark_NoLineInfoEnd: + dec(nolineinfolevel); + end; + end; + end; + + if (currsectype=sec_code) and + (hp.typ=ait_instruction) and + (nolineinfolevel=0) then + begin + currfileinfo:=tailineinfo(hp).fileinfo; + { file changed ? (must be before line info) } + if (currfileinfo.fileindex<>0) and + ((lastfileinfo.fileindex<>currfileinfo.fileindex) or + (lastfileinfo.moduleindex<>currfileinfo.moduleindex)) then + begin + infile:=get_module(currfileinfo.moduleindex).sourcefiles.get_file(currfileinfo.fileindex); + if assigned(infile) then + begin + currfileidx := get_file_index(infile); + if prevfileidx <> currfileidx then + begin + list.insertbefore(tai_comment.Create(strpnew('path: '+infile.path^)), hp); + list.insertbefore(tai_comment.Create(strpnew('file: '+infile.name^)), hp); + list.insertbefore(tai_comment.Create(strpnew('indx: '+tostr(currfileidx))), hp); + + { set file } + asmline.concat(tai_comment.Create(strpnew('path: '+infile.path^))); + asmline.concat(tai_comment.Create(strpnew('file: '+infile.name^))); + asmline.concat(tai_const.create_8bit(DW_LNS_set_file)); + asmline.concat(tai_const.create_uleb128bit(currfileidx)); + + prevfileidx := currfileidx; + end; + { force new line info } + lastfileinfo.line:=-1; + end; + end; + + { line changed ? } + if (lastfileinfo.line<>currfileinfo.line) and (currfileinfo.line<>0) then + begin + { set address } + current_asmdata.getlabel(currlabel, alt_dbgline); + list.insertbefore(tai_label.create(currlabel), hp); + + asmline.concat(tai_comment.Create(strpnew('['+tostr(currfileinfo.line)+':'+tostr(currfileinfo.column)+']'))); + + if (prevlabel = nil) or + { darwin's assembler cannot create an uleb128 of the difference } + { between to symbols } + (target_info.system in systems_darwin) then + begin + asmline.concat(tai_const.create_8bit(DW_LNS_extended_op)); + asmline.concat(tai_const.create_uleb128bit(1+sizeof(pint))); + asmline.concat(tai_const.create_8bit(DW_LNE_set_address)); + asmline.concat(tai_const.create_sym(currlabel)); + end + else + begin + asmline.concat(tai_const.create_8bit(DW_LNS_advance_pc)); + asmline.concat(tai_const.create_rel_sym(aitconst_uleb128bit, prevlabel, currlabel)); + end; + prevlabel := currlabel; + + { set column } + if prevcolumn <> currfileinfo.column then + begin + asmline.concat(tai_const.create_8bit(DW_LNS_set_column)); + asmline.concat(tai_const.create_uleb128bit(currfileinfo.column)); + prevcolumn := currfileinfo.column; + end; + + { set line } + diffline := currfileinfo.line - prevline; + if (diffline >= LINE_BASE) and (OPCODE_BASE + diffline - LINE_BASE <= 255) then + begin + { use special opcode, this also adds a row } + asmline.concat(tai_const.create_8bit(OPCODE_BASE + diffline - LINE_BASE)); + end + else + begin + if diffline <> 0 then + begin + asmline.concat(tai_const.create_8bit(DW_LNS_advance_line)); + asmline.concat(tai_const.create_sleb128bit(diffline)); + end; + { no row added yet, do it manually } + asmline.concat(tai_const.create_8bit(DW_LNS_copy)); + end; + prevline := currfileinfo.line; + end; + + lastfileinfo:=currfileinfo; + end; + + hpend:=hp; + hp:=tai(hp.next); + end; + + if assigned(hpend) then + begin + { set address for end (see appendix 3 of dwarf 2 specs) } + current_asmdata.getlabel(currlabel, alt_dbgline); + list.insertafter(tai_label.create(currlabel), hpend); + asmline.concat(tai_const.create_8bit(DW_LNS_extended_op)); + asmline.concat(tai_const.create_uleb128bit(1+sizeof(pint))); + asmline.concat(tai_const.create_8bit(DW_LNE_set_address)); + asmline.concat(tai_const.create_sym(currlabel)); + end; + + { end sequence } + asmline.concat(tai_const.Create_8bit(DW_LNS_extended_op)); + asmline.concat(tai_const.Create_8bit(1)); + asmline.concat(tai_const.Create_8bit(DW_LNE_end_sequence)); + asmline.concat(tai_comment.Create(strpnew('###################'))); + end; + + + procedure TDebugInfoDwarf.finish_lineinfo; + var + infile: tinputfile; + begin + { only needed if no line info at all has been generated } + if generated_lineinfo then + begin + { reset for next module compilation } + generated_lineinfo:=false; + exit; + end; + { at least the Darwin linker is annoyed if you do not } + { finish the lineinfo section, or if it doesn't } + { contain at least one file name and set_address } + infile:=current_module.sourcefiles.get_file(1); + if not assigned(infile) then + internalerror(2006020211); + asmline.concat(tai_const.create_8bit(DW_LNS_set_file)); + asmline.concat(tai_const.create_uleb128bit(get_file_index(infile))); + + asmline.concat(tai_const.create_8bit(DW_LNS_extended_op)); + asmline.concat(tai_const.create_uleb128bit(1+sizeof(pint))); + asmline.concat(tai_const.create_8bit(DW_LNE_set_address)); + asmline.concat(tai_const.create_sym(nil)); + asmline.concat(tai_const.create_8bit(DW_LNS_extended_op)); + asmline.concat(tai_const.Create_8bit(1)); + asmline.concat(tai_const.Create_8bit(DW_LNE_end_sequence)); + asmline.concat(tai_comment.Create(strpnew('###################'))); + end; + +{**************************************************************************** + TDebugInfoDwarf2 +****************************************************************************} + + procedure TDebugInfoDwarf2.appenddef_file(list:TAsmList;def: tfiledef); + begin + { gdb 6.4 doesn't support files so far so we use some fake recorddef + file recs. are less than 1k so using data2 is enough } + if assigned(def.typesym) then + append_entry(DW_TAG_structure_type,false,[ + DW_AT_name,DW_FORM_string,symname(def.typesym)+#0, + DW_AT_byte_size,DW_FORM_udata,def.size + ]) + else + append_entry(DW_TAG_structure_type,false,[ + DW_AT_byte_size,DW_FORM_udata,def.size + ]); + finish_entry; + end; + + procedure TDebugInfoDwarf2.appenddef_formal(list:TAsmList;def: tformaldef); + begin + { gdb 6.4 doesn't support DW_TAG_unspecified_type so we + replace it with a unsigned type with size 0 (FK) + } + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,'FormalDef'#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned, + DW_AT_byte_size,DW_FORM_data1,0 + ]); + finish_entry; + end; + + procedure TDebugInfoDwarf2.append_object_struct(def: tobjectdef; const createlabel: boolean; const objectname: PShortString); + begin + if createlabel then + begin + if not(tf_dwarf_only_local_labels in target_info.flags) then + current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create_global(def_dwarf_class_struct_lab(def),0)) + else + current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(def_dwarf_class_struct_lab(def),0)); + end; + if assigned(objectname) then + append_entry(DW_TAG_class_type,true,[ + DW_AT_name,DW_FORM_string,objectname^+#0, + DW_AT_byte_size,DW_FORM_udata,tobjectsymtable(def.symtable).datasize + ]) + else + append_entry(DW_TAG_class_type,true,[ + DW_AT_byte_size,DW_FORM_udata,tobjectsymtable(def.symtable).datasize + ]); + { Apple-specific tag that identifies it as an Objective-C class } + if (def.objecttype=odt_objcclass) then + append_attribute(DW_AT_APPLE_runtime_class,DW_FORM_data1,[DW_LANG_ObjC]); + + finish_entry; + if assigned(def.childof) then + begin + append_entry(DW_TAG_inheritance,false,[ + DW_AT_accessibility,DW_FORM_data1,DW_ACCESS_public, + DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0) + ]); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0)); + if (def.childof.dbg_state=dbg_state_unused) then + def.childof.dbg_state:=dbg_state_used; + if is_implicit_pointer_object_type(def) then + append_labelentry_ref(DW_AT_type,def_dwarf_class_struct_lab(def.childof)) + else + append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.childof)); + finish_entry; + end; + if (oo_has_vmt in def.objectoptions) and + (not assigned(def.childof) or + not(oo_has_vmt in def.childof.objectoptions)) then + begin + { vmt field } + append_entry(DW_TAG_member,false,[ + DW_AT_artificial,DW_FORM_flag,true, + DW_AT_name,DW_FORM_string,'_vptr$'+def.objname^+#0, + DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(def.vmt_offset) + ]); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(def.vmt_offset)); + { should be changed into a pointer to a function returning an } + { int and with TAG_unspecified_parameters } + if (voidpointertype.dbg_state=dbg_state_unused) then + voidpointertype.dbg_state:=dbg_state_used; + append_labelentry_ref(DW_AT_type,def_dwarf_lab(voidpointertype)); + finish_entry; + end; + + def.symtable.symList.ForEachCall(@enum_membersyms_callback,nil); + { Write the methods in the scope of the class/object, except for Objective-C. } + if is_objc_class_or_protocol(def) then + finish_children; + { don't write procdefs of externally defined classes, gcc doesn't + either (info is probably gotten from ObjC runtime) } + if not(oo_is_external in def.objectoptions) then + write_symtable_procdefs(current_asmdata.asmlists[al_dwarf_info],def.symtable); + if not is_objc_class_or_protocol(def) then + finish_children; + end; + + + procedure TDebugInfoDwarf2.appenddef_object(list:TAsmList;def: tobjectdef); + + begin + case def.objecttype of + odt_cppclass, + odt_object: + append_object_struct(def,false,def.objname); + odt_interfacecom, + odt_interfacecorba, + odt_dispinterface, + odt_helper, + odt_class: + begin + { implicit pointer } + append_entry(DW_TAG_pointer_type,false,[]); + append_labelentry_ref(DW_AT_type,def_dwarf_class_struct_lab(def)); + finish_entry; + + append_object_struct(def,true,def.objname); + end; + odt_objcclass: + { Objective-C class: same as regular class, except for + a) Apple-specific tag that identifies it as an Objective-C class + b) use extname^ instead of objname + } + append_object_struct(def,true,def.objextname); + odt_objcprotocol: + begin + append_entry(DW_TAG_pointer_type,false,[]); + append_labelentry_ref(DW_AT_type,def_dwarf_lab(voidpointertype)); + finish_entry; + end; + else + internalerror(200602041); + end; + end; + + procedure TDebugInfoDwarf2.appenddef_set_intern(list:TAsmList;def: tsetdef; force_tag_set: boolean); + var + lab: tasmlabel; + begin + if force_tag_set or + (ds_dwarf_sets in current_settings.debugswitches) then + begin + { current (20070704 -- patch was committed on 20060513) gdb cvs supports set types } + + if assigned(def.typesym) then + append_entry(DW_TAG_set_type,false,[ + DW_AT_name,DW_FORM_string,symname(def.typesym)+#0, + DW_AT_byte_size,DW_FORM_data2,def.size + ]) + else + append_entry(DW_TAG_set_type,false,[ + DW_AT_byte_size,DW_FORM_data2,def.size + ]); + if assigned(def.elementdef) then + begin + if not(tf_dwarf_only_local_labels in target_info.flags) then + current_asmdata.getdatalabel(lab) + else + current_asmdata.getaddrlabel(lab); + append_labelentry_ref(DW_AT_type,lab); + finish_entry; + current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(lab,0)); + { Sets of e.g. [1..5] are actually stored as a set of [0..7], + so write the exact boundaries of the set here. Let's hope no + debugger ever rejects this because this "subrange" type can + actually have a larger range than the original one. } + append_entry(DW_TAG_subrange_type,false,[ + DW_AT_lower_bound,DW_FORM_sdata,def.setbase, + DW_AT_upper_bound,DW_FORM_sdata,get_max_value(def.elementdef).svalue + ]); + append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef)) + end + end + else + begin + { gdb versions which don't support sets refuse to load the debug } + { info of modules that contain set tags } + if assigned(def.typesym) then + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,symname(def.typesym)+#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned, + DW_AT_byte_size,DW_FORM_data2,def.size + ]) + else + append_entry(DW_TAG_base_type,false,[ + DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned, + DW_AT_byte_size,DW_FORM_data2,def.size + ]); + end; + finish_entry; + end; + + procedure TDebugInfoDwarf2.appenddef_set(list:TAsmList;def: tsetdef); + begin + appenddef_set_intern(list,def,false); + end; + + procedure TDebugInfoDwarf2.appenddef_undefined(list:TAsmList;def: tundefineddef); + begin + { gdb 6.4 doesn't support DW_TAG_unspecified_type so we + replace it with a unsigned type with size 0 (FK) + } + append_entry(DW_TAG_base_type,false,[ + DW_AT_name,DW_FORM_string,'FormalDef'#0, + DW_AT_encoding,DW_FORM_data1,DW_ATE_unsigned, + DW_AT_byte_size,DW_FORM_data1,0 + ]); + finish_entry; + end; + + procedure TDebugInfoDwarf2.appenddef_variant(list:TAsmList;def: tvariantdef); + begin + { variants aren't known to dwarf2 but writting tvardata should be enough } + if assigned(vardatadef) then + appenddef_record_named(list,trecorddef(vardatadef),'Variant'); + end; + + function TDebugInfoDwarf2.dwarf_version: Word; + begin + Result:=2; + end; + +{**************************************************************************** + TDebugInfoDwarf3 +****************************************************************************} + + procedure TDebugInfoDwarf3.append_labelentry_addr_ref(attr : tdwarf_attribute;sym : tasmsymbol); + begin + AddConstToAbbrev(ord(DW_FORM_ref_addr)); + { Since Dwarf 3 the length of a DW_FORM_ref_addr entry is not dependent on the pointer size of the + target platform, but on the used Dwarf-format (32 bit or 64 bit) for the current compilation section. } + if use_64bit_headers then + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_type_sym(aitconst_64bit,sym)) + else + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.Create_type_sym(aitconst_32bit,sym)); + end; + + procedure tdebuginfodwarf3.appenddef_array(list: tasmlist; def: tarraydef); + begin + if not is_dynamic_array(def) then + begin + inherited appenddef_array(list,def); + exit; + end; + + if assigned(def.typesym) then + append_entry(DW_TAG_array_type,true,[ + DW_AT_name,DW_FORM_string,symname(def.typesym)+#0, + DW_AT_data_location,DW_FORM_block1,2 + ]) + else + append_entry(DW_TAG_array_type,true,[ + DW_AT_data_location,DW_FORM_block1,2 + ]); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); + + append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.elementdef)); + finish_entry; + { to simplify things, we don't write a multidimensional array here } + append_entry(DW_TAG_subrange_type,false,[ + DW_AT_byte_stride,DW_FORM_udata,def.elesize, + DW_AT_lower_bound,DW_FORM_udata,0, + DW_AT_upper_bound,DW_FORM_block1,14 + ]); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_dup))); + { pointer = nil? } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_bra))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(5)); + { yes -> length = 0 } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_const1s))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(byte(-1))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_skip))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(3)); + { no -> load length } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+sizeof(ptrint))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_minus))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); + append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.rangedef)); + finish_entry; + + finish_children; + end; + + + procedure tdebuginfodwarf3.appenddef_string(list: tasmlist; def: tstringdef); + + procedure addstringdef(const name: shortstring; chardef: tdef; deref: boolean; lensize: aint); + var + upperopcodes: longint; + begin + { deref=true -> ansi/unicde/widestring; deref = false -> short/longstring } + if assigned(def.typesym) then + append_entry(DW_TAG_array_type,true,[ + DW_AT_name,DW_FORM_string,name+#0, + DW_AT_data_location,DW_FORM_block1,2+ord(not(deref)) + ]) + else + append_entry(DW_TAG_array_type,true,[ + DW_AT_data_location,DW_FORM_block1,2+ord(not(deref)) + ]); + + { in all cases we start with the address of the string } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); + if deref then + begin + { ansi/unicode/widestring -> dereference the address of the string, and then + we point to address of the string + } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); + end + else + begin + { shortstring characters begin at string[1], so add one to the string's address } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+lensize)); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus))) + end; + + { reference to the element type of the string } + append_labelentry_ref(DW_AT_type,def_dwarf_lab(chardef)); + finish_entry; + + { now the information about the length of the string } + if deref then + begin + if (chardef.size=1) then + upperopcodes:=13 + else + upperopcodes:=15; + { lower bound is always 1, upper bound (length) needs to be calculated } + append_entry(DW_TAG_subrange_type,false,[ + DW_AT_lower_bound,DW_FORM_udata,1, + DW_AT_upper_bound,DW_FORM_block1,upperopcodes + ]); + + { high(string) is stored sizeof(ptrint) bytes before the string data } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_dup))); + { pointer = nil? } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_bra))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(4)); + { yes -> length = 0 } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_skip))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_16bit(3)); + { no -> load length } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit0)+sizeof(ptrint))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_minus))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); + + { for widestrings, the length is specified in bytes, so divide by two } + if (upperopcodes=15) then + begin + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_lit1))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_shr))); + end; + end + else + begin + append_entry(DW_TAG_subrange_type,false,[ + DW_AT_lower_bound,DW_FORM_udata,1, + DW_AT_upper_bound,DW_FORM_block1,3 + ]); + { for shortstrings, the length is the first byte of the string } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); + { load 1 byte } + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref_size))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(lensize)); + end; + finish_entry; + + finish_children; + end; + + begin + case def.stringtype of + st_shortstring: + begin + addstringdef('ShortString',cchartype,false,1); + end; + st_longstring: + begin +{$ifdef cpu64bitaddr} + addstringdef('LongString',cchartype,false,8); +{$else cpu64bitaddr} + addstringdef('LongString',cchartype,false,4); +{$endif cpu64bitaddr} + end; + st_ansistring: + begin + addstringdef('AnsiString',cchartype,true,-1); + end; + st_unicodestring: + begin + addstringdef('UnicodeString',cwidechartype,true,-1); + end; + st_widestring: + begin + if not(tf_winlikewidestring in target_info.flags) then + addstringdef('WideString',cwidechartype,true,-1) + else + begin + { looks like a pwidechar (no idea about length location) } + append_entry(DW_TAG_pointer_type,false,[]); + append_labelentry_ref(DW_AT_type,def_dwarf_lab(cwidechartype)); + finish_entry; + end; + end; + end; + end; + + procedure TDebugInfoDwarf3.appenddef_file(list:TAsmList;def: tfiledef); + begin + if assigned(def.typesym) then + append_entry(DW_TAG_file_type,false,[ + DW_AT_name,DW_FORM_string,symname(def.typesym)+#0, + DW_AT_byte_size,DW_FORM_data2,def.size + ]) + else + append_entry(DW_TAG_file_type,false,[ + DW_AT_byte_size,DW_FORM_data2,def.size + ]); + if tfiledef(def).filetyp=ft_typed then + append_labelentry_ref(DW_AT_type,def_dwarf_lab(tfiledef(def).typedfiledef)); + finish_entry; + end; + + procedure TDebugInfoDwarf3.appenddef_formal(list:TAsmList;def: tformaldef); + begin + append_entry(DW_TAG_unspecified_type,false,[ + ]); + finish_entry; + end; + + procedure TDebugInfoDwarf3.appenddef_object(list:TAsmList;def: tobjectdef); + + procedure dostruct(tag: tdwarf_tag); + begin + if assigned(def.objname) then + append_entry(tag,true,[ + DW_AT_name,DW_FORM_string,def.objrealname^+#0 + ]) + else + append_entry(DW_TAG_structure_type,true,[]); + append_attribute(DW_AT_byte_size,DW_FORM_udata,[tobjectsymtable(def.symtable).datasize]); + // The pointer to the class-structure is hidden. The debug-information + // does not contain an implicit pointer, but the data-adress is dereferenced here. + // In case of a nil-pointer, report the class as being unallocated. + append_block1(DW_AT_allocated,2); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); + append_block1(DW_AT_data_location,2); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_push_object_address))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_deref))); + finish_entry; + end; + + procedure doimplicitpointer; + var + obj : tasmlabel; + begin + if not(tf_dwarf_only_local_labels in target_info.flags) then + current_asmdata.getdatalabel(obj) + else + current_asmdata.getaddrlabel(obj); + { implicit pointer } + append_entry(DW_TAG_pointer_type,false,[]); + append_labelentry_ref(DW_AT_type,obj); + finish_entry; + + current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(obj,0)); + end; + + procedure doparent(isinterface: boolean); + begin + if not assigned(def.childof) then + exit; + + if isinterface then + begin + append_entry(DW_TAG_inheritance,false,[]); + end + else + begin + append_entry(DW_TAG_inheritance,false,[ + DW_AT_accessibility,DW_FORM_data1,DW_ACCESS_public, + DW_AT_data_member_location,DW_FORM_block1,1+lengthuleb128(0) + ]); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_8bit(ord(DW_OP_plus_uconst))); + current_asmdata.asmlists[al_dwarf_info].concat(tai_const.create_uleb128bit(0)); + end; + append_labelentry_ref(DW_AT_type,def_dwarf_lab(def.childof)); + finish_entry; + end; + + var + n: integer; + + begin + case def.objecttype of + odt_cppclass, + odt_object: + begin + dostruct(DW_TAG_structure_type); + doparent(false); + end; + odt_interfacecom, + odt_interfacecorba, + odt_dispinterface: + begin + dostruct(DW_TAG_interface_type); + doparent(true); + end; + odt_helper, + odt_class: + begin + //dostruct(DW_TAG_class_type); + //doparent(false); + append_entry(DW_TAG_pointer_type,false,[]); + append_labelentry_ref(DW_AT_type,def_dwarf_class_struct_lab(def)); + finish_entry; + + append_object_struct(def,true,def.objrealname); + Exit; + end; + else + internalerror(200609171); + end; + + { add implemented interfaces } + if assigned(def.ImplementedInterfaces) then + for n := 0 to def.ImplementedInterfaces.count-1 do + begin + append_entry(DW_TAG_inheritance,false,[]); + append_labelentry_ref(DW_AT_type,def_dwarf_lab(TImplementedInterface(def.ImplementedInterfaces[n]).IntfDef)); + finish_entry; + end; + + { add members } + def.symtable.symList.ForEachCall(@enum_membersyms_callback,nil); + finish_children; + end; + + procedure TDebugInfoDwarf3.appenddef_set(list:TAsmList;def: tsetdef); + begin + appenddef_set_intern(list,def,true); + end; + + procedure TDebugInfoDwarf3.appenddef_undefined(list:TAsmList;def: tundefineddef); + begin + { ??? can a undefined def have a typename ? } + if assigned(def.typesym) then + append_entry(DW_TAG_unspecified_type,false,[ + DW_AT_name,DW_FORM_string,symname(def.typesym)+#0 + ]) + else + append_entry(DW_TAG_unspecified_type,false,[ + ]); + finish_entry; + end; + + procedure TDebugInfoDwarf3.appenddef_variant(list:TAsmList;def: tvariantdef); + const + VARIANTS: array[1..27] of record Value: Word; Name: String end = ( + (value:0; name:''), + (value:1; name:''), + (value:2; name:'VSMALLINT'), + (value:3; name:'VINTEGER'), + (value:4; name:'VSINGLE'), + (value:5; name:'VDOUBLE'), + (value:6; name:'VCURRENCY'), + (value:7; name:'VDATE'), + (value:8; name:'VOLESTR'), + (value:9; name:'VDISPATCH'), + (value:10; name:'VERROR'), + (value:11; name:'VBOOLEAN'), + (value:12; name:''), + (value:13; name:'VUNKNOWN'), + (value:14; name:''), + (value:16; name:'VSHORTINT'), + (value:17; name:'VBYTE'), + (value:18; name:'VWORD'), + (value:19; name:'VLONGWORD'), + (value:20; name:'VINT64'), + (value:21; name:'VQWORD'), + (value:36; name:'VRECORD'), + (value:$48; name:''), + (value:$100; name:'VSTRING'), + (value:$101; name:'VANY'), + (value:$2000; name:'VARRAY'), + (value:$4000; name:'VPOINTER') + ); + var + fs: tfieldvarsym; + lbl: tasmlabel; + idx: integer; + begin + { it could be done with DW_TAG_variant for the union part (if that info was available) + now we do it manually for variants (MWE) } + + { struct } + append_entry(DW_TAG_structure_type,true,[ + DW_AT_name,DW_FORM_string,'Variant'#0, + DW_AT_byte_size,DW_FORM_udata,vardatadef.size + ]); + finish_entry; + + append_entry(DW_TAG_variant_part,true,[ + ]); + current_asmdata.getaddrlabel(lbl); + append_labelentry_ref(DW_AT_discr,lbl); + finish_entry; + + { discriminant } + fs := tfieldvarsym(vardatadef.symtable.Find('VTYPE')); + if (fs = nil) or (fs.typ <> fieldvarsym) then + internalerror(200609271); + current_asmdata.asmlists[al_dwarf_info].concat(tai_symbol.create(lbl,0)); + appendsym_fieldvar(list,fs); + + { variants } + for idx := Low(VARIANTS) to High(VARIANTS) do + begin + append_entry(DW_TAG_variant,true,[ + DW_AT_discr_value,DW_FORM_udata,VARIANTS[idx].value + ]); + finish_entry; + + if VARIANTS[idx].name <> '' then + begin + fs := tfieldvarsym(vardatadef.symtable.Find(VARIANTS[idx].name)); + if (fs = nil) or (fs.typ <> fieldvarsym) then + internalerror(20060927200+idx); + appendsym_fieldvar(list,fs); + end; + + finish_children; { variant } + end; + + + finish_children; { variant part } + + finish_children; { struct } + end; + + function TDebugInfoDwarf3.dwarf_version: Word; + begin + Result:=3; + end; + + function TDebugInfoDwarf3.symdebugname(sym: tsym): String; + begin + Result:=sym.realname; + end; + + + { TDebugInfoDwarf4 } + + function TDebugInfoDwarf4.dwarf_version: Word; + begin + Result:=4; + end; + + +{**************************************************************************** +****************************************************************************} + const + dbg_dwarf2_info : tdbginfo = + ( + id : dbg_dwarf2; + idtxt : 'DWARF2'; + ); + + dbg_dwarf3_info : tdbginfo = + ( + id : dbg_dwarf3; + idtxt : 'DWARF3'; + ); + + dbg_dwarf4_info : tdbginfo = + ( + id : dbg_dwarf4; + idtxt : 'DWARF4'; + ); + + +initialization + RegisterDebugInfo(dbg_dwarf2_info,TDebugInfoDwarf2); + RegisterDebugInfo(dbg_dwarf3_info,TDebugInfoDwarf3); + RegisterDebugInfo(dbg_dwarf4_info,TDebugInfoDwarf4); + +end. diff --git a/closures/compiler/dbgstabs.pas b/closures/compiler/dbgstabs.pas new file mode 100644 index 0000000000..625a58d6a8 --- /dev/null +++ b/closures/compiler/dbgstabs.pas @@ -0,0 +1,1732 @@ +{ + 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,cgbase, + symtype,symdef,symsym,symtable,symbase, + aasmtai,aasmdata; + + const + { stab types } + 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; +{ APPLE LOCAL N_OSO: This is the stab that associated the .o file with the + N_SO stab, in the case where debug info is mostly stored in the .o file. } + N_OSO = $66; + N_IncludeFile = $84; + N_BINCL = $82; + N_EINCL = $A2; + N_LBRAC = $C0; + N_EXCL = $C2; + N_RBRAC = $E0; + + type + TDebugInfoStabs=class(TDebugInfo) + private + writing_def_stabs : boolean; + global_stab_number : word; + vardatadef: trecorddef; + { 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):ansistring; + procedure write_sym_stabstr(list:TAsmList;sym:tsym;const ss:ansistring); + { tdef writing } + function def_stab_number(def:tdef):string; + function def_stab_classnumber(def:tabstractrecorddef):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):ansistring; + procedure write_def_stabstr(list:TAsmList;def:tdef;const ss:ansistring); + procedure field_add_stabstr(p:TObject;arg:pointer); + procedure method_add_stabstr(p:TObject;arg:pointer); + procedure field_write_defs(p:TObject;arg:pointer); + function get_enum_defstr(def: tenumdef; lowerbound: longint): ansistring; + function get_appendsym_paravar_reg(sym:tparavarsym;const typ,stabstr:string;reg: tregister): ansistring; + protected + procedure appendsym_staticvar(list:TAsmList;sym:tstaticvarsym);override; + procedure appendsym_paravar(list:TAsmList;sym:tparavarsym);override; + procedure appendsym_localvar(list:TAsmList;sym:tlocalvarsym);override; + procedure appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym);override; + procedure appendsym_const(list:TAsmList;sym:tconstsym);override; + procedure appendsym_type(list:TAsmList;sym:ttypesym);override; + procedure appendsym_label(list:TAsmList;sym:tlabelsym);override; + procedure beforeappenddef(list:TAsmList;def:tdef);override; + procedure appenddef_ord(list:TAsmList;def:torddef);override; + procedure appenddef_float(list:TAsmList;def:tfloatdef);override; + procedure appenddef_file(list:TAsmList;def:tfiledef);override; + procedure appenddef_enum(list:TAsmList;def:tenumdef);override; + procedure appenddef_array(list:TAsmList;def:tarraydef);override; + procedure appenddef_record(list:TAsmList;def:trecorddef);override; + procedure appenddef_object(list:TAsmList;def:tobjectdef);override; + procedure appenddef_pointer(list:TAsmList;def:tpointerdef);override; + procedure appenddef_string(list:TAsmList;def:tstringdef);override; + procedure appenddef_procvar(list:TAsmList;def:tprocvardef);override; + procedure appenddef_variant(list:TAsmList;def:tvariantdef);override; + procedure appenddef_set(list:TAsmList;def:tsetdef);override; + procedure appenddef_formal(list:TAsmList;def:tformaldef);override; + procedure appenddef_undefined(list:TAsmList;def: tundefineddef);override; + procedure appendprocdef(list:TAsmList;def:tprocdef);override; + public + procedure inserttypeinfo;override; + procedure insertmoduleinfo;override; + procedure insertlineinfo(list:TAsmList);override; + procedure referencesections(list:TAsmList);override; + + constructor Create;override; + end; + + +implementation + + uses + SysUtils,cutils,cfileutl, + systems,globals,globtype,verbose,constexp, + symconst,defutil, + cpuinfo,cpubase,paramgr, + aasmbase,procinfo, + finput,fmodule,ppu; + + function GetSymName(Sym : TSymEntry) : string; + begin + if Not (cs_stabs_preservecase in current_settings.globalswitches) then + result := Sym.Name + else + result := Sym.RealName; +{$ifdef avr} + if target_asm.id=as_gas then + result:=ReplaceForbiddenChars(result); +{$endif avr} + end; + + function GetSymTableName(SymTable : TSymTable) : string; + begin + if Not (cs_stabs_preservecase in current_settings.globalswitches) then + result := SymTable.Name^ + else + result := SymTable.RealName^; +{$ifdef avr} + if target_asm.id=as_gas then + result:=ReplaceForbiddenChars(result); +{$endif avr} + end; + + const + memsizeinc = 512; + + tagtypes = [ + recorddef, + variantdef, + enumdef, + stringdef, + filedef, + objectdef + ]; + + type + get_var_value_proc=function(const s:string;arg:pointer):string of object; + + + function string_evaluate(s:string;get_var_value:get_var_value_proc;get_var_value_arg:pointer;const vars:array of string):ansistring; + (* + 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 pshortstring; + {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:longint; + r:Pchar; + + begin + {Two pass approach, first, calculate the length and receive variables.} + i:=1; + len:=0; + varcounter:=0; + varptr:=@varvaluedata[0]; + 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]:=pshortstring(varptr); + if varptr>@varvaluedata[maxdata] then + internalerrorproc(200411152); + pshortstring(varptr)^:=get_var_value(varname,get_var_value_arg); + inc(len,length(pshortstring(varptr)^)); + inc(varptr,length(pshortstring(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.} + setlength(result,len); + r:=pchar(result); + 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; + { verify that the length was correct } + if r^<>#0 then + internalerror(200802031); + 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.typ=procdef) then + def.dbg_state:=dbg_state_written; + + { Stab must already be written, or we must be busy writing it } + if writing_def_stabs and + not(def.dbg_state in [dbg_state_writing,dbg_state_written,dbg_state_queued]) then + internalerror(200403091); + + { Keep track of used stabs, this info is only useful for stabs + referenced by the symbols. Definitions will always include all + required stabs } + if def.dbg_state=dbg_state_unused then + begin + def.dbg_state:=dbg_state_used; + deftowritelist.Add(def); + end; + { 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:tabstractrecorddef):string; + begin + if def.stab_number=0 then + def_stab_number(def); + if (def.typ=objectdef) and (tobjectdef(def).objecttype=odt_class) then + result:=tostr(def.stab_number-1) + else + result:=tostr(def.stab_number); + 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:=GetSymName(Ttypesym(def.typesym)); + 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):ansistring; + begin + result:=string_evaluate(s,@def_var_value,def,vars); + end; + + + procedure TDebugInfoStabs.field_add_stabstr(p:TObject;arg:pointer); + var + spec : string[3]; + varsize : asizeint; + newss : ansistring; + ss : pansistring absolute arg; + begin + if (tsym(p).visibility=vis_hidden) then + exit; + { static variables from objects are like global objects } + if (Tsym(p).typ=fieldvarsym) and + not(sp_static in Tsym(p).symoptions) then + begin + case tsym(p).visibility of + vis_private, + vis_strictprivate : + spec:='/0'; + vis_protected, + vis_strictprotected : + spec:='/1'; + else + spec:=''; + end; + if (tabstractrecordsymtable(tsym(p).owner).usefieldalignment<>bit_alignment) then + begin + varsize:=tfieldvarsym(p).vardef.size; + { open arrays made overflows !! } + { how can a record/object/class contain an open array? (JM) } +{$ifdef cpu16bitaddr} + if varsize>$fff then + varsize:=$fff; +{$else cpu16bitaddr} + if varsize>$fffffff then + varsize:=$fffffff; +{$endif cpu16bitaddr} + newss:=def_stabstr_evaluate(nil,'$1:$2,$3,$4;',[GetSymName(tfieldvarsym(p)), + spec+def_stab_number(tfieldvarsym(p).vardef), + tostr(TConstExprInt(tfieldvarsym(p).fieldoffset)*8),tostr(varsize*8)]) + end + else + newss:=def_stabstr_evaluate(nil,'$1:$2,$3,$4;',[GetSymName(tfieldvarsym(p)), + spec+def_stab_number(tfieldvarsym(p).vardef), + tostr(TConstExprInt(tfieldvarsym(p).fieldoffset)),tostr(tfieldvarsym(p).vardef.packedbitsize)]); + ss^:=ss^+newss; + end; + end; + + + procedure TDebugInfoStabs.method_add_stabstr(p:TObject;arg:pointer); + var + virtualind,argnames : string; + pd : tprocdef; + lindex : longint; + arglength : byte; + sp : char; + i : integer; + parasym : tparavarsym; + newss : ansistring; + ss : pansistring absolute arg; + begin + if tsym(p).typ = procsym then + begin + pd :=tprocdef(tprocsym(p).ProcdefList[0]); + if (po_virtualmethod in pd.procoptions) and + not is_objectpascal_helper(pd.struct) then + begin + lindex := pd.extnumber; + {doesnt seem to be necessary + lindex := lindex or $80000000;} + virtualind := '*'+tostr(lindex)+';'+def_stab_classnumber(pd.struct)+';' + 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.vardef.typ = formaldef then + begin + case Parasym.varspez of + vs_var : + argnames := argnames+'3var'; + vs_const : + argnames:=argnames+'5const'; + vs_out : + argnames:=argnames+'3out'; + vs_constref : + argnames:=argnames+'8constref'; + end; + end + else + begin + { if the arg definition is like (v: ^byte;.. + there is no sym attached to data !!! } + if assigned(Parasym.vardef.typesym) then + begin + arglength := length(GetSymName(Parasym.vardef.typesym)); + argnames := argnames + tostr(arglength)+GetSymName(Parasym.vardef.typesym); + end + else + argnames:=argnames+'11unnamedtype'; + end; + end; + { here 2A must be changed for private and protected } + { 0 is private 1 protected and 2 public } + case tsym(p).visibility of + vis_private, + vis_strictprivate : + sp:='0'; + vis_protected, + vis_strictprotected : + sp:='1' + else + sp:='2'; + end; + newss:=def_stabstr_evaluate(nil,'$1::$2=##$3;:$4;$5A$6;',[GetSymName(tsym(p)),def_stab_number(pd), + def_stab_number(pd.returndef),argnames,sp, + virtualind]); + ss^:=ss^+newss; + end; + end; + + + procedure TDebugInfoStabs.field_write_defs(p:TObject;arg:pointer); + begin + if (Tsym(p).typ=fieldvarsym) and + not(sp_static in Tsym(p).symoptions) then + appenddef(TAsmList(arg),tfieldvarsym(p).vardef); + end; + + + procedure TDebugInfoStabs.write_def_stabstr(list:TAsmList;def:tdef;const ss:ansistring); + var + stabchar : string[2]; + symname : string[20]; + st : ansistring; + begin + { type prefix } + if def.typ in tagtypes then + stabchar := 'Tt' + else + stabchar := 't'; + { in case of writing the class record structure, we always have to + use the class name (so it refers both to the struct and the + pointer to the struct), otherwise gdb crashes (see tests/webtbs/tw9766.pp) } + if is_class(def) and + tobjectdef(def).writing_class_record_dbginfo then + st:=def_stabstr_evaluate(def,'"${sym_name}:$1$2=',[stabchar,def_stab_classnumber(tobjectdef(def))]) + else + begin + { Type names for types defined in the current unit are already written in + the typesym } + if (def.owner.symtabletype=globalsymtable) and + not(def.owner.iscurrentunit) then + symname:='${sym_name}' + else + symname:=''; + st:=def_stabstr_evaluate(def,'"'+symname+':$1$2=',[stabchar,def_stab_number(def)]); + end; + st:=st+ss; + { line info is set to 0 for all defs, because the def can be in another + unit and then the linenumber is invalid in the current sourcefile } + st:=st+def_stabstr_evaluate(def,'",${N_LSYM},0,0,0',[]); + { add to list } + list.concat(Tai_stab.create_ansistr(stab_stabs,st)); + end; + + + procedure TDebugInfoStabs.appenddef_string(list:TAsmList;def:tstringdef); + var + bytest,charst,longst : string; + ss : ansistring; + slen : longint; + begin + ss:=''; + case def.stringtype of + st_shortstring: + begin + { fix length of openshortstring } + slen:=def.len; + if slen=0 then + slen:=255; + charst:=def_stab_number(cchartype); + bytest:=def_stab_number(u8inttype); + ss:=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); + bytest:=def_stab_number(u8inttype); + longst:=def_stab_number(u32inttype); + ss:=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 } + ss:='*'+def_stab_number(cchartype); + end; + st_unicodestring, + st_widestring: + begin + { looks like a pwidechar } + ss:='*'+def_stab_number(cwidechartype); + end; + end; + write_def_stabstr(list,def,ss); + end; + + + function TDebugInfoStabs.get_enum_defstr(def: tenumdef; lowerbound: longint): ansistring; + var + i: longint; + p: tenumsym; + begin + { we can specify the size with @s<size>; prefix PM } + if def.size <> std_param_align then + result:='@s'+tostr(def.size*8)+';e' + else + result:='e'; + { the if-test is required because pred(def.minval) might overflow; + the longint() typecast should be safe because stabs is not + supported for 64 bit targets } + if (def.minval<>lowerbound) then + for i:=lowerbound to pred(longint(def.minval)) do + result:=result+'<invalid>:'+tostr(i)+','; + + for i := 0 to def.symtable.SymList.Count - 1 do + begin + p := tenumsym(def.symtable.SymList[i]); + if p.value<def.minval then + continue + else + if p.value>def.maxval then + break; + result:=result+GetSymName(p)+':'+tostr(p.value)+','; + end; + { the final ',' is required to have a valid stabs } + result:=result+';'; + end; + + procedure TDebugInfoStabs.appenddef_enum(list:TAsmList;def:tenumdef); + begin + write_def_stabstr(list,def,get_enum_defstr(def,def.minval)); + end; + + + procedure TDebugInfoStabs.appenddef_ord(list:TAsmList;def:torddef); + var + ss : ansistring; + begin + ss:=''; + if cs_gdb_valgrind in current_settings.globalswitches then + begin + case def.ordtype of + uvoid : + ss:=def_stab_number(def); + pasbool8, + pasbool16, + pasbool32, + pasbool64, + bool8bit, + bool16bit, + bool32bit, + bool64bit : + ss:=def_stabstr_evaluate(def,'r${numberstring};0;255;',[]); + u32bit, + s64bit, + u64bit : + ss:=def_stabstr_evaluate(def,'r${numberstring};0;-1;',[]); + else + ss:=def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low.svalue)),tostr(longint(def.high.svalue))]); + end; + end + else + begin + case def.ordtype of + uvoid : + ss:=def_stab_number(def); + uchar : + ss:='-20;'; + uwidechar : + ss:='-30;'; + pasbool8, + bool8bit : + ss:='-21;'; + pasbool16, + bool16bit : + ss:='-22;'; + pasbool32, + bool32bit : + ss:='-23;'; + pasbool64, + bool64bit : + { no clue if this is correct (FK) } + ss:='-23;'; + u64bit : + ss:='-32;'; + s64bit : + ss:='-31;'; + {u32bit : result:=def_stab_number(s32inttype)+';0;-1;'); } + else + ss:=def_stabstr_evaluate(def,'r${numberstring};$1;$2;',[tostr(longint(def.low.svalue)),tostr(longint(def.high.svalue))]); + end; + end; + write_def_stabstr(list,def,ss); + end; + + + procedure TDebugInfoStabs.appenddef_float(list:TAsmList;def:tfloatdef); + var + ss : ansistring; + begin + ss:=''; + case def.floattype of + s32real, + s64real, + s80real, + sc80real: + ss:=def_stabstr_evaluate(def,'r$1;${savesize};0;',[def_stab_number(s32inttype)]); + s64currency, + s64comp: + ss:=def_stabstr_evaluate(def,'r$1;-${savesize};0;',[def_stab_number(s32inttype)]); + else + internalerror(200509261); + end; + write_def_stabstr(list,def,ss); + end; + + + procedure TDebugInfoStabs.appenddef_file(list:TAsmList;def:tfiledef); + var + ss : ansistring; + begin +{$ifdef cpu64bitaddr} + ss:=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_stab_number(s64inttype), + def_stab_number(u8inttype), + def_stab_number(cchartype)]); +{$else cpu64bitaddr} + ss:=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_stab_number(u8inttype), + def_stab_number(cchartype)]); +{$endif cpu64bitaddr} + write_def_stabstr(list,def,ss); + end; + + + procedure TDebugInfoStabs.appenddef_record(list:TAsmList;def:trecorddef); + var + ss : ansistring; + begin + ss:='s'+tostr(def.size); + def.symtable.SymList.ForEachCall(@field_add_stabstr,@ss); + ss[length(ss)]:=';'; + write_def_stabstr(list,def,ss); + end; + + + procedure TDebugInfoStabs.appenddef_object(list:TAsmList;def:tobjectdef); + + procedure do_write_object(list:TAsmList;def:tobjectdef); + var + ss : ansistring; + anc : tobjectdef; + begin + ss:=''; + { Write the invisible pointer for the class? } + if (def.objecttype=odt_class) and + (not def.writing_class_record_dbginfo) then + begin + ss:='*'+def_stab_classnumber(def); + write_def_stabstr(list,def,ss); + exit; + end; + + ss:='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 , } + ss:=ss+'!1,020,'+def_stab_classnumber(def.childof)+';'; + end; + + {virtual table to implement yet} + def.symtable.symList.ForEachCall(@field_add_stabstr,@ss); + + if (oo_has_vmt in def.objectoptions) and + ( + not assigned(def.childof) or + not(oo_has_vmt in def.childof.objectoptions) + ) then + ss:=ss+'$vf'+def_stab_classnumber(def)+':'+def_stab_number(vmtarraytype)+','+tostr(def.vmt_offset*8)+';'; + def.symtable.symList.ForEachCall(@method_add_stabstr,@ss); + 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 } + ss:=ss+';~%'+def_stab_classnumber(anc)+';'; + end + else + ss:=ss+';'; + write_def_stabstr(list,def,ss); + end; + + var + oldtypesym : tsym; + 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_dbginfo:=true; + do_write_object(list,def); + tobjectdef(def).writing_class_record_dbginfo:=false; + { Write the invisible pointer class } + oldtypesym:=def.typesym; + def.typesym:=nil; + do_write_object(list,def); + def.typesym:=oldtypesym; + end + else + do_write_object(list,def); + { VMT symbol } + if (oo_has_vmt in def.objectoptions) and + assigned(def.owner) and + assigned(def.owner.name) then + list.concat(Tai_stab.create_ansistr(stab_stabs,ansistring('"vmt_')+GetSymTableName(def.owner)+tobjectdef(def).objname^+':S'+ + def_stab_number(vmttype)+'",'+tostr(N_STSYM)+',0,0,'+ansistring(tobjectdef(def).vmt_mangledname))); + end; + + + procedure TDebugInfoStabs.appenddef_variant(list:TAsmList;def:tvariantdef); + var + ss : ansistring; + begin + if not assigned(vardatadef) then + exit; + + ss:='s'+tostr(vardatadef.size); + vardatadef.symtable.SymList.ForEachCall(@field_add_stabstr,@ss); + ss[length(ss)]:=';'; + write_def_stabstr(list,def,ss); + end; + + + procedure TDebugInfoStabs.appenddef_pointer(list:TAsmList;def:tpointerdef); + var + ss : ansistring; + begin + ss:='*'+def_stab_number(tpointerdef(def).pointeddef); + write_def_stabstr(list,def,ss); + end; + + + procedure TDebugInfoStabs.appenddef_set(list:TAsmList;def:tsetdef); + var + st, + ss : ansistring; + elementdefstabnr: string; + begin + { ugly hack: create a temporary subrange type if the lower bound of + the set's element type is not a multiple of 8 (because we store them + as if the lower bound is a multiple of 8) } + if (def.setbase<>get_min_value(def.elementdef)) then + begin + { allocate a def number } + inc(global_stab_number); + elementdefstabnr:=tostr(global_stab_number); + { anonymous subrange def } + st:='":t'+elementdefstabnr+'='; + if (def.elementdef.typ = enumdef) then + st:=st+get_enum_defstr(tenumdef(def.elementdef),def.setbase) + else + st:=st+def_stabstr_evaluate(def.elementdef,'r'+elementdefstabnr+';$1;$2;',[tostr(longint(def.setbase)),tostr(longint(get_max_value(def.elementdef).svalue))]); + st:=st+'",'+tostr(N_LSYM)+',0,0,0'; + { add to list } + list.concat(Tai_stab.create_ansistr(stab_stabs,st)); + end + else + elementdefstabnr:=def_stab_number(def.elementdef); + ss:=def_stabstr_evaluate(def,'@s$1;S$2',[tostr(def.size*8),elementdefstabnr]); + write_def_stabstr(list,def,ss); + end; + + + procedure TDebugInfoStabs.appenddef_formal(list:TAsmList;def:tformaldef); + var + ss : ansistring; + begin + ss:=def_stabstr_evaluate(def,'${numberstring};',[]); + write_def_stabstr(list,def,ss); + end; + + + procedure TDebugInfoStabs.appenddef_array(list:TAsmList;def:tarraydef); + var + tempstr: shortstring; + ss : ansistring; + begin + if not is_packed_array(def) then + begin + tempstr:='ar$1;$2;$3;$4'; + if is_dynamic_array(def) then + tempstr:='*'+tempstr; + ss:=def_stabstr_evaluate(def,tempstr,[def_stab_number(tarraydef(def).rangedef), + tostr(tarraydef(def).lowrange),tostr(tarraydef(def).highrange),def_stab_number(tarraydef(def).elementdef)]) + end + else + begin + // the @P seems to be ignored by gdb + tempstr:=def_stabstr_evaluate(tarraydef(def).rangedef,'r${numberstring};$1;$2;', + [tostr(tarraydef(def).lowrange),tostr(tarraydef(def).highrange)]); + // will only show highrange-lowrange+1 bits in gdb + ss:=def_stabstr_evaluate(def,'@s$1;@S;S$2', + [tostr(TConstExprInt(tarraydef(def).elepackedbitsize) * tarraydef(def).elecount),tempstr]); + end; + write_def_stabstr(list,def,ss); + end; + + + procedure TDebugInfoStabs.appenddef_procvar(list:TAsmList;def:tprocvardef); + var + ss : ansistring; + begin + ss:='*f'+def_stab_number(tprocvardef(def).returndef); + write_def_stabstr(list,def,ss); + end; + + + procedure TDebugInfoStabs.appenddef_undefined(list:TAsmList;def:tundefineddef); + var + ss : ansistring; + begin + ss:=def_stabstr_evaluate(def,'${numberstring};',[]); + write_def_stabstr(list,def,ss); + end; + + + procedure TDebugInfoStabs.beforeappenddef(list:TAsmList;def:tdef); + var + anc : tobjectdef; + i : longint; + begin + { write dependencies first } + case def.typ of + stringdef : + begin + if tstringdef(def).stringtype in [st_widestring,st_unicodestring] then + appenddef(list,cwidechartype) + else + begin + appenddef(list,cchartype); + appenddef(list,u8inttype); + end; + end; + floatdef : + appenddef(list,s32inttype); + filedef : + begin + appenddef(list,s32inttype); +{$ifdef cpu64bitaddr} + appenddef(list,s64inttype); +{$endif cpu64bitaddr} + appenddef(list,u8inttype); + appenddef(list,cchartype); + end; + classrefdef : + appenddef(list,pvmttype); + pointerdef : + appenddef(list,tpointerdef(def).pointeddef); + setdef : + appenddef(list,tsetdef(def).elementdef); + procvardef : + begin + appenddef(list,tprocvardef(def).returndef); + if assigned(tprocvardef(def).parast) then + write_symtable_defs(list,tprocvardef(def).parast); + end; + procdef : + begin + appenddef(list,tprocdef(def).returndef); + if assigned(tprocdef(def).parast) then + write_symtable_defs(list,tprocdef(def).parast); + if assigned(tprocdef(def).localst) and + (tprocdef(def).localst.symtabletype=localsymtable) then + write_symtable_defs(list,tprocdef(def).localst); + end; + arraydef : + begin + appenddef(list,tarraydef(def).rangedef); + appenddef(list,tarraydef(def).elementdef); + end; + recorddef : + trecorddef(def).symtable.symList.ForEachCall(@field_write_defs,list); + enumdef : + if assigned(tenumdef(def).basedef) then + appenddef(list,tenumdef(def).basedef); + objectdef : + begin + { make sure we don't write child classdefs before their parent } + { classdefs, because this crashes gdb } + anc:=tobjectdef(def); + while assigned(anc.childof) do + begin + anc:=anc.childof; + if (anc.dbg_state=dbg_state_writing) then + { happens in case a field of a parent is of the (forward } + { defined) child type } + begin + { We don't explicitly requeue it, but the fact that } + { a child type was used in a parent before the child } + { type was fully defined means that it was forward } + { declared, and will still be encountered later (it } + { cannot have been declared in another unit, because } + { then this and that other unit would depend on } + { eachother's interface) } + { Setting the state to queued however allows us to } + { get the def number already without an IE } + def.dbg_state:=dbg_state_queued; + exit; + end; + end; + appenddef(list,vmtarraytype); + if assigned(tobjectdef(def).ImplementedInterfaces) then + for i:=0 to tobjectdef(def).ImplementedInterfaces.Count-1 do + appenddef(list,TImplementedInterface(tobjectdef(def).ImplementedInterfaces[i]).IntfDef); + { first the parents } + anc:=tobjectdef(def); + while assigned(anc.childof) do + begin + anc:=anc.childof; + appenddef(list,anc); + if assigned(anc.ImplementedInterfaces) then + for i:=0 to anc.ImplementedInterfaces.Count-1 do + appenddef(list,TImplementedInterface(anc.ImplementedInterfaces[i]).IntfDef); + end; + tobjectdef(def).symtable.symList.ForEachCall(@field_write_defs,list); + end; + end; + end; + + + procedure TDebugInfoStabs.appendprocdef(list:TAsmList;def:tprocdef); + var + templist : TAsmList; + stabsendlabel : tasmlabel; + RType : Char; + Obj,Info : String; + hs : string; + ss : ansistring; + begin + if not(def.in_currentunit) or + { happens for init procdef of units without init section } + not assigned(def.procstarttai) then + exit; + + { mark as used so the local type defs also be written } + def.dbg_state:=dbg_state_used; + + templist:=TAsmList.create; + + { end of procedure } + current_asmdata.getlabel(stabsendlabel,alt_dbgtype); + + if assigned(def.funcretsym) and + (tabstractnormalvarsym(def.funcretsym).refs>0) then + begin + if tabstractnormalvarsym(def.funcretsym).localloc.loc=LOC_REFERENCE then + begin +{ TODO: Need to add gdb support for ret in param register calling} + if paramanager.ret_in_param(def.returndef,def.proccalloption) then + hs:='X*' + else + hs:='X'; + templist.concat(Tai_stab.create(stab_stabs,strpnew( + '"'+GetSymName(def.procsym)+':'+hs+def_stab_number(def.returndef)+'",'+ + tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(def.funcretsym).localloc.reference.offset)))); + if (m_result in current_settings.modeswitches) then + templist.concat(Tai_stab.create(stab_stabs,strpnew( + '"RESULT:'+hs+def_stab_number(def.returndef)+'",'+ + tostr(N_tsym)+',0,0,'+tostr(tabstractnormalvarsym(def.funcretsym).localloc.reference.offset)))); + end; + end; + // LBRAC + ss:=tostr(N_LBRAC)+',0,0,'; + if target_info.cpu=cpu_powerpc64 then + ss:=ss+'.'; + ss:=ss+def.mangledname; + if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then + begin + ss:=ss+'-'; + if target_info.cpu=cpu_powerpc64 then + ss:=ss+'.'; + ss:=ss+def.mangledname; + end; + templist.concat(Tai_stab.Create_ansistr(stab_stabn,ss)); + // RBRAC + ss:=tostr(N_RBRAC)+',0,0,'+stabsendlabel.name; + if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then + begin + ss:=ss+'-'; + if target_info.cpu=cpu_powerpc64 then + ss:=ss+'.'; + ss:=ss+def.mangledname; + end; + templist.concat(Tai_stab.Create_ansistr(stab_stabn,ss)); + + { the stabsendlabel must come after all other stabs for this } + { function } + templist.concat(tai_label.create(stabsendlabel)); + + { Add a "size" stab as described in the last paragraph of 2.5 at } + { http://sourceware.org/gdb/current/onlinedocs/stabs_2.html#SEC12 } + { This works at least on Darwin (and is needed on Darwin to get } + { correct smartlinking of stabs), but I don't know which binutils } + { version is required on other platforms } + { This stab must come after all other stabs for the procedure, } + { including the LBRAC/RBRAC ones } + if (target_info.system in systems_darwin) then + templist.concat(Tai_stab.create(stab_stabs, + strpnew('"",'+tostr(N_FUNCTION)+',0,0,'+stabsendlabel.name+'-'+def.mangledname))); + + current_asmdata.asmlists[al_procedures].insertlistafter(def.procendtai,templist); + + { "The stab representing a procedure is located immediately + following the code of the procedure. This stab is in turn + directly followed by a group of other stabs describing + elements of the procedure. These other stabs describe the + procedure's parameters, its block local variables, and its + block structure." (stab docs) } + { this is however incorrect in case "include source" statements } + { appear in the block, in that case the procedure stab must } + { appear before this include stabs (and we generate such an } + { stabs for all functions) (JM) } + + { FUNC stabs } + obj := GetSymName(def.procsym); + info := ''; + if (po_global in def.procoptions) then + RType := 'F' + else + RType := 'f'; + if assigned(def.owner) then + begin + if (def.owner.symtabletype in [ObjectSymtable,recordsymtable]) then + obj := GetSymTableName(def.owner)+'__'+GetSymName(def.procsym); + if not(cs_gdb_valgrind in current_settings.globalswitches) and + (def.owner.symtabletype=localsymtable) and + assigned(def.owner.defowner) and + assigned(tprocdef(def.owner.defowner).procsym) then + info := ','+GetSymName(def.procsym)+','+GetSymName(tprocdef(def.owner.defowner).procsym); + end; + templist.concat(Tai_stab.Create_ansistr(stab_stabs,'"'+ansistring(obj)+':'+RType+def_stab_number(def.returndef)+info+'",'+tostr(n_function)+',0,'+tostr(def.fileinfo.line)+','+ansistring(def.mangledname))); + + current_asmdata.asmlists[al_procedures].insertlistbefore(def.procstarttai,templist); + + { para types } + if assigned(def.parast) then + write_symtable_syms(templist,def.parast); + { local type defs and vars should not be written + inside the main proc stab } + if assigned(def.localst) and + (def.localst.symtabletype=localsymtable) then + write_symtable_syms(templist,def.localst); + + current_asmdata.asmlists[al_procedures].insertlistbefore(def.procstarttai,templist); + + templist.free; + end; + + +{**************************************************************************** + TSym support +****************************************************************************} + + function TDebugInfoStabs.sym_var_value(const s:string;arg:pointer):string; + var + sym : tsym absolute arg; + begin + result:=''; + if s='name' then + result:=GetSymName(sym) + else if s='mangledname' then + result:=sym.mangledname + else if s='ownername' then + result:=GetSymTableName(sym.owner) + 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):ansistring; + begin + result:=string_evaluate(s,@sym_var_value,sym,vars); + end; + + + procedure TDebugInfoStabs.write_sym_stabstr(list:TAsmList;sym:tsym;const ss:ansistring); + begin + if ss='' then + exit; + { add to list } + list.concat(Tai_stab.create_ansistr(stab_stabs,ss)); + end; + + + procedure TDebugInfoStabs.appendsym_fieldvar(list:TAsmList;sym:tfieldvarsym); + var + ss : ansistring; + begin + ss:=''; + if (sym.owner.symtabletype in [ObjectSymtable,recordsymtable]) and + (sp_static in sym.symoptions) then + ss:=sym_stabstr_evaluate(sym,'"${ownername}__${name}:S$1",${N_LCSYM},0,${line},${mangledname}', + [def_stab_number(sym.vardef)]); + write_sym_stabstr(list,sym,ss); + end; + + + procedure TDebugInfoStabs.appendsym_staticvar(list:TAsmList;sym:tstaticvarsym); + var + ss : ansistring; + st : string; + threadvaroffset : string; + regidx : Tregisterindex; + nsym : string[7]; + begin + { 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; + ss:=''; + st:=def_stab_number(sym.vardef); + 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 + ss:=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(pint)) + else + threadvaroffset:=''; + if (vo_is_typed_const in sym.varoptions) then + nsym:='N_STSYM' + else + nsym:='N_LCSYM'; + { 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; + ss:=sym_stabstr_evaluate(sym,'"${name}:$1",${'+nsym+'},0,${line},${mangledname}$2',[st,threadvaroffset]); + end; + end; + write_sym_stabstr(list,sym,ss); + end; + + + procedure TDebugInfoStabs.appendsym_localvar(list:TAsmList;sym:tlocalvarsym); + var + ss : ansistring; + st : string; + regidx : Tregisterindex; + begin + { There is no space allocated for not referenced locals } + if (sym.owner.symtabletype=localsymtable) and (sym.refs=0) then + exit; + + ss:=''; + st:=def_stab_number(sym.vardef); + 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 + ss:=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 } + ss:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[st,tostr(sym.localloc.reference.offset)]) + else + internalerror(2003091814); + end; + write_sym_stabstr(list,sym,ss); + end; + + + function TDebugInfoStabs.get_appendsym_paravar_reg(sym:tparavarsym;const typ,stabstr:string;reg: tregister): ansistring; + var + ltyp: string[1]; + regidx : Tregisterindex; + begin + result:=''; + if typ='p' then + ltyp:='R' + else + ltyp:='a'; + regidx:=findreg_by_number(reg); + { "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}:$1",${N_RSYM},0,${line},$2',[ltyp+stabstr,tostr(longint(regstabs_table[regidx]))]); + end; + + + procedure TDebugInfoStabs.appendsym_paravar(list:TAsmList;sym:tparavarsym); + var + ss : ansistring; + c : string[1]; + st : string; + regidx : Tregisterindex; + begin + ss:=''; + { 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 + ss:=sym_stabstr_evaluate(sym,'"pvmt:p$1",${N_TSYM},0,0,$2', + [def_stab_number(pvmttype),tostr(sym.localloc.reference.offset)]) + else + begin + regidx:=findreg_by_number(sym.localloc.register); + ss:=sym_stabstr_evaluate(sym,'"pvmt:r$1",${N_RSYM},0,0,$2', + [def_stab_number(pvmttype),tostr(regstabs_table[regidx])]); + end + end + else + begin + if not(is_class(tprocdef(sym.owner.defowner).struct)) then + c:='v' + else + c:='p'; + if (sym.localloc.loc=LOC_REFERENCE) then + ss:=sym_stabstr_evaluate(sym,'"$$t:$1",${N_TSYM},0,0,$2', + [c+def_stab_number(tprocdef(sym.owner.defowner).struct),tostr(sym.localloc.reference.offset)]) + else + begin + if (c='p') then + c:='R' + else + c:='a'; + regidx:=findreg_by_number(sym.localloc.register); + ss:=sym_stabstr_evaluate(sym,'"$$t:$1",${N_RSYM},0,0,$2', + [c+def_stab_number(tprocdef(sym.owner.defowner).struct),tostr(regstabs_table[regidx])]); + end + end; + end + else + begin + st:=def_stab_number(sym.vardef); + + if paramanager.push_addr_param(sym.varspez,sym.vardef,tprocdef(sym.owner.defowner).proccalloption) and + not(vo_has_local_copy in sym.varoptions) and + not is_open_string(sym.vardef) then + c:='v' { should be 'i' but 'i' doesn't work } + else + c:='p'; + case sym.localloc.loc of + LOC_REGISTER, + LOC_CREGISTER, + LOC_MMREGISTER, + LOC_CMMREGISTER, + LOC_FPUREGISTER, + LOC_CFPUREGISTER : + begin + ss:=get_appendsym_paravar_reg(sym,c,st,sym.localloc.register); + end; + LOC_REFERENCE : + begin + { When the *value* of a parameter (so not its address!) is + copied into a local variable, you have to generate two + stabs: one for the parmeter, and one for the local copy. + Not doing this breaks debugging under e.g. SPARC. Doc: + http://sourceware.org/gdb/current/onlinedocs/stabs_4.html#SEC26 + } + if (c='p') and + not is_open_string(sym.vardef) and + ((sym.paraloc[calleeside].location^.loc<>sym.localloc.loc) or + ((sym.localloc.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and + ((sym.paraloc[calleeside].location^.reference.index<>sym.localloc.reference.base) or + (sym.paraloc[calleeside].location^.reference.offset<>sym.localloc.reference.offset))) or + ((sym.localloc.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_MMREGISTER,LOC_CMMREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER]) and + (sym.localloc.register<>sym.paraloc[calleeside].location^.register))) then + begin + if not(sym.paraloc[calleeside].location^.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then + ss:=get_appendsym_paravar_reg(sym,c,st,sym.paraloc[calleeside].location^.register) + else + ss:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[c+st,tostr(sym.paraloc[calleeside].location^.reference.offset)]); + write_sym_stabstr(list,sym,ss); + { second stab has no parameter specifier } + c:=''; + end; + { offset to ebp => will not work if the framepointer is esp + so some optimizing will make things harder to debug } + ss:=sym_stabstr_evaluate(sym,'"${name}:$1",${N_TSYM},0,${line},$2',[c+st,tostr(sym.localloc.reference.offset)]) + end; + else + internalerror(2003091814); + end; + end; + write_sym_stabstr(list,sym,ss); + end; + + + procedure TDebugInfoStabs.appendsym_const(list:TAsmList;sym:tconstsym); + var + st : string; + ss : ansistring; + begin + ss:=''; + { Don't write info for default parameter values, the N_Func breaks + the N_Func for the function itself. + Valgrind does not support constants } + if (sym.owner.symtabletype=parasymtable) or + (cs_gdb_valgrind in current_settings.globalswitches) then + exit; + 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; + ss:=sym_stabstr_evaluate(sym,'"${name}:c=$1;",${N_FUNCTION},0,${line},0',[st]); + write_sym_stabstr(list,sym,ss); + end; + + + procedure TDebugInfoStabs.appendsym_type(list:TAsmList;sym:ttypesym); + var + ss : ansistring; + stabchar : string[2]; + begin + ss:=''; + if not assigned(sym.typedef) then + internalerror(200509262); + if sym.typedef.typ in tagtypes then + stabchar:='Tt' + else + stabchar:='t'; + ss:=sym_stabstr_evaluate(sym,'"${name}:$1$2",${N_LSYM},0,${line},0',[stabchar,def_stab_number(sym.typedef)]); + write_sym_stabstr(list,sym,ss); + end; + + + procedure TDebugInfoStabs.appendsym_label(list:TAsmList;sym:tlabelsym); + var + ss : ansistring; + begin + ss:=sym_stabstr_evaluate(sym,'"${name}",${N_LSYM},0,${line},0',[]); + write_sym_stabstr(list,sym,ss); + end; + + +{**************************************************************************** + Proc/Module support +****************************************************************************} + + procedure tdebuginfostabs.inserttypeinfo; + var + stabsvarlist, + stabstypelist : TAsmList; + storefilepos : tfileposinfo; + i : longint; + vardatatype : ttypesym; + begin + storefilepos:=current_filepos; + current_filepos:=current_module.mainfilepos; + + global_stab_number:=0; + defnumberlist:=TFPObjectlist.create(false); + deftowritelist:=TFPObjectlist.create(false); + stabsvarlist:=TAsmList.create; + stabstypelist:=TAsmList.create; + + vardatatype:=try_search_system_type('TVARDATA'); + if assigned(vardatatype) then + vardatadef:=trecorddef(vardatatype.typedef); + + { include symbol that will be referenced from the main to be sure to + include this debuginfo .o file } + current_module.flags:=current_module.flags or uf_has_stabs_debuginfo; + if not(target_info.system in systems_darwin) then + begin + new_section(current_asmdata.asmlists[al_stabs],sec_data,GetSymTableName(current_module.localsymtable),0); + current_asmdata.asmlists[al_stabs].concat(tai_symbol.Createname_global(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0)); + end + else + new_section(current_asmdata.asmlists[al_stabs],sec_code,GetSymTableName(current_module.localsymtable),0); + + { write all global/local variables. 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); + + { write all procedures and methods. This will flag all required tdefs } + if assigned(current_module.globalsymtable) then + write_symtable_procdefs(stabsvarlist,current_module.globalsymtable); + if assigned(current_module.localsymtable) then + write_symtable_procdefs(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); + + write_remaining_defs_to_write(stabstypelist); + + current_asmdata.asmlists[al_stabs].concatlist(stabstypelist); + current_asmdata.asmlists[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]).dbg_state:=dbg_state_unused; + end; + end; + + defnumberlist.free; + defnumberlist:=nil; + deftowritelist.free; + deftowritelist:=nil; + + stabsvarlist.free; + stabstypelist.free; + current_filepos:=storefilepos; + end; + + + procedure tdebuginfostabs.insertlineinfo(list:TAsmList); + var + currfileinfo, + lastfileinfo : tfileposinfo; + currfuncname : pshortstring; + 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) or + (lastfileinfo.moduleindex<>currfileinfo.moduleindex)) then + begin + infile:=get_module(currfileinfo.moduleindex).sourcefiles.get_file(currfileinfo.fileindex); + if assigned(infile) then + begin + current_asmdata.getlabel(hlabel,alt_dbgfile); + { emit stabs } + if not(ds_stabs_abs_include_files in current_settings.debugswitches) or + path_absolute(infile.path^) then + list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+FixFileName(infile.name^)+'",'+tostr(n_includefile)+ + ',0,0,'+hlabel.name),hp) + else + list.insertbefore(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(getcurrentdir,false)+FixPath(infile.path^,false))+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 (currfileinfo.line>lastfileinfo.line) and (currfileinfo.line<>0) then + begin + if assigned(currfuncname) and + not(af_stabs_use_function_absolute_addresses in target_asm.flags) then + begin + current_asmdata.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; + begin + { emit main source n_sourcefile for start of module } + current_asmdata.getlabel(hlabel,alt_dbgfile); + infile:=current_module.sourcefiles.get_file(1); + new_section(current_asmdata.asmlists[al_start],sec_code,make_mangledname('DEBUGSTART',current_module.localsymtable,''),0,secorder_begin); + if not(target_info.system in systems_darwin) then + current_asmdata.asmlists[al_start].concat(tai_symbol.Createname_global(make_mangledname('DEBUGSTART',current_module.localsymtable,''),AT_DATA,0)); + current_asmdata.asmlists[al_start].concat(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(getcurrentdir,false))+'",'+tostr(n_sourcefile)+ + ',0,0,'+hlabel.name)); + current_asmdata.asmlists[al_start].concat(Tai_stab.Create_str(stab_stabs,'"'+BsToSlash(FixPath(infile.path^,false))+FixFileName(infile.name^)+'",'+tostr(n_sourcefile)+ + ',0,0,'+hlabel.name)); + current_asmdata.asmlists[al_start].concat(tai_label.create(hlabel)); + { for darwin, you need a "module marker" too to work around } + { either some assembler or gdb bug (radar 4386531 according to a } + { comment in dbxout.c of Apple's gcc) } + if (target_info.system in systems_darwin) then + current_asmdata.asmlists[al_end].concat(Tai_stab.Create_str(stab_stabs,'"",'+tostr(N_OSO)+',0,0,0')); + { emit empty n_sourcefile for end of module } + current_asmdata.getlabel(hlabel,alt_dbgfile); + new_section(current_asmdata.asmlists[al_end],sec_code,make_mangledname('DEBUGEND',current_module.localsymtable,''),0,secorder_end); + if not(target_info.system in systems_darwin) then + current_asmdata.asmlists[al_end].concat(tai_symbol.Createname_global(make_mangledname('DEBUGEND',current_module.localsymtable,''),AT_DATA,0)); + current_asmdata.asmlists[al_end].concat(Tai_stab.Create_str(stab_stabs,'"",'+tostr(n_sourcefile)+',0,0,'+hlabel.name)); + current_asmdata.asmlists[al_end].concat(tai_label.create(hlabel)); + end; + + + procedure tdebuginfostabs.referencesections(list:TAsmList); + var + hp : tmodule; + dbgtable : tai_symbol; + begin + { Reference all DEBUGINFO sections from the main .fpc section } + if (target_info.system in ([system_powerpc_macos]+systems_darwin)) then + exit; + new_section(list,sec_fpc,'links',0); + { make sure the debuginfo doesn't get stripped out } + if (target_info.system in systems_darwin) then + begin + dbgtable:=tai_symbol.createname('DEBUGINFOTABLE',AT_DATA,0); + list.concat(tai_directive.create(asd_no_dead_strip,dbgtable.sym.name)); + list.concat(dbgtable); + end; + { include reference to all debuginfo sections of used units } + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + If (hp.flags and uf_has_stabs_debuginfo)=uf_has_stabs_debuginfo then + begin + list.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.localsymtable,''),0)); + list.concat(Tai_const.Createname(make_mangledname('DEBUGSTART',hp.localsymtable,''),0)); + list.concat(Tai_const.Createname(make_mangledname('DEBUGEND',hp.localsymtable,''),0)); + end; + hp:=tmodule(hp.next); + end; + end; + + constructor TDebugInfoStabs.Create; + begin + inherited Create; + vardatadef:=nil; + end; + + const + dbg_stabs_info : tdbginfo = + ( + id : dbg_stabs; + idtxt : 'STABS'; + ); + +initialization + RegisterDebugInfo(dbg_stabs_info,TDebugInfoStabs); +end. diff --git a/closures/compiler/defcmp.pas b/closures/compiler/defcmp.pas new file mode 100644 index 0000000000..25c4ca4f11 --- /dev/null +++ b/closures/compiler/defcmp.pas @@ -0,0 +1,1942 @@ +{ + 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, // ignore hidden parameters + cpo_allowconvert, + cpo_comparedefaultvalue, + cpo_openequalisexact, + cpo_ignoreuniv, + cpo_warn_incompatible_univ, + cpo_ignorevarspez, // ignore parameter access type + cpo_ignoreframepointer, // ignore frame pointer parameter (for assignment-compatibility of global procedures to nested procvars) + cpo_compilerproc, + cpo_rtlproc + ); + + tcompare_paras_options = set of tcompare_paras_option; + + tcompare_defs_option = (cdo_internal,cdo_explicit,cdo_check_operator,cdo_allow_variant,cdo_parameter,cdo_warn_incompatible_univ); + 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_nil_2_methodprocvar, + tc_arrayconstructor_2_set, + tc_set_to_set, + tc_cord_2_pointer, + tc_intf_2_string, + tc_intf_2_guid, + tc_class_2_intf, + tc_char_2_char, + 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_all, all have to match exactly + if acp is cp_value_equal_const call by value + and call by const parameter are assumed as + equal + if acp is cp_procvar then the varspez have to match, + and all parameter types must be at least te_equal + if acp is cp_none, then we don't check the varspez at all + 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 : TFPObjectList; 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;checkincompatibleuniv: boolean):tequaltype; + + { Parentdef is the definition of a method defined in a parent class or interface } + { Childdef is the definition of a method defined in a child class, interface or } + { a class implementing an interface with parentdef. } + { Returns true if the resultdef of childdef can be used to implement/override } + { parentdef's resultdef } + function compatible_childmethod_resultdef(parentretdef, childretdef: tdef): boolean; + + +implementation + + uses + verbose,systems,constexp, + 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; + + { tordtype: + uvoid, + u8bit,u16bit,u32bit,u64bit, + s8bit,s16bit,s32bit,s64bit, + pasbool, bool8bit,bool16bit,bool32bit,bool64bit, + uchar,uwidechar,scurrency } + + type + tbasedef=(bvoid,bchar,bint,bbool); + const + basedeftbl:array[tordtype] of tbasedef = + (bvoid, + bint,bint,bint,bint, + bint,bint,bint,bint, + bbool,bbool,bbool,bbool, + bbool,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; + hobjdef : 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; + + { undefined def? then mark it as equal } + if (def_from.typ=undefineddef) or + (def_to.typ=undefineddef) 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.typ of + orddef : + begin + case def_from.typ of + orddef : + begin + if (torddef(def_from).ordtype=torddef(def_to).ordtype) then + begin + case torddef(def_from).ordtype 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, + pasbool8,pasbool16,pasbool32,pasbool64, + bool8bit,bool16bit,bool32bit,bool64bit: + eq:=te_equal; + else + internalerror(200210061); + end; + end + else + begin + if cdo_explicit in cdoptions then + doconv:=basedefconvertsexplicit[basedeftbl[torddef(def_from).ordtype],basedeftbl[torddef(def_to).ordtype]] + else + doconv:=basedefconvertsimplicit[basedeftbl[torddef(def_from).ordtype],basedeftbl[torddef(def_to).ordtype]]; + if (doconv=tc_not_possible) then + eq:=te_incompatible + else if (not is_in_limit(def_from,def_to)) then + { "punish" bad type conversions :) (JM) } + eq:=te_convert_l3 + else + 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; + objectdef: + begin + if (m_delphi in current_settings.modeswitches) and + is_implicit_pointer_object_type(def_from) and + (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; + 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 current_settings.modeswitches) and + (fromtreetype=stringconstn) then + begin + eq:=te_convert_l3; + doconv:=tc_cstring_2_int; + end; + end; + end; + end; + + stringdef : + begin + case def_from.typ of + stringdef : + begin + { Constant string } + if (fromtreetype=stringconstn) then + begin + if (tstringdef(def_from).stringtype=tstringdef(def_to).stringtype) and + ((tstringdef(def_from).stringtype<>st_ansistring) or + (tstringdef(def_from).encoding=tstringdef(def_to).encoding) + ) then + eq:=te_equal + else + begin + doconv:=tc_string_2_string; + if (tstringdef(def_from).stringtype = st_ansistring) and + (tstringdef(def_to).stringtype = st_ansistring) then + if (tstringdef(def_to).encoding=globals.CP_UTF8) then + eq:=te_convert_l1 + else + eq:=te_convert_l2 + else + begin + { Don't prefer conversions from widestring to a + normal string as we can lose information } + if (tstringdef(def_from).stringtype in [st_widestring,st_unicodestring]) and + not (tstringdef(def_to).stringtype in [st_widestring,st_unicodestring]) then + eq:=te_convert_l3 + else if tstringdef(def_to).stringtype in [st_widestring,st_unicodestring] then + eq:=te_convert_l2 + else + eq:=te_convert_l1; + end; + end; + end + else if (tstringdef(def_from).stringtype=tstringdef(def_to).stringtype) and + (tstringdef(def_from).stringtype=st_ansistring) then + begin + { don't convert ansistrings if any conditions is true: + 1) same encoding + 2) from explicit codepage ansistring to ansistring and vice versa + 3) from any ansistring to rawbytestring } + if (tstringdef(def_from).encoding=tstringdef(def_to).encoding) or + ((tstringdef(def_to).encoding=0) and (tstringdef(def_from).encoding=getansistringcodepage)) or + ((tstringdef(def_to).encoding=getansistringcodepage) and (tstringdef(def_from).encoding=0)) or + (tstringdef(def_to).encoding=globals.CP_NONE) then + begin + eq:=te_equal; + end + else + begin + doconv := tc_string_2_string; + if (tstringdef(def_to).encoding=globals.CP_UTF8) then + eq:=te_convert_l1 + else + eq:=te_convert_l2; + end + end + else + { same string type ? } + if (tstringdef(def_from).stringtype=tstringdef(def_to).stringtype) and + { for shortstrings also the length must match } + ((tstringdef(def_from).stringtype<>st_shortstring) or + (tstringdef(def_from).len=tstringdef(def_to).len)) and + { for ansi- and unicodestrings also the encoding must match } + (not(tstringdef(def_from).stringtype in [st_ansistring,st_unicodestring]) or + (tstringdef(def_from).encoding=tstringdef(def_to).encoding)) then + eq:=te_equal + else + begin + doconv:=tc_string_2_string; + case tstringdef(def_from).stringtype of + st_widestring : + begin + { Prefer conversions to unicodestring } + if tstringdef(def_to).stringtype=st_unicodestring then + eq:=te_convert_l1 + { else prefer conversions to ansistring } + else if tstringdef(def_to).stringtype=st_ansistring then + eq:=te_convert_l2 + else + eq:=te_convert_l3; + end; + st_unicodestring : + begin + { Prefer conversions to widestring } + if tstringdef(def_to).stringtype=st_widestring then + eq:=te_convert_l1 + { else prefer conversions to ansistring } + else if tstringdef(def_to).stringtype=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).stringtype=st_shortstring) then + eq:=te_convert_l1 + else if tstringdef(def_to).stringtype=st_ansistring then + eq:=te_convert_l2 + else + eq:=te_convert_l3; + end; + st_ansistring : + begin + { Prefer conversion to widestrings } + if (tstringdef(def_to).stringtype in [st_widestring,st_unicodestring]) 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 current_settings.localswitches) and + (tstringdef(def_to).stringtype=st_shortstring) then + eq:=te_equal + else if (cs_ansistrings in current_settings.localswitches) and + (tstringdef(def_to).stringtype=st_ansistring) then + eq:=te_equal + else if tstringdef(def_to).stringtype in [st_widestring,st_unicodestring] 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) or is_unicodestring(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) or is_unicodestring(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) or is_unicodestring(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 (is_open_widechararray(def_from) or (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 current_settings.modeswitches) 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 current_settings.localswitches)) or + (is_ansistring(def_to) and + (cs_ansistrings in current_settings.localswitches)) 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) or is_unicodestring(def_to) then + eq:=te_convert_l1 + else + eq:=te_convert_l3; + end; + end; + end; + objectdef : + begin + { corba interface -> id string } + if is_interfacecorba(def_from) then + begin + doconv:=tc_intf_2_string; + eq:=te_convert_l1; + end; + end; + end; + end; + + floatdef : + begin + case def_from.typ of + orddef : + begin { ordinal to real } + { only for implicit and internal typecasts in tp/delphi } + if (([cdo_explicit,cdo_internal] * cdoptions <> [cdo_explicit]) or + ([m_tp7,m_delphi] * current_settings.modeswitches = [])) and + (is_integer(def_from) or + (is_currency(def_from) and + (s64currencytype.typ = floatdef))) then + begin + doconv:=tc_int_2_real; + + { prefer single over others } + if is_single(def_to) then + eq:=te_convert_l3 + else + eq:=te_convert_l4; + end + else if is_currency(def_from) + { and (s64currencytype.typ = 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).floattype=tfloatdef(def_to).floattype then + eq:=te_equal + else + begin + { Delphi does not allow explicit type conversions for float types like: + single_var:=single(double_var); + But if such conversion is inserted by compiler (internal) for some purpose, + it should be allowed even in Delphi mode. } + if (fromtreetype=realconstn) or + not((cdoptions*[cdo_explicit,cdo_internal]=[cdo_explicit]) and + (m_delphi in current_settings.modeswitches)) then + begin + doconv:=tc_real_2_real; + { do we lose precision? } + if (def_to.size<def_from.size) or + (is_currency(def_from) and (tfloatdef(def_to).floattype in [s32real,s64real])) then + eq:=te_convert_l2 + else + eq:=te_convert_l1; + end; + end; + end; + end; + end; + + enumdef : + begin + case def_from.typ 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).getfirstsym)=tenumsym(tenumdef(hd2).getfirstsym)) 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 current_settings.modeswitches) then + begin + doconv:=tc_int_2_int; + eq:=te_convert_l1; + end; + end; + objectdef: + begin + { ugly, but delphi allows it } + if (m_delphi in current_settings.modeswitches) and + is_class_or_interface_or_dispinterface(def_from) and + (cdo_explicit in cdoptions) 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. + the extra check for deftyp is needed because equal defs can also return + true if the def types are not the same, for example with dynarray to pointer. } + if is_open_array(def_to) and + (def_from.typ=tarraydef(def_to).elementdef.typ) and + equal_defs(def_from,tarraydef(def_to).elementdef) then + begin + doconv:=tc_equal; + { also update in htypechk.pas/var_para_allowed if changed + here } + eq:=te_convert_l3; + end + else + begin + case def_from.typ of + arraydef : + begin + { from/to packed array -- packed chararrays are } + { strings in ISO Pascal (at least if the lower bound } + { is 1, but GPC makes all equal-length chararrays } + { compatible), so treat those the same as regular } + { char arrays } + if (is_packed_array(def_from) and + not is_chararray(def_from) and + not is_widechararray(def_from)) xor + (is_packed_array(def_to) and + not is_chararray(def_to) and + not is_widechararray(def_to)) then + { both must be packed } + begin + compare_defs_ext:=te_incompatible; + exit; + end + { to dynamic array } + else if is_dynamic_array(def_to) then + begin + if equal_defs(tarraydef(def_from).elementdef,tarraydef(def_to).elementdef) then + begin + { dynamic array -> dynamic array } + if is_dynamic_array(def_from) then + eq:=te_equal + { fpc modes only: array -> dyn. array } + else if (current_settings.modeswitches*[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).elementdef) then + begin + doconv:=tc_equal; + eq:=te_convert_l1; + end + else + begin + subeq:=compare_defs_ext(tarraydef(def_from).elementdef, + tarraydef(def_to).elementdef, + { reason for cdo_allow_variant: see webtbs/tw7070a and webtbs/tw7070b } + arrayconstructorn,hct,hpd,[cdo_check_operator,cdo_allow_variant]); + 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).elementdef,tarraydef(def_to).elementdef) then + begin + doconv:=tc_dynarray_2_openarray; + eq:=te_convert_l2; + end + else + { open array -> open array } + if is_open_array(def_from) and + equal_defs(tarraydef(def_from).elementdef,tarraydef(def_to).elementdef) then + if tarraydef(def_from).elementdef=tarraydef(def_to).elementdef then + eq:=te_exact + else + eq:=te_equal + else + { array -> open array } + if not(cdo_parameter in cdoptions) and + equal_defs(tarraydef(def_from).elementdef,tarraydef(def_to).elementdef) then + begin + if fromtreetype=stringconstn then + eq:=te_convert_l1 + else + eq:=te_equal; + end; + 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).elementdef,tarraydef(def_from).elementdef) 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 not(cdo_parameter in cdoptions) and + is_open_array(def_from) and + equal_defs(tarraydef(def_from).elementdef,tarraydef(def_to).elementdef) then + begin + eq:=te_equal + end + else + { array -> array } + if not(m_tp7 in current_settings.modeswitches) and + not(m_delphi in current_settings.modeswitches) and + (tarraydef(def_from).lowrange=tarraydef(def_to).lowrange) and + (tarraydef(def_from).highrange=tarraydef(def_to).highrange) and + equal_defs(tarraydef(def_from).elementdef,tarraydef(def_to).elementdef) and + equal_defs(tarraydef(def_from).rangedef,tarraydef(def_to).rangedef) 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).pointeddef,tarraydef(def_to).elementdef) 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).elementdef)or + is_widechar(tarraydef(def_to).elementdef)) 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).elementdef) 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.typ 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 + { corbainterfaces not accepted, until we have + runtime support for them in Variants (sergei) } + if is_interfacecom_or_dispinterface(def_from) then + begin + doconv:=tc_interface_2_variant; + eq:=te_convert_l1; + end; + end; + variantdef : + begin + { doing this in the compiler avoids a lot of unncessary + copying } + if (tvariantdef(def_from).varianttype=vt_olevariant) and + (tvariantdef(def_to).varianttype=vt_normalvariant) then + begin + doconv:=tc_equal; + eq:=te_convert_l1; + end; + end; + end; + end; + end; + + pointerdef : + begin + case def_from.typ of + stringdef : + begin + { string constant (which can be part of array constructor) + to zero terminated string constant } + if (fromtreetype = 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) or (fromtreetype = arrayconstructorn) 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_wide_or_unicode_string(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 in [ordconstn,arrayconstructorn]) 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 current_settings.modeswitches) and is_integer(def_from) then + begin + doconv:=tc_cord_2_pointer; + eq:=te_convert_l5; + end; + end; + { allow explicit typecasts from ordinals to pointer. + Support for delphi compatibility + Support constructs like pointer(cardinal-cardinal) or pointer(longint+cardinal) where + the result of the ordinal operation is int64 also on 32 bit platforms. + It is also used by the compiler internally for inc(pointer,ordinal) } + if (eq=te_incompatible) and + not is_void(def_from) and + ( + ( + (cdo_explicit in cdoptions) and + ( + (m_delphi in current_settings.modeswitches) or + { Don't allow pchar(char) in fpc modes } + is_integer(def_from) + ) + ) or + (cdo_internal in cdoptions) + ) then + begin + doconv:=tc_int_2_int; + eq:=te_convert_l1; + end; + end; + enumdef : + begin + { allow explicit typecasts from enums to pointer. + Support for delphi compatibility + } + if (((cdo_explicit in cdoptions) and + (m_delphi in current_settings.modeswitches) + ) 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 = arrayconstructorn) and + { can't use is_chararray, because returns false for } + { array constructors } + is_char(tarraydef(def_from).elementdef)) or + (fromtreetype = 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).elementdef,tpointerdef(def_to).pointeddef) 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 current_settings.modeswitches) and + is_dynamic_array(def_from) and + is_voidpointer(def_to) 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).pointeddef.typ=forwarddef) then + begin + if (def_from.typesym=def_to.typesym) then + eq:=te_equal + end + else + { same types } + if equal_defs(tpointerdef(def_from).pointeddef,tpointerdef(def_to).pointeddef) then + begin + eq:=te_equal + end + else + { child class pointer can be assigned to anchestor pointers } + if ( + (tpointerdef(def_from).pointeddef.typ=objectdef) and + (tpointerdef(def_to).pointeddef.typ=objectdef) and + tobjectdef(tpointerdef(def_from).pointeddef).is_related( + tobjectdef(tpointerdef(def_to).pointeddef)) + ) 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).pointeddef) 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).pointeddef) or + { all pointers can be assigned from void-pointer or formaldef pointer, check + tw3777.pp if you change this } + (tpointerdef(def_from).pointeddef.typ=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 + { id = generic class instance. metaclasses are also + class instances themselves. } + else if ((def_from=objc_idtype) and + (def_to=objc_metaclasstype)) or + ((def_to=objc_idtype) and + (def_from=objc_metaclasstype)) then + begin + doconv:=tc_equal; + eq:=te_convert_l2; + end; + end; + procvardef : + begin + { procedure variable can be assigned to an void pointer, + this is not allowed for complex procvars } + if (is_void(tpointerdef(def_to).pointeddef) or + (m_mac_procvar in current_settings.modeswitches)) 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 current_settings.modeswitches) and + tprocdef(def_from).is_addressonly then + begin + doconv:=tc_proc_2_procvar; + eq:=te_convert_l2; + end; + end; + classrefdef, + objectdef : + begin + { implicit pointer object and class reference types + can be assigned to void pointers, but it is less + preferred than assigning to a related objectdef } + if ( + is_implicit_pointer_object_type(def_from) or + (def_from.typ=classrefdef) + ) and + (tpointerdef(def_to).pointeddef.typ=orddef) and + (torddef(tpointerdef(def_to).pointeddef).ordtype=uvoid) then + begin + doconv:=tc_equal; + eq:=te_convert_l2; + end + else if (is_objc_class_or_protocol(def_from) and + (def_to=objc_idtype)) or + { classrefs are also instances in Objective-C, + hence they're also assignment-cpmpatible with + id } + (is_objcclassref(def_from) and + ((def_to=objc_metaclasstype) or + (def_to=objc_idtype))) then + begin + doconv:=tc_equal; + eq:=te_convert_l2; + end; + end; + end; + end; + + setdef : + begin + case def_from.typ of + setdef : + begin + if assigned(tsetdef(def_from).elementdef) and + assigned(tsetdef(def_to).elementdef) then + begin + { sets with the same element base type and the same range are equal } + if equal_defs(tsetdef(def_from).elementdef,tsetdef(def_to).elementdef) and + (tsetdef(def_from).setbase=tsetdef(def_to).setbase) and + (tsetdef(def_from).setmax=tsetdef(def_to).setmax) then + eq:=te_equal + else if is_subequal(tsetdef(def_from).elementdef,tsetdef(def_to).elementdef) then + begin + eq:=te_convert_l1; + doconv:=tc_set_to_set; + end; + end + else + begin + { empty set is compatible with everything } + eq:=te_convert_l1; + doconv:=tc_set_to_set; + end; + 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.typ of + procdef : + begin + { proc -> procvar } + if (m_tp_procvar in current_settings.modeswitches) or + (m_mac_procvar in current_settings.modeswitches) then + begin + subeq:=proc_to_procvar_equal(tprocdef(def_from),tprocvardef(def_to),cdo_warn_incompatible_univ in cdoptions); + if subeq>te_incompatible then + begin + doconv:=tc_proc_2_procvar; + if subeq>te_convert_l5 then + eq:=pred(subeq) + else + eq:=subeq; + end; + end; + end; + procvardef : + begin + { procvar -> procvar } + eq:=proc_to_procvar_equal(tprocvardef(def_from),tprocvardef(def_to),cdo_warn_incompatible_univ in cdoptions); + end; + pointerdef : + begin + { nil is compatible with procvars } + if (fromtreetype=niln) then + begin + if not Tprocvardef(def_to).is_addressonly then + {Nil to method pointers requires to convert a single + pointer nil value to a two pointer procvardef.} + doconv:=tc_nil_2_methodprocvar + else + 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 current_settings.modeswitches) and + is_void(tpointerdef(def_from).pointeddef) and + tprocvardef(def_to).is_addressonly then + begin + doconv:=tc_equal; + eq:=te_convert_l1; + end; + end; + end; + end; + + objectdef : + begin + { Objective-C classes (handle anonymous externals) } + if (def_from.typ=objectdef) and + (find_real_objcclass_definition(tobjectdef(def_from),false) = + find_real_objcclass_definition(tobjectdef(def_to),false)) then + begin + doconv:=tc_equal; + { exact, not equal, because can change between interface + and implementation } + eq:=te_exact; + end + { object pascal objects } + else if (def_from.typ=objectdef) and + (tobjectdef(def_from).is_related(tobjectdef(def_to))) then + begin + doconv:=tc_equal; + eq:=te_convert_l1; + end + else + { specific to implicit pointer object types } + if is_implicit_pointer_object_type(def_to) then + begin + { void pointer also for delphi mode } + if (m_delphi in current_settings.modeswitches) 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 + { All Objective-C classes are compatible with ID } + else if is_objc_class_or_protocol(def_to) and + (def_from=objc_idtype) then + begin + doconv:=tc_equal; + eq:=te_convert_l2; + end + { classes can be assigned to interfaces + (same with objcclass and objcprotocol) } + else if ((is_interface(def_to) and + is_class(def_from)) or + (is_objcprotocol(def_to) and + is_objcclass(def_from))) and + assigned(tobjectdef(def_from).ImplementedInterfaces) then + begin + { we've to search in parent classes as well } + hobjdef:=tobjectdef(def_from); + while assigned(hobjdef) do + begin + if hobjdef.find_implemented_interface(tobjectdef(def_to))<>nil then + begin + if is_interface(def_to) then + doconv:=tc_class_2_intf + else + { for Objective-C, we don't have to do anything special } + doconv:=tc_equal; + { don't prefer this over objectdef->objectdef } + eq:=te_convert_l2; + break; + end; + hobjdef:=hobjdef.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.typ=variantdef) and is_interfacecom_or_dispinterface(def_to) then + begin + { corbainterfaces not accepted, until we have + runtime support for them in Variants (sergei) } + doconv:=tc_variant_2_interface; + eq:=te_convert_l2; + end + { ugly, but delphi allows it } + else if (def_from.typ in [orddef,enumdef]) and + (m_delphi in current_settings.modeswitches) 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).pointeddef.typ=forwarddef) then + begin + if (def_from.typesym=def_to.typesym) then + eq:=te_equal; + end + else + { class reference types } + if (def_from.typ=classrefdef) then + begin + if equal_defs(tclassrefdef(def_from).pointeddef,tclassrefdef(def_to).pointeddef) then + begin + eq:=te_equal; + end + else + begin + doconv:=tc_equal; + if (cdo_explicit in cdoptions) or + tobjectdef(tclassrefdef(def_from).pointeddef).is_related( + tobjectdef(tclassrefdef(def_to).pointeddef)) then + eq:=te_convert_l1; + end; + end + else + if (m_delphi in current_settings.modeswitches) 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 references } + if (fromtreetype=niln) then + begin + doconv:=tc_equal; + eq:=te_convert_l1; + end + else + { id is compatible with all classref types } + if (def_from=objc_idtype) 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.typ=filedef) then + begin + if (tfiledef(def_from).filetyp=tfiledef(def_to).filetyp) then + begin + if + ( + (tfiledef(def_from).typedfiledef=nil) and + (tfiledef(def_to).typedfiledef=nil) + ) or + ( + (tfiledef(def_from).typedfiledef<>nil) and + (tfiledef(def_to).typedfiledef<>nil) and + equal_defs(tfiledef(def_from).typedfiledef,tfiledef(def_to).typedfiledef) + ) or + ( + (tfiledef(def_from).filetyp = ft_typed) and + (tfiledef(def_to).filetyp = ft_typed) and + ( + (tfiledef(def_from).typedfiledef = tdef(voidtype)) or + (tfiledef(def_to).typedfiledef = tdef(voidtype)) + ) + ) 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 (def_to=rec_tguid) and + (is_interfacecom_or_dispinterface(def_from)) then + begin + doconv:=tc_intf_2_guid; + eq:=te_convert_l1; + end; + end; + + formaldef : + begin + doconv:=tc_equal; + if (def_from.typ=formaldef) then + eq:=te_equal + else + { Just about everything can be converted to a formaldef...} + if not (def_from.typ in [abstractdef,errordef]) then + eq:=te_convert_l2; + end; + end; + + { if we didn't find an appropriate type conversion yet + then we search also the := operator } + if (eq=te_incompatible) and + { make sure there is not a single variant if variants } + { are not allowed (otherwise if only cdo_check_operator } + { and e.g. fromdef=stringdef and todef=variantdef, then } + { the test will still succeed } + ((cdo_allow_variant in cdoptions) or + ((def_from.typ<>variantdef) and (def_to.typ<>variantdef)) + ) and + ( + { Check for variants? } + ( + (cdo_allow_variant in cdoptions) and + ((def_from.typ=variantdef) or (def_to.typ=variantdef)) + ) or + { Check for operators? } + ( + (cdo_check_operator in cdoptions) and + ((def_from.typ<>variantdef) or (def_to.typ<>variantdef)) + ) + ) then + begin + operatorpd:=search_assignment_operator(def_from,def_to,cdo_explicit in cdoptions); + 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.typ = orddef) and (def2.typ = 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).ordtype of + u8bit,u16bit,u32bit,u64bit, + s8bit,s16bit,s32bit,s64bit : + is_subequal:=(torddef(def2).ordtype in [s64bit,u64bit,s32bit,u32bit,u8bit,s8bit,s16bit,u16bit]); + pasbool8,pasbool16,pasbool32,pasbool64, + bool8bit,bool16bit,bool32bit,bool64bit : + is_subequal:=(torddef(def2).ordtype in [pasbool8,pasbool16,pasbool32,pasbool64,bool8bit,bool16bit,bool32bit,bool64bit]); + uchar : + is_subequal:=(torddef(def2).ordtype=uchar); + uwidechar : + is_subequal:=(torddef(def2).ordtype=uwidechar); + end; + end + else + Begin + { Check if both basedefs are equal } + if (def1.typ=enumdef) and (def2.typ=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 potentially_incompatible_univ_paras(def1, def2: tdef): boolean; + begin + result := + { not entirely safe: different records can be passed differently + depending on the types of their fields, but they're hard to compare + (variant records, bitpacked vs non-bitpacked) } + ((def1.typ in [floatdef,recorddef,arraydef,filedef,variantdef]) and + (def1.typ<>def2.typ)) or + { pointers, ordinals and small sets are all passed the same} + (((def1.typ in [orddef,enumdef,pointerdef,procvardef,classrefdef]) or + (is_class_or_interface_or_objc(def1)) or + is_dynamic_array(def1) or + is_smallset(def1) or + is_ansistring(def1) or + is_unicodestring(def1)) <> + (def2.typ in [orddef,enumdef,pointerdef,procvardef,classrefdef]) or + (is_class_or_interface_or_objc(def2)) or + is_dynamic_array(def2) or + is_smallset(def2) or + is_ansistring(def2) or + is_unicodestring(def2)) or + { shortstrings } + (is_shortstring(def1)<> + is_shortstring(def2)) or + { winlike widestrings } + (is_widestring(def1)<> + is_widestring(def2)) or + { TP-style objects } + (is_object(def1) <> + is_object(def2)); + end; + + + function compare_paras(para1,para2 : TFPObjectList; 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_parameter,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; + if cpo_ignoreframepointer in cpoptions then + begin + if (i1<para1.count) and + (vo_is_parentfp in tparavarsym(para1[i1]).varoptions) then + inc(i1); + if (i2<para2.count) and + (vo_is_parentfp in tparavarsym(para2[i2]).varoptions) then + 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.vardef.defoptions) or (df_unique in currpara2.vardef.defoptions)) and + (currpara1.vardef<>currpara2.vardef) 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_exact; + if not(vo_is_self in currpara1.varoptions) and + not(vo_is_self in currpara2.varoptions) then + begin + if not(cpo_ignorevarspez in cpoptions) and + (currpara1.varspez<>currpara2.varspez) then + exit; + eq:=compare_defs_ext(currpara1.vardef,currpara2.vardef,nothingn, + convtype,hpd,cdoptions); + end; + end + else + begin + case acp of + cp_value_equal_const : + begin + { this one is used for matching parameters from a call + statement to a procdef -> univ state can't be equal + in any case since the call statement does not contain + any information about that } + if ( + not(cpo_ignorevarspez in cpoptions) and + (currpara1.varspez<>currpara2.varspez) and + ((currpara1.varspez in [vs_var,vs_out,vs_constref]) or + (currpara2.varspez in [vs_var,vs_out,vs_constref])) + ) then + exit; + eq:=compare_defs_ext(currpara1.vardef,currpara2.vardef,nothingn, + convtype,hpd,cdoptions); + end; + cp_all : + begin + { used to resolve forward definitions -> headers must + match exactly, including the "univ" specifier } + if (not(cpo_ignorevarspez in cpoptions) and + (currpara1.varspez<>currpara2.varspez)) or + (currpara1.univpara<>currpara2.univpara) then + exit; + eq:=compare_defs_ext(currpara1.vardef,currpara2.vardef,nothingn, + convtype,hpd,cdoptions); + end; + cp_procvar : + begin + if not(cpo_ignorevarspez in cpoptions) and + (currpara1.varspez<>currpara2.varspez) then + exit; + { "univ" state doesn't matter here: from univ to non-univ + matches if the types are compatible (i.e., as usual), + from from non-univ to univ also matches if the types + have the same size (checked below) } + eq:=compare_defs_ext(currpara1.vardef,currpara2.vardef,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.vardef,currpara2.vardef,nothingn, + convtype,hpd,cdoptions); + end; + end; + { check type } + if eq=te_incompatible then + begin + { special case: "univ" parameters match if their size is equal } + if not(cpo_ignoreuniv in cpoptions) and + currpara2.univpara and + is_valid_univ_para_type(currpara1.vardef) and + (currpara1.vardef.size=currpara2.vardef.size) then + begin + { only pick as last choice } + eq:=te_convert_l5; + if (acp=cp_procvar) and + (cpo_warn_incompatible_univ in cpoptions) then + begin + { if the types may be passed in different ways by the + calling convention then this can lead to crashes + (note: not an exhaustive check, and failing this + this check does not mean things will crash on all + platforms) } + if potentially_incompatible_univ_paras(currpara1.vardef,currpara2.vardef) then + Message2(type_w_procvar_univ_conflicting_para,currpara1.vardef.typename,currpara2.vardef.typename) + end; + end + else + exit; + end; + { open strings can never match exactly, since you cannot define } + { a separate "open string" type -> we have to be able to } + { consider those as exact when resolving forward definitions. } + { The same goes for array of const. Open arrays are handled } + { already (if their element types match exactly, they are } + { considered to be an exact match) } + { And also for "inline defined" function parameter definitions } + { (i.e., function types directly declared in a parameter list) } + if (is_array_of_const(currpara1.vardef) or + is_open_string(currpara1.vardef) or + ((currpara1.vardef.typ = procvardef) and + not(assigned(currpara1.vardef.typesym)))) and + (eq=te_equal) and + (cpo_openequalisexact in cpoptions) then + eq:=te_exact; + 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; + if not(cpo_compilerproc in cpoptions) and + not(cpo_rtlproc in cpoptions) and + is_ansistring(currpara1.vardef) and + is_ansistring(currpara2.vardef) and + (tstringdef(currpara1.vardef).encoding<>tstringdef(currpara2.vardef).encoding) and + ((tstringdef(currpara1.vardef).encoding=globals.CP_NONE) or + (tstringdef(currpara2.vardef).encoding=globals.CP_NONE) + ) then + eq:=te_convert_l1; + if eq<lowesteq then + lowesteq:=eq; + 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; + if cpo_ignoreframepointer in cpoptions then + begin + if (i1<para1.count) and + (vo_is_parentfp in tparavarsym(para1[i1]).varoptions) then + inc(i1); + if (i2<para2.count) and + (vo_is_parentfp in tparavarsym(para2[i2]).varoptions) then + 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;checkincompatibleuniv: boolean):tequaltype; + var + eq : tequaltype; + po_comp : tprocoptions; + pa_comp: tcompare_paras_options; + begin + proc_to_procvar_equal:=te_incompatible; + if not(assigned(def1)) or not(assigned(def2)) then + exit; + { check for method pointer and local procedure pointer: + a) if one is a procedure of object, the other also has to be one + b) if one is a pure address, the other also has to be one + except if def1 is a global proc and def2 is a nested procdef + (global procedures can be converted into nested procvars) + c) if def1 is a nested procedure, then def2 has to be a nested + procvar and def1 has to have the po_delphi_nested_cc option + d) if def1 is a procvar, def1 and def2 both have to be nested or + non-nested (we don't allow assignments from non-nested to + nested procvars to make sure that we can still implement + nested procvars using trampolines -- e.g., this would be + necessary for LLVM or CIL as long as they do not have support + for Delphi-style frame pointer parameter passing) } + if (def1.is_methodpointer<>def2.is_methodpointer) or { a) } + ((def1.is_addressonly<>def2.is_addressonly) and { b) } + (is_nested_pd(def1) or + not is_nested_pd(def2))) or + ((def1.typ=procdef) and { c) } + is_nested_pd(def1) and + (not(po_delphi_nested_cc in def1.procoptions) or + not is_nested_pd(def2))) or + ((def1.typ=procvardef) and { d) } + (is_nested_pd(def1)<>is_nested_pd(def2))) then + exit; + pa_comp:=[cpo_ignoreframepointer]; + if checkincompatibleuniv then + include(pa_comp,cpo_warn_incompatible_univ); + { check return value and options, methodpointer is already checked } + po_comp:=[po_staticmethod,po_interrupt, + po_iocheck,po_varargs]; + if (m_delphi in current_settings.modeswitches) then + exclude(po_comp,po_varargs); + if (def1.proccalloption=def2.proccalloption) and + ((po_comp * def1.procoptions)= (po_comp * def2.procoptions)) and + equal_defs(def1.returndef,def2.returndef) 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,pa_comp); + if eq=te_exact then + eq:=te_equal; + if (eq=te_equal) then + begin + { prefer non-nested to non-nested over non-nested to nested } + if (is_nested_pd(def1)<>is_nested_pd(def2)) then + eq:=te_convert_l1; + end; + proc_to_procvar_equal:=eq; + end; + end; + + + function compatible_childmethod_resultdef(parentretdef, childretdef: tdef): boolean; + begin + compatible_childmethod_resultdef := + (equal_defs(parentretdef,childretdef)) or + ((parentretdef.typ=objectdef) and + (childretdef.typ=objectdef) and + is_class_or_interface_or_objc(parentretdef) and + is_class_or_interface_or_objc(childretdef) and + (tobjectdef(childretdef).is_related(tobjectdef(parentretdef)))) + end; + + +end. diff --git a/closures/compiler/defutil.pas b/closures/compiler/defutil.pas new file mode 100644 index 0000000000..061044904e --- /dev/null +++ b/closures/compiler/defutil.pas @@ -0,0 +1,1164 @@ +{ + Copyright (c) 1998-2006 by Florian Klaempfl + + This unit provides some help routines for type 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 defutil; + +{$i fpcdefs.inc} + +interface + + uses + cclasses, + globtype,globals,constexp,node, + symconst,symbase,symtype,symdef, + cgbase,cpubase; + + type + tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit, + mmxu32bit,mmxs32bit,mmxfixed16,mmxsingle); + + +{***************************************************************************** + Basic type functions + *****************************************************************************} + + {# Returns true, if definition defines an ordinal type } + function is_ordinal(def : tdef) : boolean; + + {# Returns true, if definition defines a string type } + function is_string(def : tdef): boolean; + + {# Returns the minimal integer value of the type } + function get_min_value(def : tdef) : TConstExprInt; + + {# Returns the maximal integer value of the type } + function get_max_value(def : tdef) : TConstExprInt; + + {# Returns basetype of the specified integer range } + function range_to_basetype(l,h:TConstExprInt):tordtype; + + procedure range_to_type(l,h:TConstExprInt;var def:tdef); + + procedure int_to_type(v:TConstExprInt;var def:tdef); + + {# Returns true, if definition defines an integer type } + function is_integer(def : tdef) : boolean; + + {# Returns true if definition is a boolean } + function is_boolean(def : tdef) : boolean; + + {# Returns true if definition is a Pascal-style boolean (1 = true, zero = false) } + function is_pasbool(def : tdef) : boolean; + + {# Returns true if definition is a C-style boolean (non-zero value = true, zero = false) } + function is_cbool(def : tdef) : boolean; + + {# Returns true if definition is a char + + This excludes the unicode char. + } + function is_char(def : tdef) : boolean; + + {# Returns true if definition is a widechar } + function is_widechar(def : tdef) : boolean; + + {# Returns true if definition is either an AnsiChar or a WideChar } + function is_anychar(def : tdef) : boolean; + + {# Returns true if definition is a void} + function is_void(def : tdef) : boolean; + + {# Returns true if definition is a smallset} + function is_smallset(p : tdef) : boolean; + + {# Returns true, if def defines a signed data type + (only for ordinal types) + } + function is_signed(def : tdef) : boolean; + + {# Returns whether def_from's range is comprised in def_to's if both are + orddefs, false otherwise } + function is_in_limit(def_from,def_to : tdef) : boolean; + + {# Returns whether def is reference counted } + function is_managed_type(def: tdef) : boolean;{$ifdef USEINLINE}inline;{$endif} + + +{ function is_in_limit_value(val_from:TConstExprInt;def_from,def_to : tdef) : boolean;} + +{***************************************************************************** + Array helper functions + *****************************************************************************} + + {# Returns true, if p points to a zero based (non special like open or + dynamic array def). + + This is mainly used to see if the array + is convertable to a pointer + } + function is_zero_based_array(p : tdef) : boolean; + + {# Returns true if p points to an open array definition } + function is_open_array(p : tdef) : boolean; + + {# Returns true if p points to a dynamic array definition } + function is_dynamic_array(p : tdef) : boolean; + + {# Returns true, if p points to an array of const definition } + function is_array_constructor(p : tdef) : boolean; + + {# Returns true, if p points to a variant array } + function is_variant_array(p : tdef) : boolean; + + {# Returns true, if p points to an array of const } + function is_array_of_const(p : tdef) : boolean; + + {# Returns true, if p points any kind of special array + + That is if the array is an open array, a variant + array, an array constants constructor, or an + array of const. + + Bitpacked arrays aren't special in this regard though. + } + function is_special_array(p : tdef) : boolean; + + {# Returns true if p is a bitpacked array } + function is_packed_array(p: tdef) : boolean; + + {# Returns true if p is a bitpacked record } + function is_packed_record_or_object(p: tdef) : boolean; + + {# Returns true if p is a char array def } + function is_chararray(p : tdef) : boolean; + + {# Returns true if p is a wide char array def } + function is_widechararray(p : tdef) : boolean; + + {# Returns true if p is a open char array def } + function is_open_chararray(p : tdef) : boolean; + + {# Returns true if p is a open wide char array def } + function is_open_widechararray(p : tdef) : boolean; + +{***************************************************************************** + String helper functions + *****************************************************************************} + + {# Returns true if p points to an open string type } + function is_open_string(p : tdef) : boolean; + + {# Returns true if p is an ansi string type } + function is_ansistring(p : tdef) : boolean; + + {# Returns true if p is an ansi string type with codepage 0 } + function is_rawbytestring(p : tdef) : boolean; + + {# Returns true if p is a long string type } + function is_longstring(p : tdef) : boolean; + + {# returns true if p is a wide string type } + function is_widestring(p : tdef) : boolean; + + {# true if p is an unicode string def } + function is_unicodestring(p : tdef) : boolean; + + {# returns true if p is a wide or unicode string type } + function is_wide_or_unicode_string(p : tdef) : boolean; + + {# Returns true if p is a short string type } + function is_shortstring(p : tdef) : boolean; + + {# Returns true if p is a pchar def } + function is_pchar(p : tdef) : boolean; + + {# Returns true if p is a pwidechar def } + function is_pwidechar(p : tdef) : boolean; + + {# Returns true if p is a voidpointer def } + function is_voidpointer(p : tdef) : boolean; + + {# Returns true, if definition is a float } + function is_fpu(def : tdef) : boolean; + + {# Returns true, if def is a currency type } + function is_currency(def : tdef) : boolean; + + {# Returns true, if def is a single type } + function is_single(def : tdef) : boolean; + + {# Returns true, if def is a double type } + function is_double(def : tdef) : boolean; + + {# Returns true, if def is an extended type } + function is_extended(def : tdef) : boolean; + + {# Returns true, if definition is a "real" real (i.e. single/double/extended) } + function is_real(def : tdef) : boolean; + + {# Returns true, if def is a 32 bit integer type } + function is_32bitint(def : tdef) : boolean; + + {# Returns true, if def is a 64 bit integer type } + function is_64bitint(def : tdef) : boolean; + + {# Returns true, if def is a 64 bit type } + function is_64bit(def : tdef) : boolean; + + {# If @var(l) isn't in the range of todef a range check error (if not explicit) is generated and + the value is placed within the range + } + procedure testrange(todef : tdef;var l : tconstexprint;explicit,forcerangecheck:boolean); + + {# Returns the range of def, where @var(l) is the low-range and @var(h) is + the high-range. + } + procedure getrange(def : tdef;out l, h : TConstExprInt); + + { type being a vector? } + function is_vector(p : tdef) : boolean; + + { some type helper routines for MMX support } + function is_mmx_able_array(p : tdef) : boolean; + + {# returns the mmx type } + function mmx_type(p : tdef) : tmmxtype; + + { returns if the passed type (array) fits into an mm register } + function fits_in_mm_register(p : tdef) : boolean; + + {# From a definition return the abstract code generator size enum. It is + to note that the value returned can be @var(OS_NO) } + function def_cgsize(def: tdef): tcgsize; + + {# returns true, if the type passed is can be used with windows automation } + function is_automatable(p : tdef) : boolean; + + { # returns true if the procdef has no parameters and no specified return type } + function is_bareprocdef(pd : tprocdef): boolean; + + { # returns the smallest base integer type whose range encompasses that of + both ld and rd; if keep_sign_if_equal, then if ld and rd have the same + signdness, the result will also get that signdness } + function get_common_intdef(ld, rd: torddef; keep_sign_if_equal: boolean): torddef; + + { # returns whether the type is potentially a valid type of/for an "univ" parameter + (basically: it must have a compile-time size) } + function is_valid_univ_para_type(def: tdef): boolean; + + { # returns whether the procdef/procvardef represents a nested procedure + or not } + function is_nested_pd(def: tabstractprocdef): boolean;{$ifdef USEINLINE}inline;{$endif} + + { # returns whether def is a type parameter of a generic } + function is_typeparam(def : tdef) : boolean;{$ifdef USEINLINE}inline;{$endif} + +implementation + + uses + systems,verbose; + + { returns true, if def uses FPU } + function is_fpu(def : tdef) : boolean; + begin + is_fpu:=(def.typ=floatdef); + end; + + + { returns true, if def is a currency type } + function is_currency(def : tdef) : boolean; + begin + case s64currencytype.typ of + orddef : + result:=(def.typ=orddef) and + (torddef(s64currencytype).ordtype=torddef(def).ordtype); + floatdef : + result:=(def.typ=floatdef) and + (tfloatdef(s64currencytype).floattype=tfloatdef(def).floattype); + else + internalerror(200304222); + end; + end; + + + { returns true, if def is a single type } + function is_single(def : tdef) : boolean; + begin + result:=(def.typ=floatdef) and + (tfloatdef(def).floattype=s32real); + end; + + + { returns true, if def is a double type } + function is_double(def : tdef) : boolean; + begin + result:=(def.typ=floatdef) and + (tfloatdef(def).floattype=s64real); + end; + + + function is_extended(def : tdef) : boolean; + begin + result:=(def.typ=floatdef) and + (tfloatdef(def).floattype in [s80real,sc80real]); + end; + + + { returns true, if definition is a "real" real (i.e. single/double/extended) } + function is_real(def : tdef) : boolean; + begin + result:=(def.typ=floatdef) and + (tfloatdef(def).floattype in [s32real,s64real,s80real]); + end; + + + function range_to_basetype(l,h:TConstExprInt):tordtype; + begin + { prefer signed over unsigned } + if (l>=int64(-128)) and (h<=127) then + range_to_basetype:=s8bit + else if (l>=0) and (h<=255) then + range_to_basetype:=u8bit + else if (l>=int64(-32768)) and (h<=32767) then + range_to_basetype:=s16bit + else if (l>=0) and (h<=65535) then + range_to_basetype:=u16bit + else if (l>=int64(low(longint))) and (h<=high(longint)) then + range_to_basetype:=s32bit + else if (l>=low(cardinal)) and (h<=high(cardinal)) then + range_to_basetype:=u32bit + else + range_to_basetype:=s64bit; + end; + + + procedure range_to_type(l,h:TConstExprInt;var def:tdef); + begin + { prefer signed over unsigned } + if (l>=int64(-128)) and (h<=127) then + def:=s8inttype + else if (l>=0) and (h<=255) then + def:=u8inttype + else if (l>=int64(-32768)) and (h<=32767) then + def:=s16inttype + else if (l>=0) and (h<=65535) then + def:=u16inttype + else if (l>=int64(low(longint))) and (h<=high(longint)) then + def:=s32inttype + else if (l>=low(cardinal)) and (h<=high(cardinal)) then + def:=u32inttype + else if (l>=low(int64)) and (h<=high(int64)) then + def:=s64inttype + else + def:=u64inttype; + end; + + + procedure int_to_type(v:TConstExprInt;var def:tdef); + begin + range_to_type(v,v,def); + end; + + + { true if p is an ordinal } + function is_ordinal(def : tdef) : boolean; + var + dt : tordtype; + begin + case def.typ of + orddef : + begin + dt:=torddef(def).ordtype; + is_ordinal:=dt in [uchar,uwidechar, + u8bit,u16bit,u32bit,u64bit, + s8bit,s16bit,s32bit,s64bit, + pasbool8,pasbool16,pasbool32,pasbool64, + bool8bit,bool16bit,bool32bit,bool64bit]; + end; + enumdef : + is_ordinal:=true; + else + is_ordinal:=false; + end; + end; + + { true if p is a string } + function is_string(def : tdef) : boolean; + begin + is_string := (assigned(def) and (def.typ = stringdef)); + end; + + + { returns the min. value of the type } + function get_min_value(def : tdef) : TConstExprInt; + begin + case def.typ of + orddef: + result:=torddef(def).low; + enumdef: + result:=int64(tenumdef(def).min); + else + result:=0; + end; + end; + + + { returns the max. value of the type } + function get_max_value(def : tdef) : TConstExprInt; + begin + case def.typ of + orddef: + result:=torddef(def).high; + enumdef: + result:=tenumdef(def).max; + else + result:=0; + end; + end; + + + { true if p is an integer } + function is_integer(def : tdef) : boolean; + begin + result:=(def.typ=orddef) and + (torddef(def).ordtype in [u8bit,u16bit,u32bit,u64bit, + s8bit,s16bit,s32bit,s64bit]); + end; + + + { true if p is a boolean } + function is_boolean(def : tdef) : boolean; + begin + result:=(def.typ=orddef) and + (torddef(def).ordtype in [pasbool8,pasbool16,pasbool32,pasbool64,bool8bit,bool16bit,bool32bit,bool64bit]); + end; + + + function is_pasbool(def : tdef) : boolean; + begin + result:=(def.typ=orddef) and + (torddef(def).ordtype in [pasbool8,pasbool16,pasbool32,pasbool64]); + end; + + { true if def is a C-style boolean (non-zero value = true, zero = false) } + function is_cbool(def : tdef) : boolean; + begin + result:=(def.typ=orddef) and + (torddef(def).ordtype in [bool8bit,bool16bit,bool32bit,bool64bit]); + end; + + + { true if p is a void } + function is_void(def : tdef) : boolean; + begin + result:=(def.typ=orddef) and + (torddef(def).ordtype=uvoid); + end; + + + { true if p is a char } + function is_char(def : tdef) : boolean; + begin + result:=(def.typ=orddef) and + (torddef(def).ordtype=uchar); + end; + + + { true if p is a wchar } + function is_widechar(def : tdef) : boolean; + begin + result:=(def.typ=orddef) and + (torddef(def).ordtype=uwidechar); + end; + + + { true if p is a char or wchar } + function is_anychar(def : tdef) : boolean; + begin + result:=(def.typ=orddef) and + (torddef(def).ordtype in [uchar,uwidechar]) + end; + + + { true if p is signed (integer) } + function is_signed(def : tdef) : boolean; + begin + case def.typ of + orddef : + result:=torddef(def).low < 0; + enumdef : + result:=tenumdef(def).min < 0; + arraydef : + result:=is_signed(tarraydef(def).rangedef); + else + result:=false; + end; + end; + + + function is_in_limit(def_from,def_to : tdef) : boolean; + + begin + if (def_from.typ<>def_to.typ) or + not(def_from.typ in [orddef,enumdef,setdef]) then + begin + is_in_limit := false; + exit; + end; + case def_from.typ of + orddef: + is_in_limit:=(torddef(def_from).low>=torddef(def_to).low) and + (torddef(def_from).high<=torddef(def_to).high); + enumdef: + is_in_limit:=(tenumdef(def_from).min>=tenumdef(def_to).min) and + (tenumdef(def_from).max<=tenumdef(def_to).max); + setdef: + is_in_limit:=(tsetdef(def_from).setbase>=tsetdef(def_to).setbase) and + (tsetdef(def_from).setmax<=tsetdef(def_to).setmax); + else + is_in_limit:=false; + end; + end; + + + function is_managed_type(def: tdef): boolean;{$ifdef USEINLINE}inline;{$endif} + begin + result:=def.needs_inittable; + end; + + + { true, if p points to an open array def } + function is_open_string(p : tdef) : boolean; + begin + is_open_string:=(p.typ=stringdef) and + (tstringdef(p).stringtype=st_shortstring) and + (tstringdef(p).len=0); + end; + + + { true, if p points to a zero based array def } + function is_zero_based_array(p : tdef) : boolean; + begin + result:=(p.typ=arraydef) and + (tarraydef(p).lowrange=0) and + not(is_special_array(p)); + end; + + { true if p points to a dynamic array def } + function is_dynamic_array(p : tdef) : boolean; + begin + result:=(p.typ=arraydef) and + (ado_IsDynamicArray in tarraydef(p).arrayoptions); + end; + + + { true, if p points to an open array def } + function is_open_array(p : tdef) : boolean; + begin + { check for s32inttype is needed, because for u32bit the high + range is also -1 ! (PFV) } + result:=(p.typ=arraydef) and + (tarraydef(p).rangedef=s32inttype) and + (tarraydef(p).lowrange=0) and + (tarraydef(p).highrange=-1) and + ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])=[]); + end; + + { true, if p points to an array of const def } + function is_array_constructor(p : tdef) : boolean; + begin + result:=(p.typ=arraydef) and + (ado_IsConstructor in tarraydef(p).arrayoptions); + end; + + { true, if p points to a variant array } + function is_variant_array(p : tdef) : boolean; + begin + result:=(p.typ=arraydef) and + (ado_IsVariant in tarraydef(p).arrayoptions); + end; + + { true, if p points to an array of const } + function is_array_of_const(p : tdef) : boolean; + begin + result:=(p.typ=arraydef) and + (ado_IsArrayOfConst in tarraydef(p).arrayoptions); + end; + + { true, if p points to a special array, bitpacked arrays aren't special in this regard though } + function is_special_array(p : tdef) : boolean; + begin + result:=(p.typ=arraydef) and + ( + ((tarraydef(p).arrayoptions * [ado_IsVariant,ado_IsArrayOfConst,ado_IsConstructor,ado_IsDynamicArray])<>[]) or + is_open_array(p) + ); + end; + + { true if p is an ansi string def } + function is_ansistring(p : tdef) : boolean; + begin + is_ansistring:=(p.typ=stringdef) and + (tstringdef(p).stringtype=st_ansistring); + end; + + { true if p is an ansi string def with codepage CP_NONE } + function is_rawbytestring(p : tdef) : boolean; + begin + is_rawbytestring:=(p.typ=stringdef) and + (tstringdef(p).stringtype=st_ansistring) and + (tstringdef(p).encoding=globals.CP_NONE); + end; + + { true if p is an long string def } + function is_longstring(p : tdef) : boolean; + begin + is_longstring:=(p.typ=stringdef) and + (tstringdef(p).stringtype=st_longstring); + end; + + + { true if p is an wide string def } + function is_widestring(p : tdef) : boolean; + begin + is_widestring:=(p.typ=stringdef) and + (tstringdef(p).stringtype=st_widestring); + end; + + + { true if p is an wide string def } + function is_wide_or_unicode_string(p : tdef) : boolean; + begin + is_wide_or_unicode_string:=(p.typ=stringdef) and + (tstringdef(p).stringtype in [st_widestring,st_unicodestring]); + end; + + + { true if p is an unicode string def } + function is_unicodestring(p : tdef) : boolean; + begin + is_unicodestring:=(p.typ=stringdef) and + (tstringdef(p).stringtype=st_unicodestring); + end; + + + { true if p is an short string def } + function is_shortstring(p : tdef) : boolean; + begin + is_shortstring:=(p.typ=stringdef) and + (tstringdef(p).stringtype=st_shortstring); + end; + + + { true if p is bit packed array def } + function is_packed_array(p: tdef) : boolean; + begin + is_packed_array := + (p.typ = arraydef) and + (ado_IsBitPacked in tarraydef(p).arrayoptions); + end; + + + { true if p is bit packed record def } + function is_packed_record_or_object(p: tdef) : boolean; + begin + is_packed_record_or_object := + (p.typ in [recorddef,objectdef]) and + (tabstractrecorddef(p).is_packed); + end; + + + { true if p is a char array def } + function is_chararray(p : tdef) : boolean; + begin + is_chararray:=(p.typ=arraydef) and + is_char(tarraydef(p).elementdef) and + not(is_special_array(p)); + end; + + { true if p is a widechar array def } + function is_widechararray(p : tdef) : boolean; + begin + is_widechararray:=(p.typ=arraydef) and + is_widechar(tarraydef(p).elementdef) and + not(is_special_array(p)); + end; + + + { true if p is a open char array def } + function is_open_chararray(p : tdef) : boolean; + begin + is_open_chararray:= is_open_array(p) and + is_char(tarraydef(p).elementdef); + end; + + { true if p is a open wide char array def } + function is_open_widechararray(p : tdef) : boolean; + begin + is_open_widechararray:= is_open_array(p) and + is_widechar(tarraydef(p).elementdef); + end; + + { true if p is a pchar def } + function is_pchar(p : tdef) : boolean; + begin + is_pchar:=(p.typ=pointerdef) and + (is_char(tpointerdef(p).pointeddef) or + (is_zero_based_array(tpointerdef(p).pointeddef) and + is_chararray(tpointerdef(p).pointeddef))); + end; + + { true if p is a pchar def } + function is_pwidechar(p : tdef) : boolean; + begin + is_pwidechar:=(p.typ=pointerdef) and + (is_widechar(tpointerdef(p).pointeddef) or + (is_zero_based_array(tpointerdef(p).pointeddef) and + is_widechararray(tpointerdef(p).pointeddef))); + end; + + + { true if p is a voidpointer def } + function is_voidpointer(p : tdef) : boolean; + begin + is_voidpointer:=(p.typ=pointerdef) and + (tpointerdef(p).pointeddef.typ=orddef) and + (torddef(tpointerdef(p).pointeddef).ordtype=uvoid); + end; + + + { true, if def is a 32 bit int type } + function is_32bitint(def : tdef) : boolean; + begin + result:=(def.typ=orddef) and (torddef(def).ordtype in [u32bit,s32bit]) + end; + + + { true, if def is a 64 bit int type } + function is_64bitint(def : tdef) : boolean; + begin + is_64bitint:=(def.typ=orddef) and (torddef(def).ordtype in [u64bit,s64bit]) + end; + + + { true, if def is a 64 bit type } + function is_64bit(def : tdef) : boolean; + begin + is_64bit:=(def.typ=orddef) and (torddef(def).ordtype in [u64bit,s64bit,scurrency,pasbool64,bool64bit]) + end; + + + { if l isn't in the range of todef a range check error (if not explicit) is generated and + the value is placed within the range } + procedure testrange(todef : tdef;var l : tconstexprint;explicit,forcerangecheck:boolean); + var + lv,hv: TConstExprInt; + begin + { for 64 bit types we need only to check if it is less than } + { zero, if def is a qword node } + getrange(todef,lv,hv); + if (l<lv) or (l>hv) then + begin + if not explicit then + begin + if ((todef.typ=enumdef) and + { delphi allows range check errors in + enumeration type casts FK } + not(m_delphi in current_settings.modeswitches)) or + (cs_check_range in current_settings.localswitches) or + forcerangecheck then + Message(parser_e_range_check_error) + else + Message(parser_w_range_check_error); + end; + { Fix the value to fit in the allocated space for this type of variable } + case longint(todef.size) of + 1: l := l and $ff; + 2: l := l and $ffff; + 4: l := l and $ffffffff; + end; + {reset sign, i.e. converting -1 to qword changes the value to high(qword)} + l.signed:=false; + { do sign extension if necessary (JM) } + if is_signed(todef) then + begin + case longint(todef.size) of + 1: l.svalue := shortint(l.svalue); + 2: l.svalue := smallint(l.svalue); + 4: l.svalue := longint(l.svalue); + end; + l.signed:=true; + end; + end; + end; + + + { return the range from def in l and h } + procedure getrange(def : tdef;out l, h : TConstExprInt); + begin + case def.typ of + orddef : + begin + l:=torddef(def).low; + h:=torddef(def).high; + end; + enumdef : + begin + l:=int64(tenumdef(def).min); + h:=int64(tenumdef(def).max); + end; + arraydef : + begin + l:=int64(tarraydef(def).lowrange); + h:=int64(tarraydef(def).highrange); + end; + else + internalerror(200611054); + end; + end; + + + function mmx_type(p : tdef) : tmmxtype; + begin + mmx_type:=mmxno; + if is_mmx_able_array(p) then + begin + if tarraydef(p).elementdef.typ=floatdef then + case tfloatdef(tarraydef(p).elementdef).floattype of + s32real: + mmx_type:=mmxsingle; + end + else + case torddef(tarraydef(p).elementdef).ordtype of + u8bit: + mmx_type:=mmxu8bit; + s8bit: + mmx_type:=mmxs8bit; + u16bit: + mmx_type:=mmxu16bit; + s16bit: + mmx_type:=mmxs16bit; + u32bit: + mmx_type:=mmxu32bit; + s32bit: + mmx_type:=mmxs32bit; + end; + end; + end; + + + function is_vector(p : tdef) : boolean; + begin + result:=(p.typ=arraydef) and + not(is_special_array(p)) and + (tarraydef(p).elementdef.typ=floatdef) and + (tfloatdef(tarraydef(p).elementdef).floattype in [s32real,s64real]); + end; + + + { returns if the passed type (array) fits into an mm register } + function fits_in_mm_register(p : tdef) : boolean; + begin +{$ifdef x86} + result:= is_vector(p) and + ( + (tarraydef(p).elementdef.typ=floatdef) and + ( + (tarraydef(p).lowrange=0) and + (tarraydef(p).highrange=3) and + (tfloatdef(tarraydef(p).elementdef).floattype=s32real) + ) + ) or + + ( + (tarraydef(p).elementdef.typ=floatdef) and + ( + (tarraydef(p).lowrange=0) and + (tarraydef(p).highrange=1) and + (tfloatdef(tarraydef(p).elementdef).floattype=s64real) + ) + ); +{$else x86} + result:=false; +{$endif x86} + end; + + + function is_mmx_able_array(p : tdef) : boolean; + begin +{$ifdef SUPPORT_MMX} + if (cs_mmx_saturation in current_settings.localswitches) then + begin + is_mmx_able_array:=(p.typ=arraydef) and + not(is_special_array(p)) and + ( + ( + (tarraydef(p).elementdef.typ=orddef) and + ( + ( + (tarraydef(p).lowrange=0) and + (tarraydef(p).highrange=1) and + (torddef(tarraydef(p).elementdef).ordtype in [u32bit,s32bit]) + ) + or + ( + (tarraydef(p).lowrange=0) and + (tarraydef(p).highrange=3) and + (torddef(tarraydef(p).elementdef).ordtype in [u16bit,s16bit]) + ) + ) + ) + or + ( + ( + (tarraydef(p).elementdef.typ=floatdef) and + ( + (tarraydef(p).lowrange=0) and + (tarraydef(p).highrange=1) and + (tfloatdef(tarraydef(p).elementdef).floattype=s32real) + ) + ) + ) + ); + end + else + begin + is_mmx_able_array:=(p.typ=arraydef) and + ( + ( + (tarraydef(p).elementdef.typ=orddef) and + ( + ( + (tarraydef(p).lowrange=0) and + (tarraydef(p).highrange=1) and + (torddef(tarraydef(p).elementdef).ordtype in [u32bit,s32bit]) + ) + or + ( + (tarraydef(p).lowrange=0) and + (tarraydef(p).highrange=3) and + (torddef(tarraydef(p).elementdef).ordtype in [u16bit,s16bit]) + ) + or + ( + (tarraydef(p).lowrange=0) and + (tarraydef(p).highrange=7) and + (torddef(tarraydef(p).elementdef).ordtype in [u8bit,s8bit]) + ) + ) + ) + or + ( + (tarraydef(p).elementdef.typ=floatdef) and + ( + (tarraydef(p).lowrange=0) and + (tarraydef(p).highrange=1) and + (tfloatdef(tarraydef(p).elementdef).floattype=s32real) + ) + ) + ); + end; +{$else SUPPORT_MMX} + is_mmx_able_array:=false; +{$endif SUPPORT_MMX} + end; + + + function def_cgsize(def: tdef): tcgsize; + begin + case def.typ of + orddef, + enumdef, + setdef: + begin + result:=int_cgsize(def.size); + if is_signed(def) then + result:=tcgsize(ord(result)+(ord(OS_S8)-ord(OS_8))); + end; + classrefdef, + pointerdef: + result := OS_ADDR; + procvardef: + begin + if not tprocvardef(def).is_addressonly then + {$if sizeof(pint) = 4} + result:=OS_64 + {$else} {$if sizeof(pint) = 8} + result:=OS_128 + {$else} + internalerror(200707141) + {$endif} {$endif} + else + result:=OS_ADDR; + end; + stringdef : + begin + if is_ansistring(def) or is_wide_or_unicode_string(def) then + result := OS_ADDR + else + result:=int_cgsize(def.size); + end; + objectdef : + begin + if is_implicit_pointer_object_type(def) then + result := OS_ADDR + else + result:=int_cgsize(def.size); + end; + floatdef: + if cs_fp_emulation in current_settings.moduleswitches then + result:=int_cgsize(def.size) + else + result:=tfloat2tcgsize[tfloatdef(def).floattype]; + recorddef : + result:=int_cgsize(def.size); + arraydef : + begin + if not is_special_array(def) then + result := int_cgsize(def.size) + else + begin + if is_dynamic_array(def) then + result := OS_ADDR + else + result := OS_NO; + end; + end; + else + begin + { undefined size } + result:=OS_NO; + end; + end; + end; + + { In Windows 95 era, ordinals were restricted to [u8bit,s32bit,s16bit,bool16bit] + As of today, both signed and unsigned types from 8 to 64 bits are supported. } + function is_automatable(p : tdef) : boolean; + begin + result:=false; + case p.typ of + orddef: + result:=torddef(p).ordtype in [u8bit,s8bit,u16bit,s16bit,u32bit,s32bit, + u64bit,s64bit,bool16bit,scurrency]; + floatdef: + result:=tfloatdef(p).floattype in [s64currency,s64real,s32real]; + stringdef: + result:=tstringdef(p).stringtype in [st_ansistring,st_widestring,st_unicodestring]; + variantdef: + result:=true; + objectdef: + result:=tobjectdef(p).objecttype in [odt_interfacecom,odt_dispinterface,odt_interfacecorba]; + end; + end; + + + {# returns true, if the type passed is a varset } + function is_smallset(p : tdef) : boolean; + begin + result:=(p.typ=setdef) and (p.size in [1,2,4]) + end; + + + function is_bareprocdef(pd : tprocdef): boolean; + begin + result:=(pd.maxparacount=0) and + (is_void(pd.returndef) or + (pd.proctypeoption = potype_constructor)); + end; + + + function get_common_intdef(ld, rd: torddef; keep_sign_if_equal: boolean): torddef; + var + llow, lhigh: tconstexprint; + begin + llow:=rd.low; + if llow<ld.low then + llow:=ld.low; + lhigh:=rd.high; + if lhigh<ld.high then + lhigh:=ld.high; + case range_to_basetype(llow,lhigh) of + s8bit: + result:=torddef(s8inttype); + u8bit: + result:=torddef(u8inttype); + s16bit: + result:=torddef(s16inttype); + u16bit: + result:=torddef(u16inttype); + s32bit: + result:=torddef(s32inttype); + u32bit: + result:=torddef(u32inttype); + s64bit: + result:=torddef(s64inttype); + u64bit: + result:=torddef(u64inttype); + else + begin + { avoid warning } + result:=nil; + internalerror(200802291); + end; + end; + if keep_sign_if_equal and + (is_signed(ld)=is_signed(rd)) and + (is_signed(result)<>is_signed(ld)) then + case result.ordtype of + s8bit: + result:=torddef(u8inttype); + u8bit: + result:=torddef(s16inttype); + s16bit: + result:=torddef(u16inttype); + u16bit: + result:=torddef(s32inttype); + s32bit: + result:=torddef(u32inttype); + u32bit: + result:=torddef(s64inttype); + s64bit: + result:=torddef(u64inttype); + end; + end; + + + function is_valid_univ_para_type(def: tdef): boolean; + begin + result:= + not is_open_array(def) and + not is_void(def) and + (def.typ<>formaldef); + end; + + + function is_nested_pd(def: tabstractprocdef): boolean;{$ifdef USEINLINE}inline;{$endif} + begin + result:=def.parast.symtablelevel>normal_function_level; + end; + + + function is_typeparam(def : tdef) : boolean;{$ifdef USEINLINE}inline;{$endif} + begin + result:=(def.typ=undefineddef); + end; +end. diff --git a/closures/compiler/export.pas b/closures/compiler/export.pas new file mode 100644 index 0000000000..d363d7434a --- /dev/null +++ b/closures/compiler/export.pas @@ -0,0 +1,269 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements an uniform export 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 export; + +{$i fpcdefs.inc} + +interface + +uses + cutils,cclasses, + systems, + symtype,symdef,symsym, + aasmbase,aasmdata; + +const + { export options } + eo_resident = $1; + eo_index = $2; + eo_name = $4; + +type + texported_item = class(TLinkedListItem) + sym : tsym; + index : longint; + name : pshortstring; + options : word; + is_var : boolean; + constructor create; + destructor destroy;override; + end; + + texportlib=class + private + notsupmsg : boolean; + finitname, + ffininame : string; + procedure NotSupported; + public + constructor Create;virtual; + destructor Destroy;override; + procedure preparelib(const s : string);virtual; + procedure exportprocedure(hp : texported_item);virtual; + procedure exportvar(hp : texported_item);virtual; + procedure generatelib;virtual; + procedure setinitname(list: TAsmList; const s: string); virtual; + procedure setfininame(list: TAsmList; const s: string); virtual; + + property initname: string read finitname; + property fininame: string read ffininame; + end; + + TExportLibClass=class of TExportLib; + + + procedure exportprocsym(sym: tsym; const s : string; index: longint; options: word); + procedure exportvarsym(sym: tsym; const s : string; index: longint; options: word); + { to export symbols not directly related to a tsym (e.g., the Objective-C + rtti) } + procedure exportname(const s : string; options: word); + + procedure exportallprocdefnames(sym: tprocsym; pd: tprocdef; options: word); + procedure exportallprocsymnames(ps: tprocsym; options: word); + + +var + CExportLib : array[tsystem] of TExportLibClass; + ExportLib : TExportLib; + +procedure RegisterExport(t:tsystem;c:TExportLibClass); +procedure InitExport; +procedure DoneExport; + +implementation + +uses + verbose,globals; + +{**************************************************************************** + TExported_procedure +****************************************************************************} + +procedure exportprocsym(sym: tsym; const s : string; index: longint; options: word); + var + hp : texported_item; + begin + hp:=texported_item.create; + hp.name:=stringdup(s); + hp.sym:=sym; + hp.options:=options or eo_name; + hp.index:=index; + exportlib.exportprocedure(hp); + end; + + +procedure exportvarsym(sym: tsym; const s : string; index: longint; options: word); + var + hp : texported_item; + begin + hp:=texported_item.create; + hp.name:=stringdup(s); + hp.sym:=sym; + hp.is_var:=true; + hp.options:=options or eo_name; + hp.index:=index; + exportlib.exportvar(hp); + end; + + +procedure exportname(const s : string; options: word); + begin + exportvarsym(nil,s,0,options); + end; + + + procedure exportallprocdefnames(sym: tprocsym; pd: tprocdef; options: word); + var + item: TCmdStrListItem; + begin + exportprocsym(sym,pd.mangledname,0,options); + { walk through all aliases } + item:=TCmdStrListItem(pd.aliasnames.first); + while assigned(item) do + begin + { avoid duplicate entries, sometimes aliasnames contains the mangledname } + if item.str<>pd.mangledname then + exportprocsym(sym,item.str,0,options); + item:=TCmdStrListItem(item.next); + end; + end; + + + procedure exportallprocsymnames(ps: tprocsym; options: word); + var + i: longint; + begin + for i:= 0 to ps.ProcdefList.Count-1 do + exportallprocdefnames(ps,tprocdef(ps.ProcdefList[i]),options); + end; + + +{**************************************************************************** + TExported_procedure +****************************************************************************} + +constructor texported_item.Create; +begin + inherited Create; + sym:=nil; + index:=-1; + name:=nil; + options:=0; + is_var:=false; +end; + + +destructor texported_item.destroy; +begin + stringdispose(name); + inherited destroy; +end; + + +{**************************************************************************** + TExportLib +****************************************************************************} + +constructor texportlib.Create; +begin + notsupmsg:=false; +end; + + +destructor texportlib.Destroy; +begin +end; + + +procedure texportlib.NotSupported; +begin + { show the message only once } + if not notsupmsg then + begin + Message(exec_e_dll_not_supported); + notsupmsg:=true; + end; +end; + + +procedure texportlib.preparelib(const s:string); +begin + NotSupported; +end; + + +procedure texportlib.exportprocedure(hp : texported_item); +begin + NotSupported; +end; + + +procedure texportlib.exportvar(hp : texported_item); +begin + NotSupported; +end; + + +procedure texportlib.generatelib; +begin + NotSupported; +end; + + +procedure texportlib.setinitname(list: TAsmList; const s: string); +begin + finitname:=s; +end; + + +procedure texportlib.setfininame(list: TAsmList; const s: string); +begin + ffininame:=s; +end; + +{***************************************************************************** + Init/Done +*****************************************************************************} + +procedure RegisterExport(t:tsystem;c:TExportLibClass); +begin + CExportLib[t]:=c; +end; + + +procedure InitExport; +begin + if assigned(CExportLib[target_info.system]) then + exportlib:=CExportLib[target_info.system].Create + else + exportlib:=TExportLib.Create; +end; + + +procedure DoneExport; +begin + if assigned(Exportlib) then + Exportlib.free; +end; + + +end. diff --git a/closures/compiler/expunix.pas b/closures/compiler/expunix.pas new file mode 100644 index 0000000000..9bf7ae3919 --- /dev/null +++ b/closures/compiler/expunix.pas @@ -0,0 +1,189 @@ +{ + Copyright (c) 2008 by the Free Pascal Compiler team + + This unit implements common support for import,export,link routines + for unix target + + 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 expunix; + +{$i fpcdefs.inc} + +interface + +uses + cutils,cclasses, + systems, + export, + symtype,symdef,symsym, + aasmbase; + +type + texportlibunix=class(texportlib) + private + fexportedsymnames: TCmdStrList; + public + constructor Create; override; + destructor destroy; override; + procedure preparelib(const s : string);override; + procedure exportprocedure(hp : texported_item);override; + procedure exportvar(hp : texported_item);override; + procedure generatelib;override; + property exportedsymnames: TCmdStrList read fexportedsymnames; + end; + +implementation + +{**************************************************************************** + TExportLibUnix +****************************************************************************} + +uses + symconst, + globtype,globals, + aasmdata,aasmtai,aasmcpu, + fmodule, + cgbase,cgutils,cpubase,cgobj, + cgcpu, + ncgutil, + verbose; + + +constructor texportlibunix.create; +begin + inherited create; + fexportedsymnames:=tcmdstrlist.create_no_double; +end; + +destructor texportlibunix.destroy; +begin + fexportedsymnames.free; + inherited destroy; +end; + + + +procedure texportlibunix.preparelib(const s:string); +begin +end; + + +procedure texportlibunix.exportprocedure(hp : texported_item); +var + hp2 : texported_item; +begin + { first test the index value } + if (hp.options and eo_index)<>0 then + begin + Message1(parser_e_no_export_with_index_for_target,target_info.shortname); + exit; + end; + { now place in correct order } + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) and + (hp.name^>hp2.name^) do + hp2:=texported_item(hp2.next); + { insert hp there !! } + if assigned(hp2) and (hp2.name^=hp.name^) then + begin + { this is not allowed !! } + Message1(parser_e_export_name_double,hp.name^); + exit; + end; + if hp2=texported_item(current_module._exports.first) then + current_module._exports.concat(hp) + else if assigned(hp2) then + begin + hp.next:=hp2; + hp.previous:=hp2.previous; + if assigned(hp2.previous) then + hp2.previous.next:=hp; + hp2.previous:=hp; + end + else + current_module._exports.concat(hp); +end; + + +procedure texportlibunix.exportvar(hp : texported_item); +begin + hp.is_var:=true; + exportprocedure(hp); +end; + + +procedure texportlibunix.generatelib; // straight t_linux copy for now. +var + hp2 : texported_item; + pd : tprocdef; +{$ifdef x86} + sym : tasmsymbol; + r : treference; +{$endif x86} +begin + create_codegen; + new_section(current_asmdata.asmlists[al_procedures],sec_code,'',0); + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) do + begin + if (not hp2.is_var) and + (hp2.sym.typ=procsym) then + begin + { the manglednames can already be the same when the procedure + is declared with cdecl } + pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]); + if not has_alias_name(pd,hp2.name^) then + begin + { place jump in al_procedures } + current_asmdata.asmlists[al_procedures].concat(tai_align.create(target_info.alignment.procalign)); + current_asmdata.asmlists[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + if (cs_create_pic in current_settings.moduleswitches) and + { other targets need to be checked how it works } + (target_info.system in [system_i386_freebsd,system_x86_64_freebsd,system_x86_64_linux,system_i386_linux,system_x86_64_solaris,system_i386_solaris]) then + begin +{$ifdef x86} + sym:=current_asmdata.RefAsmSymbol(pd.mangledname); + reference_reset_symbol(r,sym,0,sizeof(pint)); + if cs_create_pic in current_settings.moduleswitches then + r.refaddr:=addr_pic + else + r.refaddr:=addr_full; + current_asmdata.asmlists[al_procedures].concat(taicpu.op_ref(A_JMP,S_NO,r)); +{$endif x86} + end + else + cg.a_jmp_name(current_asmdata.asmlists[al_procedures],pd.mangledname); + current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); + end; + exportedsymnames.insert(hp2.name^); + end + else + begin + if assigned(hp2.sym) and + (hp2.name^<>hp2.sym.mangledname) then + Message2(parser_e_cant_export_var_different_name,hp2.sym.realname,hp2.sym.mangledname) + else + exportedsymnames.insert(hp2.name^); + end; + hp2:=texported_item(hp2.next); + end; + destroy_codegen; +end; + + +end. diff --git a/closures/compiler/finput.pas b/closures/compiler/finput.pas new file mode 100644 index 0000000000..1bfd39e18e --- /dev/null +++ b/closures/compiler/finput.pas @@ -0,0 +1,726 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements an extended file management + + 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 finput; + +{$i fpcdefs.inc} + +interface + + uses + cutils,cclasses,cstreams; + + const + InputFileBufSize=32*1024+1; + linebufincrease=512; + + type + tlongintarr = array[0..1000000] of longint; + plongintarr = ^tlongintarr; + + tinputfile = class + path,name : pshortstring; { path and filename } + next : tinputfile; { next file for reading } + + is_macro, + endoffile, { still bytes left to read } + closed : boolean; { is the file closed } + + buf : pchar; { buffer } + bufstart, { buffer start position in the file } + bufsize, { amount of bytes in the buffer } + maxbufsize : longint; { size in memory for the buffer } + + saveinputpointer : pchar; { save fields for scanner variables } + savelastlinepos, + saveline_no : longint; + + linebuf : plongintarr; { line buffer to retrieve lines } + maxlinebuf : longint; + + ref_index : longint; + ref_next : tinputfile; + + constructor create(const fn:string); + destructor destroy;override; + procedure setpos(l:longint); + procedure seekbuf(fpos:longint); + procedure readbuf; + function open:boolean; + procedure close; + procedure tempclose; + function tempopen:boolean; + procedure setmacro(p:pchar;len:longint); + procedure setline(line,linepos:longint); + function getlinestr(l:longint):string; + function getfiletime:longint; + protected + filetime : longint; + function fileopen(const filename: string): boolean; virtual; abstract; + function fileseek(pos: longint): boolean; virtual; abstract; + function fileread(var databuf; maxsize: longint): longint; virtual; abstract; + function fileeof: boolean; virtual; abstract; + function fileclose: boolean; virtual; abstract; + procedure filegettime; virtual; abstract; + end; + + tdosinputfile = class(tinputfile) + protected + function fileopen(const filename: string): boolean; override; + function fileseek(pos: longint): boolean; override; + function fileread(var databuf; maxsize: longint): longint; override; + function fileeof: boolean; override; + function fileclose: boolean; override; + procedure filegettime; override; + private + f : TCCustomFileStream; { current file handle } + end; + + tinputfilemanager = class + files : tinputfile; + last_ref_index : longint; + cacheindex : longint; + cacheinputfile : tinputfile; + constructor create; + destructor destroy;override; + procedure register_file(f : tinputfile); + function get_file(l:longint) : tinputfile; + function get_file_name(l :longint):string; + function get_file_path(l :longint):string; + end; + +{**************************************************************************** + TModuleBase + ****************************************************************************} + + type + tmodulestate = (ms_unknown, + ms_registered, + ms_load,ms_compile, + ms_second_load,ms_second_compile, + ms_compiled + ); + const + ModuleStateStr : array[TModuleState] of string[20] = ( + 'Unknown', + 'Registered', + 'Load','Compile', + 'Second_Load','Second_Compile', + 'Compiled' + ); + + type + tmodulebase = class(TLinkedListItem) + { index } + unit_index : longint; { global counter for browser } + { status } + state : tmodulestate; + { sources } + sourcefiles : tinputfilemanager; + { paths and filenames } + paramallowoutput : boolean; { original allowoutput parameter } + paramfn, { original filename } + path, { path where the module is find/created } + outputpath, { path where the .s / .o / exe are created } + modulename, { name of the module in uppercase } + realmodulename, { name of the module in the orignal case } + objfilename, { fullname of the objectfile } + asmfilename, { fullname of the assemblerfile } + ppufilename, { fullname of the ppufile } + importlibfilename, { fullname of the import libraryfile } + staticlibfilename, { fullname of the static libraryfile } + sharedlibfilename, { fullname of the shared libraryfile } + mapfilename, { fullname of the mapfile } + exefilename, { fullname of the exefile } + dbgfilename, { fullname of the debug info file } + mainsource : pshortstring; { name of the main sourcefile } + constructor create(const s:string); + destructor destroy;override; + procedure setfilename(const fn:string;allowoutput:boolean); + end; + + + Function GetNamedFileTime (Const F : String) : Longint; + + +implementation + +uses + SysUtils, + GlobType,Comphook, +{$ifdef heaptrc} + fmodule, + ppheap, +{$endif heaptrc} + cfileutl, + Globals,Systems + ; + + +{**************************************************************************** + Utils + ****************************************************************************} + + Function GetNamedFileTime (Const F : String) : Longint; + begin + GetNamedFileTime:=do_getnamedfiletime(F); + end; + + +{**************************************************************************** + TINPUTFILE + ****************************************************************************} + + constructor tinputfile.create(const fn:string); + begin + name:=stringdup(ExtractFileName(fn)); + path:=stringdup(ExtractFilePath(fn)); + next:=nil; + filetime:=-1; + { file info } + is_macro:=false; + endoffile:=false; + closed:=true; + buf:=nil; + bufstart:=0; + bufsize:=0; + maxbufsize:=InputFileBufSize; + { save fields } + saveinputpointer:=nil; + saveline_no:=0; + savelastlinepos:=0; + { indexing refs } + ref_next:=nil; + ref_index:=0; + { line buffer } + linebuf:=nil; + maxlinebuf:=0; + end; + + + destructor tinputfile.destroy; + begin + if not closed then + close; + stringdispose(path); + stringdispose(name); + { free memory } + if assigned(linebuf) then + freemem(linebuf,maxlinebuf shl 2); + end; + + + procedure tinputfile.setpos(l:longint); + begin + bufstart:=l; + end; + + + procedure tinputfile.seekbuf(fpos:longint); + begin + if closed then + exit; + fileseek(fpos); + bufstart:=fpos; + bufsize:=0; + end; + + + procedure tinputfile.readbuf; + begin + if is_macro then + endoffile:=true; + if closed then + exit; + inc(bufstart,bufsize); + bufsize:=fileread(buf^,maxbufsize-1); + buf[bufsize]:=#0; + endoffile:=fileeof; + end; + + + function tinputfile.open:boolean; + begin + open:=false; + if not closed then + Close; + if not fileopen(path^+name^) then + exit; + { file } + endoffile:=false; + closed:=false; + Getmem(buf,MaxBufsize); + buf[0]:=#0; + bufstart:=0; + bufsize:=0; + open:=true; + end; + + + procedure tinputfile.close; + begin + if is_macro then + begin + if assigned(buf) then + begin + Freemem(buf,maxbufsize); + buf:=nil; + end; + closed:=true; + exit; + end; + if not closed then + begin + fileclose; + closed:=true; + end; + if assigned(buf) then + begin + Freemem(buf,maxbufsize); + buf:=nil; + end; + bufstart:=0; + end; + + + procedure tinputfile.tempclose; + begin + if is_macro then + exit; + if not closed then + begin + fileclose; + if assigned(buf) then + begin + Freemem(buf,maxbufsize); + buf:=nil; + end; + closed:=true; + end; + end; + + + function tinputfile.tempopen:boolean; + begin + tempopen:=false; + if is_macro then + begin + { seek buffer postion to bufstart } + if bufstart>0 then + begin + move(buf[bufstart],buf[0],bufsize-bufstart+1); + bufstart:=0; + end; + tempopen:=true; + exit; + end; + if not closed then + exit; + if not fileopen(path^+name^) then + exit; + closed:=false; + { get new mem } + Getmem(buf,maxbufsize); + { restore state } + fileseek(BufStart); + bufsize:=0; + readbuf; + tempopen:=true; + end; + + + procedure tinputfile.setmacro(p:pchar;len:longint); + begin + { create new buffer } + getmem(buf,len+1); + move(p^,buf^,len); + buf[len]:=#0; + { reset } + bufstart:=0; + bufsize:=len; + maxbufsize:=len+1; + is_macro:=true; + endoffile:=true; + closed:=true; + end; + + + procedure tinputfile.setline(line,linepos:longint); + var + oldlinebuf : plongintarr; + begin + if line<1 then + exit; + while (line>=maxlinebuf) do + begin + oldlinebuf:=linebuf; + { create new linebuf and move old info } + getmem(linebuf,(maxlinebuf+linebufincrease) shl 2); + if assigned(oldlinebuf) then + begin + move(oldlinebuf^,linebuf^,maxlinebuf shl 2); + freemem(oldlinebuf,maxlinebuf shl 2); + end; + fillchar(linebuf^[maxlinebuf],linebufincrease shl 2,0); + inc(maxlinebuf,linebufincrease); + end; + linebuf^[line]:=linepos; + end; + + + function tinputfile.getlinestr(l:longint):string; + var + c : char; + i, + fpos : longint; + p : pchar; + begin + getlinestr:=''; + if l<maxlinebuf then + begin + fpos:=linebuf^[l]; + { fpos is set negativ if the line was already written } + { but we still know the correct value } + if fpos<0 then + fpos:=-fpos+1; + if closed then + open; + { in current buf ? } + if (fpos<bufstart) or (fpos>bufstart+bufsize) then + begin + seekbuf(fpos); + readbuf; + end; + { the begin is in the buf now simply read until #13,#10 } + i:=0; + p:=@buf[fpos-bufstart]; + repeat + c:=p^; + if c=#0 then + begin + if endoffile then + break; + readbuf; + p:=buf; + c:=p^; + end; + if c in [#10,#13] then + break; + inc(i); + getlinestr[i]:=c; + inc(p); + until (i=255); + getlinestr[0]:=chr(i); + end; + end; + + + function tinputfile.getfiletime:longint; + begin + if filetime=-1 then + filegettime; + getfiletime:=filetime; + end; + + +{**************************************************************************** + TDOSINPUTFILE + ****************************************************************************} + + function tdosinputfile.fileopen(const filename: string): boolean; + begin + { Check if file exists, this will also check if it is + a real file and not a directory } + if not fileexists(filename,false) then + begin + result:=false; + exit; + end; + { Open file } + fileopen:=false; + try + f:=CFileStreamClass.Create(filename,fmOpenRead); + fileopen:=true; + except + end; + end; + + + function tdosinputfile.fileseek(pos: longint): boolean; + begin + fileseek:=false; + try + f.position:=Pos; + fileseek:=true; + except + end; + end; + + + function tdosinputfile.fileread(var databuf; maxsize: longint): longint; + begin + fileread:=f.Read(databuf,maxsize); + end; + + + function tdosinputfile.fileeof: boolean; + begin + fileeof:=f.eof(); + end; + + + function tdosinputfile.fileclose: boolean; + begin + fileclose:=false; + try + f.Free; + fileclose:=true; + except + end; + end; + + + procedure tdosinputfile.filegettime; + begin + filetime:=getnamedfiletime(path^+name^); + end; + + +{**************************************************************************** + Tinputfilemanager + ****************************************************************************} + + constructor tinputfilemanager.create; + begin + files:=nil; + last_ref_index:=0; + cacheindex:=0; + cacheinputfile:=nil; + end; + + + destructor tinputfilemanager.destroy; + var + hp : tinputfile; + begin + hp:=files; + while assigned(hp) do + begin + files:=files.ref_next; + hp.free; + hp:=files; + end; + last_ref_index:=0; + end; + + + procedure tinputfilemanager.register_file(f : tinputfile); + begin + { don't register macro's } + if f.is_macro then + exit; + inc(last_ref_index); + f.ref_next:=files; + f.ref_index:=last_ref_index; + files:=f; + { update cache } + cacheindex:=last_ref_index; + cacheinputfile:=f; +{$ifdef heaptrc} + ppheap_register_file(f.name^,current_module.unit_index*100000+f.ref_index); +{$endif heaptrc} + end; + + + function tinputfilemanager.get_file(l :longint) : tinputfile; + var + ff : tinputfile; + begin + { check cache } + if (l=cacheindex) and assigned(cacheinputfile) then + begin + get_file:=cacheinputfile; + exit; + end; + ff:=files; + while assigned(ff) and (ff.ref_index<>l) do + ff:=ff.ref_next; + if assigned(ff) then + begin + cacheindex:=ff.ref_index; + cacheinputfile:=ff; + end; + get_file:=ff; + end; + + + function tinputfilemanager.get_file_name(l :longint):string; + var + hp : tinputfile; + begin + hp:=get_file(l); + if assigned(hp) then + get_file_name:=hp.name^ + else + get_file_name:=''; + end; + + + function tinputfilemanager.get_file_path(l :longint):string; + var + hp : tinputfile; + begin + hp:=get_file(l); + if assigned(hp) then + get_file_path:=hp.path^ + else + get_file_path:=''; + end; + + +{**************************************************************************** + TModuleBase + ****************************************************************************} + + procedure tmodulebase.setfilename(const fn:string;allowoutput:boolean); + var + p,n, + prefix, + suffix : string; + begin + stringdispose(objfilename); + stringdispose(asmfilename); + stringdispose(ppufilename); + stringdispose(importlibfilename); + stringdispose(staticlibfilename); + stringdispose(sharedlibfilename); + stringdispose(mapfilename); + stringdispose(exefilename); + stringdispose(dbgfilename); + stringdispose(outputpath); + stringdispose(path); + stringdispose(paramfn); + { Create names } + paramfn := stringdup(fn); + paramallowoutput := allowoutput; + p := FixPath(ExtractFilePath(fn),false); + n := FixFileName(ChangeFileExt(ExtractFileName(fn),'')); + { set path } + path:=stringdup(p); + { obj,asm,ppu names } + if AllowOutput then + begin + if (OutputUnitDir<>'') then + p:=OutputUnitDir + else + if (OutputExeDir<>'') then + p:=OutputExeDir; + end; + outputpath:=stringdup(p); + asmfilename:=stringdup(p+n+target_info.asmext); + objfilename:=stringdup(p+n+target_info.objext); + ppufilename:=stringdup(p+n+target_info.unitext); + importlibfilename:=stringdup(p+target_info.importlibprefix+n+target_info.importlibext); + staticlibfilename:=stringdup(p+target_info.staticlibprefix+n+target_info.staticlibext); + + { output dir of exe can be specified separatly } + if AllowOutput and (OutputExeDir<>'') then + p:=OutputExeDir + else + p:=path^; + + { lib and exe could be loaded with a file specified with -o } + if AllowOutput and + (compile_level=1) and + (OutputFileName<>'')then + begin + exefilename:=stringdup(p+OutputFileName); + sharedlibfilename:=stringdup(p+OutputFileName); + end + else + begin + exefilename:=stringdup(p+n+target_info.exeext); + if Assigned(OutputPrefix) then + prefix := OutputPrefix^ + else + prefix := target_info.sharedlibprefix; + if Assigned(OutputSuffix) then + suffix := OutputSuffix^ + else + suffix := ''; + sharedlibfilename:=stringdup(p+prefix+n+suffix+target_info.sharedlibext); + end; + mapfilename:=stringdup(p+n+'.map'); + dbgfilename:=stringdup(p+n+'.dbg'); + end; + + + constructor tmodulebase.create(const s:string); + begin + modulename:=stringdup(Upper(s)); + realmodulename:=stringdup(s); + mainsource:=nil; + ppufilename:=nil; + objfilename:=nil; + asmfilename:=nil; + importlibfilename:=nil; + staticlibfilename:=nil; + sharedlibfilename:=nil; + exefilename:=nil; + dbgfilename:=nil; + mapfilename:=nil; + outputpath:=nil; + paramfn:=nil; + path:=nil; + { status } + state:=ms_registered; + { unit index } + inc(global_unit_count); + unit_index:=global_unit_count; + { sources } + sourcefiles:=TInputFileManager.Create; + end; + + + destructor tmodulebase.destroy; + begin + if assigned(sourcefiles) then + sourcefiles.free; + sourcefiles:=nil; + stringdispose(objfilename); + stringdispose(asmfilename); + stringdispose(ppufilename); + stringdispose(importlibfilename); + stringdispose(staticlibfilename); + stringdispose(sharedlibfilename); + stringdispose(exefilename); + stringdispose(dbgfilename); + stringdispose(mapfilename); + stringdispose(outputpath); + stringdispose(path); + stringdispose(modulename); + stringdispose(realmodulename); + stringdispose(mainsource); + stringdispose(paramfn); + inherited destroy; + end; + +end. diff --git a/closures/compiler/fmodule.pas b/closures/compiler/fmodule.pas new file mode 100644 index 0000000000..7134218995 --- /dev/null +++ b/closures/compiler/fmodule.pas @@ -0,0 +1,1017 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements the first loading and searching of the modules + + 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 fmodule; + +{$i fpcdefs.inc} + +{$ifdef go32v2} + {$define shortasmprefix} +{$endif} +{$ifdef watcom} + {$define shortasmprefix} +{$endif} +{$ifdef tos} + {$define shortasmprefix} +{$endif} +{$ifdef OS2} + { Allthough OS/2 supports long filenames I play it safe and + use 8.3 filenames, because this allows the compiler to run + on a FAT partition. (DM) } + {$define shortasmprefix} +{$endif} + +interface + + uses + cutils,cclasses,cfileutl, + globtype,finput,ogbase, + symbase,symsym, + wpobase, + aasmbase,aasmtai,aasmdata; + + + const + UNSPECIFIED_LIBRARY_NAME = '<none>'; + + type + trecompile_reason = (rr_unknown, + rr_noppu,rr_sourcenewer,rr_build,rr_crcchanged + ); + + { unit options } + tmoduleoption = (mo_none, + mo_hint_deprecated, + mo_hint_platform, + mo_hint_library, + mo_hint_unimplemented, + mo_hint_experimental, + mo_has_deprecated_msg + ); + tmoduleoptions = set of tmoduleoption; + + tlinkcontaineritem=class(tlinkedlistitem) + public + data : pshortstring; + needlink : cardinal; + constructor Create(const s:string;m:cardinal); + destructor Destroy;override; + end; + + tlinkcontainer=class(tlinkedlist) + procedure add(const s : string;m:cardinal); + function get(var m:cardinal) : string; + function getusemask(mask:cardinal) : string; + function find(const s:string):boolean; + end; + + tmodule = class; + tused_unit = class; + + tunitmaprec = record + u : tmodule; + { number of references } + refs : longint; + { index in the derefmap } + derefidx : longint; + end; + punitmap = ^tunitmaprec; + + tderefmaprec = record + u : tmodule; + { modulename, used during ppu load } + modulename : pshortstring; + end; + pderefmap = ^tderefmaprec; + + { tmodule } + + tmodule = class(tmodulebase) + private + FImportLibraryList : TFPHashObjectList; + public + do_reload, { force reloading of the unit } + do_compile, { need to compile the sources } + sources_avail, { if all sources are reachable } + interface_compiled, { if the interface section has been parsed/compiled/loaded } + is_dbginfo_written, + is_unit, + in_interface, { processing the implementation part? } + { allow global settings } + in_global : boolean; + { Whether a mode switch is still allowed at this point in the parsing.} + mode_switch_allowed, + { generate pic helper which loads eip in ecx (for leave procedures) } + requires_ecx_pic_helper, + { generate pic helper which loads eip in ebx (for non leave procedures) } + requires_ebx_pic_helper : boolean; + interface_only: boolean; { interface-only macpas unit; flag does not need saving/restoring to ppu } + mainfilepos : tfileposinfo; + recompile_reason : trecompile_reason; { the reason why the unit should be recompiled } + crc, + interface_crc, + indirect_crc : cardinal; + flags : cardinal; { the PPU flags } + islibrary : boolean; { if it is a library (win32 dll) } + IsPackage : boolean; + moduleid : longint; + unitmap : punitmap; { mapping of all used units } + unitmapsize : longint; { number of units in the map } + derefmap : pderefmap; { mapping of all units needed for deref } + derefmapcnt : longint; { number of units in the map } + derefmapsize : longint; { number of units in the map } + derefdataintflen : longint; + derefdata : tdynamicarray; + checkforwarddefs, + deflist, + symlist : TFPObjectList; + ansistrdef : tobject; { an ansistring def redefined for the current module } + wpoinfo : tunitwpoinfobase; { whole program optimization-related information that is generated during the current run for this unit } + globalsymtable, { pointer to the global symtable of this unit } + localsymtable : TSymtable;{ pointer to the local symtable of this unit } + globalmacrosymtable, { pointer to the global macro symtable of this unit } + localmacrosymtable : TSymtable;{ pointer to the local macro symtable of this unit } + scanner : TObject; { scanner object used } + procinfo : TObject; { current procedure being compiled } + asmdata : TObject; { Assembler data } + asmprefix : pshortstring; { prefix for the smartlink asmfiles } + debuginfo : TObject; + loaded_from : tmodule; + _exports : tlinkedlist; + dllscannerinputlist : TFPHashList; + resourcefiles : TCmdStrList; + linkunitofiles, + linkunitstaticlibs, + linkunitsharedlibs, + linkotherofiles, { objects,libs loaded from the source } + linkothersharedlibs, { using $L or $LINKLIB or import lib (for linux) } + linkotherstaticlibs, + linkotherframeworks : tlinkcontainer; + mainname : pshortstring; { alternate name for "main" procedure } + + used_units : tlinkedlist; + dependent_units : tlinkedlist; + + localunitsearchpath, { local searchpaths } + localobjectsearchpath, + localincludesearchpath, + locallibrarysearchpath, + localframeworksearchpath : TSearchPathList; + + moduleoptions: tmoduleoptions; + deprecatedmsg: pshortstring; + + { contains a list of types that are extended by helper types; the key is + the full name of the type and the data is a TFPObjectList of + tobjectdef instances (the helper defs) } + extendeddefs: TFPHashObjectList; + + {create creates a new module which name is stored in 's'. LoadedFrom + points to the module calling it. It is nil for the first compiled + module. This allow inheritence of all path lists. MUST pay attention + to that when creating link.res!!!!(mazen)} + constructor create(LoadedFrom:TModule;const amodulename,afilename:string;_is_unit:boolean); + destructor destroy;override; + procedure reset;virtual; + procedure adddependency(callermodule:tmodule); + procedure flagdependent(callermodule:tmodule); + function addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit; + procedure updatemaps; + procedure check_hints; + function derefidx_unit(id:longint):longint; + function resolve_unit(id:longint):tmodule; + procedure allunitsused; + procedure setmodulename(const s:string); + procedure AddExternalImport(const libname,symname,symmangledname:string;OrdNr: longint;isvar:boolean;ImportByOrdinalOnly:boolean); + property ImportLibraryList : TFPHashObjectList read FImportLibraryList; + end; + + tused_unit = class(tlinkedlistitem) + checksum, + interface_checksum, + indirect_checksum: cardinal; + in_uses, + in_interface : boolean; + u : tmodule; + unitsym : tunitsym; + constructor create(_u : tmodule;intface,inuses:boolean;usym:tunitsym); + end; + + tdependent_unit = class(tlinkedlistitem) + u : tmodule; + constructor create(_u : tmodule); + end; + + var + main_module : tmodule; { Main module of the program } + current_module : tmodule; { Current module which is compiled or loaded } + compiled_module : tmodule; { Current module which is compiled } + usedunits : tlinkedlist; { Used units for this program } + loaded_units : tlinkedlist; { All loaded units } + unloaded_units : tlinkedlist; { Units removed from loaded_units, to be freed } + SmartLinkOFiles : TCmdStrList; { List of .o files which are generated, + used to delete them after linking } + + + procedure set_current_module(p:tmodule); + function get_module(moduleindex : longint) : tmodule; + function get_source_file(moduleindex,fileindex : longint) : tinputfile; + procedure addloadedunit(hp:tmodule); + function find_module_from_symtable(st:tsymtable):tmodule; + + +implementation + + uses + SysUtils,globals, + verbose,systems, + scanner,ppu,dbgbase, + procinfo,symdef; + +{$ifdef MEMDEBUG} + var + memsymtable : TMemDebug; +{$endif} + +{***************************************************************************** + Global Functions +*****************************************************************************} + + function find_module_from_symtable(st:tsymtable):tmodule; + var + hp : tmodule; + begin + result:=nil; + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + if (hp.moduleid=st.moduleid) then + begin + result:=hp; + exit; + end; + hp:=tmodule(hp.next); + end; + end; + + procedure set_current_module(p:tmodule); + begin + { save the state of the scanner } + if assigned(current_scanner) then + current_scanner.tempcloseinputfile; + { set new module } + current_module:=p; + { restore previous module settings } + Fillchar(current_filepos,0,sizeof(current_filepos)); + if assigned(current_module) then + begin + current_asmdata:=tasmdata(current_module.asmdata); + current_debuginfo:=tdebuginfo(current_module.debuginfo); + { restore scanner and file positions } + current_scanner:=tscannerfile(current_module.scanner); + if assigned(current_scanner) then + begin + current_scanner.tempopeninputfile; + current_scanner.gettokenpos; + parser_current_file:=current_scanner.inputfile.name^; + end + else + begin + current_filepos.moduleindex:=current_module.unit_index; + parser_current_file:=''; + end; + end + else + begin + current_asmdata:=nil; + current_scanner:=nil; + current_debuginfo:=nil; + end; + end; + + + function get_module(moduleindex : longint) : tmodule; + var + hp : tmodule; + begin + result:=nil; + if moduleindex=0 then + exit; + result:=current_module; + if not(assigned(loaded_units)) then + exit; + hp:=tmodule(loaded_units.first); + while assigned(hp) and (hp.unit_index<>moduleindex) do + hp:=tmodule(hp.next); + result:=hp; + end; + + + function get_source_file(moduleindex,fileindex : longint) : tinputfile; + var + hp : tmodule; + begin + hp:=get_module(moduleindex); + if assigned(hp) then + get_source_file:=hp.sourcefiles.get_file(fileindex) + else + get_source_file:=nil; + end; + + + procedure addloadedunit(hp:tmodule); + begin + hp.moduleid:=loaded_units.count; + loaded_units.concat(hp); + end; + + +{**************************************************************************** + TLinkContainerItem + ****************************************************************************} + + constructor TLinkContainerItem.Create(const s:string;m:cardinal); + begin + inherited Create; + data:=stringdup(s); + needlink:=m; + end; + + + destructor TLinkContainerItem.Destroy; + begin + stringdispose(data); + end; + + +{**************************************************************************** + TLinkContainer + ****************************************************************************} + + procedure TLinkContainer.add(const s : string;m:cardinal); + begin + inherited concat(TLinkContainerItem.Create(s,m)); + end; + + + function TLinkContainer.get(var m:cardinal) : string; + var + p : tlinkcontaineritem; + begin + p:=tlinkcontaineritem(inherited getfirst); + if p=nil then + begin + get:=''; + m:=0; + end + else + begin + get:=p.data^; + m:=p.needlink; + p.free; + end; + end; + + + function TLinkContainer.getusemask(mask:cardinal) : string; + var + p : tlinkcontaineritem; + found : boolean; + begin + found:=false; + repeat + p:=tlinkcontaineritem(inherited getfirst); + if p=nil then + begin + getusemask:=''; + exit; + end; + getusemask:=p.data^; + found:=(p.needlink and mask)<>0; + p.free; + until found; + end; + + + function TLinkContainer.find(const s:string):boolean; + var + newnode : tlinkcontaineritem; + begin + find:=false; + newnode:=tlinkcontaineritem(First); + while assigned(newnode) do + begin + if newnode.data^=s then + begin + find:=true; + exit; + end; + newnode:=tlinkcontaineritem(newnode.next); + end; + end; + + +{**************************************************************************** + TUSED_UNIT + ****************************************************************************} + + constructor tused_unit.create(_u : tmodule;intface,inuses:boolean;usym:tunitsym); + begin + u:=_u; + in_interface:=intface; + in_uses:=inuses; + unitsym:=usym; + if _u.state=ms_compiled then + begin + checksum:=u.crc; + interface_checksum:=u.interface_crc; + indirect_checksum:=u.indirect_crc; + end + else + begin + checksum:=0; + interface_checksum:=0; + indirect_checksum:=0; + end; + end; + + +{**************************************************************************** + TDENPENDENT_UNIT + ****************************************************************************} + + constructor tdependent_unit.create(_u : tmodule); + begin + u:=_u; + end; + + +{**************************************************************************** + TMODULE + ****************************************************************************} + + constructor tmodule.create(LoadedFrom:TModule;const amodulename,afilename:string;_is_unit:boolean); + var + n,fn:string; + begin + if amodulename='' then + n:=ChangeFileExt(ExtractFileName(afilename),'') + else + n:=amodulename; + if afilename='' then + fn:=amodulename + else + fn:=afilename; + { Programs have the name 'Program' to don't conflict with dup id's } + if _is_unit then + inherited create(amodulename) + else + inherited create('Program'); + mainsource:=stringdup(fn); + { Dos has the famous 8.3 limit :( } +{$ifdef shortasmprefix} + asmprefix:=stringdup(FixFileName('as')); +{$else} + asmprefix:=stringdup(FixFileName(n)); +{$endif} + setfilename(fn,true); + localunitsearchpath:=TSearchPathList.Create; + localobjectsearchpath:=TSearchPathList.Create; + localincludesearchpath:=TSearchPathList.Create; + locallibrarysearchpath:=TSearchPathList.Create; + localframeworksearchpath:=TSearchPathList.Create; + used_units:=TLinkedList.Create; + dependent_units:=TLinkedList.Create; + resourcefiles:=TCmdStrList.Create; + linkunitofiles:=TLinkContainer.Create; + linkunitstaticlibs:=TLinkContainer.Create; + linkunitsharedlibs:=TLinkContainer.Create; + linkotherofiles:=TLinkContainer.Create; + linkotherstaticlibs:=TLinkContainer.Create; + linkothersharedlibs:=TLinkContainer.Create; + linkotherframeworks:=TLinkContainer.Create; + mainname:=nil; + FImportLibraryList:=TFPHashObjectList.Create(true); + crc:=0; + interface_crc:=0; + indirect_crc:=0; + flags:=0; + scanner:=nil; + unitmap:=nil; + unitmapsize:=0; + derefmap:=nil; + derefmapsize:=0; + derefmapcnt:=0; + derefdata:=TDynamicArray.Create(1024); + derefdataintflen:=0; + deflist:=TFPObjectList.Create(false); + symlist:=TFPObjectList.Create(false); + ansistrdef:=nil; + wpoinfo:=nil; + checkforwarddefs:=TFPObjectList.Create(false); + extendeddefs := TFPHashObjectList.Create(true); + globalsymtable:=nil; + localsymtable:=nil; + globalmacrosymtable:=nil; + localmacrosymtable:=nil; + loaded_from:=LoadedFrom; + do_reload:=false; + do_compile:=false; + sources_avail:=true; + mainfilepos.line:=0; + mainfilepos.column:=0; + mainfilepos.fileindex:=0; + recompile_reason:=rr_unknown; + in_interface:=true; + in_global:=true; + is_unit:=_is_unit; + islibrary:=false; + ispackage:=false; + is_dbginfo_written:=false; + mode_switch_allowed:= true; + moduleoptions:=[]; + deprecatedmsg:=nil; + _exports:=TLinkedList.Create; + dllscannerinputlist:=TFPHashList.Create; + asmdata:=TAsmData.create(realmodulename^); + InitDebugInfo(self); + end; + + + destructor tmodule.Destroy; + var + i : longint; + begin + if assigned(unitmap) then + freemem(unitmap); + if assigned(derefmap) then + begin + for i:=0 to derefmapcnt-1 do + stringdispose(derefmap[i].modulename); + freemem(derefmap); + end; + if assigned(_exports) then + _exports.free; + if assigned(dllscannerinputlist) then + dllscannerinputlist.free; + if assigned(scanner) then + begin + { also update current_scanner if it was pointing + to this module } + if current_scanner=tscannerfile(scanner) then + current_scanner:=nil; + tscannerfile(scanner).free; + end; + if assigned(asmdata) then + begin + if current_asmdata=asmdata then + current_asmdata:=nil; + asmdata.free; + end; + if assigned(procinfo) then + begin + if current_procinfo=tprocinfo(procinfo) then + begin + current_procinfo:=nil; + current_structdef:=nil; + current_genericdef:=nil; + current_specializedef:=nil; + end; + { release procinfo tree } + tprocinfo(procinfo).destroy_tree; + end; + DoneDebugInfo(self); + used_units.free; + dependent_units.free; + resourcefiles.Free; + linkunitofiles.Free; + linkunitstaticlibs.Free; + linkunitsharedlibs.Free; + linkotherofiles.Free; + linkotherstaticlibs.Free; + linkothersharedlibs.Free; + linkotherframeworks.Free; + stringdispose(mainname); + FImportLibraryList.Free; + extendeddefs.Free; + stringdispose(objfilename); + stringdispose(asmfilename); + stringdispose(ppufilename); + stringdispose(importlibfilename); + stringdispose(staticlibfilename); + stringdispose(sharedlibfilename); + stringdispose(exefilename); + stringdispose(outputpath); + stringdispose(path); + stringdispose(realmodulename); + stringdispose(mainsource); + stringdispose(asmprefix); + stringdispose(deprecatedmsg); + localunitsearchpath.Free; + localobjectsearchpath.free; + localincludesearchpath.free; + locallibrarysearchpath.free; + localframeworksearchpath.free; +{$ifdef MEMDEBUG} + memsymtable.start; +{$endif} + derefdata.free; + deflist.free; + symlist.free; + ansistrdef:=nil; + wpoinfo.free; + checkforwarddefs.free; + globalsymtable.free; + localsymtable.free; + globalmacrosymtable.free; + localmacrosymtable.free; +{$ifdef MEMDEBUG} + memsymtable.stop; +{$endif} + stringdispose(modulename); + inherited Destroy; + end; + + + procedure tmodule.reset; + var + i : longint; + begin + if assigned(scanner) then + begin + { also update current_scanner if it was pointing + to this module } + if current_scanner=tscannerfile(scanner) then + current_scanner:=nil; + tscannerfile(scanner).free; + scanner:=nil; + end; + if assigned(procinfo) then + begin + if current_procinfo=tprocinfo(procinfo) then + begin + current_procinfo:=nil; + current_structdef:=nil; + current_genericdef:=nil; + current_specializedef:=nil; + end; + { release procinfo tree } + tprocinfo(procinfo).destroy_tree; + end; + if assigned(asmdata) then + begin + if current_asmdata=TAsmData(asmdata) then + current_asmdata:=nil; + asmdata.free; + asmdata:=nil; + end; + DoneDebugInfo(self); + globalsymtable.free; + globalsymtable:=nil; + localsymtable.free; + localsymtable:=nil; + globalmacrosymtable.free; + globalmacrosymtable:=nil; + localmacrosymtable.free; + localmacrosymtable:=nil; + deflist.free; + deflist:=TFPObjectList.Create(false); + symlist.free; + symlist:=TFPObjectList.Create(false); + wpoinfo.free; + wpoinfo:=nil; + checkforwarddefs.free; + checkforwarddefs:=TFPObjectList.Create(false); + derefdata.free; + derefdata:=TDynamicArray.Create(1024); + if assigned(unitmap) then + begin + freemem(unitmap); + unitmap:=nil; + end; + if assigned(derefmap) then + begin + for i:=0 to derefmapcnt-1 do + stringdispose(derefmap[i].modulename); + freemem(derefmap); + derefmap:=nil; + end; + unitmapsize:=0; + derefmapsize:=0; + derefmapcnt:=0; + derefdataintflen:=0; + sourcefiles.free; + sourcefiles:=tinputfilemanager.create; + asmdata:=TAsmData.create(realmodulename^); + InitDebugInfo(self); + _exports.free; + _exports:=tlinkedlist.create; + dllscannerinputlist.free; + dllscannerinputlist:=TFPHashList.create; + used_units.free; + used_units:=TLinkedList.Create; + dependent_units.free; + dependent_units:=TLinkedList.Create; + resourcefiles.Free; + resourcefiles:=TCmdStrList.Create; + linkunitofiles.Free; + linkunitofiles:=TLinkContainer.Create; + linkunitstaticlibs.Free; + linkunitstaticlibs:=TLinkContainer.Create; + linkunitsharedlibs.Free; + linkunitsharedlibs:=TLinkContainer.Create; + linkotherofiles.Free; + linkotherofiles:=TLinkContainer.Create; + linkotherstaticlibs.Free; + linkotherstaticlibs:=TLinkContainer.Create; + linkothersharedlibs.Free; + linkothersharedlibs:=TLinkContainer.Create; + linkotherframeworks.Free; + linkotherframeworks:=TLinkContainer.Create; + stringdispose(mainname); + FImportLibraryList.Free; + FImportLibraryList:=TFPHashObjectList.Create; + do_compile:=false; + do_reload:=false; + interface_compiled:=false; + in_interface:=true; + in_global:=true; + mode_switch_allowed:=true; + stringdispose(deprecatedmsg); + moduleoptions:=[]; + is_dbginfo_written:=false; + crc:=0; + interface_crc:=0; + indirect_crc:=0; + flags:=0; + mainfilepos.line:=0; + mainfilepos.column:=0; + mainfilepos.fileindex:=0; + recompile_reason:=rr_unknown; + { + The following fields should not + be reset: + mainsource + state + loaded_from + sources_avail + } + end; + + + procedure tmodule.adddependency(callermodule:tmodule); + begin + { This is not needed for programs } + if not callermodule.is_unit then + exit; + Message2(unit_u_add_depend_to,callermodule.modulename^,modulename^); + dependent_units.concat(tdependent_unit.create(callermodule)); + end; + + + procedure tmodule.flagdependent(callermodule:tmodule); + var + pm : tdependent_unit; + begin + { flag all units that depend on this unit for reloading } + pm:=tdependent_unit(current_module.dependent_units.first); + while assigned(pm) do + begin + { We do not have to reload the unit that wants to load + this unit, unless this unit is already compiled during + the loading } + if (pm.u=callermodule) and + (pm.u.state<>ms_compiled) then + Message1(unit_u_no_reload_is_caller,pm.u.modulename^) + else + if pm.u.state=ms_second_compile then + Message1(unit_u_no_reload_in_second_compile,pm.u.modulename^) + else + begin + pm.u.do_reload:=true; + Message1(unit_u_flag_for_reload,pm.u.modulename^); + end; + pm:=tdependent_unit(pm.next); + end; + end; + + + function tmodule.addusedunit(hp:tmodule;inuses:boolean;usym:tunitsym):tused_unit; + var + pu : tused_unit; + begin + pu:=tused_unit.create(hp,in_interface,inuses,usym); + used_units.concat(pu); + addusedunit:=pu; + end; + + + procedure tmodule.updatemaps; + var + oldmapsize : longint; + hp : tmodule; + i : longint; + begin + { Extend unitmap } + oldmapsize:=unitmapsize; + unitmapsize:=loaded_units.count; + reallocmem(unitmap,unitmapsize*sizeof(tunitmaprec)); + fillchar(unitmap[oldmapsize],(unitmapsize-oldmapsize)*sizeof(tunitmaprec),0); + + { Extend Derefmap } + oldmapsize:=derefmapsize; + derefmapsize:=loaded_units.count; + reallocmem(derefmap,derefmapsize*sizeof(tderefmaprec)); + fillchar(derefmap[oldmapsize],(derefmapsize-oldmapsize)*sizeof(tderefmaprec),0); + + { Add all units to unitmap } + hp:=tmodule(loaded_units.first); + i:=0; + while assigned(hp) do + begin + if hp.moduleid>=unitmapsize then + internalerror(200501151); + { Verify old entries } + if (i<oldmapsize) then + begin + if (hp.moduleid<>i) or + (unitmap[hp.moduleid].u<>hp) then + internalerror(200501156); + end + else + begin + unitmap[hp.moduleid].u:=hp; + unitmap[hp.moduleid].derefidx:=-1; + end; + inc(i); + hp:=tmodule(hp.next); + end; + end; + + procedure tmodule.check_hints; + begin + if mo_hint_deprecated in moduleoptions then + if (mo_has_deprecated_msg in moduleoptions) and (deprecatedmsg <> nil) then + Message2(sym_w_deprecated_unit_with_msg,realmodulename^,deprecatedmsg^) + else + Message1(sym_w_deprecated_unit,realmodulename^); + if mo_hint_experimental in moduleoptions then + Message1(sym_w_experimental_unit,realmodulename^); + if mo_hint_platform in moduleoptions then + Message1(sym_w_non_portable_unit,realmodulename^); + if mo_hint_library in moduleoptions then + Message1(sym_w_library_unit,realmodulename^); + if mo_hint_unimplemented in moduleoptions then + Message1(sym_w_non_implemented_unit,realmodulename^); + end; + + + function tmodule.derefidx_unit(id:longint):longint; + begin + if id>=unitmapsize then + internalerror(2005011511); + if unitmap[id].derefidx=-1 then + begin + unitmap[id].derefidx:=derefmapcnt; + inc(derefmapcnt); + derefmap[unitmap[id].derefidx].u:=unitmap[id].u; + end; + if unitmap[id].derefidx>=derefmapsize then + internalerror(2005011514); + result:=unitmap[id].derefidx; + end; + + + function tmodule.resolve_unit(id:longint):tmodule; + var + hp : tmodule; + begin + if id>=derefmapsize then + internalerror(200306231); + result:=derefmap[id].u; + if not assigned(result) then + begin + if not assigned(derefmap[id].modulename) or + (derefmap[id].modulename^='') then + internalerror(200501159); + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + { only check for units. The main program is also + as a unit in the loaded_units list. We simply need + to ignore this entry (PFV) } + if hp.is_unit and + (hp.modulename^=derefmap[id].modulename^) then + break; + hp:=tmodule(hp.next); + end; + if not assigned(hp) then + internalerror(2005011510); + derefmap[id].u:=hp; + result:=hp; + end; + end; + + + procedure tmodule.allunitsused; + var + pu : tused_unit; + begin + pu:=tused_unit(used_units.first); + while assigned(pu) do + begin + if assigned(pu.u.globalsymtable) then + begin + if unitmap[pu.u.moduleid].u<>pu.u then + internalerror(200501157); + { Give a note when the unit is not referenced, skip + this is for units with an initialization/finalization } + if (unitmap[pu.u.moduleid].refs=0) and + ((pu.u.flags and (uf_init or uf_finalize))=0) then + CGMessagePos2(pu.unitsym.fileinfo,sym_n_unit_not_used,pu.u.realmodulename^,realmodulename^); + end; + pu:=tused_unit(pu.next); + end; + end; + + + procedure tmodule.setmodulename(const s:string); + begin + stringdispose(modulename); + stringdispose(realmodulename); + modulename:=stringdup(upper(s)); + realmodulename:=stringdup(s); + { also update asmlibrary names } + current_asmdata.name:=modulename^; + current_asmdata.realname:=realmodulename^; + end; + + + procedure TModule.AddExternalImport(const libname,symname,symmangledname:string; + OrdNr: longint;isvar:boolean;ImportByOrdinalOnly:boolean); + var + ImportLibrary,OtherIL : TImportLibrary; + ImportSymbol : TImportSymbol; + i : longint; + begin + ImportLibrary:=TImportLibrary(ImportLibraryList.Find(libname)); + if not assigned(ImportLibrary) then + ImportLibrary:=TImportLibrary.Create(ImportLibraryList,libname); + ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList.Find(symname)); + if not assigned(ImportSymbol) then + begin + { Check that the same name does not exist in another library } + { If it does and the same mangled name is used, issue a warning } + if ImportLibraryList.Count>1 then + for i:=0 To ImportLibraryList.Count-1 do + begin + OtherIL:=TImportLibrary(ImportLibraryList.Items[i]); + ImportSymbol:=TImportSymbol(OtherIL.ImportSymbolList.Find(symname)); + if assigned(ImportSymbol) then + begin + if ImportSymbol.MangledName=symmangledname then + begin + CGMessage3(sym_w_library_overload,symname,libname,OtherIL.Name); + break; + end; + end; + end; + if not ImportByOrdinalOnly then + { negative ordinal number indicates import by name with ordinal number as hint } + OrdNr:=-OrdNr; + ImportSymbol:=TImportSymbol.Create(ImportLibrary.ImportSymbolList, + symname,symmangledname,OrdNr,isvar); + end; + end; + + +initialization +{$ifdef MEMDEBUG} + memsymtable:=TMemDebug.create('Symtables'); + memsymtable.stop; +{$endif MEMDEBUG} + +finalization +{$ifdef MEMDEBUG} + memsymtable.free; +{$endif MEMDEBUG} + +end. diff --git a/closures/compiler/fpccrc.pas b/closures/compiler/fpccrc.pas new file mode 100644 index 0000000000..a617b65dba --- /dev/null +++ b/closures/compiler/fpccrc.pas @@ -0,0 +1,76 @@ +{ + 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 fpccrc; + +{$i fpcdefs.inc} + +Interface + +Function UpdateCrc32(InitCrc:cardinal;const InBuf;InLen:integer):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 UpdateCrc32(InitCrc:cardinal;const InBuf;InLen:Integer):cardinal; +var + i : integer; + p : pchar; +begin + if Crc32Tbl[1]=0 then + MakeCrc32Tbl; + p:=@InBuf; + result:=not InitCrc; + for i:=1 to InLen do + begin + result:=Crc32Tbl[byte(result) xor byte(p^)] xor (result shr 8); + inc(p); + end; + result:=not result; +end; + + +end. diff --git a/closures/compiler/fpcdefs.inc b/closures/compiler/fpcdefs.inc new file mode 100644 index 0000000000..fc41470b8c --- /dev/null +++ b/closures/compiler/fpcdefs.inc @@ -0,0 +1,179 @@ +{$mode objfpc} +{$asmmode default} +{$H-} +{$goto on} +{$inline on} +{$interfaces corba} + +{ This reduces the memory requirements a lot } +{$PACKENUM 1} +{$ifdef FPC_HAS_VARSETS} +{$ifndef FPC_BIG_ENDIAN} +{ $define USE_PACKSET1} +{$endif} +{$endif FPC_HAS_VARSETS} + +{$ifdef USE_PACKSET1} +{$PACKSET 1} +{$endif USE_PACKSET1} + +{ We don't use exceptions, so turn off the implicit + exceptions in the constructors } +{$IMPLICITEXCEPTIONS OFF} + +{ Inline small functions, but not when EXTDEBUG is used } +{$ifndef EXTDEBUG} + {$define USEINLINE} +{$endif EXTDEBUG} + +{$define USEEXCEPT} + +{ If anyone wants to use interrupt for + a specific target, add a + $define FPC_HAS_SYSTEMS_INTERRUPT_TABLE + to fpcdefs.inc to reactivate + the corresponding code } +{$undef FPC_HAS_SYSTEMS_INTERRUPT_TABLE} + +{ This fake CPU is used to allow incorporation of globtype unit + into utils/ppudump without any CPU specific code PM } +{$ifdef generic_cpu} + {$define cpu32bit} + {$define cpu32bitaddr} + {$define cpu32bitalu} + {$define cpuflags} + {$define cpuextended} +{$endif generic_cpu} + +{$ifdef cpuarm} + {$packrecords c} +{$endif cpuarm} + +{$ifdef i386} + {$define cpu32bit} + {$define cpu32bitaddr} + {$define cpu32bitalu} + {$define x86} + {$define cpuflags} + {$define cpuextended} + {$define SUPPORT_MMX} + {$define cpumm} + {$define fewintregisters} + {$define cpurox} +{$endif i386} + +{$ifdef x86_64} + {$define x86} + {$define cpuflags} + {$define cpu64bitalu} + {$define cpu64bitaddr} + {$define cpuextended} + {$define cpufloat128} + {$define cputargethasfixedstack} + {$define cpumm} + {$define cpurox} +{$endif x86_64} + +{$ifdef ia64} + {$define cpuflags} + {$define cpu64bitalu} + {$define cpu64bitaddr} + {$define cpuextended} + {$define cpufloat128} +{$endif ia64} + +{$ifdef alpha} + {$define cpu64bitalu} + {$define cpu64bitaddr} +{$endif alpha} + +{$ifdef sparc} + {$define cpu32bit} + {$define cpu32bitaddr} + {$define cpu32bitalu} + {$define cpuflags} + {$define cputargethasfixedstack} +{$endif sparc} + +{$ifdef powerpc} + {$define cpu32bit} + {$define cpu32bitaddr} + {$define cpu32bitalu} + {$define cpuflags} + {$define cputargethasfixedstack} + {$define cpumm} + {$define cpurox} +{$endif powerpc} + +{$ifdef powerpc64} + {$define cpu64bitalu} + {$define cpu64bitaddr} + {$define cpuflags} + {$define cputargethasfixedstack} + {$define cpumm} + {$define cpurox} +{$endif powerpc64} + +{$ifdef arm} + {$define cpu32bit} + {$define cpu32bitaddr} + {$define cpu32bitalu} + {$define cpuflags} + {$define cpufpemu} + {$define cpuneedsdiv32helper} + {$define cpurox} + {$define cputargethasfixedstack} + { default to armel } + {$if not(defined(CPUARM)) and not(defined(CPUARMEB)) and not(defined(FPC_OARM)) and not(defined(FPC_ARMEB))} + {$define FPC_ARMEL} + {$endif} + { inherit FPC_ARMEL? } + {$if defined(CPUARMEL) and not(defined(FPC_OARM)) and not(defined(FPC_ARMEB))} + {$define FPC_ARMEL} + {$endif} + { inherit FPC_ARMEB? } + {$if defined(CPUARMEB) and not(defined(FPC_OARM)) and not(defined(FPC_ARMEL))} + {$define FPC_ARMEB} + {$endif} +{$endif arm} + +{$ifdef m68k} + {$define cpu32bit} + {$define cpu32bitaddr} + {$define cpu32bitalu} + {$define cpuflags} + {$define cpufpemu} +{$endif m68k} + +{$ifdef avr} + {$define cpu8bit} + {$define cpu16bitaddr} + {$define cpu8bitalu} + {$define cpuflags} + {$define cpunofpu} + {$define cpunodefaultint} + {$define cpuneedsdiv32helper} + {$define cpuneedsmulhelper} +{$endif avr} + +{$ifdef mipsel} + {$define mips} +{$endif mipsel} + +{$ifdef mips} + {$define cpu32bit} + {$define cpu32bitalu} + {$define cpu32bitaddr} + { $define cpuflags} + {$define cputargethasfixedstack} + {$define cpurequiresproperalignment} + {$define cpumm} +{$endif mips} + +{$IFDEF MACOS} +{$DEFINE USE_FAKE_SYSUTILS} +{$ENDIF MACOS} + +{$if not defined(FPC_HAS_TYPE_EXTENDED) and defined(i386)} +{$error Cross-compiling from systems without support for an 80 bit extended floating point type to i386 is not yet supported at this time } +{$endif} diff --git a/closures/compiler/fppu.pas b/closures/compiler/fppu.pas new file mode 100644 index 0000000000..d75bca19c9 --- /dev/null +++ b/closures/compiler/fppu.pas @@ -0,0 +1,1732 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements the first loading and searching of the modules + + 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 fppu; + +{$i fpcdefs.inc} + +{ close ppufiles on system that are + short on file handles like DOS system PM } +{$ifdef GO32V2} + {$define SHORT_ON_FILE_HANDLES} +{$endif GO32V2} +{$ifdef WATCOM} + {$define SHORT_ON_FILE_HANDLES} +{$endif WATCOM} + +interface + + uses + cmsgs,verbose, + cutils,cclasses, + globtype,globals,finput,fmodule, + symbase,ppu,symtype; + + type + + { tppumodule } + + tppumodule = class(tmodule) + ppufile : tcompilerppufile; { the PPU file } + sourcefn : pshortstring; { Source specified with "uses .. in '..'" } + comments : TCmdStrList; +{$ifdef Test_Double_checksum} + crc_array : pointer; + crc_size : longint; + crc_array2 : pointer; + crc_size2 : longint; +{$endif def Test_Double_checksum} + constructor create(LoadedFrom:TModule;const amodulename,afilename:string;_is_unit:boolean); + destructor destroy;override; + procedure reset;override; + function openppu:boolean; + procedure getppucrc; + procedure writeppu; + procedure loadppu; + function needrecompile:boolean; + procedure setdefgeneration; + procedure reload_flagged_units; + private + { Each time a unit's defs are (re)created, its defsgeneration is + set to the value of a global counter, and the global counter is + increased. We only reresolve its dependent units' defs in case + they have been resolved only for an older generation, in order to + avoid endless resolving loops in case of cyclic dependencies. } + defsgeneration : longint; + + function search_unit_files(onlysource:boolean):boolean; + function search_unit(onlysource,shortname:boolean):boolean; + procedure load_interface; + procedure load_implementation; + procedure load_usedunits; + procedure printcomments; + procedure queuecomment(const s:TMsgStr;v,w:longint); + procedure writesourcefiles; + procedure writeusedunit(intf:boolean); + procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean); + procedure writederefmap; + procedure writederefdata; + procedure writeImportSymbols; + procedure writeResources; + procedure readsourcefiles; + procedure readloadunit; + procedure readlinkcontainer(var p:tlinkcontainer); + procedure readderefmap; + procedure readderefdata; + procedure readImportSymbols; + procedure readResources; + procedure readwpofile; +{$IFDEF MACRO_DIFF_HINT} + procedure writeusedmacro(p:TNamedIndexItem;arg:pointer); + procedure writeusedmacros; + procedure readusedmacros; +{$ENDIF} + end; + + function registerunit(callermodule:tmodule;const s : TIDString;const fn:string) : tppumodule; + + +implementation + +uses + SysUtils, + cfileutl, + systems,version, + symtable, symsym, + wpoinfo, + scanner, + aasmbase,ogbase, + parser, + comphook; + + +var + currentdefgeneration: longint; + +{**************************************************************************** + TPPUMODULE + ****************************************************************************} + + constructor tppumodule.create(LoadedFrom:TModule;const amodulename,afilename:string;_is_unit:boolean); + begin + inherited create(LoadedFrom,amodulename,afilename,_is_unit); + ppufile:=nil; + sourcefn:=stringdup(afilename); + end; + + + destructor tppumodule.Destroy; + begin + if assigned(ppufile) then + ppufile.free; + ppufile:=nil; + comments.free; + comments:=nil; + stringdispose(sourcefn); + inherited Destroy; + end; + + + procedure tppumodule.reset; + begin + inc(currentdefgeneration); + if assigned(ppufile) then + begin + ppufile.free; + ppufile:=nil; + end; + inherited reset; + end; + + procedure tppumodule.queuecomment(const s:TMsgStr;v,w:longint); + begin + if comments = nil then + comments := TCmdStrList.create; + comments.insert(s); + end; + + procedure tppumodule.printcomments; + var + comment: string; + begin + if comments = nil then + exit; + { comments are inserted in reverse order } + repeat + comment := comments.getlast; + if length(comment) = 0 then + exit; + do_comment(v_normal, comment); + until false; + end; + + function tppumodule.openppu:boolean; + var + ppufiletime : longint; + begin + openppu:=false; + Message1(unit_t_ppu_loading,ppufilename^,@queuecomment); + { Get ppufile time (also check if the file exists) } + ppufiletime:=getnamedfiletime(ppufilename^); + if ppufiletime=-1 then + exit; + { Open the ppufile } + Message1(unit_u_ppu_name,ppufilename^); + ppufile:=tcompilerppufile.create(ppufilename^); + if not ppufile.openfile then + begin + ppufile.free; + ppufile:=nil; + Message(unit_u_ppu_file_too_short); + exit; + end; + { check for a valid PPU file } + if not ppufile.CheckPPUId then + begin + ppufile.free; + ppufile:=nil; + Message(unit_u_ppu_invalid_header); + exit; + end; + { check for allowed PPU versions } + if not (ppufile.GetPPUVersion = CurrentPPUVersion) then + begin + Message1(unit_u_ppu_invalid_version,tostr(ppufile.GetPPUVersion),@queuecomment); + ppufile.free; + ppufile:=nil; + exit; + end; + { check the target processor } + if tsystemcpu(ppufile.header.cpu)<>target_cpu then + begin + ppufile.free; + ppufile:=nil; + Message(unit_u_ppu_invalid_processor,@queuecomment); + exit; + end; + { check target } + if tsystem(ppufile.header.target)<>target_info.system then + begin + ppufile.free; + ppufile:=nil; + Message(unit_u_ppu_invalid_target,@queuecomment); + exit; + end; +{$ifdef cpufpemu} + { check if floating point emulation is on? + fpu emulation isn't unit levelwise because it affects calling convention } + if ((ppufile.header.flags and uf_fpu_emulation)<>0) xor + (cs_fp_emulation in current_settings.moduleswitches) then + begin + ppufile.free; + ppufile:=nil; + Message(unit_u_ppu_invalid_fpumode,@queuecomment); + exit; + end; +{$endif cpufpemu} + + { Load values to be access easier } + flags:=ppufile.header.flags; + crc:=ppufile.header.checksum; + interface_crc:=ppufile.header.interface_checksum; + indirect_crc:=ppufile.header.indirect_checksum; + { Show Debug info } + Message1(unit_u_ppu_time,filetimestring(ppufiletime)); + Message1(unit_u_ppu_flags,tostr(flags)); + Message1(unit_u_ppu_crc,hexstr(ppufile.header.checksum,8)); + Message1(unit_u_ppu_crc,hexstr(ppufile.header.interface_checksum,8)+' (intfc)'); + Message1(unit_u_ppu_crc,hexstr(ppufile.header.indirect_checksum,8)+' (indc)'); + Comment(V_used,'Number of definitions: '+tostr(ppufile.header.deflistsize)); + Comment(V_used,'Number of symbols: '+tostr(ppufile.header.symlistsize)); + do_compile:=false; + openppu:=true; + end; + + + function tppumodule.search_unit_files(onlysource:boolean):boolean; + var + found : boolean; + begin + found:=false; + if search_unit(onlysource,false) then + found:=true; + if (not found) and + (length(modulename^)>8) and + search_unit(onlysource,true) then + found:=true; + search_unit_files:=found; + end; + + + function tppumodule.search_unit(onlysource,shortname:boolean):boolean; + var + singlepathstring, + filename : TCmdStr; + + Function UnitExists(const ext:string;var foundfile:TCmdStr):boolean; + begin + if CheckVerbosity(V_Tried) then + Message1(unit_t_unitsearch,Singlepathstring+filename+ext); + UnitExists:=FindFile(FileName+ext,Singlepathstring,true,foundfile); + end; + + Function PPUSearchPath(const s:TCmdStr):boolean; + var + found : boolean; + hs : TCmdStr; + begin + Found:=false; + singlepathstring:=FixPath(s,false); + { Check for PPU file } + Found:=UnitExists(target_info.unitext,hs); + if Found then + Begin + SetFileName(hs,false); + Found:=OpenPPU; + End; + PPUSearchPath:=Found; + end; + + Function SourceSearchPath(const s:TCmdStr):boolean; + var + found : boolean; + hs : TCmdStr; + begin + Found:=false; + singlepathstring:=FixPath(s,false); + { Check for Sources } + ppufile:=nil; + do_compile:=true; + recompile_reason:=rr_noppu; + {Check for .pp file} + Found:=UnitExists(sourceext,hs); + if not Found then + begin + { Check for .pas } + Found:=UnitExists(pasext,hs); + end; + if not Found and + ((m_mac in current_settings.modeswitches) or + (tf_p_ext_support in target_info.flags)) then + begin + { Check for .p, if mode is macpas} + Found:=UnitExists(pext,hs); + end; + stringdispose(mainsource); + if Found then + begin + sources_avail:=true; + { Load Filenames when found } + mainsource:=StringDup(hs); + SetFileName(hs,false); + end + else + sources_avail:=false; + SourceSearchPath:=Found; + end; + + Function SearchPath(const s:TCmdStr):boolean; + var + found : boolean; + begin + { First check for a ppu, then for the source } + found:=false; + if not onlysource then + found:=PPUSearchPath(s); + if not found then + found:=SourceSearchPath(s); + SearchPath:=found; + end; + + Function SearchPathList(list:TSearchPathList):boolean; + var + hp : TCmdStrListItem; + found : boolean; + begin + found:=false; + hp:=TCmdStrListItem(list.First); + while assigned(hp) do + begin + found:=SearchPath(hp.Str); + if found then + break; + hp:=TCmdStrListItem(hp.next); + end; + SearchPathList:=found; + end; + + var + fnd : boolean; + hs : TCmdStr; + begin + if shortname then + filename:=FixFileName(Copy(realmodulename^,1,8)) + else + filename:=FixFileName(realmodulename^); + { try to find unit + 1. look for ppu in cwd + 2. look for ppu in outputpath if set, this is tp7 compatible (PFV) + 3. look for ppu in maindir + 4. look for the specified source file (from the uses line) + 5. look for source in cwd + 6. look for source in maindir + 7. local unit pathlist + 8. global unit pathlist } + fnd:=false; + if not onlysource then + begin + fnd:=PPUSearchPath('.'); + if (not fnd) and (outputpath^<>'') then + fnd:=PPUSearchPath(outputpath^); + if (not fnd) and Assigned(main_module) and (main_module.Path^<>'') then + fnd:=PPUSearchPath(main_module.Path^); + end; + if (not fnd) and (sourcefn^<>'') then + begin + { the full filename is specified so we can't use here the + searchpath (PFV) } + if CheckVerbosity(V_Tried) then + Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,sourceext)); + fnd:=FindFile(ChangeFileExt(sourcefn^,sourceext),'',true,hs); + if not fnd then + begin + if CheckVerbosity(V_Tried) then + Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,pasext)); + fnd:=FindFile(ChangeFileExt(sourcefn^,pasext),'',true,hs); + end; + if not fnd and + ((m_mac in current_settings.modeswitches) or + (tf_p_ext_support in target_info.flags)) then + begin + if CheckVerbosity(V_Tried) then + Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,pext)); + fnd:=FindFile(ChangeFileExt(sourcefn^,pext),'',true,hs); + end; + if fnd then + begin + sources_avail:=true; + do_compile:=true; + recompile_reason:=rr_noppu; + stringdispose(mainsource); + mainsource:=StringDup(hs); + SetFileName(hs,false); + end; + end; + if not fnd then + fnd:=SourceSearchPath('.'); + if (not fnd) and Assigned(main_module) and (main_module.Path^<>'') then + fnd:=SourceSearchPath(main_module.Path^); + if (not fnd) and Assigned(loaded_from) then + fnd:=SearchPathList(loaded_from.LocalUnitSearchPath); + if not fnd then + fnd:=SearchPathList(UnitSearchPath); + search_unit:=fnd; + end; + + +{********************************** + PPU Reading/Writing Helpers +***********************************} + +{$IFDEF MACRO_DIFF_HINT} + var + is_initial: Boolean; + + procedure tppumodule.writeusedmacro(p:TNamedIndexItem;arg:pointer); + begin + if tmacro(p).is_used or is_initial then + begin + ppufile.putstring(p.name); + ppufile.putbyte(byte(is_initial)); + ppufile.putbyte(byte(tmacro(p).is_used)); + end; + end; + + procedure tppumodule.writeusedmacros; + begin + ppufile.do_crc:=false; + is_initial:= true; + initialmacrosymtable.foreach(@writeusedmacro,nil); + is_initial:= false; + if assigned(globalmacrosymtable) then + globalmacrosymtable.foreach(@writeusedmacro,nil); + localmacrosymtable.foreach(@writeusedmacro,nil); + ppufile.writeentry(ibusedmacros); + ppufile.do_crc:=true; + end; +{$ENDIF} + + procedure tppumodule.writesourcefiles; + var + hp : tinputfile; + i,j : longint; + begin + { second write the used source files } + ppufile.do_crc:=false; + hp:=sourcefiles.files; + { write source files directly in good order } + j:=0; + while assigned(hp) do + begin + inc(j); + hp:=hp.ref_next; + end; + while j>0 do + begin + hp:=sourcefiles.files; + for i:=1 to j-1 do + hp:=hp.ref_next; + ppufile.putstring(hp.name^); + ppufile.putlongint(hp.getfiletime); + dec(j); + end; + ppufile.writeentry(ibsourcefiles); + ppufile.do_crc:=true; + end; + + + procedure tppumodule.writeusedunit(intf:boolean); + var + hp : tused_unit; + oldcrc : boolean; + begin + { write a reference for each used unit } + hp:=tused_unit(used_units.first); + while assigned(hp) do + begin + if hp.in_interface=intf then + begin + ppufile.putstring(hp.u.realmodulename^); + { the checksum should not affect the crc of this unit ! (PFV) } + oldcrc:=ppufile.do_crc; + ppufile.do_crc:=false; + ppufile.putlongint(longint(hp.checksum)); + ppufile.putlongint(longint(hp.interface_checksum)); + ppufile.putlongint(longint(hp.indirect_checksum)); + ppufile.do_crc:=oldcrc; + { combine all indirect checksums from units used by this unit } + if intf then + ppufile.indirect_crc:=ppufile.indirect_crc xor hp.indirect_checksum; + end; + hp:=tused_unit(hp.next); + end; + ppufile.do_interface_crc:=true; + ppufile.writeentry(ibloadunit); + end; + + + procedure tppumodule.writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean); + var + hcontainer : tlinkcontainer; + s : string; + mask : cardinal; + begin + hcontainer:=TLinkContainer.Create; + while not p.empty do + begin + s:=p.get(mask); + if strippath then + ppufile.putstring(ExtractFileName(s)) + else + ppufile.putstring(s); + ppufile.putlongint(mask); + hcontainer.add(s,mask); + end; + ppufile.writeentry(id); + p.Free; + p:=hcontainer; + end; + + + procedure tppumodule.writederefmap; + var + i : longint; + oldcrc : boolean; + begin + { This does not influence crc } + oldcrc:=ppufile.do_crc; + ppufile.do_crc:=false; + { The unit map used for resolving } + ppufile.putlongint(derefmapcnt); + for i:=0 to derefmapcnt-1 do + begin + if not assigned(derefmap[i].u) then + internalerror(2005011512); + ppufile.putstring(derefmap[i].u.modulename^) + end; + ppufile.writeentry(ibderefmap); + ppufile.do_crc:=oldcrc; + end; + + + procedure tppumodule.writederefdata; + var + oldcrc : boolean; + len,hlen : longint; + buf : array[0..1023] of byte; + begin + if longword(derefdataintflen)>derefdata.size then + internalerror(200310223); + derefdata.seek(0); + { Write interface data } + len:=derefdataintflen; + while (len>0) do + begin + if len>1024 then + hlen:=1024 + else + hlen:=len; + derefdata.read(buf,hlen); + ppufile.putdata(buf,hlen); + dec(len,hlen); + end; + { Write implementation data, this does not influence crc } + oldcrc:=ppufile.do_crc; + ppufile.do_crc:=false; + len:=derefdata.size-derefdataintflen; + while (len>0) do + begin + if len>1024 then + hlen:=1024 + else + hlen:=len; + derefdata.read(buf,hlen); + ppufile.putdata(buf,hlen); + dec(len,hlen); + end; + if derefdata.pos<>derefdata.size then + internalerror(200310224); + ppufile.do_crc:=oldcrc; + ppufile.writeentry(ibderefdata); + end; + + + procedure tppumodule.writeImportSymbols; + var + i,j : longint; + ImportLibrary : TImportLibrary; + ImportSymbol : TImportSymbol; + begin + for i:=0 to ImportLibraryList.Count-1 do + begin + ImportLibrary:=TImportLibrary(ImportLibraryList[i]); + ppufile.putstring(ImportLibrary.Name); + ppufile.putlongint(ImportLibrary.ImportSymbolList.Count); + for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do + begin + ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]); + ppufile.putstring(ImportSymbol.Name); + ppufile.putstring(ImportSymbol.MangledName); + ppufile.putlongint(ImportSymbol.OrdNr); + ppufile.putbyte(byte(ImportSymbol.IsVar)); + end; + end; + ppufile.writeentry(ibImportSymbols); + end; + + + procedure tppumodule.writeResources; + var + res : TCmdStrListItem; + begin + res:=TCmdStrListItem(ResourceFiles.First); + while res<>nil do + begin + ppufile.putstring(res.FPStr); + res:=TCmdStrListItem(res.Next); + end; + ppufile.writeentry(ibresources); + end; + + +{$IFDEF MACRO_DIFF_HINT} + +{ + Define MACRO_DIFF_HINT for the whole compiler (and ppudump) + to turn this facility on. Also the hint messages defined + below must be commented in in the msg/errore.msg file. + + There is some problems with this, thats why it is shut off: + + At the first compilation, consider a macro which is not initially + defined, but it is used (e g the check that it is undefined is true). + Since it do not exist, there is no macro object where the is_used + flag can be set. Later on when the macro is defined, and the ppu + is opened, the check cannot detect this. + + Also, in which macro object should this flag be set ? It cant be set + for macros in the initialmacrosymboltable since this table is shared + between different files. +} + + procedure tppumodule.readusedmacros; + var + hs : string; + mac : tmacro; + was_initial, + was_used : boolean; + {Reads macros which was defined or used when the module was compiled. + This is done when a ppu file is open, before it possibly is parsed.} + begin + while not ppufile.endofentry do + begin + hs:=ppufile.getstring; + was_initial:=boolean(ppufile.getbyte); + was_used:=boolean(ppufile.getbyte); + mac:=tmacro(initialmacrosymtable.Find(hs)); + if assigned(mac) then + begin +{$ifndef EXTDEBUG} + { if we don't have the sources why tell } + if sources_avail then +{$endif ndef EXTDEBUG} + if (not was_initial) and was_used then + Message2(unit_h_cond_not_set_in_last_compile,hs,mainsource^); + end + else { not assigned } + if was_initial and + was_used then + Message2(unit_h_cond_set_in_last_compile,hs,mainsource^); + end; + end; +{$ENDIF} + + procedure tppumodule.readsourcefiles; + var + temp,hs : string; + temp_dir : TCmdStr; + main_dir : TCmdStr; + found, + is_main : boolean; + orgfiletime, + source_time : longint; + hp : tinputfile; + begin + sources_avail:=(flags and uf_release) = 0; + if not sources_avail then + exit; + is_main:=true; + main_dir:=''; + while not ppufile.endofentry do + begin + hs:=ppufile.getstring; + orgfiletime:=ppufile.getlongint; + temp_dir:=''; + if (flags and uf_in_library)<>0 then + begin + sources_avail:=false; + temp:=' library'; + end + else if pos('Macro ',hs)=1 then + begin + { we don't want to find this file } + { but there is a problem with file indexing !! } + temp:=''; + end + else + begin + { check the date of the source files: + 1 path of ppu + 2 path of main source + 3 current dir + 4 include/unit path } + Source_Time:=GetNamedFileTime(path^+hs); + found:=false; + if Source_Time<>-1 then + hs:=path^+hs + else + if not(is_main) then + begin + Source_Time:=GetNamedFileTime(main_dir+hs); + if Source_Time<>-1 then + hs:=main_dir+hs; + end; + if Source_Time=-1 then + Source_Time:=GetNamedFileTime(hs); + if (Source_Time=-1) then + begin + if is_main then + found:=unitsearchpath.FindFile(hs,true,temp_dir) + else + found:=includesearchpath.FindFile(hs,true,temp_dir); + if found then + begin + Source_Time:=GetNamedFileTime(temp_dir); + if Source_Time<>-1 then + hs:=temp_dir; + end; + end; + if Source_Time<>-1 then + begin + if is_main then + main_dir:=ExtractFilePath(hs); + temp:=' time '+filetimestring(source_time); + if (orgfiletime<>-1) and + (source_time<>orgfiletime) then + begin + do_compile:=true; + recompile_reason:=rr_sourcenewer; + Message2(unit_u_source_modified,hs,ppufilename^,@queuecomment); + temp:=temp+' *'; + end; + end + else + begin + sources_avail:=false; + temp:=' not found'; + end; + hp:=tdosinputfile.create(hs); + { the indexing is wrong here PM } + sourcefiles.register_file(hp); + end; + if is_main then + begin + stringdispose(mainsource); + mainsource:=stringdup(hs); + end; + Message1(unit_u_ppu_source,hs+temp,@queuecomment); + is_main:=false; + end; + { check if we want to rebuild every unit, only if the sources are + available } + if do_build and sources_avail then + begin + do_compile:=true; + recompile_reason:=rr_build; + end; + end; + + + procedure tppumodule.readloadunit; + var + hs : string; + pu : tused_unit; + hp : tppumodule; + indchecksum, + intfchecksum, + checksum : cardinal; + begin + while not ppufile.endofentry do + begin + hs:=ppufile.getstring; + checksum:=cardinal(ppufile.getlongint); + intfchecksum:=cardinal(ppufile.getlongint); + indchecksum:=cardinal(ppufile.getlongint); + { set the state of this unit before registering, this is + needed for a correct circular dependency check } + hp:=registerunit(self,hs,''); + pu:=addusedunit(hp,false,nil); + pu.checksum:=checksum; + pu.interface_checksum:=intfchecksum; + pu.indirect_checksum:=indchecksum; + end; + in_interface:=false; + end; + + + procedure tppumodule.readlinkcontainer(var p:tlinkcontainer); + var + s : string; + m : longint; + begin + while not ppufile.endofentry do + begin + s:=ppufile.getstring; + m:=ppufile.getlongint; + p.add(s,m); + end; + end; + + + procedure tppumodule.readderefmap; + var + i : longint; + begin + { Load unit map used for resolving } + derefmapsize:=ppufile.getlongint; + derefmapcnt:=derefmapsize; + getmem(derefmap,derefmapsize*sizeof(tderefmaprec)); + fillchar(derefmap^,derefmapsize*sizeof(tderefmaprec),0); + for i:=0 to derefmapsize-1 do + derefmap[i].modulename:=stringdup(ppufile.getstring); + end; + + + procedure tppumodule.readderefdata; + var + len,hlen : longint; + buf : array[0..1023] of byte; + begin + len:=ppufile.entrysize; + while (len>0) do + begin + if len>1024 then + hlen:=1024 + else + hlen:=len; + ppufile.getdata(buf,hlen); + derefdata.write(buf,hlen); + dec(len,hlen); + end; + end; + + + procedure tppumodule.readImportSymbols; + var + j, + extsymcnt : longint; + ImportLibrary : TImportLibrary; + extsymname : string; + extsymmangledname : string; + extsymordnr : longint; + extsymisvar : boolean; + begin + while not ppufile.endofentry do + begin + ImportLibrary:=TImportLibrary.Create(ImportLibraryList,ppufile.getstring); + extsymcnt:=ppufile.getlongint; + for j:=0 to extsymcnt-1 do + begin + extsymname:=ppufile.getstring; + extsymmangledname:=ppufile.getstring; + extsymordnr:=ppufile.getlongint; + extsymisvar:=(ppufile.getbyte<>0); + TImportSymbol.Create(ImportLibrary.ImportSymbolList,extsymname, + extsymmangledname,extsymordnr,extsymisvar); + end; + end; + end; + + + procedure tppumodule.readResources; + begin + while not ppufile.endofentry do + resourcefiles.Insert(ppufile.getstring); + end; + + + procedure tppumodule.readwpofile; + var + orgwpofilename: string; + orgwpofiletime: longint; + begin + { check whether we are using the same wpo feedback input file as when + this unit was compiled (same file name and file date) + } + orgwpofilename:=ppufile.getstring; + orgwpofiletime:=ppufile.getlongint; + if (extractfilename(orgwpofilename)<>extractfilename(wpofeedbackinput)) or + (orgwpofiletime<>GetNamedFileTime(orgwpofilename)) then + { make sure we don't throw away a precompiled unit if the user simply + forgot to specify the right wpo feedback file + } + message3(unit_e_different_wpo_file,ppufilename^,orgwpofilename,filetimestring(orgwpofiletime)); + end; + + + procedure tppumodule.load_interface; + var + b : byte; + newmodulename : string; + begin + { read interface part } + repeat + b:=ppufile.readentry; + case b of + ibmodulename : + begin + newmodulename:=ppufile.getstring; + if (cs_check_unit_name in current_settings.globalswitches) and + (upper(newmodulename)<>modulename^) then + Message2(unit_f_unit_name_error,realmodulename^,newmodulename); + stringdispose(modulename); + stringdispose(realmodulename); + modulename:=stringdup(upper(newmodulename)); + realmodulename:=stringdup(newmodulename); + end; + ibmoduleoptions: + begin + ppufile.getsmallset(moduleoptions); + if mo_has_deprecated_msg in moduleoptions then + begin + stringdispose(deprecatedmsg); + deprecatedmsg:=stringdup(ppufile.getstring); + end; + end; + ibsourcefiles : + readsourcefiles; +{$IFDEF MACRO_DIFF_HINT} + ibusedmacros : + readusedmacros; +{$ENDIF} + ibloadunit : + readloadunit; + iblinkunitofiles : + readlinkcontainer(LinkUnitOFiles); + iblinkunitstaticlibs : + readlinkcontainer(LinkUnitStaticLibs); + iblinkunitsharedlibs : + readlinkcontainer(LinkUnitSharedLibs); + iblinkotherofiles : + readlinkcontainer(LinkotherOFiles); + iblinkotherstaticlibs : + readlinkcontainer(LinkotherStaticLibs); + iblinkothersharedlibs : + readlinkcontainer(LinkotherSharedLibs); + iblinkotherframeworks : + readlinkcontainer(LinkOtherFrameworks); + ibmainname: + begin + mainname:=stringdup(ppufile.getstring); + if (mainaliasname<>defaultmainaliasname) then + Message1(scan_w_multiple_main_name_overrides,mainaliasname); + mainaliasname:=mainname^; + end; + ibImportSymbols : + readImportSymbols; + ibderefmap : + readderefmap; + ibderefdata : + readderefdata; + ibresources: + readResources; + ibwpofile: + readwpofile; + ibendinterface : + break; + else + Message1(unit_f_ppu_invalid_entry,tostr(b)); + end; + { we can already stop when we know that we must recompile } + if do_compile then + exit; + until false; + end; + + + procedure tppumodule.load_implementation; + var + b : byte; + begin + { read implementation part } + repeat + b:=ppufile.readentry; + case b of + ibloadunit : + readloadunit; + ibasmsymbols : +{ TODO: Remove ibasmsymbols} + ; + ibendimplementation : + break; + else + Message1(unit_f_ppu_invalid_entry,tostr(b)); + end; + until false; + end; + + + procedure tppumodule.writeppu; + begin + Message1(unit_u_ppu_write,realmodulename^); + + { create unit flags } + if do_release then + flags:=flags or uf_release; + if assigned(localsymtable) then + flags:=flags or uf_local_symtable; +{$ifdef cpufpemu} + if (cs_fp_emulation in current_settings.moduleswitches) then + flags:=flags or uf_fpu_emulation; +{$endif cpufpemu} +{$ifdef Test_Double_checksum_write} + Assign(CRCFile,s+'.IMP'); + Rewrite(CRCFile); +{$endif def Test_Double_checksum_write} + + { create new ppufile } + ppufile:=tcompilerppufile.create(ppufilename^); + if not ppufile.createfile then + Message(unit_f_ppu_cannot_write); + + { first the unitname } + ppufile.putstring(realmodulename^); + ppufile.writeentry(ibmodulename); + + ppufile.putsmallset(moduleoptions); + if mo_has_deprecated_msg in moduleoptions then + ppufile.putstring(deprecatedmsg^); + ppufile.writeentry(ibmoduleoptions); + + { write the alternate main procedure name if any } + if assigned(mainname) then + begin + ppufile.putstring(mainname^); + ppufile.writeentry(ibmainname); + end; + + writesourcefiles; +{$IFDEF MACRO_DIFF_HINT} + writeusedmacros; +{$ENDIF} + + { write interface uses } + writeusedunit(true); + + { write the objectfiles and libraries that come for this unit, + preserve the containers because they are still needed to load + the link.res. + All doesn't depend on the crc! It doesn't matter + if a unit is in a .o or .a file } + ppufile.do_crc:=false; + { write after source files, so that we know whether or not the compiler + will recompile the unit when checking whether the correct wpo file is + used (if it will recompile the unit anyway, it doesn't matter) + } + if (wpofeedbackinput<>'') then + begin + ppufile.putstring(wpofeedbackinput); + ppufile.putlongint(getnamedfiletime(wpofeedbackinput)); + ppufile.writeentry(ibwpofile); + end; + writelinkcontainer(linkunitofiles,iblinkunitofiles,true); + writelinkcontainer(linkunitstaticlibs,iblinkunitstaticlibs,true); + writelinkcontainer(linkunitsharedlibs,iblinkunitsharedlibs,true); + writelinkcontainer(linkotherofiles,iblinkotherofiles,false); + writelinkcontainer(linkotherstaticlibs,iblinkotherstaticlibs,true); + writelinkcontainer(linkothersharedlibs,iblinkothersharedlibs,true); + writelinkcontainer(linkotherframeworks,iblinkotherframeworks,true); + writeImportSymbols; + writeResources; + ppufile.do_crc:=true; + + { generate implementation deref data, the interface deref data is + already generated when calculating the interface crc } + if (cs_compilesystem in current_settings.moduleswitches) then + begin + tstoredsymtable(globalsymtable).buildderef; + derefdataintflen:=derefdata.size; + end + else + { the unit may have been re-resolved, in which case the current + position in derefdata is not necessarily at the end } + derefdata.seek(derefdata.size); + tstoredsymtable(globalsymtable).buildderefimpl; + if (flags and uf_local_symtable)<>0 then + begin + tstoredsymtable(localsymtable).buildderef; + tstoredsymtable(localsymtable).buildderefimpl; + end; + tunitwpoinfo(wpoinfo).buildderef; + tunitwpoinfo(wpoinfo).buildderefimpl; + writederefmap; + writederefdata; + + ppufile.writeentry(ibendinterface); + + { write the symtable entries } + tstoredsymtable(globalsymtable).ppuwrite(ppufile); + + if assigned(globalmacrosymtable) and (globalmacrosymtable.SymList.count > 0) then + begin + ppufile.putbyte(byte(true)); + ppufile.writeentry(ibexportedmacros); + tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile); + end + else + begin + ppufile.putbyte(byte(false)); + ppufile.writeentry(ibexportedmacros); + end; + + { everything after this doesn't affect the crc } + ppufile.do_crc:=false; + + { write implementation uses } + writeusedunit(false); + + { end of implementation } + ppufile.writeentry(ibendimplementation); + + { write static symtable + needed for local debugging of unit functions } + if (flags and uf_local_symtable)<>0 then + tstoredsymtable(localsymtable).ppuwrite(ppufile); + + { write whole program optimisation-related information } + tunitwpoinfo(wpoinfo).ppuwrite(ppufile); + + { the last entry ibend is written automatically } + + { flush to be sure } + ppufile.flush; + { create and write header } + ppufile.header.size:=ppufile.size; + ppufile.header.checksum:=ppufile.crc; + ppufile.header.interface_checksum:=ppufile.interface_crc; + ppufile.header.indirect_checksum:=ppufile.indirect_crc; + ppufile.header.compiler:=wordversion; + ppufile.header.cpu:=word(target_cpu); + ppufile.header.target:=word(target_info.system); + ppufile.header.flags:=flags; + ppufile.header.deflistsize:=current_module.deflist.count; + ppufile.header.symlistsize:=current_module.symlist.count; + ppufile.writeheader; + + { save crc in current module also } + crc:=ppufile.crc; + interface_crc:=ppufile.interface_crc; + indirect_crc:=ppufile.indirect_crc; + +{$ifdef Test_Double_checksum_write} + close(CRCFile); +{$endif Test_Double_checksum_write} + + ppufile.closefile; + ppufile.free; + ppufile:=nil; + end; + + + procedure tppumodule.getppucrc; + begin +{$ifdef Test_Double_checksum_write} + Assign(CRCFile,s+'.INT') + Rewrite(CRCFile); +{$endif def Test_Double_checksum_write} + + { create new ppufile } + ppufile:=tcompilerppufile.create(ppufilename^); + ppufile.crc_only:=true; + if not ppufile.createfile then + Message(unit_f_ppu_cannot_write); + + { first the unitname } + ppufile.putstring(realmodulename^); + ppufile.writeentry(ibmodulename); + + ppufile.putsmallset(moduleoptions); + if mo_has_deprecated_msg in moduleoptions then + ppufile.putstring(deprecatedmsg^); + ppufile.writeentry(ibmoduleoptions); + + { the interface units affect the crc } + writeusedunit(true); + + { deref data of interface that affect the crc } + derefdata.reset; + tstoredsymtable(globalsymtable).buildderef; + derefdataintflen:=derefdata.size; + writederefmap; + writederefdata; + + ppufile.writeentry(ibendinterface); + + { write the symtable entries } + tstoredsymtable(globalsymtable).ppuwrite(ppufile); + + if assigned(globalmacrosymtable) and (globalmacrosymtable.SymList.count > 0) then + begin + ppufile.putbyte(byte(true)); + ppufile.writeentry(ibexportedmacros); + tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile); + end + else + begin + ppufile.putbyte(byte(false)); + ppufile.writeentry(ibexportedmacros); + end; + + { save crc } + crc:=ppufile.crc; + interface_crc:=ppufile.interface_crc; + indirect_crc:=ppufile.indirect_crc; + + { end of implementation, to generate a correct ppufile + for ppudump when using INTFPPU define } + ppufile.writeentry(ibendimplementation); + +{$ifdef Test_Double_checksum} + crc_array:=ppufile.crc_test; + ppufile.crc_test:=nil; + crc_size:=ppufile.crc_index2; + crc_array2:=ppufile.crc_test2; + ppufile.crc_test2:=nil; + crc_size2:=ppufile.crc_index2; +{$endif Test_Double_checksum} + +{$ifdef Test_Double_checksum_write} + close(CRCFile); +{$endif Test_Double_checksum_write} + + { create and write header, this will only be used + for debugging purposes } + ppufile.header.size:=ppufile.size; + ppufile.header.checksum:=ppufile.crc; + ppufile.header.interface_checksum:=ppufile.interface_crc; + ppufile.header.indirect_checksum:=ppufile.indirect_crc; + ppufile.header.compiler:=wordversion; + ppufile.header.cpu:=word(target_cpu); + ppufile.header.target:=word(target_info.system); + ppufile.header.flags:=flags; + ppufile.writeheader; + + ppufile.closefile; + ppufile.free; + ppufile:=nil; + end; + + + procedure tppumodule.load_usedunits; + var + pu : tused_unit; + begin + if current_module<>self then + internalerror(200212284); + + { load the used units from interface } + in_interface:=true; + pu:=tused_unit(used_units.first); + while assigned(pu) do + begin + if pu.in_interface then + begin + tppumodule(pu.u).loadppu; + { if this unit is compiled we can stop } + if state=ms_compiled then + exit; + { add this unit to the dependencies } + pu.u.adddependency(self); + { need to recompile the current unit, check the interface + crc. And when not compiled with -Ur then check the complete + crc } + if (pu.u.interface_crc<>pu.interface_checksum) or + (pu.u.indirect_crc<>pu.indirect_checksum) or + ( + ((ppufile.header.flags and uf_release)=0) and + (pu.u.crc<>pu.checksum) + ) then + begin + Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.realmodulename^,@queuecomment); +{$ifdef DEBUG_UNIT_CRC_CHANGES} + if (pu.u.interface_crc<>pu.interface_checksum) then + writeln(' intfcrc change: ',hexstr(pu.u.interface_crc,8),' <> ',hexstr(pu.interface_checksum,8)) + else if (pu.u.indirect_crc<>pu.indirect_checksum) then + writeln(' indcrc change: ',hexstr(pu.u.indirect_crc,8),' <> ',hexstr(pu.indirect_checksum,8)) + else + writeln(' implcrc change: ',hexstr(pu.u.crc,8),' <> ',hexstr(pu.checksum,8)); +{$endif DEBUG_UNIT_CRC_CHANGES} + recompile_reason:=rr_crcchanged; + do_compile:=true; + exit; + end; + end; + pu:=tused_unit(pu.next); + end; + + { ok, now load the interface of this unit } + if current_module<>self then + internalerror(200208187); + deflist.count:=ppufile.header.deflistsize; + symlist.count:=ppufile.header.symlistsize; + globalsymtable:=tglobalsymtable.create(modulename^,moduleid); + tstoredsymtable(globalsymtable).ppuload(ppufile); + + if ppufile.readentry<>ibexportedmacros then + Message(unit_f_ppu_read_error); + if boolean(ppufile.getbyte) then + begin + globalmacrosymtable:=tmacrosymtable.Create(true); + tstoredsymtable(globalmacrosymtable).ppuload(ppufile) + end; + + interface_compiled:=true; + + { read the implementation part, containing + the implementation uses and ObjData } + in_interface:=false; + load_implementation; + + { now only read the implementation uses } + pu:=tused_unit(used_units.first); + while assigned(pu) do + begin + if (not pu.in_interface) then + begin + tppumodule(pu.u).loadppu; + { if this unit is compiled we can stop } + if state=ms_compiled then + exit; + { add this unit to the dependencies } + pu.u.adddependency(self); + { need to recompile the current unit ? } + if (pu.u.interface_crc<>pu.interface_checksum) or + (pu.u.indirect_crc<>pu.indirect_checksum) then + begin + Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.realmodulename^+' {impl}',@queuecomment); +{$ifdef DEBUG_UNIT_CRC_CHANGES} + if (pu.u.interface_crc<>pu.interface_checksum) then + writeln(' intfcrc change (2): ',hexstr(pu.u.interface_crc,8),' <> ',hexstr(pu.interface_checksum,8)) + else if (pu.u.indirect_crc<>pu.indirect_checksum) then + writeln(' indcrc change (2): ',hexstr(pu.u.indirect_crc,8),' <> ',hexstr(pu.indirect_checksum,8)); +{$endif DEBUG_UNIT_CRC_CHANGES} + recompile_reason:=rr_crcchanged; + do_compile:=true; + exit; + end; + end; + pu:=tused_unit(pu.next); + end; + + { load implementation symtable } + if (flags and uf_local_symtable)<>0 then + begin + localsymtable:=tstaticsymtable.create(modulename^,moduleid); + tstaticsymtable(localsymtable).ppuload(ppufile); + end; + + { we can now derefence all pointers to the implementation parts } + tstoredsymtable(globalsymtable).derefimpl; + if assigned(localsymtable) then + tstoredsymtable(localsymtable).derefimpl; + + { read whole program optimisation-related information } + wpoinfo:=tunitwpoinfo.ppuload(ppufile); + tunitwpoinfo(wpoinfo).deref; + tunitwpoinfo(wpoinfo).derefimpl; + end; + + + function tppumodule.needrecompile:boolean; + var + pu : tused_unit; + begin + result:=false; + pu:=tused_unit(used_units.first); + while assigned(pu) do + begin + { need to recompile the current unit, check the interface + crc. And when not compiled with -Ur then check the complete + crc } + if (pu.u.interface_crc<>pu.interface_checksum) or + (pu.u.indirect_crc<>pu.indirect_checksum) or + ( + (pu.in_interface) and + (pu.u.crc<>pu.checksum) + ) then + begin +{$ifdef DEBUG_UNIT_CRC_CHANGES} + if (pu.u.interface_crc<>pu.interface_checksum) then + writeln(' intfcrc change (3): ',hexstr(pu.u.interface_crc,8),' <> ',hexstr(pu.interface_checksum,8)) + else if (pu.u.indirect_crc<>pu.indirect_checksum) then + writeln(' indcrc change (3): ',hexstr(pu.u.indirect_crc,8),' <> ',hexstr(pu.indirect_checksum,8)) + else + writeln(' implcrc change (3): ',hexstr(pu.u.crc,8),' <> ',hexstr(pu.checksum,8)); +{$endif DEBUG_UNIT_CRC_CHANGES} + result:=true; + exit; + end; + pu:=tused_unit(pu.next); + end; + end; + + + procedure tppumodule.setdefgeneration; + begin + defsgeneration:=currentdefgeneration; + inc(currentdefgeneration); + end; + + + procedure tppumodule.reload_flagged_units; + var + hp : tppumodule; + begin + { now reload all dependent units with outdated defs } + hp:=tppumodule(loaded_units.first); + while assigned(hp) do + begin + if hp.do_reload and + (hp.defsgeneration<defsgeneration) then + begin + hp.defsgeneration:=defsgeneration; + hp.loadppu + end + else + hp.do_reload:=false; + hp:=tppumodule(hp.next); + end; + end; + + + procedure tppumodule.loadppu; + const + ImplIntf : array[boolean] of string[15]=('implementation','interface'); + var + do_load, + second_time : boolean; + old_current_module : tmodule; + begin + old_current_module:=current_module; + Message3(unit_u_load_unit,old_current_module.modulename^, + ImplIntf[old_current_module.in_interface], + modulename^); + + { Update loaded_from to detect cycles } + loaded_from:=old_current_module; + + { check if the globalsymtable is already available, but + we must reload when the do_reload flag is set } + if (not do_reload) and + assigned(globalsymtable) then + exit; + + { reset } + do_load:=true; + second_time:=false; + set_current_module(self); + + { A force reload } + if do_reload then + begin + Message(unit_u_forced_reload); + do_reload:=false; + { When the unit is already loaded or being loaded + we can maybe skip a complete reload/recompile } + if assigned(globalsymtable) and + (not needrecompile) then + begin + { When we don't have any data stored yet there + is nothing to resolve } + if interface_compiled then + begin + Message1(unit_u_reresolving_unit,modulename^); + tstoredsymtable(globalsymtable).deref; + tstoredsymtable(globalsymtable).derefimpl; + if assigned(localsymtable) then + begin + tstoredsymtable(localsymtable).deref; + tstoredsymtable(localsymtable).derefimpl; + end; + if assigned(wpoinfo) then + begin + tunitwpoinfo(wpoinfo).deref; + tunitwpoinfo(wpoinfo).derefimpl; + end; + + { We have to flag the units that depend on this unit even + though it didn't change, because they might also + indirectly depend on the unit that did change (e.g., + in case rgobj, rgx86 and rgcpu have been compiled + already, and then rgobj is recompiled for some reason + -> rgx86 is re-reresolved, but the vmtentries of trgcpu + must also be re-resolved, because they will also contain + pointers to procdefs in the old trgobj (in case of a + recompile, all old defs are freed) } + flagdependent(old_current_module); + reload_flagged_units; + end + else + Message1(unit_u_skipping_reresolving_unit,modulename^); + do_load:=false; + end; + end; + + if do_load then + begin + { loading the unit for a second time? } + if state=ms_registered then + state:=ms_load + else + begin + { try to load the unit a second time first } + Message1(unit_u_second_load_unit,modulename^); + Message2(unit_u_previous_state,modulename^,ModuleStateStr[state]); + { Flag modules to reload } + flagdependent(old_current_module); + { Reset the module } + reset; + if state in [ms_compile,ms_second_compile] then + begin + Message1(unit_u_second_compile_unit,modulename^); + state:=ms_second_compile; + do_compile:=true; + end + else + state:=ms_second_load; + second_time:=true; + end; + + { close old_current_ppu on system that are + short on file handles like DOS PM } +{$ifdef SHORT_ON_FILE_HANDLES} + if old_current_module.is_unit and + assigned(tppumodule(old_current_module).ppufile) then + tppumodule(old_current_module).ppufile.tempclose; +{$endif SHORT_ON_FILE_HANDLES} + + { try to opening ppu, skip this when we already + know that we need to compile the unit } + if not do_compile then + begin + Message1(unit_u_loading_unit,modulename^); + search_unit_files(false); + if not do_compile then + begin + load_interface; + setdefgeneration; + if not do_compile then + begin + load_usedunits; + if not do_compile then + Message1(unit_u_finished_loading_unit,modulename^); + end; + end; + { PPU is not needed anymore } + if assigned(ppufile) then + begin + ppufile.closefile; + ppufile.free; + ppufile:=nil; + end; + end; + + { Do we need to recompile the unit } + if do_compile then + begin + { recompile the unit or give a fatal error if sources not available } + if not(sources_avail) then + begin + search_unit_files(true); + if not(sources_avail) then + begin + printcomments; + if recompile_reason=rr_noppu then + Message2(unit_f_cant_find_ppu,realmodulename^,loaded_from.realmodulename^) + else + Message1(unit_f_cant_compile_unit,realmodulename^); + end; + end; + { we found the sources, we do not need the verbose messages anymore } + if comments <> nil then + begin + comments.free; + comments:=nil; + end; + { Flag modules to reload } + flagdependent(old_current_module); + { Reset the module } + reset; + { compile this module } + if not(state in [ms_compile,ms_second_compile]) then + state:=ms_compile; + compile(mainsource^); + setdefgeneration; + end + else + state:=ms_compiled; + + if current_module<>self then + internalerror(200212282); + + if in_interface then + internalerror(200212283); + + { for a second_time recompile reload all dependent units, + for a first time compile register the unit _once_ } + if second_time then + reload_flagged_units + else + usedunits.concat(tused_unit.create(self,true,false,nil)); + + { reopen the old module } +{$ifdef SHORT_ON_FILE_HANDLES} + if old_current_module.is_unit and + assigned(tppumodule(old_current_module).ppufile) then + tppumodule(old_current_module).ppufile.tempopen; +{$endif SHORT_ON_FILE_HANDLES} + end; + + { we are back, restore current_module } + set_current_module(old_current_module); + end; + + +{***************************************************************************** + RegisterUnit +*****************************************************************************} + + + function registerunit(callermodule:tmodule;const s : TIDString;const fn:string) : tppumodule; + var + ups : TIDString; + hp : tppumodule; + hp2 : tmodule; + begin + { Info } + ups:=upper(s); + { search all loaded units } + hp:=tppumodule(loaded_units.first); + while assigned(hp) do + begin + if hp.modulename^=ups then + begin + { only check for units. The main program is also + as a unit in the loaded_units list. We simply need + to ignore this entry (PFV) } + if hp.is_unit then + begin + { both units in interface ? } + if callermodule.in_interface and + hp.in_interface then + begin + { check for a cycle } + hp2:=callermodule.loaded_from; + while assigned(hp2) and (hp2<>hp) do + begin + if hp2.in_interface then + hp2:=hp2.loaded_from + else + hp2:=nil; + end; + if assigned(hp2) then + Message2(unit_f_circular_unit_reference,callermodule.realmodulename^,hp.realmodulename^); + end; + break; + end; + end; + { the next unit } + hp:=tppumodule(hp.next); + end; + { the unit is not in the loaded units, + we create an entry and register the unit } + if not assigned(hp) then + begin + Message1(unit_u_registering_new_unit,Upper(s)); + hp:=tppumodule.create(callermodule,s,fn,true); + hp.loaded_from:=callermodule; + addloadedunit(hp); + end; + { return } + registerunit:=hp; + end; + +end. diff --git a/closures/compiler/gendef.pas b/closures/compiler/gendef.pas new file mode 100644 index 0000000000..65e64c353e --- /dev/null +++ b/closures/compiler/gendef.pas @@ -0,0 +1,163 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generation of a .def file for needed for Os2/Win32 + + 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 gendef; + +{$i fpcdefs.inc} + +interface +uses + cclasses; + +type + tdeffile=class + fname : string; + constructor create(const fn:string); + destructor destroy;override; + procedure addexport(const s:string); + procedure addimport(const s:string); + procedure writefile; + function empty : boolean; + private + is_empty : boolean; + WrittenOnDisk : boolean; + exportlist, + importlist : TCmdStrList; + end; + +var + deffile : tdeffile; + + +implementation + +uses + SysUtils, + systems,cutils,globtype,globals; + +{****************************************************************************** + TDefFile +******************************************************************************} + +constructor tdeffile.create(const fn:string); +begin + fname:=fn; + WrittenOnDisk:=false; + is_empty:=true; + importlist:=TCmdStrList.Create; + exportlist:=TCmdStrList.Create; +end; + + +destructor tdeffile.destroy; +begin + if WrittenOnDisk and + not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(FName); + importlist.Free; + exportlist.Free; +end; + + + +procedure tdeffile.addexport(const s:string); +begin + exportlist.insert(s); + is_empty:=false; +end; + + +procedure tdeffile.addimport(const s:string); +begin + importlist.insert(s); + is_empty:=false; +end; + + +function tdeffile.empty : boolean; +begin + empty:=is_empty or DescriptionSetExplicity; +end; + + +procedure tdeffile.writefile; +var + t : text; +begin + If WrittenOnDisk then + Exit; +{ open file } + assign(t,fname); + {$push}{$I-} + rewrite(t); + {$pop} + if ioresult<>0 then + exit; + case target_info.system of + system_i386_Os2, system_i386_emx: + begin + write(t,'NAME '+ChangeFileExt(inputfilename,'')); + if usewindowapi then + write(t,' WINDOWAPI'); + writeln(t,''); + writeln(t,'PROTMODE'); + writeln(t,'DESCRIPTION '+''''+description+''''); + writeln(t,'DATA'#9'MULTIPLE'); + writeln(t,'STACKSIZE'#9+tostr(stacksize)); + writeln(t,'HEAPSIZE'#9+tostr(heapsize)); + end; + system_i386_win32, + system_x86_64_win64, + system_ia64_win64, + system_arm_wince, + system_i386_wince, + system_i386_wdosx : + begin + if description<>'' then + writeln(t,'DESCRIPTION '+''''+description+''''); + if dllversion<>'' then + writeln(t,'VERSION '+dllversion); + end; + end; + +{write imports} + if not importlist.empty then + begin + writeln(t,''); + writeln(t,'IMPORTS'); + while not importlist.empty do + writeln(t,#9+importlist.getfirst); + end; + +{write exports} + if not exportlist.empty then + begin + writeln(t,''); + writeln(t,'EXPORTS'); + while not exportlist.empty do + writeln(t,#9+exportlist.getfirst); + end; + + close(t); + WrittenOnDisk:=true; +end; + +end. diff --git a/closures/compiler/generic/cpuinfo.pas b/closures/compiler/generic/cpuinfo.pas new file mode 100644 index 0000000000..28b762da7b --- /dev/null +++ b/closures/compiler/generic/cpuinfo.pas @@ -0,0 +1,51 @@ +{ + Copyright (c) 1998-2002 by the Free Pascal development team + + Basic Processor information for the Generic CPU + This file is used by PPUDump program from utils subdirectory. + + 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 = extended; + ts32real = single; + ts64real = double; + ts80real = type extended; + ts128real = type extended; + ts64comp = comp; + + pbestreal=^bestreal; + + { possible supported processors for this target } + tcputype = + (cpu_none + ); + + +Type + tfputype = + (fpu_none, + fpu_soft + ); + +Const + cputypestr : array[tcputype] of string[8] = ('none'); + fputypestr : array[tfputype] of string[6] = ('none','soft'); + +Implementation + +end. diff --git a/closures/compiler/globals.pas b/closures/compiler/globals.pas new file mode 100644 index 0000000000..8cff5fbdf4 --- /dev/null +++ b/closures/compiler/globals.pas @@ -0,0 +1,1549 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements some support functions and global variables + + 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 globals; + +{$i fpcdefs.inc} + +interface + + uses +{$ifdef windows} + windows, +{$endif} +{$ifdef os2} + dos, +{$endif os2} +{$ifdef hasunix} + Baseunix,unix, +{$endif} + +{$IFNDEF USE_FAKE_SYSUTILS} + sysutils, +{$ELSE} + fksysutl, +{$ENDIF} + + { comphook pulls in sysutils anyways } + cutils,cclasses,cfileutl, + cpuinfo, + globtype,version,systems; + + const + delphimodeswitches = + [m_delphi,m_all,m_class,m_objpas,m_result,m_string_pchar, + m_pointer_2_procedure,m_autoderef,m_tp_procvar,m_initfinal,m_default_ansistring, + m_out,m_default_para,m_duplicate_names,m_hintdirective, + m_property,m_default_inline,m_except,m_advanced_records]; + delphiunicodemodeswitches = delphimodeswitches + [m_systemcodepage]; + fpcmodeswitches = + [m_fpc,m_all,m_string_pchar,m_nested_comment,m_repeat_forward, + m_cvar_support,m_initfinal,m_hintdirective, + m_property,m_default_inline]; + objfpcmodeswitches = + [m_objfpc,m_fpc,m_all,m_class,m_objpas,m_result,m_string_pchar,m_nested_comment, + m_repeat_forward,m_cvar_support,m_initfinal,m_out,m_default_para,m_hintdirective, + m_property,m_default_inline,m_except]; + tpmodeswitches = + [m_tp7,m_all,m_tp_procvar,m_duplicate_names]; +{$ifdef gpc_mode} + gpcmodeswitches = + [m_gpc,m_all,m_tp_procvar]; +{$endif} + macmodeswitches = + [m_mac,m_all,m_cvar_support,m_mac_procvar,m_nested_procvars,m_non_local_goto,m_isolike_unary_minus,m_default_inline]; + isomodeswitches = + [m_iso,m_all,m_tp_procvar,m_duplicate_names,m_nested_procvars,m_non_local_goto,m_isolike_unary_minus]; + + { maximum nesting of routines } + maxnesting = 32; + + { Filenames and extensions } + sourceext = '.pp'; + pasext = '.pas'; + pext = '.p'; + + treelogfilename = 'tree.log'; + +{$if defined(CPUARM) and defined(FPUFPA)} + MathQNaN : tdoublerec = (bytes : (0,0,252,255,0,0,0,0)); + MathInf : tdoublerec = (bytes : (0,0,240,127,0,0,0,0)); + MathNegInf : tdoublerec = (bytes : (0,0,240,255,0,0,0,0)); + MathPi : tdoublerec = (bytes : (251,33,9,64,24,45,68,84)); +{$else} +{$ifdef FPC_LITTLE_ENDIAN} + MathQNaN : tdoublerec = (bytes : (0,0,0,0,0,0,252,255)); + MathInf : tdoublerec = (bytes : (0,0,0,0,0,0,240,127)); + MathNegInf : tdoublerec = (bytes : (0,0,0,0,0,0,240,255)); + MathPi : tdoublerec = (bytes : (24,45,68,84,251,33,9,64)); + MathPiExtended : textendedrec = (bytes : (53,194,104,33,162,218,15,201,0,64)); +{$else FPC_LITTLE_ENDIAN} + MathQNaN : tdoublerec = (bytes : (255,252,0,0,0,0,0,0)); + MathInf : tdoublerec = (bytes : (127,240,0,0,0,0,0,0)); + MathNegInf : tdoublerec = (bytes : (255,240,0,0,0,0,0,0)); + MathPi : tdoublerec = (bytes : (64,9,33,251,84,68,45,24)); + MathPiExtended : textendedrec = (bytes : (64,0,201,15,218,162,33,104,194,53)); +{$endif FPC_LITTLE_ENDIAN} +{$endif} + CP_UTF8 = 65001; + CP_UTF16 = 1200; + CP_NONE = 65535; + + + type + { this is written to ppus during token recording for generics so it must be packed } + tsettings = packed record + alignment : talignmentinfo; + globalswitches : tglobalswitches; + moduleswitches : tmoduleswitches; + localswitches : tlocalswitches; + modeswitches : tmodeswitches; + optimizerswitches : toptimizerswitches; + { generate information necessary to perform these wpo's during a subsequent compilation } + genwpoptimizerswitches: twpoptimizerswitches; + { perform these wpo's using information generated during a previous compilation } + dowpoptimizerswitches: twpoptimizerswitches; + debugswitches : tdebugswitches; + { 0: old behaviour for sets <=256 elements + >0: round to this size } + setalloc, + packenum : shortint; + + packrecords : shortint; + maxfpuregisters : shortint; + + cputype, + optimizecputype : tcputype; + fputype : tfputype; + asmmode : tasmmode; + interfacetype : tinterfacetypes; + defproccall : tproccalloption; + sourcecodepage : tstringencoding; + + minfpconstprec : tfloattype; + + disabledircache : boolean; + + { CPU targets with microcontroller support can add a controller specific unit } +{$if defined(ARM) or defined(AVR)} + controllertype : tcontrollertype; +{$endif defined(ARM) or defined(AVR)} + { WARNING: this pointer cannot be written as such in record token } + pmessage : pmessagestaterecord; + end; + + const + LinkMapWeightDefault = 1000; + + type + TLinkRec = record + Key : AnsiString; + Value : AnsiString; // key expands to valuelist "value" + Weight: longint; + end; + + TLinkStrMap = class + private + itemcnt : longint; + fmap : Array Of TLinkRec; + function Lookup(key:Ansistring):longint; + function getlinkrec(i:longint):TLinkRec; + public + procedure Add(key:ansistring;value:AnsiString='';weight:longint=LinkMapWeightDefault); + procedure addseries(keys:AnsiString;weight:longint=LinkMapWeightDefault); + function AddDep(keyvalue:String):boolean; + function AddWeight(keyvalue:String):boolean; + procedure SetValue(key:AnsiString;Weight:Integer); + procedure SortonWeight; + function Find(key:AnsiString):AnsiString; + procedure Expand(src:TCmdStrList;dest: TLinkStrMap); + procedure UpdateWeights(Weightmap:TLinkStrMap); + constructor Create; + property count : longint read itemcnt; + property items[I:longint]:TLinkRec read getlinkrec; default; + end; + + + tpendingstate = record + nextverbositystr : shortstring; + nextlocalswitches : tlocalswitches; + nextverbosityfullswitch: longint; + nextcallingstr : shortstring; + nextmessagerecord : pmessagestaterecord; + verbosityfullswitched, + localswitcheschanged : boolean; + end; + + + var + { specified inputfile } + inputfilepath : string; + inputfilename : string; + { specified outputfile with -o parameter } + outputfilename : string; + outputprefix : pshortstring; + outputsuffix : pshortstring; + { specified with -FE or -FU } + outputexedir : TPathStr; + outputunitdir : TPathStr; + { specified with -FW and -Fw } + wpofeedbackinput, + wpofeedbackoutput : TPathStr; + + { things specified with parameters } + paratarget : tsystem; + paratargetdbg : tdbg; + paratargetasm : tasm; + paralinkoptions : TCmdStr; + paradynamiclinker : string; + paraprintnodetree : byte; + parapreprocess : boolean; + printnodefile : text; + + { typical cross compiling params} + + { directory where the utils can be found (options -FD) } + utilsdirectory : TPathStr; + { targetname specific prefix used by these utils (options -XP<path>) } + utilsprefix : TCmdStr; + cshared : boolean; { pass --shared to ld to link C libs shared} + Dontlinkstdlibpath: Boolean; { Don't add std paths to linkpath} + rlinkpath : TCmdStr; { rpath-link linkdir override} + sysrootpath : TCmdStr; { target system root to search dyn linker } + + { some flags for global compiler switches } + do_build, + do_release, + do_make : boolean; + { path for searching units, different paths can be seperated by ; } + exepath : TPathStr; { Path to ppc } + librarysearchpath, + unitsearchpath, + objectsearchpath, + includesearchpath, + frameworksearchpath : TSearchPathList; + autoloadunits : string; + + { linking } + usegnubinutils : boolean; + forceforwardslash : boolean; + usewindowapi : boolean; + description : string; + SetPEFlagsSetExplicity, + ImageBaseSetExplicity, + MinStackSizeSetExplicity, + MaxStackSizeSetExplicity, + DescriptionSetExplicity : boolean; + dllversion : string; + dllmajor, + dllminor, + dllrevision : word; { revision only for netware } + { win pe } + peflags : longint; + minstacksize, + maxstacksize, + imagebase : puint; + UseDeffileForExports : boolean; + UseDeffileForExportsSetExplicitly : boolean; + GenerateImportSection, + GenerateImportSectionSetExplicitly, + RelocSection : boolean; + RelocSectionSetExplicitly : boolean; + LinkTypeSetExplicitly : boolean; + + current_tokenpos, { position of the last token } + current_filepos : tfileposinfo; { current position } + + nwscreenname : string; + nwthreadname : string; + nwcopyright : string; + + codegenerror : boolean; { true if there is an error reported } + + block_type : tblock_type; { type of currently parsed block } + + compile_level : word; + exceptblockcounter : integer; { each except block gets a unique number check gotos } + current_exceptblock : integer; { the exceptblock number of the current block (0 if none) } + LinkLibraryAliases : TLinkStrMap; + LinkLibraryOrder : TLinkStrMap; + + init_settings, + current_settings : tsettings; + + pendingstate : tpendingstate; + { Memory sizes } + heapsize, + stacksize, + jmp_buf_size, + jmp_buf_align : longint; + +{$Ifdef EXTDEBUG} + { parameter switches } + debugstop : boolean; +{$EndIf EXTDEBUG} + { windows / OS/2 application type } + apptype : tapptype; + + features : tfeatures; + + const + DLLsource : boolean = false; + + { used to set all registers used for each global function + this should dramatically decrease the number of + recompilations needed PM } + simplify_ppu : boolean = true; + + Inside_asm_statement : boolean = false; + + global_unit_count : word = 0; + + { for error info in pp.pas } + parser_current_file : string = ''; + +{$if defined(m68k) or defined(arm)} + { PalmOS resources } + palmos_applicationname : string = 'FPC Application'; + palmos_applicationid : string[4] = 'FPCA'; +{$endif defined(m68k) or defined(arm)} + +{$ifdef powerpc} + { default calling convention used on MorphOS } + syscall_convention : string = 'LEGACY'; +{$endif powerpc} + + { default name of the C-style "main" procedure of the library/program } + { (this will be prefixed with the target_info.cprefix) } + defaultmainaliasname = 'main'; + mainaliasname : string = defaultmainaliasname; + + { by default no local variable trashing } + localvartrashing: longint = -1; + { actual values are defined in ncgutil.pas } + nroftrashvalues = 4; + + const + default_settings : TSettings = ( + alignment : ( + procalign : 0; + loopalign : 0; + jumpalign : 0; + constalignmin : 0; + constalignmax : 0; + varalignmin : 0; + varalignmax : 0; + localalignmin : 0; + localalignmax : 0; + recordalignmin : 0; + recordalignmax : 0; + maxCrecordalign : 0; + ); + globalswitches : [cs_check_unit_name,cs_link_static]; + moduleswitches : [cs_extsyntax,cs_implicit_exceptions]; + localswitches : [cs_check_io,cs_typed_const_writable,cs_pointermath]; + modeswitches : fpcmodeswitches; + optimizerswitches : []; + genwpoptimizerswitches : []; + dowpoptimizerswitches : []; + debugswitches : []; + + setalloc : 0; + packenum : 4; + + packrecords : 0; + maxfpuregisters : 0; + +{ Note: GENERIC_CPU is sued together with generic subdirectory to + be able to compile some of the units without any real CPU. + This is used to generate a CPU independant PPUDUMP utility. PM } +{$ifdef GENERIC_CPU} + cputype : cpu_none; + optimizecputype : cpu_none; + fputype : fpu_none; +{$else not GENERIC_CPU} + {$ifdef i386} + cputype : cpu_Pentium; + optimizecputype : cpu_Pentium3; + fputype : fpu_x87; + {$endif i386} + {$ifdef m68k} + cputype : cpu_MC68020; + optimizecputype : cpu_MC68020; + fputype : fpu_soft; + {$endif m68k} + {$ifdef powerpc} + cputype : cpu_PPC604; + optimizecputype : cpu_ppc7400; + fputype : fpu_standard; + {$endif powerpc} + {$ifdef POWERPC64} + cputype : cpu_PPC970; + optimizecputype : cpu_ppc970; + fputype : fpu_standard; + {$endif POWERPC64} + {$ifdef sparc} + cputype : cpu_SPARC_V8; + optimizecputype : cpu_SPARC_V8; + fputype : fpu_hard; + {$endif sparc} + {$ifdef arm} + cputype : cpu_armv3; + optimizecputype : cpu_armv3; + fputype : fpu_fpa; + {$endif arm} + {$ifdef x86_64} + cputype : cpu_athlon64; + optimizecputype : cpu_athlon64; + fputype : fpu_sse64; + {$endif x86_64} + {$ifdef ia64} + cputype : cpu_itanium; + optimizecputype : cpu_itanium; + fputype : fpu_itanium; + {$endif ia64} + {$ifdef avr} + cputype : cpuinfo.cpu_avr5; + optimizecputype : cpuinfo.cpu_avr5; + fputype : fpu_none; + {$endif avr} + {$ifdef mips} + cputype : cpu_mips32; + optimizecputype : cpu_mips32; + fputype : fpu_mips2; + {$endif mips} +{$endif not GENERIC_CPU} + asmmode : asmmode_standard; + interfacetype : it_interfacecom; + defproccall : pocall_default; + sourcecodepage : 28591; + minfpconstprec : s32real; + + disabledircache : false; +{$if defined(ARM) or defined(AVR)} + controllertype : ct_none; +{$endif defined(ARM) or defined(AVR)} + pmessage : nil; + ); + + var + starttime : real; + + function getdatestr:string; + function gettimestr:string; + function filetimestring( t : longint) : string; + function getrealtime : real; + + procedure DefaultReplacements(var s:ansistring); + + function Shell(const command:ansistring): longint; + function GetEnvPChar(const envname:string):pchar; + procedure FreeEnvPChar(p:pchar); + + function is_number_float(d : double) : boolean; + { discern +0.0 and -0.0 } + function get_real_sign(r: bestreal): longint; + + procedure InitGlobals; + procedure DoneGlobals; + + function string2guid(const s: string; var GUID: TGUID): boolean; + function guid2string(const GUID: TGUID): string; + + function SetAktProcCall(const s:string; var a:tproccalloption):boolean; + function Setabitype(const s:string;var a:tabi):boolean; + function Setcputype(const s:string;var a:tcputype):boolean; + function SetFpuType(const s:string;var a:tfputype):boolean; +{$if defined(arm) or defined(avr)} + function SetControllerType(const s:string;var a:tcontrollertype):boolean; +{$endif defined(arm) or defined(avr)} + function UpdateAlignmentStr(s:string;var a:talignmentinfo):boolean; + function UpdateOptimizerStr(s:string;var a:toptimizerswitches):boolean; + function UpdateWpoStr(s: string; var a: twpoptimizerswitches): boolean; + function UpdateDebugStr(s:string;var a:tdebugswitches):boolean; + function IncludeFeature(const s : string) : boolean; + function SetMinFPConstPrec(const s: string; var a: tfloattype) : boolean; + + {# Routine to get the required alignment for size of data, which will + be placed in bss segment, according to the current alignment requirements } + function var_align(want_align: longint): shortint; + function var_align_size(siz: longint): shortint; + {# Routine to get the required alignment for size of data, which will + be placed in data/const segment, according to the current alignment requirements } + function const_align(want_align: longint): shortint; + function const_align_size(siz: longint): shortint; +{$ifdef ARM} + function is_double_hilo_swapped: boolean;{$ifdef USEINLINE}inline;{$endif} +{$endif ARM} + function floating_point_range_check_error : boolean; + +implementation + + uses +{$ifdef macos} + macutils, +{$endif} +{$ifdef mswindows} +{$ifdef VER2_4} + cwindirs, +{$else VER2_4} + windirs, +{$endif VER2_4} +{$endif} + comphook; + +{**************************************************************************** + TLinkStrMap +****************************************************************************} + + Constructor TLinkStrMap.create; + begin + inherited; + itemcnt:=0; + end; + + + procedure TLinkStrMap.Add(key:ansistring;value:AnsiString='';weight:longint=LinkMapWeightDefault); + begin + if lookup(key)<>-1 Then + exit; + if itemcnt<=length(fmap) Then + setlength(fmap,itemcnt+10); + fmap[itemcnt].key:=key; + fmap[itemcnt].value:=value; + fmap[itemcnt].weight:=weight; + inc(itemcnt); + end; + + + function TLinkStrMap.AddDep(keyvalue:String):boolean; + var + i : Longint; + begin + AddDep:=false; + i:=pos('=',keyvalue); + if i=0 then + exit; + Add(Copy(KeyValue,1,i-1),Copy(KeyValue,i+1,length(KeyValue)-i)); + AddDep:=True; + end; + + + function TLinkStrMap.AddWeight(keyvalue:String):boolean; + var + i,j : Longint; + Code : Word; + s : AnsiString; + begin + AddWeight:=false; + i:=pos('=',keyvalue); + if i=0 then + exit; + s:=Copy(KeyValue,i+1,length(KeyValue)-i); + val(s,j,code); + if code=0 Then + begin + Add(Copy(KeyValue,1,i-1),'',j); + AddWeight:=True; + end; + end; + + + procedure TLinkStrMap.addseries(keys:AnsiString;weight:longint); + var + i,j,k : longint; + begin + k:=length(keys); + i:=1; + while i<=k do + begin + j:=i; + while (i<=k) and (keys[i]<>',') do + inc(i); + add(copy(keys,j,i-j),'',weight); + inc(i); + end; + end; + + procedure TLinkStrMap.SetValue(Key:Ansistring;weight:Integer); + var + j : longint; + begin + j:=lookup(key); + if j<>-1 then + fmap[j].weight:=weight; + end; + + + function TLinkStrMap.find(key:Ansistring):Ansistring; + var + j : longint; + begin + find:=''; + j:=lookup(key); + if j<>-1 then + find:=fmap[j].value; + end; + + + function TLinkStrMap.lookup(key:Ansistring):longint; + var + i : longint; + begin + lookup:=-1; + i:=0; + while (i<itemcnt) and (fmap[i].key<>key) do + inc(i); + if i<>itemcnt then + lookup:=i; + end; + + + procedure TLinkStrMap.SortOnWeight; + var + i, j : longint; + m : TLinkRec; + begin + if itemcnt <2 then exit; + for i:=0 to itemcnt-1 do + for j:=i+1 to itemcnt-1 do + begin + if fmap[i].weight>fmap[j].weight Then + begin + m:=fmap[i]; + fmap[i]:=fmap[j]; + fmap[j]:=m; + end; + end; + end; + + + function TLinkStrMap.getlinkrec(i:longint):TLinkRec; + begin + result:=fmap[i]; + end; + + + procedure TLinkStrMap.Expand(Src:TCmdStrList;Dest:TLinkStrMap); + // expands every thing in Src to Dest for linkorder purposes. + var + r : longint; + LibN : TCmdStr; + begin + while not src.empty do + begin + LibN:=src.getfirst; + r:=lookup (LibN); + if r=-1 then + dest.add(LibN) + else + dest.addseries(fmap[r].value); + end; + end; + + procedure TLinkStrMap.UpdateWeights(Weightmap:TLinkStrMap); + var + l,r : longint; + begin + for l := 0 to itemcnt-1 do + begin + r:=weightmap.lookup (fmap[l].key); + if r<>-1 then + fmap[l].weight:=weightmap[r].weight; + end; + end; + + +{**************************************************************************** + Time Handling +****************************************************************************} + + Function L0(l:longint):string; + { + return the string of value l, if l<10 then insert a zero, so + the string is always at least 2 chars '01','02',etc + } + var + s : string; + begin + Str(l,s); + if l<10 then + s:='0'+s; + L0:=s; + end; + + + function gettimestr:string; + { + get the current time in a string HH:MM:SS + } + var + hour,min,sec,hsec : word; + begin + DecodeTime(Time,hour,min,sec,hsec); + gettimestr:=L0(Hour)+':'+L0(min)+':'+L0(sec); + end; + + + function getdatestr:string; + { + get the current date in a string YY/MM/DD + } + var + Year,Month,Day: Word; + begin + DecodeDate(Date,year,month,day); + getdatestr:=L0(Year)+'/'+L0(Month)+'/'+L0(Day); + end; + + + function filetimestring( t : longint) : string; + { + convert dos datetime t to a string YY/MM/DD HH:MM:SS + } + var + DT : TDateTime; + hsec : word; + Year,Month,Day: Word; + hour,min,sec : word; + begin + if t=-1 then + begin + Result := 'Not Found'; + exit; + end; + DT := FileDateToDateTime(t); + DecodeTime(DT,hour,min,sec,hsec); + DecodeDate(DT,year,month,day); + Result := L0(Year)+'/'+L0(Month)+'/'+L0(Day)+' '+L0(Hour)+':'+L0(min)+':'+L0(sec); + end; + + + function getrealtime : real; + var + h,m,s,s1000 : word; + begin + DecodeTime(Time,h,m,s,s1000); + result:=h*3600.0+m*60.0+s+s1000/1000.0; + end; + +{**************************************************************************** + Default Macro Handling +****************************************************************************} + + + procedure DefaultReplacements(var s:ansistring); +{$ifdef mswindows} + procedure ReplaceSpecialFolder(const MacroName: string; const ID: integer); + begin + // Only try to receive the special folders (and thus dynamically + // load shfolder.dll) when that's needed. + if pos(MacroName,s)>0 then + Replace(s,MacroName,GetWindowsSpecialDir(ID)); + end; + +{$endif mswindows} + var + envstr: string; + envvalue: pchar; + i: integer; + begin + { Replace some macros } + Replace(s,'$FPCVERSION',version_string); + Replace(s,'$FPCFULLVERSION',full_version_string); + Replace(s,'$FPCDATE',date_string); + Replace(s,'$FPCCPU',target_cpu_string); + Replace(s,'$FPCOS',target_os_string); + if (tf_use_8_3 in Source_Info.Flags) or + (tf_use_8_3 in Target_Info.Flags) then + Replace(s,'$FPCTARGET',target_os_string) + else + Replace(s,'$FPCTARGET',target_full_string); +{$ifdef mswindows} + ReplaceSpecialFolder('$LOCAL_APPDATA',CSIDL_LOCAL_APPDATA); + ReplaceSpecialFolder('$APPDATA',CSIDL_APPDATA); + ReplaceSpecialFolder('$COMMON_APPDATA',CSIDL_COMMON_APPDATA); + ReplaceSpecialFolder('$PERSONAL',CSIDL_PERSONAL); + ReplaceSpecialFolder('$PROGRAM_FILES',CSIDL_PROGRAM_FILES); + ReplaceSpecialFolder('$PROGRAM_FILES_COMMON',CSIDL_PROGRAM_FILES_COMMON); + ReplaceSpecialFolder('$PROFILE',CSIDL_PROFILE); +{$endif mswindows} + { Replace environment variables between dollar signs } + i := pos('$',s); + while i>0 do + begin + envstr:=copy(s,i+1,length(s)-i); + i:=pos('$',envstr); + if i>0 then + begin + envstr := copy(envstr,1,i-1); + envvalue := GetEnvPChar(envstr); + if assigned(envvalue) then + begin + Replace(s,'$'+envstr+'$',envvalue); + // Look if there is another env.var in the string + i:=pos('$',s); + end + else + // if the env.var is not set, do not replace the env.variable + // and stop looking for more env.var within the string + i := 0; + FreeEnvPChar(envvalue); + end; + end; + end; + + + {**************************************************************************** + OS Dependent things + ****************************************************************************} + + function GetEnvPChar(const envname:string):pchar; + {$ifdef win32} + var + s : string; + i,len : longint; + hp,p,p2 : pchar; + {$endif} + begin + {$ifdef hasunix} + GetEnvPchar:=BaseUnix.fpGetEnv(envname); + {$define GETENVOK} + {$endif} + {$ifdef win32} + GetEnvPchar:=nil; + p:=GetEnvironmentStrings; + hp:=p; + while hp^<>#0 do + begin + s:=strpas(hp); + i:=pos('=',s); + len:=strlen(hp); + if upper(copy(s,1,i-1))=upper(envname) then + begin + GetMem(p2,len-length(envname)); + Move(hp[i],p2^,len-length(envname)); + GetEnvPchar:=p2; + break; + end; + { next string entry} + hp:=hp+len+1; + end; + FreeEnvironmentStrings(p); + {$define GETENVOK} + {$endif} + {$ifdef os2} + GetEnvPChar := Dos.GetEnvPChar (EnvName); + {$define GETENVOK} + {$endif} + {$ifdef GETENVOK} + {$undef GETENVOK} + {$else} + GetEnvPchar:=StrPNew(GetEnvironmentVariable(envname)); + {$endif} + end; + + + procedure FreeEnvPChar(p:pchar); + begin + {$ifndef hasunix} + {$ifndef os2} + freemem(p); + {$endif} + {$endif} + end; + +{$if defined(MORPHOS) or defined(AMIGA)} + {$define AMIGASHELL} +{$endif} + + function Shell(const command:ansistring): longint; + { This is already defined in the linux.ppu for linux, need for the * + expansion under linux } +{$ifdef hasunix} + begin + result := Unix.fpsystem(command); + end; +{$else hasunix} + {$ifdef amigashell} + begin + result := ExecuteProcess('',command); + end; + {$else amigashell} + var + comspec : string; + begin + comspec:=GetEnvironmentVariable('COMSPEC'); + result := ExecuteProcess(comspec,' /C '+command); + end; + {$endif amigashell} +{$endif hasunix} + +{$UNDEF AMIGASHELL} + function is_number_float(d : double) : boolean; + var + bytearray : array[0..7] of byte; + begin + move(d,bytearray,8); + { only 1.1 save, 1.0.x will use always little endian } +{$ifdef FPC_BIG_ENDIAN} + result:=((bytearray[0] and $7f)<>$7f) or ((bytearray[1] and $f0)<>$f0); +{$else FPC_BIG_ENDIAN} + result:=((bytearray[7] and $7f)<>$7f) or ((bytearray[6] and $f0)<>$f0); +{$endif FPC_BIG_ENDIAN} + end; + + function get_real_sign(r: bestreal): longint; + var + p: pbyte; + begin + p := pbyte(@r); +{$ifdef CPU_ARM} + inc(p,4); +{$else} +{$ifdef FPC_LITTLE_ENDIAN} + inc(p,sizeof(r)-1); +{$endif} +{$endif} + if (p^ and $80) = 0 then + result := 1 + else + result := -1; + end; + + function convertdoublerec(d : tdoublerec) : tdoublerec;{$ifdef USEINLINE}inline;{$endif} +{$ifdef CPUARM} + var + i : longint; + begin + for i:=0 to 3 do + begin + result.bytes[i+4]:=d.bytes[i]; + result.bytes[i]:=d.bytes[i+4]; + end; +{$else CPUARM} + begin + result:=d; +{$endif CPUARM} + end; + + + { '('D1:'00000000-'D2:'0000-'D3:'0000-'D4:'0000-000000000000)' } + function string2guid(const s: string; var GUID: TGUID): boolean; + function ishexstr(const hs: string): boolean; + var + i: integer; + begin + ishexstr:=false; + for i:=1 to Length(hs) do begin + if not (hs[i] in ['0'..'9','A'..'F','a'..'f']) then + exit; + end; + ishexstr:=true; + end; + function hexstr2longint(const hexs: string): longint; + var + i: integer; + rl: longint; + begin + rl:=0; + for i:=1 to length(hexs) do begin + rl:=rl shl 4; + case hexs[i] of + '0'..'9' : inc(rl,ord(hexs[i])-ord('0')); + 'A'..'F' : inc(rl,ord(hexs[i])-ord('A')+10); + 'a'..'f' : inc(rl,ord(hexs[i])-ord('a')+10); + end + end; + hexstr2longint:=rl; + end; + var + i: integer; + begin + if (Length(s)=38) and (s[1]='{') and (s[38]='}') and + (s[10]='-') and (s[15]='-') and (s[20]='-') and (s[25]='-') and + ishexstr(copy(s,2,8)) and ishexstr(copy(s,11,4)) and + ishexstr(copy(s,16,4)) and ishexstr(copy(s,21,4)) and + ishexstr(copy(s,26,12)) then begin + GUID.D1:=dword(hexstr2longint(copy(s,2,8))); + { these values are arealdy in the correct range (4 chars = word) } + GUID.D2:=word(hexstr2longint(copy(s,11,4))); + GUID.D3:=word(hexstr2longint(copy(s,16,4))); + for i:=0 to 1 do + GUID.D4[i]:=byte(hexstr2longint(copy(s,21+i*2,2))); + for i:=2 to 7 do + GUID.D4[i]:=byte(hexstr2longint(copy(s,22+i*2,2))); + string2guid:=true; + end + else if (length(s)=0) then + begin + FillChar(GUID,SizeOf(GUID),0); + string2guid:=true; + end + else + string2guid:=false; + end; + + + function guid2string(const GUID: TGUID): string; + + begin + guid2string:= + '{'+hexstr(GUID.D1,8)+ + '-'+hexstr(GUID.D2,4)+ + '-'+hexstr(GUID.D3,4)+ + '-'+hexstr(GUID.D4[0],2)+hexstr(GUID.D4[1],2)+ + '-'+hexstr(GUID.D4[2],2)+hexstr(GUID.D4[3],2)+ + hexstr(GUID.D4[4],2)+hexstr(GUID.D4[5],2)+ + hexstr(GUID.D4[6],2)+hexstr(GUID.D4[7],2)+ + '}'; + end; + + + function SetAktProcCall(const s:string; var a:tproccalloption):boolean; + const + DefProcCallName : array[tproccalloption] of string[12] = ('', + 'CDECL', + 'CPPDECL', + 'FAR16', + 'OLDFPCCALL', + '', { internproc } + '', { syscall } + 'PASCAL', + 'REGISTER', + 'SAFECALL', + 'STDCALL', + 'SOFTFLOAT', + 'MWPASCAL', + 'INTERRUPT' + ); + var + t : tproccalloption; + hs : string; + begin + result:=false; + if (s = '') then + exit; + hs:=upper(s); + if (hs = 'DEFAULT') then + begin + a := pocall_default; + result := true; + exit; + end; + for t:=low(tproccalloption) to high(tproccalloption) do + if DefProcCallName[t]=hs then + begin + a:=t; + result:=true; + break; + end; + end; + + + function Setabitype(const s:string;var a:tabi):boolean; + var + t : tabi; + hs : string; + begin + result:=false; + hs:=Upper(s); + for t:=low(t) to high(t) do + if abi2str[t]=hs then + begin + a:=t; + result:=true; + break; + end; + end; + + + function Setcputype(const s:string;var a:tcputype):boolean; + var + t : tcputype; + hs : string; + begin + result:=false; + hs:=Upper(s); + for t:=low(tcputype) to high(tcputype) do + if cputypestr[t]=hs then + begin + a:=t; + result:=true; + break; + end; + end; + + + function SetFpuType(const s:string;var a:tfputype):boolean; + var + t : tfputype; + begin + result:=false; + for t:=low(tfputype) to high(tfputype) do + if fputypestr[t]=s then + begin + a:=t; + result:=true; + break; + end; + end; + + +{$if defined(arm) or defined(avr)} + function SetControllerType(const s:string;var a:tcontrollertype):boolean; + var + t : tcontrollertype; + hs : string; + begin + result:=false; + hs:=Upper(s); + for t:=low(tcontrollertype) to high(tcontrollertype) do + if embedded_controllers[t].controllertypestr=hs then + begin + a:=t; + result:=true; + break; + end; + end; +{$endif defined(arm) or defined(avr)} + + + function UpdateAlignmentStr(s:string;var a:talignmentinfo):boolean; + var + tok : string; + vstr : string; + l : longint; + code : integer; + b : talignmentinfo; + begin + UpdateAlignmentStr:=true; + uppervar(s); + fillchar(b,sizeof(b),0); + repeat + tok:=GetToken(s,'='); + if tok='' then + break; + vstr:=GetToken(s,','); + val(vstr,l,code); + if tok='PROC' then + b.procalign:=l + else if tok='JUMP' then + b.jumpalign:=l + else if tok='LOOP' then + b.loopalign:=l + else if tok='CONSTMIN' then + begin + b.constalignmin:=l; + if l>b.constalignmax then + b.constalignmax:=l; + end + else if tok='CONSTMAX' then + b.constalignmax:=l + else if tok='VARMIN' then + begin + b.varalignmin:=l; + if l>b.varalignmax then + b.varalignmax:=l; + end + else if tok='VARMAX' then + b.varalignmax:=l + else if tok='LOCALMIN' then + begin + b.localalignmin:=l; + if l>b.localalignmax then + b.localalignmax:=l; + end + else if tok='LOCALMAX' then + b.localalignmax:=l + else if tok='RECORDMIN' then + begin + b.recordalignmin:=l; + if l>b.recordalignmax then + b.recordalignmax:=l; + end + else if tok='RECORDMAX' then + b.recordalignmax:=l + else { Error } + UpdateAlignmentStr:=false; + until false; + Result:=Result and UpdateAlignment(a,b); + end; + + + function UpdateOptimizerStr(s:string;var a:toptimizerswitches):boolean; + var + tok : string; + doset, + found : boolean; + opt : toptimizerswitch; + begin + result:=true; + uppervar(s); + repeat + tok:=GetToken(s,','); + if tok='' then + break; + if Copy(tok,1,2)='NO' then + begin + delete(tok,1,2); + doset:=false; + end + else + doset:=true; + found:=false; + for opt:=low(toptimizerswitch) to high(toptimizerswitch) do + begin + if OptimizerSwitchStr[opt]=tok then + begin + found:=true; + break; + end; + end; + if found then + begin + if doset then + include(a,opt) + else + exclude(a,opt); + end + else + result:=false; + until false; + end; + + + function UpdateWpoStr(s: string; var a: twpoptimizerswitches): boolean; + var + tok : string; + doset, + found : boolean; + opt : twpoptimizerswitch; + begin + result:=true; + uppervar(s); + repeat + tok:=GetToken(s,','); + if tok='' then + break; + if Copy(tok,1,2)='NO' then + begin + delete(tok,1,2); + doset:=false; + end + else + doset:=true; + found:=false; + if (tok = 'ALL') then + begin + for opt:=low(twpoptimizerswitch) to high(twpoptimizerswitch) do + if doset then + include(a,opt) + else + exclude(a,opt); + end + else + begin + for opt:=low(twpoptimizerswitch) to high(twpoptimizerswitch) do + begin + if WPOptimizerSwitchStr[opt]=tok then + begin + found:=true; + break; + end; + end; + if found then + begin + if doset then + include(a,opt) + else + exclude(a,opt); + end + else + result:=false; + end; + until false; + end; + + + function UpdateDebugStr(s:string;var a:tdebugswitches):boolean; + var + tok : string; + doset, + found : boolean; + opt : tdebugswitch; + begin + result:=true; + uppervar(s); + repeat + tok:=GetToken(s,','); + if tok='' then + break; + if Copy(tok,1,2)='NO' then + begin + delete(tok,1,2); + doset:=false; + end + else + doset:=true; + found:=false; + for opt:=low(tdebugswitch) to high(tdebugswitch) do + begin + if DebugSwitchStr[opt]=tok then + begin + found:=true; + break; + end; + end; + if found then + begin + if doset then + include(a,opt) + else + exclude(a,opt); + end + else + result:=false; + until false; + end; + + + function IncludeFeature(const s : string) : boolean; + var + i : tfeature; + begin + result:=true; + for i:=low(tfeature) to high(tfeature) do + if s=featurestr[i] then + begin + include(features,i); + exit; + end; + result:=false; + end; + + + function SetMinFPConstPrec(const s: string; var a: tfloattype) : boolean; + var + value, error: longint; + begin + if (upper(s)='DEFAULT') then + begin + a:=s32real; + result:=true; + exit; + end; + result:=false; + val(s,value,error); + if (error<>0) then + exit; + case value of + 32: a:=s32real; + 64: a:=s64real; + { adding support for 80 bit here is tricky, since we can't really } + { check whether the target cpu+OS actually supports it } + else + exit; + end; + result:=true; + end; + + + function var_align(want_align: longint): shortint; + begin + var_align := used_align(want_align,current_settings.alignment.varalignmin,current_settings.alignment.varalignmax); + end; + + + function var_align_size(siz: longint): shortint; + begin + siz := size_2_align(siz); + var_align_size := var_align(siz); + end; + + + function const_align(want_align: longint): shortint; + begin + const_align := used_align(want_align,current_settings.alignment.constalignmin,current_settings.alignment.constalignmax); + end; + + + function const_align_size(siz: longint): shortint; + begin + siz := size_2_align(siz); + const_align_size := const_align(siz); + end; + + +{$ifdef ARM} + function is_double_hilo_swapped: boolean;{$ifdef USEINLINE}inline;{$endif} + begin + result := (current_settings.fputype in [fpu_fpa,fpu_fpa10,fpu_fpa11]) and + not(cs_fp_emulation in current_settings.moduleswitches); +{$ifdef FPC_DOUBLE_HILO_SWAPPED} + { inverse result if compiler was compiled with swapped hilo already } + result := not result; +{$endif FPC_DOUBLE_HILO_SWAPPED} + end; +{$endif ARM} + + + function floating_point_range_check_error : boolean; + begin + result:=cs_ieee_errors in current_settings.localswitches; + end; + +{**************************************************************************** + Init +****************************************************************************} + +{$ifdef unix} + {$define need_path_search} +{$endif unix} +{$ifdef os2} + {$define need_path_search} +{$endif os2} +{$ifdef macos} + {$define need_path_search} +{$endif macos} + + procedure get_exepath; + var + localExepath : TCmdStr; + exeName:TCmdStr; +{$ifdef need_path_search} + hs1 : TPathStr; +{$endif need_path_search} + begin + localexepath:=GetEnvironmentVariable('PPC_EXEC_PATH'); + if localexepath='' then + begin + exeName := FixFileName(system.paramstr(0)); + localexepath := ExtractFilePath(exeName); + end; +{$ifdef need_path_search} + if localexepath='' then + begin + hs1 := ExtractFileName(exeName); + ChangeFileExt(hs1,source_info.exeext); +{$ifdef macos} + FindFile(hs1,GetEnvironmentVariable('Commands'),false,localExepath); +{$else macos} + FindFile(hs1,GetEnvironmentVariable('PATH'),false,localExepath); +{$endif macos} + localExepath:=ExtractFilePath(localExepath); + end; +{$endif need_path_search} + exepath:=FixPath(localExepath,false); + end; + + + + procedure DoneGlobals; + begin + librarysearchpath.Free; + unitsearchpath.Free; + objectsearchpath.Free; + includesearchpath.Free; + frameworksearchpath.Free; + LinkLibraryAliases.Free; + LinkLibraryOrder.Free; + end; + + procedure InitGlobals; + begin + get_exepath; + + { reset globals } + do_build:=false; + do_release:=false; + do_make:=true; + compile_level:=0; + codegenerror:=false; + DLLsource:=false; + paratarget:=system_none; + paratargetasm:=as_none; + paratargetdbg:=dbg_none; + + { Output } + OutputFileName:=''; + OutputPrefix:=Nil; + OutputSuffix:=Nil; + + OutputExeDir:=''; + OutputUnitDir:=''; + + { Utils directory } + utilsdirectory:=''; + utilsprefix:=''; + cshared:=false; + rlinkpath:=''; + sysrootpath:=''; + + { Search Paths } + librarysearchpath:=TSearchPathList.Create; + unitsearchpath:=TSearchPathList.Create; + includesearchpath:=TSearchPathList.Create; + objectsearchpath:=TSearchPathList.Create; + frameworksearchpath:=TSearchPathList.Create; + + { Def file } + usewindowapi:=false; + description:='Compiled by FPC '+version_string+' - '+target_cpu_string; + DescriptionSetExplicity:=false; + SetPEFlagsSetExplicity:=false; + ImageBaseSetExplicity:=false; + MinStackSizeSetExplicity:=false; + MaxStackSizeSetExplicity:=false; + + dllversion:=''; + dllmajor:=1; + dllminor:=0; + dllrevision:=0; + nwscreenname := ''; + nwthreadname := ''; + nwcopyright := ''; + UseDeffileForExports:=false; + UseDeffileForExportsSetExplicitly:=false; + GenerateImportSection:=false; + RelocSection:=false; + RelocSectionSetExplicitly:=false; + LinkTypeSetExplicitly:=false; + { memory sizes, will be overridden by parameter or default for target + in options or init_parser } + stacksize:=0; + { not initialized yet } + jmp_buf_size:=-1; + apptype:=app_cui; + + { Init values } + init_settings:=default_settings; + if init_settings.optimizecputype=cpu_none then + init_settings.optimizecputype:=init_settings.cputype; + + LinkLibraryAliases :=TLinkStrMap.Create; + LinkLibraryOrder :=TLinkStrMap.Create; + + { enable all features by default } + features:=[low(Tfeature)..high(Tfeature)]; + end; + +end. diff --git a/closures/compiler/globtype.pas b/closures/compiler/globtype.pas new file mode 100644 index 0000000000..ed6f69d564 --- /dev/null +++ b/closures/compiler/globtype.pas @@ -0,0 +1,563 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller + + Global 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. + **************************************************************************** +} +unit globtype; + +{$i fpcdefs.inc} + +interface + + const + maxidlen = 127; + + type + { TCmdStr is used to pass command line parameters to an external program to be + executed from the FPC application. In some circomstances, this can be more + than 255 characters. That's why using Ansi Strings} + TCmdStr = AnsiString; + TPathStr = AnsiString; + + { Integer type corresponding to pointer size } +{$ifdef cpu64bitaddr} + PUint = qword; + PInt = int64; +{$endif cpu64bitaddr} +{$ifdef cpu32bitaddr} + PUint = cardinal; + PInt = longint; +{$endif cpu32bitaddr} +{$ifdef cpu16bitaddr} + PUint = word; + PInt = Smallint; +{$endif cpu16bitaddr} + + { Natural integer register type and size for the target machine } +{$ifdef cpu64bitalu} + AWord = qword; + AInt = Int64; + + Const + AIntBits = 64; +{$endif cpu64bitalu} +{$ifdef cpu32bitalu} + AWord = longword; + AInt = longint; + + Const + AIntBits = 32; +{$endif cpu32bitalu} +{$ifdef cpu16bitalu} + AWord = Word; + AInt = Smallint; + + Const + AIntBits = 16; +{$endif cpu16bitalu} +{$ifdef cpu8bitalu} + AWord = Byte; + AInt = Shortint; + + Const + AIntBits = 8; +{$endif cpu8bitalu} + + Type + PAWord = ^AWord; + PAInt = ^AInt; + + { target cpu specific type used to store data sizes } + ASizeInt = PInt; + ASizeUInt = PUInt; + + { type used for handling constants etc. in the code generator } + TCGInt = Int64; + + { This must be an ordinal type with the same size as a pointer + Note: Must be unsigned! Otherwise, ugly code like + pointer(-1) will result in a pointer with the value + $fffffffffffffff on a 32bit machine if the compiler uses + int64 constants internally (JM) } + TConstPtrUInt = AWord; + + { Use a variant record to be sure that the array if aligned correctly } + tdoublerec=record + case byte of + 0 : (bytes:array[0..7] of byte); + 1 : (value:double); + end; + textendedrec=record + case byte of + 0 : (bytes:array[0..9] of byte); + 1 : (value:extended); + end; + + pconstset = ^tconstset; + tconstset = set of 0..255; + + { Switches which can be changed locally } + tlocalswitch = (cs_localnone, + { codegen } + cs_check_overflow,cs_check_range,cs_check_object, + cs_check_io,cs_check_stack, + cs_checkpointer,cs_check_ordinal_size, + cs_generate_stackframes,cs_do_assertion,cs_generate_rtti, + cs_full_boolean_eval,cs_typed_const_writable,cs_allow_enum_calc, + cs_do_inline,cs_fpu_fwait,cs_ieee_errors, + { mmx } + cs_mmx,cs_mmx_saturation, + { parser } + cs_typed_addresses,cs_strict_var_strings,cs_ansistrings,cs_bitpacking, + cs_varpropsetter,cs_scopedenums,cs_pointermath, + { macpas specific} + cs_external_var, cs_externally_visible + ); + tlocalswitches = set of tlocalswitch; + + { Switches which can be changed only at the beginning of a new module } + tmoduleswitch = (cs_modulenone, + { parser } + cs_fp_emulation,cs_extsyntax,cs_openstring, + { support } + cs_support_goto,cs_support_macro, + cs_support_c_operators, + { generation } + cs_profile,cs_debuginfo,cs_compilesystem, + cs_lineinfo,cs_implicit_exceptions,cs_explicit_codepage, + { linking } + cs_create_smart,cs_create_dynamic,cs_create_pic, + { browser switches are back } + cs_browser,cs_local_browser, + { target specific } + cs_executable_stack + ); + tmoduleswitches = set of tmoduleswitch; + + { Switches which can be changed only for a whole program/compilation, + mostly set with commandline } + tglobalswitch = (cs_globalnone, + { parameter switches } + cs_check_unit_name,cs_constructor_name,cs_support_exceptions, + cs_support_c_objectivepas, + { units } + cs_load_objpas_unit, + cs_load_gpc_unit, + cs_load_fpcylix_unit, + cs_support_vectors, + { debuginfo } + cs_use_heaptrc,cs_use_lineinfo, + cs_gdb_valgrind,cs_no_regalloc,cs_stabs_preservecase, + { assembling } + cs_asm_leave,cs_asm_extern,cs_asm_pipe,cs_asm_source, + cs_asm_regalloc,cs_asm_tempalloc,cs_asm_nodes, + { linking } + cs_link_nolink,cs_link_static,cs_link_smart,cs_link_shared,cs_link_deffile, + cs_link_strip,cs_link_staticflag,cs_link_on_target,cs_link_extern,cs_link_opt_vtable, + cs_link_opt_used_sections,cs_link_separate_dbg_file, + cs_link_map,cs_link_pthread,cs_link_no_default_lib_order, + cs_link_native + ); + tglobalswitches = set of tglobalswitch; + + { global switches specific to debug information } + tdebugswitch = (ds_none, + { enable set support in dwarf debug info, breaks gdb versions } + { without support for that tag (they refuse to parse the rest } + { of the debug information) } + ds_dwarf_sets, + { use absolute paths for include files in stabs. Pro: gdb } + { always knows full path to file. Con: doesn't work anymore } + { if the include file is moved (otherwise, things still work } + { if your source hierarchy is the same, but has a different } + { base path) } + ds_stabs_abs_include_files, + { prefix method names by "classname__" in DWARF (like is done } + { for Stabs); not enabled by default, because otherwise once } + { support for calling methods has been added to gdb, you'd } + { always have to type classinstance.classname__methodname() } + ds_dwarf_method_class_prefix + ); + tdebugswitches = set of tdebugswitch; + + + { adding a new entry here requires also adding the appropriate define in + systemh.inc (FK) + } + tfeature = ( + f_heap,f_init_final,f_rtti,f_classes,f_exceptions,f_exitcode, + f_ansistrings,f_widestrings,f_textio,f_consoleio,f_fileio, + f_random,f_variants,f_objects,f_dynarrays,f_threading,f_commandargs, + f_processes,f_stackcheck,f_dynlibs,f_softfpu,f_objectivec1,f_resources + ); + tfeatures = set of tfeature; + + type + { optimizer } + toptimizerswitch = (cs_opt_none, + cs_opt_level1,cs_opt_level2,cs_opt_level3, + cs_opt_regvar,cs_opt_uncertain,cs_opt_size,cs_opt_stackframe, + cs_opt_peephole,cs_opt_asmcse,cs_opt_loopunroll,cs_opt_tailrecursion,cs_opt_nodecse, + cs_opt_nodedfa,cs_opt_loopstrength + ); + toptimizerswitches = set of toptimizerswitch; + + { whole program optimizer } + twpoptimizerswitch = ( + cs_wpo_devirtualize_calls,cs_wpo_optimize_vmts, + cs_wpo_symbol_liveness + ); + twpoptimizerswitches = set of twpoptimizerswitch; + + type + { Used by ARM / AVR to differentiate between specific microcontrollers } + tcontrollerdatatype = record + controllertypestr, controllerunitstr: string[20]; + interruptvectors:integer; + flashbase, flashsize, srambase, sramsize, eeprombase, eepromsize: dword; + end; + + const + OptimizerSwitchStr : array[toptimizerswitch] of string[10] = ('', + 'LEVEL1','LEVEL2','LEVEL3', + 'REGVAR','UNCERTAIN','SIZE','STACKFRAME', + 'PEEPHOLE','ASMCSE','LOOPUNROLL','TAILREC','CSE','DFA','STRENGTH' + ); + WPOptimizerSwitchStr : array [twpoptimizerswitch] of string[14] = ( + 'DEVIRTCALLS','OPTVMTS','SYMBOLLIVENESS' + ); + + DebugSwitchStr : array[tdebugswitch] of string[22] = ('', + 'DWARFSETS','STABSABSINCLUDES','DWARFMETHODCLASSPREFIX'); + + { switches being applied to all CPUs at the given level } + genericlevel1optimizerswitches = [cs_opt_level1]; + genericlevel2optimizerswitches = [cs_opt_level2]; + genericlevel3optimizerswitches = [cs_opt_level3]; + + { whole program optimizations whose information generation requires + information from all loaded units + } + WPOptimizationsNeedingAllUnitInfo = [cs_wpo_devirtualize_calls]; + + featurestr : array[tfeature] of string[12] = ( + 'HEAP','INITFINAL','RTTI','CLASSES','EXCEPTIONS','EXITCODE', + 'ANSISTRINGS','WIDESTRINGS','TEXTIO','CONSOLEIO','FILEIO', + 'RANDOM','VARIANTS','OBJECTS','DYNARRAYS','THREADING','COMMANDARGS', + 'PROCESSES','STACKCHECK','DYNLIBS','SOFTFPU','OBJECTIVEC1','RESOURCES' + ); + + type + { Switches which can be changed by a mode (fpc,tp7,delphi) } + tmodeswitch = (m_none,m_all, { needed for keyword } + { generic } + m_fpc,m_objfpc,m_delphi,m_tp7,m_mac,m_iso, + {$ifdef fpc_mode}m_gpc,{$endif} + { more specific } + m_class, { delphi class model } + m_objpas, { load objpas unit } + m_result, { result in functions } + m_string_pchar, { pchar 2 string conversion } + m_cvar_support, { cvar variable directive } + m_nested_comment, { nested comments } + m_tp_procvar, { tp style procvars (no @ needed) } + m_mac_procvar, { macpas style procvars } + m_repeat_forward, { repeating forward declarations is needed } + m_pointer_2_procedure, { allows the assignement of pointers to + procedure variables } + m_autoderef, { does auto dereferencing of struct. vars } + m_initfinal, { initialization/finalization for units } + m_default_ansistring, { ansistring turned on by default } + m_out, { support the calling convention OUT } + m_default_para, { support default parameters } + m_hintdirective, { support hint directives } + m_duplicate_names, { allow locals/paras to have duplicate names of globals } + m_property, { allow properties } + m_default_inline, { allow inline proc directive } + m_except, { allow exception-related keywords } + m_objectivec1, { support interfacing with Objective-C (1.0) } + m_objectivec2, { support interfacing with Objective-C (2.0) } + m_nested_procvars, { support nested procedural variables } + m_non_local_goto, { support non local gotos (like iso pascal) } + m_advanced_records, { advanced record syntax with visibility sections, methods and properties } + m_isolike_unary_minus, { unary minus like in iso pascal: same precedence level as binary minus/plus } + m_systemcodepage { use system codepage as compiler codepage by default, emit ansistrings with system codepage } + ); + tmodeswitches = set of tmodeswitch; + + { Win32, OS/2 & MacOS application types } + tapptype = ( + app_none, + app_native, + app_gui, { graphic user-interface application} + app_cui, { console application} + app_fs, { full-screen type application (OS/2 and EMX only) } + app_tool, { tool application, (MPW tool for MacOS, MacOS only)} + app_arm7, + app_arm9, + app_bundle { dynamically loadable bundle, Darwin only } + ); + + { interface types } + tinterfacetypes = ( + it_interfacecom, + it_interfacecorba + ); + + { currently parsed block type } + tblock_type = ( + bt_none, { not assigned } + bt_general, { default } + bt_type, { type section } + bt_const, { const section } + bt_const_type, { const part of type. e.g.: ": Integer = 1" } + bt_var, { variable declaration } + bt_var_type, { type of variable } + bt_except, { except section } + bt_body { procedure body } + ); + + { Temp types } + ttemptype = (tt_none, + tt_free,tt_normal,tt_persistent, + tt_noreuse,tt_freenoreuse); + ttemptypeset = set of ttemptype; + + { calling convention for tprocdef and tprocvardef } + tproccalloption=(pocall_none, + { procedure uses C styled calling } + pocall_cdecl, + { C++ calling conventions } + pocall_cppdecl, + { Far16 for OS/2 } + pocall_far16, + { Old style FPC default calling } + pocall_oldfpccall, + { Procedure has compiler magic} + pocall_internproc, + { procedure is a system call, applies e.g. to MorphOS and PalmOS } + pocall_syscall, + { pascal standard left to right } + pocall_pascal, + { procedure uses register (fastcall) calling } + pocall_register, + { safe call calling conventions } + pocall_safecall, + { procedure uses stdcall call } + pocall_stdcall, + { Special calling convention for cpus without a floating point + unit. Floating point numbers are passed in integer registers + instead of floating point registers. Depending on the other + available calling conventions available for the cpu + this replaces either pocall_fastcall or pocall_stdcall. + } + pocall_softfloat, + { Metrowerks Pascal. Special case on Mac OS (X): passes all } + { constant records by reference. } + pocall_mwpascal, + { Special interrupt handler for embedded systems } + pocall_interrupt + ); + tproccalloptions = set of tproccalloption; + + const + proccalloptionStr : array[tproccalloption] of string[14]=('', + 'CDecl', + 'CPPDecl', + 'Far16', + 'OldFPCCall', + 'InternProc', + 'SysCall', + 'Pascal', + 'Register', + 'SafeCall', + 'StdCall', + 'SoftFloat', + 'MWPascal', + 'Interrupt' + ); + + { Default calling convention } +{$ifdef x86} + pocall_default = pocall_register; +{$else} + pocall_default = pocall_stdcall; +{$endif} + + modeswitchstr : array[tmodeswitch] of string[18] = ('','', + '','','','','','', + {$ifdef fpc_mode}'',{$endif} + { more specific } + 'CLASS', + 'OBJPAS', + 'RESULT', + 'PCHARTOSTRING', + 'CVAR', + 'NESTEDCOMMENTS', + 'CLASSICPROCVARS', + 'MACPROCVARS', + 'REPEATFORWARD', + 'POINTERTOPROCVAR', + 'AUTODEREF', + 'INITFINAL', + 'ANSISTRINGS', + 'OUT', + 'DEFAULTPARAMETERS', + 'HINTDIRECTIVE', + 'DUPLICATELOCALS', + 'PROPERTIES', + 'ALLOWINLINE', + 'EXCEPTIONS', + 'OBJECTIVEC1', + 'OBJECTIVEC2', + 'NESTEDPROCVARS', + 'NONLOCALGOTO', + 'ADVANCEDRECORDS', + 'ISOUNARYMINUS', + 'SYSTEMCODEPAGE'); + + + type + tprocinfoflag=( + { procedure has at least one assembler block } + pi_has_assembler_block, + { procedure does a call } + pi_do_call, + { procedure has a try statement = no register optimization } + pi_uses_exceptions, + { procedure is declared as @var(assembler), don't optimize} + pi_is_assembler, + { procedure contains data which needs to be finalized } + pi_needs_implicit_finally, + { procedure has the implicit try..finally generated } + pi_has_implicit_finally, + { procedure uses fpu} + pi_uses_fpu, + { procedure uses GOT for PIC code } + pi_needs_got, + { references var/proc/type/const in static symtable, + i.e. not allowed for inlining from other units } + pi_uses_static_symtable, + { set if the procedure has to push parameters onto the stack } + pi_has_stackparameter, + { set if the procedure has at least one label } + pi_has_label, + { calls itself recursive } + pi_is_recursive, + { stack frame optimization not possible (only on x86 probably) } + pi_needs_stackframe, + { set if the procedure has at least one register saved on the stack } + pi_has_saved_regs, + { dfa was generated for this proc } + pi_dfaavailable, + { subroutine contains interprocedural used labels } + pi_has_interproclabel, + { subroutine has unwind info (win64) } + pi_has_unwind_info + ); + tprocinfoflags=set of tprocinfoflag; + + type + { float types -- warning, this enum/order is used internally by the RTL + as well in rtl/inc/real2str.inc } + tfloattype = ( + s32real,s64real,s80real,sc80real { the C "long double" type on x86 }, + s64comp,s64currency,s128real + ); + + type + { register allocator live range extension direction } + TRADirection = (rad_forward, rad_backwards, rad_backwards_reinit); + + type + TIDString = string[maxidlen]; + + tnormalset = set of byte; { 256 elements set } + pnormalset = ^tnormalset; + + pboolean = ^boolean; + pdouble = ^double; + pbyte = ^byte; + pword = ^word; + plongint = ^longint; + plongintarray = plongint; + + pfileposinfo = ^tfileposinfo; + tfileposinfo = record + { if types of column or fileindex are changed, modify tcompilerppufile.putposinfo } + line : longint; + column : word; + fileindex : word; + moduleindex : word; + end; + + {$ifndef xFPC} + type + pguid = ^tguid; + tguid = packed record + D1: LongWord; + D2: Word; + D3: Word; + D4: array[0..7] of Byte; + end; + {$endif} + + tstringencoding = Word; + tcodepagestring = string[20]; + + const + { link options } + link_none = $0; + link_always = $1; + link_static = $2; + link_smart = $4; + link_shared = $8; + + type + { a message state } + tmsgstate = ( + ms_on := 1, + ms_off := 2, + ms_error := 3, + + ms_on_global := $11, // turn on output + ms_off_global := $22, // turn off output + ms_error_global := $33 // cast to error + ); + const + { Mask for current value of message state } + ms_local_mask = $0f; + { Mask for global value of message state + that needs to be restored when changing units } + ms_global_mask = $f0; + { Shift used to convert global to local message state } + ms_shift = 4; + + type + pmessagestaterecord = ^tmessagestaterecord; + tmessagestaterecord = record + next : pmessagestaterecord; + value : longint; + state : tmsgstate; + end; + + + +implementation + +end. diff --git a/closures/compiler/html/i386/readme.txt b/closures/compiler/html/i386/readme.txt new file mode 100644 index 0000000000..b1f0f0ba45 --- /dev/null +++ b/closures/compiler/html/i386/readme.txt @@ -0,0 +1,5 @@ +This directory contains the documentation of the compiler with i386 as target. +To get the documentation you've to run the pasdoc utility. You can get it from +http://pasdoc.sourceforge.net. Do a make htmldocs in the compiler directory +to create the documentation. The generated all*.html file provide access +to the different documentation. diff --git a/closures/compiler/html/powerpc/readme.txt b/closures/compiler/html/powerpc/readme.txt new file mode 100644 index 0000000000..7a534cd114 --- /dev/null +++ b/closures/compiler/html/powerpc/readme.txt @@ -0,0 +1,5 @@ +This directory contains the documentation of the compiler with powerpc as target. +To get the documentation you've to run the pasdoc utility. You can get it from +http://pasdoc.sourceforge.net. Do a make htmldocs in the compiler directory +to create the documentation. The generated all*.html file provide access +to the different documentation. diff --git a/closures/compiler/htypechk.pas b/closures/compiler/htypechk.pas new file mode 100644 index 0000000000..ea460f0816 --- /dev/null +++ b/closures/compiler/htypechk.pas @@ -0,0 +1,2968 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit exports some help routines for the type checking + + 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 htypechk; + +{$i fpcdefs.inc} + +interface + + uses + cclasses,tokens,cpuinfo, + node,globtype, + symconst,symtype,symdef,symsym,symbase; + + type + Ttok2nodeRec=record + tok : ttoken; + nod : tnodetype; + inr : integer; // inline number + op_overloading_supported : boolean; + end; + + pcandidate = ^tcandidate; + tcandidate = record + next : pcandidate; + data : tprocdef; + wrongparaidx, + firstparaidx : integer; + exact_count, + equal_count, + cl1_count, + cl2_count, + cl3_count, + cl4_count, + cl5_count, + coper_count : integer; { should be signed } + ordinal_distance : double; + invalid : boolean; + wrongparanr : byte; + end; + + tcallcandidates = class + private + FProcsym : tprocsym; + FProcsymtable : tsymtable; + FOperator : ttoken; + FCandidateProcs : pcandidate; + FProcCnt : integer; + FParaNode : tnode; + FParaLength : smallint; + FAllowVariant : boolean; + procedure collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;searchhelpers,anoninherited:boolean); + procedure collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; objcidcall,explicitunit: boolean); + procedure create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean); + function proc_add(st:tsymtable;pd:tprocdef;objcidcall: boolean):pcandidate; + public + constructor create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean); + constructor create_operator(op:ttoken;ppn:tnode); + destructor destroy;override; + procedure list(all:boolean); +{$ifdef EXTDEBUG} + procedure dump_info(lvl:longint); +{$endif EXTDEBUG} + procedure get_information; + function choose_best(var bestpd:tabstractprocdef; singlevariant: boolean):integer; + procedure find_wrong_para; + property Count:integer read FProcCnt; + end; + + type + tregableinfoflag = ( + // can be put in a register if it's the address of a var/out/const parameter + ra_addr_regable, + // orthogonal to above flag: the address of the node is taken and may + // possibly escape the block in which this node is declared (e.g. a + // local variable is passed as var parameter to another procedure) + ra_addr_taken); + tregableinfoflags = set of tregableinfoflag; + + {$i compinnr.inc} + const + tok2nodes=27; + tok2node:array[1..tok2nodes] of ttok2noderec=( + (tok:_PLUS ;nod:addn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_MINUS ;nod:subn;inr:-1;op_overloading_supported:true), { binary and unary overloading supported } + (tok:_STAR ;nod:muln;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_SLASH ;nod:slashn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_EQ ;nod:equaln;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_GT ;nod:gtn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_LT ;nod:ltn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_GTE ;nod:gten;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_LTE ;nod:lten;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_SYMDIF ;nod:symdifn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_STARSTAR ;nod:starstarn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_OP_AS ;nod:asn;inr:-1;op_overloading_supported:false), { binary overloading NOT supported } + (tok:_OP_IN ;nod:inn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_OP_IS ;nod:isn;inr:-1;op_overloading_supported:false), { binary overloading NOT supported } + (tok:_OP_OR ;nod:orn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_OP_AND ;nod:andn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_OP_DIV ;nod:divn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_OP_NOT ;nod:notn;inr:-1;op_overloading_supported:true), { unary overloading supported } + (tok:_OP_MOD ;nod:modn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_OP_SHL ;nod:shln;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_OP_SHR ;nod:shrn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_OP_XOR ;nod:xorn;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_ASSIGNMENT ;nod:assignn;inr:-1;op_overloading_supported:true), { unary overloading supported } + (tok:_OP_EXPLICIT;nod:assignn;inr:-1;op_overloading_supported:true), { unary overloading supported } + (tok:_NE ;nod:unequaln;inr:-1;op_overloading_supported:true), { binary overloading supported } + (tok:_OP_INC ;nod:inlinen;inr:in_inc_x;op_overloading_supported:true),{ unary overloading supported } + (tok:_OP_DEC ;nod:inlinen;inr:in_dec_x;op_overloading_supported:true) { unary overloading supported } + ); + + { true, if we are parsing stuff which allows array constructors } + allow_array_constructor : boolean = false; + + function node2opstr(nt:tnodetype):string; + + { check operator args and result type } + function isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean; + function isoperatoracceptable(pf : tprocdef; optoken : ttoken) : boolean; + function isunaryoverloaded(var t : tnode) : boolean; + function isbinaryoverloaded(var t : tnode) : boolean; + + { Register Allocation } + procedure make_not_regable(p : tnode; how: tregableinfoflags); + + { procvar handling } + function is_proc2procvar_load(p:tnode;out realprocdef:tprocdef):boolean; + { returns whether a node represents a load of the function result node via + the function name (so it could also be a recursive call to the function + in case there or no parameters, or the function could be passed as + procvar } + function is_ambiguous_funcret_load(p: tnode; out owningprocdef: tprocdef): boolean; + procedure test_local_to_procvar(from_def:tprocvardef;to_def:tdef); + + { sets varsym varstate field correctly } + type + tvarstateflag = (vsf_must_be_valid,vsf_use_hints); + tvarstateflags = set of tvarstateflag; + procedure set_varstate(p:tnode;newstate:tvarstate;varstateflags:tvarstateflags); + + { sets the callunique flag, if the node is a vecn, } + { takes care of type casts etc. } + procedure set_unique(p : tnode); + + function valid_for_formal_var(p : tnode; report_errors: boolean) : boolean; + function valid_for_formal_const(p : tnode; report_errors: boolean) : boolean; + function valid_for_var(p:tnode; report_errors: boolean):boolean; + function valid_for_assignment(p:tnode; report_errors: boolean):boolean; + function valid_for_loopvar(p:tnode; report_errors: boolean):boolean; + function valid_for_addr(p : tnode; report_errors: boolean) : boolean; + + function allowenumop(nt:tnodetype):boolean; + + procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring); + + procedure check_ranges(const location: tfileposinfo; source: tnode; destdef: tdef); + +implementation + + uses + sysutils, + systems,constexp,globals, + cutils,verbose, + symtable, + defutil,defcmp, + nbas,ncnv,nld,nmem,ncal,nmat,ninl,nutils,ncon, + cgbase,procinfo + ; + + type + TValidAssign=(Valid_Property,Valid_Void,Valid_Const,Valid_Addr,Valid_Packed); + TValidAssigns=set of TValidAssign; + + + function node2opstr(nt:tnodetype):string; + var + i : integer; + begin + result:='<unknown>'; + for i:=1 to tok2nodes do + if tok2node[i].nod=nt then + begin + result:=tokeninfo^[tok2node[i].tok].str; + break; + end; + end; + + + function isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean; + + function internal_check(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype;var allowed:boolean):boolean; + begin + internal_check:=true; + case ld.typ of + formaldef, + recorddef, + variantdef : + begin + allowed:=true; + end; + procvardef : + begin + if (rd.typ in [pointerdef,procdef,procvardef]) then + begin + allowed:=false; + exit; + end; + allowed:=true; + end; + pointerdef : + begin + if ((rd.typ in [orddef,enumdef,pointerdef,classrefdef,procvardef]) or + is_implicit_pointer_object_type(rd)) then + begin + allowed:=false; + exit; + end; + + { don't allow pchar+string } + if (is_pchar(ld) or is_pwidechar(ld)) and + ((rd.typ=stringdef) or + is_pchar(rd) or + is_pwidechar(rd) or + is_chararray(rd) or + is_widechararray(rd)) then + begin + allowed:=false; + exit; + end; + allowed:=true; + end; + arraydef : + begin + { not vector/mmx } + if ((cs_mmx in current_settings.localswitches) and + is_mmx_able_array(ld)) or + ((cs_support_vectors in current_settings.globalswitches) and + is_vector(ld)) then + begin + allowed:=false; + exit; + end; + { not chararray+[(wide)char,(wide)string,(wide)chararray] } + if (is_chararray(ld) or is_widechararray(ld) or + is_open_chararray(ld) or is_open_widechararray(ld)) + and + ((rd.typ in [stringdef,orddef,enumdef]) or + is_pchar(rd) or + is_pwidechar(rd) or + is_chararray(rd) or + is_widechararray(rd) or + is_open_chararray(rd) or + is_open_widechararray(rd) or + (rt=niln)) then + begin + allowed:=false; + exit; + end; + { dynamic array compare with niln } + if ((is_dynamic_array(ld) and + (rt=niln)) or + (is_dynamic_array(ld) and is_dynamic_array(rd))) + and + (treetyp in [equaln,unequaln]) then + begin + allowed:=false; + exit; + end; + allowed:=true; + end; + objectdef : + begin + { <> and = are defined for implicit pointer object types } + if (treetyp in [equaln,unequaln]) and + is_implicit_pointer_object_type(ld) then + begin + allowed:=false; + exit; + end; + allowed:=true; + end; + stringdef : + begin + if (rd.typ in [orddef,enumdef,stringdef]) or + is_pchar(rd) or + is_pwidechar(rd) or + is_chararray(rd) or + is_widechararray(rd) or + is_open_chararray(rd) or + is_open_widechararray(rd) then + begin + allowed:=false; + exit; + end; + allowed:=true; + end; + else + internal_check:=false; + end; + end; + + var + allowed : boolean; + begin + { power ** is always possible } + if (treetyp=starstarn) then + begin + isbinaryoperatoroverloadable:=true; + exit; + end; + { order of arguments does not matter so we have to check also + the reversed order } + allowed:=false; + if not internal_check(treetyp,ld,lt,rd,rt,allowed) then + internal_check(treetyp,rd,rt,ld,lt,allowed); + isbinaryoperatoroverloadable:=allowed; + end; + + + function isunaryoperatoroverloadable(treetyp:tnodetype;inlinenumber:integer;ld:tdef) : boolean; + begin + result:=false; + case treetyp of + subn, + addn, + unaryminusn, + unaryplusn, + inlinen: + begin + { only Inc, Dec inline functions are supported for now, so skip check inlinenumber } + + if (ld.typ in [orddef,enumdef,floatdef]) then + exit; + +{$ifdef SUPPORT_MMX} + if (cs_mmx in current_settings.localswitches) and + is_mmx_able_array(ld) then + exit; +{$endif SUPPORT_MMX} + + result:=true; + end; + + notn : + begin + if (ld.typ in [orddef,enumdef,floatdef]) then + exit; + +{$ifdef SUPPORT_MMX} + if (cs_mmx in current_settings.localswitches) and + is_mmx_able_array(ld) then + exit; +{$endif SUPPORT_MMX} + + result:=true; + end; + end; + end; + + + function isoperatoracceptable(pf : tprocdef; optoken : ttoken) : boolean; + var + ld,rd : tdef; + i : longint; + eq : tequaltype; + conv : tconverttype; + pd : tprocdef; + oldcount, + count: longint; + parasym : tparavarsym; + begin + result:=false; + count := pf.parast.SymList.count; + + oldcount:=count; + while count > 0 do + begin + parasym:=tparavarsym(pf.parast.SymList[count-1]); + if is_boolean(parasym.vardef) then + begin + if parasym.name='RANGECHECK' then + begin + Include(parasym.varoptions, vo_is_hidden_para); + Include(parasym.varoptions, vo_is_range_check); + Dec(count); + end + else if parasym.name='OVERFLOWCHECK' then + begin + Include(parasym.varoptions, vo_is_hidden_para); + Include(parasym.varoptions, vo_is_overflow_check); + Dec(count); + end + else + break; + end + else + break; + end; + if count<>oldcount then + pf.calcparas; + + case count of + 1 : begin + ld:=tparavarsym(pf.parast.SymList[0]).vardef; + { assignment is a special case } + if optoken in [_ASSIGNMENT,_OP_EXPLICIT] then + begin + eq:=compare_defs_ext(ld,pf.returndef,nothingn,conv,pd,[cdo_explicit]); + result:= + (eq=te_exact) or + ( + (eq=te_incompatible) and + { don't allow overloading assigning to custom shortstring + types, because we also don't want to differentiate based + on different shortstring types (e.g., + "operator :=(const v: variant) res: shorstring" also + has to work for assigning a variant to a string[80]) + } + (not is_shortstring(pf.returndef) or + (tstringdef(pf.returndef).len=255)) + ); + end + else + { enumerator is a special case too } + if optoken=_OP_ENUMERATOR then + begin + result:= + is_class_or_interface_or_object(pf.returndef) or + is_record(pf.returndef); + if result then + begin + if not assigned(tabstractrecorddef(pf.returndef).search_enumerator_move) then + begin + Message1(sym_e_no_enumerator_move, pf.returndef.typename); + result:=false; + end; + if not assigned(tabstractrecorddef(pf.returndef).search_enumerator_current) then + begin + Message1(sym_e_no_enumerator_current,pf.returndef.typename); + result:=false; + end; + end; + end + else + begin + for i:=1 to tok2nodes do + if tok2node[i].tok=optoken then + begin + result:= + tok2node[i].op_overloading_supported and + isunaryoperatoroverloadable(tok2node[i].nod,tok2node[i].inr,ld); + break; + end; + { Inc, Dec operators are valid if only result type is the same as argument type } + if result and (optoken in [_OP_INC,_OP_DEC]) then + result:=pf.returndef=ld; + end; + end; + 2 : begin + for i:=1 to tok2nodes do + if tok2node[i].tok=optoken then + begin + ld:=tparavarsym(pf.parast.SymList[0]).vardef; + rd:=tparavarsym(pf.parast.SymList[1]).vardef; + result:= + tok2node[i].op_overloading_supported and + isbinaryoperatoroverloadable(tok2node[i].nod,ld,nothingn,rd,nothingn); + break; + end; + end; + end; + end; + + + function isunaryoverloaded(var t : tnode) : boolean; + var + ld : tdef; + optoken : ttoken; + operpd : tprocdef; + ppn : tcallparanode; + candidates : tcallcandidates; + cand_cnt, + inlinenumber: integer; + begin + result:=false; + operpd:=nil; + + { load easier access variables } + ld:=tunarynode(t).left.resultdef; + + { if we are dealing with inline function then get the function } + if t.nodetype=inlinen then + inlinenumber:=tinlinenode(t).inlinenumber + else + inlinenumber:=-1; + + if not isunaryoperatoroverloadable(t.nodetype,inlinenumber,ld) then + exit; + + { operator overload is possible } + result:=true; + + optoken:=NOTOKEN; + case t.nodetype of + notn: + optoken:=_OP_NOT; + unaryminusn: + optoken:=_MINUS; + unaryplusn: + optoken:=_PLUS; + inlinen: + case inlinenumber of + in_inc_x: + optoken:=_OP_INC; + in_dec_x: + optoken:=_OP_DEC; + end; + end; + if (optoken=NOTOKEN) then + begin + CGMessage(parser_e_operator_not_overloaded); + t:=cnothingnode.create; + exit; + end; + + { generate parameter nodes } + { for inline nodes just copy existent callparanode } + if (t.nodetype=inlinen) and (tinlinenode(t).left.nodetype=callparan) then + ppn:=tcallparanode(tinlinenode(t).left.getcopy) + else + begin + ppn:=ccallparanode.create(tunarynode(t).left.getcopy,nil); + ppn.get_paratype; + end; + candidates:=tcallcandidates.create_operator(optoken,ppn); + + { stop when there are no operators found } + if candidates.count=0 then + begin + CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str); + candidates.free; + ppn.free; + t:=cnothingnode.create; + exit; + end; + + { Retrieve information about the candidates } + candidates.get_information; +{$ifdef EXTDEBUG} + { Display info when multiple candidates are found } + candidates.dump_info(V_Debug); +{$endif EXTDEBUG} + cand_cnt:=candidates.choose_best(tabstractprocdef(operpd),false); + + { exit when no overloads are found } + if cand_cnt=0 then + begin + CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str); + candidates.free; + ppn.free; + t:=cnothingnode.create; + exit; + end; + + { Multiple candidates left? } + if cand_cnt>1 then + begin + CGMessage(type_e_cant_choose_overload_function); +{$ifdef EXTDEBUG} + candidates.dump_info(V_Hint); +{$else EXTDEBUG} + candidates.list(false); +{$endif EXTDEBUG} + { we'll just use the first candidate to make the + call } + end; + candidates.free; + + addsymref(operpd.procsym); + + { the nil as symtable signs firstcalln that this is + an overloaded operator } + t:=ccallnode.create(ppn,Tprocsym(operpd.procsym),nil,nil,[]); + + { we already know the procdef to use, so it can + skip the overload choosing in callnode.pass_typecheck } + tcallnode(t).procdefinition:=operpd; + end; + + + function isbinaryoverloaded(var t : tnode) : boolean; + var + rd,ld : tdef; + optoken : ttoken; + operpd : tprocdef; + ht : tnode; + ppn : tcallparanode; + cand_cnt : integer; + + function search_operator(optoken:ttoken;generror:boolean): integer; + var + candidates : tcallcandidates; + begin + { generate parameter nodes } + ppn:=ccallparanode.create(tbinarynode(t).right.getcopy,ccallparanode.create(tbinarynode(t).left.getcopy,nil)); + ppn.get_paratype; + candidates:=tcallcandidates.create_operator(optoken,ppn); + + { for commutative operators we can swap arguments and try again } + if (candidates.count=0) and + not(optoken in [_OP_SHL,_OP_SHR,_OP_DIV,_OP_MOD,_STARSTAR,_SLASH,_MINUS]) then + begin + candidates.free; + reverseparameters(ppn); + { reverse compare operators } + case optoken of + _LT: + optoken:=_GTE; + _GT: + optoken:=_LTE; + _LTE: + optoken:=_GT; + _GTE: + optoken:=_LT; + end; + candidates:=tcallcandidates.create_operator(optoken,ppn); + end; + + { stop when there are no operators found } + result:=candidates.count; + if (result=0) and generror then + begin + CGMessage(parser_e_operator_not_overloaded); + candidates.free; + exit; + end; + + if (result>0) then + begin + { Retrieve information about the candidates } + candidates.get_information; + {$ifdef EXTDEBUG} + { Display info when multiple candidates are found } + candidates.dump_info(V_Debug); + {$endif EXTDEBUG} + result:=candidates.choose_best(tabstractprocdef(operpd),false); + end; + + { exit when no overloads are found } + if (result=0) and generror then + begin + CGMessage3(parser_e_operator_not_overloaded_3,ld.typename,arraytokeninfo[optoken].str,rd.typename); + candidates.free; + exit; + end; + + { Multiple candidates left? } + if result>1 then + begin + CGMessage(type_e_cant_choose_overload_function); + {$ifdef EXTDEBUG} + candidates.dump_info(V_Hint); + {$else EXTDEBUG} + candidates.list(false); + {$endif EXTDEBUG} + { we'll just use the first candidate to make the + call } + end; + candidates.free; + end; + + begin + isbinaryoverloaded:=false; + operpd:=nil; + { load easier access variables } + ld:=tbinarynode(t).left.resultdef; + rd:=tbinarynode(t).right.resultdef; + if not isbinaryoperatoroverloadable(t.nodetype,ld,tbinarynode(t).left.nodetype,rd,tbinarynode(t).right.nodetype) then + exit; + + { operator overload is possible } + result:=true; + + case t.nodetype of + equaln: + optoken:=_EQ; + unequaln: + optoken:=_NE; + addn: + optoken:=_PLUS; + subn: + optoken:=_MINUS; + muln: + optoken:=_STAR; + starstarn: + optoken:=_STARSTAR; + slashn: + optoken:=_SLASH; + ltn: + optoken:=_LT; + gtn: + optoken:=_GT; + lten: + optoken:=_LTE; + gten: + optoken:=_GTE; + symdifn : + optoken:=_SYMDIF; + modn : + optoken:=_OP_MOD; + orn : + optoken:=_OP_OR; + xorn : + optoken:=_OP_XOR; + andn : + optoken:=_OP_AND; + divn : + optoken:=_OP_DIV; + shln : + optoken:=_OP_SHL; + shrn : + optoken:=_OP_SHR; + inn : + optoken:=_OP_IN; + else + begin + CGMessage(parser_e_operator_not_overloaded); + t:=cnothingnode.create; + exit; + end; + end; + + cand_cnt:=search_operator(optoken,optoken<>_NE); + + { no operator found for "<>" then search for "=" operator } + if (cand_cnt=0) and (optoken=_NE) then + begin + ppn.free; + operpd:=nil; + optoken:=_EQ; + cand_cnt:=search_operator(optoken,true); + end; + + if (cand_cnt=0) then + begin + ppn.free; + t:=cnothingnode.create; + exit; + end; + + addsymref(operpd.procsym); + + { the nil as symtable signs firstcalln that this is + an overloaded operator } + ht:=ccallnode.create(ppn,Tprocsym(operpd.procsym),nil,nil,[]); + + { we already know the procdef to use, so it can + skip the overload choosing in callnode.pass_typecheck } + tcallnode(ht).procdefinition:=operpd; + + { if we found "=" operator for "<>" expression then use it + together with "not" } + if (t.nodetype=unequaln) and (optoken=_EQ) then + ht:=cnotnode.create(ht); + t:=ht; + end; + + +{**************************************************************************** + Register Calculation +****************************************************************************} + + { marks an lvalue as "unregable" } + procedure make_not_regable_intern(p : tnode; how: tregableinfoflags; records_only: boolean); + begin + repeat + case p.nodetype of + subscriptn: + begin + records_only:=true; + p:=tsubscriptnode(p).left; + end; + vecn: + begin + { if there's an implicit dereference, we can stop (just like + when there is an actual derefn) } + if ((tvecnode(p).left.resultdef.typ=arraydef) and + not is_special_array(tvecnode(p).left.resultdef)) or + ((tvecnode(p).left.resultdef.typ=stringdef) and + (tstringdef(tvecnode(p).left.resultdef).stringtype in [st_shortstring,st_longstring])) then + p:=tvecnode(p).left + else + break; + end; + typeconvn : + begin + { implicit dereference -> stop } + if (ttypeconvnode(p).convtype=tc_pointer_2_array) then + break; + if (ttypeconvnode(p).resultdef.typ=recorddef) then + records_only:=false; + p:=ttypeconvnode(p).left; + end; + loadn : + begin + if (tloadnode(p).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then + begin + if (ra_addr_taken in how) then + tabstractvarsym(tloadnode(p).symtableentry).addr_taken:=true; + if (tabstractvarsym(tloadnode(p).symtableentry).varregable <> vr_none) and + ((not records_only) or + (tabstractvarsym(tloadnode(p).symtableentry).vardef.typ = recorddef)) then + if (tloadnode(p).symtableentry.typ = paravarsym) and + (ra_addr_regable in how) then + tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_addr + else + tabstractvarsym(tloadnode(p).symtableentry).varregable:=vr_none; + end; + break; + end; + temprefn : + begin + if (ra_addr_taken in how) then + include(ttemprefnode(p).tempinfo^.flags,ti_addr_taken); + if (ti_may_be_in_reg in ttemprefnode(p).tempinfo^.flags) and + ((not records_only) or + (ttemprefnode(p).tempinfo^.typedef.typ = recorddef)) then + exclude(ttemprefnode(p).tempinfo^.flags,ti_may_be_in_reg); + break; + end; + else + break; + end; + until false; + end; + + procedure make_not_regable(p : tnode; how: tregableinfoflags); + begin + make_not_regable_intern(p,how,false); + end; + + +{**************************************************************************** + Subroutine Handling +****************************************************************************} + + function is_proc2procvar_load(p:tnode;out realprocdef:tprocdef):boolean; + begin + result:=false; + { remove voidpointer typecast for tp procvars } + if ((m_tp_procvar in current_settings.modeswitches) or + (m_mac_procvar in current_settings.modeswitches)) and + (p.nodetype=typeconvn) and + is_voidpointer(p.resultdef) then + p:=tunarynode(p).left; + result:=(p.nodetype=typeconvn) and + (ttypeconvnode(p).convtype=tc_proc_2_procvar); + if result then + realprocdef:=tprocdef(ttypeconvnode(p).left.resultdef); + end; + + + function is_ambiguous_funcret_load(p: tnode; out owningprocdef: tprocdef): boolean; + begin + result:=false; + { the funcret is an absolutevarsym, which gets converted into a type + conversion node of the loadnode of the actual function result. Its + resulttype is obviously the same as that of the real function result } + if (p.nodetype=typeconvn) and + (p.resultdef=ttypeconvnode(p).left.resultdef) then + p:=ttypeconvnode(p).left; + if (p.nodetype=loadn) and + (tloadnode(p).symtableentry.typ in [absolutevarsym,localvarsym,paravarsym]) and + ([vo_is_funcret,vo_is_result] * tabstractvarsym(tloadnode(p).symtableentry).varoptions = [vo_is_funcret]) then + begin + owningprocdef:=tprocdef(tloadnode(p).symtableentry.owner.defowner); + result:=true; + end; + end; + + + { local routines can't be assigned to procvars } + procedure test_local_to_procvar(from_def:tprocvardef;to_def:tdef); + begin + if not(m_nested_procvars in current_settings.modeswitches) and + (from_def.parast.symtablelevel>normal_function_level) and + (to_def.typ=procvardef) then + CGMessage(type_e_cannot_local_proc_to_procvar); + end; + + + procedure set_varstate(p:tnode;newstate:tvarstate;varstateflags:tvarstateflags); + const + vstrans: array[tvarstate,tvarstate] of tvarstate = ( + { vs_none -> ... } + (vs_none,vs_declared,vs_initialised,vs_read,vs_read_not_warned,vs_referred_not_inited,vs_written,vs_readwritten), + { vs_declared -> ... } + (vs_none,vs_declared,vs_initialised,vs_read,vs_read_not_warned,vs_referred_not_inited,vs_written,vs_readwritten), + { vs_initialised -> ... } + (vs_none,vs_initialised,vs_initialised,vs_read,vs_read,vs_read,vs_written,vs_readwritten), + { vs_read -> ... } + (vs_none,vs_read,vs_read,vs_read,vs_read,vs_read,vs_readwritten,vs_readwritten), + { vs_read_not_warned -> ... } + (vs_none,vs_read_not_warned,vs_read,vs_read,vs_read_not_warned,vs_read_not_warned,vs_readwritten,vs_readwritten), + { vs_referred_not_inited } + (vs_none,vs_referred_not_inited,vs_read,vs_read,vs_read_not_warned,vs_referred_not_inited,vs_written,vs_readwritten), + { vs_written -> ... } + (vs_none,vs_written,vs_written,vs_readwritten,vs_readwritten,vs_written,vs_written,vs_readwritten), + { vs_readwritten -> ... } + (vs_none,vs_readwritten,vs_readwritten,vs_readwritten,vs_readwritten,vs_readwritten,vs_readwritten,vs_readwritten)); + var + hsym : tabstractvarsym; + begin + { make sure we can still warn about uninitialised use after high(v), @v etc } + if (newstate = vs_read) and + not(vsf_must_be_valid in varstateflags) then + newstate := vs_referred_not_inited; + + while assigned(p) do + begin + case p.nodetype of + derefn: + begin + if (tderefnode(p).left.nodetype=temprefn) and + assigned(ttemprefnode(tderefnode(p).left).tempinfo^.withnode) then + p:=ttemprefnode(tderefnode(p).left).tempinfo^.withnode + else + break; + end; + typeconvn : + begin + case ttypeconvnode(p).convtype of + tc_cchar_2_pchar, + tc_cstring_2_pchar, + tc_array_2_pointer : + exclude(varstateflags,vsf_must_be_valid); + tc_pchar_2_string, + tc_pointer_2_array : + include(varstateflags,vsf_must_be_valid); + end; + p:=tunarynode(p).left; + end; + subscriptn : + begin + if is_implicit_pointer_object_type(tunarynode(p).left.resultdef) then + newstate := vs_read; + p:=tunarynode(p).left; + end; + vecn: + begin + set_varstate(tbinarynode(p).right,vs_read,[vsf_must_be_valid]); + if (newstate in [vs_read,vs_readwritten]) or + not(tunarynode(p).left.resultdef.typ in [stringdef,arraydef]) then + include(varstateflags,vsf_must_be_valid) + else if (newstate = vs_written) then + exclude(varstateflags,vsf_must_be_valid); + p:=tunarynode(p).left; + end; + { do not parse calln } + calln : + break; + loadn : + begin + if (tloadnode(p).symtableentry.typ in [localvarsym,paravarsym,staticvarsym]) then + begin + hsym:=tabstractvarsym(tloadnode(p).symtableentry); + if (vsf_must_be_valid in varstateflags) and + (hsym.varstate in [vs_declared,vs_read_not_warned,vs_referred_not_inited]) then + begin + { Give warning/note for uninitialized locals } + if assigned(hsym.owner) and + not(cs_opt_nodedfa in current_settings.optimizerswitches) and + not(vo_is_external in hsym.varoptions) and + (hsym.owner.symtabletype in [parasymtable,localsymtable,staticsymtable]) and + ((hsym.owner=current_procinfo.procdef.localst) or + (hsym.owner=current_procinfo.procdef.parast)) then + begin + if (vo_is_funcret in hsym.varoptions) then + begin + if (vsf_use_hints in varstateflags) then + CGMessagePos(p.fileinfo,sym_h_function_result_uninitialized) + else + CGMessagePos(p.fileinfo,sym_w_function_result_uninitialized) + end + else + begin + if tloadnode(p).symtable.symtabletype=localsymtable then + begin + if (vsf_use_hints in varstateflags) then + CGMessagePos1(p.fileinfo,sym_h_uninitialized_local_variable,hsym.realname) + else + CGMessagePos1(p.fileinfo,sym_w_uninitialized_local_variable,hsym.realname); + end + else + begin + if (vsf_use_hints in varstateflags) then + CGMessagePos1(p.fileinfo,sym_h_uninitialized_variable,hsym.realname) + else + CGMessagePos1(p.fileinfo,sym_w_uninitialized_variable,hsym.realname); + end; + end; + end + else if (newstate = vs_read) then + newstate := vs_read_not_warned; + end; + hsym.varstate := vstrans[hsym.varstate,newstate]; + end; + case newstate of + vs_written: + include(tloadnode(p).flags,nf_write); + vs_readwritten: + if not(nf_write in tloadnode(p).flags) then + include(tloadnode(p).flags,nf_modify); + end; + break; + end; + callparan : + internalerror(200310081); + else + break; + end;{case } + end; + end; + + + procedure set_unique(p : tnode); + begin + while assigned(p) do + begin + case p.nodetype of + vecn: + begin + include(p.flags,nf_callunique); + break; + end; + typeconvn, + subscriptn, + derefn: + p:=tunarynode(p).left; + else + break; + end; + end; + end; + + + function valid_for_assign(p:tnode;opts:TValidAssigns; report_errors: boolean):boolean; + var + hp2, + hp : tnode; + gotstring, + gotsubscript, + gotrecord, + gotpointer, + gotvec, + gotclass, + gotdynarray, + gotderef, + gottypeconv : boolean; + fromdef, + todef : tdef; + errmsg, + temp : longint; + begin + if valid_const in opts then + errmsg:=type_e_variable_id_expected + else if valid_property in opts then + errmsg:=type_e_argument_cant_be_assigned + else + errmsg:=type_e_no_addr_of_constant; + result:=false; + gotsubscript:=false; + gotvec:=false; + gotderef:=false; + gotrecord:=false; + gotclass:=false; + gotpointer:=false; + gotdynarray:=false; + gotstring:=false; + gottypeconv:=false; + hp:=p; + if not(valid_void in opts) and + is_void(hp.resultdef) then + begin + if report_errors then + CGMessagePos(hp.fileinfo,errmsg); + exit; + end; + while assigned(hp) do + begin + { property allowed? calln has a property check itself } + if (nf_isproperty in hp.flags) then + begin + { check return type } + case hp.resultdef.typ of + pointerdef : + gotpointer:=true; + objectdef : + gotclass:=is_implicit_pointer_object_type(hp.resultdef); + recorddef : + gotrecord:=true; + classrefdef : + gotclass:=true; + stringdef : + gotstring:=true; + end; + if (valid_property in opts) then + begin + { don't allow writing to calls that will create + temps like calls that return a structure and we + are assigning to a member } + if (valid_const in opts) or + { if we got a deref, we won't modify the property itself } + (gotderef) or + { same when we got a class and subscript (= deref) } + (gotclass and gotsubscript) or + ( + { allowing assignments to typecasted properties + a) is Delphi-incompatible + b) causes problems in case the getter is a function + (because then the result of the getter is + typecasted to this type, and then we "assign" to + this typecasted function result) -> always + disallow, since property accessors should be + transparantly changeable to functions at all + times + } + not(gottypeconv) and + not(gotsubscript and gotrecord) and + not(gotstring and gotvec) + ) then + result:=true + else + if report_errors then + CGMessagePos(hp.fileinfo,errmsg); + end + else + begin + { 1. if it returns a pointer and we've found a deref, + 2. if it returns a class and a subscription or with is found + 3. if the address is needed of a field (subscriptn, vecn) } + if (gotpointer and gotderef) or + (gotstring and gotvec) or + (gotclass and gotsubscript) or + ( + (gotvec and gotdynarray) + ) or + ( + (Valid_Addr in opts) and + (hp.nodetype in [subscriptn,vecn]) + ) then + result:=true + else + if report_errors then + CGMessagePos(hp.fileinfo,errmsg); + end; + exit; + end; + case hp.nodetype of + temprefn : + begin + valid_for_assign := true; + exit; + end; + derefn : + begin + gotderef:=true; + hp:=tderefnode(hp).left; + end; + typeconvn : + begin + gottypeconv:=true; + { typecast sizes must match, exceptions: + - implicit typecast made by absolute + - from formaldef + - from void + - from/to open array + - typecast from pointer to array } + fromdef:=ttypeconvnode(hp).left.resultdef; + todef:=hp.resultdef; + if not((nf_absolute in ttypeconvnode(hp).flags) or + (fromdef.typ=formaldef) or + is_void(fromdef) or + is_open_array(fromdef) or + is_open_array(todef) or + ((fromdef.typ=pointerdef) and (todef.typ=arraydef)) or + ((fromdef.typ = objectdef) and (todef.typ = objectdef) and + (tobjectdef(fromdef).is_related(tobjectdef(todef))))) and + (fromdef.size<>todef.size) then + begin + { in TP it is allowed to typecast to smaller types. But the variable can't + be in a register } + if (m_tp7 in current_settings.modeswitches) or + (todef.size<fromdef.size) then + make_not_regable(hp,[ra_addr_regable]) + else + if report_errors then + CGMessagePos2(hp.fileinfo,type_e_typecast_wrong_size_for_assignment,tostr(fromdef.size),tostr(todef.size)); + end; + + { don't allow assignments to typeconvs that need special code } + if not(gotsubscript or gotvec or gotderef) and + not(ttypeconvnode(hp).assign_allowed) then + begin + if report_errors then + CGMessagePos(hp.fileinfo,errmsg); + exit; + end; + case hp.resultdef.typ of + pointerdef : + gotpointer:=true; + objectdef : + gotclass:=is_implicit_pointer_object_type(hp.resultdef); + classrefdef : + gotclass:=true; + arraydef : + begin + { pointer -> array conversion is done then we need to see it + as a deref, because a ^ is then not required anymore } + if (ttypeconvnode(hp).left.resultdef.typ=pointerdef) then + gotderef:=true; + end; + end; + hp:=ttypeconvnode(hp).left; + end; + vecn : + begin + if { only check for first (= outermost) vec node } + not gotvec and + not(valid_packed in opts) and + (tvecnode(hp).left.resultdef.typ = arraydef) and + (ado_IsBitPacked in tarraydef(tvecnode(hp).left.resultdef).arrayoptions) and + ((tarraydef(tvecnode(hp).left.resultdef).elepackedbitsize mod 8 <> 0) or + (is_ordinal(tarraydef(tvecnode(hp).left.resultdef).elementdef) and + not ispowerof2(tarraydef(tvecnode(hp).left.resultdef).elepackedbitsize div 8,temp))) then + begin + if report_errors then + if (valid_property in opts) then + CGMessagePos(hp.fileinfo,parser_e_packed_element_no_loop) + else + CGMessagePos(hp.fileinfo,parser_e_packed_element_no_var_addr); + exit; + end; + gotvec:=true; + { accesses to dyn. arrays override read only access in delphi } + if (m_delphi in current_settings.modeswitches) and is_dynamic_array(tunarynode(hp).left.resultdef) then + gotdynarray:=true; + hp:=tunarynode(hp).left; + end; + blockn : + begin + hp2:=tblocknode(hp).statements; + if assigned(hp2) then + begin + if hp2.nodetype<>statementn then + internalerror(2006110801); + while assigned(tstatementnode(hp2).next) do + hp2:=tstatementnode(hp2).next; + hp:=tstatementnode(hp2).statement; + end + else + begin + if report_errors then + CGMessagePos(hp.fileinfo,type_e_variable_id_expected); + exit; + end; + end; + asn : + begin + { asn can't be assigned directly, it returns the value in a register instead + of reference. } + if not(gotsubscript or gotderef or gotvec) then + begin + if report_errors then + CGMessagePos(hp.fileinfo,errmsg); + exit; + end; + hp:=tunarynode(hp).left; + end; + subscriptn : + begin + { only check first (= outermost) subscriptn } + if not gotsubscript and + not(valid_packed in opts) and + is_packed_record_or_object(tsubscriptnode(hp).left.resultdef) and + ((tsubscriptnode(hp).vs.fieldoffset mod 8 <> 0) or + (is_ordinal(tsubscriptnode(hp).resultdef) and + not ispowerof2(tsubscriptnode(hp).resultdef.packedbitsize div 8,temp))) then + begin + if report_errors then + if (valid_property in opts) then + CGMessagePos(hp.fileinfo,parser_e_packed_element_no_loop) + else + CGMessagePos(hp.fileinfo,parser_e_packed_element_no_var_addr); + exit; + end; + gotsubscript:=true; + { loop counter? } + if not(Valid_Const in opts) and + (vo_is_loop_counter in tsubscriptnode(hp).vs.varoptions) then + begin + if report_errors then + CGMessage1(parser_e_illegal_assignment_to_count_var,tsubscriptnode(hp).vs.realname); + exit; + end; + { implicit pointer object types result in dereferencing } + hp:=tsubscriptnode(hp).left; + if is_implicit_pointer_object_type(hp.resultdef) then + gotderef:=true; + end; + muln, + divn, + andn, + xorn, + orn, + notn, + subn, + addn : + begin + { Allow operators on a pointer, or an integer + and a pointer typecast and deref has been found } + if ((hp.resultdef.typ=pointerdef) or + (is_integer(hp.resultdef) and gotpointer)) and + gotderef then + result:=true + else + { Temp strings are stored in memory, for compatibility with + delphi only } + if (m_delphi in current_settings.modeswitches) and + ((valid_addr in opts) or + (valid_const in opts)) and + (hp.resultdef.typ=stringdef) then + result:=true + else + if report_errors then + CGMessagePos(hp.fileinfo,type_e_variable_id_expected); + exit; + end; + niln, + pointerconstn : + begin + { to support e.g. @tmypointer(0)^.data; see tests/tbs/tb0481 } + if gotderef then + result:=true + else + if report_errors then + CGMessagePos(hp.fileinfo,type_e_no_assign_to_addr); + exit; + end; + ordconstn, + realconstn : + begin + { these constants will be passed by value } + if report_errors then + CGMessagePos(hp.fileinfo,type_e_variable_id_expected); + exit; + end; + setconstn, + stringconstn, + guidconstn : + begin + { these constants will be passed by reference } + if valid_const in opts then + result:=true + else + if report_errors then + CGMessagePos(hp.fileinfo,type_e_variable_id_expected); + exit; + end; + addrn : + begin + if gotderef then + result:=true + else + if report_errors then + CGMessagePos(hp.fileinfo,type_e_no_assign_to_addr); + exit; + end; + calln : + begin + { check return type } + case hp.resultdef.typ of + arraydef : + begin + { dynamic arrays are allowed when there is also a + vec node } + if is_dynamic_array(hp.resultdef) and + gotvec then + begin + gotderef:=true; + gotpointer:=true; + end; + end; + pointerdef : + gotpointer:=true; + objectdef : + gotclass:=is_implicit_pointer_object_type(hp.resultdef); + recorddef, { handle record like class it needs a subscription } + classrefdef : + gotclass:=true; + stringdef : + gotstring:=true; + end; + { 1. if it returns a pointer and we've found a deref, + 2. if it returns a class or record and a subscription or with is found + 3. string is returned } + if (gotstring and gotvec) or + (gotpointer and gotderef) or + (gotclass and gotsubscript) then + result:=true + else + { Temp strings are stored in memory, for compatibility with + delphi only } + if (m_delphi in current_settings.modeswitches) and + (valid_addr in opts) and + (hp.resultdef.typ=stringdef) then + result:=true + else + if ([valid_const,valid_addr] * opts = [valid_const]) then + result:=true + else + if report_errors then + CGMessagePos(hp.fileinfo,errmsg); + exit; + end; + inlinen : + begin + if ((valid_const in opts) and + (tinlinenode(hp).inlinenumber in [in_typeof_x])) or + (tinlinenode(hp).inlinenumber in [in_unaligned_x]) then + result:=true + else + if report_errors then + CGMessagePos(hp.fileinfo,type_e_variable_id_expected); + exit; + end; + dataconstn: + begin + { only created internally, so no additional checks necessary } + result:=true; + exit; + end; + loadn : + begin + case tloadnode(hp).symtableentry.typ of + absolutevarsym, + staticvarsym, + localvarsym, + paravarsym : + begin + { loop counter? } + if not(Valid_Const in opts) and + not gotderef and + (vo_is_loop_counter in tabstractvarsym(tloadnode(hp).symtableentry).varoptions) then + begin + if report_errors then + CGMessage1(parser_e_illegal_assignment_to_count_var,tloadnode(hp).symtableentry.realname); + exit; + end; + { read-only variable? } + if (tabstractvarsym(tloadnode(hp).symtableentry).varspez in [vs_const,vs_constref]) then + begin + { allow p^:= constructions with p is const parameter } + if gotderef or gotdynarray or (Valid_Const in opts) or + (loadnf_isinternal_ignoreconst in tloadnode(hp).loadnodeflags) then + result:=true + else + if report_errors then + CGMessagePos(tloadnode(hp).fileinfo,type_e_no_assign_to_const); + exit; + end; + result:=true; + exit; + end; + procsym : + begin + if (Valid_Const in opts) then + result:=true + else + if report_errors then + CGMessagePos(hp.fileinfo,type_e_variable_id_expected); + exit; + end; + labelsym : + begin + if (Valid_Addr in opts) then + result:=true + else + if report_errors then + CGMessagePos(hp.fileinfo,type_e_variable_id_expected); + exit; + end; + constsym: + begin + if (tconstsym(tloadnode(hp).symtableentry).consttyp=constresourcestring) and + (valid_addr in opts) then + result:=true + else + if report_errors then + CGMessagePos(hp.fileinfo,type_e_variable_id_expected); + exit; + end; + else + begin + if report_errors then + CGMessagePos(hp.fileinfo,type_e_variable_id_expected); + exit; + end; + end; + end; + else + begin + if report_errors then + CGMessagePos(hp.fileinfo,type_e_variable_id_expected); + exit; + end; + end; + end; + end; + + + function valid_for_var(p:tnode; report_errors: boolean):boolean; + begin + valid_for_var:=valid_for_assign(p,[],report_errors); + end; + + + function valid_for_formal_var(p : tnode; report_errors: boolean) : boolean; + begin + valid_for_formal_var:=valid_for_assign(p,[valid_void],report_errors); + end; + + + function valid_for_formal_const(p : tnode; report_errors: boolean) : boolean; + begin + valid_for_formal_const:=(p.resultdef.typ=formaldef) or + valid_for_assign(p,[valid_void,valid_const,valid_property],report_errors); + end; + + + function valid_for_assignment(p:tnode; report_errors: boolean):boolean; + begin + valid_for_assignment:=valid_for_assign(p,[valid_property,valid_packed],report_errors); + end; + + + function valid_for_loopvar(p:tnode; report_errors: boolean):boolean; + begin + valid_for_loopvar:=valid_for_assign(p,[valid_property],report_errors); + end; + + + function valid_for_addr(p : tnode; report_errors: boolean) : boolean; + begin + result:=valid_for_assign(p,[valid_const,valid_addr,valid_void],report_errors); + end; + + + procedure var_para_allowed(var eq:tequaltype;def_from,def_to:Tdef; fromnode: tnode); + begin + { Note: eq must be already valid, it will only be updated! } + case def_to.typ of + formaldef : + begin + { all types can be passed to a formaldef, + but it is not the prefered way } + if not is_constnode(fromnode) then + eq:=te_convert_l2 + else + eq:=te_incompatible; + end; + orddef : + begin + { allows conversion from word to integer and + byte to shortint, but only for TP7 compatibility } + if (m_tp7 in current_settings.modeswitches) and + (def_from.typ=orddef) and + (def_from.size=def_to.size) then + eq:=te_convert_l1; + end; + arraydef : + begin + if is_open_array(def_to) then + begin + if is_dynamic_array(def_from) and + equal_defs(tarraydef(def_from).elementdef,tarraydef(def_to).elementdef) then + eq:=te_convert_l2 + else + if equal_defs(def_from,tarraydef(def_to).elementdef) then + eq:=te_convert_l3; + end; + end; + pointerdef : + begin + { an implicit pointer conversion is allowed } + if (def_from.typ=pointerdef) then + eq:=te_convert_l1; + end; + stringdef : + begin + { all shortstrings are allowed, size is not important } + if is_shortstring(def_from) and + is_shortstring(def_to) then + eq:=te_equal; + end; + objectdef : + begin + { child objects can be also passed } + { in non-delphi mode, otherwise } + { they must match exactly, except } + { if they are objects } + if (def_from.typ=objectdef) and + ( + (tobjectdef(def_from).objecttype=odt_object) and + (tobjectdef(def_to).objecttype=odt_object) + ) and + (tobjectdef(def_from).is_related(tobjectdef(def_to))) then + eq:=te_convert_l1; + end; + filedef : + begin + { an implicit file conversion is also allowed } + { from a typed file to an untyped one } + if (def_from.typ=filedef) and + (tfiledef(def_from).filetyp = ft_typed) and + (tfiledef(def_to).filetyp = ft_untyped) then + eq:=te_convert_l1; + end; + end; + end; + + + procedure para_allowed(var eq:tequaltype;p:tcallparanode;def_to:tdef); + var + acn: tarrayconstructornode; + realprocdef: tprocdef; + tmpeq: tequaltype; + begin + { Note: eq must be already valid, it will only be updated! } + case def_to.typ of + formaldef : + begin + { all types can be passed to a formaldef } + eq:=te_equal; + end; + stringdef : + begin + { to support ansi/long/wide strings in a proper way } + { string and string[10] are assumed as equal } + { when searching the correct overloaded procedure } + if (p.resultdef.typ=stringdef) and + (tstringdef(def_to).stringtype=tstringdef(p.resultdef).stringtype) then + eq:=te_equal + else + { Passing a constant char to ansistring or shortstring or + a widechar to widestring then handle it as equal. } + if (p.left.nodetype=ordconstn) and + ( + is_char(p.resultdef) and + (is_shortstring(def_to) or is_ansistring(def_to)) + ) or + ( + is_widechar(p.resultdef) and + (is_widestring(def_to) or is_unicodestring(def_to)) + ) then + eq:=te_equal + end; + setdef : + begin + { set can also be a not yet converted array constructor } + if (p.resultdef.typ=arraydef) and + is_array_constructor(p.resultdef) and + not is_variant_array(p.resultdef) then + eq:=te_equal; + end; + procvardef : + begin + tmpeq:=te_incompatible; + { in tp/macpas mode proc -> procvar is allowed } + if ((m_tp_procvar in current_settings.modeswitches) or + (m_mac_procvar in current_settings.modeswitches)) and + (p.left.nodetype=calln) then + tmpeq:=proc_to_procvar_equal(tprocdef(tcallnode(p.left).procdefinition),tprocvardef(def_to),false); + if (tmpeq=te_incompatible) and + (m_nested_procvars in current_settings.modeswitches) and + is_proc2procvar_load(p.left,realprocdef) then + tmpeq:=proc_to_procvar_equal(realprocdef,tprocvardef(def_to),false); + if (tmpeq=te_incompatible) and + (m_mac in current_settings.modeswitches) and + is_ambiguous_funcret_load(p.left,realprocdef) then + tmpeq:=proc_to_procvar_equal(realprocdef,tprocvardef(def_to),false); + if tmpeq<>te_incompatible then + eq:=tmpeq; + end; + arraydef : + begin + { an arrayconstructor of proccalls may have to be converted to + an array of procvars } + if ((m_tp_procvar in current_settings.modeswitches) or + (m_mac_procvar in current_settings.modeswitches)) and + (tarraydef(def_to).elementdef.typ=procvardef) and + is_array_constructor(p.resultdef) and + not is_variant_array(p.resultdef) then + begin + acn:=tarrayconstructornode(p.left); + if assigned(acn.left) then + begin + eq:=te_exact; + while assigned(acn) and + (eq<>te_incompatible) do + begin + if (acn.left.nodetype=calln) then + tmpeq:=proc_to_procvar_equal(tprocdef(tcallnode(acn.left).procdefinition),tprocvardef(tarraydef(def_to).elementdef),false) + else + tmpeq:=compare_defs(acn.left.resultdef,tarraydef(def_to).elementdef,acn.left.nodetype); + if tmpeq<eq then + eq:=tmpeq; + acn:=tarrayconstructornode(acn.right); + end; + end + end; + end; + end; + end; + + + function allowenumop(nt:tnodetype):boolean; + begin + result:=(nt in [equaln,unequaln,ltn,lten,gtn,gten]) or + ((cs_allow_enum_calc in current_settings.localswitches) and + (nt in [addn,subn])); + end; + + +{**************************************************************************** + TCallCandidates +****************************************************************************} + + constructor tcallcandidates.create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean); + begin + if not assigned(sym) then + internalerror(200411015); + FOperator:=NOTOKEN; + FProcsym:=sym; + FProcsymtable:=st; + FParanode:=ppn; + create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited); + end; + + + constructor tcallcandidates.create_operator(op:ttoken;ppn:tnode); + begin + FOperator:=op; + FProcsym:=nil; + FProcsymtable:=nil; + FParanode:=ppn; + create_candidate_list(false,false,false,false,false,false); + end; + + + destructor tcallcandidates.destroy; + var + hpnext, + hp : pcandidate; + begin + hp:=FCandidateProcs; + while assigned(hp) do + begin + hpnext:=hp^.next; + dispose(hp); + hp:=hpnext; + end; + end; + + + procedure tcallcandidates.collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;searchhelpers,anoninherited:boolean); + + function processprocsym(srsym:tprocsym; out foundanything: boolean):boolean; + var + j : integer; + pd : tprocdef; + begin + { add all definitions } + result:=false; + foundanything:=false; + for j:=0 to srsym.ProcdefList.Count-1 do + begin + pd:=tprocdef(srsym.ProcdefList[j]); + { in case of anonymous inherited, only match procdefs identical + to the current one (apart from hidden parameters), rather than + anything compatible to the parameters -- except in case of + the presence of a messagestr/int, in which case those have to + match exactly } + if anoninherited then + if po_msgint in current_procinfo.procdef.procoptions then + begin + if not(po_msgint in pd.procoptions) or + (pd.messageinf.i<>current_procinfo.procdef.messageinf.i) then + continue + end + else if po_msgstr in current_procinfo.procdef.procoptions then + begin + if not(po_msgstr in pd.procoptions) or + (pd.messageinf.str^<>current_procinfo.procdef.messageinf.str^) then + continue + end + else if (compare_paras(current_procinfo.procdef.paras,pd.paras,cp_all,[cpo_ignorehidden])<te_equal) then + continue; + foundanything:=true; + { Store first procsym found } + if not assigned(FProcsym) then + FProcsym:=tprocsym(srsym); + if po_overload in pd.procoptions then + result:=true; + ProcdefOverloadList.Add(srsym.ProcdefList[j]); + end; + end; + + var + srsym : tsym; + hashedid : THashedIDString; + hasoverload, + foundanything : boolean; + helperdef : tobjectdef; + begin + if FOperator=NOTOKEN then + hashedid.id:=FProcsym.name + else + hashedid.id:=overloaded_names[FOperator]; + hasoverload:=false; + while assigned(structdef) do + begin + { first search in helpers for this type } + if (is_class(structdef) or is_record(structdef)) + and searchhelpers then + begin + if search_last_objectpascal_helper(structdef,nil,helperdef) then + begin + srsym:=nil; + while assigned(helperdef) do + begin + srsym:=tsym(helperdef.symtable.FindWithHash(hashedid)); + if assigned(srsym) and + { Delphi allows hiding a property by a procedure with the same name } + (srsym.typ=procsym) then + begin + hasoverload:=processprocsym(tprocsym(srsym),foundanything); + { when there is no explicit overload we stop searching } + if foundanything and + not hasoverload then + break; + end; + helperdef:=helperdef.childof; + end; + if not hasoverload and assigned(srsym) then + exit; + end; + end; + { now search in the type itself } + srsym:=tprocsym(structdef.symtable.FindWithHash(hashedid)); + if assigned(srsym) and + { Delphi allows hiding a property by a procedure with the same name } + (srsym.typ=procsym) then + begin + hasoverload:=processprocsym(tprocsym(srsym),foundanything); + { when there is no explicit overload we stop searching } + if foundanything and + not hasoverload then + break; + end; + if is_objectpascal_helper(structdef) and + (tobjectdef(structdef).typ in [recorddef,objectdef]) then + begin + { search methods in the extended type as well } + srsym:=tprocsym(tabstractrecorddef(tobjectdef(structdef).extendeddef).symtable.FindWithHash(hashedid)); + if assigned(srsym) and + { Delphi allows hiding a property by a procedure with the same name } + (srsym.typ=procsym) then + begin + hasoverload:=processprocsym(tprocsym(srsym),foundanything); + { when there is no explicit overload we stop searching } + if foundanything and + not hasoverload then + break; + end; + end; + { next parent } + if (structdef.typ=objectdef) then + structdef:=tobjectdef(structdef).childof + else + structdef:=nil; + end; + end; + + + procedure tcallcandidates.collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; objcidcall,explicitunit: boolean); + var + j : integer; + pd : tprocdef; + srsymtable : TSymtable; + srsym : tsym; + checkstack : psymtablestackitem; + hashedid : THashedIDString; + hasoverload : boolean; + begin + { we search all overloaded operator definitions in the symtablestack. The found + entries are only added to the procs list and not the procsym, because + the list can change in every situation } + if FOperator=NOTOKEN then + begin + if not objcidcall then + hashedid.id:=FProcsym.name + else + hashedid.id:=class_helper_prefix+FProcsym.name; + end + else + hashedid.id:=overloaded_names[FOperator]; + + checkstack:=symtablestack.stack; + if assigned(FProcsymtable) then + begin + while assigned(checkstack) and + (checkstack^.symtable<>FProcsymtable) do + checkstack:=checkstack^.next; + end; + while assigned(checkstack) do + begin + srsymtable:=checkstack^.symtable; + { if the unit in which the routine has to be searched has been + specified explicitly, stop searching after its symtable(s) have + been checked (can be both the static and the global symtable + in case it's the current unit itself) } + if explicitunit and + (FProcsymtable.symtabletype in [globalsymtable,staticsymtable]) and + (srsymtable.moduleid<>FProcsymtable.moduleid) then + break; + if srsymtable.symtabletype in [localsymtable,staticsymtable,globalsymtable] then + begin + srsym:=tsym(srsymtable.FindWithHash(hashedid)); + if assigned(srsym) and + (srsym.typ=procsym) then + begin + { Store first procsym found } + if not assigned(FProcsym) then + FProcsym:=tprocsym(srsym); + { add all definitions } + hasoverload:=false; + for j:=0 to tprocsym(srsym).ProcdefList.Count-1 do + begin + pd:=tprocdef(tprocsym(srsym).ProcdefList[j]); + if po_overload in pd.procoptions then + hasoverload:=true; + ProcdefOverloadList.Add(tprocsym(srsym).ProcdefList[j]); + end; + { when there is no explicit overload we stop searching, + except for Objective-C methods called via id } + if not hasoverload and + not objcidcall then + break; + end; + end; + checkstack:=checkstack^.next + end; + end; + + + procedure tcallcandidates.create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers,anoninherited:boolean); + var + j : integer; + pd : tprocdef; + hp : pcandidate; + pt : tcallparanode; + found : boolean; + st : TSymtable; + contextstructdef : tabstractrecorddef; + ProcdefOverloadList : TFPObjectList; + cpoptions : tcompare_paras_options; + begin + FCandidateProcs:=nil; + + { Find all available overloads for this procsym } + ProcdefOverloadList:=TFPObjectList.Create(false); + if not objcidcall and + (FOperator=NOTOKEN) and + (FProcsym.owner.symtabletype in [objectsymtable,recordsymtable]) then + collect_overloads_in_struct(tabstractrecorddef(FProcsym.owner.defowner),ProcdefOverloadList,searchhelpers,anoninherited) + else + if (FOperator<>NOTOKEN) then + begin + { check operands and if they contain records then search in records, + then search in unit } + pt:=tcallparanode(FParaNode); + while assigned(pt) do + begin + if (pt.resultdef.typ=recorddef) then + collect_overloads_in_struct(tabstractrecorddef(pt.resultdef),ProcdefOverloadList,searchhelpers,anoninherited); + pt:=tcallparanode(pt.right); + end; + collect_overloads_in_units(ProcdefOverloadList,objcidcall,explicitunit); + end + else + collect_overloads_in_units(ProcdefOverloadList,objcidcall,explicitunit); + + { determine length of parameter list. + for operators also enable the variant-operators if + a variant parameter is passed } + FParalength:=0; + FAllowVariant:=(FOperator=NOTOKEN); + pt:=tcallparanode(FParaNode); + while assigned(pt) do + begin + if (pt.resultdef.typ=variantdef) then + FAllowVariant:=true; + inc(FParalength); + pt:=tcallparanode(pt.right); + end; + + { when the class passed is defined in this unit we + need to use the scope of that class. This is a trick + that can be used to access protected members in other + units. At least kylix supports it this way (PFV) } + if assigned(FProcSymtable) and + ( + (FProcSymtable.symtabletype in [ObjectSymtable,recordsymtable]) or + ((FProcSymtable.symtabletype=withsymtable) and + (FProcSymtable.defowner.typ in [objectdef,recorddef])) + ) and + (FProcSymtable.defowner.owner.symtabletype in [globalsymtable,staticsymtable,objectsymtable,recordsymtable]) and + FProcSymtable.defowner.owner.iscurrentunit then + contextstructdef:=tabstractrecorddef(FProcSymtable.defowner) + else + contextstructdef:=current_structdef; + + { symtable is needed later to calculate the distance } + if assigned(FProcsym) then + st:=FProcsym.Owner + else + st:=nil; + { Process all found overloads } + for j:=0 to ProcdefOverloadList.Count-1 do + begin + pd:=tprocdef(ProcdefOverloadList[j]); + + { only when the # of parameter are supported by the procedure and + it is visible } + if (FParalength>=pd.minparacount) and + ( + ( + allowdefaultparas and + ( + (FParalength<=pd.maxparacount) or + (po_varargs in pd.procoptions) + ) + ) or + ( + not allowdefaultparas and + (FParalength=pd.maxparacount) + ) + ) and + ( + ignorevisibility or + not (pd.owner.symtabletype in [objectsymtable,recordsymtable]) or + is_visible_for_object(pd,contextstructdef) + ) then + begin + { don't add duplicates, only compare visible parameters for the user } + cpoptions:=[cpo_ignorehidden]; + if (po_compilerproc in pd.procoptions) then + cpoptions:=cpoptions+[cpo_compilerproc]; + if (po_rtlproc in pd.procoptions) then + cpoptions:=cpoptions+[cpo_rtlproc]; + found:=false; + hp:=FCandidateProcs; + while assigned(hp) do + begin + if (compare_paras(hp^.data.paras,pd.paras,cp_value_equal_const,cpoptions)>=te_equal) and + (not(po_objc in pd.procoptions) or + (pd.messageinf.str^=hp^.data.messageinf.str^)) then + begin + found:=true; + break; + end; + hp:=hp^.next; + end; + if not found then + proc_add(st,pd,objcidcall); + end; + end; + + ProcdefOverloadList.Free; + end; + + + function tcallcandidates.proc_add(st:tsymtable;pd:tprocdef;objcidcall: boolean):pcandidate; + var + defaultparacnt : integer; + begin + { generate new candidate entry } + new(result); + fillchar(result^,sizeof(tcandidate),0); + result^.data:=pd; + result^.next:=FCandidateProcs; + FCandidateProcs:=result; + inc(FProccnt); + { Find last parameter, skip all default parameters + that are not passed. Ignore this skipping for varargs } + result^.firstparaidx:=pd.paras.count-1; + if not(po_varargs in pd.procoptions) then + begin + { ignore hidden parameters } + while (result^.firstparaidx>=0) and (vo_is_hidden_para in tparavarsym(pd.paras[result^.firstparaidx]).varoptions) do + dec(result^.firstparaidx); + defaultparacnt:=pd.maxparacount-FParalength; + if defaultparacnt>0 then + begin + if defaultparacnt>result^.firstparaidx+1 then + internalerror(200401141); + dec(result^.firstparaidx,defaultparacnt); + end; + end; + { Give a small penalty for overloaded methods not in + defined the current class/unit } + { when calling Objective-C methods via id.method, then the found + procsym will be inside an arbitrary ObjectSymtable, and we don't + want togive the methods of that particular objcclass precedence over + other methods, so instead check against the symtable in which this + objcclass is defined } + if objcidcall then + st:=st.defowner.owner; + if (st<>pd.owner) then + result^.ordinal_distance:=result^.ordinal_distance+1.0; + end; + + + procedure tcallcandidates.list(all:boolean); + var + hp : pcandidate; + begin + hp:=FCandidateProcs; + while assigned(hp) do + begin + if all or + (not hp^.invalid) then + MessagePos1(hp^.data.fileinfo,sym_h_param_list,hp^.data.fullprocname(false)); + hp:=hp^.next; + end; + end; + + +{$ifdef EXTDEBUG} + procedure tcallcandidates.dump_info(lvl:longint); + + function ParaTreeStr(p:tcallparanode):string; + begin + result:=''; + while assigned(p) do + begin + if result<>'' then + result:=','+result; + result:=p.resultdef.typename+result; + p:=tcallparanode(p.right); + end; + end; + + var + hp : pcandidate; + i : integer; + currpara : tparavarsym; + begin + if not CheckVerbosity(lvl) then + exit; + Comment(lvl+V_LineInfo,'Overloaded callnode: '+FProcsym.name+'('+ParaTreeStr(tcallparanode(FParaNode))+')'); + hp:=FCandidateProcs; + while assigned(hp) do + begin + Comment(lvl,' '+hp^.data.fullprocname(false)); + if (hp^.invalid) then + Comment(lvl,' invalid') + else + begin + Comment(lvl,' ex: '+tostr(hp^.exact_count)+ + ' eq: '+tostr(hp^.equal_count)+ + ' l1: '+tostr(hp^.cl1_count)+ + ' l2: '+tostr(hp^.cl2_count)+ + ' l3: '+tostr(hp^.cl3_count)+ + ' l4: '+tostr(hp^.cl4_count)+ + ' l5: '+tostr(hp^.cl5_count)+ + ' oper: '+tostr(hp^.coper_count)+ + ' ord: '+realtostr(hp^.ordinal_distance)); + { Print parameters in left-right order } + for i:=0 to hp^.data.paras.count-1 do + begin + currpara:=tparavarsym(hp^.data.paras[i]); + if not(vo_is_hidden_para in currpara.varoptions) then + Comment(lvl,' - '+currpara.vardef.typename+' : '+EqualTypeName[currpara.eqval]); + end; + end; + hp:=hp^.next; + end; + end; +{$endif EXTDEBUG} + + + procedure tcallcandidates.get_information; + var + hp : pcandidate; + currpara : tparavarsym; + paraidx : integer; + currparanr : byte; + rfh,rth : double; + objdef : tobjectdef; + def_from, + def_to : tdef; + currpt, + pt : tcallparanode; + eq : tequaltype; + convtype : tconverttype; + pdtemp, + pdoper : tprocdef; + releasecurrpt : boolean; + cdoptions : tcompare_defs_options; + n : tnode; + + {$push} + {$r-} + {$q-} + const + inf=1.0/0.0; + {$pop} + begin + cdoptions:=[cdo_check_operator]; + if FAllowVariant then + include(cdoptions,cdo_allow_variant); + { process all procs } + hp:=FCandidateProcs; + while assigned(hp) do + begin + { We compare parameters in reverse order (right to left), + the firstpara is already pointing to the last parameter + were we need to start comparing } + currparanr:=FParalength; + paraidx:=hp^.firstparaidx; + while (paraidx>=0) and (vo_is_hidden_para in tparavarsym(hp^.data.paras[paraidx]).varoptions) do + dec(paraidx); + pt:=tcallparanode(FParaNode); + while assigned(pt) and (paraidx>=0) do + begin + currpara:=tparavarsym(hp^.data.paras[paraidx]); + { currpt can be changed from loadn to calln when a procvar + is passed. This is to prevent that the change is permanent } + currpt:=pt; + releasecurrpt:=false; + { retrieve current parameter definitions to compares } + eq:=te_incompatible; + def_from:=currpt.resultdef; + def_to:=currpara.vardef; + if not(assigned(def_from)) then + internalerror(200212091); + if not( + assigned(def_to) or + ((po_varargs in hp^.data.procoptions) and + (currparanr>hp^.data.minparacount)) + ) then + internalerror(200212092); + + { Convert tp procvars when not expecting a procvar } + if (currpt.left.resultdef.typ=procvardef) and + not(def_to.typ in [procvardef,formaldef]) and + { Only convert to call when there is no overload or the return type + is equal to the expected type. } + ( + (count=1) or + equal_defs(tprocvardef(currpt.left.resultdef).returndef,def_to) + ) then + begin + releasecurrpt:=true; + currpt:=tcallparanode(pt.getcopy); + if maybe_call_procvar(currpt.left,true) then + begin + currpt.resultdef:=currpt.left.resultdef; + def_from:=currpt.left.resultdef; + end; + end; + + { If we expect a procvar and the left is loadnode that + returns a procdef we need to find the correct overloaded + procdef that matches the expected procvar. The loadnode + temporary returned the first procdef (PFV) } + if (def_to.typ=procvardef) and + (currpt.left.nodetype=loadn) and + (currpt.left.resultdef.typ=procdef) then + begin + pdtemp:=tprocsym(Tloadnode(currpt.left).symtableentry).Find_procdef_byprocvardef(Tprocvardef(def_to)); + if assigned(pdtemp) then + begin + tloadnode(currpt.left).setprocdef(pdtemp); + currpt.resultdef:=currpt.left.resultdef; + def_from:=currpt.left.resultdef; + end; + end; + + { varargs are always equal, but not exact } + if (po_varargs in hp^.data.procoptions) and + (currparanr>hp^.data.minparacount) and + not is_array_of_const(def_from) and + not is_array_constructor(def_from) then + eq:=te_equal + else + { same definition -> exact } + if (def_from=def_to) then + eq:=te_exact + else + { for value and const parameters check if a integer is constant or + included in other integer -> equal and calc ordinal_distance } + if not(currpara.varspez in [vs_var,vs_out]) and + is_integer(def_from) and + is_integer(def_to) and + is_in_limit(def_from,def_to) then + begin + eq:=te_equal; + hp^.ordinal_distance:=hp^.ordinal_distance+ + abs(bestreal(torddef(def_from).low)-bestreal(torddef(def_to).low)); + rth:=bestreal(torddef(def_to).high); + rfh:=bestreal(torddef(def_from).high); + hp^.ordinal_distance:=hp^.ordinal_distance+abs(rth-rfh); + { Give wrong sign a small penalty, this is need to get a diffrence + from word->[longword,longint] } + if is_signed(def_from)<>is_signed(def_to) then +{$push} +{$r-} +{$q-} + hp^.ordinal_distance:=nextafter(hp^.ordinal_distance,inf); +{$pop} + end + else + { for value and const parameters check precision of real, give + penalty for loosing of precision. var and out parameters must match exactly } + if not(currpara.varspez in [vs_var,vs_out]) and + is_real(def_from) and + is_real(def_to) then + begin + eq:=te_equal; + if is_extended(def_to) then + rth:=4 + else + if is_double (def_to) then + rth:=2 + else + rth:=1; + if is_extended(def_from) then + rfh:=4 + else + if is_double (def_from) then + rfh:=2 + else + rfh:=1; + { penalty for shrinking of precision } + if rth<rfh then + rfh:=(rfh-rth)*16 + else + rfh:=rth-rfh; + hp^.ordinal_distance:=hp^.ordinal_distance+rfh; + end + else + { related object parameters also need to determine the distance between the current + object and the object we are comparing with. var and out parameters must match exactly } + if not(currpara.varspez in [vs_var,vs_out]) and + (def_from.typ=objectdef) and + (def_to.typ=objectdef) and + (tobjectdef(def_from).objecttype=tobjectdef(def_to).objecttype) and + tobjectdef(def_from).is_related(tobjectdef(def_to)) then + begin + eq:=te_convert_l1; + objdef:=tobjectdef(def_from); + while assigned(objdef) do + begin + if objdef=def_to then + break; + hp^.ordinal_distance:=hp^.ordinal_distance+1; + objdef:=objdef.childof; + end; + end + { compare_defs_ext compares sets and array constructors very poorly because + it has too little information. So we do explicitly a detailed comparisation, + see also bug #11288 (FK) + } + else if (def_to.typ=setdef) and is_array_constructor(currpt.left.resultdef) then + begin + n:=currpt.left.getcopy; + arrayconstructor_to_set(n); + eq:=compare_defs_ext(n.resultdef,def_to,n.nodetype,convtype,pdoper,cdoptions); + n.free; + end + else + { generic type comparision } + begin + if not(po_compilerproc in hp^.data.procoptions) and + not(po_rtlproc in hp^.data.procoptions) and + is_ansistring(currpara.vardef) and + is_ansistring(currpt.left.resultdef) and + (tstringdef(currpara.vardef).encoding<>tstringdef(currpt.left.resultdef).encoding) and + ((tstringdef(currpara.vardef).encoding=globals.CP_NONE) or + (tstringdef(currpt.left.resultdef).encoding=globals.CP_NONE) + ) then + eq:=te_convert_l1 + else + eq:=compare_defs_ext(def_from,def_to,currpt.left.nodetype,convtype,pdoper,cdoptions); + + { when the types are not equal we need to check + some special case for parameter passing } + if (eq<te_equal) then + begin + if currpara.varspez in [vs_var,vs_out] then + begin + { para requires an equal type so the previous found + match was not good enough, reset to incompatible } + eq:=te_incompatible; + { var_para_allowed will return te_equal and te_convert_l1 to + make a difference for best matching } + var_para_allowed(eq,currpt.resultdef,currpara.vardef,currpt.left) + end + else + para_allowed(eq,currpt,def_to); + end; + end; + + { univ parameters match if the size matches (don't override the + comparison result if it was ok, since a match based on the + "univ" character is the lowest possible match) } + if (eq=te_incompatible) and + currpara.univpara and + is_valid_univ_para_type(def_from) and + (def_from.size=def_to.size) then + eq:=te_convert_l5; + + { when a procvar was changed to a call an exact match is + downgraded to equal. This way an overload call with the + procvar is choosen. See tb0471 (PFV) } + if (pt<>currpt) and (eq=te_exact) then + eq:=te_equal; + + { increase correct counter } + case eq of + te_exact : + inc(hp^.exact_count); + te_equal : + inc(hp^.equal_count); + te_convert_l1 : + inc(hp^.cl1_count); + te_convert_l2 : + inc(hp^.cl2_count); + te_convert_l3 : + inc(hp^.cl3_count); + te_convert_l4 : + inc(hp^.cl4_count); + te_convert_l5 : + inc(hp^.cl5_count); + te_convert_operator : + inc(hp^.coper_count); + te_incompatible : + hp^.invalid:=true; + else + internalerror(200212072); + end; + + { stop checking when an incompatible parameter is found } + if hp^.invalid then + begin + { store the current parameter info for + a nice error message when no procedure is found } + hp^.wrongparaidx:=paraidx; + hp^.wrongparanr:=currparanr; + break; + end; + +{$ifdef EXTDEBUG} + { store equal in node tree for dump } + currpara.eqval:=eq; +{$endif EXTDEBUG} + + { maybe release temp currpt } + if releasecurrpt then + currpt.free; + + { next parameter in the call tree } + pt:=tcallparanode(pt.right); + + { next parameter for definition, only goto next para + if we're out of the varargs } + if not(po_varargs in hp^.data.procoptions) or + (currparanr<=hp^.data.maxparacount) then + begin + { Ignore vs_hidden parameters } + repeat + dec(paraidx); + until (paraidx<0) or not(vo_is_hidden_para in tparavarsym(hp^.data.paras[paraidx]).varoptions); + end; + dec(currparanr); + end; + if not(hp^.invalid) and + (assigned(pt) or (paraidx>=0) or (currparanr<>0)) then + internalerror(200212141); + { next candidate } + hp:=hp^.next; + end; + end; + + + function get_variantequaltype(def: tdef): tvariantequaltype; + const + variantorddef_cl: array[tordtype] of tvariantequaltype = + (tve_incompatible,tve_byte,tve_word,tve_cardinal,tve_chari64, + tve_shortint,tve_smallint,tve_longint,tve_chari64, + tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal, + tve_boolformal,tve_boolformal,tve_boolformal,tve_boolformal, + tve_chari64,tve_chari64,tve_dblcurrency); +{ TODO: fixme for 128 bit floats } + variantfloatdef_cl: array[tfloattype] of tvariantequaltype = + (tve_single,tve_dblcurrency,tve_extended,tve_extended, + tve_dblcurrency,tve_dblcurrency,tve_extended); + variantstringdef_cl: array[tstringtype] of tvariantequaltype = + (tve_sstring,tve_astring,tve_astring,tve_wstring,tve_ustring); + begin + case def.typ of + orddef: + begin + result:=variantorddef_cl[torddef(def).ordtype]; + end; + floatdef: + begin + result:=variantfloatdef_cl[tfloatdef(def).floattype]; + end; + stringdef: + begin + result:=variantstringdef_cl[tstringdef(def).stringtype]; + end; + formaldef: + begin + result:=tve_boolformal; + end; + else + begin + result:=tve_incompatible; + end; + end + end; + + + function is_better_candidate(currpd,bestpd:pcandidate):integer; + var + res : integer; + begin + { + Return values: + > 0 when currpd is better than bestpd + < 0 when bestpd is better than currpd + = 0 when both are equal + + To choose the best candidate we use the following order: + - Incompatible flag + - (Smaller) Number of convert operator parameters. + - (Smaller) Number of convertlevel 2 parameters. + - (Smaller) Number of convertlevel 1 parameters. + - (Bigger) Number of exact parameters. + - (Smaller) Number of equal parameters. + - (Smaller) Total of ordinal distance. For example, the distance of a word + to a byte is 65535-255=65280. + } + if bestpd^.invalid then + begin + if currpd^.invalid then + res:=0 + else + res:=1; + end + else + if currpd^.invalid then + res:=-1 + else + begin + { less operator parameters? } + res:=(bestpd^.coper_count-currpd^.coper_count); + if (res=0) then + begin + { less cl5 parameters? } + res:=(bestpd^.cl5_count-currpd^.cl5_count); + if (res=0) then + begin + { less cl4 parameters? } + res:=(bestpd^.cl4_count-currpd^.cl4_count); + if (res=0) then + begin + { less cl3 parameters? } + res:=(bestpd^.cl3_count-currpd^.cl3_count); + if (res=0) then + begin + { less cl2 parameters? } + res:=(bestpd^.cl2_count-currpd^.cl2_count); + if (res=0) then + begin + { less cl1 parameters? } + res:=(bestpd^.cl1_count-currpd^.cl1_count); + if (res=0) then + begin + { more exact parameters? } + res:=(currpd^.exact_count-bestpd^.exact_count); + if (res=0) then + begin + { less equal parameters? } + res:=(bestpd^.equal_count-currpd^.equal_count); + if (res=0) then + begin + { smaller ordinal distance? } + if (currpd^.ordinal_distance<bestpd^.ordinal_distance) then + res:=1 + else + if (currpd^.ordinal_distance>bestpd^.ordinal_distance) then + res:=-1 + else + res:=0; + end; + end; + end; + end; + end; + end; + end; + end; + end; + is_better_candidate:=res; + end; + + +{ Delphi precedence rules extracted from test programs. Only valid if passing + a variant parameter to overloaded procedures expecting exactly one parameter. + + single > (char, currency, int64, shortstring, ansistring, widestring, extended, double) + double/currency > (char, int64, shortstring, ansistring, widestring, extended) + extended > (char, int64, shortstring, ansistring, widestring) + longint/cardinal > (int64, shortstring, ansistring, widestring, extended, double, single, char, currency) + smallint > (longint, int64, shortstring, ansistring, widestring, extended, double single, char, currency); + word > (longint, cardinal, int64, shortstring, ansistring, widestring, extended, double single, char, currency); + shortint > (longint, smallint, int64, shortstring, ansistring, widestring, extended, double, single, char, currency) + byte > (longint, cardinal, word, smallint, int64, shortstring, ansistring, widestring, extended, double, single, char, currency); + boolean/formal > (char, int64, shortstring, ansistring, widestring) + shortstring > (char, int64, ansistring, widestring) + ansistring > (char, int64, widestring) + widestring > (char, int64) + + Relations not mentioned mean that they conflict: no decision possible } + + function is_better_candidate_single_variant(currpd,bestpd:pcandidate):integer; + + function calculate_relation(const currvcl, bestvcl, testvcl: + tvariantequaltype; const conflictvcls: tvariantequaltypes):integer; + begin + { if (bestvcl=conflictvcl) or + (currvcl=conflictvcl) then + result:=0 + else if (bestvcl=testvcl) then + result:=-1 + else result:=1 } + result:=1-2*ord(bestvcl=testvcl)+ + ord(currvcl in conflictvcls)-ord(bestvcl in conflictvcls); + end; + + + function getfirstrealparaidx(pd: pcandidate): integer; + begin + { can be different for currpd and bestpd in case of overloaded } + { functions, e.g. lowercase():char and lowercase():shortstring } + { (depending on the calling convention and parameter order) } + result:=pd^.firstparaidx; + while (result>=0) and (vo_is_hidden_para in tparavarsym(pd^.data.paras[result]).varoptions) do + dec(result); + if (vo_is_hidden_para in tparavarsym(pd^.data.paras[result]).varoptions) then + internalerror(2006122803); + end; + + var + currpara, bestpara: tparavarsym; + currvcl, bestvcl: tvariantequaltype; + begin + { + Return values: + > 0 when currpd is better than bestpd + < 0 when bestpd is better than currpd + = 0 when both are equal + } + currpara:=tparavarsym(currpd^.data.paras[getfirstrealparaidx(currpd)]); + bestpara:=tparavarsym(bestpd^.data.paras[getfirstrealparaidx(bestpd)]); + + { if one of the parameters is a regular variant, fall back to the } + { default algorithm } + if (currpara.vardef.typ = variantdef) or + (bestpara.vardef.typ = variantdef) then + begin + result:=is_better_candidate(currpd,bestpd); + exit; + end; + + currvcl:=get_variantequaltype(currpara.vardef); + bestvcl:=get_variantequaltype(bestpara.vardef); + + { sanity check } + result:=-5; + + { if both are the same, there is a conflict } + if (currvcl=bestvcl) then + result:=0 + { if one of the two cannot be used as variant, the other is better } + else if (bestvcl=tve_incompatible) then + result:=1 + else if (currvcl=tve_incompatible) then + result:=-1 + { boolean and formal are better than chari64str, but conflict with } + { everything else } + else if (currvcl=tve_boolformal) or + (bestvcl=tve_boolformal) then + if (currvcl=tve_boolformal) then + result:=ord(bestvcl in [tve_chari64,tve_sstring,tve_astring,tve_wstring,tve_ustring]) + else + result:=-ord(currvcl in [tve_chari64,tve_sstring,tve_astring,tve_wstring,tve_ustring]) + { byte is better than everything else (we assume both aren't byte, } + { since there's only one parameter and that one can't be the same) } + else if (currvcl=tve_byte) or + (bestvcl=tve_byte) then + result:=calculate_relation(currvcl,bestvcl,tve_byte,[tve_shortint]) + { shortint conflicts with word and cardinal, but is better than } + { everything else but byte (which has already been handled) } + else if (currvcl=tve_shortint) or + (bestvcl=tve_shortint) then + result:=calculate_relation(currvcl,bestvcl,tve_shortint,[tve_word, tve_cardinal]) + { word conflicts with smallint, but is better than everything else } + { but shortint and byte (which has already been handled) } + else if (currvcl=tve_word) or + (bestvcl=tve_word) then + result:=calculate_relation(currvcl,bestvcl,tve_word,[tve_smallint]) + { smallint conflicts with cardinal, but is better than everything } + { which has not yet been tested } + else if (currvcl=tve_smallint) or + (bestvcl=tve_smallint) then + result:=calculate_relation(currvcl,bestvcl,tve_smallint,[tve_cardinal]) + { cardinal conflicts with each longint and is better than everything } + { which has not yet been tested } + else if (currvcl=tve_cardinal) or + (bestvcl=tve_cardinal) then + result:=calculate_relation(currvcl,bestvcl,tve_cardinal,[tve_longint]) + { longint is better than everything which has not yet been tested } + else if (currvcl=tve_longint) or + (bestvcl=tve_longint) then + { if bestvcl=tve_longint then + result:=-1 + else + result:=1 } + result:=1-2*ord(bestvcl=tve_longint) + { single is better than everything left } + else if (currvcl=tve_single) or + (bestvcl=tve_single) then + result:=1-2*ord(bestvcl=tve_single) + { double/comp/currency are better than everything left, and conflict } + { with each other (but that's already tested) } + else if (currvcl=tve_dblcurrency) or + (bestvcl=tve_dblcurrency) then + result:=1-2*ord(bestvcl=tve_dblcurrency) + { extended is better than everything left } + else if (currvcl=tve_extended) or + (bestvcl=tve_extended) then + result:=1-2*ord(bestvcl=tve_extended) + { shortstring is better than everything left } + else if (currvcl=tve_sstring) or + (bestvcl=tve_sstring) then + result:=1-2*ord(bestvcl=tve_sstring) + { ansistring is better than everything left } + else if (currvcl=tve_astring) or + (bestvcl=tve_astring) then + result:=1-2*ord(bestvcl=tve_astring) + { widestring is better than everything left } + else if (currvcl=tve_wstring) or + (bestvcl=tve_wstring) then + result:=1-2*ord(bestvcl=tve_wstring) + { unicodestring is better than everything left } + else if (currvcl=tve_ustring) or + (bestvcl=tve_ustring) then + result:=1-2*ord(bestvcl=tve_ustring); + + { all possibilities should have been checked now } + if (result=-5) then + internalerror(2006122805); + end; + + + function tcallcandidates.choose_best(var bestpd:tabstractprocdef; singlevariant: boolean):integer; + var + besthpstart, + hp : pcandidate; + cntpd, + res : integer; + begin + { + Returns the number of candidates left and the + first candidate is returned in pdbest + } + { Setup the first procdef as best, only count it as a result + when it is valid } + bestpd:=FCandidateProcs^.data; + if FCandidateProcs^.invalid then + cntpd:=0 + else + cntpd:=1; + if assigned(FCandidateProcs^.next) then + begin + besthpstart:=FCandidateProcs; + hp:=FCandidateProcs^.next; + while assigned(hp) do + begin + if not singlevariant then + res:=is_better_candidate(hp,besthpstart) + else + res:=is_better_candidate_single_variant(hp,besthpstart); + if (res>0) then + begin + { hp is better, flag all procs to be incompatible } + while (besthpstart<>hp) do + begin + besthpstart^.invalid:=true; + besthpstart:=besthpstart^.next; + end; + { besthpstart is already set to hp } + bestpd:=besthpstart^.data; + cntpd:=1; + end + else + if (res<0) then + begin + { besthpstart is better, flag current hp to be incompatible } + hp^.invalid:=true; + end + else + begin + { res=0, both are valid } + if not hp^.invalid then + inc(cntpd); + end; + hp:=hp^.next; + end; + end; + + result:=cntpd; + end; + + + procedure tcallcandidates.find_wrong_para; + var + currparanr : smallint; + hp : pcandidate; + pt : tcallparanode; + wrongpara : tparavarsym; + begin + { Only process the first overloaded procdef } + hp:=FCandidateProcs; + { Find callparanode corresponding to the argument } + pt:=tcallparanode(FParanode); + currparanr:=FParalength; + while assigned(pt) and + (currparanr>hp^.wrongparanr) do + begin + pt:=tcallparanode(pt.right); + dec(currparanr); + end; + if (currparanr<>hp^.wrongparanr) or + not assigned(pt) then + internalerror(200212094); + { Show error message, when it was a var or out parameter + guess that it is a missing typeconv } + wrongpara:=tparavarsym(hp^.data.paras[hp^.wrongparaidx]); + if wrongpara.varspez in [vs_var,vs_out] then + begin + { Maybe passing the correct type but passing a const to var parameter } + if (compare_defs(pt.resultdef,wrongpara.vardef,pt.nodetype)<>te_incompatible) and + not valid_for_var(pt.left,true) then + CGMessagePos(pt.left.fileinfo,type_e_variable_id_expected) + else + CGMessagePos3(pt.left.fileinfo,parser_e_call_by_ref_without_typeconv,tostr(hp^.wrongparanr), + FullTypeName(pt.left.resultdef,wrongpara.vardef), + FullTypeName(wrongpara.vardef,pt.left.resultdef)) + end + else + CGMessagePos3(pt.left.fileinfo,type_e_wrong_parameter_type,tostr(hp^.wrongparanr), + FullTypeName(pt.left.resultdef,wrongpara.vardef), + FullTypeName(wrongpara.vardef,pt.left.resultdef)); + end; + + + procedure check_hints(const srsym: tsym; const symoptions: tsymoptions; const deprecatedmsg : pshortstring); + begin + if not assigned(srsym) then + internalerror(200602051); + if sp_hint_deprecated in symoptions then + if (sp_has_deprecated_msg in symoptions) and (deprecatedmsg <> nil) then + Message2(sym_w_deprecated_symbol_with_msg,srsym.realname,deprecatedmsg^) + else + Message1(sym_w_deprecated_symbol,srsym.realname); + if sp_hint_experimental in symoptions then + Message1(sym_w_experimental_symbol,srsym.realname); + if sp_hint_platform in symoptions then + Message1(sym_w_non_portable_symbol,srsym.realname); + if sp_hint_library in symoptions then + Message1(sym_w_library_symbol,srsym.realname); + if sp_hint_unimplemented in symoptions then + Message1(sym_w_non_implemented_symbol,srsym.realname); + end; + + + procedure check_ranges(const location: tfileposinfo; source: tnode; destdef: tdef); + begin + if not(cs_check_ordinal_size in current_settings.localswitches) then + exit; + { check if the assignment may cause a range check error } + { if its not explicit, and only if the values are } + { ordinals, enumdef and floatdef } + if assigned(destdef) and + (destdef.typ in [enumdef,orddef,floatdef]) and + not is_boolean(destdef) and + assigned(source.resultdef) and + (source.resultdef.typ in [enumdef,orddef,floatdef]) and + not is_boolean(source.resultdef) and + not is_constrealnode(source) then + begin + if ((destdef.size < source.resultdef.size) and + { s80real and sc80real have a different size but the same precision } + not((destdef.typ=floatdef) and + (source.resultdef.typ=floatdef) and + (tfloatdef(source.resultdef).floattype in [s80real,sc80real]) and + (tfloatdef(destdef).floattype in [s80real,sc80real]))) or + ((destdef.typ<>floatdef) and + (source.resultdef.typ<>floatdef) and + not is_in_limit(source.resultdef,destdef)) then + begin + if (cs_check_range in current_settings.localswitches) then + MessagePos(location,type_w_smaller_possible_range_check) + else + MessagePos(location,type_h_smaller_possible_range_check); + end; + end; + end; + + +end. diff --git a/closures/compiler/i386/aopt386.pas b/closures/compiler/i386/aopt386.pas new file mode 100644 index 0000000000..0e82343ad2 --- /dev/null +++ b/closures/compiler/i386/aopt386.pas @@ -0,0 +1,119 @@ +{ + Copyright (c) 1998-2002 by Jonas Maebe + + This unit calls the optimization procedures to optimize the assembler + code for i386+ + + 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 aopt386; + +{$i fpcdefs.inc} + +Interface + +Uses + aasmbase,aasmtai,aasmdata,aasmcpu; + +Procedure Optimize(AsmL: TAsmList); + + +Implementation + +Uses + globtype, + globals, + DAOpt386,POpt386,CSOpt386; + + +Procedure Optimize(AsmL: TAsmList); +Var + BlockStart, BlockEnd, HP: Tai; + pass: longint; + slowopt, changed, lastLoop: boolean; +Begin + slowopt := (cs_opt_level3 in current_settings.optimizerswitches); + pass := 0; + changed := false; + dfa := TDFAObj.create(asml); + repeat + lastLoop := + not(slowopt) or + (not changed and (pass > 2)) or + { prevent endless loops } + (pass = 4); + changed := false; + { Setup labeltable, always necessary } + blockstart := tai(asml.first); + blockend := dfa.pass_1(blockstart); + { Blockend now either contains an ait_marker with Kind = mark_AsmBlockStart, } + { or nil } + While Assigned(BlockStart) Do + Begin + if pass = 0 then + PrePeepHoleOpts(AsmL, BlockStart, BlockEnd); + { Peephole optimizations } + PeepHoleOptPass1(AsmL, BlockStart, BlockEnd); + { Only perform them twice in the first pass } + if pass = 0 then + PeepHoleOptPass1(AsmL, BlockStart, BlockEnd); + { Data flow analyzer } + If (cs_opt_asmcse in current_settings.optimizerswitches) Then + begin + if dfa.pass_generate_code then + { common subexpression elimination } + changed := CSE(asmL, blockStart, blockEnd, pass) or changed; + end; + { More peephole optimizations } + PeepHoleOptPass2(AsmL, BlockStart, BlockEnd); + if lastLoop then + PostPeepHoleOpts(AsmL, BlockStart, BlockEnd); + + { Free memory } + dfa.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 = mark_AsmBlockStart) Do + Begin + { We stopped at an assembler block, so skip it } + Repeat + BlockStart := Tai(BlockStart.Next); + Until (BlockStart.Typ = Ait_Marker) And + (Tai_Marker(Blockstart).Kind = mark_AsmBlockEnd); + { Blockstart now contains a Tai_marker(mark_AsmBlockEnd) } + If GetNextInstruction(BlockStart, HP) And + ((HP.typ <> ait_Marker) Or + (Tai_Marker(HP).Kind <> mark_AsmBlockStart)) Then + { There is no assembler block anymore after the current one, so } + { optimize the next block of "normal" instructions } + BlockEnd := dfa.pass_1(blockstart) + { Otherwise, skip the next assembler block } + else + blockStart := hp; + End; + End; + inc(pass); + until lastLoop; + dfa.free; + +End; + +End. diff --git a/closures/compiler/i386/cgcpu.pas b/closures/compiler/i386/cgcpu.pas new file mode 100644 index 0000000000..863638d3e7 --- /dev/null +++ b/closures/compiler/i386/cgcpu.pas @@ -0,0 +1,862 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements the code generator for the i386 + + 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, + cgbase,cgobj,cg64f32,cgx86, + aasmbase,aasmtai,aasmdata,aasmcpu, + cpubase,parabase,cgutils, + symconst,symdef + ; + + type + tcg386 = class(tcgx86) + procedure init_register_allocators;override; + procedure do_register_allocation(list:TAsmList;headertai:tai);override; + + { passing parameter using push instead of mov } + procedure a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);override; + procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : tcgpara);override; + procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara);override; + procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara);override; + + procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override; + procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;destreg:tregister);override; + procedure g_releasevaluepara_openarray(list : TAsmList;const l:tlocation);override; + + procedure g_exception_reason_save(list : TAsmList; const href : treference);override; + procedure g_exception_reason_save_const(list : TAsmList; const href : treference; a: tcgint);override; + procedure g_exception_reason_load(list : TAsmList; const href : treference);override; + procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override; + procedure g_maybe_got_init(list: TAsmList); override; + end; + + tcg64f386 = class(tcg64f32) + procedure a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);override; + procedure a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);override; + procedure a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);override; + procedure a_op64_const_ref(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;const ref : treference);override; + private + procedure get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp); + end; + + procedure create_codegen; + + implementation + + uses + globals,verbose,systems,cutils, + paramgr,procinfo,fmodule, + rgcpu,rgx86,cpuinfo; + + function use_push(const cgpara:tcgpara):boolean; + begin + result:=(not paramanager.use_fixed_stack) and + assigned(cgpara.location) and + (cgpara.location^.loc=LOC_REFERENCE) and + (cgpara.location^.reference.index=NR_STACK_POINTER_REG); + end; + + + procedure tcg386.init_register_allocators; + begin + inherited init_register_allocators; + if not(target_info.system in [system_i386_darwin,system_i386_iphonesim]) and + (cs_create_pic in current_settings.moduleswitches) then + rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP]) + else + rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_EAX,RS_EDX,RS_ECX,RS_EBX,RS_ESI,RS_EDI],first_int_imreg,[RS_EBP]); + rg[R_MMXREGISTER]:=trgcpu.create(R_MMXREGISTER,R_SUBNONE,[RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7],first_mm_imreg,[]); + rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBWHOLE,[RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7],first_mm_imreg,[]); + rgfpu:=Trgx86fpu.create; + end; + + procedure tcg386.do_register_allocation(list:TAsmList;headertai:tai); + begin + if (pi_needs_got in current_procinfo.flags) then + begin + if getsupreg(current_procinfo.got) < first_int_imreg then + include(rg[R_INTREGISTER].used_in_proc,getsupreg(current_procinfo.got)); + end; + inherited do_register_allocation(list,headertai); + end; + + + procedure tcg386.a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara); + var + pushsize : tcgsize; + begin + check_register_size(size,r); + if use_push(cgpara) then + begin + cgpara.check_simple_location; + if tcgsize2size[cgpara.location^.size]>cgpara.alignment then + pushsize:=cgpara.location^.size + else + pushsize:=int_cgsize(cgpara.alignment); + list.concat(taicpu.op_reg(A_PUSH,tcgsize2opsize[pushsize],makeregsize(list,r,pushsize))); + end + else + inherited a_load_reg_cgpara(list,size,r,cgpara); + end; + + + procedure tcg386.a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : tcgpara); + var + pushsize : tcgsize; + begin + if use_push(cgpara) then + begin + cgpara.check_simple_location; + if tcgsize2size[cgpara.location^.size]>cgpara.alignment then + pushsize:=cgpara.location^.size + else + pushsize:=int_cgsize(cgpara.alignment); + list.concat(taicpu.op_const(A_PUSH,tcgsize2opsize[pushsize],a)); + end + else + inherited a_load_const_cgpara(list,size,a,cgpara); + end; + + + procedure tcg386.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara); + + procedure pushdata(paraloc:pcgparalocation;ofs:tcgint); + var + pushsize : tcgsize; + tmpreg : tregister; + href : treference; + begin + if not assigned(paraloc) then + exit; + if (paraloc^.loc<>LOC_REFERENCE) or + (paraloc^.reference.index<>NR_STACK_POINTER_REG) or + (tcgsize2size[paraloc^.size]>sizeof(aint)) then + internalerror(200501162); + { Pushes are needed in reverse order, add the size of the + current location to the offset where to load from. This + prevents wrong calculations for the last location when + the size is not a power of 2 } + if assigned(paraloc^.next) then + pushdata(paraloc^.next,ofs+tcgsize2size[paraloc^.size]); + { Push the data starting at ofs } + href:=r; + inc(href.offset,ofs); + if tcgsize2size[paraloc^.size]>cgpara.alignment then + pushsize:=paraloc^.size + else + pushsize:=int_cgsize(cgpara.alignment); + if tcgsize2size[paraloc^.size]<cgpara.alignment then + begin + tmpreg:=getintregister(list,pushsize); + a_load_ref_reg(list,paraloc^.size,pushsize,href,tmpreg); + list.concat(taicpu.op_reg(A_PUSH,TCgsize2opsize[pushsize],tmpreg)); + end + else + begin + make_simple_ref(list,href); + list.concat(taicpu.op_ref(A_PUSH,TCgsize2opsize[pushsize],href)); + end; + end; + + var + len : tcgint; + href : treference; + begin + { cgpara.size=OS_NO requires a copy on the stack } + if use_push(cgpara) then + begin + { Record copy? } + if (cgpara.size in [OS_NO,OS_F64]) or (size=OS_NO) then + begin + cgpara.check_simple_location; + len:=align(cgpara.intsize,cgpara.alignment); + g_stackpointer_alloc(list,len); + reference_reset_base(href,NR_STACK_POINTER_REG,0,4); + g_concatcopy(list,r,href,len); + end + else + begin + if tcgsize2size[cgpara.size]<>tcgsize2size[size] then + internalerror(200501161); + { We need to push the data in reverse order, + therefor we use a recursive algorithm } + pushdata(cgpara.location,0); + end + end + else + inherited a_load_ref_cgpara(list,size,r,cgpara); + end; + + + procedure tcg386.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara); + var + tmpreg : tregister; + opsize : topsize; + tmpref : treference; + begin + with r do + begin + if (segment<>NR_NO) then + cgmessage(cg_e_cant_use_far_pointer_there); + if use_push(cgpara) then + begin + cgpara.check_simple_location; + opsize:=tcgsize2opsize[OS_ADDR]; + if (segment=NR_NO) and (base=NR_NO) and (index=NR_NO) then + begin + if assigned(symbol) then + begin + if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) and + ((r.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or + (cs_create_pic in current_settings.moduleswitches)) then + begin + tmpreg:=getaddressregister(list); + a_loadaddr_ref_reg(list,r,tmpreg); + list.concat(taicpu.op_reg(A_PUSH,opsize,tmpreg)); + end + else if cs_create_pic in current_settings.moduleswitches then + begin + if offset<>0 then + begin + tmpreg:=getaddressregister(list); + a_loadaddr_ref_reg(list,r,tmpreg); + list.concat(taicpu.op_reg(A_PUSH,opsize,tmpreg)); + end + else + begin + reference_reset_symbol(tmpref,r.symbol,0,r.alignment); + tmpref.refaddr:=addr_pic; + tmpref.base:=current_procinfo.got; + include(current_procinfo.flags,pi_needs_got); + list.concat(taicpu.op_ref(A_PUSH,S_L,tmpref)); + end + end + else + list.concat(Taicpu.Op_sym_ofs(A_PUSH,opsize,symbol,offset)); + end + else + list.concat(Taicpu.Op_const(A_PUSH,opsize,offset)); + end + else if (segment=NR_NO) and (base=NR_NO) and (index<>NR_NO) and + (offset=0) and (scalefactor=0) and (symbol=nil) then + list.concat(Taicpu.Op_reg(A_PUSH,opsize,index)) + else if (segment=NR_NO) and (base<>NR_NO) and (index=NR_NO) and + (offset=0) and (symbol=nil) then + list.concat(Taicpu.Op_reg(A_PUSH,opsize,base)) + else + begin + tmpreg:=getaddressregister(list); + a_loadaddr_ref_reg(list,r,tmpreg); + list.concat(taicpu.op_reg(A_PUSH,opsize,tmpreg)); + end; + end + else + inherited a_loadaddr_ref_cgpara(list,r,cgpara); + end; + end; + + + procedure tcg386.g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); + var + stacksize : longint; + begin + { MMX needs to call EMMS } + if assigned(rg[R_MMXREGISTER]) and + (rg[R_MMXREGISTER].uses_registers) then + list.concat(Taicpu.op_none(A_EMMS,S_NO)); + + { remove stackframe } + if not nostackframe then + begin + if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then + begin + stacksize:=current_procinfo.calc_stackframe_size; + if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) and + ((stacksize <> 0) or + (pi_do_call in current_procinfo.flags) or + { can't detect if a call in this case -> use nostackframe } + { if you (think you) know what you are doing } + (po_assembler in current_procinfo.procdef.procoptions)) then + stacksize := align(stacksize+sizeof(aint),16) - sizeof(aint); + if (stacksize<>0) then + cg.a_op_const_reg(list,OP_ADD,OS_ADDR,stacksize,current_procinfo.framepointer); + end + else + list.concat(Taicpu.op_none(A_LEAVE,S_NO)); + list.concat(tai_regalloc.dealloc(current_procinfo.framepointer,nil)); + end; + + { return from proc } + if (po_interrupt in current_procinfo.procdef.procoptions) and + { this messes up stack alignment } + not(target_info.system in [system_i386_darwin,system_i386_iphonesim]) then + begin + if assigned(current_procinfo.procdef.funcretloc[calleeside].location) and + (current_procinfo.procdef.funcretloc[calleeside].location^.loc=LOC_REGISTER) then + begin + if (getsupreg(current_procinfo.procdef.funcretloc[calleeside].location^.register)=RS_EAX) then + list.concat(Taicpu.Op_const_reg(A_ADD,S_L,4,NR_ESP)) + else + internalerror(2010053001); + end + else + list.concat(Taicpu.Op_reg(A_POP,S_L,NR_EAX)); + list.concat(Taicpu.Op_reg(A_POP,S_L,NR_EBX)); + list.concat(Taicpu.Op_reg(A_POP,S_L,NR_ECX)); + + if (current_procinfo.procdef.funcretloc[calleeside].size in [OS_64,OS_S64]) and + assigned(current_procinfo.procdef.funcretloc[calleeside].location) and + assigned(current_procinfo.procdef.funcretloc[calleeside].location^.next) and + (current_procinfo.procdef.funcretloc[calleeside].location^.next^.loc=LOC_REGISTER) then + begin + if (getsupreg(current_procinfo.procdef.funcretloc[calleeside].location^.next^.register)=RS_EDX) then + list.concat(Taicpu.Op_const_reg(A_ADD,S_L,4,NR_ESP)) + else + internalerror(2010053002); + end + else + list.concat(Taicpu.Op_reg(A_POP,S_L,NR_EDX)); + + list.concat(Taicpu.Op_reg(A_POP,S_L,NR_ESI)); + list.concat(Taicpu.Op_reg(A_POP,S_L,NR_EDI)); + { .... also the segment registers } + list.concat(Taicpu.Op_reg(A_POP,S_W,NR_DS)); + list.concat(Taicpu.Op_reg(A_POP,S_W,NR_ES)); + list.concat(Taicpu.Op_reg(A_POP,S_W,NR_FS)); + list.concat(Taicpu.Op_reg(A_POP,S_W,NR_GS)); + { this restores the flags } + list.concat(Taicpu.Op_none(A_IRET,S_NO)); + end + { Routines with the poclearstack flag set use only a ret } + else if (current_procinfo.procdef.proccalloption in clearstack_pocalls) and + (not paramanager.use_fixed_stack) then + begin + { complex return values are removed from stack in C code PM } + { but not on win32 } + { and not for safecall with hidden exceptions, because the result } + { wich contains the exception is passed in EAX } + if (target_info.system <> system_i386_win32) and + not ((current_procinfo.procdef.proccalloption = pocall_safecall) and + (tf_safecall_exceptions in target_info.flags)) and + paramanager.ret_in_param(current_procinfo.procdef.returndef, + current_procinfo.procdef.proccalloption) then + list.concat(Taicpu.Op_const(A_RET,S_W,sizeof(aint))) + else + list.concat(Taicpu.Op_none(A_RET,S_NO)); + end + { ... also routines with parasize=0 } + else if (parasize=0) then + list.concat(Taicpu.Op_none(A_RET,S_NO)) + else + begin + { parameters are limited to 65535 bytes because ret allows only imm16 } + if (parasize>65535) then + CGMessage(cg_e_parasize_too_big); + list.concat(Taicpu.Op_const(A_RET,S_W,parasize)); + end; + end; + + + procedure tcg386.g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;destreg:tregister); + var + power,len : longint; + opsize : topsize; +{$ifndef __NOWINPECOFF__} + again,ok : tasmlabel; +{$endif} + begin + if paramanager.use_fixed_stack then + begin + inherited g_copyvaluepara_openarray(list,ref,lenloc,elesize,destreg); + exit; + end; + + { get stack space } + getcpuregister(list,NR_EDI); + a_load_loc_reg(list,OS_INT,lenloc,NR_EDI); + list.concat(Taicpu.op_reg(A_INC,S_L,NR_EDI)); + { Now EDI contains (high+1). Copy it to ECX for later use. } + getcpuregister(list,NR_ECX); + list.concat(Taicpu.op_reg_reg(A_MOV,S_L,NR_EDI,NR_ECX)); + if (elesize<>1) then + begin + if ispowerof2(elesize, power) then + list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,NR_EDI)) + else + list.concat(Taicpu.op_const_reg(A_IMUL,S_L,elesize,NR_EDI)); + end; +{$ifndef __NOWINPECOFF__} + { windows guards only a few pages for stack growing, } + { so we have to access every page first } + if target_info.system=system_i386_win32 then + begin + current_asmdata.getjumplabel(again); + current_asmdata.getjumplabel(ok); + a_label(list,again); + list.concat(Taicpu.op_const_reg(A_CMP,S_L,winstackpagesize,NR_EDI)); + a_jmp_cond(list,OC_B,ok); + list.concat(Taicpu.op_const_reg(A_SUB,S_L,winstackpagesize-4,NR_ESP)); + list.concat(Taicpu.op_reg(A_PUSH,S_L,NR_EDI)); + list.concat(Taicpu.op_const_reg(A_SUB,S_L,winstackpagesize,NR_EDI)); + a_jmp_always(list,again); + + a_label(list,ok); + end; +{$endif __NOWINPECOFF__} + { If we were probing pages, EDI=(size mod pagesize) and ESP is decremented + by (size div pagesize)*pagesize, otherwise EDI=size. + Either way, subtracting EDI from ESP will set ESP to desired final value. } + list.concat(Taicpu.op_reg_reg(A_SUB,S_L,NR_EDI,NR_ESP)); + { align stack on 4 bytes } + list.concat(Taicpu.op_const_reg(A_AND,S_L,aint($fffffff4),NR_ESP)); + { load destination, don't use a_load_reg_reg, that will add a move instruction + that can confuse the reg allocator } + list.concat(Taicpu.Op_reg_reg(A_MOV,S_L,NR_ESP,NR_EDI)); + + { Allocate ESI and load it with source } + getcpuregister(list,NR_ESI); + a_loadaddr_ref_reg(list,ref,NR_ESI); + + { calculate size } + len:=elesize; + opsize:=S_B; + if (len and 3)=0 then + begin + opsize:=S_L; + len:=len shr 2; + end + else + if (len and 1)=0 then + begin + opsize:=S_W; + len:=len shr 1; + end; + + if len>1 then + begin + if ispowerof2(len, power) then + list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,NR_ECX)) + else + list.concat(Taicpu.op_const_reg(A_IMUL,S_L,len,NR_ECX)); + end; + list.concat(Taicpu.op_none(A_REP,S_NO)); + case opsize of + S_B : list.concat(Taicpu.Op_none(A_MOVSB,S_NO)); + S_W : list.concat(Taicpu.Op_none(A_MOVSW,S_NO)); + S_L : list.concat(Taicpu.Op_none(A_MOVSD,S_NO)); + end; + ungetcpuregister(list,NR_EDI); + ungetcpuregister(list,NR_ECX); + ungetcpuregister(list,NR_ESI); + + { patch the new address, but don't use a_load_reg_reg, that will add a move instruction + that can confuse the reg allocator } + list.concat(Taicpu.Op_reg_reg(A_MOV,S_L,NR_ESP,destreg)); + end; + + + procedure tcg386.g_releasevaluepara_openarray(list : TAsmList;const l:tlocation); + begin + if paramanager.use_fixed_stack then + begin + inherited g_releasevaluepara_openarray(list,l); + exit; + end; + { Nothing to release } + end; + + + procedure tcg386.g_exception_reason_save(list : TAsmList; const href : treference); + begin + if not paramanager.use_fixed_stack then + list.concat(Taicpu.op_reg(A_PUSH,tcgsize2opsize[OS_INT],NR_FUNCTION_RESULT_REG)) + else + inherited g_exception_reason_save(list,href); + end; + + + procedure tcg386.g_exception_reason_save_const(list : TAsmList;const href : treference; a: tcgint); + begin + if not paramanager.use_fixed_stack then + list.concat(Taicpu.op_const(A_PUSH,tcgsize2opsize[OS_INT],a)) + else + inherited g_exception_reason_save_const(list,href,a); + end; + + + procedure tcg386.g_exception_reason_load(list : TAsmList; const href : treference); + begin + if not paramanager.use_fixed_stack then + begin + cg.a_reg_alloc(list,NR_FUNCTION_RESULT_REG); + list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[OS_INT],NR_FUNCTION_RESULT_REG)) + end + else + inherited g_exception_reason_load(list,href); + end; + + + procedure tcg386.g_maybe_got_init(list: TAsmList); + var + notdarwin: boolean; + begin + { allocate PIC register } + if (cs_create_pic in current_settings.moduleswitches) and + (tf_pic_uses_got in target_info.flags) and + (pi_needs_got in current_procinfo.flags) then + begin + notdarwin:=not(target_info.system in [system_i386_darwin,system_i386_iphonesim]); + { on darwin, the got register is virtual (and allocated earlier + already) } + if notdarwin then + { ecx could be used in leaf procedures that don't use ecx to pass + aparameter } + current_procinfo.got:=NR_EBX; + if notdarwin { needs testing before it can be enabled for non-darwin platforms + and + (current_settings.optimizecputype in [cpu_Pentium2,cpu_Pentium3,cpu_Pentium4]) } then + begin + current_module.requires_ebx_pic_helper:=true; + cg.a_call_name_static(list,'fpc_geteipasebx'); + end + else + begin + { call/pop is faster than call/ret/mov on Core Solo and later + according to Apple's benchmarking -- and all Intel Macs + have at least a Core Solo (furthermore, the i386 - Pentium 1 + don't have a return stack buffer) } + a_call_name_static(list,current_procinfo.CurrGOTLabel.name); + a_label(list,current_procinfo.CurrGotLabel); + list.concat(taicpu.op_reg(A_POP,S_L,current_procinfo.got)) + end; + if notdarwin then + begin + list.concat(taicpu.op_sym_ofs_reg(A_ADD,S_L,current_asmdata.RefAsmSymbol('_GLOBAL_OFFSET_TABLE_'),0,NR_PIC_OFFSET_REG)); + list.concat(tai_regalloc.alloc(NR_PIC_OFFSET_REG,nil)); + end; + end; + end; + + + procedure tcg386.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); + { + possible calling conventions: + default stdcall cdecl pascal register + default(0): OK OK OK OK OK + virtual(1): OK OK OK OK OK(2) + + (0): + set self parameter to correct value + jmp mangledname + + (1): The wrapper code use %eax to reach the virtual method address + set self to correct value + move self,%eax + mov 0(%eax),%eax ; load vmt + jmp vmtoffs(%eax) ; method offs + + (2): Virtual use values pushed on stack to reach the method address + so the following code be generated: + set self to correct value + push %ebx ; allocate space for function address + push %eax + mov self,%eax + mov 0(%eax),%eax ; load vmt + mov vmtoffs(%eax),eax ; method offs + mov %eax,4(%esp) + pop %eax + ret 0; jmp the address + + } + + procedure getselftoeax(offs: longint); + var + href : treference; + selfoffsetfromsp : longint; + begin + { mov offset(%esp),%eax } + if (procdef.proccalloption<>pocall_register) then + begin + { framepointer is pushed for nested procs } + if procdef.parast.symtablelevel>normal_function_level then + selfoffsetfromsp:=2*sizeof(aint) + else + selfoffsetfromsp:=sizeof(aint); + reference_reset_base(href,NR_ESP,selfoffsetfromsp+offs,4); + cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX); + end; + end; + + procedure loadvmttoeax; + var + href : treference; + begin + { mov 0(%eax),%eax ; load vmt} + reference_reset_base(href,NR_EAX,0,4); + cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX); + end; + + procedure op_oneaxmethodaddr(op: TAsmOp); + var + href : treference; + begin + if (procdef.extnumber=$ffff) then + Internalerror(200006139); + { call/jmp vmtoffs(%eax) ; method offs } + reference_reset_base(href,NR_EAX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4); + list.concat(taicpu.op_ref(op,S_L,href)); + end; + + + procedure loadmethodoffstoeax; + var + href : treference; + begin + if (procdef.extnumber=$ffff) then + Internalerror(200006139); + { mov vmtoffs(%eax),%eax ; method offs } + reference_reset_base(href,NR_EAX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4); + cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_EAX); + 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.struct) 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 + create_smartlink 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); + + if (po_virtualmethod in procdef.procoptions) and + not is_objectpascal_helper(procdef.struct) then + begin + if (procdef.proccalloption=pocall_register) then + begin + { case 2 } + list.concat(taicpu.op_reg(A_PUSH,S_L,NR_EBX)); { allocate space for address} + list.concat(taicpu.op_reg(A_PUSH,S_L,NR_EAX)); + getselftoeax(8); + loadvmttoeax; + loadmethodoffstoeax; + { mov %eax,4(%esp) } + reference_reset_base(href,NR_ESP,4,4); + list.concat(taicpu.op_reg_ref(A_MOV,S_L,NR_EAX,href)); + { pop %eax } + list.concat(taicpu.op_reg(A_POP,S_L,NR_EAX)); + { ret ; jump to the address } + list.concat(taicpu.op_none(A_RET,S_L)); + end + else + begin + { case 1 } + getselftoeax(0); + loadvmttoeax; + op_oneaxmethodaddr(A_JMP); + end; + end + { case 0 } + else + begin + if (target_info.system <> system_i386_darwin) then + begin + lab:=current_asmdata.RefAsmSymbol(procdef.mangledname); + list.concat(taicpu.op_sym(A_JMP,S_NO,lab)) + end + else + list.concat(taicpu.op_sym(A_JMP,S_NO,get_darwin_call_stub(procdef.mangledname,false))) + end; + + List.concat(Tai_symbol_end.Createname(labelname)); + end; + + +{ ************* 64bit operations ************ } + + procedure tcg64f386.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp); + begin + case op of + OP_ADD : + begin + op1:=A_ADD; + op2:=A_ADC; + end; + OP_SUB : + begin + op1:=A_SUB; + op2:=A_SBB; + end; + OP_XOR : + begin + op1:=A_XOR; + op2:=A_XOR; + end; + OP_OR : + begin + op1:=A_OR; + op2:=A_OR; + end; + OP_AND : + begin + op1:=A_AND; + op2:=A_AND; + end; + else + internalerror(200203241); + end; + end; + + + procedure tcg64f386.a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64); + var + op1,op2 : TAsmOp; + tempref : treference; + begin + if not(op in [OP_NEG,OP_NOT]) then + begin + get_64bit_ops(op,op1,op2); + tempref:=ref; + tcgx86(cg).make_simple_ref(list,tempref); + list.concat(taicpu.op_ref_reg(op1,S_L,tempref,reg.reglo)); + inc(tempref.offset,4); + list.concat(taicpu.op_ref_reg(op2,S_L,tempref,reg.reghi)); + end + else + begin + a_load64_ref_reg(list,ref,reg); + a_op64_reg_reg(list,op,size,reg,reg); + end; + end; + + + procedure tcg64f386.a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64); + var + op1,op2 : TAsmOp; + begin + case op of + OP_NEG : + begin + if (regsrc.reglo<>regdst.reglo) then + a_load64_reg_reg(list,regsrc,regdst); + list.concat(taicpu.op_reg(A_NOT,S_L,regdst.reghi)); + list.concat(taicpu.op_reg(A_NEG,S_L,regdst.reglo)); + list.concat(taicpu.op_const_reg(A_SBB,S_L,-1,regdst.reghi)); + exit; + end; + OP_NOT : + begin + if (regsrc.reglo<>regdst.reglo) then + a_load64_reg_reg(list,regsrc,regdst); + list.concat(taicpu.op_reg(A_NOT,S_L,regdst.reghi)); + list.concat(taicpu.op_reg(A_NOT,S_L,regdst.reglo)); + exit; + end; + end; + get_64bit_ops(op,op1,op2); + list.concat(taicpu.op_reg_reg(op1,S_L,regsrc.reglo,regdst.reglo)); + list.concat(taicpu.op_reg_reg(op2,S_L,regsrc.reghi,regdst.reghi)); + end; + + + procedure tcg64f386.a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;reg : tregister64); + var + op1,op2 : TAsmOp; + begin + case op of + OP_AND,OP_OR,OP_XOR: + begin + cg.a_op_const_reg(list,op,OS_32,tcgint(lo(value)),reg.reglo); + cg.a_op_const_reg(list,op,OS_32,tcgint(hi(value)),reg.reghi); + end; + OP_ADD, OP_SUB: + begin + // can't use a_op_const_ref because this may use dec/inc + get_64bit_ops(op,op1,op2); + list.concat(taicpu.op_const_reg(op1,S_L,aint(lo(value)),reg.reglo)); + list.concat(taicpu.op_const_reg(op2,S_L,aint(hi(value)),reg.reghi)); + end; + else + internalerror(200204021); + end; + end; + + + procedure tcg64f386.a_op64_const_ref(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;const ref : treference); + var + op1,op2 : TAsmOp; + tempref : treference; + begin + tempref:=ref; + tcgx86(cg).make_simple_ref(list,tempref); + case op of + OP_AND,OP_OR,OP_XOR: + begin + cg.a_op_const_ref(list,op,OS_32,tcgint(lo(value)),tempref); + inc(tempref.offset,4); + cg.a_op_const_ref(list,op,OS_32,tcgint(hi(value)),tempref); + end; + OP_ADD, OP_SUB: + begin + get_64bit_ops(op,op1,op2); + // can't use a_op_const_ref because this may use dec/inc + list.concat(taicpu.op_const_ref(op1,S_L,aint(lo(value)),tempref)); + inc(tempref.offset,4); + list.concat(taicpu.op_const_ref(op2,S_L,aint(hi(value)),tempref)); + end; + else + internalerror(200204022); + end; + end; + + procedure create_codegen; + begin + cg := tcg386.create; + cg64 := tcg64f386.create; + end; + +end. diff --git a/closures/compiler/i386/cpubase.inc b/closures/compiler/i386/cpubase.inc new file mode 100644 index 0000000000..cadf3e29e2 --- /dev/null +++ b/closures/compiler/i386/cpubase.inc @@ -0,0 +1,147 @@ +{ + Copyright (c) 1998-2000 by Florian Klaempfl and Peter Vreman + + Contains the basic declarations for the i386 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 include file contains the basic declarations for the i386 architecture. +} + +{***************************************************************************** + Operand Sizes +*****************************************************************************} + + type + topsize = (S_NO, + S_B,S_W,S_L,S_Q,S_BW,S_BL,S_WL, + S_IS,S_IL,S_IQ, + S_FS,S_FL,S_FX,S_FV,S_FXX, + S_MD, + S_NEAR,S_FAR,S_SHORT, + S_T, + S_XMM + ); + + +{***************************************************************************** + Registers +*****************************************************************************} + const + {# Standard opcode string table (for each tasmop enumeration). The + opcode strings should conform to the names as defined by the + processor manufacturer. + } + std_op2str:op2strtable={$i i386int.inc} + +{***************************************************************************** + GDB Information +*****************************************************************************} + + {# Register indexes for stabs information, when some + parameters or variables are stored in registers. + + Taken from i386.c (dbx_register_map) and i386.h + (FIXED_REGISTERS) from GCC 3.x source code + + } + reg_stab_table : array[tregisterindex] of shortint = ( + {$i r386stab.inc} + ); + + +{***************************************************************************** + 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_F80; + {# the size of a vector register for a processor } + OS_VECTOR = OS_M128; + +{***************************************************************************** + Generic Register names +*****************************************************************************} + + {# Stack pointer register } + NR_STACK_POINTER_REG = NR_ESP; + RS_STACK_POINTER_REG = RS_ESP; + {# Frame pointer register } + RS_FRAME_POINTER_REG = RS_EBP; + NR_FRAME_POINTER_REG = NR_EBP; + { Return address for DWARF } + NR_RETURN_ADDRESS_REG = NR_EIP; + {# 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_EBX; + { Results are returned in this register (32-bit values) } + NR_FUNCTION_RETURN_REG = NR_EAX; + RS_FUNCTION_RETURN_REG = RS_EAX; + { Low part of 64bit return value } + NR_FUNCTION_RETURN64_LOW_REG = NR_EAX; + RS_FUNCTION_RETURN64_LOW_REG = RS_EAX; + { High part of 64bit return value } + NR_FUNCTION_RETURN64_HIGH_REG = NR_EDX; + RS_FUNCTION_RETURN64_HIGH_REG = RS_EDX; + { 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; + + { WARNING: don't change to R_ST0!! See comments above implementation of } + { a_loadfpu* methods in rgcpu (JM) } + NR_fpu_result_reg = NR_ST; + NR_mm_result_reg = NR_MM0; + + { Offset where the parent framepointer is pushed } + PARENT_FRAMEPOINTER_OFFSET = 8; + +{***************************************************************************** + 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..2] of tsuperregister = (RS_EBX,RS_ESI,RS_EDI); + + saved_mm_registers : array[0..0] of tsuperregister = (RS_INVALID); + {# 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; diff --git a/closures/compiler/i386/cpuinfo.pas b/closures/compiler/i386/cpuinfo.pas new file mode 100644 index 0000000000..598c746625 --- /dev/null +++ b/closures/compiler/i386/cpuinfo.pas @@ -0,0 +1,114 @@ +{ + Copyright (c) 1998-2004 by Florian Klaempfl + + Basic Processor information + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +Unit cpuinfo; + +{$i fpcdefs.inc} + +Interface + + uses + globtype; + +Type + bestreal = extended; + ts32real = single; + ts64real = double; + ts80real = extended; + ts128real = type extended; + ts64comp = type extended; + + pbestreal=^bestreal; + + { possible supported processors for this target } + tcputype = + (cpu_none, + cpu_386, + cpu_Pentium, + cpu_Pentium2, + cpu_Pentium3, + cpu_Pentium4, + cpu_PentiumM + ); + + tfputype = + (fpu_none, +// fpu_soft, + fpu_x87, + fpu_sse, + fpu_sse2, + fpu_sse3 + ); + + +Const + { calling conventions supported by the code generator } + supported_calling_conventions : tproccalloptions = [ + pocall_internproc, + pocall_register, + pocall_safecall, + pocall_stdcall, + pocall_cdecl, + pocall_cppdecl, + pocall_far16, + pocall_pascal, + pocall_oldfpccall, + pocall_mwpascal + ]; + + cputypestr : array[tcputype] of string[10] = ('', + '80386', + 'PENTIUM', + 'PENTIUM2', + 'PENTIUM3', + 'PENTIUM4', + 'PENTIUMM' + ); + + fputypestr : array[tfputype] of string[6] = ('', +// 'SOFT', + 'X87', + 'SSE', + 'SSE2', + 'SSE3' + ); + + sse_singlescalar : set of tfputype = [fpu_sse,fpu_sse2,fpu_sse3]; + sse_doublescalar : set of tfputype = [fpu_sse2,fpu_sse3]; + + { Supported optimizations, only used for information } + supported_optimizerswitches = genericlevel1optimizerswitches+ + genericlevel2optimizerswitches+ + genericlevel3optimizerswitches- + { no need to write info about those } + [cs_opt_level1,cs_opt_level2,cs_opt_level3]+ + [cs_opt_peephole,cs_opt_regvar,cs_opt_stackframe, + cs_opt_asmcse,cs_opt_loopunroll,cs_opt_uncertain, + cs_opt_tailrecursion,cs_opt_nodecse]; + + level1optimizerswitches = genericlevel1optimizerswitches + [cs_opt_peephole]; + level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + + [cs_opt_regvar,cs_opt_stackframe,cs_opt_tailrecursion,cs_opt_nodecse]; + level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches + [{,cs_opt_loopunroll}]; + +Implementation + +end. diff --git a/closures/compiler/i386/cpunode.pas b/closures/compiler/i386/cpunode.pas new file mode 100644 index 0000000000..09db4d1057 --- /dev/null +++ b/closures/compiler/i386/cpunode.pas @@ -0,0 +1,60 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + Includes the i386 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. + + **************************************************************************** +} +unit cpunode; + +{$i fpcdefs.inc} + + interface + + implementation + + uses + { generic nodes } + ncgbas, + ncgld, + ncgflw, + ncgcnv, + ncgmem, + ncgmat, + ncgcon, + ncgcal, + ncgset, + ncginl, + ncgopt, + ncgobjc, + { to be able to only parts of the generic code, + the processor specific nodes must be included + after the generic one (FK) + } + nx86set, + nx86con, + nx86cnv, + + n386add, + n386cal, + n386mem, + n386set, + n386inl, + n386mat + ; + +end. diff --git a/closures/compiler/i386/cpupara.pas b/closures/compiler/i386/cpupara.pas new file mode 100644 index 0000000000..d208cc619d --- /dev/null +++ b/closures/compiler/i386/cpupara.pas @@ -0,0 +1,762 @@ +{ + Copyright (c) 2002 by Florian Klaempfl + + Generates the argument location information for i386 + + 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 cpupara; + +{$i fpcdefs.inc} + + interface + + uses + globtype, + aasmtai,aasmdata,cpubase,cgbase,cgutils, + symconst,symtype,symsym,symdef, + parabase,paramgr; + + type + ti386paramanager = class(tparamanager) + function param_use_paraloc(const cgpara:tcgpara):boolean;override; + function ret_in_param(def : tdef;calloption : tproccalloption) : boolean;override; + function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override; + function get_para_align(calloption : tproccalloption):byte;override; + function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override; + function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override; + function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;override; + { Returns the location for the nr-st 32 Bit int parameter + if every parameter before is an 32 Bit int parameter as well + and if the calling conventions for the helper routines of the + rtl are used. + } + 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; + procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);override; + function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): TCGPara;override; + private + procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); + procedure create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parasize:longint); + procedure create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parareg,parasize:longint); + end; + + + implementation + + uses + cutils, + systems,verbose, + symtable, + defutil; + + const + parasupregs : array[0..2] of tsuperregister = (RS_EAX,RS_EDX,RS_ECX); + +{**************************************************************************** + TI386PARAMANAGER +****************************************************************************} + + function ti386paramanager.param_use_paraloc(const cgpara:tcgpara):boolean; + var + paraloc : pcgparalocation; + begin + if not assigned(cgpara.location) then + internalerror(200410102); + result:=true; + { All locations are LOC_REFERENCE } + paraloc:=cgpara.location; + while assigned(paraloc) do + begin + if (paraloc^.loc<>LOC_REFERENCE) then + begin + result:=false; + exit; + end; + paraloc:=paraloc^.next; + end; + end; + + + function ti386paramanager.ret_in_param(def : tdef;calloption : tproccalloption) : boolean; + var + size: longint; + begin + if (tf_safecall_exceptions in target_info.flags) and + (calloption=pocall_safecall) then + begin + result:=true; + exit; + end; + case target_info.system of + system_i386_win32 : + begin + case def.typ of + recorddef : + begin + { Win32 GCC returns small records in the FUNCTION_RETURN_REG. + For stdcall we follow delphi instead of GCC } + if (calloption in [pocall_cdecl,pocall_cppdecl]) and + (def.size>0) and + (def.size<=8) then + begin + result:=false; + exit; + end; + end; + end; + end; + system_i386_darwin, + system_i386_iphonesim : + begin + case def.typ of + recorddef : + begin + size := def.size; + if (size > 0) and + (size <= 8) and + { only if size is a power of 2 } + ((size and (size-1)) = 0) then + begin + result := false; + exit; + end; + end; + procvardef: + begin + result:=false; + exit; + end; + end; + end; + end; + result:=inherited ret_in_param(def,calloption); + end; + + + function ti386paramanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; + begin + result:=false; + { var,out,constref always require address } + if varspez in [vs_var,vs_out,vs_constref] then + begin + result:=true; + exit; + end; + { Only vs_const, vs_value here } + case def.typ of + variantdef : + begin + { variants are small enough to be passed by value except if + required by the windows api + + variants are somethings very delphi/windows specific so do it like + windows/delphi (FK) + } + if ((target_info.system=system_i386_win32) and + (calloption in [pocall_stdcall,pocall_safecall]) and + (varspez=vs_const)) or + (calloption=pocall_register) then + result:=true + else + result:=false; + end; + formaldef : + result:=true; + recorddef : + begin + { Delphi stdcall passes records on the stack for call by value } + if (target_info.system=system_i386_win32) and + (calloption=pocall_stdcall) and + (varspez=vs_value) then + result:=false + else + result:= + (not(calloption in (cdecl_pocalls+[pocall_mwpascal])) and + (def.size>sizeof(aint))) or + (((calloption = pocall_mwpascal) or (target_info.system=system_i386_wince)) and + (varspez=vs_const)); + end; + arraydef : + begin + { array of const values are pushed on the stack as + well as dyn. arrays } + if (calloption in cdecl_pocalls) then + result:=not(is_array_of_const(def) or + is_dynamic_array(def)) + else + begin + result:=( + (tarraydef(def).highrange>=tarraydef(def).lowrange) and + (def.size>sizeof(aint)) + ) or + is_open_array(def) or + is_array_of_const(def) or + is_array_constructor(def); + end; + end; + objectdef : + result:=is_object(def); + stringdef : + result:= (tstringdef(def).stringtype in [st_shortstring,st_longstring]); + procvardef : + result:=not(calloption in cdecl_pocalls) and not tprocvardef(def).is_addressonly; + setdef : + result:=not(calloption in cdecl_pocalls) and (not is_smallset(def)); + end; + end; + + + function ti386paramanager.get_para_align(calloption : tproccalloption):byte; + begin + if calloption=pocall_oldfpccall then + begin + if target_info.system in [system_i386_go32v2,system_i386_watcom] then + result:=2 + else + result:=4; + end + else + result:=std_param_align; + end; + + + function ti386paramanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset; + begin + case calloption of + pocall_internproc : + result:=[]; + pocall_register, + pocall_safecall, + pocall_stdcall, + pocall_cdecl, + pocall_cppdecl, + pocall_mwpascal : + result:=[RS_EAX,RS_EDX,RS_ECX]; + pocall_far16, + pocall_pascal, + pocall_oldfpccall : + result:=[RS_EAX,RS_EDX,RS_ECX,RS_ESI,RS_EDI,RS_EBX]; + else + internalerror(200309071); + end; + end; + + + function ti386paramanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset; + begin + result:=[0..first_fpu_imreg-1]; + end; + + + function ti386paramanager.get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset; + begin + result:=[0..first_mm_imreg-1]; + end; + + + procedure ti386paramanager.getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara); + var + paraloc : pcgparalocation; + begin + cgpara.reset; + cgpara.size:=OS_ADDR; + cgpara.intsize:=sizeof(pint); + cgpara.alignment:=get_para_align(calloption); + paraloc:=cgpara.add_location; + with paraloc^ do + begin + size:=OS_INT; + if calloption=pocall_register then + begin + if (nr<=high(parasupregs)+1) then + begin + if nr=0 then + internalerror(200309271); + loc:=LOC_REGISTER; + register:=newreg(R_INTREGISTER,parasupregs[nr-1],R_SUBWHOLE); + end + else + begin + loc:=LOC_REFERENCE; + reference.index:=NR_STACK_POINTER_REG; + reference.offset:=sizeof(aint)*nr; + end; + end + else + begin + loc:=LOC_REFERENCE; + reference.index:=NR_STACK_POINTER_REG; + reference.offset:=sizeof(aint)*nr; + end; + end; + end; + + + procedure ti386paramanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); + begin + p.funcretloc[side]:=get_funcretloc(p,side,p.returndef); + end; + + + function ti386paramanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): TCGPara; + var + retcgsize : tcgsize; + paraloc : pcgparalocation; + sym: tfieldvarsym; + begin + result.init; + result.alignment:=get_para_align(p.proccalloption); + { void has no location } + if is_void(def) then + begin + paraloc:=result.add_location; + result.size:=OS_NO; + result.intsize:=0; + paraloc^.size:=OS_NO; + paraloc^.loc:=LOC_VOID; + exit; + end; + { on darwin/i386, if a record has only one field and that field is a + single or double, it has to be returned like a single/double } + if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) and + ((def.typ=recorddef) or + is_object(def)) and + tabstractrecordsymtable(tabstractrecorddef(def).symtable).has_single_field(sym) and + (sym.vardef.typ=floatdef) and + (tfloatdef(sym.vardef).floattype in [s32real,s64real]) then + def:=sym.vardef; + { Constructors return self instead of a boolean } + if (p.proctypeoption=potype_constructor) then + begin + retcgsize:=OS_ADDR; + result.intsize:=sizeof(pint); + end + else + begin + retcgsize:=def_cgsize(def); + { darwin/x86 requires that results < sizeof(aint) are sign/ } + { zero extended to sizeof(aint) } + if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) and + (side=calleeside) and + (result.intsize>0) and + (result.intsize<sizeof(aint)) then + begin + result.intsize:=sizeof(aint); + retcgsize:=OS_SINT; + end + else + result.intsize:=def.size; + end; + result.size:=retcgsize; + { Return is passed as var parameter } + if ret_in_param(def,p.proccalloption) then + begin + paraloc:=result.add_location; + paraloc^.loc:=LOC_REFERENCE; + paraloc^.size:=retcgsize; + exit; + end; + { Return in FPU register? } + if def.typ=floatdef then + begin + paraloc:=result.add_location; + paraloc^.loc:=LOC_FPUREGISTER; + paraloc^.register:=NR_FPU_RESULT_REG; + paraloc^.size:=retcgsize; + end + else + { Return in register } + begin + paraloc:=result.add_location; + paraloc^.loc:=LOC_REGISTER; + if retcgsize in [OS_64,OS_S64] then + begin + { low 32bits } + if side=callerside then + paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG + else + paraloc^.register:=NR_FUNCTION_RETURN64_LOW_REG; + paraloc^.size:=OS_32; + + { high 32bits } + paraloc:=result.add_location; + paraloc^.loc:=LOC_REGISTER; + if side=callerside then + paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG + else + paraloc^.register:=NR_FUNCTION_RETURN64_HIGH_REG; + paraloc^.size:=OS_32; + end + else + begin + paraloc^.size:=retcgsize; + if side=callerside then + paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize)) + else + paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize)); + end; + end; + end; + + + procedure ti386paramanager.create_stdcall_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist;var parasize:longint); + var + i : integer; + hp : tparavarsym; + paraloc : pcgparalocation; + l, + paralen, + varalign : longint; + paraalign : shortint; + pushaddr : boolean; + paracgsize : tcgsize; + begin + paraalign:=get_para_align(p.proccalloption); + { we push Flags and CS as long + to cope with the IRETD + and we save 6 register + 4 selectors } + if po_interrupt in p.procoptions then + inc(parasize,8+6*4+4*2); + { Offset is calculated like: + sub esp,12 + mov [esp+8],para3 + mov [esp+4],para2 + mov [esp],para1 + call function + That means for pushes the para with the + highest offset (see para3) needs to be pushed first + } + if p.proccalloption in pushleftright_pocalls then + i:=paras.count-1 + else + i:=0; + while ((p.proccalloption in pushleftright_pocalls) and (i>=0)) or + (not(p.proccalloption in pushleftright_pocalls) and (i<=paras.count-1)) do + begin + hp:=tparavarsym(paras[i]); + pushaddr:=push_addr_param(hp.varspez,hp.vardef,p.proccalloption); + if pushaddr then + begin + paralen:=sizeof(aint); + paracgsize:=OS_ADDR; + end + else + begin + paralen:=push_size(hp.varspez,hp.vardef,p.proccalloption); + { darwin/x86 requires that parameters < sizeof(aint) are sign/ } + { zero extended to sizeof(aint) } + if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) and + (side = callerside) and + (paralen > 0) and + (paralen < sizeof(aint)) then + begin + paralen := sizeof(aint); + paracgsize:=OS_SINT; + end + else + paracgsize:=def_cgsize(hp.vardef); + end; + hp.paraloc[side].reset; + hp.paraloc[side].size:=paracgsize; + hp.paraloc[side].intsize:=paralen; + hp.paraloc[side].Alignment:=paraalign; + { Copy to stack? } + if (paracgsize=OS_NO) or + (use_fixed_stack) then + begin + paraloc:=hp.paraloc[side].add_location; + paraloc^.loc:=LOC_REFERENCE; + paraloc^.size:=paracgsize; + if side=callerside then + paraloc^.reference.index:=NR_STACK_POINTER_REG + else + paraloc^.reference.index:=NR_FRAME_POINTER_REG; + varalign:=used_align(size_2_align(paralen),paraalign,paraalign); + + { don't let push_size return 16, because then we can } + { read past the end of the heap since the value is only } + { 10 bytes long (JM) } + if (paracgsize = OS_F80) and + (target_info.system in [system_i386_darwin,system_i386_iphonesim]) then + paralen:=16; + paraloc^.reference.offset:=parasize; + if side=calleeside then + inc(paraloc^.reference.offset,target_info.first_parm_offset); + parasize:=align(parasize+paralen,varalign); + end + else + begin + if paralen=0 then + internalerror(200501163); + while (paralen>0) do + begin + paraloc:=hp.paraloc[side].add_location; + paraloc^.loc:=LOC_REFERENCE; + { single and double need a single location } + if (paracgsize in [OS_F64,OS_F32]) then + begin + paraloc^.size:=paracgsize; + l:=paralen; + end + else + begin + { We can allocate at maximum 32 bits per location } + if paralen>sizeof(aint) then + l:=sizeof(aint) + else + l:=paralen; + paraloc^.size:=int_cgsize(l); + end; + if (side=callerside) or + (po_nostackframe in p.procoptions) then + paraloc^.reference.index:=NR_STACK_POINTER_REG + else + paraloc^.reference.index:=NR_FRAME_POINTER_REG; + varalign:=used_align(size_2_align(l),paraalign,paraalign); + paraloc^.reference.offset:=parasize; + if side=calleeside then + if not(po_nostackframe in p.procoptions) then + inc(paraloc^.reference.offset,target_info.first_parm_offset) + else + { return addres } + inc(paraloc^.reference.offset,4); + parasize:=align(parasize+l,varalign); + dec(paralen,l); + end; + end; + if p.proccalloption in pushleftright_pocalls then + dec(i) + else + inc(i); + end; + end; + + + procedure ti386paramanager.create_register_paraloc_info(p : tabstractprocdef; side: tcallercallee;paras:tparalist; + var parareg,parasize:longint); + var + hp : tparavarsym; + paraloc : pcgparalocation; + paracgsize : tcgsize; + i : integer; + l, + paralen, + varalign : longint; + pushaddr : boolean; + paraalign : shortint; + pass : byte; + begin + if paras.count=0 then + exit; + paraalign:=get_para_align(p.proccalloption); + + { clean up here so we can later detect properly if a parameter has been + assigned or not + } + for i:=0 to paras.count-1 do + tparavarsym(paras[i]).paraloc[side].reset; + { Register parameters are assigned from left to right, + stack parameters from right to left so assign first the + register parameters in a first pass, in the second + pass all unhandled parameters are done } + for pass:=1 to 2 do + begin + if pass=1 then + i:=0 + else + i:=paras.count-1; + while true do + begin + hp:=tparavarsym(paras[i]); + if not(assigned(hp.paraloc[side].location)) then + begin + + pushaddr:=push_addr_param(hp.varspez,hp.vardef,p.proccalloption); + if pushaddr then + begin + paralen:=sizeof(aint); + paracgsize:=OS_ADDR; + end + else + begin + paralen:=push_size(hp.varspez,hp.vardef,p.proccalloption); + paracgsize:=def_cgsize(hp.vardef); + end; + hp.paraloc[side].size:=paracgsize; + hp.paraloc[side].intsize:=paralen; + hp.paraloc[side].Alignment:=paraalign; + { + EAX + EDX + ECX + Stack + Stack + + 64bit values,floats,arrays and records are always + on the stack. + + In case of po_delphi_nested_cc, the parent frame pointer + is also always passed on the stack. + } + if (parareg<=high(parasupregs)) and + (paralen<=sizeof(aint)) and + (not(hp.vardef.typ in [floatdef,recorddef,arraydef]) or + pushaddr) and + (not(vo_is_parentfp in hp.varoptions) or + not(po_delphi_nested_cc in p.procoptions)) then + begin + if pass=1 then + begin + paraloc:=hp.paraloc[side].add_location; + paraloc^.size:=paracgsize; + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=newreg(R_INTREGISTER,parasupregs[parareg],cgsize2subreg(R_INTREGISTER,paracgsize)); + inc(parareg); + end; + end + else + if pass=2 then + begin + { Copy to stack? } + if (use_fixed_stack) or + (paracgsize=OS_NO) then + begin + paraloc:=hp.paraloc[side].add_location; + paraloc^.loc:=LOC_REFERENCE; + paraloc^.size:=paracgsize; + if side=callerside then + paraloc^.reference.index:=NR_STACK_POINTER_REG + else + paraloc^.reference.index:=NR_FRAME_POINTER_REG; + varalign:=used_align(size_2_align(paralen),paraalign,paraalign); + paraloc^.reference.offset:=parasize; + if side=calleeside then + inc(paraloc^.reference.offset,target_info.first_parm_offset); + parasize:=align(parasize+paralen,varalign); + end + else + begin + if paralen=0 then + internalerror(200501163); + while (paralen>0) do + begin + paraloc:=hp.paraloc[side].add_location; + paraloc^.loc:=LOC_REFERENCE; + { Extended and double need a single location } + if (paracgsize in [OS_F64,OS_F32]) then + begin + paraloc^.size:=paracgsize; + l:=paralen; + end + else + begin + { We can allocate at maximum 32 bits per location } + if paralen>sizeof(aint) then + l:=sizeof(aint) + else + l:=paralen; + paraloc^.size:=int_cgsize(l); + end; + if side=callerside then + paraloc^.reference.index:=NR_STACK_POINTER_REG + else + paraloc^.reference.index:=NR_FRAME_POINTER_REG; + varalign:=used_align(size_2_align(l),paraalign,paraalign); + paraloc^.reference.offset:=parasize; + if side=calleeside then + inc(paraloc^.reference.offset,target_info.first_parm_offset); + parasize:=align(parasize+l,varalign); + dec(paralen,l); + end; + end; + end; + end; + case pass of + 1: + begin + if i=paras.count-1 then + break; + inc(i); + end; + 2: + begin + if i=0 then + break; + dec(i); + end; + end; + end; + end; + end; + + + function ti386paramanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint; + var + parasize, + parareg : longint; + begin + parasize:=0; + parareg:=0; + case p.proccalloption of + pocall_register : + create_register_paraloc_info(p,side,p.paras,parareg,parasize); + pocall_internproc : + begin + { Use default calling } +{$warnings off} + if (pocall_default=pocall_register) then + create_register_paraloc_info(p,side,p.paras,parareg,parasize) + else + create_stdcall_paraloc_info(p,side,p.paras,parasize); +{$warnings on} + end; + else + create_stdcall_paraloc_info(p,side,p.paras,parasize); + end; + create_funcretloc_info(p,side); + result:=parasize; + end; + + + function ti386paramanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint; + var + parasize : longint; + begin + parasize:=0; + { calculate the registers for the normal parameters } + create_stdcall_paraloc_info(p,callerside,p.paras,parasize); + { append the varargs } + create_stdcall_paraloc_info(p,callerside,varargspara,parasize); + result:=parasize; + end; + + + procedure ti386paramanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara); + begin + { Never a need for temps when value is pushed (calls inside parameters + will simply allocate even more stack space for their parameters) } + if not(use_fixed_stack) then + can_use_final_stack_loc:=true; + inherited createtempparaloc(list,calloption,parasym,can_use_final_stack_loc,cgpara); + end; + + +begin + paramanager:=ti386paramanager.create; +end. diff --git a/closures/compiler/i386/cpupi.pas b/closures/compiler/i386/cpupi.pas new file mode 100644 index 0000000000..3d3b35ce26 --- /dev/null +++ b/closures/compiler/i386/cpupi.pas @@ -0,0 +1,103 @@ +{ + 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 + psub,procinfo,aasmdata; + + type + ti386procinfo = class(tcgprocinfo) + constructor create(aparent:tprocinfo);override; + procedure set_first_temp_offset;override; + function calc_stackframe_size:longint;override; + procedure generate_parameter_info;override; + procedure allocate_got_register(list: tasmlist);override; + end; + + + implementation + + uses + cutils, + systems,globals,globtype, + cgobj,tgobj,paramgr, + cpubase, + cgutils, + symconst; + + constructor ti386procinfo.create(aparent:tprocinfo); + begin + inherited create(aparent); + got:=NR_EBX; + end; + + + procedure ti386procinfo.set_first_temp_offset; + begin + if paramanager.use_fixed_stack then + begin + if not(po_assembler in procdef.procoptions) and + (tg.direction > 0) then + tg.setfirsttemp(tg.direction*maxpushedparasize); + end; + end; + + + function ti386procinfo.calc_stackframe_size:longint; + begin + { align to 4 bytes at least + otherwise all those subl $2,%esp are meaningless PM } + if not(target_info.system in [system_i386_darwin,system_i386_iphonesim]) then + result:=Align(tg.direction*tg.lasttemp,min(current_settings.alignment.localalignmin,4)) + else + result:=tg.direction*tg.lasttemp+maxpushedparasize; + end; + + + procedure ti386procinfo.generate_parameter_info; + begin + inherited generate_parameter_info; + { Para_stack_size is only used to determine how many bytes to remove } + { from the stack at the end of the procedure (in the "ret $xx"). } + { If the stack is fixed, nothing has to be removed by the callee } + if paramanager.use_fixed_stack then + para_stack_size := 0; + end; + + procedure ti386procinfo.allocate_got_register(list: tasmlist); + begin + if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) and + (cs_create_pic in current_settings.moduleswitches) then + begin + got := cg.getaddressregister(list); + end; + end; + +begin + cprocinfo:=ti386procinfo; +end. diff --git a/closures/compiler/i386/cputarg.pas b/closures/compiler/i386/cputarg.pas new file mode 100644 index 0000000000..3b02424cba --- /dev/null +++ b/closures/compiler/i386/cputarg.pas @@ -0,0 +1,132 @@ +{ + Copyright (c) 2001-2002 by Peter Vreman + + Includes the i386 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 NOTARGETBSD} + ,t_bsd + {$endif} + {$ifndef NOTARGETSUNOS} + ,t_sunos + {$endif} + {$ifndef NOTARGETEMX} + ,t_emx + {$endif} + {$ifndef NOTARGETOS2} + ,t_os2 + {$endif} + {$ifndef NOTARGETWIN} + ,t_win + {$endif} + {$ifndef NOTARGETNETWARE} + ,t_nwm + {$endif} + {$ifndef NOTARGETNETWLIBC} + ,t_nwl + {$endif} + {$ifndef NOTARGETGO32V2} + ,t_go32v2 + {$endif} + {$ifndef NOTARGETBEOS} + ,t_beos + {$endif} + {$ifndef NOTARGETHAIKU} + ,t_haiku + {$endif} + {$ifndef NOTARGETWDOSX} + ,t_wdosx + {$endif} + {$ifndef NOTARGETWATCOM} + ,t_watcom + {$endif} + {$ifndef NOTARGETSYMBIAN} + ,t_symbian + {$endif} + {$ifndef NOTARGETNATIVENT} + ,t_nativent + {$endif} + {$ifndef NOTARGETEMBEDDED} + ,t_embed + {$endif} + +{************************************** + Assemblers +**************************************} + + {$ifndef NOAG386ATT} + ,agx86att + {$endif} + {$ifndef NOAG386NSM} + ,agx86nsm + {$endif} + {$ifndef NOAG386INT} + ,agx86int + {$endif} + + ,ogcoff + ,ogelf + ,ogmacho + +{************************************** + Assembler Readers +**************************************} + + {$ifndef NoRa386Int} + ,ra386int + {$endif NoRa386Int} + {$ifndef NoRa386Att} + ,ra386att + {$endif NoRa386Att} + +{************************************** + Debuginfo +**************************************} + + {$ifndef NoCFIDwarf} + ,cfidwarf + {$endif NoCFIDwarf} + {$ifndef NoDbgStabs} + ,dbgstabs + {$endif NoDbgStabs} + {$ifndef NoDbgDwarf} + ,dbgdwarf + {$endif NoDbgDwarf} + + ; + +end. diff --git a/closures/compiler/i386/csopt386.pas b/closures/compiler/i386/csopt386.pas new file mode 100644 index 0000000000..f8eaf47cd0 --- /dev/null +++ b/closures/compiler/i386/csopt386.pas @@ -0,0 +1,2255 @@ +{ + Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal + development team + + This unit contains the common subexpression elimination procedure. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS for A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit CSOpt386; + +{$i fpcdefs.inc} + +interface + +uses aasmbase,aasmtai,aasmdata,aasmcpu, cpuinfo, cpubase, cgbase; + +function CSE(asml: TAsmList; first, last: tai; pass: longint): boolean; + +function doReplaceReg(hp: taicpu; newReg, orgReg: tsuperregister): boolean; +function changeOp(var o: toper; newReg, orgReg: tsuperregister): boolean; +function storeBack(start, current: tai; orgReg, newReg: tsuperregister): boolean; +function NoHardCodedRegs(p: taicpu; orgReg, newReg: tsuperregister): boolean; +function RegSizesOK(oldReg,newReg: tsuperregister; p: taicpu): boolean; + +implementation + +uses +{$ifdef csdebug} + cutils, +{$else} + {$ifdef replaceregdebug}cutils,{$endif} +{$endif} + globtype, verbose, procinfo, globals, daopt386, rgobj, rropt386,cgutils; + +{ +function TaiInSequence(P: tai; Const Seq: TContent): Boolean; +var P1: tai; + Counter: Byte; + TmpResult: Boolean; +begin + TmpResult := False; + P1 := Seq.StartMod; + Counter := 1; + while not(TmpResult) and + (Counter <= Seq.NrofMods) do + begin + if (P = P1) then TmpResult := True; + inc(Counter); + p1 := tai(p1.Next); + end; + TaiInSequence := TmpResult; +end; +} + +function modifiesConflictingMemLocation(p1: tai; supreg: tsuperregister; c: tregContent; + var regsStillValid: tregset; onlymem: boolean; var invalsmemwrite: boolean): boolean; +var + p: taicpu; + tmpRef: treference; + regCounter: tsuperregister; + opCount: longint; + dummy: boolean; +begin + modifiesConflictingMemLocation := false; + invalsmemwrite := false; + if p1.typ <> ait_instruction then + exit; + p := taicpu(p1); + case p.opcode of + A_MOV,A_MOVSX,A_MOVZX: + if p.oper[1]^.typ = top_ref then + for regCounter := RS_EAX to RS_EDI do + begin + if (p.oper[0]^.typ<>top_reg) or + (getregtype(p.oper[0]^.reg) <> R_INTREGISTER) then + break; + if writeToMemDestroysContents(getsupreg(p.oper[0]^.reg),p.oper[1]^.ref^, + regCounter,topsize2tcgsize[p.opsize],c[regCounter],dummy) then + begin + exclude(regsStillValid,regCounter); + modifiesConflictingMemLocation := not(supreg in regsStillValid); + end; + if (regcounter = supreg) then + invalsmemwrite := invalsmemwrite or dummy; + end + else +{ if is_reg_var[getsupreg(p.oper[1]^.reg)] then } + if not onlymem then + for regCounter := RS_EAX to RS_EDI do + begin + if writeDestroysContents(p.oper[1]^,regCounter,topsize2tcgsize[p.opsize],c[regCounter],dummy) then + begin + exclude(regsStillValid,regCounter); + modifiesConflictingMemLocation := not(supreg in regsStillValid); + end + end; + A_DIV, A_IDIV, A_MUL, A_IMUL: + begin + if not onlymem then + if (p.ops = 1) then + begin + for regCounter := RS_EAX to RS_EDI do + begin + if writeToRegDestroysContents(RS_EDX,regCounter,c[regCounter]) then + begin + exclude(regsStillValid,RS_EDX); + modifiesConflictingMemLocation := not(supreg in regsStillValid); + end; + if writeToRegDestroysContents(RS_EAX,regCounter,c[regCounter]) then + begin + exclude(regsStillValid,RS_EAX); + modifiesConflictingMemLocation := not(supreg in regsStillValid); + end; + end + end + else + { only possible for imul } + { last operand is always destination } + for regCounter := RS_EAX to RS_EDI do + begin + if writeDestroysContents(p.oper[p.ops-1]^,regCounter,topsize2tcgsize[p.opsize],c[regCounter],dummy) then + begin + exclude(regsStillValid,regCounter); + modifiesConflictingMemLocation := not(supreg in regsStillValid); + end + end + end; + else + for opCount := 1 to maxinschanges do + case InsProp[p.opcode].Ch[opCount] of + Ch_MOp1,CH_WOp1,CH_RWOp1: + if not(onlymem) or + (p.oper[0]^.typ = top_ref) then +{ or ((p.oper[0]^.typ = top_reg) and } +{ is_reg_var[getsupreg(p.oper[0]^.reg)]) then } + for regCounter := RS_EAX to RS_EDI do + begin + if writeDestroysContents(p.oper[0]^,regCounter,topsize2tcgsize[p.opsize],c[regCounter],dummy) then + begin + exclude(regsStillValid,regCounter); + modifiesConflictingMemLocation := not(supreg in regsStillValid); + end; + if (regcounter = supreg) then + invalsmemwrite := invalsmemwrite or dummy; + end; + Ch_MOp2,CH_WOp2,CH_RWOp2: + if not(onlymem) or + (p.oper[1]^.typ = top_ref) then +{ or ((p.oper[1]^.typ = top_reg) and } +{ is_reg_var[getsupreg(p.oper[1]^.reg)]) then } + for regCounter := RS_EAX to RS_EDI do + begin + if writeDestroysContents(p.oper[1]^,regCounter,topsize2tcgsize[p.opsize],c[regCounter],dummy) then + begin + exclude(regsStillValid,regCounter); + modifiesConflictingMemLocation := not(supreg in regsStillValid); + end; + if (regcounter = supreg) then + invalsmemwrite := invalsmemwrite or dummy; + end; + Ch_MOp3,CH_WOp3,CH_RWOp3: + if not(onlymem) or + (p.oper[2]^.typ = top_ref) then +{ or ((p.oper[2]^.typ = top_reg) and } +{ is_reg_var[getsupreg(p.oper[2]^.reg)]) then } + for regCounter := RS_EAX to RS_EDI do + begin + if writeDestroysContents(p.oper[2]^,regCounter,topsize2tcgsize[p.opsize],c[regCounter],dummy) then + begin + exclude(regsStillValid,regCounter); + modifiesConflictingMemLocation := not(supreg in regsStillValid); + end; + if (regcounter = supreg) then + invalsmemwrite := invalsmemwrite or dummy; + end; + Ch_WMemEDI: + begin + fillchar(tmpref,sizeof(tmpref),0); + tmpRef.base := NR_EDI; + tmpRef.index := NR_EDI; + for regCounter := RS_EAX to RS_EDI do + begin + if writeToMemDestroysContents(RS_INVALID,tmpRef,regCounter,OS_32,c[regCounter],dummy) then + begin + exclude(regsStillValid,regCounter); + modifiesConflictingMemLocation := not(supreg in regsStillValid); + end; + if (regcounter = supreg) then + invalsmemwrite := invalsmemwrite or dummy; + end; + end; + end; + end; +end; + + +function isSimpleMemLoc(const ref: treference): boolean; +begin +{ isSimpleMemLoc := + (ref.index = RS_NO) and + not(ref.base in (rg.usableregsint+[RS_EDI]));} + isSimpleMemLoc := + (ref.index = NR_NO) and + ((ref.base = NR_NO) or + not(getsupreg(ref.base) in [RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI,RS_EDI])); +end; + + +{checks whether the current instruction sequence (starting with p) and the + one between StartMod and EndMod of Reg are the same. if so, the number of + instructions that match is stored in Found and true is returned, otherwise + Found holds the number of instructions between StartMod and EndMod and false + is returned} +function CheckSequence(p: tai; var prev: tai; supreg: tsuperregister; var Found: Longint; + var reginfo: toptreginfo; findPrevSeqs: boolean): Boolean; + +var + regsNotRead, regsStillValid : tregset; + checkingPrevSequences, + passedFlagsModifyingInstr : boolean; + + function getPrevSequence(p: tai; supreg: tsuperregister; currentPrev: tai; var newPrev: tai): tsuperregister; + + const + current_reg: tsuperregister = RS_INVALID; + + function stillValid(p: tai): boolean; + var + hp: tai; + begin + { only regvars are still used at jump instructions } + if (cs_opt_regvar in current_settings.optimizerswitches) and + (p.typ = ait_instruction) and + taicpu(p).is_jmp then + regsstillvalid := regsstillvalid - ptaiprop(p.optinfo)^.usedregs; + + stillValid := + (p.typ = ait_instruction) and + (taicpu(p).opcode <> a_jmp) and + (ptaiprop(p.optinfo)^.regs[supreg].wstate = + ptaiprop(currentPrev.optinfo)^.regs[supreg].wstate) and + { in case destroyreg is called with doIncState = false } + (ptaiprop(p.optinfo)^.regs[supreg].typ = + ptaiprop(currentPrev.optinfo)^.regs[supreg].typ) and + (supreg in (regsNotRead * regsStillValid)); + { stop if the register was still used right before a (conditional) } + { jump, since in that case its current contents could still be } + { used in the other path of the jump) } + if (p.typ = ait_instruction) and + (taicpu(p).is_jmp) and + getlastinstruction(p,hp) then + stillValid := stillValid and + not(supreg in ptaiprop(hp.optinfo)^.usedregs); + passedFlagsModifyingInstr := passedFlagsModifyingInstr or + instrWritesFlags(currentPrev); + end; + + + function findChangedRegister(p: tai): tsuperregister; + var + regCounter, loopstart: tsuperregister; + begin + if (current_reg <> RS_INVALID) then + loopstart := succ(current_reg) + else + loopstart := RS_EAX; + for regCounter := loopstart to RS_EDI do + with ptaiprop(p.optinfo)^.regs[regCounter] do + if ((startmod <> + ptaiprop(currentPrev.optinfo)^.regs[regCounter].startmod) or + (nrofMods <> + ptaiprop(currentPrev.optinfo)^.regs[regCounter].nrofMods)) and + (ptaiprop(p.optinfo)^.regs[regCounter].typ in [con_ref,con_noRemoveRef]) then + begin + findChangedRegister := regCounter; + current_reg := regCounter; + exit; + end; + current_reg := RS_INVALID; + findChangedRegister := RS_INVALID; + end; + + + var + hp, prevFound: tai; + tmpResult, regCounter: tsuperregister; + invalsmemwrite: boolean; + begin + if (current_reg <> RS_EDI) and + (current_reg <> RS_INVALID) then + begin + tmpResult := findChangedRegister(currentPrev); + if tmpResult <> RS_INVALID then + begin + getPrevSequence := tmpResult; + exit; + end; + end; + + getPrevSequence := RS_INVALID; + passedFlagsModifyingInstr := passedFlagsModifyingInstr or + instrWritesFlags(currentPrev); + if (cs_opt_regvar in current_settings.optimizerswitches) and + (currentprev.typ = ait_instruction) and + taicpu(currentprev).is_jmp then + regsstillvalid := regsstillvalid - ptaiprop(currentprev.optinfo)^.usedregs; + + if not getLastInstruction(currentPrev,hp) then + exit; + + prevFound := currentPrev; + tmpResult := RS_INVALID; + + while (tmpResult = RS_INVALID) and + stillValid(hp) and + (ptaiprop(prevFound.optinfo)^.canBeRemoved or + not(modifiesConflictingMemLocation(prevFound,supreg, + ptaiprop(p.optinfo)^.regs,regsStillValid,false, invalsmemwrite))) do + begin + { only update the regsread for the instructions we already passed } + if not(ptaiprop(prevFound.optinfo)^.canBeRemoved) then + for regCounter := RS_EAX to RS_EDI do + if regReadByInstruction(regCounter,prevFound) then + exclude(regsNotRead,regCounter); + + { in case getPreviousInstruction fails and sets hp to nil in the } + { next iteration } + prevFound := hp; + if not(ptaiprop(hp.optinfo)^.canBeRemoved) then + tmpResult := findChangedRegister(hp); + if not getLastInstruction(hp,hp) then + break; + end; + getPrevSequence := tmpResult; + if tmpResult <> RS_INVALID then + newPrev := prevFound; + end; + + + function getNextRegToTest(var prev: tai; currentReg: tsuperregister): tsuperregister; + begin + if not checkingPrevSequences then + begin + if (currentreg = RS_INVALID) then + currentreg := RS_EAX + else + inc(currentreg); + while (currentReg <= RS_EDI) and + not(ptaiprop(prev.optinfo)^.regs[currentReg].typ in [con_ref,con_noRemoveRef]) do + inc(currentReg); + if currentReg > RS_EDI then + begin + if (taicpu(p).oper[0]^.typ <> top_ref) or + isSimpleMemLoc(taicpu(p).oper[0]^.ref^) then + begin + checkingPrevSequences := true; + end + else + getNextRegToTest := RS_INVALID; + end + else + getNextRegToTest := currentReg; + end; + if checkingPrevSequences then + if findPrevSeqs then + getNextRegToTest := + getPrevSequence(p,supreg,prev,prev) + else + getNextRegToTest := RS_INVALID; + end; + + + function changedreginvalidatedbetween(const oldreginfo: toptreginfo; var newreginfo: toptreginfo; startp,endp,current: tai): boolean; + var + orgdiffregs,diffregs: tregset; + runner: tai; + invalsmemwrite: boolean; + begin + diffregs := newreginfo.newregsencountered - oldreginfo.newregsencountered; + orgdiffregs := diffregs; + if diffregs <> [] then + begin + runner := startp; + repeat + modifiesConflictingMemLocation(runner,RS_EAX { dummy },ptaiprop(current.optinfo)^.regs,diffregs,true,invalsmemwrite); + if orgdiffregs <> diffregs then + begin + changedreginvalidatedbetween := true; + newreginfo := oldreginfo; + exit; + end; + getnextinstruction(runner,runner); + until (runner = endp); + end; + changedreginvalidatedbetween := false; + end; + +var + prevreginfo: toptreginfo; + hp2, hp3{, EndMod}, prevhp3, highPrev, orgPrev, pprev: tai; + {Cnt,} OldNrofMods: Longint; + startRegInfo, OrgRegInfo, HighRegInfo: toptreginfo; + regModified, lastregloadremoved: array[RS_EAX..RS_ESP] of boolean; + HighFound, OrgRegFound: longint; + regcounter, regCounter2, tmpreg, base, index: tsuperregister; + OrgRegResult: Boolean; + TmpResult, flagResultsNeeded: Boolean; +begin {CheckSequence} + TmpResult := False; + FillChar(OrgRegInfo, Sizeof(OrgRegInfo), 0); + FillChar(startRegInfo, sizeof(startRegInfo), 0); + OrgRegFound := 0; + HighFound := 0; + OrgRegResult := False; + with startRegInfo do + begin + newRegsEncountered := [RS_EBP, RS_ESP]; + fillword(new2oldreg,sizeof(new2oldreg),RS_INVALID); + new2OldReg[RS_EBP] := RS_EBP; + new2OldReg[RS_ESP] := RS_ESP; + oldRegsEncountered := newRegsEncountered; + end; + + checkingPrevSequences := false; + passedFlagsModifyingInstr := false; + flagResultsNeeded := false; + regsNotRead := [RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESP,RS_EBP,RS_EDI,RS_ESI]; + regsStillValid := regsNotRead; + GetLastInstruction(p, prev); + pprev := prev; + tmpreg:=RS_INVALID; + regCounter := getNextRegToTest(prev,tmpreg); + while (regcounter <> RS_INVALID) do + begin + fillchar(regModified,sizeof(regModified),0); + fillchar(lastregloadremoved,sizeof(lastregloadremoved),0); + reginfo := startRegInfo; + Found := 0; + hp2 := ptaiprop(prev.optinfo)^.Regs[regcounter].StartMod; + if (prev <> ptaiprop(prev.optinfo)^.Regs[regcounter].StartMod) then + OldNrofMods := ptaiprop(prev.optinfo)^.Regs[regcounter].NrofMods + else + OldNrofMods := 1; + hp3 := p; + if checkingprevsequences then + prevreginfo := reginfo; + while (Found <> OldNrofMods) and + { old new } + InstructionsEquivalent(hp2, hp3, reginfo) and + (not(checkingprevsequences) or + not(changedreginvalidatedbetween(prevreginfo,reginfo,prev,p,hp3))) do + begin + if checkingprevsequences then + begin + prevreginfo := reginfo; + end; + if (hp3.typ = ait_instruction) and + ((taicpu(hp3).opcode = A_MOV) or + (taicpu(hp3).opcode = A_MOVZX) or + (taicpu(hp3).opcode = A_LEA) or + (taicpu(hp3).opcode = A_MOVSX)) and + (taicpu(hp3).oper[1]^.typ = top_reg) and + not(regInOp(getsupreg(taicpu(hp3).oper[1]^.reg),taicpu(hp3).oper[0]^)) then + begin + tmpreg := getsupreg(taicpu(hp3).oper[1]^.reg); + lastregloadremoved[tmpreg] := ptaiprop(hp2.optinfo)^.canberemoved; + reginfo.lastReload[tmpreg] := hp3; + case taicpu(hp3).oper[0]^.typ of + top_ref: + begin + base := getsupreg(taicpu(hp3).oper[0]^.ref^.base); + index := getsupreg(taicpu(hp3).oper[0]^.ref^.index); + if (found <> 0) and + ((taicpu(hp3).oper[0]^.ref^.base = NR_NO) or + regModified[base] or + (base = getsupreg(current_procinfo.framepointer))) and + ((taicpu(hp3).oper[0]^.ref^.index = NR_NO) or + regModified[index]) and + not(regInRef(tmpReg,taicpu(hp3).oper[0]^.ref^)) then + begin + with ptaiprop(hp3.optinfo)^.regs[tmpreg] do + if nrofMods > (oldNrofMods - found) then + oldNrofMods := found + nrofMods; + { next is safe because instructions are equivalent } + with ptaiprop(hp2.optinfo)^.regs[getsupreg(taicpu(hp2).oper[1]^.reg)] do + if nrofMods > (oldNrofMods - found) then + oldNrofMods := found + nrofMods; + end; + end; + top_reg: + if regModified[getsupreg(taicpu(hp3).oper[0]^.reg)] then + begin + with ptaiprop(hp3.optinfo)^.regs[tmpreg] do + if nrofMods > (oldNrofMods - found) then + oldNrofMods := found + nrofMods; + with ptaiprop(hp2.optinfo)^.regs[getsupreg(taicpu(hp2).oper[1]^.reg)] do + if nrofMods > (oldNrofMods - found) then + oldNrofMods := found + nrofMods; + end; + end; + end; + for regCounter2 := RS_EAX to RS_EDI do + regModified[regCounter2] := regModified[regCounter2] or + regModifiedByInstruction(regCounter2,hp3); + if flagResultsNeeded then + flagResultsNeeded := not instrReadsFlags(hp3); + if not flagResultsNeeded then + flagResultsNeeded := ptaiprop(hp3.optinfo)^.FlagsUsed; + inc(Found); + prevhp3 := hp3; + if (Found <> OldNrofMods) then + if not GetNextInstruction(hp2, hp2) or + not GetNextInstruction(hp3, hp3) then + break; + end; + + if assigned(hp3) then + begin + prevhp3 := hp3; + getnextinstruction(hp3,hp3); + end; + if not assigned(hp3) or + { a marker has no optinfo, which is used below } + (hp3.typ = ait_marker) then + hp3 := prevhp3; +{ +a) movl -4(%ebp),%edx + movl -12(%ebp),%ecx + ... + movl -8(%ebp),%eax + movl -12(%ebp),%edx (marked as removable) + movl (%eax,%edx),%eax (replaced by "movl (%eax,%ecx),%eax") + ... + movl -8(%ebp),%eax + movl -12(%ebp),%edx + movl (%eax,%edx),%eax + movl (%edx),%edx + +-> the "movl -12(ebp),%edx" can't be removed in the last sequence, because + edx has not been replaced with ecx there, and edx is still used after the + sequence + +b) tests/webtbs/tw4266.pp +} + + { hp2 = instruction after previous sequence, pprev = instruction before } + { current sequence, prev = instruction where the loads of the registers } + { will be inserted } + for regCounter2 := RS_EAX to RS_EDI do + if (reginfo.new2OldReg[regCounter2] <> RS_INVALID) and + { case a) above } + (((regCounter2 in ptaiprop(hp3.optinfo)^.usedRegs) and + (not regLoadedWithNewValue(regCounter2,false,hp3) and + lastregloadremoved[regcounter2])) or + { case b) above } + ((ptaiprop(hp2.optinfo)^.regs[regCounter2].wstate <> + ptaiprop(pprev.optinfo)^.regs[regcounter2].wstate)) or + ((ptaiprop(hp2.optinfo)^.regs[reginfo.new2OldReg[regCounter2]].wstate <> + ptaiprop(prev.optinfo)^.regs[reginfo.new2OldReg[regCounter2]].wstate))) then + begin + found := 0; + break; + end; + + if checkingPrevSequences then + begin + for regCounter2 := RS_EAX to RS_EDI do + if (reginfo.new2OldReg[regCounter2] <> RS_INVALID) and + (reginfo.new2OldReg[regCounter2] <> regCounter2) and + (not(regCounter2 in (regsNotRead * regsStillValid)) or + not(reginfo.new2OldReg[regCounter2] in regsStillValid)) then + begin + found := 0; + break; + end; + if passedFlagsModifyingInstr and flagResultsNeeded then + found := 0; + end; + + TmpResult := true; + if (found <> OldNrofMods) then + TmpResult := false + else if assigned(hp3) then + for regcounter2 := RS_EAX to RS_EDI do + if (regcounter2 in reginfo.regsLoadedforRef) and + regModified[regcounter2] and + (regcounter2 in ptaiprop(hp3.optinfo)^.usedRegs) and + not regLoadedWithNewValue(regcounter2,false,hp3) then + begin + TmpResult := False; + if (found > 0) then + {this is correct because we only need to turn off the CanBeRemoved flag + when an instruction has already been processed by CheckSequence + (otherwise CanBeRemoved can't be true and thus can't have to be turned off). + if it has already been processed by CheckSequence and flagged to be + removed, it means that it has been checked against a previous sequence + and that it was equal (otherwise CheckSequence would have returned false + and the instruction wouldn't have been removed). if this "if found > 0" + check is left out, incorrect optimizations are performed.} + Found := ptaiprop(tai(p).optinfo)^.Regs[supreg].NrofMods; + break; + end; + + if TmpResult and + (Found > HighFound) then + begin + highPrev := prev; + HighFound := Found; + HighRegInfo := reginfo; + end; + if (regcounter = supreg) then + begin + orgPrev := prev; + OrgRegFound := Found; + OrgRegResult := TmpResult; + OrgRegInfo := reginfo + end; + regCounter := getNextRegToTest(prev,regCounter); + end; + if (HighFound > 0) and + (not(OrgRegResult) Or + (HighFound > OrgRegFound)) + then + begin + CheckSequence := True; + prev := highPrev; + reginfo := HighRegInfo; + Found := HighFound + end + else + begin + CheckSequence := OrgRegResult; + prev := orgPrev; + Found := OrgRegFound; + reginfo := OrgRegInfo; + end; +end; {CheckSequence} + + +procedure SetAlignReg(p: tai); +Const alignSearch = 12; +var regsUsable: TRegSet; + prevInstrCount, nextInstrCount: Longint; + prevState, nextWState,nextRState: Array[RS_EAX..RS_EDI] of byte; + regCounter, lastRemoved: tsuperregister; + prev, next: tai; +{$ifdef alignregdebug} + temp: tai; +{$endif alignregdebug} +begin + regsUsable := [RS_EAX,RS_ECX,RS_EDX,RS_EBX,{R_ESP,RS_EBP,}RS_ESI,RS_EDI]; + for regCounter := RS_EAX to RS_EDI do + begin + prevState[regCounter] := ptaiprop(p.optinfo)^.Regs[regCounter].wState; + nextWState[regCounter] := ptaiprop(p.optinfo)^.Regs[regCounter].wState; + nextRState[regCounter] := ptaiprop(p.optinfo)^.Regs[regCounter].rState; + end; + getLastInstruction(p,prev); + getNextInstruction(p,next); + lastRemoved := getsupreg(tai_align(p).reg); + nextInstrCount := 0; + prevInstrCount := 0; + while ((assigned(prev) and + assigned(prev.optinfo) and + (prevInstrCount < alignSearch)) or + (assigned(next) and + assigned(next.optinfo) and + (nextInstrCount < alignSearch))) and + (regsUsable <> []) do + begin +{$ifdef alignregdebug} + if assigned(prev) then + begin + temp := tai_comment.Create(strpnew('got here')); + temp.next := prev.next; + temp.previous := prev; + prev.next := temp; + if assigned(temp.next) then + temp.next.previous := temp; + end; +{$endif alignregdebug} + if assigned(prev) and assigned(prev.optinfo) and + (prevInstrCount < alignSearch) then + begin + if (prev.typ = ait_instruction) and + (insProp[taicpu(prev).opcode].ch[1] <> Ch_ALL) and + (taicpu(prev).opcode <> A_JMP) then + begin + inc(prevInstrCount); + for regCounter := RS_EAX to RS_EDI do + begin + if (regCounter in regsUsable) and + (ptaiprop(prev.optinfo)^.Regs[regCounter].wState <> + prevState[regCounter]) then + begin + lastRemoved := regCounter; + exclude(regsUsable,regCounter); +{$ifdef alignregdebug} + temp := tai_comment.Create(strpnew( + std_regname(newreg(R_INTREGISTER,regCounter,R_SUBWHOLE))+' removed'))); + temp.next := prev.next; + temp.previous := prev; + prev.next := temp; + if assigned(temp.next) then + temp.next.previous := temp; + if regsUsable = [] then + begin + temp := tai_comment.Create(strpnew( + 'regsUsable empty here'))); + temp.next := prev.next; + temp.previous := prev; + prev.next := temp; + if assigned(temp.next) then + temp.next.previous := temp; + end; +{$endif alignregdebug} + end; + prevState[regCounter] := + ptaiprop(prev.optinfo)^.Regs[regCounter].wState; + end; + getLastInstruction(prev,prev); + end + else + if GetLastInstruction(prev,prev) and + assigned(prev.optinfo) then + for regCounter := RS_EAX to RS_EDI do + prevState[regCounter] := + ptaiprop(prev.optinfo)^.Regs[regCounter].wState + end; + if assigned(next) and assigned(next.optinfo) and + (nextInstrCount < alignSearch) then + begin + if (next.typ = ait_instruction) and + (insProp[taicpu(next).opcode].ch[1] <> Ch_ALL) and + (taicpu(next).opcode <> A_JMP) then + begin + inc(nextInstrCount); + for regCounter := RS_EAX to RS_EDI do + begin + if (regCounter in regsUsable) and + ((ptaiprop(next.optinfo)^.Regs[regCounter].wState <> + nextWState[regCounter]) or + (ptaiprop(next.optinfo)^.Regs[regCounter].rState <> + nextRState[regCounter])) then + begin + lastRemoved := regCounter; + exclude(regsUsable,regCounter); +{$ifdef alignregdebug} + temp := tai_comment.Create(strpnew( + std_regname(newreg(R_INTREGISTER,regCounter,R_SUBWHOLE))+' removed'))); + temp.next := next.next; + temp.previous := next; + next.next := temp; + if assigned(temp.next) then + temp.next.previous := temp; + if regsUsable = [] then + begin + temp := tai_comment.Create(strpnew( + 'regsUsable empty here'))); + temp.next := next.next; + temp.previous := next; + next.next := temp; + if assigned(temp.next) then + temp.next.previous := temp; + end; +{$endif alignregdebug} + end; + nextWState[regCounter] := + ptaiprop(next.optinfo)^.Regs[regCounter].wState; + nextRState[regCounter] := + ptaiprop(next.optinfo)^.Regs[regCounter].rState; + end + end + else + for regCounter := RS_EAX to RS_EDI do + begin + nextWState[regCounter] := + ptaiprop(next.optinfo)^.Regs[regCounter].wState; + nextRState[regCounter] := + ptaiprop(next.optinfo)^.Regs[regCounter].rState; + end; + getNextInstruction(next,next); + end; + end; + if regsUsable <> [] then + for regCounter := RS_EAX to RS_EDI do + if regCounter in regsUsable then + begin + lastRemoved := regCounter; + break + end; +{$ifdef alignregdebug} + next := tai_comment.Create(strpnew(std_regname(newreg(R_INTREGISTER,lastremoved,R_SUBWHOLE))+ + ' chosen as alignment register'))); + next.next := p.next; + next.previous := p; + p.next := next; + if assigned(next.next) then + next.next.previous := next; +{$endif alignregdebug} + tai_align(p).reg := newreg(R_INTREGISTER,lastRemoved,R_SUBWHOLE); +end; + + +procedure clearmemwrites(p: tai; supreg: tsuperregister); +var + beginmemwrite: tai; +begin + beginmemwrite := ptaiprop(p.optinfo)^.regs[supreg].memwrite; + repeat + ptaiprop(p.optinfo)^.regs[supreg].memwrite := nil; + until not getnextinstruction(p,p) or + (ptaiprop(p.optinfo)^.regs[supreg].memwrite <> beginmemwrite); +end; + + +procedure ClearRegContentsFrom(asml: TAsmList; supreg: tsuperregister; p, endP: tai); +{ first clears the contents of reg from p till endP. then the contents are } +{ cleared until the first instruction that changes reg } +var +{$ifdef replaceregdebug} + hp: tai; + l: longint; +{$endif replaceregdebug} + regcounter: tsuperregister; + oldStartmod: tai; + regstoclear: tregset; +begin +{$ifdef replaceregdebug} + l := random(1000); + hp := tai_comment.Create(strpnew( + 'cleared '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+' from here... '+tostr(l))); + insertllitem(asml,p.previous,p,hp); +{$endif replaceregdebug} + ptaiprop(p.optinfo)^.Regs[supreg].typ := con_unknown; + regstoclear := [supreg]; + while (p <> endP) do + begin + for regcounter := RS_EAX to RS_EDI do + begin + if (regcounter <> supreg) and + assigned(ptaiprop(p.optinfo)^.regs[supreg].memwrite) and + reginref(regcounter,ptaiprop(p.optinfo)^.regs[supreg].memwrite.oper[1]^.ref^) then + clearmemwrites(p,regcounter); + { needs double loop to cheack for each dependency combination? } + if assigned(ptaiprop(p.optinfo)^.regs[regcounter].startmod) and + sequencedependsonreg(ptaiprop(p.optinfo)^.regs[regcounter],regcounter,supreg) then + include(regstoclear,regcounter); + + if regcounter in regstoclear then + with ptaiprop(p.optinfo)^.Regs[regcounter] do + begin + typ := con_unknown; + memwrite := nil; + startmod := nil; + nrofmods := 0; + end; + end; + getNextInstruction(p,p); + end; + oldStartmod := ptaiprop(p.optinfo)^.Regs[supreg].startmod; + repeat + for regcounter := RS_EAX to RS_EDI do + begin + { needs double loop to cheack for each dependency combination? } + if assigned(ptaiprop(p.optinfo)^.regs[regcounter].startmod) and + sequencedependsonreg(ptaiprop(p.optinfo)^.regs[regcounter],regcounter,supreg) then + include(regstoclear,regcounter); + with ptaiprop(p.optinfo)^.Regs[supreg] do + if regcounter in regstoclear then + begin + typ := con_unknown; + memwrite := nil; + end; + end; + until not getNextInstruction(p,p) or + (ptaiprop(p.optinfo)^.Regs[supreg].startmod <> oldStartmod); +{$ifdef replaceregdebug} + if assigned(p) then + begin + hp := tai_comment.Create(strpnew( + 'cleared '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+' till here... '+tostr(l))); + insertllitem(asml,p.previous,p,hp); + end; +{$endif replaceregdebug} +end; + +procedure RestoreRegContentsTo(asml: TAsmList; supreg: tsuperregister; const c: TContent; p, endP: tai); +var +{$ifdef replaceregdebug} + l: longint; +{$endif replaceregdebug} + hp: tai; + validregs, prevvalidregs: tregset; + regcounter: tsuperregister; + tmpState, newrstate: byte; + prevcontenttyp: byte; + memconflict: boolean; + invalsmemwrite: boolean; +begin +{$ifdef replaceregdebug} + l := random(1000); + hp := tai_comment.Create(strpnew( + 'restored '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+' with data from here... '+tostr(l))); + insertllitem(asml,p.previous,p,hp); +{$endif replaceregdebug} +{ ptaiprop(p.optinfo)^.Regs[reg] := c;} + newrstate := c.rstate; + incstate(newrstate,$7f); + memconflict := false; + invalsmemwrite := false; + validregs := [RS_EAX..RS_EDI]; + prevvalidregs := validregs; + while (p <> endP) and + not(memconflict) and + not(invalsmemwrite) do + begin + if not(ptaiprop(p.optinfo)^.canberemoved) and + regreadbyinstruction(supreg,p) then + incstate(newrstate,1); + // is this a write to memory that destroys the contents we are restoring? + memconflict := modifiesConflictingMemLocation(p,supreg,ptaiprop(p.optinfo)^.regs,validregs,false,invalsmemwrite); + if (validregs <> prevvalidregs) then + begin + prevvalidregs := validregs >< prevvalidregs; + for regcounter := RS_EAX to RS_EDI do + if regcounter in prevvalidregs then + clearRegContentsFrom(asml,regcounter,p,endP); + end; + prevvalidregs := validregs; + if (not memconflict and not invalsmemwrite) then + begin + ptaiprop(p.optinfo)^.Regs[supreg] := c; + ptaiprop(p.optinfo)^.Regs[supreg].rstate := newrstate; + end + else + begin + clearRegContentsFrom(asml,supreg,p,endP); +{$ifdef replaceregdebug} + if assigned(p) then + begin + hp := tai_comment.Create(strpnew( + 'stopping restoring of '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+'because memory conflict... '+tostr(l))); + insertllitem(asml,p,p.next,hp); + end; +{$endif replaceregdebug} + exit + end; + + getNextInstruction(p,p); + end; + + tmpState := ptaiprop(p.optinfo)^.Regs[supreg].wState; + if (newrstate = ptaiprop(p.optinfo)^.Regs[supreg].rState) then + begin + incstate(ptaiprop(p.optinfo)^.regs[supreg].rstate,63); + if not getnextinstruction(p,hp) then + exit; + if (ptaiprop(hp.optinfo)^.regs[supreg].rstate = ptaiprop(p.optinfo)^.regs[supreg].rstate) then + internalerror(2004122710); + end; + repeat + newrstate := ptaiprop(p.optinfo)^.Regs[supreg].rState; + prevcontenttyp := ptaiprop(p.optinfo)^.Regs[supreg].typ; + // is this a write to memory that destroys the contents we are restoring? + memconflict := modifiesConflictingMemLocation(p,supreg,ptaiprop(p.optinfo)^.regs,validregs,false,invalsmemwrite); + if (validregs <> prevvalidregs) then + begin + prevvalidregs := validregs >< prevvalidregs; + for regcounter := RS_EAX to RS_EDI do + if regcounter in prevvalidregs then + clearRegContentsFrom(asml,regcounter,p,p); + end; + prevvalidregs := validregs; + if (not memconflict and not invalsmemwrite) then + begin + ptaiprop(p.optinfo)^.Regs[supreg] := c; + ptaiprop(p.optinfo)^.Regs[supreg].rstate := newrstate; + end; + until invalsmemwrite or + memconflict or + not getNextInstruction(p,p) or + (ptaiprop(p.optinfo)^.Regs[supreg].wState <> tmpState) or + (p.typ = ait_label) or + ((prevcontenttyp <> con_invalid) and + (ptaiprop(p.optinfo)^.Regs[supreg].typ = con_invalid)); + if assigned(p) and + (p.typ <> ait_marker) then + if ((p.typ = ait_label) or + memconflict or + invalsmemwrite) then + clearRegContentsFrom(asml,supreg,p,p) + else if (ptaiprop(p.optinfo)^.Regs[supreg].rstate = newrstate) then + incstate(ptaiprop(p.optinfo)^.Regs[supreg].rstate,20); +{$ifdef replaceregdebug} + if assigned(p) then + begin + hp := tai_comment.Create(strpnew( + 'restored '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+' till here... '+tostr(l))); + insertllitem(asml,p,p.next,hp); + end; +{$endif replaceregdebug} +end; + +function NoHardCodedRegs(p: taicpu; orgReg, newReg: tsuperregister): boolean; +var + chCount: byte; +begin + case p.opcode of + A_IMUL: noHardCodedRegs := p.ops <> 1; + A_SHL,A_SHR,A_ROR,A_ROL,A_SAR,A_SHLD,A_SHRD: noHardCodedRegs := + (p.oper[0]^.typ <> top_reg) or + ((orgReg <> RS_ECX) and (newReg <> RS_ECX)); + else + begin + NoHardCodedRegs := true; + with InsProp[p.opcode] do + for chCount := 1 to maxinschanges do + if Ch[chCount] in ([Ch_REAX..Ch_MEDI,Ch_WMemEDI,Ch_All]-[Ch_RESP,Ch_WESP,Ch_RWESP]) then + begin + NoHardCodedRegs := false; + break + end; + end; + end; +end; + + +function ChangeReg(var Reg: TRegister; newReg, orgReg: tsuperregister): boolean; +begin + changereg := false; + if (reg <> NR_NO) and + (getregtype(reg) = R_INTREGISTER) and + (getsupreg(reg) = newreg) then + begin + changereg := true; + setsupreg(reg,orgreg); + end; +end; + + +function changeOp(var o: toper; newReg, orgReg: tsuperregister): boolean; +var + tmpresult: boolean; +begin + changeOp := false; + case o.typ of + top_reg: changeOp := changeReg(o.reg,newReg,orgReg); + top_ref: + begin + tmpresult := changeReg(o.ref^.base,newReg,orgReg); + changeop := changeReg(o.ref^.index,newReg,orgReg) or tmpresult; + end; + end; +end; + + +procedure updateStates(orgReg,newReg: tsuperregister; hp: tai; writeStateToo: boolean); +var + prev: tai; + newOrgRegRState, newOrgRegWState: byte; +begin + if getLastInstruction(hp,prev) then + with ptaiprop(prev.optinfo)^ do + begin + newOrgRegRState := byte(longint(regs[orgReg].rState) + + longint(ptaiprop(hp.optinfo)^.regs[newReg].rState) - regs[newReg].rstate); + if writeStateToo then + newOrgRegWState := byte(longint(regs[orgReg].wState) + + longint(ptaiprop(hp.optinfo)^.regs[newReg].wState) - regs[newReg].wstate); + end + else + with ptaiprop(hp.optinfo)^.regs[newReg] do + begin + newOrgRegRState := rState; + if writeStateToo then + newOrgRegWState := wState; + end; + with ptaiprop(hp.optinfo)^.regs[orgReg] do + begin + rState := newOrgRegRState; + if writeStateToo then + wState := newOrgRegwState; + end; +end; + + +function doReplaceReg(hp: taicpu; newReg, orgReg: tsuperregister): boolean; +var + opCount: longint; + tmpResult: boolean; +begin + tmpresult := false; + for opCount := 0 to hp.ops-1 do + tmpResult := + changeOp(hp.oper[opCount]^,newReg,orgReg) or tmpResult; + doReplaceReg := tmpResult; +end; + + +function RegSizesOK(oldReg,newReg: tsuperregister; p: taicpu): boolean; +{ oldreg and newreg must be 32bit components } +var + opCount: longint; + tmpreg: tsuperregister; +begin + RegSizesOK := true; + { if only one of them is a general purpose register ... } + if (IsGP32reg(oldReg) xor IsGP32Reg(newReg)) then + begin + for opCount := 0 to p.ops-1 do + if (p.oper[opCount]^.typ = top_reg) and + (getsubreg(p.oper[opCount]^.reg) in [R_SUBL,R_SUBH]) then + begin + tmpreg := getsupreg(p.oper[opCount]^.reg); + if (tmpreg = oldreg) or + (tmpreg = newreg) then + begin + RegSizesOK := false; + break + end + end; + end; +end; + + +function doReplaceReadReg(p: taicpu; newReg,orgReg: tsuperregister): boolean; +var + opCount: longint; +begin + doReplaceReadReg := false; + { handle special case } + case p.opcode of + A_IMUL: + begin + case p.ops of + 1: internalerror(1301001); + 2,3: + begin + if changeOp(p.oper[0]^,newReg,orgReg) then + begin +{ updateStates(orgReg,newReg,p,false);} + doReplaceReadReg := true; + end; + if p.ops = 3 then + if changeOp(p.oper[1]^,newReg,orgReg) then + begin +{ updateStates(orgReg,newReg,p,false);} + doReplaceReadReg := true; + end; + end; + end; + end; + A_DIV,A_IDIV,A_MUL: internalerror(1301002); + else + begin + for opCount := 0 to p.ops-1 do + if p.oper[opCount]^.typ = top_ref then + if changeOp(p.oper[opCount]^,newReg,orgReg) then + begin +{ updateStates(orgReg,newReg,p,false);} + doReplaceReadReg := true; + end; + for opCount := 1 to maxinschanges do + case InsProp[p.opcode].Ch[opCount] of + Ch_ROp1: + if p.oper[0]^.typ = top_reg then + if changeReg(p.oper[0]^.reg,newReg,orgReg) then + begin +{ updateStates(orgReg,newReg,p,false);} + doReplaceReadReg := true; + end; + Ch_ROp2: + if p.oper[1]^.typ = top_reg then + if changeReg(p.oper[1]^.reg,newReg,orgReg) then + begin +{ updateStates(orgReg,newReg,p,false);} + doReplaceReadReg := true; + end; + Ch_ROp3: + if p.oper[2]^.typ = top_reg then + if changeReg(p.oper[2]^.reg,newReg,orgReg) then + begin +{ updateStates(orgReg,newReg,p,false);} + doReplaceReadReg := true; + end; + end; + end; + end; +end; + + +procedure updateState(supreg: tsuperregister; p: tai); +{ this procedure updates the read and write states of the instructions } +{ coming after p. It's called when the read/write state of p has been } +{ changed and this change has to be propagated to the following } +{ instructions as well } +var + newRState, newWState: byte; + prevRState, prevWState: byte; + doRState, doWState: boolean; +begin + { get the new read/write states from p } + with ptaiprop(p.optinfo)^.regs[supreg] do + begin + newRState := rState; + newWState := wState; + end; + if not GetNextInstruction(p,p) then + exit; + { get the old read/write states from the next instruction, to know } + { when we can stop updating } + with ptaiprop(p.optinfo)^.regs[supreg] do + begin + prevRState := rState; + prevWState := wState; + end; + { adjust the states if this next instruction reads/writes the register } + if regReadByInstruction(supreg,p) then + incState(newRState,1); + if regModifiedByInstruction(supreg,p) then + incState(newWState,1); + { do we still have to update the read and/or write states? } + doRState := true; + doWState := true; + repeat + { update the states } + with ptaiprop(p.optinfo)^.regs[supreg] do + begin + if doRState then + rState := newRState; + if doWState then + wState := newWState; + end; + if not getNextInstruction(p,p) then + break; + with ptaiprop(p.optinfo)^.regs[supreg] do + begin + { stop updating the read state if it changes } + doRState := + doRState and (rState = prevRState); + { if, by accident, this changed state is the same as the one } + { we've been using, change it to a value that's definitely } + { different from the previous and next state } + if not doRState and + (rState = newRState) then + begin + incState(newRState,1); + prevRState := rState; + doRState := true; + end; + { ditto for the write state } + doWState := + doWState and (WState = prevWState); + if not doWState and + (wState = newWState) then + begin + incState(newWState,1); + prevWState := wState; + doWState := true; + end; + end; + { stop when we don't have to update either state anymore } + until not(doRState or doWState); +end; + + +function storeBack(start, current: tai; orgReg, newReg: tsuperregister): boolean; +{ returns true if p1 contains an instruction that stores the contents } +{ of newReg back to orgReg } +begin + storeback := false; + if (current.typ = ait_instruction) and + (taicpu(current).opcode = A_MOV) and + (taicpu(current).oper[0]^.typ = top_reg) and + (getsupreg(taicpu(current).oper[0]^.reg) = newReg) and + (taicpu(current).oper[1]^.typ = top_reg) and + (getsupreg(taicpu(current).oper[1]^.reg) = orgReg) then + case taicpu(current).opsize of + S_B: + storeback := true; + S_W: + storeback := taicpu(start).opsize <> S_B; + S_L: + storeback := taicpu(start).opsize = S_L; + else + internalerror(2003121501); + end; +end; + + +function canreplacereg(orgsupreg, newsupreg: tsuperregister; p: tai; + orgRegCanBeModified: boolean; var resnewregmodified, resorgregread, resremovelast: boolean; var returnendp: tai): boolean; +var + endP, hp: tai; + removeLast, sequenceEnd, tmpResult, newRegModified, orgRegRead: boolean; +begin + canreplacereg := false; + tmpResult := true; + sequenceEnd := false; + newRegModified := false; + orgRegRead := false; + removeLast := false; + endP := p; + while tmpResult and not sequenceEnd do + begin + tmpResult := + getNextInstruction(endP,endP) and + (endp.typ = ait_instruction) and + not(taicpu(endp).is_jmp); + if tmpresult and not assigned(endp.optinfo) then + begin +{ hp := tai_comment.Create(strpnew('next no optinfo')); + hp.next := endp; + hp.previous := endp.previous; + endp.previous := hp; + if assigned(hp.previous) then + hp.previous.next := hp;} + exit; + end; + if tmpResult and + { don't take into account instructions that will be removed } + not (ptaiprop(endp.optinfo)^.canBeRemoved) then + begin + { if the newsupreg gets stored back to the oldReg, we can change } + { "mov %oldReg,%newReg; <operations on %newReg>; mov %newReg, } + { %oldReg" to "<operations on %oldReg>" } + removeLast := storeBack(p,endP, orgsupreg, newsupreg); + sequenceEnd := + { no support for (i)div, mul and imul with hardcoded operands } + noHardCodedRegs(taicpu(endP),orgsupreg,newsupreg) and + { if newsupreg gets loaded with a new value, we can stop } + { replacing newsupreg with oldReg here (possibly keeping } + { the original contents of oldReg so we still know them } + { afterwards) } + (RegLoadedWithNewValue(newsupreg,true,taicpu(endP)) or + { we can also stop if we reached the end of the use of } + { newReg's current contents } + (GetNextInstruction(endp,hp) and + FindRegDealloc(newsupreg,hp))); + { to be able to remove the first and last instruction of } + { movl %reg1, %reg2 } + { <operations on %reg2> (replacing reg2 with reg1 here) } + { movl %reg2, %reg1 } + { %reg2 must not be use afterwards (it can be as the } + { result of a peepholeoptimization) } + removeLast := removeLast and sequenceEnd; + newRegModified := + newRegModified or + (not(regLoadedWithNewValue(newsupreg,true,taicpu(endP))) and + RegModifiedByInstruction(newsupreg,endP)); + orgRegRead := newRegModified and RegReadByInstruction(orgsupreg,endP); + sequenceEnd := SequenceEnd and + (removeLast or + { since newsupreg will be replaced by orgsupreg, we can't allow that newsupreg } + { gets modified if orgsupreg is still read afterwards (since after } + { replacing, this would mean that orgsupreg first gets modified and then } + { gets read in the assumption it still contains the unmodified value) } + not(newRegModified and orgRegRead)) (* and + { since newsupreg will be replaced by orgsupreg, we can't allow that newsupreg } + { gets modified if orgRegCanBeModified = false } + + { this now gets checked after the loop (JM) } + (orgRegCanBeModified or not(newRegModified)) *); + tmpResult := + not(removeLast) and + not(newRegModified and orgRegRead) and +(* (orgRegCanBeModified or not(newRegModified)) and *) +(* already checked at the top + (endp.typ = ait_instruction) and *) + NoHardCodedRegs(taicpu(endP),orgsupreg,newsupreg) and + RegSizesOk(orgsupreg,newsupreg,taicpu(endP)) and + not RegModifiedByInstruction(orgsupreg,endP); + end; + end; + canreplacereg := sequenceEnd and + (removeLast or + (orgRegCanBeModified or not(newRegModified))) and + (not(assigned(endp)) or + not(endp.typ = ait_instruction) or + (noHardCodedRegs(taicpu(endP),orgsupreg,newsupreg) and + RegSizesOk(orgsupreg,newsupreg,taicpu(endP)) and + not(newRegModified and + (orgsupreg in ptaiprop(endp.optinfo)^.usedRegs) and + not(RegLoadedWithNewValue(orgsupreg,true,taicpu(endP)))))); + if canreplacereg then + begin + resnewregmodified := newregmodified; + resorgregread := orgregread; + resremovelast := removelast; + end; + { needed for replaceregdebug code } + returnendp := endp; +end; + + + +function ReplaceReg(asml: TAsmList; orgsupreg, newsupreg: tsuperregister; p, + seqstart: tai; const c: TContent; orgRegCanBeModified: Boolean; + var returnEndP: tai): Boolean; +{ Tries to replace orgsupreg with newsupreg in all instructions coming after p } +{ until orgsupreg gets loaded with a new value. Returns true if successful, } +{ false otherwise. if successful, the contents of newsupreg are set to c, } +{ which should hold the contents of newsupreg before the current sequence } +{ started } +{ if the function returns true, returnEndP holds the last instruction } +{ where newsupreg was replaced by orgsupreg } +var + endP, hp: tai; + removeLast, newRegModified, orgRegRead, + stateChanged, readStateChanged: Boolean; +{$ifdef replaceregdebug} + l: longint; +{$endif replaceregdebug} + +begin + replacereg := false; + if canreplacereg(orgsupreg,newsupreg,p,orgregcanbemodified,newregmodified, orgregread, removelast,endp) then + begin +{$ifdef replaceregdebug} + l := random(1000); + hp := tai_comment.Create(strpnew( + 'replacing '+std_regname(newreg(R_INTREGISTER,newsupreg,R_SUBWHOLE))+' with '+std_regname(newreg(R_INTREGISTER,orgsupreg,R_SUBWHOLE))+ + ' from here... '+tostr(l))); + insertllitem(asml,p.previous,p,hp); + hp := tai_comment.Create(strpnew( + 'replaced '+std_regname(newreg(R_INTREGISTER,newsupreg,R_SUBWHOLE))+' with '+std_regname(newreg(R_INTREGISTER,orgsupreg,R_SUBWHOLE))+ + ' till here ' + tostr(l))); + insertllitem(asml,endp,endp.next,hp); +{$endif replaceregdebug} + replaceReg := true; + returnEndP := endP; + + if not getNextInstruction(p,hp) then + exit; + stateChanged := false; + while hp <> endP do + begin + if {not(ptaiprop(hp.optinfo)^.canBeRemoved) and } + (hp.typ = ait_instruction) then + stateChanged := + doReplaceReg(taicpu(hp),newsupreg,orgsupreg) or stateChanged; + if stateChanged then + updateStates(orgsupreg,newsupreg,hp,true); + getNextInstruction(hp,hp) + end; + if assigned(endp) and (endp.typ = ait_instruction) then + readStateChanged := + doReplaceReadReg(taicpu(endP),newsupreg,orgsupreg); + if stateChanged or readStateChanged then + updateStates(orgsupreg,newsupreg,endP,stateChanged); + + if stateChanged or readStateChanged then + updateState(orgsupreg,endP); + +{ We replaced newreg with oldreg between p and endp, so restore the contents } +{ of newreg there with its contents from before the sequence. } + if removeLast or + RegLoadedWithNewValue(newsupreg,true,endP) then + GetLastInstruction(endP,hp) + else hp := endP; + RestoreRegContentsTo(asml,newsupreg,c,seqstart,hp); + +{ Ot is possible that the new register was modified (e.g. an add/sub), so if } +{ it was replaced by oldreg in that instruction, oldreg's contents have been } +{ changed. To take this into account, we simply set the contents of orgsupreg } +{ to "unknown" after this sequence } + if newRegModified then + ClearRegContentsFrom(asml,orgsupreg,p,hp); + if removeLast then + ptaiprop(endp.optinfo)^.canBeRemoved := true; + allocRegBetween(asml,newreg(R_INTREGISTER,orgsupreg,R_SUBWHOLE),p,endP,ptaiprop(p.optinfo)^.usedregs); + + end +{$ifdef replaceregdebug} + else + begin + l := random(1000); + hp := tai_comment.Create(strpnew( + 'replacing '+std_regname(newreg(R_INTREGISTER,newsupreg,R_SUBWHOLE))+' with '+std_regname(newreg(R_INTREGISTER,orgsupreg,R_SUBWHOLE))+ + ' from here... '+ tostr(l))); + insertllitem(asml,p.previous,p,hp); + hp := tai_comment.Create(strpnew( + 'replacing '+std_regname(newreg(R_INTREGISTER,newsupreg,R_SUBWHOLE))+' with '+std_regname(newreg(R_INTREGISTER,orgsupreg,R_SUBWHOLE))+ + ' failed here ' + tostr(l))); + insertllitem(asml,endp,endp.next,hp); + end; +{$endif replaceregdebug} +end; + + +function FindRegWithConst(p: tai; size: topsize; l: aint; var Res: TRegister): Boolean; +{Finds a register which contains the constant l} +var + Counter: tsuperregister; +{$ifdef testing} + hp: tai; +{$endif testing} +begin + Result:=false; + Counter := RS_EAX; + repeat +{$ifdef testing} + if (ptaiprop(p.optinfo)^.regs[counter].typ in [con_const,con_noRemoveConst]) then + begin + hp := tai_comment.Create(strpnew( + 'checking const load of '+tostr(l)+' here...')); + hp.next := ptaiprop(p.optinfo)^.Regs[Counter].StartMod; + hp.previous := ptaiprop(p.optinfo)^.Regs[Counter].StartMod^.previous; + ptaiprop(p.optinfo)^.Regs[Counter].StartMod^.previous := hp; + if assigned(hp.previous) then + hp.previous.next := hp; + end; +{$endif testing} + if (ptaiprop(p.optinfo)^.regs[counter].typ in [con_const,con_noRemoveConst]) and + (taicpu(ptaiprop(p.optinfo)^.Regs[Counter].StartMod).opsize = size) and + (taicpu(ptaiprop(p.optinfo)^.Regs[Counter].StartMod).oper[0]^.typ = top_const) and + (taicpu(ptaiprop(p.optinfo)^.Regs[Counter].StartMod).oper[0]^.val = l) then + begin + res:=taicpu(ptaiprop(p.optinfo)^.Regs[Counter].StartMod).oper[1]^.reg; + result:=true; + exit; + end; + inc(counter); + until (Counter > RS_EDI); +end; + + +procedure removePrevNotUsedLoad(asml: TAsmList; p: tai; supreg: tsuperregister; check: boolean); +{ if check = true, it means the procedure has to check whether it isn't } +{ possible that the contents are still used after p (used when removing } +{ instructions because of a "call"), otherwise this is not necessary } +{ (e.g. when you have a "mov 8(%ebp),%eax", you can be sure the previous } +{ value of %eax isn't used anymore later on) } +var + hp1, next, beforestartmod: tai; +begin + if getLastInstruction(p,hp1) then + with ptaiprop(hp1.optinfo)^.regs[supreg] do + if (typ in [con_ref,con_invalid,con_const]) and + (nrofMods = 1) and + (rState = ptaiprop(startmod.optinfo)^.regs[supreg].rState) and + (not(check) or + (not(regInInstruction(supreg,p)) and + (not(supreg in ptaiprop(hp1.optinfo)^.usedRegs) or + findRegDealloc(supreg,p)))) then + begin + ptaiprop(startMod.optinfo)^.canBeRemoved := true; + getnextinstruction(p,next); + { give the register that was modified by this instruction again } + { the contents it had before this instruction } + if getlastinstruction(startmod,beforestartmod) then + RestoreRegContentsTo(asml,supreg,ptaiprop(beforestartmod.optinfo)^.regs[supreg], + startmod,hp1) + else + ClearRegContentsFrom(asml,supreg,startmod,hp1); + end; +end; + + +{$ifdef notused} +function is_mov_for_div(p: taicpu): boolean; +begin + is_mov_for_div := + (p.opcode = A_MOV) and + (p.oper[0]^.typ = top_const) and + (p.oper[1]^.typ = top_reg) and + (p.oper[1]^.reg = RS_EDX) and + getNextInstruction(p,p) and + (p.typ = ait_instruction) and + ((p.opcode = A_DIV) or + (p.opcode = A_IDIV)); +end; +{$endif notused} + + +function memtoreg(t: taicpu; const ref: treference; var startp: tai): tregister; +var + hp: tai; + p: ptaiprop; + regcounter: tsuperregister; + optimizable: boolean; +begin + if not getlastinstruction(t,hp) or + not issimplememloc(ref) then + begin + memtoreg := NR_NO; + exit; + end; + p := ptaiprop(hp.optinfo); + optimizable := false; + for regcounter := RS_EAX to RS_EDI do + begin + if (assigned(p^.regs[regcounter].memwrite) and + refsequal(ref,p^.regs[regcounter].memwrite.oper[1]^.ref^)) then + begin + optimizable := true; + hp := p^.regs[regcounter].memwrite; + end + else if ((p^.regs[regcounter].typ in [CON_REF,CON_NOREMOVEREF]) and + (p^.regs[regcounter].nrofmods = 1) and + ((taicpu(p^.regs[regcounter].startmod).opcode = A_MOV) or + (taicpu(p^.regs[regcounter].startmod).opcode = A_MOVZX) or + (taicpu(p^.regs[regcounter].startmod).opcode = A_MOVSX)) and + (taicpu(p^.regs[regcounter].startmod).oper[0]^.typ = top_ref) and + refsequal(ref,taicpu(p^.regs[regcounter].startmod).oper[0]^.ref^)) then + begin + optimizable := true; + hp := p^.regs[regcounter].startmod; + end; + if optimizable then + if ((t.opsize <> S_B) or + not(regcounter in [RS_ESI,RS_EDI])) and + sizescompatible(taicpu(hp).opsize,t.opsize) then + begin + case t.opsize of + S_B: + begin + memtoreg := newreg(R_INTREGISTER,regcounter,R_SUBL) + end; + S_W,S_BW: + begin + memtoreg := newreg(R_INTREGISTER,regcounter,R_SUBW); + if (t.opsize = S_BW) then + begin + t.opcode := A_MOV; + t.opsize := S_W; + end; + end; + S_L,S_BL,S_WL: + begin + memtoreg := newreg(R_INTREGISTER,regcounter,R_SUBWHOLE); + if (t.opsize <> S_L) then + begin + t.opcode := A_MOV; + t.opsize := S_L; + end; + end; + end; + startp := hp; + exit; + end; + end; + memtoreg := NR_NO; +end; + + +procedure removeLocalStores(const t1: tai); +{var + p: tai; + regcount: tregister; } +begin +{ + for regcount := LoGPReg to HiGPReg do + if assigned(pTaiProp(t1.optinfo)^.regs[regcount].memwrite) and + (taicpu(pTaiProp(t1.optinfo)^.regs[regcount].memwrite).oper[1]^.ref^.base + = current_procinfo.framepointer) then + begin + pTaiProp(pTaiProp(t1.optinfo)^.regs[regcount].memwrite.optinfo)^.canberemoved := true; + clearmemwrites(pTaiProp(t1.optinfo)^.regs[regcount].memwrite,regcount); + end; +} +end; + + +procedure loadcseregs(asml: TAsmList; const reginfo: toptreginfo; curseqend, prevseqstart, curseqstart, curprev: tai; cnt: longint); +var + regsloaded: tregset; + regloads, reguses: array[RS_EAX..RS_EDI] of tai; + regcounter: tsuperregister; + hp, hp2: tai; + insertpos, insertoptinfo, prevseq_next: tai; + i: longint; + opc: tasmop; +begin + regsloaded := []; + fillchar(regloads,sizeof(regloads),0); + fillchar(reguses,sizeof(reguses),0); + getnextinstruction(prevseqstart,prevseq_next); + for regcounter := RS_EAX To RS_EDI do + if (reginfo.new2oldreg[regcounter] <> RS_INVALID) Then + begin + include(regsloaded,regcounter); + if assigned(ptaiprop(prevseqstart.optinfo)^.Regs[reginfo.new2oldreg[regcounter]].StartMod) then + AllocRegBetween(asml,newreg(R_INTREGISTER,reginfo.new2oldreg[regcounter],R_SUBWHOLE), + ptaiprop(prevseqstart.optinfo)^.Regs[reginfo.new2oldreg[regcounter]].StartMod,curseqstart, + ptaiprop(ptaiprop(prevseqstart.optinfo)^.Regs[reginfo.new2oldreg[regcounter]].StartMod.optinfo)^.usedregs) + else + AllocRegBetween(asml,newreg(R_INTREGISTER,reginfo.new2oldreg[regcounter],R_SUBWHOLE), + prevseqstart,curseqstart,ptaiprop(prevseqstart.optinfo)^.usedregs); + + if curprev <> prevseqstart then + begin + if assigned(reginfo.lastReload[regCounter]) then + getLastInstruction(reginfo.lastReload[regCounter],hp) + else if assigned(reginfo.lastReload[reginfo.new2oldreg[regCounter]]) then + getLastInstruction(reginfo.lastReload[reginfo.new2OldReg[regCounter]],hp) + else + hp := curprev; + clearRegContentsFrom(asml,regCounter,prevSeq_next,hp); + getnextInstruction(hp,hp); + allocRegBetween(asml,newreg(R_INTREGISTER,regCounter,R_SUBWHOLE),prevseqstart,hp, + ptaiprop(prevseqstart.optinfo)^.usedregs); + end; + if not(regcounter in reginfo.RegsLoadedforRef) and + {old reg new reg} + (reginfo.new2oldreg[regcounter] <> regcounter) then + begin + getLastInstruction(curseqend,hp); + opc := A_MOV; + insertpos := prevseq_next; + insertoptinfo := prevseqstart; + if assigned(reguses[regcounter]) then + if assigned(regloads[reginfo.new2oldreg[regcounter]]) then + opc := A_XCHG + else + begin + insertoptinfo := reguses[regcounter]; + insertpos := tai(insertoptinfo.next) + end + else + if assigned(regloads[reginfo.new2oldreg[regcounter]]) then + begin + insertpos := regloads[reginfo.new2oldreg[regcounter]]; + if not getlastinstruction(insertpos,insertoptinfo) then + internalerror(2006060701); + end; + hp := Tai_Marker.Create(mark_NoPropInfoStart); + InsertLLItem(asml, insertpos.previous,insertpos, hp); + hp2 := taicpu.Op_Reg_Reg(opc, S_L, + {old reg new reg} + newreg(R_INTREGISTER,reginfo.new2oldreg[regcounter],R_SUBWHOLE), newreg(R_INTREGISTER,regcounter,R_SUBWHOLE)); + if (opc = A_XCHG) and + (taicpu(regloads[reginfo.new2oldreg[regcounter]]).opcode <> A_XCHG) then + begin + asml.remove(regloads[reginfo.new2oldreg[regcounter]]); + regloads[reginfo.new2oldreg[regcounter]].free; + regloads[reginfo.new2oldreg[regcounter]] := hp2; + reguses[regcounter] := hp2; + end; + regloads[regcounter] := hp2; + reguses[reginfo.new2oldreg[regcounter]] := hp2; + new(ptaiprop(hp2.optinfo)); + ptaiprop(hp2.optinfo)^ := ptaiprop(insertoptinfo.optinfo)^; + ptaiprop(hp2.optinfo)^.canBeRemoved := false; + InsertLLItem(asml, insertpos.previous, insertpos, hp2); + hp := Tai_Marker.Create(mark_NoPropInfoEnd); + InsertLLItem(asml, insertpos.previous, insertpos, hp); + { adjusts states in previous instruction so that it will } + { definitely be different from the previous or next state } + incstate(ptaiprop(hp2.optinfo)^. + regs[reginfo.new2oldreg[regcounter]].rstate,20); + incstate(ptaiprop(hp2.optinfo)^. + regs[regCounter].wstate,20); + updateState(reginfo.new2oldreg[regcounter],hp2); + updateState(regcounter,hp2); + end + else + { imagine the following code: } + { normal wrong optimized } + { movl 8(%ebp), %eax movl 8(%ebp), %eax } + { movl (%eax), %eax movl (%eax), %eax } + { cmpl 8(%ebp), %eax cmpl 8(%ebp), %eax } + { jne l1 jne l1 } + { movl 8(%ebp), %eax } + { movl (%eax), %edi movl %eax, %edi } + { movl %edi, -4(%ebp) movl %edi, -4(%ebp) } + { movl 8(%ebp), %eax } + { pushl 70(%eax) pushl 70(%eax) } + { } + { The error is that at the moment that the last instruction is executed, } + { %eax doesn't contain 8(%ebp) anymore. Solution: the contents of } + { registers that are completely removed from a sequence (= registers in } + { RegLoadedforRef), have to be changed to their contents from before the } + { sequence. } + { if regcounter in reginfo.RegsLoadedforRef then } + begin + hp := curseqstart; + { cnt still holds the number of instructions } + { of the sequence, so go to the end of it } + for i := 1 to pred(cnt) do + getNextInstruction(hp,hp); + { curprev = instruction prior to start of sequence } + restoreRegContentsTo(asml,regCounter, + ptaiprop(curprev.optinfo)^.Regs[regcounter], + curseqstart,hp); + end; + end; +end; + + +procedure replaceoperandwithreg(asml: TAsmList; p: tai; opnr: byte; reg: tregister); +var + hp: tai; +begin + { new instruction -> it's info block is not in the big one allocated at the start } + hp := Tai_Marker.Create(mark_NoPropInfoStart); + InsertLLItem(asml, p.previous,p, hp); + { duplicate the original instruction and replace it's designated operant with the register } + hp := tai(p.getcopy); + taicpu(hp).loadreg(opnr,reg); + { add optimizer state info } + new(ptaiprop(hp.optinfo)); + ptaiprop(hp.optinfo)^ := ptaiprop(p.optinfo)^; + { new instruction can not be removed } + ptaiprop(hp.optinfo)^.canBeRemoved := false; + { but the old one can } + ptaiprop(p.optinfo)^.canBeRemoved := true; + { insert end marker } + InsertLLItem(asml, p.previous, p, hp); + hp := Tai_Marker.Create(mark_NoPropInfoEnd); + InsertLLItem(asml, p.previous, p, hp); +end; + + +procedure doCSE(asml: TAsmList; First, Last: tai; findPrevSeqs, doSubOpts: boolean); +{marks the instructions that can be removed by RemoveInstructs. They're not + removed immediately because sometimes an instruction needs to be checked in + two different sequences} +var cnt, cnt2, {cnt3,} orgNrofMods: longint; + p, hp1, hp2, prevSeq: tai; + hp4: tai; + hp5 : tai; + reginfo: toptreginfo; + memreg: tregister; + regcounter: tsuperregister; +begin + p := First; + SkipHead(p); + while (p <> Last) do + begin + case p.typ of + ait_align: + if not(tai_align(p).use_op) then + SetAlignReg(p); + ait_instruction: + begin + case taicpu(p).opcode of +{ + Does not work anymore with register calling because the registers are + released before the call + A_CALL: + for regCounter := RS_EAX to RS_EBX do + removePrevNotUsedLoad(asml,p,regCounter,true); +} + A_CLD: if GetLastInstruction(p, hp1) and + (ptaiprop(hp1.optinfo)^.DirFlag = F_NotSet) then + ptaiprop(tai(p).optinfo)^.CanBeRemoved := True; + A_LEA, A_MOV, A_MOVZX, A_MOVSX: + begin + hp2 := p; + case taicpu(p).oper[0]^.typ of + top_ref, top_reg: + if (taicpu(p).oper[1]^.typ = top_reg) then + begin + With ptaiprop(p.optinfo)^.Regs[getsupreg(taicpu(p).oper[1]^.reg)] do + begin + if (startmod = p) then + orgNrofMods := nrofMods + else + orgNrofMods := 0; + if (p = StartMod) and + GetLastInstruction (p, hp1) and + not(hp1.typ in [ait_marker,ait_label]) then +{so we don't try to check a sequence when p is the first instruction of the block} + begin +{$ifdef csdebug} + hp5 := tai_comment.Create(strpnew( + 'cse checking '+std_regname(taicpu(p).oper[1]^.reg))); + insertLLItem(asml,p,p.next,hp5); +{$endif csdebug} + if CheckSequence(p,prevSeq,getsupreg(taicpu(p).oper[1]^.reg), Cnt, reginfo, findPrevSeqs) and + (Cnt > 0) then + begin +(* + hp1 := nil; +{ although it's perfectly ok to remove an instruction which doesn't contain } +{ the register that we've just checked (CheckSequence takes care of that), } +{ the sequence containing this other register should also be completely } +{ checked and removed, otherwise we may get situations like this: } +{ } +{ movl 12(%ebp), %edx movl 12(%ebp), %edx } +{ movl 16(%ebp), %eax movl 16(%ebp), %eax } +{ movl 8(%edx), %edx movl 8(%edx), %edx } +{ movl (%eax), eax movl (%eax), eax } +{ cmpl %eax, %edx cmpl %eax, %edx } +{ jnz l123 getting converted to jnz l123 } +{ movl 12(%ebp), %edx movl 4(%eax), eax } +{ movl 16(%ebp), %eax } +{ movl 8(%edx), %edx } +{ movl 4(%eax), eax } +*) + +{ not anymore: if the start of a new sequence is found while checking (e.g. } +{ above that of eax while checking edx, this new sequence is automatically } +{ also checked } + Cnt2 := 1; + while Cnt2 <= Cnt do + begin +{$ifndef noremove} + ptaiprop(p.optinfo)^.CanBeRemoved := True +{$endif noremove} + ; inc(Cnt2); + GetNextInstruction(p, p); + end; + {hp4 is used to get the contents of the registers before the sequence} + GetLastInstruction(hp2, hp4); + +{$IfDef CSDebug} + for regcounter := RS_EAX To RS_EDI do + if (regcounter in reginfo.RegsLoadedforRef) then + begin + hp5 := tai_comment.Create(strpnew('New: '+std_regname(newreg(R_INTREGISTER,regcounter,R_SUBNONE))+', Old: '+ + std_regname(newreg(R_INTREGISTER,reginfo.new2oldreg[regcounter],R_SUBNONE)))); + InsertLLItem(asml, tai(hp2.previous), hp2, hp5); + end; +{$EndIf CSDebug} + { if some registers were different in the old and the new sequence, move } + { the contents of those old registers to the new ones } + loadcseregs(asml,reginfo,p,prevseq,hp2,hp4,cnt); + continue; + end + end; + end; + { try to replace the new reg with the old reg } + if not(ptaiprop(p.optinfo)^.canBeRemoved) then + if (taicpu(p).oper[0]^.typ = top_reg) and + (taicpu(p).oper[1]^.typ = top_reg) and + { only remove if we're not storing something in a regvar } + (getsupreg(taicpu(p).oper[1]^.reg) in [RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI,RS_EDI]) and +{ (taicpu(p).oper[1]^.reg in (rg.usableregsint+[RS_EDI])) and} + (taicpu(p).opcode = A_MOV) and + getLastInstruction(p,hp4) and + { we only have to start replacing from the instruction after the mov, } + { but replacereg only starts with getnextinstruction(p,p) } + replaceReg(asml,getsupreg(taicpu(p).oper[0]^.reg), + getsupreg(taicpu(p).oper[1]^.reg),p,p, + ptaiprop(hp4.optinfo)^.regs[getsupreg(taicpu(p).oper[1]^.reg)],false,hp1) then + begin + ptaiprop(p.optinfo)^.canBeRemoved := true; + { this is just a regular move that was here, so the source register should be } + { allocated already at this point -> only allocate from here onwards } + if not(getsupreg(taicpu(p).oper[0]^.reg) in pTaiProp(p.optinfo)^.usedregs) then + internalerror(2004101011); + allocRegBetween(asml,taicpu(p).oper[0]^.reg, + p,hp1,pTaiProp(p.optinfo)^.usedregs) + end + else + begin + if (taicpu(p).oper[1]^.typ = top_reg) and + not regInOp(getsupreg(taicpu(p).oper[1]^.reg),taicpu(p).oper[0]^) then + removePrevNotUsedLoad(asml,p,getsupreg(taicpu(p).oper[1]^.reg),false); + if doSubOpts and + (taicpu(p).opcode <> A_LEA) and + (taicpu(p).oper[0]^.typ = top_ref) then + begin + memreg := + memtoreg(taicpu(p), + taicpu(p).oper[0]^.ref^,hp5); + if memreg <> NR_NO then + if (taicpu(p).opcode = A_MOV) and + (taicpu(p).oper[1]^.typ = top_reg) and + (taicpu(p).oper[1]^.reg = memreg) then + begin + pTaiProp(p.optinfo)^.canberemoved := true; + allocregbetween(asml,memreg,hp5,p,ptaiprop(hp5.optinfo)^.usedregs); + end + else + begin + replaceoperandwithreg(asml,p,0,memreg); + allocregbetween(asml,memreg,hp5,p,ptaiprop(hp5.optinfo)^.usedregs); + regcounter := getsupreg(memreg); + incstate(pTaiProp(p.optinfo)^.regs[regcounter].rstate,1); + updatestate(regcounter,p); + end; + end; + end; + { at first, only try optimizations of large blocks, because doing } + { doing smaller ones may prevent bigger ones from completing in } + { in the next pass } + if not doSubOpts and (orgNrofMods <> 0) then + begin + p := hp2; + for cnt := 1 to pred(orgNrofMods) do + getNextInstruction(p,p); + end; + end; + top_Const: + begin + case taicpu(p).oper[1]^.typ of + Top_Reg: + begin + regCounter := getsupreg(taicpu(p).oper[1]^.reg); + if GetLastInstruction(p, hp1) then + With ptaiprop(hp1.optinfo)^.Regs[regCounter] do + if (typ in [con_const,con_noRemoveConst]) and + (taicpu(startMod).opsize >= taicpu(p).opsize) and + opsequal(taicpu(StartMod).oper[0]^,taicpu(p).oper[0]^) then + begin + ptaiprop(p.optinfo)^.CanBeRemoved := True; + allocRegBetween(asml,taicpu(p).oper[1]^.reg,startmod,p, + ptaiprop(startmod.optinfo)^.usedregs); + end + else + removePrevNotUsedLoad(asml,p,getsupreg(taicpu(p).oper[1]^.reg),false); + + end; + Top_Ref: + if (taicpu(p).oper[0]^.typ = top_const) and + getLastInstruction(p,hp1) and + findRegWithConst(hp1,taicpu(p).opsize,taicpu(p).oper[0]^.val,memreg) then + begin + taicpu(p).loadreg(0,memreg); + { mark the used register as read } + incstate(ptaiprop(p.optinfo)^. + regs[getsupreg(memreg)].rstate,20); + updateState(getsupreg(memreg),p); + allocRegBetween(asml,memreg, + ptaiprop(hp1.optinfo)^.regs[getsupreg(memreg)].startMod,p, + ptaiprop(ptaiprop(hp1.optinfo)^.regs[getsupreg(memreg)].startMod.optinfo)^.usedregs); + end; + end; + end; + end; + + end; + A_LEAVE: + begin + if getlastinstruction(p,hp1) then + removeLocalStores(hp1); + end; + A_STD: if GetLastInstruction(p, hp1) and + (ptaiprop(hp1.optinfo)^.DirFlag = F_Set) then + ptaiprop(tai(p).optinfo)^.CanBeRemoved := True; + else + begin + for cnt := 1 to maxinschanges do + begin + case InsProp[taicpu(p).opcode].Ch[cnt] of + Ch_ROp1: + if (taicpu(p).oper[0]^.typ = top_ref) and + ((taicpu(p).opcode < A_F2XM1) or + ((taicpu(p).opcode > A_IN) and + (taicpu(p).opcode < A_OUT)) or + (taicpu(p).opcode = A_PUSH) or + ((taicpu(p).opcode >= A_RCL) and + (taicpu(p).opcode <= A_XOR))) then + begin + memreg := + memtoreg(taicpu(p), + taicpu(p).oper[0]^.ref^,hp5); + if memreg <> NR_NO then + begin + replaceoperandwithreg(asml,p,0,memreg); + allocregbetween(asml,memreg,hp5,p,ptaiprop(hp5.optinfo)^.usedregs); + regcounter := getsupreg(memreg); + incstate(pTaiProp(p.optinfo)^.regs[regcounter].rstate,1); + updatestate(regcounter,p); + end; + end; + Ch_MOp1: + if not(cs_opt_size in current_settings.optimizerswitches) and + (taicpu(p).oper[0]^.typ = top_ref) then + begin + memreg := + memtoreg(taicpu(p), + taicpu(p).oper[0]^.ref^,hp5); + if (memreg <> NR_NO) and + (not getNextInstruction(p,hp1) or + (RegLoadedWithNewValue(getsupreg(memreg),false,hp1) or + FindRegDealloc(getsupreg(memreg),hp1))) then + begin + hp1 := Tai_Marker.Create(mark_NoPropInfoEnd); + insertllitem(asml,p,p.next,hp1); + hp1 := taicpu.op_reg_ref(A_MOV,reg2opsize(memreg), + memreg,taicpu(p).oper[0]^.ref^); + new(ptaiprop(hp1.optinfo)); + pTaiProp(hp1.optinfo)^ := pTaiProp(p.optinfo)^; + insertllitem(asml,p,p.next,hp1); + regcounter := getsupreg(memreg); + incstate(pTaiProp(hp1.optinfo)^.regs[regcounter].rstate,1); + updatestate(regcounter,hp1); + hp1 := Tai_Marker.Create(mark_NoPropInfoStart); + insertllitem(asml,p,p.next,hp1); + replaceoperandwithreg(asml,p,0,memreg); + allocregbetween(asml,memreg,hp5, + tai(p.next.next),ptaiprop(hp5.optinfo)^.usedregs); + ClearRegContentsFrom(asml,regcounter,hp5,p); + end; + end; + Ch_ROp2: + if ((taicpu(p).opcode = A_CMP) or + (taicpu(p).opcode = A_TEST)) and + (taicpu(p).oper[1]^.typ = top_ref) then + begin + memreg := + memtoreg(taicpu(p), + taicpu(p).oper[1]^.ref^,hp5); + if memreg <> NR_NO then + begin + replaceoperandwithreg(asml,p,1,memreg); + allocregbetween(asml,memreg,hp5,p,ptaiprop(hp5.optinfo)^.usedregs); + regcounter := getsupreg(memreg); + incstate(pTaiProp(p.optinfo)^.regs[regcounter].rstate,1); + updatestate(regcounter,p); + end; + end; + Ch_MOp2: + if not(cs_opt_size in current_settings.optimizerswitches) and + (taicpu(p).oper[1]^.typ = top_ref) and + ((taicpu(p).opcode < A_BT) or + ((taicpu(p).opcode > A_IN) and + (taicpu(p).opcode < A_OUT)) or + (taicpu(p).opcode = A_PUSH) or + ((taicpu(p).opcode >= A_RCL) and + (taicpu(p).opcode <= A_XOR))) then + begin + memreg := + memtoreg(taicpu(p), + taicpu(p).oper[1]^.ref^,hp5); + if (memreg <> NR_NO) and + (not getNextInstruction(p,hp1) or + (RegLoadedWithNewValue(getsupreg(memreg),false,hp1) or + FindRegDealloc(getsupreg(memreg),hp1))) then + begin + hp1 := Tai_Marker.Create(mark_NoPropInfoEnd); + insertllitem(asml,p,p.next,hp1); + hp1 := taicpu.op_reg_ref(A_MOV,reg2opsize(memreg), + memreg,taicpu(p).oper[1]^.ref^); + new(ptaiprop(hp1.optinfo)); + pTaiProp(hp1.optinfo)^ := pTaiProp(p.optinfo)^; + insertllitem(asml,p,p.next,hp1); + regcounter := getsupreg(memreg); + incstate(pTaiProp(hp1.optinfo)^.regs[regcounter].rstate,1); + updatestate(regcounter,hp1); + hp1 := Tai_Marker.Create(mark_NoPropInfoStart); + insertllitem(asml,p,p.next,hp1); + replaceoperandwithreg(asml,p,1,memreg); + allocregbetween(asml,memreg,hp5, + tai(p.next.next),ptaiprop(hp5.optinfo)^.usedregs); + ClearRegContentsFrom(asml,regcounter,hp5,p); + end; + end; + end; + end; + end; + end + end; + end; + GetNextInstruction(p, p); + end; +end; + +function removeInstructs(asml: TAsmList; first, last: tai): boolean; +{ Removes the marked instructions and disposes the PTaiProps of the other } +{ instructions } +var + p, hp1: tai; + nopropinfolevel: longint; +begin + removeInstructs := false; + p := First; + nopropinfolevel := 0; + while (p <> Last) do + begin + if (p.typ = ait_marker) and + (Tai_marker(p).kind = mark_NoPropInfoStart) then + begin + hp1 := tai(p.next); + asml.remove(p); + p.free; + nopropinfolevel := 1; + while (nopropinfolevel <> 0) do + begin + p := tai(hp1.next); +{$ifndef noinstremove} + { allocregbetween can insert new ait_regalloc objects } + { without optinfo } + if (hp1.typ = ait_marker) then + begin + case Tai_marker(hp1).kind of + { they can be nested! } + mark_NoPropInfoStart: inc(nopropinfolevel); + mark_NoPropInfoEnd: dec(nopropinfolevel); + else + begin + hp1 := p; + continue; + end; + end; + asml.remove(hp1); + hp1.free; + end + else if assigned(hp1.optinfo) then + if ptaiprop(hp1.optinfo)^.canBeRemoved then + begin + dispose(ptaiprop(hp1.optinfo)); + hp1.optinfo := nil; + asml.remove(hp1); + hp1.free; + end + else +{$endif noinstremove} + begin + dispose(ptaiprop(hp1.optinfo)); + hp1.optinfo := nil; + end; + hp1 := p; + end; + end + else +{$ifndef noinstremove} + if assigned(p.optinfo) and + ptaiprop(p.optinfo)^.canBeRemoved then + begin + hp1 := tai(p.next); + asml.Remove(p); + p.free; + p := hp1; + removeInstructs := true; + end + else +{$endif noinstremove} + begin + p.optinfo := nil; + p := tai(p.next); + end; + end; +end; + +function CSE(asml: TAsmList; First, Last: tai; pass: longint): boolean; +begin + doCSE(asml, First, Last, not(cs_opt_level3 in current_settings.optimizerswitches) or (pass >= 2), + not(cs_opt_level3 in current_settings.optimizerswitches) or (pass >= 1)); + { register renaming } + if not(cs_opt_level3 in current_settings.optimizerswitches) or (pass > 0) then + doRenaming(asml, first, last); + cse := removeInstructs(asml, first, last); +end; + +end. diff --git a/closures/compiler/i386/daopt386.pas b/closures/compiler/i386/daopt386.pas new file mode 100644 index 0000000000..bdcaea11a2 --- /dev/null +++ b/closures/compiler/i386/daopt386.pas @@ -0,0 +1,2816 @@ +{ + Copyright (c) 1998-2002 by Jonas Maebe, member of the Freepascal + development team + + This unit contains the data flow analyzer and several helper procedures + and 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. + + **************************************************************************** +} +unit daopt386; + +{$i fpcdefs.inc} + +interface + +uses + globtype, + cclasses,aasmbase,aasmtai,aasmdata,aasmcpu,cgbase,cgutils, + cpubase; + +{******************************* Constants *******************************} + +const + +{ Possible register content types } + con_Unknown = 0; + con_ref = 1; + con_const = 2; + { The contents aren't usable anymore for CSE, but they may still be } + { useful for detecting whether the result of a load is actually used } + con_invalid = 3; + { the reverse of the above (in case a (conditional) jump is encountered): } + { CSE is still possible, but the original instruction can't be removed } + con_noRemoveRef = 4; + { same, but for constants } + con_noRemoveConst = 5; + + +const + topsize2tcgsize: array[topsize] of tcgsize = (OS_NO, + OS_8,OS_16,OS_32,OS_64,OS_16,OS_32,OS_32, + OS_16,OS_32,OS_64, + OS_F32,OS_F64,OS_F80,OS_C64,OS_F128, + OS_M32, + OS_ADDR,OS_NO,OS_NO, + OS_NO, + OS_NO); + + + +{********************************* Types *********************************} + +type + TRegEnum = RS_EAX..RS_ESP; + TRegArray = Array[TRegEnum] of tsuperregister; + TRegSet = Set of TRegEnum; + toptreginfo = Record + NewRegsEncountered, OldRegsEncountered: TRegSet; + RegsLoadedForRef: TRegSet; + lastReload: array[RS_EAX..RS_ESP] of tai; + New2OldReg: TRegArray; + end; + +{possible actions on an operand: read, write or modify (= read & write)} + TOpAction = (OpAct_Read, OpAct_Write, OpAct_Modify, OpAct_Unknown); + +{the possible states of a flag} + TFlagContents = (F_Unknown, F_notSet, F_Set); + + TContent = Packed Record + {start and end of block instructions that defines the + content of this register.} + StartMod: tai; + MemWrite: taicpu; + {how many instructions starting with StarMod does the block consist of} + NrOfMods: Word; + {the type of the content of the register: unknown, memory, constant} + Typ: Byte; + case byte of + {starts at 0, gets increased everytime the register is written to} + 1: (WState: Byte; + {starts at 0, gets increased everytime the register is read from} + RState: Byte); + { to compare both states in one operation } + 2: (state: word); + end; + +{Contents of the integer registers} + TRegContent = Array[RS_EAX..RS_ESP] Of TContent; + +{contents of the FPU registers} +// TRegFPUContent = Array[RS_ST..RS_ST7] Of TContent; + +{$ifdef tempOpts} +{ linked list which allows searching/deleting based on value, no extra frills} + PSearchLinkedListItem = ^TSearchLinkedListItem; + TSearchLinkedListItem = object(TLinkedList_Item) + constructor init; + function equals(p: PSearchLinkedListItem): boolean; virtual; + end; + + PSearchDoubleIntItem = ^TSearchDoubleInttem; + TSearchDoubleIntItem = object(TLinkedList_Item) + constructor init(_int1,_int2: longint); + function equals(p: PSearchLinkedListItem): boolean; virtual; + private + int1, int2: longint; + end; + + PSearchLinkedList = ^TSearchLinkedList; + TSearchLinkedList = object(TLinkedList) + function searchByValue(p: PSearchLinkedListItem): boolean; + procedure removeByValue(p: PSearchLinkedListItem); + end; +{$endif tempOpts} + +{information record with the contents of every register. Every tai object + gets one of these assigned: a pointer to it is stored in the OptInfo field} + TtaiProp = Record + Regs: TRegContent; +{ FPURegs: TRegFPUContent;} {currently not yet used} + { allocated Registers } + UsedRegs: TRegSet; + { status of the direction flag } + DirFlag: TFlagContents; +{$ifdef tempOpts} + { currently used temps } + tempAllocs: PSearchLinkedList; +{$endif tempOpts} + { can this instruction be removed? } + CanBeRemoved: Boolean; + { are the resultflags set by this instruction used? } + FlagsUsed: Boolean; + end; + + ptaiprop = ^TtaiProp; + + TtaiPropBlock = Array[1..250000] Of TtaiProp; + PtaiPropBlock = ^TtaiPropBlock; + + TInstrSinceLastMod = Array[RS_EAX..RS_ESP] Of Word; + + TLabelTableItem = Record + taiObj: tai; +{$ifDef JumpAnal} + InstrNr: Longint; + RefsFound: Word; + JmpsProcessed: Word +{$endif JumpAnal} + end; + TLabelTable = Array[0..2500000] Of TLabelTableItem; + PLabelTable = ^TLabelTable; + + +{*********************** procedures and functions ************************} + +procedure InsertLLItem(AsmL: TAsmList; prev, foll, new_one: TLinkedListItem); + + +function RefsEqual(const R1, R2: TReference): Boolean; +function isgp32reg(supreg: tsuperregister): Boolean; +function reginref(supreg: tsuperregister; const ref: treference): boolean; +function RegReadByInstruction(supreg: tsuperregister; hp: tai): boolean; +function RegModifiedByInstruction(supreg: tsuperregister; p1: tai): boolean; +function RegInInstruction(supreg: tsuperregister; p1: tai): boolean; +function reginop(supreg: tsuperregister; const o:toper): boolean; +function instrWritesFlags(p: tai): boolean; +function instrReadsFlags(p: tai): boolean; + +function writeToMemDestroysContents(regWritten: tsuperregister; const ref: treference; + supreg: tsuperregister; size: tcgsize; const c: tcontent; var invalsmemwrite: boolean): boolean; +function writeToRegDestroysContents(destReg, supreg: tsuperregister; + const c: tcontent): boolean; +function writeDestroysContents(const op: toper; supreg: tsuperregister; size: tcgsize; + const c: tcontent; var memwritedestroyed: boolean): boolean; + +function sequenceDependsonReg(const Content: TContent; seqreg: tsuperregister; supreg: tsuperregister): Boolean; + +function GetNextInstruction(Current: tai; var Next: tai): Boolean; +function GetLastInstruction(Current: tai; var Last: tai): Boolean; +procedure SkipHead(var p: tai); +function labelCanBeSkipped(p: tai_label): boolean; + +procedure RemoveLastDeallocForFuncRes(asmL: TAsmList; p: tai); +function regLoadedWithNewValue(supreg: tsuperregister; canDependOnPrevValue: boolean; + hp: tai): boolean; +procedure UpdateUsedRegs(var UsedRegs: TRegSet; p: tai); +procedure AllocRegBetween(asml: TAsmList; reg: tregister; p1, p2: tai; var initialusedregs: tregset); +function FindRegDealloc(supreg: tsuperregister; p: tai): boolean; + +function InstructionsEquivalent(p1, p2: tai; var RegInfo: toptreginfo): Boolean; +function sizescompatible(loadsize,newsize: topsize): boolean; +function OpsEqual(const o1,o2:toper): Boolean; + + +type + tdfaobj = class + constructor create(_list: TAsmList); virtual; + + function pass_1(_blockstart: tai): tai; + function pass_generate_code: boolean; + procedure clear; + + function getlabelwithsym(sym: tasmlabel): tai; + + private + { asm list we're working on } + list: TAsmList; + + { current part of the asm list } + blockstart, blockend: tai; + + { the amount of taiObjects in the current part of the assembler list } + nroftaiobjs: longint; + + { Array which holds all TtaiProps } + taipropblock: ptaipropblock; + + { all labels in the current block: their value mapped to their location } + lolab, hilab, labdif: longint; + labeltable: plabeltable; + + { Walks through the list to find the lowest and highest label number, inits the } + { labeltable and fixes/optimizes some regallocs } + procedure initlabeltable; + + function initdfapass2: boolean; + procedure dodfapass2; + end; + + +function FindLabel(L: tasmlabel; var hp: tai): Boolean; + +procedure incState(var S: Byte; amount: longint); + +{******************************* Variables *******************************} + +var + dfa: tdfaobj; + +{*********************** end of Interface section ************************} + + +Implementation + +Uses +{$ifdef csdebug} + cutils, +{$else} + {$ifdef statedebug} + cutils, + {$else} + {$ifdef allocregdebug} + cutils, + {$endif} + {$endif} +{$endif} + globals, systems, verbose, symconst, cgobj,procinfo; + +Type + TRefCompare = function(const r1, r2: treference; size1, size2: tcgsize): boolean; + +var + {How many instructions are between the current instruction and the last one + that modified the register} + NrOfInstrSinceLastMod: TInstrSinceLastMod; + +{$ifdef tempOpts} + constructor TSearchLinkedListItem.init; + begin + end; + + function TSearchLinkedListItem.equals(p: PSearchLinkedListItem): boolean; + begin + equals := false; + end; + + constructor TSearchDoubleIntItem.init(_int1,_int2: longint); + begin + int1 := _int1; + int2 := _int2; + end; + + function TSearchDoubleIntItem.equals(p: PSearchLinkedListItem): boolean; + begin + equals := (TSearchDoubleIntItem(p).int1 = int1) and + (TSearchDoubleIntItem(p).int2 = int2); + end; + + function TSearchLinkedList.FindByValue(p: PSearchLinkedListItem): boolean; + var temp: PSearchLinkedListItem; + begin + temp := first; + while (temp <> last.next) and + not(temp.equals(p)) do + temp := temp.next; + searchByValue := temp <> last.next; + end; + + procedure TSearchLinkedList.removeByValue(p: PSearchLinkedListItem); + begin + temp := first; + while (temp <> last.next) and + not(temp.equals(p)) do + temp := temp.next; + if temp <> last.next then + begin + remove(temp); + dispose(temp,done); + end; + end; + +procedure updateTempAllocs(var UsedRegs: TRegSet; 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 + labelCanBeSkipped(tai_label(current)))) Do + p := tai(p.next); + while assigned(p) and + (p.typ=ait_RegAlloc) Do + begin + case tai_regalloc(p).ratype of + ra_alloc : + Include(UsedRegs, TRegEnum(getsupreg(tai_regalloc(p).reg))); + ra_dealloc : + Exclude(UsedRegs, TRegEnum(getsupreg(tai_regalloc(p).reg))); + end; + p := tai(p.next); + end; + until not(assigned(p)) or + (not(p.typ in SkipInstr) and + not((p.typ = ait_label) and + labelCanBeSkipped(tai_label(current)))); +end; + +{$endif tempOpts} + +{************************ Create the Label table ************************} + +function findregalloc(supreg: tsuperregister; starttai: tai; ratyp: tregalloctype): boolean; +{ Returns true if a ait_alloc object for reg is found in the block of tai's } +{ starting with Starttai and ending with the next "real" instruction } +begin + findregalloc := false; + repeat + while assigned(starttai) and + ((starttai.typ in (skipinstr - [ait_regalloc])) or + ((starttai.typ = ait_label) and + labelcanbeskipped(tai_label(starttai)))) do + starttai := tai(starttai.next); + if assigned(starttai) and + (starttai.typ = ait_regalloc) then + begin + if (tai_regalloc(Starttai).ratype = ratyp) and + (getsupreg(tai_regalloc(Starttai).reg) = supreg) then + begin + findregalloc:=true; + break; + end; + starttai := tai(starttai.next); + end + else + break; + until false; +end; + +procedure RemoveLastDeallocForFuncRes(asml: TAsmList; p: tai); + + procedure DoRemoveLastDeallocForFuncRes(asml: TAsmList; supreg: tsuperregister); + var + hp2: tai; + begin + hp2 := p; + repeat + hp2 := tai(hp2.previous); + if assigned(hp2) and + (hp2.typ = ait_regalloc) and + (tai_regalloc(hp2).ratype=ra_dealloc) and + (getregtype(tai_regalloc(hp2).reg) = R_INTREGISTER) and + (getsupreg(tai_regalloc(hp2).reg) = supreg) then + begin + asml.remove(hp2); + hp2.free; + break; + end; + until not(assigned(hp2)) or regInInstruction(supreg,hp2); + end; + +begin + case current_procinfo.procdef.returndef.typ of + arraydef,recorddef,pointerdef, + stringdef,enumdef,procdef,objectdef,errordef, + filedef,setdef,procvardef, + classrefdef,forwarddef: + DoRemoveLastDeallocForFuncRes(asml,RS_EAX); + orddef: + if current_procinfo.procdef.returndef.size <> 0 then + begin + DoRemoveLastDeallocForFuncRes(asml,RS_EAX); + { for int64/qword } + if current_procinfo.procdef.returndef.size = 8 then + DoRemoveLastDeallocForFuncRes(asml,RS_EDX); + end; + end; +end; + +procedure getNoDeallocRegs(var regs: tregset); +var + regCounter: TSuperRegister; +begin + regs := []; + case current_procinfo.procdef.returndef.typ of + arraydef,recorddef,pointerdef, + stringdef,enumdef,procdef,objectdef,errordef, + filedef,setdef,procvardef, + classrefdef,forwarddef: + regs := [RS_EAX]; + orddef: + if current_procinfo.procdef.returndef.size <> 0 then + begin + regs := [RS_EAX]; + { for int64/qword } + if current_procinfo.procdef.returndef.size = 8 then + regs := regs + [RS_EDX]; + end; + end; + for regCounter := RS_EAX to RS_EBX do +{ if not(regCounter in rg.usableregsint) then} + include(regs,regcounter); +end; + + +procedure AddRegDeallocFor(asml: TAsmList; reg: tregister; p: tai); +var + hp1: tai; + funcResRegs: tregset; +{ funcResReg: boolean;} +begin +{ if not(supreg in rg.usableregsint) then + exit;} +{ if not(supreg in [RS_EDI]) then + exit;} + getNoDeallocRegs(funcresregs); +{ funcResRegs := funcResRegs - rg.usableregsint;} +{ funcResRegs := funcResRegs - [RS_EDI];} +{ funcResRegs := funcResRegs - [RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI]; } +{ funcResReg := getsupreg(reg) in funcresregs;} + + hp1 := p; +{ + + + while not(funcResReg and + (p.typ = ait_instruction) and + (taicpu(p).opcode = A_JMP) and + (tasmlabel(taicpu(p).oper[0]^.sym) = aktexit2label)) and + getLastInstruction(p, p) and + not(regInInstruction(supreg, p)) do + hp1 := p; +} + { don't insert a dealloc for registers which contain the function result } + { if they are followed by a jump to the exit label (for exit(...)) } +{ if not(funcResReg) or + not((hp1.typ = ait_instruction) and + (taicpu(hp1).opcode = A_JMP) and + (tasmlabel(taicpu(hp1).oper[0]^.sym) = aktexit2label)) then } + begin + p := tai_regalloc.deAlloc(reg,nil); + insertLLItem(AsmL, hp1.previous, hp1, p); + end; +end; + + + +{************************ Search the Label table ************************} + +function findlabel(l: tasmlabel; var hp: tai): boolean; + +{searches for the specified label starting from hp as long as the + encountered instructions are labels, to be able to optimize constructs like + + jne l2 jmp l2 + jmp l3 and l1: + l1: l2: + l2:} + +var + p: tai; + +begin + p := hp; + while assigned(p) and + (p.typ in SkipInstr + [ait_label,ait_align]) Do + if (p.typ <> ait_Label) or + (tai_label(p).labsym <> l) then + GetNextInstruction(p, p) + else + begin + hp := p; + findlabel := true; + exit + end; + findlabel := false; +end; + +{************************ Some general functions ************************} + +function tch2reg(ch: tinschange): tsuperregister; +{converts a TChange variable to a TRegister} +const + ch2reg: array[CH_REAX..CH_REDI] of tsuperregister = (RS_EAX,RS_ECX,RS_EDX,RS_EBX,RS_ESP,RS_EBP,RS_ESI,RS_EDI); +begin + if (ch <= CH_REDI) then + tch2reg := ch2reg[ch] + else if (ch <= CH_WEDI) then + tch2reg := ch2reg[tinschange(ord(ch) - ord(CH_REDI))] + else if (ch <= CH_RWEDI) then + tch2reg := ch2reg[tinschange(ord(ch) - ord(CH_WEDI))] + else if (ch <= CH_MEDI) then + tch2reg := ch2reg[tinschange(ord(ch) - ord(CH_RWEDI))] + else + InternalError($db) +end; + + +{ inserts new_one between prev and foll } + +procedure InsertLLItem(AsmL: TAsmList; 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; + { shgould 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; + +{********************* Compare parts of tai objects *********************} + +function regssamesize(reg1, reg2: tregister): boolean; +{returns true if Reg1 and Reg2 are of the same size (so if they're both + 8bit, 16bit or 32bit)} +begin + if (reg1 = NR_NO) or (reg2 = NR_NO) then + internalerror(2003111602); + regssamesize := getsubreg(reg1) = getsubreg(reg2); +end; + + +procedure AddReg2RegInfo(OldReg, NewReg: TRegister; var RegInfo: toptreginfo); +{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 RS_INVALID} +var + newsupreg, oldsupreg: tsuperregister; +begin + if (newreg = NR_NO) or (oldreg = NR_NO) then + internalerror(2003111601); + newsupreg := getsupreg(newreg); + oldsupreg := getsupreg(oldreg); + with RegInfo Do + begin + NewRegsEncountered := NewRegsEncountered + [newsupreg]; + OldRegsEncountered := OldRegsEncountered + [oldsupreg]; + New2OldReg[newsupreg] := oldsupreg; + end; +end; + + +procedure AddOp2RegInfo(const o:toper; var reginfo: toptreginfo); +begin + case o.typ Of + top_reg: + if (o.reg <> NR_NO) then + AddReg2RegInfo(o.reg, o.reg, RegInfo); + top_ref: + begin + if o.ref^.base <> NR_NO then + AddReg2RegInfo(o.ref^.base, o.ref^.base, RegInfo); + if o.ref^.index <> NR_NO then + AddReg2RegInfo(o.ref^.index, o.ref^.index, RegInfo); + end; + end; +end; + + +function RegsEquivalent(oldreg, newreg: tregister; const oldinst, newinst: taicpu; var reginfo: toptreginfo; opact: topaction): Boolean; +begin + if not((oldreg = NR_NO) or (newreg = NR_NO)) then + if RegsSameSize(oldreg, newreg) then + with reginfo do +{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 RS_NO and the comparison in the else-part will fail} + if (getsupreg(oldReg) in OldRegsEncountered) then + if (getsupreg(NewReg) in NewRegsEncountered) then + RegsEquivalent := (getsupreg(oldreg) = New2OldReg[getsupreg(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 + AddReg2RegInfo(oldreg, newreg, reginfo); + RegsEquivalent := true + end + else + Regsequivalent := false + else + if not(getsupreg(newreg) in NewRegsEncountered) and + ((opact = opact_write) or + ((newreg = oldreg) and + (ptaiprop(oldinst.optinfo)^.regs[getsupreg(oldreg)].wstate = + ptaiprop(newinst.optinfo)^.regs[getsupreg(oldreg)].wstate) and + not(regmodifiedbyinstruction(getsupreg(oldreg),oldinst)))) then + begin + AddReg2RegInfo(oldreg, newreg, reginfo); + RegsEquivalent := true + end + else + RegsEquivalent := false + else + RegsEquivalent := false + else + RegsEquivalent := oldreg = newreg +end; + + +function RefsEquivalent(const r1, r2: treference; const oldinst, newinst: taicpu; var regInfo: toptreginfo): boolean; +begin + RefsEquivalent := + (r1.offset = r2.offset) and + RegsEquivalent(r1.base, r2.base, oldinst, newinst, reginfo, OpAct_Read) and + RegsEquivalent(r1.index, r2.index, oldinst, newinst, reginfo, OpAct_Read) and + (r1.segment = r2.segment) and (r1.scalefactor = r2.scalefactor) and + (r1.symbol = r2.symbol) and (r1.refaddr = r2.refaddr) and + (r1.relsymbol = r2.relsymbol); +end; + + +function refsequal(const r1, r2: treference): boolean; +begin + refsequal := + (r1.offset = r2.offset) and + (r1.segment = r2.segment) and (r1.base = r2.base) and + (r1.index = r2.index) and (r1.scalefactor = r2.scalefactor) and + (r1.symbol=r2.symbol) and (r1.refaddr = r2.refaddr) and + (r1.relsymbol = r2.relsymbol); +end; + + +{$push} +{$q-} + +// checks whether a write to r2 of size "size" contains address r1 +function refsoverlapping(const r1, r2: treference; size1, size2: tcgsize): boolean; +var + realsize1, realsize2: aint; +begin + realsize1 := tcgsize2size[size1]; + realsize2 := tcgsize2size[size2]; + refsoverlapping := + (r2.offset <= r1.offset+realsize1) and + (r1.offset <= r2.offset+realsize2) and + (r1.segment = r2.segment) and (r1.base = r2.base) and + (r1.index = r2.index) and (r1.scalefactor = r2.scalefactor) and + (r1.symbol=r2.symbol) and (r1.refaddr = r2.refaddr) and + (r1.relsymbol = r2.relsymbol); +end; + +{$pop} + + +function isgp32reg(supreg: tsuperregister): boolean; +{Checks if the register is a 32 bit general purpose register} +begin + isgp32reg := false; +{$push}{$warnings off} + if (supreg >= RS_EAX) and (supreg <= RS_EBX) then + isgp32reg := true +{$pop} +end; + + +function reginref(supreg: tsuperregister; const ref: treference): boolean; +begin {checks whether ref contains a reference to reg} + reginref := + ((ref.base <> NR_NO) and + (getsupreg(ref.base) = supreg)) or + ((ref.index <> NR_NO) and + (getsupreg(ref.index) = supreg)) +end; + + +function RegReadByInstruction(supreg: tsuperregister; hp: tai): boolean; +var + p: taicpu; + opcount: longint; +begin + RegReadByInstruction := false; + if hp.typ <> ait_instruction then + exit; + p := taicpu(hp); + case p.opcode of + A_CALL: + regreadbyinstruction := true; + A_IMUL: + case p.ops of + 1: + regReadByInstruction := + (supreg = RS_EAX) or reginop(supreg,p.oper[0]^); + 2,3: + regReadByInstruction := + reginop(supreg,p.oper[0]^) or + reginop(supreg,p.oper[1]^); + end; + A_IDIV,A_DIV,A_MUL: + begin + regReadByInstruction := + reginop(supreg,p.oper[0]^) or (supreg in [RS_EAX,RS_EDX]); + end; + else + begin + for opcount := 0 to p.ops-1 do + if (p.oper[opCount]^.typ = top_ref) and + reginref(supreg,p.oper[opcount]^.ref^) then + begin + RegReadByInstruction := true; + exit + end; + for opcount := 1 to maxinschanges do + case insprop[p.opcode].ch[opcount] of + CH_REAX..CH_REDI,CH_RWEAX..CH_MEDI: + if supreg = tch2reg(insprop[p.opcode].ch[opcount]) then + begin + RegReadByInstruction := true; + exit + end; + CH_RWOP1,CH_ROP1,CH_MOP1: + if //(p.oper[0]^.typ = top_reg) and + reginop(supreg,p.oper[0]^) then + begin + RegReadByInstruction := true; + exit + end; + Ch_RWOP2,Ch_ROP2,Ch_MOP2: + if //(p.oper[1]^.typ = top_reg) and + reginop(supreg,p.oper[1]^) then + begin + RegReadByInstruction := true; + exit + end; + Ch_RWOP3,Ch_ROP3,Ch_MOP3: + if //(p.oper[2]^.typ = top_reg) and + reginop(supreg,p.oper[2]^) then + begin + RegReadByInstruction := true; + exit + end; + end; + end; + end; +end; + + +function regInInstruction(supreg: tsuperregister; p1: tai): boolean; +{ Checks if reg is used by the instruction p1 } +{ Difference with "regReadBysinstruction() or regModifiedByInstruction()": } +{ this one ignores CH_ALL opcodes, while regModifiedByInstruction doesn't } +var + p: taicpu; + opcount: longint; +begin + regInInstruction := false; + if p1.typ <> ait_instruction then + exit; + p := taicpu(p1); + case p.opcode of + A_CALL: + regininstruction := true; + A_IMUL: + case p.ops of + 1: + regInInstruction := + (supreg = RS_EAX) or reginop(supreg,p.oper[0]^); + 2,3: + regInInstruction := + reginop(supreg,p.oper[0]^) or + reginop(supreg,p.oper[1]^) or + (assigned(p.oper[2]) and + reginop(supreg,p.oper[2]^)); + end; + A_IDIV,A_DIV,A_MUL: + regInInstruction := + reginop(supreg,p.oper[0]^) or + (supreg in [RS_EAX,RS_EDX]) + else + begin + for opcount := 0 to p.ops-1 do + if (p.oper[opCount]^.typ = top_ref) and + reginref(supreg,p.oper[opcount]^.ref^) then + begin + regInInstruction := true; + exit + end; + for opcount := 1 to maxinschanges do + case insprop[p.opcode].Ch[opCount] of + CH_REAX..CH_MEDI: + if tch2reg(InsProp[p.opcode].Ch[opCount]) = supreg then + begin + regInInstruction := true; + exit; + end; + CH_ROp1..CH_MOp1: + if reginop(supreg,p.oper[0]^) then + begin + regInInstruction := true; + exit + end; + Ch_ROp2..Ch_MOp2: + if reginop(supreg,p.oper[1]^) then + begin + regInInstruction := true; + exit + end; + Ch_ROp3..Ch_MOp3: + if reginop(supreg,p.oper[2]^) then + begin + regInInstruction := true; + exit + end; + end; + end; + end; +end; + + +function reginop(supreg: tsuperregister; const o:toper): boolean; +begin + reginop := false; + case o.typ Of + top_reg: + reginop := + (getregtype(o.reg) = R_INTREGISTER) and + (supreg = getsupreg(o.reg)); + top_ref: + reginop := + ((o.ref^.base <> NR_NO) and + (supreg = getsupreg(o.ref^.base))) or + ((o.ref^.index <> NR_NO) and + (supreg = getsupreg(o.ref^.index))); + end; +end; + + +function RegModifiedByInstruction(supreg: tsuperregister; p1: tai): boolean; +var + InstrProp: TInsProp; + TmpResult: Boolean; + Cnt: Word; +begin + TmpResult := False; + if supreg = RS_INVALID then + exit; + if (p1.typ = ait_instruction) then + case taicpu(p1).opcode of + A_IMUL: + With taicpu(p1) Do + TmpResult := + ((ops = 1) and (supreg in [RS_EAX,RS_EDX])) or + ((ops = 2) and (getsupreg(oper[1]^.reg) = supreg)) or + ((ops = 3) and (getsupreg(oper[2]^.reg) = supreg)); + A_DIV, A_IDIV, A_MUL: + With taicpu(p1) Do + TmpResult := + (supreg in [RS_EAX,RS_EDX]); + else + begin + Cnt := 1; + InstrProp := InsProp[taicpu(p1).OpCode]; + while (Cnt <= maxinschanges) and + (InstrProp.Ch[Cnt] <> Ch_None) and + not(TmpResult) Do + begin + case InstrProp.Ch[Cnt] Of + Ch_WEAX..Ch_MEDI: + TmpResult := supreg = tch2reg(InstrProp.Ch[Cnt]); + Ch_RWOp1,Ch_WOp1,Ch_Mop1: + TmpResult := (taicpu(p1).oper[0]^.typ = top_reg) and + reginop(supreg,taicpu(p1).oper[0]^); + Ch_RWOp2,Ch_WOp2,Ch_Mop2: + TmpResult := (taicpu(p1).oper[1]^.typ = top_reg) and + reginop(supreg,taicpu(p1).oper[1]^); + Ch_RWOp3,Ch_WOp3,Ch_Mop3: + TmpResult := (taicpu(p1).oper[2]^.typ = top_reg) and + reginop(supreg,taicpu(p1).oper[2]^); + Ch_FPU: TmpResult := false; // supreg is supposed to be an intreg!! supreg in [RS_ST..RS_ST7,RS_MM0..RS_MM7]; + Ch_ALL: TmpResult := true; + end; + inc(Cnt) + end + end + end; + RegModifiedByInstruction := TmpResult +end; + + +function instrWritesFlags(p: tai): boolean; +var + l: longint; +begin + instrWritesFlags := true; + case p.typ of + ait_instruction: + begin + for l := 1 to maxinschanges do + if InsProp[taicpu(p).opcode].Ch[l] in [Ch_WFlags,Ch_RWFlags,Ch_All] then + exit; + end; + ait_label: + exit; + end; + instrWritesFlags := false; +end; + + +function instrReadsFlags(p: tai): boolean; +var + l: longint; +begin + instrReadsFlags := true; + case p.typ of + ait_instruction: + begin + for l := 1 to maxinschanges do + if InsProp[taicpu(p).opcode].Ch[l] in [Ch_RFlags,Ch_RWFlags,Ch_All] then + exit; + end; + ait_label: + exit; + end; + instrReadsFlags := false; +end; + + +{********************* GetNext and GetLastInstruction *********************} +function GetNextInstruction(Current: tai; var Next: tai): Boolean; +{ skips ait_regalloc, ait_regdealloc and ait_stab* objects and puts the } +{ next tai object in Next. Returns false if there isn't any } +begin + repeat + if (Current.typ = ait_marker) and + (tai_Marker(current).Kind = mark_AsmBlockStart) then + begin + GetNextInstruction := False; + Next := Nil; + Exit + end; + Current := tai(current.Next); + while assigned(Current) and + ((current.typ in skipInstr) or + ((current.typ = ait_label) and + labelCanBeSkipped(tai_label(current)))) do + Current := tai(current.Next); +{ if assigned(Current) and + (current.typ = ait_Marker) and + (tai_Marker(current).Kind = mark_NoPropInfoStart) then + begin + while assigned(Current) and + ((current.typ <> ait_Marker) or + (tai_Marker(current).Kind <> mark_NoPropInfoEnd)) Do + Current := tai(current.Next); + end;} + until not(assigned(Current)) or + (current.typ <> ait_Marker) or + not(tai_Marker(current).Kind in [mark_NoPropInfoStart,mark_NoPropInfoEnd]); + Next := Current; + if assigned(Current) and + not((current.typ in SkipInstr) or + ((current.typ = ait_label) and + labelCanBeSkipped(tai_label(current)))) + then + GetNextInstruction := + not((current.typ = ait_marker) and + (tai_marker(current).kind = mark_AsmBlockStart)) + else + begin + GetNextInstruction := False; + Next := nil; + end; +end; + + +function GetLastInstruction(Current: tai; var Last: tai): boolean; +{skips the ait-types in SkipInstr puts the previous tai object in + Last. Returns false if there isn't any} +begin + repeat + Current := tai(current.previous); + while assigned(Current) and + (((current.typ = ait_Marker) and + not(tai_Marker(current).Kind in [mark_AsmBlockEnd{,mark_NoPropInfoEnd}])) or + (current.typ in SkipInstr) or + ((current.typ = ait_label) and + labelCanBeSkipped(tai_label(current)))) Do + Current := tai(current.previous); +{ if assigned(Current) and + (current.typ = ait_Marker) and + (tai_Marker(current).Kind = mark_NoPropInfoEnd) then + begin + while assigned(Current) and + ((current.typ <> ait_Marker) or + (tai_Marker(current).Kind <> mark_NoPropInfoStart)) Do + Current := tai(current.previous); + end;} + until not(assigned(Current)) or + (current.typ <> ait_Marker) or + not(tai_Marker(current).Kind in [mark_NoPropInfoStart,mark_NoPropInfoEnd]); + if not(assigned(Current)) or + (current.typ in SkipInstr) or + ((current.typ = ait_label) and + labelCanBeSkipped(tai_label(current))) or + ((current.typ = ait_Marker) and + (tai_Marker(current).Kind = mark_AsmBlockEnd)) + then + begin + Last := nil; + GetLastInstruction := False + end + else + begin + Last := Current; + GetLastInstruction := True; + end; +end; + + +procedure SkipHead(var p: tai); +var + oldp: tai; +begin + repeat + oldp := p; + if (p.typ in SkipInstr) or + ((p.typ = ait_marker) and + (tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd])) then + GetNextInstruction(p,p) + else if ((p.Typ = Ait_Marker) and + (tai_Marker(p).Kind = mark_NoPropInfoStart)) then + {a marker of the mark_NoPropInfoStart can't be the first instruction of a + TAsmList list} + GetNextInstruction(tai(p.previous),p); + until p = oldp +end; + + +function labelCanBeSkipped(p: tai_label): boolean; +begin + labelCanBeSkipped := not(p.labsym.is_used) or (p.labsym.labeltype<>alt_jump); +end; + +{******************* The Data Flow Analyzer functions ********************} + +function regLoadedWithNewValue(supreg: tsuperregister; canDependOnPrevValue: boolean; + hp: tai): boolean; +{ assumes reg is a 32bit register } +var + p: taicpu; +begin + if not assigned(hp) or + (hp.typ <> ait_instruction) then + begin + regLoadedWithNewValue := false; + exit; + end; + p := taicpu(hp); + regLoadedWithNewValue := + (((p.opcode = A_MOV) or + (p.opcode = A_MOVZX) or + (p.opcode = A_MOVSX) or + (p.opcode = A_LEA)) and + (p.oper[1]^.typ = top_reg) and + (getsupreg(p.oper[1]^.reg) = supreg) and + (canDependOnPrevValue or + (p.oper[0]^.typ = top_const) or + ((p.oper[0]^.typ = top_reg) and + (getsupreg(p.oper[0]^.reg) <> supreg)) or + ((p.oper[0]^.typ = top_ref) and + not regInRef(supreg,p.oper[0]^.ref^)))) or + ((p.opcode = A_POP) and + (getsupreg(p.oper[0]^.reg) = supreg)); +end; + +procedure UpdateUsedRegs(var UsedRegs: TRegSet; 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 + labelCanBeSkipped(tai_label(p))) or + ((p.typ = ait_marker) and + (tai_Marker(p).Kind in [mark_AsmBlockEnd,mark_NoLineInfoStart,mark_NoLineInfoEnd]))) do + p := tai(p.next); + while assigned(p) and + (p.typ=ait_RegAlloc) Do + begin + if (getregtype(tai_regalloc(p).reg) = R_INTREGISTER) then + begin + case tai_regalloc(p).ratype of + ra_alloc : + Include(UsedRegs, TRegEnum(getsupreg(tai_regalloc(p).reg))); + ra_dealloc : + Exclude(UsedRegs, TRegEnum(getsupreg(tai_regalloc(p).reg))); + end; + end; + p := tai(p.next); + end; + until not(assigned(p)) or + (not(p.typ in SkipInstr) and + not((p.typ = ait_label) and + labelCanBeSkipped(tai_label(p)))); +end; + + +procedure AllocRegBetween(asml: TAsmList; reg: tregister; p1, p2: tai; var initialusedregs: tregset); +{ allocates register reg between (and including) instructions p1 and p2 } +{ the type of p1 and p2 must not be in SkipInstr } +{ note that this routine is both called from the peephole optimizer } +{ where optinfo is not yet initialised) and from the cse (where it is) } +var + hp, start: tai; + removedsomething, + firstRemovedWasAlloc, + lastRemovedWasDealloc: boolean; + supreg: tsuperregister; +begin +{$ifdef EXTDEBUG} + if assigned(p1.optinfo) and + (ptaiprop(p1.optinfo)^.usedregs <> initialusedregs) then + internalerror(2004101010); +{$endif EXTDEBUG} + start := p1; + if (reg = NR_ESP) or + (reg = current_procinfo.framepointer) or + not(assigned(p1)) then + { this happens with registers which are loaded implicitely, outside the } + { current block (e.g. esi with self) } + exit; + supreg := getsupreg(reg); + { make sure we allocate it for this instruction } + getnextinstruction(p2,p2); + lastRemovedWasDealloc := false; + removedSomething := false; + firstRemovedWasAlloc := false; +{$ifdef allocregdebug} + hp := tai_comment.Create(strpnew('allocating '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+ + ' from here...')); + insertllitem(asml,p1.previous,p1,hp); + hp := tai_comment.Create(strpnew('allocated '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+ + ' till here...')); + insertllitem(asml,p2,p2.next,hp); +{$endif allocregdebug} + if not(supreg in initialusedregs) then + begin + hp := tai_regalloc.alloc(reg,nil); + insertllItem(asmL,p1.previous,p1,hp); + include(initialusedregs,supreg); + end; + while assigned(p1) and + (p1 <> p2) do + begin + if assigned(p1.optinfo) then + include(ptaiprop(p1.optinfo)^.usedregs,supreg); + p1 := tai(p1.next); + repeat + while assigned(p1) and + (p1.typ in (SkipInstr-[ait_regalloc])) Do + p1 := tai(p1.next); +{ remove all allocation/deallocation info about the register in between } + if assigned(p1) and + (p1.typ = ait_regalloc) then + if (getsupreg(tai_regalloc(p1).reg) = supreg) then + begin + if not removedSomething then + begin + firstRemovedWasAlloc := tai_regalloc(p1).ratype=ra_alloc; + removedSomething := true; + end; + lastRemovedWasDealloc := (tai_regalloc(p1).ratype=ra_dealloc); + hp := tai(p1.Next); + asml.Remove(p1); + p1.free; + p1 := hp; + end + else p1 := tai(p1.next); + until not(assigned(p1)) or + not(p1.typ in SkipInstr); + end; + if assigned(p1) then + begin + if firstRemovedWasAlloc then + begin + hp := tai_regalloc.Alloc(reg,nil); + insertLLItem(asmL,start.previous,start,hp); + end; + if lastRemovedWasDealloc then + begin + hp := tai_regalloc.DeAlloc(reg,nil); + insertLLItem(asmL,p1.previous,p1,hp); + end; + end; +end; + + +function FindRegDealloc(supreg: tsuperregister; p: tai): boolean; +var + hp: tai; + first: boolean; +begin + findregdealloc := false; + first := true; + while assigned(p.previous) and + ((tai(p.previous).typ in (skipinstr+[ait_align])) or + ((tai(p.previous).typ = ait_label) and + labelCanBeSkipped(tai_label(p.previous)))) do + begin + p := tai(p.previous); + if (p.typ = ait_regalloc) and + (getregtype(tai_regalloc(p).reg) = R_INTREGISTER) and + (getsupreg(tai_regalloc(p).reg) = supreg) then + if (tai_regalloc(p).ratype=ra_dealloc) then + if first then + begin + findregdealloc := true; + break; + end + else + begin + findRegDealloc := + getNextInstruction(p,hp) and + regLoadedWithNewValue(supreg,false,hp); + break + end + else + first := false; + end +end; + + + +procedure incState(var S: Byte; amount: longint); +{increases S by 1, wraps around at $ffff to 0 (so we won't get overflow + errors} +begin + if (s <= $ff - amount) then + inc(s, amount) + else s := longint(s) + amount - $ff; +end; + + +function sequenceDependsonReg(const Content: TContent; seqreg: tsuperregister; supreg: tsuperregister): Boolean; +{ Content is the sequence of instructions that describes the contents of } +{ seqReg. reg is being overwritten by the current instruction. if the } +{ content of seqReg depends on reg (ie. because of a } +{ "movl (seqreg,reg), seqReg" instruction), this function returns true } +var + p: tai; + Counter: Word; + TmpResult: Boolean; + RegsChecked: TRegSet; +begin + RegsChecked := []; + p := Content.StartMod; + TmpResult := False; + Counter := 1; + while not(TmpResult) and + (Counter <= Content.NrOfMods) Do + begin + if (p.typ = ait_instruction) and + ((taicpu(p).opcode = A_MOV) or + (taicpu(p).opcode = A_MOVZX) or + (taicpu(p).opcode = A_MOVSX) or + (taicpu(p).opcode = A_LEA)) and + (taicpu(p).oper[0]^.typ = top_ref) then + With taicpu(p).oper[0]^.ref^ Do + if ((base = current_procinfo.FramePointer) or + (assigned(symbol) and (base = NR_NO))) and + (index = NR_NO) then + begin + RegsChecked := RegsChecked + [getsupreg(taicpu(p).oper[1]^.reg)]; + if supreg = getsupreg(taicpu(p).oper[1]^.reg) then + break; + end + else + tmpResult := + regReadByInstruction(supreg,p) and + regModifiedByInstruction(seqReg,p) + else + tmpResult := + regReadByInstruction(supreg,p) and + regModifiedByInstruction(seqReg,p); + inc(Counter); + GetNextInstruction(p,p) + end; + sequenceDependsonReg := TmpResult +end; + + +procedure invalidateDependingRegs(p1: ptaiprop; supreg: tsuperregister); +var + counter: tsuperregister; +begin + for counter := RS_EAX to RS_EDI do + if counter <> supreg then + with p1^.regs[counter] Do + begin + if (typ in [con_ref,con_noRemoveRef]) and + sequenceDependsOnReg(p1^.Regs[counter],counter,supreg) then + if typ in [con_ref, con_invalid] then + typ := con_invalid + { con_noRemoveRef = con_unknown } + else + typ := con_unknown; + if assigned(memwrite) and + regInRef(counter,memwrite.oper[1]^.ref^) then + memwrite := nil; + end; +end; + + +procedure DestroyReg(p1: ptaiprop; supreg: tsuperregister; doincState:Boolean); +{Destroys the contents of the register reg in the ptaiprop p1, as well as the + contents of registers are loaded with a memory location based on reg. + doincState is false when this register has to be destroyed not because + it's contents are directly modified/overwritten, but because of an indirect + action (e.g. this register holds the contents of a variable and the value + of the variable in memory is changed) } +begin +{$push}{$warnings off} + { the following happens for fpu registers } + if (supreg < low(NrOfInstrSinceLastMod)) or + (supreg > high(NrOfInstrSinceLastMod)) then + exit; +{$pop} + NrOfInstrSinceLastMod[supreg] := 0; + with p1^.regs[supreg] do + begin + if doincState then + begin + incState(wstate,1); + typ := con_unknown; + startmod := nil; + end + else + if typ in [con_ref,con_const,con_invalid] then + typ := con_invalid + { con_noRemoveRef = con_unknown } + else + typ := con_unknown; + memwrite := nil; + end; + invalidateDependingRegs(p1,supreg); +end; + +{procedure AddRegsToSet(p: tai; var RegSet: TRegSet); +begin + if (p.typ = ait_instruction) then + begin + case taicpu(p).oper[0]^.typ Of + top_reg: + if not(taicpu(p).oper[0]^.reg in [RS_NO,RS_ESP,current_procinfo.FramePointer]) then + RegSet := RegSet + [taicpu(p).oper[0]^.reg]; + top_ref: + With TReference(taicpu(p).oper[0]^) Do + begin + if not(base in [current_procinfo.FramePointer,RS_NO,RS_ESP]) + then RegSet := RegSet + [base]; + if not(index in [current_procinfo.FramePointer,RS_NO,RS_ESP]) + then RegSet := RegSet + [index]; + end; + end; + case taicpu(p).oper[1]^.typ Of + top_reg: + if not(taicpu(p).oper[1]^.reg in [RS_NO,RS_ESP,current_procinfo.FramePointer]) then + if RegSet := RegSet + [TRegister(TwoWords(taicpu(p).oper[1]^).Word1]; + top_ref: + With TReference(taicpu(p).oper[1]^) Do + begin + if not(base in [current_procinfo.FramePointer,RS_NO,RS_ESP]) + then RegSet := RegSet + [base]; + if not(index in [current_procinfo.FramePointer,RS_NO,RS_ESP]) + then RegSet := RegSet + [index]; + end; + end; + end; +end;} + +function OpsEquivalent(const o1, o2: toper; const oldinst, newinst: taicpu; var RegInfo: toptreginfo; OpAct: TopAction): Boolean; +begin {checks whether the two ops are equivalent} + OpsEquivalent := False; + if o1.typ=o2.typ then + case o1.typ Of + top_reg: + OpsEquivalent :=RegsEquivalent(o1.reg,o2.reg, oldinst, newinst, RegInfo, OpAct); + top_ref: + OpsEquivalent := RefsEquivalent(o1.ref^, o2.ref^, oldinst, newinst, RegInfo); + Top_Const: + OpsEquivalent := o1.val = o2.val; + Top_None: + OpsEquivalent := True + end; +end; + + +function OpsEqual(const o1,o2:toper): Boolean; +begin {checks whether the two ops are equal} + OpsEqual := False; + if o1.typ=o2.typ then + case o1.typ Of + top_reg : + OpsEqual:=o1.reg=o2.reg; + top_ref : + OpsEqual := RefsEqual(o1.ref^, o2.ref^); + Top_Const : + OpsEqual:=o1.val=o2.val; + Top_None : + OpsEqual := True + end; +end; + + +function sizescompatible(loadsize,newsize: topsize): boolean; + begin + case loadsize of + S_B,S_BW,S_BL: + sizescompatible := (newsize = loadsize) or (newsize = S_B); + S_W,S_WL: + sizescompatible := (newsize = loadsize) or (newsize = S_W); + else + sizescompatible := newsize = S_L; + end; + end; + + +function opscompatible(p1,p2: taicpu): boolean; +begin + case p1.opcode of + A_MOVZX,A_MOVSX: + opscompatible := + ((p2.opcode = p1.opcode) or (p2.opcode = A_MOV)) and + sizescompatible(p1.opsize,p2.opsize); + else + opscompatible := + (p1.opcode = p2.opcode) and + (p1.ops = p2.ops) and + (p1.opsize = p2.opsize); + end; +end; + + +function InstructionsEquivalent(p1, p2: tai; var RegInfo: toptreginfo): Boolean; +{$ifdef csdebug} +var + hp: tai; +{$endif csdebug} +begin {checks whether two taicpu instructions are equal} + if assigned(p1) and assigned(p2) and + (tai(p1).typ = ait_instruction) and + (tai(p2).typ = ait_instruction) and + opscompatible(taicpu(p1),taicpu(p2)) and + (not(assigned(taicpu(p1).oper[0])) or + (taicpu(p1).oper[0]^.typ = taicpu(p2).oper[0]^.typ)) and + (not(assigned(taicpu(p1).oper[1])) or + (taicpu(p1).oper[1]^.typ = taicpu(p2).oper[1]^.typ)) and + (not(assigned(taicpu(p1).oper[2])) or + (taicpu(p1).oper[2]^.typ = taicpu(p2).oper[2]^.typ)) then + {both instructions have the same structure: + "<operator> <operand of type1>, <operand of type 2>"} + if ((taicpu(p1).opcode = A_MOV) or + (taicpu(p1).opcode = A_MOVZX) or + (taicpu(p1).opcode = A_MOVSX) or + (taicpu(p1).opcode = A_LEA)) and + (taicpu(p1).oper[0]^.typ = top_ref) {then .oper[1]^t = top_reg} then + if not(RegInRef(getsupreg(taicpu(p1).oper[1]^.reg), taicpu(p1).oper[0]^.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(getsupreg(taicpu(p2).oper[1]^.reg), taicpu(p2).oper[0]^.ref^)) and + RefsEquivalent(taicpu(p1).oper[0]^.ref^, taicpu(p2).oper[0]^.ref^,taicpu(p1), taicpu(p2), reginfo) 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 taicpu(p2).oper[0]^.ref^ Do + begin + if (base <> NR_NO) and + (not(getsupreg(base) in [getsupreg(current_procinfo.FramePointer), RS_ESP])) then + include(RegInfo.RegsLoadedForRef, getsupreg(base)); + if (index <> NR_NO) and + (not(getsupreg(index) in [getsupreg(current_procinfo.FramePointer), RS_ESP])) then + include(RegInfo.RegsLoadedForRef, getsupreg(index)); + end; + {add the registers from the reference (.oper[0]^) to the RegInfo, all registers + from the reference are the same in the old and in the new instruction + sequence} + AddOp2RegInfo(taicpu(p1).oper[0]^, RegInfo); + {the registers from .oper[1]^ have to be equivalent, but not necessarily equal} + InstructionsEquivalent := + RegsEquivalent(taicpu(p1).oper[1]^.reg, + taicpu(p2).oper[1]^.reg, taicpu(p1), taicpu(p2), RegInfo, OpAct_Write); + end + {the registers are loaded with values from different memory locations. if + this was 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 taicpu(p2).oper[0]^.ref^ Do + begin + if (base <> NR_NO) and + (not(getsupreg(base) in [getsupreg(current_procinfo.FramePointer), + getsupreg(taicpu(p2).oper[1]^.reg),RS_ESP])) then + {it won't do any harm if the register is already in RegsLoadedForRef} + begin + include(RegInfo.RegsLoadedForRef, getsupreg(base)); +{$ifdef csdebug} + Writeln(std_regname(base), ' added'); +{$endif csdebug} + end; + if (index <> NR_NO) and + (not(getsupreg(index) in [getsupreg(current_procinfo.FramePointer), + getsupreg(taicpu(p2).oper[1]^.reg),RS_ESP])) then + begin + include(RegInfo.RegsLoadedForRef, getsupreg(index)); +{$ifdef csdebug} + Writeln(std_regname(index), ' added'); +{$endif csdebug} + end; + + end; + if (taicpu(p2).oper[1]^.reg <> NR_NO) and + (not(getsupreg(taicpu(p2).oper[1]^.reg) in [getsupreg(current_procinfo.FramePointer),RS_ESP])) then + begin + RegInfo.RegsLoadedForRef := RegInfo.RegsLoadedForRef - + [getsupreg(taicpu(p2).oper[1]^.reg)]; +{$ifdef csdebug} + Writeln(std_regname(newreg(R_INTREGISTER,getsupreg(taicpu(p2).oper[1]^.reg),R_SUBWHOLE)), ' removed'); +{$endif csdebug} + end; + InstructionsEquivalent := + OpsEquivalent(taicpu(p1).oper[0]^, taicpu(p2).oper[0]^, taicpu(p1), taicpu(p2), RegInfo, OpAct_Read) and + OpsEquivalent(taicpu(p1).oper[1]^, taicpu(p2).oper[1]^, taicpu(p1), taicpu(p2), RegInfo, OpAct_Write) + end + else + {an instruction <> mov, movzx, movsx} + begin + {$ifdef csdebug} + hp := tai_comment.Create(strpnew('checking if equivalent')); + hp.previous := p2; + hp.next := p2.next; + p2.next.previous := hp; + p2.next := hp; + {$endif csdebug} + InstructionsEquivalent := + (not(assigned(taicpu(p1).oper[0])) or + OpsEquivalent(taicpu(p1).oper[0]^, taicpu(p2).oper[0]^, taicpu(p1), taicpu(p2), RegInfo, OpAct_Unknown)) and + (not(assigned(taicpu(p1).oper[1])) or + OpsEquivalent(taicpu(p1).oper[1]^, taicpu(p2).oper[1]^, taicpu(p1), taicpu(p2), RegInfo, OpAct_Unknown)) and + (not(assigned(taicpu(p1).oper[2])) or + OpsEquivalent(taicpu(p1).oper[2]^, taicpu(p2).oper[2]^, taicpu(p1), taicpu(p2), RegInfo, OpAct_Unknown)) + end + {the instructions haven't even got the same structure, so they're certainly + not equivalent} + else + begin + {$ifdef csdebug} + hp := tai_comment.Create(strpnew('different opcodes/format')); + hp.previous := p2; + hp.next := p2.next; + p2.next.previous := hp; + p2.next := hp; + {$endif csdebug} + InstructionsEquivalent := False; + end; + {$ifdef csdebug} + hp := tai_comment.Create(strpnew('instreq: '+tostr(byte(instructionsequivalent)))); + hp.previous := p2; + hp.next := p2.next; + p2.next.previous := hp; + p2.next := hp; + {$endif csdebug} +end; + +(* +function InstructionsEqual(p1, p2: tai): Boolean; +begin {checks whether two taicpu instructions are equal} + InstructionsEqual := + assigned(p1) and assigned(p2) and + ((tai(p1).typ = ait_instruction) and + (tai(p1).typ = ait_instruction) and + (taicpu(p1).opcode = taicpu(p2).opcode) and + (taicpu(p1).oper[0]^.typ = taicpu(p2).oper[0]^.typ) and + (taicpu(p1).oper[1]^.typ = taicpu(p2).oper[1]^.typ) and + OpsEqual(taicpu(p1).oper[0]^.typ, taicpu(p1).oper[0]^, taicpu(p2).oper[0]^) and + OpsEqual(taicpu(p1).oper[1]^.typ, taicpu(p1).oper[1]^, taicpu(p2).oper[1]^)) +end; +*) + +procedure readreg(p: ptaiprop; supreg: tsuperregister); +begin + if supreg in [RS_EAX..RS_EDI] then + incState(p^.regs[supreg].rstate,1) +end; + + +procedure readref(p: ptaiprop; const ref: preference); +begin + if ref^.base <> NR_NO then + readreg(p, getsupreg(ref^.base)); + if ref^.index <> NR_NO then + readreg(p, getsupreg(ref^.index)); +end; + + +procedure ReadOp(p: ptaiprop;const o:toper); +begin + case o.typ Of + top_reg: readreg(p, getsupreg(o.reg)); + top_ref: readref(p, o.ref); + end; +end; + + +function RefInInstruction(const ref: TReference; p: tai; + RefsEq: TRefCompare; size: tcgsize): Boolean; +{checks whehter ref is used in p} +var + mysize: tcgsize; + TmpResult: Boolean; +begin + TmpResult := False; + if (p.typ = ait_instruction) then + begin + mysize := topsize2tcgsize[taicpu(p).opsize]; + if (taicpu(p).ops >= 1) and + (taicpu(p).oper[0]^.typ = top_ref) then + TmpResult := RefsEq(taicpu(p).oper[0]^.ref^,ref,mysize,size); + if not(TmpResult) and + (taicpu(p).ops >= 2) and + (taicpu(p).oper[1]^.typ = top_ref) then + TmpResult := RefsEq(taicpu(p).oper[1]^.ref^,ref,mysize,size); + if not(TmpResult) and + (taicpu(p).ops >= 3) and + (taicpu(p).oper[2]^.typ = top_ref) then + TmpResult := RefsEq(taicpu(p).oper[2]^.ref^,ref,mysize,size); + end; + RefInInstruction := TmpResult; +end; + + +function RefInSequence(const ref: TReference; Content: TContent; + RefsEq: TRefCompare; size: tcgsize): Boolean; +{checks the whole sequence of Content (so StartMod and and the next NrOfMods + tai objects) to see whether ref is used somewhere} +var p: tai; + Counter: Word; + 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, RefsEq, size) + then TmpResult := True; + inc(Counter); + GetNextInstruction(p,p) + end; + RefInSequence := TmpResult +end; + +{$push} +{$q-} +// checks whether a write to r2 of size "size" contains address r1 +function arrayrefsoverlapping(const r1, r2: treference; size1, size2: tcgsize): Boolean; +var + realsize1, realsize2: aint; +begin + realsize1 := tcgsize2size[size1]; + realsize2 := tcgsize2size[size2]; + arrayrefsoverlapping := + (r2.offset <= r1.offset+realsize1) and + (r1.offset <= r2.offset+realsize2) and + (r1.segment = r2.segment) and + (r1.symbol=r2.symbol) and + (r1.base = r2.base) +end; +{$pop} + +function isSimpleRef(const ref: treference): boolean; +{ returns true if ref is reference to a local or global variable, to a } +{ parameter or to an object field (this includes arrays). Returns false } +{ otherwise. } +begin + isSimpleRef := + assigned(ref.symbol) or + (ref.base = current_procinfo.framepointer); +end; + + +function containsPointerRef(p: tai): boolean; +{ checks if an instruction contains a reference which is a pointer location } +var + hp: taicpu; + count: longint; +begin + containsPointerRef := false; + if p.typ <> ait_instruction then + exit; + hp := taicpu(p); + for count := 0 to hp.ops-1 do + begin + case hp.oper[count]^.typ of + top_ref: + if not isSimpleRef(hp.oper[count]^.ref^) then + begin + containsPointerRef := true; + exit; + end; + top_none: + exit; + end; + end; +end; + + +function containsPointerLoad(c: tcontent): boolean; +{ checks whether the contents of a register contain a pointer reference } +var + p: tai; + count: longint; +begin + containsPointerLoad := false; + p := c.startmod; + for count := c.nrOfMods downto 1 do + begin + if containsPointerRef(p) then + begin + containsPointerLoad := true; + exit; + end; + getnextinstruction(p,p); + end; +end; + + +function writeToMemDestroysContents(regWritten: tsuperregister; const ref: treference; + supreg: tsuperregister; size: tcgsize; const c: tcontent; var invalsmemwrite: boolean): boolean; +{ returns whether the contents c of reg are invalid after regWritten is } +{ is written to ref } +var + refsEq: trefCompare; +begin + if isSimpleRef(ref) then + begin + if (ref.index <> NR_NO) or + (assigned(ref.symbol) and + (ref.base <> NR_NO)) then + { local/global variable or parameter which is an array } + refsEq := @arrayRefsOverlapping + else + { local/global variable or parameter which is not an array } + refsEq := @refsOverlapping; + invalsmemwrite := + assigned(c.memwrite) and + ((not(cs_opt_size in current_settings.optimizerswitches) and + containsPointerRef(c.memwrite)) or + refsEq(c.memwrite.oper[1]^.ref^,ref,topsize2tcgsize[c.memwrite.opsize],size)); + if not(c.typ in [con_ref,con_noRemoveRef,con_invalid]) then + begin + writeToMemDestroysContents := false; + exit; + end; + + { 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 } + { expression based on ref) } + { * with uncertain optimizations off: } + { - also destroy registers that contain any pointer } + with c do + writeToMemDestroysContents := + (typ in [con_ref,con_noRemoveRef]) and + ((not(cs_opt_size in current_settings.optimizerswitches) and + containsPointerLoad(c) + ) or + (refInSequence(ref,c,refsEq,size) and + ((supreg <> regWritten) or + not((nrOfMods = 1) and + {StarMod is always of the type ait_instruction} + (taicpu(StartMod).oper[0]^.typ = top_ref) and + refsEq(taicpu(StartMod).oper[0]^.ref^, ref, topsize2tcgsize[taicpu(StartMod).opsize],size) + ) + ) + ) + ); + 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 } + begin + invalsmemwrite := + assigned(c.memwrite) and + (not(cs_opt_size in current_settings.optimizerswitches) or + containsPointerRef(c.memwrite)); + if not(c.typ in [con_ref,con_noRemoveRef,con_invalid]) then + begin + writeToMemDestroysContents := false; + exit; + end; + with c do + writeToMemDestroysContents := + (typ in [con_ref,con_noRemoveRef]) and + (not(cs_opt_size in current_settings.optimizerswitches) or + { for movsl } + ((ref.base = NR_EDI) and (ref.index = NR_EDI)) or + { don't destroy if reg contains a parameter, local or global variable } + containsPointerLoad(c) + ); + end; +end; + + +function writeToRegDestroysContents(destReg, supreg: tsuperregister; + const c: tcontent): boolean; +{ returns whether the contents c of reg are invalid after destReg is } +{ modified } +begin + writeToRegDestroysContents := + (c.typ in [con_ref,con_noRemoveRef,con_invalid]) and + sequenceDependsOnReg(c,supreg,destReg); +end; + + +function writeDestroysContents(const op: toper; supreg: tsuperregister; size: tcgsize; + const c: tcontent; var memwritedestroyed: boolean): boolean; +{ returns whether the contents c of reg are invalid after regWritten is } +{ is written to op } +begin + memwritedestroyed := false; + case op.typ of + top_reg: + writeDestroysContents := + (getregtype(op.reg) = R_INTREGISTER) and + writeToRegDestroysContents(getsupreg(op.reg),supreg,c); + top_ref: + writeDestroysContents := + writeToMemDestroysContents(RS_INVALID,op.ref^,supreg,size,c,memwritedestroyed); + else + writeDestroysContents := false; + end; +end; + + +procedure destroyRefs(p: tai; const ref: treference; regwritten: tsuperregister; size: tcgsize); +{ destroys all registers which possibly contain a reference to ref, regWritten } +{ is the register whose contents are being written to memory (if this proc } +{ is called because of a "mov?? %reg, (mem)" instruction) } +var + counter: tsuperregister; + destroymemwrite: boolean; +begin + for counter := RS_EAX to RS_EDI Do + begin + if writeToMemDestroysContents(regwritten,ref,counter,size, + ptaiprop(p.optInfo)^.regs[counter],destroymemwrite) then + destroyReg(ptaiprop(p.optInfo), counter, false) + else if destroymemwrite then + ptaiprop(p.optinfo)^.regs[counter].MemWrite := nil; + end; +end; + + +procedure DestroyAllRegs(p: ptaiprop; read, written: boolean); +var Counter: tsuperregister; +begin {initializes/desrtoys all registers} + For Counter := RS_EAX To RS_EDI Do + begin + if read then + readreg(p, Counter); + DestroyReg(p, Counter, written); + p^.regs[counter].MemWrite := nil; + end; + p^.DirFlag := F_Unknown; +end; + + +procedure DestroyOp(taiObj: tai; const o:Toper); +{$ifdef statedebug} +var + hp: tai; +{$endif statedebug} +begin + case o.typ Of + top_reg: + begin +{$ifdef statedebug} + hp := tai_comment.Create(strpnew('destroying '+std_regname(o.reg))); + hp.next := taiobj.next; + hp.previous := taiobj; + taiobj.next := hp; + if assigned(hp.next) then + hp.next.previous := hp; +{$endif statedebug} + DestroyReg(ptaiprop(taiObj.OptInfo), getsupreg(o.reg), true); + end; + top_ref: + begin + readref(ptaiprop(taiObj.OptInfo), o.ref); + DestroyRefs(taiObj, o.ref^, RS_INVALID,topsize2tcgsize[(taiobj as taicpu).opsize]); + end; + end; +end; + + +procedure AddInstr2RegContents({$ifdef statedebug} asml: TAsmList; {$endif} +p: taicpu; supreg: tsuperregister); +{$ifdef statedebug} +var + hp: tai; +{$endif statedebug} +begin + With ptaiprop(p.optinfo)^.regs[supreg] Do + if (typ in [con_ref,con_noRemoveRef]) then + begin + incState(wstate,1); + { also store how many instructions are part of the sequence in the first } + { instructions ptaiprop, so it can be easily accessed from within } + { CheckSequence} + inc(NrOfMods, NrOfInstrSinceLastMod[supreg]); + ptaiprop(tai(StartMod).OptInfo)^.Regs[supreg].NrOfMods := NrOfMods; + NrOfInstrSinceLastMod[supreg] := 0; + invalidateDependingRegs(p.optinfo,supreg); + ptaiprop(p.optinfo)^.regs[supreg].memwrite := nil; +{$ifdef StateDebug} + hp := tai_comment.Create(strpnew(std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+': '+tostr(ptaiprop(p.optinfo)^.Regs[supreg].WState) + + ' -- ' + tostr(ptaiprop(p.optinfo)^.Regs[supreg].nrofmods))); + InsertLLItem(AsmL, p, p.next, hp); +{$endif StateDebug} + end + else + begin +{$ifdef statedebug} + hp := tai_comment.Create(strpnew('destroying '+std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE)))); + insertllitem(asml,p,p.next,hp); +{$endif statedebug} + DestroyReg(ptaiprop(p.optinfo), supreg, true); +{$ifdef StateDebug} + hp := tai_comment.Create(strpnew(std_regname(newreg(R_INTREGISTER,supreg,R_SUBWHOLE))+': '+tostr(ptaiprop(p.optinfo)^.Regs[supreg].WState))); + InsertLLItem(AsmL, p, p.next, hp); +{$endif StateDebug} + end +end; + + +procedure AddInstr2OpContents({$ifdef statedebug} asml: TAsmList; {$endif} +p: taicpu; const oper: TOper); +begin + if oper.typ = top_reg then + AddInstr2RegContents({$ifdef statedebug} asml, {$endif}p, getsupreg(oper.reg)) + else + begin + ReadOp(ptaiprop(p.optinfo), oper); + DestroyOp(p, oper); + end +end; + + +{*************************************************************************************} +{************************************** TDFAOBJ **************************************} +{*************************************************************************************} + +constructor tdfaobj.create(_list: TAsmList); +begin + list := _list; + blockstart := nil; + blockend := nil; + nroftaiobjs := 0; + taipropblock := nil; + lolab := 0; + hilab := 0; + labdif := 0; + labeltable := nil; +end; + + +procedure tdfaobj.initlabeltable; +var + labelfound: boolean; + p, prev: tai; + hp1, hp2: tai; +{$ifdef i386} + regcounter, + supreg : tsuperregister; +{$endif i386} + usedregs, nodeallocregs: tregset; +begin + labelfound := false; + lolab := maxlongint; + hilab := 0; + p := blockstart; + prev := p; + while assigned(p) do + begin + if (tai(p).typ = ait_label) then + if not labelcanbeskipped(tai_label(p)) then + begin + labelfound := true; + if (tai_Label(p).labsym.labelnr < lolab) then + lolab := tai_label(p).labsym.labelnr; + if (tai_Label(p).labsym.labelnr > hilab) then + hilab := tai_label(p).labsym.labelnr; + end; + prev := p; + getnextinstruction(p, p); + end; + if (prev.typ = ait_marker) and + (tai_marker(prev).kind = mark_AsmBlockStart) then + blockend := prev + else blockend := nil; + if labelfound then + labdif := hilab+1-lolab + else labdif := 0; + + usedregs := []; + if (labdif <> 0) then + begin + getmem(labeltable, labdif*sizeof(tlabeltableitem)); + fillchar(labeltable^, labdif*sizeof(tlabeltableitem), 0); + end; + p := blockstart; + prev := p; + while (p <> blockend) do + begin + case p.typ of + ait_label: + if not labelcanbeskipped(tai_label(p)) then + labeltable^[tai_label(p).labsym.labelnr-lolab].taiobj := p; +{$ifdef i386} + ait_regalloc: + if (getregtype(tai_regalloc(p).reg) = R_INTREGISTER) then + begin + supreg:=getsupreg(tai_regalloc(p).reg); + case tai_regalloc(p).ratype of + ra_alloc : + begin + if not(supreg in usedregs) then + include(usedregs, supreg) + else + begin + //addregdeallocfor(list, tai_regalloc(p).reg, p); + hp1 := tai(p.previous); + list.remove(p); + p.free; + p := hp1; + end; + end; + ra_dealloc : + begin + exclude(usedregs, supreg); + hp1 := p; + hp2 := nil; + while not(findregalloc(supreg,tai(hp1.next),ra_alloc)) and + getnextinstruction(hp1, hp1) and + regininstruction(getsupreg(tai_regalloc(p).reg), hp1) Do + hp2 := hp1; + if hp2 <> nil then + begin + hp1 := tai(p.previous); + list.remove(p); + insertllitem(list, hp2, tai(hp2.next), p); + p := hp1; + end + else if findregalloc(getsupreg(tai_regalloc(p).reg), tai(p.next),ra_alloc) + and getnextinstruction(p,hp1) then + begin + hp1 := tai(p.previous); + list.remove(p); + p.free; + p := hp1; +// don't include here, since then the allocation will be removed when it's processed +// include(usedregs,supreg); + end; + end; + end; + end; +{$endif i386} + end; + repeat + prev := p; + p := tai(p.next); + until not(assigned(p)) or + (p = blockend) or + not(p.typ in (skipinstr - [ait_regalloc])); + end; +{$ifdef i386} + { don't add deallocation for function result variable or for regvars} + getNoDeallocRegs(noDeallocRegs); + usedRegs := usedRegs - noDeallocRegs; + for regCounter := RS_EAX to RS_EDI do + if regCounter in usedRegs then + addRegDeallocFor(list,newreg(R_INTREGISTER,regCounter,R_SUBWHOLE),prev); +{$endif i386} +end; + + +function tdfaobj.pass_1(_blockstart: tai): tai; +begin + blockstart := _blockstart; + initlabeltable; + pass_1 := blockend; +end; + + + +function tdfaobj.initdfapass2: boolean; +{reserves memory for the PtaiProps in one big memory block when not using + TP, returns False if not enough memory is available for the optimizer in all + cases} +var + p: tai; + count: Longint; +{ TmpStr: String; } +begin + p := blockstart; + skiphead(p); + nroftaiobjs := 0; + while (p <> blockend) do + begin +{$ifDef JumpAnal} + case p.typ of + ait_label: + begin + if not labelcanbeskipped(tai_label(p)) then + labeltable^[tai_label(p).labsym.labelnr-lolab].instrnr := nroftaiobjs + end; + ait_instruction: + begin + if taicpu(p).is_jmp then + begin + if (tasmlabel(taicpu(p).oper[0]^.sym).labsymabelnr >= lolab) and + (tasmlabel(taicpu(p).oper[0]^.sym).labsymabelnr <= hilab) then + inc(labeltable^[tasmlabel(taicpu(p).oper[0]^.sym).labsymabelnr-lolab].refsfound); + end; + end; +{ ait_instruction: + begin + if (taicpu(p).opcode = A_PUSH) and + (taicpu(p).oper[0]^.typ = top_symbol) and + (PCSymbol(taicpu(p).oper[0]^)^.offset = 0) then + begin + TmpStr := StrPas(PCSymbol(taicpu(p).oper[0]^)^.symbol); + if} + end; +{$endif JumpAnal} + inc(NrOftaiObjs); + getnextinstruction(p,p); + end; + if nroftaiobjs <> 0 then + begin + initdfapass2 := True; + getmem(taipropblock, nroftaiobjs*sizeof(ttaiprop)); + fillchar(taiPropblock^,nroftaiobjs*sizeof(ttaiprop),0); + p := blockstart; + skiphead(p); + for count := 1 To nroftaiobjs do + begin + ptaiprop(p.optinfo) := @taipropblock^[count]; + getnextinstruction(p, p); + end; + end + else + initdfapass2 := false; +end; + + +procedure tdfaobj.dodfapass2; +{Analyzes the Data Flow of an assembler list. Starts creating the reg + contents for the instructions starting with p. Returns the last tai which has + been processed} +var + curprop, LastFlagsChangeProp: ptaiprop; + Cnt, InstrCnt : Longint; + InstrProp: TInsProp; + UsedRegs: TRegSet; + prev,p : tai; + tmpref: TReference; + tmpsupreg: tsuperregister; +{$ifdef statedebug} + hp : tai; +{$endif} +{$ifdef AnalyzeLoops} + hp : tai; + TmpState: Byte; +{$endif AnalyzeLoops} +begin + p := BlockStart; + LastFlagsChangeProp := nil; + prev := nil; + UsedRegs := []; + UpdateUsedregs(UsedRegs, p); + SkipHead(p); + BlockStart := p; + InstrCnt := 1; + fillchar(NrOfInstrSinceLastMod, SizeOf(NrOfInstrSinceLastMod), 0); + while (p <> Blockend) Do + begin + curprop := @taiPropBlock^[InstrCnt]; + if assigned(prev) + then + begin +{$ifdef JumpAnal} + if (p.Typ <> ait_label) then +{$endif JumpAnal} + begin + curprop^.regs := ptaiprop(prev.OptInfo)^.Regs; + curprop^.DirFlag := ptaiprop(prev.OptInfo)^.DirFlag; + curprop^.FlagsUsed := false; + end + end + else + begin + fillchar(curprop^, SizeOf(curprop^), 0); +{ For tmpreg := RS_EAX to RS_EDI Do + curprop^.regs[tmpreg].WState := 1;} + end; + curprop^.UsedRegs := UsedRegs; + curprop^.CanBeRemoved := False; + UpdateUsedRegs(UsedRegs, tai(p.Next)); + For tmpsupreg := RS_EAX To RS_EDI Do + if NrOfInstrSinceLastMod[tmpsupreg] < 255 then + inc(NrOfInstrSinceLastMod[tmpsupreg]) + else + begin + NrOfInstrSinceLastMod[tmpsupreg] := 0; + curprop^.regs[tmpsupreg].typ := con_unknown; + end; + case p.typ Of + ait_marker:; + ait_label: +{$ifndef JumpAnal} + if not labelCanBeSkipped(tai_label(p)) then + DestroyAllRegs(curprop,false,false); +{$else JumpAnal} + begin + if not labelCanBeSkipped(tai_label(p)) then + With LTable^[tai_Label(p).labsym^.labelnr-LoLab] Do +{$ifDef AnalyzeLoops} + if (RefsFound = tai_Label(p).labsym^.RefCount) +{$else AnalyzeLoops} + if (JmpsProcessed = tai_Label(p).labsym^.RefCount) +{$endif AnalyzeLoops} + then +{all jumps to this label have been found} +{$ifDef AnalyzeLoops} + if (JmpsProcessed > 0) + then +{$endif AnalyzeLoops} + {we've processed at least one jump to this label} + begin + if (GetLastInstruction(p, hp) and + not(((hp.typ = ait_instruction)) and + (taicpu_labeled(hp).is_jmp)) + then + {previous instruction not a JMP -> the contents of the registers after the + previous intruction has been executed have to be taken into account as well} + For tmpsupreg := RS_EAX to RS_EDI Do + begin + if (curprop^.regs[tmpsupreg].WState <> + ptaiprop(hp.OptInfo)^.Regs[tmpsupreg].WState) + then DestroyReg(curprop, tmpsupreg, true) + end + end +{$ifDef AnalyzeLoops} + else + {a label from a backward jump (e.g. a loop), no jump to this label has + already been processed} + if GetLastInstruction(p, hp) and + not(hp.typ = ait_instruction) and + (taicpu_labeled(hp).opcode = A_JMP)) + then + {previous instruction not a jmp, so keep all the registers' contents from the + previous instruction} + begin + curprop^.regs := ptaiprop(hp.OptInfo)^.Regs; + curprop.DirFlag := ptaiprop(hp.OptInfo)^.DirFlag; + end + else + {previous instruction a jmp and no jump to this label processed yet} + begin + hp := p; + Cnt := InstrCnt; + {continue until we find a jump to the label or a label which has already + been processed} + while GetNextInstruction(hp, hp) and + not((hp.typ = ait_instruction) and + (taicpu(hp).is_jmp) and + (tasmlabel(taicpu(hp).oper[0]^.sym).labsymabelnr = tai_Label(p).labsym^.labelnr)) and + not((hp.typ = ait_label) and + (LTable^[tai_Label(hp).labsym^.labelnr-LoLab].RefsFound + = tai_Label(hp).labsym^.RefCount) and + (LTable^[tai_Label(hp).labsym^.labelnr-LoLab].JmpsProcessed > 0)) Do + inc(Cnt); + if (hp.typ = ait_label) + then + {there's a processed label after the current one} + begin + curprop^.regs := taiPropBlock^[Cnt].Regs; + curprop.DirFlag := taiPropBlock^[Cnt].DirFlag; + end + else + {there's no label anymore after the current one, or they haven't been + processed yet} + begin + GetLastInstruction(p, hp); + curprop^.regs := ptaiprop(hp.OptInfo)^.Regs; + curprop.DirFlag := ptaiprop(hp.OptInfo)^.DirFlag; + DestroyAllRegs(ptaiprop(hp.OptInfo),true,true) + end + end +{$endif AnalyzeLoops} + else +{not all references to this label have been found, so destroy all registers} + begin + GetLastInstruction(p, hp); + curprop^.regs := ptaiprop(hp.OptInfo)^.Regs; + curprop.DirFlag := ptaiprop(hp.OptInfo)^.DirFlag; + DestroyAllRegs(curprop,true,true) + end; + end; +{$endif JumpAnal} + + ait_stab, ait_force_line, ait_function_name:; + ait_align: ; { may destroy flags !!! } + ait_instruction: + begin + if taicpu(p).is_jmp or + (taicpu(p).opcode = A_JMP) then + begin +{$ifNDef JumpAnal} + for tmpsupreg := RS_EAX to RS_EDI do + with curprop^.regs[tmpsupreg] do + case typ of + con_ref: typ := con_noRemoveRef; + con_const: typ := con_noRemoveConst; + con_invalid: typ := con_unknown; + end; +{$else JumpAnal} + With LTable^[tasmlabel(taicpu(p).oper[0]^.sym).labsymabelnr-LoLab] Do + if (RefsFound = tasmlabel(taicpu(p).oper[0]^.sym).RefCount) then + begin + if (InstrCnt < InstrNr) + then + {forward jump} + if (JmpsProcessed = 0) then + {no jump to this label has been processed yet} + begin + taiPropBlock^[InstrNr].Regs := curprop^.regs; + taiPropBlock^[InstrNr].DirFlag := curprop.DirFlag; + inc(JmpsProcessed); + end + else + begin + For tmpreg := RS_EAX to RS_EDI Do + if (taiPropBlock^[InstrNr].Regs[tmpreg].WState <> + curprop^.regs[tmpreg].WState) then + DestroyReg(@taiPropBlock^[InstrNr], tmpreg, true); + inc(JmpsProcessed); + end +{$ifdef AnalyzeLoops} + else +{ backward jump, a loop for example} +{ if (JmpsProcessed > 0) or + not(GetLastInstruction(taiObj, hp) and + (hp.typ = ait_labeled_instruction) and + (taicpu_labeled(hp).opcode = A_JMP)) + then} +{instruction prior to label is not a jmp, or at least one jump to the label + has yet been processed} + begin + inc(JmpsProcessed); + For tmpreg := RS_EAX to RS_EDI Do + if (taiPropBlock^[InstrNr].Regs[tmpreg].WState <> + curprop^.regs[tmpreg].WState) + then + begin + TmpState := taiPropBlock^[InstrNr].Regs[tmpreg].WState; + Cnt := InstrNr; + while (TmpState = taiPropBlock^[Cnt].Regs[tmpreg].WState) Do + begin + DestroyReg(@taiPropBlock^[Cnt], tmpreg, true); + inc(Cnt); + end; + while (Cnt <= InstrCnt) Do + begin + inc(taiPropBlock^[Cnt].Regs[tmpreg].WState); + inc(Cnt) + end + end; + end +{ else } +{instruction prior to label is a jmp and no jumps to the label have yet been + processed} +{ begin + inc(JmpsProcessed); + For tmpreg := RS_EAX to RS_EDI Do + begin + TmpState := taiPropBlock^[InstrNr].Regs[tmpreg].WState; + Cnt := InstrNr; + while (TmpState = taiPropBlock^[Cnt].Regs[tmpreg].WState) Do + begin + taiPropBlock^[Cnt].Regs[tmpreg] := curprop^.regs[tmpreg]; + inc(Cnt); + end; + TmpState := taiPropBlock^[InstrNr].Regs[tmpreg].WState; + while (TmpState = taiPropBlock^[Cnt].Regs[tmpreg].WState) Do + begin + DestroyReg(@taiPropBlock^[Cnt], tmpreg, true); + inc(Cnt); + end; + while (Cnt <= InstrCnt) Do + begin + inc(taiPropBlock^[Cnt].Regs[tmpreg].WState); + inc(Cnt) + end + end + end} +{$endif AnalyzeLoops} + end; +{$endif JumpAnal} + end + else + begin + InstrProp := InsProp[taicpu(p).opcode]; + case taicpu(p).opcode Of + A_MOV, A_MOVZX, A_MOVSX: + begin + case taicpu(p).oper[0]^.typ Of + top_ref, top_reg: + case taicpu(p).oper[1]^.typ Of + top_reg: + begin +{$ifdef statedebug} + hp := tai_comment.Create(strpnew('destroying '+std_regname(taicpu(p).oper[1]^.reg))); + insertllitem(list,p,p.next,hp); +{$endif statedebug} + + readOp(curprop, taicpu(p).oper[0]^); + tmpsupreg := getsupreg(taicpu(p).oper[1]^.reg); + if reginop(tmpsupreg, taicpu(p).oper[0]^) and + (curprop^.regs[tmpsupreg].typ in [con_ref,con_noRemoveRef]) then + begin + with curprop^.regs[tmpsupreg] Do + begin + incState(wstate,1); + { also store how many instructions are part of the sequence in the first } + { instruction's ptaiprop, so it can be easily accessed from within } + { CheckSequence } + inc(nrOfMods, nrOfInstrSinceLastMod[tmpsupreg]); + ptaiprop(startmod.optinfo)^.regs[tmpsupreg].nrOfMods := nrOfMods; + nrOfInstrSinceLastMod[tmpsupreg] := 0; + { Destroy the contents of the registers } + { that depended on the previous value of } + { this register } + invalidateDependingRegs(curprop,tmpsupreg); + curprop^.regs[tmpsupreg].memwrite := nil; + end; + end + else + begin +{$ifdef statedebug} + hp := tai_comment.Create(strpnew('destroying & initing '+std_regname(newreg(R_INTREGISTER,tmpsupreg,R_SUBWHOLE)))); + insertllitem(list,p,p.next,hp); +{$endif statedebug} + destroyReg(curprop, tmpsupreg, true); + if not(reginop(tmpsupreg, taicpu(p).oper[0]^)) then + with curprop^.regs[tmpsupreg] Do + begin + typ := con_ref; + startmod := p; + nrOfMods := 1; + end + end; +{$ifdef StateDebug} + hp := tai_comment.Create(strpnew(std_regname(newreg(R_INTREGISTER,tmpsupreg,R_SUBWHOLE))+': '+tostr(curprop^.regs[tmpsupreg].WState))); + insertllitem(list,p,p.next,hp); +{$endif StateDebug} + end; + top_ref: + begin + readref(curprop, taicpu(p).oper[1]^.ref); + if taicpu(p).oper[0]^.typ = top_reg then + begin + readreg(curprop, getsupreg(taicpu(p).oper[0]^.reg)); + DestroyRefs(p, taicpu(p).oper[1]^.ref^, getsupreg(taicpu(p).oper[0]^.reg),topsize2tcgsize[taicpu(p).opsize]); + ptaiprop(p.optinfo)^.regs[getsupreg(taicpu(p).oper[0]^.reg)].memwrite := + taicpu(p); + end + else + DestroyRefs(p, taicpu(p).oper[1]^.ref^, RS_INVALID,topsize2tcgsize[taicpu(p).opsize]); + end; + end; + top_Const: + begin + case taicpu(p).oper[1]^.typ Of + top_reg: + begin + tmpsupreg := getsupreg(taicpu(p).oper[1]^.reg); +{$ifdef statedebug} + hp := tai_comment.Create(strpnew('destroying '+std_regname(newreg(R_INTREGISTER,tmpsupreg,R_SUBWHOLE)))); + insertllitem(list,p,p.next,hp); +{$endif statedebug} + With curprop^.regs[tmpsupreg] Do + begin + DestroyReg(curprop, tmpsupreg, true); + typ := Con_Const; + StartMod := p; + nrOfMods := 1; + end + end; + top_ref: + begin + readref(curprop, taicpu(p).oper[1]^.ref); + DestroyRefs(p, taicpu(p).oper[1]^.ref^, RS_INVALID,topsize2tcgsize[taicpu(p).opsize]); + end; + end; + end; + end; + end; + A_DIV, A_IDIV, A_MUL: + begin + ReadOp(curprop, taicpu(p).oper[0]^); + readreg(curprop,RS_EAX); + if (taicpu(p).OpCode = A_IDIV) or + (taicpu(p).OpCode = A_DIV) then + begin + readreg(curprop,RS_EDX); + end; +{$ifdef statedebug} + hp := tai_comment.Create(strpnew('destroying eax and edx')); + insertllitem(list,p,p.next,hp); +{$endif statedebug} +{ DestroyReg(curprop, RS_EAX, true);} + AddInstr2RegContents({$ifdef statedebug}list,{$endif} + taicpu(p), RS_EAX); + DestroyReg(curprop, RS_EDX, true); + LastFlagsChangeProp := curprop; + end; + A_IMUL: + begin + ReadOp(curprop,taicpu(p).oper[0]^); + if (taicpu(p).ops >= 2) then + ReadOp(curprop,taicpu(p).oper[1]^); + if (taicpu(p).ops <= 2) then + if (taicpu(p).ops=1) then + begin + readreg(curprop,RS_EAX); +{$ifdef statedebug} + hp := tai_comment.Create(strpnew('destroying eax and edx')); + insertllitem(list,p,p.next,hp); +{$endif statedebug} +{ DestroyReg(curprop, RS_EAX, true); } + AddInstr2RegContents({$ifdef statedebug}list,{$endif} + taicpu(p), RS_EAX); + DestroyReg(curprop,RS_EDX, true) + end + else + AddInstr2OpContents( + {$ifdef statedebug}list,{$endif} + taicpu(p), taicpu(p).oper[1]^) + else + AddInstr2OpContents({$ifdef statedebug}list,{$endif} + taicpu(p), taicpu(p).oper[2]^); + LastFlagsChangeProp := curprop; + end; + A_LEA: + begin + readop(curprop,taicpu(p).oper[0]^); + if reginref(getsupreg(taicpu(p).oper[1]^.reg),taicpu(p).oper[0]^.ref^) then + AddInstr2RegContents({$ifdef statedebug}list,{$endif} + taicpu(p), getsupreg(taicpu(p).oper[1]^.reg)) + else + begin +{$ifdef statedebug} + hp := tai_comment.Create(strpnew('destroying & initing'+ + std_regname(taicpu(p).oper[1]^.reg))); + insertllitem(list,p,p.next,hp); +{$endif statedebug} + destroyreg(curprop,getsupreg(taicpu(p).oper[1]^.reg),true); + with curprop^.regs[getsupreg(taicpu(p).oper[1]^.reg)] Do + begin + typ := con_ref; + startmod := p; + nrOfMods := 1; + end + end; + end; + else + begin + Cnt := 1; + while (Cnt <= maxinschanges) and + (InstrProp.Ch[Cnt] <> Ch_None) Do + begin + case InstrProp.Ch[Cnt] Of + Ch_REAX..Ch_REDI: + begin + tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]); + readreg(curprop,tmpsupreg); + end; + Ch_WEAX..Ch_RWEDI: + begin + if (InstrProp.Ch[Cnt] >= Ch_RWEAX) then + begin + tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]); + readreg(curprop,tmpsupreg); + end; +{$ifdef statedebug} + hp := tai_comment.Create(strpnew('destroying '+ + std_regname(tch2reg(InstrProp.Ch[Cnt])))); + insertllitem(list,p,p.next,hp); +{$endif statedebug} + tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]); + DestroyReg(curprop,tmpsupreg, true); + end; + Ch_MEAX..Ch_MEDI: + begin + tmpsupreg:=tch2reg(InstrProp.Ch[Cnt]); + AddInstr2RegContents({$ifdef statedebug} list,{$endif} + taicpu(p),tmpsupreg); + end; + Ch_CDirFlag: curprop^.DirFlag := F_notSet; + Ch_SDirFlag: curprop^.DirFlag := F_Set; + Ch_Rop1: ReadOp(curprop, taicpu(p).oper[0]^); + Ch_Rop2: ReadOp(curprop, taicpu(p).oper[1]^); + Ch_ROp3: ReadOp(curprop, taicpu(p).oper[2]^); + Ch_Wop1..Ch_RWop1: + begin + if (InstrProp.Ch[Cnt] in [Ch_RWop1]) then + ReadOp(curprop, taicpu(p).oper[0]^); + DestroyOp(p, taicpu(p).oper[0]^); + end; + Ch_Mop1: + AddInstr2OpContents({$ifdef statedebug} list, {$endif} + taicpu(p), taicpu(p).oper[0]^); + Ch_Wop2..Ch_RWop2: + begin + if (InstrProp.Ch[Cnt] = Ch_RWop2) then + ReadOp(curprop, taicpu(p).oper[1]^); + DestroyOp(p, taicpu(p).oper[1]^); + end; + Ch_Mop2: + AddInstr2OpContents({$ifdef statedebug} list, {$endif} + taicpu(p), taicpu(p).oper[1]^); + Ch_WOp3..Ch_RWOp3: + begin + if (InstrProp.Ch[Cnt] = Ch_RWOp3) then + ReadOp(curprop, taicpu(p).oper[2]^); + DestroyOp(p, taicpu(p).oper[2]^); + end; + Ch_Mop3: + AddInstr2OpContents({$ifdef statedebug} list, {$endif} + taicpu(p), taicpu(p).oper[2]^); + Ch_WMemEDI: + begin + readreg(curprop, RS_EDI); + fillchar(tmpref, SizeOf(tmpref), 0); + tmpref.base := NR_EDI; + tmpref.index := NR_EDI; + DestroyRefs(p, tmpref,RS_INVALID,OS_32) + end; + Ch_RFlags: + if assigned(LastFlagsChangeProp) then + LastFlagsChangeProp^.FlagsUsed := true; + Ch_WFlags: + LastFlagsChangeProp := curprop; + Ch_RWFlags: + begin + if assigned(LastFlagsChangeProp) then + LastFlagsChangeProp^.FlagsUsed := true; + LastFlagsChangeProp := curprop; + end; + Ch_FPU:; + else + begin +{$ifdef statedebug} + hp := tai_comment.Create(strpnew( + 'destroying all regs for prev instruction')); + insertllitem(list,p, p.next,hp); +{$endif statedebug} + DestroyAllRegs(curprop,true,true); + LastFlagsChangeProp := curprop; + end; + end; + inc(Cnt); + end + end; + end; + end; + end + else + begin +{$ifdef statedebug} + hp := tai_comment.Create(strpnew( + 'destroying all regs: unknown tai: '+tostr(ord(p.typ)))); + insertllitem(list,p, p.next,hp); +{$endif statedebug} + DestroyAllRegs(curprop,true,true); + end; + end; + inc(InstrCnt); + prev := p; + GetNextInstruction(p, p); + end; +end; + + +function tdfaobj.pass_generate_code: boolean; +begin + if initdfapass2 then + begin + dodfapass2; + pass_generate_code := true + end + else + pass_generate_code := false; +end; + +{$push} +{$r-} +function tdfaobj.getlabelwithsym(sym: tasmlabel): tai; +begin + if (sym.labelnr >= lolab) and + (sym.labelnr <= hilab) then { range check, a jump can go past an assembler block! } + getlabelwithsym := labeltable^[sym.labelnr-lolab].taiobj + else + getlabelwithsym := nil; +end; +{$pop} + + +procedure tdfaobj.clear; +begin + if labdif <> 0 then + begin + freemem(labeltable); + labeltable := nil; + end; + if assigned(taipropblock) then + begin + freemem(taipropblock, nroftaiobjs*sizeof(ttaiprop)); + taipropblock := nil; + end; +end; + + +end. diff --git a/closures/compiler/i386/i386att.inc b/closures/compiler/i386/i386att.inc new file mode 100644 index 0000000000..a591dad220 --- /dev/null +++ b/closures/compiler/i386/i386att.inc @@ -0,0 +1,688 @@ +{ don't edit, this file is generated from x86ins.dat } +( +'none', +'aaa', +'aad', +'aam', +'aas', +'adc', +'add', +'and', +'arpl', +'bound', +'bsf', +'bsr', +'bswap', +'bt', +'btc', +'btr', +'bts', +'call', +'cbtw', +'cltd', +'clc', +'cld', +'cli', +'clts', +'cmc', +'cmp', +'cmpsb', +'cmpsl', +'cmpsw', +'cmpxchg', +'cmpxchg486', +'cmpxchg8b', +'cpuid', +'cwd', +'cwtl', +'daa', +'das', +'dec', +'div', +'emms', +'enter', +'f2xm1', +'fabs', +'fadd', +'faddp', +'fbld', +'fbstp', +'fchs', +'fclex', +'fcmovb', +'fcmovbe', +'fcmove', +'fcmovnb', +'fcmovnbe', +'fcmovne', +'fcmovnu', +'fcmovu', +'fcom', +'fcomi', +'fcomip', +'fcomp', +'fcompp', +'fcos', +'fdecstp', +'fdisi', +'fdiv', +'fdivp', +'fdivr', +'fdivrp', +'femms', +'feni', +'ffree', +'fiadd', +'ficom', +'ficomp', +'fidiv', +'fidivr', +'fild', +'fimul', +'fincstp', +'finit', +'fist', +'fistp', +'fisttp', +'fisub', +'fisubr', +'fld', +'fld1', +'fldcw', +'fldenv', +'fldl2e', +'fldl2t', +'fldlg2', +'fldln2', +'fldpi', +'fldz', +'fmul', +'fmulp', +'fnclex', +'fndisi', +'fneni', +'fninit', +'fnop', +'fnsave', +'fnstcw', +'fnstenv', +'fnstsw', +'fpatan', +'fprem', +'fprem1', +'fptan', +'frndint', +'frstor', +'fsave', +'fscale', +'fsetpm', +'fsin', +'fsincos', +'fsqrt', +'fst', +'fstcw', +'fstenv', +'fstp', +'fstsw', +'fsub', +'fsubp', +'fsubr', +'fsubrp', +'ftst', +'fucom', +'fucomi', +'fucomip', +'fucomp', +'fucompp', +'fwait', +'fxam', +'fxch', +'fxtract', +'fyl2x', +'fyl2xp1', +'hlt', +'ibts', +'icebp', +'idiv', +'imul', +'in', +'inc', +'insb', +'insl', +'insw', +'int', +'int01', +'int1', +'int03', +'int3', +'into', +'invd', +'invlpg', +'iret', +'iret', +'iretw', +'iretq', +'jcxz', +'jecxz', +'jrcxz', +'jmp', +'lahf', +'lar', +'lcall', +'lds', +'lea', +'leave', +'les', +'lfs', +'lgdt', +'lgs', +'lidt', +'ljmp', +'lldt', +'lmsw', +'loadall', +'loadall286', +'lock', +'lodsb', +'lodsl', +'lodsw', +'loop', +'loope', +'loopne', +'loopnz', +'loopz', +'lsl', +'lss', +'ltr', +'monitor', +'mov', +'movd', +'movq', +'movsb', +'movsl', +'movsq', +'movsw', +'movs', +'movz', +'mul', +'mwait', +'neg', +'nop', +'not', +'or', +'out', +'outsb', +'outsl', +'outsw', +'packssdw', +'packsswb', +'packuswb', +'paddb', +'paddd', +'paddsb', +'paddsiw', +'paddsw', +'paddusb', +'paddusw', +'paddw', +'pand', +'pandn', +'paveb', +'pavgusb', +'pcmpeqb', +'pcmpeqd', +'pcmpeqw', +'pcmpgtb', +'pcmpgtd', +'pcmpgtw', +'pdistib', +'pf2id', +'pfacc', +'pfadd', +'pfcmpeq', +'pfcmpge', +'pfcmpgt', +'pfmax', +'pfmin', +'pfmul', +'pfrcp', +'pfrcpit1', +'pfrcpit2', +'pfrsqit1', +'pfrsqrt', +'pfsub', +'pfsubr', +'pi2fd', +'pmachriw', +'pmaddwd', +'pmagw', +'pmulhriw', +'pmulhrwa', +'pmulhrwc', +'pmulhw', +'pmullw', +'pmvgezb', +'pmvlzb', +'pmvnzb', +'pmvzb', +'pop', +'popa', +'popal', +'popaw', +'popf', +'popfl', +'popfw', +'popfq', +'por', +'prefetch', +'prefetchw', +'pslld', +'pslldq', +'psllq', +'psllw', +'psrad', +'psraw', +'psrld', +'psrlq', +'psrlw', +'psubb', +'psubd', +'psubsb', +'psubsiw', +'psubsw', +'psubusb', +'psubusw', +'psubw', +'punpckhbw', +'punpckhdq', +'punpckhwd', +'punpcklbw', +'punpckldq', +'punpcklwd', +'push', +'pusha', +'pushal', +'pushaw', +'pushf', +'pushfl', +'pushfw', +'pushfq', +'pxor', +'rcl', +'rcr', +'rdshr', +'rdmsr', +'rdpmc', +'rdtsc', +'rep', +'repe', +'repne', +'repnz', +'repz', +'ret', +'lret', +'ret', +'rol', +'ror', +'rsdc', +'rsldt', +'rsm', +'sahf', +'sal', +'salc', +'sar', +'sbb', +'scasb', +'scasl', +'scasq', +'scasw', +'cs', +'ds', +'es', +'fs', +'gs', +'ss', +'sgdt', +'shl', +'shld', +'shr', +'shrd', +'sidt', +'sldt', +'smi', +'smint', +'smintold', +'smsw', +'stc', +'std', +'sti', +'stosb', +'stosl', +'stosw', +'str', +'sub', +'svdc', +'svldt', +'svts', +'syscall', +'sysenter', +'sysexit', +'sysret', +'test', +'ud1', +'ud2', +'umov', +'verr', +'verw', +'wait', +'wbinvd', +'wrshr', +'wrmsr', +'xadd', +'xbts', +'xchg', +'xlat', +'xlatb', +'xor', +'xstore', +'xcryptecb', +'xcryptcbc', +'xcryptcfb', +'xcryptofb', +'cmov', +'j', +'set', +'addps', +'addss', +'andnps', +'andps', +'cmpeqps', +'cmpeqss', +'cmpleps', +'cmpless', +'cmpltps', +'cmpltss', +'cmpneqps', +'cmpneqss', +'cmpnleps', +'cmpnless', +'cmpnltps', +'cmpnltss', +'cmpordps', +'cmpordss', +'cmpunordps', +'cmpunordss', +'cmpps', +'cmpss', +'comiss', +'cvtpi2ps', +'cvtps2pi', +'cvtsi2ss', +'cvtss2si', +'cvttps2pi', +'cvttss2si', +'divps', +'divss', +'ldmxcsr', +'maxps', +'maxss', +'minps', +'minss', +'movaps', +'movhps', +'movlhps', +'movlps', +'movhlps', +'movmskps', +'movntps', +'movss', +'movups', +'mulps', +'mulss', +'orps', +'rcpps', +'rcpss', +'rsqrtps', +'rsqrtss', +'shufps', +'sqrtps', +'sqrtss', +'stmxcsr', +'subps', +'subss', +'ucomiss', +'unpckhps', +'unpcklps', +'xorps', +'fxrstor', +'fxsave', +'prefetchnta', +'prefetcht0', +'prefetcht1', +'prefetcht2', +'sfence', +'maskmovq', +'movntq', +'pavgb', +'pavgw', +'pextrw', +'pinsrw', +'pmaxsw', +'pmaxub', +'pminsw', +'pminub', +'pmovmskb', +'pmulhuw', +'psadbw', +'pshufw', +'pfnacc', +'pfpnacc', +'pi2fw', +'pf2iw', +'pswapd', +'ffreep', +'maskmovdqu', +'clflush', +'movntdq', +'movnti', +'movntpd', +'pause', +'lfence', +'mfence', +'movdqa', +'movdqu', +'movdq2q', +'movq2dq', +'paddq', +'pmuludq', +'pshufd', +'pshufhw', +'pshuflw', +'psrldq', +'psubq', +'punpckhqdq', +'punpcklqdq', +'addpd', +'addsd', +'andnpd', +'andpd', +'cmpeqpd', +'cmpeqsd', +'cmplepd', +'cmplesd', +'cmpltpd', +'cmpltsd', +'cmpneqpd', +'cmpneqsd', +'cmpnlepd', +'cmpnlesd', +'cmpnltpd', +'cmpnltsd', +'cmpordpd', +'cmpordsd', +'cmpunordpd', +'cmpunordsd', +'cmppd', +'comisd', +'cvtdq2pd', +'cvtdq2ps', +'cvtpd2dq', +'cvtpd2pi', +'cvtpd2ps', +'cvtpi2pd', +'cvtps2dq', +'cvtps2pd', +'cvtsd2si', +'cvtsd2ss', +'cvtsi2sd', +'cvtss2sd', +'cvttpd2pi', +'cvttpd2dq', +'cvttps2dq', +'cvttsd2si', +'divpd', +'divsd', +'maxpd', +'maxsd', +'minpd', +'minsd', +'movapd', +'movhpd', +'movlpd', +'movmskpd', +'movupd', +'mulpd', +'mulsd', +'orpd', +'shufpd', +'sqrtpd', +'sqrtsd', +'subpd', +'subsd', +'ucomisd', +'unpckhpd', +'unpcklpd', +'xorpd', +'addsubpd', +'addsubps', +'haddpd', +'haddps', +'hsubpd', +'hsubps', +'lddqu', +'movddup', +'movshdup', +'movsldup', +'vmread', +'vmwrite', +'vmcall', +'vmlaunch', +'vmresume', +'vmxoff', +'vmxon', +'vmclear', +'vmptrld', +'vmptrst', +'vmrun', +'vmmcall', +'vmload', +'vmsave', +'stgi', +'clgi', +'skinit', +'invlpga', +'montmul', +'xsha1', +'xsha256', +'dmint', +'rdm', +'movabs', +'movslq', +'cqto', +'cmpxchg16b', +'movntss', +'movntsd', +'insertq', +'extrq', +'lzcnt', +'pabsb', +'pabsw', +'pabsd', +'palignr', +'phaddw', +'phaddd', +'phaddsw', +'phsubw', +'phsubd', +'phsubsw', +'pmaddubsw', +'pmulhrsw', +'pshufb', +'psignb', +'psignw', +'psignd', +'blendps', +'blendpd', +'blendvps', +'blendvpd', +'dpps', +'dppd', +'extractps', +'insertps', +'movntdqa', +'mpsadbw', +'packusdw', +'pblendvb', +'pblendw', +'pcmpeqq', +'pextrb', +'pextrd', +'pextrq', +'phminposuw', +'pinsrb', +'pinsrd', +'pinsrq', +'pmaxsb', +'pmaxsd', +'pmaxud', +'pmaxuw', +'pminsb', +'pminsd', +'pminuw', +'pminud', +'pmovsxbw', +'pmovsxbd', +'pmovsxbq', +'pmovsxwd', +'pmovsxwq', +'pmovsxdq', +'pmovzxbw', +'pmovzxbd', +'pmovzxbq', +'pmovzxwd', +'pmovzxwq', +'pmovzxdq', +'pmuldq', +'pmulld', +'ptest', +'roundps', +'roundpd', +'roundss', +'roundsd', +'crc32', +'pcmpestri', +'pcmpestrm', +'pcmpistri', +'pcmpistrm', +'pcmpgtq', +'popcnt', +'aesenc', +'aesenclast', +'aesdec', +'aesdeclast', +'aesimc', +'aeskeygenassist', +'stosq', +'lodsq', +'cmpsq' +); diff --git a/closures/compiler/i386/i386atts.inc b/closures/compiler/i386/i386atts.inc new file mode 100644 index 0000000000..31bc9cd421 --- /dev/null +++ b/closures/compiler/i386/i386atts.inc @@ -0,0 +1,688 @@ +{ don't edit, this file is generated from x86ins.dat } +( +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufNONE, +attsufNONE, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufNONE, +attsufNONE, +attsufNONE, +attsufFPUint, +attsufFPUint, +attsufFPUint, +attsufFPUint, +attsufFPUint, +attsufFPUint, +attsufFPUint, +attsufNONE, +attsufNONE, +attsufFPUint, +attsufFPUint, +attsufFPUint, +attsufFPUint, +attsufFPUint, +attsufFPU, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufFPU, +attsufFPU, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufFPU, +attsufINT, +attsufNONE, +attsufFPU, +attsufINT, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufNONE, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufNONE, +attsufNONE, +attsufNONE, +attsufFPU, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufINT, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufINT, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINTdual, +attsufINTdual, +attsufINT, +attsufNONE, +attsufINT, +attsufNONE, +attsufINT, +attsufINT, +attsufINT, +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, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufINT, +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, +attsufINT, +attsufINT, +attsufNONE, +attsufINT, +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, +attsufINT, +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, +attsufINT, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +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, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +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, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE +); diff --git a/closures/compiler/i386/i386int.inc b/closures/compiler/i386/i386int.inc new file mode 100644 index 0000000000..b6cc4caa78 --- /dev/null +++ b/closures/compiler/i386/i386int.inc @@ -0,0 +1,688 @@ +{ don't edit, this file is generated from x86ins.dat } +( +'none', +'aaa', +'aad', +'aam', +'aas', +'adc', +'add', +'and', +'arpl', +'bound', +'bsf', +'bsr', +'bswap', +'bt', +'btc', +'btr', +'bts', +'call', +'cbw', +'cdq', +'clc', +'cld', +'cli', +'clts', +'cmc', +'cmp', +'cmpsb', +'cmpsd', +'cmpsw', +'cmpxchg', +'cmpxchg486', +'cmpxchg8b', +'cpuid', +'cwd', +'cwde', +'daa', +'das', +'dec', +'div', +'emms', +'enter', +'f2xm1', +'fabs', +'fadd', +'faddp', +'fbld', +'fbstp', +'fchs', +'fclex', +'fcmovb', +'fcmovbe', +'fcmove', +'fcmovnb', +'fcmovnbe', +'fcmovne', +'fcmovnu', +'fcmovu', +'fcom', +'fcomi', +'fcomip', +'fcomp', +'fcompp', +'fcos', +'fdecstp', +'fdisi', +'fdiv', +'fdivp', +'fdivr', +'fdivrp', +'femms', +'feni', +'ffree', +'fiadd', +'ficom', +'ficomp', +'fidiv', +'fidivr', +'fild', +'fimul', +'fincstp', +'finit', +'fist', +'fistp', +'fisttp', +'fisub', +'fisubr', +'fld', +'fld1', +'fldcw', +'fldenv', +'fldl2e', +'fldl2t', +'fldlg2', +'fldln2', +'fldpi', +'fldz', +'fmul', +'fmulp', +'fnclex', +'fndisi', +'fneni', +'fninit', +'fnop', +'fnsave', +'fnstcw', +'fnstenv', +'fnstsw', +'fpatan', +'fprem', +'fprem1', +'fptan', +'frndint', +'frstor', +'fsave', +'fscale', +'fsetpm', +'fsin', +'fsincos', +'fsqrt', +'fst', +'fstcw', +'fstenv', +'fstp', +'fstsw', +'fsub', +'fsubp', +'fsubr', +'fsubrp', +'ftst', +'fucom', +'fucomi', +'fucomip', +'fucomp', +'fucompp', +'fwait', +'fxam', +'fxch', +'fxtract', +'fyl2x', +'fyl2xp1', +'hlt', +'ibts', +'icebp', +'idiv', +'imul', +'in', +'inc', +'insb', +'insd', +'insw', +'int', +'int01', +'int1', +'int03', +'int3', +'into', +'invd', +'invlpg', +'iret', +'iretd', +'iretw', +'iretq', +'jcxz', +'jecxz', +'jrcxz', +'jmp', +'lahf', +'lar', +'lcall', +'lds', +'lea', +'leave', +'les', +'lfs', +'lgdt', +'lgs', +'lidt', +'ljmp', +'lldt', +'lmsw', +'loadall', +'loadall286', +'lock', +'lodsb', +'lodsd', +'lodsw', +'loop', +'loope', +'loopne', +'loopnz', +'loopz', +'lsl', +'lss', +'ltr', +'monitor', +'mov', +'movd', +'movq', +'movsb', +'movsd', +'movsq', +'movsw', +'movsx', +'movzx', +'mul', +'mwait', +'neg', +'nop', +'not', +'or', +'out', +'outsb', +'outsd', +'outsw', +'packssdw', +'packsswb', +'packuswb', +'paddb', +'paddd', +'paddsb', +'paddsiw', +'paddsw', +'paddusb', +'paddusw', +'paddw', +'pand', +'pandn', +'paveb', +'pavgusb', +'pcmpeqb', +'pcmpeqd', +'pcmpeqw', +'pcmpgtb', +'pcmpgtd', +'pcmpgtw', +'pdistib', +'pf2id', +'pfacc', +'pfadd', +'pfcmpeq', +'pfcmpge', +'pfcmpgt', +'pfmax', +'pfmin', +'pfmul', +'pfrcp', +'pfrcpit1', +'pfrcpit2', +'pfrsqit1', +'pfrsqrt', +'pfsub', +'pfsubr', +'pi2fd', +'pmachriw', +'pmaddwd', +'pmagw', +'pmulhriw', +'pmulhrwa', +'pmulhrwc', +'pmulhw', +'pmullw', +'pmvgezb', +'pmvlzb', +'pmvnzb', +'pmvzb', +'pop', +'popa', +'popad', +'popaw', +'popf', +'popfd', +'popfw', +'popfq', +'por', +'prefetch', +'prefetchw', +'pslld', +'pslldq', +'psllq', +'psllw', +'psrad', +'psraw', +'psrld', +'psrlq', +'psrlw', +'psubb', +'psubd', +'psubsb', +'psubsiw', +'psubsw', +'psubusb', +'psubusw', +'psubw', +'punpckhbw', +'punpckhdq', +'punpckhwd', +'punpcklbw', +'punpckldq', +'punpcklwd', +'push', +'pusha', +'pushad', +'pushaw', +'pushf', +'pushfd', +'pushfw', +'pushfq', +'pxor', +'rcl', +'rcr', +'rdshr', +'rdmsr', +'rdpmc', +'rdtsc', +'rep', +'repe', +'repne', +'repnz', +'repz', +'ret', +'retf', +'retn', +'rol', +'ror', +'rsdc', +'rsldt', +'rsm', +'sahf', +'sal', +'salc', +'sar', +'sbb', +'scasb', +'scasd', +'scasq', +'scasw', +'segcs', +'segds', +'seges', +'segfs', +'seggs', +'segss', +'sgdt', +'shl', +'shld', +'shr', +'shrd', +'sidt', +'sldt', +'smi', +'smint', +'smintold', +'smsw', +'stc', +'std', +'sti', +'stosb', +'stosd', +'stosw', +'str', +'sub', +'svdc', +'svldt', +'svts', +'syscall', +'sysenter', +'sysexit', +'sysret', +'test', +'ud1', +'ud2', +'umov', +'verr', +'verw', +'wait', +'wbinvd', +'wrshr', +'wrmsr', +'xadd', +'xbts', +'xchg', +'xlat', +'xlatb', +'xor', +'xstore', +'xcryptecb', +'xcryptcbc', +'xcryptcfb', +'xcryptofb', +'cmov', +'j', +'set', +'addps', +'addss', +'andnps', +'andps', +'cmpeqps', +'cmpeqss', +'cmpleps', +'cmpless', +'cmpltps', +'cmpltss', +'cmpneqps', +'cmpneqss', +'cmpnleps', +'cmpnless', +'cmpnltps', +'cmpnltss', +'cmpordps', +'cmpordss', +'cmpunordps', +'cmpunordss', +'cmpps', +'cmpss', +'comiss', +'cvtpi2ps', +'cvtps2pi', +'cvtsi2ss', +'cvtss2si', +'cvttps2pi', +'cvttss2si', +'divps', +'divss', +'ldmxcsr', +'maxps', +'maxss', +'minps', +'minss', +'movaps', +'movhps', +'movlhps', +'movlps', +'movhlps', +'movmskps', +'movntps', +'movss', +'movups', +'mulps', +'mulss', +'orps', +'rcpps', +'rcpss', +'rsqrtps', +'rsqrtss', +'shufps', +'sqrtps', +'sqrtss', +'stmxcsr', +'subps', +'subss', +'ucomiss', +'unpckhps', +'unpcklps', +'xorps', +'fxrstor', +'fxsave', +'prefetchnta', +'prefetcht0', +'prefetcht1', +'prefetcht2', +'sfence', +'maskmovq', +'movntq', +'pavgb', +'pavgw', +'pextrw', +'pinsrw', +'pmaxsw', +'pmaxub', +'pminsw', +'pminub', +'pmovmskb', +'pmulhuw', +'psadbw', +'pshufw', +'pfnacc', +'pfpnacc', +'pi2fw', +'pf2iw', +'pswapd', +'ffreep', +'maskmovdqu', +'clflush', +'movntdq', +'movnti', +'movntpd', +'pause', +'lfence', +'mfence', +'movdqa', +'movdqu', +'movdq2q', +'movq2dq', +'paddq', +'pmuludq', +'pshufd', +'pshufhw', +'pshuflw', +'psrldq', +'psubq', +'punpckhqdq', +'punpcklqdq', +'addpd', +'addsd', +'andnpd', +'andpd', +'cmpeqpd', +'cmpeqsd', +'cmplepd', +'cmplesd', +'cmpltpd', +'cmpltsd', +'cmpneqpd', +'cmpneqsd', +'cmpnlepd', +'cmpnlesd', +'cmpnltpd', +'cmpnltsd', +'cmpordpd', +'cmpordsd', +'cmpunordpd', +'cmpunordsd', +'cmppd', +'comisd', +'cvtdq2pd', +'cvtdq2ps', +'cvtpd2dq', +'cvtpd2pi', +'cvtpd2ps', +'cvtpi2pd', +'cvtps2dq', +'cvtps2pd', +'cvtsd2si', +'cvtsd2ss', +'cvtsi2sd', +'cvtss2sd', +'cvttpd2pi', +'cvttpd2dq', +'cvttps2dq', +'cvttsd2si', +'divpd', +'divsd', +'maxpd', +'maxsd', +'minpd', +'minsd', +'movapd', +'movhpd', +'movlpd', +'movmskpd', +'movupd', +'mulpd', +'mulsd', +'orpd', +'shufpd', +'sqrtpd', +'sqrtsd', +'subpd', +'subsd', +'ucomisd', +'unpckhpd', +'unpcklpd', +'xorpd', +'addsubpd', +'addsubps', +'haddpd', +'haddps', +'hsubpd', +'hsubps', +'lddqu', +'movddup', +'movshdup', +'movsldup', +'vmread', +'vmwrite', +'vmcall', +'vmlaunch', +'vmresume', +'vmxoff', +'vmxon', +'vmclear', +'vmptrld', +'vmptrst', +'vmrun', +'vmmcall', +'vmload', +'vmsave', +'stgi', +'clgi', +'skinit', +'invlpga', +'montmul', +'xsha1', +'xsha256', +'dmint', +'rdm', +'movabs', +'movsxd', +'cqo', +'cmpxchg16b', +'movntss', +'movntsd', +'insertq', +'extrq', +'lzcnt', +'pabsb', +'pabsw', +'pabsd', +'palignr', +'phaddw', +'phaddd', +'phaddsw', +'phsubw', +'phsubd', +'phsubsw', +'pmaddubsw', +'pmulhrsw', +'pshufb', +'psignb', +'psignw', +'psignd', +'blendps', +'blendpd', +'blendvps', +'blendvpd', +'dpps', +'dppd', +'extractps', +'insertps', +'movntdqa', +'mpsadbw', +'packusdw', +'pblendvb', +'pblendw', +'pcmpeqq', +'pextrb', +'pextrd', +'pextrq', +'phminposuw', +'pinsrb', +'pinsrd', +'pinsrq', +'pmaxsb', +'pmaxsd', +'pmaxud', +'pmaxuw', +'pminsb', +'pminsd', +'pminuw', +'pminud', +'pmovsxbw', +'pmovsxbd', +'pmovsxbq', +'pmovsxwd', +'pmovsxwq', +'pmovsxdq', +'pmovzxbw', +'pmovzxbd', +'pmovzxbq', +'pmovzxwd', +'pmovzxwq', +'pmovzxdq', +'pmuldq', +'pmulld', +'ptest', +'roundps', +'roundpd', +'roundss', +'roundsd', +'crc32', +'pcmpestri', +'pcmpestrm', +'pcmpistri', +'pcmpistrm', +'pcmpgtq', +'popcnt', +'aesenc', +'aesenclast', +'aesdec', +'aesdeclast', +'aesimc', +'aeskeygenassist', +'stosq', +'lodsq', +'cmpsq' +); diff --git a/closures/compiler/i386/i386nop.inc b/closures/compiler/i386/i386nop.inc new file mode 100644 index 0000000000..69f2343600 --- /dev/null +++ b/closures/compiler/i386/i386nop.inc @@ -0,0 +1,2 @@ +{ don't edit, this file is generated from x86ins.dat } +1205; diff --git a/closures/compiler/i386/i386op.inc b/closures/compiler/i386/i386op.inc new file mode 100644 index 0000000000..4070734e54 --- /dev/null +++ b/closures/compiler/i386/i386op.inc @@ -0,0 +1,688 @@ +{ don't edit, this file is generated from x86ins.dat } +( +A_NONE, +A_AAA, +A_AAD, +A_AAM, +A_AAS, +A_ADC, +A_ADD, +A_AND, +A_ARPL, +A_BOUND, +A_BSF, +A_BSR, +A_BSWAP, +A_BT, +A_BTC, +A_BTR, +A_BTS, +A_CALL, +A_CBW, +A_CDQ, +A_CLC, +A_CLD, +A_CLI, +A_CLTS, +A_CMC, +A_CMP, +A_CMPSB, +A_CMPSD, +A_CMPSW, +A_CMPXCHG, +A_CMPXCHG486, +A_CMPXCHG8B, +A_CPUID, +A_CWD, +A_CWDE, +A_DAA, +A_DAS, +A_DEC, +A_DIV, +A_EMMS, +A_ENTER, +A_F2XM1, +A_FABS, +A_FADD, +A_FADDP, +A_FBLD, +A_FBSTP, +A_FCHS, +A_FCLEX, +A_FCMOVB, +A_FCMOVBE, +A_FCMOVE, +A_FCMOVNB, +A_FCMOVNBE, +A_FCMOVNE, +A_FCMOVNU, +A_FCMOVU, +A_FCOM, +A_FCOMI, +A_FCOMIP, +A_FCOMP, +A_FCOMPP, +A_FCOS, +A_FDECSTP, +A_FDISI, +A_FDIV, +A_FDIVP, +A_FDIVR, +A_FDIVRP, +A_FEMMS, +A_FENI, +A_FFREE, +A_FIADD, +A_FICOM, +A_FICOMP, +A_FIDIV, +A_FIDIVR, +A_FILD, +A_FIMUL, +A_FINCSTP, +A_FINIT, +A_FIST, +A_FISTP, +A_FISTTP, +A_FISUB, +A_FISUBR, +A_FLD, +A_FLD1, +A_FLDCW, +A_FLDENV, +A_FLDL2E, +A_FLDL2T, +A_FLDLG2, +A_FLDLN2, +A_FLDPI, +A_FLDZ, +A_FMUL, +A_FMULP, +A_FNCLEX, +A_FNDISI, +A_FNENI, +A_FNINIT, +A_FNOP, +A_FNSAVE, +A_FNSTCW, +A_FNSTENV, +A_FNSTSW, +A_FPATAN, +A_FPREM, +A_FPREM1, +A_FPTAN, +A_FRNDINT, +A_FRSTOR, +A_FSAVE, +A_FSCALE, +A_FSETPM, +A_FSIN, +A_FSINCOS, +A_FSQRT, +A_FST, +A_FSTCW, +A_FSTENV, +A_FSTP, +A_FSTSW, +A_FSUB, +A_FSUBP, +A_FSUBR, +A_FSUBRP, +A_FTST, +A_FUCOM, +A_FUCOMI, +A_FUCOMIP, +A_FUCOMP, +A_FUCOMPP, +A_FWAIT, +A_FXAM, +A_FXCH, +A_FXTRACT, +A_FYL2X, +A_FYL2XP1, +A_HLT, +A_IBTS, +A_ICEBP, +A_IDIV, +A_IMUL, +A_IN, +A_INC, +A_INSB, +A_INSD, +A_INSW, +A_INT, +A_INT01, +A_INT1, +A_INT03, +A_INT3, +A_INTO, +A_INVD, +A_INVLPG, +A_IRET, +A_IRETD, +A_IRETW, +A_IRETQ, +A_JCXZ, +A_JECXZ, +A_JRCXZ, +A_JMP, +A_LAHF, +A_LAR, +A_LCALL, +A_LDS, +A_LEA, +A_LEAVE, +A_LES, +A_LFS, +A_LGDT, +A_LGS, +A_LIDT, +A_LJMP, +A_LLDT, +A_LMSW, +A_LOADALL, +A_LOADALL286, +A_LOCK, +A_LODSB, +A_LODSD, +A_LODSW, +A_LOOP, +A_LOOPE, +A_LOOPNE, +A_LOOPNZ, +A_LOOPZ, +A_LSL, +A_LSS, +A_LTR, +A_MONITOR, +A_MOV, +A_MOVD, +A_MOVQ, +A_MOVSB, +A_MOVSD, +A_MOVSQ, +A_MOVSW, +A_MOVSX, +A_MOVZX, +A_MUL, +A_MWAIT, +A_NEG, +A_NOP, +A_NOT, +A_OR, +A_OUT, +A_OUTSB, +A_OUTSD, +A_OUTSW, +A_PACKSSDW, +A_PACKSSWB, +A_PACKUSWB, +A_PADDB, +A_PADDD, +A_PADDSB, +A_PADDSIW, +A_PADDSW, +A_PADDUSB, +A_PADDUSW, +A_PADDW, +A_PAND, +A_PANDN, +A_PAVEB, +A_PAVGUSB, +A_PCMPEQB, +A_PCMPEQD, +A_PCMPEQW, +A_PCMPGTB, +A_PCMPGTD, +A_PCMPGTW, +A_PDISTIB, +A_PF2ID, +A_PFACC, +A_PFADD, +A_PFCMPEQ, +A_PFCMPGE, +A_PFCMPGT, +A_PFMAX, +A_PFMIN, +A_PFMUL, +A_PFRCP, +A_PFRCPIT1, +A_PFRCPIT2, +A_PFRSQIT1, +A_PFRSQRT, +A_PFSUB, +A_PFSUBR, +A_PI2FD, +A_PMACHRIW, +A_PMADDWD, +A_PMAGW, +A_PMULHRIW, +A_PMULHRWA, +A_PMULHRWC, +A_PMULHW, +A_PMULLW, +A_PMVGEZB, +A_PMVLZB, +A_PMVNZB, +A_PMVZB, +A_POP, +A_POPA, +A_POPAD, +A_POPAW, +A_POPF, +A_POPFD, +A_POPFW, +A_POPFQ, +A_POR, +A_PREFETCH, +A_PREFETCHW, +A_PSLLD, +A_PSLLDQ, +A_PSLLQ, +A_PSLLW, +A_PSRAD, +A_PSRAW, +A_PSRLD, +A_PSRLQ, +A_PSRLW, +A_PSUBB, +A_PSUBD, +A_PSUBSB, +A_PSUBSIW, +A_PSUBSW, +A_PSUBUSB, +A_PSUBUSW, +A_PSUBW, +A_PUNPCKHBW, +A_PUNPCKHDQ, +A_PUNPCKHWD, +A_PUNPCKLBW, +A_PUNPCKLDQ, +A_PUNPCKLWD, +A_PUSH, +A_PUSHA, +A_PUSHAD, +A_PUSHAW, +A_PUSHF, +A_PUSHFD, +A_PUSHFW, +A_PUSHFQ, +A_PXOR, +A_RCL, +A_RCR, +A_RDSHR, +A_RDMSR, +A_RDPMC, +A_RDTSC, +A_REP, +A_REPE, +A_REPNE, +A_REPNZ, +A_REPZ, +A_RET, +A_RETF, +A_RETN, +A_ROL, +A_ROR, +A_RSDC, +A_RSLDT, +A_RSM, +A_SAHF, +A_SAL, +A_SALC, +A_SAR, +A_SBB, +A_SCASB, +A_SCASD, +A_SCASQ, +A_SCASW, +A_SEGCS, +A_SEGDS, +A_SEGES, +A_SEGFS, +A_SEGGS, +A_SEGSS, +A_SGDT, +A_SHL, +A_SHLD, +A_SHR, +A_SHRD, +A_SIDT, +A_SLDT, +A_SMI, +A_SMINT, +A_SMINTOLD, +A_SMSW, +A_STC, +A_STD, +A_STI, +A_STOSB, +A_STOSD, +A_STOSW, +A_STR, +A_SUB, +A_SVDC, +A_SVLDT, +A_SVTS, +A_SYSCALL, +A_SYSENTER, +A_SYSEXIT, +A_SYSRET, +A_TEST, +A_UD1, +A_UD2, +A_UMOV, +A_VERR, +A_VERW, +A_WAIT, +A_WBINVD, +A_WRSHR, +A_WRMSR, +A_XADD, +A_XBTS, +A_XCHG, +A_XLAT, +A_XLATB, +A_XOR, +A_XSTORE, +A_XCRYPTECB, +A_XCRYPTCBC, +A_XCRYPTCFB, +A_XCRYPTOFB, +A_CMOVcc, +A_Jcc, +A_SETcc, +A_ADDPS, +A_ADDSS, +A_ANDNPS, +A_ANDPS, +A_CMPEQPS, +A_CMPEQSS, +A_CMPLEPS, +A_CMPLESS, +A_CMPLTPS, +A_CMPLTSS, +A_CMPNEQPS, +A_CMPNEQSS, +A_CMPNLEPS, +A_CMPNLESS, +A_CMPNLTPS, +A_CMPNLTSS, +A_CMPORDPS, +A_CMPORDSS, +A_CMPUNORDPS, +A_CMPUNORDSS, +A_CMPPS, +A_CMPSS, +A_COMISS, +A_CVTPI2PS, +A_CVTPS2PI, +A_CVTSI2SS, +A_CVTSS2SI, +A_CVTTPS2PI, +A_CVTTSS2SI, +A_DIVPS, +A_DIVSS, +A_LDMXCSR, +A_MAXPS, +A_MAXSS, +A_MINPS, +A_MINSS, +A_MOVAPS, +A_MOVHPS, +A_MOVLHPS, +A_MOVLPS, +A_MOVHLPS, +A_MOVMSKPS, +A_MOVNTPS, +A_MOVSS, +A_MOVUPS, +A_MULPS, +A_MULSS, +A_ORPS, +A_RCPPS, +A_RCPSS, +A_RSQRTPS, +A_RSQRTSS, +A_SHUFPS, +A_SQRTPS, +A_SQRTSS, +A_STMXCSR, +A_SUBPS, +A_SUBSS, +A_UCOMISS, +A_UNPCKHPS, +A_UNPCKLPS, +A_XORPS, +A_FXRSTOR, +A_FXSAVE, +A_PREFETCHNTA, +A_PREFETCHT0, +A_PREFETCHT1, +A_PREFETCHT2, +A_SFENCE, +A_MASKMOVQ, +A_MOVNTQ, +A_PAVGB, +A_PAVGW, +A_PEXTRW, +A_PINSRW, +A_PMAXSW, +A_PMAXUB, +A_PMINSW, +A_PMINUB, +A_PMOVMSKB, +A_PMULHUW, +A_PSADBW, +A_PSHUFW, +A_PFNACC, +A_PFPNACC, +A_PI2FW, +A_PF2IW, +A_PSWAPD, +A_FFREEP, +A_MASKMOVDQU, +A_CLFLUSH, +A_MOVNTDQ, +A_MOVNTI, +A_MOVNTPD, +A_PAUSE, +A_LFENCE, +A_MFENCE, +A_MOVDQA, +A_MOVDQU, +A_MOVDQ2Q, +A_MOVQ2DQ, +A_PADDQ, +A_PMULUDQ, +A_PSHUFD, +A_PSHUFHW, +A_PSHUFLW, +A_PSRLDQ, +A_PSUBQ, +A_PUNPCKHQDQ, +A_PUNPCKLQDQ, +A_ADDPD, +A_ADDSD, +A_ANDNPD, +A_ANDPD, +A_CMPEQPD, +A_CMPEQSD, +A_CMPLEPD, +A_CMPLESD, +A_CMPLTPD, +A_CMPLTSD, +A_CMPNEQPD, +A_CMPNEQSD, +A_CMPNLEPD, +A_CMPNLESD, +A_CMPNLTPD, +A_CMPNLTSD, +A_CMPORDPD, +A_CMPORDSD, +A_CMPUNORDPD, +A_CMPUNORDSD, +A_CMPPD, +A_COMISD, +A_CVTDQ2PD, +A_CVTDQ2PS, +A_CVTPD2DQ, +A_CVTPD2PI, +A_CVTPD2PS, +A_CVTPI2PD, +A_CVTPS2DQ, +A_CVTPS2PD, +A_CVTSD2SI, +A_CVTSD2SS, +A_CVTSI2SD, +A_CVTSS2SD, +A_CVTTPD2PI, +A_CVTTPD2DQ, +A_CVTTPS2DQ, +A_CVTTSD2SI, +A_DIVPD, +A_DIVSD, +A_MAXPD, +A_MAXSD, +A_MINPD, +A_MINSD, +A_MOVAPD, +A_MOVHPD, +A_MOVLPD, +A_MOVMSKPD, +A_MOVUPD, +A_MULPD, +A_MULSD, +A_ORPD, +A_SHUFPD, +A_SQRTPD, +A_SQRTSD, +A_SUBPD, +A_SUBSD, +A_UCOMISD, +A_UNPCKHPD, +A_UNPCKLPD, +A_XORPD, +A_ADDSUBPD, +A_ADDSUBPS, +A_HADDPD, +A_HADDPS, +A_HSUBPD, +A_HSUBPS, +A_LDDQU, +A_MOVDDUP, +A_MOVSHDUP, +A_MOVSLDUP, +A_VMREAD, +A_VMWRITE, +A_VMCALL, +A_VMLAUNCH, +A_VMRESUME, +A_VMXOFF, +A_VMXON, +A_VMCLEAR, +A_VMPTRLD, +A_VMPTRST, +A_VMRUN, +A_VMMCALL, +A_VMLOAD, +A_VMSAVE, +A_STGI, +A_CLGI, +A_SKINIT, +A_INVLPGA, +A_MONTMUL, +A_XSHA1, +A_XSHA256, +A_DMINT, +A_RDM, +A_MOVABS, +A_MOVSXD, +A_CQO, +A_CMPXCHG16B, +A_MOVNTSS, +A_MOVNTSD, +A_INSERTQ, +A_EXTRQ, +A_LZCNT, +A_PABSB, +A_PABSW, +A_PABSD, +A_PALIGNR, +A_PHADDW, +A_PHADDD, +A_PHADDSW, +A_PHSUBW, +A_PHSUBD, +A_PHSUBSW, +A_PMADDUBSW, +A_PMULHRSW, +A_PSHUFB, +A_PSIGNB, +A_PSIGNW, +A_PSIGND, +A_BLENDPS, +A_BLENDPD, +A_BLENDVPS, +A_BLENDVPD, +A_DPPS, +A_DPPD, +A_EXTRACTPS, +A_INSERTPS, +A_MOVNTDQA, +A_MPSADBW, +A_PACKUSDW, +A_PBLENDVB, +A_PBLENDW, +A_PCMPEQQ, +A_PEXTRB, +A_PEXTRD, +A_PEXTRQ, +A_PHMINPOSUW, +A_PINSRB, +A_PINSRD, +A_PINSRQ, +A_PMAXSB, +A_PMAXSD, +A_PMAXUD, +A_PMAXUW, +A_PMINSB, +A_PMINSD, +A_PMINUW, +A_PMINUD, +A_PMOVSXBW, +A_PMOVSXBD, +A_PMOVSXBQ, +A_PMOVSXWD, +A_PMOVSXWQ, +A_PMOVSXDQ, +A_PMOVZXBW, +A_PMOVZXBD, +A_PMOVZXBQ, +A_PMOVZXWD, +A_PMOVZXWQ, +A_PMOVZXDQ, +A_PMULDQ, +A_PMULLD, +A_PTEST, +A_ROUNDPS, +A_ROUNDPD, +A_ROUNDSS, +A_ROUNDSD, +A_CRC32, +A_PCMPESTRI, +A_PCMPESTRM, +A_PCMPISTRI, +A_PCMPISTRM, +A_PCMPGTQ, +A_POPCNT, +A_AESENC, +A_AESENCLAST, +A_AESDEC, +A_AESDECLAST, +A_AESIMC, +A_AESKEYGENASSIST, +A_STOSQ, +A_LODSQ, +A_CMPSQ +); diff --git a/closures/compiler/i386/i386prop.inc b/closures/compiler/i386/i386prop.inc new file mode 100644 index 0000000000..4a8f2f7fa4 --- /dev/null +++ b/closures/compiler/i386/i386prop.inc @@ -0,0 +1,688 @@ +{ don't edit, this file is generated from x86ins.dat } +( +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_MEAX, Ch_WFlags, Ch_None)), +(Ch: (Ch_MEAX, Ch_WFlags, Ch_None)), +(Ch: (Ch_MEAX, Ch_WFlags, Ch_None)), +(Ch: (Ch_MEAX, Ch_WFlags, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_RWFlags)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_WFlags, Ch_None, Ch_None)), +(Ch: (Ch_Rop1, Ch_None, Ch_None)), +(Ch: (Ch_Wop2, Ch_WFlags, Ch_Rop1)), +(Ch: (Ch_Wop2, Ch_WFlags, Ch_Rop1)), +(Ch: (Ch_MOp1, Ch_None, Ch_None)), +(Ch: (Ch_WFlags, Ch_Rop1, Ch_Rop2)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_ROp1, Ch_All, Ch_None)), +(Ch: (Ch_MEAX, Ch_None, Ch_None)), +(Ch: (Ch_MEAX, Ch_WEDX, Ch_None)), +(Ch: (Ch_WFlags, Ch_None, Ch_None)), +(Ch: (Ch_CDirFlag, Ch_None, Ch_None)), +(Ch: (Ch_WFlags, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_WFlags, Ch_None, Ch_None)), +(Ch: (Ch_ROp1, Ch_ROp2, Ch_WFlags)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_none)), +(Ch: (Ch_MEAX, Ch_WEDX, Ch_None)), +(Ch: (Ch_MEAX, Ch_None, Ch_None)), +(Ch: (Ch_MEAX, Ch_None, Ch_None)), +(Ch: (Ch_MEAX, Ch_None, Ch_None)), +(Ch: (Ch_Mop1, Ch_WFlags, Ch_None)), +(Ch: (Ch_RWEAX, Ch_WEDX, Ch_WFlags)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_RWESP, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_Rop1, Ch_FPU, Ch_None)), +(Ch: (Ch_Wop1, Ch_FPU, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_WFLAGS, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_WFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_Rop1, Ch_FPU, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_ROp1, Ch_FPU, Ch_None)), +(Ch: (Ch_ROp1, Ch_FPU, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_FPU, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_ROp1, Ch_FPU, Ch_None)), +(Ch: (Ch_ROp1, Ch_FPU, Ch_None)), +(Ch: (Ch_ROp1, Ch_FPU, Ch_None)), +(Ch: (Ch_ROp1, Ch_FPU, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_WFLAGS, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_WFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_RWEAX, Ch_WEDX, Ch_WFlags)), +(Ch: (Ch_RWEAX, Ch_WEDX, Ch_WFlags)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop1, Ch_WFlags, Ch_None)), +(Ch: (Ch_WMemEDI, Ch_RWEDI, Ch_REDX)), +(Ch: (Ch_WMemEDI, Ch_RWEDI, Ch_REDX)), +(Ch: (Ch_WMemEDI, Ch_RWEDI, Ch_REDX)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_RECX, Ch_None, Ch_None)), +(Ch: (Ch_RECX, Ch_None, Ch_None)), +(Ch: (Ch_RECX, Ch_None, Ch_None)), +(Ch: (Ch_ROp1, Ch_None, Ch_None)), +(Ch: (Ch_WEAX, Ch_RFlags, Ch_None)), +(Ch: (Ch_Wop2, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_RWESP, Ch_WEBP, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_ROp1, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_WEAX, Ch_RWESI, Ch_None)), +(Ch: (Ch_WEAX, Ch_RWESI, Ch_None)), +(Ch: (Ch_WEAX, Ch_RWESI, Ch_None)), +(Ch: (Ch_RWECX, Ch_None, Ch_None)), +(Ch: (Ch_RWECX, Ch_RFlags, Ch_None)), +(Ch: (Ch_RWECX, Ch_RFlags, Ch_None)), +(Ch: (Ch_RWECX, Ch_RFlags, Ch_None)), +(Ch: (Ch_RWECX, Ch_RFlags, Ch_None)), +(Ch: (Ch_Wop2, Ch_WFlags, Ch_None)), +(Ch: (Ch_Wop2, Ch_ROP1, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Rop1, Ch_Wop2, Ch_None)), +(Ch: (Ch_Rop1, Ch_Wop2, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_RWEAX, Ch_WEDX, Ch_WFlags)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_Mop1, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_Mop1, Ch_WFlags, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_Rop1, Ch_Rop2, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_RWESP, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_RWESP, Ch_WFlags, Ch_None)), +(Ch: (Ch_RWESP, Ch_WFlags, Ch_None)), +(Ch: (Ch_RWESP, Ch_WFLAGS, Ch_None)), +(Ch: (Ch_RWESP, Ch_WFlags, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Rop1, Ch_RWESP, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_RWESP, Ch_RFlags, Ch_None)), +(Ch: (Ch_RWESP, Ch_RFlags, Ch_None)), +(Ch: (Ch_RWESP, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_RWESP, Ch_RFlags, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_RWFlags)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_RWFlags)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_WEAX, Ch_WEDX, Ch_None)), +(Ch: (Ch_WEAX, Ch_WEDX, Ch_None)), +(Ch: (Ch_WEAX, Ch_WEDX, Ch_None)), +(Ch: (Ch_RWECX, Ch_RWFlags, Ch_None)), +(Ch: (Ch_RWECX, Ch_RWFlags, Ch_None)), +(Ch: (Ch_RWECX, Ch_RWFlags, Ch_None)), +(Ch: (Ch_RWECX, Ch_RWFLAGS, Ch_None)), +(Ch: (Ch_RWECX, Ch_RWFLAGS, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_RWFlags)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_RWFlags)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_WFlags, Ch_REAX, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_RWFlags)), +(Ch: (Ch_WEAX, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_RWFlags)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_MOp3, Ch_RWFlags, Ch_Rop2)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_MOp3, Ch_RWFlags, Ch_Rop2)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_WFlags, Ch_None, Ch_None)), +(Ch: (Ch_SDirFlag, Ch_None, Ch_None)), +(Ch: (Ch_WFlags, Ch_None, Ch_None)), +(Ch: (Ch_REAX, Ch_WMemEDI, Ch_RWEDI)), +(Ch: (Ch_REAX, Ch_WMemEDI, Ch_RWEDI)), +(Ch: (Ch_REAX, Ch_WMemEDI, Ch_RWEDI)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_WFlags, Ch_Rop1, Ch_Rop2)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_WFlags, Ch_None, Ch_None)), +(Ch: (Ch_WFlags, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_RWop1, Ch_RWop2, Ch_None)), +(Ch: (Ch_WEAX, Ch_REBX, Ch_None)), +(Ch: (Ch_WEAX, Ch_REBX, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_ROp1, Ch_WOp2, Ch_RFLAGS)), +(Ch: (Ch_RFLAGS, Ch_None, Ch_None)), +(Ch: (Ch_RFLAGS, Ch_WOp1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Rop1, Ch_Rop2, Ch_WFlags)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_ROp1, Ch_WOp2, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop3, Ch_Rop2, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Rop1, Ch_Rop2, Ch_WFlags)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Rop1, Ch_Rop2, Ch_WFlags)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_ROp1, Ch_WOp2, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop3, Ch_Rop2, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Rop1, Ch_Rop2, Ch_WFlags)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_MRAX, Ch_WRDX, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Mop1, Ch_Rop2, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_RRAX, Ch_WMemEDI, Ch_RWRDI)), +(Ch: (Ch_WRAX, Ch_RWRSI, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)) +); diff --git a/closures/compiler/i386/i386tab.inc b/closures/compiler/i386/i386tab.inc new file mode 100644 index 0000000000..f3df187bdc --- /dev/null +++ b/closures/compiler/i386/i386tab.inc @@ -0,0 +1,8438 @@ +{ don't edit, this file is generated from x86ins.dat } +( + ( + opcode : A_NONE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #0; + flags : if_none + ), + ( + opcode : A_AAA; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#55; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_AAD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#213#10; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_AAD; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #1#213#20; + flags : if_8086 or if_sb or if_nox86_64 + ), + ( + opcode : A_AAM; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#212#10; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_AAM; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #1#212#20; + flags : if_8086 or if_sb or if_nox86_64 + ), + ( + opcode : A_AAS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#63; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#17#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#19#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#16#65; + flags : if_8086 + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#18#72; + flags : if_8086 + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #208#1#131#130#13; + flags : if_8086 + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_reg_eax,ot_immediate,ot_none,ot_none); + code : #213#1#21#33; + flags : if_386 or if_sm + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #213#1#129#130#33; + flags : if_386 or if_sm + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_reg_ax,ot_immediate,ot_none,ot_none); + code : #212#1#21#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#129#130#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#20#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#128#130#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#1#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#3#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#0#65; + flags : if_8086 + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#2#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #208#1#131#128#13; + flags : if_8086 + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_reg_eax,ot_immediate,ot_none,ot_none); + code : #208#1#5#33; + flags : if_386 or if_sm + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #213#1#129#128#33; + flags : if_386 or if_sm + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_reg_ax,ot_immediate,ot_none,ot_none); + code : #212#1#5#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#129#128#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#4#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#128#128#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#33#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#35#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#32#65; + flags : if_8086 + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#34#72; + flags : if_8086 + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #208#1#131#132#13; + flags : if_8086 + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_reg_eax,ot_immediate,ot_none,ot_none); + code : #213#1#37#33; + flags : if_386 or if_sm + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #213#1#129#132#33; + flags : if_386 or if_sm + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_reg_ax,ot_immediate,ot_none,ot_none); + code : #212#1#37#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#129#132#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#36#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#128#132#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_ARPL; + ops : 2; + optypes : (ot_reg16,ot_reg16,ot_none,ot_none); + code : #1#99#65; + flags : if_286 or if_prot or if_nox86_64 + ), + ( + opcode : A_ARPL; + ops : 2; + optypes : (ot_memory,ot_reg16,ot_none,ot_none); + code : #1#99#65; + flags : if_286 or if_prot or if_sm or if_nox86_64 + ), + ( + opcode : A_BOUND; + ops : 2; + optypes : (ot_reg16 or ot_bits32,ot_memory,ot_none,ot_none); + code : #208#1#98#72; + flags : if_186 or if_nox86_64 + ), + ( + opcode : A_BSF; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#2#15#188#72; + flags : if_386 or if_sm + ), + ( + opcode : A_BSR; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#2#15#189#72; + flags : if_386 or if_sm + ), + ( + opcode : A_BSWAP; + ops : 1; + optypes : (ot_reg32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#1#15#8#200; + flags : if_486 + ), + ( + opcode : A_BT; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#163#65; + flags : if_386 or if_sm + ), + ( + opcode : A_BT; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#2#15#186#132#21; + flags : if_386 or if_sb + ), + ( + opcode : A_BTC; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#187#65; + flags : if_386 or if_sm + ), + ( + opcode : A_BTC; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#2#15#186#135#21; + flags : if_386 or if_sb + ), + ( + opcode : A_BTR; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#179#65; + flags : if_386 or if_sm + ), + ( + opcode : A_BTR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#2#15#186#134#21; + flags : if_386 or if_sb + ), + ( + opcode : A_BTS; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#171#65; + flags : if_386 or if_sm + ), + ( + opcode : A_BTS; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#2#15#186#133#21; + flags : if_386 or if_sb + ), + ( + opcode : A_CALL; + ops : 1; + optypes : (ot_rm_gpr or ot_bits32,ot_none,ot_none,ot_none); + code : #213#1#255#130; + flags : if_386 or if_nox86_64 + ), + ( + opcode : A_CALL; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none); + code : #212#1#255#130; + flags : if_8086 + ), + ( + opcode : A_CALL; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #208#1#232#52; + flags : if_8086 + ), + ( + opcode : A_CALL; + ops : 1; + optypes : (ot_immediate or ot_near,ot_none,ot_none,ot_none); + code : #208#1#232#52; + flags : if_8086 + ), + ( + opcode : A_CALL; + ops : 1; + optypes : (ot_immediate or ot_far,ot_none,ot_none,ot_none); + code : #208#1#154#28#31; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_CALL; + ops : 1; + optypes : (ot_memory or ot_near,ot_none,ot_none,ot_none); + code : #208#1#255#130; + flags : if_8086 + ), + ( + opcode : A_CALL; + ops : 1; + optypes : (ot_memory or ot_far,ot_none,ot_none,ot_none); + code : #208#1#255#131; + flags : if_8086 + ), + ( + opcode : A_CALL; + ops : 2; + optypes : (ot_immediate,ot_immediate,ot_none,ot_none); + code : #215#1#154#29#24; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_CALL; + ops : 2; + optypes : (ot_immediate or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#154#25#24; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_CALL; + ops : 2; + optypes : (ot_immediate,ot_immediate or ot_bits16,ot_none,ot_none); + code : #212#1#154#25#24; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_CALL; + ops : 2; + optypes : (ot_immediate or ot_bits32,ot_immediate,ot_none,ot_none); + code : #213#1#154#33#24; + flags : if_386 or if_nox86_64 + ), + ( + opcode : A_CALL; + ops : 2; + optypes : (ot_immediate,ot_immediate or ot_bits32,ot_none,ot_none); + code : #213#1#154#33#24; + flags : if_386 or if_nox86_64 + ), + ( + opcode : A_CBW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#152; + flags : if_8086 + ), + ( + opcode : A_CDQ; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#153; + flags : if_386 + ), + ( + opcode : A_CLC; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#248; + flags : if_8086 + ), + ( + opcode : A_CLD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#252; + flags : if_8086 + ), + ( + opcode : A_CLI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#250; + flags : if_8086 + ), + ( + opcode : A_CLTS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#6; + flags : if_286 or if_priv + ), + ( + opcode : A_CMC; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#245; + flags : if_8086 + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#57#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#59#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#56#65; + flags : if_8086 + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#58#72; + flags : if_8086 + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #208#1#131#135#13; + flags : if_8086 + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_reg_eax,ot_immediate,ot_none,ot_none); + code : #213#1#61#33; + flags : if_386 or if_sm + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #213#1#129#135#33; + flags : if_386 or if_sm + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_reg_ax,ot_immediate,ot_none,ot_none); + code : #212#1#61#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#129#135#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#60#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#128#135#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_memory,ot_immediate or ot_bits32,ot_none,ot_none); + code : #213#1#129#135#33; + flags : if_386 or if_sd + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_memory,ot_immediate or ot_bits16,ot_none,ot_none); + code : #212#1#129#135#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_memory,ot_immediate or ot_bits8,ot_none,ot_none); + code : #1#128#135#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_CMPSB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #218#1#166; + flags : if_8086 + ), + ( + opcode : A_CMPSD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #218#213#1#167; + flags : if_386 + ), + ( + opcode : A_CMPSD; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #220#2#15#194#72#22; + flags : if_willamette or if_sse2 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_CMPSW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #218#212#1#167; + flags : if_8086 + ), + ( + opcode : A_CMPXCHG; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#177#65; + flags : if_pent or if_sm + ), + ( + opcode : A_CMPXCHG; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #2#15#176#65; + flags : if_pent + ), + ( + opcode : A_CMPXCHG486; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#167#65; + flags : if_486 or if_sm + ), + ( + opcode : A_CMPXCHG486; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #2#15#166#65; + flags : if_486 or if_undoc + ), + ( + opcode : A_CMPXCHG8B; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#199#129; + flags : if_pent + ), + ( + opcode : A_CPUID; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#162; + flags : if_pent + ), + ( + opcode : A_CWD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#153; + flags : if_8086 + ), + ( + opcode : A_CWDE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#152; + flags : if_386 + ), + ( + opcode : A_DAA; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#39; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_DAS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#47; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_DEC; + ops : 1; + optypes : (ot_reg16 or ot_bits32,ot_none,ot_none,ot_none); + code : #208#8#72; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_DEC; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#1#255#129; + flags : if_8086 + ), + ( + opcode : A_DEC; + ops : 1; + optypes : (ot_rm_gpr or ot_bits8,ot_none,ot_none,ot_none); + code : #1#254#129; + flags : if_8086 + ), + ( + opcode : A_DIV; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#1#247#134; + flags : if_8086 + ), + ( + opcode : A_DIV; + ops : 1; + optypes : (ot_rm_gpr or ot_bits8,ot_none,ot_none,ot_none); + code : #1#246#134; + flags : if_8086 + ), + ( + opcode : A_EMMS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#119; + flags : if_pent or if_mmx + ), + ( + opcode : A_ENTER; + ops : 2; + optypes : (ot_immediate,ot_immediate,ot_none,ot_none); + code : #1#200#24#21; + flags : if_186 + ), + ( + opcode : A_F2XM1; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#240; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FABS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#225; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADD; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#216#128; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADD; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#220#128; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#222#193; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADD; + ops : 1; + optypes : (ot_fpureg or ot_to,ot_none,ot_none,ot_none); + code : #1#220#8#192; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADD; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#220#8#192; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADD; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#216#8#192; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADD; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#216#9#192; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADDP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#222#193; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADDP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#222#8#192; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADDP; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#222#8#192; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FBLD; + ops : 1; + optypes : (ot_memory or ot_bits80,ot_none,ot_none,ot_none); + code : #1#223#132; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FBLD; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #1#223#132; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FBSTP; + ops : 1; + optypes : (ot_memory or ot_bits80,ot_none,ot_none,ot_none); + code : #1#223#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FBSTP; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #1#223#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCHS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#224; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCLEX; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#155#219#226; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCMOVB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#218#193; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVB; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#218#8#192; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVB; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#218#9#192; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVBE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#218#209; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVBE; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#218#8#208; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVBE; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#218#9#208; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#218#201; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVE; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#218#8#200; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVE; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#218#9#200; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#193; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNB; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#219#8#192; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNB; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#219#9#192; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNBE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#209; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNBE; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#219#8#208; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNBE; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#219#9#208; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#201; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNE; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#219#8#200; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNE; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#219#9#200; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNU; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#217; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNU; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#219#8#216; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNU; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#219#9#216; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVU; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#218#217; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVU; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#218#8#216; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVU; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#218#9#216; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCOM; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#216#130; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOM; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#220#130; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOM; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#216#209; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOM; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#216#8#208; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOM; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#216#9#208; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOMI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#241; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCOMI; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#219#8#240; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCOMI; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#219#9#240; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCOMIP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#223#241; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCOMIP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#223#8#240; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCOMIP; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#223#9#240; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCOMP; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#216#131; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOMP; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#220#131; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOMP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#216#217; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOMP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#216#8#216; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOMP; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#216#9#216; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOMPP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#222#217; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#255; + flags : if_386 or if_fpu + ), + ( + opcode : A_FDECSTP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#246; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDISI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#155#219#225; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIV; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#216#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIV; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#220#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIV; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#220#241; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIV; + ops : 1; + optypes : (ot_fpureg or ot_to,ot_none,ot_none,ot_none); + code : #1#220#8#240; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIV; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#220#8#240; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIV; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#216#8#240; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIV; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#216#9#240; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#222#241; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVP; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#222#8#240; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#222#8#240; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVR; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#216#135; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVR; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#220#135; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVR; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#220#249; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVR; + ops : 1; + optypes : (ot_fpureg or ot_to,ot_none,ot_none,ot_none); + code : #1#220#8#248; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVR; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#220#8#248; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVR; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#216#8#248; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVR; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#216#9#248; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVRP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#222#249; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVRP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#222#8#248; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVRP; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#222#8#248; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FEMMS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#14; + flags : if_pent or if_3dnow + ), + ( + opcode : A_FENI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#155#219#224; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FFREE; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#221#8#192; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIADD; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#222#128; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIADD; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#218#128; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FICOM; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#222#130; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FICOM; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#218#130; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FICOMP; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#222#131; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FICOMP; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#218#131; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIDIV; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#222#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIDIV; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#218#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIDIVR; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#222#135; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIDIVR; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#218#135; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FILD; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#219#128; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FILD; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#223#128; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FILD; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#223#133; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIMUL; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#222#129; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIMUL; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#218#129; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FINCSTP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#247; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FINIT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#155#219#227; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIST; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#219#130; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIST; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #212#1#223#130; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FISTP; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#219#131; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FISTP; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #212#1#223#131; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FISTP; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#223#135; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FISTTP; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#219#129; + flags : if_prescott or if_fpu + ), + ( + opcode : A_FISTTP; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#223#129; + flags : if_prescott or if_fpu + ), + ( + opcode : A_FISTTP; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#221#129; + flags : if_prescott or if_fpu + ), + ( + opcode : A_FISUB; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#222#132; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FISUB; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#218#132; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FISUBR; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#222#133; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FISUBR; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#218#133; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLD; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#217#128; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLD; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#221#128; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLD; + ops : 1; + optypes : (ot_memory or ot_bits80,ot_none,ot_none,ot_none); + code : #1#219#133; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLD; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#217#8#192; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLD1; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#232; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLDCW; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #1#217#133; + flags : if_8086 or if_fpu or if_sw + ), + ( + opcode : A_FLDENV; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #1#217#132; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLDL2E; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#234; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLDL2T; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#233; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLDLG2; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#236; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLDLN2; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#237; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLDPI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#235; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLDZ; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#238; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMUL; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#216#129; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMUL; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#220#129; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMUL; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#220#201; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMUL; + ops : 1; + optypes : (ot_fpureg or ot_to,ot_none,ot_none,ot_none); + code : #1#220#8#200; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMUL; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#220#8#200; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMUL; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#216#8#200; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMUL; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#216#9#200; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMULP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#222#201; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMULP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#222#8#200; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMULP; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#222#8#200; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FNCLEX; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#226; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FNDISI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#225; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FNENI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#224; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FNINIT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#227; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FNOP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#208; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FNSAVE; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #1#221#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FNSTCW; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #1#217#135; + flags : if_8086 or if_fpu or if_sw + ), + ( + opcode : A_FNSTENV; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #1#217#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FNSTSW; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #1#221#135; + flags : if_8086 or if_fpu or if_sw + ), + ( + opcode : A_FNSTSW; + ops : 1; + optypes : (ot_reg_ax,ot_none,ot_none,ot_none); + code : #2#223#224; + flags : if_286 or if_fpu + ), + ( + opcode : A_FPATAN; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#243; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FPREM; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#248; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FPREM1; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#245; + flags : if_386 or if_fpu + ), + ( + opcode : A_FPTAN; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#242; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FRNDINT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#252; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FRSTOR; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #1#221#132; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSAVE; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#155#221#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSCALE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#253; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSETPM; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#228; + flags : if_286 or if_fpu + ), + ( + opcode : A_FSIN; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#254; + flags : if_386 or if_fpu + ), + ( + opcode : A_FSINCOS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#251; + flags : if_386 or if_fpu + ), + ( + opcode : A_FSQRT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#250; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FST; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#217#130; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FST; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#221#130; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FST; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#221#8#208; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSTCW; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#155#217#135; + flags : if_8086 or if_fpu or if_sw + ), + ( + opcode : A_FSTENV; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#155#217#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSTP; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#217#131; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSTP; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#221#131; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSTP; + ops : 1; + optypes : (ot_memory or ot_bits80,ot_none,ot_none,ot_none); + code : #1#219#135; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSTP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#221#8#216; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSTSW; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#155#221#135; + flags : if_8086 or if_fpu or if_sw + ), + ( + opcode : A_FSTSW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#155#223#224; + flags : if_286 or if_fpu + ), + ( + opcode : A_FSTSW; + ops : 1; + optypes : (ot_reg_ax,ot_none,ot_none,ot_none); + code : #3#155#223#224; + flags : if_286 or if_fpu + ), + ( + opcode : A_FSUB; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#216#132; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUB; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#220#132; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#220#225; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUB; + ops : 1; + optypes : (ot_fpureg or ot_to,ot_none,ot_none,ot_none); + code : #1#220#8#224; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUB; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#220#8#224; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUB; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#216#8#224; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUB; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#216#9#224; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#222#225; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#222#8#224; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBP; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#222#8#224; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBR; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#216#133; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBR; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#220#133; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBR; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#220#233; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBR; + ops : 1; + optypes : (ot_fpureg or ot_to,ot_none,ot_none,ot_none); + code : #1#220#8#232; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBR; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#220#8#232; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBR; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#216#8#232; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBR; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#216#9#232; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBRP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#222#233; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBRP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#222#8#232; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBRP; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#222#8#232; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FTST; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#228; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FUCOM; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#221#225; + flags : if_386 or if_fpu + ), + ( + opcode : A_FUCOM; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#221#8#224; + flags : if_386 or if_fpu + ), + ( + opcode : A_FUCOM; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#221#9#224; + flags : if_386 or if_fpu + ), + ( + opcode : A_FUCOMI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#233; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FUCOMI; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#219#8#232; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FUCOMI; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#219#9#232; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FUCOMIP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#223#233; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FUCOMIP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#223#8#232; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FUCOMIP; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#223#9#232; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FUCOMP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#221#233; + flags : if_386 or if_fpu + ), + ( + opcode : A_FUCOMP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#221#8#232; + flags : if_386 or if_fpu + ), + ( + opcode : A_FUCOMP; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#221#9#232; + flags : if_386 or if_fpu + ), + ( + opcode : A_FUCOMPP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#218#233; + flags : if_386 or if_fpu + ), + ( + opcode : A_FWAIT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#155; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FXAM; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#229; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FXCH; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#201; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FXCH; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#217#8#200; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FXCH; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#217#8#200; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FXCH; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#217#9#200; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FXTRACT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#244; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FYL2X; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#241; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FYL2XP1; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#249; + flags : if_8086 or if_fpu + ), + ( + opcode : A_HLT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#244; + flags : if_8086 or if_priv + ), + ( + opcode : A_IBTS; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#167#65; + flags : if_386 or if_sm or if_undoc + ), + ( + opcode : A_ICEBP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#241; + flags : if_386 + ), + ( + opcode : A_IDIV; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#1#247#135; + flags : if_8086 + ), + ( + opcode : A_IDIV; + ops : 1; + optypes : (ot_rm_gpr or ot_bits8,ot_none,ot_none,ot_none); + code : #1#246#135; + flags : if_8086 + ), + ( + opcode : A_IMUL; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#2#15#175#72; + flags : if_386 or if_sm + ), + ( + opcode : A_IMUL; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#1#247#133; + flags : if_8086 + ), + ( + opcode : A_IMUL; + ops : 3; + optypes : (ot_reg32 or ot_bits64,ot_rm_gpr,ot_immediate or ot_bits8 or ot_signed,ot_none); + code : #208#1#107#72#14; + flags : if_286 or if_sm + ), + ( + opcode : A_IMUL; + ops : 3; + optypes : (ot_reg32 or ot_bits64,ot_rm_gpr,ot_immediate,ot_none); + code : #208#1#105#72#34; + flags : if_286 or if_sm or if_sd or if_ar2 + ), + ( + opcode : A_IMUL; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #208#1#107#64#13; + flags : if_286 + ), + ( + opcode : A_IMUL; + ops : 2; + optypes : (ot_reg32,ot_immediate,ot_none,ot_none); + code : #213#1#105#64#33; + flags : if_286 or if_sd + ), + ( + opcode : A_IMUL; + ops : 3; + optypes : (ot_reg16,ot_rm_gpr,ot_immediate or ot_bits8 or ot_signed,ot_none); + code : #212#1#107#72#14; + flags : if_286 or if_sm + ), + ( + opcode : A_IMUL; + ops : 3; + optypes : (ot_reg16,ot_rm_gpr,ot_immediate,ot_none); + code : #212#1#105#72#26; + flags : if_286 or if_sm or if_sw or if_ar2 + ), + ( + opcode : A_IMUL; + ops : 2; + optypes : (ot_reg16,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #212#1#107#64#13; + flags : if_286 + ), + ( + opcode : A_IMUL; + ops : 2; + optypes : (ot_reg16,ot_immediate,ot_none,ot_none); + code : #212#1#105#64#25; + flags : if_286 or if_sw + ), + ( + opcode : A_IMUL; + ops : 1; + optypes : (ot_rm_gpr or ot_bits8,ot_none,ot_none,ot_none); + code : #1#246#133; + flags : if_8086 + ), + ( + opcode : A_IN; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#228#21; + flags : if_8086 or if_sb + ), + ( + opcode : A_IN; + ops : 2; + optypes : (ot_reg_ax or ot_bits32,ot_immediate,ot_none,ot_none); + code : #208#1#229#21; + flags : if_8086 or if_sb + ), + ( + opcode : A_IN; + ops : 2; + optypes : (ot_reg_al,ot_reg_dx,ot_none,ot_none); + code : #1#236; + flags : if_8086 + ), + ( + opcode : A_IN; + ops : 2; + optypes : (ot_reg_ax or ot_bits32,ot_reg_dx,ot_none,ot_none); + code : #208#1#237; + flags : if_8086 + ), + ( + opcode : A_INC; + ops : 1; + optypes : (ot_reg16 or ot_bits32,ot_none,ot_none,ot_none); + code : #208#8#64; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_INC; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#1#255#128; + flags : if_8086 + ), + ( + opcode : A_INC; + ops : 1; + optypes : (ot_rm_gpr or ot_bits8,ot_none,ot_none,ot_none); + code : #1#254#128; + flags : if_8086 + ), + ( + opcode : A_INSB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#108; + flags : if_186 + ), + ( + opcode : A_INSD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#109; + flags : if_386 + ), + ( + opcode : A_INSW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#109; + flags : if_186 + ), + ( + opcode : A_INT; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #1#205#20; + flags : if_8086 or if_sb + ), + ( + opcode : A_INT01; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#241; + flags : if_386 + ), + ( + opcode : A_INT1; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#241; + flags : if_386 + ), + ( + opcode : A_INT03; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#204; + flags : if_8086 + ), + ( + opcode : A_INT3; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#204; + flags : if_8086 + ), + ( + opcode : A_INTO; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#206; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_INVD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#8; + flags : if_486 or if_priv + ), + ( + opcode : A_INVLPG; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#1#135; + flags : if_486 or if_priv + ), + ( + opcode : A_IRET; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #215#1#207; + flags : if_8086 + ), + ( + opcode : A_IRETD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#207; + flags : if_386 + ), + ( + opcode : A_IRETW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#207; + flags : if_8086 + ), + ( + opcode : A_JCXZ; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #200#1#227#40; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_JECXZ; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #201#1#227#40; + flags : if_386 + ), + ( + opcode : A_JMP; + ops : 1; + optypes : (ot_immediate or ot_bits8,ot_none,ot_none,ot_none); + code : #1#235#40; + flags : if_8086 or if_pass2 + ), + ( + opcode : A_JMP; + ops : 1; + optypes : (ot_immediate or ot_bits16 or ot_bits32,ot_none,ot_none,ot_none); + code : #208#1#233#52; + flags : if_8086 or if_pass2 + ), + ( + opcode : A_JMP; + ops : 1; + optypes : (ot_rm_gpr or ot_bits32,ot_none,ot_none,ot_none); + code : #213#1#255#132; + flags : if_386 or if_nox86_64 + ), + ( + opcode : A_JMP; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none); + code : #212#1#255#132; + flags : if_8086 + ), + ( + opcode : A_JMP; + ops : 1; + optypes : (ot_immediate or ot_short,ot_none,ot_none,ot_none); + code : #1#235#40; + flags : if_8086 or if_pass2 + ), + ( + opcode : A_JMP; + ops : 1; + optypes : (ot_immediate or ot_near,ot_none,ot_none,ot_none); + code : #208#1#233#52; + flags : if_8086 or if_pass2 + ), + ( + opcode : A_JMP; + ops : 1; + optypes : (ot_immediate or ot_far,ot_none,ot_none,ot_none); + code : #208#1#234#28#31; + flags : if_8086 or if_pass2 or if_nox86_64 + ), + ( + opcode : A_JMP; + ops : 1; + optypes : (ot_memory or ot_near,ot_none,ot_none,ot_none); + code : #208#1#255#132; + flags : if_8086 + ), + ( + opcode : A_JMP; + ops : 1; + optypes : (ot_memory or ot_far,ot_none,ot_none,ot_none); + code : #208#1#255#133; + flags : if_8086 + ), + ( + opcode : A_JMP; + ops : 2; + optypes : (ot_immediate,ot_immediate,ot_none,ot_none); + code : #215#1#234#29#24; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_JMP; + ops : 2; + optypes : (ot_immediate,ot_immediate or ot_bits16,ot_none,ot_none); + code : #212#1#234#25#24; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_JMP; + ops : 2; + optypes : (ot_immediate,ot_immediate or ot_bits32,ot_none,ot_none); + code : #213#1#234#33#24; + flags : if_386 or if_nox86_64 + ), + ( + opcode : A_LAHF; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#159; + flags : if_8086 + ), + ( + opcode : A_LAR; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#2#15#2#72; + flags : if_286 or if_prot or if_sm + ), + ( + opcode : A_LCALL; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #213#1#255#131; + flags : if_386 or if_nox86_64 + ), + ( + opcode : A_LCALL; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #212#1#255#131; + flags : if_8086 + ), + ( + opcode : A_LDS; + ops : 2; + optypes : (ot_reg16 or ot_bits32,ot_memory,ot_none,ot_none); + code : #208#1#197#72; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_LEA; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_memory,ot_none,ot_none); + code : #208#1#141#72; + flags : if_8086 + ), + ( + opcode : A_LEA; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#1#141#72; + flags : if_8086 or if_sd + ), + ( + opcode : A_LEAVE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#201; + flags : if_186 + ), + ( + opcode : A_LES; + ops : 2; + optypes : (ot_reg16 or ot_bits32,ot_memory,ot_none,ot_none); + code : #208#1#196#72; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_LFS; + ops : 2; + optypes : (ot_reg16 or ot_bits32,ot_memory,ot_none,ot_none); + code : #208#2#15#180#72; + flags : if_386 + ), + ( + opcode : A_LGDT; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#1#130; + flags : if_286 or if_priv + ), + ( + opcode : A_LGS; + ops : 2; + optypes : (ot_reg16 or ot_bits32,ot_memory,ot_none,ot_none); + code : #208#2#15#181#72; + flags : if_386 + ), + ( + opcode : A_LIDT; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#1#131; + flags : if_286 or if_priv + ), + ( + opcode : A_LJMP; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #213#1#255#133; + flags : if_386 or if_nox86_64 + ), + ( + opcode : A_LJMP; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #212#1#255#133; + flags : if_8086 + ), + ( + opcode : A_LLDT; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none); + code : #2#15#0#130; + flags : if_286 or if_prot or if_priv + ), + ( + opcode : A_LMSW; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none); + code : #2#15#1#134; + flags : if_286 or if_priv + ), + ( + opcode : A_LOADALL; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#7; + flags : if_386 or if_undoc + ), + ( + opcode : A_LOADALL286; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#5; + flags : if_286 or if_undoc + ), + ( + opcode : A_LOCK; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#240; + flags : if_8086 or if_pre + ), + ( + opcode : A_LODSB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#172; + flags : if_8086 + ), + ( + opcode : A_LODSD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#173; + flags : if_386 + ), + ( + opcode : A_LODSW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#173; + flags : if_8086 + ), + ( + opcode : A_LOOP; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #202#1#226#40; + flags : if_8086 + ), + ( + opcode : A_LOOP; + ops : 2; + optypes : (ot_immediate,ot_reg_cx,ot_none,ot_none); + code : #200#1#226#40; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_LOOP; + ops : 2; + optypes : (ot_immediate,ot_reg_ecx or ot_bits64,ot_none,ot_none); + code : #201#1#226#40; + flags : if_386 + ), + ( + opcode : A_LOOPE; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #202#1#225#40; + flags : if_8086 + ), + ( + opcode : A_LOOPE; + ops : 2; + optypes : (ot_immediate,ot_reg_cx,ot_none,ot_none); + code : #200#1#225#40; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_LOOPE; + ops : 2; + optypes : (ot_immediate,ot_reg_ecx or ot_bits64,ot_none,ot_none); + code : #201#1#225#40; + flags : if_386 + ), + ( + opcode : A_LOOPNE; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #202#1#224#40; + flags : if_8086 + ), + ( + opcode : A_LOOPNE; + ops : 2; + optypes : (ot_immediate,ot_reg_cx,ot_none,ot_none); + code : #200#1#224#40; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_LOOPNE; + ops : 2; + optypes : (ot_immediate,ot_reg_ecx or ot_bits64,ot_none,ot_none); + code : #201#1#224#40; + flags : if_386 + ), + ( + opcode : A_LOOPNZ; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #202#1#224#40; + flags : if_8086 + ), + ( + opcode : A_LOOPNZ; + ops : 2; + optypes : (ot_immediate,ot_reg_cx,ot_none,ot_none); + code : #200#1#224#40; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_LOOPNZ; + ops : 2; + optypes : (ot_immediate,ot_reg_ecx or ot_bits64,ot_none,ot_none); + code : #201#1#224#40; + flags : if_386 + ), + ( + opcode : A_LOOPZ; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #202#1#225#40; + flags : if_8086 + ), + ( + opcode : A_LOOPZ; + ops : 2; + optypes : (ot_immediate,ot_reg_cx,ot_none,ot_none); + code : #200#1#225#40; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_LOOPZ; + ops : 2; + optypes : (ot_immediate,ot_reg_ecx or ot_bits64,ot_none,ot_none); + code : #201#1#225#40; + flags : if_386 + ), + ( + opcode : A_LSL; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#2#15#3#72; + flags : if_286 or if_prot or if_sm + ), + ( + opcode : A_LSS; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_memory,ot_none,ot_none); + code : #208#2#15#178#72; + flags : if_386 + ), + ( + opcode : A_LTR; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none); + code : #2#15#0#131; + flags : if_286 or if_prot or if_priv + ), + ( + opcode : A_MONITOR; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#200; + flags : if_prescott + ), + ( + opcode : A_MONITOR; + ops : 3; + optypes : (ot_reg_eax,ot_reg_ecx,ot_reg_edx,ot_none); + code : #3#15#1#200; + flags : if_prescott + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_mem_offs,ot_reg_ax,ot_none,ot_none); + code : #212#1#163#36; + flags : if_8086 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_mem_offs,ot_reg_eax,ot_none,ot_none); + code : #213#1#163#36; + flags : if_386 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#137#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_ax,ot_mem_offs,ot_none,ot_none); + code : #212#1#161#37; + flags : if_8086 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_eax,ot_mem_offs,ot_none,ot_none); + code : #213#1#161#37; + flags : if_386 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#139#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg32,ot_immediate,ot_none,ot_none); + code : #213#8#184#33; + flags : if_386 or if_sd + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #213#1#199#128#33; + flags : if_386 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg16,ot_immediate,ot_none,ot_none); + code : #212#8#184#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#199#128#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_mem_offs,ot_reg_al,ot_none,ot_none); + code : #1#162#36; + flags : if_8086 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#136#65; + flags : if_8086 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_al,ot_mem_offs,ot_none,ot_none); + code : #1#160#37; + flags : if_8086 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#138#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg8,ot_immediate,ot_none,ot_none); + code : #8#176#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#198#128#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32,ot_reg_cs,ot_none,ot_none); + code : #208#1#140#129; + flags : if_8086 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32,ot_reg_dess,ot_none,ot_none); + code : #208#1#140#65; + flags : if_8086 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32,ot_reg_fsgs,ot_none,ot_none); + code : #208#1#140#65; + flags : if_386 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_dess,ot_rm_gpr or ot_bits16 or ot_bits32,ot_none,ot_none); + code : #209#1#142#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_fsgs,ot_rm_gpr or ot_bits16 or ot_bits32,ot_none,ot_none); + code : #209#1#142#72; + flags : if_386 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg32,ot_reg_cr4,ot_none,ot_none); + code : #2#15#32#132; + flags : if_pent or if_priv or if_nox86_64 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg32,ot_reg_creg,ot_none,ot_none); + code : #2#15#32#65; + flags : if_386 or if_priv or if_nox86_64 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg32,ot_reg_dreg,ot_none,ot_none); + code : #2#15#33#65; + flags : if_386 or if_priv or if_nox86_64 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg32,ot_reg_treg,ot_none,ot_none); + code : #2#15#36#65; + flags : if_386 or if_priv or if_nox86_64 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_cr4,ot_reg32,ot_none,ot_none); + code : #2#15#34#140; + flags : if_pent or if_priv or if_nox86_64 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_creg,ot_reg32,ot_none,ot_none); + code : #2#15#34#72; + flags : if_386 or if_priv or if_nox86_64 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_dreg,ot_reg32,ot_none,ot_none); + code : #2#15#35#72; + flags : if_386 or if_priv or if_nox86_64 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_treg,ot_reg32,ot_none,ot_none); + code : #2#15#38#72; + flags : if_386 or if_priv or if_nox86_64 + ), + ( + opcode : A_MOVD; + ops : 2; + optypes : (ot_mmxreg,ot_rm_gpr or ot_bits32,ot_none,ot_none); + code : #2#15#110#72; + flags : if_pent or if_mmx or if_sd + ), + ( + opcode : A_MOVD; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_mmxreg,ot_none,ot_none); + code : #2#15#126#65; + flags : if_pent or if_mmx or if_sd + ), + ( + opcode : A_MOVD; + ops : 2; + optypes : (ot_xmmreg,ot_rm_gpr or ot_bits32,ot_none,ot_none); + code : #241#2#15#110#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVD; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#126#65; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#111#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_MOVQ; + ops : 2; + optypes : (ot_mmxrm,ot_mmxreg,ot_none,ot_none); + code : #2#15#127#65; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_MOVQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#126#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVQ; + ops : 2; + optypes : (ot_xmmrm,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#214#65; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVSB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#164; + flags : if_8086 + ), + ( + opcode : A_MOVSD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#165; + flags : if_386 + ), + ( + opcode : A_MOVSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#16#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVSD; + ops : 2; + optypes : (ot_xmmrm,ot_xmmreg,ot_none,ot_none); + code : #220#2#15#17#65; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVSW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#165; + flags : if_8086 + ), + ( + opcode : A_MOVSX; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_rm_gpr or ot_bits16,ot_none,ot_none); + code : #208#2#15#191#72; + flags : if_386 + ), + ( + opcode : A_MOVSX; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #208#2#15#190#72; + flags : if_386 + ), + ( + opcode : A_MOVZX; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_rm_gpr or ot_bits16,ot_none,ot_none); + code : #208#2#15#183#72; + flags : if_386 + ), + ( + opcode : A_MOVZX; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #208#2#15#182#72; + flags : if_386 + ), + ( + opcode : A_MUL; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#1#247#132; + flags : if_8086 + ), + ( + opcode : A_MUL; + ops : 1; + optypes : (ot_rm_gpr or ot_bits8,ot_none,ot_none,ot_none); + code : #1#246#132; + flags : if_8086 + ), + ( + opcode : A_MWAIT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#201; + flags : if_prescott + ), + ( + opcode : A_MWAIT; + ops : 2; + optypes : (ot_reg_eax,ot_reg_ecx,ot_none,ot_none); + code : #3#15#1#201; + flags : if_prescott + ), + ( + opcode : A_NEG; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#1#247#131; + flags : if_8086 + ), + ( + opcode : A_NEG; + ops : 1; + optypes : (ot_rm_gpr or ot_bits8,ot_none,ot_none,ot_none); + code : #1#246#131; + flags : if_8086 + ), + ( + opcode : A_NOP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#144; + flags : if_8086 + ), + ( + opcode : A_NOT; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#1#247#130; + flags : if_8086 + ), + ( + opcode : A_NOT; + ops : 1; + optypes : (ot_rm_gpr or ot_bits8,ot_none,ot_none,ot_none); + code : #1#246#130; + flags : if_8086 + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#9#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#11#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#8#65; + flags : if_8086 + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#10#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #208#1#131#129#13; + flags : if_8086 + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_reg_eax,ot_immediate,ot_none,ot_none); + code : #213#1#13#33; + flags : if_386 or if_sm + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #213#1#129#129#33; + flags : if_386 or if_sm + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_reg_ax,ot_immediate,ot_none,ot_none); + code : #212#1#13#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#129#129#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#12#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#128#129#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_OUT; + ops : 2; + optypes : (ot_immediate,ot_reg_al,ot_none,ot_none); + code : #1#230#20; + flags : if_8086 or if_sb + ), + ( + opcode : A_OUT; + ops : 2; + optypes : (ot_immediate,ot_reg_ax,ot_none,ot_none); + code : #212#1#231#20; + flags : if_8086 or if_sb + ), + ( + opcode : A_OUT; + ops : 2; + optypes : (ot_immediate,ot_reg_eax,ot_none,ot_none); + code : #213#1#231#20; + flags : if_386 or if_sb + ), + ( + opcode : A_OUT; + ops : 2; + optypes : (ot_reg_dx,ot_reg_al,ot_none,ot_none); + code : #1#238; + flags : if_8086 + ), + ( + opcode : A_OUT; + ops : 2; + optypes : (ot_reg_dx,ot_reg_ax,ot_none,ot_none); + code : #212#1#239; + flags : if_8086 + ), + ( + opcode : A_OUT; + ops : 2; + optypes : (ot_reg_dx,ot_reg_eax,ot_none,ot_none); + code : #213#1#239; + flags : if_386 + ), + ( + opcode : A_OUTSB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#110; + flags : if_186 + ), + ( + opcode : A_OUTSD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#111; + flags : if_386 + ), + ( + opcode : A_OUTSW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#111; + flags : if_186 + ), + ( + opcode : A_PACKSSDW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#107#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PACKSSDW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#107#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PACKSSWB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#99#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PACKSSWB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#99#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PACKUSWB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#103#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PACKUSWB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#103#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PADDB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#252#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PADDB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#252#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PADDD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#254#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PADDD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#254#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PADDSB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#236#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PADDSB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#236#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PADDSIW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#81#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PADDSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#237#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PADDSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#237#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PADDUSB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#220#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PADDUSB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#220#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PADDUSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#221#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PADDUSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#221#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PADDW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#253#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PADDW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#253#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PAND; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#219#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PAND; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#219#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PANDN; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#223#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PANDN; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#223#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PAVEB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#80#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PAVGUSB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#191; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PCMPEQB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#116#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PCMPEQB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#116#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PCMPEQD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#118#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PCMPEQD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#118#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PCMPEQW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#117#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PCMPEQW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#117#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PCMPGTB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#100#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PCMPGTB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#100#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PCMPGTD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#102#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PCMPGTD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#102#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PCMPGTW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#101#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PCMPGTW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#101#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PDISTIB; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #2#15#84#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PF2ID; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#29; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFACC; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#174; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFADD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#158; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFCMPEQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#176; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFCMPGE; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#144; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFCMPGT; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#160; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFMAX; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#164; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFMIN; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#148; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFMUL; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#180; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFRCP; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#150; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFRCPIT1; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#166; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFRCPIT2; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#182; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFRSQIT1; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#167; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFRSQRT; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#151; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFSUB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#154; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFSUBR; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#170; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PI2FD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#13; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PMACHRIW; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #2#15#94#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PMADDWD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#245#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PMADDWD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#245#72; + flags : if_willamette or if_sm or if_sse2 + ), + ( + opcode : A_PMAGW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#82#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PMULHRIW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#93#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PMULHRWA; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#183; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PMULHRWC; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#89#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PMULHW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#229#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PMULHW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#229#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PMULLW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#213#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PMULLW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#213#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PMVGEZB; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #2#15#92#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PMVLZB; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #2#15#91#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PMVNZB; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #2#15#90#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PMVZB; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #2#15#88#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_POP; + ops : 1; + optypes : (ot_reg16,ot_none,ot_none,ot_none); + code : #212#8#88; + flags : if_8086 + ), + ( + opcode : A_POP; + ops : 1; + optypes : (ot_reg32,ot_none,ot_none,ot_none); + code : #213#8#88; + flags : if_386 or if_nox86_64 + ), + ( + opcode : A_POP; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none); + code : #212#1#143#128; + flags : if_8086 + ), + ( + opcode : A_POP; + ops : 1; + optypes : (ot_rm_gpr or ot_bits32,ot_none,ot_none,ot_none); + code : #213#1#143#128; + flags : if_386 or if_nox86_64 + ), + ( + opcode : A_POP; + ops : 1; + optypes : (ot_reg_cs,ot_none,ot_none,ot_none); + code : #1#15; + flags : if_8086 or if_undoc + ), + ( + opcode : A_POP; + ops : 1; + optypes : (ot_reg_dess,ot_none,ot_none,ot_none); + code : #4; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_POP; + ops : 1; + optypes : (ot_reg_fsgs,ot_none,ot_none,ot_none); + code : #1#15#5#221; + flags : if_386 + ), + ( + opcode : A_POPA; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #215#1#97; + flags : if_186 or if_nox86_64 + ), + ( + opcode : A_POPAD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#97; + flags : if_386 or if_nox86_64 + ), + ( + opcode : A_POPAW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#97; + flags : if_186 or if_nox86_64 + ), + ( + opcode : A_POPF; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #215#1#157; + flags : if_186 or if_nox86_64 + ), + ( + opcode : A_POPFD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#157; + flags : if_386 or if_nox86_64 + ), + ( + opcode : A_POPFW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#157; + flags : if_186 or if_nox86_64 + ), + ( + opcode : A_POR; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#235#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_POR; + ops : 2; + optypes : (ot_xmmreg,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#235#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PREFETCH; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#13#128; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PREFETCHW; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#13#129; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PSLLD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#242#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSLLD; + ops : 2; + optypes : (ot_mmxreg,ot_immediate,ot_none,ot_none); + code : #2#15#114#134#21; + flags : if_pent or if_mmx or if_sb or if_ar1 + ), + ( + opcode : A_PSLLD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#242#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSLLD; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#114#134#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSLLDQ; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#115#135#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSLLQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#243#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSLLQ; + ops : 2; + optypes : (ot_mmxreg,ot_immediate,ot_none,ot_none); + code : #2#15#115#134#21; + flags : if_pent or if_mmx or if_sb or if_ar1 + ), + ( + opcode : A_PSLLQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#243#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSLLQ; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#115#134#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSLLW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#241#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSLLW; + ops : 2; + optypes : (ot_mmxreg,ot_immediate,ot_none,ot_none); + code : #2#15#113#134#21; + flags : if_pent or if_mmx or if_sb or if_ar1 + ), + ( + opcode : A_PSLLW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#241#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSLLW; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#113#134#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSRAD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#226#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSRAD; + ops : 2; + optypes : (ot_mmxreg,ot_immediate,ot_none,ot_none); + code : #2#15#114#132#21; + flags : if_pent or if_mmx or if_sb or if_ar1 + ), + ( + opcode : A_PSRAD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#226#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSRAD; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#114#132#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSRAW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#225#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSRAW; + ops : 2; + optypes : (ot_mmxreg,ot_immediate,ot_none,ot_none); + code : #2#15#113#132#21; + flags : if_pent or if_mmx or if_sb or if_ar1 + ), + ( + opcode : A_PSRAW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#225#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSRAW; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#113#132#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSRLD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#210#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSRLD; + ops : 2; + optypes : (ot_mmxreg,ot_immediate,ot_none,ot_none); + code : #2#15#114#130#21; + flags : if_pent or if_mmx or if_sb or if_ar1 + ), + ( + opcode : A_PSRLD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#210#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSRLD; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#114#130#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSRLQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#211#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSRLQ; + ops : 2; + optypes : (ot_mmxreg,ot_immediate,ot_none,ot_none); + code : #2#15#115#130#21; + flags : if_pent or if_mmx or if_sb or if_ar1 + ), + ( + opcode : A_PSRLQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#211#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSRLQ; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#115#130#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSRLW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#209#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSRLW; + ops : 2; + optypes : (ot_mmxreg,ot_immediate,ot_none,ot_none); + code : #2#15#113#130#21; + flags : if_pent or if_mmx or if_sb or if_ar1 + ), + ( + opcode : A_PSRLW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#209#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSRLW; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#113#130#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSUBB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#248#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSUBB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#248#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSUBD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#250#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSUBD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#250#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSUBSB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#232#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSUBSB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#232#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSUBSIW; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #2#15#85#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PSUBSIW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxreg,ot_none,ot_none); + code : #2#15#85#72; + flags : if_pent or if_mmx or if_cyrix + ), + ( + opcode : A_PSUBSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#233#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSUBSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#233#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSUBUSB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#216#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSUBUSB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#216#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSUBUSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#217#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSUBUSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#217#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSUBW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#249#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSUBW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#249#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PUNPCKHBW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#104#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PUNPCKHBW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#104#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PUNPCKHDQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#106#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PUNPCKHDQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#106#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PUNPCKHWD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#105#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PUNPCKHWD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#105#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PUNPCKLBW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#96#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PUNPCKLBW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#96#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PUNPCKLDQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#98#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PUNPCKLDQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#98#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PUNPCKLWD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#97#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PUNPCKLWD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#97#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PUSH; + ops : 1; + optypes : (ot_reg16,ot_none,ot_none,ot_none); + code : #212#8#80; + flags : if_8086 + ), + ( + opcode : A_PUSH; + ops : 1; + optypes : (ot_reg32,ot_none,ot_none,ot_none); + code : #213#8#80; + flags : if_386 or if_nox86_64 + ), + ( + opcode : A_PUSH; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none); + code : #212#1#255#134; + flags : if_8086 + ), + ( + opcode : A_PUSH; + ops : 1; + optypes : (ot_rm_gpr or ot_bits32,ot_none,ot_none,ot_none); + code : #213#1#255#134; + flags : if_386 or if_nox86_64 + ), + ( + opcode : A_PUSH; + ops : 1; + optypes : (ot_immediate or ot_bits32,ot_none,ot_none,ot_none); + code : #213#1#104#32#221; + flags : if_386 + ), + ( + opcode : A_PUSH; + ops : 1; + optypes : (ot_immediate or ot_bits16,ot_none,ot_none,ot_none); + code : #212#1#104#24#221; + flags : if_286 + ), + ( + opcode : A_PUSH; + ops : 1; + optypes : (ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none,ot_none); + code : #1#106#12#221; + flags : if_286 + ), + ( + opcode : A_PUSH; + ops : 1; + optypes : (ot_reg_fsgs,ot_none,ot_none,ot_none); + code : #1#15#7#221; + flags : if_386 or if_nox86_64 + ), + ( + opcode : A_PUSH; + ops : 1; + optypes : (ot_reg_sreg,ot_none,ot_none,ot_none); + code : #6; + flags : if_8086 or if_nox86_64 + ), + ( + opcode : A_PUSHA; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #215#1#96; + flags : if_186 or if_nox86_64 + ), + ( + opcode : A_PUSHAD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#96; + flags : if_386 or if_nox86_64 + ), + ( + opcode : A_PUSHAW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#96; + flags : if_186 or if_nox86_64 + ), + ( + opcode : A_PUSHF; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #215#1#156; + flags : if_186 + ), + ( + opcode : A_PUSHFD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#156; + flags : if_386 or if_nox86_64 + ), + ( + opcode : A_PUSHFW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#156; + flags : if_186 + ), + ( + opcode : A_PXOR; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#239#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PXOR; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#239#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_RCL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_unity,ot_none,ot_none); + code : #208#1#209#130; + flags : if_8086 + ), + ( + opcode : A_RCL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none,ot_none); + code : #208#1#211#130; + flags : if_8086 + ), + ( + opcode : A_RCL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#1#193#130#21; + flags : if_8086 or if_sb + ), + ( + opcode : A_RCL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_unity,ot_none,ot_none); + code : #1#208#130; + flags : if_8086 + ), + ( + opcode : A_RCL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg_cl,ot_none,ot_none); + code : #1#210#130; + flags : if_8086 + ), + ( + opcode : A_RCL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#192#130#21; + flags : if_186 or if_sb + ), + ( + opcode : A_RCR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_unity,ot_none,ot_none); + code : #208#1#209#131; + flags : if_8086 + ), + ( + opcode : A_RCR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none,ot_none); + code : #208#1#211#131; + flags : if_8086 + ), + ( + opcode : A_RCR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#1#193#131#21; + flags : if_8086 or if_sb + ), + ( + opcode : A_RCR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_unity,ot_none,ot_none); + code : #1#208#131; + flags : if_8086 + ), + ( + opcode : A_RCR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg_cl,ot_none,ot_none); + code : #1#210#131; + flags : if_8086 + ), + ( + opcode : A_RCR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#192#131#21; + flags : if_186 or if_sb + ), + ( + opcode : A_RDSHR; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#54; + flags : if_p6 or if_cyrix or if_smm + ), + ( + opcode : A_RDMSR; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#50; + flags : if_pent or if_priv + ), + ( + opcode : A_RDPMC; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#51; + flags : if_p6 + ), + ( + opcode : A_RDTSC; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#49; + flags : if_pent + ), + ( + opcode : A_REP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#243; + flags : if_8086 or if_pre + ), + ( + opcode : A_REPE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#243; + flags : if_8086 or if_pre + ), + ( + opcode : A_REPNE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#242; + flags : if_8086 or if_pre + ), + ( + opcode : A_REPNZ; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#242; + flags : if_8086 or if_pre + ), + ( + opcode : A_REPZ; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#243; + flags : if_8086 or if_pre + ), + ( + opcode : A_RET; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#195; + flags : if_8086 + ), + ( + opcode : A_RET; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #1#194#24; + flags : if_8086 or if_sw + ), + ( + opcode : A_RETF; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#203; + flags : if_8086 + ), + ( + opcode : A_RETF; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #1#202#24; + flags : if_8086 or if_sw + ), + ( + opcode : A_RETN; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#195; + flags : if_8086 + ), + ( + opcode : A_RETN; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #1#194#24; + flags : if_8086 or if_sw + ), + ( + opcode : A_ROL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_unity,ot_none,ot_none); + code : #208#1#209#128; + flags : if_8086 + ), + ( + opcode : A_ROL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none,ot_none); + code : #208#1#211#128; + flags : if_8086 + ), + ( + opcode : A_ROL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#1#193#128#21; + flags : if_8086 or if_sb + ), + ( + opcode : A_ROL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_unity,ot_none,ot_none); + code : #1#208#128; + flags : if_8086 + ), + ( + opcode : A_ROL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg_cl,ot_none,ot_none); + code : #1#210#128; + flags : if_8086 + ), + ( + opcode : A_ROL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#192#128#21; + flags : if_186 or if_sb + ), + ( + opcode : A_ROR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_unity,ot_none,ot_none); + code : #208#1#209#129; + flags : if_8086 + ), + ( + opcode : A_ROR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none,ot_none); + code : #208#1#211#129; + flags : if_8086 + ), + ( + opcode : A_ROR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#1#193#129#21; + flags : if_8086 or if_sb + ), + ( + opcode : A_ROR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_unity,ot_none,ot_none); + code : #1#208#129; + flags : if_8086 + ), + ( + opcode : A_ROR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg_cl,ot_none,ot_none); + code : #1#210#129; + flags : if_8086 + ), + ( + opcode : A_ROR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#192#129#21; + flags : if_186 or if_sb + ), + ( + opcode : A_RSDC; + ops : 2; + optypes : (ot_reg_sreg,ot_memory or ot_bits80,ot_none,ot_none); + code : #2#15#121#65; + flags : if_486 or if_cyrix or if_smm + ), + ( + opcode : A_RSLDT; + ops : 1; + optypes : (ot_memory or ot_bits80,ot_none,ot_none,ot_none); + code : #2#15#123#128; + flags : if_486 or if_cyrix or if_smm + ), + ( + opcode : A_RSM; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#170; + flags : if_pent or if_smm + ), + ( + opcode : A_SAHF; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#158; + flags : if_8086 + ), + ( + opcode : A_SAL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_unity,ot_none,ot_none); + code : #208#1#209#132; + flags : if_8086 + ), + ( + opcode : A_SAL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none,ot_none); + code : #208#1#211#132; + flags : if_8086 + ), + ( + opcode : A_SAL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#1#193#132#21; + flags : if_8086 or if_sb + ), + ( + opcode : A_SAL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_unity,ot_none,ot_none); + code : #1#208#132; + flags : if_8086 + ), + ( + opcode : A_SAL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg_cl,ot_none,ot_none); + code : #1#210#132; + flags : if_8086 + ), + ( + opcode : A_SAL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#192#132#21; + flags : if_186 or if_sb + ), + ( + opcode : A_SALC; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#214; + flags : if_8086 or if_undoc or if_nox86_64 + ), + ( + opcode : A_SAR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_unity,ot_none,ot_none); + code : #208#1#209#135; + flags : if_8086 + ), + ( + opcode : A_SAR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none,ot_none); + code : #208#1#211#135; + flags : if_8086 + ), + ( + opcode : A_SAR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#1#193#135#21; + flags : if_8086 or if_sb + ), + ( + opcode : A_SAR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_unity,ot_none,ot_none); + code : #1#208#135; + flags : if_8086 + ), + ( + opcode : A_SAR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg_cl,ot_none,ot_none); + code : #1#210#135; + flags : if_8086 + ), + ( + opcode : A_SAR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#192#135#21; + flags : if_186 or if_sb + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#25#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#27#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #208#1#131#131#13; + flags : if_8086 + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#24#65; + flags : if_8086 + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#26#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_reg_eax,ot_immediate,ot_none,ot_none); + code : #213#1#29#33; + flags : if_386 or if_sm + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #208#1#129#131#33; + flags : if_386 or if_sm + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_reg_ax,ot_immediate,ot_none,ot_none); + code : #212#1#29#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #208#1#129#131#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#28#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#128#131#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_SCASB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #218#1#174; + flags : if_8086 + ), + ( + opcode : A_SCASD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #218#213#1#175; + flags : if_386 + ), + ( + opcode : A_SCASW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #218#212#1#175; + flags : if_8086 + ), + ( + opcode : A_SEGCS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#46; + flags : if_8086 or if_pre + ), + ( + opcode : A_SEGDS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#62; + flags : if_8086 or if_pre + ), + ( + opcode : A_SEGES; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#38; + flags : if_8086 or if_pre + ), + ( + opcode : A_SEGFS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#100; + flags : if_8086 or if_pre + ), + ( + opcode : A_SEGGS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#101; + flags : if_8086 or if_pre + ), + ( + opcode : A_SEGSS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#54; + flags : if_8086 or if_pre + ), + ( + opcode : A_SGDT; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#1#128; + flags : if_286 + ), + ( + opcode : A_SHL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_unity,ot_none,ot_none); + code : #208#1#209#132; + flags : if_8086 + ), + ( + opcode : A_SHL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none,ot_none); + code : #208#1#211#132; + flags : if_8086 + ), + ( + opcode : A_SHL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#1#193#132#21; + flags : if_186 or if_sw + ), + ( + opcode : A_SHL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_unity,ot_none,ot_none); + code : #1#208#132; + flags : if_8086 + ), + ( + opcode : A_SHL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg_cl,ot_none,ot_none); + code : #1#210#132; + flags : if_8086 + ), + ( + opcode : A_SHL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#192#132#21; + flags : if_186 or if_sb + ), + ( + opcode : A_SHLD; + ops : 3; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg16 or ot_bits32 or ot_bits64,ot_immediate,ot_none); + code : #209#2#15#164#65#22; + flags : if_386 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_SHLD; + ops : 3; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none); + code : #209#2#15#165#65; + flags : if_386 or if_sm + ), + ( + opcode : A_SHR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_unity,ot_none,ot_none); + code : #208#1#209#133; + flags : if_8086 + ), + ( + opcode : A_SHR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none,ot_none); + code : #208#1#211#133; + flags : if_8086 + ), + ( + opcode : A_SHR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#1#193#133#21; + flags : if_186 or if_sw + ), + ( + opcode : A_SHR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_unity,ot_none,ot_none); + code : #1#208#133; + flags : if_8086 + ), + ( + opcode : A_SHR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg_cl,ot_none,ot_none); + code : #1#210#133; + flags : if_8086 + ), + ( + opcode : A_SHR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#192#133#21; + flags : if_186 or if_sb + ), + ( + opcode : A_SHRD; + ops : 3; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg16 or ot_bits32 or ot_bits64,ot_immediate,ot_none); + code : #209#2#15#172#65#22; + flags : if_386 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_SHRD; + ops : 3; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none); + code : #209#2#15#173#65; + flags : if_386 or if_sm + ), + ( + opcode : A_SIDT; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#1#129; + flags : if_286 + ), + ( + opcode : A_SLDT; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#0#128; + flags : if_286 + ), + ( + opcode : A_SLDT; + ops : 1; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#2#15#0#128; + flags : if_286 + ), + ( + opcode : A_SMI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#241; + flags : if_386 or if_undoc + ), + ( + opcode : A_SMINT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#56; + flags : if_p6 or if_cyrix + ), + ( + opcode : A_SMINTOLD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#126; + flags : if_486 or if_cyrix + ), + ( + opcode : A_SMSW; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#2#15#1#132; + flags : if_286 + ), + ( + opcode : A_STC; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#249; + flags : if_8086 + ), + ( + opcode : A_STD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#253; + flags : if_8086 + ), + ( + opcode : A_STI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#251; + flags : if_8086 + ), + ( + opcode : A_STOSB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#170; + flags : if_8086 + ), + ( + opcode : A_STOSD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#171; + flags : if_386 + ), + ( + opcode : A_STOSW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#171; + flags : if_8086 + ), + ( + opcode : A_STR; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#0#129; + flags : if_286 or if_prot + ), + ( + opcode : A_STR; + ops : 1; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#2#15#0#129; + flags : if_286 or if_prot + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#41#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#43#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#40#65; + flags : if_8086 + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#42#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #208#1#131#133#13; + flags : if_8086 + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_reg_eax,ot_immediate,ot_none,ot_none); + code : #213#1#45#33; + flags : if_386 or if_sm + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #208#1#129#133#33; + flags : if_386 or if_sm + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_reg_ax,ot_immediate,ot_none,ot_none); + code : #212#1#45#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#129#133#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#44#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#128#133#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_SVDC; + ops : 2; + optypes : (ot_memory or ot_bits80,ot_reg_sreg,ot_none,ot_none); + code : #2#15#120#65; + flags : if_486 or if_cyrix or if_smm + ), + ( + opcode : A_SVLDT; + ops : 1; + optypes : (ot_memory or ot_bits80,ot_none,ot_none,ot_none); + code : #2#15#122#128; + flags : if_486 or if_cyrix or if_smm + ), + ( + opcode : A_SVTS; + ops : 1; + optypes : (ot_memory or ot_bits80,ot_none,ot_none,ot_none); + code : #2#15#124#128; + flags : if_486 or if_cyrix or if_smm + ), + ( + opcode : A_SYSCALL; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#5; + flags : if_p6 or if_amd + ), + ( + opcode : A_SYSENTER; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#52; + flags : if_p6 + ), + ( + opcode : A_SYSEXIT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#53; + flags : if_p6 or if_priv + ), + ( + opcode : A_SYSRET; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#7; + flags : if_p6 or if_priv or if_amd + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#133#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_memory,ot_none,ot_none); + code : #208#1#133#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_reg8,ot_reg8,ot_none,ot_none); + code : #1#132#65; + flags : if_8086 + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#132#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_reg_eax,ot_immediate,ot_none,ot_none); + code : #213#1#169#33; + flags : if_386 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_reg_ax,ot_immediate,ot_none,ot_none); + code : #212#1#169#25; + flags : if_8086 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#168#17; + flags : if_8086 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #213#1#247#128#33; + flags : if_386 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#247#128#25; + flags : if_8086 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#246#128#17; + flags : if_8086 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_memory,ot_immediate or ot_bits32,ot_none,ot_none); + code : #213#1#247#128#33; + flags : if_386 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_memory,ot_immediate or ot_bits16,ot_none,ot_none); + code : #212#1#247#128#25; + flags : if_8086 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_memory,ot_immediate or ot_bits8,ot_none,ot_none); + code : #1#246#128#17; + flags : if_8086 or if_sm + ), + ( + opcode : A_UD1; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#185; + flags : if_286 or if_undoc + ), + ( + opcode : A_UD2; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#11; + flags : if_286 + ), + ( + opcode : A_UMOV; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#17#65; + flags : if_386 or if_undoc or if_sm + ), + ( + opcode : A_UMOV; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_memory,ot_none,ot_none); + code : #208#2#15#19#72; + flags : if_386 or if_undoc or if_sm + ), + ( + opcode : A_UMOV; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #2#15#16#65; + flags : if_386 or if_undoc + ), + ( + opcode : A_UMOV; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #2#15#18#72; + flags : if_386 or if_undoc + ), + ( + opcode : A_VERR; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#0#132; + flags : if_286 or if_prot + ), + ( + opcode : A_VERR; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #2#15#0#132; + flags : if_286 or if_prot + ), + ( + opcode : A_VERR; + ops : 1; + optypes : (ot_reg16,ot_none,ot_none,ot_none); + code : #2#15#0#132; + flags : if_286 or if_prot + ), + ( + opcode : A_VERW; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#0#133; + flags : if_286 or if_prot + ), + ( + opcode : A_VERW; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #2#15#0#133; + flags : if_286 or if_prot + ), + ( + opcode : A_VERW; + ops : 1; + optypes : (ot_reg16,ot_none,ot_none,ot_none); + code : #2#15#0#133; + flags : if_286 or if_prot + ), + ( + opcode : A_WAIT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#155; + flags : if_8086 + ), + ( + opcode : A_WBINVD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#9; + flags : if_486 or if_priv + ), + ( + opcode : A_WRSHR; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#55; + flags : if_p6 or if_cyrix or if_smm + ), + ( + opcode : A_WRMSR; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#48; + flags : if_pent or if_priv + ), + ( + opcode : A_XADD; + ops : 2; + optypes : (ot_memory,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#193#65; + flags : if_486 or if_sm + ), + ( + opcode : A_XADD; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #2#15#192#65; + flags : if_486 + ), + ( + opcode : A_XBTS; + ops : 2; + optypes : (ot_reg16,ot_memory,ot_none,ot_none); + code : #212#2#15#166#72; + flags : if_386 or if_sw or if_undoc + ), + ( + opcode : A_XBTS; + ops : 2; + optypes : (ot_reg16,ot_reg16,ot_none,ot_none); + code : #212#2#15#166#72; + flags : if_386 or if_undoc + ), + ( + opcode : A_XBTS; + ops : 2; + optypes : (ot_reg32,ot_memory,ot_none,ot_none); + code : #213#2#15#166#72; + flags : if_386 or if_sd or if_undoc + ), + ( + opcode : A_XBTS; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #213#2#15#166#72; + flags : if_386 or if_undoc + ), + ( + opcode : A_XCHG; + ops : 2; + optypes : (ot_reg_ax,ot_reg16,ot_none,ot_none); + code : #212#9#144; + flags : if_8086 + ), + ( + opcode : A_XCHG; + ops : 2; + optypes : (ot_reg_eax,ot_reg32,ot_none,ot_none); + code : #213#9#144; + flags : if_386 + ), + ( + opcode : A_XCHG; + ops : 2; + optypes : (ot_reg16,ot_reg_ax,ot_none,ot_none); + code : #212#8#144; + flags : if_8086 + ), + ( + opcode : A_XCHG; + ops : 2; + optypes : (ot_reg32,ot_reg_eax,ot_none,ot_none); + code : #213#8#144; + flags : if_386 + ), + ( + opcode : A_XCHG; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#135#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_XCHG; + ops : 2; + optypes : (ot_memory,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#135#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_XCHG; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#134#72; + flags : if_8086 + ), + ( + opcode : A_XCHG; + ops : 2; + optypes : (ot_memory or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#134#65; + flags : if_8086 + ), + ( + opcode : A_XLAT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#215; + flags : if_8086 + ), + ( + opcode : A_XLATB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#215; + flags : if_8086 + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#49#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#51#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#48#65; + flags : if_8086 + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#50#72; + flags : if_8086 + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #208#1#131#134#13; + flags : if_8086 + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_reg_eax,ot_immediate,ot_none,ot_none); + code : #213#1#53#33; + flags : if_386 or if_sm + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #208#1#129#134#33; + flags : if_386 or if_sm + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_reg_ax,ot_immediate,ot_none,ot_none); + code : #212#1#53#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#129#134#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#52#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#128#134#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_XSTORE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#167#192; + flags : if_p6 or if_cyrix + ), + ( + opcode : A_XCRYPTECB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #219#3#15#167#200; + flags : if_p6 or if_cyrix + ), + ( + opcode : A_XCRYPTCBC; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #219#3#15#167#208; + flags : if_p6 or if_cyrix + ), + ( + opcode : A_XCRYPTCFB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #219#3#15#167#224; + flags : if_p6 or if_cyrix + ), + ( + opcode : A_XCRYPTOFB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #219#3#15#167#232; + flags : if_p6 or if_cyrix + ), + ( + opcode : A_CMOVcc; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#15#11#64#72; + flags : if_p6 or if_sm + ), + ( + opcode : A_Jcc; + ops : 1; + optypes : (ot_immediate or ot_bits8,ot_none,ot_none,ot_none); + code : #11#112#40; + flags : if_8086 + ), + ( + opcode : A_Jcc; + ops : 1; + optypes : (ot_immediate or ot_bits16 or ot_bits32,ot_none,ot_none,ot_none); + code : #208#1#15#11#128#52; + flags : if_386 or if_pass2 + ), + ( + opcode : A_Jcc; + ops : 1; + optypes : (ot_immediate or ot_short,ot_none,ot_none,ot_none); + code : #11#112#40; + flags : if_8086 + ), + ( + opcode : A_Jcc; + ops : 1; + optypes : (ot_immediate or ot_near,ot_none,ot_none,ot_none); + code : #208#1#15#11#128#52; + flags : if_386 or if_pass2 + ), + ( + opcode : A_SETcc; + ops : 1; + optypes : (ot_rm_gpr or ot_bits8,ot_none,ot_none,ot_none); + code : #1#15#11#144#128; + flags : if_386 + ), + ( + opcode : A_ADDPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#88#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_ADDSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#88#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_ANDNPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#85#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_ANDPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#84#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPEQPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#194#72#1#0; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPEQSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#194#72#1#0; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPLEPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#194#72#1#2; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPLESS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#194#72#1#2; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPLTPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#194#72#1#1; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPLTSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#194#72#1#1; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPNEQPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#194#72#1#4; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPNEQSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#194#72#1#4; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPNLEPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#194#72#1#6; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPNLESS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#194#72#1#6; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPNLTPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#194#72#1#5; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPNLTSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#194#72#1#5; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPORDPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#194#72#1#7; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPORDSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#194#72#1#7; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPUNORDPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#194#72#1#3; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPUNORDSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#194#72#1#3; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPPS; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #217#2#15#194#72#18; + flags : if_katmai or if_sse or if_sb or if_ar2 + ), + ( + opcode : A_CMPSS; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #219#2#15#194#72#18; + flags : if_katmai or if_sse or if_sb or if_ar2 + ), + ( + opcode : A_COMISS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#47#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_CVTPI2PS; + ops : 2; + optypes : (ot_xmmreg,ot_memory,ot_none,ot_none); + code : #217#2#15#42#72; + flags : if_katmai or if_sse or if_mmx + ), + ( + opcode : A_CVTPI2PS; + ops : 2; + optypes : (ot_xmmreg,ot_mmxreg,ot_none,ot_none); + code : #217#2#15#42#72; + flags : if_katmai or if_sse or if_mmx + ), + ( + opcode : A_CVTPS2PI; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #217#2#15#45#72; + flags : if_katmai or if_sse or if_mmx + ), + ( + opcode : A_CVTPS2PI; + ops : 2; + optypes : (ot_mmxreg,ot_xmmreg,ot_none,ot_none); + code : #217#2#15#45#72; + flags : if_katmai or if_sse or if_mmx + ), + ( + opcode : A_CVTSI2SS; + ops : 2; + optypes : (ot_xmmreg,ot_memory,ot_none,ot_none); + code : #219#209#2#15#42#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_CVTSI2SS; + ops : 2; + optypes : (ot_xmmreg,ot_reg32 or ot_bits64,ot_none,ot_none); + code : #219#209#2#15#42#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_CVTSS2SI; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_memory,ot_none,ot_none); + code : #219#208#2#15#45#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_CVTSS2SI; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_xmmreg,ot_none,ot_none); + code : #219#208#2#15#45#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_CVTTPS2PI; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #217#2#15#44#72; + flags : if_katmai or if_sse or if_mmx + ), + ( + opcode : A_CVTTPS2PI; + ops : 2; + optypes : (ot_mmxreg,ot_xmmreg,ot_none,ot_none); + code : #217#2#15#44#72; + flags : if_katmai or if_sse or if_mmx + ), + ( + opcode : A_CVTTSS2SI; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_memory,ot_none,ot_none); + code : #219#208#2#15#44#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_CVTTSS2SI; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_xmmreg,ot_none,ot_none); + code : #219#208#2#15#44#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_DIVPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#94#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_DIVSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#94#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_LDMXCSR; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#174#130; + flags : if_katmai or if_sse or if_sd + ), + ( + opcode : A_MAXPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#95#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MAXSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#95#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MINPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#93#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MINSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#93#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVAPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#40#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVAPS; + ops : 2; + optypes : (ot_xmmrm,ot_xmmreg,ot_none,ot_none); + code : #2#15#41#65; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVHPS; + ops : 2; + optypes : (ot_xmmreg,ot_memory,ot_none,ot_none); + code : #2#15#22#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVHPS; + ops : 2; + optypes : (ot_memory,ot_xmmreg,ot_none,ot_none); + code : #2#15#23#65; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVLHPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmreg,ot_none,ot_none); + code : #2#15#22#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVLPS; + ops : 2; + optypes : (ot_xmmreg,ot_memory,ot_none,ot_none); + code : #2#15#18#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVLPS; + ops : 2; + optypes : (ot_memory,ot_xmmreg,ot_none,ot_none); + code : #2#15#19#65; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVHLPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmreg,ot_none,ot_none); + code : #2#15#18#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVMSKPS; + ops : 2; + optypes : (ot_reg32,ot_xmmreg,ot_none,ot_none); + code : #2#15#80#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVNTPS; + ops : 2; + optypes : (ot_memory,ot_xmmreg,ot_none,ot_none); + code : #2#15#43#65; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#16#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVSS; + ops : 2; + optypes : (ot_xmmrm,ot_xmmreg,ot_none,ot_none); + code : #219#2#15#17#65; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVUPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#16#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVUPS; + ops : 2; + optypes : (ot_xmmrm,ot_xmmreg,ot_none,ot_none); + code : #217#2#15#17#65; + flags : if_katmai or if_sse + ), + ( + opcode : A_MULPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#89#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MULSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#89#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_ORPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#86#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_RCPPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#83#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_RCPSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#83#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_RSQRTPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#82#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_RSQRTSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#82#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_SHUFPS; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #2#15#198#72#18; + flags : if_katmai or if_sse or if_sb or if_ar2 + ), + ( + opcode : A_SQRTPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#81#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_SQRTSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#81#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_STMXCSR; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#174#131; + flags : if_katmai or if_sse or if_sd + ), + ( + opcode : A_SUBPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#92#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_SUBSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#92#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_UCOMISS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#46#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_UNPCKHPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#21#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_UNPCKLPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#20#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_XORPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#87#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_FXRSTOR; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#174#129; + flags : if_p6 or if_sse or if_fpu + ), + ( + opcode : A_FXSAVE; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#174#128; + flags : if_p6 or if_sse or if_fpu + ), + ( + opcode : A_PREFETCHNTA; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#24#128; + flags : if_katmai + ), + ( + opcode : A_PREFETCHT0; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#24#129; + flags : if_katmai + ), + ( + opcode : A_PREFETCHT1; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#24#130; + flags : if_katmai + ), + ( + opcode : A_PREFETCHT2; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#24#131; + flags : if_katmai + ), + ( + opcode : A_SFENCE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#174#248; + flags : if_katmai + ), + ( + opcode : A_MASKMOVQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxreg,ot_none,ot_none); + code : #2#15#247#72; + flags : if_katmai or if_mmx + ), + ( + opcode : A_MOVNTQ; + ops : 2; + optypes : (ot_memory,ot_mmxreg,ot_none,ot_none); + code : #2#15#231#65; + flags : if_katmai or if_mmx or if_sm + ), + ( + opcode : A_PAVGB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#224#72; + flags : if_katmai or if_mmx or if_sm + ), + ( + opcode : A_PAVGB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#224#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PAVGW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#227#72; + flags : if_katmai or if_mmx or if_sm + ), + ( + opcode : A_PAVGW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#227#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PEXTRW; + ops : 3; + optypes : (ot_reg32,ot_mmxreg,ot_immediate,ot_none); + code : #2#15#197#72#18; + flags : if_katmai or if_mmx or if_sb or if_ar2 + ), + ( + opcode : A_PEXTRW; + ops : 3; + optypes : (ot_reg32,ot_xmmreg,ot_immediate,ot_none); + code : #241#2#15#197#72#22; + flags : if_sse41 + ), + ( + opcode : A_PEXTRW; + ops : 3; + optypes : (ot_memory or ot_bits32,ot_xmmreg,ot_immediate,ot_none); + code : #241#3#15#58#21#65#22; + flags : if_sse41 + ), + ( + opcode : A_PINSRW; + ops : 3; + optypes : (ot_mmxreg,ot_reg16,ot_immediate,ot_none); + code : #2#15#196#72#18; + flags : if_katmai or if_mmx or if_sb or if_ar2 + ), + ( + opcode : A_PINSRW; + ops : 3; + optypes : (ot_mmxreg,ot_reg32,ot_immediate,ot_none); + code : #2#15#196#72#18; + flags : if_katmai or if_mmx or if_sb or if_ar2 + ), + ( + opcode : A_PINSRW; + ops : 3; + optypes : (ot_mmxreg,ot_memory,ot_immediate,ot_none); + code : #2#15#196#72#18; + flags : if_katmai or if_mmx or if_sb or if_ar2 + ), + ( + opcode : A_PINSRW; + ops : 3; + optypes : (ot_mmxreg,ot_memory or ot_bits16,ot_immediate,ot_none); + code : #2#15#196#72#18; + flags : if_katmai or if_mmx or if_sb or if_ar2 + ), + ( + opcode : A_PINSRW; + ops : 3; + optypes : (ot_xmmreg,ot_reg16,ot_immediate,ot_none); + code : #241#2#15#196#72#22; + flags : if_willamette or if_sse2 or if_sb or if_ar2 + ), + ( + opcode : A_PINSRW; + ops : 3; + optypes : (ot_xmmreg,ot_reg32,ot_immediate,ot_none); + code : #241#2#15#196#72#22; + flags : if_willamette or if_sse2 or if_sb or if_ar2 + ), + ( + opcode : A_PINSRW; + ops : 3; + optypes : (ot_xmmreg,ot_memory,ot_immediate,ot_none); + code : #241#2#15#196#72#22; + flags : if_willamette or if_sse2 or if_sb or if_ar2 + ), + ( + opcode : A_PINSRW; + ops : 3; + optypes : (ot_xmmreg,ot_memory or ot_bits16,ot_immediate,ot_none); + code : #241#2#15#196#72#22; + flags : if_willamette or if_sse2 or if_sb or if_ar2 + ), + ( + opcode : A_PMAXSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#238#72; + flags : if_katmai or if_mmx or if_sm + ), + ( + opcode : A_PMAXSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#238#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PMAXUB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#222#72; + flags : if_katmai or if_mmx or if_sm + ), + ( + opcode : A_PMAXUB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#222#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PMINSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#234#72; + flags : if_katmai or if_mmx or if_sm + ), + ( + opcode : A_PMINSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#234#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PMINUB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#218#72; + flags : if_katmai or if_mmx or if_sm + ), + ( + opcode : A_PMINUB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#218#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PMOVMSKB; + ops : 2; + optypes : (ot_reg32,ot_mmxreg,ot_none,ot_none); + code : #2#15#215#72; + flags : if_katmai or if_mmx + ), + ( + opcode : A_PMOVMSKB; + ops : 2; + optypes : (ot_reg32,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#215#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_PMULHUW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#228#72; + flags : if_katmai or if_mmx or if_sm + ), + ( + opcode : A_PMULHUW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#228#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSADBW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#246#72; + flags : if_katmai or if_mmx or if_sm + ), + ( + opcode : A_PSADBW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#246#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSHUFW; + ops : 3; + optypes : (ot_mmxreg,ot_mmxrm,ot_immediate,ot_none); + code : #2#15#112#72#18; + flags : if_katmai or if_mmx or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PFNACC; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#138; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFPNACC; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#142; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PI2FW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#12; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PF2IW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#28; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PSWAPD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#187; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_FFREEP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#223#8#192; + flags : if_pent or if_3dnow or if_fpu + ), + ( + opcode : A_MASKMOVDQU; + ops : 2; + optypes : (ot_xmmreg,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#247#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CLFLUSH; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#174#135; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVNTDQ; + ops : 2; + optypes : (ot_memory,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#231#65; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MOVNTI; + ops : 2; + optypes : (ot_memory,ot_reg32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#195#65; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MOVNTPD; + ops : 2; + optypes : (ot_memory,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#43#65; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PAUSE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #219#1#144; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_LFENCE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#174#232; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MFENCE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#174#240; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVDQA; + ops : 2; + optypes : (ot_xmmrm,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#127#65; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MOVDQA; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#111#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MOVDQU; + ops : 2; + optypes : (ot_xmmrm,ot_xmmreg,ot_none,ot_none); + code : #219#2#15#127#65; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MOVDQU; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#111#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MOVDQ2Q; + ops : 2; + optypes : (ot_mmxreg,ot_xmmreg,ot_none,ot_none); + code : #220#2#15#214#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVQ2DQ; + ops : 2; + optypes : (ot_xmmreg,ot_mmxreg,ot_none,ot_none); + code : #219#2#15#214#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_PADDQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#212#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PADDQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#212#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PMULUDQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#244#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PMULUDQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#244#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSHUFD; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#2#15#112#72#18; + flags : if_willamette or if_sse2 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PSHUFHW; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #219#2#15#112#72#18; + flags : if_willamette or if_sse2 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PSHUFLW; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #220#2#15#112#72#18; + flags : if_willamette or if_sse2 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PSRLDQ; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#115#131#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSUBQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#251#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSUBQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#251#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PUNPCKHQDQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#109#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PUNPCKLQDQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#108#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_ADDPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#88#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_ADDSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#88#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_ANDNPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#85#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_ANDPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#84#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CMPEQPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#194#72#1#0; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CMPEQSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#194#72#1#0; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CMPLEPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#194#72#1#2; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CMPLESD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#194#72#1#2; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CMPLTPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#194#72#1#1; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CMPLTSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#194#72#1#1; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CMPNEQPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#194#72#1#4; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CMPNEQSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#194#72#1#4; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CMPNLEPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#194#72#1#6; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CMPNLESD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#194#72#1#6; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CMPNLTPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#194#72#1#5; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CMPNLTSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#194#72#1#5; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CMPORDPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#194#72#1#7; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CMPORDSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#194#72#1#7; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CMPUNORDPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#194#72#1#3; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CMPUNORDSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#194#72#1#3; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CMPPD; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#2#15#194#72#22; + flags : if_willamette or if_sse2 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_COMISD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#47#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTDQ2PD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#230#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTDQ2PS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#91#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CVTPD2DQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#230#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CVTPD2PI; + ops : 2; + optypes : (ot_mmxreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#45#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTPD2PS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#90#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CVTPI2PD; + ops : 2; + optypes : (ot_xmmreg,ot_mmxrm,ot_none,ot_none); + code : #241#2#15#42#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTPS2DQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#91#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CVTPS2PD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#90#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTSD2SI; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_xmmreg,ot_none,ot_none); + code : #220#208#2#15#45#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTSD2SI; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_memory,ot_none,ot_none); + code : #220#208#2#15#45#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTSD2SS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#90#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTSI2SD; + ops : 2; + optypes : (ot_xmmreg,ot_reg32 or ot_bits64,ot_none,ot_none); + code : #220#209#2#15#42#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTSI2SD; + ops : 2; + optypes : (ot_xmmreg,ot_memory,ot_none,ot_none); + code : #220#209#2#15#42#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTSS2SD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#90#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTTPD2PI; + ops : 2; + optypes : (ot_mmxreg,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#44#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTTPD2PI; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #241#2#15#44#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTTPD2DQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#230#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CVTTPS2DQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#91#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CVTTSD2SI; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_xmmreg,ot_none,ot_none); + code : #220#208#2#15#44#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTTSD2SI; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_memory,ot_none,ot_none); + code : #220#208#2#15#44#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_DIVPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#94#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_DIVSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#94#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MAXPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#95#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MAXSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#95#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MINPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#93#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MINSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#93#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVAPD; + ops : 2; + optypes : (ot_xmmrm,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#41#65; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MOVAPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#40#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MOVHPD; + ops : 2; + optypes : (ot_memory,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#23#65; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVHPD; + ops : 2; + optypes : (ot_xmmreg,ot_memory,ot_none,ot_none); + code : #241#2#15#22#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVLPD; + ops : 2; + optypes : (ot_memory,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#19#65; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVLPD; + ops : 2; + optypes : (ot_xmmreg,ot_memory,ot_none,ot_none); + code : #241#2#15#18#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVMSKPD; + ops : 2; + optypes : (ot_reg32,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#80#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVUPD; + ops : 2; + optypes : (ot_xmmrm,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#17#65; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MOVUPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#16#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MULPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#89#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MULSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#89#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_ORPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#86#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_SHUFPD; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#2#15#198#72#22; + flags : if_willamette or if_sse2 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_SQRTPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#81#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_SQRTSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#81#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_SUBPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#92#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_SUBSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#92#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_UCOMISD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#46#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_UNPCKHPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#21#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_UNPCKLPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#20#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_XORPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#87#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_ADDSUBPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#208#72; + flags : if_prescott or if_sse3 or if_sm + ), + ( + opcode : A_ADDSUBPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#208#72; + flags : if_prescott or if_sse3 or if_sm + ), + ( + opcode : A_HADDPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#124#72; + flags : if_prescott or if_sse3 or if_sm + ), + ( + opcode : A_HADDPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#124#72; + flags : if_prescott or if_sse3 or if_sm + ), + ( + opcode : A_HSUBPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#125#72; + flags : if_prescott or if_sse3 or if_sm + ), + ( + opcode : A_HSUBPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#125#72; + flags : if_prescott or if_sse3 or if_sm + ), + ( + opcode : A_LDDQU; + ops : 2; + optypes : (ot_xmmreg,ot_memory,ot_none,ot_none); + code : #220#2#15#240#72; + flags : if_prescott or if_sse3 + ), + ( + opcode : A_MOVDDUP; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#18#72; + flags : if_prescott or if_sse3 + ), + ( + opcode : A_MOVSHDUP; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#22#72; + flags : if_prescott or if_sse3 or if_sm + ), + ( + opcode : A_MOVSLDUP; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#18#72; + flags : if_prescott or if_sse3 or if_sm + ), + ( + opcode : A_VMREAD; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #2#15#120#65; + flags : if_386 or if_priv or if_prot + ), + ( + opcode : A_VMREAD; + ops : 2; + optypes : (ot_memory,ot_reg32,ot_none,ot_none); + code : #2#15#120#65; + flags : if_386 or if_priv or if_prot or if_sm + ), + ( + opcode : A_VMWRITE; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #2#15#121#72; + flags : if_386 or if_priv or if_prot + ), + ( + opcode : A_VMWRITE; + ops : 2; + optypes : (ot_reg32,ot_memory,ot_none,ot_none); + code : #2#15#121#72; + flags : if_386 or if_priv or if_prot or if_sm + ), + ( + opcode : A_VMCALL; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#193; + flags : if_386 or if_priv or if_prot + ), + ( + opcode : A_VMLAUNCH; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#194; + flags : if_386 or if_priv or if_prot + ), + ( + opcode : A_VMRESUME; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#195; + flags : if_386 or if_priv or if_prot + ), + ( + opcode : A_VMXOFF; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#196; + flags : if_386 or if_priv or if_prot + ), + ( + opcode : A_VMXON; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #219#2#15#199#134; + flags : if_priv or if_prot + ), + ( + opcode : A_VMCLEAR; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #241#2#15#199#134; + flags : if_priv or if_prot + ), + ( + opcode : A_VMPTRLD; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#199#134; + flags : if_priv or if_prot + ), + ( + opcode : A_VMPTRST; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#199#135; + flags : if_priv or if_prot + ), + ( + opcode : A_VMRUN; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#216; + flags : if_386 or if_svm or if_priv or if_prot + ), + ( + opcode : A_VMMCALL; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#217; + flags : if_386 or if_svm + ), + ( + opcode : A_VMLOAD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#218; + flags : if_386 or if_svm or if_priv or if_prot + ), + ( + opcode : A_VMSAVE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#219; + flags : if_386 or if_svm or if_priv or if_prot + ), + ( + opcode : A_STGI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#220; + flags : if_386 or if_svm or if_priv or if_prot + ), + ( + opcode : A_CLGI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#221; + flags : if_386 or if_svm or if_priv or if_prot + ), + ( + opcode : A_SKINIT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#222; + flags : if_386 or if_svm or if_priv or if_prot + ), + ( + opcode : A_INVLPGA; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#223; + flags : if_386 or if_svm or if_priv or if_prot + ), + ( + opcode : A_MONTMUL; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #219#3#15#166#192; + flags : if_centaur + ), + ( + opcode : A_XSHA1; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #219#3#15#166#200; + flags : if_centaur + ), + ( + opcode : A_XSHA256; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #219#3#15#166#208; + flags : if_centaur + ), + ( + opcode : A_DMINT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#57; + flags : if_p6 or if_cyrix + ), + ( + opcode : A_RDM; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#58; + flags : if_p6 or if_cyrix + ), + ( + opcode : A_MOVNTSS; + ops : 2; + optypes : (ot_memory,ot_xmmreg,ot_none,ot_none); + code : #219#2#15#43#65; + flags : if_sse4 or if_sd + ), + ( + opcode : A_MOVNTSD; + ops : 2; + optypes : (ot_memory,ot_xmmreg,ot_none,ot_none); + code : #220#213#2#15#43#65; + flags : if_sse4 + ), + ( + opcode : A_INSERTQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmreg,ot_none,ot_none); + code : #220#2#15#121#72; + flags : if_sse4 + ), + ( + opcode : A_INSERTQ; + ops : 4; + optypes : (ot_xmmreg,ot_xmmreg,ot_immediate,ot_immediate); + code : #220#2#15#120#72#22#23; + flags : if_sse4 or if_sb + ), + ( + opcode : A_EXTRQ; + ops : 3; + optypes : (ot_xmmreg,ot_immediate,ot_immediate,ot_none); + code : #241#2#15#120#128#21#22; + flags : if_sse4 or if_sb + ), + ( + opcode : A_EXTRQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#121#72; + flags : if_sse4 + ), + ( + opcode : A_LZCNT; + ops : 2; + optypes : (ot_reg16,ot_rm_gpr,ot_none,ot_none); + code : #208#219#2#15#189#72; + flags : if_386 or if_sm or if_sse4 + ), + ( + opcode : A_LZCNT; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #209#219#2#15#189#72; + flags : if_386 or if_sm or if_sse4 + ), + ( + opcode : A_PABSB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#28#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PABSB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#28#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PABSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#29#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PABSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#29#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PABSD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#30#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PABSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#30#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PALIGNR; + ops : 3; + optypes : (ot_mmxreg,ot_mmxrm,ot_immediate,ot_none); + code : #217#3#15#58#15#72#22; + flags : if_ssse3 or if_mmx or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PALIGNR; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#15#72#22; + flags : if_ssse3 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PHADDW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#1#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PHADDW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#1#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PHADDD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#2#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PHADDD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#2#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PHADDSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#3#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PHADDSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#3#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PHSUBW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#5#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PHSUBW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#5#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PHSUBD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#6#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PHSUBD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#6#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PHSUBSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#7#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PHSUBSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#7#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PMADDUBSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#4#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PMADDUBSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#4#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PMULHRSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#11#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PMULHRSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#11#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PSHUFB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#0#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PSHUFB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#0#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PSIGNB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#8#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PSIGNB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#8#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PSIGNW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#9#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PSIGNW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#9#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PSIGND; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#10#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PSIGND; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#10#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_BLENDPS; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#12#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_BLENDPD; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#13#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_BLENDVPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#20#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_BLENDVPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#21#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_DPPS; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#64#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_DPPD; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#65#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_EXTRACTPS; + ops : 3; + optypes : (ot_memory,ot_xmmreg,ot_immediate,ot_none); + code : #241#213#3#15#58#23#65#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_EXTRACTPS; + ops : 3; + optypes : (ot_reg32 or ot_bits64,ot_xmmreg,ot_immediate,ot_none); + code : #241#3#15#58#23#65#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_INSERTPS; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#33#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_MOVNTDQA; + ops : 2; + optypes : (ot_xmmreg,ot_memory,ot_none,ot_none); + code : #241#3#15#56#42#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_MPSADBW; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#66#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PACKUSDW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#43#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PBLENDVB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#16#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PBLENDW; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#14#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PCMPEQQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#41#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PEXTRB; + ops : 3; + optypes : (ot_reg32 or ot_bits64,ot_xmmreg,ot_immediate,ot_none); + code : #241#3#15#58#20#65#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_PEXTRB; + ops : 3; + optypes : (ot_memory or ot_bits8,ot_xmmreg,ot_immediate,ot_none); + code : #241#3#15#58#20#65#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_PEXTRD; + ops : 3; + optypes : (ot_reg32,ot_xmmreg,ot_immediate,ot_none); + code : #241#3#15#58#22#65#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_PEXTRD; + ops : 3; + optypes : (ot_memory or ot_bits32,ot_xmmreg,ot_immediate,ot_none); + code : #241#3#15#58#22#65#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_PHMINPOSUW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#65#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PINSRB; + ops : 3; + optypes : (ot_xmmreg,ot_reg32 or ot_bits64,ot_immediate,ot_none); + code : #241#3#15#58#32#72#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_PINSRB; + ops : 3; + optypes : (ot_xmmreg,ot_memory or ot_bits8,ot_immediate,ot_none); + code : #241#3#15#58#32#72#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_PINSRD; + ops : 3; + optypes : (ot_xmmreg,ot_reg32,ot_immediate,ot_none); + code : #241#3#15#58#34#72#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_PINSRD; + ops : 3; + optypes : (ot_xmmreg,ot_memory or ot_bits32,ot_immediate,ot_none); + code : #241#3#15#58#34#72#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_PMAXSB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#60#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMAXSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#61#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMAXUD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#63#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMAXUW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#62#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMINSB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#56#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMINSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#57#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMINUW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#58#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMINUD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#59#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVSXBW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#32#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVSXBD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#33#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVSXBQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#34#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVSXWD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#35#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVSXWQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#36#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVSXDQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#37#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVZXBW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#48#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVZXBD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#49#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVZXBQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#50#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVZXWD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#51#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVZXWQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#52#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVZXDQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#53#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMULDQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#40#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMULLD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#64#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PTEST; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#23#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_ROUNDPS; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#8#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_ROUNDPD; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#9#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_ROUNDSS; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#10#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_ROUNDSD; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#11#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_CRC32; + ops : 2; + optypes : (ot_reg32,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #220#3#15#56#240#72; + flags : if_sse42 + ), + ( + opcode : A_CRC32; + ops : 2; + optypes : (ot_reg32,ot_rm_gpr or ot_bits16 or ot_bits32,ot_none,ot_none); + code : #209#220#3#15#56#241#72; + flags : if_sse42 + ), + ( + opcode : A_PCMPESTRI; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#97#72#22; + flags : if_sse42 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PCMPESTRM; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#96#72#22; + flags : if_sse42 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PCMPISTRI; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#99#72#22; + flags : if_sse42 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PCMPISTRM; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#98#72#22; + flags : if_sse42 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PCMPGTQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#55#72; + flags : if_sse42 or if_sm + ), + ( + opcode : A_POPCNT; + ops : 2; + optypes : (ot_reg16,ot_rm_gpr or ot_bits16,ot_none,ot_none); + code : #219#208#2#15#184#72; + flags : if_386 or if_sm or if_sse4 + ), + ( + opcode : A_POPCNT; + ops : 2; + optypes : (ot_reg32,ot_rm_gpr or ot_bits32,ot_none,ot_none); + code : #219#208#2#15#184#72; + flags : if_386 or if_sm or if_sse4 + ), + ( + opcode : A_AESENC; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#220#72; + flags : if_sse4 or if_sm + ), + ( + opcode : A_AESENCLAST; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#221#72; + flags : if_sse4 or if_sm + ), + ( + opcode : A_AESDEC; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#222#72; + flags : if_sse4 or if_sm + ), + ( + opcode : A_AESDECLAST; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#223#72; + flags : if_sse4 or if_sm + ), + ( + opcode : A_AESIMC; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#219#72; + flags : if_sse4 or if_sm + ), + ( + opcode : A_AESKEYGENASSIST; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#223#72#22; + flags : if_sse4 or if_sb or if_ar2 + ) +); diff --git a/closures/compiler/i386/n386add.pas b/closures/compiler/i386/n386add.pas new file mode 100644 index 0000000000..9485af5e02 --- /dev/null +++ b/closures/compiler/i386/n386add.pas @@ -0,0 +1,448 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + Code generation for add nodes on the i386 + + 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 n386add; + +{$i fpcdefs.inc} + +interface + + uses + node,nadd,cpubase,nx86add; + + type + ti386addnode = class(tx86addnode) + function use_generic_mul32to64: boolean; override; + procedure second_addordinal; override; + procedure second_add64bit;override; + procedure second_cmp64bit;override; + procedure second_mul(unsigned: boolean); + end; + + implementation + + uses + globtype,systems, + cutils,verbose,globals, + symconst,symdef,paramgr,defutil, + aasmbase,aasmtai,aasmdata,aasmcpu, + cgbase,procinfo, + ncon,nset,cgutils,tgobj, + cga,ncgutil,cgobj,cg64f32,cgx86; + +{***************************************************************************** + use_generic_mul32to64 +*****************************************************************************} + + function ti386addnode.use_generic_mul32to64: boolean; + begin + result := False; + end; + + { handles all unsigned multiplications, and 32->64 bit signed ones. + 32bit-only signed mul is handled by generic codegen } + procedure ti386addnode.second_addordinal; + var + unsigned: boolean; + begin + unsigned:=not(is_signed(left.resultdef)) or + not(is_signed(right.resultdef)); + if (nodetype=muln) and (unsigned or is_64bit(resultdef)) then + second_mul(unsigned) + else + inherited second_addordinal; + end; + +{***************************************************************************** + Add64bit +*****************************************************************************} + + procedure ti386addnode.second_add64bit; + var + op : TOpCG; + op1,op2 : TAsmOp; + opsize : TOpSize; + hregister, + hregister2 : tregister; + hl4 : tasmlabel; + mboverflow, + unsigned:boolean; + r:Tregister; + begin + firstcomplex(self); + pass_left_right; + + op1:=A_NONE; + op2:=A_NONE; + mboverflow:=false; + opsize:=S_L; + unsigned:=((left.resultdef.typ=orddef) and + (torddef(left.resultdef).ordtype=u64bit)) or + ((right.resultdef.typ=orddef) and + (torddef(right.resultdef).ordtype=u64bit)); + case nodetype of + addn : + begin + op:=OP_ADD; + mboverflow:=true; + end; + subn : + begin + op:=OP_SUB; + op1:=A_SUB; + op2:=A_SBB; + mboverflow:=true; + end; + xorn: + op:=OP_XOR; + orn: + op:=OP_OR; + andn: + op:=OP_AND; + else + begin + { everything should be handled in pass_1 (JM) } + internalerror(200109051); + end; + end; + + { left and right no register? } + { then one must be demanded } + if (left.location.loc<>LOC_REGISTER) then + begin + if (right.location.loc<>LOC_REGISTER) then + begin + hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + hregister2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg64.a_load64_loc_reg(current_asmdata.CurrAsmList,left.location,joinreg64(hregister,hregister2)); + location_reset(left.location,LOC_REGISTER,left.location.size); + left.location.register64.reglo:=hregister; + left.location.register64.reghi:=hregister2; + end + else + begin + location_swap(left.location,right.location); + toggleflag(nf_swapped); + end; + end; + + { at this point, left.location.loc should be LOC_REGISTER } + if right.location.loc=LOC_REGISTER then + begin + { when swapped another result register } + if (nodetype=subn) and (nf_swapped in flags) then + begin + cg64.a_op64_reg_reg(current_asmdata.CurrAsmList,op,location.size, + left.location.register64, + right.location.register64); + location_swap(left.location,right.location); + toggleflag(nf_swapped); + end + else + begin + cg64.a_op64_reg_reg(current_asmdata.CurrAsmList,op,location.size, + right.location.register64, + left.location.register64); + end; + end + else + begin + { right.location<>LOC_REGISTER } + if (nodetype=subn) and (nf_swapped in flags) then + begin + r:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg64.a_load64low_loc_reg(current_asmdata.CurrAsmList,right.location,r); + emit_reg_reg(op1,opsize,left.location.register64.reglo,r); + emit_reg_reg(A_MOV,opsize,r,left.location.register64.reglo); + cg64.a_load64high_loc_reg(current_asmdata.CurrAsmList,right.location,r); + { the carry flag is still ok } + emit_reg_reg(op2,opsize,left.location.register64.reghi,r); + emit_reg_reg(A_MOV,opsize,r,left.location.register64.reghi); + end + else + begin + cg64.a_op64_loc_reg(current_asmdata.CurrAsmList,op,location.size,right.location, + left.location.register64); + end; + location_freetemp(current_asmdata.CurrAsmList,right.location); + end; + + { only in case of overflow operations } + { produce overflow code } + { we must put it here directly, because sign of operation } + { is in unsigned VAR!! } + if mboverflow then + begin + if cs_check_overflow in current_settings.localswitches then + begin + current_asmdata.getjumplabel(hl4); + if unsigned then + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_AE,hl4) + else + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NO,hl4); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false); + cg.a_label(current_asmdata.CurrAsmList,hl4); + end; + end; + + location_copy(location,left.location); + end; + + + procedure ti386addnode.second_cmp64bit; + var + hregister, + hregister2 : tregister; + href : treference; + unsigned : boolean; + + procedure firstjmp64bitcmp; + + var + oldnodetype : tnodetype; + + begin +{$ifdef OLDREGVARS} + load_all_regvars(current_asmdata.CurrAsmList); +{$endif OLDREGVARS} + { the jump the sequence is a little bit hairy } + case nodetype of + ltn,gtn: + begin + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrTrueLabel); + { cheat a little bit for the negative test } + toggleflag(nf_swapped); + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrFalseLabel); + toggleflag(nf_swapped); + end; + lten,gten: + begin + oldnodetype:=nodetype; + if nodetype=lten then + nodetype:=ltn + else + nodetype:=gtn; + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrTrueLabel); + { cheat for the negative test } + if nodetype=ltn then + nodetype:=gtn + else + nodetype:=ltn; + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrFalseLabel); + nodetype:=oldnodetype; + end; + equaln: + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,current_procinfo.CurrFalseLabel); + unequaln: + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,current_procinfo.CurrTrueLabel); + end; + end; + + procedure secondjmp64bitcmp; + + begin + { the jump the sequence is a little bit hairy } + case nodetype of + ltn,gtn,lten,gten: + begin + { the comparisaion of the low dword have to be } + { always unsigned! } + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(true),current_procinfo.CurrTrueLabel); + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + end; + equaln: + begin + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,current_procinfo.CurrFalseLabel); + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel); + end; + unequaln: + begin + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,current_procinfo.CurrTrueLabel); + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + end; + end; + end; + + begin + firstcomplex(self); + + pass_left_right; + + unsigned:=((left.resultdef.typ=orddef) and + (torddef(left.resultdef).ordtype=u64bit)) or + ((right.resultdef.typ=orddef) and + (torddef(right.resultdef).ordtype=u64bit)); + + { left and right no register? } + { then one must be demanded } + if (left.location.loc<>LOC_REGISTER) then + begin + if (right.location.loc<>LOC_REGISTER) then + begin + { we can reuse a CREGISTER for comparison } + if (left.location.loc<>LOC_CREGISTER) then + begin + hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + hregister2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg64.a_load64_loc_reg(current_asmdata.CurrAsmList,left.location,joinreg64(hregister,hregister2)); + location_freetemp(current_asmdata.CurrAsmList,left.location); + location_reset(left.location,LOC_REGISTER,left.location.size); + left.location.register64.reglo:=hregister; + left.location.register64.reghi:=hregister2; + end; + end + else + begin + location_swap(left.location,right.location); + toggleflag(nf_swapped); + end; + end; + + { at this point, left.location.loc should be LOC_REGISTER } + if right.location.loc=LOC_REGISTER then + begin + emit_reg_reg(A_CMP,S_L,right.location.register64.reghi,left.location.register64.reghi); + firstjmp64bitcmp; + emit_reg_reg(A_CMP,S_L,right.location.register64.reglo,left.location.register64.reglo); + secondjmp64bitcmp; + end + else + begin + case right.location.loc of + LOC_CREGISTER : + begin + emit_reg_reg(A_CMP,S_L,right.location.register64.reghi,left.location.register64.reghi); + firstjmp64bitcmp; + emit_reg_reg(A_CMP,S_L,right.location.register64.reglo,left.location.register64.reglo); + secondjmp64bitcmp; + end; + LOC_CREFERENCE, + LOC_REFERENCE : + begin + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,right.location.reference); + href:=right.location.reference; + inc(href.offset,4); + emit_ref_reg(A_CMP,S_L,href,left.location.register64.reghi); + firstjmp64bitcmp; + emit_ref_reg(A_CMP,S_L,right.location.reference,left.location.register64.reglo); + secondjmp64bitcmp; + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + location_freetemp(current_asmdata.CurrAsmList,right.location); + end; + LOC_CONSTANT : + begin + current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,S_L,aint(hi(right.location.value64)),left.location.register64.reghi)); + firstjmp64bitcmp; + current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,S_L,aint(lo(right.location.value64)),left.location.register64.reglo)); + secondjmp64bitcmp; + end; + else + internalerror(200203282); + end; + end; + + { we have LOC_JUMP as result } + location_reset(location,LOC_JUMP,OS_NO) + end; + + +{***************************************************************************** + x86 MUL +*****************************************************************************} + + procedure ti386addnode.second_mul(unsigned: boolean); + + var reg:Tregister; + ref:Treference; + use_ref:boolean; + hl4 : tasmlabel; + + const + asmops: array[boolean] of tasmop = (A_IMUL, A_MUL); + + begin + pass_left_right; + + {The location.register will be filled in later (JM)} + location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); + { Mul supports registers and references, so if not register/reference, + load the location into a register. + The variant of IMUL which is capable of doing 32->64 bits has the same restrictions. } + use_ref:=false; + if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then + reg:=left.location.register + else if left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then + begin + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,left.location.reference); + ref:=left.location.reference; + use_ref:=true; + end + else + begin + {LOC_CONSTANT for example.} + reg:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_INT,left.location,reg); + end; + {Allocate EAX.} + cg.getcpuregister(current_asmdata.CurrAsmList,NR_EAX); + {Load the right value.} + cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_INT,right.location,NR_EAX); + {Also allocate EDX, since it is also modified by a mul (JM).} + cg.getcpuregister(current_asmdata.CurrAsmList,NR_EDX); + if use_ref then + emit_ref(asmops[unsigned],S_L,ref) + else + emit_reg(asmops[unsigned],S_L,reg); + if (cs_check_overflow in current_settings.localswitches) and + { 32->64 bit cannot overflow } + (not is_64bit(resultdef)) then + begin + current_asmdata.getjumplabel(hl4); + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_AE,hl4); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false); + cg.a_label(current_asmdata.CurrAsmList,hl4); + end; + {Free EAX,EDX} + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EDX); + if is_64bit(resultdef) then + begin + {Allocate a couple of registers and store EDX:EAX into it} + location.register64.reghi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.a_load_reg_reg(current_asmdata.CurrAsmList, OS_INT, OS_INT, NR_EDX, location.register64.reghi); + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EAX); + location.register64.reglo := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.a_load_reg_reg(current_asmdata.CurrAsmList, OS_INT, OS_INT, NR_EAX, location.register64.reglo); + end + else + begin + {Allocate a new register and store the result in EAX in it.} + location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EAX); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_EAX,location.register); + end; + location_freetemp(current_asmdata.CurrAsmList,left.location); + location_freetemp(current_asmdata.CurrAsmList,right.location); + end; + + +begin + caddnode:=ti386addnode; +end. diff --git a/closures/compiler/i386/n386cal.pas b/closures/compiler/i386/n386cal.pas new file mode 100644 index 0000000000..3751c0003c --- /dev/null +++ b/closures/compiler/i386/n386cal.pas @@ -0,0 +1,120 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate i386 assembler for in 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 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 n386cal; + +{$i fpcdefs.inc} + +interface + +{ $define AnsiStrRef} + + uses + ncgcal; + + type + ti386callnode = class(tcgcallnode) + protected + procedure pop_parasize(pop_size:longint);override; + procedure extra_interrupt_code;override; + end; + + +implementation + + uses + globtype,systems, + cutils,verbose,globals, + cgbase,cgutils, + cpubase,paramgr, + aasmtai,aasmdata,aasmcpu, + ncal,nbas,nmem,nld,ncnv, + cga,cgobj,cpuinfo; + + +{***************************************************************************** + TI386CALLNODE +*****************************************************************************} + + + procedure ti386callnode.extra_interrupt_code; + begin + if not(target_info.system in [system_i386_darwin,system_i386_iphonesim]) then + begin + emit_none(A_PUSHF,S_L); + emit_reg(A_PUSH,S_L,NR_CS); + end; + end; + + + procedure ti386callnode.pop_parasize(pop_size:longint); + var + hreg : tregister; + begin + if (paramanager.use_fixed_stack) then + begin + { very weird: in this case the callee does a "ret $4" and the } + { caller immediately a "subl $4,%esp". Possibly this is for } + { use_fixed_stack code to be able to transparently call } + { old-style code (JM) } + dec(pop_size,pushedparasize); + if (pop_size < 0) then + current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_SUB,S_L,-pop_size,NR_ESP)); + exit; + end; + + { on win32, the caller is responsible for removing the funcret } + { pointer from the stack, unlike on Linux. Don't know about } + { elsewhere (except Darwin, handled above), but since the default } + { was "callee removes funcret pointer from stack" until now, we'll } + { keep that default for everyone else (ncgcal decreases popsize by } + { sizeof(aint) in case of ret_in_param()) } + if (target_info.system = system_i386_win32) and + paramanager.ret_in_param(procdefinition.returndef,procdefinition.proccalloption) then + inc(pop_size,sizeof(aint)); + + { better than an add on all processors } + if pop_size=4 then + begin + hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_POP,S_L,hreg)); + end + { the pentium has two pipes and pop reg is pairable } + { but the registers must be different! } + else + if (pop_size=8) and + not(cs_opt_size in current_settings.optimizerswitches) and + (current_settings.optimizecputype=cpu_Pentium) then + begin + hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_POP,S_L,hreg)); + hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_POP,S_L,hreg)); + end + else + if pop_size<>0 then + current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_ADD,S_L,pop_size,NR_ESP)); + end; + + +begin + ccallnode:=ti386callnode; +end. diff --git a/closures/compiler/i386/n386inl.pas b/closures/compiler/i386/n386inl.pas new file mode 100644 index 0000000000..4c28d2bc8a --- /dev/null +++ b/closures/compiler/i386/n386inl.pas @@ -0,0 +1,42 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate i386 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 n386inl; + +{$i fpcdefs.inc} + +interface + + uses + nx86inl; + + type + ti386inlinenode = class(tx86inlinenode) + end; + +implementation + + uses + ninl; + +begin + cinlinenode:=ti386inlinenode; +end. diff --git a/closures/compiler/i386/n386mat.pas b/closures/compiler/i386/n386mat.pas new file mode 100644 index 0000000000..313f7f328d --- /dev/null +++ b/closures/compiler/i386/n386mat.pas @@ -0,0 +1,473 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate i386 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 n386mat; + +{$i fpcdefs.inc} + +interface + + uses + node,nmat,ncgmat,nx86mat; + + type + ti386moddivnode = class(tmoddivnode) + procedure pass_generate_code;override; + end; + + ti386shlshrnode = class(tcgshlshrnode) + procedure second_64bit;override; + function first_shlshr64bitint: tnode; override; + end; + + ti386unaryminusnode = class(tx86unaryminusnode) + end; + + ti386notnode = class(tx86notnode) + end; + + +implementation + + uses + globtype,systems,constexp, + cutils,verbose,globals, + symconst,symdef,aasmbase,aasmtai,aasmdata,defutil, + cgbase,pass_2, + ncon, + cpubase,cpuinfo, + cga,ncgutil,cgobj,cgutils; + +{***************************************************************************** + TI386MODDIVNODE +*****************************************************************************} + + function log2(i : dword) : dword; + begin + result:=0; + i:=i shr 1; + while i<>0 do + begin + i:=i shr 1; + inc(result); + end; + end; + + + procedure ti386moddivnode.pass_generate_code; + var + hreg1,hreg2:Tregister; + power:longint; + hl:Tasmlabel; + op:Tasmop; + e : longint; + d,l,r,s,m,a,n,t : dword; + m_low,m_high,j,k : qword; + begin + secondpass(left); + if codegenerror then + exit; + secondpass(right); + if codegenerror then + exit; + + if is_64bitint(resultdef) then + { should be handled in pass_1 (JM) } + internalerror(200109052); + { put numerator in register } + location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); + location_force_reg(current_asmdata.CurrAsmList,left.location,location.size,false); + hreg1:=left.location.register; + + if (nodetype=divn) and (right.nodetype=ordconstn) then + begin + if ispowerof2(tordconstnode(right).value.svalue,power) then + begin + { for signed numbers, the numerator must be adjusted before the + shift instruction, but not wih unsigned numbers! Otherwise, + "Cardinal($ffffffff) div 16" overflows! (JM) } + if is_signed(left.resultdef) Then + begin + if (current_settings.optimizecputype <> cpu_386) and + not(cs_opt_size in current_settings.optimizerswitches) then + { use a sequence without jumps, saw this in + comp.compilers (JM) } + begin + { no jumps, but more operations } + hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + emit_reg_reg(A_MOV,S_L,hreg1,hreg2); + {If the left value is signed, hreg2=$ffffffff, otherwise 0.} + emit_const_reg(A_SAR,S_L,31,hreg2); + {If signed, hreg2=right value-1, otherwise 0.} + emit_const_reg(A_AND,S_L,tordconstnode(right).value.svalue-1,hreg2); + { add to the left value } + emit_reg_reg(A_ADD,S_L,hreg2,hreg1); + { do the shift } + emit_const_reg(A_SAR,S_L,power,hreg1); + end + else + begin + { a jump, but less operations } + emit_reg_reg(A_TEST,S_L,hreg1,hreg1); + current_asmdata.getjumplabel(hl); + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NS,hl); + if power=1 then + emit_reg(A_INC,S_L,hreg1) + else + emit_const_reg(A_ADD,S_L,tordconstnode(right).value.svalue-1,hreg1); + cg.a_label(current_asmdata.CurrAsmList,hl); + emit_const_reg(A_SAR,S_L,power,hreg1); + end + end + else + emit_const_reg(A_SHR,S_L,power,hreg1); + location.register:=hreg1; + end + else + begin + if is_signed(left.resultdef) then + begin + e:=tordconstnode(right).value.svalue; + d:=abs(e); + { Determine algorithm (a), multiplier (m), and shift factor (s) for 32-bit + signed integer division. Based on: Granlund, T.; Montgomery, P.L.: + "Division by Invariant Integers using Multiplication". SIGPLAN Notices, + Vol. 29, June 1994, page 61. + } + + l:=log2(d); + j:=qword($80000000) mod qword(d); + k:=(qword(1) shl (32+l)) div (qword($80000000-j)); + m_low:=((qword(1)) shl (32+l)) div d; + m_high:=(((qword(1)) shl (32+l)) + k) div d; + while ((m_low shr 1) < (m_high shr 1)) and (l > 0) do + begin + m_low:=m_low shr 1; + m_high:=m_high shr 1; + dec(l); + end; + m:=dword(m_high); + s:=l; + if (m_high shr 31)<>0 then + a:=1 + else + a:=0; + cg.getcpuregister(current_asmdata.CurrAsmList,NR_EAX); + emit_const_reg(A_MOV,S_L,aint(m),NR_EAX); + cg.getcpuregister(current_asmdata.CurrAsmList,NR_EDX); + emit_reg(A_IMUL,S_L,hreg1); + emit_reg_reg(A_MOV,S_L,hreg1,NR_EAX); + if a<>0 then + begin + emit_reg_reg(A_ADD,S_L,NR_EAX,NR_EDX); + { + printf ("; dividend: memory location or register other than EAX or EDX\n"); + printf ("\n"); + printf ("MOV EAX, 0%08LXh\n", m); + printf ("IMUL dividend\n"); + printf ("MOV EAX, dividend\n"); + printf ("ADD EDX, EAX\n"); + if (s) printf ("SAR EDX, %d\n", s); + printf ("SHR EAX, 31\n"); + printf ("ADD EDX, EAX\n"); + if (e < 0) printf ("NEG EDX\n"); + printf ("\n"); + printf ("; quotient now in EDX\n"); + } + end; + { + printf ("; dividend: memory location of register other than EAX or EDX\n"); + printf ("\n"); + printf ("MOV EAX, 0%08LXh\n", m); + printf ("IMUL dividend\n"); + printf ("MOV EAX, dividend\n"); + if (s) printf ("SAR EDX, %d\n", s); + printf ("SHR EAX, 31\n"); + printf ("ADD EDX, EAX\n"); + if (e < 0) printf ("NEG EDX\n"); + printf ("\n"); + printf ("; quotient now in EDX\n"); + } + if s<>0 then + emit_const_reg(A_SAR,S_L,s,NR_EDX); + emit_const_reg(A_SHR,S_L,31,NR_EAX); + emit_reg_reg(A_ADD,S_L,NR_EAX,NR_EDX); + if e<0 then + emit_reg(A_NEG,S_L,NR_EDX); + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EDX); + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EAX); + location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_EDX,location.register) + end + else + begin + d:=tordconstnode(right).value.svalue; + if d>=$80000000 then + begin + emit_const_reg(A_CMP,S_L,aint(d),hreg1); + location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + emit_const_reg(A_MOV,S_L,0,location.register); + emit_const_reg(A_SBB,S_L,-1,location.register); + end + else + begin + { Reduce divisor until it becomes odd } + n:=0; + t:=d; + while (t and 1)=0 do + begin + t:=t shr 1; + inc(n); + end; + { Generate m, s for algorithm 0. Based on: Granlund, T.; Montgomery, + P.L.: "Division by Invariant Integers using Multiplication". + SIGPLAN Notices, Vol. 29, June 1994, page 61. + } + l:=log2(t)+1; + j:=qword($ffffffff) mod qword(t); + k:=(qword(1) shl (32+l)) div (qword($ffffffff-j)); + m_low:=((qword(1)) shl (32+l)) div t; + m_high:=(((qword(1)) shl (32+l)) + k) div t; + while ((m_low shr 1) < (m_high shr 1)) and (l>0) do + begin + m_low:=m_low shr 1; + m_high:=m_high shr 1; + l:=l-1; + end; + if (m_high shr 32)=0 then + begin + m:=dword(m_high); + s:=l; + a:=0; + end + + { Generate m, s for algorithm 1. Based on: Magenheimer, D.J.; et al: + "Integer Multiplication and Division on the HP Precision Architecture". + IEEE Transactions on Computers, Vol 37, No. 8, August 1988, page 980. + } + else + begin + s:=log2(t); + m_low:=(qword(1) shl (32+s)) div qword(t); + r:=dword(((qword(1)) shl (32+s)) mod qword(t)); + if (r < ((t>>1)+1)) then + m:=dword(m_low) + else + m:=dword(m_low)+1; + a:=1; + end; + { Reduce multiplier for either algorithm to smallest possible } + while (m and 1)=0 do + begin + m:=m shr 1; + dec(s); + end; + { Adjust multiplier for reduction of even divisors } + inc(s,n); + cg.getcpuregister(current_asmdata.CurrAsmList,NR_EAX); + emit_const_reg(A_MOV,S_L,aint(m),NR_EAX); + cg.getcpuregister(current_asmdata.CurrAsmList,NR_EDX); + emit_reg(A_MUL,S_L,hreg1); + if a<>0 then + begin + { + printf ("; dividend: register other than EAX or memory location\n"); + printf ("\n"); + printf ("MOV EAX, 0%08lXh\n", m); + printf ("MUL dividend\n"); + printf ("ADD EAX, 0%08lXh\n", m); + printf ("ADC EDX, 0\n"); + if (s) printf ("SHR EDX, %d\n", s); + printf ("\n"); + printf ("; quotient now in EDX\n"); + } + emit_const_reg(A_ADD,S_L,aint(m),NR_EAX); + emit_const_reg(A_ADC,S_L,0,NR_EDX); + end; + if s<>0 then + emit_const_reg(A_SHR,S_L,aint(s),NR_EDX); + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EDX); + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EAX); + location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_EDX,location.register) + end; + end + end + end + else + begin + cg.getcpuregister(current_asmdata.CurrAsmList,NR_EAX); + emit_reg_reg(A_MOV,S_L,hreg1,NR_EAX); + cg.getcpuregister(current_asmdata.CurrAsmList,NR_EDX); + {Sign extension depends on the left type.} + if torddef(left.resultdef).ordtype=u32bit then + emit_reg_reg(A_XOR,S_L,NR_EDX,NR_EDX) + else + emit_none(A_CDQ,S_NO); + + {Division depends on the right type.} + if Torddef(right.resultdef).ordtype=u32bit then + op:=A_DIV + else + op:=A_IDIV; + + if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then + emit_ref(op,S_L,right.location.reference) + else if right.location.loc in [LOC_REGISTER,LOC_CREGISTER] then + emit_reg(op,S_L,right.location.register) + else + begin + hreg1:=cg.getintregister(current_asmdata.CurrAsmList,right.location.size); + cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_32,right.location,hreg1); + emit_reg(op,S_L,hreg1); + end; + + {Copy the result into a new register. Release EAX & EDX.} + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EDX); + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_EAX); + location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + if nodetype=divn then + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_EAX,location.register) + else + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_EDX,location.register); + end; + end; + + +{***************************************************************************** + TI386SHLRSHRNODE +*****************************************************************************} + + + function ti386shlshrnode.first_shlshr64bitint: tnode; + begin + result := nil; + end; + + procedure ti386shlshrnode.second_64bit; + var + hreg64hi,hreg64lo:Tregister; + v : TConstExprInt; + l1,l2,l3:Tasmlabel; + begin + location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); + + { load left operator in a register } + location_force_reg(current_asmdata.CurrAsmList,left.location,location.size,false); + hreg64hi:=left.location.register64.reghi; + hreg64lo:=left.location.register64.reglo; + + { shifting by a constant directly coded: } + if (right.nodetype=ordconstn) then + begin + v:=Tordconstnode(right).value and 63; + if v>31 then + begin + if nodetype=shln then + begin + emit_reg_reg(A_XOR,S_L,hreg64hi,hreg64hi); + if ((v and 31) <> 0) then + emit_const_reg(A_SHL,S_L,v.svalue and 31,hreg64lo); + end + else + begin + emit_reg_reg(A_XOR,S_L,hreg64lo,hreg64lo); + if ((v and 31) <> 0) then + emit_const_reg(A_SHR,S_L,v.svalue and 31,hreg64hi); + end; + location.register64.reghi:=hreg64lo; + location.register64.reglo:=hreg64hi; + end + else + begin + if nodetype=shln then + begin + emit_const_reg_reg(A_SHLD,S_L,v.svalue and 31,hreg64lo,hreg64hi); + emit_const_reg(A_SHL,S_L,v.svalue and 31,hreg64lo); + end + else + begin + emit_const_reg_reg(A_SHRD,S_L,v.svalue and 31,hreg64hi,hreg64lo); + emit_const_reg(A_SHR,S_L,v.svalue and 31,hreg64hi); + end; + location.register64.reglo:=hreg64lo; + location.register64.reghi:=hreg64hi; + end; + end + else + begin + { load right operators in a register } + cg.getcpuregister(current_asmdata.CurrAsmList,NR_ECX); + cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_32,right.location,NR_ECX); + + { left operator is already in a register } + { hence are both in a register } + { is it in the case ECX ? } + + { the damned shift instructions work only til a count of 32 } + { so we've to do some tricks here } + current_asmdata.getjumplabel(l1); + current_asmdata.getjumplabel(l2); + current_asmdata.getjumplabel(l3); + emit_const_reg(A_CMP,S_L,64,NR_ECX); + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_L,l1); + emit_reg_reg(A_XOR,S_L,hreg64lo,hreg64lo); + emit_reg_reg(A_XOR,S_L,hreg64hi,hreg64hi); + cg.a_jmp_always(current_asmdata.CurrAsmList,l3); + cg.a_label(current_asmdata.CurrAsmList,l1); + emit_const_reg(A_CMP,S_L,32,NR_ECX); + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_L,l2); + emit_const_reg(A_SUB,S_L,32,NR_ECX); + if nodetype=shln then + begin + emit_reg_reg(A_SHL,S_L,NR_CL,hreg64lo); + emit_reg_reg(A_MOV,S_L,hreg64lo,hreg64hi); + emit_reg_reg(A_XOR,S_L,hreg64lo,hreg64lo); + cg.a_jmp_always(current_asmdata.CurrAsmList,l3); + cg.a_label(current_asmdata.CurrAsmList,l2); + emit_reg_reg_reg(A_SHLD,S_L,NR_CL,hreg64lo,hreg64hi); + emit_reg_reg(A_SHL,S_L,NR_CL,hreg64lo); + end + else + begin + emit_reg_reg(A_SHR,S_L,NR_CL,hreg64hi); + emit_reg_reg(A_MOV,S_L,hreg64hi,hreg64lo); + emit_reg_reg(A_XOR,S_L,hreg64hi,hreg64hi); + cg.a_jmp_always(current_asmdata.CurrAsmList,l3); + cg.a_label(current_asmdata.CurrAsmList,l2); + emit_reg_reg_reg(A_SHRD,S_L,NR_CL,hreg64hi,hreg64lo); + emit_reg_reg(A_SHR,S_L,NR_CL,hreg64hi); + end; + cg.a_label(current_asmdata.CurrAsmList,l3); + + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_ECX); + location.register64.reglo:=hreg64lo; + location.register64.reghi:=hreg64hi; + end; + end; + + +begin + cunaryminusnode:=ti386unaryminusnode; + cmoddivnode:=ti386moddivnode; + cshlshrnode:=ti386shlshrnode; + cnotnode:=ti386notnode; +end. diff --git a/closures/compiler/i386/n386mem.pas b/closures/compiler/i386/n386mem.pas new file mode 100644 index 0000000000..fc9fb07853 --- /dev/null +++ b/closures/compiler/i386/n386mem.pas @@ -0,0 +1,98 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate i386 assembler for in memory related 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 n386mem; + +{$i fpcdefs.inc} + +interface + + uses + globtype, + cgbase,cpuinfo,cpubase, + node,nmem,ncgmem,nx86mem; + + type + ti386addrnode = class(tcgaddrnode) + procedure pass_generate_code;override; + end; + + ti386derefnode = class(tcgderefnode) + procedure pass_generate_code;override; + end; + + ti386vecnode = class(tx86vecnode) + procedure pass_generate_code;override; + end; + +implementation + + uses + systems, + cutils,verbose, + symdef,paramgr, + aasmtai,aasmdata, + nld,ncon,nadd, + cgutils,cgobj; + +{***************************************************************************** + TI386ADDRNODE +*****************************************************************************} + + procedure ti386addrnode.pass_generate_code; + + begin + inherited pass_generate_code; + { for use of other segments, not used } + {if left.location.reference.segment<>NR_NO then + location.segment:=left.location.reference.segment;} + end; + + +{***************************************************************************** + TI386DEREFNODE +*****************************************************************************} + + procedure ti386derefnode.pass_generate_code; + begin + inherited pass_generate_code; + if tpointerdef(left.resultdef).is_far then + location.reference.segment:=NR_FS; + end; + + +{***************************************************************************** + TI386VECNODE +*****************************************************************************} + + procedure ti386vecnode.pass_generate_code; + begin + inherited pass_generate_code; + if nf_memseg in flags then + location.reference.segment:=NR_FS; + end; + + +begin + caddrnode:=ti386addrnode; + cderefnode:=ti386derefnode; + cvecnode:=ti386vecnode; +end. diff --git a/closures/compiler/i386/n386set.pas b/closures/compiler/i386/n386set.pas new file mode 100644 index 0000000000..e5ee719752 --- /dev/null +++ b/closures/compiler/i386/n386set.pas @@ -0,0 +1,73 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate i386 assembler for in set/case 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 n386set; + +{$i fpcdefs.inc} + +interface + + uses + globtype, + node,nset,pass_1,nx86set; + + type + ti386casenode = class(tx86casenode) + procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);override; + end; + + +implementation + + uses + systems, + verbose,globals,constexp, + symconst,symdef,defutil, + aasmbase,aasmtai,aasmdata,aasmcpu, + cgbase,pass_2, + ncon, + cpubase,cpuinfo,procinfo, + cga,cgutils,cgobj,ncgutil, + cgx86; + + +{***************************************************************************** + TI386CASENODE +*****************************************************************************} + + procedure ti386casenode.optimizevalues(var max_linear_list:aint;var max_dist:aword); + begin + { a jump table crashes the pipeline! } + if current_settings.optimizecputype=cpu_386 then + inc(max_linear_list,3) + else if current_settings.optimizecputype=cpu_Pentium then + inc(max_linear_list,6) + else if current_settings.optimizecputype in [cpu_Pentium2,cpu_Pentium3] then + inc(max_linear_list,9) + else if current_settings.optimizecputype=cpu_Pentium4 then + inc(max_linear_list,14); + end; + + + +begin + ccasenode:=ti386casenode; +end. diff --git a/closures/compiler/i386/popt386.pas b/closures/compiler/i386/popt386.pas new file mode 100644 index 0000000000..a7bbfe0434 --- /dev/null +++ b/closures/compiler/i386/popt386.pas @@ -0,0 +1,2262 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl and Jonas Maebe + + This unit contains the peephole 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 popt386; + +{$i fpcdefs.inc} + +interface + +uses Aasmbase,aasmtai,aasmdata,aasmcpu,verbose; + +procedure PrePeepHoleOpts(asml: TAsmList; BlockStart, BlockEnd: tai); +procedure PeepHoleOptPass1(asml: TAsmList; BlockStart, BlockEnd: tai); +procedure PeepHoleOptPass2(asml: TAsmList; BlockStart, BlockEnd: tai); +procedure PostPeepHoleOpts(asml: TAsmList; BlockStart, BlockEnd: tai); + +implementation + +uses + globtype,systems, + globals,cgbase,procinfo, + symsym, +{$ifdef finaldestdebug} + cobjects, +{$endif finaldestdebug} + cpuinfo,cpubase,cgutils,daopt386; + + +function isFoldableArithOp(hp1: taicpu; reg: tregister): boolean; +begin + isFoldableArithOp := False; + case hp1.opcode of + A_ADD,A_SUB,A_OR,A_XOR,A_AND,A_SHL,A_SHR,A_SAR: + isFoldableArithOp := + ((taicpu(hp1).oper[0]^.typ = top_const) or + ((taicpu(hp1).oper[0]^.typ = top_reg) and + (taicpu(hp1).oper[0]^.reg <> reg))) and + (taicpu(hp1).oper[1]^.typ = top_reg) and + (taicpu(hp1).oper[1]^.reg = reg); + A_INC,A_DEC: + isFoldableArithOp := + (taicpu(hp1).oper[0]^.typ = top_reg) and + (taicpu(hp1).oper[0]^.reg = reg); + end; +end; + + +function RegUsedAfterInstruction(reg: Tregister; p: tai; var UsedRegs: TRegSet): Boolean; +var + supreg: tsuperregister; +begin + supreg := getsupreg(reg); + UpdateUsedRegs(UsedRegs, tai(p.Next)); + RegUsedAfterInstruction := + (supreg in UsedRegs) and + (not(getNextInstruction(p,p)) or + not(regLoadedWithNewValue(supreg,false,p))); +end; + + +function doFpuLoadStoreOpt(asmL: TAsmList; var p: tai): boolean; +{ returns true if a "continue" should be done after this optimization } +var hp1, hp2: tai; +begin + doFpuLoadStoreOpt := false; + if (taicpu(p).oper[0]^.typ = top_ref) and + getNextInstruction(p, hp1) and + (hp1.typ = ait_instruction) and + (((taicpu(hp1).opcode = A_FLD) and + (taicpu(p).opcode = A_FSTP)) or + ((taicpu(p).opcode = A_FISTP) and + (taicpu(hp1).opcode = A_FILD))) and + (taicpu(hp1).oper[0]^.typ = top_ref) and + (taicpu(hp1).opsize = taicpu(p).opsize) and + refsEqual(taicpu(p).oper[0]^.ref^, taicpu(hp1).oper[0]^.ref^) then + begin + { replacing fstp f;fld f by fst f is only valid for extended because of rounding } + if (taicpu(p).opsize=S_FX) and + getNextInstruction(hp1, hp2) and + (hp2.typ = ait_instruction) and + ((taicpu(hp2).opcode = A_LEAVE) or + (taicpu(hp2).opcode = A_RET)) and + (taicpu(p).oper[0]^.ref^.base = current_procinfo.FramePointer) and + not(assigned(current_procinfo.procdef.funcretsym) and + (taicpu(p).oper[0]^.ref^.offset < tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)) and + (taicpu(p).oper[0]^.ref^.index = NR_NO) then + begin + asml.remove(p); + asml.remove(hp1); + p.free; + hp1.free; + p := hp2; + removeLastDeallocForFuncRes(asmL, p); + doFPULoadStoreOpt := true; + end + (* can't be done because the store operation rounds + else + { fst can't store an extended value! } + if (taicpu(p).opsize <> S_FX) and + (taicpu(p).opsize <> S_IQ) then + begin + if (taicpu(p).opcode = A_FSTP) then + taicpu(p).opcode := A_FST + else taicpu(p).opcode := A_FIST; + asml.remove(hp1); + hp1.free; + end + *) + end; +end; + + +{ returns true if p contains a memory operand with a segment set } +function InsContainsSegRef(p: taicpu): boolean; +var + i: longint; +begin + result:=true; + for i:=0 to p.opercnt-1 do + if (p.oper[i]^.typ=top_ref) and + (p.oper[i]^.ref^.segment<>NR_NO) then + exit; + result:=false; +end; + + +procedure PrePeepHoleOpts(asml: TAsmList; BlockStart, BlockEnd: tai); +var + p,hp1: tai; + l: aint; + tmpRef: treference; +begin + p := BlockStart; + while (p <> BlockEnd) Do + begin + case p.Typ Of + Ait_Instruction: + begin + if InsContainsSegRef(taicpu(p)) then + begin + p := tai(p.next); + continue; + end; + case taicpu(p).opcode Of + A_IMUL: + {changes certain "imul const, %reg"'s to lea sequences} + begin + if (taicpu(p).oper[0]^.typ = Top_Const) and + (taicpu(p).oper[1]^.typ = Top_Reg) and + (taicpu(p).opsize = S_L) then + if (taicpu(p).oper[0]^.val = 1) then + if (taicpu(p).ops = 2) then + {remove "imul $1, reg"} + begin + hp1 := tai(p.Next); + asml.remove(p); + p.free; + p := hp1; + continue; + end + else + {change "imul $1, reg1, reg2" to "mov reg1, reg2"} + begin + hp1 := taicpu.Op_Reg_Reg(A_MOV, S_L, taicpu(p).oper[1]^.reg,taicpu(p).oper[2]^.reg); + InsertLLItem(asml, p.previous, p.next, hp1); + p.free; + p := hp1; + end + else if + ((taicpu(p).ops <= 2) or + (taicpu(p).oper[2]^.typ = Top_Reg)) and + (taicpu(p).oper[0]^.val <= 12) and + not(cs_opt_size in current_settings.optimizerswitches) and + (not(GetNextInstruction(p, hp1)) or + {GetNextInstruction(p, hp1) and} + not((tai(hp1).typ = ait_instruction) and + ((taicpu(hp1).opcode=A_Jcc) and + (taicpu(hp1).condition in [C_O,C_NO])))) then + begin + reference_reset(tmpref,1); + case taicpu(p).oper[0]^.val Of + 3: begin + {imul 3, reg1, reg2 to + lea (reg1,reg1,2), reg2 + imul 3, reg1 to + lea (reg1,reg1,2), reg1} + TmpRef.base := taicpu(p).oper[1]^.reg; + TmpRef.index := taicpu(p).oper[1]^.reg; + TmpRef.ScaleFactor := 2; + if (taicpu(p).ops = 2) then + hp1 := taicpu.op_ref_reg(A_LEA, S_L, TmpRef, taicpu(p).oper[1]^.reg) + else + hp1 := taicpu.op_ref_reg(A_LEA, S_L, TmpRef, taicpu(p).oper[2]^.reg); + InsertLLItem(asml,p.previous, p.next, hp1); + p.free; + p := hp1; + end; + 5: begin + {imul 5, reg1, reg2 to + lea (reg1,reg1,4), reg2 + imul 5, reg1 to + lea (reg1,reg1,4), reg1} + TmpRef.base := taicpu(p).oper[1]^.reg; + TmpRef.index := taicpu(p).oper[1]^.reg; + TmpRef.ScaleFactor := 4; + if (taicpu(p).ops = 2) then + hp1 := taicpu.op_ref_reg(A_LEA, S_L, TmpRef, taicpu(p).oper[1]^.reg) + else + hp1 := taicpu.op_ref_reg(A_LEA, S_L, TmpRef, taicpu(p).oper[2]^.reg); + InsertLLItem(asml,p.previous, p.next, hp1); + p.free; + p := hp1; + end; + 6: begin + {imul 6, reg1, reg2 to + lea (,reg1,2), reg2 + lea (reg2,reg1,4), reg2 + imul 6, reg1 to + lea (reg1,reg1,2), reg1 + add reg1, reg1} + if (current_settings.optimizecputype <= cpu_386) then + begin + TmpRef.index := taicpu(p).oper[1]^.reg; + if (taicpu(p).ops = 3) then + begin + TmpRef.base := taicpu(p).oper[2]^.reg; + TmpRef.ScaleFactor := 4; + hp1 := taicpu.op_ref_reg(A_LEA, S_L, TmpRef, taicpu(p).oper[1]^.reg); + end + else + begin + hp1 := taicpu.op_reg_reg(A_ADD, S_L, + taicpu(p).oper[1]^.reg,taicpu(p).oper[1]^.reg); + end; + InsertLLItem(asml,p, p.next, hp1); + reference_reset(tmpref,2); + TmpRef.index := taicpu(p).oper[1]^.reg; + TmpRef.ScaleFactor := 2; + if (taicpu(p).ops = 3) then + begin + TmpRef.base := NR_NO; + hp1 := taicpu.op_ref_reg(A_LEA, S_L, TmpRef, + taicpu(p).oper[2]^.reg); + end + else + begin + TmpRef.base := taicpu(p).oper[1]^.reg; + hp1 := taicpu.op_ref_reg(A_LEA, S_L, TmpRef, taicpu(p).oper[1]^.reg); + end; + InsertLLItem(asml,p.previous, p.next, hp1); + p.free; + p := tai(hp1.next); + end + end; + 9: begin + {imul 9, reg1, reg2 to + lea (reg1,reg1,8), reg2 + imul 9, reg1 to + lea (reg1,reg1,8), reg1} + TmpRef.base := taicpu(p).oper[1]^.reg; + TmpRef.index := taicpu(p).oper[1]^.reg; + TmpRef.ScaleFactor := 8; + if (taicpu(p).ops = 2) then + hp1 := taicpu.op_ref_reg(A_LEA, S_L, TmpRef, taicpu(p).oper[1]^.reg) + else + hp1 := taicpu.op_ref_reg(A_LEA, S_L, TmpRef, taicpu(p).oper[2]^.reg); + InsertLLItem(asml,p.previous, p.next, hp1); + p.free; + p := hp1; + end; + 10: begin + {imul 10, reg1, reg2 to + lea (reg1,reg1,4), reg2 + add reg2, reg2 + imul 10, reg1 to + lea (reg1,reg1,4), reg1 + add reg1, reg1} + if (current_settings.optimizecputype <= cpu_386) then + begin + if (taicpu(p).ops = 3) then + hp1 := taicpu.op_reg_reg(A_ADD, S_L, + taicpu(p).oper[2]^.reg,taicpu(p).oper[2]^.reg) + else + hp1 := taicpu.op_reg_reg(A_ADD, S_L, + taicpu(p).oper[1]^.reg,taicpu(p).oper[1]^.reg); + InsertLLItem(asml,p, p.next, hp1); + TmpRef.base := taicpu(p).oper[1]^.reg; + TmpRef.index := taicpu(p).oper[1]^.reg; + TmpRef.ScaleFactor := 4; + if (taicpu(p).ops = 3) then + hp1 := taicpu.op_ref_reg(A_LEA, S_L, TmpRef, taicpu(p).oper[2]^.reg) + else + hp1 := taicpu.op_ref_reg(A_LEA, S_L, TmpRef, taicpu(p).oper[1]^.reg); + InsertLLItem(asml,p.previous, p.next, hp1); + p.free; + p := tai(hp1.next); + end + end; + 12: begin + {imul 12, reg1, reg2 to + lea (,reg1,4), reg2 + lea (,reg1,8) reg2 + imul 12, reg1 to + lea (reg1,reg1,2), reg1 + lea (,reg1,4), reg1} + if (current_settings.optimizecputype <= cpu_386) + then + begin + TmpRef.index := taicpu(p).oper[1]^.reg; + if (taicpu(p).ops = 3) then + begin + TmpRef.base := taicpu(p).oper[2]^.reg; + TmpRef.ScaleFactor := 8; + hp1 := taicpu.op_ref_reg(A_LEA, S_L, TmpRef, taicpu(p).oper[2]^.reg); + end + else + begin + TmpRef.base := NR_NO; + TmpRef.ScaleFactor := 4; + hp1 := taicpu.op_ref_reg(A_LEA, S_L, TmpRef, taicpu(p).oper[1]^.reg); + end; + InsertLLItem(asml,p, p.next, hp1); + reference_reset(tmpref,2); + TmpRef.index := taicpu(p).oper[1]^.reg; + if (taicpu(p).ops = 3) then + begin + TmpRef.base := NR_NO; + TmpRef.ScaleFactor := 4; + hp1 := taicpu.op_ref_reg(A_LEA, S_L, TmpRef, taicpu(p).oper[2]^.reg); + end + else + begin + TmpRef.base := taicpu(p).oper[1]^.reg; + TmpRef.ScaleFactor := 2; + hp1 := taicpu.op_ref_reg(A_LEA, S_L, TmpRef, taicpu(p).oper[1]^.reg); + end; + InsertLLItem(asml,p.previous, p.next, hp1); + p.free; + p := tai(hp1.next); + end + end + end; + end; + end; + A_SAR, A_SHR: + {changes the code sequence + shr/sar const1, x + shl const2, x + to either "sar/and", "shl/and" or just "and" depending on const1 and const2} + begin + if GetNextInstruction(p, hp1) and + (tai(hp1).typ = ait_instruction) and + (taicpu(hp1).opcode = A_SHL) and + (taicpu(p).oper[0]^.typ = top_const) and + (taicpu(hp1).oper[0]^.typ = top_const) and + (taicpu(hp1).opsize = taicpu(p).opsize) and + (taicpu(hp1).oper[1]^.typ = taicpu(p).oper[1]^.typ) and + OpsEqual(taicpu(hp1).oper[1]^, taicpu(p).oper[1]^) then + if (taicpu(p).oper[0]^.val > taicpu(hp1).oper[0]^.val) and + not(cs_opt_size in current_settings.optimizerswitches) then + { shr/sar const1, %reg + shl const2, %reg + with const1 > const2 } + begin + taicpu(p).loadConst(0,taicpu(p).oper[0]^.val-taicpu(hp1).oper[0]^.val); + taicpu(hp1).opcode := A_AND; + l := (1 shl (taicpu(hp1).oper[0]^.val)) - 1; + case taicpu(p).opsize Of + S_L: taicpu(hp1).loadConst(0,l Xor aint($ffffffff)); + S_B: taicpu(hp1).loadConst(0,l Xor $ff); + S_W: taicpu(hp1).loadConst(0,l Xor $ffff); + end; + end + else if (taicpu(p).oper[0]^.val<taicpu(hp1).oper[0]^.val) and + not(cs_opt_size in current_settings.optimizerswitches) then + { shr/sar const1, %reg + shl const2, %reg + with const1 < const2 } + begin + taicpu(hp1).loadConst(0,taicpu(hp1).oper[0]^.val-taicpu(p).oper[0]^.val); + taicpu(p).opcode := A_AND; + l := (1 shl (taicpu(p).oper[0]^.val))-1; + case taicpu(p).opsize Of + S_L: taicpu(p).loadConst(0,l Xor aint($ffffffff)); + S_B: taicpu(p).loadConst(0,l Xor $ff); + S_W: taicpu(p).loadConst(0,l Xor $ffff); + end; + end + else + { shr/sar const1, %reg + shl const2, %reg + with const1 = const2 } + if (taicpu(p).oper[0]^.val = taicpu(hp1).oper[0]^.val) then + begin + taicpu(p).opcode := A_AND; + l := (1 shl (taicpu(p).oper[0]^.val))-1; + case taicpu(p).opsize Of + S_B: taicpu(p).loadConst(0,l Xor $ff); + S_W: taicpu(p).loadConst(0,l Xor $ffff); + S_L: taicpu(p).loadConst(0,l Xor aint($ffffffff)); + end; + asml.remove(hp1); + hp1.free; + end; + end; + A_XOR: + if (taicpu(p).oper[0]^.typ = top_reg) and + (taicpu(p).oper[1]^.typ = top_reg) and + (taicpu(p).oper[0]^.reg = taicpu(p).oper[1]^.reg) then + { temporarily change this to 'mov reg,0' to make it easier } + { for the CSE. Will be changed back in pass 2 } + begin + taicpu(p).opcode := A_MOV; + taicpu(p).loadConst(0,0); + end; + end; + end; + end; + p := tai(p.next) + end; +end; + + + +procedure PeepHoleOptPass1(Asml: TAsmList; BlockStart, BlockEnd: tai); +{First pass of peepholeoptimizations} + +var + l : longint; + p,hp1,hp2 : tai; + hp3,hp4: tai; + v:aint; + + TmpRef: TReference; + + UsedRegs, TmpUsedRegs: TRegSet; + + TmpBool1, TmpBool2: Boolean; + + 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 GetFinalDestination(asml: TAsmList; 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; + + 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).labsym; + end + end; + + begin + GetfinalDestination := false; + if level > 20 then + exit; + p1 := dfa.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).condition in [C_None,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)} + ((taicpu(p1).condition = inverse_cond(hp.condition)) and + SkipLabels(p1,p2) and + (p2.typ = ait_instruction) and + (taicpu(p2).is_jmp) and + (taicpu(p2).condition in [C_None,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(asml, 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 (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} + current_asmdata.getjumplabel(l); + insertllitem(asml,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(asml, hp,succ(level)) then + exit; + end; + end; + GetFinalDestination := true; + end; + + function DoSubAddOpt(var p: tai): Boolean; + begin + DoSubAddOpt := False; + if GetLastInstruction(p, hp1) and + (hp1.typ = ait_instruction) and + (taicpu(hp1).opsize = taicpu(p).opsize) then + case taicpu(hp1).opcode Of + A_DEC: + if (taicpu(hp1).oper[0]^.typ = top_reg) and + (taicpu(hp1).oper[0]^.reg = taicpu(p).oper[1]^.reg) then + begin + taicpu(p).loadConst(0,taicpu(p).oper[0]^.val+1); + asml.remove(hp1); + hp1.free; + end; + A_SUB: + if (taicpu(hp1).oper[0]^.typ = top_const) and + (taicpu(hp1).oper[1]^.typ = top_reg) and + (taicpu(hp1).oper[1]^.reg = taicpu(p).oper[1]^.reg) then + begin + taicpu(p).loadConst(0,taicpu(p).oper[0]^.val+taicpu(hp1).oper[0]^.val); + asml.remove(hp1); + hp1.free; + end; + A_ADD: + if (taicpu(hp1).oper[0]^.typ = top_const) and + (taicpu(hp1).oper[1]^.typ = top_reg) and + (taicpu(hp1).oper[1]^.reg = taicpu(p).oper[1]^.reg) then + begin + taicpu(p).loadConst(0,taicpu(p).oper[0]^.val-taicpu(hp1).oper[0]^.val); + asml.remove(hp1); + hp1.free; + if (taicpu(p).oper[0]^.val = 0) then + begin + hp1 := tai(p.next); + asml.remove(p); + p.free; + if not GetLastInstruction(hp1, p) then + p := hp1; + DoSubAddOpt := True; + end + end; + end; + end; + +begin + p := BlockStart; + UsedRegs := []; + while (p <> BlockEnd) Do + begin + UpDateUsedRegs(UsedRegs, tai(p.next)); + case p.Typ Of + ait_instruction: + begin + if InsContainsSegRef(taicpu(p)) then + begin + p := tai(p.next); + continue; + end; + { 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 = A_JMP) 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 + { TODO: 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=A_JMP) and + GetNextInstruction(hp1, hp2) and + FindLabel(tasmlabel(taicpu(p).oper[0]^.ref^.symbol), hp2) then + begin + if taicpu(p).opcode=A_Jcc then + begin + taicpu(p).condition:=inverse_cond(taicpu(p).condition); + tai_label(hp2).labsym.decrefs; + taicpu(p).oper[0]^.ref^.symbol:=taicpu(hp1).oper[0]^.ref^.symbol; + { when free'ing hp1, the ref. isn't decresed, so we don't + increase it (FK) + + taicpu(p).oper[0]^.ref^.symbol.increfs; + } + asml.remove(hp1); + hp1.free; + GetFinalDestination(asml, taicpu(p),0); + end + else + begin + GetFinalDestination(asml, taicpu(p),0); + p:=tai(p.next); + continue; + end; + end + else + GetFinalDestination(asml, taicpu(p),0); + end; + end; + end + else + { All other optimizes } + begin + for l := 0 to taicpu(p).ops-1 Do + if (taicpu(p).oper[l]^.typ = top_ref) then + With taicpu(p).oper[l]^.ref^ Do + begin + if (base = NR_NO) and + (index <> NR_NO) and + (scalefactor in [0,1]) then + begin + base := index; + index := NR_NO + end + end; + case taicpu(p).opcode Of + A_AND: + begin + if (taicpu(p).oper[0]^.typ = top_const) and + (taicpu(p).oper[1]^.typ = top_reg) and + GetNextInstruction(p, hp1) and + (tai(hp1).typ = ait_instruction) and + (taicpu(hp1).opcode = A_AND) and + (taicpu(hp1).oper[0]^.typ = top_const) and + (taicpu(hp1).oper[1]^.typ = top_reg) and + (getsupreg(taicpu(p).oper[1]^.reg)=getsupreg(taicpu(hp1).oper[1]^.reg)) and + (getsubreg(taicpu(p).oper[1]^.reg)<=getsubreg(taicpu(hp1).oper[1]^.reg)) then + {change "and const1, reg; and const2, reg" to "and (const1 and const2), reg"} + begin + taicpu(hp1).loadConst(0,taicpu(p).oper[0]^.val and taicpu(hp1).oper[0]^.val); + asml.remove(p); + p.free; + p:=hp1; + end + else + {change "and x, reg; jxx" to "test x, reg", if reg is deallocated before the + jump, but only if it's a conditional jump (PFV) } + if (taicpu(p).oper[1]^.typ = top_reg) and + GetNextInstruction(p, hp1) and + (hp1.typ = ait_instruction) and + (taicpu(hp1).is_jmp) and + (taicpu(hp1).opcode<>A_JMP) and + not(getsupreg(taicpu(p).oper[1]^.reg) in UsedRegs) then + taicpu(p).opcode := A_TEST; + end; + A_CMP: + begin + { cmp register,$8000 neg register + je target --> jo target + + .... only if register is deallocated before jump.} + case Taicpu(p).opsize of + S_B: v:=$80; + S_W: v:=$8000; + S_L: v:=aint($80000000); + end; + if (taicpu(p).oper[0]^.typ=Top_const) and + (taicpu(p).oper[0]^.val=v) and + (Taicpu(p).oper[1]^.typ=top_reg) and + GetNextInstruction(p, hp1) and + (hp1.typ=ait_instruction) and + (taicpu(hp1).opcode=A_Jcc) and + (Taicpu(hp1).condition in [C_E,C_NE]) and + not(getsupreg(Taicpu(p).oper[1]^.reg) in usedregs) then + begin + Taicpu(p).opcode:=A_NEG; + Taicpu(p).loadoper(0,Taicpu(p).oper[1]^); + Taicpu(p).clearop(1); + Taicpu(p).ops:=1; + if Taicpu(hp1).condition=C_E then + Taicpu(hp1).condition:=C_O + else + Taicpu(hp1).condition:=C_NO; + continue; + end; + { + @@2: @@2: + .... .... + cmp operand1,0 + jle/jbe @@1 + dec operand1 --> sub operand1,1 + jmp @@2 jge/jae @@2 + @@1: @@1: + ... ....} + if (taicpu(p).oper[0]^.typ = top_const) and + (taicpu(p).oper[1]^.typ in [top_reg,top_ref]) and + (taicpu(p).oper[0]^.val = 0) and + GetNextInstruction(p, hp1) and + (hp1.typ = ait_instruction) and + (taicpu(hp1).is_jmp) and + (taicpu(hp1).opcode=A_Jcc) and + (taicpu(hp1).condition in [C_LE,C_BE]) and + GetNextInstruction(hp1,hp2) and + (hp2.typ = ait_instruction) and + (taicpu(hp2).opcode = A_DEC) and + OpsEqual(taicpu(hp2).oper[0]^,taicpu(p).oper[1]^) and + GetNextInstruction(hp2, hp3) and + (hp3.typ = ait_instruction) and + (taicpu(hp3).is_jmp) and + (taicpu(hp3).opcode = A_JMP) and + GetNextInstruction(hp3, hp4) and + FindLabel(tasmlabel(taicpu(hp1).oper[0]^.ref^.symbol),hp4) then + begin + taicpu(hp2).Opcode := A_SUB; + taicpu(hp2).loadoper(1,taicpu(hp2).oper[0]^); + taicpu(hp2).loadConst(0,1); + taicpu(hp2).ops:=2; + taicpu(hp3).Opcode := A_Jcc; + case taicpu(hp1).condition of + C_LE: taicpu(hp3).condition := C_GE; + C_BE: taicpu(hp3).condition := C_AE; + end; + asml.remove(p); + asml.remove(hp1); + p.free; + hp1.free; + p := hp2; + continue; + end + end; + A_FLD: + begin + if (taicpu(p).oper[0]^.typ = top_reg) and + GetNextInstruction(p, hp1) and + (hp1.typ = Ait_Instruction) and + (taicpu(hp1).oper[0]^.typ = top_reg) and + (taicpu(hp1).oper[1]^.typ = top_reg) and + (taicpu(hp1).oper[0]^.reg = NR_ST) and + (taicpu(hp1).oper[1]^.reg = NR_ST1) then + { change to + fld reg fxxx reg,st + fxxxp st, st1 (hp1) + Remark: non commutative operations must be reversed! + } + begin + case taicpu(hp1).opcode Of + A_FMULP,A_FADDP, + A_FSUBP,A_FDIVP,A_FSUBRP,A_FDIVRP: + begin + case taicpu(hp1).opcode Of + A_FADDP: taicpu(hp1).opcode := A_FADD; + A_FMULP: taicpu(hp1).opcode := A_FMUL; + A_FSUBP: taicpu(hp1).opcode := A_FSUBR; + A_FSUBRP: taicpu(hp1).opcode := A_FSUB; + A_FDIVP: taicpu(hp1).opcode := A_FDIVR; + A_FDIVRP: taicpu(hp1).opcode := A_FDIV; + end; + taicpu(hp1).oper[0]^.reg := taicpu(p).oper[0]^.reg; + taicpu(hp1).oper[1]^.reg := NR_ST; + asml.remove(p); + p.free; + p := hp1; + continue; + end; + end; + end + else + if (taicpu(p).oper[0]^.typ = top_ref) and + GetNextInstruction(p, hp2) and + (hp2.typ = Ait_Instruction) and + (taicpu(hp2).ops = 2) and + (taicpu(hp2).oper[0]^.typ = top_reg) and + (taicpu(hp2).oper[1]^.typ = top_reg) and + (taicpu(p).opsize in [S_FS, S_FL]) and + (taicpu(hp2).oper[0]^.reg = NR_ST) and + (taicpu(hp2).oper[1]^.reg = NR_ST1) then + if GetLastInstruction(p, hp1) and + (hp1.typ = Ait_Instruction) and + ((taicpu(hp1).opcode = A_FLD) or + (taicpu(hp1).opcode = A_FST)) and + (taicpu(hp1).opsize = taicpu(p).opsize) and + (taicpu(hp1).oper[0]^.typ = top_ref) and + RefsEqual(taicpu(p).oper[0]^.ref^, taicpu(hp1).oper[0]^.ref^) then + if ((taicpu(hp2).opcode = A_FMULP) or + (taicpu(hp2).opcode = A_FADDP)) then + { change to + fld/fst mem1 (hp1) fld/fst mem1 + fld mem1 (p) fadd/ + faddp/ fmul st, st + fmulp st, st1 (hp2) } + begin + asml.remove(p); + p.free; + p := hp1; + if (taicpu(hp2).opcode = A_FADDP) then + taicpu(hp2).opcode := A_FADD + else + taicpu(hp2).opcode := A_FMUL; + taicpu(hp2).oper[1]^.reg := NR_ST; + end + else + { change to + fld/fst mem1 (hp1) fld/fst mem1 + fld mem1 (p) fld st} + begin + taicpu(p).changeopsize(S_FL); + taicpu(p).loadreg(0,NR_ST); + end + else + begin + case taicpu(hp2).opcode Of + A_FMULP,A_FADDP,A_FSUBP,A_FDIVP,A_FSUBRP,A_FDIVRP: + { change to + fld/fst mem1 (hp1) fld/fst mem1 + fld mem2 (p) fxxx mem2 + fxxxp st, st1 (hp2) } + + begin + case taicpu(hp2).opcode Of + A_FADDP: taicpu(p).opcode := A_FADD; + A_FMULP: taicpu(p).opcode := A_FMUL; + A_FSUBP: taicpu(p).opcode := A_FSUBR; + A_FSUBRP: taicpu(p).opcode := A_FSUB; + A_FDIVP: taicpu(p).opcode := A_FDIVR; + A_FDIVRP: taicpu(p).opcode := A_FDIV; + end; + asml.remove(hp2); + hp2.free; + end + end + end + end; + A_FSTP,A_FISTP: + if doFpuLoadStoreOpt(asmL,p) then + continue; + A_LEA: + begin + {removes seg register prefixes from LEA operations, as they + don't do anything} + taicpu(p).oper[0]^.ref^.Segment := NR_NO; + {changes "lea (%reg1), %reg2" into "mov %reg1, %reg2"} + if (taicpu(p).oper[0]^.ref^.base <> NR_NO) and + (getsupreg(taicpu(p).oper[0]^.ref^.base) in [RS_EAX..RS_ESP]) and + (taicpu(p).oper[0]^.ref^.index = NR_NO) and + (not(Assigned(taicpu(p).oper[0]^.ref^.Symbol))) then + if (taicpu(p).oper[0]^.ref^.base <> taicpu(p).oper[1]^.reg) and + (taicpu(p).oper[0]^.ref^.offset = 0) then + begin + hp1 := taicpu.op_reg_reg(A_MOV, S_L,taicpu(p).oper[0]^.ref^.base, + taicpu(p).oper[1]^.reg); + InsertLLItem(asml,p.previous,p.next, hp1); + p.free; + p := hp1; + continue; + end + else if (taicpu(p).oper[0]^.ref^.offset = 0) then + begin + hp1 := tai(p.Next); + asml.remove(p); + p.free; + p := hp1; + continue; + end + else + with taicpu(p).oper[0]^.ref^ do + if (base = taicpu(p).oper[1]^.reg) then + begin + l := offset; + if (l=1) then + begin + taicpu(p).opcode := A_INC; + taicpu(p).loadreg(0,taicpu(p).oper[1]^.reg); + taicpu(p).ops := 1 + end + else if (l=-1) then + begin + taicpu(p).opcode := A_DEC; + taicpu(p).loadreg(0,taicpu(p).oper[1]^.reg); + taicpu(p).ops := 1; + end + else + begin + taicpu(p).opcode := A_ADD; + taicpu(p).loadConst(0,l); + end; + end; + end; + A_MOV: + begin + TmpUsedRegs := UsedRegs; + if (taicpu(p).oper[1]^.typ = top_reg) and + (getsupreg(taicpu(p).oper[1]^.reg) in [RS_EAX, RS_EBX, RS_ECX, RS_EDX, RS_ESI, RS_EDI]) and + GetNextInstruction(p, hp1) and + (tai(hp1).typ = ait_instruction) and + (taicpu(hp1).opcode = A_MOV) and + (taicpu(hp1).oper[0]^.typ = top_reg) and + (taicpu(hp1).oper[0]^.reg = taicpu(p).oper[1]^.reg) then + begin + {we have "mov x, %treg; mov %treg, y} + if not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg, hp1, TmpUsedRegs)) then + {we've got "mov x, %treg; mov %treg, y; with %treg is not used after } + case taicpu(p).oper[0]^.typ Of + top_reg: + begin + { change "mov %reg, %treg; mov %treg, y" + to "mov %reg, y" } + taicpu(p).loadOper(1,taicpu(hp1).oper[1]^); + asml.remove(hp1); + hp1.free; + continue; + end; + top_ref: + if (taicpu(hp1).oper[1]^.typ = top_reg) then + begin + { change "mov mem, %treg; mov %treg, %reg" + to "mov mem, %reg" } + taicpu(p).loadoper(1,taicpu(hp1).oper[1]^); + asml.remove(hp1); + hp1.free; + continue; + end; + end + end + else + {Change "mov %reg1, %reg2; xxx %reg2, ???" to + "mov %reg1, %reg2; xxx %reg1, ???" to avoid a write/read + penalty} + if (taicpu(p).oper[0]^.typ = top_reg) and + (taicpu(p).oper[1]^.typ = top_reg) and + GetNextInstruction(p,hp1) and + (tai(hp1).typ = ait_instruction) and + (taicpu(hp1).ops >= 1) and + (taicpu(hp1).oper[0]^.typ = top_reg) and + (taicpu(hp1).oper[0]^.reg = taicpu(p).oper[1]^.reg) then + {we have "mov %reg1, %reg2; XXX %reg2, ???"} + begin + if ((taicpu(hp1).opcode = A_OR) or + (taicpu(hp1).opcode = A_TEST)) and + (taicpu(hp1).oper[1]^.typ = top_reg) and + (taicpu(hp1).oper[0]^.reg = taicpu(hp1).oper[1]^.reg) then + {we have "mov %reg1, %reg2; test/or %reg2, %reg2"} + begin + TmpUsedRegs := UsedRegs; + { reg1 will be used after the first instruction, } + { so update the allocation info } + allocRegBetween(asmL,taicpu(p).oper[0]^.reg,p,hp1,usedregs); + if GetNextInstruction(hp1, hp2) and + (hp2.typ = ait_instruction) and + taicpu(hp2).is_jmp and + not(RegUsedAfterInstruction(taicpu(hp1).oper[0]^.reg, hp1, TmpUsedRegs)) then + { change "mov %reg1, %reg2; test/or %reg2, %reg2; jxx" to + "test %reg1, %reg1; jxx" } + begin + taicpu(hp1).loadoper(0,taicpu(p).oper[0]^); + taicpu(hp1).loadoper(1,taicpu(p).oper[0]^); + asml.remove(p); + p.free; + p := hp1; + continue + end + else + {change "mov %reg1, %reg2; test/or %reg2, %reg2" to + "mov %reg1, %reg2; test/or %reg1, %reg1"} + begin + taicpu(hp1).loadoper(0,taicpu(p).oper[0]^); + taicpu(hp1).loadoper(1,taicpu(p).oper[0]^); + end; + end +{ else + if (taicpu(p.next)^.opcode + in [A_PUSH, A_OR, A_XOR, A_AND, A_TEST])} + {change "mov %reg1, %reg2; push/or/xor/... %reg2, ???" to + "mov %reg1, %reg2; push/or/xor/... %reg1, ???"} + end + else + {leave out the mov from "mov reg, x(%frame_pointer); leave/ret" (with + x >= RetOffset) as it doesn't do anything (it writes either to a + parameter or to the temporary storage room for the function + result)} + if GetNextInstruction(p, hp1) and + (tai(hp1).typ = ait_instruction) then + if ((taicpu(hp1).opcode = A_LEAVE) or + (taicpu(hp1).opcode = A_RET)) and + (taicpu(p).oper[1]^.typ = top_ref) and + (taicpu(p).oper[1]^.ref^.base = current_procinfo.FramePointer) and + not(assigned(current_procinfo.procdef.funcretsym) and + (taicpu(p).oper[1]^.ref^.offset < tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)) and + (taicpu(p).oper[1]^.ref^.index = NR_NO) and + (taicpu(p).oper[0]^.typ = top_reg) then + begin + asml.remove(p); + p.free; + p := hp1; + RemoveLastDeallocForFuncRes(asmL,p); + end + else + if (taicpu(p).oper[0]^.typ = top_reg) and + (taicpu(p).oper[1]^.typ = top_ref) and + (taicpu(p).opsize = taicpu(hp1).opsize) and + (taicpu(hp1).opcode = A_CMP) and + (taicpu(hp1).oper[1]^.typ = top_ref) and + RefsEqual(taicpu(p).oper[1]^.ref^, taicpu(hp1).oper[1]^.ref^) then + {change "mov reg1, mem1; cmp x, mem1" to "mov reg, mem1; cmp x, reg1"} + begin + taicpu(hp1).loadreg(1,taicpu(p).oper[0]^.reg); + allocRegBetween(asmL,taicpu(p).oper[0]^.reg,p,hp1,usedregs); + end; + { Next instruction is also a MOV ? } + if GetNextInstruction(p, hp1) and + (tai(hp1).typ = ait_instruction) and + (taicpu(hp1).opcode = A_MOV) and + (taicpu(hp1).opsize = taicpu(p).opsize) then + begin + if (taicpu(hp1).oper[0]^.typ = taicpu(p).oper[1]^.typ) and + (taicpu(hp1).oper[1]^.typ = taicpu(p).oper[0]^.typ) then + {mov reg1, mem1 or mov mem1, reg1 + mov mem2, reg2 mov reg2, mem2} + begin + if OpsEqual(taicpu(hp1).oper[1]^,taicpu(p).oper[0]^) then + {mov reg1, mem1 or mov mem1, reg1 + mov mem2, reg1 mov reg2, mem1} + begin + if OpsEqual(taicpu(hp1).oper[0]^,taicpu(p).oper[1]^) then + { Removes the second statement from + mov reg1, mem1/reg2 + mov mem1/reg2, reg1 } + begin + if (taicpu(p).oper[0]^.typ = top_reg) then + AllocRegBetween(asmL,taicpu(p).oper[0]^.reg,p,hp1,usedregs); + asml.remove(hp1); + hp1.free; + end + else + begin + TmpUsedRegs := UsedRegs; + UpdateUsedRegs(TmpUsedRegs, tai(hp1.next)); + if (taicpu(p).oper[1]^.typ = top_ref) and + { mov reg1, mem1 + mov mem2, reg1 } + (taicpu(hp1).oper[0]^.ref^.refaddr = addr_no) and + GetNextInstruction(hp1, hp2) and + (hp2.typ = ait_instruction) and + (taicpu(hp2).opcode = A_CMP) and + (taicpu(hp2).opsize = taicpu(p).opsize) and + (taicpu(hp2).oper[0]^.typ = TOp_Ref) and + (taicpu(hp2).oper[1]^.typ = TOp_Reg) and + RefsEqual(taicpu(hp2).oper[0]^.ref^, taicpu(p).oper[1]^.ref^) and + (taicpu(hp2).oper[1]^.reg= taicpu(p).oper[0]^.reg) and + not(RegUsedAfterInstruction(taicpu(p).oper[0]^.reg, hp2, TmpUsedRegs)) then + { change to + mov reg1, mem1 mov reg1, mem1 + mov mem2, reg1 cmp reg1, mem2 + cmp mem1, reg1 } + begin + asml.remove(hp2); + hp2.free; + taicpu(hp1).opcode := A_CMP; + taicpu(hp1).loadref(1,taicpu(hp1).oper[0]^.ref^); + taicpu(hp1).loadreg(0,taicpu(p).oper[0]^.reg); + end; + end; + end + else + begin + tmpUsedRegs := UsedRegs; + if GetNextInstruction(hp1, hp2) and + (taicpu(p).oper[0]^.typ = top_ref) and + (taicpu(p).oper[1]^.typ = top_reg) and + (taicpu(hp1).oper[0]^.typ = top_reg) and + (taicpu(hp1).oper[0]^.reg = taicpu(p).oper[1]^.reg) and + (taicpu(hp1).oper[1]^.typ = top_ref) and + (tai(hp2).typ = ait_instruction) and + (taicpu(hp2).opcode = A_MOV) and + (taicpu(hp2).opsize = taicpu(p).opsize) and + (taicpu(hp2).oper[1]^.typ = top_reg) and + (taicpu(hp2).oper[0]^.typ = top_ref) and + RefsEqual(taicpu(hp2).oper[0]^.ref^, taicpu(hp1).oper[1]^.ref^) then + if not regInRef(getsupreg(taicpu(hp2).oper[1]^.reg),taicpu(hp2).oper[0]^.ref^) and + not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg,hp1,tmpUsedRegs)) then + { mov mem1, %reg1 + mov %reg1, mem2 + mov mem2, reg2 + to: + mov mem1, reg2 + mov reg2, mem2} + begin + AllocRegBetween(asmL,taicpu(hp2).oper[1]^.reg,p,hp2,usedregs); + taicpu(p).loadoper(1,taicpu(hp2).oper[1]^); + taicpu(hp1).loadoper(0,taicpu(hp2).oper[1]^); + asml.remove(hp2); + hp2.free; + end + else + if (taicpu(p).oper[1]^.reg <> taicpu(hp2).oper[1]^.reg) and + not(RegInRef(getsupreg(taicpu(p).oper[1]^.reg),taicpu(p).oper[0]^.ref^)) and + not(RegInRef(getsupreg(taicpu(hp2).oper[1]^.reg),taicpu(hp2).oper[0]^.ref^)) then + { mov mem1, reg1 mov mem1, reg1 + mov reg1, mem2 mov reg1, mem2 + mov mem2, reg2 mov mem2, reg1 + to: to: + mov mem1, reg1 mov mem1, reg1 + mov mem1, reg2 mov reg1, mem2 + mov reg1, mem2 + + or (if mem1 depends on reg1 + and/or if mem2 depends on reg2) + to: + mov mem1, reg1 + mov reg1, mem2 + mov reg1, reg2 + } + begin + taicpu(hp1).loadRef(0,taicpu(p).oper[0]^.ref^); + taicpu(hp1).loadReg(1,taicpu(hp2).oper[1]^.reg); + taicpu(hp2).loadRef(1,taicpu(hp2).oper[0]^.ref^); + taicpu(hp2).loadReg(0,taicpu(p).oper[1]^.reg); + allocRegBetween(asmL,taicpu(p).oper[1]^.reg,p,hp2,usedregs); + if (taicpu(p).oper[0]^.ref^.base <> NR_NO) and + (getsupreg(taicpu(p).oper[0]^.ref^.base) in [RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI,RS_EDI]) then + allocRegBetween(asmL,taicpu(p).oper[0]^.ref^.base,p,hp2,usedregs); + if (taicpu(p).oper[0]^.ref^.index <> NR_NO) and + (getsupreg(taicpu(p).oper[0]^.ref^.index) in [RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI,RS_EDI]) then + allocRegBetween(asmL,taicpu(p).oper[0]^.ref^.index,p,hp2,usedregs); + end + else + if (taicpu(hp1).Oper[0]^.reg <> taicpu(hp2).Oper[1]^.reg) then + begin + taicpu(hp2).loadReg(0,taicpu(hp1).Oper[0]^.reg); + allocRegBetween(asmL,taicpu(p).oper[1]^.reg,p,hp2,usedregs); + end + else + begin + asml.remove(hp2); + hp2.free; + end + end + end + else +(* {movl [mem1],reg1 + movl [mem1],reg2 + to: + movl [mem1],reg1 + movl reg1,reg2 } + if (taicpu(p).oper[0]^.typ = top_ref) and + (taicpu(p).oper[1]^.typ = top_reg) and + (taicpu(hp1).oper[0]^.typ = top_ref) and + (taicpu(hp1).oper[1]^.typ = top_reg) and + (taicpu(p).opsize = taicpu(hp1).opsize) and + RefsEqual(TReference(taicpu(p).oper[0]^^),taicpu(hp1).oper[0]^^.ref^) and + (taicpu(p).oper[1]^.reg<>taicpu(hp1).oper[0]^^.ref^.base) and + (taicpu(p).oper[1]^.reg<>taicpu(hp1).oper[0]^^.ref^.index) then + taicpu(hp1).loadReg(0,taicpu(p).oper[1]^.reg) + else*) + { movl const1,[mem1] + movl [mem1],reg1 + to: + movl const1,reg1 + movl reg1,[mem1] } + if (taicpu(p).oper[0]^.typ = top_const) and + (taicpu(p).oper[1]^.typ = top_ref) and + (taicpu(hp1).oper[0]^.typ = top_ref) and + (taicpu(hp1).oper[1]^.typ = top_reg) and + (taicpu(p).opsize = taicpu(hp1).opsize) and + RefsEqual(taicpu(hp1).oper[0]^.ref^,taicpu(p).oper[1]^.ref^) and + not(reginref(getsupreg(taicpu(hp1).oper[1]^.reg),taicpu(hp1).oper[0]^.ref^)) then + begin + allocregbetween(asml,taicpu(hp1).oper[1]^.reg,p,hp1,usedregs); + taicpu(hp1).loadReg(0,taicpu(hp1).oper[1]^.reg); + taicpu(hp1).loadRef(1,taicpu(p).oper[1]^.ref^); + taicpu(p).loadReg(1,taicpu(hp1).oper[0]^.reg); + end + end; + if GetNextInstruction(p, hp1) and + (Tai(hp1).typ = ait_instruction) and + ((Taicpu(hp1).opcode = A_BTS) or (Taicpu(hp1).opcode = A_BTR)) and + (Taicpu(hp1).opsize = Taicpu(p).opsize) and + GetNextInstruction(hp1, hp2) and + (Tai(hp2).typ = ait_instruction) and + (Taicpu(hp2).opcode = A_OR) and + (Taicpu(hp1).opsize = Taicpu(p).opsize) and + (Taicpu(hp2).opsize = Taicpu(p).opsize) and + (Taicpu(p).oper[0]^.typ = top_const) and (Taicpu(p).oper[0]^.val=0) and + (Taicpu(p).oper[1]^.typ = top_reg) and + (Taicpu(hp1).oper[1]^.typ = top_reg) and + (Taicpu(p).oper[1]^.reg=Taicpu(hp1).oper[1]^.reg) and + (Taicpu(hp2).oper[1]^.typ = top_reg) and + (Taicpu(p).oper[1]^.reg=Taicpu(hp2).oper[1]^.reg) then + {mov reg1,0 + bts reg1,operand1 --> mov reg1,operand2 + or reg1,operand2 bts reg1,operand1} + begin + Taicpu(hp2).opcode:=A_MOV; + asml.remove(hp1); + insertllitem(asml,hp2,hp2.next,hp1); + asml.remove(p); + p.free; + end; + end; + + A_MOVSX, + A_MOVZX : + begin + if (taicpu(p).oper[1]^.typ = top_reg) and + GetNextInstruction(p,hp1) and + (hp1.typ = ait_instruction) and + IsFoldableArithOp(taicpu(hp1),taicpu(p).oper[1]^.reg) and + (getsupreg(taicpu(hp1).oper[0]^.reg) in [RS_EAX, RS_EBX, RS_ECX, RS_EDX]) and + GetNextInstruction(hp1,hp2) and + (hp2.typ = ait_instruction) and + (taicpu(hp2).opcode = A_MOV) and + (taicpu(hp2).oper[0]^.typ = top_reg) and + OpsEqual(taicpu(hp2).oper[1]^,taicpu(p).oper[0]^) then + { change movsX/movzX reg/ref, reg2 } + { add/sub/or/... reg3/$const, reg2 } + { mov reg2 reg/ref } + { to add/sub/or/... reg3/$const, reg/ref } + begin + { by example: + movswl %si,%eax movswl %si,%eax p + decl %eax addl %edx,%eax hp1 + movw %ax,%si movw %ax,%si hp2 + -> + movswl %si,%eax movswl %si,%eax p + decw %eax addw %edx,%eax hp1 + movw %ax,%si movw %ax,%si hp2 + } + taicpu(hp1).changeopsize(taicpu(hp2).opsize); + { + -> + movswl %si,%eax movswl %si,%eax p + decw %si addw %dx,%si hp1 + movw %ax,%si movw %ax,%si hp2 + } + case taicpu(hp1).ops of + 1: + taicpu(hp1).loadoper(0,taicpu(hp2).oper[1]^); + 2: + begin + taicpu(hp1).loadoper(1,taicpu(hp2).oper[1]^); + if (taicpu(hp1).oper[0]^.typ = top_reg) then + setsubreg(taicpu(hp1).oper[0]^.reg,getsubreg(taicpu(hp2).oper[0]^.reg)); + end; + else + internalerror(2008042701); + end; + { + -> + decw %si addw %dx,%si p + } + asml.remove(p); + asml.remove(hp2); + p.free; + hp2.free; + p := hp1 + end + { removes superfluous And's after movzx's } + else if taicpu(p).opcode=A_MOVZX then + begin + if (taicpu(p).oper[1]^.typ = top_reg) and + GetNextInstruction(p, hp1) and + (tai(hp1).typ = ait_instruction) and + (taicpu(hp1).opcode = A_AND) and + (taicpu(hp1).oper[0]^.typ = top_const) and + (taicpu(hp1).oper[1]^.typ = top_reg) and + (taicpu(hp1).oper[1]^.reg = taicpu(p).oper[1]^.reg) then + case taicpu(p).opsize Of + S_BL, S_BW: + if (taicpu(hp1).oper[0]^.val = $ff) then + begin + asml.remove(hp1); + hp1.free; + end; + S_WL: + if (taicpu(hp1).oper[0]^.val = $ffff) then + begin + asml.remove(hp1); + hp1.free; + end; + end; + {changes some movzx constructs to faster synonims (all examples + are given with eax/ax, but are also valid for other registers)} + if (taicpu(p).oper[1]^.typ = top_reg) then + if (taicpu(p).oper[0]^.typ = top_reg) then + case taicpu(p).opsize of + S_BW: + begin + if (getsupreg(taicpu(p).oper[0]^.reg)=getsupreg(taicpu(p).oper[1]^.reg)) and + not(cs_opt_size in current_settings.optimizerswitches) then + {Change "movzbw %al, %ax" to "andw $0x0ffh, %ax"} + begin + taicpu(p).opcode := A_AND; + taicpu(p).changeopsize(S_W); + taicpu(p).loadConst(0,$ff); + end + else if GetNextInstruction(p, hp1) and + (tai(hp1).typ = ait_instruction) and + (taicpu(hp1).opcode = A_AND) and + (taicpu(hp1).oper[0]^.typ = top_const) and + (taicpu(hp1).oper[1]^.typ = top_reg) and + (taicpu(hp1).oper[1]^.reg = taicpu(p).oper[1]^.reg) then + {Change "movzbw %reg1, %reg2; andw $const, %reg2" + to "movw %reg1, reg2; andw $(const1 and $ff), %reg2"} + begin + taicpu(p).opcode := A_MOV; + taicpu(p).changeopsize(S_W); + setsubreg(taicpu(p).oper[0]^.reg,R_SUBW); + taicpu(hp1).loadConst(0,taicpu(hp1).oper[0]^.val and $ff); + end; + end; + S_BL: + begin + if (getsupreg(taicpu(p).oper[0]^.reg)=getsupreg(taicpu(p).oper[1]^.reg)) and + not(cs_opt_size in current_settings.optimizerswitches) then + {Change "movzbl %al, %eax" to "andl $0x0ffh, %eax"} + begin + taicpu(p).opcode := A_AND; + taicpu(p).changeopsize(S_L); + taicpu(p).loadConst(0,$ff) + end + else if GetNextInstruction(p, hp1) and + (tai(hp1).typ = ait_instruction) and + (taicpu(hp1).opcode = A_AND) and + (taicpu(hp1).oper[0]^.typ = top_const) and + (taicpu(hp1).oper[1]^.typ = top_reg) and + (taicpu(hp1).oper[1]^.reg = taicpu(p).oper[1]^.reg) then + {Change "movzbl %reg1, %reg2; andl $const, %reg2" + to "movl %reg1, reg2; andl $(const1 and $ff), %reg2"} + begin + taicpu(p).opcode := A_MOV; + taicpu(p).changeopsize(S_L); + setsubreg(taicpu(p).oper[0]^.reg,R_SUBWHOLE); + taicpu(hp1).loadConst(0,taicpu(hp1).oper[0]^.val and $ff); + end + end; + S_WL: + begin + if (getsupreg(taicpu(p).oper[0]^.reg)=getsupreg(taicpu(p).oper[1]^.reg)) and + not(cs_opt_size in current_settings.optimizerswitches) then + {Change "movzwl %ax, %eax" to "andl $0x0ffffh, %eax"} + begin + taicpu(p).opcode := A_AND; + taicpu(p).changeopsize(S_L); + taicpu(p).loadConst(0,$ffff); + end + else if GetNextInstruction(p, hp1) and + (tai(hp1).typ = ait_instruction) and + (taicpu(hp1).opcode = A_AND) and + (taicpu(hp1).oper[0]^.typ = top_const) and + (taicpu(hp1).oper[1]^.typ = top_reg) and + (taicpu(hp1).oper[1]^.reg = taicpu(p).oper[1]^.reg) then + {Change "movzwl %reg1, %reg2; andl $const, %reg2" + to "movl %reg1, reg2; andl $(const1 and $ffff), %reg2"} + begin + taicpu(p).opcode := A_MOV; + taicpu(p).changeopsize(S_L); + setsubreg(taicpu(p).oper[0]^.reg,R_SUBWHOLE); + taicpu(hp1).loadConst(0,taicpu(hp1).oper[0]^.val and $ffff); + end; + end; + end + else if (taicpu(p).oper[0]^.typ = top_ref) then + begin + if GetNextInstruction(p, hp1) and + (tai(hp1).typ = ait_instruction) and + (taicpu(hp1).opcode = A_AND) and + (taicpu(hp1).oper[0]^.typ = Top_Const) and + (taicpu(hp1).oper[1]^.typ = Top_Reg) and + (taicpu(hp1).oper[1]^.reg = taicpu(p).oper[1]^.reg) then + begin + taicpu(p).opcode := A_MOV; + case taicpu(p).opsize Of + S_BL: + begin + taicpu(p).changeopsize(S_L); + taicpu(hp1).loadConst(0,taicpu(hp1).oper[0]^.val and $ff); + end; + S_WL: + begin + taicpu(p).changeopsize(S_L); + taicpu(hp1).loadConst(0,taicpu(hp1).oper[0]^.val and $ffff); + end; + S_BW: + begin + taicpu(p).changeopsize(S_W); + taicpu(hp1).loadConst(0,taicpu(hp1).oper[0]^.val and $ff); + end; + end; + end; + end; + end; + end; + +(* should not be generated anymore by the current code generator + A_POP: + begin + if target_info.system=system_i386_go32v2 then + begin + { Transform a series of pop/pop/pop/push/push/push to } + { 'movl x(%esp),%reg' for go32v2 (not for the rest, } + { because I'm not sure whether they can cope with } + { 'movl x(%esp),%reg' with x > 0, I believe we had } + { such a problem when using esp as frame pointer (JM) } + if (taicpu(p).oper[0]^.typ = top_reg) then + begin + hp1 := p; + hp2 := p; + l := 0; + while getNextInstruction(hp1,hp1) and + (hp1.typ = ait_instruction) and + (taicpu(hp1).opcode = A_POP) and + (taicpu(hp1).oper[0]^.typ = top_reg) do + begin + hp2 := hp1; + inc(l,4); + end; + getLastInstruction(p,hp3); + l1 := 0; + while (hp2 <> hp3) and + assigned(hp1) and + (hp1.typ = ait_instruction) and + (taicpu(hp1).opcode = A_PUSH) and + (taicpu(hp1).oper[0]^.typ = top_reg) and + (taicpu(hp1).oper[0]^.reg.enum = taicpu(hp2).oper[0]^.reg.enum) do + begin + { change it to a two op operation } + taicpu(hp2).oper[1]^.typ:=top_none; + taicpu(hp2).ops:=2; + taicpu(hp2).opcode := A_MOV; + taicpu(hp2).loadoper(1,taicpu(hp1).oper[0]^); + reference_reset(tmpref); + tmpRef.base.enum:=R_INTREGISTER; + tmpRef.base.number:=NR_STACK_POINTER_REG; + convert_register_to_enum(tmpref.base); + tmpRef.offset := l; + taicpu(hp2).loadRef(0,tmpRef); + hp4 := hp1; + getNextInstruction(hp1,hp1); + asml.remove(hp4); + hp4.free; + getLastInstruction(hp2,hp2); + dec(l,4); + inc(l1); + end; + if l <> -4 then + begin + inc(l,4); + for l1 := l1 downto 1 do + begin + getNextInstruction(hp2,hp2); + dec(taicpu(hp2).oper[0]^.ref^.offset,l); + end + end + end + end + else + begin + if (taicpu(p).oper[0]^.typ = top_reg) and + GetNextInstruction(p, hp1) and + (tai(hp1).typ=ait_instruction) and + (taicpu(hp1).opcode=A_PUSH) and + (taicpu(hp1).oper[0]^.typ = top_reg) and + (taicpu(hp1).oper[0]^.reg.enum=taicpu(p).oper[0]^.reg.enum) then + begin + { change it to a two op operation } + taicpu(p).oper[1]^.typ:=top_none; + taicpu(p).ops:=2; + taicpu(p).opcode := A_MOV; + taicpu(p).loadoper(1,taicpu(p).oper[0]^); + reference_reset(tmpref); + TmpRef.base.enum := R_ESP; + taicpu(p).loadRef(0,TmpRef); + asml.remove(hp1); + hp1.free; + end; + end; + end; +*) + A_PUSH: + begin + if (taicpu(p).opsize = S_W) and + (taicpu(p).oper[0]^.typ = Top_Const) and + GetNextInstruction(p, hp1) and + (tai(hp1).typ = ait_instruction) and + (taicpu(hp1).opcode = A_PUSH) and + (taicpu(hp1).oper[0]^.typ = Top_Const) and + (taicpu(hp1).opsize = S_W) then + begin + taicpu(p).changeopsize(S_L); + taicpu(p).loadConst(0,taicpu(p).oper[0]^.val shl 16 + word(taicpu(hp1).oper[0]^.val)); + asml.remove(hp1); + hp1.free; + end; + end; + A_SHL, A_SAL: + begin + if (taicpu(p).oper[0]^.typ = Top_Const) and + (taicpu(p).oper[1]^.typ = Top_Reg) and + (taicpu(p).opsize = S_L) and + (taicpu(p).oper[0]^.val <= 3) then + {Changes "shl const, %reg32; add const/reg, %reg32" to one lea statement} + begin + TmpBool1 := True; {should we check the next instruction?} + TmpBool2 := False; {have we found an add/sub which could be + integrated in the lea?} + reference_reset(tmpref,2); + TmpRef.index := taicpu(p).oper[1]^.reg; + TmpRef.scalefactor := 1 shl taicpu(p).oper[0]^.val; + while TmpBool1 and + GetNextInstruction(p, hp1) and + (tai(hp1).typ = ait_instruction) and + ((((taicpu(hp1).opcode = A_ADD) or + (taicpu(hp1).opcode = A_SUB)) and + (taicpu(hp1).oper[1]^.typ = Top_Reg) and + (taicpu(hp1).oper[1]^.reg = taicpu(p).oper[1]^.reg)) or + (((taicpu(hp1).opcode = A_INC) or + (taicpu(hp1).opcode = A_DEC)) and + (taicpu(hp1).oper[0]^.typ = Top_Reg) and + (taicpu(hp1).oper[0]^.reg = taicpu(p).oper[1]^.reg))) and + (not GetNextInstruction(hp1,hp2) or + not instrReadsFlags(hp2)) Do + begin + TmpBool1 := False; + if (taicpu(hp1).oper[0]^.typ = Top_Const) then + begin + TmpBool1 := True; + TmpBool2 := True; + case taicpu(hp1).opcode of + A_ADD: + inc(TmpRef.offset, longint(taicpu(hp1).oper[0]^.val)); + A_SUB: + dec(TmpRef.offset, longint(taicpu(hp1).oper[0]^.val)); + end; + asml.remove(hp1); + hp1.free; + end + else + if (taicpu(hp1).oper[0]^.typ = Top_Reg) and + (((taicpu(hp1).opcode = A_ADD) and + (TmpRef.base = NR_NO)) or + (taicpu(hp1).opcode = A_INC) or + (taicpu(hp1).opcode = A_DEC)) then + begin + TmpBool1 := True; + TmpBool2 := True; + case taicpu(hp1).opcode of + A_ADD: + TmpRef.base := taicpu(hp1).oper[0]^.reg; + A_INC: + inc(TmpRef.offset); + A_DEC: + dec(TmpRef.offset); + end; + asml.remove(hp1); + hp1.free; + end; + end; + if TmpBool2 or + ((current_settings.optimizecputype < cpu_Pentium2) and + (taicpu(p).oper[0]^.val <= 3) and + not(cs_opt_size in current_settings.optimizerswitches)) then + begin + if not(TmpBool2) and + (taicpu(p).oper[0]^.val = 1) then + begin + hp1 := taicpu.Op_reg_reg(A_ADD,taicpu(p).opsize, + taicpu(p).oper[1]^.reg, taicpu(p).oper[1]^.reg) + end + else + hp1 := taicpu.op_ref_reg(A_LEA, S_L, TmpRef, + taicpu(p).oper[1]^.reg); + InsertLLItem(asml,p.previous, p.next, hp1); + p.free; + p := hp1; + end; + end + else + if (current_settings.optimizecputype < cpu_Pentium2) and + (taicpu(p).oper[0]^.typ = top_const) and + (taicpu(p).oper[1]^.typ = top_reg) then + if (taicpu(p).oper[0]^.val = 1) then + {changes "shl $1, %reg" to "add %reg, %reg", which is the same on a 386, + but faster on a 486, and Tairable in both U and V pipes on the Pentium + (unlike shl, which is only Tairable in the U pipe)} + begin + hp1 := taicpu.Op_reg_reg(A_ADD,taicpu(p).opsize, + taicpu(p).oper[1]^.reg, taicpu(p).oper[1]^.reg); + InsertLLItem(asml,p.previous, p.next, hp1); + p.free; + p := hp1; + end + else if (taicpu(p).opsize = S_L) and + (taicpu(p).oper[0]^.val<= 3) then + {changes "shl $2, %reg" to "lea (,%reg,4), %reg" + "shl $3, %reg" to "lea (,%reg,8), %reg} + begin + reference_reset(tmpref,2); + TmpRef.index := taicpu(p).oper[1]^.reg; + TmpRef.scalefactor := 1 shl taicpu(p).oper[0]^.val; + hp1 := taicpu.Op_ref_reg(A_LEA,S_L,TmpRef, taicpu(p).oper[1]^.reg); + InsertLLItem(asml,p.previous, p.next, hp1); + p.free; + p := hp1; + end + end; + A_SETcc : + { changes + setcc (funcres) setcc reg + movb (funcres), reg to leave/ret + leave/ret } + begin + if (taicpu(p).oper[0]^.typ = top_ref) and + GetNextInstruction(p, hp1) and + GetNextInstruction(hp1, hp2) and + (hp2.typ = ait_instruction) and + ((taicpu(hp2).opcode = A_LEAVE) or + (taicpu(hp2).opcode = A_RET)) and + (taicpu(p).oper[0]^.ref^.base = current_procinfo.FramePointer) and + (taicpu(p).oper[0]^.ref^.index = NR_NO) and + not(assigned(current_procinfo.procdef.funcretsym) and + (taicpu(p).oper[0]^.ref^.offset < tabstractnormalvarsym(current_procinfo.procdef.funcretsym).localloc.reference.offset)) and + (hp1.typ = ait_instruction) and + (taicpu(hp1).opcode = A_MOV) and + (taicpu(hp1).opsize = S_B) and + (taicpu(hp1).oper[0]^.typ = top_ref) and + RefsEqual(taicpu(hp1).oper[0]^.ref^, taicpu(p).oper[0]^.ref^) then + begin + taicpu(p).loadReg(0,taicpu(hp1).oper[1]^.reg); + asml.remove(hp1); + hp1.free; + end + end; + A_SUB: + { * change "subl $2, %esp; pushw x" to "pushl x"} + { * change "sub/add const1, reg" or "dec reg" followed by + "sub const2, reg" to one "sub ..., reg" } + begin + if (taicpu(p).oper[0]^.typ = top_const) and + (taicpu(p).oper[1]^.typ = top_reg) then + if (taicpu(p).oper[0]^.val = 2) and + (taicpu(p).oper[1]^.reg = NR_ESP) and + { Don't do the sub/push optimization if the sub } + { comes from setting up the stack frame (JM) } + (not getLastInstruction(p,hp1) or + (hp1.typ <> ait_instruction) or + (taicpu(hp1).opcode <> A_MOV) or + (taicpu(hp1).oper[0]^.typ <> top_reg) or + (taicpu(hp1).oper[0]^.reg <> NR_ESP) or + (taicpu(hp1).oper[1]^.typ <> top_reg) or + (taicpu(hp1).oper[1]^.reg <> NR_EBP)) then + begin + hp1 := tai(p.next); + while Assigned(hp1) and + (tai(hp1).typ in [ait_instruction]+SkipInstr) and + not regReadByInstruction(RS_ESP,hp1) and + not regModifiedByInstruction(RS_ESP,hp1) do + hp1 := tai(hp1.next); + if Assigned(hp1) and + (tai(hp1).typ = ait_instruction) and + (taicpu(hp1).opcode = A_PUSH) and + (taicpu(hp1).opsize = S_W) then + begin + taicpu(hp1).changeopsize(S_L); + if taicpu(hp1).oper[0]^.typ=top_reg then + setsubreg(taicpu(hp1).oper[0]^.reg,R_SUBWHOLE); + hp1 := tai(p.next); + asml.remove(p); + p.free; + p := hp1; + continue + end; + if DoSubAddOpt(p) then + continue; + end + else if DoSubAddOpt(p) then + continue + end; + end; + end; { if is_jmp } + end; + end; + updateUsedRegs(UsedRegs,p); + p:=tai(p.next); + end; +end; + + +procedure PeepHoleOptPass2(asml: TAsmList; BlockStart, BlockEnd: tai); + + function CanBeCMOV(p : tai) : boolean; + begin + CanBeCMOV:=assigned(p) and (p.typ=ait_instruction) and + (taicpu(p).opcode=A_MOV) and + (taicpu(p).opsize in [S_L,S_W]) and + ((taicpu(p).oper[0]^.typ = top_reg) + { we can't use cmov ref,reg because + ref could be nil and cmov still throws an exception + if ref=nil but the mov isn't done (FK) + or ((taicpu(p).oper[0]^.typ = top_ref) and + (taicpu(p).oper[0]^.ref^.refaddr = addr_no)) + } + ) and + (taicpu(p).oper[1]^.typ in [top_reg]); + end; + +var + p,hp1,hp2: tai; + l : longint; + condition : tasmcond; + hp3: tai; + UsedRegs, TmpUsedRegs: TRegSet; + carryadd_opcode: Tasmop; + +begin + p := BlockStart; + UsedRegs := []; + while (p <> BlockEnd) Do + begin + UpdateUsedRegs(UsedRegs, tai(p.next)); + case p.Typ Of + Ait_Instruction: + begin + if InsContainsSegRef(taicpu(p)) then + begin + p := tai(p.next); + continue; + end; + case taicpu(p).opcode Of + A_Jcc: + begin + { jb @@1 cmc + inc/dec operand --> adc/sbb operand,0 + @@1: + + ... and ... + + jnb @@1 + inc/dec operand --> adc/sbb operand,0 + @@1: } + if GetNextInstruction(p,hp1) and (hp1.typ=ait_instruction) and + GetNextInstruction(hp1,hp2) and (hp2.typ=ait_label) and + (Tasmlabel(Taicpu(p).oper[0]^.ref^.symbol)=Tai_label(hp2).labsym) then + begin + carryadd_opcode:=A_NONE; + if Taicpu(p).condition in [C_NAE,C_B] then + begin + if Taicpu(hp1).opcode=A_INC then + carryadd_opcode:=A_ADC; + if Taicpu(hp1).opcode=A_DEC then + carryadd_opcode:=A_SBB; + if carryadd_opcode<>A_NONE then + begin + Taicpu(p).clearop(0); + Taicpu(p).ops:=0; + Taicpu(p).is_jmp:=false; + Taicpu(p).opcode:=A_CMC; + Taicpu(p).condition:=C_NONE; + Taicpu(hp1).ops:=2; + Taicpu(hp1).loadoper(1,Taicpu(hp1).oper[0]^); + Taicpu(hp1).loadconst(0,0); + Taicpu(hp1).opcode:=carryadd_opcode; + continue; + end; + end; + if Taicpu(p).condition in [C_AE,C_NB] then + begin + if Taicpu(hp1).opcode=A_INC then + carryadd_opcode:=A_ADC; + if Taicpu(hp1).opcode=A_DEC then + carryadd_opcode:=A_SBB; + if carryadd_opcode<>A_NONE then + begin + asml.remove(p); + p.free; + Taicpu(hp1).ops:=2; + Taicpu(hp1).loadoper(1,Taicpu(hp1).oper[0]^); + Taicpu(hp1).loadconst(0,0); + Taicpu(hp1).opcode:=carryadd_opcode; + p:=hp1; + continue; + end; + end; + end; + if (current_settings.cputype>=cpu_Pentium2) then + begin + { check for + jCC xxx + <several movs> + xxx: + } + l:=0; + GetNextInstruction(p, hp1); + while assigned(hp1) and + CanBeCMOV(hp1) and + { stop on labels } + not(hp1.typ=ait_label) do + begin + inc(l); + GetNextInstruction(hp1,hp1); + end; + if assigned(hp1) then + begin + if FindLabel(tasmlabel(taicpu(p).oper[0]^.ref^.symbol),hp1) then + begin + if (l<=4) and (l>0) then + begin + condition:=inverse_cond(taicpu(p).condition); + hp2:=p; + GetNextInstruction(p,hp1); + p:=hp1; + repeat + taicpu(hp1).opcode:=A_CMOVcc; + taicpu(hp1).condition:=condition; + GetNextInstruction(hp1,hp1); + until not(assigned(hp1)) or + not(CanBeCMOV(hp1)); + { wait with removing else GetNextInstruction could + ignore the label if it was the only usage in the + jump moved away } + tasmlabel(taicpu(hp2).oper[0]^.ref^.symbol).decrefs; + asml.remove(hp2); + hp2.free; + continue; + end; + end + else + begin + { check further for + jCC xxx + <several movs 1> + jmp yyy + xxx: + <several movs 2> + yyy: + } + { hp2 points to jmp yyy } + hp2:=hp1; + { skip hp1 to xxx } + GetNextInstruction(hp1, hp1); + if assigned(hp2) and + assigned(hp1) and + (l<=3) and + (hp2.typ=ait_instruction) and + (taicpu(hp2).is_jmp) and + (taicpu(hp2).condition=C_None) and + { real label and jump, no further references to the + label are allowed } + (tasmlabel(taicpu(p).oper[0]^.ref^.symbol).getrefs=2) and + FindLabel(tasmlabel(taicpu(p).oper[0]^.ref^.symbol),hp1) then + begin + l:=0; + { skip hp1 to <several moves 2> } + GetNextInstruction(hp1, hp1); + while assigned(hp1) and + CanBeCMOV(hp1) do + begin + inc(l); + GetNextInstruction(hp1, hp1); + end; + { hp1 points to yyy: } + if assigned(hp1) and + FindLabel(tasmlabel(taicpu(hp2).oper[0]^.ref^.symbol),hp1) then + begin + condition:=inverse_cond(taicpu(p).condition); + GetNextInstruction(p,hp1); + hp3:=p; + p:=hp1; + repeat + taicpu(hp1).opcode:=A_CMOVcc; + taicpu(hp1).condition:=condition; + GetNextInstruction(hp1,hp1); + until not(assigned(hp1)) or + not(CanBeCMOV(hp1)); + { hp2 is still at jmp yyy } + GetNextInstruction(hp2,hp1); + { hp2 is now at xxx: } + condition:=inverse_cond(condition); + GetNextInstruction(hp1,hp1); + { hp1 is now at <several movs 2> } + repeat + taicpu(hp1).opcode:=A_CMOVcc; + taicpu(hp1).condition:=condition; + GetNextInstruction(hp1,hp1); + until not(assigned(hp1)) or + not(CanBeCMOV(hp1)); + { + asml.remove(hp1.next) + hp1.next.free; + asml.remove(hp1); + hp1.free; + } + { remove jCC } + tasmlabel(taicpu(hp3).oper[0]^.ref^.symbol).decrefs; + asml.remove(hp3); + hp3.free; + { remove jmp } + tasmlabel(taicpu(hp2).oper[0]^.ref^.symbol).decrefs; + asml.remove(hp2); + hp2.free; + continue; + end; + end; + end; + end; + end; + end; + A_FSTP,A_FISTP: + if doFpuLoadStoreOpt(asmL,p) then + continue; + A_IMUL: + begin + if (taicpu(p).ops >= 2) and + ((taicpu(p).oper[0]^.typ = top_const) or + ((taicpu(p).oper[0]^.typ = top_ref) and (taicpu(p).oper[0]^.ref^.refaddr=addr_full))) and + (taicpu(p).oper[1]^.typ = top_reg) and + ((taicpu(p).ops = 2) or + ((taicpu(p).oper[2]^.typ = top_reg) and + (taicpu(p).oper[2]^.reg = taicpu(p).oper[1]^.reg))) and + getLastInstruction(p,hp1) and + (hp1.typ = ait_instruction) and + (taicpu(hp1).opcode = A_MOV) and + (taicpu(hp1).oper[0]^.typ = top_reg) and + (taicpu(hp1).oper[1]^.typ = top_reg) and + (taicpu(hp1).oper[1]^.reg = taicpu(p).oper[1]^.reg) then + { change "mov reg1,reg2; imul y,reg2" to "imul y,reg1,reg2" } + begin + taicpu(p).ops := 3; + taicpu(p).loadreg(1,taicpu(hp1).oper[0]^.reg); + taicpu(p).loadreg(2,taicpu(hp1).oper[1]^.reg); + asml.remove(hp1); + hp1.free; + end; + end; + A_MOV: + begin + if (taicpu(p).oper[0]^.typ = top_reg) and + (taicpu(p).oper[1]^.typ = top_reg) and + GetNextInstruction(p, hp1) and + (hp1.typ = ait_Instruction) and + ((taicpu(hp1).opcode = A_MOV) or + (taicpu(hp1).opcode = A_MOVZX) or + (taicpu(hp1).opcode = A_MOVSX)) and + (taicpu(hp1).oper[0]^.typ = top_ref) and + (taicpu(hp1).oper[1]^.typ = top_reg) and + ((taicpu(hp1).oper[0]^.ref^.base = taicpu(p).oper[1]^.reg) or + (taicpu(hp1).oper[0]^.ref^.index = taicpu(p).oper[1]^.reg)) and + (getsupreg(taicpu(hp1).oper[1]^.reg) = getsupreg(taicpu(p).oper[1]^.reg)) then + {mov reg1, reg2 + mov/zx/sx (reg2, ..), reg2 to mov/zx/sx (reg1, ..), reg2} + begin + if (taicpu(hp1).oper[0]^.ref^.base = taicpu(p).oper[1]^.reg) then + taicpu(hp1).oper[0]^.ref^.base := taicpu(p).oper[0]^.reg; + if (taicpu(hp1).oper[0]^.ref^.index = taicpu(p).oper[1]^.reg) then + taicpu(hp1).oper[0]^.ref^.index := taicpu(p).oper[0]^.reg; + asml.remove(p); + p.free; + p := hp1; + continue; + end + else if (taicpu(p).oper[0]^.typ = top_ref) and + GetNextInstruction(p,hp1) and + (hp1.typ = ait_instruction) and + IsFoldableArithOp(taicpu(hp1),taicpu(p).oper[1]^.reg) and + GetNextInstruction(hp1,hp2) and + (hp2.typ = ait_instruction) and + (taicpu(hp2).opcode = A_MOV) and + (taicpu(hp2).oper[0]^.typ = top_reg) and + (taicpu(hp2).oper[0]^.reg = taicpu(p).oper[1]^.reg) and + (taicpu(hp2).oper[1]^.typ = top_ref) then + begin + TmpUsedRegs := UsedRegs; + UpdateUsedRegs(TmpUsedRegs,tai(hp1.next)); + if (RefsEqual(taicpu(hp2).oper[1]^.ref^, taicpu(p).oper[0]^.ref^) and + not(RegUsedAfterInstruction(taicpu(p).oper[1]^.reg, + hp2, TmpUsedRegs))) then + { change mov (ref), reg } + { add/sub/or/... reg2/$const, reg } + { mov reg, (ref) } + { # release reg } + { to add/sub/or/... reg2/$const, (ref) } + begin + case taicpu(hp1).opcode of + A_INC,A_DEC: + taicpu(hp1).loadRef(0,taicpu(p).oper[0]^.ref^) + else + taicpu(hp1).loadRef(1,taicpu(p).oper[0]^.ref^); + end; + asml.remove(p); + asml.remove(hp2); + p.free; + hp2.free; + p := hp1 + end; + end + end; + end; + end; + end; + p := tai(p.next) + end; +end; + + +procedure PostPeepHoleOpts(asml: TAsmList; BlockStart, BlockEnd: tai); +var + p,hp1,hp2: tai; +begin + p := BlockStart; + while (p <> BlockEnd) Do + begin + case p.Typ Of + Ait_Instruction: + begin + if InsContainsSegRef(taicpu(p)) then + begin + p := tai(p.next); + continue; + end; + case taicpu(p).opcode Of + A_CALL: + if (current_settings.optimizecputype < cpu_Pentium2) and + not(cs_create_pic in current_settings.moduleswitches) and + GetNextInstruction(p, hp1) and + (hp1.typ = ait_instruction) and + (taicpu(hp1).opcode = A_JMP) and + ((taicpu(hp1).oper[0]^.typ=top_ref) and (taicpu(hp1).oper[0]^.ref^.refaddr=addr_full)) then + begin + hp2 := taicpu.Op_sym(A_PUSH,S_L,taicpu(hp1).oper[0]^.ref^.symbol); + InsertLLItem(asml, p.previous, p, hp2); + taicpu(p).opcode := A_JMP; + taicpu(p).is_jmp := true; + asml.remove(hp1); + hp1.free; + end; + A_CMP: + begin + if (taicpu(p).oper[0]^.typ = top_const) and + (taicpu(p).oper[0]^.val = 0) and + (taicpu(p).oper[1]^.typ = top_reg) then + {change "cmp $0, %reg" to "test %reg, %reg"} + begin + taicpu(p).opcode := A_TEST; + taicpu(p).loadreg(0,taicpu(p).oper[1]^.reg); + continue; + end; + end; +(* +Optimization is not safe; xor clears the carry flag. +See test/tgadint64 in the test suite. + A_MOV: + if (taicpu(p).oper[0]^.typ = Top_Const) and + (taicpu(p).oper[0]^.val = 0) and + (taicpu(p).oper[1]^.typ = Top_Reg) then + { change "mov $0, %reg" into "xor %reg, %reg" } + begin + taicpu(p).opcode := A_XOR; + taicpu(p).loadReg(0,taicpu(p).oper[1]^.reg); + end; +*) + A_MOVZX: + { if register vars are on, it's possible there is code like } + { "cmpl $3,%eax; movzbl 8(%ebp),%ebx; je .Lxxx" } + { so we can't safely replace the movzx then with xor/mov, } + { since that would change the flags (JM) } + if not(cs_opt_regvar in current_settings.optimizerswitches) then + begin + if (taicpu(p).oper[1]^.typ = top_reg) then + if (taicpu(p).oper[0]^.typ = top_reg) + then + case taicpu(p).opsize of + S_BL: + begin + if IsGP32Reg(getsupreg(taicpu(p).oper[1]^.reg)) and + not(cs_opt_size in current_settings.optimizerswitches) and + (current_settings.optimizecputype = cpu_Pentium) then + {Change "movzbl %reg1, %reg2" to + "xorl %reg2, %reg2; movb %reg1, %reg2" for Pentium and + PentiumMMX} + begin + hp1 := taicpu.op_reg_reg(A_XOR, S_L, + taicpu(p).oper[1]^.reg, taicpu(p).oper[1]^.reg); + InsertLLItem(asml,p.previous, p, hp1); + taicpu(p).opcode := A_MOV; + taicpu(p).changeopsize(S_B); + setsubreg(taicpu(p).oper[1]^.reg,R_SUBL); + end; + end; + end + else if (taicpu(p).oper[0]^.typ = top_ref) and + (taicpu(p).oper[0]^.ref^.base <> taicpu(p).oper[1]^.reg) and + (taicpu(p).oper[0]^.ref^.index <> taicpu(p).oper[1]^.reg) and + not(cs_opt_size in current_settings.optimizerswitches) and + IsGP32Reg(getsupreg(taicpu(p).oper[1]^.reg)) and + (current_settings.optimizecputype = cpu_Pentium) and + (taicpu(p).opsize = S_BL) then + {changes "movzbl mem, %reg" to "xorl %reg, %reg; movb mem, %reg8" for + Pentium and PentiumMMX} + begin + hp1 := taicpu.Op_reg_reg(A_XOR, S_L, taicpu(p).oper[1]^.reg, + taicpu(p).oper[1]^.reg); + taicpu(p).opcode := A_MOV; + taicpu(p).changeopsize(S_B); + setsubreg(taicpu(p).oper[1]^.reg,R_SUBL); + InsertLLItem(asml,p.previous, p, hp1); + end; + end; + A_TEST, A_OR: + {removes the line marked with (x) from the sequence + and/or/xor/add/sub/... $x, %y + test/or %y, %y (x) + j(n)z _Label + as the first instruction already adjusts the ZF} + begin + if OpsEqual(taicpu(p).oper[0]^,taicpu(p).oper[1]^) then + if GetLastInstruction(p, hp1) and + (tai(hp1).typ = ait_instruction) and + GetNextInstruction(p,hp2) and + (hp2.typ = ait_instruction) and + ((taicpu(hp2).opcode = A_SETcc) or + (taicpu(hp2).opcode = A_Jcc) or + (taicpu(hp2).opcode = A_CMOVcc)) then + case taicpu(hp1).opcode Of + A_ADD, A_SUB, A_OR, A_XOR, A_AND{, A_SHL, A_SHR}: + begin + if OpsEqual(taicpu(hp1).oper[1]^,taicpu(p).oper[0]^) and + { does not work in case of overflow for G(E)/L(E)/C_O/C_NO } + { and in case of carry for A(E)/B(E)/C/NC } + ((taicpu(hp2).condition in [C_Z,C_NZ,C_E,C_NE]) or + ((taicpu(hp1).opcode <> A_ADD) and + (taicpu(hp1).opcode <> A_SUB))) then + begin + hp1 := tai(p.next); + asml.remove(p); + p.free; + p := tai(hp1); + continue + end; + end; + A_DEC, A_INC, A_NEG: + begin + if OpsEqual(taicpu(hp1).oper[0]^,taicpu(p).oper[0]^) and + { does not work in case of overflow for G(E)/L(E)/C_O/C_NO } + { and in case of carry for A(E)/B(E)/C/NC } + (taicpu(hp2).condition in [C_Z,C_NZ,C_E,C_NE]) then + begin + case taicpu(hp1).opcode Of + A_DEC, A_INC: + {replace inc/dec with add/sub 1, because inc/dec doesn't set the carry flag} + begin + case taicpu(hp1).opcode Of + A_DEC: taicpu(hp1).opcode := A_SUB; + A_INC: taicpu(hp1).opcode := A_ADD; + end; + taicpu(hp1).loadoper(1,taicpu(hp1).oper[0]^); + taicpu(hp1).loadConst(0,1); + taicpu(hp1).ops:=2; + end + end; + hp1 := tai(p.next); + asml.remove(p); + p.free; + p := tai(hp1); + continue + end; + end + end + end; + end; + end; + end; + p := tai(p.next) + end; +end; + + + +end. diff --git a/closures/compiler/i386/r386ari.inc b/closures/compiler/i386/r386ari.inc new file mode 100644 index 0000000000..485e9d94a4 --- /dev/null +++ b/closures/compiler/i386/r386ari.inc @@ -0,0 +1,73 @@ +{ don't edit, this file is generated from x86reg.dat } +2, +1, +3, +14, +13, +21, +15, +6, +5, +38, +39, +40, +41, +26, +7, +10, +19, +9, +32, +33, +34, +35, +36, +37, +27, +11, +4, +22, +16, +8, +20, +12, +25, +28, +18, +24, +30, +31, +56, +57, +58, +59, +60, +61, +62, +63, +17, +23, +29, +55, +47, +48, +49, +50, +51, +52, +53, +54, +42, +43, +44, +45, +46, +64, +65, +66, +67, +68, +69, +70, +71, +0 diff --git a/closures/compiler/i386/r386att.inc b/closures/compiler/i386/r386att.inc new file mode 100644 index 0000000000..2efe472cd4 --- /dev/null +++ b/closures/compiler/i386/r386att.inc @@ -0,0 +1,73 @@ +{ don't edit, this file is generated from x86reg.dat } +'INVALID', +'%al', +'%ah', +'%ax', +'%eax', +'%cl', +'%ch', +'%cx', +'%ecx', +'%dl', +'%dh', +'%dx', +'%edx', +'%bl', +'%bh', +'%bx', +'%ebx', +'%si', +'%esi', +'%di', +'%edi', +'%bp', +'%ebp', +'%sp', +'%esp', +'%eip', +'%cs', +'%ds', +'%es', +'%ss', +'%fs', +'%gs', +'%dr0', +'%dr1', +'%dr2', +'%dr3', +'%dr6', +'%dr7', +'%cr0', +'%cr2', +'%cr3', +'%cr4', +'%tr3', +'%tr4', +'%tr5', +'%tr6', +'%tr7', +'%st(0)', +'%st(1)', +'%st(2)', +'%st(3)', +'%st(4)', +'%st(5)', +'%st(6)', +'%st(7)', +'%st', +'%mm0', +'%mm1', +'%mm2', +'%mm3', +'%mm4', +'%mm5', +'%mm6', +'%mm7', +'%xmm0', +'%xmm1', +'%xmm2', +'%xmm3', +'%xmm4', +'%xmm5', +'%xmm6', +'%xmm7' diff --git a/closures/compiler/i386/r386con.inc b/closures/compiler/i386/r386con.inc new file mode 100644 index 0000000000..eb1f3d0a78 --- /dev/null +++ b/closures/compiler/i386/r386con.inc @@ -0,0 +1,73 @@ +{ don't edit, this file is generated from x86reg.dat } +NR_NO = tregister($00000000); +NR_AL = tregister($01010000); +NR_AH = tregister($01020000); +NR_AX = tregister($01030000); +NR_EAX = tregister($01040000); +NR_CL = tregister($01010001); +NR_CH = tregister($01020001); +NR_CX = tregister($01030001); +NR_ECX = tregister($01040001); +NR_DL = tregister($01010002); +NR_DH = tregister($01020002); +NR_DX = tregister($01030002); +NR_EDX = tregister($01040002); +NR_BL = tregister($01010003); +NR_BH = tregister($01020003); +NR_BX = tregister($01030003); +NR_EBX = tregister($01040003); +NR_SI = tregister($01030004); +NR_ESI = tregister($01040004); +NR_DI = tregister($01030005); +NR_EDI = tregister($01040005); +NR_BP = tregister($01030006); +NR_EBP = tregister($01040006); +NR_SP = tregister($01030007); +NR_ESP = tregister($01040007); +NR_EIP = tregister($05000000); +NR_CS = tregister($05000001); +NR_DS = tregister($05000002); +NR_ES = tregister($05000003); +NR_SS = tregister($05000004); +NR_FS = tregister($05000005); +NR_GS = tregister($05000006); +NR_DR0 = tregister($05000007); +NR_DR1 = tregister($05000008); +NR_DR2 = tregister($05000009); +NR_DR3 = tregister($0500000a); +NR_DR6 = tregister($0500000b); +NR_DR7 = tregister($0500000c); +NR_CR0 = tregister($0500000d); +NR_CR2 = tregister($0500000e); +NR_CR3 = tregister($0500000f); +NR_CR4 = tregister($05000010); +NR_TR3 = tregister($05000011); +NR_TR4 = tregister($05000012); +NR_TR5 = tregister($05000013); +NR_TR6 = tregister($05000014); +NR_TR7 = tregister($05000015); +NR_ST0 = tregister($02000000); +NR_ST1 = tregister($02000001); +NR_ST2 = tregister($02000002); +NR_ST3 = tregister($02000003); +NR_ST4 = tregister($02000004); +NR_ST5 = tregister($02000005); +NR_ST6 = tregister($02000006); +NR_ST7 = tregister($02000007); +NR_ST = tregister($02000008); +NR_MM0 = tregister($03000000); +NR_MM1 = tregister($03000001); +NR_MM2 = tregister($03000002); +NR_MM3 = tregister($03000003); +NR_MM4 = tregister($03000004); +NR_MM5 = tregister($03000005); +NR_MM6 = tregister($03000006); +NR_MM7 = tregister($03000007); +NR_XMM0 = tregister($04000000); +NR_XMM1 = tregister($04000001); +NR_XMM2 = tregister($04000002); +NR_XMM3 = tregister($04000003); +NR_XMM4 = tregister($04000004); +NR_XMM5 = tregister($04000005); +NR_XMM6 = tregister($04000006); +NR_XMM7 = tregister($04000007); diff --git a/closures/compiler/i386/r386dwrf.inc b/closures/compiler/i386/r386dwrf.inc new file mode 100644 index 0000000000..79d6522842 --- /dev/null +++ b/closures/compiler/i386/r386dwrf.inc @@ -0,0 +1,73 @@ +{ don't edit, this file is generated from x86reg.dat } +-1, +0, +0, +0, +0, +1, +1, +1, +1, +2, +2, +2, +2, +3, +3, +3, +3, +6, +6, +7, +7, +5, +5, +4, +4, +8, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +11, +12, +13, +14, +15, +16, +17, +18, +11, +29, +30, +31, +32, +33, +34, +35, +36, +21, +22, +23, +24, +25, +26, +27, +28 diff --git a/closures/compiler/i386/r386int.inc b/closures/compiler/i386/r386int.inc new file mode 100644 index 0000000000..585a5b0285 --- /dev/null +++ b/closures/compiler/i386/r386int.inc @@ -0,0 +1,73 @@ +{ don't edit, this file is generated from x86reg.dat } +'INVALID', +'al', +'ah', +'ax', +'eax', +'cl', +'ch', +'cx', +'ecx', +'dl', +'dh', +'dx', +'edx', +'bl', +'bh', +'bx', +'ebx', +'si', +'esi', +'di', +'edi', +'bp', +'ebp', +'sp', +'esp', +'eip', +'cs', +'ds', +'es', +'ss', +'fs', +'gs', +'dr0', +'dr1', +'dr2', +'dr3', +'dr6', +'dr7', +'cr0', +'cr2', +'cr3', +'cr4', +'tr3', +'tr4', +'tr5', +'tr6', +'tr7', +'st(0)', +'st(1)', +'st(2)', +'st(3)', +'st(4)', +'st(5)', +'st(6)', +'st(7)', +'st', +'mm0', +'mm1', +'mm2', +'mm3', +'mm4', +'mm5', +'mm6', +'mm7', +'xmm0', +'xmm1', +'xmm2', +'xmm3', +'xmm4', +'xmm5', +'xmm6', +'xmm7' diff --git a/closures/compiler/i386/r386iri.inc b/closures/compiler/i386/r386iri.inc new file mode 100644 index 0000000000..33148cb940 --- /dev/null +++ b/closures/compiler/i386/r386iri.inc @@ -0,0 +1,73 @@ +{ don't edit, this file is generated from x86reg.dat } +0, +2, +1, +3, +14, +13, +21, +15, +6, +5, +38, +39, +40, +41, +26, +7, +10, +19, +9, +32, +33, +34, +35, +36, +37, +27, +11, +4, +22, +16, +8, +20, +12, +25, +28, +18, +24, +30, +31, +56, +57, +58, +59, +60, +61, +62, +63, +17, +23, +29, +55, +47, +48, +49, +50, +51, +52, +53, +54, +42, +43, +44, +45, +46, +64, +65, +66, +67, +68, +69, +70, +71 diff --git a/closures/compiler/i386/r386nasm.inc b/closures/compiler/i386/r386nasm.inc new file mode 100644 index 0000000000..1e2bd036b0 --- /dev/null +++ b/closures/compiler/i386/r386nasm.inc @@ -0,0 +1,73 @@ +{ don't edit, this file is generated from x86reg.dat } +'INVALID', +'al', +'ah', +'ax', +'eax', +'cl', +'ch', +'cx', +'ecx', +'dl', +'dh', +'dx', +'edx', +'bl', +'bh', +'bx', +'ebx', +'si', +'esi', +'di', +'edi', +'bp', +'ebp', +'sp', +'esp', +'eip', +'cs', +'ds', +'es', +'ss', +'fs', +'gs', +'dr0', +'dr1', +'dr2', +'dr3', +'dr6', +'dr7', +'cr0', +'cr2', +'cr3', +'cr4', +'tr3', +'tr4', +'tr5', +'tr6', +'tr7', +'st0', +'st1', +'st2', +'st3', +'st4', +'st5', +'st6', +'st7', +'st0', +'mm0', +'mm1', +'mm2', +'mm3', +'mm4', +'mm5', +'mm6', +'mm7', +'xmm0', +'xmm1', +'xmm2', +'xmm3', +'xmm4', +'xmm5', +'xmm6', +'xmm7' diff --git a/closures/compiler/i386/r386nor.inc b/closures/compiler/i386/r386nor.inc new file mode 100644 index 0000000000..2e66b09488 --- /dev/null +++ b/closures/compiler/i386/r386nor.inc @@ -0,0 +1,2 @@ +{ don't edit, this file is generated from x86reg.dat } +72 diff --git a/closures/compiler/i386/r386nri.inc b/closures/compiler/i386/r386nri.inc new file mode 100644 index 0000000000..33148cb940 --- /dev/null +++ b/closures/compiler/i386/r386nri.inc @@ -0,0 +1,73 @@ +{ don't edit, this file is generated from x86reg.dat } +0, +2, +1, +3, +14, +13, +21, +15, +6, +5, +38, +39, +40, +41, +26, +7, +10, +19, +9, +32, +33, +34, +35, +36, +37, +27, +11, +4, +22, +16, +8, +20, +12, +25, +28, +18, +24, +30, +31, +56, +57, +58, +59, +60, +61, +62, +63, +17, +23, +29, +55, +47, +48, +49, +50, +51, +52, +53, +54, +42, +43, +44, +45, +46, +64, +65, +66, +67, +68, +69, +70, +71 diff --git a/closures/compiler/i386/r386num.inc b/closures/compiler/i386/r386num.inc new file mode 100644 index 0000000000..5762785a18 --- /dev/null +++ b/closures/compiler/i386/r386num.inc @@ -0,0 +1,73 @@ +{ don't edit, this file is generated from x86reg.dat } +tregister($00000000), +tregister($01010000), +tregister($01020000), +tregister($01030000), +tregister($01040000), +tregister($01010001), +tregister($01020001), +tregister($01030001), +tregister($01040001), +tregister($01010002), +tregister($01020002), +tregister($01030002), +tregister($01040002), +tregister($01010003), +tregister($01020003), +tregister($01030003), +tregister($01040003), +tregister($01030004), +tregister($01040004), +tregister($01030005), +tregister($01040005), +tregister($01030006), +tregister($01040006), +tregister($01030007), +tregister($01040007), +tregister($05000000), +tregister($05000001), +tregister($05000002), +tregister($05000003), +tregister($05000004), +tregister($05000005), +tregister($05000006), +tregister($05000007), +tregister($05000008), +tregister($05000009), +tregister($0500000a), +tregister($0500000b), +tregister($0500000c), +tregister($0500000d), +tregister($0500000e), +tregister($0500000f), +tregister($05000010), +tregister($05000011), +tregister($05000012), +tregister($05000013), +tregister($05000014), +tregister($05000015), +tregister($02000000), +tregister($02000001), +tregister($02000002), +tregister($02000003), +tregister($02000004), +tregister($02000005), +tregister($02000006), +tregister($02000007), +tregister($02000008), +tregister($03000000), +tregister($03000001), +tregister($03000002), +tregister($03000003), +tregister($03000004), +tregister($03000005), +tregister($03000006), +tregister($03000007), +tregister($04000000), +tregister($04000001), +tregister($04000002), +tregister($04000003), +tregister($04000004), +tregister($04000005), +tregister($04000006), +tregister($04000007) diff --git a/closures/compiler/i386/r386op.inc b/closures/compiler/i386/r386op.inc new file mode 100644 index 0000000000..c9df7fabcb --- /dev/null +++ b/closures/compiler/i386/r386op.inc @@ -0,0 +1,73 @@ +{ don't edit, this file is generated from x86reg.dat } +0, +0, +4, +0, +0, +1, +5, +1, +1, +2, +6, +2, +2, +3, +7, +3, +3, +6, +6, +7, +7, +5, +5, +4, +4, +0, +1, +3, +0, +2, +4, +5, +0, +1, +2, +3, +6, +7, +0, +2, +3, +4, +3, +4, +5, +6, +7, +0, +1, +2, +3, +4, +5, +6, +7, +0, +0, +1, +2, +3, +4, +5, +6, +7, +0, +1, +2, +3, +4, +5, +6, +7 diff --git a/closures/compiler/i386/r386ot.inc b/closures/compiler/i386/r386ot.inc new file mode 100644 index 0000000000..d30c918dc7 --- /dev/null +++ b/closures/compiler/i386/r386ot.inc @@ -0,0 +1,73 @@ +{ don't edit, this file is generated from x86reg.dat } +OT_NONE, +OT_REG_AL, +OT_REG8, +OT_REG_AX, +OT_REG_EAX, +OT_REG_CL, +OT_REG8, +OT_REG_CX, +OT_REG_ECX, +OT_REG8, +OT_REG8, +OT_REG_DX, +OT_REG32, +OT_REG8, +OT_REG8, +OT_REG16, +OT_REG32, +OT_REG16, +OT_REG32, +OT_REG16, +OT_REG32, +OT_REG16, +OT_REG32, +OT_REG16, +OT_REG32, +OT_NONE, +OT_REG_CS, +OT_REG_DESS, +OT_REG_DESS, +OT_REG_DESS, +OT_REG_FSGS, +OT_REG_FSGS, +OT_REG_DREG, +OT_REG_DREG, +OT_REG_DREG, +OT_REG_DREG, +OT_REG_DREG, +OT_REG_DREG, +OT_REG_CREG, +OT_REG_CREG, +OT_REG_CREG, +OT_REG_CR4, +OT_REG_TREG, +OT_REG_TREG, +OT_REG_TREG, +OT_REG_TREG, +OT_REG_TREG, +OT_FPU0, +OT_FPUREG, +OT_FPUREG, +OT_FPUREG, +OT_FPUREG, +OT_FPUREG, +OT_FPUREG, +OT_FPUREG, +OT_FPU0, +OT_MMXREG, +OT_MMXREG, +OT_MMXREG, +OT_MMXREG, +OT_MMXREG, +OT_MMXREG, +OT_MMXREG, +OT_MMXREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG diff --git a/closures/compiler/i386/r386rni.inc b/closures/compiler/i386/r386rni.inc new file mode 100644 index 0000000000..294022d5e2 --- /dev/null +++ b/closures/compiler/i386/r386rni.inc @@ -0,0 +1,73 @@ +{ don't edit, this file is generated from x86reg.dat } +0, +1, +5, +9, +13, +2, +6, +10, +14, +3, +7, +11, +15, +17, +19, +21, +23, +4, +8, +12, +16, +18, +20, +22, +24, +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, +25, +26, +27, +28, +29, +30, +31, +32, +33, +34, +35, +36, +37, +38, +39, +40, +41, +42, +43, +44, +45, +46 diff --git a/closures/compiler/i386/r386sri.inc b/closures/compiler/i386/r386sri.inc new file mode 100644 index 0000000000..33148cb940 --- /dev/null +++ b/closures/compiler/i386/r386sri.inc @@ -0,0 +1,73 @@ +{ don't edit, this file is generated from x86reg.dat } +0, +2, +1, +3, +14, +13, +21, +15, +6, +5, +38, +39, +40, +41, +26, +7, +10, +19, +9, +32, +33, +34, +35, +36, +37, +27, +11, +4, +22, +16, +8, +20, +12, +25, +28, +18, +24, +30, +31, +56, +57, +58, +59, +60, +61, +62, +63, +17, +23, +29, +55, +47, +48, +49, +50, +51, +52, +53, +54, +42, +43, +44, +45, +46, +64, +65, +66, +67, +68, +69, +70, +71 diff --git a/closures/compiler/i386/r386stab.inc b/closures/compiler/i386/r386stab.inc new file mode 100644 index 0000000000..d2fbf4d7e5 --- /dev/null +++ b/closures/compiler/i386/r386stab.inc @@ -0,0 +1,73 @@ +{ don't edit, this file is generated from x86reg.dat } +-1, +0, +0, +0, +0, +1, +1, +1, +1, +2, +2, +2, +2, +3, +3, +3, +3, +6, +6, +7, +7, +5, +5, +4, +4, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +12, +13, +14, +15, +16, +17, +18, +19, +12, +29, +30, +31, +32, +33, +34, +35, +36, +21, +22, +23, +24, +25, +26, +27, +28 diff --git a/closures/compiler/i386/r386std.inc b/closures/compiler/i386/r386std.inc new file mode 100644 index 0000000000..585a5b0285 --- /dev/null +++ b/closures/compiler/i386/r386std.inc @@ -0,0 +1,73 @@ +{ don't edit, this file is generated from x86reg.dat } +'INVALID', +'al', +'ah', +'ax', +'eax', +'cl', +'ch', +'cx', +'ecx', +'dl', +'dh', +'dx', +'edx', +'bl', +'bh', +'bx', +'ebx', +'si', +'esi', +'di', +'edi', +'bp', +'ebp', +'sp', +'esp', +'eip', +'cs', +'ds', +'es', +'ss', +'fs', +'gs', +'dr0', +'dr1', +'dr2', +'dr3', +'dr6', +'dr7', +'cr0', +'cr2', +'cr3', +'cr4', +'tr3', +'tr4', +'tr5', +'tr6', +'tr7', +'st(0)', +'st(1)', +'st(2)', +'st(3)', +'st(4)', +'st(5)', +'st(6)', +'st(7)', +'st', +'mm0', +'mm1', +'mm2', +'mm3', +'mm4', +'mm5', +'mm6', +'mm7', +'xmm0', +'xmm1', +'xmm2', +'xmm3', +'xmm4', +'xmm5', +'xmm6', +'xmm7' diff --git a/closures/compiler/i386/ra386att.pas b/closures/compiler/i386/ra386att.pas new file mode 100644 index 0000000000..4e1185e905 --- /dev/null +++ b/closures/compiler/i386/ra386att.pas @@ -0,0 +1,59 @@ +{ + Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman + + Does the parsing for the i386 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 ra386att; + +{$i fpcdefs.inc} + + interface + + uses + rax86att; + + type + ti386attreader = class(tx86attreader) + end; + + + implementation + + uses + rabase,systems; + +const + asmmode_i386_att_info : tasmmodeinfo = + ( + id : asmmode_i386_att; + idtxt : 'ATT'; + casmreader : ti386attreader; + ); + + asmmode_i386_standard_info : tasmmodeinfo = + ( + id : asmmode_standard; + idtxt : 'STANDARD'; + casmreader : ti386attreader; + ); + +initialization + RegisterAsmMode(asmmode_i386_att_info); + RegisterAsmMode(asmmode_i386_standard_info); +end. diff --git a/closures/compiler/i386/ra386int.pas b/closures/compiler/i386/ra386int.pas new file mode 100644 index 0000000000..366595bac1 --- /dev/null +++ b/closures/compiler/i386/ra386int.pas @@ -0,0 +1,74 @@ +{ + Copyright (c) 1998-2006 by Carl Eric Codere and Peter Vreman + + Does the parsing for the i386 intel 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 ra386int; + +{$i fpcdefs.inc} + + interface + + uses + rax86int; + + type + ti386intreader = class(tx86intreader) + // procedure handleopcode;override; + end; + + + implementation + + uses + rabase,systems,rax86,aasmcpu; + +(* + procedure ti386intreader.handleopcode; + var + instr : Tx86Instruction; + begin + instr:=Tx86Instruction.Create(Tx86Operand); + instr.OpOrder:=op_att; + BuildOpcode(instr); + instr.AddReferenceSizes; + instr.SetInstructionOpsize; + { + instr.CheckOperandSizes; + } + instr.ConcatInstruction(curlist); + instr.Free; + end; +*) + +{***************************************************************************** + Initialize +*****************************************************************************} + +const + asmmode_i386_intel_info : tasmmodeinfo = + ( + id : asmmode_i386_intel; + idtxt : 'INTEL'; + casmreader : ti386intreader; + ); + +begin + RegisterAsmMode(asmmode_i386_intel_info); +end. diff --git a/closures/compiler/i386/rgcpu.pas b/closures/compiler/i386/rgcpu.pas new file mode 100644 index 0000000000..1bdff50369 --- /dev/null +++ b/closures/compiler/i386/rgcpu.pas @@ -0,0 +1,71 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements the i386 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 + cpubase, + cpuinfo, + aasmbase,aasmtai,aasmdata, + cclasses,globtype,cgbase,rgobj,rgx86; + + type + trgcpu = class(trgx86) + procedure add_constraints(reg:Tregister);override; + end; + +implementation + + uses + systems, + verbose; + + const + { This value is used in tsaved. If the array value is equal + to this, then this means that this register is not used.} + reg_not_saved = $7fffffff; + +{************************************************************************ + trgcpu +*************************************************************************} + + procedure trgcpu.add_constraints(reg:Tregister); + var + supreg : tsuperregister; + begin + if getsubreg(reg) in [R_SUBL,R_SUBH] then + begin + { Some registers have no 8-bit subregister } + supreg:=getsupreg(reg); + add_edge(supreg,RS_ESI); + add_edge(supreg,RS_EDI); + add_edge(supreg,RS_EBP); + end; + end; + + +end. diff --git a/closures/compiler/i386/rropt386.pas b/closures/compiler/i386/rropt386.pas new file mode 100644 index 0000000000..158ff204b2 --- /dev/null +++ b/closures/compiler/i386/rropt386.pas @@ -0,0 +1,371 @@ +{ + Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal + development team + + This unit contains register renaming functionality + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit rropt386; + +{$i fpcdefs.inc} + +interface + +uses aasmbase,aasmtai,aasmdata,aasmcpu; + +procedure doRenaming(asml: TAsmList; first, last: tai); + +implementation + +uses + {$ifdef replaceregdebug}cutils,{$endif} + verbose,globals,cpubase,daopt386,csopt386,rgobj, + cgbase,cgutils,cgobj; + +function canBeFirstSwitch(p: taicpu; supreg: tsuperregister): boolean; +{ checks whether an operation on reg can be switched to another reg without an } +{ additional mov, e.g. "addl $4,%reg1" can be changed to "leal 4(%reg1),%reg2" } +begin + canBeFirstSwitch := false; + case p.opcode of + A_MOV,A_MOVZX,A_MOVSX,A_LEA: + canBeFirstSwitch := + (p.oper[1]^.typ = top_reg) and + (getsupreg(p.oper[1]^.reg) = supreg); + A_IMUL: + canBeFirstSwitch := + (p.ops >= 2) and + (p.oper[0]^.typ = top_const) and + (getsupreg(p.oper[p.ops-1]^.reg) = supreg) and + (not pTaiprop(p.optinfo)^.FlagsUsed); + A_INC,A_DEC: + canBeFirstSwitch := + (p.oper[0]^.typ = top_reg) and + (p.opsize = S_L) and + (not pTaiprop(p.optinfo)^.FlagsUsed); + A_SUB,A_ADD: + canBeFirstSwitch := + (p.oper[1]^.typ = top_reg) and + (p.opsize = S_L) and + (getsupreg(p.oper[1]^.reg) = supreg) and + (p.oper[0]^.typ <> top_ref) and + ((p.opcode <> A_SUB) or + (p.oper[0]^.typ = top_const)) and + (not pTaiprop(p.optinfo)^.FlagsUsed); + A_SHL: + canBeFirstSwitch := + (p.opsize = S_L) and + (p.oper[1]^.typ = top_reg) and + (getsupreg(p.oper[1]^.reg) = supreg) and + (p.oper[0]^.typ = top_const) and + (p.oper[0]^.val in [1,2,3]) and + (not pTaiprop(p.optinfo)^.FlagsUsed); + end; +end; + + +procedure switchReg(var reg: tregister; reg1, reg2: tsuperregister); +var + supreg: tsuperregister; +begin + if (reg = NR_NO) or + (getregtype(reg) <> R_INTREGISTER) then + exit; + supreg := getsupreg(reg); + if (supreg = reg1) then + setsupreg(reg,reg2) + else if (supreg = reg2) then + setsupreg(reg,reg1); +end; + + +procedure switchOp(var op: toper; reg1, reg2: tsuperregister); +begin + case op.typ of + top_reg: + switchReg(op.reg,reg1,reg2); + top_ref: + begin + switchReg(op.ref^.base,reg1,reg2); + switchReg(op.ref^.index,reg1,reg2); + end; + end; +end; + + +procedure doSwitchReg(hp: taicpu; reg1,reg2: tsuperregister); +var + opCount: longint; +begin + for opCount := 0 to hp.ops-1 do + switchOp(hp.oper[opCount]^,reg1,reg2); +end; + + +procedure doFirstSwitch(p: taicpu; reg1, reg2: tsuperregister); +var + tmpRef: treference; +begin + case p.opcode of + A_MOV,A_MOVZX,A_MOVSX,A_LEA: + begin + changeOp(p.oper[1]^,reg1,reg2); + changeOp(p.oper[0]^,reg2,reg1); + end; + A_IMUL: + begin + p.ops := 3; + p.loadreg(2,newreg(R_INTREGISTER,reg2,R_SUBWHOLE)); + changeOp(p.oper[1]^,reg2,reg1); + end; + A_INC,A_DEC: + begin + reference_reset(tmpref,1); + tmpref.base := newreg(R_INTREGISTER,reg1,R_SUBWHOLE); + case p.opcode of + A_INC: + tmpref.offset := 1; + A_DEC: + tmpref.offset := -1; + end; + p.ops := 2; + p.opcode := A_LEA; + p.loadreg(1,newreg(R_INTREGISTER,reg2,R_SUBWHOLE)); + p.loadref(0,tmpref); + end; + A_SUB,A_ADD: + begin + reference_reset(tmpref,1); + tmpref.base := newreg(R_INTREGISTER,reg1,R_SUBWHOLE); + case p.oper[0]^.typ of + top_const: + begin + tmpref.offset := longint(p.oper[0]^.val); + if p.opcode = A_SUB then + tmpref.offset := - tmpRef.offset; + end; + top_ref: + if (p.oper[0]^.ref^.refaddr=addr_full) then + tmpref.symbol := p.oper[0]^.ref^.symbol + else + internalerror(200402263); + top_reg: + begin + { "addl %reg2,%reg1" must become "leal (%reg1,%reg1),%reg2" } + { since at this point reg1 holds the value that reg2 would } + { otherwise contain } + tmpref.index := p.oper[0]^.reg; + if (getsupreg(tmpref.index)=reg2) then + setsupreg(tmpref.index,reg1); + tmpref.scalefactor := 1; + end; + else internalerror(200010031); + end; + p.opcode := A_LEA; + p.loadref(0,tmpref); + p.loadreg(1,newreg(R_INTREGISTER,reg2,R_SUBWHOLE)); + end; + A_SHL: + begin + reference_reset(tmpref,2); + tmpref.index := newreg(R_INTREGISTER,reg1,R_SUBWHOLE); + tmpref.scalefactor := 1 shl p.oper[0]^.val; + p.opcode := A_LEA; + p.loadref(0,tmpref); + p.loadreg(1,newreg(R_INTREGISTER,reg2,R_SUBWHOLE)); + end; + else internalerror(200010032); + end; +end; + + +function switchRegs(asml: TAsmList; reg1, reg2: tsuperregister; start: tai): Boolean; +{ change movl %reg1,%reg2 ... bla ... to ... bla with reg1 and reg2 switched } +var + endP, hp, lastreg1,lastreg2: tai; + switchDone, switchLast, tmpResult, sequenceEnd, reg1Modified, reg2Modified: boolean; + reg1StillUsed, reg2StillUsed, isInstruction: boolean; +begin + switchRegs := false; + tmpResult := true; + sequenceEnd := false; + reg1Modified := false; + reg2Modified := false; + endP := start; + while tmpResult and not sequenceEnd do + begin + tmpResult := + getNextInstruction(endP,endP); + If tmpResult and + not pTaiprop(endp.optinfo)^.canBeRemoved then + begin + { if the newReg gets stored back to the oldReg, we can change } + { "mov %oldReg,%newReg; <operations on %newReg>; mov %newReg, } + { %oldReg" to "<operations on %oldReg>" } + switchLast := storeBack(start,endP,reg1,reg2); + reg1StillUsed := reg1 in pTaiprop(endp.optinfo)^.usedregs; + reg2StillUsed := reg2 in pTaiprop(endp.optinfo)^.usedregs; + isInstruction := endp.typ = ait_instruction; + sequenceEnd := + switchLast or + { if both registers are released right before an instruction } + { that contains hardcoded regs, it's ok too } + (not reg1StillUsed and not reg2StillUsed) or + { no support for (i)div, mul and imul with hardcoded operands } + (((not isInstruction) or + noHardCodedRegs(taicpu(endP),reg1,reg2)) and + (not reg1StillUsed or + (isInstruction and findRegDealloc(reg1,endP) and + regLoadedWithNewValue(reg1,false,taicpu(endP)))) and + (not reg2StillUsed or + (isInstruction and findRegDealloc(reg2,endP) and + regLoadedWithNewValue(reg2,false,taicpu(endP))))); + + { we can't switch reg1 and reg2 in something like } + { movl %reg1,%reg2 } + { movl (%reg2),%reg2 } + { movl 4(%reg1),%reg1 } + if reg2Modified and not(reg1Modified) and + regReadByInstruction(reg1,endP) then + begin + tmpResult := false; + break + end; + + if not reg1Modified then + begin + reg1Modified := regModifiedByInstruction(reg1,endP); + if reg1Modified and not canBeFirstSwitch(taicpu(endP),reg1) then + begin + tmpResult := false; + break; + end; + end; + if not reg2Modified then + reg2Modified := regModifiedByInstruction(reg2,endP); + + tmpResult := + ((not isInstruction) or + (NoHardCodedRegs(taicpu(endP),reg1,reg2) and + RegSizesOk(reg1,reg2,taicpu(endP)))); + + if sequenceEnd then + break; + + tmpResult := + tmpresult and + (endp.typ <> ait_label) and + ((not isInstruction) or + (not taicpu(endp).is_jmp)); + end; + end; + + if tmpResult and sequenceEnd then + begin + switchRegs := true; + reg1Modified := false; + reg2Modified := false; + lastreg1 := start; + lastreg2 := start; + getNextInstruction(start,hp); + while hp <> endP do + begin + if (not pTaiprop(hp.optinfo)^.canberemoved) and + (hp.typ = ait_instruction) then + begin + switchDone := false; + if not reg1Modified then + begin + reg1Modified := regModifiedByInstruction(reg1,hp); + if reg1Modified then + begin + doFirstSwitch(taicpu(hp),reg1,reg2); + switchDone := true; + end; + end; + if not switchDone then + if reg1Modified then + doSwitchReg(taicpu(hp),reg1,reg2) + else + doReplaceReg(taicpu(hp),reg2,reg1); + end; + if regininstruction(reg1,hp) then + lastreg1 := hp; + if regininstruction(reg2,hp) then + lastreg2 := hp; + getNextInstruction(hp,hp); + end; + if switchLast then + begin + lastreg1 := hp; + lastreg2 := hp; + { this is in case of a storeback, make sure the same size of register } + { contents as the initial move is transfered } + doSwitchReg(taicpu(hp),reg1,reg2); + if taicpu(hp).opsize <> taicpu(start).opsize then + begin + taicpu(hp).opsize := taicpu(start).opsize; + taicpu(hp).oper[0]^.reg := taicpu(start).oper[0]^.reg; + taicpu(hp).oper[1]^.reg := taicpu(start).oper[1]^.reg; + end; + end + else + getLastInstruction(hp,hp); + allocRegBetween(asmL,newreg(R_INTREGISTER,reg1,R_SUBWHOLE),start,lastreg1, + ptaiprop(start.optinfo)^.usedregs); + allocRegBetween(asmL,newreg(R_INTREGISTER,reg2,R_SUBWHOLE),start,lastreg2, + ptaiprop(start.optinfo)^.usedregs); + end; +end; + + +procedure doRenaming(asml: TAsmList; first, last: tai); +var + p: tai; +begin + p := First; + SkipHead(p); + while p <> last do + begin + case p.typ of + ait_instruction: + begin + case taicpu(p).opcode of + A_MOV: + begin + if not(pTaiprop(p.optinfo)^.canBeRemoved) and + (taicpu(p).oper[0]^.typ = top_reg) and + (taicpu(p).oper[1]^.typ = top_reg) and + (taicpu(p).opsize = S_L) and + (getsupreg(taicpu(p).oper[0]^.reg) in ([RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI,RS_EDI])) and + (getsupreg(taicpu(p).oper[1]^.reg) in ([RS_EAX,RS_EBX,RS_ECX,RS_EDX,RS_ESI,RS_EDI])) then + if switchRegs(asml,getsupreg(taicpu(p).oper[0]^.reg), + getsupreg(taicpu(p).oper[1]^.reg),p) then + begin + pTaiprop(p.optinfo)^.canBeRemoved := true; + end; + end; + end; + end; + end; + getNextInstruction(p,p); + end; +end; + + +End. diff --git a/closures/compiler/ia64/aasmcpu.pas b/closures/compiler/ia64/aasmcpu.pas new file mode 100644 index 0000000000..35da6c32a5 --- /dev/null +++ b/closures/compiler/ia64/aasmcpu.pas @@ -0,0 +1,287 @@ +{ + Copyright (c) 2000-2006 by Florian Klaempfl + + Contains the assembler object for the ia64 + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit aasmcpu; + +{$i fpcdefs.inc} + +interface + +uses + globals,verbose, + aasmbase,aasmtai, + cpubase, + cgutils; + + +type + pairegalloc = ^tairegalloc; + tairegalloc = class(tai) + allocation : boolean; + reg : tregister; + constructor alloc(r : tregister); + constructor dealloc(r : tregister); + end; + + { Types of operand } + toptype=(top_none,top_reg,top_ref,top_const,top_symbol,top_qp); + + paicpu = ^taicpu; + taicpu = class(tai) + is_jmp : boolean; { is this instruction a jump? (needed for optimizer) } + opcode : tasmop; + ops : array[0..4] of longint; + oper : longint; + qp : tqp; + ldsttype : tldsttype; + hint : thint; + { ALU instructions } + { A1,A9: integer ALU } + constructor op_reg_reg_reg(op : tasmop;const r1,r2,r3 : tregister); + { A2,A10: shift left and add } + constructor op_reg_reg_const_reg(_qp : tqp;op : tasmop; + const r1,r2 : tregister;i : byte;const r3 : tregister); + { A3,A4,A5: integer ALU - imm.,register } + constructor op_reg_const_reg(_qp : tqp;op : tasmop; + const r1 : tregister;i : longint;const r3 : tregister); + { A6,A7: integer compare - register,register } + constructor op_preg_preg_reg_reg(_qp : tqp;op : tasmop; + cond : tasmcond;p1,p2 : tqp;const r2,r3 : tregister); + { A8: integer compare - imm.,register } + constructor op_preg_preg_const_reg(_qp : tqp;op : tasmop; + cond : tasmcond;p1,p2 : tqp;i : longint;const r3 : tregister); +(*!!!!!!! + { multimedia shift and multiply } + constructor op_reg_reg_reg_const(_qp : tqp; + { multimedia mux } + constructor op_reg_reg_mbtype(_qp : tqp; + { multimedia shift fixed } + constructor op_reg_reg_const(_qp : tqp; + { div. } + constructor op_reg_reg(_qp : tqp; + { mm extract } + constructor op_reg_reg_const_const(_qp : tqp; + { zero and deposit imm } + constructor op_reg_const_const_const(_qp : tqp; + { deposit imm } + constructor op_reg_const_reg_const_const(_qp : tqp; + { deposit } + constructor op_reg_reg_reg_const_const(_qp : tqp; + { test bit } + { !!!! here we need also to take care of the postfix } + constructor op_preg_preg_reg_const(_qp : tqp; + { test NaT } + { !!!! here we need also to take care of the postfix } + constructor op_preg_preg_reg(_qp : tqp; + + { -------- here are some missed ----------- } + *) + + { M1: integer load } + { M4: integer store } + { M6: floating-point load } + { M9: floating-point store } + constructor op_reg_ref(_qp : tqp;op : tasmop;postfix : tldsttype; + _hint : thint;const r1 : tregister;ref : treference); + + { M2: integer load incremented by register } + { M7: floating-point load incremented by register } + constructor op_reg_ref_reg(_qp : tqp;op : tasmop;postfix : tldsttype; + _hint : thint;const r1 : tregister;const ref : treference; + const r2 : tregister); + + { M3: integer load increment by imm. } + { M5: integer store increment by imm. } + { M8: floating-point load increment by imm. } + { M10: floating-point store increment by imm. } + constructor op_reg_ref_const(_qp : tqp;op : tasmop;postfix : tldsttype; + _hint : thint;const r1 : tregister;ref : treference;i : longint); + + { M11: floating-point load pair} + constructor op_reg_ref(_qp : tqp;op : tasmop;postfix : tldsttype; + _hint : thint;const r1,r2 : tregister;ref : treference); + + { M12: floating-point load pair increment by imm. } + constructor op_reg_ref(_qp : tqp;op : tasmop;postfix : tldsttype; + _hint : thint;const r1,r2 : tregister;ref : treference;i : longint); + + { X1: break/nop } + constructor op_const62(_qp : tqp;op : tasmop;i : int64); + { X2: move imm64 } + constructor op_reg_const64(_qp : tqp;op : tasmop;const r1 : tregister; + i : int64); + end; + + { the following objects are special for the ia64 } + { they decribe a stop and the bundles } + paistop = ^taistop; + taistop = class(tai) + constructor init; + end; + + { a second underscro indicates a stop } + tbundletemplate = (but_none,but_mii,but_mii_, + but_mi_i,but_mi_i_,but_mlx,but_mlx_, + but_mmi,but_mmi_,but_m_mi,but_m_mi_, + but_mfi,but_mfi_,but_mmf,but_mmf_, + but_mif,but_mib_,but_mbb,but_mbb_, + but_bbb,but_bbb_,but_mmb,but_mmb_, + but_mfb,but_mfb_); + + paibundle = ^taibundle; + taibundle = class(tai) + template : tbundletemplate; + instructions : array[0..1] of paicpu; + end; + +implementation + + +{***************************************************************************** + TaiStop +*****************************************************************************} + + constructor taistop.init; + + begin + inherited create; + typ:=ait_stop; + end; + + +{***************************************************************************** + TaiRegAlloc +*****************************************************************************} + + constructor tairegalloc.alloc(r : tregister); + begin + inherited create; + typ:=ait_regalloc; + allocation:=true; + reg:=r; + end; + + + constructor tairegalloc.dealloc(r : tregister); + begin + inherited create; + typ:=ait_regalloc; + allocation:=false; + reg:=r; + end; + + +{***************************************************************************** + Taicpu +*****************************************************************************} + + { ALU instructions } + { A1,A9: integer ALU } + constructor taicpu.op_reg_reg_reg(op : tasmop;const r1,r2,r3 : tregister); + + begin + end; + + { A2,A10: shift left and add } + constructor taicpu.op_reg_reg_const_reg(_qp : tqp;op : tasmop; + const r1,r2 : tregister;i : byte;const r3 : tregister); + + begin + end; + + { A3,A4,A5: integer ALU - imm.,register } + constructor taicpu.op_reg_const_reg(_qp : tqp;op : tasmop; + const r1 : tregister;i : longint;const r3 : tregister); + + begin + end; + + { A6,A7: integer compare - register,register } + constructor taicpu.op_preg_preg_reg_reg(_qp : tqp;op : tasmop; + cond : tasmcond;p1,p2 : tqp;const r2,r3 : tregister); + + begin + end; + + { A8: integer compare - imm.,register } + constructor taicpu.op_preg_preg_const_reg(_qp : tqp;op : tasmop; + cond : tasmcond;p1,p2 : tqp;i : longint;const r3 : tregister); + + begin + end; + + { M1: integer load } + { M4: integer store } + { M6: floating-point load } + { M9: floating-point store } + constructor taicpu.op_reg_ref(_qp : tqp;op : tasmop;postfix : tldsttype; + _hint : thint;const r1 : tregister;ref : treference); + + begin + end; + + { M2: integer load incremented by register } + { M7: floating-point load incremented by register } + constructor taicpu.op_reg_ref_reg(_qp : tqp;op : tasmop;postfix : tldsttype; + _hint : thint;const r1 : tregister;const ref : treference; + const r2 : tregister); + + begin + end; + + { M3: integer load increment by imm. } + { M5: integer store increment by imm. } + { M8: floating-point load increment by imm. } + { M10: floating-point store increment by imm. } + constructor taicpu.op_reg_ref_const(_qp : tqp;op : tasmop;postfix : tldsttype; + _hint : thint;const r1 : tregister;ref : treference;i : longint); + + begin + end; + + { M11: floating-point load pair} + constructor taicpu.op_reg_ref(_qp : tqp;op : tasmop;postfix : tldsttype; + _hint : thint;const r1,r2 : tregister;ref : treference); + + begin + end; + + { M12: floating-point load pair increment by imm. } + constructor taicpu.op_reg_ref(_qp : tqp;op : tasmop;postfix : tldsttype; + _hint : thint;const r1,r2 : tregister;ref : treference;i : longint); + + begin + end; + + { X1: break/nop } + constructor taicpu.op_const62(_qp : tqp;op : tasmop;i : int64); + { X2: move imm64 } + + begin + end; + + constructor taicpu.op_reg_const64(_qp : tqp;op : tasmop;const r1 : tregister; + i : int64); + + begin + end; + +end. diff --git a/closures/compiler/ia64/cpubase.pas b/closures/compiler/ia64/cpubase.pas new file mode 100644 index 0000000000..0590be4ec5 --- /dev/null +++ b/closures/compiler/ia64/cpubase.pas @@ -0,0 +1,149 @@ +{ + Copyright (C) 2000-2006 by Florian Klaempfl + + this unit implements the base types for the iA-64 architecture + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit cpubase; + + interface + + uses + cutils, + globals, + systems, + cpuinfo, + cgbase; + +type + tasmop = (A_ADD,A_SUB,A_ADDP4,A_AND,A_ANDCM,A_OR,A_XOR,A_SHLADD, + A_SHLADDP4,A_ADDS,A_ADDL,A_CMP,A_CMP4,A_PADD1,A_PADD2, + A_PADD4,A_PSUB1,A_PSUB2,A_PSUB4,A_PAVG1,A_PAVG2,A_PAVGSUB1, + A_PAVGSUB2,A_PCMP1,A_PCMP2,A_PCMP4,A_PSHLADD2,A_PSHRADD2, + A_PMPY2,A_MIX1,A_MIX2,A_MIX4,A_PACK2,A_PACK4,A_UNPACK2, + A_UNPACK4,A_PMIN1,A_PMAX1,A_PMIN2,A_PMAX2,A_PSAD1,A_MUX1, + A_MUX2,A_PSHR2,A_PSHR4,A_SHR,A_PSHL2,A_SHL4,A_SHL, + A_POPCNT,A_SHRP,A_EXTR,A_DEP,A_TBIT,A_TNAT,A_BREAK, + A_NOP,A_CHK,A_MOV,A_ZX1,A_ZX2,A_ZXT4,A_SXT1,A_SXT2,A_SXT4, + A_CXZ1,A_CZX2,A_LD1,A_LD2,A_LD4,A_LD8,A_ST1,A_ST2,A_ST4, + A_ST8,A_LDFS,A_LDFD,A_LDF8,A_LDFE,A_LDF,A_STFS,A_STFD,A_STF8, + A_STFE,A_STF,A_LDFPS,A_LDFPD,A_LDFP8,A_LFETCH,A_CMPXCHG1, + A_CMPXCHG2,A_CMPXHG4,A_CMPXCHG8,A_XCHG1,A_XCHG2,A_XCHG4, + A_XCHG8,A_FETCHADD4,A_FETCHADD8,A_SETF,A_GETF, + A_INVALA,A_MF,A_SRLZ,A_SYNC,A_FLUSHRS,A_FC,A_ALLOC,A_SUM, + A_RUM,A_BR,A_CLRRRB,A_FMA,A_FPMA,A_FMS,A_FPMS,A_FNMA,A_FPNMA, + A_XMA,A_FSELECT,A_FCLASS,A_FRCPA,A_FPRCPA,A_FRSQRTA, + A_FPRSQRTA,A_FMIN,A_FMAX,A_FAMIN,A_FAMAX,A_FPMIN,A_FPMAX, + A_FPAMIN,A_FPAMAX,A_FPCMP,A_FMERGE,A_FMIX,A_FSXT,A_FPACK, + A_FSWAP,A_FAND,A_FANDCM,A_FOR,A_FXOR,A_FPMERGE,A_FCVT, + A_FPCVT,A_FSETC,A_FCLRT,A_FCHKF,A_MOVL); + +Const + firstop = low(tasmop); + lastop = high(tasmop); + +type + TAsmCond = (C_NONE,C_LT,C_LTU,C_EQ,C_LT_UNC,C_LTU_UNC,C_EQ_UNC, + C_EQ_AND,C_EQ_OR,C_EQ_OR_ANDCM,C_NE_AND,C_NE_OR); + + THint = (H_NONE,H_NT1,H_NT2,H_NTA); + TLdStType = (LST_NONE,LST_S,LST_A,LSR_SA,LST_BIAS,LST_ACQ,LST_C_CLR, + LST_FILL,LST_C_NC,LST_C_CLR_ACQ,LST_REL, + LST_SPILL); + +{***************************************************************************** + Flags +*****************************************************************************} + + type + TResFlags = (F_NONE,F_LT,F_LTU,F_EQ,F_LT_UNC,F_LTU_UNC,F_EQ_UNC, + F_EQ_AND,F_EQ_OR,F_EQ_OR_ANDCM,F_NE_AND,F_NE_OR); + +Type + TRegister = (R_NO, { R_NO is Mandatory, signifies no register } + R_0,R_1,R_2,R_3,R_4,R_5,R_6,R_7,R_8,R_9, + R_10,R_11,R_12,R_13,R_14,R_15,R_16,R_17,R_18,R_19, + R_20,R_21,R_22,R_23,R_24,R_25,R_26,R_27,R_28,R_29, + R_30,R_31, + R_F0,R_F1,R_F2,R_F3,R_F4,R_F5,R_F6,R_F7,R_F8,R_F9, + R_F10,R_F11,R_F12,R_F13,R_F14,R_F15,R_F16,R_F17,R_F18,R_F19, + R_F20,R_F21,R_F22,R_F23,R_F24,R_F25,R_F26,R_F27,R_F28,R_F29, + R_F30,R_F31); + + TRegisterset = Set of TRegister; + + { -1 indicates no qualifying prediction } + tqp = -1..63; + +const + qp_none : tqp = -1; + +{ Constants describing the registers } + +Const + intregs = [R_0..R_31]; + fpuregs = [R_F0..R_F31]; + mmregs = []; + + maxvarregs = 128; + maxfpuvarregs = 128; + + max_operands = 4; + +{***************************************************************************** + Default generic sizes +*****************************************************************************} + + { Defines the default address size for a processor, } + OS_ADDR = OS_64; + { the natural int size for a processor, } + OS_INT = OS_64; + OS_SINT = OS_S64; + { the maximum float size for a processor, } + OS_FLOAT = OS_F80; + { the size of a vector register for a processor } + OS_VECTOR = OS_M128; + +{***************************************************************************** + GCC /ABI linking information +*****************************************************************************} + + {# Registers which must be saved when calling a routine declared as + cppdecl, cdecl, stdcall, safecall, palmossyscall. The registers + saved should be the ones as defined in the target ABI and / or GCC. + + This value can be deduced from CALLED_USED_REGISTERS array in the + GCC source. + } + std_saved_registers = [R_9..R_14,R_F2..R_F9]; + {# Required parameter alignment when calling a routine declared as + stdcall and cdecl. The alignment value should be the one defined + by GCC or the target ABI. + + The value of this constant is equal to the constant + PARM_BOUNDARY / BITS_PER_UNIT in the GCC source. + } + std_param_align = 8; + +{***************************************************************************** + Opcode propeties (needed for optimizer) +*****************************************************************************} + +implementation + +end. diff --git a/closures/compiler/ia64/cpuinfo.pas b/closures/compiler/ia64/cpuinfo.pas new file mode 100644 index 0000000000..51e6df6f23 --- /dev/null +++ b/closures/compiler/ia64/cpuinfo.pas @@ -0,0 +1,83 @@ +{ + Copyright (c) 1998-2006 by Florian Klaempfl + + Basic Processor information + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +Unit cpuinfo; + +{$i fpcdefs.inc} + +Interface + +uses + globtype; + +Type + bestreal = extended; + ts32real = single; + ts64real = double; + ts80real = extended; + ts128real = type extended; + ts64comp = type extended; + + pbestreal=^bestreal; + + { possible supported processors for this target } + tcputype = + (cpu_none, + cpu_itanium + ); + + tfputype = + (fpu_none, + fpu_itanium + ); + +const + { calling conventions supported by the code generator } + supported_calling_conventions : tproccalloptions = [ + pocall_internproc, + pocall_stdcall, + pocall_cdecl, + pocall_cppdecl + ]; + + + cputypestr : array[tcputype] of string[10] = ('', + 'ITANIUM' + ); + + fputypestr : array[tfputype] of string[6] = ('', + 'ITANIUM' + ); + + { Supported optimizations, only used for information } + supported_optimizerswitches = [cs_opt_peephole,cs_opt_regvar,cs_opt_stackframe, + cs_opt_asmcse,cs_opt_loopunroll,cs_opt_uncertain, + cs_opt_nodecse]; + + level1optimizerswitches = [cs_opt_level1,cs_opt_peephole]; + level2optimizerswitches = level1optimizerswitches + + [cs_opt_level2,cs_opt_regvar,cs_opt_stackframe,cs_opt_asmcse,cs_opt_nodecse]; + level3optimizerswitches = level2optimizerswitches + [cs_opt_level3{,cs_opt_loopunroll}]; + +Implementation + +end. + diff --git a/closures/compiler/ia64/ia64reg.dat b/closures/compiler/ia64/ia64reg.dat new file mode 100644 index 0000000000..dd2dac4515 --- /dev/null +++ b/closures/compiler/ia64/ia64reg.dat @@ -0,0 +1,268 @@ +; +; iA-64 registers +; This file is generate with help of fpc/compiler/utils/gia64reg, +; please try to use this generator before you do error prone and tedious +; editing by hand +; +; layout +; <name>,<type>,<value>,<stdname>,<gasname> +; +NO,$00,$00,INVALID,INVALID + +R0,$01,0,r0,r0 +R1,$01,1,r1,r1 +R2,$01,2,r2,r2 +R3,$01,3,r3,r3 +R4,$01,4,r4,r4 +R5,$01,5,r5,r5 +R6,$01,6,r6,r6 +R7,$01,7,r7,r7 +R8,$01,8,r8,r8 +R9,$01,9,r9,r9 +R10,$01,10,r10,r10 +R11,$01,11,r11,r11 +R12,$01,12,r12,r12 +R13,$01,13,r13,r13 +R14,$01,14,r14,r14 +R15,$01,15,r15,r15 +R16,$01,16,r16,r16 +R17,$01,17,r17,r17 +R18,$01,18,r18,r18 +R19,$01,19,r19,r19 +R20,$01,20,r20,r20 +R21,$01,21,r21,r21 +R22,$01,22,r22,r22 +R23,$01,23,r23,r23 +R24,$01,24,r24,r24 +R25,$01,25,r25,r25 +R26,$01,26,r26,r26 +R27,$01,27,r27,r27 +R28,$01,28,r28,r28 +R29,$01,29,r29,r29 +R30,$01,30,r30,r30 +R31,$01,31,r31,r31 +R32,$01,32,r32,r32 +R33,$01,33,r33,r33 +R34,$01,34,r34,r34 +R35,$01,35,r35,r35 +R36,$01,36,r36,r36 +R37,$01,37,r37,r37 +R38,$01,38,r38,r38 +R39,$01,39,r39,r39 +R40,$01,40,r40,r40 +R41,$01,41,r41,r41 +R42,$01,42,r42,r42 +R43,$01,43,r43,r43 +R44,$01,44,r44,r44 +R45,$01,45,r45,r45 +R46,$01,46,r46,r46 +R47,$01,47,r47,r47 +R48,$01,48,r48,r48 +R49,$01,49,r49,r49 +R50,$01,50,r50,r50 +R51,$01,51,r51,r51 +R52,$01,52,r52,r52 +R53,$01,53,r53,r53 +R54,$01,54,r54,r54 +R55,$01,55,r55,r55 +R56,$01,56,r56,r56 +R57,$01,57,r57,r57 +R58,$01,58,r58,r58 +R59,$01,59,r59,r59 +R60,$01,60,r60,r60 +R61,$01,61,r61,r61 +R62,$01,62,r62,r62 +R63,$01,63,r63,r63 +R64,$01,64,r64,r64 +R65,$01,65,r65,r65 +R66,$01,66,r66,r66 +R67,$01,67,r67,r67 +R68,$01,68,r68,r68 +R69,$01,69,r69,r69 +R70,$01,70,r70,r70 +R71,$01,71,r71,r71 +R72,$01,72,r72,r72 +R73,$01,73,r73,r73 +R74,$01,74,r74,r74 +R75,$01,75,r75,r75 +R76,$01,76,r76,r76 +R77,$01,77,r77,r77 +R78,$01,78,r78,r78 +R79,$01,79,r79,r79 +R80,$01,80,r80,r80 +R81,$01,81,r81,r81 +R82,$01,82,r82,r82 +R83,$01,83,r83,r83 +R84,$01,84,r84,r84 +R85,$01,85,r85,r85 +R86,$01,86,r86,r86 +R87,$01,87,r87,r87 +R88,$01,88,r88,r88 +R89,$01,89,r89,r89 +R90,$01,90,r90,r90 +R91,$01,91,r91,r91 +R92,$01,92,r92,r92 +R93,$01,93,r93,r93 +R94,$01,94,r94,r94 +R95,$01,95,r95,r95 +R96,$01,96,r96,r96 +R97,$01,97,r97,r97 +R98,$01,98,r98,r98 +R99,$01,99,r99,r99 +R100,$01,100,r100,r100 +R101,$01,101,r101,r101 +R102,$01,102,r102,r102 +R103,$01,103,r103,r103 +R104,$01,104,r104,r104 +R105,$01,105,r105,r105 +R106,$01,106,r106,r106 +R107,$01,107,r107,r107 +R108,$01,108,r108,r108 +R109,$01,109,r109,r109 +R110,$01,110,r110,r110 +R111,$01,111,r111,r111 +R112,$01,112,r112,r112 +R113,$01,113,r113,r113 +R114,$01,114,r114,r114 +R115,$01,115,r115,r115 +R116,$01,116,r116,r116 +R117,$01,117,r117,r117 +R118,$01,118,r118,r118 +R119,$01,119,r119,r119 +R120,$01,120,r120,r120 +R121,$01,121,r121,r121 +R122,$01,122,r122,r122 +R123,$01,123,r123,r123 +R124,$01,124,r124,r124 +R125,$01,125,r125,r125 +R126,$01,126,r126,r126 +R127,$01,127,r127,r127 + +F0,$02,0,r0,r0 +F1,$02,1,r1,r1 +F2,$02,2,r2,r2 +F3,$02,3,r3,r3 +F4,$02,4,r4,r4 +F5,$02,5,r5,r5 +F6,$02,6,r6,r6 +F7,$02,7,r7,r7 +F8,$02,8,r8,r8 +F9,$02,9,r9,r9 +F10,$02,10,r10,r10 +F11,$02,11,r11,r11 +F12,$02,12,r12,r12 +F13,$02,13,r13,r13 +F14,$02,14,r14,r14 +F15,$02,15,r15,r15 +F16,$02,16,r16,r16 +F17,$02,17,r17,r17 +F18,$02,18,r18,r18 +F19,$02,19,r19,r19 +F20,$02,20,r20,r20 +F21,$02,21,r21,r21 +F22,$02,22,r22,r22 +F23,$02,23,r23,r23 +F24,$02,24,r24,r24 +F25,$02,25,r25,r25 +F26,$02,26,r26,r26 +F27,$02,27,r27,r27 +F28,$02,28,r28,r28 +F29,$02,29,r29,r29 +F30,$02,30,r30,r30 +F31,$02,31,r31,r31 +F32,$02,32,r32,r32 +F33,$02,33,r33,r33 +F34,$02,34,r34,r34 +F35,$02,35,r35,r35 +F36,$02,36,r36,r36 +F37,$02,37,r37,r37 +F38,$02,38,r38,r38 +F39,$02,39,r39,r39 +F40,$02,40,r40,r40 +F41,$02,41,r41,r41 +F42,$02,42,r42,r42 +F43,$02,43,r43,r43 +F44,$02,44,r44,r44 +F45,$02,45,r45,r45 +F46,$02,46,r46,r46 +F47,$02,47,r47,r47 +F48,$02,48,r48,r48 +F49,$02,49,r49,r49 +F50,$02,50,r50,r50 +F51,$02,51,r51,r51 +F52,$02,52,r52,r52 +F53,$02,53,r53,r53 +F54,$02,54,r54,r54 +F55,$02,55,r55,r55 +F56,$02,56,r56,r56 +F57,$02,57,r57,r57 +F58,$02,58,r58,r58 +F59,$02,59,r59,r59 +F60,$02,60,r60,r60 +F61,$02,61,r61,r61 +F62,$02,62,r62,r62 +F63,$02,63,r63,r63 +F64,$02,64,r64,r64 +F65,$02,65,r65,r65 +F66,$02,66,r66,r66 +F67,$02,67,r67,r67 +F68,$02,68,r68,r68 +F69,$02,69,r69,r69 +F70,$02,70,r70,r70 +F71,$02,71,r71,r71 +F72,$02,72,r72,r72 +F73,$02,73,r73,r73 +F74,$02,74,r74,r74 +F75,$02,75,r75,r75 +F76,$02,76,r76,r76 +F77,$02,77,r77,r77 +F78,$02,78,r78,r78 +F79,$02,79,r79,r79 +F80,$02,80,r80,r80 +F81,$02,81,r81,r81 +F82,$02,82,r82,r82 +F83,$02,83,r83,r83 +F84,$02,84,r84,r84 +F85,$02,85,r85,r85 +F86,$02,86,r86,r86 +F87,$02,87,r87,r87 +F88,$02,88,r88,r88 +F89,$02,89,r89,r89 +F90,$02,90,r90,r90 +F91,$02,91,r91,r91 +F92,$02,92,r92,r92 +F93,$02,93,r93,r93 +F94,$02,94,r94,r94 +F95,$02,95,r95,r95 +F96,$02,96,r96,r96 +F97,$02,97,r97,r97 +F98,$02,98,r98,r98 +F99,$02,99,r99,r99 +F100,$02,100,r100,r100 +F101,$02,101,r101,r101 +F102,$02,102,r102,r102 +F103,$02,103,r103,r103 +F104,$02,104,r104,r104 +F105,$02,105,r105,r105 +F106,$02,106,r106,r106 +F107,$02,107,r107,r107 +F108,$02,108,r108,r108 +F109,$02,109,r109,r109 +F110,$02,110,r110,r110 +F111,$02,111,r111,r111 +F112,$02,112,r112,r112 +F113,$02,113,r113,r113 +F114,$02,114,r114,r114 +F115,$02,115,r115,r115 +F116,$02,116,r116,r116 +F117,$02,117,r117,r117 +F118,$02,118,r118,r118 +F119,$02,119,r119,r119 +F120,$02,120,r120,r120 +F121,$02,121,r121,r121 +F122,$02,122,r122,r122 +F123,$02,123,r123,r123 +F124,$02,124,r124,r124 +F125,$02,125,r125,r125 +F126,$02,126,r126,r126 +F127,$02,127,r127,r127 diff --git a/closures/compiler/impdef.pas b/closures/compiler/impdef.pas new file mode 100644 index 0000000000..7cb0b8fee0 --- /dev/null +++ b/closures/compiler/impdef.pas @@ -0,0 +1,473 @@ +{ + Copyright (c) 1998-2002 by Pavel + + This unit finds the export defs from PE files + + C source code of DEWIN Windows disassembler (written by A. Milukov) was + partially used + + 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 impdef; + +{$ifndef STANDALONE} + {$i fpcdefs.inc} +{$endif} + +interface + + uses + SysUtils; + + var + as_name, + ar_name : string; + + function makedef(const binname, +{$IFDEF STANDALONE} + textname, +{$ENDIF} + libname:string):longbool; + + +implementation + +{$IFDEF STANDALONE} +var + __textname : string; +const + kind : array[longbool] of pchar=('',' DATA'); +{$ENDIF} + +var + f:file; +{$IFDEF STANDALONE} + t:text; + FileCreated:longbool; +{$ENDIF} + lname:string; + impname:string; + TheWord:array[0..1]of char; + PEoffset:cardinal; + loaded:longint; + +function DOSstubOK(var x:cardinal):longbool; +begin + blockread(f,TheWord,2,loaded); + if loaded<>2 then + DOSstubOK:=false + else + begin + DOSstubOK:=TheWord='MZ'; + seek(f,$3C); + blockread(f,x,4,loaded); + if(loaded<>4)or(x>filesize(f))then + DOSstubOK:=false; + end; +end; + + +function isPE(x:longint):longbool; +begin + seek(f,x); + blockread(f,TheWord,2,loaded); + isPE:=(loaded=2)and(TheWord='PE'); +end; + + +var + cstring : array[0..127]of char; +function GetEdata(PE:cardinal):longbool; +type + TObjInfo=packed record + ObjName:array[0..7]of char; + VirtSize, + VirtAddr, + RawSize, + RawOffset, + Reloc, + LineNum:cardinal; + RelCount, + LineCount:word; + flags:cardinal; + end; +var + i:cardinal; + ObjOfs:cardinal; + Obj:TObjInfo; + APE_obj,APE_Optsize:word; + ExportRVA:cardinal; + delta:cardinal; +const + IMAGE_SCN_CNT_CODE=$00000020; + const +{$ifdef unix} + DirSep = '/'; +{$else} + {$if defined(amiga) or defined(morphos)} + DirSep = '/'; + {$else} + DirSep = '\'; + {$endif} +{$endif} +var + path:string; + _d:dirstr; + _n:namestr; + _e:extstr; + common_created:longbool; +procedure cleardir(const s,ext:string); + var + ff:file; + dir:searchrec; + attr:word; + begin + findfirst(s+dirsep+ext,anyfile,dir); + while (doserror=0) do + begin + assign(ff,s+dirsep+dir.name); + GetFattr(ff,attr); + if not((DOSError<>0)or(Attr and Directory<>0))then + Erase(ff); + findnext(dir); + end; + findclose(dir); + end; +procedure CreateTempDir(const s:string); + var + attr:word; + ff:file; + begin + assign(ff,s); + GetFattr(ff,attr); + if DosError=0 then + begin + cleardir(s,'*.sw'); + cleardir(s,'*.swo'); + end + else + begin + {$push} {$I-} + mkdir(s); + {$pop} + if ioresult<>0 then; + end; + end; +procedure call_as(const name:string); + begin + FlushOutput; + ExecuteProcess(as_name,'-o '+name+'o '+name); + end; +procedure call_ar; + var + f:file; + attr:word; + begin +{$IFDEF STANDALONE} + if impname='' then + exit; +{$ENDIF} + assign(f,impname); + GetFAttr(f,attr); + If DOSError=0 then + erase(f); + FlushOutput; + ExecuteProcess(ar_name,'rs '+impname+' '+path+dirsep+'*.swo'); + cleardir(path,'*.sw'); + cleardir(path,'*.swo'); + {$push} {$I-} + RmDir(path); + {$pop} + if ioresult<>0 then; + end; +procedure makeasm(index:cardinal;name:pchar;isData:longbool); + type + tt=array[1..1]of pchar; + pt=^tt; + const + fn_template:array[1..24]of pchar=( + '.section .idata$2', + '.rva .L4', + '.long 0,0', + '.rva ', + '.rva .L5', + '.section .idata$4', + '.L4:', + '.rva .L6', + '.long 0', + '.section .idata$5', + '.L5:', + '.text', + '.globl ', + ':', + 'jmp *.L7', + '.balign 4,144', + '.section .idata$5', + '.L7:', + '.rva .L6', + '.long 0', + '.section .idata$6', + '.L6:', + '.short 0', + '.ascii "\000"' + ); + var_template:array[1..19]of pchar=( + '.section .idata$2', + '.rva .L7', + '.long 0,0', + '.rva ', + '.rva .L8', + '.section .idata$4', + '.L7:', + '.rva .L9', + '.long 0', + '.section .idata$5', + '.L8:', + '.globl ', + ':', + '.rva .L9', + '.long 0', + '.section .idata$6', + '.L9:', + '.short 0', + '.ascii "\000"' + ); + __template:array[longbool]of pointer=(@fn_template,@var_template); + common_part:array[1..5]of pchar=( + '.balign 2,0', + '.section .idata$7', + '.globl ', + ':', + '.ascii "\000"' + ); + posit:array[longbool,1..4]of longint=((4,13,14,24),(4,12,13,19)); + var + template:array[longbool]of pt absolute __template; + f:text; + s:string; + i:longint; + n:string; + common_name,asmout:string; + __d:dirstr; + __n:namestr; + __x:extstr; + begin + if not common_created then + begin + common_name:='_$'+_n+'@common'; + asmout:=path+dirsep+'0.sw'; + assign(f,asmout); + rewrite(f); + for i:=1 to 5 do + begin + s:=StrPas(Common_part[i]); + case i of + 3: + s:=s+common_name; + 4: + s:=common_name+s; + 5: + begin + fsplit(lname,__d,__n,__x); + insert(__n+__x,s,9); + end; + end; + writeln(f,s); + end; + close(f); + call_as(asmout); + common_created:=true; + end; + n:=strpas(name); + str(succ(index):0,s); + asmout:=path+dirsep+s+'.sw'; + assign(f,asmout); + rewrite(f); + for i:=1 to posit[isData,4]do + begin + s:=StrPas(template[isData]^[i]); + if i=posit[isData,1]then + s:=s+common_name + else if i=posit[isData,2]then + s:=s+n + else if i=posit[isData,3]then + s:=n+s + else if i=posit[isData,4]then + insert(n,s,9); + writeln(f,s); + end; + close(f); + call_as(asmout); + end; +procedure ProcessEdata; + type + a8=array[0..7]of char; + function GetSectionName(rva:cardinal;var Flags:cardinal):a8; + var + i:cardinal; + LocObjOfs:cardinal; + LocObj:TObjInfo; + begin + GetSectionName:=''; + Flags:=0; + LocObjOfs:=APE_OptSize+PEoffset+24; + for i:=1 to APE_obj do + begin + seek(f,LocObjOfs); + blockread(f,LocObj,sizeof(LocObj)); + if(rva>=LocObj.VirtAddr)and(rva<=LocObj.VirtAddr+LocObj.RawSize)then + begin + GetSectionName:=a8(LocObj.ObjName); + Flags:=LocObj.flags; + end; + end; + end; + var + j,Fl:cardinal; + ulongval,procEntry:cardinal; + Ordinal:word; + isData:longbool; + ExpDir:packed record + flag, + stamp:cardinal; + Major, + Minor:word; + Name, + Base, + NumFuncs, + NumNames, + AddrFuncs, + AddrNames, + AddrOrds:cardinal; + end; + begin + with Obj do + begin + seek(f,RawOffset+delta); + blockread(f,ExpDir,sizeof(ExpDir)); + fsplit(impname,_d,_n,_e); + path:=_d+_n+'.ils'; +{$IFDEF STANDALONE} + if impname<>'' then +{$ENDIF} + CreateTempDir(path); + Common_created:=false; + for j:=0 to pred(ExpDir.NumNames)do + begin + seek(f,RawOffset-VirtAddr+ExpDir.AddrOrds+j*2); + blockread(f,Ordinal,2); + seek(f,RawOffset-VirtAddr+ExpDir.AddrFuncs+Cardinal(Ordinal*4)); + blockread(f,ProcEntry,4); + seek(f,RawOffset-VirtAddr+ExpDir.AddrNames+j*4); + blockread(f,ulongval,4); + seek(f,RawOffset-VirtAddr+ulongval); + blockread(f,cstring,sizeof(cstring)); +{$IFDEF STANDALONE} + if not FileCreated then + begin + FileCreated:=true; + if(__textname<>'')or(impname='')then + begin + rewrite(t); + writeln(t,'EXPORTS'); + end; + end; +{$ENDIF} + isData:=GetSectionName(procentry,Fl)=''; + if not isData then + isData:=Fl and IMAGE_SCN_CNT_CODE<>IMAGE_SCN_CNT_CODE; +{$IFDEF STANDALONE} + if(__textname<>'')or(impname='')then + writeln(t,cstring,' @',succ(ordinal):0,' ',kind[isData]); + if impname<>''then +{$ENDIF} + makeasm(j,cstring,isData); + end; + call_ar; + end; + end; + +begin + GetEdata:=false; +{$IFDEF STANDALONE} + FileCreated:=false; +{$ENDIF} + seek(f,PE+120); + blockread(f,ExportRVA,4); + seek(f,PE+6); + blockread(f,APE_Obj,2); + seek(f,PE+20); + blockread(f,APE_OptSize,2); + ObjOfs:=APE_OptSize+PEoffset+24; + for i:=1 to APE_obj do + begin + seek(f,ObjOfs); + blockread(f,Obj,sizeof(Obj)); + inc(ObjOfs,sizeof(Obj)); + with Obj do + if(VirtAddr<=ExportRva)and(ExportRva<VirtAddr+VirtSize)then + begin + delta:=ExportRva-VirtAddr; + ProcessEdata; + GetEdata:=true; + end; + end; +end; + + +function makedef(const binname, +{$IFDEF STANDALONE} + textname, +{$ENDIF} + libname:string):longbool; +var + OldFileMode:longint; +begin + assign(f,binname); +{$IFDEF STANDALONE} + FileCreated:=false; + assign(t,textname); + __textname:=textname; +{$ENDIF} + impname:=libname; + lname:=binname; + OldFileMode:=filemode; + {$push} {$I-} + filemode:=0; + reset(f,1); + filemode:=OldFileMode; + {$pop} + if IOResult<>0 then + begin + makedef:=false; + exit; + end; + if not DOSstubOK(PEoffset)then + makedef:=false + else if not IsPE(PEoffset)then + makedef:=false + else + makedef:=GetEdata(PEoffset); + close(f); +{$IFDEF STANDALONE} + if FileCreated then + if(textname<>'')or(impname='')then + close(t); +{$ENDIF} +end; + +end. diff --git a/closures/compiler/import.pas b/closures/compiler/import.pas new file mode 100644 index 0000000000..c8bc844c50 --- /dev/null +++ b/closures/compiler/import.pas @@ -0,0 +1,130 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements an uniform import 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 import; + +{$i fpcdefs.inc} + +interface + +uses + cutils,cclasses, + systems, + aasmbase, + symdef,symsym; + +type + timportlib=class + private + notsupmsg : boolean; + procedure NotSupported; + public + constructor Create;virtual; + destructor Destroy;override; + procedure generatelib;virtual; + end; + + TDLLScanner=class + function Scan(const binname:string):boolean;virtual;abstract; + end; + + TImportLibClass=class of TImportLib; + TDLLScannerClass=class of TDLLScanner; + +var + CImportLib : array[tsystem] of TImportLibClass; + CDLLScanner : array[tsystem] of TDLLScannerClass; + ImportLib : TImportLib; + +procedure RegisterImport(t:tsystem;c:TImportLibClass); +procedure RegisterDLLScanner(t:tsystem;c:TDLLScannerClass); +procedure InitImport; +procedure DoneImport; + + +implementation + +uses + verbose,globals; + +{**************************************************************************** + TImportLib +****************************************************************************} + +constructor timportlib.Create; +begin + notsupmsg:=false; +end; + + +destructor timportlib.Destroy; +begin +end; + + +procedure timportlib.NotSupported; +begin + { show the message only once } + if not notsupmsg then + begin + Message(exec_e_dll_not_supported); + notsupmsg:=true; + end; +end; + + +procedure timportlib.generatelib; +begin + NotSupported; +end; + + +{***************************************************************************** + Init/Done +*****************************************************************************} + +procedure RegisterImport(t:tsystem;c:TImportLibClass); +begin + CImportLib[t]:=c; +end; + + +procedure RegisterDLLScanner(t:tsystem;c:TDLLScannerClass); +begin + CDLLScanner[t]:=c; +end; + + +procedure InitImport; +begin + if assigned(CImportLib[target_info.system]) then + importlib:=CImportLib[target_info.system].Create + else + importlib:=TImportLib.Create; +end; + + +procedure DoneImport; +begin + if assigned(importlib) then + importlib.free; +end; + +end. diff --git a/closures/compiler/link.pas b/closures/compiler/link.pas new file mode 100644 index 0000000000..0f130c7723 --- /dev/null +++ b/closures/compiler/link.pas @@ -0,0 +1,1398 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit handles the linker and binder calls for programs and + libraries + + 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 link; + +{$i fpcdefs.inc} + +interface + + uses + sysutils, + cclasses, + systems, + fmodule, + globtype, + ogbase; + + Type + TLinkerInfo=record + ExeCmd, + DllCmd, + ExtDbgCmd : array[1..3] of string; + ResName : string[100]; + ScriptName : string[100]; + ExtraOptions : TCmdStr; + DynamicLinker : string[100]; + end; + + TLinker = class(TAbstractLinker) + public + HasResources, + HasExports : boolean; + SysInitUnit : string[20]; + ObjectFiles, + SharedLibFiles, + StaticLibFiles, + FrameworkFiles : TCmdStrList; + Constructor Create;virtual; + Destructor Destroy;override; + procedure AddModuleFiles(hp:tmodule); + Procedure AddObject(const S,unitpath : TCmdStr;isunit:boolean); + Procedure AddStaticLibrary(const S : TCmdStr); + Procedure AddSharedLibrary(S : TCmdStr); + Procedure AddStaticCLibrary(const S : TCmdStr); + Procedure AddSharedCLibrary(S : TCmdStr); + Procedure AddFramework(S : TCmdStr); + procedure AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);virtual; + Procedure InitSysInitUnitName;virtual; + Function MakeExecutable:boolean;virtual; + Function MakeSharedLibrary:boolean;virtual; + Function MakeStaticLibrary:boolean;virtual; + procedure ExpandAndApplyOrder(var Src:TCmdStrList); + procedure LoadPredefinedLibraryOrder;virtual; + function ReOrderEntries : boolean; + end; + + TExternalLinker = class(TLinker) + public + Info : TLinkerInfo; + Constructor Create;override; + Destructor Destroy;override; + Function FindUtil(const s:TCmdStr):TCmdStr; + Function CatFileContent(para:TCmdStr):TCmdStr; + Function DoExec(const command:TCmdStr; para:TCmdStr;showinfo,useshell:boolean):boolean; + procedure SetDefaultInfo;virtual; + Function MakeStaticLibrary:boolean;override; + end; + + TBooleanArray = array [1..1024] of boolean; + PBooleanArray = ^TBooleanArray; + + TInternalLinker = class(TLinker) + private + FCExeOutput : TExeOutputClass; + FCObjInput : TObjInputClass; + { Libraries } + FStaticLibraryList : TFPHashObjectList; + FImportLibraryList : TFPHashObjectList; + procedure Load_ReadObject(const para:TCmdStr); + procedure Load_ReadStaticLibrary(const para:TCmdStr); + procedure ParseScript_Handle; + procedure ParseScript_PostCheck; + procedure ParseScript_Load; + function ParsePara(const para : string) : string; + procedure ParseScript_Order; + procedure ParseScript_MemPos; + procedure ParseScript_DataPos; + procedure PrintLinkerScript; + function RunLinkScript(const outputname:TCmdStr):boolean; + protected + linkscript : TCmdStrList; + ScriptCount : longint; + IsHandled : PBooleanArray; + property CObjInput:TObjInputClass read FCObjInput write FCObjInput; + property CExeOutput:TExeOutputClass read FCExeOutput write FCExeOutput; + property StaticLibraryList:TFPHashObjectList read FStaticLibraryList; + property ImportLibraryList:TFPHashObjectList read FImportLibraryList; + procedure DefaultLinkScript;virtual;abstract; + public + IsSharedLibrary : boolean; + UseStabs : boolean; + Constructor Create;override; + Destructor Destroy;override; + Function MakeExecutable:boolean;override; + Function MakeSharedLibrary:boolean;override; + procedure AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean);override; + end; + + var + Linker : TLinker; + + function FindObjectFile(s : TCmdStr;const unitpath:TCmdStr;isunit:boolean) : TCmdStr; + function FindLibraryFile(s:TCmdStr;const prefix,ext:TCmdStr;var foundfile : TCmdStr) : boolean; + function FindDLL(const s:TCmdStr;var founddll:TCmdStr):boolean; + + procedure InitLinker; + procedure DoneLinker; + + +Implementation + + uses + cutils,cfileutl,cstreams, + script,globals,verbose,comphook,ppu,fpccrc, + aasmbase,aasmtai,aasmdata,aasmcpu, + owbase,owar,ogmap; + + type + TLinkerClass = class of Tlinker; + +{***************************************************************************** + Helpers +*****************************************************************************} + + function GetFileCRC(const fn:string):cardinal; + var + fs : TCStream; + bufcount, + bufsize : Integer; + buf : pbyte; + begin + result:=0; + bufsize:=64*1024; + fs:=CFileStreamClass.Create(fn,fmOpenRead or fmShareDenyNone); + if CStreamError<>0 then + begin + fs.Free; + Comment(V_Error,'Can''t open file: '+fn); + exit; + end; + getmem(buf,bufsize); + repeat + bufcount:=fs.Read(buf^,bufsize); + result:=UpdateCrc32(result,buf^,bufcount); + until bufcount<bufsize; + freemem(buf); + fs.Free; + end; + + + { searches an object file } + function FindObjectFile(s:TCmdStr;const unitpath:TCmdStr;isunit:boolean) : TCmdStr; + var + found : boolean; + foundfile : TCmdStr; + begin + findobjectfile:=''; + if s='' then + exit; + + {When linking on target, the units has not been assembled yet, + so there is no object files to look for at + the host. Look for the corresponding assembler file instead, + because it will be assembled to object file on the target.} + if isunit and (cs_link_on_target in current_settings.globalswitches) then + s:=ChangeFileExt(s,target_info.asmext); + + { when it does not belong to the unit then check if + the specified file exists without searching any paths } + if not isunit then + begin + if FileExists(FixFileName(s),false) then + begin + foundfile:=ScriptFixFileName(s); + found:=true; + end; + end; + if pos('.',s)=0 then + s:=s+target_info.objext; + { find object file + 1. output unit path + 2. output exe path + 3. specified unit path (if specified) + 4. cwd + 5. unit search path + 6. local object path + 7. global object path + 8. exepath (not when linking on target) + for all finds don't use the directory caching } + found:=false; + if isunit and (OutputUnitDir<>'') then + found:=FindFile(s,OutPutUnitDir,false,foundfile) + else + if OutputExeDir<>'' then + found:=FindFile(s,OutPutExeDir,false,foundfile); + if (not found) and (unitpath<>'') then + found:=FindFile(s,unitpath,false,foundfile); + if (not found) then + found:=FindFile(s, CurDirRelPath(source_info),false,foundfile); + if (not found) then + found:=UnitSearchPath.FindFile(s,false,foundfile); + if (not found) then + found:=current_module.localobjectsearchpath.FindFile(s,false,foundfile); + if (not found) then + found:=objectsearchpath.FindFile(s,false,foundfile); + if not(cs_link_on_target in current_settings.globalswitches) and (not found) then + found:=FindFile(s,exepath,false,foundfile); + if not(cs_link_nolink in current_settings.globalswitches) and (not found) then + Message1(exec_w_objfile_not_found,s); + + {Restore file extension} + if isunit and (cs_link_on_target in current_settings.globalswitches) then + foundfile:= ChangeFileExt(foundfile,target_info.objext); + + findobjectfile:=ScriptFixFileName(foundfile); + end; + + + { searches a (windows) DLL file } + function FindDLL(const s:TCmdStr;var founddll:TCmdStr):boolean; + var + sysdir : TCmdStr; + Found : boolean; + begin + Found:=false; + { Look for DLL in: + 1. Current dir + 2. Library Path + 3. windir,windir/system,windir/system32 } + Found:=FindFile(s,'.'+source_info.DirSep,false,founddll); + if (not found) then + Found:=librarysearchpath.FindFile(s,false,founddll); + + { when cross compiling, it is pretty useless to search windir etc. for dlls } + if (not found) and (source_info.system=target_info.system) then + begin + sysdir:=FixPath(GetEnvironmentVariable('windir'),false); + Found:=FindFile(s,sysdir+';'+sysdir+'system'+source_info.DirSep+';'+sysdir+'system32'+source_info.DirSep,false,founddll); + end; + if (not found) then + begin + message1(exec_w_libfile_not_found,s); + FoundDll:=s; + end; + FindDll:=Found; + end; + + + { searches an library file } + function FindLibraryFile(s:TCmdStr;const prefix,ext:TCmdStr;var foundfile : TCmdStr) : boolean; + var + found : boolean; + paths : TCmdStr; + begin + findlibraryfile:=false; + foundfile:=s; + if s='' then + exit; + { split path from filename } + paths:=ExtractFilePath(s); + s:=ExtractFileName(s); + { add prefix 'lib' } + if (prefix<>'') and (Copy(s,1,length(prefix))<>prefix) then + s:=prefix+s; + { add extension } + if (ext<>'') and (Copy(s,length(s)-length(ext)+1,length(ext))<>ext) then + s:=s+ext; + { readd the split path } + s:=paths+s; + if FileExists(s,false) then + begin + foundfile:=ScriptFixFileName(s); + FindLibraryFile:=true; + exit; + end; + { find libary + 1. cwd + 2. local libary dir + 3. global libary dir + 4. exe path of the compiler (not when linking on target) + for all searches don't use the directory cache } + found:=FindFile(s, CurDirRelPath(source_info), false,foundfile); + if (not found) and (current_module.outputpath^<>'') then + found:=FindFile(s,current_module.outputpath^,false,foundfile); + if (not found) then + found:=current_module.locallibrarysearchpath.FindFile(s,false,foundfile); + if (not found) then + found:=librarysearchpath.FindFile(s,false,foundfile); + if not(cs_link_on_target in current_settings.globalswitches) and (not found) then + found:=FindFile(s,exepath,false,foundfile); + foundfile:=ScriptFixFileName(foundfile); + findlibraryfile:=found; + end; + + +{***************************************************************************** + TLINKER +*****************************************************************************} + + Constructor TLinker.Create; + begin + Inherited Create; + ObjectFiles:=TCmdStrList.Create_no_double; + SharedLibFiles:=TCmdStrList.Create_no_double; + StaticLibFiles:=TCmdStrList.Create_no_double; + FrameworkFiles:=TCmdStrList.Create_no_double; + end; + + + Destructor TLinker.Destroy; + begin + ObjectFiles.Free; + SharedLibFiles.Free; + StaticLibFiles.Free; + FrameworkFiles.Free; + end; + + + procedure TLinker.AddModuleFiles(hp:tmodule); + var + mask : longint; + i,j : longint; + ImportLibrary : TImportLibrary; + ImportSymbol : TImportSymbol; + begin + with hp do + begin + if (flags and uf_has_resourcefiles)<>0 then + HasResources:=true; + if (flags and uf_has_exports)<>0 then + HasExports:=true; + { link unit files } + if (flags and uf_no_link)=0 then + begin + { create mask which unit files need linking } + mask:=link_always; + { static linking ? } + if (cs_link_static in current_settings.globalswitches) then + begin + if (flags and uf_static_linked)=0 then + begin + { if smart not avail then try static linking } + if (flags and uf_smart_linked)<>0 then + begin + Message1(exec_t_unit_not_static_linkable_switch_to_smart,modulename^); + mask:=mask or link_smart; + end + else + Message1(exec_e_unit_not_smart_or_static_linkable,modulename^); + end + else + mask:=mask or link_static; + end; + { smart linking ? } + + if (cs_link_smart in current_settings.globalswitches) then + begin + if (flags and uf_smart_linked)=0 then + begin + { if smart not avail then try static linking } + if (flags and uf_static_linked)<>0 then + begin + { if not create_smartlink_library, then smart linking happens using the + regular object files + } + if create_smartlink_library then + Message1(exec_t_unit_not_smart_linkable_switch_to_static,modulename^); + mask:=mask or link_static; + end + else + Message1(exec_e_unit_not_smart_or_static_linkable,modulename^); + end + else + mask:=mask or link_smart; + end; + { shared linking } + if (cs_link_shared in current_settings.globalswitches) then + begin + if (flags and uf_shared_linked)=0 then + begin + { if shared not avail then try static linking } + if (flags and uf_static_linked)<>0 then + begin + Message1(exec_t_unit_not_shared_linkable_switch_to_static,modulename^); + mask:=mask or link_static; + end + else + Message1(exec_e_unit_not_shared_or_static_linkable,modulename^); + end + else + mask:=mask or link_shared; + end; + { unit files } + while not linkunitofiles.empty do + AddObject(linkunitofiles.getusemask(mask),path^,true); + while not linkunitstaticlibs.empty do + AddStaticLibrary(linkunitstaticlibs.getusemask(mask)); + while not linkunitsharedlibs.empty do + AddSharedLibrary(linkunitsharedlibs.getusemask(mask)); + end; + { Other needed .o and libs, specified using $L,$LINKLIB,external } + mask:=link_always; + while not linkotherofiles.empty do + AddObject(linkotherofiles.Getusemask(mask),path^,false); + while not linkotherstaticlibs.empty do + AddStaticCLibrary(linkotherstaticlibs.Getusemask(mask)); + while not linkothersharedlibs.empty do + AddSharedCLibrary(linkothersharedlibs.Getusemask(mask)); + while not linkotherframeworks.empty do + AddFramework(linkotherframeworks.Getusemask(mask)); + { Known Library/DLL Imports } + for i:=0 to ImportLibraryList.Count-1 do + begin + ImportLibrary:=TImportLibrary(ImportLibraryList[i]); + for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do + begin + ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]); + AddImportSymbol(ImportLibrary.Name,ImportSymbol.Name, + ImportSymbol.MangledName,ImportSymbol.OrdNr,ImportSymbol.IsVar); + end; + end; + end; + end; + + + procedure TLinker.AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean); + begin + end; + + + Procedure TLinker.AddObject(const S,unitpath : TCmdStr;isunit:boolean); + begin + ObjectFiles.Concat(FindObjectFile(s,unitpath,isunit)); + end; + + + Procedure TLinker.AddSharedLibrary(S:TCmdStr); + begin + if s='' then + exit; + { remove prefix 'lib' } + if Copy(s,1,length(target_info.sharedlibprefix))=target_info.sharedlibprefix then + Delete(s,1,length(target_info.sharedlibprefix)); + { remove extension if any } + if Copy(s,length(s)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext))=target_info.sharedlibext then + Delete(s,length(s)-length(target_info.sharedlibext)+1,length(target_info.sharedlibext)+1); + { ready to be added } + SharedLibFiles.Concat(S); + end; + + + Procedure TLinker.AddStaticLibrary(const S:TCmdStr); + var + ns : TCmdStr; + found : boolean; + begin + if s='' then + exit; + found:=FindLibraryFile(s,target_info.staticlibprefix,target_info.staticlibext,ns); + if not(cs_link_nolink in current_settings.globalswitches) and (not found) then + Message1(exec_w_libfile_not_found,s); + StaticLibFiles.Concat(ns); + end; + + + Procedure TLinker.AddSharedCLibrary(S:TCmdStr); + begin + if s='' then + exit; + { remove prefix 'lib' } + if Copy(s,1,length(target_info.sharedclibprefix))=target_info.sharedclibprefix then + Delete(s,1,length(target_info.sharedclibprefix)); + { remove extension if any } + if Copy(s,length(s)-length(target_info.sharedclibext)+1,length(target_info.sharedclibext))=target_info.sharedclibext then + Delete(s,length(s)-length(target_info.sharedclibext)+1,length(target_info.sharedclibext)+1); + { ready to be added } + SharedLibFiles.Concat(S); + end; + + + Procedure TLinker.AddFramework(S:TCmdStr); + begin + if s='' then + exit; + { ready to be added } + FrameworkFiles.Concat(S); + end; + + + Procedure TLinker.AddStaticCLibrary(const S:TCmdStr); + var + ns : TCmdStr; + found : boolean; + begin + if s='' then + exit; + found:=FindLibraryFile(s,target_info.staticclibprefix,target_info.staticclibext,ns); + if not(cs_link_nolink in current_settings.globalswitches) and (not found) then + Message1(exec_w_libfile_not_found,s); + StaticLibFiles.Concat(ns); + end; + + + procedure AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean); + begin + end; + + + procedure TLinker.InitSysInitUnitName; + begin + end; + + function TLinker.MakeExecutable:boolean; + begin + MakeExecutable:=false; + Message(exec_e_exe_not_supported); + end; + + + Function TLinker.MakeSharedLibrary:boolean; + begin + MakeSharedLibrary:=false; + Message(exec_e_dll_not_supported); + end; + + + Function TLinker.MakeStaticLibrary:boolean; + begin + MakeStaticLibrary:=false; + Message(exec_e_dll_not_supported); + end; + + + Procedure TLinker.ExpandAndApplyOrder(var Src:TCmdStrList); + var + p : TLinkStrMap; + i : longint; + begin + // call Virtual TLinker method to initialize + LoadPredefinedLibraryOrder; + + // something to do? + if (LinkLibraryAliases.count=0) and (LinkLibraryOrder.Count=0) Then + exit; + p:=TLinkStrMap.Create; + + // expand libaliases, clears src + LinkLibraryAliases.expand(src,p); + + // writeln(src.count,' ',p.count,' ',linklibraryorder.count,' ',linklibraryaliases.count); + // apply order + p.UpdateWeights(LinkLibraryOrder); + p.SortOnWeight; + + // put back in src + for i:=0 to p.count-1 do + src.insert(p[i].Key); + p.free; + end; + + + procedure TLinker.LoadPredefinedLibraryOrder; + begin + end; + + + function TLinker.ReOrderEntries : boolean; + begin + result:=(LinkLibraryOrder.count>0) or (LinkLibraryAliases.count>0); + end; + + +{***************************************************************************** + TEXTERNALLINKER +*****************************************************************************} + + Constructor TExternalLinker.Create; + begin + inherited Create; + { set generic defaults } + FillChar(Info,sizeof(Info),0); + if cs_link_on_target in current_settings.globalswitches then + begin + Info.ResName:=outputexedir+ChangeFileExt(inputfilename,'_link.res'); + Info.ScriptName:=outputexedir+ChangeFileExt(inputfilename,'_script.res'); + end + else + begin + Info.ResName:='link.res'; + Info.ScriptName:='script.res'; + end; + { set the linker specific defaults } + SetDefaultInfo; + { Allow Parameter overrides for linker info } + with Info do + begin + if ParaLinkOptions<>'' then + ExtraOptions:=ParaLinkOptions; + if ParaDynamicLinker<>'' then + DynamicLinker:=ParaDynamicLinker; + end; + end; + + + Destructor TExternalLinker.Destroy; + begin + inherited destroy; + end; + + + Procedure TExternalLinker.SetDefaultInfo; + begin + end; + + + Function TExternalLinker.FindUtil(const s:TCmdStr):TCmdStr; + var + Found : boolean; + FoundBin : TCmdStr; + UtilExe : TCmdStr; + begin + if cs_link_on_target in current_settings.globalswitches then + begin + { If linking on target, don't add any path PM } + FindUtil:=ChangeFileExt(s,target_info.exeext); + exit; + end; + UtilExe:=ChangeFileExt(s,source_info.exeext); + FoundBin:=''; + Found:=false; + if utilsdirectory<>'' then + Found:=FindFile(utilexe,utilsdirectory,false,Foundbin); + if (not Found) then + Found:=FindExe(utilexe,false,Foundbin); + if (not Found) and not(cs_link_nolink in current_settings.globalswitches) then + begin + Message1(exec_e_util_not_found,utilexe); + current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink]; + end; + if (FoundBin<>'') then + Message1(exec_t_using_util,FoundBin); + FindUtil:=FoundBin; + end; + + + Function TExternalLinker.CatFileContent(para : TCmdStr) : TCmdStr; + var + filecontent : TCmdStr; + f : text; + st : string; + begin + if not (tf_no_backquote_support in source_info.flags) then + begin + CatFileContent:='`cat '+MaybeQuoted(para)+'`'; + Exit; + end; + assign(f,para); + filecontent:=''; + {$push}{$I-} + reset(f); + {$pop} + if IOResult<>0 then + begin + Message1(exec_n_backquote_cat_file_not_found,para); + end + else + begin + while not eof(f) do + begin + readln(f,st); + if st<>'' then + filecontent:=filecontent+' '+st; + end; + close(f); + end; + CatFileContent:=filecontent; + end; + + Function TExternalLinker.DoExec(const command:TCmdStr; para:TCmdStr;showinfo,useshell:boolean):boolean; + var + exitcode: longint; + begin + DoExec:=true; + if not(cs_link_nolink in current_settings.globalswitches) then + begin + FlushOutput; + if useshell then + exitcode:=shell(maybequoted(command)+' '+para) + else + try + exitcode:=ExecuteProcess(command,para); + except on E:EOSError do + begin + Message(exec_e_cant_call_linker); + current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink]; + DoExec:=false; + end; + end; + if (exitcode<>0) then + begin + Message(exec_e_error_while_linking); + current_settings.globalswitches:=current_settings.globalswitches+[cs_link_nolink]; + DoExec:=false; + end; + end; + { Update asmres when externmode is set } + if cs_link_nolink in current_settings.globalswitches then + begin + if showinfo then + begin + if DLLsource then + AsmRes.AddLinkCommand(Command,Para,current_module.sharedlibfilename^) + else + AsmRes.AddLinkCommand(Command,Para,current_module.exefilename^); + end + else + AsmRes.AddLinkCommand(Command,Para,''); + end; + end; + + + Function TExternalLinker.MakeStaticLibrary:boolean; + + function GetNextFiles(const maxCmdLength : Longint; var item : TCmdStrListItem) : TCmdStr; + begin + result := ''; + while (assigned(item) and ((length(result) + length(item.str) + 1) < maxCmdLength)) do begin + result := result + ' ' + item.str; + item := TCmdStrListItem(item.next); + end; + end; + + var + binstr, scriptfile : TCmdStr; + cmdstr, nextcmd, smartpath : TCmdStr; + current : TCmdStrListItem; + script: Text; + scripted_ar : boolean; + success : boolean; + begin + MakeStaticLibrary:=false; + { remove the library, to be sure that it is rewritten } + DeleteFile(current_module.staticlibfilename^); + { Call AR } + smartpath:=FixPath(ChangeFileExt(current_module.asmfilename^,target_info.smartext),false); + SplitBinCmd(target_ar.arcmd,binstr,cmdstr); + binstr := FindUtil(utilsprefix + binstr); + + + scripted_ar:=target_ar.id=ar_gnu_ar_scripted; + + if scripted_ar then + begin + scriptfile := FixFileName(smartpath+'arscript.txt'); + Replace(cmdstr,'$SCRIPT',maybequoted(scriptfile)); + Assign(script, scriptfile); + Rewrite(script); + try + writeln(script, 'CREATE ' + current_module.staticlibfilename^); + current := TCmdStrListItem(SmartLinkOFiles.First); + while current <> nil do + begin + writeln(script, 'ADDMOD ' + current.str); + current := TCmdStrListItem(current.next); + end; + writeln(script, 'SAVE'); + writeln(script, 'END'); + finally + Close(script); + end; + success:=DoExec(binstr,cmdstr,false,true); + end + else + begin + Replace(cmdstr,'$LIB',maybequoted(current_module.staticlibfilename^)); + { create AR commands } + success := true; + current := TCmdStrListItem(SmartLinkOFiles.First); + repeat + nextcmd := cmdstr; + Replace(nextcmd,'$FILES',GetNextFiles(2047, current)); + success:=DoExec(binstr,nextcmd,false,true); + until (not assigned(current)) or (not success); + end; + + if (target_ar.arfinishcmd <> '') then + begin + SplitBinCmd(target_ar.arfinishcmd,binstr,cmdstr); + binstr := FindUtil(utilsprefix + binstr); + Replace(cmdstr,'$LIB',maybequoted(current_module.staticlibfilename^)); + success:=DoExec(binstr,cmdstr,false,true); + end; + + { Clean up } + if not(cs_asm_leave in current_settings.globalswitches) then + if not(cs_link_nolink in current_settings.globalswitches) then + begin + while not SmartLinkOFiles.Empty do + DeleteFile(SmartLinkOFiles.GetFirst); + if scripted_ar then + DeleteFile(scriptfile); + RemoveDir(smartpath); + end + else + begin + AsmRes.AddDeleteCommand(FixFileName(smartpath+current_module.asmprefix^+'*'+target_info.objext)); + if scripted_ar then + AsmRes.AddDeleteCommand(scriptfile); + AsmRes.AddDeleteDirCommand(smartpath); + end; + MakeStaticLibrary:=success; + end; + + +{***************************************************************************** + TINTERNALLINKER +*****************************************************************************} + + Constructor TInternalLinker.Create; + begin + inherited Create; + linkscript:=TCmdStrList.Create; + FStaticLibraryList:=TFPHashObjectList.Create(true); + FImportLibraryList:=TFPHashObjectList.Create(true); + exemap:=nil; + exeoutput:=nil; + UseStabs:=false; + CObjInput:=TObjInput; + ScriptCount:=0; + IsHandled:=nil; + end; + + + Destructor TInternalLinker.Destroy; + begin + linkscript.free; + StaticLibraryList.Free; + ImportLibraryList.Free; + if assigned(IsHandled) then + begin + FreeMem(IsHandled,sizeof(boolean)*ScriptCount); + IsHandled:=nil; + ScriptCount:=0; + end; + if assigned(exeoutput) then + begin + exeoutput.free; + exeoutput:=nil; + end; + if assigned(exemap) then + begin + exemap.free; + exemap:=nil; + end; + inherited destroy; + end; + + + procedure TInternalLinker.AddImportSymbol(const libname,symname,symmangledname:TCmdStr;OrdNr: longint;isvar:boolean); + var + ImportLibrary : TImportLibrary; + ImportSymbol : TFPHashObject; + begin + ImportLibrary:=TImportLibrary(ImportLibraryList.Find(libname)); + if not assigned(ImportLibrary) then + ImportLibrary:=TImportLibrary.Create(ImportLibraryList,libname); + ImportSymbol:=TFPHashObject(ImportLibrary.ImportSymbolList.Find(symname)); + if not assigned(ImportSymbol) then + ImportSymbol:=TImportSymbol.Create(ImportLibrary.ImportSymbolList,symname,symmangledname,OrdNr,isvar); + end; + + + procedure TInternalLinker.Load_ReadObject(const para:TCmdStr); + var + objdata : TObjData; + objinput : TObjinput; + objreader : TObjectReader; + fn : TCmdStr; + begin + fn:=FindObjectFile(para,'',false); + Comment(V_Tried,'Reading object '+fn); + objinput:=CObjInput.Create; + objdata:=objinput.newObjData(para); + objreader:=TObjectreader.create; + if objreader.openfile(fn) then + begin + if objinput.ReadObjData(objreader,objdata) then + exeoutput.addobjdata(objdata); + end; + { release input object } + objinput.free; + objreader.free; + end; + + + procedure TInternalLinker.Load_ReadStaticLibrary(const para:TCmdStr); + var + objreader : TObjectReader; + begin +{ TODO: Cleanup ignoring of FPC generated libimp*.a files} + { Don't load import libraries } + if copy(ExtractFileName(para),1,6)='libimp' then + exit; + Comment(V_Tried,'Opening library '+para); + objreader:=TArObjectreader.create(para); + TStaticLibrary.Create(StaticLibraryList,para,objreader,CObjInput); + end; + + + procedure TInternalLinker.ParseScript_Handle; + var + s, para, keyword : String; + hp : TCmdStrListItem; + i : longint; + begin + hp:=TCmdStrListItem(linkscript.first); + i:=0; + while assigned(hp) do + begin + inc(i); + s:=hp.str; + if (s='') or (s[1]='#') then + continue; + keyword:=Upper(GetToken(s,' ')); + para:=GetToken(s,' '); + if Trim(s)<>'' then + Comment(V_Warning,'Unknown part "'+s+'" in "'+hp.str+'" internal linker script'); + if (keyword<>'SYMBOL') and + (keyword<>'SYMBOLS') and + (keyword<>'STABS') and + (keyword<>'PROVIDE') and + (keyword<>'ZEROS') and + (keyword<>'BYTE') and + (keyword<>'WORD') and + (keyword<>'LONG') and + (keyword<>'QUAD') and + (keyword<>'ENTRYNAME') and + (keyword<>'ISSHAREDLIBRARY') and + (keyword<>'IMAGEBASE') and + (keyword<>'READOBJECT') and + (keyword<>'READSTATICLIBRARY') and + (keyword<>'EXESECTION') and + (keyword<>'ENDEXESECTION') and + (keyword<>'OBJSECTION') and + (keyword<>'HEADER') + then + Comment(V_Warning,'Unknown keyword "'+keyword+'" in "'+hp.str + +'" internal linker script'); + hp:=TCmdStrListItem(hp.next); + end; + ScriptCount:=i; + if ScriptCount>0 then + begin + GetMem(IsHandled,sizeof(boolean)*ScriptCount); + Fillchar(IsHandled^,sizeof(boolean)*ScriptCount,#0); + end; + end; + + procedure TInternalLinker.ParseScript_PostCheck; + var + hp : TCmdStrListItem; + i : longint; + begin + hp:=TCmdStrListItem(linkscript.first); + i:=0; + while assigned(hp) do + begin + inc(i); + if not IsHandled^[i] then + begin + Comment(V_Warning,'"'+hp.str+ + '" internal linker script not handled'); + end; + hp:=TCmdStrListItem(hp.next); + end; + end; + + function TInternalLinker.ParsePara(const para : string) : string; + var + res : string; + begin + res:=trim(para); + { Remove enclosing braces } + if (length(res)>0) and (res[1]='(') and + (res[length(res)]=')') then + res:=trim(copy(res,2,length(res)-2)); + result:=res; + end; + + procedure TInternalLinker.ParseScript_Load; + var + s, + para, + keyword : String; + hp : TCmdStrListItem; + i : longint; + handled : boolean; + begin + exeoutput.Load_Start; + hp:=TCmdStrListItem(linkscript.first); + i:=0; + while assigned(hp) do + begin + inc(i); + s:=hp.str; + if (s='') or (s[1]='#') then + begin + IsHandled^[i]:=true; + continue; + end; + handled:=true; + keyword:=Upper(GetToken(s,' ')); + para:=ParsePara(GetToken(s,' ')); + if keyword='SYMBOL' then + ExeOutput.Load_Symbol(para) + else if keyword='PROVIDE' then + ExeOutput.Load_ProvideSymbol(para) + else if keyword='ENTRYNAME' then + ExeOutput.Load_EntryName(para) + else if keyword='ISSHAREDLIBRARY' then + ExeOutput.Load_IsSharedLibrary + else if keyword='IMAGEBASE' then + ExeOutput.Load_ImageBase(para) + else if keyword='READOBJECT' then + Load_ReadObject(para) + else if keyword='STABS' then + UseStabs:=true + else if keyword='READSTATICLIBRARY' then + Load_ReadStaticLibrary(para) + else + handled:=false; + if handled then + IsHandled^[i]:=true; + hp:=TCmdStrListItem(hp.next); + end; + end; + + + procedure TInternalLinker.ParseScript_Order; + var + s, + para, + keyword : String; + hp : TCmdStrListItem; + i : longint; + handled : boolean; + begin + exeoutput.Order_Start; + hp:=TCmdStrListItem(linkscript.first); + i:=0; + while assigned(hp) do + begin + inc(i); + s:=hp.str; + if (s='') or (s[1]='#') then + continue; + handled:=true; + keyword:=Upper(GetToken(s,' ')); + para:=ParsePara(GetToken(s,' ')); + + if keyword='EXESECTION' then + ExeOutput.Order_ExeSection(para) + else if keyword='ENDEXESECTION' then + ExeOutput.Order_EndExeSection + else if keyword='OBJSECTION' then + ExeOutput.Order_ObjSection(para) + else if keyword='ZEROS' then + ExeOutput.Order_Zeros(para) + else if keyword='BYTE' then + ExeOutput.Order_Values(1,para) + else if keyword='WORD' then + ExeOutput.Order_Values(2,para) + else if keyword='LONG' then + ExeOutput.Order_Values(4,para) + else if keyword='QUAD' then + ExeOutput.Order_Values(8,para) + else if keyword='SYMBOL' then + ExeOutput.Order_Symbol(para) + else if keyword='PROVIDE' then + ExeOutput.Order_ProvideSymbol(para) + else + handled:=false; + if handled then + IsHandled^[i]:=true; + hp:=TCmdStrListItem(hp.next); + end; + exeoutput.Order_End; + end; + + + procedure TInternalLinker.ParseScript_MemPos; + var + s, + para, + keyword : String; + hp : TCmdStrListItem; + i : longint; + handled : boolean; + begin + exeoutput.MemPos_Start; + hp:=TCmdStrListItem(linkscript.first); + i:=0; + while assigned(hp) do + begin + inc(i); + s:=hp.str; + if (s='') or (s[1]='#') then + continue; + handled:=true; + keyword:=Upper(GetToken(s,' ')); + para:=ParsePara(GetToken(s,' ')); + if keyword='EXESECTION' then + ExeOutput.MemPos_ExeSection(para) + else if keyword='ENDEXESECTION' then + ExeOutput.MemPos_EndExeSection + else if keyword='HEADER' then + ExeOutput.MemPos_Header + else + handled:=false; + if handled then + IsHandled^[i]:=true; + hp:=TCmdStrListItem(hp.next); + end; + end; + + + procedure TInternalLinker.ParseScript_DataPos; + var + s, + para, + keyword : String; + hp : TCmdStrListItem; + i : longint; + handled : boolean; + begin + exeoutput.DataPos_Start; + hp:=TCmdStrListItem(linkscript.first); + i:=0; + while assigned(hp) do + begin + inc(i); + s:=hp.str; + if (s='') or (s[1]='#') then + continue; + handled:=true; + keyword:=Upper(GetToken(s,' ')); + para:=ParsePara(GetToken(s,' ')); + if keyword='EXESECTION' then + ExeOutput.DataPos_ExeSection(para) + else if keyword='ENDEXESECTION' then + ExeOutput.DataPos_EndExeSection + else if keyword='HEADER' then + ExeOutput.DataPos_Header + else if keyword='SYMBOLS' then + ExeOutput.DataPos_Symbols + else + handled:=false; + if handled then + IsHandled^[i]:=true; + hp:=TCmdStrListItem(hp.next); + end; + end; + + + procedure TInternalLinker.PrintLinkerScript; + var + hp : TCmdStrListItem; + begin + if not assigned(exemap) then + exit; + exemap.Add('Used linker script'); + exemap.Add(''); + hp:=TCmdStrListItem(linkscript.first); + while assigned(hp) do + begin + exemap.Add(hp.str); + hp:=TCmdStrListItem(hp.next); + end; + end; + + + function TInternalLinker.RunLinkScript(const outputname:TCmdStr):boolean; + label + myexit; + var + bsssize : aword; + bsssec : TExeSection; + dbgname : TCmdStr; + begin + result:=false; + + Message1(exec_i_linking,outputname); + FlushOutput; + +{ TODO: Load custom linker script} + DefaultLinkScript; + + exeoutput:=CExeOutput.Create; + + if (cs_link_map in current_settings.globalswitches) then + exemap:=texemap.create(current_module.mapfilename^); + + PrintLinkerScript; + + { Check that syntax is OK } + ParseScript_Handle; + { Load .o files and resolve symbols } + ParseScript_Load; + exeoutput.ResolveSymbols(StaticLibraryList); + { Generate symbols and code to do the importing } + exeoutput.GenerateLibraryImports(ImportLibraryList); + { Fill external symbols data } + exeoutput.FixupSymbols; + if ErrorCount>0 then + goto myexit; + + { parse linker options specific for output format } + exeoutput.ParseScript (linkscript); + + { Create .exe sections and add .o sections } + ParseScript_Order; + exeoutput.RemoveUnreferencedSections; + { if UseStabs then, this would remove + STABS for empty linker scripts } + exeoutput.MergeStabs; + exeoutput.RemoveEmptySections; + if ErrorCount>0 then + goto myexit; + + { Calc positions in mem } + ParseScript_MemPos; + exeoutput.FixupRelocations; + exeoutput.PrintMemoryMap; + if ErrorCount>0 then + goto myexit; + + if cs_link_separate_dbg_file in current_settings.globalswitches then + begin + { create debuginfo, which is an executable without data on disk } + dbgname:=ChangeFileExt(outputname,'.dbg'); + exeoutput.ExeWriteMode:=ewm_dbgonly; + ParseScript_DataPos; + exeoutput.WriteExeFile(dbgname); + { create executable with link to just created debuginfo file } + exeoutput.ExeWriteMode:=ewm_exeonly; + exeoutput.RemoveDebugInfo; + exeoutput.GenerateDebugLink(ExtractFileName(dbgname),GetFileCRC(dbgname)); + ParseScript_MemPos; + ParseScript_DataPos; + exeoutput.WriteExeFile(outputname); + end + else + begin + exeoutput.ExeWriteMode:=ewm_exefull; + ParseScript_DataPos; + exeoutput.WriteExeFile(outputname); + end; + + { Post check that everything was handled } + ParseScript_PostCheck; + +{ TODO: fixed section names} + status.codesize:=exeoutput.findexesection('.text').size; + status.datasize:=exeoutput.findexesection('.data').size; + bsssec:=exeoutput.findexesection('.bss'); + if assigned(bsssec) then + bsssize:=bsssec.size + else + bsssize:=0; + + { Executable info } + Message1(execinfo_x_codesize,tostr(status.codesize)); + Message1(execinfo_x_initdatasize,tostr(status.datasize)); + Message1(execinfo_x_uninitdatasize,tostr(bsssize)); + Message1(execinfo_x_stackreserve,tostr(stacksize)); + + myexit: + { close map } + if assigned(exemap) then + begin + exemap.free; + exemap:=nil; + end; + + { close exe } + exeoutput.free; + exeoutput:=nil; + + result:=true; + end; + + + function TInternalLinker.MakeExecutable:boolean; + begin + IsSharedLibrary:=false; + result:=RunLinkScript(current_module.exefilename^); + end; + + + function TInternalLinker.MakeSharedLibrary:boolean; + begin + IsSharedLibrary:=true; + result:=RunLinkScript(current_module.sharedlibfilename^); + end; + + +{***************************************************************************** + Init/Done +*****************************************************************************} + + procedure InitLinker; + var + lk : TlinkerClass; + begin + if (cs_link_extern in current_settings.globalswitches) and + assigned(target_info.linkextern) then + begin + lk:=TlinkerClass(target_info.linkextern); + linker:=lk.Create; + end + else + if assigned(target_info.link) then + begin + lk:=TLinkerClass(target_info.link); + linker:=lk.Create; + end + else + linker:=Tlinker.Create; + end; + + + procedure DoneLinker; + begin + if assigned(linker) then + Linker.Free; + end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + + const + ar_gnu_ar_info : tarinfo = + ( + id : ar_gnu_ar; + arcmd : 'ar qS $LIB $FILES'; + arfinishcmd : 'ar s $LIB' + ); + + ar_gnu_ar_scripted_info : tarinfo = + ( + id : ar_gnu_ar_scripted; + arcmd : 'ar -M < $SCRIPT'; + arfinishcmd : '' + ); + + ar_gnu_gar_info : tarinfo = + ( id : ar_gnu_gar; + arcmd : 'gar qS $LIB $FILES'; + arfinishcmd : 'gar s $LIB' + ); + + +initialization + RegisterAr(ar_gnu_ar_info); + RegisterAr(ar_gnu_ar_scripted_info); + RegisterAr(ar_gnu_gar_info); +end. diff --git a/closures/compiler/m68k/aasmcpu.pas b/closures/compiler/m68k/aasmcpu.pas new file mode 100644 index 0000000000..f2a5e837bc --- /dev/null +++ b/closures/compiler/m68k/aasmcpu.pas @@ -0,0 +1,579 @@ +{ + Copyright (c) 1998-2001 by Florian Klaempfl and Pierre Muller + + m68k family assembler instructions + + 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,aasmtai,aasmdata,aasmsym, + aasmbase,globals,verbose,symtype, + cpubase,cpuinfo,cgbase,cgutils; + + +const + { "mov reg,reg" source operand number } + O_MOV_SOURCE = 0; + { "mov reg,reg" source operand number } + O_MOV_DEST = 1; +type + + taicpu = class(tai_cpu_abstract_sym) + opsize : topsize; + constructor op_none(op : tasmop); + constructor op_none(op : tasmop;_size : topsize); + + constructor op_reg(op : tasmop;_size : topsize;_op1 : tregister); + constructor op_const(op : tasmop;_size : topsize;_op1 : longint); + constructor op_ref(op : tasmop;_size : topsize;_op1 : treference); + + constructor op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister); + constructor op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;_op2 : treference); + constructor op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: longint); + + constructor op_const_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister); + constructor op_const_const(op : tasmop;_size : topsize;_op1,_op2 : longint); + constructor op_const_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : treference); + + constructor op_ref_reg(op : tasmop;_size : topsize;_op1 : treference;_op2 : tregister); + { this is only allowed if _op1 is an int value (_op1^.isintvalue=true) } + constructor op_ref_ref(op : tasmop;_size : topsize;_op1,_op2 : treference); + + constructor op_reg_reg_reg(op : tasmop;_size : topsize;_op1,_op2,_op3 : tregister); + constructor op_const_reg_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : tregister); + constructor op_const_ref_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : treference;_op3 : tregister); + constructor op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister; _op3 : treference); + constructor op_const_reg_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : treference); + + constructor op_reg_regset(op: tasmop; _size : topsize; _op1: tregister;const _op2: tcpuregisterset); + constructor op_regset_reg(op: tasmop; _size : topsize;const _op1: tcpuregisterset; _op2: tregister); + + constructor op_ref_regset(op: tasmop; _size : topsize; _op1: treference;const _op2: tcpuregisterset); + constructor op_regset_ref(op: tasmop; _size : topsize;const _op1: tcpuregisterset; _op2: treference); + + { this is for Jmp instructions } + constructor op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol); + + constructor op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol); + { for DBxx opcodes } + constructor op_reg_sym(op: tasmop; _size : topsize; _op1: tregister; _op2 :tasmsymbol); + constructor op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister); + + constructor op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint); + constructor op_sym_ofs_ref(op : tasmop;_size : topsize;_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; + + private + procedure loadregset(opidx:longint;const s:tcpuregisterset); + procedure init(_size : topsize); { this need to be called by all constructor } + end; + + + tai_align = class(tai_align_abstract) + { nothing to add } + end; + + procedure InitAsm; + procedure DoneAsm; + + function spilling_create_load(const ref:treference;r:tregister):Taicpu; + function spilling_create_store(r:tregister; const ref:treference):Taicpu; + + implementation + + uses + globtype; + + +{ TODO: FIX ME!! useful for debug, remove it, same table as in ag68kgas } + const + gas_op2str:op2strtable= + { warning: CPU32 opcodes are not fully compatible with the MC68020. } + { 68000 only opcodes } + ( '', + 'abcd','add','adda','addi','addq','addx','and','andi', + 'asl','asr','bcc','bcs','beq','bge','bgt','bhi', + 'ble','bls','blt','bmi','bne','bpl','bvc','bvs', + 'bchg','bclr','bra','bset','bsr','btst','chk', + 'clr','cmp','cmpa','cmpi','cmpm','dbcc','dbcs','dbeq','dbge', + 'dbgt','dbhi','dble','dbls','dblt','dbmi','dbne','dbra', + 'dbpl','dbt','dbvc','dbvs','dbf','divs','divu', + 'eor','eori','exg','illegal','ext','jmp','jsr', + 'lea','link','lsl','lsr','move','movea','movei','moveq', + 'movem','movep','muls','mulu','nbcd','neg','negx', + 'nop','not','or','ori','pea','rol','ror','roxl', + 'roxr','rtr','rts','sbcd','scc','scs','seq','sge', + 'sgt','shi','sle','sls','slt','smi','sne', + 'spl','st','svc','svs','sf','sub','suba','subi','subq', + 'subx','swap','tas','trap','trapv','tst','unlk', + 'rte','reset','stop', + { mc68010 instructions } + 'bkpt','movec','moves','rtd', + { mc68020 instructions } + 'bfchg','bfclr','bfexts','bfextu','bfffo', + 'bfins','bfset','bftst','callm','cas','cas2', + 'chk2','cmp2','divsl','divul','extb','pack','rtm', + 'trapcc','tracs','trapeq','trapf','trapge','trapgt', + 'traphi','traple','trapls','traplt','trapmi','trapne', + 'trappl','trapt','trapvc','trapvs','unpk', + { fpu processor instructions - directly supported only. } + { ieee aware and misc. condition codes not supported } + 'fabs','fadd', + 'fbeq','fbne','fbngt','fbgt','fbge','fbnge', + 'fblt','fbnlt','fble','fbgl','fbngl','fbgle','fbngle', + 'fdbeq','fdbne','fdbgt','fdbngt','fdbge','fdbnge', + 'fdblt','fdbnlt','fdble','fdbgl','fdbngl','fdbgle','fdbngle', + 'fseq','fsne','fsgt','fsngt','fsge','fsnge', + 'fslt','fsnlt','fsle','fsgl','fsngl','fsgle','fsngle', + 'fcmp','fdiv','fmove','fmovem', + 'fmul','fneg','fnop','fsqrt','fsub','fsgldiv', + 'fsflmul','ftst', + 'ftrapeq','ftrapne','ftrapgt','ftrapngt','ftrapge','ftrapnge', + 'ftraplt','ftrapnlt','ftraple','ftrapgl','ftrapngl','ftrapgle','ftrapngle', + { protected instructions } + 'cprestore','cpsave', + { fpu unit protected instructions } + { and 68030/68851 common mmu instructions } + { (this may include 68040 mmu instructions) } + 'frestore','fsave','pflush','pflusha','pload','pmove','ptest', + { useful for assembly language output } + 'label','db','s','b','fb'); + + +{***************************************************************************** + Taicpu Constructors +*****************************************************************************} + + + + 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_D0 to RS_D7 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; + for i:=RS_A0 to RS_SP do + begin + if assigned(add_reg_instruction_hook) and (i in regset^) then + add_reg_instruction_hook(self,newreg(R_ADDRESSREGISTER,i,R_SUBWHOLE)); + end; + end; + end; + + + procedure taicpu.init(_size : topsize); + begin + typ:=ait_instruction; + is_jmp:=false; + opsize:=_size; + ops:=0; + end; + + + constructor taicpu.op_none(op : tasmop); + begin + inherited create(op); + init(S_NO); + end; + + + constructor taicpu.op_none(op : tasmop;_size : topsize); + begin + inherited create(op); + init(_size); + end; + + + constructor taicpu.op_reg(op : tasmop;_size : topsize;_op1 : tregister); + begin + inherited create(op); + init(_size); + ops:=1; + loadreg(0,_op1); + end; + + + constructor taicpu.op_const(op : tasmop;_size : topsize;_op1 : longint); + begin + inherited create(op); + init(_size); + ops:=1; + loadconst(0,aword(_op1)); + end; + + + constructor taicpu.op_ref(op : tasmop;_size : topsize;_op1 : treference); + begin + inherited create(op); + init(_size); + ops:=1; + loadref(0,_op1); + end; + + + constructor taicpu.op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister); + begin + inherited create(op); + init(_size); + ops:=2; + loadreg(0,_op1); + loadreg(1,_op2); + end; + + + constructor taicpu.op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: longint); + begin + inherited create(op); + init(_size); + ops:=2; + loadreg(0,_op1); + loadconst(1,aword(_op2)); + end; + + + constructor taicpu.op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;_op2 : treference); + begin + inherited create(op); + init(_size); + ops:=2; + loadreg(0,_op1); + loadref(1,_op2); + end; + + + constructor taicpu.op_const_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister); + begin + inherited create(op); + init(_size); + ops:=2; + loadconst(0,aword(_op1)); + loadreg(1,_op2); + end; + + + constructor taicpu.op_const_const(op : tasmop;_size : topsize;_op1,_op2 : longint); + begin + inherited create(op); + init(_size); + ops:=2; + loadconst(0,aword(_op1)); + loadconst(1,aword(_op2)); + end; + + + constructor taicpu.op_const_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : treference); + begin + inherited create(op); + init(_size); + ops:=2; + loadconst(0,aword(_op1)); + loadref(1,_op2); + end; + + + constructor taicpu.op_ref_reg(op : tasmop;_size : topsize;_op1 : treference;_op2 : tregister); + begin + inherited create(op); + init(_size); + ops:=2; + loadref(0,_op1); + loadreg(1,_op2); + end; + + + constructor taicpu.op_ref_ref(op : tasmop;_size : topsize;_op1,_op2 : treference); + begin + inherited create(op); + init(_size); + ops:=2; + loadref(0,_op1); + loadref(1,_op2); + end; + + + constructor taicpu.op_reg_reg_reg(op : tasmop;_size : topsize;_op1,_op2,_op3 : tregister); + begin + inherited create(op); + init(_size); + ops:=3; + loadreg(0,_op1); + loadreg(1,_op2); + loadreg(2,_op3); + end; + + constructor taicpu.op_const_reg_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : tregister); + begin + inherited create(op); + init(_size); + ops:=3; + loadconst(0,aword(_op1)); + loadreg(1,_op2); + loadreg(2,_op3); + end; + + constructor taicpu.op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister;_op3 : treference); + begin + inherited create(op); + init(_size); + ops:=3; + loadreg(0,_op1); + loadreg(1,_op2); + loadref(2,_op3); + end; + + + constructor taicpu.op_const_ref_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : treference;_op3 : tregister); + begin + inherited create(op); + init(_size); + ops:=3; + loadconst(0,aword(_op1)); + loadref(1,_op2); + loadreg(2,_op3); + end; + + + constructor taicpu.op_const_reg_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : treference); + begin + inherited create(op); + init(_size); + ops:=3; + loadconst(0,aword(_op1)); + loadreg(1,_op2); + loadref(2,_op3); + end; + + + constructor taicpu.op_ref_regset(op: tasmop; _size : topsize; _op1: treference;const _op2: tcpuregisterset); + Begin + inherited create(op); + init(_size); + ops:=2; + loadref(0,_op1); + loadregset(1,_op2); + end; + + constructor taicpu.op_regset_ref(op: tasmop; _size : topsize;const _op1: tcpuregisterset; _op2: treference); + Begin + inherited create(op); + init(_size); + ops:=2; + loadregset(0,_op1); + loadref(1,_op2); + End; + + + + constructor taicpu.op_reg_regset(op: tasmop; _size : topsize; _op1: tregister;const _op2: tcpuregisterset); + Begin + inherited create(op); + init(_size); + ops:=2; + loadreg(0,_op1); + loadregset(1,_op2); + end; + + + constructor taicpu.op_regset_reg(op: tasmop; _size : topsize;const _op1: tcpuregisterset; _op2: tregister); + Begin + inherited create(op); + init(_size); + ops:=2; + loadregset(0,_op1); + loadreg(1,_op2); + End; + + + constructor taicpu.op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol); + begin + inherited create(op); + init(_size); + ops:=1; + loadsymbol(0,_op1,0); + end; + + + constructor taicpu.op_reg_sym(op: tasmop; _size : topsize; _op1: tregister; _op2 :tasmsymbol); + begin + inherited create(op); + init(_size); + ops:=2; + loadreg(0,_op1); + loadsymbol(1,_op2,0); + end; + + + constructor taicpu.op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference); + begin + inherited create(op); + init(_size); + ops:=2; + loadsymbol(0,_op1,_op1ofs); + loadref(1,_op2); + end; + + + constructor taicpu.op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint); + begin + inherited create(op); + init(_size); + ops:=1; + loadsymbol(0,_op1,_op1ofs); + end; + + constructor taicpu.op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister); + begin + inherited create(op); + init(_size); + ops:=2; + if ((op >= A_DBCC) and (op <= A_DBF)) + or ((op >= A_FDBEQ) and (op <= A_FDBNGLE)) then + begin + loadreg(0,_op2); + loadsymbol(1,_op1,_op1ofs); + end + else + begin + loadsymbol(0,_op1,_op1ofs); + loadreg(1,_op2); + end; + end; + + + constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol); + begin + inherited create(op); + init(_size); + condition:=cond; + ops:=1; + loadsymbol(0,_op1,0); + end; + + + function taicpu.is_same_reg_move(regtype: Tregistertype):boolean; + begin + result:=(((opcode=A_MOVE) or (opcode=A_EXG)) and + (regtype = R_INTREGISTER) and + (ops=2) and + (oper[0]^.typ=top_reg) and + (oper[1]^.typ=top_reg) and + (oper[0]^.reg=oper[1]^.reg) + ) or + (((opcode=A_MOVE) or (opcode=A_EXG) or (opcode=A_MOVEA)) and + (regtype = R_ADDRESSREGISTER) and + (ops=2) and + (oper[0]^.typ=top_reg) and + (oper[1]^.typ=top_reg) and + (oper[0]^.reg=oper[1]^.reg) + ) or + ((opcode=A_FMOVE) and + (regtype = R_FPUREGISTER) and + (ops=2) and + (oper[0]^.typ=top_reg) and + (oper[1]^.typ=top_reg) and + (oper[0]^.reg=oper[1]^.reg) + ); + end; + + + function taicpu.spilling_get_operation_type(opnr: longint): topertype; + begin + case opcode of + A_MOVE, A_MOVEQ, A_ADD, A_ADDQ, A_ADDX, A_SUB, A_SUBQ, + A_AND, A_LSR, A_LSL, A_ASR, A_ASL, A_EOR, A_EORI, A_OR: + if opnr=1 then begin + result:=operand_write; + end else begin + result:=operand_read; + end; + A_TST,A_CMP,A_CMPI: + result:=operand_read; + A_CLR, A_SXX: + result:=operand_write; + A_NEG, A_EXT, A_EXTB, A_NOT: + result:=operand_readwrite; + else begin +{ TODO: FIX ME!!! remove ugly debug code ... } + writeln('M68K: unknown opcode when spilling: ',gas_op2str[opcode]); + internalerror(200404091); + end; + end; + end; + + + function spilling_create_load(const ref:treference;r:tregister):Taicpu; + begin + case getregtype(r) of + R_INTREGISTER : + result:=taicpu.op_ref_reg(A_MOVE,S_L,ref,r); + R_ADDRESSREGISTER : + result:=taicpu.op_ref_reg(A_MOVE,S_L,ref,r); + R_FPUREGISTER : + // no need to handle sizes here + result:=taicpu.op_ref_reg(A_FMOVE,S_FS,ref,r); + else + internalerror(200602011); + end; + end; + + + function spilling_create_store(r:tregister; const ref:treference):Taicpu; + begin + case getregtype(r) of + R_INTREGISTER : + result:=taicpu.op_reg_ref(A_MOVE,S_L,r,ref); + R_ADDRESSREGISTER : + result:=taicpu.op_reg_ref(A_MOVE,S_L,r,ref); + R_FPUREGISTER : + // no need to handle sizes here + result:=taicpu.op_reg_ref(A_FMOVE,S_FS,r,ref); + else + internalerror(200602012); + end; + end; + + + procedure InitAsm; + begin + end; + + + procedure DoneAsm; + begin + end; + + +end. diff --git a/closures/compiler/m68k/ag68kgas.pas b/closures/compiler/m68k/ag68kgas.pas new file mode 100644 index 0000000000..e2e5bc28ba --- /dev/null +++ b/closures/compiler/m68k/ag68kgas.pas @@ -0,0 +1,385 @@ +{ + Copyright (c) 1998-2006 by the Free Pascal development team + + This unit implements an asmoutput class for m68k GAS syntax + + 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 ag68kgas; + +{$i fpcdefs.inc} + +interface + + uses + cclasses,cpubase, + globals, + aasmbase,aasmtai,aasmdata,aasmcpu,assemble,aggas; + + type + Tm68kGNUAssembler=class(TGNUassembler) + constructor create(smart: boolean); override; + end; + + type + Tm68kInstrWriter=class(TCPUInstrWriter) + procedure WriteInstruction(hp: tai);override; + end; + + const + gas_op2str:op2strtable= + { warning: CPU32 opcodes are not fully compatible with the MC68020. } + { 68000 only opcodes } + ( '', + 'abcd','add','adda','addi','addq','addx','and','andi', + 'asl','asr','bcc','bcs','beq','bge','bgt','bhi', + 'ble','bls','blt','bmi','bne','bpl','bvc','bvs', + 'bchg','bclr','bra','bset','bsr','btst','chk', + 'clr','cmp','cmpa','cmpi','cmpm','dbcc','dbcs','dbeq','dbge', + 'dbgt','dbhi','dble','dbls','dblt','dbmi','dbne','dbra', + 'dbpl','dbt','dbvc','dbvs','dbf','divs','divu', + 'eor','eori','exg','illegal','ext','jmp','jsr', + 'lea','link','lsl','lsr','move','movea','movei','moveq', + 'movem','movep','muls','mulu','nbcd','neg','negx', + 'nop','not','or','ori','pea','rol','ror','roxl', + 'roxr','rtr','rts','sbcd','scc','scs','seq','sge', + 'sgt','shi','sle','sls','slt','smi','sne', + 'spl','st','svc','svs','sf','sub','suba','subi','subq', + 'subx','swap','tas','trap','trapv','tst','unlk', + 'rte','reset','stop', + { mc68010 instructions } + 'bkpt','movec','moves','rtd', + { mc68020 instructions } + 'bfchg','bfclr','bfexts','bfextu','bfffo', + 'bfins','bfset','bftst','callm','cas','cas2', + 'chk2','cmp2','divsl','divul','extb','pack','rtm', + 'trapcc','tracs','trapeq','trapf','trapge','trapgt', + 'traphi','traple','trapls','traplt','trapmi','trapne', + 'trappl','trapt','trapvc','trapvs','unpk', + { fpu processor instructions - directly supported only. } + { ieee aware and misc. condition codes not supported } + 'fabs','fadd', + 'fbeq','fbne','fbngt','fbgt','fbge','fbnge', + 'fblt','fbnlt','fble','fbgl','fbngl','fbgle','fbngle', + 'fdbeq','fdbne','fdbgt','fdbngt','fdbge','fdbnge', + 'fdblt','fdbnlt','fdble','fdbgl','fdbngl','fdbgle','fdbngle', + 'fseq','fsne','fsgt','fsngt','fsge','fsnge', + 'fslt','fsnlt','fsle','fsgl','fsngl','fsgle','fsngle', + 'fcmp','fdiv','fmove','fmovem', + 'fmul','fneg','fnop','fsqrt','fsub','fsgldiv', + 'fsflmul','ftst', + 'ftrapeq','ftrapne','ftrapgt','ftrapngt','ftrapge','ftrapnge', + 'ftraplt','ftrapnlt','ftraple','ftrapgl','ftrapngl','ftrapgle','ftrapngle', + { protected instructions } + 'cprestore','cpsave', + { fpu unit protected instructions } + { and 68030/68851 common mmu instructions } + { (this may include 68040 mmu instructions) } + 'frestore','fsave','pflush','pflusha','pload','pmove','ptest', + { useful for assembly language output } + 'label','db','s','b','fb'); + + + gas_opsize2str : array[topsize] of string[2] = + ('','.b','.w','.l','.s','.d','.x','' + ); +{ + gas_reg2str : treg2strtable = + ('', '%d0','%d1','%d2','%d3','%d4','%d5','%d6','%d7', + '%a0','%a1','%a2','%a3','%a4','%a5','%a6','%sp', + '-(%sp)','(%sp)+', + '%ccr','%fp0','%fp1','%fp2','%fp3','%fp4','%fp5', + '%fp6','%fp7','%fpcr','%sr','%ssp','%dfc', + '%sfc','%vbr','%fpsr'); +} + + implementation + + uses + cutils,systems, + cgbase,cgutils, + verbose,itcpugas; + + + {****************************************************************************} + { GNU m68k Assembler writer } + {****************************************************************************} + + constructor Tm68kGNUAssembler.create(smart: boolean); + begin + inherited create(smart); + InstrWriter := Tm68kInstrWriter.create(self); + end; + + + function getreferencestring(var ref : treference) : string; + var + s,basestr,indexstr : string; + + begin + s:=''; + with ref do + begin + basestr:=gas_regname(base); + indexstr:=gas_regname(index); + if assigned(symbol) then + s:=s+symbol.name; + + if offset<0 then s:=s+tostr(offset) + else if (offset>0) then + begin + if (symbol=nil) then s:=tostr(offset) + else s:=s+'+'+tostr(offset); + end + else if (index=NR_NO) and (base=NR_NO) and not assigned(symbol) then + s:=s+'0'; + + if (index<>NR_NO) and (base=NR_NO) and (direction=dir_none) then + begin + if (scalefactor = 1) or (scalefactor = 0) then + s:=s+'(,'+indexstr+'.l)' + else + s:=s+'(,'+indexstr+'.l*'+tostr(scalefactor)+')' + end + else if (index=NR_NO) and (base<>NR_NO) and (direction=dir_inc) then + begin + if (scalefactor = 1) or (scalefactor = 0) then + s:=s+'('+basestr+')+' + else + InternalError(10002); + end + else if (index=NR_NO) and (base<>NR_NO) and (direction=dir_dec) then + begin + if (scalefactor = 1) or (scalefactor = 0) then + s:=s+'-('+basestr+')' + else + InternalError(10003); + end + else if (index=NR_NO) and (base<>NR_NO) and (direction=dir_none) then + begin + s:=s+'('+basestr+')' + end + else if (index<>NR_NO) and (base<>NR_NO) and (direction=dir_none) then + begin + if (scalefactor = 1) or (scalefactor = 0) then + s:=s+'('+basestr+','+indexstr+'.l)' + else + s:=s+'('+basestr+','+indexstr+'.l*'+tostr(scalefactor)+')'; + end; + end; + getreferencestring:=s; + end; + + + function getopstr(const o:toper) : string; + var + hs : string; + i : tsuperregister; + begin + case o.typ of + top_reg: begin + getopstr:=gas_regname(o.reg); +// writeln('top_reg:',getopstr,'!'); + end; + top_ref: + if o.ref^.refaddr=addr_full then + begin + if assigned(o.ref^.symbol) then + hs:=o.ref^.symbol.name + else + hs:='#'; + 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) + else + if not(assigned(o.ref^.symbol)) then + hs:=hs+'0'; + getopstr:=hs; + end + else + getopstr:=getreferencestring(o.ref^); + top_regset: + begin + hs:=''; + for i:=RS_D0 to RS_D7 do + begin + if i in o.regset^ then + hs:=hs+gas_regname(newreg(R_INTREGISTER,i,R_SUBWHOLE))+'/'; + end; + for i:=RS_A0 to RS_SP do + begin + if i in o.regset^ then + hs:=hs+gas_regname(newreg(R_INTREGISTER,i,R_SUBWHOLE))+'/'; + end; + delete(hs,length(hs),1); + getopstr := hs; + end; + top_const: + getopstr:='#'+tostr(longint(o.val)); + else internalerror(200405021); + end; + end; + + + function getopstr_jmp(const o:toper) : string; + var + hs : string; + begin + case o.typ of + top_reg: + getopstr_jmp:=gas_regname(o.reg); + top_ref: + if o.ref^.refaddr=addr_no then + getopstr_jmp:=getreferencestring(o.ref^) + else + begin + if assigned(o.ref^.symbol) then + hs:=o.ref^.symbol.name + else + hs:=''; + 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) + else + if not(assigned(o.ref^.symbol)) then + hs:=hs+'0'; + getopstr_jmp:=hs; + end; + top_const: + getopstr_jmp:=tostr(o.val); + else internalerror(200405022); + end; + end; + +{**************************************************************************** + TM68kASMOUTPUT + ****************************************************************************} + + { returns the opcode string } + function getopcodestring(hp : tai) : string; + var + op : tasmop; + s : string; + begin + op:=taicpu(hp).opcode; + { old versions of GAS don't like PEA.L and LEA.L } + if (op in [ + A_LEA,A_PEA,A_ABCD,A_BCHG,A_BCLR,A_BSET,A_BTST, + A_EXG,A_NBCD,A_SBCD,A_SWAP,A_TAS,A_SCC,A_SCS, + A_SEQ,A_SGE,A_SGT,A_SHI,A_SLE,A_SLS,A_SLT,A_SMI, + A_SNE,A_SPL,A_ST,A_SVC,A_SVS,A_SF]) then + s:=gas_op2str[op] + else + if op = A_SXX then + s:=gas_op2str[op]+cond2str[taicpu(hp).condition] + else + { size of DBRA is always WORD, doesn't need opsize (KB) } + if op = A_DBRA then + s:=gas_op2str[op]+cond2str[taicpu(hp).condition] + else + if op in [a_dbxx,a_bxx,a_fbxx] then + s:=gas_op2str[op]+cond2str[taicpu(hp).condition]+gas_opsize2str[taicpu(hp).opsize] + else + s:=gas_op2str[op]+gas_opsize2str[taicpu(hp).opsize]; + if op = A_FMOVE then + begin +{$ifdef DEBUG_CHARLIE} + writeln('fmove! opsize:',dword(taicpu(hp).opsize)); +{$endif DEBUG_CHARLIE} + end; + getopcodestring:=s; + end; + + + procedure Tm68kInstrWriter.WriteInstruction(hp: tai); + var + op : tasmop; + s : string; + sep : char; + calljmp : boolean; + i : integer; + begin + if hp.typ <> ait_instruction then exit; + op:=taicpu(hp).opcode; + calljmp:=is_calljmp(op); + { call maybe not translated to call } + s:=#9+getopcodestring(hp); + { process operands } + if taicpu(hp).ops<>0 then + begin + { call and jmp need an extra handling } + { this code is only called if jmp isn't a labeled instruction } + { quick hack to overcome a problem with manglednames=255 chars } + if calljmp then + begin + owner.AsmWrite(s+#9); + s:=getopstr_jmp(taicpu(hp).oper[0]^); + { dbcc dx,<sym> has two operands! (KB) } + if (taicpu(hp).ops>1) then + s:=s+','+getopstr_jmp(taicpu(hp).oper[1]^); + if (taicpu(hp).ops>2) then + internalerror(2006120501); + end + else + begin + for i:=0 to taicpu(hp).ops-1 do + begin + if i=0 then + sep:=#9 + else + if ((op = A_DIVSL) or + (op = A_DIVUL) or + (op = A_MULU) or + (op = A_MULS) or + (op = A_DIVS) or + (op = A_DIVU)) and (i=2) then + begin + sep:=':' + end else + sep:=','; + s:=s+sep+getopstr(taicpu(hp).oper[i]^) + end; + end; + end; + owner.AsmWriteLn(s); + end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + + const + as_m68k_as_info : tasminfo = + ( + id : as_gas; + idtxt : 'AS'; + asmbin : 'as'; + asmcmd : '-o $OBJ $ASM'; + supported_targets : [system_m68k_Amiga,system_m68k_Atari,system_m68k_Mac,system_m68k_linux,system_m68k_PalmOS,system_m68k_netbsd,system_m68k_openbsd,system_m68k_embedded]; + flags : [af_allowdirect,af_needar,af_smartlink_sections]; + labelprefix : '.L'; + comment : '# '; + ); + +initialization + RegisterAssembler(as_m68k_as_info,Tm68kGNUAssembler); +end. diff --git a/closures/compiler/m68k/aoptcpu.pas b/closures/compiler/m68k/aoptcpu.pas new file mode 100644 index 0000000000..cb656af36e --- /dev/null +++ b/closures/compiler/m68k/aoptcpu.pas @@ -0,0 +1,41 @@ +{ + Copyright (c) 1998-2004 by Jonas Maebe + + This unit calls the optimization procedures to optimize the assembler + code for sparc + + 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, aoptobj, aoptcpub, aopt; + + Type + TCpuAsmOptimizer = class(TAsmOptimizer) + End; + + Implementation + +begin + casmoptimizer:=TCpuAsmOptimizer; +end. diff --git a/closures/compiler/m68k/aoptcpub.pas b/closures/compiler/m68k/aoptcpub.pas new file mode 100644 index 0000000000..bf1ab48cb8 --- /dev/null +++ b/closures/compiler/m68k/aoptcpub.pas @@ -0,0 +1,120 @@ + { + Copyright (c) 1998-2004 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 sparc 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_JMP; + aopt_condjmp = A_Bxx; + +Implementation + +{ ************************************************************************* } +{ **************************** TCondRegs ********************************** } +{ ************************************************************************* } +Constructor TCondRegs.init; +Begin +End; + +Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl} +Begin +End; + +End. diff --git a/closures/compiler/m68k/aoptcpud.pas b/closures/compiler/m68k/aoptcpud.pas new file mode 100644 index 0000000000..cb8c5d319f --- /dev/null +++ b/closures/compiler/m68k/aoptcpud.pas @@ -0,0 +1,36 @@ +{ + Copyright (c) 1998-2004 by Jonas Maebe, member of the Free Pascal + Development Team + + 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. diff --git a/closures/compiler/m68k/cgcpu.pas b/closures/compiler/m68k/cgcpu.pas new file mode 100644 index 0000000000..a98ffce61b --- /dev/null +++ b/closures/compiler/m68k/cgcpu.pas @@ -0,0 +1,1751 @@ +{ + Copyright (c) 1998-2002 by the FPC team + + This unit implements the code generator for the 680x0 + + 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. + + **************************************************************************** +} +{DEFINE DEBUG_CHARLIE} + +{$IFNDEF DEBUG_CHARLIE} +{$WARNINGS OFF} +{$ENDIF} +unit cgcpu; + +{$i fpcdefs.inc} + + interface + + uses + cgbase,cgobj,globtype, + aasmbase,aasmtai,aasmdata,aasmcpu, + cpubase,cpuinfo, + parabase,cpupara, + node,symconst,symtype,symdef, + cgutils,cg64f32; + + type + tcg68k = class(tcg) + procedure init_register_allocators;override; + procedure done_register_allocators;override; + + procedure a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara);override; + procedure a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : tcgpara);override; + procedure a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara);override; + procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara);override; + + procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override; + procedure a_call_reg(list : TAsmList;reg : tregister);override; + + procedure a_load_const_reg(list : TAsmList;size : tcgsize;a : tcgint;register : tregister);override; + procedure a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference);override; + + procedure a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override; + procedure a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister);override; + procedure a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override; + procedure a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);override; + + procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override; + procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override; + procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override; + procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override; + + procedure a_loadmm_reg_reg(list: TAsmList;fromsize,tosize : tcgsize; reg1, reg2: tregister;shuffle : pmmshuffle); override; + procedure a_loadmm_ref_reg(list: TAsmList;fromsize,tosize : tcgsize; const ref: treference; reg: tregister;shuffle : pmmshuffle); override; + procedure a_loadmm_reg_ref(list: TAsmList;fromsize,tosize : tcgsize; reg: tregister; const ref: treference;shuffle : pmmshuffle); override; + procedure a_loadmm_reg_cgpara(list: TAsmList; size: tcgsize; reg: tregister;const locpara : TCGPara;shuffle : pmmshuffle); override; + + procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister); override; +// procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); override; + procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); override; + + procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; + l : tasmlabel);override; + procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override; + procedure a_jmp_always(list : TAsmList;l: tasmlabel); override; + procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); override; + procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister); override; + + procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);override; + { generates overflow checking code for a node } + procedure g_overflowcheck(list: TAsmList; const l:tlocation; def:tdef); override; + procedure g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;destreg:tregister);override; + + procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override; + procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override; + +// procedure g_restore_frame_pointer(list : TAsmList);override; +// procedure g_return_from_proc(list : TAsmList;parasize : tcgint);override; + procedure g_restore_registers(list:TAsmList);override; + procedure g_save_registers(list:TAsmList);override; + +// procedure g_save_all_registers(list : TAsmList);override; +// procedure g_restore_all_registers(list : TAsmList;const funcretparaloc:TCGPara);override; + + procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override; + + protected + function fixref(list: TAsmList; var ref: treference): boolean; + private + { # Sign or zero extend the register to a full 32-bit value. + The new value is left in the same register. + } + procedure sign_extend(list: TAsmList;_oldsize : tcgsize; reg: tregister); + procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel); + + end; + + tcg64f68k = class(tcg64f32) + procedure a_op64_reg_reg(list : TAsmList;op:TOpCG; size: tcgsize; regsrc,regdst : tregister64);override; + procedure a_op64_const_reg(list : TAsmList;op:TOpCG; size: tcgsize; value : int64;regdst : tregister64);override; + end; + + { This function returns true if the reference+offset is valid. + Otherwise extra code must be generated to solve the reference. + + On the m68k, this verifies that the reference is valid + (e.g : if index register is used, then the max displacement + is 256 bytes, if only base is used, then max displacement + is 32K + } + function isvalidrefoffset(const ref: treference): boolean; + + const + TCGSize2OpSize: Array[tcgsize] of topsize = + (S_NO,S_B,S_W,S_L,S_L,S_NO,S_B,S_W,S_L,S_L,S_NO, + S_FS,S_FD,S_FX,S_NO,S_NO, + S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO); + + procedure create_codegen; + + implementation + + uses + globals,verbose,systems,cutils, + symsym,defutil,paramgr,procinfo, + rgobj,tgobj,rgcpu,fmodule; + + + const + { opcode table lookup } + topcg2tasmop: Array[topcg] of tasmop = + ( + A_NONE, + A_MOVE, + A_ADD, + A_AND, + A_DIVU, + A_DIVS, + A_MULS, + A_MULU, + A_NEG, + A_NOT, + A_OR, + A_ASR, + A_LSL, + A_LSR, + A_SUB, + A_EOR, + A_NONE, + A_NONE + ); + + + TOpCmp2AsmCond: Array[topcmp] of TAsmCond = + ( + C_NONE, + C_EQ, + C_GT, + C_LT, + C_GE, + C_LE, + C_NE, + C_LS, + C_CS, + C_CC, + C_HI + ); + + + function isvalidrefoffset(const ref: treference): boolean; + begin + isvalidrefoffset := true; + if ref.index <> NR_NO then + begin + if ref.base <> NR_NO then + internalerror(20020814); + if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then + isvalidrefoffset := false + end + else + begin + if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then + isvalidrefoffset := false; + end; + end; + + +{****************************************************************************} +{ TCG68K } +{****************************************************************************} + + + function use_push(const cgpara:tcgpara):boolean; + begin + result:=(not paramanager.use_fixed_stack) and + assigned(cgpara.location) and + (cgpara.location^.loc=LOC_REFERENCE) and + (cgpara.location^.reference.index=NR_STACK_POINTER_REG); + end; + + + procedure tcg68k.init_register_allocators; + begin + inherited init_register_allocators; + rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE, + [RS_D0,RS_D1,RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7], + first_int_imreg,[]); + rg[R_ADDRESSREGISTER]:=trgcpu.create(R_ADDRESSREGISTER,R_SUBWHOLE, + [RS_A0,RS_A1,RS_A2,RS_A3,RS_A4,RS_A5,RS_A6], + first_addr_imreg,[]); + rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBNONE, + [RS_FP0,RS_FP1,RS_FP2,RS_FP3,RS_FP4,RS_FP5,RS_FP6,RS_FP7], + first_fpu_imreg,[]); + end; + + + procedure tcg68k.done_register_allocators; + begin + rg[R_INTREGISTER].free; + rg[R_FPUREGISTER].free; + rg[R_ADDRESSREGISTER].free; + inherited done_register_allocators; + end; + + + procedure tcg68k.a_load_reg_cgpara(list : TAsmList;size : tcgsize;r : tregister;const cgpara : tcgpara); + var + pushsize : tcgsize; + ref : treference; + begin +{$ifdef DEBUG_CHARLIE} +// writeln('a_load_reg');_cgpara +{$endif DEBUG_CHARLIE} + { it's probably necessary to port this from x86 later, or provide an m68k solution (KB) } +{ TODO: FIX ME! check_register_size()} + // check_register_size(size,r); + if use_push(cgpara) then + begin + cgpara.check_simple_location; + if tcgsize2size[cgpara.location^.size]>cgpara.alignment then + pushsize:=cgpara.location^.size + else + pushsize:=int_cgsize(cgpara.alignment); + + reference_reset_base(ref, NR_STACK_POINTER_REG, 0, cgpara.alignment); + ref.direction := dir_dec; + list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[pushsize],makeregsize(list,r,pushsize),ref)); + end + else + inherited a_load_reg_cgpara(list,size,r,cgpara); + end; + + + procedure tcg68k.a_load_const_cgpara(list : TAsmList;size : tcgsize;a : tcgint;const cgpara : tcgpara); + var + pushsize : tcgsize; + ref : treference; + begin +{$ifdef DEBUG_CHARLIE} +// writeln('a_load_const');_cgpara +{$endif DEBUG_CHARLIE} + if use_push(cgpara) then + begin + cgpara.check_simple_location; + if tcgsize2size[cgpara.location^.size]>cgpara.alignment then + pushsize:=cgpara.location^.size + else + pushsize:=int_cgsize(cgpara.alignment); + + reference_reset_base(ref, NR_STACK_POINTER_REG, 0, cgpara.alignment); + ref.direction := dir_dec; + list.concat(taicpu.op_const_ref(A_MOVE,tcgsize2opsize[pushsize],a,ref)); + end + else + inherited a_load_const_cgpara(list,size,a,cgpara); + end; + + + procedure tcg68k.a_load_ref_cgpara(list : TAsmList;size : tcgsize;const r : treference;const cgpara : tcgpara); + + procedure pushdata(paraloc:pcgparalocation;ofs:tcgint); + var + pushsize : tcgsize; + tmpreg : tregister; + href : treference; + ref : treference; + begin + if not assigned(paraloc) then + exit; +{ TODO: FIX ME!!! this also triggers location bug } + {if (paraloc^.loc<>LOC_REFERENCE) or + (paraloc^.reference.index<>NR_STACK_POINTER_REG) or + (tcgsize2size[paraloc^.size]>sizeof(tcgint)) then + internalerror(200501162);} + + { Pushes are needed in reverse order, add the size of the + current location to the offset where to load from. This + prevents wrong calculations for the last location when + the size is not a power of 2 } + if assigned(paraloc^.next) then + pushdata(paraloc^.next,ofs+tcgsize2size[paraloc^.size]); + { Push the data starting at ofs } + href:=r; + inc(href.offset,ofs); + if tcgsize2size[paraloc^.size]>cgpara.alignment then + pushsize:=paraloc^.size + else + pushsize:=int_cgsize(cgpara.alignment); + + reference_reset_base(ref, NR_STACK_POINTER_REG, 0, tcgsize2size[paraloc^.size]); + ref.direction := dir_dec; + + if tcgsize2size[paraloc^.size]<cgpara.alignment then + begin + tmpreg:=getintregister(list,pushsize); + a_load_ref_reg(list,paraloc^.size,pushsize,href,tmpreg); + list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[pushsize],tmpreg,ref)); + end + else + list.concat(taicpu.op_ref_ref(A_MOVE,tcgsize2opsize[pushsize],href,ref)); + end; + + var + len : tcgint; + href : treference; + begin +{$ifdef DEBUG_CHARLIE} +// writeln('a_load_ref');_cgpara +{$endif DEBUG_CHARLIE} + + { cgpara.size=OS_NO requires a copy on the stack } + if use_push(cgpara) then + begin + { Record copy? } + if (cgpara.size in [OS_NO,OS_F64]) or (size=OS_NO) then + begin + cgpara.check_simple_location; + len:=align(cgpara.intsize,cgpara.alignment); + g_stackpointer_alloc(list,len); + reference_reset_base(href,NR_STACK_POINTER_REG,0,cgpara.alignment); + g_concatcopy(list,r,href,len); + end + else + begin + if tcgsize2size[cgpara.size]<>tcgsize2size[size] then + internalerror(200501161); + { We need to push the data in reverse order, + therefor we use a recursive algorithm } + pushdata(cgpara.location,0); + end + end + else + inherited a_load_ref_cgpara(list,size,r,cgpara); + end; + + + procedure tcg68k.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const cgpara : tcgpara); + var + tmpreg : tregister; + opsize : topsize; + begin +{$ifdef DEBUG_CHARLIE} +// writeln('a_loadaddr_ref');_cgpara +{$endif DEBUG_CHARLIE} + with r do + begin + { i suppose this is not required for m68k (KB) } +// if (segment<>NR_NO) then +// cgmessage(cg_e_cant_use_far_pointer_there); + if not use_push(cgpara) then + begin + cgpara.check_simple_location; + opsize:=tcgsize2opsize[OS_ADDR]; + if (segment=NR_NO) and (base=NR_NO) and (index=NR_NO) then + begin + if assigned(symbol) then +// list.concat(Taicpu.Op_sym_ofs(A_PUSH,opsize,symbol,offset)) + else; +// list.concat(Taicpu.Op_const(A_PUSH,opsize,offset)); + end + else if (segment=NR_NO) and (base=NR_NO) and (index<>NR_NO) and + (offset=0) and (scalefactor=0) and (symbol=nil) then +// list.concat(Taicpu.Op_reg(A_PUSH,opsize,index)) + else if (segment=NR_NO) and (base<>NR_NO) and (index=NR_NO) and + (offset=0) and (symbol=nil) then +// list.concat(Taicpu.Op_reg(A_PUSH,opsize,base)) + else + begin + tmpreg:=getaddressregister(list); + a_loadaddr_ref_reg(list,r,tmpreg); +// list.concat(taicpu.op_reg(A_PUSH,opsize,tmpreg)); + end; + end + else + inherited a_loadaddr_ref_cgpara(list,r,cgpara); + end; + end; + + + + function tcg68k.fixref(list: TAsmList; var ref: treference): boolean; + + begin + result:=false; + { The Coldfire and MC68020+ have extended + addressing capabilities with a 32-bit + displacement. + } + if (current_settings.cputype<>cpu_MC68000) then + exit; + if (ref.base<>NR_NO) then + begin + if (ref.index <> NR_NO) and assigned(ref.symbol) then + internalerror(20020814); + { base + reg } + if ref.index <> NR_NO then + begin + { base + reg + offset } + if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then + begin + list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,ref.base)); + fixref := true; + ref.offset := 0; + exit; + end; + end + else + { base + offset } + if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then + begin + list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,ref.base)); + fixref := true; + ref.offset := 0; + exit; + end; + end; + end; + + + + procedure tcg68k.a_call_name(list : TAsmList;const s : string; weak: boolean); + var + sym: tasmsymbol; + begin + if not(weak) then + sym:=current_asmdata.RefAsmSymbol(s) + else + sym:=current_asmdata.WeakRefAsmSymbol(s); + + list.concat(taicpu.op_sym(A_JSR,S_NO,current_asmdata.RefAsmSymbol(s))); + end; + + + procedure tcg68k.a_call_reg(list : TAsmList;reg: tregister); + var + tmpref : treference; + tmpreg : tregister; + begin +{$ifdef DEBUG_CHARLIE} + list.concat(tai_comment.create(strpnew('a_call_reg'))); +{$endif} + if isaddressregister(reg) then + begin + { if we have an address register, we can jump to the address directly } + reference_reset_base(tmpref,reg,0,4); + end + else + begin + { if we have a data register, we need to move it to an address register first } + tmpreg:=getaddressregister(list); + reference_reset_base(tmpref,tmpreg,0,4); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg,tmpreg)); + end; + list.concat(taicpu.op_ref(A_JSR,S_NO,tmpref)); + end; + + + + procedure tcg68k.a_load_const_reg(list : TAsmList;size : tcgsize;a : tcgint;register : tregister); + begin +{$ifdef DEBUG_CHARLIE} +// writeln('a_load_const_reg'); +{$endif DEBUG_CHARLIE} + + if isaddressregister(register) then + begin + list.concat(taicpu.op_const_reg(A_MOVE,S_L,longint(a),register)) + end + else + if a = 0 then + list.concat(taicpu.op_reg(A_CLR,S_L,register)) + else + begin + if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then + list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,longint(a),register)) + else + list.concat(taicpu.op_const_reg(A_MOVE,S_L,longint(a),register)) + end; + end; + + procedure tcg68k.a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference); + begin +{$ifdef DEBUG_CHARLIE} + list.concat(tai_comment.create(strpnew('a_load_const_ref'))); +{$endif DEBUG_CHARLIE} + + list.concat(taicpu.op_const_ref(A_MOVE,S_L,longint(a),ref)); + end; + + + procedure tcg68k.a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference); + var + href : treference; + begin + href := ref; + fixref(list,href); +{$ifdef DEBUG_CHARLIE} + list.concat(tai_comment.create(strpnew('a_load_reg_ref'))); +{$endif DEBUG_CHARLIE} + { move to destination reference } + list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[fromsize],register,href)); + end; + + + procedure tcg68k.a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference); + var + aref: treference; + bref: treference; + begin + aref := sref; + bref := dref; + fixref(list,aref); + fixref(list,bref); +{$ifdef DEBUG_CHARLIE} +// writeln('a_load_ref_ref'); +{$endif DEBUG_CHARLIE} + list.concat(taicpu.op_ref_ref(A_MOVE,TCGSize2OpSize[fromsize],aref,bref)); + end; + + + procedure tcg68k.a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister); + begin + { move to destination register } + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,reg2)); + { zero/sign extend register to 32-bit } + sign_extend(list, fromsize, reg2); + end; + + + procedure tcg68k.a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister); + var + href : treference; + begin + href := ref; + fixref(list,href); + list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[fromsize],href,register)); + { extend the value in the register } + sign_extend(list, tosize, register); + end; + + + procedure tcg68k.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister); + var + href : treference; +// p: pointer; + begin + { TODO: FIX ME!!! take a look on this mess again...} +// if getregtype(r)=R_ADDRESSREGISTER then +// begin +// writeln('address reg?!?'); +// p:=nil; dword(p^):=0; {DEBUG CODE... :D ) +// internalerror(2002072901); +// end; + href:=ref; + fixref(list, href); + list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,r)); + end; + + + procedure tcg68k.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); + begin + { in emulation mode, only 32-bit single is supported } + if cs_fp_emulation in current_settings.moduleswitches then + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,reg2)) + else + list.concat(taicpu.op_reg_reg(A_FMOVE,tcgsize2opsize[tosize],reg1,reg2)); + end; + + + procedure tcg68k.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); + var + opsize : topsize; + href : treference; + tmpreg : tregister; + begin + opsize := tcgsize2opsize[fromsize]; + { extended is not supported, since it is not available on Coldfire } + if opsize = S_FX then + internalerror(20020729); + href := ref; + fixref(list,href); + { in emulation mode, only 32-bit single is supported } + if cs_fp_emulation in current_settings.moduleswitches then + list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,reg)) + else + begin + list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg)); + if (tosize < fromsize) then + a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg); + end; + end; + + procedure tcg68k.a_loadfpu_reg_ref(list: TAsmList; fromsize,tosize: tcgsize; reg: tregister; const ref: treference); + var + opsize : topsize; + begin + opsize := tcgsize2opsize[tosize]; + { extended is not supported, since it is not available on Coldfire } + if opsize = S_FX then + internalerror(20020729); + { in emulation mode, only 32-bit single is supported } + if cs_fp_emulation in current_settings.moduleswitches then + list.concat(taicpu.op_reg_ref(A_MOVE,S_L,reg, ref)) + else + list.concat(taicpu.op_reg_ref(A_FMOVE,opsize,reg, ref)); + end; + + + procedure tcg68k.a_loadmm_reg_reg(list: TAsmList;fromsize,tosize : tcgsize; reg1, reg2: tregister;shuffle : pmmshuffle); + begin + internalerror(20020729); + end; + + + procedure tcg68k.a_loadmm_ref_reg(list: TAsmList;fromsize,tosize : tcgsize; const ref: treference; reg: tregister;shuffle : pmmshuffle); + begin + internalerror(20020729); + end; + + + procedure tcg68k.a_loadmm_reg_ref(list: TAsmList;fromsize,tosize : tcgsize; reg: tregister; const ref: treference;shuffle : pmmshuffle); + begin + internalerror(20020729); + end; + + + procedure tcg68k.a_loadmm_reg_cgpara(list: TAsmList; size: tcgsize; reg: tregister;const locpara : TCGPara;shuffle : pmmshuffle); + begin + internalerror(20020729); + end; + + + procedure tcg68k.a_op_const_reg(list : TAsmList; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister); + var + scratch_reg : tregister; + scratch_reg2: tregister; + opcode : tasmop; + r,r2 : Tregister; + begin + optimize_op_const(op, a); + opcode := topcg2tasmop[op]; + case op of + OP_NONE : + begin + { Opcode is optimized away } + end; + OP_MOVE : + begin + { Optimized, replaced with a simple load } + a_load_const_reg(list,size,a,reg); + end; + OP_ADD : + begin + if (a >= 1) and (a <= 8) then + list.concat(taicpu.op_const_reg(A_ADDQ,S_L,a, reg)) + else + begin + { all others, including coldfire } + list.concat(taicpu.op_const_reg(A_ADD,S_L,a, reg)); + end; + end; + OP_AND, + OP_OR: + begin + list.concat(taicpu.op_const_reg(topcg2tasmop[op],S_L,longint(a), reg)); + end; + OP_DIV : + begin + internalerror(20020816); + end; + OP_IDIV : + begin + internalerror(20020816); + end; + OP_IMUL : + begin + if current_settings.cputype = cpu_MC68000 then + begin + r:=NR_D0; + r2:=NR_D1; + cg.getcpuregister(list,NR_D0); + cg.getcpuregister(list,NR_D1); + list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, r)); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, r2)); + cg.a_call_name(list,'FPC_MUL_LONGINT',false); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,r, reg)); + cg.ungetcpuregister(list,r); + cg.ungetcpuregister(list,r2); + + end + else + begin + if (isaddressregister(reg)) then + begin + scratch_reg := getintregister(list,OS_INT); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg)); + list.concat(taicpu.op_const_reg(A_MULS,S_L,a,scratch_reg)); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg)); + end + else + list.concat(taicpu.op_const_reg(A_MULS,S_L,a,reg)); + end; + end; + OP_MUL : + begin + if current_settings.cputype = cpu_MC68000 then + begin + r:=NR_D0; + r2:=NR_D1; + cg.getcpuregister(list,NR_D0); + cg.getcpuregister(list,NR_D1); + list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, r)); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, r2)); + cg.a_call_name(list,'FPC_MUL_LONGWORD',false); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,r, reg)); + cg.ungetcpuregister(list,r); + cg.ungetcpuregister(list,r2); + end + else + begin + if (isaddressregister(reg)) then + begin + scratch_reg := getintregister(list,OS_INT); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg)); + list.concat(taicpu.op_const_reg(A_MULU,S_L,a,scratch_reg)); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg)); + end + else + list.concat(taicpu.op_const_reg(A_MULU,S_L,a,reg)); + end; + end; + OP_SAR, + OP_SHL, + OP_SHR : + begin + if (a >= 1) and (a <= 8) then + begin + { now allowed to shift an address register } + if (isaddressregister(reg)) then + begin + scratch_reg := getintregister(list,OS_INT); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg)); + list.concat(taicpu.op_const_reg(opcode,S_L,a, scratch_reg)); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg,reg)); + end + else + list.concat(taicpu.op_const_reg(opcode,S_L,a, reg)); + end + else + begin + { we must load the data into a register ... :() } + scratch_reg := cg.getintregister(list,OS_INT); + list.concat(taicpu.op_const_reg(A_MOVE,S_L,a, scratch_reg)); + { again... since shifting with address register is not allowed } + if (isaddressregister(reg)) then + begin + scratch_reg2 := cg.getintregister(list,OS_INT); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg, scratch_reg2)); + list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg, scratch_reg2)); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,scratch_reg2,reg)); + end + else + list.concat(taicpu.op_reg_reg(opcode,S_L,scratch_reg, reg)); + end; + end; + OP_SUB : + begin + if (a >= 1) and (a <= 8) then + list.concat(taicpu.op_const_reg(A_SUBQ,S_L,a,reg)) + else + begin + { all others, including coldfire } + list.concat(taicpu.op_const_reg(A_SUB,S_L,a, reg)); + end; + end; + OP_XOR : + begin + list.concat(taicpu.op_const_reg(A_EORI,S_L,a, reg)); + end; + else + internalerror(20020729); + end; + end; + +{ + procedure tcg68k.a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); + var + opcode: tasmop; + begin + writeln('a_op_const_ref'); + + optimize_op_const(op, a); + opcode := topcg2tasmop[op]; + case op of + OP_NONE : + begin + { opcode was optimized away } + end; + OP_MOVE : + begin + { Optimized, replaced with a simple load } + a_load_const_ref(list,size,a,ref); + end; + else + begin + internalerror(2007010101); + end; + end; + end; +} + + procedure tcg68k.a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); + var + hreg1,hreg2,r,r2: tregister; + begin + case op of + OP_ADD : + begin + if current_settings.cputype = cpu_ColdFire then + begin + { operation only allowed only a longword } + sign_extend(list, size, reg1); + sign_extend(list, size, reg2); + list.concat(taicpu.op_reg_reg(A_ADD,S_L,reg1, reg2)); + end + else + begin + list.concat(taicpu.op_reg_reg(A_ADD,TCGSize2OpSize[size],reg1, reg2)); + end; + end; + OP_AND,OP_OR, + OP_SAR,OP_SHL, + OP_SHR,OP_SUB,OP_XOR : + begin + { load to data registers } + if (isaddressregister(reg1)) then + begin + hreg1 := getintregister(list,OS_INT); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1)); + end + else + hreg1 := reg1; + + if (isaddressregister(reg2)) then + begin + hreg2:= getintregister(list,OS_INT); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2)); + end + else + hreg2 := reg2; + + if current_settings.cputype = cpu_ColdFire then + begin + { operation only allowed only a longword } + {!*************************************** + in the case of shifts, the value to + shift by, should already be valid, so + no need to sign extend the value + ! + } + if op in [OP_AND,OP_OR,OP_SUB,OP_XOR] then + sign_extend(list, size, hreg1); + sign_extend(list, size, hreg2); + list.concat(taicpu.op_reg_reg(topcg2tasmop[op],S_L,hreg1, hreg2)); + end + else + begin + list.concat(taicpu.op_reg_reg(topcg2tasmop[op],TCGSize2OpSize[size],hreg1, hreg2)); + end; + + { move back result into destination register } + if reg2 <> hreg2 then + begin + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2)); + end; + end; + OP_DIV : + begin + internalerror(20020816); + end; + OP_IDIV : + begin + internalerror(20020816); + end; + OP_IMUL : + begin + sign_extend(list, size,reg1); + sign_extend(list, size,reg2); + if current_settings.cputype = cpu_MC68000 then + begin + r:=NR_D0; + r2:=NR_D1; + cg.getcpuregister(list,NR_D0); + cg.getcpuregister(list,NR_D1); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1, r)); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2, r2)); + cg.a_call_name(list,'FPC_MUL_LONGINT',false); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,r, reg2)); + cg.ungetcpuregister(list,r); + cg.ungetcpuregister(list,r2); + end + else + begin +// writeln('doing 68020'); + + if (isaddressregister(reg1)) then + hreg1 := getintregister(list,OS_INT) + else + hreg1 := reg1; + if (isaddressregister(reg2)) then + hreg2:= getintregister(list,OS_INT) + else + hreg2 := reg2; + + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1)); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2)); + + list.concat(taicpu.op_reg_reg(A_MULS,S_L,reg1,reg2)); + + { move back result into destination register } + + if reg2 <> hreg2 then + begin + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2)); + end; + end; + end; + OP_MUL : + begin + sign_extend(list, size,reg1); + sign_extend(list, size,reg2); + if current_settings.cputype = cpu_MC68000 then + begin + r:=NR_D0; + r2:=NR_D1; + cg.getcpuregister(list,NR_D0); + cg.getcpuregister(list,NR_D1); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1, r)); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2, r2)); + cg.a_call_name(list,'FPC_MUL_LONGWORD',false); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,r, reg2)); + cg.ungetcpuregister(list,r); + cg.ungetcpuregister(list,r2); + end + else + begin + if (isaddressregister(reg1)) then + begin + hreg1 := cg.getintregister(list,OS_INT); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg1,hreg1)); + end + else + hreg1 := reg1; + + if (isaddressregister(reg2)) then + begin + hreg2:= cg.getintregister(list,OS_INT); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2)); + end + else + hreg2 := reg2; + + list.concat(taicpu.op_reg_reg(A_MULU,S_L,reg1,reg2)); + + { move back result into destination register } + if reg2<>hreg2 then + begin + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2)); + end; + end; + end; + OP_NEG, + OP_NOT : + Begin + { if there are two operands, move the register, + since the operation will only be done on the result + register. + } + if reg1 <> NR_NO then + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,reg1,reg2); + + if (isaddressregister(reg2)) then + begin + hreg2 := getintregister(list,OS_INT); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg2,hreg2)); + end + else + hreg2 := reg2; + + { coldfire only supports long version } + if current_settings.cputype = cpu_ColdFire then + begin + sign_extend(list, size,hreg2); + list.concat(taicpu.op_reg(topcg2tasmop[op],S_L,hreg2)); + end + else + begin + list.concat(taicpu.op_reg(topcg2tasmop[op],TCGSize2OpSize[size],hreg2)); + end; + + if reg2 <> hreg2 then + begin + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg2,reg2)); + end; + + end; + else + internalerror(20020729); + end; + end; + + + + procedure tcg68k.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; + l : tasmlabel); + var + hregister : tregister; + begin + if a = 0 then + begin + list.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[size],reg)); + end + else + begin + if (current_settings.cputype = cpu_ColdFire) then + begin + { + only longword comparison is supported, + and only on data registers. + } + hregister := getintregister(list,OS_INT); + { always move to a data register } + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,reg,hregister)); + { sign/zero extend the register } + sign_extend(list, size,hregister); + list.concat(taicpu.op_const_reg(A_CMPI,S_L,a,hregister)); + end + else + begin + list.concat(taicpu.op_const_reg(A_CMPI,TCGSize2OpSize[size],a,reg)); + end; + end; + { emit the actual jump to the label } + a_jmp_cond(list,cmp_op,l); + end; + + procedure tcg68k.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); + begin + list.concat(taicpu.op_reg_reg(A_CMP,tcgsize2opsize[size],reg1,reg2)); + { emit the actual jump to the label } + a_jmp_cond(list,cmp_op,l); + end; + + procedure tcg68k.a_jmp_always(list : TAsmList;l: tasmlabel); + var + ai: taicpu; + begin + ai := Taicpu.op_sym(A_JMP,S_NO,l); + ai.is_jmp := true; + list.concat(ai); + end; + + procedure tcg68k.a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); + var + ai : taicpu; + begin + ai := Taicpu.op_sym(A_BXX,S_NO,l); + ai.SetCondition(flags_to_cond(f)); + ai.is_jmp := true; + list.concat(ai); + end; + + procedure tcg68k.g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister); + var + ai : taicpu; + hreg : tregister; + begin + { move to a Dx register? } + if (isaddressregister(reg)) then + begin + hreg := getintregister(list,OS_INT); + a_load_const_reg(list,size,0,hreg); + ai:=Taicpu.Op_reg(A_Sxx,S_B,hreg); + ai.SetCondition(flags_to_cond(f)); + list.concat(ai); + + if (current_settings.cputype = cpu_ColdFire) then + begin + { neg.b does not exist on the Coldfire + so we need to sign extend the value + before doing a neg.l + } + list.concat(taicpu.op_reg(A_EXTB,S_L,hreg)); + list.concat(taicpu.op_reg(A_NEG,S_L,hreg)); + end + else + begin + list.concat(taicpu.op_reg(A_NEG,S_B,hreg)); + end; + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,hreg,reg)); + end + else + begin + a_load_const_reg(list,size,0,reg); + ai:=Taicpu.Op_reg(A_Sxx,S_B,reg); + ai.SetCondition(flags_to_cond(f)); + list.concat(ai); + + if (current_settings.cputype = cpu_ColdFire) then + begin + { neg.b does not exist on the Coldfire + so we need to sign extend the value + before doing a neg.l + } + list.concat(taicpu.op_reg(A_EXTB,S_L,reg)); + list.concat(taicpu.op_reg(A_NEG,S_L,reg)); + end + else + begin + list.concat(taicpu.op_reg(A_NEG,S_B,reg)); + end; + end; + end; + + + + procedure tcg68k.g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint); + + var + helpsize : longint; + i : byte; + reg8,reg32 : tregister; + swap : boolean; + hregister : tregister; + iregister : tregister; + jregister : tregister; + hp1 : treference; + hp2 : treference; + hl : tasmlabel; + hl2: tasmlabel; + popaddress : boolean; + srcref,dstref : treference; + + begin + popaddress := false; + +// writeln('concatcopy:',len); + + { this should never occur } + if len > 65535 then + internalerror(0); + + hregister := getintregister(list,OS_INT); +// if delsource then +// reference_release(list,source); + + { from 12 bytes movs is being used } + if {(not loadref) and} ((len<=8) or (not(cs_opt_size in current_settings.optimizerswitches) and (len<=12))) then + begin + srcref := source; + dstref := dest; + helpsize:=len div 4; + { move a dword x times } + for i:=1 to helpsize do + begin + a_load_ref_reg(list,OS_INT,OS_INT,srcref,hregister); + a_load_reg_ref(list,OS_INT,OS_INT,hregister,dstref); + inc(srcref.offset,4); + inc(dstref.offset,4); + dec(len,4); + end; + { move a word } + if len>1 then + begin + a_load_ref_reg(list,OS_16,OS_16,srcref,hregister); + a_load_reg_ref(list,OS_16,OS_16,hregister,dstref); + inc(srcref.offset,2); + inc(dstref.offset,2); + dec(len,2); + end; + { move a single byte } + if len>0 then + begin + a_load_ref_reg(list,OS_8,OS_8,srcref,hregister); + a_load_reg_ref(list,OS_8,OS_8,hregister,dstref); + end + end + else + begin + iregister:=getaddressregister(list); + jregister:=getaddressregister(list); + { reference for move (An)+,(An)+ } + reference_reset(hp1,source.alignment); + hp1.base := iregister; { source register } + hp1.direction := dir_inc; + reference_reset(hp2,dest.alignment); + hp2.base := jregister; + hp2.direction := dir_inc; + { iregister = source } + { jregister = destination } + +{ if loadref then + cg.a_load_ref_reg(list,OS_INT,OS_INT,source,iregister) + else} + a_loadaddr_ref_reg(list,source,iregister); + + a_loadaddr_ref_reg(list,dest,jregister); + + { double word move only on 68020+ machines } + { because of possible alignment problems } + { use fast loop mode } + if (current_settings.cputype=cpu_MC68020) then + begin + helpsize := len - len mod 4; + len := len mod 4; + list.concat(taicpu.op_const_reg(A_MOVE,S_L,helpsize div 4,hregister)); + current_asmdata.getjumplabel(hl2); + a_jmp_always(list,hl2); + current_asmdata.getjumplabel(hl); + a_label(list,hl); + list.concat(taicpu.op_ref_ref(A_MOVE,S_L,hp1,hp2)); + a_label(list,hl2); + list.concat(taicpu.op_reg_sym(A_DBRA,S_L,hregister,hl)); + if len > 1 then + begin + dec(len,2); + list.concat(taicpu.op_ref_ref(A_MOVE,S_W,hp1,hp2)); + end; + if len = 1 then + list.concat(taicpu.op_ref_ref(A_MOVE,S_B,hp1,hp2)); + end + else + begin + { Fast 68010 loop mode with no possible alignment problems } + helpsize := len; + list.concat(taicpu.op_const_reg(A_MOVE,S_L,helpsize,hregister)); + current_asmdata.getjumplabel(hl2); + a_jmp_always(list,hl2); + current_asmdata.getjumplabel(hl); + a_label(list,hl); + list.concat(taicpu.op_ref_ref(A_MOVE,S_B,hp1,hp2)); + a_label(list,hl2); + list.concat(taicpu.op_reg_sym(A_DBRA,S_L,hregister,hl)); + end; + + { restore the registers that we have just used olny if they are used! } + if jregister = NR_A1 then + hp2.base := NR_NO; + if iregister = NR_A0 then + hp1.base := NR_NO; +// reference_release(list,hp1); +// reference_release(list,hp2); + end; + +// if delsource then +// tg.ungetiftemp(list,source); + end; + + procedure tcg68k.g_overflowcheck(list: TAsmList; const l:tlocation; def:tdef); + begin + end; + + procedure tcg68k.g_copyvaluepara_openarray(list : TAsmList;const ref:treference;const lenloc:tlocation;elesize:tcgint;destreg:tregister); + begin + end; + + + procedure tcg68k.g_proc_entry(list: TAsmList; localsize: longint; nostackframe:boolean); + var + r,rsp: TRegister; + ref : TReference; + begin +{$ifdef DEBUG_CHARLIE} +// writeln('proc entry, localsize:',localsize); +{$endif DEBUG_CHARLIE} + + if not nostackframe then + begin + if localsize<>0 then + begin + { size can't be negative } + if (localsize < 0) then + internalerror(2006122601); + + { Not to complicate the code generator too much, and since some } + { of the systems only support this format, the localsize cannot } + { exceed 32K in size. } + if (localsize > high(smallint)) then + CGMessage(cg_e_localsize_too_big); + + list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,-localsize)); + end + else + begin + list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,0)); +(* + { FIXME! - Carl's original code uses this method. However, + according to the 68060 users manual, a LINK is faster than + two moves. So, use a link in #0 case too, for now. I'm not + really sure tho', that LINK supports #0 disposition, but i + see no reason why it shouldn't support it. (KB) } + + { when localsize = 0, use two moves, instead of link } + r:=NR_FRAME_POINTER_REG; + rsp:=NR_STACK_POINTER_REG; + + reference_reset_base(ref,NR_STACK_POINTER_REG,0); + ref.direction:=dir_dec; + list.concat(taicpu.op_reg_ref(A_MOVE,S_L,r,ref)); + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,rsp,r)); + *) + end; + end; + end; + +{ procedure tcg68k.g_restore_frame_pointer(list : TAsmList); + var + r:Tregister; + begin + r:=NR_FRAME_POINTER_REG; + list.concat(taicpu.op_reg(A_UNLK,S_NO,r)); + end; +} + + procedure tcg68k.g_proc_exit(list : TAsmList; parasize: longint; nostackframe: boolean); + var +// r,hregister : TRegister; + localsize: tcgint; + spr : TRegister; + fpr : TRegister; + ref : TReference; + begin + if not nostackframe then + begin + localsize := current_procinfo.calc_stackframe_size; +{$ifdef DEBUG_CHARLIE} +// writeln('proc exit with stackframe, size:',localsize,' parasize:',parasize); +{$endif DEBUG_CHARLIE} + list.concat(taicpu.op_reg(A_UNLK,S_NO,NR_FRAME_POINTER_REG)); + parasize := parasize - target_info.first_parm_offset; { i'm still not 100% confident that this is + correct here, but at least it looks less + hacky, and makes some sense (KB) } + if (parasize<>0) then + begin + { only 68020+ supports RTD, so this needs another code path + for 68000 and Coldfire (KB) } +{ TODO: 68020+ only code generation, without fallback} + list.concat(taicpu.op_const(A_RTD,S_NO,parasize)); + end + else + list.concat(taicpu.op_none(A_RTS,S_NO)); + end + else + begin +{$ifdef DEBUG_CHARLIE} +// writeln('proc exit, no stackframe'); +{$endif DEBUG_CHARLIE} + list.concat(taicpu.op_none(A_RTS,S_NO)); + end; + +// writeln('g_proc_exit'); + { Routines with the poclearstack flag set use only a ret. + also routines with parasize=0 } + (* + if current_procinfo.procdef.proccalloption in clearstack_pocalls then + begin + { complex return values are removed from stack in C code PM } + if paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef.proccalloption) then + list.concat(taicpu.op_const(A_RTD,S_NO,4)) + else + list.concat(taicpu.op_none(A_RTS,S_NO)); + end + else if (parasize=0) then + begin + list.concat(taicpu.op_none(A_RTS,S_NO)); + end + else + begin + { return with immediate size possible here + signed! + RTD is not supported on the coldfire } + if (current_settings.cputype=cpu_MC68020) and (parasize<$7FFF) then + list.concat(taicpu.op_const(A_RTD,S_NO,parasize)) + { manually restore the stack } + else + begin + { We must pull the PC Counter from the stack, before } + { restoring the stack pointer, otherwise the PC would } + { point to nowhere! } + + { save the PC counter (pop it from the stack) } + hregister:=NR_A3; + cg.a_reg_alloc(list,hregister); + reference_reset_base(ref,NR_STACK_POINTER_REG,0); + ref.direction:=dir_inc; + list.concat(taicpu.op_ref_reg(A_MOVE,S_L,ref,hregister)); + { can we do a quick addition ... } + r:=NR_SP; + if (parasize > 0) and (parasize < 9) then + list.concat(taicpu.op_const_reg(A_ADDQ,S_L,parasize,r)) + else { nope ... } + list.concat(taicpu.op_const_reg(A_ADD,S_L,parasize,r)); + + { restore the PC counter (push it on the stack) } + reference_reset_base(ref,NR_STACK_POINTER_REG,0); + ref.direction:=dir_dec; + cg.a_reg_alloc(list,hregister); + list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hregister,ref)); + list.concat(taicpu.op_none(A_RTS,S_NO)); + end; + end; + *) + end; + + + procedure Tcg68k.g_save_registers(list:TAsmList); + var + tosave : tcpuregisterset; + ref : treference; + begin + {!!!!! + tosave:=std_saved_registers; + { only save the registers which are not used and must be saved } + tosave:=tosave*(rg[R_INTREGISTER].used_in_proc+rg[R_ADDRESSREGISTER].used_in_proc); + reference_reset_base(ref,NR_STACK_POINTER_REG,0); + ref.direction:=dir_dec; + if tosave<>[] then + list.concat(taicpu.op_regset_ref(A_MOVEM,S_L,tosave,ref)); + } + end; + + + procedure Tcg68k.g_restore_registers(list:TAsmList); + var + torestore : tcpuregisterset; + r:Tregister; + ref : treference; + begin + {!!!!!!!! + torestore:=std_saved_registers; + { should be intersected with used regs, no ? } + torestore:=torestore*(rg[R_INTREGISTER].used_in_proc+rg[R_ADDRESSREGISTER].used_in_proc); + reference_reset_base(ref,NR_STACK_POINTER_REG,0); + ref.direction:=dir_inc; + if torestore<>[] then + list.concat(taicpu.op_ref_regset(A_MOVEM,S_L,ref,torestore)); + } + end; + +{ + procedure tcg68k.g_save_all_registers(list : TAsmList); + begin + end; + + procedure tcg68k.g_restore_all_registers(list : TAsmList;const funcretparaloc:TCGPara); + begin + end; +} + procedure tcg68k.sign_extend(list: TAsmList;_oldsize : tcgsize; reg: tregister); + begin + case _oldsize of + { sign extend } + OS_S8: + begin + if (isaddressregister(reg)) then + internalerror(20020729); + if (current_settings.cputype = cpu_MC68000) then + begin + list.concat(taicpu.op_reg(A_EXT,S_W,reg)); + list.concat(taicpu.op_reg(A_EXT,S_L,reg)); + end + else + begin +// list.concat(tai_comment.create(strpnew('sign extend byte'))); + list.concat(taicpu.op_reg(A_EXTB,S_L,reg)); + end; + end; + OS_S16: + begin + if (isaddressregister(reg)) then + internalerror(20020729); +// list.concat(tai_comment.create(strpnew('sign extend word'))); + list.concat(taicpu.op_reg(A_EXT,S_L,reg)); + end; + { zero extend } + OS_8: + begin +// list.concat(tai_comment.create(strpnew('zero extend byte'))); + list.concat(taicpu.op_const_reg(A_AND,S_L,$FF,reg)); + end; + OS_16: + begin +// list.concat(tai_comment.create(strpnew('zero extend word'))); + list.concat(taicpu.op_const_reg(A_AND,S_L,$FFFF,reg)); + end; + end; { otherwise the size is already correct } + end; + + procedure tcg68k.a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel); + + var + ai : taicpu; + + begin + if cond=OC_None then + ai := Taicpu.Op_sym(A_JMP,S_NO,l) + else + begin + ai:=Taicpu.Op_sym(A_Bxx,S_NO,l); + ai.SetCondition(TOpCmp2AsmCond[cond]); + end; + ai.is_jmp:=true; + list.concat(ai); + end; + + + procedure tcg68k.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); +{ + procedure loadvmttor11; + var + href : treference; + begin + reference_reset_base(href,NR_R3,0); + cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11); + end; + + procedure op_onr11methodaddr; + var + href : treference; + begin + if (procdef.extnumber=$ffff) then + Internalerror(200006139); + { call/jmp vmtoffs(%eax) ; method offs } + reference_reset_base(href,NR_R11,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber)); + if not((longint(href.offset) >= low(smallint)) and + (longint(href.offset) <= high(smallint))) then + begin + list.concat(taicpu.op_reg_reg_const(A_ADDIS,NR_R11,NR_R11, + smallint((href.offset shr 16)+ord(smallint(href.offset and $ffff) < 0)))); + href.offset := smallint(href.offset and $ffff); + end; + list.concat(taicpu.op_reg_ref(A_LWZ,NR_R11,href)); + list.concat(taicpu.op_reg(A_MTCTR,NR_R11)); + list.concat(taicpu.op_none(A_BCTR)); + end; +} + var + make_global : boolean; + begin + if not(procdef.proctypeoption in [potype_function,potype_procedure]) then + Internalerror(200006137); + if not assigned(procdef.struct) 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 + create_smartlink 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) and + not is_objectpascal_helper(procdef.struct) then + begin +// loadvmttor11; +// op_onr11methodaddr; + end + { case 0 } + else +// list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname))); + + List.concat(Tai_symbol_end.Createname(labelname)); + end; + + +{****************************************************************************} +{ TCG64F68K } +{****************************************************************************} + procedure tcg64f68k.a_op64_reg_reg(list : TAsmList;op:TOpCG;size: tcgsize; regsrc,regdst : tregister64); + var + hreg1, hreg2 : tregister; + opcode : tasmop; + begin +// writeln('a_op64_reg_reg'); + opcode := topcg2tasmop[op]; + case op of + OP_ADD : + begin + { if one of these three registers is an address + register, we'll really get into problems! + } + if isaddressregister(regdst.reglo) or + isaddressregister(regdst.reghi) or + isaddressregister(regsrc.reghi) then + internalerror(20020817); + list.concat(taicpu.op_reg_reg(A_ADD,S_L,regsrc.reglo,regdst.reglo)); + list.concat(taicpu.op_reg_reg(A_ADDX,S_L,regsrc.reghi,regdst.reghi)); + end; + OP_AND,OP_OR : + begin + { at least one of the registers must be a data register } + if (isaddressregister(regdst.reglo) and + isaddressregister(regsrc.reglo)) or + (isaddressregister(regsrc.reghi) and + isaddressregister(regdst.reghi)) + then + internalerror(20020817); + cg.a_op_reg_reg(list,op,OS_32,regsrc.reglo,regdst.reglo); + cg.a_op_reg_reg(list,op,OS_32,regsrc.reghi,regdst.reghi); + end; + { this is handled in 1st pass for 32-bit cpu's (helper call) } + OP_IDIV,OP_DIV, + OP_IMUL,OP_MUL: internalerror(2002081701); + { this is also handled in 1st pass for 32-bit cpu's (helper call) } + OP_SAR,OP_SHL,OP_SHR: internalerror(2002081702); + OP_SUB: + begin + { if one of these three registers is an address + register, we'll really get into problems! + } + if isaddressregister(regdst.reglo) or + isaddressregister(regdst.reghi) or + isaddressregister(regsrc.reghi) then + internalerror(20020817); + list.concat(taicpu.op_reg_reg(A_SUB,S_L,regsrc.reglo,regdst.reglo)); + list.concat(taicpu.op_reg_reg(A_SUBX,S_L,regsrc.reghi,regdst.reghi)); + end; + OP_XOR: + begin + if isaddressregister(regdst.reglo) or + isaddressregister(regsrc.reglo) or + isaddressregister(regsrc.reghi) or + isaddressregister(regdst.reghi) then + internalerror(20020817); + list.concat(taicpu.op_reg_reg(A_EOR,S_L,regsrc.reglo,regdst.reglo)); + list.concat(taicpu.op_reg_reg(A_EOR,S_L,regsrc.reghi,regdst.reghi)); + end; + end; { end case } + end; + + + procedure tcg64f68k.a_op64_const_reg(list : TAsmList;op:TOpCG;size: tcgsize; value : int64;regdst : tregister64); + var + lowvalue : cardinal; + highvalue : cardinal; + hreg : tregister; + begin +// writeln('a_op64_const_reg'); + { is it optimized out ? } +// if cg.optimize64_op_const_reg(list,op,value,reg) then +// exit; + + lowvalue := cardinal(value); + highvalue:= value shr 32; + + { the destination registers must be data registers } + if isaddressregister(regdst.reglo) or + isaddressregister(regdst.reghi) then + internalerror(20020817); + case op of + OP_ADD : + begin + hreg:=cg.getintregister(list,OS_INT); + list.concat(taicpu.op_const_reg(A_MOVE,S_L,highvalue,hreg)); + list.concat(taicpu.op_const_reg(A_ADD,S_L,lowvalue,regdst.reglo)); + list.concat(taicpu.op_reg_reg(A_ADDX,S_L,hreg,regdst.reglo)); + end; + OP_AND : + begin + list.concat(taicpu.op_const_reg(A_AND,S_L,lowvalue,regdst.reglo)); + list.concat(taicpu.op_const_reg(A_AND,S_L,highvalue,regdst.reglo)); + end; + OP_OR : + begin + list.concat(taicpu.op_const_reg(A_OR,S_L,lowvalue,regdst.reglo)); + list.concat(taicpu.op_const_reg(A_OR,S_L,highvalue,regdst.reglo)); + end; + { this is handled in 1st pass for 32-bit cpus (helper call) } + OP_IDIV,OP_DIV, + OP_IMUL,OP_MUL: internalerror(2002081701); + { this is also handled in 1st pass for 32-bit cpus (helper call) } + OP_SAR,OP_SHL,OP_SHR: internalerror(2002081702); + OP_SUB: + begin + hreg:=cg.getintregister(list,OS_INT); + list.concat(taicpu.op_const_reg(A_MOVE,S_L,highvalue,hreg)); + list.concat(taicpu.op_const_reg(A_SUB,S_L,lowvalue,regdst.reglo)); + list.concat(taicpu.op_reg_reg(A_SUBX,S_L,hreg,regdst.reglo)); + end; + OP_XOR: + begin + list.concat(taicpu.op_const_reg(A_EOR,S_L,lowvalue,regdst.reglo)); + list.concat(taicpu.op_const_reg(A_EOR,S_L,highvalue,regdst.reglo)); + end; + end; { end case } + end; + + +procedure create_codegen; + begin + cg := tcg68k.create; + cg64 :=tcg64f68k.create; + end; + +end. diff --git a/closures/compiler/m68k/cpuasm.pas b/closures/compiler/m68k/cpuasm.pas new file mode 100644 index 0000000000..b19eb527df --- /dev/null +++ b/closures/compiler/m68k/cpuasm.pas @@ -0,0 +1,26 @@ +{ + Copyright (c) 1998-2000 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 cpuasm; + + interface + + implementation + +end. diff --git a/closures/compiler/m68k/cpubase.pas b/closures/compiler/m68k/cpubase.pas new file mode 100644 index 0000000000..e7de4b692a --- /dev/null +++ b/closures/compiler/m68k/cpubase.pas @@ -0,0 +1,520 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Contains the base types for the m68k + + 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 base types for the m68k +} +unit cpubase; + +{$i fpcdefs.inc} + + interface + + uses + globtype, + strings,cutils,cclasses,aasmbase,cpuinfo,cgbase; + +{***************************************************************************** + Assembler Opcodes +*****************************************************************************} + + type + { warning: CPU32 opcodes are not fully compatible with the MC68020. } + { 68000 only opcodes } + tasmop = (a_none, + a_abcd,a_add,a_adda,a_addi,a_addq,a_addx,a_and,a_andi, + a_asl,a_asr,a_bcc,a_bcs,a_beq,a_bge,a_bgt,a_bhi, + a_ble,a_bls,a_blt,a_bmi,a_bne,a_bpl,a_bvc,a_bvs, + a_bchg,a_bclr,a_bra,a_bset,a_bsr,a_btst,a_chk, + a_clr,a_cmp,a_cmpa,a_cmpi,a_cmpm,a_dbcc,a_dbcs,a_dbeq,a_dbge, + a_dbgt,a_dbhi,a_dble,a_dbls,a_dblt,a_dbmi,a_dbne,a_dbra, + a_dbpl,a_dbt,a_dbvc,a_dbvs,a_dbf,a_divs,a_divu, + a_eor,a_eori,a_exg,a_illegal,a_ext,a_jmp,a_jsr, + a_lea,a_link,a_lsl,a_lsr,a_move,a_movea,a_movei,a_moveq, + a_movem,a_movep,a_muls,a_mulu,a_nbcd,a_neg,a_negx, + a_nop,a_not,a_or,a_ori,a_pea,a_rol,a_ror,a_roxl, + a_roxr,a_rtr,a_rts,a_sbcd,a_scc,a_scs,a_seq,a_sge, + a_sgt,a_shi,a_sle,a_sls,a_slt,a_smi,a_sne, + a_spl,a_st,a_svc,a_svs,a_sf,a_sub,a_suba,a_subi,a_subq, + a_subx,a_swap,a_tas,a_trap,a_trapv,a_tst,a_unlk, + a_rte,a_reset,a_stop, + { mc68010 instructions } + a_bkpt,a_movec,a_moves,a_rtd, + { mc68020 instructions } + a_bfchg,a_bfclr,a_bfexts,a_bfextu,a_bfffo, + a_bfins,a_bfset,a_bftst,a_callm,a_cas,a_cas2, + a_chk2,a_cmp2,a_divsl,a_divul,a_extb,a_pack,a_rtm, + a_trapcc,a_tracs,a_trapeq,a_trapf,a_trapge,a_trapgt, + a_traphi,a_traple,a_trapls,a_traplt,a_trapmi,a_trapne, + a_trappl,a_trapt,a_trapvc,a_trapvs,a_unpk, + { fpu processor instructions - directly supported only. } + { ieee aware and misc. condition codes not supported } + a_fabs,a_fadd, + a_fbeq,a_fbne,a_fbngt,a_fbgt,a_fbge,a_fbnge, + a_fblt,a_fbnlt,a_fble,a_fbgl,a_fbngl,a_fbgle,a_fbngle, + a_fdbeq,a_fdbne,a_fdbgt,a_fdbngt,a_fdbge,a_fdbnge, + a_fdblt,a_fdbnlt,a_fdble,a_fdbgl,a_fdbngl,a_fdbgle,a_fdbngle, + a_fseq,a_fsne,a_fsgt,a_fsngt,a_fsge,a_fsnge, + a_fslt,a_fsnlt,a_fsle,a_fsgl,a_fsngl,a_fsgle,a_fsngle, + a_fcmp,a_fdiv,a_fmove,a_fmovem, + a_fmul,a_fneg,a_fnop,a_fsqrt,a_fsub,a_fsgldiv, + a_fsflmul,a_ftst, + a_ftrapeq,a_ftrapne,a_ftrapgt,a_ftrapngt,a_ftrapge,a_ftrapnge, + a_ftraplt,a_ftrapnlt,a_ftraple,a_ftrapgl,a_ftrapngl,a_ftrapgle,a_ftrapngle, + { protected instructions } + a_cprestore,a_cpsave, + { fpu unit protected instructions } + { and 68030/68851 common mmu instructions } + { (this may include 68040 mmu instructions) } + a_frestore,a_fsave,a_pflush,a_pflusha,a_pload,a_pmove,a_ptest, + { useful for assembly language output } + a_label,a_dbxx,a_sxx,a_bxx,a_fbxx); + + {# 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 r68knor.inc}-1; + + const + { Available Superregisters } + {$i r68ksup.inc} + + { ? whatever... } + R_SUBWHOLE = R_SUBNONE; + + { Available Registers } + {$i r68kcon.inc} + + { Integer Super registers first and last } + first_int_imreg = RS_D7+1; + + { Float Super register first and last } + first_fpu_imreg = RS_FP7+1; + + { Integer Super registers first and last } + first_addr_imreg = RS_SP+1; + + { MM Super register first and last } + first_mm_supreg = 0; + first_mm_imreg = 0; + + maxfpuregs = 8; + +{ TODO: FIX BSSTART} + regnumber_count_bsstart = 16; + + regnumber_table : array[tregisterindex] of tregister = ( + {$i r68knum.inc} + ); + + regstabs_table : array[tregisterindex] of shortint = ( + {$i r68ksta.inc} + ); + + regdwarf_table : array[tregisterindex] of shortint = ( +{ TODO: reused stabs values!} + {$i r68ksta.inc} + ); + + { registers which may be destroyed by calls } + VOLATILE_INTREGISTERS = [RS_D0,RS_D1]; + VOLATILE_FPUREGISTERS = []; + VOLATILE_ADDRESSREGISTER = [RS_A0,RS_A1]; + + type + totherregisterset = set of tregisterindex; + + +{***************************************************************************** + Conditions +*****************************************************************************} + + type + TAsmCond=(C_None, + C_CC,C_LS,C_CS,C_LT,C_EQ,C_MI,C_F,C_NE, + C_GE,C_PL,C_GT,C_T,C_HI,C_VC,C_LE,C_VS + ); + + + const + cond2str:array[TAsmCond] of string[3]=('', + 'cc','ls','cs','lt','eq','mi','f','ne', + 'ge','pl','gt','t','hi','vc','le','vs' + ); + +{***************************************************************************** + Flags +*****************************************************************************} + + type + TResFlags = ( + F_E,F_NE, + F_G,F_L,F_GE,F_LE,F_C,F_NC,F_A,F_AE,F_B,F_BE); + +{***************************************************************************** + Reference +*****************************************************************************} + + type + { direction of address register : } + { (An) (An)+ -(An) } + tdirection = (dir_none,dir_inc,dir_dec); + + +{***************************************************************************** + Operand Sizes +*****************************************************************************} + + { S_NO = No Size of operand } + { S_B = 8-bit size operand } + { S_W = 16-bit size operand } + { S_L = 32-bit size operand } + { Floating point types } + { S_FS = single type (32 bit) } + { S_FD = double/64bit integer } + { S_FX = Extended type } + topsize = (S_NO,S_B,S_W,S_L,S_FS,S_FD,S_FX,S_IQ); + +{***************************************************************************** + Constants +*****************************************************************************} + + const + {# maximum number of operands in assembler instruction } + max_operands = 4; + +{***************************************************************************** + 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_M128; + + +{***************************************************************************** + GDB Information +*****************************************************************************} + + {# Register indexes for stabs information, when some + parameters or variables are stored in registers. + + Taken from m68kelf.h (DBX_REGISTER_NUMBER) + from GCC 3.x source code. + + This is not compatible with the m68k-sun + implementation. + } + stab_regindex : array[tregisterindex] of shortint = + ( + {$i r68ksta.inc} + ); + +{***************************************************************************** + Generic Register names +*****************************************************************************} + + {# Stack pointer register } + NR_STACK_POINTER_REG = NR_SP; + RS_STACK_POINTER_REG = RS_SP; + {# Frame pointer register } +{ TODO: FIX ME!!! frame pointer is A5 on Amiga, but A6 on unixes?} + NR_FRAME_POINTER_REG = NR_A5; + RS_FRAME_POINTER_REG = RS_A5; + + {# 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 + } +{ TODO: FIX ME!!! pic offset reg conflicts with frame pointer?} + NR_PIC_OFFSET_REG = NR_A5; + { Return address for DWARF } +{ TODO: just a guess!} + NR_RETURN_ADDRESS_REG = NR_A0; + { Results are returned in this register (32-bit values) } + NR_FUNCTION_RETURN_REG = NR_D0; + RS_FUNCTION_RETURN_REG = RS_D0; + { Low part of 64bit return value } + NR_FUNCTION_RETURN64_LOW_REG = NR_D0; + RS_FUNCTION_RETURN64_LOW_REG = RS_D0; + { High part of 64bit return value } + NR_FUNCTION_RETURN64_HIGH_REG = NR_D1; + RS_FUNCTION_RETURN64_HIGH_REG = RS_D1; + { 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; + + {# Floating point results will be placed into this register } + NR_FPU_RESULT_REG = NR_FP0; + +{***************************************************************************** + GCC /ABI linking information +*****************************************************************************} + + {# Registers which must be saved when calling a routine declared as + cppdecl, cdecl, stdcall, safecall, palmossyscall. The registers + saved should be the ones as defined in the target ABI and / or GCC. + + This value can be deduced from CALLED_USED_REGISTERS array in the + GCC source. + } + saved_standard_registers : array[0..5] of tsuperregister = (RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7); + saved_standard_address_registers : array[0..3] of tsuperregister = (RS_A2,RS_A3,RS_A4,RS_A5); + + { this is only for the generic code which is not used for this architecture } + saved_mm_registers : array[0..0] of tsuperregister = (RS_NO); + + {# 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; { for 32-bit version only } + + +{***************************************************************************** + CPU Dependent Constants +*****************************************************************************} + + +{***************************************************************************** + Helpers +*****************************************************************************} + + function is_calljmp(o:tasmop):boolean; + + procedure inverse_flags(var r : TResFlags); + function flags_to_cond(const f: TResFlags) : TAsmCond; + function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister; + function reg_cgsize(const reg: tregister): tcgsize; + + function findreg_by_number(r:Tregister):tregisterindex; + function std_regnum_search(const s:string):Tregister; + function std_regname(r:Tregister):string; + + function isaddressregister(reg : tregister) : boolean; + + function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE} + function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE} + function dwarf_reg(r:tregister):shortint; + +implementation + + uses + verbose, + rgbase; + + + const + std_regname_table : array[tregisterindex] of string[7] = ( + {$i r68kstd.inc} + ); + + regnumber_index : array[tregisterindex] of tregisterindex = ( + {$i r68krni.inc} + ); + + std_regname_index : array[tregisterindex] of tregisterindex = ( + {$i r68ksri.inc} + ); + + +{***************************************************************************** + Helpers +*****************************************************************************} + + function is_calljmp(o:tasmop):boolean; + begin + is_calljmp := false; + if o in [A_BXX,A_FBXX,A_DBXX,A_BCC..A_BVS,A_DBCC..A_DBVS,A_FBEQ..A_FSNGLE, + A_JSR,A_BSR,A_JMP] then + is_calljmp := true; + end; + + + procedure inverse_flags(var r: TResFlags); + const flagsinvers : array[F_E..F_BE] of tresflags = + (F_NE,F_E, + F_LE,F_GE, + F_L,F_G, + F_NC,F_C, + F_BE,F_B, + F_AE,F_A); + begin + r:=flagsinvers[r]; + end; + + + + function flags_to_cond(const f: TResFlags) : TAsmCond; + const flags2cond: array[tresflags] of tasmcond = ( + C_EQ,{F_E equal} + C_NE,{F_NE not equal} + C_GT,{F_G gt signed} + C_LT,{F_L lt signed} + C_GE,{F_GE ge signed} + C_LE,{F_LE le signed} + C_CS,{F_C carry set} + C_CC,{F_NC carry clear} + C_HI,{F_A gt unsigned} + C_CC,{F_AE ge unsigned} + C_CS,{F_B lt unsigned} + C_LS);{F_BE le unsigned} + begin + flags_to_cond := flags2cond[f]; + end; + + function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister; + var p: pointer; + begin + case s of + OS_NO: begin +{ TODO: FIX ME!!! results in bad code generation} + cgsize2subreg:=R_SUBWHOLE; + end; + + OS_8,OS_S8: + cgsize2subreg:=R_SUBWHOLE; + OS_16,OS_S16: + cgsize2subreg:=R_SUBWHOLE; + OS_32,OS_S32: + cgsize2subreg:=R_SUBWHOLE; + OS_64,OS_S64: + begin +// writeln('64bit regsize?'); + cgsize2subreg:=R_SUBWHOLE; + end; + OS_F32 : + cgsize2subreg:=R_SUBFS; + OS_F64 : + cgsize2subreg:=R_SUBFD; +{ + begin + // is this correct? (KB) + cgsize2subreg:=R_SUBNONE; + end; +} + else begin + writeln('M68K: invalid register size'); + // this supposed to be debug + // p:=nil; dword(p^):=0; + // internalerror(200301231); + cgsize2subreg:=R_SUBWHOLE; + end; + end; + end; + + + function reg_cgsize(const reg: tregister): tcgsize; + begin + case getregtype(reg) of + R_ADDRESSREGISTER, + R_INTREGISTER : + result:=OS_32; + R_FPUREGISTER : + result:=OS_F64; + else + internalerror(200303181); + end; + end; + + + function findreg_by_number(r:Tregister):tregisterindex; + begin + result:=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; + + + function isaddressregister(reg : tregister) : boolean; + begin + result:=getregtype(reg)=R_ADDRESSREGISTER; + end; + + + function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE} + const + inverse:array[TAsmCond] of TAsmCond=(C_None, +{ TODO: TODO, this is just a copy!} + C_CC,C_LS,C_CS,C_LT,C_EQ,C_MI,C_F,C_NE, + C_GE,C_PL,C_GT,C_T,C_HI,C_VC,C_LE,C_VS + ); + begin + result := inverse[c]; + end; + + + function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE} + begin + result := c1 = c2; + end; + + + function dwarf_reg(r:tregister):shortint; + begin + result:=regdwarf_table[findreg_by_number(r)]; + if result=-1 then + internalerror(200603251); + end; + +end. diff --git a/closures/compiler/m68k/cpuinfo.pas b/closures/compiler/m68k/cpuinfo.pas new file mode 100644 index 0000000000..0006c73243 --- /dev/null +++ b/closures/compiler/m68k/cpuinfo.pas @@ -0,0 +1,87 @@ +{ + Copyright (c) 1998-2002 by the Free Pascal development team + + Basic Processor information for the m68k + + 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 = extended; + ts128real = type extended; + ts64comp = extended; + + pbestreal=^bestreal; + + { possible supported processors for this target } + tcputype = + (cpu_none, + cpu_MC68000, + cpu_MC68020, + cpu_Coldfire + ); + + tfputype = + (fpu_none, + fpu_soft, + fpu_libgcc, + fpu_68881 + ); + +Const + { calling conventions supported by the code generator } + supported_calling_conventions : tproccalloptions = [ + pocall_internproc, + pocall_stdcall, + { the difference to stdcall is only the name mangling } + pocall_cdecl, + { the difference to stdcall is only the name mangling } + pocall_cppdecl, + { this used by the PalmOS port only } + pocall_syscall + ]; + + cputypestr : array[tcputype] of string[8] = ('', + '68000', + '68020', + 'COLDFIRE' + ); + + fputypestr : array[tfputype] of string[6] = ('', + 'SOFT', + 'LIBGCC', + '68881' + ); + + { Supported optimizations, only used for information } + supported_optimizerswitches = genericlevel1optimizerswitches+ + genericlevel2optimizerswitches+ + genericlevel3optimizerswitches- + { no need to write info about those } + [cs_opt_level1,cs_opt_level2,cs_opt_level3]+ + [cs_opt_regvar,cs_opt_loopunroll,cs_opt_nodecse]; + + level1optimizerswitches = genericlevel1optimizerswitches; + level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + + [cs_opt_regvar,cs_opt_stackframe,cs_opt_nodecse]; + level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches + [{,cs_opt_loopunroll}]; + +Implementation + +end. diff --git a/closures/compiler/m68k/cpunode.pas b/closures/compiler/m68k/cpunode.pas new file mode 100644 index 0000000000..79f38ae861 --- /dev/null +++ b/closures/compiler/m68k/cpunode.pas @@ -0,0 +1,52 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + Includes the 680x0/Coldfire 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. + + **************************************************************************** +} +unit cpunode; + +{$i fpcdefs.inc} + + interface + + implementation + + uses + { generic nodes } + ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,ncgmat,ncgadd, + { to be able to only parts of the generic code, + the processor specific nodes must be included + after the generic one (FK) + } + n68kadd, + n68kcal, +// nppccon, +// nppcflw, +// nppcmem, +// nppcset, +// nppcinl, +// nppcopt, + { this not really a node } +// nppcobj, +// nppcmat, + n68kmat, + n68kcnv + ; + +end. diff --git a/closures/compiler/m68k/cpupara.pas b/closures/compiler/m68k/cpupara.pas new file mode 100644 index 0000000000..bf23642a98 --- /dev/null +++ b/closures/compiler/m68k/cpupara.pas @@ -0,0 +1,599 @@ +{ + Copyright (c) 2002 by Florian Klaempfl + + Generates the argument location information for 680x0 + + 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. + + **************************************************************************** +} +{ Generates the argument location information for 680x0. +} +unit cpupara; + +{$i fpcdefs.inc} + + interface + + uses + globtype, + cpubase, + aasmdata, + symconst,symtype,symdef,symsym, + parabase,paramgr,cgbase; + + type + { Returns the location for the nr-st 32 Bit int parameter + if every parameter before is an 32 Bit int parameter as well + and if the calling conventions for the helper routines of the + rtl are used. + } + tm68kparamanager = class(tparamanager) + procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara : TCGPara);override; + function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override; + function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override; + function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override; + procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);override; + procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); + function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override; + function parseparaloc(p : tparavarsym;const s : string) : boolean;override; + function parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;override; + private + procedure init_values(var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword); + function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist; + var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword):longint; + end; + + implementation + + uses + verbose, + globals, + systems, + cpuinfo,cgutils, + defutil; + + procedure tm68kparamanager.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.alignment:=std_param_align; + paraloc:=cgpara.add_location; + with paraloc^ do + begin + { warning : THIS ONLY WORKS WITH INTERNAL ROUTINES, + WHICH MUST ALWAYS PASS 4-BYTE PARAMETERS!! + } + loc:=LOC_REFERENCE; + reference.index:=NR_STACK_POINTER_REG; + reference.offset:=target_info.first_parm_offset+nr*4; + end; + end; + + function getparaloc(p : tdef) : tcgloc; + + begin + result:=LOC_REFERENCE; + (* Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER + if push_addr_param for the def is true + case p.typ of + orddef: + result:=LOC_REGISTER; + floatdef: + result:=LOC_FPUREGISTER; + enumdef: + result:=LOC_REGISTER; + pointerdef: + result:=LOC_REGISTER; + formaldef: + result:=LOC_REGISTER; + classrefdef: + result:=LOC_REGISTER; + recorddef: + if (target_info.abi<>abi_powerpc_aix) then + result:=LOC_REFERENCE + else + result:=LOC_REGISTER; + objectdef: + if is_object(p) then + result:=LOC_REFERENCE + else + result:=LOC_REGISTER; + stringdef: + if is_shortstring(p) or is_longstring(p) then + result:=LOC_REFERENCE + else + result:=LOC_REGISTER; + procvardef: + if (po_methodpointer in tprocvardef(p).procoptions) then + result:=LOC_REFERENCE + else + result:=LOC_REGISTER; + filedef: + result:=LOC_REGISTER; + arraydef: + result:=LOC_REFERENCE; + setdef: + if is_smallset(p) then + result:=LOC_REGISTER + else + result:=LOC_REFERENCE; + variantdef: + result:=LOC_REFERENCE; + { avoid problems with errornous definitions } + errordef: + result:=LOC_REGISTER; + else + internalerror(2002071001); + end; + *) + end; + + +{ TODO: copied from ppc cg, needs work} + function tm68kparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; + begin + result:=false; + { var,out,constref always require address } + if varspez in [vs_var,vs_out,vs_constref] then + begin + result:=true; + exit; + end; + case def.typ of + variantdef, + formaldef : + result:=true; + 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:=not is_smallset(def); + stringdef : + result:=tstringdef(def).stringtype in [st_shortstring,st_longstring]; + procvardef : + result:=po_methodpointer in tprocvardef(def).procoptions; + end; + end; + + procedure tm68kparamanager.init_values(var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword); + begin + cur_stack_offset:=8; + curintreg:=RS_D0; + curfloatreg:=RS_FP0; + end; + + procedure tm68kparamanager.create_funcretloc_info(p: tabstractprocdef; side: tcallercallee); + begin + p.funcretloc[side]:=get_funcretloc(p,side,p.returndef); + end; + + + function tm68kparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara; + var + paraloc : pcgparalocation; + retcgsize : tcgsize; + begin + result.init; + result.alignment:=get_para_align(p.proccalloption); + { void has no location } + if is_void(def) then + begin + paraloc:=result.add_location; + result.size:=OS_NO; + result.intsize:=0; + paraloc^.size:=OS_NO; + paraloc^.loc:=LOC_VOID; + exit; + end; + { Constructors return self instead of a boolean } + if (p.proctypeoption=potype_constructor) then + begin + retcgsize:=OS_ADDR; + result.intsize:=sizeof(pint); + end + else + begin + retcgsize:=def_cgsize(def); + result.intsize:=def.size; + end; + result.size:=retcgsize; + { Return is passed as var parameter } + if ret_in_param(def,p.proccalloption) then + begin + paraloc:=result.add_location; + paraloc^.loc:=LOC_REFERENCE; + paraloc^.size:=retcgsize; + exit; + end; + + paraloc:=result.add_location; + { Return in FPU register? } + if not(cs_fp_emulation in current_settings.moduleswitches) and (p.returndef.typ=floatdef) then + begin + paraloc^.loc:=LOC_FPUREGISTER; + paraloc^.register:=NR_FPU_RESULT_REG; + paraloc^.size:=retcgsize; + end + else + { Return in register } + begin + if retcgsize in [OS_64,OS_S64] then + begin + { low 32bits } + paraloc^.loc:=LOC_REGISTER; + paraloc^.size:=OS_32; + if side=callerside then + paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG + else + paraloc^.register:=NR_FUNCTION_RETURN64_LOW_REG; + { high 32bits } + paraloc:=result.add_location; + paraloc^.loc:=LOC_REGISTER; + paraloc^.size:=OS_32; + if side=calleeside then + paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG + else + paraloc^.register:=NR_FUNCTION_RETURN64_HIGH_REG; + end + else + begin + paraloc^.loc:=LOC_REGISTER; + paraloc^.size:=retcgsize; + if side=callerside then + paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize)) + else + paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize)); + end; + end; + end; + + function tm68kparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint; + var + cur_stack_offset: aword; + curintreg, curfloatreg: tsuperregister; + begin + init_values(curintreg,curfloatreg,cur_stack_offset); + + result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,cur_stack_offset); + + create_funcretloc_info(p,side); + end; + + function tm68kparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist; + var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword):longint; + var + paraloc : pcgparalocation; + hp : tparavarsym; + paracgsize : tcgsize; + paralen : aint; + parasize : longint; + paradef : tdef; + i : longint; + loc : tcgloc; + nextintreg, + nextfloatreg : tsuperregister; + stack_offset : longint; + + begin + result:=0; + nextintreg:=curintreg; + nextfloatreg:=curfloatreg; + stack_offset:=cur_stack_offset; + + parasize:=0; + + for i:=0 to p.paras.count-1 do + begin + hp:=tparavarsym(paras[i]); + paradef:=hp.vardef; + + { syscall for AmigaOS can have already a paraloc set } + if (vo_has_explicit_paraloc in hp.varoptions) then + begin + if not(vo_is_syscall_lib in hp.varoptions) then + internalerror(200506051); + continue; + end; + hp.paraloc[side].reset; + + { currently only support C-style array of const } + if (p.proccalloption in [pocall_cdecl,pocall_cppdecl]) and + is_array_of_const(paradef) then + begin +{$ifdef DEBUG_CHARLIE} + writeln('loc register'); +{$endif DEBUG_CHARLIE} + paraloc:=hp.paraloc[side].add_location; + { hack: the paraloc must be valid, but is not actually used } + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=NR_D0; + paraloc^.size:=OS_ADDR; + break; + end; + + if (hp.varspez in [vs_var,vs_out]) or + push_addr_param(hp.varspez,paradef,p.proccalloption) or + is_open_array(paradef) or + is_array_of_const(paradef) then + begin +{$ifdef DEBUG_CHARLIE} + writeln('loc register'); +{$endif DEBUG_CHARLIE} + paradef:=voidpointertype; + loc:=LOC_REGISTER; + paracgsize := OS_ADDR; + paralen := tcgsize2size[OS_ADDR]; + end + else + begin + if not is_special_array(paradef) then + paralen:=paradef.size + else + paralen:=tcgsize2size[def_cgsize(paradef)]; + + loc:=getparaloc(paradef); + paracgsize:=def_cgsize(paradef); + { for things like formaldef } + if (paracgsize=OS_NO) then + begin + paracgsize:=OS_ADDR; + paralen := tcgsize2size[OS_ADDR]; + end; + end; + + hp.paraloc[side].alignment:=std_param_align; + hp.paraloc[side].size:=paracgsize; + hp.paraloc[side].intsize:=paralen; + + if (paralen = 0) then + if (paradef.typ = recorddef) then + begin + paraloc:=hp.paraloc[side].add_location; + paraloc^.loc := LOC_VOID; + end + else + internalerror(200506052); + { can become < 0 for e.g. 3-byte records } + while (paralen > 0) do + begin + paraloc:=hp.paraloc[side].add_location; + (* + by default, the m68k doesn't know any register parameters (FK) + if (loc = LOC_REGISTER) and + (nextintreg <= RS_D2) then + begin + //writeln('loc register'); + paraloc^.loc := loc; + { make sure we don't lose whether or not the type is signed } + if (paradef.typ <> orddef) then + paracgsize := int_cgsize(paralen); + if (paracgsize in [OS_NO,OS_64,OS_S64]) then + paraloc^.size := OS_INT + else + paraloc^.size := paracgsize; + paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBNONE); + inc(nextintreg); + dec(paralen,tcgsize2size[paraloc^.size]); + end + else if (loc = LOC_FPUREGISTER) and + (nextfloatreg <= RS_FP2) then + begin +// writeln('loc fpuregister'); + paraloc^.loc:=loc; + paraloc^.size := paracgsize; + paraloc^.register:=newreg(R_FPUREGISTER,nextfloatreg,R_SUBWHOLE); + inc(nextfloatreg); + dec(paralen,tcgsize2size[paraloc^.size]); + end + else { LOC_REFERENCE } + *) + begin +{$ifdef DEBUG_CHARLIE} + writeln('loc reference'); +{$endif DEBUG_CHARLIE} + paraloc^.loc:=LOC_REFERENCE; + paraloc^.size:=int_cgsize(paralen); + if (side = callerside) then + paraloc^.reference.index:=NR_STACK_POINTER_REG + else + paraloc^.reference.index:=NR_FRAME_POINTER_REG; + paraloc^.reference.offset:=stack_offset; + inc(stack_offset,align(paralen,4)); + paralen := 0; + end; + end; + end; + result:=stack_offset; +// writeln('stack offset:',stack_offset); + end; + + +{ + + if push_addr_param(hp.varspez,paradef,p.proccalloption) then + paracgsize:=OS_ADDR + else + begin + paracgsize:=def_cgsize(paradef); + if paracgsize=OS_NO then + paracgsize:=OS_ADDR; + end; + hp.paraloc[side].size:=paracgsize; + hp.paraloc[side].Alignment:=std_param_align; + paraloc:=hp.paraloc[side].add_location; + paraloc^.size:=paracgsize; + paraloc^.loc:=LOC_REFERENCE; + if side=callerside then + paraloc^.reference.index:=NR_STACK_POINTER_REG + else + paraloc^.reference.index:=NR_FRAME_POINTER_REG; + paraloc^.reference.offset:=target_info.first_parm_offset+parasize; + end; + create_funcretloc_info(p,side); + result:=parasize; + end; +} + + function tm68kparamanager.parsefuncretloc(p : tabstractprocdef; const s : string) : boolean; + begin + result:=false; + case target_info.system of + system_m68k_amiga: + begin + if s='D0' then + p.exp_funcretloc:=NR_D0 + else if s='D1' then + p.exp_funcretloc:=NR_D1 + else if s='D2' then + p.exp_funcretloc:=NR_D2 + else if s='D3' then + p.exp_funcretloc:=NR_D3 + else if s='D4' then + p.exp_funcretloc:=NR_D4 + else if s='D5' then + p.exp_funcretloc:=NR_D5 + else if s='D6' then + p.exp_funcretloc:=NR_D6 + else if s='D7' then + p.exp_funcretloc:=NR_D7 + else if s='A0' then + p.exp_funcretloc:=NR_A0 + else if s='A1' then + p.exp_funcretloc:=NR_A1 + else if s='A2' then + p.exp_funcretloc:=NR_A2 + else if s='A3' then + p.exp_funcretloc:=NR_A3 + else if s='A4' then + p.exp_funcretloc:=NR_A4 + else if s='A5' then + p.exp_funcretloc:=NR_A5 + { 'A6' is problematic, since it's the frame pointer in fpc, + so it should be saved before a call! } + else if s='A6' then + p.exp_funcretloc:=NR_A6 + { 'A7' is the stack pointer on 68k, can't be overwritten by API calls } + else + p.exp_funcretloc:=NR_NO; + + if p.exp_funcretloc<>NR_NO then result:=true; + end; + else + internalerror(2005121801); + end; + end; + + + function tm68kparamanager.parseparaloc(p : tparavarsym;const s : string) : boolean; + var + paraloc : pcgparalocation; + begin + result:=false; + case target_info.system of + system_m68k_amiga: + begin + p.paraloc[callerside].alignment:=4; + paraloc:=p.paraloc[callerside].add_location; + paraloc^.loc:=LOC_REGISTER; + paraloc^.size:=def_cgsize(p.vardef); + { pattern is always uppercase'd } + if s='D0' then + paraloc^.register:=NR_D0 + else if s='D1' then + paraloc^.register:=NR_D1 + else if s='D2' then + paraloc^.register:=NR_D2 + else if s='D3' then + paraloc^.register:=NR_D3 + else if s='D4' then + paraloc^.register:=NR_D4 + else if s='D5' then + paraloc^.register:=NR_D5 + else if s='D6' then + paraloc^.register:=NR_D6 + else if s='D7' then + paraloc^.register:=NR_D7 + else if s='A0' then + paraloc^.register:=NR_A0 + else if s='A1' then + paraloc^.register:=NR_A1 + else if s='A2' then + paraloc^.register:=NR_A2 + else if s='A3' then + paraloc^.register:=NR_A3 + else if s='A4' then + paraloc^.register:=NR_A4 + else if s='A5' then + paraloc^.register:=NR_A5 + { 'A6' is problematic, since it's the frame pointer in fpc, + so it should be saved before a call! } + else if s='A6' then + paraloc^.register:=NR_A6 + { 'A7' is the stack pointer on 68k, can't be overwritten by API calls } + else + exit; + + { copy to callee side } + p.paraloc[calleeside].add_location^:=paraloc^; + end; + else + internalerror(200405092); + end; + result:=true; + end; + + + procedure tm68kparamanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara); + var + paraloc : pcgparalocation; + begin + paraloc:=parasym.paraloc[callerside].location; + { Never a need for temps when value is pushed (calls inside parameters + will simply allocate even more stack space for their parameters) } + if not(use_fixed_stack) then + can_use_final_stack_loc:=true; + inherited createtempparaloc(list,calloption,parasym,can_use_final_stack_loc,cgpara); + end; + + function tm68kparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint; + var + cur_stack_offset: aword; + curintreg, curfloatreg: tsuperregister; + begin + init_values(curintreg,curfloatreg,cur_stack_offset); + + result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,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,cur_stack_offset) + else + internalerror(200410231); + end; + + +begin + paramanager:=tm68kparamanager.create; +end. diff --git a/closures/compiler/m68k/cpupi.pas b/closures/compiler/m68k/cpupi.pas new file mode 100644 index 0000000000..2ed0f87dae --- /dev/null +++ b/closures/compiler/m68k/cpupi.pas @@ -0,0 +1,41 @@ +{ + 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 + procinfo,cgbase,psub; + + type + tm68kprocinfo = class(tcgprocinfo) + end; + + implementation + +begin + cprocinfo:=tm68kprocinfo; +end. diff --git a/closures/compiler/m68k/cputarg.pas b/closures/compiler/m68k/cputarg.pas new file mode 100644 index 0000000000..ad73f0f145 --- /dev/null +++ b/closures/compiler/m68k/cputarg.pas @@ -0,0 +1,61 @@ +{ + Copyright (c) 2001-2002 by Peter Vreman + + Includes the m68k 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 NOTARGETAMIGA} + ,t_amiga + {$endif} + {$ifndef NOTARGETPALMOS} + ,t_palmos + {$endif} + +{************************************** + Assembler Readers +**************************************} + + ,ra68kmot + +{************************************** + Assemblers +**************************************} + + ,ag68kgas + ; + +end. diff --git a/closures/compiler/m68k/itcpugas.pas b/closures/compiler/m68k/itcpugas.pas new file mode 100644 index 0000000000..2f70bec349 --- /dev/null +++ b/closures/compiler/m68k/itcpugas.pas @@ -0,0 +1,138 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit contains the m68k 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 + gas_op2str : op2strtable= + { warning: CPU32 opcodes are not fully compatible with the MC68020. } + { 68000 only opcodes } + ( '', + 'abcd','add','adda','addi','addq','addx','and','andi', + 'asl','asr','bcc','bcs','beq','bge','bgt','bhi', + 'ble','bls','blt','bmi','bne','bpl','bvc','bvs', + 'bchg','bclr','bra','bset','bsr','btst','chk', + 'clr','cmp','cmpa','cmpi','cmpm','dbcc','dbcs','dbeq','dbge', + 'dbgt','dbhi','dble','dbls','dblt','dbmi','dbne','dbra', + 'dbpl','dbt','dbvc','dbvs','dbf','divs','divu', + 'eor','eori','exg','illegal','ext','jmp','jsr', + 'lea','link','lsl','lsr','move','movea','movei','moveq', + 'movem','movep','muls','mulu','nbcd','neg','negx', + 'nop','not','or','ori','pea','rol','ror','roxl', + 'roxr','rtr','rts','sbcd','scc','scs','seq','sge', + 'sgt','shi','sle','sls','slt','smi','sne', + 'spl','st','svc','svs','sf','sub','suba','subi','subq', + 'subx','swap','tas','trap','trapv','tst','unlk', + 'rte','reset','stop', + { mc68010 instructions } + 'bkpt','movec','moves','rtd', + { mc68020 instructions } + 'bfchg','bfclr','bfexts','bfextu','bfffo', + 'bfins','bfset','bftst','callm','cas','cas2', + 'chk2','cmp2','divsl','divul','extb','pack','rtm', + 'trapcc','tracs','trapeq','trapf','trapge','trapgt', + 'traphi','traple','trapls','traplt','trapmi','trapne', + 'trappl','trapt','trapvc','trapvs','unpk', + { fpu processor instructions - directly supported only. } + { ieee aware and misc. condition codes not supported } + 'fabs','fadd', + 'fbeq','fbne','fbngt','fbgt','fbge','fbnge', + 'fblt','fbnlt','fble','fbgl','fbngl','fbgle','fbngle', + 'fdbeq','fdbne','fdbgt','fdbngt','fdbge','fdbnge', + 'fdblt','fdbnlt','fdble','fdbgl','fdbngl','fdbgle','fdbngle', + 'fseq','fsne','fsgt','fsngt','fsge','fsnge', + 'fslt','fsnlt','fsle','fsgl','fsngl','fsgle','fsngle', + 'fcmp','fdiv','fmove','fmovem', + 'fmul','fneg','fnop','fsqrt','fsub','fsgldiv', + 'fsflmul','ftst', + 'ftrapeq','ftrapne','ftrapgt','ftrapngt','ftrapge','ftrapnge', + 'ftraplt','ftrapnlt','ftraple','ftrapgl','ftrapngl','ftrapgle','ftrapngle', + { protected instructions } + 'cprestore','cpsave', + { fpu unit protected instructions } + { and 68030/68851 common mmu instructions } + { (this may include 68040 mmu instructions) } + 'frestore','fsave','pflush','pflusha','pload','pmove','ptest', + { useful for assembly language output } + 'label','db','s','b','fb'); + + function gas_regnum_search(const s:string):Tregister; + function gas_regname(r:Tregister):string; + + implementation + + const + gas_regname_table : array[tregisterindex] of string[7] = ( + {r386att.inc contains the AT&T name of each register.} + {$i r68kgas.inc} + ); + + gas_regname_index : array[tregisterindex] of tregisterindex = ( + {r386ari.inc contains an index which sorts att_regname_table by + ATT name.} + {$i r68kgri.inc} + ); + + + function findreg_by_gasname(const s:string):byte; + 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. diff --git a/closures/compiler/m68k/m68kreg.dat b/closures/compiler/m68k/m68kreg.dat new file mode 100644 index 0000000000..9ff2289155 --- /dev/null +++ b/closures/compiler/m68k/m68kreg.dat @@ -0,0 +1,44 @@ +; +; Motorola 680x0 registers +; +; layout +; <name>,<type>,<value>,<stdname>,<stabidx> +; +NO,$00,$00,INVALID,INVALID,-1 + +D0,$01,$00,d0,%d0,0 +D1,$01,$01,d1,%d1,1 +D2,$01,$02,d2,%d2,2 +D3,$01,$03,d3,%d3,3 +D4,$01,$04,d4,%d4,4 +D5,$01,$05,d5,%d5,5 +D6,$01,$06,d6,%d6,6 +D7,$01,$07,d7,%d7,7 + +FP0,$02,$00,fp0,%fp0,16 +FP1,$02,$01,fp1,%fp1,17 +FP2,$02,$02,fp2,%fp2,18 +FP3,$02,$03,fp3,%fp3,19 +FP4,$02,$04,fp4,%fp4,20 +FP5,$02,$05,fp5,%fp5,21 +FP6,$02,$06,fp6,%fp6,22 +FP7,$02,$07,fp7,%fp7,23 + +PC,$05,$00,pc,%pc,24 +CCR,$05,$01,ccr,%ccr,0 +FPCR,$05,$02,fpcr,%fpcr,0 +SR,$05,$03,sr,%sr,0 +SSP,$05,$04,ssp,%ssp,0 +DFC,$05,$05,dfc,%dfc,0 +SFC,$05,$06,sfc,%sfc,0 +VBR,$05,$07,vbr,%vbr,0 +FPSR,$05,$08,fpsr,%fpsr,0 + +A0,$06,$00,a0,%a0,8 +A1,$06,$01,a1,%a1,9 +A2,$06,$02,a2,%a2,10 +A3,$06,$03,a3,%a3,11 +A4,$06,$04,a4,%a4,12 +A5,$06,$05,a5,%a5,13 +A6,$06,$06,a6,%a6,14 +SP,$06,$07,sp,%sp,15 diff --git a/closures/compiler/m68k/n68kadd.pas b/closures/compiler/m68k/n68kadd.pas new file mode 100644 index 0000000000..0c243c55ca --- /dev/null +++ b/closures/compiler/m68k/n68kadd.pas @@ -0,0 +1,546 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl and Jonas Maebe + + Code generation for add nodes on the Motorola 680x0 family + + 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 n68kadd; + +{$i fpcdefs.inc} + +interface + + uses + node,nadd,ncgadd,cpubase; + + + type + t68kaddnode = 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; + procedure second_cmpboolean;override; + end; + + +implementation + + uses + globtype,systems, + cutils,verbose,globals, + symconst,symdef,paramgr, + aasmbase,aasmtai,aasmdata,aasmcpu,defutil,htypechk, + cgbase,cpuinfo,pass_1,pass_2,regvars, + cpupara,cgutils,procinfo, + ncon,nset, + ncgutil,tgobj,rgobj,rgcpu,cgobj,cg64f32; + +{***************************************************************************** + Helpers +*****************************************************************************} + + + function t68kaddnode.getresflags(unsigned : boolean) : tresflags; + begin + case nodetype of + equaln : getresflags:=F_E; + unequaln : getresflags:=F_NE; + else + if not(unsigned) then + begin + if nf_swapped in flags then + case nodetype of + ltn : getresflags:=F_G; + lten : getresflags:=F_GE; + gtn : getresflags:=F_L; + gten : getresflags:=F_LE; + end + else + case nodetype of + ltn : getresflags:=F_L; + lten : getresflags:=F_LE; + gtn : getresflags:=F_G; + gten : getresflags:=F_GE; + end; + end + else + begin + if nf_swapped in flags then + case nodetype of + ltn : getresflags:=F_A; + lten : getresflags:=F_AE; + gtn : getresflags:=F_B; + gten : getresflags:=F_BE; + end + else + case nodetype of + ltn : getresflags:=F_B; + lten : getresflags:=F_BE; + gtn : getresflags:=F_A; + gten : getresflags:=F_AE; + end; + end; + end; + end; + +{***************************************************************************** + AddFloat +*****************************************************************************} + + procedure t68kaddnode.second_addfloat; + var + op : TAsmOp; + cmpop : boolean; + begin + pass_left_right; + + cmpop:=false; + case nodetype of + addn : + op:=A_FADD; + muln : + op:=A_FMUL; + subn : + op:=A_FSUB; + slashn : + op:=A_FDIV; + ltn,lten,gtn,gten, + equaln,unequaln : + begin +// op:=A_FCMPO; + cmpop:=true; + end; + else + internalerror(200403182); + end; + + // get the operands in the correct order, there are no special cases + // here, everything is register-based + if nf_swapped in flags then + swapleftright; + + // put both operands in a register + location_force_fpureg(current_asmdata.CurrAsmList,right.location,true); + location_force_fpureg(current_asmdata.CurrAsmList,left.location,true); + + // initialize de result + if not cmpop then + begin + location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); + if left.location.loc = LOC_FPUREGISTER then + location.register := left.location.register + else if right.location.loc = LOC_FPUREGISTER then + location.register := right.location.register + else + location.register := cg.getfpuregister(current_asmdata.CurrAsmList,location.size); + end + else + begin + location_reset(location,LOC_FLAGS,OS_NO); + // FIX ME! +// location.resflags := getresflags; + end; + + // emit the actual operation + if not cmpop then + begin + { + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op, + location.register,left.location.register, + right.location.register)) + } + end + else + begin +{ current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op, + newreg(R_SPECIALREGISTER,location.resflags.cr,R_SUBNONE),left.location.register,right.location.register))} + end; + end; + + + procedure t68kaddnode.second_cmpfloat; + begin + pass_left_right; + +{ + if (nf_swapped in flags) then + swapleftright; +} + { force fpureg as location, left right doesn't matter + as both will be in a fpureg } + location_force_fpureg(current_asmdata.CurrAsmList,left.location,true); + location_force_fpureg(current_asmdata.CurrAsmList,right.location,true); + + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=getresflags(true); +{ + if nodetype in [equaln,unequaln] then + current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_CMF, + left.location.register,right.location.register), + cgsize2fpuoppostfix[def_cgsize(resultdef)])) + else + current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_CMFE, + left.location.register,right.location.register), + cgsize2fpuoppostfix[def_cgsize(resultdef)])); + + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=getresflags(false); +} + end; + + + + +{***************************************************************************** + Smallsets +*****************************************************************************} + + procedure t68kaddnode.second_cmpsmallset; + var + tmpreg : tregister; + begin + location_reset(location,LOC_FLAGS,OS_NO); + + case nodetype of + equaln, + unequaln : + begin + {emit_compare(true);} + end; + lten,gten: + begin + If (not(nf_swapped in flags) and + (nodetype = lten)) or + ((nf_swapped in flags) and + (nodetype = gten)) then + swapleftright; + // now we have to check whether left >= right + tmpreg := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + if left.location.loc = LOC_CONSTANT then + begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_AND,OS_INT, + not(left.location.value),right.location.register,tmpreg); + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_L,tmpreg)); + // the two instructions above should be folded together by + // the peepholeoptimizer + end + else + begin + if right.location.loc = LOC_CONSTANT then + begin + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT, + aword(right.location.value),tmpreg); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_AND,S_L, + tmpreg,left.location.register)); + end + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_AND,S_L, + right.location.register,left.location.register)); + end; +// cg.ungetcpuregister(current_asmdata.CurrAsmList,tmpreg); + location.resflags := getresflags(true); + end; + else + internalerror(2002072701); + end; + + + end; + + +{***************************************************************************** + Ordinals +*****************************************************************************} + + procedure t68kaddnode.second_cmpordinal; + var + unsigned : boolean; + useconst : boolean; + tmpreg : tregister; + op : tasmop; + begin +// writeln('second_cmpordinal'); + pass_left_right; + { set result location } + location_reset(location,LOC_JUMP,OS_NO); + + { load values into registers (except constants) } + force_reg_left_right(true, false); + + { determine if the comparison will be unsigned } + unsigned:=not(is_signed(left.resultdef)) or + not(is_signed(right.resultdef)); + + // get the constant on the right if there is one + if (left.location.loc = LOC_CONSTANT) then + swapleftright; + // can we use an immediate, or do we have to load the + // constant in a register first? + if (right.location.loc = LOC_CONSTANT) then + begin +{$ifdef extdebug} + if (right.location.size in [OS_64,OS_S64]) and (hi(right.location.value64)<>0) and ((hi(right.location.value64)<>-1) or unsigned) then + internalerror(2002080301); +{$endif extdebug} + if (nodetype in [equaln,unequaln]) then + if (unsigned and + (right.location.value > high(word))) or + (not unsigned and + (longint(right.location.value) < low(smallint)) or + (longint(right.location.value) > high(smallint))) then + { we can then maybe use a constant in the 'othersigned' case + (the sign doesn't matter for // equal/unequal)} + unsigned := not unsigned; + + if (unsigned and + ((right.location.value) <= high(word))) or + (not(unsigned) and + (longint(right.location.value) >= low(smallint)) and + (longint(right.location.value) <= high(smallint))) then + useconst := true + else + begin + useconst := false; + tmpreg := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT, + aword(right.location.value),tmpreg); + end + end + else + useconst := false; + location.loc := LOC_FLAGS; + location.resflags := getresflags(unsigned); + op := A_CMP; + if (right.location.loc = LOC_CONSTANT) then + if useconst then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(op,S_L, + left.location.register,longint(right.location.value))) + else + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,S_L, + left.location.register,tmpreg)); +// cg.ungetcpuregister(current_asmdata.CurrAsmList,tmpreg); + end + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,S_L, + left.location.register,right.location.register)); + end; + +{***************************************************************************** + Boolean +*****************************************************************************} + + procedure t68kaddnode.second_cmpboolean; + var + cgop : TOpCg; + cgsize : TCgSize; + isjump : boolean; + otl,ofl : tasmlabel; + begin +// writeln('second_cmpboolean'); + if (torddef(left.resultdef).ordtype in [pasbool8,bool8bit]) or + (torddef(right.resultdef).ordtype in [pasbool8,bool8bit]) then + cgsize:=OS_8 + else + if (torddef(left.resultdef).ordtype in [pasbool16,bool16bit]) or + (torddef(right.resultdef).ordtype in [pasbool16,bool16bit]) then + cgsize:=OS_16 + else + cgsize:=OS_32; + + if (cs_full_boolean_eval in current_settings.localswitches) or + (nodetype in [unequaln,ltn,lten,gtn,gten,equaln,xorn]) then + begin + if left.nodetype in [ordconstn,realconstn] then + swapleftright; + + isjump:=(left.location.loc=LOC_JUMP); + if isjump then + begin + otl:=current_procinfo.CurrTrueLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + ofl:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + end; + secondpass(left); + if left.location.loc in [LOC_FLAGS,LOC_JUMP] then begin +// writeln('ajjaj'); + location_force_reg(current_asmdata.CurrAsmList,left.location,cgsize,false); +// writeln('reccs?'); + end; + if isjump then + begin + current_procinfo.CurrTrueLabel:=otl; + current_procinfo.CurrFalseLabel:=ofl; + end; + + isjump:=(right.location.loc=LOC_JUMP); + if isjump then + begin + otl:=current_procinfo.CurrTrueLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + ofl:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + end; + secondpass(right); + if right.location.loc in [LOC_FLAGS,LOC_JUMP] then + location_force_reg(current_asmdata.CurrAsmList,right.location,cgsize,false); + if isjump then + begin + current_procinfo.CurrTrueLabel:=otl; + current_procinfo.CurrFalseLabel:=ofl; + end; + + location_reset(location,LOC_FLAGS,OS_NO); + + force_reg_left_right(true,false); + + if (left.location.loc = LOC_CONSTANT) then + swapleftright; + + if (right.location.loc <> LOC_CONSTANT) then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,S_L, + left.location.register,right.location.register)) + else + current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,S_L, + longint(right.location.value),left.location.register)); + location.resflags := getresflags(true); + end; + + //release_reg_left_right; + end; + + +{***************************************************************************** + 64-bit +*****************************************************************************} + + procedure t68kaddnode.second_cmp64bit; + begin + // writeln('second_cmp64bit'); + pass_left_right; + + +// load_left_right(true,false); +(* + case nodetype of + ltn,lten, + gtn,gten: + begin + emit_cmp64_hi; + firstjmp64bitcmp; + emit_cmp64_lo; + secondjmp64bitcmp; + end; + equaln,unequaln: + begin + // instead of doing a complicated compare, do + // (left.hi xor right.hi) or (left.lo xor right.lo) + // (somewhate optimized so that no superfluous 'mr's are + // generated) + if (left.location.loc = LOC_CONSTANT) then + swapleftright; + if (right.location.loc = LOC_CONSTANT) then + begin + if left.location.loc = LOC_REGISTER then + begin + tempreg64.reglo := left.location.register64.reglo; + tempreg64.reghi := left.location.register64.reghi; + end + else + begin + if (aword(right.location.valueqword) <> 0) then + tempreg64.reglo := cg.getintregister(current_asmdata.CurrAsmList) + else + tempreg64.reglo := left.location.register64.reglo; + if ((right.location.valueqword shr 32) <> 0) then + tempreg64.reghi := cg.getintregister(current_asmdata.CurrAsmList) + else + tempreg64.reghi := left.location.register64.reghi; + end; + + if (aword(right.location.valueqword) <> 0) then + { negative values can be handled using SUB, } + { positive values < 65535 using XOR. } + if (longint(right.location.valueqword) >= -32767) and + (longint(right.location.valueqword) < 0) then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT, + aword(right.location.valueqword), + left.location.register64.reglo,tempreg64.reglo) + else + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_INT, + aword(right.location.valueqword), + left.location.register64.reglo,tempreg64.reglo); + + if ((right.location.valueqword shr 32) <> 0) then + if (longint(right.location.valueqword shr 32) >= -32767) and + (longint(right.location.valueqword shr 32) < 0) then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT, + aword(right.location.valueqword shr 32), + left.location.register64.reghi,tempreg64.reghi) + else + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_INT, + aword(right.location.valueqword shr 32), + left.location.register64.reghi,tempreg64.reghi); + end + else + begin + tempreg64.reglo := cg.getintregister(current_asmdata.CurrAsmList); + tempreg64.reghi := cg.getintregister(current_asmdata.CurrAsmList); + cg64.a_op64_reg_reg_reg(current_asmdata.CurrAsmList,OP_XOR, + left.location.register64,right.location.register64, + tempreg64); + end; + + cg.a_reg_alloc(current_asmdata.CurrAsmList,R_0); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_OR_,R_0, + tempreg64.reglo,tempreg64.reghi)); + cg.a_reg_dealloc(current_asmdata.CurrAsmList,R_0); + if (tempreg64.reglo <> left.location.register64.reglo) then + cg.ungetregister(current_asmdata.CurrAsmList,tempreg64.reglo); + if (tempreg64.reghi <> left.location.register64.reghi) then + cg.ungetregister(current_asmdata.CurrAsmList,tempreg64.reghi); + + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags := getresflags; + end; + else + internalerror(2002072803); + end; + + + { set result location } + { (emit_compare sets it to LOC_FLAGS for compares, so set the } + { real location only now) (JM) } + if cmpop and + not(nodetype in [equaln,unequaln]) then + location_reset(location,LOC_JUMP,OS_NO); +*) + location_reset(location,LOC_JUMP,OS_NO); + // writeln('second_cmp64_exit'); + end; + + +begin + caddnode:=t68kaddnode; +end. diff --git a/closures/compiler/m68k/n68kcal.pas b/closures/compiler/m68k/n68kcal.pas new file mode 100644 index 0000000000..d9763acd9a --- /dev/null +++ b/closures/compiler/m68k/n68kcal.pas @@ -0,0 +1,86 @@ +{ + Copyright (c) 2002 by Florian Klaempfl + + Implements the M68K 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 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 n68kcal; + +{$i fpcdefs.inc} + +interface + + uses + symdef,node,ncal,ncgcal; + + type + tm68kcallnode = class(tcgcallnode) + procedure do_syscall;override; + end; + + +implementation + + uses + globtype,systems, + cutils,verbose,globals, + symconst,symbase,symsym,symtable,defutil,paramgr,parabase, + cgbase,pass_2, + cpuinfo,cpubase,aasmbase,aasmtai,aasmdata,aasmcpu, + nmem,nld,ncnv, + ncgutil,cgutils,cgobj,tgobj,regvars,rgobj,rgcpu, + cg64f32,cgcpu,cpupi,procinfo; + + + procedure tm68kcallnode.do_syscall; + var + tmpref: treference; + tmpref2: treference; + begin + case target_info.system of + system_m68k_amiga: + begin + if po_syscall_legacy in tprocdef(procdefinition).procoptions then + begin + { save base pointer on syscalls } + { FIXME: probably this will need to be extended to save all regs (KB) } + reference_reset_base(tmpref2, NR_STACK_POINTER_REG, 0, 4); + tmpref2.direction := dir_dec; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_ref(A_MOVE,S_L,NR_FRAME_POINTER_REG,tmpref2)); + + { the actuall call } + reference_reset_base(tmpref,NR_A6,-tprocdef(procdefinition).extnumber,4); + current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_JSR,S_NO,tmpref)); + + { restore frame pointer } + reference_reset_base(tmpref2, NR_STACK_POINTER_REG, 0, 4); + tmpref2.direction := dir_inc; + current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(A_MOVE,S_L,tmpref2,NR_FRAME_POINTER_REG)); + end + else + internalerror(2005010403); + end; + else + internalerror(2004042901); + end; + end; + + +begin + ccallnode:=tm68kcallnode; +end. diff --git a/closures/compiler/m68k/n68kcnv.pas b/closures/compiler/m68k/n68kcnv.pas new file mode 100644 index 0000000000..8dde10c83d --- /dev/null +++ b/closures/compiler/m68k/n68kcnv.pas @@ -0,0 +1,257 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate m68k 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 n68kcnv; + +{$i fpcdefs.inc} + +interface + + uses + node,ncnv,ncgcnv,defcmp; + + type + tm68ktypeconvnode = class(tcgtypeconvnode) + protected + function first_int_to_real: tnode; override; + procedure second_int_to_real;override; + procedure second_int_to_bool;override; +// procedure pass_generate_code;override; + end; + +implementation + + uses + verbose,globals,systems, + symconst,symdef,aasmbase,aasmtai,aasmdata, + defutil, + cgbase,pass_1,pass_2, + ncon,ncal, + ncgutil, + cpubase,aasmcpu, + rgobj,tgobj,cgobj,cgutils,globtype,cgcpu; + + +{***************************************************************************** + FirstTypeConv +*****************************************************************************} + + function tm68ktypeconvnode.first_int_to_real: tnode; + var + fname: string[32]; + begin + { In case we are in emulation mode, we must + always call the helpers + } + if (cs_fp_emulation in current_settings.moduleswitches) then + begin + result := inherited first_int_to_real; + exit; + end + else + { converting a 64bit integer to a float requires a helper } + if is_64bitint(left.resultdef) then + begin + if is_signed(left.resultdef) 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.resultdef) then + inserttypeconv(left,s32inttype) + else + { the fpu always considers 32-bit values as signed + therefore we need to call the helper in case of + a cardinal value. + } + begin + fname := 'fpc_longword_to_double'; + result := ccallnode.createintern(fname,ccallparanode.create( + left,nil)); + left:=nil; + firstpass(result); + exit; + end; + firstpass(left); + end; + result := nil; + location.loc:=LOC_FPUREGISTER; + end; + + +{***************************************************************************** + SecondTypeConv +*****************************************************************************} + + + + procedure tm68ktypeconvnode.second_int_to_real; + + var + tempconst: trealconstnode; + ref: treference; + valuereg, tempreg, leftreg, tmpfpureg: tregister; + signed : boolean; + scratch_used : boolean; + opsize : tcgsize; + begin + scratch_used := false; + location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); + signed := is_signed(left.resultdef); + opsize := def_cgsize(left.resultdef); + { has to be handled by a helper } + if is_64bitint(left.resultdef) then + internalerror(200110011); + { has to be handled by a helper } + if not signed then + internalerror(20020814); + + location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,opsize); + if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_REFERENCE,LOC_CREFERENCE]) then + location_force_reg(current_asmdata.CurrAsmList,left.location,OS_INT,false); + case left.location.loc of + LOC_REGISTER, LOC_CREGISTER: + begin + leftreg := left.location.register; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FMOVE,TCGSize2OpSize[opsize],leftreg, + location.register)); + end; + LOC_REFERENCE,LOC_CREFERENCE: + begin + current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(A_FMOVE,TCGSize2OpSize[opsize], + left.location.reference,location.register)); + end + else + internalerror(200110012); + end; + end; + + + procedure tm68ktypeconvnode.second_int_to_bool; + var + hreg1, + hreg2 : tregister; + resflags : tresflags; + opsize : tcgsize; + newsize : tcgsize; + begin + secondpass(left); + +{ TODO: needs LOC_JUMP support, because called for bool_to_bool from ncgcnv } + + { Explicit typecasts from any ordinal type to a boolean type } + { must not change the ordinal value } + if (nf_explicit in flags) and + not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then + begin + location_copy(location,left.location); + newsize:=def_cgsize(resultdef); + { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend } + if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or + ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then + location_force_reg(current_asmdata.CurrAsmList,location,newsize,true) + else + location.size:=newsize; +{ ACTIVATE when loc_jump support is added + current_procinfo.CurrTrueLabel:=oldTrueLabel; + current_procinfo.CurrFalseLabel:=oldFalseLabel; +} + exit; + end; + + location_reset(location,LOC_REGISTER,def_cgsize(left.resultdef)); + opsize := def_cgsize(left.resultdef); + case left.location.loc of + LOC_CREFERENCE,LOC_REFERENCE : + begin + { can we optimize it, or do we need to fix the ref. ? } + if isvalidrefoffset(left.location.reference) then + begin + current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,TCGSize2OpSize[opsize], + left.location.reference)); + end + else + begin + hreg2:=cg.getintregister(current_asmdata.CurrAsmList,opsize); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,opsize,opsize, + left.location.reference,hreg2); + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[opsize],hreg2)); +// cg.ungetcpuregister(current_asmdata.CurrAsmList,hreg2); + end; +// reference_release(current_asmdata.CurrAsmList,left.location.reference); + resflags:=F_NE; + hreg1:=cg.getintregister(current_asmdata.CurrAsmList,opsize); + end; + LOC_REGISTER,LOC_CREGISTER : + begin + hreg2:=left.location.register; + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[opsize],hreg2)); +// cg.ungetcpuregister(current_asmdata.CurrAsmList,hreg2); + hreg1:=cg.getintregister(current_asmdata.CurrAsmList,opsize); + resflags:=F_NE; + end; + LOC_FLAGS : + begin + hreg1:=cg.getintregister(current_asmdata.CurrAsmList,opsize); + resflags:=left.location.resflags; + end; + else + internalerror(200512182); + end; + cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,hreg1); + if (is_cbool(resultdef)) then + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,hreg1,hreg1); + location.register := hreg1; + end; + +{ + procedure tm68ktypeconvnode.pass_generate_code; +{$ifdef TESTOBJEXT2} + var + r : preference; + nillabel : plabel; +{$endif TESTOBJEXT2} + begin + { this isn't good coding, I think tc_bool_2_int, shouldn't be } + { type conversion (FK) } + + if not(convtype in [tc_bool_2_int,tc_bool_2_bool]) then + begin + secondpass(left); + location_copy(location,left.location); + if codegenerror then + exit; + end; + second_call_helper(convtype); + end; +} + +begin + ctypeconvnode:=tm68ktypeconvnode; +end. diff --git a/closures/compiler/m68k/n68kmat.pas b/closures/compiler/m68k/n68kmat.pas new file mode 100644 index 0000000000..453ec29895 --- /dev/null +++ b/closures/compiler/m68k/n68kmat.pas @@ -0,0 +1,361 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate 680x0 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 n68kmat; + +{$i fpcdefs.inc} + +interface + + uses + node,nmat,ncgmat,cpubase,cgbase; + + type + + + tm68knotnode = class(tnotnode) + procedure pass_generate_code;override; + end; + + tm68kmoddivnode = class(tcgmoddivnode) + procedure emit_div_reg_reg(signed: boolean;denum,num : tregister);override; + procedure emit_mod_reg_reg(signed: boolean;denum,num : tregister);override; + end; + + tm68kshlshrnode = class(tshlshrnode) + procedure pass_generate_code;override; + { everything will be handled in pass_2 } + function first_shlshr64bitint: tnode; override; + end; + + +implementation + + uses + globtype,systems, + cutils,verbose,globals, + symconst,symdef,aasmbase,aasmtai,aasmdata,aasmcpu, + pass_1,pass_2,procinfo, + ncon, + cpuinfo,paramgr,defutil,parabase, + tgobj,ncgutil,cgobj,cgutils,rgobj,rgcpu,cgcpu,cg64f32; + + + + +{***************************************************************************** + TM68KNOTNODE +*****************************************************************************} + + procedure tm68knotnode.pass_generate_code; + var + hl : tasmlabel; + opsize : tcgsize; + begin + opsize:=def_cgsize(resultdef); + if is_boolean(resultdef) then + begin + { the second pass could change the location of left } + { if it is a register variable, so we've to do } + { this before the case statement } + if left.location.loc<>LOC_JUMP then + secondpass(left); + + case left.location.loc of + LOC_JUMP : + begin + location_reset(location,LOC_JUMP,OS_NO); + hl:=current_procinfo.CurrTrueLabel; + current_procinfo.CurrTrueLabel:=current_procinfo.CurrFalseLabel; + current_procinfo.CurrFalseLabel:=hl; + secondpass(left); + maketojumpbool(current_asmdata.CurrAsmList,left,lr_load_regvars); + hl:=current_procinfo.CurrTrueLabel; + current_procinfo.CurrTrueLabel:=current_procinfo.CurrFalseLabel; + current_procinfo.CurrFalseLabel:=hl; + end; + LOC_FLAGS : + begin + location_copy(location,left.location); +// location_release(current_asmdata.CurrAsmList,left.location); + inverse_flags(location.resflags); + end; + LOC_CONSTANT, + LOC_REGISTER, + LOC_CREGISTER, + LOC_REFERENCE, + LOC_CREFERENCE : + begin + location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(resultdef),true); + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,tcgsize2opsize[opsize],left.location.register)); +// location_release(current_asmdata.CurrAsmList,left.location); + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=F_E; + end; + else + internalerror(200203224); + end; + end + else if is_64bitint(left.resultdef) then + begin + secondpass(left); + location_copy(location,left.location); + location_force_reg(current_asmdata.CurrAsmList,location,OS_64,false); + cg64.a_op64_loc_reg(current_asmdata.CurrAsmList,OP_NOT,OS_64,location, + joinreg64(location.register64.reglo,location.register64.reghi)); + end + else + begin + secondpass(left); + location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),false); + location_copy(location,left.location); + if location.loc=LOC_CREGISTER then + location.register := cg.getintregister(current_asmdata.CurrAsmList,opsize); + { perform the NOT operation } + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NOT,opsize,location.register,left.location.register); + end; + end; + + +{***************************************************************************** + TM68KMODDIVNODE +*****************************************************************************} + procedure tm68kmoddivnode.emit_div_reg_reg(signed: boolean;denum,num : tregister); + var + continuelabel : tasmlabel; + reg_d0,reg_d1 : tregister; + paraloc1 : tcgpara; + begin + { no RTL call, so inline a zero denominator verification } + if current_settings.cputype <> cpu_MC68000 then + begin + { verify if denominator is zero } + current_asmdata.getjumplabel(continuelabel); + { compare against zero, if not zero continue } + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_S32,OC_NE,0,denum,continuelabel); +// paraloc1.init; +// cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_S32,200,paramanager.getintparaloc(pocall_default,1,paraloc1)); + + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_HANDLEERROR',false); + cg.a_label(current_asmdata.CurrAsmList, continuelabel); + if signed then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_DIVS,S_L,denum,num)) + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_DIVU,S_L,denum,num)); + { result should be in denuminator } + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,num,denum); + end + else + begin + { On MC68000/68010 mw must pass through RTL routines } + reg_d0:=NR_D0; + cg.getcpuregister(current_asmdata.CurrAsmList,NR_D0); + reg_d1:=NR_D1; + cg.getcpuregister(current_asmdata.CurrAsmList,NR_D1); + { put numerator in d0 } + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,num,reg_d0); + { put denum in D1 } + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,denum,reg_d1); + if signed then + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DIV_LONGINT',false) + else + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DIV_CARDINAL',false); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,reg_d0,denum); + cg.ungetcpuregister(current_asmdata.CurrAsmList,reg_d0); + cg.ungetcpuregister(current_asmdata.CurrAsmList,reg_d1); + end; + end; + + + procedure tm68kmoddivnode.emit_mod_reg_reg(signed: boolean;denum,num : tregister); + var tmpreg : tregister; + continuelabel : tasmlabel; + signlabel : tasmlabel; + reg_d0,reg_d1 : tregister; + begin +// writeln('emit mod reg reg'); + { no RTL call, so inline a zero denominator verification } + if current_settings.cputype <> cpu_MC68000 then + begin + { verify if denominator is zero } + current_asmdata.getjumplabel(continuelabel); + { compare against zero, if not zero continue } + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_S32,OC_NE,0,denum,continuelabel); +// cg.a_load_const_cgpara(current_asmdata.CurrAsmList, OS_S32,200,paramanager.getintparaloc(pocall_default,1)); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_HANDLEERROR',false); + cg.a_label(current_asmdata.CurrAsmList, continuelabel); + + tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + + { we have to prepare the high register with the } + { correct sign. i.e we clear it, check if the low dword reg } + { which will participate in the division is signed, if so we} + { we extend the sign to the high doword register by inverting } + { all the bits. } + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_CLR,S_L,tmpreg)); + current_asmdata.getjumplabel(signlabel); + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_L,tmpreg)); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_S32,OC_A,0,tmpreg,signlabel); + { its a negative value, therefore change sign } + cg.a_label(current_asmdata.CurrAsmList,signlabel); + { tmpreg:num / denum } + + if signed then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_DIVSL,S_L,denum,tmpreg,num)) + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_DIVUL,S_L,denum,tmpreg,num)); + { remainder in tmpreg } + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,tmpreg,denum); +// cg.ungetcpuregister(current_asmdata.CurrAsmList,tmpreg); + end + else + begin + { On MC68000/68010 mw must pass through RTL routines } + Reg_d0:=NR_D0; + cg.getcpuregister(current_asmdata.CurrAsmList,NR_D0); + Reg_d1:=NR_D1; + cg.getcpuregister(current_asmdata.CurrAsmList,NR_D1); + { put numerator in d0 } + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,num,Reg_D0); + { put denum in D1 } + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,denum,Reg_D1); + if signed then + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_MOD_LONGINT',false) + else + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_MOD_CARDINAL',false); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,Reg_D0,denum); + cg.ungetcpuregister(current_asmdata.CurrAsmList,Reg_D0); + cg.ungetcpuregister(current_asmdata.CurrAsmList,Reg_D1); + end; +// writeln('exits'); + end; + + +{***************************************************************************** + TM68KSHLRSHRNODE +*****************************************************************************} + + function tm68kShlShrNode.first_shlshr64bitint:TNode; + begin + { 2nd pass is our friend } + result := nil; + end; + + +{ TODO: FIX ME!!! shlshrnode needs review} + procedure tm68kshlshrnode.pass_generate_code; + var + hregister,resultreg,hregister1, + hreg64hi,hreg64lo : tregister; + op : topcg; + shiftval: aint; + begin + secondpass(left); + secondpass(right); + if is_64bit(left.resultdef) then + begin + location_reset(location,LOC_REGISTER,OS_64); + + { load left operator in a register } + location_force_reg(current_asmdata.CurrAsmList,left.location,OS_64,false); + hreg64hi:=left.location.register64.reghi; + hreg64lo:=left.location.register64.reglo; + + shiftval := tordconstnode(right).value.svalue; + shiftval := shiftval and 63; + if shiftval > 31 then + begin + if nodetype = shln then + begin + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,hreg64hi); + if (shiftval and 31) <> 0 then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_32,shiftval and 31,hreg64lo,hreg64lo); + end + else + begin + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,hreg64lo); + if (shiftval and 31) <> 0 then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_32,shiftval and 31,hreg64hi,hreg64hi); + end; + location.register64.reglo:=hreg64hi; + location.register64.reghi:=hreg64lo; + end + else + begin + hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + if nodetype = shln then + begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_32,32-shiftval,hreg64lo,hregister); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_32,shiftval,hreg64hi,hreg64hi); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,hregister,hreg64hi,hreg64hi); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_32,shiftval,hreg64lo,hreg64lo); + end + else + begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_32,32-shiftval,hreg64hi,hregister); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_32,shiftval,hreg64lo,hreg64lo); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,hregister,hreg64lo,hreg64lo); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_32,shiftval,hreg64hi,hreg64hi); + end; + location.register64.reghi:=hreg64hi; + location.register64.reglo:=hreg64lo; + end; + end + else + begin + { load left operators in a register } + location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),true); + location_copy(location,left.location); + resultreg := location.register; + hregister1 := location.register; + if (location.loc = LOC_CREGISTER) then + begin + location.loc := LOC_REGISTER; + resultreg := cg.GetIntRegister(current_asmdata.CurrAsmList,OS_INT); + location.register := resultreg; + end; + { determine operator } + if nodetype=shln then + op:=OP_SHL + else + op:=OP_SHR; + { shifting by a constant directly coded: } + if (right.nodetype=ordconstn) then + begin + if tordconstnode(right).value.svalue and 31<>0 then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,op,OS_32,tordconstnode(right).value.svalue and 31,hregister1,resultreg) + end + else + begin + { load shift count in a register if necessary } + location_force_reg(current_asmdata.CurrAsmList,right.location,def_cgsize(right.resultdef),true); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,op,OS_32,right.location.register,hregister1,resultreg); + end; + end; + end; + + + +begin + cnotnode:=tm68knotnode; + cmoddivnode:=tm68kmoddivnode; + cshlshrnode:=tm68kshlshrnode; +end. diff --git a/closures/compiler/m68k/r68kcon.inc b/closures/compiler/m68k/r68kcon.inc new file mode 100644 index 0000000000..2e8f8716fb --- /dev/null +++ b/closures/compiler/m68k/r68kcon.inc @@ -0,0 +1,35 @@ +{ don't edit, this file is generated from m68kreg.dat } +NR_NO = tregister($00000000); +NR_D0 = tregister($01000000); +NR_D1 = tregister($01000001); +NR_D2 = tregister($01000002); +NR_D3 = tregister($01000003); +NR_D4 = tregister($01000004); +NR_D5 = tregister($01000005); +NR_D6 = tregister($01000006); +NR_D7 = tregister($01000007); +NR_FP0 = tregister($02000000); +NR_FP1 = tregister($02000001); +NR_FP2 = tregister($02000002); +NR_FP3 = tregister($02000003); +NR_FP4 = tregister($02000004); +NR_FP5 = tregister($02000005); +NR_FP6 = tregister($02000006); +NR_FP7 = tregister($02000007); +NR_PC = tregister($05000000); +NR_CCR = tregister($05000001); +NR_FPCR = tregister($05000002); +NR_SR = tregister($05000003); +NR_SSP = tregister($05000004); +NR_DFC = tregister($05000005); +NR_SFC = tregister($05000006); +NR_VBR = tregister($05000007); +NR_FPSR = tregister($05000008); +NR_A0 = tregister($06000000); +NR_A1 = tregister($06000001); +NR_A2 = tregister($06000002); +NR_A3 = tregister($06000003); +NR_A4 = tregister($06000004); +NR_A5 = tregister($06000005); +NR_A6 = tregister($06000006); +NR_SP = tregister($06000007); diff --git a/closures/compiler/m68k/r68kgas.inc b/closures/compiler/m68k/r68kgas.inc new file mode 100644 index 0000000000..ee47e9ad64 --- /dev/null +++ b/closures/compiler/m68k/r68kgas.inc @@ -0,0 +1,35 @@ +{ don't edit, this file is generated from m68kreg.dat } +'INVALID', +'%d0', +'%d1', +'%d2', +'%d3', +'%d4', +'%d5', +'%d6', +'%d7', +'%fp0', +'%fp1', +'%fp2', +'%fp3', +'%fp4', +'%fp5', +'%fp6', +'%fp7', +'%pc', +'%ccr', +'%fpcr', +'%sr', +'%ssp', +'%dfc', +'%sfc', +'%vbr', +'%fpsr', +'%a0', +'%a1', +'%a2', +'%a3', +'%a4', +'%a5', +'%a6', +'%sp' diff --git a/closures/compiler/m68k/r68kgri.inc b/closures/compiler/m68k/r68kgri.inc new file mode 100644 index 0000000000..17ba5dc3a9 --- /dev/null +++ b/closures/compiler/m68k/r68kgri.inc @@ -0,0 +1,35 @@ +{ don't edit, this file is generated from m68kreg.dat } +26, +27, +28, +29, +30, +31, +32, +18, +1, +2, +3, +4, +5, +6, +7, +8, +22, +9, +10, +11, +12, +13, +14, +15, +16, +19, +25, +17, +23, +33, +20, +21, +24, +0 diff --git a/closures/compiler/m68k/r68knor.inc b/closures/compiler/m68k/r68knor.inc new file mode 100644 index 0000000000..c1e8cc2f30 --- /dev/null +++ b/closures/compiler/m68k/r68knor.inc @@ -0,0 +1,2 @@ +{ don't edit, this file is generated from m68kreg.dat } +34 diff --git a/closures/compiler/m68k/r68knum.inc b/closures/compiler/m68k/r68knum.inc new file mode 100644 index 0000000000..0dc71ce16f --- /dev/null +++ b/closures/compiler/m68k/r68knum.inc @@ -0,0 +1,35 @@ +{ don't edit, this file is generated from m68kreg.dat } +tregister($00000000), +tregister($01000000), +tregister($01000001), +tregister($01000002), +tregister($01000003), +tregister($01000004), +tregister($01000005), +tregister($01000006), +tregister($01000007), +tregister($02000000), +tregister($02000001), +tregister($02000002), +tregister($02000003), +tregister($02000004), +tregister($02000005), +tregister($02000006), +tregister($02000007), +tregister($05000000), +tregister($05000001), +tregister($05000002), +tregister($05000003), +tregister($05000004), +tregister($05000005), +tregister($05000006), +tregister($05000007), +tregister($05000008), +tregister($06000000), +tregister($06000001), +tregister($06000002), +tregister($06000003), +tregister($06000004), +tregister($06000005), +tregister($06000006), +tregister($06000007) diff --git a/closures/compiler/m68k/r68krni.inc b/closures/compiler/m68k/r68krni.inc new file mode 100644 index 0000000000..d6364bb31a --- /dev/null +++ b/closures/compiler/m68k/r68krni.inc @@ -0,0 +1,35 @@ +{ don't edit, this file is generated from m68kreg.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 diff --git a/closures/compiler/m68k/r68ksri.inc b/closures/compiler/m68k/r68ksri.inc new file mode 100644 index 0000000000..44010ba66a --- /dev/null +++ b/closures/compiler/m68k/r68ksri.inc @@ -0,0 +1,35 @@ +{ don't edit, this file is generated from m68kreg.dat } +0, +26, +27, +28, +29, +30, +31, +32, +18, +1, +2, +3, +4, +5, +6, +7, +8, +22, +9, +10, +11, +12, +13, +14, +15, +16, +19, +25, +17, +23, +33, +20, +21, +24 diff --git a/closures/compiler/m68k/r68ksta.inc b/closures/compiler/m68k/r68ksta.inc new file mode 100644 index 0000000000..ed8d142fe4 --- /dev/null +++ b/closures/compiler/m68k/r68ksta.inc @@ -0,0 +1,35 @@ +{ don't edit, this file is generated from m68kreg.dat } +-1, +0, +1, +2, +3, +4, +5, +6, +7, +16, +17, +18, +19, +20, +21, +22, +23, +24, +0, +0, +0, +0, +0, +0, +0, +0, +8, +9, +10, +11, +12, +13, +14, +15 diff --git a/closures/compiler/m68k/r68kstd.inc b/closures/compiler/m68k/r68kstd.inc new file mode 100644 index 0000000000..3719f1f96b --- /dev/null +++ b/closures/compiler/m68k/r68kstd.inc @@ -0,0 +1,35 @@ +{ don't edit, this file is generated from m68kreg.dat } +'INVALID', +'d0', +'d1', +'d2', +'d3', +'d4', +'d5', +'d6', +'d7', +'fp0', +'fp1', +'fp2', +'fp3', +'fp4', +'fp5', +'fp6', +'fp7', +'pc', +'ccr', +'fpcr', +'sr', +'ssp', +'dfc', +'sfc', +'vbr', +'fpsr', +'a0', +'a1', +'a2', +'a3', +'a4', +'a5', +'a6', +'sp' diff --git a/closures/compiler/m68k/r68ksup.inc b/closures/compiler/m68k/r68ksup.inc new file mode 100644 index 0000000000..8677c2a633 --- /dev/null +++ b/closures/compiler/m68k/r68ksup.inc @@ -0,0 +1,35 @@ +{ don't edit, this file is generated from m68kreg.dat } +RS_NO = $00; +RS_D0 = $00; +RS_D1 = $01; +RS_D2 = $02; +RS_D3 = $03; +RS_D4 = $04; +RS_D5 = $05; +RS_D6 = $06; +RS_D7 = $07; +RS_FP0 = $00; +RS_FP1 = $01; +RS_FP2 = $02; +RS_FP3 = $03; +RS_FP4 = $04; +RS_FP5 = $05; +RS_FP6 = $06; +RS_FP7 = $07; +RS_PC = $00; +RS_CCR = $01; +RS_FPCR = $02; +RS_SR = $03; +RS_SSP = $04; +RS_DFC = $05; +RS_SFC = $06; +RS_VBR = $07; +RS_FPSR = $08; +RS_A0 = $00; +RS_A1 = $01; +RS_A2 = $02; +RS_A3 = $03; +RS_A4 = $04; +RS_A5 = $05; +RS_A6 = $06; +RS_SP = $07; diff --git a/closures/compiler/m68k/ra68k.pas b/closures/compiler/m68k/ra68k.pas new file mode 100644 index 0000000000..611ad4dcd3 --- /dev/null +++ b/closures/compiler/m68k/ra68k.pas @@ -0,0 +1,371 @@ +{ + Copyright (c) 1998-2003 by Carl Eric Codere and Peter Vreman + + Handles the common 68k 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 ra68k; + +{$i fpcdefs.inc} + + interface + + uses + aasmbase,aasmtai,aasmdata,aasmcpu, + cpubase,rautils,cclasses; + + type + Tm68kOperand=class(TOperand) + end; + + Tm68kInstruction=class(TInstruction) + opsize : topsize; + function ConcatInstruction(p : TAsmList):tai;override; + function ConcatLabeledInstr(p : TAsmList):tai; + end; + + implementation + + uses + verbose,cgbase; + +{***************************************************************************** + TM68kInstruction +*****************************************************************************} + + function TM68kInstruction.ConcatInstruction(p : TAsmList):tai; + begin + result:=inherited ConcatInstruction(p); + if assigned(result) then + taicpu(result).opsize:=opsize; + end; +{ + function TM68kInstruction.ConcatInstruction(p : TAsmList):tai; + var + fits : boolean; + begin + writeln('jaj mami'); + result:=nil; + fits := FALSE; + { setup specific opcodetions for first pass } + + { Setup special operands } + { Convert to general form as to conform to the m68k opcode table } + if (opcode = A_ADDA) or (opcode = A_ADDI) + then opcode := A_ADD + else + { CMPM excluded because of GAS v1.34 BUG } + if (opcode = A_CMPA) or + (opcode = A_CMPI) then + opcode := A_CMP + else + if opcode = A_EORI then + opcode := A_EOR + else + if opcode = A_MOVEA then + opcode := A_MOVE + else + if opcode = A_ORI then + opcode := A_OR + else + if (opcode = A_SUBA) or (opcode = A_SUBI) then + opcode := A_SUB; + + { Setup operand types } + +(* + in opcode <> A_MOVEM then + begin + + while not(fits) do + begin + { set the opcodetion cache, if the opcodetion } + { occurs the first time } + if (it[i].i=opcode) and (ins_cache[opcode]=-1) then + ins_cache[opcode]:=i; + + if (it[i].i=opcode) and (instr.ops=it[i].ops) then + begin + { first fit } + case instr.ops of + 0 : begin + fits:=true; + break; + end; + 1 : + begin + if (optyp1 and it[i].o1)<>0 then + begin + fits:=true; + break; + end; + end; + 2 : if ((optyp1 and it[i].o1)<>0) and + ((optyp2 and it[i].o2)<>0) then + begin + fits:=true; + break; + end + 3 : if ((optyp1 and it[i].o1)<>0) and + ((optyp2 and it[i].o2)<>0) and + ((optyp3 and it[i].o3)<>0) then + begin + fits:=true; + break; + end; + end; { end case } + end; { endif } + if it[i].i=A_NONE then + begin + { NO MATCH! } + Message(asmr_e_invalid_combination_opcode_and_operand); + exit; + end; + inc(i); + end; { end while } + *) + fits:=TRUE; + + { We add the opcode to the opcode linked list } + if fits then + begin + case ops of + 0: + if opsize <> S_NO then + result:=(taicpu.op_none(opcode,opsize)) + else + result:=(taicpu.op_none(opcode,S_NO)); + 1: begin + case operands[1].opr.typ of + OPR_SYMBOL: + begin + result:=(taicpu.op_sym_ofs(opcode, + opsize, operands[1].opr.symbol,operands[1].opr.symofs)); + end; + OPR_CONSTANT: + begin + result:=(taicpu.op_const(opcode, + opsize, operands[1].opr.val)); + end; + OPR_REGISTER: + result:=(taicpu.op_reg(opcode,opsize,operands[1].opr.reg)); + OPR_REFERENCE: + if opsize <> S_NO then + begin + result:=(taicpu.op_ref(opcode, + opsize,operands[1].opr.ref)); + end + else + begin + { special jmp and call case with } + { symbolic references. } + if opcode in [A_BSR,A_JMP,A_JSR,A_BRA,A_PEA] then + begin + result:=(taicpu.op_ref(opcode, + S_NO,operands[1].opr.ref)); + end + else + Message(asmr_e_invalid_opcode_and_operand); + end; + OPR_NONE: + Message(asmr_e_invalid_opcode_and_operand); + else + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; + end; + 2: begin + { source } + case operands[1].opr.typ of + { reg,reg } + { reg,ref } + OPR_REGISTER: + begin + case operands[2].opr.typ of + OPR_REGISTER: + begin + result:=(taicpu.op_reg_reg(opcode, + opsize,operands[1].opr.reg,operands[2].opr.reg)); + end; + OPR_REFERENCE: + result:=(taicpu.op_reg_ref(opcode, + opsize,operands[1].opr.reg,operands[2].opr.ref)); + else { else case } + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_REGISTER } + end; + { regset, ref } + OPR_regset: + begin + case operands[2].opr.typ of + OPR_REFERENCE : + result:=(taicpu.op_regset_ref(opcode, + opsize,operands[1].opr.regset,operands[2].opr.ref)); + else + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_regset } + end; + + { const,reg } + { const,const } + { const,ref } + OPR_CONSTANT: + case operands[2].opr.typ of + { constant, constant does not have a specific size. } + OPR_CONSTANT: + result:=(taicpu.op_const_const(opcode, + S_NO,operands[1].opr.val,operands[2].opr.val)); + OPR_REFERENCE: + begin + result:=(taicpu.op_const_ref(opcode, + opsize,operands[1].opr.val, + operands[2].opr.ref)) + end; + OPR_REGISTER: + begin + result:=(taicpu.op_const_reg(opcode, + opsize,operands[1].opr.val, + operands[2].opr.reg)) + end; + else + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_CONSTANT } + { ref,reg } + { ref,ref } + OPR_REFERENCE: + case operands[2].opr.typ of + OPR_REGISTER: + begin + result:=(taicpu.op_ref_reg(opcode, + opsize,operands[1].opr.ref, + operands[2].opr.reg)); + end; + OPR_regset: + begin + result:=(taicpu.op_ref_regset(opcode, + opsize,operands[1].opr.ref, + operands[2].opr.regset)); + end; + OPR_REFERENCE: { special opcodes } + result:=(taicpu.op_ref_ref(opcode, + opsize,operands[1].opr.ref, + operands[2].opr.ref)); + else + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_REFERENCE } + OPR_SYMBOL: case operands[2].opr.typ of + OPR_REFERENCE: + begin + result:=(taicpu.op_sym_ofs_ref(opcode, + opsize,operands[1].opr.symbol,operands[1].opr.symofs, + operands[2].opr.ref)) + end; + OPR_REGISTER: + begin + result:=(taicpu.op_sym_ofs_reg(opcode, + opsize,operands[1].opr.symbol,operands[1].opr.symofs, + operands[2].opr.reg)) + end; + else + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end second operand case for OPR_SYMBOL } + else + begin + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end first operand case } + end; + 3: begin + if (opcode = A_DIVSL) or (opcode = A_DIVUL) or (opcode = A_MULU) + or (opcode = A_MULS) or (opcode = A_DIVS) or (opcode = A_DIVU) then + begin + if (operands[1].opr.typ <> OPR_REGISTER) + or (operands[2].opr.typ <> OPR_REGISTER) + or (operands[3].opr.typ <> OPR_REGISTER) then + begin + Message(asmr_e_invalid_opcode_and_operand); + end + else + begin + result:=(taicpu. op_reg_reg_reg(opcode,opsize, + operands[1].opr.reg,operands[2].opr.reg,operands[3].opr.reg)); + end; + end + else + Message(asmr_e_invalid_opcode_and_operand); + end; + end; { end case } + end; + if assigned(result) then + p.concat(result); + end; +} + + function TM68kInstruction.ConcatLabeledInstr(p : TAsmList):tai; + begin + if ((opcode >= A_BCC) and (opcode <= A_BVS)) or + (opcode = A_BRA) or (opcode = A_BSR) or + (opcode = A_JMP) or (opcode = A_JSR) or + ((opcode >= A_FBEQ) and (opcode <= A_FBNGLE)) then + begin + if ops > 2 then + Message(asmr_e_invalid_opcode_and_operand) + else if operands[1].opr.typ <> OPR_SYMBOL then + Message(asmr_e_invalid_opcode_and_operand) + else if (operands[1].opr.typ = OPR_SYMBOL) and + (ops = 1) then + if assigned(operands[1].opr.symbol) and + (operands[1].opr.symofs=0) then + result:=taicpu.op_sym(opcode,S_NO, + operands[1].opr.symbol) + else + Message(asmr_e_invalid_opcode_and_operand); + end + else if ((opcode >= A_DBCC) and (opcode <= A_DBF)) + or ((opcode >= A_FDBEQ) and (opcode <= A_FDBNGLE)) then + begin + if (ops<>2) or + (operands[1].opr.typ <> OPR_REGISTER) or + (operands[2].opr.typ <> OPR_SYMBOL) or + (operands[2].opr.symofs <> 0) then + Message(asmr_e_invalid_opcode_and_operand) + else + result:=taicpu.op_reg_sym(opcode,opsize,operands[1].opr.reg, + operands[2].opr.symbol); + end + else + Message(asmr_e_invalid_opcode_and_operand); + if assigned(result) then + p.concat(result); + end; + + + + +end. diff --git a/closures/compiler/m68k/ra68kmot.pas b/closures/compiler/m68k/ra68kmot.pas new file mode 100644 index 0000000000..b61ecbe50b --- /dev/null +++ b/closures/compiler/m68k/ra68kmot.pas @@ -0,0 +1,1835 @@ +{ + Copyright (c) 1998-2000 by Carl Eric Codere + + This unit does the parsing process for the motorola 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 ra68kmot; + +{$i fpcdefs.inc} + +{**********************************************************************} +{ WARNING } +{**********************************************************************} +{ Any modification in the order or removal of terms in the tables } +{ in m68k.pas and asmo68k.pas will BREAK the code in this unit, } +{ unless the appropriate changes are made to this unit. Addition } +{ of terms though, will not change the code herein. } +{**********************************************************************} + +{---------------------------------------------------------------------------} +{ LEFT TO DO } +{---------------------------------------------------------------------------} +{ o Add support for sized indexing such as in d0.l } +{ presently only (an,dn) is supported for indexing -- } +{ size defaults to LONG. } +{ o Add support for MC68020 opcodes. } +{ o Add support for MC68020 adressing modes. } +{ o Add operand checking with m68k opcode table in ConcatOpCode } +{ o Add Floating point support } +{---------------------------------------------------------------------------} + + interface + + + uses + cutils, + globtype,cclasses,cpubase, + symconst, + aasmbase, + rabase,rasm,ra68k,rautils; + + type + tasmtoken = ( + AS_NONE,AS_LABEL,AS_LLABEL,AS_STRING,AS_HEXNUM,AS_OCTALNUM, + AS_BINNUM,AS_COMMA,AS_LBRACKET,AS_RBRACKET,AS_LPAREN, + AS_RPAREN,AS_COLON,AS_DOT,AS_PLUS,AS_MINUS,AS_STAR,AS_INTNUM, + AS_SEPARATOR,AS_ID,AS_REGISTER,AS_OPCODE,AS_SLASH,AS_APPT,AS_REALNUM, + AS_ALIGN, + {------------------ Assembler directives --------------------} + AS_DB,AS_DW,AS_DD,AS_XDEF,AS_END, + {------------------ Assembler Operators --------------------} + AS_MOD,AS_SHL,AS_SHR,AS_NOT,AS_AND,AS_OR,AS_XOR); + + tasmkeyword = string[10]; + + tm68kmotreader = class(tasmreader) + actasmtoken : tasmtoken; + prevasmtoken : tasmtoken; + procedure SetupTables; + function Assemble: tlinkedlist;override; + function is_asmopcode(const s: string) : boolean; + Function is_asmdirective(const s: string):boolean; + function is_register(const s:string):boolean; + procedure GetToken; + function consume(t : tasmtoken):boolean; + function findopcode(s: string; var opsize: topsize): tasmop; + Function BuildExpression(allow_symbol : boolean; asmsym : pshortstring) : longint; + Procedure BuildConstant(maxvalue: longint); + Procedure BuildRealConstant(typ : tfloattype); + Procedure BuildScaling(const oper:tm68koperand); + Function BuildRefExpression: longint; + procedure BuildReference(const oper:tm68koperand); + Procedure BuildOperand(const oper:tm68koperand); + Procedure BuildStringConstant(asciiz: boolean); + Procedure BuildOpCode(instr:Tm68kinstruction); + end; + + +Implementation + + uses + { global } + globals,verbose, + systems, + { aasm } + cpuinfo,aasmtai,aasmdata,aasmcpu, + cgbase, + { symtable } + symbase,symtype,symsym,symdef,symtable, + { pass 1 } + nbas, + { parser } + scanner,ag68kgas, + itcpugas + ; + +const + firstdirective = AS_DB; + lastdirective = AS_END; + firstoperator = AS_MOD; + lastoperator = AS_XOR; + + _count_asmdirectives = longint(lastdirective)-longint(firstdirective); + _count_asmoperators = longint(lastoperator)-longint(firstoperator); + + _asmdirectives : array[0.._count_asmdirectives] of tasmkeyword = + ('DC.B','DC.W','DC.L','XDEF','END'); + + { problems with shl,shr,not,and,or and xor, they are } + { context sensitive. } + _asmoperators : array[0.._count_asmoperators] of tasmkeyword = ( + 'MOD','SHL','SHR','NOT','AND','OR','XOR'); + + token2str : array[tasmtoken] of tasmkeyword=( + 'NONE','LABEL','LLABEL','STRING','HEXNUM','OCTALNUM', + 'BINNUM',',','[',']','(', + ')',':','.','+','-','*','INTNUM', + 'SEPARATOR','ID','REGISTER','OPCODE','/','APPT','REALNUM', + 'ALIGN', + {------------------ Assembler directives --------------------} + 'DB','DW','DD','XDEF','END', + {------------------ Assembler Operators --------------------} + 'MOD','SHL','SHR','NOT','AND','OR','XOR'); + +const + firsttoken : boolean = TRUE; + operandnum : byte = 0; + + procedure tm68kmotreader.SetupTables; + { creates uppercased symbol tables for speed access } + var + i : tasmop; + Begin + { opcodes } + iasmops:=TFPHashList.create; + for i:=firstop to lastop do + iasmops.Add(upper(gas_op2str[i]),Pointer(PtrInt(i))); + end; + + + {---------------------------------------------------------------------} + { Routines for the tokenizing } + {---------------------------------------------------------------------} + + function tm68kmotreader.is_asmopcode(const s: string):boolean; + var + hs : string; + j : byte; + begin + is_asmopcode:=false; + { first of all we remove the suffix } + j:=pos('.',s); + if j>0 then + hs:=copy(s,1,j-1) + else + hs:=s; + + { Search opcodes } + actopcode:=tasmop(PtrInt(iasmops.Find(hs))); + if actopcode<>A_NONE then + begin + actasmtoken:=AS_OPCODE; + result:=TRUE; + exit; + end; + end; + + + + Function tm68kmotreader.is_asmdirective(const s: string):boolean; + var + i:byte; + begin + result:=false; + for i:=0 to _count_asmdirectives do + begin + if s=_asmdirectives[i] then + begin + actasmtoken := tasmtoken(longint(firstdirective)+i); + result:=true; + exit; + end; + end; + end; + + + function tm68kmotreader.is_register(const s:string):boolean; + begin + is_register:=false; + // FIX ME!!! Ugly, needs a proper fix (KB) + actasmregister:=gas_regnum_search('%'+lower(s)); + if actasmregister<>NR_NO then + begin + is_register:=true; + actasmtoken:=AS_REGISTER; + end; + end; + + + Procedure tm68kmotreader.GetToken; + {*********************************************************************} + { FUNCTION GetToken: tinteltoken; } + { Description: This routine returns intel assembler tokens and } + { does some minor syntax error checking. } + {*********************************************************************} + var + token: tasmtoken; + forcelabel: boolean; + begin + forcelabel := FALSE; + actasmpattern :=''; + {* INIT TOKEN TO NOTHING *} + token := AS_NONE; + { while space and tab , continue scan... } + while c in [' ',#9] do + c:=current_scanner.asmgetchar; + + if not (c in [#10,#13,'{',';']) then + current_scanner.gettokenpos; + { Possiblities for first token in a statement: } + { Local Label, Label, Directive, Prefix or Opcode.... } + if firsttoken and not (c in [#10,#13,'{',';']) then + begin + + firsttoken := FALSE; + if c = '@' then + begin + token := AS_LLABEL; { this is a local label } + { Let us point to the next character } + c := current_scanner.asmgetchar; + end; + + + + while c in ['A'..'Z','a'..'z','0'..'9','_','@','.'] do + begin + { if there is an at_sign, then this must absolutely be a label } + if c = '@' then forcelabel:=TRUE; + actasmpattern := actasmpattern + c; + c := current_scanner.asmgetchar; + end; + + uppervar(actasmpattern); + + if c = ':' then + begin + case token of + AS_NONE: token := AS_LABEL; + AS_LLABEL: ; { do nothing } + end; { end case } + { let us point to the next character } + c := current_scanner.asmgetchar; + actasmtoken := token; + exit; + end; + + { Are we trying to create an identifier with } + { an at-sign...? } + if forcelabel then + Message(asmr_e_none_label_contain_at); + + If is_asmopcode(actasmpattern) then + exit; + if is_asmdirective(actasmpattern) then + exit + else + begin + actasmtoken := AS_NONE; + Message1(asmr_e_invalid_or_missing_opcode,actasmpattern); + end; + end + else { else firsttoken } + { Here we must handle all possible cases } + begin + case c of + + '@': { possiblities : - local label reference , such as in jmp @local1 } + { - @Result, @Code or @Data special variables. } + begin + actasmpattern := c; + c:= current_scanner.asmgetchar; + while c in ['A'..'Z','a'..'z','0'..'9','_','@','.'] do + begin + actasmpattern := actasmpattern + c; + c := current_scanner.asmgetchar; + end; + uppervar(actasmpattern); + actasmtoken := AS_ID; + exit; + end; + { identifier, register, opcode, prefix or directive } + 'A'..'Z','a'..'z','_': begin + actasmpattern := c; + c:= current_scanner.asmgetchar; + while c in ['A'..'Z','a'..'z','0'..'9','_','.'] do + begin + actasmpattern := actasmpattern + c; + c := current_scanner.asmgetchar; + end; + uppervar(actasmpattern); + + If is_asmopcode(actasmpattern) then + exit; + if is_register(actasmpattern) then + exit; + if is_asmdirective(actasmpattern) then + exit; + { this is surely an identifier } + actasmtoken := AS_ID; + exit; + end; + { override operator... not supported } + '&': begin + c:=current_scanner.asmgetchar; + actasmtoken := AS_AND; + end; + { string or character } + '''' : + begin + actasmpattern:=''; + while true do + begin + if c = '''' then + begin + c:=current_scanner.asmgetchar; + if c=#10 then + begin + Message(scan_f_string_exceeds_line); + break; + end; + repeat + if c=''''then + begin + c:=current_scanner.asmgetchar; + if c='''' then + begin + actasmpattern:=actasmpattern+''''; + c:=current_scanner.asmgetchar; + if c=#10 then + begin + Message(scan_f_string_exceeds_line); + break; + end; + end + else break; + end + else + begin + actasmpattern:=actasmpattern+c; + c:=current_scanner.asmgetchar; + if c=#10 then + begin + Message(scan_f_string_exceeds_line); + break + end; + end; + until false; { end repeat } + end + else break; { end if } + end; { end while } + token:=AS_STRING; + actasmtoken := token; + exit; + end; + '$' : begin + c:=current_scanner.asmgetchar; + while c in ['0'..'9','A'..'F','a'..'f'] do + begin + actasmpattern := actasmpattern + c; + c := current_scanner.asmgetchar; + end; + actasmtoken := AS_HEXNUM; + exit; + end; + ',' : begin + actasmtoken := AS_COMMA; + c:=current_scanner.asmgetchar; + exit; + end; + '(' : begin + actasmtoken := AS_LPAREN; + c:=current_scanner.asmgetchar; + exit; + end; + ')' : begin + actasmtoken := AS_RPAREN; + c:=current_scanner.asmgetchar; + exit; + end; + ':' : begin + actasmtoken := AS_COLON; + c:=current_scanner.asmgetchar; + exit; + end; +{ '.' : begin + actasmtoken := AS_DOT; + c:=current_scanner.asmgetchar; + exit; + end; } + '+' : begin + actasmtoken := AS_PLUS; + c:=current_scanner.asmgetchar; + exit; + end; + '-' : begin + actasmtoken := AS_MINUS; + c:=current_scanner.asmgetchar; + exit; + end; + '*' : begin + actasmtoken := AS_STAR; + c:=current_scanner.asmgetchar; + exit; + end; + '/' : begin + actasmtoken := AS_SLASH; + c:=current_scanner.asmgetchar; + exit; + end; + '<' : begin + c := current_scanner.asmgetchar; + { invalid characters } + if c <> '<' then + Message(asmr_e_invalid_char_smaller); + { still assume << } + actasmtoken := AS_SHL; + c := current_scanner.asmgetchar; + exit; + end; + '>' : begin + c := current_scanner.asmgetchar; + { invalid characters } + if c <> '>' then + Message(asmr_e_invalid_char_greater); + { still assume << } + actasmtoken := AS_SHR; + c := current_scanner.asmgetchar; + exit; + end; + '|' : begin + actasmtoken := AS_OR; + c := current_scanner.asmgetchar; + exit; + end; + '^' : begin + actasmtoken := AS_XOR; + c := current_scanner.asmgetchar; + exit; + end; + '#' : begin + actasmtoken:=AS_APPT; + c:=current_scanner.asmgetchar; + exit; + end; + '%' : begin + c:=current_scanner.asmgetchar; + while c in ['0','1'] do + begin + actasmpattern := actasmpattern + c; + c := current_scanner.asmgetchar; + end; + actasmtoken := AS_BINNUM; + exit; + end; + { integer number } + '0'..'9': begin + actasmpattern := c; + c := current_scanner.asmgetchar; + while c in ['0'..'9'] do + begin + actasmpattern := actasmpattern + c; + c:= current_scanner.asmgetchar; + end; + actasmtoken := AS_INTNUM; + exit; + end; + ';' : begin + repeat + c:=current_scanner.asmgetchar; + until c=#10; + firsttoken := TRUE; + actasmtoken:=AS_SEPARATOR; + end; + + '{',#13,#10 : begin + c:=current_scanner.asmgetchar; + firsttoken := TRUE; + actasmtoken:=AS_SEPARATOR; + end; + else + begin + Message(scan_f_illegal_char); + end; + + end; { end case } + end; { end else if } + end; + + + {---------------------------------------------------------------------} + { Routines for the parsing } + {---------------------------------------------------------------------} + + function tm68kmotreader.consume(t : tasmtoken):boolean; + var + p: pointer; + begin + Consume:=true; + if t<>actasmtoken then + begin + p:=nil; + dword(p^):=0; + Message2(scan_f_syn_expected,token2str[t],token2str[actasmtoken]); + Consume:=false; + end; + repeat + gettoken; + until actasmtoken<>AS_NONE; + end; + + + function tm68kmotreader.findopcode(s: string; var opsize: topsize): tasmop; + {*********************************************************************} + { FUNCTION findopcode(s: string): tasmop; } + { Description: Determines if the s string is a valid opcode } + { if so returns correct tasmop token. } + {*********************************************************************} + var + j: byte; + op_size: string; + begin + findopcode := A_NONE; + j:=pos('.',s); + if j<>0 then + begin + op_size:=copy(s,j+1,1); + case op_size[1] of + { For the motorola only opsize size is used to } + { determine the size of the operands. } + 'B': opsize := S_B; + 'W': opsize := S_W; + 'L': opsize := S_L; + 'S': opsize := S_FS; + 'D': opsize := S_FD; + 'X': opsize := S_FX; + else + Message1(asmr_e_unknown_opcode,s); + end; + { delete everything starting from dot } + delete(s,j,length(s)); + end; + result:=actopcode; + end; + + + + + Function tm68kmotreader.BuildExpression(allow_symbol : boolean; asmsym : pshortstring) : longint; + {*********************************************************************} + { FUNCTION BuildExpression: longint } + { Description: This routine calculates a constant expression to } + { a given value. The return value is the value calculated from } + { the expression. } + { The following tokens (not strings) are recognized: } + { (,),SHL,SHR,/,*,NOT,OR,XOR,AND,MOD,+/-,numbers,ID to constants. } + {*********************************************************************} + { ENTRY: On entry the token should be any valid expression token. } + { EXIT: On Exit the token points to either COMMA or SEPARATOR } + { ERROR RECOVERY: Tries to find COMMA or SEPARATOR token by consuming } + { invalid tokens. } + {*********************************************************************} + var expr: string; + hs, tempstr: string; + sym : tsym; + srsymtable : TSymtable; + hl : tasmlabel; + l : longint; + errorflag: boolean; + begin + errorflag := FALSE; + expr := ''; + tempstr := ''; + if allow_symbol then + asmsym^:=''; + Repeat + Case actasmtoken of + AS_LPAREN: begin + Consume(AS_LPAREN); + expr := expr + '('; + end; + AS_RPAREN: begin + Consume(AS_RPAREN); + expr := expr + ')'; + end; + AS_SHL: begin + Consume(AS_SHL); + expr := expr + '<'; + end; + AS_SHR: begin + Consume(AS_SHR); + expr := expr + '>'; + end; + AS_SLASH: begin + Consume(AS_SLASH); + expr := expr + '/'; + end; + AS_MOD: begin + Consume(AS_MOD); + expr := expr + '%'; + end; + AS_STAR: begin + Consume(AS_STAR); + expr := expr + '*'; + end; + AS_PLUS: begin + Consume(AS_PLUS); + expr := expr + '+'; + end; + AS_MINUS: begin + Consume(AS_MINUS); + expr := expr + '-'; + end; + AS_AND: begin + Consume(AS_AND); + expr := expr + '&'; + end; + AS_NOT: begin + Consume(AS_NOT); + expr := expr + '~'; + end; + AS_XOR: begin + Consume(AS_XOR); + expr := expr + '^'; + end; + AS_OR: begin + Consume(AS_OR); + expr := expr + '|'; + end; + AS_ID: begin + if SearchIConstant(actasmpattern,l) then + begin + str(l, tempstr); + expr := expr + tempstr; + Consume(AS_ID); + End else + if not allow_symbol then + begin + Message(asmr_e_syn_constant); + l := 0; + End else + begin + hs:=''; + if (expr[Length(expr)]='+') then + Delete(expr,Length(expr),1) + else if expr<>'' then + begin + Message(asmr_e_invalid_constant_expression); + break; + End; + tempstr:=actasmpattern; + consume(AS_ID); + if (length(tempstr)>1) and (tempstr[1]='@') then + begin + CreateLocalLabel(tempstr,hl,false); + hs:=hl.name + end + else if SearchLabel(tempstr,hl,false) then + hs:=hl.name + else + begin + asmsearchsym(tempstr,sym,srsymtable); + if assigned(sym) then + begin + case sym.typ of + paravarsym, + localvarsym : + begin + Message(asmr_e_no_local_or_para_allowed); + hs:=tabstractvarsym(sym).mangledname; + end; + staticvarsym : + hs:=tstaticvarsym(sym).mangledname; + procsym : + begin + if tprocsym(sym).procdeflist.count>1 then + Message(asmr_w_calling_overload_func); + hs:=tprocdef(tprocsym(sym).procdeflist[0]).mangledname; + end; + typesym : + begin + if not(ttypesym(sym).typedef.typ in [recorddef,objectdef]) then + Message(asmr_e_wrong_sym_type); + end; + else + Message(asmr_e_wrong_sym_type); + end; + end + else + Message1(sym_e_unknown_id,tempstr); + end; + { symbol found? } + if hs<>'' then + begin + if asmsym^='' then + asmsym^:=hs + else + Message(asmr_e_cant_have_multiple_relocatable_symbols); + end; + end; + end; + AS_INTNUM: begin + expr := expr + actasmpattern; + Consume(AS_INTNUM); + end; + AS_BINNUM: begin + tempstr := tostr(ParseVal(actasmpattern,2)); + if tempstr = '' then + Message(asmr_e_error_converting_binary); + expr:=expr+tempstr; + Consume(AS_BINNUM); + end; + + AS_HEXNUM: begin + tempstr := tostr(ParseVal(actasmpattern,16)); + if tempstr = '' then + Message(asmr_e_error_converting_hexadecimal); + expr:=expr+tempstr; + Consume(AS_HEXNUM); + end; + AS_OCTALNUM: begin + tempstr := tostr(ParseVal(actasmpattern,8)); + if tempstr = '' then + Message(asmr_e_error_converting_octal); + expr:=expr+tempstr; + Consume(AS_OCTALNUM); + end; + { go to next term } + AS_COMMA: begin + if not ErrorFlag then + BuildExpression := CalculateExpression(expr) + else + BuildExpression := 0; + Exit; + end; + { go to next symbol } + AS_SEPARATOR: begin + if not ErrorFlag then + BuildExpression := CalculateExpression(expr) + else + BuildExpression := 0; + Exit; + end; + else + begin + { only write error once. } + if not errorflag then + Message(asmr_e_invalid_constant_expression); + { consume tokens until we find COMMA or SEPARATOR } + Consume(actasmtoken); + errorflag := TRUE; + End; + end; + Until false; + end; + + + Procedure tm68kmotreader.BuildRealConstant(typ : tfloattype); + {*********************************************************************} + { PROCEDURE BuilRealConst } + { Description: This routine calculates a constant expression to } + { a given value. The return value is the value calculated from } + { the expression. } + { The following tokens (not strings) are recognized: } + { +/-,numbers and real numbers } + {*********************************************************************} + { ENTRY: On entry the token should be any valid expression token. } + { EXIT: On Exit the token points to either COMMA or SEPARATOR } + { ERROR RECOVERY: Tries to find COMMA or SEPARATOR token by consuming } + { invalid tokens. } + {*********************************************************************} + var expr: string; + r : extended; + code : word; + negativ : boolean; + errorflag: boolean; + begin + errorflag := FALSE; + Repeat + negativ:=false; + expr := ''; + if actasmtoken=AS_PLUS then Consume(AS_PLUS) + else if actasmtoken=AS_MINUS then + begin + negativ:=true; + consume(AS_MINUS); + end; + Case actasmtoken of + AS_INTNUM: begin + expr := actasmpattern; + Consume(AS_INTNUM); + end; + AS_REALNUM: begin + expr := actasmpattern; + { in ATT syntax you have 0d in front of the real } + { should this be forced ? yes i think so, as to } + { conform to gas as much as possible. } + if (expr[1]='0') and (upper(expr[2])='D') then + expr:=copy(expr,3,255); + Consume(AS_REALNUM); + end; + AS_BINNUM: begin + { checking for real constants with this should use } + { real DECODING otherwise the compiler will crash! } + Message(asmr_e_invalid_float_expr); + expr:='0.0'; + Consume(AS_BINNUM); + end; + + AS_HEXNUM: begin + { checking for real constants with this should use } + { real DECODING otherwise the compiler will crash! } + Message(asmr_e_invalid_float_expr); + expr:='0.0'; + Consume(AS_HEXNUM); + end; + AS_OCTALNUM: begin + { checking for real constants with this should use } + { real DECODING otherwise the compiler will crash! } + { xxxToDec using reals could be a solution, but the } + { problem is that these will crash the m68k compiler } + { when compiling -- because of lack of good fpu } + { support. } + Message(asmr_e_invalid_float_expr); + expr:='0.0'; + Consume(AS_OCTALNUM); + end; + else + begin + { only write error once. } + if not errorflag then + Message(asmr_e_invalid_float_expr); + { consume tokens until we find COMMA or SEPARATOR } + Consume(actasmtoken); + errorflag := TRUE; + End; + + end; + { go to next term } + if (actasmtoken=AS_COMMA) or (actasmtoken=AS_SEPARATOR) then + begin + if negativ then expr:='-'+expr; + val(expr,r,code); + if code<>0 then + begin + r:=0; + Message(asmr_e_invalid_float_expr); + ConcatRealConstant(curlist,r,typ); + End + else + begin + ConcatRealConstant(curlist,r,typ); + End; + end + else + Message(asmr_e_invalid_float_expr); + Until actasmtoken=AS_SEPARATOR; + end; + + + Procedure tm68kmotreader.BuildConstant(maxvalue: longint); + {*********************************************************************} + { PROCEDURE BuildConstant } + { Description: This routine takes care of parsing a DB,DD,or DW } + { line and adding those to the assembler node. Expressions, range- } + { checking are fullly taken care of. } + { maxvalue: $ff -> indicates that this is a DB node. } + { $ffff -> indicates that this is a DW node. } + { $ffffffff -> indicates that this is a DD node. } + {*********************************************************************} + { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. } + {*********************************************************************} + var + expr: string; + value : longint; + begin + Repeat + Case actasmtoken of + AS_STRING: begin + if maxvalue <> $ff then + Message(asmr_e_string_not_allowed_as_const); + expr := actasmpattern; + if length(expr) > 1 then + Message(asmr_e_string_not_allowed_as_const); + Consume(AS_STRING); + Case actasmtoken of + AS_COMMA: Consume(AS_COMMA); + AS_SEPARATOR: ; + else + Message(asmr_e_invalid_string_expression); + end; { end case } + ConcatString(curlist,expr); + end; + AS_INTNUM,AS_BINNUM, + AS_OCTALNUM,AS_HEXNUM: + begin + value:=BuildExpression(false,nil); + ConcatConstant(curlist,value,maxvalue); + end; + AS_ID: + begin + value:=BuildExpression(false,nil); + if value > maxvalue then + begin + Message(asmr_e_constant_out_of_bounds); + { assuming a value of maxvalue } + value := maxvalue; + end; + ConcatConstant(curlist,value,maxvalue); + end; + { These terms can start an assembler expression } + AS_PLUS,AS_MINUS,AS_LPAREN,AS_NOT: begin + value := BuildExpression(false,nil); + ConcatConstant(curlist,value,maxvalue); + end; + AS_COMMA: begin + Consume(AS_COMMA); + END; + AS_SEPARATOR: ; + + else + begin + Message(asmr_e_syntax_error); + end; + end; { end case } + Until actasmtoken = AS_SEPARATOR; + end; + + + Procedure TM68kMotreader.BuildScaling(const oper:tm68koperand); + {*********************************************************************} + { Takes care of parsing expression starting from the scaling value } + { up to and including possible field specifiers. } + { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR } + { or AS_COMMA. On entry should point to the AS_STAR token. } + {*********************************************************************} + var str:string; + l: longint; + code: integer; + begin + Consume(AS_STAR); + if (oper.opr.ref.scalefactor <> 0) + and (oper.opr.ref.scalefactor <> 1) then + Message(asmr_e_wrong_base_index); + case actasmtoken of + AS_INTNUM: str := actasmpattern; + AS_HEXNUM: str := Tostr(ParseVal(actasmpattern,16)); + AS_BINNUM: str := Tostr(ParseVal(actasmpattern,2)); + AS_OCTALNUM: str := Tostr(ParseVal(actasmpattern,8)); + else + Message(asmr_e_syntax_error); + end; + val(str, l, code); + if code <> 0 then + Message(asmr_e_wrong_scale_factor); + if ((l = 2) or (l = 4) or (l = 8) or (l = 1)) and (code = 0) then + begin + oper.opr.ref.scalefactor := l; + end + else + begin + Message(asmr_e_wrong_scale_factor); + oper.opr.ref.scalefactor := 0; + end; + if oper.opr.ref.index = NR_NO then + begin + Message(asmr_e_wrong_base_index); + oper.opr.ref.scalefactor := 0; + end; + { Consume the scaling number } + Consume(actasmtoken); + if actasmtoken = AS_RPAREN then + Consume(AS_RPAREN) + else + Message(asmr_e_wrong_scale_factor); + { // .Field.Field ... or separator/comma // } + if actasmtoken in [AS_COMMA,AS_SEPARATOR] then + begin + end + else + Message(asmr_e_syntax_error); + end; + + + Function TM68kMotreader.BuildRefExpression: longint; + {*********************************************************************} + { FUNCTION BuildRefExpression: longint } + { Description: This routine calculates a constant expression to } + { a given value. The return value is the value calculated from } + { the expression. } + { The following tokens (not strings) are recognized: } + { SHL,SHR,/,*,NOT,OR,XOR,AND,MOD,+/-,numbers,ID to constants. } + {*********************************************************************} + { ENTRY: On entry the token should be any valid expression token. } + { EXIT: On Exit the token points to the LPAREN token. } + { ERROR RECOVERY: Tries to find COMMA or SEPARATOR token by consuming } + { invalid tokens. } + {*********************************************************************} + var tempstr: string; + expr: string; + l : longint; + errorflag : boolean; + begin + errorflag := FALSE; + tempstr := ''; + expr := ''; + Repeat + Case actasmtoken of + AS_RPAREN: begin + Message(asmr_e_syntax_error); + Consume(AS_RPAREN); + end; + AS_SHL: begin + Consume(AS_SHL); + expr := expr + '<'; + end; + AS_SHR: begin + Consume(AS_SHR); + expr := expr + '>'; + end; + AS_SLASH: begin + Consume(AS_SLASH); + expr := expr + '/'; + end; + AS_MOD: begin + Consume(AS_MOD); + expr := expr + '%'; + end; + AS_STAR: begin + Consume(AS_STAR); + expr := expr + '*'; + end; + AS_PLUS: begin + Consume(AS_PLUS); + expr := expr + '+'; + end; + AS_MINUS: begin + Consume(AS_MINUS); + expr := expr + '-'; + end; + AS_AND: begin + Consume(AS_AND); + expr := expr + '&'; + end; + AS_NOT: begin + Consume(AS_NOT); + expr := expr + '~'; + end; + AS_XOR: begin + Consume(AS_XOR); + expr := expr + '^'; + end; + AS_OR: begin + Consume(AS_OR); + expr := expr + '|'; + end; + { End of reference } + AS_LPAREN: begin + if not ErrorFlag then + BuildRefExpression := CalculateExpression(expr) + else + BuildRefExpression := 0; + { no longer in an expression } + exit; + end; + AS_ID: + begin + if NOT SearchIConstant(actasmpattern,l) then + begin + Message(asmr_e_syn_constant); + l := 0; + end; + str(l, tempstr); + expr := expr + tempstr; + Consume(AS_ID); + end; + AS_INTNUM: begin + expr := expr + actasmpattern; + Consume(AS_INTNUM); + end; + AS_BINNUM: begin + tempstr := Tostr(ParseVal(actasmpattern,2)); + if tempstr = '' then + Message(asmr_e_error_converting_binary); + expr:=expr+tempstr; + Consume(AS_BINNUM); + end; + + AS_HEXNUM: begin + tempstr := Tostr(ParseVal(actasmpattern,16)); + if tempstr = '' then + Message(asmr_e_error_converting_hexadecimal); + expr:=expr+tempstr; + Consume(AS_HEXNUM); + end; + AS_OCTALNUM: begin + tempstr := Tostr(ParseVal(actasmpattern,8)); + if tempstr = '' then + Message(asmr_e_error_converting_octal); + expr:=expr+tempstr; + Consume(AS_OCTALNUM); + end; + else + begin + { write error only once. } + if not errorflag then + Message(asmr_e_invalid_constant_expression); + BuildRefExpression := 0; + if actasmtoken in [AS_COMMA,AS_SEPARATOR] then exit; + { consume tokens until we find COMMA or SEPARATOR } + Consume(actasmtoken); + errorflag := TRUE; + end; + end; + Until false; + end; + + + + {*********************************************************************} + { PROCEDURE BuildBracketExpression } + { Description: This routine builds up an expression after a LPAREN } + { token is encountered. } + { On entry actasmtoken should be equal to AS_LPAREN } + {*********************************************************************} + { EXIT CONDITION: On exit the routine should point to either the } + { AS_COMMA or AS_SEPARATOR token. } + {*********************************************************************} + procedure TM68kMotreader.BuildReference(const oper:tm68koperand); + var + l:longint; + code: integer; + str: string; + begin + Consume(AS_LPAREN); + case actasmtoken of + { // (reg ... // } + AS_REGISTER: + begin + oper.opr.ref.base := actasmregister; + Consume(AS_REGISTER); + { can either be a register or a right parenthesis } + { // (reg) // } + { // (reg)+ // } + if actasmtoken=AS_RPAREN then + begin + Consume(AS_RPAREN); + if actasmtoken = AS_PLUS then + begin + if (oper.opr.ref.direction <> dir_none) then + Message(asmr_e_no_inc_and_dec_together) + else + oper.opr.ref.direction := dir_inc; + Consume(AS_PLUS); + end; + if not (actasmtoken in [AS_COMMA,AS_SEPARATOR]) then + begin + Message(asmr_e_invalid_reference_syntax); + { error recovery ... } + while actasmtoken <> AS_SEPARATOR do + Consume(actasmtoken); + end; + exit; + end; + { // (reg,reg .. // } + Consume(AS_COMMA); + if actasmtoken = AS_REGISTER then + begin + oper.opr.ref.index := + actasmregister; + Consume(AS_REGISTER); + { check for scaling ... } + case actasmtoken of + AS_RPAREN: + begin + Consume(AS_RPAREN); + if not (actasmtoken in [AS_COMMA,AS_SEPARATOR]) then + begin + { error recovery ... } + Message(asmr_e_invalid_reference_syntax); + while actasmtoken <> AS_SEPARATOR do + Consume(actasmtoken); + end; + exit; + end; + AS_STAR: + begin + BuildScaling(oper); + end; + else + begin + Message(asmr_e_invalid_reference_syntax); + while (actasmtoken <> AS_SEPARATOR) do + Consume(actasmtoken); + end; + end; { end case } + end + else + begin + Message(asmr_e_invalid_reference_syntax); + while (actasmtoken <> AS_SEPARATOR) do + Consume(actasmtoken); + end; + end; + AS_HEXNUM,AS_OCTALNUM, { direct address } + AS_BINNUM,AS_INTNUM: + begin + case actasmtoken of + AS_INTNUM: str := actasmpattern; + AS_HEXNUM: str := Tostr(ParseVal(actasmpattern,16)); + AS_BINNUM: str := Tostr(ParseVal(actasmpattern,2)); + AS_OCTALNUM: str := Tostr(ParseVal(actasmpattern,8)); + else + Message(asmr_e_syntax_error); + end; + Consume(actasmtoken); + val(str, l, code); + if code <> 0 then + Message(asmr_e_invalid_reference_syntax) + else + oper.opr.ref.offset := l; + Consume(AS_RPAREN); + if not (actasmtoken in [AS_COMMA,AS_SEPARATOR]) then + begin + { error recovery ... } + Message(asmr_e_invalid_reference_syntax); + while actasmtoken <> AS_SEPARATOR do + Consume(actasmtoken); + end; + exit; + end; + else + begin + Message(asmr_e_invalid_reference_syntax); + while (actasmtoken <> AS_SEPARATOR) do + Consume(actasmtoken); + end; + end; + end; + + + + + Procedure TM68kMotreader.BuildOperand(const oper:tm68koperand); + {*********************************************************************} + { EXIT CONDITION: On exit the routine should point to either the } + { AS_COMMA or AS_SEPARATOR token. } + {*********************************************************************} + var + expr: string; + tempstr: string; + lab: tasmlabel; + l : longint; + i: Tsuperregister; + r:Tregister; + hl: tasmlabel; + reg_one, reg_two: tregister; + regset: tcpuregisterset; + p: pointer; + begin + regset := []; + tempstr := ''; + case actasmtoken of + { // Memory reference // } + AS_LPAREN: + begin + Oper.InitRef; + BuildReference(oper); + end; + { // Constant expression // } + AS_APPT: begin + Consume(AS_APPT); + if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then + Message(asmr_e_invalid_operand_type); + { identifiers are handled by BuildExpression } + oper.opr.typ := OPR_CONSTANT; + oper.opr.val :=BuildExpression(true,@tempstr); + if tempstr<>'' then + begin + l:=oper.opr.val; + oper.opr.typ := OPR_SYMBOL; + oper.opr.symofs := l; + oper.opr.symbol := current_asmdata.RefAsmSymbol(tempstr); + end; + end; + { // Constant memory offset . // } + { // This must absolutely be followed by ( // } + AS_HEXNUM,AS_INTNUM, + AS_BINNUM,AS_OCTALNUM,AS_PLUS: + begin + Oper.InitRef; + oper.opr.ref.offset:=BuildRefExpression; + BuildReference(oper); + end; + { // A constant expression, or a Variable ref. // } + AS_ID: begin + Oper.InitRef; + if actasmpattern[1] = '@' then + { // Label or Special symbol reference // } + begin + if actasmpattern = '@RESULT' then + oper.SetUpResult + else + if actasmpattern = 'SELF' then + oper.SetUpSelf + else + if (actasmpattern = '@CODE') or (actasmpattern = '@DATA') then + Message(asmr_w_CODE_and_DATA_not_supported) + else + begin + delete(actasmpattern,1,1); + if actasmpattern = '' then + Message(asmr_e_null_label_ref_not_allowed); + CreateLocalLabel(actasmpattern,lab,false); + oper.opr.typ := OPR_SYMBOL; + oper.opr.symbol := lab; + oper.opr.symofs := 0; +// labeled := TRUE; + end; + Consume(AS_ID); + if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then + Message(asmr_e_syntax_error); + end + { probably a variable or normal expression } + { or a procedure (such as in CALL ID) } + else + begin + { is it a constant ? } + if SearchIConstant(actasmpattern,l) then + begin + Oper.InitRef; + oper.opr.ref.offset:=BuildRefExpression; + BuildReference(oper); + end + else { is it a label variable ? } + + { // ID[ , ID.Field.Field or simple ID // } + { check if this is a label, if so then } + { emit it as a label. } + if SearchLabel(actasmpattern,hl,false) then + begin + oper.opr.typ := OPR_SYMBOL; + oper.opr.symbol := hl; + oper.opr.symofs := 0; +// labeled := TRUE; + Consume(AS_ID); + if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then + Message(asmr_e_syntax_error); + + end + else begin + expr:=actasmpattern; + Consume(AS_ID); + { typecasting? } + if SearchType(expr,l) then + begin + oper.hastype:=true; + oper.typesize:=l; + case actasmtoken of + AS_LPAREN : + begin + { Support Type([Reference]) } + Consume(AS_LPAREN); + BuildOperand(oper{,true}); + Consume(AS_RPAREN); + end; + AS_LBRACKET : + begin + { Support Var.Type[Index] } + { Convert @label.Byte[1] to reference } + if oper.opr.typ=OPR_SYMBOL then + oper.initref; + end; + end; + end + else + begin + if not oper.SetupVar(expr,false) then + begin + { not a variable, check special variables.. } + if expr = 'SELF' then + oper.SetupSelf + else begin + writeln('unknown id: ',expr); + Message1(sym_e_unknown_id,expr); + end; + expr:=''; + end; + end; +// Message1(sym_e_unknown_id,actasmpattern); + end; + + case actasmtoken of + AS_LPAREN: { indexing } + BuildReference(oper); + AS_SEPARATOR,AS_COMMA: begin + end; + else + Message(asmr_e_syntax_error); + end; + + end; + end; + + { // Pre-decrement mode reference or constant mem offset. // } + AS_MINUS: begin + Consume(AS_MINUS); + if actasmtoken = AS_LPAREN then + begin + Oper.InitRef; + { indicate pre-decrement mode } + oper.opr.ref.direction := dir_dec; + BuildReference(oper); + end + else + if actasmtoken in [AS_OCTALNUM,AS_HEXNUM,AS_BINNUM,AS_INTNUM] then + begin + Oper.InitRef; + oper.opr.ref.offset:=BuildRefExpression; + { negate because was preceded by a negative sign! } + oper.opr.ref.offset:=-oper.opr.ref.offset; + BuildReference(oper); + end + else + begin + Message(asmr_e_syntax_error); + while not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) do + Consume(actasmtoken); + end; + end; + { // Register, a variable reference or a constant reference // } + AS_REGISTER: begin +// writeln('register! ',actasmpattern); + { save the type of register used. } + tempstr := actasmpattern; + Consume(AS_REGISTER); + { // Simple register // } + if (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA) then + begin +// writeln('simple reg'); + 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 := actasmregister; + end + else + { HERE WE MUST HANDLE THE SPECIAL CASE OF MOVEM AND FMOVEM } + { // Individual register listing // } + if (actasmtoken = AS_SLASH) then + begin + r:=actasmregister; + if getregtype(r)<>R_INTREGISTER then + internalerror(200302191); + include(regset,getsupreg(r)); + Consume(AS_SLASH); + if actasmtoken = AS_REGISTER then + begin + While not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) do + begin + case actasmtoken of + AS_REGISTER: begin + if getregtype(r)<>R_INTREGISTER then + internalerror(200302191); + include(regset,getsupreg(r)); + Consume(AS_REGISTER); + end; + AS_SLASH: Consume(AS_SLASH); + AS_SEPARATOR,AS_COMMA: break; + else + begin + Message(asmr_e_invalid_reg_list_in_movem); + Consume(actasmtoken); + end; + end; { end case } + end; { end while } + oper.opr.typ:= OPR_regset; + oper.opr.regset := regset; + end + else + { error recovery ... } + begin + Message(asmr_e_invalid_reg_list_in_movem); + while not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) do + Consume(actasmtoken); + end; + end + else + { // Range register listing // } + if (actasmtoken = AS_MINUS) then + begin + Consume(AS_MINUS); + reg_one:=actasmregister; + if actasmtoken <> AS_REGISTER then + begin + Message(asmr_e_invalid_reg_list_in_movem); + while not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) do + Consume(actasmtoken); + end + else + begin + { determine the register range ... } + reg_two:=actasmregister; + if getregtype(reg_two)<>R_INTREGISTER then + internalerror(200302191); + if getsupreg(reg_one) > getsupreg(reg_two) then + for i:=getsupreg(reg_two) to getsupreg(reg_one) do + include(regset,i) + else + for i:=getsupreg(reg_one) to getsupreg(reg_two) do + include(regset,i); + Consume(AS_REGISTER); + if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then + begin + Message(asmr_e_invalid_reg_list_in_movem); + while not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) do + Consume(actasmtoken); + end; + { set up instruction } + oper.opr.typ:= OPR_regset; + oper.opr.regset := regset; + end; + end + else + { DIVSL/DIVS/MULS/MULU with long for MC68020 only } + if (actasmtoken = AS_COLON) then + begin + if (current_settings.cputype = cpu_MC68020) or (cs_compilesystem in current_settings.moduleswitches) then + begin + Consume(AS_COLON); + if (actasmtoken = AS_REGISTER) then + begin + { set up old field, since register is valid } + oper.opr.typ := OPR_REGISTER; + oper.opr.reg := actasmregister; + Inc(operandnum); + oper.opr.typ := OPR_REGISTER; + oper.opr.reg := actasmregister; + Consume(AS_REGISTER); + if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then + begin + Message(asmr_e_invalid_reg_list_for_opcode); + while not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) do + Consume(actasmtoken); + end; + end; + end + else + begin + Message1(asmr_e_higher_cpu_mode_required,'68020'); + if not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) then + begin + Message(asmr_e_invalid_reg_list_for_opcode); + while not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) do + Consume(actasmtoken); + end; + end; + end + else + Message(asmr_e_invalid_register); + end; + AS_SEPARATOR, AS_COMMA: ; + else + begin + writeln('looofasz'); + Message(asmr_e_invalid_opcode_and_operand); + Consume(actasmtoken); + end; + end; { end case } + end; + + + + Procedure tm68kmotreader.BuildStringConstant(asciiz: boolean); + {*********************************************************************} + { PROCEDURE BuildStringConstant } + { Description: Takes care of a ASCII, or ASCIIZ directive. } + { asciiz: boolean -> if true then string will be null terminated. } + {*********************************************************************} + { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. } + { On ENTRY: Token should point to AS_STRING } + {*********************************************************************} + var + expr: string; + errorflag : boolean; + begin + errorflag := FALSE; + Repeat + Case actasmtoken of + AS_STRING: begin + expr:=actasmpattern; + if asciiz then + expr:=expr+#0; + ConcatPasString(curlist,expr); + Consume(AS_STRING); + end; + AS_COMMA: begin + Consume(AS_COMMA); + END; + AS_SEPARATOR: ; + else + begin + Consume(actasmtoken); + if not errorflag then + Message(asmr_e_invalid_string_expression); + errorflag := TRUE; + end; + end; { end case } + Until actasmtoken = AS_SEPARATOR; + end; + + + Procedure TM68kmotReader.BuildOpCode(instr:Tm68kinstruction); + {*********************************************************************} + { PROCEDURE BuildOpcode; } + { Description: Parses the intel opcode and operands, and writes it } + { in the TInstruction object. } + {*********************************************************************} + { EXIT CONDITION: On exit the routine should point to AS_SEPARATOR. } + { On ENTRY: Token should point to AS_OPCODE } + {*********************************************************************} + var + operandnum : longint; + begin + { // opcode // } + { allow for newline as in gas styled syntax } + { under DOS you get two AS_SEPARATOR !! } + while actasmtoken=AS_SEPARATOR do + Consume(AS_SEPARATOR); + if (actasmtoken <> AS_OPCODE) then + begin + Message(asmr_e_invalid_or_missing_opcode); + { error recovery } + While not (actasmtoken in [AS_SEPARATOR,AS_COMMA]) do + Consume(actasmtoken); + exit; + end + else + begin + Instr.opcode := findopcode(actasmpattern,instr.opsize); + Consume(AS_OPCODE); + { // Zero operand opcode ? // } + if actasmtoken = AS_SEPARATOR then + exit + else + operandnum := 1; + end; + + While actasmtoken <> AS_SEPARATOR do + begin + case actasmtoken of + { // Operand delimiter // } + AS_COMMA: begin + if operandnum > Max_Operands then + Message(asmr_e_too_many_operands) + else + Inc(operandnum); + Consume(AS_COMMA); + end; + { // End of asm operands for this opcode // } + AS_SEPARATOR: ; + else + BuildOperand(Instr.Operands[operandnum] as tm68koperand); + end; { end case } + end; { end while } + instr.Ops:=operandnum; + end; + + + + + function tm68kmotreader.Assemble: tlinkedlist; + var + hl: tasmlabel; + instr : TM68kInstruction; + begin + Message(asmr_d_start_reading); + firsttoken := TRUE; + operandnum := 0; + { sets up all opcode and register tables in uppercase } + if not _asmsorted then + begin + SetupTables; + _asmsorted := TRUE; + end; + curlist:=TAsmList.Create; + { setup label linked list } + LocalLabelList:=TLocalLabelList.Create; + c:=current_scanner.asmgetchar; + gettoken; + while actasmtoken<>AS_END do + begin + case actasmtoken of + AS_LLABEL: + begin + if CreateLocalLabel(actasmpattern,hl,true) then + ConcatLabel(curlist,hl); + Consume(AS_LLABEL); + end; + AS_LABEL: + begin + { when looking for Pascal labels, these must } + { be in uppercase. } + if SearchLabel(upper(actasmpattern),hl,true) then + ConcatLabel(curlist,hl) + else + Message1(asmr_e_unknown_label_identifier,actasmpattern); + Consume(AS_LABEL); + end; + AS_DW: + begin + Consume(AS_DW); + BuildConstant($ffff); + end; + AS_DB: + begin + Consume(AS_DB); + BuildConstant($ff); + end; + AS_DD: + begin + Consume(AS_DD); + BuildConstant(longint($ffffffff)); + end; + AS_XDEF: + begin + Consume(AS_XDEF); + if actasmtoken=AS_ID then + ConcatPublic(curlist,actasmpattern); + Consume(AS_ID); + if actasmtoken<>AS_SEPARATOR then + Consume(AS_SEPARATOR); + end; + AS_ALIGN: + begin + Message(asmr_w_align_not_supported); + while actasmtoken <> AS_SEPARATOR do + Consume(actasmtoken); + end; + AS_OPCODE: + begin + instr:=TM68kInstruction.Create(tm68koperand); + BuildOpcode(instr); +// instr.AddReferenceSizes; +// instr.SetInstructionOpsize; +// instr.CheckOperandSizes; + if instr.labeled then + instr.ConcatLabeledInstr(curlist) + else begin + instr.ConcatInstruction(curlist); + end; + instr.Free; +{ + instr.init; + BuildOpcode; + instr.ops := operandnum; + if instr.labeled then + ConcatLabeledInstr(instr) + else + ConcatOpCode(instr); + instr.done;} + end; + AS_SEPARATOR: + begin + Consume(AS_SEPARATOR); + { let us go back to the first operand } + operandnum := 0; + end; + AS_END: + { end assembly block } + ; + else + begin + Message(asmr_e_syntax_error); + { error recovery } + Consume(actasmtoken); + end; + end; { end case } + end; { end while } + + { Check LocalLabelList } + LocalLabelList.CheckEmitted; + LocalLabelList.Free; + + assemble:=curlist; + Message(asmr_d_finish_reading); + end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +const + asmmode_m68k_mot_info : tasmmodeinfo = + ( + id : asmmode_m68k_mot; + idtxt : 'MOTOROLA'; + casmreader : tm68kmotreader; + ); + + asmmode_m68k_standard_info : tasmmodeinfo = + ( + id : asmmode_standard; + idtxt : 'STANDARD'; + casmreader : tm68kmotreader; + ); + +begin + RegisterAsmMode(asmmode_m68k_mot_info); + RegisterAsmMode(asmmode_m68k_standard_info); +end. diff --git a/closures/compiler/m68k/rgcpu.pas b/closures/compiler/m68k/rgcpu.pas new file mode 100644 index 0000000000..a981d73a75 --- /dev/null +++ b/closures/compiler/m68k/rgcpu.pas @@ -0,0 +1,40 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements the register allocator for m68k + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} + +unit rgcpu; + +{$i fpcdefs.inc} + + interface + + uses + aasmbase,aasmtai,aasmdata, + cpubase, + rgobj; + + type + trgcpu = class(trgobj) + end; + + implementation + +end. diff --git a/closures/compiler/macho.pas b/closures/compiler/macho.pas new file mode 100644 index 0000000000..8885db4383 --- /dev/null +++ b/closures/compiler/macho.pas @@ -0,0 +1,2103 @@ +unit macho; +{ + * Copyright (c) 1999-2008 Apple Inc. All Rights Reserved. + * + * @APPLE_LICENSE_HEADER_START@ + * + * This file contains Original Code and/or Modifications of Original Code + * as defined in and that are subject to the Apple Public Source License + * Version 2.0 (the 'License'). You may not use this file except in + * compliance with the License. Please obtain a copy of the License at + * http://www.opensource.apple.com/apsl/ and read it before using this + * file. + * + * The Original Code and all software distributed under the License are + * distributed on an 'AS IS' basis, WITHOUT WARRANTY OF ANY KIND, EITHER + * EXPRESS OR IMPLIED, AND APPLE HEREBY DISCLAIMS ALL SUCH WARRANTIES, + * INCLUDING WITHOUT LIMITATION, ANY WARRANTIES OF MERCHANTABILITY, + * FITNESS FOR A PARTICULAR PURPOSE, QUIET ENJOYMENT OR NON-INFRINGEMENT. + * Please see the License for the specific language governing rights and + * limitations under the License. + * + * @APPLE_LICENSE_HEADER_END@ + } + +{ converted by Dmitry Boyarintsev 2009 } + +{$mode objfpc}{$H+} + +interface + +{$IFDEF FPC} +{$PACKRECORDS C} +{$PACKENUM 4} +{$ENDIF} + + +// mach/$arch/machine.h +// $arch can be: i386, x86_64, ppc, arm +// currently used is i386 + +type + integer_t = Integer; + uint8_t = Byte; + + int16_t = SmallInt; + uint16_t = Word; + + uint32_t = LongWord; + int32_t = Integer; + + uint64_t = QWord; + +// mach/thread_status.h + +{$ifdef i386} + +{$endif i386} + +// mach/machine.h + +type + cpu_type_t = integer_t; + cpu_subtype_t = integer_t; + cpu_threadtype_t = integer_t; + +const + CPU_STATE_MAX = 4; + + CPU_STATE_USER = 0; + CPU_STATE_SYSTEM = 1; + CPU_STATE_IDLE = 2; + CPU_STATE_NICE = 3; + + {* Capability bits used in the definition of cpu_type. } + CPU_ARCH_MASK = $ff000000; { mask for architecture bits } + CPU_ARCH_ABI64 = $01000000; { 64 bit ABI } + + { Machine types known by all. } + + CPU_TYPE_ANY = -1; + CPU_TYPE_VAX = 1; + CPU_TYPE_MC680x0 = 6; + CPU_TYPE_X86 = 7; + CPU_TYPE_I386 = CPU_TYPE_X86; { compatibility } + CPU_TYPE_X86_64 = CPU_TYPE_X86 or CPU_ARCH_ABI64; + // skip CPU_TYPE_MIPS = 8; + CPU_TYPE_MC98000 = 10; + CPU_TYPE_HPPA = 11; + CPU_TYPE_ARM = 12; + CPU_TYPE_MC88000 = 13; + CPU_TYPE_SPARC = 14; + CPU_TYPE_I860 = 15; + // skip CPU_TYPE_ALPHA = 16; */ + + CPU_TYPE_POWERPC = 18; + CPU_TYPE_POWERPC64 = CPU_TYPE_POWERPC or CPU_ARCH_ABI64; + +{* + * Machine subtypes (these are defined here, instead of in a machine + * dependent directory, so that any program can get all definitions + * regardless of where is it compiled). + *} + +{* + * Capability bits used in the definition of cpu_subtype. + *} + CPU_SUBTYPE_MASK = $ff000000; { mask for feature flags } + CPU_SUBTYPE_LIB64 = $80000000; { 64 bit libraries } + + +{* + * Object files that are hand-crafted to run on any + * implementation of an architecture are tagged with + * CPU_SUBTYPE_MULTIPLE. This functions essentially the same as + * the "ALL" subtype of an architecture except that it allows us + * to easily find object files that may need to be modified + * whenever a new implementation of an architecture comes out. + * + * It is the responsibility of the implementor to make sure the + * software handles unsupported implementations elegantly. + *} + CPU_SUBTYPE_MULTIPLE = -1; + CPU_SUBTYPE_LITTLE_ENDIAN = 0; + CPU_SUBTYPE_BIG_ENDIAN = 1; + +{* + * Machine threadtypes. + * This is none - not defined - for most machine types/subtypes. + *} + CPU_THREADTYPE_NONE = 0; + +{* + * VAX subtypes (these do *not* necessary conform to the actual cpu + * ID assigned by DEC available via the SID register). + *} + + CPU_SUBTYPE_VAX_ALL = 0; + CPU_SUBTYPE_VAX780 = 1; + CPU_SUBTYPE_VAX785 = 2; + CPU_SUBTYPE_VAX750 = 3; + CPU_SUBTYPE_VAX730 = 4; + CPU_SUBTYPE_UVAXI = 5; + CPU_SUBTYPE_UVAXII = 6; + CPU_SUBTYPE_VAX8200 = 7; + CPU_SUBTYPE_VAX8500 = 8; + CPU_SUBTYPE_VAX8600 = 9; + CPU_SUBTYPE_VAX8650 = 10; + CPU_SUBTYPE_VAX8800 = 11; + CPU_SUBTYPE_UVAXIII = 12; + +{* + * 680x0 subtypes + * + * The subtype definitions here are unusual for historical reasons. + * NeXT used to consider 68030 code as generic 68000 code. For + * backwards compatability: + * + * CPU_SUBTYPE_MC68030 symbol has been preserved for source code + * compatability. + * + * CPU_SUBTYPE_MC680x0_ALL has been defined to be the same + * subtype as CPU_SUBTYPE_MC68030 for binary comatability. + * + * CPU_SUBTYPE_MC68030_ONLY has been added to allow new object + * files to be tagged as containing 68030-specific instructions. + *} + + CPU_SUBTYPE_MC680x0_ALL = 1; + CPU_SUBTYPE_MC68030 = 1; { compat } + CPU_SUBTYPE_MC68040 = 2; + CPU_SUBTYPE_MC68030_ONLY = 3; + + {* I386 subtypes *} + + CPU_SUBTYPE_I386_ALL = 3 + (0 shl 4); + CPU_SUBTYPE_386 = 3 + (0 shl 4); + CPU_SUBTYPE_486 = 4 + (0 shl 4); + CPU_SUBTYPE_486SX = 4 + (8 shl 4); // 8 << 4 = 128 + CPU_SUBTYPE_586 = 5 + (0 shl 4); + CPU_SUBTYPE_PENT = 5 + (0 shl 4); + CPU_SUBTYPE_PENTPRO = 6 + (1 shl 4); + CPU_SUBTYPE_PENTII_M3 = 6 + (3 shl 4); + CPU_SUBTYPE_PENTII_M5 = 6 + (5 shl 4); + CPU_SUBTYPE_CELERON = 7 + (6 shl 4); + CPU_SUBTYPE_CELERON_MOBILE = 7 + (7 shl 4); + CPU_SUBTYPE_PENTIUM_3 = 8 + (0 shl 4); + CPU_SUBTYPE_PENTIUM_3_M = 8 + (1 shl 4); + CPU_SUBTYPE_PENTIUM_3_XEON = 8 + (2 shl 4); + CPU_SUBTYPE_PENTIUM_M = 9 + (0 shl 4); + CPU_SUBTYPE_PENTIUM_4 = 10 + (0 shl 4); + CPU_SUBTYPE_PENTIUM_4_M = 10 + (1 shl 4); + CPU_SUBTYPE_ITANIUM = 11 + (0 shl 4); + CPU_SUBTYPE_ITANIUM_2 = 11 + (1 shl 4); + CPU_SUBTYPE_XEON = 12 + (0 shl 4); + CPU_SUBTYPE_XEON_MP = 12 + (1 shl 4); + + CPU_SUBTYPE_INTEL_FAMILY_MAX = 15; + CPU_SUBTYPE_INTEL_MODEL_ALL = 0; + + {* X86 subtypes. *} + + CPU_SUBTYPE_X86_ALL = 3; + CPU_SUBTYPE_X86_64_ALL = 3; + CPU_SUBTYPE_X86_ARCH1 = 4; + + + CPU_THREADTYPE_INTEL_HTT = 1; + + {* Mips subtypes. *} + + CPU_SUBTYPE_MIPS_ALL = 0; + CPU_SUBTYPE_MIPS_R2300 = 1; + CPU_SUBTYPE_MIPS_R2600 = 2; + CPU_SUBTYPE_MIPS_R2800 = 3; + CPU_SUBTYPE_MIPS_R2000a = 4; {* pmax *} + CPU_SUBTYPE_MIPS_R2000 = 5; + CPU_SUBTYPE_MIPS_R3000a = 6; { 3max *} + CPU_SUBTYPE_MIPS_R3000 = 7; + + {* MC98000 (PowerPC) subtypes *} + CPU_SUBTYPE_MC98000_ALL = 0; + CPU_SUBTYPE_MC98601 = 1; + +{* + * HPPA subtypes for Hewlett-Packard HP-PA family of + * risc processors. Port by NeXT to 700 series. + *} + + CPU_SUBTYPE_HPPA_ALL = 0; + CPU_SUBTYPE_HPPA_7100 = 0; {* compat *} + CPU_SUBTYPE_HPPA_7100LC = 1; + + {* MC88000 subtypes. *} + + CPU_SUBTYPE_MC88000_ALL = 0; + CPU_SUBTYPE_MC88100 = 1; + CPU_SUBTYPE_MC88110 = 2; + + {* SPARC subtypes *} + CPU_SUBTYPE_SPARC_ALL = 0; + + {* I860 subtypes *} + CPU_SUBTYPE_I860_ALL = 0; + CPU_SUBTYPE_I860_860 = 1; + + {* PowerPC subtypes *} + + CPU_SUBTYPE_POWERPC_ALL = 0; + CPU_SUBTYPE_POWERPC_601 = 1; + CPU_SUBTYPE_POWERPC_602 = 2; + CPU_SUBTYPE_POWERPC_603 = 3; + CPU_SUBTYPE_POWERPC_603e = 4; + CPU_SUBTYPE_POWERPC_603ev = 5; + CPU_SUBTYPE_POWERPC_604 = 6; + CPU_SUBTYPE_POWERPC_604e = 7; + CPU_SUBTYPE_POWERPC_620 = 8; + CPU_SUBTYPE_POWERPC_750 = 9; + CPU_SUBTYPE_POWERPC_7400 = 10; + CPU_SUBTYPE_POWERPC_7450 = 11; + CPU_SUBTYPE_POWERPC_970 = 100; + + {* ARM subtypes *} + CPU_SUBTYPE_ARM_ALL = 0; + CPU_SUBTYPE_ARM_V4T = 5; + CPU_SUBTYPE_ARM_V6 = 6; + CPU_SUBTYPE_ARM_V5TEJ = 7; + CPU_SUBTYPE_ARM_XSCALE = 8; + +{* + * CPU families (sysctl hw.cpufamily) + * + * These are meant to identify the CPU's marketing name - an + * application can map these to (possibly) localized strings. + * NB: the encodings of the CPU families are intentionally arbitrary. + * There is no ordering, and you should never try to deduce whether + * or not some feature is available based on the family. + * Use feature flags (eg, hw.optional.altivec) to test for optional + * functionality. + *} + CPUFAMILY_UNKNOWN = 0; + CPUFAMILY_POWERPC_G3 = $cee41549; + CPUFAMILY_POWERPC_G4 = $77c184ae; + CPUFAMILY_POWERPC_G5 = $ed76d8aa; + CPUFAMILY_INTEL_6_13 = $aa33392b; + CPUFAMILY_INTEL_6_14 = $73d67300; { "Intel Core Solo" and "Intel Core Duo" (32-bit Pentium-M with SSE3) } + CPUFAMILY_INTEL_6_15 = $426f69ef; { "Intel Core 2 Duo" } + CPUFAMILY_INTEL_6_23 = $78ea4fbc; { Penryn } + CPUFAMILY_INTEL_6_26 = $6b5a4cd2; { Nehalem } + CPUFAMILY_ARM_9 = $e73283ae; + CPUFAMILY_ARM_11 = $8ff620d8; + CPUFAMILY_ARM_XSCALE = $53b005f5; + + CPUFAMILY_INTEL_YONAH = CPUFAMILY_INTEL_6_14; + CPUFAMILY_INTEL_MEROM = CPUFAMILY_INTEL_6_15; + CPUFAMILY_INTEL_PENRYN = CPUFAMILY_INTEL_6_23; + CPUFAMILY_INTEL_NEHALEM = CPUFAMILY_INTEL_6_26; + + CPUFAMILY_INTEL_CORE = CPUFAMILY_INTEL_6_14; + CPUFAMILY_INTEL_CORE2 = CPUFAMILY_INTEL_6_15; + +// mach/vm_prot.h +type + vm_prot_t = Integer; + +const + VM_PROT_NONE = $00; + + VM_PROT_READ = $01; {* read permission *} + VM_PROT_WRITE = $02; {* write permission *} + VM_PROT_EXECUTE = $04; {* execute permission *} + +{* + * The default protection for newly-created virtual memory + *} + + VM_PROT_DEFAULT = VM_PROT_READ or VM_PROT_WRITE; + +{* + * The maximum privileges possible, for parameter checking. + *} + + VM_PROT_ALL = VM_PROT_READ or VM_PROT_WRITE or VM_PROT_EXECUTE; + +{* + * An invalid protection value. + * Used only by memory_object_lock_request to indicate no change + * to page locks. Using -1 here is a bad idea because it + * looks like VM_PROT_ALL and then some. + *} + + VM_PROT_NO_CHANGE = $08; + +{* + * When a caller finds that he cannot obtain write permission on a + * mapped entry, the following flag can be used. The entry will + * be made "needs copy" effectively copying the object (using COW), + * and write permission will be added to the maximum protections + * for the associated entry. + *} + + VM_PROT_COPY = $10; + + +{* + * Another invalid protection value. + * Used only by memory_object_data_request upon an object + * which has specified a copy_call copy strategy. It is used + * when the kernel wants a page belonging to a copy of the + * object, and is only asking the object as a result of + * following a shadow chain. This solves the race between pages + * being pushed up by the memory manager and the kernel + * walking down the shadow chain. + *} + + VM_PROT_WANTS_COPY = $10; + + +{ Constant for the magic field of the mach_header (32-bit architectures) the mach magic number } + +const + MH_MAGIC = $feedface; + MH_CIGAM = $cefaedfe; { NXSwapInt(MH_MAGIC) } + + +type + { * The 32-bit mach header appears at the very beginning of the object file for 32-bit architectures. } + mach_header = record + magic : uint32_t; { mach magic number identifier } + cputype : cpu_type_t; { cpu specifier } + cpusubtype : cpu_subtype_t; { machine specifier } + filetype : uint32_t; { type of file } + ncmds : uint32_t; { number of load commands } + sizeofcmds : uint32_t; { the size of all the load commands } + flags : uint32_t; { flags } + end; + pmach_header = ^mach_header; + +type + {* The 64-bit mach header appears at the very beginning of object files for + * 64-bit architectures. } + mach_header_64 = record + magic : uint32_t; { mach magic number identifier } + cputype : cpu_type_t; { cpu specifier } + cpusubtype : cpu_subtype_t; { machine specifier } + filetype : uint32_t; { type of file } + ncmds : uint32_t; { number of load commands } + sizeofcmds : uint32_t; { the size of all the load commands } + flags : uint32_t; { flags } + reserved : uint32_t; { reserved } + end; + pmach_header_64 = ^mach_header_64; + + { Constant for the magic field of the mach_header_64 (64-bit architectures) } + { the 64-bit mach magic number } + +const + MH_MAGIC_64 = $feedfacf; + MH_CIGAM_64 = $cffaedfe; { NXSwapInt(MH_MAGIC_64) } + + {* The layout of the file depends on the filetype. For all but the MH_OBJECT + * file type the segments are padded out and aligned on a segment alignment + * boundary for efficient demand pageing. The MH_EXECUTE, MH_FVMLIB, MH_DYLIB, + * MH_DYLINKER and MH_BUNDLE file types also have the headers included as part + * of their first segment. + * + * The file type MH_OBJECT is a compact format intended as output of the + * assembler and input (and possibly output) of the link editor (the .o + * format). All sections are in one unnamed segment with no segment padding. + * This format is used as an executable format when the file is so small the + * segment padding greatly increases its size. + * + * The file type MH_PRELOAD is an executable format intended for things that + * are not executed under the kernel (proms, stand alones, kernels, etc). The + * format can be executed under the kernel but may demand paged it and not + * preload it before execution. + * + * A core file is in MH_CORE format and can be any in an arbritray legal + * Mach-O file. + * + * Constants for the filetype field of the mach_header } +const + MH_OBJECT = $1; { relocatable object file } + MH_EXECUTE = $2; { demand paged executable file } + MH_FVMLIB = $3; { fixed VM shared library file } + MH_CORE = $4; { core file } + MH_PRELOAD = $5; { preloaded executable file } + MH_DYLIB = $6; { dynamically bound shared library } + MH_DYLINKER = $7; { dynamic link editor } + MH_BUNDLE = $8; { dynamically bound bundle file } + MH_DYLIB_STUB = $9; { shared library stub for static } + MH_DSYM = $a; { linking only, no section contents } + { companion file with only debug sections } + +const + { Constants for the flags field of the mach_header } + + MH_NOUNDEFS = $1; { the object file has no undefined references } + MH_INCRLINK = $2; { the object file is the output of an incremental link against a base file and can't be link edited again } + MH_DYLDLINK = $4; { the object file is input for the dynamic linker and can't be staticly link edited again } + MH_BINDATLOAD = $8; { the object file's undefined references are bound by the dynamic linker when loaded. } + MH_PREBOUND = $10; { the file has its dynamic undefined references prebound. } + MH_SPLIT_SEGS = $20; { the file has its read-only and read-write segments split } + MH_LAZY_INIT = $40; { the shared library init routine is to be run lazily via catching memory faults to its writeable segments (obsolete) } + MH_TWOLEVEL = $80; { the image is using two-level name space bindings } + MH_FORCE_FLAT = $100; { the executable is forcing all images to use flat name space bindings } + MH_NOMULTIDEFS = $200; { this umbrella guarantees no multiple defintions of symbols in its sub-images so the two-level namespace hints can always be used. } + MH_NOFIXPREBINDING = $400; { do not have dyld notify the prebinding agent about this executable } + MH_PREBINDABLE = $800; { the binary is not prebound but can have its prebinding redone. only used when MH_PREBOUND is not set. } + MH_ALLMODSBOUND = $1000; { indicates that this binary binds to all two-level namespace modules of } + { its dependent libraries. only used when MH_PREBINDABLE and MH_TWOLEVEL are both set. } + MH_SUBSECTIONS_VIA_SYMBOLS = $2000; { safe to divide up the sections into sub-sections via symbols for dead code stripping } + MH_CANONICAL = $4000; { the binary has been canonicalized via the unprebind operation } + MH_WEAK_DEFINES = $8000; { the final linked image contains external weak symbols } + MH_BINDS_TO_WEAK = $10000; { the final linked image uses weak symbols } + MH_ALLOW_STACK_EXECUTION = $20000; { When this bit is set, all stacks in the task will be given stack } + { execution privilege. Only used in MH_EXECUTE filetypes. } + MH_ROOT_SAFE = $40000; { When this bit is set, the binary declares it is safe for use in processes with uid zero } + MH_SETUID_SAFE = $80000; { When this bit is set, the binary declares it is safe for use in processes when issetugid() is true } + MH_NO_REEXPORTED_DYLIBS = $100000; { When this bit is set on a dylib, the static linker does not need to examine dependent dylibs to see if any are re-exported } + MH_PIE = $200000; { When this bit is set, the OS will load the main executable at a random address. Only used in MH_EXECUTE filetypes. } + + { + * The load commands directly follow the mach_header. The total size of all + * of the commands is given by the sizeofcmds field in the mach_header. All + * load commands must have as their first two fields cmd and cmdsize. The cmd + * field is filled in with a constant for that command type. Each command type + * has a structure specifically for it. The cmdsize field is the size in bytes + * of the particular load command structure plus anything that follows it that + * is a part of the load command (i.e. section structures, strings, etc.). To + * advance to the next load command the cmdsize can be added to the offset or + * pointer of the current load command. The cmdsize for 32-bit architectures + * MUST be a multiple of 4 bytes and for 64-bit architectures MUST be a multiple + * of 8 bytes (these are forever the maximum alignment of any load commands). + * The padded bytes must be zero. All tables in the object file must also + * follow these rules so the file can be memory mapped. Otherwise the pointers + * to these tables will not work well or at all on some machines. With all + * padding zeroed like objects will compare byte for byte. + } + +type + load_command = record + cmd : uint32_t; { type of load command } + cmdsize : uint32_t; { total size of command in bytes } + end; + pload_command = ^load_command; + + { + * After MacOS X 10.1 when a new load command is added that is required to be + * understood by the dynamic linker for the image to execute properly the + * LC_REQ_DYLD bit will be or'ed into the load command constant. If the dynamic + * linker sees such a load command it it does not understand will issue a + * "unknown load command required for execution" error and refuse to use the + * image. Other load commands without this bit that are not understood will + * simply be ignored. + } +const + LC_REQ_DYLD = $80000000; + +{ Constants for the cmd field of all load commands, the type } +const + LC_SEGMENT = $1; { segment of this file to be mapped } + LC_SYMTAB = $2; { link-edit stab symbol table info } + LC_SYMSEG = $3; { link-edit gdb symbol table info (obsolete) } + LC_THREAD = $4; { thread } + LC_UNIXTHREAD = $5; { unix thread (includes a stack) } + LC_LOADFVMLIB = $6; { load a specified fixed VM shared library } + LC_IDFVMLIB = $7; { fixed VM shared library identification } + LC_IDENT = $8; { object identification info (obsolete) } + LC_FVMFILE = $9; { fixed VM file inclusion (internal use) } + LC_PREPAGE = $a; { prepage command (internal use) } + LC_DYSYMTAB = $b; { dynamic link-edit symbol table info } + LC_LOAD_DYLIB = $c; { load a dynamically linked shared library } + LC_ID_DYLIB = $d; { dynamically linked shared lib ident } + LC_LOAD_DYLINKER = $e; { load a dynamic linker } + LC_ID_DYLINKER = $f; { dynamic linker identification } + LC_PREBOUND_DYLIB = $10; { modules prebound for a dynamically linked shared library } + LC_ROUTINES = $11; { image routines } + LC_SUB_FRAMEWORK = $12; { sub framework } + LC_SUB_UMBRELLA = $13; { sub umbrella } + LC_SUB_CLIENT = $14; { sub client } + LC_SUB_LIBRARY = $15; { sub library } + LC_TWOLEVEL_HINTS = $16; { two-level namespace lookup hints } + LC_PREBIND_CKSUM = $17; { prebind checksum } + LC_LOAD_WEAK_DYLIB = $18 or LC_REQ_DYLD; { load a dynamically linked shared library that is allowed to be missing (all symbols are weak imported). } + LC_SEGMENT_64 = $19; { 64-bit segment of this file to be mapped } + LC_ROUTINES_64 = $1a; { 64-bit image routines } + LC_UUID = $1b; { the uuid } + LC_RPATH = $1c or LC_REQ_DYLD; { runpath additions } + LC_CODE_SIGNATURE = $1d; { local of code signature } + LC_SEGMENT_SPLIT_INFO = $1e; { local of info to split segments } + LC_REEXPORT_DYLIB = $1f or LC_REQ_DYLD; { load and re-export dylib } + LC_LAZY_LOAD_DYLIB = $20; { delay load of dylib until first use } + LC_ENCRYPTION_INFO = $21; { encrypted segment information } + { + * A variable length string in a load command is represented by an lc_str + * union. The strings are stored just after the load command structure and + * the offset is from the start of the load command structure. The size + * of the string is reflected in the cmdsize field of the load command. + * Once again any padded bytes to bring the cmdsize field to a multiple + * of 4 bytes must be zero. + } + { offset to the string } +{$ifndef __LP64__} + { pointer to the string } +{$endif} + +type + lc_str = record + case longint of + 0 : ( offset : uint32_t ); + 1 : ( ptr : ^char ); + end; + + { + * The segment load command indicates that a part of this file is to be + * mapped into the task's address space. The size of this segment in memory, + * vmsize, maybe equal to or larger than the amount to map from this file, + * filesize. The file is mapped starting at fileoff to the beginning of + * the segment in memory, vmaddr. The rest of the memory of the segment, + * if any, is allocated zero fill on demand. The segment's maximum virtual + * memory protection and initial virtual memory protection are specified + * by the maxprot and initprot fields. If the segment has sections then the + * section structures directly follow the segment command and their size is + * reflected in cmdsize. + } + + { for 32-bit architectures } + + segment_command = record + cmd : uint32_t; { LC_SEGMENT } + cmdsize : uint32_t; { includes sizeof section structs } + segname : array[0..15] of char; { segment name } + vmaddr : uint32_t; { memory address of this segment } + vmsize : uint32_t; { memory size of this segment } + fileoff : uint32_t; { file offset of this segment } + filesize : uint32_t; { amount to map from the file } + maxprot : vm_prot_t; { maximum VM protection } + initprot : vm_prot_t; { initial VM protection } + nsects : uint32_t; { number of sections in segment } + flags : uint32_t; { flags } + end; + psegment_command = ^segment_command; + + { + * The 64-bit segment load command indicates that a part of this file is to be + * mapped into a 64-bit task's address space. If the 64-bit segment has + * sections then section_64 structures directly follow the 64-bit segment + * command and their size is reflected in cmdsize. + } + { for 64-bit architectures } + + segment_command_64 = record + cmd : uint32_t; { LC_SEGMENT_64 } + cmdsize : uint32_t; { includes sizeof section_64 structs } + segname : array[0..15] of char; { segment name } + vmaddr : uint64_t; { memory address of this segment } + vmsize : uint64_t; { memory size of this segment } + fileoff : uint64_t; { file offset of this segment } + filesize : uint64_t; { amount to map from the file } + maxprot : vm_prot_t; { maximum VM protection } + initprot : vm_prot_t; { initial VM protection } + nsects : uint32_t; { number of sections in segment } + flags : uint32_t; { flags } + end; + psegment_command_64 = ^segment_command_64; + + { Constants for the flags field of the segment_command } + +const + SG_HIGHVM = $1; { the file contents for this segment is for } + { the high part of the VM space, the low part } + { is zero filled (for stacks in core files) } + + SG_FVMLIB = $2; { this segment is the VM that is allocated by } + { a fixed VM library, for overlap checking in } + { the link editor } + + SG_NORELOC = $4; { this segment has nothing that was relocated } + { in it and nothing relocated to it, that is } + { it maybe safely replaced without relocation } + + SG_PROTECTED_VERSION_1 = $8; { This segment is protected. If the } + { segment starts at file offset 0, the } + { first page of the segment is not } + { protected. All other pages of the } + { segment are protected. } + + {* A segment is made up of zero or more sections. Non-MH_OBJECT files have + * all of their segments with the proper sections in each, and padded to the + * specified segment alignment when produced by the link editor. The first + * segment of a MH_EXECUTE and MH_FVMLIB format file contains the mach_header + * and load commands of the object file before its first section. The zero + * fill sections are always last in their segment (in all formats). This + * allows the zeroed segment padding to be mapped into memory where zero fill + * sections might be. The gigabyte zero fill sections, those with the section + * type S_GB_ZEROFILL, can only be in a segment with sections of this type. + * These segments are then placed after all other segments. + * + * The MH_OBJECT format has all of its sections in one segment for + * compactness. There is no padding to a specified segment boundary and the + * mach_header and load commands are not part of the segment. + * + * Sections with the same section name, sectname, going into the same segment, + * segname, are combined by the link editor. The resulting section is aligned + * to the maximum alignment of the combined sections and is the new section's + * alignment. The combined sections are aligned to their original alignment in + * the combined section. Any padded bytes to get the specified alignment are + * zeroed. + * + * The format of the relocation entries referenced by the reloff and nreloc + * fields of the section structure for mach object files is described in the + * header file <reloc.h>. } + +type + { for 32-bit architectures } + section = record + sectname : array[0..15] of char; { name of this section } + segname : array[0..15] of char; { segment this section goes in } + addr : uint32_t; { memory address of this section } + size : uint32_t; { size in bytes of this section } + offset : uint32_t; { file offset of this section } + align : uint32_t; { section alignment (power of 2) } + reloff : uint32_t; { file offset of relocation entries } + nreloc : uint32_t; { number of relocation entries } + flags : uint32_t; { flags (section type and attributes) } + reserved1 : uint32_t; { reserved (for offset or index) } + reserved2 : uint32_t; { reserved (for count or sizeof) } + end; + psection = ^section; + + + { for 64-bit architectures } + section_64 = record + sectname : array[0..15] of char; { name of this section } + segname : array[0..15] of char; { segment this section goes in } + addr : uint64_t; { memory address of this section } + size : uint64_t; { size in bytes of this section } + offset : uint32_t; { file offset of this section } + align : uint32_t; { section alignment (power of 2) } + reloff : uint32_t; { file offset of relocation entries } + nreloc : uint32_t; { number of relocation entries } + flags : uint32_t; { flags (section type and attributes) } + reserved1 : uint32_t; { reserved (for offset or index) } + reserved2 : uint32_t; { reserved (for count or sizeof) } + reserved3 : uint32_t; { reserved } + end; + psection_64 = ^section_64; + + {* The flags field of a section structure is separated into two parts a section + * type and section attributes. The section types are mutually exclusive (it + * can only have one type) but the section attributes are not (it may have more + * than one attribute). } + + { 256 section types } + +const + SECTION_TYPE = $000000ff; { Constants for the type of a section } + SECTION_ATTRIBUTES = $ffffff00; { 24 section attributes } + S_REGULAR = $0; { regular section } + S_ZEROFILL = $1; { zero fill on demand section } + S_CSTRING_LITERALS = $2; { section with only literal C strings } + S_4BYTE_LITERALS = $3; { section with only 4 byte literals } + S_8BYTE_LITERALS = $4; { section with only 8 byte literals } + S_LITERAL_POINTERS = $5; { section with only pointers to literals } + + {* For the two types of symbol pointers sections and the symbol stubs section + * they have indirect symbol table entries. For each of the entries in the + * section the indirect symbol table entries, in corresponding order in the + * indirect symbol table, start at the index stored in the reserved1 field + * of the section structure. Since the indirect symbol table entries + * correspond to the entries in the section the number of indirect symbol table + * entries is inferred from the size of the section divided by the size of the + * entries in the section. For symbol pointers sections the size of the entries + * in the section is 4 bytes and for symbol stubs sections the byte size of the + * stubs is stored in the reserved2 field of the section structure. } + + S_NON_LAZY_SYMBOL_POINTERS = $6; { section with only non-lazy symbol pointers } + S_LAZY_SYMBOL_POINTERS = $7; { section with only lazy symbol pointers } + S_SYMBOL_STUBS = $8; { section with only symbol stubs, byte size of stub in the reserved2 field } + S_MOD_INIT_FUNC_POINTERS = $9; { section with only function pointers for initialization } + S_MOD_TERM_FUNC_POINTERS = $a; { section with only function pointers for termination } + S_COALESCED = $b; { section contains symbols that are to be coalesced } + S_GB_ZEROFILL = $c; { zero fill on demand section (that can be larger than 4 gigabytes) } + S_INTERPOSING = $d; { section with only pairs of function pointers for interposing } + S_16BYTE_LITERALS = $e; { section with only 16 byte literals } + S_DTRACE_DOF = $f; { section contains DTrace Object Format } + S_LAZY_DYLIB_SYMBOL_POINTERS = $10; { section with only lazy symbol pointers to lazy loaded dylibs } + + {* Constants for the section attributes part of the flags field of a section structure. } + + SECTION_ATTRIBUTES_USR = $ff000000; { User setable attributes } + + S_ATTR_PURE_INSTRUCTIONS = $80000000; { section contains only true machine instructions } + S_ATTR_NO_TOC = $40000000; { section contains coalesced symbols } + { that are not to be in a ranlib table of contents } + S_ATTR_STRIP_STATIC_SYMS = $20000000; { ok to strip static symbols this section } + { in files with the MH_DYLDLINK flag } + S_ATTR_NO_DEAD_STRIP = $10000000; { no dead stripping } + S_ATTR_LIVE_SUPPORT = $08000000; { blocks are live if they reference live blocks } + S_ATTR_SELF_MODIFYING_CODE = $04000000; { Used with i386 code stubs written on by dyld } + + { + * If a segment contains any sections marked with S_ATTR_DEBUG then all + * sections in that segment must have this attribute. No section other than + * a section marked with this attribute may reference the contents of this + * section. A section with this attribute may contain no symbols and must have + * a section type S_REGULAR. The static linker will not copy section contents + * from sections with this attribute into its output file. These sections + * generally contain DWARF debugging info. + } { a debug section } + S_ATTR_DEBUG = $02000000; + { system setable attributes } + SECTION_ATTRIBUTES_SYS = $00ffff00; + { section contains some + machine instructions } + S_ATTR_SOME_INSTRUCTIONS = $00000400; + { section has external + relocation entries } + S_ATTR_EXT_RELOC = $00000200; + { section has local + relocation entries } + S_ATTR_LOC_RELOC = $00000100; + { + * The names of segments and sections in them are mostly meaningless to the + * link-editor. But there are few things to support traditional UNIX + * executables that require the link-editor and assembler to use some names + * agreed upon by convention. + * + * The initial protection of the "__TEXT" segment has write protection turned + * off (not writeable). + * + * The link-editor will allocate common symbols at the end of the "__common" + * section in the "__DATA" segment. It will create the section and segment + * if needed. + } + { The currently known segment names and the section names in those segments } + + + SEG_PAGEZERO = '__PAGEZERO'; { the pagezero segment which has no } + { protections and catches NULL references for MH_EXECUTE files } + + SEG_TEXT = '__TEXT'; { the tradition UNIX text segment } + SECT_TEXT = '__text'; { the real text part of the text } + SECT_FVMLIB_INIT0 = '__fvmlib_init0'; { the fvmlib initialization section } + SECT_FVMLIB_INIT1 = '__fvmlib_init1'; { the section following the fvmlib initialization section } + + SEG_DATA = '__DATA'; { the tradition UNIX data segment } + SECT_DATA = '__data'; { the real initialized data section no padding, no bss overlap } + SECT_BSS = '__bss'; { the real uninitialized data section no padding } + SECT_COMMON = '__common'; { the section common symbols are allocated in by the link editor } + + SEG_OBJC = '__OBJC'; { objective-C runtime segment } + SECT_OBJC_SYMBOLS = '__symbol_table'; { symbol table } + SECT_OBJC_MODULES = '__module_info'; { module information } + SECT_OBJC_STRINGS = '__selector_strs'; { string table } + SECT_OBJC_REFS = '__selector_refs'; { string table } + + SEG_ICON = '__ICON'; { the icon segment } + SECT_ICON_HEADER = '__header'; { the icon headers } + SECT_ICON_TIFF = '__tiff'; { the icons in tiff format } + + SEG_LINKEDIT = '__LINKEDIT'; { the segment containing all structs } + { created and maintained by the linkeditor. } + { Created with -seglinkedit option to ld(1) for MH_EXECUTE and FVMLIB file types only } + + SEG_UNIXSTACK = '__UNIXSTACK'; { the unix stack segment } + + SEG_IMPORT = '__IMPORT'; { the segment for the self (dyld) } + { modifing code stubs that has read, write and execute permissions } + + {* Fixed virtual memory shared libraries are identified by two things. The + * target pathname (the name of the library as found for execution), and the + * minor version number. The address of where the headers are loaded is in + * header_addr. (THIS IS OBSOLETE and no longer supported). } + +type + fvmlib = record + name : lc_str; { library's target pathname } + minor_version : uint32_t; { library's minor version number } + header_addr : uint32_t; { library's header address } + end; + + {* A fixed virtual shared library (filetype == MH_FVMLIB in the mach header) + * contains a fvmlib_command (cmd == LC_IDFVMLIB) to identify the library. + * An object that uses a fixed virtual shared library also contains a + * fvmlib_command (cmd == LC_LOADFVMLIB) for each library it uses. + * (THIS IS OBSOLETE and no longer supported). } + + fvmlib_command = record + cmd : uint32_t; { LC_IDFVMLIB or LC_LOADFVMLIB } + cmdsize : uint32_t; { includes pathname string } + fvmlib : fvmlib; { the library identification } + end; + pfvmlib_command = ^fvmlib_command; + + {* Dynamicly linked shared libraries are identified by two things. The + * pathname (the name of the library as found for execution), and the + * compatibility version number. The pathname must match and the compatibility + * number in the user of the library must be greater than or equal to the + * library being used. The time stamp is used to record the time a library was + * built and copied into user so it can be use to determined if the library used + * at runtime is exactly the same as used to built the program. } + + dylib = record + name : lc_str; { library's path name } + timestamp : uint32_t; { library's build time stamp } + current_version : uint32_t; { library's current version number } + compatibility_version : uint32_t; { library's compatibility vers number } + end; + + {* A dynamically linked shared library (filetype == MH_DYLIB in the mach header) + * contains a dylib_command (cmd == LC_ID_DYLIB) to identify the library. + * An object that uses a dynamically linked shared library also contains a + * dylib_command (cmd == LC_LOAD_DYLIB, LC_LOAD_WEAK_DYLIB, or + * LC_REEXPORT_DYLIB) for each library it uses. } + + dylib_command = record + cmd : uint32_t; { LC_ID_DYLIB, LC_LOAD_DYLIB,WEAK_DYLIB, LC_REEXPORT_DYLIB } + cmdsize : uint32_t; { includes pathname string } + dylib : dylib; { the library identification } + end; + pdylib_command = ^dylib_command; + + {* A dynamically linked shared library may be a subframework of an umbrella + * framework. If so it will be linked with "-umbrella umbrella_name" where + * Where "umbrella_name" is the name of the umbrella framework. A subframework + * can only be linked against by its umbrella framework or other subframeworks + * that are part of the same umbrella framework. Otherwise the static link + * editor produces an error and states to link against the umbrella framework. + * The name of the umbrella framework for subframeworks is recorded in the + * following structure. } + + sub_framework_command = record + cmd : uint32_t; { LC_SUB_FRAMEWORK } + cmdsize : uint32_t; { includes umbrella string } + umbrella : lc_str; { the umbrella framework name } + end; + psub_framework_command = ^sub_framework_command; + + + {* For dynamically linked shared libraries that are subframework of an umbrella + * framework they can allow clients other than the umbrella framework or other + * subframeworks in the same umbrella framework. To do this the subframework + * is built with "-allowable_client client_name" and an LC_SUB_CLIENT load + * command is created for each -allowable_client flag. The client_name is + * usually a framework name. It can also be a name used for bundles clients + * where the bundle is built with "-client_name client_name". } + + sub_client_command = record + cmd : uint32_t; { LC_SUB_CLIENT } + cmdsize : uint32_t; { includes client string } + client : lc_str; { the client name } + end; + psub_client_command = ^sub_client_command; + + { + * A dynamically linked shared library may be a sub_umbrella of an umbrella + * framework. If so it will be linked with "-sub_umbrella umbrella_name" where + * Where "umbrella_name" is the name of the sub_umbrella framework. When + * staticly linking when -twolevel_namespace is in effect a twolevel namespace + * umbrella framework will only cause its subframeworks and those frameworks + * listed as sub_umbrella frameworks to be implicited linked in. Any other + * dependent dynamic libraries will not be linked it when -twolevel_namespace + * is in effect. The primary library recorded by the static linker when + * resolving a symbol in these libraries will be the umbrella framework. + * Zero or more sub_umbrella frameworks may be use by an umbrella framework. + * The name of a sub_umbrella framework is recorded in the following structure. + } + + sub_umbrella_command = record + cmd : uint32_t; { LC_SUB_UMBRELLA } + cmdsize : uint32_t; { includes sub_umbrella string } + sub_umbrella : lc_str; { the sub_umbrella framework name } + end; + + {* A dynamically linked shared library may be a sub_library of another shared + * library. If so it will be linked with "-sub_library library_name" where + * Where "library_name" is the name of the sub_library shared library. When + * staticly linking when -twolevel_namespace is in effect a twolevel namespace + * shared library will only cause its subframeworks and those frameworks + * listed as sub_umbrella frameworks and libraries listed as sub_libraries to + * be implicited linked in. Any other dependent dynamic libraries will not be + * linked it when -twolevel_namespace is in effect. The primary library + * recorded by the static linker when resolving a symbol in these libraries + * will be the umbrella framework (or dynamic library). Zero or more sub_library + * shared libraries may be use by an umbrella framework or (or dynamic library). + * The name of a sub_library framework is recorded in the following structure. + * For example /usr/lib/libobjc_profile.A.dylib would be recorded as "libobjc".} + + sub_library_command = record + cmd : uint32_t; { LC_SUB_LIBRARY } + cmdsize : uint32_t; { includes sub_library string } + sub_library : lc_str; { the sub_library name } + end; + psub_library_command = ^sub_library_command; + + {* A program (filetype == MH_EXECUTE) that is + * prebound to its dynamic libraries has one of these for each library that + * the static linker used in prebinding. It contains a bit vector for the + * modules in the library. The bits indicate which modules are bound (1) and + * which are not (0) from the library. The bit for module 0 is the low bit + * of the first byte. So the bit for the Nth module is: + * (linked_modules[N/8] >> N%8) & 1 } + + prebound_dylib_command = record + cmd : uint32_t; { LC_PREBOUND_DYLIB } + cmdsize : uint32_t; { includes strings } + name : lc_str; { library's path name } + nmodules : uint32_t; { number of modules in library } + linked_modules : lc_str; { bit vector of linked modules } + end; + pprebound_dylib_command = ^prebound_dylib_command; + + + {* A program that uses a dynamic linker contains a dylinker_command to identify + * the name of the dynamic linker (LC_LOAD_DYLINKER). And a dynamic linker + * contains a dylinker_command to identify the dynamic linker (LC_ID_DYLINKER). + * A file can have at most one of these.} + + dylinker_command = record + cmd : uint32_t; { LC_ID_DYLINKER or LC_LOAD_DYLINKER } + cmdsize : uint32_t; { includes pathname string } + name : lc_str; { dynamic linker's path name } + end; + pdylinker_command = ^dylinker_command; + + { + * Thread commands contain machine-specific data structures suitable for + * use in the thread state primitives. The machine specific data structures + * follow the struct thread_command as follows. + * Each flavor of machine specific data structure is preceded by an unsigned + * long constant for the flavor of that data structure, an uint32_t + * that is the count of longs of the size of the state data structure and then + * the state data structure follows. This triple may be repeated for many + * flavors. The constants for the flavors, counts and state data structure + * definitions are expected to be in the header file <machine/thread_status.h>. + * These machine specific data structures sizes must be multiples of + * 4 bytes The cmdsize reflects the total size of the thread_command + * and all of the sizes of the constants for the flavors, counts and state + * data structures. + * + * For executable objects that are unix processes there will be one + * thread_command (cmd == LC_UNIXTHREAD) created for it by the link-editor. + * This is the same as a LC_THREAD, except that a stack is automatically + * created (based on the shell's limit for the stack size). Command arguments + * and environment variables are copied onto that stack. + } + + thread_command = record + cmd : uint32_t; { LC_THREAD or LC_UNIXTHREAD } + cmdsize : uint32_t; { total size of this command } + flavor : uint32_t; { uint32_t flavor flavor of thread state } + count : uint32_t; { uint32_t count count of longs in thread state } + { struct XXX_thread_state state thread state for this flavor } + { ... } + end; + pthread_command = ^thread_command; + + {* The routines command contains the address of the dynamic shared library + * initialization routine and an index into the module table for the module + * that defines the routine. Before any modules are used from the library the + * dynamic linker fully binds the module that defines the initialization routine + * and then calls it. This gets called before any module initialization + * routines (used for C++ static constructors) in the library. } + { for 32-bit architectures } + + routines_command = record + cmd : uint32_t; { LC_ROUTINES } + cmdsize : uint32_t; { total size of this command } + init_address : uint32_t; { address of initialization routine } + init_module : uint32_t; { index into the module table that the init routine is defined in } + reserved1 : uint32_t; + reserved2 : uint32_t; + reserved3 : uint32_t; + reserved4 : uint32_t; + reserved5 : uint32_t; + reserved6 : uint32_t; + end; + proutines_command = ^routines_command; + + { * The 64-bit routines command. Same use as above. } + { for 64-bit architectures } + + routines_command_64 = record + cmd : uint32_t; { LC_ROUTINES_64 } + cmdsize : uint32_t; { total size of this command } + init_address : uint64_t; { address of initialization routine } + init_module : uint64_t; { index into the module table that } + { the init routine is defined in } + reserved1 : uint64_t; + reserved2 : uint64_t; + reserved3 : uint64_t; + reserved4 : uint64_t; + reserved5 : uint64_t; + reserved6 : uint64_t; + end; + proutines_command_64 = ^routines_command_64; + + {* The symtab_command contains the offsets and sizes of the link-edit 4.3BSD + * "stab" style symbol table information as described in the header files + * <nlist.h> and <stab.h>. + } + + symtab_command = record + cmd : uint32_t; { LC_SYMTAB } + cmdsize : uint32_t; { sizeof(struct symtab_command) } + symoff : uint32_t; { symbol table offset } + nsyms : uint32_t; { number of symbol table entries } + stroff : uint32_t; { string table offset } + strsize : uint32_t; { string table size in bytes } + end; + psymtab_command = ^symtab_command; + + { + * This is the second set of the symbolic information which is used to support + * the data structures for the dynamically link editor. + * + * The original set of symbolic information in the symtab_command which contains + * the symbol and string tables must also be present when this load command is + * present. When this load command is present the symbol table is organized + * into three groups of symbols: + * local symbols (static and debugging symbols) - grouped by module + * defined external symbols - grouped by module (sorted by name if not lib) + * undefined external symbols (sorted by name if MH_BINDATLOAD is not set, + * and in order the were seen by the static + * linker if MH_BINDATLOAD is set) + * In this load command there are offsets and counts to each of the three groups + * of symbols. + * + * This load command contains a the offsets and sizes of the following new + * symbolic information tables: + * table of contents + * module table + * reference symbol table + * indirect symbol table + * The first three tables above (the table of contents, module table and + * reference symbol table) are only present if the file is a dynamically linked + * shared library. For executable and object modules, which are files + * containing only one module, the information that would be in these three + * tables is determined as follows: + * table of contents - the defined external symbols are sorted by name + * module table - the file contains only one module so everything in the + * file is part of the module. + * reference symbol table - is the defined and undefined external symbols + * + * For dynamically linked shared library files this load command also contains + * offsets and sizes to the pool of relocation entries for all sections + * separated into two groups: + * external relocation entries + * local relocation entries + * For executable and object modules the relocation entries continue to hang + * off the section structures. + } + + dysymtab_command = record + cmd : uint32_t; { LC_DYSYMTAB } + cmdsize : uint32_t; { sizeof(struct dysymtab_command) } + { + * The symbols indicated by symoff and nsyms of the LC_SYMTAB load command + * are grouped into the following three groups: + * local symbols (further grouped by the module they are from) + * defined external symbols (further grouped by the module they are from) + * undefined symbols + * + * The local symbols are used only for debugging. The dynamic binding + * process may have to use them to indicate to the debugger the local + * symbols for a module that is being bound. + * + * The last two groups are used by the dynamic binding process to do the + * binding (indirectly through the module table and the reference symbol + * table when this is a dynamically linked shared library file). + } + ilocalsym : uint32_t; { index to local symbols } + nlocalsym : uint32_t; { number of local symbols } + iextdefsym : uint32_t; { index to externally defined symbols } + nextdefsym : uint32_t; { number of externally defined symbols } + iundefsym : uint32_t; { index to undefined symbols } + nundefsym : uint32_t; { number of undefined symbols } + { + * For the for the dynamic binding process to find which module a symbol + * is defined in the table of contents is used (analogous to the ranlib + * structure in an archive) which maps defined external symbols to modules + * they are defined in. This exists only in a dynamically linked shared + * library file. For executable and object modules the defined external + * symbols are sorted by name and is use as the table of contents. + } + tocoff : uint32_t; { file offset to table of contents } + ntoc : uint32_t; { number of entries in table of contents } + { + * To support dynamic binding of "modules" (whole object files) the symbol + * table must reflect the modules that the file was created from. This is + * done by having a module table that has indexes and counts into the merged + * tables for each module. The module structure that these two entries + * refer to is described below. This exists only in a dynamically linked + * shared library file. For executable and object modules the file only + * contains one module so everything in the file belongs to the module. + } + modtaboff : uint32_t; { file offset to module table } + nmodtab : uint32_t; { number of module table entries } + { + * To support dynamic module binding the module structure for each module + * indicates the external references (defined and undefined) each module + * makes. For each module there is an offset and a count into the + * reference symbol table for the symbols that the module references. + * This exists only in a dynamically linked shared library file. For + * executable and object modules the defined external symbols and the + * undefined external symbols indicates the external references. + } + extrefsymoff : uint32_t; { offset to referenced symbol table } + nextrefsyms : uint32_t; { number of referenced symbol table entries } + { + * The sections that contain "symbol pointers" and "routine stubs" have + * indexes and (implied counts based on the size of the section and fixed + * size of the entry) into the "indirect symbol" table for each pointer + * and stub. For every section of these two types the index into the + * indirect symbol table is stored in the section header in the field + * reserved1. An indirect symbol table entry is simply a 32bit index into + * the symbol table to the symbol that the pointer or stub is referring to. + * The indirect symbol table is ordered to match the entries in the section. + } + indirectsymoff : uint32_t; { file offset to the indirect symbol table } + nindirectsyms : uint32_t; { number of indirect symbol table entries } + { * To support relocating an individual module in a library file quickly the + * external relocation entries for each module in the library need to be + * accessed efficiently. Since the relocation entries can't be accessed + * through the section headers for a library file they are separated into + * groups of local and external entries further grouped by module. In this + * case the presents of this load command who's extreloff, nextrel, + * locreloff and nlocrel fields are non-zero indicates that the relocation + * entries of non-merged sections are not referenced through the section + * structures (and the reloff and nreloc fields in the section headers are + * set to zero). + * + * Since the relocation entries are not accessed through the section headers + * this requires the r_address field to be something other than a section + * offset to identify the item to be relocated. In this case r_address is + * set to the offset from the vmaddr of the first LC_SEGMENT command. + * For MH_SPLIT_SEGS images r_address is set to the the offset from the + * vmaddr of the first read-write LC_SEGMENT command. + * + * The relocation entries are grouped by module and the module table + * entries have indexes and counts into them for the group of external + * relocation entries for that the module. + * + * For sections that are merged across modules there must not be any + * remaining external relocation entries for them (for merged sections + * remaining relocation entries must be local). + } + extreloff : uint32_t; { offset to external relocation entries } + nextrel : uint32_t; { number of external relocation entries } + { * All the local relocation entries are grouped together (they are not + * grouped by their module since they are only used if the object is moved + * from it staticly link edited address). } + locreloff : uint32_t; { offset to local relocation entries } + nlocrel : uint32_t; { number of local relocation entries } + end; + + { + * An indirect symbol table entry is simply a 32bit index into the symbol table + * to the symbol that the pointer or stub is refering to. Unless it is for a + * non-lazy symbol pointer section for a defined symbol which strip(1) as + * removed. In which case it has the value INDIRECT_SYMBOL_LOCAL. If the + * symbol was also absolute INDIRECT_SYMBOL_ABS is or'ed with that. + } + +const + INDIRECT_SYMBOL_LOCAL = $80000000; + INDIRECT_SYMBOL_ABS = $40000000; + +type + dylib_table_of_contents = record { a table of contents entry } + symbol_index : uint32_t; { the defined external symbol (index into the symbol table) } + module_index : uint32_t; { index into the module table this symbol is defined in } + end; + + dylib_module = record { a module table entry } + module_name : uint32_t; { the module name (index into string table) } + iextdefsym : uint32_t; { index into externally defined symbols } + nextdefsym : uint32_t; { number of externally defined symbols } + irefsym : uint32_t; { index into reference symbol table } + nrefsym : uint32_t; { number of reference symbol table entries } + ilocalsym : uint32_t; { index into symbols for local symbols } + nlocalsym : uint32_t; { number of local symbols } + iextrel : uint32_t; { index into external relocation entries } + nextrel : uint32_t; { number of external relocation entries } + iinit_iterm : uint32_t; { low 16 bits are the index into the init + section, high 16 bits are the index into + the term section } + ninit_nterm : uint32_t; { low 16 bits are the number of init section + entries, high 16 bits are the number of + term section entries } + objc_module_info_addr : uint32_t; { for this module address of the start of the (__OBJC,__module_info) section } + objc_module_info_size : uint32_t; { for this module size of the (__OBJC,__module_info) section } + end; + + dylib_module_64 = record { a 64-bit module table entry } + module_name : uint32_t; { the module name (index into string table) } + iextdefsym : uint32_t; { index into externally defined symbols } + nextdefsym : uint32_t; { number of externally defined symbols } + irefsym : uint32_t; { index into reference symbol table } + nrefsym : uint32_t; { number of reference symbol table entries } + ilocalsym : uint32_t; { index into symbols for local symbols } + nlocalsym : uint32_t; { number of local symbols } + iextrel : uint32_t; { index into external relocation entries } + nextrel : uint32_t; { number of external relocation entries } + iinit_iterm : uint32_t; { low 16 bits are the index into the init + section, high 16 bits are the index into + the term section } + ninit_nterm : uint32_t; { low 16 bits are the number of init section + entries, high 16 bits are the number of + term section entries } + objc_module_info_size : uint32_t; { for this module size of the (__OBJC,__module_info) section } + objc_module_info_addr : uint64_t; { for this module address of the start of the (__OBJC,__module_info) section } + end; + + { + * The entries in the reference symbol table are used when loading the module + * (both by the static and dynamic link editors) and if the module is unloaded + * or replaced. Therefore all external symbols (defined and undefined) are + * listed in the module's reference table. The flags describe the type of + * reference that is being made. The constants for the flags are defined in + * <mach-o/nlist.h> as they are also used for symbol table entries. + } + { index into the symbol table } + { flags to indicate the type of reference } + dylib_reference = record + flag0 : longint; + end; + + +{ const + bm_dylib_reference_isym = $FFFFFF; + bp_dylib_reference_isym = 0; + bm_dylib_reference_flags = $FF000000; + bp_dylib_reference_flags = 24; + + function isym(var a : dylib_reference) : uint32_t; + procedure set_isym(var a : dylib_reference; __isym : uint32_t); + function flags(var a : dylib_reference) : uint32_t; + procedure set_flags(var a : dylib_reference; __flags : uint32_t);} + + {* The twolevel_hints_command contains the offset and number of hints in the + * two-level namespace lookup hints table.} + +type + twolevel_hints_command = record + cmd : uint32_t; { LC_TWOLEVEL_HINTS } + cmdsize : uint32_t; { sizeof(struct twolevel_hints_command) } + offset : uint32_t; { offset to the hint table } + nhints : uint32_t; { number of hints in the hint table } + end; + + { + * The entries in the two-level namespace lookup hints table are twolevel_hint + * structs. These provide hints to the dynamic link editor where to start + * looking for an undefined symbol in a two-level namespace image. The + * isub_image field is an index into the sub-images (sub-frameworks and + * sub-umbrellas list) that made up the two-level image that the undefined + * symbol was found in when it was built by the static link editor. If + * isub-image is 0 the the symbol is expected to be defined in library and not + * in the sub-images. If isub-image is non-zero it is an index into the array + * of sub-images for the umbrella with the first index in the sub-images being + * 1. The array of sub-images is the ordered list of sub-images of the umbrella + * that would be searched for a symbol that has the umbrella recorded as its + * primary library. The table of contents index is an index into the + * library's table of contents. This is used as the starting point of the + * binary search or a directed linear search. + } + { index into the sub images } + { index into the table of contents } + twolevel_hint = record + flag0 : longint; + end; + + +{ const + bm_twolevel_hint_isub_image = $FF; + bp_twolevel_hint_isub_image = 0; + bm_twolevel_hint_itoc = $FFFFFF00; + bp_twolevel_hint_itoc = 8; + + function isub_image(var a : twolevel_hint) : uint32_t; + procedure set_isub_image(var a : twolevel_hint; __isub_image : uint32_t); + function itoc(var a : twolevel_hint) : uint32_t; + procedure set_itoc(var a : twolevel_hint; __itoc : uint32_t); +} + +type + {* The prebind_cksum_command contains the value of the original check sum for + * prebound files or zero. When a prebound file is first created or modified + * for other than updating its prebinding information the value of the check sum + * is set to zero. When the file has it prebinding re-done and if the value of + * the check sum is zero the original check sum is calculated and stored in + * cksum field of this load command in the output file. If when the prebinding + * is re-done and the cksum field is non-zero it is left unchanged from the + * input file. } + + prebind_cksum_command = record + cmd : uint32_t; { LC_PREBIND_CKSUM } + cmdsize : uint32_t; { sizeof(struct prebind_cksum_command) } + cksum : uint32_t; { the check sum or zero } + end; + pprebind_cksum_command = ^prebind_cksum_command; + + + {* The uuid load command contains a single 128-bit unique random number that + * identifies an object produced by the static link editor. } + + uuid_command = record + cmd : uint32_t; { LC_UUID } + cmdsize : uint32_t; { sizeof(struct uuid_command) } + uuid : array[0..15] of uint8_t; { the 128-bit uuid } + end; + puuid_command = ^uuid_command; + + + {* The rpath_command contains a path which at runtime should be added to + * the current run path used to find @rpath prefixed dylibs.} + + rpath_command = record + cmd : uint32_t; { LC_RPATH } + cmdsize : uint32_t; { includes string } + path : lc_str; { path to add to run path } + end; + prpath_command = ^rpath_command; + + + {* The linkedit_data_command contains the offsets and sizes of a blob + * of data in the __LINKEDIT segment.} + + linkedit_data_command = record + cmd : uint32_t; { LC_CODE_SIGNATURE or LC_SEGMENT_SPLIT_INFO } + cmdsize : uint32_t; { sizeof(struct linkedit_data_command) } + dataoff : uint32_t; { file offset of data in __LINKEDIT segment } + datasize : uint32_t; { file size of data in __LINKEDIT segment } + end; + plinkedit_data_command = ^linkedit_data_command; + + + {* The encryption_info_command contains the file offset and size of an + * of an encrypted segment.} + + encryption_info_command = record + cmd : uint32_t; { LC_ENCRYPTION_INFO } + cmdsize : uint32_t; { sizeof(struct encryption_info_command) } + cryptoff : uint32_t; { file offset of encrypted range } + cryptsize : uint32_t; { file size of encrypted range } + cryptid : uint32_t; { which enryption system, 0 means not-encrypted yet } + end; + pencryption_info_command = ^encryption_info_command; + + + {* The symseg_command contains the offset and size of the GNU style + * symbol table information as described in the header file <symseg.h>. + * The symbol roots of the symbol segments must also be aligned properly + * in the file. So the requirement of keeping the offsets aligned to a + * multiple of a 4 bytes translates to the length field of the symbol + * roots also being a multiple of a long. Also the padding must again be + * zeroed. (THIS IS OBSOLETE and no longer supported). } + + symseg_command = record + cmd : uint32_t; { LC_SYMSEG } + cmdsize : uint32_t; { sizeof(struct symseg_command) } + offset : uint32_t; { symbol segment offset } + size : uint32_t; { symbol segment size in bytes } + end; + psymseg_command = ^symseg_command; + + + {* The ident_command contains a free format string table following the + * ident_command structure. The strings are null terminated and the size of + * the command is padded out with zero bytes to a multiple of 4 bytes/ + * (THIS IS OBSOLETE and no longer supported).} + + ident_command = record + cmd : uint32_t; { LC_IDENT } + cmdsize : uint32_t; { strings that follow this command } + end; + pident_command = ^ident_command; + + + {* The fvmfile_command contains a reference to a file to be loaded at the + * specified virtual address. (Presently, this command is reserved for + * internal use. The kernel ignores this command when loading a program into + * memory). } + + fvmfile_command = record + cmd : uint32_t; { LC_FVMFILE } + cmdsize : uint32_t; { includes pathname string } + name : lc_str; { files pathname } + header_addr : uint32_t; { files virtual address } + end; + pfvmfile_command = ^fvmfile_command; + + + {* This header file describes the structures of the file format for "fat" + * architecture specific file (wrapper design). At the begining of the file + * there is one fat_header structure followed by a number of fat_arch + * structures. For each architecture in the file, specified by a pair of + * cputype and cpusubtype, the fat_header describes the file offset, file + * size and alignment in the file of the architecture specific member. + * The padded bytes in the file to place each member on it's specific alignment + * are defined to be read as zeros and can be left as "holes" if the file system + * can support them as long as they read as zeros. + * + * All structures defined here are always written and read to/from disk + * in big-endian order.} + {* <mach/machine.h> is needed here for the cpu_type_t and cpu_subtype_t types + * and contains the constants for the possible values of these types.} + +const + FAT_MAGIC = $cafebabe; + FAT_CIGAM = $bebafeca; + +type + fat_header = record + magic : uint32_t; { FAT_MAGIC } + nfat_arch : uint32_t; { number of structs that follow } + end; + + fat_arch = record + cputype : cpu_type_t; { cpu specifier (int) } + cpusubtype : cpu_subtype_t; { machine specifier (int) } + offset : uint32_t; { file offset to this object file } + size : uint32_t; { size of this object file } + align : uint32_t; { alignment as a power of 2 } + end; + + + { + * Format of a symbol table entry of a Mach-O file for 32-bit architectures. + * Modified from the BSD format. The modifications from the original format + * were changing n_other (an unused field) to n_sect and the addition of the + * N_SECT type. These modifications are required to support symbols in a larger + * number of sections not just the three sections (text, data and bss) in a BSD + * file. + } + +type + nlist = record + n_un : record + case longint of + {$ifndef __LP64__} + 0 : ( n_name : Pchar ); { for use when in-core } + {$endif} + 1 : ( n_strx : int32_t ); { index into the string table } + end; + n_type : uint8_t; { type flag, see below } + n_sect : uint8_t; { section number or NO_SECT } + n_desc : int16_t; { see <mach-o/stab.h> } + n_value : uint32_t; { value of this symbol (or stab offset) } + end; + pnlist = ^nlist; + + {* This is the symbol table entry structure for 64-bit architectures.} + nlist_64 = record + n_un : record + case longint of + 0 : ( n_strx : uint32_t ); { index into the string table } + end; + n_type : uint8_t; { type flag, see below } + n_sect : uint8_t; { section number or NO_SECT } + n_desc : uint16_t; { see <mach-o/stab.h> } + n_value : uint64_t; { value of this symbol (or stab offset) } + end; + pnlist_64 = ^nlist_64; + + {* Symbols with a index into the string table of zero (n_un.n_strx == 0) are + * defined to have a null, "", name. Therefore all string indexes to non null + * names must not have a zero string index. This is bit historical information + * that has never been well documented. } + {* The n_type field really contains four fields: + * unsigned char N_STAB:3, + * N_PEXT:1, + * N_TYPE:3, + * N_EXT:1; + * which are used via the following masks.} + +const + N_STAB = $e0; { if any of these bits set, a symbolic debugging entry } + N_PEXT = $10; { private external symbol bit } + N_TYPE = $0e; { mask for the type bits } + N_EXT = $01; { external symbol bit, set for external symbols } + + {* Only symbolic debugging entries have some of the N_STAB bits set and if any + * of these bits are set then it is a symbolic debugging entry (a stab). In + * which case then the values of the n_type field (the entire field) are given + * in <mach-o/stab.h> } + + {* Values for N_TYPE bits of the n_type field. } + + N_UNDF = $0; { undefined, n_sect == NO_SECT } + N_ABS = $2; { absolute, n_sect == NO_SECT } + N_SECT = $e; { defined in section number n_sect } + N_PBUD = $c; { prebound undefined (defined in a dylib) } + N_INDR = $a; { indirect } + + {* If the type is N_INDR then the symbol is defined to be the same as another + * symbol. In this case the n_value field is an index into the string table + * of the other symbol's name. When the other symbol is defined then they both + * take on the defined type and value.} + + {* If the type is N_SECT then the n_sect field contains an ordinal of the + * section the symbol is defined in. The sections are numbered from 1 and + * refer to sections in order they appear in the load commands for the file + * they are in. This means the same ordinal may very well refer to different + * sections in different files. + * + * The n_value field for all symbol table entries (including N_STAB's) gets + * updated by the link editor based on the value of it's n_sect field and where + * the section n_sect references gets relocated. If the value of the n_sect + * field is NO_SECT then it's n_value field is not changed by the link editor.} + + NO_SECT = 0; { symbol is not in any section } + MAX_SECT = 255; { 1 thru 255 inclusive } + {* Common symbols are represented by undefined (N_UNDF) external (N_EXT) types + * who's values (n_value) are non-zero. In which case the value of the n_value + * field is the size (in bytes) of the common symbol. The n_sect field is set + * to NO_SECT. The alignment of a common symbol may be set as a power of 2 + * between 2^1 and 2^15 as part of the n_desc field using the macros below. If + * the alignment is not set (a value of zero) then natural alignment based on + * the size is used.} + + { ----- Process manually ----- + #define GET_COMM_ALIGN(n_desc) (((n_desc) >> 8) & 0x0f) + #define SET_COMM_ALIGN(n_desc,align) \ + (n_desc) = (((n_desc) & 0xf0ff) | (((align) & 0x0f) << 8)) + } + + {* To support the lazy binding of undefined symbols in the dynamic link-editor, + * the undefined symbols in the symbol table (the nlist structures) are marked + * with the indication if the undefined reference is a lazy reference or + * non-lazy reference. If both a non-lazy reference and a lazy reference is + * made to the same symbol the non-lazy reference takes precedence. A reference + * is lazy only when all references to that symbol are made through a symbol + * pointer in a lazy symbol pointer section. + * + * The implementation of marking nlist structures in the symbol table for + * undefined symbols will be to use some of the bits of the n_desc field as a + * reference type. The mask REFERENCE_TYPE will be applied to the n_desc field + * of an nlist structure for an undefined symbol to determine the type of + * undefined reference (lazy or non-lazy). + * + * The constants for the REFERENCE FLAGS are propagated to the reference table + * in a shared library file. In that case the constant for a defined symbol, + * REFERENCE_FLAG_DEFINED, is also used.} + + { Reference type bits of the n_desc field of undefined symbols } + REFERENCE_TYPE = $7; + + { types of references } + REFERENCE_FLAG_UNDEFINED_NON_LAZY = 0; + REFERENCE_FLAG_UNDEFINED_LAZY = 1; + REFERENCE_FLAG_DEFINED = 2; + REFERENCE_FLAG_PRIVATE_DEFINED = 3; + REFERENCE_FLAG_PRIVATE_UNDEFINED_NON_LAZY = 4; + REFERENCE_FLAG_PRIVATE_UNDEFINED_LAZY = 5; + + {* To simplify stripping of objects that use are used with the dynamic link + * editor, the static link editor marks the symbols defined an object that are + * referenced by a dynamicly bound object (dynamic shared libraries, bundles). + * With this marking strip knows not to strip these symbols.} + REFERENCED_DYNAMICALLY = $0010; + + {* For images created by the static link editor with the -twolevel_namespace + * option in effect the flags field of the mach header is marked with + * MH_TWOLEVEL. And the binding of the undefined references of the image are + * determined by the static link editor. Which library an undefined symbol is + * bound to is recorded by the static linker in the high 8 bits of the n_desc + * field using the SET_LIBRARY_ORDINAL macro below. The ordinal recorded + * references the libraries listed in the Mach-O's LC_LOAD_DYLIB load commands + * in the order they appear in the headers. The library ordinals start from 1. + * For a dynamic library that is built as a two-level namespace image the + * undefined references from module defined in another use the same nlist struct + * an in that case SELF_LIBRARY_ORDINAL is used as the library ordinal. For + * defined symbols in all images they also must have the library ordinal set to + * SELF_LIBRARY_ORDINAL. The EXECUTABLE_ORDINAL refers to the executable + * image for references from plugins that refer to the executable that loads + * them. + * + * The DYNAMIC_LOOKUP_ORDINAL is for undefined symbols in a two-level namespace + * image that are looked up by the dynamic linker with flat namespace semantics. + * This ordinal was added as a feature in Mac OS X 10.3 by reducing the + * value of MAX_LIBRARY_ORDINAL by one. So it is legal for existing binaries + * or binaries built with older tools to have 0xfe (254) dynamic libraries. In + * this case the ordinal value 0xfe (254) must be treated as a library ordinal + * for compatibility.} + + { was #define dname(params) para_def_expr } + { argument types are unknown } + { return type might be wrong } +// function GET_LIBRARY_ORDINAL(n_desc : longint) : longint; + + { -- Process Manually --- + #define SET_LIBRARY_ORDINAL(n_desc,ordinal) \ + (n_desc) = (((n_desc) & 0x00ff) | (((ordinal) & 0xff) << 8)) + } + +const + SELF_LIBRARY_ORDINAL = $0; + MAX_LIBRARY_ORDINAL = $fd; + DYNAMIC_LOOKUP_ORDINAL = $fe; + EXECUTABLE_ORDINAL = $ff; + + {* The bit 0x0020 of the n_desc field is used for two non-overlapping purposes + * and has two different symbolic names, N_NO_DEAD_STRIP and N_DESC_DISCARDED. } + + {* The N_NO_DEAD_STRIP bit of the n_desc field only ever appears in a + * relocatable .o file (MH_OBJECT filetype). And is used to indicate to the + * static link editor it is never to dead strip the symbol.} + N_NO_DEAD_STRIP = $0020; { symbol is not to be dead stripped } + + + + {* The N_DESC_DISCARDED bit of the n_desc field never appears in linked image. + * But is used in very rare cases by the dynamic link editor to mark an in + * memory symbol as discared and longer used for linking. } + N_DESC_DISCARDED = $0020; { symbol is discarded } + + {* The N_WEAK_REF bit of the n_desc field indicates to the dynamic linker that + * the undefined symbol is allowed to be missing and is to have the address of + * zero when missing. } + N_WEAK_REF = $0040; { symbol is weak referenced } + + {* The N_WEAK_DEF bit of the n_desc field indicates to the static and dynamic + * linkers that the symbol definition is weak, allowing a non-weak symbol to + * also be used which causes the weak definition to be discared. Currently this + * is only supported for symbols in coalesed sections. } + N_WEAK_DEF = $0080; { coalesed symbol is a weak definition } + + {* The N_REF_TO_WEAK bit of the n_desc field indicates to the dynamic linker + * that the undefined symbol should be resolved using flat namespace searching. } + N_REF_TO_WEAK = $0080; { reference to a weak symbol } + + {* The N_ARM_THUMB_DEF bit of the n_desc field indicates that the symbol is + * a defintion of a Thumb function. } + N_ARM_THUMB_DEF = $0008; { symbol is a Thumb function (ARM) } + + {* There are two known orders of table of contents for archives. The first is + * the order ranlib(1) originally produced and still produces without any + * options. This table of contents has the archive member name "__.SYMDEF" + * This order has the ranlib structures in the order the objects appear in the + * archive and the symbol names of those objects in the order of symbol table. + * The second know order is sorted by symbol name and is produced with the -s + * option to ranlib(1). This table of contents has the archive member name + * "__.SYMDEF SORTED" and many programs (notably the 1.0 version of ld(1) can't + * tell the difference between names because of the imbedded blank in the name + * and works with either table of contents). This second order is used by the + * post 1.0 link editor to produce faster linking. The original 1.0 version of + * ranlib(1) gets confused when it is run on a archive with the second type of + * table of contents because it and ar(1) which it uses use different ways to + * determined the member name (ar(1) treats all blanks in the name as + * significant and ranlib(1) only checks for the first one).} + +const + SYMDEF = '__.SYMDEF'; + SYMDEF_SORTED = '__.SYMDEF SORTED'; + + { + * Structure of the __.SYMDEF table of contents for an archive. + * __.SYMDEF begins with a long giving the size in bytes of the ranlib + * structures which immediately follow, and then continues with a string + * table consisting of a long giving the number of bytes of strings which + * follow and then the strings themselves. The ran_strx fields index the + * string table whose first byte is numbered 0. + } + +type + ranlib = record + ran_un : record + case longint of + 0 : ( ran_strx : uint32_t ); + 1 : ( ran_name : ^char ); + end; + ran_off : uint32_t; + end; + +type + {* Format of a relocation entry of a Mach-O file. Modified from the 4.3BSD + * format. The modifications from the original format were changing the value + * of the r_symbolnum field for "local" (r_extern == 0) relocation entries. + * This modification is required to support symbols in an arbitrary number of + * sections not just the three sections (text, data and bss) in a 4.3BSD file. + * Also the last 4 bits have had the r_type tag added to them. } + + relocation_info = record + r_address : int32_t; { offset in the section to what is being relocated } + r_info : longint; + // r_symbolnum:24, {* symbol index if r_extern == 1 or section ordinal if r_extern == 0 *} + // r_pcrel:1; {* was relocated pc relative already *} + // r_length:2; {* 0=byte, 1=word, 2=long, 3=quad *} + // r_extern:1; {* does not include value of sym referenced *} + // r_type:4; {* if not 0, machine specific relocation type *} + end; + + +{ absolute relocation type for Mach-O files } + +const + R_ABS = 0; + R_SCATTERED = $80000000; { mask to be applied to the r_address field } + { of a relocation_info structure to tell that } + { is is really a scattered_relocation_info } + { stucture } + + { + * The r_address is not really the address as it's name indicates but an offset. + * In 4.3BSD a.out objects this offset is from the start of the "segment" for + * which relocation entry is for (text or data). For Mach-O object files it is + * also an offset but from the start of the "section" for which the relocation + * entry is for. See comments in <mach-o/loader.h> about the r_address feild + * in images for used with the dynamic linker. + * + * In 4.3BSD a.out objects if r_extern is zero then r_symbolnum is an ordinal + * for the segment the symbol being relocated is in. These ordinals are the + * symbol types N_TEXT, N_DATA, N_BSS or N_ABS. In Mach-O object files these + * ordinals refer to the sections in the object file in the order their section + * structures appear in the headers of the object file they are in. The first + * section has the ordinal 1, the second 2, and so on. This means that the + * same ordinal in two different object files could refer to two different + * sections. And further could have still different ordinals when combined + * by the link-editor. The value R_ABS is used for relocation entries for + * absolute symbols which need no further relocation. + } + { + * For RISC machines some of the references are split across two instructions + * and the instruction does not contain the complete value of the reference. + * In these cases a second, or paired relocation entry, follows each of these + * relocation entries, using a PAIR r_type, which contains the other part of the + * reference not contained in the instruction. This other part is stored in the + * pair's r_address field. The exact number of bits of the other part of the + * reference store in the r_address field is dependent on the particular + * relocation type for the particular architecture. + } + { + * To make scattered loading by the link editor work correctly "local" + * relocation entries can't be used when the item to be relocated is the value + * of a symbol plus an offset (where the resulting expresion is outside the + * block the link editor is moving, a blocks are divided at symbol addresses). + * In this case. where the item is a symbol value plus offset, the link editor + * needs to know more than just the section the symbol was defined. What is + * needed is the actual value of the symbol without the offset so it can do the + * relocation correctly based on where the value of the symbol got relocated to + * not the value of the expression (with the offset added to the symbol value). + * So for the NeXT 2.0 release no "local" relocation entries are ever used when + * there is a non-zero offset added to a symbol. The "external" and "local" + * relocation entries remain unchanged. + * + * The implemention is quite messy given the compatibility with the existing + * relocation entry format. The ASSUMPTION is that a section will never be + * bigger than 2**24 - 1 (0x00ffffff or 16,777,215) bytes. This assumption + * allows the r_address (which is really an offset) to fit in 24 bits and high + * bit of the r_address field in the relocation_info structure to indicate + * it is really a scattered_relocation_info structure. Since these are only + * used in places where "local" relocation entries are used and not where + * "external" relocation entries are used the r_extern field has been removed. + * + * For scattered loading to work on a RISC machine where some of the references + * are split across two instructions the link editor needs to be assured that + * each reference has a unique 32 bit reference (that more than one reference is + * NOT sharing the same high 16 bits for example) so it move each referenced + * item independent of each other. Some compilers guarantees this but the + * compilers don't so scattered loading can be done on those that do guarantee + * this. + } + + { + * The reason for the ifdef's of __BIG_ENDIAN__ and __LITTLE_ENDIAN__ are that + * when stattered relocation entries were added the mistake of using a mask + * against a structure that is made up of bit fields was used. To make this + * design work this structure must be laid out in memory the same way so the + * mask can be applied can check the same bit each time (r_scattered). + } + + +type + scattered_relocation_info = record + {$ifdef ENDIAN_BIG} + r_info : longint; { r_scattered:1, /* 1=scattered, 0=non-scattered (see above) */ + r_pcrel:1, /* was relocated pc relative already */ + r_length:2, /* 0=byte, 1=word, 2=long, 3=quad */ + r_type:4, /* if not 0, machine specific relocation type */ + r_address:24; /* offset in the section to what is being relocated */} + r_value : int32_t; {* the value the item to be relocated is refering to (without any offset added) *} + {$else} + r_value : int32_t; + r_info : longint; {* r_address:24, /* offset in the section to what is being relocated */ + r_type:4, /* if not 0, machine specific relocation type */ + r_length:2, /* 0=byte, 1=word, 2=long, 3=quad */ + r_pcrel:1, /* was relocated pc relative already */ + r_scattered:1; /* 1=scattered, 0=non-scattered (see above) */ *} + {$endif} + end; + + { + * Relocation types used in a generic implementation. Relocation entries for + * normal things use the generic relocation as discribed above and their r_type + * is GENERIC_RELOC_VANILLA (a value of zero). + * + * Another type of generic relocation, GENERIC_RELOC_SECTDIFF, is to support + * the difference of two symbols defined in different sections. That is the + * expression "symbol1 - symbol2 + constant" is a relocatable expression when + * both symbols are defined in some section. For this type of relocation the + * both relocations entries are scattered relocation entries. The value of + * symbol1 is stored in the first relocation entry's r_value field and the + * value of symbol2 is stored in the pair's r_value field. + * + * A special case for a prebound lazy pointer is needed to beable to set the + * value of the lazy pointer back to its non-prebound state. This is done + * using the GENERIC_RELOC_PB_LA_PTR r_type. This is a scattered relocation + * entry where the r_value feild is the value of the lazy pointer not prebound. + } + +const + GENERIC_RELOC_VANILLA = 0; { generic relocation as discribed above } + GENERIC_RELOC_PAIR = 1; { Only follows a GENERIC_RELOC_SECTDIFF } + GENERIC_RELOC_SECTDIFF = 2; + GENERIC_RELOC_PB_LA_PTR = 3; { prebound lazy pointer } + GENERIC_RELOC_LOCAL_SECTDIFF = 4; + +{* + * Relocations for x86_64 are a bit different than for other architectures in + * Mach-O: Scattered relocations are not used. Almost all relocations produced + * by the compiler are external relocations. An external relocation has the + * r_extern bit set to 1 and the r_symbolnum field contains the symbol table + * index of the target label. + * + * When the assembler is generating relocations, if the target label is a local + * label (begins with 'L'), then the previous non-local label in the same + * section is used as the target of the external relocation. An addend is used + * with the distance from that non-local label to the target label. Only when + * there is no previous non-local label in the section is an internal + * relocation used. + * + * The addend (i.e. the 4 in _foo+4) is encoded in the instruction (Mach-O does + * not have RELA relocations). For PC-relative relocations, the addend is + * stored directly in the instruction. This is different from other Mach-O + * architectures, which encode the addend minus the current section offset. + * + * The relocation types are: + * + * X86_64_RELOC_UNSIGNED // for absolute addresses + * X86_64_RELOC_SIGNED // for signed 32-bit displacement + * X86_64_RELOC_BRANCH // a CALL/JMP instruction with 32-bit displacement + * X86_64_RELOC_GOT_LOAD // a MOVQ load of a GOT entry + * X86_64_RELOC_GOT // other GOT references + * X86_64_RELOC_SUBTRACTOR // must be followed by a X86_64_RELOC_UNSIGNED + * + * The following are sample assembly instructions, followed by the relocation + * and section content they generate in an object file: + * + * call _foo + * r_type=X86_64_RELOC_BRANCH, r_length=2, r_extern=1, r_pcrel=1, r_symbolnum=_foo + * E8 00 00 00 00 + * + * call _foo+4 + * r_type=X86_64_RELOC_BRANCH, r_length=2, r_extern=1, r_pcrel=1, r_symbolnum=_foo + * E8 04 00 00 00 + * + * movq _foo@GOTPCREL(%rip), %rax + * r_type=X86_64_RELOC_GOT_LOAD, r_length=2, r_extern=1, r_pcrel=1, r_symbolnum=_foo + * 48 8B 05 00 00 00 00 + * + * pushq _foo@GOTPCREL(%rip) + * r_type=X86_64_RELOC_GOT, r_length=2, r_extern=1, r_pcrel=1, r_symbolnum=_foo + * FF 35 00 00 00 00 + * + * movl _foo(%rip), %eax + * r_type=X86_64_RELOC_SIGNED, r_length=2, r_extern=1, r_pcrel=1, r_symbolnum=_foo + * 8B 05 00 00 00 00 + * + * movl _foo+4(%rip), %eax + * r_type=X86_64_RELOC_SIGNED, r_length=2, r_extern=1, r_pcrel=1, r_symbolnum=_foo + * 8B 05 04 00 00 00 + * + * movb $0x12, _foo(%rip) + * r_type=X86_64_RELOC_SIGNED, r_length=2, r_extern=1, r_pcrel=1, r_symbolnum=_foo + * C6 05 FF FF FF FF 12 + * + * movl $0x12345678, _foo(%rip) + * r_type=X86_64_RELOC_SIGNED, r_length=2, r_extern=1, r_pcrel=1, r_symbolnum=_foo + * C7 05 FC FF FF FF 78 56 34 12 + * + * .quad _foo + * r_type=X86_64_RELOC_UNSIGNED, r_length=3, r_extern=1, r_pcrel=0, r_symbolnum=_foo + * 00 00 00 00 00 00 00 00 + * + * .quad _foo+4 + * r_type=X86_64_RELOC_UNSIGNED, r_length=3, r_extern=1, r_pcrel=0, r_symbolnum=_foo + * 04 00 00 00 00 00 00 00 + * + * .quad _foo - _bar + * r_type=X86_64_RELOC_SUBTRACTOR, r_length=3, r_extern=1, r_pcrel=0, r_symbolnum=_bar + * r_type=X86_64_RELOC_UNSIGNED, r_length=3, r_extern=1, r_pcrel=0, r_symbolnum=_foo + * 00 00 00 00 00 00 00 00 + * + * .quad _foo - _bar + 4 + * r_type=X86_64_RELOC_SUBTRACTOR, r_length=3, r_extern=1, r_pcrel=0, r_symbolnum=_bar + * r_type=X86_64_RELOC_UNSIGNED, r_length=3, r_extern=1, r_pcrel=0, r_symbolnum=_foo + * 04 00 00 00 00 00 00 00 + * + * .long _foo - _bar + * r_type=X86_64_RELOC_SUBTRACTOR, r_length=2, r_extern=1, r_pcrel=0, r_symbolnum=_bar + * r_type=X86_64_RELOC_UNSIGNED, r_length=2, r_extern=1, r_pcrel=0, r_symbolnum=_foo + * 00 00 00 00 + * + * lea L1(%rip), %rax + * r_type=X86_64_RELOC_SIGNED, r_length=2, r_extern=1, r_pcrel=1, r_symbolnum=_prev + * 48 8d 05 12 00 00 00 + * // assumes _prev is the first non-local label 0x12 bytes before L1 + * + * lea L0(%rip), %rax + * r_type=X86_64_RELOC_SIGNED, r_length=2, r_extern=0, r_pcrel=1, r_symbolnum=3 + * 48 8d 05 56 00 00 00 + * // assumes L0 is in third section, has an address of 0x00000056 in .o + * // file, and there is no previous non-local label + * + * .quad L1 + * r_type=X86_64_RELOC_UNSIGNED, r_length=3, r_extern=1, r_pcrel=0, r_symbolnum=_prev + * 12 00 00 00 00 00 00 00 + * // assumes _prev is the first non-local label 0x12 bytes before L1 + * + * .quad L0 + * r_type=X86_64_RELOC_UNSIGNED, r_length=3, r_extern=0, r_pcrel=0, r_symbolnum=3 + * 56 00 00 00 00 00 00 00 + * // assumes L0 is in third section, has an address of 0x00000056 in .o + * // file, and there is no previous non-local label + * + * .quad _foo - . + * r_type=X86_64_RELOC_SUBTRACTOR, r_length=3, r_extern=1, r_pcrel=0, r_symbolnum=_prev + * r_type=X86_64_RELOC_UNSIGNED, r_length=3, r_extern=1, r_pcrel=0, r_symbolnum=_foo + * EE FF FF FF FF FF FF FF + * // assumes _prev is the first non-local label 0x12 bytes before this + * // .quad + * + * .quad _foo - L1 + * r_type=X86_64_RELOC_SUBTRACTOR, r_length=3, r_extern=1, r_pcrel=0, r_symbolnum=_prev + * r_type=X86_64_RELOC_UNSIGNED, r_length=3, r_extern=1, r_pcrel=0, r_symbolnum=_foo + * EE FF FF FF FF FF FF FF + * // assumes _prev is the first non-local label 0x12 bytes before L1 + * + * .quad L1 - _prev + * // No relocations. This is an assembly time constant. + * 12 00 00 00 00 00 00 00 + * // assumes _prev is the first non-local label 0x12 bytes before L1 + * + * + * + * In final linked images, there are only two valid relocation kinds: + * + * r_type=X86_64_RELOC_UNSIGNED, r_length=3, r_pcrel=0, r_extern=1, r_symbolnum=sym_index + * This tells dyld to add the address of a symbol to a pointer sized (8-byte) + * piece of data (i.e on disk the 8-byte piece of data contains the addend). The + * r_symbolnum contains the index into the symbol table of the target symbol. + * + * r_type=X86_64_RELOC_UNSIGNED, r_length=3, r_pcrel=0, r_extern=0, r_symbolnum=0 + * This tells dyld to adjust the pointer sized (8-byte) piece of data by the amount + * the containing image was loaded from its base address (e.g. slide). + * + *} + +const + X86_64_RELOC_UNSIGNED = 0; // for absolute addresses + X86_64_RELOC_SIGNED = 1; // for signed 32-bit displacement + X86_64_RELOC_BRANCH = 2; // a CALL/JMP instruction with 32-bit displacement + X86_64_RELOC_GOT_LOAD = 3; // a MOVQ load of a GOT entry + X86_64_RELOC_GOT = 4; // other GOT references + X86_64_RELOC_SUBTRACTOR = 5; // must be followed by a X86_64_RELOC_UNSIGNED + X86_64_RELOC_SIGNED_1 = 6; // for signed 32-bit displacement with a -1 addend + X86_64_RELOC_SIGNED_2 = 7; // for signed 32-bit displacement with a -2 addend + X86_64_RELOC_SIGNED_4 = 8; // for signed 32-bit displacement with a -4 addend + + + + + {* Relocation types used in the ppc implementation. Relocation entries for + * things other than instructions use the same generic relocation as discribed + * above and their r_type is RELOC_VANILLA. The rest of the relocation types + * are for instructions. Since they are for instructions the r_address field + * indicates the 32 bit instruction that the relocation is to be preformed on. + * The fields r_pcrel and r_length are ignored for non-RELOC_VANILLA r_types + * except for PPC_RELOC_BR14. + * + * For PPC_RELOC_BR14 if the r_length is the unused value 3, then the branch was + * statically predicted setting or clearing the Y-bit based on the sign of the + * displacement or the opcode. If this is the case the static linker must flip + * the value of the Y-bit if the sign of the displacement changes for non-branch + * always conditions. + } + +const + PPC_RELOC_VANILLA = 0; { generic relocation as discribed above } + PPC_RELOC_PAIR = 1; { the second relocation entry of a pair } + PPC_RELOC_BR14 = 2; { 14 bit branch displacement (to a word address) } + PPC_RELOC_BR24 = 3; { 24 bit branch displacement (to a word address) } + PPC_RELOC_HI16 = 4; { a PAIR follows with the low half } + PPC_RELOC_LO16 = 5; { a PAIR follows with the high half } + PPC_RELOC_HA16 = 6; { Same as the RELOC_HI16 except the low 16 bits and the } + { * high 16 bits are added together with the low 16 bits } + { * sign extened first. This means if bit 15 of the low } + { * 16 bits is set the high 16 bits stored in the } + { * instruction will be adjusted. } + PPC_RELOC_LO14 = 7; { Same as the LO16 except that the low 2 bits are not } + { * stored in the instruction and are always zero. This } + { * is used in double word load/store instructions. } + PPC_RELOC_SECTDIFF = 8; { a PAIR follows with subtract symbol value } + PPC_RELOC_PB_LA_PTR = 9; { prebound lazy pointer } + PPC_RELOC_HI16_SECTDIFF = 10; { section difference forms of above. a PAIR } + PPC_RELOC_LO16_SECTDIFF = 11; { follows these with subtract symbol value } + PPC_RELOC_HA16_SECTDIFF = 12; + PPC_RELOC_JBSR = 13; + PPC_RELOC_LO14_SECTDIFF = 14; + PPC_RELOC_LOCAL_SECTDIFF = 15; { like PPC_RELOC_SECTDIFF, but the symbol referenced was local. } + + { + * Symbolic debugger symbols. The comments give the conventional use for + * + * .stabs "n_name", n_type, n_sect, n_desc, n_value + * + * where n_type is the defined constant and not listed in the comment. Other + * fields not listed are zero. n_sect is the section ordinal the entry is + * refering to. + } + +const + N_GSYM = $20; { global symbol: name,,NO_SECT,type,0 } + N_FNAME = $22; { procedure name (f77 kludge): name,,NO_SECT,0,0 } + N_FUN = $24; { procedure: name,,n_sect,linenumber,address } + N_STSYM = $26; { static symbol: name,,n_sect,type,address } + N_LCSYM = $28; { .lcomm symbol: name,,n_sect,type,address } + N_BNSYM = $2e; { begin nsect sym: 0,,n_sect,0,address } + N_OPT = $3c; { emitted with gcc2_compiled and in gcc source } + N_RSYM = $40; { register sym: name,,NO_SECT,type,register } + N_SLINE = $44; { src line: 0,,n_sect,linenumber,address } + N_ENSYM = $4e; { end nsect sym: 0,,n_sect,0,address } + N_SSYM = $60; { structure elt: name,,NO_SECT,type,struct_offset } + N_SO = $64; { source file name: name,,n_sect,0,address } + N_OSO = $66; { object file name: name,,0,0,st_mtime } + N_LSYM = $80; { local sym: name,,NO_SECT,type,offset } + N_BINCL = $82; { include file beginning: name,,NO_SECT,0,sum } + N_SOL = $84; { #included file name: name,,n_sect,0,address } + N_PARAMS = $86; { compiler parameters: name,,NO_SECT,0,0 } + N_VERSION = $88; { compiler version: name,,NO_SECT,0,0 } + N_OLEVEL = $8A; { compiler -O level: name,,NO_SECT,0,0 } + N_PSYM = $a0; { parameter: name,,NO_SECT,type,offset } + N_EINCL = $a2; { include file end: name,,NO_SECT,0,0 } + N_ENTRY = $a4; { alternate entry: name,,n_sect,linenumber,address } + N_LBRAC = $c0; { left bracket: 0,,NO_SECT,nesting level,address } + N_EXCL = $c2; { deleted include file: name,,NO_SECT,0,sum } + N_RBRAC = $e0; { right bracket: 0,,NO_SECT,nesting level,address } + N_BCOMM = $e2; { begin common: name,,NO_SECT,0,0 } + N_ECOMM = $e4; { end common: name,,n_sect,0,0 } + N_ECOML = $e8; { end common (local name): 0,,n_sect,0,address } + N_LENG = $fe; { second stab entry with length information } + { * for the berkeley pascal compiler, pc(1): } + N_PC = $30; { global pascal symbol: name,,NO_SECT,subtype,line } + +implementation + +end. + + + diff --git a/closures/compiler/machoutils.pas b/closures/compiler/machoutils.pas new file mode 100644 index 0000000000..b9060b3127 --- /dev/null +++ b/closures/compiler/machoutils.pas @@ -0,0 +1,1466 @@ +{ + Copyright (c) 2009-2010 by Dmitry Boyarintsev + + Contains utility routines and types for handling mach-o structure and 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. + + **************************************************************************** + +} + +unit machoutils; + +interface + +{$mode objfpc}{$h+} + +uses + macho; + + type + TRawWriter=class(TObject) + public + procedure WriteRaw(const data; datasize: Integer); virtual; abstract; + end; + + TRawReader=class(TObject) + public + function ReadRaw(var data; datasize: Integer): Integer; virtual; abstract; + function Seek(pos: qword): Boolean; virtual; abstract; + function ReadPos: qword; virtual; abstract; + end; + + TMachHeader=record + cputype : cpu_type_t; + cpusubtype : cpu_subtype_t; + filetype : longword; + ncmds : longword; + sizeofcmds : longword; + flags : longword; + end; + + TSegmentName=string[16]; + TSectionName=TSegmentName; + + TMachoSegment=record + segname : TSegmentName; + vmaddr : qword; + vmsize : qword; + fileoff : qword; + filesize : qword; + maxprot : vm_prot_t; + initprot : vm_prot_t; + nsects : longword; + flags : longword; + end; + + TMachoSection=record + sectname : TSectionName; + segname : TSegmentName; + addr : uint64_t; + size : uint64_t; + offset : uint32_t; + align : uint32_t; + reloff : uint32_t; + nreloc : uint32_t; + flags : uint32_t; + + indirectIndex : Integer; // reserved1 for LAZY and NON_LAZY pointers + stubSize : Integer; // reserved2 for S_SYMBOL_STUBS + end; + + TMachoRoutine=record + init_address : uint64_t; { address of initialization routine } + init_module : uint64_t; { index into the module table that } + end; + + { TMachoWriter } + + TMachoWriter=class(TObject) + private + fwriter : TRawWriter; + fown : Boolean; + protected + public + constructor Create(ARawWriter: TRawWriter; AllowFreeWriter: Boolean); + destructor Destroy; override; + + { non platform specific writer } + procedure WriteData(const data; dataSize: Integer); + procedure WriteUint8(i: uint8_t); + + { endian specific writer } + procedure WriteUint16(i: uint16_t); virtual; abstract; + procedure WriteUint32(i: uint32_t); virtual; abstract; + procedure WriteUint64(i: uint64_t); virtual; abstract; + + { endian and ptr-size specific writer } + procedure WritePtr(ofs: QWord); virtual; abstract; // ptr is 32 bit for 32-bit platforms + + { macro utility methods } + + procedure WriteHeader(const hdr: TMachHeader); virtual; abstract; + procedure WriteSegmentCmd(const seg: TMachoSegment; cmdSize: LongWord); virtual; abstract; + procedure WriteSection(const sec: TMachoSection); virtual; abstract; + procedure WriteRoutineCmd(const rt: TMachoRoutine); virtual; abstract; + procedure WriteLoadCommand(const cmd: load_command); virtual; abstract; overload; + procedure WriteLoadCommand(cmd, cmdsize: Integer); overload; + procedure WriteRelocation(const ri: relocation_info); virtual; abstract; + procedure WriteScatterReloc(const ri: scattered_relocation_info); virtual; abstract; + procedure WriteNList(const list: nlist_64); virtual; abstract; + end; + + { TLE32MachoWriter } + + TLE32MachoWriter=class(TMachoWriter) + public + procedure WriteUint16(i: uint16_t); override; + procedure WriteUint32(i: uint32_t); override; + procedure WriteUint64(i: uint64_t); override; + procedure WritePtr(ofs: QWord); override; + + procedure WriteHeader(const hdr: TMachHeader); override; + procedure WriteSegmentCmd(const seg: TMachoSegment; ACmdSize: LongWord); override; + procedure WriteSection(const sec: TMachoSection); override; + procedure WriteRoutineCmd(const rt: TMachoRoutine); override; + procedure WriteLoadCommand(const cmd: load_command); override; + procedure WriteRelocation(const ri: relocation_info); override; + procedure WriteScatterReloc(const ri: scattered_relocation_info); override; + procedure WriteNList(const list: nlist_64); override; + end; + + { TLE64MachoWriter } + + TLE64MachoWriter=class(TLE32MachoWriter) + public + procedure WritePtr(ofs: QWord); override; + + procedure WriteHeader(const hdr: TMachHeader); override; + procedure WriteSegmentCmd(const seg: TMachoSegment; acmdSize: LongWord); override; + procedure WriteSection(const sec: TMachoSection); override; + procedure WriteRoutineCmd(const rt: TMachoRoutine); override; + procedure WriteNList(const list: nlist_64); override; + end; + + { TBE32MachoWriter } + + TBE32MachoWriter=class(TMachoWriter) + public + procedure WriteUint16(i: uint16_t); override; + procedure WriteUint32(i: uint32_t); override; + procedure WriteUint64(i: uint64_t); override; + procedure WritePtr(ofs: QWord); override; + + procedure WriteHeader(const hdr: TMachHeader); override; + procedure WriteSegmentCmd(const seg: TMachoSegment; acmdSize: LongWord); override; + procedure WriteSection(const sec: TMachoSection); override; + procedure WriteRoutineCmd(const rt: TMachoRoutine); override; + procedure WriteLoadCommand(const cmd: load_command); override; + procedure WriteRelocation(const ri: relocation_info); override; + procedure WriteScatterReloc(const ri: scattered_relocation_info); override; + procedure WriteNList(const list: nlist_64); override; + end; + + { TBE64MachoWriter } + + TBE64MachoWriter=class(TBE32MachoWriter) + public + procedure WritePtr(ofs: QWord); override; + + procedure WriteHeader(const hdr: TMachHeader); override; + procedure WriteSegmentCmd(const seg: TMachoSegment; acmdSize: LongWord); override; + procedure WriteSection(const sec: TMachoSection); override; + procedure WriteRoutineCmd(const rt: TMachoRoutine); override; + procedure WriteNList(const list: nlist_64); override; + end; + + + { TLEMachoStructConverter } + + { converter for Little-endian structures to Host } + TLEMachoStructConverter = class(TObject) + public + procedure ConvertMachoHeader(const mh: mach_header; var hdr: TMachHeader); virtual; + procedure ConvertMachoHeader64(const mh: mach_header_64; var hdr: TMachHeader); virtual; + procedure ConvertLoadCommand(var cmd: load_command); virtual; + procedure ConvertSegment(const segcmd: segment_command; var segment: TMachoSegment); virtual; + procedure ConvertSegment64(const segcmd: segment_command_64; var segment: TMachoSegment); virtual; + procedure ConvertSection(const sec: section; var section: TMachoSection); virtual; + procedure ConvertSection64(const sec: section_64; var section: TMachoSection); virtual; + + procedure ConvertUInt16(var v: Word); virtual; + procedure ConvertUInt32(var v: LongWord); virtual; + procedure ConvertUInt64(var v: qWord); virtual; + end; + + { converter for Big-endian structures to Host } + TBEMachoStructConverter = class(TLEMachoStructConverter); + + {common} + TMachoStructConverter = TLEMachoStructConverter; + + { TMachoReader } + + TMachoReader=class(TObject) + private + fReader : TRawReader; + HdrOfs : qword; + fCnv : TMachoStructConverter; + fHdr : TMachHeader; + is64 : Boolean; + cmdofs : array of qword; + cmds : array of load_command; + protected + function IntReadStruct: Boolean; + public + constructor Create(ARawReader: TRawReader; StartOfs: QWord=0); + function ReadHeader(var hdr: TMachHeader): Boolean; + function ReadCommandID(index: LongWord; var cmd: load_command): Boolean; + function GetCmdOfs(index: LongWord): qword; + + function ReadSegmentCommand(cmdindex: LongWord; var segment: TMachoSegment): Boolean; + function ReadSection(segindex, secindex: LongWord; var machsection: TMachoSection): Boolean; + + function ReadSymTabCmd(var symcmd: symtab_command): Boolean; + + function ReadUInt32(var v: LongWord): Boolean; + function ReadData(var data; dataSize: Integer): Integer; + + {todo: ReadNList - using index of symbol, instead of file offset?} + function GetNListSize: Integer; + function ReadNList(fileofs: qword; var nsym: nlist_64): Boolean; + + procedure Seek(apos: qword); + end; + + const + seg_TEXT : TSegmentName = '__TEXT'; + seg_DATA : TSegmentName = '__DATA'; + seg_OBJC : TSegmentName = '__OBJC'; + seg_IMPORT : TSegmentName = '__IMPORT'; + seg_DWARF : TSegmentName = '__DWARF'; + + function AllocMachoWriter(cputarget: cpu_type_t; ARawWriter: TRawWriter; AllowFreeWriter: Boolean): TMachoWriter; + + function sizeMachHeader(cputarget: cpu_type_t): integer; inline; + function sizeSegment(cputarget: cpu_type_t): integer; inline; + function sizeSection(cputarget: cpu_type_t): integer; inline; + function sizeNList(cputarget: cpu_type_t): integer; inline; + + function AlignAddr(cputarget: cpu_type_t; addr: qword): qword; + + procedure InitSegment(var seg: TMachoSegment); + + function MakeSectionName(const segName, secName: shortstring): shortstring; + function GetSegmentSectionName(const objSecName: shortstring; var segName, secName: shortstring): shortstring; + + function GetSectionFlags(const segName, secName: shortstring): LongWord; + + type + TRelocInfoLength = (ril_byte = 0, ril_word = 1, ril_long = 2, ril_quad = 3); + + procedure RelocInfo(addr, symnum, reltype: integer; len: TRelocInfoLength; pcrel, extern: Boolean; var info: relocation_info); + procedure ScatterRelocInfo(value, addr, reltype: integer; len: TRelocInfoLength; pcrel: Boolean; var info: scattered_relocation_info); + + function GetReserved1(const macho: TMachoSection): integer; + function GetReserved2(const macho: TMachoSection): integer; + + function GetStubSize(cputarget: Integer; Pic: Boolean): Integer; + function MachoAlign(al: integer): integer; + +implementation + + function MachoAlign(al: integer): integer; + begin + Result:=0; + al:=al shr 1; + while al>0 do + begin + inc(Result); + al:=al shr 1; + end; + end; + + + function AllocConverter(magic: LongWord): TMachoStructConverter; + begin + {$ifdef ENDIAN_BIG} + if magic=MH_MAGIC then + Result:=TBEMachoStructConverter.Create + else + Result:=TLEMachoStructConverter.Create; + {$else} + if magic=MH_MAGIC then + Result:=TLEMachoStructConverter.Create + else + Result:=TBEMachoStructConverter.Create; + {$endif} + end; + + + {result values are used from aggas.pas, see TGNUAssembler.WriteSection } + function GetStubSize(cputarget: Integer; Pic: Boolean): Integer; + begin + case cputarget of + CPU_TYPE_I386, CPU_TYPE_X86_64: + Result:=5; + CPU_TYPE_POWERPC, CPU_TYPE_POWERPC64: + if Pic then + Result:=32 + else + Result:=16; + CPU_TYPE_ARM: + if Pic then + Result:=16 + else + Result:=12; + else + Result:=-1; + end; + end; + + + function GetReserved1(const macho: TMachoSection): integer; + begin + case macho.flags and SECTION_TYPE of + S_NON_LAZY_SYMBOL_POINTERS, S_LAZY_SYMBOL_POINTERS: + Result:=macho.indirectIndex; + else + Result:=0; + end; + end; + + + function GetReserved2(const macho: TMachoSection): integer; + begin + case macho.flags and SECTION_TYPE of + S_SYMBOL_STUBS: + Result:=macho.stubSize + else + Result:=0; + end; + end; + + + procedure RelocInfo(addr, symnum, reltype: integer; len: TRelocInfoLength; pcrel, extern: Boolean; var info: relocation_info); + {$ifdef ENDIAN_BIG} + const + relbit : array [Boolean] of Integer = (0, 1 shl 7); + extbit : array [Boolean] of Integer = (0, 1 shl 4); + ri_len_mask : array [TRelocInfoLength] of Integer = (0 shl 5, 1 shl 5, 2 shl 5, 3 shl 5); + begin + info.r_address:=addr; + info.r_info:=((symnum and $FFFFFF) shl 8) or // r_symbolnum:24 + relbit[pcrel] or // r_pcrel:1; + ri_len_mask[len] or // r_length:2; + extbit[extern] or // r_extern:1; + (reltype and $F); // r_type:4; + end; + {$else} + const + relbit : array [Boolean] of Integer = (0, 1 shl 24); + extbit : array [Boolean] of Integer = (0, 1 shl 27); + ri_len_mask : array [TRelocInfoLength] of Integer = (0 shl 25, 1 shl 25, 2 shl 25, 3 shl 25); + begin + info.r_address:=addr; + info.r_info:=(symnum and $FFFFFF) or // r_symbolnum:24 + relbit[pcrel] or // r_pcrel:1; + extbit[extern] or // r_length:2; + ri_len_mask[len] or // r_extern:1; + (reltype shl 28); // r_type:4; + end; + {$endif} + + +const + si_len_mask: array [TRelocInfoLength] of Integer = (0 shl 28, 1 shl 28, 2 shl 28, 3 shl 28); + si_type_ofs = 24; + si_pcrel_bit = 1 shl 30; + si_scatter_bit = 1 shl 31; + si_addr_ofs = 0; + + + procedure ScatterRelocInfo(value, addr, reltype: integer; len: TRelocInfoLength; pcrel: Boolean; var info: scattered_relocation_info); + const + relbit : array [Boolean] of Integer = (0, si_pcrel_bit); + begin + // big endian + info.r_info:=si_scatter_bit or // r_scattered:1, /* 1=scattered, 0=non-scattered (see above) */ + relbit[pcrel] or // r_pcrel:1, /* was relocated pc relative already */ + si_len_mask[len] or // r_length:2, /* 0=byte, 1=word, 2=long, 3=quad */ + ((reltype and $F) shl si_type_ofs) or // r_type:4, /* if not 0, machine specific relocation type */ + ((addr and $FFFFFF) shl si_addr_ofs); // r_address:24; /* offset in the section to what is being relocated */} + info.r_value:=value; + // little endian + // r_address:24, /* offset in the section to what is being relocated */ + // r_type:4, /* if not 0, machine specific relocation type */ + // r_length:2, /* 0=byte, 1=word, 2=long, 3=quad */ + // r_pcrel:1, /* was relocated pc relative already */ + // r_scattered:1; /* 1=scattered, 0=non-scattered (see above) */ *} + end; + + + function GetSectionFlags(const segName, secName: shortstring): LongWord; + begin + Result:=0; + if segName = seg_DATA then + begin + if secName = '__nl_symbol_ptr' then + Result:=Result or S_NON_LAZY_SYMBOL_POINTERS + else if secName = '__la_symbol_ptr' then + Result:=Result or S_LAZY_SYMBOL_POINTERS + else if secName = '__common' then + Result:=Result or S_ZEROFILL + end + else if segName = seg_TEXT then + begin + if (secName = '__text') then + Result:=Result or S_ATTR_PURE_INSTRUCTIONS or S_ATTR_SOME_INSTRUCTIONS + else if secName = '__textcoal_nt' then + Result:=Result or S_ATTR_PURE_INSTRUCTIONS or S_ATTR_SOME_INSTRUCTIONS or S_COALESCED + else if secName = '.fpc' then + Result:=Result or S_ATTR_NO_DEAD_STRIP + else if secName = '__cstring' then + Result:=Result or S_CSTRING_LITERALS; + end + else if (segName = seg_IMPORT) then + begin + if (secName = '__jump_table') then + Result:=Result or S_SYMBOL_STUBS or S_ATTR_SELF_MODIFYING_CODE or S_ATTR_SOME_INSTRUCTIONS + end + else if (segName=seg_OBJC) then + begin + Result:=S_ATTR_NO_DEAD_STRIP; + if secName='__message_refs' then + Result:=Result or S_ATTR_NO_DEAD_STRIP or S_LITERAL_POINTERS + else if secName='__cls_refs' then + Result:=Result or S_ATTR_NO_DEAD_STRIP or S_LITERAL_POINTERS; + end; + end; + + + function MakeSectionName(const segName, secName: shortstring): shortstring; + begin + if segName = '' then + Result:=secName + else + Result:=segName+' '+secName; + end; + + + function GetSegmentSectionName(const objSecName: shortstring; var segName, secName: shortstring): shortstring; + var + i : integer; + begin + i:=Pos(' ', objSecName); + if i>0 then + begin + segName:=copy(objsecName, 1, i-1); + secName:=copy(objsecName, i+1, length(objsecName)-i); + end + else + begin + segName:=''; + secName:=objSecName; + end; + Result:=objSecName; + end; + + + procedure InitSegment(var seg: TMachoSegment); + begin + FillChar(seg, sizeof(seg), 0); + seg.initprot:=VM_PROT_ALL; + seg.maxprot:=VM_PROT_ALL; + end; + + + const + is64MachHeaderSize : array [Boolean] of Integer = ( sizeof(mach_header), sizeof(mach_header_64)); + is64SectionSize : array [Boolean] of Integer = ( sizeof(section), sizeof(section_64)); + is64SegmentSize : array [Boolean] of Integer = ( sizeof(segment_command), sizeof(segment_command_64)); + is64NListSize : array [Boolean] of Integer = (sizeof(nlist), sizeof(nlist_64)); + + function AlignAddr(cputarget: cpu_type_t; addr: qword): qword; + var + md : array [Boolean] of integer = (4, 8); + p : PtrUInt; + begin + p:=addr; + p:=align(p, md[cputarget and CPU_ARCH_ABI64 > 0]); + Result:=qword(p); + end; + + + function sizeMachHeader(cputarget: cpu_type_t): integer; + begin + Result:=is64MachHeaderSize[ cputarget and CPU_ARCH_ABI64 > 0]; + end; + + + function sizeSegment(cputarget: cpu_type_t): integer; + begin + Result:=is64SegmentSize[ cputarget and CPU_ARCH_ABI64 > 0]; + end; + + + function sizeSection(cputarget: cpu_type_t): integer; + begin + Result:=is64SectionSize[ cputarget and CPU_ARCH_ABI64 > 0]; + end; + + + function sizeNList(cputarget: cpu_type_t): integer; inline; + begin + Result:=is64NlistSize[ cputarget and CPU_ARCH_ABI64 > 0]; + end; + + + function AllocMachoWriter(cputarget: cpu_type_t; ARawWriter: TRawWriter; AllowFreeWriter: Boolean): TMachoWriter; + begin + case cputarget of + CPU_TYPE_I386, + CPU_TYPE_ARM: Result:=TLE32MachoWriter.Create(ARawWriter, AllowFreeWriter); + CPU_TYPE_X86_64: Result:=TLE64MachoWriter.Create(ARawWriter, AllowFreeWriter); + CPU_TYPE_POWERPC: Result:=TBE32MachoWriter.Create(ARawWriter, AllowFreeWriter); + CPU_TYPE_POWERPC64: Result:=TBE64MachoWriter.Create(ARawWriter, AllowFreeWriter); + else + begin + if AllowFreeWriter then + ARawWriter.Free; + Result:=nil; + end; + end; + end; + + + { TMachoWriter } + + procedure TMachoWriter.WriteData(const data; dataSize: Integer); + begin + if not assigned(fwriter) then + Exit; + fwriter.WriteRaw(data, dataSize); + end; + + + procedure TMachoWriter.WriteUint8(i: uint8_t); + begin + WriteData(i, sizeof(i)); + end; + + + procedure TMachoWriter.WriteLoadCommand(cmd, cmdsize: Integer); + var + m : load_command; + begin + m.cmd:=cmd; + m.cmdsize:=cmdsize; + WriteLoadCommand(m); + end; + + + constructor TMachoWriter.Create(ARawWriter: TRawWriter; AllowFreeWriter: Boolean); + begin + inherited Create; + fwriter:=ARawWriter; + fown:=AllowFreeWriter; + end; + + + destructor TMachoWriter.Destroy; + begin + if fown then + fwriter.Free; + inherited Destroy; + end; + + + { TLE32MachoWriter } + + procedure TLE32MachoWriter.WriteHeader(const hdr: TMachHeader); + var + m : mach_header; + begin + with m do + begin + magic:=NtoLE(MH_MAGIC); + cputype:=NtoLE(hdr.cputype); + cpusubtype:=NtoLE(hdr.cpusubtype); + filetype:=NtoLE(hdr.filetype); + ncmds:=NtoLE(hdr.ncmds); + sizeofcmds:=NtoLE(hdr.sizeofcmds); + flags:=NtoLE(hdr.flags); + end; + WriteData(m, sizeof(m)); + end; + + + procedure TLE32MachoWriter.WriteSegmentCmd(const seg: TMachoSegment; ACmdSize: LongWord); + var + m : segment_command; + begin + with m do + begin + cmd:=NtoLE(LC_SEGMENT); + cmdsize:=NtoLE(ACmdSize); + segname:=seg.segname; + vmaddr:=NtoLE(uint32_t(seg.vmaddr)); + vmsize:=NtoLE(uint32_t(seg.vmsize)); + fileoff:=NtoLE(uint32_t(seg.fileoff)); + filesize:=NtoLE(uint32_t(seg.filesize)); + maxprot:=NtoLE(seg.maxprot); + initprot:=NtoLE(seg.initprot); + nsects:=NtoLE(seg.nsects); + flags:=NtoLE(seg.flags); + end; + WriteData(m, sizeof(m)); + end; + + + procedure TLE32MachoWriter.WriteSection(const sec: TMachoSection); + var + m : section; + begin + FillChar(m, sizeof(m), 0); + with m do + begin + sectname:=sec.sectname; + segname:=sec.segname; + addr:=NtoLE(sec.addr); + size:=NtoLE(sec.size); + offset:=NtoLE(sec.offset); + align:=NtoLE(sec.align); + reloff:=NtoLE(sec.reloff); + nreloc:=NtoLE(sec.nreloc); + flags:=NtoLE(sec.flags); + reserved1:=NtoLE( GetReserved1(sec)); + reserved2:=NtoLE( GetReserved2(sec)); + end; + WriteData(m, sizeof(m)); + end; + + + procedure TLE32MachoWriter.WriteRoutineCmd(const rt: TMachoRoutine); + var + m : routines_command; + begin + FillChar(m, sizeof(m), 0); + with m do + begin + cmd:=NtoLE(LC_ROUTINES); + cmdsize:=NtoLE(sizeof(m)); + init_address:=NtoLE(rt.init_address); + init_module:=NtoLE(rt.init_module); + end; + WriteData(m, sizeof(m)); + end; + + + procedure TLE32MachoWriter.WriteLoadCommand(const cmd: load_command); + var + m : load_command; + begin + m.cmd:=NtoLE(cmd.cmd); + m.cmdsize:=NtoLE(cmd.cmdsize); + WriteData(m, sizeof(m)); + end; + + + procedure TLE32MachoWriter.WriteRelocation(const ri: relocation_info); + var + m : relocation_info; + begin + m.r_address:=NtoLE(ri.r_address); + m.r_info:=NtoLE(ri.r_info); + WriteData(m, sizeof(m)); + end; + + + procedure TLE32MachoWriter.WriteScatterReloc(const ri: scattered_relocation_info); + var + m : LongWord; + begin + m:=LongWord(ri.r_info); + WriteUint32(NtoLE(m)); + + m:=LongWord(ri.r_value); + WriteUint32(NtoLE(m)); + end; + + + procedure TLE32MachoWriter.WriteNList(const list: nlist_64); + var + m : nlist; + begin + m.n_un.n_strx:=NtoLe(list.n_un.n_strx); + m.n_type:=NtoLe(list.n_type); + m.n_sect:=NtoLe(list.n_sect); + m.n_desc:=NtoLe(list.n_desc); + m.n_value:=NtoLe(list.n_value); + WriteData(m, sizeof(m)); + end; + + + procedure TLE32MachoWriter.WriteUint16(i: uint16_t); + var + m: uint16_t; + begin + m:=NtoLE(i); + WriteData(m, sizeof(m)); + end; + + + procedure TLE32MachoWriter.WriteUint32(i: uint32_t); + var + m: uint32_t; + begin + m:=NtoLE(i); + WriteData(m, sizeof(m)); + end; + + + procedure TLE32MachoWriter.WriteUint64(i: uint64_t); + var + m: uint64_t; + begin + m:=NtoLE(i); + WriteData(m, sizeof(m)); + end; + + + procedure TLE32MachoWriter.WritePtr(ofs: QWord); + var + m: uint32_t; + begin + m:=NtoLE(ofs); + WriteData(m, sizeof(m)); + end; + + + { TLE64MachoWriter } + + procedure TLE64MachoWriter.WritePtr(ofs: QWord); + var + m : uint64_t; + begin + m:=NtoLE(ofs); + Writedata(m, sizeof(m)); + end; + + + procedure TLE64MachoWriter.WriteHeader(const hdr: TMachHeader); + var + m : mach_header_64; + begin + with m do + begin + magic:=NtoLE(MH_MAGIC_64); + cputype:=NtoLE(hdr.cputype); + cpusubtype:=NtoLE(hdr.cpusubtype); + filetype:=NtoLE(hdr.filetype); + ncmds:=NtoLE(hdr.ncmds); + sizeofcmds:=NtoLE(hdr.sizeofcmds); + flags:=NtoLE(hdr.flags); + reserved:=0; + end; + WriteData(m, sizeof(m)); + end; + + + procedure TLE64MachoWriter.WriteSegmentCmd(const seg: TMachoSegment; acmdSize: LongWord); + var + m : segment_command_64; + begin + with m do + begin + cmd:=NtoLE(LC_SEGMENT_64); + cmdsize:=NtoLE(acmdSize); + segname:=seg.segname; + vmaddr:=NtoLE(seg.vmaddr); + vmsize:=NtoLE(seg.vmsize); + fileoff:=NtoLE(seg.fileoff); + filesize:=NtoLE(seg.filesize); + maxprot:=NtoLE(seg.maxprot); + initprot:=NtoLE(seg.initprot); + nsects:=NtoLE(seg.nsects); + flags:=NtoLE(seg.flags); + end; + WriteData(m, sizeof(m)); + end; + + + procedure TLE64MachoWriter.WriteSection(const sec: TMachoSection); + var + m : section_64; + begin + FillChar(m, sizeof(m), 0); + with m do + begin + sectname:=sec.sectname; + segname:=sec.segname; + addr:=NtoLE(sec.addr); + size:=NtoLE(sec.size); + offset:=NtoLE(sec.offset); + align:=NtoLE(sec.align); + reloff:=NtoLE(sec.reloff); + nreloc:=NtoLE(sec.nreloc); + flags:=NtoLE(sec.flags); + reserved1:=NtoLE( GetReserved1(sec)); + reserved2:=NtoLE( GetReserved2(sec)); + end; + WriteData(m, sizeof(m)); + end; + + + procedure TLE64MachoWriter.WriteRoutineCmd(const rt: TMachoRoutine); + var + m : routines_command_64; + begin + FillChar(m, sizeof(m), 0); + with m do + begin + cmd:=NtoLE(LC_ROUTINES); + cmdsize:=NtoLE(sizeof(m)); + init_address:=NtoLE(rt.init_address); + init_module:=NtoLE(rt.init_module); + end; + WriteData(m, sizeof(m)); + end; + + + procedure TLE64MachoWriter.WriteNList(const list: nlist_64); + var + m : nlist_64; + begin + m.n_un.n_strx:=NtoLe(list.n_un.n_strx); + m.n_type:=NtoLe(list.n_type); + m.n_sect:=NtoLe(list.n_sect); + m.n_desc:=NtoLe(list.n_desc); + m.n_value:=NtoLe(list.n_value); + WriteData(m, sizeof(m)); + end; + + + { TBE32MachoWriter } + + procedure TBE32MachoWriter.WriteHeader(const hdr: TMachHeader); + var + m : mach_header; + begin + with m do + begin + magic:=NtoBE(MH_MAGIC); + cputype:=NtoBE(hdr.cputype); + cpusubtype:=NtoBE(hdr.cpusubtype); + filetype:=NtoBE(hdr.filetype); + ncmds:=NtoBE(hdr.ncmds); + sizeofcmds:=NtoBE(hdr.sizeofcmds); + flags:=NtoBE(hdr.flags); + end; + WriteData(m, sizeof(m)); + end; + + + procedure TBE32MachoWriter.WriteSegmentCmd(const seg: TMachoSegment; acmdSize: LongWord); + var + m : segment_command; + begin + with m do + begin + cmd:=NtoBE(LC_SEGMENT); + cmdsize:=NtoBE(acmdSize); + segname:=seg.segname; + vmaddr:=NtoBE(uint32_t(seg.vmaddr)); + vmsize:=NtoBE(uint32_t(seg.vmsize)); + fileoff:=NtoBE(uint32_t(seg.fileoff)); + filesize:=NtoBE(uint32_t(seg.filesize)); + maxprot:=NtoBE(seg.maxprot); + initprot:=NtoBE(seg.initprot); + nsects:=NtoBE(seg.nsects); + flags:=NtoBE(seg.flags); + end; + WriteData(m, sizeof(m)); + end; + + + procedure TBE32MachoWriter.WriteSection(const sec: TMachoSection); + var + m : section; + begin + FillChar(m, sizeof(m), 0); + with m do + begin + sectname:=sec.sectname; + segname:=sec.segname; + addr:=NtoBE(sec.addr); + size:=NtoBE(sec.size); + offset:=NtoBE(sec.offset); + align:=NtoBE(sec.align); + reloff:=NtoBE(sec.reloff); + nreloc:=NtoBE(sec.nreloc); + flags:=NtoBE(sec.flags); + reserved1:=NtoBE( GetReserved1(sec)); + reserved2:=NtoBE( GetReserved2(sec)); + end; + WriteData(m, sizeof(m)); + end; + + + procedure TBE32MachoWriter.WriteRoutineCmd(const rt: TMachoRoutine); + var + m : routines_command; + begin + FillChar(m, sizeof(m), 0); + with m do + begin + cmd:=NtoBE(LC_ROUTINES); + cmdsize:=NtoBE(sizeof(m)); + init_address:=NtoBE(rt.init_address); + init_module:=NtoBE(rt.init_module); + end; + WriteData(m, sizeof(m)); + end; + + + procedure TBE32MachoWriter.WriteLoadCommand(const cmd: load_command); + var + m : load_command; + begin + m.cmd:=NtoBE(cmd.cmd); + m.cmdsize:=NtoBE(cmd.cmdsize); + WriteData(m, sizeof(m)); + end; + + + procedure TBE32MachoWriter.WriteRelocation(const ri: relocation_info); + var + m : relocation_info; + begin + m.r_address:=NtoBE(ri.r_address); + m.r_info:=NtoBE(ri.r_info); + WriteData(m, sizeof(m)); + end; + + + procedure TBE32MachoWriter.WriteScatterReloc(const ri: scattered_relocation_info); + var + m : LongWord; + begin + m:=LongWord(ri.r_info); + WriteUint32(NtoBE(m)); + + m:=LongWord(ri.r_value); + WriteUint32(NtoBE(m)); + end; + + + procedure TBE32MachoWriter.WriteNList(const list: nlist_64); + var + m : nlist; + begin + m.n_un.n_strx:=NtoBe(list.n_un.n_strx); + m.n_type:=NtoBe(list.n_type); + m.n_sect:=NtoBe(list.n_sect); + m.n_desc:=NtoBe(list.n_desc); + m.n_value:=NtoBe(list.n_value); + WriteData(m, sizeof(m)); + end; + + + procedure TBE32MachoWriter.WriteUint16(i: uint16_t); + var + m: uint16_t; + begin + m:=NtoBE(i); + WriteData(m, sizeof(m)); + end; + + + procedure TBE32MachoWriter.WriteUint32(i: uint32_t); + var + m: uint32_t; + begin + m:=NtoBE(i); + WriteData(m, sizeof(m)); + end; + + + procedure TBE32MachoWriter.WriteUint64(i: uint64_t); + var + m: uint64_t; + begin + m:=NtoBE(i); + WriteData(m, sizeof(m)); + end; + + + procedure TBE32MachoWriter.WritePtr(ofs: QWord); + var + m: uint32_t; + begin + m:=NtoBE(ofs); + WriteData(m, sizeof(m)); + end; + + + { TBE64MachoWriter } + + procedure TBE64MachoWriter.WritePtr(ofs: QWord); + var + m : uint64_t; + begin + m:=NtoBE(ofs); + Writedata(m, sizeof(m)); + end; + + + procedure TBE64MachoWriter.WriteHeader(const hdr: TMachHeader); + var + m : mach_header_64; + begin + with m do + begin + magic:=NtoBE(MH_MAGIC_64); + cputype:=NtoBE(hdr.cputype); + cpusubtype:=NtoBE(hdr.cpusubtype); + filetype:=NtoBE(hdr.filetype); + ncmds:=NtoBE(hdr.ncmds); + sizeofcmds:=NtoBE(hdr.sizeofcmds); + flags:=NtoBE(hdr.flags); + reserved:=0; + end; + WriteData(m, sizeof(m)); + end; + + + procedure TBE64MachoWriter.WriteSegmentCmd(const seg: TMachoSegment; acmdSize: LongWord); + var + m : segment_command_64; + begin + with m do + begin + cmd:=NtoBE(LC_SEGMENT_64); + cmdsize:=NtoBE(acmdSize); + segname:=seg.segname; + vmaddr:=NtoBE(seg.vmaddr); + vmsize:=NtoBE(seg.vmsize); + fileoff:=NtoBE(seg.fileoff); + filesize:=NtoBE(seg.filesize); + maxprot:=NtoBE(seg.maxprot); + initprot:=NtoBE(seg.initprot); + nsects:=NtoBE(seg.nsects); + flags:=NtoBE(seg.flags); + end; + WriteData(m, sizeof(m)); + end; + + + procedure TBE64MachoWriter.WriteSection(const sec: TMachoSection); + var + m : section_64; + begin + FillChar(m, sizeof(m), 0); + with m do + begin + sectname:=sec.sectname; + segname:=sec.segname; + addr:=NtoBE(sec.addr); + size:=NtoBE(sec.size); + offset:=NtoBE(sec.offset); + align:=NtoBE(sec.align); + reloff:=NtoBE(sec.reloff); + nreloc:=NtoBE(sec.nreloc); + flags:=NtoBE(sec.flags); + reserved1:=NtoBE( GetReserved1(sec)); + reserved2:=NtoBE( GetReserved2(sec)); + end; + WriteData(m, sizeof(m)); + end; + + + procedure TBE64MachoWriter.WriteRoutineCmd(const rt: TMachoRoutine); + var + m : routines_command_64; + begin + FillChar(m, sizeof(m), 0); + with m do + begin + cmd:=NtoBE(LC_ROUTINES); + cmdsize:=NtoBE(sizeof(m)); + init_address:=NtoBE(rt.init_address); + init_module:=NtoBE(rt.init_module); + end; + WriteData(m, sizeof(m)); + end; + + + procedure TBE64MachoWriter.WriteNList(const list: nlist_64); + var + m : nlist_64; + begin + m.n_un.n_strx:=NtoBe(list.n_un.n_strx); + m.n_type:=NtoBe(list.n_type); + m.n_sect:=NtoBe(list.n_sect); + m.n_desc:=NtoBe(list.n_desc); + m.n_value:=NtoBe(list.n_value); + WriteData(m, sizeof(m)); + end; + + + { TMachoReader } + + constructor TMachoReader.Create(ARawReader: TRawReader; StartOfs: QWord=0); + begin + inherited Create; + fReader:=ARawReader; + hdrofs:=StartOfs; + end; + + + function TMachoReader.IntReadStruct: Boolean; + var + m : mach_header_64; + i : Integer; + p : qword; + begin + Result:=false; + if not fReader.Seek(hdrofs) then + Exit; + //todo: + fReader.ReadRaw(m, sizeof(mach_header_64)); + fCnv:=AllocConverter(m.magic); + fCnv.ConvertMachoHeader(pmach_header(@m)^, fhdr); + is64:=fhdr.cputype and CPU_ARCH_ABI64>0; + Result:=true; + + SetLength(cmds, fHdr.ncmds); + if fHdr.ncmds>0 then + begin + if is64 then + p:=sizeof(mach_header_64) + else + p:=sizeof(mach_header); + + SetLength(cmdofs, fHdr.ncmds); + for i:=0 to fHdr.ncmds - 1 do + begin + cmdofs[i]:=p; + fReader.Seek(p); + fReader.ReadRaw(cmds[i], sizeof(cmds[i])); + fCnv.ConvertLoadCommand(cmds[i]); + inc(p, cmds[i].cmdsize); + end; + end; + end; + + + function TMachoReader.ReadHeader(var hdr: TMachHeader): Boolean; + begin + if not Assigned(fCnv) then + Result:=IntReadStruct + else + Result:=true; + hdr:=fhdr; + end; + + + function TMachoReader.ReadCommandID(index: LongWord; var cmd: load_command): Boolean; + begin + if not Assigned(fCnv) then + IntReadStruct; + Result:={(index>=0) and }(index<fHdr.ncmds); + if not Result then + Exit; + Result:=true; + cmd:=cmds[index]; + end; + + + function TMachoReader.ReadSegmentCommand(cmdindex: LongWord; var segment: TMachoSegment): Boolean; + var + seg64 : segment_command_64; + seg32 : segment_command; + begin + if not Assigned(fCnv) then + IntReadStruct; + + Result:={(cmdindex>=0) and } + (cmdindex<fHdr.ncmds) and + (cmds[cmdindex].cmd in [LC_SEGMENT, LC_SEGMENT_64]); + + if Result then + begin + fReader.Seek(cmdofs[cmdindex]); + if is64 then + begin + Result:=fReader.ReadRaw(seg64, sizeof(seg64))=sizeof(seg64); + if Result then + fCnv.ConvertSegment64(seg64, segment); + end + else + begin + Result:=fReader.ReadRaw(seg32, sizeof(seg32))=sizeof(seg32); + if Result then + fCnv.ConvertSegment(seg32, segment); + end; + end; + end; + + + function TMachoReader.GetCmdOfs(index: LongWord): qword; + begin + if not Assigned(fCnv) then + IntReadStruct; + + if {(index<0) or} + (index>=longword(length(cmdofs))) then + Result:=0 + else + Result:=cmdofs[index]; + end; + + + function TMachoReader.ReadSection(segindex, secindex: LongWord; var machsection: TMachoSection): Boolean; + var + ofs : qword; + is64bit : Boolean; + buf : array [0..sizeof(section_64)-1] of byte; + const + sectsize : array[Boolean] of LongWord = ( sizeof(macho.section), sizeof(macho.section_64)); + segsize : array[Boolean] of LongWord = ( sizeof(macho.segment_command), sizeof(macho.segment_command_64)); + begin + if not Assigned(fCnv) then + IntReadStruct; + Result:={(secindex>=0) and (segindex>=0) and }(segindex<fHdr.ncmds) and (cmds[segindex].cmd in [LC_SEGMENT, LC_SEGMENT_64]); + if not Result then + Exit; + + is64bit:=cmds[segindex].cmd=LC_SEGMENT_64; + Result:=secindex<(cmds[segindex].cmdsize-segsize[is64bit]) div sectsize[is64bit]; + if not Result then + Exit; + + ofs:=cmdofs[segindex]+segsize[is64bit]+sectsize[is64]*secindex; + fReader.Seek(ofs); + fReader.ReadRaw(buf, segsize[is64bit]); + if is64bit then + fCnv.ConvertSection64( psection_64(@buf)^, machsection) + else + fCnv.ConvertSection( psection(@buf)^, machsection); + end; + + + function TMachoReader.ReadUInt32(var v: LongWord): Boolean; + begin + if not Assigned(fCnv) then + IntReadStruct; + Result:=Assigned(fCnv) and (fReader.ReadRaw(v, sizeof(v))=sizeof(v)); + if Result then + fCnv.ConvertUint32(v); + end; + + + function TMachoReader.ReadData(var data; dataSize: Integer): Integer; + begin + Result:=fReader.ReadRaw(data, dataSize); + end; + + + function TMachoReader.GetNListSize: Integer; + begin + if is64 then + Result:=sizeof(nlist_64) + else + Result:=sizeof(nlist); + end; + + + function TMachoReader.ReadNList(fileofs: qword; var nsym: nlist_64): Boolean; + var + n32 : nlist; + begin + fReader.Seek(fileofs); + if is64 then + Result:=fReader.ReadRaw(nsym, sizeof(nlist_64))=sizeof(nlist_64) + else + begin + Result:=fReader.ReadRaw(n32, sizeof(nlist))=sizeof(nlist); + nsym.n_un.n_strx:=n32.n_un.n_strx; + nsym.n_desc:=n32.n_desc; + nsym.n_sect:=n32.n_sect; + nsym.n_type:=n32.n_type; + nsym.n_value:=n32.n_value; + end; + fCnv.ConvertUInt32(nsym.n_un.n_strx); + fCnv.ConvertUInt16(nsym.n_desc); + fCnv.ConvertUInt64(nsym.n_value); + end; + + + function TMachoReader.ReadSymTabCmd(var symcmd: symtab_command): Boolean; + var + i : Integer; + p : qword; + begin + if not Assigned(fCnv) then + IntReadStruct; + + for i:=0 to length(cmds)-1 do + if cmds[i].cmd=LC_SYMTAB then + begin + p:=fReader.ReadPos; + fReader.Seek(cmdofs[i]); + fReader.ReadRaw(symcmd, sizeof(symcmd)); + fCnv.ConvertUInt32(symcmd.cmd); + fCnv.ConvertUInt32(symcmd.cmdsize); + fCnv.ConvertUInt32(symcmd.symoff); + fCnv.ConvertUInt32(symcmd.nsyms); + fCnv.ConvertUInt32(symcmd.stroff); + fCnv.ConvertUInt32(symcmd.strsize); + fReader.Seek(p); + Result:=true; + Exit; + end; + Result:=false; + end; + + + procedure TMachoReader.Seek(apos: qword); + begin + fReader.Seek(apos); + end; + + + { TLEMachoStructConverter } + + procedure TLEMachoStructConverter.ConvertMachoHeader(const mh: mach_header; var hdr: TMachHeader); + begin + hdr.cputype:=LEToN(mh.cputype); + hdr.cpusubtype:=LEtoN(mh.cpusubtype); + hdr.filetype:=LEToN(mh.filetype); + hdr.ncmds:=LEToN(mh.ncmds); + hdr.sizeofcmds:=LEToN(mh.ncmds); + hdr.flags:=LEToN(mh.flags); + end; + + + procedure TLEMachoStructConverter.ConvertMachoHeader64(const mh: mach_header_64; var hdr: TMachHeader); + begin + hdr.cputype:=LEToN(mh.cputype); + hdr.cpusubtype:=LEtoN(mh.cpusubtype); + hdr.filetype:=LEToN(mh.filetype); + hdr.ncmds:=LEToN(mh.ncmds); + hdr.sizeofcmds:=LEToN(mh.ncmds); + hdr.flags:=LEToN(mh.flags); + end; + + + procedure TLEMachoStructConverter.ConvertLoadCommand(var cmd: load_command); + begin + cmd.cmd:=LEToN(cmd.cmd); + cmd.cmdsize:=LEToN(cmd.cmdsize); + end; + + + procedure TLEMachoStructConverter.ConvertSegment(const segcmd: segment_command; var segment: TMachoSegment); + begin + FillChar(segment, sizeof(segment), 0); + segment.segname:=segcmd.segname; + segment.vmaddr:=LEToN(segcmd.vmaddr); + segment.vmsize:=LEToN(segcmd.vmsize); + segment.fileoff:=LEToN(segcmd.fileoff); + segment.filesize:=LEToN(segcmd.filesize); + segment.maxprot:=LEToN(segcmd.maxprot); + segment.initprot:=LEToN(segcmd.initprot); + writelN('segcmd.nsects = ', segcmd.nsects); + segment.nsects:=LEToN(segcmd.nsects); + segment.flags:=LEToN(segcmd.flags); + //todo: reserved!? + end; + + + procedure TMachoStructConverter.ConvertSegment64(const segcmd: segment_command_64; var segment: TMachoSegment); + begin + FillChar(segment, sizeof(segment), 0); + segment.segname:=segcmd.segname; + segment.vmaddr:=LEToN(segcmd.vmaddr); + segment.vmsize:=LEToN(segcmd.vmsize); + segment.fileoff:=LEToN(segcmd.fileoff); + segment.filesize:=LEToN(segcmd.filesize); + segment.maxprot:=LEToN(segcmd.maxprot); + segment.initprot:=LEToN(segcmd.initprot); + segment.nsects:=LEToN(segcmd.nsects); + segment.flags:=LEToN(segcmd.flags); + //todo: reserved!? + end; + + + procedure TMachoStructConverter.ConvertSection(const sec: section; var section: TMachoSection); + begin + FillChar(section, sizeof(section), 0); + section.sectname:=sec.sectname; + section.segname:=sec.segname; + section.addr:=LEToN(sec.addr); + section.size:=LEToN(sec.size); + section.offset:=LEToN(sec.offset); + section.align:=LEToN(sec.align); + section.reloff:=LEToN(sec.reloff); + section.nreloc:=LEToN(sec.nreloc); + section.flags:=LEToN(sec.flags); + //todo: + //section.indirectIndex : Integer; // reserved1 for LAZY and NON_LAZY pointers + //section.stubSize : Integer; // reserved2 for S_SYMBOL_STUBS + end; + + + procedure TMachoStructConverter.ConvertSection64(const sec: section_64; var section: TMachoSection); + begin + FillChar(section, sizeof(section), 0); + section.sectname:=sec.sectname; + section.segname:=sec.segname; + section.addr:=LEToN(sec.addr); + section.size:=LEToN(sec.size); + section.offset:=LEToN(sec.offset); + section.align:=LEToN(sec.align); + section.reloff:=LEToN(sec.reloff); + section.nreloc:=LEToN(sec.nreloc); + section.flags:=LEToN(sec.flags); + //todo: + //section.indirectIndex : Integer; // reserved1 for LAZY and NON_LAZY pointers + //section.stubSize : Integer; // reserved2 for S_SYMBOL_STUBS + end; + + + procedure TMachoStructConverter.ConvertUInt32(var v: LongWord); + begin + v:=LEtoN(v); + end; + + + procedure TMachoStructConverter.ConvertUInt64(var v: qword); + begin + v:=LEtoN(v); + end; + + + procedure TMachoStructConverter.ConvertUInt16(var v: Word); + begin + v:=LEToN(v); + end; + +end. + diff --git a/closures/compiler/mips/aasmcpu.pas b/closures/compiler/mips/aasmcpu.pas new file mode 100644 index 0000000000..263d2a242b --- /dev/null +++ b/closures/compiler/mips/aasmcpu.pas @@ -0,0 +1,449 @@ +{ + Copyright (c) 1999-2009 by Mazen Neifer and David Zhang + + Contains the assembler object for the MIPSEL + + 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, aasmsym, aasmtai, + cgbase, cgutils, cpubase, cpuinfo; + +const + { "mov reg,reg" source operand number } + O_MOV_SOURCE = 0; + { "mov reg,reg" source operand number } + O_MOV_DEST = 1; + +type + taicpu = class(tai_cpu_abstract_sym) + delayslot_annulled: boolean; { conditinal opcode with ,a } + constructor op_none(op: tasmop); + + constructor op_reg(op: tasmop; _op1: tregister); + constructor op_const(op: tasmop; _op1: longint); + constructor op_ref(op: tasmop; const _op1: treference); + + 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: longint); + + constructor op_reg_reg_reg(op: tasmop; _op1, _op2, _op3: tregister); + + constructor op_reg_reg_ref(op: tasmop; _op1, _op2: tregister; const _op3: treference); + constructor op_reg_reg_const(op: tasmop; _op1, _op2: tregister; _op3: aint); + + { this is for Jmp instructions } + constructor op_sym(op: tasmop; _op1: tasmsymbol); + constructor op_reg_reg_sym(op: tasmop; _op1, _op2: tregister; _op3: tasmsymbol); + constructor op_reg_sym(op: tasmop; _op1: tregister; _op2: tasmsymbol); + constructor op_sym_ofs(op: tasmop; _op1: tasmsymbol; _op1ofs: longint); + + { register allocation } + function is_same_reg_move(regtype: Tregistertype): boolean; override; + + { register spilling code } + function spilling_get_operation_type(opnr: longint): topertype; override; + end; + + tai_align = class(tai_align_abstract) + { nothing to add } + end; + + procedure InitAsm; + procedure DoneAsm; + + function spilling_create_load(const ref: treference; r: tregister): taicpu; + function spilling_create_store(r: tregister; const ref: treference): taicpu; + +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; + loadreg(0, _op1); +end; + + +constructor taicpu.op_ref(op: tasmop; const _op1: treference); +begin + inherited Create(op); + ops := 1; + loadref(0, _op1); +end; + + +constructor taicpu.op_const(op: tasmop; _op1: longint); +begin + inherited Create(op); + ops := 1; + loadconst(0, _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: longint); +begin + inherited Create(op); + ops := 2; + loadreg(0, _op1); + loadconst(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_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_const(op: tasmop; _op1, _op2: tregister; _op3: aint); + begin + inherited create(op); + ops := 3; + loadreg(0, _op1); + loadreg(1, _op2); + loadconst(2, _op3); +end; + + + +constructor taicpu.op_sym(op: tasmop; _op1: tasmsymbol); +begin + inherited Create(op); + is_jmp := op in [A_J, A_BEQI, A_BNEI, A_BLTI, A_BLEI, A_BGTI, A_BGEI, + A_BLTUI, A_BLEUI, A_BGTUI, A_BGEUI, + A_BEQ, A_BNE, A_BLT, A_BLE, A_BGT, A_BGE, + A_BLTU, A_BLEU, A_BGTU, A_BGEU + ]; + + ops := 1; + loadsymbol(0, _op1, 0); +end; + +constructor taicpu.op_reg_reg_sym(op: tasmop; _op1, _op2: tregister; _op3: tasmsymbol); +begin + inherited create(op); + is_jmp := op in [A_J, + A_BEQI, A_BNEI, A_BLTI, A_BLEI, A_BGTI, A_BGEI, A_BLTUI, A_BLEUI, + A_BGTUI, A_BGEUI, + A_BEQ, A_BNE, A_BLT, A_BLE, A_BGT, A_BGE, A_BLTU, A_BLEU, A_BGTU, A_BGEU]; + ops := 3; + loadreg(0, _op1); + loadreg(1, _op2); + loadsymbol(2, _op3, 0); +end; + +constructor taicpu.op_reg_sym(op: tasmop; _op1: tregister; _op2: tasmsymbol); +begin + inherited create(op); + is_jmp := op in [A_J, + A_BEQI, A_BNEI, A_BLTI, A_BLEI, A_BGTI, A_BGEI, A_BLTUI, A_BLEUI, + A_BGTUI, A_BGEUI, + A_BEQ, A_BNE, A_BLT, A_BLE, A_BGT, A_BGE, A_BLTU, A_BLEU, A_BGTU, A_BGEU, A_BGTZ]; + ops := 2; + loadreg(0, _op1); + loadsymbol(1, _op2, 0); +end; + +constructor taicpu.op_sym_ofs(op: tasmop; _op1: tasmsymbol; _op1ofs: longint); +begin + inherited Create(op); + ops := 1; + loadsymbol(0, _op1, _op1ofs); +end; + + +function taicpu.is_same_reg_move(regtype: Tregistertype): boolean; +begin + Result := ( + ((opcode = A_MOVE) and (regtype = R_INTREGISTER)) or + ((regtype = R_FPUREGISTER) and (opcode in [A_MOV_S, A_MOV_D])) + ) and + (oper[0]^.reg = oper[1]^.reg); +end; + + + function taicpu.spilling_get_operation_type(opnr: longint): topertype; + type + op_write_set_type = set of TAsmOp; + const + op_write_set: op_write_set_type = + [A_NEG, + A_NEGU, + A_LI, + A_DLI, + A_LA, + A_MOVE, + A_LB, + A_LBU, + A_LH, + A_LHU, + A_LW, + A_LWU, + A_LWL, + A_LWR, + A_LD, + A_LDL, + A_LDR, + A_LL, + A_LLD, + A_ADDI, + A_DADDI, + A_ADDIU, + A_DADDIU, + A_SLTI, + A_SLTIU, + A_ANDI, + A_ORI, + A_XORI, + A_LUI, + A_DNEG, + A_DNEGU, + A_ADD, + A_DADD, + A_ADDU, + A_DADDU, + A_SUB, + A_DSUB, + A_SUBU, + A_DSUBU, + A_SLT, + A_SLTU, + A_AND, + A_OR, + A_XOR, + A_NOR, + A_MUL, + A_MULO, + A_MULOU, + A_DMUL, + A_DMULO, + A_DMULOU, + A_DIV, + A_DIVU, + A_DDIV, + A_DDIVU, + A_REM, + A_REMU, + A_DREM, + A_DREMU, + A_MULT, + A_DMULT, + A_MULTU, + A_DMULTU, + A_MFHI, + A_MFLO, + A_MULTG, + A_DMULTG, + A_MULTUG, + A_DMULTUG, + A_DIVG, + A_DDIVG, + A_DIVUG, + A_DDIVUG, + A_MODG, + A_DMODG, + A_MODUG, + A_DMODUG, + + A_SLL, + A_SRL, + A_SRA, + A_SLLV, + A_SRLV, + A_SRAV, + A_DSLL, + A_DSRL, + A_DSRA, + A_DSLLV, + A_DSRLV, + A_DSRAV, + A_DSLL32, + A_DSRL32, + A_DSRA32, + A_LWC1, + A_LDC1, + + + A_ADD_S, + A_ADD_D, + A_SUB_S, + A_SUB_D, + A_MUL_S, + A_MUL_D, + A_DIV_S, + A_DIV_D, + A_ABS_S, + A_ABS_D, + A_NEG_S, + A_NEG_D, + A_SQRT_S, + A_SQRT_D, + A_MOV_S, + A_MOV_D, + A_CVT_S_D, + A_CVT_S_W, + A_CVT_S_L, + A_CVT_D_S, + A_CVT_D_W, + A_CVT_D_L, + A_CVT_W_S, + A_CVT_W_D, + A_CVT_L_S, + A_CVT_L_D, + A_ROUND_W_S, + A_ROUND_W_D, + A_ROUND_L_S, + A_ROUND_L_D, + A_TRUNC_W_S, + A_TRUNC_W_D, + A_TRUNC_L_S, + A_TRUNC_L_D, + A_CEIL_W_S, + A_CEIL_W_D, + A_CEIL_L_S, + A_CEIL_L_D, + A_FLOOR_W_S, + A_FLOOR_W_D, + A_FLOOR_L_S, + A_FLOOR_L_D, + A_SEQ, + A_SGE, + A_SGEU, + A_SGT, + A_SGTU, + A_SLE, + A_SLEU, + A_SNE]; + + begin + result := operand_read; + if opcode in op_write_set then + if opnr = 0 then + result := operand_write; + end; + + + function spilling_create_load(const ref: treference; r: tregister): taicpu; + begin + case getregtype(r) of + R_INTREGISTER : + result:=taicpu.op_reg_ref(A_LW,r,ref); + R_FPUREGISTER : + begin + case getsubreg(r) of + R_SUBFS : + result:=taicpu.op_reg_ref(A_LWC1,r,ref); + R_SUBFD : + result:=taicpu.op_reg_ref(A_LDC1,r,ref); + else + internalerror(200401042); + end; + end + else + internalerror(200401041); + end; + end; + + + function spilling_create_store(r: tregister; const ref: treference): taicpu; + begin + case getregtype(r) of + R_INTREGISTER : + result:=taicpu.op_reg_ref(A_SW,r,ref); + R_FPUREGISTER : + begin + case getsubreg(r) of + R_SUBFS : + result:=taicpu.op_reg_ref(A_SWC1,r,ref); + R_SUBFD : + result:=taicpu.op_reg_ref(A_SDC1,r,ref); + else + internalerror(200401042); + end; + end + else + internalerror(200401041); + end; + end; + + +procedure InitAsm; + begin + end; + + +procedure DoneAsm; + begin + end; + + +begin + cai_cpu := taicpu; + cai_align := tai_align; +end. diff --git a/closures/compiler/mips/aoptcpu.pas b/closures/compiler/mips/aoptcpu.pas new file mode 100644 index 0000000000..cb656af36e --- /dev/null +++ b/closures/compiler/mips/aoptcpu.pas @@ -0,0 +1,41 @@ +{ + Copyright (c) 1998-2004 by Jonas Maebe + + This unit calls the optimization procedures to optimize the assembler + code for sparc + + 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, aoptobj, aoptcpub, aopt; + + Type + TCpuAsmOptimizer = class(TAsmOptimizer) + End; + + Implementation + +begin + casmoptimizer:=TCpuAsmOptimizer; +end. diff --git a/closures/compiler/mips/aoptcpub.pas b/closures/compiler/mips/aoptcpub.pas new file mode 100644 index 0000000000..ef5d869669 --- /dev/null +++ b/closures/compiler/mips/aoptcpub.pas @@ -0,0 +1,119 @@ + { + Copyright (c) 1998-2009 by Jonas Maebe and David Zhang + + This unit contains several types and constants necessary for the + optimizer to work on the MIPSEL 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_J; + aopt_condjmp = A_BEQ; + +Implementation + +{ ************************************************************************* } +{ **************************** TCondRegs ********************************** } +{ ************************************************************************* } +Constructor TCondRegs.init; +Begin +End; + +Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl} +Begin +End; + +End. diff --git a/closures/compiler/mips/aoptcpud.pas b/closures/compiler/mips/aoptcpud.pas new file mode 100644 index 0000000000..cb8c5d319f --- /dev/null +++ b/closures/compiler/mips/aoptcpud.pas @@ -0,0 +1,36 @@ +{ + Copyright (c) 1998-2004 by Jonas Maebe, member of the Free Pascal + Development Team + + 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. diff --git a/closures/compiler/mips/cgcpu.pas b/closures/compiler/mips/cgcpu.pas new file mode 100644 index 0000000000..6a88661bf3 --- /dev/null +++ b/closures/compiler/mips/cgcpu.pas @@ -0,0 +1,1980 @@ +{ + Copyright (c) 1998-2009 by Florian Klaempfl and David Zhang + + This unit implements the code generator for the MIPSEL + + 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, parabase, + cgbase, cgutils, cgobj, cg64f32, + aasmbase, aasmtai, aasmcpu, aasmdata, + cpubase, cpuinfo, + node, symconst, SymType, symdef, + rgcpu; + +type + TCgMPSel = class(tcg) + public + procedure init_register_allocators; override; + procedure done_register_allocators; override; + function getfpuregister(list: tasmlist; size: Tcgsize): Tregister; override; +/// { needed by cg64 } + procedure make_simple_ref(list: tasmlist; var ref: treference); + procedure make_simple_ref_fpu(list: tasmlist; var ref: treference); + procedure handle_load_store(list: tasmlist; isstore: boolean; op: tasmop; reg: tregister; ref: treference); + procedure handle_load_store_fpu(list: tasmlist; isstore: boolean; op: tasmop; reg: tregister; ref: treference); + procedure handle_reg_const_reg(list: tasmlist; op: Tasmop; src: tregister; a: tcgint; dst: tregister); + + { parameter } + procedure a_load_const_cgpara(list: tasmlist; size: tcgsize; a: tcgint; const paraloc: TCGPara); override; + procedure a_load_ref_cgpara(list: tasmlist; sz: tcgsize; const r: TReference; const paraloc: TCGPara); override; + procedure a_loadaddr_ref_cgpara(list: tasmlist; const r: TReference; const paraloc: TCGPara); override; + procedure a_loadfpu_reg_cgpara(list: tasmlist; size: tcgsize; const r: tregister; const paraloc: TCGPara); override; + procedure a_loadfpu_ref_cgpara(list: tasmlist; size: tcgsize; const ref: treference; const paraloc: TCGPara); override; + procedure a_call_name(list: tasmlist; const s: string; weak : boolean); override; + procedure a_call_reg(list: tasmlist; Reg: TRegister); override; + { General purpose instructions } + procedure a_op_const_reg(list: tasmlist; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister); override; + procedure a_op_reg_reg(list: tasmlist; Op: TOpCG; size: TCGSize; src, dst: TRegister); override; + procedure a_op_const_reg_reg(list: tasmlist; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister); override; + procedure a_op_reg_reg_reg(list: tasmlist; op: TOpCg; size: tcgsize; src1, src2, dst: tregister); override; + procedure a_op_const_reg_reg_checkoverflow(list: tasmlist; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation); override; + procedure a_op_reg_reg_reg_checkoverflow(list: tasmlist; op: TOpCg; size: tcgsize; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation); override; + { move instructions } + procedure a_load_const_reg(list: tasmlist; size: tcgsize; a: tcgint; reg: tregister); override; + procedure a_load_const_ref(list: tasmlist; size: tcgsize; a: tcgint; const ref: TReference); override; + procedure a_load_reg_ref(list: tasmlist; FromSize, ToSize: TCgSize; reg: TRegister; const ref: TReference); override; + procedure a_load_ref_reg(list: tasmlist; FromSize, ToSize: TCgSize; const ref: TReference; reg: tregister); override; + procedure a_load_reg_reg(list: tasmlist; FromSize, ToSize: TCgSize; reg1, reg2: tregister); override; + procedure a_loadaddr_ref_reg(list: tasmlist; const ref: TReference; r: tregister); override; + { fpu move instructions } + procedure a_loadfpu_reg_reg(list: tasmlist; fromsize, tosize: tcgsize; reg1, reg2: tregister); override; + procedure a_loadfpu_ref_reg(list: tasmlist; fromsize, tosize: tcgsize; const ref: TReference; reg: tregister); override; + procedure a_loadfpu_reg_ref(list: tasmlist; fromsize, tosize: tcgsize; reg: tregister; const ref: TReference); override; + { comparison operations } + procedure a_cmp_const_reg_label(list: tasmlist; size: tcgsize; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel); override; + procedure a_cmp_reg_reg_label(list: tasmlist; size: tcgsize; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel); override; + procedure a_jmp_always(List: tasmlist; l: TAsmLabel); override; + procedure a_jmp_name(list: tasmlist; const s: string); override; + procedure a_jmp_cond(list: tasmlist; cond: TOpCmp; l: tasmlabel); { override;} + procedure g_overflowCheck(List: tasmlist; const Loc: TLocation; def: TDef); override; + procedure g_overflowCheck_loc(List: tasmlist; const Loc: TLocation; def: TDef; ovloc: tlocation); override; + procedure g_proc_entry(list: tasmlist; localsize: longint; nostackframe: boolean); override; + procedure g_proc_exit(list: tasmlist; parasize: longint; nostackframe: boolean); override; + procedure g_concatcopy(list: tasmlist; const Source, dest: treference; len: tcgint); override; + procedure g_concatcopy_unaligned(list: tasmlist; const Source, dest: treference; len: tcgint); override; + procedure g_concatcopy_move(list: tasmlist; const Source, dest: treference; len: tcgint); + procedure g_intf_wrapper(list: tasmlist; procdef: tprocdef; const labelname: string; ioffset: longint); override; + { Transform unsupported methods into Internal errors } + procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override; + procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override; + end; + + TCg64MPSel = class(tcg64f32) + public + procedure a_load64_reg_ref(list: tasmlist; reg: tregister64; const ref: treference); override; + procedure a_load64_ref_reg(list: tasmlist; const ref: treference; reg: tregister64); override; + procedure a_load64_ref_cgpara(list: tasmlist; const r: treference; const paraloc: tcgpara); override; + procedure a_op64_reg_reg(list: tasmlist; op: TOpCG; size: tcgsize; regsrc, regdst: TRegister64); override; + procedure a_op64_const_reg(list: tasmlist; op: TOpCG; size: tcgsize; Value: int64; regdst: TRegister64); override; + procedure a_op64_const_reg_reg(list: tasmlist; op: TOpCG; size: tcgsize; Value: int64; regsrc, regdst: tregister64); override; + procedure a_op64_reg_reg_reg(list: tasmlist; op: TOpCG; size: tcgsize; regsrc1, regsrc2, regdst: tregister64); override; + procedure a_op64_const_reg_reg_checkoverflow(list: tasmlist; op: TOpCG; size: tcgsize; Value: int64; regsrc, regdst: tregister64; setflags: boolean; var ovloc: tlocation); override; + procedure a_op64_reg_reg_reg_checkoverflow(list: tasmlist; op: TOpCG; size: tcgsize; regsrc1, regsrc2, regdst: tregister64; setflags: boolean; var ovloc: tlocation); override; + end; + + procedure create_codegen; + +implementation + +uses + globals, verbose, systems, cutils, + paramgr, fmodule, + tgobj, + procinfo, cpupi; + +var + cgcpu_calc_stackframe_size: aint; + + + function f_TOpCG2AsmOp(op: TOpCG; size: tcgsize): TAsmOp; + begin + if size = OS_32 then + case op of + OP_ADD: { simple addition } + f_TOpCG2AsmOp := A_ADDU; + OP_AND: { simple logical and } + f_TOpCG2AsmOp := A_AND; + OP_DIV: { simple unsigned division } + f_TOpCG2AsmOp := A_DIVU; + OP_IDIV: { simple signed division } + f_TOpCG2AsmOp := A_DIV; + OP_IMUL: { simple signed multiply } + f_TOpCG2AsmOp := A_MULT; + OP_MUL: { simple unsigned multiply } + f_TOpCG2AsmOp := A_MULTU; + OP_NEG: { simple negate } + f_TOpCG2AsmOp := A_NEGU; + OP_NOT: { simple logical not } + f_TOpCG2AsmOp := A_NOT; + OP_OR: { simple logical or } + f_TOpCG2AsmOp := A_OR; + OP_SAR: { arithmetic shift-right } + f_TOpCG2AsmOp := A_SRA; + OP_SHL: { logical shift left } + f_TOpCG2AsmOp := A_SLL; + OP_SHR: { logical shift right } + f_TOpCG2AsmOp := A_SRL; + OP_SUB: { simple subtraction } + f_TOpCG2AsmOp := A_SUBU; + OP_XOR: { simple exclusive or } + f_TOpCG2AsmOp := A_XOR; + else + InternalError(2007070401); + end{ case } + else + case op of + OP_ADD: { simple addition } + f_TOpCG2AsmOp := A_ADDU; + OP_AND: { simple logical and } + f_TOpCG2AsmOp := A_AND; + OP_DIV: { simple unsigned division } + f_TOpCG2AsmOp := A_DIVU; + OP_IDIV: { simple signed division } + f_TOpCG2AsmOp := A_DIV; + OP_IMUL: { simple signed multiply } + f_TOpCG2AsmOp := A_MULT; + OP_MUL: { simple unsigned multiply } + f_TOpCG2AsmOp := A_MULTU; + OP_NEG: { simple negate } + f_TOpCG2AsmOp := A_NEGU; + OP_NOT: { simple logical not } + f_TOpCG2AsmOp := A_NOT; + OP_OR: { simple logical or } + f_TOpCG2AsmOp := A_OR; + OP_SAR: { arithmetic shift-right } + f_TOpCG2AsmOp := A_SRA; + OP_SHL: { logical shift left } + f_TOpCG2AsmOp := A_SLL; + OP_SHR: { logical shift right } + f_TOpCG2AsmOp := A_SRL; + OP_SUB: { simple subtraction } + f_TOpCG2AsmOp := A_SUBU; + OP_XOR: { simple exclusive or } + f_TOpCG2AsmOp := A_XOR; + else + InternalError(2007010701); + end;{ case } + end; + + function f_TOpCG2AsmOp_ovf(op: TOpCG; size: tcgsize): TAsmOp; + begin + if size = OS_32 then + case op of + OP_ADD: { simple addition } + f_TOpCG2AsmOp_ovf := A_ADD; + OP_AND: { simple logical and } + f_TOpCG2AsmOp_ovf := A_AND; + OP_DIV: { simple unsigned division } + f_TOpCG2AsmOp_ovf := A_DIVU; + OP_IDIV: { simple signed division } + f_TOpCG2AsmOp_ovf := A_DIV; + OP_IMUL: { simple signed multiply } + f_TOpCG2AsmOp_ovf := A_MULO; + OP_MUL: { simple unsigned multiply } + f_TOpCG2AsmOp_ovf := A_MULOU; + OP_NEG: { simple negate } + f_TOpCG2AsmOp_ovf := A_NEG; + OP_NOT: { simple logical not } + f_TOpCG2AsmOp_ovf := A_NOT; + OP_OR: { simple logical or } + f_TOpCG2AsmOp_ovf := A_OR; + OP_SAR: { arithmetic shift-right } + f_TOpCG2AsmOp_ovf := A_SRA; + OP_SHL: { logical shift left } + f_TOpCG2AsmOp_ovf := A_SLL; + OP_SHR: { logical shift right } + f_TOpCG2AsmOp_ovf := A_SRL; + OP_SUB: { simple subtraction } + f_TOpCG2AsmOp_ovf := A_SUB; + OP_XOR: { simple exclusive or } + f_TOpCG2AsmOp_ovf := A_XOR; + else + InternalError(2007070403); + end{ case } + else + case op of + OP_ADD: { simple addition } + f_TOpCG2AsmOp_ovf := A_ADD; + OP_AND: { simple logical and } + f_TOpCG2AsmOp_ovf := A_AND; + OP_DIV: { simple unsigned division } + f_TOpCG2AsmOp_ovf := A_DIVU; + OP_IDIV: { simple signed division } + f_TOpCG2AsmOp_ovf := A_DIV; + OP_IMUL: { simple signed multiply } + f_TOpCG2AsmOp_ovf := A_MULO; + OP_MUL: { simple unsigned multiply } + f_TOpCG2AsmOp_ovf := A_MULOU; + OP_NEG: { simple negate } + f_TOpCG2AsmOp_ovf := A_NEG; + OP_NOT: { simple logical not } + f_TOpCG2AsmOp_ovf := A_NOT; + OP_OR: { simple logical or } + f_TOpCG2AsmOp_ovf := A_OR; + OP_SAR: { arithmetic shift-right } + f_TOpCG2AsmOp_ovf := A_SRA; + OP_SHL: { logical shift left } + f_TOpCG2AsmOp_ovf := A_SLL; + OP_SHR: { logical shift right } + f_TOpCG2AsmOp_ovf := A_SRL; + OP_SUB: { simple subtraction } + f_TOpCG2AsmOp_ovf := A_SUB; + OP_XOR: { simple exclusive or } + f_TOpCG2AsmOp_ovf := A_XOR; + else + InternalError(2007010703); + end;{ case } + end; + + function f_TOp64CG2AsmOp(op: TOpCG): TAsmOp; + begin + case op of + OP_ADD: { simple addition } + f_TOp64CG2AsmOp := A_DADDU; + OP_AND: { simple logical and } + f_TOp64CG2AsmOp := A_AND; + OP_DIV: { simple unsigned division } + f_TOp64CG2AsmOp := A_DDIVU; + OP_IDIV: { simple signed division } + f_TOp64CG2AsmOp := A_DDIV; + OP_IMUL: { simple signed multiply } + f_TOp64CG2AsmOp := A_DMULO; + OP_MUL: { simple unsigned multiply } + f_TOp64CG2AsmOp := A_DMULOU; + OP_NEG: { simple negate } + f_TOp64CG2AsmOp := A_DNEGU; + OP_NOT: { simple logical not } + f_TOp64CG2AsmOp := A_NOT; + OP_OR: { simple logical or } + f_TOp64CG2AsmOp := A_OR; + OP_SAR: { arithmetic shift-right } + f_TOp64CG2AsmOp := A_DSRA; + OP_SHL: { logical shift left } + f_TOp64CG2AsmOp := A_DSLL; + OP_SHR: { logical shift right } + f_TOp64CG2AsmOp := A_DSRL; + OP_SUB: { simple subtraction } + f_TOp64CG2AsmOp := A_DSUBU; + OP_XOR: { simple exclusive or } + f_TOp64CG2AsmOp := A_XOR; + else + InternalError(2007010702); + end;{ case } + end; + + + +procedure TCgMPSel.make_simple_ref(list: tasmlist; var ref: treference); +var + tmpreg, tmpreg1: tregister; + tmpref: treference; +begin + tmpreg := NR_NO; + { Be sure to have a base register } + if (ref.base = NR_NO) then + begin + ref.base := ref.index; + ref.index := NR_NO; + end; + if (cs_create_pic in current_settings.moduleswitches) and + assigned(ref.symbol) then + begin + tmpreg := GetIntRegister(list, OS_INT); + reference_reset(tmpref,sizeof(aint)); + tmpref.symbol := ref.symbol; + tmpref.refaddr := addr_pic; + if not (pi_needs_got in current_procinfo.flags) then + internalerror(200501161); + tmpref.index := current_procinfo.got; + list.concat(taicpu.op_reg_ref(A_LW, tmpreg, tmpref)); + ref.symbol := nil; + if (ref.index <> NR_NO) then + begin + list.concat(taicpu.op_reg_reg_reg(A_ADDU, tmpreg, ref.index, tmpreg)); + ref.index := tmpreg; + end + else + begin + if ref.base <> NR_NO then + ref.index := tmpreg + else + ref.base := tmpreg; + end; + end; + { When need to use LUI, do it first } + if assigned(ref.symbol) or + (ref.offset < simm16lo) or + (ref.offset > simm16hi) then + begin + tmpreg := GetIntRegister(list, OS_INT); + reference_reset(tmpref,sizeof(aint)); + tmpref.symbol := ref.symbol; + tmpref.offset := ref.offset; + tmpref.refaddr := addr_high; + list.concat(taicpu.op_reg_ref(A_LUI, tmpreg, tmpref)); + if (ref.offset = 0) and (ref.index = NR_NO) and + (ref.base = NR_NO) then + begin + ref.refaddr := addr_low; + end + else + begin + { Load the low part is left } + tmpref.refaddr := addr_low; + list.concat(taicpu.op_reg_reg_ref(A_ADDIU, tmpreg, tmpreg, tmpref)); + ref.offset := 0; + { symbol is loaded } + ref.symbol := nil; + end; + if (ref.index <> NR_NO) then + begin + list.concat(taicpu.op_reg_reg_reg(A_ADDU, tmpreg, ref.index, tmpreg)); + ref.index := tmpreg; + end + else + begin + if ref.base <> NR_NO then + ref.index := tmpreg + else + ref.base := tmpreg; + end; + end; + if (ref.base <> NR_NO) then + begin + if (ref.index <> NR_NO) and (ref.offset = 0) then + begin + tmpreg1 := GetIntRegister(list, OS_INT); + list.concat(taicpu.op_reg_reg_reg(A_ADDU, tmpreg1, ref.base, ref.index)); + ref.base := tmpreg1; + ref.index := NR_NO; + end + else if (ref.index <> NR_NO) and + ((ref.offset <> 0) or assigned(ref.symbol)) then + begin + if tmpreg = NR_NO then + tmpreg := GetIntRegister(list, OS_INT); + list.concat(taicpu.op_reg_reg_reg(A_ADDU, tmpreg, ref.base, ref.index)); + ref.base := tmpreg; + ref.index := NR_NO; + end; + end; +end; + +procedure TCgMPSel.make_simple_ref_fpu(list: tasmlist; var ref: treference); +var + tmpreg, tmpreg1: tregister; + tmpref: treference; +begin + tmpreg := NR_NO; + { Be sure to have a base register } + if (ref.base = NR_NO) then + begin + ref.base := ref.index; + ref.index := NR_NO; + end; + if (cs_create_pic in current_settings.moduleswitches) and + assigned(ref.symbol) then + begin + tmpreg := GetIntRegister(list, OS_INT); + reference_reset(tmpref,sizeof(aint)); + tmpref.symbol := ref.symbol; + tmpref.refaddr := addr_pic; + if not (pi_needs_got in current_procinfo.flags) then + internalerror(200501161); + tmpref.index := current_procinfo.got; + list.concat(taicpu.op_reg_ref(A_LW, tmpreg, tmpref)); + ref.symbol := nil; + if (ref.index <> NR_NO) then + begin + list.concat(taicpu.op_reg_reg_reg(A_ADDU, tmpreg, ref.index, tmpreg)); + ref.index := tmpreg; + end + else + begin + if ref.base <> NR_NO then + ref.index := tmpreg + else + ref.base := tmpreg; + end; + end; + { When need to use LUI, do it first } + if (not assigned(ref.symbol)) and (ref.index = NR_NO) and + (ref.offset > simm16lo + 1000) and (ref.offset < simm16hi - 1000) + then + exit; + + tmpreg1 := GetIntRegister(list, OS_INT); + if assigned(ref.symbol) then + begin + reference_reset(tmpref,sizeof(aint)); + tmpref.symbol := ref.symbol; + tmpref.offset := ref.offset; + tmpref.refaddr := addr_high; + list.concat(taicpu.op_reg_ref(A_LUI, tmpreg1, tmpref)); + { Load the low part } + + tmpref.refaddr := addr_low; + list.concat(taicpu.op_reg_reg_ref(A_ADDIU, tmpreg1, tmpreg1, tmpref)); + { symbol is loaded } + ref.symbol := nil; + end + else + list.concat(taicpu.op_reg_const(A_LI, tmpreg1, ref.offset)); + + if (ref.index <> NR_NO) then + begin + list.concat(taicpu.op_reg_reg_reg(A_ADDU, tmpreg1, ref.index, tmpreg1)); + ref.index := NR_NO + end; + if ref.base <> NR_NO then + list.concat(taicpu.op_reg_reg_reg(A_ADDU, tmpreg1, ref.base, tmpreg1)); + ref.base := tmpreg1; + ref.offset := 0; +end; + +procedure TCgMPSel.handle_load_store(list: tasmlist; isstore: boolean; op: tasmop; reg: tregister; ref: treference); +begin + make_simple_ref(list, ref); + list.concat(taicpu.op_reg_ref(op, reg, ref)); +end; + +procedure TCgMPSel.handle_load_store_fpu(list: tasmlist; isstore: boolean; op: tasmop; reg: tregister; ref: treference); +begin + make_simple_ref_fpu(list, ref); + list.concat(taicpu.op_reg_ref(op, reg, ref)); +end; + + +procedure TCgMPSel.handle_reg_const_reg(list: tasmlist; op: Tasmop; src: tregister; a: tcgint; dst: tregister); +var + tmpreg: tregister; +begin + if (a < simm16lo) or + (a > simm16hi) then + begin + tmpreg := GetIntRegister(list, OS_INT); + a_load_const_reg(list, OS_INT, a, tmpreg); + list.concat(taicpu.op_reg_reg_reg(op, dst, src, tmpreg)); + end + else + list.concat(taicpu.op_reg_reg_const(op, dst, src, a)); +end; + + +{**************************************************************************** + Assembler code +****************************************************************************} + +procedure TCgMPSel.init_register_allocators; +begin + inherited init_register_allocators; + + if (cs_create_pic in current_settings.moduleswitches) and + (pi_needs_got in current_procinfo.flags) then + begin + current_procinfo.got := NR_GP; + rg[R_INTREGISTER] := Trgcpu.Create(R_INTREGISTER, R_SUBD, + [RS_R4, RS_R5, RS_R6, RS_R7, RS_R8, RS_R9, RS_R10, RS_R11, + RS_R12, RS_R13, RS_R14 {, RS_R15 for tmp_const in ncpuadd.pas} {, RS_R24, RS_R25}], + first_int_imreg, []); + end + else + rg[R_INTREGISTER] := Trgcpu.Create(R_INTREGISTER, R_SUBD, + [RS_R4, RS_R5, RS_R6, RS_R7, RS_R8, RS_R9, RS_R10, RS_R11, + RS_R12, RS_R13, RS_R14 {, RS_R15 for tmp_const in ncpuadd.pas} {, RS_R24=VMT, RS_R25=PIC jump}], + first_int_imreg, []); + + rg[R_FPUREGISTER] := trgcpu.Create(R_FPUREGISTER, R_SUBFS{R_SUBFD}, + [RS_F0, RS_F2, RS_F4, RS_F6, + RS_F8, RS_F10, RS_F12, RS_F14, + RS_F16, RS_F18, RS_F20, RS_F22, + RS_F24, RS_F26, RS_F28, RS_F30], + first_fpu_imreg, []); +end; + + + +procedure TCgMPSel.done_register_allocators; +begin + rg[R_INTREGISTER].Free; + rg[R_FPUREGISTER].Free; + inherited done_register_allocators; +end; + + +function TCgMPSel.getfpuregister(list: tasmlist; size: Tcgsize): Tregister; +begin + if size = OS_F64 then + Result := rg[R_FPUREGISTER].getregister(list, R_SUBFD) + else + Result := rg[R_FPUREGISTER].getregister(list, R_SUBFS); +end; + + +procedure TCgMPSel.a_load_const_cgpara(list: tasmlist; size: tcgsize; a: tcgint; const paraloc: TCGPara); +var + Ref: TReference; +begin + paraloc.check_simple_location; + paramanager.allocparaloc(list,paraloc.location); + case paraloc.location^.loc of + LOC_REGISTER, LOC_CREGISTER: + a_load_const_reg(list, size, a, paraloc.location^.Register); + LOC_REFERENCE: + begin + with paraloc.location^.Reference do + begin + if (Index = NR_SP) and (Offset < Target_info.first_parm_offset) then + InternalError(2002081104); + reference_reset_base(ref, index, offset, sizeof(aint)); + end; + a_load_const_ref(list, size, a, ref); + end; + else + InternalError(2002122200); + end; +end; + + +procedure TCgMPSel.a_load_ref_cgpara(list: tasmlist; sz: TCgSize; const r: TReference; const paraloc: TCGPara); +var + ref: treference; + tmpreg: TRegister; +begin + paraloc.check_simple_location; + paramanager.allocparaloc(list,paraloc.location); + with paraloc.location^ do + begin + case loc of + LOC_REGISTER, LOC_CREGISTER: + a_load_ref_reg(list, sz, sz, r, Register); + LOC_REFERENCE: + begin + with Reference do + begin + if (Index = NR_SP) and (Offset < Target_info.first_parm_offset) then + InternalError(2002081104); + reference_reset_base(ref, index, offset, sizeof(aint)); + end; + tmpreg := GetIntRegister(list, OS_INT); + a_load_ref_reg(list, sz, sz, r, tmpreg); + a_load_reg_ref(list, sz, sz, tmpreg, ref); + end; + else + internalerror(2002081103); + end; + end; +end; + + +procedure TCgMPSel.a_loadaddr_ref_cgpara(list: tasmlist; const r: TReference; const paraloc: TCGPara); +var + Ref: TReference; + TmpReg: TRegister; +begin + paraloc.check_simple_location; + paramanager.allocparaloc(list,paraloc.location); + with paraloc.location^ do + begin + case loc of + LOC_REGISTER, LOC_CREGISTER: + a_loadaddr_ref_reg(list, r, Register); + LOC_REFERENCE: + begin + reference_reset(ref,sizeof(aint)); + ref.base := reference.index; + ref.offset := reference.offset; + tmpreg := GetAddressRegister(list); + a_loadaddr_ref_reg(list, r, tmpreg); + a_load_reg_ref(list, OS_ADDR, OS_ADDR, tmpreg, ref); + end; + else + internalerror(2002080701); + end; + end; +end; + + +procedure TCgMPSel.a_loadfpu_ref_cgpara(list: tasmlist; 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 + paramanager.allocparaloc(list,hloc); + case hloc^.loc of + 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, sizeof(aint)); + 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 TCgMPSel.a_loadfpu_reg_cgpara(list: tasmlist; size: tcgsize; const r: tregister; const paraloc: TCGPara); +var + href: treference; +begin + tg.GetTemp(list, TCGSize2Size[size], sizeof(aint), tt_normal, href); + a_loadfpu_reg_ref(list, size, size, r, href); + a_loadfpu_ref_cgpara(list, size, href, paraloc); + tg.Ungettemp(list, href); +end; + + +procedure TCgMPSel.a_call_name(list: tasmlist; const s: string; weak: boolean); +begin + list.concat(taicpu.op_sym(A_JAL,current_asmdata.RefAsmSymbol(s))); + { Delay slot } + list.concat(taicpu.op_none(A_NOP)); +end; + + +procedure TCgMPSel.a_call_reg(list: tasmlist; Reg: TRegister); +begin + list.concat(taicpu.op_reg(A_JALR, reg)); + { Delay slot } + list.concat(taicpu.op_none(A_NOP)); +end; + + +{********************** load instructions ********************} + +procedure TCgMPSel.a_load_const_reg(list: tasmlist; size: TCGSize; a: tcgint; reg: TRegister); +begin + if (a = 0) then + list.concat(taicpu.op_reg_reg(A_MOVE, reg, NR_R0)) + { LUI allows to set the upper 16 bits, so we'll take full advantage of it } + else if (a and aint($ffff)) = 0 then + list.concat(taicpu.op_reg_const(A_LUI, reg, a shr 16)) + else if (a >= simm16lo) and (a <= simm16hi) then + list.concat(taicpu.op_reg_reg_const(A_ADDIU, reg, NR_R0, a)) + else if (a>=0) and (a <= 65535) then + list.concat(taicpu.op_reg_reg_const(A_ORI, reg, NR_R0, a)) + else + begin + list.concat(taicpu.op_reg_const(A_LI, reg, a )); + end; +end; + + +procedure TCgMPSel.a_load_const_ref(list: tasmlist; size: tcgsize; a: tcgint; const ref: TReference); +begin + if a = 0 then + a_load_reg_ref(list, size, size, NR_R0, ref) + else + inherited a_load_const_ref(list, size, a, ref); +end; + + +procedure TCgMPSel.a_load_reg_ref(list: tasmlist; FromSize, ToSize: TCGSize; reg: tregister; const Ref: TReference); +var + op: tasmop; +begin + + if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then + fromsize := tosize; + case fromsize of + { signed integer registers } + OS_8, + OS_S8: + Op := A_SB; + OS_16, + OS_S16: + Op := A_SH; + OS_32, + OS_S32: + Op := A_SW; + else + InternalError(2002122100); + end; + handle_load_store(list, True, op, reg, ref); +end; + + +procedure TCgMPSel.a_load_ref_reg(list: tasmlist; FromSize, ToSize: TCgSize; const ref: TReference; reg: tregister); +var + op: tasmop; +begin + if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then + fromsize := tosize; + case fromsize of + OS_S8: + Op := A_LB;{Load Signed Byte} + OS_8: + Op := A_LBU;{Load Unsigned Byte} + OS_S16: + Op := A_LH;{Load Signed Halfword} + OS_16: + Op := A_LHU;{Load Unsigned Halfword} + OS_S32: + Op := A_LW;{Load Word} + OS_32: + Op := A_LW;//A_LWU;{Load Unsigned Word} + OS_S64, + OS_64: + Op := A_LD;{Load a Long Word} + else + InternalError(2002122101); + end; + handle_load_store(list, False, op, reg, ref); +end; + + +procedure TCgMPSel.a_load_reg_reg(list: tasmlist; fromsize, tosize: tcgsize; reg1, reg2: tregister); +var + instr: taicpu; +begin + 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: + a_op_const_reg_reg(list, OP_AND, tosize, $ff, reg1, reg2); + OS_16: + a_op_const_reg_reg(list, OP_AND, tosize, $ffff, reg1, reg2); + OS_32, + OS_S32: + begin + instr := taicpu.op_reg_reg(A_MOVE, 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; + OS_S8: + begin + list.concat(taicpu.op_reg_reg_const(A_SLL, reg2, reg1, 24)); + list.concat(taicpu.op_reg_reg_const(A_SRA, reg2, reg2, 24)); + end; + OS_S16: + begin + list.concat(taicpu.op_reg_reg_const(A_SLL, reg2, reg1, 16)); + list.concat(taicpu.op_reg_reg_const(A_SRA, reg2, reg2, 16)); + 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_MOVE, 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 TCgMPSel.a_loadaddr_ref_reg(list: tasmlist; const ref: TReference; r: tregister); +var + tmpref, href: treference; + hreg, tmpreg: tregister; + r_used: boolean; +begin + r_used := false; + href := ref; + if (href.base = NR_NO) and (href.index <> NR_NO) then + internalerror(200306171); + + if (cs_create_pic in current_settings.moduleswitches) and + assigned(href.symbol) then + begin + tmpreg := r; //GetIntRegister(list, OS_ADDR); + r_used := true; + reference_reset(tmpref,sizeof(aint)); + tmpref.symbol := href.symbol; + tmpref.refaddr := addr_pic; + if not (pi_needs_got in current_procinfo.flags) then + internalerror(200501161); + tmpref.base := current_procinfo.got; + list.concat(taicpu.op_reg_ref(A_LW, tmpreg, tmpref)); + href.symbol := nil; + if (href.index <> NR_NO) then + begin + list.concat(taicpu.op_reg_reg_reg(A_ADDU, tmpreg, href.index, tmpreg)); + href.index := tmpreg; + end + else + begin + if href.base <> NR_NO then + href.index := tmpreg + else + href.base := tmpreg; + end; + end; + + + if assigned(href.symbol) or + (href.offset < simm16lo) or + (href.offset > simm16hi) then + begin + if (href.base = NR_NO) and (href.index = NR_NO) then + hreg := r + else + hreg := GetAddressRegister(list); + reference_reset(tmpref,sizeof(aint)); + tmpref.symbol := href.symbol; + tmpref.offset := href.offset; + tmpref.refaddr := addr_high; + list.concat(taicpu.op_reg_ref(A_LUI, hreg, tmpref)); + { Only the low part is left } + tmpref.refaddr := addr_low; + list.concat(taicpu.op_reg_reg_ref(A_ADDIU, hreg, hreg, tmpref)); + if href.base <> NR_NO then + begin + if href.index <> NR_NO then + begin + list.concat(taicpu.op_reg_reg_reg(A_ADDU, hreg, href.base, hreg)); + list.concat(taicpu.op_reg_reg_reg(A_ADDU, r, hreg, href.index)); + end + else + list.concat(taicpu.op_reg_reg_reg(A_ADDU, r, hreg, href.base)); + end; + end + else + { At least small offset, maybe base and maybe index } + if (href.offset >= simm16lo) and + (href.offset <= simm16hi) then + begin + if href.index <> NR_NO then { Both base and index } + begin + if href.offset = 0 then + begin + list.concat(taicpu.op_reg_reg_reg(A_ADDU, r, href.base, href.index)); + end + else + begin + if r_used then + hreg := GetAddressRegister(list) + else + hreg := r; + list.concat(taicpu.op_reg_reg_const(A_ADDIU, hreg, href.base, href.offset)); + list.concat(taicpu.op_reg_reg_reg(A_ADDU, r, hreg, href.index)); + end + end + else if href.base <> NR_NO then { Only base } + begin + list.concat(taicpu.op_reg_reg_const(A_ADDIU, r, href.base, href.offset)); + end + else + { only offset, can be generated by absolute } + a_load_const_reg(list, OS_ADDR, href.offset, r); + end + else + internalerror(200703111); +end; + +procedure TCgMPSel.a_loadfpu_reg_reg(list: tasmlist; fromsize, tosize: tcgsize; reg1, reg2: tregister); +const + FpuMovInstr: array[OS_F32..OS_F64] of TAsmOp = + (A_MOV_S, A_MOV_D); +var + instr: taicpu; +begin + if reg1 <> reg2 then + begin + instr := taicpu.op_reg_reg(fpumovinstr[tosize], 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; + + +procedure TCgMPSel.a_loadfpu_ref_reg(list: tasmlist; fromsize, tosize: tcgsize; const ref: TReference; reg: tregister); +var + tmpref: treference; + tmpreg: tregister; +begin + case tosize of + OS_F32: + handle_load_store_fpu(list, False, A_LWC1, reg, ref); + OS_F64: + handle_load_store_fpu(list, False, A_LDC1, reg, ref); + else + InternalError(2007042701); + end; +end; + +procedure TCgMPSel.a_loadfpu_reg_ref(list: tasmlist; fromsize, tosize: tcgsize; reg: tregister; const ref: TReference); +var + tmpref: treference; + tmpreg: tregister; +begin + case tosize of + OS_F32: + handle_load_store_fpu(list, True, A_SWC1, reg, ref); + OS_F64: + handle_load_store_fpu(list, True, A_SDC1, reg, ref); + else + InternalError(2007042702); + end; +end; + +procedure TCgMPSel.a_op_const_reg(list: tasmlist; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister); +var + power: longint; + tmpreg1: tregister; +begin + if ((op = OP_MUL) or (op = OP_IMUL)) then + begin + if ispowerof2(a, power) then + begin + { can be done with a shift } + if power < 32 then + begin + list.concat(taicpu.op_reg_reg_const(A_SLL, reg, reg, power)); + exit; + end; + end; + end; + if ((op = OP_SUB) or (op = OP_ADD)) then + begin + if (a = 0) then + exit; + end; + + if Op in [OP_NEG, OP_NOT] then + internalerror(200306011); + if (a = 0) then + begin + if (Op = OP_IMUL) or (Op = OP_MUL) then + list.concat(taicpu.op_reg_reg(A_MOVE, reg, NR_R0)) + else + list.concat(taicpu.op_reg_reg_reg(f_TOpCG2AsmOp(op, size), reg, reg, NR_R0)) + end + else + begin + if op = OP_IMUL then + begin + tmpreg1 := GetIntRegister(list, OS_INT); + a_load_const_reg(list, OS_INT, a, tmpreg1); + list.concat(taicpu.op_reg_reg(A_MULT, reg, tmpreg1)); + list.concat(taicpu.op_reg(A_MFLO, reg)); + end + else if op = OP_MUL then + begin + tmpreg1 := GetIntRegister(list, OS_INT); + a_load_const_reg(list, OS_INT, a, tmpreg1); + list.concat(taicpu.op_reg_reg(A_MULTU, reg, tmpreg1)); + list.concat(taicpu.op_reg(A_MFLO, reg)); + end + else + handle_reg_const_reg(list, f_TOpCG2AsmOp(op, size), reg, a, reg); + end; +end; + + +procedure TCgMPSel.a_op_reg_reg(list: tasmlist; Op: TOpCG; size: TCGSize; src, dst: TRegister); +var + a: aint; +begin + case Op of + OP_NEG: + list.concat(taicpu.op_reg_reg(A_NEG, dst, src)); + OP_NOT: + begin + list.concat(taicpu.op_reg_reg(A_NOT, dst, src)); + end; + else + begin + if op = OP_IMUL then + begin + list.concat(taicpu.op_reg_reg(A_MULT, dst, src)); + list.concat(taicpu.op_reg(A_MFLO, dst)); + end + else if op = OP_MUL then + begin + list.concat(taicpu.op_reg_reg(A_MULTU, dst, src)); + list.concat(taicpu.op_reg(A_MFLO, dst)); + end + else + begin + list.concat(taicpu.op_reg_reg_reg(f_TOpCG2AsmOp(op, size), dst, dst, src)); + end; + end; + end; +end; + + +procedure TCgMPSel.a_op_const_reg_reg(list: tasmlist; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister); +var + power: longint; + tmpreg1: tregister; +begin + case op of + OP_MUL, + OP_IMUL: + begin + if ispowerof2(a, power) then + begin + { can be done with a shift } + if power < 32 then + list.concat(taicpu.op_reg_reg_const(A_SLL, dst, src, power)) + else + inherited a_op_const_reg_reg(list, op, size, a, src, dst); + exit; + end; + end; + OP_SUB, + OP_ADD: + begin + if (a = 0) then + begin + a_load_reg_reg(list, size, size, src, dst); + exit; + end; + end; + end; + if op = OP_IMUL then + begin + tmpreg1 := GetIntRegister(list, OS_INT); + a_load_const_reg(list, OS_INT, a, tmpreg1); + list.concat(taicpu.op_reg_reg(A_MULT, src, tmpreg1)); + list.concat(taicpu.op_reg(A_MFLO, dst)); + end + else if op = OP_MUL then + begin + tmpreg1 := GetIntRegister(list, OS_INT); + a_load_const_reg(list, OS_INT, a, tmpreg1); + list.concat(taicpu.op_reg_reg(A_MULTU, src, tmpreg1)); + list.concat(taicpu.op_reg(A_MFLO, dst)); + end + else + handle_reg_const_reg(list, f_TOpCG2AsmOp(op, size), src, a, dst); +end; + + +procedure TCgMPSel.a_op_reg_reg_reg(list: tasmlist; op: TOpCg; size: tcgsize; src1, src2, dst: tregister); +begin + + list.concat(taicpu.op_reg_reg_reg(f_TOpCG2AsmOp(op, size), dst, src2, src1)); +end; + + +procedure TCgMPSel.a_op_const_reg_reg_checkoverflow(list: tasmlist; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister; setflags: boolean; var ovloc: tlocation); +var + tmpreg1: tregister; +begin + ovloc.loc := LOC_VOID; + case op of + OP_SUB, + OP_ADD: + begin + if (a = 0) then + begin + a_load_reg_reg(list, size, size, src, dst); + exit; + end; + end; + end;{case} + + case op of + OP_ADD: + begin + if setflags then + handle_reg_const_reg(list, f_TOpCG2AsmOp_ovf(op, size), src, a, dst) + else + handle_reg_const_reg(list, f_TOpCG2AsmOp(op, size), src, a, dst); + end; + OP_SUB: + begin + if setflags then + handle_reg_const_reg(list, f_TOpCG2AsmOp_ovf(op, size), src, a, dst) + else + handle_reg_const_reg(list, f_TOpCG2AsmOp(op, size), src, a, dst); + end; + OP_MUL: + begin + if setflags then + handle_reg_const_reg(list, f_TOpCG2AsmOp_ovf(op, size), src, a, dst) + else + begin + tmpreg1 := GetIntRegister(list, OS_INT); + a_load_const_reg(list, OS_INT, a, tmpreg1); + list.concat(taicpu.op_reg_reg(f_TOpCG2AsmOp(op, size),src, tmpreg1)); + list.concat(taicpu.op_reg(A_MFLO, dst)); + end; + end; + OP_IMUL: + begin + if setflags then + handle_reg_const_reg(list, f_TOpCG2AsmOp_ovf(op, size), src, a, dst) + else + begin + tmpreg1 := GetIntRegister(list, OS_INT); + a_load_const_reg(list, OS_INT, a, tmpreg1); + list.concat(taicpu.op_reg_reg(f_TOpCG2AsmOp(op, size),src, tmpreg1)); + list.concat(taicpu.op_reg(A_MFLO, dst)); + end; + end; + OP_XOR, OP_OR, OP_AND: + begin + handle_reg_const_reg(list, f_TOpCG2AsmOp_ovf(op, size), src, a, dst); + end; + else + internalerror(2007012601); + end; +end; + + +procedure TCgMPSel.a_op_reg_reg_reg_checkoverflow(list: tasmlist; op: TOpCg; size: tcgsize; src1, src2, dst: tregister; setflags: boolean; var ovloc: tlocation); +begin + ovloc.loc := LOC_VOID; + case op of + OP_ADD: + begin + if setflags then + list.concat(taicpu.op_reg_reg_reg(f_TOpCG2AsmOp_ovf(op, size), dst, src2, src1)) + else + list.concat(taicpu.op_reg_reg_reg(f_TOpCG2AsmOp(op, size), dst, src2, src1)); + end; + OP_SUB: + begin + if setflags then + list.concat(taicpu.op_reg_reg_reg(f_TOpCG2AsmOp_ovf(op, size), dst, src2, src1)) + else + list.concat(taicpu.op_reg_reg_reg(f_TOpCG2AsmOp(op, size), dst, src2, src1)); + end; + OP_MUL: + begin + if setflags then + list.concat(taicpu.op_reg_reg_reg(f_TOpCG2AsmOp_ovf(op, size), dst, src2, src1)) + else + begin + list.concat(taicpu.op_reg_reg(f_TOpCG2AsmOp(op, size), src2, src1)); + list.concat(taicpu.op_reg(A_MFLO, dst)); + end; + end; + OP_IMUL: + begin + if setflags then + list.concat(taicpu.op_reg_reg_reg(f_TOpCG2AsmOp_ovf(op, size), dst, src2, src1)) + else + begin + list.concat(taicpu.op_reg_reg(f_TOpCG2AsmOp(op, size), src2, src1)); + list.concat(taicpu.op_reg(A_MFLO, dst)); + end; + end; + OP_XOR, OP_OR, OP_AND: + begin + list.concat(taicpu.op_reg_reg_reg(f_TOpCG2AsmOp_ovf(op, size), dst, src2, src1)); + end; + else + internalerror(2007012602); + end; +end; + + + +{*************** compare instructructions ****************} + +procedure TCgMPSel.a_cmp_const_reg_label(list: tasmlist; size: tcgsize; cmp_op: topcmp; a: tcgint; reg: tregister; l: tasmlabel); +var + tmpreg: tregister; +begin +if a = 0 then + tmpreg := NR_R0 +else +begin + tmpreg := GetIntRegister(list, OS_INT); + list.concat(taicpu.op_reg_const(A_LI, tmpreg, a)); +end; + case cmp_op of + OC_EQ: { equality comparison } + list.concat(taicpu.op_reg_reg_sym(A_BEQ, reg, tmpreg, l)); + OC_GT: { greater than (signed) } + list.concat(taicpu.op_reg_reg_sym(A_BGT, reg, tmpreg, l)); + OC_LT: { less than (signed) } + list.concat(taicpu.op_reg_reg_sym(A_BLT, reg, tmpreg, l)); + OC_GTE: { greater or equal than (signed) } + list.concat(taicpu.op_reg_reg_sym(A_BGE, reg, tmpreg, l)); + OC_LTE: { less or equal than (signed) } + list.concat(taicpu.op_reg_reg_sym(A_BLE, reg, tmpreg, l)); + OC_NE: { not equal } + list.concat(taicpu.op_reg_reg_sym(A_BNE, reg, tmpreg, l)); + OC_BE: { less or equal than (unsigned) } + list.concat(taicpu.op_reg_reg_sym(A_BLEU, reg, tmpreg, l)); + OC_B: { less than (unsigned) } + list.concat(taicpu.op_reg_reg_sym(A_BLTU, reg, tmpreg, l)); + OC_AE: { greater or equal than (unsigned) } + list.concat(taicpu.op_reg_reg_sym(A_BGEU, reg, tmpreg, l)); + OC_A: { greater than (unsigned) } + list.concat(taicpu.op_reg_reg_sym(A_BGTU, reg, tmpreg, l)); + else + internalerror(200701071); + end; + list.Concat(TAiCpu.Op_none(A_NOP)); +end; + + +procedure TCgMPSel.a_cmp_reg_reg_label(list: tasmlist; size: tcgsize; cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel); +begin + case cmp_op of + OC_EQ: { equality comparison } + list.concat(taicpu.op_reg_reg_sym(A_BEQ, reg2, reg1, l)); + OC_GT: { greater than (signed) } + list.concat(taicpu.op_reg_reg_sym(A_BGT, reg2, reg1, l)); + OC_LT: { less than (signed) } + list.concat(taicpu.op_reg_reg_sym(A_BLT, reg2, reg1, l)); + OC_GTE: { greater or equal than (signed) } + list.concat(taicpu.op_reg_reg_sym(A_BGE, reg2, reg1, l)); + OC_LTE: { less or equal than (signed) } + list.concat(taicpu.op_reg_reg_sym(A_BLE, reg2, reg1, l)); + OC_NE: { not equal } + list.concat(taicpu.op_reg_reg_sym(A_BNE, reg2, reg1, l)); + OC_BE: { less or equal than (unsigned) } + list.concat(taicpu.op_reg_reg_sym(A_BLEU, reg2, reg1, l)); + OC_B: { less than (unsigned) } + list.concat(taicpu.op_reg_reg_sym(A_BLTU, reg2, reg1, l)); + OC_AE: { greater or equal than (unsigned) } + list.concat(taicpu.op_reg_reg_sym(A_BGEU, reg2, reg1, l)); + OC_A: { greater than (unsigned) } + list.concat(taicpu.op_reg_reg_sym(A_BGTU, reg2, reg1, l)); + else + internalerror(200701072); + end;{ case } + list.Concat(TAiCpu.Op_none(A_NOP)); +end; + + +procedure TCgMPSel.a_jmp_always(List: tasmlist; l: TAsmLabel); +begin + List.Concat(TAiCpu.op_sym(A_J,l)); + { Delay slot } + list.Concat(TAiCpu.Op_none(A_NOP)); +end; + + +procedure TCgMPSel.a_jmp_name(list: tasmlist; const s: string); +begin + List.Concat(TAiCpu.op_sym(A_J, current_asmdata.RefAsmSymbol(s))); + { Delay slot } + list.Concat(TAiCpu.Op_none(A_NOP)); +end; + + +procedure TCgMPSel.a_jmp_cond(list: tasmlist; cond: TOpCmp; l: TAsmLabel); +begin + internalerror(200701181); +end; + + +procedure TCgMPSel.g_overflowCheck(List: tasmlist; const Loc: TLocation; def: TDef); +begin +// this is an empty procedure +end; + +procedure TCgMPSel.g_overflowCheck_loc(List: tasmlist; const Loc: TLocation; def: TDef; ovloc: tlocation); +begin + +// this is an empty procedure + +end; + +{ *********** entry/exit code and address loading ************ } + +procedure TCgMPSel.g_proc_entry(list: tasmlist; localsize: longint; nostackframe: boolean); +var + regcounter, firstregfpu, firstreggpr: TSuperRegister; + href: treference; + usesfpr, usesgpr, gotgot: boolean; + regcounter2, firstfpureg: Tsuperregister; + cond: tasmcond; + instr: taicpu; + +begin + if STK2_dummy <> 0 then + begin + list.concat(Taicpu.Op_reg_reg_const(A_P_STK2, STK2_PTR, STK2_PTR, -STK2_dummy)); + end; + + if nostackframe then + exit; + + usesfpr := False; + if not (po_assembler in current_procinfo.procdef.procoptions) then + case target_info.abi of + abi_powerpc_aix: + firstfpureg := RS_F14; + abi_powerpc_sysv: + firstfpureg := RS_F14; + abi_default: + firstfpureg := RS_F14; + else + internalerror(2003122903); + end; + for regcounter := firstfpureg to RS_F31 do + begin + if regcounter in rg[R_FPUREGISTER].used_in_proc then + begin + usesfpr := True; + firstregfpu := regcounter; + break; + end; + end; + + usesgpr := False; + if not (po_assembler in current_procinfo.procdef.procoptions) then + for regcounter2 := RS_R13 to RS_R31 do + begin + if regcounter2 in rg[R_INTREGISTER].used_in_proc then + begin + usesgpr := True; + firstreggpr := regcounter2; + break; + end; + end; + + + LocalSize := align(LocalSize, 8); + + cgcpu_calc_stackframe_size := LocalSize; + list.concat(Taicpu.Op_reg_reg_const(A_P_FRAME, NR_FRAME_POINTER_REG, NR_R31, LocalSize)); + list.concat(Taicpu.op_none(A_P_SET_NOREORDER)); + list.concat(Taicpu.op_none(A_P_SET_NOMACRO)); + list.concat(Taicpu.Op_reg_reg_const(A_P_SW, NR_FRAME_POINTER_REG, NR_STACK_POINTER_REG, -LocalSize)); + list.concat(Taicpu.Op_reg_reg_const(A_P_SW, NR_R31, NR_STACK_POINTER_REG, -LocalSize + 4)); + list.concat(Taicpu.op_reg_reg(A_MOVE, NR_FRAME_POINTER_REG, NR_STACK_POINTER_REG)); + list.concat(Taicpu.Op_reg_reg_const(A_ADDIU, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, -LocalSize)); + if (cs_create_pic in current_settings.moduleswitches) and + (pi_needs_got in current_procinfo.flags) then + begin + current_procinfo.got := NR_GP; + end; +end; + + + + +procedure TCgMPSel.g_proc_exit(list: tasmlist; parasize: longint; nostackframe: boolean); +var + hr: treference; + localsize: aint; +begin + localsize := cgcpu_calc_stackframe_size; + if paramanager.ret_in_param(current_procinfo.procdef.returndef, current_procinfo.procdef.proccalloption) then + begin + reference_reset(hr,sizeof(aint)); + hr.offset := 12; + hr.refaddr := addr_full; + if nostackframe then + begin + if STK2_dummy <> 0 then + list.concat(Taicpu.Op_reg_reg_const(A_P_STK2, STK2_PTR, STK2_PTR, STK2_dummy)); + list.concat(taicpu.op_reg(A_J, NR_R31)); + list.concat(Taicpu.op_none(A_NOP)); + end + else + begin + + list.concat(Taicpu.Op_reg_reg_const(A_P_LW, NR_FRAME_POINTER_REG, NR_STACK_POINTER_REG, 0)); + list.concat(Taicpu.Op_reg_reg_const(A_P_LW, NR_R31, NR_STACK_POINTER_REG, 4)); + list.concat(Taicpu.Op_reg_reg_const(A_ADDIU, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, localsize)); + if STK2_dummy <> 0 then + list.concat(Taicpu.Op_reg_reg_const(A_P_STK2, STK2_PTR, STK2_PTR, STK2_dummy)); + list.concat(taicpu.op_reg(A_J, NR_R31)); + list.concat(Taicpu.op_none(A_NOP)); + list.concat(Taicpu.op_none(A_P_SET_MACRO)); + list.concat(Taicpu.op_none(A_P_SET_REORDER)); + + end; + end + else + begin + if nostackframe then + begin + if STK2_dummy <> 0 then + list.concat(Taicpu.Op_reg_reg_const(A_P_STK2, STK2_PTR, STK2_PTR, STK2_dummy)); + list.concat(taicpu.op_reg(A_J, NR_R31)); + list.concat(Taicpu.op_none(A_NOP)); + list.concat(Taicpu.op_none(A_P_SET_MACRO)); + list.concat(Taicpu.op_none(A_P_SET_REORDER)); + end + else + begin + list.concat(Taicpu.Op_reg_reg_const(A_P_LW, NR_FRAME_POINTER_REG, NR_STACK_POINTER_REG, 0)); + list.concat(Taicpu.Op_reg_reg_const(A_P_LW, NR_R31, NR_STACK_POINTER_REG, 4)); + list.concat(Taicpu.Op_reg_reg_const(A_ADDIU, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, localsize)); + if STK2_dummy <> 0 then + list.concat(Taicpu.Op_reg_reg_const(A_P_STK2, STK2_PTR, STK2_PTR, STK2_dummy)); + list.concat(taicpu.op_reg(A_J, NR_R31)); + list.concat(Taicpu.op_none(A_NOP)); + list.concat(Taicpu.op_none(A_P_SET_MACRO)); + list.concat(Taicpu.op_none(A_P_SET_REORDER)); + end; + end; +end; + + + +{ ************* concatcopy ************ } + +procedure TCgMPSel.g_concatcopy_move(list: tasmlist; const Source, dest: treference; len: tcgint); +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); + a_load_const_cgpara(list, OS_INT, len, paraloc3); + a_loadaddr_ref_cgpara(list, dest, paraloc2); + a_loadaddr_ref_cgpara(list, Source, paraloc1); + paramanager.freecgpara(list, paraloc3); + paramanager.freecgpara(list, paraloc2); + paramanager.freecgpara(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', false); + dealloccpuregisters(list, R_FPUREGISTER, paramanager.get_volatile_registers_fpu(pocall_default)); + dealloccpuregisters(list, R_INTREGISTER, paramanager.get_volatile_registers_int(pocall_default)); + paraloc3.done; + paraloc2.done; + paraloc1.done; +end; + + +procedure TCgMPSel.g_concatcopy(list: tasmlist; const Source, dest: treference; len: tcgint); +var + tmpreg1, hreg, countreg: TRegister; + src, dst: TReference; + lab: tasmlabel; + Count, count2: aint; +begin + if len > high(longint) then + internalerror(2002072704); + { anybody wants to determine a good value here :)? } + if len > 100 then + g_concatcopy_move(list, Source, dest, len) + else + begin + reference_reset(src,sizeof(aint)); + reference_reset(dst,sizeof(aint)); + { load the address of source into src.base } + src.base := GetAddressRegister(list); + a_loadaddr_ref_reg(list, Source, src.base); + { load the address of dest into dst.base } + dst.base := GetAddressRegister(list); + a_loadaddr_ref_reg(list, dest, dst.base); + { generate a loop } + Count := len div 4; + if Count > 4 then + begin + { the offsets are zero after the a_loadaddress_ref_reg and just } + { have to be set to 8. I put an Inc there so debugging may be } + { easier (should offset be different from zero here, it will be } + { easy to notice in the generated assembler } + countreg := GetIntRegister(list, OS_INT); + tmpreg1 := GetIntRegister(list, OS_INT); + a_load_const_reg(list, OS_INT, Count, countreg); + { explicitely allocate R_O0 since it can be used safely here } + { (for holding date that's being copied) } + current_asmdata.getjumplabel(lab); + a_label(list, lab); + list.concat(taicpu.op_reg_ref(A_LW, tmpreg1, src)); + list.concat(taicpu.op_reg_ref(A_SW, tmpreg1, dst)); + list.concat(taicpu.op_reg_reg_const(A_ADDIU, src.base, src.base, 4)); + list.concat(taicpu.op_reg_reg_const(A_ADDIU, dst.base, dst.base, 4)); + list.concat(taicpu.op_reg_reg_const(A_ADDIU, countreg, countreg, -1)); + list.concat(taicpu.op_reg_sym(A_BGTZ, countreg, lab)); + list.concat(taicpu.op_none(A_NOP)); + len := len mod 4; + end; + { unrolled loop } + Count := len div 4; + if Count > 0 then + begin + tmpreg1 := GetIntRegister(list, OS_INT); + for count2 := 1 to Count do + begin + list.concat(taicpu.op_reg_ref(A_LW, tmpreg1, src)); + list.concat(taicpu.op_reg_ref(A_SW, tmpreg1, dst)); + Inc(src.offset, 4); + Inc(dst.offset, 4); + end; + len := len mod 4; + end; + if (len and 4) <> 0 then + begin + hreg := GetIntRegister(list, OS_INT); + a_load_ref_reg(list, OS_32, OS_32, src, hreg); + a_load_reg_ref(list, OS_32, OS_32, hreg, dst); + Inc(src.offset, 4); + Inc(dst.offset, 4); + end; + { copy the leftovers } + if (len and 2) <> 0 then + begin + hreg := GetIntRegister(list, OS_INT); + a_load_ref_reg(list, OS_16, OS_16, src, hreg); + a_load_reg_ref(list, OS_16, OS_16, hreg, dst); + Inc(src.offset, 2); + Inc(dst.offset, 2); + end; + if (len and 1) <> 0 then + begin + hreg := GetIntRegister(list, OS_INT); + a_load_ref_reg(list, OS_8, OS_8, src, hreg); + a_load_reg_ref(list, OS_8, OS_8, hreg, dst); + end; + end; +end; + + +procedure TCgMPSel.g_concatcopy_unaligned(list: tasmlist; const Source, dest: treference; len: tcgint); +var + src, dst: TReference; + tmpreg1, countreg: TRegister; + i: aint; + lab: tasmlabel; +begin + if len > 31 then + g_concatcopy_move(list, Source, dest, len) + else + begin + reference_reset(src,sizeof(aint)); + reference_reset(dst,sizeof(aint)); + { load the address of source into src.base } + src.base := GetAddressRegister(list); + a_loadaddr_ref_reg(list, Source, src.base); + { load the address of dest into dst.base } + dst.base := GetAddressRegister(list); + a_loadaddr_ref_reg(list, dest, dst.base); + { generate a loop } + if len > 4 then + begin + { the offsets are zero after the a_loadaddress_ref_reg and just } + { have to be set to 8. I put an Inc there so debugging may be } + { easier (should offset be different from zero here, it will be } + { easy to notice in the generated assembler } + countreg := GetIntRegister(list, OS_INT); + tmpreg1 := GetIntRegister(list, OS_INT); + a_load_const_reg(list, OS_INT, len, countreg); + { explicitely allocate R_O0 since it can be used safely here } + { (for holding date that's being copied) } + current_asmdata.getjumplabel(lab); + a_label(list, lab); + list.concat(taicpu.op_reg_ref(A_LBU, tmpreg1, src)); + list.concat(taicpu.op_reg_ref(A_SB, tmpreg1, dst)); + list.concat(taicpu.op_reg_reg_const(A_ADDIU, src.base, src.base, 1)); + list.concat(taicpu.op_reg_reg_const(A_ADDIU, dst.base, dst.base, 1)); + list.concat(taicpu.op_reg_reg_const(A_ADDIU, countreg, countreg, -1)); + list.concat(taicpu.op_reg_sym(A_BGTZ, countreg, lab)); + list.concat(taicpu.op_none(A_NOP)); + end + else + begin + { unrolled loop } + tmpreg1 := GetIntRegister(list, OS_INT); + for i := 1 to len do + begin + list.concat(taicpu.op_reg_ref(A_LBU, tmpreg1, src)); + list.concat(taicpu.op_reg_ref(A_SB, tmpreg1, dst)); + Inc(src.offset); + Inc(dst.offset); + end; + end; + end; +end; + + +procedure TCgMPSel.g_intf_wrapper(list: tasmlist; procdef: tprocdef; const labelname: string; ioffset: longint); + procedure loadvmttor24; + var + href: treference; + begin + reference_reset_base(href, NR_R2, 0, sizeof(aint)); { return value } + cg.a_load_ref_reg(list, OS_ADDR, OS_ADDR, href, NR_R24); + end; + + + procedure op_onr24methodaddr; + var + href : treference; + begin + if (procdef.extnumber=$ffff) then + Internalerror(200006139); + { call/jmp vmtoffs(%eax) ; method offs } + reference_reset_base(href, NR_R24, tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber), sizeof(aint)); + cg.a_load_ref_reg(list, OS_ADDR, OS_ADDR, href, NR_R24); + list.concat(taicpu.op_reg(A_JR, NR_R24)); + end; +var + make_global: boolean; + href: treference; +begin + if procdef.proctypeoption <> potype_none then + Internalerror(200006137); + if not assigned(procdef.struct) 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 create_smartlink 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); + + if (po_virtualmethod in procdef.procoptions) and + not is_objectpascal_helper(procdef.struct) then + begin + loadvmttor24; + op_onr24methodaddr; + end + else + list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname))); + { Delay slot } + list.Concat(TAiCpu.Op_none(A_NOP)); + + List.concat(Tai_symbol_end.Createname(labelname)); +end; + +procedure TCgMPSel.g_stackpointer_alloc(list : TAsmList;localsize : longint); + begin + Comment(V_Error,'TCgMPSel.g_stackpointer_alloc method not implemented'); + end; + +procedure TCgMPSel.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); + begin + Comment(V_Error,'TCgMPSel.a_bit_scan_reg_reg method not implemented'); + end; + +{**************************************************************************** + TCG64_MIPSel +****************************************************************************} + + +procedure TCg64MPSel.a_load64_reg_ref(list: tasmlist; reg: tregister64; const ref: treference); +var + tmpref: treference; +begin + { Override this function to prevent loading the reference twice } + tmpref := ref; + cg.a_load_reg_ref(list, OS_S32, OS_S32, reg.reglo, tmpref); + Inc(tmpref.offset, 4); + cg.a_load_reg_ref(list, OS_S32, OS_S32, reg.reghi, tmpref); +end; + + +procedure TCg64MPSel.a_load64_ref_reg(list: tasmlist; const ref: treference; reg: tregister64); +var + tmpref: treference; +begin + { Override this function to prevent loading the reference twice } + tmpref := ref; + cg.a_load_ref_reg(list, OS_S32, OS_S32, tmpref, reg.reglo); + Inc(tmpref.offset, 4); + cg.a_load_ref_reg(list, OS_S32, OS_S32, tmpref, reg.reghi); +end; + + +procedure TCg64MPSel.a_load64_ref_cgpara(list: tasmlist; const r: treference; const paraloc: tcgpara); +var + hreg64: tregister64; +begin + { Override this function to prevent loading the reference twice. + Use here some extra registers, but those are optimized away by the RA } + hreg64.reglo := cg.GetIntRegister(list, OS_S32); + hreg64.reghi := cg.GetIntRegister(list, OS_S32); + a_load64_ref_reg(list, r, hreg64); + a_load64_reg_cgpara(list, hreg64, paraloc); +end; + + + + +procedure TCg64MPSel.a_op64_reg_reg(list: tasmlist; op: TOpCG; size: tcgsize; regsrc, regdst: TRegister64); +var + op1, op2, op_call64: TAsmOp; + tmpreg1, tmpreg2: TRegister; +begin + tmpreg1 := NR_TCR12; //GetIntRegister(list, OS_INT); + tmpreg2 := NR_TCR13; //GetIntRegister(list, OS_INT); + + case op of + OP_ADD: + begin + list.concat(taicpu.op_reg_reg_reg(A_ADDU, tmpreg1, regsrc.reglo, regdst.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_SLTU, NR_TCR10, tmpreg1, regsrc.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_ADDU, tmpreg2, regsrc.reghi, regdst.reghi)); + list.concat(taicpu.op_reg_reg_reg(A_ADDU, NR_TCR10, NR_TCR10, tmpreg2)); + list.concat(Taicpu.Op_reg_reg(A_MOVE, regdst.reglo, tmpreg1)); + list.concat(Taicpu.Op_reg_reg(A_MOVE, regdst.reghi, NR_TCR10)); + exit; + end; + OP_AND: + begin + list.concat(taicpu.op_reg_reg_reg(A_AND, regdst.reglo, regsrc.reglo, regdst.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_AND, regdst.reghi, regsrc.reghi, regdst.reghi)); + exit; + end; + + OP_NEG: + begin + list.concat(taicpu.op_reg_reg_reg(A_SUBU, regdst.reglo, NR_R0, regsrc.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_SLTU, NR_TCR10, NR_R0, regdst.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_SUBU, regdst.reghi, NR_R0, regsrc.reghi)); + list.concat(taicpu.op_reg_reg_reg(A_SUBU, NR_TCR10, regdst.reghi, NR_TCR10)); + list.concat(Taicpu.Op_reg_reg(A_MOVE, regdst.reghi, NR_TCR10)); + exit; + end; + OP_NOT: + begin + list.concat(taicpu.op_reg_reg_reg(A_NOR, regdst.reglo, NR_R0, regsrc.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_NOR, regdst.reghi, NR_R0, regsrc.reghi)); + exit; + end; + OP_OR: + begin + list.concat(taicpu.op_reg_reg_reg(A_OR, regdst.reglo, regsrc.reglo, regdst.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_OR, regdst.reghi, regsrc.reghi, regdst.reghi)); + exit; + end; + OP_SUB: + begin + list.concat(taicpu.op_reg_reg_reg(A_SUBU, tmpreg1, regdst.reglo, regsrc.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_SLTU, NR_TCR10, regdst.reglo, tmpreg1)); + list.concat(taicpu.op_reg_reg_reg(A_SUBU, tmpreg2, regdst.reghi, regsrc.reghi)); + list.concat(taicpu.op_reg_reg_reg(A_SUBU, tmpreg2, tmpreg2, NR_TCR10)); + list.concat(Taicpu.Op_reg_reg(A_MOVE, regdst.reglo, tmpreg1)); + list.concat(Taicpu.Op_reg_reg(A_MOVE, regdst.reghi, tmpreg2)); + exit; + end; + OP_XOR: + begin + list.concat(taicpu.op_reg_reg_reg(A_XOR, regdst.reglo, regdst.reglo, regsrc.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_XOR, regdst.reghi, regsrc.reghi, regdst.reghi)); + exit; + end; + else + internalerror(200306017); + + end; {case} + + + +end; + + +procedure TCg64MPSel.a_op64_const_reg(list: tasmlist; op: TOpCG; size: tcgsize; Value: int64; regdst: TRegister64); +var + op1, op2: TAsmOp; +begin + case op of + OP_NEG, + OP_NOT: + internalerror(200306017); + end; + a_op64_const_reg_reg(list, op, size, value, regdst, regdst); + +end; + + +procedure TCg64MPSel.a_op64_const_reg_reg(list: tasmlist; op: TOpCG; size: tcgsize; Value: int64; regsrc, regdst: tregister64); +var + l: tlocation; +begin + a_op64_const_reg_reg_checkoverflow(list, op, size, Value, regsrc, regdst, False, l); +end; + + +procedure TCg64MPSel.a_op64_reg_reg_reg(list: tasmlist; op: TOpCG; size: tcgsize; regsrc1, regsrc2, regdst: tregister64); +var + l: tlocation; +begin + a_op64_reg_reg_reg_checkoverflow(list, op, size, regsrc1, regsrc2, regdst, False, l); +end; + + +procedure TCg64MPSel.a_op64_const_reg_reg_checkoverflow(list: tasmlist; op: TOpCG; size: tcgsize; Value: int64; regsrc, regdst: tregister64; setflags: boolean; var ovloc: tlocation); +var + op1, op2: TAsmOp; + tmpreg1: TRegister; +begin + tmpreg1 := NR_TCR12; + case op of + OP_NEG, + OP_NOT: + internalerror(200306017); + end; + + list.concat(taicpu.op_reg_const(A_LI, NR_TCR10, aint(hi(Value)))); + list.concat(taicpu.op_reg_const(A_LI, NR_TCR11, aint(lo(Value)))); + case op of + OP_ADD: + begin + list.concat(taicpu.op_reg_reg_reg(A_ADDU, regdst.reglo, regsrc.reglo, NR_TCR10)); + list.concat(taicpu.op_reg_reg_reg(A_SLTU, tmpreg1, regdst.reglo, regsrc.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_ADDU, regdst.reghi, regsrc.reghi, NR_TCR11)); + list.concat(taicpu.op_reg_reg_reg(A_ADDU, tmpreg1, tmpreg1, regdst.reghi)); + list.concat(Taicpu.Op_reg_reg(A_MOVE, regdst.reghi, tmpreg1)); + exit; + end; + OP_AND: + begin + list.concat(taicpu.op_reg_reg_reg(A_AND, regdst.reglo, regsrc.reglo, NR_TCR10)); + list.concat(taicpu.op_reg_reg_reg(A_AND, regdst.reghi, regsrc.reghi, NR_TCR11)); + exit; + end; + + OP_OR: + begin + list.concat(taicpu.op_reg_reg_reg(A_OR, regdst.reglo, regsrc.reglo, NR_TCR10)); + list.concat(taicpu.op_reg_reg_reg(A_OR, regdst.reghi, regsrc.reghi, NR_TCR11)); + exit; + end; + OP_SUB: + begin + list.concat(taicpu.op_reg_reg_reg(A_SUBU, regdst.reglo, regsrc.reglo, NR_TCR10)); + list.concat(taicpu.op_reg_reg_reg(A_SLTU, tmpreg1, regsrc.reglo, regdst.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_SUBU, regdst.reghi, regsrc.reghi, NR_TCR11)); + list.concat(taicpu.op_reg_reg_reg(A_SUBU, tmpreg1, regdst.reghi, tmpreg1)); + list.concat(Taicpu.Op_reg_reg(A_MOVE, regdst.reghi, tmpreg1)); + exit; + end; + OP_XOR: + begin + list.concat(taicpu.op_reg_reg_reg(A_XOR, regdst.reglo, regsrc.reglo, NR_TCR10)); + list.concat(taicpu.op_reg_reg_reg(A_XOR, regdst.reghi, regsrc.reghi, NR_TCR11)); + exit; + end; + else + internalerror(200306017); + end; + +end; + + +procedure TCg64MPSel.a_op64_reg_reg_reg_checkoverflow(list: tasmlist; op: TOpCG; size: tcgsize; regsrc1, regsrc2, regdst: tregister64; setflags: boolean; var ovloc: tlocation); +var + op1, op2: TAsmOp; + tmpreg1, tmpreg2: TRegister; + +begin + tmpreg1 := NR_TCR12; + tmpreg2 := NR_TCR13; + + case op of + OP_NEG, + OP_NOT: + internalerror(200306017); + end; + case op of + OP_ADD: + begin + list.concat(taicpu.op_reg_reg_reg(A_ADDU, tmpreg1, regsrc2.reglo, regsrc1.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_SLTU, NR_TCR10, tmpreg1, regsrc2.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_ADDU, tmpreg2, regsrc2.reghi, regsrc1.reghi)); + list.concat(taicpu.op_reg_reg_reg(A_ADDU, regdst.reghi, NR_TCR10, tmpreg2)); + list.concat(Taicpu.Op_reg_reg(A_MOVE, regdst.reglo, tmpreg1)); + exit; + end; + OP_AND: + begin + list.concat(taicpu.op_reg_reg_reg(A_AND, regdst.reglo, regsrc2.reglo, regsrc1.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_AND, regdst.reghi, regsrc2.reghi, regsrc1.reghi)); + exit; + end; + OP_OR: + begin + list.concat(taicpu.op_reg_reg_reg(A_OR, regdst.reglo, regsrc2.reglo, regsrc1.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_OR, regdst.reghi, regsrc2.reghi, regsrc1.reghi)); + exit; + end; + OP_SUB: + begin + list.concat(taicpu.op_reg_reg_reg(A_SUBU, tmpreg1, regsrc2.reglo, regsrc1.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_SLTU, NR_TCR10, regsrc2.reglo, tmpreg1)); + list.concat(taicpu.op_reg_reg_reg(A_SUBU, tmpreg2, regsrc2.reghi, regsrc1.reghi)); + list.concat(taicpu.op_reg_reg_reg(A_SUBU, regdst.reghi, tmpreg2, NR_TCR10)); + list.concat(Taicpu.Op_reg_reg(A_MOVE, regdst.reglo, tmpreg1)); + exit; + end; + OP_XOR: + begin + list.concat(taicpu.op_reg_reg_reg(A_XOR, regdst.reglo, regsrc2.reglo, regsrc1.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_XOR, regdst.reghi, regsrc2.reghi, regsrc1.reghi)); + exit; + end; + else + internalerror(200306017); + + end; {case} + +end; + + + procedure create_codegen; + begin + cg:=TCgMPSel.Create; + cg64:=TCg64MPSel.Create; + end; + +end. diff --git a/closures/compiler/mips/cpubase.pas b/closures/compiler/mips/cpubase.pas new file mode 100644 index 0000000000..c075394ffd --- /dev/null +++ b/closures/compiler/mips/cpubase.pas @@ -0,0 +1,397 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl and Peter Vreman + + Contains the base types for MIPS + + 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 opcode.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 rmipsnor.inc}-1; + + const + { Available Superregisters } + {$i rmipssup.inc} + + { No Subregisters } + R_SUBWHOLE = R_SUBNONE; + + { Available Registers } + {$i rmipscon.inc} + + { 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_NO; + first_mm_imreg = RS_NO; + +{ TODO: Calculate bsstart} + regnumber_count_bsstart = 64; + + regnumber_table : array[tregisterindex] of tregister = ( + {$i rmipsnum.inc} + ); + + regstabs_table : array[tregisterindex] of shortint = ( + {$i rmipssta.inc} + ); + + regdwarf_table : array[tregisterindex] of shortint = ( + {$i rmipsdwf.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; + +{***************************************************************************** + Conditions +*****************************************************************************} + + type + TAsmCond=(C_None, + C_EQ, C_NE, C_LT, C_LE, C_GT, C_GE, C_LTU, C_LEU, C_GTU, C_GEU, + C_FEQ, {Equal} + C_FNE, {Not Equal} + C_FGT, {Greater} + C_FLT, {Less} + C_FGE, {Greater or Equal} + C_FLE {Less or Equal} + + ); + + const + cond2str : array[TAsmCond] of string[3]=('', + 'eq','ne','lt','le','gt','ge','ltu','leu','gtu','geu', + 'feq','fne','fgt','flt','fge','fle' + ); + +{***************************************************************************** + Constants +*****************************************************************************} + + const + max_operands = 4; + + maxintregs = 31; + maxfpuregs = 8; + maxaddrregs = 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 + 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 +*****************************************************************************} + + STK2_PTR = NR_R23; + NR_GP = NR_R28; + NR_SP = NR_R29; + NR_S8 = NR_R30; + NR_FP = NR_R30; + NR_RA = NR_R31; + + RS_GP = RS_R28; + RS_SP = RS_R29; + RS_S8 = RS_R30; + RS_FP = RS_R30; + RS_RA = RS_R31; + + {# Stack pointer register } + NR_STACK_POINTER_REG = NR_SP; + RS_STACK_POINTER_REG = RS_SP; + {# Frame pointer register } + NR_FRAME_POINTER_REG = NR_FP; + RS_FRAME_POINTER_REG = RS_FP; + + NR_RETURN_ADDRESS_REG = NR_R7; + { 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 } + + { Results are returned in this register (32-bit values) } + NR_FUNCTION_RETURN_REG = NR_R2; + RS_FUNCTION_RETURN_REG = RS_R2; + { Low part of 64bit return value } + NR_FUNCTION_RETURN64_LOW_REG = NR_R2; + RS_FUNCTION_RETURN64_LOW_REG = RS_R2; + { High part of 64bit return value } + NR_FUNCTION_RETURN64_HIGH_REG = NR_R3; + RS_FUNCTION_RETURN64_HIGH_REG = RS_R3; + { The value returned from a function is available in this register } + NR_FUNCTION_RESULT_REG = NR_R2; + RS_FUNCTION_RESULT_REG = RS_R2; + { The lowh part of 64bit value returned from a function } + NR_FUNCTION_RESULT64_LOW_REG = NR_R2; + RS_FUNCTION_RESULT64_LOW_REG = RS_R2; + { The high part of 64bit value returned from a function } + NR_FUNCTION_RESULT64_HIGH_REG = NR_R3; + RS_FUNCTION_RESULT64_HIGH_REG = RS_R3; + + NR_FPU_RESULT_REG = NR_F0; + NR_MM_RESULT_REG = NR_NO; + + NR_TCR0 = NR_R15; + NR_TCR1 = NR_R3; + + NR_TCR10 = NR_R20; + NR_TCR11 = NR_R21; + NR_TCR12 = NR_R18; + NR_TCR13 = NR_R19; + + +{***************************************************************************** + 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..0] of tsuperregister = + (RS_NO); + + { this is only for the generic code which is not used for this architecture } + saved_mm_registers : array[0..0] of tsuperregister = (RS_NO); + + { 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; + +{***************************************************************************** + CPU Dependent Constants +*****************************************************************************} + + const + simm16lo = -32768; + simm16hi = 32767; + +{***************************************************************************** + Helpers +*****************************************************************************} + + 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} + + { Returns the tcgsize corresponding with the size of reg.} + function reg_cgsize(const reg: tregister) : tcgsize; + function cgsize2subreg(regtype: tregistertype; s:tcgsize):tsubregister; + function is_calljmp(o:tasmop):boolean; + function findreg_by_number(r:Tregister):tregisterindex; + function std_regnum_search(const s:string):Tregister; + function std_regname(r:Tregister):string; + + var + STK2_dummy: aint; + STK2_Localsize: aint; + + implementation + + uses + rgBase,verbose; + + + const + std_regname_table : array[tregisterindex] of string[7] = ( + {$i rmipsstd.inc} + ); + + regnumber_index : array[tregisterindex] of tregisterindex = ( + {$i rmipsrni.inc} + ); + + std_regname_index : array[tregisterindex] of tregisterindex = ( + {$i rmipssri.inc} + ); + + + function cgsize2subreg(regtype: tregistertype; s:tcgsize):tsubregister; + begin + if s in [OS_64,OS_S64] then + cgsize2subreg:=R_SUBQ + else + cgsize2subreg:=R_SUBWHOLE; + end; + + + function reg_cgsize(const reg: tregister): tcgsize; + begin + case getregtype(reg) of + R_INTREGISTER : + reg_cgsize:=OS_32; + R_FPUREGISTER : + begin + if getsubreg(reg)=R_SUBFD then + result:=OS_F64 + else + result:=OS_F32; + end; + 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_J,A_JAL,A_JALR,{ A_JALX, }A_JR, + A_BEQ,A_BNE,A_BGEZ,A_BGEZAL,A_BGTZ,A_BLEZ,A_BLTZ,A_BLTZAL, + A_BEQL,A_BGEZALL,A_BGEZL,A_BGTZL,A_BLEZL,A_BLTZALL,A_BLTZL,A_BNEL]; + end; + + + function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE} + const + inverse: array[TAsmCond] of TAsmCond=(C_None, + C_EQ, C_NE, C_LT, C_LE, C_GT, C_GE, C_LTU, C_LEU, C_GTU, C_GEU, + C_FEQ, {Equal} + C_FNE, {Not Equal} + C_FGT, {Greater} + C_FLT, {Less} + C_FGE, {Greater or Equal} + C_FLE {Less or Equal} + + ); + begin + result := inverse[c]; + end; function findreg_by_number(r:Tregister):tregisterindex; + begin + result:=rgBase.findreg_by_number_table(r,regnumber_index); + end; + + + function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE} + begin + result := c1 = c2; + 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; + + +begin + STK2_dummy := 10; + STK2_Localsize := 0; +end. diff --git a/closures/compiler/mips/cpugas.pas b/closures/compiler/mips/cpugas.pas new file mode 100644 index 0000000000..d030f14f21 --- /dev/null +++ b/closures/compiler/mips/cpugas.pas @@ -0,0 +1,265 @@ +{ + Copyright (c) 1999-2009 by Florian Klaempfl and David Zhang + + This unit implements an asmoutput class for MIPS assembly syntax + + 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 cpugas; + +{$i fpcdefs.inc} + + interface + + uses + cpubase, + aasmtai, aasmcpu, assemble, aggas; + + type + TMIPSGNUAssembler = class(TGNUassembler) + constructor create(smart: boolean); override; + end; + + TMIPSInstrWriter = class(TCPUInstrWriter) + procedure WriteInstruction(hp : tai);override; + end; + + implementation + + uses + cutils, systems, + verbose, itcpugas, cgbase, cgutils; + +{****************************************************************************} +{ GNU MIPS Assembler writer } +{****************************************************************************} + + constructor TMIPSGNUAssembler.create(smart: boolean); + begin + inherited create(smart); + InstrWriter := TMIPSInstrWriter.create(self); + end; + + +{****************************************************************************} +{ Helper routines for Instruction Writer } +{****************************************************************************} + + function GetReferenceString(var ref: TReference): string; + begin + GetReferenceString := ''; + with ref do + begin + if (base = NR_NO) and (index = NR_NO) then + begin + if assigned(symbol) then + GetReferenceString := symbol.Name; + if offset > 0 then + GetReferenceString := GetReferenceString + '+' + ToStr(offset) + else if offset < 0 then + GetReferenceString := GetReferenceString + ToStr(offset); + case refaddr of + addr_high: + GetReferenceString := '%hi(' + GetReferenceString + ')'; + addr_low: + GetReferenceString := '%lo(' + GetReferenceString + ')'; + end; + end + else + begin + {$ifdef extdebug} + if assigned(symbol) and + not(refaddr in [addr_pic,addr_lo]) then + internalerror(2003052601); + {$endif extdebug} + if base <> NR_NO then + GetReferenceString := GetReferenceString + '(' + gas_regname(base) + ')'; + if index = NR_NO then + begin + if offset <> 0 then + GetReferenceString := ToStr(offset) + GetReferenceString; + if assigned(symbol) then + begin + if refaddr = addr_low then + GetReferenceString := '%lo(' + symbol.Name + ')' + GetReferenceString + else + GetReferenceString := symbol.Name + {'+' +} GetReferenceString; + end; + end + else + begin + {$ifdef extdebug} + if (Offset<>0) or assigned(symbol) then + internalerror(2003052603); + {$endif extdebug} + GetReferenceString := GetReferenceString + '(' + gas_regname(index) + ')'; + + end; + end; + end; + end; + + + function getopstr(const Oper: TOper): string; + begin + with Oper do + case typ of + top_reg: + getopstr := gas_regname(reg); + top_const: + getopstr := tostr(longint(val)); + top_ref: + if (oper.ref^.refaddr in [addr_no, addr_pic]) or ((oper.ref^.refaddr = addr_low) and ((oper.ref^.base <> NR_NO) or + (oper.ref^.index <> NR_NO))) then + getopstr := getreferencestring(ref^) + else + getopstr := getreferencestring(ref^); + else + internalerror(10001); + end; + end; + + function getopstr_4(const Oper: TOper): string; + var + tmpref: treference; + begin + with Oper do + case typ of + top_ref: + begin + tmpref := ref^; + Inc(tmpref.offset, 4); + getopstr_4 := getreferencestring(tmpref); + end; + else + internalerror(2007050403); + end; + end; + + + procedure TMIPSInstrWriter.WriteInstruction(hp: Tai); + var + Op: TAsmOp; + s,s1: string; + i: integer; + tmpfpu: string; + tmpfpu_len: longint; + begin + if hp.typ <> ait_instruction then + exit; + op := taicpu(hp).opcode; + + case op of + A_P_STK2: + begin + s1 := getopstr(taicpu(hp).oper[2]^); + STK2_LocalSize := align(STK2_LocalSize, 8); + if s1[1] = '-' then + str(-STK2_LocalSize, s1) + else + str(STK2_LocalSize, s1); + s := #9 + gas_op2str[A_ADDIU] + #9 + getopstr(taicpu(hp).oper[0]^)+ ',' + getopstr(taicpu(hp).oper[1]^) + ',' + s1; + owner.AsmWriteLn(s); + end; + A_P_FRAME: + begin + end; + A_P_SET_MACRO: + begin + s := #9 + '.set' + #9 + 'macro'; + owner.AsmWriteLn(s); + end; + A_P_SET_REORDER: + begin + s := #9 + '.set' + #9 + 'reorder'; + owner.AsmWriteLn(s); + end; + A_P_SET_NOMACRO: + begin + s := #9 + '.set' + #9 + 'nomacro'; + owner.AsmWriteLn(s); + end; + A_P_SET_NOREORDER: + begin + s := #9 + '.set' + #9 + 'noreorder'; + owner.AsmWriteLn(s); + end; + A_P_SW: + begin + s := #9 + gas_op2str[A_SW] + #9 + getopstr(taicpu(hp).oper[0]^)+ ',' + getopstr(taicpu(hp).oper[2]^) + '(' + getopstr(taicpu(hp).oper[1]^) + ')'; + owner.AsmWriteLn(s); + end; + A_P_LW: + begin + s := #9 + gas_op2str[A_LW] + #9 + getopstr(taicpu(hp).oper[0]^)+ ',' + getopstr(taicpu(hp).oper[2]^) + '(' + getopstr(taicpu(hp).oper[1]^) + ')'; + owner.AsmWriteLn(s); + end; + A_LDC1: + begin + tmpfpu := getopstr(taicpu(hp).oper[0]^); + s := #9 + gas_op2str[A_LWC1] + #9 + tmpfpu + ',' + getopstr(taicpu(hp).oper[1]^); // + '(' + getopstr(taicpu(hp).oper[1]^) + ')'; + owner.AsmWriteLn(s); + + tmpfpu_len := length(tmpfpu); + tmpfpu[tmpfpu_len] := succ(tmpfpu[tmpfpu_len]); + s := #9 + gas_op2str[A_LWC1] + #9 + tmpfpu + ',' + getopstr_4(taicpu(hp).oper[1]^); // + '(' + getopstr(taicpu(hp).oper[1]^) + ')'; + owner.AsmWriteLn(s); + end; + A_SDC1: + begin + tmpfpu := getopstr(taicpu(hp).oper[0]^); + s := #9 + gas_op2str[A_SWC1] + #9 + tmpfpu + ',' + getopstr(taicpu(hp).oper[1]^); //+ ',' + getopstr(taicpu(hp).oper[2]^) + '(' + getopstr(taicpu(hp).oper[1]^) + ')'; + owner.AsmWriteLn(s); + + tmpfpu_len := length(tmpfpu); + tmpfpu[tmpfpu_len] := succ(tmpfpu[tmpfpu_len]); + s := #9 + gas_op2str[A_SWC1] + #9 + tmpfpu + ',' + getopstr_4(taicpu(hp).oper[1]^); //+ ',' + getopstr(taicpu(hp).oper[2]^) + '(' + getopstr(taicpu(hp).oper[1]^) + ')'; + owner.AsmWriteLn(s); + end; + else + begin + s := #9 + gas_op2str[op] + cond2str[taicpu(hp).condition]; + if taicpu(hp).delayslot_annulled then + s := s + ',a'; + if taicpu(hp).ops > 0 then + begin + s := s + #9 + getopstr(taicpu(hp).oper[0]^); + for i := 1 to taicpu(hp).ops - 1 do + s := s + ',' + getopstr(taicpu(hp).oper[i]^); + end; + owner.AsmWriteLn(s); + end; + end; + end; + + + const + as_MIPSEL_as_info: tasminfo = + ( + id: as_gas; + idtxt: 'AS'; + asmbin: 'as'; + asmcmd: '-mips2 -W -EL -o $OBJ $ASM'; + supported_targets: [system_mips_linux,system_mipsel_linux]; + flags: [af_allowdirect, af_needar, af_smartlink_sections]; + labelprefix: '.L'; + comment: '# '; + ); + +begin + RegisterAssembler(as_MIPSEL_as_info, TMIPSGNUAssembler); +end. diff --git a/closures/compiler/mips/cpuinfo.pas b/closures/compiler/mips/cpuinfo.pas new file mode 100644 index 0000000000..ddf0494b9c --- /dev/null +++ b/closures/compiler/mips/cpuinfo.pas @@ -0,0 +1,79 @@ +{ + 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 double; + ts128real = type double; + ts64comp = comp; + + pbestreal=^bestreal; + + { possible supported processors for this target } + tcputype = + (cpu_none, + cpu_mips32 + ); + + tfputype =(fpu_none,fpu_soft,fpu_mips2,fpu_mips3); + +Const + {# Size of native extended floating point type } + extended_size = 8; + {# Size of a multimedia register } + mmreg_size = 0; + { target cpu string (used by compiler options) } +{$ifdef MIPSEL} + target_cpu_string = 'mipsel'; +{$else MIPSEL} + target_cpu_string = 'mips'; +{$endif MIPSEL} + { 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 + ]; + + cputypestr : array[tcputype] of string[6] = ('', + 'MIPS32' + ); + + fputypestr : array[tfputype] of string[9] = ('', + 'SOFT', + 'FPU_MIPS2','FPU_MIPS3' + ); + + { Supported optimizations, only used for information } + supported_optimizerswitches = [cs_opt_regvar,cs_opt_loopunroll,cs_opt_nodecse]; + + level1optimizerswitches = []; + level2optimizerswitches = level1optimizerswitches + [cs_opt_regvar,cs_opt_stackframe,cs_opt_nodecse]; + level3optimizerswitches = level2optimizerswitches + [cs_opt_loopunroll]; + +Implementation + +end. diff --git a/closures/compiler/mips/cpunode.pas b/closures/compiler/mips/cpunode.pas new file mode 100644 index 0000000000..89ddf3058f --- /dev/null +++ b/closures/compiler/mips/cpunode.pas @@ -0,0 +1,41 @@ +{****************************************************************************** + Copyright (c) 2000 by Florian Klaempfl + + Includes the MIPS 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. + + *****************************************************************************} +unit CpuNode; + +{$I fpcdefs.inc} + +interface +{ This unit is used to define the specific CPU implementations. All needed +actions are included in the INITALIZATION part of these units. This explains +the behaviour of such a unit having just a USES clause! } + +implementation + + uses + { generic nodes } + ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,ncgopt,ncgmat,ncgobjc, + { to be able to only parts of the generic code, + the processor specific nodes must be included + after the generic one (FK) + } + ncpuadd,ncpucall,ncpumat,ncpuinln,ncpucnv,ncpuset; + +end. diff --git a/closures/compiler/mips/cpupara.pas b/closures/compiler/mips/cpupara.pas new file mode 100644 index 0000000000..c440940943 --- /dev/null +++ b/closures/compiler/mips/cpupara.pas @@ -0,0 +1,371 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl and David Zhang + + Calling conventions for the MIPSEL + + 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 cpupara; + +{$i fpcdefs.inc} + +interface + + uses + globtype, + cclasses, + aasmtai, + cpubase,cpuinfo, + symconst,symbase,symsym,symtype,symdef,paramgr,parabase,cgbase; + + type + TMIPSELParaManager=class(TParaManager) + function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override; + function get_volatile_registers_int(calloption : tproccalloption):TCpuRegisterSet;override; + function get_volatile_registers_fpu(calloption : tproccalloption):TCpuRegisterSet;override; + {Returns a structure giving the information on the storage of the parameter + (which must be an integer parameter) + @param(nr Parameter number of routine, starting from 1)} + 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; + function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override; + private + procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); + procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist; + var intparareg,parasize:longint); + end; + +implementation + + uses + cutils,verbose,systems, + defutil, + cgutils,cgobj; + + type + tparasupregs = array[0..5] of tsuperregister; + pparasupregs = ^tparasupregs; + const + paraoutsupregs : tparasupregs = (RS_R4, RS_R5, RS_R6, RS_R7, RS_R8, RS_R9); + parainsupregs : tparasupregs = (RS_R4, RS_R5, RS_R6, RS_R7, RS_R8, RS_R9); + + + function TMIPSELParaManager.get_volatile_registers_int(calloption : tproccalloption):TCpuRegisterSet; + begin + result:=[RS_R16..RS_R23]; + end; + + + function tMIPSELparamanager.get_volatile_registers_fpu(calloption : tproccalloption):TCpuRegisterSet; + begin + result:=[RS_F0..RS_F31]; + end; + + + procedure TMIPSELParaManager.GetIntParaLoc(calloption : tproccalloption; nr : longint;var cgpara : tcgpara); + var + paraloc : pcgparalocation; + begin + if nr<1 then + InternalError(2002100806); + cgpara.reset; + cgpara.size:=OS_INT; + cgpara.intsize:=tcgsize2size[OS_INT]; + cgpara.alignment:=std_param_align; + paraloc:=cgpara.add_location; + with paraloc^ do + begin + { The six first parameters are passed into registers } {MIPS first four} + dec(nr); + if nr<6 then //MIPSEL nr<6 + begin + loc:=LOC_REGISTER; + register:=newreg(R_INTREGISTER,(RS_R4+nr),R_SUBWHOLE); + end + else + begin + { The other parameters are passed on the stack } + loc:=LOC_REFERENCE; + reference.index:=NR_STACK_POINTER_REG; + reference.offset:=92+(nr-6)*4; + end; + size:=OS_INT; + end; + end; + + { true if a parameter is too large to copy and only the address is pushed } + function tMIPSELparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; + begin + result:=false; + { var,out,constref always require address } + if varspez in [vs_var,vs_out,vs_constref] then + begin + result:=true; + exit; + end; + case def.typ of + recorddef, + arraydef, + variantdef, + formaldef : + push_addr_param:=true; + objectdef : + result:=is_object(def); + stringdef : + result:=(tstringdef(def).stringtype in [st_shortstring,st_longstring]); + procvardef : + result:=not tprocvardef(def).is_addressonly; + setdef : + result:=not(is_smallset(def)); + end; + end; + + + procedure tMIPSELparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); + begin + p.funcretloc[side]:=get_funcretloc(p,side,p.returndef); + end; + + + function tMIPSELparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara; + var + paraloc : pcgparalocation; + retcgsize : tcgsize; + begin + result.init; + result.alignment:=get_para_align(p.proccalloption); + { void has no location } + if is_void(def) then + begin + paraloc:=result.add_location; + result.size:=OS_NO; + result.intsize:=0; + paraloc^.size:=OS_NO; + paraloc^.loc:=LOC_VOID; + exit; + end; + { Constructors return self instead of a boolean } + if (p.proctypeoption=potype_constructor) then + begin + retcgsize:=OS_ADDR; + result.intsize:=sizeof(pint); + end + else + begin + retcgsize:=def_cgsize(def); + result.intsize:=def.size; + end; + result.size:=retcgsize; + { Return is passed as var parameter } + if ret_in_param(def,p.proccalloption) then + begin + paraloc:=result.add_location; + paraloc^.loc:=LOC_REFERENCE; + paraloc^.size:=retcgsize; + exit; + end; + + paraloc:=result.add_location; + { Return in FPU register? } + if p.returndef.typ=floatdef then + begin + paraloc^.loc:=LOC_FPUREGISTER; + paraloc^.register:=NR_FPU_RESULT_REG; + if retcgsize=OS_F64 then + setsubreg(paraloc^.register,R_SUBFD); + paraloc^.size:=retcgsize; + end + else + { Return in register } + begin +{$ifndef cpu64bit} + if retcgsize in [OS_64,OS_S64] then + begin + { high } + paraloc^.loc:=LOC_REGISTER; + if side=callerside then + paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG + else + paraloc^.register:=NR_FUNCTION_RETURN64_HIGH_REG; + paraloc^.size:=OS_32; + { low } + paraloc:=result.add_location; + paraloc^.loc:=LOC_REGISTER; + if side=callerside then + paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG + else + paraloc^.register:=NR_FUNCTION_RETURN64_LOW_REG; + paraloc^.size:=OS_32; + end + else +{$endif cpu64bit} + begin + paraloc^.loc:=LOC_REGISTER; + paraloc^.size:=retcgsize; + if side=callerside then + paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize)) + else + paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize)); + end; + end + end; + + var + param_offset:array[0..20] of ^Aint; + + procedure tMIPSELparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;paras:tparalist; + var intparareg,parasize:longint); + var + paraloc : pcgparalocation; + i : integer; + hp : tparavarsym; + paracgsize : tcgsize; + hparasupregs : pparasupregs; + paralen : longint; + begin + if side=callerside then + hparasupregs:=@paraoutsupregs + else + hparasupregs:=@parainsupregs; + for i:=0 to paras.count-1 do + begin + + param_offset[i] := Nil; + 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.vardef) 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.vardef,p.proccalloption) then + paracgsize:=OS_ADDR + else + begin + paracgsize:=def_cgSize(hp.vardef); + 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; + paralen:=tcgsize2size[paracgsize]; + hp.paraloc[side].intsize:=paralen; + while paralen>0 do + begin + paraloc:=hp.paraloc[side].add_location; + { Floats are passed in int registers, + We can allocate at maximum 32 bits per register } + if paracgsize in [OS_64,OS_S64,OS_F32,OS_F64] then + paraloc^.size:=OS_32 + else + paraloc^.size:=paracgsize; + { ret in param? } + if vo_is_funcret in hp.varoptions then + begin + paraloc^.loc:=LOC_REFERENCE; + if side=callerside then + begin + paraloc^.reference.index := NR_STACK_POINTER_REG; + paraloc^.reference.offset:=target_info.first_parm_offset{1000}-12 - parasize; + end + else + begin + paraloc^.reference.index := NR_FRAME_POINTER_REG; + paraloc^.reference.offset:=target_info.first_parm_offset{1000}-4 - parasize; + param_offset[i] := @paraloc^.reference.offset; + end; + inc(parasize,align(tcgsize2size[paraloc^.size],sizeof(aint))); + end + { In case of po_delphi_nested_cc, the parent frame pointer + is always passed on the stack. } + else if (intparareg<=high(tparasupregs)) and + (not(vo_is_parentfp in hp.varoptions) or + not(po_delphi_nested_cc in p.procoptions)) then + begin + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=newreg(R_INTREGISTER,hparasupregs^[intparareg],R_SUBWHOLE); + inc(intparareg); + end + else + begin + paraloc^.loc:=LOC_REFERENCE; + if side=callerside then + begin + paraloc^.reference.index := {NR_R17;//}NR_STACK_POINTER_REG; + paraloc^.reference.offset:=target_info.first_parm_offset{1000}-12 - parasize; + end + else + begin + paraloc^.reference.index := {NR_R18;//}NR_FRAME_POINTER_REG; + paraloc^.reference.offset:=target_info.first_parm_offset{1000}-4 - parasize; + param_offset[i] := @paraloc^.reference.offset; + end; + { Parameters are aligned at 4 bytes } + inc(parasize,align(tcgsize2size[paraloc^.size],sizeof(aint))); + end; + dec(paralen,tcgsize2size[paraloc^.size]); + end; + end; + for i:=0 to paras.count-1 do + begin + if (side = calleeside) and (param_offset[i] <> nil) then + param_offset[i]^ := param_offset[i]^ + parasize - 8; + end; + end; + + + function TMIPSELParaManager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint; + var + intparareg, + parasize : longint; + begin + intparareg:=0; + parasize:=0; + { calculate the registers for the normal parameters } + create_paraloc_info_intern(p,callerside,p.paras,intparareg,parasize); + { append the varargs } + create_paraloc_info_intern(p,callerside,varargspara,intparareg,parasize); + result:=parasize; + end; + + + + function tMIPSELparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint; + var + intparareg, + parasize : longint; + begin + intparareg:=0; + parasize:=0; + create_paraloc_info_intern(p,side,p.paras,intparareg,parasize); + { Create Function result paraloc } + create_funcretloc_info(p,side); + { We need to return the size allocated on the stack } + result:=parasize; + end; + + +begin + ParaManager:=TMIPSELParaManager.create; +end. diff --git a/closures/compiler/mips/cpupi.pas b/closures/compiler/mips/cpupi.pas new file mode 100644 index 0000000000..1c2dd53afd --- /dev/null +++ b/closures/compiler/mips/cpupi.pas @@ -0,0 +1,76 @@ +{ + Copyright (c) 2002-2009 by Florian Klaempfl and David Zhang + + 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. + + **************************************************************************** +} +unit cpupi; + +{$i fpcdefs.inc} + +interface + + uses + cutils, + procinfo,cpuinfo, + psub; + + type + TMIPSProcInfo=class(tcgprocinfo) + public + constructor create(aparent:tprocinfo);override; + function calc_stackframe_size:longint;override; + end; + +implementation + + uses + systems,globals, + tgobj,paramgr,symconst; + + constructor tmipsprocinfo.create(aparent:tprocinfo); + begin + inherited create(aparent); + maxpushedparasize:=0; + end; + + + function TMIPSProcInfo.calc_stackframe_size:longint; + begin + { + Stackframe layout: + %fp + <locals> + <temp> + <arguments 6-n for calling> + %sp+92 + <space for arguments 0-5> \ + <return pointer for calling> | included in first_parm_offset + <register window save area for calling> / + %sp + + Alignment must be the max available, as doubles require + 8 byte alignment + } + result:=Align(tg.direction*tg.lasttemp+maxpushedparasize+target_info.first_parm_offset,current_settings.alignment.localalignmax); + end; + + +begin + cprocinfo:=TMIPSProcInfo; +end. diff --git a/closures/compiler/mips/cputarg.pas b/closures/compiler/mips/cputarg.pas new file mode 100644 index 0000000000..40fc726163 --- /dev/null +++ b/closures/compiler/mips/cputarg.pas @@ -0,0 +1,53 @@ +{ + Copyright (c) 2001 by Peter Vreman + + Includes the mips 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 } + +{$ifndef NOOPT} + ,aoptcpu +{$endif NOOPT} + +{************************************** + Targets +**************************************} + + {$ifndef NOTARGETLINUX} + ,t_linux + {$endif} + +{************************************** + Assemblers +**************************************} + + ,CpuGas + ; + +end. diff --git a/closures/compiler/mips/itcpugas.pas b/closures/compiler/mips/itcpugas.pas new file mode 100644 index 0000000000..294edf58c1 --- /dev/null +++ b/closures/compiler/mips/itcpugas.pas @@ -0,0 +1,101 @@ +{ + Copyright (c) 1998-2009 by Mazen NEIFER and David Zhang + + This unit contains the MIPS 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 + gas_op2str: array[tasmop] of string[15] = ({$INCLUDE strinst.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 rmipsstd.inc} + ); + + gas_regname_index: array[tregisterindex] of tregisterindex = ( + {$i rmipssri.inc} + ); + + +function findreg_by_gasname(const s: string): tregisterindex; +var + i, p: tregisterindex; +begin + for p := low(tregisterindex) to high(tregisterindex) do + begin + if gas_regname_table[gas_regname_index[p]] = s then + begin + findreg_by_gasname := gas_regname_index[p]; + exit + end; + end; + 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 + hr: tregister; + p: longint; +begin + { Double uses the same table as single } + hr := r; + case getsubreg(hr) of + R_SUBFD: + setsubreg(hr, R_SUBFS); + R_SUBL, R_SUBW, R_SUBD, R_SUBQ: + setsubreg(hr, R_SUBD); + end; + p := findreg_by_number(hr); + if p <> 0 then + Result := gas_regname_table[p] + else + Result := generic_regname(r); +end; + +end. +{ + $Log: itcpugas.pas,v $ + Revision 1.7 2005/02/14 17:13:10 peter + * truncate log + +} diff --git a/closures/compiler/mips/mipsreg.dat b/closures/compiler/mips/mipsreg.dat new file mode 100644 index 0000000000..c666d257cf --- /dev/null +++ b/closures/compiler/mips/mipsreg.dat @@ -0,0 +1,83 @@ +; +; MIPS registers +; +; layout +; <name>,<value>,<stdname>,<gasname>,<stabidx> +; +NO,$00,$00,INVALID,INVALID,-1,-1 + +R0,$01,$00,r0,r0,0,0 +R1,$01,$01,r1,r1,1,1 +R2,$01,$02,r2,r2,2,2 +R3,$01,$03,r3,r3,3,3 +R4,$01,$04,r4,r4,4,4 +R5,$01,$05,r5,r5,5,5 +R6,$01,$06,r6,r6,6,6 +R7,$01,$07,r7,r7,7,7 +R8,$01,$08,r8,r8,8,8 +R9,$01,$09,r9,r9,9,9 +R10,$01,$0a,r10,r10,10,10 +R11,$01,$0b,r11,r11,11,11 +R12,$01,$0c,r12,r12,12,12 +R13,$01,$0d,r13,r13,13,13 +R14,$01,$0e,r14,r14,14,14 +R15,$01,$0f,r15,r15,15,15 +R16,$01,$10,r16,r16,16,16 +R17,$01,$11,r17,r17,17,17 +R18,$01,$12,r18,r18,18,18 +R19,$01,$13,r19,r19,19,19 +R20,$01,$14,r20,r20,20,20 +R21,$01,$15,r21,r21,21,21 +R22,$01,$16,r22,r22,22,22 +R23,$01,$17,r23,r23,23,23 +R24,$01,$18,r24,r24,24,24 +R25,$01,$19,r25,r25,25,25 +R26,$01,$1a,r26,r26,26,26 +R27,$01,$1b,r27,r27,27,27 +R28,$01,$1c,r28,r28,28,28 +R29,$01,$1d,r29,r29,29,29 +R30,$01,$1e,r30,r30,30,30 +R31,$01,$1f,r31,r31,31,31 + +F0,$02,$00,F0,f0,32,32 +F1,$02,$01,F1,f1,33,33 +F2,$02,$02,F2,f2,34,34 +F3,$02,$03,F3,f3,35,35 +F4,$02,$04,F4,f4,36,36 +F5,$02,$05,F5,f5,37,37 +F6,$02,$06,F6,f6,38,38 +F7,$02,$07,F7,f7,39,39 +F8,$02,$08,F8,f8,40,40 +F9,$02,$09,F9,f9,41,41 +F10,$02,$0a,F10,f10,42,42 +F11,$02,$0b,F11,f11,43,43 +F12,$02,$0c,F12,f12,44,44 +F13,$02,$0d,F13,f13,45,45 +F14,$02,$0e,F14,f14,46,46 +F15,$02,$0f,F15,f15,47,47 +F16,$02,$10,F16,f16,48,48 +F17,$02,$11,F17,f17,49,49 +F18,$02,$12,F18,f18,50,50 +F19,$02,$13,F19,f19,51,51 +F20,$02,$14,F20,f20,52,52 +F21,$02,$15,F21,f21,53,53 +F22,$02,$16,F22,f22,54,54 +F23,$02,$17,F23,f23,55,55 +F24,$02,$18,F24,f24,56,56 +F25,$02,$19,F25,f25,57,57 +F26,$02,$1a,F26,f26,58,58 +F27,$02,$1b,F27,f27,59,59 +F28,$02,$1c,F28,f28,60,60 +F29,$02,$1d,F29,f29,61,61 +F30,$02,$1e,F30,f30,62,62 +F31,$02,$1f,F31,f31,63,63 + +PC,$05,$00,PC,pc,-1,-1 +HI,$05,$01,HI,hi,68,68 +LO,$05,$02,LO,lo,69,69 +CR,$05,$03,CR,cr,70,70 +FCR0,$05,$04,FCR0,fcr0,71,71 +FCR25,$05,$05,FCR25,fcr25,72,72 +FCR26,$05,$06,FCR26,fcr26,73,73 +FCR28,$05,$07,FCR28,fcr28,74,74 +FCSR,$05,$08,FCSR,fcsr,75,75 diff --git a/closures/compiler/mips/ncpuadd.pas b/closures/compiler/mips/ncpuadd.pas new file mode 100644 index 0000000000..e1ba25794b --- /dev/null +++ b/closures/compiler/mips/ncpuadd.pas @@ -0,0 +1,598 @@ +{ + Copyright (c) 2000-2009 by Florian Klaempfl and David Zhang + + Code generation for add nodes on the FVM32 + + 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 ncpuadd; + +{$i fpcdefs.inc} + +interface + +uses + node, ncgadd, cpubase, aasmbase, cgbase; + +type + tmipsaddnode = class(tcgaddnode) + private + function cmp64_lt(left_reg, right_reg: TRegister64): TRegister; + function cmp64_le(left_reg, right_reg: TRegister64): TRegister; + function cmp64_eq(left_reg, right_reg: TRegister64): TRegister; + function cmp64_ne(left_reg, right_reg: TRegister64): TRegister; + function cmp64_ltu(left_reg, right_reg: TRegister64): TRegister; + function cmp64_leu(left_reg, right_reg: TRegister64): TRegister; + + function GetRes_register(unsigned: boolean; this_reg, left_reg, right_reg: TRegister): TRegister; + function GetRes64_register(unsigned: boolean; {this_reg,} left_reg, right_reg: TRegister64): TRegister; + protected + procedure second_addfloat; override; + procedure second_cmpfloat; override; + procedure second_cmpboolean; override; + procedure second_cmpsmallset; override; + procedure second_cmp64bit; override; + procedure second_cmpordinal; override; + end; + +implementation + +uses + systems, + cutils, verbose, + paramgr, + aasmtai, aasmcpu, aasmdata, + defutil, + {cgbase,} cgcpu, cgutils, + cpupara, + ncon, nset, nadd, + ncgutil, cgobj; + +{***************************************************************************** + tmipsaddnode +*****************************************************************************} +function tmipsaddnode.GetRes_register(unsigned: boolean; this_reg, left_reg, right_reg: TRegister): TRegister; +var + tmp_asm_op: tasmop; +begin + case NodeType of + equaln: + tmp_asm_op := A_SEQ; + unequaln: + tmp_asm_op := A_SNE; + else + if not (unsigned) then + begin + if nf_swapped in flags then + case NodeType of + ltn: + tmp_asm_op := A_SGT; + lten: + tmp_asm_op := A_SGE; + gtn: + tmp_asm_op := A_SLT; + gten: + tmp_asm_op := A_SLE; + end + else + case NodeType of + ltn: + tmp_asm_op := A_SLT; + lten: + tmp_asm_op := A_SLE; + gtn: + tmp_asm_op := A_SGT; + gten: + tmp_asm_op := A_SGE; + end; + end + else + begin + if nf_swapped in Flags then + case NodeType of + ltn: + tmp_asm_op := A_SGTU; + lten: + tmp_asm_op := A_SGEU; + gtn: + tmp_asm_op := A_SLTU; + gten: + tmp_asm_op := A_SLEU; + end + else + case NodeType of + ltn: + tmp_asm_op := A_SLTU; + lten: + tmp_asm_op := A_SLEU; + gtn: + tmp_asm_op := A_SGTU; + gten: + tmp_asm_op := A_SGEU; + end; + end; + end; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(tmp_asm_op, this_reg, left_reg, right_reg)); + GetRes_register := this_reg; +end; + +function tmipsaddnode.cmp64_eq(left_reg, right_reg: TRegister64): TRegister; +var + lfcmp64_L4: tasmlabel; +begin + + current_asmdata.getjumplabel(lfcmp64_L4); + + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_LI, NR_TCR10, 0)); + + current_asmdata.CurrAsmList.concat(Taicpu.op_reg_reg_sym(A_BNE, left_reg.reghi, right_reg.reghi, lfcmp64_L4)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_sym(A_BNE, left_reg.reglo, right_reg.reglo, lfcmp64_L4)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_LI, NR_TCR10, 1)); + + cg.a_label(current_asmdata.CurrAsmList, lfcmp64_L4); + cmp64_eq := NR_TCR10; +end; + +function tmipsaddnode.cmp64_ne(left_reg, right_reg: TRegister64): TRegister; +var + lfcmp64_L4: tasmlabel; +begin + + current_asmdata.getjumplabel(lfcmp64_L4); + + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_LI, NR_TCR10, 1)); + + current_asmdata.CurrAsmList.concat(Taicpu.op_reg_reg_sym(A_BNE, left_reg.reghi, right_reg.reghi, lfcmp64_L4)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_sym(A_BNE, left_reg.reglo, right_reg.reglo, lfcmp64_L4)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_LI, NR_TCR10, 0)); + + cg.a_label(current_asmdata.CurrAsmList, lfcmp64_L4); + cmp64_ne := NR_TCR10; +end; + +function tmipsaddnode.cmp64_lt(left_reg, right_reg: TRegister64): TRegister; +var + lfcmp64_L4, lfcmp64_L5: tasmlabel; +begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_LI, NR_TCR10, 0)); + + current_asmdata.getjumplabel(lfcmp64_L4); + current_asmdata.getjumplabel(lfcmp64_L5); + + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SLT, NR_TCR11, left_reg.reghi, right_reg.reghi)); + current_asmdata.CurrAsmList.concat(Taicpu.op_reg_reg_sym(A_BNE, NR_TCR11, NR_R0, lfcmp64_L5)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(Taicpu.op_reg_reg_sym(A_BNE, left_reg.reghi, right_reg.reghi, lfcmp64_L4)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SLTU, NR_TCR11, left_reg.reglo, right_reg.reglo)); + current_asmdata.CurrAsmList.concat(Taicpu.op_reg_reg_sym(A_BNE, NR_TCR11, NR_R0, lfcmp64_L5)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(Taicpu.op_sym(A_B, lfcmp64_L4)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + + cg.a_label(current_asmdata.CurrAsmList, lfcmp64_L5); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_LI, NR_TCR10, 1)); + + cg.a_label(current_asmdata.CurrAsmList, lfcmp64_L4); + cmp64_lt := NR_TCR10; +end; + +function tmipsaddnode.cmp64_le(left_reg, right_reg: TRegister64): TRegister; +var + lfcmp64_L4, lfcmp64_L5: tasmlabel; +begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_LI, NR_TCR10, 0)); + + current_asmdata.getjumplabel(lfcmp64_L4); + current_asmdata.getjumplabel(lfcmp64_L5); + + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SLT, NR_TCR11, right_reg.reghi, left_reg.reghi)); + current_asmdata.CurrAsmList.concat(Taicpu.op_reg_reg_sym(A_BNE, NR_TCR11, NR_R0, lfcmp64_L4)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(Taicpu.op_reg_reg_sym(A_BNE, right_reg.reghi, left_reg.reghi, lfcmp64_L5)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SLTU, NR_TCR11, right_reg.reglo, left_reg.reglo)); + current_asmdata.CurrAsmList.concat(Taicpu.op_reg_reg_sym(A_BNE, NR_TCR11, NR_R0, lfcmp64_L4)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + + cg.a_label(current_asmdata.CurrAsmList, lfcmp64_L5); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_LI, NR_TCR10, 1)); + + cg.a_label(current_asmdata.CurrAsmList, lfcmp64_L4); + cmp64_le := NR_TCR10; +end; + +function tmipsaddnode.cmp64_ltu(left_reg, right_reg: TRegister64): TRegister; +var + lfcmp64_L4, lfcmp64_L5: tasmlabel; +begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_LI, NR_TCR10, 0)); + + current_asmdata.getjumplabel(lfcmp64_L4); + current_asmdata.getjumplabel(lfcmp64_L5); + + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SLTU, NR_TCR11, left_reg.reghi, right_reg.reghi)); + current_asmdata.CurrAsmList.concat(Taicpu.op_reg_reg_sym(A_BNE, NR_TCR11, NR_R0, lfcmp64_L5)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(Taicpu.op_reg_reg_sym(A_BNE, left_reg.reghi, right_reg.reghi, lfcmp64_L4)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SLTU, NR_TCR11, left_reg.reglo, right_reg.reglo)); + current_asmdata.CurrAsmList.concat(Taicpu.op_reg_reg_sym(A_BNE, NR_TCR11, NR_R0, lfcmp64_L5)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(Taicpu.op_sym(A_B, lfcmp64_L4)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + + cg.a_label(current_asmdata.CurrAsmList, lfcmp64_L5); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_LI, NR_TCR10, 1)); + + cg.a_label(current_asmdata.CurrAsmList, lfcmp64_L4); + cmp64_ltu := NR_TCR10; +end; + +function tmipsaddnode.cmp64_leu(left_reg, right_reg: TRegister64): TRegister; +var + lfcmp64_L4, lfcmp64_L5: tasmlabel; +begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_LI, NR_TCR10, 0)); + + current_asmdata.getjumplabel(lfcmp64_L4); + current_asmdata.getjumplabel(lfcmp64_L5); + + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SLTU, NR_TCR11, right_reg.reghi, left_reg.reghi)); + current_asmdata.CurrAsmList.concat(Taicpu.op_reg_reg_sym(A_BNE, NR_TCR11, NR_R0, lfcmp64_L4)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(Taicpu.op_reg_reg_sym(A_BNE, right_reg.reghi, left_reg.reghi, lfcmp64_L5)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SLTU, NR_TCR11, right_reg.reglo, left_reg.reglo)); + current_asmdata.CurrAsmList.concat(Taicpu.op_reg_reg_sym(A_BNE, NR_TCR11, NR_R0, lfcmp64_L4)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + + cg.a_label(current_asmdata.CurrAsmList, lfcmp64_L5); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_LI, NR_TCR10, 1)); + + cg.a_label(current_asmdata.CurrAsmList, lfcmp64_L4); + cmp64_leu := NR_TCR10; +end; + +function tmipsaddnode.GetRes64_register(unsigned: boolean; //this_reg: TRegister; + left_reg, right_reg: TRegister64): TRegister; +var + tmpreg: TRegister; + lfcmp64_L4, lfcmp_L5: tasmlabel; +begin + case NodeType of + equaln: + begin + GetRes64_register := cmp64_eq(left_reg, right_reg); + end; + unequaln: + GetRes64_register := cmp64_ne(left_reg, right_reg); + else + if not (unsigned) then + begin + if nf_swapped in flags then + case NodeType of + ltn: + GetRes64_register := cmp64_lt(right_reg, left_reg); + lten: + GetRes64_register := cmp64_le(right_reg, left_reg); + gtn: + GetRes64_register := cmp64_lt(left_reg, right_reg); + gten: + GetRes64_register := cmp64_le(left_reg, right_reg); + end + else + case NodeType of + ltn: + GetRes64_register := cmp64_lt(left_reg, right_reg); + lten: + GetRes64_register := cmp64_le(left_reg, right_reg); + gtn: + GetRes64_register := cmp64_lt(right_reg, left_reg); + gten: + GetRes64_register := cmp64_le(right_reg, left_reg); + end; + end + else + begin + if nf_swapped in Flags then + case NodeType of + ltn: + GetRes64_register := cmp64_ltu(right_reg, left_reg); + lten: + GetRes64_register := cmp64_leu(right_reg, left_reg); + gtn: + GetRes64_register := cmp64_ltu(left_reg, right_reg); + gten: + GetRes64_register := cmp64_leu(left_reg, right_reg); + end + else + case NodeType of + ltn: + GetRes64_register := cmp64_ltu(left_reg, right_reg); + lten: + GetRes64_register := cmp64_leu(left_reg, right_reg); + gtn: + GetRes64_register := cmp64_ltu(right_reg, left_reg); + gten: + GetRes64_register := cmp64_leu(right_reg, left_reg); + end; + end; + end; +end; + +procedure tmipsaddnode.second_addfloat; +var + op: TAsmOp; +begin + pass_left_right; + if (nf_swapped in flags) then + swapleftright; + + { force fpureg as location, left right doesn't matter + as both will be in a fpureg } + location_force_fpureg(current_asmdata.CurrAsmList, left.location, True); + location_force_fpureg(current_asmdata.CurrAsmList, right.location, (left.location.loc <> LOC_CFPUREGISTER)); + + location_reset(location, LOC_FPUREGISTER, def_cgsize(resultdef)); + if left.location.loc <> LOC_CFPUREGISTER then + location.Register := left.location.Register + else + location.Register := right.location.Register; + + case nodetype of + addn: + begin + if location.size = OS_F64 then + op := A_ADD_D + else + op := A_ADD_S; + end; + muln: + begin + if location.size = OS_F64 then + op := A_MUL_D + else + op := A_MUL_S; + end; + subn: + begin + if location.size = OS_F64 then + op := A_SUB_D + else + op := A_SUB_S; + end; + slashn: + begin + if location.size = OS_F64 then + op := A_DIV_D + else + op := A_DIV_S; + end; + else + internalerror(200306014); + end; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op, + location.Register, left.location.Register, right.location.Register)); + +end; + + +procedure tmipsaddnode.second_cmpfloat; +var + op: tasmop; + lfcmptrue, lfcmpfalse: tasmlabel; +begin + pass_left_right; + if nf_swapped in flags then + swapleftright; + + { force fpureg as location, left right doesn't matter + as both will be in a fpureg } + location_force_fpureg(current_asmdata.CurrAsmList, left.location, True); + location_force_fpureg(current_asmdata.CurrAsmList, right.location, True); + + location_reset(location, LOC_REGISTER, OS_INT); + location.Register := NR_TCR0; + + case NodeType of + equaln: + begin + if left.location.size = OS_F64 then + op := A_C_EQ_D + else + op := A_C_EQ_S; + current_asmdata.getjumplabel(lfcmpfalse); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_OR, location.Register {NR_TCR0}, NR_R0, NR_R0)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op, left.location.Register, right.location.Register)); + current_asmdata.CurrAsmList.concat(Taicpu.op_sym(A_BC1F, lfcmpfalse)); //lfcmpfalse + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_ORI, location.Register{NR_TCR0}, NR_R0, 1)); + cg.a_label(current_asmdata.CurrAsmList, lfcmpfalse); + + end; + unequaln: + begin + if left.location.size = OS_F64 then + op := A_C_EQ_D + else + op := A_C_EQ_S; + current_asmdata.getjumplabel(lfcmpfalse); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_ORI, location.Register{NR_TCR0}, NR_R0, 1)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op, left.location.Register, right.location.Register)); + current_asmdata.CurrAsmList.concat(Taicpu.op_sym(A_BC1F, lfcmpfalse)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_OR, location.Register {NR_TCR0}, NR_R0, NR_R0)); + cg.a_label(current_asmdata.CurrAsmList, lfcmpfalse); + end; + ltn: + begin + if left.location.size = OS_F64 then + op := A_C_LT_D + else + op := A_C_LT_S; + current_asmdata.getjumplabel(lfcmptrue); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_ORI, location.Register{NR_TCR0}, NR_R0, 1)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op, left.location.Register, right.location.Register)); + current_asmdata.CurrAsmList.concat(Taicpu.op_sym(A_BC1T, lfcmptrue)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_OR, location.Register {NR_TCR0}, NR_R0, NR_R0)); + cg.a_label(current_asmdata.CurrAsmList, lfcmptrue); + end; + lten: + begin + if left.location.size = OS_F64 then + op := A_C_LE_D + else + op := A_C_LE_S; + current_asmdata.getjumplabel(lfcmptrue); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_ORI, location.Register{NR_TCR0}, NR_R0, 1)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op, left.location.Register, right.location.Register)); + current_asmdata.CurrAsmList.concat(Taicpu.op_sym(A_BC1T, lfcmptrue)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_OR, location.Register {NR_TCR0}, NR_R0, NR_R0)); + cg.a_label(current_asmdata.CurrAsmList, lfcmptrue); + end; + gtn: + begin + if left.location.size = OS_F64 then + op := A_C_LT_D + else + op := A_C_LT_S; + current_asmdata.getjumplabel(lfcmptrue); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_ORI, location.Register{NR_TCR0}, NR_R0, 1)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op, right.location.Register, left.location.Register)); + current_asmdata.CurrAsmList.concat(Taicpu.op_sym(A_BC1T, lfcmptrue)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_OR, location.Register {NR_TCR0}, NR_R0, NR_R0)); + cg.a_label(current_asmdata.CurrAsmList, lfcmptrue); + end; + gten: + begin + if left.location.size = OS_F64 then + op := A_C_LE_D + else + op := A_C_LE_S; + current_asmdata.getjumplabel(lfcmptrue); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_ORI, location.Register{NR_TCR0}, NR_R0, 1)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op, right.location.Register, left.location.Register)); + current_asmdata.CurrAsmList.concat(Taicpu.op_sym(A_BC1T, lfcmptrue)); + current_asmdata.CurrAsmList.concat(TAiCpu.Op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_OR, location.Register {NR_TCR0}, NR_R0, NR_R0)); + cg.a_label(current_asmdata.CurrAsmList, lfcmptrue); + end; + end; {case} +end; + + +procedure tmipsaddnode.second_cmpboolean; +var + tmp_right_reg: TRegister; +begin + pass_left_right; + force_reg_left_right(True, True); + tmp_right_reg := NR_NO; + if right.location.loc = LOC_CONSTANT then + begin + tmp_right_reg := cg.GetIntRegister(current_asmdata.CurrAsmList, OS_INT); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_LI, tmp_right_reg, right.location.Value)); + end + else + begin + tmp_right_reg := right.location.Register; + end; + + location_reset(location, LOC_REGISTER, OS_INT); + location.Register := GetRes_register(True, NR_TCR0, left.location.Register, tmp_right_reg); + +end; + + +procedure tmipsaddnode.second_cmpsmallset; +var + tmp_right_reg: TRegister; +begin + pass_left_right; + force_reg_left_right(True, True); + + tmp_right_reg := NR_NO; + + if right.location.loc = LOC_CONSTANT then + begin + tmp_right_reg := cg.GetIntRegister(current_asmdata.CurrAsmList, OS_INT); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_LI, tmp_right_reg, right.location.Value)); + end + else + begin + tmp_right_reg := right.location.Register; + end; + + + location_reset(location, LOC_REGISTER, OS_INT); + location.Register := GetRes_register(True, NR_TCR0, left.location.Register, tmp_right_reg); +end; + + +procedure tmipsaddnode.second_cmp64bit; +var + unsigned : boolean; + tmp_left_reg: TRegister; + +begin + pass_left_right; + force_reg_left_right(false,false); + + unsigned:=not(is_signed(left.resultdef)) or + not(is_signed(right.resultdef)); + + location_reset(location, LOC_REGISTER, OS_INT); + location.Register := GetRes64_register(unsigned, {NR_TCR0, }left.location.register64, right.location.register64); // NR_TCR0; +end; + + +procedure tmipsaddnode.second_cmpordinal; +var + unsigned: boolean; + tmp_right_reg: TRegister; +begin + pass_left_right; + force_reg_left_right(True, True); + unsigned := not (is_signed(left.resultdef)) or not (is_signed(right.resultdef)); + + tmp_right_reg := NR_NO; + if right.location.loc = LOC_CONSTANT then + begin + tmp_right_reg := cg.GetIntRegister(current_asmdata.CurrAsmList, OS_INT); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_LI, tmp_right_reg, right.location.Value)); + end + else + begin + tmp_right_reg := right.location.Register; + end; + location_reset(location, LOC_REGISTER, OS_INT); + location.Register := getres_register(unsigned, NR_TCR0, left.location.Register, tmp_right_reg); +end; + +begin + caddnode := tmipsaddnode; +end. diff --git a/closures/compiler/mips/ncpucall.pas b/closures/compiler/mips/ncpucall.pas new file mode 100644 index 0000000000..65db4569c9 --- /dev/null +++ b/closures/compiler/mips/ncpucall.pas @@ -0,0 +1,62 @@ +{ + Copyright (c) 1998-2009 by Florian Klaempfl and David Zhang + + Generate MIPSEL assembler for in 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 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 ncpucall; + +{$i fpcdefs.inc} + +interface + +uses + ncgcal; + +type + tMIPSELcallnode = class(tcgcallnode) + procedure extra_call_code; override; + procedure extra_post_call_code; override; + end; + + +implementation + +uses + cpubase, + aasmtai,aasmcpu,aasmdata, + paramgr, + ncal; + +procedure tMIPSELcallnode.extra_call_code; +begin + if pushedparasize > 0 then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_ADDIU, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, -pushedparasize)); +end; + +procedure tMIPSELcallnode.extra_post_call_code; +begin + if pushedparasize > 0 then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_ADDIU, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, pushedparasize)); + +end; + + +begin + ccallnode := TMIPSELCallNode; +end. diff --git a/closures/compiler/mips/ncpucnv.pas b/closures/compiler/mips/ncpucnv.pas new file mode 100644 index 0000000000..18743252ad --- /dev/null +++ b/closures/compiler/mips/ncpucnv.pas @@ -0,0 +1,286 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl and David Zhang + + Generate MIPSEL 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 ncpucnv; + +{$i fpcdefs.inc} + +interface + +uses + node, ncnv, ncgcnv, defcmp; + +type + tMIPSELtypeconvnode = class(TCgTypeConvNode) + protected + { 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, aasmdata, + defutil, + cgbase, cgutils, pass_1, pass_2, procinfo, + ncon, ncal, + ncgutil, + cpubase, aasmcpu, + tgobj, cgobj; + + +{***************************************************************************** + FirstTypeConv +*****************************************************************************} + +function tMIPSELtypeconvnode.first_int_to_real: tnode; +var + fname: string[19]; +begin + { converting a 64bit integer to a float requires a helper } + if is_64bitint(left.resultdef) or + is_currency(left.resultdef) then + begin + { hack to avoid double division by 10000, as it's + already done by resulttypepass.resulttype_int_to_real } + if is_currency(left.resultdef) then + left.resultdef := s64inttype; + if is_signed(left.resultdef) 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.resultdef) then + inserttypeconv(left, s32inttype) + else + inserttypeconv(left, u32inttype); + firstpass(left); + end; + Result := nil; + expectloc := LOC_FPUREGISTER; +end; + + +{***************************************************************************** + SecondTypeConv +*****************************************************************************} + +procedure tMIPSELtypeconvnode.second_int_to_real; + + procedure loadsigned; + begin + location_force_mem(current_asmdata.CurrAsmList, left.location); + location.Register := cg.getfpuregister(current_asmdata.CurrAsmList, location.size); + { Load memory in fpu register } + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList, OS_F32, OS_F32, left.location.reference, location.Register); + tg.ungetiftemp(current_asmdata.CurrAsmList, left.location.reference); + { Convert value in fpu register from integer to float } + case tfloatdef(resultdef).floattype of + s32real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVT_S_W, location.Register, location.Register)); + s64real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVT_D_W, location.Register, location.Register)); + else + internalerror(200408011); + end; + end; + +var + href: treference; + hregister: tregister; + l1, l2: tasmlabel; + +begin + location_reset(location, LOC_FPUREGISTER, def_cgsize(resultdef)); + if is_signed(left.resultdef) then + loadsigned + else + begin + current_asmdata.getdatalabel(l1); + current_asmdata.getjumplabel(l2); + reference_reset_symbol(href, l1, 0, sizeof(aint)); + hregister := cg.getintregister(current_asmdata.CurrAsmList, OS_32); + cg.a_load_loc_reg(current_asmdata.CurrAsmList, OS_32, left.location, hregister); + + loadsigned; + + current_asmdata.CurrAsmList.concat(Taicpu.op_reg_reg_sym(A_BGE, hregister, NR_R0, l2)); + + case tfloatdef(resultdef).floattype of + { converting dword to s64real first and cut off at the end avoids precision loss } + s32real, + s64real: + begin + hregister := cg.getfpuregister(current_asmdata.CurrAsmList, OS_F64); + new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,l1.name,const_align(8)); + current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l1)); + + { I got this constant from a test program (FK) } + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit(0)); + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit($0000f041)); + + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList, OS_F64, OS_F64, href, hregister); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ADD_D, location.Register, hregister, location.Register)); + cg.a_label(current_asmdata.CurrAsmList, l2); + + { cut off if we should convert to single } + if tfloatdef(resultdef).floattype = s32real then + begin + hregister := location.Register; + location.Register := cg.getfpuregister(current_asmdata.CurrAsmList, location.size); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVT_S_D, location.Register, hregister)); + end; + end; + else + internalerror(200410031); + end; + end; +end; + + +procedure tMIPSELtypeconvnode.second_real_to_real; +const + conv_op: array[tfloattype, tfloattype] of tasmop = ( + { from: s32 s64 s80 sc80 c64 cur f128 } + { s32 } (A_MOV_S, A_CVT_S_D, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE), + { s64 } (A_CVT_D_S, A_MOV_D, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE), + { s80 } (A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE), + { sc80 } (A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE), + { c64 } (A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE), + { cur } (A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE), + { f128 } (A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE) + ); +var + op: tasmop; +begin + location_reset(location, LOC_FPUREGISTER, def_cgsize(resultdef)); + location_force_fpureg(current_asmdata.CurrAsmList, left.location, False); + { Convert value in fpu register from integer to float } + op := conv_op[tfloatdef(resultdef).floattype, tfloatdef(left.resultdef).floattype]; + if op = A_NONE then + internalerror(200401121); + location.Register := cg.getfpuregister(current_asmdata.CurrAsmList, location.size); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op, location.Register, left.location.Register)); +end; + + +procedure tMIPSELtypeconvnode.second_int_to_bool; +var + hreg1, hreg2: tregister; + opsize: tcgsize; + hlabel, oldtruelabel, oldfalselabel: tasmlabel; +begin + oldtruelabel := current_procinfo.CurrTrueLabel; + oldfalselabel := current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + 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.resultdef.size = resultdef.size) and + (left.location.loc in [LOC_REFERENCE, LOC_CREFERENCE, LOC_CREGISTER]) then + begin + location_copy(location, left.location); + current_procinfo.CurrTrueLabel := oldtruelabel; + current_procinfo.CurrFalseLabel := oldfalselabel; + exit; + end; + location_reset(location, LOC_REGISTER, def_cgsize(resultdef)); + opsize := def_cgsize(left.resultdef); + case left.location.loc of + LOC_CREFERENCE, LOC_REFERENCE, LOC_REGISTER, LOC_CREGISTER: + begin + if left.location.loc in [LOC_CREFERENCE, LOC_REFERENCE] then + begin + hreg2 := cg.getintregister(current_asmdata.CurrAsmList, opsize); + cg.a_load_ref_reg(current_asmdata.CurrAsmList, opsize, opsize, left.location.reference, hreg2); + end + else + hreg2 := left.location.Register; +{$ifndef cpu64bit} + if left.location.size in [OS_64, OS_S64] then + begin + hreg1 := cg.getintregister(current_asmdata.CurrAsmList, OS_32); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_OR, OS_32, hreg2, tregister(succ(longint(hreg2))), hreg1); + hreg2 := hreg1; + opsize := OS_32; + end; +{$endif cpu64bit} + hreg1 := cg.getintregister(current_asmdata.CurrAsmList, opsize); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SNE, hreg1, hreg2, NR_R0)); + end; + LOC_JUMP: + begin + hreg1 := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + current_asmdata.getjumplabel(hlabel); + cg.a_label(current_asmdata.CurrAsmList, current_procinfo.CurrTrueLabel); + cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, 1, hreg1); + cg.a_jmp_always(current_asmdata.CurrAsmList, hlabel); + cg.a_label(current_asmdata.CurrAsmList, current_procinfo.CurrFalseLabel); + cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, 0, hreg1); + cg.a_label(current_asmdata.CurrAsmList, hlabel); + end; + else + internalerror(10062); + end; + location.Register := hreg1; + + if location.size in [OS_64, OS_S64] then + internalerror(200408241); + + current_procinfo.CurrTrueLabel := oldtruelabel; + current_procinfo.CurrFalseLabel := oldfalselabel; +end; + + +begin + ctypeconvnode := tMIPSELtypeconvnode; +end. diff --git a/closures/compiler/mips/ncpuinln.pas b/closures/compiler/mips/ncpuinln.pas new file mode 100644 index 0000000000..5470e9492e --- /dev/null +++ b/closures/compiler/mips/ncpuinln.pas @@ -0,0 +1,138 @@ +{ + Copyright (c) 1998-2009 by Florian Klaempfl and David Zhang + + Generate MIPSEL 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 ncpuinln; + +{$i fpcdefs.inc} + +interface + +uses + node, ninl, ncginl; + +type + tMIPSELinlinenode = class(tcgInlineNode) + function first_abs_real: tnode; override; + function first_sqr_real: tnode; override; + function first_sqrt_real: tnode; override; + procedure second_abs_real; override; + procedure second_sqr_real; override; + procedure second_sqrt_real; override; + private + procedure load_fpu_location; + end; + + +implementation + +uses + systems, + globtype, + cutils, verbose, + symconst, symdef, + aasmtai, aasmcpu, aasmdata, + cgbase, pass_2, + cpubase, paramgr, + nbas, ncon, ncal, ncnv, nld, + ncgutil, cgobj, cgutils; + +{***************************************************************************** + tMIPSELinlinenode +*****************************************************************************} + +procedure tMIPSELinlinenode.load_fpu_location; +begin + secondpass(left); + location_force_fpureg(current_asmdata.CurrAsmList, left.location, True); + location_copy(location, left.location); + if left.location.loc = LOC_CFPUREGISTER then + begin + location.Register := cg.getfpuregister(current_asmdata.CurrAsmList, location.size); + location.loc := LOC_FPUREGISTER; + end; +end; + + +function tMIPSELinlinenode.first_abs_real: tnode; +begin + expectloc := LOC_FPUREGISTER; + first_abs_real := nil; +end; + + +function tMIPSELinlinenode.first_sqr_real: tnode; +begin + expectloc := LOC_FPUREGISTER; + first_sqr_real := nil; +end; + + +function tMIPSELinlinenode.first_sqrt_real: tnode; +begin + expectloc := LOC_FPUREGISTER; + first_sqrt_real := nil; +end; + + +procedure tMIPSELinlinenode.second_abs_real; +begin + load_fpu_location; + case tfloatdef(left.resultdef).floattype of + s32real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_ABS_s, location.Register, left.location.Register)); + s64real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_ABS_d, location.Register, left.location.Register)); + else + internalerror(200410031); + end; +end; + + +procedure tMIPSELinlinenode.second_sqr_real; +begin + load_fpu_location; + case tfloatdef(left.resultdef).floattype of + s32real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MUL_s, location.Register, left.location.Register, left.location.Register)); + s64real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MUL_d, location.Register, left.location.Register, left.location.Register)); + else + internalerror(200410032); + end; +end; + + +procedure tMIPSELinlinenode.second_sqrt_real; +begin + load_fpu_location; + case tfloatdef(left.resultdef).floattype of + s32real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_SQRT_s, location.Register, left.location.Register)); + s64real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_SQRT_d, location.Register, left.location.Register)); + else + internalerror(200410033); + end; +end; + +begin + cInlineNode := tMIPSELinlinenode; +end. diff --git a/closures/compiler/mips/ncpumat.pas b/closures/compiler/mips/ncpumat.pas new file mode 100644 index 0000000000..43d09598e8 --- /dev/null +++ b/closures/compiler/mips/ncpumat.pas @@ -0,0 +1,302 @@ +{ +David Zhang 2007/01/15 + $Id: ncpumat.pas,v 1.23 2005/02/14 17:13:10 peter Exp $ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate MIPSel 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 ncpumat; + +{$i fpcdefs.inc} + +interface + +uses + node, nmat, ncgmat; + +type + tMIPSELmoddivnode = class(tmoddivnode) + procedure pass_generate_code;override; + end; + + tMIPSELshlshrnode = class(tshlshrnode) + procedure pass_generate_code;override; + { everything will be handled in pass_2 } + function first_shlshr64bitint: tnode; override; + end; + + tMIPSELnotnode = class(tcgnotnode) + procedure second_boolean; override; + end; + +implementation + +uses + globtype, systems, + cutils, verbose, globals, + symconst, + aasmbase, aasmcpu, aasmtai, aasmdata, + defutil, + procinfo, + cgbase, cgobj, pass_2, + ncon, + cpubase, + ncgutil, cgcpu, cgutils; + +{***************************************************************************** + TMipselMODDIVNODE +*****************************************************************************} + +procedure tMIPSELmoddivnode.pass_generate_code; +var + power: longint; + tmpreg, numerator, divider, resultreg: tregister; +begin + secondpass(left); + secondpass(right); + location_copy(location, left.location); + + { put numerator in register } + location_force_reg(current_asmdata.CurrAsmList, left.location, def_cgsize(left.resultdef), True); + location_copy(location, left.location); + numerator := location.Register; + + if (nodetype = modn) then + resultreg := cg.GetIntRegister(current_asmdata.CurrAsmList, OS_INT) + else + begin + if (location.loc = LOC_CREGISTER) then + begin + location.loc := LOC_REGISTER; + location.Register := cg.GetIntRegister(current_asmdata.CurrAsmList, OS_INT); + end; + resultreg := location.Register; + end; + + if (nodetype = divn) and + (right.nodetype = ordconstn) and + ispowerof2(tordconstnode(right).Value.svalue, power) then + begin + tmpreg := cg.GetIntRegister(current_asmdata.CurrAsmList, OS_INT); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SAR, OS_INT, 31, numerator, tmpreg); + { if signed, tmpreg=right value-1, otherwise 0 } + cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, tordconstnode(right).Value.svalue - 1, tmpreg); + { add to the left value } + cg.a_op_reg_reg(current_asmdata.CurrAsmList, OP_ADD, OS_INT, tmpreg, numerator); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SAR, OS_INT, aword(power), numerator, resultreg); + end + else + begin + { load divider in a register if necessary } + location_force_reg(current_asmdata.CurrAsmList, right.location, + def_cgsize(right.resultdef), True); + divider := right.location.Register; + + + if (nodetype = modn) then + begin + if is_signed(right.resultdef) then + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_REM, resultreg, numerator, divider)); + end + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_REMU, resultreg, numerator, divider)); + end + else + begin + if is_signed({left.resultdef}right.resultdef) then + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_DIV, resultreg, numerator, divider)); + end + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_DIVU, resultreg, numerator, divider)); + end; + end; + { set result location } + location.loc := LOC_REGISTER; + location.Register := resultreg; +end; + + +{***************************************************************************** + TMIPSelSHLRSHRNODE +*****************************************************************************} + +function TMIPSELShlShrNode.first_shlshr64bitint: TNode; +begin + { 64bit without constants need a helper } + if is_64bit(left.resultdef) and + (right.nodetype <> ordconstn) then + begin + Result := inherited first_shlshr64bitint; + exit; + end; + + Result := nil; +end; + + +procedure tMIPSELshlshrnode.pass_generate_code; +var + hregister, resultreg, hregister1, hreg64hi, hreg64lo: tregister; + op: topcg; + shiftval: aword; +begin + { 64bit without constants need a helper, and is + already replaced in pass1 } + if is_64bit(left.resultdef) and + (right.nodetype <> ordconstn) then + internalerror(200405301); + + secondpass(left); + secondpass(right); + if is_64bit(left.resultdef) then + begin + location_reset(location, LOC_REGISTER, OS_64); + + { load left operator in a register } + location_force_reg(current_asmdata.CurrAsmList, left.location, OS_64, False); + + + hreg64hi := left.location.register64.reghi; + hreg64lo := left.location.register64.reglo; + + shiftval := tordconstnode(right).Value.svalue and 63; + if shiftval > 31 then + begin + if nodetype = shln then + begin + cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_32, 0, hreg64hi); + if (shiftval and 31) <> 0 then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHL, OS_32, shiftval and 31, hreg64lo, hreg64lo); + end + else + begin + cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_32, 0, hreg64lo); + if (shiftval and 31) <> 0 then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_32, shiftval and 31, hreg64hi, hreg64hi); + end; + location.register64.reglo := hreg64hi; + location.register64.reghi := hreg64lo; + end + else + begin + hregister := cg.getintregister(current_asmdata.CurrAsmList, OS_32); + if nodetype = shln then + begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_32, 32 - shiftval, hreg64lo, hregister); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHL, OS_32, shiftval, hreg64hi, hreg64hi); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_OR, OS_32, hregister, hreg64hi, hreg64hi); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHL, OS_32, shiftval, hreg64lo, hreg64lo); + end + else + begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHL, OS_32, 32 - shiftval, hreg64hi, hregister); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_32, shiftval, hreg64lo, hreg64lo); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_OR, OS_32, hregister, hreg64lo, hreg64lo); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_32, shiftval, hreg64hi, hreg64hi); + end; + location.register64.reghi := hreg64hi; + location.register64.reglo := hreg64lo; + end; + end + else + begin + { load left operators in a register } + location_force_reg(current_asmdata.CurrAsmList, left.location, def_cgsize(left.resultdef), True); + location_copy(location, left.location); + resultreg := location.Register; + hregister1 := location.Register; + if (location.loc = LOC_CREGISTER) then + begin + location.loc := LOC_REGISTER; + resultreg := cg.GetIntRegister(current_asmdata.CurrAsmList, OS_INT); + location.Register := resultreg; + end; + { determine operator } + if nodetype = shln then + op := OP_SHL + else + op := OP_SHR; + { shifting by a constant directly coded: } + if (right.nodetype = ordconstn) then + begin + if tordconstnode(right).Value.svalue and 31 <> 0 then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, op, OS_32, tordconstnode(right).Value.svalue and 31, hregister1, resultreg); + end + else + begin + { load shift count in a register if necessary } + location_force_reg(current_asmdata.CurrAsmList, right.location, def_cgsize(right.resultdef), True); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, op, OS_32, right.location.Register, hregister1, resultreg); + end; + end; +end; + + +{***************************************************************************** + TMIPSelNOTNODE +*****************************************************************************} + +procedure tMIPSELnotnode.second_boolean; +var + hl: tasmlabel; +begin + { if the location is LOC_JUMP, we do the secondpass after the + labels are allocated + } + if left.expectloc = LOC_JUMP then + begin + hl := current_procinfo.CurrTrueLabel; + current_procinfo.CurrTrueLabel := current_procinfo.CurrFalseLabel; + current_procinfo.CurrFalseLabel := hl; + secondpass(left); + maketojumpbool(current_asmdata.CurrAsmList, left, lr_load_regvars); + hl := current_procinfo.CurrTrueLabel; + current_procinfo.CurrTrueLabel := current_procinfo.CurrFalseLabel; + current_procinfo.CurrFalseLabel := hl; + location.loc := LOC_JUMP; + end + else + begin + secondpass(left); + case left.location.loc of + LOC_FLAGS: + begin + internalerror(2007011501); + end; + LOC_REGISTER, LOC_CREGISTER, LOC_REFERENCE, LOC_CREFERENCE: + begin + location_force_reg(current_asmdata.CurrAsmList, left.location, def_cgsize(left.resultdef), True); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SEQ, NR_TCR0, left.location.Register, NR_R0)); + location_reset(location, LOC_REGISTER, OS_INT); + location.Register := NR_TCR0; + end; + else + internalerror(2003042401); + end; + end; +end; + + +begin + cmoddivnode := tMIPSELmoddivnode; + cshlshrnode := tMIPSELshlshrnode; + cnotnode := tMIPSELnotnode; +end. diff --git a/closures/compiler/mips/ncpuset.pas b/closures/compiler/mips/ncpuset.pas new file mode 100644 index 0000000000..ec311d1e05 --- /dev/null +++ b/closures/compiler/mips/ncpuset.pas @@ -0,0 +1,130 @@ +{ + Copyright (c) 1998-2004 by Florian Klaempfl and David Zhang + + Generate MIPSEL assembler for in set/case 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 ncpuset; + +{$i fpcdefs.inc} + +interface + +uses + globtype, + nset, + ncgset; + +type + tcpucasenode = class(tcgcasenode) + protected + procedure optimizevalues(var max_linear_list: aint; var max_dist: aword); override; + function has_jumptable: boolean; override; + procedure genjumptable(hp: pcaselabel; min_, max_: aint); override; + end; + + +implementation + +uses + globals, + systems, + constexp, + cpubase, + aasmbase, aasmtai, aasmcpu, aasmdata, + cgbase, cgutils, cgobj, + procinfo; + +procedure tcpucasenode.optimizevalues(var max_linear_list: aint; var max_dist: aword); +begin + { give the jump table a higher priority } + max_dist := (max_dist * 3) div 2; +end; + + +function tcpucasenode.has_jumptable: boolean; +begin + has_jumptable := True; +end; + + +procedure tcpucasenode.genjumptable(hp: pcaselabel; min_, max_: aint); +var + table: tasmlabel; + last: TConstExprInt; + indexreg, jmpreg, basereg: tregister; + href: treference; + jumpsegment: TAsmlist; + + procedure genitem(t: pcaselabel); + var + i: aint; + begin + if assigned(t^.less) then + genitem(t^.less); + { fill possible hole } + for i := last.svalue+1 to t^._low.svalue-1 do + jumpSegment.concat(Tai_const.Create_sym(elselabel)); + for i := t^._low.svalue to t^._high.svalue do + jumpSegment.concat(Tai_const.Create_sym(blocklabel(t^.blockid))); + last := t^._high; + if assigned(t^.greater) then + genitem(t^.greater); + end; + +begin + jumpsegment := current_procinfo.aktlocaldata; + if not (jumptable_no_range) then + begin + { case expr less than min_ => goto elselabel } + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_lt, aint(min_), hregister, elselabel); + { case expr greater than max_ => goto elselabel } + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_gt, aint(max_), hregister, elselabel); + end; + current_asmdata.getjumplabel(table); + indexreg := cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHL, OS_ADDR, 2, hregister, indexreg); + { create reference } + reference_reset_symbol(href, table, 0, sizeof(aint)); + href.offset := (-aint(min_)) * 4; + basereg := cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList, href, basereg); + + jmpreg := cg.getaddressregister(current_asmdata.CurrAsmList); + + reference_reset(href, sizeof(aint)); + href.index := indexreg; + href.base := basereg; + cg.a_load_ref_reg(current_asmdata.CurrAsmList, OS_ADDR, OS_ADDR, href, jmpreg); + + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_JR, jmpreg)); + { Delay slot } + current_asmdata.CurrAsmList.concat(taicpu.op_none(A_NOP)); + { generate jump table } + if not(cs_opt_size in current_settings.optimizerswitches) then + jumpSegment.concat(Tai_Align.Create_Op(4, 0)); + jumpSegment.concat(Tai_label.Create(table)); + last := min_; + genitem(hp); +end; + + + +begin + ccasenode := tcpucasenode; +end. diff --git a/closures/compiler/mips/opcode.inc b/closures/compiler/mips/opcode.inc new file mode 100644 index 0000000000..f58fd3aa32 --- /dev/null +++ b/closures/compiler/mips/opcode.inc @@ -0,0 +1,241 @@ +A_NONE, +A_P_STK2, +A_P_LW, +A_P_SET_NOREORDER, +A_P_SET_NOMACRO, +A_P_SET_MACRO, +A_P_SET_REORDER, +A_P_FRAME, +A_P_MASK, +A_P_FMASK, +A_P_SW, +A_SPARC8UNIMP, +A_NOP, +A_NOT, +A_NEG, +A_NEGU, +A_B, +A_LI, +A_DLI, +A_LA, +A_MOVE, +A_LB, +A_LBU, +A_LH, +A_LHU, +A_LW, +A_LWU, +A_LWL, +A_LWR, +A_LD, +A_LDL, +A_LDR, +A_LL, +A_LLD, +A_SB, +A_SH, +A_SW, +A_SWL, +A_SWR, +A_SD, +A_SDL, +A_SDR, +A_SC, +A_SCD, +A_SYNC, +A_ADDI, +A_DADDI, +A_ADDIU, +A_DADDIU, +A_SLTI, +A_SLTIU, +A_ANDI, +A_ORI, +A_XORI, +A_LUI, +A_DNEG, +A_DNEGU, +A_ADD, +A_DADD, +A_ADDU, +A_DADDU, +A_SUB, +A_DSUB, +A_SUBU, +A_DSUBU, +A_SLT, +A_SLTU, +A_AND, +A_OR, +A_XOR, +A_NOR, +A_MUL, +A_MULO, +A_MULOU, +A_DMUL, +A_DMULO, +A_DMULOU, +A_DIV, +A_DIVU, +A_DDIV, +A_DDIVU, +A_REM, +A_REMU, +A_DREM, +A_DREMU, +A_MULT, +A_DMULT, +A_MULTU, +A_DMULTU, +A_MFHI, +A_MTHI, +A_MFLO, +A_MTLO, +A_MULTG, +A_DMULTG, +A_MULTUG, +A_DMULTUG, +A_DIVG, +A_DDIVG, +A_DIVUG, +A_DDIVUG, +A_MODG, +A_DMODG, +A_MODUG, +A_DMODUG, +A_J, +A_JAL, +A_JR, +A_JALR, +A_BEQ, +A_BNE, +A_BLEZ, +A_BGTZ, +A_BLTZ, +A_BGEZ, +A_BLTZAL, +A_BGEZAL, +A_BEQL, +A_BNEL, +A_BLEZL, +A_BGTZL, +A_BLTZL, +A_BGEZL, +A_BLTZALL, +A_BGEZALL, +A_SLL, +A_SRL, +A_SRA, +A_SLLV, +A_SRLV, +A_SRAV, +A_DSLL, +A_DSRL, +A_DSRA, +A_DSLLV, +A_DSRLV, +A_DSRAV, +A_DSLL32, +A_DSRL32, +A_DSRA32, +A_LWC1, +A_SWC1, +A_LDC1, +A_SDC1, +A_MTC1, +A_MFC1, +A_DMTC1, +A_DMFC1, +A_CTC1, +A_CFC1, +A_ADD_S, +A_ADD_D, +A_SUB_S, +A_SUB_D, +A_MUL_S, +A_MUL_D, +A_DIV_S, +A_DIV_D, +A_ABS_S, +A_ABS_D, +A_NEG_S, +A_NEG_D, +A_SQRT_S, +A_SQRT_D, +A_MOV_S, +A_MOV_D, +A_CVT_S_D, +A_CVT_S_W, +A_CVT_S_L, +A_CVT_D_S, +A_CVT_D_W, +A_CVT_D_L, +A_CVT_W_S, +A_CVT_W_D, +A_CVT_L_S, +A_CVT_L_D, +A_ROUND_W_S, +A_ROUND_W_D, +A_ROUND_L_S, +A_ROUND_L_D, +A_TRUNC_W_S, +A_TRUNC_W_D, +A_TRUNC_L_S, +A_TRUNC_L_D, +A_CEIL_W_S, +A_CEIL_W_D, +A_CEIL_L_S, +A_CEIL_L_D, +A_FLOOR_W_S, +A_FLOOR_W_D, +A_FLOOR_L_S, +A_FLOOR_L_D, +A_BC1T, +A_BC1F, +A_BC1TL, +A_BC1FL, +A_C_EQ_D, +A_C_EQ_S, +A_C_LE_D, +A_C_LE_S, +A_C_LT_D, +A_C_LT_S, +A_BEQI, +A_BNEI, +A_BLTI, +A_BLEI, +A_BGTI, +A_BGEI, +A_BLTUI, +A_BLEUI, +A_BGTUI, +A_BGEUI, +A_BLT, +A_BLE, +A_BGT, +A_BGE, +A_BLTU, +A_BLEU, +A_BGTU, +A_BGEU, +A_SEQ, +A_SGE, +A_SGEU, +A_SGT, +A_SGTU, +A_SLE, +A_SLEU, +A_SNE, +A_SYSCALL, +A_ADD64SUB, +A_SUB64SUB, +A_MUL64SUB, +A_DIV64SUB, +A_NEG64SUB, +A_NOT64SUB, +A_OR64SUB, +A_SAR64SUB, +A_SHL64SUB, +A_SHR64SUB, +A_XOR64SUB, +A_END_DEF diff --git a/closures/compiler/mips/rgcpu.pas b/closures/compiler/mips/rgcpu.pas new file mode 100644 index 0000000000..280946debe --- /dev/null +++ b/closures/compiler/mips/rgcpu.pas @@ -0,0 +1,165 @@ +{ + Copyright (c) 1998-2009 by Florian Klaempfl and David Zhang + + This unit implements the register allocator for MIPLEL + + 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,aasmcpu,aasmtai,aasmdata, + cgbase,cgutils, + cpubase, + rgobj; + + type + trgcpu=class(trgobj) + procedure add_constraints(reg:tregister);override; + function get_spill_subreg(r : tregister) : tsubregister;override; + procedure do_spill_read(list:tasmlist;pos:tai;const spilltemp:treference;tempreg:tregister);override; + procedure do_spill_written(list:tasmlist;pos:tai;const spilltemp:treference;tempreg:tregister);override; + end; + + +implementation + + uses + globtype, + verbose,cutils, + cgobj; + + procedure trgcpu.add_constraints(reg:tregister); + var + supreg,i : Tsuperregister; + begin + case getsubreg(reg) of + { Let 64bit floats conflict with all odd float regs } + R_SUBFD: + begin + supreg:=getsupreg(reg); + i:=RS_F1; + while (i<=RS_F31) do + begin + add_edge(supreg,i); + inc(i,2); + end; + end; + { Let 64bit ints conflict with all odd int regs } + R_SUBQ: + begin + supreg:=getsupreg(reg); + i:=RS_R1; + while (i<=RS_R31) do + begin + add_edge(supreg,i); + inc(i,2); + end; + end; + end; + end; + + + function trgcpu.get_spill_subreg(r : tregister) : tsubregister; + begin + if getregtype(r)=R_FPUREGISTER then + result:=getsubreg(r) + else + result:=defaultsub; + end; + + + procedure trgcpu.do_spill_read(list:tasmlist;pos:tai;const spilltemp:treference;tempreg:tregister); + var + helpins : tai; + tmpref : treference; + helplist : tasmlist; + hreg : tregister; + begin + if abs(spilltemp.offset)>4095 then + begin + helplist:=tasmlist.create; + + if getregtype(tempreg)=R_INTREGISTER then + hreg:=tempreg + else + hreg:=cg.getintregister(helplist,OS_ADDR); + + reference_reset(tmpref,sizeof(aint)); + tmpref.offset:=spilltemp.offset; + tmpref.refaddr:=addr_high; + helplist.concat(taicpu.op_reg_ref(A_LUI,hreg,tmpref)); + + tmpref.refaddr:=addr_low; + helplist.concat(taicpu.op_reg_reg_ref(A_ADDIU,hreg,hreg,tmpref)); + helplist.concat(taicpu.op_reg_reg_reg(A_ADDU,hreg,hreg,spilltemp.base)); + + reference_reset_base(tmpref,hreg,0,sizeof(aint)); + + helpins:=spilling_create_load(tmpref,tempreg); + helplist.concat(helpins); + list.insertlistafter(pos,helplist) + end + else + inherited do_spill_read(list,pos,spilltemp,tempreg); + end; + + + procedure trgcpu.do_spill_written(list:tasmlist;pos:tai;const spilltemp:treference;tempreg:tregister); + var + helpins : tai; + tmpref : treference; + helplist : tasmlist; + hreg : tregister; + begin + if abs(spilltemp.offset)>4095 then + begin + helplist:=tasmlist.create; + + if getregtype(tempreg)=R_INTREGISTER then + hreg:=getregisterinline(helplist,[R_SUBWHOLE]) + else + hreg:=cg.getintregister(helplist,OS_ADDR); + + reference_reset(tmpref,sizeof(aint)); + tmpref.offset:=spilltemp.offset; + tmpref.refaddr:=addr_high; + helplist.concat(taicpu.op_reg_ref(A_LUI,hreg,tmpref)); + + tmpref.refaddr:=addr_low; + helplist.concat(taicpu.op_reg_reg_ref(A_ADDIU,hreg,hreg,tmpref)); + helplist.concat(taicpu.op_reg_reg_reg(A_ADDU,hreg,hreg,spilltemp.base)); + + reference_reset_base(tmpref,hreg,0,sizeof(aint)); + + helpins:=spilling_create_store(tempreg,tmpref); + helplist.concat(helpins); + if getregtype(tempreg)=R_INTREGISTER then + ungetregisterinline(helplist,hreg); + + list.insertlistafter(pos,helplist) + end + else + inherited do_spill_written(list,pos,spilltemp,tempreg); + end; + +end. diff --git a/closures/compiler/mips/rmipscon.inc b/closures/compiler/mips/rmipscon.inc new file mode 100644 index 0000000000..e4dedd516e --- /dev/null +++ b/closures/compiler/mips/rmipscon.inc @@ -0,0 +1,75 @@ +{ don't edit, this file is generated from mipsreg.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_R16 = tregister($01000010); +NR_R17 = tregister($01000011); +NR_R18 = tregister($01000012); +NR_R19 = tregister($01000013); +NR_R20 = tregister($01000014); +NR_R21 = tregister($01000015); +NR_R22 = tregister($01000016); +NR_R23 = tregister($01000017); +NR_R24 = tregister($01000018); +NR_R25 = tregister($01000019); +NR_R26 = tregister($0100001a); +NR_R27 = tregister($0100001b); +NR_R28 = tregister($0100001c); +NR_R29 = tregister($0100001d); +NR_R30 = tregister($0100001e); +NR_R31 = tregister($0100001f); +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_F8 = tregister($02000008); +NR_F9 = tregister($02000009); +NR_F10 = tregister($0200000a); +NR_F11 = tregister($0200000b); +NR_F12 = tregister($0200000c); +NR_F13 = tregister($0200000d); +NR_F14 = tregister($0200000e); +NR_F15 = tregister($0200000f); +NR_F16 = tregister($02000010); +NR_F17 = tregister($02000011); +NR_F18 = tregister($02000012); +NR_F19 = tregister($02000013); +NR_F20 = tregister($02000014); +NR_F21 = tregister($02000015); +NR_F22 = tregister($02000016); +NR_F23 = tregister($02000017); +NR_F24 = tregister($02000018); +NR_F25 = tregister($02000019); +NR_F26 = tregister($0200001a); +NR_F27 = tregister($0200001b); +NR_F28 = tregister($0200001c); +NR_F29 = tregister($0200001d); +NR_F30 = tregister($0200001e); +NR_F31 = tregister($0200001f); +NR_PC = tregister($05000000); +NR_HI = tregister($05000001); +NR_LO = tregister($05000002); +NR_CR = tregister($05000003); +NR_FCR0 = tregister($05000004); +NR_FCR25 = tregister($05000005); +NR_FCR26 = tregister($05000006); +NR_FCR28 = tregister($05000007); +NR_FCSR = tregister($05000008); diff --git a/closures/compiler/mips/rmipsdwf.inc b/closures/compiler/mips/rmipsdwf.inc new file mode 100644 index 0000000000..35598a2ffe --- /dev/null +++ b/closures/compiler/mips/rmipsdwf.inc @@ -0,0 +1,75 @@ +{ don't edit, this file is generated from mipsreg.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, +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, +-1, +68, +69, +70, +71, +72, +73, +74, +75 diff --git a/closures/compiler/mips/rmipsgas.inc b/closures/compiler/mips/rmipsgas.inc new file mode 100644 index 0000000000..b81050d8c8 --- /dev/null +++ b/closures/compiler/mips/rmipsgas.inc @@ -0,0 +1,75 @@ +{ don't edit, this file is generated from mipsreg.dat } +'INVALID', +'r0', +'r1', +'r2', +'r3', +'r4', +'r5', +'r6', +'r7', +'r8', +'r9', +'r10', +'r11', +'r12', +'r13', +'r14', +'r15', +'r16', +'r17', +'r18', +'r19', +'r20', +'r21', +'r22', +'r23', +'r24', +'r25', +'r26', +'r27', +'r28', +'r29', +'r30', +'r31', +'f0', +'f1', +'f2', +'f3', +'f4', +'f5', +'f6', +'f7', +'f8', +'f9', +'f10', +'f11', +'f12', +'f13', +'f14', +'f15', +'f16', +'f17', +'f18', +'f19', +'f20', +'f21', +'f22', +'f23', +'f24', +'f25', +'f26', +'f27', +'f28', +'f29', +'f30', +'f31', +'pc', +'hi', +'lo', +'cr', +'fcr0', +'fcr25', +'fcr26', +'fcr28', +'fcsr' diff --git a/closures/compiler/mips/rmipsgri.inc b/closures/compiler/mips/rmipsgri.inc new file mode 100644 index 0000000000..a52df4ffa7 --- /dev/null +++ b/closures/compiler/mips/rmipsgri.inc @@ -0,0 +1,75 @@ +{ don't edit, this file is generated from mipsreg.dat } +0, +68, +33, +34, +43, +44, +45, +46, +47, +48, +49, +50, +51, +52, +35, +53, +54, +55, +56, +57, +58, +59, +60, +61, +62, +36, +63, +64, +37, +38, +39, +40, +41, +42, +69, +70, +71, +72, +73, +66, +67, +65, +1, +2, +11, +12, +13, +14, +15, +16, +17, +18, +19, +20, +3, +21, +22, +23, +24, +25, +26, +27, +28, +29, +30, +4, +31, +32, +5, +6, +7, +8, +9, +10 diff --git a/closures/compiler/mips/rmipsgss.inc b/closures/compiler/mips/rmipsgss.inc new file mode 100644 index 0000000000..c618ae3c54 --- /dev/null +++ b/closures/compiler/mips/rmipsgss.inc @@ -0,0 +1,75 @@ +{ don't edit, this file is generated from mipsreg.dat } +'INVALID', +'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', +'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', +'pc', +'hi', +'lo', +'cr', +'fcr0', +'fcr25', +'fcr26', +'fcr28', +'fcsr' diff --git a/closures/compiler/mips/rmipsnor.inc b/closures/compiler/mips/rmipsnor.inc new file mode 100644 index 0000000000..a03cbf0309 --- /dev/null +++ b/closures/compiler/mips/rmipsnor.inc @@ -0,0 +1,2 @@ +{ don't edit, this file is generated from mipsreg.dat } +74 diff --git a/closures/compiler/mips/rmipsnum.inc b/closures/compiler/mips/rmipsnum.inc new file mode 100644 index 0000000000..ebd3e23c45 --- /dev/null +++ b/closures/compiler/mips/rmipsnum.inc @@ -0,0 +1,75 @@ +{ don't edit, this file is generated from mipsreg.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($01000010), +tregister($01000011), +tregister($01000012), +tregister($01000013), +tregister($01000014), +tregister($01000015), +tregister($01000016), +tregister($01000017), +tregister($01000018), +tregister($01000019), +tregister($0100001a), +tregister($0100001b), +tregister($0100001c), +tregister($0100001d), +tregister($0100001e), +tregister($0100001f), +tregister($02000000), +tregister($02000001), +tregister($02000002), +tregister($02000003), +tregister($02000004), +tregister($02000005), +tregister($02000006), +tregister($02000007), +tregister($02000008), +tregister($02000009), +tregister($0200000a), +tregister($0200000b), +tregister($0200000c), +tregister($0200000d), +tregister($0200000e), +tregister($0200000f), +tregister($02000010), +tregister($02000011), +tregister($02000012), +tregister($02000013), +tregister($02000014), +tregister($02000015), +tregister($02000016), +tregister($02000017), +tregister($02000018), +tregister($02000019), +tregister($0200001a), +tregister($0200001b), +tregister($0200001c), +tregister($0200001d), +tregister($0200001e), +tregister($0200001f), +tregister($05000000), +tregister($05000001), +tregister($05000002), +tregister($05000003), +tregister($05000004), +tregister($05000005), +tregister($05000006), +tregister($05000007), +tregister($05000008) diff --git a/closures/compiler/mips/rmipsrni.inc b/closures/compiler/mips/rmipsrni.inc new file mode 100644 index 0000000000..18ce2cb19e --- /dev/null +++ b/closures/compiler/mips/rmipsrni.inc @@ -0,0 +1,75 @@ +{ don't edit, this file is generated from mipsreg.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, +73 diff --git a/closures/compiler/mips/rmipssri.inc b/closures/compiler/mips/rmipssri.inc new file mode 100644 index 0000000000..5af5c3069c --- /dev/null +++ b/closures/compiler/mips/rmipssri.inc @@ -0,0 +1,75 @@ +{ don't edit, this file is generated from mipsreg.dat } +68, +33, +34, +43, +44, +45, +46, +47, +48, +49, +50, +51, +52, +35, +53, +54, +55, +56, +57, +58, +59, +60, +61, +62, +36, +63, +64, +37, +38, +39, +40, +41, +42, +69, +70, +71, +72, +73, +66, +0, +67, +65, +1, +2, +11, +12, +13, +14, +15, +16, +17, +18, +19, +20, +3, +21, +22, +23, +24, +25, +26, +27, +28, +29, +30, +4, +31, +32, +5, +6, +7, +8, +9, +10 diff --git a/closures/compiler/mips/rmipssta.inc b/closures/compiler/mips/rmipssta.inc new file mode 100644 index 0000000000..35598a2ffe --- /dev/null +++ b/closures/compiler/mips/rmipssta.inc @@ -0,0 +1,75 @@ +{ don't edit, this file is generated from mipsreg.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, +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, +-1, +68, +69, +70, +71, +72, +73, +74, +75 diff --git a/closures/compiler/mips/rmipsstd.inc b/closures/compiler/mips/rmipsstd.inc new file mode 100644 index 0000000000..7f44888e61 --- /dev/null +++ b/closures/compiler/mips/rmipsstd.inc @@ -0,0 +1,75 @@ +{ don't edit, this file is generated from mipsreg.dat } +'INVALID', +'r0', +'r1', +'r2', +'r3', +'r4', +'r5', +'r6', +'r7', +'r8', +'r9', +'r10', +'r11', +'r12', +'r13', +'r14', +'r15', +'r16', +'r17', +'r18', +'r19', +'r20', +'r21', +'r22', +'r23', +'r24', +'r25', +'r26', +'r27', +'r28', +'r29', +'r30', +'r31', +'F0', +'F1', +'F2', +'F3', +'F4', +'F5', +'F6', +'F7', +'F8', +'F9', +'F10', +'F11', +'F12', +'F13', +'F14', +'F15', +'F16', +'F17', +'F18', +'F19', +'F20', +'F21', +'F22', +'F23', +'F24', +'F25', +'F26', +'F27', +'F28', +'F29', +'F30', +'F31', +'PC', +'HI', +'LO', +'CR', +'FCR0', +'FCR25', +'FCR26', +'FCR28', +'FCSR' diff --git a/closures/compiler/mips/rmipssup.inc b/closures/compiler/mips/rmipssup.inc new file mode 100644 index 0000000000..9999435836 --- /dev/null +++ b/closures/compiler/mips/rmipssup.inc @@ -0,0 +1,75 @@ +{ don't edit, this file is generated from mipsreg.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_R16 = $10; +RS_R17 = $11; +RS_R18 = $12; +RS_R19 = $13; +RS_R20 = $14; +RS_R21 = $15; +RS_R22 = $16; +RS_R23 = $17; +RS_R24 = $18; +RS_R25 = $19; +RS_R26 = $1a; +RS_R27 = $1b; +RS_R28 = $1c; +RS_R29 = $1d; +RS_R30 = $1e; +RS_R31 = $1f; +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_F8 = $08; +RS_F9 = $09; +RS_F10 = $0a; +RS_F11 = $0b; +RS_F12 = $0c; +RS_F13 = $0d; +RS_F14 = $0e; +RS_F15 = $0f; +RS_F16 = $10; +RS_F17 = $11; +RS_F18 = $12; +RS_F19 = $13; +RS_F20 = $14; +RS_F21 = $15; +RS_F22 = $16; +RS_F23 = $17; +RS_F24 = $18; +RS_F25 = $19; +RS_F26 = $1a; +RS_F27 = $1b; +RS_F28 = $1c; +RS_F29 = $1d; +RS_F30 = $1e; +RS_F31 = $1f; +RS_PC = $00; +RS_HI = $01; +RS_LO = $02; +RS_CR = $03; +RS_FCR0 = $04; +RS_FCR25 = $05; +RS_FCR26 = $06; +RS_FCR28 = $07; +RS_FCSR = $08; diff --git a/closures/compiler/mips/strinst.inc b/closures/compiler/mips/strinst.inc new file mode 100644 index 0000000000..10d6214ec0 --- /dev/null +++ b/closures/compiler/mips/strinst.inc @@ -0,0 +1,241 @@ +'none', +'p_stk2', +'p_lw', +'p_set_noreorder', +'p_set_nomacro', +'p_set_macro', +'p_set_reorder', +'p_frame', +'p_mask', +'p_fmask', +'p_sw', +'sparc8unimp', +'nop', +'not', +'neg', +'negu', +'b', +'li', +'dli', +'la', +'move', +'lb', +'lbu', +'lh', +'lhu', +'lw', +'lwu', +'lwl', +'lwr', +'ld', +'ldl', +'ldr', +'ll', +'lld', +'sb', +'sh', +'sw', +'swl', +'swr', +'sd', +'sdl', +'sdr', +'sc', +'scd', +'sync', +'addi', +'daddi', +'addiu', +'daddiu', +'slti', +'sltiu', +'andi', +'ori', +'xori', +'lui', +'dneg', +'dnegu', +'add', +'dadd', +'addu', +'daddu', +'sub', +'dsub', +'subu', +'dsubu', +'slt', +'sltu', +'and', +'or', +'xor', +'nor', +'mul', +'mulo', +'mulou', +'dmul', +'dmulo', +'dmulou', +'div', +'divu', +'ddiv', +'ddivu', +'rem', +'remu', +'drem', +'dremu', +'mult', +'dmult', +'multu', +'dmultu', +'mfhi', +'mthi', +'mflo', +'mtlo', +'multg', +'dmultg', +'multug', +'dmultug', +'divg', +'ddivg', +'divug', +'ddivug', +'modg', +'dmodg', +'modug', +'dmodug', +'j', +'jal', +'jr', +'jalr', +'beq', +'bne', +'blez', +'bgtz', +'bltz', +'bgez', +'bltzal', +'bgezal', +'beql', +'bnel', +'blezl', +'bgtzl', +'bltzl', +'bgezl', +'bltzall', +'bgezall', +'sll', +'srl', +'sra', +'sllv', +'srlv', +'srav', +'dsll', +'dsrl', +'dsra', +'dsllv', +'dsrlv', +'dsrav', +'dsll32', +'dsrl32', +'dsra32', +'lwc1', +'swc1', +'ldc1', +'sdc1', +'mtc1', +'mfc1', +'dmtc1', +'dmfc1', +'ctc1', +'cfc1', +'add.s', +'add.d', +'sub.s', +'sub.d', +'mul.s', +'mul.d', +'div.s', +'div.d', +'abs.s', +'abs.d', +'neg.s', +'neg.d', +'sqrt.s', +'sqrt.d', +'mov.s', +'mov.d', +'cvt.s.d', +'cvt.s.w', +'cvt.s.l', +'cvt.d.s', +'cvt.d.w', +'cvt.d.l', +'cvt.w.s', +'cvt.w.d', +'cvt.l.s', +'cvt.l.d', +'round.w.s', +'round.w.d', +'round.l.s', +'round.l.d', +'trunc.w.s', +'trunc.w.d', +'trunc.l.s', +'trunc.l.d', +'ceil.w.s', +'ceil.w.d', +'ceil.l.s', +'ceil.l.d', +'floor.w.s', +'floor.w.d', +'floor.l.s', +'floor.l.d', +'bc1t', +'bc1f', +'bc1tl', +'bc1fl', +'c.eq.d', +'c.eq.s', +'c.le.d', +'c.le.s', +'c.lt.d', +'c.lt.s', +'beqi', +'bnei', +'blti', +'blei', +'bgti', +'bgei', +'bltui', +'bleui', +'bgtui', +'bgeui', +'blt', +'ble', +'bgt', +'bge', +'bltu', +'bleu', +'bgtu', +'bgeu', +'seq', +'sge', +'sgeu', +'sgt', +'sgtu', +'sle', +'sleu', +'sne', +'syscall', +'add64sub', +'sub64sub', +'mul64sub', +'div64sub', +'neg64sub', +'not64sub', +'or64sub', +'sar64sub', +'shl64sub', +'shr64sub', +'xor64sub', +'end_def' diff --git a/closures/compiler/msg/errorct.msg b/closures/compiler/msg/errorct.msg new file mode 100644 index 0000000000..458e5b54b9 --- /dev/null +++ b/closures/compiler/msg/errorct.msg @@ -0,0 +1,2357 @@ +# +# This file is part of the Free Pascal Compiler +# Copyright (c) 1993-2008 by the Free Pascal Development team +# +# Catalan Language File for Free Pascal +# +# 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. +# +# +# The constants are build in the following order: +# <part>_<type>_<txtidentifier> +# +# <part> is the part of the compiler the message is used +# asmr_ assembler parsing +# asmw_ assembler writing/binary writers +# unit_ unit handling +# scan_ scanner +# parser_ parser +# type_ type checking +# general_ general info +# exec_ calls to assembler, linker, binder +# +# <type> the type of the message it should normally used for +# f_ fatal error +# e_ error +# w_ warning +# n_ note +# h_ hint +# i_ info +# l_ add linenumber +# u_ used +# t_ tried +# c_ conditional +# d_ debug message +# x_ executable informations +# + +# +# General +# +# 01017 is the last one used +# +# BeginOfTeX +% \section{General compiler messages} +% This section gives the compiler messages which are not fatal, but which +% display useful information. The number of such messages can be +% controlled with the various verbosity level \var{-v} switches. +% \begin{description} +general_t_compilername=01000_T_Compilador: $1 +% When the \var{-vt} switch is used, this line tells you what compiler +% is used. +general_d_sourceos=01001_D_SO d'origen: $1 +% When the \var{-vd} switch is used, this line tells you what the source +% operating system is. +general_i_targetos=01002_I_SO objectiu: $1 +% When the \var{-vd} switch is used, this line tells you what the target +% operating system is. +general_t_exepath=01003_T_S'està utilitzant el camí pels executables: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its binaries. +general_t_unitpath=01004_T_S'està utilitzant el camí de les unitats: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for compiled units. You can set this path with the \var{-Fu} +general_t_includepath=01005_T_S'està utilitzant el camí dels inclosos: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its include files (files used in \var{\{\$I xxx\}} statements). +% You can set this path with the \var{-I} option. +general_t_librarypath=01006_T_S'està utilitzant el camí per les biblioteques : $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for the libraries. You can set this path with the \var{-Fl} option. +general_t_objectpath=01007_T_S'està utilitzant el camí dels objectes: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for object files you link in (files used in \var{\{\$L xxx\}} statements). +% You can set this path with the \var{-Fo} option. +general_i_abslines_compiled=01008_I_$1 Línies compilades, $2 seg +% When the \var{-vi} switch is used, the compiler reports the number +% of lines compiled, and the time it took to compile them (real time, +% not program time). +general_f_no_memory_left=01009_F_No hi ha prou memòria disponible +% The compiler doesn't have enough memory to compile your program. +% There are several remedies for this: +% \begin{itemize} +% \item If you're using the build option of the compiler, try compiling the +% different units manually. +% \item If you're compiling a huge program, split it up in units, and compile +% these separately. +% \item If the previous two don't work, recompile the compiler with a bigger +% heap (you can use the \var{-Ch} option for this, \seeo{Ch}) +% \end{itemize} +general_i_writingresourcefile=01010_I_S'està escrivint el fitxer de la taula del recurs: $1 +% This message is shown when the compiler writes the Resource String Table +% file containing all the resource strings for a program. +general_e_errorwritingresourcefile=01011_E_S'ha produït un error mentre s'escrivia el fitxer de la taula del recurs: $1 +% This message is shown when the compiler encountered an error when writing +% the Resource String Table file +general_i_fatal=01012_I_Fatal: +% Prefix for Fatal Errors +general_i_error=01013_I_Error: +% Prefix for Errors +general_i_warning=01014_I_Avís: +% Prefix for Warnings +general_i_note=01015_I_Nota: +% Prefix for Notes +general_i_hint=01016_I_Suggeriment: +% Prefix for Hints +general_e_path_does_not_exist=01017_E_El camí "$1" no existeix +% The specified path does not exist +general_e_compilation_aborted=01018_E_S'ha avortat la compilació +% \end{description} +# +# Scanner +# +# 02066 is the last used one +# +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compiling handling. +% \begin{description} +scan_f_end_of_file=02000_F_No s'esperava el final del fitxer +% this typically happens in one of the following cases : +% \begin{itemize} +% \item The source file ends before the final \var{end.} statement. +% This happens mostly when the \var{begin} and \var{end} statements aren't +% balanced; +% \item An include file ends in the middle of a statement. +% \item A comment was not closed. +% \end{itemize} +scan_f_string_exceeds_line=02001_F_La cadena excedeix la línia +% There is a missing closing 'in a string, so it occupies +% multiple lines. +scan_f_illegal_char=02002_F_Caràcter il·legal "$1" ($2) +% An illegal character was encountered in the input file. +scan_f_syn_expected=02003_F_S'ha trobat un error de sintaxi, s'esperava "$1" però s'ha trobat "$2" +% This indicates that the compiler expected a different token than +% the one you typed. It can occur almost everywhere where you make a +% mistake against the pascal language. +scan_t_start_include_file=02004_TL_S'està començant a llegir el fitxer inclòs $1 +% When you provide the \var{-vt} switch, the compiler tells you +% when it starts reading an included file. +scan_w_comment_level=02005_W_S'ha trobat nivell de comentari $1 +% When the \var{-vw} switch is used, then the compiler warns you if +% it finds nested comments. Nested comments are not allowed in Turbo Pascal +% and can be a possible source of errors. +scan_n_ignored_switch=02008_N_S'ignora el commutador del compilador "$1" +% With \var{-vn} on, the compiler warns if it ignores a switch +scan_w_illegal_switch=02009_W_El commutador del compilador $1 no és vàlid +% You included a compiler switch (i.e. \var{\{\$... \}}) which the compiler +% does not recognise. +scan_w_switch_is_global=02010_W_Falta el commutador d'efecte global +% The compiler switch is misplaced, and should be located at +% the start of the unit or program +scan_e_illegal_char_const=02011_E_Constant de caràcter il·legal +% This happens when you specify a character with its ASCII code, as in +% \var{\#96}, but the number is either illegal, or out of range. +scan_f_cannot_open_input=02012_F_No es pot obrir el fitxer "$1" +% \fpc cannot find the program or unit source file you specified on the +% command line. +scan_f_cannot_open_includefile=02013_F_No es pot obrir el fitxer inclòs "$1" +% \fpc cannot find the source file you specified in a \var{\{\$include..\}} +% statement. +scan_w_only_pack_records=02015_W_Els camps dels Registres només es poden alinear a 1,2,4 o 16 octets +% You are specifying the \var{\{\$PACKRECORDS n\} } with an illegal value for +% \var{n}. Only 1,2,4 or 16 are valid in this case. +scan_w_only_pack_enum=02016_W_Els enumerats només es poden desar en 1,2 o 4 octets +% You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for +% \var{n}. Only 1,2 or 4 are valid in this case. +scan_e_endif_expected=02017_E_S'esperava $ENDIF per $1, s'ha definit $2 en $3 a la línia $4 +% Your conditional compilation statements are unbalanced. +scan_e_preproc_syntax_error=02018_E_S'ha trobat un error de sintaxi mentre es processava una expressió de compilació condicional +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setcd +% compiler directives. +scan_e_error_in_preproc_expr=02019_E_S'ha produït un error mentre s'avaluava una expressió de compilació condicional +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc +% compiler directives. +scan_w_macro_cut_after_255_chars=02020_W_Els continguts de la macro estan limitats a una longitud de 255 caràcters +% The contents of macros cannot be longer than 255 characters. +scan_e_endif_without_if=02021_E_ENDIF sense IF(N)DEF +% Your \var{\{\$IFDEF ..\}} and {\{\$ENDIF\}} statements aren't balanced. +scan_f_user_defined=02022_F_L'usuari ha definit: $1 +% A user defined fatal error occurred. see also the \progref +scan_e_user_defined=02023_E_L'usuari ha definit: $1 +% A user defined error occurred. see also the \progref +scan_w_user_defined=02024_W_L'usuari ha definit: $1 +% A user defined warning occurred. see also the \progref +scan_n_user_defined=02025_N_L'usuari ha definit: $1 +% A user defined note was encountered. see also the \progref +scan_h_user_defined=02026_H_L'usuari ha definit: $1 +% A user defined hint was encountered. see also the \progref +scan_i_user_defined=02027_I_L'usuari ha definit: $1 +% User defined information was encountered. see also the \progref +scan_e_keyword_cant_be_a_macro=02028_E_La paraula clau redefinida com a macro no té efecte +% You cannot redefine keywords with macros. +scan_f_macro_buffer_overflow=02029_F_Una macroinstrucció ha desbordat la memòria intermèdia mentre es llegia o s'expandia +% Your macro or its result was too long for the compiler. +scan_w_macro_too_deep=02030_W_L'expansió de les macroinstruccions excedeix una profunditat de 16. +% When expanding a macro, macros have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_w_wrong_styled_switch=02031_W_No es permeten els commutadors del compilador en comentaris de l'estil // +% Compiler switches should be in normal pascal style comments +scan_d_handling_switch=02032_DL_Manejant el commutador "$1" +% When you set debugging info on (\var{-vd}) the compiler tells you when it +% is evaluating conditional compile statements. +scan_c_endif_found=02033_CL_S'ha trobat ENDIF $1 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifdef_found=02034_CL_S'ha trobat IFDEF $1, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifopt_found=02035_CL_S'ha trobat IFOPT $1, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_if_found=02036_CL_S'ha trobat IF $1, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifndef_found=02037_CL_S'ha trobat IFNDEF $1, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_else_found=02038_CL_S'ha trobat ELSE $1, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_skipping_until=02039_CL_S'ha omès fins ... +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements, and whether it is skipping or +% compiling parts. +scan_i_press_enter=02040_I_Premeu <retorn> per a continuar +% When the \var{-vi} switch is used, the compiler stops compilation +% and waits for the \var{Enter} key to be pressed when it encounters +% a \var{\{\$STOP\}} directive. +scan_w_unsupported_switch=02041_W_No es permet l'ús del commutador "$1" +% When warnings are turned on (\var{-vw}) the compiler warns you about +% unsupported switches. This means that the switch is used in Delphi or +% Turbo Pascal, but not in \fpc +scan_w_illegal_directive=02042_W_La directiva del compilador "$1" no és vàlida +% When warings are turned on (\var{-vw}) the compiler warns you about +% unrecognised switches. For a list of recognised switches, \progref +scan_t_back_in=02043_TL_S'està tornant a $1 +% When you use (\var{-vt}) the compiler tells you when it has finished +% reading an include file. +scan_w_unsupported_app_type=02044_W_El tipus de l'aplicació "$1" no és compatible +% You get this warning, if you specify an unknown application type +% with the directive \var{\{\$APPTYPE\}} +scan_w_app_type_not_support=02045_W_APPTYPE no és compatible amb el SO objectiu +% The \var{\{\$APPTYPE\}} directive is supported by certain operanting +% systems only. +scan_w_description_not_support=02046_W_DESCRIPTION no és compatible amb el SO objectiu +% The \var{\{\$DESCRIPTION\}} directive is not supported on this target OS +scan_n_version_not_support=02047_N_VERSION no és compatible amb el SO objectiu +% The \var{\{\$VERSION\}} directive is not supported on this target OS. +scan_n_only_exe_version=02048_N_VERSION només es pot utilitzar en executables o DLLs +% The \var{\{\$VERSION\}} directive is only used for executable or DLL sources. +scan_w_wrong_version_ignored=02049_W_Format erroni de la directiva VERSION "$1" +% The \var{\{\$VERSION\}} directive format is major_version.minor_version +% where major_version and minor_version are words. +scan_e_unsupported_asmmode_specifier=02050_E_L'estil d'assemblador especificat "$1" no és vàlid +% When you specify an assembler mode with the \var{\{\$ASMMODE xxx\}} +% the compiler didn't recognize the mode you specified. +scan_w_no_asm_reader_switch_inside_asm=02051_W_No es permet el commutador de lector d'ASM dins d'una declaració ASM, "$1" serà efectiu a continuació +% It is not possible to switch from one assembler reader to another +% inside an assmebler block. The new reader will be used for next +% assembler statements only. +scan_e_wrong_switch_toggle=02052_E_El modificador del commutador és erroni, utilitzeu ON/OFF o +/- +% You need to use ON or OFF or a + or - to toggle the switch +scan_e_resourcefiles_not_supported=02053_E_No es permet l'ús dels fitxers del recurs en aquest destí +% The target you are compiling for doesn't support resource files. +scan_w_include_env_not_found=02054_W_No s'ha trobat la variable d'entorn "$1" +% The included environment variable can't be found in the environment, it will +% be replaced by an empty string instead. +scan_e_invalid_maxfpureg_value=02055_E_El valor pel límit del registre FPU no és vàlid +% Valid values for this directive are 0..8 and NORMAL/DEFAULT +scan_w_only_one_resourcefile_supported=02056_W_Aquest destí només permet un fitxer d'origen +% The target you are compiling for supports only one resource file. +% The first resource file found is used, the others are discarded. +scan_w_macro_support_turned_off=02057_W_El suport per a macroinstruccions està aturat +% A macro declaration has been found, but macro support is currently off, +% so the declaration will be ignored. To turn macro support on, compile with +% -Sm on the commandline or add {\$MACRO ON\} in the source +scan_e_invalid_interface_type=02058_E_S'ha especificat un tipus d'interfície no vàlida. Les interfícies vàlides son : COM, CORBA o DEFAULT. +% The interface type that was specified is not supported +scan_w_appid_not_support=02059_W_APPID només funciona amb el PalmOS +% The \var{\{\$APPID}} directive is only supported for the PalmOS target. +scan_w_appname_not_support=02060_W_APPNAME només funciona amb el PalmOS +% The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target +scan_e_string_exceeds_255_chars=02061_E_Les constants de cadena no poden excedir els 255 caràcters +% A single string contant can contain at most 255 chars. Try splitting up the +% string in multiple smaller parts and concatenate them with a + operator. +scan_f_include_deep_ten=02062_F_Els fitxers inclosos superen els 16 niats +% When including include files the files have been nested to a level of 16 +% The compiler will expand no further, since this may be a sign that +% recursion is used +scan_e_too_many_push=02063_E_S'han trobat massa nivells de PUSH +% A maximum of 20 levels is allowed. This error occurs only in mode MacPas +scan_e_too_many_pop=02064_E_S'ha trobat POP sense PUSH anterior +% This error occurs only in mode MacPas +scan_e_error_macro_lacks_value=02065_E_La macroinstrucció o variable del temps de compilació "$1" no te cap valor +% Thus the conditional compile time expression cannot be evaluated. +scan_e_wrong_switch_toggle_default=02066_E_La posició del commutador és errònia, utilitzeu ON/OFF/DEFAULT o +/-/* +% You need to use ON or OFF or DEFAULT or a + or - or * to toggle the switch +scan_e_mode_switch_not_allowed=02067_E_Aquí no es permet el commutador de mode "$1" +% A mode switch has already been encountered, or, in case of option -Mmacpas, +% a mode switch occur after UNIT +scan_e_error_macro_undefined=02068_E_La variable de temps de compilació "$1" no està definida +% Thus the conditional compile time expression cannot be evaluated. +% \end{description} +# +# Parser +# +# 03211 is the last used one +# +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your pascal constructs +% are correct. +% \begin{description} +% \section{Parser messages} +parser_e_syntax_error=03000_E_Analitzador - Error de sintaxi +% An error against the Turbo Pascal language was encountered. This happens +% typically when an illegal character is found in the sources file. +parser_e_dont_nest_interrupt=03004_E_El procediment INTERRUPT no pot estar niat +% An \VAR{INTERRUPT} procedure must be global. +parser_w_proc_directive_ignored=03005_W_S'ignora el tipus de procediment "$1" +% The specified is ignored fy FPC programs +parser_e_no_overload_for_all_procs=03006_E_No totes les declaracions de "$1" s'han declarat amb OVERLOAD +% When you want to use overloading using the \var{OVERLOAD} directive, then +% all declarations need to have \var{OVERLOAD} specified. +parser_e_export_name_double=03008_E_El nom de la funció exportada "$1" està dupllicat +% Exported function names inside a specific DLL must all be different +parser_e_export_ordinal_double=03009_E_L'índex de la funció exportada $1 no pot estar duplicat +% Exported function names inside a specific DLL must all be different +parser_e_export_invalid_index=03010_E_L'índex de la funció exportada no és vàlid +% DLL function index must be in the range \var{1..\$FFFF} +parser_w_parser_reloc_no_debug=03011_W_L'informació de la depuració de la biblioteca reassignada o executable $1 no funciona, es deshabilita. +parser_w_parser_win32_debug_needs_WN=03012_W_Per permetre la depuració pel codi de win32, necessiteu deshabilitar la reassignació amb l'opció -WN +% Stabs info is wrong for relocatable DLL or EXES use -WN +% if you want to debug win32 executables. +parser_e_constructorname_must_be_init=03013_E_El nom del constructor ha de ser INIT +% You are declaring a constructor with a name which is not \var{init}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_destructorname_must_be_done=03014_E_El nom del destructor ha de ser DONE +% You are declaring a constructor with a name which is not \var{done}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_proc_inline_not_supported=03016_E_No es permet l'ús del procediment tipus INLINE +% You tried to compile a program with C++ style inlining, and forgot to +% specify the \var{-Si} option (\seeo{Si}). The compiler doesn't support C++ +% styled inlining by default. +parser_w_constructor_should_be_public=03018_W_El constructor ha de ser públic +% Constructors must be in the 'public' part of an object (class) declaration. +parser_w_destructor_should_be_public=03019_W_El destructor ha de ser públic +% Destructors must be in the 'public' part of an object (class) declaration. +parser_n_only_one_destructor=03020_N_La classe només ha de tenir un destructor +% You can declare only one destructor for a class. +parser_e_no_local_objects=03021_E_No es permeten les definicions de les classes locals +% Classes must be defined globally. They cannot be defined inside a +% procedure or function +parser_f_no_anonym_objects=03022_F_No es permeten les definicions de classe anònimes +% An invalid object (class) declaration was encountered, i.e. an +% object or class without methods that isn't derived from another object or +% class. For example: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% will trigger this error. +parser_n_object_has_no_vmt=03023_E_L'objecte "$1" no té VMT +% This is a note indicating that the declared object has no +% virtual method table +parser_e_illegal_parameter_list=03024_E_La llista dels paràmetres no és vàlida +% You are calling a function with parameters that are of a different type than +% the declared parameters of the function. +parser_e_wrong_parameter_size=03026_E_S'ha especificat una quantitat errònia de paràmetres +% There is an error in the parameter list of the function or procedure, +% the number of parameters is not correct. +parser_e_overloaded_no_procedure=03027_E_L'identificador sobrecarregat "$1" no és una funció +% The compiler encountered a symbol with the same name as an overloaded +% function, but it is not a function it can overload. +parser_e_overloaded_have_same_parameters=03028_E_Les funcions sobrecarregades tenen la mateixa llista de paràmetres +% You're declaring overloaded functions, but with the same parameter list. +% Overloaded function must have at least 1 different parameter in their +% declaration. +parser_e_header_dont_match_forward=03029_E_L'encapçalament de la funció no concorda amb la declaració posterior "$1" +% You declared a function with same parameters but +% different result type or function specifiers. +parser_e_header_different_var_names=03030_E_L'encapçalament de la funció "$1" no concorda amb la posterior declaració : el nom de la variable canvia $2 => $3 +% You declared the function in the \var{interface} part, or with the +% \var{forward} directive, but define it with a different parameter list. +parser_n_duplicate_enum=03031_N_Els valors en tipus d'enumerats han de ser ascendents +% \fpc allows enumeration constructions as in C. Given the following +% declaration two declarations: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% The second declaration would produce an error. \var{A\_UAS} needs to have a +% value higher than \var{A\_E}, i.e. at least 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_No es pot utilitzar WITH per les variables en un segment diferent +% With stores a variable locally on the stack, +% but this is not possible if the variable belongs to another segment. +parser_e_too_much_lexlevel=03034_E_El niat de les funcions és superior a 31 +% You can nest function definitions only 31 times. +parser_e_range_check_error=03035_E_S'ha produït un error de comprovació de l'abast mentre s'avaluaven les constants +% The constants are out of their allowed range. +parser_w_range_check_error=03036_W_S'ha produït un error de comprovació de l'abast mentre s'avaluaven les constants +% The constants are out of their allowed range. +parser_e_double_caselabel=03037_E_L'etiqueta de CASE està duplicada +% You are specifying the same label 2 times in a \var{case} statement. +parser_e_case_lower_less_than_upper_bound=03038_E_El límit superior de CASE és menor que el límit inferior +% The upper bound of a \var{case} label is less than the lower bound and this +% is useless +parser_e_type_const_not_possible=03039_E_No es permeten les constants amb tipus de les classes +% You cannot declare a constant of type class or object. +parser_e_no_overloaded_procvars=03040_E_No es permeten les funcions variables de les funcions sobrecarregades +% You are trying to assign an overloaded function to a procedural variable. +% This is not allowed. +parser_e_invalid_string_size=03041_E_La longitud d'una cadena ha de ser un valor entre 1 i 255 +% The length of a shortstring in Pascal is limited to 255 characters. You are +% trying to declare a string with length lower than 1 or greater than 255 +parser_w_use_extended_syntax_for_objects=03042_W_Utilitzeu la sintaxi estesa de DISPOSE i NEW per les instàncies dels objectes +% If you have a pointer \var{a} to a class type, then the statement +% \var{new(a)} will not initialize the class (i.e. the constructor isn't +% called), although space will be allocated. you should issue the +% \var{new(a,init)} statement. This will allocate space, and call the +% constructor of the object. +parser_w_no_new_dispose_on_void_pointers=03043_W_L'utilització de NEW o DISPOSE en punters sense tipus no té sentit +parser_e_no_new_dispose_on_void_pointers=03044_E_L'utilització de NEW o DISPOSE no és possible amb punters sense tipus +% You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer +% because no size is associated to an untyped pointer. +% Accepted for compatibility in \var{tp} and \var{delphi} modes. +parser_e_class_id_expected=03045_E_S'esperava un identificador de classe +% This happens when the compiler scans a procedure declaration that contains +% a dot, +% i.e., a object or class method, but the type in front of the dot is not +% a known type. +parser_e_no_type_not_allowed_here=03046_E_Aquí no es permet l'identificador de tipus +% You cannot use a type inside an expression. +parser_e_methode_id_expected=03047_E_S'esperava un identificador del mètode +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_e_header_dont_match_any_member=03048_E_L'encapçalament de la funció no concorda amb cap mètode d'aquesta classe "$1" +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_d_procedure_start=03049_DL_PROCEDURE/FUNCTION $1 +% When using the \var{-vd} switch, the compiler tells you when it starts +% processing a procedure or function implementation. +parser_e_error_in_real=03050_E_La constant de punt flotant no és vàlida +% The compiler expects a floating point expression, and gets something else. +parser_e_fail_only_in_constructor=03051_E_FAIL només es pot utilitzar en constructors +% You are using the \var{fail} keyword outside a constructor method. +parser_e_no_paras_for_destructor=03052_E_Els destructors no poden tenir paràmetres +% You are declaring a destructor with a parameter list. Destructor methods +% cannot have parameters. +parser_e_only_class_methods_via_class_ref=03053_E_Els mètodes de la classe només es poden referir amb referències de classe +% This error occurs in a situation like the following: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} is not a class method and hence cannot be called with a class +% reference. +parser_e_only_class_methods=03054_E_Només els mètodes de la classe poden ser accedits en mètodes de classe +% This is related to the previous error. You cannot call a method of an object +% from a inside a class method. The following code would produce this error: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% Because free is a normal method of a class it cannot be called from a class +% method. +parser_e_case_mismatch=03055_E_Els tipus d'una constant i CASE no concorden +% One of the labels is not of the same type as the case variable. +parser_e_illegal_symbol_exported=03056_E_No es pot exportar el símbol d'una biblioteca +% You can only export procedures and functions when you write a library. You +% cannot export variables or constants. +parser_w_should_use_override=03057_W_ "$1" està amagant un mètode heretat +% A method that is declared \var{virtual} in a parent class, should be +% overridden in the descendent class with the \var{override} directive. If you +% don't specify the \var{override} directive, you will hide the parent method; +% you will not override it. +parser_e_nothing_to_be_overridden=03058_E_No hi ha un mètode en una classe avantpassada per ser substituït: "$1" +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_no_procedure_to_access_property=03059_E_No s'ha subministrat un membre per accedir a la propietat +% You specified no \var{read} directive for a property. +parser_w_stored_not_implemented=03060_W_La directiva Stored encara no està implementada +% The \var{stored} directive is not yet implemented +parser_e_ill_property_access_sym=03061_E_El símbol per accedir a la propietat no és vàlid +% There is an error in the \var{read} or \var{write} directives for an array +% property. When you declare an array property, you can only access it with +% procedures and functions. The following code woud cause such an error. +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_Aquí no es pot accedir a un camp protegit d'un objecte +% Fields that are declared in a \var{protected} section of an object or class +% declaration cannot be accessed outside the module wher the object is +% defined, or outside descendent object methods. +parser_e_cant_access_private_member=03063_E_Aquí no es pot accedir a un camp privat d'un objecte +% Fields that are declared in a \var{private} section of an object or class +% declaration cannot be accessed outside the module where the class is +% defined. +parser_e_overridden_methods_not_same_ret=03066_E_Els mètodes sobrecarregats han de retornar el mateix tipus: "$2" està sobrecarregat per "$1", el qual retorna un altre tipus +% If you declare overridden methods in a class definition, they must +% have the same return type. +parser_e_dont_nest_export=03067_E_Les funcions declarades amb EXPORT no poden estar niades +% You cannot declare a function or procedure within a function or procedure +% that was declared as an export procedure. +parser_e_methods_dont_be_export=03068_E_Els mètodes no poden ser EXPORTats +% You cannot declare a procedure that is a method for an object as +% \var{export}ed. +parser_e_call_by_ref_without_typeconv=03069_E_Les trucades per paràmetres variables tenen que concordar exactament: s'ha obtingut "$1", s'esperava "$2" +% When calling a function declared with \var{var} parameters, the variables in +% the function call must be of exactly the same type. There is no automatic +% type conversion. +parser_e_no_super_class=03070_E_La classe no és un pare de la classe actual +% When calling inherited methods, you are trying to call a method of a non-related +% class. You can only call an inherited method of a parent class. +parser_e_self_not_in_method=03071_E_SELF només és permet en mètodes +% You are trying to use the \var{self} parameter outside an object's method. +% Only methods get passed the \var{self} parameters. +parser_e_generic_methods_only_in_methods=03072_E_Els mètodes només poden estar en altres mètodes cridats directament amb l'identificador del tipus de la classe +% A construction like \var{sometype.somemethod} is only allowed in a method. +parser_e_illegal_colon_qualifier=03073_E_Ús no vàlid de ":" +% You are using the format \var{:} (colon) 2 times on an expression that +% is not a real expression. +parser_e_illegal_set_expr=03074_E_S'ha produït un error de comprovació de l'abast en el constructor del conjunt o hi ha element del conjunt duplicat +% The declaration of a set contains an error. Either one of the elements is +% outside the range of the set type, either two of the elements are in fact +% the same. +parser_e_pointer_to_class_expected=03075_E_S'esperava un punter a un objecte +% You specified an illegal type in a \var{New} statement. +% The extended syntax of \var{New} needs an object as a parameter. +parser_e_expr_have_to_be_constructor_call=03076_E_L'expressió ha de ser una trucada al constructor +% When using the extended syntax of \var{new}, you must specify the constructor +% method of the object you are trying to create. The procedure you specified +% is not a constructor. +parser_e_expr_have_to_be_destructor_call=03077_E_L'expressió ha de ser una trucada al destructor +% When using the extended syntax of \var{dispose}, you must specify the +% destructor method of the object you are trying to dispose of. +% The procedure you specified is not a destructor. +parser_e_invalid_record_const=03078_E_L'ordre dels elements del registre no és correcte +% When declaring a constant record, you specified the fields in the wrong +% order. +parser_e_false_with_expr=03079_E_El tipus de l'expressió ha de ser CLASS o RECORD +% A \var{with} statement needs an argument that is of the type \var{record} +% or \var{class}. You are using \var{with} on an expression that is not of +% this type. +parser_e_void_function=03080_E_Els procediments no poden retornar cap valor +% In \fpc, you can specify a return value for a function when using +% the \var{exit} statement. This error occurs when you try to do this with a +% procedure. Procedures cannot return a value. +parser_e_only_methods_allowed=03081_E_Els constructors, destructors i class operators han de ser mètodes +% You're declaring a procedure as destructor, constructor or class operator, when the +% procedure isn't a class method. +parser_e_operator_not_overloaded=03082_E_L'operador no està sobrecarregat +% You're trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_no_such_assignment=03083_E_No es pot sobrecarregar l'assignació per tipus iguals +% You can not overload assignment for types +% that the compiler considers as equal. +parser_e_overload_impossible=03084_E_No es pot sobrecarregar l'operador +% The combination of operator, arguments and return type are +% incompatible. +parser_e_no_reraise_possible=03085_E_Aquí no es pot rellançar una excepció +% You are trying to raise an exception where it is not allowed. You can only +% raise exceptions in an \var{except} block. +parser_e_no_new_or_dispose_for_classes=03086_E_No es permet la sintaxi estesa de NEW o DISPOSE en una classe +% You cannot generate an instance of a class with the extended syntax of +% \var{new}. The constructor must be used for that. For the same reason, you +% cannot call \var{dispose} to de-allocate an instance of a class, the +% destructor must be used for that. +parser_e_procedure_overloading_is_off=03088_E_La sobrecàrrega de procediments no està activada +% When using the \var{-So} switch, procedure overloading is switched off. +% Turbo Pascal does not support function overloading. +parser_e_overload_operator_failed=03089_E_No es pot sobrecarregar aquest operador +% You are trying to overload an operator which cannot be overloaded. +% The following operators can be overloaded : +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_L'operador comparatiu ha de retornar un valor booleà +% When overloading the \var{=} operator, the function must return a boolean +% value. +parser_e_only_virtual_methods_abstract=03091_E_Només els mètodes virtuals poden ser abstractes +% You are declaring a method as abstract, when it is not declared to be +% virtual. +parser_f_unsupported_feature=03092_F_S'està fent ús d'una característica no permesa! +% You're trying to force the compiler into doing something it cannot do yet. +parser_e_mix_of_classes_and_objects=03093_E_No es permet la barreja de diferents tipus d'objectes (class, object, interface, etc) +% You cannot derive \var{objects}, \var{classes}, \var{cppclasses} and +% \var{interfaces} interttwined . E,g. +% a class cannot have an object as parent and vice versa. +parser_w_unknown_proc_directive_ignored=03094_W_Es desconeix la directiva del procediment "$1", s'ignora. +parser_e_absolute_only_one_var=03095_E_Absolute només es pot associar a una variable +% The procedure direcive you specified is unknown. +% You cannot specify more than one variable before the \var{absolute} directive. +% Thus, the following construct will provide this error: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +% \item [ absolute can only be associated a var or const ] +% The address of a \var{absolute} directive can only point to a variable or a +% typed constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_absolute_only_to_var_or_const=03096_E_ABSOLUTE només es pot associar a una variable o constant +% The address of a \var{absolute} directive can only point to a variable or +% constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_initialized_only_one_var=03097_E_Només es pot inicialitzar una variable +% You cannot specify more than one variable with a initial value +% in Delphi mode. +parser_e_abstract_no_definition=03098_E_Els mètodes abstractes no han de tenir cap definició (en el cos de la funció) +% Abstract methods can only be declared, you cannot implement them. They +% should be overridden by a descendant class. +parser_e_overloaded_must_be_all_global=03099_E_Aquesta funció sobrecarregada no pot ser local (ha de ser EXPORTED) +% You are defining a overloaded function in the implementation part of a unit, +% but there is no corresponding declaration in the interface part of the unit. +parser_w_virtual_without_constructor=03100_W_Els mètodes virtuals s'utilitzen sense un constructor a "$1" +% If you declare objects or classes that contain virtual methods, you need +% to have a constructor and destructor to initialize them. The compiler +% encountered an object or class with virtual methods that doesn't have +% a constructor/destructor pair. +parser_c_macro_defined=03101_CL_S'ha definit la macro: $1 +% When \var{-vc} is used, the compiler tells you when it defines macros. +parser_c_macro_undefined=03102_CL_S'ha indefinit la macro: $1 +% When \var{-vc} is used, the compiler tells you when it undefines macros. +parser_c_macro_set_to=03103_CL_S'ha ficat la macro $1 a $2 +% When \var{-vc} is used, the compiler tells you what values macros get. +parser_i_compiling=03104_I_S'està compilant $1 +% When you turn on information messages (\var{-vi}), the compiler tells you +% what units it is recompiling. +parser_u_parsing_interface=03105_UL_S'està analitzant l'interfície de l'unitat $1 +% This tells you that the reading of the interface +% of the current unit starts +parser_u_parsing_implementation=03106_UL_S'està analitzant l'implementació de $1 +% This tells you that the code reading of the implementation +% of the current unit, library or program starts +parser_d_compiling_second_time=03107_DL_S'està compilant $1 per segona vegada +% When you request debug messages (\var{-vd}) the compiler tells you what +% units it recompiles for the second time. +parser_e_no_property_found_to_override=03109_E_No s'ha trobat la propietat a sobreescriure +% You want to overrride a property of a parent class, when there is, in fact, +% no such property in the parent class. +parser_e_only_one_default_property=03110_E_Només es permet una propietat predeterminada. +% You specified a property as \var{Default}, but the class already has a +% default property, and a class can have only one default property. +parser_e_property_need_paras=03111_E_La propietat predeterminada ha de ser un conjunt de propietat +% Only array properties of classes can be made \var{default} properties. +parser_e_constructor_cannot_be_not_virtual=03112_E_Els constructors virtuals només son compatibles en models class object +% You cannot have virtual constructors in objects. You can only have them +% in classes. +parser_e_no_default_property_available=03113_E_No hi ha cap propietat predeterminada disponible +% You are trying to access a default property of a class, but this class (or one of +% its ancestors) does not have a default property. +parser_e_cant_have_published=03114_E_La classe no pot tenir una secció PUBLISHED, utilitzeu el commutador {$M+} +% If you want a \var{published} section in a class definition, you must +% use the \var{\{\$M+\}} switch, whch turns on generation of type +% information. +parser_e_forward_declaration_must_be_resolved=03115_E_La declaració posterior de la classe "$1" s'ha de resoldre aquí per poder utilitzar la classe com anvantpassada +% To be able to use an object as an ancestor object, it must be defined +% first. This error occurs in the following situation: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% Where \var{ParentClass} is declared but not defined. +parser_e_no_local_operator=03116_E_No es permeten els operadors locals +% You cannot overload locally, i.e. inside procedures or function +% definitions. +parser_e_proc_dir_not_allowed_in_interface=03117_E_No es permet la directiva de procediment "$1" en la secció INTERFACE +% This procedure directive is not allowed in the \var{interface} section of +% a unit. You can only use it in the \var{implementation} section. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_No es permet la directiva del procediment "$1" en la secció IMPLEMENTATION +% This procedure directive is not defined in the \var{implementation} section of +% a unit. You can only use it in the \var{interface} section. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_No es permet la directiva del procediment "$1" en la declaració procvar +% This procedure directive cannot be part of a procedural of function +% type declaration. +parser_e_function_already_declared_public_forward=03120_E_La funció "$1" ja està declarada com Public/Forward +% You will get this error if a function is defined as \var{forward} twice. +% Or it is once in the \var{interface} section, and once as a \var{forward} +% declaration in the \var{implmentation} section. +parser_e_not_external_and_export=03121_E_No es poden utilitzar EXPORT i EXTERNAL conjuntament +% These two procedure directives are mutually exclusive +parser_w_not_supported_for_inline=03123_W_Encara no es permet "$1" dins de procediment/funció inserits +% Inline procedures don't support this declaration. +parser_w_inlining_disabled=03124_W_S'ha deshabilitat l'inseriment +% Inlining of procedures is disabled. +parser_i_writing_browser_log=03125_I_S'està escrivint el registre del navegador $1 +% When information messages are on, the compiler warns you when it +% writes the browser log (generated with the \var{\{\$Y+ \}} switch). +parser_h_maybe_deref_caret_missing=03126_H_Pot ser que falti la dereferència del punter +% The compiler thinks that a pointer may need a dereference. +parser_f_assembler_reader_not_supported=03127_F_El lector de l'assemblador seleccionat no és compatible +% The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not +% supported. The compiler can be compiled with or without support for a +% particular assembler reader. +earser_e_proc_dir_conflict=03128_E_La directiva del procediment "$1" té conflictes amb altres directives +% You specified a procedure directive that conflicts with other directives. +% for instance \var{cdecl} and \var{pascal} are mutually exclusive. +parser_e_call_convention_dont_match_forward=03129_E_La convenció de la crida no concorda amb la posterior +% This error happens when you declare a function or procedure with +% e.g. \var{cdecl;} but omit this directive in the implementation, or vice +% versa. The calling convention is part of the function declaration, and +% must be repeated in the function definition. +parser_e_property_cant_have_a_default_value=03131_E_La propietat no pot tenir un valor predeterminat +% Set properties or indexed properties cannot have a default value. +parser_e_property_default_value_must_const=03132_E_El valor predeterminat d'una propietat ha de ser constant +% The value of a \var{default} declared property must be knwon at compile +% time. The value you specified is only known at run time. This happens +% .e.g. if you specify a variable name as a default value. +parser_e_cant_publish_that=03133_E_No es pot publicar el símbol, només pot ser una classe +% Only class type variables can be in a \var{published} section of a class +% if they are not declared as a property. +parser_e_cant_publish_that_property=03134_E_No es pot publicar aquest tipus de propietat +% Properties in a \var{published} section cannot be array properties. +% they must be moved to public sections. Properties in a \var{published} +% section must be an ordinal type, a real type, strings or sets. +parser_e_empty_import_name=03136_E_Es requereix nom d'importació +% Some targets need a name for the imported procedure or a \var{cdecl} specifier +parser_e_division_by_zero=03138_E_S'ha efectuat una divisió per zero +% There is a divsion by zero encounted +parser_e_invalid_float_operation=03139_E_L'operació de punt flotant no és vàlida +% An operation on two real type values produced an overflow or a division +% by zero. +parser_e_array_lower_less_than_upper_bound=03140_E_El límit superior de l'abast és menor que el límit inferior +% The upper bound of a an array declaration is less than the lower bound and this +% is not possible +parser_w_string_too_long=03141_W_La cadena "$1" és més llarga que "$2" +% The size of the constant string is larger than the size you specified in +% string type definition +parser_e_string_larger_array=03142_E_La longitud de la cadena és major que el conjunt de caràcters +% The size of the constant string is larger than the size you specified in +% the array[x..y] of char definition +parser_e_ill_msg_expr=03143_E_Hi ha una expressió il·legal després d'una directiva del missatge +% \fpc supports only integer or string values as message constants +parser_e_ill_msg_param=03144_E_Els manipuladors de missatges només accepten una crida per paràmetre de referència +% A method declared with the \var{message}-directive as message handler +% can take only one parameter which must be declared as call by reference +% Parameters are declared as call by reference using the \var{var}-directive +parser_e_duplicate_message_label=03145_E_L'etiqueta del missatge està duplicada: "$1" +% A label for a message is used twice in one object/class +parser_e_self_in_non_message_handler=03146_E_SELF només pot ser un paràmetre explícit en mètodes que son manipuladors dels missatges +% The self parameter can be passed only explicit if it is a method which +% is declared as message handler +parser_e_threadvars_only_sg=03147_E_Les variables del fil només poden ser estàtiques o globals +% Threadvars must be static or global, you can't declare a thread +% local to a procedure. Local variables are always local to a thread, +% because every thread has its own stack and local variables +% are stored on the stack +parser_f_direct_assembler_not_allowed=03148_F_L'assemblador directe no és compatible amb el format binari de la sortida +% You can't use direct assembler when using a binary writer, choose an +% other outputformat or use another assembler reader +% \end{description} +parser_w_no_objpas_use_mode=03149_W_No carregueu manualment l'unitat OBJPAS, utilitzeu {\$mode objfpc\} o {\$mode delphi\} +% You are trying to load the ObjPas unit manual from a uses clause. This is +% not a good idea. Use the \var{\{\$mode objfpc\}} or +% \var{\{\$mode delphi\}} +% directives which load the unit automatically +parser_e_no_object_override=03150_E_No es pot utilitzar OVERRIDE en objectes +% Override is not supported for objects, use \var{virtual} instead to override +% a method of a parent object +parser_e_cant_use_inittable_here=03151_E_No es poden utilitzar els tipus de dades que requereixen inicialització/finalització en registres variables +% Some data type (e.g. \var{ansistring}) needs initialization/finalization +% code which is implicitly generated by the compiler. Such data types +% can't be used in the variant part of a record. +parser_e_resourcestring_only_sg=03152_E_Les cadenes del recurs només poden ser estàtiques o globals +% Resourcestring can not be declared local, only global or using the static +% directive. +parser_e_exit_with_argument_not__possible=03153_E_Aquí no es pot utilitzar Exit amb arguments +% an exit statement with an argument for the return value can't be used here, this +% can happen e.g. in \var{try..except} or \var{try..finally} blocks +parser_e_stored_property_must_be_boolean=03154_E_El tipus del símbol ha de ser booleà +% If you specify a storage symbol in a property declaration, it must be of +% the type boolean +parser_e_ill_property_storage_sym=03155_E_No es permet aquest símbol com a símbol per emmagatzemar +% You can't use this type of symbol as storage specifier in property +% declaration. You can use only methods with the result type boolean, +% boolean class fields or boolean constants +parser_e_only_publishable_classes_can__be_published=03156_E_Només les classes compilades amb el mode $M+ poden ser publicades +% In the published section of a class can be only class as fields used which +% are compiled in $M+ or which are derived from such a class. Normally +% such a class should be derived from TPersitent +parser_e_proc_directive_expected=03157_E_S'esperava la directiva del procediment +% When declaring a procedure in a const block you used a ; after the +% procedure declaration after which a procedure directive must follow. +% Correct declarations are: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_El valor per un índex de la propietat ha de ser d'un tipus ordinal +% The value you use to index a property must be of an ordinal type, for +% example an integer or enumerated type. +parser_e_procname_to_short_for_export=03159_E_El nom del procediment és massa curt per ser exportat +% The length of the procedure/function name must be at least 2 characters +% long. This is because of a bug in dlltool which doesn't parse the .def +% file correct with a name of length 1. +parser_e_dlltool_unit_var_problem=03160_E_No es pot generar una entrada DEFFILE per les variables globals d'una unitat +parser_e_dlltool_unit_var_problem2=03161_E_Compileu sense l'opció -WD +% You need to compile this file without the -WD switch on the +% commandline +parser_f_need_objfpc_or_delphi_mode=03162_F_Necessiteu el mode ObjFpc (-S2) o Delphi (-Sd) per compilar aquest mòdul +% You need to use {\$MODE OBJFPC\} or {\$MODE DELPHI\} to compile this file +% Or use the equivalent commandline switches -S2 or -Sd +parser_e_no_export_with_index_for_target=03163_E_No es pot exportar amb índex sota $1 +% Exporting of functions or procedures with a specific index is not +% supported on this target. +parser_e_no_export_of_variables_for_target=03164_E_No es poden exportar variables sota $1 +% Exporting of variables is not supported on this target. +parser_e_improper_guid_syntax=03165_E_La sintaxi de GUID no és apropiada +parser_w_interface_mapping_notfound=03168_W_El procediment anomenat "$1" no sembla apropiat per implementar $2.$3 +parser_e_interface_id_expected=03169_E_S'esperava identificador d'interfície +% This happens when the compiler scans a \var{class} declaration that contains +% \var{interface} function name mapping code like this: +% \begin{verbatim} +% type +% TMyObject = class (TObject, IDispach) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% and the \var{interface} before the dot not listed in the inheritance list. +parser_e_type_cant_be_used_in_array_index=03170_E_No es pot utilitzar el tipus "$1" com a índex de conjunt +% Types like \var{qword} or \var{int64} aren't allowed as array index type +parser_e_no_con_des_in_interfaces=03171_E_No es permeten els constructors i destructors a l'interfície +% Constructor and destructor declarations aren't allowed in interface +% In the most cases the method \var{QueryInterface} of \var{IUnknown} can +% be used to create a new interface +parser_e_no_access_specifier_in_interfaces=03172_E_No es poden utilitzar els especificadors d'accés en l'interfície +% The access specifiers \var{public}, \var{private}, \var{protected} and +% \var{published} can't be used in interfaces because all methods +% of an interfaces must be public. +parser_e_no_vars_in_interfaces=03173_E_Una interfície no pot contenir camps +% Declarations of fields aren't allowed in interfaces. An interface +% can contain only methods +parser_e_no_local_proc_external=03174_E_No es poden declarar procediments locals com EXTERNAL +% Declaring local procedures as external is not possible. Local procedures +% get hidden parameters that will make the chance of errors very high +parser_w_skipped_fields_before=03175_W_Alguns camps d'abans de "$1" no s'han inicialitzat +% In Delphi mode, not all fields of a typed constant record have to be +% initialized, but the compiler warms you when it detects such situations +parser_e_skipped_fields_before=03176_E_Alguns camps d'abans de "$1" no s'han inicialitzat +% In all syntax modes but Delphi mode, you can't leave some fields unitialized +% in the middle of a typed constant record +parser_w_skipped_fields_after=03177_W_Alguns camps de després de "$1" no s'han inicialitzat +% You can leave some fields at the end of a type constant record unitialized +% (the compiler will initialize them to zero automatically), this may be the cause +% of subtle problems. +parser_e_varargs_need_cdecl_and_external=03178_E_Directiva VarArgs sense CDecl i External +% The varargs directive can only be used with procedures or functions +% that are declared with \var{cdecl} and \var{external} directives. The varargs directive +% is only meant to provide a compatible interface to C functions like printf. +parser_e_self_call_by_value=03179_E_SELF ha de ser un paràmetre normal +% You can't declare self as a const or var parameter, it must always be +% a call-by-value parameter +parser_e_interface_has_no_guid=03180_E_L'interfície "$1" no té identificació d'interfície +% When you want to assign an interface to a constant, then the interface +% must have a GUID value set. +parser_e_illegal_field_or_method=03181_E_Es desconeix el camp de la classe o l'identificador del mètode "$1" +% Properties must refer to a field or method in the same class +parser_w_proc_overriding_calling=03182_W_S'està sobreescrivint la convenció de la crida "$1" amb "$2" +% There are two directives in the procedure declaration that specify a calling +% convention. Only the last directive will be used +parser_e_noprocvarobj_const=03183_E_Les constants del tipus "procediment de l'objecte" només es poden inicialitzar amb NIL +% You can't assign the address of a method to a typed constant which has a +% "procedure of object" type, because such a constant requires two addresses: +% that of the method (which is known at compile time) and that of the object or +% class instance it operates an (which can't be known at compile time). +parser_e_default_value_only_one_para=03184_E_El valor predeterminat només es pot assignar a un paràmetre +parser_e_default_value_expected_for_para=03185_E_Es requereix el paràmetre predeterminat per "$1" +parser_w_unsupported_feature=03186_W_No es permet l'ús d'aquesta característica! +% You're trying to force the compiler into doing something it cannot do yet. +parser_h_c_arrays_are_references=03187_H_Els conjunts del C es passen per referència +% Any array passed to a C functions is passed +% by a pointer (i.e. by reference). +parser_e_C_array_of_const_must_be_last=03188_E_El conjunt de constants de C, han de ser l'últim argument +% You can not add any other argument after an \var{array of const} for +% \var{cdecl} functions, as the size pushed on stack for this argument is +% not known. +parser_h_type_redef=03189_H_S'ha tornat a definir el tipus "$1" +% This is an indicator that a previously declared type is +% being redefined as something else. This may, or may not +% be, a cause for errors. +parser_w_cdecl_has_no_high=03190_W_Les funcions declarades amb CDECL no tenen paràmetres alts +% Functions declared with cdecl modifier do not pass an extra implicit parameter +parser_w_cdecl_no_openstring=03191_W_Les funcions declarades amb CDECL no son compatibles amb les cadenes obertes +% Openstring is not supported for cdecl'ared functions +parser_e_initialized_not_for_threadvar=03192_E_No es poden inicialitzar variables definides com a variables del fil +% Variables declared as threadvar can not be initialized with a default value +% The variables will always be filled with zero at the start of a new thread +parser_e_msg_only_for_classes=03193_E_Només es permet la directiva del missatge en classes +% The message directive is only supported for Class types. +parser_e_procedure_or_function_expected=03194_E_S'esperava procediment o funció +% A class method can only be specified for procedures and functions +parser_e_illegal_calling_convention=03195_E_S'ignora la directiva de la convenció de la crida: "$1" +% Some calling conventions are supported only by certain CPUs. I.e. most +% non-i386 ports support only the standard ABI calling convention of the CPU. +parser_e_no_object_reintroduce=03196_E_No es pot utilitzar REINTRODUCE en els objectes +% \var{REINTRODUCE} is not supported for objects +parser_e_paraloc_only_one_para=03197_E_Cada argument ha de tenir la seva pròpia localització +% if locations for arguments are specified explicity as it is required by +% some syscalls conventions, each argument must have its only location, +% things like \var{procedure p (i,j:longint 'r');} aren't allowed +parser_e_paraloc_all_paras=03198_E_Cada argument ha de tenir una localització explicita +% if one argument has an explicit argument location, all arguments of a procedure +% must have one +parser_e_illegal_explicit_paraloc=03199_E_No es coneix la localització de l'argument +% The location specified for an argument isn't recognized by the compiler +parser_e_32bitint_or_pointer_variable_expected=03200_E_S'esperava variable tipus Integer de 32 Bits o Pointer +% The libbase for MorphOS/AmigaOS can be give only as \var{longint}, \var{dword} or any pointer variable. +parser_e_goto_outside_proc=03201_E_No es permeten les declaracions GOTO entre diferents procediments +% It is not allowed to use the \var{goto} statements referencing labels outside the +% current procedure. The following example shows the problem: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1: +% +% procedure p2; +% begin +% goto l1; // This goto ISN'T allowed +% end; +% +% begin +% p2 +% l1; +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_El procediment és massa complex, requereix massa registres +% Your procedure body is too long for the compiler. You should split the +% procedure into multiple smaller procedures. +parser_e_illegal_expression=03203_E_L'expressió és il·legal +% This can occur under many circumstancies. Mostly when trying to evaluate +% constant expressions +parser_e_invalid_integer=03204_E_L'expressió amb INTEGER no és vàlida, el resultat ha de ser INTEGER +% You made an expression which isn't an integer, and the compiler expects the +% result to be an integer. +parser_e_invalid_qualifier=03205_E_El qualificador és il·legal +% One of the following is happening: +% \begin{itemize} +% \item You're trying to access a field of a variable that is not a record. +% \item You're indexing a variable that is not an array. +% \item You're dereferencing a variable that is not a pointer. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_El límit més alt és inferior al límit més baix de l'abast +% You are declaring a subrange, and the lower limit is higher than the high +% limit of the range +parser_e_macpas_exit_wrong_param=03207_E_La sortida del paràmetre ha de ser el nom del procediment on s'utilitza +% Non local exit is not allowed. This error occurs only in mode MacPas. +parser_e_illegal_assignment_to_count_var=03208_E_L'assignació de la variable "$1" del bucle FOR no és vàlida +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +parser_e_no_local_var_external=03209_E_No es pot declarar una variable local com EXTERNAL +% Declaring local variables as external is not allowed. Only global variables can reference +% to external variables. +parser_e_proc_already_external=03210_E_El procediment ja està declarat com EXTERNAL +% The procedure is already declared with the EXTERNAL directive in an interface of +% forward declaration. +parser_w_implicit_uses_of_variants_unit=03211_W_S'està utilitzant implícitament l'unitat Variants +% The Variant type is used in the unit without any used unit using the variants unit. +% The compiler has implicity added the Variants unit to the uses list. +% To remove this warning, the Variants unit needs to be added to the USES statement. +parser_e_no_static_method_in_interfaces=03212_E_No es poden utilitzar els mètodes de la classe i estàtics dins d'INTERFACES +% The specifier \var{class} and directive \var{static} can be used in interfaces +% because all methods of an interface must be public. +parser_e_arithmetic_operation_overflow=03213_E_S'ha produït una sobrecàrrega en l'operació aritmètica +% An operation on two integers values produced an overflow +% \end{description} +# +# Type Checking +# +# +# 04058 is the last used one +# +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +type_e_mismatch=04000_E_Els tipus no concorden +% This can happen in many cases: +% \begin{itemize} +% \item The variable you're assigning to is of a different type than the +% expression in the assignment. +% \item You are calling a function or procedure with parameters that are +% incompatible with the parameters in the function or procedure definition. +% \end{itemize} +type_e_incompatible_types=04001_E_Els tipus son incompatibles: s'ha obtingut "$1", s'esperava "$2" +% There is no conversion possible between the two types +% Another possiblity is that they are declared in different +% declarations: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { This statement gives also this error, it +% is due the strict type checking of pascal } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_Els tipus "$1" i "$2" no concorden +% The types are not equal +type_e_type_id_expected=04003_E_S'esperava un identificador de tipus +% The identifier is not a type, or you forgot to supply a type identifier. +type_e_variable_id_expected=04004_E_S'esperava un identificador de variable +% This happens when you pass a constant to a routine (such as \var{Inc} var or \var{Dec}) +% when it expects a variable. You can only pass variables as arguments to these functions. +type_e_integer_expr_expected=04005_E_S'esperava una expressió entera, però s'ha obtingut "$1" +% The compiler expects an expression of type integer, but gets a different +% type. +type_e_boolean_expr_expected=04006_E_S'esperava una expressió booleana, però s'ha obtingut "$1" +% The expression must be a boolean type, it should be return true or +% false. +type_e_ordinal_expr_expected=04007_E_S'esperava una expressió ordinal +% The expression must be of ordinal type, i.e., maximum a \var{Longint}. +% This happens, for instance, when you specify a second argument +% to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value. +type_e_pointer_type_expected=04008_E_S'esperava un tipus punter, però s'ha obtingut "$1" +% The variable or expression isn't of the type \var{pointer}. This +% happens when you pass a variable that isn't a pointer to \var{New} +% or \var{Dispose}. +type_e_class_type_expected=04009_E_S'esperava un tipus de classe, però s'ha obtingut "$1" +% The variable of expression isn't of the type \var{class}. This happens +% typically when +% \begin{enumerate} +% \item The parent class in a class declaration isn't a class. +% \item An exception handler (\var{On}) contains a type identifier that +% isn't a class. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_No es pot avaluar l'expressió constant +% This error can ocurr when the bounds of an array you declared does +% not evaluate to ordinal constants +type_e_set_element_are_not_comp=04012_E_Els elements del conjunt no son compatibles +% You are trying to make an operation on two sets, when the set element types +% are not the same. The base type of a set must be the same when taking the +% union +type_e_set_operation_unknown=04013_E_L'operació no està implementada pels conjunts +% several binary operations are not defined for sets +% like div mod ** (also >= <= for now) +type_w_convert_real_2_comp=04014_W_S'està convertint automàticament el tipus de punt flotant a COMP, el qual és un tipus enter +% An implicit type conversion from a real type to a \var{comp} is +% encountered. Since \var{comp} is a 64 bit integer type, this may indicate +% an error. +type_h_use_div_for_int=04015_H_Utilitzeu DIV per obtenir un resultat enter +% When hints are on, then an integer division with the '/' operator will +% procuce this message, because the result will then be of type real +type_e_strict_var_string_violation=04016_E_Els tipus de la cadena no concorden a causa del mode $V+ +% When compiling in \var{\{\$V+\}} mode, the string you pass as a parameter +% should be of the exact same type as the declared parameter of the procedure. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_No es pot utilitzar SUCC o PRED en enumeracions amb assignació +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use the \var{Succ} or \var{Pred} functions on them. +type_e_cant_read_write_type=04018_E_No es poden llegir o escriure variables d'aquest tipus +% You are trying to \var{read} or \var{write} a variable from or to a +% file of type text, which doesn't support that. Only integer types, +% reals, pchars and strings can be read from/written to a text file. +% Booleans can only be written to text files. +type_e_no_readln_writeln_for_typed_file=04019_E_No és pot utilitzar READLN o WRITELN en fitxers de tipus +% \var{readln} and \var{writeln} are only allowed for text files. +type_e_no_read_write_for_untyped_file=04020_E_No és pot utilitzar READ o WRITE en fitxers sense tipus +% \var{read} and \var{write} are only allowed for text or typed files. +type_e_typeconflict_in_set=04021_E_S'ha produït un conflicte de tipus entre els elements del conjunt +% There is at least one set element which is of the wrong type, i.e. not of +% the set type. +type_w_maybe_wrong_hi_lo=04022_W_lo/hi(dword/qword) retorna el word/dword més alt/més baix +% \fpc supports an overloaded version of \var{lo/hi} for \var{longint/dword} +% which returns the lower/upper word of the argument. TP always uses +% a 16 bit \var{lo/hi} which returns always bits 0..7 for \var{lo} and the +% bits 8..15 for \var{hi}. If you want the TP behavior you have +% to type case the argument to \var{word/integer} +type_e_integer_or_real_expr_expected=04023_E_S'esperava una expressió tipus INTEGER o REAL +% The first argument to \var{str} must a real or integer type. +type_e_wrong_type_in_array_constructor=04024_E_El tipus "$1" no és correcte en el constructor del conjunt +% You are trying to use a type in an array constructor which is not +% allowed. +type_e_wrong_parameter_type=04025_E_El tipus de l'argument num.$1 és incompatible: s'ha obtingut "$2", s'esperava "$3" +% You are trying to pass an invalid type for the specified parameter. +% \end{description} +type_e_no_method_and_procedure_not_compatible=04026_E_El mètode (variable) i el procediment (variable) no son compatibles +% You can't assign a method to a procedure variable or a procedure to a +% method pointer. +type_e_wrong_math_argument=04027_E_S'ha passat una constant il·legal a una funció matemàtica interna +% The constant argument passed to a ln or sqrt function is out of +% the definition range of these functions. +type_e_no_addr_of_constant=04028_E_No es pot trobar l'adreça de les constants +% It is not possible to get the address of a constant, because they +% aren't stored in memory, you can try making it a typed constant. +type_e_argument_cant_be_assigned=04029_E_No es pot assignar l'argument +% Only expressions which can be on the left side of an +% assignment can be passed as call by reference argument +% Remark: Properties can be only +% used on the left side of an assignment, but they cannot be used as arguments +type_e_cannot_local_proc_to_procvar=04030_E_No es pot assignar el procediment/funció local a la variable del procediment +% It's not allowed to assign a local procedure/function to a +% procedure variable, because the calling of local procedure/function is +% different. You can only assign local procedure/function to a void pointer. +type_e_no_assign_to_addr=04031_E_No es poden assignar els valors a una adreça +% It is not allowed to assign a value to an address of a variable, constant, +% procedure or function. You can try compiling with -So if the identifier +% is a procedure variable. +type_e_no_assign_to_const=04032_E_No es poden assignar valors a una variable declarada com a constant +% It's not allowed to assign a value to a variable which is declared +% as a const. This is normally a parameter declared as const, to allow +% changing the value make the parameter as a value parameter or a var. +type_e_array_required=04033_E_Es requereix tipus de conjunt +% If you are accessing a variable using an index '[<x>]' then +% the type must be an array. In FPC mode also a pointer is allowed. +type_e_interface_type_expected=04034_E_S'esperava tipus d'interfície, però s'ha obtingut "$1" +type_w_mixed_signed_unsigned=04035_W_El resultat de la barreja d'expressions amb signe i paraules llargues és de 64 octets +% If yoy divide (or calculate the modulus of) a signed expression by a longword (or vice versa), +% or if you have overflow and/or range checking turned on and use an arithmetic +% expression (+, -, *, div, mod) in which both signed numbers and longwords appear, +% then everything has to be evaluated in 64bit which is slower than normal +% 32bit arithmetic. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_w_mixed_signed_unsigned2=04036_W_Barrejar expressions amb signe i cardinals aquí, pot causar errors de l'abast +% If you use a binari operator (and, or, xor) and one of +% the operands is a longword while the other one is a signed expression, then, +% if range checking is turned on, you may get a range check error because in +% such a case both operands are converted to longword before the operation is +% matches the result type of the other one. +type_e_typecast_wrong_size_for_assignment=04037_E_La conversió de tipus té diferents tamanys ($1 -> $2) en les assignacions +% Type casting to a type with a different size is not allowed when the variable is +% used for assigning. +type_e_array_index_enums_with_assign_not_possible=04038_E_Els enumerats amb assignacions no es poden utilitzar com a índex de conjunts +% When yoy declare an enumeration type which has assignments in it, as in C, +% like the foloowing: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% yoy cannot use it as index of an array. +type_e_classes_not_related=04039_E_Els tipus Class o Object "$1" i "$2" no estan relacionats +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_w_classes_not_related=04040_W_Els tipus de la classe "$1" i "$2" no estan relacionats +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_e_class_or_interface_type_expected=04041_E_S'esperava tipus de classe o interfície, però s'ha obtingut "$1" +type_e_type_is_not_completly_defined=04042_E_No s'ha definit completament el tipus "$1" +% The size of the constant string, which is assigned to a shortstring, +% is longer than the maximum size of the shortstring +type_w_signed_unsigned_always_false=04044_W_La comparació és sempre falsa a causa de l'abast dels valors +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% false. Explicitly typecast the constant to the correct range to avoid this problem. +type_w_signed_unsigned_always_true=04045_W_La comparació és sempre vertadera a causa de l'abast dels valors +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% true. Explicitly typecast the constant to the correct range to avoid this problem. +type_w_instance_with_abstract=04046_W_S'està construint una classe "$1" amb mètodes abstractes +% An instance of a class is created which contains non_implemented abstract +% methods. This will probably lead to a runtime error 211 in the code if that +% routine is ever called. All abstract methods should be overridden. +type_h_in_range_check=04047_H_L'operand esquerra per a l'operador d'IN ha de tenir el tamany d'un octet +% The left operand of the \var{in} operator is not an ordinal or enumeration which fits +% within 8-bits, this may lead to range check errors. The \var{in} operator +% currently only supports a left operand which fits within a byte. In the case of +% enumerations, the size of an element of an enumeration can be controlled with +% the \var{\{\$PACKENUM\}} or \var{\{\$Zn\}} switches. +type_w_smaller_possible_range_check=04048_W_El tamany dels tipus no concorden, possible pèrdua de dades / errors de l'abast +type_h_smaller_possible_range_check=04049_H_El tamany dels tipus no concorden, possible pèrdua de dades / errors de l'abast +% There is an assignement to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data +type_e_cant_take_address_of_abtract_method=04050_E_No es pot obtenir l'adreça d'un mètode abstracte +% An abstract method has no body, so the address of an abstract method can not +% be taken +type_e_operator_not_allowed=04051_E_No es pot aplicar l'operador pel tipus d'operand +% You are trying an operator that is not available for the type of the +% operands +type_e_constant_expr_expected=04052_E_S'esperava una expressió constant +% The compiler expects an constant expression, but gets a variable expression. +type_e_operator_not_supported_for_types=04053_E_L'operació "$1" no és compatible pels tipus "$2" i "$3" +% The operation is not allowed for the supplied types +type_e_illegal_type_conversion=04054_E_S'ha produït una conversió il·legal dels tipus: "$1" a "$2" +% When doing a type-cast, you must take care that the sizes of the variable +% and the destination type are the same +type_h_pointer_to_longint_conv_not_portable=04055_H_La conversió entre ordinals i punters no és portable +% If you typecast a pointer to a longint (or vice-versa), this code will not +% compile on a machineusing 64-bit for pointer storage. +type_w_pointer_to_longint_conv_not_portable=04056_W_La conversió entre ordinals i punters no és portable +% If you typecast a pointer to a ordinal type of different size (or vice-versa) +% this can cause problems. This is a warning to help finding the 32bit specific +% code where cardinal/longint is used to typecast pointers to ordinals +% A solution is to use the ptrint/ptruint types instead. +type_e_cant_choose_overload_function=04057_E_No es pot determinar a quina funció sobrecarregada cridar. +% You are calling overloaded functions with a parameter that does not correspond +% to any of the declared function parameter lists. e.g. when you have declared +% a function with parameters \var{word} and \var{longint}, and then you call +% it with a parameter which is of type \var{integer}. +type_e_illegal_count_var=04058_E_La variable del comptador no és vàlida +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +% \end{description} +# +# Symtable +# +# 05056 is the last used one +# +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedure and variable names. +% \begin{description} +sym_e_id_not_found=05000_E_No s'ha trobat l'dentificador "$1" +% The compiler doesn't know this symbol. Usually happens when you misspel +% the name of a variable or procedure, or when you forgot to declare a +% variable. +sym_f_internal_error_in_symtablestack=05001_F_S'ha produït un error intern en SymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_L'identificador "$1" està duplicat +% The identifier was already declared in the current scope. +sym_h_duplicate_id_where=05003_H_L'identificador ja està definit en $1 en la línia $2 +% The identifier was already declared in a previous scope. +sym_e_unknown_id=05004_E_Es desconeix l'identificador "$1" +% The identifier encountered has not been declared, or is used outside the +% scope where it is defined. +sym_e_forward_not_resolved=05005_E_No s'ha resolt la declaració posterior "$1" +% This can happen in two cases: +% \begin{itemize} +% \item This happens when you declare a function (in the \var{interface} part, or +% with a \var{forward} directive, but do not implement it. +% \item You reference a type which isn't declared in the current \var{type} +% block. +% \end{itemize} +sym_e_error_in_type_def=05007_E_S'ha produït un error en la definició del tipus +% There is an error in your definition of a new array type: +% \item One of the range delimiters in an array declaration is err¢neous. +% For example, \var{Array [1..1.25]} will trigger this error. +sym_e_forward_type_not_resolved=05009_E_No s'ha resolt el tipus posterior "$1" +% A symbolwas forward defined, but no declaration was encountered. +sym_e_only_static_in_static=05010_E_Només les variables estàtiques poden ser utilitzades en mètodes estàtics o fora dels mètodes +% A static method of an object can only access static variables. +sym_f_type_must_be_rec_or_class=05012_F_S'esperava un tipus de registre o classe +% The variable or expression isn't of the type \var{record} or \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_No es permeten les instàncies de les classes o els objectes amb un mètode abstracte +% You are trying to generate an instance of a class which has an abstract +% method that wasn't overridden. +sym_w_label_not_defined=05014_W_No s'ha definit l'etiqueta "$1" +% A label was declared, but not defined. +sym_e_label_used_and_not_defined=05015_E_S'està utilitzant l'etiqueta "$1" però no està definida +% A label was declared and used, but not defined. +sym_e_ill_label_decl=05016_E_La declaració de l'etiqueta no és vàlida +% This error should never happen; it occurs if a label is defined outside a +% procedure or function. +sym_e_goto_and_label_not_supported=05017_E_No es permeten GOTO i LABEL (utilitzeu el commutador -Sg) +% You must compile a program which has \var{label}s and \var{goto} statements +% with the \var{-Sg} switch. By default, \var{label} and \var{goto} aren't +% supported. +sym_e_label_not_found=05018_E_No s'ha trobat l'etiqueta +% A \var{goto label} was encountered, but the label isn't declared. +sym_e_id_is_no_label_id=05019_E_L'identificador no és una etiqueta +% The identifier specified after the \var{goto} isn't of type label. +sym_e_label_already_defined=05020_E_L'etiqueta ja està definida +% You are defining a label twice. You can define a label only once. +sym_e_ill_type_decl_set=05021_E_Declaració de tipus il·legal dels elements del conjunt +% The declaration of a set contains an invalid type definition. +sym_e_class_forward_not_resolved=05022_E_No s'ha resolt la definició de la classe posterior "$1" +% You declared a class, but you did not implement it. +sym_n_unit_not_used=05023_H_No s'utilitza l'unitat "$1" en $2 +% The unit referenced in the \var{uses} clause is not used. +sym_h_para_identifier_not_used=05024_H_No s'utilitza el paràmetre "$1" +% The identifier was declared (locally or globally) but +% was not used (locally or globally). +sym_n_local_identifier_not_used=05025_N_No s'utilitza la variable local "$1" +% You have declared, but not used a variable in a procedure or function +% implementation. +sym_h_para_identifier_only_set=05026_H_S'ha assignat el paràmetre del valor "$1" però no s'utilitza +% The identifier was declared (locally or globally) +% set but not used (locally or globally). +sym_n_local_identifier_only_set=05027_N_S'ha assignat la variable local "$1" però no s'utilitza +% The variable in a procedure or function +% implementation is declared, set but never used. +sym_h_local_symbol_not_used=05028_H_No s'utilitza $1 local "$2" +% A local symbol is never used. +sym_n_private_identifier_not_used=05029_N_No s'utilitza el camp privat "$1.$2" +sym_n_private_identifier_only_set=05030_N_S'ha assignat el camp privat "$1.$2" però no s'utilitza +sym_n_private_method_not_used=05031_N_No s'utilitza el mètode privat "$1.$2" +sym_e_set_expected=05032_E_S'esperava un tipus de conjunt +% The variable or expression is not of type \var{set}. This happens in an +% \var{in} statement. +sym_w_function_result_not_set=05033_W_No s'ha definit el resultat de la funció +% You can get this warning if the compiler thinks that a function return +% value is not set. This will not be displayed for assembler procedures, +% or procedures that contain assembler blocks. +sym_w_wrong_C_pack=05034_W_El tipus "$1" no està alineat correctament en el registre actual pel C +% Arrays with sizes not multiples of 4 will be wrongly aligned +% for C structures. +sym_e_illegal_field=05035_E_No es coneix l'identificador del camp del registre "$1" +% The field doesn't exist in the record/object definition. +sym_w_uninitialized_local_variable=05036_W_No s'ha inicialitzat la variable local "$1" +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_w_uninitialized_variable=05037_W_No s'ha inicialitzat la variable "$1" +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_e_id_no_member=05038_E_L'identificador "$1" no identifica cap membre +% This error is generated when an identifier of a record, +% field, or method is accessed while it is not defined. +sym_h_param_list=05039_H_S'ha trobat la declaració: $1 +% You get this when you use the \var{-vh} switch. In case an overloaded +% procedure is not found, then all candidate overloaded procedures are +% listed, with their parameter lists. +sym_e_segment_too_large=05040_E_L'element de dades és massa llarg +% You get this when you declare an array whose size exceeds the +% prescribed limit (2 Gb on 80368+/68020+ processors) +sym_e_no_matching_implementation_found=05042_E_S'ha trobat una implementació pel mètode d'interfície "$1" que no concorda +% There was no matching method found which could implement the interface +% method. Check argument types and result type of the methods. +sym_w_deprecated_symbol=05043_W_Es desaconsella el símbol "$1" +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit/library. Usage of this symbol +% should be avoied as much as possible. +sym_w_non_portable_symbol=05044_W_El símbol "$1" no és portable +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{platform} is used. This symbol's value, usage +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_non_implemented_symbol=05055_W_El símbol "$1" no està implementat +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{unimplemented} is used. This symbol is defined, +% but is not yet implemented on this specific platform. +sym_e_cant_create_unique_type=05056_E_No es pot crear un tipus únic a partir d'aquest tipus +% Only simple types like ordinal, float and string types are supported when +% redefining a type with \var{type newtype = type oldtype;} +% \end{description} +sym_h_uninitialized_local_variable=05057_H_La variable local "$1" no està inicialitzada +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_h_uninitialized_variable=05058_H_La variable "$1" no està inicialitzada +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +# +# Codegenerator +# +# 06045 is the last used one +# +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +cg_e_parasize_too_big=06009_E_El tamany de la llista de paràmetres excedeix els 65535 octets +% The I386 processor limits the parameter list to 65535 bytes (the \var{RET} +% instruction causes this) +cg_e_file_must_call_by_reference=06012_E_Els tipus del fitxer han de ser paràmetres variables +% You cannot specify files as value parameters, i.e. they must always be +% declared \var{var} parameters. +cg_e_cant_use_far_pointer_there=06013_E_Aquí no es permet l'ús de punters de tipus FAR +% Free Pascal doesn't support far pointers, so you cannot take the address of +% an expression which has a far reference as a result. The \var{mem} construct +% has a far reference as a result, so the following code will produce this +% error: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_No es poden cridar les funcions declarades amb EXPORT +% No longer in use. +cg_w_member_cd_call_from_method=06016_W_Possiblement s'ha produït una crida il·legal d'un constructor o destructor +% The compiler detected that a constructor or destructor is called within a +% method. This will probably lead to problems, since contructors/destructors +% require parameters on entry +cg_n_inefficient_code=06017_N_El codi és ineficient +% You statement seems dubious to the compiler. +cg_w_unreachable_code=06018_W_Aquest codi no s'executa mai +% You specified a construct which will never be executed. Example: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_Els mètodes abstractes no es poden cridar directament +% You cannot call an abstract method directy, instead you must call a +% overriding child method, because an abstract method isn't implemented. +cg_d_register_weight=06027_DL_Registre $1 pes $2 $3 +% Debugging message. Shown when the compiler considers a variable for +% keeping in the registers. +cg_d_stackframe_omited=06029_DL_S'omet l'estructura de la pila +% Some procedure/functions do not need a complete stack-frame, so it is omitted. +% This message will be displayed when the {-vd} switch is used. +cg_e_unable_inline_object_methods=06031_E_No es poden inserir mètodes d'objectes o classes +% You cannot have inlined object methods. +cg_e_unable_inline_procvar=06032_E_No es poden inserir crides a procvar +% A procedure with a procedural variable call cannot be inlined. +cg_e_no_code_for_inline_stored=06033_E_No hi ha codi enmagetzemat pel procediment inserit +% The compiler couldn't store code for the inline procedure. +cg_e_can_access_element_zero=06035_E_No es pot accedir a l'element zero d'un ansi/wide- o longstring, utilitzeu (set)length +% You should use \var{setlength} to set the length of an ansi/wide/longstring +% and \var{length} to get the length of such a string types +cg_e_cannot_call_cons_dest_inside_with=06037_E_No es poden cridar constructors o destructors dins de la clàusula 'with' +% Inside a \var{with} clause you cannot call a constructor or destructor for the +% object you have in the \var{with} clause. +cg_e_cannot_call_message_direct=06038_E_No es poden cridat els mètodes manipuladors de missatges directament +% A message method handler method cannot be called directly if it contains an +% explicit self argument +cg_e_goto_inout_of_exception_block=06039_E_Hi ha un salt dins o fora d'un block d'excepció +% It is not allowed to jump in or outside of an exception block like \var{try..finally..end;}: +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // this line will cause an error +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_No es permeten les declaracions de control de flux en un bloc finally +% It isn't allowed to use the control flow statements \var{break}, +% \var{continue} and \var{exit} +% inside a finally statement. The following example shows the problem: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // This exit ISN'T allowed +% end; +% ... +% +% \end{verbatim} +% If the procedure \var{p} raises an exception the finally block is +% executed. If the execution reaches the exit, it's unclear what to do: +% exiting the procedure or searching for another exception handler +cg_w_parasize_too_big=06041_W_El tamany dels paràmetres excedeix el límit per determinades cpu's +% This indicates that you are declaring more than 64k ok parameters, which +% might not be supported on other processor targets. +cg_w_localsize_to_big=06042_W_El tamany de la variable local excedeix el límit per determinades cpu's +% This indicates that you are declaring more than 32k of local variables, which +% might not be supported on other processor targets. +cg_e_localsize_too_big=06043_E_Les variables locals excedeixen el límit permès +% This indicates that you are declaring more than 32k of local variables, which +% is not supported by this processor. +cg_e_break_not_allowed=06044_E_No es permet BREAK +% You're trying to use \var{break} outside a loop construction. +cg_e_continue_not_allowed=06045_E_No es permet CONTINUE +% You're trying to use \var{continue} outside a loop construction. +% \end{description} +# EndOfTeX +# +# Assembler reader +# +# 07097 is the last one used +# +asmr_d_start_reading=07000_DL_S'està començant l'analització del bloc d'assemblador $1 +% This informs you that an assembler block is being parsed +asmr_d_finish_reading=07001_DL_S'ha finalitzat l'analizació del bloc d'assemblador $1 +% This informs you that an assembler block has finished. +asmr_e_none_label_contain_at=07002_E_Un patró que no és una etiqueta conté @ +% A identifier which isn't a label can't contain a @. +asmr_e_building_record_offset=07004_E_S'ha produït un error mentre es muntava el desplaçament del registre +% There has an error occured while building the offset of a record/object +% structure, this can happend when there is no field specified at all or +% an unknown field identifier is used. +asmr_e_offset_without_identifier=07005_E_S'està utilitzant OFFSET sense identificador +% You can only use OFFSET with an identifier. Other syntaxes aren't +% supported +asmr_e_type_without_identifier=07006_E_S'està utilitzant TYPE sense identificador +% You can only use TYPE with an identifier. Other syntaxes aren't +% supported +asmr_e_no_local_or_para_allowed=07007_E_Aquí no es poden utilitzar variables locals o paràmetres +% You can't use a local variable or parameter here, mostly because the +% addressing of locals and parameters is done using the frame pointer register so the +% address can't be obtained directly. +asmr_e_need_offset=07008_E_Aquí heu d'utilitzar OFFSET +% You need to use OFFSET <id> here to get the address of the identifier. +asmr_e_need_dollar=07009_E_Aquí heu d'utilitzar $ +% You need to use $<id> here to get the address of the identifier. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_No es poden utilitzar multiples símbols reassignats +% You can't have more than one relocatable symbol (variable/typed constant) +% in one argument. +asmr_e_only_add_relocatable_symbol=07011_E_Els símbols reassignats només es poden afegir +% Relocatable symbols (variable/typed constant) can't be used with other +% operators. Only addition is allowed. +asmr_e_invalid_constant_expression=07012_E_L'expressió constant no és vàlida +% There is an error in the constant expression. +asmr_e_relocatable_symbol_not_allowed=07013_E_No es permet el símbol reassignat +% You can't use a relocatable symbol (variable/typed constant) here. +asmr_e_invalid_reference_syntax=07014_E_La sintaxi de la referència no és vàlida +% There is an error in the reference. +asmr_e_local_para_unreachable=07015_E_No podeu accedir a $1 des d'aquest codi +% You can not read directly the value of local or para +% of a higher level in assembler code (except for +% local assembler code without parameter nor locals). +asmr_e_local_label_not_allowed_as_ref=07016_E_No es permeten els símbols i etiquetes locals com a referències +% You can't use local symbols/labels as references +asmr_e_wrong_base_index=07017_E_L'utilització de la base i índex del registre no és vàlida +% There is an error with the base and index register, they are +% probably incorrect +asmr_w_possible_object_field_bug=07018_W_Hi ha un possible error en la manipulació del camp de l'objecte +% Fields of objects or classes can be reached directly in normal or objfpc +% modes but TP and Delphi modes treat the field name as a simple offset. +asmr_e_wrong_scale_factor=07019_E_S'ha especificat un factor de l'escala erroni +% The scale factor given is wrong, only 1,2,4 and 8 are allowed +asmr_e_multiple_index=07020_E_S'estan utilitzant múltiples registres d'índex +% You are trying to use more than one index register +asmr_e_invalid_operand_type=07021_E_El tipus de l'operand no és vàlid +% The operand type doesn't match with the opcode used +asmr_e_invalid_string_as_opcode_operand=07022_E_La cadena $1 no és vàlida com operand opcode +% The string specified as operand is not correct with this opcode +asmr_w_CODE_and_DATA_not_supported=07023_W_No es permet l'ús de @CODE i @DATA +% @CODE and @DATA are unsupported and are ignored. +asmr_e_null_label_ref_not_allowed=07024_E_No es permeten les referències a etiquetes nul·les +asmr_e_expr_zero_divide=07025_E_Divisió per zero en l'avaluador asm +% There is a division by zero in a constant expression +asmr_e_expr_illegal=07026_E_L'expressió és il·legal +% There is an illegal expression in a constant expression +asmr_e_escape_seq_ignored=07027_E_S'ignora la seqüència d'escapament: $1 +% There is a C-styled string, but the escape sequence in the string +% is unknown, and is therefore ignored +asmr_e_invalid_symbol_ref=07028_E_La referència del símbol no és vàlida +asmr_w_fwait_emu_prob=07029_W_Fwait pot causar problemes d'emulació amb emu387 +asmr_w_fadd_to_faddp=07030_W_S'ha traduït $1 sense operand a $1P +asmr_w_enter_not_supported_by_linux=07031_W_El Kernel del Linux no permet l'instrucció ENTER +% ENTER instruction can generate a stack page fault that is not +% caught correctly by the i386 Linux page handler. +asmr_w_calling_overload_func=07032_W_S'està cridant a una funció sobrecarregada en asm +% There is a call to an overloaded method in the assembler block, +% this might be the sign there is a problem +asmr_e_unsupported_symbol_type=07033_E_El tipus del símbol no és compatible amb l'operand +asmr_e_constant_out_of_bounds=07034_E_El valor de la constant està fora dels límits +asmr_e_error_converting_decimal=07035_E_S'ha produït un error mentre es convertia el decimal $1 +% A constant decimal value doen not have the correct syntax +asmr_e_error_converting_octal=07036_E_S'ha produït un error mentre es convertia l'octal $1 +% A constant octal value does not have the correct syntax +asmr_e_error_converting_binary=07037_E_S'ha produït un error mentre es convertia el binari $1 +% A constant binary value does not have the correct syntax +asmr_e_error_converting_hexadecimal=07038_E_S'ha produït un error mentre es convertia l'hexadecimal $1 +% A constant hexadecimal value does not have the correct syntax +asmr_h_direct_global_to_mangled=07039_H_S'ha traduït $1 a $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 està associat a una funció sobrecarregada +asmr_e_cannot_use_SELF_outside_a_method=07041_E_No es pot utilitzar SELF fora d'un mètode +% There is a reference to the \var{self} symbol while it is not +% allowed. \var{self} can only be referenced inside methods +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_No es pot utilitzar OLDEBP fora d'un procediment niat +% There is a reference to the \var{oldebp} symbol while it is not +% allowed. \var{oldebp} can only be referenced inside nested routines +asmr_e_void_function=07043_W_Els procediments no poden retornar cap valor en codi asm +% Trying to return a value while in a procedure. A procedure +% does not have any return value +asmr_e_SEG_not_supported=07044_E_No es permet SEG +asmr_e_size_suffix_and_dest_dont_match=07045_E_El tamany de sufix i objectiu o el tamany de l'origen no concorden +% The register size and the opcode size suffix does not match. This is +% probably an error in the assembler statement +asmr_w_size_suffix_and_dest_dont_match=07046_W_El tamany de sufix i objectiu o el tamany de l'origen no concorden +% The register size and the opcode size suffix does not match. This is +% probably an error in the assembler statement +asmr_e_syntax_error=07047_E_Error de sintaxi de l'assemblador +% There is an assembler syntax error +asmr_e_invalid_opcode_and_operand=07048_E_La combinació d'opcode i operands no és vàlida +% The opcode cannot be used with this type of operand +asmr_e_syn_operand=07049_E_S'ha trobat un error de sintaxi de l'assemblador en l'operand +asmr_e_syn_constant=07050_E_S'ha trobat un error de sintaxi de l'assemblador en la constant +asmr_e_invalid_string_expression=07051_E_L'expressió de la cadena no és vàlida +asmr_w_const32bit_for_address=07052_W_Constant amb símbol $1 per una adreça que no és en un punter +% A constant expression represents an address which does not fit +% into a pointer. The address is probably incorrect +asmr_e_unknown_opcode=07053_E_Es desconeix l'opcode $1 +% This opcode is not known +asmr_e_invalid_or_missing_opcode=07054_E_Falta opcode o no és vàlid +asmr_e_invalid_prefix_and_opcode=07055_E_La combinació del prefix i l'opcode $1 no és vàlida +asmr_e_invalid_override_and_opcode=07056_E_La combinació de override i opcode $1 no és vàlida +asmr_e_too_many_operands=07057_E_Hi ha massa operands en la línia +% There are too many operands for this opcode. Check your +% assembler syntax +asmr_w_near_ignored=07058_W_S'ignora NEAR +asmr_w_far_ignored=07059_W_S'ignora FAR +asmr_e_dup_local_sym=07060_E_El símbol local $1 està duplicat +asmr_e_unknown_local_sym=07061_E_El símbol local $1 no està definit +asmr_e_unknown_label_identifier=07062_E_No es coneix l'identificador de l''etiqueta $1 +asmr_e_invalid_register=07063_E_El nom del registre no és vàlid +% There is an unknown register name used as operand +asmr_e_invalid_fpu_register=07064_E_El nom del registre de punt flotant no és vàlid +asmr_w_modulo_not_supported=07066_W_No es permet l'ús del mòdul +asmr_e_invalid_float_const=07067_E_La constant de punt flotant $1 no és vàlida +% The floating point constant declared in an assembler block is invalid +asmr_e_invalid_float_expr=07068_E_L'expressió de punt flotant no és vàlida +% The floating point expression declared in an assembler block is invalid +asmr_e_wrong_sym_type=07069_E_El tipus del símbol no és correcte +asmr_e_cannot_index_relative_var=07070_E_No es pot indexar una variable local o un paràmetre amb un registre +% Trying to index using a base register a symbol which is already relative +% to a register. This is not possible, and will probably lead to crashes. +asmr_e_invalid_seg_override=07071_E_L'expressió que sobreescriu el segment no és vàlida +asmr_w_id_supposed_external=07072_W_S'assumeix l'identificador $1 com extern +% There is a reference to an undefined symbol. This will not result +% in an error, since the symbol might be external, but may cause +% problems at link time if the symbol is not defined anywhere. +asmr_e_string_not_allowed_as_const=07073_E_No es permeten les cadenes com a constants +% Character strings are not allowed as constants. +asmr_e_no_var_type_specified=07074_E_No s'ha especificat el tipus de la variable +% The syntax expects a type idenfitifer after the dot, but +% none was found. +asmr_w_assembler_code_not_returned_to_text=07075_E_El codi de l'assemblador no ha retornat a la secció de text +% There was a directive in the assembler block to change sections, +% but there is a missing return to the text section at the end +% of the assembler block. This might cause errors during link time. +asmr_e_not_directive_or_local_symbol=07076_E_$1 no és una directiva o un símbol local +% This symbol is unknown. +asmr_w_using_defined_as_local=07077_E_S'està utilitzant un nom definit com una etiqueta local +asmr_e_dollar_without_identifier=07078_E_S'està utilitzant el símbol Dol·lar sense un identificador +% A constant expression has an identifier which does not start with +% the $ symbol. +asmr_w_32bit_const_for_address=07079_W_L'adreça ha creat una constant de 32bit +% A constant was used as an address. This is probably an error, +% since using absolute addresses will probably not work. +asmr_n_align_is_target_specific=07080_N_.align és específic de la plataforma, utilitzeu .balign o .p2align +% Using the .align directive is platform specific, and its meaning will vary +% from one platform to another. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_Els paràmetres no poden accedir directament als camps +% You should load the parameter first into a register and then access the +% fields using that register. +asmr_e_cannot_access_object_field_directly=07082_E_No es pot accedir directament als camps dels objectes o classes +% You should load the self pointer first into a register and then access the +% fields using the register as base. By default the self pointer is available +% in the esi register on i386. +asmr_e_unable_to_determine_reference_size=07083_E_No s'ha especificat el tamany i no es pot determinar el tamany dels operands +% You should specify explicity a size for the reference, because +% compiler is unable to determine what size (byte, word, dword, etc.) it +% should use for the reference. +asmr_e_cannot_use_RESULT_here=07084_E_No es pot utilitzar RESULT en aquesta funció +% Some functions which return complex types cannot use the \var{result} +% keyword. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" sense operand s'ha traduït a "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" s'ha traduït a "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" s'ha traduït a "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_Aquí no es permet el caràcter < +% The shift operator requires the << characters. Only one +% of those characters was found. +asmr_e_invalid_char_greater=07090_E_Aquí no es permet el caràcter > +% The shift operator requires the >> characters. Only one +% of those characters was found. +asmr_w_align_not_supported=07093_W_No es permet l'ús d'ALIGN +asmr_e_no_inc_and_dec_together=07094_E_Inc i Dec no poden estar junts +% Trying to use an increment and a decrement within the same +% opcode on the 680x0. This is impossible. +asmr_e_invalid_reg_list_in_movem=07095_E_El reglist no és vàlid pel movem +% Trying to use the \var{movem} opcode with invalid registers +% to save or restore. +asmr_e_invalid_reg_list_for_opcode=07096_E_El reglist no és vàlid per l'opcode +asmr_e_68020_mode_required=07097_E_Es requereix un mode de cpu més alt ($1) +% Trying to use an instruction which is not supported in the current +% cpu mode. Use a higher cpu generation to be able to use this +% opcode in your assembler block +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_No s'ha especificat i no es pot determinar el tamany dels operands, s'està utilitzant DWORD com a predeterminat +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use DWORD as default. +asmr_e_illegal_shifterop_syntax=07099_E_S'ha trobat un error de sintaxi mentre s'analitzava un operand desplaçat +% ARM only, ARM assembler supports a so called shifter operand. The used syntax isn't +% a valid shifter operand. Example for an operation with shifter operand: +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +# +# Assembler/binary writers +# +# 08018 is the last one used +# +asmw_f_too_many_asm_files=08000_F_Hi ha massa arxius d'assemblador oberts +% With smartlinking enabled, there are too many assembler +% files generated. Disable smartlinking. +asmw_f_assembler_output_not_supported=08001_F_L'assemblador de sortida seleccionat no és compatible +asmw_f_comp_not_supported=08002_F_No es permet l'ús de COMP +asmw_f_direct_not_supported=08003_F_Direct no és compatible amb els escriptors binaris +% Direct assembler mode is not supported for binary writers. +asmw_e_alloc_data_only_in_bss=08004_E_Només es permet l'assignació de dades en la secció bss +asmw_f_no_binary_writer_selected=08005_F_No s'ha seleccionat un escriptor binari +asmw_e_opcode_not_in_table=08006_E_Asm: L'opcode $1 no és a la taula +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 la combinació d'opcode i operands no és vàlida +asmw_e_16bit_not_supported=08008_E_Asm: No es permeten les referències de 16 Bits +asmw_e_invalid_effective_address=08009_E_Asm: L'adreça actual no és vàlida +asmw_e_immediate_or_reference_expected=08010_E_Asm: S'esperava immediat o referència +asmw_e_value_exceeds_bounds=08011_E_Asm: el valor $1 excedeix el límit $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: El salt curt està fora de l'abast $1 +asmw_e_undefined_label=08013_E_Asm: L'etiqueta $1 no està definida +asmw_e_comp_not_supported=08014_E_Asm: El tipus comp no està permès en aquest objectiu +asmw_e_extended_not_supported=08015_E_Asm: El tipus Extended no està permès en aquest objectiu +asmw_e_duplicate_label=08016_E_Asm: L'etiqueta $1 està duplicada +asmw_e_redefined_label=08017_E_Asm: S'ha tornat a definir l'etiqueta $1 +asmw_e_first_defined_label=08018_E_Asm: Aquí s'ha definit primer +asmw_e_invalid_register=08019_E_Asm: el registre $1 no és vàlid +# +# Executing linker/assembler +# +# 09034 is the last one used +# +# BeginOfTeX +% +% \section{Errors of assembling/linking stage} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +exec_w_source_os_redefined=09000_W_S'ha tornat a definir el SO d'origen +exec_i_assembling_pipe=09001_I_S'està assemblant (canonada) $1 +exec_d_cant_create_asmfile=09002_E_No es pot crear el fitxer d'assemblador $1 +% The mentioned file can't be create. Check if you've +% permission to create this file +exec_e_cant_create_objectfile=09003_E_No es pot creat el fitxer objecte $1 +% The mentioned file can't be create. Check if you've +% permission to create this file +exec_e_cant_create_archivefile=09004_E_No es pot crear l'arxiu $1 +% The mentioned file can't be create. Check if you've +% permission to create this file +exec_w_assembler_not_found=09005_W_No s'ha trobat l'assemblador $1, s'està canviant a assemblament extern +exec_t_using_assembler=09006_T_S'està utilitzant l'assemblador $1 +exec_w_error_while_assembling=09007_W_S'ha produït un error mentre s'assemblava el codi de sortida $1 +% There was an error while assembling the file using an external assembler. +% Consult the documentation of the assembler tool to find out more information +% on this error. +exec_w_cant_call_assembler=09008_W_No es pot cridar l'assemblador, error $1 canviant a assemblament extern +exec_i_assembling=09009_I_S'està assemblant $1 +exec_i_assembling_smart=09010_I_S'està assemblant amb enllaçament intel·ligent $1 +exec_w_objfile_not_found=09011_W_No s'ha trobat l'objecte $1, l'enllaçament pot fallar ! +% One of the object file is missing, and linking will probably fail. +% Check your paths. +exec_w_libfile_not_found=09012_W_No s'ha trobat la biblioteca $1, l'enllaçament pot fallar ! +% One of the library file is missing, and linking will probably fail. +% Check your paths. +exec_w_error_while_linking=09013_W_S'ha produït un error mentre s'enllaçava +% Generic error while linking. +exec_w_cant_call_linker=09014_W_No es pot cridar l'enllaçador, s'està canviant a l'enllaçament extern +exec_i_linking=09015_I_S'està enllaçant $1 +exec_w_util_not_found=09016_W_No s'ha trobat l'utilitat $1, s'està canviant a enllaçament extern +exec_t_using_util=09017_T_S'està utilitzant l'utilitat $1 +exec_e_exe_not_supported=09018_E_No es permet la creació d'executables +exec_e_dll_not_supported=09019_E_No es permet la creació de biblioteques dinàmiques/compartides +exec_i_closing_script=09020_I_S'està tancant la seqüència $1 +exec_w_res_not_found=09021_W_No s'ha trobat el compilador del recurs, s'està canviant a mode extern +exec_i_compilingresource=09022_I_S'està compilant el recurs $1 +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_No es pot enllaçar estàticament l'unitat $1, s'està canviant a enllaçament intel·ligent +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_No es pot utilitzar l'enllaçament intel·ligent amb l'unitat $1, s'està canviant a enllaçament estàtic. +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_No es pot utilitzar l'enllaçament compartit amb l'unitat $1, s'està canviant a enllaçament estàtic +exec_e_unit_not_smart_or_static_linkable=09026_E_No es pot enllaçar l'unitat $1 ni estàticament ni dinàmicament +exec_e_unit_not_shared_or_static_linkable=09027_E_No es pot utilitzar l'enllaçament compartit ni estàtic amb l'unitat $1. +%\end{description} +# EndOfTeX +# +# Executable information +# +execinfo_f_cant_process_executable=09128_F_No es pot post-processar l'executable $1 +execinfo_f_cant_open_executable=09129_F_No es pot obrir l'executable $1 +execinfo_x_codesize=09130_X_Tamany del codi: $1 octets +execinfo_x_initdatasize=09131_X_Tamany de les dades inicialitzades: $1 octets +execinfo_x_uninitdatasize=09132_X_Tamany de les dades sense inicialitzar: $1 octets +execinfo_x_stackreserve=09133_X_Espai reservat per la pila: $1 octets +execinfo_x_stackcommit=09134_X_Espai utilitzat per la pila: $1 octets +# +# Unit loading +# +# 10041 is the last used one +# +# BeginOfTeX +% \section{Unit loading messages.} +% This section lists all messages that can occur when the compiler is +% loading a unit from disk into memory. Many of these messages are +% informational messages. +% \begin{description} +unit_t_unitsearch=10000_T_S'està cercant l'unitat: $1 +% When you use the \var{-vt}, the compiler tells you where it tries to find +% unit files. +unit_t_ppu_loading=10001_T_S'està carregant la PPU $1 +% When the \var{-vt} switch is used, the compiler tells you +% what units it loads. +unit_u_ppu_name=10002_U_Nom de la PPU: $1 +% When you use the \var{-vu} flag, the unit name is shown. +unit_u_ppu_flags=10003_U_Senyaladors de la PPU: $1 +% When you use the \var{-vu} flag, the unit flags are shown. +unit_u_ppu_crc=10004_U_Crc de la PPU: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_time=10005_U_Temps de la PPU: $1 +% When you use the \var{-vu} flag, the unit time is shown. +unit_u_ppu_file_too_short=10006_U_El fitxer PPU és massa curt +% When you use the \var{-vu} flag, the unit time is shown. +unit_u_ppu_invalid_header=10007_U_L'encapçalament de la PPU no és vàlid (no hi ha PPU al principi) +% A unit file contains as the first three bytes the ascii codes of \var{PPU} +unit_u_ppu_invalid_version=10008_U_La versió $1 de la PPU no és vàlida +% This unit file was compiled with a different version of the compiler, and +% cannot be read. +unit_u_ppu_invalid_processor=10009_U_La PPU està compilada per a un altre processador +% This unit file was compiled for a different processor type, and +% cannot be read +unit_u_ppu_invalid_target=10010_U_La PPU està compilada per un altre objectiu +% This unit file was compiled for a different processor type, and +% cannot be read +unit_u_ppu_source=10011_U_font PPU: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_write=10012_U_S'està escrivint $1 +% When you specify the \var{-vu} switch, the compiler will tell you where it +% writes the unit file. +unit_f_ppu_cannot_write=10013_F_No es pot escriure el fitxer PPU +% An error occurred when writing the unit file. +unit_f_ppu_read_error=10014_F_No es pot llegir el fitxer PPU +% This means that the unit file was corrupted, and contains invalid +% information. Recompilation will be necessary. +unit_f_ppu_read_unexpected_end=10015_F_No s'esperava el final del fitxer PPU +% Unexpected end of file. This may mean that the PPU file is +% corrupted. +unit_f_ppu_invalid_entry=10016_F_Entrada invàlida en el fitxer PPU: $1 +% The unit the compiler is trying to read is corrupted, or generated with a +% newer version of the compiler. +unit_f_ppu_dbx_count_problem=10017_F_Hi ha hagut un problema calculant el Dbx de la PPU +% There is an inconsistency in the debugging information of the unit. +unit_e_illegal_unit_name=10018_E_El nom de l'unitat és il·legal: $1 +% The name of the unit doesn't match the file name. +unit_f_too_much_units=10019_F_Hi ha massa unitats +% \fpc has a limit of 1024 units in a program. You can change this behavior +% by changing the \var{maxunits} constant in the \file{files.pas} file of the +% compiler, and recompiling the compiler. +unit_f_circular_unit_reference=10020_F_Hi ha una referència circular entre les unitats $1 i $2 +% Two units are using each other in the interface part. This is only allowed +% in the \var{implementation} part. At least one unit must contain the other one +% in the \var{implementation} section. +unit_f_cant_compile_unit=10021_F_No es pot compilar l'unitat $1, no hi ha les fonts disponibles +% A unit was found that needs to be recompiled, but no sources are +% available. +unit_f_cant_find_ppu=10022_F_No es pot trobar l'unitat $1 +% You tried to use a unit of which the PPU file isn't found by the +% compiler. Check your config files for the unit pathes +unit_w_unit_name_error=10023_W_No es pot trobar l'unitat $1, però hi ha la $2 +unit_f_unit_name_error=10024_F_S'estava cercant l'unitat $1, però s'ha trobat $2 +% Dos truncation of 8 letters for unit PPU files +% may lead to problems when unit name is longer than 8 letters. +unit_w_switch_us_missed=10025_W_Per compilar l'unitat System es necessita el commutador -Us +% When recompiling the system unit (it needs special treatment), the +% \var{-Us} must be specified. +unit_f_errors_in_unit=10026_F_Hi ha hagut $1 errors compilant el mòdul, s'ha aturat! +% When the compiler encounters a fatal error or too many errors in a module +% then it stops with this message. +unit_u_load_unit=10027_U_S'està carregant desde $1 ($2) l'unitat $3 +% When you use the \var{-vu} flag, which unit is loaded from which unit is +% shown. +unit_u_recompile_crc_change=10028_U_S'està tornant a compilar $1, s'ha canviat la suma de verificació a $2 +unit_u_recompile_source_found_alone=10029_U_S'està tornant a compilar $1, només s'han trobat les fonts +% When you use the \var{-vu} flag, these messages tell you why the current +% unit is recompiled. +unit_u_recompile_staticlib_is_older=10030_U_S'està tornant a compilar l'unitat, la biblioteca estàtica és més vella que el fitxer ppu +% When you use the \var{-vu} flag, the compiler warns if the static library +% of the unit are older than the unit file itself. +unit_u_recompile_sharedlib_is_older=10031_U_S'està tornant a compilar l'unitat, la biblioteca compartida és més vella que el fitxer ppu +% When you use the \var{-vu} flag, the compiler warns if the shared library +% of the unit are older than the unit file itself. +unit_u_recompile_obj_and_asm_older=10032_U_S'està tornant a compilar l'unitat, obj i asm son més vells que el fitxer ppu +% When you use the \var{-vu} flag, the compiler warns if the assembler of +% object file of the unit are older than the unit file itself. +unit_u_recompile_obj_older_than_asm=10033_U_S'està tornant a compilar l'unitat, obj és més vell que asm +% When you use the \var{-vu} flag, the compiler warns if the assembler +% file of the unit is older than the object file of the unit. +unit_u_parsing_interface=10034_U_S'està analitzant l'interfície de $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the interface part of the unit +unit_u_parsing_implementation=10035_U_S'està analitzant l'implementació de $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the implementation part of the unit +unit_u_second_load_unit=10036_U_S'està carregant l'unitat $1 per segona vegada +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_check_time=10037_U_S'està comprovant el fitxer PPU $1 temps $2 +% When you use the \var{-vu} flag, the compiler show the filename and +% date and time of the file which a recompile depends on +### The following two error msgs is currently disabled +# unit_h_cond_not_set_in_last_compile=10038_H_El condicional $1 no ha estat inicialitzat al començament de la última compilació de $2 +# % When recompilation of an unit ies required the compiler will check that +# % the same conditionals are set for the recompilation. The compiler has +# % found a conditional that currently is defined, but was not used the last +# % time the unit was compiled +# unit_h_cond_set_in_last_compile=10039_H_El condicional $1 ha estat inicialitzat al començament de la última compilació de $2 +# % When recompilation of an unit is required the compiler will check that +# % the same conditionals are set for the recompilation. The compiler has +# % found a conditional that was used the last time the unit was compiled, but +# % the conditional is currently not defined. +unit_w_cant_compile_unit_with_changed_incfile=10040_W_No es pot tornar a compilar l'unitat $1, però s'han trobat fitxers inclosos modificats +% A unit was found to have modified include files, but +% some source files were not found, so recompilation is impossible. +unit_h_source_modified=10041_H_El fitxer $1 és més nou que la versió de la PPU $2 +% A modified source file for a unit was found that was compiled with the +% release flag (-Ur). The unit will not implicitly be recompiled because +% this release flag is set. +unit_u_ppu_invalid_fpumode=10042_U_S'està utilitzant una unitat la qual no ha estat compilada amb el mode FPU correcte +% Trying to compile code while using units which were not compiled with +% the same floating point format mode. Either all code should be compiled +% with FPU emulation on, or with FPU emulation off. +unit_u_loading_interface_units=10043_U_S'estan carregant les unitats d'INTERFACE desde $1 +% When you use the \var{-vu} flag, the compiler warms that it starts +% loading the units defined in the interface part of the unit +unit_u_loading_implementation_units=10044_U_S'estan carregant les unitat d'IMPLEMENTATION desde $1 +% When you use the \var{-vu} flag, the compiler warms that it starts +% loading the units defined in the implementation part of the unit +unit_u_interface_crc_changed=10045_U_L'interfície CRC ha canviat per la unitat $1 +% When you use the \var{-vu} flag, the compiler warms that it the +% CRC calculated for the interface has been changed after the implementation +% has been parsed +unit_u_implementation_crc_changed=10046_U_L'implementació CRC ha canviat per l'unitat $1 +% When you use the \var{-vu} flag, the compiler warms that it the +% CRC calculated has been changed after the implementation +% has been parsed +unit_u_finished_compiling=10047_U_S'ha acabat la compilació de l'unitat $1 +% When you use the \var{-vu} flag, the compiler warms that it +% has finished compiling the unit +unit_u_add_depend_to=10048_U_S'ha afegit la dependència de $1 a $2 +% When you use the \var{-vu} flag, the compiler warms that it +% has added a dependency between the two units +unit_u_no_reload_is_caller=10049_U_No es torna a carregar, es crida: $1 +% When you use the \var{-vu} flag, the compiler warms that it +% has will not reload the unit because it is the unit that wants +% to load this unit +unit_u_no_reload_in_second_compile=10050_U_No es torna a carregar, ja és en segona compilació: $1 +% When you use the \var{-vu} flag, the compiler warms that it +% has will not reload the unit because it is already in a second recompile +unit_u_flag_for_reload=10051_U_Senyalador per la recàrrega: $1 +% When you use the \var{-vu} flag, the compiler warms that it +% has to reload the unit +unit_u_forced_reload=10052_U_Es torna a carregar forçadament +% When you use the \var{-vu} flag, the compiler warms that it +% has is reloading the unit because it was required +unit_u_previous_state=10053_U_Estat previ de $1: $2 +% When you use the \var{-vu} flag, the compiler shows the +% previous state of the unit +unit_u_second_compile_unit=10054_U_S'està compilant l'unitat $1 per segona vegada +% When you use the \var{-vu} flag, the compiler warms that it starts +% recompiling a unit for the second time. This can happend with independent +% units +unit_u_loading_unit=10055_U_S'està carregant l'unitat $1 +% When you use the \var{-vu} flag, the compiler warms that it starts +% loading the unit +unit_u_finished_loading_unit=10056_U_S'ha acabat la càrrega de l'unitat $1 +% When you use the \var{-vu} flag, the compiler warms that it finished +% loading the unit +unit_u_registering_new_unit=10057_U_S'està registrant l'unitat nova $1 +% When you use the \var{-vu} flag, the compiler warms that it has +% found a new unit and registers it in the internal lists +unit_u_reresolving_unit=10058_U_S'està tornant a resoldre l'unitat $1 +% When you use the \var{-vu} flag, the compiler warms that it +% has to recalculate the internal data of the unit +unit_u_skipping_reresolving_unit=10059_U_No es torna a resoldre l'unitat $1, encara s'estan carregant les unitats utilitzades +% When you use the \var{-vu} flag, the compiler warms that it +% skips to recalculate the internal data of the unit because there +% is no data to racalculate +% \end{description} +# EndOfTeX +# +# Options +# +# 11039 is the las used one +# +option_usage=11000_O_$1 [opcions] <fitxer-entrada> [opcions] +# BeginOfTeX +% +% \section{Command-line handling errors} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +option_only_one_source_support=11001_W_Només es permet un fitxer font +% You can specify only one source file on the command line. The first +% one will be compiled, others will be ignored. This may indicate that +% you forgot a \var{'-'} sign. +option_def_only_for_os2=11002_W_El fitxer DEF només pot ser creat per OS/2 +% This option can only be specified when you're compiling for OS/2 +option_no_nested_response_file=11003_E_No es permeten els fitxers de resposta niats +% you cannot nest response files with the \var{@file} command-line option. +option_no_source_found=11004_F_No hi ha el nom del fitxer font en la línia d'ordres +% The compiler expects a source file name on the command line. +option_no_option_found=11005_N_No hi ha cap opció dins del fitxer de configuració $1 +% The compiler didn't find any option in that config file. +option_illegal_para=11006_E_El paràmetre $1 és il·legal +% You specified an unknown option. +option_help_pages_para=11007_H_-? escriu las pàgines de l'ajuda +% When an unknown option is given, this message is diplayed. +option_too_many_cfg_files=11008_F_Hi ha massa fitxers de configuració niats +% You can only nest up to 16 config files. +option_unable_open_file=11009_F_No es pot obrir el fitxer $1 +% The option file cannot be found. +option_reading_further_from=11010_N_S'estan llegint les opcions addicionals de $1 +% Displayed when you have notes turned on, and the compiler switches +% to another options file. +option_target_is_already_set=11011_W_L'objectiu ja està posat a $1 +% Displayed if more than one \var{-T} option is specified. +option_no_shared_lib_under_dos=11012_W_Les biblioteques compartides no estan permeses en la plataforma DOS, es canvia a estàtiques +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos +option_too_many_ifdef=11013_F_Hi ha massa IF(N)DEFs +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_many_endif=11014_F_Hi ha massa ENDIFs +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_less_endif=11015_F_Hi ha un condicional obert al final del fitxer +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_no_debug_support=11016_W_Aquest executable no permet la generació d'informació del depurador +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_Proveu de tornar a compilar amb -dGDB +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_E_Esteu utilitzant el commutador obsolet $1 +% this warns you when you use a switch that is not needed/supported anymore. +% It is recommended that you remove the switch to overcome problems in the +% future, when the switch meaning may change. +option_obsolete_switch_use_new=11019_E_Esteu utilitzant el commutador obsolet $1, si us plau, utilitzeu $2 +% this warns you when you use a switch that is not supported anymore. You +% must now use the second switch instead. +% It is recommended that you change the switch to overcome problems in the +% future, when the switch meaning may change. +option_switch_bin_to_src_assembler=11020_N_S'està canviant a assemblador d'escriptura del codi font a predeterminat +% this notifies you that the assembler has been changed because you used the +% -a switch which can't be used with a binary assembler writer. +option_incompatible_asm=11021_W_La sortida de l'assemblador seleccionada "$1" no és compatible amb "$2" +option_asm_forced=11022_W_S'utilitza l'assemblador "$1" forçadament +% The assembler output selected can not generate +% object files with the correct format. Therefore, the +% default assembler for this target is used instead. +option_using_file=11026_T_S'estan llegint les opcions del fitxer $1 +% Options are also read from this file +option_using_env=11027_T_S'estan llegint les opcions des de l'entorn $1 +% Options are also read from this environment string +option_handling_option=11028_D_S'està gestionant l'opció "$1" +% Debug info that an option is found and will be handled +option_help_press_enter=11029__*** Premeu <Intro> *** +option_start_reading_configfile=11030_H_S'està començant a llegir el fitxer de configuració $1 +% Starting of config file parsing. +option_end_reading_configfile=11031_H_S'ha acabat de llegir el fitxer de configuració $1 +% End of config file parsing +option_interpreting_option=11032_D_S'està executant l'opció "$1" +option_interpreting_firstpass_option=11036_D_S'està executant l'opció "$1" per 1ª vegada +option_interpreting_file_option=11033_D_S'està executant l'opció del fitxer "$1" +option_read_config_file=11034_D=11034_D_S'està llegint el fitxer de configuració "$1" +option_found_file=11035_D_S'ha trobat el nom del fitxer font "$1" +% Additional infos about options, displayed +% when you have debug option turned on. +option_code_page_not_available=11039_E_La pàgina del codi no està disponible +%\end{description} +# EndOfTeX + +# +# Logo (option -l) +# +option_logo=11023_[ +Free Pascal Compiler versió $FPCFULLVERSION [$FPCDATE] per $FPCCPU +Copyright (c) 1993-2011 per Florian Klaempfl +] + +# +# Info (option -i) +# +option_info=11024_[ +Free Pascal Compiler versió $FPCVERSION + +Data del compilador : $FPCDATE +CPU del compilador : $FPCCPU + +Plataformes compatibles : + $OSTARGETS + +Aquest programa ve sota la Llicència Pública General de GNU +Per a més informació llegiu COPYING.FPC + +Comuniqueu les errades, suggeriments, etc a: + http://bugs.freepascal.org +o + bugs@freepascal.org +] + +# +# Help pages (option -? and -h) +# +# The first character on the line indicates who will display this +# line, the current possibilities are : +# * = every target +# 3 = 80x86 targets +# 6 = 680x0 targets +# e = in extended debug mode only +# P = PowerPC targets +# S = Sparc targets +# V = Virtual machine targets +# The second character also indicates who will display this line, +# (if the above character was TRUE) the current possibilities are : +# * = everyone +# g = with GDB info supported by the compiler +# O = OS/2 +# L = UNIX systems +# The third character represents the indentation level. +# +option_help_pages=11025_[ +**0*_Poseu + després d'un commutador booleà per activar-lo, - per desactivar-lo +**1a_El compilador no eliminarà el fitxer d'assemblador generat +**2al_Escriu les línies del codi font en el fitxer de l'assemblador +**2an_Escriu l'informació del node en el fitxer d'assemblador +*L2ap_Utilitza canonades en lloc de crear fitxers temporals d'assemblador +**2ar_Escriu info.d'alotj/desalotj del registre en el fitxer d'assemblador +**2at_Escriu info.d'alotj/desalotj temporal en el fitxer d'assemblador +**1A<x>_format de la sortida: +**2Adefault_Utilitza assemblador predeterminat +3*2Aas_Utilitza assemblador GNU AS +3*2Anasmcoff_fitxer coff (Go32v2) utilitzant Nasm +3*2Aasmelf_fitxer elf32 (Linux) utilitzant Nasm +3*2Anasmwin32_fitxer objecte Win32 utilitzant Nasm +3*2Anasmwdosx_fitxer objecte Win32/WDOSX utilitzant Nasm +3*2Awasm_fitxer objecte utilitzant Wasm (Watcom) +3*2Anasmobj_fitxer objecte utilitzant Nasm +3*2Amasm_fitxer objecte utilitzant Masm (Microsoft) +3*2Atasm_fitxer objecte utilitzant Tasm (Borland) +3*2Aelf_elf32 (Linux) utilitzant escriptor intern +3*2Acoff_coff (Go32v2) utilitzant escriptor intern +3*2Apecoff_pecoff (Win32) utilitzant escriptor intern +4*2Aas_assemblar utilitzant el GNU AS +6*2Aas_fitxer objecte Unix utilitzant GNU AS +6*2Agas_assemblador GNU Motorola +6*2Amit_sintaxi MIT (antiga GAS) +6*2Amot_assemblador Motorola estàndard +A*2Aas_assemblar utilitzant GNU AS +P*2Aas_assemblar utilitzant GNU AS +S*2Aas_assemblar utilitzant GNU AS +**1b_Genera informació de navegador +**2bl_Genera informació dels símbols locals +**1B_Munta tots els mòduls +**1C<x>_Opcions de generació del codi: +**2Cc<x>_predetermina la convenció de crida a <x> +**2CD_Crea biblioteca dinàmica +**2Ce_Compilació amb opcodes emulats de coma flotant +**2Cf<x>_Selecciona instrucció fpu a utilitzar per <x> +**2Cg_Genera codi PIC +**2Ch<n>_<n> octets de la pila (entre 1023 i 67107840) +**2Ci_Comprova E/S +**2Cn_Omet l'enllaçament +**2Co_Comprova el desbordament de les operacions amb enters +**2Cr_Comprova l'abast +**2CR_Verifica la validesa de la crida dels objectes del mètode +**2Cs<n>_Posa el tamany de la pila a <n> +**2Ct_Comprova la pila +**2CX_Crea també biblioteca enllaçada intel·ligentment +**1d<x>_Defineix el símbol <x> +**1D_Genera un fitxer DEF +**2Dd<x>_Posa la descripció a <x> +**2Dv<x>_Posa la versió de DLL a <x> +*O2Dw_Aplicació PM +**1e<x>_Posa el camí a l'executable +**1E_Igual que -Cn +**1F<x>_Posa els noms dels fitxers i els camins: +**2Fa<x>[,y]_Carrega primer les unitats <x> i [y], abans d'analitzar USES +**2Fc<x>_Posa la pàgina del codi d'entrada a <x> +**2FD<x>_Posa el directori on buscar les utilitats del compilador +**2Fe<x>_Redirigeix la sortida dels errors a <x> +**2FE<x>_Posa el path de sortida d'executables i unitats a <x> +**2Fi<x>_Afegeix <x> al camí dels inclosos +**2Fl<x>_Afegeix <x> al camí de les llibreries +**2FL<x>_Utilitza <x> com enllaçador dinàmic +**2Fo<x>_Afegeix <x> al camí dels objectes +**2Fr<x>_Carrega el fitxer de missatges d'error <x> +**2Fu<x>_Afegeix <x> al camí de les unitats +**2FU<x>_Posa camí sortida de les unitats a <x>, substitueix -FE +*g1g_Genera informació del depurador: +*g2gc_genera controls pels punters +*g2gd_Utilitza dbx +*g2gg_Utilitza gsym +*g2gh_Utilitza l'unitat de traçat de la pila (depura pèrdua de memòria) +*g2gl_Utilitza l'unitat d'info. per mostrar +info per seguiments inversos +*g2gv_Genera programes traçables amb valgrind +*g2gw_Genera informació de depuració dwarf +**1i_Informació: +**2iD_Retorna la data del compilador +**2iV_Retorna la versió del compilador +**2iSO_Retorna el SO d'origen +**2iSP_Retorna el processador d'origen +**2iTO_Retorna el SO de destí +**2iTP_Retorna el processador de destí +**1I<x>_Afegeix <x> a la trajec.d'afegits +**1k<x>_Passa <x> a l'enllaçador +**1l_Escriu el logotipus +**1M<x>_Fica el mode del llenguatge a <x> +**2Mfpc_dialecte Free Pascal (predeterminat) +**2Mobjfpc_Activa algunes extensions Delphi 2 +**2Mdelphi_Intenta ser compatible amb Delphi +**2Mtp_Intenta ser compatible amb TP/BP 7.0 +**2Mgpc_Intenta ser compatible amb gpc +**2Mmacpas_Intenta ser compatible amb dialectes Pascal del Macintosh +**1n_No llegeix el fitxer de configuració predeterminat +**1o<x>_Canvia el nom de l'executable produït a <x> +**1O<x>_optimitzacions: +3*2Og_genera codi més petit +3*2OG_genera codi més ràpid (predeterminat) +**2Or_manté determinades variables en els registres +3*2Ou_habilita optimitzacions incertes (mireu docs) +3*2O1_optimitzacions de nivell 1 (ràpides) +3*2O2_optimitzacions de nivell 2 (-O1 + més lentes) +3*2O3_optimitzacions de nivell 3 (-O2 repetidament, max 5 vegades) +3*2Op<x>_processador de destí: +3*3Op1_posa el processador de destí a 386/486 +3*3Op2_posa el processador de destí a Pentium/PentiumMMX (r) +3*3Op3_posa el processador de destí a PPro/PII/c6x86/K6 (r) +6*2Og_genera codi més petit +6*2OG_genera codi més ràpid (predeterminat) +6*2Ox_optimitza al màxim (Encara no és segur !!!) +6*2O0_posa el processador de destí a MC68000 +6*2O2_posa el processador de destí a MC68020+ (predeterminat) +**1pg_genera codi de perfil per gprof (defineix FPC_PROFILE) +**1R<x>_Estil de lectura de l'assemblador: +**2Rdefault_utilitza l'assemblador predeterminat +3*2Ratt_llegeix assemblador d'estil AT&T +3*2Rintel_llegeix assemblador d'estil Intel +6*2RMOT_llegeix assemblador d'estil Motorola +**1S<x>_Opcions de sintaxi: +**2S2_Igual que -Mobjfpc +**2Sc_Permet operadors tipus C (*=,+=,/= i -=) +**2Sa_Inclou assertion code +**2Sd_Igual que -Mdelphi +**2Se_opcions d'error <x> és una combinació del següent: +**3*_<n>: el compilador s'atura després de <n> errors (predeterminat és 1) +**3*_w: el compilador s'atura també després dels avisos +**3*_n: el compilador s'atura també després de les notes +**3*_h: el compilador s'atura també després dels suggeriments +**2Sg_Permet LABEL i GOTO +**2Sh_Utilitza ansistrings +**2Si_Permet INLINE estil C++ +**2SI<x>_posa l'estil de l'interfície a <x> +**3SIcom_interfície compatible amb COM (predeterminat) +**3SIcorba_interfície compatible amb CORBA +**2Sm_Permet macros tipus C (globals) +**2So_Igual que -Mtp +**2Sp_Igual que -Mgpc +**2Ss_El nom del constructor ha de ser init (destructor = done) +**1s_No cridis l'assemblador ni l'enllaçador +**2sh_Genera la seqüència per enllaçar a l'anfitrió +**2st_Genera la seqüència per enllaçar al destí +**2sr_Salta la fase de localització de registres (utilitzeu amb -alr) +**1T<x>_sistema operatiu de destí: +3*2Termx_OS/2 via EMX (incloent extensor EMX/RSX) +3*2Tfreebsd_FreeBSD +3*2go32v2_versió 2 de DJ Deloire DOS extender +3*2Tlinux_Linux +3*2Tnetbsd_NetBSD +3*2Tnetware_Novell Netware Module (clib) +3*2Tnetwlibc_Novell Netware Module (libc) +3*2Topenbsd_OpenBSD +3*2Tos2_OS/2 eComStation +3*2Tsunos_SunOS/Solaris +3*2Twatcom_Watcom compatible DOS extender +3*2Twdosx_WDOSX DOS extender +3*2Twin32_Windows 32 Bit +4*2Tlinux_Linux +6*2Tamiga_Commodore Amiga +6*2Tatari_Atari ST/STe/TT +6*2Tlinux_Linux-68k +6*2Tmacos_Macintosh m68k (no compatible) +6*2Tpalmos_PalmOS +A*2Tlinux_Linux +P*2Tdarwin_Darwin i MacOS X en PowerPC +P*2Tlinux_Linux en PowerPC +P*2Tmacos_MacOS (clàssic) en PowerPC +P*2Tmorphos_MorphOS +S*2Tlinux_Linux +**1u<x>_Indefineix el símbol <x> +**1U_Opcions de l'unitat: +**2Un_No comprovar el nom de l'unitat +**2Ur_generate release unit files +**2Us_Compila una unitat del sistema +**1v<x>_Detall. <x> és una combinació de les següents lletres : +**2*_e : mostra errors (predet.) 0 : no mostrar res (excepte errors) +**2*_w : mostra avisos u : mostra info de les unitats +**2*_n : mostra notes t : mostra els fitxers selec./utilitz. +**2*_h : mostra suggeriments c : mostra els condicionals +**2*_i : mostra informació general d : mostra l'informació del depurador +**2*_l : mostra números de línia r : compatibilitat Rhide/GCC +**2*_a : mostra-ho tot x : informació de l'executable (win32) +**2*_v : escriu fpcdebug.txt amb p : escriu tree.log amb arbre analitzat +**2*_ molta informació de la depuració +3*1W<x>_Opcions per a plataformes tipus Win32 +3*2WB<x>_Imatge a valor hexadecimal <x> +3*2WC_Especifica aplicació tipus consola +3*2WD_Utilitza DEFFILE per exportar les funcions de DLL o EXE +3*2WF_Especifica aplicació tipus pantalla sencera (només OS/2) +3*2WG_Especifica aplicació de tipus gràfic +3*2WN_No generar codi deslocalitzat (necessari per la depuració) +3*2WR_Genera codi reagrupat +P*2WC_Especifica aplicació tipus consola (només MacOS) +P*2WG_Especifica aplicació gràfica (només MacOS) +P*2WT_Especifica aplicació tipus eina (eina MPW, només MacOS) +**1X_Opcions de l'executable: +**2Xc_passa --shared a l'enllaçador (només Unix) +**2Xd_no utilitzar el camí normalitzat de biblioteques (necessària per compilar entre diferents SO) +**2XD_intenta enllaçar les unitats dinàmicament (defineix FPC_LINK_DYNAMIC) +**2XP<x>_avant posar el prefix <x> als noms de les utilitats binaries +**2Xr<x>_posa el camí de les biblioteques a <x> (necessari per compilar entre diferents SO) +**2Xs_elimina tots els símbols de l'executable +**2XS_intenta enllaçar les unitats estàticament (predeterminat) (defineix FPC_LINK_STATIC) +**2Xt_enllaça amb biblioteques estàtiques (es passa -static a l'enllaçador) +**2XX_intenta enllaçar les unitats intel·ligentment (defineix FPC_LINK_SMART) +**1*_ +**1?_mostra aquesta ajuda +**1h_mostra aquesta ajuda sense esperar +] + +# +# The End... diff --git a/closures/compiler/msg/errord.msg b/closures/compiler/msg/errord.msg new file mode 100644 index 0000000000..9013b18937 --- /dev/null +++ b/closures/compiler/msg/errord.msg @@ -0,0 +1,3417 @@ +# +# German (alternative, LATIN-US DOS) Language File for Free Pascal +# Latest updates contributed by Karl-Michael Schindler aka mischi +# <karl-michael.schindler at web.de> +# +# Based on errore.msg of SVN revision 18275 +# +# This file is part of the Free Pascal Compiler +# Copyright (c) 1998-2010 by the Free Pascal Development team +# +# 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. +# +# +# The constants are build in the following order: +# <part>_<type>_<txtidentifier> +# +# <part> is the part of the compiler the message is used +# asmr_ assembler parsing +# asmw_ assembler writing/binary writers +# unit_ unit handling +# scan_ scanner +# parser_ parser +# type_ type checking +# general_ general info +# exec_ calls to assembler, linker, binder +# link_ internal linker +# +# <type> the type of the message it should normally used for +# f_ fatal error +# e_ error +# w_ warning +# n_ note +# h_ hint +# i_ info +# l_ add linenumber +# u_ used +# t_ tried +# c_ conditional +# d_ debug message +# x_ executable informations +# o_ normal (e.g., "press enter to continue") +# + +# +# General +# +# 01025 is the last used one +# +# BeginOfTeX +% \section{General compiler messages} +% This section gives the compiler messages which are not fatal, but which +% display useful information. The number of such messages can be +% controlled with the various verbosity level \var{-v} switches. +% \begin{description} +general_t_compilername=01000_T_Compiler: $1 +% When the \var{-vt} switch is used, this line tells you what compiler +% is used. +general_d_sourceos=01001_D_Quellbetriebssystem: $1 +% When the \var{-vd} switch is used, this line tells you what the source +% operating system is. +general_i_targetos=01002_I_Zielbetriebssystem: $1 +% When the \var{-vd} switch is used, this line tells you what the target +% operating system is. +general_t_exepath=01003_T_Der Pfad der ausfhrbaren Datei ist: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its binaries. +general_t_unitpath=01004_T_Der Unitpfad ist: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for compiled units. You can set this path with the \var{-Fu} option. +general_t_includepath=01005_T_Der Includepfad ist: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its include files (files used in \var{\{\$I xxx\}} statements). +% You can set this path with the \var{-Fi} option. +general_t_librarypath=01006_T_Der Bibliothekspfad ist: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for the libraries. You can set this path with the \var{-Fl} option. +general_t_objectpath=01007_T_Der Objektdateienpfad ist: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for object files you link in (files used in \var{\{\$L xxx\}} statements). +% You can set this path with the \var{-Fo} option. +general_i_abslines_compiled=01008_I_$1 Zeilen bersetzt, $2 Sekunden $3 +% When the \var{-vi} switch is used, the compiler reports the number +% of lines compiled, and the time it took to compile them (real time, +% not program time). +general_f_no_memory_left=01009_F_Speicher voll +% The compiler doesn't have enough memory to compile your program. There are +% several remedies for this: +% \begin{itemize} +% \item If you're using the build option of the compiler, try compiling the +% different units manually. +% \item If you're compiling a huge program, split it up into units, and compile +% these separately. +% \item If the previous two don't work, recompile the compiler with a bigger +% heap. (You can use the \var{-Ch} option for this, \seeo{Ch}.) +% \end{itemize} +general_i_writingresourcefile=01010_I_Resourcestringtabellendatei $1 wird geschrieben +% This message is shown when the compiler writes the Resource String Table +% file containing all the resource strings for a program. +general_e_errorwritingresourcefile=01011_E_Fehler beim Schreiben der Resourcestringtabellendatei: $1 +% This message is shown when the compiler encounters an error when writing +% the Resource String Table file. +general_i_fatal=01012_I_Fataler Fehler: +% Prefix for Fatal Errors. +general_i_error=01013_I_Fehler: +% Prefix for Errors. +general_i_warning=01014_I_Warnung: +% Prefix for Warnings. +general_i_note=01015_I_Anmerkung: +% Prefix for Notes. +general_i_hint=01016_I_Hinweis: +% Prefix for Hints. +general_e_path_does_not_exist=01017_E_Der Pfad "$1" existiert nicht +% The specified path does not exist. +general_f_compilation_aborted=01018_F_šbersetzen abgebrochen +% Compilation was aborted. +general_text_bytes_code=01019_bytes Code +% The size of the generated executable code, in bytes. +general_text_bytes_data=01020_bytes Daten +% The size of the generated program data, in bytes. +general_i_number_of_warnings=01021_I_$1 Warnung(en) ausgegeben +% Total number of warnings issued during compilation. +general_i_number_of_hints=01022_I_$1 Hinweis(e) ausgegeben +% Total number of hints issued during compilation. +general_i_number_of_notes=01023_I_$1 Anmerkung(en) ausgegeben +% Total number of notes issued during compilation. +general_f_ioerror=01024_F_I/O Fehler: $1 +% During compilation an I/O error happened which allows no further compilation. +general_f_oserror=01025_F_Betriebsystemfehler: $1 +% During compilation an operanting system error happened which allows no further compilation. +% +% \end{description} +# EndOfTeX + +# +# Scanner +# +# 02088 is the last used one +# +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compilation handling. +% \begin{description} +scan_f_end_of_file=02000_F_Unerwartetes Dateiende +% this typically happens in one of the following cases: +% \begin{itemize} +% \item The source file ends before the final \var{end.} statement. This +% happens mostly when the \var{begin} and \var{end} statements aren't +% balanced; +% \item An include file ends in the middle of a statement. +% \item A comment was not closed. +% \end{itemize} +scan_f_string_exceeds_line=02001_F_Zeichenkette geht ber das Zeilenende hinaus +% You forgot probably to include the closing ' in a string, so it occupies +% multiple lines. +scan_f_illegal_char=02002_F_Unzul„ssiges Zeichen "$1" ($2) +% An illegal character was encountered in the input file. +scan_f_syn_expected=02003_F_Syntaxfehler, "$1" erwartet, aber "$2" vorgefunden +% This indicates that the compiler expected a different token than +% the one you typed. It can occur almost anywhere it is possible to make an error +% against the Pascal language. +scan_t_start_include_file=02004_TL_Die Include-Datei $1 wird jetzt gelesen +% When you provide the \var{-vt} switch, the compiler tells you +% when it starts reading an included file. +scan_w_comment_level=02005_W_Kommentarschachtelungstiefe $1 gefunden +% When the \var{-vw} switch is used, then the compiler warns you if +% it finds nested comments. Nested comments are not allowed in Turbo Pascal +% and Delphi, and can be a possible source of errors. +scan_n_ignored_switch=02008_N_Compilerschalter $1 wurde ignoriert +% With \var{-vn} on, the compiler warns if it ignores a switch. +scan_w_illegal_switch=02009_W_Compilerschalter $1 ist ungltig +% You included a compiler switch (i.e. \var{\{\$... \}}) which the compiler +% does not recognise. +scan_w_switch_is_global=02010_W_Dieser Compilerschalter hat globale Auswirkung +% The compiler switch is misplaced, and should be located at +% the start of the unit or program. +scan_e_illegal_char_const=02011_E_Ungltige Char-Konstante +% This happens when you specify a character with its ASCII code, as in +% \var{\#96}, but the number is either illegal, or out of range. +scan_f_cannot_open_input=02012_F_Datei $1 kann nicht ge”ffnet werden +% \fpc cannot find the program or unit source file you specified on the +% command line. +scan_f_cannot_open_includefile=02013_F_Includedatei $1 kann nicht ge”ffnet werden +% \fpc cannot find the source file you specified in a \var{\{\$include ..\}} +% statement. +scan_e_illegal_pack_records=02015_E_Ungltige Record Ausrichtung "$1" +% You are specifying \var{\{\$PACKRECORDS n\} } or \var{\{\$ALIGN n\} } +% with an illegal value for \var{n}. For \$PACKRECORDS valid alignments are 1, 2, 4, 8, 16, 32, C, +% NORMAL, DEFAULT, and for \$ALIGN valid alignments are 1, 2, 4, 8, 16, 32, ON, +% OFF. Under mode MacPas \$ALIGN also supports MAC68K, POWER and RESET. +scan_e_illegal_pack_enum=02016_E_Ungltige minimale Gr”sse der Aufz„hlung "$1" +% You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for +% \var{n}. Only 1,2,4, NORMAL or DEFAULT is valid here. +scan_e_endif_expected=02017_E_$ENDIF erwartet fr $1 $2 definiert in $3 Zeile $4 +% Your conditional compilation statements are unbalanced. +scan_e_preproc_syntax_error=02018_E_Syntaxfehler im Argument einer $if Direktive +% There is an error in the expression following the \var{\{\$if ..\}}, \var{\{\$ifc \}} +% or \var{\{\$setc \}} compiler directives. +scan_e_error_in_preproc_expr=02019_E_Syntaxfehler im Kontext einer $if Direktive +% There is an error in the expression following the \var{\{\$if ..\}} compiler +% directive. +scan_w_macro_cut_after_255_chars=02020_W_Inhalt des Makros wurde nach der Auswertung bei 255 Zeichen abgeschnitten +% The contents of macros cannot be longer than 255 characters. +scan_e_endif_without_if=02021_E_ENDIF ohne IF(N)DEF +% Your \var{\{\$IFDEF ..\}} and {\{\$ENDIF\}} statements aren't balanced. +scan_f_user_defined=02022_F_Benutzerdefiniert: $1 +% A user defined fatal error occurred. See also the \progref +scan_e_user_defined=02023_E_Benutzerdefiniert: $1 +% A user defined error occurred. See also the \progref +scan_w_user_defined=02024_W_Benutzerdefiniert: $1 +% A user defined warning occurred. See also the \progref +scan_n_user_defined=02025_N_Benutzerdefiniert: $1 +% A user defined note was encountered. See also the \progref +scan_h_user_defined=02026_H_Benutzerdefiniert: $1 +% A user defined hint was encountered. See also the \progref +scan_i_user_defined=02027_I_Benutzerdefiniert: $1 +% User defined information was encountered. See also the \progref +scan_e_keyword_cant_be_a_macro=02028_E_Ein Makro, das den selben Namen wie ein Schlsselwort hat, wird ignoriert +% You cannot redefine keywords with macros. +scan_f_macro_buffer_overflow=02029_F_Makropufferberlauf w„hrend des Lesens oder Expandierens eines Makros +% Your macro or it's result was too long for the compiler. +scan_w_macro_too_deep=02030_W_Expansion des Makros berschreitet eine Makroschachtelungstiefe von 16 +% When expanding a macro macros have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_w_wrong_styled_switch=02031_W_Compilerschalter innerhalb von Kommentaren der Form // werden nicht unterstzt +% Compiler switches should be in normal Pascal style comments. +scan_d_handling_switch=02032_DL_Bearbeite Schalter "$1" +% When you set debugging info on (\var{-vd}) the compiler tells you when it +% is evaluating conditional compile statements. +scan_c_endif_found=02033_CL_ENDIF $1 bearbeitet +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifdef_found=02034_CL_IFDEF $1 bearbeitet, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifopt_found=02035_CL_IFOPT $1 bearbeitet, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_if_found=02036_CL_IF $1 bearbeitet, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifndef_found=02037_CL_IFNDEF $1 bearbeitet, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_else_found=02038_CL_ELSE $1 bearbeitet, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_skipping_until=02039_CL_Quelltext wird ignoriert bis... +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements, and whether it is skipping or +% compiling parts. +scan_i_press_enter=02040_I_Drcken Sie <Return> um fortzusetzen +% When the \var{-vi} switch is used, the compiler stops compilation +% and waits for the \var{Enter} key to be pressed when it encounters +% a \var{\{\$STOP\}} directive. +scan_w_unsupported_switch=02041_W_Nicht untersttzter Schalter $1 +% When warings are turned on (\var{-vw}), the compiler warns you about +% unsupported switches. This means that the switch is used in Delphi or +% Turbo Pascal, but not in \fpc. +scan_w_illegal_directive=02042_W_Ungltige Compilerdirektive $1 +% When warings are turned on (\var{-vw}), the compiler warns you about +% unrecognised switches. For a list of recognised switches, see the \progref +scan_t_back_in=02043_TL_Wieder zurck in $1 +% When you use the \var{-vt} switch, the compiler tells you when it has finished +% reading an include file. +scan_w_unsupported_app_type=02044_W_Nicht untersttzter Anwendungstyp: $1 +% You get this warning if you specify an unknown application type +% with the directive \var{\{\$APPTYPE\}}. +scan_w_app_type_not_support=02045_W_APPTYPE wird vom Zielbetriebssystem nicht untersttzt +% The \var{\{\$APPTYPE\}} directive is supported by win32 applications only. +scan_w_description_not_support=02046_W_Der Compilerschalter DESCRIPTION wird vom Zielbetriebssystem nicht untersttzt +% The \var{\{\$DESCRIPTION\}} directive is not supported on this target OS. +scan_n_version_not_support=02047_N_VERSION wird vom Zielbetriebssystem nicht untersttzt +% The \var{\{\$VERSION\}} directive is not supported on this target OS. +scan_n_only_exe_version=02048_N_VERSION kann in Units nicht verwendet werden +% The \var{\{\$VERSION\}} directive is only used for executable or DLL sources. +scan_w_wrong_version_ignored=02049_W_Falsches Format fr VERSION-Direktive $1 +% The \var{\{\$VERSION\}} directive format is major_version.minor_version +% where major_version and minor_version are words. +scan_e_illegal_asmmode_specifier=02050_E_Unbekannter Assemblermodusname: "$1" +% When you specify an assembler mode with the \var{\{\$ASMMODE xxx\}} directive, +% the compiler didn't recognize the mode you specified. +scan_w_no_asm_reader_switch_inside_asm=02051_W_ASM-Leser-Schalter ist innerhalb einer Asm-Sequenz nicht m”glich, $1 wird erst in der n„chsten Sequenz wirksam +% It is not possible to switch from one assembler reader to another +% inside an assembler block. The new reader will be used for next +% assembler statement only. +scan_e_wrong_switch_toggle=02052_E_Parameter fr Schalter falsch, verwenden Sie ON/OFF oder +/- +% You need to use ON or OFF or a + or - to toggle the switch. +scan_e_resourcefiles_not_supported=02053_E_Resourcedateien werden vom aktuellen Zielbetriebssystem nicht untersttzt +% The target you are compiling for doesn't support resource files. +scan_w_include_env_not_found=02054_W_$1 ist keine Umgebungsvariable +% The included environment variable can't be found in the environment; it will +% be replaced by an empty string instead. +scan_e_invalid_maxfpureg_value=02055_E_Nicht erlaubter Wert fr MAXFPUREGISTER-Direktive +% Valid values for this directive are 0..8 and NORMAL/DEFAULT. +scan_w_only_one_resourcefile_supported=02056_W_Vom aktuellen Zielbetriebssystem wird nur eine Resourcedatei untersttzt +% Only one resource file can be supported for this target - this is the case of +% OS/2 (EMX) currently. The first one found is used, the others are discarded. +scan_w_macro_support_turned_off=02057_W_Makrountersttzung ist ausgeschaltet +% A macro declaration has been found, but macro support is currently off, +% so the declaration will be ignored. To turn macro support on compile with +% -Sm on the command line or add \{\$MACRO ON\} in the source. +scan_e_invalid_interface_type=02058_E_Unbekannter Interfacetyp. Untersttzt wird COM, CORBA und DEFAULT +% The interface type that was specified is not supported. +scan_w_appid_not_support=02059_W_APPID wird nur von PalmOS untersttzt +% The \var{\{\$APPID\}} directive is only supported for the PalmOS target. +scan_w_appname_not_support=02060_W_APPNAME wird nur von PalmOS untersttzt +% The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target. +scan_e_string_exceeds_255_chars=02061_E_Zeichenkettenkonstanten k”nnen maximal 255 Zeichen lang sein +% A single string constant can contain at most 255 chars. Try splitting up the +% string into multiple smaller parts and concatenate them with a + operator. +scan_f_include_deep_ten=02062_F_Include-Dateien k”nnen nur bis zu einer Tiefe von 16 geschachtelt werden +% When including include files the files have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_e_too_many_push=02063_F_Zu viele Ebenen von PUSH +% A maximum of 20 levels is allowed. This error occurs only in mode MacPas. +scan_e_too_many_pop=02064_E_POP ohne ein vorhergehendes PUSH +% This error occurs only in mode MacPas. +scan_e_error_macro_lacks_value=02065_E_Das Makro "$1" besitzt keinen Wert +% Thus the conditional compiling expression cannot be evaluated. +scan_e_wrong_switch_toggle_default=02066_E_Zum Modusumschalten kann nur ON/OFF/DEFAULT oder +/-/* verwendet werden +% You need to use ON or OFF or DEFAULT or a + or - or * to toggle the switch. +scan_e_mode_switch_not_allowed=02067_E_Der Modus Umschalter "$1" ist hier nicht erlaubt +% A mode switch has already been encountered, or, in the case of option -Mmacpas, +% a mode switch occurs after UNIT. +scan_e_error_macro_undefined=02068_E_Die Compile time Variable oder das Makro "$1" ist nicht definiert. +% Thus the conditional compile time expression cannot be evaluated. Only in mode MacPas. +scan_e_utf8_bigger_than_65535=02069_E_Der UTF-8 Code ist gr”sser als 65535 +% \fpc handles UTF-8 strings internally as widestrings, i.e. the char codes are limited to 65535. +scan_e_utf8_malformed=02070_E_Ungltige UTF-8 Zeichenkette +% The given string isn't a valid UTF-8 string. +scan_c_switching_to_utf8=02071_C_UTF-8 Signatur gefunden, verwende UTF-8 Code +% The compiler found a UTF-8 encoding signature (\$ef, \$bb, \$bf) at the beginning of a file, +% so it interprets it as a UTF-8 file. +scan_e_compile_time_typeerror=02072_E_Compile time Ausdruck: Erwartete $1 aber erhielt $2 bei $3 +% The type-check of a compile time expression failed. +scan_n_app_type_not_support=02073_N_APPTYPE wird vom Zielbetriebssystem nicht untersttzt +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_e_illegal_optimization_specifier=02074_E_"$1" ist eine ungltige Optimierung +% You specified an optimization with the \var{\{\$OPTIMIZATION xxx\}} directive, +% and the compiler didn't recognize the optimization you specified. +scan_w_setpeflags_not_support=02075_W_SETPEFLAGS wird vom Zielbetriebssystem nicht untersttzt +% The \var{\{\$SETPEFLAGS\}} directive is not supported by the target OS. +scan_w_imagebase_not_support=02076_W_IMAGEBASE wird vom Zielbetriebssystem nicht untersttzt +% The \var{\{\$IMAGEBASE\}} directive is not supported by the target OS. +scan_w_minstacksize_not_support=02077_W_MINSTACKSIZE wird vom Zielbetriebssystem nicht untersttzt +% The \var{\{\$IMAGEBASE\}} directive is not supported by the target OS. +scan_w_maxstacksize_not_support=02078_W_MAXSTACKSIZE wird vom Zielbetriebssystem nicht untersttzt +% The \var{\{\$MAXSTACKSIZE\}} directive is not supported by the target OS. +scanner_e_illegal_warn_state=02079_E_Ungltiger Wert "$1" fr die $WARN Direktive +% Only ON and OFF can be used as state with a \var{\{\$WARN\}} compiler directive. +scan_e_only_packset=02080_E_Ungltiger Wert fr das set packing +% Only 0, 1, 2, 4, 8, DEFAULT and NORMAL are allowed as packset parameters. +scan_w_pic_ignored=02081_W_PIC Direktive oder Schalter wird ignoriert +% Several targets, such as \windows, do not support nor need PIC, +% so the PIC directive and switch are ignored. +scan_w_unsupported_switch_by_target=02082_W_Der Schalter "$1" wird vom derzeit ausgew„hlten Zielbetriebssystem nicht untersttzt +% Some compiler switches like \$E are not supported by all targets. +scan_w_frameworks_darwin_only=02084_W_Framework-bezogene Optionen werden nur fr Darwin/Mac OS X untersttzt +% Frameworks are not a known concept, or at least not supported by FPC, +% on operating systems other than Darwin/Mac OS X. +scan_e_illegal_minfpconstprec=02085_E_"$1" ist eine ungltige minimale Pr„zision von Fliesskommakonstanten +% Valid minimal precisions for floating point constants are default, 32 and 64, +% which mean respectively minimal (usually 32 bit), 32 bit and 64 bit precision. +scan_w_multiple_main_name_overrides=02086_W_Der Name der "main" Prozedur wird mehrfach berschrieben. Es war bisher auf "$1" gesetzt +% The name for the main entry procedure is specified more than once. Only the last +% name will be used. +scanner_w_illegal_warn_identifier=02087_W_Ungltige Bezeichner "$1" fr die $WARN Direktive +% Identifier is not known by a \var{\{\$WARN\}} compiler directive. +scanner_e_illegal_alignment_directive=02088_E_Ungltige "alignment" Direktive +% The alignment directive is not valid. Either the alignment type is not known or the alignment +% value is not a power of two. +% +% \end{description} +# EndOfTeX + +# +# Parser +# +# 03313 is the last used one +# +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your Pascal constructs +% are correct. +% \begin{description} +parser_e_syntax_error=03000_E_Parser - Syntaxfehler +% An error against the Turbo Pascal language was encountered. This typically +% happens when an illegal character is found in the source file. +parser_e_dont_nest_interrupt=03004_E_INTERRUPT-Prozeduren drfen nicht verschachtelt sein +% An \VAR{INTERRUPT} procedure must be global. +parser_w_proc_directive_ignored=03005_W_Prozedurtyp $1 wird ignoriert +% The specified procedure directive is ignored by FPC programs. +parser_e_no_overload_for_all_procs=03006_E_Nicht alle Deklarationen von "$1" sind mit OVERLOAD deklariert +% When you want to use overloading using the \var{OVERLOAD} directive, then +% all declarations need to have \var{OVERLOAD} specified. +parser_e_export_name_double=03008_E_Doppelter Name fr exportierte Funktion $1 +% Exported function names inside a specific DLL must all be different. +parser_e_export_ordinal_double=03009_E_Doppelter Index fr exportierte Funktion $1 +% Exported function names inside a specific DLL must all be different. +parser_e_export_invalid_index=03010_E_Ungltiger Index for exportierte Funktion +% DLL function index must be in the range \var{1..\$FFFF}. +parser_w_parser_reloc_no_debug=03011_W_Fr relozierbare DLL oder ausfhrbare Datei $1 funktionieren keine Debug-Information, deaktiviert. +% It is currently not possible to include debug information in a relocatable DLL. +parser_w_parser_win32_debug_needs_WN=03012_W_Um Win32-Code debuggen zu k”nnen, mssen die Relozierungen mit -WN option abgeschaltet werden. +% Stabs debug info is wrong for relocatable DLL or EXES. Use -WN +% if you want to debug win32 executables. +parser_e_constructorname_must_be_init=03013_E_Konstruktor-Name muss INIT sein +% You are declaring a constructor with a name which isn't \var{init}, and the +% \var{-Ss} switch is in effect. See the switch \seeo{Ss}. +parser_e_destructorname_must_be_done=03014_E_Destruktor-Name muss DONE sein +% You are declaring a constructor with a name which isn't \var{done}, and the +% \var{-Ss} switch is in effect. See the switch \seeo{Ss}. +parser_e_proc_inline_not_supported=03016_E_Schlsselwort INLINE nicht untersttzt +% You tried to compile a program with C++ style inlining, and forgot to +% specify the \var{-Si} option (\seeo{Si}). The compiler doesn't support C++ +% styled inlining by default. +parser_w_constructor_should_be_public=03018_W_Konstruktor muss PUBLIC sein +% Constructors must be in the 'public' part of an object (class) declaration. +parser_w_destructor_should_be_public=03019_W_Destruktor muss PUBLIC sein +% Destructors must be in the 'public' part of an object (class) declaration. +parser_n_only_one_destructor=03020_N_Klasse darf nur einen Destruktor besitzen +% You can declare only one destructor for a class. +parser_e_no_local_objects=03021_E_Lokale Klassendefinitionen sind nicht zul„ssig +% Classes must be defined globally. They cannot be defined inside a +% procedure or function. +parser_f_no_anonym_objects=03022_F_Anonyme Klassendefinitionen sind nicht zul„ssig +% An invalid object (class) declaration was encountered, i.e. an +% object or class without methods that isn't derived from another object or +% class. For example: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% will trigger this error. +parser_n_object_has_no_vmt=03023_N_Das Objekt "$1" besitzt keine VMT +% This is a note indicating that the declared object has no +% virtual method table. +parser_e_illegal_parameter_list=03024_E_Ungltige Parameterliste +% You are calling a function with parameters that are of a different type than +% the declared parameters of the function. +parser_e_wrong_parameter_size=03026_E_Falsche Anzahl an Parameter im Aufruf von "$1" angegeben +% There is an error in the parameter list of the function or procedure -- +% the number of parameters is not correct. +parser_e_overloaded_no_procedure=03027_E_Bezeichner "$1" ist keine Funktion, overload nicht m”glich +% The compiler encountered a symbol with the same name as an overloaded +% function, but it isn't a function it can overload. +parser_e_overloaded_have_same_parameters=03028_E_Overload-Funktion darf keine identische Parameterliste aufweisen +% You're declaring overloaded functions, but with the same parameter list. +% Overloaded function must have at least 1 different parameter in their +% declaration. +parser_e_header_dont_match_forward=03029_E_Funktionskopf unterscheidet sich von voriger Deklaration "$1" +% You declared a function with the same parameters but +% different result type or function specifiers. +parser_e_header_different_var_names=03030_E_Funktionskopf von "$1" passt nicht zur Forward-Deklaration, Variablename „ndert sich: $2 => $3 +% You declared the function in the \var{interface} part, or with the +% \var{forward} directive, but defined it with a different parameter list. +parser_n_duplicate_enum=03031_N_Werte in Aufz„hlungen mssen aufsteigend sein +% \fpc allows enumeration constructions as in C. Examine the following +% two declarations: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% The second declaration would produce an error. \var{A\_UAS} needs to have a +% value higher than \var{A\_E}, i.e. at least 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_WITH kann nicht auf Variablen in anderen Segmenten angewendet werden +% With stores a variable locally on the stack, +% but this is not possible if the variable belongs to another segment. +parser_e_too_much_lexlevel=03034_E_Funktionsverschachtelung gr”sser als 31 +% You can nest function definitions only 31 levels deep. +parser_e_range_check_error=03035_E_Bereichsprfungsfehler bei Konstantenbestimmung +% The constants are out of their allowed range. +parser_w_range_check_error=03036_W_Bereichsprfungsfehler bei Konstantenbestimmung +% The constants are out of their allowed range. +parser_e_double_caselabel=03037_E_doppelter CASE-Wert +% You are specifying the same label 2 times in a \var{case} statement. +parser_e_case_lower_less_than_upper_bound=03038_E_Obere Grenze der CASE-Bereichsangabe ist kleiner als untere Grenze +% The upper bound of a \var{case} label is less than the lower bound and this +% is useless. +parser_e_type_const_not_possible=03039_E_Klassen oder Interfaces sind als typisierte Konstanten unzul„ssig +% You cannot declare a constant of type class or object. +parser_e_no_overloaded_procvars=03040_E_Funktionsvariablen von Overload-Funktionen sind unzul„ssig +% You are trying to assign an overloaded function to a procedural variable. +% This is not allowed. +parser_e_invalid_string_size=03041_E_Stringl„nge muss ein Wert zwischen 1 und 255 sein +% The length of a string in Pascal is limited to 255 characters. You are +% trying to declare a string with length less than 1 or greater than 255. +parser_w_use_extended_syntax_for_objects=03042_W_Benutzen Sie die erweiterte Syntax von NEW und DISPOSE fr Objekt-Instanzen +% If you have a pointer \var{a} to an object type, then the statement +% \var{new(a)} will not initialize the object (i.e. the constructor isn't +% called), although space will be allocated. You should issue the +% \var{new(a,init)} statement. This will allocate space, and call the +% constructor of the object. +parser_w_no_new_dispose_on_void_pointers=03043_W_Verwendung von NEW oder DISPOSE mit untypisierten Pointern ist ohne Aussage +parser_e_no_new_dispose_on_void_pointers=03044_E_Verwendung von NEW oder DISPOSE mit untypisierten Pointern ist nicht m”glich +% You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer +% because no size is associated to an untyped pointer. +% It is accepted for compatibility in \var{TP} and \var{DELPHI} modes, but the +% compiler will still warn you if it finds such a construct. +parser_e_class_id_expected=03045_E_Klassenbezeichner erwartet +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., an object or class method, but the type in front of the dot is not +% a known type. +parser_e_no_type_not_allowed_here=03046_E_Typbezeichner ist hier nicht zul„ssig +% You cannot use a type inside an expression. +parser_e_methode_id_expected=03047_E_Methodenbezeichner erwartet +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., an object or class method, but the procedure name is not a +% procedure of this type. +parser_e_header_dont_match_any_member=03048_E_Funktionskopf passt zu keiner Methode der Klasse $1 +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., an object or class method, but the procedure name is not a +% procedure of this type. +parser_d_procedure_start=03049_DL_Procedure/Function $1 +% When using the \var{-vd} switch, the compiler tells you when it starts +% processing a procedure or function implementation. +parser_e_error_in_real=03050_E_Ungltige Fliesskommakonstante +% The compiler expects a floating point expression, and gets something else. +parser_e_fail_only_in_constructor=03051_E_FAIL darf nur in Konstruktoren verwendet werden +% You are using the \var{FAIL} instruction outside a constructor method. +parser_e_no_paras_for_destructor=03052_E_Destruktoren k”nnen keine Parameter haben +% You are declaring a destructor with a parameter list. Destructor methods +% cannot have parameters. +parser_e_only_class_members_via_class_ref=03053_E_Nur Klassenmethoden, Klasseneigenschaften und Klassenvariablen k”nnen ber den Klassennamen angesprochen werden +% This error occurs in a situation like the following: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} is not a class method and hence cannot be called with a class +% reference. +parser_e_only_class_members=03054_E_Nur Klassenmethoden, Klasseneigenschaften und Klassenvariablen k”nnen in einer Klassenmethode angesprochen werden +% This is related to the previous error. You cannot call a method of an object +% from inside a class method. The following code would produce this error: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% Because free is a normal method of a class it cannot be called from a class +% method. +parser_e_case_mismatch=03055_E_Konstante und CASE-Typ passen nicht zueinander +% One of the labels is not of the same type as the case variable. +parser_e_illegal_symbol_exported=03056_E_Das Symbol kann nicht aus einer Bibliothek exportiert werden +% You can only export procedures and functions when you write a library. You +% cannot export variables or constants. +parser_w_should_use_override=03057_W_Eine Inherit-Methode wird durch $1 verdeckt +% A method that is declared \var{virtual} in a parent class, should be +% overridden in the descendant class with the \var{override} directive. If you +% don't specify the \var{override} directive, you will hide the parent method; +% you will not override it. +parser_e_nothing_to_be_overridden=03058_E_Es gibt keine Vorg„ngerklasse mit einer Methode, die damit berschrieben werden k”nnte: $1 +% You try to \var{override} a virtual method of a parent class that doesn't +% exist. +parser_e_no_procedure_to_access_property=03059_E_Es gibt keine Member-Funktion um auf diese Property zuzugreifen +% You specified no \var{read} directive for a property. +parser_w_stored_not_implemented=03060_W_Die Stored Property - Direktive ist noch nicht implementiert +% This message is no longer used, as the \var{stored} directive has been implemented. +parser_e_ill_property_access_sym=03061_E_Ungltiges Symbol fr den Zugriff auf die Property +% There is an error in the \var{read} or \var{write} directives for an array +% property. When you declare an array property, you can only access it with +% procedures and functions. The following code would cause such an error. +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_Kann an dieser Stelle nicht auf das geschtzte Feld des Objekts zugreifen +% Fields that are declared in a \var{protected} section of an object or class +% declaration cannot be accessed outside the module where the object is +% defined, or outside descendent object methods. +parser_e_cant_access_private_member=03063_E_Kann an dieser Stelle nicht auf das private Feld des Objekts zugreifen +% Fields that are declared in a \var{private} section of an object or class +% declaration cannot be accessed outside the module where the class is +% defined. +parser_e_overridden_methods_not_same_ret=03066_E_šberschriebene, virtuelle Methoden mssen den gleichen Ergebnistyp haben: "$2" wird berschrieben von "$1" +% If you declare overridden methods in a class definition, they must +% have the same return type. +parser_e_dont_nest_export=03067_E_Mit EXPORT deklarierte Funktionen drfen nicht verschachtelt sein +% You cannot declare a function or procedure within a function or procedure +% that was declared as an export procedure. +parser_e_methods_dont_be_export=03068_E_Methoden drfen nicht EXPORTiert werden +% You cannot declare a procedure that is a method for an object as +% \var{export}ed. That is, your methods cannot be called from a C program. +parser_e_call_by_ref_without_typeconv=03069_E_Aufrufe mit VAR-Parametern fr Argument-Nr. $1 mssen exakt stimmen: "$2" gefunden, "$3" erwartet +% When calling a function declared with \var{var} parameters, the variables in +% the function call must be of exactly the same type. There is no automatic +% type conversion. +parser_e_no_super_class=03070_E_Klasse ist keine Elternklasse zur aktuellen Klasse +% When calling inherited methods, you are trying to call a method of a strange +% class. You can only call an inherited method of a parent class. +parser_e_self_not_in_method=03071_E_SELF ist nur in Methoden erlaubt +% You are trying to use the \var{self} parameter outside an object's method. +% Only methods get passed the \var{self} parameters. +parser_e_generic_methods_only_in_methods=03072_E_Methoden drfen nur in anderen Methoden direkt mit dem Klassen-Typbezeichner aufgerufen werden +% A construction like \var{sometype.somemethod} is only allowed in a method. +parser_e_illegal_colon_qualifier=03073_E_Unzul„ssige Verwendung von ':' +% You are using the format \var{:} (colon) 2 times on an expression that +% is not a real expression. +parser_e_illegal_set_expr=03074_E_Bereichsprfungsfehler im SET-Konstruktor oder doppeltes Set-Element +% The declaration of a set contains an error. Either one of the elements is +% outside the range of the set type, or two of the elements are in fact +% the same. +parser_e_pointer_to_class_expected=03075_E_Zeiger auf Objekt erwartet +% You specified an illegal type in a \var{New} statement. +% The extended synax of \var{New} needs an object as a parameter. +parser_e_expr_have_to_be_constructor_call=03076_E_Ausdruck muss ein Konstruktor-Aufruf sein +% When using the extended syntax of \var{new}, you must specify the constructor +% method of the object you are trying to create. The procedure you specified +% is not a constructor. +parser_e_expr_have_to_be_destructor_call=03077_E_Ausdruck muss ein Destruktor-Aufruf sein +% When using the extended syntax of \var{dispose}, you must specify the +% destructor method of the object you are trying to dispose of. +% The procedure you specified is not a destructor. +parser_e_invalid_record_const=03078_E_Unzul„ssige Reihenfolge der Record-Elemente +% When declaring a constant record, you specified the fields in the wrong +% order. +parser_e_false_with_expr=03079_E_Typ des Ausdrucks muss eine Klasse oder ein Recordtyp sein +% A \var{with} statement needs an argument that is of the type \var{record} +% or \var{class}. You are using \var{with} on an expression that is not of +% this type. +parser_e_void_function=03080_E_Prozeduren k”nnen keinen Wert zurckliefern +% In \fpc, you can specify a return value for a function when using +% the \var{exit} statement. This error occurs when you try to do this with a +% procedure. Procedures cannot return a value. +parser_e_only_methods_allowed=03081_E_Konstruktoren, Destruktoren und Klassenoperatoren mssen Methoden sein +% You're declaring a procedure as destructor, constructor or class operator, when the +% procedure isn't a class method. +parser_e_operator_not_overloaded=03082_E_Operator besitzt kein Overload +% You're trying to use an overloaded operator when it isn't overloaded for +% this type. +parser_e_no_such_assignment=03083_E_Es ist nicht m”glich, die Zuweisung fr gleiche Typen zu berladen +% You cannot overload assignment for types +% that the compiler considers as equal. +parser_e_overload_impossible=03084_E_Unm”gliche Operator-.berladung +% The combination of operator, arguments and return type are +% incompatible. +parser_e_no_reraise_possible=03085_E_Ausl”sen einer Exception an dieser Stelle nicht m”glich +% You are trying to re-raise an exception where it is not allowed. You can only +% re-raise exceptions in an \var{except} block. +parser_e_no_new_or_dispose_for_classes=03086_E_Die erweiterte Syntax von New oder Dispose ist fr Klassen unzul„ssig +% You cannot generate an instance of a class with the extended syntax of +% \var{new}. The constructor must be used for that. For the same reason, you +% cannot call \var{Dispose} to de-allocate an instance of a class, the +% destructor must be used for that. +parser_e_procedure_overloading_is_off=03088_E_Das šberladen von Prozeduren ist ausgeschaltet +% When using the \var{-So} switch, procedure overloading is switched off. +% Turbo Pascal does not support function overloading. +parser_e_overload_operator_failed=03089_E_Es ist nicht m”glich, dieesen Operator zu berladen. Verwandte berladbare Operatoren sind "$1" +% You are trying to overload an operator which cannot be overloaded. +% The following operators can be overloaded : +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_Vergleichsoperator muss einen booleschen Wert zurckgeben +% When overloading the \var{=} operator, the function must return a boolean +% value. +parser_e_only_virtual_methods_abstract=03091_E_Nur virtuelle Methoden k”nnen abstrakt sein +% You are declaring a method as abstract, when it isn't declared to be +% virtual. +parser_f_unsupported_feature=03092_F_Benutzung einer nicht untersttzten Erweiterung! +% You're trying to force the compiler into doing something it cannot do yet. +parser_e_mix_of_classes_and_objects=03093_E_Das Mischen von Klassen und Objekten ist unzul„ssig +% You cannot derive \var{objects}, \var{classes}, \var{cppclasses} and \var{interfaces} intertwined. E.g. +% a class cannot have an object as parent and vice versa. +parser_w_unknown_proc_directive_ignored=03094_W_Unbekannte Prozedur, Direktive $1 wurde ignoriert +% The procedure direcive you secified is unknown. +parser_e_absolute_only_one_var=03095_E_ABSOLUTE kann nur auf eine alleinstehende Variable angewendet werden +% You cannot specify more than one variable before the \var{absolute} directive. +% Thus, the following construct will provide this error: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +parser_e_absolute_only_to_var_or_const=03096_E_ABSOLUTE kann nur auf Variablen und Konstanten angewendet werden +% The address of an \var{absolute} directive can only point to a variable or +% constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_initialized_only_one_var=03097_E_Es kann nur EINE Variable initialisiert werden +% You cannot specify more than one variable with a initial value in Delphi mode. +parser_e_abstract_no_definition=03098_E_Abstrakte Methoden drfen keine Definition (mit Rumpf) haben +% Abstract methods can only be declared, you cannot implement them. They +% should be overridden by a descendant class. +parser_e_overloaded_must_be_all_global=03099_E_Diese berladene Funktion darf nicht lokal sein (muss Exportiert werden) +% You are defining an overloaded function in the implementation part of a unit, +% but there is no corresponding declaration in the interface part of the unit. +parser_w_virtual_without_constructor=03100_W_Virtuelle Methoden wurden ohne Konstruktor verwendet in $1 +% If you declare objects or classes that contain virtual methods, you need +% to have a constructor and destructor to initialize them. The compiler +% encountered an object or class with virtual methods that doesn't have +% a constructor/destructor pair. +parser_c_macro_defined=03101_CL_Makro definiert: $1 +% When \var{-vc} is used, the compiler tells you when it defines macros. +parser_c_macro_undefined=03102_CL_Makrodefinition gel”scht: $1 +% When \var{-vc} is used, the compiler tells you when it undefines macros. +parser_c_macro_set_to=03103_CL_Wert des Makros $1 auf $2 gesetzt +% When \var{-vc} is used, the compiler tells you what values macros get. +parser_i_compiling=03104_I_šbersetze $1 +% When you turn on information messages (\var{-vi}), the compiler tells you +% what units it is recompiling. +parser_u_parsing_interface=03105_UL_Parse Interface von Unit $1 +% This tells you that the reading of the interface +% of the current unit has started +parser_u_parsing_implementation=03106_UL_Parse Implementation von $1 +% This tells you that the code reading of the implementation +% of the current unit, library or program starts +parser_d_compiling_second_time=03107_DL_šbersetze $1 zum zweiten Mal +% When you request debug messages (\var{-vd}) the compiler tells you what +% units it recompiles for the second time. +parser_e_no_property_found_to_override=03109_E_Es gibt keine Property diesen Namens, die berschrieben werden k”nnte +% You want to overrride a property of a parent class, when there is, in fact, +% no such property in the parent class. +parser_e_only_one_default_property=03110_E_Es ist nur eine einzelne Default-Property erlaubt, vererbte Default-Property in Klasse $1 gefunden +% You specified a property as \var{Default}, but a parent class already has a +% default property, and a class can have only one default property. +parser_e_property_need_paras=03111_E_Die Default-Property muss eine Array-Property sein +% Only array properties of classes can be made \var{default} properties. +parser_e_constructor_cannot_be_not_virtual=03112_E_Virtuelle Konstruktoren werden nur im Klassen-Objektmodell untersttzt +% You cannot have virtual constructors in objects. You can only have them +% in classes. +parser_e_no_default_property_available=03113_E_Keine Default-Property verfgbar +% You try to access a default property of a class, but this class (or one of +% its ancestors) doesn't have a default property. +parser_e_cant_have_published=03114_E_Die Klasse kann keinen PUBLISHED Bereich haben, benutzen Sie den {$M+} Schalter +% If you want a \var{published} section in a class definition, you must +% use the \var{\{\$M+\}} switch, which turns on generation of type +% information. +parser_e_forward_declaration_must_be_resolved=03115_E_Forward-Deklaration der Klasse $1 muss hier aufgel”st werden, wenn sie als Elternklasse benutzt werden soll +% To be able to use an object as an ancestor object, it must be defined +% first. This error occurs in the following situation: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% where \var{ParentClass} is declared but not defined. +parser_e_no_local_operator=03116_E_Lokale Operatoren werden nicht untersttzt +% You cannot overload locally, i.e. inside procedures or function +% definitions. +parser_e_proc_dir_not_allowed_in_interface=03117_E_Prozedur-Direktive $1 unzul„ssig im Interface-Bereich +% This procedure directive is not allowed in the \var{interface} section of +% a unit. You can only use it in the \var{implementation} section. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_Prozedur Direktive $1 unzul„ssig im Implementation-Bereich +% This procedure directive is not allowed in the \var{implementation} section of +% a unit. You can only use it in the \var{interface} section. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_Prozedur-Direktive $1 unzul„ssig in einer Procvar-Deklaration +% This procedure directive cannot be part of a procedural of function +% type declaration. +parser_e_function_already_declared_public_forward=03120_E_Funktion ist bereits als Public oder Forward deklariert: $1 +% You will get this error if a function is defined as \var{forward} twice. +% Or if it occurs in the \var{interface} section, and again as a \var{forward} +% declaration in the \var{implementation} section. +parser_e_not_external_and_export=03121_E_Kann nicht EXPORT und EXTERNAL gleichzeitig benutzen +% These two procedure directives are mutually exclusive. +parser_w_not_supported_for_inline=03123_W_$1 noch nicht innerhalb von inline Prozeduren/Funktionen untersttzt +% Inline procedures don't support this declaration. +parser_w_inlining_disabled=03124_W_Inlining deaktiviert +% Inlining of procedures is disabled. +parser_i_writing_browser_log=03125_I_Schreibe Browser-Log $1 +% When information messages are on, the compiler warns you when it +% writes the browser log (generated with the \var{\{\$Y+\}} switch). +parser_h_maybe_deref_caret_missing=03126_H_M”glicherweise fehlt eine Zeiger-Dereferenzierung +% The compiler thinks that a pointer may need a dereference. +parser_f_assembler_reader_not_supported=03127_F_Gew„hlter Assembler-Leser nicht untersttzt +% The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not +% supported. The compiler can be compiled with or without support for a +% particular assembler reader. +parser_e_proc_dir_conflict=03128_E_Prozedur-Direktive $1 steht in Konflikt mit anderen Direktiven +% You specified a procedure directive that conflicts with other directives. +% For instance \var{cdecl} and \var{pascal} are mutually exclusive. +parser_e_call_convention_dont_match_forward=03129_E_Aufrufkonvention passt nicht zur Forward-Deklaration +% This error happens when you declare a function or procedure with +% e.g. \var{cdecl;} but omit this directive in the implementation, or vice +% versa. The calling convention is part of the function declaration, and +% must be repeated in the function definition. +parser_e_property_cant_have_a_default_value=03131_E_Property kann keinen Vorgabewert haben +% Set properties or indexed properties cannot have a default value. +parser_e_property_default_value_must_const=03132_E_Der Vorgabewert einer Property muss eine Konstante sein +% The value of a \var{default} declared property must be known at compile +% time. The value you specified is only known at run time. This happens +% e.g. if you specify a variable name as a default value. +parser_e_cant_publish_that=03133_E_Symbol darf nicht PUBLISHED sein, dies kann nur eine Klasse sein +% Only class type variables can be in a \var{published} section of a class +% if they are not declared as a property. +parser_e_cant_publish_that_property=03134_E_Diese Property-Art kann nicht PUBLISHED sein +% Properties in a \var{published} section cannot be array properties. +% They must be moved to public sections. Properties in a \var{published} +% section must be an ordinal type, a real type, strings or sets. +parser_e_empty_import_name=03136_E_Leerer Importname angegeben +% Some targets need a name for the imported procedure or a \var{cdecl} specifier. +parser_e_division_by_zero=03138_E_Division durch Null +% A division by zero was encounted. +parser_e_invalid_float_operation=03139_E_Ungltige Fliesskomma-Operation +% An operation on two real type values produced an overflow or a division +% by zero. +parser_e_array_lower_less_than_upper_bound=03140_E_Obere Grenze des Bereichs ist kleiner als die untere Grenze +% The upper bound of an array declaration is less than the lower bound and this +% is not possible. +parser_w_string_too_long=03141_W_String "$1" ist l„nger als $2 +% The size of the constant string is larger than the size you specified in +% string type definition. +parser_e_string_larger_array=03142_E_Stringl„nge ist gr”sser als die L„nge des "array of char" +% The size of the constant string is larger than the size you specified in +% the \var{Array[x..y] of char} definition. +parser_e_ill_msg_expr=03143_E_Ungltiger Ausdruck nach der 'Message'-Direktive +% \fpc supports only integer or string values as message constants. +parser_e_ill_msg_param=03144_E_Message-Handler akzeptieren nur einen "Call by Reference" Parameter +% A method declared with the \var{message} directive as message handler +% can take only one parameter which must be declared as call by reference. +% Parameters are declared as call by reference using the \var{var}-directive. +parser_e_duplicate_message_label=03145_E_Doppeltes Message-Label: $1 +% A label for a message is used twice in one object/class. +parser_e_self_in_non_message_handler=03146_E_SELF darf nur in Message-Handlern ein expliziter Parameter sein +% The \var{Self} parameter can only be passed explicitly to a method which +% is declared as message method handler +parser_e_threadvars_only_sg=03147_E_Threadvariablen k”nnen nur statisch oder global sein +% Threadvars must be static or global; you can't declare a thread +% local to a procedure. Local variables are always local to a thread, +% because every thread has its own stack and local variables +% are stored on the stack. +parser_f_direct_assembler_not_allowed=03148_F_Direkter Assembler wird f+r bin„res Ausgabeformat nicht untersttzt +% You can't use direct assembler when using a binary writer. Choose an +% other output format or use another assembler reader. +parser_w_no_objpas_use_mode=03149_W_Laden Sie die OBJPAS Unit nicht manuell, benutzen Sie statdessen {$mode objfpc} oder {$mode delphi} +% You are trying to load the \file{ObjPas} unit manually from a \var{uses} clause. +% This is not a good idea. Use the \var{\{\$MODE OBJFPC\}} or +% \var{\{\$mode delphi\}} directives which load the unit automatically. +parser_e_no_object_override=03150_E_OVERRIDE darf in Objekten nicht verwendet werden +% \var{Override} is not supported for objects, use \var{virtual} instead to override +% a method of a parent object. +parser_e_cant_use_inittable_here=03151_E_Datentypen, die ein Initialiserung oder Finalisierung ben”tigen, k”nnen in varianten Records nicht verwendet werden +% Some data types (e.g. \var{ansistring}) need initialization/finalization +% code which is implicitly generated by the compiler. Such data types +% can't be used in the variant part of a record. +parser_e_resourcestring_only_sg=03152_E_Resourcestrings drfen nur statisch oder global sein +% Resourcestring cannot be declared local, only global or using the static +% directive. +parser_e_exit_with_argument_not__possible=03153_E_EXIT mit Argument darf hier nicht verwendet werden +% An exit statement with an argument for the return value can't be used here. This +% can happen for example in \var{try..except} or \var{try..finally} blocks. +parser_e_stored_property_must_be_boolean=03154_E_Der Typ des STORED-Symbols muss boolesch sein +% If you specify a storage symbol in a property declaration, it must be a +% boolean type. +parser_e_ill_property_storage_sym=03155_E_Dieses Symbol ist als Speichersymbol unzul„ssig +% You can't use this type of symbol as storage specifier in property +% declaration. You can use only methods with the result type boolean, +% boolean class fields or boolean constants. +parser_e_only_publishable_classes_can_be_published=03156_E_Nur Klassen, die im "$M+"-Modus bersetzt wurden, drfen published sein +% A class-typed field in the published section of a class can only be a class which was +% compiled in \var{\{\$M+\}} or which is derived from such a class. Normally +% such a class should be derived from \var{TPersistent}. +parser_e_proc_directive_expected=03157_E_Prozedurdirektive erwartet +% This error is triggered when you have a \var{\{\$Calling\}} directive without +% a calling convention specified. +% It also happens when declaring a procedure in a const block and you +% used a ; after a procedure declaration which must be followed by a +% procedure directive. +% Correct declarations are: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_Der Wert fr einen Property-Index muss ordinalen Typs sein +% The value you use to index a property must be of an ordinal type, for +% example an integer or enumerated type. +parser_e_procname_to_short_for_export=03159_E_Prozedurname zu kurz um exportiert zu werden +% The length of the procedure/function name must be at least 2 characters +% long. This is because of a bug in dlltool which doesn't parse the .def +% file correctly with a name of length 1. +parser_e_dlltool_unit_var_problem=03160_E_Es kann kein DEFFILE-Eintrag fr unit-globale Variablen erzeugt werden +parser_e_dlltool_unit_var_problem2=03161_E_šbersetze ohne "-WD"-Option +% You need to compile this file without the -WD switch on the +% command line. +parser_f_need_objfpc_or_delphi_mode=03162_F_Es muss der Modus ObjFPC (-S2) oder Delphi (-Sd) aktiv sein, um dieses Modul zu bersetzen +% You need to use \var{\{\$MODE OBJFPC\}} or \var{\{\$MODE DELPHI\}} to compile this file. +% Or use the corresponding command line switch, either \var{-Mobjfpc} or \var{-MDelphi.} +parser_e_no_export_with_index_for_target=03163_E_Der Index darf nicht kleiner als $1 sein +% Exporting of functions or procedures with a specified index is not +% supported on this target. +parser_e_no_export_of_variables_for_target=03164_E_Das Ziel $1 untersttzt das Exportieren von Variablen nicht +% Exporting of variables is not supported on this target. +parser_e_improper_guid_syntax=03165_E_Falscher GUID-Syntax +% The GUID indication does not have the proper syntax. It should be of the form +% \begin{verbatim} +% {XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX} +% \end{verbatim} +% Where each \var{X} represents a hexadecimal digit. +parser_w_interface_mapping_notfound=03168_W_Eine Prozedur mit dem Namen "$1", die $2.$3 implementieren k”nnte, kann nicht gefunden werden +% The compiler cannot find a suitable procedure which implements the given method of an interface. +% A procedure with the same name is found, but the arguments do not match. +parser_e_interface_id_expected=03169_E_Interface-Bezeichner erwartet +% This happens when the compiler scans a \var{class} declaration that contains +% \var{interface} function name mapping code like this: +% \begin{verbatim} +% type +% TMyObject = class(TObject, IDispatch) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% and the \var{interface} before the dot is not listed in the inheritance list. +parser_e_type_cant_be_used_in_array_index=03170_E_Der Typ "$1" kann nicht als Array-Index verwendet werden +% Types like \var{qword} or \var{int64} aren't allowed as array index type. +parser_e_no_con_des_in_interfaces=03171_E_Kon- und Destruktoren sind in Interfaces nicht erlaubt +% Constructor and destructor declarations aren't allowed in interfaces. +% In the most cases method \var{QueryInterface} of \var{IUnknown} can +% be used to create a new interface. +parser_e_no_access_specifier_in_interfaces=03172_E_Zugriffsbezeichner k”nnen in INTERFACEs und OBJCPROTOCOLs nicht benutzt werden +% The access specifiers \var{public}, \var{private}, \var{protected} and +% \var{published} can't be used in interfaces, Objective-C protocols and categories because all methods +% of an interface/protocol/category must be public. +parser_e_no_vars_in_interfaces=03173_E_Ein Interface, ein Helfer, ein Objective-C Protokoll oder eine Kategorie darf keine Felder enthalten +% Declarations of fields are not allowed in interfaces, helpers and Objective-C protocols and categories. +% An interface/helper/protocol/category can contain only methods and properties with method read/write specifiers. +parser_e_no_local_proc_external=03174_E_Eine lokale Prozedur kann nicht als EXTERNAL deklariert werden +% Declaring local procedures as external is not possible. Local procedures +% get hidden parameters that will make the chance of errors very high. +parser_w_skipped_fields_before=03175_W_Einige Felder vor dem Feld "$1" sind nicht initialisiert +% In Delphi mode, not all fields of a typed constant record have to be +% initialized, but the compiler warns you when it detects such situations. +parser_e_skipped_fields_before=03176_E_Einige Felder vor dem Feld "$1" sind nicht initialisiert +% In all syntax modes but Delphi mode, you can't leave some fields uninitialized +% in the middle of a typed constant record. +parser_w_skipped_fields_after=03177_W_Einige Felder nach dem Feld "$1" sind nicht initialisiert +% You can leave some fields at the end of a type constant record uninitialized +% (The compiler will initialize them to zero automatically). This may be the cause +% of subtle problems. +parser_e_varargs_need_cdecl_and_external=03178_E_Verwendung von VarArgs (oder '...' in MacPas) ohne CDecl/CPPDecl/MWPascal oder External nicht m”glich +% The varargs directive (or the ``...'' varargs parameter in MacPas mode) can only be +% used with procedures or functions that are declared with \var{external} and one of +% \var{cdecl}, \var{cppdecl} and \var{mwpascal}. This functionality +% is only supported to provide a compatible interface to C functions like printf. +parser_e_self_call_by_value=03179_E_Self muss ein Call-By-Value-Parameter sein +% You can't declare \var{Self} as a const or var parameter, it must always be +% a call-by-value parameter. +parser_e_interface_has_no_guid=03180_E_Interface "$1" hat keine Interface-Identifikation +% When you want to assign an interface to a constant, then the interface +% must have a GUID value set. +parser_e_illegal_field_or_method=03181_E_Klassenfeld oder Methoden-Bezeichner "$1" unbekannt +% Properties must refer to a field or method in the same class. +parser_w_proc_overriding_calling=03182_W_šberschreibe die Calling Convention "$1" mit "$2" +% There are two directives in the procedure declaration that specify a calling +% convention. Only the last directive will be used. +parser_e_no_procvarobj_const=03183_E_Die Konstante des Typs "procedure of object" kann nur mit NIL initialisiert werden +% You cannot assign the address of a method to a typed constant which has a +% 'procedure of object' type, because such a constant requires two addresses: +% that of the method (which is known at compile time) and that of the object or +% class instance it operates on (which cannot be known at compile time). +parser_e_default_value_only_one_para=03184_E_Der Default Value kann nur einem Parameter zugewiesen werden +% It is not possible to specify a default value for several parameters at once. +% The following is invalid: +% \begin{verbatim} +% Procedure MyProcedure (A,B : Integer = 0); +% \end{verbatim} +% Instead, this should be declared as +% \begin{verbatim} +% Procedure MyProcedure (A : Integer = 0; B : Integer = 0); +% \end{verbatim} +parser_e_default_value_expected_for_para=03185_E_Standard Parameter fr "$1" ben”tigt +% The specified parameter requires a default value. +parser_w_unsupported_feature=03186_W_Verwendung eines nicht untersttzten Features! +% You're trying to force the compiler into doing something it cannot do yet. +parser_h_c_arrays_are_references=03187_H_C Arrays werden "by reference" bergeben +% Any array passed to a C function is passed +% by a pointer (i.e. by reference). +parser_e_C_array_of_const_must_be_last=03188_E_C array of const muss letztes Argument sein +% You cannot add any other argument after an \var{array of const} for +% \var{cdecl} functions, as the size pushed on stack for this argument is +% not known. +parser_h_type_redef=03189_H_Erneute Definition des Typs "$1" +% This is an indicator that a previously declared type is +% being redefined as something else. This may, or may not +% be, a potential source of errors. +parser_w_cdecl_has_no_high=03190_W_cdecl'ared Functionen haben keinen high Parameter +% Functions declared with the \var{cdecl} modifier do not pass an extra implicit parameter. +parser_w_cdecl_no_openstring=03191_W_cdecl'ared Functionen untersttzen keine open strings +% Openstring is not supported for functions that have the \var{cdecl} modifier. +parser_e_initialized_not_for_threadvar=03192_E_Als threadvar deklarierte Variable kann nicht initialisiert werden +% Variables declared as threadvar cannot be initialized with a default value. +% The variables will always be filled with zero at the start of a new thread. +parser_e_msg_only_for_classes=03193_E_Message directive ist nur in Klassen erlaubt +% The message directive is only supported for Class types. +parser_e_procedure_or_function_expected=03194_E_Procedure oder Function erwartet +% A class method can only be specified for procedures and functions. +parser_e_illegal_calling_convention=03195_W_Calling convention directive ignoriert: "$1" +% Some calling conventions are supported only by certain CPUs. I.e. most non-i386 ports support +% only the standard ABI calling convention of the CPU. +parser_e_no_object_reintroduce=03196_E_REINTRODUCE kann in Objekten nicht benutzt werden +% \var{reintroduce} is not supported for objects, Objective-C classes and Objective-C protocols. +parser_e_paraloc_only_one_para=03197_E_Jedes Argument muss seine eigene "location" haben +% If locations for arguments are specified explicitly as it is required by +% some syscall conventions, each argument must have its own location. Things +% like +% \begin{verbatim} +% procedure p(i,j : longint 'r1'); +% \end{verbatim} +% aren't allowed. +parser_e_paraloc_all_paras=03198_E_Jedes Argument muss seine explizite "location" haben +% If one argument has an explicit argument location, all arguments of a procedure +% must have one. +parser_e_illegal_explicit_paraloc=03199_E_"location" des Arguments unbekannt +% The location specified for an argument isn't recognized by the compiler. +parser_e_32bitint_or_pointer_variable_expected=03200_E_32 Bit-Integer oder Zeiger-Variable erwartet +% The libbase for MorphOS/AmigaOS can be given only as \var{longint}, \var{dword} or any pointer variable. +parser_e_goto_outside_proc=03201_E_Goto Statements zwischen verschiedenen Prozeduren sind nicht erlaubt +% It isn't allowed to use \var{goto} statements referencing labels outside the +% current procedure. The following example shows the problem: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1; +% +% procedure p2; +% begin +% goto l1; // This goto ISN'T allowed +% end; +% +% begin +% p2 +% l1: +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_Prozedur zu komplex, sie erfordert zu viele Register +% Your procedure body is too long for the compiler. You should split the +% procedure into multiple smaller procedures. +parser_e_illegal_expression=03203_E_Ungltiger Ausdruck +% This can occur under many circumstances. Usually when trying to evaluate +% constant expressions. +parser_e_invalid_integer=03204_E_Ungltiger integer Ausdruck +% You made an expression which isn't an integer, and the compiler expects the +% result to be an integer. +parser_e_invalid_qualifier=03205_E_Ungltiger Qualifier +% One of the following is happening : +% \begin{itemize} +% \item You're trying to access a field of a variable that is not a record. +% \item You're indexing a variable that is not an array. +% \item You're dereferencing a variable that is not a pointer. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_High Range Limit < low Range Limit +% You are declaring a subrange, and the high limit is less than the low limit of +% the range. +parser_e_macpas_exit_wrong_param=03207_E_Exits Parameter muss der Name der Prozedur sein, in der es benutzt wird +% Non local exit is not allowed. This error occurs only in mode MacPas. +parser_e_illegal_assignment_to_count_var=03208_E_Ungltige Zuweisung zur for-loop Variable "$1" +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. You also cannot assign values to +% loop variables inside the loop (Except in Delphi and TP modes). Use a while or +% repeat loop instead if you need to do something like that, since those +% constructs were built for that. +parser_e_no_local_var_external=03209_E_Lokale Variable kann nicht als EXTERNAL deklariert werden +% Declaring local variables as external is not allowed. Only global variables can reference +% external variables. +parser_e_proc_already_external=03210_E_Prozedur ist bereits als EXTERNAL deklariert +% The procedure is already declared with the EXTERNAL directive in an interface or +% forward declaration. +parser_w_implicit_uses_of_variants_unit=03211_W_Implizite Verwendung einer Variant Unit +% The Variant type is used in the unit without any used unit using the Variants unit. The +% compiler has implicitly added the Variants unit to the uses list. To remove this warning +% the Variants unit needs to be added to the uses statement. +parser_e_no_static_method_in_interfaces=03212_E_Class und statische Methoden k”nnen nicht in INTERFACES verwendet werden +% The specifier \var{class} and directive \var{static} can't be used in interfaces +% because all methods of an interface must be public. +parser_e_arithmetic_operation_overflow=03213_E_šberlauf in arithmetischer Operation +% An operation on two integer values produced an overflow. +parser_e_protected_or_private_expected=03214_E_Protected oder private erwartet +% \var{strict} can be only used together with \var{protected} or \var{private}. +parser_e_illegal_slice=03215_E_SLICE kann nicht ausserhalb der Parameterliste benutzt werden +% \var{slice} can be used only for arguments accepting an open array parameter. +parser_e_dispinterface_cant_have_parent=03216_E_Ein DISPINTERFACE kann keine Elternklasse haben. +% A DISPINTERFACE is a special type of interface which can't have a parent class. Dispinterface always derive from IDispatch type. +parser_e_dispinterface_needs_a_guid=03217_E_Ein DISPINTERFACE ben”tigt einen GUID +% A DISPINTERFACE always needs an interface identification (a GUID). +parser_w_overridden_methods_not_same_ret=03218_W_šberschriebene Methoden mssen einen entsprechenden Rckgabetyp haben. Dieser Code kann abstrzen, weil er von einem Delphi Parser Bug abh„ngt (Methode "$2" wird durch "$1" berschrieben, die einen anderen Rckgabetyp hat). +% If you declare overridden methods in a class definition, they must +% have the same return type. Some versions of Delphi allow you to change the +% return type of interface methods, and even to change procedures into +% functions, but the resulting code may crash depending on the types used +% and the way the methods are called. +parser_e_dispid_must_be_ord_const=03219_E_Dispatch IDs mssen ganzzahlige Konstanten sein +% The \var{dispid} keyword must be followed by an ordinal constant (the dispid index). +parser_e_array_range_out_of_bounds=03220_E_Der Bereich des Array ist zu gross +% Regardless of the size taken up by its elements, an array cannot have more +% than high(ptrint) elements. Additionally, the range type must be a subrange +% of ptrint. +parser_e_packed_element_no_var_addr=03221_E_Bit packed Array-Elemente und Record-Felder haben keine Adressen +% If you declare an array or record as \var{packed} in Mac Pascal mode +% (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will +% be packed at the bit level. This means it becomes impossible to take addresses +% of individual array elements or record fields. The only exception to this rule +% is in the case of packed arrays elements whose packed size is a multple of 8 bits. +parser_e_packed_dynamic_open_array=03222_E_Dynamische Arrays k”nnen nicht packed sein +% Only regular (and possibly in the future also open) arrays can be packed. +parser_e_packed_element_no_loop=03223_E_Bit packed Array-Elemente und Record-Felder k”nnen nicht als Loop-Variable verwerndet werden +% If you declare an array or record as \var{packed} in Mac Pascal mode +% (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will +% be packed at the bit level. For performance reasons, they cannot be +% used as loop variables. +parser_e_type_var_const_only_in_records_and_classes=03224_E_VAR, TYPE und CONST sind nur innerhalb Records, Objekten und Klassen erlaubt +% The usage of VAR, TYPE and CONST to declare new types inside an object is allowed only inside +% records, objects and classes. +parser_e_cant_create_generics_of_this_type=03225_E_Dieser Typ kann nicht "generic" sein +% Only Classes, Objects, Interfaces and Records are allowed to be used as generic. +parser_w_no_lineinfo_use_switch=03226_W_Die LINEINFO Unit nicht manuell laden. Verwende statt dessen den Compilerschalter -gl +% Do not use the \file{lineinfo} unit directly, Use the \var{-gl} switch which +% automatically adds the correct unit for reading the selected type of debugging +% information. The unit that needs to be used depends on the type of +% debug information used when compiling the binary. +parser_e_no_funcret_specified=03227_E_Kein Funktionsergebnistyp fr Funktion "$1" angegeben +% The first time you declare a function you have to declare it completely, +% including all parameters and the result type. +parser_e_special_onlygenerics=03228_E_Spezialisierung wird nur fr generische Typen untersttzt +% Types which are not generics can't be specialized. +parser_e_no_generics_as_params=03229_E_Generische Typen k”nnen bei der Spezialisierung generischer Typen nicht als Parameter benutzt werden +% When specializing a generic, only non-generic types can be used as parameters. +parser_e_type_object_constants=03230_E_Konstanten eines Objekts, das ein VMT enth„lt, sind unzul„ssig +% If an object requires a VMT either because it contains a constructor or virtual methods, +% it's not allowed to create constants of it. In TP and Delphi mode this is allowed +% for compatibility reasons. +parser_e_label_outside_proc=03231_E_Die Address von Labels, die ausserhalb des aktuellen Scopes definiert wurden, k”nnen nicht verwendet werden +% It isn't allowed to take the address of labels outside the +% current procedure. +parser_e_initialized_not_for_external=03233_E_Extern deklarierte Variablen k”nnen nicht intialisiert werden +% Variables declared as external cannot be initialized with a default value. +parser_e_illegal_function_result=03234_E_Ungltiger Funktionsergebnistyp +% Some types like file types cannot be used as function result. +parser_e_no_common_type=03235_E_"$1" und "$2" haben keinen gemeinsamen Typ +% To perform an operation on integers, the compiler converts both operands +% to their common type, which appears to be an invalid type. To determine the +% common type of the operands, the compiler takes the minimum of the minimal values +% of both types, and the maximum of the maximal values of both types. The common +% type is then minimum..maximum. +parser_e_no_generics_as_types=03236_E_Generische Typen k”nnen nicht ohne Spezialisierung als Typ fr eine Variable verwendet werden +% Generics must be always specialized before being used as variable type. +parser_w_register_list_ignored=03237_W_Registerliste wird in reinen Assemblerroutinen ignoriert +% When using pure assembler routines, the list with modified registers is ignored. +parser_e_implements_must_be_class_or_interface=03238_E_Die Implements-Eigenschaft muss einen Klassen- oder Interface-Typ haben +% A property which implements an interface must be of type class or interface. +parser_e_implements_must_have_correct_type=03239_E_Die Implements-Eigenschaft muss ein Interface mit dem richtigen Typ implementieren; es wurde Typ "$1" gefunden, aber Typ "$2" erwartet. +% A property which implements an interface actually implements a different interface. +parser_e_implements_must_read_specifier=03240_E_Die Implements-Eigenschaft muss einen Lesen-Bezeichner haben +% A property which implements an interface must have at least a read specifier. +parser_e_implements_must_not_have_write_specifier=03241_E_Die Implements-Eigenschaft darf keinen Schreib-Bezeichner haben +% A property which implements an interface may not have a write specifier. +parser_e_implements_must_not_have_stored_specifier=03242_E_Die Implements-Eigenschaft darf keinen Gespeichert-Bezeichner haben +% A property which implements an interface may not have a stored specifier. +parser_e_implements_uses_non_implemented_interface=03243_E_Die Implements-Eigenschaft benutzt das nicht implementierte Interface "$1" +% The interface which is implemented by a property is not an interface implemented by the class. +parser_e_unsupported_real=03244_E_Fliesskommavariablen werden fr dieses Ziel nicht untersttzt +% The compiler parsed a floating point expression, but it is not supported. +parser_e_class_doesnt_implement_interface=03245_E_Klasse "$1" implementiert das Interface "$2" nicht +% The delegated interface is not implemented by the class given in the implements clause. +parser_e_class_implements_must_be_interface=03246_E_Der von Implements benutzte Typ muss ein Interface sein +% The \var{implements} keyword must be followed by an interface type. +parser_e_cant_export_var_different_name=03247_E_Variablen k”nnen fr dieses Target nicht mit einem anderen Namen exportiert werden; fge der Deklaration den Namen mit einer "export" Direktive hinzu (Variablenname: $1, deklarierter Name fr den Export: $2) +% On most targets it is not possible to change the name under which a variable +% is exported inside the \var{exports} statement of a library. +% In that case, you have to specify the export name at the point where the +% variable is declared, using the \var{export} and \var{alias} directives. +parser_e_weak_external_not_supported=03248_E_Schwache externe Symbole werden fr dieses Target nicht untersttzt +% A "weak external" symbol is a symbol which may or may not exist at (either static +% or dynamic) link time. This concept may not be available (or implemented yet) +% on the current cpu/OS target. +parser_e_forward_mismatch=03249_E_Forward Typdefinition passt nicht +% Classes and interfaces being defined forward must have the same type +% when being implemented. A forward interface cannot be changed into a class. +parser_n_ignore_lower_visibility=03250_N_Die virtuelle Methode "$1" hat eine niedrigere Sichtbarkeit ($2) als die Elternklasse $3 ($4) +% The virtual method overrides an method that is declared with a higher visibility. This might give +% unexpected results. In case the new visibility is private than it might be that a call to inherited in a +% new child class will call the higher visible method in a parent class and ignores the private method. +parser_e_field_not_allowed_here=03251_E_Felder sind nach der Definition einer Methode oder Eigenschaft nicht erlaubt. Beginne vorher eine neue Sichtbarkeitssektion +% Once a method or property has been defined in a class or object, you cannot define any fields afterwards +% without starting a new visibility section (such as \var{public}, \var{private}, etc.). The reason is +% that otherwise the source code can appear ambiguous to the compiler, since it is possible to use modifiers +% such as \var{default} and \var{register} also as field names. +parser_e_no_local_para_def=03252_E_Parameter oder Ergebnistypen k”nnen keine lokalen Typdeklarationen enthalten. Verwende eine getrennte Typdefinition in einem "type"-Block +% In Pascal, types are not considered to be identical simply because they are semantically equivalent. +% Two variables or parameters are only considered to be of the same type if they refer to the +% same type definition. +% As a result, it is not allowed to define new types inside parameter lists, because then it is impossible to +% refer to the same type definition in the procedure headers of the interface and implementation of a unit +% (both procedure headers would define a separate type). Keep in mind that expressions such as +% ``file of byte'' or ``string[50]'' also define a new type. +parser_e_abstract_and_sealed_conflict=03253_E_Konflikt zwischen ABSTRACT und SEALED +% ABSTRACT and SEALED cannot be used together in one declaration +parser_e_sealed_descendant=03254_E_Kann keinen Nachfahren der SEALED Klasse "$1" erzeugen +% Sealed means that class cannot be derived by another class. +parser_e_sealed_class_cannot_have_abstract_methods=03255_E_Eine SEALED Klasse kann keine ABSTRACT Methode haben +% Sealed means that class cannot be derived. Therefore no one class is able to override an abstract method in a sealed class. +parser_e_only_virtual_methods_final=03256_E_Nur virtuelle Methoden k”nnen final sein. +% You are declaring a method as final, when it is not declared to be +% virtual. +parser_e_final_can_no_be_overridden=03257_E_Die finale Methode kann nicht berschrieben werden: "$1" +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_multiple_messages=03258_E_Pro Methode kann nur eine Nachricht verwendet werden +% It is not possible to associate multiple messages with a single method. +parser_e_invalid_enumerator_identifier=03259_E_Ungltiger Aufz„hlungsbezeichner: "$1" +% Only "MoveNext" and "Current" enumerator identifiers are supported. +parser_e_enumerator_identifier_required=03260_E_Aufz„hlungsbezeichner notwendig +% "MoveNext" or "Current" identifier must follow the \var{enumerator} modifier. +parser_e_enumerator_movenext_is_not_valid=03261_E_Die Aufz„hlungs-pattern-Methode "MoveNext" ist ungltig. Die Methode muss eine Funktion mit Rckgabetyp Boolean und ohne notwendige Argumente sein +% "MoveNext" enumerator pattern method must be a function with Boolean return type and no required arguments +parser_e_enumerator_current_is_not_valid=03262_E_Die Aufz„hlungs-pattern-Eigenschaft "Current" ist ungltig. Die Eigenschaft ben”tigt einen "Getter" +% "Current" enumerator pattern property must have a getter +parser_e_only_one_enumerator_movenext=03263_E_Pro Klasse/Objekt ist nur eine Aufz„hlungsmethode "MoveNext" erlaubt +% Class or Object can have only one enumerator MoveNext declaration. +parser_e_only_one_enumerator_current=03264_E_Pro Klasse/Objekt ist nur eine Aufz„hlungseigenschaft "Current" erlaubt +% Class or Object can have only one enumerator Current declaration. +parser_e_for_in_loop_cannot_be_used_for_the_type=03265_E_For in Schleife kann nicht fr den Typ "$1" verwendet werden +% For in loop can be used not for all types. For example it cannot be used for the enumerations with jumps. +parser_e_objc_requires_msgstr=03266_E_Objective-C Nachrichten erfordern, dass ihr Objective-C selector-Name mit der Direktive "message" angegeben wird +% Objective-C messages require their Objective-C name (selector name) to be specified using the \var{message `someName:'} procedure directive. +% While bindings to other languages automatically generate such names based on the identifier you use (by replacing +% all underscores with colons), this is unsafe since nothing prevents an Objective-C method name to contain actual +% colons. +parser_e_objc_no_constructor_destructor=03267_E_Objective-C hat keine formalen Konstruktoren oder Destruktoren. Verwende die Nachrichten alloc, initXXX und dealloc +% The Objective-C language does not have any constructors or destructors. While there are some messages with a similar +% purpose (such as \var{init} and \var{dealloc}), these cannot be identified using automatic parsers and do not +% guarantee anything like Pascal constructors/destructors (e.g., you have to take care of only calling ``designated'' +% inherited ``constructors''). For these reasons, we have opted to follow the standard Objective-C patterns for +% instance creation/destruction. +parser_e_message_string_too_long=03268_E_Der Name der Nachricht ist zu lang (max. 255 Zeichen) +% Due to compiler implementation reasons, message names are currently limited to 255 characters. +parser_e_objc_message_name_too_long=03269_E_Der Symbolname der Objective-C-Nachricht "$1" ist zu lang +% Due to compiler implementation reasons, mangled message names (i.e., the symbol names used in the assembler +% code) are currently limited to 255 characters. +parser_h_no_objc_parent=03270_H_Definieren einer neuen Objective-C root-Klasse. Um sie von einer anderen root-Klasse abzuleiten (z.B. NSObject), gib diese als Elternklasse an +% If no parent class is specified for an Object Pascal class, then it automatically derives from TObject. +% Objective-C classes however do not automatically derive from NSObject, because one can have multiple +% root classes in Objective-C. For example, in the Cocoa framework both NSObject and NSProxy are root classes. +% Therefore, you have to explicitly define a parent class (such as NSObject) if you want to derive your +% Objective-C class from it. +parser_e_no_objc_published=03271_E_Objective-C Klassen k”nnen keinen Abschnitt published haben +% In Object Pascal, ``published'' determines whether or not RTTI is generated. Since the Objective-C runtime always needs +% RTTI for everything, this specified does not make sense for Objective-C classes. +parser_f_need_objc=03272_F_Dieses Modul erfordert, dass der Objective-C Mode-Schalter bersetzt wird +% This error indicates the use of Objective-C language features without an Objective-C mode switch +% active. Enable one via the -M command line switch, or the {\$modeswitch x} directive. +parser_e_must_use_override_objc=03273_E_Vererbte Methoden k”nnen nur in Objective-C berschrieben werden, fge "override" hinzu (Vererbte Methode ist in $1 definiert) +parser_h_should_use_override_objc=03274_H_Vererbte Methoden k”nnen nur in Objective-C berschrieben werden, fge "override" hinzu (Vererbte Methode ist in $1 definiert) +% It is not possible to \var{reintroduce} methods in Objective-C like in Object Pascal. Methods with the same +% name always map to the same virtual method entry. In order to make this clear in the source code, +% the compiler always requires the \var{override} directive to be specified when implementing overriding +% Objective-C methods in Pascal. If the implementation is external, this rule is relaxed because Objective-C +% does not have any \var{override}-style keyword (since it's the default and only behaviour in that language), +% which makes it hard for automated header conversion tools to include it everywhere. +% The type in which the inherited method is defined is explicitly mentioned, because this may either +% be an objcclass or an objccategory. +parser_e_objc_message_name_changed=03275_E_Der Nachrichtenname "$1" in der vererbten Klasse unterscheidet sich vom Nachrichtennamen "$2" in der aktuellen Klasse +% An overriding Objective-C method cannot have a different message name than an inherited method. The reason +% is that these message names uniquely define the message to the Objective-C runtime, which means that +% giving them a different message name breaks the ``override'' semantics. +parser_e_no_objc_unique=03276_E_Noch k”nnen eindeutige Kopien von Objective-C Typen nicht erstellt werden +% Duplicating an Objective-C type using \var{type x = type y;} is not yet supported. You may be able to +% obtain the desired effect using \var{type x = objcclass(y) end;} instead. +parser_e_no_category_as_types=03277_E_Objective-C Kategorien und Object-Pascal Klassenhelfer k”nnen nicht als Typen benutzt werden +% It is not possible to declare a variable as an instance of an Objective-C +% category or an Object Pascal class helper. A category/class helper adds +% methods to the scope of an existing class, but does not define a type by +% itself. An exception of this rule is when inheriting an Object Pascal class +% helper from another class helper. +parser_e_no_category_override=03278_E_Kategorien berschreiben Methoden nicht, sondern ersetzen sie. "reintroduce" benutzen +parser_e_must_use_reintroduce_objc=03279_E_Ersetzte Methoden k”nnen in Objective-C nur wieder eingefhrt werden, fge "reintroduce" hinzu (Ersetzte Methode ist in $1 definiert) +parser_h_should_use_reintroduce_objc=03280_H_Ersetzte Methoden k”nnen in Objective-C nur wieder eingefhrt werden, fge "reintroduce" hinzu (Ersetzte Methode ist in $1 definiert) +% A category replaces an existing method in an Objective-C class, rather than that it overrides it. +% Calling an inherited method from an category method will call that method in +% the extended class' parent, not in the extended class itself. The +% replaced method in the original class is basically lost, and can no longer be +% called or referred to. This behaviour corresponds somewhat more closely to +% \var{reintroduce} than to \var{override} (although in case of \var{reintroduce} +% in Object Pascal, hidden methods are still reachable via inherited). +% The type in which the inherited method is defined is explicitly mentioned, because this may either +% be an objcclass or an objccategory. +parser_e_implements_getter_not_default_cc=03281_E_Getter fr das Interface implements mssen die voreingestellte calling convention des Ziels benutzen +% Interface getters are called via a helper in the run time library, and hence +% have to use the default calling convention for the target (\var{register} on +% i386 and x86\_64, \var{stdcall} on other architectures). +parser_e_no_refcounted_typed_file=03282_E_Typisierte Dateien k”nnen keine reference-counted Typen enthalten +% The data in a typed file cannot be of a reference counted type (such as +% \var{ansistring} or a record containing a field that is reference counted). +parser_e_operator_not_overloaded_2=03283_E_šberladenener Operator nicht vorhanden: $2 "$1" +% You are trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_operator_not_overloaded_3=03284_E_šberladenener Operator nicht vorhanden: "$1" $2 "$3" +% You are trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_more_array_elements_expected=03285_E_Erwarte ein weiteres Element fr Array $1 +% When declaring a typed constant array, you provided to few elements to initialize the array +parser_e_string_const_too_long=03286_E_Stringkonstante zu lang, so lange ansistrings ausgeschaltet sind +% Only when a piece of code is compiled with ansistrings enabled (\var{\{\$H+\}}), string constants +% longer than 255 characters are allowed. +parser_e_invalid_univ_para=03287_E_Typ kann nicht als "univ" Parameter verwendet werden, weil seine Gr”áe zur Zeit der šbersetzung unbekannt ist: "$1" +% \var{univ} parameters are compatible with all values of the same size, but this +% cannot be checked in case a parameter's size is unknown at compile time. +parser_e_only_one_class_constructor_allowed=03288_E_In der Klasse "$1" darf nur ein Klassenkonstruktor deklariert werden +% You are trying to declare more than one class constructor but only one class constructor can be declared. +parser_e_only_one_class_destructor_allowed=03289_E_In der Klasse "$1" darf nur ein Klassendestruktor deklariert werden +% You are trying to declare more than one class destructor but only one class destructor can be declared. +parser_e_no_paras_for_class_constructor=03290_E_Ein Klassenkonstruktur darf keine Parameter haben +% You are declaring a class constructor with a parameter list. Class constructor methods +% cannot have parameters. +parser_e_no_paras_for_class_destructor=03291_E_Ein Klassendestruktur darf keine Parameter haben +% You are declaring a class destructor with a parameter list. Class destructor methods +% cannot have parameters. +parser_f_modeswitch_objc_required=03292_F_Dieses Konstrukt erfordert, dass der Modenschalter \{\$modeswitch objectivec1\} aktiv ist +% Objective-Pascal constructs are not supported when \{\$modeswitch ObjectiveC1\} +% is not active. +parser_e_widestring_to_ansi_compile_time=03293_E_Eine Unicodechar/string Konstante zur Zeit der šbersetzung nicht in eine ansi/shortstring Konstante konvertiert werden +% It is not possible to use unicodechar and unicodestring constants in +% constant expressions that have to be converted into an ansistring or shortstring +% at compile time, for example inside typed constants. The reason is that the +% compiler cannot know what the actual ansi encoding will be at run time. +parser_e_objc_enumerator_2_0=03294_E_Objective-Pascal For-in Schleifen erfordern, dass der Modenschalter \{\$modeswitch ObjectiveC2\} aktiv ist +% Objective-C ``fast enumeration'' support was added in Objective-C 2.0, and +% hence the appropriate modeswitch has to be activated to expose this feature. +% Note that Objective-C 2.0 programs require Mac OS X 10.5 or later. +parser_e_objc_missing_enumeration_defs=03295_E_Der Kompiler findet die Typen NSFastEnumerationProtocol oder NSFastEnumerationState nicht in der Unit CocoaAll +% Objective-C for-in loops (fast enumeration) require that the compiler can +% find a unit called CocoaAll that contains definitions for the +% NSFastEnumerationProtocol and NSFastEnumerationState types. If you get this +% error, most likely the compiler is finding and loading an alternate CocoaAll +% unit. +parser_e_no_procvarnested_const=03296_E_Typisierte Konstanten des Typs 'procedure is nested' k”nnen nur mit NIL und globalen Prozeduren/Funktionen initialisiert werden +% A nested procedural variable consists of two components: the address of the +% procedure/function to call (which is always known at compile time), and also +% a parent frame pointer (which is never known at compile time) in case the +% procedural variable contains a reference to a nested procedure/function. +% Therefore such typed constants can only be initialized with global +% functions/procedures since these do not require a parent frame pointer. +parser_f_no_generic_inside_generic=03297_F_Die Deklaration einer generischen Klasse innerhalb einer anderen generischen Klasse ist nicht erlaubt +% At the moment, scanner supports recording of only one token buffer at the time +% (guarded by internal error 200511173 in tscannerfile.startrecordtokens). +% Since generics are implemented by recording tokens, it is not possible to +% have declaration of generic class inside another generic class. +parser_e_forward_protocol_declaration_must_be_resolved=03298_E_Vorw„rts-Deklarationen des ObjC-Protokolls "$1" mssen aufgel”st sein, bevor eine ObjC-Klasse ihr folgen kann +% An objcprotocol must be fully defined before classes can conform to it. +% This error occurs in the following situation: +% \begin{verbatim} +% Type MyProtocol = objcprotoocl; +% ChildClass = Class(NSObject,MyProtocol) +% ... +% end; +% \end{verbatim} +% where \var{MyProtocol} is declared but not defined. +parser_e_no_record_published=03299_E_Record -Typen k”nnen keine ”ffentlichen Abschnitte (published sections) haben +% Published sections can be used only inside classes. +parser_e_no_destructor_in_records=03300_E_Destruktoren sind in Records und Helfern nicht erlaubt +% Destructor declarations aren't allowed in records or helpers. +parser_e_class_methods_only_static_in_records=03301_E_Klassenmethoden mssen in Records statisch sein +% Class methods declarations aren't allowed in records without static modifier. +% Records have no inheritance and therefore non static class methods have no sence for them. +parser_e_no_constructor_in_records=03302_E_Konstruktoren sind in Records und Recordhelfern nicht erlaubt +% Constructor declarations aren't allowed in records or record helpers. +parser_e_at_least_one_argument_must_be_of_type=03303_E_Entweder das Ergebnis oder mindestens ein Parameter mssen vom Typ "$1" sein +% It is required that either the result of the routine or at least one of its parameters be of the specified type. +% For example class operators either take an instance of the structured type in which they are defined, or they return one. +parser_e_cant_use_type_parameters_here=03304_E_Typ-Parameter k”nnen initialization/finalization erfordern - Sie k”nnen deshalb nicht in varianten Rekords verwendet werden +% Type parameters may be specialized with types which (e.g. \var{ansistring}) need initialization/finalization +% code which is implicitly generated by the compiler. +parser_e_externals_no_section=03305_E_"external" deklarierte Variablen drfen nicht in einer "custom section" sein +% A section directive is not valid for variables being declared as external. +parser_e_section_no_locals=03306_E_Nicht-statische und nicht-globale Variablen drfen keine Direktive "section" haben +% A variable placed in a custom section is always statically allocated so it must be either a static or global variable. +parser_e_not_allowed_in_helper=03307_E_"$1" ist in Helfertypen nicht erlaubt +% Some directives and specifiers like "virtual", "dynamic", "override" aren't +% allowed inside helper types in mode ObjFPC (they are ignored in mode Delphi), +% because they have no meaning within helpers. Also "abstract" isn't allowed in +% either mode. +parser_e_no_class_constructor_in_helpers=03308_E_Klassenkonstruktoren sind in Helfern nicht erlaubt +% Class constructor declarations aren't allowed in helpers. +parser_e_inherited_not_in_record=03309_E_"inherited" ist in einem Record nicht erlaubt +% As records don't suppport inheritance the use of "inherited" is prohibited for +% these as well as for record helpers (in mode "Delphi" only). +parser_e_no_types_in_local_anonymous_records=03310_E_Typ-Deklarationen sind in lokalen oder anonymen Records nicht erlaubt +% Records with types must be defined globally. Types cannot be defined inside records which are defined in a +% procedure or function or in anonymous records. +parser_e_duplicate_implements_clause=03311_E_Zweifacher "implements"-Term fr das Interface "$1" +% A class may delegate an interface using the "implements" clause only to a single property. Delegating it multiple times +% is a error. +parser_e_mapping_no_implements=03312_E_Das Interface "$1" kann nicht durch "$2" delegiert werden. Die Methode ist bereits aufgel”st +% Method resolution clause maps a method of an interface to a method of the current class. Therefore the current class +% has to implement the interface directly. Delegation is not possible. +parser_e_implements_no_mapping=03313_E_Das Interface "$1" kann keine Methoden-Aufl”sung haben, "$2" delegiert es bereits +% Method resoulution is only possible for interfaces that are implemented directly, not by delegation. +% +% \end{description} +# EndOfTeX + +# +# Type Checking +# +# 04103 is the last used one +# +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +type_e_mismatch=04000_E_Typen passen nicht zusammen +% This can happen in many cases: +% \begin{itemize} +% \item The variable you're assigning to is of a different type than the +% expression in the assignment. +% \item You are calling a function or procedure with parameters that are +% incompatible with the parameters in the function or procedure definition. +% \end{itemize} +type_e_incompatible_types=04001_E_Inkompatible Typen: Habe "$1" erhalten, aber "$2" erwartet +% There is no conversion possible between the two types. +% Another possiblity is that they are declared in different +% declarations: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { This statement also gives this error. It +% is due to the strict type checking of Pascal } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_Typen sind verschieden bei $1 und $2 +% The types are not equal. +type_e_type_id_expected=04003_E_Typbezeichner erwartet +% The identifier is not a type, or you forgot to supply a type identifier. +type_e_variable_id_expected=04004_E_Variablenbezeichner erwartet +% This happens when you pass a constant to a \var{Inc} var or \var{Dec} +% procedure. You can only pass variables as arguments to these functions. +type_e_integer_expr_expected=04005_E_Integer-Ausdruck erwartet, aber "$1" erhalten +% The compiler expects an expression of type integer, but gets a different +% type. +type_e_boolean_expr_expected=04006_E_Booleschen Ausdruck erwartet, aber "$1" erhalten +% The expression must be a boolean type. It should be return \var{True} or +% \var{False}. +type_e_ordinal_expr_expected=04007_E_Ganzzahliger Ausdruck erwartet +% The expression must be of ordinal type, i.e., maximum a \var{Longint}. +% This happens, for instance, when you specify a second argument +% to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value. +type_e_pointer_type_expected=04008_E_Zeigertyp erwartet, aber "$1" erhalten +% The variable or expression isn't of the type \var{pointer}. This +% happens when you pass a variable that isn't a pointer to \var{New} +% or \var{Dispose}. +type_e_class_type_expected=04009_E_Klassentyp erwartet, aber "$1" erhalten +% The variable or expression isn't of the type \var{class}. This happens +% typically when +% \begin{enumerate} +% \item The parent class in a class declaration isn't a class. +% \item An exception handler (\var{On}) contains a type identifier that +% isn't a class. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_Kann konstanten Ausdruck nicht auswerten +% This error can occur when the bounds of an array you declared do +% not evaluate to ordinal constants. +type_e_set_element_are_not_comp=04012_E_Set-Elemente sind nicht kompatibel +% You are trying to perform an operation on two sets, when the set element types +% are not the same. The base type of a set must be the same when taking the +% union. +type_e_set_operation_unknown=04013_E_Operation fr Sets nicht implementiert +% several binary operations are not defined for sets. +% These include: \var{div}, \var{mod}, \var{**}, \var{>=} and \var{<=}. +% The last two may be defined for sets in the future. +type_w_convert_real_2_comp=04014_W_Automatische Typumwandlung von Fliesskommatyp nach COMP (=integer mit 64 bit) +% An implicit type conversion from a real type to a \var{comp} is +% encountered. Since \var{Comp} is a 64 bit integer type, this may indicate +% an error. +type_h_use_div_for_int=04015_H_Verwenden sie DIV um ein Integer-Ergebnis zu erhalten +% When hints are on, then an integer division with the '/' operator will +% produce this message, because the result will then be of type real. +type_e_strict_var_string_violation=04016_E_Stringtypen mssen im "$V+"-Modus exakt bereinstimmen +% When compiling in \var{\{\$V+\}} mode, the string you pass as a parameter +% should be of the exact same type as the declared parameter of the procedure. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_Succ oder Pred kann nicht auf Aufz„hlungen mit Zuweisungen angewendet werden +% If you declare an enumeration type which has C-like assignments +% in it, such as in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% then you cannot use the \var{Succ} or \var{Pred} functions with this enumeration. +type_e_cant_read_write_type=04018_E_Kann Variablen dieses Typs nicht lesen oder schreiben +% You are trying to \var{read} or \var{write} a variable from or to a +% file of type text, which doesn't support that variable's type. +% Only integer types, reals, pchars and strings can be read from or +% written to a text file. Booleans can only be written to text files. +type_e_no_readln_writeln_for_typed_file=04019_E_Kann ReadLn und WriteLn nicht bei typisierten Dateien verwenden +% \var{readln} and \var{writeln} are only allowed for text files. +type_e_no_read_write_for_untyped_file=04020_E_Kann Read und Write nicht bei untypisierten Dateien verwenden +% \var{read} and \var{write} are only allowed for text or typed files. +type_e_typeconflict_in_set=04021_E_Typkonflikt zwischen den Elementen des Sets +% There is at least one set element which is of the wrong type, i.e. not of +% the set type. +type_w_maybe_wrong_hi_lo=04022_W_lo/hi(dword/qword) gibt oberes/unteres Word/DWord zurck +% \fpc supports an overloaded version of \var{lo/hi} for \var{longint/dword/int64/qword} +% which returns the lower/upper word/dword of the argument. \tp always uses +% a 16 bit \var{lo/hi} which always returns bits 0..7 for \var{lo} and the +% bits 8..15 for \var{hi}. If you want the \tp behavior you have +% to type cast the argument to a \var{word} or \var{integer}. +type_e_integer_or_real_expr_expected=04023_E_Integer- oder Real-Ausdruck erwartet +% The first argument to \var{str} must be a real or integer type. +type_e_wrong_type_in_array_constructor=04024_E_Falscher Typ "$1" im Array-Konstruktor +% You are trying to use a type in an array constructor which is not +% allowed. +type_e_wrong_parameter_type=04025_E_Inkompatible Typen fr Argument Nr. #$1: habe $2 erhalten, aber $3 erwartet +% You are trying to pass an invalid type for the specified parameter. +type_e_no_method_and_procedure_not_compatible=04026_E_Methode (Variable) und Prozedur (Variable) sind nicht kompatibel +% You can't assign a method to a procedure variable or a procedure to a +% method pointer. +type_e_wrong_math_argument=04027_E_Unzul„ssige Konstante an interne Algebrafunktion bergeben +% The constant argument passed to a \var{ln} or \var{sqrt} function is out of +% the definition range of these functions. +type_e_no_addr_of_constant=04028_E_Von Konstanten kann keine Adresse bestimmt werden +% It's not possible to get the address of a constant, because they +% aren't stored in memory, you can try making it a typed constant. This error +% can also be displayed if you try to pass a property to a var parameter. +type_e_argument_cant_be_assigned=04029_E_An das Argument kann nichts zugewiesen werden +% Only expressions which can be on the left side of an +% assignment can be passed as call by reference arguments. +% +% Remark: Properties can be used on the left side of an assignment, +% nevertheless they cannot be used as arguments. +type_e_cannot_local_proc_to_procvar=04030_E_Kann lokale Prozedur/Funktion nicht an Prozedurvariable zuweisen +% It's not allowed to assign a local procedure/function to a +% procedure variable, because the calling convention of a local procedure/function is +% different. You can only assign local procedure/function to a void pointer. +type_e_no_assign_to_addr=04031_E_Kann einer Adresse keine Werte zuweisen +% It's not allowed to assign a value to an address of a variable,constant, +% procedure or function. You can try compiling with -So if the identifier +% is a procedure variable. +type_e_no_assign_to_const=04032_E_Kann einer Konstanten keine Werte zuweisen +% It's not allowed to assign a value to a variable which is declared +% as a const. This is normally a parameter declared as const. To allow +% changing the value, pass the parameter by value, or a parameter by reference +% (using var). +type_e_array_required=04033_E_Array Typ notwendig +% If you are accessing a variable using an index '[<x>]' then +% the type must be an array. In FPC mode a pointer is also allowed. +type_e_interface_type_expected=04034_E_Interface Typ erwartet, aber "$1" erhalten +% The compiler expected to encounter an interface type name, but got something else. +% The following code would produce this error: +% \begin{verbatim} +% Type +% TMyStream = Class(TStream,Integer) +% \end{verbatim} +type_h_mixed_signed_unsigned=04035_H_Mischen von signed Ausdrcken und Longwords ergibt ein 64bit Ergebnis +% If you divide (or calculate the modulus of) a signed expression by a longword (or vice versa), +% or if you have overflow and/or range checking turned on and use an arithmetic +% expression (+, -, *, div, mod) in which both signed numbers and longwords appear, +% then everything has to be evaluated in 64-bit arithmetic which is slower than normal +% 32-bit arithmetic. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_w_mixed_signed_unsigned2=04036_W_Mischen von signed Ausdrcken und kardinalen Typen hier kann einen Bereichsprfungsfehler verursachen +% If you use a binary operator (and, or, xor) and one of +% the operands is a longword while the other one is a signed expression, then, +% if range checking is turned on, you may get a range check error because in +% such a case both operands are converted to longword before the operation is +% carried out. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_e_typecast_wrong_size_for_assignment=04037_E_Typecast hat verschiedene Gr”ssen ($1 -> $2) in der Zuweisung +% Type casting to a type with a different size is not allowed when the variable is +% used in an assignment. +type_e_array_index_enums_with_assign_not_possible=04038_E_enums mit Zuweisungen k”nnen nicht als Array-Index verwendet werden +% When you declared an enumeration type which has C-like +% assignments, such as in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use it as the index of an array. +type_e_classes_not_related=04039_E_Klassen- oder Objekttypen "$1" and "$2" sind nicht verwandt +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors. +type_w_classes_not_related=04040_W_Klassentypen "$1" und "$2" sind nicht verwandt +% There is a typecast from one class to another while the classes +% are not related. This will probably lead to errors. +type_e_class_or_interface_type_expected=04041_E_Klassen- oder Interface-Typ erwartet, aber "$1" erhalten +% The compiler expected a class or interface name, but got another type or identifier. +type_e_type_is_not_completly_defined=04042_E_Typ "$1" ist nicht vollst„ndig definiert +% This error occurs when a type is not complete: i.e. a pointer type which points to +% an undefined type. +type_w_string_too_long=04043_W_String literal hat mehr Zeichen als short string length +% The size of the constant string, which is assigned to a shortstring, +% is longer than the maximum size of the shortstring (255 characters). +type_w_comparison_always_false=04044_W_Wegen der Bereiche der Konstanten und des Ausdrucks k”nnte das Vergleichsergebnis immer falsch sein +% There is a comparison between a constant and an expression where the constant is out of the +% valid range of values of the expression. Because of type promotion, the statement will always evaluate to +% false. Explicitly typecast the constant or the expression to the correct range to avoid this warning +% if you think the code is correct. +type_w_comparison_always_true=04045_W_Wegen der Bereiche der Konstanten und des Ausdrucks k”nnte das Vergleichsergebnis immer richtig sein +% There is a comparison between a constant and an expression where the constant is out of the +% valid range of values of the expression. Because of type promotion, the statement will always evaluate to +% true. Explicitly typecast the constant or the expression to the correct range to avoid this warning +% if you think the code is correct. +type_w_instance_with_abstract=04046_W_Konstruktion der Klasse "$1" mit der abstrakten Methode "$2" +% An instance of a class is created which contains non-implemented abstract +% methods. This will probably lead to a runtime error 211 in the code if that +% routine is ever called. All abstract methods should be overridden. +type_h_in_range_check=04047_H_Der linke Operand des IN Operators sollte byte Gr”sse haben +% The left operand of the \var{in} operator is not an ordinal or enumeration which fits +% within 8 bits. This may lead to range check errors. The \var{in} operator +% currently only supports a left operand which fits within a byte. In the case of +% enumerations, the size of an element of an enumeration can be controlled with +% the \var{\{\$PACKENUM\}} or \var{\{\$Zn\}} switches. +type_w_smaller_possible_range_check=04048_W_Unpassende Typgr”ssen, Gefahr des Datenverlusts oder Bereichsprfungsfehlers +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_h_smaller_possible_range_check=04049_H_Unpassende Typgr”ssen, Gefahr des Datenverlusts oder Bereichsprfungsfehlers +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_e_cant_take_address_of_abstract_method=04050_E_Die Adresse einer abstrakten Methode kann nicht verwendet werden +% An abstract method has no body, so the address of an abstract method can't be taken. +type_e_assignment_not_allowed=04051_E_Zuweisungen auf formale Parameter und offene Arrays sind nicht m”glich +% You are trying to assign a value to a formal (untyped var, const or out) +% parameter, or to an open array. +type_e_constant_expr_expected=04052_E_Konstanter Ausdruck erwartet +% The compiler expects an constant expression, but gets a variable expression. +type_e_operator_not_supported_for_types=04053_E_Operation "$1" wird fr die Typen "$2" und "$3" nicht untersttzt +% The operation is not allowed for the supplied types. +type_e_illegal_type_conversion=04054_E_Illegale Typ-Konversion: "$1" nach "$2" +% When doing a type-cast, you must take care that the sizes of the variable and +% the destination type are the same. +type_h_pointer_to_longint_conv_not_portable=04055_H_Konversion zwischen ordinalen Typen und Zeigern ist nicht portierbar +% If you typecast a pointer to a longint (or vice-versa), this code will not compile +% on a machine using 64 bits addressing. +type_w_pointer_to_longint_conv_not_portable=04056_W_Konversion zwischen ordinalen Typen und Zeigern ist nicht portierbar +% If you typecast a pointer to an ordinal type of a different size (or vice-versa), this can +% cause problems. This is a warning to help in finding the 32-bit specific code where cardinal/longint is used +% to typecast pointers to ordinals. A solution is to use the ptrint/ptruint types instead. +type_e_cant_choose_overload_function=04057_E_Kann nicht bestimmen, welche der berladenen Funktionen aufgerufen werden soll +% You're calling overloaded functions with a parameter that doesn't correspond +% to any of the declared function parameter lists. e.g. when you have declared +% a function with parameters \var{word} and \var{longint}, and then you call +% it with a parameter which is of type \var{integer}. +type_e_illegal_count_var=04058_E_Loop-Variable muss einen ordinalen Typ haben +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +type_w_double_c_varargs=04059_W_Der konstante Wert vom Typ real wird fr ein C Variablen-Argument zu double konvertiert. Erg„nze eine explizite Typ-Konversion (typecast), um das zu verhindern +% In C, constant real values are double by default. For this reason, if you +% pass a constant real value to a variable argument part of a C function, FPC +% by default converts this constant to double as well. If you want to prevent +% this from happening, add an explicit typecast around the constant. +type_e_class_or_cominterface_type_expected=04060_E_Class oder COM interface Typ erwartet, statt dessen "$1" erhalten +% Some operators, such as the AS operator, are only applicable to classes or COM interfaces. +type_e_no_const_packed_array=04061_E_Konstante packed Arrays werden noch nicht untersttzt +% You cannot declare a (bit)packed array as a typed constant. +type_e_got_expected_packed_array=04062_E_Inkompatibler Typ fr Argument $1: Erhielt "$2" erwartete "(Bit)Packed Array" +% The compiler expects a (bit)packed array as the specified parameter. +type_e_got_expected_unpacked_array=04063_E_Inkompatibler Typ fr Argument $1: Erhielt "$2" erwartete "(not packed) Array" +% The compiler expects a regular (i.e., not packed) array as the specified parameter. +type_e_no_packed_inittable=04064_E_Elemente von packed Arrays k”nnen nicht von einem Typ sein, der initialisiert werden muss +% Support for packed arrays of types that need initialization +% (such as ansistrings, or records which contain ansistrings) is not yet implemented. +type_e_no_const_packed_record=04065_E_Konstante packed Records und Objekte werden noch nicht untersttzt +% You cannot declare a (bit)packed array as a typed constant at this time. +type_w_untyped_arithmetic_unportable=04066_W_Arithmetik "$1" mit typenlosem Pointer ist nicht portierbar nach {$T+}, schlage typecast vor +% Addition/subtraction from an untyped pointer may work differently in \var{\{\$T+\}}. +% Use a typecast to a typed pointer. +type_e_cant_take_address_of_local_subroutine=04076_E_Die Address einer Subroutine, die als local markiert ist, kann nicht verwendet werden +% The address of a subroutine marked as local can't be taken. +type_e_cant_export_local=04077_E_Eine Subroutine, die aus einer Unit als local markiert ist, kann nicht exportiert werden +% A subroutine marked as local can't be exported from a unit. +type_e_not_automatable=04078_E_Typ "$1" ist nicht "automatable" +% Only byte, integer, longint, smallint, currency, single, double, ansistring, +% widestring, tdatetime, variant, olevariant, wordbool and all interfaces are automatable. +type_h_convert_add_operands_to_prevent_overflow=04079_H_Konvertierung des Operanden "$1" vor der Addition k”nnte šberlauf Fehler verhindern +% Adding two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the addition. +type_h_convert_sub_operands_to_prevent_overflow=04080_H_Konvertierung des Operanden "$1" vor der Subtraktion k”nnte šberlauf Fehler verhindern +% Subtracting two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the subtraction. +type_h_convert_mul_operands_to_prevent_overflow=04081_H_Konvertierung des Operanden "$1" vor der Multiplikation k”nnte šberlauf Fehler verhindern +% Multiplying two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the multiplication. +type_w_pointer_to_signed=04082_W_Die Konvertierung von Pointern in einen Integertyp mit Vorzeichen kann zu falschen Ergebnissen bei Vergleichen und zu Bereichsberschreitungen fhren; verwenden sie statt dessen besser einen Typ ohne Vorzeichen +% The virtual address space on 32-bit machines runs from \$00000000 to \$ffffffff. +% Many operating systems allow you to allocate memory above \$80000000. +% For example both \windows and \linux allow pointers in the range \$0000000 to \$bfffffff. +% If you convert pointers to signed types, this can cause overflow and range check errors, +% but also \$80000000 < \$7fffffff. This can cause random errors in code like "if p>q". +type_e_interface_has_no_guid=04083_E_Interface Typ $1 hat keine gltige GUID +% When applying the as-operator to an interface or class, the desired interface (i.e. the right operand of the +% as-operator) must have a valid GUID. +type_e_invalid_objc_selector_name=04084_E_Ungltiger Objective-C-Selector-Name "$1" +% An Objective-C selector cannot be empty, must be a valid identifier or a single colon, +% and if it contains at least one colon it must also end in one. +type_e_expected_objc_method_but_got=04085_E_Erwartete eine Objective-C-Methode, erhielt aber $1 +% A selector can only be created for Objective-C methods, not for any other kind +% of procedure/function/method. +type_e_expected_objc_method=04086_E_Erwartete eine Objective-C-Methode, oder den Namen einer konstanten Methode +% A selector can only be created for Objective-C methods, either by specifying +% the name using a string constant, or by using an Objective-C method identifier +% that is visible in the current scope. +type_e_no_type_info=04087_E_Fr diesen Typ steht keine Typ-Information zu Verfgung +% Type information is not generated for some types, such as enumerations with gaps +% in their value range (this includes enumerations whose lower bound is different +% from zero). +type_e_ordinal_or_string_expr_expected=04088_E_Ausdruck mit ordinalem Typ oder Zeichenkette erwartet +% The expression must be an ordinal or string type. +type_e_string_expr_expected=04089_E_Ausdruck mit Zeichenkette erwartet +% The expression must be a string type. +type_w_zero_to_nil=04090_W_Konvertiere 0 zu NIL +% Use NIL rather than 0 when initialising a pointer. +type_e_protocol_type_expected=04091_E_Objective-C Protokolltyp erwartet, erhielt aber "$1" +% The compiler expected a protocol type name, but found something else. +type_e_objc_type_unsupported=04092_E_Der Typ "$1" wird nicht fr die Verwendung mit der Objective-C Laufzeitumgebung untersttzt. +% Objective-C makes extensive use of run time type information (RTTI). This format +% is defined by the maintainers of the run time and can therefore not be adapted +% to all possible Object Pascal types. In particular, types that depend on +% reference counting by the compiler (such as ansistrings and certain kinds of +% interfaces) cannot be used as fields of Objective-C classes, cannot be +% directly passed to Objective-C methods, and cannot be encoded using \var{objc\_encode}. +type_e_class_or_objcclass_type_expected=04093_E_Klasse oder Objective-C Klasse als Typ erwartet, erhielt aber "$1" +% It is only possible to create class reference types of \var{class} and \var{objcclass} +type_e_objcclass_type_expected=04094_E_Objective-C Klasse als Typ erwartet +% The compiler expected an \var{objcclass} type +type_w_procvar_univ_conflicting_para=04095_W_Erzwungener univ Parameter Typ in einer prozeduralen Variablen kann einen Absturz oder SpeicherKorruption verursachen: $1 auf $2 +% \var{univ} parameters are implicitly compatible with all types of the same size, +% also in procedural variable definitions. That means that the following code is +% legal, because \var{single} and \var{longint} have the same size: +% \begin{verbatim} +% {$mode macpas} +% Type +% TIntProc = procedure (l: univ longint); +% +% procedure test(s: single); +% begin +% writeln(s); +% end; +% +% var +% p: TIntProc; +% begin +% p:=test; +% p(4); +% end. +% \end{verbatim} +% This code may however crash on platforms that pass integers in registers and +% floating point values on the stack, because then the stack will be unbalanced. +% Note that this warning will not flagg all potentially dangerous situations. +% when \var{test} returns. +type_e_generics_cannot_reference_itself=04096_E_Typ-Parameter bei der Spezialisation von Generics k”nnen den aktuel spezialisierten Typ nicht referenzieren +% Recursive specializations of generics like \var{Type MyType = specialize MyGeneric<MyType>;} are not possible. +type_e_type_parameters_are_not_allowed_here=04097_E_Typ-Parameter sind fr nicht-generische Klassen/Record/Objekte Prozeduren und Funktionen nicht erlaubt +% Type parameters are only allowed for methods of generic classes, records or objects +type_e_generic_declaration_does_not_match=04098_E_Die generische Deklaration von "$1" unterscheidet sich vom der vorherigen Deklaration +% Generic declaration does not match the previous declaration +type_e_helper_type_expected=04099_E_Helfertyp erwartet +% The compiler expected a \var{class helper} type. +type_e_record_type_expected=04100_E_Recordtyp erwartet +% The compiler expected a \var{record} type. +type_e_class_helper_must_extend_subclass=04101_E_Abgeleitete Klassenhelfer mssen eine Unterklasse von "$1" oder die Klasse selbst erweitern +% If a class helper inherits from another class helper the extended class must +% extend either the same class as the parent class helper or a subclass of it +type_e_record_helper_must_extend_same_record=04102_E_Abgeleitete Recordhelfer mssen "$1" erweitern +% If a record helper inherits from another record helper it must extend the same +% record that the parent record helper extended. +type_e_procedures_return_no_value=04103_E_Ungltige Zuweisung, eine Prozedur gibt keinen Wert zurck +% This error occurs when one tries to assign the result of a procedure or destructor call. +% A procedure or destructor returns no value so this is not +% possible. +% +% \end{description} +# EndOfTeX + +# +# Symtable +# +# 05084 is the last used one +# +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedure and variable names. +% \begin{description} +sym_e_id_not_found=05000_E_Bezeichner "$1" nicht gefunden +% The compiler doesn't know this symbol. Usually happens when you misspell +% the name of a variable or procedure, or when you forget to declare a +% variable. +sym_f_internal_error_in_symtablestack=05001_F_Interner Fehler in SymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_Doppelter Bezeichner "$1" +% The identifier was already declared in the current scope. +sym_h_duplicate_id_where=05003_H_Bezeichner ist bereits definiert in $1 in Zeile $2 +% The identifier was already declared in a previous scope. +sym_e_unknown_id=05004_E_Unbekannter Bezeichner "$1" +% The identifier encountered hasn't been declared, or is used outside the +% scope where it's defined. +sym_e_forward_not_resolved=05005_E_Forward-Deklaration "$1" nicht gefunden +% This can happen in two cases: +% \begin{itemize} +% \item You declare a function in the \var{interface} part, or +% with a \var{forward} directive, but do not implement it. +% \item You reference a type which isn't declared in the current \var{type} +% block. +% \end{itemize} +sym_e_error_in_type_def=05007_E_Fehler in Typdefinition +% There is an error in your definition of a new array type. +% One of the range delimiters in an array declaration is erroneous. +% For example, \var{Array [1..1.25]} will trigger this error. +sym_e_forward_type_not_resolved=05009_E_Forward-Typ "$1" nicht gefunden +% The compiler encountered an unknown type. +sym_e_only_static_in_static=05010_E_Nur statische Variablen k”nnen in statischen oder „usseren Methoden verwendet werden +% A static method of an object can only access static variables. +sym_f_type_must_be_rec_or_class=05012_F_Record- oder Klassen-Typ erwartet +% The variable or expression isn't of the type \var{record} or \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_Instanzen von Klassen oder Objekten mit abstrakten Methoden sind unzul„ssig +% You are trying to generate an instance of a class which has an abstract +% method that wasn't overridden. +sym_w_label_not_defined=05014_W_Label "$1" nicht definiert +% A label was declared, but not defined. +sym_e_label_used_and_not_defined=05015_E_Label "$1" benutzt aber nicht definiert +% A label was declared and used, but not defined. +sym_e_ill_label_decl=05016_E_Ungltige Label-Deklaration +% This error should never happen; it occurs if a label is defined outside a +% procedure or function. +sym_e_goto_and_label_not_supported=05017_E_GOTO und LABEL werden nicht untersttzt (verwenden Sie den Schalter -Sg) +% You must use the -Sg switch to compile a program which has \var{label}s +% and \var{goto} statements. By default, \var{label} and \var{goto} aren't +% supported. +sym_e_label_not_found=05018_E_Label nicht gefunden +% A \var{goto label} was encountered, but the label wasn't declared. +sym_e_id_is_no_label_id=05019_E_Bezeichner ist kein Label +% The identifier specified after the \var{goto} isn't of type label. +sym_e_label_already_defined=05020_E_Label ist bereits definiert +% You are defining a label twice. You can define a label only once. +sym_e_ill_type_decl_set=05021_E_Ungltige Typdeklaration von Set-Elementen +% The declaration of a set contains an invalid type definition. +sym_e_class_forward_not_resolved=05022_E_Forward-Klassendefinition nicht gefunden: $1 +% You declared a class, but you didn't implement it. +sym_n_unit_not_used=05023_H_Unit "$1" wird von "$2" nicht verwendet +% The unit referenced in the \var{uses} clause is not used. +sym_h_para_identifier_not_used=05024_H_Parameter nicht verwendet: $1 +% This is a warning. The identifier was declared (locally or globally) but +% wasn't used (locally or globally). +sym_n_local_identifier_not_used=05025_N_Lokale Variable nicht verwendet: $1 +% You have declared, but not used, a variable in a procedure or function +% implementation. +sym_h_para_identifier_only_set=05026_H_Werte-Parameter "$1" wurde zugewiesen, aber nie verwendet +% The identifier was declared (locally or globally) and +% assigned to, but is not used (locally or globally) after the assignment. +sym_n_local_identifier_only_set=05027_N_Lokale Variable "$1" wurde zugewiesen, aber nicht verwendet +% The variable in a procedure or function implementation is declared and +% assigned to, but is not used after the assignment. +sym_h_local_symbol_not_used=05028_H_Lokales $1-Element "$2" wird nicht verwendet +% A local symbol is never used. +sym_n_private_identifier_not_used=05029_N_Privates Feld $1.$2 wird nie verwendet +% The indicated private field is defined, but is never used in the code. +sym_n_private_identifier_only_set=05030_N_Privates Feld $1.$2 wurde zugewiesen, aber nie verwendet +% The indicated private field is declared and assigned to, but never read. +sym_n_private_method_not_used=05031_N_Private Methode $1.$2 wird nie verwendet +% The indicated private method is declared but is never used in the code. +sym_e_set_expected=05032_E_Mengentyp erwartet +% The variable or expression isn't of type \var{set}. This happens in an +% \var{in} statement. +sym_w_function_result_not_set=05033_W_Funktionsergebnis scheint nicht gesetzt zu sein +% You can get this warning if the compiler thinks that a function return +% value is not set. This will not be displayed for assembler procedures, +% or procedures that contain assembler blocks. +sym_w_wrong_C_pack=05034_W_Typ "$1" ist im aktuellen Record mit C-Packing nicht korrekt ausgerichtet +% Arrays with sizes not multiples of 4 will be wrongly aligned +% for C structures. +sym_e_illegal_field=05035_E_Unbekannter Record-Feldbezeichner $1 +% The field doesn't exist in the record definition. +sym_w_uninitialized_local_variable=05036_W_Lokale Variable "$1" wird verwendet, bevor ihr ein Wert zugewiesen wurde +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assignment). +sym_w_uninitialized_variable=05037_W_Variable "$1" scheint nicht initialisiert worden zu sein +% These messages are displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% wasn't initialized first (i.e. appeared in the left-hand side of an +% assignassignmentment). +sym_e_id_no_member=05038_E_Bezeichener verweist nicht auf ein Element: $1 +% This error is generated when an identifier of a record, +% field or method is accessed while it is not defined. +sym_h_param_list=05039_H_Deklaration gefunden: $1 +% You get this when you use the \var{-vh} switch.In the case of an overloaded procedure +% not being found. Then all candidate overloaded procedures are +% listed, with their parameter lists. +sym_e_segment_too_large=05040_E_Datensegment zu gross (max. 2GB) +% You get this when you declare a data element whose size exceeds the +% prescribed limit (2 Gb on 80386+/68020+ processors). +sym_e_no_matching_implementation_found=05042_E_Keine passende Implementation der Interface Methode "$1" gefunden +% There was no matching method found which could implement the interface +% method. Check argument types and result type of the methods. +sym_w_deprecated_symbol=05043_W_Symbol "$1" ist veraltet +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Use of this symbol +% should be avoided as much as possible. +sym_w_non_portable_symbol=05044_W_Symbol "$1" ist nicht portierbar +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{platform} is used. This symbol's value, use +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_non_implemented_symbol=05055_W_Symbol "$1" ist nicht implementiert +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{unimplemented} is used. This symbol is defined, +% but is not yet implemented on this specific platform. +sym_e_cant_create_unique_type=05056_E_Von diesem Typ kann kein eindeutiger Typ deklariert werden +% Only simple types like ordinal, float and string types are supported when +% redefining a type with \var{type newtype = type oldtype;}. +sym_h_uninitialized_local_variable=05057_H_Die Variable "$1" scheint nicht initialisiert zu sein +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. it did not appear in the left-hand side of an +% assignment). +sym_h_uninitialized_variable=05058_H_Die Variable "$1" scheint nicht initialisiert zu sein +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. t did not appear in the left-hand side of an +% assignment). +sym_w_function_result_uninitialized=05059_W_Die Ergebnisvariable der Funktion scheint nicht initialisiert zu sein +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. it appears in the right-hand side of an expression) +% before it is initialized (i.e. before it appeared in the left-hand side of an +% assignment). +sym_h_function_result_uninitialized=05060_H_Die Ergebnisvariable der Funktion scheint nicht initialisiert zu sein +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. it appears in the right-hand side of an expression) +% before it is initialized (i.e. it appears in the left-hand side of an +% assignment) +sym_w_identifier_only_read=05061_W_Die Variable "$1" wird gelesen, obwohl ihr aber noch kein Wert zugewiesen wurde +% You have read the value of a variable, but nowhere assigned a value to +% it. +sym_h_abstract_method_list=05062_H_Abstrakte Method "$1" gefunden +% When getting a warning about constructing a class/object with abstract methods +% you get this hint to assist you in finding the affected method. +sym_w_experimental_symbol=05063_W_Symbol "$1" ist experimentell +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{experimental} is used. Experimental symbols +% might disappear or change semantics in future versions. Usage of this symbol +% should be avoided as much as possible. +sym_w_forward_not_resolved=05064_W_Forward Deklaration "$1" wird nicht aufgel”st und deshalb als extern angenommen +% This happens if you declare a function in the \var{interface} of a unit in macpas mode, +% but do not implement it. +sym_w_library_symbol=05065_W_Symbol "$1" geh”rt zu einer Bibliothek +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{library} is used. Library symbols may not be +% available in other libraries. +sym_w_deprecated_symbol_with_msg=05066_W_Symbol "$1" ist veraltet: "$2" +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Use of this symbol +% should be avoided as much as possible. +sym_e_no_enumerator=05067_E_Kann keinen Z„hler fr den Typ "$1" finden +% This means that compiler cannot find an apropriate enumerator to use in the for-in loop. +% To create an enumerator you need to defind an operator enumerator or add a public or published +% GetEnumerator method to the class or object definition. +sym_e_no_enumerator_move=05068_E_Kann keine Methode "MoveNext" in der Aufz„hlung "$1" finden +% This means that compiler cannot find a public MoveNext method with the Boolean return type in +% the enumerator class or object definition. +sym_e_no_enumerator_current=05069_E_Kann keine Eigenschaft "Current" in der Aufz„hlung "$1" finden +% This means that compiler cannot find a public Current property in the enumerator class or object +% definition. +sym_e_objc_para_mismatch=05070_E_Die Anzahl der deklarierten Parameter und die Anzahl der Doppelpunkte in der Nachrichtenzeichenkette stimmen nicht berein +% In Objective-C, a message name automatically contains as many colons as parameters. +% In order to prevent mistakes when specifying the message name in FPC, the compiler +% checks whether this is also the case here. Note that in case of messages taking a +% variable number of arguments translated to FPC via an \var{array of const} parameter, +% this final \var{array of const} parameter is not counted. Neither are the hidden +% \var{self} and \var{\_cmd} parameters. +sym_n_private_type_not_used=05071_N_Privater Typ "$1.$2" wird nie benutzt +% The indicated private type is declared but is never used in the code. +sym_n_private_const_not_used=05072_N_Private Konstante "$1.$2" wird nie benutzt +% The indicated private const is declared but is never used in the code. +sym_n_private_property_not_used=05073_N_Private Eigenschaft "$1.$2" wird nie benutzt +% The indicated private property is declared but is never used in the code. +sym_w_deprecated_unit=05074_W_Unit "$1" ist veraltet +% This means that a unit which is +% declared as \var{deprecated} is used. Deprecated units may no longer +% be available in newer versions of the library. Use of this unit +% should be avoided as much as possible. +sym_w_deprecated_unit_with_msg=05075_W_Unit "$1" ist veraltet: "$2" +% This means that a unit which is +% declared as \var{deprecated} is used. Deprecated units may no longer +% be available in newer versions of the library. Use of this unit +% should be avoided as much as possible. +sym_w_non_portable_unit=05076_W_Unit "$1" ist plattformabh„ngig +% This means that a unit which is +% declared as \var{platform} is used. This unit use +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_library_unit=05077_W_Unit "$1" geh”rt zu einer Bibliothek +% This means that a unit which is +% declared as \var{library} is used. Library units may not be +% available in other libraries. +sym_w_non_implemented_unit=05078_W_Unit "$1" ist nicht implementiert +% This means that a unit which is +% declared as \var{unimplemented} is used. This unit is defined, +% but is not yet implemented on this specific platform. +sym_w_experimental_unit=05079_W_Unit "$1" ist experimentell +% This means that a unit which is +% declared as \var{experimental} is used. Experimental units +% might disappear or change semantics in future versions. Usage of this unit +% should be avoided as much as possible. +sym_e_objc_formal_class_not_resolved=05080_E_Die vollst„ndige Definition der formal deklarierten ObjC-Klasse "$1" fehlt in diesem Geltungsbereich +% Objecive-C classes can be imported formally, without using the the unit in which it is fully declared. +% This enables making forward references to such classes and breaking circular dependencies amongst units. +% However, as soon as you wish to actually do something with an entity of this class type (such as +% access one of its fields, send a message to it, or use it to inherit from), the compiler requires the full definition +% of the class to be in scope. +sym_e_interprocgoto_into_init_final_code_not_allowed=05081_E_Gotos in die 'initialization'- oder 'finalization'-Bl”cke einer Unit sind nicht erlaubt +% Gotos into initialization or finalization blockse of units are not allowed. +sym_e_external_class_name_mismatch1=05082_E_Ungltiger externer Name "$1" fr die formale Klasse "$2" +sym_e_external_class_name_mismatch2=05083_E_Hierhin muss die vollst„ndige Klassendefinition mit externem Namen "$1" +% When a class is declared using a formal external definition, the actual external +% definition (if any) must specify the same external name as the formal definition +% (since both definitions refer to the same actual class type). +sym_w_library_overload=05084_W_M”glicher Bibliothekenkonflikt: Das Symbol "$1" aus Bibliothek "$2" wurde auch in Bibliothek "$3" gefunden +% Some OS do not have library specific namespaces, for those +% OS, the function declared as "external 'libname' name 'funcname'", +% the 'libname' part is only a hint, funcname might also be loaded +% by another library. This warning appears if 'funcname' is used twice +% with two different library names. +% +% \end{description} +# EndOfTeX + +# +# Codegenerator +# +# 06052 is the last used one +# +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +cg_e_parasize_too_big=06009_E_Gr”sse der Parameterliste bersteigt 65535 Bytes +% The I386 processor limits the parameter list to 65535 bytes. (The \var{RET} +% instruction causes this). +cg_e_file_must_call_by_reference=06012_E_Dateitypen mssen VAR Parameter sein +% You cannot specify files as value parameters, i.e., they must always be +% declared \var{var} parameters. +cg_e_cant_use_far_pointer_there=06013_E_Die Verwendung eines FAR-Zeigers ist in dieser Art nicht erlaubt +% Free Pascal doesn't support far pointers, so you cannot take the address of +% an expression which has a far reference as a result. The \var{mem} construct +% has a far reference as a result, so the following code will produce this +% error: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_Mit EXPORT deklarierte Funktionen k”nnen nicht aufgerufen werden +% No longer in use. +cg_w_member_cd_call_from_method=06016_W_M”glicherweise unzul„ssiger Aufruf eines Konstruktors oder Destruktors (passt nicht in diesen Kontext) +% The compiler detected that a constructor or destructor is called within a +% a method. This will probably lead to problems, since constructors / destructors +% require parameters on entry. +cg_n_inefficient_code=06017_N_Uneffiziente Programmierung +% You construction seems dubious to the compiler. +cg_w_unreachable_code=06018_W_Code wird niemals ausgefhrt +% You specified a loop which will never be executed. Example: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_Abstrakte Methoden k”nnen nicht direkt aufgerufen werden +% You cannot call an abstract method directly. Instead, you must call an +% overriding child method, because an abstract method isn't implemented. +cg_d_register_weight=06027_DL_Register $1 Gewichtung $2 $3 +% Debugging message. Shown when the compiler considers a variable for +% keeping in the registers. +cg_d_stackframe_omited=06029_DL_Stackframe wird ausgelassen +% Some procedure/functions do not need a complete stack-frame, so it is omitted. +% This message will be displayed when the {-vd} switch is used. +cg_e_unable_inline_object_methods=06031_E_Objektmethoden k”nnen nicht Inline sein +% You cannot have inlined object methods. +cg_e_unable_inline_procvar=06032_E_Procvar-Aufrufe k”nnen nicht Inline sein +% A procedure with a procedural variable call cannot be inlined. +cg_e_no_code_for_inline_stored=06033_E_Kein Code fr Inline-Prozedur gespeichert +% The compiler couldn't store code for the inline procedure. +cg_e_can_access_element_zero=06035_E_Auf Element Null von Ansi/Wide- oder Longstring kann nicht zugegriffen werden, benutzen Sie stattdessen (Set)Length +% You should use \var{setlength} to set the length of an ansi/wide/longstring +% and \var{length} to get the length of such string type. +cg_e_cannot_call_cons_dest_inside_with=06037_E_Konstruktoren und Destruktoren k”nnen in diesem Kontext nicht aufgerufen werden +% Inside a \var{With} clause you cannot call a constructor or destructor for the +% object you have in the \var{with} clause. +cg_e_cannot_call_message_direct=06038_E_Kann Messagehandler-Methode nicht direkt aufrufen +% A message method handler method can't be called directly if it contains an +% explicit \var{Self} argument. +cg_e_goto_inout_of_exception_block=06039_E_Sprung in- oder aus dem Exceptionblock heraus +% It is not allowed to jump in or outside of an exception block like \var{try..finally..end;}. +% For example, the following code will produce this error: + +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // this line will cause an error +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_Kontrollfluss-Anweisungen sind in einem Finally-Block nicht erlaubt +% It isn't allowed to use the control flow statements \var{break}, +% \var{continue} and \var{exit} +% inside a finally statement. The following example shows the problem: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // This exit ISN'T allowed +% end; +% ... +% +% \end{verbatim} +% If the procedure \var{p} raises an exception the finally block is +% executed. If the execution reaches the exit, it's unclear what to do: +% exit the procedure or search for another exception handler. +cg_w_parasize_too_big=06041_W_Gr”sse der Parameter berschreitet die Grenze fr bestimmte CPUs +% This indicates that you are declaring more than 64K of parameters, which +% might not be supported on other processor targets. +cg_w_localsize_too_big=06042_W_Gr”sse der lokalen Variablen berschreitet die Grenze fr bestimmte CPUs +% This indicates that you are declaring more than 32K of local variables, which +% might not be supported on other processor targets. +cg_e_localsize_too_big=06043_E_Gr”sse der lokalen Variablen berschreitet die untersttzte Grenze +% This indicates that you are declaring more than 32K of local variables, which +% is not supported by this processor. +cg_e_break_not_allowed=06044_E_BREAK nicht zul„ssig +% You're trying to use \var{break} outside a loop construction. +cg_e_continue_not_allowed=06045_E_CONTINUE nicht zul„ssig +% You're trying to use \var{continue} outside a loop construction. +cg_f_unknown_compilerproc=06046_F_Unbekannte Compiler-Prozedur "$1". šberprfe, ob die korrekte Laufzeit-Bibliothek verwendet wird +% The compiler expects that the runtime library contains certain subroutines. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the compiler in use. If you changed the runtime library this error means +% that you removed a subroutine which the compiler needs for internal use. +cg_f_unknown_system_type=06047_F_Systemtyp "$1" konnte nicht gefunden werden. šberprfe, ob die korrekte Laufzeit-Bibliothek verwendet wird +% The compiler expects that the runtime library contains certain type definitions. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the compiler in use. If you changed the runtime library this error means +% that you removed a type which the compiler needs for internal use. +cg_h_inherited_ignored=06048_H_Geerbter Aufruf einer abstrakten Methode ignoriert +% This message appears only in Delphi mode when you call an abstract method +% of a parent class via \var{inherited;}. The call is then ignored. +cg_e_goto_label_not_found=06049_E_Goto Label "$1": Das Label ist nicht definiert oder wurde bei der Optimierung entfernt +% The label used in the goto definition is not defined or optimized away by the +% unreachable code elemination. +cg_f_unknown_type_in_unit=06050_F_Kann den Typ "$1" nicht in der Unit "$2" finden. šberprfe, ob die korrekte Laufzeit-Bibliothek verwendet wird +% The compiler expects that the runtime library contains certain type definitions. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the compiler in use. If you changed the runtime library this error means +% that you removed a type which the compiler needs for internal use. +cg_e_interprocedural_goto_only_to_outer_scope_allowed=06051_E_Interprozedurale gotos sind nur in „uáere Subroutines erlaubt +% Gotos between subroutines are only allowed if the goto jumps from an inner to an outer subroutine or +% from a subroutine to the main program +cg_e_labels_cannot_defined_outside_declaration_scope=06052_E_ Label mssen im selben Bereich definiert werden, in dem sie deklariert werden +% In ISO mode, labels must be defined in the same scope as they are declared. +cg_e_goto_across_procedures_with_exceptions_not_allowed=06053_E_Eine Prozedur, die explizite oder implizite Excpetion Frames enth„lt, darf nicht mit einem goto verlassen werden +% Non-local gotos might not be used to leave procedures using exceptions either implicitly or explicitly. Procedures +% which use automated types like ansistrings or class constructurs are affected by this too. +% +% \end{description} +# EndOfTeX + +# +# Assembler reader +# +# 07110 is the last used one +# +asmr_d_start_reading=07000_DL_Starte $1 Stil Assembler Parsen +% This informs you that an assembler block is being parsed +asmr_d_finish_reading=07001_DL_Beende $1 Stil Assembler Parsen +% This informs you that an assembler block has finished. +asmr_e_none_label_contain_at=07002_E_Nicht-Label Bezeichner enth„lt @ +% A identifier which isn't a label can't contain a @. +asmr_e_building_record_offset=07004_E_Fehler beim Ermitteln des Recordoffsets +% There has an error occured while building the offset of a record/object +% structure, this can happend when there is no field specified at all or +% an unknown field identifier is used. +asmr_e_offset_without_identifier=07005_E_OFFSET ohne Bezeicner verwendet +% You can only use OFFSET with an identifier. Other syntaxes aren't +% supported +asmr_e_type_without_identifier=07006_E_TYPE verwendet ohne Bezeichner +% You can only use TYPE with an identifier. Other syntaxes aren't +% supported +asmr_e_no_local_or_para_allowed=07007_E_Lokale Variable oder Parameter k”nnen hier nicht verwendet werden +% You can't use a local variable or parameter here, mostly because the +% addressing of locals and parameters is done using the %ebp register so the +% address can't be get directly. +asmr_e_need_offset=07008_E_Hier muss OFFSET verwendet werden +% You need to use OFFSET <id> here to get the address of the identifier. +asmr_e_need_dollar=07009_E_Hier muss "$" verwendet werden +% You need to use $<id> here to get the address of the identifier. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_Verwendung von mehreren verschiebbaren Symbolen nicht m”glich +% You can't have more than one relocatable symbol (variable/typed constant) +% in one argument. +asmr_e_only_add_relocatable_symbol=07011_E_Verschiebbares Symbol kann nur addiert werden +% Relocatable symbols (variable/typed constant) can't be used with other +% operators. Only addition is allowed. +asmr_e_invalid_constant_expression=07012_E_Ungltiger Konstantenausdruck +% There is an error in the constant expression. +asmr_e_relocatable_symbol_not_allowed=07013_E_Verschiebbares Symbol ist nicht zul„ssig +% You can't use a relocatable symbol (variable/typed constant) here. +asmr_e_invalid_reference_syntax=07014_E_Ungltige Verweis-Syntax +% There is an error in the reference. +asmr_e_local_para_unreachable=07015_E_Sie k”nnen "$1" von diesem Code aus nicht erreichen +% You cannot read directly the value of a local variable or parameter +% of a higher level procedure in assembler code (except for +% local assembler code without parameter nor locals). +asmr_e_local_label_not_allowed_as_ref=07016_E_Lokale Symbole/Labels sind nicht als Referenz zul„ssig +% You can't use local symbols/labels as references +asmr_e_wrong_base_index=07017_E_Ungltige Verwendung von Basis- und Index-Registern +% There is an error with the base and index register, they are +% probably incorrect +asmr_w_possible_object_field_bug=07018_W_M”glicher Fehler bei Objektfeld-Behandlung +% Fields of objects or classes can be reached directly in normal or objfpc +% modes but TP and Delphi modes treat the field name as a simple offset. +asmr_e_wrong_scale_factor=07019_E_Falscher Skalierungsfaktor angegeben +% The scale factor given is wrong, only 1,2,4 and 8 are allowed +asmr_e_multiple_index=07020_E_Mehrfache Verwendung fon Index-Registern +% You are trying to use more than one index register +asmr_e_invalid_operand_type=07021_E_Ungltiger Operandentyp +% The operand type doesn't match with the opcode used +asmr_e_invalid_string_as_opcode_operand=07022_E_Unglitge Zeichenkette als Opcode-Operand: $1 +% The string specified as operand is not correct with this opcode +asmr_w_CODE_and_DATA_not_supported=07023_W_@CODE und @DATA werden nicht untersttzt +% @CODE and @DATA are unsupported and are ignored. +asmr_e_null_label_ref_not_allowed=07024_E_Null-Label-Bezug nicht m”glich +asmr_e_expr_zero_divide=07025_E_Division durch Null in Assembler-Ausdruck +% There is a division by zero in a constant expression +asmr_e_expr_illegal=07026_E_Ungltiger Ausdruck +% There is an illegal expression in a constant expression +asmr_e_escape_seq_ignored=07027_E_Escape-Sequenz ignoriert: $1 +% There is a C-styled string, but the escape sequence in the string +% is unknown, and is therefore ignored +asmr_e_invalid_symbol_ref=07028_E_Ungltige Symbolverwendung +asmr_w_fwait_emu_prob=07029_W_FWAIT kann Emulationsprobleme mit emu387 verursachen +asmr_w_fadd_to_faddp=07030_W_$1 ohne Operand wurde in $1P bersetzt +asmr_w_enter_not_supported_by_linux=07031_W_Der ENTER-Befehl wird vom Linux-Kernel nicht untersttzt +% ENTER instruction can generate a stack page fault that is not +% caught correctly by the i386 Linux page handler. +asmr_w_calling_overload_func=07032_W_Aufruf einer berladenen Funktion in Assembler +% There is a call to an overloaded method in the assembler block, +% this might be the sign there is a problem +asmr_e_unsupported_symbol_type=07033_E_Nicht untersttzter Symboltyp fr Operand +asmr_e_constant_out_of_bounds=07034_E_Wert der Konstante ausserhalb des zul„ssigen Bereichs +asmr_e_error_converting_decimal=07035_E_Fehler beim Umwandeln in Dezimal $1 +% A constant decimal value does not have the correct syntax +asmr_e_error_converting_octal=07036_E_Fehler beim Umwandeln in Oktal $1 +% A constant octal value does not have the correct syntax +asmr_e_error_converting_binary=07037_E_Fehler beim Umwandeln in Bin„r $1 +% A constant binary value does not have the correct syntax +asmr_e_error_converting_hexadecimal=07038_E_Fehler beim Umwandeln in Hexadezimal $1 +% A constant hexadecimal value does not have the correct syntax +asmr_h_direct_global_to_mangled=07039_H_$1 bersetzt nach $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 ist einer berladenen Funktion zugeordnet +asmr_e_cannot_use_SELF_outside_a_method=07041_E_Kann SELF nicht ausserhalb einer Methode verwenden +% There is a reference to the \var{self} symbol while it is not +% allowed. \var{self} can only be referenced inside methods +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_Kann OLDEBP ausserhalb einer verschachtelten Prozedur nicht verwenden +% There is a reference to the \var{oldebp} symbol while it is not +% allowed. \var{oldebp} can only be referenced inside nested routines +asmr_e_void_function=07043_W_Prozeduren k”nnen keinen Wert im Assembler-Code zurckliefern +% Trying to return a value while in a procedure. A procedure +% does not have any return value +asmr_e_SEG_not_supported=07044_E_SEG nicht untersttzt +asmr_e_size_suffix_and_dest_dont_match=07045_E_Gr”ssensuffix und Ziel- oder Quellgr”sse passen nicht zusammen +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_w_size_suffix_and_dest_dont_match=07046_W_Gr”ssensuffix und Ziel- oder Quellgr”sse passen nicht zusammen +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_e_syntax_error=07047_E_Assembler Syntaxfehler +% There is an assembler syntax error +asmr_e_invalid_opcode_and_operand=07048_E_Ungltige Kombination von Opcode und Operanden +% The opcode cannot be used with this type of operand +asmr_e_syn_operand=07049_E_Assembler Syntaxfehler im Operanden +asmr_e_syn_constant=07050_E_Assembler Syntaxfehler in Konstanten +asmr_e_invalid_string_expression=07051_E_Ungltiger Stringausdruck +asmr_w_const32bit_for_address=07052_W_Konstante mit Symbol $1 fr Adresse erzeugt, die kein Pointer ist +% A constant expression represents an address which does not fit +% into a pointer. The address is probably incorrect +asmr_e_unknown_opcode=07053_E_Unbekannter Opcode $1 +% This opcode is not known +asmr_e_invalid_or_missing_opcode=07054_E_Ungltiger oder fehlender Opcode +asmr_e_invalid_prefix_and_opcode=07055_E_Ungltige Kombination von Prefix und Opcode: $1 +asmr_e_invalid_override_and_opcode=07056_E_Ungltige Kombination von Override und Opcode: $1 +asmr_e_too_many_operands=07057_E_Zu viele Operanden in der Zeile +% There are too many operands for this opcode. Check your +% assembler syntax +asmr_w_near_ignored=07058_W_NEAR ignoriert +asmr_w_far_ignored=07059_W_FAR ignoriert +asmr_e_dup_local_sym=07060_E_Doppelters lokales Symbol $1 +asmr_e_unknown_local_sym=07061_E_Undefiniertes lokales Symbol $1 +asmr_e_unknown_label_identifier=07062_E_Unbekannter Label-Bezeichner $1 +asmr_e_invalid_register=07063_E_Ungltiger Registername +% There is an unknown register name used as operand. +asmr_e_invalid_fpu_register=07064_E_Ungltiger Name fr Fliesskommaregister +% There is an unknown register name used as operand. +asmr_w_modulo_not_supported=07066_W_Modulo nicht untersttzt +asmr_e_invalid_float_const=07067_E_Ungltige Fliesskommakonstante $1 +% The floating point constant declared in an assembler block is +% invalid. +asmr_e_invalid_float_expr=07068_E_Ungltiger Fliesskommaausdruck +% The floating point expression declared in an assembler block is +% invalid. +asmr_e_wrong_sym_type=07069_E_Falscher Symboltyp +asmr_e_cannot_index_relative_var=07070_E_Kann lokale Variable oder Parameter nicht mit Register indizieren +% Trying to index using a base register a symbol which is already relative +% to a register. This is not possible, and will probably lead to crashes. +asmr_e_invalid_seg_override=07071_E_Ungltiger Segmentoverride-Ausdruck +asmr_w_id_supposed_external=07072_W_Bezeichner $1 ist vermutlich External +% There is a reference to an undefined symbol. This will not result +% in an error, since the symbol might be external, but may cause +% problems at link time if the symbol is not defined anywhere. +asmr_e_string_not_allowed_as_const=07073_E_Strings sind als Konstanten unzul„ssig +% Character strings are not allowed as constants. +asmr_e_no_var_type_specified=07074_E_Typ der Variablen nicht angegeben +% The syntax expects a type idenfitifer after the dot, but +% none was found. +asmr_w_assembler_code_not_returned_to_text=07075_E_Assemblercode kehrt nicht zum Text zurck +% There was a directive in the assembler block to change sections, +% but there is a missing return to the text section at the end +% of the assembler block. This might cause errors during link time. +asmr_e_not_directive_or_local_symbol=07076_E_Keine Direktive oder lokales Symbol $1 +% This symbol is unknown. +asmr_w_using_defined_as_local=07077_E_Verwendung eines definierten Namens als lokales Label +asmr_e_dollar_without_identifier=07078_E_Dollarzeichen wird ohne Bezeichner verwendet +% A constant expression has an identifier which does not start with +% the $ symbol. +asmr_w_32bit_const_for_address=07079_W_32-Bit-Konstante fr Adresse erzeugt +% A constant was used as an address. This is probably an error, +% since using absolute addresses will probably not work. +asmr_n_align_is_target_specific=07080_N_.align ist abh„ngig von Zielplattform, verwende .balign oder .p2align +% Using the .align directive is platform specific, and its meaning will vary +% from one platform to another. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_Kann fr Parameter nicht direkt auf Felder zugreifen +% You should load the parameter first into a register and then access the +% fields using that register. +asmr_e_cannot_access_object_field_directly=07082_E_Kann auf Felder von Objekten/Klassen nicht direkt zugreifen +% You should load the self pointer first into a register and then access the +% fields using the register as base. By default the self pointer is available +% in the esi register on i386. +asmr_e_unable_to_determine_reference_size=07083_E_Gr”sse nicht spezifiziert und auch keine M”glichkeit die Gr”sse der Operanden zu bestimmen +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. +asmr_e_cannot_use_RESULT_here=07084_E_RESULT kann in dieser Funktion nicht verwendet werden +% Some functions which return complex types cannot use the \var{result} +% keyword. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" ohne Operand bersetzt in "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" bersetzt in "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" bersetzt in "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_Das Zeichen < ist hier nicht erlaubt +% The shift operator requires the << characters. Only one +% of those characters was found. +asmr_e_invalid_char_greater=07090_E_Das Zeichen > ist hier nicht erlaubt +% The shift operator requires the >> characters. Only one +% of those characters was found. +asmr_w_align_not_supported=07093_W_ALIGN wird nicht untersttzt +asmr_e_no_inc_and_dec_together=07094_E_Inc und Dec k”nnen nicht gemeinsam vorkommen +% Trying to use an increment and a decrement within the same +% opcode on the 680x0. This is impossible. +asmr_e_invalid_reg_list_in_movem=07095_E_Ungltige Registerliste fr movem +% Trying to use the \var{movem} opcode with invalid registers +% to save or restore. +asmr_e_invalid_reg_list_for_opcode=07096_E_Ungltige Registerliste fr diesen opcode +asmr_e_higher_cpu_mode_required=07097_E_H”herer cpu Modus notwendig ($1) +% Trying to use an instruction which is not supported in the current +% cpu mode. Use a higher cpu generation to be able to use this +% opcode in your assembler block +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_Gr”sse nicht spezifiziert und auch keine M”glichkeit die Gr”sse der Operanden zu bestimmen. Es wird DWORD als Voreinstellung verwendet +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use DWORD as default. +asmr_e_illegal_shifterop_syntax=07099_E_Syntax Fehler beim Analysieren eines shifter Operanden +% ARM only; ARM assembler supports a so called shifter operand. The used syntax isn't +% a valid shifter operand. Example for an operation with shifter operand: +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +asmr_e_packed_element=07100_E_Die Adresse der packed Komponente ist nicht an einer Byte Grenze +% Packed components (record fields and array elements) may start at an arbitrary +% bit inside a byte. On CPU which do not support bit-addressable memory (which +% includes all currently supported CPUs by FPC) you will therefore get an error +% message when trying to index arrays with elements whose size is not a multiple +% of 8 bits. The same goes for accessing record fields with such an address. +% multiple of 8 bits. +asmr_w_unable_to_determine_reference_size_using_byte=07101_W_Gr”sse nicht angegeben und kann auch nicht aus der Gr”sse der Operanden bestimmt werden. Verwende BYTE als Voreinstellung +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use BYTE as default. +asmr_w_no_direct_ebp_for_parameter=07102_W_Die Verwendung von +offset(%ebp) fr Parameter ist hier ungltig +% Using direct 8(%ebp) reference for function/procedure parameters is invalid +% if parameters are in registers. +asmr_w_direct_ebp_for_parameter_regcall=07103_W_Die Verwendung von +offset(%ebp) ist nicht mit der regcall Konvention kompatibel +% Using direct 8(%ebp) reference for function/procedure parameters is invalid +% if parameters are in registers. +asmr_w_direct_ebp_neg_offset=07104_W_Die Verwendung von -offset(%ebp) wird fr den Zugriff auf lokale Variablen nicht empfohlen +% Using -8(%ebp) to access a local variable is not recommended +asmr_w_direct_esp_neg_offset=07105_W_Verwendung von -offset(%esp); Zugriff kann einen Crash oder Datenverlust ausl”sen +% Using -8(%esp) to access a local stack is not recommended, as +% this stack portion can be overwritten by any function calls or interrupts. +asmr_e_no_vmtoffset_possible=07106_E_VMTOffset muss in Kombination mit einer virtuellen Methode verwendet werden; "$1" ist aber nicht virtuell +% Only virtual methods have VMT offsets +asmr_e_need_pic_ref=07107_E_Erzeuge eigentlich PIC, aber die Referenz ist nicht PIC-sicher +% The compiler has been configured to generate position-independent code +% (PIC), but there are position-dependent references in the current +% handwritten assembler instruction. +asmr_e_mixing_regtypes=07108_E_Alle Register in einem Registerset mssen in T und Breite bereinstimmen +% Instructions on the ARM architecture that take a register set as argument require that all registers +% in this set are of the same kind (e.g., integer, vfp) and width (e.g., single precision, double precision). +asmr_e_empty_regset=07109_E_Ein Registerset kann nicht leer sein +% Instructions on the ARM architecture that take a register set as argument require that such a set +% contains at least one register. +asmr_w_useless_got_for_local=07110_W_@GOTPCREL ist nutzlos und bei lokalen Symbole m”glicherweise gef„hrlich +% The use of @GOTPCREL supposes an extra indirection that is +% not present if the symbol is local, which might lead to wrong asembler code + +# +# Assembler/binary writers +# +# 08022 is the last used one +# +asmw_f_too_many_asm_files=08000_F_Zu viele Assembler-Dateien +% With smartlinking enabled, there are too many assembler +% files generated. Disable smartlinking. +asmw_f_assembler_output_not_supported=08001_F_Gew„hlte Assemblerausgabe wird nicht untersttzt +asmw_f_comp_not_supported=08002_F_Comp nicht untersttzt +asmw_f_direct_not_supported=08003_F_Direct nicht untersttzt fr bin„res Schreiben +% Direct assembler mode is not supported for binary writers. +asmw_e_alloc_data_only_in_bss=08004_E_Allozieren von Daten ist nur in "bss"-Abschnitten zul„ssig +asmw_f_no_binary_writer_selected=08005_F_Kein Bin„rschreiber ausgew„hlt +asmw_e_opcode_not_in_table=08006_E_Asm: Opcode $1 nicht in Tabelle enthalten +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 ungltige Kombination von Opcode und Operanden +asmw_e_16bit_not_supported=08008_E_Asm: 16-Bit-Verweise werden nicht untersttzt +asmw_e_invalid_effective_address=08009_E_Asm: Ungltige effektive Adresse +asmw_e_immediate_or_reference_expected=08010_E_Asm: Konstanter Ausdruck oder Referenz erwartet +asmw_e_value_exceeds_bounds=08011_E_Asm: $1 Wert berschreitet Grenzen $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: "Short jump" ist ausserhalb des Bereichs $1 +asmw_e_undefined_label=08013_E_Asm: Undefiniertes Label: $1 +asmw_e_comp_not_supported=08014_E_Asm: Comp wird fr dieses Ziel nicht untersttzt +asmw_e_extended_not_supported=08015_E_Asm: Extended Typ wird fr dieses Ziel nicht untersttzt +asmw_e_duplicate_label=08016_E_Asm: Doppeltes Label $1 +asmw_e_redefined_label=08017_E_Asm: Neu definiertes Label $1 +asmw_e_first_defined_label=08018_E_Asm: First beginnt hier +asmw_e_invalid_register=08019_E_Asm: Ungltiges Register $1 +asmw_e_16bit_32bit_not_supported=08020_E_Asm: 16 oder 32 Bit Referenzen werden nicht untersttzt +asmw_e_64bit_not_supported=08021_E_Asm: 64 Bit Operanden werden nicht untersttzt +asmw_e_bad_reg_with_rex=08022_E_Asm: AH,BH,CH oder DH k”nnen nicht in einer Instruktion verwendt werden, die den Prefix REX ben”tigt +% x86_64 only: instruction encoding of this platform does not allow using +% 8086 high byte registers (AH,BH,CH or DH) together with REX prefix in a single instruction. +% The REX prefix is required whenever the instruction operand size is 64 bits, or +% when it uses one of extended x86_64 registers (R8-R15 or XMM8-XMM15). + +# +# Executing linker/assembler +# +# 09032 is the last used one +# +# BeginOfTeX +% +% \section{Errors of assembling/linking stage} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +exec_w_source_os_redefined=09000_W_Quellbetriebssystem wurde neu definiert +% The source operating system is redefined. +exec_i_assembling_pipe=09001_I_Assembliere (pipe) $1 +% Assembling using a pipe to an external assembler. +exec_d_cant_create_asmfile=09002_E_Kann Assemblerdatei nicht erzeugen: $1 +% The mentioned file can't be created. Check if you have +% access permissions to create this file. +exec_e_cant_create_objectfile=09003_E_Kann Objektdatei nicht erzeugen: $1 +% The mentioned file can't be created. Check if you have +% got access permissions to create this file. +exec_e_cant_create_archivefile=09004_E_Kann Archivdatei nicht erzeugen: $1 +% The mentioned file can't be created. Check if you have +% access permissions to create this file. +exec_e_assembler_not_found=09005_E_Assembler $1 nicht gefunden, schalte um zu externem Assemblieren +% The assembler program was not found. The compiler will produce a script that +% can be used to assemble and link the program. +exec_t_using_assembler=09006_T_Benutze Assembler: $1 +% An informational message saying which assembler is being used. +exec_e_error_while_assembling=09007_E_Fehler beim Assemblieren des Exitcodes $1 +% There was an error while assembling the file using an external assembler. +% Consult the documentation of the assembler tool to find out more information +% on this error. +exec_e_cant_call_assembler=09008_E_Assembler kann nicht aufgerufen werden, Fehler $1 schalte um zu externem Assemblieren +% An error occurred when calling an external assembler. The compiler will produce a script that +% can be used to assemble and link the program. +exec_i_assembling=09009_I_Assembliere $1 +% An informational message stating which file is being assembled. +exec_i_assembling_smart=09010_I_Assembliere mit Smartlinking $1 +% An informational message stating which file is being assembled using smartlinking. +exec_w_objfile_not_found=09011_W_Objekt $1 nicht gefunden, Linken kann fehlschlagen! +% One of the object files is missing, and linking will probably fail. +% Check your paths. +exec_w_libfile_not_found=09012_W_Bibliothek $1 nicht gefunden, Linken kann fehlschlagen! +% One of the library file is missing, and linking will probably fail. +% Check your paths. +exec_e_error_while_linking=09013_E_Fehler beim Linken +% Generic error while linking. +exec_e_cant_call_linker=09014_E_Linker kann nicht aufgerufen werden, schalte um zu externem Linken +% An error occurred when calling an external linker. The compiler will produce a script that +% can be used to assemble and link the program. +exec_i_linking=09015_I_Linke $1 +% An informational message, showing which program or library is being linked. +exec_e_util_not_found=09016_E_Hilfsprogramm $1 nicht gefunden, schalte um zu externem Linken +% An external tool was not found. The compiler will produce a script that +% can be used to assemble and link or postprocess the program. +exec_t_using_util=09017_T_Benutze Hilfsprogramm $1 +% An informational message, showing which external program (usually a postprocessor) is being used. +exec_e_exe_not_supported=09018_E_Erzeugen von ausfhrbaren Dateien nicht untersttzt +% Creating executable programs is not supported for this platform, because it was +% not yet implemented in the compiler. +exec_e_dll_not_supported=09019_E_Dynamische Bibliotheken nicht untersttzt +% Creating dynamically loadable libraries is not supported for this platform, because it was +% not yet implemented in the compiler. +exec_i_closing_script=09020_I_Schliesse Skript $1 +% Informational message showing when writing of the external assembling and linking script is finished. +exec_e_res_not_found=09021_E_Resource-Compiler "$1" nicht gefunden, schalte um auf externen Modus +% An external resource compiler was not found. The compiler will produce a script that +% can be used to assemble, compile resources and link or postprocess the program. +exec_i_compilingresource=09022_I_šbersetze Resource $1 +% An informational message, showing which resource is being compiled. +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_Unit $1 kann nicht statisch gelinkt werden, schalte um zu smart Linken +% Static linking was requested, but a unit which is not statically linkable was used. +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_Unit $1 kann nicht smart gelinkt werden, schalte um zu statischem Linken +% Smart linking was requested, but a unit which is not smart-linkable was used. +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_Unit $1 kann nicht shared gelinkt werden, schalte um zu statischem Linken +% Shared linking was requested, but a unit which is not shared-linkable was used. +exec_e_unit_not_smart_or_static_linkable=09026_E_Unit $1 kann weder smart noch statisch gelinkt werden +% Smart or static linking was requested, but a unit which cannot be used for either was used. +exec_e_unit_not_shared_or_static_linkable=09027_E_Unit $1 kann weder shared noch statisch gelinkt werden +% Shared or static linking was requested, but a unit which cannot be used for either was used. +exec_d_resbin_params=09028_D_Resource Compiler "$1" wird mit "$2" als Kommandozeile aufgerufen +% An informational message showing which command line is used for the resource compiler. +exec_e_error_while_compiling_resources=09029_E_Fehler beim šbersetzen von Resourcen +% The resource compiler or converter returned an error. +exec_e_cant_call_resource_compiler=09030_E_Der Resource-Compiler "$1" kann nicht aufgerufen werden, schalte um auf externen Modus +% An error occurred when calling a resource compiler. The compiler will produce +% a script that can be used to assemble, compile resources and link or +% postprocess the program. +exec_e_cant_open_resource_file=09031_E_Kann die Resourcedatei "$1" nicht ”ffnen +% An error occurred resource file cannot be opened. +exec_e_cant_write_resource_file=09032_E_Kann die Resourcedatei "$1" nicht schreiben +% An error occurred resource file cannot be written. +% +% \end{description} +# EndOfTeX + +# +# Executable information +# +# 09134 is the last used one +# +# BeginOfTeX +% \section{Executable information messages.} +% This section lists all messages that the compiler emits when an executable program is produced, +% and only when the internal linker is used. +% \begin{description} +execinfo_f_cant_process_executable=09128_F_Kann ausfhrbare Datei nicht nachbearbeiten: $1 +% Fatal error when the compiler is unable to post-process an executable. +execinfo_f_cant_open_executable=09129_F_Kann ausfhrbare Datei nicht ”ffnen: $1 +% Fatal error when the compiler cannot open the file for the executable. +execinfo_x_codesize=09130_X_Gr”sse des Codes: $1 Bytes +% Informational message showing the size of the produced code section. +execinfo_x_initdatasize=09131_X_Gr”sse der initialisierten Daten: $1 Bytes +% Informational message showing the size of the initialized data section. +execinfo_x_uninitdatasize=09132_X_Gr”sse der nicht initialisierten Daten: $1 Bytes +% Informational message showing the size of the uninitialized data section. +execinfo_x_stackreserve=09133_X_Stack Bereich "reserved": $1 Bytes +% Informational message showing the stack size that the compiler reserved for the executable. +execinfo_x_stackcommit=09134_X_Stack Bereich "committed": $1 Bytes +% Informational message showing the stack size that the compiler committed for the executable. +% +% \end{description} +# EndOfTeX + +# +# Internal linker messages +# +# 09201 is the last used one +# +# BeginOfTeX +% \section{Linker messages} +% This section lists messages produced by internal linker. +% \begin{description} +link_f_executable_too_big=09200_F_Das Programm - Image ist fr das Target $1 zu groá +% Fatal error when resulting executable is too big. +link_w_32bit_absolute_reloc=09201_W_Object Daei "$1" enth„lt eine 32-bit absolute Relocation auf Symbol "$2". +% Warning when 64-bit object file contains 32-bit absolute relocations. +% In such case an executable image can be loaded into lower 4Gb of +% address space only. +% +% \end{description} +# EndOfTeX + +# +# Unit loading +# +# 10062 is the last used one +# +# BeginOfTeX +% \section{Unit loading messages.} +% This section lists all messages that can occur when the compiler is +% loading a unit from disk into memory. Many of these mesages are +% informational messages. +% \begin{description} +unit_t_unitsearch=10000_T_Suche Unit: $1 +% When you use the \var{-vt} option, the compiler tells you where it tries to find +% unit files. +unit_t_ppu_loading=10001_T_Lade PPU: $1 +% When the \var{-vt} switch is used, the compiler tells you +% what units it loads. +unit_u_ppu_name=10002_U_PPU-Name: $1 +% When you use the \var{-vu} flag, the unit name is shown. +unit_u_ppu_flags=10003_U_PPU-Flags: $1 +% When you use the \var{-vu} flag, the unit flags are shown. +unit_u_ppu_crc=10004_U_PPU-CRC: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_time=10005_U_PPU-Zeit: $1 +% When you use the \var{-vu} flag, the unit time is shown. +unit_u_ppu_file_too_short=10006_U_PPU-Datei zu kurz +% When you use the \var{-vu} flag, the unit time is shown. +unit_u_ppu_invalid_header=10007_U_PPU Ungltiger Header (kein PPU am Anfang) +% A unit file contains as the first three bytes the ASCII codes of the characters \var{PPU}. +unit_u_ppu_invalid_version=10008_U_PPU Ungltige Version $1 +% This unit file was compiled with a different version of the compiler, and +% cannot be read. +unit_u_ppu_invalid_processor=10009_U_PPU ist fr einen anderen Prozessor bersetzt +% This unit file was compiled for a different processor type, and +% cannot be read. +unit_u_ppu_invalid_target=10010_U_PPU ist fr ein anderes Zielsystem bersetzt +% This unit file was compiled for a different processor type, and +% cannot be read. +unit_u_ppu_source=10011_U_PPU Quelle: $1 +% When you use the \var{-vu} flag, the unit source file name is shown. +unit_u_ppu_write=10012_U_Schreibe $1 +% When you specify the \var{-vu} switch, the compiler will tell you where it +% writes the unit file. +unit_f_ppu_cannot_write=10013_F_Kann PPU-Datei nicht schreiben +% An error occurred when writing the unit file. +unit_f_ppu_read_error=10014_F_Kann PPU-Datei nicht lesen +% This means that the unit file was corrupted, and contains invalid +% information. Recompilation will be necessary. +unit_f_ppu_read_unexpected_end=10015_F_Unerwartetes Ende der PPU-Datei +% Unexpected end of file. This may mean that the PPU file is +% corrupted. +unit_f_ppu_invalid_entry=10016_F_Ungltiger Eintrag in PPU-Datei: $1 +% The unit the compiler is trying to read is corrupted, or generated with a +% newer version of the compiler. +unit_f_ppu_dbx_count_problem=10017_F_PPU Dbx Z„hler-Problem +% There is an inconsistency in the debugging information of the unit. +unit_e_illegal_unit_name=10018_E_Ungltiger Unitname: $1 +% The name of the unit doesn't match the file name. +unit_f_too_much_units=10019_F_Zu viele Units +% \fpc has a limit of 1024 units in a program. You can change this behavior +% by changing the \var{maxunits} constant in the \file{files.pas} file of the +% compiler, and recompiling the compiler. +unit_f_circular_unit_reference=10020_F_Gegenseitige Abh„ngigkeit von Units zwischen $1 und $2 +% Two units are using each other in the interface part. This is only allowed +% in the \var{implementation} part. At least one unit must contain the other one +% in the \var{implementation} section. +unit_f_cant_compile_unit=10021_F_Kann Unit "$1" nicht bersetzen, keine Quellen vorhanden +% A unit was found that needs to be recompiled, but no sources are +% available. +unit_f_cant_find_ppu=10022_F_Kann Unit "$1", die von "$2" benutzt wird, nicht finden +% You tried to use a unit of which the PPU file isn't found by the +% compiler. Check your configuration file for the unit paths. +unit_w_unit_name_error=10023_W_Unit "$1" wurde nicht gefunden, aber "$2" existiert +% This error message is no longer used. +unit_f_unit_name_error=10024_F_Unit "$1" gesucht, aber "$2" gefunden +% \dos truncation of 8 letters for unit PPU files +% may lead to problems when unit name is longer than 8 letters. +unit_w_switch_us_missed=10025_W_šbersetzen der Systemunit erfordert den Schalter -Us +% When recompiling the system unit (it needs special treatment), the +% \var{-Us} switch must be specified. +unit_f_errors_in_unit=10026_F_Es traten $1 Fehler beim šbersetzen des Moduls auf, halte an +% When the compiler encounters a fatal error or too many errors in a module +% then it stops with this message. +unit_u_load_unit=10027_U_Lade aus $1 ($2) die Unit $3 +% When you use the \var{-vu} flag, which unit is loaded from which unit is +% shown. +unit_u_recompile_crc_change=10028_U_šbersetze $1 erneut, Prfsumme fr $2 hat sich ge„ndert +% The unit is recompiled because the checksum of a unit it depends on has +% changed. +unit_u_recompile_source_found_alone=10029_U_šbersetze "$1", nur Quellcode gefunden +% When you use the \var{-vu} flag, these messages tell you why the current +% unit is recompiled. +unit_u_recompile_staticlib_is_older=10030_U_šbersetze Unit erneut, statische Bibliothek ist „lter als PPU-Datei +% When you use the \var{-vu} flag, the compiler warns if the static library +% of the unit is older than the unit file itself. +unit_u_recompile_sharedlib_is_older=10031_U_šbersetze Unit erneut, gemeinsame Bibliothek ist „lter als PPU-Datei +% When you use the \var{-vu} flag, the compiler warns if the shared library +% of the unit is older than the unit file itself. +unit_u_recompile_obj_and_asm_older=10032_U_šbersetze Unit erneut, obj und asm sind „lter als PPU-Datei +% When you use the \var{-vu} flag, the compiler warns if the assembler of +% object file of the unit is older than the unit file itself. +unit_u_recompile_obj_older_than_asm=10033_U_šbersetze Unit erneut, obj ist „lter als asm +% When you use the \var{-vu} flag, the compiler warns if the assembler +% file of the unit is older than the object file of the unit. +unit_u_parsing_interface=10034_U_Analysiere Interface von $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the interface part of the unit. +unit_u_parsing_implementation=10035_U_Analysiere Implementation von $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the implementation part of the unit. +unit_u_second_load_unit=10036_U_Zweites Laden fr Unit "$1" +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happen with +% interdependent units. +unit_u_check_time=10037_U_PPU prfe Datei $1 Zeit $2 +% When you use the \var{-vu} flag, the compiler shows the filename and +% date and time of the file on which a recompile depends. +### The following two error msgs is currently disabled. +#unit_h_cond_not_set_in_last_compile=10038_H_Conditional $1 wurde beim Start beim letzten šbersetzen von $2 nicht gesetzt +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that currently is defined, but was not used the last +#% time the unit was compiled. +#unit_h_cond_set_in_last_compile=10039_H_Conditional $1 wurde beim Start beim letzten šbersetzen von $2 gesetzt +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that was used the last time the unit was compiled, but +#% the conditional is currently not defined. +unit_w_cant_compile_unit_with_changed_incfile=10040_W_Kann Unit $1 nicht erneut bersetzen, aber ge„nderte Include-Datei gefunden +% A unit was found to have modified include files, but +% some source files were not found, so recompilation is impossible. +unit_u_source_modified=10041_U_Datei $1 ist neuer als die, aus der die PPU Datei $2 erzeugt wird +% A modified source file for a compiler unit was found. +unit_u_ppu_invalid_fpumode=10042_U_Versuch eine Unit zu verwenden, die in einem anderen FPU Mode bersetzt wurde +% Trying to compile code while using units which were not compiled with +% the same floating point format mode. Either all code should be compiled +% with FPU emulation on, or with FPU emulation off. +unit_u_loading_interface_units=10043_U_Interface Units werden von $1 geladen +% When you use the \var{-vu} flag, the compiler warns that it is starting +% to load the units defined in the interface part of the unit. +unit_u_loading_implementation_units=10044_U_Implementation Units werden von $1 geladen +% When you use the \var{-vu} flag, the compiler warns that it is starting +% to load the units defined in the implementation part of the unit. +unit_u_interface_crc_changed=10045_U_Ge„nderte Interface CRC fr Unit $1 +% When you use the \var{-vu} flag, the compiler warns that the +% CRC calculated for the interface has been changed after the implementation +% has been parsed. +unit_u_implementation_crc_changed=10046_U_Ge„nderte Implementation CRC fr Unit $1 +% When you use the \var{-vu} flag, the compiler warns that the +% CRC calculated has been changed after the implementation +% has been parsed. +unit_u_finished_compiling=10047_U_šbersetzen der Unit $1 beendet +% When you use the \var{-vu} flag, the compiler warns that it +% has finished compiling the unit. +unit_u_add_depend_to=10048_U_Abh„ngigkeit hinzufgen: $1 h„ngt von $2 ab +% When you use the \var{-vu} flag, the compiler warns that it +% has added a dependency between the two units. +unit_u_no_reload_is_caller=10049_U_Kein erneutes Laden, Unit $1 ist die Aufrufende +% When you use the \var{-vu} flag, the compiler warns that it +% will not reload the unit because it is the unit that wants +% to load this unit. +unit_u_no_reload_in_second_compile=10050_U_Kein erneutes Laden der Unit, bereits beim zweiten šbersetzen: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% will not reload the unit because it is already in a second recompile. +unit_u_flag_for_reload=10051_U_Flag fr erneutes Laden: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to reload the unit. +unit_u_forced_reload=10052_U_Erzwungenes erneutes Laden +% When you use the \var{-vu} flag, the compiler warns that it +% is reloading the unit because it was required. +unit_u_previous_state=10053_U_Vorhergehender Status von $1: $2 +% When you use the \var{-vu} flag, the compiler shows the +% previous state of the unit. +unit_u_second_compile_unit=10054_U_$1 wird bereits bersetzt, zweites šbersetzen gesetzt +% When you use the \var{-vu} flag, the compiler warns that it is starting +% to recompile a unit for the second time. This can happen with interdependent +% units. +unit_u_loading_unit=10055_U_Unit $1 wird geladen +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the unit. +unit_u_finished_loading_unit=10056_U_Laden der Unit $1 beendet +% When you use the \var{-vu} flag, the compiler warns that it finished +% loading the unit. +unit_u_registering_new_unit=10057_U_Registrierung der neuen Unit $1 +% When you use the \var{-vu} flag, the compiler warns that it has +% found a new unit and is registering it in the internal lists. +unit_u_reresolving_unit=10058_U_Erneutes resolving der Unit $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to recalculate the internal data of the unit. +unit_u_skipping_reresolving_unit=10059_U_Erneutes Resolving der Unit $1 wird bersprungen, benutzte Units werden noch geladen +% When you use the \var{-vu} flag, the compiler warns that it is +% skipping the recalculation of the internal data of the unit +% because there is no data to recalculate. +unit_u_unload_resunit=10060_U_Entlade die Resource-Unit $1 (wird nicht ben”tigt) +% When you use the \var{-vu} flag, the compiler warns that it is unloading the +% resource handling unit, since no resources are used. +unit_e_different_wpo_file=10061_E_Unit $1 wurde mit einer anderen Feedback-Eingabe ($2, $3) fr die Gesamtprogramm-Optimierung (wpo) bersetzt. Bitte erneut ohne wpo oder mit der gleichen wpo-Feedback-Eingabe-Datei bersetzen +% When a unit has been compiled using a particular whole program optimization (wpo) feedback file (\var{-FW<x>} \var{-OW<x>}), +% this compiled version of the unit is specialised for that particular compilation scenario and cannot be used in +% any other context. It has to be recompiled before you can use it in another program or with another wpo feedback input file. +unit_u_indirect_crc_changed=10062_U_Die CRC des indirekten Interface (Objekte/Klassen) fr die unit $1 hat sich ge„ndert +% When you use the \var{-vu} flag, the compiler warns that the +% indirect CRC calculated for the unit (this is the CRC of all classes/objects/interfaces/$\ldots$ +% in the interfaces of units directly or indirectly used by this unit in the interface) has been changed after the +% implementation has been parsed. +% +% \end{description} +# EndOfTeX + +# +# Options +# +# 11048 is the last used one +# +option_usage=11000_O_$1 [Optionen] <Eingabedatei> [Optionen] +# BeginOfTeX +% +% \section{Command line handling errors} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +option_only_one_source_support=11001_W_Es wird nur eine Quelldatei untersttzt. Wechsel fr das Kompilieren von Quelldatei "$1" zu Quelldatei "$2" +% You can specify only one source file on the command line. The last +% one will be compiled, others will be ignored. This may indicate that +% you forgot a \var{'-'} sign. +option_def_only_for_os2=11002_W_DEF-Datei kann nur fr OS/2 erzeugt werden +% This option can only be specified when you're compiling for OS/2. +option_no_nested_response_file=11003_E_Verschachtelte Response-Dateien werden nicht untersttzt +% You cannot nest response files with the \var{@file} command line option. +option_no_source_found=11004_F_Kein Name fr Quelldatei auf der Kommandzeile +% The compiler expects a source file name on the command line. +option_no_option_found=11005_N_Keine Angaben in Konfigurationsdatei "$1" gefunden +% The compiler didn't find any option in that config file. +option_illegal_para=11006_E_Ungltiger Parameter: $1 +% You specified an unknown option. +option_help_pages_para=11007_H_-? zeigt Hilfetext an +% When an unknown option is given, this message is diplayed. +option_too_many_cfg_files=11008_F_Zu viele verschachtelte Konfigurationsdateien +% You can only nest up to 16 config files. +option_unable_open_file=11009_F_Kann Datei nicht ”ffnen $1 +% The option file cannot be found. +option_reading_further_from=11010_D_Lese weitere Optionen aus $1 +% Displayed when you have notes turned on, and the compiler switches +% to another options file. +option_target_is_already_set=11011_W_Zielsystem ist bereits gesetzt: $1 +% Displayed if more than one \var{-T} option is specified. +option_no_shared_lib_under_dos=11012_W_Gemeinsame Bibliotheken sind auf der DOS Platform nicht verfgbar, verwende stattdessen statische Bibliotheken +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos. +option_too_many_ifdef=11013_F_Zu viele \var{\#IF(N)DEFs} in Zeile $2 der Optionen-Datei $1 +% The \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_many_endif=11014_F_Unerwartetes \var{\#ENDIFs} in Zeile $2 der Optionen-Datei $1 +% The \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_less_endif=11015_F_Offene Bedingung am Ende der Optionen-Datei +% The \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_no_debug_support=11016_W_Erzeugung von Debug-Informationen wird von dieser ausfhrbaren Datei nicht untersttzt +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_Versuchen Sie mit -dGDB erneut zu bersetzen +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_W_Sie verwenden den nun berholten Schalter $1 +% This warns you when you use a switch that is not needed/supported anymore. +% It is recommended that you remove the switch to overcome problems in the +% future, when the meaning of the switch may change. +option_obsolete_switch_use_new=11019_W_Sie benutzen den nun berholten Schalter $1, bitte benutzen Sie $2 +% This warns you when you use a switch that is not supported anymore. You +% must now use the second switch instead. +% It is recommended that you change the switch to overcome problems in the +% future, when the meaning of the switch may change. +option_switch_bin_to_src_assembler=11020_N_Schalte Assembler auf den Standard-Assembler-Quellcodeschreiber +% This notifies you that the assembler has been changed because you used the +% -a switch, which can't be used with a binary assembler writer. +option_incompatible_asm=11021_W_Das gew„hlte Assembler-Ausgabeformat "$1" ist nicht mit "$2" kompatibel +option_asm_forced=11022_W_Verwendung des Assemblers "$1" erzwungen +% The assembler output selected cannot generate +% object files with the correct format. Therefore, the +% default assembler for this target is used instead. +option_using_file=11026_T_Optionen werden aus der Datei $1 gelesen +% Options are also read from this file. +option_using_env=11027_T_Optionen werden aus dem environment $1 gelesen +% Options are also read from this environment string. +option_handling_option=11028_D_Handling der Option "$1" +% Debug info that an option is found and will be handled. +option_help_press_enter=11029_O_*** Drcken Sie die ENTER-Taste *** +% Message shown when help is shown page per page. When pressing the ENTER +% Key, the next page of help is shown. If you press q and then ENTER, the +% compiler exits. +option_start_reading_configfile=11030_H_Beginn des Lesens der Konfigurationsdatei $1 +% Start of configuration file parsing. +option_end_reading_configfile=11031_H_Ende des Lesens der Konfigurationsdatei $1 +% End of configuration file parsing. +option_interpreting_option=11032_D_Option "$1" interpretieren +% The compiler is interpreting an option +option_interpreting_firstpass_option=11036_D_firstpass Option "$1" interpretieren +% The compiler is interpreting an option for the first time. +option_interpreting_file_option=11033_D_Datei Option "$1" interpretieren +% The compiler is interpreting an option which it read from the configuration file. +option_read_config_file=11034_D_Konfigurationsdatei "$1" lesen +% The compiler is starting to read the configuration file. +option_found_file=11035_D_Name der Quelldatei "$1" gefunden +% Additional information about options. +% Displayed when you have the debug option turned on. +option_code_page_not_available=11039_E_Unbekannte code page +% An unknown code page for the source files was requested. +% The compiler is compiled with support for several code pages built-in. +% The requested code page is not in that list. You will need to recompile +% the compiler with support for the codepage you need. +option_config_is_dir=11040_F_Konfigurationsdatei $1 ist ein Verzeichnis +% Directories cannot be used as configuration files. +option_confict_asm_debug=11041_W_Die gew„hlte Assembler-Ausgabe "$1" kann kein Debug-Info erzeugen, Debugging ist ausgeschaltet +% The selected assembler output cannot generate +% debugging information, debugging option is therefore disabled. +option_ppc386_deprecated=11042_W_Die Verwendung von ppc386.cfg wird beendet. Bitte statt dessen fpc.cfg benutzen +% Using ppc386.cfg is still supported for historical reasons, however, for a multiplatform +% system the naming makes no sense anymore. Please continue to use fpc.cfg instead. +option_else_without_if=11043_F_Zur \var{\#ELSE} Direktive in Zeile $2 der Optionen-Datei $1 gibt es kein entsprechendes \var{\#IF(N)DEF} +% An \var{\#ELSE} statement was found in the options file without a matching \var{\#IF(N)DEF} statement. +option_unsupported_target=11044_F_Die Option "$1" wird auf der Zielplattform nicht oder noch nicht untersttzt +% Not all options are supported or implemented for all target platforms. This message informs you that a chosen +% option is incompatible with the currently selected target platform. +option_unsupported_target_for_feature=11045_F_Das Feature "$1" wird fr die ausgew„hlte Zielplattform nicht oder noch nicht untersttzt +% Not all features are supported or implemented for all target platforms. This message informs you that a chosen +% feature is incompatible with the currently selected target platform. +option_dwarf_smart_linking=11046_N_DWARF Debug-Information kann auf dieser Zielplattform nicht zusammen mit Smartlinking benutzt werden, es wird auf statisches Linken umgeschaltet +% Smart linking is currently incompatble with DWARF debug information on most +% platforms, so smart linking is disabled in such cases. +option_ignored_target=11047_W_Option "$1" wird fr die ausgew„hlte Zielplattform ignoriert +% Not all options are supported or implemented for all target platforms. This message informs you that a chosen +% option is ignored for the currently selected target platform. +option_debug_external_unsupported=11048_W_Schalte externe Debuginformation aus, weil es fr die gew„hlte Kombination Ziel/Debugformat nicht untersttzt wird +% Not all debug formats can be stored in an external file on all platforms. In particular, on +% Mac OS X only DWARF debug information can be stored externally. +% +% \end{description} +# EndOfTeX + +# +# Whole program optimization +# +# 12019 is the last used one +# +# BeginOfTeX +% +% \section{Whole program optimization messages} +% This section lists errors that occur when the compiler is performing +% whole program optimization. +% \begin{description} +wpo_cant_find_file=12000_F_Feedback-Datei "$1" fr die Gesamtprogramm-Optimierung kann nicht ge”ffnet werden +% The compiler cannot open the specified feedback file with whole program optimization information. +wpo_begin_processing=12001_D_Bearbeite die Informationen zur Gesamtprogramm-Optimierung aus der wpo-Feedback-Datei "$1" +% The compiler starts processing whole program optimization information found in the named file. +wpo_end_processing=12002_D_Bearbeitung der Informationen zur Gesamtprogramm-Optimierung aus der wpo-Feedback-Datei "$1" beendet +% The compiler has finished processing the whole program optimization information found in the named file. +wpo_expected_section=12003_E_Erwarte einen Sektions-Header, statt dessen "$2" in Zeile $1 der wpo-Feedback-Datei erhalten +% The compiler expected a section header in the whole program optimization file (starting with \%), +% but did not find it. +wpo_no_section_handler=12004_W_Kein Handler fr die Sektion "$2" der Gesamtprogramm-Optimierung registriert (Zeile $1 der wpo-Feedback-Datei). Wird ignoriert +% The compiler has no handler to deal with the mentioned whole program optimization information +% section, and will therefore ignore it and skip to the next section. +wpo_found_section=12005_D_Sektion "$1" der Gesamtprogramm-Optimierung mit Informationen ber "$2" gefunden +% The compiler encountered a section with whole program optimization information, and according +% to its handler this section contains information usable for the mentioned purpose. +wpo_no_input_specified=12006_F_Die ausgew„hlte Gesamtprogramm-Optimierung erfordert eine bereits erzeugte Feedback-Datei (bitte mit -Fw angeben) +% The compiler needs information gathered during a previous compilation run to perform the selected +% whole program optimizations. You can specify the location of the feedback file containing this +% information using the -Fw switch. +wpo_not_enough_info=12007_E_Keine Informationen fr "$1" Gesamtprogramm-Optimierung gefunden +% While you pointed the compiler to a file containing whole program optimization feedback, it +% did not contain the information necessary to perform the selected optimizations. You most likely +% have to recompile the program using the appropate -OWxxx switch. +wpo_no_output_specified=12008_F_Gebe eine Feedback-Datei an, um die erzeugte Information fr die Gesamtprogramm-Optimierung zu speichern (mit der Option -FW) +% You have to specify the feedback file in which the compiler has to store the whole program optimization +% feedback that is generated during the compilation run. This can be done using the -FW switch. +wpo_output_without_info_gen=12009_E_Erzeuge keine Information fr die Gesamtprogramm-Optimierung, obwohl eine Feedback-Datei dafr angegeben wurde (mit der Option -FW) +% The compiler was instructed to store whole program optimization feedback into a file specified using -FW, +% but not to actually generated any whole program optimization feedback. The classes of to be +% generated information can be speciied using -OWxxx. +wpo_input_without_info_use=12010_E_Gesamtprogramm-Optimierung wird nicht durchgefhrt, obwohl eine Feedback-Datei angegeben wurde (mit der Option -FW) +% The compiler was not instructed to perform any whole program optimizations (no -Owxxx parameters), +% but nevertheless an input file with such feedback was specified (using -Fwyyy). Since this can +% indicate that you forgot to specify an -Owxxx parameter, the compiler generates an error in this case. +wpo_skipping_unnecessary_section=12011_D_šberspringe die Sektion "$1" der Gesamtprogramm-Optimierung, weil sie nicht ben”tigt wird +% The whole program optimization feedback file contains a section with information that is not +% required by the selected whole program optimizations. +wpo_duplicate_wpotype=12012_W_šberschreibe bereits gelesene Information "$1" aus der Feedback-Eingabe-Datei mit der Information in Sektion "$2" +% The feedback file contains multiple sections that provide the same class of information (e.g., +% information about which virtual methods can be devirtualized). In this case, the information in last encountered +% section is used. Turn on debugging output (-vd) to see which class of information is provided by each section. +wpo_cannot_extract_live_symbol_info_strip=12013_E_Symbol "liveness" Information kann nicht aus dem Programm erhalten werden, wenn Symbole mit "strip" entfernt wurden. Benutze -Xs- +% Certain symbol liveness collectors extract the symbol information from the linked program. If the symbol information +% is stripped (option -Xs), this is not possible. +wpo_cannot_extract_live_symbol_info_no_link=12014_E_Symbol "liveness" Information kann nicht aus dem Programm erhalten werden, wenn es nicht "linked" wird +% Certain symbol liveness collectors extract the symbol information from the linked program. If the program is not +% linked by the compiler, this is not possible. +wpo_cannot_find_symbol_progs=12015_F_"$1" oder "$2" wurden nicht gefunden, um die Symbol "liveness" Information aus dem Programm zu erhalten +% Certain symbol liveness collectors need a helper program to extract the symbol information from the linked program. +% This helper program is normally 'nm', which is part of the GNU binutils. +wpo_error_reading_symbol_file=12016_E_Fehler beim Lesen der "symbol liveness" Information durch "$1" erzeugt +% An error occurred during the reading of the symbol liveness file that was generated using the 'nm' or 'objdump' program. The reason +% can be that it was shorter than expected, or that its format was not understood. +wpo_error_executing_symbol_prog=12017_F_Fehler bei der Ausfhrung von "$1" (exitcode: $2) um Symbolinformationen aus dem "gelinkten" Programm zu erhalten +% Certain symbol liveness collectors need a helper program to extract the symbol information from the linked program. +% The helper program produced the reported error code when it was run on the linked program. +wpo_symbol_live_info_needs_smart_linking=12018_E_Die Sammlung der "symbol liveness" Information hilft nur bei smart linking, benutze -CX -XX +% Whether or not a symbol is live is determined by looking whether it exists in the final linked program. +% Without smart linking/dead code stripping, all symbols are always included, regardless of whether they are +% actually used or not. So in that case all symbols will be seen as live, which makes this optimization ineffective. +wpo_cant_create_feedback_file=12019_E_Die angegebene Feedback-Eingabe-Datei "$1" fr die Gesamtprogramm-Optimierung kann nicht erzeugt werden +% The compiler is unable to create the file specified using the -FW parameter to store the whole program optimisation information. +% +% \end{description} +# EndOfTeX + +# +# Logo (option -l) +# +option_logo=11023_[ +Free Pascal Compiler Version $FPCFULLVERSION [$FPCDATE] fr $FPCTARGET +Copyright (c) 1993-2011 Florian Kl„mpfl und andere +] + +# +# Info (option -i) +# +option_info=11024_[ +Free Pascal Compiler Version $FPCVERSION + +Compiler Datum: $FPCDATE +Compiler Zielsystem: $FPCCPU + +Untersttzte Zielbetriebssysteme: + $OSTARGETS + +Untersttzte CPU Instruktionen: + $INSTRUCTIONSETS + +Untersttzte FPU Instruktionen: + $FPUINSTRUCTIONSETS + +Untersttzte ABI Ziele: + $ABITARGETS + +Untersttzte Optimierungen: + $OPTIMIZATIONS + +Untersttzte Gesamtprogramm-Optimierungen: + All + $WPOPTIMIZATIONS + +Untersttzte Microcontroller: + $CONTROLLERTYPES + +Dieses Programm unterliegt der GNU General Public Licence +Weitere Informationen sind in COPYING.FPC zu finden + +Fehlerberichte, Vorschl„ge usw. bitte senden an: + http://bugs.freepascal.org +oder + bugs@freepascal.org +] + +# +# Help pages (option -? and -h) +# +# The first character on the line indicates who will display this +# line, the current possibilities are : +# * = every target +# 3 = 80x86 targets +# 4 = x86_64 +# 6 = 680x0 targets +# A = ARM +# e = in extended debug mode only +# P = PowerPC targets +# S = Sparc targets +# V = Virtual machine targets +# The second character also indicates who will display this line, +# (if the above character was TRUE) the current possibilities are : +# * = everyone +# g = with GDB info supported by the compiler +# O = OS/2 +# L = UNIX systems +# The third character represents the indentation level. +# +option_help_pages=11025_[ +**0*_Nach booleschen Optionen geben Sie + zum Ein- bzw. - zum Ausschalten an +**1a_L”sche die erzeugte Assembler-Datei nicht +**2al_Liste Quellcode-Zeilen in der Assembler-Datei +**2an_Liste "node info" in der Assembler-Datei +*L2ap_Benutze Pipes anstelle tempor„rer Assembler-Dateien +**2ar_Liste Registerbelegungsinformation in Assembler-Datei +**2at_Liste Temp. Variablenbelegungsinfo in Assembler-Datei +**1A<x>_Ausgabe Format: +**2Adefault_Benutze den "default" Assembler +3*2Aas_Assembliere mit Hilfe von GNU AS +3*2Amacho_Mach-O (Darwin, Intel 32 bit) mit Hilfe des internen Schreibers +3*2Anasmcoff_COFF (Go32v2) Datei mit Hilfe von Nasm +3*2Anasmelf_ELF32 (Linux) Datei mit Hilfe von Nasm +3*2Anasmwin32_Win32 Object Datei mit Hilfe von Nasm +3*2Anasmwdosx_Win32/WDOSX Object Datei mit Hilfe von Nasm +3*2Awasm_obj Datei mit Hilfe von Wasm (Watcom) +3*2Anasmobj_Obj Datei mit Hilfe von Nasm +3*2Amasm_Obj Datei mit Hilfe von Masm (Microsoft) +3*2Atasm_Obj Datei mit Hilfe von Tasm (Borland) +3*2Aelf_ELF32 (Linux) mit Hilfe des internen Schreibers +3*2Acoff_COFF (Go32v2) mit Hilfe des internen Schreibers +3*2Apecoff_PE_COFF (Win32) mit Hilfe des internen Schreibers +4*2Aas_Assembliere mit Hilfe von GNU AS +4*2Agas_Assembliere mit Hilfe von GNU GAS +4*2Agas-darwin_Assembliere darwin Mach-O64 mit Hilfe von GNU GAS +4*2Amasm_Win64 Object Datei mit Hilfe von ml64 (Microsoft) +4*2Apecoff_PE-COFF (Win64) mit Hilfe des internen Writer +4*2Aelf_ELF (Linux-64bit) mit Hilfe des internen Writer +6*2Aas_Unix o-Datei mit Hilfe von GNU AS +6*2Agas_GNU Motorola Assembler +6*2Amit_MIT Syntax (old GAS) +6*2Amot_Standard Motorola Assembler +A*2Aas_Assembliere mit Hilfe von GNU AS +P*2Aas_Assembliere mit Hilfe von GNU AS +S*2Aas_Assembliere mit Hilfe von GNU AS +**1b_Erzeuge Browser-Info +**2bl_Erzeuge Info zu lokalen Symbolen +**1B_Erzeuge alle Module (Build) +**1C<x>_Optionen fr Code-Erzeugung: +**2C3<x>_Schalte ieee-Prfung von Konstanten ein +**2Ca<x>_W„hle ABI aus; fpc -i gibt die m”glichen Werte aus +**2Cb_Erzeuge "big-endian" Code +**2Cc<x>_Setze "default calling convention" zu <x> +**2CD_Erzeuge auch eine dynamische Bibliothek (nicht untersttzt) +**2Ce_šbersetze mit emulierten Fliesskomma opcodes +**2Cf<x>_W„hle den Fliesskomma instruction set aus; fpc -i gibt die m”glichen Werte aus +**2CF<x>_Minimale Pr„zission von Fliesskommakonstanten (default, 32, 64) +**2Cg_Erzeuge PIC code +**2Ch<n>_<n> Bytes Heap (zwischen 1023 und 67107840) +**2Ci_I/O-Prfung +**2Cn_Lasse die Linkstufe aus +**2Co_Prfe auf šberlauf von Integer-Operationen +**2CO_Prfe auf m”glichen šberlauf von Integer-Operationen +**2Cp<x>_W„hle instruction set aus; fpc -i gibt die m”glichen Werte aus +**2CP<x>=<y>_ Einstellungen fr packing +**3CPPACKSET=<y>_ <y> Belegung von Sets: 0, 1 oder DEFAULT oder NORMAL, 2, 4 und 8 +**2Cr_Fhre Bereichsprfung durch +**2CR_Verifiziere die Gltigkiet des Aufrufs der Objektmethoden +**2Cs<n>_Setze die Prfgr”sse des Stacks auf <n> +**2Ct_Fhre Stackprfung durch (nur zum Testen, siehe Handbuch) +**2Cx_Benutze Smartlinking +**1d<x>_Definiere das Symbol <x> +**1D_Erzeuge eine DEF-Datei +**2Dd<x>_Setze Beschreibung zu <x> +**2Dv<x>_Setze DLL Version zu <x> +*O2Dw_Erzeuge PM-Anwendung +**1e<x>_Setze Pfad zur ausfhrbaren Datei +**1E_Genau wie -Cn +**1fPIC_Genau wie -Cg +**1F<x>_Dateinamen und Pfade: +**2Fa<x>[,y]_Ein Program soll die Units <x> und [y] laden, bevor uses analysiert wird +**2Fc<x>_Setze die Eingabe-Codepage zu <x> +**2Fd_Schalte den internen Verzeichnis-Cache des Compilers aus +**2FC<x>_Setze den Namen des RC Compiler-Bin„rprograms auf <x> +**2FD<x>_Setze das Verzeichnis fr die Compiler-Hilfsprogramme +**2Fe<x>_Leite die Fehlerausgabe um nach <x> +**2Ff<x>_Erg„nze <x> zum Framework-Pfad (nur Darwin) +**2FE<x>_Setze den Pfad fr Exe/Unit-Dateien auf <x> +**2Fi<x>_Erg„nze <x> zum Include-Pfad +**2Fl<x>_Erg„nze <x> zum Bibliotheks-Pfad +**2FL<x>_Benutze <x> als dynamischen Linker +**2Fm<x>_Lade die Unicode-Konversionstabelle aus <x>.txt im Compiler-Verzeichnis +**2Fo<x>_Erg„nze <x> zum Objektdatei-Pfad +**2Fr<x>_Lade die Fehler-Meldungs Datei <x> +**2FR<x>_Setze den Resource (.res) Linker auf <x> +**2Fu<x>_Erg„nze <x> zum Unit-Pfad +**2FU<x>_Units werden nach <x> ausgegeben, hat Vorrang vor -FE +**2FW<x>_Speichere das erzeugte Feedback fr die Gesamtprogramm-Optimierung in <x> +**2Fw<x>_Lade das bereits gespeicherte Feedback fr die Gesamtprogramm-Optimierung aus <x> +*g1g<x>_Erzeuge Informationen zur Fehlersuche: +*g2gc_Zeigerberprfung +*g2gh_Heaptrace-Unit einbinden +*g2gl_Line info Unit einbinden, um mehr backtrace Informationen anzuzeigen +*g2go<x>_Setze Optionen fr die Debug Informationen +*g3godwarfsets_Schalte DWARF Debug Informationen fr Mengen (sets) ein (verhindert debugging mit gdb < 6.5) +*g3gostabsabsincludes_ Absolute/volle Include-Datei-Pfade in Stabs speichern +*g3godwarfmethodclassprefix_ Stelle Methodennamen in DWARF den Namen der Klasse voran +*g2gp_Erhalte Gross/Kleinschreibung in Stabs-Symbolnamen +*g2gs_Erzeuge Stabs-Debug-Informationen +*g2gt_L”sche lokale Variablen (um eine Verwendung ohne Initialisierung zu finden) +*g2gv_Erzeuge ein mit Valgrind verfolgbares (traceable) Programm +*g2gw_Erzeuge DWARFv2-Debug-Informationen (wie -gw2) +*g2gw2_Erzeuge DWARFv2-Debug-Informationen +*g2gw3_Erzeuge DWARFv3-Debug-Informationen +*g2gw4_Generate DWARFv4-Debug-Informationen (experimentell) +**1i_Zeige alle Informationen ber den Compiler +**2iD_Zeige Compilerdatum +**2iV_Zeige Compilerversion +**2iW_Zeige vollst„ndige Compilerversion +**2iSO_Zeige Compilerbetriebssystem +**2iSP_Zeige Compilerprozessor +**2iTO_Zeige Zielbetriebssystem +**2iTP_Zeige Zielprozessor +**1I<x>_Erg„nze <x> zum Include-Pfad +**1k<x>_šbergebe <x> an den Linker +**1l_Zeige Logo +**1M<x>_Setze Sprachmodus zu <x> +**2Mfpc_Free Pascal Dialekt (Voreinstellung) +**2Mobjfpc_Schalte einige Delphi 2 Erweiterungen ein +**2Mdelphi_Versuche zu Delphi kompatibel zu sein +**2Mtp_Versuche zu TP/BP 7.0 kompatibel zu sein +**2Mmacpas_Versuche zu den MacIntosh Pascal-Dialekten kompatibel zu sein +**1n_Standard-Konfigurationsdatei ignorieren +**1N<x>_Node tree Optimierung +**2Nu_Unroll loops +**1o<x>_Die erzeugte, ausfhrbare Datei bekommt den Namen <x> +**1O<x>_Optimierungen: +**2O-_Optimierungen ausschalten +**2O1_Level 1 Optimierung (schnell und Debugger freundlich) +**2O2_Level 2 Optimierung (-O1 + schnelle Optimierungen) +**2O3_Level 3 Optimierung (-O2 + langsame Optimierungen) +**2Oa<x>=<y>_Ausrichtung (alignment) von Mengen +**2Oo[NO]<x>_Optimierungen ein- oder ausschalten; fpc -i gibt die m”glichen Werte aus +**2Op<x>_Setze Zielprozessor fr die Optimierung; fpc -i gibt die m”glichen Werte aus +**2OW<x>_Erzeuge Feedback fr die Gesamtprogramm-Optimierung fr Optimierung <x>, siehe fpc -i fr m”gliche Werte +**2Ow<x>_Fhre die Gesamtprogramm-Optimierung durch <x>, siehe fpc -i fr m”gliche Werte +**2Os_Erzeuge krzeren Code +**1pg_Erzeuge Profiler-Code fr gprof +**1R<x>_Assembler Code Format: +**2Rdefault_Benutze den default Assembler +3*2Ratt_Lese Assembler Code im AT&T Format +3*2Rintel_Lese Assembler im Intel Format +6*2RMOT_Lese Assembler im Motorola Format +**1S<x>_Syntax-Optionen: +**2S2_Schalte einige der Delphi 2 Erweiterungen ein (wie -Mobjfpc) +**2Sc_Untersttze spezielle C Operatoren (*=,+=,/= and -=) +**2Sa_Erlaube assertion code. +**2Sd_Sei Delphi-kompatibel (wie -Mdelphi) +**2Se<x>_Fehler Optionen. <x> ist eine der folgenden Kombinationen: +**3*_<n> : Compiler h„lt nach <n> Fehlern (Voreinstellung ist 1) +**3*_w : Compiler h„lt auch nach Warnungen +**3*_n : Compiler h„lt auch nach Anmerkungen +**3*_h : Compiler h„lt auch nach Hinweisen +**2Sg_Erlaube LABEL und GOTO +**2Sh_Benutze ANSI-Strings +**2Si_Benutze C++ artige INLINE +**2Sk_Lade fpcylix Unit +**2SI<x>_Setze den Stil des Interface zu <x> +**3SIcom_COM kompatibles Interface (Voreinstellung) +**3SIcorba_CORBA kompatibles Interface +**2Sm_Untersttze Makros wie in C (global) +**2So_Sei TP/BP 7.0 kompatibel (wie -Mtp) +**2Ss_Konstruktor- und Destruktorname mssen "Init" und "Done" sein +**2Sx_Exception Schlsselw”rter einschalten (Voreinstellung in Delphi/ObjFPC Moden) +**2Sy_@<pointer> gibt einen typisierten Pointer zurck, genau wie $T+ +**1s_Rufe weder Assembler noch Linker auf (nur mit -a) +**2sh_Erzeuge Script um auf dem Host zu linken +**2st_Erzeuge Script um auf dem Zielsystem zu linken +**2sr_šberspringe die Phase der "register allocation" (mit -alr benutzen) +**1T<x>_Zielbetriebssystem:: +3*2Tdarwin_Darwin/Mac OS X +3*2Temx_OS/2 via EMX (einschliesslich EMX/RSX extender) +3*2Tfreebsd_FreeBSD +3*2Tgo32v2_Version 2 des DJ Delorie DOS extender +3*2Tlinux_Linux +3*2Tnetbsd_NetBSD +3*2Tnetware_Novell Netware Module (clib) +3*2Tnetwlibc_Novell Netware Module (libc) +3*2Topenbsd_OpenBSD +3*2Tos2_OS/2 / eComStation +3*2Tsunos_SunOS/Solaris +3*2Tsymbian_Symbian OS +3*2Tsolaris_Solaris +3*2Twatcom_Watcom compatible DOS extender +3*2Twdosx_WDOSX DOS extender +3*2Twin32_Windows 32 Bit +3*2Twince_Windows CE +4*2Tdarwin_Darwin/Mac OS X +4*2Twin64_Win64 (64 bit Windows systems) +4*2Tlinux_Linux +6*2Tamiga_Commodore Amiga +6*2Tatari_Atari ST/STe/TT +6*2Tlinux_Linux +6*2Tpalmos_PalmOS +A*2Tdarwin_Darwin/iPhoneOS/iOS +A*2Tlinux_Linux +A*2Twince_Windows CE +P*2Tamiga_AmigaOS +P*2Tdarwin_Darwin und Mac OS X +P*2Tlinux_Linux +P*2Tmacos_Mac OS (classic) +P*2Tmorphos_MorphOS +S*2Tsolaris_Solaris +S*2Tlinux_Linux +**1u<x>_Entferne die Definition fr das Symbol <x> +**1U<x>_Unit-Optionen: +**2Un_Prfe den Unitnamen nicht +**2Ur_Erzeuge "release unit"-Dateien +**2Us_Erzeuge eine Systemunit +**1v<x>_Meldungen, <x> ist eine Kombination der folgenden Zeichen: +**2*_e : Fehler (Standard) 0 : Nichts (ausser Fehlern) +**2*_w : Warnungen u : Unit Informationen +**2*_n : Anmerkungen t : Angesprochene/benutzte Dateien +**2*_h : Hinweise c : Preprozessordirektiven +**2*_i : Allgemeine Informationen d : Debug Informationen +**2*_l : Zeilennummern r : Rhide/GCC kompatibler Modus +**2*_s : Zeitstempel q : Nummer der Meldung +**2*_a : Alles x : Exe-Datei Informationen (nur Win32) +**2*_b : Schreibe bei Meldungen mit p : Schreibe tree.log mit Analysenbaum (parse tree) +**2*_ Dateinamen den vollst„ndigen v : Schreibe fpcdebug.txt mit +**2*_ Pfad ganz viel Information +**2*_m<x>,<y> : Zeige die Meldungen mit den Nummern <x> und <y> nicht +**1W<x>_Spezifiziere ein natives Programm (Windows) +3*2WA_Spezifiziere ein natives Programm (Windows) +4*2WA_Spezifiziere ein natives Programm (Windows) +A*2WA_Spezifiziere ein natives Programm (Windows) +3*2Wb_Erzeuge statt einer Bibliothek ein Bundle (Darwin) +P*2Wb_Erzeuge statt einer Bibliothek ein Bundle (Darwin) +p*2Wb_Erzeuge statt einer Bibliothek ein Bundle (Darwin) +A*2Wb_Erzeuge statt einer Bibliothek ein Bundle (Darwin) +4*2Wb_Erzeuge statt einer Bibliothek ein Bundle (Darwin) +3*2WB_Erzeuge ein relozierbares Image (Windows, Symbian) +3*2WBxxxx_Setze die Imagebasis auf xxxx (Windows, Symbian) +4*2WB_Erzeuge ein relozierbares Image (Windows) +4*2WBxxxx_Setze die Imagebasis auf xxxx (Windows, Symbian) +A*2WB_Erzeuge ein relozierbares Image (Windows, Symbian) +A*2WBxxxx_Setze die Imagebasis auf xxxx (Windows) +3*2WC_Spezifiziere "console type application" (EMX, OS/2, Windows) +4*2WC_Spezifiziere "console type application" (EMX, OS/2, Windows) +A*2WC_Spezifiziere "console type application" (Windows) +P*2WC_Spezifiziere "console type application" (Classic Mac OS) +3*2WD_Benutze DEFFILE um Funktionen der DLL oder EXE zu exportieren (Windows) +4*2WD_Benutze DEFFILE um Funktionen der DLL oder EXE zu exportieren (Windows) +A*2WD_Benutze DEFFILE um Funktionen der DLL oder EXE zu exportieren (Windows) +3*2We_Benutze externe Resourcen (Darwin) +4*2We_Benutze externe Resourcen (Darwin) +A*2We_Benutze externe Resourcen (Darwin) +P*2We_Benutze externe Resourcen (Darwin) +p*2We_Benutze externe Resourcen (Darwin) +3*2WF_Spezifiziere "full-screen type application" (EMX, OS/2) +3*2WG_Spezifiziere "graphic type application" (EMX, OS/2, Windows) +4*2WG_Spezifiziere "graphic type application" (EMX, OS/2, Windows) +A*2WG_Spezifiziere "graphic type application" (Windows) +P*2WG_Spezifiziere "graphic type application" (Classic Mac OS) +3*2Wi_Benutze interne Resourcen (Darwin) +4*2Wi_Benutze interne Resourcen (Darwin) +A*2Wi_Benutze interne Resourcen (Darwin) +P*2Wi_Benutze interne Resourcen (Darwin) +p*2Wi_Benutze interne Resourcen (Darwin) +3*2WI_Die Verwendung der "import"-Abschnitte ein/ausschalten (Windows) +4*2WI_Die Verwendung der "import"-Abschnitte ein/ausschalten (Windows) +A*2WI_Die Verwendung der "import"-Abschnitte ein/ausschalten (Windows) +3*2WN_Erzeuge keinen "relocation code" (notwendig fr debugging) (Windows) +4*2WN_Erzeuge keinen "relocation code" (notwendig fr debugging) (Windows) +A*2WN_Erzeuge keinen "relocation code" (notwendig fr debugging) (Windows) +A*2Wpxxxx_Spezifiziere den Kontrollertyp, m”gliche Werte liefert fpc -i +V*2Wpxxxx_Spezifiziere den Kontrollertyp, m”gliche Werte liefert fpc -i +3*2WR_Erzeuge "relocation code" (Windows) +4*2WR_Erzeuge "relocation code" (Windows) +A*2WR_Erzeuge "relocation code" (Windows) +P*2WF_Spezifiziere "MPW tool type application" (Classic Mac OS) +**2WX_Erm”gliche den executable stack (Linux) +**1X_Programm-Optionen: +**2Xc_šbergebe --shared an den Linker (nur Unix) +**2Xd_Den Standard Bibliotheks-Suchpfad NICHT nutzen (ben”tigt fr cross compile) +**2Xe_Verwende den externen Linker +**2Xg_Erstelle die Debug-Informationen in einer separaten Datei und einen "Debug-Link"-Abschnitt im ausfhrbaren Programm +**2XD_Versuche Units dynamisch zu linken (definiert FPC_LINK_DYNAMIC) +**2Xi_Verwende den internen Linker +**2Xm_Erzeuge die "link map" +**2XM<x>_Setze den Namen der 'main' program Routine (default ist 'main') +**2XP<x>_Stelle den Namen der Compiler-Hilfsprogrammen den Prefix <x> voran +**2Xr<x>_Setze den rlink-Pfad des Linker zu <x> (ben”tigt fr cross compile, siehe ld-Manual fr mehr Informationen) (BeOS, Linux) +**2XR<x>_Stelle allen Linker-Suchpfaden den Namen <x> voran (BeOS, Darwin, FreeBSD, Linux, Mac OS, Solaris) +**2Xs_Entferne alle Symbole aus der ausfhrbaren Datei +**2XS_Versuche Units statisch zu linken (default) (definiert FPC_LINK_STATIC) +**2Xt_Linke mit statischen Bibliotheken (-static wird an den Linker bergeben) +**2XX_Versuche Units smart zu linken (definiert FPC_LINK_SMART) +**1*_ +**1?_Zeigt diese Hilfe an +**1h_Zeigt diese Hilfe ohne Warten an +] + +# +# The End... +# diff --git a/closures/compiler/msg/errorda.msg b/closures/compiler/msg/errorda.msg new file mode 100644 index 0000000000..16f07e1ec2 --- /dev/null +++ b/closures/compiler/msg/errorda.msg @@ -0,0 +1,2501 @@ +# +# $Id: errorda.msg 621 2006-07-02 15:44:03Z chrivers $ +# This file is part of the Free Pascal Compiler +# Copyright (c) 1999-2000 by the Free Pascal Development team +# +# Danish Language File for Free Pascal +# +# Translation by Christian Iversen <chrivers@iversen-net.dk> +# +# This file is encoded in UTF-8, and based on r4084 of errore.eng +# +# 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. +# +# +# The constants are build in the following order: +# <part>_<type>_<txtidentifier> +# +# <part> is the part of the compiler the message is used +# asmr_ assembler parsing +# asmw_ assembler writing/binary writers + +# unit_ unit handling +# scan_ scanner +# parser_ parser +# type_ type checking +# general_ general info +# exec_ calls to assembler, linker, binder +# +# <type> the type of the message it should normally used for +# f_ fatal error +# e_ error +# w_ warning +# n_ note +# h_ hint +# i_ info +# l_ add linenumber +# u_ used +# t_ tried +# c_ conditional +# d_ debug message +# x_ executable informations +# + +# +# General +# +# 01016 is the last used one +# +# BeginOfTeX +% \section{General compiler messages} +% This section gives the compiler messages which are not fatal, but which +% display useful information. The number of such messages can be +% controlled with the various verbosity level \var{-v} switches. +% \begin{description} +general_t_compilername=01000_T_Oversætter: $1 +% When the \var{-vt} switch is used, this line tells you what compiler +% is used. +general_d_sourceos=01001_D_Oversætter OS: $1 +% When the \var{-vd} switch is used, this line tells you what the source +% operating system is. +general_i_targetos=01002_I_Compilerer til OS: $1 +% When the \var{-vd} switch is used, this line tells you what the target +% operating system is. +general_t_exepath=01003_T_Sti til program: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for it's binaries. +general_t_unitpath=01004_T_Sti til units: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for compiled units. You can set this path with the \var{-Fu} +general_t_includepath=01005_T_Sti til include-filer: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for it's include files (files used in \var{\{\$I xxx\}} statements). +% You can set this path with the \var{-I} option. +general_t_librarypath=01006_T_Sti til biblioteker: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for the libraries. You can set this path with the \var{-Fl} option. +general_t_objectpath=01007_T_Sti til objekter: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for object files you link in (files used in \var{\{\$L xxx\}} statements). +% You can set this path with the \var{-Fo} option. +general_i_abslines_compiled=01008_I_$1 linier kompileret, $2 sekunder +% When the \var{-vi} switch is used, the compiler reports the number +% of lines compiled, and the time it took to compile them (real time, +% not program time). +general_f_no_memory_left=01009_F_Ikke mere hukommelse! +% The compiler doesn't have enough memory to compile your program. There are +% several remedies for this: +% \begin{itemize} +% \item If you're using the build option of the compiler, try compiling the +% different units manually. +% \item If you're compiling a huge program, split it up in units, and compile +% these separately. +% \item If the previous two don't work, recompile the compiler with a bigger +% heap (you can use the \var{-Ch} option for this, \seeo{Ch}) +% \end{itemize} +general_i_writingresourcefile=01010_I_Skriver resourcestrengstabel til fil: $1 +% This message is shown when the compiler writes the Resource String Table +% file containing all the resource strings for a program. +general_e_errorwritingresourcefile=01011_E_Skriver resourcestrengtabel til fil: $1 +% This message is shown when the compiler encountered an error when writing +% the Resource String Table file +general_i_fatal=01012_I_Fatal fejl: +% Prefix for Fatal Errors +general_i_error=01013_I_Fejl: +% Prefix for Errors +general_i_warning=01014_I_Advarsel: +% Prefix for Warnings +general_i_note=01015_I_Bemærkning: +% Prefix for Notes +general_i_hint=01016_I_Hint: +% Prefix for Hints +general_e_path_does_not_exist=01017_E_Stien "$1" blev ikke fundet +% The specified path does not exist. +general_f_compilation_aborted=01018_F_Compilering afbrudt +% \end{description} +# +# Scanner +# +# 02063 is the last used one +# +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compiling handling. +% \begin{description} +scan_f_end_of_file=02000_F_Slutning af fil fundet mod forventning +% this typically happens in one of the following cases : +% \begin{itemize} +% \item The source file ends before the final \var{end.} statement. This +% happens mostly when the \var{begin} and \var{end} statements aren't +% balanced; +% \item An include file ends in the middle of a statement. +% \item A comment was not closed +% \end{itemize} +scan_f_string_exceeds_line=02001_F_Streng overskrider slutning af linie +% There is a missing closing ' in a string, so it occupies +% multiple lines. +scan_f_illegal_char=02002_F_Ugyldig karakter "$1" ($2) +% An illegal character was encountered in the input file. +scan_f_syn_expected=02003_F_Syntaxfejl, "$1" forventet men "$2" fundet +% This indicates that the compiler expected a different token than +% the one you typed. It can occur almost everywhere where you make a +% mistake against the pascal language. +scan_t_start_include_file=02004_TL_Læser includefil $1 +% When you provide the \var{-vt} switch, the compiler tells you +% when it starts reading an included file. +scan_w_comment_level=02005_W_Kommentarniveau $1 fundet +% When the \var{-vw} switch is used, then the compiler warns you if +% it finds nested comments. Nested comments are not allowed in Turbo Pascal +% and can be a possible source of errors. +scan_n_ignored_switch=02008_N_Ignorerer compilerindstilling "$1" +% With \var{-vn} on, the compiler warns if it ignores a switch +scan_w_illegal_switch=02009_W_Ugyldig compilerindstilling "$1" +% You included a compiler switch (i.e. \var{\{\$... \}}) which the compiler +% does not recognise +scan_w_switch_is_global=02010_W_Fejlplaceret global compilerindstilling +% The compiler switch is misplaced, and should be located at +% the start of the unit or program. +scan_e_illegal_char_const=02011_E_Ugyldig karakterkonstant +% This happens when you specify a character with its ASCII code, as in +% \var{\#96}, but the number is either illegal, or out of range. +scan_f_cannot_open_input=02012_F_Kan ikke Ã¥bne filen "$1" +% \fpc cannot find the program or unit source file you specified on the +% command line. +scan_f_cannot_open_includefile=02013_F_Kan ikke Ã¥bne includefilen "$1" +% \fpc cannot find the source file you specified in a \var{\{\$include ..\}} +% statement. +scan_e_illegal_pack_records=02015_E_Ugyldig strukturopstillingsspecifikation "$1" +% You are specifying the \var{\{\$PACKRECORDS n\} } or \var{\{\$ALIGN n\} } +% with an illegal value for \var{n}. For \$PACKRECORDS valid alignments are 1, 2, 4, 8, 16, 32, C, +% NORMAL, DEFAULT, and for \$ALIGN valid alignment are 1, 2, 4, 8, 16, 32, ON, +% OFF. Under mode MacPas \$ALIGN also supports MAC68K, POWER and RESET. +scan_e_illegal_pack_enum=02016_E_Ugyldig enumerations-minimumsstørrelsespecifikation "$1" +% You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for +% \var{n}. Only 1,2,4, NORMAL or DEFAULT are valid here. +scan_e_endif_expected=02017_E_$ENDIF forventet til $1 $2 defineret i $3 linie $4 +% Your conditional compilation statements are unbalanced. +scan_e_preproc_syntax_error=02018_E_Syntaxfejl under læsning af betinget kompileret udtryk +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc compiler +% directives. +scan_e_error_in_preproc_expr=02019_E_Evaluerer betinget kompileret udtryk +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc compiler +% directives. +scan_w_macro_cut_after_255_chars=02020_W_Makroindhold er begrænset til 255 tegns længde +% The contents of macros cannot be longer than 255 characters. +scan_e_endif_without_if=02021_E_ENDIF uden IF(N)DEF +% Your \var{\{\$IFDEF ..\}} and {\{\$ENDIF\}} statements aren't balanced. +scan_f_user_defined=02022_F_Brugerdefineret: $1 +% A user defined fatal error occurred. see also the \progref +scan_e_user_defined=02023_E_Brugerdefineret: $1 +% A user defined error occurred. see also the \progref +scan_w_user_defined=02024_W_Brugerdefineret: $1 +% A user defined warning occurred. see also the \progref +scan_n_user_defined=02025_N_Brugerdefineret: $1 +% A user defined note was encountered. see also the \progref +scan_h_user_defined=02026_H_Brugerdefineret: $1 +% A user defined hint was encountered. see also the \progref +scan_i_user_defined=02027_I_Brugerdefineret: $1 +% User defined information was encountered. see also the \progref +scan_e_keyword_cant_be_a_macro=02028_E_Makroer kan ikke omdefinere nøgleord +% You cannot redefine keywords with macros. +scan_f_macro_buffer_overflow=02029_F_Overløb under læsning eller udvidelse af makro +% Your macro or it's result was too long for the compiler. +scan_w_macro_too_deep=02030_W_Makroudfoldning har oversteget 16 niveauer +% When expanding a macro, macros have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_w_wrong_styled_switch=02031_W_Compilerindstillinger understøttes ikke i // denne slags kommentarer +% Compiler switches should be in normal pascal style comments. +scan_d_handling_switch=02032_DL_HÃ¥ndterer indstilling "$1" +% When you set debugging info on (\var{-vd}) the compiler tells you when it +% is evaluating conditional compile statements. +scan_c_endif_found=02033_CL_ENDIF $1 fundet +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifdef_found=02034_CL_IFDEF $1 fundet, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifopt_found=02035_CL_IFOPT $1 fundet, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_if_found=02036_CL_IF $1 fundet, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifndef_found=02037_CL_IFNDEF $1 fundet, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_else_found=02038_CL_ELSE $1 fundet, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_skipping_until=02039_CL_Springer over indtil... +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements, and whether it is skipping or +% compiling parts. +scan_i_press_enter=02040_I_Tryk <return> for at fortsætte +% When the \var{-vi} switch is used, the compiler stops compilation +% and waits for the \var{Enter} key to be pressed when it encounters +% a \var{\{\$STOP\}} directive. +scan_w_unsupported_switch=02041_W_Ugyldig compilerindstilling "$1" +% When warnings are turned on (\var{-vw}) the compiler warns you about +% unsupported switches. This means that the switch is used in Delphi or +% Turbo Pascal, but not in \fpc +scan_w_illegal_directive=02042_W_Ugyldig compilerindstilling "$1" +% When warings are turned on (\var{-vw}) the compiler warns you about +% unrecognised switches. For a list of recognised switches, \progref +scan_t_back_in=02043_TL_Tilbage i $1 +% When you use (\var{-vt}) the compiler tells you when it has finished +% reading an include file. +scan_w_unsupported_app_type=02044_W_Ugyldig programtype: "$1" +% You get this warning, ff you specify an unknown application type +% with the directive \var{\{\$APPTYPE\}} +scan_w_app_type_not_support=02045_W_APPTYPE understøttes ikke af det OS der kompileres til +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_w_description_not_support=02046_W_DESCRIPTION understøttes ikke af det OS der kompileres til +% The \var{\{\$DESCRIPTION\}} directive is not supported on this target OS +scan_n_version_not_support=02047_N_VERSION understøttes ikke af det OS der kompileres til +% The \var{\{\$VERSION\}} directive is not supported on this target OS +scan_n_only_exe_version=02048_N_VERSION er kun til programmer og DLL-filer +% The \var{\{\$VERSION\}} directive is only used for executable or DLL sources. +scan_w_wrong_version_ignored=02049_W_Direktivet VERSION har forkert format "$1" +% The \var{\{\$VERSION\}} directive format is majorversion.minorversion +% where majorversion and minorversion are words. +scan_e_illegal_asmmode_specifier=02050_E_Ugyldig assemblerstil angivet "$1" +% When you specify an assembler mode with the \var{\{\$ASMMODE xxx\}} +% the compiler didn't recognize the mode you specified. +scan_w_no_asm_reader_switch_inside_asm=02051_W_Kan ikke skifte assemblerlæser midt i en assemblerblok. Skifter til "$1" i næste blok +% It is not possible to switch from one assembler reader to another +% inside an assmebler block. The new reader will be used for next +% assembler statements only. +scan_e_wrong_switch_toggle=02052_E_Forkert indstillingsparameter. Brug ON/OFF eller +/- +% You need to use ON or OFF or a + or - to toggle the switch +scan_e_resourcefiles_not_supported=02053_E_Resourcefiler understøttes ikke af mÃ¥l-operativsystemet +% The target you are compiling for doesn't support resource files. +scan_w_include_env_not_found=02054_W_Environment-værdien "$1" er ikke defineret +% The included environment variable cannot be found in the environment, it will +% be replaced by an empty string instead. +scan_e_invalid_maxfpureg_value=02055_E_Ugyldig værdi for FPU-registergrænse +% Valid values for this directive are 0..8 and NORMAL/DEFAULT +scan_w_only_one_resourcefile_supported=02056_W_MÃ¥l-systemet understøtter kun én resourcefil +% The target you are compiling for supports only one resource file. +% The first resource file found is used, the others are discarded. +scan_w_macro_support_turned_off=02057_W_Makrosupport er slÃ¥et fra +% A macro declaration has been found, but macro support is currently off, +% so the declaration will be ignored. To turn macro support on compile with +% -Sm on the commandline or add {$MACRO ON} in the source +scan_e_invalid_interface_type=02058_E_Ugyldig interface-type angivet. Gyldige værdier er COM, CORBA eller DEFAULT. +% The interface type that was specified is not supported +scan_w_appid_not_support=02059_W_APPID understøttes kun til PalmOS +% The \var{\{\$APPID\}} directive is only supported for the PalmOS target. +scan_w_appname_not_support=02060_W_APPNAME understøttes kun til PalmOS +% The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target. +scan_e_string_exceeds_255_chars=02061_E_Strengkonstanter kan ikke være længere end 255 tegn +% A single string constant can contain at most 255 chars. Try splitting up the +% string in multiple smaller parts and concatenate them with a + operator. +scan_f_include_deep_ten=02062_F_Include-filer overskrider dypdegrænsen pÃ¥ 16 niveauer +% When including include files the files have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_e_too_many_push=02063_F_For mange niveauer af PUSH +% A maximum of 20 levels is allowed. This error occur only in mode MacPas. +scan_e_too_many_pop=02064_E_POP uden forudgÃ¥ende PUSH +% This error occur only in mode MacPas. +scan_e_error_macro_lacks_value=02065_E_Makro "$1" har ingen værdi +% Thus the conditional compiling expression cannot be evaluated. +% \end{description} +# +# Parser +# +# 03192 is the last used one +# +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your pascal constructs +% are correct. +% \begin{description} +scan_e_wrong_switch_toggle_default=02066_E_Forkert indstillingsværdi, brug ON/OFF/DEFAULT eller +/-/* +% You need to use ON or OFF or DEFAULT or a + or - or * to toggle the switch +scan_e_mode_switch_not_allowed=02067_E_Tilstandstypeindstilling "$1" ikke tilladt her +% A mode switch has already been encountered, or, in case of option -Mmacpas, +% a mode switch occur after UNIT. +scan_e_error_macro_undefined=02068_E_Kompileringstidsvariablen eller makroen "$1" er ikke defineret +% Thus the conditional compile time expression cannot be evaluated. Only in mode MacPas. +scan_e_utf8_bigger_than_65535=02069_E_UTF-8 kode større end 65535 fundet +% \fpc handles utf-8 strings internally as widestrings e.g. the char codes are limited to 65535 +scan_e_utf8_malformed=02070_E_Ugyldig UTF-8-streng +% The given string isn't a valid UTF-8 string +scan_c_switching_to_utf8=02071_C_UTF-8-signatur fundet, benytter UTF-8-kodning +% The compiler found an UTF-8 encoding signature (\$ef, \$bb, \$bf) at the beginning of a file, +% so it interprets it as an UTF-8 file +scan_e_compile_time_typeerror=02072_E_Kompileringstidsudtryk: Forventede $1, men fik $2 ved $3 +% Type check of a compile time expression failed. +scan_n_app_type_not_support=02073_N_APPTYPE understøttes ikke af mÃ¥l-operativsystemet +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +% \end{description} +# +# Parser +# +# 03192 is the last used one +# +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your pascal constructs +% are correct. +% \begin{description} +parser_e_syntax_error=03000_E_Parser - syntaxfejl +% An error against the Turbo Pascal language was encountered. This happens +% typically when an illegal character is found in the sources file. +parser_e_dont_nest_interrupt=03004_E_INTERRUPT-procedure kan ikke indlejres +% An \var{INTERRUPT} procedure must be global. +parser_w_proc_directive_ignored=03005_W_Proceduretype "$1" ignoreret +% The specified is ignored by FPC programs. +parser_e_no_overload_for_all_procs=03006_E_Ikke alle erklæringer af "$1" er angivet med OVERLOAD +% When you want to use overloading using the \var{OVERLOAD} directive, then +% all declarations need to have \var{OVERLOAD} specified. +parser_e_export_name_double=03008_E_Funktionsnavnet "$1" er angivet flere gange i en EXPORT-erklæring +% Exported function names inside a specific DLL must all be different +parser_e_export_ordinal_double=03009_E_Funktionsindex $1 er angivet flere gange i en EXPORT-erklæring +% Exported function names inside a specific DLL must all be different +parser_e_export_invalid_index=03010_E_Ugyldigt index for eksporteret funktion +% DLL function index must be in the range \var{1..\$FFFF} +parser_w_parser_reloc_no_debug=03011_W_Relokérbar DLL eller program $1 har ikke-fungerende debug-info. SlÃ¥et fra. +parser_w_parser_win32_debug_needs_WN=03012_W_For at tillade debugging i win32-kode, skal relokérbarhed slÃ¥s fra med -WN +% Stabs info is wrong for relocatable DLL or EXES use -WN +% if you want to debug win32 executables. +parser_e_constructorname_must_be_init=03013_E_Constructor-navnet skal være INIT +% You are declaring an object constructor with a name which is not \var{init}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_destructorname_must_be_done=03014_E_Destructor-navnet skal være DONE +% You are declaring an object destructor with a name which is not \var{done}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_proc_inline_not_supported=03016_E_Proceduretypen INLINE er ikke understøttet +% You tried to compile a program with C++ style inlining, and forgot to +% specify the \var{-Si} option (\seeo{Si}). The compiler does not support C++ +% styled inlining by default. +parser_w_constructor_should_be_public=03018_W_Constructor bør være public +% Constructors must be in the 'public' part of an object (class) declaration. +parser_w_destructor_should_be_public=03019_W_Destructor bør være public +% Destructors must be in the 'public' part of an object (class) declaration. +parser_n_only_one_destructor=03020_N_En klasse skal kun have én destructor +% You can declare only one destructor for a class. +parser_e_no_local_objects=03021_E_Lokale klassedefinitioner er ikke tilladt +% Classes must be defined globally. They cannot be defined inside a +% procedure or function +parser_f_no_anonym_objects=03022_F_Anonyme klassedefinitioner er ikke tilladt +% An invalid object (class) declaration was encountered, i.e. an +% object or class without methods that isn't derived from another object or +% class. For example: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% will trigger this error. +parser_n_object_has_no_vmt=03023_N_Objektet "$1" har ingen VMT +% This is a note indicating that the declared object has no +% virtual method table. +parser_e_illegal_parameter_list=03024_E_Ugyldig parameterliste +% You are calling a function with parameters that are of a different type than +% the declared parameters of the function. +parser_e_wrong_parameter_size=03026_E_Forkert antal parametre angivet +% There is an error in the parameter list of the function or procedure, +% the number of parameters is not correct. +parser_e_overloaded_no_procedure=03027_E_Overloaded navn "$1" er ikke en funktion +% The compiler encountered a symbol with the same name as an overloaded +% function, but it is not a function it can overload. +parser_e_overloaded_have_same_parameters=03028_E_Overloadede funktioner har samme parametre +% You're declaring overloaded functions, but with the same parameter list. +% Overloaded function must have at least 1 different parameter in their +% declaration. +parser_e_header_dont_match_forward=03029_E_Functionserklæring passer ikke med forward-erklæringen $1 +% You declared a function with same parameters but +% different result type or function modifiers. +parser_e_header_different_var_names=03030_E_Funktionserklæringen "$1" passer ikke med forward - var-navn ændrer $2 => $3 +% You declared the function in the \var{interface} part, or with the +% \var{forward} directive, but define it with a different parameter list. +parser_n_duplicate_enum=03031_N_Værdier i enumerate-typer skal være stigende +% \fpc allows enumeration constructions as in C. Given the following +% declaration two declarations: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% The second declaration would produce an error. \var{A\_UAS} needs to have a +% value higher than \var{A\_E}, i.e. at least 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_"With" kan ikke bruges til variabler i et andet segment +% With stores a variable locally on the stack, +% but this is not possible if the variable belongs to another segment. +parser_e_too_much_lexlevel=03034_E_Funktionsindlejring over 31 niveauer +% You can nest function definitions only 31 times. +parser_e_range_check_error=03035_E_VærdiomrÃ¥defejl under evaluering af konstanter +% The constants are out of their allowed range. +parser_w_range_check_error=03036_W_VærdiomrÃ¥defejl under evaluering af konstanter +% The constants are out of their allowed range. +parser_e_double_caselabel=03037_E_Gentaget case-værdi +% You are specifying the same label 2 times in a \var{case} statement. +parser_e_case_lower_less_than_upper_bound=03038_E_Øvre grænse for case-værdiomrÃ¥de er mindre end den nedre grænse +% The upper bound of a \var{case} label is less than the lower bound and this +% is useless +parser_e_type_const_not_possible=03039_E_Typegivne konstanter er ikke tilladt i klasser +% You cannot declare a constant of type class or object. +parser_e_no_overloaded_procvars=03040_E_Tildeling af overloaded funktion til procedurel variabel ikke tilladt +% You are trying to assign an overloaded function to a procedural variable. +% This is not allowed +parser_e_invalid_string_size=03041_E_Strenglængdegrænse skal være mellem 1 og 255 +% The length of a shortstring in Pascal is limited to 255 characters. You are +% trying to declare a string with length lower than 1 or greater than 255 +parser_w_use_extended_syntax_for_objects=03042_W_Brug udvidet syntax NEW og DISPOSE til instantiering af objekter +% If you have a pointer \var{a} to a class type, then the statement +% \var{new(a)} will not initialize the class (i.e. the constructor isn't +% called), although space will be allocated. you should issue the +% \var{new(a,init)} statement. This will allocate space, and call the +% constructor of the object +parser_w_no_new_dispose_on_void_pointers=03043_W_Brug af NEW eller DISPOSE pÃ¥ typeløse pointere er meningsløst +parser_e_no_new_dispose_on_void_pointers=03044_E_Brug af NEW eller DISPOSE pÃ¥ typeløse pointere ikke muligt +% You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer +% because no size is associated to an untyped pointer. +% Accepted for compatibility in \var{tp} and \var{delphi} modes. +parser_e_class_id_expected=03045_E_Klassenavn forventet +% This happens when the compiler scans a procedure declaration that contains +% a dot, +% i.e., a object or class method, but the type in front of the dot is not +% a known type. +parser_e_no_type_not_allowed_here=03046_E_Typenavn ikke tilladt her +% You cannot use a type inside an expression. +parser_e_methode_id_expected=03047_E_Metodenavn forventet +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_e_header_dont_match_any_member=03048_E_Funktionserklæring passer ikke med nogen metoder i klassen "$1" +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_d_procedure_start=03049_DL_procedure/funktion $1 +% When using the \var{-vd} switch, the compiler tells you when it starts +% processing a procedure or function implementation. +parser_e_error_in_real=03050_E_Ugyldig kommetalskonstant +% The compiler expects a floating point expression, and gets something else. +parser_e_fail_only_in_constructor=03051_E_FAIL kan kun bruges i en constructor +% You are using the \var{fail} keyword outside a constructor method. +parser_e_no_paras_for_destructor=03052_E_En destructor kan ikke have parametre +% You are declaring a destructor with a parameter list. Destructor methods +% cannot have parameters. +parser_e_only_class_methods_via_class_ref=03053_E_Kun klassemetoder kan refereres med en klassereference +% This error occurs in a situation like the following: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} is not a class method and hence cannot be called with a class +% reference. +parser_e_only_class_methods=03054_E_Kun klassemetoder kan tilgÃ¥s i klassemetoder +% This is related to the previous error. You cannot call a method of an object +% from a inside a class method. The following code would produce this error: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% Because free is a normal method of a class it cannot be called from a class +% method. +parser_e_case_mismatch=03055_E_Constant-type of CASE-type stemmer ikke overens +% One of the labels is not of the same type as the case variable. +parser_e_illegal_symbol_exported=03056_E_Symbolet kan ikke eksporteres fra et bibliotek +% You can only export procedures and functions when you write a library. You +% cannot export variables or constants. +parser_w_should_use_override=03057_W_En nedarvet metode skjules af "$1" +% A method that is declared \var{virtual} in a parent class, should be +% overridden in the descendent class with the \var{override} directive. If you +% don't specify the \var{override} directive, you will hide the parent method; +% you will not override it. +parser_e_nothing_to_be_overridden=03058_E_Der er ingen metode i super-klassen at override: "$1" +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_no_procedure_to_access_property=03059_E_Ingen læseadgang til egenskaben +% You specified no \var{read} directive for a property. +parser_w_stored_not_implemented=03060_W_Gemte egenskaber er endnu ikke implementeret +% The \var{stored} directive is not yet implemented +parser_e_ill_property_access_sym=03061_E_Ugyldig værdi for egenskabsadgang +% There is an error in the \var{read} or \var{write} directives for an array +% property. When you declare an array property, you can only access it with +% procedures and functions. The following code woud cause such an error. +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_Kan ikke tilgÃ¥ et protected felt i et objekt her +% Fields that are declared in a \var{protected} section of an object or class +% declaration cannot be accessed outside the module wher the object is +% defined, or outside descendent object methods. +parser_e_cant_access_private_member=03063_E_Kan ikke tilgÃ¥ et private felt i et objekt her +% Fields that are declared in a \var{private} section of an object or class +% declaration cannot be accessed outside the module where the class is +% defined. +parser_e_overridden_methods_not_same_ret=03066_E_Metoder med "override" skal have samme retur-type: "$2" er overridet af "$1" der har en anden retur-type +% If you declare overridden methods in a class definition, they must +% have the same return type. +parser_e_dont_nest_export=03067_E_EXPORT-erklærede funktioner kan ikke indlejres +% You cannot declare a function or procedure within a function or procedure +% that was declared as an export procedure. +parser_e_methods_dont_be_export=03068_E_Metoder kan ikke EXPORT'es +% You cannot declare a procedure that is a method for an object as +% \var{export}ed. +parser_e_call_by_ref_without_typeconv=03069_E_Kald med var-parametre skal passe præcist: Fandt "$1", "$2" forventet +% When calling a function declared with \var{var} parameters, the variables in +% the function call must be of exactly the same type. There is no automatic +% type conversion. +parser_e_no_super_class=03070_E_Klassen er ikke en super-klasse af den angivne klasse +% When calling inherited methods, you are trying to call a method of a non-related +% class. You can only call an inherited method of a parent class. +parser_e_self_not_in_method=03071_E_SELF kan kun bruges i objekter +% You are trying to use the \var{self} parameter outside an object's method. +% Only methods get passed the \var{self} parameters. +parser_e_generic_methods_only_in_methods=03072_E_methods can be only in other methods called direct with type identifier of the class +% A construction like \var{sometype.somemethod} is only allowed in a method. +parser_e_illegal_colon_qualifier=03073_E_Ugyldig brug af ':' +% You are using the format \var{:} (colon) 2 times on an expression that +% is not a real expression. +parser_e_illegal_set_expr=03074_E_Værdigrænsefejl i set-constructor, eller genanvendt element-værdi +% The declaration of a set contains an error. Either one of the elements is +% outside the range of the set type, either two of the elements are in fact +% the same. +parser_e_pointer_to_class_expected=03075_E_Pointer til objekt forventet +% You specified an illegal type in a \var{new} statement. +% The extended syntax of \var{new} needs an object as a parameter. +parser_e_expr_have_to_be_constructor_call=03076_E_Udtryk skal være constructor-kald +% When using the extended syntax of \var{new}, you must specify the constructor +% method of the object you are trying to create. The procedure you specified +% is not a constructor. +parser_e_expr_have_to_be_destructor_call=03077_E_Udtryk skal være destructor-kald +% When using the extended syntax of \var{dispose}, you must specify the +% destructor method of the object you are trying to dispose of. +% The procedure you specified is not a destructor. +parser_e_invalid_record_const=03078_E_Ugyldig rækkefølge af strukturelementer +% When declaring a constant record, you specified the fields in the wrong +% order. +parser_e_false_with_expr=03079_E_Udtrykket skal være en klasse eller struktur +% A \var{with} statement needs an argument that is of the type \var{record} +% or \var{class}. You are using \var{with} on an expression that is not of +% this type. +parser_e_void_function=03080_E_Procedurer kan ikke returnere værdier +% In \fpc, you can specify a return value for a function when using +% the \var{exit} statement. This error occurs when you try to do this with a +% procedure. Procedures cannot return a value. +parser_e_only_methods_allowed=03081_E_constructors destructors og class operators skal være metoder +% You're declaring a procedure as destructor, constructor or class operator, when the +% procedure isn't a class method. +parser_e_operator_not_overloaded=03082_E_Operatoren er ikke overloaded +% You're trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_no_such_assignment=03083_E_Umuligt at overloade tildeling for ensartede typer +% You can not overload assignment for types +% that the compiler considers as equal. +parser_e_overload_impossible=03084_E_Umuligt at overloade operatoren +% The combination of operator, arguments and return type are +% incompatible. +parser_e_no_reraise_possible=03085_E_Re-raise er ikke muligt her +% You are trying to raise an exception where it is not allowed. You can only +% raise exceptions in an \var{except} block. +parser_e_no_new_or_dispose_for_classes=03086_E_Den udvidede syntax af new og dispose er ikke gyldig for klasser +% You cannot generate an instance of a class with the extended syntax of +% \var{new}. The constructor must be used for that. For the same reason, you +% cannot call \var{dispose} to de-allocate an instance of a class, the +% destructor must be used for that. +parser_e_procedure_overloading_is_off=03088_E_Procedure overloading er slÃ¥et fra +% When using the \var{-So} switch, procedure overloading is switched off. +% Turbo Pascal does not support function overloading. +parser_e_overload_operator_failed=03089_E_Det er ikke muligt at overloade denne operator (overload "=" i stedet) +% You are trying to overload an operator which cannot be overloaded. +% The following operators can be overloaded : +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_Sammenligningsoperationer skal returnere en sandhedsværdi +% When overloading the \var{=} operator, the function must return a boolean +% value. +parser_e_only_virtual_methods_abstract=03091_E_Kun virtuelle metoder kan være abstrakte +% You are declaring a method as abstract, when it is not declared to be +% virtual. +parser_f_unsupported_feature=03092_F_Ikke-understøttet konstruktion +% You're trying to force the compiler into doing something it cannot do yet. +parser_e_mix_of_classes_and_objects=03093_E_Det er ikke gyldigt at blande forskellige typer objekter (class, object, interface, etc) +% You cannot derive \var{objects}, \var{classes}, \var{cppclasses} and \var{interfaces} interttwined . E.g. +% a class cannot have an object as parent and vice versa. +parser_w_unknown_proc_directive_ignored=03094_W_Ukendt procedure-direktev blev ignoreret: "$1" +% The procedure directive you specified is unknown. +parser_e_absolute_only_one_var=03095_E_Absolute kan kun associere én variabel +% You cannot specify more than one variable before the \var{absolute} directive. +% Thus, the following construct will provide this error: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +% \item [ absolute can only be associated a var or const ] +% The address of a \var{absolute} directive can only point to a variable or a +% typed constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_absolute_only_to_var_or_const=03096_E_Absolute kan kun associeres med én variabel eller konstant +% The address of a \var{absolute} directive can only point to a variable or +% constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_initialized_only_one_var=03097_E_Kun én variabel kan initialiseres +% You cannot specify more than one variable with a initial value +% in Delphi mode. +parser_e_abstract_no_definition=03098_E_Abstrakte metoder mÃ¥ ikke implementeres +% Abstract methods can only be declared, you cannot implement them. They +% should be overridden by a descendant class. +parser_e_overloaded_must_be_all_global=03099_E_Denne overloadede funktion kan ikke være lokal (skal eksporteres) +% You are defining a overloaded function in the implementation part of a unit, +% but there is no corresponding declaration in the interface part of the unit. +parser_w_virtual_without_constructor=03100_W_Virtuelle metoder er brugt uden at have en constructor: "$1" +% If you declare objects or classes that contain virtual methods, you need +% to have a constructor and destructor to initialize them. The compiler +% encountered an object or class with virtual methods that doesn't have +% a constructor/destructor pair. +parser_c_macro_defined=03101_CL_Makro defineret: $1 +% When \var{-vc} is used, the compiler tells you when it defines macros. +parser_c_macro_undefined=03102_CL_Makro fjernet: $1 +% When \var{-vc} is used, the compiler tells you when it undefines macros. +parser_c_macro_set_to=03103_CL_Makro $1 sat til $2 +% When \var{-vc} is used, the compiler tells you what values macros get. +parser_i_compiling=03104_I_Compilerer $1 +% When you turn on information messages (\var{-vi}), the compiler tells you +% what units it is recompiling. +parser_u_parsing_interface=03105_UL_Parser interface-delen af unit $1 +% This tells you that the reading of the interface +% of the current unit starts +parser_u_parsing_implementation=03106_UL_Parser implementation-delen af unit $1 +% This tells you that the code reading of the implementation +% of the current unit, library or program starts +parser_d_compiling_second_time=03107_DL_Compilerer $1 for anden gang +% When you request debug messages (\var{-vd}) the compiler tells you what +% units it recompiles for the second time. +parser_e_no_property_found_to_override=03109_E_Ingen egenskab at override +% You want to overrride a property of a parent class, when there is, in fact, +% no such property in the parent class. +parser_e_only_one_default_property=03110_E_Kun én default-egenskab tilladt +% You specified a property as \var{Default}, but the class already has a +% default property, and a class can have only one default property. +parser_e_property_need_paras=03111_E_Default-egenskaben skal være et array +% Only array properties of classes can be made \var{default} properties. +parser_e_constructor_cannot_be_not_virtual=03112_E_Virtuelle constructors er kun tilladt i klassemodellen +% You cannot have virtual constructors in objects. You can only have them +% in classes. +parser_e_no_default_property_available=03113_E_Ingen default-egenskab tilgængelig +% You are trying to access a default property of a class, but this class (or one of +% it's ancestors) doesn't have a default property. +parser_e_cant_have_published=03114_E_Klassen kan ikke have en published-sektion, brug {$M+}-indstillingen +% If you want a \var{published} section in a class definition, you must +% use the \var{\{\$M+\}} switch, whch turns on generation of type +% information. +parser_e_forward_declaration_must_be_resolved=03115_E_Forward-erklæring af klasse "$1" skal løses her, for at bruge klassen som super-klasse +% To be able to use an object as an ancestor object, it must be defined +% first. This error occurs in the following situation: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% Where \var{ParentClass} is declared but not defined. +parser_e_no_local_operator=03116_E_Lokale operatorer ikke understøttet +% You cannot overload locally, i.e. inside procedures or function +% definitions. +parser_e_proc_dir_not_allowed_in_interface=03117_E_Procedure-direktivet "$1" er ikke tilladt i interface-sektionen +% This procedure directive is not allowed in the \var{interface} section of +% a unit. You can only use it in the \var{implementation} section. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_Procedure-direktivet "$1" er ikke tilladt i implementation-sektionen +% This procedure directive is not defined in the \var{implementation} section of +% a unit. You can only use it in the \var{interface} section. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_Procedure-direktivet "$1" er ikke tilladt i procvar-erklæring +% This procedure directive cannot be part of a procedural or function +% type declaration. +parser_e_function_already_declared_public_forward=03120_E_Funktionen "$1" er allerede erklæret Public/Forward +% You will get this error if a function is defined as \var{forward} twice. +% Or it is once in the \var{interface} section, and once as a \var{forward} +% declaration in the \var{implmentation} section. +parser_e_not_external_and_export=03121_E_Kan ikke bruge bÃ¥de EXPORT og EXTERNAL +% These two procedure directives are mutually exclusive +parser_w_not_supported_for_inline=03123_W_Deklarationen "$1" er endnu ikke understøttet i inline procedurer/funktioner +% Inline procedures don't support this declaration. +parser_w_inlining_disabled=03124_W_Inlining slÃ¥et fra +% Inlining of procedures is disabled. +parser_i_writing_browser_log=03125_I_Skriver browser-log $1 +% When information messages are on, the compiler warns you when it +% writes the browser log (generated with the \var{\{\$Y+ \}} switch). +parser_h_maybe_deref_caret_missing=03126_H_MÃ¥ske mangler en pointer-dereference +% The compiler thinks that a pointer may need a dereference. +parser_f_assembler_reader_not_supported=03127_F_Valgt assembler-læser er ikke understøttet +% The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not +% supported. The compiler can be compiled with or without support for a +% particular assembler reader. +parser_e_proc_dir_conflict=03128_E_Procedure-direktivet "$1" er i konflikt med andre direktiver +% You specified a procedure directive that conflicts with other directives. +% for instance \var{cdecl} and \var{pascal} are mutually exclusive. +parser_e_call_convention_dont_match_forward=03129_E_Kaldkonvention passer ikke med forward-erklæring +% This error happens when you declare a function or procedure with +% e.g. \var{cdecl;} but omit this directive in the implementation, or vice +% versa. The calling convention is part of the function declaration, and +% must be repeated in the function definition. +parser_e_property_cant_have_a_default_value=03131_E_Egenskaben kan ikke have default-værdi +% Set properties or indexed properties cannot have a default value. +parser_e_property_default_value_must_const=03132_E_Default-værdien for en egenskab skal være konstant +% The value of a \var{default} declared property must be known at compile +% time. The value you specified is only known at run time. This happens +% .e.g. if you specify a variable name as a default value. +parser_e_cant_publish_that=03133_E_Variabler kan ikke være published, med mindre de er klasser +% Only class type variables can be in a \var{published} section of a class +% if they are not declared as a property. +parser_e_cant_publish_that_property=03134_E_Egenskabs-typen er ikke understøttet i published +% Properties in a \var{published} section cannot be array properties. +% they must be moved to public sections. Properties in a \var{published} +% section must be an ordinal type, a real type, strings or sets. +parser_e_empty_import_name=03136_E_Et import-navn er krævet +% Some targets need a name for the imported procedure or a \var{cdecl} specifier +parser_e_division_by_zero=03138_E_Division med nul +% There is a divsion by zero encounted +parser_e_invalid_float_operation=03139_E_Ugyldig floating-point operation +% An operation on two real type values produced an overflow or a division +% by zero. +parser_e_array_lower_less_than_upper_bound=03140_E_Øvre grænse er mindre end nedre grænse +% The upper bound of a an array declaration is less than the lower bound and this +% is not possible +parser_w_string_too_long=03141_W_Strengen "$1" er længere end "$2" +% The size of the constant string is larger than the size you specified in +% string type definition +parser_e_string_larger_array=03142_E_Strenglængde er større end længden af karakter-arrayet +% The size of the constant string is larger than the size you specified in +% the array[x..y] of char definition +parser_e_ill_msg_expr=03143_E_Ugyldigt udtryk efter beskedddirektiv +% \fpc supports only integer or string values as message constants +parser_e_ill_msg_param=03144_E_Procedurerer til beskedhÃ¥ndtering kan kun tage én parameter, der skal være en reference (var) +% A method declared with the \var{message}-directive as message handler +% can take only one parameter which must be declared as call by reference +% Parameters are declared as call by reference using the \var{var}-directive +parser_e_duplicate_message_label=03145_E_Gentaget besked-værdi: "$1" +% A label for a message is used twice in one object/class +parser_e_self_in_non_message_handler=03146_E_"Self" kan kun være en eksplicit parameter i metoder der er beskedhandlere +% The self parameter can only be passed explicitly to a method which +% is declared as message handler. +parser_e_threadvars_only_sg=03147_E_TrÃ¥dvariabler kan kun erklæres static eller globalt +% Threadvars must be static or global, you can't declare a thread +% local to a procedure. Local variables are always local to a thread, +% because every thread has it's own stack and local variables +% are stored on the stack +parser_f_direct_assembler_not_allowed=03148_F_Direkte assembler er ikke understøttet i det binære udformat +% You can't use direct assembler when using a binary writer, choose an +% other outputformat or use another assembler reader +parser_w_no_objpas_use_mode=03149_W_Inkludér ikke unit'en OBJPAS manuelt, brug i stedet {$mode objfpc} eller {$mode delphi} +% You are trying to load the ObjPas unit manually from a uses clause. This is +% not a good idea. Use the \var{\{\$mode objfpc\}} or +% \var{\{\$mode delphi\}} +% directives which load the unit automatically +parser_e_no_object_override=03150_E_OVERRIDE kan ikke bruges i objekter +% Override is not supported for objects, use \var{virtual} instead to override +% a method of a parent object +parser_e_cant_use_inittable_here=03151_E_Datatyper der kræver initialisering/afslutning kan ikke bruges i en variantstruktur +% Some data type (e.g. \var{ansistring}) needs initialization/finalization +% code which is implicitly generated by the compiler. Such data types +% can't be used in the variant part of a record. +parser_e_resourcestring_only_sg=03152_E_Strengresourcer kan kun være statiske eller globale +% Resourcestring can not be declared local, only global or using the static +% directive. +parser_e_exit_with_argument_not__possible=03153_E_Exit med parametre kan ikke bruges her +% an exit statement with an argument for the return value can't be used here, this +% can happen e.g. in \var{try..except} or \var{try..finally} blocks +parser_e_stored_property_must_be_boolean=03154_E_Storage-symbolet skal være en sandhedsværdi +% If you specify a storage symbol in a property declaration, it must be of +% the type boolean +parser_e_ill_property_storage_sym=03155_E_Dette symbol er ikke tilladt som storage-symbol +% You can't use this type of symbol as storage specifier in property +% declaration. You can use only methods with the result type boolean, +% boolean class fields or boolean constants +parser_e_only_publishable_classes_can__be_published=03156_E_Kun klasser der er kompileret i med {$M+}-indstillingen kan bruge published +% In the published section of a class can be only class as fields used which +% are compiled in \var{\{\$M+\}} or which are derived from such a class. Normally +% such a class should be derived from TPersitent +parser_e_proc_directive_expected=03157_E_Procedure-direktiv forventet +% When declaring a procedure in a const block you used a ; after the +% procedure declaration after which a procedure directive must follow. +% Correct declarations are: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_Værdien for egenskabs-indexet skal være en ordinal-type +% The value you use to index a property must be of an ordinal type, for +% example an integer or enumerated type. +parser_e_procname_to_short_for_export=03159_E_Procedurenavn for kort til at eksportere +% The length of the procedure/function name must be at least 2 characters +% long. This is because of a bug in dlltool which doesn't parse the .def +% file correct with a name of length 1. +parser_e_dlltool_unit_var_problem=03160_E_Intet DEFFILE-opslag kan genereres for variabler der er globale i en unit +parser_e_dlltool_unit_var_problem2=03161_E_Kompilér uden -WD indstillingen +% You need to compile this file without the -WD switch on the +% commandline +parser_f_need_objfpc_or_delphi_mode=03162_F_Du skal bruge ObjFpc (-S2) eller Delphi (-Sd)-mode for at kompilere denne fil +% You need to use {$mode objfpc} or {$mode delphi} to compile this file. +% Or use the equivalent commandline switches -S2 or -Sd. +parser_e_no_export_with_index_for_target=03163_E_Kan ikke eksportere med index under $1 +% Exporting of functions or procedures with a specified index is not +% supported on this target. +parser_e_no_export_of_variables_for_target=03164_E_Eksport af variabler ikke understøttet af mÃ¥lsystemet $1 +% Exporting of variables is not supported on this target. +parser_e_improper_guid_syntax=03165_E_Ugyldig GUID-syntax +parser_w_interface_mapping_notfound=03168_W_En procedure kaldet $1 der kan implementere $2 blev ikke fundet. $3 +parser_e_interface_id_expected=03169_E_Interface-navn krævet +% This happens when the compiler scans a \var{class} declaration that contains +% \var{interface} function name mapping code like this: +% \begin{verbatim} +% type +% TMyObject = class(TObject, IDispatch) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% and the \var{interface} before the dot not listed in the inheritance list. +parser_e_type_cant_be_used_in_array_index=03170_E_Typen "$1" kan ikke bruges som index-type i et array +% Types like \var{qword} or \var{int64} aren't allowed as array index type +parser_e_no_con_des_in_interfaces=03171_E_Con- og destructors er ikke tilladt i interfaces +% Constructor and destructor declarations aren't allowed in interface +% In the most cases the method \var{QueryInterface} of \var{IUnknown} can +% be used to create a new interface. +parser_e_no_access_specifier_in_interfaces=03172_E_Adgangskrav kan ikke sættes i et interface +% The access specifiers \var{public}, \var{private}, \var{protected} and +% \var{pusblished} can't be used in interfaces because all methods +% of an interfaces must be public. +parser_e_no_vars_in_interfaces=03173_E_Et interface kan ikke indeholde felter +% Declarations of fields aren't allowed in interfaces. An interface +% can contain only methods +parser_e_no_local_proc_external=03174_E_Kan ikke erklære en lokal procedure som ekstern +% Declaring local procedures as external is not possible. Local procedures +% get hidden parameters that will make the chance of errors very high +parser_w_skipped_fields_before=03175_W_Visse felter i "$1" blev ikke initialiseret +% In Delphi mode, not all fields of a typed constant record have to be +% initialized, but the compiler warns you when it detects such situations. +parser_e_skipped_fields_before=03176_E_Visse felter i "$1" blev ikke initialiseret +% In all syntax modes but Delphi mode, you can't leave some fields uninitialized +% in the middle of a typed constant record +parser_w_skipped_fields_after=03177_W_Visse felter efter "$1" er ikke initialiseret +% You can leave some fields at the end of a type constant record uninitialized +% (the compiler will initialize them to zero automatically). This may be the cause +% of subtle problems. +parser_e_varargs_need_cdecl_and_external=03178_E_VarArgs-direktiv uden CDecl og External +% The varargs directive can only be used with procedures or functions +% that are declared with \var{cdecl} and \var{external} directives. The varargs directive +% is only meant to provide a compatible interface to C functions like printf. +parser_e_self_call_by_value=03179_E_Self skal være en almindelig (værdioverført) parameter +% You can't declare self as a const or var parameter, it must always be +% a call-by-value parameter +parser_e_interface_has_no_guid=03180_E_Interfacet "$1" har intet GUID +% When you want to assign an interface to a constant, then the interface +% must have a GUID value set. +parser_e_illegal_field_or_method=03181_E_Ukendt klassefelt eller metodenavn "$1" +% Properties must refer to a field or method in the same class. +parser_w_proc_overriding_calling=03182_W_Overrider kaldkonvention mellem "$1" og "$2" +% There are two directives in the procedure declaration that specify a calling +% convention. Only the last directive will be used +parser_e_no_procvarobj_const=03183_E_Konstanter af typen "procedure of object" kan kun initialiseres med NIL +% You can't assign the address of a method to a typed constant which has a +% 'procedure of object' type, because such a constant requires two addresses: +% that of the method (which is known at compile time) and that of the object or +% class instance it operates on (which can not be known at compile time). +parser_e_default_value_only_one_para=03184_E_Default-værdi kan kun tildeles én parameter +parser_e_default_value_expected_for_para=03185_E_Default-værdi krævet for parameter "$1" +parser_w_unsupported_feature=03186_W_Feature ikke understøttet +% You're trying to force the compiler into doing something it cannot do yet. +parser_h_c_arrays_are_references=03187_H_C-arrays videregives som reference +% Any array passed to a C functions is passed +% by a pointer (i.e. by reference). +parser_e_C_array_of_const_must_be_last=03188_E_C-arrays af konstanter skal være det sidste element +% You can not add any other argument after an \var{array of const} for +% \var{cdecl} functions, as the size pushed on stack for this argument is +% not known. +parser_h_type_redef=03189_H_Type "$1" redefineret +% This is an indicator that a previously declared type is +% being redefined as something else. This may, or may not +% be, a cause for errors. +parser_w_cdecl_has_no_high=03190_W_cdecl'arerede funktioner har ingen "high"-parameter +% Functions declared with cdecl modifier do not pass an extra implicit parameter. +parser_w_cdecl_no_openstring=03191_W_cdecl'arerede funktioner understøtter ikke Ã¥bne strenge +% Openstring is not supported for cdecl'ared functions. +parser_e_initialized_not_for_threadvar=03192_E_Kan ikke initialisere variabler der er erklæret som threadvar +% Variables declared as threadvar can not be initialized with a default value. +% The variables will always be filled with zero at the start of a new thread. +parser_e_msg_only_for_classes=03193_E_Message-direktivet kun gyldigt i klasser +% The message directive is only supported for Class types. +parser_e_procedure_or_function_expected=03194_E_Procedure eller Function forventet +% A class method can only be specified for procedures and functions. +parser_e_illegal_calling_convention=03195_W_Kaldkonventions-direktiv ignoreret: "$1" +% Some calling conventions are supported only by certain CPUs. I.e. most non-i386 ports support +% only the standard ABI calling convention of the CPU. +parser_e_no_object_reintroduce=03196_E_REINTRODUCE kan ikke bruges i objekter +% \var{reintroduce} is not supported for objects. +parser_e_paraloc_only_one_para=03197_E_Hvert argument skal have sin egen pladsspecifikation +% If locations for arguments are specified explicitly as it is required by +% some syscall conventions, each argument must have it's only location, things +% like \var{procedure p(i,j : longint 'r1');} aren't allowed +parser_e_paraloc_all_paras=03198_E_Hvert argument skal have en specifik pladsspecifikatino +% If one argument has an explicit argument location, all arguments of a procedure +% must have one. +parser_e_illegal_explicit_paraloc=03199_E_Ukendt pladsspecifikation parameter +% The location specified for an argument isn't recognized by the compiler +parser_e_32bitint_or_pointer_variable_expected=03200_E_32-bit heltal eller pointer forventet +% The libbase for MorphOS/AmigaOS can be give only as \var{longint}, \var{dword} or any pointer variable. +parser_e_goto_outside_proc=03201_E_Goto-erklæring ikke tilladt mellem forskellige procedurer +% It isn't allowed to use the \var{goto} statements referencing labels outside the +% current procedure. The following example shows the problem: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1; +% +% procedure p2; +% begin +% goto l1; // This goto ISN'T allowed +% end; +% +% begin +% p2 +% l1: +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_Procedure for kompleks, den kræver for mange registre +% Your procedure body is too long for the compiler. You should split the +% procedure into multiple smaller procedures. +parser_e_illegal_expression=03203_E_Ugyldigt udtryk +% This can occur under many circumstances. Mostly when trying to evaluate +% constant expressions. +parser_e_invalid_integer=03204_E_Ugyldigt heltalsudtryk +% You made an expression which isn't an integer, and the compiler expects the +% result to be an integer. +parser_e_invalid_qualifier=03205_E_Ugyldigt udtryk +% One of the following is happening : +% \begin{itemize} +% \item You're trying to access a field of a variable that is not a record. +% \item You're indexing a variable that is not an array. +% \item You're dereferencing a variable that is not a pointer. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_Øvre grænse er mindre end nedre grænse +% You are declaring a subrange, and the lower limit is higher than the high +% limit of the range. +parser_e_macpas_exit_wrong_param=03207_E_Parametren til Exit skal være navnet pÃ¥ den kaldende procedure +% Non local exit is not allowed. This error occur only in mode MacPas. +% \end{description} +# +# Type Checking +# +# 04049 is the last used one +# +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +parser_e_illegal_assignment_to_count_var=03208_E_Ugyldig tildeling til for-løkkevariablen "$1" +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. You can also not assign values to +% loop variables inside the loop (except in Delphi and TP modes). Use a while or +% repeat loop instead if you need to do something like that, since those +% constructs were built for that. +parser_e_no_local_var_external=03209_E_Kan ikke erklære en lokal variabel som ekstern +% Declaring local variables as external is not allowed. Only global variables can reference +% to external variables. +parser_e_proc_already_external=03210_E_Proceduren er allerede erklæret ekstern +% The procedure is already declared with the EXTERNAL directive in an interface or +% forward declaration. +parser_w_implicit_uses_of_variants_unit=03211_W_Implicit brug af Variants-modulet. +% The Variant type is used in the unit without any used unit using the Variants unit. The +% compiler has implicitly added the Variants unit to the uses list. To remove this warning +% the Variants unit needs to be added to the uses statement. +parser_e_no_static_method_in_interfaces=03212_E_Klasse- og statiske metoder kan ikke benyttes i interfaces +% The specifier \var{class} and directive \var{static} can't be used in interfaces +% because all methods of an interfaces must be public. +parser_e_arithmetic_operation_overflow=03213_E_Overløb i aritmetisk operation +% An operation on two integers values produced an overflow +parser_e_protected_or_private_expected=03214_E_"Protected" eller "private" forventet +% \var{strict} can be only used together with \var{protected} or \var{private}. +parser_e_illegal_slice=03215_E_"Slice" kan kun bruges med parameterlister +% \var{slice} can be used only for arguments accepting an open array parameter +parser_e_dispinterface_cant_have_parent=03216_E_Et DispInterface kan ikke nedarve fra en anden klasse +% A DISPINMTERFACE is a special type of interface which can't have a parent class +parser_e_dispinterface_needs_a_guid=03217_E_Et DispInterface kræver et GUID +% A DISPINMTERFACE always needs an interface identification +parser_w_overridden_methods_not_same_ret=03218_W_Metoder med "override" skal have relaterede returtyper. Denne kode kan fejle, da den afhænger af en fejl i Delphis parser ("$2" overrides af "$1", der har en anden returtype) +% If you declare overridden methods in a class definition, they must +% have the same return type. Some versions of Delphi allow you to change the +% return type of interface methods, and even to change procedures into +% functions, but the resulting code may crash depending on the types used +% and the way the methods are called. +% \end{description} +# +# Type Checking +# +# 04049 is the last used one +# +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +type_e_mismatch=04000_E_Typefejl +% This can happen in many cases: +% \begin{itemize} +% \item The variable you're assigning to is of a different type than the +% expression in the assignment. +% \item You are calling a function or procedure with parameters that are +% incompatible with the parameters in the function or procedure definition. +% \end{itemize} +type_e_incompatible_types=04001_E_Inkompatible typer: fandt "$1" forventede "$2" +% There is no conversion possible between the two types +% Another possiblity is that they are declared in different +% declarations: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { This statement gives also this error, it +% is due the strict type checking of pascal } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_Typeinkompatabilitet mellem "$1" og "$2" +% The types are not equal +type_e_type_id_expected=04003_E_Typenavn forventet +% The identifier is not a type, or you forgot to supply a type identifier. +type_e_variable_id_expected=04004_E_Variabelnavn forventet +% This happens when you pass a constant to a routine (such as \var{Inc} var or \var{Dec}) +% when it expects a variable. You can only pass variables as arguments to these functions. +type_e_integer_expr_expected=04005_E_Heltalsudtryk forventet, men "$1" fundet +% The compiler expects an expression of type integer, but gets a different +% type. +type_e_boolean_expr_expected=04006_E_Sandhedsudtryk forventet, men "$1" fundet +% The expression must be a boolean type, it should be return true or +% false. +type_e_ordinal_expr_expected=04007_E_Ordinaludtryk forventet +% The expression must be of ordinal type, i.e., maximum a \var{Longint}. +% This happens, for instance, when you specify a second argument +% to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value. +type_e_pointer_type_expected=04008_E_Pointertype forventet, men "$1" fundet +% The variable or expression isn't of the type \var{pointer}. This +% happens when you pass a variable that isn't a pointer to \var{New} +% or \var{Dispose}. +type_e_class_type_expected=04009_E_Klasse forventet, men "$1" fundet +% The variable of expression isn't of the type \var{class}. This happens +% typically when +% \begin{enumerate} +% \item The parent class in a class declaration isn't a class. +% \item An exception handler (\var{On}) contains a type identifier that +% isn't a class. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_Kan ikke evaluere konstantudtryk +% This error can occur when the bounds of an array you declared does +% not evaluate to ordinal constants +type_e_set_element_are_not_comp=04012_E_Setelementer er ikke kompatible +% You are trying to make an operation on two sets, when the set element types +% are not the same. The base type of a set must be the same when taking the +% union +type_e_set_operation_unknown=04013_E_Operationen er ikke implementeret for set +% several binary operations are not defined for sets +% like div mod ** (also >= <= for now) +type_w_convert_real_2_comp=04014_W_Automatisk typekonversion fra kommatal til COMP, der er en heltalstype +% An implicit type conversion from a real type to a \var{comp} is +% encountered. Since \var{comp} is a 64 bit integer type, this may indicate +% an error. +type_h_use_div_for_int=04015_H_Brug DIV i stedet, for at fÃ¥ et heltalsresultat +% When hints are on, then an integer division with the '/' operator will +% procuce this message, because the result will then be of type real +type_e_strict_var_string_violation=04016_E_Strengtyper passer ikke sammen, pÃ¥ grund af {$V+}-indstilling +% When compiling in \var{\{\$V+\}} mode, the string you pass as a parameter +% should be of the exact same type as the declared parameter of the procedure. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_succ() eller pred() pÃ¥ enumerate-typer med tildelte værdier er ikke gyldigt +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use the \var{Succ} or \var{Pred} functions on them. +type_e_cant_read_write_type=04018_E_Kan ikke læse eller skrive variabler af denne type +% You are trying to \var{read} or \var{write} a variable from or to a +% file of type text, which doesn't support that. Only integer types, +% reals, pchars and strings can be read from/written to a text file. +% Booleans can only be written to text files. +type_e_no_readln_writeln_for_typed_file=04019_E_Kan ikke bruge readln og writeln pÃ¥ typede filer +% \var{readln} and \var{writeln} are only allowed for text files. +type_e_no_read_write_for_untyped_file=04020_E_Kan ikke bruge read eller write pÃ¥ utypede filer +% \var{read} and \var{write} are only allowed for text or typed files. +type_e_typeconflict_in_set=04021_E_Typekonflikt mellem setelementer +% There is at least one set element which is of the wrong type, i.e. not of +% the set type. +type_w_maybe_wrong_hi_lo=04022_W_lo/hi(dword/qword) returnerer det øvre word/dword +% \fpc supports an overloaded version of \var{lo/hi} for \var{longint/dword/int64/qword} +% which returns the lower/upper word/dword of the argument. TP always uses +% a 16 bit \var{lo/hi} which returns always bits 0..7 for \var{lo} and the +% bits 8..15 for \var{hi}. If you want the TP behavior you have +% to type cast the argument to \var{word/integer} +type_e_integer_or_real_expr_expected=04023_E_Heltal eller kommatal forventet +% The first argument to \var{str} must a real or integer type. +type_e_wrong_type_in_array_constructor=04024_E_Forkert type "$1" i array-constructor +% You are trying to use a type in an array constructor which is not +% allowed. +type_e_wrong_parameter_type=04025_E_Inkompatible typer for $1. parameter: "$2" fundet men "$3" forventet +% You are trying to pass an invalid type for the specified parameter. +type_e_no_method_and_procedure_not_compatible=04026_E_Metode (variabel) og Procedure (variabel) er ikke kompatible +% You can't assign a method to a procedure variable or a procedure to a +% method pointer. +type_e_wrong_math_argument=04027_E_Ugyldig konstant givet til intern matematik-funktion +% The constant argument passed to a ln or sqrt function is out of +% the definition range of these functions. +type_e_no_addr_of_constant=04028_E_Kan ikke beregne adressen af konstanter +% It is not possible to get the address of a constant, because they +% aren't stored in memory, you can try making it a typed constant. +type_e_argument_cant_be_assigned=04029_E_Ugyldig tildeling +% Only expressions which can be on the left side of an +% assignment can be passed as call by reference argument +% Remark: Properties can be only +% used on the left side of an assignment, but they cannot be used as arguments +type_e_cannot_local_proc_to_procvar=04030_E_Kan ikke tildele lokal procedure/funktion til procedure-variabel +% It's not allowed to assign a local procedure/function to a +% procedure variable, because the calling of local procedure/function is +% different. You can only assign local procedure/function to a void pointer. +type_e_no_assign_to_addr=04031_E_Kan ikke tildele værdi til en adresse +% It is not allowed to assign a value to an address of a variable,constant, +% procedure or function. You can try compiling with -So if the identifier +% is a procedure variable. +type_e_no_assign_to_const=04032_E_Kan ikke tildele til konstant-erklæret variabel +% It's not allowed to assign a value to a variable which is declared +% as a const. This is normally a parameter declared as const, to allow +% changing the value make the parameter as a value parameter or a var. +type_e_array_required=04033_E_Array-type krævet +% If you are accessing a variable using an index '[<x>]' then +% the type must be an array. In FPC mode also a pointer is allowed. +type_e_interface_type_expected=04034_E_interface-type forventet, men "$1" fundet +type_w_mixed_signed_unsigned=04035_W_Blanding af fortegnsudtryk og fortegnsfri udtryk giver 64-bit resultat +% If you divide (or calculate the modulus of) a signed expression by a longword (or vice versa), +% or if you have overflow and/or range checking turned on and use an arithmetic +% expression (+, -, *, div, mod) in which both signed numbers and longwords appear, +% then everything has to be evaluated in 64bit which is slower than normal +% 32bit arithmetic. You can avoid this by typecasting one operand so it +% matches the resulttype of the other one. +type_w_mixed_signed_unsigned2=04036_W_Blanding af fortegnsudtryk og fortegnsfri udtryk her kan give værdiomrÃ¥defejl +% If you use a binary operator (and, or, xor) and one of +% the operands is a longword while the other one is a signed expression, then, +% if range checking is turned on, you may get a range check error because in +% such a case both operands are converted to longword before the operation is +% carried out. You can avoid this by typecasting one operand so it +% matches the resulttype of the other one. +type_e_typecast_wrong_size_for_assignment=04037_E_Typecast har forskellig størrelse ($1 -> $2) i tildeling +% Type casting to a type with a different size is not allowed when the variable is +% used for assigning. +type_e_array_index_enums_with_assign_not_possible=04038_E_Enumerate-typer med tildelinger kan ikke bruges som index i arrays +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use it as index of an array. +type_e_classes_not_related=04039_E_Klasse- eller objekt-typerne "$1" og "$2" er ikke relaterede +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_w_classes_not_related=04040_W_Klasse- eller objekt-typerne "$1" og "$2" er ikke relaterede +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_e_class_or_interface_type_expected=04041_E_Klasse eller interface-type forventet, men "$1" fundet +type_e_type_is_not_completly_defined=04042_E_Typen "$1" er ikke fuldt ud defineret +type_w_string_too_long=04043_W_Strengkonstant har flere karakterer end længden af en kort streng +% The size of the constant string, which is assigned to a shortstring, +% is longer than the maximum size of the shortstring +type_w_signed_unsigned_always_false=04044_W_Sammenligning er altid falsk, grundet værdiernes rækkevidde +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% false. Exlicitly typecast the constant to the correct range to avoid this problem. +type_w_signed_unsigned_always_true=04045_W_Sammenligning er altid sand, grundet værdiernes rækkevidde +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% true. Exlicitly typecast the constant to the correct range to avoid this problem. +type_w_instance_with_abstract=04046_W_Konstruerer klassen "$1" med abstrakte metoder +% An instance of a class is created which contains non-implemented abstract +% methods. This will probably lead to a runtime error 211 in the code if that +% routine is ever called. All abstract methods should be overridden. +type_h_in_range_check=04047_H_Den venstre operand til IN-operatoren skal være én byte stor +% The left operand of the \var{in} operator is not an ordinal or enumeration which fits +% within 8-bits, this may lead to range check errors. The \var{in} operator +% currently only supports a left operand which fits within a byte. In the case of +% enumerations, the size of an element of an enumeration can be controlled with +% the \var{\{\$PACKENUM\}} or \var{\{\$Zn\}} switches. +type_w_smaller_possible_range_check=04048_W_Forskel i typestørrelser. Muligt datatab eller værdigrænsefejl +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_h_smaller_possible_range_check=04049_H_Forskel i typestørrelser. Muligt datatab eller værdigrænsefejl +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_e_cant_take_address_of_abstract_method=04050_E_Kan ikke beregne adressen af en abstrakt metode +% An abstract method has no body, so the address of an abstract method can't be taken. +type_e_operator_not_allowed=04051_E_Operatoren kan ikke bruges pÃ¥ denne operand-type +% You are trying an operator that is not available for the type of the +% operands +type_e_constant_expr_expected=04052_E_Konstant udtryk forventet +% The compiler expects an constant expression, but gets a variable expression. +type_e_operator_not_supported_for_types=04053_E_Operationen "$1" ikke understøttet for typerne "$2" og "$3" +% The operation is not allowed for the supplied types +type_e_illegal_type_conversion=04054_E_Ugyldig typekonvertering: "$1" til "$2" +% When doing a type-cast, you must take care that the sizes of the variable and +% the destination type are the same. +type_h_pointer_to_longint_conv_not_portable=04055_H_Konvertering mellem ordinaltyper og pointere virker ikke pÃ¥ alle platforme +% If you typecast a pointer to a longint (or vice-versa), this code will not compile +% on a machine using 64-bit for pointer storage. +type_w_pointer_to_longint_conv_not_portable=04056_W_Konvertering mellem ordinaltyper og pointere virker ikke pÃ¥ alle platforme +% If you typecast a pointer to a ordinal type of a different size (or vice-versa), this can +% cause problems. This is a warning to help finding the 32bit specific code where cardinal/longint is used +% to typecast pointers to ordinals. A solution is to use the ptrint/ptruint types instead. +type_e_cant_choose_overload_function=04057_E_Kan ikke bestemme hvilken overloaded funktion der skal kaldes +% You're calling overloaded functions with a parameter that doesn't correspond +% to any of the declared function parameter lists. e.g. when you have declared +% a function with parameters \var{word} and \var{longint}, and then you call +% it with a parameter which is of type \var{integer}. +type_e_illegal_count_var=04058_E_Ugyldig tællevariabel +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +% \end{description} +# +# Symtable +# +# 05055 is the last used one +# +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedurek and variable names. +% \begin{description} +sym_e_id_not_found=05000_E_Ukendt navn: "$1" +% The compiler doesn't know this symbol. Usually happens when you misspel +% the name of a variable or procedure, or when you forgot to declare a +% variable. +sym_f_internal_error_in_symtablestack=05001_F_Intern fejl i SymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_Generklæret navn "$1" +% The identifier was already declared in the current scope. +sym_h_duplicate_id_where=05003_H_Navnet er allerede brugt in $1, linie $2 +% The identifier was already declared in a previous scope. +sym_e_unknown_id=05004_E_Ukendt navn: "$1" +% The identifier encountered has not been declared, or is used outside the +% scope where it is defined. +sym_e_forward_not_resolved=05005_E_Forward-erklæring ikke løst: "$1" +% This can happen in two cases: +% \begin{itemize} +% \item This happens when you declare a function (in the \var{interface} part, or +% with a \var{forward} directive, but do not implement it. +% \item You reference a type which isn't declared in the current \var{type} +% block. +% \end{itemize} +sym_e_error_in_type_def=05007_E_Fejl i typeerklæring +% There is an error in your definition of a new array type: +% \item One of the range delimiters in an array declaration is erroneous. +% For example, \var{Array [1..1.25]} will trigger this error. +sym_e_forward_type_not_resolved=05009_E_Forward-type ikke erklæret: "$1" +% A symbol was forward defined, but no declaration was encountered. +sym_e_only_static_in_static=05010_E_Kun statiske variabler kan bruges i statiske metoder, eller uden for metoder +% A static method of an object can only access static variables. +sym_f_type_must_be_rec_or_class=05012_F_Struktur- eller klassetype forventet +% The variable or expression isn't of the type \var{record} or \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_Instancer af klasser eller objekter med abstrakte metoder er ikke tilladt +% You are trying to generate an instance of a class which has an abstract +% method that wasn't overridden. +sym_w_label_not_defined=05014_W_Label er ikke defineret "$1" +% A label was declared, but not defined. +sym_e_label_used_and_not_defined=05015_E_Label brugt men ikke defineret "$1" +% A label was declared and used, but not defined. +sym_e_ill_label_decl=05016_E_Ugyldig label-erklæring +% This error should never happen; it occurs if a label is defined outside a +% procedure or function. +sym_e_goto_and_label_not_supported=05017_E_GOTO og LABEL er ikke understøttet (brug -Sg) +% You must compile a program which has \var{label}s and \var{goto} statements +% with the \var{-Sg} switch. By default, \var{label} and \var{goto} aren't +% supported. +sym_e_label_not_found=05018_E_Label ikke fundet +% A \var{goto label} was encountered, but the label isn't declared. +sym_e_id_is_no_label_id=05019_E_Navnet er ikke en label +% The identifier specified after the \var{goto} isn't of type label. +sym_e_label_already_defined=05020_E_Label er allerede defineret +% You are defining a label twice. You can define a label only once. +sym_e_ill_type_decl_set=05021_E_Ugyldig typeerklæring af setelementer +% The declaration of a set contains an invalid type definition. +sym_e_class_forward_not_resolved=05022_E_Forward-erklæring af klassen "$1" ikke løst +% You declared a class, but you did not implement it. +sym_n_unit_not_used=05023_H_Unit "$1" ikke brugt i "$2" +% The unit referenced in the \var{uses} clause is not used. +sym_h_para_identifier_not_used=05024_H_Parameter "$1" ikke brugt +% The identifier was declared (locally or globally) but +% was not used (locally or globally). +sym_n_local_identifier_not_used=05025_N_Lokal variabel "$1" ikke brugt +% You have declared, but not used a variable in a procedure or function +% implementation. +sym_h_para_identifier_only_set=05026_H_Værdiparameter "$1" er tildelt, men aldrig brugt +% The identifier was declared (locally or globally) +% set but not used (locally or globally). +sym_n_local_identifier_only_set=05027_N_Lokal variabel "$1" er tildelt, men aldrig brugt +% The variable in a procedure or function +% implementation is declared, set but never used. +sym_h_local_symbol_not_used=05028_H_Lokal $1 "$2" aldrig brugt +% A local symbol is never used. +sym_n_private_identifier_not_used=05029_N_Private-feltet "$1.$2" aldrig brugt +sym_n_private_identifier_only_set=05030_N_Private-feltet "$1.$2" tildelt men aldrig brugt +sym_n_private_method_not_used=05031_N_Private-metoden "$1.$2" aldrig brugt +sym_e_set_expected=05032_E_Set-type forventet +% The variable or expression is not of type \var{set}. This happens in an +% \var{in} statement. +sym_w_function_result_not_set=05033_W_Funktionsresultat ser ikke ud til at være sat +% You can get this warning if the compiler thinks that a function return +% value is not set. This will not be displayed for assembler procedures, +% or procedures that contain assembler blocks. +sym_w_wrong_C_pack=05034_W_Typen "$1" er ikke korrekt opstillet i C-struktur +% Arrays with sizes not multiples of 4 will be wrongly aligned +% for C structures. +sym_e_illegal_field=05035_E_Ukendt feltnavn i struktur, "$1" +% The field doesn't exist in the record/object definition. +sym_w_uninitialized_local_variable=05036_W_Den lokale variabel "$1" er ikke initialiseret +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_w_uninitialized_variable=05037_W_Variablen "$1" er ikke initialiseret +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_e_id_no_member=05038_E_Strukturen har intet felt ved navn "$1" +% This error is generated when an identifier of a record, +% field, or method is accessed while it is not defined. +sym_h_param_list=05039_H_Fandt erklæring: $1 +% You get this when you use the \var{-vh} switch. In case an overloaded +% procedure is not found, then all candidate overloaded procedures are +% listed, with their parameter lists. +sym_e_segment_too_large=05040_E_Dataelement for stort +% You get this when you declare a data element whose size exceeds the +% prescribed limit (2 Gb on 80386+/68020+ processors) +sym_e_no_matching_implementation_found=05042_E_Ingen passende implementation for interface-metoden "$1" fundet +% There was no matching method found which could implement the interface +% method. Check argument types and result type of the methods. +sym_w_deprecated_symbol=05043_W_Symbolet "$1" er markeret forældet, og bør ikke anvendes +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Usage of this symbol +% should be avoided as much as possible. +sym_w_non_portable_symbol=05044_W_Symbolet "$1" er ikke portabelt +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{platform} is used. This symbol's value, usage +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_non_implemented_symbol=05055_W_Symbolet "$1" er ikke implementeret +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{unimplemented} is used. This symbol is defined, +% but is not yet implemented on this specific platform. +sym_e_cant_create_unique_type=05056_E_Kan ikke lave unik type fra denne type +% Only simple types like ordinal, float and string types are supported when +% redefining a type with \var{type newtype = type oldtype;}. +% \end{description} +# +# Codegenerator +# +# 06040 is the last used one +# +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +sym_h_uninitialized_local_variable=05057_H_Den lokale variabel "$1" er ikke initialiseret +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_h_uninitialized_variable=05058_H_Variablen "$1" er ikke initialiseret +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_w_function_result_uninitialized=05059_W_Funktionsresultatet er ikke initialiseret +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. appears in the right-hand-side of an expression) +% before it is initialized (i.e. appeared in the left-hand side of an +% assigment) +sym_h_function_result_uninitialized=05060_H_Funktionsresultatet er ikke initialiseret +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. appears in the right-hand-side of an expression) +% before it is initialized (i.e. appeared in the left-hand side of an +% assigment) +sym_w_identifier_only_read=05061_W_Variablen "$1" bliver læst men aldrig tildelt +% You have read the value of a variable, but nowhere assigned a value to +% it. + +% \end{description} +# +# Codegenerator +# +# 06040 is the last used one +# +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +cg_e_parasize_too_big=06009_E_Den samlede parameterstørrelse overstiger 64KB +% The I386 processor limits the parameter list to 65535 bytes (the \var{RET} +% instruction causes this) +cg_e_file_must_call_by_reference=06012_E_File-typer skal være var-parametre +% You cannot specify files as value parameters, i.e. they must always be +% declared \var{var} parameters. +cg_e_cant_use_far_pointer_there=06013_E_Brugen af FAR-pointere er ikke tilladt her +% Free Pascal doesn't support far pointers, so you cannot take the address of +% an expression which has a far reference as a result. The \var{mem} construct +% has a far reference as a result, so the following code will produce this +% error: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_EXPORT-erklæringer kan ikke kaldes +% No longer in use. +cg_w_member_cd_call_from_method=06016_W_Mulig ugyldigt kald af constructor eller destructor +% The compiler detected that a constructor or destructor is called within a +% a method. This will probably lead to problems, since constructors / destructors +% require parameters on entry. +cg_n_inefficient_code=06017_N_Utilstrækkelig kode +% Your statement seems dubious to the compiler. +cg_w_unreachable_code=06018_W_Koden vil aldrig blive kørt +% You specified a construct which will never be executed. Example: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_Abstrakte metoder kan ikke kaldes direkte +% You cannot call an abstract method directy, instead you must call a +% overriding child method, because an abstract method isn't implemented. +cg_d_register_weight=06027_DL_Register $1 vægt $2 $3 +% Debugging message. Shown when the compiler considers a variable for +% keeping in the registers. +cg_d_stackframe_omited=06029_DL_Stakramme er udeladt +% Some procedure/functions do not need a complete stack-frame, so it is omitted. +% This message will be displayed when the {-vd} switch is used. +cg_e_unable_inline_object_methods=06031_E_Objekt eller klassemetode kan ikke være inline +% You cannot have inlined object methods. +cg_e_unable_inline_procvar=06032_E_Procvar kald kan ikke være inline +% A procedure with a procedural variable call cannot be inlined. +cg_e_no_code_for_inline_stored=06033_E_Koden til inline-procedure ikke gemt +% The compiler couldn't store code for the inline procedure. +cg_e_can_access_element_zero=06035_E_Element nul af en ansi/wide/lang-strengtype kan ikke tilgÃ¥s. Brug i stedet (set)length +% You should use \var{setlength} to set the length of an ansi/wide/longstring +% and \var{length} to get the length of such a string types +cg_e_cannot_call_cons_dest_inside_with=06037_E_En constructor eller destructor kan ikke kaldes i en "with"-erklæring +% Inside a \var{with} clause you cannot call a constructor or destructor for the +% object you have in the \var{with} clause. +cg_e_cannot_call_message_direct=06038_E_Kan ikke kalde beskedhÃ¥ndteringsprocedure direkte +% A message method handler method cannot be called directly if it contains an +% explicit self argument +cg_e_goto_inout_of_exception_block=06039_E_Jump ind eller ud af en untagelsesblok +% It is not allowed to jump in or outside of an exception block like \var{try..finally..end;}: +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // this line will cause an error +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_Forløbs-ændrende erklæringer er ikke tilladt i en finally-blok +% It isn't allowed to use the control flow statements \var{break}, +% \var{continue} and \var{exit} +% inside a finally statement. The following example shows the problem: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // This exit ISN'T allowed +% end; +% ... +% +% \end{verbatim} +% If the procedure \var{p} raises an exception the finally block is +% executed. If the execution reaches the exit, it's unclear what to do: +% exiting the procedure or searching for another exception handler +% \end{description} +cg_w_parasize_too_big=06041_W_Parameterstørrelsen overstiger grænsen for visse CPUer +% This indicates that you are declaring more than 64K of parameters, which +% might not be supported on other processor targets. +cg_w_localsize_too_big=06042_W_Størrelsen af lokale variabler overstiger grænsen for visse CPUer +% This indicates that you are declaring more than 32K of lcoal variables, which +% might not be supported on other processor targets. +cg_e_localsize_too_big=06043_E_Størrelsen af lokale variabler overstiger understøttet størrelse +% This indicates that you are declaring more than 32K of lcoal variables, which +% is not supported by this processor. +cg_e_break_not_allowed=06044_E_BREAK ikke tilladt uden for løkke-erklæringer +% You're trying to use \var{break} outside a loop construction. +cg_e_continue_not_allowed=06045_E_CONTINUE ikke tilladt uden for løkke-erklæringer +% You're trying to use \var{continue} outside a loop construction. +# EndOfTeX + +# +# Assembler reader +# +# 07097 is the last used one +# +cg_f_unknown_compilerproc=06046_F_Ukendt compilerfunktion "$1". Undersøg om du bruger det korrekt køretidsbibliotek. +% The compiler expects that the runtime library contains some subrountines. If you see this error +% and you didn't mess with the runtime library, it's very likely that the runtime library +% you're using doesn't match the used compiler. If you changed the runtime library this error means +% that you removed a subroutine which the compiler needs for internal use. +% \end{description} +# EndOfTeX + +# +# Assembler reader +# +# 07097 is the last used one +# +asmr_d_start_reading=07000_DL_Begynder assembler-parsing ($1) +% This informs you that an assembler block is being parsed +asmr_d_finish_reading=07001_DL_Afslutter assembler-parsing ($1) +% This informs you that an assembler block has finished. +asmr_e_none_label_contain_at=07002_E_Ikke-label navn indeholder @ +% A identifier which isn't a label can't contain a @. +asmr_e_building_record_offset=07004_E_Fejl under opbygning af struktur-offset +% There has an error occured while building the offset of a record/object +% structure, this can happend when there is no field specified at all or +% an unknown field identifier is used. +asmr_e_offset_without_identifier=07005_E_OFFSET brugt uden navn +% You can only use OFFSET with an identifier. Other syntaxes aren't +% supported +asmr_e_type_without_identifier=07006_E_TYPE brugt uden navn +% You can only use TYPE with an identifier. Other syntaxes aren't +% supported +asmr_e_no_local_or_para_allowed=07007_E_Kan ikke bruge lokale variabler eller parametre her +% You can't use a local variable or parameter here, mostly because the +% addressing of locals and parameters is done using the frame pointer register so the +% address can't be obtained directly. +asmr_e_need_offset=07008_E_Nødvendigt at bruge OFFSET her +% You need to use OFFSET <id> here to get the address of the identifier. +asmr_e_need_dollar=07009_E_Nødvendigt at bruge $ her +% You need to use $<id> here to get the address of the identifier. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_Kan ikke bruge flere samtidige relokérbare symboler +% You can't have more than one relocatable symbol (variable/typed constant) +% in one argument. +asmr_e_only_add_relocatable_symbol=07011_E_Relokérbare symboler kan kun adderes +% Relocatable symbols (variable/typed constant) can't be used with other +% operators. Only addition is allowed. +asmr_e_invalid_constant_expression=07012_E_Ugyldigt konstantudtryk +% There is an error in the constant expression. +asmr_e_relocatable_symbol_not_allowed=07013_E_Relokérbart symbol ikke tilladt her +% You can't use a relocatable symbol (variable/typed constant) here. +asmr_e_invalid_reference_syntax=07014_E_Ugyldig referencesyntax +% There is an error in the reference. +asmr_e_local_para_unreachable=07015_E_Kan ikke tilgÃ¥ $1 fra denne position +% You can not read directly the value of local or para +% of a higher level in assembler code (except for +% local assembler code without parameter nor locals). +asmr_e_local_label_not_allowed_as_ref=07016_E_Lokale symboler/labels er ikke gyldige referencer +% You can't use local symbols/labels as references +asmr_e_wrong_base_index=07017_E_Ugyldigt base- eller indexregister +% There is an error with the base and index register, they are +% probably incorrect +asmr_w_possible_object_field_bug=07018_W_Mulig fejl i objektfelthÃ¥ndtering +% Fields of objects or classes can be reached directly in normal or objfpc +% modes but TP and Delphi modes treat the field name as a simple offset. +asmr_e_wrong_scale_factor=07019_E_Forkert skaleringsfaktor angivet +% The scale factor given is wrong, only 1,2,4 and 8 are allowed +asmr_e_multiple_index=07020_E_Mere end ét indexregister angivet +% You are trying to use more than one index register +asmr_e_invalid_operand_type=07021_E_Ugyldig operandtype +% The operand type doesn't match with the opcode used +asmr_e_invalid_string_as_opcode_operand=07022_E_Ugyldig streng som operand: $1 +% The string specified as operand is not correct with this opcode +asmr_w_CODE_and_DATA_not_supported=07023_W_@CODE og @DATA ikke understøttet +% @CODE and @DATA are unsupported and are ignored. +asmr_e_null_label_ref_not_allowed=07024_E_Tomme labelreferencer er ikke tilladt +asmr_e_expr_zero_divide=07025_E_Division med nul i assembler-evaluatoren +% There is a division by zero in a constant expression +asmr_e_expr_illegal=07026_E_Ugyldigt konstantudtryk +% There is an illegal expression in a constant expression +asmr_e_escape_seq_ignored=07027_E_Escape-sekvens ignoreret: $1 +% There is a C-styled string, but the escape sequence in the string +% is unknown, and is therefore ignored +asmr_e_invalid_symbol_ref=07028_E_Ugyldig symbolreference +asmr_w_fwait_emu_prob=07029_W_FWAIT kan føre til emulationsproblemer med emu387 +asmr_w_fadd_to_faddp=07030_W_$1 uden operand oversat til $1P +asmr_w_enter_not_supported_by_linux=07031_W_ENTER-instruktionen er ikke understøttet af Linux-kernen +% ENTER instruction can generate a stack page fault that is not +% caught correctly by the i386 Linux page handler. +asmr_w_calling_overload_func=07032_W_Kald til overloaded funktion i assembler +% There is a call to an overloaded method in the assembler block, +% this might be the sign there is a problem +asmr_e_unsupported_symbol_type=07033_E_Operandens symboltype er ikke understøttet +asmr_e_constant_out_of_bounds=07034_E_Konstantværdi overskrider værdigrænse +asmr_e_error_converting_decimal=07035_E_Fejl under konvertering af decimal $1 +% A constant decimal value does not have the correct syntax +asmr_e_error_converting_octal=07036_E_Fejl under konvertering af octal $1 +% A constant octal value does not have the correct syntax +asmr_e_error_converting_binary=07037_E_Fejl under konvertering af binær $1 +% A constant binary value does not have the correct syntax +asmr_e_error_converting_hexadecimal=07038_E_Fejl under konvertering af hexadecimal $1 +% A constant hexadecimal value does not have the correct syntax +asmr_h_direct_global_to_mangled=07039_H_$1 oversat til $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 er associeret med en overloadet funktion +asmr_e_cannot_use_SELF_outside_a_method=07041_E_Kan ikke tilgÃ¥ SELF uden for en metode +% There is a reference to the \var{self} symbol while it is not +% allowed. \var{self} can only be referenced inside methods +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_Kan ikke tilgÃ¥ OLDEBP uden for en indlejret procedure +% There is a reference to the \var{oldebp} symbol while it is not +% allowed. \var{oldebp} can only be referenced inside nested routines +asmr_e_void_function=07043_W_En procedure kan ikke returnere en værdi i assembler-kode +% Trying to return a value while in a procedure. A procedure +% does not have any return value +asmr_e_SEG_not_supported=07044_E_SEG er ikke understøttet +asmr_e_size_suffix_and_dest_dont_match=07045_E_Størrelses-suffix og destination- eller kildestørrelse stemmer ikke overens +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_w_size_suffix_and_dest_dont_match=07046_W_Størrelses-suffix og destination- eller kildestørrelse stemmer ikke overens +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_e_syntax_error=07047_E_Syntaxfejl i assemblerkode +% There is an assembler syntax error +asmr_e_invalid_opcode_and_operand=07048_E_Ugyldig kombination af operationskode og operand +% The opcode cannot be used with this type of operand +asmr_e_syn_operand=07049_E_Syntaxfejl i assembleroperand +asmr_e_syn_constant=07050_E_Syntaxfejl i assemblerkonstant +asmr_e_invalid_string_expression=07051_E_Ugyldigt strengudtryk +asmr_w_const32bit_for_address=07052_W_adressekonstanten $1 er ikke en gyldig pointer +% A constant expression represents an address which does not fit +% into a pointer. The address is probably incorrect +asmr_e_unknown_opcode=07053_E_Ukendt operationskode $1 +% This opcode is not known +asmr_e_invalid_or_missing_opcode=07054_E_Ugyldig eller manglende operationskode +asmr_e_invalid_prefix_and_opcode=07055_E_Ugyldig kombination af prefix og operationskode: $1 +asmr_e_invalid_override_and_opcode=07056_E_Ugyldig kombination af override og operationskode: $1 +asmr_e_too_many_operands=07057_E_For mange operander pÃ¥ linien +% There are too many operands for this opcode. Check your +% assembler syntax +asmr_w_near_ignored=07058_W_NEAR ignoreret +asmr_w_far_ignored=07059_W_FAR ignoreret +asmr_e_dup_local_sym=07060_E_Gentaget lokalt symbol $1 +asmr_e_unknown_local_sym=07061_E_Ukendt lokalt symbol $1 +asmr_e_unknown_label_identifier=07062_E_Unknown labelnavn $1 +asmr_e_invalid_register=07063_E_Ugyldigt registernavn +% There is an unknown register name used as operand. +asmr_e_invalid_fpu_register=07064_E_Ugyldigt kommatalsregister-navn +% There is an unknown register name used as operand. +asmr_w_modulo_not_supported=07066_W_Modulo ikke understøttet +asmr_e_invalid_float_const=07067_E_Ugyldig kommatalskonstant $1 +% The floating point constant declared in an assembler block is +% invalid. +asmr_e_invalid_float_expr=07068_E_Ugyldig kommatalsudtryk +% The floating point expression declared in an assembler block is +% invalid. +asmr_e_wrong_sym_type=07069_E_Forkert symboltype +asmr_e_cannot_index_relative_var=07070_E_Kan ikke indexere en lokal variabel eller parameter med et register +% Trying to index using a base register a symbol which is already relative +% to a register. This is not possible, and will probably lead to crashes. +asmr_e_invalid_seg_override=07071_E_Ugyldigt segment-override-udtryk +asmr_w_id_supposed_external=07072_W_Navnet $1 antages at være eksternt +% There is a reference to an undefined symbol. This will not result +% in an error, since the symbol might be external, but may cause +% problems at link time if the symbol is not defined anywhere. +asmr_e_string_not_allowed_as_const=07073_E_Strenge er ikke tilladte som konstanter +% Character strings are not allowed as constants. +asmr_e_no_var_type_specified=07074_Ingen variabeltype specificeret +% The syntax expects a type idenfitifer after the dot, but +% none was found. +asmr_w_assembler_code_not_returned_to_text=07075_E_Assemblerkode returnerer ikke til tekst-sektionen +% There was a directive in the assembler block to change sections, +% but there is a missing return to the text section at the end +% of the assembler block. This might cause errors during link time. +asmr_e_not_directive_or_local_symbol=07076_E_Ikke et direktiv eller lokalt symbol $1 +% This symbol is unknown. +asmr_w_using_defined_as_local=07077_E_Brug af defineret navn som lokal label +asmr_e_dollar_without_identifier=07078_E_Dollar-token brugt uden navn +% A constant expression has an identifier which does not start with +% the $ symbol. +asmr_w_32bit_const_for_address=07079_W_32-bit konstant brugt som adresse +% A constant was used as an address. This is probably an error, +% since using absolute addresses will probably not work. +asmr_n_align_is_target_specific=07080_N_.align er mÃ¥l-specifikt. Brug .balign eller .p2align +% Using the .align directive is platform specific, and its meaning will vary +% from one platform to another. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_Kan ikke tilgÃ¥ felter fra parametre direkte +% You should load the parameter first into a register and then access the +% fields using that register. +asmr_e_cannot_access_object_field_directly=07082_E_Kan ikke tilgÃ¥ felter fra objekter/klasser direkte +% You should load the self pointer first into a register and then access the +% fields using the register as base. By default the self pointer is available +% in the esi register on i386. +asmr_e_unable_to_determine_reference_size=07083_E_Ingen størrelse angivet, og det var ikke muligt at fastslÃ¥ størrelsen af operanderne +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. +asmr_e_cannot_use_RESULT_here=07084_E_Kan ikke bruge RESULT i denne funktion +% Some functions which return complex types cannot use the \var{result} +% keyword. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" uden operand oversat til "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" oversat til "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" oversat til "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_Karakter "<" ikke tilladt her (brug "<<" for logisk skift) +% The shift operator requires the << characters. Only one +% of those characters was found. +asmr_e_invalid_char_greater=07090_E_Karakter ">" ikke tilladt her (brug ">>" for logisk skift) +% The shift operator requires the >> characters. Only one +% of those characters was found. +asmr_w_align_not_supported=07093_W_ALIGN ikke understøttet +asmr_e_no_inc_and_dec_together=07094_E_Inc og Dec kan ikke bruges sammen +% Trying to use an increment and a decrement within the same +% opcode on the 680x0. This is impossible. +asmr_e_invalid_reg_list_in_movem=07095_E_Ugyldig registerliste til movem +% Trying to use the \var{movem} opcode with invalid registers +% to save or restore. +asmr_e_invalid_reg_list_for_opcode=07096_E_Registerliste ikke gyldig for denne operationskode +asmr_e_higher_cpu_mode_required=07097_E_Højere cpu-mode krævet ($1) +% Trying to use an instruction which is not supported in the current +% cpu mode. Use a higher cpu generation to be able to use this +% opcode in your assembler block +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_Ingen størrelse angivet, og det var ikke muligt at fastslÃ¥ størrelsen af operanderne. Bruger DWORD. +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use DWORD as default. +# +# Assembler/binary writers +# +# 08018 is the last used one +# +asmr_e_illegal_shifterop_syntax=07099_E_Syntaxfejl under parsning af skifteroperand +% ARM only; ARM assembler supports a so called shifter operand. The used syntax isn't +% a valid shifter operand. Example for an operation with shifter operand: +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +# +# Assembler/binary writers +# +# 08018 is the last used one +# +asmw_f_too_many_asm_files=08000_F_For mange assemblerfiler (forsøg uden smartlinking) +% With smartlinking enabled, there are too many assembler +% files generated. Disable smartlinking. +asmw_f_assembler_output_not_supported=08001_F_Den valgte assemblerform understøttes ikke +asmw_f_comp_not_supported=08002_F_Typen "Comp" er ikke understøttet +asmw_f_direct_not_supported=08003_F_Direkte assembler-tilstand ikke understøttet for indbyggede filskrivere +% Direct assembler mode is not supported for binary writers. +asmw_e_alloc_data_only_in_bss=08004_E_Allokering af data kun tilladt i bss-sektionen +asmw_f_no_binary_writer_selected=08005_F_Ingen binær filskriver valgt +asmw_e_opcode_not_in_table=08006_E_Asm: Operationskode $1 ikke fundet i tabellen +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 ugyldig kombination af register og operationskode +asmw_e_16bit_not_supported=08008_E_Asm: 16-bit referencer ikke understøttet +asmw_e_invalid_effective_address=08009_E_Asm: Ugyldig effektiv adressering +asmw_e_immediate_or_reference_expected=08010_E_Asm: Konstant eller reference forventet +asmw_e_value_exceeds_bounds=08011_E_Asm: $1 værdi overstiger grænse $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: Kort hop er uden for rækkevidde $1 +asmw_e_undefined_label=08013_E_Asm: Ukendt labelnavn $1 +asmw_e_comp_not_supported=08014_E_Asm: Typen "Comp" er ikke understøttet pÃ¥ dette mÃ¥lsystem +asmw_e_extended_not_supported=08015_E_Asm: Typen "Extended" er ikke understøttet pÃ¥ dette mÃ¥lsystem +asmw_e_duplicate_label=08016_E_Asm: Genbrugt labelnavn $1 +asmw_e_redefined_label=08017_E_Asm: Redefineret labelnavn $1 +asmw_e_first_defined_label=08018_E_Asm: Først defineret her +asmw_e_invalid_register=08019_E_Asm: Ugyldigt register $1 + +# +# Executing linker/assembler +# +# 09034 is the last used one +# +# BeginOfTeX +% +% \section{Errors of assembling/linking stage} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +exec_w_source_os_redefined=09000_W_Kilde-operativsystem redefineret +exec_i_assembling_pipe=09001_I_Assembler (pipe) $1 +exec_d_cant_create_asmfile=09002_E_Kan ikke oprette assemblerfil: $1 +% The mentioned file can't be created. Check if you have got +% access permissions to create this file +exec_e_cant_create_objectfile=09003_E_Kan ikke oprette objektfil: $1 +% The mentioned file can't be created. Check if you've +% got access permissions to create this file +exec_e_cant_create_archivefile=09004_E_Kan ikke oprette arkivfil: $1 +% The mentioned file can't be created. Check if you've +% access permissions to create this file +exec_e_assembler_not_found=09005_E_Assembler $1 ikke fundet, skifter til ekstern assembler +exec_t_using_assembler=09006_T_Bruger assembler: $1 +exec_e_error_while_assembling=09007_E_Fejl under assembling (returkode $1) +% There was an error while assembling the file using an external assembler. +% Consult the documentation of the assembler tool to find out more information +% on this error. +exec_e_cant_call_assembler=09008_E_Kan ikke kalde assembleren, fejl $1 under skift til ekstern assembler +exec_i_assembling=09009_I_Assembler $1 +exec_i_assembling_smart=09010_I_Assembler med smartlinking $1 +exec_w_objfile_not_found=09011_W_Objektet $1 ikke fundet - linkningen kan fejle! +% One of the object file is missing, and linking will probably fail. +% Check your paths. +exec_w_libfile_not_found=09012_W_Biblioteket $1 blev ikke fundet - linkningen kan fejle! +% One of the library file is missing, and linking will probably fail. +% Check your paths. +exec_e_error_while_linking=09013_E_Fejl under linkning +% Generic error while linking. +exec_e_cant_call_linker=09014_E_Kan ikke starte linkeren, skifter til ekstern linker +exec_i_linking=09015_I_Linker $1 +exec_e_util_not_found=09016_E_Hjælpeprogram $1 ikke fundet, skifter til ekstern linker +exec_t_using_util=09017_T_Bruger hjælpeprogram $1 +exec_e_exe_not_supported=09018_E_Programbygning ikke understøttet +exec_e_dll_not_supported=09019_E_Dynamisk/Delt bibliotek-bygning ikke understøttet +exec_i_closing_script=09020_I_Lukker script $1 +exec_e_res_not_found=09021_E_resourcecompiler ikke fundet, skifter til ekstern +exec_i_compilingresource=09022_I_Compilerer resourcen $1 +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_unit $1 kan ikke linkes statisk. Skifter til smartlinking +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_unit $1 kan ikke smartlinkes. Skifter til statisk linking +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_unit $1 kan ikke linkes delt, skifter til statisk linking +exec_e_unit_not_smart_or_static_linkable=09026_E_unit $1 kan ikke linkes smart eller statisk +exec_e_unit_not_shared_or_static_linkable=09027_E_unit $1 kan ikke linkes delt eller statisk +%\end{description} +# EndOfTeX + +# +# Executable information +# +exec_d_resbin_params=09028_D_Kalder resourcecompiler "$1" med "$2" som kommandolinie +%\end{description} +# EndOfTeX + +# +# Executable information +# +execinfo_f_cant_process_executable=09128_F_Can't post process executable $1 +execinfo_f_cant_open_executable=09129_F_Kan ikke Ã¥bne programmet $1 +execinfo_x_codesize=09130_X_Størrelsen af koden: $1 bytes +execinfo_x_initdatasize=09131_X_Størrelse af initialiseret data: $1 bytes +execinfo_x_uninitdatasize=09132_X_Størrelse af uinitialiseret data: $1 bytes +execinfo_x_stackreserve=09133_X_Reserveret stakstørrelse: $1 bytes +execinfo_x_stackcommit=09134_X_Brugt stakstørrelse: $1 bytes + +# +# Unit loading +# +# 10041 is the last used one +# +# BeginOfTeX +% \section{Unit loading messages.} +% This section lists all messages that can occur when the compiler is +% loading a unit from disk into memory. Many of these messages are +% informational messages. +% \begin{description} +unit_t_unitsearch=10000_T_Leder efter unit: $1 +% When you use the \var{-vt}, the compiler tells you where it tries to find +% unit files. +unit_t_ppu_loading=10001_T_Indlæser PPU $1 +% When the \var{-vt} switch is used, the compiler tells you +% what units it loads. +unit_u_ppu_name=10002_U_PPU Navn: $1 +% When you use the \var{-vu} flag, the unit name is shown. +unit_u_ppu_flags=10003_U_PPU Flag: $1 +% When you use the \var{-vu} flag, the unit flags are shown. +unit_u_ppu_crc=10004_U_PPU CRC: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_time=10005_U_PPU Tid: $1 +% When you use the \var{-vu} flag, the time the unit was compiled is shown. +unit_u_ppu_file_too_short=10006_U_PPU-filen er for kort +% The ppufile is too short, not all declarations are present. +unit_u_ppu_invalid_header=10007_U_PPU-filen har ugyldigt startinformation (ingen PPU i begyndelsen af filen) +% A unit file contains as the first three bytes the ascii codes of \var{PPU} +unit_u_ppu_invalid_version=10008_U_PPU ugyldig version $1 +% This unit file was compiled with a different version of the compiler, and +% cannot be read. +unit_u_ppu_invalid_processor=10009_U_PPU er kompileret til en anden processor +% This unit file was compiled for a different processor type, and +% cannot be read +unit_u_ppu_invalid_target=10010_U_PPU er kompileret til et andet mÃ¥l +% This unit file was compiled for a different target, and +% cannot be read +unit_u_ppu_source=10011_U_PPU Kilde: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_write=10012_U_Skriver $1 +% When you specify the \var{-vu} switch, the compiler will tell you where it +% writes the unit file. +unit_f_ppu_cannot_write=10013_F_Kan ikke skrive PPU-fil +% An error occurred when writing the unit file. +unit_f_ppu_read_error=10014_F_Fejl under læsning af PPU-fil +% This means that the unit file was corrupted, and contains invalid +% information. Recompilation will be necessary. +unit_f_ppu_read_unexpected_end=10015_F_PPU-filen sluttede uventet +% Unexpected end of file. This may mean that the PPU file is +% corrupted. +unit_f_ppu_invalid_entry=10016_F_Ugyldigt element $1 i PPU-fil +% The unit the compiler is trying to read is corrupted, or generated with a +% newer version of the compiler. +unit_f_ppu_dbx_count_problem=10017_F_Problem med størrelsen af Dbx i PPU-filen +% There is an inconsistency in the debugging information of the unit. +unit_e_illegal_unit_name=10018_E_Ugyldigt unitnavn: $1 +% The name of the unit does not match the file name. +unit_f_too_much_units=10019_F_For mange units +% \fpc has a limit of 1024 units in a program. You can change this behavior +% by changing the \var{maxunits} constant in the \file{fmodule.pas} file of the +% compiler, and recompiling the compiler. +unit_f_circular_unit_reference=10020_F_Cirkulær unit-reference mellem $1 og $2 +% Two units are using each other in the interface part. This is only allowed +% in the \var{implementation} part. At least one unit must contain the other one +% in the \var{implementation} section. +unit_f_cant_compile_unit=10021_F_Kan ikke gencompilere $1, ingen kildekode tilgængelig +% A unit was found that needs to be recompiled, but no sources are +% available. +unit_f_cant_find_ppu=10022_F_Kan ikke finde unit'en $1 +% You tried to use a unit of which the PPU file isn't found by the +% compiler. Check your configuration file for the unit paths +unit_w_unit_name_error=10023_W_Unit $1 blev ikke fundet, men $2 findes +unit_f_unit_name_error=10024_F_Unit $1 blev eftersøgt, men $2 fundet +% Dos truncation of 8 letters for unit PPU files +% may lead to problems when unit name is longer than 8 letters. +unit_w_switch_us_missed=10025_W_Compilering af systemunit'en kræver -Us indstillingen +% When recompiling the system unit (it needs special treatment), the +% \var{-Us} must be specified. +unit_f_errors_in_unit=10026_F_Der var $1 fejl under compileringen af modulet, stopper +% When the compiler encounters a fatal error or too many errors in a module +% then it stops with this message. +unit_u_load_unit=10027_U_Indlæser fra $1 ($2) unit $3 +% When you use the \var{-vu} flag, which unit is loaded from which unit is +% shown. +unit_u_recompile_crc_change=10028_U_Gencompilerer $1, checksum ændret for $2 +unit_u_recompile_source_found_alone=10029_U_Gencompilerer $1, kun kilden fundet +% When you use the \var{-vu} flag, these messages tell you why the current +% unit is recompiled. +unit_u_recompile_staticlib_is_older=10030_U_Gencompilerer unit, statisk bibliotek er ældre end PPU-fil +% When you use the \var{-vu} flag, the compiler warns if the static library +% of the unit are older than the unit file itself. +unit_u_recompile_sharedlib_is_older=10031_U_Gencompilerer unit, delt bibliotek er ældre end PPU-fil +% When you use the \var{-vu} flag, the compiler warns if the shared library +% of the unit are older than the unit file itself. +unit_u_recompile_obj_and_asm_older=10032_U_Gencompilerer unit, objekt- og assemblerfil er ældre end PPU-fil +% When you use the \var{-vu} flag, the compiler warns if the assembler or +% object file of the unit are older than the unit file itself. +unit_u_recompile_obj_older_than_asm=10033_U_Gencompilerer unit, objekt-filen er ældre end assemblerfilen +% When you use the \var{-vu} flag, the compiler warns if the assembler +% file of the unit is older than the object file of the unit. +unit_u_parsing_interface=10034_U_Parser interfacet af $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the interface part of the unit +unit_u_parsing_implementation=10035_U_Parser implementationen af $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the implementation part of the unit +unit_u_second_load_unit=10036_U_Anden indlæsning for unit $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_check_time=10037_U_PPU Check filen $1 tid $2 +% When you use the \var{-vu} flag, the compiler show the filename and +% date and time of the file which a recompile depends on +unit_w_cant_compile_unit_with_changed_incfile=10040_W_Kan ikke gencompilere unit $1, men der blev fundet ændrede includefiler +% A unit was found to have modified include files, but +% some source files were not found, so recompilation is impossible. +unit_h_source_modified=10041_H_Filen $1 er nyere end PPU-filen $2 (Release-udgave) +% A modified source file for a unit was found that was compiled with the +% release flag (-Ur). The unit will not implicitly be recompiled because +% this release flag is set. +unit_u_ppu_invalid_fpumode=10042_U_Bruger en unit der der ikke er compileret i den korrekte FPU-mode +% Trying to compile code while using units which were not compiled with +% the same floating point format mode. Either all code should be compiled +% with FPU emulation on, or with FPU emulation off. +unit_u_loading_interface_units=10043_U_Indlæser interface-units fra $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the units defined in the interface part of the unit. +unit_u_loading_implementation_units=10044_U_Indlæser implementation-units fra $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the units defined in the implementation part of the unit. +unit_u_interface_crc_changed=10045_U_Interface-CRC ændret for unit $1 +% When you use the \var{-vu} flag, the compiler warns that it the +% CRC calculated for the interface has been changed after the implementation +% has been parsed. +unit_u_implementation_crc_changed=10046_U_Implementation-CRC ændret for unit $1 +% When you use the \var{-vu} flag, the compiler warns that it the +% CRC calculated has been changed after the implementation +% has been parsed. +unit_u_finished_compiling=10047_U_Færdiggjorde compileringen af unit $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has finished compiling the unit. +unit_u_add_depend_to=10048_U_Tilføjede afhængighed af $1 til $2 +% When you use the \var{-vu} flag, the compiler warns that it +% has added a dependency between the two units. +unit_u_no_reload_is_caller=10049_U_Ingen genindlæsning, $1 er kalder +% When you use the \var{-vu} flag, the compiler warns that it +% has will not reload the unit because it is the unit that wants +% to load this unit +unit_u_no_reload_in_second_compile=10050_U_Ingen genindlæsning, allerede anden kompilering: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has will not reload the unit because it is already in a second recompile +unit_u_flag_for_reload=10051_U_Indstillinger for genindlæsning: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to reload the unit +unit_u_forced_reload=10052_U_Tvungen genindlæsning +% When you use the \var{-vu} flag, the compiler warns that it +% has is reloading the unit because it was required +unit_u_previous_state=10053_U_Tidligere tilstand af $1: $2 +% When you use the \var{-vu} flag, the compiler shows the +% previous state of the unit +unit_u_second_compile_unit=10054_U_Compilerer allerede $1, starter anden compilering +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_loading_unit=10055_U_Indlæser unit $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the unit. +unit_u_finished_loading_unit=10056_U_Indlæsning af unit $1 færdig +% When you use the \var{-vu} flag, the compiler warns that it finished +% loading the unit. +unit_u_registering_new_unit=10057_U_Registrering af unit $1 +% When you use the \var{-vu} flag, the compiler warns that it has +% found a new unit and registers it in the internal lists. +unit_u_reresolving_unit=10058_U_Genberegner unit $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to recalculate the internal data of the unit +unit_u_skipping_reresolving_unit=10059_U_Springer genberegning over for unit $1, indlæser stadig brugte units +% When you use the \var{-vu} flag, the compiler warns that it +% skips to recalculate the internal data of the unit because there +% is no data to recalculate +% \end{description} +# EndOfTeX + +# +# Options +# +# 11039 is the last used one +# +option_usage=11000_O_$1 [indstillinger] <inputfil> [indstillinger] +# BeginOfTeX +% +% \section{Command-line handling errors} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +option_only_one_source_support=11001_W_Kun én kildefil understøttet +% You can specify only one source file on the command line. The first +% one will be compiled, others will be ignored. This may indicate that +% you forgot a \var{'-'} sign. +option_def_only_for_os2=11002_W_DEF-fil kan kun laves pÃ¥ OS/2 +% This option can only be specified when you're compiling for OS/2 +option_no_nested_response_file=11003_E_indlejrede svarfiler ikke understøttet +% you cannot nest response files with the \var{@file} command-line option. +option_no_source_found=11004_F_Ingen kildefil angivet pÃ¥ kommandolinien +% The compiler expects a source file name on the command line. +option_no_option_found=11005_N_Ingen indstillinger i konfigurationsfilen $1 +% The compiler didn't find any option in that config file. +option_illegal_para=11006_E_Ugyldig parameter: $1 +% You specified an unknown option. +option_help_pages_para=11007_H_-? udskriver hjælpe-beskeder +% When an unknown option is given, this message is diplayed. +option_too_many_cfg_files=11008_F_for mange indlejrede niveauer af konfigurationsfiler +% You can only nest up to 16 config files. +option_unable_open_file=11009_F_Kan ikke Ã¥bne filen $1 +% The option file cannot be found. +option_reading_further_from=11010_D_Læser yderligere indstillinger fra $1 +% Displayed when you have notes turned on, and the compiler switches +% to another options file. +option_target_is_already_set=11011_W_MÃ¥l er allerede sat til: $1 +% Displayed if more than one \var{-T} option is specified. +option_no_shared_lib_under_dos=11012_W_Delte biblioteker er ikke understøttet pÃ¥ DOS-platformen, gÃ¥r tilbage til statisk +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos +option_too_many_ifdef=11013_F_for mange IF(N)DEF +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_many_endif=11014_F_for mange ENDIFs +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_less_endif=11015_F_Ã¥bne betingelser i slutningen af filen +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_no_debug_support=11016_W_generering af debug-information understøttes ikke at dette programformat +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_Prøv at gencompilere med -dGDB +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_E_Du bruger $1 der er en forældet indstilling +% this warns you when you use a switch that is not needed/supported anymore. +% It is recommended that you remove the switch to overcome problems in the +% future, when the switch meaning may change. +option_obsolete_switch_use_new=11019_E_Du bruger $1 der er en forældet indstilling. Vær venlig at bruge $2 +% this warns you when you use a switch that is not supported anymore. You +% must now use the second switch instead. +% It is recommended that you change the switch to overcome problems in the +% future, when the switch meaning may change. +option_switch_bin_to_src_assembler=11020_N_Skifter til den standard-assembler der skriver direkte til assemblerfilerne +% this notifies you that the assembler has been changed because you used the +% -a switch which can't be used with a binary assembler writer. +option_incompatible_asm=11021_W_Det valgte udformat for assemblerfiler "$1" er ikke kompatibelt med "$2" +option_asm_forced=11022_W_brug af "$1" assembler gennemtvunget +% The assembler output selected can not generate +% object files with the correct format. Therefore, the +% default assembler for this target is used instead. +option_using_file=11026_T_Læser indstillinger fra filen $1 +% Options are also read from this file +option_using_env=11027_T_Læser indstillinger fra environment $1 +% Options are also read from this environment string +option_handling_option=11028_D_HÃ¥ndterer indstilling "$1" +% Debug info that an option is found and will be handled +option_help_press_enter=11029__*** tryk enter *** +option_start_reading_configfile=11030_H_Begynder at læse konfigurationsfil $1 +% Starting of config file parsing. +option_end_reading_configfile=11031_H_Er færdig med at læse konfigurationsfil $1 +% End of config file parsing. +option_interpreting_option=11032_D_fortolker indstilling "$1" +option_interpreting_firstpass_option=11036_D_fortolker indstilling til første gennemløb "$1" +option_interpreting_file_option=11033_D_fortolker filindstilling "$1" +option_read_config_file=11034_D_Læser konfigurationsfil "$1" +option_found_file=11035_D_fandt kildefilen "$1" +% Additional infos about options, displayed +% when you have debug option turned on. +option_code_page_not_available=11039_E_Ukendt tegnsæt +%\end{description} +# EndOfTeX + +# +# Logo (option -l) +# +option_config_is_dir=11040_F_Konfigurationsfilen $1 er et directory +% Directories can not be used as configuration files. +%\end{description} +# EndOfTeX + +# +# Logo (option -l) +# +option_logo=11023_[ +Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] til $FPCTARGET +Copyright (c) 1993-2011 Florian Klaempfl +] + +# +# Info (option -i) +# +option_info=11024_[ +Free Pascal Compiler version $FPCVERSION + +Compilerdato : $FPCDATE +Compilerplatform : $FPCTARGET + +Understøttede platforme: + $OSTARGETS + +Dette program dækkes af reglerne for GNU General Public License +Læs COPYING.FPC for mere information + +Indsend fejlbeskrivelser, forslag, etc til + http://bugs.freepascal.org +og + bugs@freepascal.org + +For kommentarer vedrørende den danske oversættelse, skriv til + chrivers@iversen-net.dk +] + +# +# Help pages (option -? and -h) +# +# The first character on the line indicates who will display this +# line, the current possibilities are : +# * = every target +# 3 = 80x86 targets +# 6 = 680x0 targets +# e = in extended debug mode only +# P = PowerPC targets +# S = Sparc targets +# V = Virtual machine targets +# The second character also indicates who will display this line, +# (if the above character was TRUE) the current possibilities are : +# * = everyone +# g = with GDB info supported by the compiler +# O = OS/2 +# L = UNIX systems +# The third character represents the indentation level. +# +option_help_pages=11025_[ +**0*_sæt + efter en indstilling for at slÃ¥ den til, - for at slÃ¥ den fra +**1a_compileren sletter ikke den genererede assemblerfil +**2al_lav en liste over linienummer fra kildekoden i assemblerfilen +**2ar_indsæt information om register(de)allokering i assemblerfilen +**2at_indsæt information om midlertidige allokeringer i assemblerfilen +**1b_generér browser-information +**2bl_generér information om lokale symboler +**1B_byg alle moduler +**1C<x>_Indstillinger for kodegenerering +**2CD_Byg ogsÃ¥ et dynamisk bibliotek (ikke understøttet) +**2Ce_Compilér med emulerede kommatalsoperationer +**2Cf_Vælg hvilket fpu-instruktionssæt der skal bruges +**2Cg_Generér PIC-kode +**2Ch<n>_Sæt heapstørrelsen til <n> bytes (mellem 1023 og 67107840) +**2Ci_IO-checking +**2Cn_spring link-stadiet over +**2Co_check overflow af heltalsoperationer +**2Cr_værdiomrÃ¥decheck +**2CR_verificér gyldigheden af objekters metodekald +**2Cs<n>_set stakstørrelsen til <n> +**2Ct_stakchecking +**2CX_byg ogsÃ¥ et smartlinket bibliotek +**1d<x>_definerer symbolet <x> +*O1D_genererer en DEF-fil +*O2Dd<x>_sætter beskrivelsen til <x> +*O2Dw_PM-applikation +**1e<x>_sæt stien til programmet +**1E_samme som -Cn +**1F<x>_sæt filnavne og stier: +**2FD<x>_sætter mappen hvor der søges efter hjælpeprogrammer til compileren +**2Fe<x>_videresend fejlbeskeder til <x> +**2FE<x>_sæt exe/unit sti til <x> +**2Fi<x>_tilføjer <x> til include-stien +**2Fl<x>_tilføjer <x> til library-stien +*L2FL<x>_bruger <x> som dynamisk linker +**2Fo<x>_tilføjer <x> til object-stien +**2Fr<x>_indlæser beskedfilen <x> +**2Fu<x>_tilføjer <x> til unit-stien +**2FU<x>_sæt unit-output-stien til <x>, overskriver -FE +*g1g_Generér debug-information: +*g2gg_brug gsym +*g2gd_brug dbx +*g2gh_brug heap-sporingsunit (til at finde memory leaks) +*g2gl_brug line-infounit for at vise backtraces +*g2gc_generér checks for pointere +*g2gv_generér programmer der kan spores med valgrind +*g2gw_generér dwarf debug-information +**1i_information: +**2iD_returnerer compilerdato +**2iV_returnerer compilerversion +**2iSO_returnerer compiler-OS +**2iSP_returnerer compiler-processor +**2iTO_returnerer mÃ¥l-system +**2iTP_returnerer mÃ¥l-processor +**1I<x>_tilføjer <x> til include-stien +**1k<x>_videregiv <x> til linkeren +**1l_skriv logo under kørsel +**1M<x>_sæt sprogtilstand til <x> +**2Mfpc_free pascal dialekt (standard) +**2Mobjfpc_slÃ¥ visse udvidelser fra Delphi 2 til +**2Mdelphi_forsøg at være Delphi-kompatibel +**2Mtp_forsøg at være Turbo/Borland Pascal 7.0-kompatibel +**2Mgpc_forsøg at være GNU-Pascal-kompatibel +**2Mmacpas_forsøg at være kompatibel med pascal-dialekter fra macintosh +**1n_spring læsning af standardkonfigurationsfil over +**1o<x>_ændr navnet af det producerede program til <x> +**1pg_generér profileringskode til gprof (definerer FPC_PROFILE) +*L1P_brug pipes i stedet for midlertidige assembler-filer +**1S<x>_Syntaxindstillinger: +**2S2_samme som -Mobjfpc +**2Sc_understøttet operatorer som i C (*=,+=,/= and -=) +**2Sa_bruger assertion-kode +**2Sd_samme som -Mdelphi +**2Se<x>_compileren stopper efter den <x>te fejl (standard er efter første fejl) +**2Sg_tillad LABEL og GOTO +**2Sh_brug ansistrenge +**2Si_brug C++-lignende INLINE +**2Sm_understøt makroer som I C (globalt) +**2So_samme som -Mtp +**2Sp_samme som -Mgpc +**2Ss_constructor-navn skal være "init" (destructor-navn skal være "done") +**1s_kør hverken assembler eller linker +**2sh_generér script til linkning pÃ¥ værtscomputeren +**2st_generér script til linkning pÃ¥ mÃ¥l-computeren +**2sr_spring registerallokerings-fasen over (optimeringer vil være slÃ¥et fra) +**1u<x>_fjerner definitionen af symbolet <x> +**1U_Unit-indstillinger: +**2Un_undersøg ikke om unit-navnet er korrekt +**2Ur_generér release-unit-filer +**2Us_compilér en system-enhed +**1v<x>_Ekstra information. <x> er en kombination af følgende bogstaver: +**2*_e : Vis fejl (standard) d : Vis debug-information +**2*_w : Vis advarsler u : Vis unit-information +**2*_n : Vis bemærkninger t : Vis forsøgte/benyttede filer +**2*_h : Vis hints m : Vis definerede makroer +**2*_i : Vis generel information p : Vis kompilerede procedurer +**2*_l : Vis linienumre c : Vis betingelser +**2*_a : Vis alt 0 : Vis intet (bortset fra fejl) +**2*_b : Vis alle procedure- r : Rhide/GCC kompatabilitetstilstand +**2*_ erklæringer hvis der x : Programinformation (kun pÃ¥ windows) +**2*_ opstÃ¥r en fejl +**1V_skriv filen fpcdebug.txt med store mængder debug-information +*L2Xc_link med c-biblioteket +**2Xs_fjern alle symboler fra programfilen +**2XP<x>_sæt <x> foran binutils-filnavnene +**2XD_forsøg at linke dynamisk (definerer FPC_LINK_DYNAMIC) +**2XS_forsøg at linke statisk (standard) (definerer FPC_LINK_STATIC) +**2XX_forsøg at linke intelligent (definerer FPC_LINK_SMART) +**0*_Processor-specifikke indstillinger: +3*1A<x>_Udfilformat: +3*2Aas_brug GNU AS som assembler +3*2Anasmcoff_brug Nasm til at lave en coff-fil (Go32v2) +3*2Anasmelf_brug Nasm til at lave en elf32-fil (Linux) +3*2Awasm_brug Wasm til at lave en obj-fil (Watcom) +3*2Anasmobj_brug Nasm til at lave en obj-fil +3*2Amasm_brug Masm til at lave en obj-fil (Microsoft) +3*2Atasm_brug Tasm til at lave en obj-fil (Borland) +3*2Acoff_brug intern filgenerator til at lave coff-fil (Go32v2) +3*2Apecoff_brug intern filgenerator til at lave pecoff-fil (Win32) +3*1R<x>_Læsestil for assembler: +3*2Ratt_Læs assemblerkode i AT&T-stil +3*2Rintel_Læs assemblerkode i Intel-stil +3*2Rdirect_Kopier assemblerkoden direkte ind i assemblerkildefilen +3*1O<x>_Optimeringer: +3*2Og_generér lille kode +3*2OG_generér hurtig kode (standard) +3*2Or_gem visse variabler i registre +3*2Ou_slÃ¥ usikre optimeringer til (se dokumentation) +3*2O1_niveau-1 optimeringer (hurtige optimeringer) +3*2O2_niveau-2 optimeringer (-O1 + langsommere optimeringer) +3*2O3_niveau-3 optimeringer (-O2 gentaget, højst 5 gange) +3*2Op<x>_MÃ¥lprocessor: +3*3Op1_sæt mÃ¥lprocessor til 386/486 +3*3Op2_sæt mÃ¥lprocessor til Pentium/PentiumMMX (tm) +3*3Op3_sæt mÃ¥lprocessor til PPro/PII/c6x86/K6 (tm) +3*1T<x>_MÃ¥l-operativsystem: +3*2Temx_OS/2 via EMX (bruger EMX/RSX extender) +3*2Tgo32v2_Version 2 af DJ Delorie DOS extender +3*2Tlinux_Linux +3*2Tnetware_Novell Netware Module (clib) +3*2Tnetwlibc_Novell Netware Module (libc) +3*2Tos2_OS/2 / eComStation +3*2Tsunos_SunOS/Solaris +3*2Twatcom_Watcom kompatibel DOS extender +3*2Twdosx_WDOSX DOS extender +3*2Twin32_Windows 32 Bit +3*1W<x>_Indstillinger for Win32-lignende mÃ¥l: +3*2WB<x>_sæt image base til <x> (hexadecimal) +3*2WC_specificér konsolprogram +3*2WD_brug DEFFILE til at eksportere funktioner fra DLL eller EXE +3*2WF_specificér grafisk fuldskærmsprogram (kun OS/2) +3*2WG_specificér grafisk programtype +3*2WN_lav ikke-relokérbar kode (nødvendig til debugging) +3*2WR_lav relokérbar kode +6*1A<x>_Udfilformat +6*2Aas_Brug GNU AS til at lave Unix o-filer +6*2Agas_GNU Motorola assembler +6*2Amit_MIT Syntax (old GAS) +6*2Amot_Standard Motorola assembler +6*1O_Optimeringer: +6*2Oa_slÃ¥ optimeringer til +6*2Og_generér lille kode +6*2OG_generér hurtig kode (standard) +6*2Ox_optimer maksimalt (stadig ikke fejlfri!!) +6*2O0_sæt mÃ¥lprocessor til MC68000 +6*2O2_sæt mÃ¥lprocessor til MC68020+ (standard) +6*1R<x>_Læsestil for assembleren: +6*2RMOT_Læs assemblerkode i motorola-stil +6*1T<x>_MÃ¥l-operativsystem: +6*2Tamiga_Commodore Amiga +6*2Tatari_Atari ST/STe/TT +6*2Tlinux_Linux-68k +6*2Tmacos_Macintosh m68k (ikke understøttet) +6*2Tpalmos_PalmOS +P*1T<x>_MÃ¥l-operativsystem: +P*2Tdarwin_Darwin og MacOS X pÃ¥ PowerPC +P*2Tlinux_Linux pÃ¥ PowerPC +P*2Tmacos_MacOS (klassisk) pÃ¥ PowerPC +P*2Tmorphos_MorphOS +P*2WC_Vælg konsoleapplikation (MacOS only) +P*2WG_Vælg grafisk applikation (MacOS only) +P*2WT_Vælg værktøjsapplikation (MPW tool, MacOS only) +**1*_ +**1?_vis denne hjælp +**1h_vis denne hjælp uden at vente pÃ¥ tastetryk +] + +# +# Slut :) +# +%%% general_e_path_does_not_exists=01017_E_Sti "$1" ikke fundet +% The specified path does not exists. +% \end{description} +# +# Scanner +# +# 02061 is the last used one +# +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compiling handling. +% \begin{description} +%%% scan_w_only_pack_records=02015_W_Strukturfelter kan kun opstilles pÃ¥ 1,2,4,8,16 eller 32 bytes +% You are specifying the \var{\{\$PACKRECORDS n\} } with an illegal value for +% \var{n}. Only 1, 2, 4, 8, 16 and 32 are valid in this case. +%%% scan_w_only_pack_enum=02016_W_Enumerate-typer kan kun gemmes i 1,2 eller 4 bytes +% You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for +% \var{n}. Only 1,2 or 4 are valid in this case. +%%% scan_w_macro_deep_ten=02030_W_Makroudvidelse har en dybdegrænse pÃ¥ 16 niveauer +% When expanding a macro, macros have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +%%% parser_e_no_local_external=03174_E_Kan ikke erklære lokal procedure som EXTERNAL +% Declaring local procedures as external is not possible. Local procedures +% get hidden parameters that will make the chance of errors very high +%%% parser_e_too_complex_expr=03202_E_Udtryk for komplekst - stakoverløb pÃ¥ FPU +% Your expression is too long for the compiler. You should try dividing the +% construct over multiple assignments. +%%% sym_n_uninitialized_local_variable=05036_W_Lokal variabel "$1" ser ikke ud til at være initialiseret +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +%%% sym_n_uninitialized_variable=05037_W_Variablen "$1" ser ikke ud til at være initialiseret +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +%%% unit_h_cond_not_set_in_last_compile=10038_H_Betingelsen $1 var slÃ¥et fra ved sidste compilering af $2 +% when recompilation of an unit is required the compiler will check that +% the same conditionals are set for the recompiliation. The compiler has +% found a conditional that currently is defined, but was not used the last +% time the unit was compiled. +%%% unit_h_cond_set_in_last_compile=10039_H_Betingelsen $1 var slÃ¥et til ved sidste compilering af $2 +% when recompilation of an unit is required the compiler will check that +% the same conditionals are set for the recompiliation. The compiler has +% found a conditional that was used the last time the unit was compiled, but +% the conditional is currently not defined. +%%% option_defining_symbol=11037_D_Definerer symbolet $1 +%%% option_undefining_symbol=11038_D_Fjerner symbolet $1 +% Additional infos about options, displayed +% when you have debug option turned on. diff --git a/closures/compiler/msg/errordu.msg b/closures/compiler/msg/errordu.msg new file mode 100644 index 0000000000..f13cca027d --- /dev/null +++ b/closures/compiler/msg/errordu.msg @@ -0,0 +1,3418 @@ +# +# German (UTF-8) Language File for Free Pascal +# Latest updates contributed by Karl-Michael Schindler aka mischi +# <karl-michael.schindler at web.de> +# +# Based on errore.msg of SVN revision 18275 +# +# This file is part of the Free Pascal Compiler +# Copyright (c) 1998-2010 by the Free Pascal Development team +# +# 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. +# +# +# The constants are build in the following order: +# <part>_<type>_<txtidentifier> +# +# <part> is the part of the compiler the message is used +# asmr_ assembler parsing +# asmw_ assembler writing/binary writers +# unit_ unit handling +# scan_ scanner +# parser_ parser +# type_ type checking +# general_ general info +# exec_ calls to assembler, linker, binder +# link_ internal linker +# +# <type> the type of the message it should normally used for +# f_ fatal error +# e_ error +# w_ warning +# n_ note +# h_ hint +# i_ info +# l_ add linenumber +# u_ used +# t_ tried +# c_ conditional +# d_ debug message +# x_ executable informations +# o_ normal (e.g., "press enter to continue") +# + +# +# General +# +# 01025 is the last used one +# +# BeginOfTeX +% \section{General compiler messages} +% This section gives the compiler messages which are not fatal, but which +% display useful information. The number of such messages can be +% controlled with the various verbosity level \var{-v} switches. +% \begin{description} +general_t_compilername=01000_T_Compiler: $1 +% When the \var{-vt} switch is used, this line tells you what compiler +% is used. +general_d_sourceos=01001_D_Quellbetriebssystem: $1 +% When the \var{-vd} switch is used, this line tells you what the source +% operating system is. +general_i_targetos=01002_I_Zielbetriebssystem: $1 +% When the \var{-vd} switch is used, this line tells you what the target +% operating system is. +general_t_exepath=01003_T_Der Pfad der ausführbaren Datei ist: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its binaries. +general_t_unitpath=01004_T_Der Unitpfad ist: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for compiled units. You can set this path with the \var{-Fu} option. +general_t_includepath=01005_T_Der Includepfad ist: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its include files (files used in \var{\{\$I xxx\}} statements). +% You can set this path with the \var{-Fi} option. +general_t_librarypath=01006_T_Der Bibliothekspfad ist: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for the libraries. You can set this path with the \var{-Fl} option. +general_t_objectpath=01007_T_Der Objektdateienpfad ist: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for object files you link in (files used in \var{\{\$L xxx\}} statements). +% You can set this path with the \var{-Fo} option. +general_i_abslines_compiled=01008_I_$1 Zeilen übersetzt, $2 Sekunden $3 +% When the \var{-vi} switch is used, the compiler reports the number +% of lines compiled, and the time it took to compile them (real time, +% not program time). +general_f_no_memory_left=01009_F_Speicher voll +% The compiler doesn't have enough memory to compile your program. There are +% several remedies for this: +% \begin{itemize} +% \item If you're using the build option of the compiler, try compiling the +% different units manually. +% \item If you're compiling a huge program, split it up into units, and compile +% these separately. +% \item If the previous two don't work, recompile the compiler with a bigger +% heap. (You can use the \var{-Ch} option for this, \seeo{Ch}.) +% \end{itemize} +general_i_writingresourcefile=01010_I_Resourcestringtabellendatei $1 wird geschrieben +% This message is shown when the compiler writes the Resource String Table +% file containing all the resource strings for a program. +general_e_errorwritingresourcefile=01011_E_Fehler beim Schreiben der Resourcestringtabellendatei: $1 +% This message is shown when the compiler encountered an error when writing +% the Resource String Table file. +general_i_fatal=01012_I_Fataler Fehler: +% Prefix for Fatal Errors. +general_i_error=01013_I_Fehler: +% Prefix for Errors. +general_i_warning=01014_I_Warnung: +% Prefix for Warnings. +general_i_note=01015_I_Anmerkung: +% Prefix for Notes. +general_i_hint=01016_I_Hinweis: +% Prefix for Hints. +general_e_path_does_not_exist=01017_E_Der Pfad "$1" existiert nicht +% The specified path does not exist. +general_f_compilation_aborted=01018_F_Ãœbersetzen abgebrochen +% Compilation was aborted. +general_text_bytes_code=01019_bytes Code +% The size of the generated executable code, in bytes. +general_text_bytes_data=01020_bytes Daten +% The size of the generated program data, in bytes. +general_i_number_of_warnings=01021_I_$1 Warnung(en) ausgegeben +% Total number of warnings issued during compilation. +general_i_number_of_hints=01022_I_$1 Hinweis(e) ausgegeben +% Total number of hints issued during compilation. +general_i_number_of_notes=01023_I_$1 Anmerkung(en) ausgegeben +% Total number of notes issued during compilation. +general_f_ioerror=01024_F_I/O Fehler: $1 +% During compilation an I/O error happened which allows no further compilation. +general_f_oserror=01025_F_Betriebsystemfehler: $1 +% During compilation an operanting system error happened which allows no further compilation. +% +% \end{description} +# EndOfTeX + +# +# Scanner +# +# 02088 is the last used one +# +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compilation handling. +% \begin{description} +scan_f_end_of_file=02000_F_Unerwartetes Dateiende +% this typically happens in one of the following cases: +% \begin{itemize} +% \item The source file ends before the final \var{end.} statement. This +% happens mostly when the \var{begin} and \var{end} statements aren't +% balanced; +% \item An include file ends in the middle of a statement. +% \item A comment was not closed. +% \end{itemize} +scan_f_string_exceeds_line=02001_F_Zeichenkette geht über das Zeilenende hinaus +% You forgot probably to include the closing ' in a string, so it occupies +% multiple lines. +scan_f_illegal_char=02002_F_Unzulässiges Zeichen "$1" ($2) +% An illegal character was encountered in the input file. +scan_f_syn_expected=02003_F_Syntaxfehler, "$1" erwartet, aber "$2" vorgefunden +% This indicates that the compiler expected a different token than +% the one you typed. It can occur almost anywhere it is possible to make an error +% against the Pascal language. +scan_t_start_include_file=02004_TL_Die Include-Datei $1 wird jetzt gelesen +% When you provide the \var{-vt} switch, the compiler tells you +% when it starts reading an included file. +scan_w_comment_level=02005_W_Kommentarschachtelungstiefe $1 gefunden +% When the \var{-vw} switch is used, then the compiler warns you if +% it finds nested comments. Nested comments are not allowed in Turbo Pascal +% and Delphi, and can be a possible source of errors. +scan_n_ignored_switch=02008_N_Compilerschalter $1 wurde ignoriert +% With \var{-vn} on, the compiler warns if it ignores a switch. +scan_w_illegal_switch=02009_W_Compilerschalter $1 ist ungültig +% You included a compiler switch (i.e. \var{\{\$... \}}) which the compiler +% does not recognise. +scan_w_switch_is_global=02010_W_Dieser Compilerschalter hat globale Auswirkung +% The compiler switch is misplaced, and should be located at +% the start of the unit or program. +scan_e_illegal_char_const=02011_E_Ungültige Char-Konstante +% This happens when you specify a character with its ASCII code, as in +% \var{\#96}, but the number is either illegal, or out of range. +scan_f_cannot_open_input=02012_F_Datei $1 kann nicht geöffnet werden +% \fpc cannot find the program or unit source file you specified on the +% command line. +scan_f_cannot_open_includefile=02013_F_Includedatei $1 kann nicht geöffnet werden +% \fpc cannot find the source file you specified in a \var{\{\$include ..\}} +% statement. +scan_e_illegal_pack_records=02015_E_Ungültige Record Ausrichtung "$1" +% You are specifying \var{\{\$PACKRECORDS n\} } or \var{\{\$ALIGN n\} } +% with an illegal value for \var{n}. For \$PACKRECORDS valid alignments are 1, 2, 4, 8, 16, 32, C, +% NORMAL, DEFAULT, and for \$ALIGN valid alignments are 1, 2, 4, 8, 16, 32, ON, +% OFF. Under mode MacPas \$ALIGN also supports MAC68K, POWER and RESET. +scan_e_illegal_pack_enum=02016_E_Ungültige minimale Grösse der Aufzählung "$1" +% You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for +% \var{n}. Only 1,2,4, NORMAL or DEFAULT is valid here. +scan_e_endif_expected=02017_E_$ENDIF erwartet für $1 $2 definiert in $3 Zeile $4 +% Your conditional compilation statements are unbalanced. +scan_e_preproc_syntax_error=02018_E_Syntaxfehler im Argument einer $if Direktive +% There is an error in the expression following the \var{\{\$if ..\}}, \var{\{\$ifc \}} +% or \var{\{\$setc \}} compiler directives. +scan_e_error_in_preproc_expr=02019_E_Syntaxfehler im Kontext einer $if Direktive +% There is an error in the expression following the \var{\{\$if ..\}} compiler +% directive. +scan_w_macro_cut_after_255_chars=02020_W_Inhalt des Makros wurde nach der Auswertung bei 255 Zeichen abgeschnitten +% The contents of macros cannot be longer than 255 characters. +scan_e_endif_without_if=02021_E_ENDIF ohne IF(N)DEF +% Your \var{\{\$IFDEF ..\}} and {\{\$ENDIF\}} statements aren't balanced. +scan_f_user_defined=02022_F_Benutzerdefiniert: $1 +% A user defined fatal error occurred. See also the \progref +scan_e_user_defined=02023_E_Benutzerdefiniert: $1 +% A user defined error occurred. See also the \progref +scan_w_user_defined=02024_W_Benutzerdefiniert: $1 +% A user defined warning occurred. See also the \progref +scan_n_user_defined=02025_N_Benutzerdefiniert: $1 +% A user defined note was encountered. See also the \progref +scan_h_user_defined=02026_H_Benutzerdefiniert: $1 +% A user defined hint was encountered. See also the \progref +scan_i_user_defined=02027_I_Benutzerdefiniert: $1 +% User defined information was encountered. See also the \progref +scan_e_keyword_cant_be_a_macro=02028_E_Ein Makro, das den selben Namen wie ein Schlüsselwort hat, wird ignoriert +% You cannot redefine keywords with macros. +scan_f_macro_buffer_overflow=02029_F_Makropufferüberlauf während des Lesens oder Expandierens eines Makros +% Your macro or it's result was too long for the compiler. +scan_w_macro_too_deep=02030_W_Expansion des Makros überschreitet eine Makroschachtelungstiefe von 16 +% When expanding a macro macros have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_w_wrong_styled_switch=02031_W_Compilerschalter innerhalb von Kommentaren der Form // werden nicht untersützt +% Compiler switches should be in normal Pascal style comments. +scan_d_handling_switch=02032_DL_Bearbeite Schalter "$1" +% When you set debugging info on (\var{-vd}) the compiler tells you when it +% is evaluating conditional compile statements. +scan_c_endif_found=02033_CL_ENDIF $1 bearbeitet +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifdef_found=02034_CL_IFDEF $1 bearbeitet, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifopt_found=02035_CL_IFOPT $1 bearbeitet, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_if_found=02036_CL_IF $1 bearbeitet, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifndef_found=02037_CL_IFNDEF $1 bearbeitet, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_else_found=02038_CL_ELSE $1 bearbeitet, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_skipping_until=02039_CL_Quelltext wird ignoriert bis... +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements, and whether it is skipping or +% compiling parts. +scan_i_press_enter=02040_I_Drücken Sie <Return> um fortzusetzen +% When the \var{-vi} switch is used, the compiler stops compilation +% and waits for the \var{Enter} key to be pressed when it encounters +% a \var{\{\$STOP\}} directive. +scan_w_unsupported_switch=02041_W_Nicht unterstützter Schalter $1 +% When warings are turned on (\var{-vw}), the compiler warns you about +% unsupported switches. This means that the switch is used in Delphi or +% Turbo Pascal, but not in \fpc. +scan_w_illegal_directive=02042_W_Ungültige Compilerdirektive $1 +% When warings are turned on (\var{-vw}), the compiler warns you about +% unrecognised switches. For a list of recognised switches, see the \progref +scan_t_back_in=02043_TL_Wieder zurück in $1 +% When you use the \var{-vt} switch, the compiler tells you when it has finished +% reading an include file. +scan_w_unsupported_app_type=02044_W_Nicht unterstützter Anwendungstyp: $1 +% You get this warning if you specify an unknown application type +% with the directive \var{\{\$APPTYPE\}}. +scan_w_app_type_not_support=02045_W_APPTYPE wird vom Zielbetriebssystem nicht unterstützt +% The \var{\{\$APPTYPE\}} directive is supported by win32 applications only. +scan_w_description_not_support=02046_W_Der Compilerschalter DESCRIPTION wird vom Zielbetriebssystem nicht unterstützt +% The \var{\{\$DESCRIPTION\}} directive is not supported on this target OS. +scan_n_version_not_support=02047_N_VERSION wird vom Zielbetriebssystem nicht unterstützt +% The \var{\{\$VERSION\}} directive is not supported on this target OS. +scan_n_only_exe_version=02048_N_VERSION kann in Units nicht verwendet werden +% The \var{\{\$VERSION\}} directive is only used for executable or DLL sources. +scan_w_wrong_version_ignored=02049_W_Falsches Format für VERSION-Direktive $1 +% The \var{\{\$VERSION\}} directive format is major_version.minor_version +% where major_version and minor_version are words. +scan_e_illegal_asmmode_specifier=02050_E_Unbekannter Assemblermodusname: "$1" +% When you specify an assembler mode with the \var{\{\$ASMMODE xxx\}} directive, +% the compiler didn't recognize the mode you specified. +scan_w_no_asm_reader_switch_inside_asm=02051_W_ASM-Leser-Schalter ist innerhalb einer Asm-Sequenz nicht möglich, $1 wird erst in der nächsten Sequenz wirksam +% It is not possible to switch from one assembler reader to another +% inside an assembler block. The new reader will be used for next +% assembler statement only. +scan_e_wrong_switch_toggle=02052_E_Parameter für Schalter falsch, verwenden Sie ON/OFF oder +/- +% You need to use ON or OFF or a + or - to toggle the switch. +scan_e_resourcefiles_not_supported=02053_E_Resourcedateien werden vom aktuellen Zielbetriebssystem nicht unterstützt +% The target you are compiling for doesn't support resource files. +scan_w_include_env_not_found=02054_W_$1 ist keine Umgebungsvariable +% The included environment variable can't be found in the environment; it will +% be replaced by an empty string instead. +scan_e_invalid_maxfpureg_value=02055_E_Nicht erlaubter Wert für MAXFPUREGISTER-Direktive +% Valid values for this directive are 0..8 and NORMAL/DEFAULT. +scan_w_only_one_resourcefile_supported=02056_W_Vom aktuellen Zielbetriebssystem wird nur eine Resourcedatei unterstützt +% Only one resource file can be supported for this target - this is the case of +% OS/2 (EMX) currently. The first one found is used, the others are discarded. +scan_w_macro_support_turned_off=02057_W_Makrounterstützung ist ausgeschaltet +% A macro declaration has been found, but macro support is currently off, +% so the declaration will be ignored. To turn macro support on compile with +% -Sm on the command line or add \{\$MACRO ON\} in the source. +scan_e_invalid_interface_type=02058_E_Unbekannter Interfacetyp. Unterstützt wird COM, CORBA und DEFAULT +% The interface type that was specified is not supported. +scan_w_appid_not_support=02059_W_APPID wird nur von PalmOS unterstützt +% The \var{\{\$APPID\}} directive is only supported for the PalmOS target. +scan_w_appname_not_support=02060_W_APPNAME wird nur von PalmOS unterstützt +% The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target. +scan_e_string_exceeds_255_chars=02061_E_Zeichenkettenkonstanten können maximal 255 Zeichen lang sein +% A single string constant can contain at most 255 chars. Try splitting up the +% string into multiple smaller parts and concatenate them with a + operator. +scan_f_include_deep_ten=02062_F_Include-Dateien können nur bis zu einer Tiefe von 16 geschachtelt werden +% When including include files the files have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_e_too_many_push=02063_F_Zu viele Ebenen von PUSH +% A maximum of 20 levels is allowed. This error occurs only in mode MacPas. +scan_e_too_many_pop=02064_E_POP ohne ein vorhergehendes PUSH +% This error occurs only in mode MacPas. +scan_e_error_macro_lacks_value=02065_E_Das Makro "$1" besitzt keinen Wert +% Thus the conditional compiling expression cannot be evaluated. +scan_e_wrong_switch_toggle_default=02066_E_Zum Modusumschalten kann nur ON/OFF/DEFAULT oder +/-/* verwendet werden +% You need to use ON or OFF or DEFAULT or a + or - or * to toggle the switch. +scan_e_mode_switch_not_allowed=02067_E_Der Modus Umschalter "$1" ist hier nicht erlaubt +% A mode switch has already been encountered, or, in the case of option -Mmacpas, +% a mode switch occurs after UNIT. +scan_e_error_macro_undefined=02068_E_Die Compile time Variable oder das Makro "$1" ist nicht definiert. +% Thus the conditional compile time expression cannot be evaluated. Only in mode MacPas. +scan_e_utf8_bigger_than_65535=02069_E_Der UTF-8 Code ist grösser als 65535 +% \fpc handles UTF-8 strings internally as widestrings, i.e. the char codes are limited to 65535. +scan_e_utf8_malformed=02070_E_Ungültige UTF-8 Zeichenkette +% The given string isn't a valid UTF-8 string. +scan_c_switching_to_utf8=02071_C_UTF-8 Signatur gefunden, verwende UTF-8 Code +% The compiler found a UTF-8 encoding signature (\$ef, \$bb, \$bf) at the beginning of a file, +% so it interprets it as a UTF-8 file. +scan_e_compile_time_typeerror=02072_E_Compile time Ausdruck: Erwartete $1 aber erhielt $2 bei $3 +% The type-check of a compile time expression failed. +scan_n_app_type_not_support=02073_N_APPTYPE wird vom Zielbetriebssystem nicht unterstützt +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_e_illegal_optimization_specifier=02074_E_"$1" ist eine ungültige Optimierung +% You specified an optimization with the \var{\{\$OPTIMIZATION xxx\}} directive, +% and the compiler didn't recognize the optimization you specified. +scan_w_setpeflags_not_support=02075_W_SETPEFLAGS wird vom Zielbetriebssystem nicht unterstützt +% The \var{\{\$SETPEFLAGS\}} directive is not supported by the target OS. +scan_w_imagebase_not_support=02076_W_IMAGEBASE wird vom Zielbetriebssystem nicht unterstützt +% The \var{\{\$IMAGEBASE\}} directive is not supported by the target OS. +scan_w_minstacksize_not_support=02077_W_MINSTACKSIZE wird vom Zielbetriebssystem nicht unterstützt +% The \var{\{\$IMAGEBASE\}} directive is not supported by the target OS. +scan_w_maxstacksize_not_support=02078_W_MAXSTACKSIZE wird vom Zielbetriebssystem nicht unterstützt +% The \var{\{\$MAXSTACKSIZE\}} directive is not supported by the target OS. +scanner_e_illegal_warn_state=02079_E_Ungültiger Wert "$1" für die $WARN Direktive +% Only ON and OFF can be used as state with a \var{\{\$WARN\}} compiler directive. +scan_e_only_packset=02080_E_Ungültiger Wert für das set packing +% Only 0, 1, 2, 4, 8, DEFAULT and NORMAL are allowed as packset parameters. +scan_w_pic_ignored=02081_W_PIC Direktive oder Schalter wird ignoriert +% Several targets, such as \windows, do not support nor need PIC, +% so the PIC directive and switch are ignored. +scan_w_unsupported_switch_by_target=02082_W_Der Schalter "$1" wird vom derzeit ausgewählten Zielbetriebssystem nicht unterstützt +% Some compiler switches like \$E are not supported by all targets. +scan_w_frameworks_darwin_only=02084_W_Framework-bezogene Optionen werden nur für Darwin/Mac OS X unterstützt +% Frameworks are not a known concept, or at least not supported by FPC, +% on operating systems other than Darwin/Mac OS X. +scan_e_illegal_minfpconstprec=02085_E_"$1" ist eine ungültige minimale Präzision von Fliesskommakonstanten +% Valid minimal precisions for floating point constants are default, 32 and 64, +% which mean respectively minimal (usually 32 bit), 32 bit and 64 bit precision. +scan_w_multiple_main_name_overrides=02086_W_Der Name der "main" Prozedur wird mehrfach überschrieben. Es war bisher auf "$1" gesetzt +% The name for the main entry procedure is specified more than once. Only the last +% name will be used. +scanner_w_illegal_warn_identifier=02087_W_Ungültige Bezeichner "$1" für die $WARN Direktive +% Identifier is not known by a \var{\{\$WARN\}} compiler directive. +scanner_e_illegal_alignment_directive=02088_E_Ungültige "alignment" Direktive +% The alignment directive is not valid. Either the alignment type is not known or the alignment +% value is not a power of two. +% +% \end{description} +# EndOfTeX + +# +# Parser +# +# 03313 is the last used one +# +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your Pascal constructs +% are correct. +% \begin{description} +parser_e_syntax_error=03000_E_Parser - Syntaxfehler +% An error against the Turbo Pascal language was encountered. This typically +% happens when an illegal character is found in the source file. +parser_e_dont_nest_interrupt=03004_E_INTERRUPT-Prozeduren dürfen nicht verschachtelt sein +% An \VAR{INTERRUPT} procedure must be global. +parser_w_proc_directive_ignored=03005_W_Prozedurtyp $1 wird ignoriert +% The specified procedure directive is ignored by FPC programs. +parser_e_no_overload_for_all_procs=03006_E_Nicht alle Deklarationen von "$1" sind mit OVERLOAD deklariert +% When you want to use overloading using the \var{OVERLOAD} directive, then +% all declarations need to have \var{OVERLOAD} specified. +parser_e_export_name_double=03008_E_Doppelter Name für exportierte Funktion $1 +% Exported function names inside a specific DLL must all be different. +parser_e_export_ordinal_double=03009_E_Doppelter Index für exportierte Funktion $1 +% Exported function names inside a specific DLL must all be different. +parser_e_export_invalid_index=03010_E_Ungültiger Index for exportierte Funktion +% DLL function index must be in the range \var{1..\$FFFF}. +parser_w_parser_reloc_no_debug=03011_W_Für relozierbare DLL oder ausführbare Datei $1 funktionieren keine Debug-Information, deaktiviert. +% It is currently not possible to include debug information in a relocatable DLL. +parser_w_parser_win32_debug_needs_WN=03012_W_Um Win32-Code debuggen zu können, müssen die Relozierungen mit -WN option abgeschaltet werden. +% Stabs debug info is wrong for relocatable DLL or EXES. Use -WN +% if you want to debug win32 executables. +parser_e_constructorname_must_be_init=03013_E_Konstruktor-Name muss INIT sein +% You are declaring a constructor with a name which isn't \var{init}, and the +% \var{-Ss} switch is in effect. See the switch \seeo{Ss}. +parser_e_destructorname_must_be_done=03014_E_Destruktor-Name muss DONE sein +% You are declaring a constructor with a name which isn't \var{done}, and the +% \var{-Ss} switch is in effect. See the switch \seeo{Ss}. +parser_e_proc_inline_not_supported=03016_E_Schlüsselwort INLINE nicht unterstützt +% You tried to compile a program with C++ style inlining, and forgot to +% specify the \var{-Si} option (\seeo{Si}). The compiler doesn't support C++ +% styled inlining by default. +parser_w_constructor_should_be_public=03018_W_Konstruktor muss PUBLIC sein +% Constructors must be in the 'public' part of an object (class) declaration. +parser_w_destructor_should_be_public=03019_W_Destruktor muss PUBLIC sein +% Destructors must be in the 'public' part of an object (class) declaration. +parser_n_only_one_destructor=03020_N_Klasse darf nur einen Destruktor besitzen +% You can declare only one destructor for a class. +parser_e_no_local_objects=03021_E_Lokale Klassendefinitionen sind nicht zulässig +% Classes must be defined globally. They cannot be defined inside a +% procedure or function. +parser_f_no_anonym_objects=03022_F_Anonyme Klassendefinitionen sind nicht zulässig +% An invalid object (class) declaration was encountered, i.e. an +% object or class without methods that isn't derived from another object or +% class. For example: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% will trigger this error. +parser_n_object_has_no_vmt=03023_N_Das Objekt "$1" besitzt keine VMT +% This is a note indicating that the declared object has no +% virtual method table. +parser_e_illegal_parameter_list=03024_E_Ungültige Parameterliste +% You are calling a function with parameters that are of a different type than +% the declared parameters of the function. +parser_e_wrong_parameter_size=03026_E_Falsche Anzahl an Parameter im Aufruf von "$1" angegeben +% There is an error in the parameter list of the function or procedure -- +% the number of parameters is not correct. +parser_e_overloaded_no_procedure=03027_E_Bezeichner "$1" ist keine Funktion, overload nicht möglich +% The compiler encountered a symbol with the same name as an overloaded +% function, but it isn't a function it can overload. +parser_e_overloaded_have_same_parameters=03028_E_Overload-Funktion darf keine identische Parameterliste aufweisen +% You're declaring overloaded functions, but with the same parameter list. +% Overloaded function must have at least 1 different parameter in their +% declaration. +parser_e_header_dont_match_forward=03029_E_Funktionskopf unterscheidet sich von voriger Deklaration "$1" +% You declared a function with the same parameters but +% different result type or function specifiers. +parser_e_header_different_var_names=03030_E_Funktionskopf von "$1" passt nicht zur Forward-Deklaration, Variablename ändert sich: $2 => $3 +% You declared the function in the \var{interface} part, or with the +% \var{forward} directive, but defined it with a different parameter list. +parser_n_duplicate_enum=03031_N_Werte in Aufzählungen müssen aufsteigend sein +% \fpc allows enumeration constructions as in C. Examine the following +% two declarations: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% The second declaration would produce an error. \var{A\_UAS} needs to have a +% value higher than \var{A\_E}, i.e. at least 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_WITH kann nicht auf Variablen in anderen Segmenten angewendet werden +% With stores a variable locally on the stack, +% but this is not possible if the variable belongs to another segment. +parser_e_too_much_lexlevel=03034_E_Funktionsverschachtelung grösser als 31 +% You can nest function definitions only 31 levels deep. +parser_e_range_check_error=03035_E_Bereichsprüfungsfehler bei Konstantenbestimmung +% The constants are out of their allowed range. +parser_w_range_check_error=03036_W_Bereichsprüfungsfehler bei Konstantenbestimmung +% The constants are out of their allowed range. +parser_e_double_caselabel=03037_E_doppelter CASE-Wert +% You are specifying the same label 2 times in a \var{case} statement. +parser_e_case_lower_less_than_upper_bound=03038_E_Obere Grenze der CASE-Bereichsangabe ist kleiner als untere Grenze +% The upper bound of a \var{case} label is less than the lower bound and this +% is useless. +parser_e_type_const_not_possible=03039_E_Klassen oder Interfaces 03229_Esind als typisierte Konstanten unzulässig +% You cannot declare a constant of type class or object. +parser_e_no_overloaded_procvars=03040_E_Funktionsvariablen von Overload-Funktionen sind unzulässig +% You are trying to assign an overloaded function to a procedural variable. +% This is not allowed. +parser_e_invalid_string_size=03041_E_Stringlänge muss ein Wert zwischen 1 und 255 sein +% The length of a string in Pascal is limited to 255 characters. You are +% trying to declare a string with length less than 1 or greater than 255. +parser_w_use_extended_syntax_for_objects=03042_W_Benutzen Sie die erweiterte Syntax von NEW und DISPOSE für Objekt-Instanzen +% If you have a pointer \var{a} to an object type, then the statement +% \var{new(a)} will not initialize the object (i.e. the constructor isn't +% called), although space will be allocated. You should issue the +% \var{new(a,init)} statement. This will allocate space, and call the +% constructor of the object. +parser_w_no_new_dispose_on_void_pointers=03043_W_Verwendung von NEW oder DISPOSE mit untypisierten Pointern ist ohne Aussage +parser_e_no_new_dispose_on_void_pointers=03044_E_Verwendung von NEW oder DISPOSE mit untypisierten Pointern ist nicht möglich +% You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer +% because no size is associated to an untyped pointer. +% It is accepted for compatibility in \var{TP} and \var{DELPHI} modes, but the +% compiler will still warn you if it finds such a construct. +parser_e_class_id_expected=03045_E_Klassenbezeichner erwartet +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., an object or class method, but the type in front of the dot is not +% a known type. +parser_e_no_type_not_allowed_here=03046_E_Typbezeichner ist hier nicht zulässig +% You cannot use a type inside an expression. +parser_e_methode_id_expected=03047_E_Methodenbezeichner erwartet +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., an object or class method, but the procedure name is not a +% procedure of this type. +parser_e_header_dont_match_any_member=03048_E_Funktionskopf passt zu keiner Methode der Klasse $1 +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., an object or class method, but the procedure name is not a +% procedure of this type. +parser_d_procedure_start=03049_DL_Procedure/Function $1 +% When using the \var{-vd} switch, the compiler tells you when it starts +% processing a procedure or function implementation. +parser_e_error_in_real=03050_E_Ungültige Fliesskommakonstante +% The compiler expects a floating point expression, and gets something else. +parser_e_fail_only_in_constructor=03051_E_FAIL darf nur in Konstruktoren verwendet werden +% You are using the \var{FAIL} instruction outside a constructor method. +parser_e_no_paras_for_destructor=03052_E_Destruktoren können keine Parameter haben +% You are declaring a destructor with a parameter list. Destructor methods +% cannot have parameters. +parser_e_only_class_members_via_class_ref=03053_E_Nur Klassenmethoden, Klasseneigenschaften und Klassenvariablen können über den Klassennamen angesprochen werden +% This error occurs in a situation like the following: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} is not a class method and hence cannot be called with a class +% reference. +parser_e_only_class_members=03054_E_Nur Klassenmethoden, Klasseneigenschaften und Klassenvariablen können in einer Klassenmethode angesprochen werden +% This is related to the previous error. You cannot call a method of an object +% from inside a class method. The following code would produce this error: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% Because free is a normal method of a class it cannot be called from a class +% method. +parser_e_case_mismatch=03055_E_Konstante und CASE-Typ passen nicht zueinander +% One of the labels is not of the same type as the case variable. +parser_e_illegal_symbol_exported=03056_E_Das Symbol kann nicht aus einer Bibliothek exportiert werden +% You can only export procedures and functions when you write a library. You +% cannot export variables or constants. +parser_w_should_use_override=03057_W_Eine Inherit-Methode wird durch $1 verdeckt +% A method that is declared \var{virtual} in a parent class, should be +% overridden in the descendant class with the \var{override} directive. If you +% don't specify the \var{override} directive, you will hide the parent method; +% you will not override it. +parser_e_nothing_to_be_overridden=03058_E_Es gibt keine Vorgängerklasse mit einer Methode, die damit überschrieben werden könnte: $1 +% You try to \var{override} a virtual method of a parent class that doesn't +% exist. +parser_e_no_procedure_to_access_property=03059_E_Es gibt keine Member-Funktion um auf diese Property zuzugreifen +% You specified no \var{read} directive for a property. +parser_w_stored_not_implemented=03060_W_Die Stored Property - Direktive ist noch nicht implementiert +% This message is no longer used, as the \var{stored} directive has been implemented. +parser_e_ill_property_access_sym=03061_E_Ungültiges Symbol für den Zugriff auf die Property +% There is an error in the \var{read} or \var{write} directives for an array +% property. When you declare an array property, you can only access it with +% procedures and functions. The following code would cause such an error. +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_Kann an dieser Stelle nicht auf das geschützte Feld des Objekts zugreifen +% Fields that are declared in a \var{protected} section of an object or class +% declaration cannot be accessed outside the module where the object is +% defined, or outside descendent object methods. +parser_e_cant_access_private_member=03063_E_Kann an dieser Stelle nicht auf das private Feld des Objekts zugreifen +% Fields that are declared in a \var{private} section of an object or class +% declaration cannot be accessed outside the module where the class is +% defined. +parser_e_overridden_methods_not_same_ret=03066_E_Ãœberschriebene, virtuelle Methoden müssen den gleichen Ergebnistyp haben: "$2" wird überschrieben von "$1" +% If you declare overridden methods in a class definition, they must +% have the same return type. +parser_e_dont_nest_export=03067_E_Mit EXPORT deklarierte Funktionen dürfen nicht verschachtelt sein +% You cannot declare a function or procedure within a function or procedure +% that was declared as an export procedure. +parser_e_methods_dont_be_export=03068_E_Methoden dürfen nicht EXPORTiert werden +% You cannot declare a procedure that is a method for an object as +% \var{export}ed. That is, your methods cannot be called from a C program. +parser_e_call_by_ref_without_typeconv=03069_E_Aufrufe mit VAR-Parametern für Argument-Nr. $1 müssen exakt stimmen: "$2" gefunden, "$3" erwartet +% When calling a function declared with \var{var} parameters, the variables in +% the function call must be of exactly the same type. There is no automatic +% type conversion. +parser_e_no_super_class=03070_E_Klasse ist keine Elternklasse zur aktuellen Klasse +% When calling inherited methods, you are trying to call a method of a strange +% class. You can only call an inherited method of a parent class. +parser_e_self_not_in_method=03071_E_SELF ist nur in Methoden erlaubt +% You are trying to use the \var{self} parameter outside an object's method. +% Only methods get passed the \var{self} parameters. +parser_e_generic_methods_only_in_methods=03072_E_Methoden dürfen nur in anderen Methoden direkt mit dem Klassen-Typbezeichner aufgerufen werden +% A construction like \var{sometype.somemethod} is only allowed in a method. +parser_e_illegal_colon_qualifier=03073_E_Unzulässige Verwendung von ':' +% You are using the format \var{:} (colon) 2 times on an expression that +% is not a real expression. +parser_e_illegal_set_expr=03074_E_Bereichsprüfungsfehler im SET-Konstruktor oder doppeltes Set-Element +% The declaration of a set contains an error. Either one of the elements is +% outside the range of the set type, or two of the elements are in fact +% the same. +parser_e_pointer_to_class_expected=03075_E_Zeiger auf Objekt erwartet +% You specified an illegal type in a \var{New} statement. +% The extended synax of \var{New} needs an object as a parameter. +parser_e_expr_have_to_be_constructor_call=03076_E_Ausdruck muss ein Konstruktor-Aufruf sein +% When using the extended syntax of \var{new}, you must specify the constructor +% method of the object you are trying to create. The procedure you specified +% is not a constructor. +parser_e_expr_have_to_be_destructor_call=03077_E_Ausdruck muss ein Destruktor-Aufruf sein +% When using the extended syntax of \var{dispose}, you must specify the +% destructor method of the object you are trying to dispose of. +% The procedure you specified is not a destructor. +parser_e_invalid_record_const=03078_E_Unzulässige Reihenfolge der Record-Elemente +% When declaring a constant record, you specified the fields in the wrong +% order. +parser_e_false_with_expr=03079_E_Typ des Ausdrucks muss eine Klasse oder ein Recordtyp sein +% A \var{with} statement needs an argument that is of the type \var{record} +% or \var{class}. You are using \var{with} on an expression that is not of +% this type. +parser_e_void_function=03080_E_Prozeduren können keinen Wert zurückliefern +% In \fpc, you can specify a return value for a function when using +% the \var{exit} statement. This error occurs when you try to do this with a +% procedure. Procedures cannot return a value. +parser_e_only_methods_allowed=03081_E_Konstruktoren, Destruktoren und Klassenoperatoren müssen Methoden sein +% You're declaring a procedure as destructor, constructor or class operator, when the +% procedure isn't a class method. +parser_e_operator_not_overloaded=03082_E_Operator besitzt kein Overload +% You're trying to use an overloaded operator when it isn't overloaded for +% this type. +parser_e_no_such_assignment=03083_E_Es ist nicht möglich, die Zuweisung für gleiche Typen zu überladen +% You cannot overload assignment for types +% that the compiler considers as equal. +parser_e_overload_impossible=03084_E_Unmögliche Operator-.berladung +% The combination of operator, arguments and return type are +% incompatible. +parser_e_no_reraise_possible=03085_E_Auslösen einer Exception an dieser Stelle nicht möglich +% You are trying to re-raise an exception where it is not allowed. You can only +% re-raise exceptions in an \var{except} block. +parser_e_no_new_or_dispose_for_classes=03086_E_Die erweiterte Syntax von New oder Dispose ist für Klassen unzulässig +% You cannot generate an instance of a class with the extended syntax of +% \var{new}. The constructor must be used for that. For the same reason, you +% cannot call \var{Dispose} to de-allocate an instance of a class, the +% destructor must be used for that. +parser_e_procedure_overloading_is_off=03088_E_Das Ãœberladen von Prozeduren ist ausgeschaltet +% When using the \var{-So} switch, procedure overloading is switched off. +% Turbo Pascal does not support function overloading. +parser_e_overload_operator_failed=03089_E_Es ist nicht möglich, dieesen Operator zu überladen. Verwandte überladbare Operatoren sind "$1" +% You are trying to overload an operator which cannot be overloaded. +% The following operators can be overloaded : +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_Vergleichsoperator muss einen booleschen Wert zurückgeben +% When overloading the \var{=} operator, the function must return a boolean +% value. +parser_e_only_virtual_methods_abstract=03091_E_Nur virtuelle Methoden können abstrakt sein +% You are declaring a method as abstract, when it isn't declared to be +% virtual. +parser_f_unsupported_feature=03092_F_Benutzung einer nicht unterstützten Erweiterung! +% You're trying to force the compiler into doing something it cannot do yet. +parser_e_mix_of_classes_and_objects=03093_E_Das Mischen von Klassen und Objekten ist unzulässig +% You cannot derive \var{objects}, \var{classes}, \var{cppclasses} and \var{interfaces} intertwined. E.g. +% a class cannot have an object as parent and vice versa. +parser_w_unknown_proc_directive_ignored=03094_W_Unbekannte Prozedur, Direktive $1 wurde ignoriert +% The procedure direcive you secified is unknown. +parser_e_absolute_only_one_var=03095_E_ABSOLUTE kann nur auf eine alleinstehende Variable angewendet werden +% You cannot specify more than one variable before the \var{absolute} directive. +% Thus, the following construct will provide this error: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +parser_e_absolute_only_to_var_or_const=03096_E_ABSOLUTE kann nur auf Variablen und Konstanten angewendet werden +% The address of an \var{absolute} directive can only point to a variable or +% constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_initialized_only_one_var=03097_E_Es kann nur EINE Variable initialisiert werden +% You cannot specify more than one variable with a initial value in Delphi mode. +parser_e_abstract_no_definition=03098_E_Abstrakte Methoden dürfen keine Definition (mit Rumpf) haben +% Abstract methods can only be declared, you cannot implement them. They +% should be overridden by a descendant class. +parser_e_overloaded_must_be_all_global=03099_E_Diese überladene Funktion darf nicht lokal sein (muss Exportiert werden) +% You are defining an overloaded function in the implementation part of a unit, +% but there is no corresponding declaration in the interface part of the unit. +parser_w_virtual_without_constructor=03100_W_Virtuelle Methoden wurden ohne Konstruktor verwendet in $1 +% If you declare objects or classes that contain virtual methods, you need +% to have a constructor and destructor to initialize them. The compiler +% encountered an object or class with virtual methods that doesn't have +% a constructor/destructor pair. +parser_c_macro_defined=03101_CL_Makro definiert: $1 +% When \var{-vc} is used, the compiler tells you when it defines macros. +parser_c_macro_undefined=03102_CL_Makrodefinition gelöscht: $1 +% When \var{-vc} is used, the compiler tells you when it undefines macros. +parser_c_macro_set_to=03103_CL_Wert des Makros $1 auf $2 gesetzt +% When \var{-vc} is used, the compiler tells you what values macros get. +parser_i_compiling=03104_I_Ãœbersetze $1 +% When you turn on information messages (\var{-vi}), the compiler tells you +% what units it is recompiling. +parser_u_parsing_interface=03105_UL_Parse Interface von Unit $1 +% This tells you that the reading of the interface +% of the current unit has started +parser_u_parsing_implementation=03106_UL_Parse Implementation von $1 +% This tells you that the code reading of the implementation +% of the current unit, library or program starts +parser_d_compiling_second_time=03107_DL_Ãœbersetze $1 zum zweiten Mal +% When you request debug messages (\var{-vd}) the compiler tells you what +% units it recompiles for the second time. +parser_e_no_property_found_to_override=03109_E_Es gibt keine Property diesen Namens, die überschrieben werden könnte +% You want to overrride a property of a parent class, when there is, in fact, +% no such property in the parent class. +parser_e_only_one_default_property=03110_E_Es ist nur eine einzelne Default-Property erlaubt, vererbte Default-Property in Klasse $1 gefunden +% You specified a property as \var{Default}, but a parent class already has a +% default property, and a class can have only one default property. +parser_e_property_need_paras=03111_E_Die Default-Property muss eine Array-Property sein +% Only array properties of classes can be made \var{default} properties. +parser_e_constructor_cannot_be_not_virtual=03112_E_Virtuelle Konstruktoren werden nur im Klassen-Objektmodell unterstützt +% You cannot have virtual constructors in objects. You can only have them +% in classes. +parser_e_no_default_property_available=03113_E_Keine Default-Property verfügbar +% You try to access a default property of a class, but this class (or one of +% its ancestors) doesn't have a default property. +parser_e_cant_have_published=03114_E_Die Klasse kann keinen PUBLISHED Bereich haben, benutzen Sie den {$M+} Schalter +% If you want a \var{published} section in a class definition, you must +% use the \var{\{\$M+\}} switch, which turns on generation of type +% information. +parser_e_forward_declaration_must_be_resolved=03115_E_Forward-Deklaration der Klasse $1 muss hier aufgelöst werden, wenn sie als Elternklasse benutzt werden soll +% To be able to use an object as an ancestor object, it must be defined +% first. This error occurs in the following situation: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% where \var{ParentClass} is declared but not defined. +parser_e_no_local_operator=03116_E_Lokale Operatoren werden nicht unterstützt +% You cannot overload locally, i.e. inside procedures or function +% definitions. +parser_e_proc_dir_not_allowed_in_interface=03117_E_Prozedur-Direktive $1 unzulässig im Interface-Bereich +% This procedure directive is not allowed in the \var{interface} section of +% a unit. You can only use it in the \var{implementation} section. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_Prozedur Direktive $1 unzulässig im Implementation-Bereich +% This procedure directive is not allowed in the \var{implementation} section of +% a unit. You can only use it in the \var{interface} section. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_Prozedur-Direktive $1 unzulässig in einer Procvar-Deklaration +% This procedure directive cannot be part of a procedural of function +% type declaration. +parser_e_function_already_declared_public_forward=03120_E_Funktion ist bereits als Public oder Forward deklariert: $1 +% You will get this error if a function is defined as \var{forward} twice. +% Or if it occurs in the \var{interface} section, and again as a \var{forward} +% declaration in the \var{implementation} section. +parser_e_not_external_and_export=03121_E_Kann nicht EXPORT und EXTERNAL gleichzeitig benutzen +% These two procedure directives are mutually exclusive. +parser_w_not_supported_for_inline=03123_W_$1 noch nicht innerhalb von inline Prozeduren/Funktionen unterstützt +% Inline procedures don't support this declaration. +parser_w_inlining_disabled=03124_W_Inlining deaktiviert +% Inlining of procedures is disabled. +parser_i_writing_browser_log=03125_I_Schreibe Browser-Log $1 +% When information messages are on, the compiler warns you when it +% writes the browser log (generated with the \var{\{\$Y+\}} switch). +parser_h_maybe_deref_caret_missing=03126_H_Möglicherweise fehlt eine Zeiger-Dereferenzierung +% The compiler thinks that a pointer may need a dereference. +parser_f_assembler_reader_not_supported=03127_F_Gewählter Assembler-Leser nicht unterstützt +% The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not +% supported. The compiler can be compiled with or without support for a +% particular assembler reader. +parser_e_proc_dir_conflict=03128_E_Prozedur-Direktive $1 steht in Konflikt mit anderen Direktiven +% You specified a procedure directive that conflicts with other directives. +% For instance \var{cdecl} and \var{pascal} are mutually exclusive. +parser_e_call_convention_dont_match_forward=03129_E_Aufrufkonvention passt nicht zur Forward-Deklaration +% This error happens when you declare a function or procedure with +% e.g. \var{cdecl;} but omit this directive in the implementation, or vice +% versa. The calling convention is part of the function declaration, and +% must be repeated in the function definition. +parser_e_property_cant_have_a_default_value=03131_E_Property kann keinen Vorgabewert haben +% Set properties or indexed properties cannot have a default value. +parser_e_property_default_value_must_const=03132_E_Der Vorgabewert einer Property muss eine Konstante sein +% The value of a \var{default} declared property must be known at compile +% time. The value you specified is only known at run time. This happens +% e.g. if you specify a variable name as a default value. +parser_e_cant_publish_that=03133_E_Symbol darf nicht PUBLISHED sein, dies kann nur eine Klasse sein +% Only class type variables can be in a \var{published} section of a class +% if they are not declared as a property. +parser_e_cant_publish_that_property=03134_E_Diese Property-Art kann nicht PUBLISHED sein +% Properties in a \var{published} section cannot be array properties. +% They must be moved to public sections. Properties in a \var{published} +% section must be an ordinal type, a real type, strings or sets. +parser_e_empty_import_name=03136_E_Leerer Importname angegeben +% Some targets need a name for the imported procedure or a \var{cdecl} specifier. +parser_e_division_by_zero=03138_E_Division durch Null +% A division by zero was encounted. +parser_e_invalid_float_operation=03139_E_Ungültige Fliesskomma-Operation +% An operation on two real type values produced an overflow or a division +% by zero. +parser_e_array_lower_less_than_upper_bound=03140_E_Obere Grenze des Bereichs ist kleiner als die untere Grenze +% The upper bound of an array declaration is less than the lower bound and this +% is not possible. +parser_w_string_too_long=03141_W_String "$1" ist länger als $2 +% The size of the constant string is larger than the size you specified in +% string type definition. +parser_e_string_larger_array=03142_E_Stringlänge ist grösser als die Länge des "array of char" +% The size of the constant string is larger than the size you specified in +% the \var{Array[x..y] of char} definition. +parser_e_ill_msg_expr=03143_E_Ungültiger Ausdruck nach der 'Message'-Direktive +% \fpc supports only integer or string values as message constants. +parser_e_ill_msg_param=03144_E_Message-Handler akzeptieren nur einen "Call by Reference" Parameter +% A method declared with the \var{message} directive as message handler +% can take only one parameter which must be declared as call by reference. +% Parameters are declared as call by reference using the \var{var}-directive. +parser_e_duplicate_message_label=03145_E_Doppeltes Message-Label: $1 +% A label for a message is used twice in one object/class. +parser_e_self_in_non_message_handler=03146_E_SELF darf nur in Message-Handlern ein expliziter Parameter sein +% The \var{Self} parameter can only be passed explicitly to a method which +% is declared as message method handler +parser_e_threadvars_only_sg=03147_E_Threadvariablen können nur statisch oder global sein +% Threadvars must be static or global; you can't declare a thread +% local to a procedure. Local variables are always local to a thread, +% because every thread has its own stack and local variables +% are stored on the stack. +parser_f_direct_assembler_not_allowed=03148_F_Direkter Assembler wird f+r binäres Ausgabeformat nicht unterstützt +% You can't use direct assembler when using a binary writer. Choose an +% other output format or use another assembler reader. +parser_w_no_objpas_use_mode=03149_W_Laden Sie die OBJPAS Unit nicht manuell, benutzen Sie statdessen {$mode objfpc} oder {$mode delphi} +% You are trying to load the \file{ObjPas} unit manually from a \var{uses} clause. +% This is not a good idea. Use the \var{\{\$MODE OBJFPC\}} or +% \var{\{\$mode delphi\}} directives which load the unit automatically. +parser_e_no_object_override=03150_E_OVERRIDE darf in Objekten nicht verwendet werden +% \var{Override} is not supported for objects, use \var{virtual} instead to override +% a method of a parent object. +parser_e_cant_use_inittable_here=03151_E_Datentypen, die ein Initialiserung oder Finalisierung benötigen, können in varianten Records nicht verwendet werden +% Some data types (e.g. \var{ansistring}) need initialization/finalization +% code which is implicitly generated by the compiler. Such data types +% can't be used in the variant part of a record. +parser_e_resourcestring_only_sg=03152_E_Resourcestrings dürfen nur statisch oder global sein +% Resourcestring cannot be declared local, only global or using the static +% directive. +parser_e_exit_with_argument_not__possible=03153_E_EXIT mit Argument darf hier nicht verwendet werden +% An exit statement with an argument for the return value can't be used here. This +% can happen for example in \var{try..except} or \var{try..finally} blocks. +parser_e_stored_property_must_be_boolean=03154_E_Der Typ des STORED-Symbols muss boolesch sein +% If you specify a storage symbol in a property declaration, it must be a +% boolean type. +parser_e_ill_property_storage_sym=03155_E_Dieses Symbol ist als Speichersymbol unzulässig +% You can't use this type of symbol as storage specifier in property +% declaration. You can use only methods with the result type boolean, +% boolean class fields or boolean constants. +parser_e_only_publishable_classes_can_be_published=03156_E_Nur Klassen, die im "$M+"-Modus übersetzt wurden, dürfen published sein +% A class-typed field in the published section of a class can only be a class which was +% compiled in \var{\{\$M+\}} or which is derived from such a class. Normally +% such a class should be derived from \var{TPersistent}. +parser_e_proc_directive_expected=03157_E_Prozedurdirektive erwartet +% This error is triggered when you have a \var{\{\$Calling\}} directive without +% a calling convention specified. +% It also happens when declaring a procedure in a const block and you +% used a ; after a procedure declaration which must be followed by a +% procedure directive. +% Correct declarations are: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_Der Wert für einen Property-Index muss ordinalen Typs sein +% The value you use to index a property must be of an ordinal type, for +% example an integer or enumerated type. +parser_e_procname_to_short_for_export=03159_E_Prozedurname zu kurz um exportiert zu werden +% The length of the procedure/function name must be at least 2 characters +% long. This is because of a bug in dlltool which doesn't parse the .def +% file correctly with a name of length 1. +parser_e_dlltool_unit_var_problem=03160_E_Es kann kein DEFFILE-Eintrag für unit-globale Variablen erzeugt werden +parser_e_dlltool_unit_var_problem2=03161_E_Ãœbersetze ohne "-WD"-Option +% You need to compile this file without the -WD switch on the +% command line. +parser_f_need_objfpc_or_delphi_mode=03162_F_Es muss der Modus ObjFPC (-S2) oder Delphi (-Sd) aktiv sein, um dieses Modul zu übersetzen +% You need to use \var{\{\$MODE OBJFPC\}} or \var{\{\$MODE DELPHI\}} to compile this file. +% Or use the corresponding command line switch, either \var{-Mobjfpc} or \var{-MDelphi.} +parser_e_no_export_with_index_for_target=03163_E_Der Index darf nicht kleiner als $1 sein +% Exporting of functions or procedures with a specified index is not +% supported on this target. +parser_e_no_export_of_variables_for_target=03164_E_Das Ziel $1 unterstützt das Exportieren von Variablen nicht +% Exporting of variables is not supported on this target. +parser_e_improper_guid_syntax=03165_E_Falscher GUID-Syntax +% The GUID indication does not have the proper syntax. It should be of the form +% \begin{verbatim} +% {XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX} +% \end{verbatim} +% Where each \var{X} represents a hexadecimal digit. +parser_w_interface_mapping_notfound=03168_W_Eine Prozedur mit dem Namen "$1", die $2.$3 implementieren könnte, kann nicht gefunden werden +% The compiler cannot find a suitable procedure which implements the given method of an interface. +% A procedure with the same name is found, but the arguments do not match. +parser_e_interface_id_expected=03169_E_Interface-Bezeichner erwartet +% This happens when the compiler scans a \var{class} declaration that contains +% \var{interface} function name mapping code like this: +% \begin{verbatim} +% type +% TMyObject = class(TObject, IDispatch) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% and the \var{interface} before the dot is not listed in the inheritance list. +parser_e_type_cant_be_used_in_array_index=03170_E_Der Typ "$1" kann nicht als Array-Index verwendet werden +% Types like \var{qword} or \var{int64} aren't allowed as array index type. +parser_e_no_con_des_in_interfaces=03171_E_Kon- und Destruktoren sind in Interfaces nicht erlaubt +% Constructor and destructor declarations aren't allowed in interfaces. +% In the most cases method \var{QueryInterface} of \var{IUnknown} can +% be used to create a new interface. +parser_e_no_access_specifier_in_interfaces=03172_E_Zugriffsbezeichner können in INTERFACEs und OBJCPROTOCOLs nicht benutzt werden +% The access specifiers \var{public}, \var{private}, \var{protected} and +% \var{published} can't be used in interfaces, Objective-C protocols and categories because all methods +% of an interface/protocol/category must be public. +parser_e_no_vars_in_interfaces=03173_E_Ein Interface, ein Helfer, ein Objective-C Protokoll oder eine Kategorie darf keine Felder enthalten +% Declarations of fields are not allowed in interfaces, helpers and Objective-C protocols and categories. +% An interface/helper/protocol/category can contain only methods and properties with method read/write specifiers. +parser_e_no_local_proc_external=03174_E_Eine lokale Prozedur kann nicht als EXTERNAL deklariert werden +% Declaring local procedures as external is not possible. Local procedures +% get hidden parameters that will make the chance of errors very high. +parser_w_skipped_fields_before=03175_W_Einige Felder vor dem Feld "$1" sind nicht initialisiert +% In Delphi mode, not all fields of a typed constant record have to be +% initialized, but the compiler warns you when it detects such situations. +parser_e_skipped_fields_before=03176_E_Einige Felder vor dem Feld "$1" sind nicht initialisiert +% In all syntax modes but Delphi mode, you can't leave some fields uninitialized +% in the middle of a typed constant record. +parser_w_skipped_fields_after=03177_W_Einige Felder nach dem Feld "$1" sind nicht initialisiert +% You can leave some fields at the end of a type constant record uninitialized +% (The compiler will initialize them to zero automatically). This may be the cause +% of subtle problems. +parser_e_varargs_need_cdecl_and_external=03178_E_Verwendung von VarArgs (oder '...' in MacPas) ohne CDecl/CPPDecl/MWPascal oder External nicht möglich +% The varargs directive (or the ``...'' varargs parameter in MacPas mode) can only be +% used with procedures or functions that are declared with \var{external} and one of +% \var{cdecl}, \var{cppdecl} and \var{mwpascal}. This functionality +% is only supported to provide a compatible interface to C functions like printf. +parser_e_self_call_by_value=03179_E_Self muss ein Call-By-Value-Parameter sein +% You can't declare \var{Self} as a const or var parameter, it must always be +% a call-by-value parameter. +parser_e_interface_has_no_guid=03180_E_Interface "$1" hat keine Interface-Identifikation +% When you want to assign an interface to a constant, then the interface +% must have a GUID value set. +parser_e_illegal_field_or_method=03181_E_Klassenfeld oder Methoden-Bezeichner "$1" unbekannt +% Properties must refer to a field or method in the same class. +parser_w_proc_overriding_calling=03182_W_Ãœberschreibe die Calling Convention "$1" mit "$2" +% There are two directives in the procedure declaration that specify a calling +% convention. Only the last directive will be used. +parser_e_no_procvarobj_const=03183_E_Die Konstante des Typs "procedure of object" kann nur mit NIL initialisiert werden +% You cannot assign the address of a method to a typed constant which has a +% 'procedure of object' type, because such a constant requires two addresses: +% that of the method (which is known at compile time) and that of the object or +% class instance it operates on (which cannot be known at compile time). +parser_e_default_value_only_one_para=03184_E_Der Default Value kann nur einem Parameter zugewiesen werden +% It is not possible to specify a default value for several parameters at once. +% The following is invalid: +% \begin{verbatim} +% Procedure MyProcedure (A,B : Integer = 0); +% \end{verbatim} +% Instead, this should be declared as +% \begin{verbatim} +% Procedure MyProcedure (A : Integer = 0; B : Integer = 0); +% \end{verbatim} +parser_e_default_value_expected_for_para=03185_E_Standard Parameter für "$1" benötigt +% The specified parameter requires a default value. +parser_w_unsupported_feature=03186_W_Verwendung eines nicht unterstützten Features! +% You're trying to force the compiler into doing something it cannot do yet. +parser_h_c_arrays_are_references=03187_H_C Arrays werden "by reference" übergeben +% Any array passed to a C function is passed +% by a pointer (i.e. by reference). +parser_e_C_array_of_const_must_be_last=03188_E_C array of const muss letztes Argument sein +% You cannot add any other argument after an \var{array of const} for +% \var{cdecl} functions, as the size pushed on stack for this argument is +% not known. +parser_h_type_redef=03189_H_Erneute Definition des Typs "$1" +% This is an indicator that a previously declared type is +% being redefined as something else. This may, or may not +% be, a potential source of errors. +parser_w_cdecl_has_no_high=03190_W_cdecl'ared Functionen haben keinen high Parameter +% Functions declared with the \var{cdecl} modifier do not pass an extra implicit parameter. +parser_w_cdecl_no_openstring=03191_W_cdecl'ared Functionen unterstützen keine open strings +% Openstring is not supported for functions that have the \var{cdecl} modifier. +parser_e_initialized_not_for_threadvar=03192_E_Als threadvar deklarierte Variable kann nicht initialisiert werden +% Variables declared as threadvar cannot be initialized with a default value. +% The variables will always be filled with zero at the start of a new thread. +parser_e_msg_only_for_classes=03193_E_Message directive ist nur in Klassen erlaubt +% The message directive is only supported for Class types. +parser_e_procedure_or_function_expected=03194_E_Procedure oder Function erwartet +% A class method can only be specified for procedures and functions. +parser_e_illegal_calling_convention=03195_W_Calling convention directive ignoriert: "$1" +% Some calling conventions are supported only by certain CPUs. I.e. most non-i386 ports support +% only the standard ABI calling convention of the CPU. +parser_e_no_object_reintroduce=03196_E_REINTRODUCE kann in Objekten nicht benutzt werden +% \var{reintroduce} is not supported for objects, Objective-C classes and Objective-C protocols. +parser_e_paraloc_only_one_para=03197_E_Jedes Argument muss seine eigene "location" haben +% If locations for arguments are specified explicitly as it is required by +% some syscall conventions, each argument must have its own location. Things +% like +% \begin{verbatim} +% procedure p(i,j : longint 'r1'); +% \end{verbatim} +% aren't allowed. +parser_e_paraloc_all_paras=03198_E_Jedes Argument muss seine explizite "location" haben +% If one argument has an explicit argument location, all arguments of a procedure +% must have one. +parser_e_illegal_explicit_paraloc=03199_E_"location" des Arguments unbekannt +% The location specified for an argument isn't recognized by the compiler. +parser_e_32bitint_or_pointer_variable_expected=03200_E_32 Bit-Integer oder Zeiger-Variable erwartet +% The libbase for MorphOS/AmigaOS can be given only as \var{longint}, \var{dword} or any pointer variable. +parser_e_goto_outside_proc=03201_E_Goto Statements zwischen verschiedenen Prozeduren sind nicht erlaubt +% It isn't allowed to use \var{goto} statements referencing labels outside the +% current procedure. The following example shows the problem: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1; +% +% procedure p2; +% begin +% goto l1; // This goto ISN'T allowed +% end; +% +% begin +% p2 +% l1: +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_Prozedur zu komplex, sie erfordert zu viele Register +% Your procedure body is too long for the compiler. You should split the +% procedure into multiple smaller procedures. +parser_e_illegal_expression=03203_E_Ungültiger Ausdruck +% This can occur under many circumstances. Usually when trying to evaluate +% constant expressions. +parser_e_invalid_integer=03204_E_Ungültiger integer Ausdruck +% You made an expression which isn't an integer, and the compiler expects the +% result to be an integer. +parser_e_invalid_qualifier=03205_E_Ungültiger Qualifier +% One of the following is happening : +% \begin{itemize} +% \item You're trying to access a field of a variable that is not a record. +% \item You're indexing a variable that is not an array. +% \item You're dereferencing a variable that is not a pointer. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_High Range Limit < low Range Limit +% You are declaring a subrange, and the high limit is less than the low limit of +% the range. +parser_e_macpas_exit_wrong_param=03207_E_Exits Parameter muss der Name der Prozedur sein, in der es benutzt wird +% Non local exit is not allowed. This error occurs only in mode MacPas. +parser_e_illegal_assignment_to_count_var=03208_E_Ungültige Zuweisung zur for-loop Variable "$1" +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. You also cannot assign values to +% loop variables inside the loop (Except in Delphi and TP modes). Use a while or +% repeat loop instead if you need to do something like that, since those +% constructs were built for that. +parser_e_no_local_var_external=03209_E_Lokale Variable kann nicht als EXTERNAL deklariert werden +% Declaring local variables as external is not allowed. Only global variables can reference +% external variables. +parser_e_proc_already_external=03210_E_Prozedur ist bereits als EXTERNAL deklariert +% The procedure is already declared with the EXTERNAL directive in an interface or +% forward declaration. +parser_w_implicit_uses_of_variants_unit=03211_W_Implizite Verwendung einer Variant Unit +% The Variant type is used in the unit without any used unit using the Variants unit. The +% compiler has implicitly added the Variants unit to the uses list. To remove this warning +% the Variants unit needs to be added to the uses statement. +parser_e_no_static_method_in_interfaces=03212_E_Class und statische Methoden können nicht in INTERFACES verwendet werden +% The specifier \var{class} and directive \var{static} can't be used in interfaces +% because all methods of an interface must be public. +parser_e_arithmetic_operation_overflow=03213_E_Ãœberlauf in arithmetischer Operation +% An operation on two integer values produced an overflow. +parser_e_protected_or_private_expected=03214_E_Protected oder private erwartet +% \var{strict} can be only used together with \var{protected} or \var{private}. +parser_e_illegal_slice=03215_E_SLICE kann nicht ausserhalb der Parameterliste benutzt werden +% \var{slice} can be used only for arguments accepting an open array parameter. +parser_e_dispinterface_cant_have_parent=03216_E_Ein DISPINTERFACE kann keine Elternklasse haben. +% A DISPINTERFACE is a special type of interface which can't have a parent class. Dispinterface always derive from IDispatch type. +parser_e_dispinterface_needs_a_guid=03217_E_Ein DISPINTERFACE benötigt einen GUID +% A DISPINTERFACE always needs an interface identification (a GUID). +parser_w_overridden_methods_not_same_ret=03218_W_Ãœberschriebene Methoden müssen einen entsprechenden Rückgabetyp haben. Dieser Code kann abstürzen, weil er von einem Delphi Parser Bug abhängt (Methode "$2" wird durch "$1" überschrieben, die einen anderen Rückgabetyp hat). +% If you declare overridden methods in a class definition, they must +% have the same return type. Some versions of Delphi allow you to change the +% return type of interface methods, and even to change procedures into +% functions, but the resulting code may crash depending on the types used +% and the way the methods are called. +parser_e_dispid_must_be_ord_const=03219_E_Dispatch IDs müssen ganzzahlige Konstanten sein +% The \var{dispid} keyword must be followed by an ordinal constant (the dispid index). +parser_e_array_range_out_of_bounds=03220_E_Der Bereich des Array ist zu gross +% Regardless of the size taken up by its elements, an array cannot have more +% than high(ptrint) elements. Additionally, the range type must be a subrange +% of ptrint. +parser_e_packed_element_no_var_addr=03221_E_Bit packed Array-Elemente und Record-Felder haben keine Adressen +% If you declare an array or record as \var{packed} in Mac Pascal mode +% (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will +% be packed at the bit level. This means it becomes impossible to take addresses +% of individual array elements or record fields. The only exception to this rule +% is in the case of packed arrays elements whose packed size is a multple of 8 bits. +parser_e_packed_dynamic_open_array=03222_E_Dynamische Arrays können nicht packed sein +% Only regular (and possibly in the future also open) arrays can be packed. +parser_e_packed_element_no_loop=03223_E_Bit packed Array-Elemente und Record-Felder können nicht als Loop-Variable verwerndet werden +% If you declare an array or record as \var{packed} in Mac Pascal mode +% (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will +% be packed at the bit level. For performance reasons, they cannot be +% used as loop variables. +parser_e_type_var_const_only_in_records_and_classes=03224_E_VAR, TYPE und CONST sind nur innerhalb Records, Objekten und Klassen erlaubt +% The usage of VAR, TYPE and CONST to declare new types inside an object is allowed only inside +% records, objects and classes. +parser_e_cant_create_generics_of_this_type=03225_E_Dieser Typ kann nicht "generic" sein +% Only Classes, Objects, Interfaces and Records are allowed to be used as generic. +parser_w_no_lineinfo_use_switch=03226_W_Die LINEINFO Unit nicht manuell laden. Verwende statt dessen den Compilerschalter -gl +% Do not use the \file{lineinfo} unit directly, Use the \var{-gl} switch which +% automatically adds the correct unit for reading the selected type of debugging +% information. The unit that needs to be used depends on the type of +% debug information used when compiling the binary. +parser_e_no_funcret_specified=03227_E_Kein FunKtionsergebnistyp für Funktion "$1" angegeben +% The first time you declare a function you have to declare it completely, +% including all parameters and the result type. +parser_e_special_onlygenerics=03228_E_Spezialisierung wird nur für generische Typen unterstützt +% Types which are not generics can't be specialized. +parser_e_no_generics_as_params=03229_E_Generische Typen können bei der Spezialisierung generischer Typen nicht als Parameter benutzt werden +% When specializing a generic, only non-generic types can be used as parameters. +parser_e_type_object_constants=03230_E_Konstanten eines Objekts, das ein VMT enthält, sind unzulässig +% If an object requires a VMT either because it contains a constructor or virtual methods, +% it's not allowed to create constants of it. In TP and Delphi mode this is allowed +% for compatibility reasons. +parser_e_label_outside_proc=03231_E_Die Address von Labels, die ausserhalb des aktuellen Scopes definiert wurden, können nicht verwendet werden +% It isn't allowed to take the address of labels outside the +% current procedure. +parser_e_initialized_not_for_external=03233_E_Extern deklarierte Variablen können nicht intialisiert werden +% Variables declared as external cannot be initialized with a default value. +parser_e_illegal_function_result=03234_E_Ungültiger Funktionsergebnistyp +% Some types like file types cannot be used as function result. +parser_e_no_common_type=03235_E_"$1" und "$2" haben keinen gemeinsamen Typ +% To perform an operation on integers, the compiler converts both operands +% to their common type, which appears to be an invalid type. To determine the +% common type of the operands, the compiler takes the minimum of the minimal values +% of both types, and the maximum of the maximal values of both types. The common +% type is then minimum..maximum. +parser_e_no_generics_as_types=03236_E_Generische Typen können nicht ohne Spezialisierung als Typ für eine Variable verwendet werden +% Generics must be always specialized before being used as variable type. +parser_w_register_list_ignored=03237_W_Registerliste wird in reinen Assemblerroutinen ignoriert +% When using pure assembler routines, the list with modified registers is ignored. +parser_e_implements_must_be_class_or_interface=03238_E_Die Implements-Eigenschaft muss einen Klassen- oder Interface-Typ haben +% A property which implements an interface must be of type class or interface. +parser_e_implements_must_have_correct_type=03239_E_Die Implements-Eigenschaft muss ein Interface mit dem richtigen Typ implementieren; es wurde Typ "$1" gefunden, aber Typ "$2" erwartet. +% A property which implements an interface actually implements a different interface. +parser_e_implements_must_read_specifier=03240_E_Die Implements-Eigenschaft muss einen Lesen-Bezeichner haben +% A property which implements an interface must have at least a read specifier. +parser_e_implements_must_not_have_write_specifier=03241_E_Die Implements-Eigenschaft darf keinen Schreib-Bezeichner haben +% A property which implements an interface may not have a write specifier. +parser_e_implements_must_not_have_stored_specifier=03242_E_Die Implements-Eigenschaft darf keinen Gespeichert-Bezeichner haben +% A property which implements an interface may not have a stored specifier. +parser_e_implements_uses_non_implemented_interface=03243_E_Die Implements-Eigenschaft benutzt das nicht implementierte Interface "$1" +% The interface which is implemented by a property is not an interface implemented by the class. +parser_e_unsupported_real=03244_E_Fliesskommavariablen werden für dieses Ziel nicht unterstützt +% The compiler parsed a floating point expression, but it is not supported. +parser_e_class_doesnt_implement_interface=03245_E_Klasse "$1" implementiert das Interface "$2" nicht +% The delegated interface is not implemented by the class given in the implements clause. +parser_e_class_implements_must_be_interface=03246_E_Der von Implements benutzte Typ muss ein Interface sein +% The \var{implements} keyword must be followed by an interface type. +parser_e_cant_export_var_different_name=03247_E_Variablen können für dieses Target nicht mit einem anderen Namen exportiert werden; füge der Deklaration den Namen mit einer "export" Direktive hinzu (Variablenname: $1, deklarierter Name für den Export: $2) +% On most targets it is not possible to change the name under which a variable +% is exported inside the \var{exports} statement of a library. +% In that case, you have to specify the export name at the point where the +% variable is declared, using the \var{export} and \var{alias} directives. +parser_e_weak_external_not_supported=03248_E_Schwache externe Symbole werden für dieses Target nicht unterstützt +% A "weak external" symbol is a symbol which may or may not exist at (either static +% or dynamic) link time. This concept may not be available (or implemented yet) +% on the current cpu/OS target. +parser_e_forward_mismatch=03249_E_Forward Typdefinition passt nicht +% Classes and interfaces being defined forward must have the same type +% when being implemented. A forward interface cannot be changed into a class. +parser_n_ignore_lower_visibility=03250_N_Die virtuelle Methode "$1" hat eine niedrigere Sichtbarkeit ($2) als die Elternklasse $3 ($4) +% The virtual method overrides an method that is declared with a higher visibility. This might give +% unexpected results. In case the new visibility is private than it might be that a call to inherited in a +% new child class will call the higher visible method in a parent class and ignores the private method. +parser_e_field_not_allowed_here=03251_E_Felder sind nach der Definition einer Methode oder Eigenschaft nicht erlaubt. Beginne vorher eine neue Sichtbarkeitssektion +% Once a method or property has been defined in a class or object, you cannot define any fields afterwards +% without starting a new visibility section (such as \var{public}, \var{private}, etc.). The reason is +% that otherwise the source code can appear ambiguous to the compiler, since it is possible to use modifiers +% such as \var{default} and \var{register} also as field names. +parser_e_no_local_para_def=03252_E_Parameter oder Ergebnistypen können keine lokalen Typdeklarationen enthalten. Verwende eine getrennte Typdefinition in einem "type"-Block +% In Pascal, types are not considered to be identical simply because they are semantically equivalent. +% Two variables or parameters are only considered to be of the same type if they refer to the +% same type definition. +% As a result, it is not allowed to define new types inside parameter lists, because then it is impossible to +% refer to the same type definition in the procedure headers of the interface and implementation of a unit +% (both procedure headers would define a separate type). Keep in mind that expressions such as +% ``file of byte'' or ``string[50]'' also define a new type. +parser_e_abstract_and_sealed_conflict=03253_E_Konflikt zwischen ABSTRACT und SEALED +% ABSTRACT and SEALED cannot be used together in one declaration +parser_e_sealed_descendant=03254_E_Kann keinen Nachfahren der SEALED Klasse "$1" erzeugen +% Sealed means that class cannot be derived by another class. +parser_e_sealed_class_cannot_have_abstract_methods=03255_E_Eine SEALED Klasse kann keine ABSTRACT Methode haben +% Sealed means that class cannot be derived. Therefore no one class is able to override an abstract method in a sealed class. +parser_e_only_virtual_methods_final=03256_E_Nur virtuelle Methoden können final sein. +% You are declaring a method as final, when it is not declared to be +% virtual. +parser_e_final_can_no_be_overridden=03257_E_Die finale Methode kann nicht überschrieben werden: "$1" +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_multiple_messages=03258_E_Pro Methode kann nur eine Nachricht verwendet werden. +% It is not possible to associate multiple messages with a single method. +parser_e_invalid_enumerator_identifier=03259_E_Ungültiger Aufzählungsbezeichner: "$1" +% Only "MoveNext" and "Current" enumerator identifiers are supported. +parser_e_enumerator_identifier_required=03260_E_Aufzählungsbezeichner notwendig +% "MoveNext" or "Current" identifier must follow the \var{enumerator} modifier. +parser_e_enumerator_movenext_is_not_valid=03261_E_Die Aufzählungs-pattern-methode MoveNext ist ungültig. Die Methode muss eine Funktion mit Rückgabetyp Boolean und ohne notwendige Argumente sein. +% "MoveNext" enumerator pattern method must be a function with Boolean return type and no required arguments +parser_e_enumerator_current_is_not_valid=03262_E_Die Aufzählungs-pattern-Eigenschaft "Current" ist ungültig. Die Eigenschaft benötigt einen "Getter" +% "Current" enumerator pattern property must have a getter +parser_e_only_one_enumerator_movenext=03263_E_Pro Klasse/Objekt ist nur eine Aufzählungsmethode "MoveNext" erlaubt +% Class or Object can have only one enumerator MoveNext declaration. +parser_e_only_one_enumerator_current=03264_E_Pro Klasse/Objekt ist nur eine Aufzählungseigenschaft "Current" erlaubt +% Class or Object can have only one enumerator Current declaration. +parser_e_for_in_loop_cannot_be_used_for_the_type=03265_E_For in Schleife kann nicht für den Typ "$1" verwendet werden +% For in loop can be used not for all types. For example it cannot be used for the enumerations with jumps. +parser_e_objc_requires_msgstr=03266_E_Objective-C Nachrichten erfordern, dass ihr Objective-C selector-Name mit der Direktive "message" angegeben wird +% Objective-C messages require their Objective-C name (selector name) to be specified using the \var{message `someName:'} procedure directive. +% While bindings to other languages automatically generate such names based on the identifier you use (by replacing +% all underscores with colons), this is unsafe since nothing prevents an Objective-C method name to contain actual +% colons. +parser_e_objc_no_constructor_destructor=03267_E_Objective-C hat keine formalen Konstruktoren oder Destruktoren. Verwende die Nachrichten alloc, initXXX und dealloc +% The Objective-C language does not have any constructors or destructors. While there are some messages with a similar +% purpose (such as \var{init} and \var{dealloc}), these cannot be identified using automatic parsers and do not +% guarantee anything like Pascal constructors/destructors (e.g., you have to take care of only calling ``designated'' +% inherited ``constructors''). For these reasons, we have opted to follow the standard Objective-C patterns for +% instance creation/destruction. +parser_e_message_string_too_long=03268_E_Der Name der Nachricht ist zu lang (max. 255 Zeichen) +% Due to compiler implementation reasons, message names are currently limited to 255 characters. +parser_e_objc_message_name_too_long=03269_E_Der Symbolname der Objective-C-Nachricht "$1" ist zu lang +% Due to compiler implementation reasons, mangled message names (i.e., the symbol names used in the assembler +% code) are currently limited to 255 characters. +parser_h_no_objc_parent=03270_H_Definieren einer neuen Objective-C root-Klasse. Um sie von einer anderen root-Klasse abzuleiten (z.B. NSObject), gib diese als Elternklasse an +% If no parent class is specified for an Object Pascal class, then it automatically derives from TObject. +% Objective-C classes however do not automatically derive from NSObject, because one can have multiple +% root classes in Objective-C. For example, in the Cocoa framework both NSObject and NSProxy are root classes. +% Therefore, you have to explicitly define a parent class (such as NSObject) if you want to derive your +% Objective-C class from it. +parser_e_no_objc_published=03271_E_Objective-C Klassen können keinen Abschnitt published haben +% In Object Pascal, ``published'' determines whether or not RTTI is generated. Since the Objective-C runtime always needs +% RTTI for everything, this specified does not make sense for Objective-C classes. +parser_f_need_objc=03272_F_Dieses Modul erfordert, dass der Objective-C Mode-Schalter übersetzt wird +% This error indicates the use of Objective-C language features without an Objective-C mode switch +% active. Enable one via the -M command line switch, or the {\$modeswitch x} directive. +parser_e_must_use_override_objc=03273_E_Vererbte Methoden können nur in Objective-C überschrieben werden, füge "override" hinzu (Vererbte Methode ist in $1 definiert) +parser_h_should_use_override_objc=03274_H_Vererbte Methoden können nur in Objective-C überschrieben werden, füge "override" hinzu (Vererbte Methode ist in $1 definiert) +% It is not possible to \var{reintroduce} methods in Objective-C like in Object Pascal. Methods with the same +% name always map to the same virtual method entry. In order to make this clear in the source code, +% the compiler always requires the \var{override} directive to be specified when implementing overriding +% Objective-C methods in Pascal. If the implementation is external, this rule is relaxed because Objective-C +% does not have any \var{override}-style keyword (since it's the default and only behaviour in that language), +% which makes it hard for automated header conversion tools to include it everywhere. +% The type in which the inherited method is defined is explicitly mentioned, because this may either +% be an objcclass or an objccategory. +parser_e_objc_message_name_changed=03275_E_Der Nachrichtenname "$1" in der vererbten Klasse unterscheidet sich vom Nachrichtennamen "$2" in der aktuellen Klasse +% An overriding Objective-C method cannot have a different message name than an inherited method. The reason +% is that these message names uniquely define the message to the Objective-C runtime, which means that +% giving them a different message name breaks the ``override'' semantics. +parser_e_no_objc_unique=03276_E_Noch können eindeutige Kopien von Objective-C Typen nicht erstellt werden +% Duplicating an Objective-C type using \var{type x = type y;} is not yet supported. You may be able to +% obtain the desired effect using \var{type x = objcclass(y) end;} instead. +parser_e_no_category_as_types=03277_E_Objective-C Kategorien und Object-Pascal Klassenhelfer können nicht als Typen benutzt werden +% It is not possible to declare a variable as an instance of an Objective-C +% category or an Object Pascal class helper. A category/class helper adds +% methods to the scope of an existing class, but does not define a type by +% itself. An exception of this rule is when inheriting an Object Pascal class +% helper from another class helper. +parser_e_no_category_override=03278_E_Kategorien überschreiben Methoden nicht, sondern ersetzen sie. "reintroduce" benutzen +parser_e_must_use_reintroduce_objc=03279_E_Ersetzte Methoden können in Objective-C nur wieder eingeführt werden, füge "reintroduce" hinzu (Ersetzte Methode ist in $1 definiert) +parser_h_should_use_reintroduce_objc=03280_H_Ersetzte Methoden können in Objective-C nur wieder eingeführt werden, füge "reintroduce" hinzu (Ersetzte Methode ist in $1 definiert) +% A category replaces an existing method in an Objective-C class, rather than that it overrides it. +% Calling an inherited method from an category method will call that method in +% the extended class' parent, not in the extended class itself. The +% replaced method in the original class is basically lost, and can no longer be +% called or referred to. This behaviour corresponds somewhat more closely to +% \var{reintroduce} than to \var{override} (although in case of \var{reintroduce} +% in Object Pascal, hidden methods are still reachable via inherited). +% The type in which the inherited method is defined is explicitly mentioned, because this may either +% be an objcclass or an objccategory. +parser_e_implements_getter_not_default_cc=03281_E_Getter für das Interface implements müssen die voreingestellte calling convention des Ziels benutzen +% Interface getters are called via a helper in the run time library, and hence +% have to use the default calling convention for the target (\var{register} on +% i386 and x86\_64, \var{stdcall} on other architectures). +parser_e_no_refcounted_typed_file=03282_E_Typisierte Dateien können keine reference-counted Typen enthalten +% The data in a typed file cannot be of a reference counted type (such as +% \var{ansistring} or a record containing a field that is reference counted). +parser_e_operator_not_overloaded_2=03283_E_Ãœberladenener Operator nicht vorhanden: $2 "$1" +% You are trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_operator_not_overloaded_3=03284_E_Ãœberladenener Operator nicht vorhanden: "$1" $2 "$3" +% You are trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_more_array_elements_expected=03285_E_Erwarte ein weiteres Element für Array $1 +% When declaring a typed constant array, you provided to few elements to initialize the array +parser_e_string_const_too_long=03286_E_Stringkonstante zu lang, so lange ansistrings ausgeschaltet sind +% Only when a piece of code is compiled with ansistrings enabled (\var{\{\$H+\}}), string constants +% longer than 255 characters are allowed. +parser_e_invalid_univ_para=03287_E_Typ kann nicht als "univ" Parameter verwendet werden, weil seine Größe zur Zeit der Ãœbersetzung unbekannt ist: "$1" +% \var{univ} parameters are compatible with all values of the same size, but this +% cannot be checked in case a parameter's size is unknown at compile time. +parser_e_only_one_class_constructor_allowed=03288_E_In der Klasse "$1" darf nur ein Klassenkonstruktor deklariert werden +% You are trying to declare more than one class constructor but only one class constructor can be declared. +parser_e_only_one_class_destructor_allowed=03289_E_In der Klasse "$1" darf nur ein Klassendestruktor deklariert werden +% You are trying to declare more than one class destructor but only one class destructor can be declared. +parser_e_no_paras_for_class_constructor=03290_E_Ein Klassenkonstruktur darf keine Parameter haben +% You are declaring a class constructor with a parameter list. Class constructor methods +% cannot have parameters. +parser_e_no_paras_for_class_destructor=03291_E_Ein Klassendestruktur darf keine Parameter haben +% You are declaring a class destructor with a parameter list. Class destructor methods +% cannot have parameters. +parser_f_modeswitch_objc_required=03292_F_Dieses Konstrukt erfordert, dass der Modenschalter \{\$modeswitch objectivec1\} aktiv ist +% Objective-Pascal constructs are not supported when \{\$modeswitch ObjectiveC1\} +% is not active. +parser_e_widestring_to_ansi_compile_time=03293_E_Eine Unicodechar/string Konstante zur Zeit der Ãœbersetzung nicht in eine ansi/shortstring Konstante konvertiert werden +% It is not possible to use unicodechar and unicodestring constants in +% constant expressions that have to be converted into an ansistring or shortstring +% at compile time, for example inside typed constants. The reason is that the +% compiler cannot know what the actual ansi encoding will be at run time. +parser_e_objc_enumerator_2_0=03294_E_Objective-Pascal For-in Schleifen erfordern, dass der Modenschalter \{\$modeswitch ObjectiveC2\} aktiv ist +% Objective-C ``fast enumeration'' support was added in Objective-C 2.0, and +% hence the appropriate modeswitch has to be activated to expose this feature. +% Note that Objective-C 2.0 programs require Mac OS X 10.5 or later. +parser_e_objc_missing_enumeration_defs=03295_E_Der Kompiler findet die Typen NSFastEnumerationProtocol oder NSFastEnumerationState nicht in der Unit CocoaAll +% Objective-C for-in loops (fast enumeration) require that the compiler can +% find a unit called CocoaAll that contains definitions for the +% NSFastEnumerationProtocol and NSFastEnumerationState types. If you get this +% error, most likely the compiler is finding and loading an alternate CocoaAll +% unit. +parser_e_no_procvarnested_const=03296_E_Typisierte Konstanten des Typs 'procedure is nested' können nur mit NIL und globalen Prozeduren/Funktionen initialisiert werden +% A nested procedural variable consists of two components: the address of the +% procedure/function to call (which is always known at compile time), and also +% a parent frame pointer (which is never known at compile time) in case the +% procedural variable contains a reference to a nested procedure/function. +% Therefore such typed constants can only be initialized with global +% functions/procedures since these do not require a parent frame pointer. +parser_f_no_generic_inside_generic=03297_F_Die Deklaration einer generischen Klasse innerhalb einer anderen generischen Klasse ist nicht erlaubt +% At the moment, scanner supports recording of only one token buffer at the time +% (guarded by internal error 200511173 in tscannerfile.startrecordtokens). +% Since generics are implemented by recording tokens, it is not possible to +% have declaration of generic class inside another generic class. +parser_e_forward_protocol_declaration_must_be_resolved=03298_E_Vorwärts-Deklarationen des ObjC-Protokolls "$1" müssen aufgelöst sein, bevor eine ObjC-Klasse ihr folgen kann +% An objcprotocol must be fully defined before classes can conform to it. +% This error occurs in the following situation: +% \begin{verbatim} +% Type MyProtocol = objcprotoocl; +% ChildClass = Class(NSObject,MyProtocol) +% ... +% end; +% \end{verbatim} +% where \var{MyProtocol} is declared but not defined. +parser_e_no_record_published=03299_E_Record -Typen können keine öffentlichen Abschnitte (published sections) haben +% Published sections can be used only inside classes. +parser_e_no_destructor_in_records=03300_E_Destruktoren sind in Records und Helfern nicht erlaubt +% Destructor declarations aren't allowed in records or helpers. +parser_e_class_methods_only_static_in_records=03301_E_Klassenmethoden müssen in Records statisch sein +% Class methods declarations aren't allowed in records without static modifier. +% Records have no inheritance and therefore non static class methods have no sence for them. +parser_e_no_constructor_in_records=03302_E_Konstruktoren sind in Records und Recordhelfern nicht erlaubt +% Constructor declarations aren't allowed in records or record helpers. +parser_e_at_least_one_argument_must_be_of_type=03303_E_Entweder das Ergebnis oder mindestens ein Parameter müssen vom Typ "$1" sein +% It is required that either the result of the routine or at least one of its parameters be of the specified type. +% For example class operators either take an instance of the structured type in which they are defined, or they return one. +parser_e_cant_use_type_parameters_here=03304_E_Typ-Parameter können initialization/finalization erfordern - Sie können deshalb nicht in varianten Rekords verwendet werden +% Type parameters may be specialized with types which (e.g. \var{ansistring}) need initialization/finalization +% code which is implicitly generated by the compiler. +parser_e_externals_no_section=03305_E_"external" deklarierte Variablen dürfen nicht in einer "custom section" sein +% A section directive is not valid for variables being declared as external. +parser_e_section_no_locals=03306_E_Nicht-statische und nicht-globale Variablen dürfen keine Direktive "section" haben +% A variable placed in a custom section is always statically allocated so it must be either a static or global variable. +parser_e_not_allowed_in_helper=03307_E_"$1" ist in Helfertypen nicht erlaubt +% Some directives and specifiers like "virtual", "dynamic", "override" aren't +% allowed inside helper types in mode ObjFPC (they are ignored in mode Delphi), +% because they have no meaning within helpers. Also "abstract" isn't allowed in +% either mode. +parser_e_no_class_constructor_in_helpers=03308_E_Klassenkonstruktoren sind in Helfern nicht erlaubt +% Class constructor declarations aren't allowed in helpers. +parser_e_inherited_not_in_record=03309_E_"inherited" ist in einem Record nicht erlaubt +% As records don't suppport inheritance the use of "inherited" is prohibited for +% these as well as for record helpers (in mode "Delphi" only). +parser_e_no_types_in_local_anonymous_records=03310_E_Typ-Deklarationen sind in lokalen oder anonymen Records nicht erlaubt +% Records with types must be defined globally. Types cannot be defined inside records which are defined in a +% procedure or function or in anonymous records. +parser_e_duplicate_implements_clause=03311_E_Zweifacher "implements"-Term für das Interface "$1" +% A class may delegate an interface using the "implements" clause only to a single property. Delegating it multiple times +% is a error. +parser_e_mapping_no_implements=03312_E_Das Interface "$1" kann nicht durch "$2" delegiert werden. Die Methode ist bereits aufgelöst +% Method resolution clause maps a method of an interface to a method of the current class. Therefore the current class +% has to implement the interface directly. Delegation is not possible. +parser_e_implements_no_mapping=03313_E_Das Interface "$1" kann keine Methoden-Auflösung haben, "$2" delegiert es bereits +% Method resoulution is only possible for interfaces that are implemented directly, not by delegation. +% +% \end{description} +# EndOfTeX + +# +# Type Checking +# +# 04103 is the last used one +# +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +type_e_mismatch=04000_E_Typen passen nicht zusammen +% This can happen in many cases: +% \begin{itemize} +% \item The variable you're assigning to is of a different type than the +% expression in the assignment. +% \item You are calling a function or procedure with parameters that are +% incompatible with the parameters in the function or procedure definition. +% \end{itemize} +type_e_incompatible_types=04001_E_Inkompatible Typen: Habe "$1" erhalten, aber "$2" erwartet +% There is no conversion possible between the two types. +% Another possiblity is that they are declared in different +% declarations: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { This statement also gives this error. It +% is due to the strict type checking of Pascal } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_Typen sind verschieden bei $1 und $2 +% The types are not equal. +type_e_type_id_expected=04003_E_Typbezeichner erwartet +% The identifier is not a type, or you forgot to supply a type identifier. +type_e_variable_id_expected=04004_E_Variablenbezeichner erwartet +% This happens when you pass a constant to a \var{Inc} var or \var{Dec} +% procedure. You can only pass variables as arguments to these functions. +type_e_integer_expr_expected=04005_E_Integer-Ausdruck erwartet, aber "$1" erhalten +% The compiler expects an expression of type integer, but gets a different +% type. +type_e_boolean_expr_expected=04006_E_Booleschen Ausdruck erwartet, aber "$1" erhalten +% The expression must be a boolean type. It should be return \var{True} or +% \var{False}. +type_e_ordinal_expr_expected=04007_E_Ganzzahliger Ausdruck erwartet +% The expression must be of ordinal type, i.e., maximum a \var{Longint}. +% This happens, for instance, when you specify a second argument +% to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value. +type_e_pointer_type_expected=04008_E_Zeigertyp erwartet, aber "$1" erhalten +% The variable or expression isn't of the type \var{pointer}. This +% happens when you pass a variable that isn't a pointer to \var{New} +% or \var{Dispose}. +type_e_class_type_expected=04009_E_Klassentyp erwartet, aber "$1" erhalten +% The variable or expression isn't of the type \var{class}. This happens +% typically when +% \begin{enumerate} +% \item The parent class in a class declaration isn't a class. +% \item An exception handler (\var{On}) contains a type identifier that +% isn't a class. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_Kann konstanten Ausdruck nicht auswerten +% This error can occur when the bounds of an array you declared do +% not evaluate to ordinal constants. +type_e_set_element_are_not_comp=04012_E_Set-Elemente sind nicht kompatibel +% You are trying to perform an operation on two sets, when the set element types +% are not the same. The base type of a set must be the same when taking the +% union. +type_e_set_operation_unknown=04013_E_Operation für Sets nicht implementiert +% several binary operations are not defined for sets. +% These include: \var{div}, \var{mod}, \var{**}, \var{>=} and \var{<=}. +% The last two may be defined for sets in the future. +type_w_convert_real_2_comp=04014_W_Automatische Typumwandlung von Fliesskommatyp nach COMP (=integer mit 64 bit) +% An implicit type conversion from a real type to a \var{comp} is +% encountered. Since \var{Comp} is a 64 bit integer type, this may indicate +% an error. +type_h_use_div_for_int=04015_H_Verwenden sie DIV um ein Integer-Ergebnis zu erhalten +% When hints are on, then an integer division with the '/' operator will +% produce this message, because the result will then be of type real. +type_e_strict_var_string_violation=04016_E_Stringtypen müssen im "$V+"-Modus exakt übereinstimmen +% When compiling in \var{\{\$V+\}} mode, the string you pass as a parameter +% should be of the exact same type as the declared parameter of the procedure. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_Succ oder Pred kann nicht auf Aufzählungen mit Zuweisungen angewendet werden +% If you declare an enumeration type which has C-like assignments +% in it, such as in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% then you cannot use the \var{Succ} or \var{Pred} functions with this enumeration. +type_e_cant_read_write_type=04018_E_Kann Variablen dieses Typs nicht lesen oder schreiben +% You are trying to \var{read} or \var{write} a variable from or to a +% file of type text, which doesn't support that variable's type. +% Only integer types, reals, pchars and strings can be read from or +% written to a text file. Booleans can only be written to text files. +type_e_no_readln_writeln_for_typed_file=04019_E_Kann ReadLn und WriteLn nicht bei typisierten Dateien verwenden +% \var{readln} and \var{writeln} are only allowed for text files. +type_e_no_read_write_for_untyped_file=04020_E_Kann Read und Write nicht bei untypisierten Dateien verwenden +% \var{read} and \var{write} are only allowed for text or typed files. +type_e_typeconflict_in_set=04021_E_Typkonflikt zwischen den Elementen des Sets +% There is at least one set element which is of the wrong type, i.e. not of +% the set type. +type_w_maybe_wrong_hi_lo=04022_W_lo/hi(dword/qword) gibt oberes/unteres Word/DWord zurück +% \fpc supports an overloaded version of \var{lo/hi} for \var{longint/dword/int64/qword} +% which returns the lower/upper word/dword of the argument. \tp always uses +% a 16 bit \var{lo/hi} which always returns bits 0..7 for \var{lo} and the +% bits 8..15 for \var{hi}. If you want the \tp behavior you have +% to type cast the argument to a \var{word} or \var{integer}. +type_e_integer_or_real_expr_expected=04023_E_Integer- oder Real-Ausdruck erwartet +% The first argument to \var{str} must be a real or integer type. +type_e_wrong_type_in_array_constructor=04024_E_Falscher Typ "$1" im Array-Konstruktor +% You are trying to use a type in an array constructor which is not +% allowed. +type_e_wrong_parameter_type=04025_E_Inkompatible Typen für Argument Nr. #$1: habe $2 erhalten, aber $3 erwartet +% You are trying to pass an invalid type for the specified parameter. +type_e_no_method_and_procedure_not_compatible=04026_E_Methode (Variable) und Prozedur (Variable) sind nicht kompatibel +% You can't assign a method to a procedure variable or a procedure to a +% method pointer. +type_e_wrong_math_argument=04027_E_Unzulässige Konstante an interne Algebrafunktion übergeben +% The constant argument passed to a \var{ln} or \var{sqrt} function is out of +% the definition range of these functions. +type_e_no_addr_of_constant=04028_E_Von Konstanten kann keine Adresse bestimmt werden +% It's not possible to get the address of a constant, because they +% aren't stored in memory, you can try making it a typed constant. This error +% can also be displayed if you try to pass a property to a var parameter. +type_e_argument_cant_be_assigned=04029_E_An das Argument kann nichts zugewiesen werden +% Only expressions which can be on the left side of an +% assignment can be passed as call by reference arguments. +% +% Remark: Properties can be used on the left side of an assignment, +% nevertheless they cannot be used as arguments. +type_e_cannot_local_proc_to_procvar=04030_E_Kann lokale Prozedur/Funktion nicht an Prozedurvariable zuweisen +% It's not allowed to assign a local procedure/function to a +% procedure variable, because the calling convention of a local procedure/function is +% different. You can only assign local procedure/function to a void pointer. +type_e_no_assign_to_addr=04031_E_Kann einer Adresse keine Werte zuweisen +% It's not allowed to assign a value to an address of a variable,constant, +% procedure or function. You can try compiling with -So if the identifier +% is a procedure variable. +type_e_no_assign_to_const=04032_E_Kann einer Konstanten keine Werte zuweisen +% It's not allowed to assign a value to a variable which is declared +% as a const. This is normally a parameter declared as const. To allow +% changing the value, pass the parameter by value, or a parameter by reference +% (using var). +type_e_array_required=04033_E_Array Typ notwendig +% If you are accessing a variable using an index '[<x>]' then +% the type must be an array. In FPC mode a pointer is also allowed. +type_e_interface_type_expected=04034_E_Interface Typ erwartet, aber "$1" erhalten +% The compiler expected to encounter an interface type name, but got something else. +% The following code would produce this error: +% \begin{verbatim} +% Type +% TMyStream = Class(TStream,Integer) +% \end{verbatim} +type_h_mixed_signed_unsigned=04035_H_Mischen von signed Ausdrücken und Longwords ergibt ein 64bit Ergebnis +% If you divide (or calculate the modulus of) a signed expression by a longword (or vice versa), +% or if you have overflow and/or range checking turned on and use an arithmetic +% expression (+, -, *, div, mod) in which both signed numbers and longwords appear, +% then everything has to be evaluated in 64-bit arithmetic which is slower than normal +% 32-bit arithmetic. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_w_mixed_signed_unsigned2=04036_W_Mischen von signed Ausdrücken und kardinalen Typen hier kann einen Bereichsprüfungsfehler verursachen +% If you use a binary operator (and, or, xor) and one of +% the operands is a longword while the other one is a signed expression, then, +% if range checking is turned on, you may get a range check error because in +% such a case both operands are converted to longword before the operation is +% carried out. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_e_typecast_wrong_size_for_assignment=04037_E_Typecast hat verschiedene Grössen ($1 -> $2) in der Zuweisung +% Type casting to a type with a different size is not allowed when the variable is +% used in an assignment. +type_e_array_index_enums_with_assign_not_possible=04038_E_enums mit Zuweisungen können nicht als Array-Index verwendet werden +% When you declared an enumeration type which has C-like +% assignments, such as in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use it as the index of an array. +type_e_classes_not_related=04039_E_Klassen- oder Objekttypen "$1" and "$2" sind nicht verwandt +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors. +type_w_classes_not_related=04040_W_Klassentypen "$1" und "$2" sind nicht verwandt +% There is a typecast from one class to another while the classes +% are not related. This will probably lead to errors. +type_e_class_or_interface_type_expected=04041_E_Klassen- oder Interface-Typ erwartet, aber "$1" erhalten +% The compiler expected a class or interface name, but got another type or identifier. +type_e_type_is_not_completly_defined=04042_E_Typ "$1" ist nicht vollständig definiert +% This error occurs when a type is not complete: i.e. a pointer type which points to +% an undefined type. +type_w_string_too_long=04043_W_String literal hat mehr Zeichen als short string length +% The size of the constant string, which is assigned to a shortstring, +% is longer than the maximum size of the shortstring (255 characters). +type_w_comparison_always_false=04044_W_Wegen der Bereiche der Konstanten und des Ausdrucks könnte das Vergleichsergebnis immer falsch sein +% There is a comparison between a constant and an expression where the constant is out of the +% valid range of values of the expression. Because of type promotion, the statement will always evaluate to +% false. Explicitly typecast the constant or the expression to the correct range to avoid this warning +% if you think the code is correct. +type_w_comparison_always_true=04045_W_Wegen der Bereiche der Konstanten und des Ausdrucks könnte das Vergleichsergebnis immer richtig sein +% There is a comparison between a constant and an expression where the constant is out of the +% valid range of values of the expression. Because of type promotion, the statement will always evaluate to +% true. Explicitly typecast the constant or the expression to the correct range to avoid this warning +% if you think the code is correct. +type_w_instance_with_abstract=04046_W_Konstruktion der Klasse "$1" mit der abstrakten Methode "$2" +% An instance of a class is created which contains non-implemented abstract +% methods. This will probably lead to a runtime error 211 in the code if that +% routine is ever called. All abstract methods should be overridden. +type_h_in_range_check=04047_H_Der linke Operand des IN Operators sollte byte Grösse haben +% The left operand of the \var{in} operator is not an ordinal or enumeration which fits +% within 8 bits. This may lead to range check errors. The \var{in} operator +% currently only supports a left operand which fits within a byte. In the case of +% enumerations, the size of an element of an enumeration can be controlled with +% the \var{\{\$PACKENUM\}} or \var{\{\$Zn\}} switches. +type_w_smaller_possible_range_check=04048_W_Unpassende Typgrössen, Gefahr des Datenverlusts oder Bereichsprüfungsfehlers +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_h_smaller_possible_range_check=04049_H_Unpassende Typgrössen, Gefahr des Datenverlusts oder Bereichsprüfungsfehlers +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_e_cant_take_address_of_abstract_method=04050_E_Die Adresse einer abstrakten Methode kann nicht verwendet werden +% An abstract method has no body, so the address of an abstract method can't be taken. +type_e_assignment_not_allowed=04051_E_Zuweisungen auf formale Parameter und offene Arrays sind nicht möglich +% You are trying to assign a value to a formal (untyped var, const or out) +% parameter, or to an open array. +type_e_constant_expr_expected=04052_E_Konstanter Ausdruck erwartet +% The compiler expects an constant expression, but gets a variable expression. +type_e_operator_not_supported_for_types=04053_E_Operation "$1" wird für die Typen "$2" und "$3" nicht unterstützt +% The operation is not allowed for the supplied types. +type_e_illegal_type_conversion=04054_E_Illegale Typ-Konversion: "$1" nach "$2" +% When doing a type-cast, you must take care that the sizes of + the variable and +% the destination type are the same. +type_h_pointer_to_longint_conv_not_portable=04055_H_Konversion zwischen ordinalen Typen und Zeigern ist nicht portierbar +% If you typecast a pointer to a longint (or vice-versa), this code will not compile +% on a machine using 64 bits addressing. +type_w_pointer_to_longint_conv_not_portable=04056_W_Konversion zwischen ordinalen Typen und Zeigern ist nicht portierbar +% If you typecast a pointer to an ordinal type of a different size (or vice-versa), this can +% cause problems. This is a warning to help in finding the 32-bit specific code where cardinal/longint is used +% to typecast pointers to ordinals. A solution is to use the ptrint/ptruint types instead. +type_e_cant_choose_overload_function=04057_E_Kann nicht bestimmen, welche der überladenen Funktionen aufgerufen werden soll +% You're calling overloaded functions with a parameter that doesn't correspond +% to any of the declared function parameter lists. e.g. when you have declared +% a function with parameters \var{word} and \var{longint}, and then you call +% it with a parameter which is of type \var{integer}. +type_e_illegal_count_var=04058_E_Loop-Variable muss einen ordinalen Typ haben +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +type_w_double_c_varargs=04059_W_Der konstante Wert vom Typ real wird für ein C Variablen-Argument zu double konvertiert. Ergänze eine explizite Typ-Konversion (typecast), um das zu verhindern +% In C, constant real values are double by default. For this reason, if you +% pass a constant real value to a variable argument part of a C function, FPC +% by default converts this constant to double as well. If you want to prevent +% this from happening, add an explicit typecast around the constant. +type_e_class_or_cominterface_type_expected=04060_E_Class oder COM interface Typ erwartet, statt dessen "$1" erhalten +% Some operators, such as the AS operator, are only applicable to classes or COM interfaces. +type_e_no_const_packed_array=04061_E_Konstante packed Arrays werden noch nicht unterstützt +% You cannot declare a (bit)packed array as a typed constant. +type_e_got_expected_packed_array=04062_E_Inkompatibler Typ für Argument $1: Erhielt "$2" erwartete "(Bit)Packed Array" +% The compiler expects a (bit)packed array as the specified parameter. +type_e_got_expected_unpacked_array=04063_E_Inkompatibler Typ für Argument $1: Erhielt "$2" erwartete "(not packed) Array" +% The compiler expects a regular (i.e., not packed) array as the specified parameter. +type_e_no_packed_inittable=04064_E_Elemente von packed Arrays können nicht von einem Typ sein, der initialisiert werden muss +% Support for packed arrays of types that need initialization +% (such as ansistrings, or records which contain ansistrings) is not yet implemented. +type_e_no_const_packed_record=04065_E_Konstante packed Records und Objekte werden noch nicht unterstützt +% You cannot declare a (bit)packed array as a typed constant at this time. +type_w_untyped_arithmetic_unportable=04066_W_Arithmetik "$1" mit typenlosem Pointer ist nicht portierbar nach {$T+}, schlage typecast vor +% Addition/subtraction from an untyped pointer may work differently in \var{\{\$T+\}}. +% Use a typecast to a typed pointer. +type_e_cant_take_address_of_local_subroutine=04076_E_Die Address einer Subroutine, die als local markiert ist, kann nicht verwendet werden +% The address of a subroutine marked as local can't be taken. +type_e_cant_export_local=04077_E_Eine Subroutine, die aus einer Unit als local markiert ist, kann nicht exportiert werden +% A subroutine marked as local can't be exported from a unit. +type_e_not_automatable=04078_E_Typ "$1" ist nicht "automatable" +% Only byte, integer, longint, smallint, currency, single, double, ansistring, +% widestring, tdatetime, variant, olevariant, wordbool and all interfaces are automatable. +type_h_convert_add_operands_to_prevent_overflow=04079_H_Konvertierung des Operanden "$1" vor der Addition könnte Ãœberlauf Fehler verhindern +% Adding two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the addition. +type_h_convert_sub_operands_to_prevent_overflow=04080_H_Konvertierung des Operanden "$1" vor der Subtraktion könnte Ãœberlauf Fehler verhindern +% Subtracting two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the subtraction. +type_h_convert_mul_operands_to_prevent_overflow=04081_H_Konvertierung des Operanden "$1" vor der Multiplikation könnte Ãœberlauf Fehler verhindern +% Multiplying two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the multiplication. +type_w_pointer_to_signed=04082_W_Die Konvertierung von Pointern in einen Integertyp mit Vorzeichen kann zu falschen Ergebnissen bei Vergleichen und zu Bereichsüberschreitungen führen; verwenden sie statt dessen besser einen Typ ohne Vorzeichen +% The virtual address space on 32-bit machines runs from \$00000000 to \$ffffffff. +% Many operating systems allow you to allocate memory above \$80000000. +% For example both \windows and \linux allow pointers in the range \$0000000 to \$bfffffff. +% If you convert pointers to signed types, this can cause overflow and range check errors, +% but also \$80000000 < \$7fffffff. This can cause random errors in code like "if p>q". +type_e_interface_has_no_guid=04083_E_Interface Typ $1 hat keine gültige GUID +% When applying the as-operator to an interface or class, the desired interface (i.e. the right operand of the +% as-operator) must have a valid GUID. +type_e_invalid_objc_selector_name=04084_E_Ungültiger Objective-C-Selector-Name "$1" +% An Objective-C selector cannot be empty, must be a valid identifier or a single colon, +% and if it contains at least one colon it must also end in one. +type_e_expected_objc_method_but_got=04085_E_Erwartete eine Objective-C-Methode, erhielt aber $1 +% A selector can only be created for Objective-C methods, not for any other kind +% of procedure/function/method. +type_e_expected_objc_method=04086_E_Erwartete eine Objective-C-Methode, oder den Namen einer konstanten Methode +% A selector can only be created for Objective-C methods, either by specifying +% the name using a string constant, or by using an Objective-C method identifier +% that is visible in the current scope. +type_e_no_type_info=04087_E_Für diesen Typ steht keine Typ-Information zu Verfügung +% Type information is not generated for some types, such as enumerations with gaps +% in their value range (this includes enumerations whose lower bound is different +% from zero). +type_e_ordinal_or_string_expr_expected=04088_E_Ausdruck mit ordinalem Typ oder Zeichenkette erwartet +% The expression must be an ordinal or string type. +type_e_string_expr_expected=04089_E_Ausdruck mit Zeichenkette erwartet +% The expression must be a string type. +type_w_zero_to_nil=04090_W_Konvertiere 0 zu NIL +% Use NIL rather than 0 when initialising a pointer. +type_e_protocol_type_expected=04091_E_Objective-C Protokolltyp erwartet, erhielt aber "$1" +% The compiler expected a protocol type name, but found something else. +type_e_objc_type_unsupported=04092_E_Der Typ "$1" wird nicht für die Verwendung mit der Objective-C Laufzeitumgebung unterstützt. +% Objective-C makes extensive use of run time type information (RTTI). This format +% is defined by the maintainers of the run time and can therefore not be adapted +% to all possible Object Pascal types. In particular, types that depend on +% reference counting by the compiler (such as ansistrings and certain kinds of +% interfaces) cannot be used as fields of Objective-C classes, cannot be +% directly passed to Objective-C methods, and cannot be encoded using \var{objc\_encode}. +type_e_class_or_objcclass_type_expected=04093_E_Klasse oder Objective-C Klasse als Typ erwartet, erhielt aber "$1" +% It is only possible to create class reference types of \var{class} and \var{objcclass} +type_e_objcclass_type_expected=04094_E_Objective-C Klasse als Typ erwartet +% The compiler expected an \var{objcclass} type +type_w_procvar_univ_conflicting_para=04095_W_Erzwungener univ Parameter Typ in einer prozeduralen Variablen kann einen Absturz oder SpeicherKorruption verursachen: $1 auf $2 +% \var{univ} parameters are implicitly compatible with all types of the same size, +% also in procedural variable definitions. That means that the following code is +% legal, because \var{single} and \var{longint} have the same size: +% \begin{verbatim} +% {$mode macpas} +% Type +% TIntProc = procedure (l: univ longint); +% +% procedure test(s: single); +% begin +% writeln(s); +% end; +% +% var +% p: TIntProc; +% begin +% p:=test; +% p(4); +% end. +% \end{verbatim} +% This code may however crash on platforms that pass integers in registers and +% floating point values on the stack, because then the stack will be unbalanced. +% Note that this warning will not flagg all potentially dangerous situations. +% when \var{test} returns. +type_e_generics_cannot_reference_itself=04096_E_Typ-Parameter bei der Spezialisation von Generics können den aktuel spezialisierten Typ nicht referenzieren +% Recursive specializations of generics like \var{Type MyType = specialize MyGeneric<MyType>;} are not possible. +type_e_type_parameters_are_not_allowed_here=04097_E_Typ-Parameter sind für nicht-generische Klassen/Record/Objekte Prozeduren und Funktionen nicht erlaubt +% Type parameters are only allowed for methods of generic classes, records or objects +type_e_generic_declaration_does_not_match=04098_E_Die generische Deklaration von "$1" unterscheidet sich vom der vorherigen Deklaration +% Generic declaration does not match the previous declaration +type_e_helper_type_expected=04099_E_Helfertyp erwartet +% The compiler expected a \var{class helper} type. +type_e_record_type_expected=04100_E_Recordtyp erwartet +% The compiler expected a \var{record} type. +type_e_class_helper_must_extend_subclass=04101_E_Abgeleitete Klassenhelfer müssen eine Unterklasse von "$1" oder die Klasse selbst erweitern +% If a class helper inherits from another class helper the extended class must +% extend either the same class as the parent class helper or a subclass of it +type_e_record_helper_must_extend_same_record=04102_E_Abgeleitete Recordhelfer müssen "$1" erweitern +% If a record helper inherits from another record helper it must extend the same +% record that the parent record helper extended. +type_e_procedures_return_no_value=04103_E_Ungültige Zuweisung, eine Prozedur gibt keinen Wert zurück +% This error occurs when one tries to assign the result of a procedure or destructor call. +% A procedure or destructor returns no value so this is not +% possible. +% +% \end{description} +# EndOfTeX + +# +# Symtable +# +# 05084 is the last used one +# +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedure and variable names. +% \begin{description} +sym_e_id_not_found=05000_E_Bezeichner "$1" nicht gefunden +% The compiler doesn't know this symbol. Usually happens when you misspell +% the name of a variable or procedure, or when you forget to declare a +% variable. +sym_f_internal_error_in_symtablestack=05001_F_Interner Fehler in SymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_Doppelter Bezeichner "$1" +% The identifier was already declared in the current scope. +sym_h_duplicate_id_where=05003_H_Bezeichner ist bereits definiert in $1 in Zeile $2 +% The identifier was already declared in a previous scope. +sym_e_unknown_id=05004_E_Unbekannter Bezeichner "$1" +% The identifier encountered hasn't been declared, or is used outside the +% scope where it's defined. +sym_e_forward_not_resolved=05005_E_Forward-Deklaration "$1" nicht gefunden +% This can happen in two cases: +% \begin{itemize} +% \item You declare a function in the \var{interface} part, or +% with a \var{forward} directive, but do not implement it. +% \item You reference a type which isn't declared in the current \var{type} +% block. +% \end{itemize} +sym_e_error_in_type_def=05007_E_Fehler in Typdefinition +% There is an error in your definition of a new array type. +% One of the range delimiters in an array declaration is erroneous. +% For example, \var{Array [1..1.25]} will trigger this error. +sym_e_forward_type_not_resolved=05009_E_Forward-Typ "$1" nicht gefunden +% The compiler encountered an unknown type. +sym_e_only_static_in_static=05010_E_Nur statische Variablen können in statischen oder äusseren Methoden verwendet werden +% A static method of an object can only access static variables. +sym_f_type_must_be_rec_or_class=05012_F_Record- oder Klassen-Typ erwartet +% The variable or expression isn't of the type \var{record} or \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_Instanzen von Klassen oder Objekten mit abstrakten Methoden sind unzulässig +% You are trying to generate an instance of a class which has an abstract +% method that wasn't overridden. +sym_w_label_not_defined=05014_W_Label "$1" nicht definiert +% A label was declared, but not defined. +sym_e_label_used_and_not_defined=05015_E_Label "$1" benutzt aber nicht definiert +% A label was declared and used, but not defined. +sym_e_ill_label_decl=05016_E_Ungültige Label-Deklaration +% This error should never happen; it occurs if a label is defined outside a +% procedure or function. +sym_e_goto_and_label_not_supported=05017_E_GOTO und LABEL werden nicht unterstützt (verwenden Sie den Schalter -Sg) +% You must use the -Sg switch to compile a program which has \var{label}s +% and \var{goto} statements. By default, \var{label} and \var{goto} aren't +% supported. +sym_e_label_not_found=05018_E_Label nicht gefunden +% A \var{goto label} was encountered, but the label wasn't declared. +sym_e_id_is_no_label_id=05019_E_Bezeichner ist kein Label +% The identifier specified after the \var{goto} isn't of type label. +sym_e_label_already_defined=05020_E_Label ist bereits definiert +% You are defining a label twice. You can define a label only once. +sym_e_ill_type_decl_set=05021_E_Ungültige Typdeklaration von Set-Elementen +% The declaration of a set contains an invalid type definition. +sym_e_class_forward_not_resolved=05022_E_Forward-Klassendefinition nicht gefunden: $1 +% You declared a class, but you didn't implement it. +sym_n_unit_not_used=05023_H_Unit "$1" wird von "$2" nicht verwendet +% The unit referenced in the \var{uses} clause is not used. +sym_h_para_identifier_not_used=05024_H_Parameter nicht verwendet: $1 +% This is a warning. The identifier was declared (locally or globally) but +% wasn't used (locally or globally). +sym_n_local_identifier_not_used=05025_N_Lokale Variable nicht verwendet: $1 +% You have declared, but not used, a variable in a procedure or function +% implementation. +sym_h_para_identifier_only_set=05026_H_Werte-Parameter "$1" wurde zugewiesen, aber nie verwendet +% The identifier was declared (locally or globally) and +% assigned to, but is not used (locally or globally) after the assignment. +sym_n_local_identifier_only_set=05027_N_Lokale Variable "$1" wurde zugewiesen, aber nicht verwendet +% The variable in a procedure or function implementation is declared and +% assigned to, but is not used after the assignment. +sym_h_local_symbol_not_used=05028_H_Lokales $1-Element "$2" wird nicht verwendet +% A local symbol is never used. +sym_n_private_identifier_not_used=05029_N_Privates Feld $1.$2 wird nie verwendet +% The indicated private field is defined, but is never used in the code. +sym_n_private_identifier_only_set=05030_N_Privates Feld $1.$2 wurde zugewiesen, aber nie verwendet +% The indicated private field is declared and assigned to, but never read. +sym_n_private_method_not_used=05031_N_Private Methode $1.$2 wird nie verwendet +% The indicated private method is declared but is never used in the code. +sym_e_set_expected=05032_E_Mengentyp erwartet +% The variable or expression isn't of type \var{set}. This happens in an +% \var{in} statement. +sym_w_function_result_not_set=05033_W_Funktionsergebnis scheint nicht gesetzt zu sein +% You can get this warning if the compiler thinks that a function return +% value is not set. This will not be displayed for assembler procedures, +% or procedures that contain assembler blocks. +sym_w_wrong_C_pack=05034_W_Typ "$1" ist im aktuellen Record mit C-Packing nicht korrekt ausgerichtet +% Arrays with sizes not multiples of 4 will be wrongly aligned +% for C structures. +sym_e_illegal_field=05035_E_Unbekannter Record-Feldbezeichner $1 +% The field doesn't exist in the record definition. +sym_w_uninitialized_local_variable=05036_W_Lokale Variable "$1" wird verwendet, bevor ihr ein Wert zugewiesen wurde +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assignment). +sym_w_uninitialized_variable=05037_W_Variable "$1" scheint nicht initialisiert worden zu sein +% These messages are displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% wasn't initialized first (i.e. appeared in the left-hand side of an +% assignment). +sym_e_id_no_member=05038_E_Bezeichener verweist nicht auf ein Element: $1 +% This error is generated when an identifier of a record, +% field or method is accessed while it is not defined. +sym_h_param_list=05039_H_Deklaration gefunden: $1 +% You get this when you use the \var{-vh} switch.In the case of an overloaded procedure +% not being found. Then all candidate overloaded procedures are +% listed, with their parameter lists. +sym_e_segment_too_large=05040_E_Datensegment zu gross (max. 2GB) +% You get this when you declare a data element whose size exceeds the +% prescribed limit (2 Gb on 80386+/68020+ processors). +sym_e_no_matching_implementation_found=05042_E_Keine passende Implementation der Interface Methode "$1" gefunden +% There was no matching method found which could implement the interface +% method. Check argument types and result type of the methods. +sym_w_deprecated_symbol=05043_W_Symbol "$1" ist veraltet +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Use of this symbol +% should be avoided as much as possible. +sym_w_non_portable_symbol=05044_W_Symbol "$1" ist nicht portierbar +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{platform} is used. This symbol's value, use +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_non_implemented_symbol=05055_W_Symbol "$1" ist nicht implementiert +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{unimplemented} is used. This symbol is defined, +% but is not yet implemented on this specific platform. +sym_e_cant_create_unique_type=05056_E_Von diesem Typ kann kein eindeutiger Typ deklariert werden +% Only simple types like ordinal, float and string types are supported when +% redefining a type with \var{type newtype = type oldtype;}. +sym_h_uninitialized_local_variable=05057_H_Die Variable "$1" scheint nicht initialisiert zu sein +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. it did not appear in the left-hand side of an +% assignment). +sym_h_uninitialized_variable=05058_H_Die Variable "$1" scheint nicht initialisiert zu sein +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. t did not appear in the left-hand side of an +% assignment). +sym_w_function_result_uninitialized=05059_W_Die Ergebnisvariable der Funktion scheint nicht initialisiert zu sein +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. it appears in the right-hand side of an expression) +% before it is initialized (i.e. before it appeared in the left-hand side of an +% assignment). +sym_h_function_result_uninitialized=05060_H_Die Ergebnisvariable der Funktion scheint nicht initialisiert zu sein +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. it appears in the right-hand side of an expression) +% before it is initialized (i.e. it appears in the left-hand side of an +% assignment) +sym_w_identifier_only_read=05061_W_Die Variable "$1" wird gelesen, obwohl ihr aber noch kein Wert zugewiesen wurde +% You have read the value of a variable, but nowhere assigned a value to +% it. +sym_h_abstract_method_list=05062_H_Abstrakte Method "$1" gefunden +% When getting a warning about constructing a class/object with abstract methods +% you get this hint to assist you in finding the affected method. +sym_w_experimental_symbol=05063_W_Symbol "$1" ist experimentell +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{experimental} is used. Experimental symbols +% might disappear or change semantics in future versions. Usage of this symbol +% should be avoided as much as possible. +sym_w_forward_not_resolved=05064_W_Forward Deklaration "$1" wird nicht aufgelöst und deshalb als extern angenommen +% This happens if you declare a function in the \var{interface} of a unit in macpas mode, +% but do not implement it. +sym_w_library_symbol=05065_W_Symbol "$1" gehört zu einer Bibliothek +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{library} is used. Library symbols may not be +% available in other libraries. +sym_w_deprecated_symbol_with_msg=05066_W_Symbol "$1" ist veraltet: "$2" +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Use of this symbol +% should be avoided as much as possible. +sym_e_no_enumerator=05067_E_Kann keinen Zähler für den Typ "$1" finden +% This means that compiler cannot find an apropriate enumerator to use in the for-in loop. +% To create an enumerator you need to defind an operator enumerator or add a public or published +% GetEnumerator method to the class or object definition. +sym_e_no_enumerator_move=05068_E_Kann keine Methode "MoveNext" in der Aufzählung "$1" finden +% This means that compiler cannot find a public MoveNext method with the Boolean return type in +% the enumerator class or object definition. +sym_e_no_enumerator_current=05069_E_Kann keine Eigenschaft "Current" in der Aufzählung "$1" finden +% This means that compiler cannot find a public Current property in the enumerator class or object +% definition. +sym_e_objc_para_mismatch=05070_E_Die Anzahl der deklarierten Parameter und die Anzahl der Doppelpunkte in der Nachrichtenzeichenkette stimmen nicht überein +% In Objective-C, a message name automatically contains as many colons as parameters. +% In order to prevent mistakes when specifying the message name in FPC, the compiler +% checks whether this is also the case here. Note that in case of messages taking a +% variable number of arguments translated to FPC via an \var{array of const} parameter, +% this final \var{array of const} parameter is not counted. Neither are the hidden +% \var{self} and \var{\_cmd} parameters. +sym_n_private_type_not_used=05071_N_Privater Typ "$1.$2" wird nie benutzt +% The indicated private type is declared but is never used in the code. +sym_n_private_const_not_used=05072_N_Private Konstante "$1.$2" wird nie benutzt +% The indicated private const is declared but is never used in the code. +sym_n_private_property_not_used=05073_N_Private Eigenschaft "$1.$2" wird nie benutzt +% The indicated private property is declared but is never used in the code. +sym_w_deprecated_unit=05074_W_Unit "$1" ist veraltet +% This means that a unit which is +% declared as \var{deprecated} is used. Deprecated units may no longer +% be available in newer versions of the library. Use of this unit +% should be avoided as much as possible. +sym_w_deprecated_unit_with_msg=05075_W_Unit "$1" ist veraltet: "$2" +% This means that a unit which is +% declared as \var{deprecated} is used. Deprecated units may no longer +% be available in newer versions of the library. Use of this unit +% should be avoided as much as possible. +sym_w_non_portable_unit=05076_W_Unit "$1" ist plattformabhängig +% This means that a unit which is +% declared as \var{platform} is used. This unit use +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_library_unit=05077_W_Unit "$1" gehört zu einer Bibliothek +% This means that a unit which is +% declared as \var{library} is used. Library units may not be +% available in other libraries. +sym_w_non_implemented_unit=05078_W_Unit "$1" ist nicht implementiert +% This means that a unit which is +% declared as \var{unimplemented} is used. This unit is defined, +% but is not yet implemented on this specific platform. +sym_w_experimental_unit=05079_W_Unit "$1" ist experimentell +% This means that a unit which is +% declared as \var{experimental} is used. Experimental units +% might disappear or change semantics in future versions. Usage of this unit +% should be avoided as much as possible. +sym_e_objc_formal_class_not_resolved=05080_E_Die vollständige Definition der formal deklarierten ObjC-Klasse "$1" fehlt in diesem Geltungsbereich +% Objecive-C classes can be imported formally, without using the the unit in which it is fully declared. +% This enables making forward references to such classes and breaking circular dependencies amongst units. +% However, as soon as you wish to actually do something with an entity of this class type (such as +% access one of its fields, send a message to it, or use it to inherit from), the compiler requires the full definition +% of the class to be in scope. +sym_e_interprocgoto_into_init_final_code_not_allowed=05081_E_Gotos in die 'initialization'- oder 'finalization'-Blöcke einer Unit sind nicht erlaubt +% Gotos into initialization or finalization blockse of units are not allowed. +sym_e_external_class_name_mismatch1=05082_E_Ungültiger externer Name "$1" für die formale Klasse "$2" +sym_e_external_class_name_mismatch2=05083_E_Hierhin muss die vollständige Klassendefinition mit externem Namen "$1" +% When a class is declared using a formal external definition, the actual external +% definition (if any) must specify the same external name as the formal definition +% (since both definitions refer to the same actual class type). +sym_w_library_overload=05084_W_Möglicher Bibliothekenkonflikt: Das Symbol "$1" aus Bibliothek "$2" wurde auch in Bibliothek "$3" gefunden +% Some OS do not have library specific namespaces, for those +% OS, the function declared as "external 'libname' name 'funcname'", +% the 'libname' part is only a hint, funcname might also be loaded +% by another library. This warning appears if 'funcname' is used twice +% with two different library names. +% +% \end{description} +# EndOfTeX + +# +# Codegenerator +# +# 06052 is the last used one +# +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +cg_e_parasize_too_big=06009_E_Grösse der Parameterliste übersteigt 65535 Bytes +% The I386 processor limits the parameter list to 65535 bytes. (The \var{RET} +% instruction causes this). +cg_e_file_must_call_by_reference=06012_E_Dateitypen müssen VAR Parameter sein +% You cannot specify files as value parameters, i.e., they must always be +% declared \var{var} parameters. +cg_e_cant_use_far_pointer_there=06013_E_Die Verwendung eines FAR-Zeigers ist in dieser Art nicht erlaubt +% Free Pascal doesn't support far pointers, so you cannot take the address of +% an expression which has a far reference as a result. The \var{mem} construct +% has a far reference as a result, so the following code will produce this +% error: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_Mit EXPORT deklarierte Funktionen können nicht aufgerufen werden +% No longer in use. +cg_w_member_cd_call_from_method=06016_W_Möglicherweise unzulässiger Aufruf eines Konstruktors oder Destruktors (passt nicht in diesen Kontext) +% The compiler detected that a constructor or destructor is called within a +% a method. This will probably lead to problems, since constructors / destructors +% require parameters on entry. +cg_n_inefficient_code=06017_N_Uneffiziente Programmierung +% You construction seems dubious to the compiler. +cg_w_unreachable_code=06018_W_Code wird niemals ausgeführt +% You specified a loop which will never be executed. Example: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_Abstrakte Methoden können nicht direkt aufgerufen werden +% You cannot call an abstract method directly. Instead, you must call an +% overriding child method, because an abstract method isn't implemented. +cg_d_register_weight=06027_DL_Register $1 Gewichtung $2 $3 +% Debugging message. Shown when the compiler considers a variable for +% keeping in the registers. +cg_d_stackframe_omited=06029_DL_Stackframe wird ausgelassen +% Some procedure/functions do not need a complete stack-frame, so it is omitted. +% This message will be displayed when the {-vd} switch is used. +cg_e_unable_inline_object_methods=06031_E_Objektmethoden können nicht Inline sein +% You cannot have inlined object methods. +cg_e_unable_inline_procvar=06032_E_Procvar-Aufrufe können nicht Inline sein +% A procedure with a procedural variable call cannot be inlined. +cg_e_no_code_for_inline_stored=06033_E_Kein Code für Inline-Prozedur gespeichert +% The compiler couldn't store code for the inline procedure. +cg_e_can_access_element_zero=06035_E_Auf Element Null von Ansi/Wide- oder Longstring kann nicht zugegriffen werden, benutzen Sie stattdessen (Set)Length +% You should use \var{setlength} to set the length of an ansi/wide/longstring +% and \var{length} to get the length of such string type. +cg_e_cannot_call_cons_dest_inside_with=06037_E_Konstruktoren und Destruktoren können in diesem Kontext nicht aufgerufen werden +% Inside a \var{With} clause you cannot call a constructor or destructor for the +% object you have in the \var{with} clause. +cg_e_cannot_call_message_direct=06038_E_Kann Messagehandler-Methode nicht direkt aufrufen +% A message method handler method can't be called directly if it contains an +% explicit \var{Self} argument. +cg_e_goto_inout_of_exception_block=06039_E_Sprung in- oder aus dem Exceptionblock heraus +% It is not allowed to jump in or outside of an exception block like \var{try..finally..end;}. +% For example, the following code will produce this error: + +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // this line will cause an error +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_Kontrollfluss-Anweisungen sind in einem Finally-Block nicht erlaubt +% It isn't allowed to use the control flow statements \var{break}, +% \var{continue} and \var{exit} +% inside a finally statement. The following example shows the problem: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // This exit ISN'T allowed +% end; +% ... +% +% \end{verbatim} +% If the procedure \var{p} raises an exception the finally block is +% executed. If the execution reaches the exit, it's unclear what to do: +% exit the procedure or search for another exception handler. +cg_w_parasize_too_big=06041_W_Grösse der Parameter überschreitet die Grenze für bestimmte CPUs +% This indicates that you are declaring more than 64K of parameters, which +% might not be supported on other processor targets. +cg_w_localsize_too_big=06042_W_Grösse der lokalen Variablen überschreitet die Grenze für bestimmte CPUs +% This indicates that you are declaring more than 32K of local variables, which +% might not be supported on other processor targets. +cg_e_localsize_too_big=06043_E_Grösse der lokalen Variablen überschreitet die unterstützte Grenze +% This indicates that you are declaring more than 32K of local variables, which +% is not supported by this processor. +cg_e_break_not_allowed=06044_E_BREAK nicht zulässig +% You're trying to use \var{break} outside a loop construction. +cg_e_continue_not_allowed=06045_E_CONTINUE nicht zulässig +% You're trying to use \var{continue} outside a loop construction. +cg_f_unknown_compilerproc=06046_F_Unbekannte Compiler-Prozedur "$1". Ãœberprüfe, ob die korrekte Laufzeit-Bibliothek verwendet wird. +% The compiler expects that the runtime library contains certain subroutines. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the compiler in use. If you changed the runtime library this error means +% that you removed a subroutine which the compiler needs for internal use. +cg_f_unknown_system_type=06047_F_Systemtyp "$1" konnte nicht gefunden werden. Ãœberprüfe ob die korrekte Laufzeit-Bibliothek verwendet wird. +% The compiler expects that the runtime library contains certain type definitions. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the compiler in use. If you changed the runtime library this error means +% that you removed a type which the compiler needs for internal use. +cg_h_inherited_ignored=06048_H_Geerbter Aufruf einer abstrakten Methode ignoriert +% This message appears only in Delphi mode when you call an abstract method +% of a parent class via \var{inherited;}. The call is then ignored. +cg_e_goto_label_not_found=06049_E_Goto Label "$1": Das Label ist nicht definiert oder wurde bei der Optimierung entfernt +% The label used in the goto definition is not defined or optimized away by the +% unreachable code elemination. +cg_f_unknown_type_in_unit=06050_F_Kann den Typ "$1" nicht in der Unit "$2" finden. Ãœberprüfe, ob die korrekte Laufzeit-Bibliothek verwendet wird +% The compiler expects that the runtime library contains certain type definitions. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the compiler in use. If you changed the runtime library this error means +% that you removed a type which the compiler needs for internal use. +cg_e_interprocedural_goto_only_to_outer_scope_allowed=06051_E_Interprozedurale gotos sind nur in äußere Subroutines erlaubt +% Gotos between subroutines are only allowed if the goto jumps from an inner to an outer subroutine or +% from a subroutine to the main program +cg_e_labels_cannot_defined_outside_declaration_scope=06052_E_ Label müssen im selben Bereich definiert werden, in dem sie deklariert werden +% In ISO mode, labels must be defined in the same scope as they are declared. +cg_e_goto_across_procedures_with_exceptions_not_allowed=06053_E_Eine Prozedur, die explizite oder implizite Excpetion Frames enthält, darf nicht mit einem goto verlassen werden +% Non-local gotos might not be used to leave procedures using exceptions either implicitly or explicitly. Procedures +% which use automated types like ansistrings or class constructurs are affected by this too. +% +% \end{description} +# EndOfTeX + +# +# Assembler reader +# +# 07110 is the last used one +# +asmr_d_start_reading=07000_DL_Starte $1 Stil Assembler Parsen +% This informs you that an assembler block is being parsed +asmr_d_finish_reading=07001_DL_Beende $1 Stil Assembler Parsen +% This informs you that an assembler block has finished. +asmr_e_none_label_contain_at=07002_E_Nicht-Label Bezeichner enthält @ +% A identifier which isn't a label can't contain a @. +asmr_e_building_record_offset=07004_E_Fehler beim Ermitteln des Recordoffsets +% There has an error occured while building the offset of a record/object +% structure, this can happend when there is no field specified at all or +% an unknown field identifier is used. +asmr_e_offset_without_identifier=07005_E_OFFSET ohne Bezeicner verwendet +% You can only use OFFSET with an identifier. Other syntaxes aren't +% supported +asmr_e_type_without_identifier=07006_E_TYPE verwendet ohne Bezeichner +% You can only use TYPE with an identifier. Other syntaxes aren't +% supported +asmr_e_no_local_or_para_allowed=07007_E_Lokale Variable oder Parameter können hier nicht verwendet werden +% You can't use a local variable or parameter here, mostly because the +% addressing of locals and parameters is done using the %ebp register so the +% address can't be get directly. +asmr_e_need_offset=07008_E_Hier muss OFFSET verwendet werden +% You need to use OFFSET <id> here to get the address of the identifier. +asmr_e_need_dollar=07009_E_Hier muss "$" verwendet werden +% You need to use $<id> here to get the address of the identifier. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_Verwendung von mehreren verschiebbaren Symbolen nicht möglich +% You can't have more than one relocatable symbol (variable/typed constant) +% in one argument. +asmr_e_only_add_relocatable_symbol=07011_E_Verschiebbares Symbol kann nur addiert werden +% Relocatable symbols (variable/typed constant) can't be used with other +% operators. Only addition is allowed. +asmr_e_invalid_constant_expression=07012_E_Ungültiger Konstantenausdruck +% There is an error in the constant expression. +asmr_e_relocatable_symbol_not_allowed=07013_E_Verschiebbares Symbol ist nicht zulässig +% You can't use a relocatable symbol (variable/typed constant) here. +asmr_e_invalid_reference_syntax=07014_E_Ungültige Verweis-Syntax +% There is an error in the reference. +asmr_e_local_para_unreachable=07015_E_Sie können "$1" von diesem Code aus nicht erreichen +% You cannot read directly the value of a local variable or parameter +% of a higher level procedure in assembler code (except for +% local assembler code without parameter nor locals). +asmr_e_local_label_not_allowed_as_ref=07016_E_Lokale Symbole/Labels sind nicht als Referenz zulässig +% You can't use local symbols/labels as references +asmr_e_wrong_base_index=07017_E_Ungültige Verwendung von Basis- und Index-Registern +% There is an error with the base and index register, they are +% probably incorrect +asmr_w_possible_object_field_bug=07018_W_Möglicher Fehler bei Objektfeld-Behandlung +% Fields of objects or classes can be reached directly in normal or objfpc +% modes but TP and Delphi modes treat the field name as a simple offset. +asmr_e_wrong_scale_factor=07019_E_Falscher Skalierungsfaktor angegeben +% The scale factor given is wrong, only 1,2,4 and 8 are allowed +asmr_e_multiple_index=07020_E_Mehrfache Verwendung fon Index-Registern +% You are trying to use more than one index register +asmr_e_invalid_operand_type=07021_E_Ungültiger Operandentyp +% The operand type doesn't match with the opcode used +asmr_e_invalid_string_as_opcode_operand=07022_E_Ungülitge Zeichenkette als Opcode-Operand: $1 +% The string specified as operand is not correct with this opcode +asmr_w_CODE_and_DATA_not_supported=07023_W_@CODE und @DATA werden nicht unterstützt +% @CODE and @DATA are unsupported and are ignored. +asmr_e_null_label_ref_not_allowed=07024_E_Null-Label-Bezug nicht möglich +asmr_e_expr_zero_divide=07025_E_Division durch Null in Assembler-Ausdruck +% There is a division by zero in a constant expression +asmr_e_expr_illegal=07026_E_Ungültiger Ausdruck +% There is an illegal expression in a constant expression +asmr_e_escape_seq_ignored=07027_E_Escape-Sequenz ignoriert: $1 +% There is a C-styled string, but the escape sequence in the string +% is unknown, and is therefore ignored +asmr_e_invalid_symbol_ref=07028_E_Ungültige Symbolverwendung +asmr_w_fwait_emu_prob=07029_W_FWAIT kann Emulationsprobleme mit emu387 verursachen +asmr_w_fadd_to_faddp=07030_W_$1 ohne Operand wurde in $1P übersetzt +asmr_w_enter_not_supported_by_linux=07031_W_Der ENTER-Befehl wird vom Linux-Kernel nicht unterstützt +% ENTER instruction can generate a stack page fault that is not +% caught correctly by the i386 Linux page handler. +asmr_w_calling_overload_func=07032_W_Aufruf einer überladenen Funktion in Assembler +% There is a call to an overloaded method in the assembler block, +% this might be the sign there is a problem +asmr_e_unsupported_symbol_type=07033_E_Nicht unterstützter Symboltyp für Operand +asmr_e_constant_out_of_bounds=07034_E_Wert der Konstante ausserhalb des zulässigen Bereichs +asmr_e_error_converting_decimal=07035_E_Fehler beim Umwandeln in Dezimal $1 +% A constant decimal value does not have the correct syntax +asmr_e_error_converting_octal=07036_E_Fehler beim Umwandeln in Oktal $1 +% A constant octal value does not have the correct syntax +asmr_e_error_converting_binary=07037_E_Fehler beim Umwandeln in Binär $1 +% A constant binary value does not have the correct syntax +asmr_e_error_converting_hexadecimal=07038_E_Fehler beim Umwandeln in Hexadezimal $1 +% A constant hexadecimal value does not have the correct syntax +asmr_h_direct_global_to_mangled=07039_H_$1 übersetzt nach $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 ist einer überladenen Funktion zugeordnet +asmr_e_cannot_use_SELF_outside_a_method=07041_E_Kann SELF nicht ausserhalb einer Methode verwenden +% There is a reference to the \var{self} symbol while it is not +% allowed. \var{self} can only be referenced inside methods +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_Kann OLDEBP ausserhalb einer verschachtelten Prozedur nicht verwenden +% There is a reference to the \var{oldebp} symbol while it is not +% allowed. \var{oldebp} can only be referenced inside nested routines +asmr_e_void_function=07043_W_Prozeduren können keinen Wert im Assembler-Code zurückliefern +% Trying to return a value while in a procedure. A procedure +% does not have any return value +asmr_e_SEG_not_supported=07044_E_SEG nicht unterstützt +asmr_e_size_suffix_and_dest_dont_match=07045_E_Grössensuffix und Ziel- oder Quellgrösse passen nicht zusammen +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_w_size_suffix_and_dest_dont_match=07046_W_Grössensuffix und Ziel- oder Quellgrösse passen nicht zusammen +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_e_syntax_error=07047_E_Assembler Syntaxfehler +% There is an assembler syntax error +asmr_e_invalid_opcode_and_operand=07048_E_Ungültige Kombination von Opcode und Operanden +% The opcode cannot be used with this type of operand +asmr_e_syn_operand=07049_E_Assembler Syntaxfehler im Operanden +asmr_e_syn_constant=07050_E_Assembler Syntaxfehler in Konstanten +asmr_e_invalid_string_expression=07051_E_Ungültiger Stringausdruck +asmr_w_const32bit_for_address=07052_W_Konstante mit Symbol $1 für Adresse erzeugt, die kein Pointer ist +% A constant expression represents an address which does not fit +% into a pointer. The address is probably incorrect +asmr_e_unknown_opcode=07053_E_Unbekannter Opcode $1 +% This opcode is not known +asmr_e_invalid_or_missing_opcode=07054_E_Ungültiger oder fehlender Opcode +asmr_e_invalid_prefix_and_opcode=07055_E_Ungültige Kombination von Prefix und Opcode: $1 +asmr_e_invalid_override_and_opcode=07056_E_Ungültige Kombination von Override und Opcode: $1 +asmr_e_too_many_operands=07057_E_Zu viele Operanden in der Zeile +% There are too many operands for this opcode. Check your +% assembler syntax +asmr_w_near_ignored=07058_W_NEAR ignoriert +asmr_w_far_ignored=07059_W_FAR ignoriert +asmr_e_dup_local_sym=07060_E_Doppelters lokales Symbol $1 +asmr_e_unknown_local_sym=07061_E_Undefiniertes lokales Symbol $1 +asmr_e_unknown_label_identifier=07062_E_Unbekannter Label-Bezeichner $1 +asmr_e_invalid_register=07063_E_Ungültiger Registername +% There is an unknown register name used as operand. +asmr_e_invalid_fpu_register=07064_E_Ungültiger Name für Fliesskommaregister +% There is an unknown register name used as operand. +asmr_w_modulo_not_supported=07066_W_Modulo nicht unterstützt +asmr_e_invalid_float_const=07067_E_Ungültige Fliesskommakonstante $1 +% The floating point constant declared in an assembler block is +% invalid. +asmr_e_invalid_float_expr=07068_E_Ungültiger Fliesskommaausdruck +% The floating point expression declared in an assembler block is +% invalid. +asmr_e_wrong_sym_type=07069_E_Falscher Symboltyp +asmr_e_cannot_index_relative_var=07070_E_Kann lokale Variable oder Parameter nicht mit Register indizieren +% Trying to index using a base register a symbol which is already relative +% to a register. This is not possible, and will probably lead to crashes. +asmr_e_invalid_seg_override=07071_E_Ungültiger Segmentoverride-Ausdruck +asmr_w_id_supposed_external=07072_W_Bezeichner $1 ist vermutlich External +% There is a reference to an undefined symbol. This will not result +% in an error, since the symbol might be external, but may cause +% problems at link time if the symbol is not defined anywhere. +asmr_e_string_not_allowed_as_const=07073_E_Strings sind als Konstanten unzulässig +% Character strings are not allowed as constants. +asmr_e_no_var_type_specified=07074_E_Typ der Variablen nicht angegeben +% The syntax expects a type idenfitifer after the dot, but +% none was found. +asmr_w_assembler_code_not_returned_to_text=07075_E_Assemblercode kehrt nicht zum Text zurück +% There was a directive in the assembler block to change sections, +% but there is a missing return to the text section at the end +% of the assembler block. This might cause errors during link time. +asmr_e_not_directive_or_local_symbol=07076_E_Keine Direktive oder lokales Symbol $1 +% This symbol is unknown. +asmr_w_using_defined_as_local=07077_E_Verwendung eines definierten Namens als lokales Label +asmr_e_dollar_without_identifier=07078_E_Dollarzeichen wird ohne Bezeichner verwendet +% A constant expression has an identifier which does not start with +% the $ symbol. +asmr_w_32bit_const_for_address=07079_W_32-Bit-Konstante für Adresse erzeugt +% A constant was used as an address. This is probably an error, +% since using absolute addresses will probably not work. +asmr_n_align_is_target_specific=07080_N_.align ist abhängig von Zielplattform, verwende .balign oder .p2align +% Using the .align directive is platform specific, and its meaning will vary +% from one platform to another. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_Kann für Parameter nicht direkt auf Felder zugreifen +% You should load the parameter first into a register and then access the +% fields using that register. +asmr_e_cannot_access_object_field_directly=07082_E_Kann auf Felder von Objekten/Klassen nicht direkt zugreifen +% You should load the self pointer first into a register and then access the +% fields using the register as base. By default the self pointer is available +% in the esi register on i386. +asmr_e_unable_to_determine_reference_size=07083_E_Grösse nicht spezifiziert und auch keine Möglichkeit die Grösse der Operanden zu bestimmen +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. +asmr_e_cannot_use_RESULT_here=07084_E_RESULT kann in dieser Funktion nicht verwendet werden +% Some functions which return complex types cannot use the \var{result} +% keyword. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" ohne Operand übersetzt in "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" übersetzt in "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" übersetzt in "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_Das Zeichen < ist hier nicht erlaubt +% The shift operator requires the << characters. Only one +% of those characters was found. +asmr_e_invalid_char_greater=07090_E_Das Zeichen > ist hier nicht erlaubt +% The shift operator requires the >> characters. Only one +% of those characters was found. +asmr_w_align_not_supported=07093_W_ALIGN wird nicht unterstützt +asmr_e_no_inc_and_dec_together=07094_E_Inc und Dec können nicht gemeinsam vorkommen +% Trying to use an increment and a decrement within the same +% opcode on the 680x0. This is impossible. +asmr_e_invalid_reg_list_in_movem=07095_E_Ungültige Registerliste für movem +% Trying to use the \var{movem} opcode with invalid registers +% to save or restore. +asmr_e_invalid_reg_list_for_opcode=07096_E_Ungültige Registerliste für diesen opcode +asmr_e_higher_cpu_mode_required=07097_E_Höherer cpu Modus notwendig ($1) +% Trying to use an instruction which is not supported in the current +% cpu mode. Use a higher cpu generation to be able to use this +% opcode in your assembler block +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_Grösse nicht spezifiziert und auch keine Möglichkeit die Grösse der Operanden zu bestimmen. Es wird DWORD als Voreinstellung verwendet +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use DWORD as default. +asmr_e_illegal_shifterop_syntax=07099_E_Syntax Fehler beim Analysieren eines shifter Operanden +% ARM only; ARM assembler supports a so called shifter operand. The used syntax isn't +% a valid shifter operand. Example for an operation with shifter operand: +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +asmr_e_packed_element=07100_E_Die Adresse der packed Komponente ist nicht an einer Byte Grenze +% Packed components (record fields and array elements) may start at an arbitrary +% bit inside a byte. On CPU which do not support bit-addressable memory (which +% includes all currently supported CPUs by FPC) you will therefore get an error +% message when trying to index arrays with elements whose size is not a multiple +% of 8 bits. The same goes for accessing record fields with such an address. +% multiple of 8 bits. +asmr_w_unable_to_determine_reference_size_using_byte=07101_W_Grösse nicht angegeben und kann auch nicht aus der Grösse der Operanden bestimmt werden. Verwende BYTE als Voreinstellung +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use BYTE as default. +asmr_w_no_direct_ebp_for_parameter=07102_W_Die Verwendung von +offset(%ebp) für Parameter ist hier ungültig +% Using direct 8(%ebp) reference for function/procedure parameters is invalid +% if parameters are in registers. +asmr_w_direct_ebp_for_parameter_regcall=07103_W_Die Verwendung von +offset(%ebp) ist nicht mit der regcall Konvention kompatibel +% Using direct 8(%ebp) reference for function/procedure parameters is invalid +% if parameters are in registers. +asmr_w_direct_ebp_neg_offset=07104_W_Die Verwendung von -offset(%ebp) wird für den Zugriff auf lokale Variablen nicht empfohlen +% Using -8(%ebp) to access a local variable is not recommended +asmr_w_direct_esp_neg_offset=07105_W_Verwendung von -offset(%esp); Zugriff kann einen Crash oder Datenverlust auslösen +% Using -8(%esp) to access a local stack is not recommended, as +% this stack portion can be overwritten by any function calls or interrupts. +asmr_e_no_vmtoffset_possible=07106_E_VMTOffset muss in Kombination mit einer virtuellen Methode verwendet werden; "$1" ist aber nicht virtuell +% Only virtual methods have VMT offsets +asmr_e_need_pic_ref=07107_E_Erzeuge eigentlich PIC, aber die Referenz ist nicht PIC-sicher +% The compiler has been configured to generate position-independent code +% (PIC), but there are position-dependent references in the current +% handwritten assembler instruction. +asmr_e_mixing_regtypes=07108_E_Alle Register in einem Registerset müssen in T und Breite übereinstimmen +% Instructions on the ARM architecture that take a register set as argument require that all registers +% in this set are of the same kind (e.g., integer, vfp) and width (e.g., single precision, double precision). +asmr_e_empty_regset=07109_E_Ein Registerset kann nicht leer sein +% Instructions on the ARM architecture that take a register set as argument require that such a set +% contains at least one register. +asmr_w_useless_got_for_local=07110_W_@GOTPCREL ist nutzlos und bei lokalen Symbole möglicherweise gefährlich +% The use of @GOTPCREL supposes an extra indirection that is +% not present if the symbol is local, which might lead to wrong asembler code + +# +# Assembler/binary writers +# +# 08022 is the last used one +# +asmw_f_too_many_asm_files=08000_F_Zu viele Assembler-Dateien +% With smartlinking enabled, there are too many assembler +% files generated. Disable smartlinking. +asmw_f_assembler_output_not_supported=08001_F_Gewählte Assemblerausgabe wird nicht unterstützt +asmw_f_comp_not_supported=08002_F_Comp nicht unterstützt +asmw_f_direct_not_supported=08003_F_Direct nicht unterstützt für binäres Schreiben +% Direct assembler mode is not supported for binary writers. +asmw_e_alloc_data_only_in_bss=08004_E_Allozieren von Daten ist nur in "bss"-Abschnitten zulässig +asmw_f_no_binary_writer_selected=08005_F_Kein Binärschreiber ausgewählt +asmw_e_opcode_not_in_table=08006_E_Asm: Opcode $1 nicht in Tabelle enthalten +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 ungültige Kombination von Opcode und Operanden +asmw_e_16bit_not_supported=08008_E_Asm: 16-Bit-Verweise werden nicht unterstützt +asmw_e_invalid_effective_address=08009_E_Asm: Ungültige effektive Adresse +asmw_e_immediate_or_reference_expected=08010_E_Asm: Konstanter Ausdruck oder Referenz erwartet +asmw_e_value_exceeds_bounds=08011_E_Asm: $1 Wert überschreitet Grenzen $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: "Short jump" ist ausserhalb des Bereichs $1 +asmw_e_undefined_label=08013_E_Asm: Undefiniertes Label: $1 +asmw_e_comp_not_supported=08014_E_Asm: Comp wird für dieses Ziel nicht unterstützt +asmw_e_extended_not_supported=08015_E_Asm: Extended Typ wird für dieses Ziel nicht unterstützt +asmw_e_duplicate_label=08016_E_Asm: Doppeltes Label $1 +asmw_e_redefined_label=08017_E_Asm: Neu definiertes Label $1 +asmw_e_first_defined_label=08018_E_Asm: First beginnt hier +asmw_e_invalid_register=08019_E_Asm: Ungültiges Register $1 +asmw_e_16bit_32bit_not_supported=08020_E_Asm: 16 oder 32 Bit Referenzen werden nicht unterstützt +asmw_e_64bit_not_supported=08021_E_Asm: 64 Bit Operanden werden nicht unterstützt +asmw_e_bad_reg_with_rex=08022_E_Asm: AH,BH,CH oder DH können nicht in einer Instruktion verwendt werden, die den Prefix REX benötigt +% x86_64 only: instruction encoding of this platform does not allow using +% 8086 high byte registers (AH,BH,CH or DH) together with REX prefix in a single instruction. +% The REX prefix is required whenever the instruction operand size is 64 bits, or +% when it uses one of extended x86_64 registers (R8-R15 or XMM8-XMM15). + +# +# Executing linker/assembler +# +# 09032 is the last used one +# +# BeginOfTeX +% +% \section{Errors of assembling/linking stage} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +exec_w_source_os_redefined=09000_W_Quellbetriebssystem wurde neu definiert +% The source operating system is redefined. +exec_i_assembling_pipe=09001_I_Assembliere (pipe) $1 +% Assembling using a pipe to an external assembler. +exec_d_cant_create_asmfile=09002_E_Kann Assemblerdatei nicht erzeugen: $1 +% The mentioned file can't be created. Check if you have +% access permissions to create this file. +exec_e_cant_create_objectfile=09003_E_Kann Objektdatei nicht erzeugen: $1 +% The mentioned file can't be created. Check if you have +% got access permissions to create this file. +exec_e_cant_create_archivefile=09004_E_Kann Archivdatei nicht erzeugen: $1 +% The mentioned file can't be created. Check if you have +% access permissions to create this file. +exec_e_assembler_not_found=09005_E_Assembler $1 nicht gefunden, schalte um zu externem Assemblieren +% The assembler program was not found. The compiler will produce a script that +% can be used to assemble and link the program. +exec_t_using_assembler=09006_T_Benutze Assembler: $1 +% An informational message saying which assembler is being used. +exec_e_error_while_assembling=09007_E_Fehler beim Assemblieren des Exitcodes $1 +% There was an error while assembling the file using an external assembler. +% Consult the documentation of the assembler tool to find out more information +% on this error. +exec_e_cant_call_assembler=09008_E_Assembler kann nicht aufgerufen werden, Fehler $1 schalte um zu externem Assemblieren +% An error occurred when calling an external assembler. The compiler will produce a script that +% can be used to assemble and link the program. +exec_i_assembling=09009_I_Assembliere $1 +% An informational message stating which file is being assembled. +exec_i_assembling_smart=09010_I_Assembliere mit Smartlinking $1 +% An informational message stating which file is being assembled using smartlinking. +exec_w_objfile_not_found=09011_W_Objekt $1 nicht gefunden, Linken kann fehlschlagen! +% One of the object files is missing, and linking will probably fail. +% Check your paths. +exec_w_libfile_not_found=09012_W_Bibliothek $1 nicht gefunden, Linken kann fehlschlagen! +% One of the library file is missing, and linking will probably fail. +% Check your paths. +exec_e_error_while_linking=09013_E_Fehler beim Linken +% Generic error while linking. +exec_e_cant_call_linker=09014_E_Linker kann nicht aufgerufen werden, schalte um zu externem Linken +% An error occurred when calling an external linker. The compiler will produce a script that +% can be used to assemble and link the program. +exec_i_linking=09015_I_Linke $1 +% An informational message, showing which program or library is being linked. +exec_e_util_not_found=09016_E_Hilfsprogramm $1 nicht gefunden, schalte um zu externem Linken +% An external tool was not found. The compiler will produce a script that +% can be used to assemble and link or postprocess the program. +exec_t_using_util=09017_T_Benutze Hilfsprogramm $1 +% An informational message, showing which external program (usually a postprocessor) is being used. +exec_e_exe_not_supported=09018_E_Erzeugen von ausführbaren Dateien nicht unterstützt +% Creating executable programs is not supported for this platform, because it was +% not yet implemented in the compiler. +exec_e_dll_not_supported=09019_E_Dynamische Bibliotheken nicht unterstützt +% Creating dynamically loadable libraries is not supported for this platform, because it was +% not yet implemented in the compiler. +exec_i_closing_script=09020_I_Schliesse Skript $1 +% Informational message showing when writing of the external assembling and linking script is finished. +exec_e_res_not_found=09021_E_Resource-Compiler "$1" nicht gefunden, schalte um auf externen Modus +% An external resource compiler was not found. The compiler will produce a script that +% can be used to assemble, compile resources and link or postprocess the program. +exec_i_compilingresource=09022_I_Ãœbersetze Resource $1 +% An informational message, showing which resource is being compiled. +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_Unit $1 kann nicht statisch gelinkt werden, schalte um zu smart Linken +% Static linking was requested, but a unit which is not statically linkable was used. +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_Unit $1 kann nicht smart gelinkt werden, schalte um zu statischem Linken +% Smart linking was requested, but a unit which is not smart-linkable was used. +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_Unit $1 kann nicht shared gelinkt werden, schalte um zu statischem Linken +% Shared linking was requested, but a unit which is not shared-linkable was used. +exec_e_unit_not_smart_or_static_linkable=09026_E_Unit $1 kann weder smart noch statisch gelinkt werden +% Smart or static linking was requested, but a unit which cannot be used for either was used. +exec_e_unit_not_shared_or_static_linkable=09027_E_Unit $1 kann weder shared noch statisch gelinkt werden +% Shared or static linking was requested, but a unit which cannot be used for either was used. +exec_d_resbin_params=09028_D_Resource-Compiler "$1" wird mit "$2" als Kommandozeile aufgerufen +% An informational message showing which command line is used for the resource compiler. +exec_e_error_while_compiling_resources=09029_E_Fehler beim Ãœbersetzen von Resourcen +% The resource compiler or converter returned an error. +exec_e_cant_call_resource_compiler=09030_E_Der Resource-Compiler "$1" kann nicht aufgerufen werden, schalte um auf externen Modus +% An error occurred when calling a resource compiler. The compiler will produce +% a script that can be used to assemble, compile resources and link or +% postprocess the program. +exec_e_cant_open_resource_file=09031_E_Kann die Resourcedatei "$1" nicht öffnen +% An error occurred resource file cannot be opened. +exec_e_cant_write_resource_file=09032_E_Kann die Resourcedatei "$1" nicht schreiben +% An error occurred resource file cannot be written. +% +% \end{description} +# EndOfTeX + +# +# Executable information +# +# 09134 is the last used one +# +# BeginOfTeX +% \section{Executable information messages.} +% This section lists all messages that the compiler emits when an executable program is produced, +% and only when the internal linker is used. +% \begin{description} +execinfo_f_cant_process_executable=09128_F_Kann ausführbare Datei nicht nachbearbeiten: $1 +% Fatal error when the compiler is unable to post-process an executable. +execinfo_f_cant_open_executable=09129_F_Kann ausführbare Datei nicht öffnen: $1 +% Fatal error when the compiler cannot open the file for the executable. +execinfo_x_codesize=09130_X_Grösse des Codes: $1 Bytes +% Informational message showing the size of the produced code section. +execinfo_x_initdatasize=09131_X_Grösse der initialisierten Daten: $1 Bytes +% Informational message showing the size of the initialized data section. +execinfo_x_uninitdatasize=09132_X_Grösse der nicht initialisierten Daten: $1 Bytes +% Informational message showing the size of the uninitialized data section. +execinfo_x_stackreserve=09133_X_Stack Bereich "reserved": $1 Bytes +% Informational message showing the stack size that the compiler reserved for the executable. +execinfo_x_stackcommit=09134_X_Stack Bereich "committed": $1 Bytes +% Informational message showing the stack size that the compiler committed for the executable. +% +% \end{description} +# EndOfTeX + +# +# Internal linker messages +# +# 09201 is the last used one +# +# BeginOfTeX +% \section{Linker messages} +% This section lists messages produced by internal linker. +% \begin{description} +link_f_executable_too_big=09200_F_Das Programm - Image ist für das Target $1 zu groß +% Fatal error when resulting executable is too big. +link_w_32bit_absolute_reloc=09201_W_Object Daei "$1" enthält eine 32-bit absolute Relocation auf Symbol "$2". +% Warning when 64-bit object file contains 32-bit absolute relocations. +% In such case an executable image can be loaded into lower 4Gb of +% address space only. +% +% \end{description} +# EndOfTeX + +# +# Unit loading +# +# 10062 is the last used one +# +# BeginOfTeX +% \section{Unit loading messages.} +% This section lists all messages that can occur when the compiler is +% loading a unit from disk into memory. Many of these mesages are +% informational messages. +% \begin{description} +unit_t_unitsearch=10000_T_Suche Unit: $1 +% When you use the \var{-vt} option, the compiler tells you where it tries to find +% unit files. +unit_t_ppu_loading=10001_T_Lade PPU: $1 +% When the \var{-vt} switch is used, the compiler tells you +% what units it loads. +unit_u_ppu_name=10002_U_PPU-Name: $1 +% When you use the \var{-vu} flag, the unit name is shown. +unit_u_ppu_flags=10003_U_PPU-Flags: $1 +% When you use the \var{-vu} flag, the unit flags are shown. +unit_u_ppu_crc=10004_U_PPU-CRC: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_time=10005_U_PPU-Zeit: $1 +% When you use the \var{-vu} flag, the unit time is shown. +unit_u_ppu_file_too_short=10006_U_PPU-Datei zu kurz +% When you use the \var{-vu} flag, the unit time is shown. +unit_u_ppu_invalid_header=10007_U_PPU Ungültiger Header (kein PPU am Anfang) +% A unit file contains as the first three bytes the ASCII codes of the characters \var{PPU}. +unit_u_ppu_invalid_version=10008_U_PPU Ungültige Version $1 +% This unit file was compiled with a different version of the compiler, and +% cannot be read. +unit_u_ppu_invalid_processor=10009_U_PPU ist für einen anderen Prozessor übersetzt +% This unit file was compiled for a different processor type, and +% cannot be read. +unit_u_ppu_invalid_target=10010_U_PPU ist für ein anderes Zielsystem übersetzt +% This unit file was compiled for a different processor type, and +% cannot be read. +unit_u_ppu_source=10011_U_PPU Quelle: $1 +% When you use the \var{-vu} flag, the unit source file name is shown. +unit_u_ppu_write=10012_U_Schreibe $1 +% When you specify the \var{-vu} switch, the compiler will tell you where it +% writes the unit file. +unit_f_ppu_cannot_write=10013_F_Kann PPU-Datei nicht schreiben +% An error occurred when writing the unit file. +unit_f_ppu_read_error=10014_F_Kann PPU-Datei nicht lesen +% This means that the unit file was corrupted, and contains invalid +% information. Recompilation will be necessary. +unit_f_ppu_read_unexpected_end=10015_F_Unerwartetes Ende der PPU-Datei +% Unexpected end of file. This may mean that the PPU file is +% corrupted. +unit_f_ppu_invalid_entry=10016_F_Ungültiger Eintrag in PPU-Datei: $1 +% The unit the compiler is trying to read is corrupted, or generated with a +% newer version of the compiler. +unit_f_ppu_dbx_count_problem=10017_F_PPU Dbx Zähler-Problem +% There is an inconsistency in the debugging information of the unit. +unit_e_illegal_unit_name=10018_E_Ungültiger Unitname: $1 +% The name of the unit doesn't match the file name. +unit_f_too_much_units=10019_F_Zu viele Units +% \fpc has a limit of 1024 units in a program. You can change this behavior +% by changing the \var{maxunits} constant in the \file{files.pas} file of the +% compiler, and recompiling the compiler. +unit_f_circular_unit_reference=10020_F_Gegenseitige Abhängigkeit von Units zwischen $1 und $2 +% Two units are using each other in the interface part. This is only allowed +% in the \var{implementation} part. At least one unit must contain the other one +% in the \var{implementation} section. +unit_f_cant_compile_unit=10021_F_Kann Unit "$1" nicht übersetzen, keine Quellen vorhanden +% A unit was found that needs to be recompiled, but no sources are +% available. +unit_f_cant_find_ppu=10022_F_Kann Unit "$1", die von "$2" benutzt wird, nicht finden +% You tried to use a unit of which the PPU file isn't found by the +% compiler. Check your configuration file for the unit paths. +unit_w_unit_name_error=10023_W_Unit "$1" wurde nicht gefunden, aber "$2" existiert +% This error message is no longer used. +unit_f_unit_name_error=10024_F_Unit "$1" gesucht, aber "$2" gefunden +% \dos truncation of 8 letters for unit PPU files +% may lead to problems when unit name is longer than 8 letters. +unit_w_switch_us_missed=10025_W_Ãœbersetzen der Systemunit erfordert den Schalter -Us +% When recompiling the system unit (it needs special treatment), the +% \var{-Us} switch must be specified. +unit_f_errors_in_unit=10026_F_Es traten $1 Fehler beim Ãœbersetzen des Moduls auf, halte an +% When the compiler encounters a fatal error or too many errors in a module +% then it stops with this message. +unit_u_load_unit=10027_U_Lade aus $1 ($2) die Unit $3 +% When you use the \var{-vu} flag, which unit is loaded from which unit is +% shown. +unit_u_recompile_crc_change=10028_U_Ãœbersetze $1 erneut, Prüfsumme für $2 hat sich geändert +% The unit is recompiled because the checksum of a unit it depends on has +% changed. +unit_u_recompile_source_found_alone=10029_U_Ãœbersetze "$1", nur Quellcode gefunden +% When you use the \var{-vu} flag, these messages tell you why the current +% unit is recompiled. +unit_u_recompile_staticlib_is_older=10030_U_Ãœbersetze Unit erneut, statische Bibliothek ist älter als PPU-Datei +% When you use the \var{-vu} flag, the compiler warns if the static library +% of the unit is older than the unit file itself. +unit_u_recompile_sharedlib_is_older=10031_U_Ãœbersetze Unit erneut, gemeinsame Bibliothek ist älter als PPU-Datei +% When you use the \var{-vu} flag, the compiler warns if the shared library +% of the unit is older than the unit file itself. +unit_u_recompile_obj_and_asm_older=10032_U_Ãœbersetze Unit erneut, obj und asm sind älter als PPU-Datei +% When you use the \var{-vu} flag, the compiler warns if the assembler of +% object file of the unit is older than the unit file itself. +unit_u_recompile_obj_older_than_asm=10033_U_Ãœbersetze Unit erneut, obj ist älter als asm +% When you use the \var{-vu} flag, the compiler warns if the assembler +% file of the unit is older than the object file of the unit. +unit_u_parsing_interface=10034_U_Analysiere Interface von $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the interface part of the unit. +unit_u_parsing_implementation=10035_U_Analysiere Implementation von $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the implementation part of the unit. +unit_u_second_load_unit=10036_U_Zweites Laden für Unit "$1" +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happen with +% interdependent units. +unit_u_check_time=10037_U_PPU prüfe Datei $1 Zeit $2 +% When you use the \var{-vu} flag, the compiler shows the filename and +% date and time of the file on which a recompile depends. +### The following two error msgs is currently disabled. +#unit_h_cond_not_set_in_last_compile=10038_H_Conditional $1 wurde beim Start beim letzten Ãœbersetzen von $2 nicht gesetzt +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that currently is defined, but was not used the last +#% time the unit was compiled. +#unit_h_cond_set_in_last_compile=10039_H_Conditional $1 wurde beim Start beim letzten Ãœbersetzen von $2 gesetzt +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that was used the last time the unit was compiled, but +#% the conditional is currently not defined. +unit_w_cant_compile_unit_with_changed_incfile=10040_W_Kann Unit $1 nicht erneut übersetzen, aber geänderte Include-Datei gefunden +% A unit was found to have modified include files, but +% some source files were not found, so recompilation is impossible. +unit_u_source_modified=10041_U_Datei $1 ist neuer als die, aus der die PPU Datei $2 erzeugt wird +% A modified source file for a compiler unit was found. +unit_u_ppu_invalid_fpumode=10042_U_Versuch eine Unit zu verwenden, die in einem anderen FPU Mode übersetzt wurde +% Trying to compile code while using units which were not compiled with +% the same floating point format mode. Either all code should be compiled +% with FPU emulation on, or with FPU emulation off. +unit_u_loading_interface_units=10043_U_Interface Units werden von $1 geladen +% When you use the \var{-vu} flag, the compiler warns that it is starting +% to load the units defined in the interface part of the unit. +unit_u_loading_implementation_units=10044_U_Implementation Units werden von $1 geladen +% When you use the \var{-vu} flag, the compiler warns that it is starting +% to load the units defined in the implementation part of the unit. +unit_u_interface_crc_changed=10045_U_Geänderte Interface CRC für Unit $1 +% When you use the \var{-vu} flag, the compiler warns that the +% CRC calculated for the interface has been changed after the implementation +% has been parsed. +unit_u_implementation_crc_changed=10046_U_Geänderte Implementation CRC für Unit $1 +% When you use the \var{-vu} flag, the compiler warns that the +% CRC calculated has been changed after the implementation +% has been parsed. +unit_u_finished_compiling=10047_U_Ãœbersetzen der Unit $1 beendet +% When you use the \var{-vu} flag, the compiler warns that it +% has finished compiling the unit. +unit_u_add_depend_to=10048_U_Abhängigkeit hinzufügen: $1 hängt von $2 ab +% When you use the \var{-vu} flag, the compiler warns that it +% has added a dependency between the two units. +unit_u_no_reload_is_caller=10049_U_Kein erneutes Laden, Unit $1 ist die Aufrufende +% When you use the \var{-vu} flag, the compiler warns that it +% will not reload the unit because it is the unit that wants +% to load this unit. +unit_u_no_reload_in_second_compile=10050_U_Kein erneutes Laden der Unit, bereits beim zweiten Ãœbersetzen: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% will not reload the unit because it is already in a second recompile. +unit_u_flag_for_reload=10051_U_Flag für erneutes Laden: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to reload the unit. +unit_u_forced_reload=10052_U_Erzwungenes erneutes Laden +% When you use the \var{-vu} flag, the compiler warns that it +% is reloading the unit because it was required. +unit_u_previous_state=10053_U_Vorhergehender Status von $1: $2 +% When you use the \var{-vu} flag, the compiler shows the +% previous state of the unit. +unit_u_second_compile_unit=10054_U_$1 wird bereits übersetzt, zweites Ãœbersetzen gesetzt +% When you use the \var{-vu} flag, the compiler warns that it is starting +% to recompile a unit for the second time. This can happen with interdependent +% units. +unit_u_loading_unit=10055_U_Unit $1 wird geladen +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the unit. +unit_u_finished_loading_unit=10056_U_Laden der Unit $1 beendet +% When you use the \var{-vu} flag, the compiler warns that it finished +% loading the unit. +unit_u_registering_new_unit=10057_U_Registrierung der neuen Unit $1 +% When you use the \var{-vu} flag, the compiler warns that it has +% found a new unit and is registering it in the internal lists. +unit_u_reresolving_unit=10058_U_Erneutes resolving der Unit $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to recalculate the internal data of the unit. +unit_u_skipping_reresolving_unit=10059_U_Erneutes Resolving der Unit $1 wird übersprungen, benutzte Units werden noch geladen +% When you use the \var{-vu} flag, the compiler warns that it is +% skipping the recalculation of the internal data of the unit +% because there is no data to recalculate. +unit_u_unload_resunit=10060_U_Entlade die Resource-Unit $1 (wird nicht benötigt) +% When you use the \var{-vu} flag, the compiler warns that it is unloading the +% resource handling unit, since no resources are used. +unit_e_different_wpo_file=10061_E_Unit $1 wurde mit einer anderen Feedback-Eingabe ($2, $3) für die Gesamtprogramm-Optimierung (wpo) übersetzt. Bitte erneut ohne wpo oder mit der gleichen wpo-Feedback-Eingabe-Datei übersetzen +% When a unit has been compiled using a particular whole program optimization (wpo) feedback file (\var{-FW<x>} \var{-OW<x>}), +% this compiled version of the unit is specialised for that particular compilation scenario and cannot be used in +% any other context. It has to be recompiled before you can use it in another program or with another wpo feedback input file. +unit_u_indirect_crc_changed=10062_U_Die CRC des indirekten Interface (Objekte/Klassen) für die unit $1 hat sich geändert +% When you use the \var{-vu} flag, the compiler warns that the +% indirect CRC calculated for the unit (this is the CRC of all classes/objects/interfaces/$\ldots$ +% in the interfaces of units directly or indirectly used by this unit in the interface) has been changed after the +% implementation has been parsed. +% +% \end{description} +# EndOfTeX + +# +# Options +# +# 11048 is the last used one +# +option_usage=11000_O_$1 [Optionen] <Eingabedatei> [Optionen] +# BeginOfTeX +% +% \section{Command line handling errors} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +option_only_one_source_support=11001_W_Es wird nur eine Quelldatei unterstützt. Wechsel für das Kompilieren von Quelldatei "$1" zu Quelldatei "$2" +% You can specify only one source file on the command line. The last +% one will be compiled, others will be ignored. This may indicate that +% you forgot a \var{'-'} sign. +option_def_only_for_os2=11002_W_DEF-Datei kann nur für OS/2 erzeugt werden +% This option can only be specified when you're compiling for OS/2. +option_no_nested_response_file=11003_E_Verschachtelte Response-Dateien werden nicht unterstützt +% You cannot nest response files with the \var{@file} command line option. +option_no_source_found=11004_F_Kein Name für Quelldatei auf der Kommandzeile +% The compiler expects a source file name on the command line. +option_no_option_found=11005_N_Keine Angaben in Konfigurationsdatei "$1" gefunden +% The compiler didn't find any option in that config file. +option_illegal_para=11006_E_Ungültiger Parameter: $1 +% You specified an unknown option. +option_help_pages_para=11007_H_-? zeigt Hilfetext an +% When an unknown option is given, this message is diplayed. +option_too_many_cfg_files=11008_F_Zu viele verschachtelte Konfigurationsdateien +% You can only nest up to 16 config files. +option_unable_open_file=11009_F_Kann Datei nicht öffnen $1 +% The option file cannot be found. +option_reading_further_from=11010_D_Lese weitere Optionen aus $1 +% Displayed when you have notes turned on, and the compiler switches +% to another options file. +option_target_is_already_set=11011_W_Zielsystem ist bereits gesetzt: $1 +% Displayed if more than one \var{-T} option is specified. +option_no_shared_lib_under_dos=11012_W_Gemeinsame Bibliotheken sind auf der DOS Platform nicht verfügbar, verwende stattdessen statische Bibliotheken +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos. +option_too_many_ifdef=11013_F_Zu viele \var{\#IF(N)DEFs} in Zeile $2 der Optionen-Datei $1 +% The \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_many_endif=11014_F_Unerwartetes \var{\#ENDIFs} in Zeile $2 der Optionen-Datei $1 +% The \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_less_endif=11015_F_Offene Bedingung am Ende der Optionen-Datei +% The \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_no_debug_support=11016_W_Erzeugung von Debug-Informationen wird von dieser ausführbaren Datei nicht unterstützt +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_Versuchen Sie mit -dGDB erneut zu übersetzen +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_W_Sie verwenden den nun überholten Schalter $1 +% This warns you when you use a switch that is not needed/supported anymore. +% It is recommended that you remove the switch to overcome problems in the +% future, when the meaning of the switch may change. +option_obsolete_switch_use_new=11019_W_Sie benutzen den nun überholten Schalter $1, bitte benutzen Sie $2 +% This warns you when you use a switch that is not supported anymore. You +% must now use the second switch instead. +% It is recommended that you change the switch to overcome problems in the +% future, when the meaning of the switch may change. +option_switch_bin_to_src_assembler=11020_N_Schalte Assembler auf den Standard-Assembler-Quellcodeschreiber +% This notifies you that the assembler has been changed because you used the +% -a switch, which can't be used with a binary assembler writer. +option_incompatible_asm=11021_W_Das gewählte Assembler-Ausgabeformat "$1" ist nicht mit "$2" kompatibel +option_asm_forced=11022_W_Verwendung des Assemblers "$1" erzwungen +% The assembler output selected cannot generate +% object files with the correct format. Therefore, the +% default assembler for this target is used instead. +option_using_file=11026_T_Optionen werden aus der Datei $1 gelesen +% Options are also read from this file. +option_using_env=11027_T_Optionen werden aus dem environment $1 gelesen +% Options are also read from this environment string. +option_handling_option=11028_D_Handling der Option "$1" +% Debug info that an option is found and will be handled. +option_help_press_enter=11029_O_*** Drücken Sie die ENTER-Taste *** +% Message shown when help is shown page per page. When pressing the ENTER +% Key, the next page of help is shown. If you press q and then ENTER, the +% compiler exits. +option_start_reading_configfile=11030_H_Beginn des Lesens der Konfigurationsdatei $1 +% Start of configuration file parsing. +option_end_reading_configfile=11031_H_Ende des Lesens der Konfigurationsdatei $1 +% End of configuration file parsing. +option_interpreting_option=11032_D_Option "$1" interpretieren +% The compiler is interpreting an option +option_interpreting_firstpass_option=11036_D_firstpass Option "$1" interpretieren +% The compiler is interpreting an option for the first time. +option_interpreting_file_option=11033_D_Datei Option "$1" interpretieren +% The compiler is interpreting an option which it read from the configuration file. +option_read_config_file=11034_D_Konfigurationsdatei "$1" lesen +% The compiler is starting to read the configuration file. +option_found_file=11035_D_Name der Quelldatei "$1" gefunden +% Additional information about options. +% Displayed when you have the debug option turned on. +option_code_page_not_available=11039_E_Unbekannte code page +% An unknown code page for the source files was requested. +% The compiler is compiled with support for several code pages built-in. +% The requested code page is not in that list. You will need to recompile +% the compiler with support for the codepage you need. +option_config_is_dir=11040_F_Konfigurationsdatei $1 ist ein Verzeichnis +% Directories cannot be used as configuration files. +option_confict_asm_debug=11041_W_Die gewählte Assembler-Ausgabe "$1" kann kein Debug-Info erzeugen, Debugging ist ausgeschaltet +% The selected assembler output cannot generate +% debugging information, debugging option is therefore disabled. +option_ppc386_deprecated=11042_W_Die Verwendung von ppc386.cfg wird beendet. Bitte statt dessen fpc.cfg benutzen +% Using ppc386.cfg is still supported for historical reasons, however, for a multiplatform +% system the naming makes no sense anymore. Please continue to use fpc.cfg instead. +option_else_without_if=11043_F_Zur \var{\#ELSE} Direktive in Zeile $2 der Optionen-Datei $1 gibt es kein entsprechendes \var{\#IF(N)DEF} +% An \var{\#ELSE} statement was found in the options file without a matching \var{\#IF(N)DEF} statement. +option_unsupported_target=11044_F_Die Option "$1" wird auf der Zielplattform nicht oder noch nicht unterstützt +% Not all options are supported or implemented for all target platforms. This message informs you that a chosen +% option is incompatible with the currently selected target platform. +option_unsupported_target_for_feature=11045_F_Das Feature "$1" wird für die ausgewählte Zielplattform nicht oder noch nicht unterstützt +% Not all features are supported or implemented for all target platforms. This message informs you that a chosen +% feature is incompatible with the currently selected target platform. +option_dwarf_smart_linking=11046_N_DWARF Debug-Information kann auf dieser Zielplattform nicht zusammen mit Smartlinking benutzt werden, es wird auf statisches Linken umgeschaltet +% Smart linking is currently incompatble with DWARF debug information on most +% platforms, so smart linking is disabled in such cases. +option_ignored_target=11047_W_Option "$1" wird für die ausgewählte Zielplattform ignoriert +% Not all options are supported or implemented for all target platforms. This message informs you that a chosen +% option is ignored for the currently selected target platform. +option_debug_external_unsupported=11048_W_Schalte externe Debuginformation aus, weil es für die gewählte Kombination Ziel/Debugformat nicht unterstützt wird +% Not all debug formats can be stored in an external file on all platforms. In particular, on +% Mac OS X only DWARF debug information can be stored externally. +% +% \end{description} +# EndOfTeX + +# +# Whole program optimization +# +# 12019 is the last used one +# +# BeginOfTeX +% +% \section{Whole program optimization messages} +% This section lists errors that occur when the compiler is performing +% whole program optimization. +% \begin{description} +wpo_cant_find_file=12000_F_Feedback-Datei "$1" für die Gesamtprogramm-Optimierung kann nicht geöffnet werden +% The compiler cannot open the specified feedback file with whole program optimization information. +wpo_begin_processing=12001_D_Bearbeite die Informationen zur Gesamtprogramm-Optimierung aus der wpo-Feedback-Datei "$1" +% The compiler starts processing whole program optimization information found in the named file. +wpo_end_processing=12002_D_Bearbeitung der Informationen zur Gesamtprogramm-Optimierung aus der wpo-Feedback-Datei "$1" beendet +% The compiler has finished processing the whole program optimization information found in the named file. +wpo_expected_section=12003_E_Erwarte einen Sektions-Header, statt dessen "$2" in Zeile $1 der wpo-Feedback-Datei erhalten +% The compiler expected a section header in the whole program optimization file (starting with \%), +% but did not find it. +wpo_no_section_handler=12004_W_Kein Handler für die Sektion "$2" der Gesamtprogramm-Optimierung registriert (Zeile $1 der wpo-Feedback-Datei). Wird ignoriert +% The compiler has no handler to deal with the mentioned whole program optimization information +% section, and will therefore ignore it and skip to the next section. +wpo_found_section=12005_D_Sektion "$1" der Gesamtprogramm-Optimierung mit Informationen über "$2" gefunden +% The compiler encountered a section with whole program optimization information, and according +% to its handler this section contains information usable for the mentioned purpose. +wpo_no_input_specified=12006_F_Die ausgewählte Gesamtprogramm-Optimierung erfordert eine bereits erzeugte Feedback-Datei (bitte mit -Fw angeben) +% The compiler needs information gathered during a previous compilation run to perform the selected +% whole program optimizations. You can specify the location of the feedback file containing this +% information using the -Fw switch. +wpo_not_enough_info=12007_E_Keine Informationen für "$1" Gesamtprogramm-Optimierung gefunden +% While you pointed the compiler to a file containing whole program optimization feedback, it +% did not contain the information necessary to perform the selected optimizations. You most likely +% have to recompile the program using the appropate -OWxxx switch. +wpo_no_output_specified=12008_F_Gebe eine Feedback-Datei an, um die erzeugte Information für die Gesamtprogramm-Optimierung zu speichern (mit der Option -FW) +% You have to specify the feedback file in which the compiler has to store the whole program optimization +% feedback that is generated during the compilation run. This can be done using the -FW switch. +wpo_output_without_info_gen=12009_E_Erzeuge keine Information für die Gesamtprogramm-Optimierung, obwohl eine Feedback-Datei dafür angegeben wurde (mit der Option -FW) +% The compiler was instructed to store whole program optimization feedback into a file specified using -FW, +% but not to actually generated any whole program optimization feedback. The classes of to be +% generated information can be speciied using -OWxxx. +wpo_input_without_info_use=12010_E_Gesamtprogramm-Optimierung wird nicht durchgeführt, obwohl eine Feedback-Datei angegeben wurde (mit der Option -FW) +% The compiler was not instructed to perform any whole program optimizations (no -Owxxx parameters), +% but nevertheless an input file with such feedback was specified (using -Fwyyy). Since this can +% indicate that you forgot to specify an -Owxxx parameter, the compiler generates an error in this case. +wpo_skipping_unnecessary_section=12011_D_Ãœberspringe die Sektion "$1" der Gesamtprogramm-Optimierung, weil sie nicht benötigt wird +% The whole program optimization feedback file contains a section with information that is not +% required by the selected whole program optimizations. +wpo_duplicate_wpotype=12012_W_Ãœberschreibe bereits gelesene Information "$1" aus der Feedback-Eingabe-Datei mit der Information in Sektion "$2" +% The feedback file contains multiple sections that provide the same class of information (e.g., +% information about which virtual methods can be devirtualized). In this case, the information in last encountered +% section is used. Turn on debugging output (-vd) to see which class of information is provided by each section. +wpo_cannot_extract_live_symbol_info_strip=12013_E_Symbol "liveness" Information kann nicht aus dem Programm erhalten werden, wenn Symbole mit "strip" entfernt wurden. Benutze -Xs- +% Certain symbol liveness collectors extract the symbol information from the linked program. If the symbol information +% is stripped (option -Xs), this is not possible. +wpo_cannot_extract_live_symbol_info_no_link=12014_E_Symbol "liveness" Information kann nicht aus dem Programm erhalten werden, wenn es nicht "linked" wird +% Certain symbol liveness collectors extract the symbol information from the linked program. If the program is not +% linked by the compiler, this is not possible. +wpo_cannot_find_symbol_progs=12015_F_"$1" oder "$2" wurden nicht gefunden, um die Symbol "liveness" Information aus dem Programm zu erhalten +% Certain symbol liveness collectors need a helper program to extract the symbol information from the linked program. +% This helper program is normally 'nm', which is part of the GNU binutils. +wpo_error_reading_symbol_file=12016_E_Fehler beim Lesen der "symbol liveness" Information durch "$1" erzeugt +% An error occurred during the reading of the symbol liveness file that was generated using the 'nm' or 'objdump' program. The reason +% can be that it was shorter than expected, or that its format was not understood. +wpo_error_executing_symbol_prog=12017_F_Fehler bei der Ausführung von "$1" (exitcode: $2) um Symbolinformationen aus dem "gelinkten" Programm zu erhalten +% Certain symbol liveness collectors need a helper program to extract the symbol information from the linked program. +% The helper program produced the reported error code when it was run on the linked program. +wpo_symbol_live_info_needs_smart_linking=12018_E_Die Sammlung der "symbol liveness" Information hilft nur bei smart linking, benutze -CX -XX +% Whether or not a symbol is live is determined by looking whether it exists in the final linked program. +% Without smart linking/dead code stripping, all symbols are always included, regardless of whether they are +% actually used or not. So in that case all symbols will be seen as live, which makes this optimization ineffective. +wpo_cant_create_feedback_file=12019_E_Die angegebene Feedback-Eingabe-Datei "$1" für die Gesamtprogramm-Optimierung kann nicht erzeugt werden +% The compiler is unable to create the file specified using the -FW parameter to store the whole program optimisation information. +% +% \end{description} +# EndOfTeX + +# +# Logo (option -l) +# +option_logo=11023_[ +Free Pascal Compiler Version $FPCFULLVERSION [$FPCDATE] für $FPCTARGET +Copyright (c) 1993-2011 Florian Klämpfl und andere +] + +# +# Info (option -i) +# +option_info=11024_[ +Free Pascal Compiler Version $FPCVERSION + +Compiler Datum: $FPCDATE +Compiler Zielsystem: $FPCCPU + +Unterstützte Zielbetriebssysteme: + $OSTARGETS + +Unterstützte CPU Instruktionen: + $INSTRUCTIONSETS + +Unterstützte FPU Instruktionen: + $FPUINSTRUCTIONSETS + +Unterstützte ABI Ziele: + $ABITARGETS + +Unterstützte Optimierungen: + $OPTIMIZATIONS + +Unterstützte Gesamtprogramm-Optimierungen: + All + $WPOPTIMIZATIONS + +Unterstützte Microcontroller: + $CONTROLLERTYPES + +Dieses Programm unterliegt der GNU General Public Licence +Weitere Informationen sind in COPYING.FPC zu finden + +Fehlerberichte, Vorschläge usw. bitte senden an: + http://bugs.freepascal.org +oder + bugs@freepascal.org +] + +# +# Help pages (option -? and -h) +# +# The first character on the line indicates who will display this +# line, the current possibilities are : +# * = every target +# 3 = 80x86 targets +# 4 = x86_64 +# 6 = 680x0 targets +# A = ARM +# e = in extended debug mode only +# P = PowerPC targets +# S = Sparc targets +# V = Virtual machine targets +# The second character also indicates who will display this line, +# (if the above character was TRUE) the current possibilities are : +# * = everyone +# g = with GDB info supported by the compiler +# O = OS/2 +# L = UNIX systems +# The third character represents the indentation level. +# +option_help_pages=11025_[ +**0*_Nach booleschen Optionen geben Sie + zum Ein- bzw. - zum Ausschalten an +**1a_Lösche die erzeugte Assembler-Datei nicht +**2al_Liste Quellcode-Zeilen in der Assembler-Datei +**2an_Liste "node info" in der Assembler-Datei +*L2ap_Benutze Pipes anstelle temporärer Assembler-Dateien +**2ar_Liste Registerbelegungsinformation in Assembler-Datei +**2at_Liste Temp. Variablenbelegungsinfo in Assembler-Datei +**1A<x>_Ausgabe Format: +**2Adefault_Benutze den "default" Assembler +3*2Aas_Assembliere mit Hilfe von GNU AS +3*2Amacho_Mach-O (Darwin, Intel 32 bit) mit Hilfe des internen Schreibers +3*2Anasmcoff_COFF (Go32v2) Datei mit Hilfe von Nasm +3*2Anasmelf_ELF32 (Linux) Datei mit Hilfe von Nasm +3*2Anasmwin32_Win32 Object Datei mit Hilfe von Nasm +3*2Anasmwdosx_Win32/WDOSX Object Datei mit Hilfe von Nasm +3*2Awasm_Obj Datei mit Hilfe von Wasm (Watcom) +3*2Anasmobj_Obj Datei mit Hilfe von Nasm +3*2Amasm_Obj Datei mit Hilfe von Masm (Microsoft) +3*2Atasm_Obj Datei mit Hilfe von Tasm (Borland) +3*2Aelf_ELF32 (Linux) mit Hilfe des internen Schreibers +3*2Acoff_COFF (Go32v2) mit Hilfe des internen Schreibers +3*2Apecoff_PE_COFF (Win32) mit Hilfe des internen Schreibers +4*2Aas_Assembliere mit Hilfe von GNU AS +4*2Agas_Assembliere mit Hilfe von GNU GAS +4*2Agas-darwin_Assembliere darwin Mach-O64 mit Hilfe von GNU GAS +4*2Amasm_Win64 Object Datei mit Hilfe von ml64 (Microsoft) +4*2Apecoff_PE-COFF (Win64) mit Hilfe des internen Writer +4*2Aelf_ELF (Linux-64bit) mit Hilfe des internen Writer +6*2Aas_Unix o-file mit Hilfe von GNU AS +6*2Agas_GNU Motorola Assembler +6*2Amit_MIT Syntax (old GAS) +6*2Amot_Standard Motorola Assembler +A*2Aas_Assembliere mit Hilfe von GNU AS +P*2Aas_Assembliere mit Hilfe von GNU AS +S*2Aas_Assembliere mit Hilfe von GNU AS +**1b_Erzeuge Browser-Info +**2bl_Erzeuge Info zu lokalen Symbolen +**1B_Erzeuge alle Module (Build) +**1C<x>_Optionen für Code-Erzeugung: +**2C3<x>_Schalte ieee-Prüfung von Konstanten ein +**2Ca<x>_Wähle ABI aus; fpc -i gibt die möglichen Werte aus +**2Cb_Erzeuge "big-endian" Code +**2Cc<x>_Setze "default calling convention" zu <x> +**2CD_Erzeuge auch eine dynamische Bibliothek (nicht unterstützt) +**2Ce_Ãœbersetze mit emulierten Fliesskomma opcodes +**2Cf<x>_Wähle den Fliesskomma instruction set aus; fpc -i gibt die möglichen Werte aus +**2CF<x>_Minimale Präzission von Fliesskommakonstanten (default, 32, 64) +**2Cg_Erzeuge PIC code +**2Ch<n>_<n> Bytes Heap (zwischen 1023 und 67107840) +**2Ci_I/O-Prüfung +**2Cn_Lasse die Linkstufe aus +**2Co_Prüfe auf Ãœberlauf von Integer-Operationen +**2CO_Prüfe auf möglichen Ãœberlauf von Integer-Operationen +**2Cp<x>_Wähle instruction set aus; fpc -i gibt die möglichen Werte aus +**2CP<x>=<y>_ Einstellungen für packing +**3CPPACKSET=<y>_ <y> Belegung von Sets: 0, 1 oder DEFAULT oder NORMAL, 2, 4 und 8 +**2Cr_Führe Bereichsprüfung durch +**2CR_Verifiziere die Gültigkiet des Aufrufs der Objektmethoden +**2Cs<n>_Setze die Prüfgrösse des Stacks auf <n> +**2Ct_Führe Stackprüfung durch (nur zum Testen, siehe Handbuch) +**2Cx_Benutze Smartlinking +**1d<x>_Definiere das Symbol <x> +**1D_Erzeuge eine DEF-Datei +**2Dd<x>_Setze Beschreibung zu <x> +**2Dv<x>_Setze DLL Version zu <x> +*O2Dw_Erzeuge PM-Anwendung +**1e<x>_Setze Pfad zur ausführbaren Datei +**1E_Genau wie -Cn +**1fPIC_Genau wie -Cg +**1F<x>_Dateinamen und Pfade: +**2Fa<x>[,y]_Ein Program soll die Units <x> und [y] laden, bevor uses analysiert wird +**2Fc<x>_Setze die Eingabe-Codepage zu <x> +**2FC<x>_Setze den Namen des RC Compiler-Binärprograms auf <x> +**2Fd_Schalte den internen Verzeichnis-Cache des Compilers aus +**2FD<x>_Setze das Verzeichnis für die Compiler-Hilfsprogramme +**2Fe<x>_Leite die Fehlerausgabe um nach <x> +**2Ff<x>_Ergänze <x> zum Framework-Pfad (nur Darwin) +**2FE<x>_Setze den Pfad für Exe/Unit-Dateien auf <x> +**2Fi<x>_Ergänze <x> zum Include-Pfad +**2Fl<x>_Ergänze <x> zum Bibliotheks-Pfad +**2FL<x>_Benutze <x> als dynamischen Linker +**2Fm<x>_Lade die Unicode-Konversionstabelle aus <x>.txt im Compiler-Verzeichnis +**2Fo<x>_Ergänze <x> zum Objektdatei-Pfad +**2Fr<x>_Lade die Fehlermeldungs-Datei <x> +**2FR<x>_Setze den Resource (.res) Linker auf <x> +**2Fu<x>_Ergänze <x> zum Unit-Pfad +**2FU<x>_Units werden nach <x> ausgegeben, hat Vorrang vor -FE +**2FW<x>_Speichere das erzeugte Feedback für die Gesamtprogramm-Optimierung in <x> +**2Fw<x>_Lade das bereits gespeicherte Feedback für die Gesamtprogramm-Optimierung aus <x> +*g1g<x>_Erzeuge Informationen zur Fehlersuche: +*g2gc_Zeigerüberprüfung +*g2gh_Heaptrace-Unit einbinden +*g2gl_Line info Unit einbinden, um mehr backtrace Informationen anzuzeigen +*g2go<x>_Setze Optionen für die Debug Informationen +*g3godwarfsets_Schalte DWARF Debug Informationen für Mengen (sets) ein (verhindert debugging mit gdb < 6.5) +*g3gostabsabsincludes_ Absolute/volle Include-Datei-Pfade in Stabs speichern +*g3godwarfmethodclassprefix_ Stelle Methodennamen in DWARF den Namen der Klasse voran +*g2gp_Erhalte Gross/Kleinschreibung in Stabs-Symbolnamen +*g2gs_Erzeuge Stabs-Debug-Informationen +*g2gt_Lösche lokale Variablen (um eine Verwendung ohne Initialisierung zu finden) +*g2gv_Erzeuge ein mit Valgrind verfolgbares (traceable) Programm +*g2gw_Erzeuge DWARFv2-Debug-Informationen (wie -gw2) +*g2gw2_Erzeuge DWARFv2-Debug-Informationen +*g2gw3_Erzeuge DWARFv3-Debug-Informationen +*g2gw4_Generate DWARFv4-Debug-Informationen (experimentell) +**1i_Zeige alle Informationen über den Compiler +**2iD_Zeige Compilerdatum +**2iV_Zeige Compilerversion +**2iW_Zeige vollständige Compilerversion +**2iSO_Zeige Compilerbetriebssystem +**2iSP_Zeige Compilerprozessor +**2iTO_Zeige Zielbetriebssystem +**2iTP_Zeige Zielprozessor +**1I<x>_Ergänze <x> zum Include-Pfad +**1k<x>_Ãœbergebe <x> an den Linker +**1l_Zeige Logo +**1M<x>_Setze Sprachmodus zu <x> +**2Mfpc_Free Pascal Dialekt (Voreinstellung) +**2Mobjfpc_Schalte einige Delphi 2 Erweiterungen ein +**2Mdelphi_Versuche zu Delphi kompatibel zu sein +**2Mtp_Versuche zu TP/BP 7.0 kompatibel zu sein +**2Mmacpas_Versuche zu den MacIntosh Pascal-Dialekten kompatibel zu sein +**1n_Standard-Konfigurationsdatei ignorieren +**1N<x>_Node tree Optimierung +**2Nu_Unroll loops +**1o<x>_Die erzeugte, ausführbare Datei bekommt den Namen <x> +**1O<x>_Optimierungen: +**2O-_Optimierungen ausschalten +**2O1_Level 1 Optimierung (schnell und Debugger freundlich) +**2O2_Level 2 Optimierung (-O1 + schnelle Optimierungen) +**2O3_Level 3 Optimierung (-O2 + langsame Optimierungen) +**2Oa<x>=<y>_Ausrichtung (alignment) von Mengen +**2Oo[NO]<x>_Optimierungen ein- oder ausschalten; fpc -i gibt die möglichen Werte aus +**2Op<x>_Setze Zielprozessor für die Optimierung; fpc -i gibt die möglichen Werte aus +**2OW<x>_Erzeuge Feedback für die Gesamtprogramm-Optimierung für Optimierung <x>, siehe fpc -i für mögliche Werte +**2Ow<x>_Führe die Gesamtprogramm-Optimierung durch <x>, siehe fpc -i für mögliche Werte +**2Os_Erzeuge kürzeren Code +**1pg_Erzeuge Profiler-Code für gprof +**1R<x>_Assembler Code Format: +**2Rdefault_Benutze den default Assembler +3*2Ratt_Lese Assembler Code im AT&T Format +3*2Rintel_Lese Assembler im Intel Format +6*2RMOT_Lese Assembler im Motorola Format +**1S<x>_Syntax-Optionen: +**2S2_Schalte einige der Delphi 2 Erweiterungen ein (wie -Mobjfpc) +**2Sc_Unterstütze spezielle C Operatoren (*=,+=,/= and -=) +**2Sa_Erlaube assertion code. +**2Sd_Sei Delphi-kompatibel (wie -Mdelphi) +**2Se<x>_Fehler Optionen. <x> ist eine der folgenden Kombinationen: +**3*_<n> : Compiler hält nach <n> Fehlern (Voreinstellung ist 1) +**3*_w : Compiler hält auch nach Warnungen +**3*_n : Compiler hält auch nach Anmerkungen +**3*_h : Compiler hält auch nach Hinweisen +**2Sg_Erlaube LABEL und GOTO +**2Sh_Benutze ANSI-Strings +**2Si_Benutze C++ artige INLINE +**2Sk_Lade fpcylix Unit +**2SI<x>_Setze den Stil des Interface zu <x> +**3SIcom_COM kompatibles Interface (Voreinstellung) +**3SIcorba_CORBA kompatibles Interface +**2Sm_Unterstütze Makros wie in C (global) +**2So_Sei TP/BP 7.0 kompatibel (wie -Mtp) +**2Ss_Konstruktor- und Destruktorname müssen "Init" und "Done" sein +**2Sx_Exception Schlüsselwörter einschalten (Voreinstellung in Delphi/ObjFPC Moden) +**2Sy_@<pointer> gibt einen typisierten Pointer zurück, genau wie $T+ +**1s_Rufe weder Assembler noch Linker auf (nur mit -a) +**2sh_Erzeuge Script um auf dem Host zu linken +**2st_Erzeuge Script um auf dem Zielsystem zu linken +**2sr_Ãœberspringe die Phase der "register allocation" (mit -alr benutzen) +**1T<x>_Zielbetriebssystem:: +3*2Tdarwin_Darwin/Mac OS X +3*2Temx_OS/2 via EMX (einschliesslich EMX/RSX extender) +3*2Tfreebsd_FreeBSD +3*2Tgo32v2_Version 2 des DJ Delorie DOS extender +3*2Tlinux_Linux +3*2Tnetbsd_NetBSD +3*2Tnetware_Novell Netware Module (clib) +3*2Tnetwlibc_Novell Netware Module (libc) +3*2Topenbsd_OpenBSD +3*2Tos2_OS/2 / eComStation +3*2Tsunos_SunOS/Solaris +3*2Tsymbian_Symbian OS +3*2Tsolaris_Solaris +3*2Twatcom_Watcom compatible DOS extender +3*2Twdosx_WDOSX DOS extender +3*2Twin32_Windows 32 Bit +3*2Twince_Windows CE +4*2Tdarwin_Darwin/Mac OS X +4*2Tlinux_Linux +4*2Twin64_Win64 (64 bit Windows systems) +6*2Tamiga_Commodore Amiga +6*2Tatari_Atari ST/STe/TT +6*2Tlinux_Linux +6*2Tpalmos_PalmOS +A*2Tdarwin_Darwin/iPhoneOS/iOS +A*2Tlinux_Linux +A*2Twince_Windows CE +P*2Tamiga_AmigaOS +P*2Tdarwin_Darwin und Mac OS X +P*2Tlinux_Linux +P*2Tmacos_Mac OS (classic) +P*2Tmorphos_MorphOS +S*2Tsolaris_Solaris +S*2Tlinux_Linux +**1u<x>_Entferne die Definition für das Symbol <x> +**1U<x>_Unit-Optionen: +**2Un_Prüfe den Unitnamen nicht +**2Ur_Erzeuge "release unit"-Dateien +**2Us_Erzeuge eine Systemunit +**1v<x>_Meldungen, <x> ist eine Kombination der folgenden Zeichen: +**2*_e : Fehler (Standard) 0 : Nichts (ausser Fehlern) +**2*_w : Warnungen u : Unit Informationen +**2*_n : Anmerkungen t : Angesprochene/benutzte Dateien +**2*_h : Hinweise c : Preprozessordirektiven +**2*_i : Allgemeine Informationen d : Debug Informationen +**2*_l : Zeilennummern r : Rhide/GCC kompatibler Modus +**2*_s : Zeitstempel q : Nummer der Meldung +**2*_a : Alles x : Exe-Datei Informationen (nur Win32) +**2*_b : Schreibe bei Meldungen mit p : Schreibe tree.log mit Analysenbaum (parse tree) +**2*_ Dateinamen den vollständigen v : Schreibe fpcdebug.txt mit +**2*_ Pfad ganz viel Information +**2*_m<x>,<y> : Zeige die Meldungen mit den Nummern <x> und <y> nicht +**1W<x>_Spezifiziere ein natives Programm (Windows) +3*2WA_Spezifiziere ein natives Programm (Windows) +4*2WA_Spezifiziere ein natives Programm (Windows) +A*2WA_Spezifiziere ein natives Programm (Windows) +3*2Wb_Erzeuge statt einer Bibliothek ein Bundle (Darwin) +P*2Wb_Erzeuge statt einer Bibliothek ein Bundle (Darwin) +p*2Wb_Erzeuge statt einer Bibliothek ein Bundle (Darwin) +A*2Wb_Erzeuge statt einer Bibliothek ein Bundle (Darwin) +4*2Wb_Erzeuge statt einer Bibliothek ein Bundle (Darwin) +3*2WB_Erzeuge ein relozierbares Image (Windows, Symbian) +3*2WBxxxx_Setze die Imagebasis auf xxxx (Windows, Symbian) +4*2WB_Erzeuge ein relozierbares Image (Windows) +4*2WBxxxx_Setze die Imagebasis auf xxxx (Windows, Symbian) +A*2WB_Erzeuge ein relozierbares Image (Windows, Symbian) +A*2WBxxxx_Setze die Imagebasis auf xxxx (Windows) +3*2WC_Spezifiziere "console type application" (EMX, OS/2, Windows) +4*2WC_Spezifiziere "console type application" (EMX, OS/2, Windows) +A*2WC_Spezifiziere "console type application" (Windows) +P*2WC_Spezifiziere "console type application" (Classic Mac OS) +3*2WD_Benutze DEFFILE um Funktionen der DLL oder EXE zu exportieren (Windows) +4*2WD_Benutze DEFFILE um Funktionen der DLL oder EXE zu exportieren (Windows) +A*2WD_Benutze DEFFILE um Funktionen der DLL oder EXE zu exportieren (Windows) +3*2We_Benutze externe Resourcen (Darwin) +4*2We_Benutze externe Resourcen (Darwin) +A*2We_Benutze externe Resourcen (Darwin) +P*2We_Benutze externe Resourcen (Darwin) +p*2We_Benutze externe Resourcen (Darwin) +3*2WF_Spezifiziere "full-screen type application" (EMX, OS/2) +3*2WG_Spezifiziere "graphic type application" (EMX, OS/2, Windows) +4*2WG_Spezifiziere "graphic type application" (EMX, OS/2, Windows) +A*2WG_Spezifiziere "graphic type application" (Windows) +P*2WG_Spezifiziere "graphic type application" (Classic Mac OS) +3*2Wi_Benutze interne Resourcen (Darwin) +4*2Wi_Benutze interne Resourcen (Darwin) +A*2Wi_Benutze interne Resourcen (Darwin) +P*2Wi_Benutze interne Resourcen (Darwin) +p*2Wi_Benutze interne Resourcen (Darwin) +3*2WI_Die Verwendung der "import"-Abschnitte ein/ausschalten (Windows) +4*2WI_Die Verwendung der "import"-Abschnitte ein/ausschalten (Windows) +A*2WI_Die Verwendung der "import"-Abschnitte ein/ausschalten (Windows) +3*2WN_Erzeuge keinen "relocation code" (notwendig für debugging) (Windows) +4*2WN_Erzeuge keinen "relocation code" (notwendig für debugging) (Windows) +A*2WN_Erzeuge keinen "relocation code" (notwendig für debugging) (Windows) +A*2Wpxxxx_Spezifiziere den Kontrollertyp, mögliche Werte liefert fpc -i +V*2Wpxxxx_Spezifiziere den Kontrollertyp, mögliche Werte liefert fpc -i +3*2WR_Erzeuge "relocation code" (Windows) +4*2WR_Erzeuge "relocation code" (Windows) +A*2WR_Erzeuge "relocation code" (Windows) +P*2WF_Spezifiziere "MPW tool type application" (Classic Mac OS) +**2WX_Ermögliche den executable stack (Linux) +**1X_Programm-Optionen: +**2Xc_Ãœbergebe --shared an den Linker (nur Unix) +**2Xd_Den Standard Bibliotheks-Suchpfad NICHT nutzen (benötigt für cross compile) +**2Xe_Verwende den externen Linker +**2Xg_Erstelle die Debug-Informationen in einer separaten Datei und einen "Debug-Link"-Abschnitt im ausführbaren Programm +**2XD_Versuche Units dynamisch zu linken (definiert FPC_LINK_DYNAMIC) +**2Xi_Verwende den internen Linker +**2Xm_Erzeuge die "link map" +**2XM<x>_Setze den Namen der 'main' program Routine (default ist 'main') +**2XP<x>_Stelle den Namen der Compiler-Hilfsprogrammen den Prefix <x> voran +**2Xr<x>_Setze den rlink-Pfad des Linker zu <x> (benötigt für cross compile, siehe ld-Manual für mehr Informationen) (BeOS, Linux) +**2XR<x>_Stelle allen Linker-Suchpfaden den Namen <x> voran (BeOS, Darwin, FreeBSD, Linux, Mac OS, Solaris) +**2Xs_Entferne alle Symbole aus der ausführbaren Datei +**2XS_Versuche Units statisch zu linken (default) (definiert FPC_LINK_STATIC) +**2Xt_Linke mit statischen Bibliotheken (-static wird an den Linker übergeben) +**2XX_Versuche Units smart zu linken (definiert FPC_LINK_SMART) +**1*_ +**1?_Zeigt diese Hilfe an +**1h_Zeigt diese Hilfe ohne Warten an +] + +# +# The End... +# diff --git a/closures/compiler/msg/errore.msg b/closures/compiler/msg/errore.msg new file mode 100644 index 0000000000..0611192936 --- /dev/null +++ b/closures/compiler/msg/errore.msg @@ -0,0 +1,3445 @@ +# +# This file is part of the Free Pascal Compiler +# Copyright (c) 1999-2009 by the Free Pascal Development team +# +# English (default) Language File for Free Pascal +# +# 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. +# +# +# The constants are build in the following order: +# <part>_<type>_<txtidentifier> +# +# <part> is the part of the compiler the message is used +# asmr_ assembler parsing +# asmw_ assembler writing/binary writers +# unit_ unit handling +# scan_ scanner +# parser_ parser +# type_ type checking +# general_ general info +# exec_ calls to assembler, external linker, binder +# link_ internal linker +# +# <type> the type of the message it should normally used for +# f_ fatal error +# e_ error +# w_ warning +# n_ note +# h_ hint +# i_ info +# l_ add linenumber +# u_ used +# t_ tried +# c_ conditional +# d_ debug message +# x_ executable informations +# o_ normal (e.g., "press enter to continue") +# +# <type> can contain a minus sign at the beginning to mark that +# the message is off by default. Look at type_w_explicit_string_cast +# for example. + +# +# General +# +# 01023 is the last used one +# +# BeginOfTeX +% \section{General compiler messages} +% This section gives the compiler messages which are not fatal, but which +% display useful information. The number of such messages can be +% controlled with the various verbosity level \var{-v} switches. +% \begin{description} +general_t_compilername=01000_T_Compiler: $1 +% When the \var{-vt} switch is used, this line tells you what compiler +% is used. +general_d_sourceos=01001_D_Compiler OS: $1 +% When the \var{-vd} switch is used, this line tells you what the source +% operating system is. +general_i_targetos=01002_I_Target OS: $1 +% When the \var{-vd} switch is used, this line tells you what the target +% operating system is. +general_t_exepath=01003_T_Using executable path: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its binaries. +general_t_unitpath=01004_T_Using unit path: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for compiled units. You can set this path with the \var{-Fu} option. +general_t_includepath=01005_T_Using include path: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its include files (files used in \var{\{\$I xxx\}} statements). +% You can set this path with the \var{-Fi} option. +general_t_librarypath=01006_T_Using library path: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for the libraries. You can set this path with the \var{-Fl} option. +general_t_objectpath=01007_T_Using object path: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for object files you link in (files used in \var{\{\$L xxx\}} statements). +% You can set this path with the \var{-Fo} option. +general_i_abslines_compiled=01008_I_$1 lines compiled, $2 sec$3 +% When the \var{-vi} switch is used, the compiler reports the number +% of lines compiled, and the time it took to compile them (real time, +% not program time). +general_f_no_memory_left=01009_F_No memory left +% The compiler doesn't have enough memory to compile your program. There are +% several remedies for this: +% \begin{itemize} +% \item If you're using the build option of the compiler, try compiling the +% different units manually. +% \item If you're compiling a huge program, split it up into units, and compile +% these separately. +% \item If the previous two don't work, recompile the compiler with a bigger +% heap. (You can use the \var{-Ch} option for this, \seeo{Ch}.) +% \end{itemize} +general_i_writingresourcefile=01010_I_Writing Resource String Table file: $1 +% This message is shown when the compiler writes the Resource String Table +% file containing all the resource strings for a program. +general_e_errorwritingresourcefile=01011_E_Writing Resource String Table file: $1 +% This message is shown when the compiler encounters an error when writing +% the Resource String Table file. +general_i_fatal=01012_I_Fatal: +% Prefix for Fatal Errors. +general_i_error=01013_I_Error: +% Prefix for Errors. +general_i_warning=01014_I_Warning: +% Prefix for Warnings. +general_i_note=01015_I_Note: +% Prefix for Notes. +general_i_hint=01016_I_Hint: +% Prefix for Hints. +general_e_path_does_not_exist=01017_E_Path "$1" does not exist +% The specified path does not exist. +general_f_compilation_aborted=01018_F_Compilation aborted +% Compilation was aborted. +general_text_bytes_code=01019_bytes code +% The size of the generated executable code, in bytes. +general_text_bytes_data=01020_bytes data +% The size of the generated program data, in bytes. +general_i_number_of_warnings=01021_I_$1 warning(s) issued +% Total number of warnings issued during compilation. +general_i_number_of_hints=01022_I_$1 hint(s) issued +% Total number of hints issued during compilation. +general_i_number_of_notes=01023_I_$1 note(s) issued +% Total number of notes issued during compilation. +general_f_ioerror=01024_F_I/O error: $1 +% During compilation an I/O error happened which allows no further compilation. +general_f_oserror=01025_F_Operating system error: $1 +% During compilation an operanting system error happened which allows no further compilation. +% \end{description} +# +# Scanner +# +# 02087 is the last used one +# +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compilation handling. +% \begin{description} +scan_f_end_of_file=02000_F_Unexpected end of file +% This typically happens in one of the following cases: +% \begin{itemize} +% \item The source file ends before the final \var{end.} statement. This +% happens mostly when the \var{begin} and \var{end} statements aren't +% balanced; +% \item An include file ends in the middle of a statement. +% \item A comment was not closed. +% \end{itemize} +scan_f_string_exceeds_line=02001_F_String exceeds line +% There is a missing closing ' in a string, so it occupies +% multiple lines. +scan_f_illegal_char=02002_F_illegal character "$1" ($2) +% An illegal character was encountered in the input file. +scan_f_syn_expected=02003_F_Syntax error, "$1" expected but "$2" found +% This indicates that the compiler expected a different token than +% the one you typed. It can occur almost anywhere it is possible to make an error +% against the Pascal language. +scan_t_start_include_file=02004_TL_Start reading includefile $1 +% When you provide the \var{-vt} switch, the compiler tells you +% when it starts reading an included file. +scan_w_comment_level=02005_W_Comment level $1 found +% When the \var{-vw} switch is used, then the compiler warns you if +% it finds nested comments. Nested comments are not allowed in Turbo Pascal +% and Delphi, and can be a possible source of errors. +scan_n_ignored_switch=02008_N_Ignored compiler switch "$1" +% With \var{-vn} on, the compiler warns if it ignores a switch. +scan_w_illegal_switch=02009_W_Illegal compiler switch "$1" +% You included a compiler switch (i.e. \var{\{\$... \}}) which the compiler +% does not recognise. +scan_w_switch_is_global=02010_W_Misplaced global compiler switch +% The compiler switch is misplaced, and should be located at +% the start of the unit or program. +scan_e_illegal_char_const=02011_E_Illegal char constant +% This happens when you specify a character with its ASCII code, as in +% \var{\#96}, but the number is either illegal, or out of range. +scan_f_cannot_open_input=02012_F_Can't open file "$1" +% \fpc cannot find the program or unit source file you specified on the +% command line. +scan_f_cannot_open_includefile=02013_F_Can't open include file "$1" +% \fpc cannot find the source file you specified in a \var{\{\$include ..\}} +% statement. +scan_e_illegal_pack_records=02015_E_Illegal record alignment specifier "$1" +% You are specifying \var{\{\$PACKRECORDS n\} } or \var{\{\$ALIGN n\} } +% with an illegal value for \var{n}. For \$PACKRECORDS valid alignments are 1, 2, 4, 8, 16, 32, C, +% NORMAL, DEFAULT, and for \$ALIGN valid alignments are 1, 2, 4, 8, 16, 32, ON, +% OFF. Under mode MacPas \$ALIGN also supports MAC68K, POWER and RESET. +scan_e_illegal_pack_enum=02016_E_Illegal enum minimum-size specifier "$1" +% You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for +% \var{n}. Only 1,2,4, NORMAL or DEFAULT is valid here. +scan_e_endif_expected=02017_E_$ENDIF expected for $1 $2 defined in $3 line $4 +% Your conditional compilation statements are unbalanced. +scan_e_preproc_syntax_error=02018_E_Syntax error while parsing a conditional compiling expression +% There is an error in the expression following the \var{\{\$if ..\}}, \var{\{\$ifc \}} +% or \var{\{\$setc \}} compiler directives. +scan_e_error_in_preproc_expr=02019_E_Evaluating a conditional compiling expression +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc compiler +% directives. +scan_w_macro_cut_after_255_chars=02020_W_Macro contents are limited to 255 characters in length +% The contents of macros cannot be longer than 255 characters. +scan_e_endif_without_if=02021_E_ENDIF without IF(N)DEF +% Your \var{\{\$IFDEF ..\}} and {\{\$ENDIF\}} statements aren't balanced. +scan_f_user_defined=02022_F_User defined: $1 +% A user defined fatal error occurred. See also the \progref. +scan_e_user_defined=02023_E_User defined: $1 +% A user defined error occurred. See also the \progref. +scan_w_user_defined=02024_W_User defined: $1 +% A user defined warning occurred. See also the \progref. +scan_n_user_defined=02025_N_User defined: $1 +% A user defined note was encountered. See also the \progref. +scan_h_user_defined=02026_H_User defined: $1 +% A user defined hint was encountered. See also the \progref. +scan_i_user_defined=02027_I_User defined: $1 +% User defined information was encountered. See also the \progref. +scan_e_keyword_cant_be_a_macro=02028_E_Keyword redefined as macro has no effect +% You cannot redefine keywords with macros. +scan_f_macro_buffer_overflow=02029_F_Macro buffer overflow while reading or expanding a macro +% Your macro or its result was too long for the compiler. +scan_w_macro_too_deep=02030_W_Expanding of macros exceeds a depth of 16. +% When expanding a macro, macros have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_w_wrong_styled_switch=02031_W_compiler switches aren't supported in // styled comments +% Compiler switches should be in normal Pascal style comments. +scan_d_handling_switch=02032_DL_Handling switch "$1" +% When you set debugging info on (\var{-vd}) the compiler tells you when it +% is evaluating conditional compile statements. +scan_c_endif_found=02033_CL_ENDIF $1 found +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifdef_found=02034_CL_IFDEF $1 found, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifopt_found=02035_CL_IFOPT $1 found, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_if_found=02036_CL_IF $1 found, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifndef_found=02037_CL_IFNDEF $1 found, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_else_found=02038_CL_ELSE $1 found, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_skipping_until=02039_CL_Skipping until... +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements, and whether it is skipping or +% compiling parts. +scan_i_press_enter=02040_I_Press <return> to continue +% When the \var{-vi} switch is used, the compiler stops compilation +% and waits for the \var{Enter} key to be pressed when it encounters +% a \var{\{\$STOP\}} directive. +scan_w_unsupported_switch=02041_W_Unsupported switch "$1" +% When warnings are turned on (\var{-vw}), the compiler warns you about +% unsupported switches. This means that the switch is used in Delphi or +% Turbo Pascal, but not in \fpc. +scan_w_illegal_directive=02042_W_Illegal compiler directive "$1" +% When warnings are turned on (\var{-vw}), the compiler warns you about +% unrecognised switches. For a list of recognised switches, see the \progref. +scan_t_back_in=02043_TL_Back in $1 +% When you use the \var{-vt} switch, the compiler tells you when it has finished +% reading an include file. +scan_w_unsupported_app_type=02044_W_Unsupported application type: "$1" +% You get this warning if you specify an unknown application type +% with the directive \var{\{\$APPTYPE\}}. +scan_w_app_type_not_support=02045_W_APPTYPE is not supported by the target OS +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_w_description_not_support=02046_W_DESCRIPTION is not supported by the target OS +% The \var{\{\$DESCRIPTION\}} directive is not supported on this target OS. +scan_n_version_not_support=02047_N_VERSION is not supported by target OS +% The \var{\{\$VERSION\}} directive is not supported on this target OS. +scan_n_only_exe_version=02048_N_VERSION only for exes or DLLs +% The \var{\{\$VERSION\}} directive is only used for executable or DLL sources. +scan_w_wrong_version_ignored=02049_W_Wrong format for VERSION directive "$1" +% The \var{\{\$VERSION\}} directive format is majorversion.minorversion +% where majorversion and minorversion are words. +scan_e_illegal_asmmode_specifier=02050_E_Illegal assembler style specified "$1" +% When you specify an assembler mode with the \var{\{\$ASMMODE xxx\}} directive, +% the compiler didn't recognize the mode you specified. +scan_w_no_asm_reader_switch_inside_asm=02051_W_ASM reader switch is not possible inside asm statement, "$1" will be effective only for next +% It is not possible to switch from one assembler reader to another +% inside an assembler block. The new reader will be used for next +% assembler statements only. +scan_e_wrong_switch_toggle=02052_E_Wrong switch toggle, use ON/OFF or +/- +% You need to use ON or OFF or a + or - to toggle the switch. +scan_e_resourcefiles_not_supported=02053_E_Resource files are not supported for this target +% The target you are compiling for doesn't support resource files. +scan_w_include_env_not_found=02054_W_Include environment "$1" not found in environment +% The included environment variable can't be found in the environment; it will +% be replaced by an empty string instead. +scan_e_invalid_maxfpureg_value=02055_E_Illegal value for FPU register limit +% Valid values for this directive are 0..8 and NORMAL/DEFAULT. +scan_w_only_one_resourcefile_supported=02056_W_Only one resource file is supported for this target +% The target you are compiling for supports only one resource file. +% The first resource file found is used, the others are discarded. +scan_w_macro_support_turned_off=02057_W_Macro support has been turned off +% A macro declaration has been found, but macro support is currently off, +% so the declaration will be ignored. To turn macro support on compile with +% -Sm on the command line or add \{\$MACRO ON\} in the source. +scan_e_invalid_interface_type=02058_E_Illegal interface type specified. Valids are COM, CORBA or DEFAULT. +% The interface type that was specified is not supported. +scan_w_appid_not_support=02059_W_APPID is only supported for PalmOS +% The \var{\{\$APPID\}} directive is only supported for the PalmOS target. +scan_w_appname_not_support=02060_W_APPNAME is only supported for PalmOS +% The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target. +scan_e_string_exceeds_255_chars=02061_E_Constant strings can't be longer than 255 chars +% A single string constant can contain at most 255 chars. Try splitting up the +% string into multiple smaller parts and concatenate them with a + operator. +scan_f_include_deep_ten=02062_F_Including include files exceeds a depth of 16. +% When including include files the files have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_e_too_many_push=02063_F_Too many levels of PUSH +% A maximum of 20 levels is allowed. This error occurs only in mode MacPas. +scan_e_too_many_pop=02064_E_A POP without a preceding PUSH +% This error occurs only in mode MacPas. +scan_e_error_macro_lacks_value=02065_E_Macro or compile time variable "$1" does not have any value +% Thus the conditional compile time expression cannot be evaluated. +scan_e_wrong_switch_toggle_default=02066_E_Wrong switch toggle, use ON/OFF/DEFAULT or +/-/* +% You need to use ON or OFF or DEFAULT or a + or - or * to toggle the switch. +scan_e_mode_switch_not_allowed=02067_E_Mode switch "$1" not allowed here +% A mode switch has already been encountered, or, in the case of option -Mmacpas, +% a mode switch occurs after UNIT. +scan_e_error_macro_undefined=02068_E_Compile time variable or macro "$1" is not defined. +% Thus the conditional compile time expression cannot be evaluated. Only in mode MacPas. +scan_e_utf8_bigger_than_65535=02069_E_UTF-8 code greater than 65535 found +% \fpc handles UTF-8 strings internally as widestrings, i.e. the char codes are limited to 65535. +scan_e_utf8_malformed=02070_E_Malformed UTF-8 string +% The given string isn't a valid UTF-8 string. +scan_c_switching_to_utf8=02071_C_UTF-8 signature found, using UTF-8 encoding +% The compiler found a UTF-8 encoding signature (\$ef, \$bb, \$bf) at the beginning of a file, +% so it interprets it as a UTF-8 file. +scan_e_compile_time_typeerror=02072_E_Compile time expression: Wanted $1 but got $2 at $3 +% The type-check of a compile time expression failed. +scan_n_app_type_not_support=02073_N_APPTYPE is not supported by the target OS +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_e_illegal_optimization_specifier=02074_E_Illegal optimization specified "$1" +% You specified an optimization with the \var{\{\$OPTIMIZATION xxx\}} directive, +% and the compiler didn't recognize the optimization you specified. +scan_w_setpeflags_not_support=02075_W_SETPEFLAGS is not supported by the target OS +% The \var{\{\$SETPEFLAGS\}} directive is not supported by the target OS. +scan_w_imagebase_not_support=02076_W_IMAGEBASE is not supported by the target OS +% The \var{\{\$IMAGEBASE\}} directive is not supported by the target OS. +scan_w_minstacksize_not_support=02077_W_MINSTACKSIZE is not supported by the target OS +% The \var{\{\$MINSTACKSIZE\}} directive is not supported by the target OS. +scan_w_maxstacksize_not_support=02078_W_MAXSTACKSIZE is not supported by the target OS +% The \var{\{\$MAXSTACKSIZE\}} directive is not supported by the target OS. +scanner_e_illegal_warn_state=02079_E_Illegal state "$1" for $WARN directive +% Only ON and OFF can be used as state with a \var{\{\$WARN\}} compiler directive. +scan_e_only_packset=02080_E_Illegal set packing value +% Only 0, 1, 2, 4, 8, DEFAULT and NORMAL are allowed as packset parameters. +scan_w_pic_ignored=02081_W_PIC directive or switch ignored +% Several targets, such as \windows, do not support nor need PIC, +% so the PIC directive and switch are ignored. +scan_w_unsupported_switch_by_target=02082_W_The switch "$1" is not supported by the currently selected target +% Some compiler switches like \$E are not supported by all targets. +scan_w_frameworks_darwin_only=02084_W_Framework-related options are only supported for Darwin/Mac OS X +% Frameworks are not a known concept, or at least not supported by FPC, +% on operating systems other than Darwin/Mac OS X. +scan_e_illegal_minfpconstprec=02085_E_Illegal minimal floating point constant precision "$1" +% Valid minimal precisions for floating point constants are default, 32 and 64, +% which mean respectively minimal (usually 32 bit), 32 bit and 64 bit precision. +scan_w_multiple_main_name_overrides=02086_W_Overriding name of "main" procedure multiple times, was previously set to "$1" +% The name for the main entry procedure is specified more than once. Only the last +% name will be used. +scanner_w_illegal_warn_identifier=02087_W_Illegal identifier "$1" for $WARN directive +% Identifier is not known by a \var{\{\$WARN\}} compiler directive. +scanner_e_illegal_alignment_directive=02088_E_Illegal alignment directive +% The alignment directive is not valid. Either the alignment type is not known or the alignment +% value is not a power of two. +% \end{description} +# +# Parser +# +# 03314 is the last used one +# +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your Pascal constructs +% are correct. +% \begin{description} +parser_e_syntax_error=03000_E_Parser - Syntax Error +% An error against the Turbo Pascal language was encountered. This typically +% happens when an illegal character is found in the source file. +parser_e_dont_nest_interrupt=03004_E_INTERRUPT procedure can't be nested +% An \var{INTERRUPT} procedure must be global. +parser_w_proc_directive_ignored=03005_W_Procedure type "$1" ignored +% The specified procedure directive is ignored by FPC programs. +parser_e_no_overload_for_all_procs=03006_E_Not all declarations of "$1" are declared with OVERLOAD +% When you want to use overloading using the \var{OVERLOAD} directive, then +% all declarations need to have \var{OVERLOAD} specified. +parser_e_export_name_double=03008_E_Duplicate exported function name "$1" +% Exported function names inside a specific DLL must all be different. +parser_e_export_ordinal_double=03009_E_Duplicate exported function index $1 +% Exported function indexes inside a specific DLL must all be different. +parser_e_export_invalid_index=03010_E_Invalid index for exported function +% DLL function index must be in the range \var{1..\$FFFF}. +parser_w_parser_reloc_no_debug=03011_W_Relocatable DLL or executable $1 debug info does not work, disabled. +% It is currently not possible to include debug information in a relocatable DLL. +parser_w_parser_win32_debug_needs_WN=03012_W_To allow debugging for win32 code you need to disable relocation with -WN option +% Stabs debug info is wrong for relocatable DLL or EXES. Use -WN +% if you want to debug win32 executables. +parser_e_constructorname_must_be_init=03013_E_Constructor name must be INIT +% You are declaring an object constructor with a name which is not \var{init}, and the +% \var{-Ss} switch is in effect. See the switch \seeo{Ss}. +parser_e_destructorname_must_be_done=03014_E_Destructor name must be DONE +% You are declaring an object destructor with a name which is not \var{done}, and the +% \var{-Ss} switch is in effect. See the switch \seeo{Ss}. +parser_e_proc_inline_not_supported=03016_E_Procedure type INLINE not supported +% You tried to compile a program with C++ style inlining, and forgot to +% specify the \var{-Si} option (\seeo{Si}). The compiler doesn't support C++ +% styled inlining by default. +parser_w_constructor_should_be_public=03018_W_Constructor should be public +% Constructors must be in the 'public' part of an object (class) declaration. +parser_w_destructor_should_be_public=03019_W_Destructor should be public +% Destructors must be in the 'public' part of an object (class) declaration. +parser_n_only_one_destructor=03020_N_Class should have one destructor only +% You can declare only one destructor for a class. +parser_e_no_local_objects=03021_E_Local class definitions are not allowed +% Classes must be defined globally. They cannot be defined inside a +% procedure or function. +parser_f_no_anonym_objects=03022_F_Anonymous class definitions are not allowed +% An invalid object (class) declaration was encountered, i.e. an +% object or class without methods that isn't derived from another object or +% class. For example: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% will trigger this error. +parser_n_object_has_no_vmt=03023_N_The object "$1" has no VMT +% This is a note indicating that the declared object has no +% virtual method table. +parser_e_illegal_parameter_list=03024_E_Illegal parameter list +% You are calling a function with parameters that are of a different type than +% the declared parameters of the function. +parser_e_wrong_parameter_size=03026_E_Wrong number of parameters specified for call to "$1" +% There is an error in the parameter list of the function or procedure -- +% the number of parameters is not correct. +parser_e_overloaded_no_procedure=03027_E_overloaded identifier "$1" isn't a function +% The compiler encountered a symbol with the same name as an overloaded +% function, but it is not a function it can overload. +parser_e_overloaded_have_same_parameters=03028_E_overloaded functions have the same parameter list +% You're declaring overloaded functions, but with the same parameter list. +% Overloaded function must have at least 1 different parameter in their +% declaration. +parser_e_header_dont_match_forward=03029_E_function header doesn't match the previous declaration "$1" +% You declared a function with the same parameters but +% different result type or function modifiers. +parser_e_header_different_var_names=03030_E_function header "$1" doesn't match forward : var name changes $2 => $3 +% You declared the function in the \var{interface} part, or with the +% \var{forward} directive, but defined it with a different parameter list. +parser_n_duplicate_enum=03031_N_Values in enumeration types have to be ascending +% \fpc allows enumeration constructions as in C. Examine the following +% two declarations: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% The second declaration would produce an error. \var{A\_UAS} needs to have a +% value higher than \var{A\_E}, i.e. at least 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_With cannot be used for variables in a different segment +% With stores a variable locally on the stack, +% but this is not possible if the variable belongs to another segment. +parser_e_too_much_lexlevel=03034_E_function nesting > 31 +% You can nest function definitions only 31 levels deep. +parser_e_range_check_error=03035_E_range check error while evaluating constants +% The constants are out of their allowed range. +parser_w_range_check_error=03036_W_range check error while evaluating constants +% The constants are out of their allowed range. +parser_e_double_caselabel=03037_E_duplicate case label +% You are specifying the same label 2 times in a \var{case} statement. +parser_e_case_lower_less_than_upper_bound=03038_E_Upper bound of case range is less than lower bound +% The upper bound of a \var{case} label is less than the lower bound and this +% is useless. +parser_e_type_const_not_possible=03039_E_typed constants of classes or interfaces are not allowed +% You cannot declare a constant of type class or object. +parser_e_no_overloaded_procvars=03040_E_functions variables of overloaded functions are not allowed +% You are trying to assign an overloaded function to a procedural variable. +% This is not allowed. +parser_e_invalid_string_size=03041_E_string length must be a value from 1 to 255 +% The length of a shortstring in Pascal is limited to 255 characters. You are +% trying to declare a string with length less than 1 or greater than 255. +parser_w_use_extended_syntax_for_objects=03042_W_use extended syntax of NEW and DISPOSE for instances of objects +% If you have a pointer \var{a} to an object type, then the statement +% \var{new(a)} will not initialize the object (i.e. the constructor isn't +% called), although space will be allocated. You should issue the +% \var{new(a,init)} statement. This will allocate space, and call the +% constructor of the object. +parser_w_no_new_dispose_on_void_pointers=03043_W_use of NEW or DISPOSE for untyped pointers is meaningless +parser_e_no_new_dispose_on_void_pointers=03044_E_use of NEW or DISPOSE is not possible for untyped pointers +% You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer +% because no size is associated to an untyped pointer. +% It is accepted for compatibility in \var{TP} and \var{DELPHI} modes, but the +% compiler will still warn you if it finds such a construct. +parser_e_class_id_expected=03045_E_class identifier expected +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., an object or class method, but the type in front of the dot is not +% a known type. +parser_e_no_type_not_allowed_here=03046_E_type identifier not allowed here +% You cannot use a type inside an expression. +parser_e_methode_id_expected=03047_E_method identifier expected +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., an object or class method, but the procedure name is not a +% procedure of this type. +parser_e_header_dont_match_any_member=03048_E_function header doesn't match any method of this class "$1" +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., an object or class method, but the procedure name is not a +% procedure of this type. +parser_d_procedure_start=03049_DL_procedure/function $1 +% When using the \var{-vd} switch, the compiler tells you when it starts +% processing a procedure or function implementation. +parser_e_error_in_real=03050_E_Illegal floating point constant +% The compiler expects a floating point expression, and gets something else. +parser_e_fail_only_in_constructor=03051_E_FAIL can be used in constructors only +% You are using the \var{fail} keyword outside a constructor method. +parser_e_no_paras_for_destructor=03052_E_Destructors can't have parameters +% You are declaring a destructor with a parameter list. Destructor methods +% cannot have parameters. +parser_e_only_class_members_via_class_ref=03053_E_Only class methods, class properties and class variables can be referred with class references +% This error occurs in a situation like the following: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} is not a class method and hence cannot be called with a class +% reference. +parser_e_only_class_members=03054_E_Only class methods, class properties and class variables can be accessed in class methods +% This is related to the previous error. You cannot call a method of an object +% from inside a class method. The following code would produce this error: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% Because free is a normal method of a class it cannot be called from a class +% method. +parser_e_case_mismatch=03055_E_Constant and CASE types do not match +% One of the labels is not of the same type as the case variable. +parser_e_illegal_symbol_exported=03056_E_The symbol can't be exported from a library +% You can only export procedures and functions when you write a library. You +% cannot export variables or constants. +parser_w_should_use_override=03057_W_An inherited method is hidden by "$1" +% A method that is declared \var{virtual} in a parent class, should be +% overridden in the descendant class with the \var{override} directive. If you +% don't specify the \var{override} directive, you will hide the parent method; +% you will not override it. +parser_e_nothing_to_be_overridden=03058_E_There is no method in an ancestor class to be overridden: "$1" +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_no_procedure_to_access_property=03059_E_No member is provided to access property +% You specified no \var{read} directive for a property. +parser_w_stored_not_implemented=03060_W_Stored property directive is not yet implemented +% This message is no longer used, as the \var{stored} directive has been implemented. +parser_e_ill_property_access_sym=03061_E_Illegal symbol for property access +% There is an error in the \var{read} or \var{write} directives for an array +% property. When you declare an array property, you can only access it with +% procedures and functions. The following code would cause such an error. +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_Cannot access a protected field of an object here +% Fields that are declared in a \var{protected} section of an object or class +% declaration cannot be accessed outside the module where the object is +% defined, or outside descendent object methods. +parser_e_cant_access_private_member=03063_E_Cannot access a private field of an object here +% Fields that are declared in a \var{private} section of an object or class +% declaration cannot be accessed outside the module where the class is +% defined. +parser_e_overridden_methods_not_same_ret=03066_E_Overridden methods must have the same return type: "$2" is overridden by "$1" which has another return type +% If you declare overridden methods in a class definition, they must +% have the same return type. +parser_e_dont_nest_export=03067_E_EXPORT declared functions can't be nested +% You cannot declare a function or procedure within a function or procedure +% that was declared as an export procedure. +parser_e_methods_dont_be_export=03068_E_Methods can't be EXPORTed +% You cannot declare a procedure that is a method for an object as +% \var{export}ed. +parser_e_call_by_ref_without_typeconv=03069_E_Call by var for arg no. $1 has to match exactly: Got "$2" expected "$3" +% When calling a function declared with \var{var} parameters, the variables in +% the function call must be of exactly the same type. There is no automatic +% type conversion. +parser_e_no_super_class=03070_E_Class isn't a parent class of the current class +% When calling inherited methods, you are trying to call a method of a non-related +% class. You can only call an inherited method of a parent class. +parser_e_self_not_in_method=03071_E_SELF is only allowed in methods +% You are trying to use the \var{self} parameter outside an object's method. +% Only methods get passed the \var{self} parameters. +parser_e_generic_methods_only_in_methods=03072_E_Methods can be only in other methods called direct with type identifier of the class +% A construction like \var{sometype.somemethod} is only allowed in a method. +parser_e_illegal_colon_qualifier=03073_E_Illegal use of ':' +% You are using the format \var{:} (colon) 2 times on an expression that +% is not a real expression. +parser_e_illegal_set_expr=03074_E_range check error in set constructor or duplicate set element +% The declaration of a set contains an error. Either one of the elements is +% outside the range of the set type, or two of the elements are in fact +% the same. +parser_e_pointer_to_class_expected=03075_E_Pointer to object expected +% You specified an illegal type in a \var{new} statement. +% The extended syntax of \var{new} needs an object as a parameter. +parser_e_expr_have_to_be_constructor_call=03076_E_Expression must be constructor call +% When using the extended syntax of \var{new}, you must specify the constructor +% method of the object you are trying to create. The procedure you specified +% is not a constructor. +parser_e_expr_have_to_be_destructor_call=03077_E_Expression must be destructor call +% When using the extended syntax of \var{dispose}, you must specify the +% destructor method of the object you are trying to dispose of. +% The procedure you specified is not a destructor. +parser_e_invalid_record_const=03078_E_Illegal order of record elements +% When declaring a constant record, you specified the fields in the wrong +% order. +parser_e_false_with_expr=03079_E_Expression type must be class or record type +% A \var{with} statement needs an argument that is of the type \var{record} +% or \var{class}. You are using \var{with} on an expression that is not of +% this type. +parser_e_void_function=03080_E_Procedures can't return a value +% In \fpc, you can specify a return value for a function when using +% the \var{exit} statement. This error occurs when you try to do this with a +% procedure. Procedures cannot return a value. +parser_e_only_methods_allowed=03081_E_constructors, destructors and class operators must be methods +% You're declaring a procedure as destructor, constructor or class operator, when the +% procedure isn't a class method. +parser_e_operator_not_overloaded=03082_E_Operator is not overloaded +% You're trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_no_such_assignment=03083_E_Impossible to overload assignment for equal types +% You cannot overload assignment for types +% that the compiler considers as equal. +parser_e_overload_impossible=03084_E_Impossible operator overload +% The combination of operator, arguments and return type are +% incompatible. +parser_e_no_reraise_possible=03085_E_Re-raise isn't possible there +% You are trying to re-raise an exception where it is not allowed. You can only +% re-raise exceptions in an \var{except} block. +parser_e_no_new_or_dispose_for_classes=03086_E_The extended syntax of new or dispose isn't allowed for a class +% You cannot generate an instance of a class with the extended syntax of +% \var{new}. The constructor must be used for that. For the same reason, you +% cannot call \var{dispose} to de-allocate an instance of a class, the +% destructor must be used for that. +parser_e_procedure_overloading_is_off=03088_E_Procedure overloading is switched off +% When using the \var{-So} switch, procedure overloading is switched off. +% Turbo Pascal does not support function overloading. +parser_e_overload_operator_failed=03089_E_It is not possible to overload this operator. Related overloadable operators (if any) are: $1 +% You are trying to overload an operator which cannot be overloaded. +% The following operators can be overloaded : +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_Comparative operator must return a boolean value +% When overloading the \var{=} operator, the function must return a boolean +% value. +parser_e_only_virtual_methods_abstract=03091_E_Only virtual methods can be abstract +% You are declaring a method as abstract, when it is not declared to be +% virtual. +parser_f_unsupported_feature=03092_F_Use of unsupported feature! +% You're trying to force the compiler into doing something it cannot do yet. +parser_e_mix_of_classes_and_objects=03093_E_The mix of different kind of objects (class, object, interface, etc) isn't allowed +% You cannot derive \var{objects}, \var{classes}, \var{cppclasses} and \var{interfaces} intertwined. E.g. +% a class cannot have an object as parent and vice versa. +parser_w_unknown_proc_directive_ignored=03094_W_Unknown procedure directive had to be ignored: "$1" +% The procedure directive you specified is unknown. +parser_e_absolute_only_one_var=03095_E_absolute can only be associated to one variable +% You cannot specify more than one variable before the \var{absolute} directive. +% Thus, the following construct will provide this error: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +parser_e_absolute_only_to_var_or_const=03096_E_absolute can only be associated with a var or const +% The address of an \var{absolute} directive can only point to a variable or +% constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +parser_e_initialized_only_one_var=03097_E_Only one variable can be initialized +% You cannot specify more than one variable with a initial value in Delphi mode. +parser_e_abstract_no_definition=03098_E_Abstract methods shouldn't have any definition (with function body) +% Abstract methods can only be declared, you cannot implement them. They +% should be overridden by a descendant class. +parser_e_overloaded_must_be_all_global=03099_E_This overloaded function can't be local (must be exported) +% You are defining an overloaded function in the implementation part of a unit, +% but there is no corresponding declaration in the interface part of the unit. +parser_w_virtual_without_constructor=03100_W_Virtual methods are used without a constructor in "$1" +% If you declare objects or classes that contain virtual methods, you need +% to have a constructor and destructor to initialize them. The compiler +% encountered an object or class with virtual methods that doesn't have +% a constructor/destructor pair. +parser_c_macro_defined=03101_CL_Macro defined: $1 +% When \var{-vc} is used, the compiler tells you when it defines macros. +parser_c_macro_undefined=03102_CL_Macro undefined: $1 +% When \var{-vc} is used, the compiler tells you when it undefines macros. +parser_c_macro_set_to=03103_CL_Macro $1 set to $2 +% When \var{-vc} is used, the compiler tells you what values macros get. +parser_i_compiling=03104_I_Compiling $1 +% When you turn on information messages (\var{-vi}), the compiler tells you +% what units it is recompiling. +parser_u_parsing_interface=03105_UL_Parsing interface of unit $1 +% This tells you that the reading of the interface +% of the current unit has started +parser_u_parsing_implementation=03106_UL_Parsing implementation of $1 +% This tells you that the code reading of the implementation +% of the current unit, library or program starts +parser_d_compiling_second_time=03107_DL_Compiling $1 for the second time +% When you request debug messages (\var{-vd}) the compiler tells you what +% units it recompiles for the second time. +parser_e_no_property_found_to_override=03109_E_No property found to override +% You want to override a property of a parent class, when there is, in fact, +% no such property in the parent class. +parser_e_only_one_default_property=03110_E_Only one default property is allowed +% You specified a property as \var{Default}, but the class already has a +% default property, and a class can have only one default property. +parser_e_property_need_paras=03111_E_The default property must be an array property +% Only array properties of classes can be made \var{default} properties. +parser_e_constructor_cannot_be_not_virtual=03112_E_Virtual constructors are only supported in class object model +% You cannot have virtual constructors in objects. You can only have them +% in classes. +parser_e_no_default_property_available=03113_E_No default property available +% You are trying to access a default property of a class, but this class (or one of +% its ancestors) doesn't have a default property. +parser_e_cant_have_published=03114_E_The class can't have a published section, use the {$M+} switch +% If you want a \var{published} section in a class definition, you must +% use the \var{\{\$M+\}} switch, which turns on generation of type +% information. +parser_e_forward_declaration_must_be_resolved=03115_E_Forward declaration of class "$1" must be resolved here to use the class as ancestor +% To be able to use an object as an ancestor object, it must be defined +% first. This error occurs in the following situation: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% where \var{ParentClass} is declared but not defined. +parser_e_no_local_operator=03116_E_Local operators not supported +% You cannot overload locally, i.e. inside procedures or function +% definitions. +parser_e_proc_dir_not_allowed_in_interface=03117_E_Procedure directive "$1" not allowed in interface section +% This procedure directive is not allowed in the \var{interface} section of +% a unit. You can only use it in the \var{implementation} section. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_Procedure directive "$1" not allowed in implementation section +% This procedure directive is not allowed in the \var{implementation} section of +% a unit. You can only use it in the \var{interface} section. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_Procedure directive "$1" not allowed in procvar declaration +% This procedure directive cannot be part of a procedural or function +% type declaration. +parser_e_function_already_declared_public_forward=03120_E_Function is already declared Public/Forward "$1" +% You will get this error if a function is defined as \var{forward} twice. +% Or if it occurs in the \var{interface} section, and again as a \var{forward} +% declaration in the \var{implementation} section. +parser_e_not_external_and_export=03121_E_Can't use both EXPORT and EXTERNAL +% These two procedure directives are mutually exclusive. +parser_w_not_supported_for_inline=03123_W_"$1" not yet supported inside inline procedure/function +% Inline procedures don't support this declaration. +parser_w_inlining_disabled=03124_W_Inlining disabled +% Inlining of procedures is disabled. +parser_i_writing_browser_log=03125_I_Writing Browser log $1 +% When information messages are on, the compiler warns you when it +% writes the browser log (generated with the \var{\{\$Y+ \}} switch). +parser_h_maybe_deref_caret_missing=03126_H_may be pointer dereference is missing +% The compiler thinks that a pointer may need a dereference. +parser_f_assembler_reader_not_supported=03127_F_Selected assembler reader not supported +% The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not +% supported. The compiler can be compiled with or without support for a +% particular assembler reader. +parser_e_proc_dir_conflict=03128_E_Procedure directive "$1" has conflicts with other directives +% You specified a procedure directive that conflicts with other directives. +% For instance \var{cdecl} and \var{pascal} are mutually exclusive. +parser_e_call_convention_dont_match_forward=03129_E_Calling convention doesn't match forward +% This error happens when you declare a function or procedure with +% e.g. \var{cdecl;} but omit this directive in the implementation, or vice +% versa. The calling convention is part of the function declaration, and +% must be repeated in the function definition. +parser_e_property_cant_have_a_default_value=03131_E_Property can't have a default value +% Set properties or indexed properties cannot have a default value. +parser_e_property_default_value_must_const=03132_E_The default value of a property must be constant +% The value of a \var{default} declared property must be known at compile +% time. The value you specified is only known at run time. This happens +% e.g. if you specify a variable name as a default value. +parser_e_cant_publish_that=03133_E_Symbol can't be published, can be only a class +% Only class type variables can be in a \var{published} section of a class +% if they are not declared as a property. +parser_e_cant_publish_that_property=03134_E_This kind of property can't be published +% Properties in a \var{published} section cannot be array properties. +% They must be moved to public sections. Properties in a \var{published} +% section must be an ordinal type, a real type, strings or sets. +parser_e_empty_import_name=03136_E_An import name is required +% Some targets need a name for the imported procedure or a \var{cdecl} specifier. +parser_e_division_by_zero=03138_E_Division by zero +% A division by zero was encounted. +parser_e_invalid_float_operation=03139_E_Invalid floating point operation +% An operation on two real type values produced an overflow or a division +% by zero. +parser_e_array_lower_less_than_upper_bound=03140_E_Upper bound of range is less than lower bound +% The upper bound of an array declaration is less than the lower bound and this +% is not possible. +parser_w_string_too_long=03141_W_string "$1" is longer than "$2" +% The size of the constant string is larger than the size you specified in +% string type definition. +parser_e_string_larger_array=03142_E_string length is larger than array of char length +% The size of the constant string is larger than the size you specified in +% the \var{Array[x..y] of char} definition. +parser_e_ill_msg_expr=03143_E_Illegal expression after message directive +% \fpc supports only integer or string values as message constants. +parser_e_ill_msg_param=03144_E_Message handlers can take only one call by ref. parameter +% A method declared with the \var{message} directive as message handler +% can take only one parameter which must be declared as call by reference. +% Parameters are declared as call by reference using the \var{var}-directive. +parser_e_duplicate_message_label=03145_E_Duplicate message label: "$1" +% A label for a message is used twice in one object/class. +parser_e_self_in_non_message_handler=03146_E_Self can only be an explicit parameter in methods which are message handlers +% The \var{Self} parameter can only be passed explicitly to a method which +% is declared as message handler. +parser_e_threadvars_only_sg=03147_E_Threadvars can be only static or global +% Threadvars must be static or global; you can't declare a thread +% local to a procedure. Local variables are always local to a thread, +% because every thread has its own stack and local variables +% are stored on the stack. +parser_f_direct_assembler_not_allowed=03148_F_Direct assembler not supported for binary output format +% You can't use direct assembler when using a binary writer. Choose an +% other output format or use another assembler reader. +parser_w_no_objpas_use_mode=03149_W_Don't load OBJPAS unit manually, use \{\$mode objfpc\} or \{\$mode delphi\} instead +% You are trying to load the \file{ObjPas} unit manually from a \var{uses} clause. +% This is not a good idea. Use the \var{\{\$MODE OBJFPC\}} or +% \var{\{\$mode delphi\}} directives which load the unit automatically. +parser_e_no_object_override=03150_E_OVERRIDE can't be used in objects +% \var{Override} is not supported for objects, use \var{virtual} instead to override +% a method of a parent object. +parser_e_cant_use_inittable_here=03151_E_Data types which require initialization/finalization can't be used in variant records +% Some data types (e.g. \var{ansistring}) need initialization/finalization +% code which is implicitly generated by the compiler. Such data types +% can't be used in the variant part of a record. +parser_e_resourcestring_only_sg=03152_E_Resourcestrings can be only static or global +% Resourcestring cannot be declared local, only global or using the static +% directive. +parser_e_exit_with_argument_not__possible=03153_E_Exit with argument can't be used here +% An exit statement with an argument for the return value can't be used here. This +% can happen for example in \var{try..except} or \var{try..finally} blocks. +parser_e_stored_property_must_be_boolean=03154_E_The type of the storage symbol must be boolean +% If you specify a storage symbol in a property declaration, it must be a +% boolean type. +parser_e_ill_property_storage_sym=03155_E_This symbol isn't allowed as storage symbol +% You can't use this type of symbol as storage specifier in property +% declaration. You can use only methods with the result type boolean, +% boolean class fields or boolean constants. +parser_e_only_publishable_classes_can_be_published=03156_E_Only classes which are compiled in $M+ mode can be published +% A class-typed field in the published section of a class can only be a class which was +% compiled in \var{\{\$M+\}} or which is derived from such a class. Normally +% such a class should be derived from \var{TPersistent}. +parser_e_proc_directive_expected=03157_E_Procedure directive expected +% This error is triggered when you have a \var{\{\$Calling\}} directive without +% a calling convention specified. +% It also happens when declaring a procedure in a const block and you +% used a ; after a procedure declaration which must be followed by a +% procedure directive. +% Correct declarations are: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_The value for a property index must be of an ordinal type +% The value you use to index a property must be of an ordinal type, for +% example an integer or enumerated type. +parser_e_procname_to_short_for_export=03159_E_Procedure name too short to be exported +% The length of the procedure/function name must be at least 2 characters +% long. This is because of a bug in dlltool which doesn't parse the .def +% file correctly with a name of length 1. +parser_e_dlltool_unit_var_problem=03160_E_No DEFFILE entry can be generated for unit global vars +parser_e_dlltool_unit_var_problem2=03161_E_Compile without -WD option +% You need to compile this file without the -WD switch on the +% command line. +parser_f_need_objfpc_or_delphi_mode=03162_F_You need ObjFpc (-S2) or Delphi (-Sd) mode to compile this module +% You need to use \var{\{\$MODE OBJFPC\}} or \var{\{\$MODE DELPHI\}} to compile this file. +% Or use the corresponding command line switch, either \var{-Mobjfpc} or \var{-MDelphi.} +parser_e_no_export_with_index_for_target=03163_E_Can't export with index under $1 +% Exporting of functions or procedures with a specified index is not +% supported on this target. +parser_e_no_export_of_variables_for_target=03164_E_Exporting of variables is not supported under $1 +% Exporting of variables is not supported on this target. +parser_e_improper_guid_syntax=03165_E_Improper GUID syntax +% The GUID indication does not have the proper syntax. It should be of the form +% \begin{verbatim} +% {XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX} +% \end{verbatim} +% Where each \var{X} represents a hexadecimal digit. +parser_w_interface_mapping_notfound=03168_W_Procedure named "$1" not found that is suitable for implementing the $2.$3 +% The compiler cannot find a suitable procedure which implements the given method of an interface. +% A procedure with the same name is found, but the arguments do not match. +parser_e_interface_id_expected=03169_E_interface identifier expected +% This happens when the compiler scans a \var{class} declaration that contains +% \var{interface} function name mapping code like this: +% \begin{verbatim} +% type +% TMyObject = class(TObject, IDispatch) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% and the \var{interface} before the dot is not listed in the inheritance list. +parser_e_type_cant_be_used_in_array_index=03170_E_Type "$1" can't be used as array index type +% Types like \var{qword} or \var{int64} aren't allowed as array index type. +parser_e_no_con_des_in_interfaces=03171_E_Con- and destructors aren't allowed in interfaces +% Constructor and destructor declarations aren't allowed in interfaces. +% In the most cases method \var{QueryInterface} of \var{IUnknown} can +% be used to create a new interface. +parser_e_no_access_specifier_in_interfaces=03172_E_Access specifiers can't be used in INTERFACEs and OBJCPROTOCOLs +% The access specifiers \var{public}, \var{private}, \var{protected} and +% \var{published} can't be used in interfaces, Objective-C protocols and categories because all methods +% of an interface/protocol/category must be public. +parser_e_no_vars_in_interfaces=03173_E_An interface, helper or Objective-C protocol or category cannot contain fields +% Declarations of fields are not allowed in interfaces, helpers and Objective-C protocols and categories. +% An interface/helper/protocol/category can contain only methods and properties with method read/write specifiers. +parser_e_no_local_proc_external=03174_E_Can't declare local procedure as EXTERNAL +% Declaring local procedures as external is not possible. Local procedures +% get hidden parameters that will make the chance of errors very high. +parser_w_skipped_fields_before=03175_W_Some fields coming before "$1" weren't initialized +% In Delphi mode, not all fields of a typed constant record have to be +% initialized, but the compiler warns you when it detects such situations. +parser_e_skipped_fields_before=03176_E_Some fields coming before "$1" weren't initialized +% In all syntax modes but Delphi mode, you can't leave some fields uninitialized +% in the middle of a typed constant record. +parser_w_skipped_fields_after=03177_W_Some fields coming after "$1" weren't initialized +% You can leave some fields at the end of a type constant record uninitialized +% (The compiler will initialize them to zero automatically). This may be the cause +% of subtle problems. +parser_e_varargs_need_cdecl_and_external=03178_E_VarArgs directive (or '...' in MacPas) without CDecl/CPPDecl/MWPascal and External +% The varargs directive (or the ``...'' varargs parameter in MacPas mode) can only be +% used with procedures or functions that are declared with \var{external} and one of +% \var{cdecl}, \var{cppdecl} and \var{mwpascal}. This functionality +% is only supported to provide a compatible interface to C functions like printf. +parser_e_self_call_by_value=03179_E_Self must be a normal (call-by-value) parameter +% You can't declare \var{Self} as a const or var parameter, it must always be +% a call-by-value parameter. +parser_e_interface_has_no_guid=03180_E_Interface "$1" has no interface identification +% When you want to assign an interface to a constant, then the interface +% must have a GUID value set. +parser_e_illegal_field_or_method=03181_E_Unknown class field or method identifier "$1" +% Properties must refer to a field or method in the same class. +parser_w_proc_overriding_calling=03182_W_Overriding calling convention "$1" with "$2" +% There are two directives in the procedure declaration that specify a calling +% convention. Only the last directive will be used. +parser_e_no_procvarobj_const=03183_E_Typed constants of the type "procedure of object" can only be initialized with NIL +% You cannot assign the address of a method to a typed constant which has a +% 'procedure of object' type, because such a constant requires two addresses: +% that of the method (which is known at compile time) and that of the object or +% class instance it operates on (which cannot be known at compile time). +parser_e_default_value_only_one_para=03184_E_Default value can only be assigned to one parameter +% It is not possible to specify a default value for several parameters at once. +% The following is invalid: +% \begin{verbatim} +% Procedure MyProcedure (A,B : Integer = 0); +% \end{verbatim} +% Instead, this should be declared as +% \begin{verbatim} +% Procedure MyProcedure (A : Integer = 0; B : Integer = 0); +% \end{verbatim} +parser_e_default_value_expected_for_para=03185_E_Default parameter required for "$1" +% The specified parameter requires a default value. +parser_w_unsupported_feature=03186_W_Use of unsupported feature! +% You're trying to force the compiler into doing something it cannot do yet. +parser_h_c_arrays_are_references=03187_H_C arrays are passed by reference +% Any array passed to a C function is passed +% by a pointer (i.e. by reference). +parser_e_C_array_of_const_must_be_last=03188_E_C array of const must be the last argument +% You cannot add any other argument after an \var{array of const} for +% \var{cdecl} functions, as the size pushed on stack for this argument is +% not known. +parser_h_type_redef=03189_H_Type "$1" redefinition +% This is an indicator that a previously declared type is +% being redefined as something else. This may, or may not +% be, a potential source of errors. +parser_w_cdecl_has_no_high=03190_W_cdecl'ared functions have no high parameter +% Functions declared with the \var{cdecl} modifier do not pass an extra implicit parameter. +parser_w_cdecl_no_openstring=03191_W_cdecl'ared functions do not support open strings +% Openstring is not supported for functions that have the \var{cdecl} modifier. +parser_e_initialized_not_for_threadvar=03192_E_Cannot initialize variables declared as threadvar +% Variables declared as threadvar cannot be initialized with a default value. +% The variables will always be filled with zero at the start of a new thread. +parser_e_msg_only_for_classes=03193_E_Message directive is only allowed in Classes +% The message directive is only supported for Class types. +parser_e_procedure_or_function_expected=03194_E_Procedure or Function expected +% A class method can only be specified for procedures and functions. +parser_e_illegal_calling_convention=03195_W_Calling convention directive ignored: "$1" +% Some calling conventions are supported only by certain CPUs. I.e. most non-i386 ports support +% only the standard ABI calling convention of the CPU. +parser_e_no_object_reintroduce=03196_E_REINTRODUCE can't be used in objects +% \var{reintroduce} is not supported for objects, Objective-C classes and Objective-C protocols. +parser_e_paraloc_only_one_para=03197_E_Each argument must have its own location +% If locations for arguments are specified explicitly as it is required by +% some syscall conventions, each argument must have its own location. Things +% like +% \begin{verbatim} +% procedure p(i,j : longint 'r1'); +% \end{verbatim} +% aren't allowed. +parser_e_paraloc_all_paras=03198_E_Each argument must have an explicit location +% If one argument has an explicit argument location, all arguments of a procedure +% must have one. +parser_e_illegal_explicit_paraloc=03199_E_Unknown argument location +% The location specified for an argument isn't recognized by the compiler. +parser_e_32bitint_or_pointer_variable_expected=03200_E_32 Bit-Integer or pointer variable expected +% The libbase for MorphOS/AmigaOS can be given only as \var{longint}, \var{dword} or any pointer variable. +parser_e_goto_outside_proc=03201_E_Goto statements aren't allowed between different procedures +% It isn't allowed to use \var{goto} statements referencing labels outside the +% current procedure. The following example shows the problem: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1; +% +% procedure p2; +% begin +% goto l1; // This goto ISN'T allowed +% end; +% +% begin +% p2 +% l1: +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_Procedure too complex, it requires too many registers +% Your procedure body is too long for the compiler. You should split the +% procedure into multiple smaller procedures. +parser_e_illegal_expression=03203_E_Illegal expression +% This can occur under many circumstances. Usually when trying to evaluate +% constant expressions. +parser_e_invalid_integer=03204_E_Invalid integer expression +% You made an expression which isn't an integer, and the compiler expects the +% result to be an integer. +parser_e_invalid_qualifier=03205_E_Illegal qualifier +% One of the following is happening : +% \begin{itemize} +% \item You're trying to access a field of a variable that is not a record. +% \item You're indexing a variable that is not an array. +% \item You're dereferencing a variable that is not a pointer. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_High range limit < low range limit +% You are declaring a subrange, and the high limit is less than the low limit of +% the range. +parser_e_macpas_exit_wrong_param=03207_E_Exit's parameter must be the name of the procedure it is used in +% Non local exit is not allowed. This error occurs only in mode MacPas. +parser_e_illegal_assignment_to_count_var=03208_E_Illegal assignment to for-loop variable "$1" +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. You also cannot assign values to +% loop variables inside the loop (Except in Delphi and TP modes). Use a while or +% repeat loop instead if you need to do something like that, since those +% constructs were built for that. +parser_e_no_local_var_external=03209_E_Can't declare local variable as EXTERNAL +% Declaring local variables as external is not allowed. Only global variables can reference +% external variables. +parser_e_proc_already_external=03210_E_Procedure is already declared EXTERNAL +% The procedure is already declared with the EXTERNAL directive in an interface or +% forward declaration. +parser_w_implicit_uses_of_variants_unit=03211_W_Implicit uses of Variants unit +% The Variant type is used in the unit without any used unit using the Variants unit. The +% compiler has implicitly added the Variants unit to the uses list. To remove this warning +% the Variants unit needs to be added to the uses statement. +parser_e_no_static_method_in_interfaces=03212_E_Class and static methods can't be used in INTERFACES +% The specifier \var{class} and directive \var{static} can't be used in interfaces +% because all methods of an interface must be public. +parser_e_arithmetic_operation_overflow=03213_E_Overflow in arithmetic operation +% An operation on two integer values produced an overflow. +parser_e_protected_or_private_expected=03214_E_Protected or private expected +% \var{strict} can be only used together with \var{protected} or \var{private}. +parser_e_illegal_slice=03215_E_SLICE can't be used outside of parameter list +% \var{slice} can be used only for arguments accepting an open array parameter. +parser_e_dispinterface_cant_have_parent=03216_E_A DISPINTERFACE can't have a parent class +% A DISPINTERFACE is a special type of interface which can't have a parent class. Dispinterface always derive from IDispatch type. +parser_e_dispinterface_needs_a_guid=03217_E_A DISPINTERFACE needs a guid +% A DISPINTERFACE always needs an interface identification (a GUID). +parser_w_overridden_methods_not_same_ret=03218_W_Overridden methods must have a related return type. This code may crash, it depends on a Delphi parser bug ("$2" is overridden by "$1" which has another return type) +% If you declare overridden methods in a class definition, they must +% have the same return type. Some versions of Delphi allow you to change the +% return type of interface methods, and even to change procedures into +% functions, but the resulting code may crash depending on the types used +% and the way the methods are called. +parser_e_dispid_must_be_ord_const=03219_E_Dispatch IDs must be ordinal constants +% The \var{dispid} keyword must be followed by an ordinal constant (the dispid index). +parser_e_array_range_out_of_bounds=03220_E_The range of the array is too large +% Regardless of the size taken up by its elements, an array cannot have more +% than high(ptrint) elements. Additionally, the range type must be a subrange +% of ptrint. +parser_e_packed_element_no_var_addr=03221_E_The address cannot be taken of bit packed array elements and record fields +% If you declare an array or record as \var{packed} in Mac Pascal mode +% (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will +% be packed at the bit level. This means it becomes impossible to take addresses +% of individual array elements or record fields. The only exception to this rule +% is in the case of packed arrays elements whose packed size is a multple of 8 bits. +parser_e_packed_dynamic_open_array=03222_E_Dynamic arrays cannot be packed +% Only regular (and possibly in the future also open) arrays can be packed. +parser_e_packed_element_no_loop=03223_E_Bit packed array elements and record fields cannot be used as loop variables +% If you declare an array or record as \var{packed} in Mac Pascal mode +% (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will +% be packed at the bit level. For performance reasons, they cannot be +% used as loop variables. +parser_e_type_var_const_only_in_records_and_classes=03224_E_VAR, TYPE and CONST are allowed only in records, objects and classes +% The usage of VAR, TYPE and CONST to declare new types inside an object is allowed only inside +% records, objects and classes. +parser_e_cant_create_generics_of_this_type=03225_E_This type can't be a generic +% Only Classes, Objects, Interfaces and Records are allowed to be used as generic. +parser_w_no_lineinfo_use_switch=03226_W_Don't load LINEINFO unit manually, Use the -gl compiler switch instead +% Do not use the \file{lineinfo} unit directly, Use the \var{-gl} switch which +% automatically adds the correct unit for reading the selected type of debugging +% information. The unit that needs to be used depends on the type of +% debug information used when compiling the binary. +parser_e_no_funcret_specified=03227_E_No function result type specified for function "$1" +% The first time you declare a function you have to declare it completely, +% including all parameters and the result type. +parser_e_special_onlygenerics=03228_E_Specialization is only supported for generic types +% Types which are not generics can't be specialized. +parser_e_no_generics_as_params=03229_E_Generics can't be used as parameters when specializing generics +% When specializing a generic, only non-generic types can be used as parameters. +parser_e_type_object_constants=03230_E_Constants of objects containing a VMT aren't allowed +% If an object requires a VMT either because it contains a constructor or virtual methods, +% it's not allowed to create constants of it. In TP and Delphi mode this is allowed +% for compatibility reasons. +parser_e_label_outside_proc=03231_E_Taking the address of labels defined outside the current scope isn't allowed +% It isn't allowed to take the address of labels outside the +% current procedure. +parser_e_initialized_not_for_external=03233_E_Cannot initialize variables declared as external +% Variables declared as external cannot be initialized with a default value. +parser_e_illegal_function_result=03234_E_Illegal function result type +% Some types like file types cannot be used as function result. +parser_e_no_common_type=03235_E_No common type possible between "$1" and "$2" +% To perform an operation on integers, the compiler converts both operands +% to their common type, which appears to be an invalid type. To determine the +% common type of the operands, the compiler takes the minimum of the minimal values +% of both types, and the maximum of the maximal values of both types. The common +% type is then minimum..maximum. +parser_e_no_generics_as_types=03236_E_Generics without specialization cannot be used as a type for a variable +% Generics must be always specialized before being used as variable type. +parser_w_register_list_ignored=03237_W_Register list is ignored for pure assembler routines +% When using pure assembler routines, the list with modified registers is ignored. +parser_e_implements_must_be_class_or_interface=03238_E_Implements property must have class or interface type +% A property which implements an interface must be of type class or interface. +parser_e_implements_must_have_correct_type=03239_E_Implements-property must implement interface of correct type, found "$1" expected "$2" +% A property which implements an interface actually implements a different interface. +parser_e_implements_must_read_specifier=03240_E_Implements-property must have read specifier +% A property which implements an interface must have at least a read specifier. +parser_e_implements_must_not_have_write_specifier=03241_E_Implements-property must not have write-specifier +% A property which implements an interface may not have a write specifier. +parser_e_implements_must_not_have_stored_specifier=03242_E_Implements-property must not have stored-specifier +% A property which implements an interface may not have a stored specifier. +parser_e_implements_uses_non_implemented_interface=03243_E_Implements-property used on unimplemented interface: "$1" +% The interface which is implemented by a property is not an interface implemented by the class. +parser_e_unsupported_real=03244_E_Floating point not supported for this target +% The compiler parsed a floating point expression, but it is not supported. +parser_e_class_doesnt_implement_interface=03245_E_Class "$1" does not implement interface "$2" +% The delegated interface is not implemented by the class given in the implements clause. +parser_e_class_implements_must_be_interface=03246_E_Type used by implements must be an interface +% The \var{implements} keyword must be followed by an interface type. +parser_e_cant_export_var_different_name=03247_E_Variables cannot be exported with a different name on this target, add the name to the declaration using the "export" directive (variable name: $1, declared export name: $2) +% On most targets it is not possible to change the name under which a variable +% is exported inside the \var{exports} statement of a library. +% In that case, you have to specify the export name at the point where the +% variable is declared, using the \var{export} and \var{alias} directives. +parser_e_weak_external_not_supported=03248_E_Weak external symbols are not supported for the current target +% A "weak external" symbol is a symbol which may or may not exist at (either static +% or dynamic) link time. This concept may not be available (or implemented yet) +% on the current cpu/OS target. +parser_e_forward_mismatch=03249_E_Forward type definition does not match +% Classes and interfaces being defined forward must have the same type +% when being implemented. A forward interface cannot be changed into a class. +parser_n_ignore_lower_visibility=03250_N_Virtual method "$1" has a lower visibility ($2) than parent class $3 ($4) +% The virtual method overrides an method that is declared with a higher visibility. This might give +% unexpected results. In case the new visibility is private than it might be that a call to inherited in a +% new child class will call the higher visible method in a parent class and ignores the private method. +parser_e_field_not_allowed_here=03251_E_Fields cannot appear after a method or property definition, start a new visibility section first +% Once a method or property has been defined in a class or object, you cannot define any fields afterwards +% without starting a new visibility section (such as \var{public}, \var{private}, etc.). The reason is +% that otherwise the source code can appear ambiguous to the compiler, since it is possible to use modifiers +% such as \var{default} and \var{register} also as field names. +parser_e_no_local_para_def=03252_E_Parameters or result types cannot contain local type definitions. Use a separate type definition in a type block. +% In Pascal, types are not considered to be identical simply because they are semantically equivalent. +% Two variables or parameters are only considered to be of the same type if they refer to the +% same type definition. +% As a result, it is not allowed to define new types inside parameter lists, because then it is impossible to +% refer to the same type definition in the procedure headers of the interface and implementation of a unit +% (both procedure headers would define a separate type). Keep in mind that expressions such as +% ``file of byte'' or ``string[50]'' also define a new type. +parser_e_abstract_and_sealed_conflict=03253_E_ABSTRACT and SEALED conflict +% ABSTRACT and SEALED cannot be used together in one declaration +parser_e_sealed_descendant=03254_E_Cannot create a descendant of the sealed class "$1" +% Sealed means that class cannot be derived by another class. +parser_e_sealed_class_cannot_have_abstract_methods=03255_E_SEALED class cannot have an ABSTRACT method +% Sealed means that class cannot be derived. Therefore no one class is able to override an abstract method in a sealed class. +parser_e_only_virtual_methods_final=03256_E_Only virtual methods can be final +% You are declaring a method as final, when it is not declared to be +% virtual. +parser_e_final_can_no_be_overridden=03257_E_Final method cannot be overridden: "$1" +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_multiple_messages=03258_E_Only one message can be used per method. +% It is not possible to associate multiple messages with a single method. +parser_e_invalid_enumerator_identifier=03259_E_Invalid enumerator identifier: "$1" +% Only "MoveNext" and "Current" enumerator identifiers are supported. +parser_e_enumerator_identifier_required=03260_E_Enumerator identifier required +% "MoveNext" or "Current" identifier must follow the \var{enumerator} modifier. +parser_e_enumerator_movenext_is_not_valid=03261_E_Enumerator MoveNext pattern method is not valid. Method must be a function with the Boolean return type and no required arguments. +% "MoveNext" enumerator pattern method must be a function with Boolean return type and no required arguments +parser_e_enumerator_current_is_not_valid=03262_E_Enumerator Current pattern property is not valid. Property must have a getter. +% "Current" enumerator pattern property must have a getter +parser_e_only_one_enumerator_movenext=03263_E_Only one enumerator MoveNext method is allowed per class/object +% Class or Object can have only one enumerator MoveNext declaration. +parser_e_only_one_enumerator_current=03264_E_Only one enumerator Current property is allowed per class/object +% Class or Object can have only one enumerator Current declaration. +parser_e_for_in_loop_cannot_be_used_for_the_type=03265_E_For in loop cannot be used for the type "$1" +% For in loop can be used not for all types. For example it cannot be used for the enumerations with jumps. +parser_e_objc_requires_msgstr=03266_E_Objective-C messages require their Objective-C selector name to be specified using the "message" directive. +% Objective-C messages require their Objective-C name (selector name) to be specified using the \var{message `someName:'} procedure directive. +% While bindings to other languages automatically generate such names based on the identifier you use (by replacing +% all underscores with colons), this is unsafe since nothing prevents an Objective-C method name to contain actual +% colons. +parser_e_objc_no_constructor_destructor=03267_E_Objective-C does not have formal constructors nor destructors. Use the alloc, initXXX and dealloc messages. +% The Objective-C language does not have any constructors or destructors. While there are some messages with a similar +% purpose (such as \var{init} and \var{dealloc}), these cannot be identified using automatic parsers and do not +% guarantee anything like Pascal constructors/destructors (e.g., you have to take care of only calling ``designated'' +% inherited ``constructors''). For these reasons, we have opted to follow the standard Objective-C patterns for +% instance creation/destruction. +parser_e_message_string_too_long=03268_E_Message name is too long (max. 255 characters) +% Due to compiler implementation reasons, message names are currently limited to 255 characters. +parser_e_objc_message_name_too_long=03269_E_Objective-C message symbol name for "$1" is too long +% Due to compiler implementation reasons, mangled message names (i.e., the symbol names used in the assembler +% code) are currently limited to 255 characters. +parser_h_no_objc_parent=03270_H_Defining a new Objective-C root class. To derive from another root class (e.g., NSObject), specify it as the parent class. +% If no parent class is specified for an Object Pascal class, then it automatically derives from TObject. +% Objective-C classes however do not automatically derive from NSObject, because one can have multiple +% root classes in Objective-C. For example, in the Cocoa framework both NSObject and NSProxy are root classes. +% Therefore, you have to explicitly define a parent class (such as NSObject) if you want to derive your +% Objective-C class from it. +parser_e_no_objc_published=03271_E_Objective-C classes cannot have published sections. +% In Object Pascal, ``published'' determines whether or not RTTI is generated. Since the Objective-C runtime always needs +% RTTI for everything, this specified does not make sense for Objective-C classes. +parser_f_need_objc=03272_F_This module requires an Objective-C mode switch to be compiled +% This error indicates the use of Objective-C language features without an Objective-C mode switch +% active. Enable one via the -M command line switch, or the {\$modeswitch x} directive. +parser_e_must_use_override_objc=03273_E_Inherited methods can only be overridden in Objective-C, add "override" (inherited method defined in $1) +parser_h_should_use_override_objc=03274_H_Inherited methods can only be overridden in Objective-C, add "override" (inherited method defined in $1). +% It is not possible to \var{reintroduce} methods in Objective-C like in Object Pascal. Methods with the same +% name always map to the same virtual method entry. In order to make this clear in the source code, +% the compiler always requires the \var{override} directive to be specified when implementing overriding +% Objective-C methods in Pascal. If the implementation is external, this rule is relaxed because Objective-C +% does not have any \var{override}-style keyword (since it's the default and only behaviour in that language), +% which makes it hard for automated header conversion tools to include it everywhere. +% The type in which the inherited method is defined is explicitly mentioned, because this may either +% be an objcclass or an objccategory. +parser_e_objc_message_name_changed=03275_E_Message name "$1" in inherited class is different from message name "$2" in current class. +% An overriding Objective-C method cannot have a different message name than an inherited method. The reason +% is that these message names uniquely define the message to the Objective-C runtime, which means that +% giving them a different message name breaks the ``override'' semantics. +parser_e_no_objc_unique=03276_E_It is not yet possible to make unique copies of Objective-C types +% Duplicating an Objective-C type using \var{type x = type y;} is not yet supported. You may be able to +% obtain the desired effect using \var{type x = objcclass(y) end;} instead. +parser_e_no_category_as_types=03277_E_Objective-C categories and Object Pascal class helpers cannot be used as types +% It is not possible to declare a variable as an instance of an Objective-C +% category or an Object Pascal class helper. A category/class helper adds +% methods to the scope of an existing class, but does not define a type by +% itself. An exception of this rule is when inheriting an Object Pascal class +% helper from another class helper. +parser_e_no_category_override=03278_E_Categories do not override, but replace methods. Use "reintroduce" instead. +parser_e_must_use_reintroduce_objc=03279_E_Replaced methods can only be reintroduced in Objective-C, add "reintroduce" (replaced method defined in $1). +parser_h_should_use_reintroduce_objc=03280_H_Replaced methods can only be reintroduced in Objective-C, add "reintroduce" (replaced method defined in $1). +% A category replaces an existing method in an Objective-C class, rather than that it overrides it. +% Calling an inherited method from an category method will call that method in +% the extended class' parent, not in the extended class itself. The +% replaced method in the original class is basically lost, and can no longer be +% called or referred to. This behaviour corresponds somewhat more closely to +% \var{reintroduce} than to \var{override} (although in case of \var{reintroduce} +% in Object Pascal, hidden methods are still reachable via inherited). +% The type in which the inherited method is defined is explicitly mentioned, because this may either +% be an objcclass or an objccategory. +parser_e_implements_getter_not_default_cc=03281_E_Getter for implements interface must use the target's default calling convention. +% Interface getters are called via a helper in the run time library, and hence +% have to use the default calling convention for the target (\var{register} on +% i386 and x86\_64, \var{stdcall} on other architectures). +parser_e_no_refcounted_typed_file=03282_E_Typed files cannot contain reference-counted types. +% The data in a typed file cannot be of a reference counted type (such as +% \var{ansistring} or a record containing a field that is reference counted). +parser_e_operator_not_overloaded_2=03283_E_Operator is not overloaded: $2 "$1" +% You are trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_operator_not_overloaded_3=03284_E_Operator is not overloaded: "$1" $2 "$3" +% You are trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_more_array_elements_expected=03285_E_Expected another $1 array elements +% When declaring a typed constant array, you provided to few elements to initialize the array +parser_e_string_const_too_long=03286_E_String constant too long while ansistrings are disabled +% Only when a piece of code is compiled with ansistrings enabled (\var{\{\$H+\}}), string constants +% longer than 255 characters are allowed. +parser_e_invalid_univ_para=03287_E_Type cannot be used as univ parameter because its size is unknown at compile time: "$1" +% \var{univ} parameters are compatible with all values of the same size, but this +% cannot be checked in case a parameter's size is unknown at compile time. +parser_e_only_one_class_constructor_allowed=03288_E_Only one class constructor can be declared in class: "$1" +% You are trying to declare more than one class constructor but only one class constructor can be declared. +parser_e_only_one_class_destructor_allowed=03289_E_Only one class destructor can be declared in class: "$1" +% You are trying to declare more than one class destructor but only one class destructor can be declared. +parser_e_no_paras_for_class_constructor=03290_E_Class constructors can't have parameters +% You are declaring a class constructor with a parameter list. Class constructor methods +% cannot have parameters. +parser_e_no_paras_for_class_destructor=03291_E_Class destructors can't have parameters +% You are declaring a class destructor with a parameter list. Class destructor methods +% cannot have parameters. +parser_f_modeswitch_objc_required=03292_F_This construct requires the \{\$modeswitch objectivec1\} mode switch to be active +% Objective-Pascal constructs are not supported when \{\$modeswitch ObjectiveC1\} +% is not active. +parser_e_widestring_to_ansi_compile_time=03293_E_Unicodechar/string constants cannot be converted to ansi/shortstring at compile-time +% It is not possible to use unicodechar and unicodestring constants in +% constant expressions that have to be converted into an ansistring or shortstring +% at compile time, for example inside typed constants. The reason is that the +% compiler cannot know what the actual ansi encoding will be at run time. +parser_e_objc_enumerator_2_0=03294_E_For-in Objective-Pascal loops require \{\$modeswitch ObjectiveC2\} to be active +% Objective-C ``fast enumeration'' support was added in Objective-C 2.0, and +% hence the appropriate modeswitch has to be activated to expose this feature. +% Note that Objective-C 2.0 programs require Mac OS X 10.5 or later. +parser_e_objc_missing_enumeration_defs=03295_E_The compiler cannot find the NSFastEnumerationProtocol or NSFastEnumerationState type in the CocoaAll unit +% Objective-C for-in loops (fast enumeration) require that the compiler can +% find a unit called CocoaAll that contains definitions for the +% NSFastEnumerationProtocol and NSFastEnumerationState types. If you get this +% error, most likely the compiler is finding and loading an alternate CocoaAll +% unit. +parser_e_no_procvarnested_const=03296_E_Typed constants of the type 'procedure is nested' can only be initialized with NIL and global procedures/functions +% A nested procedural variable consists of two components: the address of the +% procedure/function to call (which is always known at compile time), and also +% a parent frame pointer (which is never known at compile time) in case the +% procedural variable contains a reference to a nested procedure/function. +% Therefore such typed constants can only be initialized with global +% functions/procedures since these do not require a parent frame pointer. +parser_f_no_generic_inside_generic=03297_F_Declaration of generic class inside another generic class is not allowed +% At the moment, scanner supports recording of only one token buffer at the time +% (guarded by internal error 200511173 in tscannerfile.startrecordtokens). +% Since generics are implemented by recording tokens, it is not possible to +% have declaration of generic class inside another generic class. +parser_e_forward_protocol_declaration_must_be_resolved=03298_E_Forward declaration of objcprotocol "$1" must be resolved before an objcclass can conform to it +% An objcprotocol must be fully defined before classes can conform to it. +% This error occurs in the following situation: +% \begin{verbatim} +% Type MyProtocol = objcprotoocl; +% ChildClass = Class(NSObject,MyProtocol) +% ... +% end; +% \end{verbatim} +% where \var{MyProtocol} is declared but not defined. +parser_e_no_record_published=03299_E_Record types cannot have published sections +% Published sections can be used only inside classes. +parser_e_no_destructor_in_records=03300_E_Destructors aren't allowed in records or helpers +% Destructor declarations aren't allowed in records or helpers. +parser_e_class_methods_only_static_in_records=03301_E_Class methods must be static in records +% Class methods declarations aren't allowed in records without static modifier. +% Records have no inheritance and therefore non static class methods have no sence for them. +parser_e_no_constructor_in_records=03302_E_Constructors aren't allowed in records or record helpers +% Constructor declarations aren't allowed in records or record helpers. +parser_e_at_least_one_argument_must_be_of_type=03303_E_Either the result or at least one parameter must be of type "$1" +% It is required that either the result of the routine or at least one of its parameters be of the specified type. +% For example class operators either take an instance of the structured type in which they are defined, or they return one. +parser_e_cant_use_type_parameters_here=03304_E_Type parameters may require initialization/finalization - can't be used in variant records +% Type parameters may be specialized with types which (e.g. \var{ansistring}) need initialization/finalization +% code which is implicitly generated by the compiler. +parser_e_externals_no_section=03305_E_Variables being declared as external cannot be in a custom section +% A section directive is not valid for variables being declared as external. +parser_e_section_no_locals=03306_E_Non-static and non-global variables cannot have a section directive +% A variable placed in a custom section is always statically allocated so it must be either a static or global variable. +parser_e_not_allowed_in_helper=03307_E_"$1" is not allowed in helper types +% Some directives and specifiers like "virtual", "dynamic", "override" aren't +% allowed inside helper types in mode ObjFPC (they are ignored in mode Delphi), +% because they have no meaning within helpers. Also "abstract" isn't allowed in +% either mode. +parser_e_no_class_constructor_in_helpers=03308_E_Class constructors aren't allowed in helpers +% Class constructor declarations aren't allowed in helpers. +parser_e_inherited_not_in_record=03309_E_The use of "inherited" is not allowed in a record +% As records don't suppport inheritance the use of "inherited" is prohibited for +% these as well as for record helpers (in mode "Delphi" only). +parser_e_no_types_in_local_anonymous_records=03310_E_Type declarations are not allowed in local or anonymous records +% Records with types must be defined globally. Types cannot be defined inside records which are defined in a +% procedure or function or in anonymous records. +parser_e_duplicate_implements_clause=03311_E_Duplicate implements clause for interface "$1" +% A class may delegate an interface using the "implements" clause only to a single property. Delegating it multiple times +% is a error. +parser_e_mapping_no_implements=03312_E_Interface "$1" can't be delegated by "$2", it already has method resolutions +% Method resolution clause maps a method of an interface to a method of the current class. Therefore the current class +% has to implement the interface directly. Delegation is not possible. +parser_e_implements_no_mapping=03313_E_Interface "$1" can't have method resolutions, "$2" already delegates it +% Method resoulution is only possible for interfaces that are implemented directly, not by delegation. +parser_e_invalid_codepage=03314_E_Invalid codepage +% When declaring a string with a given codepage, the range of valid codepages values is limited +% to 0 to 65535. +% \end{description} +# Type Checking +# +# 04108 is the last used one +# +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +type_e_mismatch=04000_E_Type mismatch +% This can happen in many cases: +% \begin{itemize} +% \item The variable you're assigning to is of a different type than the +% expression in the assignment. +% \item You are calling a function or procedure with parameters that are +% incompatible with the parameters in the function or procedure definition. +% \end{itemize} +type_e_incompatible_types=04001_E_Incompatible types: got "$1" expected "$2" +% There is no conversion possible between the two types. +% Another possiblity is that they are declared in different +% declarations: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { This statement also gives this error. It +% is due to the strict type checking of Pascal } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_Type mismatch between "$1" and "$2" +% The types are not equal. +type_e_type_id_expected=04003_E_Type identifier expected +% The identifier is not a type, or you forgot to supply a type identifier. +type_e_variable_id_expected=04004_E_Variable identifier expected +% This happens when you pass a constant to a routine (such as \var{Inc} var or \var{Dec}) +% when it expects a variable. You can only pass variables as arguments to these functions. +type_e_integer_expr_expected=04005_E_Integer expression expected, but got "$1" +% The compiler expects an expression of type integer, but gets a different +% type. +type_e_boolean_expr_expected=04006_E_Boolean expression expected, but got "$1" +% The expression must be a boolean type. It should be return \var{True} or +% \var{False}. +type_e_ordinal_expr_expected=04007_E_Ordinal expression expected +% The expression must be of ordinal type, i.e., maximum a \var{Longint}. +% This happens, for instance, when you specify a second argument +% to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value. +type_e_pointer_type_expected=04008_E_pointer type expected, but got "$1" +% The variable or expression isn't of the type \var{pointer}. This +% happens when you pass a variable that isn't a pointer to \var{New} +% or \var{Dispose}. +type_e_class_type_expected=04009_E_class type expected, but got "$1" +% The variable or expression isn't of the type \var{class}. This happens +% typically when +% \begin{enumerate} +% \item The parent class in a class declaration isn't a class. +% \item An exception handler (\var{On}) contains a type identifier that +% isn't a class. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_Can't evaluate constant expression +% This error can occur when the bounds of an array you declared do +% not evaluate to ordinal constants. +type_e_set_element_are_not_comp=04012_E_Set elements are not compatible +% You are trying to perform an operation on two sets, when the set element types +% are not the same. The base type of a set must be the same when taking the +% union. +type_e_set_operation_unknown=04013_E_Operation not implemented for sets +% several binary operations are not defined for sets. +% These include: \var{div}, \var{mod}, \var{**}, \var{>=} and \var{<=}. +% The last two may be defined for sets in the future. +type_w_convert_real_2_comp=04014_W_Automatic type conversion from floating type to COMP which is an integer type +% An implicit type conversion from a real type to a \var{comp} is +% encountered. Since \var{comp} is a 64 bit integer type, this may indicate +% an error. +type_h_use_div_for_int=04015_H_use DIV instead to get an integer result +% When hints are on, then an integer division with the '/' operator will +% produce this message, because the result will then be of type real. +type_e_strict_var_string_violation=04016_E_String types have to match exactly in $V+ mode +% When compiling in \var{\{\$V+\}} mode, the string you pass as a parameter +% should be of the exact same type as the declared parameter of the procedure. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_succ or pred on enums with assignments not possible +% If you declare an enumeration type which has C-like assignments +% in it, such as in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% then you cannot use the \var{Succ} or \var{Pred} functions with this enumeration. +type_e_cant_read_write_type=04018_E_Can't read or write variables of this type +% You are trying to \var{read} or \var{write} a variable from or to a +% file of type text, which doesn't support that variable's type. +% Only integer types, reals, pchars and strings can be read from or +% written to a text file. Booleans can only be written to text files. +type_e_no_readln_writeln_for_typed_file=04019_E_Can't use readln or writeln on typed file +% \var{readln} and \var{writeln} are only allowed for text files. +type_e_no_read_write_for_untyped_file=04020_E_Can't use read or write on untyped file. +% \var{read} and \var{write} are only allowed for text or typed files. +type_e_typeconflict_in_set=04021_E_Type conflict between set elements +% There is at least one set element which is of the wrong type, i.e. not of +% the set type. +type_w_maybe_wrong_hi_lo=04022_W_lo/hi(dword/qword) returns the upper/lower word/dword +% \fpc supports an overloaded version of \var{lo/hi} for \var{longint/dword/int64/qword} +% which returns the lower/upper word/dword of the argument. \tp always uses +% a 16 bit \var{lo/hi} which always returns bits 0..7 for \var{lo} and the +% bits 8..15 for \var{hi}. If you want the \tp behavior you have +% to type cast the argument to a \var{word} or \var{integer}. +type_e_integer_or_real_expr_expected=04023_E_Integer or real expression expected +% The first argument to \var{str} must be a real or integer type. +type_e_wrong_type_in_array_constructor=04024_E_Wrong type "$1" in array constructor +% You are trying to use a type in an array constructor which is not +% allowed. +type_e_wrong_parameter_type=04025_E_Incompatible type for arg no. $1: Got "$2", expected "$3" +% You are trying to pass an invalid type for the specified parameter. +type_e_no_method_and_procedure_not_compatible=04026_E_Method (variable) and Procedure (variable) are not compatible +% You can't assign a method to a procedure variable or a procedure to a +% method pointer. +type_e_wrong_math_argument=04027_E_Illegal constant passed to internal math function +% The constant argument passed to a \var{ln} or \var{sqrt} function is out of +% the definition range of these functions. +type_e_no_addr_of_constant=04028_E_Can't take the address of constant expressions +% It is not possible to get the address of a constant expression, because they +% aren't stored in memory. You can try making it a typed constant. This error +% can also be displayed if you try to pass a property to a var parameter. +type_e_argument_cant_be_assigned=04029_E_Argument can't be assigned to +% Only expressions which can be on the left side of an +% assignment can be passed as call by reference arguments. +% +% Remark: Properties can be used on the left side of an assignment, +% nevertheless they cannot be used as arguments. +type_e_cannot_local_proc_to_procvar=04030_E_Can't assign local procedure/function to procedure variable +% It's not allowed to assign a local procedure/function to a +% procedure variable, because the calling convention of a local procedure/function is +% different. You can only assign local procedure/function to a void pointer. +type_e_no_assign_to_addr=04031_E_Can't assign values to an address +% It is not allowed to assign a value to an address of a variable, constant, +% procedure or function. You can try compiling with -So if the identifier +% is a procedure variable. +type_e_no_assign_to_const=04032_E_Can't assign values to const variable +% It's not allowed to assign a value to a variable which is declared +% as a const. This is normally a parameter declared as const. To allow +% changing the value, pass the parameter by value, or a parameter by reference +% (using var). +type_e_array_required=04033_E_Array type required +% If you are accessing a variable using an index '[<x>]' then +% the type must be an array. In FPC mode a pointer is also allowed. +type_e_interface_type_expected=04034_E_interface type expected, but got "$1" +% The compiler expected to encounter an interface type name, but got something else. +% The following code would produce this error: +% \begin{verbatim} +% Type +% TMyStream = Class(TStream,Integer) +% \end{verbatim} +type_h_mixed_signed_unsigned=04035_H_Mixing signed expressions and longwords gives a 64bit result +% If you divide (or calculate the modulus of) a signed expression by a longword (or vice versa), +% or if you have overflow and/or range checking turned on and use an arithmetic +% expression (+, -, *, div, mod) in which both signed numbers and longwords appear, +% then everything has to be evaluated in 64-bit arithmetic which is slower than normal +% 32-bit arithmetic. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_w_mixed_signed_unsigned2=04036_W_Mixing signed expressions and cardinals here may cause a range check error +% If you use a binary operator (and, or, xor) and one of +% the operands is a longword while the other one is a signed expression, then, +% if range checking is turned on, you may get a range check error because in +% such a case both operands are converted to longword before the operation is +% carried out. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_e_typecast_wrong_size_for_assignment=04037_E_Typecast has different size ($1 -> $2) in assignment +% Type casting to a type with a different size is not allowed when the variable is +% used in an assignment. +type_e_array_index_enums_with_assign_not_possible=04038_E_enums with assignments can't be used as array index +% When you declared an enumeration type which has C-like +% assignments, such as in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use it as the index of an array. +type_e_classes_not_related=04039_E_Class or Object types "$1" and "$2" are not related +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors. +type_w_classes_not_related=04040_W_Class types "$1" and "$2" are not related +% There is a typecast from one class to another while the classes +% are not related. This will probably lead to errors. +type_e_class_or_interface_type_expected=04041_E_Class or interface type expected, but got "$1" +% The compiler expected a class or interface name, but got another type or identifier. +type_e_type_is_not_completly_defined=04042_E_Type "$1" is not completely defined +% This error occurs when a type is not complete: i.e. a pointer type which points to +% an undefined type. +type_w_string_too_long=04043_W_String literal has more characters than short string length +% The size of the constant string, which is assigned to a shortstring, +% is longer than the maximum size of the shortstring (255 characters). +type_w_comparison_always_false=04044_W_Comparison might be always false due to range of constant and expression +% There is a comparison between a constant and an expression where the constant is out of the +% valid range of values of the expression. Because of type promotion, the statement will always evaluate to +% false. Explicitly typecast the constant or the expression to the correct range to avoid this warning +% if you think the code is correct. +type_w_comparison_always_true=04045_W_Comparison might be always true due to range of constant and expression +% There is a comparison between a constant and an expression where the constant is out of the +% valid range of values of the expression. Because of type promotion, the statement will always evaluate to +% true. Explicitly typecast the constant or the expression to the correct range to avoid this warning +% if you think the code is correct. +type_w_instance_with_abstract=04046_W_Constructing a class "$1" with abstract method "$2" +% An instance of a class is created which contains non-implemented abstract +% methods. This will probably lead to a runtime error 211 in the code if that +% routine is ever called. All abstract methods should be overridden. +type_h_in_range_check=04047_H_The left operand of the IN operator should be byte sized +% The left operand of the \var{in} operator is not an ordinal or enumeration which fits +% within 8 bits. This may lead to range check errors. The \var{in} operator +% currently only supports a left operand which fits within a byte. In the case of +% enumerations, the size of an element of an enumeration can be controlled with +% the \var{\{\$PACKENUM\}} or \var{\{\$Zn\}} switches. +type_w_smaller_possible_range_check=04048_W_Type size mismatch, possible loss of data / range check error +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_h_smaller_possible_range_check=04049_H_Type size mismatch, possible loss of data / range check error +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_e_cant_take_address_of_abstract_method=04050_E_The address of an abstract method can't be taken +% An abstract method has no body, so the address of an abstract method can't be taken. +type_e_assignment_not_allowed=04051_E_Assignments to formal parameters and open arrays are not possible +% You are trying to assign a value to a formal (untyped var, const or out) +% parameter, or to an open array. +type_e_constant_expr_expected=04052_E_Constant Expression expected +% The compiler expects an constant expression, but gets a variable expression. +type_e_operator_not_supported_for_types=04053_E_Operation "$1" not supported for types "$2" and "$3" +% The operation is not allowed for the supplied types. +type_e_illegal_type_conversion=04054_E_Illegal type conversion: "$1" to "$2" +% When doing a type-cast, you must take care that the sizes of the variable and +% the destination type are the same. +type_h_pointer_to_longint_conv_not_portable=04055_H_Conversion between ordinals and pointers is not portable +% If you typecast a pointer to a longint (or vice-versa), this code will not compile +% on a machine using 64 bits addressing. +type_w_pointer_to_longint_conv_not_portable=04056_W_Conversion between ordinals and pointers is not portable +% If you typecast a pointer to an ordinal type of a different size (or vice-versa), this can +% cause problems. This is a warning to help in finding the 32-bit specific code where cardinal/longint is used +% to typecast pointers to ordinals. A solution is to use the ptrint/ptruint types instead. +type_e_cant_choose_overload_function=04057_E_Can't determine which overloaded function to call +% You're calling overloaded functions with a parameter that doesn't correspond +% to any of the declared function parameter lists. e.g. when you have declared +% a function with parameters \var{word} and \var{longint}, and then you call +% it with a parameter which is of type \var{integer}. +type_e_illegal_count_var=04058_E_Illegal counter variable +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +type_w_double_c_varargs=04059_W_Converting constant real value to double for C variable argument, add explicit typecast to prevent this. +% In C, constant real values are double by default. For this reason, if you +% pass a constant real value to a variable argument part of a C function, FPC +% by default converts this constant to double as well. If you want to prevent +% this from happening, add an explicit typecast around the constant. +type_e_class_or_cominterface_type_expected=04060_E_Class or COM interface type expected, but got "$1" +% Some operators, such as the AS operator, are only applicable to classes or COM interfaces. +type_e_no_const_packed_array=04061_E_Constant packed arrays are not yet supported +% You cannot declare a (bit)packed array as a typed constant. +type_e_got_expected_packed_array=04062_E_Incompatible type for arg no. $1: Got "$2" expected "(Bit)Packed Array" +% The compiler expects a (bit)packed array as the specified parameter. +type_e_got_expected_unpacked_array=04063_E_Incompatible type for arg no. $1: Got "$2" expected "(not packed) Array" +% The compiler expects a regular (i.e., not packed) array as the specified parameter. +type_e_no_packed_inittable=04064_E_Elements of packed arrays cannot be of a type which need to be initialised +% Support for packed arrays of types that need initialization +% (such as ansistrings, or records which contain ansistrings) is not yet implemented. +type_e_no_const_packed_record=04065_E_Constant packed records and objects are not yet supported +% You cannot declare a (bit)packed array as a typed constant at this time. +type_w_untyped_arithmetic_unportable=04066_W_Arithmetic "$1" on untyped pointer is unportable to {$T+}, suggest typecast +% Addition/subtraction from an untyped pointer may work differently in \var{\{\$T+\}}. +% Use a typecast to a typed pointer. +type_e_cant_take_address_of_local_subroutine=04076_E_Can't take address of a subroutine marked as local +% The address of a subroutine marked as local can't be taken. +type_e_cant_export_local=04077_E_Can't export subroutine marked as local from a unit +% A subroutine marked as local can't be exported from a unit. +type_e_not_automatable=04078_E_Type is not automatable: "$1" +% Only byte, integer, longint, smallint, currency, single, double, ansistring, +% widestring, tdatetime, variant, olevariant, wordbool and all interfaces are automatable. +type_h_convert_add_operands_to_prevent_overflow=04079_H_Converting the operands to "$1" before doing the add could prevent overflow errors. +% Adding two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the addition. +type_h_convert_sub_operands_to_prevent_overflow=04080_H_Converting the operands to "$1" before doing the subtract could prevent overflow errors. +% Subtracting two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the subtraction. +type_h_convert_mul_operands_to_prevent_overflow=04081_H_Converting the operands to "$1" before doing the multiply could prevent overflow errors. +% Multiplying two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the multiplication. +type_w_pointer_to_signed=04082_W_Converting pointers to signed integers may result in wrong comparison results and range errors, use an unsigned type instead. +% The virtual address space on 32-bit machines runs from \$00000000 to \$ffffffff. +% Many operating systems allow you to allocate memory above \$80000000. +% For example both \windows and \linux allow pointers in the range \$0000000 to \$bfffffff. +% If you convert pointers to signed types, this can cause overflow and range check errors, +% but also \$80000000 < \$7fffffff. This can cause random errors in code like "if p>q". +type_e_interface_has_no_guid=04083_E_Interface type $1 has no valid GUID +% When applying the as-operator to an interface or class, the desired interface (i.e. the right operand of the +% as-operator) must have a valid GUID. +type_e_invalid_objc_selector_name=04084_E_Invalid selector name "$1" +% An Objective-C selector cannot be empty, must be a valid identifier or a single colon, +% and if it contains at least one colon it must also end in one. +type_e_expected_objc_method_but_got=04085_E_Expected Objective-C method, but got $1 +% A selector can only be created for Objective-C methods, not for any other kind +% of procedure/function/method. +type_e_expected_objc_method=04086_E_Expected Objective-C method or constant method name +% A selector can only be created for Objective-C methods, either by specifying +% the name using a string constant, or by using an Objective-C method identifier +% that is visible in the current scope. +type_e_no_type_info=04087_E_No type info available for this type +% Type information is not generated for some types, such as enumerations with gaps +% in their value range (this includes enumerations whose lower bound is different +% from zero). +type_e_ordinal_or_string_expr_expected=04088_E_Ordinal or string expression expected +% The expression must be an ordinal or string type. +type_e_string_expr_expected=04089_E_String expression expected +% The expression must be a string type. +type_w_zero_to_nil=04090_W_Converting 0 to NIL +% Use NIL rather than 0 when initialising a pointer. +type_e_protocol_type_expected=04091_E_Objective-C protocol type expected, but got "$1" +% The compiler expected a protocol type name, but found something else. +type_e_objc_type_unsupported=04092_E_The type "$1" is not supported for interaction with the Objective-C runtime. +% Objective-C makes extensive use of run time type information (RTTI). This format +% is defined by the maintainers of the run time and can therefore not be adapted +% to all possible Object Pascal types. In particular, types that depend on +% reference counting by the compiler (such as ansistrings and certain kinds of +% interfaces) cannot be used as fields of Objective-C classes, cannot be +% directly passed to Objective-C methods, and cannot be encoded using \var{objc\_encode}. +type_e_class_or_objcclass_type_expected=04093_E_Class or objcclass type expected, but got "$1" +% It is only possible to create class reference types of \var{class} and \var{objcclass} +type_e_objcclass_type_expected=04094_E_Objcclass type expected +% The compiler expected an \var{objcclass} type +type_w_procvar_univ_conflicting_para=04095_W_Coerced univ parameter type in procedural variable may cause crash or memory corruption: $1 to $2 +% \var{univ} parameters are implicitly compatible with all types of the same size, +% also in procedural variable definitions. That means that the following code is +% legal, because \var{single} and \var{longint} have the same size: +% \begin{verbatim} +% {$mode macpas} +% Type +% TIntProc = procedure (l: univ longint); +% +% procedure test(s: single); +% begin +% writeln(s); +% end; +% +% var +% p: TIntProc; +% begin +% p:=test; +% p(4); +% end. +% \end{verbatim} +% This code may however crash on platforms that pass integers in registers and +% floating point values on the stack, because then the stack will be unbalanced. +% Note that this warning will not flagg all potentially dangerous situations. +% when \var{test} returns. +type_e_generics_cannot_reference_itself=04096_E_Type parameters of specializations of generics cannot reference the currently specialized type +% Recursive specializations of generics like \var{Type MyType = specialize MyGeneric<MyType>;} are not possible. +type_e_type_parameters_are_not_allowed_here=04097_E_Type parameters are not allowed on non-generic class/record/object procedure or function +% Type parameters are only allowed for methods of generic classes, records or objects +type_e_generic_declaration_does_not_match=04098_E_Generic declaration of "$1" differs from previous declaration +% Generic declaration does not match the previous declaration +type_e_helper_type_expected=04099_E_Helper type expected +% The compiler expected a \var{class helper} type. +type_e_record_type_expected=04100_E_Record type expected +% The compiler expected a \var{record} type. +type_e_class_helper_must_extend_subclass=04101_E_Derived class helper must extend a subclass of "$1" or the class itself +% If a class helper inherits from another class helper the extended class must +% extend either the same class as the parent class helper or a subclass of it +type_e_record_helper_must_extend_same_record=04102_E_Derived record helper must extend "$1" +% If a record helper inherits from another record helper it must extend the same +% record that the parent record helper extended. +type_e_procedures_return_no_value=04103_E_Invalid assignment, procedures return no value +% This error occurs when one tries to assign the result of a procedure or destructor call. +% A procedure or destructor returns no value so this is not +% possible. +type_w_implicit_string_cast=04104_W_Implicit string type conversion from "$1" to "$2" +% An implicit type conversion from an ansi string type to an unicode string type is +% encountered. To avoid this warning perform an explicit type conversion. +type_w_implicit_string_cast_loss=04105_W_Implicit string type conversion with potential data loss from "$1" to "$2" +% An implicit type conversion from an unicode string type to an ansi string type is +% encountered. This conversion can lose data since not all unicode characters may be represented in the codepage of +% destination string type. +type_w_explicit_string_cast=04106_-W_Explicit string typecast from "$1" to "$2" +% An explicit typecast from an ansi string type to an unicode string type is +% encountered. This warning is off by default. You can turn it on to see all suspicious string conversions. +type_w_explicit_string_cast_loss=04107_-W_Explicit string typecast with potential data loss from "$1" to "$2" +% An explicit typecast from an unicode string type to an ansi string type is +% encountered. This conversion can lose data since not all unicode characters may be represented in the codepage of +% destination string type. This warning is off by default. You can turn it on to see all the places with lossy string +% conversions. +type_w_unicode_data_loss=04108_W_Unicode constant cast with potential data loss +% Conversion from a WideChar to AnsiChar can lose data since now all unicode characters may be represented in the current +% system codepage +% \end{description} +# +# Symtable +# +# 05084 is the last used one +# +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedure and variable names. +% \begin{description} +sym_e_id_not_found=05000_E_Identifier not found "$1" +% The compiler doesn't know this symbol. Usually happens when you misspell +% the name of a variable or procedure, or when you forget to declare a +% variable. +sym_f_internal_error_in_symtablestack=05001_F_Internal Error in SymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_Duplicate identifier "$1" +% The identifier was already declared in the current scope. +sym_h_duplicate_id_where=05003_H_Identifier already defined in $1 at line $2 +% The identifier was already declared in a previous scope. +sym_e_unknown_id=05004_E_Unknown identifier "$1" +% The identifier encountered has not been declared, or is used outside the +% scope where it is defined. +sym_e_forward_not_resolved=05005_E_Forward declaration not solved "$1" +% This can happen in two cases: +% \begin{itemize} +% \item You declare a function in the \var{interface} part, or +% with a \var{forward} directive, but do not implement it. +% \item You reference a type which isn't declared in the current \var{type} +% block. +% \end{itemize} +sym_e_error_in_type_def=05007_E_Error in type definition +% There is an error in your definition of a new array type. +% One of the range delimiters in an array declaration is erroneous. +% For example, \var{Array [1..1.25]} will trigger this error. +sym_e_forward_type_not_resolved=05009_E_Forward type not resolved "$1" +% A symbol was forward defined, but no declaration was encountered. +sym_e_only_static_in_static=05010_E_Only static variables can be used in static methods or outside methods +% A static method of an object can only access static variables. +sym_f_type_must_be_rec_or_class=05012_F_record or class type expected +% The variable or expression isn't of the type \var{record} or \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_Instances of classes or objects with an abstract method are not allowed +% You are trying to generate an instance of a class which has an abstract +% method that wasn't overridden. +sym_w_label_not_defined=05014_W_Label not defined "$1" +% A label was declared, but not defined. +sym_e_label_used_and_not_defined=05015_E_Label used but not defined "$1" +% A label was declared and used, but not defined. +sym_e_ill_label_decl=05016_E_Illegal label declaration +% This error should never happen; it occurs if a label is defined outside a +% procedure or function. +sym_e_goto_and_label_not_supported=05017_E_GOTO and LABEL are not supported (use switch -Sg) +% You must use the -Sg switch to compile a program which has \var{label}s +% and \var{goto} statements. By default, \var{label} and \var{goto} aren't +% supported. +sym_e_label_not_found=05018_E_Label not found +% A \var{goto label} was encountered, but the label wasn't declared. +sym_e_id_is_no_label_id=05019_E_identifier isn't a label +% The identifier specified after the \var{goto} isn't of type label. +sym_e_label_already_defined=05020_E_label already defined +% You are defining a label twice. You can define a label only once. +sym_e_ill_type_decl_set=05021_E_illegal type declaration of set elements +% The declaration of a set contains an invalid type definition. +sym_e_class_forward_not_resolved=05022_E_Forward class definition not resolved "$1" +% You declared a class, but you did not implement it. +sym_n_unit_not_used=05023_H_Unit "$1" not used in $2 +% The unit referenced in the \var{uses} clause is not used. +sym_h_para_identifier_not_used=05024_H_Parameter "$1" not used +% The identifier was declared (locally or globally) but +% was not used (locally or globally). +sym_n_local_identifier_not_used=05025_N_Local variable "$1" not used +% You have declared, but not used, a variable in a procedure or function +% implementation. +sym_h_para_identifier_only_set=05026_H_Value parameter "$1" is assigned but never used +% The identifier was declared (locally or globally) and +% assigned to, but is not used (locally or globally) after the assignment. +sym_n_local_identifier_only_set=05027_N_Local variable "$1" is assigned but never used +% The variable in a procedure or function implementation is declared and +% assigned to, but is not used after the assignment. +sym_h_local_symbol_not_used=05028_H_Local $1 "$2" is not used +% A local symbol is never used. +sym_n_private_identifier_not_used=05029_N_Private field "$1.$2" is never used +% The indicated private field is defined, but is never used in the code. +sym_n_private_identifier_only_set=05030_N_Private field "$1.$2" is assigned but never used +% The indicated private field is declared and assigned to, but never read. +sym_n_private_method_not_used=05031_N_Private method "$1.$2" never used +% The indicated private method is declared but is never used in the code. +sym_e_set_expected=05032_E_Set type expected +% The variable or expression is not of type \var{set}. This happens in an +% \var{in} statement. +sym_w_function_result_not_set=05033_W_Function result does not seem to be set +% You can get this warning if the compiler thinks that a function return +% value is not set. This will not be displayed for assembler procedures, +% or procedures that contain assembler blocks. +sym_w_wrong_C_pack=05034_W_Type "$1" is not aligned correctly in current record for C +% Arrays with sizes not multiples of 4 will be wrongly aligned +% for C structures. +sym_e_illegal_field=05035_E_Unknown record field identifier "$1" +% The field doesn't exist in the record/object definition. +sym_w_uninitialized_local_variable=05036_W_Local variable "$1" does not seem to be initialized +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assignment). +sym_w_uninitialized_variable=05037_W_Variable "$1" does not seem to be initialized +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assignment). +sym_e_id_no_member=05038_E_identifier idents no member "$1" +% This error is generated when an identifier of a record, +% field or method is accessed while it is not defined. +sym_h_param_list=05039_H_Found declaration: $1 +% You get this when you use the \var{-vh} switch.In the case of an overloaded procedure +% not being found. Then all candidate overloaded procedures are +% listed, with their parameter lists. +sym_e_segment_too_large=05040_E_Data element too large +% You get this when you declare a data element whose size exceeds the +% prescribed limit (2 Gb on 80386+/68020+ processors). +sym_e_no_matching_implementation_found=05042_E_No matching implementation for interface method "$1" found +% There was no matching method found which could implement the interface +% method. Check argument types and result type of the methods. +sym_w_deprecated_symbol=05043_W_Symbol "$1" is deprecated +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Use of this symbol +% should be avoided as much as possible. +sym_w_non_portable_symbol=05044_W_Symbol "$1" is not portable +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{platform} is used. This symbol's value, use +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_non_implemented_symbol=05055_W_Symbol "$1" is not implemented +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{unimplemented} is used. This symbol is defined, +% but is not yet implemented on this specific platform. +sym_e_cant_create_unique_type=05056_E_Can't create unique type from this type +% Only simple types like ordinal, float and string types are supported when +% redefining a type with \var{type newtype = type oldtype;}. +sym_h_uninitialized_local_variable=05057_H_Local variable "$1" does not seem to be initialized +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. it did not appear in the left-hand side of an +% assignment). +sym_h_uninitialized_variable=05058_H_Variable "$1" does not seem to be initialized +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. t did not appear in the left-hand side of an +% assignment). +sym_w_function_result_uninitialized=05059_W_Function result variable does not seem to initialized +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. it appears in the right-hand side of an expression) +% before it is initialized (i.e. before it appeared in the left-hand side of an +% assignment). +sym_h_function_result_uninitialized=05060_H_Function result variable does not seem to be initialized +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. it appears in the right-hand side of an expression) +% before it is initialized (i.e. it appears in the left-hand side of an +% assignment) +sym_w_identifier_only_read=05061_W_Variable "$1" read but nowhere assigned +% You have read the value of a variable, but nowhere assigned a value to +% it. +sym_h_abstract_method_list=05062_H_Found abstract method: $1 +% When getting a warning about constructing a class/object with abstract methods +% you get this hint to assist you in finding the affected method. +sym_w_experimental_symbol=05063_W_Symbol "$1" is experimental +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{experimental} is used. Experimental symbols +% might disappear or change semantics in future versions. Usage of this symbol +% should be avoided as much as possible. +sym_w_forward_not_resolved=05064_W_Forward declaration "$1" not resolved, assumed external +% This happens if you declare a function in the \var{interface} of a unit in macpas mode, +% but do not implement it. +sym_w_library_symbol=05065_W_Symbol "$1" is belongs to a library +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{library} is used. Library symbols may not be +% available in other libraries. +sym_w_deprecated_symbol_with_msg=05066_W_Symbol "$1" is deprecated: "$2" +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Use of this symbol +% should be avoided as much as possible. +sym_e_no_enumerator=05067_E_Cannot find an enumerator for the type "$1" +% This means that compiler cannot find an apropriate enumerator to use in the for-in loop. +% To create an enumerator you need to defind an operator enumerator or add a public or published +% GetEnumerator method to the class or object definition. +sym_e_no_enumerator_move=05068_E_Cannot find a "MoveNext" method in enumerator "$1" +% This means that compiler cannot find a public MoveNext method with the Boolean return type in +% the enumerator class or object definition. +sym_e_no_enumerator_current=05069_E_Cannot find a "Current" property in enumerator "$1" +% This means that compiler cannot find a public Current property in the enumerator class or object +% definition. +sym_e_objc_para_mismatch=05070_E_Mismatch between number of declared parameters and number of colons in message string. +% In Objective-C, a message name automatically contains as many colons as parameters. +% In order to prevent mistakes when specifying the message name in FPC, the compiler +% checks whether this is also the case here. Note that in case of messages taking a +% variable number of arguments translated to FPC via an \var{array of const} parameter, +% this final \var{array of const} parameter is not counted. Neither are the hidden +% \var{self} and \var{\_cmd} parameters. +sym_n_private_type_not_used=05071_N_Private type "$1.$2" never used +% The indicated private type is declared but is never used in the code. +sym_n_private_const_not_used=05072_N_Private const "$1.$2" never used +% The indicated private const is declared but is never used in the code. +sym_n_private_property_not_used=05073_N_Private property "$1.$2" never used +% The indicated private property is declared but is never used in the code. +sym_w_deprecated_unit=05074_W_Unit "$1" is deprecated +% This means that a unit which is +% declared as \var{deprecated} is used. Deprecated units may no longer +% be available in newer versions of the library. Use of this unit +% should be avoided as much as possible. +sym_w_deprecated_unit_with_msg=05075_W_Unit "$1" is deprecated: "$2" +% This means that a unit which is +% declared as \var{deprecated} is used. Deprecated units may no longer +% be available in newer versions of the library. Use of this unit +% should be avoided as much as possible. +sym_w_non_portable_unit=05076_W_Unit "$1" is not portable +% This means that a unit which is +% declared as \var{platform} is used. This unit use +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_library_unit=05077_W_Unit "$1" is belongs to a library +% This means that a unit which is +% declared as \var{library} is used. Library units may not be +% available in other libraries. +sym_w_non_implemented_unit=05078_W_Unit "$1" is not implemented +% This means that a unit which is +% declared as \var{unimplemented} is used. This unit is defined, +% but is not yet implemented on this specific platform. +sym_w_experimental_unit=05079_W_Unit "$1" is experimental +% This means that a unit which is +% declared as \var{experimental} is used. Experimental units +% might disappear or change semantics in future versions. Usage of this unit +% should be avoided as much as possible. +sym_e_objc_formal_class_not_resolved=05080_E_No complete definition of the formally declared objcclass "$1" is in scope +% Objecive-C classes can be imported formally, without using the the unit in which it is fully declared. +% This enables making forward references to such classes and breaking circular dependencies amongst units. +% However, as soon as you wish to actually do something with an entity of this class type (such as +% access one of its fields, send a message to it, or use it to inherit from), the compiler requires the full definition +% of the class to be in scope. +sym_e_interprocgoto_into_init_final_code_not_allowed=05081_E_Gotos into initialization or finalization blocks of units are not allowed +% Gotos into initialization or finalization blockse of units are not allowed. +sym_e_external_class_name_mismatch1=05082_E_Invalid external name "$1" for formal class "$2" +sym_e_external_class_name_mismatch2=05083_E_Complete class definition with external name "$1" here +% When a class is declared using a formal external definition, the actual external +% definition (if any) must specify the same external name as the formal definition +% (since both definitions refer to the same actual class type). +sym_w_library_overload=05084_W_Possible library conflict: symbol "$1" from library "$2" also found in library "$3" +% Some OS do not have library specific namespaces, for those +% OS, the function declared as "external 'libname' name 'funcname'", +% the 'libname' part is only a hint, funcname might also be loaded +% by another library. This warning appears if 'funcname' is used twice +% with two different library names. +% +% \end{description} +# +# Codegenerator +# +# 06049 is the last used one +# +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +cg_e_parasize_too_big=06009_E_Parameter list size exceeds 65535 bytes +% The I386 processor limits the parameter list to 65535 bytes. (The \var{RET} +% instruction causes this.) +cg_e_file_must_call_by_reference=06012_E_File types must be var parameters +% You cannot specify files as value parameters, i.e., they must always be +% declared \var{var} parameters. +cg_e_cant_use_far_pointer_there=06013_E_The use of a far pointer isn't allowed there +% Free Pascal doesn't support far pointers, so you cannot take the address of +% an expression which has a far reference as a result. The \var{mem} construct +% has a far reference as a result, so the following code will produce this +% error: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_EXPORT declared functions can't be called +% No longer in use. +cg_w_member_cd_call_from_method=06016_W_Possible illegal call of constructor or destructor +% The compiler detected that a constructor or destructor is called within a +% a method. This will probably lead to problems, since constructors / destructors +% require parameters on entry. +cg_n_inefficient_code=06017_N_Inefficient code +% Your statement seems dubious to the compiler. +cg_w_unreachable_code=06018_W_unreachable code +% You specified a construct which will never be executed. Example: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_Abstract methods can't be called directly +% You cannot call an abstract method directly. Instead, you must call an +% overriding child method, because an abstract method isn't implemented. +cg_d_register_weight=06027_DL_Register $1 weight $2 $3 +% Debugging message. Shown when the compiler considers a variable for +% keeping in the registers. +cg_d_stackframe_omited=06029_DL_Stack frame is omitted +% Some procedure/functions do not need a complete stack-frame, so it is omitted. +% This message will be displayed when the {-vd} switch is used. +cg_e_unable_inline_object_methods=06031_E_Object or class methods can't be inline. +% You cannot have inlined object methods. +cg_e_unable_inline_procvar=06032_E_Procvar calls cannot be inline. +% A procedure with a procedural variable call cannot be inlined. +cg_e_no_code_for_inline_stored=06033_E_No code for inline procedure stored +% The compiler couldn't store code for the inline procedure. +cg_e_can_access_element_zero=06035_E_Element zero of an ansi/wide- or longstring can't be accessed, use (set)length instead +% You should use \var{setlength} to set the length of an ansi/wide/longstring +% and \var{length} to get the length of such string type. +cg_e_cannot_call_cons_dest_inside_with=06037_E_Constructors or destructors cannot be called inside a 'with' clause +% Inside a \var{with} clause you cannot call a constructor or destructor for the +% object you have in the \var{with} clause. +cg_e_cannot_call_message_direct=06038_E_Cannot call message handler methods directly +% A message method handler method cannot be called directly if it contains an +% explicit \var{Self} argument. +cg_e_goto_inout_of_exception_block=06039_E_Jump in or outside of an exception block +% It is not allowed to jump in or outside of an exception block like \var{try..finally..end;}. +% For example, the following code will produce this error: + +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // this line will cause an error +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_Control flow statements aren't allowed in a finally block +% It isn't allowed to use the control flow statements \var{break}, +% \var{continue} and \var{exit} +% inside a finally statement. The following example shows the problem: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // This exit ISN'T allowed +% end; +% ... +% +% \end{verbatim} +% If the procedure \var{p} raises an exception the finally block is +% executed. If the execution reaches the exit, it's unclear what to do: +% exit the procedure or search for another exception handler. +cg_w_parasize_too_big=06041_W_Parameters size exceeds limit for certain cpu's +% This indicates that you are declaring more than 64K of parameters, which +% might not be supported on other processor targets. +cg_w_localsize_too_big=06042_W_Local variable size exceed limit for certain cpu's +% This indicates that you are declaring more than 32K of local variables, which +% might not be supported on other processor targets. +cg_e_localsize_too_big=06043_E_Local variables size exceeds supported limit +% This indicates that you are declaring more than 32K of local variables, which +% is not supported by this processor. +cg_e_break_not_allowed=06044_E_BREAK not allowed +% You're trying to use \var{break} outside a loop construction. +cg_e_continue_not_allowed=06045_E_CONTINUE not allowed +% You're trying to use \var{continue} outside a loop construction. +cg_f_unknown_compilerproc=06046_F_Unknown compilerproc "$1". Check if you use the correct run time library. +% The compiler expects that the runtime library contains certain subroutines. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the compiler in use. If you changed the runtime library this error means +% that you removed a subroutine which the compiler needs for internal use. +cg_f_unknown_system_type=06047_F_Cannot find system type "$1". Check if you use the correct run time library. +% The compiler expects that the runtime library contains certain type definitions. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the compiler in use. If you changed the runtime library this error means +% that you removed a type which the compiler needs for internal use. +cg_h_inherited_ignored=06048_H_Inherited call to abstract method ignored +% This message appears only in Delphi mode when you call an abstract method +% of a parent class via \var{inherited;}. The call is then ignored. +cg_e_goto_label_not_found=06049_E_Goto label "$1" not defined or optimized away +% The label used in the goto definition is not defined or optimized away by the +% unreachable code elemination. +cg_f_unknown_type_in_unit=06050_F_Cannot find type "$1" in unit "$2". Check if you use the correct run time library. +% The compiler expects that the runtime library contains certain type definitions. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the compiler in use. If you changed the runtime library this error means +% that you removed a type which the compiler needs for internal use. +cg_e_interprocedural_goto_only_to_outer_scope_allowed=06051_E_Interprocedural gotos are allowed only to outer subroutines +% Gotos between subroutines are only allowed if the goto jumps from an inner to an outer subroutine or +% from a subroutine to the main program +cg_e_labels_cannot_defined_outside_declaration_scope=06052_E_Label must be defined in the same scope as it is declared +% In ISO mode, labels must be defined in the same scope as they are declared. +cg_e_goto_across_procedures_with_exceptions_not_allowed=06053_E_Leaving procedures containing explicit or implicit exceptions frames using goto is not allowed +% Non-local gotos might not be used to leave procedures using exceptions either implicitly or explicitly. Procedures +% which use automated types like ansistrings or class constructurs are affected by this too. +cg_e_mod_only_defined_for_pos_quotient=06054_E_In ISO mode, the mod operator is defined only for positive quotient +% In ISO pascal, only positive values are allowed for the quotient: \var{n mod m} is only valid if \var{m>0}. +% \end{description} +# EndOfTeX + +# +# Assembler reader +# +# 07110 is the last used one +# +asmr_d_start_reading=07000_DL_Starting $1 styled assembler parsing +% This informs you that an assembler block is being parsed +asmr_d_finish_reading=07001_DL_Finished $1 styled assembler parsing +% This informs you that an assembler block has finished. +asmr_e_none_label_contain_at=07002_E_Non-label pattern contains @ +% A identifier which isn't a label can't contain a @. +asmr_e_building_record_offset=07004_E_Error building record offset +% There has an error occured while building the offset of a record/object +% structure, this can happend when there is no field specified at all or +% an unknown field identifier is used. +asmr_e_offset_without_identifier=07005_E_OFFSET used without identifier +% You can only use OFFSET with an identifier. Other syntaxes aren't +% supported +asmr_e_type_without_identifier=07006_E_TYPE used without identifier +% You can only use TYPE with an identifier. Other syntaxes aren't +% supported +asmr_e_no_local_or_para_allowed=07007_E_Cannot use local variable or parameters here +% You can't use a local variable or parameter here, mostly because the +% addressing of locals and parameters is done using the frame pointer register so the +% address can't be obtained directly. +asmr_e_need_offset=07008_E_need to use OFFSET here +% You need to use OFFSET <id> here to get the address of the identifier. +asmr_e_need_dollar=07009_E_need to use $ here +% You need to use $<id> here to get the address of the identifier. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_Cannot use multiple relocatable symbols +% You can't have more than one relocatable symbol (variable/typed constant) +% in one argument. +asmr_e_only_add_relocatable_symbol=07011_E_Relocatable symbol can only be added +% Relocatable symbols (variable/typed constant) can't be used with other +% operators. Only addition is allowed. +asmr_e_invalid_constant_expression=07012_E_Invalid constant expression +% There is an error in the constant expression. +asmr_e_relocatable_symbol_not_allowed=07013_E_Relocatable symbol is not allowed +% You can't use a relocatable symbol (variable/typed constant) here. +asmr_e_invalid_reference_syntax=07014_E_Invalid reference syntax +% There is an error in the reference. +asmr_e_local_para_unreachable=07015_E_You cannot reach $1 from that code +% You cannot read directly the value of a local variable or parameter +% of a higher level procedure in assembler code (except for +% local assembler code without parameter nor locals). +asmr_e_local_label_not_allowed_as_ref=07016_E_Local symbols/labels aren't allowed as references +% You can't use local symbols/labels as references +asmr_e_wrong_base_index=07017_E_Invalid base and index register usage +% There is an error with the base and index register, they are +% probably incorrect +asmr_w_possible_object_field_bug=07018_W_Possible error in object field handling +% Fields of objects or classes can be reached directly in normal or objfpc +% modes but TP and Delphi modes treat the field name as a simple offset. +asmr_e_wrong_scale_factor=07019_E_Wrong scale factor specified +% The scale factor given is wrong, only 1,2,4 and 8 are allowed +asmr_e_multiple_index=07020_E_Multiple index register usage +% You are trying to use more than one index register +asmr_e_invalid_operand_type=07021_E_Invalid operand type +% The operand type doesn't match with the opcode used +asmr_e_invalid_string_as_opcode_operand=07022_E_Invalid string as opcode operand: $1 +% The string specified as operand is not correct with this opcode +asmr_w_CODE_and_DATA_not_supported=07023_W_@CODE and @DATA not supported +% @CODE and @DATA are unsupported and are ignored. +asmr_e_null_label_ref_not_allowed=07024_E_Null label references are not allowed +asmr_e_expr_zero_divide=07025_E_Divide by zero in asm evaluator +% There is a division by zero in a constant expression +asmr_e_expr_illegal=07026_E_Illegal expression +% There is an illegal expression in a constant expression +asmr_e_escape_seq_ignored=07027_E_escape sequence ignored: $1 +% There is a C-styled string, but the escape sequence in the string +% is unknown, and is therefore ignored +asmr_e_invalid_symbol_ref=07028_E_Invalid symbol reference +asmr_w_fwait_emu_prob=07029_W_Fwait can cause emulation problems with emu387 +asmr_w_fadd_to_faddp=07030_W_$1 without operand translated into $1P +asmr_w_enter_not_supported_by_linux=07031_W_ENTER instruction is not supported by Linux kernel +% ENTER instruction can generate a stack page fault that is not +% caught correctly by the i386 Linux page handler. +asmr_w_calling_overload_func=07032_W_Calling an overload function in assembler +% There is a call to an overloaded method in the assembler block, +% this might be the sign there is a problem +asmr_e_unsupported_symbol_type=07033_E_Unsupported symbol type for operand +asmr_e_constant_out_of_bounds=07034_E_Constant value out of bounds +asmr_e_error_converting_decimal=07035_E_Error converting decimal $1 +% A constant decimal value does not have the correct syntax +asmr_e_error_converting_octal=07036_E_Error converting octal $1 +% A constant octal value does not have the correct syntax +asmr_e_error_converting_binary=07037_E_Error converting binary $1 +% A constant binary value does not have the correct syntax +asmr_e_error_converting_hexadecimal=07038_E_Error converting hexadecimal $1 +% A constant hexadecimal value does not have the correct syntax +asmr_h_direct_global_to_mangled=07039_H_$1 translated to $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 is associated to an overloaded function +asmr_e_cannot_use_SELF_outside_a_method=07041_E_Cannot use SELF outside a method +% There is a reference to the \var{self} symbol while it is not +% allowed. \var{self} can only be referenced inside methods +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_Cannot use OLDEBP outside a nested procedure +% There is a reference to the \var{oldebp} symbol while it is not +% allowed. \var{oldebp} can only be referenced inside nested routines +asmr_e_void_function=07043_W_Procedures can't return any value in asm code +% Trying to return a value while in a procedure. A procedure +% does not have any return value +asmr_e_SEG_not_supported=07044_E_SEG not supported +asmr_e_size_suffix_and_dest_dont_match=07045_E_Size suffix and destination or source size do not match +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_w_size_suffix_and_dest_dont_match=07046_W_Size suffix and destination or source size do not match +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_e_syntax_error=07047_E_Assembler syntax error +% There is an assembler syntax error +asmr_e_invalid_opcode_and_operand=07048_E_Invalid combination of opcode and operands +% The opcode cannot be used with this type of operand +asmr_e_syn_operand=07049_E_Assembler syntax error in operand +asmr_e_syn_constant=07050_E_Assembler syntax error in constant +asmr_e_invalid_string_expression=07051_E_Invalid String expression +asmr_w_const32bit_for_address=07052_W_constant with symbol $1 for address which is not on a pointer +% A constant expression represents an address which does not fit +% into a pointer. The address is probably incorrect +asmr_e_unknown_opcode=07053_E_Unrecognized opcode $1 +% This opcode is not known +asmr_e_invalid_or_missing_opcode=07054_E_Invalid or missing opcode +asmr_e_invalid_prefix_and_opcode=07055_E_Invalid combination of prefix and opcode: $1 +asmr_e_invalid_override_and_opcode=07056_E_Invalid combination of override and opcode: $1 +asmr_e_too_many_operands=07057_E_Too many operands on line +% There are too many operands for this opcode. Check your +% assembler syntax +asmr_w_near_ignored=07058_W_NEAR ignored +asmr_w_far_ignored=07059_W_FAR ignored +asmr_e_dup_local_sym=07060_E_Duplicate local symbol $1 +asmr_e_unknown_local_sym=07061_E_Undefined local symbol $1 +asmr_e_unknown_label_identifier=07062_E_Unknown label identifier $1 +asmr_e_invalid_register=07063_E_Invalid register name +% There is an unknown register name used as operand. +asmr_e_invalid_fpu_register=07064_E_Invalid floating point register name +% There is an unknown register name used as operand. +asmr_w_modulo_not_supported=07066_W_Modulo not supported +asmr_e_invalid_float_const=07067_E_Invalid floating point constant $1 +% The floating point constant declared in an assembler block is +% invalid. +asmr_e_invalid_float_expr=07068_E_Invalid floating point expression +% The floating point expression declared in an assembler block is +% invalid. +asmr_e_wrong_sym_type=07069_E_Wrong symbol type +asmr_e_cannot_index_relative_var=07070_E_Cannot index a local var or parameter with a register +% Trying to index using a base register a symbol which is already relative +% to a register. This is not possible, and will probably lead to crashes. +asmr_e_invalid_seg_override=07071_E_Invalid segment override expression +asmr_w_id_supposed_external=07072_W_Identifier $1 supposed external +% There is a reference to an undefined symbol. This will not result +% in an error, since the symbol might be external, but may cause +% problems at link time if the symbol is not defined anywhere. +asmr_e_string_not_allowed_as_const=07073_E_Strings not allowed as constants +% Character strings are not allowed as constants. +asmr_e_no_var_type_specified=07074_E_No type of variable specified +% The syntax expects a type idenfitifer after the dot, but +% none was found. +asmr_w_assembler_code_not_returned_to_text=07075_E_assembler code not returned to text section +% There was a directive in the assembler block to change sections, +% but there is a missing return to the text section at the end +% of the assembler block. This might cause errors during link time. +asmr_e_not_directive_or_local_symbol=07076_E_Not a directive or local symbol $1 +% This symbol is unknown. +asmr_w_using_defined_as_local=07077_E_Using a defined name as a local label +asmr_e_dollar_without_identifier=07078_E_Dollar token is used without an identifier +% A constant expression has an identifier which does not start with +% the $ symbol. +asmr_w_32bit_const_for_address=07079_W_32bit constant created for address +% A constant was used as an address. This is probably an error, +% since using absolute addresses will probably not work. +asmr_n_align_is_target_specific=07080_N_.align is target specific, use .balign or .p2align +% Using the .align directive is platform specific, and its meaning will vary +% from one platform to another. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_Can't access fields directly for parameters +% You should load the parameter first into a register and then access the +% fields using that register. +asmr_e_cannot_access_object_field_directly=07082_E_Can't access fields of objects/classes directly +% You should load the self pointer first into a register and then access the +% fields using the register as base. By default the self pointer is available +% in the esi register on i386. +asmr_e_unable_to_determine_reference_size=07083_E_No size specified and unable to determine the size of the operands +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. +asmr_e_cannot_use_RESULT_here=07084_E_Cannot use RESULT in this function +% Some functions which return complex types cannot use the \var{result} +% keyword. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" without operand translated into "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" translated into "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" translated into "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_Char < not allowed here +% The shift operator requires the << characters. Only one +% of those characters was found. +asmr_e_invalid_char_greater=07090_E_Char > not allowed here +% The shift operator requires the >> characters. Only one +% of those characters was found. +asmr_w_align_not_supported=07093_W_ALIGN not supported +asmr_e_no_inc_and_dec_together=07094_E_Inc and Dec cannot be together +% Trying to use an increment and a decrement within the same +% opcode on the 680x0. This is impossible. +asmr_e_invalid_reg_list_in_movem=07095_E_Invalid reglist for movem +% Trying to use the \var{movem} opcode with invalid registers +% to save or restore. +asmr_e_invalid_reg_list_for_opcode=07096_E_Reglist invalid for opcode +asmr_e_higher_cpu_mode_required=07097_E_Higher cpu mode required ($1) +% Trying to use an instruction which is not supported in the current +% cpu mode. Use a higher cpu generation to be able to use this +% opcode in your assembler block +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_No size specified and unable to determine the size of the operands, using DWORD as default +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use DWORD as default. +asmr_e_illegal_shifterop_syntax=07099_E_Syntax error while trying to parse a shifter operand +% ARM only; ARM assembler supports a so called shifter operand. The used syntax isn't +% a valid shifter operand. Example for an operation with shifter operand: +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +asmr_e_packed_element=07100_E_Address of packed component is not at a byte boundary +% Packed components (record fields and array elements) may start at an arbitrary +% bit inside a byte. On CPU which do not support bit-addressable memory (which +% includes all currently supported CPUs by FPC) you will therefore get an error +% message when trying to index arrays with elements whose size is not a multiple +% of 8 bits. The same goes for accessing record fields with such an address. +% multiple of 8 bits. +asmr_w_unable_to_determine_reference_size_using_byte=07101_W_No size specified and unable to determine the size of the operands, using BYTE as default +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use BYTE as default. +asmr_w_no_direct_ebp_for_parameter=07102_W_Use of +offset(%ebp) for parameters invalid here +% Using direct 8(%ebp) reference for function/procedure parameters is invalid +% if parameters are in registers. +asmr_w_direct_ebp_for_parameter_regcall=07103_W_Use of +offset(%ebp) is not compatible with regcall convention +% Using direct 8(%ebp) reference for function/procedure parameters is invalid +% if parameters are in registers. +asmr_w_direct_ebp_neg_offset=07104_W_Use of -offset(%ebp) is not recommended for local variable access +% Using -8(%ebp) to access a local variable is not recommended +asmr_w_direct_esp_neg_offset=07105_W_Use of -offset(%esp), access may cause a crash or value may be lost +% Using -8(%esp) to access a local stack is not recommended, as +% this stack portion can be overwritten by any function calls or interrupts. +asmr_e_no_vmtoffset_possible=07106_E_VMTOffset must be used in combination with a virtual method, and "$1" is not virtual +% Only virtual methods have VMT offsets +asmr_e_need_pic_ref=07107_E_Generating PIC, but reference is not PIC-safe +% The compiler has been configured to generate position-independent code +% (PIC), but there are position-dependent references in the current +% handwritten assembler instruction. +asmr_e_mixing_regtypes=07108_E_All registers in a register set must be of the same kind and width +% Instructions on the ARM architecture that take a register set as argument require that all registers +% in this set are of the same kind (e.g., integer, vfp) and width (e.g., single precision, double precision). +asmr_e_empty_regset=07109_E_A register set cannot be empty +% Instructions on the ARM architecture that take a register set as argument require that such a set +% contains at least one register. + +asmr_w_useless_got_for_local=07110_W_@GOTPCREL is useless and potentially dangereous for local symbols +% The use of @GOTPCREL supposes an extra indirection that is +% not present if the symbol is local, which might lead to wrong asembler code +asmr_w_general_segment_with_constant=07111_W_Constant with general purpose segment register +% General purpose register should not have constant offsets +% as OS memory allocation might not be compatible with that. +asmr_e_bad_seh_directive_offset=07112_E_Invalid offset value for $1 +% Win64 SEH directives have certain restrictions on possible offset values, e.g. they should +% be positive and have 3 or 4 low bits clear. +asmr_e_bad_seh_directive_register=07113_E_Invalid register for $1 +% Win64 SEH directives accept only 64-bit integer registers or XMM registers. +asmr_e_seh_in_pure_asm_only=07114_E_SEH directives are allowed only in pure assembler procedures +% Win64 SEH directives are allowed only in pure assembler procedures, not in assembler +% blocks of regular procedures. +asmr_e_unsupported_directive=07115_E_Directive "$1" is not supported for the current target + + +# +# Assembler/binary writers +# +# 08022 is the last used one +# +asmw_f_too_many_asm_files=08000_F_Too many assembler files +% With smartlinking enabled, there are too many assembler +% files generated. Disable smartlinking. +asmw_f_assembler_output_not_supported=08001_F_Selected assembler output not supported +asmw_f_comp_not_supported=08002_F_Comp not supported +asmw_f_direct_not_supported=08003_F_Direct not support for binary writers +% Direct assembler mode is not supported for binary writers. +asmw_e_alloc_data_only_in_bss=08004_E_Allocating of data is only allowed in bss section +asmw_f_no_binary_writer_selected=08005_F_No binary writer selected +asmw_e_opcode_not_in_table=08006_E_Asm: Opcode $1 not in table +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 invalid combination of opcode and operands +asmw_e_16bit_not_supported=08008_E_Asm: 16 Bit references not supported +asmw_e_invalid_effective_address=08009_E_Asm: Invalid effective address +asmw_e_immediate_or_reference_expected=08010_E_Asm: Immediate or reference expected +asmw_e_value_exceeds_bounds=08011_E_Asm: $1 value exceeds bounds $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: Short jump is out of range $1 +asmw_e_undefined_label=08013_E_Asm: Undefined label $1 +asmw_e_comp_not_supported=08014_E_Asm: Comp type not supported for this target +asmw_e_extended_not_supported=08015_E_Asm: Extended type not supported for this target +asmw_e_duplicate_label=08016_E_Asm: Duplicate label $1 +asmw_e_redefined_label=08017_E_Asm: Redefined label $1 +asmw_e_first_defined_label=08018_E_Asm: First defined here +asmw_e_invalid_register=08019_E_Asm: Invalid register $1 +asmw_e_16bit_32bit_not_supported=08020_E_Asm: 16 or 32 Bit references not supported +asmw_e_64bit_not_supported=08021_E_Asm: 64 Bit operands not supported +asmw_e_bad_reg_with_rex=08022_E_Asm: AH,BH,CH or DH cannot be used in an instruction requiring REX prefix +% x86_64 only: instruction encoding of this platform does not allow using +% 8086 high byte registers (AH,BH,CH or DH) together with REX prefix in a single instruction. +% The REX prefix is required whenever the instruction operand size is 64 bits, or +% when it uses one of extended x86_64 registers (R8-R15 or XMM8-XMM15). +asmw_e_missing_endprologue=08023_E_Missing .seh_endprologue directive +% x86_64-win64 only: Normally, SEH directives are handled internally by compiler. +% However, in pure assembler procedures .seh_endprologue directive is required +% if other SEH directives are present. +asmw_e_prologue_too_large=08024_E_Function prologue exceeds 255 bytes +% x86_64-win64: .seh_prologue directive must be placed within 255 bytes from function start. +asmw_e_handlerdata_no_handler=08025_E_.seh_handlerdata directive without preceding .seh_handler +% x86_64-win64: If .seh_handlerdata directive is used, then a .seh_handler directive must be +% present earlier in the same function. + +# +# Executing linker/assembler +# +# 09033 is the last used one +# +# BeginOfTeX +% +% \section{Errors of assembling/linking stage} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +exec_w_source_os_redefined=09000_W_Source operating system redefined +% The source operating system is redefined. +exec_i_assembling_pipe=09001_I_Assembling (pipe) $1 +% Assembling using a pipe to an external assembler. +exec_d_cant_create_asmfile=09002_E_Can't create assembler file: $1 +% The mentioned file can't be created. Check if you have +% access permissions to create this file. +exec_e_cant_create_objectfile=09003_E_Can't create object file: $1 (error code: $2) +% The mentioned file can't be created. Check if you have +% got access permissions to create this file. +exec_e_cant_create_archivefile=09004_E_Can't create archive file: $1 +% The mentioned file can't be created. Check if you have +% access permissions to create this file. +exec_e_assembler_not_found=09005_E_Assembler $1 not found, switching to external assembling +% The assembler program was not found. The compiler will produce a script that +% can be used to assemble and link the program. +exec_t_using_assembler=09006_T_Using assembler: $1 +% An informational message saying which assembler is being used. +exec_e_error_while_assembling=09007_E_Error while assembling exitcode $1 +% There was an error while assembling the file using an external assembler. +% Consult the documentation of the assembler tool to find out more information +% on this error. +exec_e_cant_call_assembler=09008_E_Can't call the assembler, error $1 switching to external assembling +% An error occurred when calling an external assembler. The compiler will produce a script that +% can be used to assemble and link the program. +exec_i_assembling=09009_I_Assembling $1 +% An informational message stating which file is being assembled. +exec_i_assembling_smart=09010_I_Assembling with smartlinking $1 +% An informational message stating which file is being assembled using smartlinking. +exec_w_objfile_not_found=09011_W_Object $1 not found, Linking may fail ! +% One of the object files is missing, and linking will probably fail. +% Check your paths. +exec_w_libfile_not_found=09012_W_Library $1 not found, Linking may fail ! +% One of the library files is missing, and linking will probably fail. +% Check your paths. +exec_e_error_while_linking=09013_E_Error while linking +% Generic error while linking. +exec_e_cant_call_linker=09014_E_Can't call the linker, switching to external linking +% An error occurred when calling an external linker. The compiler will produce a script that +% can be used to assemble and link the program. +exec_i_linking=09015_I_Linking $1 +% An informational message, showing which program or library is being linked. +exec_e_util_not_found=09016_E_Util $1 not found, switching to external linking +% An external tool was not found. The compiler will produce a script that +% can be used to assemble and link or postprocess the program. +exec_t_using_util=09017_T_Using util $1 +% An informational message, showing which external program (usually a postprocessor) is being used. +exec_e_exe_not_supported=09018_E_Creation of Executables not supported +% Creating executable programs is not supported for this platform, because it was +% not yet implemented in the compiler. +exec_e_dll_not_supported=09019_E_Creation of Dynamic/Shared Libraries not supported +% Creating dynamically loadable libraries is not supported for this platform, because it was +% not yet implemented in the compiler. +exec_i_closing_script=09020_I_Closing script $1 +% Informational message showing when writing of the external assembling and linking script is finished. +exec_e_res_not_found=09021_E_resource compiler "$1" not found, switching to external mode +% An external resource compiler was not found. The compiler will produce a script that +% can be used to assemble, compile resources and link or postprocess the program. +exec_i_compilingresource=09022_I_Compiling resource $1 +% An informational message, showing which resource is being compiled. +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_unit $1 can't be statically linked, switching to smart linking +% Static linking was requested, but a unit which is not statically linkable was used. +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_unit $1 can't be smart linked, switching to static linking +% Smart linking was requested, but a unit which is not smart-linkable was used. +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_unit $1 can't be shared linked, switching to static linking +% Shared linking was requested, but a unit which is not shared-linkable was used. +exec_e_unit_not_smart_or_static_linkable=09026_E_unit $1 can't be smart or static linked +% Smart or static linking was requested, but a unit which cannot be used for either was used. +exec_e_unit_not_shared_or_static_linkable=09027_E_unit $1 can't be shared or static linked +% Shared or static linking was requested, but a unit which cannot be used for either was used. +exec_d_resbin_params=09028_D_Calling resource compiler "$1" with "$2" as command line +% An informational message showing which command line is used for the resource compiler. +exec_e_error_while_compiling_resources=09029_E_Error while compiling resources +% The resource compiler or converter returned an error. +exec_e_cant_call_resource_compiler=09030_E_Can't call the resource compiler "$1", switching to external mode +% An error occurred when calling a resource compiler. The compiler will produce +% a script that can be used to assemble, compile resources and link or +% postprocess the program. +exec_e_cant_open_resource_file=09031_E_Can't open resource file "$1" +% An error occurred resource file cannot be opened. +exec_e_cant_write_resource_file=09032_E_Can't write resource file "$1" +% An error occurred resource file cannot be written. +exec_n_backquote_cat_file_not_found=09033_N_File "$1" not found for backquoted cat command +% The compiler did not find the file that should be expanded into linker parameters +%\end{description} +# EndOfTeX + +# +# Executable information +# +# 09134 is the last used one +# +# BeginOfTeX +% \section{Executable information messages.} +% This section lists all messages that the compiler emits when an executable program is produced, +% and only when the internal linker is used. +% \begin{description} +execinfo_f_cant_process_executable=09128_F_Can't post process executable $1 +% Fatal error when the compiler is unable to post-process an executable. +execinfo_f_cant_open_executable=09129_F_Can't open executable $1 +% Fatal error when the compiler cannot open the file for the executable. +execinfo_x_codesize=09130_X_Size of Code: $1 bytes +% Informational message showing the size of the produced code section. +execinfo_x_initdatasize=09131_X_Size of initialized data: $1 bytes +% Informational message showing the size of the initialized data section. +execinfo_x_uninitdatasize=09132_X_Size of uninitialized data: $1 bytes +% Informational message showing the size of the uninitialized data section. +execinfo_x_stackreserve=09133_X_Stack space reserved: $1 bytes +% Informational message showing the stack size that the compiler reserved for the executable. +execinfo_x_stackcommit=09134_X_Stack space committed: $1 bytes +% Informational message showing the stack size that the compiler committed for the executable. +%\end{description} +# EndOfTeX + +# +# Internal linker messages +# +# 09200 is the last used one +# +# BeginOfTeX +% \section{Linker messages} +% This section lists messages produced by internal linker. +% \begin{description} +link_f_executable_too_big=09200_F_Executable image size is too big for $1 target. +% Fatal error when resulting executable is too big. +link_w_32bit_absolute_reloc=09201_W_Object file "$1" contains 32-bit absolute relocation to symbol "$2". +% Warning when 64-bit object file contains 32-bit absolute relocations. +% In such case an executable image can be loaded into lower 4Gb of +% address space only. +%\end{description} +# EndOfTeX + +# +# Unit loading +# +# 10062 is the last used one +# +# BeginOfTeX +% \section{Unit loading messages.} +% This section lists all messages that can occur when the compiler is +% loading a unit from disk into memory. Many of these messages are +% informational messages. +% \begin{description} +unit_t_unitsearch=10000_T_Unitsearch: $1 +% When you use the \var{-vt} option, the compiler tells you where it tries to find +% unit files. +unit_t_ppu_loading=10001_T_PPU Loading $1 +% When the \var{-vt} switch is used, the compiler tells you +% what units it loads. +unit_u_ppu_name=10002_U_PPU Name: $1 +% When you use the \var{-vu} flag, the unit name is shown. +unit_u_ppu_flags=10003_U_PPU Flags: $1 +% When you use the \var{-vu} flag, the unit flags are shown. +unit_u_ppu_crc=10004_U_PPU Crc: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_time=10005_U_PPU Time: $1 +% When you use the \var{-vu} flag, the time the unit was compiled is shown. +unit_u_ppu_file_too_short=10006_U_PPU File too short +% The ppufile is too short, not all declarations are present. +unit_u_ppu_invalid_header=10007_U_PPU Invalid Header (no PPU at the begin) +% A unit file contains as the first three bytes the ASCII codes of the characters \var{PPU}. +unit_u_ppu_invalid_version=10008_U_PPU Invalid Version $1 +% This unit file was compiled with a different version of the compiler, and +% cannot be read. +unit_u_ppu_invalid_processor=10009_U_PPU is compiled for another processor +% This unit file was compiled for a different processor type, and +% cannot be read. +unit_u_ppu_invalid_target=10010_U_PPU is compiled for another target +% This unit file was compiled for a different target, and +% cannot be read. +unit_u_ppu_source=10011_U_PPU Source: $1 +% When you use the \var{-vu} flag, the unit source file name is shown. +unit_u_ppu_write=10012_U_Writing $1 +% When you specify the \var{-vu} switch, the compiler will tell you where it +% writes the unit file. +unit_f_ppu_cannot_write=10013_F_Can't Write PPU-File +% An error occurred when writing the unit file. +unit_f_ppu_read_error=10014_F_Error reading PPU-File +% This means that the unit file was corrupted, and contains invalid +% information. Recompilation will be necessary. +unit_f_ppu_read_unexpected_end=10015_F_unexpected end of PPU-File +% Unexpected end of file. This may mean that the PPU file is +% corrupted. +unit_f_ppu_invalid_entry=10016_F_Invalid PPU-File entry: $1 +% The unit the compiler is trying to read is corrupted, or generated with a +% newer version of the compiler. +unit_f_ppu_dbx_count_problem=10017_F_PPU Dbx count problem +% There is an inconsistency in the debugging information of the unit. +unit_e_illegal_unit_name=10018_E_Illegal unit name: $1 +% The name of the unit does not match the file name. +unit_f_too_much_units=10019_F_Too much units +% \fpc has a limit of 1024 units in a program. You can change this behavior +% by changing the \var{maxunits} constant in the \file{fmodule.pas} file of the +% compiler, and recompiling the compiler. +unit_f_circular_unit_reference=10020_F_Circular unit reference between $1 and $2 +% Two units are using each other in the interface part. This is only allowed +% in the \var{implementation} part. At least one unit must contain the other one +% in the \var{implementation} section. +unit_f_cant_compile_unit=10021_F_Can't compile unit $1, no sources available +% A unit was found that needs to be recompiled, but no sources are +% available. +unit_f_cant_find_ppu=10022_F_Can't find unit $1 used by $2 +% You tried to use a unit of which the PPU file isn't found by the +% compiler. Check your configuration file for the unit paths. +unit_w_unit_name_error=10023_W_Unit $1 was not found but $2 exists +% This error message is no longer used. +unit_f_unit_name_error=10024_F_Unit $1 searched but $2 found +% \dos truncation of 8 letters for unit PPU files +% may lead to problems when unit name is longer than 8 letters. +unit_w_switch_us_missed=10025_W_Compiling the system unit requires the -Us switch +% When recompiling the system unit (it needs special treatment), the +% \var{-Us} switch must be specified. +unit_f_errors_in_unit=10026_F_There were $1 errors compiling module, stopping +% When the compiler encounters a fatal error or too many errors in a module +% then it stops with this message. +unit_u_load_unit=10027_U_Load from $1 ($2) unit $3 +% When you use the \var{-vu} flag, which unit is loaded from which unit is +% shown. +unit_u_recompile_crc_change=10028_U_Recompiling $1, checksum changed for $2 +% The unit is recompiled because the checksum of a unit it depends on has +% changed. +unit_u_recompile_source_found_alone=10029_U_Recompiling $1, source found only +% When you use the \var{-vu} flag, these messages tell you why the current +% unit is recompiled. +unit_u_recompile_staticlib_is_older=10030_U_Recompiling unit, static lib is older than ppufile +% When you use the \var{-vu} flag, the compiler warns if the static library +% of the unit is older than the unit file itself. +unit_u_recompile_sharedlib_is_older=10031_U_Recompiling unit, shared lib is older than ppufile +% When you use the \var{-vu} flag, the compiler warns if the shared library +% of the unit is older than the unit file itself. +unit_u_recompile_obj_and_asm_older=10032_U_Recompiling unit, obj and asm are older than ppufile +% When you use the \var{-vu} flag, the compiler warns if the assembler or +% object file of the unit is older than the unit file itself. +unit_u_recompile_obj_older_than_asm=10033_U_Recompiling unit, obj is older than asm +% When you use the \var{-vu} flag, the compiler warns if the assembler +% file of the unit is older than the object file of the unit. +unit_u_parsing_interface=10034_U_Parsing interface of $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the interface part of the unit. +unit_u_parsing_implementation=10035_U_Parsing implementation of $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the implementation part of the unit. +unit_u_second_load_unit=10036_U_Second load for unit $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happen with +% interdependent units. +unit_u_check_time=10037_U_PPU Check file $1 time $2 +% When you use the \var{-vu} flag, the compiler shows the filename and +% date and time of the file on which a recompile depends. +### The following two error msgs is currently disabled. +#unit_h_cond_not_set_in_last_compile=10038_H_Conditional $1 was not set at startup in last compilation of $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that currently is defined, but was not used the last +#% time the unit was compiled. +#unit_h_cond_set_in_last_compile=10039_H_Conditional $1 was set at startup in last compilation of $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that was used the last time the unit was compiled, but +#% the conditional is currently not defined. +unit_w_cant_compile_unit_with_changed_incfile=10040_W_Can't recompile unit $1, but found modifed include files +% A unit was found to have modified include files, but +% some source files were not found, so recompilation is impossible. +unit_u_source_modified=10041_U_File $1 is newer than the one used for creating PPU file $2 +% A modified source file for a compiler unit was found. +unit_u_ppu_invalid_fpumode=10042_U_Trying to use a unit which was compiled with a different FPU mode +% Trying to compile code while using units which were not compiled with +% the same floating point format mode. Either all code should be compiled +% with FPU emulation on, or with FPU emulation off. +unit_u_loading_interface_units=10043_U_Loading interface units from $1 +% When you use the \var{-vu} flag, the compiler warns that it is starting +% to load the units defined in the interface part of the unit. +unit_u_loading_implementation_units=10044_U_Loading implementation units from $1 +% When you use the \var{-vu} flag, the compiler warns that it is starting +% to load the units defined in the implementation part of the unit. +unit_u_interface_crc_changed=10045_U_Interface CRC changed for unit $1 +% When you use the \var{-vu} flag, the compiler warns that the +% CRC calculated for the interface has been changed after the implementation +% has been parsed. +unit_u_implementation_crc_changed=10046_U_Implementation CRC changed for unit $1 +% When you use the \var{-vu} flag, the compiler warns that the +% CRC calculated has been changed after the implementation +% has been parsed. +unit_u_finished_compiling=10047_U_Finished compiling unit $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has finished compiling the unit. +unit_u_add_depend_to=10048_U_Adding dependency: $1 depends on $2 +% When you use the \var{-vu} flag, the compiler warns that it +% has added a dependency between the two units. +unit_u_no_reload_is_caller=10049_U_No reload, is caller: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% will not reload the unit because it is the unit that wants +% to load this unit. +unit_u_no_reload_in_second_compile=10050_U_No reload, already in second compile: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% will not reload the unit because it is already in a second recompile. +unit_u_flag_for_reload=10051_U_Flag for reload: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to reload the unit. +unit_u_forced_reload=10052_U_Forced reloading +% When you use the \var{-vu} flag, the compiler warns that it +% is reloading the unit because it was required. +unit_u_previous_state=10053_U_Previous state of $1: $2 +% When you use the \var{-vu} flag, the compiler shows the +% previous state of the unit. +unit_u_second_compile_unit=10054_U_Already compiling $1, setting second compile +% When you use the \var{-vu} flag, the compiler warns that it is starting +% to recompile a unit for the second time. This can happen with interdependent +% units. +unit_u_loading_unit=10055_U_Loading unit $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the unit. +unit_u_finished_loading_unit=10056_U_Finished loading unit $1 +% When you use the \var{-vu} flag, the compiler warns that it finished +% loading the unit. +unit_u_registering_new_unit=10057_U_Registering new unit $1 +% When you use the \var{-vu} flag, the compiler warns that it has +% found a new unit and is registering it in the internal lists. +unit_u_reresolving_unit=10058_U_Re-resolving unit $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to recalculate the internal data of the unit. +unit_u_skipping_reresolving_unit=10059_U_Skipping re-resolving unit $1, still loading used units +% When you use the \var{-vu} flag, the compiler warns that it is +% skipping the recalculation of the internal data of the unit +% because there is no data to recalculate. +unit_u_unload_resunit=10060_U_Unloading resource unit $1 (not needed) +% When you use the \var{-vu} flag, the compiler warns that it is unloading the +% resource handling unit, since no resources are used. +unit_e_different_wpo_file=10061_E_Unit $1 was compiled using a different whole program optimization feedback input ($2, $3); recompile it without wpo or use the same wpo feedback input file for this compilation invocation +% When a unit has been compiled using a particular whole program optimization (wpo) feedback file (\var{-FW<x>} \var{-OW<x>}), +% this compiled version of the unit is specialised for that particular compilation scenario and cannot be used in +% any other context. It has to be recompiled before you can use it in another program or with another wpo feedback input file. +unit_u_indirect_crc_changed=10062_U_Indirect interface (objects/classes) CRC changed for unit $1 +% When you use the \var{-vu} flag, the compiler warns that the +% indirect CRC calculated for the unit (this is the CRC of all classes/objects/interfaces/$\ldots$ +% in the interfaces of units directly or indirectly used by this unit in the interface) has been changed after the +% implementation has been parsed. +% \end{description} +# EndOfTeX + +# +# Options +# +# 11049 is the last used one +# +option_usage=11000_O_$1 [options] <inputfile> [options] +# BeginOfTeX +% +% \section{Command line handling errors} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +option_only_one_source_support=11001_W_Only one source file supported, changing source file to compile from "$1" into "$2" +% You can specify only one source file on the command line. The last +% one will be compiled, others will be ignored. This may indicate that +% you forgot a \var{'-'} sign. +option_def_only_for_os2=11002_W_DEF file can be created only for OS/2 +% This option can only be specified when you're compiling for OS/2. +option_no_nested_response_file=11003_E_nested response files are not supported +% You cannot nest response files with the \var{@file} command line option. +option_no_source_found=11004_F_No source file name in command line +% The compiler expects a source file name on the command line. +option_no_option_found=11005_N_No option inside $1 config file +% The compiler didn't find any option in that config file. +option_illegal_para=11006_E_Illegal parameter: $1 +% You specified an unknown option. +option_help_pages_para=11007_H_-? writes help pages +% When an unknown option is given, this message is diplayed. +option_too_many_cfg_files=11008_F_Too many config files nested +% You can only nest up to 16 config files. +option_unable_open_file=11009_F_Unable to open file $1 +% The option file cannot be found. +option_reading_further_from=11010_D_Reading further options from $1 +% Displayed when you have notes turned on, and the compiler switches +% to another options file. +option_target_is_already_set=11011_W_Target is already set to: $1 +% Displayed if more than one \var{-T} option is specified. +option_no_shared_lib_under_dos=11012_W_Shared libs not supported on DOS platform, reverting to static +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos. +option_too_many_ifdef=11013_F_In options file $1 at line $2 too many \var{\#IF(N)DEFs} encountered +% The \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_many_endif=11014_F_In options file $1 at line $2 unexpected \var{\#ENDIFs} encountered +% The \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_less_endif=11015_F_Open conditional at the end of the options file +% The \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_no_debug_support=11016_W_Debug information generation is not supported by this executable +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_Try recompiling with -dGDB +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_W_You are using the obsolete switch $1 +% This warns you when you use a switch that is not needed/supported anymore. +% It is recommended that you remove the switch to overcome problems in the +% future, when the meaning of the switch may change. +option_obsolete_switch_use_new=11019_W_You are using the obsolete switch $1, please use $2 +% This warns you when you use a switch that is not supported anymore. You +% must now use the second switch instead. +% It is recommended that you change the switch to overcome problems in the +% future, when the meaning of the switch may change. +option_switch_bin_to_src_assembler=11020_N_Switching assembler to default source writing assembler +% This notifies you that the assembler has been changed because you used the +% -a switch, which can't be used with a binary assembler writer. +option_incompatible_asm=11021_W_Assembler output selected "$1" is not compatible with "$2" +option_asm_forced=11022_W_"$1" assembler use forced +% The assembler output selected cannot generate +% object files with the correct format. Therefore, the +% default assembler for this target is used instead. +option_using_file=11026_T_Reading options from file $1 +% Options are also read from this file. +option_using_env=11027_T_Reading options from environment $1 +% Options are also read from this environment string. +option_handling_option=11028_D_Handling option "$1" +% Debug info that an option is found and will be handled. +option_help_press_enter=11029_O_*** press enter *** +% Message shown when help is shown page per page. When pressing the ENTER +% Key, the next page of help is shown. If you press q and then ENTER, the +% compiler exits. +option_start_reading_configfile=11030_H_Start of reading config file $1 +% Start of configuration file parsing. +option_end_reading_configfile=11031_H_End of reading config file $1 +% End of configuration file parsing. +option_interpreting_option=11032_D_interpreting option "$1" +% The compiler is interpreting an option +option_interpreting_firstpass_option=11036_D_interpreting firstpass option "$1" +% The compiler is interpreting an option for the first time. +option_interpreting_file_option=11033_D_interpreting file option "$1" +% The compiler is interpreting an option which it read from the configuration file. +option_read_config_file=11034_D_Reading config file "$1" +% The compiler is starting to read the configuration file. +option_found_file=11035_D_found source file name "$1" +% Additional information about options. +% Displayed when you have the debug option turned on. +option_code_page_not_available=11039_E_Unknown codepage +% An unknown codepage for the source files was requested. +% The compiler is compiled with support for several codepages built-in. +% The requested codepage is not in that list. You will need to recompile +% the compiler with support for the codepage you need. +option_config_is_dir=11040_F_Config file $1 is a directory +% Directories cannot be used as configuration files. +option_confict_asm_debug=11041_W_Assembler output selected "$1" cannot generate debug info, debugging disabled +% The selected assembler output cannot generate +% debugging information, debugging option is therefore disabled. +option_ppc386_deprecated=11042_W_Use of ppc386.cfg is deprecated, please use fpc.cfg instead +% Using ppc386.cfg is still supported for historical reasons, however, for a multiplatform +% system the naming makes no sense anymore. Please continue to use fpc.cfg instead. +option_else_without_if=11043_F_In options file $1 at line $2 \var{\#ELSE} directive without \var{\#IF(N)DEF} found +% An \var{\#ELSE} statement was found in the options file without a matching \var{\#IF(N)DEF} statement. +option_unsupported_target=11044_F_Option "$1" is not, or not yet, supported on the current target platform +% Not all options are supported or implemented for all target platforms. This message informs you that a chosen +% option is incompatible with the currently selected target platform. +option_unsupported_target_for_feature=11045_F_The feature "$1" is not, or not yet, supported on the selected target platform +% Not all features are supported or implemented for all target platforms. This message informs you that a chosen +% feature is incompatible with the currently selected target platform. +option_dwarf_smart_linking=11046_N_DWARF debug information cannot be used with smart linking on this target, switching to static linking +% Smart linking is currently incompatble with DWARF debug information on most +% platforms, so smart linking is disabled in such cases. +option_ignored_target=11047_W_Option "$1" is ignored for the current target platform. +% Not all options are supported or implemented for all target platforms. This message informs you that a chosen +% option is ignored for the currently selected target platform. +option_debug_external_unsupported=11048_W_Disabling external debug information because it is unsupported for the selected target/debug format combination. +% Not all debug formats can be stored in an external file on all platforms. In particular, on +% Mac OS X only DWARF debug information can be stored externally. +option_dwarf_smartlink_creation=11049_N_DWARF debug information cannot be used with smart linking with external assembler, disabling static library creation. +% Smart linking is currently incompatble with DWARF debug information on most +% platforms, so smart linking is disabled in such cases. +%\end{description} +# EndOfTeX + +# +# Whole program optimization +# +# 12019 is the last used one +# +# BeginOfTeX +% +% \section{Whole program optimization messages} +% This section lists errors that occur when the compiler is performing +% whole program optimization. +% \begin{description} +wpo_cant_find_file=12000_F_Cannot open whole program optimization feedback file "$1" +% The compiler cannot open the specified feedback file with whole program optimization information. +wpo_begin_processing=12001_D_Processing whole program optimization information in wpo feedback file "$1" +% The compiler starts processing whole program optimization information found in the named file. +wpo_end_processing=12002_D_Finished processing the whole program optimization information in wpo feedback file "$1" +% The compiler has finished processing the whole program optimization information found in the named file. +wpo_expected_section=12003_E_Expected section header, but got "$2" at line $1 of wpo feedback file +% The compiler expected a section header in the whole program optimization file (starting with \%), +% but did not find it. +wpo_no_section_handler=12004_W_No handler registered for whole program optimization section "$2" at line $1 of wpo feedback file, ignoring +% The compiler has no handler to deal with the mentioned whole program optimization information +% section, and will therefore ignore it and skip to the next section. +wpo_found_section=12005_D_Found whole program optimization section "$1" with information about "$2" +% The compiler encountered a section with whole program optimization information, and according +% to its handler this section contains information usable for the mentioned purpose. +wpo_no_input_specified=12006_F_The selected whole program optimizations require a previously generated feedback file (use -Fw to specify) +% The compiler needs information gathered during a previous compilation run to perform the selected +% whole program optimizations. You can specify the location of the feedback file containing this +% information using the -Fw switch. +wpo_not_enough_info=12007_E_No collected information necessary to perform "$1" whole program optimization found +% While you pointed the compiler to a file containing whole program optimization feedback, it +% did not contain the information necessary to perform the selected optimizations. You most likely +% have to recompile the program using the appropate -OWxxx switch. +wpo_no_output_specified=12008_F_Specify a whole program optimization feedback file to store the generated info in (using -FW) +% You have to specify the feedback file in which the compiler has to store the whole program optimization +% feedback that is generated during the compilation run. This can be done using the -FW switch. +wpo_output_without_info_gen=12009_E_Not generating any whole program optimization information, yet a feedback file was specified (using -FW) +% The compiler was instructed to store whole program optimization feedback into a file specified using -FW, +% but not to actually generated any whole program optimization feedback. The classes of to be +% generated information can be speciied using -OWxxx. +wpo_input_without_info_use=12010_E_Not performing any whole program optimizations, yet an input feedback file was specified (using -Fw) +% The compiler was not instructed to perform any whole program optimizations (no -Owxxx parameters), +% but nevertheless an input file with such feedback was specified (using -Fwyyy). Since this can +% indicate that you forgot to specify an -Owxxx parameter, the compiler generates an error in this case. +wpo_skipping_unnecessary_section=12011_D_Skipping whole program optimization section "$1", because not needed by the requested optimizations +% The whole program optimization feedback file contains a section with information that is not +% required by the selected whole program optimizations. +wpo_duplicate_wpotype=12012_W_Overriding previously read information for "$1" from feedback input file using information in section "$2" +% The feedback file contains multiple sections that provide the same class of information (e.g., +% information about which virtual methods can be devirtualized). In this case, the information in last encountered +% section is used. Turn on debugging output (-vd) to see which class of information is provided by each section. +wpo_cannot_extract_live_symbol_info_strip=12013_E_Cannot extract symbol liveness information from program when stripping symbols, use -Xs- +% Certain symbol liveness collectors extract the symbol information from the linked program. If the symbol information +% is stripped (option -Xs), this is not possible. +wpo_cannot_extract_live_symbol_info_no_link=12014_E_Cannot extract symbol liveness information from program when when not linking +% Certain symbol liveness collectors extract the symbol information from the linked program. If the program is not +% linked by the compiler, this is not possible. +wpo_cannot_find_symbol_progs=12015_F_Cannot find "$1" or "$2" to extract symbol liveness information from linked program +% Certain symbol liveness collectors need a helper program to extract the symbol information from the linked program. +% This helper program is normally 'nm', which is part of the GNU binutils. +wpo_error_reading_symbol_file=12016_E_Error during reading symbol liveness information produced by "$1" +% An error occurred during the reading of the symbol liveness file that was generated using the 'nm' or 'objdump' program. The reason +% can be that it was shorter than expected, or that its format was not understood. +wpo_error_executing_symbol_prog=12017_F_Error executing "$1" (exitcode: $2) to extract symbol information from linked program +% Certain symbol liveness collectors need a helper program to extract the symbol information from the linked program. +% The helper program produced the reported error code when it was run on the linked program. +wpo_symbol_live_info_needs_smart_linking=12018_E_Collection of symbol liveness information can only help when using smart linking, use -CX -XX +% Whether or not a symbol is live is determined by looking whether it exists in the final linked program. +% Without smart linking/dead code stripping, all symbols are always included, regardless of whether they are +% actually used or not. So in that case all symbols will be seen as live, which makes this optimization ineffective. +wpo_cant_create_feedback_file=12019_E_Cannot create specified whole program optimisation feedback file "$1" +% The compiler is unable to create the file specified using the -FW parameter to store the whole program optimisation information. +%\end{description} +# EndOfTeX + + +# +# Logo (option -l) +# +option_logo=11023_[ +Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU +Copyright (c) 1993-2011 by Florian Klaempfl and others +] + +# +# Info (option -i) +# +option_info=11024_[ +Free Pascal Compiler version $FPCVERSION + +Compiler Date : $FPCDATE +Compiler CPU Target: $FPCCPU + +Supported targets: + $OSTARGETS + +Supported CPU instruction sets: + $INSTRUCTIONSETS + +Supported FPU instruction sets: + $FPUINSTRUCTIONSETS + +Supported ABI targets: + $ABITARGETS + +Supported Optimizations: + $OPTIMIZATIONS + +Supported Whole Program Optimizations: + All + $WPOPTIMIZATIONS + +Supported Microcontroller types: + $CONTROLLERTYPES + +This program comes under the GNU General Public Licence +For more information read COPYING.FPC + +Report bugs, suggestions, etc. to: + http://bugs.freepascal.org +or + bugs@freepascal.org +] + +# +# Help pages (option -? and -h) +# +# The first character on the line indicates who will display this +# line, the current possibilities are : +# * = every target +# 3 = 80x86 targets +# 4 = x86_64 +# 6 = 680x0 targets +# A = ARM +# e = in extended debug mode only +# P = PowerPC targets +# S = Sparc targets +# V = Virtual machine targets +# The second character also indicates who will display this line, +# (if the above character was TRUE) the current possibilities are : +# * = everyone +# g = with GDB info supported by the compiler +# O = OS/2 +# L = UNIX systems +# The third character represents the indentation level. +# +option_help_pages=11025_[ +**0*_Put + after a boolean switch option to enable it, - to disable it +**1a_The compiler doesn't delete the generated assembler file +**2al_List sourcecode lines in assembler file +**2an_List node info in assembler file +*L2ap_Use pipes instead of creating temporary assembler files +**2ar_List register allocation/release info in assembler file +**2at_List temp allocation/release info in assembler file +**1A<x>_Output format: +**2Adefault_Use default assembler +3*2Aas_Assemble using GNU AS +3*2Amacho_Mach-O (Darwin, Intel 32 bit) using internal writer +3*2Anasmcoff_COFF (Go32v2) file using Nasm +3*2Anasmelf_ELF32 (Linux) file using Nasm +3*2Anasmwin32_Win32 object file using Nasm +3*2Anasmwdosx_Win32/WDOSX object file using Nasm +3*2Awasm_Obj file using Wasm (Watcom) +3*2Anasmobj_Obj file using Nasm +3*2Amasm_Obj file using Masm (Microsoft) +3*2Atasm_Obj file using Tasm (Borland) +3*2Aelf_ELF (Linux) using internal writer +3*2Acoff_COFF (Go32v2) using internal writer +3*2Apecoff_PE-COFF (Win32) using internal writer +4*2Aas_Assemble using GNU AS +4*2Agas_Assemble using GNU GAS +4*2Agas-darwin_Assemble darwin Mach-O64 using GNU GAS +4*2Amasm_Win64 object file using ml64 (Microsoft) +4*2Apecoff_PE-COFF (Win64) using internal writer +4*2Aelf_ELF (Linux-64bit) using internal writer +6*2Aas_Unix o-file using GNU AS +6*2Agas_GNU Motorola assembler +6*2Amit_MIT Syntax (old GAS) +6*2Amot_Standard Motorola assembler +A*2Aas_Assemble using GNU AS +P*2Aas_Assemble using GNU AS +S*2Aas_Assemble using GNU AS +**1b_Generate browser info +**2bl_Generate local symbol info +**1B_Build all modules +**1C<x>_Code generation options: +**2C3<x>_Turn on ieee error checking for constants +**2Ca<x>_Select ABI, see fpc -i for possible values +**2Cb_Generate big-endian code +**2Cc<x>_Set default calling convention to <x> +**2CD_Create also dynamic library (not supported) +**2Ce_Compilation with emulated floating point opcodes +**2Cf<x>_Select fpu instruction set to use, see fpc -i for possible values +**2CF<x>_Minimal floating point constant precision (default, 32, 64) +**2Cg_Generate PIC code +**2Ch<n>_<n> bytes heap (between 1023 and 67107840) +**2Ci_IO-checking +**2Cn_Omit linking stage +**2Co_Check overflow of integer operations +**2CO_Check for possible overflow of integer operations +**2Cp<x>_Select instruction set, see fpc -i for possible values +**2CP<x>=<y>_ packing settings +**3CPPACKSET=<y>_ <y> set allocation: 0, 1 or DEFAULT or NORMAL, 2, 4 and 8 +**2Cr_Range checking +**2CR_Verify object method call validity +**2Cs<n>_Set stack checking size to <n> +**2Ct_Stack checking (for testing only, see manual) +**2CX_Create also smartlinked library +**1d<x>_Defines the symbol <x> +**1D_Generate a DEF file +**2Dd<x>_Set description to <x> +**2Dv<x>_Set DLL version to <x> +*O2Dw_PM application +**1e<x>_Set path to executable +**1E_Same as -Cn +**1fPIC_Same as -Cg +**1F<x>_Set file names and paths: +**2Fa<x>[,y]_(for a program) load units <x> and [y] before uses is parsed +**2Fc<x>_Set input codepage to <x> +**2FC<x>_Set RC compiler binary name to <x> +**2Fd_Disable the compiler's internal directory cache +**2FD<x>_Set the directory where to search for compiler utilities +**2Fe<x>_Redirect error output to <x> +**2Ff<x>_Add <x> to framework path (Darwin only) +**2FE<x>_Set exe/unit output path to <x> +**2Fi<x>_Add <x> to include path +**2Fl<x>_Add <x> to library path +**2FL<x>_Use <x> as dynamic linker +**2Fm<x>_Load unicode conversion table from <x>.txt in the compiler dir +**2Fo<x>_Add <x> to object path +**2Fr<x>_Load error message file <x> +**2FR<x>_Set resource (.res) linker to <x> +**2Fu<x>_Add <x> to unit path +**2FU<x>_Set unit output path to <x>, overrides -FE +**2FW<x>_Store generated whole-program optimization feedback in <x> +**2Fw<x>_Load previously stored whole-program optimization feedback from <x> +*g1g_Generate debug information (default format for target) +*g2gc_Generate checks for pointers +*g2gh_Use heaptrace unit (for memory leak/corruption debugging) +*g2gl_Use line info unit (show more info with backtraces) +*g2go<x>_Set debug information options +*g3godwarfsets_ Enable DWARF 'set' type debug information (breaks gdb < 6.5) +*g3gostabsabsincludes_ Store absolute/full include file paths in Stabs +*g3godwarfmethodclassprefix_ Prefix method names in DWARF with class name +*g2gp_Preserve case in stabs symbol names +*g2gs_Generate Stabs debug information +*g2gt_Trash local variables (to detect uninitialized uses) +*g2gv_Generates programs traceable with Valgrind +*g2gw_Generate DWARFv2 debug information (same as -gw2) +*g2gw2_Generate DWARFv2 debug information +*g2gw3_Generate DWARFv3 debug information +*g2gw4_Generate DWARFv4 debug information (experimental) +**1i_Information +**2iD_Return compiler date +**2iV_Return short compiler version +**2iW_Return full compiler version +**2iSO_Return compiler OS +**2iSP_Return compiler host processor +**2iTO_Return target OS +**2iTP_Return target processor +**1I<x>_Add <x> to include path +**1k<x>_Pass <x> to the linker +**1l_Write logo +**1M<x>_Set language mode to <x> +**2Mfpc_Free Pascal dialect (default) +**2Mobjfpc_FPC mode with Object Pascal support +**2Mdelphi_Delphi 7 compatibility mode +**2Mtp_TP/BP 7.0 compatibility mode +**2Mmacpas_Macintosh Pascal dialects compatibility mode +**1n_Do not read the default config files +**1N<x>_Node tree optimizations +**2Nu_Unroll loops +**1o<x>_Change the name of the executable produced to <x> +**1O<x>_Optimizations: +**2O-_Disable optimizations +**2O1_Level 1 optimizations (quick and debugger friendly) +**2O2_Level 2 optimizations (-O1 + quick optimizations) +**2O3_Level 3 optimizations (-O2 + slow optimizations) +**2Oa<x>=<y>_Set alignment +**2Oo[NO]<x>_Enable or disable optimizations, see fpc -i for possible values +**2Op<x>_Set target cpu for optimizing, see fpc -i for possible values +**2OW<x>_Generate whole-program optimization feedback for optimization <x>, see fpc -i for possible values +**2Ow<x>_Perform whole-program optimization <x>, see fpc -i for possible values +**2Os_Optimize for size rather than speed +**1pg_Generate profile code for gprof (defines FPC_PROFILE) +**1R<x>_Assembler reading style: +**2Rdefault_Use default assembler for target +3*2Ratt_Read AT&T style assembler +3*2Rintel_Read Intel style assembler +6*2RMOT_Read motorola style assembler +**1S<x>_Syntax options: +**2S2_Same as -Mobjfpc +**2Sc_Support operators like C (*=,+=,/= and -=) +**2Sa_Turn on assertions +**2Sd_Same as -Mdelphi +**2Se<x>_Error options. <x> is a combination of the following: +**3*_<n> : Compiler halts after the <n> errors (default is 1) +**3*_w : Compiler also halts after warnings +**3*_n : Compiler also halts after notes +**3*_h : Compiler also halts after hints +**2Sg_Enable LABEL and GOTO (default in -Mtp and -Mdelphi) +**2Sh_Use ansistrings by default instead of shortstrings +**2Si_Turn on inlining of procedures/functions declared as "inline" +**2Sk_Load fpcylix unit +**2SI<x>_Set interface style to <x> +**3SIcom_COM compatible interface (default) +**3SIcorba_CORBA compatible interface +**2Sm_Support macros like C (global) +**2So_Same as -Mtp +**2Ss_Constructor name must be init (destructor must be done) +**2Sx_Enable exception keywords (default in Delphi/ObjFPC modes) +**2Sy_@<pointer> returns a typed pointer, same as $T+ +**1s_Do not call assembler and linker +**2sh_Generate script to link on host +**2st_Generate script to link on target +**2sr_Skip register allocation phase (use with -alr) +**1T<x>_Target operating system: +3*2Tdarwin_Darwin/Mac OS X +3*2Temx_OS/2 via EMX (including EMX/RSX extender) +3*2Tfreebsd_FreeBSD +3*2Tgo32v2_Version 2 of DJ Delorie DOS extender +3*2Tiphonesim_ iPhoneSimulator from iOS SDK 3.2+ (older versions: -Tdarwin) +3*2Tlinux_Linux +3*2Tnetbsd_NetBSD +3*2Tnetware_Novell Netware Module (clib) +3*2Tnetwlibc_Novell Netware Module (libc) +3*2Topenbsd_OpenBSD +3*2Tos2_OS/2 / eComStation +3*2Tsunos_SunOS/Solaris +3*2Tsymbian_Symbian OS +3*2Tsolaris_Solaris +3*2Twatcom_Watcom compatible DOS extender +3*2Twdosx_WDOSX DOS extender +3*2Twin32_Windows 32 Bit +3*2Twince_Windows CE +4*2Tdarwin_Darwin/Mac OS X +4*2Tlinux_Linux +4*2Twin64_Win64 (64 bit Windows systems) +6*2Tamiga_Commodore Amiga +6*2Tatari_Atari ST/STe/TT +6*2Tlinux_Linux +6*2Tpalmos_PalmOS +A*2Tdarwin_Darwin/iPhoneOS/iOS +A*2Tlinux_Linux +A*2Twince_Windows CE +P*2Tamiga_AmigaOS +P*2Tdarwin_Darwin/Mac OS X +P*2Tlinux_Linux +P*2Tmacos_Mac OS (classic) +P*2Tmorphos_MorphOS +S*2Tsolaris_Solaris +S*2Tlinux_Linux +**1u<x>_Undefines the symbol <x> +**1U_Unit options: +**2Un_Do not check where the unit name matches the file name +**2Ur_Generate release unit files (never automatically recompiled) +**2Us_Compile a system unit +**1v<x>_Be verbose. <x> is a combination of the following letters: +**2*_e : Show errors (default) 0 : Show nothing (except errors) +**2*_w : Show warnings u : Show unit info +**2*_n : Show notes t : Show tried/used files +**2*_h : Show hints c : Show conditionals +**2*_i : Show general info d : Show debug info +**2*_l : Show linenumbers r : Rhide/GCC compatibility mode +**2*_s : Show time stamps q : Show message numbers +**2*_a : Show everything x : Executable info (Win32 only) +**2*_b : Write file names messages p : Write tree.log with parse tree +**2*_ with full path v : Write fpcdebug.txt with +**2*_ lots of debugging info +**2*_m<x>,<y> : Don't show messages numbered <x> and <y> +**1W<x>_Target-specific options (targets) +3*2WA_Specify native type application (Windows) +4*2WA_Specify native type application (Windows) +A*2WA_Specify native type application (Windows) +3*2Wb_Create a bundle instead of a library (Darwin) +P*2Wb_Create a bundle instead of a library (Darwin) +p*2Wb_Create a bundle instead of a library (Darwin) +A*2Wb_Create a bundle instead of a library (Darwin) +4*2Wb_Create a bundle instead of a library (Darwin) +3*2WB_Create a relocatable image (Windows, Symbian) +3*2WBxxxx_Set image base to xxxx (Windows, Symbian) +4*2WB_Create a relocatable image (Windows) +4*2WBxxxx_Set image base to xxxx (Windows) +A*2WB_Create a relocatable image (Windows, Symbian) +A*2WBxxxx_Set image base to xxxx (Windows, Symbian) +3*2WC_Specify console type application (EMX, OS/2, Windows) +4*2WC_Specify console type application (EMX, OS/2, Windows) +A*2WC_Specify console type application (Windows) +P*2WC_Specify console type application (Classic Mac OS) +3*2WD_Use DEFFILE to export functions of DLL or EXE (Windows) +4*2WD_Use DEFFILE to export functions of DLL or EXE (Windows) +A*2WD_Use DEFFILE to export functions of DLL or EXE (Windows) +3*2We_Use external resources (Darwin) +4*2We_Use external resources (Darwin) +A*2We_Use external resources (Darwin) +P*2We_Use external resources (Darwin) +p*2We_Use external resources (Darwin) +3*2WF_Specify full-screen type application (EMX, OS/2) +3*2WG_Specify graphic type application (EMX, OS/2, Windows) +4*2WG_Specify graphic type application (EMX, OS/2, Windows) +A*2WG_Specify graphic type application (Windows) +P*2WG_Specify graphic type application (Classic Mac OS) +3*2Wi_Use internal resources (Darwin) +4*2Wi_Use internal resources (Darwin) +A*2Wi_Use internal resources (Darwin) +P*2Wi_Use internal resources (Darwin) +p*2Wi_Use internal resources (Darwin) +3*2WI_Turn on/off the usage of import sections (Windows) +4*2WI_Turn on/off the usage of import sections (Windows) +A*2WI_Turn on/off the usage of import sections (Windows) +3*2WN_Do not generate relocation code, needed for debugging (Windows) +4*2WN_Do not generate relocation code, needed for debugging (Windows) +A*2WN_Do not generate relocation code, needed for debugging (Windows) +A*2Wpxxxx_Specify the controller type, see fpc -i for possible values +V*2Wpxxxx_Specify the controller type, see fpc -i for possible values +3*2WR_Generate relocation code (Windows) +4*2WR_Generate relocation code (Windows) +A*2WR_Generate relocation code (Windows) +P*2WT_Specify MPW tool type application (Classic Mac OS) +**2WX_Enable executable stack (Linux) +**1X_Executable options: +**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Linux) +**2Xd_Do not use standard library search path (needed for cross compile) +**2Xe_Use external linker +**2Xg_Create debuginfo in a separate file and add a debuglink section to executable +**2XD_Try to link units dynamically (defines FPC_LINK_DYNAMIC) +**2Xi_Use internal linker +**2Xm_Generate link map +**2XM<x>_Set the name of the 'main' program routine (default is 'main') +**2XP<x>_Prepend the binutils names with the prefix <x> +**2Xr<x>_Set the linker's rlink-path to <x> (needed for cross compile, see the ld manual for more information) (BeOS, Linux) +**2XR<x>_Prepend <x> to all linker search paths (BeOS, Darwin, FreeBSD, Linux, Mac OS, Solaris) +**2Xs_Strip all symbols from executable +**2XS_Try to link units statically (default, defines FPC_LINK_STATIC) +**2Xt_Link with static libraries (-static is passed to linker) +**2XX_Try to smartlink units (defines FPC_LINK_SMART) +**1*_ +**1?_Show this help +**1h_Shows this help without waiting +] + +# +# The End... diff --git a/closures/compiler/msg/errores.msg b/closures/compiler/msg/errores.msg new file mode 100644 index 0000000000..de54fd789d --- /dev/null +++ b/closures/compiler/msg/errores.msg @@ -0,0 +1,2375 @@ +# **************** don't edit! ******************* +# edit erroresu.msg and convert it to iso-8859-15 +# by e.g. +# recode utf-8..iso-8859-15 +# and save it as errores.msg +# ************************************************ +# +# This file is part of the Free Pascal Compiler +# Copyright (c) 1999-2000 by the Free Pascal Development team +# +# Spanish Language File for Free Pascal +# +# 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. +# +# +# The constants are build in the following order: +# <part>_<type>_<txtidentifier> +# +# <part> is the part of the compiler the message is used +# asmr_ assembler parsing +# asmw_ assembler writing/binary writers + +# unit_ unit handling +# scan_ scanner +# parser_ parser +# type_ type checking +# general_ general info +# exec_ calls to assembler, linker, binder +# +# <type> the type of the message it should normally used for +# f_ fatal error +# e_ error +# w_ warning +# n_ note +# h_ hint +# i_ info +# l_ add linenumber +# u_ used +# t_ tried +# c_ conditional +# d_ debug message +# x_ executable informations +# + +# +# General +# +# 01016 is the last used one +# +# BeginOfTeX +% \section{General compiler messages} +% This section gives the compiler messages which are not fatal, but which +% display useful information. The number of such messages can be +% controlled with the various verbosity level \var{-v} switches. +% \begin{description} +general_t_compilername=01000_T_Compilador: $1 +% When the \var{-vt} switch is used, this line tells you what compiler +% is used. +general_d_sourceos=01001_D_SO del host: $1 +% When the \var{-vd} switch is used, this line tells you what the source +% operating system is. +general_i_targetos=01002_I_SO de destino: $1 +% When the \var{-vd} switch is used, this line tells you what the target +% operating system is. +general_t_exepath=01003_T_Usando la ruta para ejecutables: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its binaries. +general_t_unitpath=01004_T_Usando la ruta para unidades: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for compiled units. You can set this path with the \var{-Fu} +general_t_includepath=01005_T_Usando la ruta para inclusiones: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its include files (files used in \var{\{\$I xxx\}} statements). +% You can set this path with the \var{-I} option. +general_t_librarypath=01006_T_Usando la ruta para bibliotecas: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for the libraries. You can set this path with the \var{-Fl} option. +general_t_objectpath=01007_T_Usando la ruta para objetos: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for object files you link in (files used in \var{\{\$L xxx\}} statements). +% You can set this path with the \var{-Fo} option. +general_i_abslines_compiled=01008_I_$1 Líneas compiladas, $2 seg +% When the \var{-vi} switch is used, the compiler reports the number +% of lines compiled, and the time it took to compile them (real time, +% not program time). +general_f_no_memory_left=01009_F_No queda suficiente memoria disponible +% The compiler doesn't have enough memory to compile your program. There are +% several remedies for this: +% \begin{itemize} +% \item If you're using the build option of the compiler, try compiling the +% different units manually. +% \item If you're compiling a huge program, split it up in units, and compile +% these separately. +% \item If the previous two don't work, recompile the compiler with a bigger +% heap (you can use the \var{-Ch} option for this, \seeo{Ch}) +% \end{itemize} +general_i_writingresourcefile=01010_I_Escribiendo archivo de recursos de tabla de cadenas: $1 +% This message is shown when the compiler writes the Resource String Table +% file containing all the resource strings for a program. +general_e_errorwritingresourcefile=01011_E_Escribiendo archivo de recursos de tabla de cadenas: $1 +% This message is shown when the compiler encountered an error when writing +% the Resource String Table file +general_i_fatal=01012_I_Fatal: +% Prefix for Fatal Errors +general_i_error=01013_I_Error: +% Prefix for Errors +general_i_warning=01014_I_Aviso: +% Prefix for Warnings +general_i_note=01015_I_Nota: +% Prefix for Notes +general_i_hint=01016_I_Consejo: +% Prefix for Hints +general_e_path_does_not_exist=01017_E_La ruta "$1" no existe +% The specified path does not exist. +general_e_compilation_aborted=01018_E_Compilación abortada +% \end{description} +# +# Scanner +# +# 02063 is the last used one +# +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compiling handling. +% \begin{description} +scan_f_end_of_file=02000_F_Final de fichero inesperado +% this typically happens in one of the following cases : +% \begin{itemize} +% \item The source file ends before the final \var{end.} statement. This +% happens mostly when the \var{begin} and \var{end} statements aren't +% balanced; +% \item An include file ends in the middle of a statement. +% \item A comment was not closed +% \end{itemize} +scan_f_string_exceeds_line=02001_F_La cadena excede la línea +% There is a missing closing ' in a string, so it occupies +% multiple lines. +scan_f_illegal_char=02002_F_Caracter inválido +% An illegal character was encountered in the input file. +scan_f_syn_expected=02003_F_Error de sintaxis, se esperaba "$1" pero se encontró "$2" +% This indicates that the compiler expected a different token than +% the one you typed. It can occur almost everywhere where you make a +% mistake against the pascal language. +scan_t_start_include_file=02004_TL_Empezando a leer el fichero incluido $1 +% When you provide the \var{-vt} switch, the compiler tells you +% when it starts reading an included file. +scan_w_comment_level=02005_W_Nivel de comentario anidado $1 encontrado +% When the \var{-vw} switch is used, then the compiler warns you if +% it finds nested comments. Nested comments are not allowed in Turbo Pascal +% and can be a possible source of errors. +scan_n_ignored_switch=02008_N_Directiva de compilación $1 ignorado +% With \var{-vn} on, the compiler warns if it ignores a switch +scan_w_illegal_switch=02009_W_Directiva de compilación $i inválida +% You included a compiler switch (i.e. \var{\{\$... \}}) which the compiler +% does not recognise +scan_w_switch_is_global=02010_W_Esta opción de compilacion tiene un efecto global +% The compiler switch is misplaced, and should be located at +% the start of the unit or program. +scan_e_illegal_char_const=02011_E_Constante de caracter inválido +% This happens when you specify a character with its ASCII code, as in +% \var{\#96}, but the number is either illegal, or out of range. +scan_f_cannot_open_input=02012_F_No se puede abrir el fichero "$1" +% \fpc cannot find the program or unit source file you specified on the +% command line. +scan_f_cannot_open_includefile=02013_F_No se puede abrir el fichero de inclusion "$1" +% \fpc cannot find the source file you specified in a \var{\{\$include ..\}} +% statement. +scan_w_only_pack_records=02015_W_Los campos de los registros pueden ser alineados solo a 1, 2, 4 o 16 bytes +% You are specifying the \var{\{\$PACKRECORDS n\} } with an illegal value for +% \var{n}. Only 1, 2, 4, 8, 16 and 32 are valid in this case. +scan_w_only_pack_enum=02016_W_Los tipos enumerados solo pueden ser almacenados en 1, 2 o 4 bytes +% You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for +% \var{n}. Only 1,2 or 4 are valid in this case. +scan_e_endif_expected=02017_E_$1 esperado para $2 definido en la línea $3 +% Your conditional compilation statements are unbalanced. +scan_e_preproc_syntax_error=02018_E_Error de sintaxis mientras se procesaba una expresión de compilación condicional +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc compiler +% directives. +scan_e_error_in_preproc_expr=02019_E_Evaluando una expresión de compilación condicional +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc compiler +% directives. +scan_w_macro_cut_after_255_chars=02020_W_El contenido de las macros esta limitado a 255 caracteres de longitud +% The contents of macros cannot be longer than 255 characters. +scan_e_endif_without_if=02021_E_ENDIF sin IF(N)DEF +% Your \var{\{\$IFDEF ..\}} and {\{\$ENDIF\}} statements aren't balanced. +scan_f_user_defined=02022_F_Error de usuario: $1 +% A user defined fatal error occurred. see also the \progref +scan_e_user_defined=02023_E_Error de usuario: $1 +% A user defined error occurred. see also the \progref +scan_w_user_defined=02024_W_Aviso de usuario: $1 +% A user defined warning occurred. see also the \progref +scan_n_user_defined=02025_N_Nota de usuario: $1 +% A user defined note was encountered. see also the \progref +scan_h_user_defined=02026_H_Consejo de usuario: $1 +% A user defined hint was encountered. see also the \progref +scan_i_user_defined=02027_I_Informacion de usuario: $1 +% User defined information was encountered. see also the \progref +scan_e_keyword_cant_be_a_macro=02028_E_Palabra clave redefinida como macro no tiene efecto +% You cannot redefine keywords with macros. +scan_f_macro_buffer_overflow=02029_F_Desbordamiento del buffer de macro durante la lextura o expansión +% Your macro or its result was too long for the compiler. +can_w_macro_too_deep=02030_W_La expansión de macros excede una profundidad de 16. +% When expanding a macro, macros have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_w_wrong_styled_switch=02031_W_Las directivas de compilacióon no estan soportadas en comentarios estilo // +% Compiler switches should be in normal pascal style comments. +scan_d_handling_switch=02032_DL_Manejando la directiva "$1" +% When you set debugging info on (\var{-vd}) the compiler tells you when it +% is evaluating conditional compile statements. +scan_c_endif_found=02033_CL_ENDIF $1 encontrado +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifdef_found=02034_CL_IFDEF $1 encontrado, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifopt_found=02035_CL_IFOPT $1 encontrado, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_if_found=02036_CL_IF $1 encontrado, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifndef_found=02037_CL_IFNDEF $1 encontrado, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_else_found=02038_CL_ELSE $1 encontrado, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_skipping_until=02039_CL_Omitiendo hasta... +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements, and whether it is skipping or +% compiling parts. +scan_i_press_enter=02040_I_Presione <retorno> para continuar +% When the \var{-vi} switch is used, the compiler stops compilation +% and waits for the \var{Enter} key to be pressed when it encounters +% a \var{\{\$STOP\}} directive. +scan_w_unsupported_switch=02041_W_Conmutador "$1" no soportado +% When warnings are turned on (\var{-vw}) the compiler warns you about +% unsupported switches. This means that the switch is used in Delphi or +% Turbo Pascal, but not in \fpc +scan_w_illegal_directive=02042_W_Directiva de compilación "$1" inválida +% When warings are turned on (\var{-vw}) the compiler warns you about +% unrecognised switches. For a list of recognised switches, \progref +scan_t_back_in=02043_TL_Vuelve en $1 +% When you use (\var{-vt}) the compiler tells you when it has finished +% reading an include file. +scan_w_unsupported_app_type=02044_W_Tipo de aplicación no soportada: "$1" +% You get this warning, if you specify an unknown application type +% with the directive \var{\{\$APPTYPE\}} +scan_w_app_type_not_support=02045_W_APPTYPE no es soportado por el SO de destino +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_w_description_not_support=02046_W_DESCRIPTION no es soportado por el SO de destino +% The \var{\{\$DESCRIPTION\}} directive is not supported on this target OS +scan_n_version_not_support=02047_N_VERSION no es soportado por el SO de destino +% The \var{\{\$VERSION\}} directive is not supported on this target OS +scan_n_only_exe_version=02048_N_VERSION sólo para EXEs o DLLs +% The \var{\{\$VERSION\}} directive is only used for executable or DLL sources. +scan_w_wrong_version_ignored=02049_W_Formato erroneo para la directiva VERSION: "$1" +% The \var{\{\$VERSION\}} directive format is majorversion.minorversion +% where majorversion and minorversion are words. +scan_e_illegal_asmmode_specifier=02050_E_Estilo de ensamblador inváalido especificado: "$1" +% When you specify an assembler mode with the \var{\{\$ASMMODE xxx\}} +% the compiler didn't recognize the mode you specified. +scan_w_no_asm_reader_switch_inside_asm=02051_W_No es posible cambiar el lector dentro de una sentencia asm. "$1" solo sera efectivo en los siguientes +% It is not possible to switch from one assembler reader to another +% inside an assmebler block. The new reader will be used for next +% assembler statements only. +scan_e_wrong_switch_toggle=02052_E_Modificador de conmutador erróneo, use ON/OFF o +/- +% You need to use ON or OFF or a + or - to toggle the switch +scan_e_resourcefiles_not_supported=02053_E_Los ficheros de recursos no son soportados por la plataforma de destino +% The target you are compiling for doesn't support resource files. +scan_w_include_env_not_found=02054_W_Variable de entorno incluida "$1" no encontrada. +% The included environment variable can't be found in the environment, it will +% be replaced by an empty string instead. +scan_e_invalid_maxfpureg_value=02055_E_Valor inválido para el registro de la FPU +% Valid values for this directive are 0..8 and NORMAL/DEFAULT +scan_w_only_one_resourcefile_supported=02056_W_La plataforma de destino solo soporta un archivo de recursos +% The target you are compiling for supports only one resource file. +% The first resource file found is used, the others are discarded. +scan_w_macro_support_turned_off=02057_W_El soporte para macros ha sido deshabilitado +% A macro declaration has been found, but macro support is currently off, +% so the declaration will be ignored. To turn macro support on compile with +% -Sm on the commandline or add \{\$MACRO ON\} in the source +scan_e_invalid_interface_type=02058_E_El tipo de interfaz especificado es inválido. Debe ser COM, CORBA o DEFAULT +% The interface type that was specified is not supported +scan_w_appid_not_support=02059_W_APPID solo esta soportado para PalmOS +% The \var{\{\$APPID\}} directive is only supported for the PalmOS target. +scan_w_appname_not_support=02060_W_APPNAME solo esta soportado para PalmOS +% The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target. +scan_e_string_exceeds_255_chars=02061_E_Las constantes de cadena no pueden ser de mas de 255 caracteres de longitud +% A single string constant can contain at most 255 chars. Try splitting up the +% string in multiple smaller parts and concatenate them with a + operator. +scan_f_include_deep_ten=02062_F_La inclusion de archivos no puede exceder 16 niveles +% When including include files the files have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_e_too_many_push=02063_F_Demasiados niveles de PUSH +% A maximum of 20 levels is allowed. This error occurs only in mode MacPas. +scan_e_too_many_pop=02064_E_A POP sin un PUSH previo +% This error occurs only in mode MacPas. +scan_e_error_macro_lacks_value=02065_E_Macro o variable de compilación "$1" no tiene ningún valor +% Thus the conditional compiling expression cannot be evaluated. +scan_e_wrong_switch_toggle_default=02066_E_Valor invalido para el conmutado, use ON/OFF/DEFAULT o +/-/* +% You need to use ON or OFF or DEFAULT or a + or - or * to toggle the switch +scan_e_mode_switch_not_allowed=02067_E_No esta permitido cambiar de modo a "$1" aqui +% A mode switch has already been encountered, or, in case of option -Mmacpas, +% a mode switch occur after UNIT. +scan_e_error_macro_undefined=02068_E_Variable en tiempo de compilación "$1" no ha sido definida. +% Thus the conditional compile time expression cannot be evaluated. +% \end{description} +# +# Parser +# +# 03192 is the last used one +# +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your pascal constructs +% are correct. +% \begin{description} +parser_e_syntax_error=03000_E_Analizador - Error de sintaxis +% An error against the Turbo Pascal language was encountered. This happens +% typically when an illegal character is found in the sources file. +parser_e_dont_nest_interrupt=03004_E_Los procedimientos INTERRUPT no pueden ser anidados +% An \var{INTERRUPT} procedure must be global. +parser_w_proc_directive_ignored=03005_W_Tipo de procedimiento "$1" ignorado +% The specified is ignored by FPC programs. +parser_e_no_overload_for_all_procs=03006_E_No todas las declaraciones de "$1" llevan OVERLOAD +% When you want to use overloading using the \var{OVERLOAD} directive, then +% all declarations need to have \var{OVERLOAD} specified. +parser_e_export_name_double=03008_E_Nombre de funcion exportada "$1" duplicado +% Exported function names inside a specific DLL must all be different +parser_e_export_ordinal_double=03009_E_Indice de funcion exportada "$1" duplicado +% Exported function names inside a specific DLL must all be different +parser_e_export_invalid_index=03010_E_Indice de funcion exportada inválido +% DLL function index must be in the range \var{1..\$FFFF} +parser_w_parser_reloc_no_debug=03011_W_La informacion de depurado $1 para ejecutables o DLLs reubicables no funciona. Desactivado. +parser_w_parser_win32_debug_needs_WN=03012_W_Para permitir el depurado en win32 las reubicaciones deben ser desactivadas con la opcion -WN +% Stabs info is wrong for relocatable DLL or EXES use -WN +% if you want to debug win32 executables. +parser_e_constructorname_must_be_init=03013_E_El nombre del constructor debe ser INIT +% You are declaring an object constructor with a name which is not \var{init}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_destructorname_must_be_done=03014_E_El nombre del destructor debe ser DONE +% You are declaring an object destructor with a name which is not \var{done}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_proc_inline_not_supported=03016_E_Procedimientos tipo INLINE no soportados +% You tried to compile a program with C++ style inlining, and forgot to +% specify the \var{-Si} option (\seeo{Si}). The compiler doesn't support C++ +% styled inlining by default. +parser_w_constructor_should_be_public=03018_W_El constructor debería ser público +% Constructors must be in the 'public' part of an object (class) declaration. +parser_w_destructor_should_be_public=03019_W_El destructor debería ser público +% Destructors must be in the 'public' part of an object (class) declaration. +parser_n_only_one_destructor=03020_N_Una clase debería tener solo un destructor +% You can declare only one destructor for a class. +parser_e_no_local_objects=03021_E_Las definiciones de clases locales no están permitidas +% Classes must be defined globally. They cannot be defined inside a +% procedure or function +parser_f_no_anonym_objects=03022_F_Las definiciones de clases anónimas no están permitidas +% An invalid object (class) declaration was encountered, i.e. an +% object or class without methods that isn't derived from another object or +% class. For example: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% will trigger this error. +parser_n_object_has_no_vmt=03023_N_El objeto "$1" no tiene VMT +% This is a note indicating that the declared object has no +% virtual method table. +parser_e_illegal_parameter_list=03024_E_Lista de parámetros inválida +% You are calling a function with parameters that are of a different type than +% the declared parameters of the function. +parser_e_wrong_parameter_size=03026_E_Numero de parámetros incorrecto +% There is an error in the parameter list of the function or procedure, +% the number of parameters is not correct. +parser_e_overloaded_no_procedure=03027_E_el identificador sobrecargado "$1" no es una función +% The compiler encountered a symbol with the same name as an overloaded +% function, but it is not a function it can overload. +parser_e_overloaded_have_same_parameters=03028_E_funciones sobrecargadas tienen los mismos par metros +% You're declaring overloaded functions, but with the same parameter list. +% Overloaded function must have at least 1 different parameter in their +% declaration. +parser_e_header_dont_match_forward=03029_E_la cabecera de la función no concuerda con la declaración posterior "$1" +% You declared a function with same parameters but +% different result type or function modifiers. +parser_e_header_different_var_names=03030_E_la cabecera de la funcion "$1" no concuerda con la posterior declaración : el nombre de la variable cambia $2 => $3 +% You declared the function in the \var{interface} part, or with the +% \var{forward} directive, but define it with a different parameter list. +parser_n_duplicate_enum=03031_N_el orden de los valores en una enumeracion debe ser ascendente +% \fpc allows enumeration constructions as in C. Given the following +% declaration two declarations: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% The second declaration would produce an error. \var{A\_UAS} needs to have a +% value higher than \var{A\_E}, i.e. at least 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_With no puede ser usado con variables en segmentos diferentes +% With stores a variable locally on the stack, +% but this is not possible if the variable belongs to another segment. +parser_e_too_much_lexlevel=03034_E_Anidado de funciones > 31 +% You can nest function definitions only 31 times. +parser_e_range_check_error=03035_E_error en la comprobación de rangos mientras se evaluaban constantes +% The constants are out of their allowed range. +parser_w_range_check_error=03036_W_error en la comprobacion de rangos mientras se evaluaban constantes +% The constants are out of their allowed range. +parser_e_double_caselabel=03037_E_etiqueta de caso duplicada +% You are specifying the same label 2 times in a \var{case} statement. +parser_e_case_lower_less_than_upper_bound=03038_E_El líimite superior del caso es menor que el inferior +% The upper bound of a \var{case} label is less than the lower bound and this +% is useless +parser_e_type_const_not_possible=03039_E_no se permiten constantes con tipo de clases +% You cannot declare a constant of type class or object. +parser_e_no_overloaded_procvars=03040_E_no se permite asignar a variables de funcion funciones sobrecargadas +% You are trying to assign an overloaded function to a procedural variable. +% This is not allowed +parser_e_invalid_string_size=03041_E_la longitud de una cadena tiene que ser un valor entre 1 y 255 +% The length of a shortstring in Pascal is limited to 255 characters. You are +% trying to declare a string with length lower than 1 or greater than 255 +parser_w_use_extended_syntax_for_objects=03042_W_use la sintaxis estendida de DISPOSE y NEW para instancias de objetos +% If you have a pointer \var{a} to a class type, then the statement +% \var{new(a)} will not initialize the class (i.e. the constructor isn't +% called), although space will be allocated. you should issue the +% \var{new(a,init)} statement. This will allocate space, and call the +% constructor of the object +parser_w_no_new_dispose_on_void_pointers=03043_W_el uso de NEW o DISPOSE para punteros sin tipo no tiene sentido +parser_e_no_new_dispose_on_void_pointers=03044_E_el uso de NEW o DISPOSE no es posible con punteros sin tipo +% You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer +% because no size is associated to an untyped pointer. +% Accepted for compatibility in \var{tp} and \var{delphi} modes. +parser_e_class_id_expected=03045_E_identificador de clase esperado +% This happens when the compiler scans a procedure declaration that contains +% a dot, +% i.e., a object or class method, but the type in front of the dot is not +% a known type. +parser_e_no_type_not_allowed_here=03046_E_identificador de tipo no permitido aquí +% You cannot use a type inside an expression. +parser_e_methode_id_expected=03047_E_identificador de método esperado +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_e_header_dont_match_any_member=03048_E_la cabecera de la funcion no concuerda con ningún método de esta clase "$1" +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_d_procedure_start=03049_DL_proceduimiento/función $1 +% When using the \var{-vd} switch, the compiler tells you when it starts +% processing a procedure or function implementation. +parser_e_error_in_real=03050_E_Constante de punto flotante inválida +% The compiler expects a floating point expression, and gets something else. +parser_e_fail_only_in_constructor=03051_E_FAIL solo puede ser usado en constructores +% You are using the \var{fail} keyword outside a constructor method. +parser_e_no_paras_for_destructor=03052_E_Los destructores no pueden tener parámetros +% You are declaring a destructor with a parameter list. Destructor methods +% cannot have parameters. +parser_e_only_class_methods_via_class_ref=03053_E_Solo los métodos de clases pueden ser referidos con referencias de clase +% This error occurs in a situation like the following: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} is not a class method and hence cannot be called with a class +% reference. +parser_e_only_class_methods=03054_E_Los métodos de clase solo pueden ser acceder a otros métodos de clase +% This is related to the previous error. You cannot call a method of an object +% from a inside a class method. The following code would produce this error: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% Because free is a normal method of a class it cannot be called from a class +% method. +parser_e_case_mismatch=03055_E_Los tipos de la constante y del CASE no concuerdan +% One of the labels is not of the same type as the case variable. +parser_e_illegal_symbol_exported=03056_E_El símbolo no puede ser exportado de una librería +% You can only export procedures and functions when you write a library. You +% cannot export variables or constants. +parser_w_should_use_override=03057_W_Un método heredado ha sido ocultado por "$1" +% A method that is declared \var{virtual} in a parent class, should be +% overridden in the descendent class with the \var{override} directive. If you +% don't specify the \var{override} directive, you will hide the parent method; +% you will not override it. +parser_e_nothing_to_be_overridden=03058_E_No hay un método en una clase antepasada para ser substituido: "$1" +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_no_procedure_to_access_property=03059_E_No se suministro un miembro para acceder a propiedad +% You specified no \var{read} directive for a property. +parser_w_stored_not_implemented=03060_W_La directiva de propiedad Stored no esta implementada aún +% The \var{stored} directive is not yet implemented +parser_e_ill_property_access_sym=03061_E_símbolo inváalido para el acceso a la propiedad +% There is an error in the \var{read} or \var{write} directives for an array +% property. When you declare an array property, you can only access it with +% procedures and functions. The following code woud cause such an error. +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_No se puede acceder a un campo protegido de un objeto aquí +% Fields that are declared in a \var{protected} section of an object or class +% declaration cannot be accessed outside the module wher the object is +% defined, or outside descendent object methods. +parser_e_cant_access_private_member=03063_E_No se puede acceder a un campo privado de un objeto aquí +% Fields that are declared in a \var{private} section of an object or class +% declaration cannot be accessed outside the module where the class is +% defined. +parser_e_overridden_methods_not_same_ret=03066_E_los métodos reemplazados deben tener el mismo tipo de dato devuelto: "$2" es reemplazado por "$1" que devuelve otro tipo +% If you declare overridden methods in a class definition, they must +% have the same return type. +parser_e_dont_nest_export=03067_E_Las funciones declarados como EXPORT no pueden estar anidados +% You cannot declare a function or procedure within a function or procedure +% that was declared as an export procedure. +parser_e_methods_dont_be_export=03068_E_los métodos no pueden ser EXPORTados +% You cannot declare a procedure that is a method for an object as +% \var{export}ed. +parser_e_call_by_ref_without_typeconv=03069_E_en llamadas con parámetros VAR los tipos deben coincidir exactamente. Se recibio "$1" cuando se esperaba "$2" +% When calling a function declared with \var{var} parameters, the variables in +% the function call must be of exactly the same type. There is no automatic +% type conversion. +parser_e_no_super_class=03070_E_La clase no es un ancestor de la clase actual +% When calling inherited methods, you are trying to call a method of a non-related +% class. You can only call an inherited method of a parent class. +parser_e_self_not_in_method=03071_E_SELF solo está permitido en métodos +% You are trying to use the \var{self} parameter outside an object's method. +% Only methods get passed the \var{self} parameters. +parser_e_generic_methods_only_in_methods=03072_E_los métodos solo pueden estar en otros métodos llamados directamente con el tipo identificador de la clase +% A construction like \var{sometype.somemethod} is only allowed in a method. +parser_e_illegal_colon_qualifier=03073_E_Uso inválido de ':' +% You are using the format \var{:} (colon) 2 times on an expression that +% is not a real expression. +parser_e_illegal_set_expr=03074_E_Error en la comprobación de rangos en el constructor del set, o elemento duplicado en el set +% The declaration of a set contains an error. Either one of the elements is +% outside the range of the set type, either two of the elements are in fact +% the same. +parser_e_pointer_to_class_expected=03075_E_Se esperaba un puntero a objeto +% You specified an illegal type in a \var{new} statement. +% The extended syntax of \var{new} needs an object as a parameter. +parser_e_expr_have_to_be_constructor_call=03076_E_La expresión tiene que ser una llamada al constructor +% When using the extended syntax of \var{new}, you must specify the constructor +% method of the object you are trying to create. The procedure you specified +% is not a constructor. +parser_e_expr_have_to_be_destructor_call=03077_E_La expresión tiene que ser una llamada al destructor +% When using the extended syntax of \var{dispose}, you must specify the +% destructor method of the object you are trying to dispose of. +% The procedure you specified is not a destructor. +parser_e_invalid_record_const=03078_E_Orden de los campos del registro incorrecto +% When declaring a constant record, you specified the fields in the wrong +% order. +parser_e_false_with_expr=03079_E_El tipo de la expresión tiene que ser class o record +% A \var{with} statement needs an argument that is of the type \var{record} +% or \var{class}. You are using \var{with} on an expression that is not of +% this type. +parser_e_void_function=03080_E_Los procedimientos no pueden devolver ningún valor +% In \fpc, you can specify a return value for a function when using +% the \var{exit} statement. This error occurs when you try to do this with a +% procedure. Procedures cannot return a value. +parser_e_only_methods_allowed=03081_E_constructores, destructors y class operators deben ser métodos +% You're declaring a procedure as destructor, constructor or class operator, when the +% procedure isn't a class method. +parser_e_operator_not_overloaded=03082_E_El operador no esta sobrecargado +% You're trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_no_such_assignment=03083_E_Imposible sobrecargar operador de asignacion para tipos iguales +% You can not overload assignment for types +% that the compiler considers as equal. +parser_e_overload_impossible=03084_E_Sobrecarga de operador imposible +% The combination of operator, arguments and return type are +% incompatible. +parser_e_no_reraise_possible=03085_E_Re-lanzamiento de la excepcion no es posible aquí +% You are trying to raise an exception where it is not allowed. You can only +% raise exceptions in an \var{except} block. +parser_e_no_new_or_dispose_for_classes=03086_E_La sintaxis extendida de new o dispose no está permitida para una clase +% You cannot generate an instance of a class with the extended syntax of +% \var{new}. The constructor must be used for that. For the same reason, you +% cannot call \var{dispose} to de-allocate an instance of a class, the +% destructor must be used for that. +parser_e_procedure_overloading_is_off=03088_E_La sobrecarga de funciones no esta activada +% When using the \var{-So} switch, procedure overloading is switched off. +% Turbo Pascal does not support function overloading. +parser_e_overload_operator_failed=03089_E_No es posible sobrecargar este operador (sobrecarge en cambio "=" ) +% You are trying to overload an operator which cannot be overloaded. +% The following operators can be overloaded : +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_Operador comparativo tiene que devolver un valor booleano +% When overloading the \var{=} operator, the function must return a boolean +% value. +parser_e_only_virtual_methods_abstract=03091_E_Solo los métodos virtuales pueden ser abstractos +% You are declaring a method as abstract, when it is not declared to be +% virtual. +parser_f_unsupported_feature=03092_F_Uso de característica no soportada! +% You're trying to force the compiler into doing something it cannot do yet. +parser_e_mix_of_classes_and_objects=03093_E_No se permite la mezcla de objetos de diferentes tipos (class, object, interface, etc) +% You cannot derive \var{objects}, \var{classes}, \var{cppclasses} and \var{interfaces} interttwined . E.g. +% a class cannot have an object as parent and vice versa. +parser_w_unknown_proc_directive_ignored=03094_W_Directiva de procedimiento desconocida fue ignorada: "$1" +% The procedure directive you specified is unknown. +parser_e_absolute_only_one_var=03095_E_absolute solo puede estar asociado a una variable +% You cannot specify more than one variable before the \var{absolute} directive. +% Thus, the following construct will provide this error: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +% \item [ absolute can only be associated a var or const ] +% The address of a \var{absolute} directive can only point to a variable or a +% typed constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_absolute_only_to_var_or_const=03096_E_absolute solo puede ser asociado con var o const +% The address of a \var{absolute} directive can only point to a variable or +% constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_initialized_only_one_var=03097_E_Solo una variable puede ser inicializada +% You cannot specify more than one variable with a initial value +% in Delphi mode. +parser_e_abstract_no_definition=03098_E_Métodos abstractos no deberían tener ninguna definición (con el cuerpo de la función) +% Abstract methods can only be declared, you cannot implement them. They +% should be overridden by a descendant class. +parser_e_overloaded_must_be_all_global=03099_E_Esta función sobrecargada no puede ser local (debe ser exportada) +% You are defining a overloaded function in the implementation part of a unit, +% but there is no corresponding declaration in the interface part of the unit. +parser_w_virtual_without_constructor=03100_W_Métodos virtuales están siendo usados sin un constructor en "$1" +% If you declare objects or classes that contain virtual methods, you need +% to have a constructor and destructor to initialize them. The compiler +% encountered an object or class with virtual methods that doesn't have +% a constructor/destructor pair. +parser_c_macro_defined=03101_CL_Macro definido: $1 +% When \var{-vc} is used, the compiler tells you when it defines macros. +parser_c_macro_undefined=03102_CL_Macro indefinido: $1 +% When \var{-vc} is used, the compiler tells you when it undefines macros. +parser_c_macro_set_to=03103_CL_Macro $1 asignado a $2 +% When \var{-vc} is used, the compiler tells you what values macros get. +parser_i_compiling=03104_I_Compilando $1 +% When you turn on information messages (\var{-vi}), the compiler tells you +% what units it is recompiling. +parser_u_parsing_interface=03105_UL_Interpretando interfaz de la unidad $1 +% This tells you that the reading of the interface +% of the current unit starts +parser_u_parsing_implementation=03106_UL_Interpretando implementacion de la unidad $1 +% This tells you that the code reading of the implementation +% of the current unit, library or program starts +parser_d_compiling_second_time=03107_DL_Compilando $1 por segunda vez +% When you request debug messages (\var{-vd}) the compiler tells you what +% units it recompiles for the second time. +parser_e_no_property_found_to_override=03109_E_No se encontro la propiedad a reemplazar +% You want to overrride a property of a parent class, when there is, in fact, +% no such property in the parent class. +parser_e_only_one_default_property=03110_E_Sólo se permite una única propiedad por defecto +% You specified a property as \var{Default}, but the class already has a +% default property, and a class can have only one default property. +parser_e_property_need_paras=03111_E_La propiedad por defecto tiene que ser un array +% Only array properties of classes can be made \var{default} properties. +parser_e_constructor_cannot_be_not_virtual=03112_E_Solo las clases soportan constructores virtuales +% You cannot have virtual constructors in objects. You can only have them +% in classes. +parser_e_no_default_property_available=03113_E_No hay propiedad por defecto disponible +% You are trying to access a default property of a class, but this class (or one of +% its ancestors) doesn't have a default property. +parser_e_cant_have_published=03114_E_La clase no puede tener una sección published, use el conmutador {$M+} +% If you want a \var{published} section in a class definition, you must +% use the \var{\{\$M+\}} switch, whch turns on generation of type +% information. +parser_e_forward_declaration_must_be_resolved=03115_E_Declaración posterior de la clase "$1" tiene que ser resuelta aquí para usar la clase como antepasado +% To be able to use an object as an ancestor object, it must be defined +% first. This error occurs in the following situation: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% Where \var{ParentClass} is declared but not defined. +parser_e_no_local_operator=03116_E_Operadores locales no soportados +% You cannot overload locally, i.e. inside procedures or function +% definitions. +parser_e_proc_dir_not_allowed_in_interface=03117_E_Directiva de procedimiento "$1" no permitida en la sección de interfaz +% This procedure directive is not allowed in the \var{interface} section of +% a unit. You can only use it in the \var{implementation} section. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_Directiva de procedimiento "$1" no permitida en la sección de implementacion +% This procedure directive is not defined in the \var{implementation} section of +% a unit. You can only use it in the \var{interface} section. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_Directiva de procedimiento "$1" no permitida en la declaración de tipo +% This procedure directive cannot be part of a procedural or function +% type declaration. +parser_e_function_already_declared_public_forward=03120_E_La función esta actualmente declarada como Public/Forward "$1" +% You will get this error if a function is defined as \var{forward} twice. +% Or it is once in the \var{interface} section, and once as a \var{forward} +% declaration in the \var{implmentation} section. +parser_e_not_external_and_export=03121_E_No se pueden usar ambos EXPORT y EXTERNAL +% These two procedure directives are mutually exclusive +parser_w_not_supported_for_inline=03123_W_"$1" aún no soportado en procedimientos/funciones inline +% Inline procedures don't support this declaration. +parser_w_inlining_disabled=03124_W_Inlining deshabilitado +% Inlining of procedures is disabled. +parser_i_writing_browser_log=03125_I_Escribiendo Browser log $1 +% When information messages are on, the compiler warns you when it +% writes the browser log (generated with the \var{\{\$Y+ \}} switch). +parser_h_maybe_deref_caret_missing=03126_H_podría ser que falte la de-referencia del puntero +% The compiler thinks that a pointer may need a dereference. +parser_f_assembler_reader_not_supported=03127_F_Lector del ensamblador seleccionado no soportado +% The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not +% supported. The compiler can be compiled with or without support for a +% particular assembler reader. +parser_e_proc_dir_conflict=03128_E_Directiva de procedimiento "$1" causa conflicto con otras directivas +% You specified a procedure directive that conflicts with other directives. +% for instance \var{cdecl} and \var{pascal} are mutually exclusive. +parser_e_call_convention_dont_match_forward=03129_E_La convencion de llamada actual no concuerda con la definida anteriormente +% This error happens when you declare a function or procedure with +% e.g. \var{cdecl;} but omit this directive in the implementation, or vice +% versa. The calling convention is part of the function declaration, and +% must be repeated in the function definition. +parser_e_property_cant_have_a_default_value=03131_E_La propiedad no puede tener un valor por defecto +% Set properties or indexed properties cannot have a default value. +parser_e_property_default_value_must_const=03132_E_El valor por defecto de una propiedad tiene que ser constante +% The value of a \var{default} declared property must be known at compile +% time. The value you specified is only known at run time. This happens +% .e.g. if you specify a variable name as a default value. +parser_e_cant_publish_that=03133_E_El símbolo no puede ser published, solo puede ser una clase +% Only class type variables can be in a \var{published} section of a class +% if they are not declared as a property. +parser_e_cant_publish_that_property=03134_E_Este tipo de propiedad no puede ser published +% Properties in a \var{published} section cannot be array properties. +% they must be moved to public sections. Properties in a \var{published} +% section must be an ordinal type, a real type, strings or sets. +parser_e_empty_import_name=03136_E_Se requiere un nombre de importación +% Some targets need a name for the imported procedure or a \var{cdecl} specifier +parser_e_division_by_zero=03138_E_Division por cero +% There is a divsion by zero encounted +parser_e_invalid_float_operation=03139_E_Operacion de punto flotante no válida +% An operation on two real type values produced an overflow or a division +% by zero. +parser_e_array_lower_less_than_upper_bound=03140_E_Límite superior del rango es menor que el límite inferior +% The upper bound of a an array declaration is less than the lower bound and this +% is not possible +parser_w_string_too_long=03141_W_La cadena "$1" es mas larga que $2 +% The size of the constant string is larger than the size you specified in +% string type definition +parser_e_string_larger_array=03142_E_La longitud de la cadena es mayor que el tamaño array de carácteres +% The size of the constant string is larger than the size you specified in +% the array[x..y] of char definition +parser_e_ill_msg_expr=03143_E_Expresión inválida tras la directiva de mensaje +% \fpc supports only integer or string values as message constants +parser_e_ill_msg_param=03144_E_Los méetodos de manejo de mensajes deben tener un único parámetro por referencia +% A method declared with the \var{message}-directive as message handler +% can take only one parameter which must be declared as call by reference +% Parameters are declared as call by reference using the \var{var}-directive +parser_e_duplicate_message_label=03145_E_Etiqueta de mensaje duplicada: "$1" +% A label for a message is used twice in one object/class +parser_e_self_in_non_message_handler=03146_E_Self solo puede ser un parámetro explícito en manejadores de mensajes +% The self parameter can only be passed explicitly to a method which +% is declared as message handler. +parser_e_threadvars_only_sg=03147_E_Threadvars sólo pueden ser globales o estáticos +% Threadvars must be static or global, you can't declare a thread +% local to a procedure. Local variables are always local to a thread, +% because every thread has its own stack and local variables +% are stored on the stack +parser_f_direct_assembler_not_allowed=03148_F_Ensamblador directo no soportado para formato binario de salida +% You can't use direct assembler when using a binary writer, choose an +% other outputformat or use another assembler reader +parser_w_no_objpas_use_mode=03149_W_No carges manuamente la unidad OBJPAS, usa \{\$mode objfpc\} o \{\$mode delphi\} +% You are trying to load the ObjPas unit manually from a uses clause. This is +% not a good idea. Use the \var{\{\$mode objfpc\}} or +% \var{\{\$mode delphi\}} +% directives which load the unit automatically +parser_e_no_object_override=03150_E_OVERRIDE no puede ser usado en objetos +% Override is not supported for objects, use \var{virtual} instead to override +% a method of a parent object +parser_e_cant_use_inittable_here=03151_E_Tipos de datos que requieran inicializacion/finalizacion no pueden ser usados en registros variables +% Some data type (e.g. \var{ansistring}) needs initialization/finalization +% code which is implicitly generated by the compiler. Such data types +% can't be used in the variant part of a record. +parser_e_resourcestring_only_sg=03152_E_Resourcestrings solo pueden ser globales o estáaticos +% Resourcestring can not be declared local, only global or using the static +% directive. +parser_e_exit_with_argument_not__possible=03153_E_Exit con parámetro no puede ser usado aquí +% an exit statement with an argument for the return value can't be used here, this +% can happen e.g. in \var{try..except} or \var{try..finally} blocks +parser_e_stored_property_must_be_boolean=03154_E_El tipo del símbolo en stored debe ser de tipo booleano +% If you specify a storage symbol in a property declaration, it must be of +% the type boolean +parser_e_ill_property_storage_sym=03155_E_Este símbolo no puede ser usado en storage para una propiedad +% You can't use this type of symbol as storage specifier in property +% declaration. You can use only methods with the result type boolean, +% boolean class fields or boolean constants +parser_e_only_publishable_classes_can__be_published=03156_E_Solo clases compiladas en $M+ pueden ser publicadas +% In the published section of a class can be only class as fields used which +% are compiled in \var{\{\$M+\}} or which are derived from such a class. Normally +% such a class should be derived from TPersitent +parser_e_proc_directive_expected=03157_E_Directiva de procedimiento esperada +% When declaring a procedure in a const block you used a ; after the +% procedure declaration after which a procedure directive must follow. +% Correct declarations are: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_El valor para el índice de una propiedad debe ser de tipo ordinal +% The value you use to index a property must be of an ordinal type, for +% example an integer or enumerated type. +parser_e_procname_to_short_for_export=03159_E_Nombre del procedimiento demasiado corto para ser exportado +% The length of the procedure/function name must be at least 2 characters +% long. This is because of a bug in dlltool which doesn't parse the .def +% file correct with a name of length 1. +parser_e_dlltool_unit_var_problem=03160_E_No se puede generar una entrada DEFFILE para las variables globales de la unidad +parser_e_dlltool_unit_var_problem2=03161_E_Compile sin la opcion -WD +% You need to compile this file without the -WD switch on the +% commandline +parser_f_need_objfpc_or_delphi_mode=03162_F_Se requiere el modo ObjFpc (-S2) o Delphi (-Sd) para compilar este módulo +% You need to use \{\$mode objfpc\} or \{\$mode delphi\} to compile this file. +% Or use the equivalent commandline switches -S2 or -Sd. +parser_e_no_export_with_index_for_target=03163_E_No se pueden exportar funciones o procedimientos por indice en $1 +% Exporting of functions or procedures with a specified index is not +% supported on this target. +parser_e_no_export_of_variables_for_target=03164_E_Exportar variables no esta soportado en $1 +% Exporting of variables is not supported on this target. +parser_e_improper_guid_syntax=03165_E_Sintaxis de GUID incorrecta +parser_w_interface_mapping_notfound=03168_W_No se encontro el procedimiento de nombre "$1" apropiado para implementar $2.$3 +parser_e_interface_id_expected=03169_E_identificador de interfaz esperado +% This happens when the compiler scans a \var{class} declaration that contains +% \var{interface} function name mapping code like this: +% \begin{verbatim} +% type +% TMyObject = class(TObject, IDispatch) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% and the \var{interface} before the dot not listed in the inheritance list. +parser_e_type_cant_be_used_in_array_index=03170_E_El tipo "$1" no puede ser usado como indice en arrays +% Types like \var{qword} or \var{int64} aren't allowed as array index type +parser_e_no_con_des_in_interfaces=03171_E_No se permiten constructores/destructores en interfaces +% Constructor and destructor declarations aren't allowed in interface +% In the most cases the method \var{QueryInterface} of \var{IUnknown} can +% be used to create a new interface. +parser_e_no_access_specifier_in_interfaces=03172_E_No se permiten especificadores de acceso en interfaces +% The access specifiers \var{public}, \var{private}, \var{protected} and +% \var{pusblished} can't be used in interfaces because all methods +% of an interfaces must be public. +parser_e_no_vars_in_interfaces=03173_E_Una interfaz no puede contener campos +% Declarations of fields aren't allowed in interfaces. An interface +% can contain only methods +parser_e_no_local_proc_external=03174_E_No se puede declarar un procedimiento local como externo +% Declaring local procedures as external is not possible. Local procedures +% get hidden parameters that will make the chance of errors very high +parser_w_skipped_fields_before=03175_W_Algunos campos anteriores a "$1" no fueron inicializados +% In Delphi mode, not all fields of a typed constant record have to be +% initialized, but the compiler warns you when it detects such situations. +parser_e_skipped_fields_before=03176_E_Algunos campos anteriores a "$1" no fueron inicializados +% In all syntax modes but Delphi mode, you can't leave some fields uninitialized +% in the middle of a typed constant record +parser_w_skipped_fields_after=03177_W_Algunos campos tras "$1" no fueron inicializados +% You can leave some fields at the end of a type constant record uninitialized +% (the compiler will initialize them to zero automatically). This may be the cause +% of subtle problems. +parser_e_varargs_need_cdecl_and_external=03178_E_Directiva VarArgs sólo es válida con CDecl o External +% The varargs directive can only be used with procedures or functions +% that are declared with \var{cdecl} and \var{external} directives. The varargs directive +% is only meant to provide a compatible interface to C functions like printf. +parser_e_self_call_by_value=03179_E_Self debe ser un parámetro normal por valor +% You can't declare self as a const or var parameter, it must always be +% a call-by-value parameter +parser_e_interface_has_no_guid=03180_E_La interfaz "$1" no tiene identificacion +% When you want to assign an interface to a constant, then the interface +% must have a GUID value set. +parser_e_illegal_field_or_method=03181_E_Campo de la clase o método desconocido "$1" +% Properties must refer to a field or method in the same class. +parser_w_proc_overriding_calling=03182_W_Varias convenciones de llamada especificadas, "$1" ignorado al especificar "$2" +% There are two directives in the procedure declaration that specify a calling +% convention. Only the last directive will be used +parser_e_no_procvarobj_const=03183_E_constantes con tipo de tipo Procedure/Function (...) of Object solo pueden ser inicializados a NIL +% You can't assign the address of a method to a typed constant which has a +% 'procedure of object' type, because such a constant requires two addresses: +% that of the method (which is known at compile time) and that of the object or +% class instance it operates on (which can not be known at compile time). +parser_e_default_value_only_one_para=03184_E_Sólo se puede asignar valor por defecto a un parámetro +parser_e_default_value_expected_for_para=03185_E_Parámetro por defecto requerido para "$1" +parser_w_unsupported_feature=03186_W_¡Uso de una caracteristica no soportada! +% You're trying to force the compiler into doing something it cannot do yet. +parser_h_c_arrays_are_references=03187_H_Arrays tipo C son pasados por referencia +% Any array passed to a C functions is passed +% by a pointer (i.e. by reference). +parser_e_C_array_of_const_must_be_last=03188_E_Array tipo C de const debe ser el ultimo parámetro +% You can not add any other argument after an \var{array of const} for +% \var{cdecl} functions, as the size pushed on stack for this argument is +% not known. +parser_h_type_redef=03189_H_Redefinición del tipo "$1" +% This is an indicator that a previously declared type is +% being redefined as something else. This may, or may not +% be, a cause for errors. +parser_w_cdecl_has_no_high=03190_W_Procedimientos y funciones declarados como cdecl no reciben de parámetro el límite superior +% Functions declared with cdecl modifier do not pass an extra implicit parameter. +parser_w_cdecl_no_openstring=03191_W_open strings no son soportados en funciones cdecl +% Openstring is not supported for cdecl'ared functions. +parser_e_initialized_not_for_threadvar=03192_E_No se pueden inicializar variables declaradas como threadvar +% Variables declared as threadvar can not be initialized with a default value. +% The variables will always be filled with zero at the start of a new thread. +parser_e_msg_only_for_classes=03193_E_La directiva Message sólo es valida en clases +% The message directive is only supported for Class types. +parser_e_procedure_or_function_expected=03194_E_Se esperaba un procedimiento o funcion +% A class method can only be specified for procedures and functions. +parser_e_illegal_calling_convention=03195_W_Directiva de convención de llama "$1" ignorada +% Some calling conventions are supported only by certain CPUs. I.e. most non-i386 ports support +% only the standard ABI calling convention of the CPU. +parser_e_no_object_reintroduce=03196_E_REINTRODUCE no puede ser utilizado en objetos +% \var{reintroduce} is not supported for objects. +parser_e_paraloc_only_one_para=03197_E_Cada parámetro debe tener su propia posición +% If locations for arguments are specified explicitly as it is required by +% some syscall conventions, each argument must have it's only location, things +% like \var{procedure p(i,j : longint 'r1');} aren't allowed +parser_e_paraloc_all_paras=03198_E_Cada parámetro debe tener su propia posición +% If one argument has an explicit argument location, all arguments of a procedure +% must have one. +parser_e_illegal_explicit_paraloc=03199_E_Localizacón en el segmento desconocida +% The location specified for an argument isn't recognized by the compiler +parser_e_32bitint_or_pointer_variable_expected=03200_E_Se esperaba una variable entera de 32 bits o un puntero +% The libbase for MorphOS/AmigaOS can be give only as \var{longint}, \var{dword} or any pointer variable. +parser_e_goto_outside_proc=03201_E_No se puede usar Goto para saltar a otro procedimiento +% It isn't allowed to use the \var{goto} statements referencing labels outside the +% current procedure. The following example shows the problem: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1; +% +% procedure p2; +% begin +% goto l1; // This goto ISN'T allowed +% end; +% +% begin +% p2 +% l1: +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_Procedimiento demasiado complejo. Se requieren demasiados registros +% Your procedure body is too long for the compiler. You should split the +% procedure into multiple smaller procedures. +parser_e_illegal_expression=03203_E_Expresión inválida +% This can occur under many circumstances. Mostly when trying to evaluate +% constant expressions. +parser_e_invalid_integer=03204_E_La expresión no evalua un número entero +% You made an expression which isn't an integer, and the compiler expects the +% result to be an integer. +parser_e_invalid_qualifier=03205_E_calificador inválido +% One of the following is happening : +% \begin{itemize} +% \item You're trying to access a field of a variable that is not a record. +% \item You're indexing a variable that is not an array. +% \item You're dereferencing a variable that is not a pointer. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_El limite superior especificado es menor que el inferior +% You are declaring a subrange, and the lower limit is higher than the high +% limit of the range. +parser_e_macpas_exit_wrong_param=03207_E_El parámetro de Exit debe ser el nombre del mismo procedimiento en el que está +% Non local exit is not allowed. This error occurs only in mode MacPas. +parser_e_illegal_assignment_to_count_var=03208_E_Asignación inválida a la variable de bucle "$1" +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +parser_e_no_local_var_external=03209_E_No se puede declarar una variable local como externa +% Declaring local variables as external is not allowed. Only global variables can reference +% to external variables. +parser_e_proc_already_external=03210_E_El procedimiento ya ha sido declarado como externo con anterioridad +% The procedure is already declared with the EXTERNAL directive in an interface or +% forward declaration. +parser_w_implicit_uses_of_variants_unit=03211_W_Uso implícito de la unidad Variants +% The Variant type is used in the unit without any used unit using the Variants unit. The +% compiler has implicitly added the Variants unit to the uses list. To remove this warning +% the Variants unit needs to be added to the uses statement. +parser_e_no_static_method_in_interfaces=03212_E_Clases y métodos estáticos no pueden ser utilizados en interfaces +% The specifier \var{class} and directive \var{static} can't be used in interfaces +% because all methods of an interfaces must be public. +parser_e_arithmetic_operation_overflow=03213_E_Desbordamiento en la operación aritmética +% An operation on two integers values produced an overflow +% \end{description} +# +# Type Checking +# +# 04049 is the last used one +# +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +type_e_mismatch=04000_E_Los tipos no concuerdan +% This can happen in many cases: +% \begin{itemize} +% \item The variable you're assigning to is of a different type than the +% expression in the assignment. +% \item You are calling a function or procedure with parameters that are +% incompatible with the parameters in the function or procedure definition. +% \end{itemize} +type_e_incompatible_types=04001_E_Tipos incompatibles: se encontró "$1" esperado "$2" +% There is no conversion possible between the two types +% Another possiblity is that they are declared in different +% declarations: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { This statement gives also this error, it +% is due the strict type checking of pascal } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_Los tipos $1 y $2 no concuerdan +% The types are not equal +type_e_type_id_expected=04003_E_Identificador de tipo esperado +% The identifier is not a type, or you forgot to supply a type identifier. +type_e_variable_id_expected=04004_E_Identificador de variable esperado +% This happens when you pass a constant to a routine (such as \var{Inc} var or \var{Dec}) +% when it expects a variable. You can only pass variables as arguments to these functions. +type_e_integer_expr_expected=04005_E_expression entera esperada, pero se encontró "$1" +% The compiler expects an expression of type integer, but gets a different +% type. +type_e_boolean_expr_expected=04006_E_Expresion booleana esperada, pero se encontró "$1" +% The expression must be a boolean type, it should be return true or +% false. +type_e_ordinal_expr_expected=04007_E_Espresión ordinal esperada +% The expression must be of ordinal type, i.e., maximum a \var{Longint}. +% This happens, for instance, when you specify a second argument +% to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value. +type_e_pointer_type_expected=04008_E_Se esperaba un tipo puntero, pero se encontró "$1" +% The variable or expression isn't of the type \var{pointer}. This +% happens when you pass a variable that isn't a pointer to \var{New} +% or \var{Dispose}. +type_e_class_type_expected=04009_E_Se esperaba un tipo de clase, pero se encontró "$1" +% The variable of expression isn't of the type \var{class}. This happens +% typically when +% \begin{enumerate} +% \item The parent class in a class declaration isn't a class. +% \item An exception handler (\var{On}) contains a type identifier that +% isn't a class. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_No se puede evaluar la espresión constante +% This error can occur when the bounds of an array you declared does +% not evaluate to ordinal constants +type_e_set_element_are_not_comp=04012_E_Elementos de sets incompatibles +% You are trying to make an operation on two sets, when the set element types +% are not the same. The base type of a set must be the same when taking the +% union +type_e_set_operation_unknown=04013_E_Operación no implementada para sets +% several binary operations are not defined for sets +% like div mod ** (also >= <= for now) +type_w_convert_real_2_comp=04014_W_Conversion automática de tipo de punto flotante a COMP el cual es un tipo entero +% An implicit type conversion from a real type to a \var{comp} is +% encountered. Since \var{comp} is a 64 bit integer type, this may indicate +% an error. +type_h_use_div_for_int=04015_H_usa DIV para tener un resultado entero +% When hints are on, then an integer division with the '/' operator will +% procuce this message, because the result will then be of type real +type_e_strict_var_string_violation=04016_E_Tipos de cadena no concuerdan por la presencia de la opción $V+ +% When compiling in \var{\{\$V+\}} mode, the string you pass as a parameter +% should be of the exact same type as the declared parameter of the procedure. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_No se permite el uso de Succ o Pred en enumeraciones que tienen valores asignados explícitamente +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use the \var{Succ} or \var{Pred} functions on them. +type_e_cant_read_write_type=04018_E_No se puede leer o escribir variables de este tipo +% You are trying to \var{read} or \var{write} a variable from or to a +% file of type text, which doesn't support that. Only integer types, +% reals, pchars and strings can be read from/written to a text file. +% Booleans can only be written to text files. +type_e_no_readln_writeln_for_typed_file=04019_E_No se puede utilizar readln o writeln en ficheros con tipo +% \var{readln} and \var{writeln} are only allowed for text files. +type_e_no_read_write_for_untyped_file=04020_E_No se pueden usar read o write en ficheros sin tipo +% \var{read} and \var{write} are only allowed for text or typed files. +type_e_typeconflict_in_set=04021_E_El set contiene un elemento que no es de tipo compatible +% There is at least one set element which is of the wrong type, i.e. not of +% the set type. +type_w_maybe_wrong_hi_lo=04022_W_lo/hi(longint/dword) devuelve la parte superior/inferior de tipo word +% \fpc supports an overloaded version of \var{lo/hi} for \var{longint/dword/int64/qword} +% which returns the lower/upper word/dword of the argument. TP always uses +% a 16 bit \var{lo/hi} which returns always bits 0..7 for \var{lo} and the +% bits 8..15 for \var{hi}. If you want the TP behavior you have +% to type cast the argument to \var{word/integer} +type_e_integer_or_real_expr_expected=04023_E_Espresión entera o real esperada +% The first argument to \var{str} must a real or integer type. +type_e_wrong_type_in_array_constructor=04024_E_Tipo "$1" erróneo en el constructor del array +% You are trying to use a type in an array constructor which is not +% allowed. +type_e_wrong_parameter_type=04025_E_Tipo incompatible para el parámetro número $1: Se recibió "$2", cuando se esperaba "$3" +% You are trying to pass an invalid type for the specified parameter. +type_e_no_method_and_procedure_not_compatible=04026_E_Variables de tipo método y procedimiento no son compatibles entre si +% You can't assign a method to a procedure variable or a procedure to a +% method pointer. +type_e_wrong_math_argument=04027_E_Constante pasada a la función matematica interna no válida +% The constant argument passed to a ln or sqrt function is out of +% the definition range of these functions. +type_e_no_addr_of_constant=04028_E_No se puede obtener una dirección de una constante +% It is not possible to get the address of a constant, because they +% aren't stored in memory, you can try making it a typed constant. +type_e_argument_cant_be_assigned=04029_E_No se puede asignar un valor al parámetro +% Only expressions which can be on the left side of an +% assignment can be passed as call by reference argument +% Remark: Properties can be only +% used on the left side of an assignment, but they cannot be used as arguments +type_e_cannot_local_proc_to_procvar=04030_E_No se puede asignar un prodecimiento o funcion local a una variable +% It's not allowed to assign a local procedure/function to a +% procedure variable, because the calling of local procedure/function is +% different. You can only assign local procedure/function to a void pointer. +type_e_no_assign_to_addr=04031_E_No se puede asignar un valor a una dirección +% It is not allowed to assign a value to an address of a variable,constant, +% procedure or function. You can try compiling with -So if the identifier +% is a procedure variable. +type_e_no_assign_to_const=04032_E_No se pueden asignar valores a variables constantes +% It's not allowed to assign a value to a variable which is declared +% as a const. This is normally a parameter declared as const, to allow +% changing the value make the parameter as a value parameter or a var. +type_e_array_required=04033_E_Se requiere un array para usar [ ] +% If you are accessing a variable using an index '[<x>]' then +% the type must be an array. In FPC mode also a pointer is allowed. +type_e_interface_type_expected=04034_E_Se esperaba "interface" pero se encontró "$1" +type_w_mixed_signed_unsigned=04035_W_Operaciones mezclando enteros de 32 bits con signo son convertidas a 64 bits +% If you divide (or calculate the modulus of) a signed expression by a longword (or vice versa), +% or if you have overflow and/or range checking turned on and use an arithmetic +% expression (+, -, *, div, mod) in which both signed numbers and longwords appear, +% then everything has to be evaluated in 64bit which is slower than normal +% 32bit arithmetic. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_w_mixed_signed_unsigned2=04036_W_Mezclar operando con signo y sin signo aqui puede causar errores de comprobación de rango +% If you use a binary operator (and, or, xor) and one of +% the operands is a longword while the other one is a signed expression, then, +% if range checking is turned on, you may get a range check error because in +% such a case both operands are converted to longword before the operation is +% carried out. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_e_typecast_wrong_size_for_assignment=04037_E_La conversión de tipos ($1 -> $2) en la asignación tiene diferentes tamaños +% Type casting to a type with a different size is not allowed when the variable is +% used for assigning. +type_e_array_index_enums_with_assign_not_possible=04038_E_No se pueden usar enums con asignaciones como indices de arrays +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use it as index of an array. +type_e_classes_not_related=04039_E_Las clases u objetos "$1" y "$2" no están relacionados +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_w_classes_not_related=04040_W_Los tipos de clases "$1" y "$2" no están relacionados +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_e_class_or_interface_type_expected=04041_E_Se esperaba una clase o interfaz, pero se encotró "$1" +type_e_type_is_not_completly_defined=04042_E_El tipo "$1" no esta definido completamente aún +type_w_string_too_long=04043_W_La cadena contiene mas caracteres que los admitidos por una cadena corta +% The size of the constant string, which is assigned to a shortstring, +% is longer than the maximum size of the shortstring +type_w_signed_unsigned_always_false=04044_W_La comparación es siempre falsa debido a los rangos de los valores +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% false. Exlicitly typecast the constant to the correct range to avoid this problem. +type_w_signed_unsigned_always_true=04045_W_La comparación es siempre verdadera debido a los rangos de los valores +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% true. Exlicitly typecast the constant to the correct range to avoid this problem. +type_w_instance_with_abstract=04046_W_Constuyendo un objeto de clase "$1" que contiene métodos abstractos +% An instance of a class is created which contains non-implemented abstract +% methods. This will probably lead to a runtime error 211 in the code if that +% routine is ever called. All abstract methods should be overridden. +type_h_in_range_check=04047_H_El operando a la izquierda de IN debe ser de tamaño un byte +% The left operand of the \var{in} operator is not an ordinal or enumeration which fits +% within 8-bits, this may lead to range check errors. The \var{in} operator +% currently only supports a left operand which fits within a byte. In the case of +% enumerations, the size of an element of an enumeration can be controlled with +% the \var{\{\$PACKENUM\}} or \var{\{\$Zn\}} switches. +type_w_smaller_possible_range_check=04048_W_Diferencia del tamaño de los tipos puede causar pérdida de datos o errores de comprobación de rango +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_h_smaller_possible_range_check=04049_H_Diferencia del tamaño de los tipos puede causar pérdida de datos o errores de comprobación de rango +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_e_cant_take_address_of_abstract_method=04050_E_No se puede obtener la dirección de un método abstracto +% An abstract method has no body, so the address of an abstract method can't be taken. +type_e_operator_not_allowed=04051_E_El operador no es aplicable con los operandos especificados +% You are trying an operator that is not available for the type of the +% operands +type_e_constant_expr_expected=04052_E_Se esperaba una expresió constante +% The compiler expects an constant expression, but gets a variable expression. +type_e_operator_not_supported_for_types=04053_E_La operacion "$1" no está soportada para los tipos "$2" y "$3" +% The operation is not allowed for the supplied types +type_e_illegal_type_conversion=04054_E_No es posible realizar una conversión de "$1" a "$2" +% When doing a type-cast, you must take care that the sizes of the variable and +% the destination type are the same. +type_h_pointer_to_longint_conv_not_portable=04055_H_La conversion entre punteros y ordinales no es portable +% If you typecast a pointer to a longint (or vice-versa), this code will not compile +% on a machine using 64-bit for pointer storage. +type_w_pointer_to_longint_conv_not_portable=04056_W_La conversion entre punteros y ordinales no es portable +% If you typecast a pointer to a ordinal type of a different size (or vice-versa), this can +% cause problems. This is a warning to help finding the 32bit specific code where cardinal/longint is used +% to typecast pointers to ordinals. A solution is to use the ptrint/ptruint types instead. +type_e_cant_choose_overload_function=04057_E_No se pudo determinar que funcion sobrecargada llamar +% You're calling overloaded functions with a parameter that doesn't correspond +% to any of the declared function parameter lists. e.g. when you have declared +% a function with parameters \var{word} and \var{longint}, and then you call +% it with a parameter which is of type \var{integer}. +type_e_illegal_count_var=04058_E_Variable de contador inválida +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +% \end{description} +# +# Symtable +# +# 05055 is the last used one +# +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedure and variable names. +% \begin{description} +sym_e_id_not_found=05000_E_Identificador no encontrado "$1" +% The compiler doesn't know this symbol. Usually happens when you misspel +% the name of a variable or procedure, or when you forgot to declare a +% variable. +sym_f_internal_error_in_symtablestack=05001_F_Error interno en SymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_Identificador duplicado "$1" +% The identifier was already declared in the current scope. +sym_h_duplicate_id_where=05003_H_El identificador ya está definido en $1 en la línea $2 +% The identifier was already declared in a previous scope. +sym_e_unknown_id=05004_E_Identificador desconocido "$1" +% The identifier encountered has not been declared, or is used outside the +% scope where it is defined. +sym_e_forward_not_resolved=05005_E_Declaración posterior no solucionada "$1" +% This can happen in two cases: +% \begin{itemize} +% \item This happens when you declare a function (in the \var{interface} part, or +% with a \var{forward} directive, but do not implement it. +% \item You reference a type which isn't declared in the current \var{type} +% block. +% \end{itemize} +sym_e_error_in_type_def=05007_E_Error en definición de tipo +% There is an error in your definition of a new array type: +% \item One of the range delimiters in an array declaration is erroneous. +% For example, \var{Array [1..1.25]} will trigger this error. +sym_e_forward_type_not_resolved=05009_E_Tipo posterior no resuelto "$1" +% A symbol was forward defined, but no declaration was encountered. +sym_e_only_static_in_static=05010_E_Solo las variables estáticas pueden ser usadas en métodos estáticos o fuera de métodos +% A static method of an object can only access static variables. +sym_f_type_must_be_rec_or_class=05012_F_tipo record o class esperado +% The variable or expression isn't of the type \var{record} or \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_No se permiten instancias de clases u objetos con un métodos abstractos +% You are trying to generate an instance of a class which has an abstract +% method that wasn't overridden. +sym_w_label_not_defined=05014_W_Etiqueta no definida "$1" +% A label was declared, but not defined. +sym_e_label_used_and_not_defined=05015_E_Etiqueta "$1" usada pero no definida +% A label was declared and used, but not defined. +sym_e_ill_label_decl=05016_E_Declaración inválida de la etiqueta +% This error should never happen; it occurs if a label is defined outside a +% procedure or function. +sym_e_goto_and_label_not_supported=05017_E_GOTO y LABEL no son soportados (debe ser habilitado con -Sg) +% You must compile a program which has \var{label}s and \var{goto} statements +% with the \var{-Sg} switch. By default, \var{label} and \var{goto} aren't +% supported. +sym_e_label_not_found=05018_E_Etiqueta no encontrada +% A \var{goto label} was encountered, but the label isn't declared. +sym_e_id_is_no_label_id=05019_E_el identificador no es una etiqueta +% The identifier specified after the \var{goto} isn't of type label. +sym_e_label_already_defined=05020_E_Etiqueta ya definida +% You are defining a label twice. You can define a label only once. +sym_e_ill_type_decl_set=05021_E_Definicion de tipo set inválida +% The declaration of a set contains an invalid type definition. +sym_e_class_forward_not_resolved=05022_E_Definición posterior de la clase "$1" no resuelta +% You declared a class, but you did not implement it. +sym_n_unit_not_used=05023_H_Unidad "$1" no utilizada en $2 +% The unit referenced in the \var{uses} clause is not used. +sym_h_para_identifier_not_used=05024_H_Parámetro "$1" no usado +% The identifier was declared (locally or globally) but +% was not used (locally or globally). +sym_n_local_identifier_not_used=05025_N_Variable local no usada "$1" +% You have declared, but not used a variable in a procedure or function +% implementation. +sym_h_para_identifier_only_set=05026_H_Valor asignado a "$1" pero no utilizado +% The identifier was declared (locally or globally) +% set but not used (locally or globally). +sym_n_local_identifier_only_set=05027_N_Valor asignado a la variable local "$1" no utilizado +% The variable in a procedure or function +% implementation is declared, set but never used. +sym_h_local_symbol_not_used=05028_H_Símbolo local $1 "$2" no utilizado +% A local symbol is never used. +sym_n_private_identifier_not_used=05029_N_Campo privado $1.$2 no utilizado +sym_n_private_identifier_only_set=05030_N_Valor asignado al campo privado $1.$2 pero nunca es utilizado +sym_n_private_method_not_used=05031_N_Método privado $1.$2 no utilizado +sym_e_set_expected=05032_E_Tipo set esperado +% The variable or expression is not of type \var{set}. This happens in an +% \var{in} statement. +sym_w_function_result_not_set=05033_W_El resultado de la función puede no haber sido asignado +% You can get this warning if the compiler thinks that a function return +% value is not set. This will not be displayed for assembler procedures, +% or procedures that contain assembler blocks. +sym_w_wrong_C_pack=05034_W_El tipo "$1" no esta correctamente alineado para C +% Arrays with sizes not multiples of 4 will be wrongly aligned +% for C structures. +sym_e_illegal_field=05035_E_Identificador de campo de registro desconocido: "$1" +% The field doesn't exist in the record/object definition. +sym_w_uninitialized_local_variable=05036_W_La variable local "$1" no parace haber sido inicializada +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_w_uninitialized_variable=05037_W_La variable "$1" no parece haber sido inicializada +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_e_id_no_member=05038_E_El identificador "$1" no identifica ningún miembro +% This error is generated when an identifier of a record, +% field, or method is accessed while it is not defined. +sym_h_param_list=05039_H_Declaracion encontrada: $1 +% You get this when you use the \var{-vh} switch. In case an overloaded +% procedure is not found, then all candidate overloaded procedures are +% listed, with their parameter lists. +sym_e_segment_too_large=05040_E_Segmento de datos demasiado grande +% You get this when you declare a data element whose size exceeds the +% prescribed limit (2 Gb on 80386+/68020+ processors) +sym_e_no_matching_implementation_found=05042_E_No se encontro una implementación para el método "$1" de la interfaz +% There was no matching method found which could implement the interface +% method. Check argument types and result type of the methods. +sym_w_deprecated_symbol=05043_W_Símbolo "$1" desaconsejado +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Usage of this symbol +% should be avoided as much as possible. +sym_w_non_portable_symbol=05044_W_El símbolo "$1" no es portable +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{platform} is used. This symbol's value, usage +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_non_implemented_symbol=05055_W_El símbolo "$1" no está implementado +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{unimplemented} is used. This symbol is defined, +% but is not yet implemented on this specific platform. +sym_e_cant_create_unique_type=05056_E_No se puede crear un tipo único a partir de este tipo +% Only simple types like ordinal, float and string types are supported when +% redefining a type with \var{type newtype = type oldtype;}. +sym_h_uninitialized_local_variable=05057_H_La variable local "$1" no parece haber sido inicializada +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_h_uninitialized_variable=05058_H_La variable "$1" no parece haber sido inicializada +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +% \end{description} +# +# Codegenerator +# +# 06040 is the last used one +# +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +cg_e_parasize_too_big=06009_E_El tamaño de la lista de par metros excede 65535 bytes +% The I386 processor limits the parameter list to 65535 bytes (the \var{RET} +% instruction causes this) +cg_e_file_must_call_by_reference=06012_E_Los tipos File deben ser pasados por referencia +% You cannot specify files as value parameters, i.e. they must always be +% declared \var{var} parameters. +cg_e_cant_use_far_pointer_there=06013_E_El uso de punteros "far" no esta permitido aqií +% Free Pascal doesn't support far pointers, so you cannot take the address of +% an expression which has a far reference as a result. The \var{mem} construct +% has a far reference as a result, so the following code will produce this +% error: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_las funciones declaradas como EXPORT no pueden ser llamadas +% No longer in use. +cg_w_member_cd_call_from_method=06016_W_Posible llamada inválida de un constructor o destructor +% The compiler detected that a constructor or destructor is called within a +% a method. This will probably lead to problems, since constructors / destructors +% require parameters on entry. +cg_n_inefficient_code=06017_N_código ineficiente +% Your statement seems dubious to the compiler. +cg_w_unreachable_code=06018_W_El código no será ejecutado nunca +% You specified a construct which will never be executed. Example: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_Los métodos abstractos no pueden ser llamados directamente +% You cannot call an abstract method directy, instead you must call a +% overriding child method, because an abstract method isn't implemented. +cg_d_register_weight=06027_DL_Registro $1 peso $2 $3 +% Debugging message. Shown when the compiler considers a variable for +% keeping in the registers. +cg_d_stackframe_omited=06029_DL_Se omite generar stack frame +% Some procedure/functions do not need a complete stack-frame, so it is omitted. +% This message will be displayed when the {-vd} switch is used. +cg_e_unable_inline_object_methods=06031_E_Métodos de objetos o clases no pueden ser inline +% You cannot have inlined object methods. +cg_e_unable_inline_procvar=06032_E_Variables de procedimiento o función no pueden ser inline +% A procedure with a procedural variable call cannot be inlined. +cg_e_no_code_for_inline_stored=06033_E_No hay código almacenado para procedimientos inline +% The compiler couldn't store code for the inline procedure. +cg_e_can_access_element_zero=06035_E_No se puede acceder al elemento 0 de cadenas largas, use SetLength/Length +% You should use \var{setlength} to set the length of an ansi/wide/longstring +% and \var{length} to get the length of such a string types +cg_e_cannot_call_cons_dest_inside_with=06037_E_No se pueden llamar a constructores o destructores en with +% Inside a \var{with} clause you cannot call a constructor or destructor for the +% object you have in the \var{with} clause. +cg_e_cannot_call_message_direct=06038_E_No se pueden llamar a métodos manejadores de mensajes directamente +% A message method handler method cannot be called directly if it contains an +% explicit self argument +cg_e_goto_inout_of_exception_block=06039_E_Salto fuera de un bloque de excepción +% It is not allowed to jump in or outside of an exception block like \var{try..finally..end;}: +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // this line will cause an error +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_No se admiten instrucciones de control de flujo en un bloque finally +% It isn't allowed to use the control flow statements \var{break}, +% \var{continue} and \var{exit} +% inside a finally statement. The following example shows the problem: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // This exit ISN'T allowed +% end; +% ... +% +% \end{verbatim} +% If the procedure \var{p} raises an exception the finally block is +% executed. If the execution reaches the exit, it's unclear what to do: +% exiting the procedure or searching for another exception handler +cg_w_parasize_too_big=06041_W_El tamaño del parámetro excede el límite de algunas CPU +% This indicates that you are declaring more than 64K of parameters, which +% might not be supported on other processor targets. +cg_w_localsize_too_big=06042_W_El tamaño de las variables locales excede el límite de algunas CPU +% This indicates that you are declaring more than 32K of lcoal variables, which +% might not be supported on other processor targets. +cg_e_localsize_too_big=06043_E_El tamaño de las variables locales excede el límite de la CPU de destino +% This indicates that you are declaring more than 32K of lcoal variables, which +% is not supported by this processor. +cg_e_break_not_allowed=06044_E_BREAK no permitido aquí +% You're trying to use \var{break} outside a loop construction. +cg_e_continue_not_allowed=06045_E_CONTINUE no permitido aquí +% You're trying to use \var{continue} outside a loop construction. +% \end{description} +# EndOfTeX + +# +# Assembler reader +# +# 07097 is the last used one +# +asmr_d_start_reading=07000_DL_Iniciando interpretado de ensamblador de estilo $1 +% This informs you that an assembler block is being parsed +asmr_d_finish_reading=07001_DL_Finalizado interpretado de ensamblador de estilo $1 +% This informs you that an assembler block has finished. +asmr_e_none_label_contain_at=07002_E_Una patrón que no es una etiqueta contiene @ +% A identifier which isn't a label can't contain a @. +asmr_e_building_record_offset=07004_E_Error construyendo desplazamiento de registro (record) +% There has an error occured while building the offset of a record/object +% structure, this can happend when there is no field specified at all or +% an unknown field identifier is used. +asmr_e_offset_without_identifier=07005_E_OFFSET usado sin identificador +% You can only use OFFSET with an identifier. Other syntaxes aren't +% supported +asmr_e_type_without_identifier=07006_E_TYPE usado sin identificador +% You can only use TYPE with an identifier. Other syntaxes aren't +% supported +asmr_e_no_local_or_para_allowed=07007_E_No es posible usar una variable local o parámetro aquí +% You can't use a local variable or parameter here, mostly because the +% addressing of locals and parameters is done using the frame pointer register so the +% address can't be obtained directly. +asmr_e_need_offset=07008_E_Es necesario el uso de OFFSET aquí +% You need to use OFFSET <id> here to get the address of the identifier. +asmr_e_need_dollar=07009_E_Es necesario el uso de $ auqí +% You need to use $<id> here to get the address of the identifier. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_No es posible utilizar varios símbolos reubicables +% You can't have more than one relocatable symbol (variable/typed constant) +% in one argument. +asmr_e_only_add_relocatable_symbol=07011_E_Símbolos reubicables solo pueden ser añadidos +% Relocatable symbols (variable/typed constant) can't be used with other +% operators. Only addition is allowed. +asmr_e_invalid_constant_expression=07012_E_Espresió constante inválida +% There is an error in the constant expression. +asmr_e_relocatable_symbol_not_allowed=07013_E_Símbolo reubicable no permitido +% You can't use a relocatable symbol (variable/typed constant) here. +asmr_e_invalid_reference_syntax=07014_E_Sintaxis de referencia inválida +% There is an error in the reference. +asmr_e_local_para_unreachable=07015_E_No se puede llegar a $1 desde este código +% You can not read directly the value of local or para +% of a higher level in assembler code (except for +% local assembler code without parameter nor locals). +asmr_e_local_label_not_allowed_as_ref=07016_E_No está permitido el uso símbolos locales o etiquetas como referencias +% You can't use local symbols/labels as references +asmr_e_wrong_base_index=07017_E_Uso inválido de registros indice y base +% There is an error with the base and index register, they are +% probably incorrect +asmr_w_possible_object_field_bug=07018_W_Posible error en el manejo de campos de objetos +% Fields of objects or classes can be reached directly in normal or objfpc +% modes but TP and Delphi modes treat the field name as a simple offset. +asmr_e_wrong_scale_factor=07019_E_Factor de escala erróneo +% The scale factor given is wrong, only 1,2,4 and 8 are allowed +asmr_e_multiple_index=07020_E_Uso de multiples registros índice +% You are trying to use more than one index register +asmr_e_invalid_operand_type=07021_E_Tipo del operando no válido +% The operand type doesn't match with the opcode used +asmr_e_invalid_string_as_opcode_operand=07022_E_Cadena no vólida como operando de esta instrucción: $1 +% The string specified as operand is not correct with this opcode +asmr_w_CODE_and_DATA_not_supported=07023_W_@CODE y @DATA no son soportados +% @CODE and @DATA are unsupported and are ignored. +asmr_e_null_label_ref_not_allowed=07024_E_Referencias a etiqueta nula no permitida +asmr_e_expr_zero_divide=07025_E_Division entre cero en el evaluador de ensamblador +% There is a division by zero in a constant expression +asmr_e_expr_illegal=07026_E_Expresión inválida +% There is an illegal expression in a constant expression +asmr_e_escape_seq_ignored=07027_E_Sequencia de escape ignorada: $1 +% There is a C-styled string, but the escape sequence in the string +% is unknown, and is therefore ignored +asmr_e_invalid_symbol_ref=07028_E_Referencia a símbolo inválida +asmr_w_fwait_emu_prob=07029_W_Fwait puede causar problemas de emulación con emu387 +asmr_w_fadd_to_faddp=07030_W_$1 sin operando interpretado como $1P +asmr_w_enter_not_supported_by_linux=07031_W_La instruccion ENTER no está soportada por el kernel de Linux +% ENTER instruction can generate a stack page fault that is not +% caught correctly by the i386 Linux page handler. +asmr_w_calling_overload_func=07032_W_Llamando a una funcion sobrecargada desde ensamblador +% There is a call to an overloaded method in the assembler block, +% this might be the sign there is a problem +asmr_e_unsupported_symbol_type=07033_E_Tipo de símbolo no soportado para el operando +asmr_e_constant_out_of_bounds=07034_E_Valor de la constante fuera de rango +asmr_e_error_converting_decimal=07035_E_Error convirtiendo decimal $1 +% A constant decimal value does not have the correct syntax +asmr_e_error_converting_octal=07036_E_Error convirtiendo octal $1 +% A constant octal value does not have the correct syntax +asmr_e_error_converting_binary=07037_E_Error convirtiendo binario $1 +% A constant binary value does not have the correct syntax +asmr_e_error_converting_hexadecimal=07038_E_Error convirtiendo hexadecimal $1 +% A constant hexadecimal value does not have the correct syntax +asmr_h_direct_global_to_mangled=07039_H_$1 traducido a $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 esta asociado a una función sobrecargada +asmr_e_cannot_use_SELF_outside_a_method=07041_E_No se puede usar SELF fuera de un método +% There is a reference to the \var{self} symbol while it is not +% allowed. \var{self} can only be referenced inside methods +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_No se puede usar OLDEBP fuera de un procedimiento anidado +% There is a reference to the \var{oldebp} symbol while it is not +% allowed. \var{oldebp} can only be referenced inside nested routines +asmr_e_void_function=07043_W_No es posible devolver un valor en procedimientos desde código asm +% Trying to return a value while in a procedure. A procedure +% does not have any return value +asmr_e_SEG_not_supported=07044_E_SEG no soportado +asmr_e_size_suffix_and_dest_dont_match=07045_E_No concuerdan el tamaño del prefijo y el del origen o destino +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_w_size_suffix_and_dest_dont_match=07046_W_No concuerdan el tamaño del prefijo y el del origen o destino +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_e_syntax_error=07047_E_Error de sintaxis de ensamblador +% There is an assembler syntax error +asmr_e_invalid_opcode_and_operand=07048_E_Combinación inválida de operacion y operandos +% The opcode cannot be used with this type of operand +asmr_e_syn_operand=07049_E_Error de sintaxis de ensamblador en operando +asmr_e_syn_constant=07050_E_Error de sintaxis de ensamblador en constante +asmr_e_invalid_string_expression=07051_E_Espresión de cadena noáv lida +asmr_w_const32bit_for_address=07052_W_constante con la direccion del símbolo $1 que no es un puntero +% A constant expression represents an address which does not fit +% into a pointer. The address is probably incorrect +asmr_e_unknown_opcode=07053_E_Instrucción $1 no reconocida +% This opcode is not known +asmr_e_invalid_or_missing_opcode=07054_E_Falta la instrucción o no es válida +asmr_e_invalid_prefix_and_opcode=07055_E_Combinación de prefijo y operación inválidos: $1 +asmr_e_invalid_override_and_opcode=07056_E_Combinación de sobrecarga y operación inválidos: $1 +asmr_e_too_many_operands=07057_E_Demasiados operandos en la línea +% There are too many operands for this opcode. Check your +% assembler syntax +asmr_w_near_ignored=07058_W_NEAR ignorado +asmr_w_far_ignored=07059_W_FAR ignorado +asmr_e_dup_local_sym=07060_E_Símbolo local duplicado $1 +asmr_e_unknown_local_sym=07061_E_Símbolo local indefinido $1 +asmr_e_unknown_label_identifier=07062_E_Identificador de etiqueta desconocido $1 +asmr_e_invalid_register=07063_E_Nombre de registro incorrecto +% There is an unknown register name used as operand. +asmr_e_invalid_fpu_register=07064_E_Nombre de registro de punto flotante no válido +% There is an unknown register name used as operand. +asmr_w_modulo_not_supported=07066_W_Modulo no soportado +asmr_e_invalid_float_const=07067_E_Constante de punto flotante no válida $1 +% The floating point constant declared in an assembler block is +% invalid. +asmr_e_invalid_float_expr=07068_E_Espresión de punto flotante no válida +% The floating point expression declared in an assembler block is +% invalid. +asmr_e_wrong_sym_type=07069_E_Tipo de símbolo erróneo +asmr_e_cannot_index_relative_var=07070_E_No se puede indexar una var. local o un parámetro con un registro +% Trying to index using a base register a symbol which is already relative +% to a register. This is not possible, and will probably lead to crashes. +asmr_e_invalid_seg_override=07071_E_Espresión reemplazo de segmento inválida +asmr_w_id_supposed_external=07072_W_Identificador $1 se supone externo +% There is a reference to an undefined symbol. This will not result +% in an error, since the symbol might be external, but may cause +% problems at link time if the symbol is not defined anywhere. +asmr_e_string_not_allowed_as_const=07073_E_Cadenas no permitidas como constantes +% Character strings are not allowed as constants. +asmr_e_no_var_type_specified=07074_E_No hay tipo de variable especificado +% The syntax expects a type idenfitifer after the dot, but +% none was found. +asmr_w_assembler_code_not_returned_to_text=07075_E_Código ensamblador no devuelto a sección de texto +% There was a directive in the assembler block to change sections, +% but there is a missing return to the text section at the end +% of the assembler block. This might cause errors during link time. +asmr_e_not_directive_or_local_symbol=07076_E_No es una directiva o un símbolo local $1 +% This symbol is unknown. +asmr_w_using_defined_as_local=07077_E_Usando un nombre definido como una etiqueta local +asmr_e_dollar_without_identifier=07078_E_Tóken de dólar usado sin identificador +% A constant expression has an identifier which does not start with +% the $ symbol. +asmr_w_32bit_const_for_address=07079_W_Constante de 32 bits creada para la dirección +% A constant was used as an address. This is probably an error, +% since using absolute addresses will probably not work. +asmr_n_align_is_target_specific=07080_N_.align es dependiente de la plataforma, use .balign o .p2align +% Using the .align directive is platform specific, and its meaning will vary +% from one platform to another. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_No se puede acceder directamente a los campos de los parámetros +% You should load the parameter first into a register and then access the +% fields using that register. +asmr_e_cannot_access_object_field_directly=07082_E_No se puede acceder directamente a los campos de objetos o clases +% You should load the self pointer first into a register and then access the +% fields using the register as base. By default the self pointer is available +% in the esi register on i386. +asmr_e_unable_to_determine_reference_size=07083_E_No se especificó un tamaño y no es posible determinar el tamaño del operando +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. +asmr_e_cannot_use_RESULT_here=07084_E_No se puede utilizar RESULT en esta función +% Some functions which return complex types cannot use the \var{result} +% keyword. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" sin operando traducido como "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" traducido como "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" traducido como "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_El carácter < no está permitido aquí +% The shift operator requires the << characters. Only one +% of those characters was found. +asmr_e_invalid_char_greater=07090_E_El carácter > no está permitido aqui +% The shift operator requires the >> characters. Only one +% of those characters was found. +asmr_w_align_not_supported=07093_W_ALIGN no es soportado +asmr_e_no_inc_and_dec_together=07094_E_Inc y Dec no pueden estar juntos en la misma instrucción +% Trying to use an increment and a decrement within the same +% opcode on the 680x0. This is impossible. +asmr_e_invalid_reg_list_in_movem=07095_E_Lista de registros inválida para movem +% Trying to use the \var{movem} opcode with invalid registers +% to save or restore. +asmr_e_invalid_reg_list_for_opcode=07096_E_Lista de registros inválida para la instrucción +asmr_e_higher_cpu_mode_required=07097_E_Se requiere un modo de CPU superior ($1) +% Trying to use an instruction which is not supported in the current +% cpu mode. Use a higher cpu generation to be able to use this +% opcode in your assembler block +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_No se especificó el tamaño del operando y no pudo ser determinado. Se utilizará DWORD por defecto +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use DWORD as default. +asmr_e_illegal_shifterop_syntax=07099_E_Error de sintaxis tratando de interpretar un operando de desplazamiento +% ARM only; ARM assembler supports a so called shifter operand. The used syntax isn't +% a valid shifter operand. Example for an operation with shifter operand: +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +# +# Assembler/binary writers +# +# 08018 is the last used one +# +asmw_f_too_many_asm_files=08000_F_Demasiados archivos de ensamblador abiertos +% With smartlinking enabled, there are too many assembler +% files generated. Disable smartlinking. +asmw_f_assembler_output_not_supported=08001_F_Salida a ensamblador seleccionada no soportada +asmw_f_comp_not_supported=08002_F_Comp no soportado +asmw_f_direct_not_supported=08003_F_Direct no soportado por escritores binarios +% Direct assembler mode is not supported for binary writers. +asmw_e_alloc_data_only_in_bss=08004_E_Sólo esta permitido alojar datos en la seccion bss +asmw_f_no_binary_writer_selected=08005_F_No hay seleccionado un escritor binario +asmw_e_opcode_not_in_table=08006_E_Asm: Opcode $1 no está en la tabla +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 combinacion inválida de opcode y operandos +asmw_e_16bit_not_supported=08008_E_Asm: Referencias de 16 Bit no soportadas +asmw_e_invalid_effective_address=08009_E_Asm: Dirección efectiva no válida +asmw_e_immediate_or_reference_expected=08010_E_Asm: Inmediato o referencia esperado +asmw_e_value_exceeds_bounds=08011_E_Asm: $1 valor excede los límites $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: Salto corto es fuera de rango $1 +asmw_e_undefined_label=08013_E_Asm: Etiqueta no definida $1 +asmw_e_comp_not_supported=08014_E_Asm: El tipo Comp no está soportado en esta plataforma +asmw_e_extended_not_supported=08015_E_Asm: El tipo Extended no está soportado en esta plataforma +asmw_e_duplicate_label=08016_E_Asm: Etiquita $1 duplicada +asmw_e_redefined_label=08017_E_Asm: Etiqueta $1 redefinida +asmw_e_first_defined_label=08018_E_Asm: Se definió por primera vez aquí +asmw_e_invalid_register=08019_E_Asm: Registro $1 inválido + +# +# Executing linker/assembler +# +# 09034 is the last used one +# +# BeginOfTeX +% +% \section{Errors of assembling/linking stage} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +exec_w_source_os_redefined=09000_W_Sistema operativo de origen redefinido +exec_i_assembling_pipe=09001_I_Ensamblando (pipe) $1 +exec_d_cant_create_asmfile=09002_E_No se puede crear fichero ensamblador $1 +% The mentioned file can't be created. Check if you have got +% access permissions to create this file +exec_e_cant_create_objectfile=09003_E_No se puede crear fichero objeto: $1 +% The mentioned file can't be created. Check if you've +% got access permissions to create this file +exec_e_cant_create_archivefile=09004_E_No se puede crear fichero de archivado: $1 +% The mentioned file can't be created. Check if you've +% access permissions to create this file +exec_e_assembler_not_found=09005_E_Ensamblador $1 no encontrado, cambiando a ensamblado externo +exec_t_using_assembler=09006_T_Usando ensamblador: $1 +exec_e_error_while_assembling=09007_E_Error mientras se ensamblaba, codigo de terminación $1 +% There was an error while assembling the file using an external assembler. +% Consult the documentation of the assembler tool to find out more information +% on this error. +exec_e_cant_call_assembler=09008_E_No se pudo llamar al ensamblador, error $1. Cambiando a ensamblador externo +exec_i_assembling=09009_I_Ensamblando $1 +exec_i_assembling_smart=09010_I_Assembling con enlazado inteligente $1 +exec_w_objfile_not_found=09011_W_Objeto $1 no encontrado, el enlazado podria fallar! +% One of the object file is missing, and linking will probably fail. +% Check your paths. +exec_w_libfile_not_found=09012_W_Librería $1 no encontrada, el enlazado podria fallar! +% One of the library file is missing, and linking will probably fail. +% Check your paths. +exec_e_error_while_linking=09013_E_Error durante el enlazado +% Generic error while linking. +exec_e_cant_call_linker=09014_E_No se puede llamar al enlazador, cambiando a enlazado externo +exec_i_linking=09015_I_Enlazando $1 +exec_e_util_not_found=09016_E_Utilidad $1 no encontrada, cambiando a enlazado externo +exec_t_using_util=09017_T_Utilizando utilidad $1 +exec_e_exe_not_supported=09018_E_Creacion de ejecutables no soportado +exec_e_dll_not_supported=09019_E_Creacion de librerías dinámicas/compartidas no soportado +exec_i_closing_script=09020_I_Cerrando script $1 +exec_e_res_not_found=09021_E_Compilador de recursos no encontrado, cambiando a modo externo +exec_i_compilingresource=09022_I_Compilando resource $1 +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_La unidad $1 no puede ser enlazada estáticamente, cambiando a enlazado inteligente +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_La unidad $1 no puede ser enlazada inteligentemente, cambiando a enlazado estático +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_La unidad $1 no admite enlazado compartido, cambiando a enlazado estático +exec_e_unit_not_smart_or_static_linkable=09026_E_La unidad $1 no puede ser enlazada estática o inteligentemente +exec_e_unit_not_shared_or_static_linkable=09027_E_La unidad $1 no admite enlazado compartido o estático +%\end{description} +# EndOfTeX + +# +# Executable information +# +execinfo_f_cant_process_executable=09128_F_No se puede post-procesar el ejecutable $1 +execinfo_f_cant_open_executable=09129_F_No se puede abrir el ejecutable $1 +execinfo_x_codesize=09130_X_Tamaño de Código: $1 bytes +execinfo_x_initdatasize=09131_X_Tamaño de datos inicializados: $1 bytes +execinfo_x_uninitdatasize=09132_X_Tamaño de datos sin inicializar: $1 bytes +execinfo_x_stackreserve=09133_X_Espacio reservado para la pila: $1 bytes +execinfo_x_stackcommit=09134_X_Stack space commited: $1 bytes + +# +# Unit loading +# +# 10041 is the last used one +# +# BeginOfTeX +% \section{Unit loading messages.} +% This section lists all messages that can occur when the compiler is +% loading a unit from disk into memory. Many of these messages are +% informational messages. +% \begin{description} +unit_t_unitsearch=10000_T_Buscando unidad: $1 +% When you use the \var{-vt}, the compiler tells you where it tries to find +% unit files. +unit_t_ppu_loading=10001_T_Cargando PPU $1 +% When the \var{-vt} switch is used, the compiler tells you +% what units it loads. +unit_u_ppu_name=10002_U_PPU Nombre: $1 +% When you use the \var{-vu} flag, the unit name is shown. +unit_u_ppu_flags=10003_U_PPU Banderas: $1 +% When you use the \var{-vu} flag, the unit flags are shown. +unit_u_ppu_crc=10004_U_PPU CRC: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_time=10005_U_PPU Fecha: $1 +% When you use the \var{-vu} flag, the time the unit was compiled is shown. +unit_u_ppu_file_too_short=10006_U_Fichero PPU demasiado corto +% The ppufile is too short, not all declarations are present. +unit_u_ppu_invalid_header=10007_U_Cabecera PPU inválida (no comienza por PPU) +% A unit file contains as the first three bytes the ascii codes of \var{PPU} +unit_u_ppu_invalid_version=10008_U_Versión $1 inválida +% This unit file was compiled with a different version of the compiler, and +% cannot be read. +unit_u_ppu_invalid_processor=10009_U_PPU está compilada para otro procesador +% This unit file was compiled for a different processor type, and +% cannot be read +unit_u_ppu_invalid_target=10010_U_PPU está compilada para otra plataforma +% This unit file was compiled for a different target, and +% cannot be read +unit_u_ppu_source=10011_U_Origen PPU: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_write=10012_U_Escribiendo $1 +% When you specify the \var{-vu} switch, the compiler will tell you where it +% writes the unit file. +unit_f_ppu_cannot_write=10013_F_No se puede escribir el fichero PPU +% An error occurred when writing the unit file. +unit_f_ppu_read_error=10014_F_Error leyendo fichero PPU +% This means that the unit file was corrupted, and contains invalid +% information. Recompilation will be necessary. +unit_f_ppu_read_unexpected_end=10015_F_Fin de fichero inesperado +% Unexpected end of file. This may mean that the PPU file is +% corrupted. +unit_f_ppu_invalid_entry=10016_F_Entrada inválida en fichero PPU: $1 +% The unit the compiler is trying to read is corrupted, or generated with a +% newer version of the compiler. +unit_f_ppu_dbx_count_problem=10017_F_Problema en el contador PPU Dbx +% There is an inconsistency in the debugging information of the unit. +unit_e_illegal_unit_name=10018_E_Nombre de unidad inválido: $1 +% The name of the unit does not match the file name. +unit_f_too_much_units=10019_F_Demasiades unidades +% \fpc has a limit of 1024 units in a program. You can change this behavior +% by changing the \var{maxunits} constant in the \file{fmodule.pas} file of the +% compiler, and recompiling the compiler. +unit_f_circular_unit_reference=10020_F_Referencia circular entre unidades $1 y $2 +% Two units are using each other in the interface part. This is only allowed +% in the \var{implementation} part. At least one unit must contain the other one +% in the \var{implementation} section. +unit_f_cant_compile_unit=10021_F_No se puede compilar la unidad $1, no hay código fuente disponible +% A unit was found that needs to be recompiled, but no sources are +% available. +unit_f_cant_find_ppu=10022_F_No se puede encontrar la unidad $1 +% You tried to use a unit of which the PPU file isn't found by the +% compiler. Check your configuration file for the unit paths +unit_w_unit_name_error=10023_W_La unidad $1 no pudo ser encontrada, pero $2 existe +unit_f_unit_name_error=10024_F_Se buscó la unidad $1 pero se encontró $2 +% Dos truncation of 8 letters for unit PPU files +% may lead to problems when unit name is longer than 8 letters. +unit_w_switch_us_missed=10025_W_Compilar la unidad System requiere el conmutador -Us +% When recompiling the system unit (it needs special treatment), the +% \var{-Us} must be specified. +unit_f_errors_in_unit=10026_F_Hubo $1 errores compilando el modulo, parando +% When the compiler encounters a fatal error or too many errors in a module +% then it stops with this message. +unit_u_load_unit=10027_U_Cargado de $1 ($2) unidad $3 +% When you use the \var{-vu} flag, which unit is loaded from which unit is +% shown. +unit_u_recompile_crc_change=10028_U_Recompilando $1, checksum cambiado por $2 +unit_u_recompile_source_found_alone=10029_U_Recompilando $1, solo se encontró el código fuente +% When you use the \var{-vu} flag, these messages tell you why the current +% unit is recompiled. +unit_u_recompile_staticlib_is_older=10030_U_Recompilando unidad, la lib estática es más antigua que la ppu +% When you use the \var{-vu} flag, the compiler warns if the static library +% of the unit are older than the unit file itself. +unit_u_recompile_sharedlib_is_older=10031_U_Recompilando unidad, la lib compartida es más antigua que la ppu +% When you use the \var{-vu} flag, the compiler warns if the shared library +% of the unit are older than the unit file itself. +unit_u_recompile_obj_and_asm_older=10032_U_Recompilando unidad, obj y asm son más antiguos que ppu +% When you use the \var{-vu} flag, the compiler warns if the assembler or +% object file of the unit are older than the unit file itself. +unit_u_recompile_obj_older_than_asm=10033_U_Recompilando unidad, obj es más antiguo que asm +% When you use the \var{-vu} flag, the compiler warns if the assembler +% file of the unit is older than the object file of the unit. +unit_u_parsing_interface=10034_U_Interpretando interfaz de $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the interface part of the unit +unit_u_parsing_implementation=10035_U_Interpretando implementacion de $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the implementation part of the unit +unit_u_second_load_unit=10036_U_Segunda carga para la unidad $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_check_time=10037_U_Chequeo de fichero PPU $1 fecha $2 +% When you use the \var{-vu} flag, the compiler show the filename and +% date and time of the file which a recompile depends on +### The following two error msgs is currently disabled. +#unit_h_cond_not_set_in_last_compile=10038_H_Conditional $1 was not set at startup in last compilation of $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that currently is defined, but was not used the last +#% time the unit was compiled. +#unit_h_cond_set_in_last_compile=10039_H_Conditional $1 was set at startup in last compilation of $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that was used the last time the unit was compiled, but +#% the conditional is currently not defined. +unit_w_cant_compile_unit_with_changed_incfile=10040_W_No se pudo recompilar la unida $1, pero se encontraron ficheros de inclusió modificados +% A unit was found to have modified include files, but +% some source files were not found, so recompilation is impossible. +unit_h_source_modified=10041_H_El fichero $1 es mas moderno que la versión Release del archivo PPU $2 +% A modified source file for a unit was found that was compiled with the +% release flag (-Ur). The unit will not implicitly be recompiled because +% this release flag is set. +unit_u_ppu_invalid_fpumode=10042_U_Se esta utilizando una unidad que no fue compilada con el modo de FPU correcto +% Trying to compile code while using units which were not compiled with +% the same floating point format mode. Either all code should be compiled +% with FPU emulation on, or with FPU emulation off. +unit_u_loading_interface_units=10043_U_Cargando unidades de interfaz de $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the units defined in the interface part of the unit. +unit_u_loading_implementation_units=10044_U_Cargando unidades de implementación de $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the units defined in the implementation part of the unit. +unit_u_interface_crc_changed=10045_U_CRC de la interfaz de la unidad $1 cambiado +% When you use the \var{-vu} flag, the compiler warns that it the +% CRC calculated for the interface has been changed after the implementation +% has been parsed. +unit_u_implementation_crc_changed=10046_U_CRC de la implementacion de la unidad $1 cambiado +% When you use the \var{-vu} flag, the compiler warns that it the +% CRC calculated has been changed after the implementation +% has been parsed. +unit_u_finished_compiling=10047_U_Finalizando compilado de la unidad $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has finished compiling the unit. +unit_u_add_depend_to=10048_U_Añadida dependencia de $1 a $2 +% When you use the \var{-vu} flag, the compiler warns that it +% has added a dependency between the two units. +unit_u_no_reload_is_caller=10049_U_No hay recarga, es llamada de: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has will not reload the unit because it is the unit that wants +% to load this unit +unit_u_no_reload_in_second_compile=10050_U_No hay recarga, ya se esta en la segunda compilación de: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has will not reload the unit because it is already in a second recompile +unit_u_flag_for_reload=10051_U_Marcado para recarga: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to reload the unit +unit_u_forced_reload=10052_U_Recarga forzada +% When you use the \var{-vu} flag, the compiler warns that it +% has is reloading the unit because it was required +unit_u_previous_state=10053_U_Estado anterior de $1: $2 +% When you use the \var{-vu} flag, the compiler shows the +% previous state of the unit +unit_u_second_compile_unit=10054_U_Ya se está compilando $1, estableciendo segunda compilación +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_loading_unit=10055_U_Cargando unidad $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the unit. +unit_u_finished_loading_unit=10056_U_Carga de la unidad $1 completada +% When you use the \var{-vu} flag, the compiler warns that it finished +% loading the unit. +unit_u_registering_new_unit=10057_U_Registrando nueva unidad $1 +% When you use the \var{-vu} flag, the compiler warns that it has +% found a new unit and registers it in the internal lists. +unit_u_reresolving_unit=10058_U_Re-resolviendo unidad $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to recalculate the internal data of the unit +unit_u_skipping_reresolving_unit=10059_U_Saltando re-resolución de $1, aún se estan cargando las unidades utilizadas +% When you use the \var{-vu} flag, the compiler warns that it +% skips to recalculate the internal data of the unit because there +% is no data to recalculate +% \end{description} +# EndOfTeX + +# +# Options +# +# 11039 is the last used one +# +option_usage=11000_O_$1 [opciones] <fichero_entrada> [opciones] +# BeginOfTeX +% +% \section{Command-line handling errors} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +option_only_one_source_support=11001_W_Solo es soportado un fichero fuente +% You can specify only one source file on the command line. The first +% one will be compiled, others will be ignored. This may indicate that +% you forgot a \var{'-'} sign. +option_def_only_for_os2=11002_W_Fichero DEF solo puede ser creado para OS/2 +% This option can only be specified when you're compiling for OS/2 +option_no_nested_response_file=11003_E_Ficheros de respuesta anidados no son soportados +% you cannot nest response files with the \var{@file} command-line option. +option_no_source_found=11004_F_No hay fichero fuente en la línea de comandos +% The compiler expects a source file name on the command line. +option_no_option_found=11005_N_No hay opciones en el archivo de configuración $1 +% The compiler didn't find any option in that config file. +option_illegal_para=11006_E_Parámetro incorrecto: $1 +% You specified an unknown option. +option_help_pages_para=11007_H_-? escribe las páginas de ayuda +% When an unknown option is given, this message is diplayed. +option_too_many_cfg_files=11008_F_Demasiados ficheros de configuración anidados +% You can only nest up to 16 config files. +option_unable_open_file=11009_F_Imposible abrir fichero $1 +% The option file cannot be found. +option_reading_further_from=11010_D_Leyendo opciones adicionales de $1 +% Displayed when you have notes turned on, and the compiler switches +% to another options file. +option_target_is_already_set=11011_W_Destino está ya puesto a: $1 +% Displayed if more than one \var{-T} option is specified. +option_no_shared_lib_under_dos=11012_W_Librerías compartidas no soportadas en la plataforma DOS, regresando a estáticas +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos +option_too_many_ifdef=11013_F_demasiados IF(N)DEFs +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_many_endif=11014_F_demasiados ENDIFs +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_less_endif=11015_F_condicional abierto al final del fichero +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_no_debug_support=11016_W_La generación de información de depuración no es soportada por este ejecutable +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_Prueba recompilando con -dGDB +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_E_Estas usando el conmutador obsoleto $1 +% this warns you when you use a switch that is not needed/supported anymore. +% It is recommended that you remove the switch to overcome problems in the +% future, when the switch meaning may change. +option_obsolete_switch_use_new=11019_E_Estás usando el conmutador obsoleto $1, porfavor usa $2 +% this warns you when you use a switch that is not supported anymore. You +% must now use the second switch instead. +% It is recommended that you change the switch to overcome problems in the +% future, when the switch meaning may change. +option_switch_bin_to_src_assembler=11020_N_Cambiando a ensamblador de escritura de código fuente por defecto +% this notifies you that the assembler has been changed because you used the +% -a switch which can't be used with a binary assembler writer. +option_incompatible_asm=11021_W_La salida de ensamblador "$1" no es compatible con "$2" +option_asm_forced=11022_W_Forzado el uso de ensamblador "$1" +% The assembler output selected can not generate +% object files with the correct format. Therefore, the +% default assembler for this target is used instead. +option_using_file=11026_T_Leyendo opciones del fichero $1 +% Options are also read from this file +option_using_env=11027_T_Leyendo opciones del entorno $1 +% Options are also read from this environment string +option_handling_option=11028_D_Procesando pción "$1" +% Debug info that an option is found and will be handled +option_help_press_enter=11029__*** presione retorno *** +option_start_reading_configfile=11030_H_Inicio de lectura del archivo de configuración $1 +% Starting of config file parsing. +option_end_reading_configfile=11031_H_Fin de lectura del archivo de configuración $1 +% End of config file parsing. +option_interpreting_option=11032_D_Interpretando opción "$1" +option_interpreting_firstpass_option=11036_D_Interpretando primera pasada de la opción "$1" +option_interpreting_file_option=11033_D_Interpretando opción de archivo "$1" +option_read_config_file=11034_D_Leyendo archivo de configuración "$1" +option_found_file=11035_D_encontrado nombre del archivo fuente "$1" +% Additional infos about options, displayed +% when you have debug option turned on. +option_code_page_not_available=11039_E_Código de página desconocido +%\end{description} +# EndOfTeX + +# +# Logo (option -l) +# +option_logo=11023_[ +Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU +Copyright (c) 1993-2011 by Florian Klaempfl +] + +# +# Info (option -i) +# +option_info=11024_[ +Free Pascal Compiler versión $FPCVERSION + +Fecha del Compilador : $FPCDATE +CPU de destino : $FPCCPU + +Plataformas soportadas: + $OSTARGETS + +Sets de instrucciones de la CPU soportados: + $INSTRUCTIONSETS + +Sets de instrucciones de la FPU soportados: + $FPUINSTRUCTIONSETS + +Este programa esta bajo la licencia GNU General Public Licence +Para mas informació lea COPYING.FPC + +Para informar de errores, sugerencias, etc: + http://bugs.freepascal.org +o + bugs@freepascal.org +] + +# +# Help pages (option -? and -h) +# +# The first character on the line indicates who will display this +# line, the current possibilities are : +# * = every target +# 3 = 80x86 targets +# 6 = 680x0 targets +# e = in extended debug mode only +# P = PowerPC targets +# S = Sparc targets +# V = Virtual machine targets +# The second character also indicates who will display this line, +# (if the above character was TRUE) the current possibilities are : +# * = everyone +# g = with GDB info supported by the compiler +# O = OS/2 +# L = UNIX systems +# The third character represents the indentation level. +# +option_help_pages=11025_[ +**0*_ponga + tras un conmutador booleano para activarlo, - para desactivarlo +**1a_el compilador no borra los ficheros de ensamblador generados +**2al_incluir los números de línea del codigo fuente en el archivo ensamblador +**2an_incluir la informacion de nodos en el archivo ensamblador generado +*L2ap_usar tuberías (pipes) en lugar de crear archivos de ensamblado temporales +**2ar_incluir reserva y liberació de registros en el archivo ensamblador +**2at_incluir informacion de reserva y liberación temporales en el archivo ensamblador +**1A<x>_formato de salida: +**2Adefault_usar ensamblador por defecto +3*2Aas_ensamblar usando GNU AS +3*2Anasmcoff_coff (Go32v2) usando Nasm +3*2Anasmelf_elf32 (Linux) usando Nasm +3*2Anasmwin32_objeto Win32 usando Nasm +3*2Anasmwdosx_objeto Win32/WDOSX usando Nasm +3*2Awasm_fichero obj usando Wasm (Watcom) +3*2Anasmobj_fichero obj usando Nasm +3*2Amasm_fichero obj usando Masm (Microsoft) +3*2Atasm_fichero obj usando Tasm (Borland) +3*2Aelf_elf32 (Linux) usando escritor interno +3*2Acoff_coff (Go32v2) usando escritor interno +3*2Apecoff_pecoff (Win32) usando escritor interno +4*2Aas_ensamblar usando GNU AS +6*2Aas_archivo o de Unix usando GNU AS +6*2Agas_ensamblador GNU Motorola +6*2Amit_Sintaxis MIT (GAS antiguo) +6*2Amot_Ensamblador Motorola estándar +A*2Aas_ensamblar usando GNU AS +P*2Aas_ensamblar usando GNU AS +S*2Aas_ensamblar usando GNU AS +**1b_generar informacion de navegado +**2bl_generar informació de símbolos locales +**1B_construir(build) todos los modulos +**1C<x>_opciones de generado de código: +**2Cc<x>_cambiar la convencion de llamada por defecto a <x> +**2CD_crear adicionalmente una librería dinámica (no soportado) +**2Ce_Compilar con opcodes de punto flotante emulados +**2Cf<x>_Cambiar el set de instrucciones de la FPU usado, fpc -i para posibles valores<x> +**2Cg_Generar código PIC +**2Ch<n>_<n> bytes heap (entre 1023 y 67107840) +**2Ci_Comprobación de E/S +**2Cn_omitir etapa de enlazado +**2Co_comprobar desbordamiento en operaciones de enteros +**2Cp<x>_Cambiar el set de instrucciones usado, fpc -i para posibles valores +**2Cr_comprobación de rango +**2CR_verificar validez de objetos de llamada +**2Cs<n>_definir el tamaño de la pila a <n> +**2Ct_comprobación de pila +**2CX_crear adicionalmente una librerí con enlazado inteligente +**1d<x>_define el símbol <x> +**1D_generar fichero DEF +**2Dd<x>_establece la descripción a <x> +**2Dv<x>_establece la version de la DLL a <x> +*O2Dw_Aplicación PM +**1e<x>_establecer ruta al ejecutable +**1E_igual que -Cn +**1F<x>_establecer ficheros y rutas: +**2Fa<x>[,y]_para hacer que el programa cargue las unidades <x> e [y] antes de procesar su uses +**2Fc<x>_establece el código de pagina de la entrada a <x> +**2FD<x>_establece la ruta donde buscar las utilidades del compilador +**2Fe<x>_redirige la salida de errores a <x> +**2FE<x>_establece la ruta de destino de exe/unidades a <x> +**2Fi<x>_añade <x> a las rutas de inclusión +**2Fl<x>_añade <x> a las rutas de librerías +**2FL<x>_usa <x> como enlazador dinámico +**2Fo<x>_añade <x> a las rutas de objetos +**2Fr<x>_load error message file <x> +**2Fu<x>_adds <x> a las rutas de unidades +**2FU<x>_establece la ruta de salida de unidades a <x>, reemplaza -FE anteriores +*g1g_generar información de depurado: +*g2gc_generar comprobación de punteros +*g2gd_usar dbx +*g2gg_usar gsym +*g2gh_usar unidad de trazado de memoria (para depurar pérdidas de memoria) +*g2gl_usar informacion de líneas de las unidades para la traza de ejecución (backtrace) +*g2gv_genera programas trazables con valgrind +*g2gw_generar información de depurado dwarf +**1i_información +**2iD_devuelve la fecha del compilador +**2iV_devuelve la versión del compilador +**2iSO_devuelve el SO del compilador +**2iSP_devuelve el procesador del compilador +**2iTO_devuelve el SO de destino +**2iTP_devuelve el procesador de destino +**1I<x>_añade <x> a las rutas de iclusión +**1k<x>_Pasar <x> al enlazador +**1l_mostrar logo +**1M<x>_establecer modo del lenguaje a <x> +**2Mfpc_dialecto de free pascal(default) +**2Mobjfpc_activar algunas extensiones de Delphi 2 +**2Mdelphi_tratar de ser compatible con Delphi +**2Mtp_tratar de ser compatible con TP/BP 7.0 +**2Mgpc_tratar de ser compatible con gpc +**2Mmacpas_tratar de ser compatible con dialectos de macintosh pascal +**1n_no leer la configuración por defecto +**1o<x>_cambiar el nombre del ejecutable producido a <x> +**1O<x>_optimizaciones: +3*2Og_generar código más pequeño +3*2OG_generar código más rápido (defecto) +**2Or_mantener algunas variables en registros +3*2Ou_activar optimizaciones inseguras (ver docs) +3*2O1_optimizaciones nivel 1 (optimizaciones rápidas) +3*2O2_optimizaciones nivel 2 (-O1 + optimizaciones más lentas) +3*2O3_optimizaciones nivel 3 (-O2 repetidamente, max 5 veces) +3*2Op<x>_procesador de destino: +3*3Op1_establecer procesador de destino a 386/486 +3*3Op2_establecer procesador de destino a Pentium/PentiumMMX (tm) +3*3Op3_establecer procesador de destino a PPro/PII/c6x86/K6 (tm) +6*2Og_generar código más pequeño +6*2OG_generatr código más rápido (defecto) +6*2Ox_optimizar al máximo (AUN CON ERRORES!!!) +6*2O0_establecer procesador de destino a MC68000 +6*2O2_establecer procesador de destino a MC68020+ (defecto) +**1pg_generar código de perfilado gprof (define FPC_PROFILE) +**1R<x>_estilo de lectura de ensamblador: +**2Rdefault_usar ensamblador por defecto +3*2Ratt_leer ensamblador estilo AT&T +3*2Rintel_leer ensamblador estilo Intel +6*2RMOT_leer ensamblador estilo motorola +**1S<x>_opciones de sintaxis: +**2S2_igual que -Mobjfpc +**2Sc_soportar operadores estilo C (*=,+=,/= and -=) +**2Sa_incluir código de aserción. +**2Sd_igual que -Mdelphi +**2Se<x>_opciones de error. <x> es una combinación de los siguientes: +**3*_<n> : detener el compilador tras <n> errores (por defecto 1) +**3*_w : detener también tras avisos +**3*_n : detener también tras notas +**3*_h : detener también tras consejos +**2Sg_permitir LABEL y GOTO +**2Sh_Usar cadenas largas (ansistrings) +**2Si_soportar INLINE estilo C++ +**2SI<x>_establecer estilo de interfaz a <x> +**3SIcom_interfaces compatibles COM (defecto) +**3SIcorba_interfaces compatibles CORBA +**2Sm_soportar macros tipo C (global) +**2So_igual que -Mtp +**2Sp_igual que -Mgpc +**2Ss_el nombre del constructor debe ser init (el destructor debe ser done) +**1s_no llamar al ensamblador ni enlazador +**2sh_Generar script para enlazar en host +**2st_Generar script para enlazar en destino +**2sr_Saltar fase de reserva de registros (usar con -alr) +**1T<x>_Sistema operativo de destino: +3*2Temx_OS/2 usando EMX (incluyendo extensor EMX/RSX) +3*2Tfreebsd_FreeBSD +3*2Tgo32v2_Version 2 de DJ Delorie DOS extender +3*2Tlinux_Linux +3*2Tnetbsd_NetBSD +3*2Tnetware_Novell Netware Module (clib) +3*2Tnetwlibc_Novell Netware Module (libc) +3*2Topenbsd_OpenBSD +3*2Tos2_OS/2 / eComStation +3*2Tsunos_SunOS/Solaris +3*2Twatcom_extensor DOS compatible Watcom +3*2Twdosx_extensor WDOSX DOS +3*2Twin32_Windows 32 Bit +4*2Tlinux_Linux +6*2Tamiga_Commodore Amiga +6*2Tatari_Atari ST/STe/TT +6*2Tlinux_Linux-68k +6*2Tmacos_Macintosh m68k (no soportado) +6*2Tpalmos_PalmOS +A*2Tlinux_Linux +P*2Tdarwin_Darwin y MacOS X en PowerPC +P*2Tlinux_Linux en PowerPC +P*2Tmacos_MacOS (clásico) en PowerPC +P*2Tmorphos_MorphOS +S*2Tlinux_Linux +**1u<x>_elimina la definición del símbolo <x> +**1U_opciones de unidad: +**2Un_no comprobar el nombre de la unidad +**2Ur_generar unidades para distribución (release) +**2Us_compilar la unidad System +**1v<x>_Mostrar detalles. <x> es una combinación de las siguientes letras: +**2*_e : Mostrar errores (defecto) 0 : No mostrar nada (excepto errores) +**2*_w : Mostrar avisos u : Mostrar info. de la unidad +**2*_n : Mostrar notas t : Mostrar archivos usados / intentados +**2*_h : Mostrar consejos c : Mostrar condicionales +**2*_i : Mostrar info. general d : Mostrar info. de depurado +**2*_l : Mostrar num de lineas r : Modo compatible con Rhide/GCC +**2*_a : Mostrar todo x : Info. del ejecutable (Win32 solo) +**2*_v : escribe fpcdebug.txt con p : Escribir el árbol de parser en tree.log +**2*_ mucha informacón de depurado +3*1W<x>_opciones de Win32 o similares +3*2WB<x>_Establece la dirección hex de base a <x> +3*2WC_Especifica que la aplicación es de consola +3*2WD_Usa DEFFILE para exportar funciones de la DLL o EXE +3*2WF_Especifica aplicación de pantalla completa (OS/2 sólo) +3*2WG_Especifica que la aplicación es para entorno gráfico +3*2WN_No generar código de reubicación (necesario para depurar) +3*2WR_Generar código de reubicación +P*2WC_Especifica aplicación de colnsola (MacOS sólo) +P*2WG_Especifica aplicación gráfica (MacOS sólo) +P*2WT_Especifica aplicación de tipo herramienta (herramienta MPW, MacOS sólo) +**1X_opciones de ejecutable: +**2Xc_pasar --shared al enlazador (Unix sólo) +**2Xd_no utilizar la ruta de librería por defecto (necesario para compilación cruzada) +**2XD_tratar de enlazar dinámicamente (define FPC_LINK_DYNAMIC) +**2XP<x>_pone <x> delante de los nombres de binutils +**2Xr<x>_establece la ruta de librerías a <x> (necesario para compilación cruzada) +**2Xs_eliminar todos los símbolos del ejecutable +**2XS_tratar de enlazar estáticamente (defecto) (define FPC_LINK_STATIC) +**2Xt_enlazar con librerias estáticas (-static es pasado al enlazador) +**2XX_tratar de enlazar inteligentemente (define FPC_LINK_SMART) +**1*_ +**1?_muestra esta ayuda +**1h_muestra esta ayuda sin esperas +] + +# +# The End... diff --git a/closures/compiler/msg/errorf.msg b/closures/compiler/msg/errorf.msg new file mode 100644 index 0000000000..fe00908011 --- /dev/null +++ b/closures/compiler/msg/errorf.msg @@ -0,0 +1,1899 @@ +# +# This file is part of the Free Pascal Compiler +# Copyright (c) 1998-2000 by the Free Pascal Development team +# +# French (cp850) Language File for Free Pascal +# +# 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. +# +# +# The constants are build in the following order: +# <part>_<type>_<txtidentifier> +# +# <part> is the part of the compiler the message is used +# asmr_ assembler parsing +# asmw_ assembler writing/binary writers +# unit_ unit handling +# scan_ scanner +# parser_ parser +# type_ type checking +# general_ general info +# exec_ calls to assembler, linker, binder +# +# <type> the type of the message it should normally used for +# f_ fatal error +# e_ error +# w_ warning +# n_ note +# h_ hint +# i_ info +# l_ linenumber +# u_ used +# t_ tried +# m_ macro +# p_ procedure +# c_ conditional +# d_ debug message +# b_ display overloaded procedures +# x_ executable informations +# + +# +# General +# +# BeginOfTeX +% \section{General compiler messages} +% This section gives the compiler messages which are not fatal, but which +% display useful information. The number of such messages can be +% controlled with the various verbosity level \var{-v} switches. +% \begin{description} +general_t_compilername=01000_T_Compilateur : $1 +% When the \var{-vt} switch is used, this line tells you what compiler +% is used. +general_d_sourceos=01001_D_SystŠme d'exploitation source : $1 +% When the \var{-vd} switch is used, this line tells you what the source +% operating system is. +general_i_targetos=01002_I_SystŠme d'exploitation cible : $1 +% When the \var{-vd} switch is used, this line tells you what the target +% operating system is. +general_t_exepath=01003_T_R‚pertoire pour fichiers executables : $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its binaries. +general_t_unitpath=01004_T_R‚pertoire de recherche d'unit‚s : $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for compiled units. You can set this path with the \var{-Fu} +general_t_includepath=01005_T_R‚pertoire pour recherche de fichiers inclus : $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its include files (files used in \var{\{\$I xxx\}} statements). +% You can set this path with the \var{-I} option. +general_t_librarypath=01006_T_R‚pertoire pour librairies : $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for the libraries. You can set this path with the \var{-Fl} option. +general_t_objectpath=01007_T_R‚pertoire pour fichiers objets : $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for object files you link in (files used in \var{\{\$L xxx\}} statements). +% You can set this path with the \var{-Fo} option. +general_i_abslines_compiled=01008_I_$1 lignes compil‚es, $2 secondes +% When the \var{-vi} switch is used, the compiler reports the number +% of lines compiled, and the time it took to compile them (real time, +% not program time). +general_f_no_memory_left=01009_F_Plus de m‚moire disponible +% The compiler doesn't have enough memory to compile your program. There are +% several remedies for this: +% \begin{itemize} +% \item If you're using the build option of the compiler, try compiling the +% different units manually. +% \item If you're compiling a huge program, split it up in units, and compile +% these separately. +% \item If the previous two don't work, recompile the compiler with a bigger +% heap (you can use the \var{-Ch} option for this, \seeo{Ch}) +% \end{itemize} +% \end{description} +# +# Scanner +# +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compiling handling. +% \begin{description} +general_i_writingresourcefile=01010_I_Ecriture du fichier Resource : $1 +% This message is shown when the compiler writes the Resource String Table +% file containing all the resource strings for a program. +general_e_errorwritingresourcefile=01011_E_Ecriture du fichier Resource String Table : $1 +% This message is shown when the compiler encountered an error when writing +% the Resource String Table file +% \end{description} +# +# Scanner +# +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compiling handling. +% \begin{description} +scan_f_end_of_file=02000_F_Fin de fichier inattendue +% this typically happens in on of the following cases : +% \begin{itemize} +% \item The source file ends befor then final \var{end.} statement. This +% happens mostly when the \var{begin} and \var{end} statements aren't +% balanced; +% \item An include file ends in the middle of a statement. +% \item A comment wasn't closed. +% \end{itemize} +scan_f_string_exceeds_line=02001_F_String au-del… de la fin de ligne +% You forgot probably to include the closing ' in a string, so it occupies +% multiple lines. +scan_f_illegal_char=02002_F_caractŠre ill‚gal +% An illegal character was encountered in the input file. +scan_f_syn_expected=02003_F_Erreur de syntaxe, $1 attendu mais $2 trouv‚ +% This indicates that the compiler expected a different token than +% the one you typed. It can occur almost everywhere where you make a +% mistake against the pascal language. +scan_t_start_include_file=02004_T_D‚but de lecture du fichier inclus $1 +% When you provide the \var{-vt} switch, the compiler tells you +% when it starts reading an included file. +scan_w_comment_level=02005_W_Commentaire de niveau $1 +% When the \var{-vw} switch is used, then the compiler warns you if +% it finds nested comments. Nested comments are not allowed in Turbo Pascal +% and can be a possible source of errors. +scan_n_far_directive_ignored=02006_N_$F directive (FAR) ignor‚e +% The \var{FAR} directive is a 16-bit construction which is recorgnised +% but ignored by the compiler, since it produces 32 bit code. +scan_n_stack_check_global_under_linux=02007_N_Le controle de la gestion de la pile est global sous Linux +% Stack checking with the \var{-Cs} switch is ignored under \linux, since +% \linux does this for you. Only displayed when \var{-vn} is used. +scan_n_ignored_switch=02008_N_Switch "$1" ignor‚ +% With \var{-vn} on, the compiler warns if it ignores a switch +scan_w_illegal_switch=02009_W_Switch "$1" ill‚gal +% You included a compiler switch (i.e. \var{\{\$... \}}) which the compiler +% doesn't know. +scan_w_switch_is_global=02010_W_Ce switch a un effet global +% When \var{-vw} is used, the compiler warns if a switch is global. +scan_e_illegal_char_const=02011_E_Constante de type char ill‚gale +% This happens when you specify a character with its ASCII code, as in +% \var{\#96}, but the number is either illegal, or out of range. The range +% is 1-255. +scan_f_cannot_open_input=02012_F_Impossible d'ouvrir le fichier $1 +% \fpc cannot find the program or unit source file you specified on the +% command line. +scan_f_cannot_open_includefile=02013_F_Impossible d'ouvrir le fichier inclus $1 +% \fpc cannot find the source file you specified in a \var{\{\$include \}} +% stateent. +scan_e_too_much_endifs=02014_E_Trop de $ENDIFs ou de $ELSEs +% Your \var{\{\$IFDEF ..\}} and {\{\$ENDIF\}} statements aren't balanced. +scan_w_only_pack_records=02015_W_L'alignement des Records peut uniquement ˆtre de 1,2,4,8 ou 16 bytes +% You are specifying the \var{\{\$PACKRECORDS n\} } with an illegal value for +% \var{n}. Only 1,2,4 or 16 are valid in this case. +scan_w_only_pack_enum=02016_W_Les ‚numerations peuvent seulement ˆtre sauvegard‚s en 1,2 ou 4 bytes +% You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for +% \var{n}. Only 1,2 or 4 are valid in this case. +scan_e_endif_expected=02017_E_$1 attendu pour $2 d‚fini … la ligne $3 +% Your conditional compilation statements are unbalanced. +scan_e_preproc_syntax_error=02018_E_Erreur de syntaxe pendant l'interpr‚tation d'une directive de compilation +% There is an error in the expression following the \var{\{\$if \}} compiler +% directive. +scan_e_error_in_preproc_expr=02019_E_Erreur d'‚valuation d'une directive de compilation +% There is an error in the expression following the \var{\{\$if \}} compiler +% directive. +scan_w_macro_cut_after_255_chars=02020_W_Le contenu d'une macro est tronqu‚ … 255 caractŠres +% The contents of macros cannot be longer than 255 characters. This is a +% safety in the compiler, to prevent buffer overflows. This is shown as a +% warning, i.e. when the \var{-vw} switch is used. +scan_e_endif_without_if=02021_E_ENDIF sans IF(N)DEF +% Your \var{\{\$IFDEF ..\}} and {\{\$ENDIF\}} statements aren't balanced. +scan_f_user_defined=02022_F_D‚fini par l'utilisateur : $1 +% A user defined fatal error occurred. see also the \progref +scan_e_user_defined=02023_E_D‚fini par l'utilisateur : $1 +% A user defined error occurred. see also the \progref +scan_w_user_defined=02024_W_D‚fini par l'utilisateur : $1 +% A user defined warning occurred. see also the \progref +scan_n_user_defined=02025_N_D‚fini par l'utilisateur : $1 +% A user defined note was encountered. see also the \progref +scan_h_user_defined=02026_H_D‚fini par l'utilisateur : $1 +% A user defined hint was encountered. see also the \progref +scan_i_user_defined=02027_I_D‚fini par l'utilisateur : $1 +% User defined information was encountered. see also the \progref +scan_e_keyword_cant_be_a_macro=02028_E_Impossible de redefinir un mot r‚serv‚ +% You cannot redefine keywords with macros. +scan_f_macro_buffer_overflow=02029_F_D‚bordement du buffer de la macro en lecture ou expansion +% Your macro or its result was too long for the compiler. +scan_w_macro_deep_ten=02030_W_L'expansion des macros d‚passe un niveau de 16. +% When expanding a macro macros have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_e_wrong_styled_switch=02031_E_Les directives de compilation entre (* ... *) ne sont pas accept‚es +% Compiler switches should always be between \var{\{ \}} comment delimiters. +scan_d_handling_switch=02032_D_Interpr‚tation switch "$1" +% When you set debugging info on (\var{-vd}) the compiler tells you when it +% is evaluating conditional compile statements. +scan_c_endif_found=02033_C_ENDIF $1 trouv‚ +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifdef_found=02034_C_IFDEF $1 trouv‚, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifopt_found=02035_C_IFOPT $1 trouv‚, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_if_found=02036_C_IF $1 trouv‚, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifndef_found=02037_C_IFNDEF $1 trouv‚, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_else_found=02038_C_ELSE $1 trouv‚, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_skipping_until=02039_C_Passant jusqu'…... +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements, and whether it is skipping or +% compiling parts. +scan_i_press_enter=02040_I_Appuyez sur <Entr‚e> pour continuer +% When the \var{-vi} switch is used, the compiler stops compilation +% and waits for the \var{Enter} key to be pressed when it encounters +% a \var{\{\$STOP\}} directive. +scan_w_unsupported_switch=02041_W_Switch non support‚ $1 +% When warings are turned on (\var{-vw}) the compiler warns you about +% unsupported switches. This means that the switch is used in Delphi or +% Turbo Pascal, but not in \fpc +scan_w_illegal_directive=02042_W_directive de compilation ill‚gale $1 +% When warings are turned on (\var{-vw}) the compiler warns you about +% unrecognised switches. For a list of recognised switches, \progref +scan_t_back_in=02043_T_De retour dans $1 +% When you use (\var{-vt}) the compiler tells you when it has finished +% reading an include file. +scan_w_unsupported_app_type=02044_W_Type d'application non support‚e : $1 +% You get this warning, if you specify an unknown application type +% with the directive $APPTYPE +scan_w_app_type_not_support=02045_W_$APPTYPE non support‚ par OS cible +% The $APPTYPE directive is supported by win32 applications only +scan_w_decription_not_support=02046_W_DESCRIPTION est support‚ seulement pour OS2 et Win32 +% The \var{\{\$DESCRIPTION\}} directive is only supported for OS2 and Win32 targets. +scan_n_version_not_support=02047_N_VERSION non support‚ par OS cible +% The \var{\{\$VERSION\}} directive is only supported by win32 target. +scan_n_only_exe_version=02048_N_VERSION seulement pour exes ou DLLs +% The \var{\{\$VERSION\}} directive is only used for executable or DLL sources. +scan_w_wrong_version_ignored=02049_W_Mauvais format de la directive VERSION $1 +% The \var{\{\$VERSION\}} directive format is major_version.minor_version +% where major_version and minor_version are words. +scan_w_unsupported_asmmode_specifier=02050_W_Style assembleur non support‚ $1 +% When you specify an assembler mode with the \var{\{\$ASMMODE xxx\}} +% the compiler didn't recognize the mode you specified. +scan_w_no_asm_reader_switch_inside_asm=02051_W_Changement de type d'interpr‚teur ASM … l'int‚rieur de code assembleur, $1 sera effectif seulement pour le prochain +% It is not possible to switch from one assembler reader to another +% inside an assmebler block. The new reader will be used for next +% assembler statement only. +scan_e_wrong_switch_toggle=02052_E_Mauvais argument de switch, utilisez ON/OFF ou +/- +% You need to use ON or OFF or a + or - to toggle the switch +scan_e_resourcefiles_not_supported=02053_E_Fichiers ressource non support‚ pour cette cible +% The target you are compiling for doesn't support Resource files. The +% only target which can use resource files is Win32 +scan_w_include_env_not_found=02054_W_Include pour variable d'environment $1 non trouv‚ +% The included environment variable can't be found in the environment, it'll +% be replaced by an empty string instead. +scan_e_invalid_maxfpureg_value=02055_E_Valeur invalide pour nombre limite de variables en registre FPU +% Valid values for this directive are 0..8 and NORMAL/DEFAULT +% \end{description} +# +# Parser +# +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your pascal constructs +% are correct. +% \begin{description} +scan_w_only_one_resourcefile_supported=02056_W_Un fichier ressource est seulement support‚ pour cette cible +% Only one resource file can be supported for this target - this is the case of +% OS/2 (EMX) currently. The first one found is used, the others are discarded. +% +% \end{description} +# +# Parser +# +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your pascal constructs +% are correct. +% \begin{description} +parser_e_syntax_error=03000_E_Parseur - Erreur de syntaxe +% An error against the Turbo Pascal language was encountered. This happens +% typically when an illegal character is found in the sources file. +parser_w_proc_far_ignored=03001_W_Directive pour proc‚dure FAR ignor‚ +% This is a warning. \var{FAR} is a construct for 8 or 16 bit programs. Since +% the compile generates 32 bit programs, it ignores this directive. +parser_w_proc_near_ignored=03002_W_Directive pour proc‚dure NEAR ignor‚ +% This is a warning. \var{NEAR} is a construct for 8 or 16 bit programs. Since +% the compile generates 32 bit programs, it ignores this directive. +parser_w_proc_interrupt_ignored=03003_W_Directive pour proc‚dure INTERRUPT ignor‚ +% This is a warning. \var{INTERRUPT} is a i386 specific construct +% and is igonred for other processors. +parser_e_dont_nest_interrupt=03004_E_Une proc‚dure de type INTERRUPT ne peut ˆtre locale +% An \VAR{INTERRUPT} procedure must be global. +parser_w_proc_directive_ignored=03005_W_Procedure type $1 ignored +% This is a warning. \var{REGISTER},\var{REINTRODUCE} is ignored by FPC programs for now. +% This is introduced first for Delphi compatibility. +parser_e_no_overload_for_all_procs=03006_E_Not all declarations of $1 are declared with OVERLOAD +% When you want to use overloading using the \var{OVERLOAD} directive, then +% all declarations need to have \var{OVERLOAD} specified. +parser_e_no_dll_file_specified=03007_E_Pas de fichier DLL sp‚cifi‚ +% No longer in use. +parser_e_export_name_double=03008_E_Nom de fonction export‚e doubl‚ $1 +% Exported function names inside a specific DLL must all be different +parser_e_export_ordinal_double=03009_E_Index de fonction export‚e doubl‚ $1 +% Exported function names inside a specific DLL must all be different +parser_e_export_invalid_index=03010_E_Index non valide pour fonction export‚e +% DLL function index must be in the range 1..$FFFF +parser_w_parser_reloc_no_debug=03011_W_Les DLL ou EXE relogeables sont incompatibles avec les informations de d‚bogage, d‚bogage d‚sactiv‚. +parser_w_parser_win32_debug_needs_WN=03012_W_Pour permettre le d‚bogage de code win32, utilisez l'option -WN +% Stabs info is wrong for relocatable DLL or EXES use -WN +% if you want to debug win32 executables. +parser_e_constructorname_must_be_init=03013_E_Le nom du constructeur doit ˆtre INIT +% You are declaring a constructor with a name which isn't \var{init}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_destructorname_must_be_done=03014_E_Le nom du destructeur doit ˆtre DONE +% You are declaring a constructor with a name which isn't \var{done}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_illegal_open_parameter=03015_E_ParamŠtre ouvert non valide +% You are trying to use the wrong type for an open parameter. +parser_e_proc_inline_not_supported=03016_E_Directive de fonction INLINE non support‚e +% You tried to compile a program with C++ style inlining, and forgot to +% specify the \var{-Si} option (\seeo{Si}). The compiler doesn't support C++ +% styled inlining by default. +parser_w_priv_meth_not_virtual=03017_W_Les m‚thodes priv‚es ne devraient pas ˆtre virutelles +% You declared a method in the private part of a object (class) as +% \var{virtual}. This is not allowed. Private methods cannot be overridden +% anyway. +parser_w_constructor_should_be_public=03018_W_Le constructeur devrait ˆtre public +% Constructors must be in the 'public' part of an object (class) declaration. +parser_w_destructor_should_be_public=03019_W_Le destructeur devrait ˆtre public +% Destructors must be in the 'public' part of an object (class) declaration. +parser_n_only_one_destructor=03020_N_Les classes ne devraient avoir qu'un selu destructeur +% You can declare only one destructor for a class. +parser_e_no_local_objects=03021_E_Les D‚finitions locales de classes ne sont pas autoris‚es +% Classes must be defined globally. They cannot be defined inside a +% procedure or function +parser_f_no_anonym_objects=03022_F_Les d‚finitions de classes anonymes sont interdites +% An invalid object (class) declaration was encountered, i.e. an +% object or class without methods that isn't derived from another object or +% class. For example: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% will trigger this error. +parser_object_has_no_vmt=03023_E_L'object $1 n'a pas de table de m‚thodes virtuelles (VMT) +parser_e_illegal_parameter_list=03024_E_Liste de paramŠtres ill‚gale +% You are calling a function with parameters that are of a different type than +% the declared parameters of the function. +parser_e_wrong_parameter_type=03025_E_Mauvais type pour paramŠtre #$1 +% There is an error in the parameter list of the function or procedure. +% The compiler cannot determine the error more accurate than this. +parser_e_wrong_parameter_size=03026_E_Mauvais nombre de paramŠtres sp‚cifi‚ +% There is an error in the parameter list of the function or procedure, +% the number of parameters is not correct. +parser_e_overloaded_no_procedure=03027_E_L'identificateur surcharg‚ $1 n'est pas une fonction +% The compiler encountered a symbol with the same name as an overloaded +% function, but it isn't a function it can overload. +parser_e_overloaded_have_same_parameters=03028_E_Les fonctions surcharg‚es ont les mˆmes paramŠtres +% You're declaring overloaded functions, but with the same parameter list. +% Overloaded function must have at least 1 different parameter in their +% declaration. +parser_e_header_dont_match_forward=03029_E_L'entˆte de la fonction ne correspond pas … la d‚claration $1 +% You declared a function with same parameters but +% different result type or function specifiers. +parser_e_header_different_var_names=03030_E_L'entˆte de la fonction $1 ne correspond pas … la d‚claration : le nom de variable change $2 => $3 +% You declared the function in the \var{interface} part, or with the +% \var{forward} directive, but define it with a different parameter list. +parser_n_duplicate_enum=03031_N_Les valeurs d'une ‚num‚ration doivent ˆtre en ordre ascendant +% \fpc allows enumeration constructions as in C. Given the following +% declaration two declarations: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% The second declaration would produce an error. \var{A\_UAS} needs to have a +% value higher than \var{A\_E}, i.e. at least 7. +parser_n_interface_name_diff_implementation_name=03032_N_Les noms d'interface et d'implementation sont diff‚rents $1 => $2 +% This note warns you if the implementation and interface names of a +% functions are different, but they have the same mangled name. This +% is important when using overloaded functions (but should produce no error). +parser_e_no_with_for_variable_in_other_segments=03033_E_With ne peut ˆtre utilis‚ pour des variables dans un autre segment +% With stores a variable locally on the stack, +% but this is not possible if the variable belongs to another segment. +parser_e_too_much_lexlevel=03034_E_Niveau d'inbrication de fonctions > 31 +% You can nest function definitions only 31 times. +parser_e_range_check_error=03035_E_Erreur d'intervalle dans l'‚valuation d'une constante +% The constants are out of their allowed range. +parser_w_range_check_error=03036_W_Erreur d'intervalle dans l'‚valuation d'une constante +% The constants are out of their allowed range. +parser_e_double_caselabel=03037_E_Valeur en double dans une instruction CASE +% You are specifying the same label 2 times in a \var{case} statement. +parser_e_case_lower_less_than_upper_bound=03038_E_Valeur max inf‚rieure … la valeur min dans CASE +% The upper bound of a \var{case} label is less than the lower bound and this +% is useless +parser_e_type_const_not_possible=03039_E_Les constantes typ‚es de classes sont interdites +% You cannot declare a constant of type class or object. +parser_e_no_overloaded_procvars=03040_E_Impossible d'assigner … une variable fonctionelle une fonction surcharg‚e +% You are trying to assign an overloaded function to a procedural variable. +% This isn't allowed. +parser_e_invalid_string_size=03041_E_La longueur d'une STRING doit ˆtre situ‚e entre 1 et 255 +% The length of a string in Pascal is limited to 255 characters. You are +% trying to declare a string with length lower than 1 or greater than 255 +% (This is not true for \var{Longstrings} and \var{AnsiStrings}. +parser_w_use_extended_syntax_for_objects=03042_W_Utilisez la syntaxe ‚tendue de NEW et DISPOSE pour les objets +% If you have a pointer \var{a} to a class type, then the statement +% \var{new(a)} will not initialize the class (i.e. the constructor isn't +% called), although space will be allocated. you should issue the +% \var{new(a,init)} statement. This will allocate space, and call the +% constructor of the class. +parser_w_no_new_dispose_on_void_pointers=03043_W_L'usage de NEW ou DISPOSE pour des pointeurs non typ‚s est sans signification meaningless +parser_e_no_new_dispose_on_void_pointers=03044_E_L'usage de NEW ou DISPOSE pour des pointeurs non typ‚s est sans signification meaningless +% You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer +% because no size is associated to an untyped pointer. +% Accepted for compatibility in \var{tp} and \vat{delphi} modes. +parser_e_class_id_expected=03045_E_Identificateur de classe attendu +% This happens when the compiler scans a procedure declaration that contains +% a dot, +% i.e., a object or class method, but the type in front of the dot is not +% a known type. +parser_e_no_type_not_allowed_here=03046_E_Identificateur de type interdit ici +% You cannot use a type inside an expression. +parser_e_methode_id_expected=03047_E_Identificateur de m‚thode attendu +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_e_header_dont_match_any_member=03048_E_La fonction ne correspond … aucune m‚thode de cette classe $1 +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_p_procedure_start=03049_P_proc‚dure/fonction $1 +% When using the \var{-vp} switch, the compiler tells you when it starts +% processing a procedure or function implementation. +parser_e_error_in_real=03050_E_Constante r‚elle ill‚gale +% The compiler expects a floating point expression, and gets something else. +parser_e_fail_only_in_constructor=03051_E_FAIL peut uniquement ˆtre utilis‚ dans un constructeur +% You are using the \var{FAIL} instruction outside a constructor method. +parser_e_no_paras_for_destructor=03052_E_Les destructeurs ne peuvent avoir de paramŠtres +% You are declaring a destructor with a parameter list. Destructor methods +% cannot have parameters. +parser_e_only_class_methods_via_class_ref=03053_E_Seules des m‚thodes de classes peuvent ˆtre r‚f‚r‚ avec des r‚f‚rences de classes +% This error occurs in a situation like the following: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} is not a class method and hence cannot be called with a class +% reference. +parser_e_only_class_methods=03054_E_Seuls des m‚thodes de classes peuvent ˆtre appel‚s dans une m‚thode de classe +% This is related to the previous error. You cannot call a method of an object +% from a inside a class method. The following code would produce this error: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% Because free is a normal method of a class it cannot be called from a class +% method. +parser_e_case_mismatch=03055_E_La constante et le type de CASE ne conserpodnet pas +% One of the labels is not of the same type as the case variable. +parser_e_illegal_symbol_exported=03056_E_Le symbole ne peut ˆtre export‚ d'une librairie +% You can only export procedures and functions when you write a library. You +% cannot export variables or constants. +parser_w_should_use_override=03057_W_Une m‚thode h‚rit‚e est cach‚e par $1 +% A method that is declared \var{virtual} in a parent class, should be +% overridden in the descendent class with the \var{override} directive. If you +% don't specify the \var{override} directive, you will hide the parent method; +% you will not override it. +parser_e_nothing_to_be_overridden=03058_E_Il n'y a pas de m‚thode dans l'ancˆtre que l'on peut surcharger : $1 +% You try to \var{override} a virtual method of a parent class that doesn't +% exist. +parser_e_no_procedure_to_access_property=03059_E_Il manque un champ pour sp‚cifier l'accŠss … la property +% You specified no \var{read} directive for a property. +parser_w_stored_not_implemented=03060_W_Directive de property Stored non implement‚e +% The \var{stored} directive is not yet implemented +parser_e_ill_property_access_sym=03061_E_Symbole ill‚gal pour accŠs … la property +% There is an error in the \var{read} or \var{write} directives for an array +% property. When you declare an array property, you can only access it with +% procedures and functions. The following code woud cause such an error. +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_Impossible d'acc‚der … un champ "protected" d'un object ici +% Fields that are declared in a \var{protected} section of an object or class +% declaration cannot be accessed outside the module wher the object is +% defined, or outside descendent object methods. +parser_e_cant_access_private_member=03063_E_Impossible d'acc‚der … un champ "private" d'un object ici +% Fields that are declared in a \var{private} section of an object or class +% declaration cannot be accessed outside the module where the class is +% defined. +parser_w_overloaded_are_not_both_virtual=03064_W_M‚thode surchargeant une m‚thode virtuelle devrait ˆtre virtuelle : $1 +% If you declare overloaded methods in a class, then they should either all be +% virtual, or none. You shouldn't mix them. +parser_w_overloaded_are_not_both_non_virtual=03065_W_M‚thode surchargeant une m‚thode non virtuelle devrait ˆtre non virtuelle : $1 +% If you declare overloaded methods in a class, then they should either all be +% virtual, or none. You shouldn't mix them. +parser_e_overloaded_methodes_not_same_ret=03066_E_M‚thodes virtuelles surcharg‚es doivent avoir le mˆme type r‚sultat : $1 +% If you declare virtual overloaded methods in a class definition, they must +% have the same return type. +parser_e_dont_nest_export=03067_E_Des fonctions d‚clar‚es comme EXPORT ne peuvent ˆtre locales +% You cannot declare a function or procedure within a function or procedure +% that was declared as an export procedure. +parser_e_methods_dont_be_export=03068_E_Les m‚thodes ne peuvent pas ˆtre EXPORT‚es +% You cannot declare a procedure that is a method for an object as +% \var{export}ed. That is, your methods cannot be called from a C program. +parser_e_call_by_ref_without_typeconv=03069_E_Un appel avec paramŠtre par variable doivent ˆtre du type exact de la d‚claration +% When calling a function declared with \var{var} parameters, the variables in +% the function call must be of exactly the same type. There is no automatic +% type conversion. +parser_e_no_super_class=03070_E_Cette classe n'est pas un paarent de la classe actuelle +% When calling inherited methods, you are trying to call a method of a strange +% class. You can only call an inherited method of a parent class. +parser_e_self_not_in_method=03071_E_SELF est seulement possible dans les m‚thodes +% You are trying to use the \var{self} parameter outside an object's method. +% Only methods get passed the \var{self} parameters. +parser_e_generic_methods_only_in_methods=03072_E_Les m‚thodes ne peuvent ˆtre appel‚s avec un type qu'… l'int‚rieur d'une m‚thode +% A construction like \var{sometype.somemethod} is only allowed in a method. +parser_e_illegal_colon_qualifier=03073_E_Utilisation non valide de ':' +% You are using the format \var{:} (colon) 2 times on an expression that +% is not a real expression. +parser_e_illegal_set_expr=03074_E_Erreur d'intervalle ou ‚l‚ment dupliqu‚ dans un constructeur d'ensemble +% The declaration of a set contains an error. Either one of the elements is +% outside the range of the set type, either two of the elements are in fact +% the same. +parser_e_pointer_to_class_expected=03075_E_Pointeur d'object attendu +% You specified an illegal type in a \var{New} statement. +% The extended synax of \var{New} needs an object as a parameter. +parser_e_expr_have_to_be_constructor_call=03076_E_Expression doit ˆtre un appel … un constructeur +% When using the extended syntax of \var{new}, you must specify the constructor +% method of the object you are trying to create. The procedure you specified +% is not a constructor. +parser_e_expr_have_to_be_destructor_call=03077_E_Expression doit ˆtre un appel … un destructeur +% When using the extended syntax of \var{dispose}, you must specify the +% destructor method of the object you are trying to dispose of. +% The procedure you specified is not a destructor. +parser_e_invalid_record_const=03078_E_Mauvais ordre des ‚l‚ments d'un record +% When declaring a constant record, you specified the fields in the wrong +% order. +parser_e_false_with_expr=03079_E_L'expression doit ˆtre de type record ou objet +% A \var{with} statement needs an argument that is of the type \var{record} +% or \var{class}. You are using \var{with} on an expression that is not of +% this type. +parser_e_void_function=03080_E_Les proc‚dures ne peuvent retourner une valeur +% In \fpc, you can specify a return value for a function when using +% the \var{exit} statement. This error occurs when you try to do this with a +% procedure. Procedures cannot return a value. +parser_e_only_methods_allowed=03081_E_Les constructeurs, destructeurs et class operators doivent ˆtre des m‚thodes +% You're declaring a procedure as destructor, constructor or class operator, when the +% procedure isn't a class method. +parser_e_operator_not_overloaded=03082_E_Operator n'est pas surcharg‚ +% You're trying to use an overloaded operator when it isn't overloaded for +% this type. +parser_e_no_such_assignment=03083_E_Impossible de surcharger l'assignement pour des types ‚gaux +% You can not overload assignment for types +% that the compiler considers as equal. +parser_e_overload_impossible=03084_E_Impossible operator overload +% The combination of operator, arguments and return type are +% incompatible. +parser_e_no_reraise_possible=03085_E_Re-raise impossible ici +% You are trying to raise an exception where it isn't allowed. You can only +% raise exceptions in an \var{except} block. +parser_e_no_new_or_dispose_for_classes=03086_E_La syntaxe ‚tendue de new ou dispose n'est pas valide pour une classe +% You cannot generate an instance of a class with the extended syntax of +% \var{new}. The constructor must be used for that. For the same reason, you +% cannot call \var{Dispose} to de-allocate an instance of a class, the +% destructor must be used for that. +parser_e_asm_incomp_with_function_return=03087_E_Directive "Assembler" incompatible avec le type de la fonction +% You're trying to implement a \var{assembler} function, but the return type +% of the function doesn't allow that. +parser_e_procedure_overloading_is_off=03088_E_L'overloading de proc‚dure est d‚sactiv‚ +% When using the \var{-So} switch, procedure overloading is switched off. +% Turbo Pascal does not support function overloading. +parser_e_overload_operator_failed=03089_E_Impossible de red‚finir cet op‚rateur +% You are trying to overload an operator which cannot be overloaded. +% The following operators can be overloaded : +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_Un op‚ratuer de comparaison doit retourner une valeur bool‚enne +% When overloading the \var{=} operator, the function must return a boolean +% value. +parser_e_only_virtual_methods_abstract=03091_E_Seule une m‚thode virtuelle peut ˆtre abstraite +% You are declaring a method as abstract, when it isn't declared to be +% virtual. +parser_f_unsupported_feature=03092_F_Utilisation d'une caract‚ristique non support‚e ! +% You're trying to force the compiler into doing something it cannot do yet. +parser_e_mix_of_classes_and_objects=03093_E_Il est interdit de m‚langer des objets et des classes +% You cannot derive \var{objects} and \var{classes} intertwined . That is, +% a class cannot have an object as parent and vice versa. +parser_w_unknown_proc_directive_ignored=03094_W_Directive de proc‚dure non reconnue a due ˆtre ignor‚e : $1 +% The procedure direcive you secified is unknown. Recognised procedure +% directives are \var{cdecl}, \var{stdcall}, \var{popstack}, \var{pascal} +% \var{register}, \var{export}. +parser_e_absolute_only_one_var=03095_E_absolute put seulement ˆtre associ‚ … une seule variable +% You cannot specify more than one variable before the \var{absolute} directive. +% Thus, the following construct will provide this error: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +% \item [ absolute can only be associated a var or const ] +% The address of a \var{absolute} directive can only point to a variable or +% constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_absolute_only_to_var_or_const=03096_E_absolute peut seulement ˆtre associ‚ … une variable ou une constante +% The address of a \var{absolute} directive can only point to a variable or +% constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_initialized_only_one_var=03097_E_Seule UNE variable peut ˆtre initialis‚e +% You cannot specify more than one variable with a initial value +% in Delphi syntax. +parser_e_abstract_no_definition=03098_E_Les m‚thodes "Abstract" ne peuvent pas avoir d'implementation +% Abstract methods can only be declared, you cannot implement them. They +% should be overridden by a descendant class. +parser_e_overloaded_must_be_all_global=03099_E_Cette fonction surcharg‚e ne peut ˆtre locale (doit ˆtre export‚e) +% You are defining a overloaded function in the implementation part of a unit, +% but there is no corresponding declaration in the interface part of the unit. +parser_w_virtual_without_constructor=03100_W_Des m‚thodes virtuelles sont utilis‚es sans constructeur pour $1 +% If you declare objects or classes that contain virtual methods, you need +% to have a constructor and destructor to initialize them. The compiler +% encountered an object or class with virtual methods that doesn't have +% a constructor/destructor pair. +parser_m_macro_defined=03101_M_Macro d‚finie : $1 +% When \var{-vm} is used, the compiler tells you when it defines macros. +parser_m_macro_undefined=03102_M_Macro non d‚finie : $1 +% When \var{-vm} is used, the compiler tells you when it undefines macros. +parser_m_macro_set_to=03103_M_Macro $1 … pour valeur $2 +% When \var{-vm} is used, the compiler tells you what values macros get. +parser_i_compiling=03104_I_Compilation de $1 +% When you turn on information messages (\var{-vi}), the compiler tells you +% what units it is recompiling. +parser_u_parsing_interface=03105_U_Lecture de l'interface de l'unit‚ $1 +% This tells you that the reading of the interface +% of the current unit starts +parser_u_parsing_implementation=03106_U_Lecture de l'implementation de $1 +% This tells you that the code reading of the implementation +% of the current unit, library or program starts +parser_d_compiling_second_time=03107_D_Compilation de $1 pour la seconde fois +% When you request debug messages (\var{-vd}) the compiler tells you what +% units it recompiles for the second time. +parser_e_no_paras_allowed=03108_E_Les propri‚t‚s vecteurs ne sont pas accept‚es ici +% You cannot use array properties at that point. +parser_e_no_property_found_to_override=03109_E_Aucune propri‚t‚ trouv‚e pour override +% You want to overrride a property of a parent class, when there is, in fact, +% no such property in the parent class. +parser_e_only_one_default_property=03110_E_Seule une propri‚t‚ pard‚faut autoris‚e, il y en a une dans la classe $1 +% You specified a property as \var{Default}, but a parent class already has a +% default property, and a class can have only one default property. +parser_e_property_need_paras=03111_E_La propri‚t‚ par d‚faut doit ˆtre une propri‚t‚ vecteur +% Only array properties of classes can be made \var{default} properties. +parser_e_constructor_cannot_be_not_virtual=03112_E_Les constructeurs virtuels sont seulement possible pour les classes +% You cannot have virtual constructors in objects. You can only have them +% in classes. +parser_e_no_default_property_available=03113_E_Pas de propri‚t‚ par d‚faut +% You try to access a default property of a class, but this class (or one of +% its ancestors) doesn't have a default property. +parser_e_cant_have_published=03114_E_PUBLISHED non autoris‚ ici pour des classes, utilisez {$M+} +% If you want a \var{published} section in a class definition, you must +% use the \var{\{\$M+\}} switch, whch turns on generation of type +% information. +parser_e_forward_declaration_must_be_resolved=03115_E_La d‚claration anticip‚e de la classe $1 doit ˆtre r‚solue ici pour pouvoir ˆtreparent +% To be able to use an object as an ancestor object, it must be defined +% first. This error occurs in the following situation: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% Where \var{ParentClass} is declared but not defined. +parser_e_no_local_operator=03116_E_Les op‚rateurs ne peuvent ˆtre locaux +% You cannot overload locally, i.e. inside procedures or function +% definitions. +parser_e_proc_dir_not_allowed_in_interface=03117_E_La directive de proc‚dure $1 n'est pas autoris‚e en interface +% This procedure directive is not allowed in the \var{interface} section of +% a unit. You can only use it in the \var{implementation} section. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_La directive de proc‚dure $1 n'est pas autoris‚e en impl‚mentation +% This procedure directive is not defined in the \var{implementation} section of +% a unit. You can only use it in the \var{interface} section. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_La directive de proc‚dure n'est pas valide pour une variable +% This procedure directive cannot be part of a procedural of function +% type declaration. +parser_e_function_already_declared_public_forward=03120_E_La fonction $1 est d‚j… d‚clar‚e comme publique ou forward +% You will get this error if a function is defined as \var{forward} twice. +% Or it is once in the \var{interface} section, and once as a \var{forward} +% declaration in the \var{implmentation} section. +parser_e_not_external_and_export=03121_E_EXPORT et EXTERNAL sont incompatibles +% These two procedure directives are mutually exclusive +parser_e_name_keyword_expected=03122_E_Le mot r‚serv‚ NAME est requis ici +% The definition of an external variable needs a \var{name} clause. +parser_w_not_supported_for_inline=03123_W_$1 n'est pas support‚ pour des fonctions INLINE +% Inline procedures don't support this declaration. +parser_w_inlining_disabled=03124_W_Inlining d‚sactiv‚ +% Inlining of procedures is disabled. +parser_i_writing_browser_log=03125_I_Ecriture du Browser log $1 +% When information messages are on, the compiler warns you when it +% writes the browser log (generated with the \var{\{\$Y+ \}} switch). +parser_h_maybe_deref_caret_missing=03126_H_le d‚r‚f‚rencement du pointeur semble manquer +% The compiler thinks that a pointer may need a dereference. +parser_f_assembler_reader_not_supported=03127_F_Lecteur de code assembleur non support‚ +% The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not +% supported. The compiler can be compiled with or without support for a +% particular assembler reader. +parser_e_proc_dir_conflict=03128_E_La directive de proc‚dure $1 est en conflit avec d'autres directives +% You specified a procedure directive that conflicts with other directives. +% for instance \var{cdecl} and \var{pascal} are mutually exclusive. +parser_e_call_convention_dont_match_forward=03129_E_La convention d'appel ne correspond pas … la fonction pr‚d‚finie +% This error happens when you declare a function or procedure with +% e.g. \var{cdecl;} but omit this directive in the implementation, or vice +% versa. The calling convention is part of the function declaration, and +% must be repeated in the function definition. +parser_e_register_calling_not_supported=03130_E_Appel avec registres (fastcall) non support‚ +% The \var{register} calling convention, i.e., arguments are passed in +% registers instead of on the stack is not supported. Arguments are always +% passed on the stack. +parser_e_property_cant_have_a_default_value=03131_E_Cette propri‚t‚ ne peut avoir de valeur par d‚faut +% Set properties or indexed properties cannot have a default value. +parser_e_property_default_value_must_const=03132_E_La valeur par d‚faut d'une propri‚t‚ doit ˆtre une constante +% The value of a \var{default} declared property must be knwon at compile +% time. The value you specified is only known at run time. This happens +% .e.g. if you specify a variable name as a default value. +parser_e_cant_publish_that=03133_E_Ce symbole n'est pas une classe et ne peut donc pas ˆtre PUBLISHED +% Only class type variables can be in a \var{published} section of a class +% if they are not declared as a property. +parser_e_cant_publish_that_property=03134_E_Ce genre de propri‚t‚ ne peut ˆtre PUBLISHED +% Properties in a \var{published} section cannot be array properties. +% they must be moved to public sections. Properties in a \var{published} +% section must be an ordinal type, a real type, strings or sets. +parser_w_empty_import_name=03135_W_Nom d'importation vide +% Both index and name for the import are 0 or empty +parser_e_empty_import_name=03136_W_Empty import name specified +% Some targets need a name for the imported procedure or a cdecl specifier +parser_e_used_proc_name_changed=03137_E_Le nom interne de la fonction … chang‚ aprŠs son usage +% This is an internal error; please report any occurrences of this error +% to the \fpc team. +parser_e_division_by_zero=03138_E_Division par z‚ro +% There is a divsion by zero encounted +parser_e_invalid_float_operation=03139_E_Op‚ration en virgule flottatne invalide +% An operation on two real type values produced an overflow or a division +% by zero. +parser_e_array_lower_less_than_upper_bound=03140_E_Limite sup‚rieure inf‚rieure … la limite inf‚rieure d'un intervalle +% The upper bound of a \var{case} label is less than the lower bound and this +% is not possible +parser_w_string_too_long=03141_W_String "$1" est plus long que $2 +% The size of the constant string is larger than the size you specified in +% string type definition +parser_e_string_larger_array=03142_E_longueur du String sup‚rieure … la longueur du CHAR ARRAY +% The size of the constant string is larger than the size you specified in +% the array[x..y] of char definition +parser_e_ill_msg_expr=03143_E_Expression invalide aprŠs directive MESSAGE +% \fpc supports only integer or string values as message constants +parser_e_ill_msg_param=03144_E_MESSAGE handler peuvent seulement accepter un paramŠtre par r‚f‚rence +% A method declared with the \var{message}-directive as message handler +% can take only one parameter which must be declared as call by reference +% Parameters are declared as call by reference using the \var{var}-directive +parser_e_duplicate_message_label=03145_E_Duplicate message label: %1 +% A label for a message is used twice in one object/class +parser_e_self_in_non_message_handler=03146_E_SELF ne peut ˆtre un paramŠtre explicite que dans les MESSAGE handlers +% The self parameter can be passed only explicit if it is a method which +% is declared as message method handler +parser_e_threadvars_only_sg=03147_E_THREADVARS peuvent seulement ˆtre statiques ou globaux +% Threadvars must be static or global, you can't declare a thread +% local to a procedure. Local variables are always local to a thread, +% because every thread has its own stack and local variables +% are stored on the stack +parser_f_direct_assembler_not_allowed=03148_F_Assembleur direct non support‚ pour la sortie binaire +% You can't use direct assembler when using a binary writer, choose an +% other outputformat or use another assembler reader +parser_w_no_objpas_use_mode=03149_W_Ne chargez pas l'unit‚ OBJPAS manuellement, utilisez {$mode objfpc} ou {$mode delphi} +% You're trying to load the ObjPas unit manual from a uses clause. This is +% not a good idea to do, you can better use the {$mode objfpc} or {$mode delphi} +% directives which load the unit automatically +parser_e_no_object_override=03150_E_OVERRIDE nepeut ˆtre utilis‚ pour des objets +% Override isn't support for objects, use VIRTUAL instead to override +% a method of an anchestor object +% \end{description} +# +# Type Checking +# +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +parser_e_cant_use_inittable_here=03151_E_Les types de donn‚es n‚cessitant des initialisations ne peuvent faire partie de RECORD variables +% Some data type (e.g. \var{ansistring}) needs initialization/finalization +% code which is implicitly generated by the compiler. Such data types +% can't be used in the variant part of a record. +parser_e_resourcestring_only_sg=03152_E_RESOURCESTRINGS doivent ˆtre statiques ou globaux +% Resourcestring can not be declared local, only global or using the static +% directive. +parser_e_exit_with_argument_not__possible=03153_E_Exit avec un argument ne peut ˆtre utilis‚ ici +% an exit statement with an argument for the return value can't be used here, this +% can happen e.g. in \var{try..except} or \var{try..finally} blocks +parser_e_stored_property_must_be_boolean=03154_E_Le type du symbole STORED doit ˆtre un bool‚en +% If you specify a storage symbol in a property declaration, it must be of +% the type boolean +parser_e_ill_property_storage_sym=03155_E_Ce symbole n'est pas admis comme symbole STORED +% You can't use this type of symbol as storage specifier in property +% declaration. You can use only methods with the result type boolean, +% boolean class fields or boolean constants +parser_e_only_publishable_classes_can__be_published=03156_E_Selues les classes compil‚es en mode $M+ peuvent ˆtre PUBLISHED +% In the published section of a class can be only class as fields used which +% are compiled in $M+ or which are derived from such a class. Normally +% such a class should be derived from TPersitent +parser_e_proc_directive_expected=03157_E_Directive de proc‚dure attendue +% When declaring a procedure in a const block you used a ; after the +% procedure declaration after which a procedure directive must follow. +% Correct declarations are: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_Le type d'un index de propri‚t‚ doit ˆtre un type ordinal +% The value you use to index a property must be of an ordinal type, for +% example an integer or enumerated type. +parser_e_procname_to_short_for_export=03159_E_Nom de proc‚dure trop court pour ˆtre exprot‚ +% The length of the procedure/function name must be at least 2 characters +% long. This is because of a bug in dlltool which doesn't parse the .def +% file correct with a name of length 1. +parser_e_dlltool_unit_var_problem=03160_E_Impossible de cr‚er une entr‚e DEFFILE pour des variables globales d'unit‚s +parser_e_dlltool_unit_var_problem2=03161_E_Compilez sans l'option -WD +% \end{description} +# +# Type Checking +# +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +type_e_mismatch=04000_E_Incompatibilit‚ de types +% This can happen in many cases: +% \begin{itemize} +% \item The variable you're assigning to is of a different type than the +% expression in the assignment. +% \item You are calling a function or procedure with parameters that are +% incompatible with the parameters in the function or procedure definition. +% \end{itemize} +type_e_incompatible_types=04001_E_Incompatible types: got $1 expected $2 +% There is no conversion possible between the two types +type_e_not_equal_types=04002_E_Incompatibilit‚ de types entre $1 et $2 +% The types are not equal +type_e_type_id_expected=04003_E_Identificateur de type attendu +% The identifier is not a type, or you forgot to supply a type identifier. +type_e_variable_id_expected=04004_E_Identificateur de variable attendu +% This happens when you pass a constant to a \var{Inc} var or \var{Dec} +% procedure. You can only pass variables as arguments to these functions. +type_e_integer_expr_expected=04005_E_Integer expression expected +% The compiler expects an expression of type integer, but gets a different +% type. +type_e_boolean_expr_expected=04006_E_Expression bool‚enne attendue, mais "$1" obtenu +% The expression must be a boolean type, it should be return true or +% false. +type_e_ordinal_expr_expected=04007_E_Expression ordinale attendue +% The expression must be of ordinal type, i.e., maximum a \var{Longint}. +% This happens, for instance, when you specify a second argument +% to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value. +type_e_pointer_type_expected=04008_E_Type pointeur attendu +% The variable or expression isn't of the type \var{pointer}. This +% happens when you pass a variable that isn't a pointer to \var{New} +% or \var{Dispose}. +type_e_class_type_expected=04009_E_Type classe attendu +% The variable of expression isn't of the type \var{class}. This happens +% typically when +% \begin{enumerate} +% \item The parent class in a class declaration isn't a class. +% \item An exception handler (\var{On}) contains a type identifier that +% isn't a class. +% \end{enumerate} +type_e_varid_or_typeid_expected=04010_E_Identificateur de variable ou de type attendu +% The argument to the \var{High} or \var{Low} function is not a variable +% nor a type identifier. +type_e_cant_eval_constant_expr=04011_E_Impossible d'‚valuer l'expression constante +% No longer in use. +type_e_set_element_are_not_comp=04012_E_Elements d'ensembles non compatibles +% You are trying to make an operation on two sets, when the set element types +% are not the same. The base type of a set must be the same when taking the +% union +type_e_set_operation_unknown=04013_E_Op‚ration non permise pour des ensembles +% several binary operations are not defined for sets +% like div mod ** (also >= <= for now) +type_w_convert_real_2_comp=04014_W_Conversion automatique de r‚el vers COMP qui est un type entier +% An implicit type conversion from a real type to a \var{comp} is +% encountered. Since \var{Comp} is a 64 bit integer type, this may indicate +% an error. +type_h_use_div_for_int=04015_H_Utilisez DIV pour obtenir un r‚sultat entier +% When hints are on, then an integer division with the '/' operator will +% procuce this message, because the result will then be of type real +type_e_strict_var_string_violation=04016_E_Types string incompatibles, … cause du mode $V+ +% When compiling in \var{\{\$V+ \}} mode, the string you pass as a parameter +% should be of the exact same type as the declared parameter of the procedure. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_succ ou pred impossible pour des ‚num‚rations avec valeurs fix‚es +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use the \var{Succ} or \var{Pred} functions on them. +type_e_cant_read_write_type=04018_E_Impossible de lire ou d'‚crire des variables de ce type +% You are trying to \var{read} or \var{write} a variable from or to a +% file of type text, which doesn't support that. Only integer types, +% booleans, reals, pchars and strings can be read from/written to a text file. +type_e_no_readln_writeln_for_typed_file=04019_E_Impossible d'utiliser READLN ou WRITELN pour un ficher typ‚ +% \var{readln} and \var{writeln} are only allowed for text files. +type_e_no_read_write_for_untyped_file=04020_E_Impossible d'utiliser READ ou WRITE pour un FILE non typ‚ +% \var{read} and \var{write} are only allowed for text or typed files. +type_e_typeconflict_in_set=04021_E_Confit de type pour des ‚l‚ments d'un ensemble +% There is at least one set element which is of the wrong type, i.e. not of +% the set type. +type_w_maybe_wrong_hi_lo=04022_W_lo/hi(longint/dword) retourne le word bas/haut +% \fpc supports an overloaded version of \var{lo/hi} for \var{longint/dword} +% which returns the lower/upper word of the argument. TP always uses +% a 16 bit \var{lo/hi} which returns always bits 0..7 for \var{lo} and the +% bits 8..15 for \var{hi}. If you want the TP behavior you have +% to type case the argument to \var{word/integer} +type_e_integer_or_real_expr_expected=04023_E_Expression entiŠre ou r‚elle attendue +% The first argument to \var{str} must a real or integer type. +type_e_wrong_type_in_array_constructor=04024_E_Mauvais type dans array constructor +% You are trying to use a type in an array constructor which is not +% allowed. +type_e_wrong_parameter_type=04025_E_Type incompatible type pour arg #$1: $2 au lieu de $3 +% You are trying to pass an invalid type for the specified parameter. +% \end{description} +type_e_no_method_and_procedure_not_compatible=04026_E_Method (variable) et Procedure (variable) sont incompatibles +% You can't assign a method to a procedure variable or a procedure to a +% method pointer. +type_e_wrong_math_argument=04027_E_Constante invalide pass‚e … une fonction math‚matique interne +% The constant argument passed to a ln or sqrt function is out of +% the definition range of these functions. +type_e_no_addr_of_constant=04028_E_Impossible d'obtenir l'adresse d'une constante +% It's not possible to get the address of a constant, because they +% aren't stored in memory, you can try making it a typed constant. +% \end{description} +# +# Symtable +# +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedure and variable names. +% \begin{description} +# +# Symtable +# +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedure and variable names. +% \begin{description} +type_e_argument_cant_be_assigned=04029_E_Impossible d'assigner une valeur … l'argument +% Only expressions which can be on the left side of an +% assignment can be passed as call by reference argument +% Remark: Properties can be only +% used on the left side of an assignment, but they can't be used as arguments +type_e_cannot_local_proc_to_procvar=04030_E_Impossible d'assigner une fonction ou proc‚dure locale … une variable de proc‚dure +% It's not allowed to assign a local procedure/function to a +% procedure variable, because the calling of local procedure/function is +% different. You can only assign local procedure/function to a void pointer. +type_e_no_assign_to_addr=04031_E_Can't assign values to an address +% It's not allowed to assign a value to an address of a variable,constant, +% procedure or function. You can try compiling with -So if the identifier +% is a procedure variable. +type_e_no_assign_to_const=04032_E_Can't assign values to const variable +% It's not allowed to assign a value to a variable which is declared +% as a const. This is normally a parameter declared as const, to allow +% changing make the parameter value or var. +% \end{description} +# +# Symtable +# +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedure and variable names. +% \begin{description} +sym_e_id_not_found=05000_E_Identificateur non trouv‚ $1 +% The compiler doesn't know this symbol. Usually happens when you misspel +% the name of a variable or procedure, or when you forgot to declare a +% variable. +sym_f_internal_error_in_symtablestack=05001_F_Internal Error in SymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_Duplicate identifier $1 +% The identifier was already declared in the current scope. +sym_h_duplicate_id_where=05003_H_Identifier already defined in $1 at line $2 +% The identifier was already declared in a previous scope. +sym_e_unknown_id=05004_E_Unknown identifier $1 +% The identifier encountered hasn't been declared, or is used outside the +% scope where it's defined. +sym_e_forward_not_resolved=05005_E_Forward declaration not solved $1 +% This can happen in two cases: +% \begin{itemize} +% \item This happens when you declare a function (in the \var{interface} part, or +% with a \var{forward} directive, but do not implement it. +% \item You reference a type which isn't declared in the current \var{type} +% block. +% \end{itemize} +sym_f_id_already_typed=05006_F_Identifier type already defined as type +% You are trying to redefine a type. +sym_e_error_in_type_def=05007_E_Error in type definition +% There is an error in your definition of a new array type: +% \item One of the range delimiters in an array declaration is erroneous. +% For example, \var{Array [1..1.25]} will trigger this error. +sym_e_type_id_not_defined=05008_E_Type identifier not defined +% The type identifier has not been defined yet. +sym_e_forward_type_not_resolved=05009_E_Forward type not resolved $1 +% The compiler encountered an unknown type. +sym_e_only_static_in_static=05010_E_Only static variables can be used in static methods or outside methods +% A static method of an object can only access static variables. +sym_e_invalid_call_tvarsymmangledname=05011_E_Invalid call to tvarsym.mangledname() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_f_type_must_be_rec_or_class=05012_F_record or class type expected +% The variable or expression isn't of the type \var{record} or \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_Instances of classes or objects with an abstract method are not allowed +% You are trying to generate an instance of a class which has an abstract +% method that wasn't overridden. +sym_w_label_not_defined=05014_W_Label not defined $1 +% A label was declared, but not defined. +sym_e_label_used_and_not_defined=05015_E_Label used but not defined $1 +% A label was declared and used, but not defined. +sym_e_ill_label_decl=05016_E_Illegal label declaration +% This error should never happen; it occurs if a label is defined outside a +% procedure or function. +sym_e_goto_and_label_not_supported=05017_E_GOTO und LABEL are not supported (use switch -Sg) +% You must compile a program which has \var{label}s and \var{goto} statements +% with the \var{-Sg} switch. By default, \var{label} and \var{goto} aren't +% supported. +sym_e_label_not_found=05018_E_Label not found +% A \var{goto label} was encountered, but the label isn't declared. +sym_e_id_is_no_label_id=05019_E_identifier isn't a label +% The identifier specified after the \var{goto} isn't of type label. +sym_e_label_already_defined=05020_E_label already defined +% You are defining a label twice. You can define a label only once. +sym_e_ill_type_decl_set=05021_E_illegal type declaration of set elements +% The declaration of a set contains an invalid type definition. +sym_e_class_forward_not_resolved=05022_E_Forward class definition not resolved $1 +% You declared a class, but you didn't implement it. +sym_n_unit_not_used=05023_H_Unit $1 not used in $2 +% The unit referenced in the \var{uses} clause is not used. +sym_h_para_identifier_not_used=05024_H_Parameter not used $1 +% This is a warning. The identifier was declared (locally or globally) but +% wasn't used (locally or globally). +sym_n_local_identifier_not_used=05025_N_Local variable not used $1 +% You have declared, but not used a variable in a procedure or function +% implementation. +sym_h_para_identifier_only_set=05026_H_Value parameter $1 is assigned but never used +% This is a warning. The identifier was declared (locally or globally) +% set but not used (locally or globally). +sym_n_local_identifier_only_set=05027_N_Local variable $1 is assigned but never used +% The variable in a procedure or function +% implementation is declared, set but never used. +sym_h_local_symbol_not_used=05028_H_Local $1 $2 is not used +% A local symbol is never used. +sym_n_private_identifier_not_used=05029_N_Private field $1.$2 is never used +sym_n_private_identifier_only_set=05030_N_Private field $1.$2 is assigned but never used +sym_n_private_method_not_used=05031_N_Private method $1.$2 never used + +sym_e_set_expected=05032_E_Set type expected +% The variable or expression isn't of type \var{set}. This happens in an +% \var{in} statement. +sym_w_function_result_not_set=05033_W_Function result does not seem to be set +% You can get this warning if the compiler thinks that a function return +% value is not set. This will not be displayed for assembler procedures, +% or procedures that contain assembler blocks. +sym_w_wrong_C_pack=05034_W_Type $1 is not aligned correctly in current record for C +% Arrays with sizes not multiples of 4 will be wrongly aligned +% for C structures. +sym_e_illegal_field=05035_E_Unknown record field identifier $1 +% The field doesn't exist in the record definition. +sym_n_uninitialized_local_variable=05036_W_Local variable $1 does not seem to be initialized +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% wasn't initialized first (i.e. appeared in the right-hand side of an +% assigment) +sym_n_uninitialized_variable=05037_W_Variable $1 does not seem to be initialized +% These messages are displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% wasn't initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_e_id_no_member=05038_E_identifier idents no member $1 +% When using the extended syntax of \var{new}, you must specify the constructor +% method of the class you are trying to create. The procedure you specified +% does not exist. +sym_b_param_list=05039_B_Found declaration: $1 +% You get this when you use the \var{-vb} switch. In case an overloaded +% procedure is not found, then all candidate overloaded procedures are +% listed, with their parameter lists. +% \end{description} +# +# Codegenerator +# +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +sym_e_segment_too_large=05040_E_Data segment too large (max. 2GB) +% You get this when you declare an array whose size exceeds the 2GB limit. +% \end{description} +# +# Codegenerator +# +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +cg_e_break_not_allowed=06000_E_BREAK not allowed +% You're trying to use \var{break} outside a loop construction. +cg_e_continue_not_allowed=06001_E_CONTINUE not allowed +% You're trying to use \var{continue} outside a loop construction. +cg_e_too_complex_expr=06002_E_Expression too complicated - FPU stack overflow +% Your expression is too long for the compiler. You should try dividing the +% construct over multiple assignments. +cg_e_illegal_expression=06003_E_Illegal expression +% This can occur under many circumstances. Mostly when trying to evaluate +% constant expressions. +cg_e_invalid_integer=06004_E_Invalid integer expression +% You made an expression which isn't an integer, and the compiler expects the +% result to be an integer. +cg_e_invalid_qualifier=06005_E_Illegal qualifier +% One of the following is happening : +% \begin{itemize} +% \item You're trying to access a field of a variable that is not a record. +% \item You're indexing a variable that is not an array. +% \item You're dereferencing a variable that is not a pointer. +% \end{itemize} +cg_e_upper_lower_than_lower=06006_E_High range limit < low range limit +% You are declaring a subrange, and the lower limit is higher than the high +% limit of the range. +cg_e_illegal_count_var=06007_E_Illegal counter variable +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +cg_e_cant_choose_overload_function=06008_E_Can't determine which overloaded function to call +% You're calling overloaded functions with a parameter that doesn't correspond +% to any of the declared function parameter lists. e.g. when you have declared +% a function with parameters \var{word} and \var{longint}, and then you call +% it with a parameter which is of type \var{integer}. +cg_e_parasize_too_big=06009_E_Parameter list size exceeds 65535 bytes +% The I386 processor limits the parameter list to 65535 bytes (the \var{RET} +% instruction causes this) +cg_e_illegal_type_conversion=06010_E_Illegal type conversion +% When doing a type-cast, you must take care that the sizes of the variable and +% the destination type are the same. +cg_d_pointer_to_longint_conv_not_portable=06011_D_Conversion between ordinals and pointers is not portable across platforms +% If you typecast a pointer to a longint, this code will not compile +% on a machine using 64bit for pointer storage. +cg_e_file_must_call_by_reference=06012_E_File types must be var parameters +% You cannot specify files as value parameters, i.e. they must always be +% declared \var{var} parameters. +cg_e_cant_use_far_pointer_there=06013_E_The use of a far pointer isn't allowed there +% Free Pascal doesn't support far pointers, so you cannot take the address of +% an expression which has a far reference as a result. The \var{mem} construct +% has a far reference as a result, so the following code will produce this +% error: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_var_must_be_reference=06014_E_illegal call by reference parameters +% You are trying to pass a constant or an expression to a procedure that +% requires a \var{var} parameter. Only variables can be passed as a \var{var} +% parameter. +cg_e_dont_call_exported_direct=06015_E_EXPORT declared functions can't be called +% No longer in use. +cg_w_member_cd_call_from_method=06016_W_Possible illegal call of constructor or destructor (doesn't match to this context) +% No longer in use. +cg_n_inefficient_code=06017_N_Inefficient code +% You construction seems dubious to the compiler. +cg_w_unreachable_code=06018_W_unreachable code +% You specified a loop which will never be executed. Example: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_stackframe_with_esp=06019_E_procedure call with stackframe ESP/SP +% The compiler encountered a procedure or function call inside a +% procedure that uses a \var{ESP/SP} stackframe. Normally, when a call is +% done the procedure needs a \var{EBP} stackframe. +cg_e_cant_call_abstract_method=06020_E_Abstract methods can't be called directly +% You cannot call an abstract method directy, instead you must call a +% overriding child method, because an abstract method isn't implemented. +cg_f_internal_error_in_getfloatreg=06021_F_Internal Error in getfloatreg(), allocation failure +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +cg_f_unknown_float_type=06022_F_Unknown float type +% The compiler cannot determine the kind of float that occurs in an expression. +cg_f_secondvecn_base_defined_twice=06023_F_SecondVecn() base defined twice +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +cg_f_extended_cg68k_not_supported=06024_F_Extended cg68k not supported +% The var{extended} type is not supported on the m68k platform. +cg_f_32bit_not_supported_in_68000=06025_F_32-bit unsigned not supported in MC68000 mode +% The cardinal is not supported on the m68k platform. +cg_f_internal_error_in_secondinline=06026_F_Internal Error in secondinline() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +cg_d_register_weight=06027_D_Register $1 weight $2 $3 +% Debugging message. Shown when the compiler considers a variable for +% keeping in the registers. +cg_e_stacklimit_in_local_routine=06028_E_Stack limit excedeed in local routine +% Your code requires a too big stack. Some operating systems pose limits +% on the stack size. You should use less variables or try ro put large +% variables on the heap. +cg_d_stackframe_omited=06029_D_Stack frame is omitted +% Some procedure/functions do not need a complete stack-frame, so it is omitted. +% This message will be displayed when the {-vd} switch is used. +cg_w_64bit_range_check_not_supported=06030_W_Range check for 64 bit integers is not supported on this target +% 64 bit range check is not yet implemented for 32 bit processors. +cg_e_unable_inline_object_methods=06031_E_Object or class methods can't be inline. +% You cannot have inlined object methods. +cg_e_unable_inline_procvar=06032_E_Procvar calls can't be inline. +% A procedure with a procedural variable call cannot be inlined. +cg_e_no_code_for_inline_stored=06033_E_No code for inline procedure stored +% The compiler couldn't store code for the inline procedure. +cg_e_no_call_to_interrupt=06034_E_Direct call of interrupt procedure $1 is not possible +% You can not call an interrupt procedure directly from FPC code +cg_e_can_access_element_zero=06035_E_Element zero of an ansi/wide- or longstring can't be accessed, use (set)length instead +% You should use \var{setlength} to set the length of an ansi/wide/longstring +% and \var{length} to get the length of such kinf of string +cg_e_include_not_implemented=06036_E_Include and exclude not implemented in this case +% \var{include} and \var{exclude} are only partially +% implemented for \var{i386} processors +% and not at all for \var{m68k} processors. +cg_e_cannot_call_cons_dest_inside_with=06037_E_Constructors or destructors can not be called inside a 'with' clause +% Inside a \var{With} clause you cannot call a constructor or destructor for the +% object you have in the \var{with} clause. +cg_e_cannot_call_message_direct=06038_E_Cannot call message handler method directly +% A message method handler method can't be called directly if it contains an +% explicit self argument +% \end{description} +# EndOfTeX +# +# Assembler reader +# +cg_e_goto_inout_of_exception_block=06039_E_Jump in or outside of an exception block +% It isn't allowed to jump in or outside of an exception block like \var{try..finally..end;}: +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // this line will cause an error +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +% \end{description} +cg_e_control_flow_outside_finally=06040_E_Control flow statements aren't allowed in a finally block +% It isn't allowed to use the control flow statements \var{break}, +% \var{continue} and \var{exit} +% inside a finally statement. The following example shows the problem: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // This exit ISN'T allowed +% end; +% ... +% +% \end{verbatim} +% If the procedure \var{p} raises an exception the finally block is +% executed. If the execution reaches the exit, it's unclear what to do: +% exiting the procedure or searching for another exception handler +# EndOfTeX +asmr_d_start_reading=07000_D_Starting $1 styled assembler parsing +% This informs you that an assembler block is being parsed +asmr_d_finish_reading=07001_D_Finished $1 styled assembler parsing +% This informs you that an assembler block has finished. +asmr_e_none_label_contain_at=07002_E_Non-label pattern contains @ +% A identifier which isn't a label can't contain a @. +asmr_w_override_op_not_supported=07003_W_Override operator not supported +% The Override operator is not supported +asmr_e_building_record_offset=07004_E_Error building record offset +% There has an error occured while building the offset of a record/object +% structure, this can happend when there is no field specified at all or +% an unknown field identifier is used. +asmr_e_offset_without_identifier=07005_E_OFFSET used without identifier +% You can only use OFFSET with an identifier. Other syntaxes aren't +% supported +asmr_e_type_without_identifier=07006_E_TYPE utilis‚ sans identificateur +% You can only use TYPE with an identifier. Other syntaxes aren't +% supported +asmr_e_no_local_or_para_allowed=07007_E_Cannot use local variable or parameters here +% You can't use a local variable or parameter here, mostly because the +% addressing of locals and parameters is done using the %ebp register so the +% address can't be get directly. +asmr_e_need_offset=07008_E_need to use OFFSET here +% You need to use OFFSET <id> here to get the address of the identifier. +asmr_e_need_dollar=07009_E_need to use $ here +% You need to use $<id> here to get the address of the identifier. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_Cannot use multiple relocatable symbols +% You can't have more than one relocatable symbol (variable/typed constant) +% in one argument. +asmr_e_only_add_relocatable_symbol=07011_E_Relocatable symbol can only be added +% Relocatable symbols (variable/typed constant) can't be used with other +% operators. Only addition is allowed. +asmr_e_invalid_constant_expression=07012_E_Invalid constant expression +% There is an error in the constant expression. +asmr_e_relocatable_symbol_not_allowed=07013_E_Relocatable symbol is not allowed +% You can't use a relocatable symbol (variable/typed constant) here. +asmr_e_invalid_reference_syntax=07014_E_Invalid reference syntax +% There is an error in the reference. +asmr_e_local_para_unreachable=07015_E_Impossible d'atteindre $1 depuis ce code +% You can not read directly the value of local or para +% of a higher level in assembler code (except for +% local assembler code without parameter nor locals). +asmr_e_local_label_not_allowed_as_ref=07016_E_Local symboles/labels ne sont pas autoris‚s +% You can't use local symbols/labels as references +asmr_e_wrong_base_index=07017_E_Invalid base and index register usage +% There is an error with the base and index register +asmr_w_possible_object_field_bug=07018_W_Erreur possible dans l'utilisation d'un champ d'un object +% Fields of objects or classes can be reached directly in normal or objfpc +% modes but TP and Delphi modes treat the field name as a simple offset. +asmr_e_wrong_scale_factor=07019_E_Wrong scale factor specified +% The scale factor given is wrong, only 1,2,4 and 8 are allowed +asmr_e_multiple_index=07020_E_Multiple index register usage +% You are trying to use more than one index register +asmr_e_invalid_operand_type=07021_E_Invalid operand type +% The operand type doesn't match with the opcode used +asmr_e_invalid_string_as_opcode_operand=07022_E_Invalid string as opcode operand: $1 +% The string specified as operand is not correct with this opcode +asmr_w_CODE_and_DATA_not_supported=07023_W_@CODE and @DATA not supported +% @CODE and @DATA are unsupported and are ignored. +asmr_e_null_label_ref_not_allowed=07024_E_Null label references are not allowed +asmr_e_expr_zero_divide=07025_E_Divide by zero in asm evaluator +asmr_e_expr_illegal=07026_E_Illegal expression +asmr_e_escape_seq_ignored=07027_E_escape sequence ignored: $1 +asmr_e_invalid_symbol_ref=07028_E_Invalid symbol reference +asmr_w_fwait_emu_prob=07029_W_Fwait can cause emulation problems with emu387 +asmr_w_fadd_to_faddp=07030_W_FADD without operand translated into FADDP +asmr_w_enter_not_supported_by_linux=07031_W_ENTER instruction is not supported by Linux kernel +% ENTER instruction can generate a stack page fault that is not +% caught correctly by the i386 Linux page handler. +asmr_w_calling_overload_func=07032_W_Calling an overload function in assembler +asmr_e_unsupported_symbol_type=07033_E_Unsupported symbol type for operand +asmr_e_constant_out_of_bounds=07034_E_Constant value out of bounds +asmr_e_error_converting_decimal=07035_E_Error converting decimal $1 +asmr_e_error_converting_octal=07036_E_Error converting octal $1 +asmr_e_error_converting_binary=07037_E_Error converting binary $1 +asmr_e_error_converting_hexadecimal=07038_E_Error converting hexadecimal $1 +asmr_h_direct_global_to_mangled=07039_H_$1 translated to $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 is associated to an overloaded function +asmr_e_cannot_use_SELF_outside_a_method=07041_E_Cannot use SELF outside a method +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_Cannot use OLDEBP outside a nested procedure +asmr_e_void_function=07043_W_Functions with void return value can't return any value in asm code +asmr_e_SEG_not_supported=07044_E_SEG not supported +asmr_e_size_suffix_and_dest_dont_match=07045_E_Size suffix and destination or source size do not match +asmr_w_size_suffix_and_dest_dont_match=07046_W_Size suffix and destination or source size do not match +asmr_e_syntax_error=07047_E_Assembler syntax error +asmr_e_invalid_opcode_and_operand=07048_E_Invalid combination of opcode and operands +asmr_e_syn_operand=07049_E_Assembler syntax error in operand +asmr_e_syn_constant=07050_E_Assembler syntax error in constant +asmr_e_invalid_string_expression=07051_E_Invalid String expression +asmr_w_const32bit_for_address=07052_bit constant created for address +asmr_e_unknown_opcode=07053_E_Instruction non reconnue $1 +asmr_e_invalid_or_missing_opcode=07054_E_Invalid or missing opcode +asmr_e_invalid_prefix_and_opcode=07055_E_Invalid combination of prefix and opcode: $1 +asmr_e_invalid_override_and_opcode=07056_E_Invalid combination of override and opcode: $1 +asmr_e_too_many_operands=07057_E_Too many operands on line +asmr_w_near_ignored=07058_W_NEAR ignored +asmr_w_far_ignored=07059_W_FAR ignored +asmr_e_dup_local_sym=07060_E_Duplicate local symbol $1 +asmr_e_unknown_local_sym=07061_E_Undefined local symbol $1 +asmr_e_unknown_label_identifier=07062_E_Unknown label identifier $1 +asmr_e_invalid_register=07063_E_Invalid register name +asmr_e_invalid_fpu_register=07064_E_Invalid floating point register name +asmr_e_nor_not_supported=07065_E_NOR not supported +asmr_w_modulo_not_supported=07066_W_Modulo not supported +asmr_e_invalid_float_const=07067_E_Invalid floating point constant $1 +asmr_e_invalid_float_expr=07068_E_Invalid floating point expression +asmr_e_wrong_sym_type=07069_E_Wrong symbol type +asmr_e_cannot_index_relative_var=07070_E_Cannot index a local var or parameter with a register +asmr_e_invalid_seg_override=07071_E_Invalid segment override expression +asmr_w_id_supposed_external=07072_W_Identifier $1 supposed external +asmr_e_string_not_allowed_as_const=07073_E_Strings not allowed as constants +asmr_e_no_var_type_specified=07074_No type of variable specified +asmr_w_assembler_code_not_returned_to_text=07075_E_assembler code not returned to text section +asmr_e_not_directive_or_local_symbol=07076_E_Not a directive or local symbol $1 +asmr_w_using_defined_as_local=07077_E_Using a defined name as a local label +# +# Assembler/binary writers +# +asmr_e_dollar_without_identifier=07078_E_Dollar utilis‚ sans identificateur +asmr_w_32bit_const_for_address=07079_W_32bit constante cr‚‚e pour une addresse +asmr_n_align_is_target_specific=07080_N_.align d‚pend de la cible, utilisez .balign ou .p2align +asmr_e_cannot_access_field_directly_for_parameters=07081_E_Impossible d'acc‚der directement aux champs pour des paramŠtres +% You should load the parameter first into a register and then access the +% fields using that register. +asmr_e_cannot_access_object_field_directly=07082_E_Impossible d'acc‚der aux champs d'objectsou de classes directement +% You should load the self pointer first into a register and then access the +% fields using the register as base. By default the self pointer is available +% in the esi register on i386. +# +# Assembler/binary writers +# +asmw_f_too_many_asm_files=08000_F_Too many assembler files +asmw_f_assembler_output_not_supported=08001_F_Selected assembler output not supported +asmw_f_comp_not_supported=08002_F_Comp not supported +asmw_f_direct_not_supported=08003_F_Direct not support for binary writers +asmw_e_alloc_data_only_in_bss=08004_E_Allocating of data is only allowed in bss section +asmw_f_no_binary_writer_selected=08005_F_No binary writer selected +asmw_e_opcode_not_in_table=08006_E_Asm: Opcode $1 not in table +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 invalid combination of opcode and operands +asmw_e_16bit_not_supported=08008_E_Asm: 16 Bit references not supported +asmw_e_invalid_effective_address=08009_E_Asm: Invalid effective address +asmw_e_immediate_or_reference_expected=08010_E_Asm: Immediate or reference expected +asmw_e_value_exceeds_bounds=08011_E_Asm: $1 value exceeds bounds $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: Short jump is out of range $1 +# +# Executing linker/assembler +# +asmw_e_undefined_label=08013_E_Asm: Label $1 non d‚fini + +# +# Executing linker/assembler +# +# BeginOfTeX +% +% \section{Errors of assembling/linking stage} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +exec_w_source_os_redefined=09000_W_Source operating system redefined +exec_i_assembling_pipe=09001_I_Assembling (pipe) $1 +exec_d_cant_create_asmfile=09002_E_Can't create assember file $1 +% The mentioned file can't be create. Check if you've +% permission to create this file +exec_e_cant_create_objectfile=09003_E_Impossible de cr‚er le fichier object : $1 +% The mentioned file can't be create. Check if you've +% permission to create this file +exec_e_cant_create_archivefile=09004_E_Impossible de cr‚er le fichier archive : $1 +% The mentioned file can't be create. Check if you've +% permission to create this file +exec_w_assembler_not_found=09005_W_Assembler $1 not found, switching to external assembling +exec_t_using_assembler=09006_T_Using assembler: $1 +exec_w_error_while_assembling=09007_W_Error while assembling exitcode $1 +exec_w_cant_call_assembler=09008_W_Can't call the assembler, error $1 switching to external assembling +exec_i_assembling=09009_I_Assembling $1 +exec_i_assembling_smart=09010_I_Assemblage smartlink $1 +exec_w_objfile_not_found=09011_W_Object $1 not found, Linking may fail ! +exec_w_libfile_not_found=09012_W_Library $1 not found, Linking may fail ! +exec_w_error_while_linking=09013_W_Error while linking +exec_w_cant_call_linker=09014_W_Can't call the linker, switching to external linking +exec_i_linking=09015_I_Linking $1 +exec_w_util_not_found=09016_W_Utilitaire $1 non trouv‚, force la liaison externe +exec_t_using_util=09017_T_Utilitaire $1 trouv‚ +exec_e_exe_not_supported=09018_E_Cr‚ation d'executables impossible +exec_e_dll_not_supported=09019_E_Dynamic Libraries not supported +exec_i_closing_script=09020_I_Closing script $1 +exec_w_res_not_found=09021_W_resource compiler not found, switching to external mode +exec_i_compilingresource=09022_I_Compiling resource $1 +# +# Executable information +# +execinfo_f_cant_process_executable=09128_F_Can't post process executable $1 +execinfo_f_cant_open_executable=09129_F_Can't open executable $1 +execinfo_x_codesize=09130_X_Size of Code: $1 bytes +execinfo_x_initdatasize=09131_X_Size of initialized data: $1 bytes +execinfo_x_uninitdatasize=09132_X_Size of uninitialized data: $1 bytes +execinfo_x_stackreserve=09133_X_Stack space reserved: $1 bytes +execinfo_x_stackcommit=09134_X_Stack space commited: $1 bytes +# Unit loading +# +# BeginOfTeX +% \section{Unit loading messages.} +% This section lists all messages that can occur when the compiler is +% loading a unit from disk into memory. Many of these mesages are +% informational messages. +% \begin{description} +unit_t_unitsearch=10000_T_Unitsearch: $1 +% When you use the \var{-vt}, the compiler tells you where it tries to find +% unit files. +unit_t_ppu_loading=10001_T_PPU Loading $1 +% When the \var{-vt} switch is used, the compiler tells you +% what units it loads. +unit_u_ppu_name=10002_U_PPU Name: $1 +% When you use the \var{-vu} flag, the unit name is shown. +unit_u_ppu_flags=10003_U_PPU Flags: $1 +% When you use the \var{-vu} flag, the unit flags are shown. +unit_u_ppu_crc=10004_U_PPU Crc: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_time=10005_U_PPU Time: $1 +% When you use the \var{-vu} flag, the unit time is shown. +unit_u_ppu_file_too_short=10006_U_PPU File too short +% When you use the \var{-vu} flag, the unit time is shown. +unit_u_ppu_invalid_header=10007_U_PPU Invalid Header (no PPU at the begin) +% A unit file contains as the first three bytes the ascii codes of \var{PPU} +unit_u_ppu_invalid_version=10008_U_PPU Invalid Version $1 +% This unit file was compiled with a different version of the compiler, and +% cannot be read. +unit_u_ppu_invalid_processor=10009_U_PPU is compiled for another processor +% This unit file was compiled for a different processor type, and +% cannot be read +unit_u_ppu_invalid_target=10010_U_PPU is compiled for another target +% This unit file was compiled for a different processor type, and +% cannot be read +unit_u_ppu_source=10011_U_PPU Source: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_write=10012_U_Writing $1 +% When you specify the \var{-vu} switch, the compiler will tell you where it +% writes the unit file. +unit_f_ppu_cannot_write=10013_F_Can't Write PPU-File +% An err +unit_f_ppu_read_error=10014_F_reading PPU-File +% Unexpected end of file +unit_f_ppu_read_unexpected_end=10015_F_unexpected end of PPU-File +% This means that the unit file was corrupted, and contains invalid +% information. Recompilation will be necessary. +unit_f_ppu_invalid_entry=10016_F_Invalid PPU-File entry: $1 +% The unit the compiler is trying to read is corrupted, or generated with a +% newer version of the compiler. +unit_f_ppu_dbx_count_problem=10017_F_PPU Dbx count problem +% There is an inconsistency in the debugging information of the unit. +unit_e_illegal_unit_name=10018_E_Illegal unit name: $1 +% The name of the unit doesn't match the file name. +unit_f_too_much_units=10019_F_Too much units +% \fpc has a limit of 1024 units in a program. You can change this behavior +% by changing the \var{maxunits} constant in the \file{files.pas} file of the +% compiler, and recompiling the compiler. +unit_f_circular_unit_reference=10020_F_Circular unit reference between $1 and $2 +% Two units are using each other in the interface part. This is only allowed +% in the \var{implementation} part. At least one unit must contain the other one +% in the \var{implementation} section. +unit_f_cant_compile_unit=10021_F_Can't compile unit $1, no sources available +% A unit was found that needs to be recompiled, but no sources are +% available. +unit_f_cant_find_ppu=10022_F_Impossible de trouver l'unit‚ $1 +% You tried to use a unit of which the PPU file isn't found by the +% compiler. Check your config files for the unit pathes +unit_w_unit_name_error=10023_W_Unit‚ $1 non trouv‚ mais $2 existe +unit_f_unit_name_error=10024_F_Unit‚ $1 cherch‚ mais $2 trouv‚ +% Dos truncation of 8 letters for unit PPU files +% may lead to problems when unit name is longer than 8 letters. +unit_w_switch_us_missed=10025_W_Compiling the system unit requires the -Us switch +% When recompiling the system unit (it needs special treatment), the +% \var{-Us} must be specified. +unit_f_errors_in_unit=10026_F_There were $1 errors compiling module, stopping +% When the compiler encounters a fatal error or too many errors in a module +% then it stops with this message. +unit_u_load_unit=10027_U_Load from $1 ($2) unit $3 +% When you use the \var{-vu} flag, which unit is loaded from which unit is +% shown. +unit_u_recompile_crc_change=10028_U_Recompiling $1, checksum changed for $2 +unit_u_recompile_source_found_alone=10029_U_Recompiling $1, source found only +% When you use the \var{-vu} flag, these messages tell you why the current +% unit is recompiled. +unit_u_recompile_staticlib_is_older=10030_U_Recompiling unit, static lib is older than ppufile +% When you use the \var{-vu} flag, the compiler warns if the static library +% of the unit are older than the unit file itself. +unit_u_recompile_sharedlib_is_older=10031_U_Recompiling unit, shared lib is older than ppufile +% When you use the \var{-vu} flag, the compiler warns if the shared library +% of the unit are older than the unit file itself. +unit_u_recompile_obj_and_asm_older=10032_U_Recompiling unit, obj and asm are older than ppufile +% When you use the \var{-vu} flag, the compiler warns if the assembler of +% object file of the unit are older than the unit file itself. +unit_u_recompile_obj_older_than_asm=10033_U_Recompiling unit, obj is older than asm +% When you use the \var{-vu} flag, the compiler warns if the assembler +% file of the unit is older than the object file of the unit. +unit_u_start_parse_interface=10034_U_Parsing interface of $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the interface part of the unit +unit_u_start_parse_implementation=10035_U_Parsing implementation of $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the implementation part of the unit +unit_u_second_load_unit=10036_U_Second load for unit $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_check_time=10037_U_PPU Check file $1 time $2 +% When you use the \var{-vu} flag, the compiler show the filename and +% date and time of the file which a recompile depends on +% \end{description} +# EndOfTeX + +# +# Options +# +option_usage=11000_O_$1 [options] <inputfile> [options] +# BeginOfTeX +% +% \section{Command-line handling errors} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +option_only_one_source_support=11001_W_Only one source file supported +% You can specify only one source file on the command line. The first +% one will be compiled, others will be ignored. This may indicate that +% you forgot a \var{'-'} sign. +option_def_only_for_os2=11002_W_DEF file can be created only for OS/2 +% This option can only be specified when you're compiling for OS/2 +option_no_nested_response_file=11003_E_nested response files are not supported +% you cannot nest response files with the \var {@file} command-line option. +option_no_source_found=11004_F_No source file name in command line +% The compiler expects a source file name on the command line. +option_no_option_found=11005_N_Aucune option trouv‚e dans le fichier de configuration $1 +% The compiler didn't find any option in that config file. +option_illegal_para=11006_E_Illegal parameter: $1 +% You specified an unknown option. +option_help_pages_para=11007_H_-? writes help pages +% When an unknown option is given, this message is diplayed. +option_too_many_cfg_files=11008_F_Too many config files nested +% You can only nest up to 16 config files. +option_unable_open_file=11009_F_Unable to open file $1 +% The option file cannot be found. +option_reading_further_from=11010_N_Reading further options from $1 +% Displayed when you have notes turned on, and the compiler switches +% to another options file. +option_target_is_already_set=11011_W_Target is already set to: $1 +% Displayed if more than one \var{-T} option is specified. +option_no_shared_lib_under_dos=11012_W_Shared libs not supported on DOS platform, reverting to static +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos +option_too_many_ifdef=11013_F_too many IF(N)DEFs +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_many_endif=11014_F_too many ENDIFs +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_less_endif=11015_F_open conditional at the end of the file +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_no_debug_support=11016_W_Debug information generation is not supported by this executable +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_Try recompiling with -dGDB +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_W_You are using the obsolete switch $1 +% this warns you when you use a switch that is not needed/supported anymore. +% It is recommended that you remove the switch to overcome problems in the +% future, when the switch meaning may change. +option_obsolete_switch_use_new=11019_W_You are using the obsolete switch $1, please use $2 +% this warns you when you use a switch that is not supported anymore. You +% must now use the second switch instead. +% It is recommended that you change the switch to overcome problems in the +% future, when the switch meaning may change. +option_switch_bin_to_src_assembler=11020_N_Switching assembler to default source writing assembler +% this notifies you that the assembler has been changed because you used the +% -a switch which can't be used with a binary assembler writer. +option_incompatible_asm=11021_W_Assembler output selected "$1" is not compatible with "$2" +option_asm_forced=11022_W_"$1" assembler use forced +% The assembler output selected can not generate +% object files with the correct format. Therefore, the +% default assembler for this target is used instead. +%\end{description} +# EndOfTeX + +# +# Logo (option -l) +# +option_logo=11023_[ +Compilateur Free Pascal version $FPCFULLVERSION [$FPCDATE] pour $FPCTARGET +Copyright (c) 1998-2011 by Florian Klaempfl +] + +# +# Info (option -i) +# +option_info=11024_[ +Compilateur Free Pascal version $FPCVERSION + +Date du compilateur : $FPCDATE +Cible du compilateur : $FPCTARGET +# the next lines are NOT translated on purpose !!! + +This program comes under the GNU General Public Licence +For more information read COPYING.FPC + +Report bugs,suggestions etc to: + http://bugs.freepascal.org +ou + bugs@freepascal.org +] + +# +# Help pages (option -? and -h) +# +option_help_pages=11025_[ +**0*_mettre + aprŠs un bool‚en pour activer l'option, - pour la d‚sactiver +**1a_conserve les fichiers assembleurs cr‚‚s pendant la compilation +**2al_liste le code source dans les fichiers assembleur +**2ar_liste les allocations de registres dans les fichiers assembleur +**2at_liste les allocations de donn‚es temporaire dans la pile +**1b_g‚nŠre les informations pour le browser +**2bl_g‚nŠre les informations locales ‚galement +**1B_recompile toutes les unit‚s +**1C<x>_options de g‚n‚ration de code : +3*2CD_cr‚erune librairie dynamique +**2Ch<n>_<n> taille du tas en bytes (entre 1023 et 67107840) +**2Ci_IO-checking +**2Cn_pas de linking +**2Co_g‚nŠre des tests d'overflow pour les op‚rations sur les entiers +**2Cr_Controle d'intervalles +**2Cs<n>_sp‚cifie <n> comme taille de la pile +**2Ct_test de d‚bordement de pile +3*2CS_cr‚er une librairie statique +3*2Cx_utiliser le smartlinking +**1d<x>_d‚finit le symbole <x> +*O1D_g‚nŠre un fichier DEF +*O2Dd<x>_assigne la description … <x> +*O2Dw_application en mode prot‚g‚ +**1e<x>_d‚finit le chemin vers l'ex‚cutable +**1E_comme -Cn +**1F<x>_d‚finit des chemins et noms de fichiers : +**2FD<x>_d‚finit le r‚pertoire o— chercher les utilitaires de compilation +**2Fe<x>_redirige les erreurs vers le fichier <x> +**2FE<x>_r‚pertoire pour les exe/unit‚s : <x> +**2Fi<x>_ajoute <x> … la liste des r‚pertoires pour fichiers inclus +**2Fl<x>_ajoute <x> … la liste des r‚pertoires pour librairies +*L2FL<x>_utilises <x> comme lieur dynamique +**2Fo<x>_ajoute <x> … la liste des r‚pertoires pour fichiers objets +**2Fr<x>_charge le fichier erreur <x> +**2Fu<x>_ajoute <x> … la liste des r‚pertoires pour unit‚s +**2FU<x>_d‚finit le r‚pertoire d'‚criture des unit‚s … <x>, en d‚pit de -FE +*g1g<x>_g‚nŠre des informations de d‚bogage : +*g2gg_utilise gsym +*g2gd_utilise dbx +*g2gh_use l'unit‚ de tracage du tas +*g2gc_generate checks for pointers +**1i_information +**2iD_donne la date du compilateur +**2iV_donne la version du compilateur +**2iSO_donne l'OS du compilateur +**2iSP_donne le processeur du compilateur +**2iTO_donne l'OS cible +**2iTP_donne le processeur cible +**1I<x>_ajoute <x> … la liste des r‚pertoires pour fichiers inclus +**1k<x>_transmet <x> au linker +**1l_‚crit le logo +**1n_ne pas lire le fichier de configuration par d‚faut +**1o<x>_change le nom de l'executable en <x> +**1pg_g‚nŠre du code pour profiler avec gprof +*L1P_utilise des pipes au lieu de cr‚er des fichiers temporaires +**1S<x>_options de syntaxe : +**2S2_autorise quelques extensions Delphi 2 +**2Sc_autorise les operateurs type C (*=,+=,/= et -=) +**2Sd_essaye d'ˆtre compatible avec Delphi +**2Se_stoppe la compilation … la premiŠre erreur +**2Sg_autorise LABEL et GOTO +**2Sh_Utilise les ansistrings +**2Si_supporte les INLINE type C++ +**2Sm_support des macros comme C (global) +**2So_essaye d'ˆtre compatible avec TP/BP 7.0 +**2Sp_essaye d'ˆtre compatible avec GPC +**2Ss_les constructeurs doivent s'appeler init (et les destructeurs done) +**1s_n'appelle pas l'assembleur ni le linker +**1u<x>_rend le symbole <x> non d‚fini +**1U_options d'unit‚s : +**2Un_ne pas v‚rifier le nom de l'unit‚ +**2Us_compiler en temps qu'unit‚ systŠme +**1v<x>_donne des informations. <x> est une combination des lettres suivantes : +**2*_e : montre les erreurs (d‚faut) d : informations de d‚boggage +**2*_w : montre les avertissements u : montre les info sur les unit‚s +**2*_n : montre les notes t : montre les fichiers essay‚s/utilis‚s +**2*_h : montre les suggestions m : montre les macros d‚finies +**2*_i : montre des infos g‚n‚rales p : montre les proc‚dures compil‚es +**2*_l : montre les num‚ros de lignes c : montre les conditionniels +**2*_a : montre tout 0 : ne montre rien (sauf les erreurs) +**2*_b : montre toutes les proc‚dures r : mode compatibilit‚ Rhide/GCC +**2*_ quand une erreur survient x : infos Executable (Win32 seulement) +**2*_ +**1X_options pour executable : +*L2Xc_lien avec librairie C +**2XD_lien avec la librarie dynamique (d‚finit FPC_LINK_DYNAMIC) +**2Xs_enlˆve tous les symboles de l'executable +**2XS_lien avec les librairies statiques (d‚finit FPC_LINK_STATIC) +**0*_options sp‚cifiques au processeur : +3*1A<x>_format de sortie : +3*2Aas_fichier objet g‚n‚r‚ par GNU AS +3*2Aasaout_fichier objet g‚n‚r‚ par GNU AS pour aout (Go32v1) +3*2Anasmcoff_fichier COFF (Go32v2) avec Nasm +3*2Anasmelf_fichier ELF32 (Linux) avec Nasm +3*2Anasmobj_fichier OBJ avec Nasm +3*2Amasm_fichier OBJ avec Masm (Microsoft) +3*2Atasm_fichier OBJ avec Tasm (Borland) +3*2Acoff_coff (Go32v2) using internal writer +3*2Apecoff_pecoff (Win32) using internal writer +3*1R<x>_type lecture assembleur : +3*2Ratt_lit l'assembleur AT&T +3*2Rintel_lit l'assembleur Intel +3*2Rdirect_copie le texte assembleur directement dans le fichier assembleur +3*1O<x>_optimisations : +3*2Og_g‚nŠre du code compact +3*2OG_g‚nŠre du code rapide (defaut) +3*2Or_garde certaines variables dans des registres (toujours BUGGY!!!) +3*2Ou_autorise les optimisations incertaines (voir docs) +3*2O1_optimisations niveau 1 (optimisations rapides) +3*2O2_optimisations niveau 2 (-O1 + optimisations plus lentes) +3*2O3_optimisations niveau 3 (comme -O2u) +3*2Op<x>_processeur cible : +3*3Op1_d‚finit 386/486 comme processeur cible +3*3Op2_d‚finit Pentium/PentiumMMX (tm) comme processeur cycle +3*3Op3_d‚finit PPro/PII/c6x86/K6 (tm) comme processeur cycle +3*1T<x>_systŠme d'expliotation cible: +3*2TEMX_OS/2 via EMX (et les extensions EMX/RSX) +3*2TGO32V2_version 2 de l'extension DOS de DJ Delorie +3*2TLINUX_Linux +3*2TNETWARE_Novell Netware Module (clib) +3*2Tnetwlibc_Novell Netware Module (libc) +3*2TOS2_OS/2 / eComStation +3*2TSUNOS_SunOS/Solaris +3*2TWDOSX_WDOSX DOS extension +3*2TWIN32_Windows 32 Bits +6*1A<x>_output format +6*2Aas_Unix o-file using GNU AS +6*2Agas_GNU Motorola assembler +6*2Amit_MIT Syntax (old GAS) +6*2Amot_Standard Motorola assembler +6*1O_optimizations: +6*2Oa_turn on the optimizer +6*2Og_generate smaller code +6*2OG_generate faster code (default) +6*2Ox_optimize maximum (still BUGGY!!!) +6*2O2_set target processor to a MC68020+ +6*1R<x>_styles d'assembleur : +6*2RMOT_lire l'assembleur type motorola +6*1T<x>_SystŠme d'exploitation cible : +6*2TAMIGA_Commodore Amiga +6*2TATARI_Atari ST/STe/TT +6*2TMACOS_Macintosh m68k +6*2TLINUX_Linux-68k +**1*_ +**1?_affiche cette aide +6*1R<x>_version de l'assembleur lu +6*2RMOT_read motorola style assembler +6*1T<x>_Target operating system: +6*2TAMIGA_Commodore Amiga +6*2TATARI_Atari ST/STe/TT +6*2TMACOS_Macintosh m68k +6*2TLINUX_Linux-68k +**1*_ +**1?_shows this help +**1h_affiche cette aide sans attente +] + +# +# The End... diff --git a/closures/compiler/msg/errorfi.msg b/closures/compiler/msg/errorfi.msg new file mode 100644 index 0000000000..16d742c014 --- /dev/null +++ b/closures/compiler/msg/errorfi.msg @@ -0,0 +1,2517 @@ +# +# This file is part of the Free Pascal Compiler +# Copyright (c) 1999-2008 by the Free Pascal Development team +# +# French (ISO 8859-1) Language File for Free Pascal +# Latest updates contributed by Rémi Dorlet <remi at dorlet.org> +# Based on errore.msg of SVN revision 4165 +# +# 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. +# +# +# The constants are build in the following order: +# <part>_<type>_<txtidentifier> +# +# <part> is the part of the compiler the message is used +# asmr_ assembler parsing +# asmw_ assembler writing/binary writers +# unit_ unit handling +# scan_ scanner +# parser_ parser +# type_ type checking +# general_ general info +# exec_ calls to assembler, linker, binder +# +# <type> the type of the message it should normally used for +# f_ fatal error +# e_ error +# w_ warning +# n_ note +# h_ hint +# i_ info +# l_ add linenumber +# u_ used +# t_ tried +# c_ conditional +# d_ debug message +# x_ executable informations +# +# +# General +# +# 01023 is the last used one +# +general_text_bytes_code=01019_Code de type octet +general_text_bytes_data=01020_Donnée de type octet +# BeginOfTeX +% \section{General compiler messages} +% This section gives the compiler messages which are not fatal, but which +% display useful information. The number of such messages can be +% controlled with the various verbosity level \var{-v} switches. +% \begin{description} +general_t_compilername=01000_T_Compilateur: $1 +% When the \var{-vt} switch is used, this line tells you what compiler +% is used. +general_d_sourceos=01001_D_Système d'exploitation du compilateur: $1 +% When the \var{-vd} switch is used, this line tells you what the source +% operating system is. +general_i_targetos=01002_I_Système d'exploitation cible: $1 +% When the \var{-vd} switch is used, this line tells you what the target +% operating system is. +general_t_exepath=01003_T_Répertoire des fichiers exécutables: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its binaries. +general_t_unitpath=01004_T_Répertoire de recherche des unités: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for compiled units. You can set this path with the \var{-Fu} +general_t_includepath=01005_T_Répertoire de recherche des fichiers inclus: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its include files (files used in \var{\{\$I xxx\}} statements). +% You can set this path with the \var{-I} option. +general_t_librarypath=01006_T_Répertoire de recherche des bibliothèques: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for the libraries. You can set this path with the \var{-Fl} option. +general_t_objectpath=01007_T_Répertoire de recherche des fichiers objet: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for object files you link in (files used in \var{\{\$L xxx\}} statements). +% You can set this path with the \var{-Fo} option. +general_i_abslines_compiled=01008_I_$1 lignes compilées, $2 sec$3 +% When the \var{-vi} switch is used, the compiler reports the number +% of lines compiled, and the time it took to compile them (real time, +% not program time). +general_f_no_memory_left=01009_F_Plus de mémoire disponible +% The compiler doesn't have enough memory to compile your program. There are +% several remedies for this: +% \begin{itemize} +% \item If you're using the build option of the compiler, try compiling the +% different units manually. +% \item If you're compiling a huge program, split it up in units, and compile +% these separately. +% \item If the previous two don't work, recompile the compiler with a bigger +% heap (you can use the \var{-Ch} option for this, \seeo{Ch}) +% \end{itemize} +general_i_writingresourcefile=01010_I_Écriture du fichier de ressource: $1 +% This message is shown when the compiler writes the Resource String Table +% file containing all the resource strings for a program. +general_e_errorwritingresourcefile=01011_E_Écriture du fichier de chaînes de ressource: $1 +% This message is shown when the compiler encountered an error when writing +% the Resource String Table file +general_i_fatal=01012_I_Fatal: +% Prefix for Fatal Errors +general_i_error=01013_I_Erreur: +% Prefix for Errors +general_i_warning=01014_I_Attention: +% Prefix for Warnings +general_i_note=01015_I_Note: +% Prefix for Notes +general_i_hint=01016_I_Conseil: +% Prefix for Hints +general_e_path_does_not_exist=01017_E_Le chemin "$1" n'existe pas +% The specified path does not exist. +general_f_compilation_aborted=01018_F_Compilation interrompue +% Compilation was aborted. +general_i_number_of_warnings=01021_I_$1 avertissement(s) émis +% Total number of warnings issued during compilation. +general_i_number_of_hints=01022_I_$1 conseil(s) émis +% Total number of hints issued during compilation. +general_i_number_of_notes=01023_I_$1 note(s) émises +% Total number of notes issued during compilation. +% \end{description} +# +# Scanner +# +# 02063 is the last used one +# +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compiling handling. +% \begin{description} +scan_f_end_of_file=02000_F_Fin de fichier inattendue +% this typically happens in one of the following cases : +% \begin{itemize} +% \item The source file ends before the final \var{end.} statement. This +% happens mostly when the \var{begin} and \var{end} statements aren't +% balanced; +% \item An include file ends in the middle of a statement. +% \item A comment was not closed +% \end{itemize} +scan_f_string_exceeds_line=02001_F_Chaîne de caractères sur plus d'une ligne +% There is a missing closing ' in a string, so it occupies +% multiple lines. +scan_f_illegal_char=02002_F_Caractère "$1" illégal ($2) +% An illegal character was encountered in the input file. +scan_f_syn_expected=02003_F_Erreur de syntaxe, "$1" attendu mais "$2" trouvé +% This indicates that the compiler expected a different token than +% the one you typed. It can occur almost everywhere where you make a +% mistake against the pascal language. +scan_t_start_include_file=02004_T_Début de lecture du fichier include $1 +% When you provide the \var{-vt} switch, the compiler tells you +% when it starts reading an included file. +scan_w_comment_level=02005_W_Commentaire de niveau $1 trouvé +% When the \var{-vw} switch is used, then the compiler warns you if +% it finds nested comments. Nested comments are not allowed in Turbo Pascal +% and can be a possible source of errors. +scan_n_ignored_switch=02008_N_Commutateur "$1" ignoré +% With \var{-vn} on, the compiler warns if it ignores a switch +scan_w_illegal_switch=02009_W_Commutateur "$1" illégal +% You included a compiler switch (i.e. \var{\{\$... \}}) which the compiler +% does not recognise +scan_w_switch_is_global=02010_W_Commutateur global mal placé +% The compiler switch is misplaced, and should be located at +% the start of the unit or program. +scan_e_illegal_char_const=02011_E_Constante de type char illégale +% This happens when you specify a character with its ASCII code, as in +% \var{\#96}, but the number is either illegal, or out of range. +scan_f_cannot_open_input=02012_F_Impossible d'ouvrir le fichier "$1" +% \fpc cannot find the program or unit source file you specified on the +% command line. +scan_f_cannot_open_includefile=02013_F_Impossible d'ouvrir le fichier include "$1" +% \fpc cannot find the source file you specified in a \var{\{\$include ..\}} +% statement. +scan_e_illegal_pack_records=02015_E_Paramètre d'alignement de record incorrect "$1" +% You are specifying the \var{\{\$PACKRECORDS n\} } or \var{\{\$ALIGN n\} } +% with an illegal value for \var{n}. For \$PACKRECORDS valid alignments are 1, 2, 4, 8, 16, 32, C, +% NORMAL, DEFAULT, and for \$ALIGN valid alignment are 1, 2, 4, 8, 16, 32, ON, +% OFF. Under mode MacPas \$ALIGN also supports MAC68K, POWER and RESET. +scan_e_illegal_pack_enum=02016_E_Paramètre de taille minimum d'énumération incorrect "$1" +% You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for +% \var{n}. Only 1,2,4, NORMAL or DEFAULT are valid here. +scan_e_endif_expected=02017_E_$ENDIF attendu pour $1 $2 défini dans $3 à la ligne $4 +% Your conditional compilation statements are unbalanced. +scan_e_preproc_syntax_error=02018_E_Erreur de syntaxe pendant l'interprétation d'une directive de compilation +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc compiler +% directives. +scan_e_error_in_preproc_expr=02019_E_Évaluation d'une directive de compilation +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc compiler +% directives. +scan_w_macro_cut_after_255_chars=02020_W_Le contenu d'une macro est tronqué à 255 caractères +% The contents of macros cannot be longer than 255 characters. +scan_e_endif_without_if=02021_E_ENDIF sans IF(N)DEF +% Your \var{\{\$IFDEF ..\}} and {\{\$ENDIF\}} statements aren't balanced. +scan_f_user_defined=02022_F_Défini par l'utilisateur : $1 +% A user defined fatal error occurred. see also the \progref +scan_e_user_defined=02023_E_Défini par l'utilisateur : $1 +% A user defined error occurred. see also the \progref +scan_w_user_defined=02024_W_Défini par l'utilisateur : $1 +% A user defined warning occurred. see also the \progref +scan_n_user_defined=02025_N_Défini par l'utilisateur : $1 +% A user defined note was encountered. see also the \progref +scan_h_user_defined=02026_H_Défini par l'utilisateur : $1 +% A user defined hint was encountered. see also the \progref +scan_i_user_defined=02027_I_Défini par l'utilisateur : $1 +% User defined information was encountered. see also the \progref +scan_e_keyword_cant_be_a_macro=02028_E_La redéfinition d'un mot réservé en tant que macro est dans effet +% You cannot redefine keywords with macros. +scan_f_macro_buffer_overflow=02029_F_Débordement de tampon lors de la lecture ou de l'expansion d'une macro +% Your macro or its result was too long for the compiler. +scan_w_macro_too_deep=02030_W_L'expansion des macros dépasse une profondeur de 16. +% When expanding a macro, macros have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_w_wrong_styled_switch=02031_W_Les commutateurs du compilateur ne sont pas supportés dans les commentaires de style // +% Compiler switches should be in normal pascal style comments. +scan_d_handling_switch=02032_D_Interprétation du commutateur "$1" +% When you set debugging info on (\var{-vd}) the compiler tells you when it +% is evaluating conditional compile statements. +scan_c_endif_found=02033_CL_ENDIF $1 trouvé +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifdef_found=02034_CL_IFDEF $1 trouvé, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifopt_found=02035_CL_IFOPT $1 trouvé, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_if_found=02036_CL_IF $1 trouvé, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifndef_found=02037_CL_IFNDEF $1 trouvé, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_else_found=02038_CL_ELSE $1 trouvé, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_skipping_until=02039_CL_Passant jusqu'à... +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements, and whether it is skipping or +% compiling parts. +scan_i_press_enter=02040_I_Appuyez sur <Entrée> pour continuer +% When the \var{-vi} switch is used, the compiler stops compilation +% and waits for the \var{Enter} key to be pressed when it encounters +% a \var{\{\$STOP\}} directive. +scan_w_unsupported_switch=02041_W_Commutateur "$1" non supporté +% When warnings are turned on (\var{-vw}) the compiler warns you about +% unsupported switches. This means that the switch is used in Delphi or +% Turbo Pascal, but not in \fpc +scan_w_illegal_directive=02042_W_Directive de compilation "$1" illégale +% When warings are turned on (\var{-vw}) the compiler warns you about +% unrecognised switches. For a list of recognised switches, \progref +scan_t_back_in=02043_T_De retour dans $1 +% When you use (\var{-vt}) the compiler tells you when it has finished +% reading an include file. +scan_w_unsupported_app_type=02044_W_Type d'application non supportée : $1 +% You get this warning, if you specify an unknown application type +% with the directive \var{\{\$APPTYPE\}} +scan_w_app_type_not_support=02045_W_$APPTYPE n'est pas supporté par l'OS cible +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_w_description_not_support=02046_W_DESCRIPTION n'est pas supporté par l'OS cible +% The \var{\{\$DESCRIPTION\}} directive is not supported on this target OS +scan_n_version_not_support=02047_N_VERSION non supporté par l'OS cible +% The \var{\{\$VERSION\}} directive is not supported on this target OS +scan_n_only_exe_version=02048_N_VERSION seulement pour les EXE et les DLL +% The \var{\{\$VERSION\}} directive is only used for executable or DLL sources. +scan_w_wrong_version_ignored=02049_W_Mauvais format de la directive VERSION "$1" +% The \var{\{\$VERSION\}} directive format is majorversion.minorversion +% where majorversion and minorversion are words. +scan_e_illegal_asmmode_specifier=02050_E_Style d'assembleur incorrect "$1" +% When you specify an assembler mode with the \var{\{\$ASMMODE xxx\}} +% the compiler didn't recognize the mode you specified. +scan_w_no_asm_reader_switch_inside_asm=02051_W_Changement de type d'interpréteur ASM à l'intérieur de code assembleur, $1 sera effectif seulement pour le prochain +% It is not possible to switch from one assembler reader to another +% inside an assembler block. The new reader will be used for next +% assembler statements only. +scan_e_wrong_switch_toggle=02052_E_Mauvais argument de commutateur, utilisez ON/OFF ou +/- +% You need to use ON or OFF or a + or - to toggle the switch +scan_e_resourcefiles_not_supported=02053_E_Fichiers de ressources non supportés pour cette cible +% The target you are compiling for doesn't support resource files. +scan_w_include_env_not_found=02054_W_Variable d'environment "$1" non trouvée +% The included environment variable can't be found in the environment, it will +% be replaced by an empty string instead. +scan_e_invalid_maxfpureg_value=02055_E_Valeur invalide pour nombre limite de variables en registre FPU +% Valid values for this directive are 0..8 and NORMAL/DEFAULT +scan_w_only_one_resourcefile_supported=02056_W_Un seul fichier de ressource est supporté pour cette cible +% The target you are compiling for supports only one resource file. +% The first resource file found is used, the others are discarded. +scan_w_macro_support_turned_off=02057_W_L'utilisation des macros à été désactivée + +% A macro declaration has been found, but macro support is currently off, +% so the declaration will be ignored. To turn macro support on compile with +% -Sm on the commandline or add \{\$MACRO ON\} in the source +scan_e_invalid_interface_type=02058_E_Type d'interface spécifié incorrect. Les valeurs acceptées sont COM, CORBA et DEFAULT. +% The interface type that was specified is not supported +scan_w_appid_not_support=02059_W_APPID n'est supporté que pour PalmOS +% The \var{\{\$APPID\}} directive is only supported for the PalmOS target. +scan_w_appname_not_support=02060_W_APPNAME n'est supporté que pour PalmOS +% The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target. +scan_e_string_exceeds_255_chars=02061_E_Les constantes chaîne de caractères ne peuvent dépasser 255 caractères +% A single string constant can contain at most 255 chars. Try splitting up the +% string in multiple smaller parts and concatenate them with a + operator. +scan_f_include_deep_ten=02062_F_La profondeur des inclusions de fichiers include dépasse 16. +% When including include files the files have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_e_too_many_push=02063_F_Trop de niveaux de PUSH +% A maximum of 20 levels is allowed. This error occurs only in mode MacPas. +scan_e_too_many_pop=02064_E_Un POP non précédé d'un PUSH +% This error occurs only in mode MacPas. +scan_e_error_macro_lacks_value=02065_E_Macro ou variable d´heure de compilation "$1" sans valeur +% Thus the conditional compile time expression cannot be evaluated. +scan_e_wrong_switch_toggle_default=02066_E_Mauvais argument de commutateur, utilisez ON/OFF/DEFAULT ou +/-/* +% You need to use ON or OFF or DEFAULT or a + or - or * to toggle the switch +scan_e_mode_switch_not_allowed=02067_E_Le commutateur de mode "$1" n'est pas autorisé ici +% A mode switch has already been encountered, or, in case of option -Mmacpas, +% a mode switch occur after UNIT. +scan_e_error_macro_undefined=02068_E_Macro ou variable d´heure de compilation "$1" non définie +% Thus the conditional compile time expression cannot be evaluated. Only in mode MacPas. +scan_e_utf8_bigger_than_65535=02069_E_Code UTF-8 supérieur à 65535 trouvé +% \fpc handles utf-8 strings internally as widestrings e.g. the char codes are limited to 65535 +scan_e_utf8_malformed=02070_E_Chaîne UTF-8 malformée +% The given string isn't a valid UTF-8 string +scan_c_switching_to_utf8=02071_C_Signature UTF-8 trouvée, utilisation de l'encodage UTF-8 +% The compiler found an UTF-8 encoding signature (\$ef, \$bb, \$bf) at the beginning of a file, +% so it interprets it as an UTF-8 file +scan_e_compile_time_typeerror=02072_E_Heure de compilation: $1 attendue mais $2 à $3 obtenue +% Type check of a compile time expression failed. +scan_n_app_type_not_support=02073_N_APPTYPE n'est pas supporté par l'OS cible +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_e_illegal_optimization_specifier=02074_E_Optimisation "$1" spécifiée incorrecte +% When you specify an optimization with the \var{\{\$OPTIMIZATION xxx\}} +% the compiler didn't recognize the optimization you specified. +scan_w_setpeflags_not_support=02075_W_SETPEFLAGS n'est pas supporté par l'OS cible +% The \var{\{\$SETPEFLAGS\}} directive is not supported by the target OS +scan_w_imagebase_not_support=02076_W_IMAGEBASE n'est pas supporté par l'OS cible +% The \var{\{\$IMAGEBASE\}} directive is not supported by the target OS +scan_w_minstacksize_not_support=02077_W_MINSTACKSIZE n'est pas supporté sur l'OS cible +% The \var{\{\$MINSTACKSIZE\}} directive is not supported by the target OS +scan_w_maxstacksize_not_support=02078_W_MAXSTACKSIZE n'est pas supporté sur l'OS cible +% The \var{\{\$MAXSTACKSIZE\}} directive is not supported by the target OS +% \end{description} +# +# Parser +# +# 03192 is the last used one +# +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your pascal constructs +% are correct. +% \begin{description} +parser_e_syntax_error=03000_E_Analyseur syntaxique - Erreur de syntaxe +% An error against the Turbo Pascal language was encountered. This happens +% typically when an illegal character is found in the sources file. +parser_e_dont_nest_interrupt=03004_E_Une procédure de type INTERRUPT ne peut pas être imbriquée +% An \var{INTERRUPT} procedure must be global. +parser_w_proc_directive_ignored=03005_W_Type procédure "$1" ignoré +% The specified procedure directive is ignored by FPC programs. +parser_e_no_overload_for_all_procs=03006_E_Toutes les déclaration de "$1" ne sont pas déclarées OVERLOAD +% When you want to use overloading using the \var{OVERLOAD} directive, then +% all declarations need to have \var{OVERLOAD} specified. +parser_e_export_name_double=03008_E_Nom de fonction exportée "$1" dupliqué +% Exported function names inside a specific DLL must all be different +parser_e_export_ordinal_double=03009_E_Index de fonction exportée "$1" dupliqué +% Exported function names inside a specific DLL must all be different +parser_e_export_invalid_index=03010_E_Index de fonction exportée invalide +% DLL function index must be in the range \var{1..\$FFFF} +parser_w_parser_reloc_no_debug=03011_W_Les DLL ou EXE relogeables sont incompatibles avec les informations de débogage, débogage désactivé. +parser_w_parser_win32_debug_needs_WN=03012_W_Pour permettre le débogage de code win32, utilisez l'option -WN +% Stabs info is wrong for relocatable DLL or EXES use -WN +% if you want to debug win32 executables. +parser_e_constructorname_must_be_init=03013_E_Le nom du constructeur doit être INIT +% You are declaring an object constructor with a name which is not \var{init}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_destructorname_must_be_done=03014_E_Le nom du destructeur doit être DONE +% You are declaring an object destructor with a name which is not \var{done}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_proc_inline_not_supported=03016_E_Procédure INLINE non supportée +% You tried to compile a program with C++ style inlining, and forgot to +% specify the \var{-Si} option (\seeo{Si}). The compiler doesn't support C++ +% styled inlining by default. +parser_w_constructor_should_be_public=03018_W_Le constructeur devrait être public +% Constructors must be in the 'public' part of an object (class) declaration. +parser_w_destructor_should_be_public=03019_W_Le destructeur devrait être public +% Destructors must be in the 'public' part of an object (class) declaration. +parser_n_only_one_destructor=03020_N_Les classes ne doivent avoir qu'un seul destructeur +% You can declare only one destructor for a class. +parser_e_no_local_objects=03021_E_Les définitions de classes locales ne sont pas autorisées +% Classes must be defined globally. They cannot be defined inside a +% procedure or function +parser_f_no_anonym_objects=03022_F_Les définitions de classes anonymes sont interdites +% An invalid object (class) declaration was encountered, i.e. an +% object or class without methods that isn't derived from another object or +% class. For example: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% will trigger this error. +parser_n_object_has_no_vmt=03023_N_L'objet "$1" n'a pas de VMT +% This is a note indicating that the declared object has no +% virtual method table. +parser_e_illegal_parameter_list=03024_E_Liste de paramètres illégale +% You are calling a function with parameters that are of a different type than +% the declared parameters of the function. +parser_e_wrong_parameter_size=03026_E_Mauvais nombre de paramètres spécifié +% There is an error in the parameter list of the function or procedure, +% the number of parameters is not correct. +parser_e_overloaded_no_procedure=03027_E_L'identificateur surchargé "$1" n'est pas une fonction +% The compiler encountered a symbol with the same name as an overloaded +% function, but it is not a function it can overload. +parser_e_overloaded_have_same_parameters=03028_E_Les fonctions surchargées ont les mêmes paramètres +% You're declaring overloaded functions, but with the same parameter list. +% Overloaded function must have at least 1 different parameter in their +% declaration. +parser_e_header_dont_match_forward=03029_E_L'en-tête de la fonction ne correspond pas à la déclaration anticipée "$1" +% You declared a function with same parameters but +% different result type or function modifiers. +parser_e_header_different_var_names=03030_E_L'entête de la fonction "$1" ne correspond pas à sa déclaration anticipée : le nom de variable change $2 => $3 +% You declared the function in the \var{interface} part, or with the +% \var{forward} directive, but define it with a different parameter list. +parser_n_duplicate_enum=03031_N_Les valeurs d'une énumération doivent être en ordre croissant +% \fpc allows enumeration constructions as in C. Given the following +% declaration two declarations: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% The second declaration would produce an error. \var{A\_UAS} needs to have a +% value higher than \var{A\_E}, i.e. at least 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_With ne peut pas être utilisé avec les variables d'un autre segment +% With stores a variable locally on the stack, +% but this is not possible if the variable belongs to another segment. +parser_e_too_much_lexlevel=03034_E_Niveau d'inbrication de fonctions > 31 +% You can nest function definitions only 31 times. +parser_e_range_check_error=03035_E_Erreur d'intervalle dans l'évaluation d'une constante +% The constants are out of their allowed range. +parser_w_range_check_error=03036_W_Erreur d'intervalle dans l'évaluation d'une constante +% The constants are out of their allowed range. +parser_e_double_caselabel=03037_E_Valeur dupliquée dans une instruction CASE +% You are specifying the same label 2 times in a \var{case} statement. +parser_e_case_lower_less_than_upper_bound=03038_E_Valeur max. inférieure à la valeur min. dans l'instruction CASE +% The upper bound of a \var{case} label is less than the lower bound and this +% is useless +parser_e_type_const_not_possible=03039_E_Les constantes typées de classes sont interdites +% You cannot declare a constant of type class or object. +parser_e_no_overloaded_procvars=03040_E_Les variables fonction de fonctions surchargées ne sont pas autorisées +% You are trying to assign an overloaded function to a procedural variable. +% This is not allowed +parser_e_invalid_string_size=03041_E_La longueur d'une chaîne doit être comprise entre 1 et 255 +% The length of a shortstring in Pascal is limited to 255 characters. You are +% trying to declare a string with length lower than 1 or greater than 255 +parser_w_use_extended_syntax_for_objects=03042_W_Utilisez la syntaxe étendue de NEW et DISPOSE pour les instances d'objet +% If you have a pointer \var{a} to a class type, then the statement +% \var{new(a)} will not initialize the class (i.e. the constructor isn't +% called), although space will be allocated. you should issue the +% \var{new(a,init)} statement. This will allocate space, and call the +% constructor of the object +parser_w_no_new_dispose_on_void_pointers=03043_W_L'usage de NEW ou DISPOSE pour des pointeurs non typés n'a pas de sens +parser_e_no_new_dispose_on_void_pointers=03044_E_L'usage de NEW ou DISPOSE pour des pointeurs non typés est impossible +% You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer +% because no size is associated to an untyped pointer. +% Accepted for compatibility in \var{tp} and \var{delphi} modes. +parser_e_class_id_expected=03045_E_Identificateur de classe attendu +% This happens when the compiler scans a procedure declaration that contains +% a dot, +% i.e., a object or class method, but the type in front of the dot is not +% a known type. +parser_e_no_type_not_allowed_here=03046_E_Identificateur de type interdit ici +% You cannot use a type inside an expression. +parser_e_methode_id_expected=03047_E_Identificateur de méthode attendu +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_e_header_dont_match_any_member=03048_E_L'en-tête de la fonction ne correspond à aucune méthode de cette classe "$1" +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_d_procedure_start=03049_DL_procédure/fonction $1 +% When using the \var{-vd} switch, the compiler tells you when it starts +% processing a procedure or function implementation. +parser_e_error_in_real=03050_E_Constante réelle illégale +% The compiler expects a floating point expression, and gets something else. +parser_e_fail_only_in_constructor=03051_E_FAIL ne peut être utilisé que dans un constructeur +% You are using the \var{fail} keyword outside a constructor method. +parser_e_no_paras_for_destructor=03052_E_Les destructeurs ne peuvent pas avoir de paramètres +% You are declaring a destructor with a parameter list. Destructor methods +% cannot have parameters. +parser_e_only_class_methods_via_class_ref=03053_E_Seules des références de classe peuvent faire référence à des méthodes de classe +% This error occurs in a situation like the following: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} is not a class method and hence cannot be called with a class +% reference. +parser_e_only_class_methods=03054_E_Seules des méthodes de classe peuvent être appelées dans des méthodes de classe +% This is related to the previous error. You cannot call a method of an object +% from a inside a class method. The following code would produce this error: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% Because free is a normal method of a class it cannot be called from a class +% method. +parser_e_case_mismatch=03055_E_La constante et l'instruction CASE ne sont pas du même type +% One of the labels is not of the same type as the case variable. +parser_e_illegal_symbol_exported=03056_E_Le symbole ne peut pas être exporté depuis une bibliothèque +% You can only export procedures and functions when you write a library. You +% cannot export variables or constants. +parser_w_should_use_override=03057_W_Une méthode héritée est cachée par "$1" +% A method that is declared \var{virtual} in a parent class, should be +% overridden in the descendent class with the \var{override} directive. If you +% don't specify the \var{override} directive, you will hide the parent method; +% you will not override it. +parser_e_nothing_to_be_overridden=03058_E_Il n'y a pas de méthode dans la classe ancêtre que l'on peut surcharger : "$1" +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_no_procedure_to_access_property=03059_E_Aucun membre n'est fourni pour accéder à la propriété +% You specified no \var{read} directive for a property. +parser_w_stored_not_implemented=03060_W_Directive de propriété stockée non encore implementée +% The \var{stored} directive is not yet implemented +parser_e_ill_property_access_sym=03061_E_Symbole illégal pour l'accès à la propriété +% There is an error in the \var{read} or \var{write} directives for an array +% property. When you declare an array property, you can only access it with +% procedures and functions. The following code would cause such an error. +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_Impossible d'accéder aux champs "protected" d'un object ici +% Fields that are declared in a \var{protected} section of an object or class +% declaration cannot be accessed outside the module where the object is +% defined, or outside descendent object methods. +parser_e_cant_access_private_member=03063_E_Impossible d'accéder aux champs "private" d'un object ici +% Fields that are declared in a \var{private} section of an object or class +% declaration cannot be accessed outside the module where the class is +% defined. +parser_e_overridden_methods_not_same_ret=03066_E_Les méthodes surchargées doivent renvoyer le même type: "$2" est surchargée par "$1" qui retourne un type différent +% If you declare overridden methods in a class definition, they must +% have the same return type. +parser_e_dont_nest_export=03067_E_Les fonctions déclarées comme EXPORT ne peuvent pas être imbriquées +% You cannot declare a function or procedure within a function or procedure +% that was declared as an export procedure. +parser_e_methods_dont_be_export=03068_E_Les méthodes ne peuvent pas être EXPORTées +% You cannot declare a procedure that is a method for an object as +% \var{export}ed. +parser_e_call_by_ref_without_typeconv=03069_E_Les paramètres passés par adresse doivent être du même type que la déclaration: "$1" spécifié mais "$2" attendu +% When calling a function declared with \var{var} parameters, the variables in +% the function call must be of exactly the same type. There is no automatic +% type conversion. +parser_e_no_super_class=03070_E_Cette classe n'est pas un parent de la classe actuelle +% When calling inherited methods, you are trying to call a method of a non-related +% class. You can only call an inherited method of a parent class. +parser_e_self_not_in_method=03071_E_Self n'est possible que dans les méthodes +% You are trying to use the \var{self} parameter outside an object's method. +% Only methods get passed the \var{self} parameters. +parser_e_generic_methods_only_in_methods=03072_E_Une méthode ne peut être appelée avec son identificateur de classe qu'à partir d'une méthode +% A construction like \var{sometype.somemethod} is only allowed in a method. +parser_e_illegal_colon_qualifier=03073_E_Utilisation non valide de ':' +% You are using the format \var{:} (colon) 2 times on an expression that +% is not a real expression. +parser_e_illegal_set_expr=03074_E_Erreur d'intervalle dans un constructeur d'ensemble ou élément d'ensemble dupliqué +% The declaration of a set contains an error. Either one of the elements is +% outside the range of the set type, either two of the elements are in fact +% the same. +parser_e_pointer_to_class_expected=03075_E_Pointeur sur un objet attendu +% You specified an illegal type in a \var{new} statement. +% The extended syntax of \var{new} needs an object as a parameter. +parser_e_expr_have_to_be_constructor_call=03076_E_L'expression doit être un appel à un constructeur +% When using the extended syntax of \var{new}, you must specify the constructor +% method of the object you are trying to create. The procedure you specified +% is not a constructor. +parser_e_expr_have_to_be_destructor_call=03077_E_L'expression doit être un appel à un destructeur +% When using the extended syntax of \var{dispose}, you must specify the +% destructor method of the object you are trying to dispose of. +% The procedure you specified is not a destructor. +parser_e_invalid_record_const=03078_E_Mauvais ordre des éléments d'un record +% When declaring a constant record, you specified the fields in the wrong +% order. +parser_e_false_with_expr=03079_E_L'expression doit être une classe ou un record +% A \var{with} statement needs an argument that is of the type \var{record} +% or \var{class}. You are using \var{with} on an expression that is not of +% this type. +parser_e_void_function=03080_E_Les procédures ne peuvent pas retourner une valeur +% In \fpc, you can specify a return value for a function when using +% the \var{exit} statement. This error occurs when you try to do this with a +% procedure. Procedures cannot return a value. +parser_e_only_methods_allowed=03081_E_Les constructeurs, les destructeurs et les class operators doivent être des méthodes +% You're declaring a procedure as destructor, constructor or class operators, when the +% procedure isn't a class method. +parser_e_operator_not_overloaded=03082_E_L'opérateur n'est pas surchargé +% You're trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_no_such_assignment=03083_E_Impossible de surcharger l'affectation de types équivalents +% You can not overload assignment for types +% that the compiler considers as equal. +parser_e_overload_impossible=03084_E_Surcharge d'opérateur impossible +% The combination of operator, arguments and return type are +% incompatible. +parser_e_no_reraise_possible=03085_E_Redéclenchement d'exception impossible ici +% You are trying to raise an exception where it is not allowed. You can only +% raise exceptions in an \var{except} block. +parser_e_no_new_or_dispose_for_classes=03086_E_La syntaxe étendue de new ou dispose n'est pas autorisée pour une classe +% You cannot generate an instance of a class with the extended syntax of +% \var{new}. The constructor must be used for that. For the same reason, you +% cannot call \var{dispose} to de-allocate an instance of a class, the +% destructor must be used for that. +parser_e_procedure_overloading_is_off=03088_E_La surcharge de procédures est désactivée +% When using the \var{-So} switch, procedure overloading is switched off. +% Turbo Pascal does not support function overloading. +parser_e_overload_operator_failed=03089_E_Impossible de surcharger cet opérateur +% You are trying to overload an operator which cannot be overloaded. +% The following operators can be overloaded : +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_Un opératuer de comparaison doit retourner une valeur booléenne +% When overloading the \var{=} operator, the function must return a boolean +% value. +parser_e_only_virtual_methods_abstract=03091_E_Seules les méthodes virtuelles peuvent être abstraites +% You are declaring a method as abstract, when it is not declared to be +% virtual. +parser_f_unsupported_feature=03092_F_Utilisation d'une caractéristique non supportée ! +% You're trying to force the compiler into doing something it cannot do yet. +parser_e_mix_of_classes_and_objects=03093_E_Le mélange de différents types d'objets (classe, objet, interface, etc.) est interdit +% You cannot derive \var{objects}, \var{classes}, \var{cppclasses} and \var{interfaces} interttwined . E.g. +% a class cannot have an object as parent and vice versa. +parser_w_unknown_proc_directive_ignored=03094_W_Une directive de procédure inconnue a due être ignorée : "$1" +% The procedure directive you specified is unknown. +parser_e_absolute_only_one_var=03095_E_absolute ne peut être associé qu'à une seule variable +% You cannot specify more than one variable before the \var{absolute} directive. +% Thus, the following construct will provide this error: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +% \item [ absolute can only be associated a var or const ] +% The address of a \var{absolute} directive can only point to a variable or a +% typed constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_absolute_only_to_var_or_const=03096_E_absolute ne peut être associé qu'à une variable ou une constante +% The address of a \var{absolute} directive can only point to a variable or +% constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_initialized_only_one_var=03097_E_Seule UNE variable peut être initialisée +% You cannot specify more than one variable with a initial value +% in Delphi mode. +parser_e_abstract_no_definition=03098_E_Les méthodes abstraites ne doivent pas avoir d'implementation +% Abstract methods can only be declared, you cannot implement them. They +% should be overridden by a descendant class. +parser_e_overloaded_must_be_all_global=03099_E_Cette fonction surchargée ne peut pas être locale (elle doit être exportée) +% You are defining a overloaded function in the implementation part of a unit, +% but there is no corresponding declaration in the interface part of the unit. +parser_w_virtual_without_constructor=03100_W_Des méthodes virtuelles sont utilisées sans constructeur dans "$1" +% If you declare objects or classes that contain virtual methods, you need +% to have a constructor and destructor to initialize them. The compiler +% encountered an object or class with virtual methods that doesn't have +% a constructor/destructor pair. +parser_c_macro_defined=03101_CL_Macro définie: $1 +% When \var{-vc} is used, the compiler tells you when it defines macros. +parser_c_macro_undefined=03102_CL_Macro non défine: $1 +% When \var{-vc} is used, the compiler tells you when it undefines macros. +parser_c_macro_set_to=03103_CL_Macro $1 définie à $2 +% When \var{-vc} is used, the compiler tells you what values macros get. +parser_i_compiling=03104_I_Compilation de $1 +% When you turn on information messages (\var{-vi}), the compiler tells you +% what units it is recompiling. +parser_u_parsing_interface=03105_U_Analyse syntaxique de l'interface de l'unité $1 +% This tells you that the reading of the interface +% of the current unit starts +parser_u_parsing_implementation=03106_U_Analyse syntaxique de l'implémentation de $1 +% This tells you that the code reading of the implementation +% of the current unit, library or program starts +parser_d_compiling_second_time=03107_DL_Compilation de $1 pour la seconde fois +% When you request debug messages (\var{-vd}) the compiler tells you what +% units it recompiles for the second time. +parser_e_no_property_found_to_override=03109_E_Aucune propriété à surcharger n'a été trouvée +% You want to override a property of a parent class, when there is, in fact, +% no such property in the parent class. +parser_e_only_one_default_property=03110_E_Une seule propriété par défaut est autorisée +% You specified a property as \var{Default}, but the class already has a +% default property, and a class can have only one default property. +parser_e_property_need_paras=03111_E_La propriété par défaut doit être de type tableau +% Only array properties of classes can be made \var{default} properties. +parser_e_constructor_cannot_be_not_virtual=03112_E_Les constructeurs virtuels ne sont possibles que pour les classes +% You cannot have virtual constructors in objects. You can only have them +% in classes. +parser_e_no_default_property_available=03113_E_Pas de propriété par défaut disponible +% You are trying to access a default property of a class, but this class (or one of +% its ancestors) doesn't have a default property. +parser_e_cant_have_published=03114_E_La classe ne peut pas avoir une section "published", utilisez le commutateur {$M+} +% If you want a \var{published} section in a class definition, you must +% use the \var{\{\$M+\}} switch, whch turns on generation of type +% information. +parser_e_forward_declaration_must_be_resolved=03115_E_La déclaration anticipée de la classe "$1" doit être résolue ici pour pouvoir utiliser la classe comme ancêtre +% To be able to use an object as an ancestor object, it must be defined +% first. This error occurs in the following situation: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% Where \var{ParentClass} is declared but not defined. +parser_e_no_local_operator=03116_E_Les opérateurs locaux ne sont pas supportés +% You cannot overload locally, i.e. inside procedures or function +% definitions. +parser_e_proc_dir_not_allowed_in_interface=03117_E_La directive de procédure "$1" n'est pas autorisée dans la section interface +% This procedure directive is not allowed in the \var{interface} section of +% a unit. You can only use it in the \var{implementation} section. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_La directive de procédure "$1" n'est pas autorisée dans la section implementation +% This procedure directive is not defined in the \var{implementation} section of +% a unit. You can only use it in the \var{interface} section. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_La directive de procédure "$1" n'est pas autorisée dans la déclaration +% This procedure directive cannot be part of a procedural or function +% type declaration. +parser_e_function_already_declared_public_forward=03120_E_La fonction "$1" est déjà déclarée comme Public ou Forward +% You will get this error if a function is defined as \var{forward} twice. +% Or it is once in the \var{interface} section, and once as a \var{forward} +% declaration in the \var{implmentation} section. +parser_e_not_external_and_export=03121_E_Impossible d'utiliser à la fois EXPORT et EXTERNAL +% These two procedure directives are mutually exclusive +parser_w_not_supported_for_inline=03123_W_"$1" n'est pas encore supporté à l'intérieur de procédures/fonctions INLINE +% Inline procedures don't support this declaration. +parser_w_inlining_disabled=03124_W_Inlining désactivé +% Inlining of procedures is disabled. +parser_i_writing_browser_log=03125_I_Ecriture du Browser log $1 +% When information messages are on, the compiler warns you when it +% writes the browser log (generated with the \var{\{\$Y+ \}} switch). +parser_h_maybe_deref_caret_missing=03126_H_Le déréférencement du pointeur semble manquer +% The compiler thinks that a pointer may need a dereference. +parser_f_assembler_reader_not_supported=03127_F_Lecteur de code assembleur sélectionné non supporté +% The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not +% supported. The compiler can be compiled with or without support for a +% particular assembler reader. +parser_e_proc_dir_conflict=03128_E_La directive de procédure "$1" entre en conflit avec d'autres directives +% You specified a procedure directive that conflicts with other directives. +% for instance \var{cdecl} and \var{pascal} are mutually exclusive. +parser_e_call_convention_dont_match_forward=03129_E_La convention d'appel ne correspond pas à la déclaration anticipée +% This error happens when you declare a function or procedure with +% e.g. \var{cdecl;} but omit this directive in the implementation, or vice +% versa. The calling convention is part of the function declaration, and +% must be repeated in the function definition. +parser_e_property_cant_have_a_default_value=03131_E_Cette propriété ne peut pas avoir de valeur par défaut +% Set properties or indexed properties cannot have a default value. +parser_e_property_default_value_must_const=03132_E_La valeur par défaut d'une propriété doit être une constante +% The value of a \var{default} declared property must be known at compile +% time. The value you specified is only known at run time. This happens +% .e.g. if you specify a variable name as a default value. +parser_e_cant_publish_that=03133_E_Ce symbole ne peut pas être "published", il ne peut être qu'une classe +% Only class type variables can be in a \var{published} section of a class +% if they are not declared as a property. +parser_e_cant_publish_that_property=03134_E_Ce genre de propriété ne peut pas être PUBLISHED +% Properties in a \var{published} section cannot be array properties. +% they must be moved to public sections. Properties in a \var{published} +% section must be an ordinal type, a real type, strings or sets. +parser_e_empty_import_name=03136_W_Un nom d'import est requis +% Some targets need a name for the imported procedure or a \var{cdecl} specifier +parser_e_division_by_zero=03138_E_Division par zéro +% There is a division by zero encounted +parser_e_invalid_float_operation=03139_E_Opération en virgule flottante invalide +% An operation on two real type values produced an overflow or a division +% by zero. +parser_e_array_lower_less_than_upper_bound=03140_E_Limite supérieure de l'intervalle plus petite que la limite inférieure +% The upper bound of a an array declaration is less than the lower bound and this +% is not possible +parser_w_string_too_long=03141_W_La chaîne "$1" est plus longue que $2 +% The size of the constant string is larger than the size you specified in +% string type definition +parser_e_string_larger_array=03142_E_Longueur de chaîne supérieure à la longueur d'un tableau de caractères +% The size of the constant string is larger than the size you specified in +% the array[x..y] of char definition +parser_e_ill_msg_expr=03143_E_Expression illégale après la directive Message +% \fpc supports only integer or string values as message constants +parser_e_ill_msg_param=03144_E_Les gestionnaires de message ne peuvent accepter qu'un paramètre par référence +% A method declared with the \var{message}-directive as message handler +% can take only one parameter which must be declared as call by reference +% Parameters are declared as call by reference using the \var{var}-directive +parser_e_duplicate_message_label=03145_E_Message dupliqué dans un objet ou une classe: "%1" +% A label for a message is used twice in one object/class +parser_e_self_in_non_message_handler=03146_E_Self ne peut être qu'un paramètre explicite dans les gestionnaires de message +% The self parameter can only be passed explicitly to a method which +% is declared as message handler. +parser_e_threadvars_only_sg=03147_E_Les variables de Threads peuvent seulement être statiques ou globales +% Threadvars must be static or global, you can't declare a thread +% local to a procedure. Local variables are always local to a thread, +% because every thread has its own stack and local variables +% are stored on the stack +parser_f_direct_assembler_not_allowed=03148_F_Assembleur direct non supporté pour la sortie binaire +% You can't use direct assembler when using a binary writer, choose an +% other outputformat or use another assembler reader +parser_w_no_objpas_use_mode=03149_W_Ne chargez pas l'unité OBJPAS manuellement, utilisez de préférence \{\$mode Objfpc\} ou \{\$mode Delphi\} +% You are trying to load the ObjPas unit manually from a uses clause. This is +% not a good idea. Use the \var{\{\$mode objfpc\}} or +% \var{\{\$mode delphi\}} +% directives which load the unit automatically +parser_e_no_object_override=03150_E_OVERRIDE ne peut pas être utilisé avec des objets +% Override is not supported for objects, use \var{virtual} instead to override +% a method of a parent object +parser_e_cant_use_inittable_here=03151_E_Les types de données nécessitant une initialisation/finalisation ne peuvent pas être utilisés dans des records variants +% Some data type (e.g. \var{ansistring}) needs initialization/finalization +% code which is implicitly generated by the compiler. Such data types +% can't be used in the variant part of a record. +parser_e_resourcestring_only_sg=03152_E_Les chaînes de ressource ne peuvent être que statiques ou globales +% Resourcestring can not be declared local, only global or using the static +% directive. +parser_e_exit_with_argument_not__possible=03153_E_Exit avec un argument ne peut pas être utilisé ici +% an exit statement with an argument for the return value can't be used here, this +% can happen e.g. in \var{try..except} or \var{try..finally} blocks +parser_e_stored_property_must_be_boolean=03154_E_Le type du symbole STORED doit être un booléen +% If you specify a storage symbol in a property declaration, it must be of +% the type boolean +parser_e_ill_property_storage_sym=03155_E_Ce symbole n'est pas admis comme symbole STORED +% You can't use this type of symbol as storage specifier in property +% declaration. You can use only methods with the result type boolean, +% boolean class fields or boolean constants +parser_e_only_publishable_classes_can__be_published=03156_E_Seules les classes compilées avec le mode $M+ peuvent être PUBLISHED +% In the published section of a class can be only class as fields used which +% are compiled in \var{\{\$M+\}} or which are derived from such a class. Normally +% such a class should be derived from TPersitent +parser_e_proc_directive_expected=03157_E_Directive de procédure attendue +% This error is triggered when you have a \var{\{\$Calling\}} directive without +% a calling convention specified. +% It also happens when declaring a procedure in a const block and you +% used a ; after a procedure declaration which must be followed by a +% procedure directive. +% Correct declarations are: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_La valeur d'un index de propriété doit être de type scalaire +% The value you use to index a property must be of an ordinal type, for +% example an integer or enumerated type. +parser_e_procname_to_short_for_export=03159_E_Nom de procédure trop court pour être exporté +% The length of the procedure/function name must be at least 2 characters +% long. This is because of a bug in dlltool which doesn't parse the .def +% file correct with a name of length 1. +parser_e_dlltool_unit_var_problem=03160_E_Impossible de créer une entrée DEFFILE pour des variables globales d'unité +parser_e_dlltool_unit_var_problem2=03161_E_Compilez sans l'option -WD +% You need to compile this file without the -WD switch on the +% commandline +parser_f_need_objfpc_or_delphi_mode=03162_F_Vous devez utilisez le mode ObjFpc (-S2) ou Delphi (-Sd) pour compiler ce module +% You need to use \{\$mode objfpc\} or \{\$mode delphi\} to compile this file. +% Or use the equivalent commandline switches -S2 or -Sd. +parser_e_no_export_with_index_for_target=03163_E_Impossible d'exporter avec un index sous $1 +% Exporting of functions or procedures with a specified index is not +% supported on this target. +parser_e_no_export_of_variables_for_target=03164_E_L'export de variables n'est pas supporté sous $1 +% Exporting of variables is not supported on this target. +parser_e_improper_guid_syntax=03165_E_Syntaxe GUID incorrecte +% The GUID indication does not have the proper syntax. It should be of the form +% \begin{verbatim} +% {XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX} +% \end{verbatim} +% Where each \var{X} represents a hexadecimal digit. +parser_w_interface_mapping_notfound=03168_W_Impossible de trouver la procédure nommée "$1" nécessaire à l'implémentation de $2.$3 +% The compiler cannot find a suitable procedure which implements the given method of an interface. +% A procedure with the same name is found, but the arguments do not match. +parser_e_interface_id_expected=03169_E_Identificateur d'interface attendu +% This happens when the compiler scans a \var{class} declaration that contains +% \var{interface} function name mapping code like this: +% \begin{verbatim} +% type +% TMyObject = class(TObject, IDispatch) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% and the \var{interface} before the dot not listed in the inheritance list. +parser_e_type_cant_be_used_in_array_index=03170_E_Le type "$1" ne peut être utilisé comme indice de tableau +% Types like \var{qword} or \var{int64} aren't allowed as array index type +parser_e_no_con_des_in_interfaces=03171_E_Constructeurs et destructeurs ne sont pas autorisés dans les interfaces +% Constructor and destructor declarations aren't allowed in interface +% In the most cases the method \var{QueryInterface} of \var{IUnknown} can +% be used to create a new interface. +parser_e_no_access_specifier_in_interfaces=03172_E_Les descripteurs de portée ne peuvent pas être utilisés dans les INTERFACES +% The access specifiers \var{public}, \var{private}, \var{protected} and +% \var{pusblished} can't be used in interfaces because all methods +% of an interfaces must be public. +parser_e_no_vars_in_interfaces=03173_E_Une interface ne peut pas contenir de propriétés +% Declarations of fields aren't allowed in interfaces. An interface +% can contain only methods +parser_e_no_local_proc_external=03174_E_Impossible de déclarer une procédure locale comme EXTERNAL +% Declaring local procedures as external is not possible. Local procedures +% get hidden parameters that will make the chance of errors very high +parser_w_skipped_fields_before=03175_W_Certaines propriétés avant "$1" n'ont pas été initialisées +% In Delphi mode, not all fields of a typed constant record have to be +% initialized, but the compiler warns you when it detects such situations. +parser_e_skipped_fields_before=03176_E_Certaines propriétés situées avant "$1" n'ont pas été initialisées +% In all syntax modes but Delphi mode, you can't leave some fields uninitialized +% in the middle of a typed constant record +parser_w_skipped_fields_after=03177_W_Certaines propriétés après "$1" n'ont pas été initialisées +% You can leave some fields at the end of a type constant record uninitialized +% (the compiler will initialize them to zero automatically). This may be the cause +% of subtle problems. +parser_e_varargs_need_cdecl_and_external=03178_E_Directive VarArgs sans CDecl ni External +% The varargs directive can only be used with procedures or functions +% that are declared with \var{cdecl} and \var{external} directives. The varargs directive +% is only meant to provide a compatible interface to C functions like printf. +parser_e_self_call_by_value=03179_E_Self doit être un paramètre normal (appel par valeur) +% You can't declare self as a const or var parameter, it must always be +% a call-by-value parameter +parser_e_interface_has_no_guid=03180_E_L'interface "$1" n'a pas d'identification d'interface +% When you want to assign an interface to a constant, then the interface +% must have a GUID value set. +parser_e_illegal_field_or_method=03181_E_Champ de classe ou identificateur de méthode "$1" inconnu +% Properties must refer to a field or method in the same class. +parser_w_proc_overriding_calling=03182_W_Surcharge de la convention d'appel "$1" avec "$2" +% There are two directives in the procedure declaration that specify a calling +% convention. Only the last directive will be used +parser_e_no_procvarobj_const=03183_E_Les constantes typées de la forme "procedure of object" ne peuvent être initialisées qu'avec NIL +% You can't assign the address of a method to a typed constant which has a +% 'procedure of object' type, because such a constant requires two addresses: +% that of the method (which is known at compile time) and that of the object or +% class instance it operates on (which can not be known at compile time). +parser_e_default_value_only_one_para=03184_E_Une valeur par défaut ne peut être affectée qu'à un paramètre +% It is not possible to specify a default value for several parameters at once. +% The following is invalid: +% \begin{verbatim} +% Procedure MyProcedure (A,B : Integer = 0); +% \end{verbatim} +% Instead, this should be declared as +% \begin{verbatim} +% Procedure MyProcedure (A : Integer = 0; B : Integer = 0); +% \end{verbatim} +parser_e_default_value_expected_for_para=03185_E_Paramètre par défaut requis pour "$1" +% The specified parameter requires a default value. +parser_w_unsupported_feature=03186_W_Fonctionnalité non supportée +% You're trying to force the compiler into doing something it cannot do yet. +parser_h_c_arrays_are_references=03187_H_Les tableaux C sont passés par référence +% Any array passed to a C functions is passed +% by a pointer (i.e. by reference). +parser_e_C_array_of_const_must_be_last=03188_E_Un tableau de constantes C doit être le dernier argument +% You can not add any other argument after an \var{array of const} for +% \var{cdecl} functions, as the size pushed on stack for this argument is +% not known. +parser_h_type_redef=03189_H_Redéfinition du Type "$1" +% This is an indicator that a previously declared type is +% being redefined as something else. This may, or may not +% be, a cause for errors. +parser_w_cdecl_has_no_high=03190_W_les fonctions cdecl n'ont pas de paramètre implicite +% Functions declared with cdecl modifier do not pass an extra implicit parameter. +parser_w_cdecl_no_openstring=03191_W_Les fonctions cdecl n'acceptent pas les chaînes ouvertes +% Openstring is not supported for cdecl'ared functions. +parser_e_initialized_not_for_threadvar=03192_E_Impossible d'initialiser des variables de thread +% Variables declared as threadvar can not be initialized with a default value. +% The variables will always be filled with zero at the start of a new thread. +parser_e_msg_only_for_classes=03193_E_La directive Message n'est autorisée que dans les classes +% The message directive is only supported for Class types. +parser_e_procedure_or_function_expected=03194_E_Procédure ou foncction attendue +% A class method can only be specified for procedures and functions. +parser_e_illegal_calling_convention=03195_W_Directive de convention d'appel ignorée: "$1" +% Some calling conventions are supported only by certain CPUs. I.e. most non-i386 ports support +% only the standard ABI calling convention of the CPU. +parser_e_no_object_reintroduce=03196_E_REINTRODUCE ne peut pas être utilisé avec des objets +% \var{reintroduce} is not supported for objects. +parser_e_paraloc_only_one_para=03197_E_Chaque argument doit avoir son propre emplacement +% If locations for arguments are specified explicitly as it is required by +% some syscall conventions, each argument must have it's only location, things +% like \var{procedure p(i,j : longint 'r1');} aren't allowed +parser_e_paraloc_all_paras=03198_E_Chaque argument doit avoir un emplacement explicite +% If one argument has an explicit argument location, all arguments of a procedure +% must have one. +parser_e_illegal_explicit_paraloc=03199_E_Emplacement d'argument inconnu +% The location specified for an argument isn't recognized by the compiler +parser_e_32bitint_or_pointer_variable_expected=03200_E_Variable entière sur 32 bits ou pointeur attendu +% The libbase for MorphOS/AmigaOS can be give only as \var{longint}, \var{dword} or any pointer variable. +parser_e_goto_outside_proc=03201_E_Les instructions Goto ne sont pas autorisées entre procédures différentes +% It isn't allowed to use the \var{goto} statements referencing labels outside the +% current procedure. The following example shows the problem: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1; +% +% procedure p2; +% begin +% goto l1; // This goto ISN'T allowed +% end; +% +% begin +% p2 +% l1: +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_Procédure trop complexe, nécessite trop de registres +% Your procedure body is too long for the compiler. You should split the +% procedure into multiple smaller procedures. +parser_e_illegal_expression=03203_E_Expression illégale +% This can occur under many circumstances. Mostly when trying to evaluate +% constant expressions. +parser_e_invalid_integer=03204_E_Expression entière incorrecte +% You made an expression which isn't an integer, and the compiler expects the +% result to be an integer. +parser_e_invalid_qualifier=03205_E_Qualificateur incorrect +% One of the following is happening : +% \begin{itemize} +% \item You're trying to access a field of a variable that is not a record. +% \item You're indexing a variable that is not an array. +% \item You're dereferencing a variable that is not a pointer. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_Limite haute < limite basse +% You are declaring a subrange, and the lower limit is higher than the high +% limit of the range. +parser_e_macpas_exit_wrong_param=03207_E_Le paramètre de sortie doit être le nom de la procédure dans laquelle il est utilisé +% Non local exit is not allowed. This error occurs only in mode MacPas. +parser_e_illegal_assignment_to_count_var=03208_E_Affectation illégale à la variable de boucle for "$1" +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. You can also not assign values to +% loop variables inside the loop (except in Delphi and TP modes). Use a while or +% repeat loop instead if you need to do something like that, since those +% constructs were built for that. +parser_e_no_local_var_external=03209_E_Impossible de déclarer une variable locale comme EXTERNAL +% Declaring local variables as external is not allowed. Only global variables can reference +% to external variables. +parser_e_proc_already_external=03210_E_Procédure déjà déclarée EXTERNAL +% The procedure is already declared with the EXTERNAL directive in an interface or +% forward declaration. +parser_w_implicit_uses_of_variants_unit=03211_W_Utilisation implicite de l'unité Variants +% The Variant type is used in the unit without any used unit using the Variants unit. The +% compiler has implicitly added the Variants unit to the uses list. To remove this warning +% the Variants unit needs to be added to the uses statement. +parser_e_no_static_method_in_interfaces=03212_E_Les méthodes de classe et les méthodes statiques ne peuvent pas être utilisées dans les interfaces +% The specifier \var{class} and directive \var{static} can't be used in interfaces +% because all methods of an interfaces must be public. +parser_e_arithmetic_operation_overflow=03213_E_Dépassement dans une opération arithmétique +% An operation on two integers values produced an overflow +parser_e_protected_or_private_expected=03214_E_Protected ou private attendu +% \var{strict} can be only used together with \var{protected} or \var{private}. +parser_e_illegal_slice=03215_E_SLICE ne peut pas être utilisée en dehors d'une liste de paramètres +% \var{slice} can be used only for arguments accepting an open array parameter +parser_e_dispinterface_cant_have_parent=03216_E_Une DISPINTERFACE ne peut pas avoir de classe parent +% A DISPINMTERFACE is a special type of interface which can't have a parent class +parser_e_dispinterface_needs_a_guid=03217_E_Une DISPINTERFACE requiert un GUID +% A DISPINMTERFACE always needs an interface identification +parser_w_overridden_methods_not_same_ret=03218_W_Les méthodes surchargées doivent avoir un type de résultat similaire. Ce code peut "crasher", il dépend d'un bug de l'analyseur syntaxique de Delphi ("$2" est surchargé par "$1" qui a un type de résultat différent) +% If you declare overridden methods in a class definition, they must +% have the same return type. Some versions of Delphi allow you to change the +% return type of interface methods, and even to change procedures into +% functions, but the resulting code may crash depending on the types used +% and the way the methods are called. +parser_e_dispid_must_be_ord_const=03219_E_Les Dispatch ID doivent être des constantes scalaires +% \end{description} +# +# Type Checking +# +# 04049 is the last used one +# +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +type_e_mismatch=04000_E_Type non valable +% This can happen in many cases: +% \begin{itemize} +% \item The variable you're assigning to is of a different type than the +% expression in the assignment. +% \item You are calling a function or procedure with parameters that are +% incompatible with the parameters in the function or procedure definition. +% \end{itemize} +type_e_incompatible_types=04001_E_Types incompatibles: $1 spécifié mais $2 attendu +% There is no conversion possible between the two types +% Another possiblity is that they are declared in different +% declarations: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { This statement gives also this error, it +% is due the strict type checking of pascal } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_Incompatibilité de types entre $1 et $2 +% The types are not equal +type_e_type_id_expected=04003_E_Identificateur de type attendu +% The identifier is not a type, or you forgot to supply a type identifier. +type_e_variable_id_expected=04004_E_Identificateur de variable attendu +% This happens when you pass a constant to a routine (such as \var{Inc} var or \var{Dec}) +% when it expects a variable. You can only pass variables as arguments to these functions. +type_e_integer_expr_expected=04005_E_Expression entière attendue, "$1" spécifié +% The compiler expects an expression of type integer, but gets a different +% type. +type_e_boolean_expr_expected=04006_E_Expression booléenne attendue mais "$1" spécifié +% The expression must be a boolean type, it should be return true or +% false. +type_e_ordinal_expr_expected=04007_E_Expression ordinale attendue +% The expression must be of ordinal type, i.e., maximum a \var{Longint}. +% This happens, for instance, when you specify a second argument +% to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value. +type_e_pointer_type_expected=04008_E_Type pointeur attendu, "$1" spécifié +% The variable or expression isn't of the type \var{pointer}. This +% happens when you pass a variable that isn't a pointer to \var{New} +% or \var{Dispose}. +type_e_class_type_expected=04009_E_Type classe attendu mais "$1" spécifié +% The variable of expression isn't of the type \var{class}. This happens +% typically when +% \begin{enumerate} +% \item The parent class in a class declaration isn't a class. +% \item An exception handler (\var{On}) contains a type identifier that +% isn't a class. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_Impossible d'évaluer l'expression constante +% This error can occur when the bounds of an array you declared does +% not evaluate to ordinal constants +type_e_set_element_are_not_comp=04012_E_Éléments de l'ensemble incompatibles +% You are trying to make an operation on two sets, when the set element types +% are not the same. The base type of a set must be the same when taking the +% union +type_e_set_operation_unknown=04013_E_Opération non implémentée pour des ensembles +% several binary operations are not defined for sets +% like div mod ** (also >= <= for now) +type_w_convert_real_2_comp=04014_W_Conversion automatique d'un réel vers COMP qui est un type entier +% An implicit type conversion from a real type to a \var{comp} is +% encountered. Since \var{comp} is a 64 bit integer type, this may indicate +% an error. +type_h_use_div_for_int=04015_H_Utilisez DIV pour obtenir un résultat entier +% When hints are on, then an integer division with the '/' operator will +% procuce this message, because the result will then be of type real +type_e_strict_var_string_violation=04016_E_Types de chaînes incompatibles à cause du mode $V+ +% When compiling in \var{\{\$V+\}} mode, the string you pass as a parameter +% should be of the exact same type as the declared parameter of the procedure. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_Succ ou Pred impossible pour des énumérations contenant des affectations +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use the \var{Succ} or \var{Pred} functions on them. +type_e_cant_read_write_type=04018_E_Impossible de lire ou d'écrire des variables de ce type +% You are trying to \var{read} or \var{write} a variable from or to a +% file of type text, which doesn't support that. Only integer types, +% reals, pchars and strings can be read from/written to a text file. +% Booleans can only be written to text files. +type_e_no_readln_writeln_for_typed_file=04019_E_Impossible d'utiliser ReadLn ou WriteLn sur un ficher typé +% \var{readln} and \var{writeln} are only allowed for text files. +type_e_no_read_write_for_untyped_file=04020_E_Impossible d'utiliser Read ou Write sur un fichier non typé +% \var{read} and \var{write} are only allowed for text or typed files. +type_e_typeconflict_in_set=04021_E_Conflit de type dans les éléments de l'ensemble +% There is at least one set element which is of the wrong type, i.e. not of +% the set type. +type_w_maybe_wrong_hi_lo=04022_W_Lo/Hi(Longint/DWord) retourne le mot ou le double mot de poids fort ou de poids faible +% \fpc supports an overloaded version of \var{lo/hi} for \var{longint/dword/int64/qword} +% which returns the lower/upper word/dword of the argument. TP always uses +% a 16 bit \var{lo/hi} which returns always bits 0..7 for \var{lo} and the +% bits 8..15 for \var{hi}. If you want the TP behavior you have +% to type cast the argument to \var{word/integer} +type_e_integer_or_real_expr_expected=04023_E_Expression entière ou réelle attendue +% The first argument to \var{str} must a real or integer type. +type_e_wrong_type_in_array_constructor=04024_E_Mauvais type "$1" dans le constructeur +% You are trying to use a type in an array constructor which is not +% allowed. +type_e_wrong_parameter_type=04025_E_Type incompatible pour l'argument no. $1: $2 spécifié au lieu de $3 +% You are trying to pass an invalid type for the specified parameter. +type_e_no_method_and_procedure_not_compatible=04026_E_Méthodes (variable) et procédures (variable) sont incompatibles +% You can't assign a method to a procedure variable or a procedure to a +% method pointer. +type_e_wrong_math_argument=04027_E_Constante invalide passée à une fonction mathématique interne +% The constant argument passed to a ln or sqrt function is out of +% the definition range of these functions. +type_e_no_addr_of_constant=04028_E_Impossible d'obtenir l'adresse des constantes +% It is not possible to get the address of a constant, because they +% aren't stored in memory, you can try making it a typed constant. +type_e_argument_cant_be_assigned=04029_E_Cet argument ne peut pas être passé par référence +% Only expressions which can be on the left side of an +% assignment can be passed as call by reference argument +% Remark: Properties can be only +% used on the left side of an assignment, but they cannot be used as arguments +type_e_cannot_local_proc_to_procvar=04030_E_Impossible d'assigner une fonction ou une procédure locale à une variable de type procédure +% It's not allowed to assign a local procedure/function to a +% procedure variable, because the calling of local procedure/function is +% different. You can only assign local procedure/function to a void pointer. +type_e_no_assign_to_addr=04031_E_Impossible d'affecter des valeurs à une adresse +% It is not allowed to assign a value to an address of a variable,constant, +% procedure or function. You can try compiling with -So if the identifier +% is a procedure variable. +type_e_no_assign_to_const=04032_E_Impossible d'affecter des valeurs à une constante +% It's not allowed to assign a value to a variable which is declared +% as a const. This is normally a parameter declared as const, to allow +% changing the value make the parameter as a value parameter or a var. +type_e_array_required=04033_E_Type de tableau requis +% If you are accessing a variable using an index '[<x>]' then +% the type must be an array. In FPC mode also a pointer is allowed. +type_e_interface_type_expected=04034_E_Type interface attendu, "$1" spécifié +% The compiler expected to encounter an interface type name, but got something else. +% The following code would provoke this error: +% \begin{verbatim} +% Type +% TMyStream = Class(TStream,Integer) +% \end{verbatim} +type_w_mixed_signed_unsigned=04035_W_Le mélange d'expressions signées et de mots longs (longwords) donne un résultat sur 64 bits +% If you divide (or calculate the modulus of) a signed expression by a longword (or vice versa), +% or if you have overflow and/or range checking turned on and use an arithmetic +% expression (+, -, *, div, mod) in which both signed numbers and longwords appear, +% then everything has to be evaluated in 64bit which is slower than normal +% 32bit arithmetic. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_w_mixed_signed_unsigned2=04036_W_Le mélange d'expressions signées et de cardinaux ici peut provoquer une erreur de dépassement d'intervalle +% If you use a binary operator (and, or, xor) and one of +% the operands is a longword while the other one is a signed expression, then, +% if range checking is turned on, you may get a range check error because in +% such a case both operands are converted to longword before the operation is +% carried out. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_e_typecast_wrong_size_for_assignment=04037_E_Transtypage de types de tailles différentes ($1 -> $2) dans l'affectation +% Type casting to a type with a different size is not allowed when the variable is +% used for assigning. +type_e_array_index_enums_with_assign_not_possible=04038_E_Les énumérations contenant des affectations ne peuvent pas être utilisées comme index de tableau +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use it as index of an array. +type_e_classes_not_related=04039_E_Les types de classe ou d'objet "$1" et "$2" ne sont pas compatibles +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_w_classes_not_related=04040_W_Classes "$1" et "$2" incompatibles +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_e_class_or_interface_type_expected=04041_E_Classe ou interface attendue mais "$1" spécifié +% The compiler expected a class or interface name, but got another type or identifier. +type_e_type_is_not_completly_defined=04042_E_Le type "$1" n'est pas complètement défini +% This error occurs when a type is not complete: i.e. a pointer type which points to +% an undefined type. +type_w_string_too_long=04043_W_La chaîne contient plus de caractères que ne peut en contenir une chaîne courte +% The size of the constant string, which is assigned to a shortstring, +% is longer than the maximum size of the shortstring +type_w_signed_unsigned_always_false=04044_W_La comparaison est toujours FAUSSE du fait de l'intervalle des valeurs +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% false. Exlicitly typecast the constant to the correct range to avoid this problem. +type_w_signed_unsigned_always_true=04045_W_La comparaison est toujours VRAIE du fait de l'intervalle des valeurs +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% true. Exlicitly typecast the constant to the correct range to avoid this problem. +type_w_instance_with_abstract=04046_W_Construction d´une classe "$1" avec des méthodes abstraites +% An instance of a class is created which contains non-implemented abstract +% methods. This will probably lead to a runtime error 211 in the code if that +% routine is ever called. All abstract methods should be overridden. +type_h_in_range_check=L´opérande à gauche de l´opérateur IN doit avoir la longueur d´un octet (8 bits) +% The left operand of the \var{in} operator is not an ordinal or enumeration which fits +% within 8-bits, this may lead to range check errors. The \var{in} operator +% currently only supports a left operand which fits within a byte. In the case of +% enumerations, the size of an element of an enumeration can be controlled with +% the \var{\{\$PACKENUM\}} or \var{\{\$Zn\}} switches. +type_w_smaller_possible_range_check=04048_W_Divergence de taille des types, risque de perte de données ou d'erreur de dépassement d'intervalle +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_h_smaller_possible_range_check=04049_H_Taille des types non concordante, possibilité de perte de données ou d´erreur de dépassement d´intervalle +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_e_cant_take_address_of_abstract_method=04050_E_L'adresse d'une méthode abstraite ne peut pas être utilisée +% An abstract method has no body, so the address of an abstract method can't be taken. +type_e_operator_not_allowed=04051_E_L'opérateur n'est pas utilisable pour le type d'opérande +% You are trying an operator that is not available for the type of the +% operands +type_e_constant_expr_expected=04052_E_Expression constante attendue +% The compiler expects an constant expression, but gets a variable expression. +type_e_operator_not_supported_for_types=04053_E_L'opération "$1" n'est pas supportée pour les types "$2" et "$3" +% The operation is not allowed for the supplied types +type_e_illegal_type_conversion=04054_E_Conversion de types illégale: de "$1" vers "$2" +% When doing a type-cast, you must take care that the sizes of the variable and +% the destination type are the same. +type_h_pointer_to_longint_conv_not_portable=La conversion entre types scalaires et pointeurs n´est pas portable +% If you typecast a pointer to a longint (or vice-versa), this code will not compile +% on a machine using 64-bit for pointer storage. +type_w_pointer_to_longint_conv_not_portable=04056_W_La conversion entre cardinaux et pointeurs n'est pas portable +% If you typecast a pointer to a ordinal type of a different size (or vice-versa), this can +% cause problems. This is a warning to help finding the 32bit specific code where cardinal/longint is used +% to typecast pointers to ordinals. A solution is to use the ptrint/ptruint types instead. +type_e_cant_choose_overload_function=04057_E_Impossible de déterminer quelle fonction overload appeler +% You're calling overloaded functions with a parameter that doesn't correspond +% to any of the declared function parameter lists. e.g. when you have declared +% a function with parameters \var{word} and \var{longint}, and then you call +% it with a parameter which is of type \var{integer}. +type_e_illegal_count_var=04058_E_Variable de boucle FOR invalide +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +type_w_double_c_varargs=04059_W_Conversion d'une valeur réelle constante en valeur double pour un paramètre variable C, ajoutez un transtypage explicite pour éviter ceci +% In C, constant real values are double by default. For this reason, if you +% pass a constant real value to a variable argument part of a C function, FPC +% by default converts this constant to double as well. If you want to prevent +% this from happening, add an explicit typecast around the constant. +type_e_class_or_cominterface_type_expected=04060_E_Classe ou interface COM attendue mais "$1" spécifié +% Some operators like the AS operator are only appliable to classes or COM interfaces. +% \end{description} +# +# Symtable +# +# 05060 is the last used one +# +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedure and variable names. +% \begin{description} +sym_e_id_not_found=05000_E_Identificateur "$1" non trouvé +% The compiler doesn't know this symbol. Usually happens when you misspel +% the name of a variable or procedure, or when you forgot to declare a +% variable. +sym_f_internal_error_in_symtablestack=05001_F_Erreur interne dans SymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_Double déclaration de l'identificateur "$1" +% The identifier was already declared in the current scope. +sym_h_duplicate_id_where=05003_H_Identificateur déjà défini dans $1 à la ligne $2 +% The identifier was already declared in a previous scope. +sym_e_unknown_id=05004_E_Identificateur "$1" inconnu +% The identifier encountered has not been declared, or is used outside the +% scope where it is defined. +sym_e_forward_not_resolved=05005_E_Déclaration forward "$1" non résolue +% This can happen in two cases: +% \begin{itemize} +% \item This happens when you declare a function (in the \var{interface} part, or +% with a \var{forward} directive, but do not implement it. +% \item You reference a type which isn't declared in the current \var{type} +% block. +% \end{itemize} +sym_e_error_in_type_def=05007_E_Erreur dans la définition du type +% There is an error in your definition of a new array type: +% \item One of the range delimiters in an array declaration is erroneous. +% For example, \var{Array [1..1.25]} will trigger this error. +sym_e_forward_type_not_resolved=05009_E_Déclaration forward "$1" non résolue +% A symbol was forward defined, but no declaration was encountered. +sym_e_only_static_in_static=05010_E_Seules les variables statiques peuvent être utilisées dans les méthodes statiques ou en dehors des méthodes +% A static method of an object can only access static variables. +sym_f_type_must_be_rec_or_class=05012_F_Type record ou classe attendu +% The variable or expression isn't of the type \var{record} or \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_Les instances de classes ou les objets avec une méthode abstraite ne sont pas autorisés +% You are trying to generate an instance of a class which has an abstract +% method that wasn't overridden. +sym_w_label_not_defined=05014_W_Label non défini $1 +% A label was declared, but not defined. +sym_e_label_used_and_not_defined=05015_E_Le Label "$1" est utilisé mais indéfini +% A label was declared and used, but not defined. +sym_e_ill_label_decl=05016_E_Déclaration de label illégale +% This error should never happen; it occurs if a label is defined outside a +% procedure or function. +sym_e_goto_and_label_not_supported=05017_E_GOTO et LABEL non supportés (utilisez l'option -Sg) +% You must compile a program which has \var{label}s and \var{goto} statements +% with the \var{-Sg} switch. By default, \var{label} and \var{goto} aren't +% supported. +sym_e_label_not_found=05018_E_Label non trouvé +% A \var{goto label} was encountered, but the label isn't declared. +sym_e_id_is_no_label_id=05019_E_L'identificateur n'est pas un label +% The identifier specified after the \var{goto} isn't of type label. +sym_e_label_already_defined=05020_E_Label déjà défini +% You are defining a label twice. You can define a label only once. +sym_e_ill_type_decl_set=05021_E_Déclaration de type d'éléments d'ensemble illégale +% The declaration of a set contains an invalid type definition. +sym_e_class_forward_not_resolved=05022_E_Déclaration forward de classe "$1" non résolue +% You declared a class, but you did not implement it. +sym_n_unit_not_used=05023_H_L'unité $1 n'est pas utilisée par $2 +% The unit referenced in the \var{uses} clause is not used. +sym_h_para_identifier_not_used=05024_H_Le paramètre "$1" n'est pas utilisé +% The identifier was declared (locally or globally) but +% was not used (locally or globally). +sym_n_local_identifier_not_used=05025_N_La variable locale "$1" n'est pas utilisée +% You have declared, but not used a variable in a procedure or function +% implementation. +sym_h_para_identifier_only_set=05026_H_La valeur du paramètre "$1" est définie mais jamais utilisée +% The identifier was declared (locally or globally) +% set but not used (locally or globally). +sym_n_local_identifier_only_set=05027_N_La variable locale "$1" a une valeur mais n'est jamais utilisée +% The variable in a procedure or function +% implementation is declared, set but never used. +sym_h_local_symbol_not_used=05028_H_Le symbole local $1 "$2" n'est pas utilisé +% A local symbol is never used. +sym_n_private_identifier_not_used=05029_N_Le champ privé "$1.$2" n'est jamais utilisé +% The indicated private field is defined, but is never used in the code. +sym_n_private_identifier_only_set=05030_N_Le champ privé "$1.$2" a une valeur mais n'est jamais utilisé +% The indicated private field is declared, assigned but never read. +sym_n_private_method_not_used=05031_N_La méthode privée "$1.$2" n'est jamais utilisée +% The indicated private method is declared but is never used in the code. +sym_e_set_expected=05032_E_Type ensemble attendu +% The variable or expression is not of type \var{set}. This happens in an +% \var{in} statement. +sym_w_function_result_not_set=05033_W_Le résultat de la fonction semble indéfini +% You can get this warning if the compiler thinks that a function return +% value is not set. This will not be displayed for assembler procedures, +% or procedures that contain assembler blocks. +sym_w_wrong_C_pack=05034_W_Le type $1 n'est pas aligné correctement pour C dans l'enregistrement courant +% Arrays with sizes not multiples of 4 will be wrongly aligned +% for C structures. +sym_e_illegal_field=05035_E_Identificateur de champ "$1" inconnu +% The field doesn't exist in the record/object definition. +sym_w_uninitialized_local_variable=05036_W_La variable locale "$1" ne semble pas être initialisée +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_w_uninitialized_variable=05037_W_La variable "$1" ne semble pas être initialisée +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_e_id_no_member=05038_E_L'identificateur "$1" n'a pas de membres +% This error is generated when an identifier of a record, +% field, or method is accessed while it is not defined. +sym_h_param_list=05039_H_Déclaration trouvée: $1 +% You get this when you use the \var{-vh} switch. In case an overloaded +% procedure is not found, then all candidate overloaded procedures are +% listed, with their parameter lists. +sym_e_segment_too_large=05040_E_Donnée trop grande (max. 2GB) +% You get this when you declare a data element whose size exceeds the +% prescribed limit (2 Gb on 80386+/68020+ processors) +sym_e_no_matching_implementation_found=05042_E_Aucune implémentation correspondante pour la méthode "$1" trouvée dans l'interface +% There was no matching method found which could implement the interface +% method. Check argument types and result type of the methods. +sym_w_deprecated_symbol=05043_W_Le symbole "$1" est déprécié +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Usage of this symbol +% should be avoided as much as possible. +sym_w_non_portable_symbol=05044_W_Le symbole "$1" n'est pas portable +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{platform} is used. This symbol's value, usage +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_non_implemented_symbol=05055_W_Le symbole "$1" n'est pas implémenté +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{unimplemented} is used. This symbol is defined, +% but is not yet implemented on this specific platform. +sym_e_cant_create_unique_type=05056_E_Impossible de créer un type unique depuis ce type +% Only simple types like ordinal, float and string types are supported when +% redefining a type with \var{type newtype = type oldtype;}. +sym_h_uninitialized_local_variable=05057_H_La variable locale "$1" ne semble pas initialisée +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_h_uninitialized_variable=05058_H_La variable "$1" ne semble pas initialisée +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_w_function_result_uninitialized=05059_W_La variable Result de la fonction ne semble pas initialisée +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. appears in the right-hand-side of an expression) +% before it is initialized (i.e. appeared in the left-hand side of an +% assigment) +sym_h_function_result_uninitialized=05060_H_La variable Result de la fonction ne semble pas initialisée +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. appears in the right-hand-side of an expression) +% before it is initialized (i.e. appeared in the left-hand side of an +% assigment) +sym_w_identifier_only_read=05061_W_La variable "$1" est lue mais ne reçoit de valeur nulle part +% You have read the value of a variable, but nowhere assigned a value to +% it. +% \end{description} +# +# Codegenerator +# +# 06040 is the last used one +# +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +cg_e_parasize_too_big=06009_E_La taille de la liste de paramètre dépasse 65535 octets +% The I386 processor limits the parameter list to 65535 bytes (the \var{RET} +% instruction causes this) +cg_e_file_must_call_by_reference=06012_E_Les paramètres de type File doivent être passés par adresse +% You cannot specify files as value parameters, i.e. they must always be +% declared \var{var} parameters. +cg_e_cant_use_far_pointer_there=06013_E_L'utilisation d'un pointeur long n'est pas autorisée ici +% Free Pascal doesn't support far pointers, so you cannot take the address of +% an expression which has a far reference as a result. The \var{mem} construct +% has a far reference as a result, so the following code will produce this +% error: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_Les fonctions déclarées EXPORT ne peuvent pas être appelées +% No longer in use. +cg_w_member_cd_call_from_method=06016_W_Appel probablement illégal d'un constructeur ou d'un destructeur +% The compiler detected that a constructor or destructor is called within a +% a method. This will probably lead to problems, since constructors / destructors +% require parameters on entry. +cg_n_inefficient_code=06017_N_Code inefficace +% Your statement seems dubious to the compiler. +cg_w_unreachable_code=06018_W_Code inaccessible +% You specified a construct which will never be executed. Example: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_Les méthodes abstraites ne peuvent pas être appelées directement +% You cannot call an abstract method directy, instead you must call a +% overriding child method, because an abstract method isn't implemented. +cg_d_register_weight=06027_DL_Registre $1 poids $2 $3 +% Debugging message. Shown when the compiler considers a variable for +% keeping in the registers. +cg_d_stackframe_omited=06029_DL_Cadre de pile omis +% Some procedure/functions do not need a complete stack-frame, so it is omitted. +% This message will be displayed when the {-vd} switch is used. +cg_e_unable_inline_object_methods=06031_E_Un object ou des méthodes de classe ne peuvent pas être "inline". +% You cannot have inlined object methods. +cg_e_unable_inline_procvar=06032_E_Les appels à des variables procédure ne peuvent pas être "inline". +% A procedure with a procedural variable call cannot be inlined. +cg_e_no_code_for_inline_stored=06033_E_Pas de code pour la procédure inline stockée +% The compiler couldn't store code for the inline procedure. +cg_e_can_access_element_zero=06035_E_Impossible d'accéder à l'élément zéro d'une chaîne ANSI, large ou longue, utilisez à la place (set)length +% You should use \var{setlength} to set the length of an ansi/wide/longstring +% and \var{length} to get the length of such a string types +cg_e_cannot_call_cons_dest_inside_with=06037_E_Constructeurs et destructeurs ne peuvent pas être appelés à l'intérieur d'une clause 'with' +% Inside a \var{with} clause you cannot call a constructor or destructor for the +% object you have in the \var{with} clause. +cg_e_cannot_call_message_direct=06038_E_Impossible d'appeler directement les méthodes du gestionnaire de messages +% A message method handler method cannot be called directly if it contains an +% explicit self argument +cg_e_goto_inout_of_exception_block=06039_E_Saut à l'intérieur ou en dehors d'un bloc de traitement d'une exception +% It is not allowed to jump in or outside of an exception block like \var{try..finally..end;}: +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // this line will cause an error +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_Les instructions de contrôle d'exécution ne sont pas autorisées dans un bloc finally +% It isn't allowed to use the control flow statements \var{break}, +% \var{continue} and \var{exit} +% inside a finally statement. The following example shows the problem: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // This exit ISN'T allowed +% end; +% ... +% +% \end{verbatim} +% If the procedure \var{p} raises an exception the finally block is +% executed. If the execution reaches the exit, it's unclear what to do: +% exiting the procedure or searching for another exception handler +cg_w_parasize_too_big=06041_W_La taille des paramètres dépasse la limite supportée par certains processeurs. +% This indicates that you are declaring more than 64K of parameters, which +% might not be supported on other processor targets. +cg_w_localsize_too_big=06042_W_La taille de la variable locale dépasse la limite supportée par certains processeurs. +% This indicates that you are declaring more than 32K of local variables, which +% might not be supported on other processor targets. +cg_e_localsize_too_big=06043_E_La taille des variables locales dépasse la limite supportée +% This indicates that you are declaring more than 32K of local variables, which +% is not supported by this processor. +cg_e_break_not_allowed=06044_E_BREAK non autorisé +% You're trying to use \var{break} outside a loop construction. +cg_e_continue_not_allowed=06045_E_CONTINUE non autorisé +% You're trying to use \var{continue} outside a loop construction. +cg_f_unknown_compilerproc=06046_F_Procédure "$1" inconnue. Verifiez que vous utilisez la bonne version de bibliothèque d'exécution. +% The compiler expects that the runtime library contains some subrountines. If you see this error +% and you didn't mess with the runtime library, it's very likely that the runtime library +% you're using doesn't match the used compiler. If you changed the runtime library this error means +% that you removed a subroutine which the compiler needs for internal use. +% \end{description} +# EndOfTeX +# +# Assembler reader +# +# 07097 is the last used one +# +asmr_d_start_reading=07000_DL_Début d'analyse assembleur de style $1 +% This informs you that an assembler block is being parsed +asmr_d_finish_reading=07001_DL_Analyse assembleur de style $1 terminée +% This informs you that an assembler block has finished. +asmr_e_none_label_contain_at=07002_E_Un identificateur qui n'est pas un label contient @ +% A identifier which isn't a label can't contain a @. +asmr_e_building_record_offset=07004_E_Erreur de construction de l'offset du record +% There has an error occured while building the offset of a record/object +% structure, this can happend when there is no field specified at all or +% an unknown field identifier is used. +asmr_e_offset_without_identifier=07005_E_OFFSET utilisé sans identificateur +% You can only use OFFSET with an identifier. Other syntaxes aren't +% supported +asmr_e_type_without_identifier=07006_E_TYPE utilisé sans identificateur +% You can only use TYPE with an identifier. Other syntaxes aren't +% supported +asmr_e_no_local_or_para_allowed=07007_E_Impossible d'utiliser une variable locale ou des paramètres ici +% You can't use a local variable or parameter here, mostly because the +% addressing of locals and parameters is done using the frame pointer register so the +% address can't be obtained directly. +asmr_e_need_offset=07008_E_Utilisation d'OFFSET nécessaire +% You need to use OFFSET <id> here to get the address of the identifier. +asmr_e_need_dollar=07009_E_Utilisation de $ nécessaire +% You need to use $<id> here to get the address of the identifier. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_Impossible d'utiliser plusieurs symboles relogeables +% You can't have more than one relocatable symbol (variable/typed constant) +% in one argument. +asmr_e_only_add_relocatable_symbol=07011_E_Les symboles relogeables ne peuvent qu'être ajoutés +% Relocatable symbols (variable/typed constant) can't be used with other +% operators. Only addition is allowed. +asmr_e_invalid_constant_expression=07012_E_Expression contante incorrecte +% There is an error in the constant expression. +asmr_e_relocatable_symbol_not_allowed=07013_E_Symbole relogeable non autorisé +% You can't use a relocatable symbol (variable/typed constant) here. +asmr_e_invalid_reference_syntax=07014_E_Syntaxe de référence incorrecte +% There is an error in the reference. +asmr_e_local_para_unreachable=07015_E_Impossible d´atteindre $1 depuis ce code +% You can not read directly the value of a local variable or parameter +% of a higher level procedure in assembler code (except for +% local assembler code without parameter nor locals). +asmr_e_local_label_not_allowed_as_ref=07016_E_Les symboles locaux et les labels ne sont pas autorisés en tant que références +% You can't use local symbols/labels as references +asmr_e_wrong_base_index=07017_E_Utilisation d'un registre de base et d'un index de registre incorrecte +% There is an error with the base and index register, they are +% probably incorrect +asmr_w_possible_object_field_bug=07018_W_Erreur possible dans la gestion d'un champ d'objet +% Fields of objects or classes can be reached directly in normal or objfpc +% modes but TP and Delphi modes treat the field name as a simple offset. +asmr_e_wrong_scale_factor=07019_E_Facteur d'échelle spécifié incorrect +% The scale factor given is wrong, only 1,2,4 and 8 are allowed +asmr_e_multiple_index=07020_E_Utilisation d'index de registre multiples +% You are trying to use more than one index register +asmr_e_invalid_operand_type=07021_E_Type de paramètre incorrect +% The operand type doesn't match with the opcode used +asmr_e_invalid_string_as_opcode_operand=07022_E_Paramètre chaîne incorrect pour le code opération: $1 +% The string specified as operand is not correct with this opcode +asmr_w_CODE_and_DATA_not_supported=07023_W_@CODE et @DATA non supportés +% @CODE and @DATA are unsupported and are ignored. +asmr_e_null_label_ref_not_allowed=07024_E_Référence à un label Null non autorisée +asmr_e_expr_zero_divide=07025_E_Division par zéro dans l'évaluateur assembleur +% There is a division by zero in a constant expression +asmr_e_expr_illegal=07026_E_Expression illégale +% There is an illegal expression in a constant expression +asmr_e_escape_seq_ignored=07027_E_Séquence d'échappement ignorée: $1 +% There is a C-styled string, but the escape sequence in the string +% is unknown, and is therefore ignored +asmr_e_invalid_symbol_ref=07028_E_Référence au symbole incorrecte +asmr_w_fwait_emu_prob=07029_W_Fwait peut causer des problèmes d'émulation avec emu387 +asmr_w_fadd_to_faddp=07030_W_$1 sans paramètre traduit en $1P +asmr_w_enter_not_supported_by_linux=07031_W_Instruction ENTER non supportée par le noyau Linux +% ENTER instruction can generate a stack page fault that is not +% caught correctly by the i386 Linux page handler. +asmr_w_calling_overload_func=07032_W_Appel d'une fonction surchargée en assembleur +% There is a call to an overloaded method in the assembler block, +% this might be the sign there is a problem +asmr_e_unsupported_symbol_type=07033_E_Type de symbole non supporté +asmr_e_constant_out_of_bounds=07034_E_Valeur de constante hors intervalle +asmr_e_error_converting_decimal=07035_E_Erreur de conversion décimale $1 +% A constant decimal value does not have the correct syntax +asmr_e_error_converting_octal=07036_E_Erreur de conversion octale $1 +% A constant octal value does not have the correct syntax +asmr_e_error_converting_binary=07037_E_Erreur de conversion binaire $1 +% A constant binary value does not have the correct syntax +asmr_e_error_converting_hexadecimal=07038_E_Erreur de conversion hexadecimale $1 +% A constant hexadecimal value does not have the correct syntax +asmr_h_direct_global_to_mangled=07039_H_$1 traduit en $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 est associé(e) à une fonction surchargée +asmr_e_cannot_use_SELF_outside_a_method=07041_E_Impossible d'utiliser SELF en dehors d'une méthode +% There is a reference to the \var{self} symbol while it is not +% allowed. \var{self} can only be referenced inside methods +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_Impossible d'utiliser OLDEBP en dehors d'une procédure imbriquée +% There is a reference to the \var{oldebp} symbol while it is not +% allowed. \var{oldebp} can only be referenced inside nested routines +asmr_e_void_function=07043_W_Les procédures ne peuvent pas retourner de valeur en code assembleur +% Trying to return a value while in a procedure. A procedure +% does not have any return value +asmr_e_SEG_not_supported=07044_E_SEG non supporté +asmr_e_size_suffix_and_dest_dont_match=07045_E_La taille du suffixe et celle de la destination ou de la source ne correspondent pas +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_w_size_suffix_and_dest_dont_match=07046_W_La taille du suffixe ne correspond pas à celle de la destination ou de la source +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_e_syntax_error=07047_E_Erreur de syntaxe assembleur +% There is an assembler syntax error +asmr_e_invalid_opcode_and_operand=07048_E_Combinaison de codes opération et de paramètres incorrecte +% The opcode cannot be used with this type of operand +asmr_e_syn_operand=07049_E_Erreur de syntaxe assembleur dans le paramètre +asmr_e_syn_constant=07050_E_Erreur de syntaxe assembleur dans la constante +asmr_e_invalid_string_expression=07051_E_Expression chaîne incorrecte +asmr_w_const32bit_for_address=07052_W_Constante avec symbole $1 utilisée comme adresse n'est pas un pointeur +% A constant expression represents an address which does not fit +% into a pointer. The address is probably incorrect +asmr_e_unknown_opcode=07053_E_Code opération $1 non reconnu +% This opcode is not known +asmr_e_invalid_or_missing_opcode=07054_E_Code opération incorrect ou manquant +asmr_e_invalid_prefix_and_opcode=07055_E_Combinaison invalide de prefix avec un code opération: $1 +asmr_e_invalid_override_and_opcode=07056_E_Combinaison invalide de override avec un code opération: $1 +asmr_e_too_many_operands=07057_E_Nombre de paramètres insuffisant +% There are too many operands for this opcode. Check your +% assembler syntax +asmr_w_near_ignored=07058_W_NEAR ignoré +asmr_w_far_ignored=07059_W_FAR ignoré +asmr_e_dup_local_sym=07060_E_Symbole local $1 dupliqué +asmr_e_unknown_local_sym=07061_E_Symbole local $1 inconnu +asmr_e_unknown_label_identifier=07062_E_Identificateur de label $1 inconnu +asmr_e_invalid_register=07063_E_Nom de registre incorrect +% There is an unknown register name used as operand. +asmr_e_invalid_fpu_register=07064_E_Nom de registre de calcul réel incorrect +% There is an unknown register name used as operand. +asmr_w_modulo_not_supported=07066_W_Modulo non supporté +asmr_e_invalid_float_const=07067_E_Constante réelle $1 invalide +% The floating point constant declared in an assembler block is +% invalid. +asmr_e_invalid_float_expr=07068_E_Expression réelle invalide +% The floating point expression declared in an assembler block is +% invalid. +asmr_e_wrong_sym_type=07069_E_Type de symbole incorrect +asmr_e_cannot_index_relative_var=07070_E_Impossible d'indicer directement une variable locale ou un paramètre avec un registre +% Trying to index using a base register a symbol which is already relative +% to a register. This is not possible, and will probably lead to crashes. +asmr_e_invalid_seg_override=07071_E_Expression d'override du segment incorrecte +asmr_w_id_supposed_external=07072_W_Identificateur $1 supposé external +% There is a reference to an undefined symbol. This will not result +% in an error, since the symbol might be external, but may cause +% problems at link time if the symbol is not defined anywhere. +asmr_e_string_not_allowed_as_const=07073_E_Constantes chaînes non autorisées +% Character strings are not allowed as constants. +asmr_e_no_var_type_specified=07074_Type de variable non spécifié +% The syntax expects a type idenfitifer after the dot, but +% none was found. +asmr_w_assembler_code_not_returned_to_text=07075_E_Code assembleur non retourné à la section text +% There was a directive in the assembler block to change sections, +% but there is a missing return to the text section at the end +% of the assembler block. This might cause errors during link time. +asmr_e_not_directive_or_local_symbol=07076_E_$1 n'est pas une directive ou un symbole local +% This symbol is unknown. +asmr_w_using_defined_as_local=07077_E_Utilisation d'un nom défini comme label local +asmr_e_dollar_without_identifier=07078_E_Dollar utilisé sans identificateur +% A constant expression has an identifier which does not start with +% the $ symbol. +asmr_w_32bit_const_for_address=07079_W_Constante 32 bits créée comme adresse +% A constant was used as an address. This is probably an error, +% since using absolute addresses will probably not work. +asmr_n_align_is_target_specific=07080_N_.align dépend de la cible, utilisez .balign ou .p2align +% Using the .align directive is platform specific, and its meaning will vary +% from one platform to another. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_Impossible d'accéder directement aux champs transmis en paramètres +% You should load the parameter first into a register and then access the +% fields using that register. +asmr_e_cannot_access_object_field_directly=07082_E_Impossible d'accéder directement aux champs d'objets ou de classes +% You should load the self pointer first into a register and then access the +% fields using the register as base. By default the self pointer is available +% in the esi register on i386. +asmr_e_unable_to_determine_reference_size=07083_E_Taille non spécifiée et impossibilité de déterminer la taille des paramètres +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. +asmr_e_cannot_use_RESULT_here=Impossible d'utiliser RESULT dans cette fonction +% Some functions which return complex types cannot use the \var{result} +% keyword. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" sans paramètre traduit en "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" traduit en "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" traduit en "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_Caractère < non autorisé ici +% The shift operator requires the << characters. Only one +% of those characters was found. +asmr_e_invalid_char_greater=07090_E_Caractère > non autorisé ici +% The shift operator requires the >> characters. Only one +% of those characters was found. +asmr_w_align_not_supported=07093_W_ALIGN non supporté +asmr_e_no_inc_and_dec_together=07094_E_Inc et Dec ne peuvent pas être ensemble +% Trying to use an increment and a decrement within the same +% opcode on the 680x0. This is impossible. +asmr_e_invalid_reg_list_in_movem=07095_E_Liste de registres invalide pour l'opération movem +% Trying to use the \var{movem} opcode with invalid registers +% to save or restore. +asmr_e_invalid_reg_list_for_opcode=07096_E_Liste de registres invalide pour le code opération +asmr_e_higher_cpu_mode_required=07097_E_Mode CPU supérieur nécessaire ($1) +% Trying to use an instruction which is not supported in the current +% cpu mode. Use a higher cpu generation to be able to use this +% opcode in your assembler block +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_Taille non spécifiée et impossible de déterminer la taille des paramètres, utilisation de DWORD par défaut +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use DWORD as default. +asmr_e_illegal_shifterop_syntax=07099_E_Erreur de syntaxe durant l'analyse d'une opération de décalage +% ARM only; ARM assembler supports a so called shifter operand. The used syntax isn't +% a valid shifter operand. Example for an operation with shifter operand: +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +# +# Assembler/binary writers +# +# 08018 is the last used one +# +asmw_f_too_many_asm_files=08000_F_Trop peu de fichiers assembleur +% With smartlinking enabled, there are too many assembler +% files generated. Disable smartlinking. +asmw_f_assembler_output_not_supported=08001_F_Résultat de l'assembleur sélectionné non supporté +asmw_f_comp_not_supported=08002_F_Comp non supporté +asmw_f_direct_not_supported=08003_F_Direct non supporté pour les 'writers' binaires +% Direct assembler mode is not supported for binary writers. +asmw_e_alloc_data_only_in_bss=08004_E_Allocation de données supportée uniquement dans la section bss +asmw_f_no_binary_writer_selected=08005_F_Aucun 'writer' binaire sélectionné +asmw_e_opcode_not_in_table=08006_E_Asm: Code opération $1 absent de la liste +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 combinaison du code opération et des paramètres incorrecte +asmw_e_16bit_not_supported=08008_E_Asm: référence 16 bits non supportée +asmw_e_invalid_effective_address=08009_E_Asm: Adresse effective incorrecte +asmw_e_immediate_or_reference_expected=08010_E_Asm: Immediate ou référence attendue +asmw_e_value_exceeds_bounds=08011_E_Asm: la valeur $1 dépasse les limites $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: Saut court hors limites $1 +asmw_e_undefined_label=08013_E_Asm: Label $1 non défini +asmw_e_comp_not_supported=08014_E_Asm: type Comp non supporté pour cette cible +asmw_e_extended_not_supported=08015_E_Asm: type Extended non supporté pour cette cible +asmw_e_duplicate_label=08016_E_Asm: label $1 dupliqué +asmw_e_redefined_label=08017_E_Asm: label $1 redéfini +asmw_e_first_defined_label=08018_E_Asm: Première définition +asmw_e_invalid_register=08019_E_Asm: Registre $1 incorrect +asmw_e_16bit_32bit_not_supported=08020_E_Asm: références 16 et 32 bits non supportées +asmw_e_64bit_not_supported=08021_E_Asm: paramètres 64 bits non supportés +# +# Executing linker/assembler +# +# 09034 is the last used one +# +# BeginOfTeX +% +% \section{Errors of assembling/linking stage} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +exec_w_source_os_redefined=09000_W_Système d'exploitation source redéfini +% The source operating system is redefined. +exec_i_assembling_pipe=09001_I_Assemblage (pipe) de $1 +% Assembling using a pipe to an external assembler. +exec_d_cant_create_asmfile=09002_E_Impossible de créer le fichier assembleur: $1 +% The mentioned file can't be created. Check if you have got +% access permissions to create this file +exec_e_cant_create_objectfile=09003_E_Impossible de créer le fichier object: $1 +% The mentioned file can't be created. Check if you've +% got access permissions to create this file +exec_e_cant_create_archivefile=09004_E_Impossible de créer le fichier archive: $1 +% The mentioned file can't be created. Check if you've +% access permissions to create this file +exec_e_assembler_not_found=09005_E_Assembleur $1 non trouvé, utilisation d'un assembleur externe +% The assembler program was not found. The compiler will produce a script that +% can be used to assemble and link the program. +exec_t_using_assembler=09006_T_Utilisation de l'assembleur: $1 +% Information message saying which assembler is being used. +exec_e_error_while_assembling=09007_E_Erreur durant l'assemblage, code de sortie $1 +% There was an error while assembling the file using an external assembler. +% Consult the documentation of the assembler tool to find out more information +% on this error. +exec_e_cant_call_assembler=09008_E_Impossible d'appeler l'assembleur, erreur $1, utilisation d'un assembleur externe +% An error occurred when calling an external assembler, The compiler will produce a script that +% can be used to assemble and link the program. +exec_i_assembling=09009_I_Assemblage de $1 +% An informational message stating which file is being assembled. +exec_i_assembling_smart=09010_I_Assemblage avec édition intelligente des liens de $1 +% An informational message stating which file is being assembled using smartlinking. +exec_w_objfile_not_found=09011_W_Objet $1 non trouvé, l'édition des liens peut échouer ! +% One of the object file is missing, and linking will probably fail. +% Check your paths. +exec_w_libfile_not_found=09012_W_Bibliothèque $1 non trouvée, l'édition des liens peut échouer ! +% One of the library file is missing, and linking will probably fail. +% Check your paths. +exec_e_error_while_linking=09013_E_Erreur durant l'édition des liens +% Generic error while linking. +exec_e_cant_call_linker=09014_E_Impossible d'appeler l'éditeur de liens, utilisation d'un éditeur de liens externe +% An error occurred when calling an external linker, The compiler will produce a script that +% can be used to assemble and link the program. +exec_i_linking=09015_I_Édition des liens de $1 +% An informational message, showing which program or library is being linked. +exec_e_util_not_found=09016_E_Utilitaire $1 non trouvé, utilisation d'un éditeur de liens externe +% An external tool was not found, the compiler will produce a script that +% can be used to assemble and link or postprocess the program. +exec_t_using_util=09017_T_Utilisation de l'utilitaire $1 +% An informational message, showing which external program (usually a postprocessor) is being used. +exec_e_exe_not_supported=09018_E_Création d'exécutables non supportée +% Creating executable programs is not supported for this platform, because it was +% not yet implemented in the compiler. +exec_e_dll_not_supported=09019_E_Création de bibliothèques dynamiques/partagées non supportée +% Creating dynamically loadable libraries is not supported for this platform, because it was +% not yet implemented in the compiler. +exec_i_closing_script=09020_I_Fermeture du script $1 +% Informational message showing when the external assembling an linking script is finished. +exec_e_res_not_found=09021_E_Compilateur de ressource non trouvé, utilisation d'un compilateur externe +% An external resource compiler was not found, the compiler will produce a script that +% can be used to assemble, compile resources and link or postprocess the program. +exec_i_compilingresource=09022_I_Compilation de la resource $1 +% An informational message, showing which resource is being compiled. +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_Édition statique des liens de l'unité $1 impossible, utilisation d'une édition intelligente des liens +% Statical linking was requested, but a unit which is not statically linkable was used. +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_Édition intelligente des liens de l'unité $1 impossible, utilisation d'une édition de liens statique +% Smart linking was requested, but a unit which is not smart-linkable was used. +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_Édition des liens partagée de l'unité $1 impossible, utilisation d'une édition de liens statique +% Shared linking was requested, but a unit which is not shared-linkable was used. +exec_e_unit_not_smart_or_static_linkable=09026_E_Édition intelligente ou statique des liens de l'unité $1 impossible +% Smart or static linking was requested, but a unit which cannot be used for either was used. +exec_e_unit_not_shared_or_static_linkable=09027_E_Édition des liens partagée ou statique de l'unité $1 impossible +% Shared or static linking was requested, but a unit which cannot be used for either was used. +exec_d_resbin_params=09028_D_Exécution du compilateur de ressource "$1" avec "$2" comme ligne de commande +% An informational message showing which command-line is used for the resource compiler. +%\end{description} +# EndOfTeX +# +# Executable information +# +# BeginOfTeX +% \section{Executable information messages.} +% This section lists all messages that the compiler emits when an executable program is produced, +% and only when the internal linker is used. +% \begin{description} +execinfo_f_cant_process_executable=09128_F_Post-traitement de l'exécutable $1 impossible +% Fatal error when the compiler is unable to post-process an executable. +execinfo_f_cant_open_executable=09129_F_Impossible d'ouvrir l'exécutable $1 +% Fatal error when the compiler cannot open the file for the executable. +execinfo_x_codesize=09130_X_Taille du code: $1 octets +% Informational message showing the size of the produced code section. +execinfo_x_initdatasize=09131_X_Taille des données initialisées: $1 octets +% Informational message showing the size of the initialized data section. +execinfo_x_uninitdatasize=09132_X_Taille des données non-initialisées: $1 octets +% Informational message showing the size of the uninitialized data section. +execinfo_x_stackreserve=09133_X_Taille de pile réservée: $1 octets +% Informational message showing the stack size that the compiler reserved for the executable. +execinfo_x_stackcommit=09134_X_Taille de pile validée: $1 octets +% Informational message showing the stack size that the compiler committed for the executable. +%\end{description} +# EndOfTeX +# +# Unit loading +# +# 10041 is the last used one +# +# BeginOfTeX +% \section{Unit loading messages.} +% This section lists all messages that can occur when the compiler is +% loading a unit from disk into memory. Many of these messages are +% informational messages. +% \begin{description} +unit_t_unitsearch=10000_T_Recherche de l'unité $1 +% When you use the \var{-vt}, the compiler tells you where it tries to find +% unit files. +unit_t_ppu_loading=10001_T_Chargement du fichier PPU $1 +% When the \var{-vt} switch is used, the compiler tells you +% what units it loads. +unit_u_ppu_name=10002_U_Fichier PPU: $1 +% When you use the \var{-vu} flag, the unit name is shown. +unit_u_ppu_flags=10003_U_Drapeaux PPU: $1 +% When you use the \var{-vu} flag, the unit flags are shown. +unit_u_ppu_crc=10004_U_Somme de contrôle du fichier PPU: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_time=10005_U_Fichier PPU compilé à $1 +% When you use the \var{-vu} flag, the time the unit was compiled is shown. +unit_u_ppu_file_too_short=10006_U_Fichier PPU trop court +% The ppufile is too short, not all declarations are present. +unit_u_ppu_invalid_header=10007_U_En-tête PPU invalide (PPU non trouvé au début) +% A unit file contains as the first three bytes the ascii codes of \var{PPU} +unit_u_ppu_invalid_version=10008_U_Version $1 de fichier PPU invalide +% This unit file was compiled with a different version of the compiler, and +% cannot be read. +unit_u_ppu_invalid_processor=10009_U_Fichier PPU compilé pour un autre processeur +% This unit file was compiled for a different processor type, and +% cannot be read +unit_u_ppu_invalid_target=10010_U_Fichier PPU compilé pour une autre cible +% This unit file was compiled for a different target, and +% cannot be read +unit_u_ppu_source=10011_U_Fichier source: $1 +% When you use the \var{-vu} flag, the unit source file name is shown. +unit_u_ppu_write=10012_U_Écriture de $1 +% When you specify the \var{-vu} switch, the compiler will tell you where it +% writes the unit file. +unit_f_ppu_cannot_write=10013_F_Impossible d'écrire le fichier PPU +% An error occurred when writing the unit file. +unit_f_ppu_read_error=10014_F_Erreur lors de la lecture du fichier PPU +% This means that the unit file was corrupted, and contains invalid +% information. Recompilation will be necessary. +unit_f_ppu_read_unexpected_end=10015_F_Fin de fichier PPU inattendue +% Unexpected end of file. This may mean that the PPU file is +% corrupted. +unit_f_ppu_invalid_entry=10016_F_Entrée invalide dans le fichier PPU $1 +% The unit the compiler is trying to read is corrupted, or generated with a +% newer version of the compiler. +unit_f_ppu_dbx_count_problem=10017_F_PPU Dbx count problem +% There is an inconsistency in the debugging information of the unit. +unit_e_illegal_unit_name=10018_E_Nom d'unité illégal: $1 +% The name of the unit does not match the file name. +unit_f_too_much_units=10019_F_Trop d'unités +% \fpc has a limit of 1024 units in a program. You can change this behavior +% by changing the \var{maxunits} constant in the \file{fmodule.pas} file of the +% compiler, and recompiling the compiler. +unit_f_circular_unit_reference=10020_F_Référence circulaire entre les unités $1 et $2 +% Two units are using each other in the interface part. This is only allowed +% in the \var{implementation} part. At least one unit must contain the other one +% in the \var{implementation} section. +unit_f_cant_compile_unit=10021_F_Compilation de l'unité $1 impossible, pas de sources disponibles +% A unit was found that needs to be recompiled, but no sources are +% available. +unit_f_cant_find_ppu=10022_F_Impossible de trouver l'unité $1 +% You tried to use a unit of which the PPU file isn't found by the +% compiler. Check your configuration file for the unit paths +unit_w_unit_name_error=10023_W_Unité $1 non trouvée mais $2 existe +% This error message is no longer used. +unit_f_unit_name_error=10024_F_Unité $1 cherchée mais $2 trouvée +% Dos truncation of 8 letters for unit PPU files +% may lead to problems when unit name is longer than 8 letters. +unit_w_switch_us_missed=10025_W_La compilation de l´unité System requiert l´option -Us +% When recompiling the system unit (it needs special treatment), the +% \var{-Us} must be specified. +unit_f_errors_in_unit=10026_F_$1 erreurs lors de la compilation du module, arrêt +% When the compiler encounters a fatal error or too many errors in a module +% then it stops with this message. +unit_u_load_unit=10027_U_Chargement à partir de $1 ($2) de l'unité $3 +% When you use the \var{-vu} flag, which unit is loaded from which unit is +% shown. +unit_u_recompile_crc_change=10028_U_Recompilation de $1, la somme de contrôle est maintenant $2 +% The unit is recompiled because the checksum of a unit it depends on has +% changed. +unit_u_recompile_source_found_alone=10029_U_Recompilation de $1, seul le source a été trouvé +% When you use the \var{-vu} flag, these messages tell you why the current +% unit is recompiled. +unit_u_recompile_staticlib_is_older=10030_U_Recompilation de l'unité, la bibliothèque statique est plus ancienne que le fichier PPU +% When you use the \var{-vu} flag, the compiler warns if the static library +% of the unit are older than the unit file itself. +unit_u_recompile_sharedlib_is_older=10031_U_Recompilation de l'unité, la bibliothèque partagée est plus ancienne que le fichier PPU +% When you use the \var{-vu} flag, the compiler warns if the shared library +% of the unit are older than the unit file itself. +unit_u_recompile_obj_and_asm_older=10032_U_Recompilation de l'unité, les fichiers OBJ et ASM sont plus anciens que le fichier PPU +% When you use the \var{-vu} flag, the compiler warns if the assembler or +% object file of the unit are older than the unit file itself. +unit_u_recompile_obj_older_than_asm=10033_U_Recompilation de l'unité, le fichier OBJ est plus ancien que le fichier ASM +% When you use the \var{-vu} flag, the compiler warns if the assembler +% file of the unit is older than the object file of the unit. +unit_u_parsing_interface=10034_U_Analyse de l'interface de $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the interface part of the unit +unit_u_parsing_implementation=10035_U_Analyse de l'implémentation de $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the implementation part of the unit +unit_u_second_load_unit=10036_U_Deuxième compilation de l'unité $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_check_time=10037_U_Vérification du fichier PPU $1, date/heure $2 +% When you use the \var{-vu} flag, the compiler show the filename and +% date and time of the file which a recompile depends on +### The following two error msgs are currently disabled. +#unit_h_cond_not_set_in_last_compile=10038_H_Conditional $1 was not set at startup in last compilation of $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that currently is defined, but was not used the last +#% time the unit was compiled. +#unit_h_cond_set_in_last_compile=10039_H_Conditional $1 was set at startup in last compilation of $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that was used the last time the unit was compiled, but +#% the conditional is currently not defined. +unit_w_cant_compile_unit_with_changed_incfile=10040_W_Impossible de recompiler l'unité $1 alors que des fichiers inclus ont été trouvés +% A unit was found to have modified include files, but +% some source files were not found, so recompilation is impossible. +unit_h_source_modified=10041_H_Le fichier $1 est plus récent que le fichier PPU $2 +% A modified source file for a unit was found that was compiled with the +% release flag (-Ur). The unit will not implicitly be recompiled because +% this release flag is set. +unit_u_ppu_invalid_fpumode=10042_U_Utilisation d'une unité compilée avec un mode FPU incorrect +% Trying to compile code while using units which were not compiled with +% the same floating point format mode. Either all code should be compiled +% with FPU emulation on, or with FPU emulation off. +unit_u_loading_interface_units=10043_U_Chargement des unités déclarées dans l'interface de $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the units defined in the interface part of the unit. +unit_u_loading_implementation_units=10044_U_Chargement des unités déclarées dans l'implementation de $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the units defined in the implementation part of the unit. +unit_u_interface_crc_changed=10045_U_La somme de contrôle de l'interface de l'unité $1 a changé +% When you use the \var{-vu} flag, the compiler warns that it the +% CRC calculated for the interface has been changed after the implementation +% has been parsed. +unit_u_implementation_crc_changed=10046_U_La somme de contrôle de l'implémentation de l'unité $1 a changé +% When you use the \var{-vu} flag, the compiler warns that it the +% CRC calculated has been changed after the implementation +% has been parsed. +unit_u_finished_compiling=10047_U_Recompilation de l'unité $1 terminée +% When you use the \var{-vu} flag, the compiler warns that it +% has finished compiling the unit. +unit_u_add_depend_to=10048_U_Ajout d'une dépendance entre $1 et $2 +% When you use the \var{-vu} flag, the compiler warns that it +% has added a dependency between the two units. +unit_u_no_reload_is_caller=10049_U_Pas de rechargement de $1 qui est l'unité appelante +% When you use the \var{-vu} flag, the compiler warns that it +% has will not reload the unit because it is the unit that wants +% to load this unit +unit_u_no_reload_in_second_compile=10050_U_Pas de rechargement de $1 déjà en cours de recompilation +% When you use the \var{-vu} flag, the compiler warns that it +% has will not reload the unit because it is already in a second recompile +unit_u_flag_for_reload=10051_U_Nécessité de recharger $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to reload the unit +unit_u_forced_reload=10052_U_Rechargement forcé +% When you use the \var{-vu} flag, the compiler warns that it +% has is reloading the unit because it was required +unit_u_previous_state=10053_U_État précédent de l'unité $1 : $2 +% When you use the \var{-vu} flag, the compiler shows the +% previous state of the unit +unit_u_second_compile_unit=10054_U_Recompilation de l'unité $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_loading_unit=10055_U_Chargement de l'unité $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the unit. +unit_u_finished_loading_unit=10056_U_Chargement de l'unité $1 terminé +% When you use the \var{-vu} flag, the compiler warns that it finished +% loading the unit. +unit_u_registering_new_unit=10057_U_Enregistrement de la nouvelle unité $1 +% When you use the \var{-vu} flag, the compiler warns that it has +% found a new unit and registers it in the internal lists. +unit_u_reresolving_unit=10058_U_Re-résolution de l'unité $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to recalculate the internal data of the unit +unit_u_skipping_reresolving_unit=10059_U_Saut de la re-resolution de l'unité $1, chargement des unités utilisées +% When you use the \var{-vu} flag, the compiler warns that it +% skips to recalculate the internal data of the unit because there +% is no data to recalculate +% \end{description} +# EndOfTeX +# +# Options +# +# 11039 is the last used one +# +option_usage=11000_O_$1 [options] <nom_fichier> [options] +# BeginOfTeX +% +% \section{Command-line handling errors} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +option_only_one_source_support=11001_W_Un seul fichier source supporté +% You can specify only one source file on the command line. The first +% one will be compiled, others will be ignored. This may indicate that +% you forgot a \var{'-'} sign. +option_def_only_for_os2=11002_W_Les fichiers DEF ne peuvent être créés que pour OS/2 +% This option can only be specified when you're compiling for OS/2 +option_no_nested_response_file=11003_E_Les fichiers de réponse imbriqués ne sont pas supportés +% you cannot nest response files with the \var{@file} command-line option. +option_no_source_found=11004_F_Pas de nom de fichier source sur la ligne de commande +% The compiler expects a source file name on the command line. +option_no_option_found=11005_N_Aucune option trouvée dans le fichier de configuration $1 +% The compiler didn't find any option in that config file. +option_illegal_para=11006_E_Paramètre illégal: $1 +% You specified an unknown option. +option_help_pages_para=11007_H_-? génère les pages d'aide +% When an unknown option is given, this message is diplayed. +option_too_many_cfg_files=11008_F_Trop de fichiers de configuration imbriqués +% You can only nest up to 16 config files. +option_unable_open_file=11009_F_Ouverture du fichier $1 impossible +% The option file cannot be found. +option_reading_further_from=11010_D_Lecture d'options supplémentaires depuis $1 +% Displayed when you have notes turned on, and the compiler switches +% to another options file. +option_target_is_already_set=11011_W_La destination est déjà définie à: $1 +% Displayed if more than one \var{-T} option is specified. +option_no_shared_lib_under_dos=11012_W_Bibliothèques partagées non supportées sous DOS, retour à une édition de liens statique +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos +option_too_many_ifdef=11013_F_Trop de IF(N)DEF +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_many_endif=11014_F_Trop de ENDIF +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_less_endif=11015_F_Directive de compilation conditionnelle non fermée à la fin du fichier +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_no_debug_support=11016_W_La génération d'informations de débogage n'est pas supportée par cet exécutable +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_Essayez de recompiler avec -dGDB +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_W_Vous utilisez le commutateur obsolète $1 +% this warns you when you use a switch that is not needed/supported anymore. +% It is recommended that you remove the switch to overcome problems in the +% future, when the switch meaning may change. +option_obsolete_switch_use_new=11019_W_Vous utilisez le commutateur obsolète $1, veuillez utiliser $2 +% this warns you when you use a switch that is not supported anymore. You +% must now use the second switch instead. +% It is recommended that you change the switch to overcome problems in the +% future, when the switch meaning may change. +option_switch_bin_to_src_assembler=11020_N_Switching assembler to default source writing assembler +% this notifies you that the assembler has been changed because you used the +% -a switch which can't be used with a binary assembler writer. +option_incompatible_asm=11021_W_La sortie assembleur "$1" n'est pas compatible avec "$2" +option_asm_forced=11022_W_Utilisation de l'assembleur "$1" forcée +% The assembler output selected can not generate +% object files with the correct format. Therefore, the +% default assembler for this target is used instead. +option_using_file=11026_T_Lecture des options depuis le fichier $1 +% Options are also read from this file +option_using_env=11027_T_Lecture des options depuis la variable d'environnement $1 +% Options are also read from this environment string +option_handling_option=11028_D_Utilisation de l'option "$1" +% Debug info that an option is found and will be handled +option_help_press_enter=11029__*** Appuyez sur Entrée *** +option_start_reading_configfile=11030_H_Début de la lecture du fichier de configuration $1 +% Starting of config file parsing. +option_end_reading_configfile=11031_H_Fin de la lecture du fichier de configuration $1 +% End of config file parsing. +option_interpreting_option=11032_D_Interprétation de l'option "$1" +option_interpreting_firstpass_option=11036_D_Interprétation de l'option de 1ère passe "$1" +option_interpreting_file_option=11033_D_Interprétation de l'option de fichier "$1" +option_read_config_file=11034_D_Lecture du fichier de configuration "$1" +option_found_file=11035_D_Fichier source "$1" trouvé +% Additional infos about options, displayed +% when you have debug option turned on. +option_code_page_not_available=11039_E_Page de codes inconnue +option_config_is_dir=11040_F_Le fichier de configuration $1 est un répertoire +% Directories can not be used as configuration files. +%\end{description} +# EndOfTeX +# +# Logo (option -l) +# +option_logo=11023_[ Compilateur Free Pascal version $FPCFULLVERSION [$FPCDATE] for $FPCCPU +Copyright (c) 1993-2011, Florian Klaempfl ] +# +# Info (option -i) +# +option_info=11024_[ Compilateur Free Pascal version $FPCVERSION +Date du compilateur: $FPCDATE +Processeur cible: $FPCCPU +Cibles supportées: $OSTARGETS +Jeu d'instructions CPU supportés: $INSTRUCTIONSETS +Jeu d'instructions FPU supportés: $FPUINSTRUCTIONSETS +Optimisations supportées: $OPTIMIZATIONS +Ce programme est fourni sous la License Publique Générale GNU (GNU GPL). +Pour plus d'informations, consultez le fichier COPYING.FPC. +Rapports de bogues, suggestions, etc. à: + http://bugs.freepascal.org +ou + bugs@freepascal.org ] +# +# Help pages (option -? and -h) +# +# The first character on the line indicates who will display this +# line, the current possibilities are : +# * = every target +# 3 = 80x86 targets +# 6 = 680x0 targets +# e = in extended debug mode only +# P = PowerPC targets +# S = Sparc targets +# V = Virtual machine targets +# The second character also indicates who will display this line, +# (if the above character was TRUE) the current possibilities are : +# * = everyone +# g = with GDB info supported by the compiler +# O = OS/2 +# L = UNIX systems +# The third character represents the indentation level. +# +option_help_pages=11025_[ +**0*_mettre + après un booléen pour activer l'option, - pour la désactiver +**1a_conserve les fichiers assembleurs créés pendant la compilation +**2al_liste le code source dans les fichiers assembleur +**2an_liste les infos de noeud dans le fichier assembleur +*L2ap_utilise des pipes au lieu de fichiers assembleur temporaires +**2ar_liste les allocations de registres dans les fichiers assembleur +**2at_liste les allocations de données temporaire dans la pile +**1A<x>_format de sortie : +**2Adefault_utilise l'assembleur défini par défaut +3*2Aas_fichier objet généré par GNU AS +3*2Anasmcoff_fichier COFF (Go32v2) avec Nasm +3*2Anasmelf_fichier ELF32 (Linux) avec Nasm +3*2Anasmwin32_fichier objet Win32 utilisant Nasm +3*2Anasmwdosx_fichier objet Win32/WDOSX utilisant Nasm +3*2Awasm_fichier objet utilisant Wasm (Watcom) +3*2Anasmobj_fichier OBJ avec Nasm +3*2Amasm_fichier OBJ avec Masm (Microsoft) +3*2Atasm_fichier OBJ avec Tasm (Borland) +3*2Aelf_elf32 (Linux) utilisant le writer interne +3*2Acoff_coff (Go32v2) using internal writer +3*2Apecoff_pecoff (Win32) using internal writer +4*2Aas_fichier objet généré par GNU AS +6*2Aas_fichier .o Unix utilisant GNU AS +6*2Agas_assembleur GNU Motorola +6*2Amit_syntaxe MIT (anciennement GAS) +6*2Amot_assembleur Motorola standard +A*2Aas_assembler avec GNU AS +P*2Aas_assembler avec GNU AS +S*2Aas_assembler avec GNU AS +**1b_génère les informations pour le browser +**2bl_génère les informations locales également +**1B_recompile toutes les unités +**1C<x>_options de génération de code : +**2Cc<x>_définir les convention d'appel <x> par défaut +**2CD_créer une bibliothèque dynamique +**2Ce_compilation avec émulation des opérations à virgule flottante +**2Cf<x>_sélectionner le jeu d'instructions FPU à utiliser, voir fpc -i pour les valeurs possibles +**2Cg_Générer du code PIC +**2Ch<n>_<n> taille du tas en bytes (entre 1023 et 67107840) +**2Ci_IO-checking +**2Cn_pas de linking +**2Co_génère des tests d'overflow pour les opérations sur les entiers +**2Cp<x>_sélectionner le jeu d'instructions, voir fpc -i pour les valeurs possibles +**2Cr_controle d'intervalles +**2CR_vérifier la validité de l'appel à la méthode d'objet +**2Cs<n>_spécifie <n> comme taille de la pile +**2Ct_test de débordement de pile +**2CX_créer également une bibliothèque avec liens optimisés +**1d<x>_définit le symbole <x> +**1D_génère un fichier DEF +**2Dd<x>_assigne la description à <x> +**2Dv<x>_affecter la version <x> à la DLL +*O2Dw_application en mode protégé +**1e<x>_définit le chemin vers l'exécutable +**1E_comme -Cn +**1F<x>_définit des chemins et noms de fichiers : +**2Fa<x>[,y]_Pour un programme charger d'abord les unités <x> et [y] avant que uses ne soit analysé +**2Fc<x>_Utiliser la page de codes <x> en entrée +**2FD<x>_définit le répertoire où chercher les utilitaires de compilation +**2Fe<x>_redirige les erreurs vers le fichier <x> +**2FE<x>_répertoire pour les exe/unités : <x> +**2Fi<x>_ajoute <x> à la liste des répertoires pour fichiers inclus +**2Fl<x>_ajoute <x> à la liste des répertoires pour librairies +**2FL<x>_utilises <x> comme lieur dynamique +**2Fo<x>_ajoute <x> à la liste des répertoires pour fichiers objets +**2Fr<x>_charge le fichier erreur <x> +**2Fu<x>_ajoute <x> à la liste des répertoires pour unités +**2FU<x>_définit le répertoire d'écriture des unités à <x>, en dépit de -FE +*g1g<x>_génère des informations de débogage : +*g2gc_générer des contrôles pour les pointeurs +*g2gd_utilise dbx +*g2gg_utilise gsym +*g2gh_use l'unité de tracage du tas +*g2gl_utiliser l'unité line info pour montrer plus de détails dans les traces +*g2gv_générer des programmes traçables avec valgrind +*g2gw_générer des infos de débogage au format dwarf +**1i_information +**2iD_donne la date du compilateur +**2iV_donne la version du compilateur +**2iW_retourner la version complète du compilateur +**2iSO_donne l'OS du compilateur +**2iSP_donne le processeur du compilateur +**2iTO_donne l'OS cible +**2iTP_donne le processeur cible +**1I<x>_ajoute <x> à la liste des répertoires pour fichiers inclus +**1k<x>_transmet <x> au linker +**1l_écrit le logo +**1M<x>_utiliser le type de langage <x> +**2Mfpc_dialecte Free Pascal (par défaut) +**2Mobjfpc_activation de certaines extensions Delphi 2 +**2Mdelphi_essaye d'être compatible avec Delphi +**2Mtp_essaye d'être compatible avec TP/BP 7.0 +**2Mgpc_essaye d'être compatible avec gpc +**2Mmacpas_essaye d'être compatible avec les dialectes Pascal du Macintosh +**1n_ne pas lire le fichier de configuration par défaut +**1o<x>_change le nom de l'executable en <x> +**1O<x>_optimisations : +3*2Oa_définir l'alignement <type>=<values> +3*2Og_génère du code compact +3*2OG_génère du code rapide (defaut) +3*2Or_garde certaines variables dans des registres +3*2Ou_autorise les optimisations incertaines (voir docs) +3*2O1_optimisations niveau 1 (optimisations rapides) +3*2O2_optimisations niveau 2 (-O1 + optimisations plus lentes) +3*2O3_optimisations niveau 3 (comme -O2u) +3*2Op<x>_processeur cible : +3*3Op1_définit 386/486 comme processeur cible +3*3Op2_définit Pentium/PentiumMMX (tm) comme processeur cycle +3*3Op3_définit PPro/PII/c6x86/K6 (tm) comme processeur cycle +3*3Op4_définit Pentium 4 (tm) comme processeur cycle +3*3Op5_définit Pentium M (tm) comme processeur cycle +6*2Og_génère du code compact +6*2OG_génère du code rapide (par défaut) +6*2Ox_optimiser au maximum (encore BOGUÉ !!!) +6*2O0_définir le processeur cible MC68000 +6*2O2_définir le processeur cible MC68020+ +**1pg_génère du code pour profiler avec gprof (définit FPC_PROFILE) +3*1R<x>_type lecture assembleur : +3*2Ratt_lit l'assembleur AT&T +3*2Rintel_lit l'assembleur Intel +6*2RMOT_lire l'assembleur type motorola +**1S<x>_options de syntaxe : +**2S2_identique à -Mobjfpc +**2Sa_include assertion code. +**2Sc_autorise les operateurs type C (*=,+=,/= et -=) +**2Sd_identique à -Mdelphi +**2Se<x>_erreur d'options. <x> est une combinaison de : +**3*_<n> : le compilateur s'arrête après <n> erreurs (1 par défaut) +**3*_w : le compilateur s'arrête également en cas d'avertissements +**3*_n : le compilateur s'arrête également en cas de notes +**3*_h : le compilateur s'arrête également en cas de suggestions +**2Sg_autorise LABEL et GOTO +**2Sh_utilise les ansistrings +**2Si_supporte les INLINE type C++ +**2SI<x>_définir le style d'interface <x> +**3SIcom_interface compatible COM (par défaut) +**3SIcorba_interface compatible CORBA +**2Sk_charger l'unité fpcylix +**2Sm_support des macros comme C (global) +**2So_identique à -Mtp +**2Sp_identique à -Mgpc +**2Ss_les constructeurs doivent s'appeler init (et les destructeurs done) +**1s_n'appelle pas l'assembleur ni le linker +**2sh_générer un script à lier sur l'hôte +**2st_générer un script à lier sur la cible +**2sr_passer la phase d'allocation de registre (à utiliser avec -alr) +**1T<x>_système d'expliotation cible: +3*2Temx_OS/2 via EMX (et les extensions EMX/RSX) +3*2Tfreebsd_FreeBSD +3*2Tgo32v2_version 2 de l'extension DOS de DJ Delorie +3*2Tlinux_Linux +3*2Tnetbsd_NetBSD +3*2Tnetware_Novell Netware Module (clib) +3*2Tnetwlibc_Novell Netware Module (libc) +3*2Topenbsd_OpenBSD +3*2Tos2_OS/2 / eComStation +3*2Tsunos_SunOS/Solaris +3*2Twatcom_DOS extender compatible avec Watcom +3*2Twdosx_WDOSX DOS extension +3*2Twin32_Windows 32 Bits +4*2Tlinux_Linux +6*2Tamiga_Commodore Amiga +6*2Tatari_Atari ST/STe/TT +6*2Tlinux_Linux/m68k +6*2Tmacos_Macintosh m68k +6*2Tpalmos_PalmOS +A*2Tlinux_Linux +P*2Tdarwin_Darwin et MacOS X pour PowerPC +P*2Tlinux_Linux pour PowerPC +P*2Tmacos_MacOS (classique) pour PowerPC +P*2Tmorphos_MorphOS +S*2Tlinux_Linux +**1u<x>_rend le symbole <x> non défini +**1U_options d'unités : +**2Un_ne pas vérifier le nom de l'unité +**2Ur_générer des fichiers d'unité distribuables +**2Us_compiler en temps qu'unité système +**1v<x>_donne des informations. <x> est une combination des lettres suivantes : +**2*_e : montre les erreurs (défaut) 0 : ne montre rien (sauf les erreurs) +**2*_w : montre les avertissements u : montre les info sur les unités +**2*_n : montre les notes t : montre les fichiers essayés/utilisés +**2*_h : montre les suggestions c : montre les conditionniels +**2*_i : montre des infos générales d : informations de déboggage +**2*_l : montre les numéros de lignes r : mode compatibilité Rhide/GCC +**2*_a : montre tout x : infos Executable (Win32 seulement) +**2*_b : montre le nom des fichiers avec chemin complet dans les messages +**2*_v : écrit fpcdebug.txt avec p : écrit tree.log avec arbre d'analyse +**2*_ un maximum d'informations de débogage +3*1W<x>_options pour cibles de type Win32 +3*2WB_créer une image relogeable +3*2WB<x>_définir la base de l'Image à la valeur hexadecimale <x> +3*2WC_générer une application console +3*2WD_utiliser DEFFILE pour exporter les fonction de la DLL ou de l'EXE +3*2WF_générer une application plein écran (OS/2 seulement) +3*2WG_générer une application graphique +3*2WN_ne pas générer de code relogeable (nécessaire pour le débogage) +3*2WR_générer du code relogeable +P*2WC_générer une application console (MacOS seulement) +P*2WG_générer une application graphique (MacOS seulement) +P*2WT_générer une application utilitaire (MPW tool, MacOS seulement) +**1X_options pour executable : +**2Xc_passer --shared à l'éditeur de liens (Unix seulement) +**2Xd_ne pas utiliser le chemin de recherche des bibliothèques standard (nécessaire à la compilation pour une autre cible) +**2XD_lien avec la librarie dynamique (définit FPC_LINK_DYNAMIC) +**2Xm_générer un fichier MAP +**2XM<x>_définir le nom de la procédure 'main' ('main' par défaut) +**2XP<x>_prepend the binutils names with the prefix <x> +**2Xr<x>_définir <x> comme chemin de recherche des bibliothèques (nécessaire à la compilation pour une autre cible) +**2Xs_enlêve tous les symboles de l'executable +**2XS_lien avec les librairies statiques (définit FPC_LINK_STATIC) +**2Xt_lier avec des bibliothèques statiques (-static est passé à l'éditeur de liens) +**2XX_essayer de lier les unités intelligemment (définit FPC_LINK_SMART) +**1*_ +**1?_affiche cette aide +**1h_affiche cette aide sans attente +] + +# +# The End... diff --git a/closures/compiler/msg/errorhe.msg b/closures/compiler/msg/errorhe.msg new file mode 100644 index 0000000000..e2fbbac9c3 --- /dev/null +++ b/closures/compiler/msg/errorhe.msg @@ -0,0 +1,2708 @@ +# +# This file is part of the Free Pascal Compiler +# Copyright (c) 1999-2008 by the Free Pascal Development team +# +# Hebrew (CP1255) language file for Free Pascal Compiler +# Contributed by Ido Kanner <idokan at gmail.com> and Dotan Kamber <kamberd at yahoo.com> +# Based on errore.msg of SVN revision 8988 +# +# 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. +# +# +# The constants are build in the following order: +# <part>_<type>_<txtidentifier> +# +# <part> is the part of the compiler the message is used +# asmr_ assembler parsing +# asmw_ assembler writing/binary writers +# unit_ unit handling +# scan_ scanner +# parser_ parser +# type_ type checking +# general_ general info +# exec_ calls to assembler, linker, binder +# +# <type> the type of the message it should normally used for +# f_ fatal error +# e_ error +# w_ warning +# n_ note +# h_ hint +# i_ info +# l_ add linenumber +# u_ used +# t_ tried +# c_ conditional +# d_ debug message +# x_ executable informations +# + +# +# General +# +# 01023 is the last used one +# +# BeginOfTeX +% \section{General compiler messages} +% This section gives the compiler messages which are not fatal, but which +% display useful information. The number of such messages can be +% controlled with the various verbosity level \var{-v} switches. +% \begin{description} +general_t_compilername=01000_T_îäãø: $1 +% When the \var{-vt} switch is used, this line tells you what compiler +% is used. +general_d_sourceos=01001_D_îòøëú äôòìä: $1 +% When the \var{-vd} switch is used, this line tells you what the source +% operating system is. +general_i_targetos=01002_I_îòøëú äôòìä îéåòãú: $1 +% When the \var{-vd} switch is used, this line tells you what the target +% operating system is. +general_t_exepath=01003_T_îùúîù áðúéá äøöä: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its binaries. +general_t_unitpath=01004_T_îùúîù áðúéá äéçéãåú: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for compiled units. You can set this path with the \var{-Fu} +general_t_includepath=01005_T_îùúîù áðúéá äîåñó: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its include files (files used in \var{\{\$I xxx\}} statements). +% You can set this path with the \var{-I} option. +general_t_librarypath=01006_T_îùúîù áðúéá äñôøéä: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for the libraries. You can set this path with the \var{-Fl} option. +general_t_objectpath=01007_T_Using object path: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for object files you link in (files used in \var{\{\$L xxx\}} statements). +% You can set this path with the \var{-Fo} option. +general_i_abslines_compiled=01008_I_$1 ùåøåú äåãøå, á$2 ùðéåú +% When the \var{-vi} switch is used, the compiler reports the number +% of lines compiled, and the time it took to compile them (real time, +% not program time). +general_f_no_memory_left=01009_F_ìà ðùàø æëøåï +% The compiler doesn't have enough memory to compile your program. There are +% several remedies for this: +% \begin{itemize} +% \item If you're using the build option of the compiler, try compiling the +% different units manually. +% \item If you're compiling a huge program, split it up in units, and compile +% these separately. +% \item If the previous two don't work, recompile the compiler with a bigger +% heap (you can use the \var{-Ch} option for this, \seeo{Ch}) +% \end{itemize} +general_i_writingresourcefile=01010_I_ëåúá àú ÷åáõ îùàáé èáìú äîçøåæåú: $1 +% This message is shown when the compiler writes the Resource String Table +% file containing all the resource strings for a program. +general_e_errorwritingresourcefile=01011_E_ëåúá àú ÷åáõ îùàáé èáìú äîçøåæåú: $1 +% This message is shown when the compiler encountered an error when writing +% the Resource String Table file +general_i_fatal=01012_I_ùâéàä ÷øéèéú: +% Prefix for Fatal Errors +general_i_error=01013_I_ùâéàä: +% Prefix for Errors +general_i_warning=01014_I_äúøàä: +% Prefix for Warnings +general_i_note=01015_I_äòøä: +% Prefix for Notes +general_i_hint=01016_I_øîæ: +% Prefix for Hints +general_e_path_does_not_exist=01017_E_äðúéá "$1" àéðå ÷ééí +% The specified path does not exist. +general_f_compilation_aborted=01018_F_ääéãåø áåèì +% Compilation was aborted. +general_text_bytes_code=01019_bytes code +general_text_bytes_data=01020_bytes data +general_i_number_of_warnings=01021_I_àæäøåú $1 äåðô÷å +% Total number of warnings issued during compilation. +general_i_number_of_hints=01022_I_äåðô÷å $1 øîæéí +% Total number of hints issued during compilation. +general_i_number_of_notes=01023_I_äåðô÷å $1 äòøåú +% Total number of notes issued during compilation. +% \end{description} +# +# Scanner +# +# 02084 is the last used one +# +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compiling handling. +% \begin{description} +scan_f_end_of_file=02000_F_ñåó ÷åáõ ìà öôåé +% this typically happens in one of the following cases : +% \begin{itemize} +% \item The source file ends before the final \var{end.} statement. This +% happens mostly when the \var{begin} and \var{end} statements aren't +% balanced; +% \item An include file ends in the middle of a statement. +% \item A comment was not closed +% \end{itemize} +scan_f_string_exceeds_line=02001_F_îçøåæú âåìùú îùåøä +% There is a missing closing ' in a string, so it occupies +% multiple lines. +scan_f_illegal_char=02002_F_úå ìà çå÷é "$1" ($2) +% An illegal character was encountered in the input file. +scan_f_syn_expected=02003_F_ùâéàú úçáéø: îöôä ì "$1" àáì "$2" ðîöà +% This indicates that the compiler expected a different token than +% the one you typed. It can occur almost everywhere where you make a +% mistake against the pascal language. +scan_t_start_include_file=02004_TL_îúçéì ÷øéàä ùì ÷åáõ úåñôåú $1 +% When you provide the \var{-vt} switch, the compiler tells you +% when it starts reading an included file. +scan_w_comment_level=02005_W_øîú äòøåú $1 ðîöàä +% When the \var{-vw} switch is used, then the compiler warns you if +% it finds nested comments. Nested comments are not allowed in Turbo Pascal +% and can be a possible source of errors. +scan_n_ignored_switch=02008_N_îúòìí îîúâ îäãø "$1" +% With \var{-vn} on, the compiler warns if it ignores a switch +scan_w_illegal_switch=02009_W_îúâ îäãø "$1" àéðå çå÷é +% You included a compiler switch (i.e. \var{\{\$... \}}) which the compiler +% does not recognise +scan_w_switch_is_global=02010_W_îé÷åí ùâåé ìîúâ îäãø âìåáìé +% The compiler switch is misplaced, and should be located at +% the start of the unit or program. +scan_e_illegal_char_const=02011_E_úå ÷áåò ìà çå÷é +% This happens when you specify a character with its ASCII code, as in +% \var{\#96}, but the number is either illegal, or out of range. +scan_f_cannot_open_input=02012_F_ìà ðéúï ìôúåç àú ÷åáõ "$1" +% \fpc cannot find the program or unit source file you specified on the +% command line. +scan_f_cannot_open_includefile=02013_F_ìà ðéúï ìôúåç àú ÷åáõ äúåñôåú "$1" +% \fpc cannot find the source file you specified in a \var{\{\$include ..\}} +% statement. +scan_e_illegal_pack_records=02015_E_ééùåø øùåîä ìà çå÷é îééöâ "$1" +% You are specifying the \var{\{\$PACKRECORDS n\} } or \var{\{\$ALIGN n\} } +% with an illegal value for \var{n}. For \$PACKRECORDS valid alignments are 1, 2, 4, 8, 16, 32, C, +% NORMAL, DEFAULT, and for \$ALIGN valid alignment are 1, 2, 4, 8, 16, 32, ON, +% OFF. Under mode MacPas \$ALIGN also supports MAC68K, POWER and RESET. +scan_e_illegal_pack_enum=02016_E_îñôø îéðéîìé ùì îðééä äîééöâ "$1" àéðå çå÷é +% You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for +% \var{n}. Only 1,2,4, NORMAL or DEFAULT are valid here. +scan_e_endif_expected=02017_E_îöôä ì$ENDIF áäâãøä $1 $2 äðîöàú á$3 ùåøä $4 +% Your conditional compilation statements are unbalanced. +scan_e_preproc_syntax_error=02018_E_ùâéàú úçáéø áòú ðéúåç îùôè úðàé +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc compiler +% directives. +scan_e_error_in_preproc_expr=02019_E_äòøëú îùôè úðàé +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc compiler +% directives. +scan_w_macro_cut_after_255_chars=02020_W_úåëï äî÷øå îåâáì ìàåøê ùì 255 úååéí +% The contents of macros cannot be longer than 255 characters. +scan_e_endif_without_if=02021_E_ENDIF ììà IF(N)DEF +% Your \var{\{\$IFDEF ..\}} and {\{\$ENDIF\}} statements aren't balanced. +scan_f_user_defined=02022_F_äâãøú îùúîù: $1 +% A user defined fatal error occurred. see also the \progref +scan_e_user_defined=02023_E_äâãøú îùúîù: $1 +% A user defined error occurred. see also the \progref +scan_w_user_defined=02024_W_äâãøú îùúîù: $1 +% A user defined warning occurred. see also the \progref +scan_n_user_defined=02025_N_äâãøú îùúîù: $1 +% A user defined note was encountered. see also the \progref +scan_h_user_defined=02026_H_äâãøú îùúîù: $1 +% A user defined hint was encountered. see also the \progref +scan_i_user_defined=02027_I_äâãøú îùúîù: $1 +% User defined information was encountered. see also the \progref +scan_e_keyword_cant_be_a_macro=02028_E_îéìú îôúç äîåâãøú îçãù ëî÷øå àéðä îëéìä äùôòä +% You cannot redefine keywords with macros. +scan_f_macro_buffer_overflow=02029_F_âìéùú îàâø î÷øå áòú ÷øéàä àå äøçáä ùì î÷øå +% Your macro or its result was too long for the compiler. +scan_w_macro_too_deep=02030_W_äøçáú î÷øå âåìùú îòåî÷ ùì 16. +% When expanding a macro, macros have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_w_wrong_styled_switch=02031_W_ îúâé ôòåìú îäãø àéðí ðúîëéí áäòøåú îñåâ // +% Compiler switches should be in normal pascal style comments. +scan_d_handling_switch=02032_DL_îèôì áîúâ "$1" +% When you set debugging info on (\var{-vd}) the compiler tells you when it +% is evaluating conditional compile statements. +scan_c_endif_found=02033_CL_ðîöà ENDIF $1 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifdef_found=02034_CL_ðîöà IFDEF $1, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifopt_found=02035_CL_ðîöà IFOPT $1, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_if_found=02036_CL_ðîöà IF $1, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifndef_found=02037_CL_ðîöà IFNDEF $1, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_else_found=02038_CL_ðîöà ELSE $1, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_skipping_until=02039_CL_îãìâ... +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements, and whether it is skipping or +% compiling parts. +scan_i_press_enter=02040_I_ìçõ òì <return> ìäîùéê +% When the \var{-vi} switch is used, the compiler stops compilation +% and waits for the \var{Enter} key to be pressed when it encounters +% a \var{\{\$STOP\}} directive. +scan_w_unsupported_switch=02041_W_îúâ "$1" àéðå ðúîê +% When warnings are turned on (\var{-vw}) the compiler warns you about +% unsupported switches. This means that the switch is used in Delphi or +% Turbo Pascal, but not in \fpc +scan_w_illegal_directive=02042_W_äåøàú äîäãø "$1" àéðä çå÷éú +% When warings are turned on (\var{-vw}) the compiler warns you about +% unrecognised switches. For a list of recognised switches, \progref +scan_t_back_in=02043_TL_çæøä á$1 +% When you use (\var{-vt}) the compiler tells you when it has finished +% reading an include file. +scan_w_unsupported_app_type=02044_W_àéï úîéëä ìñåâ äàôìé÷öéä: "$1" +% You get this warning, if you specify an unknown application type +% with the directive \var{\{\$APPTYPE\}} +scan_w_app_type_not_support=02045_W_APPTYPE àéðå ðúîê ò"é ääîòøëú äôòìä äîáå÷ùú +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_w_description_not_support=02046_W_DESCRIPTION àéðå ðúîê ò"é îòøëú ääôòìä äîáå÷ùú +% The \var{\{\$DESCRIPTION\}} directive is not supported on this target OS +scan_n_version_not_support=02047_N_VERSION àéðå ðúîê ò"é îòøëú äôòìä äîáå÷ùú +% The \var{\{\$VERSION\}} directive is not supported on this target OS +scan_n_only_exe_version=02048_N_VERSION ø÷ ì÷áöé exe àå DLL +% The \var{\{\$VERSION\}} directive is only used for executable or DLL sources. +scan_w_wrong_version_ignored=02049_W_ôåøîè ùâåé ìäåøàú VERSION: "$1" +% The \var{\{\$VERSION\}} directive format is majorversion.minorversion +% where majorversion and minorversion are words. +scan_e_illegal_asmmode_specifier=02050_E_ñâðåï äàñîáìø ùöåééï "$1" àéðå çå÷é +% When you specify an assembler mode with the \var{\{\$ASMMODE xxx\}} +% the compiler didn't recognize the mode you specified. +scan_w_no_asm_reader_switch_inside_asm=02051_W_îúâ ÷åøà äASM àéðå àôùøé áúåê îùôè àñîáìé. "$1" éäéä éùôéò ø÷ áäëøæä äáàä/ +% It is not possible to switch from one assembler reader to another +% inside an assembler block. The new reader will be used for next +% assembler statements only. +scan_e_wrong_switch_toggle=02052_E_ùéîåù ùâåé áîúâ. äùúîù áON/OFF àå á +/- +% You need to use ON or OFF or a + or - to toggle the switch +scan_e_resourcefiles_not_supported=02053_E_÷åáõ äîùàáéí àéðå ðúîê áéòã äðáçø +% The target you are compiling for doesn't support resource files. +scan_w_include_env_not_found=02054_W_îùúðä äñáéáä "$1" ìà ðîöà áñáéáä +% The included environment variable can't be found in the environment, it will +% be replaced by an empty string instead. +scan_e_invalid_maxfpureg_value=02055_E_òøê ìà çå÷é ìäâáìåú àåâø äFPC +% Valid values for this directive are 0..8 and NORMAL/DEFAULT +scan_w_only_one_resourcefile_supported=02056_W_ø÷ ÷åáõ îùàáéí àçã ðúîê áéòã æä +% The target you are compiling for supports only one resource file. +% The first resource file found is used, the others are discarded. +scan_w_macro_support_turned_off=02057_W_äúîéëä áî÷øå ëåáä +% A macro declaration has been found, but macro support is currently off, +% so the declaration will be ignored. To turn macro support on compile with +% -Sm on the commandline or add \{\$MACRO ON\} in the source +scan_e_invalid_interface_type=02058_E_äåëøæ ñåâ îîù÷ ìà çå÷é. äâãøåú çå÷éåú äí COM, CORBA àå DEFAULT +% The interface type that was specified is not supported +scan_w_appid_not_support=02059_W_APPID ðúîê ø÷ áPALMOS +% The \var{\{\$APPID\}} directive is only supported for the PalmOS target. +scan_w_appname_not_support=02060_W_APPNAME ðúîê ø÷ áPALMOS +% The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target. +scan_e_string_exceeds_255_chars=02061_E_îçøåæú ÷áåòä ìà éëåìä ìäéåú îòì 255 úååéí +% A single string constant can contain at most 255 chars. Try splitting up the +% string in multiple smaller parts and concatenate them with a + operator. +scan_f_include_deep_ten=02062_F_äåñôú ÷áöé äinclude âìù îòåî÷ ä16 +% When including include files the files have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_e_too_many_push=02063_F_éåúø îéãé ùëáåú PUSH +% A maximum of 20 levels is allowed. This error occurs only in mode MacPas. +scan_e_too_many_pop=02064_E_POP ììà ùçøåø ùì PUSH +% This error occurs only in mode MacPas. +scan_e_error_macro_lacks_value=02065_E_î÷øå "$1" ìà îëéì òøëéí +% Thus the conditional compile time expression cannot be evaluated. +scan_e_wrong_switch_toggle_default=02066_E_ùéîåù áîúâ ùâåé, äùúîù á ON/OFF/DEFAULT àå á+/-/* +% You need to use ON or OFF or DEFAULT or a + or - or * to toggle the switch +scan_e_mode_switch_not_allowed=02067_E_îöá îúâ "$1" ìà îåøùä +% A mode switch has already been encountered, or, in case of option -Mmacpas, +% a mode switch occur after UNIT. +scan_e_error_macro_undefined=02068_E_îùúðä æîï äéãåø "$1" ìà äåâãø. +% Thus the conditional compile time expression cannot be evaluated. Only in mode MacPas. +scan_e_utf8_bigger_than_65535=02069_E_ðîöà ÷åã UTF-8 âáåää éåúø î65535 +% \fpc handles utf-8 strings internally as widestrings e.g. the char codes are limited to 65535 +scan_e_utf8_malformed=02070_E_îçøåæú UTF-8 ú÷åìä +% The given string isn't a valid UTF-8 string +scan_c_switching_to_utf8=02071_C_UTF-8 signature found, using UTF-8 encoding +% The compiler found an UTF-8 encoding signature (\$ef, \$bb, \$bf) at the beginning of a file, +% so it interprets it as an UTF-8 file +scan_e_compile_time_typeerror=02072_E_áéèåé áæîï äéãåø: ðãøù $1 àáì äú÷áì $2 á$3 +% Type check of a compile time expression failed. +scan_n_app_type_not_support=02073_N_APPTYPE ìà ðúîê áîòøëú ääôòìä äîáå÷ùú +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_e_illegal_optimization_specifier=02074_E_ñåô÷ îéèåá ìà çå÷é "$1" +% When you specify an optimization with the \var{\{\$OPTIMIZATION xxx\}} +% the compiler didn't recognize the optimization you specified. +scan_w_setpeflags_not_support=02075_W_SETPEFLAGS àéðå ðúîê áîòøëú ääôòìä äîáå÷ùú +% The \var{\{\$SETPEFLAGS\}} directive is not supported by the target OS +scan_w_imagebase_not_support=02076_W_IMAGEBASE àéðå ðúîê òì éãé îòøëú ääôòìä äîáå÷ùú +% The \var{\{\$IMAGEBASE\}} directive is not supported by the target OS +scan_w_minstacksize_not_support=02077_W_MINSTACKSIZE àéðå ðúîê òì éãé îòøëú ääôòìä äîáå÷ùú +% The \var{\{\$MINSTACKSIZE\}} directive is not supported by the target OS +scan_w_maxstacksize_not_support=02078_W_MAXSTACKSIZE àéðå ðúîê òì éãé îòøëú ääôòìä äîáå÷ùú +% The \var{\{\$MAXSTACKSIZE\}} directive is not supported by the target OS +scanner_e_illegal_warn_state=02079_E_ùéîåù ìà çå÷é áäðçéú $WARN +% Only ON and OFF can be used as state with a \$warn compiler directive +scan_e_only_packset=02080_E_òøê ùì àøéæä ìà çå÷é +% Only 0, 1, 2, 4, 8, DEFAULT and NORMAL are allowed as packset parameter +scan_w_pic_ignored=02081_W_îúòìí îäåøàú PIC +% Several targets like windows do not support neither need PIC so the PIC directive and switch are +% ignored. +scan_w_unsupported_switch_by_target=02082_W_äîúâ "$1" àéðå ðúîê áñåâ úåöàä ùðáçø +% Some compiler switches like \$E are not supported by all targets. +scan_w_frameworks_darwin_only=02084_W_àôùøåéåú îáåññåú îñâøú ðúîëåú ø÷ òáåø Darwin/Mac OS X +% Frameworks are not a known concept, or at least not supported by FPC, on operating systems other than Darwin/Mac OS X. +scan_e_illegal_minfpconstprec=02085_E_ãéå÷ äòøê ä÷áåò ùì äð÷åãä äòùøåðéú äîéðéîìéú "$1" àéðå çå÷é +% Valid minimal precisions for floating point constants are default, 32 and 64, which mean respectively minimal (usually 32 bit), 32 bit and 64 bit precision. +% \end{description} +# +# Parser +# +# 03192 is the last used one +# +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your pascal constructs +% are correct. +% \begin{description} +parser_e_syntax_error=03000_E_îôøù - ùâéàä úçáéøéú +% An error against the Turbo Pascal language was encountered. This happens +% typically when an illegal character is found in the sources file. +parser_e_dont_nest_interrupt=03004_E_ôøåöãåøú ôñé÷ä àéðä éëåìä ìäéåú î÷åððú +% An \var{INTERRUPT} procedure must be global. +parser_w_proc_directive_ignored=03005_W_îúòìí îñåâ ôøåöãåøä "$1" +% The specified procedure directive is ignored by FPC programs. +parser_e_no_overload_for_all_procs=03006_E_ìà ëì ääëæøåú ùì "$1" áòìåú äëøæú OVERLOAD +% When you want to use overloading using the \var{OVERLOAD} directive, then +% all declarations need to have \var{OVERLOAD} specified. +parser_e_export_name_double=03008_E_ëôéìåéåú áééöåà ùí äôåð÷öéä "$1" +% Exported function names inside a specific DLL must all be different +parser_e_export_ordinal_double=03009_E_ëôéìåéåú áééöåà àéðã÷ñ äôåð÷öéä "$1" +% Exported function names inside a specific DLL must all be different +parser_e_export_invalid_index=03010_E_àéðã÷ñ ìà ú÷éï ìééöåà äôåð÷öéä +% DLL function index must be in the range \var{1..\$FFFF} +parser_w_parser_reloc_no_debug=03011_W_ùéðåé îé÷åí ðúåðé äðéôåé ìà òåáãéí ì÷áöé DLL àå ÷áöé äøöä. äúáèì. +parser_w_parser_win32_debug_needs_WN=03012_W_ìàôùø ðéôåé ùâéàåú ìwin32 éù ìáèì àú ùéðåé äîé÷åí ò"é äàôùøåú -WN +% Stabs info is wrong for relocatable DLL or EXES use -WN +% if you want to debug win32 executables. +parser_e_constructorname_must_be_init=03013_E_ùí éåöø çééá ìäéåú INIT +% You are declaring an object constructor with a name which is not \var{init}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_destructorname_must_be_done=03014_E_ùí äåøñ çééá ìäéåú DONE +% You are declaring an object destructor with a name which is not \var{done}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_proc_inline_not_supported=03016_E_ôøåöãåøú INLINE ìà ðúîëú +% You tried to compile a program with C++ style inlining, and forgot to +% specify the \var{-Si} option (\seeo{Si}). The compiler doesn't support C++ +% styled inlining by default. +parser_w_constructor_should_be_public=03018_W_éåöø öøéê ìäéåú öéáåøé +% Constructors must be in the 'public' part of an object (class) declaration. +parser_w_destructor_should_be_public=03019_W_äåøñ öøéê ìäéåú öéáåøé +% Destructors must be in the 'public' part of an object (class) declaration. +parser_n_only_one_destructor=03020_N_îçì÷ä öøéëä äåøñ àçã áìáã +% You can declare only one destructor for a class. +parser_e_no_local_objects=03021_E_äâãøåú îçì÷ä î÷åîéåú àéðí îåøùåú +% Classes must be defined globally. They cannot be defined inside a +% procedure or function +parser_f_no_anonym_objects=03022_F_äâãøåú îçì÷ä àðåðéîéåú àéðí îåøùåú +% An invalid object (class) declaration was encountered, i.e. an +% object or class without methods that isn't derived from another object or +% class. For example: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% will trigger this error. +parser_n_object_has_no_vmt=03023_N_äàåáéé÷è "$1" ììà VMT +% This is a note indicating that the declared object has no +% virtual method table. +parser_e_illegal_parameter_list=03024_E_øùéîú ôøîèøéí ìà çå÷éú +% You are calling a function with parameters that are of a different type than +% the declared parameters of the function. +parser_e_wrong_parameter_size=03026_E_îñôø ùâåé ùì ôøîèøéí öåéï òáåø ä÷øéàä ì "$1" +% There is an error in the parameter list of the function or procedure, +% the number of parameters is not correct. +parser_e_overloaded_no_procedure=03027_E_îæää äîøåáä ùéîåù "$1" àéðå ôåð÷öéä +% The compiler encountered a symbol with the same name as an overloaded +% function, but it is not a function it can overload. +parser_e_overloaded_have_same_parameters=03028_E_ôåð÷öéåú îøåáåú ùéîåù îëéìåú àú àåúí øùéîú ôøîèøéí +% You're declaring overloaded functions, but with the same parameter list. +% Overloaded function must have at least 1 different parameter in their +% declaration. +parser_e_header_dont_match_forward=03029_E_äâãøú äôåð÷öéä àéðä úåàîú àú ääâãøä ä÷åãîú "$1" +% You declared a function with same parameters but +% different result type or function modifiers. +parser_e_header_different_var_names=03030_E_äâãøú äôåð÷öéä "$1" àéðä úåàîú àú äîéîåù: ùí îùúðä äùúðä $2 => $3 +% You declared the function in the \var{interface} part, or with the +% \var{forward} directive, but define it with a different parameter list. +parser_n_duplicate_enum=03031_N_òøëéí áñåâ îðéä çééáéí ìäéåú áñãø òåìä +% \fpc allows enumeration constructions as in C. Given the following +% declaration two declarations: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% The second declaration would produce an error. \var{A\_UAS} needs to have a +% value higher than \var{A\_E}, i.e. at least 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_With àéðå îñåâì ìäùúîù áîùúðéí îî÷èò ùåðä +% With stores a variable locally on the stack, +% but this is not possible if the variable belongs to another segment. +parser_e_too_much_lexlevel=03034_E_ôåð÷öéä î÷åððú > 31 +% You can nest function definitions only 31 times. +parser_e_range_check_error=03035_E_ùâéàä ááãé÷ú èååç áòú äòøëú ÷áåòéí +% The constants are out of their allowed range. +parser_w_range_check_error=03036_W_ùâéàä ááãé÷ú èååç áòú äòøëú ÷áåòéí +% The constants are out of their allowed range. +parser_e_double_caselabel=03037_E_äëæøú úååéú ëôåìä ácase +% You are specifying the same label 2 times in a \var{case} statement. +parser_e_case_lower_less_than_upper_bound=03038_E_äèååç äñåôé ÷èï îäèååç ääúçìúé +% The upper bound of a \var{case} label is less than the lower bound and this +% is useless +parser_e_type_const_not_possible=03039_E_äëøæú èéôåñ ÷áåòéí ùì îçì÷åú àå îîù÷éí àñåøä +% You cannot declare a constant of type class or object. +parser_e_no_overloaded_procvars=03040_E_îùúðéí ùì ôåð÷öéåú îøåáåú ùéîåù àéðí îåøùåú +% You are trying to assign an overloaded function to a procedural variable. +% This is not allowed +parser_e_invalid_string_size=03041_E_àåøê îçøåæú çééá ìäéåú òí òøëéí î1 ì255 +% The length of a shortstring in Pascal is limited to 255 characters. You are +% trying to declare a string with length lower than 1 or greater than 255 +parser_w_use_extended_syntax_for_objects=03042_W_äùúîù áúçáéø îåøçá ùì NEW åDISPOSE ìòåú÷éí ùì àåáéé÷è +% If you have a pointer \var{a} to a class type, then the statement +% \var{new(a)} will not initialize the class (i.e. the constructor isn't +% called), although space will be allocated. you should issue the +% \var{new(a,init)} statement. This will allocate space, and call the +% constructor of the object +parser_w_no_new_dispose_on_void_pointers=03043_W_äùéîåù áîöáéò ìà îåâãø òí NEW å DISPOSE çñø îùîòåú +parser_e_no_new_dispose_on_void_pointers=03044_E_áìúé àôùøé ìäùúîù áîöáéò ìà îåâãø òí NEW àå DISPOSE +% You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer +% because no size is associated to an untyped pointer. +% Accepted for compatibility in \var{tp} and \var{delphi} modes. +parser_e_class_id_expected=03045_E_îöôä ìîæää îçì÷ä +% This happens when the compiler scans a procedure declaration that contains +% a dot, +% i.e., a object or class method, but the type in front of the dot is not +% a known type. +parser_e_no_type_not_allowed_here=03046_E_ñåâ îæää ìà îåøùä áîé÷åí äðåëçé +% You cannot use a type inside an expression. +parser_e_methode_id_expected=03047_E_îöôä ìîæää îúåãé +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_e_header_dont_match_any_member=03048_E_äâãøú äôåð÷öéä ìà æää ìîúåãåú ùì äîçì÷ä "$1" +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_d_procedure_start=03049_DL_ôøåöãåøä/ôåð÷öéä $1 +% When using the \var{-vd} switch, the compiler tells you when it starts +% processing a procedure or function implementation. +parser_e_error_in_real=03050_E_÷áåò ùì îñôø îîùé àéðå çå÷é +% The compiler expects a floating point expression, and gets something else. +parser_e_fail_only_in_constructor=03051_E_FAIL éëåì ìäéåú áùéîåù ø÷ áúåê éåöø +% You are using the \var{fail} keyword outside a constructor method. +parser_e_no_paras_for_destructor=03052_E_äåøñéí ìà éëåìéí ìäëéì ôøîèøéí +% You are declaring a destructor with a parameter list. Destructor methods +% cannot have parameters. +parser_e_only_class_methods_via_class_ref=03053_E_ø÷ îúåãåú îçì÷ä éëåìåú ìäéåú îåâãøåú áäúééçñåú îçì÷ä +% This error occurs in a situation like the following: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} is not a class method and hence cannot be called with a class +% reference. +parser_e_only_class_methods=03054_E_ø÷ îúåãú îçì÷ä éëåìä ìâùú ìîúåãú îçì÷ä +% This is related to the previous error. You cannot call a method of an object +% from a inside a class method. The following code would produce this error: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% Because free is a normal method of a class it cannot be called from a class +% method. +parser_e_case_mismatch=03055_E_÷áåòéí åñåâ CASE àéðí îúàéîéí +% One of the labels is not of the same type as the case variable. +parser_e_illegal_symbol_exported=03056_E_ìà ðéúï ìééöà àú äñîì îñôøééä +% You can only export procedures and functions when you write a library. You +% cannot export variables or constants. +parser_w_should_use_override=03057_W_îúåãú éøåùä ðñúøú ò"é "$1" +% A method that is declared \var{virtual} in a parent class, should be +% overridden in the descendent class with the \var{override} directive. If you +% don't specify the \var{override} directive, you will hide the parent method; +% you will not override it. +parser_e_nothing_to_be_overridden=03058_E_àéï îúåãä áîçì÷ä ùì äàá àùø ðéúï ìùëúá: "$1" +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_no_procedure_to_access_property=03059_E_ìà ðéúï îñôø ìâùú ìîàôééï +% You specified no \var{read} directive for a property. +parser_w_stored_not_implemented=03060_W_îàôééï ùîåø àéðå îáåöò òãééï +% The \var{stored} directive is not yet implemented +parser_e_ill_property_access_sym=03061_E_ñéîï ìà çå÷é ìâéùú äîàôééï +% There is an error in the \var{read} or \var{write} directives for an array +% property. When you declare an array property, you can only access it with +% procedures and functions. The following code would cause such an error. +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_ìà ðéúï ìâùú ìùãä îåâï áàåáéé÷è äðåëçé +% Fields that are declared in a \var{protected} section of an object or class +% declaration cannot be accessed outside the module where the object is +% defined, or outside descendent object methods. +parser_e_cant_access_private_member=03063_E_ìà ðéúï ìâùú ìùãä ôøèé áàåá÷ééè äðåëçé +% Fields that are declared in a \var{private} section of an object or class +% declaration cannot be accessed outside the module where the class is +% defined. +parser_e_overridden_methods_not_same_ret=03066_E_îúåãä îøåáú ùéîåù çééáú ìäéåú æää áñåâ äîùúðä: "$2" áùéîåù ò"é "$1", àùø îëéìä ñåâ îùúðä àçø +% If you declare overridden methods in a class definition, they must +% have the same return type. +parser_e_dont_nest_export=03067_E_äâããøú ôåð÷öéåú EXPORT ìà éëåìåú ìäéåú î÷åððåú +% You cannot declare a function or procedure within a function or procedure +% that was declared as an export procedure. +parser_e_methods_dont_be_export=03068_E_àé àôùø ìééöà àú äîúåãä +% You cannot declare a procedure that is a method for an object as +% \var{export}ed. +parser_e_call_by_ref_without_typeconv=03069_E_äùéîåù áôøîèø ùì îùúðä çééá ìäéåú æää: îëéì "$1" îöôä ì"$2" +% When calling a function declared with \var{var} parameters, the variables in +% the function call must be of exactly the same type. There is no automatic +% type conversion. +parser_e_no_super_class=03070_E_äîçì÷ä àéððä îçì÷ú àá ùì äîçì÷ä äðåëçéú +% When calling inherited methods, you are trying to call a method of a non-related +% class. You can only call an inherited method of a parent class. +parser_e_self_not_in_method=03071_E_SELF îåøùä ø÷ áîúåãåú +% You are trying to use the \var{self} parameter outside an object's method. +% Only methods get passed the \var{self} parameters. +parser_e_generic_methods_only_in_methods=03072_E_îúåãåú éëåìåú ìäé÷øà éùéøåú ø÷ áúåê îúåãåú àçøåú òí ñåâ îæää ùìäîçì÷ä +% A construction like \var{sometype.somemethod} is only allowed in a method. +parser_e_illegal_colon_qualifier=03073_E_ùéîåù ìà çå÷é ùì ':' +% You are using the format \var{:} (colon) 2 times on an expression that +% is not a real expression. +parser_e_illegal_set_expr=03074_E_ùâéàä ááãé÷ú èååç áñãøú éåöøéí àå ùëôåì ñãøä +% The declaration of a set contains an error. Either one of the elements is +% outside the range of the set type, either two of the elements are in fact +% the same. +parser_e_pointer_to_class_expected=03075_E_îöôä ìîöáéò àåáéé÷è +% You specified an illegal type in a \var{new} statement. +% The extended syntax of \var{new} needs an object as a parameter. +parser_e_expr_have_to_be_constructor_call=03076_E_äáéèåé çééá ìäéåú ÷øéàú éåöø +% When using the extended syntax of \var{new}, you must specify the constructor +% method of the object you are trying to create. The procedure you specified +% is not a constructor. +parser_e_expr_have_to_be_destructor_call=03077_E_äáéèåé çééá ìäéåú ÷øéàú äåøñ +% When using the extended syntax of \var{dispose}, you must specify the +% destructor method of the object you are trying to dispose of. +% The procedure you specified is not a destructor. +parser_e_invalid_record_const=03078_E_ñãø ìà çå÷é ùì àìîðèéí áøùåîä +% When declaring a constant record, you specified the fields in the wrong +% order. +parser_e_false_with_expr=03079_E_ñåâ áéèåé çééá ìäéåú áéèåé øùåîä àå îçì÷ä +% A \var{with} statement needs an argument that is of the type \var{record} +% or \var{class}. You are using \var{with} on an expression that is not of +% this type. +parser_e_void_function=03080_E_ôøåöãåøä ìà éëåìä ìäçæéø òøê +% In \fpc, you can specify a return value for a function when using +% the \var{exit} statement. This error occurs when you try to do this with a +% procedure. Procedures cannot return a value. +parser_e_only_methods_allowed=03081_E_äéåöøéí åääåøñéí çééáéí ìäéåú îúåãééí +% You're declaring a procedure as destructor, constructor or class operator, when the +% procedure isn't a class method. +parser_e_operator_not_overloaded=03082_E_äàåôøéèåø ìà îøåáä ùéîåù +% You're trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_no_such_assignment=03083_E_ìà ðéúï ìäöéá òøëéí ìñåâéí îøåáé ùéîåù +% You can not overload assignment for types +% that the compiler considers as equal. +parser_e_overload_impossible=03084_E_áìúé àôùøé ìäùúîù áàåôøèåø îøåáä ùéîåù +% The combination of operator, arguments and return type are +% incompatible. +parser_e_no_reraise_possible=03085_E_ìà ðéúï ìäøéí çøéâä +% You are trying to raise an exception where it is not allowed. You can only +% raise exceptions in an \var{except} block. +parser_e_no_new_or_dispose_for_classes=03086_E_äúçáéø äîåøçá ùì NEW àå DISPOSE ìà îåøùä ìîçì÷åú +% You cannot generate an instance of a class with the extended syntax of +% \var{new}. The constructor must be used for that. For the same reason, you +% cannot call \var{dispose} to de-allocate an instance of a class, the +% destructor must be used for that. +parser_e_procedure_overloading_is_off=03088_E_äàôùøåú ìôøåöãåøåú îøåáåú ùéîåù ëáåé +% When using the \var{-So} switch, procedure overloading is switched off. +% Turbo Pascal does not support function overloading. +parser_e_overload_operator_failed=03089_E_ìà ðéúï ìäòîéñ òì ñåâ äàåôøèåø äðåëçé. äòîñú äàåôøèåøéí ä÷ùåøéí ìôòåìä (àí áëìì) äí: $1 +% You are trying to overload an operator which cannot be overloaded. +% The following operators can be overloaded : +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_àåôøèåø äùååàúé çééá ìäçæéø òøê áåìéàðé +% When overloading the \var{=} operator, the function must return a boolean +% value. +parser_e_only_virtual_methods_abstract=03091_E_ø÷ ùéèä ååéøèåàìéú éëåìä ìäéåú îåôùè +% You are declaring a method as abstract, when it is not declared to be +% virtual. +parser_f_unsupported_feature=03092_F_ùéîåù áàåôöéä ìà ðúîëú! +% You're trying to force the compiler into doing something it cannot do yet. +parser_e_mix_of_classes_and_objects=03093_E_äòøáåá ùì òöîéí ùåðéí (îçì÷åú, òöí, îîù÷ åëå') àéðå îåøùä +% You cannot derive \var{objects}, \var{classes}, \var{cppclasses} and \var{interfaces} interttwined . E.g. +% a class cannot have an object as parent and vice versa. +parser_w_unknown_proc_directive_ignored=03094_W_îúòìí îäðçéú äùâøä: "$1" +% The procedure directive you specified is unknown. +parser_e_absolute_only_one_var=03095_E_absolute ðéúï ìùéîåù ø÷ òí îùúðä àçú +% You cannot specify more than one variable before the \var{absolute} directive. +% Thus, the following construct will provide this error: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +% \item [ absolute can only be associated a var or const ] +% The address of a \var{absolute} directive can only point to a variable or a +% typed constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_absolute_only_to_var_or_const=03096_E_ðéúï ìäùúîù áabsolute ø÷ òí îùúðä àå ÷áåò +% The address of a \var{absolute} directive can only point to a variable or +% constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_initialized_only_one_var=03097_E_ðéúï ìàúçì ø÷ îùúðä àçã +% You cannot specify more than one variable with a initial value +% in Delphi mode. +parser_e_abstract_no_definition=03098_E_îúåãä îåôùèú àéðä æ÷å÷ä ìäâãøä (òí âåó ùì ôåð÷öéä) +% Abstract methods can only be declared, you cannot implement them. They +% should be overridden by a descendant class. +parser_e_overloaded_must_be_all_global=03099_E_äòîñú äéúø ùì äôåð÷öéä àéðä éëåìä ìäéåú î÷åîéú (çééáú ìäéåú îéåöàú) +% You are defining a overloaded function in the implementation part of a unit, +% but there is no corresponding declaration in the interface part of the unit. +parser_w_virtual_without_constructor=03100_W_ùéîåù áîúåãåú ååéøèåàìéåú ììà éåöø á "$1" +% If you declare objects or classes that contain virtual methods, you need +% to have a constructor and destructor to initialize them. The compiler +% encountered an object or class with virtual methods that doesn't have +% a constructor/destructor pair. +parser_c_macro_defined=03101_CL_äâãøú îà÷øå: $1 +% When \var{-vc} is used, the compiler tells you when it defines macros. +parser_c_macro_undefined=03102_CL_îà÷øå ìà îåâãø: $1 +% When \var{-vc} is used, the compiler tells you when it undefines macros. +parser_c_macro_set_to=03103_CL_îà÷øå $1 îåâãø ë $2 +% When \var{-vc} is used, the compiler tells you what values macros get. +parser_i_compiling=03104_I_îäãø $1 +% When you turn on information messages (\var{-vi}), the compiler tells you +% what units it is recompiling. +parser_u_parsing_interface=03105_UL_îôøù àú äîîù÷ ùì äéçéãä $1 +% This tells you that the reading of the interface +% of the current unit starts +parser_u_parsing_implementation=03106_UL_îôøù àú äáéöåò ùì $1 +% This tells you that the code reading of the implementation +% of the current unit, library or program starts +parser_d_compiling_second_time=03107_DL_îäãø àú $1 áôòí äùðééä +% When you request debug messages (\var{-vd}) the compiler tells you what +% units it recompiles for the second time. +parser_e_no_property_found_to_override=03109_E_ìà ðîöàä úëåðä ìò÷éôä +% You want to override a property of a parent class, when there is, in fact, +% no such property in the parent class. +parser_e_only_one_default_property=03110_E_ø÷ úëåðä àçú òí áøéøú îçãì îåøùú +% You specified a property as \var{Default}, but the class already has a +% default property, and a class can have only one default property. +parser_e_property_need_paras=03111_E_äúåðä òí áøéøú îçãì çééáú ìäéåú úëåðä ùì îòøê +% Only array properties of classes can be made \var{default} properties. +parser_e_constructor_cannot_be_not_virtual=03112_E_éåöøéí ååéøèåàìéí ðúîëéí ø÷ áîçì÷ä +% You cannot have virtual constructors in objects. You can only have them +% in classes. +parser_e_no_default_property_available=03113_E_òøê áøéøú îçãì àéðå ÷ééí ìúëåðä +% You are trying to access a default property of a class, but this class (or one of +% its ancestors) doesn't have a default property. +parser_e_cant_have_published=03114_E_äîçì÷ä àéðä éëåìä ìäëéì àú çúê published, äùúîù áîúâ {$M+} +% If you want a \var{published} section in a class definition, you must +% use the \var{\{\$M+\}} switch, whch turns on generation of type +% information. +parser_e_forward_declaration_must_be_resolved=03115_E_ðãøùú äâãøä øàùåðéú ùì äîçì÷ä "$1" ìôðé äùéîåù áä ëîçì÷ä éåøùú +% To be able to use an object as an ancestor object, it must be defined +% first. This error occurs in the following situation: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% Where \var{ParentClass} is declared but not defined. +parser_e_no_local_operator=03116_E_äùéîåù áàåôøéèåø î÷åîé àéðå ðúîê +% You cannot overload locally, i.e. inside procedures or function +% definitions. +parser_e_proc_dir_not_allowed_in_interface=03117_E_î÷ãí ùéâøä "$1" àéðå îåøùä áùéîåù áúåê äîîù÷ +% This procedure directive is not allowed in the \var{interface} section of +% a unit. You can only use it in the \var{implementation} section. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_î÷ãí ùéâøä "$1" àéðå îåøùä áçì÷ äáéöåòé +% This procedure directive is not defined in the \var{implementation} section of +% a unit. You can only use it in the \var{interface} section. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_î÷ãí ùéâøä "$1" àéðå îåøùä ëçì÷ îäâãøú äùéâøä +% This procedure directive cannot be part of a procedural or function +% type declaration. +parser_e_function_already_declared_public_forward=03120_E_äâãøú äôåð÷öéä "$1" ëáø áåöòä +% You will get this error if a function is defined as \var{forward} twice. +% Or it is once in the \var{interface} section, and once as a \var{forward} +% declaration in the \var{implmentation} section. +parser_e_not_external_and_export=03121_E_ìà ðéúï ìäùúîù âí á EXPORT åâí EXTERNAL +% These two procedure directives are mutually exclusive +parser_w_not_supported_for_inline=03123_W_"$1" àéðå ðúîê òãééï áúåê ôåð÷öéú/ùâøú inline +% Inline procedures don't support this declaration. +parser_w_inlining_disabled=03124_W_äùéîåù äéùéø îáåèì +% Inlining of procedures is disabled. +parser_i_writing_browser_log=03125_I_ëåúá éåîï ãôãôï $1 +% When information messages are on, the compiler warns you when it +% writes the browser log (generated with the \var{\{\$Y+ \}} switch). +parser_h_maybe_deref_caret_missing=03126_H_ééúëï ëé çñø úåëï ìîöáéò +% The compiler thinks that a pointer may need a dereference. +parser_f_assembler_reader_not_supported=03127_F_àéï úîéëä áîàñó äðáçø +% The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not +% supported. The compiler can be compiled with or without support for a +% particular assembler reader. +parser_e_proc_dir_conflict=03128_E_î÷ãí äùéâøä "$1" îúðâù òí î÷ãîéí àçøéí +% You specified a procedure directive that conflicts with other directives. +% for instance \var{cdecl} and \var{pascal} are mutually exclusive. +parser_e_call_convention_dont_match_forward=03129_E_äùéîåù áäâãøä äðåëçéú àéðå æää ìäâãøä äøàùåðéú +% This error happens when you declare a function or procedure with +% e.g. \var{cdecl;} but omit this directive in the implementation, or vice +% versa. The calling convention is part of the function declaration, and +% must be repeated in the function definition. +parser_e_property_cant_have_a_default_value=03131_E_úëåðåú àéðï éëåìåú ìäëéì òøê áøéøú îçãì +% Set properties or indexed properties cannot have a default value. +parser_e_property_default_value_must_const=03132_E_òøê áøéøú äîçãì÷ ùú äúëåðä çééá ìäéåú ÷áåò +% The value of a \var{default} declared property must be known at compile +% time. The value you specified is only known at run time. This happens +% .e.g. if you specify a variable name as a default value. +parser_e_cant_publish_that=03133_E_äñîì àéðå éëåì ìäéåú áùéîåù áúåê îçì÷ä ììà äâãøúå áúåê äîçì÷ä +% Only class type variables can be in a \var{published} section of a class +% if they are not declared as a property. +parser_e_cant_publish_that_property=03134_E_ñåâ æä ùì úëåðä àéðå éëåì ìäéåú áùéîåù +% Properties in a \var{published} section cannot be array properties. +% they must be moved to public sections. Properties in a \var{published} +% section must be an ordinal type, a real type, strings or sets. +parser_e_empty_import_name=03136_E_ðãøù ùí ééáåà +% Some targets need a name for the imported procedure or a \var{cdecl} specifier +parser_e_division_by_zero=03138_E_çìå÷ áàôñ +% There is a division by zero encounted +parser_e_invalid_float_operation=03139_E_ôòåìú òùøåðéú ìà çå÷éú +% An operation on two real type values produced an overflow or a division +% by zero. +parser_e_array_lower_less_than_upper_bound=03140_E_äâáåì äòìéåï ðîåê éåúø îäâáåì äúçúåï +% The upper bound of a an array declaration is less than the lower bound and this +% is not possible +parser_w_string_too_long=03141_W_àåøê äîçøåæú ùì "$1" àøåê éåúø î "$1" +% The size of the constant string is larger than the size you specified in +% string type definition +parser_e_string_larger_array=03142_E_àåøê äîçøåæú àøåê éåúø îàåøê îòøê äúååéí +% The size of the constant string is larger than the size you specified in +% the array[x..y] of char definition +parser_e_ill_msg_expr=03143_E_äúåëï ùì äáéèåé ìàçø ääåãòä àéðå çå÷é +% \fpc supports only integer or string values as message constants +parser_e_ill_msg_param=03144_E_èéôåì áäåãòåú çééá ìäéåú áîáðä ÷áåò ùì ôøîèøéí +% A method declared with the \var{message}-directive as message handler +% can take only one parameter which must be declared as call by reference +% Parameters are declared as call by reference using the \var{var}-directive +parser_e_duplicate_message_label=03145_E_úååéú äåãòä ëôåìä: "$1" +% A label for a message is used twice in one object/class +parser_e_self_in_non_message_handler=03146_E_Self çééá ìäéåú ôøîèø áîúåãä ùì îèôì ääåãòåú +% The self parameter can only be passed explicitly to a method which +% is declared as message handler. +parser_e_threadvars_only_sg=03147_E_Threadvars çééáéí ìäéåú ñèèééí àå âìåáìééí +% Threadvars must be static or global, you can't declare a thread +% local to a procedure. Local variables are always local to a thread, +% because every thread has its own stack and local variables +% are stored on the stack +parser_f_direct_assembler_not_allowed=03148_F_äùéîåù áîàñó äðåëçé àéðå úåîê áåñâ äúåöàä äáéðàøéú +% You can't use direct assembler when using a binary writer, choose an +% other outputformat or use another assembler reader +parser_w_no_objpas_use_mode=03149_W_àñåø ì÷øåà ìéçéãú OBJPAS éùéøåú, éù ìäùúîù á \{\$mode objfpc\} àå á \{\$mode delphi\} áî÷åí +% You are trying to load the ObjPas unit manually from a uses clause. This is +% not a good idea. Use the \var{\{\$mode objfpc\}} or +% \var{\{\$mode delphi\}} +% directives which load the unit automatically +parser_e_no_object_override=03150_E_OVERRIDE àéðå éëåì ìäéåú áùéîåù áàåáéé÷èéí +% Override is not supported for objects, use \var{virtual} instead to override +% a method of a parent object +parser_e_cant_use_inittable_here=03151_E_èéôåñé ðúåðéí àùø ãåøùéí àúçåì àå ñéëåí àéðí éëåìéí ìäéåú áøùåîåú variant +% Some data type (e.g. \var{ansistring}) needs initialization/finalization +% code which is implicitly generated by the compiler. Such data types +% can't be used in the variant part of a record. +parser_e_resourcestring_only_sg=03152_E_ìà ðéúï ìäâãéø Resourcestring áúåø äâãøä î÷åîéú, ø÷ äâãøä âìåáìéú àå ñèèéú +% Resourcestring can not be declared local, only global or using the static +% directive. +parser_e_exit_with_argument_not__possible=03153_E_äùéîåù áùéâøä exit àéðå éëåì ìäúáöò áîé÷åí äðåëçé +% an exit statement with an argument for the return value can't be used here, this +% can happen e.g. in \var{try..except} or \var{try..finally} blocks +parser_e_stored_property_must_be_boolean=03154_E_èéôåñ äðúåðéí áñéîåì äàçñåï çééá ìäéåú áåìéàðé +% If you specify a storage symbol in a property declaration, it must be of +% the type boolean +parser_e_ill_property_storage_sym=03155_E_äñéîåì àéðå éëåì ìäùîù ëñéîåì ìàçñåï +% You can't use this type of symbol as storage specifier in property +% declaration. You can use only methods with the result type boolean, +% boolean class fields or boolean constants +parser_e_only_publishable_classes_can_be_published=03156_E_ø÷ îçì÷ä äîäåãøú áîöá $M+ éëåìä ìäéåú àéæåø ä published +% In the published section of a class can be only class as fields used which +% are compiled in \var{\{\$M+\}} or which are derived from such a class. Normally +% such a class should be derived from TPersitent +parser_e_proc_directive_expected=03157_E_îöôä ìäðçééú ùéâøä +% This error is triggered when you have a \var{\{\$Calling\}} directive without +% a calling convention specified. +% It also happens when declaring a procedure in a const block and you +% used a ; after a procedure declaration which must be followed by a +% procedure directive. +% Correct declarations are: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_äòøê äàéðã÷ñ ùì äúëåðä çééá ìäéåú èéôåñ îñåãø +% The value you use to index a property must be of an ordinal type, for +% example an integer or enumerated type. +parser_e_procname_to_short_for_export=03159_E_ùí äùâøä ÷öø îéãé ìééöåà +% The length of the procedure/function name must be at least 2 characters +% long. This is because of a bug in dlltool which doesn't parse the .def +% file correct with a name of length 1. +parser_e_dlltool_unit_var_problem=03160_E_ìà ðéúï ìééöø çì÷ DEFFILE ìîùúðéí âìåáìééí áéçéãä +parser_e_dlltool_unit_var_problem2=03161_E_äãø ììà ùéîåù á -WD +% You need to compile this file without the -WD switch on the +% commandline +parser_f_need_objfpc_or_delphi_mode=03162_F_éù ìäùúîù áîöá ObjFpc (-S2) àå áîöá Delphi (-Sd) ìäãø àú äîåãåì +% You need to use \{\$mode objfpc\} or \{\$mode delphi\} to compile this file. +% Or use the equivalent commandline switches -S2 or -Sd. +parser_e_no_export_with_index_for_target=03163_E_àé àôùø ìééöà òí àéðã÷ñ úçú $1 +% Exporting of functions or procedures with a specified index is not +% supported on this target. +parser_e_no_export_of_variables_for_target=03164_E_ééöåà ùì îùúîù àéðå ðúîê á$1 +% Exporting of variables is not supported on this target. +parser_e_improper_guid_syntax=03165_E_úçáéø GUID àéðå çå÷é +% The GUID indication does not have the proper syntax. It should be of the form +% \begin{verbatim} +% {XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX} +% \end{verbatim} +% Where each \var{X} represents a hexadecimal digit. +parser_w_interface_mapping_notfound=03168_W_äùâøä "$1" ðîöàä àê ììà äôøîèøéí äîáå÷ùéí ùì $2.$3 +% The compiler cannot find a suitable procedure which implements the given method of an interface. +% A procedure with the same name is found, but the arguments do not match. +parser_e_interface_id_expected=03169_E_îöôä ìîæää îîù÷ +% This happens when the compiler scans a \var{class} declaration that contains +% \var{interface} function name mapping code like this: +% \begin{verbatim} +% type +% TMyObject = class(TObject, IDispatch) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% and the \var{interface} before the dot not listed in the inheritance list. +parser_e_type_cant_be_used_in_array_index=03170_E_äñåâ "$1" àéðå éëåì ìäéåú áùéîåù áúåø ñåâ àéðã÷ñ ìîòøê +% Types like \var{qword} or \var{int64} aren't allowed as array index type +parser_e_no_con_des_in_interfaces=03171_E_éåöø åäåøñ àéðí îåøùéí áîîù÷éí +% Constructor and destructor declarations aren't allowed in interface +% In the most cases the method \var{QueryInterface} of \var{IUnknown} can +% be used to create a new interface. +parser_e_no_access_specifier_in_interfaces=03172_E_îæää ëðéñä àéðå éëåì ìäéåú áùéîåù òí îîù÷éí +% The access specifiers \var{public}, \var{private}, \var{protected} and +% \var{pusblished} can't be used in interfaces because all methods +% of an interfaces must be public. +parser_e_no_vars_in_interfaces=03173_E_îîù÷ àéðå éëåì ìäëéì ùãåú +% Declarations of fields aren't allowed in interfaces. An interface +% can contain only methods +parser_e_no_local_proc_external=03174_E_ìà ðéúï ìäâãéø ùâøä î÷åîéú ëçéöåðéú +% Declaring local procedures as external is not possible. Local procedures +% get hidden parameters that will make the chance of errors very high +parser_w_skipped_fields_before=03175_W_çì÷ îäùãåú äáàéí ìôðé "$1" ìà àåúçìå +% In Delphi mode, not all fields of a typed constant record have to be +% initialized, but the compiler warns you when it detects such situations. +parser_e_skipped_fields_before=03176_E_çì÷ îäùãåú äáàéí ìôðé "$1" ìà àåúçìå +% In all syntax modes but Delphi mode, you can't leave some fields uninitialized +% in the middle of a typed constant record +parser_w_skipped_fields_after=03177_W_çì÷ îäùãåú äáàéí àçøé "$1" ìà àåúçìå +% You can leave some fields at the end of a type constant record uninitialized +% (the compiler will initialize them to zero automatically). This may be the cause +% of subtle problems. +parser_e_varargs_need_cdecl_and_external=03178_E_äùéîåù áVarArgs (àå '...' áMacPas) çééá ìäéåú áùéîåù òí CDecl/CPPDecl/MWPascal å External +% The varargs directive (or the ``...'' varargs parameter in MacPas mode) can only be used with procedures or functions +% that are declared with \var{external} and one of \var{cdecl}, \var{cppdecl} and \var{mwpascal}. This functionality +% is only supported to provide a compatible interface to C functions like printf. +parser_e_self_call_by_value=03179_E_Self çééá ìäéåú ôøîèø øâéì (call-by-value) +% You can't declare self as a const or var parameter, it must always be +% a call-by-value parameter +parser_e_interface_has_no_guid=03180_E_äîîù÷ "$1" àéðå îëéì îæää GUID +% When you want to assign an interface to a constant, then the interface +% must have a GUID value set. +parser_e_illegal_field_or_method=03181_E_äîæää ùì ùãä àå îúåãä ùì îçì÷ä "$1" àéðí éãåòéí +% Properties must refer to a field or method in the same class. +parser_w_proc_overriding_calling=03182_W_òåìä òì îåñëîåú äôòìä "$1" òí "$2" +% There are two directives in the procedure declaration that specify a calling +% convention. Only the last directive will be used +parser_e_no_procvarobj_const=03183_E_ðéúï ìàúçì èéôåñ ÷áåò ùì "procedure of object" ø÷ òí NIL +% You can't assign the address of a method to a typed constant which has a +% 'procedure of object' type, because such a constant requires two addresses: +% that of the method (which is known at compile time) and that of the object or +% class instance it operates on (which can not be known at compile time). +parser_e_default_value_only_one_para=03184_E_òøê áøéøú îçãì éëåì ìäéåú áùéîåù ø÷ òí ôøîèø àçã +% It is not possible to specify a default value for several parameters at once. +% The following is invalid: +% \begin{verbatim} +% Procedure MyProcedure (A,B : Integer = 0); +% \end{verbatim} +% Instead, this should be declared as +% \begin{verbatim} +% Procedure MyProcedure (A : Integer = 0; B : Integer = 0); +% \end{verbatim} +parser_e_default_value_expected_for_para=03185_E_ôøîèø áøéøú îçãì ãøåù òáåø "$1" +% The specified parameter requires a default value. +parser_w_unsupported_feature=03186_W_ùéîåù áîàôééï ìà ðúîê ! +% You're trying to force the compiler into doing something it cannot do yet. +parser_h_c_arrays_are_references=03187_H_îòøëéí ùì C îåòáøéí ëäôðéä +% Any array passed to a C functions is passed +% by a pointer (i.e. by reference). +parser_e_C_array_of_const_must_be_last=03188_E_îòøê C ùì ÷áåò çééá ìäéåú äàøâåîðè äàçøåï +% You can not add any other argument after an \var{array of const} for +% \var{cdecl} functions, as the size pushed on stack for this argument is +% not known. +parser_h_type_redef=03189_H_äâãøä îçåãùú ùì äèéôåñ "$1" +% This is an indicator that a previously declared type is +% being redefined as something else. This may, or may not +% be, a cause for errors. +parser_w_cdecl_has_no_high=03190_W_àéï ìôåð÷öéåú cdecl ôøîèø âáåää +% Functions declared with cdecl modifier do not pass an extra implicit parameter. +parser_w_cdecl_no_openstring=03191_W_ôåð÷öéåú cdecel àéðï úåîëåú á open string +% Openstring is not supported for cdecl'ared functions. +parser_e_initialized_not_for_threadvar=03192_E_àéï àôùøåú ìàúçì îùúðä äîåâãø ëthreadvar +% Variables declared as threadvar can not be initialized with a default value. +% The variables will always be filled with zero at the start of a new thread. +parser_e_msg_only_for_classes=03193_E_ðéúï ìäùúîù áäðçééú message ø÷ áúåê îçì÷ä +% The message directive is only supported for Class types. +parser_e_procedure_or_function_expected=03194_E_îöôä ìùéâøä àå ôåð÷öéä +% A class method can only be specified for procedures and functions. +parser_e_illegal_calling_convention=03195_W_îúòìí îîåñëîú ääôòìä: "$1" +% Some calling conventions are supported only by certain CPUs. I.e. most non-i386 ports support +% only the standard ABI calling convention of the CPU. +parser_e_no_object_reintroduce=03196_E_ìà ðéúï ìäùúîù áREINTRODUCE áúåê àåáéé÷è +% \var{reintroduce} is not supported for objects. +parser_e_paraloc_only_one_para=03197_E_ëì àøâåîðè çééá ìäëéì îé÷åí òöîàé. +% If locations for arguments are specified explicitly as it is required by +% some syscall conventions, each argument must have it's only location, things +% like \var{procedure p(i,j : longint 'r1');} aren't allowed +parser_e_paraloc_all_paras=03198_E_ëì àøâåîðè çééá ìäëéì îé÷åí îåâãø +% If one argument has an explicit argument location, all arguments of a procedure +% must have one. +parser_e_illegal_explicit_paraloc=03199_E_îé÷åí àøâåîðè ìà éãåò +% The location specified for an argument isn't recognized by the compiler +parser_e_32bitint_or_pointer_variable_expected=03200_E_îöôä ìñåâ îùúðä ùì îñôø ùìí 32-Bit àå îöáéò +% The libbase for MorphOS/AmigaOS can be give only as \var{longint}, \var{dword} or any pointer variable. +parser_e_goto_outside_proc=03201_E_ìà ðéúï ìäùîù ágoto áéï ùðé ùéâøåú +% It isn't allowed to use the \var{goto} statements referencing labels outside the +% current procedure. The following example shows the problem: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1; +% +% procedure p2; +% begin +% goto l1; // This goto ISN'T allowed +% end; +% +% begin +% p2 +% l1: +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_äùéâøä îñåáëú îéãé åãåøùú ùéîåù ùì àåâøéí øáéí îéãé +% Your procedure body is too long for the compiler. You should split the +% procedure into multiple smaller procedures. +parser_e_illegal_expression=03203_E_áéèåé ìà çå÷é +% This can occur under many circumstances. Mostly when trying to evaluate +% constant expressions. +parser_e_invalid_integer=03204_E_äáéèåé ùì äîñôø äùìí àéðå çå÷é +% You made an expression which isn't an integer, and the compiler expects the +% result to be an integer. +parser_e_invalid_qualifier=03205_E_ùéîåù ìà çå÷é áîáçéï +% One of the following is happening : +% \begin{itemize} +% \item You're trying to access a field of a variable that is not a record. +% \item You're indexing a variable that is not an array. +% \item You're dereferencing a variable that is not a pointer. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_èååç ääâáìä äâáåää ÷èï îèååç ääâáìä äðîåëä +% You are declaring a subrange, and the lower limit is higher than the high +% limit of the range. +parser_e_macpas_exit_wrong_param=03207_E_äôøîèø ùì Exit çééá ìäéåú ùí äùéâøä úçúéå äåà ðîöà +% Non local exit is not allowed. This error occurs only in mode MacPas. +parser_e_illegal_assignment_to_count_var=03208_E_äöáä ìà çå÷éú ùì äîùúðä áìåìàú ä for "$1" +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. You can also not assign values to +% loop variables inside the loop (except in Delphi and TP modes). Use a while or +% repeat loop instead if you need to do something like that, since those +% constructs were built for that. +parser_e_no_local_var_external=03209_E_ìà ðéúï ìäâãéø îùúðéí î÷åîééí ëçéöåðééí +% Declaring local variables as external is not allowed. Only global variables can reference +% to external variables. +parser_e_proc_already_external=03210_E_äùéâøä ëáø îåâãøú ëçéöåðéú +% The procedure is already declared with the EXTERNAL directive in an interface or +% forward declaration. +parser_w_implicit_uses_of_variants_unit=03211_W_ùéîåù îùúîò áéçéãú Variants +% The Variant type is used in the unit without any used unit using the Variants unit. The +% compiler has implicitly added the Variants unit to the uses list. To remove this warning +% the Variants unit needs to be added to the uses statement. +parser_e_no_static_method_in_interfaces=03212_E_äùéîåù áîçì÷ä åîúåãåú ñèèééí àéðí éëåìéåú ìäéåú áùéîåù áîîù÷ +% The specifier \var{class} and directive \var{static} can't be used in interfaces +% because all methods of an interfaces must be public. +parser_e_arithmetic_operation_overflow=03213_E_âìéùä áôòåìä îúîèéú +% An operation on two integers values produced an overflow +parser_e_protected_or_private_expected=03214_E_îöôä ìàéæåø Protected àå Private +% \var{strict} can be only used together with \var{protected} or \var{private}. +parser_e_illegal_slice=03215_E_SLICE àéð éëåì ìäéåú áùéîåù îçåõ ìøùéîú ôøîèøéí +% \var{slice} can be used only for arguments accepting an open array parameter +parser_e_dispinterface_cant_have_parent=03216_E_îçì÷ú DISPINTERFACE àéðä éëåìä ìäëéì äåøä +% A DISPINMTERFACE is a special type of interface which can't have a parent class +parser_e_dispinterface_needs_a_guid=03217_E_DISPINTERFACE çééá GUID +% A DISPINMTERFACE always needs an interface identification +parser_w_overridden_methods_not_same_ret=03218_W_äîúåãåú äçãùåú çééáåú ìäçæéø àú àåúå èéôåñ ðúåðéí. ä÷åã äðåëçé éëåì ìâøåí ì÷øéñä áò÷áåú áàâ ùì äîôøù ùì ãìôé (“$2” òåìä òì “$1” àùø îëéì èéôåñ ðúåðéí àçø áäçæøä) +% If you declare overridden methods in a class definition, they must +% have the same return type. Some versions of Delphi allow you to change the +% return type of interface methods, and even to change procedures into +% functions, but the resulting code may crash depending on the types used +% and the way the methods are called. +parser_e_dispid_must_be_ord_const=03219_E_îæää Dispatch çééá ìäéåú ÷áåò áòì òøê ñéãåøé +parser_e_array_range_out_of_bounds=03220_E_äèååç ùì äîòøê âáåää îéãé +% Regardless of the size taken up by its elements, an array cannot have more +% than high(ptrint) elements. Additionally, the range type must be a subrange +% of ptrint. +parser_e_packed_element_no_var_addr=03221_E_ìà ðéúï ìîöåà àú äëúåáú ùì áéè äîòøê àøåæ, àìîðèéí àå ùãåú ùì äîòøê +% If you declare an array or record as \var{packed} in Mac Pascal mode (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will +% be packed at the bit level. This means it becomes impossible to take addresses +% of individual array elements or record fields. The only exception to this rule is in case of packed arrays elements +% whose packed size is a multple of 8 bits. +parser_e_packed_dynamic_open_array=03222_E_ìà ðéúï ìàøåæ îòøê ãéðàîé +% Only regular (and possibly in the future also open) arrays can be packed +parser_e_packed_element_no_loop=03223_E_àìîðèéí åùãåú ùì îòøëé áéè àøåæéí àéðí éëåìéí ìùîù ëîùúðéí ììåìàåú +% If you declare an array or record as \var{packed} in Mac Pascal mode (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will +% be packed at the bit level. For performance reasons, they cannot be +% used as loop variables. +parser_e_type_and_var_only_in_generics=03224_E_ðéúï ìäùúîù á VAR å TYPE ø÷ òí generics +% The usage of VAR and TYPE to declare new types inside an object is allowed only inside +% generics. +parser_e_cant_create_generics_of_this_type=03225_E_äèéôåñ àéðå éëåì ìäéåú generic +% Only Classes, Objects, Interfaces and Records are allowed to be used as generic +parser_w_no_lineinfo_use_switch=03226_W_àéï ìèòåï àú äñôøééä LINEINFO áöåøä éãðéú. òì îðú ìäùúîù áñôøééä éù ìäùúîù áîúâ -gl áî÷åí +% Do not use the LINEINFO unit directly, Use the \var{-gl} switch which automatically adds the +% unit for reading the selected type of debugging information instead. +parser_e_no_funcret_specified=03227_E_ìà öåééï èéôåñ äçæøä òáåø äôåð÷öéä "$1" +% The first time you declare a function you have to declare it completely, +% including all parameters and the result type. +parser_e_special_onlygenerics=03228_E_äùéîåù áSpecialization îåøùä ø÷ ëàùø îùúîùéí áèéôåñé generic +% Types not being generics can't be specialized +parser_e_no_generics_as_params=03229_E_ìà ðéúï ìäùúîù ágenerics áúåø ôøîèøéí ëàùø éù ùéîåù á spezializing generics +% When specializing a generic, only non-generic types can be used as parameters. +parser_e_type_object_constants=03230_E_äùéîåù á÷áåòéí ùì àåáéé÷èéí äîëéìéí VMT àéðå îåøùä +% If an object requires a VMT either because it contains a constructor or virtual methods, +% it's not allowed to create constants of it. In TP and Delphi mode this is allowed +% for compatibility reasons. +parser_e_label_outside_proc=03231_E_ùéîåù áëúåáú ùì úååéåú äîåëøæåú îçåõ ìîúçí äðåëçé àéðå îåøùä +% It isn't allowed to take the addresss of labels outside the +% current procedure. +parser_e_initialized_not_for_external=03233_E_ìà ðéúï ìàúçì òøê áøéøú îçãì ìîùúðéí äîåâãøéí ëexternal +% Variables declared as external can not be initialized with a default value. +parser_e_illegal_function_result=03234_E_èéôåñ äçæøä ùì äôåð÷öéä àéðå çå÷é +% Some types like file types can not be used as function result +parser_e_no_common_type=03235_E_àéï èéôåñ îùåúó ì "$1" å "$2" +% To perform an operation beween integers, the compiler converts both operands +% to their common type, which appears to be an invalid type. To determine the +% common type of the operands, the compiler takes the minimum of the minimal values +% of both types, and the maximum of the maximal values of both types. The common +% type is then minimum..maximum. +parser_e_no_generics_as_types=03236_E_Generics ììà specialization àéðå éëåì ìäéåú áùéîåù áúåø èéôåñ ìîùúðä +% Generics must be always specialized before being used as variable type +parser_w_register_list_ignored=03237_W_îúòìí îøùéîú äàåâøéí òáåø ùâøåú assemblter èäåøåú +% When using pure assembler routines, the list with modified registers is ignored. + +% \end{description} +# +# Type Checking +# +# 04049 is the last used one +# +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +type_e_mismatch=04000_E_èéôåñ ðúåðéí ìà çåôó +% This can happen in many cases: +% \begin{itemize} +% \item The variable you're assigning to is of a different type than the +% expression in the assignment. +% \item You are calling a function or procedure with parameters that are +% incompatible with the parameters in the function or procedure definition. +% \end{itemize} +type_e_incompatible_types=04001_E_èéôåñ ðúåðéí ìà úåàí: ðòùä ùéîåù á "$1" îöôä ì"$2" +% There is no conversion possible between the two types +% Another possiblity is that they are declared in different +% declarations: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { This statement gives also this error, it +% is due the strict type checking of pascal } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_àé äúàîä áéï èéôåñé äðúåðéí "$1" å "$2" +% The types are not equal +type_e_type_id_expected=04003_E_îöôä ìèéôåñ ðúåðéí +% The identifier is not a type, or you forgot to supply a type identifier. +type_e_variable_id_expected=04004_E_îöôä ìîæää ùì îùúðä +% This happens when you pass a constant to a routine (such as \var{Inc} var or \var{Dec}) +% when it expects a variable. You can only pass variables as arguments to these functions. +type_e_integer_expr_expected=04005_E_îöôä ìîñôø ùìí, àê äú÷áì "$1" +% The compiler expects an expression of type integer, but gets a different +% type. +type_e_boolean_expr_expected=04006_E_îöôä ìáéèåé áåìéàðé, àê äú÷áì "$1" +% The expression must be a boolean type, it should be return true or +% false. +type_e_ordinal_expr_expected=04007_E_îöôä ìèéôåñ ñåãø +% The expression must be of ordinal type, i.e., maximum a \var{Longint}. +% This happens, for instance, when you specify a second argument +% to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value. +type_e_pointer_type_expected=04008_E_îöôä ìîöáéò, àê äú÷áì "$1" +% The variable or expression isn't of the type \var{pointer}. This +% happens when you pass a variable that isn't a pointer to \var{New} +% or \var{Dispose}. +type_e_class_type_expected=04009_E_îöôä ìîçì÷ä, àê äú÷áì "$1" +% The variable of expression isn't of the type \var{class}. This happens +% typically when +% \begin{enumerate} +% \item The parent class in a class declaration isn't a class. +% \item An exception handler (\var{On}) contains a type identifier that +% isn't a class. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_ìà ðéúï ìðúç àú äáéèåé ä÷áåò +% This error can occur when the bounds of an array you declared does +% not evaluate to ordinal constants +type_e_set_element_are_not_comp=04012_E_äàìîðèéí ùì ä÷áåöä àéðí úåàîéí +% You are trying to make an operation on two sets, when the set element types +% are not the same. The base type of a set must be the same when taking the +% union +type_e_set_operation_unknown=04013_E_äôòåìä àéðä áùéîåù òí ÷áåöåú +% several binary operations are not defined for sets +% like div mod ** (also >= <= for now) +type_w_convert_real_2_comp=04014_W_äîøä àåèåîèéú ùì èéôåñ òùøåðé ì COMP àùø äåà îñôø ùìí +% An implicit type conversion from a real type to a \var{comp} is +% encountered. Since \var{comp} is a 64 bit integer type, this may indicate +% an error. +type_h_use_div_for_int=04015_H_äùúîù áDIV áî÷åí òì îðú ì÷áì úåöàä ùì îñôø ùìí +% When hints are on, then an integer division with the '/' operator will +% procuce this message, because the result will then be of type real +type_e_strict_var_string_violation=04016_E_èéôåñ äîçøåæú àéðí úåàí áâìì äùéîåù áîúâ $V+ +% When compiling in \var{\{\$V+\}} mode, the string you pass as a parameter +% should be of the exact same type as the declared parameter of the procedure. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_ìà ðéúï ìäöéá òøëéí ìîðéåú úåê ùéîåù ásucc àå pred +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use the \var{Succ} or \var{Pred} functions on them. +type_e_cant_read_write_type=04018_E_ìà ðéúï ì÷øåà àå ìëúåá îùúðéí îäñåâ äðåëçé +% You are trying to \var{read} or \var{write} a variable from or to a +% file of type text, which doesn't support that. Only integer types, +% reals, pchars and strings can be read from/written to a text file. +% Booleans can only be written to text files. +type_e_no_readln_writeln_for_typed_file=04019_E_ìà ðéúï ìäùúîù áreadln åwriteln òì èéôåñ ðúåðéí îñåâ file +% \var{readln} and \var{writeln} are only allowed for text files. +type_e_no_read_write_for_untyped_file=04020_E_ìà ðéúï ì÷øåà àå ìëúåá èéôåñ ìà îåâø ùì ÷áöéí +% \var{read} and \var{write} are only allowed for text or typed files. +type_e_typeconflict_in_set=04021_E_äúðâùåú ùì èéôåñ ðúåðéí áúåê àéáøéí ùì ÷áåöä +% There is at least one set element which is of the wrong type, i.e. not of +% the set type. +type_w_maybe_wrong_hi_lo=04022_W_lo/hi(dword/qword) îçæéø àú äòøê äòìéåï/úçúåï ùì word/dword +% \fpc supports an overloaded version of \var{lo/hi} for \var{longint/dword/int64/qword} +% which returns the lower/upper word/dword of the argument. TP always uses +% a 16 bit \var{lo/hi} which returns always bits 0..7 for \var{lo} and the +% bits 8..15 for \var{hi}. If you want the TP behavior you have +% to type cast the argument to \var{word/integer} +type_e_integer_or_real_expr_expected=04023_E_îöôä ìáéèåé ùì îñôø ùìí àå îñôø îîùé +% The first argument to \var{str} must a real or integer type. +type_e_wrong_type_in_array_constructor=04024_E_ùéîåù ùâåé áèéôåñ "$1" áúåê éåöø äîòøê +% You are trying to use a type in an array constructor which is not +% allowed. +type_e_wrong_parameter_type=04025_E_èéôåñ ìà îúàéí ìàøâåîðè îñôø $1: äú÷áì "$2", îöôä ì"$3" +% You are trying to pass an invalid type for the specified parameter. +type_e_no_method_and_procedure_not_compatible=04026_E_äîùúðä ùì äîúåãä åäùâøä àéðí úåàîéí +% You can't assign a method to a procedure variable or a procedure to a +% method pointer. +type_e_wrong_math_argument=04027_E_áéèåé ÷áåò ìà çå÷é äåæï ìôåð÷öéä îúîèéú ôðéîéú +% The constant argument passed to a ln or sqrt function is out of +% the definition range of these functions. +type_e_no_addr_of_constant=04028_E_ìà ðéúï ì÷áì àú äëúåáú ùì ä÷áåò +% It is not possible to get the address of a constant expression, because they +% aren't stored in memory. You can try making it a typed constant. This error +% can also be displayed if you try to pass a property to a var parameter. +type_e_argument_cant_be_assigned=04029_E_ìà ðéúï ìäùéí àú äàøâåîðè +% Only expressions which can be on the left side of an +% assignment can be passed as call by reference argument +% Remark: Properties can be only +% used on the left side of an assignment, but they cannot be used as arguments +type_e_cannot_local_proc_to_procvar=04030_E_ìà ðéúï ìùééê ôåð÷öéä/ùéâøä î÷åîéú ìîùúðä îñåâ ùéâøä +% It's not allowed to assign a local procedure/function to a +% procedure variable, because the calling of local procedure/function is +% different. You can only assign local procedure/function to a void pointer. +type_e_no_assign_to_addr=04031_E_ìà ðéúï ìùééê òøê ìëúåáú +% It is not allowed to assign a value to an address of a variable,constant, +% procedure or function. You can try compiling with -So if the identifier +% is a procedure variable. +type_e_no_assign_to_const=04032_E_ìà ðéúï ìùééê òøê ìîùúðä ÷áåò +% It's not allowed to assign a value to a variable which is declared +% as a const. This is normally a parameter declared as const, to allow +% changing the value make the parameter as a value parameter or a var. +type_e_array_required=04033_E_ðãøù îùúðä îñåâ îòøê +% If you are accessing a variable using an index '[<x>]' then +% the type must be an array. In FPC mode also a pointer is allowed. +type_e_interface_type_expected=04034_E_îöôä ìèéôåñ îñåâ îîù÷, àáì äú÷áì "$1" +% The compiler expected to encounter an interface type name, but got something else. +% The following code would provoke this error: +% \begin{verbatim} +% Type +% TMyStream = Class(TStream,Integer) +% \end{verbatim} +type_w_mixed_signed_unsigned=04035_W_òéøáåá áéèåéé ñéîðéí ålongwords îñô÷éí úåöàä ùì 64bit +% If you divide (or calculate the modulus of) a signed expression by a longword (or vice versa), +% or if you have overflow and/or range checking turned on and use an arithmetic +% expression (+, -, *, div, mod) in which both signed numbers and longwords appear, +% then everything has to be evaluated in 64bit which is slower than normal +% 32bit arithmetic. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_w_mixed_signed_unsigned2=04036_W_òøáåá áéèåéé ñéîðéí åîñôøéí ùìîéí âáåäéí òìåì ìâøåí ìùâéàú èååç îñôøéí +% If you use a binary operator (and, or, xor) and one of +% the operands is a longword while the other one is a signed expression, then, +% if range checking is turned on, you may get a range check error because in +% such a case both operands are converted to longword before the operation is +% carried out. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_e_typecast_wrong_size_for_assignment=04037_E_éùðå äáãì áâåãì áäöáä ùì typecast ($1-> $2) +% Type casting to a type with a different size is not allowed when the variable is +% used for assigning. +type_e_array_index_enums_with_assign_not_possible=04038_E_îðéåú òí úåëï ùì äöáä àéðí éëåìéí ìùîù áúåø àéðã÷ñ ìîòøê +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use it as index of an array. +type_e_classes_not_related=04039_E_àéï ÷éøáä áéï èéôåñé îçì÷åú àå àåáéé÷èéí ùì "$1" å "$2" +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_w_classes_not_related=04040_W_àéï ÷éøáä áéï èéôåñé äîçì÷åú ùì "$1" å "$2" +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_e_class_or_interface_type_expected=04041_E_îöôä ìèéôåñé îçì÷åú àå îîù÷éí, àáì "$1" äú÷áì +% The compiler expected a class or interface name, but got another type or identifier. +type_e_type_is_not_completly_defined=04042_E_äèéôåñ "$1" ìà äåâãø áîìåàå +% This error occurs when a type is not complete: i.e. a pointer type which points to +% an undefined type. +type_w_string_too_long=04043_W_äúåëï ùì äîçøåæú îëéì éåúø úååéí îîä ùðéúï ìäëéì áàåøê ùì îçøåæú ÷öøä +% The size of the constant string, which is assigned to a shortstring, +% is longer than the maximum size of the shortstring +type_w_signed_unsigned_always_false=04044_W_ääùååàä úîéã úçæéø òøê ùì false áâìì èååç äòøëéí +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% false. Exlicitly typecast the constant to the correct range to avoid this problem. +type_w_signed_unsigned_always_true=04045_W_ääùååàä úîéã úçæéø òøê ùì true áâìì èååç äòøëéí +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% true. Exlicitly typecast the constant to the correct range to avoid this problem. +type_w_instance_with_abstract=04046_W_îàúçì àú äîçì÷ä "$1" òí îúåãåú ìà îîåîùåú +% An instance of a class is created which contains non-implemented abstract +% methods. This will probably lead to a runtime error 211 in the code if that +% routine is ever called. All abstract methods should be overridden. +type_h_in_range_check=04047_H_äòøê äùîàìé ùì äàåôøðã IN öøéê ìäéåú áâåãì ùì áéú +% The left operand of the \var{in} operator is not an ordinal or enumeration which fits +% within 8-bits, this may lead to range check errors. The \var{in} operator +% currently only supports a left operand which fits within a byte. In the case of +% enumerations, the size of an element of an enumeration can be controlled with +% the \var{\{\$PACKENUM\}} or \var{\{\$Zn\}} switches. +type_w_smaller_possible_range_check=04048_W_âåãì äèéôåñ àéðå îúàéí, éùðä àôùøåú ìàéáåã îéãò àå ùâéàä ááãé÷ú äèååç +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_h_smaller_possible_range_check=04049_H_âåãì äèéôåñ àéðå îúàéí, éùðä àôùøåú ìàéáåã îéãò àå ùâéàä ááãé÷ú äèååç +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_e_cant_take_address_of_abstract_method=04050_E_ìà ðéúï ìñô÷ àú ëúåáú äîúåãä äîåâãøú ë abstract +% An abstract method has no body, so the address of an abstract method can't be taken. +type_e_assignment_not_allowed=04051_E_ìà ðéúï ìùééê àú äòøê ìôøîèøéí øùîééí åîòøëéí ôúåçéí +% You are trying to assign a value to a formal (untyped var, const or out) +% parameter, or to an open array. +type_e_constant_expr_expected=04052_E_îöôä ìáéèåé ÷áåò +% The compiler expects an constant expression, but gets a variable expression. +type_e_operator_not_supported_for_types=04053_E_äôòåìä "$1" àéðä ðúîëú ìèéôåñéí "$1" å "$3" +% The operation is not allowed for the supplied types +type_e_illegal_type_conversion=04054_E_äîøä ìà çå÷éú ùì äèéôåñ ùì "$1" ì "$2" +% When doing a type-cast, you must take care that the sizes of the variable and +% the destination type are the same. +type_h_pointer_to_longint_conv_not_portable=04055_H_ääîøä áéï îñôø ìîöáéò àéðä àôùøéú áëì äîòøëåú +% If you typecast a pointer to a longint (or vice-versa), this code will not compile +% on a machine using 64-bit for pointer storage. +type_w_pointer_to_longint_conv_not_portable=04056_W_ääîøä áéï îñôø ìîöáéò àéðä àôùøéú áëì äîòøëåú +% If you typecast a pointer to a ordinal type of a different size (or vice-versa), this can +% cause problems. This is a warning to help finding the 32bit specific code where cardinal/longint is used +% to typecast pointers to ordinals. A solution is to use the ptrint/ptruint types instead. +type_e_cant_choose_overload_function=04057_E_ìà ðéúï ìäçìéè áàéæå ôåð÷öéú òîåñú éúø ìäùúîù +% You're calling overloaded functions with a parameter that doesn't correspond +% to any of the declared function parameter lists. e.g. when you have declared +% a function with parameters \var{word} and \var{longint}, and then you call +% it with a parameter which is of type \var{integer}. +type_e_illegal_count_var=04058_E_îùúðä ñôéøä ìà çå÷é +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +type_w_double_c_varargs=04059_W_îîéø àú äèéôåñ real ìèéôåñ double ìîùúðä C. äåñó typecast ñôöéôé ìîðåò àú äîöá. +% In C, constant real values are double by default. For this reason, if you +% pass a constant real value to a variable argument part of a C function, FPC +% by default converts this constant to double as well. If you want to prevent +% this from happening, add an explicit typecast around the constant. +type_e_class_or_cominterface_type_expected=04060_E_îöôä ìèéôåñ îçì÷ä àå îîù÷ COM, àáì äú÷áì "$1" +% Some operators like the AS operator are only appliable to classes or COM interfaces. +type_e_no_const_packed_array=04061_E_àéï úîéëä áîòøê ÷áåò ãçåñ +% You cannot declare a (bit)packed array as a typed constant. +type_e_got_expected_packed_array=04062_E_çåñø úàéîåú ìèéôåñ äðúåðéí ùì àøâåîðè $1. äú÷áì: "$2" îöà ì "(bit)packed array" +% The compiler expects a (bit)packed array as the specified parameter +type_e_got_expected_unpacked_array=04063_E_çåñø úàéîåú èéôåñ äðúåðéí ùì àøâåîðè $1. äú÷áì "$2" îöôä ì "(not packed) Array" +% The compiler expects a regular (i.e., not packed) array as the specified parameter +type_e_no_packed_inittable=04064_E_àìîèéí ùì îòøê ãçåñ àéðí éëåìéí ìäéåú îèéôåñ ðúåðéí àùø ãåøù àúçåì +% Support for packed arrays of types that need initialization (such as ansistrings, or records which contain ansistrings) is not yet implemented. +type_e_no_const_packed_record=04065_E_àéï úîéëä ìøùåîåú åàáéé÷èéí ÷áåòéí åãçåñéí +% You cannot declare a (bit)packed array as a typed constant at this time. +type_w_untyped_arithmetic_unportable=04066_W_çéùåá "$1" òì èéôåñ ìà îåâãø ùì îöáéò àéðå ðúîê áîöá {$T+}, àê ðéúï ìäùúîù átypecast +% Addition/subtraction from untyped pointer may work differently in \var{\{\$T+\}}, use typecast to typed pointer +type_e_cant_take_address_of_local_subroutine=04076_E_ìà ðéúï ì÷çú àú ëúåáú äùéâøä äîñåîðú ëî÷åîéú +% The address of a subroutine marked as local can't be taken. +type_e_cant_export_local=04077_E_ìà ðéúï ìééöà ùéâøä äîñåîðú ëî÷åîéú áúåê éçéãä +% A subroutine marked as local can't be export from a unit. +type_e_not_automatable=04078_E_äèéôåñ àéðå àåèåîè: "$1" +% Only byte, integer, longint, smallint, currency, single, double, ansistring, +% widestring, tdatetime, variant, olevariant, wordbool and all interfaces are automatable. +type_h_convert_add_operands_to_prevent_overflow=04079_H_äîøú äàåôøðã ì"$1" ìôðé ôòåìú äçéáåø, éëåì ìîðåò ùâéàåú âìéùä. +% Adding two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the addition. +type_h_convert_sub_operands_to_prevent_overflow=04080_H_äîøú äàåôøðã ì"$1" ìôðé ôòåìú äçéáåø éëåìä ìîðåò ùâéàåú âìéùä. +% Subtracting two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the subtraction. +type_h_convert_mul_operands_to_prevent_overflow=04081_H_äîøú äàåôøðã "$1" ìôðé ôòåìú äëôì éëåìä ìîðåò ùâéàåú âìéùä. +% Multiplying two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the multiplication. +type_w_pointer_to_signed=04082_W_äîøú îöáéòéí ìîñôøéí ùìîéí òí ñéîï òìåìä ìâøåí ìùâéàåú áúåöàåú äùååàä åáèååçéí. éù ìäùúîù áî÷åí æàú áèéôåñ ììà ñéîï. +% The virtual address space on 32-bit machines runs from \$00000000 to \$ffffffff. Many operating systems allow you to +% allocate memory above \$80000000, for example both Windows and Linux allow pointers in the range \$0000000 to \$bfffffff. +% If you convert pointers to signed types, this can cause overflow and range check errors, but also \$80000000 < \$7fffffff. +% This can cause random errors in code like "if p>q". +% \end{description} +# +# Symtable +# +# 05060 is the last used one +# +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedure and variable names. +% \begin{description} +sym_e_id_not_found=05000_E_äîæää ìà ðîöà "$1" +% The compiler doesn't know this symbol. Usually happens when you misspel +% the name of a variable or procedure, or when you forgot to declare a +% variable. +sym_f_internal_error_in_symtablestack=05001_F_ùâéàä ôðéîéú áSymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_îæää ëôåì "$1" +% The identifier was already declared in the current scope. +sym_h_duplicate_id_where=05003_H_äîæää ëáø îåâãø á$1 áùåøä $2 +% The identifier was already declared in a previous scope. +sym_e_unknown_id=05004_E_îæää ìà îåëø "$1" +% The identifier encountered has not been declared, or is used outside the +% scope where it is defined. +sym_e_forward_not_resolved=05005_E_äâãøú Forward ìà îîåîùú +% This can happen in two cases: +% \begin{itemize} +% \item This happens when you declare a function (in the \var{interface} part, or +% with a \var{forward} directive, but do not implement it. +% \item You reference a type which isn't declared in the current \var{type} +% block. +% \end{itemize} +sym_e_error_in_type_def=05007_E_ùâéàä áäâãøú èéôåñ +% There is an error in your definition of a new array type: +% \item One of the range delimiters in an array declaration is erroneous. +% For example, \var{Array [1..1.25]} will trigger this error. +sym_e_forward_type_not_resolved=05009_E_äâãøú äèéôåñ ìà äåùìä "$1" +% A symbol was forward defined, but no declaration was encountered. +sym_e_only_static_in_static=05010_E_ø÷ îùúðéí ñèèééí éëåìéí ìäéåú áùéîåù òí îúåãåú ñèèéåú àå îçåõ ìîèåãåú +% A static method of an object can only access static variables. +sym_f_type_must_be_rec_or_class=05012_F_îöôä ìèéôåñ ùì øùåîä àå èéôåñ ùì îçì÷ä +% The variable or expression isn't of the type \var{record} or \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_àãâí ùì îçì÷åú àå àåáéé÷èéí òí îúåãåú abstract àéðí îåøùéí +% You are trying to generate an instance of a class which has an abstract +% method that wasn't overridden. +sym_w_label_not_defined=05014_W_äúååéú "$1" àéðä îåâãøú +% A label was declared, but not defined. +sym_e_label_used_and_not_defined=05015_E_äúååéú "$1" áùéîåù, àáì ìà îâãøú +% A label was declared and used, but not defined. +sym_e_ill_label_decl=05016_E_äâãøú úååéú ìà çå÷éú +% This error should never happen; it occurs if a label is defined outside a +% procedure or function. +sym_e_goto_and_label_not_supported=05017_E_GOTO å LABEL àéðí ðúîëéí (äùúîù áîúâ -Sg) +% You must compile a program which has \var{label}s and \var{goto} statements +% with the \var{-Sg} switch. By default, \var{label} and \var{goto} aren't +% supported. +sym_e_label_not_found=05018_E_äúååéú ìà ðîöàä +% A \var{goto label} was encountered, but the label isn't declared. +sym_e_id_is_no_label_id=05019_E_äîæää àéðå úååéú +% The identifier specified after the \var{goto} isn't of type label. +sym_e_label_already_defined=05020_E_äúååéú ëáø äåâãøä +% You are defining a label twice. You can define a label only once. +sym_e_ill_type_decl_set=05021_E_äâãøú èéôåñ ñéãøä ìà çå÷éú +% The declaration of a set contains an invalid type definition. +sym_e_class_forward_not_resolved=05022_E_äâãøä î÷ãéîä ùì îçì÷ä "$1" ìà îîåîùú +% You declared a class, but you did not implement it. +sym_n_unit_not_used=05023_H_äéçéãä "$1" àéðä áùéîåù á $2 +% The unit referenced in the \var{uses} clause is not used. +sym_h_para_identifier_not_used=05024_H_äôøîèø "$1" àéðå áùéîåù +% The identifier was declared (locally or globally) but +% was not used (locally or globally). +sym_n_local_identifier_not_used=05025_N_äîùúðä äî÷åîé "$1" àéðå áùéîåù +% You have declared, but not used a variable in a procedure or function +% implementation. +sym_h_para_identifier_only_set=05026_H_äòøê ùì äôøîèø "$1" äåæï àê äåà ìà áùéîåù +% The identifier was declared (locally or globally) +% set but not used (locally or globally). +sym_n_local_identifier_only_set=05027_N_äòøê ùì äôøîèø "$1" äåæï àê äåà ìà áùéîåù +% The variable in a procedure or function +% implementation is declared, set but never used. +sym_h_local_symbol_not_used=05028_H_$1 "$2" î÷åîé ìà áùéîåù +% A local symbol is never used. +sym_n_private_identifier_not_used=05029_N_ùãä ôøèé "$1.$2" ìà áùéîåù +% The indicated private field is defined, but is never used in the code. +sym_n_private_identifier_only_set=05030_N_äùãä äôøèé "$1.$2" áòì òøê, àê ìà áùéîåù +% The indicated private field is declared, assigned but never read. +sym_n_private_method_not_used=05031_N_äîúåãä äôøèéú "$1.$2" àéðä áùéîåù +% The indicated private method is declared but is never used in the code. +sym_e_set_expected=05032_E_îöôä ìèéôåñ ñãøä +% The variable or expression is not of type \var{set}. This happens in an +% \var{in} statement. +sym_w_function_result_not_set=05033_W_äôåð÷öéä ëðøàä ìà îçæéøä òøê +% You can get this warning if the compiler thinks that a function return +% value is not set. This will not be displayed for assembler procedures, +% or procedures that contain assembler blocks. +sym_w_wrong_C_pack=05034_W_äèéôåñ "$1" àéðå îééåùø ðëåï ìøùåîä ùì ùôú C +% Arrays with sizes not multiples of 4 will be wrongly aligned +% for C structures. +sym_e_illegal_field=05035_E_ùãä ùì øùåîä ìà çå÷é "$1" +% The field doesn't exist in the record/object definition. +sym_w_uninitialized_local_variable=05036_W_äîùúðä äî÷åîé "$1" àéðå ðøàä îàåúçì +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_w_uninitialized_variable=05037_W_äîùúðä "$1" àéðå ðøàä îàåúçì +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_e_id_no_member=05038_E_äîæää áùéîåù àéðå çáø á"$1" +% This error is generated when an identifier of a record, +% field, or method is accessed while it is not defined. +sym_h_param_list=05039_H_ðîöàä ääëøæä: $1 +% You get this when you use the \var{-vh} switch. In case an overloaded +% procedure is not found, then all candidate overloaded procedures are +% listed, with their parameter lists. +sym_e_segment_too_large=05040_E_âåãì äîéãò ùì äàìîðè âãåì îéãé +% You get this when you declare a data element whose size exceeds the +% prescribed limit (2 Gb on 80386+/68020+ processors) +sym_e_no_matching_implementation_found=05042_E_ìà ðîöà áéöåò ìîúåãä "$1" ùì äîîù÷ +% There was no matching method found which could implement the interface +% method. Check argument types and result type of the methods. +sym_w_deprecated_symbol=05043_W_äñéîåì "$1" îéåùï +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Usage of this symbol +% should be avoided as much as possible. +sym_w_non_portable_symbol=05044_W_äñéîåì "$1" àéðå ðééã +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{platform} is used. This symbol's value, usage +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_non_implemented_symbol=05055_W_äñéîåì "$1" àéðå îáåöò +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{unimplemented} is used. This symbol is defined, +% but is not yet implemented on this specific platform. +sym_e_cant_create_unique_type=05056_E_ìà ðéúï ìéöåø èéôåñ ééçåãé îäèéôåñ äðåëçé +% Only simple types like ordinal, float and string types are supported when +% redefining a type with \var{type newtype = type oldtype;}. +sym_h_uninitialized_local_variable=05057_H_äîùúðä äî÷åîé "$1" àéðå ðøàä îàåúçì +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_h_uninitialized_variable=05058_H_äîùúðä "$1" àéðå ðøàä îàåúçì +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_w_function_result_uninitialized=05059_W_äòøê äîåçæø îäôåð÷öéä àéðå ðøàä ëîàåúçì +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. appears in the right-hand-side of an expression) +% before it is initialized (i.e. appeared in the left-hand side of an +% assigment) +sym_h_function_result_uninitialized=05060_H_äòøê äîåçæø îäôåð÷öéä àéðå ðøàä ëîàåúçì +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. appears in the right-hand-side of an expression) +% before it is initialized (i.e. appeared in the left-hand side of an +% assigment) +sym_w_identifier_only_read=05061_W_äîùúðä "$1" ð÷øà, àê îòåìí ìà ÷éáì úåëï +% You have read the value of a variable, but nowhere assigned a value to +% it. +sym_h_abstract_method_list=05062_H_ðîöàä îúåãä îåôùèú: $1 +% When getting a warning about constructing a class/object with abstract methods +% you get this hint to find the affected method. +% \end{description} +# +# Codegenerator +# +# 06040 is the last used one +# +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +cg_e_parasize_too_big=06009_E_äâåãø ùì øùéîú ôøîèøéí âãåìä î 65535 áúéí +% The I386 processor limits the parameter list to 65535 bytes (the \var{RET} +% instruction causes this) +cg_e_file_must_call_by_reference=06012_E_èéôåñ ùì ÷åáõ çééá ìäéåú îùúðä îåâãø +% You cannot specify files as value parameters, i.e. they must always be +% declared \var{var} parameters. +cg_e_cant_use_far_pointer_there=06013_E_äùéîåù áîöáéò far àéðå îåøùä áîé÷åí äðåëçé +% Free Pascal doesn't support far pointers, so you cannot take the address of +% an expression which has a far reference as a result. The \var{mem} construct +% has a far reference as a result, so the following code will produce this +% error: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_ìà ðéúï ì÷øåà ìôåð÷öéåú òí äâãøú EXPORT +% No longer in use. +cg_w_member_cd_call_from_method=06016_W_ëðøàä ÷øéàä ìà çå÷éú ùì éåöø àå äåøñ +% The compiler detected that a constructor or destructor is called within a +% a method. This will probably lead to problems, since constructors / destructors +% require parameters on entry. +cg_n_inefficient_code=06017_N_çñø ÷åã +% Your statement seems dubious to the compiler. +cg_w_unreachable_code=06018_W_ìà ðéúï ìäøéõ àú ÷èò ä÷åã +% You specified a construct which will never be executed. Example: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_ìà ðéúï ì÷øåà ìîúåãåú Abstract áöåøä éùéøä +% You cannot call an abstract method directy, instead you must call a +% overriding child method, because an abstract method isn't implemented. +cg_d_register_weight=06027_DL_Register $1 îù÷ì $2 $3 +% Debugging message. Shown when the compiler considers a variable for +% keeping in the registers. +cg_d_stackframe_omited=06029_DL_îùîéè àú îñâøú äîçñðéú +% Some procedure/functions do not need a complete stack-frame, so it is omitted. +% This message will be displayed when the {-vd} switch is used. +cg_e_unable_inline_object_methods=06031_E_îúåãåú ùì àåáéé÷è àå îçì÷ä àéðí éëåìéí ìäéåú inline +% You cannot have inlined object methods. +cg_e_unable_inline_procvar=06032_E_÷øéàåú Procvar àéðí éëåìéí ìäéåú inline +% A procedure with a procedural variable call cannot be inlined. +cg_e_no_code_for_inline_stored=06033_E_àéï ÷åã ìôøåöãåøåú inline +% The compiler couldn't store code for the inline procedure. +cg_e_can_access_element_zero=06035_E_àìîðè äàôñ ùì ansi/wide- àå longstring ìà ðâéù, äùúîù á (set)length áî÷åí +% You should use \var{setlength} to set the length of an ansi/wide/longstring +% and \var{length} to get the length of such a string types +cg_e_cannot_call_cons_dest_inside_with=06037_E_ìà ðéúï ì÷øåà ìéåöøéí àå äåøñéí áúåê çì÷ ùì 'with' +% Inside a \var{with} clause you cannot call a constructor or destructor for the +% object you have in the \var{with} clause. +cg_e_cannot_call_message_direct=06038_E_ìà ðéúï ì÷øåà ìîúåãåú ùì îèôì äåãàåú áöåøä éùéøä +% A message method handler method cannot be called directly if it contains an +% explicit self argument +cg_e_goto_inout_of_exception_block=06039_E_÷ôéöä àì úåê àå îçåõ ìáìå÷ ùì exception +% It is not allowed to jump in or outside of an exception block like \var{try..finally..end;}: +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // this line will cause an error +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_äùéîåù ááéèåééí äùåìèéí áæøéîú ä÷åã àéðí îåøùéí áçì÷ ä finally +% It isn't allowed to use the control flow statements \var{break}, +% \var{continue} and \var{exit} +% inside a finally statement. The following example shows the problem: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // This exit ISN'T allowed +% end; +% ... +% +% \end{verbatim} +% If the procedure \var{p} raises an exception the finally block is +% executed. If the execution reaches the exit, it's unclear what to do: +% exiting the procedure or searching for another exception handler +cg_w_parasize_too_big=06041_W_âåãì äôøîèéí âåìù àú ääâáìåú ùì çì÷ îäîòáãéí +% This indicates that you are declaring more than 64K of parameters, which +% might not be supported on other processor targets. +cg_w_localsize_too_big=06042_W_äâåãì ùì äîùúðä äî÷åîé âåìù îäâáìåú ùì çì÷ îäîòáãéí +% This indicates that you are declaring more than 32K of local variables, which +% might not be supported on other processor targets. +cg_e_localsize_too_big=06043_E_âåãì îùúðéí î÷åîééí âåìù îäâáìåú äðúîëåú +% This indicates that you are declaring more than 32K of local variables, which +% is not supported by this processor. +cg_e_break_not_allowed=06044_E_BREAK àéðå îåøùä +% You're trying to use \var{break} outside a loop construction. +cg_e_continue_not_allowed=06045_E_CONTINUE àéðå îåøùä +% You're trying to use \var{continue} outside a loop construction. +cg_f_unknown_compilerproc=06046_F_compilerproc "$1" ìà éãåò. áãå÷ àí äùúîù áñôøééú æîï äøéöä äðëåðä. +% The compiler expects that the runtime library contains certain subroutines. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the used compiler. If you changed the runtime library this error means +% that you removed a subroutine which the compiler needs for internal use. +cg_f_unknown_system_type=06047_F_ìà ðéúï ìîöåà èéôåñ îòøëú "$1". áãå÷ äàí àúä îùúîù áñôøééú æîï äøéöä òãëðéú. +% The compiler expects that the runtime library contains certain type definitions. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the used compiler. If you changed the runtime library this error means +% that you removed a type which the compiler needs for internal use. +cg_h_inherited_ignored=06048_H_îúòìí îäùéîåù áinherited áîúåãä îñåâ abstract +% This messages appears only in Delphi mode when you call an abstract method +% of a parent class via \var{inherited;}. The call is then ignored. +cg_e_goto_label_not_found=06049_E_úååéú ä Goto "$1" ìà äåâãøä àå ìà òáøä àåôèéîéæöéä +% The label used in the goto definition is not defined or optimized away by the +% unreachable code elemination. +% \end{description} +# EndOfTeX + +# +# Assembler reader +# +# 07105 is the last used one +# +asmr_d_start_reading=07000_DL_îúçéì áñâðåï îôøù àñîáìø $1 +% This informs you that an assembler block is being parsed +asmr_d_finish_reading=07001_DL_äñúééí ðéúåç ñâðåï àñîáìø $1 +% This informs you that an assembler block has finished. +asmr_e_none_label_contain_at=07002_E_úáðéú ììà úååéú îëéìä àú äúå @ +% A identifier which isn't a label can't contain a @. +asmr_e_building_record_offset=07004_E_ùâéàä ááðééú äéñè äøùåîä +% There has an error occured while building the offset of a record/object +% structure, this can happend when there is no field specified at all or +% an unknown field identifier is used. +asmr_e_offset_without_identifier=07005_E_ðòùä ùéîåù áOFFSET ììà îæää +% You can only use OFFSET with an identifier. Other syntaxes aren't +% supported +asmr_e_type_without_identifier=07006_E_ðòùä ùéîåù áTYPE ììà îæää +% You can only use TYPE with an identifier. Other syntaxes aren't +% supported +asmr_e_no_local_or_para_allowed=07007_E_ìà ðéúï ìäùúîù áîùúîä î÷åîé àå ôøîèø áîé÷åí äðåëçé +% You can't use a local variable or parameter here, mostly because the +% addressing of locals and parameters is done using the frame pointer register so the +% address can't be obtained directly. +asmr_e_need_offset=07008_E_éù öåøê ìäùúîù á OFFSET +% You need to use OFFSET <id> here to get the address of the identifier. +asmr_e_need_dollar=07009_E_éù öåøê ìäùúîù á$ +% You need to use $<id> here to get the address of the identifier. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_ìà ðéúï ìäùúîù á relocatable symbols îøåáéí +% You can't have more than one relocatable symbol (variable/typed constant) +% in one argument. +asmr_e_only_add_relocatable_symbol=07011_E_ðéúï ìäåñéó ø÷ relocatable symbol +% Relocatable symbols (variable/typed constant) can't be used with other +% operators. Only addition is allowed. +asmr_e_invalid_constant_expression=07012_E_áéèåé ÷áåò ìà çå÷é +% There is an error in the constant expression. +asmr_e_relocatable_symbol_not_allowed=07013_E_Relocatable symbol àéðå îåøùä +% You can't use a relocatable symbol (variable/typed constant) here. +asmr_e_invalid_reference_syntax=07014_E_úçáéø äôðéåú ìà çå÷é +% There is an error in the reference. +asmr_e_local_para_unreachable=07015_E_ìà ðéúï ìâùú ì $1 îä÷åã +% You can not read directly the value of a local variable or parameter +% of a higher level procedure in assembler code (except for +% local assembler code without parameter nor locals). +asmr_e_local_label_not_allowed_as_ref=07016_E_ñéîåìéí/úååéåú î÷åîéåú àéðí îåøùéí ëäôðéåú +% You can't use local symbols/labels as references +asmr_e_wrong_base_index=07017_E_ùéîåù ùâåé ááñéñ åàéðã÷ñ ùì àåâø +% There is an error with the base and index register, they are +% probably incorrect +asmr_w_possible_object_field_bug=07018_W_éúëï ëé éù ùâéàä áèéôåì äùãåú ùì àåáéé÷è +% Fields of objects or classes can be reached directly in normal or objfpc +% modes but TP and Delphi modes treat the field name as a simple offset. +asmr_e_wrong_scale_factor=07019_E_öåééï èååç ñåìí ùâåé +% The scale factor given is wrong, only 1,2,4 and 8 are allowed +asmr_e_multiple_index=07020_E_ùéîåù îøåáä áàéð÷ñ äàåâø +% You are trying to use more than one index register +asmr_e_invalid_operand_type=07021_E_èéôåñ àåôøðã ùâåé +% The operand type doesn't match with the opcode used +asmr_e_invalid_string_as_opcode_operand=07022_E_àùéîåù áîçøåæú ëàåôøðã opcode ùâåé: $1 +% The string specified as operand is not correct with this opcode +asmr_w_CODE_and_DATA_not_supported=07023_W_äùéîåù á@CODE å@DATA ìà ðúîê +% @CODE and @DATA are unsupported and are ignored. +asmr_e_null_label_ref_not_allowed=07024_E_äúééçñåú ìúååéú øé÷ä àéðä îåøùú +asmr_e_expr_zero_divide=07025_E_çéìå÷ áàôñ áäòøëú asm +% There is a division by zero in a constant expression +asmr_e_expr_illegal=07026_E_áéèåé ìà çå÷é +% There is an illegal expression in a constant expression +asmr_e_escape_seq_ignored=07027_E_îúòìí îøöó ÷éãåã: $1 +% There is a C-styled string, but the escape sequence in the string +% is unknown, and is therefore ignored +asmr_e_invalid_symbol_ref=07028_E_äúééçñåú ñéîåì ìà ú÷éðä +asmr_w_fwait_emu_prob=07029_W_FWAIT îñåâì ìâøåí ìáòéåú çé÷åé áemu387 +asmr_w_fadd_to_faddp=07030_W_$1 ììà úøâåí àåôøðã ì$1P +asmr_w_enter_not_supported_by_linux=07031_W_äåøàú ENTER àéðä ðúîëú ò"é ìéáú Linux +% ENTER instruction can generate a stack page fault that is not +% caught correctly by the i386 Linux page handler. +asmr_w_calling_overload_func=07032_W_îáöò ÷øéàä ìôåð÷öéä îùåëúáú áassembler +% There is a call to an overloaded method in the assembler block, +% this might be the sign there is a problem +asmr_e_unsupported_symbol_type=07033_E_èéôåñ äñéîåì ùì äàåôøðã àéðå ðúîê +asmr_e_constant_out_of_bounds=07034_E_úåëï ä÷áåò îçåõ ìâáåìåú +asmr_e_error_converting_decimal=07035_E_ùâéàä áæîï äîøä ãöéîìéú $1 +% A constant decimal value does not have the correct syntax +asmr_e_error_converting_octal=07036_E_ùâéàä áæîï äîøä àå÷èìéú $1 +% A constant octal value does not have the correct syntax +asmr_e_error_converting_binary=07037_E_ùâéàä áæîï äîøä áéðøéú $1 +% A constant binary value does not have the correct syntax +asmr_e_error_converting_hexadecimal=07038_E_ùâéàä áæîï äîøä ä÷ñä-ãöéîìéú $1 +% A constant hexadecimal value does not have the correct syntax +asmr_h_direct_global_to_mangled=07039_H_$1 úåøâí ì $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 îùåééê ìôåð÷öéä îùåëúáú +asmr_e_cannot_use_SELF_outside_a_method=07041_E_ìà ðéúï ìäùúîù á SELF îçåõ ìîúåãä +% There is a reference to the \var{self} symbol while it is not +% allowed. \var{self} can only be referenced inside methods +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_ìà ðéúï ìäùúîù á OLDEBP îçåõ ìôøåöãåøä î÷åððú +% There is a reference to the \var{oldebp} symbol while it is not +% allowed. \var{oldebp} can only be referenced inside nested routines +asmr_e_void_function=07043_W_ôøåöãåøåú àéðí éëåìéí ìäçæéø òøê áúåê ÷åã assembly +% Trying to return a value while in a procedure. A procedure +% does not have any return value +asmr_e_SEG_not_supported=07044_E_SEG àéðå ðúîê +asmr_e_size_suffix_and_dest_dont_match=07045_E_âåãì ñåôé åéòã, àå î÷åø äâåãì àéðí úåàîéí +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_w_size_suffix_and_dest_dont_match=07046_W_âåãì ñåôé åéòã, àå î÷åø äâåãì àéðí úåàîéí +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_e_syntax_error=07047_E_ùâéàä áúçáéø Assembler +% There is an assembler syntax error +asmr_e_invalid_opcode_and_operand=07048_E_ùéìåá ìà çå÷é áéï opcode åàåôøðã +% The opcode cannot be used with this type of operand +asmr_e_syn_operand=07049_E_ùâéàä áúçáéø àåôøðã áAssembler +asmr_e_syn_constant=07050_E_ùâéàä áúçáéø ÷áåò áAssembler +asmr_e_invalid_string_expression=07051_E_áéèåé îçøåæú ìà ú÷éï +asmr_w_const32bit_for_address=07052_W_ä÷áåò áòì äñéîåì $1 ìëúåáú, äåà ìà îöáéò +% A constant expression represents an address which does not fit +% into a pointer. The address is probably incorrect +asmr_e_unknown_opcode=07053_E_opcode $1 àéðå îåëø +% This opcode is not known +asmr_e_invalid_or_missing_opcode=07054_E_opcode çñø àå ìà ú÷éï +asmr_e_invalid_prefix_and_opcode=07055_E_ùéìåá ùì úçéìéú åopcode ìà ú÷éï : $1 +asmr_e_invalid_override_and_opcode=07056_E_äùéìåá ùì ùëúåá åopcode ìà ú÷éï: $1 +asmr_e_too_many_operands=07057_E_Too many operands on line +% There are too many operands for this opcode. Check your +% assembler syntax +asmr_w_near_ignored=07058_W_îúòìí îNEAR +asmr_w_far_ignored=07059_W_îúòìí î FAR +asmr_e_dup_local_sym=07060_E_ùéëôåì ùì äñéîåì äî÷åîé $1 +asmr_e_unknown_local_sym=07061_E_äñéîåì äî÷åîé $1 àéðå îåâãø +asmr_e_unknown_label_identifier=07062_E_îæää úååéú $1 ìà éãåò +asmr_e_invalid_register=07063_E_ùí àåâø ùâåé +% There is an unknown register name used as operand. +asmr_e_invalid_fpu_register=07064_E_ùí àåâø ìð÷åãä öôä ìà ú÷éï +% There is an unknown register name used as operand. +asmr_w_modulo_not_supported=07066_W_îåãåìå ìà ðúîê +asmr_e_invalid_float_const=07067_E_÷áåò ùì ð÷åãä öôä ìà ú÷éï $1 +% The floating point constant declared in an assembler block is +% invalid. +asmr_e_invalid_float_expr=07068_E_áéèåé ìà ú÷éï ùì ð÷åãä öôä +% The floating point expression declared in an assembler block is +% invalid. +asmr_e_wrong_sym_type=07069_E_ñåâ ñéîåì ùâåé +asmr_e_cannot_index_relative_var=07070_E_ìà ðéúï ìùîåø öéåï ùì ôøîèø àå îùúðä î÷åîé òí àåâø +% Trying to index using a base register a symbol which is already relative +% to a register. This is not possible, and will probably lead to crashes. +asmr_e_invalid_seg_override=07071_E_áéèåé äîé÷èò äîùåëúá àéðå ú÷éï +asmr_w_id_supposed_external=07072_W_äîæää $1 àéðå ðîöà, îðéç ùäîæää çéöåðé +% There is a reference to an undefined symbol. This will not result +% in an error, since the symbol might be external, but may cause +% problems at link time if the symbol is not defined anywhere. +asmr_e_string_not_allowed_as_const=07073_E_äîçøåæåú àéðï îåøùåú ìäéåú ÷áåòåú +% Character strings are not allowed as constants. +asmr_e_no_var_type_specified=07074_ìà öåééï èéôåñ äîùúðä +% The syntax expects a type idenfitifer after the dot, but +% none was found. +asmr_w_assembler_code_not_returned_to_text=07075_E_÷åã äassembler ìà çæø ìàéæåø äè÷ñè +% There was a directive in the assembler block to change sections, +% but there is a missing return to the text section at the end +% of the assembler block. This might cause errors during link time. +asmr_e_not_directive_or_local_symbol=07076_E_$1 äåà ìà äðçéä àå ñéîåì î÷åîé +% This symbol is unknown. +asmr_w_using_defined_as_local=07077_E_îùúîù áäâãøú äùí ëúååéú î÷åîéú +asmr_e_dollar_without_identifier=07078_E_äùéîåù áúå äãåìø îúáöò ììà îæää +% A constant expression has an identifier which does not start with +% the $ symbol. +asmr_w_32bit_const_for_address=07079_W_îñô÷ ëúåáú ùì 32 ñéáéåú ì÷áåò +% A constant was used as an address. This is probably an error, +% since using absolute addresses will probably not work. +asmr_n_align_is_target_specific=07080_N_äùéîåù á.align îáåññ òì ñåâ éòã, äùúîù á.balign àå .p2align +% Using the .align directive is platform specific, and its meaning will vary +% from one platform to another. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_ìà ðéúï ìäùúîù áöåøä éùéøä áùãåú ùì ôøîèøéí +% You should load the parameter first into a register and then access the +% fields using that register. +asmr_e_cannot_access_object_field_directly=07082_E_ìà ðéúï ìâùú áöåøä éùéøä ìùãåú ùì àåáéé÷èéí/îçì÷åú +% You should load the self pointer first into a register and then access the +% fields using the register as base. By default the self pointer is available +% in the esi register on i386. +asmr_e_unable_to_determine_reference_size=07083_E_ìà ðéúï ì÷áåò àú âåãì äàåôøðãéí ììà öéåï ùì äâåãì +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. +asmr_e_cannot_use_RESULT_here=07084_E_ìà ðéúï ìäùúîù áRESULT áôåð÷öéä äðåëçéú +% Some functions which return complex types cannot use the \var{result} +% keyword. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" ììà úøâåí ùì àåôøðãéí ì "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" úåøâí ì "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" úåøâí ì "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_äúå > àéðå îåøùä ëàï +% The shift operator requires the << characters. Only one +% of those characters was found. +asmr_e_invalid_char_greater=07090_E_äúå < àéðå îåøùä ëàï +% The shift operator requires the >> characters. Only one +% of those characters was found. +asmr_w_align_not_supported=07093_W_ALIGN àéðå ðúîê +asmr_e_no_inc_and_dec_together=07094_E_äùéîåù INC å DEC àéðí éëåìéí ìäâéò áééçã +% Trying to use an increment and a decrement within the same +% opcode on the 680x0. This is impossible. +asmr_e_invalid_reg_list_in_movem=07095_E_ùéîåù áreglist ì movem ìà ú÷éï +% Trying to use the \var{movem} opcode with invalid registers +% to save or restore. +asmr_e_invalid_reg_list_for_opcode=07096_E_ùéîåù ùâåé áreglist ìopcode +asmr_e_higher_cpu_mode_required=07097_E_æ÷å÷ ìîöá îòáã âáåää éåúø ($1) +% Trying to use an instruction which is not supported in the current +% cpu mode. Use a higher cpu generation to be able to use this +% opcode in your assembler block +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_ìà öåééï âåãì ùì àåôøðã åìà ðéúï ìðçù àú äâåãì, îùúîù áDWORD ëáøéøú îçãì +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use DWORD as default. +asmr_e_illegal_shifterop_syntax=07099_E_ùâéàú úçáéø áòú ðéñéåï ìôøù äñèú àåôøðã +% ARM only; ARM assembler supports a so called shifter operand. The used syntax isn't +% a valid shifter operand. Example for an operation with shifter operand: +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +asmr_e_packed_element=07100_E_äëúåáú ùì øëéá àøåæ àéðå ðîöà áèååç ùì áéú +% Packed components (record fields and array elements) may start at an arbitrary +% bit inside a byte. On CPU which do not support bit-addressable memory (which +% includes all currently supported CPUs by FPC) you will therefore get an error +% message when trying to index arrays with elements whose size is not a multiple +% of 8 bits. The same goes for accessing record fields with such an address. +% multiple of 8 bits. +asmr_w_unable_to_determine_reference_size_using_byte=07101_W_ìà öåééï âåãì, åäîäãø àéðå îöìéç ì÷áåò àú âåãì äàåôøðã, îùúîù áâåãì BYTE áúåø áøéøú îçãì +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use BYTE as default. +asmr_w_no_direct_ebp_for_parameter=07102_W_ìà ðéúï ìäùúîù á+äñè(%ebp) áîé÷åí äðåëé òáåø äôøîèøéí +% Using direct 8(%ebp) reference for function/procedure parameters is invalid +% if parameters are in registers. +asmr_w_direct_ebp_for_parameter_regcall=07103_W_äùéîåù á+äñè(%ebp) àéðå úåàí òí îåñëîåú ä regcall +% Using direct 8(%ebp) reference for function/procedure parameters is invalid +% if parameters are in registers. +asmr_w_direct_ebp_neg_offset=07104_W_äùéîåù á-äñè(%ebp) àéðå îåîìõ òáåø âéùä ìîùúðéí î÷åîééí +% Using -8(%ebp) to access a local variable is not recommended +asmr_w_direct_esp_neg_offset=07105_W_äùéîåù á-äñè(%ebp) òìåì ìâøåí ì÷øéñä ùì äúåëðéú àå ìàéáåã äîéãò +% Using -8(%esp) to access a local stack is not recommended, as +% this stack portion can be overwritten by any function calls or interrupts. +asmr_e_no_vmtoffset_possible=07106_E_äùéîåù á VMTOffset çééá ìäâéò áùéìåá ùì îúåãåú ååéøèåàìéåú å "$1" àéðå ååéøèåàìé +% \end{verbatim} +# +# Assembler/binary writers +# +# 08018 is the last used one +# +asmw_f_too_many_asm_files=08000_F_éåúø îéãé ÷áöé assembler +% With smartlinking enabled, there are too many assembler +% files generated. Disable smartlinking. +asmw_f_assembler_output_not_supported=08001_F_ñåâ äôìè ùì äassembler àéðå ðúîê +asmw_f_comp_not_supported=08002_F_Comp àéðå ðúîê +asmw_f_direct_not_supported=08003_F_îöá éùéø ùì assembler àéðå ðúîê ò"é ëåúáéí áéðàøééí +% Direct assembler mode is not supported for binary writers. +asmw_e_alloc_data_only_in_bss=08004_E_àúçåì äîéãò îåøùä ø÷ áçì÷ äbss +asmw_f_no_binary_writer_selected=08005_F_ìà ðáçø ëåúá áéðàøé +asmw_e_opcode_not_in_table=08006_E_Asm: Opcode $1 äåà ìà èáìä +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 äéðå ùéìåá ùâåé áéï opcode ìáéï àåôøðã +asmw_e_16bit_not_supported=08008_E_Asm: äúééçñåú ùì 16 ñéáéåú àéðå ðúîê +asmw_e_invalid_effective_address=08009_E_Asm: îòï áôòåì ìà ú÷éï +asmw_e_immediate_or_reference_expected=08010_E_Asm: îöôä ìäúééçñåú ìàåôøðã àå àåôøðã îéãé +asmw_e_value_exceeds_bounds=08011_E_Asm: $1 âåìù îäâáåìåú $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: Short jump îçåõ ìèååç $1 +asmw_e_undefined_label=08013_E_Asm: úååéú ìà îåâãøú $1 +asmw_e_comp_not_supported=08014_E_Asm: äèéôåñ COMP ìà ðúîê áéòã äîáå÷ù +asmw_e_extended_not_supported=08015_E_Asm: äèéôåñ Extended àéðå ðúîê áéòã äîáå÷ù +asmw_e_duplicate_label=08016_E_Asm: úååéåú ëôåìä $1 +asmw_e_redefined_label=08017_E_Asm: îâãéø îçãù àú äúååéú $1 +asmw_e_first_defined_label=08018_E_Asm: îåâãø ëàï ìøàùåðä +asmw_e_invalid_register=08019_E_Asm: àåâø ùâåé $1 +asmw_e_16bit_32bit_not_supported=08020_E_Asm: ääúééçñåú ì16 àå 32 ñéáéåú àéðä ðúîëú +asmw_e_64bit_not_supported=08021_E_Asm: äàåôøðè 64 ñéáéåú àéðå ðúîê + +# +# Executing linker/assembler +# +# 09034 is the last used one +# +# BeginOfTeX +% +% \section{Errors of assembling/linking stage} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +exec_w_source_os_redefined=09000_W_î÷åø îòøëú ääôòìä îåâãø îçãù +% The source operating system is redefined. +exec_i_assembling_pipe=09001_I_îøëéá (öéðåø) $1 +% Assembling using a pipe to an external assembler. +exec_d_cant_create_asmfile=09002_E_ìà ðéúï ìéöåø àú ÷åáõ äassembler $1 +% The mentioned file can't be created. Check if you have got +% access permissions to create this file +exec_e_cant_create_objectfile=09003_E_ìà ðéúï ìéöåø àú ÷åáõ àåáéé÷è $1 +% The mentioned file can't be created. Check if you've +% got access permissions to create this file +exec_e_cant_create_archivefile=09004_E_ìà ðéúï ìéöåø àú ÷åáõ äàøëéåï $1 +% The mentioned file can't be created. Check if you've +% access permissions to create this file +exec_e_assembler_not_found=09005_E_äî÷ùø $1 àéðå ðîöà, òåáø ìîàñó çéöåðé +% The assembler program was not found. The compiler will produce a script that +% can be used to assemble and link the program. +exec_t_using_assembler=09006_T_îùúîù áîàñó: $1 +% Information message saying which assembler is being used. +exec_e_error_while_assembling=09007_E_ùâéàä áæîï àéñåó ÷åã éöéàä $1 +% There was an error while assembling the file using an external assembler. +% Consult the documentation of the assembler tool to find out more information +% on this error. +exec_e_cant_call_assembler=09008_E_ìà ðéúï ìäøéõ àú äîàñó, ùâéàä $1, îøéõ îàñó çéöåðé +% An error occurred when calling an external assembler, The compiler will produce a script that +% can be used to assemble and link the program. +exec_i_assembling=09009_I_î÷ùø $1 +% An informational message stating which file is being assembled. +exec_i_assembling_smart=09010_I_àåñó òí smartlinking $1 +% An informational message stating which file is being assembled using smartlinking. +exec_w_objfile_not_found=09011_W_äàåáéé÷è $1 ìà ðîöà, ðøàä ùäàéñåó éëùì ! +% One of the object file is missing, and linking will probably fail. +% Check your paths. +exec_w_libfile_not_found=09012_W_äñôøééä $1 ìà ðîöàä, ðøàä ùäàéñåó éëùì ! +% One of the library file is missing, and linking will probably fail. +% Check your paths. +exec_e_error_while_linking=09013_E_ùâéàä áæîï ÷éùåø +% Generic error while linking. +exec_e_cant_call_linker=09014_E_ìà ðéúï ìäøéõ àú äî÷ùø, òåáø ìî÷ùø çéöåðé +% An error occurred when calling an external linker, The compiler will produce a script that +% can be used to assemble and link the program. +exec_i_linking=09015_I_î÷ùø $1 +% An informational message, showing which program or library is being linked. +exec_e_util_not_found=09016_E_äëìé $1 ìà ðîöà, òåáø ìî÷ùø çéöåðé +% An external tool was not found, the compiler will produce a script that +% can be used to assemble and link or postprocess the program. +exec_t_using_util=09017_T_îùúîù áëìé $1 +% An informational message, showing which external program (usually a postprocessor) is being used. +exec_e_exe_not_supported=09018_E_àéï úîéëä áéöéøú ÷áöé øéöä +% Creating executable programs is not supported for this platform, because it was +% not yet implemented in the compiler. +exec_e_dll_not_supported=09019_E_àéï úîéëä áéöéøú ñôøéåú ãéðîéåú/îùåúôåú +% Creating dynamically loadable libraries is not supported for this platform, because it was +% not yet implemented in the compiler. +exec_i_closing_script=09020_I_ñåâø àú äúñøéè $1 +% Informational message showing when the external assembling an linking script is finished. +exec_e_res_not_found=09021_E_îäãø îùàáéí ìà ðîöà, òåáø ìîöá çéöåðé +% An external resource compiler was not found, the compiler will produce a script that +% can be used to assemble, compile resources and link or postprocess the program. +exec_i_compilingresource=09022_I_îäãø àú äîùàá $1 +% An informational message, showing which resource is being compiled. +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_ìà ðéúï ì÷ùø àú äéçéãä $1 áöåøä ñèèéú, òåáø ì÷éùåø çëí +% Statical linking was requested, but a unit which is not statically linkable was used. +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_ìà ðéúï ì÷ùø áöåøä çëîä àú äéçéãä $1, òåáø ì÷éùåø ñèèé +% Smart linking was requested, but a unit which is not smart-linkable was used. +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_ìà ðéúï ì÷ùø àú äéçéãä $1 á÷éùåø îùåúó, òåáø ì÷éùåø ñèèé +% Shared linking was requested, but a unit which is not shared-linkable was used. +exec_e_unit_not_smart_or_static_linkable=09026_E_ìà ðéúï ì÷ùø àú äéçéãä $1 á÷éùåø çëí àå á÷éùåø ñèèé +% Smart or static linking was requested, but a unit which cannot be used for either was used. +exec_e_unit_not_shared_or_static_linkable=09027_E_ìà ðéúï ì÷ùø àú äéçéãä $1 á÷éùåø îùåúó àå ñèèé +% Shared or static linking was requested, but a unit which cannot be used for either was used. +exec_d_resbin_params=09028_D_îøéõ àú îäãø äîùàáéí "$1" òí "$2" áúåø ùåøú ô÷åãä +% An informational message showing which command-line is used for the resource compiler. +%\end{description} +# EndOfTeX + +# +# Executable information +# +# BeginOfTeX +% \section{Executable information messages.} +% This section lists all messages that the compiler emits when an executable program is produced, +% and only when the internal linker is used. +% \begin{description} +execinfo_f_cant_process_executable=09128_F_ìà îöìéç ìáöò îòáø ñåôé òì ÷åáõ ääøöä $1 +% Fatal error when the compiler is unable to post-process an executable. +execinfo_f_cant_open_executable=09129_F_ìà îöìéç ìôúåç àú ÷åáõ äøéöä $1 +% Fatal error when the compiler cannot open the file for the executable. +execinfo_x_codesize=09130_X_âåãì ä÷åã: $1 áúéí +% Informational message showing the size of the produced code section. +execinfo_x_initdatasize=09131_X_äâåãì ùì îéãò îàåúçì: $1 áúéí +% Informational message showing the size of the initialized data section. +execinfo_x_uninitdatasize=09132_X_îéãò ùì îéãò ìà îàåúçì: $1 áúéí +% Informational message showing the size of the uninitialized data section. +execinfo_x_stackreserve=09133_X_âåãì äîçñðéú äùîåøä: $1 áúéí +% Informational message showing the stack size that the compiler reserved for the executable. +execinfo_x_stackcommit=09134_X_âåãì äîçñðéú áùéîåù: $1 áúéí +% Informational message showing the stack size that the compiler commites for the executable. +%\end{description} +# EndOfTeX + +# +# Unit loading +# +# 10041 is the last used one +# +# BeginOfTeX +% \section{Unit loading messages.} +% This section lists all messages that can occur when the compiler is +% loading a unit from disk into memory. Many of these messages are +% informational messages. +% \begin{description} +unit_t_unitsearch=10000_T_îçôù àú äéçéãä: $1 +% When you use the \var{-vt}, the compiler tells you where it tries to find +% unit files. +unit_t_ppu_loading=10001_T_èåòï àú ÷åáõ ä PPU $1 +% When the \var{-vt} switch is used, the compiler tells you +% what units it loads. +unit_u_ppu_name=10002_U_ùí ä PPU: $1 +% When you use the \var{-vu} flag, the unit name is shown. +unit_u_ppu_flags=10003_U_ãâìé PPU: $1 +% When you use the \var{-vu} flag, the unit flags are shown. +unit_u_ppu_crc=10004_U_PPU Crc: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_time=10005_U_æîï PPU: $1 +% When you use the \var{-vu} flag, the time the unit was compiled is shown. +unit_u_ppu_file_too_short=10006_U_÷åáõ äPPU ÷öø îéãé +% The ppufile is too short, not all declarations are present. +unit_u_ppu_invalid_header=10007_U_äøàù ùì ÷åáõ ä PPU àéðå ú÷éï (ä÷åáõ àéðå îëéì PPU áäúçìä) +% A unit file contains as the first three bytes the ascii codes of \var{PPU} +unit_u_ppu_invalid_version=10008_U_âøñä ìà ú÷éðä ùì äPPU $1 +% This unit file was compiled with a different version of the compiler, and +% cannot be read. +unit_u_ppu_invalid_processor=10009_U_÷åáõ äPPU äåãø ìîòáã àçø +% This unit file was compiled for a different processor type, and +% cannot be read +unit_u_ppu_invalid_target=10010_U_÷åáõ äPPU äåãø ìîèøä àçøú +% This unit file was compiled for a different target, and +% cannot be read +unit_u_ppu_source=10011_U_î÷åø äPPU: $1 +% When you use the \var{-vu} flag, the unit source file name is shown. +unit_u_ppu_write=10012_U_ëåúá $1 +% When you specify the \var{-vu} switch, the compiler will tell you where it +% writes the unit file. +unit_f_ppu_cannot_write=10013_F_ìà ëåúá àú ÷åáõ ä PPU +% An error occurred when writing the unit file. +unit_f_ppu_read_error=10014_F_ùâéàä áæîï ÷øéàú ÷åáõ ä PPU +% This means that the unit file was corrupted, and contains invalid +% information. Recompilation will be necessary. +unit_f_ppu_read_unexpected_end=10015_F_ñåó ÷åáõ ìà öôåé (÷åáõ PPU) +% Unexpected end of file. This may mean that the PPU file is +% corrupted. +unit_f_ppu_invalid_entry=10016_F_ëðéñä ìà ú÷éðä á÷åáõ ä PPU: $1 +% The unit the compiler is trying to read is corrupted, or generated with a +% newer version of the compiler. +unit_f_ppu_dbx_count_problem=10017_F_áòéä áñôéøú Dbx á÷åáõ PPU +% There is an inconsistency in the debugging information of the unit. +unit_e_illegal_unit_name=10018_E_ùí éçéãä ìà ú÷éï: $1 +% The name of the unit does not match the file name. +unit_f_too_much_units=10019_F_éåúø îéãé éçéãåú +% \fpc has a limit of 1024 units in a program. You can change this behavior +% by changing the \var{maxunits} constant in the \file{fmodule.pas} file of the +% compiler, and recompiling the compiler. +unit_f_circular_unit_reference=10020_F_÷øéàä îòâìéú áéï äéçéãåú $1 å $2 +% Two units are using each other in the interface part. This is only allowed +% in the \var{implementation} part. At least one unit must contain the other one +% in the \var{implementation} section. +unit_f_cant_compile_unit=10021_F_àéï îñôé÷ îùàáéí òì îðú ìäãø àú äéçéãä $1 +% A unit was found that needs to be recompiled, but no sources are +% available. +unit_f_cant_find_ppu=10022_F_ìà îåöà àú äéçéãä $1 +% You tried to use a unit of which the PPU file isn't found by the +% compiler. Check your configuration file for the unit paths +unit_w_unit_name_error=10023_W_äéçéãä $1 ìà ðîöàä, àáì $2 ÷ééí +% This error message is no longer used. +unit_f_unit_name_error=10024_F_îçôù àú äéçéãä $1, àáì $2 ðîöà +% Dos truncation of 8 letters for unit PPU files +% may lead to problems when unit name is longer than 8 letters. +unit_w_switch_us_missed=10025_W_äéãåø éçéãú system ãåøùú àú äîúâ -Us +% When recompiling the system unit (it needs special treatment), the +% \var{-Us} must be specified. +unit_f_errors_in_unit=10026_F_òåöø ìàçø ùðîöàå $1 ùâéàåú áæîï äéãåø äîåãåì +% When the compiler encounters a fatal error or too many errors in a module +% then it stops with this message. +unit_u_load_unit=10027_U_èåòï $1 ($2) éçéãä $3 +% When you use the \var{-vu} flag, which unit is loaded from which unit is +% shown. +unit_u_recompile_crc_change=10028_U_îäãø àú $1 ìàçø ùäçúéîä ùåðúä ì $2 +% The unit is recompiled because the checksum of a unit it depends on has +% changed. +unit_u_recompile_source_found_alone=10029_U_ðîöà ø÷ ÷åã î÷åø, îäãø îçãù àú $1 +% When you use the \var{-vu} flag, these messages tell you why the current +% unit is recompiled. +unit_u_recompile_staticlib_is_older=10030_U_îäãø îçãù àú äéçéãä. äñôøééä äñèèéú éùðä éåúø î÷åáõ ä PPU +% When you use the \var{-vu} flag, the compiler warns if the static library +% of the unit are older than the unit file itself. +unit_u_recompile_sharedlib_is_older=10031_U_îäãø îçãù àú äéçéãä. äñôøééä äîùåúôú éùðä éåúø î÷åáõ ä PPU +% When you use the \var{-vu} flag, the compiler warns if the shared library +% of the unit are older than the unit file itself. +unit_u_recompile_obj_and_asm_older=10032_U_îäãø îçãù àú ä äéçéãä. ÷áöé ä obj åäasm éùðéí éåúø î÷åáõ ä PPU +% When you use the \var{-vu} flag, the compiler warns if the assembler or +% object file of the unit are older than the unit file itself. +unit_u_recompile_obj_older_than_asm=10033_U_îäãø îçãù àú äéçéãä. ÷åáõ äobj éùï éåúø î÷åáõ äasm +% When you use the \var{-vu} flag, the compiler warns if the assembler +% file of the unit is older than the object file of the unit. +unit_u_parsing_interface=10034_U_îôøù àú çì÷ äîîù÷ ùì $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the interface part of the unit +unit_u_parsing_implementation=10035_U_îôøù àú çì÷ äáéöåòé ùì $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the implementation part of the unit +unit_u_second_load_unit=10036_U_èòéðä ùðééä ùì äéçéãä $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_check_time=10037_U_áãé÷ú ÷åáõ PPU $1 æîï $2 +% When you use the \var{-vu} flag, the compiler show the filename and +% date and time of the file which a recompile depends on +### The following two error msgs is currently disabled. +#unit_h_cond_not_set_in_last_compile=10038_H_äúðàéí ùì $1 ìà äåâãøå áäúçìú äøéöä áäéãåø äàçøåï ùì $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that currently is defined, but was not used the last +#% time the unit was compiled. +#unit_h_cond_set_in_last_compile=10039_H_äúðàéí ùì $1 äåâãøå áäúçìú äøéöä áäéãåø äàçøåï ùì $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that was used the last time the unit was compiled, but +#% the conditional is currently not defined. +unit_w_cant_compile_unit_with_changed_incfile=10040_W_ìà ðéúï ìäãø àú äéçéãä $1 ìîøåú ù÷áöé äinclude ùåðå +% A unit was found to have modified include files, but +% some source files were not found, so recompilation is impossible. +unit_u_source_modified=10041_U_ä÷åáõ $1 çãù éåúø îä÷åáõ PPU $2 +% A modified source file for a compiler unit was found. +unit_u_ppu_invalid_fpumode=10042_U_îðñä ìäùúîù áéçéãä àùø äåãøä ìîöá FPU ùåðä +% Trying to compile code while using units which were not compiled with +% the same floating point format mode. Either all code should be compiled +% with FPU emulation on, or with FPU emulation off. +unit_u_loading_interface_units=10043_U_èåòï àú çì÷ äîîù÷ ùì äéçéãåú î $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the units defined in the interface part of the unit. +unit_u_loading_implementation_units=10044_U_èåòï àú äçì÷ äáéöåòé ùì äéçéãåú î $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the units defined in the implementation part of the unit. +unit_u_interface_crc_changed=10045_U_çúéîú ä CRC ùì çì÷ äîîù÷ äùúðä áéçéãä $1 +% When you use the \var{-vu} flag, the compiler warns that it the +% CRC calculated for the interface has been changed after the implementation +% has been parsed. +unit_u_implementation_crc_changed=10046_U_çúéîú äCRC ùì äçì÷ äáéöåòé äùúðä ìéçéãä $1 +% When you use the \var{-vu} flag, the compiler warns that it the +% CRC calculated has been changed after the implementation +% has been parsed. +unit_u_finished_compiling=10047_U_äñúééí äéãåø äéçéãä $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has finished compiling the unit. +unit_u_add_depend_to=10048_U_îåñéó àú äúìåú ùì $1 ì$2 +% When you use the \var{-vu} flag, the compiler warns that it +% has added a dependency between the two units. +unit_u_no_reload_is_caller=10049_U_àéï ÷øéàä îçåãùú ùì ä÷åáõ áùáéì $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has will not reload the unit because it is the unit that wants +% to load this unit +unit_u_no_reload_in_second_compile=10050_U_àéï èòéðä îçãù, áæîï äéãåø ùðé ùì äéçéãä $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has will not reload the unit because it is already in a second recompile +unit_u_flag_for_reload=10051_U_ãâì ìèòéðä îçåãùú: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to reload the unit +unit_u_forced_reload=10052_U_ëåôä òì èòéðä îçåãùú +% When you use the \var{-vu} flag, the compiler warns that it +% has is reloading the unit because it was required +unit_u_previous_state=10053_U_äîöá äéùï ùì $1: $2 +% When you use the \var{-vu} flag, the compiler shows the +% previous state of the unit +unit_u_second_compile_unit=10054_U_ðîöà ëáø áúäìéê äéãåø $1, îééùí äéãåø ùðé +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_loading_unit=10055_U_èåòï àú äéçéãä $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the unit. +unit_u_finished_loading_unit=10056_U_îñééí ìèòåï àú äéçéãä $1 +% When you use the \var{-vu} flag, the compiler warns that it finished +% loading the unit. +unit_u_registering_new_unit=10057_U_øåùí éçéãä çãùä $1 +% When you use the \var{-vu} flag, the compiler warns that it has +% found a new unit and registers it in the internal lists. +unit_u_reresolving_unit=10058_U_îçùá îçãù àú äéçéãä $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to recalculate the internal data of the unit +unit_u_skipping_reresolving_unit=10059_U_îãìâ òì èòéðä îçåãùú ùì äéçéãä $1, òãééï áæîï èòéðú éçéãåú áùéîåù +% When you use the \var{-vu} flag, the compiler warns that it +% skips to recalculate the internal data of the unit because there +% is no data to recalculate +% \end{description} +# EndOfTeX + +# +# Options +# +# 11041 is the last used one +# +option_usage=11000_O_$1 [options] <inputfile> [options] +# BeginOfTeX +% +% \section{Command-line handling errors} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +option_only_one_source_support=11001_W_úåîê ø÷ á÷åáõ î÷åø àçã áùåøú äô÷åãä +% You can specify only one source file on the command line. The first +% one will be compiled, others will be ignored. This may indicate that +% you forgot a \var{'-'} sign. +option_def_only_for_os2=11002_W_ðéúï ìéöåø àú ÷åáõ ä DEF ø÷ ìOS/2 +% This option can only be specified when you're compiling for OS/2 +option_no_nested_response_file=11003_E_àéï úîéëä á÷áöé úâåáä î÷åððéí +% you cannot nest response files with the \var{@file} command-line option. +option_no_source_found=11004_F_ìà öåééï ÷åáõ î÷åø áùåøú äô÷åãä +% The compiler expects a source file name on the command line. +option_no_option_found=11005_N_ìà öåéðå àôùøåéåú áúåê ÷åáõ ääâãøåú $1 +% The compiler didn't find any option in that config file. +option_illegal_para=11006_E_ôøîèø ìà çå÷é: $1 +% You specified an unknown option. +option_help_pages_para=11007_H_-? ëåúá ãôé òæøä +% When an unknown option is given, this message is diplayed. +option_too_many_cfg_files=11008_F_éåúø îéãé ÷áöé äâãøåú î÷åððéí +% You can only nest up to 16 config files. +option_unable_open_file=11009_F_ìà ðéúï ìôúåç àú ä÷åáõ $1 +% The option file cannot be found. +option_reading_further_from=11010_D_÷åøà äâãøåú ðåñôåú î $1 +% Displayed when you have notes turned on, and the compiler switches +% to another options file. +option_target_is_already_set=11011_W_äîèøä ëáø äåâãøä ì: $1 +% Displayed if more than one \var{-T} option is specified. +option_no_shared_lib_under_dos=11012_W_DOS àéðå úåîê áñôøéåú îùåúôåú, çåæø ìñôøéåú ñèèéåú +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos +option_too_many_ifdef=11013_F_IF(N)DEF øáéí îéãé +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_many_endif=11014_F_ENDIF øáéí îéãé +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_less_endif=11015_F_úðàé ôúåç áñåó ä÷åáõ +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_no_debug_support=11016_W_îéãò ðéôåé ùâéàåú àéðå ðúîê áñåâ ÷åáõ äøéöä äîáå÷ù +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_ðñä ìäãø îçãù òí äîúâ -dGDB +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_W_àúä îùúîù áîúâ äîéåùï $1 +% this warns you when you use a switch that is not needed/supported anymore. +% It is recommended that you remove the switch to overcome problems in the +% future, when the switch meaning may change. +option_obsolete_switch_use_new=11019_W_àúä îùúîù áîúâ äîéåùï $1, äùúîù áîúâ $2 áî÷åí +% this warns you when you use a switch that is not supported anymore. You +% must now use the second switch instead. +% It is recommended that you change the switch to overcome problems in the +% future, when the switch meaning may change. +option_switch_bin_to_src_assembler=11020_N_îòáéø àú äàåñó ìîöá áøéøú îçãì ùì ëúéáú îàñó +% this notifies you that the assembler has been changed because you used the +% -a switch which can't be used with a binary assembler writer. +option_incompatible_asm=11021_W_äúåëï äðáçø ùì äassembler "$1" àéðå îúàéí ì "$2" +option_asm_forced=11022_W_äúåëï ùì äîàñó "$1" ìà îñåâì ìéöåø ÷áöé àåáéé÷è, îùúîù áîàñó áøéøú äîçãì áî÷åí +% The assembler output selected can not generate +% object files with the correct format. Therefore, the +% default assembler for this target is used instead. +option_using_file=11026_T_÷åøà àôùøåéåú îä÷åáõ $1 +% Options are also read from this file +option_using_env=11027_T_÷åøà àôùøåéåú îäñáéáä $1 +% Options are also read from this environment string +option_handling_option=11028_D_îèôì áàôùøåú "$1" +% Debug info that an option is found and will be handled +option_help_press_enter=11029__*** ìçõ òì enter *** +option_start_reading_configfile=11030_H_îúçéì á÷øéàú ÷åáõ ääâãøåú $1 +% Starting of config file parsing. +option_end_reading_configfile=11031_H_ñéåí ÷øéàú ÷åáõ ääâãøåú $1 +% End of config file parsing. +option_interpreting_option=11032_D_îôøù àú äàôùøåú "$1" +option_interpreting_firstpass_option=11036_D_îôøù àú äîòáø äøàùåï òì äàôùøåú "$1" +option_interpreting_file_option=11033_D_îôøù àú äâãøú ä÷åáõ "$1" +option_read_config_file=11034_D_÷åøà àú ÷åáõ ääâãøåú "$1" +option_found_file=11035_D_ðîöà ÷åáõ î÷åø áùí "$1" +% Additional infos about options, displayed +% when you have debug option turned on. +option_code_page_not_available=11039_E_÷åã ãó ìà éãåò +option_config_is_dir=11040_F_ðîöàä ñôøééä áî÷åí ÷åáõ ääâãøåú $1 +% Directories can not be used as configuration files. +option_confict_asm_debug=11041_W_ñåâ äôìè ùì äîàñó ùðáçø "$1" àéðå éëåì ìéöåø îéãò òáåø ðéôåé ùâéàåú. îáèì ðéôåé ùâéàåú +% The assembler output selected can not generate +% debugging information, debugging option is therefore disabled. +%\end{description} +# EndOfTeX + +# +# Logo (option -l) +# +option_logo=11023_[ +Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU +Copyright (c) 1993-2011 by Florian Klaempfl +] + +# +# Info (option -i) +# +option_info=11024_[ +Free Pascal Compiler version $FPCVERSION + +úàøéê îäãø : $FPCDATE +îäãø ìîòáã: $FPCCPU + +îòøëåú äôòìä ðúîëåú: + $OSTARGETS + +äåøàåú îòáã ðúîëåú: + $INSTRUCTIONSETS + +äåøàåú ðúîëåú ùì éçéãú ð÷åãä öôä: + $FPUINSTRUCTIONSETS + +úîéëú äîéèåá: + $OPTIMIZATIONS + +äúåëðä îåâùú úçú øéùéåï GNU General Public License +ìîéãò ðåñó éù ì÷øåà àú COPYING.FPC + +ãéååç òì ú÷ìåú (áàâéí), äöòåú åëå': + http://bugs.freepascal.org + + bugs@freepascal.org +] + +# +# Help pages (option -? and -h) +# +# The first character on the line indicates who will display this +# line, the current possibilities are : +# * = every target +# 3 = 80x86 targets +# 6 = 680x0 targets +# e = in extended debug mode only +# P = PowerPC targets +# S = Sparc targets +# V = Virtual machine targets +# The second character also indicates who will display this line, +# (if the above character was TRUE) the current possibilities are : +# * = everyone +# g = with GDB info supported by the compiler +# O = OS/2 +# L = UNIX systems +# The third character represents the indentation level. +# +option_help_pages=11025_[ +**0*_äåñó àú äñéîï + ìàçø àôùøåú îúâ áåìéàðé ìàôùø àú äàôùøåú, äåñó àú äñéîï - ìáèì àú äàôùøåú +**1a_äîäãø àéðå îåç÷ àú ÷åáõ äassembler ùðåöø +**2al_øåùí øùéîä ùì ùåøåú ÷åã î÷åø á÷åáõ äassembler +**2an_øùéîú îéãò ùì öîúéí á÷åáõ äassembler +*L2ap_äùúîù áöéðåøåú áî÷åí ÷áöé assembler æîðééí +**2ar_øùéîä àåãåú øéùåí ùì ä÷öàä/ùçøåø á÷åáõ äassembler +**2at_øùéîä æîðéú àåãåú ä÷öàä/ùçøåø á÷åáõ äassembler +**1A<x>_úñãéøé ôìè: +**2Adefault_äùúîù áîàñó áøéøú îçãì +3*2Aas_àñåó òí GNU AS +3*2Anasmcoff_÷åáõ COFF (Go32v2) áùéîåù òí Nasm +3*2Anasmelf_÷åáõ ELF32 (Linux) áùéîåù òí Nasm +3*2Anasmwin32_÷åáõ àåáéé÷è Win32 áùéîåù òí Nasm +3*2Anasmwdosx_÷åáõ àåáéé÷è Win32/WDOSX áùéîåù òí Nasm +3*2Awasm_÷åáõ obj áùéîåù òí Wasm (Watcom) +3*2Anasmobj_÷åáõ obj áùéîåù òí Nasm +3*2Amasm_÷åáõ obj áùéîåù òí Masm (Microsoft) +3*2Atasm_÷åáõ obj áùéîåù Tasm (Borland) +3*2Aelf_÷åáõ ELF32 (Linux) áùéîåù ëåúá ôðéîé +3*2Acoff_÷åáõ OFF (Go32v2) áùéîåù ëåúá ôðéîé +3*2Apecoff_÷åáõ pecoff (Win32) áùéîåù ëåúá ôðéîé +4*2Aas_àñåó òí GNU AS +6*2Aas_÷åáõ-o Unix áùéîåù GNU AS +6*2Agas_GNU Motorola assembler +6*2Amit_MIT Syntax (GAS éùï) +6*2Amot_Motorola assembler ú÷ðé +A*2Aas_àñåó òí GNU AS +P*2Aas_àñåó òí GNU AS +S*2Aas_àñåó òí GNU AS +**1b_ééöø îéãò ìãôãåó +**2bl_ééöø îéãò òì ñîìéí î÷åîééí +**1B_áðä àú ëì äîåãåìéí +**1C<x>_àôùøåéåú éöéøú ÷åã: +**2Cc<x>_÷åáò îåñëîåú äôòìä áøéøú îçãì ì <ñ> +**2CD_öåø âí ñôøééä ãéðàîéú (ìà ðúîê) +**2Ce_îäãø òí äãîééä ùì opcodes äùééëéí ìð÷åãä öôä +**2Cf<x>_áçø äåøàåú FPU ìùéîåù, øàä fpc -i ìòøëéí àôùøééí +**2CF<x>_ãéå÷ ð÷åãä òùøåðéú ÷áåòä îéðéîìéú (default, 32, 64) +**2Cg_öåø ÷åã PIC +**2Ch<n>_ëîåú ùì <n> áúéí ì îöáåø (áéï 1023 å67107840) +**2Ci_áãé÷ú IO +**2Cn_äùîè îöá ÷éùåø +**2Co_áãå÷ âìéùä ùì ôòåìåú îñôø ùìí +**2CO_áãå÷ òáåø ôòåìåú âìéùä àôùøåéåú ùì îñôø ùìí +**2Cp<x>_áçø ÷áåöú äåøàåú, øàä fpc -i ìòøëéí àôùøééí +**2CP<x>=<y>_äâãøåú àøéæä +**3CPPACKSET=<y>_ <y> îñãø ä÷öàä: 0, 1 àå DEFAULT àå NORMAL, 2, 4 å 8 +**2Cr_áãé÷ú èååç +**2CR_ååãà ÷øéàä ú÷éðä ìîúåãä +**2Cs<n>_÷áò âåãì îçñðéú ì <n> +**2Ct_áãé÷ú îçñðéú +**2CX_öåø âí ñôøééä ùì ÷éùåø çëí +**1d<x>_îâãéø àú äñîì <x> +**1D_éåöø ÷åáõ DEF +**2Dd<x>_éåöø úàåø ì <x> +**2Dv<x>_éåöø âøñú DLL ì <x> +*O2Dw_éùåí PM +**1e<x>_÷åáò ðúéá ì÷åáõ øéöä +**1E_æää ì -Cn +**1fPIC_æää ì -Cg +**1F<x>_÷åáò ùí ÷áöéí åîé÷åîéí: +**2Fa<x>[,y]_÷åãí èåòï àú äéçéãåú <x> å [y] øàùåðåú, ìôðé ðéúåç ùåøú ä uses +**2Fc<x>_÷åáò ÷åã ãó ùì ÷ìè ì<x> +**2FC<x>_÷áò ùí îäãø RC áéðàøé ì <x> +**2FD<x>_÷åáò àú äñôøééä áä àôùø ìçôù àú ëìé äòæø ùì äîäãø +**2Fe<x>_äôðä äåãòåú ùâéàä ì<x> +**2Ff<x>_äåñó àú <x> ìðúéá äîñâøú (ø÷ á Darwin) +**2FE<x>_äôðä ôìè ùì exe/unit ìðúéá <x> +**2Fi<x>_îåñéó àú <x> ìøùéîú äðúéáéí +**2Fl<x>_îåñéó àú <x> ìøùéîú äðúéáéí ùì äñôøéä +**2FL<x>_îùúîù á<x> ëî÷ùø ãéðàîé +**2Fm<x>_èåòï èáìú äîøä ùì éåðé÷åã îä÷åáõ x>.txt> îñôøééú äîäãø +**2Fo<x>_îåñéó àú <x> ìøùéðú äðúéáéí ùì àåáéé÷è +**2Fr<x>_èåòï ÷åáõ äåãòåú ùâéàä <x> +**2FR<x>_÷áò î÷ùø ì÷åáõ res ì <x> +**2Fu<x>_îåñéó àú <x> ìøùéîú äðúéáéí ùì éçéãä +**2FU<x>_÷åáò àú äîé÷åí äôìè ùì äéçéãåú ì <x> åîùëúá àú -FE +*g1g_éåöø îéãò ìðéôåé ùâéàåú +*g2gc_éåöø áãé÷åú ìîöáéòéí +*g2gh_äùúîù áéçéãä heaptrace (òáåø ãìéôåú æëøåï/áòéåú áðéôåé ùâéàåú) +*g2gl_äùúîù áéçéãú îéãò ùì ùåøä ìäöéâ îéãò ðåñó ìbacktraces +*g2go<x>_öåø àôùøåéåú ìðéôåé ùâéàåú +*g3godwarfsets_àôùø îéãò ìðéäåì îéãò òáåø ðéôåé ùâéàåú ùì Dwarf (ùåáø àú gdb < 6.5) +*g2gp_îùîø âåãì ùîåú ñîìé ästabs +*g2gs_îééöø îéãò ìðéôåé ùâéàåú stub +*g2gt_ìëìê îùúðéí î÷åîééí (ìæéäåé îéãò ìà îàåúçì) +*g2gv_îééöø úåëðåú òí éëåìú îò÷á ùì valgrind +*g2gw_îééöø îéãò ìðéôåé ùâéàåú ìdwarf +*g2gw2_îéöø îéãò ìðéôåé ùâéàåú dwarf-2 +*g2gw3_îéöø îéãò ìðéôåé ùâéàåú dwarf-3 +**1i_îéãò +**2iD_äöâ úàøéê äîäãø +**2iV_äöâ âøñú äîäãø +**2iW_äöâ âøñä îìàä ùì äîäãø +**2iSO_äöâ îòøëú äôòìä ùì äîäãø +**2iSP_äöâ âøñú îòáã ùì äîäãø +**2iTO_äöâ àú äîèøä ùì îòøëú ääôòìä +**2iTP_äöâ àú äîèøä ùì äîòáã +**1I<x>_äåñó àú <x> ìøùéîú äðúéáéí ìäåñôä +**1k<x>_äòáø àú <x> ìî÷ùø +**1l_ëúåá ñîìéì +**1M<x>_äâãø îöá ùôä ì <x> +**2Mfpc_ãéàì÷è ùì Free Pascal (áøéøú îçãì) +**2Mobjfpc_àôùø ëîä úåñôåú ùì Delphi 2 +**2Mdelphi_îðñä ìäéåú úåàí Delphi +**2Mtp_îðñä ìäéåú úåàí ì TP/BP 7.0 +**2Mmacpas_îðñä ìäéåú úåàí ììäâ ùì Macintosh Pascal +**1n_àì ú÷øà àú ÷åáõ äâãøåú áøéøú äîçãì +**1N<x>_îéèåá öîúé òõ +**2Nu_ìâåìì ìåìàåú +**1o<x>_ùðä àú ùí ÷åáõ äøéöä ùäú÷áì ì <x> +**1O<x>_îéèåáéí: +**2O-_áèì îéèåá +**2O1_îéèåá øîä 1 (îäéø åèåá ìðéôåé ùâéàåú) +**2O2_îéèåá øîä 2 (-O1 + îéèåá îäéø) +**2O3_îéèåá øîä 3 (-O2 + îéèåá àéèé) +**2Oa<x>=<y>_÷áò ééùåø +**2Oo[NO]<x>_ò"î ìàôùø àå ìàôùø îéèåáéí, øàä fpc -i ìàôùøåéåú +**2Op<x>_ì÷áéòú îéèåá ìîòáã ðáçø, øàä fpc -i ìàôùøåéåú +**2Os_öåø ÷åã ÷èï +**1pg_öåø ÷åã ôøåôéì òáåø gprof (îâãéø àú FPC_PROFILE) +**1R<x>_ñâðåï ÷øéàú äàñó: +**2Rdefault_äùúîù áîàñó áøéøú îçãì +3*2Ratt_÷øà ñâðåï î÷ùø ùì AT&T +3*2Rintel_÷øà ñâðåï î÷ùø ùì Intel +6*2RMOT_÷øà ñâðåï î÷ùø ùì Motorola +**1S<x>_àôùøåéåú úçáéø: +**2S2_æää ì -Mobjfpc +**2Sc_úåîê àåôøèåøéí áñâðåï C (*=, +=, /= å -=) +**2Sa_äåñó ÷åã èòðú úðàé ÷áéòä (assertion) +**2Sd_æää ì -Mdelphi +**2Se<x>_àôùøåéåú ùâéàä. <x> äéðå äùéìåá äáà: +**3*_<n> : äîäãø òåöø ìàçø <n> ùâéàåú (áøéøú îçãì äéà 1) +**3*_w : äîäãø òåöø âí ìàçø àæäøåú +**3*_n : äîäãø òåöø ìàçø äòøåú +**3*_h : äîäãø òåöø ìàçø øîæéí +**2Sg_àôùø LABEL å GOTO +**2Sh_äùúîù á ansistrings +**2Si_úîåê áñâðåï C++ ùì INLINE +**2Sk_èòï àú äéçéãä fpcylix +**2SI<x>_÷áò ñâðåï îîù÷ ì<x> +**3SIcom_úåàí îîù÷é COM (áøéøú îçãì) +**3SIcorba_úåàí îîù÷é CORBA +**2Sm_úîåê áî÷øå ãåîéí ìC (âìåáìééí) +**2So_æää ì -Mtp +**2Ss_ùí éåöø çééá ìäéåú init (ùí äåøñ çééá ìäéåú done) +**2Sx_àôùø îéìåú îôúç ìexception (áøéøú îçãì áîöáé Delphi/ObjFPC) +**1s_àì ú÷øà ìîàñó åäî÷ùø +**2sh_öåø úñøéè ì÷éùåø áîàøç +**2st_öåø úñøéè ì÷éùåø áîèøä +**2sr_ãìâ òì øéùåí ä÷öàú îåôò (äùúîù áééçã òí -alr) +**1T<x>_îèøú îòøëú ääôòìä: +3*2Temx_OS/2 áùéîåù EMX ( áééçã òí äøçáú EMX/RSX) +3*2Tfreebsd_FreeBSD +3*2Tgo32v2_âøñä 2 ùì äøçáú DJ Delorie DOS +3*2Tlinux_Linux +3*2Tnetbsd_NetBSD +3*2Tnetware_Novell Netware Module (clib) +3*2Tnetwlibc_Novell Netware Module (libc) +3*2Topenbsd_OpenBSD +3*2Tos2_OS/2 / eComStation +3*2Tsunos_SunOS/Solaris +3*2Twatcom_Watcom úåàí äøçáú DOS +3*2Twdosx_WDOSX äøçáú DOS +3*2Twin32_Windows 32 ñéáéåú +3*2Twince_Windows CE +4*2Tlinux_Linux +6*2Tamiga_Commodore Amiga +6*2Tatari_Atari ST/STe/TT +6*2Tlinux_Linux/m68k +6*2Tmacos_Macintosh m68k (ìà ðúîê) +6*2Tpalmos_PalmOS +A*2Tlinux_Linux +A*2Twince_Windows CE +P*2Tamiga_AmigaOS òì PowerPC +P*2Tdarwin_Darwin å Mac OS X òì PowerPC +P*2Tlinux_Linux òì PowerPC +P*2Tmacos_Mac OS (÷ìàñé) òì PowerPC +P*2Tmorphos_MorphOS +S*2Tlinux_Linux +**1u<x>_îñéø àú ääâãøä ùì äñîì <x> +**1U_äâãøåú éçéãä: +**2Un_àì úáãå÷ àú ùí äéçéãä +**2Ur_öåø ÷áöé ùçøåø ùì éçéãåú +**2Us_äãø àú éçéãú äsystem +**1v<x>_úäéä îôåøè éåúø. <x> äéðå ùéìåá ùì äúååéí äáàéí: +**2*_e : äöâ äåãòåú ùâéàä (áøéøú îçãì) +**2*_0 : àì úöéâ ëìåí (ìîòè äåãòåú ùâéàä) +**2*_w : äöâ àæäøåú +**2*_u : äöâ îéãò òì éçéãä +**2*_n : äöâ äòøåú +**2*_t : äöâ ÷áöéí ùäéå áùéîåù +**2*_h : äöâ øîæéí +**2*_c : äöâ úðàéí +**2*_i : äöâ îéãò ëììé +**2*_d : äöâ îéãò ìðôåé ùâéàåú +**2*_l : äöâ îñôøé ùåøåú +**2*_r : îöá úåàí Rhide/GCC +**2*_a : äöâ äëåì +**2*_x : äöâ îéãò òì ÷åáõ äøéöä (ø÷ áWin32) +**2*_b : ëúåá äåãòåú òí ùîåú ÷áöéí åðúéáéí îìàéí +**2*_v : ëúåá àú ä÷åáõ fpcdebug.txt òí äøáä îéãò òì ðéôåé ùâéàåú +**2*_p : ëúåá àú ä÷åáõ tree.log òí ðéúåç òõ +3*1W<x>_àôùøåú îáåññú îèøä (îèøåú) +A*1W<x>_àôùøåú îáåññú îèøä (îèøåú) +P*1W<x>_àôùøåú îáåññú îèøä (îèøåú) +3*2Wb_öåø çáéìä áî÷åí ñôøééä (Darwin) +P*2Wb_öåø çáéìä áî÷åí ñôøééä (Darwin) +p*2Wb_öåø çáéìä áî÷åí ñôøééä (Darwin) +3*2WB_öåø úîåðä äðéúðú ìîé÷åí îçåãù (Windows) +A*2WB_öåø úîåðä äðéúðú ìîé÷åí îçåãù (Windows, Symbian) +3*2WC_îöééï àôìé÷öéä îñåâ îñåó (EMX, OS/2, Windows) +A*2WC_îöééï àôìé÷öéä îñåâ îñåó (Windows) +P*2WC_îöééï àôìé÷öéä îñåâ îñåó (Classic Mac OS) +3*2WD_äùúîù á DEFFILE ìééöà ôð÷öéåú ùì DLL àå EXE (Windows) +A*2WD_äùúîù á DEFFILE ìééöà ôð÷öéåú ùì DLL àå EXE (Windows) +3*2WF_îöééï àôìé÷öéä îñåâ îñê îìà (EMX, OS/2) +3*2WG_îöééï àôìé÷öéä îñåâ âøôé (EMX, OS/2, Windows) +A*2WG_îöééï àôìé÷öéä îñåâ âøôé (Windows) +P*2WG_îöééï àôìé÷öéä îñåâ âøôé (Classic Mac OS) +3*2WN_àì úöåø ÷åã îùðä îé÷åí, ðãøù òáåø ðéôåé ùâéàåú (Windows) +A*2WN_àì úöåø ÷åã îùðä îé÷åí, ðãøù òáåø ðéôåé ùâéàåú (Windows) +3*2WR_úéöåø ÷åã îùðä îé÷åí (Windows) +A*2WR_úéöåø ÷åã îùðä îé÷åí (Windows) +P*2WT_öééï àôìé÷öéä îñåâ ëìé MPW (Classic Mac OS) +**1X_äâãøåú øéöä: +**2Xc_äòáø --shared/-dynamic ìî÷ùø (BeOS, Darwin, FreeBSD, Linux) +**2Xd_àì úùúîù áðúéá çéôåù äñôøéåú äñèðãøèéåú (ðãøù òáåø äéãåø ìàøëéè÷èåøåú àçøåú) +**2Xe_äùúîù áî÷ùø çéöåðé +**2XD_ðñä ì÷ùø éçéãåú áöåøä ãéðàîéú (îâãéø FPC_LINK_DYNAMIC) +**2Xi_äùúîù áî÷ùø ôðéîé +**2Xm_öåø îôú ÷éùåøéí +**2XM<x>_äâãø àú äùí ùì øåèéðä ä'òé÷øéú' ùì äúåëðä (áøéøú îçãì äåà 'main') +**2XP<x>_öøó àú äùîåú äîâéòéí òí äúçéìéú <x> îbinutils +**2Xr<x>_äâãø àú ðúéá çéôåù äñôøéåú ì <x> (ðãøù òáåø äéãåø ìàøëéè÷èåøåú àçøåú) (BeOS, Linux) +**2XR<x>_öøó àú <x> ìëì ðúéáé äçéôåù ùì äî÷ùø (BeOS, Darwin, FreeBSD, Linux, Mac OS, Solaris) +**2Xs_ð÷ä àú ëì äñîìéí î÷áöé ääøöä +**2XS_ðñä ì÷ùø éçéãåú áöåøä ñèèéú (áøéøú îçãì, îâãéø FPC_LINK_STATIC) +**2Xt_÷ùø òí ñôøéåú ñèèéåú (îòáéø -static ìî÷ùø) +**2XX_úðñä ìáöò smartlink ìéçéãåú (îâãéø FPC_LINK_SMART) +**1*_ +**1?_äöâ àú òæøä æå +**1h_äöâ òæøä æå ììà ìçëåú + +] + +# +# The End... diff --git a/closures/compiler/msg/errorheu.msg b/closures/compiler/msg/errorheu.msg new file mode 100644 index 0000000000..16afb09bb0 --- /dev/null +++ b/closures/compiler/msg/errorheu.msg @@ -0,0 +1,2708 @@ +# +# This file is part of the Free Pascal Compiler +# Copyright (c) 1999-2008 by the Free Pascal Development team +# +# Hebrew (UTF8) language file for Free Pascal Compiler +# Contributed by Ido Kanner <idokan at gmail.com> and Dotan Kamber <kamberd at yahoo.com> +# Based on errore.msg of SVN revision 8988 +# +# 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. +# +# +# The constants are build in the following order: +# <part>_<type>_<txtidentifier> +# +# <part> is the part of the compiler the message is used +# asmr_ assembler parsing +# asmw_ assembler writing/binary writers +# unit_ unit handling +# scan_ scanner +# parser_ parser +# type_ type checking +# general_ general info +# exec_ calls to assembler, linker, binder +# +# <type> the type of the message it should normally used for +# f_ fatal error +# e_ error +# w_ warning +# n_ note +# h_ hint +# i_ info +# l_ add linenumber +# u_ used +# t_ tried +# c_ conditional +# d_ debug message +# x_ executable informations +# + +# +# General +# +# 01023 is the last used one +# +# BeginOfTeX +% \section{General compiler messages} +% This section gives the compiler messages which are not fatal, but which +% display useful information. The number of such messages can be +% controlled with the various verbosity level \var{-v} switches. +% \begin{description} +general_t_compilername=01000_T_מהדר: $1 +% When the \var{-vt} switch is used, this line tells you what compiler +% is used. +general_d_sourceos=01001_D_מערכת הפעלה: $1 +% When the \var{-vd} switch is used, this line tells you what the source +% operating system is. +general_i_targetos=01002_I_מערכת הפעלה מיועדת: $1 +% When the \var{-vd} switch is used, this line tells you what the target +% operating system is. +general_t_exepath=01003_T_משתמש בנתיב הרצה: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its binaries. +general_t_unitpath=01004_T_משתמש בנתיב היחידות: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for compiled units. You can set this path with the \var{-Fu} +general_t_includepath=01005_T_משתמש בנתיב המוסף: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its include files (files used in \var{\{\$I xxx\}} statements). +% You can set this path with the \var{-I} option. +general_t_librarypath=01006_T_משתמש בנתיב הספריה: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for the libraries. You can set this path with the \var{-Fl} option. +general_t_objectpath=01007_T_Using object path: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for object files you link in (files used in \var{\{\$L xxx\}} statements). +% You can set this path with the \var{-Fo} option. +general_i_abslines_compiled=01008_I_$1 שורות הודרו, ב$2 שניות +% When the \var{-vi} switch is used, the compiler reports the number +% of lines compiled, and the time it took to compile them (real time, +% not program time). +general_f_no_memory_left=01009_F_×œ× × ×©×ר זכרון +% The compiler doesn't have enough memory to compile your program. There are +% several remedies for this: +% \begin{itemize} +% \item If you're using the build option of the compiler, try compiling the +% different units manually. +% \item If you're compiling a huge program, split it up in units, and compile +% these separately. +% \item If the previous two don't work, recompile the compiler with a bigger +% heap (you can use the \var{-Ch} option for this, \seeo{Ch}) +% \end{itemize} +general_i_writingresourcefile=01010_I_כותב ×ת קובץ מש×בי טבלת המחרוזות: $1 +% This message is shown when the compiler writes the Resource String Table +% file containing all the resource strings for a program. +general_e_errorwritingresourcefile=01011_E_כותב ×ת קובץ מש×בי טבלת המחרוזות: $1 +% This message is shown when the compiler encountered an error when writing +% the Resource String Table file +general_i_fatal=01012_I_שגי××” קריטית: +% Prefix for Fatal Errors +general_i_error=01013_I_שגי××”: +% Prefix for Errors +general_i_warning=01014_I_התר××”: +% Prefix for Warnings +general_i_note=01015_I_הערה: +% Prefix for Notes +general_i_hint=01016_I_רמז: +% Prefix for Hints +general_e_path_does_not_exist=01017_E_הנתיב "$1" ×ינו ×§×™×™× +% The specified path does not exist. +general_f_compilation_aborted=01018_F_ההידור בוטל +% Compilation was aborted. +general_text_bytes_code=01019_bytes code +general_text_bytes_data=01020_bytes data +general_i_number_of_warnings=01021_I_×זהרות $1 הונפקו +% Total number of warnings issued during compilation. +general_i_number_of_hints=01022_I_הונפקו $1 ×¨×ž×–×™× +% Total number of hints issued during compilation. +general_i_number_of_notes=01023_I_הונפקו $1 הערות +% Total number of notes issued during compilation. +% \end{description} +# +# Scanner +# +# 02084 is the last used one +# +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compiling handling. +% \begin{description} +scan_f_end_of_file=02000_F_סוף קובץ ×œ× ×¦×¤×•×™ +% this typically happens in one of the following cases : +% \begin{itemize} +% \item The source file ends before the final \var{end.} statement. This +% happens mostly when the \var{begin} and \var{end} statements aren't +% balanced; +% \item An include file ends in the middle of a statement. +% \item A comment was not closed +% \end{itemize} +scan_f_string_exceeds_line=02001_F_מחרוזת גולשת משורה +% There is a missing closing ' in a string, so it occupies +% multiple lines. +scan_f_illegal_char=02002_F_תו ×œ× ×—×•×§×™ "$1" ($2) +% An illegal character was encountered in the input file. +scan_f_syn_expected=02003_F_שגי×ת תחביר: מצפה ל "$1" ×בל "$2" × ×ž×¦× +% This indicates that the compiler expected a different token than +% the one you typed. It can occur almost everywhere where you make a +% mistake against the pascal language. +scan_t_start_include_file=02004_TL_מתחיל קרי××” של קובץ תוספות $1 +% When you provide the \var{-vt} switch, the compiler tells you +% when it starts reading an included file. +scan_w_comment_level=02005_W_רמת הערות $1 נמצ××” +% When the \var{-vw} switch is used, then the compiler warns you if +% it finds nested comments. Nested comments are not allowed in Turbo Pascal +% and can be a possible source of errors. +scan_n_ignored_switch=02008_N_×ž×ª×¢×œ× ×ž×ž×ª×’ מהדר "$1" +% With \var{-vn} on, the compiler warns if it ignores a switch +scan_w_illegal_switch=02009_W_מתג מהדר "$1" ×ינו חוקי +% You included a compiler switch (i.e. \var{\{\$... \}}) which the compiler +% does not recognise +scan_w_switch_is_global=02010_W_×ž×™×§×•× ×©×’×•×™ למתג מהדר גלובלי +% The compiler switch is misplaced, and should be located at +% the start of the unit or program. +scan_e_illegal_char_const=02011_E_תו קבוע ×œ× ×—×•×§×™ +% This happens when you specify a character with its ASCII code, as in +% \var{\#96}, but the number is either illegal, or out of range. +scan_f_cannot_open_input=02012_F_×œ× × ×™×ª×Ÿ לפתוח ×ת קובץ "$1" +% \fpc cannot find the program or unit source file you specified on the +% command line. +scan_f_cannot_open_includefile=02013_F_×œ× × ×™×ª×Ÿ לפתוח ×ת קובץ התוספות "$1" +% \fpc cannot find the source file you specified in a \var{\{\$include ..\}} +% statement. +scan_e_illegal_pack_records=02015_E_יישור רשומה ×œ× ×—×•×§×™ מייצג "$1" +% You are specifying the \var{\{\$PACKRECORDS n\} } or \var{\{\$ALIGN n\} } +% with an illegal value for \var{n}. For \$PACKRECORDS valid alignments are 1, 2, 4, 8, 16, 32, C, +% NORMAL, DEFAULT, and for \$ALIGN valid alignment are 1, 2, 4, 8, 16, 32, ON, +% OFF. Under mode MacPas \$ALIGN also supports MAC68K, POWER and RESET. +scan_e_illegal_pack_enum=02016_E_מספר מינימלי של מנייה המייצג "$1" ×ינו חוקי +% You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for +% \var{n}. Only 1,2,4, NORMAL or DEFAULT are valid here. +scan_e_endif_expected=02017_E_מצפה ל$ENDIF בהגדרה $1 $2 הנמצ×ת ב$3 שורה $4 +% Your conditional compilation statements are unbalanced. +scan_e_preproc_syntax_error=02018_E_שגי×ת תחביר בעת ניתוח משפט תנ××™ +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc compiler +% directives. +scan_e_error_in_preproc_expr=02019_E_הערכת משפט תנ××™ +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc compiler +% directives. +scan_w_macro_cut_after_255_chars=02020_W_תוכן המקרו מוגבל ל×ורך של 255 ×ª×•×•×™× +% The contents of macros cannot be longer than 255 characters. +scan_e_endif_without_if=02021_E_ENDIF ×œ×œ× IF(N)DEF +% Your \var{\{\$IFDEF ..\}} and {\{\$ENDIF\}} statements aren't balanced. +scan_f_user_defined=02022_F_הגדרת משתמש: $1 +% A user defined fatal error occurred. see also the \progref +scan_e_user_defined=02023_E_הגדרת משתמש: $1 +% A user defined error occurred. see also the \progref +scan_w_user_defined=02024_W_הגדרת משתמש: $1 +% A user defined warning occurred. see also the \progref +scan_n_user_defined=02025_N_הגדרת משתמש: $1 +% A user defined note was encountered. see also the \progref +scan_h_user_defined=02026_H_הגדרת משתמש: $1 +% A user defined hint was encountered. see also the \progref +scan_i_user_defined=02027_I_הגדרת משתמש: $1 +% User defined information was encountered. see also the \progref +scan_e_keyword_cant_be_a_macro=02028_E_מילת מפתח המוגדרת מחדש כמקרו ××™× ×” מכילה השפעה +% You cannot redefine keywords with macros. +scan_f_macro_buffer_overflow=02029_F_גלישת מ×גר מקרו בעת קרי××” ×ו הרחבה של מקרו +% Your macro or its result was too long for the compiler. +scan_w_macro_too_deep=02030_W_הרחבת מקרו גולשת מעומק של 16. +% When expanding a macro, macros have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_w_wrong_styled_switch=02031_W_ מתגי פעולת מהדר ××™× × × ×ª×ž×›×™× ×‘×”×¢×¨×•×ª מסוג // +% Compiler switches should be in normal pascal style comments. +scan_d_handling_switch=02032_DL_מטפל במתג "$1" +% When you set debugging info on (\var{-vd}) the compiler tells you when it +% is evaluating conditional compile statements. +scan_c_endif_found=02033_CL_× ×ž×¦× ENDIF $1 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifdef_found=02034_CL_× ×ž×¦× IFDEF $1, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifopt_found=02035_CL_× ×ž×¦× IFOPT $1, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_if_found=02036_CL_× ×ž×¦× IF $1, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifndef_found=02037_CL_× ×ž×¦× IFNDEF $1, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_else_found=02038_CL_× ×ž×¦× ELSE $1, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_skipping_until=02039_CL_מדלג... +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements, and whether it is skipping or +% compiling parts. +scan_i_press_enter=02040_I_לחץ על <return> להמשיך +% When the \var{-vi} switch is used, the compiler stops compilation +% and waits for the \var{Enter} key to be pressed when it encounters +% a \var{\{\$STOP\}} directive. +scan_w_unsupported_switch=02041_W_מתג "$1" ×ינו נתמך +% When warnings are turned on (\var{-vw}) the compiler warns you about +% unsupported switches. This means that the switch is used in Delphi or +% Turbo Pascal, but not in \fpc +scan_w_illegal_directive=02042_W_הור×ת המהדר "$1" ××™× ×” חוקית +% When warings are turned on (\var{-vw}) the compiler warns you about +% unrecognised switches. For a list of recognised switches, \progref +scan_t_back_in=02043_TL_חזרה ב$1 +% When you use (\var{-vt}) the compiler tells you when it has finished +% reading an include file. +scan_w_unsupported_app_type=02044_W_×ין תמיכה לסוג ×”×פליקציה: "$1" +% You get this warning, if you specify an unknown application type +% with the directive \var{\{\$APPTYPE\}} +scan_w_app_type_not_support=02045_W_APPTYPE ×ינו נתמך ×¢"×™ ההמערכת הפעלה המבוקשת +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_w_description_not_support=02046_W_DESCRIPTION ×ינו נתמך ×¢"×™ מערכת ההפעלה המבוקשת +% The \var{\{\$DESCRIPTION\}} directive is not supported on this target OS +scan_n_version_not_support=02047_N_VERSION ×ינו נתמך ×¢"×™ מערכת הפעלה המבוקשת +% The \var{\{\$VERSION\}} directive is not supported on this target OS +scan_n_only_exe_version=02048_N_VERSION רק לקבצי exe ×ו DLL +% The \var{\{\$VERSION\}} directive is only used for executable or DLL sources. +scan_w_wrong_version_ignored=02049_W_פורמט שגוי להור×ת VERSION: "$1" +% The \var{\{\$VERSION\}} directive format is majorversion.minorversion +% where majorversion and minorversion are words. +scan_e_illegal_asmmode_specifier=02050_E_סגנון ×”×סמבלר שצויין "$1" ×ינו חוקי +% When you specify an assembler mode with the \var{\{\$ASMMODE xxx\}} +% the compiler didn't recognize the mode you specified. +scan_w_no_asm_reader_switch_inside_asm=02051_W_מתג ×§×•×¨× ×”ASM ×ינו ×פשרי בתוך משפט ×סמבלי. "$1" ×™×”×™×” ישפיע רק בהכרזה הב××”/ +% It is not possible to switch from one assembler reader to another +% inside an assembler block. The new reader will be used for next +% assembler statements only. +scan_e_wrong_switch_toggle=02052_E_שימוש שגוי במתג. השתמש בON/OFF ×ו ב +/- +% You need to use ON or OFF or a + or - to toggle the switch +scan_e_resourcefiles_not_supported=02053_E_קובץ המש××‘×™× ×ינו נתמך ביעד הנבחר +% The target you are compiling for doesn't support resource files. +scan_w_include_env_not_found=02054_W_משתנה הסביבה "$1" ×œ× × ×ž×¦× ×‘×¡×‘×™×‘×” +% The included environment variable can't be found in the environment, it will +% be replaced by an empty string instead. +scan_e_invalid_maxfpureg_value=02055_E_ערך ×œ× ×—×•×§×™ להגבלות ×וגר ×”FPC +% Valid values for this directive are 0..8 and NORMAL/DEFAULT +scan_w_only_one_resourcefile_supported=02056_W_רק קובץ מש××‘×™× ×חד נתמך ביעד ×–×” +% The target you are compiling for supports only one resource file. +% The first resource file found is used, the others are discarded. +scan_w_macro_support_turned_off=02057_W_התמיכה במקרו כובה +% A macro declaration has been found, but macro support is currently off, +% so the declaration will be ignored. To turn macro support on compile with +% -Sm on the commandline or add \{\$MACRO ON\} in the source +scan_e_invalid_interface_type=02058_E_הוכרז סוג ממשק ×œ× ×—×•×§×™. הגדרות חוקיות ×”× COM, CORBA ×ו DEFAULT +% The interface type that was specified is not supported +scan_w_appid_not_support=02059_W_APPID נתמך רק בPALMOS +% The \var{\{\$APPID\}} directive is only supported for the PalmOS target. +scan_w_appname_not_support=02060_W_APPNAME נתמך רק בPALMOS +% The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target. +scan_e_string_exceeds_255_chars=02061_E_מחרוזת קבועה ×œ× ×™×›×•×œ×” להיות מעל 255 ×ª×•×•×™× +% A single string constant can contain at most 255 chars. Try splitting up the +% string in multiple smaller parts and concatenate them with a + operator. +scan_f_include_deep_ten=02062_F_הוספת קבצי ×”include גלש מעומק ×”16 +% When including include files the files have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_e_too_many_push=02063_F_יותר מידי שכבות PUSH +% A maximum of 20 levels is allowed. This error occurs only in mode MacPas. +scan_e_too_many_pop=02064_E_POP ×œ×œ× ×©×—×¨×•×¨ של PUSH +% This error occurs only in mode MacPas. +scan_e_error_macro_lacks_value=02065_E_מקרו "$1" ×œ× ×ž×›×™×œ ×¢×¨×›×™× +% Thus the conditional compile time expression cannot be evaluated. +scan_e_wrong_switch_toggle_default=02066_E_שימוש במתג שגוי, השתמש ב ON/OFF/DEFAULT ×ו ב+/-/* +% You need to use ON or OFF or DEFAULT or a + or - or * to toggle the switch +scan_e_mode_switch_not_allowed=02067_E_מצב מתג "$1" ×œ× ×ž×•×¨×©×” +% A mode switch has already been encountered, or, in case of option -Mmacpas, +% a mode switch occur after UNIT. +scan_e_error_macro_undefined=02068_E_משתנה זמן הידור "$1" ×œ× ×”×•×’×“×¨. +% Thus the conditional compile time expression cannot be evaluated. Only in mode MacPas. +scan_e_utf8_bigger_than_65535=02069_E_× ×ž×¦× ×§×•×“ UTF-8 גבוהה יותר מ65535 +% \fpc handles utf-8 strings internally as widestrings e.g. the char codes are limited to 65535 +scan_e_utf8_malformed=02070_E_מחרוזת UTF-8 תקולה +% The given string isn't a valid UTF-8 string +scan_c_switching_to_utf8=02071_C_UTF-8 signature found, using UTF-8 encoding +% The compiler found an UTF-8 encoding signature (\$ef, \$bb, \$bf) at the beginning of a file, +% so it interprets it as an UTF-8 file +scan_e_compile_time_typeerror=02072_E_ביטוי בזמן הידור: נדרש $1 ×בל התקבל $2 ב$3 +% Type check of a compile time expression failed. +scan_n_app_type_not_support=02073_N_APPTYPE ×œ× × ×ª×ž×š במערכת ההפעלה המבוקשת +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_e_illegal_optimization_specifier=02074_E_סופק מיטוב ×œ× ×—×•×§×™ "$1" +% When you specify an optimization with the \var{\{\$OPTIMIZATION xxx\}} +% the compiler didn't recognize the optimization you specified. +scan_w_setpeflags_not_support=02075_W_SETPEFLAGS ×ינו נתמך במערכת ההפעלה המבוקשת +% The \var{\{\$SETPEFLAGS\}} directive is not supported by the target OS +scan_w_imagebase_not_support=02076_W_IMAGEBASE ×ינו נתמך על ידי מערכת ההפעלה המבוקשת +% The \var{\{\$IMAGEBASE\}} directive is not supported by the target OS +scan_w_minstacksize_not_support=02077_W_MINSTACKSIZE ×ינו נתמך על ידי מערכת ההפעלה המבוקשת +% The \var{\{\$MINSTACKSIZE\}} directive is not supported by the target OS +scan_w_maxstacksize_not_support=02078_W_MAXSTACKSIZE ×ינו נתמך על ידי מערכת ההפעלה המבוקשת +% The \var{\{\$MAXSTACKSIZE\}} directive is not supported by the target OS +scanner_e_illegal_warn_state=02079_E_שימוש ×œ× ×—×•×§×™ בהנחית $WARN +% Only ON and OFF can be used as state with a \$warn compiler directive +scan_e_only_packset=02080_E_ערך של ×ריזה ×œ× ×—×•×§×™ +% Only 0, 1, 2, 4, 8, DEFAULT and NORMAL are allowed as packset parameter +scan_w_pic_ignored=02081_W_×ž×ª×¢×œ× ×ž×”×•×¨×ת PIC +% Several targets like windows do not support neither need PIC so the PIC directive and switch are +% ignored. +scan_w_unsupported_switch_by_target=02082_W_המתג "$1" ×ינו נתמך בסוג תוצ××” שנבחר +% Some compiler switches like \$E are not supported by all targets. +scan_w_frameworks_darwin_only=02084_W_×פשרויות מבוססות מסגרת נתמכות רק עבור Darwin/Mac OS X +% Frameworks are not a known concept, or at least not supported by FPC, on operating systems other than Darwin/Mac OS X. +scan_e_illegal_minfpconstprec=02085_E_דיוק הערך הקבוע של הנקודה העשרונית המינימלית "$1" ×ינו חוקי +% Valid minimal precisions for floating point constants are default, 32 and 64, which mean respectively minimal (usually 32 bit), 32 bit and 64 bit precision. +% \end{description} +# +# Parser +# +# 03192 is the last used one +# +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your pascal constructs +% are correct. +% \begin{description} +parser_e_syntax_error=03000_E_מפרש - שגי××” תחבירית +% An error against the Turbo Pascal language was encountered. This happens +% typically when an illegal character is found in the sources file. +parser_e_dont_nest_interrupt=03004_E_פרוצדורת פסיקה ××™× ×” יכולה להיות מקוננת +% An \var{INTERRUPT} procedure must be global. +parser_w_proc_directive_ignored=03005_W_×ž×ª×¢×œ× ×ž×¡×•×’ פרוצדורה "$1" +% The specified procedure directive is ignored by FPC programs. +parser_e_no_overload_for_all_procs=03006_E_×œ× ×›×œ ההכזרות של "$1" בעלות הכרזת OVERLOAD +% When you want to use overloading using the \var{OVERLOAD} directive, then +% all declarations need to have \var{OVERLOAD} specified. +parser_e_export_name_double=03008_E_כפילויות ×‘×™×™×¦×•× ×©× ×”×¤×•× ×§×¦×™×” "$1" +% Exported function names inside a specific DLL must all be different +parser_e_export_ordinal_double=03009_E_כפילויות ×‘×™×™×¦×•× ×ינדקס הפונקציה "$1" +% Exported function names inside a specific DLL must all be different +parser_e_export_invalid_index=03010_E_×ינדקס ×œ× ×ª×§×™×Ÿ ×œ×™×™×¦×•× ×”×¤×•× ×§×¦×™×” +% DLL function index must be in the range \var{1..\$FFFF} +parser_w_parser_reloc_no_debug=03011_W_שינוי ×ž×™×§×•× × ×ª×•× ×™ הניפוי ×œ× ×¢×•×‘×“×™× ×œ×§×‘×¦×™ DLL ×ו קבצי הרצה. התבטל. +parser_w_parser_win32_debug_needs_WN=03012_W_ל×פשר ניפוי שגי×ות לwin32 יש לבטל ×ת שינוי ×”×ž×™×§×•× ×¢"×™ ×”×פשרות -WN +% Stabs info is wrong for relocatable DLL or EXES use -WN +% if you want to debug win32 executables. +parser_e_constructorname_must_be_init=03013_E_×©× ×™×•×¦×¨ חייב להיות INIT +% You are declaring an object constructor with a name which is not \var{init}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_destructorname_must_be_done=03014_E_×©× ×”×•×¨×¡ חייב להיות DONE +% You are declaring an object destructor with a name which is not \var{done}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_proc_inline_not_supported=03016_E_פרוצדורת INLINE ×œ× × ×ª×ž×›×ª +% You tried to compile a program with C++ style inlining, and forgot to +% specify the \var{-Si} option (\seeo{Si}). The compiler doesn't support C++ +% styled inlining by default. +parser_w_constructor_should_be_public=03018_W_יוצר צריך להיות ציבורי +% Constructors must be in the 'public' part of an object (class) declaration. +parser_w_destructor_should_be_public=03019_W_הורס צריך להיות ציבורי +% Destructors must be in the 'public' part of an object (class) declaration. +parser_n_only_one_destructor=03020_N_מחלקה צריכה הורס ×חד בלבד +% You can declare only one destructor for a class. +parser_e_no_local_objects=03021_E_הגדרות מחלקה מקומיות ××™× × ×ž×•×¨×©×•×ª +% Classes must be defined globally. They cannot be defined inside a +% procedure or function +parser_f_no_anonym_objects=03022_F_הגדרות מחלקה ×נונימיות ××™× × ×ž×•×¨×©×•×ª +% An invalid object (class) declaration was encountered, i.e. an +% object or class without methods that isn't derived from another object or +% class. For example: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% will trigger this error. +parser_n_object_has_no_vmt=03023_N_×”×ובייקט "$1" ×œ×œ× VMT +% This is a note indicating that the declared object has no +% virtual method table. +parser_e_illegal_parameter_list=03024_E_רשימת ×¤×¨×ž×˜×¨×™× ×œ× ×—×•×§×™×ª +% You are calling a function with parameters that are of a different type than +% the declared parameters of the function. +parser_e_wrong_parameter_size=03026_E_מספר שגוי של ×¤×¨×ž×˜×¨×™× ×¦×•×™×Ÿ עבור הקרי××” ל "$1" +% There is an error in the parameter list of the function or procedure, +% the number of parameters is not correct. +parser_e_overloaded_no_procedure=03027_E_מזהה המרובה שימוש "$1" ×ינו פונקציה +% The compiler encountered a symbol with the same name as an overloaded +% function, but it is not a function it can overload. +parser_e_overloaded_have_same_parameters=03028_E_פונקציות מרובות שימוש מכילות ×ת ××•×ª× ×¨×©×™×ž×ª ×¤×¨×ž×˜×¨×™× +% You're declaring overloaded functions, but with the same parameter list. +% Overloaded function must have at least 1 different parameter in their +% declaration. +parser_e_header_dont_match_forward=03029_E_הגדרת הפונקציה ××™× ×” תו×מת ×ת ההגדרה הקודמת "$1" +% You declared a function with same parameters but +% different result type or function modifiers. +parser_e_header_different_var_names=03030_E_הגדרת הפונקציה "$1" ××™× ×” תו×מת ×ת המימוש: ×©× ×ž×©×ª× ×” השתנה $2 => $3 +% You declared the function in the \var{interface} part, or with the +% \var{forward} directive, but define it with a different parameter list. +parser_n_duplicate_enum=03031_N_×¢×¨×›×™× ×‘×¡×•×’ מניה ×—×™×™×‘×™× ×œ×”×™×•×ª בסדר עולה +% \fpc allows enumeration constructions as in C. Given the following +% declaration two declarations: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% The second declaration would produce an error. \var{A\_UAS} needs to have a +% value higher than \var{A\_E}, i.e. at least 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_With ×ינו מסוגל להשתמש ×‘×ž×©×ª× ×™× ×ž×ž×§×˜×¢ שונה +% With stores a variable locally on the stack, +% but this is not possible if the variable belongs to another segment. +parser_e_too_much_lexlevel=03034_E_פונקציה מקוננת > 31 +% You can nest function definitions only 31 times. +parser_e_range_check_error=03035_E_שגי××” בבדיקת טווח בעת הערכת ×§×‘×•×¢×™× +% The constants are out of their allowed range. +parser_w_range_check_error=03036_W_שגי××” בבדיקת טווח בעת הערכת ×§×‘×•×¢×™× +% The constants are out of their allowed range. +parser_e_double_caselabel=03037_E_הכזרת תווית כפולה בcase +% You are specifying the same label 2 times in a \var{case} statement. +parser_e_case_lower_less_than_upper_bound=03038_E_הטווח הסופי קטן מהטווח ההתחלתי +% The upper bound of a \var{case} label is less than the lower bound and this +% is useless +parser_e_type_const_not_possible=03039_E_הכרזת טיפוס ×§×‘×•×¢×™× ×©×œ מחלקות ×ו ×ž×ž×©×§×™× ×סורה +% You cannot declare a constant of type class or object. +parser_e_no_overloaded_procvars=03040_E_×ž×©×ª× ×™× ×©×œ פונקציות מרובות שימוש ××™× × ×ž×•×¨×©×•×ª +% You are trying to assign an overloaded function to a procedural variable. +% This is not allowed +parser_e_invalid_string_size=03041_E_×ורך מחרוזת חייב להיות ×¢× ×¢×¨×›×™× ×ž1 ל255 +% The length of a shortstring in Pascal is limited to 255 characters. You are +% trying to declare a string with length lower than 1 or greater than 255 +parser_w_use_extended_syntax_for_objects=03042_W_השתמש בתחביר מורחב של NEW וDISPOSE ×œ×¢×•×ª×§×™× ×©×œ ×ובייקט +% If you have a pointer \var{a} to a class type, then the statement +% \var{new(a)} will not initialize the class (i.e. the constructor isn't +% called), although space will be allocated. you should issue the +% \var{new(a,init)} statement. This will allocate space, and call the +% constructor of the object +parser_w_no_new_dispose_on_void_pointers=03043_W_השימוש במצביע ×œ× ×ž×•×’×“×¨ ×¢× NEW ו DISPOSE חסר משמעות +parser_e_no_new_dispose_on_void_pointers=03044_E_בלתי ×פשרי להשתמש במצביע ×œ× ×ž×•×’×“×¨ ×¢× NEW ×ו DISPOSE +% You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer +% because no size is associated to an untyped pointer. +% Accepted for compatibility in \var{tp} and \var{delphi} modes. +parser_e_class_id_expected=03045_E_מצפה למזהה מחלקה +% This happens when the compiler scans a procedure declaration that contains +% a dot, +% i.e., a object or class method, but the type in front of the dot is not +% a known type. +parser_e_no_type_not_allowed_here=03046_E_סוג מזהה ×œ× ×ž×•×¨×©×” ×‘×ž×™×§×•× ×”× ×•×›×—×™ +% You cannot use a type inside an expression. +parser_e_methode_id_expected=03047_E_מצפה למזהה מתודי +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_e_header_dont_match_any_member=03048_E_הגדרת הפונקציה ×œ× ×–×”×” למתודות של המחלקה "$1" +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_d_procedure_start=03049_DL_פרוצדורה/פונקציה $1 +% When using the \var{-vd} switch, the compiler tells you when it starts +% processing a procedure or function implementation. +parser_e_error_in_real=03050_E_קבוע של מספר ממשי ×ינו חוקי +% The compiler expects a floating point expression, and gets something else. +parser_e_fail_only_in_constructor=03051_E_FAIL יכול להיות בשימוש רק בתוך יוצר +% You are using the \var{fail} keyword outside a constructor method. +parser_e_no_paras_for_destructor=03052_E_×”×•×¨×¡×™× ×œ× ×™×›×•×œ×™× ×œ×”×›×™×œ ×¤×¨×ž×˜×¨×™× +% You are declaring a destructor with a parameter list. Destructor methods +% cannot have parameters. +parser_e_only_class_methods_via_class_ref=03053_E_רק מתודות מחלקה יכולות להיות מוגדרות בהתייחסות מחלקה +% This error occurs in a situation like the following: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} is not a class method and hence cannot be called with a class +% reference. +parser_e_only_class_methods=03054_E_רק מתודת מחלקה יכולה לגשת למתודת מחלקה +% This is related to the previous error. You cannot call a method of an object +% from a inside a class method. The following code would produce this error: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% Because free is a normal method of a class it cannot be called from a class +% method. +parser_e_case_mismatch=03055_E_×§×‘×•×¢×™× ×•×¡×•×’ CASE ××™× × ×ž×ª××™×ž×™× +% One of the labels is not of the same type as the case variable. +parser_e_illegal_symbol_exported=03056_E_×œ× × ×™×ª×Ÿ ×œ×™×™×¦× ×ת הסמל מספרייה +% You can only export procedures and functions when you write a library. You +% cannot export variables or constants. +parser_w_should_use_override=03057_W_מתודת ירושה נסתרת ×¢"×™ "$1" +% A method that is declared \var{virtual} in a parent class, should be +% overridden in the descendent class with the \var{override} directive. If you +% don't specify the \var{override} directive, you will hide the parent method; +% you will not override it. +parser_e_nothing_to_be_overridden=03058_E_×ין מתודה במחלקה של ×”×ב ×שר ניתן לשכתב: "$1" +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_no_procedure_to_access_property=03059_E_×œ× × ×™×ª×Ÿ מספר לגשת למ×פיין +% You specified no \var{read} directive for a property. +parser_w_stored_not_implemented=03060_W_מ×פיין שמור ×ינו מבוצע עדיין +% The \var{stored} directive is not yet implemented +parser_e_ill_property_access_sym=03061_E_סימן ×œ× ×—×•×§×™ לגישת המ×פיין +% There is an error in the \var{read} or \var{write} directives for an array +% property. When you declare an array property, you can only access it with +% procedures and functions. The following code would cause such an error. +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_×œ× × ×™×ª×Ÿ לגשת לשדה מוגן ב×ובייקט הנוכחי +% Fields that are declared in a \var{protected} section of an object or class +% declaration cannot be accessed outside the module where the object is +% defined, or outside descendent object methods. +parser_e_cant_access_private_member=03063_E_×œ× × ×™×ª×Ÿ לגשת לשדה פרטי ב×ובקייט הנוכחי +% Fields that are declared in a \var{private} section of an object or class +% declaration cannot be accessed outside the module where the class is +% defined. +parser_e_overridden_methods_not_same_ret=03066_E_מתודה מרובת שימוש חייבת להיות ×–×”×” בסוג המשתנה: "$2" בשימוש ×¢"×™ "$1", ×שר מכילה סוג משתנה ×חר +% If you declare overridden methods in a class definition, they must +% have the same return type. +parser_e_dont_nest_export=03067_E_הגדדרת פונקציות EXPORT ×œ× ×™×›×•×œ×•×ª להיות מקוננות +% You cannot declare a function or procedure within a function or procedure +% that was declared as an export procedure. +parser_e_methods_dont_be_export=03068_E_××™ ×פשר ×œ×™×™×¦× ×ת המתודה +% You cannot declare a procedure that is a method for an object as +% \var{export}ed. +parser_e_call_by_ref_without_typeconv=03069_E_השימוש בפרמטר של משתנה חייב להיות ×–×”×”: מכיל "$1" מצפה ל"$2" +% When calling a function declared with \var{var} parameters, the variables in +% the function call must be of exactly the same type. There is no automatic +% type conversion. +parser_e_no_super_class=03070_E_המחלקה ××™× × ×” מחלקת ×ב של המחלקה הנוכחית +% When calling inherited methods, you are trying to call a method of a non-related +% class. You can only call an inherited method of a parent class. +parser_e_self_not_in_method=03071_E_SELF מורשה רק במתודות +% You are trying to use the \var{self} parameter outside an object's method. +% Only methods get passed the \var{self} parameters. +parser_e_generic_methods_only_in_methods=03072_E_מתודות יכולות ×œ×”×™×§×¨× ×™×©×™×¨×•×ª רק בתוך מתודות ×חרות ×¢× ×¡×•×’ מזהה שלהמחלקה +% A construction like \var{sometype.somemethod} is only allowed in a method. +parser_e_illegal_colon_qualifier=03073_E_שימוש ×œ× ×—×•×§×™ של ':' +% You are using the format \var{:} (colon) 2 times on an expression that +% is not a real expression. +parser_e_illegal_set_expr=03074_E_שגי××” בבדיקת טווח בסדרת ×™×•×¦×¨×™× ×ו שכפול סדרה +% The declaration of a set contains an error. Either one of the elements is +% outside the range of the set type, either two of the elements are in fact +% the same. +parser_e_pointer_to_class_expected=03075_E_מצפה למצביע ×ובייקט +% You specified an illegal type in a \var{new} statement. +% The extended syntax of \var{new} needs an object as a parameter. +parser_e_expr_have_to_be_constructor_call=03076_E_הביטוי חייב להיות קרי×ת יוצר +% When using the extended syntax of \var{new}, you must specify the constructor +% method of the object you are trying to create. The procedure you specified +% is not a constructor. +parser_e_expr_have_to_be_destructor_call=03077_E_הביטוי חייב להיות קרי×ת הורס +% When using the extended syntax of \var{dispose}, you must specify the +% destructor method of the object you are trying to dispose of. +% The procedure you specified is not a destructor. +parser_e_invalid_record_const=03078_E_סדר ×œ× ×—×•×§×™ של ××œ×ž× ×˜×™× ×‘×¨×©×•×ž×” +% When declaring a constant record, you specified the fields in the wrong +% order. +parser_e_false_with_expr=03079_E_סוג ביטוי חייב להיות ביטוי רשומה ×ו מחלקה +% A \var{with} statement needs an argument that is of the type \var{record} +% or \var{class}. You are using \var{with} on an expression that is not of +% this type. +parser_e_void_function=03080_E_פרוצדורה ×œ× ×™×›×•×œ×” להחזיר ערך +% In \fpc, you can specify a return value for a function when using +% the \var{exit} statement. This error occurs when you try to do this with a +% procedure. Procedures cannot return a value. +parser_e_only_methods_allowed=03081_E_×”×™×•×¦×¨×™× ×•×”×”×•×¨×¡×™× ×—×™×™×‘×™× ×œ×”×™×•×ª ×ž×ª×•×“×™×™× +% You're declaring a procedure as destructor or constructor, when the +% procedure isn't a class method. +parser_e_operator_not_overloaded=03082_E_×”×ופריטור ×œ× ×ž×¨×•×‘×” שימוש +% You're trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_no_such_assignment=03083_E_×œ× × ×™×ª×Ÿ להציב ×¢×¨×›×™× ×œ×¡×•×’×™× ×ž×¨×•×‘×™ שימוש +% You can not overload assignment for types +% that the compiler considers as equal. +parser_e_overload_impossible=03084_E_בלתי ×פשרי להשתמש ב×ופרטור מרובה שימוש +% The combination of operator, arguments and return type are +% incompatible. +parser_e_no_reraise_possible=03085_E_×œ× × ×™×ª×Ÿ ×œ×”×¨×™× ×—×¨×™×’×” +% You are trying to raise an exception where it is not allowed. You can only +% raise exceptions in an \var{except} block. +parser_e_no_new_or_dispose_for_classes=03086_E_התחביר המורחב של NEW ×ו DISPOSE ×œ× ×ž×•×¨×©×” למחלקות +% You cannot generate an instance of a class with the extended syntax of +% \var{new}. The constructor must be used for that. For the same reason, you +% cannot call \var{dispose} to de-allocate an instance of a class, the +% destructor must be used for that. +parser_e_procedure_overloading_is_off=03088_E_×”×פשרות לפרוצדורות מרובות שימוש כבוי +% When using the \var{-So} switch, procedure overloading is switched off. +% Turbo Pascal does not support function overloading. +parser_e_overload_operator_failed=03089_E_×œ× × ×™×ª×Ÿ להעמיס על סוג ×”×ופרטור הנוכחי. העמסת ×”××•×¤×¨×˜×•×¨×™× ×”×§×©×•×¨×™× ×œ×¤×¢×•×œ×” (×× ×‘×›×œ×œ) ×”×: $1 +% You are trying to overload an operator which cannot be overloaded. +% The following operators can be overloaded : +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_×ופרטור השוו×תי חייב להחזיר ערך בולי×× ×™ +% When overloading the \var{=} operator, the function must return a boolean +% value. +parser_e_only_virtual_methods_abstract=03091_E_רק שיטה ווירטו×לית יכולה להיות מופשט +% You are declaring a method as abstract, when it is not declared to be +% virtual. +parser_f_unsupported_feature=03092_F_שימוש ב×ופציה ×œ× × ×ª×ž×›×ª! +% You're trying to force the compiler into doing something it cannot do yet. +parser_e_mix_of_classes_and_objects=03093_E_הערבוב של ×¢×¦×ž×™× ×©×•× ×™× (מחלקות, עצ×, ממשק וכו') ×ינו מורשה +% You cannot derive \var{objects}, \var{classes}, \var{cppclasses} and \var{interfaces} interttwined . E.g. +% a class cannot have an object as parent and vice versa. +parser_w_unknown_proc_directive_ignored=03094_W_×ž×ª×¢×œ× ×ž×”× ×—×™×ª השגרה: "$1" +% The procedure directive you specified is unknown. +parser_e_absolute_only_one_var=03095_E_absolute ניתן לשימוש רק ×¢× ×ž×©×ª× ×” ×חת +% You cannot specify more than one variable before the \var{absolute} directive. +% Thus, the following construct will provide this error: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +% \item [ absolute can only be associated a var or const ] +% The address of a \var{absolute} directive can only point to a variable or a +% typed constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_absolute_only_to_var_or_const=03096_E_ניתן להשתמש בabsolute רק ×¢× ×ž×©×ª× ×” ×ו קבוע +% The address of a \var{absolute} directive can only point to a variable or +% constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_initialized_only_one_var=03097_E_ניתן ל×תחל רק משתנה ×חד +% You cannot specify more than one variable with a initial value +% in Delphi mode. +parser_e_abstract_no_definition=03098_E_מתודה מופשטת ××™× ×” זקוקה להגדרה (×¢× ×’×•×£ של פונקציה) +% Abstract methods can only be declared, you cannot implement them. They +% should be overridden by a descendant class. +parser_e_overloaded_must_be_all_global=03099_E_העמסת היתר של הפונקציה ××™× ×” יכולה להיות מקומית (חייבת להיות מיוצ×ת) +% You are defining a overloaded function in the implementation part of a unit, +% but there is no corresponding declaration in the interface part of the unit. +parser_w_virtual_without_constructor=03100_W_שימוש במתודות ווירטו×ליות ×œ×œ× ×™×•×¦×¨ ב "$1" +% If you declare objects or classes that contain virtual methods, you need +% to have a constructor and destructor to initialize them. The compiler +% encountered an object or class with virtual methods that doesn't have +% a constructor/destructor pair. +parser_c_macro_defined=03101_CL_הגדרת מ×קרו: $1 +% When \var{-vc} is used, the compiler tells you when it defines macros. +parser_c_macro_undefined=03102_CL_מ×קרו ×œ× ×ž×•×’×“×¨: $1 +% When \var{-vc} is used, the compiler tells you when it undefines macros. +parser_c_macro_set_to=03103_CL_מ×קרו $1 מוגדר ×› $2 +% When \var{-vc} is used, the compiler tells you what values macros get. +parser_i_compiling=03104_I_מהדר $1 +% When you turn on information messages (\var{-vi}), the compiler tells you +% what units it is recompiling. +parser_u_parsing_interface=03105_UL_מפרש ×ת הממשק של היחידה $1 +% This tells you that the reading of the interface +% of the current unit starts +parser_u_parsing_implementation=03106_UL_מפרש ×ת הביצוע של $1 +% This tells you that the code reading of the implementation +% of the current unit, library or program starts +parser_d_compiling_second_time=03107_DL_מהדר ×ת $1 ×‘×¤×¢× ×”×©× ×™×™×” +% When you request debug messages (\var{-vd}) the compiler tells you what +% units it recompiles for the second time. +parser_e_no_property_found_to_override=03109_E_×œ× × ×ž×¦××” תכונה לעקיפה +% You want to override a property of a parent class, when there is, in fact, +% no such property in the parent class. +parser_e_only_one_default_property=03110_E_רק תכונה ×חת ×¢× ×‘×¨×™×¨×ª מחדל מורשת +% You specified a property as \var{Default}, but the class already has a +% default property, and a class can have only one default property. +parser_e_property_need_paras=03111_E_התונה ×¢× ×‘×¨×™×¨×ª מחדל חייבת להיות תכונה של מערך +% Only array properties of classes can be made \var{default} properties. +parser_e_constructor_cannot_be_not_virtual=03112_E_×™×•×¦×¨×™× ×•×•×™×¨×˜×•××œ×™× × ×ª×ž×›×™× ×¨×§ במחלקה +% You cannot have virtual constructors in objects. You can only have them +% in classes. +parser_e_no_default_property_available=03113_E_ערך ברירת מחדל ×ינו ×§×™×™× ×œ×ª×›×•× ×” +% You are trying to access a default property of a class, but this class (or one of +% its ancestors) doesn't have a default property. +parser_e_cant_have_published=03114_E_המחלקה ××™× ×” יכולה להכיל ×ת חתך published, השתמש במתג {$M+} +% If you want a \var{published} section in a class definition, you must +% use the \var{\{\$M+\}} switch, whch turns on generation of type +% information. +parser_e_forward_declaration_must_be_resolved=03115_E_נדרשת הגדרה ר×שונית של המחלקה "$1" לפני השימוש בה כמחלקה יורשת +% To be able to use an object as an ancestor object, it must be defined +% first. This error occurs in the following situation: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% Where \var{ParentClass} is declared but not defined. +parser_e_no_local_operator=03116_E_השימוש ב×ופריטור מקומי ×ינו נתמך +% You cannot overload locally, i.e. inside procedures or function +% definitions. +parser_e_proc_dir_not_allowed_in_interface=03117_E_×ž×§×“× ×©×™×’×¨×” "$1" ×ינו מורשה בשימוש בתוך הממשק +% This procedure directive is not allowed in the \var{interface} section of +% a unit. You can only use it in the \var{implementation} section. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_×ž×§×“× ×©×™×’×¨×” "$1" ×ינו מורשה בחלק הביצועי +% This procedure directive is not defined in the \var{implementation} section of +% a unit. You can only use it in the \var{interface} section. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_×ž×§×“× ×©×™×’×¨×” "$1" ×ינו מורשה כחלק מהגדרת השיגרה +% This procedure directive cannot be part of a procedural or function +% type declaration. +parser_e_function_already_declared_public_forward=03120_E_הגדרת הפונקציה "$1" כבר בוצעה +% You will get this error if a function is defined as \var{forward} twice. +% Or it is once in the \var{interface} section, and once as a \var{forward} +% declaration in the \var{implmentation} section. +parser_e_not_external_and_export=03121_E_×œ× × ×™×ª×Ÿ להשתמש ×’× ×‘ EXPORT ×•×’× EXTERNAL +% These two procedure directives are mutually exclusive +parser_w_not_supported_for_inline=03123_W_"$1" ×ינו נתמך עדיין בתוך פונקצית/שגרת inline +% Inline procedures don't support this declaration. +parser_w_inlining_disabled=03124_W_השימוש הישיר מבוטל +% Inlining of procedures is disabled. +parser_i_writing_browser_log=03125_I_כותב יומן דפדפן $1 +% When information messages are on, the compiler warns you when it +% writes the browser log (generated with the \var{\{\$Y+ \}} switch). +parser_h_maybe_deref_caret_missing=03126_H_ייתכן ×›×™ חסר תוכן למצביע +% The compiler thinks that a pointer may need a dereference. +parser_f_assembler_reader_not_supported=03127_F_×ין תמיכה במ×סף הנבחר +% The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not +% supported. The compiler can be compiled with or without support for a +% particular assembler reader. +parser_e_proc_dir_conflict=03128_E_×ž×§×“× ×”×©×™×’×¨×” "$1" מתנגש ×¢× ×ž×§×“×ž×™× ××—×¨×™× +% You specified a procedure directive that conflicts with other directives. +% for instance \var{cdecl} and \var{pascal} are mutually exclusive. +parser_e_call_convention_dont_match_forward=03129_E_השימוש בהגדרה הנוכחית ×ינו ×–×”×” להגדרה הר×שונית +% This error happens when you declare a function or procedure with +% e.g. \var{cdecl;} but omit this directive in the implementation, or vice +% versa. The calling convention is part of the function declaration, and +% must be repeated in the function definition. +parser_e_property_cant_have_a_default_value=03131_E_תכונות ×ינן יכולות להכיל ערך ברירת מחדל +% Set properties or indexed properties cannot have a default value. +parser_e_property_default_value_must_const=03132_E_ערך ברירת המחדלק שת התכונה חייב להיות קבוע +% The value of a \var{default} declared property must be known at compile +% time. The value you specified is only known at run time. This happens +% .e.g. if you specify a variable name as a default value. +parser_e_cant_publish_that=03133_E_הסמל ×ינו יכול להיות בשימוש בתוך מחלקה ×œ×œ× ×”×’×“×¨×ª×• בתוך המחלקה +% Only class type variables can be in a \var{published} section of a class +% if they are not declared as a property. +parser_e_cant_publish_that_property=03134_E_סוג ×–×” של תכונה ×ינו יכול להיות בשימוש +% Properties in a \var{published} section cannot be array properties. +% they must be moved to public sections. Properties in a \var{published} +% section must be an ordinal type, a real type, strings or sets. +parser_e_empty_import_name=03136_E_נדרש ×©× ×™×™×‘×•× +% Some targets need a name for the imported procedure or a \var{cdecl} specifier +parser_e_division_by_zero=03138_E_חלוק ב×פס +% There is a division by zero encounted +parser_e_invalid_float_operation=03139_E_פעולת עשרונית ×œ× ×—×•×§×™×ª +% An operation on two real type values produced an overflow or a division +% by zero. +parser_e_array_lower_less_than_upper_bound=03140_E_הגבול העליון נמוך יותר מהגבול התחתון +% The upper bound of a an array declaration is less than the lower bound and this +% is not possible +parser_w_string_too_long=03141_W_×ורך המחרוזת של "$1" ×רוך יותר מ "$1" +% The size of the constant string is larger than the size you specified in +% string type definition +parser_e_string_larger_array=03142_E_×ורך המחרוזת ×רוך יותר מ×ורך מערך ×”×ª×•×•×™× +% The size of the constant string is larger than the size you specified in +% the array[x..y] of char definition +parser_e_ill_msg_expr=03143_E_התוכן של הביטוי ל×חר ההודעה ×ינו חוקי +% \fpc supports only integer or string values as message constants +parser_e_ill_msg_param=03144_E_טיפול בהודעות חייב להיות במבנה קבוע של ×¤×¨×ž×˜×¨×™× +% A method declared with the \var{message}-directive as message handler +% can take only one parameter which must be declared as call by reference +% Parameters are declared as call by reference using the \var{var}-directive +parser_e_duplicate_message_label=03145_E_תווית הודעה כפולה: "$1" +% A label for a message is used twice in one object/class +parser_e_self_in_non_message_handler=03146_E_Self חייב להיות פרמטר במתודה של מטפל ההודעות +% The self parameter can only be passed explicitly to a method which +% is declared as message handler. +parser_e_threadvars_only_sg=03147_E_Threadvars ×—×™×™×‘×™× ×œ×”×™×•×ª ×¡×˜×˜×™×™× ×ו ×’×œ×•×‘×œ×™×™× +% Threadvars must be static or global, you can't declare a thread +% local to a procedure. Local variables are always local to a thread, +% because every thread has its own stack and local variables +% are stored on the stack +parser_f_direct_assembler_not_allowed=03148_F_השימוש במ×סף הנוכחי ×ינו תומך בוסג התוצ××” הבינ×רית +% You can't use direct assembler when using a binary writer, choose an +% other outputformat or use another assembler reader +parser_w_no_objpas_use_mode=03149_W_×סור ×œ×§×¨×•× ×œ×™×—×™×“×ª OBJPAS ישירות, יש להשתמש ב \{\$mode objfpc\} ×ו ב \{\$mode delphi\} ×‘×ž×§×•× +% You are trying to load the ObjPas unit manually from a uses clause. This is +% not a good idea. Use the \var{\{\$mode objfpc\}} or +% \var{\{\$mode delphi\}} +% directives which load the unit automatically +parser_e_no_object_override=03150_E_OVERRIDE ×ינו יכול להיות בשימוש ב××•×‘×™×™×§×˜×™× +% Override is not supported for objects, use \var{virtual} instead to override +% a method of a parent object +parser_e_cant_use_inittable_here=03151_E_טיפוסי × ×ª×•× ×™× ×שר ×“×•×¨×©×™× ×תחול ×ו ×¡×™×›×•× ××™× × ×™×›×•×œ×™× ×œ×”×™×•×ª ברשומות variant +% Some data type (e.g. \var{ansistring}) needs initialization/finalization +% code which is implicitly generated by the compiler. Such data types +% can't be used in the variant part of a record. +parser_e_resourcestring_only_sg=03152_E_×œ× × ×™×ª×Ÿ להגדיר Resourcestring בתור הגדרה מקומית, רק הגדרה גלובלית ×ו סטטית +% Resourcestring can not be declared local, only global or using the static +% directive. +parser_e_exit_with_argument_not__possible=03153_E_השימוש בשיגרה exit ×ינו יכול להתבצע ×‘×ž×™×§×•× ×”× ×•×›×—×™ +% an exit statement with an argument for the return value can't be used here, this +% can happen e.g. in \var{try..except} or \var{try..finally} blocks +parser_e_stored_property_must_be_boolean=03154_E_טיפוס ×”× ×ª×•× ×™× ×‘×¡×™×ž×•×œ ×”×חסון חייב להיות בולי×× ×™ +% If you specify a storage symbol in a property declaration, it must be of +% the type boolean +parser_e_ill_property_storage_sym=03155_E_הסימול ×ינו יכול להשמש כסימול ל×חסון +% You can't use this type of symbol as storage specifier in property +% declaration. You can use only methods with the result type boolean, +% boolean class fields or boolean constants +parser_e_only_publishable_classes_can_be_published=03156_E_רק מחלקה המהודרת במצב $M+ יכולה להיות ×יזור ×” published +% In the published section of a class can be only class as fields used which +% are compiled in \var{\{\$M+\}} or which are derived from such a class. Normally +% such a class should be derived from TPersitent +parser_e_proc_directive_expected=03157_E_מצפה להנחיית שיגרה +% This error is triggered when you have a \var{\{\$Calling\}} directive without +% a calling convention specified. +% It also happens when declaring a procedure in a const block and you +% used a ; after a procedure declaration which must be followed by a +% procedure directive. +% Correct declarations are: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_הערך ×”×ינדקס של התכונה חייב להיות טיפוס מסודר +% The value you use to index a property must be of an ordinal type, for +% example an integer or enumerated type. +parser_e_procname_to_short_for_export=03159_E_×©× ×”×©×’×¨×” קצר מידי ×œ×™×™×¦×•× +% The length of the procedure/function name must be at least 2 characters +% long. This is because of a bug in dlltool which doesn't parse the .def +% file correct with a name of length 1. +parser_e_dlltool_unit_var_problem=03160_E_×œ× × ×™×ª×Ÿ לייצר חלק DEFFILE ×œ×ž×©×ª× ×™× ×’×œ×•×‘×œ×™×™× ×‘×™×—×™×“×” +parser_e_dlltool_unit_var_problem2=03161_E_הדר ×œ×œ× ×©×™×ž×•×© ב -WD +% You need to compile this file without the -WD switch on the +% commandline +parser_f_need_objfpc_or_delphi_mode=03162_F_יש להשתמש במצב ObjFpc (-S2) ×ו במצב Delphi (-Sd) להדר ×ת המודול +% You need to use \{\$mode objfpc\} or \{\$mode delphi\} to compile this file. +% Or use the equivalent commandline switches -S2 or -Sd. +parser_e_no_export_with_index_for_target=03163_E_××™ ×פשר ×œ×™×™×¦× ×¢× ×ינדקס תחת $1 +% Exporting of functions or procedures with a specified index is not +% supported on this target. +parser_e_no_export_of_variables_for_target=03164_E_×™×™×¦×•× ×©×œ משתמש ×ינו נתמך ב$1 +% Exporting of variables is not supported on this target. +parser_e_improper_guid_syntax=03165_E_תחביר GUID ×ינו חוקי +% The GUID indication does not have the proper syntax. It should be of the form +% \begin{verbatim} +% {XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX} +% \end{verbatim} +% Where each \var{X} represents a hexadecimal digit. +parser_w_interface_mapping_notfound=03168_W_השגרה "$1" נמצ××” ×ך ×œ×œ× ×”×¤×¨×ž×˜×¨×™× ×”×ž×‘×•×§×©×™× ×©×œ $2.$3 +% The compiler cannot find a suitable procedure which implements the given method of an interface. +% A procedure with the same name is found, but the arguments do not match. +parser_e_interface_id_expected=03169_E_מצפה למזהה ממשק +% This happens when the compiler scans a \var{class} declaration that contains +% \var{interface} function name mapping code like this: +% \begin{verbatim} +% type +% TMyObject = class(TObject, IDispatch) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% and the \var{interface} before the dot not listed in the inheritance list. +parser_e_type_cant_be_used_in_array_index=03170_E_הסוג "$1" ×ינו יכול להיות בשימוש בתור סוג ×ינדקס למערך +% Types like \var{qword} or \var{int64} aren't allowed as array index type +parser_e_no_con_des_in_interfaces=03171_E_יוצר והורס ××™× × ×ž×•×¨×©×™× ×‘×ž×ž×©×§×™× +% Constructor and destructor declarations aren't allowed in interface +% In the most cases the method \var{QueryInterface} of \var{IUnknown} can +% be used to create a new interface. +parser_e_no_access_specifier_in_interfaces=03172_E_מזהה כניסה ×ינו יכול להיות בשימוש ×¢× ×ž×ž×©×§×™× +% The access specifiers \var{public}, \var{private}, \var{protected} and +% \var{pusblished} can't be used in interfaces because all methods +% of an interfaces must be public. +parser_e_no_vars_in_interfaces=03173_E_ממשק ×ינו יכול להכיל שדות +% Declarations of fields aren't allowed in interfaces. An interface +% can contain only methods +parser_e_no_local_proc_external=03174_E_×œ× × ×™×ª×Ÿ להגדיר שגרה מקומית כחיצונית +% Declaring local procedures as external is not possible. Local procedures +% get hidden parameters that will make the chance of errors very high +parser_w_skipped_fields_before=03175_W_חלק מהשדות הב××™× ×œ×¤× ×™ "$1" ×œ× ×ותחלו +% In Delphi mode, not all fields of a typed constant record have to be +% initialized, but the compiler warns you when it detects such situations. +parser_e_skipped_fields_before=03176_E_חלק מהשדות הב××™× ×œ×¤× ×™ "$1" ×œ× ×ותחלו +% In all syntax modes but Delphi mode, you can't leave some fields uninitialized +% in the middle of a typed constant record +parser_w_skipped_fields_after=03177_W_חלק מהשדות הב××™× ×חרי "$1" ×œ× ×ותחלו +% You can leave some fields at the end of a type constant record uninitialized +% (the compiler will initialize them to zero automatically). This may be the cause +% of subtle problems. +parser_e_varargs_need_cdecl_and_external=03178_E_השימוש בVarArgs (×ו '...' בMacPas) חייב להיות בשימוש ×¢× CDecl/CPPDecl/MWPascal ו External +% The varargs directive (or the ``...'' varargs parameter in MacPas mode) can only be used with procedures or functions +% that are declared with \var{external} and one of \var{cdecl}, \var{cppdecl} and \var{mwpascal}. This functionality +% is only supported to provide a compatible interface to C functions like printf. +parser_e_self_call_by_value=03179_E_Self חייב להיות פרמטר רגיל (call-by-value) +% You can't declare self as a const or var parameter, it must always be +% a call-by-value parameter +parser_e_interface_has_no_guid=03180_E_הממשק "$1" ×ינו מכיל מזהה GUID +% When you want to assign an interface to a constant, then the interface +% must have a GUID value set. +parser_e_illegal_field_or_method=03181_E_המזהה של שדה ×ו מתודה של מחלקה "$1" ××™× × ×™×“×•×¢×™× +% Properties must refer to a field or method in the same class. +parser_w_proc_overriding_calling=03182_W_עולה על מוסכמות הפעלה "$1" ×¢× "$2" +% There are two directives in the procedure declaration that specify a calling +% convention. Only the last directive will be used +parser_e_no_procvarobj_const=03183_E_ניתן ל×תחל טיפוס קבוע של "procedure of object" רק ×¢× NIL +% You can't assign the address of a method to a typed constant which has a +% 'procedure of object' type, because such a constant requires two addresses: +% that of the method (which is known at compile time) and that of the object or +% class instance it operates on (which can not be known at compile time). +parser_e_default_value_only_one_para=03184_E_ערך ברירת מחדל יכול להיות בשימוש רק ×¢× ×¤×¨×ž×˜×¨ ×חד +% It is not possible to specify a default value for several parameters at once. +% The following is invalid: +% \begin{verbatim} +% Procedure MyProcedure (A,B : Integer = 0); +% \end{verbatim} +% Instead, this should be declared as +% \begin{verbatim} +% Procedure MyProcedure (A : Integer = 0; B : Integer = 0); +% \end{verbatim} +parser_e_default_value_expected_for_para=03185_E_פרמטר ברירת מחדל דרוש עבור "$1" +% The specified parameter requires a default value. +parser_w_unsupported_feature=03186_W_שימוש במ×פיין ×œ× × ×ª×ž×š ! +% You're trying to force the compiler into doing something it cannot do yet. +parser_h_c_arrays_are_references=03187_H_×ž×¢×¨×›×™× ×©×œ C ×ž×•×¢×‘×¨×™× ×›×”×¤× ×™×” +% Any array passed to a C functions is passed +% by a pointer (i.e. by reference). +parser_e_C_array_of_const_must_be_last=03188_E_מערך C של קבוע חייב להיות ×”×רגומנט ×”×חרון +% You can not add any other argument after an \var{array of const} for +% \var{cdecl} functions, as the size pushed on stack for this argument is +% not known. +parser_h_type_redef=03189_H_הגדרה מחודשת של הטיפוס "$1" +% This is an indicator that a previously declared type is +% being redefined as something else. This may, or may not +% be, a cause for errors. +parser_w_cdecl_has_no_high=03190_W_×ין לפונקציות cdecl פרמטר גבוהה +% Functions declared with cdecl modifier do not pass an extra implicit parameter. +parser_w_cdecl_no_openstring=03191_W_פונקציות cdecel ×ינן תומכות ב open string +% Openstring is not supported for cdecl'ared functions. +parser_e_initialized_not_for_threadvar=03192_E_×ין ×פשרות ל×תחל משתנה המוגדר ×›threadvar +% Variables declared as threadvar can not be initialized with a default value. +% The variables will always be filled with zero at the start of a new thread. +parser_e_msg_only_for_classes=03193_E_ניתן להשתמש בהנחיית message רק בתוך מחלקה +% The message directive is only supported for Class types. +parser_e_procedure_or_function_expected=03194_E_מצפה לשיגרה ×ו פונקציה +% A class method can only be specified for procedures and functions. +parser_e_illegal_calling_convention=03195_W_×ž×ª×¢×œ× ×ž×ž×•×¡×›×ž×ª ההפעלה: "$1" +% Some calling conventions are supported only by certain CPUs. I.e. most non-i386 ports support +% only the standard ABI calling convention of the CPU. +parser_e_no_object_reintroduce=03196_E_×œ× × ×™×ª×Ÿ להשתמש בREINTRODUCE בתוך ×ובייקט +% \var{reintroduce} is not supported for objects. +parser_e_paraloc_only_one_para=03197_E_כל ×רגומנט חייב להכיל ×ž×™×§×•× ×¢×¦×ž××™. +% If locations for arguments are specified explicitly as it is required by +% some syscall conventions, each argument must have it's only location, things +% like \var{procedure p(i,j : longint 'r1');} aren't allowed +parser_e_paraloc_all_paras=03198_E_כל ×רגומנט חייב להכיל ×ž×™×§×•× ×ž×•×’×“×¨ +% If one argument has an explicit argument location, all arguments of a procedure +% must have one. +parser_e_illegal_explicit_paraloc=03199_E_×ž×™×§×•× ×רגומנט ×œ× ×™×“×•×¢ +% The location specified for an argument isn't recognized by the compiler +parser_e_32bitint_or_pointer_variable_expected=03200_E_מצפה לסוג משתנה של מספר ×©×œ× 32-Bit ×ו מצביע +% The libbase for MorphOS/AmigaOS can be give only as \var{longint}, \var{dword} or any pointer variable. +parser_e_goto_outside_proc=03201_E_×œ× × ×™×ª×Ÿ להשמש בgoto בין שני שיגרות +% It isn't allowed to use the \var{goto} statements referencing labels outside the +% current procedure. The following example shows the problem: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1; +% +% procedure p2; +% begin +% goto l1; // This goto ISN'T allowed +% end; +% +% begin +% p2 +% l1: +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_השיגרה מסובכת מידי ודורשת שימוש של ××•×’×¨×™× ×¨×‘×™× ×ž×™×“×™ +% Your procedure body is too long for the compiler. You should split the +% procedure into multiple smaller procedures. +parser_e_illegal_expression=03203_E_ביטוי ×œ× ×—×•×§×™ +% This can occur under many circumstances. Mostly when trying to evaluate +% constant expressions. +parser_e_invalid_integer=03204_E_הביטוי של המספר ×”×©×œ× ×ינו חוקי +% You made an expression which isn't an integer, and the compiler expects the +% result to be an integer. +parser_e_invalid_qualifier=03205_E_שימוש ×œ× ×—×•×§×™ במבחין +% One of the following is happening : +% \begin{itemize} +% \item You're trying to access a field of a variable that is not a record. +% \item You're indexing a variable that is not an array. +% \item You're dereferencing a variable that is not a pointer. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_טווח ההגבלה הגבוהה קטן מטווח ההגבלה הנמוכה +% You are declaring a subrange, and the lower limit is higher than the high +% limit of the range. +parser_e_macpas_exit_wrong_param=03207_E_הפרמטר של Exit חייב להיות ×©× ×”×©×™×’×¨×” תחתיו ×”×•× × ×ž×¦× +% Non local exit is not allowed. This error occurs only in mode MacPas. +parser_e_illegal_assignment_to_count_var=03208_E_הצבה ×œ× ×—×•×§×™×ª של המשתנה בלול×ת ×” for "$1" +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. You can also not assign values to +% loop variables inside the loop (except in Delphi and TP modes). Use a while or +% repeat loop instead if you need to do something like that, since those +% constructs were built for that. +parser_e_no_local_var_external=03209_E_×œ× × ×™×ª×Ÿ להגדיר ×ž×©×ª× ×™× ×ž×§×•×ž×™×™× ×›×—×™×¦×•× ×™×™× +% Declaring local variables as external is not allowed. Only global variables can reference +% to external variables. +parser_e_proc_already_external=03210_E_השיגרה כבר מוגדרת כחיצונית +% The procedure is already declared with the EXTERNAL directive in an interface or +% forward declaration. +parser_w_implicit_uses_of_variants_unit=03211_W_שימוש משתמע ביחידת Variants +% The Variant type is used in the unit without any used unit using the Variants unit. The +% compiler has implicitly added the Variants unit to the uses list. To remove this warning +% the Variants unit needs to be added to the uses statement. +parser_e_no_static_method_in_interfaces=03212_E_השימוש במחלקה ומתודות ×¡×˜×˜×™×™× ××™× × ×™×›×•×œ×™×•×ª להיות בשימוש בממשק +% The specifier \var{class} and directive \var{static} can't be used in interfaces +% because all methods of an interfaces must be public. +parser_e_arithmetic_operation_overflow=03213_E_גלישה בפעולה מתמטית +% An operation on two integers values produced an overflow +parser_e_protected_or_private_expected=03214_E_מצפה ל×יזור Protected ×ו Private +% \var{strict} can be only used together with \var{protected} or \var{private}. +parser_e_illegal_slice=03215_E_SLICE ××™×  יכול להיות בשימוש מחוץ לרשימת ×¤×¨×ž×˜×¨×™× +% \var{slice} can be used only for arguments accepting an open array parameter +parser_e_dispinterface_cant_have_parent=03216_E_מחלקת DISPINTERFACE ××™× ×” יכולה להכיל הורה +% A DISPINMTERFACE is a special type of interface which can't have a parent class +parser_e_dispinterface_needs_a_guid=03217_E_DISPINTERFACE חייב GUID +% A DISPINMTERFACE always needs an interface identification +parser_w_overridden_methods_not_same_ret=03218_W_המתודות החדשות חייבות להחזיר ×ת ×ותו טיפוס נתוני×. הקוד הנוכחי יכול ×œ×’×¨×•× ×œ×§×¨×™×¡×” בעקבות ב××’ של המפרש של דלפי (“$2†עולה על “$1†×שר מכיל טיפוס × ×ª×•× ×™× ×חר בהחזרה) +% If you declare overridden methods in a class definition, they must +% have the same return type. Some versions of Delphi allow you to change the +% return type of interface methods, and even to change procedures into +% functions, but the resulting code may crash depending on the types used +% and the way the methods are called. +parser_e_dispid_must_be_ord_const=03219_E_מזהה Dispatch חייב להיות קבוע בעל ערך סידורי +parser_e_array_range_out_of_bounds=03220_E_הטווח של המערך גבוהה מידי +% Regardless of the size taken up by its elements, an array cannot have more +% than high(ptrint) elements. Additionally, the range type must be a subrange +% of ptrint. +parser_e_packed_element_no_var_addr=03221_E_×œ× × ×™×ª×Ÿ ×œ×ž×¦×•× ×ת הכתובת של ביט המערך ×רוז, ××œ×ž× ×˜×™× ×ו שדות של המערך +% If you declare an array or record as \var{packed} in Mac Pascal mode (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will +% be packed at the bit level. This means it becomes impossible to take addresses +% of individual array elements or record fields. The only exception to this rule is in case of packed arrays elements +% whose packed size is a multple of 8 bits. +parser_e_packed_dynamic_open_array=03222_E_×œ× × ×™×ª×Ÿ ל×רוז מערך דינ×מי +% Only regular (and possibly in the future also open) arrays can be packed +parser_e_packed_element_no_loop=03223_E_××œ×ž× ×˜×™× ×•×©×“×•×ª של מערכי ביט ××¨×•×–×™× ××™× × ×™×›×•×œ×™× ×œ×©×ž×© ×›×ž×©×ª× ×™× ×œ×œ×•×œ×ות +% If you declare an array or record as \var{packed} in Mac Pascal mode (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will +% be packed at the bit level. For performance reasons, they cannot be +% used as loop variables. +parser_e_type_and_var_only_in_generics=03224_E_ניתן להשתמש ב VAR ו TYPE רק ×¢× generics +% The usage of VAR and TYPE to declare new types inside an object is allowed only inside +% generics. +parser_e_cant_create_generics_of_this_type=03225_E_הטיפוס ×ינו יכול להיות generic +% Only Classes, Objects, Interfaces and Records are allowed to be used as generic +parser_w_no_lineinfo_use_switch=03226_W_×ין לטעון ×ת הספרייה LINEINFO בצורה ידנית. על מנת להשתמש בספרייה יש להשתמש במתג -gl ×‘×ž×§×•× +% Do not use the LINEINFO unit directly, Use the \var{-gl} switch which automatically adds the +% unit for reading the selected type of debugging information instead. +parser_e_no_funcret_specified=03227_E_×œ× ×¦×•×™×™×Ÿ טיפוס החזרה עבור הפונקציה "$1" +% The first time you declare a function you have to declare it completely, +% including all parameters and the result type. +parser_e_special_onlygenerics=03228_E_השימוש בSpecialization מורשה רק ×›×שר ×ž×©×ª×ž×©×™× ×‘×˜×™×¤×•×¡×™ generic +% Types not being generics can't be specialized +parser_e_no_generics_as_params=03229_E_×œ× × ×™×ª×Ÿ להשתמש בgenerics בתור ×¤×¨×ž×˜×¨×™× ×›×שר יש שימוש ב spezializing generics +% When specializing a generic, only non-generic types can be used as parameters. +parser_e_type_object_constants=03230_E_השימוש ×‘×§×‘×•×¢×™× ×©×œ ××•×‘×™×™×§×˜×™× ×”×ž×›×™×œ×™× VMT ×ינו מורשה +% If an object requires a VMT either because it contains a constructor or virtual methods, +% it's not allowed to create constants of it. In TP and Delphi mode this is allowed +% for compatibility reasons. +parser_e_label_outside_proc=03231_E_שימוש בכתובת של תוויות המוכרזות מחוץ ×œ×ž×ª×—× ×”× ×•×›×—×™ ×ינו מורשה +% It isn't allowed to take the addresss of labels outside the +% current procedure. +parser_e_initialized_not_for_external=03233_E_×œ× × ×™×ª×Ÿ ל×תחל ערך ברירת מחדל ×œ×ž×©×ª× ×™× ×”×ž×•×’×“×¨×™× ×›external +% Variables declared as external can not be initialized with a default value. +parser_e_illegal_function_result=03234_E_טיפוס החזרה של הפונקציה ×ינו חוקי +% Some types like file types can not be used as function result +parser_e_no_common_type=03235_E_×ין טיפוס משותף ל "$1" ו "$2" +% To perform an operation beween integers, the compiler converts both operands +% to their common type, which appears to be an invalid type. To determine the +% common type of the operands, the compiler takes the minimum of the minimal values +% of both types, and the maximum of the maximal values of both types. The common +% type is then minimum..maximum. +parser_e_no_generics_as_types=03236_E_Generics ×œ×œ× specialization ×ינו יכול להיות בשימוש בתור טיפוס למשתנה +% Generics must be always specialized before being used as variable type +parser_w_register_list_ignored=03237_W_×ž×ª×¢×œ× ×ž×¨×©×™×ž×ª ×”××•×’×¨×™× ×¢×‘×•×¨ שגרות assemblter טהורות +% When using pure assembler routines, the list with modified registers is ignored. + +% \end{description} +# +# Type Checking +# +# 04049 is the last used one +# +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +type_e_mismatch=04000_E_טיפוס × ×ª×•× ×™× ×œ× ×—×•×¤×£ +% This can happen in many cases: +% \begin{itemize} +% \item The variable you're assigning to is of a different type than the +% expression in the assignment. +% \item You are calling a function or procedure with parameters that are +% incompatible with the parameters in the function or procedure definition. +% \end{itemize} +type_e_incompatible_types=04001_E_טיפוס × ×ª×•× ×™× ×œ× ×ª×•××: נעשה שימוש ב "$1" מצפה ל"$2" +% There is no conversion possible between the two types +% Another possiblity is that they are declared in different +% declarations: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { This statement gives also this error, it +% is due the strict type checking of pascal } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_××™ הת×מה בין טיפוסי ×”× ×ª×•× ×™× "$1" ו "$2" +% The types are not equal +type_e_type_id_expected=04003_E_מצפה לטיפוס × ×ª×•× ×™× +% The identifier is not a type, or you forgot to supply a type identifier. +type_e_variable_id_expected=04004_E_מצפה למזהה של משתנה +% This happens when you pass a constant to a routine (such as \var{Inc} var or \var{Dec}) +% when it expects a variable. You can only pass variables as arguments to these functions. +type_e_integer_expr_expected=04005_E_מצפה למספר של×, ×ך התקבל "$1" +% The compiler expects an expression of type integer, but gets a different +% type. +type_e_boolean_expr_expected=04006_E_מצפה לביטוי בולי×× ×™, ×ך התקבל "$1" +% The expression must be a boolean type, it should be return true or +% false. +type_e_ordinal_expr_expected=04007_E_מצפה לטיפוס סודר +% The expression must be of ordinal type, i.e., maximum a \var{Longint}. +% This happens, for instance, when you specify a second argument +% to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value. +type_e_pointer_type_expected=04008_E_מצפה למצביע, ×ך התקבל "$1" +% The variable or expression isn't of the type \var{pointer}. This +% happens when you pass a variable that isn't a pointer to \var{New} +% or \var{Dispose}. +type_e_class_type_expected=04009_E_מצפה למחלקה, ×ך התקבל "$1" +% The variable of expression isn't of the type \var{class}. This happens +% typically when +% \begin{enumerate} +% \item The parent class in a class declaration isn't a class. +% \item An exception handler (\var{On}) contains a type identifier that +% isn't a class. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_×œ× × ×™×ª×Ÿ לנתח ×ת הביטוי הקבוע +% This error can occur when the bounds of an array you declared does +% not evaluate to ordinal constants +type_e_set_element_are_not_comp=04012_E_×”××œ×ž× ×˜×™× ×©×œ הקבוצה ××™× × ×ª×•××ž×™× +% You are trying to make an operation on two sets, when the set element types +% are not the same. The base type of a set must be the same when taking the +% union +type_e_set_operation_unknown=04013_E_הפעולה ××™× ×” בשימוש ×¢× ×§×‘×•×¦×•×ª +% several binary operations are not defined for sets +% like div mod ** (also >= <= for now) +type_w_convert_real_2_comp=04014_W_המרה ×וטומטית של טיפוס עשרוני ל COMP ×שר ×”×•× ×ž×¡×¤×¨ ×©×œ× +% An implicit type conversion from a real type to a \var{comp} is +% encountered. Since \var{comp} is a 64 bit integer type, this may indicate +% an error. +type_h_use_div_for_int=04015_H_השתמש בDIV ×‘×ž×§×•× ×¢×œ מנת לקבל תוצ××” של מספר ×©×œ× +% When hints are on, then an integer division with the '/' operator will +% procuce this message, because the result will then be of type real +type_e_strict_var_string_violation=04016_E_טיפוס המחרוזת ××™× × ×ª×•×× ×‘×’×œ×œ השימוש במתג $V+ +% When compiling in \var{\{\$V+\}} mode, the string you pass as a parameter +% should be of the exact same type as the declared parameter of the procedure. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_×œ× × ×™×ª×Ÿ להציב ×¢×¨×›×™× ×œ×ž× ×™×•×ª תוך שימוש בsucc ×ו pred +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use the \var{Succ} or \var{Pred} functions on them. +type_e_cant_read_write_type=04018_E_×œ× × ×™×ª×Ÿ ×œ×§×¨×•× ×ו לכתוב ×ž×©×ª× ×™× ×ž×”×¡×•×’ הנוכחי +% You are trying to \var{read} or \var{write} a variable from or to a +% file of type text, which doesn't support that. Only integer types, +% reals, pchars and strings can be read from/written to a text file. +% Booleans can only be written to text files. +type_e_no_readln_writeln_for_typed_file=04019_E_×œ× × ×™×ª×Ÿ להשתמש בreadln וwriteln על טיפוס × ×ª×•× ×™× ×ž×¡×•×’ file +% \var{readln} and \var{writeln} are only allowed for text files. +type_e_no_read_write_for_untyped_file=04020_E_×œ× × ×™×ª×Ÿ ×œ×§×¨×•× ×ו לכתוב טיפוס ×œ× ×ž×•×’×¨ של ×§×‘×¦×™× +% \var{read} and \var{write} are only allowed for text or typed files. +type_e_typeconflict_in_set=04021_E_התנגשות של טיפוס × ×ª×•× ×™× ×‘×ª×•×š ××™×‘×¨×™× ×©×œ קבוצה +% There is at least one set element which is of the wrong type, i.e. not of +% the set type. +type_w_maybe_wrong_hi_lo=04022_W_lo/hi(dword/qword) מחזיר ×ת הערך העליון/תחתון של word/dword +% \fpc supports an overloaded version of \var{lo/hi} for \var{longint/dword/int64/qword} +% which returns the lower/upper word/dword of the argument. TP always uses +% a 16 bit \var{lo/hi} which returns always bits 0..7 for \var{lo} and the +% bits 8..15 for \var{hi}. If you want the TP behavior you have +% to type cast the argument to \var{word/integer} +type_e_integer_or_real_expr_expected=04023_E_מצפה לביטוי של מספר ×©×œ× ×ו מספר ממשי +% The first argument to \var{str} must a real or integer type. +type_e_wrong_type_in_array_constructor=04024_E_שימוש שגוי בטיפוס "$1" בתוך יוצר המערך +% You are trying to use a type in an array constructor which is not +% allowed. +type_e_wrong_parameter_type=04025_E_טיפוס ×œ× ×ž×ª××™× ×œ×רגומנט מספר $1: התקבל "$2", מצפה ל"$3" +% You are trying to pass an invalid type for the specified parameter. +type_e_no_method_and_procedure_not_compatible=04026_E_המשתנה של המתודה והשגרה ××™× × ×ª×•××ž×™× +% You can't assign a method to a procedure variable or a procedure to a +% method pointer. +type_e_wrong_math_argument=04027_E_ביטוי קבוע ×œ× ×—×•×§×™ הוזן לפונקציה מתמטית פנימית +% The constant argument passed to a ln or sqrt function is out of +% the definition range of these functions. +type_e_no_addr_of_constant=04028_E_×œ× × ×™×ª×Ÿ לקבל ×ת הכתובת של הקבוע +% It is not possible to get the address of a constant expression, because they +% aren't stored in memory. You can try making it a typed constant. This error +% can also be displayed if you try to pass a property to a var parameter. +type_e_argument_cant_be_assigned=04029_E_×œ× × ×™×ª×Ÿ ×œ×”×©×™× ×ת ×”×רגומנט +% Only expressions which can be on the left side of an +% assignment can be passed as call by reference argument +% Remark: Properties can be only +% used on the left side of an assignment, but they cannot be used as arguments +type_e_cannot_local_proc_to_procvar=04030_E_×œ× × ×™×ª×Ÿ לשייך פונקציה/שיגרה מקומית למשתנה מסוג שיגרה +% It's not allowed to assign a local procedure/function to a +% procedure variable, because the calling of local procedure/function is +% different. You can only assign local procedure/function to a void pointer. +type_e_no_assign_to_addr=04031_E_×œ× × ×™×ª×Ÿ לשייך ערך לכתובת +% It is not allowed to assign a value to an address of a variable,constant, +% procedure or function. You can try compiling with -So if the identifier +% is a procedure variable. +type_e_no_assign_to_const=04032_E_×œ× × ×™×ª×Ÿ לשייך ערך למשתנה קבוע +% It's not allowed to assign a value to a variable which is declared +% as a const. This is normally a parameter declared as const, to allow +% changing the value make the parameter as a value parameter or a var. +type_e_array_required=04033_E_נדרש משתנה מסוג מערך +% If you are accessing a variable using an index '[<x>]' then +% the type must be an array. In FPC mode also a pointer is allowed. +type_e_interface_type_expected=04034_E_מצפה לטיפוס מסוג ממשק, ×בל התקבל "$1" +% The compiler expected to encounter an interface type name, but got something else. +% The following code would provoke this error: +% \begin{verbatim} +% Type +% TMyStream = Class(TStream,Integer) +% \end{verbatim} +type_w_mixed_signed_unsigned=04035_W_עירבוב ביטויי ×¡×™×ž× ×™× ×•longwords ×ž×¡×¤×§×™× ×ª×•×¦××” של 64bit +% If you divide (or calculate the modulus of) a signed expression by a longword (or vice versa), +% or if you have overflow and/or range checking turned on and use an arithmetic +% expression (+, -, *, div, mod) in which both signed numbers and longwords appear, +% then everything has to be evaluated in 64bit which is slower than normal +% 32bit arithmetic. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_w_mixed_signed_unsigned2=04036_W_ערבוב ביטויי ×¡×™×ž× ×™× ×•×ž×¡×¤×¨×™× ×©×œ×ž×™× ×’×‘×•×”×™× ×¢×œ×•×œ ×œ×’×¨×•× ×œ×©×’×™×ת טווח ×ž×¡×¤×¨×™× +% If you use a binary operator (and, or, xor) and one of +% the operands is a longword while the other one is a signed expression, then, +% if range checking is turned on, you may get a range check error because in +% such a case both operands are converted to longword before the operation is +% carried out. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_e_typecast_wrong_size_for_assignment=04037_E_ישנו הבדל בגודל בהצבה של typecast ($1-> $2) +% Type casting to a type with a different size is not allowed when the variable is +% used for assigning. +type_e_array_index_enums_with_assign_not_possible=04038_E_מניות ×¢× ×ª×•×›×Ÿ של הצבה ××™× × ×™×›×•×œ×™× ×œ×©×ž×© בתור ×ינדקס למערך +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use it as index of an array. +type_e_classes_not_related=04039_E_×ין קירבה בין טיפוסי מחלקות ×ו ××•×‘×™×™×§×˜×™× ×©×œ "$1" ו "$2" +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_w_classes_not_related=04040_W_×ין קירבה בין טיפוסי המחלקות של "$1" ו "$2" +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_e_class_or_interface_type_expected=04041_E_מצפה לטיפוסי מחלקות ×ו ממשקי×, ×בל "$1" התקבל +% The compiler expected a class or interface name, but got another type or identifier. +type_e_type_is_not_completly_defined=04042_E_הטיפוס "$1" ×œ× ×”×•×’×“×¨ במלו×ו +% This error occurs when a type is not complete: i.e. a pointer type which points to +% an undefined type. +type_w_string_too_long=04043_W_התוכן של המחרוזת מכיל יותר ×ª×•×•×™× ×ž×ž×” שניתן להכיל ב×ורך של מחרוזת קצרה +% The size of the constant string, which is assigned to a shortstring, +% is longer than the maximum size of the shortstring +type_w_signed_unsigned_always_false=04044_W_ההשוו××” תמיד תחזיר ערך של false בגלל טווח ×”×¢×¨×›×™× +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% false. Exlicitly typecast the constant to the correct range to avoid this problem. +type_w_signed_unsigned_always_true=04045_W_ההשוו××” תמיד תחזיר ערך של true בגלל טווח ×”×¢×¨×›×™× +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% true. Exlicitly typecast the constant to the correct range to avoid this problem. +type_w_instance_with_abstract=04046_W_מ×תחל ×ת המחלקה "$1" ×¢× ×ž×ª×•×“×•×ª ×œ× ×ž×ž×•×ž×©×•×ª +% An instance of a class is created which contains non-implemented abstract +% methods. This will probably lead to a runtime error 211 in the code if that +% routine is ever called. All abstract methods should be overridden. +type_h_in_range_check=04047_H_הערך השמ×לי של ×”×ופרנד IN צריך להיות בגודל של בית +% The left operand of the \var{in} operator is not an ordinal or enumeration which fits +% within 8-bits, this may lead to range check errors. The \var{in} operator +% currently only supports a left operand which fits within a byte. In the case of +% enumerations, the size of an element of an enumeration can be controlled with +% the \var{\{\$PACKENUM\}} or \var{\{\$Zn\}} switches. +type_w_smaller_possible_range_check=04048_W_גודל הטיפוס ×ינו מת××™×, ישנה ×פשרות ל×יבוד מידע ×ו שגי××” בבדיקת הטווח +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_h_smaller_possible_range_check=04049_H_גודל הטיפוס ×ינו מת××™×, ישנה ×פשרות ל×יבוד מידע ×ו שגי××” בבדיקת הטווח +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_e_cant_take_address_of_abstract_method=04050_E_×œ× × ×™×ª×Ÿ לספק ×ת כתובת המתודה המוגדרת ×› abstract +% An abstract method has no body, so the address of an abstract method can't be taken. +type_e_assignment_not_allowed=04051_E_×œ× × ×™×ª×Ÿ לשייך ×ת הערך ×œ×¤×¨×ž×˜×¨×™× ×¨×©×ž×™×™× ×•×ž×¢×¨×›×™× ×¤×ª×•×—×™× +% You are trying to assign a value to a formal (untyped var, const or out) +% parameter, or to an open array. +type_e_constant_expr_expected=04052_E_מצפה לביטוי קבוע +% The compiler expects an constant expression, but gets a variable expression. +type_e_operator_not_supported_for_types=04053_E_הפעולה "$1" ××™× ×” נתמכת ×œ×˜×™×¤×•×¡×™× "$1" ו "$3" +% The operation is not allowed for the supplied types +type_e_illegal_type_conversion=04054_E_המרה ×œ× ×—×•×§×™×ª של הטיפוס של "$1" ל "$2" +% When doing a type-cast, you must take care that the sizes of the variable and +% the destination type are the same. +type_h_pointer_to_longint_conv_not_portable=04055_H_ההמרה בין מספר למצביע ××™× ×” ×פשרית בכל המערכות +% If you typecast a pointer to a longint (or vice-versa), this code will not compile +% on a machine using 64-bit for pointer storage. +type_w_pointer_to_longint_conv_not_portable=04056_W_ההמרה בין מספר למצביע ××™× ×” ×פשרית בכל המערכות +% If you typecast a pointer to a ordinal type of a different size (or vice-versa), this can +% cause problems. This is a warning to help finding the 32bit specific code where cardinal/longint is used +% to typecast pointers to ordinals. A solution is to use the ptrint/ptruint types instead. +type_e_cant_choose_overload_function=04057_E_×œ× × ×™×ª×Ÿ להחליט ב×יזו פונקצית עמוסת יתר להשתמש +% You're calling overloaded functions with a parameter that doesn't correspond +% to any of the declared function parameter lists. e.g. when you have declared +% a function with parameters \var{word} and \var{longint}, and then you call +% it with a parameter which is of type \var{integer}. +type_e_illegal_count_var=04058_E_משתנה ספירה ×œ× ×—×•×§×™ +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +type_w_double_c_varargs=04059_W_ממיר ×ת הטיפוס real לטיפוס double למשתנה C. הוסף typecast ספציפי למנוע ×ת המצב. +% In C, constant real values are double by default. For this reason, if you +% pass a constant real value to a variable argument part of a C function, FPC +% by default converts this constant to double as well. If you want to prevent +% this from happening, add an explicit typecast around the constant. +type_e_class_or_cominterface_type_expected=04060_E_מצפה לטיפוס מחלקה ×ו ממשק COM, ×בל התקבל "$1" +% Some operators like the AS operator are only appliable to classes or COM interfaces. +type_e_no_const_packed_array=04061_E_×ין תמיכה במערך קבוע דחוס +% You cannot declare a (bit)packed array as a typed constant. +type_e_got_expected_packed_array=04062_E_חוסר ת×ימות לטיפוס ×”× ×ª×•× ×™× ×©×œ ×רגומנט $1. התקבל: "$2" ×ž×¦× ×œ "(bit)packed array" +% The compiler expects a (bit)packed array as the specified parameter +type_e_got_expected_unpacked_array=04063_E_חוסר ת×ימות טיפוס ×”× ×ª×•× ×™× ×©×œ ×רגומנט $1. התקבל "$2" מצפה ל "(not packed) Array" +% The compiler expects a regular (i.e., not packed) array as the specified parameter +type_e_no_packed_inittable=04064_E_××œ×ž×˜×™× ×©×œ מערך דחוס ××™× × ×™×›×•×œ×™× ×œ×”×™×•×ª מטיפוס × ×ª×•× ×™× ×שר דורש ×תחול +% Support for packed arrays of types that need initialization (such as ansistrings, or records which contain ansistrings) is not yet implemented. +type_e_no_const_packed_record=04065_E_×ין תמיכה לרשומות ו××‘×™×™×§×˜×™× ×§×‘×•×¢×™× ×•×“×—×•×¡×™× +% You cannot declare a (bit)packed array as a typed constant at this time. +type_w_untyped_arithmetic_unportable=04066_W_חישוב "$1" על טיפוס ×œ× ×ž×•×’×“×¨ של מצביע ×ינו נתמך במצב {$T+}, ×ך ניתן להשתמש בtypecast +% Addition/subtraction from untyped pointer may work differently in \var{\{\$T+\}}, use typecast to typed pointer +type_e_cant_take_address_of_local_subroutine=04076_E_×œ× × ×™×ª×Ÿ לקחת ×ת כתובת השיגרה המסומנת כמקומית +% The address of a subroutine marked as local can't be taken. +type_e_cant_export_local=04077_E_×œ× × ×™×ª×Ÿ ×œ×™×™×¦× ×©×™×’×¨×” המסומנת כמקומית בתוך יחידה +% A subroutine marked as local can't be export from a unit. +type_e_not_automatable=04078_E_הטיפוס ×ינו ×וטומט: "$1" +% Only byte, integer, longint, smallint, currency, single, double, ansistring, +% widestring, tdatetime, variant, olevariant, wordbool and all interfaces are automatable. +type_h_convert_add_operands_to_prevent_overflow=04079_H_המרת ×”×ופרנד ל"$1" לפני פעולת החיבור, יכול למנוע שגי×ות גלישה. +% Adding two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the addition. +type_h_convert_sub_operands_to_prevent_overflow=04080_H_המרת ×”×ופרנד ל"$1" לפני פעולת החיבור יכולה למנוע שגי×ות גלישה. +% Subtracting two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the subtraction. +type_h_convert_mul_operands_to_prevent_overflow=04081_H_המרת ×”×ופרנד "$1" לפני פעולת הכפל יכולה למנוע שגי×ות גלישה. +% Multiplying two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the multiplication. +type_w_pointer_to_signed=04082_W_המרת ×ž×¦×‘×™×¢×™× ×œ×ž×¡×¤×¨×™× ×©×œ×ž×™× ×¢× ×¡×™×ž×Ÿ עלולה ×œ×’×¨×•× ×œ×©×’×™×ות בתוצ×ות השוו××” ובטווחי×. יש להשתמש ×‘×ž×§×•× ×–×ת בטיפוס ×œ×œ× ×¡×™×ž×Ÿ. +% The virtual address space on 32-bit machines runs from \$00000000 to \$ffffffff. Many operating systems allow you to +% allocate memory above \$80000000, for example both Windows and Linux allow pointers in the range \$0000000 to \$bfffffff. +% If you convert pointers to signed types, this can cause overflow and range check errors, but also \$80000000 < \$7fffffff. +% This can cause random errors in code like "if p>q". +% \end{description} +# +# Symtable +# +# 05060 is the last used one +# +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedure and variable names. +% \begin{description} +sym_e_id_not_found=05000_E_המזהה ×œ× × ×ž×¦× "$1" +% The compiler doesn't know this symbol. Usually happens when you misspel +% the name of a variable or procedure, or when you forgot to declare a +% variable. +sym_f_internal_error_in_symtablestack=05001_F_שגי××” פנימית בSymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_מזהה כפול "$1" +% The identifier was already declared in the current scope. +sym_h_duplicate_id_where=05003_H_המזהה כבר מוגדר ב$1 בשורה $2 +% The identifier was already declared in a previous scope. +sym_e_unknown_id=05004_E_מזהה ×œ× ×ž×•×›×¨ "$1" +% The identifier encountered has not been declared, or is used outside the +% scope where it is defined. +sym_e_forward_not_resolved=05005_E_הגדרת Forward ×œ× ×ž×ž×•×ž×©×ª +% This can happen in two cases: +% \begin{itemize} +% \item This happens when you declare a function (in the \var{interface} part, or +% with a \var{forward} directive, but do not implement it. +% \item You reference a type which isn't declared in the current \var{type} +% block. +% \end{itemize} +sym_e_error_in_type_def=05007_E_שגי××” בהגדרת טיפוס +% There is an error in your definition of a new array type: +% \item One of the range delimiters in an array declaration is erroneous. +% For example, \var{Array [1..1.25]} will trigger this error. +sym_e_forward_type_not_resolved=05009_E_הגדרת הטיפוס ×œ× ×”×•×©×œ×” "$1" +% A symbol was forward defined, but no declaration was encountered. +sym_e_only_static_in_static=05010_E_רק ×ž×©×ª× ×™× ×¡×˜×˜×™×™× ×™×›×•×œ×™× ×œ×”×™×•×ª בשימוש ×¢× ×ž×ª×•×“×•×ª סטטיות ×ו מחוץ למטודות +% A static method of an object can only access static variables. +sym_f_type_must_be_rec_or_class=05012_F_מצפה לטיפוס של רשומה ×ו טיפוס של מחלקה +% The variable or expression isn't of the type \var{record} or \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_××“×’× ×©×œ מחלקות ×ו ××•×‘×™×™×§×˜×™× ×¢× ×ž×ª×•×“×•×ª abstract ××™× × ×ž×•×¨×©×™× +% You are trying to generate an instance of a class which has an abstract +% method that wasn't overridden. +sym_w_label_not_defined=05014_W_התווית "$1" ××™× ×” מוגדרת +% A label was declared, but not defined. +sym_e_label_used_and_not_defined=05015_E_התווית "$1" בשימוש, ×בל ×œ× ×ž×’×“×¨×ª +% A label was declared and used, but not defined. +sym_e_ill_label_decl=05016_E_הגדרת תווית ×œ× ×—×•×§×™×ª +% This error should never happen; it occurs if a label is defined outside a +% procedure or function. +sym_e_goto_and_label_not_supported=05017_E_GOTO ו LABEL ××™× × × ×ª×ž×›×™× (השתמש במתג -Sg) +% You must compile a program which has \var{label}s and \var{goto} statements +% with the \var{-Sg} switch. By default, \var{label} and \var{goto} aren't +% supported. +sym_e_label_not_found=05018_E_התווית ×œ× × ×ž×¦××” +% A \var{goto label} was encountered, but the label isn't declared. +sym_e_id_is_no_label_id=05019_E_המזהה ×ינו תווית +% The identifier specified after the \var{goto} isn't of type label. +sym_e_label_already_defined=05020_E_התווית כבר הוגדרה +% You are defining a label twice. You can define a label only once. +sym_e_ill_type_decl_set=05021_E_הגדרת טיפוס סידרה ×œ× ×—×•×§×™×ª +% The declaration of a set contains an invalid type definition. +sym_e_class_forward_not_resolved=05022_E_הגדרה מקדימה של מחלקה "$1" ×œ× ×ž×ž×•×ž×©×ª +% You declared a class, but you did not implement it. +sym_n_unit_not_used=05023_H_היחידה "$1" ××™× ×” בשימוש ב $2 +% The unit referenced in the \var{uses} clause is not used. +sym_h_para_identifier_not_used=05024_H_הפרמטר "$1" ×ינו בשימוש +% The identifier was declared (locally or globally) but +% was not used (locally or globally). +sym_n_local_identifier_not_used=05025_N_המשתנה המקומי "$1" ×ינו בשימוש +% You have declared, but not used a variable in a procedure or function +% implementation. +sym_h_para_identifier_only_set=05026_H_הערך של הפרמטר "$1" הוזן ×ך ×”×•× ×œ× ×‘×©×™×ž×•×© +% The identifier was declared (locally or globally) +% set but not used (locally or globally). +sym_n_local_identifier_only_set=05027_N_הערך של הפרמטר "$1" הוזן ×ך ×”×•× ×œ× ×‘×©×™×ž×•×© +% The variable in a procedure or function +% implementation is declared, set but never used. +sym_h_local_symbol_not_used=05028_H_$1 "$2" מקומי ×œ× ×‘×©×™×ž×•×© +% A local symbol is never used. +sym_n_private_identifier_not_used=05029_N_שדה פרטי "$1.$2" ×œ× ×‘×©×™×ž×•×© +% The indicated private field is defined, but is never used in the code. +sym_n_private_identifier_only_set=05030_N_השדה הפרטי "$1.$2" בעל ערך, ×ך ×œ× ×‘×©×™×ž×•×© +% The indicated private field is declared, assigned but never read. +sym_n_private_method_not_used=05031_N_המתודה הפרטית "$1.$2" ××™× ×” בשימוש +% The indicated private method is declared but is never used in the code. +sym_e_set_expected=05032_E_מצפה לטיפוס סדרה +% The variable or expression is not of type \var{set}. This happens in an +% \var{in} statement. +sym_w_function_result_not_set=05033_W_הפונקציה כנר××” ×œ× ×ž×—×–×™×¨×” ערך +% You can get this warning if the compiler thinks that a function return +% value is not set. This will not be displayed for assembler procedures, +% or procedures that contain assembler blocks. +sym_w_wrong_C_pack=05034_W_הטיפוס "$1" ×ינו מייושר נכון לרשומה של שפת C +% Arrays with sizes not multiples of 4 will be wrongly aligned +% for C structures. +sym_e_illegal_field=05035_E_שדה של רשומה ×œ× ×—×•×§×™ "$1" +% The field doesn't exist in the record/object definition. +sym_w_uninitialized_local_variable=05036_W_המשתנה המקומי "$1" ×ינו נר××” מ×ותחל +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_w_uninitialized_variable=05037_W_המשתנה "$1" ×ינו נר××” מ×ותחל +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_e_id_no_member=05038_E_המזהה בשימוש ×ינו חבר ב"$1" +% This error is generated when an identifier of a record, +% field, or method is accessed while it is not defined. +sym_h_param_list=05039_H_נמצ××” ההכרזה: $1 +% You get this when you use the \var{-vh} switch. In case an overloaded +% procedure is not found, then all candidate overloaded procedures are +% listed, with their parameter lists. +sym_e_segment_too_large=05040_E_גודל המידע של ×”×למנט גדול מידי +% You get this when you declare a data element whose size exceeds the +% prescribed limit (2 Gb on 80386+/68020+ processors) +sym_e_no_matching_implementation_found=05042_E_×œ× × ×ž×¦× ×‘×™×¦×•×¢ למתודה "$1" של הממשק +% There was no matching method found which could implement the interface +% method. Check argument types and result type of the methods. +sym_w_deprecated_symbol=05043_W_הסימול "$1" מיושן +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Usage of this symbol +% should be avoided as much as possible. +sym_w_non_portable_symbol=05044_W_הסימול "$1" ×ינו נייד +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{platform} is used. This symbol's value, usage +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_non_implemented_symbol=05055_W_הסימול "$1" ×ינו מבוצע +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{unimplemented} is used. This symbol is defined, +% but is not yet implemented on this specific platform. +sym_e_cant_create_unique_type=05056_E_×œ× × ×™×ª×Ÿ ליצור טיפוס ייחודי מהטיפוס הנוכחי +% Only simple types like ordinal, float and string types are supported when +% redefining a type with \var{type newtype = type oldtype;}. +sym_h_uninitialized_local_variable=05057_H_המשתנה המקומי "$1" ×ינו נר××” מ×ותחל +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_h_uninitialized_variable=05058_H_המשתנה "$1" ×ינו נר××” מ×ותחל +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_w_function_result_uninitialized=05059_W_הערך המוחזר מהפונקציה ×ינו נר××” כמ×ותחל +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. appears in the right-hand-side of an expression) +% before it is initialized (i.e. appeared in the left-hand side of an +% assigment) +sym_h_function_result_uninitialized=05060_H_הערך המוחזר מהפונקציה ×ינו נר××” כמ×ותחל +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. appears in the right-hand-side of an expression) +% before it is initialized (i.e. appeared in the left-hand side of an +% assigment) +sym_w_identifier_only_read=05061_W_המשתנה "$1" נקר×, ×ך ×ž×¢×•×œ× ×œ× ×§×™×‘×œ תוכן +% You have read the value of a variable, but nowhere assigned a value to +% it. +sym_h_abstract_method_list=05062_H_נמצ××” מתודה מופשטת: $1 +% When getting a warning about constructing a class/object with abstract methods +% you get this hint to find the affected method. +% \end{description} +# +# Codegenerator +# +# 06040 is the last used one +# +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +cg_e_parasize_too_big=06009_E_הגודר של רשימת ×¤×¨×ž×˜×¨×™× ×’×“×•×œ×” מ 65535 ×‘×ª×™× +% The I386 processor limits the parameter list to 65535 bytes (the \var{RET} +% instruction causes this) +cg_e_file_must_call_by_reference=06012_E_טיפוס של קובץ חייב להיות משתנה מוגדר +% You cannot specify files as value parameters, i.e. they must always be +% declared \var{var} parameters. +cg_e_cant_use_far_pointer_there=06013_E_השימוש במצביע far ×ינו מורשה ×‘×ž×™×§×•× ×”× ×•×›×—×™ +% Free Pascal doesn't support far pointers, so you cannot take the address of +% an expression which has a far reference as a result. The \var{mem} construct +% has a far reference as a result, so the following code will produce this +% error: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_×œ× × ×™×ª×Ÿ ×œ×§×¨×•× ×œ×¤×•× ×§×¦×™×•×ª ×¢× ×”×’×“×¨×ª EXPORT +% No longer in use. +cg_w_member_cd_call_from_method=06016_W_כנר××” קרי××” ×œ× ×—×•×§×™×ª של יוצר ×ו הורס +% The compiler detected that a constructor or destructor is called within a +% a method. This will probably lead to problems, since constructors / destructors +% require parameters on entry. +cg_n_inefficient_code=06017_N_חסר קוד +% Your statement seems dubious to the compiler. +cg_w_unreachable_code=06018_W_×œ× × ×™×ª×Ÿ להריץ ×ת קטע הקוד +% You specified a construct which will never be executed. Example: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_×œ× × ×™×ª×Ÿ ×œ×§×¨×•× ×œ×ž×ª×•×“×•×ª Abstract בצורה ישירה +% You cannot call an abstract method directy, instead you must call a +% overriding child method, because an abstract method isn't implemented. +cg_d_register_weight=06027_DL_Register $1 משקל $2 $3 +% Debugging message. Shown when the compiler considers a variable for +% keeping in the registers. +cg_d_stackframe_omited=06029_DL_משמיט ×ת מסגרת המחסנית +% Some procedure/functions do not need a complete stack-frame, so it is omitted. +% This message will be displayed when the {-vd} switch is used. +cg_e_unable_inline_object_methods=06031_E_מתודות של ×ובייקט ×ו מחלקה ××™× × ×™×›×•×œ×™× ×œ×”×™×•×ª inline +% You cannot have inlined object methods. +cg_e_unable_inline_procvar=06032_E_קרי×ות Procvar ××™× × ×™×›×•×œ×™× ×œ×”×™×•×ª inline +% A procedure with a procedural variable call cannot be inlined. +cg_e_no_code_for_inline_stored=06033_E_×ין קוד לפרוצדורות inline +% The compiler couldn't store code for the inline procedure. +cg_e_can_access_element_zero=06035_E_×למנט ×”×פס של ansi/wide- ×ו longstring ×œ× × ×’×™×©, השתמש ב (set)length ×‘×ž×§×•× +% You should use \var{setlength} to set the length of an ansi/wide/longstring +% and \var{length} to get the length of such a string types +cg_e_cannot_call_cons_dest_inside_with=06037_E_×œ× × ×™×ª×Ÿ ×œ×§×¨×•× ×œ×™×•×¦×¨×™× ×ו ×”×•×¨×¡×™× ×‘×ª×•×š חלק של 'with' +% Inside a \var{with} clause you cannot call a constructor or destructor for the +% object you have in the \var{with} clause. +cg_e_cannot_call_message_direct=06038_E_×œ× × ×™×ª×Ÿ ×œ×§×¨×•× ×œ×ž×ª×•×“×•×ª של מטפל הוד×ות בצורה ישירה +% A message method handler method cannot be called directly if it contains an +% explicit self argument +cg_e_goto_inout_of_exception_block=06039_E_קפיצה ×ל תוך ×ו מחוץ לבלוק של exception +% It is not allowed to jump in or outside of an exception block like \var{try..finally..end;}: +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // this line will cause an error +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_השימוש ×‘×‘×™×˜×•×™×™× ×”×©×•×œ×˜×™× ×‘×–×¨×™×ž×ª הקוד ××™× × ×ž×•×¨×©×™× ×‘×—×œ×§ ×” finally +% It isn't allowed to use the control flow statements \var{break}, +% \var{continue} and \var{exit} +% inside a finally statement. The following example shows the problem: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // This exit ISN'T allowed +% end; +% ... +% +% \end{verbatim} +% If the procedure \var{p} raises an exception the finally block is +% executed. If the execution reaches the exit, it's unclear what to do: +% exiting the procedure or searching for another exception handler +cg_w_parasize_too_big=06041_W_גודל ×”×¤×¨×ž×˜×™× ×’×•×œ×© ×ת ההגבלות של חלק ×ž×”×ž×¢×‘×“×™× +% This indicates that you are declaring more than 64K of parameters, which +% might not be supported on other processor targets. +cg_w_localsize_too_big=06042_W_הגודל של המשתנה המקומי גולש מהגבלות של חלק ×ž×”×ž×¢×‘×“×™× +% This indicates that you are declaring more than 32K of local variables, which +% might not be supported on other processor targets. +cg_e_localsize_too_big=06043_E_גודל ×ž×©×ª× ×™× ×ž×§×•×ž×™×™× ×’×•×œ×© מהגבלות הנתמכות +% This indicates that you are declaring more than 32K of local variables, which +% is not supported by this processor. +cg_e_break_not_allowed=06044_E_BREAK ×ינו מורשה +% You're trying to use \var{break} outside a loop construction. +cg_e_continue_not_allowed=06045_E_CONTINUE ×ינו מורשה +% You're trying to use \var{continue} outside a loop construction. +cg_f_unknown_compilerproc=06046_F_compilerproc "$1" ×œ× ×™×“×•×¢. בדוק ×× ×”×©×ª×ž×© בספריית זמן הריצה הנכונה. +% The compiler expects that the runtime library contains certain subroutines. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the used compiler. If you changed the runtime library this error means +% that you removed a subroutine which the compiler needs for internal use. +cg_f_unknown_system_type=06047_F_×œ× × ×™×ª×Ÿ ×œ×ž×¦×•× ×˜×™×¤×•×¡ מערכת "$1". בדוק ×”×× ×תה משתמש בספריית זמן הריצה עדכנית. +% The compiler expects that the runtime library contains certain type definitions. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the used compiler. If you changed the runtime library this error means +% that you removed a type which the compiler needs for internal use. +cg_h_inherited_ignored=06048_H_×ž×ª×¢×œ× ×ž×”×©×™×ž×•×© בinherited במתודה מסוג abstract +% This messages appears only in Delphi mode when you call an abstract method +% of a parent class via \var{inherited;}. The call is then ignored. +cg_e_goto_label_not_found=06049_E_תווית ×” Goto "$1" ×œ× ×”×•×’×“×¨×” ×ו ×œ× ×¢×‘×¨×” ×ופטימיזציה +% The label used in the goto definition is not defined or optimized away by the +% unreachable code elemination. +% \end{description} +# EndOfTeX + +# +# Assembler reader +# +# 07105 is the last used one +# +asmr_d_start_reading=07000_DL_מתחיל בסגנון מפרש ×סמבלר $1 +% This informs you that an assembler block is being parsed +asmr_d_finish_reading=07001_DL_×”×¡×ª×™×™× × ×™×ª×•×— סגנון ×סמבלר $1 +% This informs you that an assembler block has finished. +asmr_e_none_label_contain_at=07002_E_תבנית ×œ×œ× ×ª×•×•×™×ª מכילה ×ת התו @ +% A identifier which isn't a label can't contain a @. +asmr_e_building_record_offset=07004_E_שגי××” בבניית היסט הרשומה +% There has an error occured while building the offset of a record/object +% structure, this can happend when there is no field specified at all or +% an unknown field identifier is used. +asmr_e_offset_without_identifier=07005_E_נעשה שימוש בOFFSET ×œ×œ× ×ž×–×”×” +% You can only use OFFSET with an identifier. Other syntaxes aren't +% supported +asmr_e_type_without_identifier=07006_E_נעשה שימוש בTYPE ×œ×œ× ×ž×–×”×” +% You can only use TYPE with an identifier. Other syntaxes aren't +% supported +asmr_e_no_local_or_para_allowed=07007_E_×œ× × ×™×ª×Ÿ להשתמש במשתמה מקומי ×ו פרמטר ×‘×ž×™×§×•× ×”× ×•×›×—×™ +% You can't use a local variable or parameter here, mostly because the +% addressing of locals and parameters is done using the frame pointer register so the +% address can't be obtained directly. +asmr_e_need_offset=07008_E_יש צורך להשתמש ב OFFSET +% You need to use OFFSET <id> here to get the address of the identifier. +asmr_e_need_dollar=07009_E_יש צורך להשתמש ב$ +% You need to use $<id> here to get the address of the identifier. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_×œ× × ×™×ª×Ÿ להשתמש ב relocatable symbols ×ž×¨×•×‘×™× +% You can't have more than one relocatable symbol (variable/typed constant) +% in one argument. +asmr_e_only_add_relocatable_symbol=07011_E_ניתן להוסיף רק relocatable symbol +% Relocatable symbols (variable/typed constant) can't be used with other +% operators. Only addition is allowed. +asmr_e_invalid_constant_expression=07012_E_ביטוי קבוע ×œ× ×—×•×§×™ +% There is an error in the constant expression. +asmr_e_relocatable_symbol_not_allowed=07013_E_Relocatable symbol ×ינו מורשה +% You can't use a relocatable symbol (variable/typed constant) here. +asmr_e_invalid_reference_syntax=07014_E_תחביר הפניות ×œ× ×—×•×§×™ +% There is an error in the reference. +asmr_e_local_para_unreachable=07015_E_×œ× × ×™×ª×Ÿ לגשת ל $1 מהקוד +% You can not read directly the value of a local variable or parameter +% of a higher level procedure in assembler code (except for +% local assembler code without parameter nor locals). +asmr_e_local_label_not_allowed_as_ref=07016_E_סימולי×/תוויות מקומיות ××™× × ×ž×•×¨×©×™× ×›×”×¤× ×™×•×ª +% You can't use local symbols/labels as references +asmr_e_wrong_base_index=07017_E_שימוש שגוי בבסיס ו×ינדקס של ×וגר +% There is an error with the base and index register, they are +% probably incorrect +asmr_w_possible_object_field_bug=07018_W_יתכן ×›×™ יש שגי××” בטיפול השדות של ×ובייקט +% Fields of objects or classes can be reached directly in normal or objfpc +% modes but TP and Delphi modes treat the field name as a simple offset. +asmr_e_wrong_scale_factor=07019_E_צויין טווח ×¡×•×œ× ×©×’×•×™ +% The scale factor given is wrong, only 1,2,4 and 8 are allowed +asmr_e_multiple_index=07020_E_שימוש מרובה ב×ינקס ×”×וגר +% You are trying to use more than one index register +asmr_e_invalid_operand_type=07021_E_טיפוס ×ופרנד שגוי +% The operand type doesn't match with the opcode used +asmr_e_invalid_string_as_opcode_operand=07022_E_×שימוש במחרוזת ×›×ופרנד opcode שגוי: $1 +% The string specified as operand is not correct with this opcode +asmr_w_CODE_and_DATA_not_supported=07023_W_השימוש ב@CODE ו@DATA ×œ× × ×ª×ž×š +% @CODE and @DATA are unsupported and are ignored. +asmr_e_null_label_ref_not_allowed=07024_E_התייחסות לתווית ריקה ××™× ×” מורשת +asmr_e_expr_zero_divide=07025_E_חילוק ב×פס בהערכת asm +% There is a division by zero in a constant expression +asmr_e_expr_illegal=07026_E_ביטוי ×œ× ×—×•×§×™ +% There is an illegal expression in a constant expression +asmr_e_escape_seq_ignored=07027_E_×ž×ª×¢×œ× ×ž×¨×¦×£ קידוד: $1 +% There is a C-styled string, but the escape sequence in the string +% is unknown, and is therefore ignored +asmr_e_invalid_symbol_ref=07028_E_התייחסות סימול ×œ× ×ª×§×™× ×” +asmr_w_fwait_emu_prob=07029_W_FWAIT מסוגל ×œ×’×¨×•× ×œ×‘×¢×™×•×ª חיקוי בemu387 +asmr_w_fadd_to_faddp=07030_W_$1 ×œ×œ× ×ª×¨×’×•× ×ופרנד ל$1P +asmr_w_enter_not_supported_by_linux=07031_W_הור×ת ENTER ××™× ×” נתמכת ×¢"×™ ליבת Linux +% ENTER instruction can generate a stack page fault that is not +% caught correctly by the i386 Linux page handler. +asmr_w_calling_overload_func=07032_W_מבצע קרי××” לפונקציה משוכתבת בassembler +% There is a call to an overloaded method in the assembler block, +% this might be the sign there is a problem +asmr_e_unsupported_symbol_type=07033_E_טיפוס הסימול של ×”×ופרנד ×ינו נתמך +asmr_e_constant_out_of_bounds=07034_E_תוכן הקבוע מחוץ לגבולות +asmr_e_error_converting_decimal=07035_E_שגי××” בזמן המרה דצימלית $1 +% A constant decimal value does not have the correct syntax +asmr_e_error_converting_octal=07036_E_שגי××” בזמן המרה ×וקטלית $1 +% A constant octal value does not have the correct syntax +asmr_e_error_converting_binary=07037_E_שגי××” בזמן המרה בינרית $1 +% A constant binary value does not have the correct syntax +asmr_e_error_converting_hexadecimal=07038_E_שגי××” בזמן המרה הקסה-דצימלית $1 +% A constant hexadecimal value does not have the correct syntax +asmr_h_direct_global_to_mangled=07039_H_$1 ×ª×•×¨×’× ×œ $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 משוייך לפונקציה משוכתבת +asmr_e_cannot_use_SELF_outside_a_method=07041_E_×œ× × ×™×ª×Ÿ להשתמש ב SELF מחוץ למתודה +% There is a reference to the \var{self} symbol while it is not +% allowed. \var{self} can only be referenced inside methods +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_×œ× × ×™×ª×Ÿ להשתמש ב OLDEBP מחוץ לפרוצדורה מקוננת +% There is a reference to the \var{oldebp} symbol while it is not +% allowed. \var{oldebp} can only be referenced inside nested routines +asmr_e_void_function=07043_W_פרוצדורות ××™× × ×™×›×•×œ×™× ×œ×”×—×–×™×¨ ערך בתוך קוד assembly +% Trying to return a value while in a procedure. A procedure +% does not have any return value +asmr_e_SEG_not_supported=07044_E_SEG ×ינו נתמך +asmr_e_size_suffix_and_dest_dont_match=07045_E_גודל סופי ויעד, ×ו מקור הגודל ××™× × ×ª×•××ž×™× +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_w_size_suffix_and_dest_dont_match=07046_W_גודל סופי ויעד, ×ו מקור הגודל ××™× × ×ª×•××ž×™× +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_e_syntax_error=07047_E_שגי××” בתחביר Assembler +% There is an assembler syntax error +asmr_e_invalid_opcode_and_operand=07048_E_שילוב ×œ× ×—×•×§×™ בין opcode ו×ופרנד +% The opcode cannot be used with this type of operand +asmr_e_syn_operand=07049_E_שגי××” בתחביר ×ופרנד בAssembler +asmr_e_syn_constant=07050_E_שגי××” בתחביר קבוע בAssembler +asmr_e_invalid_string_expression=07051_E_ביטוי מחרוזת ×œ× ×ª×§×™×Ÿ +asmr_w_const32bit_for_address=07052_W_הקבוע בעל הסימול $1 לכתובת, ×”×•× ×œ× ×ž×¦×‘×™×¢ +% A constant expression represents an address which does not fit +% into a pointer. The address is probably incorrect +asmr_e_unknown_opcode=07053_E_opcode $1 ×ינו מוכר +% This opcode is not known +asmr_e_invalid_or_missing_opcode=07054_E_opcode חסר ×ו ×œ× ×ª×§×™×Ÿ +asmr_e_invalid_prefix_and_opcode=07055_E_שילוב של תחילית וopcode ×œ× ×ª×§×™×Ÿ : $1 +asmr_e_invalid_override_and_opcode=07056_E_השילוב של שכתוב וopcode ×œ× ×ª×§×™×Ÿ: $1 +asmr_e_too_many_operands=07057_E_Too many operands on line +% There are too many operands for this opcode. Check your +% assembler syntax +asmr_w_near_ignored=07058_W_×ž×ª×¢×œ× ×žNEAR +asmr_w_far_ignored=07059_W_×ž×ª×¢×œ× ×ž FAR +asmr_e_dup_local_sym=07060_E_שיכפול של הסימול המקומי $1 +asmr_e_unknown_local_sym=07061_E_הסימול המקומי $1 ×ינו מוגדר +asmr_e_unknown_label_identifier=07062_E_מזהה תווית $1 ×œ× ×™×“×•×¢ +asmr_e_invalid_register=07063_E_×©× ×וגר שגוי +% There is an unknown register name used as operand. +asmr_e_invalid_fpu_register=07064_E_×©× ×וגר לנקודה צפה ×œ× ×ª×§×™×Ÿ +% There is an unknown register name used as operand. +asmr_w_modulo_not_supported=07066_W_מודולו ×œ× × ×ª×ž×š +asmr_e_invalid_float_const=07067_E_קבוע של נקודה צפה ×œ× ×ª×§×™×Ÿ $1 +% The floating point constant declared in an assembler block is +% invalid. +asmr_e_invalid_float_expr=07068_E_ביטוי ×œ× ×ª×§×™×Ÿ של נקודה צפה +% The floating point expression declared in an assembler block is +% invalid. +asmr_e_wrong_sym_type=07069_E_סוג סימול שגוי +asmr_e_cannot_index_relative_var=07070_E_×œ× × ×™×ª×Ÿ לשמור ציון של פרמטר ×ו משתנה מקומי ×¢× ×וגר +% Trying to index using a base register a symbol which is already relative +% to a register. This is not possible, and will probably lead to crashes. +asmr_e_invalid_seg_override=07071_E_ביטוי המיקטע המשוכתב ×ינו תקין +asmr_w_id_supposed_external=07072_W_המזהה $1 ×ינו נמצ×, מניח שהמזהה חיצוני +% There is a reference to an undefined symbol. This will not result +% in an error, since the symbol might be external, but may cause +% problems at link time if the symbol is not defined anywhere. +asmr_e_string_not_allowed_as_const=07073_E_המחרוזות ×ינן מורשות להיות קבועות +% Character strings are not allowed as constants. +asmr_e_no_var_type_specified=07074_×œ× ×¦×•×™×™×Ÿ טיפוס המשתנה +% The syntax expects a type idenfitifer after the dot, but +% none was found. +asmr_w_assembler_code_not_returned_to_text=07075_E_קוד ×”assembler ×œ× ×—×–×¨ ל×יזור הטקסט +% There was a directive in the assembler block to change sections, +% but there is a missing return to the text section at the end +% of the assembler block. This might cause errors during link time. +asmr_e_not_directive_or_local_symbol=07076_E_$1 ×”×•× ×œ× ×”× ×—×™×” ×ו סימול מקומי +% This symbol is unknown. +asmr_w_using_defined_as_local=07077_E_משתמש בהגדרת ×”×©× ×›×ª×•×•×™×ª מקומית +asmr_e_dollar_without_identifier=07078_E_השימוש בתו הדולר מתבצע ×œ×œ× ×ž×–×”×” +% A constant expression has an identifier which does not start with +% the $ symbol. +asmr_w_32bit_const_for_address=07079_W_מספק כתובת של 32 סיביות לקבוע +% A constant was used as an address. This is probably an error, +% since using absolute addresses will probably not work. +asmr_n_align_is_target_specific=07080_N_השימוש ב.align מבוסס על סוג יעד, השתמש ב.balign ×ו .p2align +% Using the .align directive is platform specific, and its meaning will vary +% from one platform to another. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_×œ× × ×™×ª×Ÿ להשתמש בצורה ישירה בשדות של ×¤×¨×ž×˜×¨×™× +% You should load the parameter first into a register and then access the +% fields using that register. +asmr_e_cannot_access_object_field_directly=07082_E_×œ× × ×™×ª×Ÿ לגשת בצורה ישירה לשדות של ×ובייקטי×/מחלקות +% You should load the self pointer first into a register and then access the +% fields using the register as base. By default the self pointer is available +% in the esi register on i386. +asmr_e_unable_to_determine_reference_size=07083_E_×œ× × ×™×ª×Ÿ לקבוע ×ת גודל ×”××•×¤×¨× ×“×™× ×œ×œ× ×¦×™×•×Ÿ של הגודל +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. +asmr_e_cannot_use_RESULT_here=07084_E_×œ× × ×™×ª×Ÿ להשתמש בRESULT בפונקציה הנוכחית +% Some functions which return complex types cannot use the \var{result} +% keyword. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" ×œ×œ× ×ª×¨×’×•× ×©×œ ××•×¤×¨× ×“×™× ×œ "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" ×ª×•×¨×’× ×œ "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" ×ª×•×¨×’× ×œ "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_התו > ×ינו מורשה ×›×ן +% The shift operator requires the << characters. Only one +% of those characters was found. +asmr_e_invalid_char_greater=07090_E_התו < ×ינו מורשה ×›×ן +% The shift operator requires the >> characters. Only one +% of those characters was found. +asmr_w_align_not_supported=07093_W_ALIGN ×ינו נתמך +asmr_e_no_inc_and_dec_together=07094_E_השימוש INC ו DEC ××™× × ×™×›×•×œ×™× ×œ×”×’×™×¢ בייחד +% Trying to use an increment and a decrement within the same +% opcode on the 680x0. This is impossible. +asmr_e_invalid_reg_list_in_movem=07095_E_שימוש בreglist ל movem ×œ× ×ª×§×™×Ÿ +% Trying to use the \var{movem} opcode with invalid registers +% to save or restore. +asmr_e_invalid_reg_list_for_opcode=07096_E_שימוש שגוי בreglist לopcode +asmr_e_higher_cpu_mode_required=07097_E_זקוק למצב מעבד גבוהה יותר ($1) +% Trying to use an instruction which is not supported in the current +% cpu mode. Use a higher cpu generation to be able to use this +% opcode in your assembler block +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_×œ× ×¦×•×™×™×Ÿ גודל של ×ופרנד ×•×œ× × ×™×ª×Ÿ לנחש ×ת הגודל, משתמש בDWORD כברירת מחדל +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use DWORD as default. +asmr_e_illegal_shifterop_syntax=07099_E_שגי×ת תחביר בעת ניסיון לפרש הסטת ×ופרנד +% ARM only; ARM assembler supports a so called shifter operand. The used syntax isn't +% a valid shifter operand. Example for an operation with shifter operand: +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +asmr_e_packed_element=07100_E_הכתובת של רכיב ×רוז ×ינו × ×ž×¦× ×‘×˜×•×•×— של בית +% Packed components (record fields and array elements) may start at an arbitrary +% bit inside a byte. On CPU which do not support bit-addressable memory (which +% includes all currently supported CPUs by FPC) you will therefore get an error +% message when trying to index arrays with elements whose size is not a multiple +% of 8 bits. The same goes for accessing record fields with such an address. +% multiple of 8 bits. +asmr_w_unable_to_determine_reference_size_using_byte=07101_W_×œ× ×¦×•×™×™×Ÿ גודל, והמהדר ×ינו מצליח לקבוע ×ת גודל ×”×ופרנד, משתמש בגודל BYTE בתור ברירת מחדל +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use BYTE as default. +asmr_w_no_direct_ebp_for_parameter=07102_W_×œ× × ×™×ª×Ÿ להשתמש ב+הסט(%ebp) ×‘×ž×™×§×•× ×”× ×•×›×™ עבור ×”×¤×¨×ž×˜×¨×™× +% Using direct 8(%ebp) reference for function/procedure parameters is invalid +% if parameters are in registers. +asmr_w_direct_ebp_for_parameter_regcall=07103_W_השימוש ב+הסט(%ebp) ×ינו תו×× ×¢× ×ž×•×¡×›×ž×•×ª ×” regcall +% Using direct 8(%ebp) reference for function/procedure parameters is invalid +% if parameters are in registers. +asmr_w_direct_ebp_neg_offset=07104_W_השימוש ב-הסט(%ebp) ×ינו מומלץ עבור גישה ×œ×ž×©×ª× ×™× ×ž×§×•×ž×™×™× +% Using -8(%ebp) to access a local variable is not recommended +asmr_w_direct_esp_neg_offset=07105_W_השימוש ב-הסט(%ebp) עלול ×œ×’×¨×•× ×œ×§×¨×™×¡×” של התוכנית ×ו ל×יבוד המידע +% Using -8(%esp) to access a local stack is not recommended, as +% this stack portion can be overwritten by any function calls or interrupts. +asmr_e_no_vmtoffset_possible=07106_E_השימוש ב VMTOffset חייב להגיע בשילוב של מתודות ווירטו×ליות ו "$1" ×ינו ווירטו×לי +% \end{verbatim} +# +# Assembler/binary writers +# +# 08018 is the last used one +# +asmw_f_too_many_asm_files=08000_F_יותר מידי קבצי assembler +% With smartlinking enabled, there are too many assembler +% files generated. Disable smartlinking. +asmw_f_assembler_output_not_supported=08001_F_סוג הפלט של ×”assembler ×ינו נתמך +asmw_f_comp_not_supported=08002_F_Comp ×ינו נתמך +asmw_f_direct_not_supported=08003_F_מצב ישיר של assembler ×ינו נתמך ×¢"×™ ×›×•×ª×‘×™× ×‘×™× ××¨×™×™× +% Direct assembler mode is not supported for binary writers. +asmw_e_alloc_data_only_in_bss=08004_E_×תחול המידע מורשה רק בחלק ×”bss +asmw_f_no_binary_writer_selected=08005_F_×œ× × ×‘×—×¨ כותב בינ×רי +asmw_e_opcode_not_in_table=08006_E_Asm: Opcode $1 ×”×•× ×œ× ×˜×‘×œ×” +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 הינו שילוב שגוי בין opcode לבין ×ופרנד +asmw_e_16bit_not_supported=08008_E_Asm: התייחסות של 16 סיביות ×ינו נתמך +asmw_e_invalid_effective_address=08009_E_Asm: מען בפעול ×œ× ×ª×§×™×Ÿ +asmw_e_immediate_or_reference_expected=08010_E_Asm: מצפה להתייחסות ל×ופרנד ×ו ×ופרנד מידי +asmw_e_value_exceeds_bounds=08011_E_Asm: $1 גולש מהגבולות $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: Short jump מחוץ לטווח $1 +asmw_e_undefined_label=08013_E_Asm: תווית ×œ× ×ž×•×’×“×¨×ª $1 +asmw_e_comp_not_supported=08014_E_Asm: הטיפוס COMP ×œ× × ×ª×ž×š ביעד המבוקש +asmw_e_extended_not_supported=08015_E_Asm: הטיפוס Extended ×ינו נתמך ביעד המבוקש +asmw_e_duplicate_label=08016_E_Asm: תוויות כפולה $1 +asmw_e_redefined_label=08017_E_Asm: מגדיר מחדש ×ת התווית $1 +asmw_e_first_defined_label=08018_E_Asm: מוגדר ×›×ן לר×שונה +asmw_e_invalid_register=08019_E_Asm: ×וגר שגוי $1 +asmw_e_16bit_32bit_not_supported=08020_E_Asm: ההתייחסות ל16 ×ו 32 סיביות ××™× ×” נתמכת +asmw_e_64bit_not_supported=08021_E_Asm: ×”×ופרנט 64 סיביות ×ינו נתמך + +# +# Executing linker/assembler +# +# 09034 is the last used one +# +# BeginOfTeX +% +% \section{Errors of assembling/linking stage} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +exec_w_source_os_redefined=09000_W_מקור מערכת ההפעלה מוגדר מחדש +% The source operating system is redefined. +exec_i_assembling_pipe=09001_I_מרכיב (צינור) $1 +% Assembling using a pipe to an external assembler. +exec_d_cant_create_asmfile=09002_E_×œ× × ×™×ª×Ÿ ליצור ×ת קובץ ×”assembler $1 +% The mentioned file can't be created. Check if you have got +% access permissions to create this file +exec_e_cant_create_objectfile=09003_E_×œ× × ×™×ª×Ÿ ליצור ×ת קובץ ×ובייקט $1 +% The mentioned file can't be created. Check if you've +% got access permissions to create this file +exec_e_cant_create_archivefile=09004_E_×œ× × ×™×ª×Ÿ ליצור ×ת קובץ ×”×רכיון $1 +% The mentioned file can't be created. Check if you've +% access permissions to create this file +exec_e_assembler_not_found=09005_E_המקשר $1 ×ינו נמצ×, עובר למ×סף חיצוני +% The assembler program was not found. The compiler will produce a script that +% can be used to assemble and link the program. +exec_t_using_assembler=09006_T_משתמש במ×סף: $1 +% Information message saying which assembler is being used. +exec_e_error_while_assembling=09007_E_שגי××” בזמן ×יסוף קוד יצי××” $1 +% There was an error while assembling the file using an external assembler. +% Consult the documentation of the assembler tool to find out more information +% on this error. +exec_e_cant_call_assembler=09008_E_×œ× × ×™×ª×Ÿ להריץ ×ת המ×סף, שגי××” $1, מריץ מ×סף חיצוני +% An error occurred when calling an external assembler, The compiler will produce a script that +% can be used to assemble and link the program. +exec_i_assembling=09009_I_מקשר $1 +% An informational message stating which file is being assembled. +exec_i_assembling_smart=09010_I_×וסף ×¢× smartlinking $1 +% An informational message stating which file is being assembled using smartlinking. +exec_w_objfile_not_found=09011_W_×”×ובייקט $1 ×œ× × ×ž×¦×, נר××” שה×יסוף יכשל ! +% One of the object file is missing, and linking will probably fail. +% Check your paths. +exec_w_libfile_not_found=09012_W_הספרייה $1 ×œ× × ×ž×¦××”, נר××” שה×יסוף יכשל ! +% One of the library file is missing, and linking will probably fail. +% Check your paths. +exec_e_error_while_linking=09013_E_שגי××” בזמן קישור +% Generic error while linking. +exec_e_cant_call_linker=09014_E_×œ× × ×™×ª×Ÿ להריץ ×ת המקשר, עובר למקשר חיצוני +% An error occurred when calling an external linker, The compiler will produce a script that +% can be used to assemble and link the program. +exec_i_linking=09015_I_מקשר $1 +% An informational message, showing which program or library is being linked. +exec_e_util_not_found=09016_E_הכלי $1 ×œ× × ×ž×¦×, עובר למקשר חיצוני +% An external tool was not found, the compiler will produce a script that +% can be used to assemble and link or postprocess the program. +exec_t_using_util=09017_T_משתמש בכלי $1 +% An informational message, showing which external program (usually a postprocessor) is being used. +exec_e_exe_not_supported=09018_E_×ין תמיכה ביצירת קבצי ריצה +% Creating executable programs is not supported for this platform, because it was +% not yet implemented in the compiler. +exec_e_dll_not_supported=09019_E_×ין תמיכה ביצירת ספריות דינמיות/משותפות +% Creating dynamically loadable libraries is not supported for this platform, because it was +% not yet implemented in the compiler. +exec_i_closing_script=09020_I_סוגר ×ת התסריט $1 +% Informational message showing when the external assembling an linking script is finished. +exec_e_res_not_found=09021_E_מהדר מש××‘×™× ×œ× × ×ž×¦×, עובר למצב חיצוני +% An external resource compiler was not found, the compiler will produce a script that +% can be used to assemble, compile resources and link or postprocess the program. +exec_i_compilingresource=09022_I_מהדר ×ת המש×ב $1 +% An informational message, showing which resource is being compiled. +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_×œ× × ×™×ª×Ÿ לקשר ×ת היחידה $1 בצורה סטטית, עובר לקישור ×—×›× +% Statical linking was requested, but a unit which is not statically linkable was used. +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_×œ× × ×™×ª×Ÿ לקשר בצורה חכמה ×ת היחידה $1, עובר לקישור סטטי +% Smart linking was requested, but a unit which is not smart-linkable was used. +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_×œ× × ×™×ª×Ÿ לקשר ×ת היחידה $1 בקישור משותף, עובר לקישור סטטי +% Shared linking was requested, but a unit which is not shared-linkable was used. +exec_e_unit_not_smart_or_static_linkable=09026_E_×œ× × ×™×ª×Ÿ לקשר ×ת היחידה $1 בקישור ×—×›× ×ו בקישור סטטי +% Smart or static linking was requested, but a unit which cannot be used for either was used. +exec_e_unit_not_shared_or_static_linkable=09027_E_×œ× × ×™×ª×Ÿ לקשר ×ת היחידה $1 בקישור משותף ×ו סטטי +% Shared or static linking was requested, but a unit which cannot be used for either was used. +exec_d_resbin_params=09028_D_מריץ ×ת מהדר המש××‘×™× "$1" ×¢× "$2" בתור שורת פקודה +% An informational message showing which command-line is used for the resource compiler. +%\end{description} +# EndOfTeX + +# +# Executable information +# +# BeginOfTeX +% \section{Executable information messages.} +% This section lists all messages that the compiler emits when an executable program is produced, +% and only when the internal linker is used. +% \begin{description} +execinfo_f_cant_process_executable=09128_F_×œ× ×ž×¦×œ×™×— לבצע מעבר סופי על קובץ ההרצה $1 +% Fatal error when the compiler is unable to post-process an executable. +execinfo_f_cant_open_executable=09129_F_×œ× ×ž×¦×œ×™×— לפתוח ×ת קובץ הריצה $1 +% Fatal error when the compiler cannot open the file for the executable. +execinfo_x_codesize=09130_X_גודל הקוד: $1 ×‘×ª×™× +% Informational message showing the size of the produced code section. +execinfo_x_initdatasize=09131_X_הגודל של מידע מ×ותחל: $1 ×‘×ª×™× +% Informational message showing the size of the initialized data section. +execinfo_x_uninitdatasize=09132_X_מידע של מידע ×œ× ×ž×ותחל: $1 ×‘×ª×™× +% Informational message showing the size of the uninitialized data section. +execinfo_x_stackreserve=09133_X_גודל המחסנית השמורה: $1 ×‘×ª×™× +% Informational message showing the stack size that the compiler reserved for the executable. +execinfo_x_stackcommit=09134_X_גודל המחסנית בשימוש: $1 ×‘×ª×™× +% Informational message showing the stack size that the compiler commites for the executable. +%\end{description} +# EndOfTeX + +# +# Unit loading +# +# 10041 is the last used one +# +# BeginOfTeX +% \section{Unit loading messages.} +% This section lists all messages that can occur when the compiler is +% loading a unit from disk into memory. Many of these messages are +% informational messages. +% \begin{description} +unit_t_unitsearch=10000_T_מחפש ×ת היחידה: $1 +% When you use the \var{-vt}, the compiler tells you where it tries to find +% unit files. +unit_t_ppu_loading=10001_T_טוען ×ת קובץ ×” PPU $1 +% When the \var{-vt} switch is used, the compiler tells you +% what units it loads. +unit_u_ppu_name=10002_U_×©× ×” PPU: $1 +% When you use the \var{-vu} flag, the unit name is shown. +unit_u_ppu_flags=10003_U_דגלי PPU: $1 +% When you use the \var{-vu} flag, the unit flags are shown. +unit_u_ppu_crc=10004_U_PPU Crc: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_time=10005_U_זמן PPU: $1 +% When you use the \var{-vu} flag, the time the unit was compiled is shown. +unit_u_ppu_file_too_short=10006_U_קובץ ×”PPU קצר מידי +% The ppufile is too short, not all declarations are present. +unit_u_ppu_invalid_header=10007_U_הר×ש של קובץ ×” PPU ×ינו תקין (הקובץ ×ינו מכיל PPU בהתחלה) +% A unit file contains as the first three bytes the ascii codes of \var{PPU} +unit_u_ppu_invalid_version=10008_U_גרסה ×œ× ×ª×§×™× ×” של ×”PPU $1 +% This unit file was compiled with a different version of the compiler, and +% cannot be read. +unit_u_ppu_invalid_processor=10009_U_קובץ ×”PPU הודר למעבד ×חר +% This unit file was compiled for a different processor type, and +% cannot be read +unit_u_ppu_invalid_target=10010_U_קובץ ×”PPU הודר למטרה ×חרת +% This unit file was compiled for a different target, and +% cannot be read +unit_u_ppu_source=10011_U_מקור ×”PPU: $1 +% When you use the \var{-vu} flag, the unit source file name is shown. +unit_u_ppu_write=10012_U_כותב $1 +% When you specify the \var{-vu} switch, the compiler will tell you where it +% writes the unit file. +unit_f_ppu_cannot_write=10013_F_×œ× ×›×•×ª×‘ ×ת קובץ ×” PPU +% An error occurred when writing the unit file. +unit_f_ppu_read_error=10014_F_שגי××” בזמן קרי×ת קובץ ×” PPU +% This means that the unit file was corrupted, and contains invalid +% information. Recompilation will be necessary. +unit_f_ppu_read_unexpected_end=10015_F_סוף קובץ ×œ× ×¦×¤×•×™ (קובץ PPU) +% Unexpected end of file. This may mean that the PPU file is +% corrupted. +unit_f_ppu_invalid_entry=10016_F_כניסה ×œ× ×ª×§×™× ×” בקובץ ×” PPU: $1 +% The unit the compiler is trying to read is corrupted, or generated with a +% newer version of the compiler. +unit_f_ppu_dbx_count_problem=10017_F_בעיה בספירת Dbx בקובץ PPU +% There is an inconsistency in the debugging information of the unit. +unit_e_illegal_unit_name=10018_E_×©× ×™×—×™×“×” ×œ× ×ª×§×™×Ÿ: $1 +% The name of the unit does not match the file name. +unit_f_too_much_units=10019_F_יותר מידי יחידות +% \fpc has a limit of 1024 units in a program. You can change this behavior +% by changing the \var{maxunits} constant in the \file{fmodule.pas} file of the +% compiler, and recompiling the compiler. +unit_f_circular_unit_reference=10020_F_קרי××” מעגלית בין היחידות $1 ו $2 +% Two units are using each other in the interface part. This is only allowed +% in the \var{implementation} part. At least one unit must contain the other one +% in the \var{implementation} section. +unit_f_cant_compile_unit=10021_F_×ין מספיק מש××‘×™× ×¢×œ מנת להדר ×ת היחידה $1 +% A unit was found that needs to be recompiled, but no sources are +% available. +unit_f_cant_find_ppu=10022_F_×œ× ×ž×•×¦× ×ת היחידה $1 +% You tried to use a unit of which the PPU file isn't found by the +% compiler. Check your configuration file for the unit paths +unit_w_unit_name_error=10023_W_היחידה $1 ×œ× × ×ž×¦××”, ×בל $2 ×§×™×™× +% This error message is no longer used. +unit_f_unit_name_error=10024_F_מחפש ×ת היחידה $1, ×בל $2 × ×ž×¦× +% Dos truncation of 8 letters for unit PPU files +% may lead to problems when unit name is longer than 8 letters. +unit_w_switch_us_missed=10025_W_הידור יחידת system דורשת ×ת המתג -Us +% When recompiling the system unit (it needs special treatment), the +% \var{-Us} must be specified. +unit_f_errors_in_unit=10026_F_עוצר ל×חר שנמצ×ו $1 שגי×ות בזמן הידור המודול +% When the compiler encounters a fatal error or too many errors in a module +% then it stops with this message. +unit_u_load_unit=10027_U_טוען $1 ($2) יחידה $3 +% When you use the \var{-vu} flag, which unit is loaded from which unit is +% shown. +unit_u_recompile_crc_change=10028_U_מהדר ×ת $1 ל×חר שהחתימה שונתה ל $2 +% The unit is recompiled because the checksum of a unit it depends on has +% changed. +unit_u_recompile_source_found_alone=10029_U_× ×ž×¦× ×¨×§ קוד מקור, מהדר מחדש ×ת $1 +% When you use the \var{-vu} flag, these messages tell you why the current +% unit is recompiled. +unit_u_recompile_staticlib_is_older=10030_U_מהדר מחדש ×ת היחידה. הספרייה הסטטית ישנה יותר מקובץ ×” PPU +% When you use the \var{-vu} flag, the compiler warns if the static library +% of the unit are older than the unit file itself. +unit_u_recompile_sharedlib_is_older=10031_U_מהדר מחדש ×ת היחידה. הספרייה המשותפת ישנה יותר מקובץ ×” PPU +% When you use the \var{-vu} flag, the compiler warns if the shared library +% of the unit are older than the unit file itself. +unit_u_recompile_obj_and_asm_older=10032_U_מהדר מחדש ×ת ×” היחידה. קבצי ×” obj והasm ×™×©× ×™× ×™×•×ª×¨ מקובץ ×” PPU +% When you use the \var{-vu} flag, the compiler warns if the assembler or +% object file of the unit are older than the unit file itself. +unit_u_recompile_obj_older_than_asm=10033_U_מהדר מחדש ×ת היחידה. קובץ ×”obj ישן יותר מקובץ ×”asm +% When you use the \var{-vu} flag, the compiler warns if the assembler +% file of the unit is older than the object file of the unit. +unit_u_parsing_interface=10034_U_מפרש ×ת חלק הממשק של $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the interface part of the unit +unit_u_parsing_implementation=10035_U_מפרש ×ת חלק הביצועי של $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the implementation part of the unit +unit_u_second_load_unit=10036_U_טעינה שנייה של היחידה $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_check_time=10037_U_בדיקת קובץ PPU $1 זמן $2 +% When you use the \var{-vu} flag, the compiler show the filename and +% date and time of the file which a recompile depends on +### The following two error msgs is currently disabled. +#unit_h_cond_not_set_in_last_compile=10038_H_התנ××™× ×©×œ $1 ×œ× ×”×•×’×“×¨×• בהתחלת הריצה בהידור ×”×חרון של $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that currently is defined, but was not used the last +#% time the unit was compiled. +#unit_h_cond_set_in_last_compile=10039_H_התנ××™× ×©×œ $1 הוגדרו בהתחלת הריצה בהידור ×”×חרון של $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that was used the last time the unit was compiled, but +#% the conditional is currently not defined. +unit_w_cant_compile_unit_with_changed_incfile=10040_W_×œ× × ×™×ª×Ÿ להדר ×ת היחידה $1 למרות שקבצי ×”include שונו +% A unit was found to have modified include files, but +% some source files were not found, so recompilation is impossible. +unit_u_source_modified=10041_U_הקובץ $1 חדש יותר מהקובץ PPU $2 +% A modified source file for a compiler unit was found. +unit_u_ppu_invalid_fpumode=10042_U_מנסה להשתמש ביחידה ×שר הודרה למצב FPU שונה +% Trying to compile code while using units which were not compiled with +% the same floating point format mode. Either all code should be compiled +% with FPU emulation on, or with FPU emulation off. +unit_u_loading_interface_units=10043_U_טוען ×ת חלק הממשק של היחידות מ $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the units defined in the interface part of the unit. +unit_u_loading_implementation_units=10044_U_טוען ×ת החלק הביצועי של היחידות מ $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the units defined in the implementation part of the unit. +unit_u_interface_crc_changed=10045_U_חתימת ×” CRC של חלק הממשק השתנה ביחידה $1 +% When you use the \var{-vu} flag, the compiler warns that it the +% CRC calculated for the interface has been changed after the implementation +% has been parsed. +unit_u_implementation_crc_changed=10046_U_חתימת ×”CRC של החלק הביצועי השתנה ליחידה $1 +% When you use the \var{-vu} flag, the compiler warns that it the +% CRC calculated has been changed after the implementation +% has been parsed. +unit_u_finished_compiling=10047_U_×”×¡×ª×™×™× ×”×™×“×•×¨ היחידה $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has finished compiling the unit. +unit_u_add_depend_to=10048_U_מוסיף ×ת התלות של $1 ל$2 +% When you use the \var{-vu} flag, the compiler warns that it +% has added a dependency between the two units. +unit_u_no_reload_is_caller=10049_U_×ין קרי××” מחודשת של הקובץ בשביל $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has will not reload the unit because it is the unit that wants +% to load this unit +unit_u_no_reload_in_second_compile=10050_U_×ין טעינה מחדש, בזמן הידור שני של היחידה $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has will not reload the unit because it is already in a second recompile +unit_u_flag_for_reload=10051_U_דגל לטעינה מחודשת: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to reload the unit +unit_u_forced_reload=10052_U_כופה על טעינה מחודשת +% When you use the \var{-vu} flag, the compiler warns that it +% has is reloading the unit because it was required +unit_u_previous_state=10053_U_המצב הישן של $1: $2 +% When you use the \var{-vu} flag, the compiler shows the +% previous state of the unit +unit_u_second_compile_unit=10054_U_× ×ž×¦× ×›×‘×¨ בתהליך הידור $1, ×ž×™×™×©× ×”×™×“×•×¨ שני +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_loading_unit=10055_U_טוען ×ת היחידה $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the unit. +unit_u_finished_loading_unit=10056_U_×ž×¡×™×™× ×œ×˜×¢×•×Ÿ ×ת היחידה $1 +% When you use the \var{-vu} flag, the compiler warns that it finished +% loading the unit. +unit_u_registering_new_unit=10057_U_×¨×•×©× ×™×—×™×“×” חדשה $1 +% When you use the \var{-vu} flag, the compiler warns that it has +% found a new unit and registers it in the internal lists. +unit_u_reresolving_unit=10058_U_מחשב מחדש ×ת היחידה $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to recalculate the internal data of the unit +unit_u_skipping_reresolving_unit=10059_U_מדלג על טעינה מחודשת של היחידה $1, עדיין בזמן טעינת יחידות בשימוש +% When you use the \var{-vu} flag, the compiler warns that it +% skips to recalculate the internal data of the unit because there +% is no data to recalculate +% \end{description} +# EndOfTeX + +# +# Options +# +# 11041 is the last used one +# +option_usage=11000_O_$1 [options] <inputfile> [options] +# BeginOfTeX +% +% \section{Command-line handling errors} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +option_only_one_source_support=11001_W_תומך רק בקובץ מקור ×חד בשורת הפקודה +% You can specify only one source file on the command line. The first +% one will be compiled, others will be ignored. This may indicate that +% you forgot a \var{'-'} sign. +option_def_only_for_os2=11002_W_ניתן ליצור ×ת קובץ ×” DEF רק לOS/2 +% This option can only be specified when you're compiling for OS/2 +option_no_nested_response_file=11003_E_×ין תמיכה בקבצי תגובה ×ž×§×•× × ×™× +% you cannot nest response files with the \var{@file} command-line option. +option_no_source_found=11004_F_×œ× ×¦×•×™×™×Ÿ קובץ מקור בשורת הפקודה +% The compiler expects a source file name on the command line. +option_no_option_found=11005_N_×œ× ×¦×•×™× ×• ×פשרויות בתוך קובץ ההגדרות $1 +% The compiler didn't find any option in that config file. +option_illegal_para=11006_E_פרמטר ×œ× ×—×•×§×™: $1 +% You specified an unknown option. +option_help_pages_para=11007_H_-? כותב דפי עזרה +% When an unknown option is given, this message is diplayed. +option_too_many_cfg_files=11008_F_יותר מידי קבצי הגדרות ×ž×§×•× × ×™× +% You can only nest up to 16 config files. +option_unable_open_file=11009_F_×œ× × ×™×ª×Ÿ לפתוח ×ת הקובץ $1 +% The option file cannot be found. +option_reading_further_from=11010_D_×§×•×¨× ×”×’×“×¨×•×ª נוספות מ $1 +% Displayed when you have notes turned on, and the compiler switches +% to another options file. +option_target_is_already_set=11011_W_המטרה כבר הוגדרה ל: $1 +% Displayed if more than one \var{-T} option is specified. +option_no_shared_lib_under_dos=11012_W_DOS ×ינו תומך בספריות משותפות, חוזר לספריות סטטיות +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos +option_too_many_ifdef=11013_F_IF(N)DEF ×¨×‘×™× ×ž×™×“×™ +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_many_endif=11014_F_ENDIF ×¨×‘×™× ×ž×™×“×™ +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_less_endif=11015_F_תנ××™ פתוח בסוף הקובץ +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_no_debug_support=11016_W_מידע ניפוי שגי×ות ×ינו נתמך בסוג קובץ הריצה המבוקש +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_נסה להדר מחדש ×¢× ×”×ž×ª×’ -dGDB +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_W_×תה משתמש במתג המיושן $1 +% this warns you when you use a switch that is not needed/supported anymore. +% It is recommended that you remove the switch to overcome problems in the +% future, when the switch meaning may change. +option_obsolete_switch_use_new=11019_W_×תה משתמש במתג המיושן $1, השתמש במתג $2 ×‘×ž×§×•× +% this warns you when you use a switch that is not supported anymore. You +% must now use the second switch instead. +% It is recommended that you change the switch to overcome problems in the +% future, when the switch meaning may change. +option_switch_bin_to_src_assembler=11020_N_מעביר ×ת ×”×וסף למצב ברירת מחדל של כתיבת מ×סף +% this notifies you that the assembler has been changed because you used the +% -a switch which can't be used with a binary assembler writer. +option_incompatible_asm=11021_W_התוכן הנבחר של ×”assembler "$1" ×ינו מת××™× ×œ "$2" +option_asm_forced=11022_W_התוכן של המ×סף "$1" ×œ× ×ž×¡×•×’×œ ליצור קבצי ×ובייקט, משתמש במ×סף ברירת המחדל ×‘×ž×§×•× +% The assembler output selected can not generate +% object files with the correct format. Therefore, the +% default assembler for this target is used instead. +option_using_file=11026_T_×§×•×¨× ×פשרויות מהקובץ $1 +% Options are also read from this file +option_using_env=11027_T_×§×•×¨× ×פשרויות מהסביבה $1 +% Options are also read from this environment string +option_handling_option=11028_D_מטפל ב×פשרות "$1" +% Debug info that an option is found and will be handled +option_help_press_enter=11029__*** לחץ על enter *** +option_start_reading_configfile=11030_H_מתחיל בקרי×ת קובץ ההגדרות $1 +% Starting of config file parsing. +option_end_reading_configfile=11031_H_×¡×™×•× ×§×¨×™×ת קובץ ההגדרות $1 +% End of config file parsing. +option_interpreting_option=11032_D_מפרש ×ת ×”×פשרות "$1" +option_interpreting_firstpass_option=11036_D_מפרש ×ת המעבר הר×שון על ×”×פשרות "$1" +option_interpreting_file_option=11033_D_מפרש ×ת הגדרת הקובץ "$1" +option_read_config_file=11034_D_×§×•×¨× ×ת קובץ ההגדרות "$1" +option_found_file=11035_D_× ×ž×¦× ×§×•×‘×¥ מקור ×‘×©× "$1" +% Additional infos about options, displayed +% when you have debug option turned on. +option_code_page_not_available=11039_E_קוד דף ×œ× ×™×“×•×¢ +option_config_is_dir=11040_F_נמצ××” ספרייה ×‘×ž×§×•× ×§×•×‘×¥ ההגדרות $1 +% Directories can not be used as configuration files. +option_confict_asm_debug=11041_W_סוג הפלט של המ×סף שנבחר "$1" ×ינו יכול ליצור מידע עבור ניפוי שגי×ות. מבטל ניפוי שגי×ות +% The assembler output selected can not generate +% debugging information, debugging option is therefore disabled. +%\end{description} +# EndOfTeX + +# +# Logo (option -l) +# +option_logo=11023_[ +Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU +Copyright (c) 1993-2011 by Florian Klaempfl +] + +# +# Info (option -i) +# +option_info=11024_[ +Free Pascal Compiler version $FPCVERSION + +ת×ריך מהדר : $FPCDATE +מהדר למעבד: $FPCCPU + +מערכות הפעלה נתמכות: + $OSTARGETS + +הור×ות מעבד נתמכות: + $INSTRUCTIONSETS + +הור×ות נתמכות של יחידת נקודה צפה: + $FPUINSTRUCTIONSETS + +תמיכת המיטוב: + $OPTIMIZATIONS + +התוכנה מוגשת תחת רישיון GNU General Public License +למידע נוסף יש ×œ×§×¨×•× ×ת COPYING.FPC + +דיווח על תקלות (ב××’×™×), הצעות וכו': + http://bugs.freepascal.org + + bugs@freepascal.org +] + +# +# Help pages (option -? and -h) +# +# The first character on the line indicates who will display this +# line, the current possibilities are : +# * = every target +# 3 = 80x86 targets +# 6 = 680x0 targets +# e = in extended debug mode only +# P = PowerPC targets +# S = Sparc targets +# V = Virtual machine targets +# The second character also indicates who will display this line, +# (if the above character was TRUE) the current possibilities are : +# * = everyone +# g = with GDB info supported by the compiler +# O = OS/2 +# L = UNIX systems +# The third character represents the indentation level. +# +option_help_pages=11025_[ +**0*_הוסף ×ת הסימן + ל×חר ×פשרות מתג בולי×× ×™ ל×פשר ×ת ×”×פשרות, הוסף ×ת הסימן - לבטל ×ת ×”×פשרות +**1a_המהדר ×ינו מוחק ×ת קובץ ×”assembler שנוצר +**2al_×¨×•×©× ×¨×©×™×ž×” של שורות קוד מקור בקובץ ×”assembler +**2an_רשימת מידע של ×¦×ž×ª×™× ×‘×§×•×‘×¥ ×”assembler +*L2ap_השתמש בצינורות ×‘×ž×§×•× ×§×‘×¦×™ assembler ×–×ž× ×™×™× +**2ar_רשימה ×ודות ×¨×™×©×•× ×©×œ הקצ××”/שחרור בקובץ ×”assembler +**2at_רשימה זמנית ×ודות הקצ××”/שחרור בקובץ ×”assembler +**1A<x>_תסדירי פלט: +**2Adefault_השתמש במ×סף ברירת מחדל +3*2Aas_×סוף ×¢× GNU AS +3*2Anasmcoff_קובץ COFF (Go32v2) בשימוש ×¢× Nasm +3*2Anasmelf_קובץ ELF32 (Linux) בשימוש ×¢× Nasm +3*2Anasmwin32_קובץ ×ובייקט Win32 בשימוש ×¢× Nasm +3*2Anasmwdosx_קובץ ×ובייקט Win32/WDOSX בשימוש ×¢× Nasm +3*2Awasm_קובץ obj בשימוש ×¢× Wasm (Watcom) +3*2Anasmobj_קובץ obj בשימוש ×¢× Nasm +3*2Amasm_קובץ obj בשימוש ×¢× Masm (Microsoft) +3*2Atasm_קובץ obj בשימוש Tasm (Borland) +3*2Aelf_קובץ ELF32 (Linux) בשימוש כותב פנימי +3*2Acoff_קובץ OFF (Go32v2) בשימוש כותב פנימי +3*2Apecoff_קובץ pecoff (Win32) בשימוש כותב פנימי +4*2Aas_×סוף ×¢× GNU AS +6*2Aas_קובץ-o Unix בשימוש GNU AS +6*2Agas_GNU Motorola assembler +6*2Amit_MIT Syntax (GAS ישן) +6*2Amot_Motorola assembler תקני +A*2Aas_×סוף ×¢× GNU AS +P*2Aas_×סוף ×¢× GNU AS +S*2Aas_×סוף ×¢× GNU AS +**1b_ייצר מידע לדפדוף +**2bl_ייצר מידע על ×¡×ž×œ×™× ×ž×§×•×ž×™×™× +**1B_בנה ×ת כל ×”×ž×•×“×•×œ×™× +**1C<x>_×פשרויות יצירת קוד: +**2Cc<x>_קובע מוסכמות הפעלה ברירת מחדל ל <ס> +**2CD_צור ×’× ×¡×¤×¨×™×™×” דינ×מית (×œ× × ×ª×ž×š) +**2Ce_מהדר ×¢× ×”×“×ž×™×™×” של opcodes ×”×©×™×™×›×™× ×œ× ×§×•×“×” צפה +**2Cf<x>_בחר הור×ות FPU לשימוש, ר××” fpc -i ×œ×¢×¨×›×™× ××¤×©×¨×™×™× +**2CF<x>_דיוק נקודה עשרונית קבועה מינימלית (default, 32, 64) +**2Cg_צור קוד PIC +**2Ch<n>_כמות של <n> ×‘×ª×™× ×œ מצבור (בין 1023 ו67107840) +**2Ci_בדיקת IO +**2Cn_השמט מצב קישור +**2Co_בדוק גלישה של פעולות מספר ×©×œ× +**2CO_בדוק עבור פעולות גלישה ×פשרויות של מספר ×©×œ× +**2Cp<x>_בחר קבוצת הור×ות, ר××” fpc -i ×œ×¢×¨×›×™× ××¤×©×¨×™×™× +**2CP<x>=<y>_הגדרות ×ריזה +**3CPPACKSET=<y>_ <y> מסדר הקצ××”: 0, 1 ×ו DEFAULT ×ו NORMAL, 2, 4 ו 8 +**2Cr_בדיקת טווח +**2CR_×•×•×“× ×§×¨×™××” תקינה למתודה +**2Cs<n>_קבע גודל מחסנית ל <n> +**2Ct_בדיקת מחסנית +**2CX_צור ×’× ×¡×¤×¨×™×™×” של קישור ×—×›× +**1d<x>_מגדיר ×ת הסמל <x> +**1D_יוצר קובץ DEF +**2Dd<x>_יוצר ת×ור ל <x> +**2Dv<x>_יוצר גרסת DLL ל <x> +*O2Dw_×™×©×•× PM +**1e<x>_קובע נתיב לקובץ ריצה +**1E_×–×”×” ל -Cn +**1fPIC_×–×”×” ל -Cg +**1F<x>_קובע ×©× ×§×‘×¦×™× ×•×ž×™×§×•×ž×™×: +**2Fa<x>[,y]_×§×•×“× ×˜×•×¢×Ÿ ×ת היחידות <x> ו [y] ר×שונות, לפני ניתוח שורת ×” uses +**2Fc<x>_קובע קוד דף של קלט ל<x> +**2FC<x>_קבע ×©× ×ž×”×“×¨ RC בינ×רי ל <x> +**2FD<x>_קובע ×ת הספרייה בה ×פשר לחפש ×ת כלי העזר של המהדר +**2Fe<x>_הפנה הודעות שגי××” ל<x> +**2Ff<x>_הוסף ×ת <x> לנתיב המסגרת (רק ב Darwin) +**2FE<x>_הפנה פלט של exe/unit לנתיב <x> +**2Fi<x>_מוסיף ×ת <x> לרשימת ×”× ×ª×™×‘×™× +**2Fl<x>_מוסיף ×ת <x> לרשימת ×”× ×ª×™×‘×™× ×©×œ הספריה +**2FL<x>_משתמש ב<x> כמקשר דינ×מי +**2Fm<x>_טוען טבלת המרה של יוניקוד מהקובץ x>.txt> מספריית המהדר +**2Fo<x>_מוסיף ×ת <x> לרשינת ×”× ×ª×™×‘×™× ×©×œ ×ובייקט +**2Fr<x>_טוען קובץ הודעות שגי××” <x> +**2FR<x>_קבע מקשר לקובץ res ל <x> +**2Fu<x>_מוסיף ×ת <x> לרשימת ×”× ×ª×™×‘×™× ×©×œ יחידה +**2FU<x>_קובע ×ת ×”×ž×™×§×•× ×”×¤×œ×˜ של היחידות ל <x> ומשכתב ×ת -FE +*g1g_יוצר מידע לניפוי שגי×ות +*g2gc_יוצר בדיקות ×œ×ž×¦×‘×™×¢×™× +*g2gh_השתמש ביחידה heaptrace (עבור דליפות זכרון/בעיות בניפוי שגי×ות) +*g2gl_השתמש ביחידת מידע של שורה להציג מידע נוסף לbacktraces +*g2go<x>_צור ×פשרויות לניפוי שגי×ות +*g3godwarfsets_×פשר מידע לניהול מידע עבור ניפוי שגי×ות של Dwarf (שובר ×ת gdb < 6.5) +*g2gp_משמר גודל שמות סמלי ×”stabs +*g2gs_מייצר מידע לניפוי שגי×ות stub +*g2gt_לכלך ×ž×©×ª× ×™× ×ž×§×•×ž×™×™× (לזיהוי מידע ×œ× ×ž×ותחל) +*g2gv_מייצר תוכנות ×¢× ×™×›×•×œ×ª מעקב של valgrind +*g2gw_מייצר מידע לניפוי שגי×ות לdwarf +*g2gw2_מיצר מידע לניפוי שגי×ות dwarf-2 +*g2gw3_מיצר מידע לניפוי שגי×ות dwarf-3 +**1i_מידע +**2iD_הצג ת×ריך המהדר +**2iV_הצג גרסת המהדר +**2iW_הצג גרסה מל××” של המהדר +**2iSO_הצג מערכת הפעלה של המהדר +**2iSP_הצג גרסת מעבד של המהדר +**2iTO_הצג ×ת המטרה של מערכת ההפעלה +**2iTP_הצג ×ת המטרה של המעבד +**1I<x>_הוסף ×ת <x> לרשימת ×”× ×ª×™×‘×™× ×œ×”×•×¡×¤×” +**1k<x>_העבר ×ת <x> למקשר +**1l_כתוב סמליל +**1M<x>_הגדר מצב שפה ל <x> +**2Mfpc_די×לקט של Free Pascal (ברירת מחדל) +**2Mobjfpc_×פשר כמה תוספות של Delphi 2 +**2Mdelphi_מנסה להיות תו×× Delphi +**2Mtp_מנסה להיות תו×× ×œ TP/BP 7.0 +**2Mmacpas_מנסה להיות תו×× ×œ×œ×”×’ של Macintosh Pascal +**1n_×ל ×ª×§×¨× ×ת קובץ הגדרות ברירת המחדל +**1N<x>_מיטוב צמתי ×¢×¥ +**2Nu_לגולל לול×ות +**1o<x>_שנה ×ת ×©× ×§×•×‘×¥ הריצה שהתקבל ל <x> +**1O<x>_מיטובי×: +**2O-_בטל מיטוב +**2O1_מיטוב רמה 1 (מהיר וטוב לניפוי שגי×ות) +**2O2_מיטוב רמה 2 (-O1 + מיטוב מהיר) +**2O3_מיטוב רמה 3 (-O2 + מיטוב ×יטי) +**2Oa<x>=<y>_קבע יישור +**2Oo[NO]<x>_×¢"מ ל×פשר ×ו ל×פשר מיטובי×, ר××” fpc -i ל×פשרויות +**2Op<x>_לקביעת מיטוב למעבד נבחר, ר××” fpc -i ל×פשרויות +**2Os_צור קוד קטן +**1pg_צור קוד פרופיל עבור gprof (מגדיר ×ת FPC_PROFILE) +**1R<x>_סגנון קרי×ת ×”×סף: +**2Rdefault_השתמש במ×סף ברירת מחדל +3*2Ratt_×§×¨× ×¡×’× ×•×Ÿ מקשר של AT&T +3*2Rintel_×§×¨× ×¡×’× ×•×Ÿ מקשר של Intel +6*2RMOT_×§×¨× ×¡×’× ×•×Ÿ מקשר של Motorola +**1S<x>_×פשרויות תחביר: +**2S2_×–×”×” ל -Mobjfpc +**2Sc_תומך ××•×¤×¨×˜×•×¨×™× ×‘×¡×’× ×•×Ÿ C (*=, +=, /= ו -=) +**2Sa_הוסף קוד טענת תנ××™ קביעה (assertion) +**2Sd_×–×”×” ל -Mdelphi +**2Se<x>_×פשרויות שגי××”. <x> הינו השילוב הב×: +**3*_<n> : המהדר עוצר ל×חר <n> שגי×ות (ברירת מחדל ×”×™× 1) +**3*_w : המהדר עוצר ×’× ×œ×חר ×זהרות +**3*_n : המהדר עוצר ל×חר הערות +**3*_h : המהדר עוצר ל×חר ×¨×ž×–×™× +**2Sg_×פשר LABEL ו GOTO +**2Sh_השתמש ב ansistrings +**2Si_תמוך בסגנון C++ של INLINE +**2Sk_טען ×ת היחידה fpcylix +**2SI<x>_קבע סגנון ממשק ל<x> +**3SIcom_תו×× ×ž×ž×©×§×™ COM (ברירת מחדל) +**3SIcorba_תו×× ×ž×ž×©×§×™ CORBA +**2Sm_תמוך במקרו ×“×•×ž×™× ×œC (גלובליי×) +**2So_×–×”×” ל -Mtp +**2Ss_×©× ×™×•×¦×¨ חייב להיות init (×©× ×”×•×¨×¡ חייב להיות done) +**2Sx_×פשר מילות מפתח לexception (ברירת מחדל במצבי Delphi/ObjFPC) +**1s_×ל ×ª×§×¨× ×œ×ž×סף והמקשר +**2sh_צור תסריט לקישור במ×רח +**2st_צור תסריט לקישור במטרה +**2sr_דלג על ×¨×™×©×•× ×”×§×¦×ת מופע (השתמש בייחד ×¢× -alr) +**1T<x>_מטרת מערכת ההפעלה: +3*2Temx_OS/2 בשימוש EMX ( בייחד ×¢× ×”×¨×—×‘×ª EMX/RSX) +3*2Tfreebsd_FreeBSD +3*2Tgo32v2_גרסה 2 של הרחבת DJ Delorie DOS +3*2Tlinux_Linux +3*2Tnetbsd_NetBSD +3*2Tnetware_Novell Netware Module (clib) +3*2Tnetwlibc_Novell Netware Module (libc) +3*2Topenbsd_OpenBSD +3*2Tos2_OS/2 / eComStation +3*2Tsunos_SunOS/Solaris +3*2Twatcom_Watcom תו×× ×”×¨×—×‘×ª DOS +3*2Twdosx_WDOSX הרחבת DOS +3*2Twin32_Windows 32 סיביות +3*2Twince_Windows CE +4*2Tlinux_Linux +6*2Tamiga_Commodore Amiga +6*2Tatari_Atari ST/STe/TT +6*2Tlinux_Linux/m68k +6*2Tmacos_Macintosh m68k (×œ× × ×ª×ž×š) +6*2Tpalmos_PalmOS +A*2Tlinux_Linux +A*2Twince_Windows CE +P*2Tamiga_AmigaOS על PowerPC +P*2Tdarwin_Darwin ו Mac OS X על PowerPC +P*2Tlinux_Linux על PowerPC +P*2Tmacos_Mac OS (קל×סי) על PowerPC +P*2Tmorphos_MorphOS +S*2Tlinux_Linux +**1u<x>_מסיר ×ת ההגדרה של הסמל <x> +**1U_הגדרות יחידה: +**2Un_×ל תבדוק ×ת ×©× ×”×™×—×™×“×” +**2Ur_צור קבצי שחרור של יחידות +**2Us_הדר ×ת יחידת ×”system +**1v<x>_תהיה מפורט יותר. <x> הינו שילוב של ×”×ª×•×•×™× ×”×‘××™×: +**2*_e : הצג הודעות שגי××” (ברירת מחדל) +**2*_0 : ×ל תציג ×›×œ×•× (למעט הודעות שגי××”) +**2*_w : הצג ×זהרות +**2*_u : הצג מידע על יחידה +**2*_n : הצג הערות +**2*_t : הצג ×§×‘×¦×™× ×©×”×™×• בשימוש +**2*_h : הצג ×¨×ž×–×™× +**2*_c : הצג תנ××™× +**2*_i : הצג מידע כללי +**2*_d : הצג מידע לנפוי שגי×ות +**2*_l : הצג מספרי שורות +**2*_r : מצב תו×× Rhide/GCC +**2*_a : הצג הכול +**2*_x : הצג מידע על קובץ הריצה (רק בWin32) +**2*_b : כתוב הודעות ×¢× ×©×ž×•×ª ×§×‘×¦×™× ×•× ×ª×™×‘×™× ×ž×œ××™× +**2*_v : כתוב ×ת הקובץ fpcdebug.txt ×¢× ×”×¨×‘×” מידע על ניפוי שגי×ות +**2*_p : כתוב ×ת הקובץ tree.log ×¢× × ×™×ª×•×— ×¢×¥ +3*1W<x>_×פשרות מבוססת מטרה (מטרות) +A*1W<x>_×פשרות מבוססת מטרה (מטרות) +P*1W<x>_×פשרות מבוססת מטרה (מטרות) +3*2Wb_צור חבילה ×‘×ž×§×•× ×¡×¤×¨×™×™×” (Darwin) +P*2Wb_צור חבילה ×‘×ž×§×•× ×¡×¤×¨×™×™×” (Darwin) +p*2Wb_צור חבילה ×‘×ž×§×•× ×¡×¤×¨×™×™×” (Darwin) +3*2WB_צור תמונה הניתנת ×œ×ž×™×§×•× ×ž×—×•×“×© (Windows) +A*2WB_צור תמונה הניתנת ×œ×ž×™×§×•× ×ž×—×•×“×© (Windows, Symbian) +3*2WC_מציין ×פליקציה מסוג מסוף (EMX, OS/2, Windows) +A*2WC_מציין ×פליקציה מסוג מסוף (Windows) +P*2WC_מציין ×פליקציה מסוג מסוף (Classic Mac OS) +3*2WD_השתמש ב DEFFILE ×œ×™×™×¦× ×¤× ×§×¦×™×•×ª של DLL ×ו EXE (Windows) +A*2WD_השתמש ב DEFFILE ×œ×™×™×¦× ×¤× ×§×¦×™×•×ª של DLL ×ו EXE (Windows) +3*2WF_מציין ×פליקציה מסוג מסך ×ž×œ× (EMX, OS/2) +3*2WG_מציין ×פליקציה מסוג גרפי (EMX, OS/2, Windows) +A*2WG_מציין ×פליקציה מסוג גרפי (Windows) +P*2WG_מציין ×פליקציה מסוג גרפי (Classic Mac OS) +3*2WN_×ל תצור קוד משנה מיקו×, נדרש עבור ניפוי שגי×ות (Windows) +A*2WN_×ל תצור קוד משנה מיקו×, נדרש עבור ניפוי שגי×ות (Windows) +3*2WR_תיצור קוד משנה ×ž×™×§×•× (Windows) +A*2WR_תיצור קוד משנה ×ž×™×§×•× (Windows) +P*2WT_ציין ×פליקציה מסוג כלי MPW (Classic Mac OS) +**1X_הגדרות ריצה: +**2Xc_העבר --shared/-dynamic למקשר (BeOS, Darwin, FreeBSD, Linux) +**2Xd_×ל תשתמש בנתיב חיפוש הספריות הסטנדרטיות (נדרש עבור הידור ל×רכיטקטורות ×חרות) +**2Xe_השתמש במקשר חיצוני +**2XD_נסה לקשר יחידות בצורה דינ×מית (מגדיר FPC_LINK_DYNAMIC) +**2Xi_השתמש במקשר פנימי +**2Xm_צור מפת ×§×™×©×•×¨×™× +**2XM<x>_הגדר ×ת ×”×©× ×©×œ רוטינה ×”'עיקרית' של התוכנה (ברירת מחדל ×”×•× 'main') +**2XP<x>_צרף ×ת השמות ×”×ž×’×™×¢×™× ×¢Ã ×”×ª×—×™×œ×™×ª <x> מbinutils +**2Xr<x>_הגדר ×ת נתיב חיפוש הספריות ל <x> (נדרש עבור הידור ל×רכיטקטורות ×חרות) (BeOS, Linux) +**2XR<x>_צרף ×ת <x> לכל נתיבי החיפוש של המקשר (BeOS, Darwin, FreeBSD, Linux, Mac OS, Solaris) +**2Xs_נקה ×ת כל ×”×¡×ž×œ×™× ×ž×§×‘×¦×™ ההרצה +**2XS_נסה לקשר יחידות בצורה סטטית (ברירת מחדל, מגדיר FPC_LINK_STATIC) +**2Xt_קשר ×¢× ×¡×¤×¨×™×•×ª סטטיות (מעביר -static למקשר) +**2XX_תנסה לבצע smartlink ליחידות (מגדיר FPC_LINK_SMART) +**1*_ +**1?_הצג ×ת עזרה זו +**1h_הצג עזרה זו ×œ×œ× ×œ×—×›×•×ª + +] + +# +# The End... diff --git a/closures/compiler/msg/errorid.msg b/closures/compiler/msg/errorid.msg new file mode 100644 index 0000000000..4c03e14317 --- /dev/null +++ b/closures/compiler/msg/errorid.msg @@ -0,0 +1,2715 @@ +# $Id: errorid.msg,v 1.124 2007/09/20 02:52:50 zaenal Exp $ +# This file is part of the Free Pascal Compiler +# Copyright (c) 1999-2008 by the Free Pascal Development team +# +# Indonesian Language File for Free Pascal +# Contributed by Zaenal Mutaqin <ade999 at gmail.com> +# +# 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. +# +# +# The constants are build in the following order: +# <part>_<type>_<txtidentifier> +# +# <part> is the part of the compiler the message is used +# asmr_ assembler parsing +# asmw_ assembler writing/binary writers +# unit_ unit handling +# scan_ scanner +# parser_ parser +# type_ type checking +# general_ general info +# exec_ calls to assembler, linker, binder +# +# <type> the type of the message it should normally used for +# f_ fatal error +# e_ error +# w_ warning +# n_ note +# h_ hint +# i_ info +# l_ add linenumber +# u_ used +# t_ tried +# c_ conditional +# d_ debug message +# x_ executable informations +# + +# +# Umum +# +# 01023 is the last used one +# +# BeginOfTeX +% \section{Pesan kompilator umum} +% Seksi ini memberikanpesan kompilator yang tidak fatal, tapi +% menampilkan informasi berguna. Jumlah pesan itu dapat dikontrol +% dengan berbagai saklar tingkat tampilan \var{-v}. +% \begin{description} +general_t_compilername=01000_T_Kompilator: $1 +% Saat saklar \var{-vt} dipakai, baris ini memberitahu anda kompilator apa +% yang dipakai. +general_d_sourceos=01001_D_OS Kompilator: $1 +% Saat saklar \var{-vd} dipakai, baris ini memberitahu anda apa sistem operasi +% sumbernya. +general_i_targetos=01002_I_OS Target: $1 +% Saat saklar \var{-vd} dipakai, baris ini memberitahu anda apa sistem operasi +% targetnya. +general_t_exepath=01003_T_Menggunakan path executable: $1 +% Saat saklar \var{-vt} dipakai, baris ini memberitahu anda ke mana kompilator +% mencari binernya. +general_t_unitpath=01004_T_Menggunakan path unit: $1 +% Saat saklar \var{-vt} dipakai, baris ini memberitahu anda ke mana kompilator +% mencari unit terkompilasinya. Anda bisa menyetel path ini dengan \var{-Fu} +general_t_includepath=01005_T_Menggunakan path include: $1 +% Saat saklar \var{-vt} dipakai, baris ini memberitahu anda ke mana kompilator +% mencari file include-nya (file dipakai dalam pernyataan \var{\{\$I xxx\}}). +% Anda dapat menyetel path ini dengan opsi \var{-I}. +general_t_librarypath=01006_T_Menggunakan path librari: $1 +% Saat saklar \var{-vt} dipakai, baris ini memberitahu anda ke mana kompilator +% mencari librari. Anda dapat menyetel path ini dengan opsi \var{-Fl}. +general_t_objectpath=01007_T_Menggunakan path obyek: $1 +% Saat saklar \var{-vt} dipakai, baris ini memberitahu anda ke mana kompilator +% mencari file obyek yang anda link (file dipakai dalam pernyataan \var{\{\$L xxx\}}). +% Anda dapat menyetel path ini dengan opsi \var{-Fo}. +general_i_abslines_compiled=01008_I_$1 baris dikompilasi, $2 det$3 +% Saat saklar \var{-vi} dipakai, kompilator melaporkan jumlah baris yang +% dikompilasi, dan waktu yang diperlukan untuk mengompilasinya (waktu nyata, +% bukan waktu program). +general_f_no_memory_left=01009_F_Memori tidak tersisa +% Kompilator kekurangan memori untuk mengkompilasi program anda. Ada beberapa +% beberapa obat untuk hal ini: +% \begin{itemize} +% \item Jika anda menggunakan opsi pembangunan kompilator, coba mengompilasi +% unit-unit berbeda secara manual. +% \item Jika anda mengompilasi program besar, pisahkan dalam units, dan +% kompilasi ini secara terpisah. +% \item Jika kedua item sebelumnya tidak bekerja, rekompilasi kompilator dengan +% heap lebih besar (anda dapat memakai opsi \var{-Ch} untuk ini, \lihat o{Ch}) +% \end{itemize} +general_i_writingresourcefile=01010_I_Menulis file Tabel String Resource: $1 +% Pesan ini ditampilkan saat kompilator menuliskan file Resource String Table +% yang berisi semua string sumber untuk sebuah program. +general_e_errorwritingresourcefile=01011_E_Menulis file Tabel String Resource: $1 +% Pesan ini ditampilkan saat kompilator menemukan kesalahaan ketika menulis +% file Resource String Table +general_i_fatal=01012_I_Fatal: +% Prefiks untuk Kesalahan Fatal +general_i_error=01013_I_Kesalahan: +% Prefiks untuk Kesalahan +general_i_warning=01014_I_Peringatan: +% Prefiks untuk Peringatan +general_i_note=01015_I_Catatan: +% Prefiks untuk Catatan +general_i_hint=01016_I_Petunjuk: +% Prefiks untuk Petunjuk +general_e_path_does_not_exist=01017_E_Path "$1" tidak ada +% Path yang ditetapkan tidak ada. +general_f_compilation_aborted=01018_F_Kompilasi dibatalkan +% Kompilasi sudah dibatalkan. +general_text_bytes_code=01019_byte kode +general_text_bytes_data=01020_byte data +general_i_number_of_warnings=01021_I_$1 peringatan diterbitkan +% Jumlah peringatan yang diterbitkan selama kompilasi. +general_i_number_of_hints=01022_I_$1 petunjuk diterbitkan +% Jumlah petunjuk yang diterbitkan selama kompilasi. +general_i_number_of_notes=01023_I_$1 catatan diterbitkan +% Jumlah catatan yang diterbitkan selama kompilasi. +% \end{description} +# +# Scanner +# +# 02084 is the last used one +# +% \section{Pesan pemindai.} +% Seksi ini mendaftarkan pesan-pesan yang dikeluarkan pemindai. Pemindai +% memelihara struktur leksikal atas file pascal, misalnya ia mencoba menemukan +% kata-kata terpakai, string, dll. Ia juga memelihara direktif dan penanganan +% kompilasi kondisional. +% \begin{description} +scan_f_end_of_file=02000_F_Akhir file tidak diharapkan +% Ini biasanya terjadi dalam salah satu kasus berikut : +% \begin{itemize} +% \item File sumber berakhir sebelum pernyataan \var{end.} final. Ini +% terjadi umumnya saat pernyataan \var{begin} dan \var{end} tidak +% seimbang; +% \item File include berakhir ditengah-tengah sebuah pernyataan. +% \item Sebuah komentar tidak ditutup +% \end{itemize} +scan_f_string_exceeds_line=02001_F_String melebihi baris +% Kekurangan penutup ' dalam sebuah string, maka ia melibatkan +% multipel baris. +scan_f_illegal_char=02002_F_Karakter tidak benar "$1" ($2) +% Sebuah karakter yang ditemukan tidak benar dalam file input. +scan_f_syn_expected=02003_F_Sintaks salah, "$1" diharapkan tetapi "$2" ditemukan +% Ini menunjukan bahwa kompilator mengharapkan token yang berbeda daripada +% yang anda ketikan. Ini bisa terjadi hampir di manapun anda membuat sebuah +% kesalahan terhadap bahasa pascal. +scan_t_start_include_file=02004_TL_Mulai membaca file include $1 +% Ketika anda menyediakan saklar \var{-vt}, kompilator memberitahu anda +% kapan ia mulai membaca sebuah file yang disertakan. +scan_w_comment_level=02005_W_Tingkat komentar $1 ditemukan +% Saat saklar \var{-vw} dipakai, maka kompilator memperingatkan anda bila +% ia menemukan komentar berulang. Komentar berulang tidak dibolehkan dalam +% Turbo Pascal dan mungkin menjadi sumber kesalahan. +scan_n_ignored_switch=02008_N_Saklar kompilator "$1" diabaikan +% Dengan \var{-vn} hidup, kompilator memperingatkan bila ia mengabaikan saklar +scan_w_illegal_switch=02009_W_Saklar kompilator "$1" tidak benar +% Anda menyertakan saklar kompilator (misalnya \var{\{\$... \}}) yang tidak +% dikenal oleh kompilator +scan_w_switch_is_global=02010_W_Saklar global kompilator salah tempat +% Saklar kompilator salah menempatkan, anda harus ditempatkan di awal +% unit atau program. +scan_e_illegal_char_const=02011_E_Konstan char tidak benar +% Ini terjadi saat anda menetapkan karakter dengan kode ASCII-nya, seperti +% dalam \var{\#96}, tapi angka baik tidak benar ataupun di luar jangkauan. +scan_f_cannot_open_input=02012_F_Tidak bisa membuka file "$1" +% \fpc todal dapat menemukan program atau file sumber unit yang anda tetapkan +% pada baris perintah. +scan_f_cannot_open_includefile=02013_F_Tidak bisa membuka file include "$1" +% \fpc tidak bisa menemukan file sumber yang anda tetapkan dalam pernyataan +% \var{\{\$include ..\}}. +scan_e_illegal_pack_records=02015_E_Pembeda penjajaran record "$1" +% Anda menetapkan \var{\{\$PACKRECORDS n\} } atau \var{\{\$ALIGN n\} } +% dengan nilai tidak benar untuk \var{n}. Penjajaran yang benar untuk \$PACKRECORDS adalah 1, 2, 4, 8, 16, 32, C, +% NORMAL, DEFAULT, dan penjajaran yang benar untuk \$ALIGN adalah 1, 2, 4, 8, 16, 32, ON, +% OFF. Di bawah mode MacPas \$ALIGN juga mendukung MAC68K, POWER dan RESET. +scan_e_illegal_pack_enum=02016_E_Pembeda besar-minimum enum "$1" tidak benar +% Anda menetapkan \var{\{\$PACKENUM n\}} dengan nilai yang tidak benar untuk +% \var{n}. Hanya 1,2,4, NORMAL atau DEFAULT yang benar di sini. +scan_e_endif_expected=02017_E_$ENDIF diharapkan untuk $1 $2 didefinisikan dalam $3 baris $4 +% Pernyataan kompilasi kondisional anda tidak seimbang. +scan_e_preproc_syntax_error=02018_E_Sintaks salah saat mengurai ekspresi kompilasi kondisional +% Ini adalah kesalahan dalam ekspresi mengikuti direktori kompilator \var{\{\$if ..\}}, +% $ifc atau $setc. +scan_e_error_in_preproc_expr=02019_E_Mengevaluasi ekspresi kompilasi kondisional +% Ini adalah kesalahan dalam ekspresi mengikuti direktori kompilator \var{\{\$if ..\}}, +% $ifc atau $setc. +scan_w_macro_cut_after_255_chars=02020_W_Panjang isi makro dibatasi 255 karakter +% Isi dari makro tidak bisa lebih panjang dari 255 karakter. +scan_e_endif_without_if=02021_E_ENDIF tanpa IF(N)DEF +% Pernyataan \var{\{\$IFDEF ..\}} dan {\{\$ENDIF\}} anda tidak seimbang. +scan_f_user_defined=02022_F_Didefinisikan pengguna: $1 +% Yang didefinisikan pengguna terjadi kesalahan fatal. Lihat juga \progref +scan_e_user_defined=02023_E_Didefinisikan pengguna: $1 +% Kesalahanyang didefinisikan pengguna terjadi. Lihat juga \progref +scan_w_user_defined=02024_W_Didefinisikan pengguna: $1 +% Peringtan yang didefinisikan pengguna ditemukan. Lihat juga \progref +scan_n_user_defined=02025_N_Didefinisikan pengguna: $1 +% Catatan yang didefinisikan pengguna ditemukan. Lihat juga \progref +scan_h_user_defined=02026_H_Didefinisikan pengguna: $1 +% Petunjuk yang didefinisikan pengguna ditemukan. Lihat juga \progref +scan_i_user_defined=02027_I_Didefinisikan pengguna: $1 +% Informasi yang didefinisikan pengguna ditemukan. Lihat juga \progref +scan_e_keyword_cant_be_a_macro=02028_E_Kata kunci didefiniskan ulang sebagai makro tidak berpengaruh +% Anda tidak dapat mendefinisikan kata kunci dengan makro. +scan_f_macro_buffer_overflow=02029_F_Bufer makro berlebihan saat membaca atau melebarkan makro +% Makro anda atau hasilnya terlalu panjang bagi kompilator. +scan_w_macro_too_deep=02030_W_Pelebaran makro melebihi kedalaman 16. +% Ketika melebarkan sebuah makro, makro diulang sampai tingkat 16. +% Kompilator tidak akan melebarkannya lagi, karena ini berupa tanda bahwa +% rekursi yang digunakan. +scan_w_wrong_styled_switch=02031_W_Saklar kompilator tidak didukung dalam gaya komentar // +% Saklar kompilator harus dalam komentar gaya pascal normal. +scan_d_handling_switch=02032_DL_Penanganan saklar "$1" +% Ketika anda menyetel info debugging pada (\var{-vd}) kompilator memberitahu +% anda saatia mengevaluasi pernyataan kompilasi kondisional. +scan_c_endif_found=02033_CL_ENDIF $1 ditemukan +% Ketika anda menghidupkan pesan kondisional (\var{-vc}), kompilator memberitahu +% anda di aman ia menemukanpernyataan kondisional. +scan_c_ifdef_found=02034_CL_IFDEF $1 ditemukan, $2 +% Ketika anda menghidupkan pesan kondisioinal (\var{-vc}), kompilator memberitahu +% anda di mana ia menemukan pernyataan kondisional. +scan_c_ifopt_found=02035_CL_IFOPT $1 ditemukan, $2 +% Ketika anda menghidupkan pesan kondisioinal (\var{-vc}), kompilator memberitahu +% anda di mana ia menemukan pernyataan kondisional. +scan_c_if_found=02036_CL_IF $1 ditemukan, $2 +% Ketika anda menghidupkan pesan kondisioinal (\var{-vc}), kompilator memberitahu +% anda di mana ia menemukan pernyataan kondisional. +scan_c_ifndef_found=02037_CL_IFNDEF $1 ditemukan, $2 +% Ketika anda menghidupkan pesan kondisioinal (\var{-vc}), kompilator memberitahu +% anda di mana ia menemukan pernyataan kondisional. +scan_c_else_found=02038_CL_ELSE $1 ditemukan, $2 +% Ketika anda menghidupkan pesan kondisioinal (\var{-vc}), kompilator memberitahu +% anda di mana ia menemukan pernyataan kondisional. +scan_c_skipping_until=02039_CL_Melewati sampai... +% Ketika anda menghidupkan pesan kondisioinal (\var{-vc}), kompilator memberitahu +% anda di mana ia menemukan pernyataan kondisional, dan apakah ia melewati atau +% mengompilasi bagiannya. +scan_i_press_enter=02040_I_Tekan <return> untuk melanjutkan +% Saat saklar \var{-vi} dipakai, kompilator berhenti mengompilasi dan menunggu +% tombol \var{Enter} ditekan bila ia menemukan direktif +% \var{\{\$STOP\}}. +scan_w_unsupported_switch=02041_W_Saklar "$1" tidak didukung +% Saat peringatan dihidupkan (\var{-vw}) kompilator memperingatkan anda tentang +% saklar yang tidak didukung. Ini berarti bahwa saklar yang dipakai dalam Delphi +% atau Turbo Pascal, tetapi tidak dalam \fpc +scan_w_illegal_directive=02042_W_Direktif kompilator "$1" tidak benar +% Saat peringatan dihidupkan (\var{-vw}) kompilator memperingatkan anda tentang +% saklar yang tidak dikenal. Untuk daftar saklar yang dikenal, \progref +scan_t_back_in=02043_TL_Kembali dalam $1 +% Saat anda memakai (\var{-vt}) kompilator memberitahu anda kapan ia selesai +% membaca sebuah file include. +scan_w_unsupported_app_type=02044_W_Tipe aplikasi tidak didukung: "$1" +% Anda mendapat peringatan ini, jika anda menetapkan tipe aplikasi tidak dikenal +% dengan direktif \var{\{\$APPTYPE\}} +scan_w_app_type_not_support=02045_W_APPTYPE tidak didukung oleh OS target +% Direktif \var{\{\$APPTYPE\}} hanya didukung oleh sistem operasi tertentu. +scan_w_description_not_support=02046_W_DESCRIPTION tidak didukung oleh OS target +% Direktif \var{\{\$DESCRIPTION\}} tidak didukung pada OS target ini +scan_n_version_not_support=02047_N_VERSION tidak didukung oleh OS target +% Direktif \var{\{\$VERSION\}} tidak didukung pada OS target ini +scan_n_only_exe_version=02048_N_VERSION hanya untuk EXE atau DLL +% Direktif \var{\{\$VERSION\}} hanya dipakai untuk executable atau sumber DLL. +scan_w_wrong_version_ignored=02049_W_Format salah untuk direktif VERSION "$1" +% Format direktif \var{\{\$VERSION\}} adalah versiutama.versiminor +% di mana versiutama dan versiminor adalah word. +scan_e_illegal_asmmode_specifier=02050_E_Gaya assembler yang ditetapkan "$1" tidak benar +% Ketika anda menetapkan mode assembler dengan \var{\{\$ASMMODE xxx\}} +% kompilator tidak mengenal mode yang anda tetapkan. +scan_w_no_asm_reader_switch_inside_asm=02051_W_Saklar pembaca ASM tidak mungkin di dalam pernyataan asm, "$1" hanya efektif untuk next +% Tidak mungkin untuk beralih dari satu pembaca assembler ke yang lainnya +% di dalam blok assembler. Pembaca baru hanya akan dipakai untuk pernyataan +% assembler next saja. +scan_e_wrong_switch_toggle=02052_E_Saklar toggle salah, gunakan ON/OFF atau +/- +% Anda perlu menggunakan ON atau OFF atau + atau - untuk menghidup matikan saklar +scan_e_resourcefiles_not_supported=02053_E_File resource tidak didukung untuk target ini +% Target yang anda kompilasi tidak mendukung file resource. +scan_w_include_env_not_found=02054_W_Lingkungan include "$1" tidak ditemukan dalam lingkungan +% Variabel lingkungan yang disertakan tidak ditemukan dalam lingkungan, sebaliknya +% ia akan diganti dengan string kosong. +scan_e_invalid_maxfpureg_value=02055_E_Nilai batas register FPU tidak benar +% Nilai yang benar untuk direktif ini adalah 0..8 dan NORMAL/DEFAULT +scan_w_only_one_resourcefile_supported=02056_W_Hanya satu file resource didukung untuk target ini +% Target yang anda kompilasi hanya mendukung satu file resource. +% File resource pertama yang ditemukan akan dipakai, yuang lain diabaikan. +scan_w_macro_support_turned_off=02057_W_Dukungan makro telah dimatikan +% Deklarasi makro ditemukan, tapi dukungan makro sudah dimatikan, +% maka deklarasi akan diabaikan. Untuk menghidupkan dukungan makro, kompilasi dengan +% -Sm pada baris perintah atau tambah \{\$MACRO ON\} dalam sumber file +scan_e_invalid_interface_type=02058_E_Tipe antarmuka yang ditetapkan tidak benar. Yang benar COM, CORBA atau DEFAULT. +% Tipe antarmuka yang ditetapkan tidak didukung +scan_w_appid_not_support=02059_W_APPID hanya didukung pada PalmOS +% Direktif \var{\{\$APPID\}} hanya didukung jika target PalmOS. +scan_w_appname_not_support=02060_W_APPNAME hanya didukung oleh PalmOS +% Direktif \var{\{\$APPNAME\}} hanya didukung oleh target PalmOS. +scan_e_string_exceeds_255_chars=02061_E_Konstan string tidak boleh lebih panjang dari 255 karakter +% Konstan string tunggal dapat berisi paling banyak 255 karakter. Coba untuk +% memisahkan string dalam bagian multipel lebih kecil dan tambah dengan operator +. +scan_f_include_deep_ten=02062_F_Menyertakan file include melebihi kedalaman 16. +% Ketika menyertakan file include, file sudah diulang ke tingkat 16. +% Kompilator tidak akan melebarkannya lagi, karena ini sebagai tanda bahwa +% rekursi yang dipakai. +scan_e_too_many_push=02063_F_Terlalu banyak tingkat PUSH +% Maksimum 20 tingkat dibolehkan. Kesalahan ini hanya terjadi dalam mode MacPas. +scan_e_too_many_pop=02064_E_POP tanpa didahului PUSH +% Kesalahan ini hanya terjadi dalam mode MacPas. +scan_e_error_macro_lacks_value=02065_E_Makro atau variabel waktu kompilasi "$1" tidak memiliki nilai +% Ekspresi waktu kompilasi kondisional tidak bisa dievaluasi. +scan_e_wrong_switch_toggle_default=02066_E_Saklar toggle salah, gunakan ON/OFF/DEFAULT atau +/-/* +% Anda perlu menggunakan ON atau OFF atau DEFAULT atau + atau - atau * untuk men-toggle saklar +scan_e_mode_switch_not_allowed=02067_E_Saklar mode "$1" tidak diijinkan di sini +% Saklar mode sudah ditemukan, atau dalam hal opsi -Mmacpas, +% saklar mode terjadi setelah UNIT. +scan_e_error_macro_undefined=02068_E_Variabel waktu kompilasi atau makro "$1" tidak didefinisikan. +% Ekspresi waktu kompilasi kondisional tidak bisa dievaluasi. Hanya dalam mode MacPas. +scan_e_utf8_bigger_than_65535=02069_E_Kode UTF-8 lebih besar dari 65535 ditemukan +% \fpc menangani string utf-8 secara internal sebagai widestring misalnya kode karakter dibatasi ke 65535 +scan_e_utf8_malformed=02070_E_String UTF-8 salah bentuk +% String yang diberikan bukan string UTF-8 yang benar +scan_c_switching_to_utf8=02071_C_Tanda UTF-8 ditemukan, menggunakan enkode UTF-8 +% Kompilator menemukan tanda enkode UTF-8 (\$ef, \$bb, \$bf) di awal file, +% maka ia menganggapnya sebagai file UTF-8 +scan_e_compile_time_typeerror=02072_E_Ekspresi waktu kompilasi: Diinginkan $1 tapi didapat $2 pada $3 +% Pemeriksaan tipe pada ekspresi waktu kompilasi gagal. +scan_n_app_type_not_support=02073_N_APPTYPE tidak didukung oleh OS target +% Direktif \var{\{\$APPTYPE\}} hanya didukung oleh sistem operasi tertentu. +scan_e_illegal_optimization_specifier=02074_E_Optimasi yang ditetapkan "$1" tidak benar +% Ketika anda menetapkan optimasi dengan \var{\{\$OPTIMIZATION xxx\}} +% kompilator tidak mengenali optimasi yang anda tetapkan. +scan_w_setpeflags_not_support=02075_W_SETPEFLAGS tidak didukung oleh OS target +% Direktif \var{\{\$SETPEFLAGS\}} tidak didukung oleh OS target +scan_w_imagebase_not_support=02076_W_IMAGEBASE tidak dudkung oleh OS target +% Direktif \var{\{\$IMAGEBASE\}} tidak dudkung oleh OS target +scan_w_minstacksize_not_support=02077_W_MINSTACKSIZE tidak dudkung oleh OS target +% Direktif \var{\{\$MINSTACKSIZE\}} tidak dudkung oleh OS target +scan_w_maxstacksize_not_support=02078_W_MAXSTACKSIZE tidak dudkung oleh OS target +% Direktif \var{\{\$MAXSTACKSIZE\}} tidak dudkung oleh OS target +scanner_e_illegal_warn_state=02079_E_Kondisi direktif $WARN tidak benar +% Hanya ON dan OFF bisa dipakai sebagai kondisi dengan direktif kompilator \$warn +scan_e_only_packset=02080_E_Nilai set packing tidak benar +% Hanya 0, 1, 2, 4, 8, DEFAULT dan NORMAL diijinkan sebagai parameter packset +scan_w_pic_ignored=02081_W_Direktif PIC atau saklar diabaikan +% Beberapa target seperti windows tidak mendukung PIC maka direktif PIC dan +% saklar diabaikan. +scan_w_unsupported_switch_by_target=02082_W_Saklar "$1" tidak didukung oleh target yang dipilih saat ini +% Beberapa saklar kompilator seperti \$E tidak didukung oleh semua target. +scan_w_frameworks_darwin_only=02084_W_Opsi terkait-framework hanya didukung oleh Darwin/Mac OS X +% Frameworks bukan konsep yang dikenal, atau setidaknya didukung oleh FPC, pada sistem operasi selain Darwin/Mac OS X. +scan_e_illegal_minfpconstprec=02085_E_Konstan presisi pecahan minimal "$1" tidak benar +% Presisi minimal yang benar untuk konstan floating point adalah standar, 32 dan 64, yang berarti masing-masing presisi minimal (biasanya 32 bit), 32 bit dan 64 bit. +% \end{description} +# +# Parser +# +# 03235 is the last used one +# +% \section{Pesan pengurai} +% Seksi ini mendaftarkan semua pesan pengurai. Pengurai memelihara semantik +% atas bahasa anda, misalnya ia menentukan apakah konstruksi pascal anda +% sudah benar atau tidak. +% \begin{description} +parser_e_syntax_error=03000_E_Pengurai - Sintaks Salah +% Kesalahan terhadap bahasa Turbo Pascal ditemukan. Ini terjadi biasanya +% saat karakter tidak benar ditemukan dalam file sumber. +parser_e_dont_nest_interrupt=03004_E_Prosedur INTERRUPT tidak bisa diulang +% Prosedur \var{INTERRUPT} harus global. +parser_w_proc_directive_ignored=03005_W_Tipe prosedur "$1" diabaikan +% Direktif procedure yang dietapkan diabaikan oleh program FPC. +parser_e_no_overload_for_all_procs=03006_E_Tidak semua deklarasi "$1" dideklarasikan dengan OVERLOAD +% Ketika anda ingin menggunakan direktif \var{OVERLOAD}, maka semua +% deklarasi perlu menetapkan \var{OVERLOAD}. +parser_e_export_name_double=03008_E_Duplikasi nama fungsi yang diekspor "$1" +% Nama-nama fungsi yang diekspor di dalam DLL tertentu semuanya harus berbeda +parser_e_export_ordinal_double=03009_E_Duplikasi indeks fungsi yang diekspor $1 +% Indeks fungsi yang diekspor di dalam DLL tertentu semuanya harus berbeda +parser_e_export_invalid_index=03010_E_Indeks untuk fungsi yang diekspor tidak benar +% Indeks fungsi DLL harus dalam jangkauan \var{1..\$FFFF} +parser_w_parser_reloc_no_debug=03011_W_DLL yang bisa direlokasi atau info debug executable $1 tidak bekerja, dimatikan. +parser_w_parser_win32_debug_needs_WN=03012_W_Untuk membolehkan men-debug pada kode win32 anda perlu mematikan relokasi dengan opsi -WN +% Info stab salah untuk DLL atau EXE yang bisa direlokasi, gunakan -WN +% jika anda ingin men-debug win32 executable. +parser_e_constructorname_must_be_init=03013_E_Nama konstruktor harus INIT +% Anda mendeklarasikan konstruktor obyek dengan nama yang bukan \var{init}, dan +% saklar \var{-Ss} dipakai. Lihat saklar \var{-Ss} (\seeo{Ss}). +parser_e_destructorname_must_be_done=03014_E_Nama destruktor harus DONE +% Anda mendeklarasikan destruktor obyek yang bukan \var{done}, dan saklar +% \var{-Ss} dipakai. Lihat saklar \var{-Ss} (\seeo{Ss}). +parser_e_proc_inline_not_supported=03016_E_Tipe prosedur INLINE tidak didukung +% Anda mencoba untuk mengompilasi program dengan gaya inline C++, dan lupa +% menetapkan opsi \var{-Si} (\seeo{Si}). Standarnya kompilator tidak mendukung +% gaya inline C++. +parser_w_constructor_should_be_public=03018_W_Konstruktor harus public +% Konstruktor harus dalam bagian 'public' pada sebuah deklarasi obyek (class). +parser_w_destructor_should_be_public=03019_W_Destruktor harus public +% Destruktor harus dalam bagian 'public' pada sebuah deklarasi obyek (class). +parser_n_only_one_destructor=03020_N_Class harus memiliki hanya satu destruktor +% Anda dapat mendeklarasikan hanya satu destruktor untuk sebuah kelas. +parser_e_no_local_objects=03021_E_Definisi kelas lokal tidak dibolehkan +% Kelas harus didefinisikan secara global. Tidak bisa didefinisikan di dalam +% sebuah procedure atau function +parser_f_no_anonym_objects=03022_F_Definisi kelas anonim tidak dibolehkan +% Deklarasi obyek (class) tidak benar ditemukan, misalnya obyek atau kelas +% tanpa metode yang tidak berasal dari obyek atau kelas +% Sebagai contoh: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% akan memicu kesalahan ini. +parser_n_object_has_no_vmt=03023_N_Obyek "$1" tidak memiliki VMT +% Ini adalah sebuah catatan yang menunjukan bahwa obyek yang dideklarasikan +% tidak memiliki tabel metode virtual. +parser_e_illegal_parameter_list=03024_E_Daftar parameter tidak benar +% Anda memanggil sebuah fungsi dengan parameter yang tipenya berbeda dengan +% yang parameternya dideklarasikan pada fungsi. +parser_e_wrong_parameter_size=03026_E_Jumlah parameter salah yang ditetapkan untuk memanggil "$1" +% Ada kesalahan dalam daftar parameter pada fungsi atau prosedur, +% jumlah parameter tidak benar. +parser_e_overloaded_no_procedure=03027_E_pembeda yang di-overload "$1" bukan sebuah fungsi +% Kompilator menemukan simbol dengan nama sama seperti fungsi yang di-overload, +% tapi ia bukan sebuah fungsi yang bisa di-overload. +parser_e_overloaded_have_same_parameters=03028_E_fungsi yang di-overload memiliki daftar parameter sama +% Anda mendeklarasikan fungsi yang di-overload, tapi dengan daftar parameter yang sama. +% Fungsi yang di-overload harus memiliki setidaknya 1 parameter berbeda dalam +% deklarasinya. +parser_e_header_dont_match_forward=03029_E_Header fungsi tidak sama dengan deklarasi "$1" sebelumnya +% Anda mendeklarasikan sebuah fungsi dengan parameter yang sama tetapi +% tipe hasil atau pengubah fungsi berbeda. +parser_e_header_different_var_names=03030_E_header fungsi "$1" tidak sama yang didepan : nama var berubah $2 => $3 +% Anda mendeklarasikan fungsi dalam bagian \var{interface}, atau dengan direktif +% \var{forward}, tapi mendefinisikannya dengan daftar parameter yang berbeda. +parser_n_duplicate_enum=03031_N_Nilai dalam tipe enumerasi harus membesar +% \fpc membolehkan konstruksi enumeration seperti dalam C. Contoh berikut +% mendeklarasikan dua deklarasi: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% Deklarasi kedua akan menghasilkan kesalahan. \var{A\_UAS} perlu mempunyai +% nilai lebih tinggi daripada \var{A\_E}, misalnya minimal 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_With tidak bisa dipakai untuk variabel dalam segmen berbeda +% With menyimpan variabel secara lokal pada stack, tapi ini tidak mungkin +% jika variabel dimiliki oleh segmen lain. +parser_e_too_much_lexlevel=03034_E_pengulangan fungsi > 31 +% Anda dapat mengulang definisi function hanya 31 kali. +parser_e_range_check_error=03035_E_kesalahan pemeriksaan jangkauan saat mengevaluasi konstan +% Konstan di luar dari jangkauan yang dibolehkan. +parser_w_range_check_error=03036_W_kesalahan pemeriksaan jangkauan saat mengevaluasi konstan +% Konstan di luar dari jangkauan yang dibolehkan. +parser_e_double_caselabel=03037_E_duplikasi label case +% Anda menetapkan label yang sama 2 kali dalam pernyataan \var{case}. +parser_e_case_lower_less_than_upper_bound=03038_E_Batas atas jangkauan case kurang dari batas bawah +% Batas atas dari label \var{case} kurang dari batas lebih bawah dan ini +% sia-sia +parser_e_type_const_not_possible=03039_E_Tipe konstan pada kelas atau interfaces tidak dibolehkan +% Anda tidak bisa mendeklarasikan konstan dari tipe class atau object. +parser_e_no_overloaded_procvars=03040_E_variabel fungsi pada fungsi yang di-overload tidak dibolehkan +% Anda mencoba untuk menempatkan fungsi yang di-overload ke variabel prosedural. +% Ini tidak dibolehkan +parser_e_invalid_string_size=03041_E_panjang string harus berupa nilai dari 1 sampai 255 +% Panjang shortstring dalam Pascal dibatasi 255 karakter. Anda mencoba untuk +% mendeklarasikan string dengan panjang lebih rendah dari 1 atau lebih besar dari 255 +parser_w_use_extended_syntax_for_objects=03042_W_gunakan sintaks diperluas NEW dan DISPOSE untuk turunan obyek +% Jika anda mempunyai pointer \var{a} ke tipe kelas, maka pernyataan +% \var{new(a)} tidak akan menginisialisasi kelas (misalnya konstruktor tidak +% dipanggil), meskipun ruang akan dialokasikan. Anda harus menerbitkan pernyataan +% \var{new(a,init)}. Ini akan mengalokasikan ruang, dan memanggil konstruktor +% obyek +parser_w_no_new_dispose_on_void_pointers=03043_W_Menggunakan NEW atau DISPOSE untuk pointer untyped sia-sia +parser_e_no_new_dispose_on_void_pointers=03044_E_Menggunakan NEW atau DISPOSE tidak mungkin untuk pointer untyped +% Anda tidak bisa menggunakan \var{new(p)} atau \var{dispose(p)} jika \var{p} adalah pointer untyped +% karena tidak ada ukuran yang terkait dengan pointer untyped. +% Diterima untuk kompatibilitas dalam mode \var{tp} dan \var{delphi}. +parser_e_class_id_expected=03045_E_pengenal kelas diharapkan +% Ini terjadi saat kompilator memindai deklarasi procedure yang berisi +% sebuah titik, +% misalnya, metode obyek atau kelas, tapi tipe di depan titik bukan +% tipe yang dikenal. +parser_e_no_type_not_allowed_here=03046_E_pengenal type tidak dibolehkan di sini +% Anda tidak bisa menggunakan sebuah type di dalam ekspresi. +parser_e_methode_id_expected=03047_E_pengenal metode diharapkan +% Pengenal ini bukan sebuah metode. +% Ini terjadi saat kompilator memindai deklarasi sebuah procedure yang berisi +% sebuah titik, misalnya nama obyek atau kelas, tapi nama prosedure bukan +% prosedur dari tipe ini. +parser_e_header_dont_match_any_member=03048_E_header fungsi tidak ada yang menyamai metode pada kelas "$1" +% Pengenal ini bukan sebuah metode. +% Ini terjadi saat kompilator memindai deklarasi prosedur yang berisi sebuah +% titik, misalnya nama obyek atau kelas, tapi nama prosedure bukan +% prosedur dari tipe ini. +parser_d_procedure_start=03049_DL_procedure/function $1 +% Ketika menggunakan saklar \var{-vd}, kompilator memberitahu anda saat ia mulai +% memproses sebuah implementasi procedure atau function. +parser_e_error_in_real=03050_E_Konstan floating point tidak benar +% Kompilator mengharapkan ekspresi floating point, dan mendapatkan yang lain. +parser_e_fail_only_in_constructor=03051_E_FAIL hanya dapat dipakai dalam konstruktor +% Anda menggunakan kata kunci \var{fail} di luar metode konstruktor. +parser_e_no_paras_for_destructor=03052_E_Destruktor tidak bisa mempunyai parameter +% Anda mendeklarasikan sebuah destruktor dengan daftar parameter. Metode destruktor +% tidak bisa memiliki parameter. +parser_e_only_class_methods_via_class_ref=03053_E_Hanya metode kelas dapat dirujuk dengan referensi kelas +% Kesalahan ini terjadi dalam situasi seperti berikut: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} bukan metode kelas dan tidak bisa dipanggil dengan referensi +% kelas. +parser_e_only_class_methods=03054_E_Hanya metode kelas bisa diakses dalam metode kelas +% Ini terkait dengan kesalahan sebelumnya. Anda tidak bisa memanggil metode obyek dari +% dalam metode kelas. Kode berikut akan menghasilkan kesalahan ini: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% Karena free adalah metode normal sebuah kelas, ia tidak bisa dipanggil dari +% metode kelas. +parser_e_case_mismatch=03055_E_Tipe konstan dan CASE tidak sama +% Salah satu label tidak memiliki tipe yang sama seperti variabel case. +parser_e_illegal_symbol_exported=03056_E_Simbol tidak bisa diekspor dari sebuah librari +% Anda hanya bisa mengekspor prosedur dan fungsi saat anda menulis sebuah librari. Anda +% tidak bisa mengekspor variabel atau konstan. +parser_w_should_use_override=03057_W_Metode yang diturunkan tidak terlihat oleh "$1" +% Metode yang dideklarasikan \v ar{virtual} dalam kelas leluhur, harus diganti +% dalam kelas turunannya dengan direktif \var{override}. Jika anda tidak +% menetapkan direktif \var{override}, anda akan menyembunyikan metode leluhur; +% anda tidak akan menggantinya. +parser_e_nothing_to_be_overridden=03058_E_Tidak ada metode dalam kelas leluhur untuk diganti: "$1" +% Anda mencoba untuk \var{override} sebuah metode virtual pada kelas leluhur yang tidak +% ada. +parser_e_no_procedure_to_access_property=03059_E_Tidak ada anggota yang disediakan untuk mengakses properti +% Anda tidak menetapkan direktif \var{read} untuk sebuah properti. +parser_w_stored_not_implemented=03060_W_Direktif properti tersimpan belum diimplementasikan +% Direktif \var{stored} belum diimplementasikan +parser_e_ill_property_access_sym=03061_E_Simbol tidak benar untuk akses properti +% Ada kesalahan dalam direktif \var{read} atau \var{write} untuk sebuah properti +% array. Ketika anda mendeklarasikan sebuah properti array, anda hanya bisa +% mengaksesnya dengan prosedur atau fungsi. Kode berikut akan membuat kesalahan +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_Tidak bisa mengakses field protected pada obyek di sini +% Field yang dideklarasikan dalam seksi \var{protected} pada deklarasi obyek +% atau kelas tidak bisa diakses dari luar modul di mana obyek itu +% didefinisikan, atau di luar metode obyek turunannya. +parser_e_cant_access_private_member=03063_E_Tidak bisa mengakses field private pada obyek di sini +% Field yang dideklarasikan dalam seksi \var{private} pada deklarasi obyek +% atau kelas tidak bisa diakses dari luar modul di mana obyek itu +% didefinisikan, atau di luar metode obyek turunannya. +parser_e_overridden_methods_not_same_ret=03066_E_Metode yang diganti harus mengembalikan tipe: "$2" diganti oleh "$1" yang menghasilkan tipe lain +% Jika anda mendeklarasikan metode pengganti dalam definisi kelas, keduanya harus +% memiliki tipe hasil yang sama. +parser_e_dont_nest_export=03067_E_Fungsi yang dideklarasikan EXPORT tidak bisa diulang +% Anda tidak bisa mendeklarasikan sebuah fungsi atau prosedur di dalam function atau +% procedure yang sudah dideklarasikan sebagai prosedur ekspor. +parser_e_methods_dont_be_export=03068_E_Method tidak bisa DIEKSPOR +% Anda tidak bisa mendeklarasikan procedure yang metode obyeknya bisa +% di-\var{export}. +parser_e_call_by_ref_without_typeconv=03069_E_Panggilan dengan var untuk arg no. $1 harus sama persis: Didapat "$2" diharapkan "$3" +% Ketika memanggil fungsi yang dideklarasikan dengan parameter \var{var}, variabel +% dalam pemanggil fungsi harus tipe yang persis sama. Tidak ada konversi tipe +% otomatis. +parser_e_no_super_class=03070_E_Kelas bukan kelas leluhur dari kelas saat ini +% Ketika memanggil metode turunan, anda mencoba untuk memanggil metode kelas +% tidak berkaitan. Anda hanya dapat memanggil metode turunan dari kelas leluhurnya. +parser_e_self_not_in_method=03071_E_SELF hanya dibolehkan dalam metode +% Anda mencoba menggunakan parameter \var{self} di luar metode obyek. +% Hanya metode yang dioper parameter \var{self}. +parser_e_generic_methods_only_in_methods=03072_E_Metode hanya bisa dalam metode lain memanggil secara langsung dengan pengenal tipe kelas +% Konstruksi seperti \var{sometype.somemethod} hanya dibolehkan dalam sebuah metode. +parser_e_illegal_colon_qualifier=03073_E_Penggunaan ':' tidak benar +% Ada menggunakan format \var{:} (titik dua) 2 kali pada ekspresi yang +% bukan ekspresi real. +parser_e_illegal_set_expr=03074_E_Kesalahan pemeriksaan jangkauan dalam set konstruktor atau duplikasi set elemen +% Deklarasi dari sebuah set berisi kesalahan. Baik salah satu elemen di luar +% jangkauan dari set type, atau dua elemen sebenarnya +% sama. +parser_e_pointer_to_class_expected=03075_E_Pointer pada obyek diharapkan +% Anda menetapkan tipe yang tidak benar dalam pernyataan \var{new}. +% Sintaks diperluas dari \var{new} memerlukan obyek sebagai parameter. +parser_e_expr_have_to_be_constructor_call=03076_E_Ekspresi harus panggilan konstruktor +% Ketika menggunakan sintaks diperluas \var{new}, anda harus menetapkan metode +% konstruktor dari obyek yang sedang anda coba buat. Prosedur yang anda tetapkan +% bukan sebuah konstruktor. +parser_e_expr_have_to_be_destructor_call=03077_E_Ekspresi harus panggilan destruktor +% Ketika menggunakan sintaks diperluas \var{dispose}, anda harus menetapkan +% metode destructor dari obyek yang sedang anda coba dispose. +% Prosedure yang anda tetapkan bukan sebuah destruktor. +parser_e_invalid_record_const=03078_E_Urutan elemen record tidak benar +% Ketika mendeklarasikan konstan record, anda menetapkan field dalam urutan +% yang salah. +parser_e_false_with_expr=03079_E_Tipe ekspresi harus tipe kelas atau record +% Pernyataan \var{with} memerlukan argumen yang tipenya adalah \var{record} +% atau \var{class}. Anda mencoba menggunakan \var{with} pada ekspresi yang +% bukan tipe ini. +parser_e_void_function=03080_E_Prosedur tidak mengembalikan nilai +% Dalam \fpc, anda dapat menetapkan nilai balik untuk sebuah fungsi saat +% memakai pernyataan \var{exit}. Kesalahan ini terjadi ketika anda mencoba untuk +% melakukan ini dengan prosedur. Prosedure tidak bisa mengembalikan nilai. +parser_e_only_methods_allowed=03081_E_konstruktor, destruktor dan class operator harus sebuah metode +% Anda mendeklarasikan sebuah procedure sebagai destruktor, konstructor atau class operator, ketika +% prosedure bukan metode kelas. +parser_e_operator_not_overloaded=03082_E_Operator tidak di-overload +% Anda mencoba untuk menggunakan operator yang di-overload saat ia bukan tipe +% untuk di-overload. +parser_e_no_such_assignment=03083_E_Tidak mungkin untuk meng-overload penempatan tipe yang sama +% Anda tidak bisa meng-overload penempatan tipe yang dianggap oleh +% kompilator sebagai sama. +parser_e_overload_impossible=03084_E_Overload operator tidak mungkin +% Kombinasi operator, argumen dan tipe balik tidak +% kompatibel. +parser_e_no_reraise_possible=03085_E_Re-raise tidak mungkin di sini +% Anda mencoba untuk memunculkan eksepsi yang tidak diperbolehkan. Anda hanya +% dapat memunculkan eksepsi dalam sebuah blok \var{except}. +parser_e_no_new_or_dispose_for_classes=03086_E_Sintaks diperluas pada new atau dispose tidak diijinkan untuk sebuah kelas +% Anda tidak bisa membuat turunan kelas dengan sintaks yang diperluas +% \var{new}. Konstruktor harus dipakai untuk itu. Untuk alasan yang sama, anda +% tidak bisa memanggil \var{dispose} untuk dealokasi turunan kelas, destruktor +% harus dipakai untuk itu. +parser_e_procedure_overloading_is_off=03088_E_Procedure overloading dimatikan +% Ketika menggunakan saklar \var{-So}, procedure overloading dimatikan. +% Turbo Pascal tidak mendukung overload fungsi. +parser_e_overload_operator_failed=03089_E_Tidak mungkinuntuk meng-overload operator ini. Operator yang bisa di-overload terkait (bila ada) adalah: $1 +% Anda mencoba untuk meng-overload sebuah operator yang tidak bisa di-overload. +% Operator berikut dapat di-overload : +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_Operator komparatif harus mengembalikan nilai boolean +% Ketika meng-overload operator \var{=}, fungsi harus mengembalikan nilai +% boolean. +parser_e_only_virtual_methods_abstract=03091_E_Hanya metode virtual dapat berupa abstak +% Anda mendeklarasikan metode sebagai abstrak, ketika ia tidak dideklarasikan menjadi +% virtual. +parser_f_unsupported_feature=03092_F_Penggunaan fitur yang tidak didukung! +% Anda mencoba untuk memaksa kompilator melakukan sesuatu yang belum bisa dilakukannya. +parser_e_mix_of_classes_and_objects=03093_E_Campuran dari jenis obyek berbeda (class, object, interface, dll) tidak dibolehkan +% Anda tidak dapat menurunkan \var{objects}, \var{classes}, \var{cppclasses} dan \var{interfaces} misalnya +% sebuah kelas tidak memiliki obyek sebagai leluhurnya dan sebaliknya. +parser_w_unknown_proc_directive_ignored=03094_W_Direktif procedure tidak dikenal harus diabaikan: "$1" +% Direktif procedure yang anda tetapkan tidak dikenal. +parser_e_absolute_only_one_var=03095_E_absolute hanya bisa dikaitkan ke satu variabel +% Anda tidak bisa menetapkan lebih dari satu variabel sebelum direktif \var{absolute}. +% Selanjutnya, konstruksi berikut akan menghasilkan kesalahan ini: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +% \item [ absolute hanya bisa dikaitkan ke sebuah var atau const ] +% Alamat dari direktif \var{absolute} hanya dapat mengarah ke variabel atau +% tipe konstan. Oleh karena itu, kode berikut akan menghasilkan kesalahan ini: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_absolute_only_to_var_or_const=03096_E_absolute hanya bisa dikaitkan dengan var atau const +% Alamat direktif \var{absolute} hanya bisa mengarah ke variabel atau konstan. +% Oleh karena itu, kode berikut akan menghasilkan kesalahan ini: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_initialized_only_one_var=03097_E_Hanya satu variabel dapat diinisialisasi +% Anda tidak dapat menetapkan lebih dari satu variabel dengan nilai awal +% dalam mode Delphi. +parser_e_abstract_no_definition=03098_E_Metode abstract tidak boleh memiliki definisi apapun (dengan badan fungsi) +% Metode abstract hanya bisa dideklarasikan, anda tidak bisa mengimplementasikannya. Ia +% harus diganti dengan kelas turunannya. +parser_e_overloaded_must_be_all_global=03099_E_Fungsi yang di-overload ini tidak boleh lokal (harus diekspor) +% Anda mendefinisikan fungsi yang di-overload dalam bagian implementation pada sebuah +% unit, tapi tidak ada deklarasi terkait dalam bagian interface dari unit itu. +parser_w_virtual_without_constructor=03100_W_Metode virtual dipakai tanpa sebuah constructor dalam "$1" +% Jika anda mendeklarasikan obyek atau kelas yang berisi metode virtual, anda perlu +% mempunyai constructor dan destructor untuk menginisialisasinya. Kompilator +% menemukan obyek atau kelas dengan metode virtual yang tidak memiliki pasangan +% constructor/destructor. +parser_c_macro_defined=03101_CL_Makro didefinisikan: $1 +% Ketika \var{-vc} dipakai, kompilator memberitahu anda saat ia mendefinisikan makro. +parser_c_macro_undefined=03102_CL_Makro tidak didefinisikan: $1 +% Ketika \var{-vc} dipakai, kompilator memberitahu anda saat ia tidak mendefinisikan makro. +parser_c_macro_set_to=03103_CL_Makro $1 disetel ke $2 +% Ketika \var{-vc} dipakai, kompilator memberitahu anda nilai apa yang didapat makro. +parser_i_compiling=03104_I_Mengompilasi $1 +% Ketika anda menghidupkan pesan informasi (\var{-vi}), kompilator memebritahu +% anda unit apa yang sedang dikompilasi. +parser_u_parsing_interface=03105_UL_Menguraikan interface dari unit $1 +% Ini memberitahu anda bahwa pembacaan interface dari unit saat ini +% dimulai +parser_u_parsing_implementation=03106_UL_Menguraikan implementation dari $1 +% Ini memberitahu anda bahwa pembacaan implementation dari unit saat ini, +% librari atau program dimulai +parser_d_compiling_second_time=03107_DL_Mengompilasi $1 untuk kedua kalinya +% Ketika anda meminta pesan debug (\var{-vd}) kompilator memberitahu anda unit +% apa yang dikompilasi untuk kedua kalinya. +parser_e_no_property_found_to_override=03109_E_Tidak ada properti yang ditemukan untuk diganti +% Anda ingin mengganti sebuah properti dari kelas leluhur, saat ia ada, +% kenyataannya, tidak ada properti seperti itu dalam kelas leluhur. +parser_e_only_one_default_property=03110_E_Hanya sati properti default yang dibolehkan +% Anda menetapkan properti sebagai \var{Default}, tapi kelas sudah mempunyai +% properti default, dan kelas hanya dapat memiliki satu properti default. +parser_e_property_need_paras=03111_E_Properti default harus berupa properti array +% Hanya properti array dari kelas dapat dibuat menjadi properti \var{default}. +parser_e_constructor_cannot_be_not_virtual=03112_E_Konstruktor virtual hanya didukung dalam model obyek kelas +% Anda tidak bisa memiliki konstruktor virtual dalam obyek. Anda hanya memilikinya +% dalam kelas. +parser_e_no_default_property_available=03113_E_Tidak ada properti default yang tersedia +% Anda mencoba mengakses properti default pada sebuah kelas, tapi kelas ini +% atau salah satu leluhurnya) tidak mempunyai properti default. +parser_e_cant_have_published=03114_E_Kelas tidak mempunyai seksi published, pakai saklar {$M+} +% Jika anda ingin seksi \var{published} dalam sebuah definisi class, anda harus +% menggunakan saklar \var{\{\$M+\}}, yang menghidupkan pembuatan informasi +% type. +parser_e_forward_declaration_must_be_resolved=03115_E_Deklarasi forward dari kelas "$1" harus dipecahkan di sini untuk menggunakan kelas sebagai leluhur +% Agar bisa menggunakan obyek sebagai obyek leluhur, ia harus didefinisikan +% lebih dahulu. Kesalahan ini terjadi dalam situasi berikut: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% Di mana \var{ParentClass} dideklarasikan tapi tidak didefinisikan. +parser_e_no_local_operator=03116_E_Operator lokal tidak didukung +% Anda tidak bisa meng-overload secara lokal, misalnya di dalam definisi +% prosedur atau fungsi. +parser_e_proc_dir_not_allowed_in_interface=03117_E_Direktif procedure "$1" tidak dibolehkan dalam seksi interface +% Direktif prosedur ini tidak dibolehkan dalam seksi \var{interface} dari +% sebuah unit. Anda hnya bisa menggunakannya dalam seksi \var{implementation}. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_Direktif procedure "$1" tidak dibolehkan dalam seksi implementation +% Direktif prosedur ini tidak didefinisikan dalam seksi \var{implementation} pada +% sebuah unit. Anda hanya bisa menggunakannya dalam seksi \var{interface}. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_Direktif prosedur "$1" tidak dibolehkan dalam deklarasi procvar +% Direktif prosedur ini tidak bisa berupa bagian dari deklarasi tipe prosedural +% atau fungsi. +parser_e_function_already_declared_public_forward=03120_E_Fungsi sudah dideklarasikan Public/Forward "$1" +% Anda akan mendapat kesalahan ini jika fungsi didefiniskan sebagai \var{forward} dua kali. +% Atau sekali dalam seksi \var{interface}, dan sekali sebagai deklarasi +% \var{forward} dalam seksi \var{implmentation}. +parser_e_not_external_and_export=03121_E_Tidak bisa menggunakan EXPORT dan EXTERNAL +% Dua prosedur ini adalah mutual eksklusif +parser_w_not_supported_for_inline=03123_W_"$1" belum didukung di dalam inline procedure/function +% Inline procedures tidak mendukung deklarasi ini. +parser_w_inlining_disabled=03124_W_Inlining dimatikan +% Inlining dari prosedur dimatikan. +parser_i_writing_browser_log=03125_I_Menulis log Browser $1 +% Ketika pesan informasi hidup, kompilator memperingatkan anda saat ia +% menulis log browser (dibuat dengan saklar \var{\{\$Y+ \}}). +parser_h_maybe_deref_caret_missing=03126_H_mungkin dereferensi pointer hilang +% Kompilator berpikir bahwa pointer mungkin memerlukan dereferensi. +parser_f_assembler_reader_not_supported=03127_F_Pembaca assembler yang dipilih tidak didukung +% Pembaca assembler yang dipilih (dengan \var{\{\$ASMMODE xxx\}} tidak +% didukung. Kompilator dapat dikompilasi dengan atau tanpa dukungan pembaca +% assembler tertentu. +parser_e_proc_dir_conflict=03128_E_Direktif prosedur "$1" konflik dengan direktif lain +% Anda menetapkan direktif prosedur yang konflik dengan direktif lainnya. +% Sebagai contoh \var{cdecl} dan \var{pascal} adalah mutual eksklusif. +parser_e_call_convention_dont_match_forward=03129_E_Konvensi pemanggilan forward tidak sama +% Kesalahan ini terjadi ketika anda mendeklarasikan fungsi atau prosedur dengan +% misalnya \var{cdecl;} tapi mengabaikan direktif ini dalam implementasi, atau +% sebaliknya. Konvensi pemanggilan adalah bagian dari deklarasi fungsi, dan +% harus diulang dalam definisi fungsi. +parser_e_property_cant_have_a_default_value=03131_E_Properti tidak bisa memiliki nilai default +% Set properti atau properti berindeks tidak bisa mempunyai nilai default. +parser_e_property_default_value_must_const=03132_E_Nilai default pada properti harus konstan +% Nilai dari properti yang dideklarasikan \var{default} harus dikenal waktu +% dikompilasi. nilai yang anda tetapkan hanya dikenal saat run time. Ini terjadi +% misalnya jika anda menetapkan sebuah nama variabel sebagai nilai default. +parser_e_cant_publish_that=03133_E_Simbol tidak bisa dipublikasi, hanya bisa sebuah kelas +% Hanya variabel tipe kelas yang bisa berada dalam seksi \var{published} pada +% sebuah kelas jika ia tidak dideklarasikan sebagai sebuah properti. +parser_e_cant_publish_that_property=03134_E_Jenis properti ini tidak bisa dipublikasi +% Properti dalam seksi \var{published} tidak bisa berupa properti array. +% ia harus dipindahkan ke seksi public. Properti dalam seksi \var{published} +% harus berupa tipe ordinal, tipe real, string atau set. +parser_e_empty_import_name=03136_E_Nama import diperlukan +% Beberapa target memerlukan nama untuk prosedur yang diimpor atau pembeda \var{cdecl} +parser_e_division_by_zero=03138_E_Pembagian dengan nol +% Ada pembagian dengan nol yang ditemukan +parser_e_invalid_float_operation=03139_E_Operasi floating point tidak benar +% Operasi pada dua nilai tipe real menhasilkan overflow atau pembagian dengan +% nol. +parser_e_array_lower_less_than_upper_bound=03140_E_Batas atas jangkauan kurang dari batas lebih rendah +% Batas lebih atas pada deklarasi array kurang dari batas lebih rendah dan ini +% mungkin +parser_w_string_too_long=03141_W_string "$1" lebih panjang dari "$2" +% Ukuran konstan string lebih besar dari ukuran yang anda tetapkan dalam +% definisi tipe string +parser_e_string_larger_array=03142_E_panjang string lebih besar dari panjang array of char +% Ukuran konstan string lebih besar dari ukuran yang anda tetapkan dalam +% definisi array[x..y] of char +parser_e_ill_msg_expr=03143_E_Ekspresi tidak benar setelah direktif pesan +% \fpc hanya mendukung nilai integer atau string sebagai konstan pesan +parser_e_ill_msg_param=03144_E_Pengendali pesan hanya dapat mengambil satu panggilan dengan parameter ref. +% Metode yang dideklarasikan dengan direktif-\var{message} sebagai pengendali +% pesan hanya mengambil satu parameter yang harus dideklarasikan sebagai +% panggilan dengan referensi. Parameter dideklarasikan sebagai panggilan dengan +% referensi menggunakan direktif-\var{var} +parser_e_duplicate_message_label=03145_E_Duplikasi label pesan: "$1" +% Label untuk sebuah pesan dipakai dua kali dalam satu object/class +parser_e_self_in_non_message_handler=03146_E_Self hanya bisa berupa parameter eksplisit dalam metode yang merupakan pengendali pesan +% Parameter self hanya dapat dioper secara eksplisit ke metode yang +% dideklarasikan sebagai pengendali pesan. +parser_e_threadvars_only_sg=03147_E_Threadvars hanya bisa berupa static atau global +% Threadvars harus berupa static atau global, anda tidak bisa mendeklarasikan +% lokal thread ke prosedur. Variabel lokal selalu lokal bagi thread, karena +% setiap thread memiliki stack-nya sendiri dan variabel lokal disimpan pada +% stack +parser_f_direct_assembler_not_allowed=03148_F_Assembler langsung tidak didukung untuk format output biner +% Anda tidak dapat menggunakan assembler langsung saat menggunakan penulis biner, +% pilih format output lain atau gunakan pembaca assembler lain +parser_w_no_objpas_use_mode=03149_W_Jangan ambil unit OBJPAS secara manual, sebaliknya gunakan \{\$mode objfpc\} atau \{\$mode delphi\} +% Anda mencoba untuk mengambil unit ObjPas secara manual dari kausul uses. Ini +% bukan ide yang baik. Gunakan direktif \var{\{\$mode objfpc\}} atau +% \var{\{\$mode delphi\}} +% yang mengambil unit secara otomatis +parser_e_no_object_override=03150_E_OVERRIDE tidak bisa dipakai dalam obyek +% Override tidak didukung untuk obyek, sebaliknya gunakan \var{virtual} untuk +% mengganti metode obyek leluhur +parser_e_cant_use_inittable_here=03151_E_Tipe data yang memerlukan initialization/finalization tidak bisa dipakai dalam variant record +% Beberapa tipe data (misalnya \var{ansistring}) memerlukan kode initialization/finalization +% yang secara implisit dibuat oleh kompilator. Tipe data sepert itu tidak +% bisa dipakai dalam bagian varian pada sebuah record. +parser_e_resourcestring_only_sg=03152_E_Resourcestring hanya berupa static atau global +% Resourcestring tidak bisa dideklarasikan lokal, hanya global atau menggunakan +% direktif static. +parser_e_exit_with_argument_not__possible=03153_E_Exit dengan argumen tidak bisa dipakai di sini +% Pernyataan exit dengan sebuah argumen untuk nilai balik tidak bisa dipakai +% di sini, ini terjadi misalnya dalam blok \var{try..except} atau \var{try..finally} +parser_e_stored_property_must_be_boolean=03154_E_Tipe penyimpanan simbol harus boolean +% Jika anda menetapkan penyimpanan simbol dalam deklarasi properti, ia harus +% berupa tipe boolean +parser_e_ill_property_storage_sym=03155_E_Simbol ini tidak diijinkan sebagai penyimpanan simbol +% Anda tidak bisa menggunakan tipe ini pada simbol sebagai pembeda penyimpanan +% dalam deklarasi properti. Anda hanya bia menggunakan metode dengan tipe hasil +% boolean, field kelas boolean atau konstan boolean +parser_e_only_publishable_classes_can_be_published=03156_E_Hanya kelas yang dikompilasi dalam mode $M+ yang bisa dipublikasikan +% Dalam seksi published dari kelas hanya bisa berupa kelas sebagai field yang dipakai +% dikompilasi dalam \var{\{\$M+\}} atau yang diturunkan dari kelas seperti itu. +% Normalnya kelas demikian harus dideklarasikan dari TPersitent +parser_e_proc_directive_expected=03157_E_Direktif prosedur diharapkan +% Kesalahan ini dipicu ketika anda mempunyai direktif \var{\{\$Calling\}} tanpa +% konvensi pemanggilan yang ditetapkan. +% Ia juga terjadi saat mendeklarasikan prosedur dalam blok const dan anda +% menggunakan sebuah ; setelah deklarasi procedure yang harus diikuti oleh +% sebuah direktif procedure. +% Deklarasi yang benar adalah: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_Nilai indeks properti harus tipe ordinal +% Nilai yang anda pakai untuk mengindeks properti harus berupa tipe ordinal, +% sebagai contoh tipe integer atau dienumerasi. +parser_e_procname_to_short_for_export=03159_E_Nama prosedur terlalu pendek untuk diekspor +% Panjang nama procedure/function harus setidaknya 2 karakter. Ini dikarenakan +% bug dalam dlltool yang tidak menguraikan file .def dengan benar +% dengan panjang nama 1. +parser_e_dlltool_unit_var_problem=03160_E_Tidak ada entri DEFFILE dapat dibuat untuk unit global vars +parser_e_dlltool_unit_var_problem2=03161_E_Kompilasi tanpa opsi -WD +% Anda perlu mengompilasi file ini tanpa saklar -WD pada baris +% perintah +parser_f_need_objfpc_or_delphi_mode=03162_F_Anda perlu ObjFpc (-S2) atau mode Delphi (-Sd) untuk mengompilasi modul ini +% Anda perlu menggunakan \{\$mode objfpc\} atau \{\$mode delphi\} untuk +% mengompilasi file ini. Atau gunakan saklar commandline yang sama -S2 atau -Sd. +parser_e_no_export_with_index_for_target=03163_E_Tidak bisa mengekspor dengan indeks di bawah $1 +% Mengekspor fungsi atau prosedur dengan indeks yang ditetapkan tidak didukung +% pada target ini. +parser_e_no_export_of_variables_for_target=03164_E_Mengekspor variabel tidak didukung di bawah $1 +% Mengekspor variabel tidak didukung pada target ini. +parser_e_improper_guid_syntax=03165_E_Sintaks GUID tidak benar +% Indikasi GUID tidak memiliki sintaks yang benar. Ia seharusnya dalam bentuk +% \begin{verbatim} +% {XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX} +% \end{verbatim} +% Di mana setiap \var{X} mewakili digit heksadesimal. +parser_w_interface_mapping_notfound=03168_W_Prosedur bernama "$1" tidak meemukan yang sesuai untuk mengimplementasikan $2.$3 +% Kompilator tidak bisa menemukan prosedur yang cocok yang mengimplementasikan metode +% yang diberikan pada interface. Prosedur dengan nama sama ditemukan, tapi argumen tidak sama. +parser_e_interface_id_expected=03169_E_pengenal interface diharapkan +% Ini terjadi ketika kompilator memindai deklarasi \var{class} yang berisi +% \var{interface} nama fungsi memetakan kode seperti ini: +% \begin{verbatim} +% type +% TMyObject = class(TObject, IDispatch) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% dan \var{interface} sebelum titik tidak didaftarkan dalam daftar turunan. +parser_e_type_cant_be_used_in_array_index=03170_E_Tipe "$1" tidak bisa dipakai sebagai tipe indeks array +% Tipe seperti \var{qword} atau \var{int64} tidak dibolehkan sebagai tipe indeks array +parser_e_no_con_des_in_interfaces=03171_E_Con- dan destruktor tidak dibolehkan dalam interface +% Deklarasi konstruktor dan destruktor tidak dibolehkan dalam interface +% Dalam banyak kasus metode \var{QueryInterface} pada \var{IUnknown} dapat +% dipakai untuk membuat interface baru. +parser_e_no_access_specifier_in_interfaces=03172_E_Pembeda akses tidak bisa dipakai dalam INTERFACE +% Pembeda akses \var{public}, \var{private}, \var{protected} dan +% \var{pusblished} tidak bisa dipakai dalam interfaces karena semua metode +% pada interfaces harus public. +parser_e_no_vars_in_interfaces=03173_E_Interface tidak bisa berisi field +% Deklarasi field tidak dibolehkan dalam interface. Interface hanya dapat +% berisi metode +parser_e_no_local_proc_external=03174_E_Tidak bisa mendeklarasikan prosedur lokal sebagai EXTERNAL +% Mendeklarasikan prosedur lokal sebagai external tidak mungkin. Prosedur lokal +% mendapat parameter tersembunyi yang akan menjadi peluang kesalahan sangat tinggi +parser_w_skipped_fields_before=03175_W_Beberapa field datang sebelum "$1" diinisialisasi +% Dalam mode Delphi, tidak semua field dari record tipe konstan harus +% diinisialisasi, tapi kompilator memperingatkan anda saat ia mendeteksi situasi itu. +parser_e_skipped_fields_before=03176_E_Beberapa field datang sebelum "$1" diinisialisasi +% Dalam semua mode sintaks kecuali mode Delphi, anda tidak bisa meninggalkan +% beberapa field tidak diinisialisasi di tengah konstan tipe record +parser_w_skipped_fields_after=03177_W_Beberapa field datang setelah "$1" tidak diinisialisasi +% Anda dapat meninggalkan beberapa fields di akhir konstan tipe record tidak +% diinisialisasi (kompilator akan menginisialisasinya ke nol secara otomatis). +% Ini dapat menjadi penyebab masalah yang kentara. +parser_e_varargs_need_cdecl_and_external=03178_E_Direktif VarArgs (atau '...' dalam MacPas) tanpa CDecl/CPPDecl/MWPascal dan External +% Direktif varargs (atau parameter varargs ``...'' dalam mode MacPas) hanya bisa +% dipakai dengan prosedur atau fungsi yang dideklarasikan dengan \var{external} dan salah satu +% dari \var{cdecl}, \var{cppdecl} dan \var{mwpascal}. Fungsionalitas ini hanya +% didukung untuk menyediakan interface kompatibel terhadap fungsi C seperti printf. +parser_e_self_call_by_value=03179_E_Self harus berupa parameter normal (dipanggil-dengan-nilai) +% Anda tidak bisa mendeklarasikan self sebagai parameter const atau var, ia harus +% selalu berupa parameter dipanggil-dengan-nilai +parser_e_interface_has_no_guid=03180_E_Interface "$1" tidak mempunyai identifikasi interface +% Ketika anda ingin menempatkan interface ke konstan, maka interface harus +% sudah menyetel nilai GUID. +parser_e_illegal_field_or_method=03181_E_Field class atau pengenal metode "$1" tidak dikenal +% Properti harus merujuk ke sebuah field atau metode dalam kelas yang sama. +parser_w_proc_overriding_calling=03182_W_Mengganti konvensi pemanggilan "$1" dengan "$2" +% Ada dua direktif dalam deklarasi prosedur yang menetapkan konvensi +% pemanggilan. Hanya direktif terakhir yang akan dipakai +parser_e_no_procvarobj_const=03183_E_Tipe konstan dari tipe "procedure of object" hanya dapat diinisialisasi dengan NIL +% Anda tidak bisa menempatkan alamat sebuah metode ke tipe konstan yang +% memiliki tipe 'procedure of object', karena konstan memerlukan dua alamat: +% yang metodenya (dikenal saat waktu kompilasi) dan yang obyeknya atau turunan +% beroperasi pada kelasnya (yang tidak dapat dikenal saat waktu kompilasi). +parser_e_default_value_only_one_para=03184_E_Nilai default hanya bisa ditempatkan ke satu parameter +% Tidak mungkin untuk menetapkan nilai default untuk beberapa parameters sekaligus. +% Yang berikut adalah tidak benar: +% \begin{verbatim} +% Procedure MyProcedure (A,B : Integer = 0); +% \end{verbatim} +% Lebih baik, deklarasikan sebagai +% \begin{verbatim} +% Procedure MyProcedure (A : Integer = 0; B : Integer = 0); +% \end{verbatim} +parser_e_default_value_expected_for_para=03185_E_Parameter default diperlukan untuk "$1" +% Parameter yang ditetapkan memerlukan nilai default. +parser_w_unsupported_feature=03186_W_Penggunaan fitur yang tidak didukung! +% Anda mencoba untuk memaksa kompilator melakukan yang belum bisa dilakukannya. +parser_h_c_arrays_are_references=03187_H_Array C dikirimkan dengan referensi +% Setiap array yang dikirimkan ke fungsi C dioper dengan pointer +% (misalnya dengan referensi). +parser_e_C_array_of_const_must_be_last=03188_E_Array of const pada C harus argumen terakhir +% Anda tidak bisa menambah argumen lain setelah \var{array of const} untuk +% fungsi \var{cdecl}, karena ukuran yang disimpan pada stack untuk argumen ini +% tidak diketahui. +parser_h_type_redef=03189_H_Redefinisi tipe "$1" +% Ini adalah indikator yang sebelumnya tipe dideklarasikan sedang didefinisikan +% ulang sebagai yang lain. Ini bisa menjadi atau tidak penyebab dari +% kesalahan. +parser_w_cdecl_has_no_high=03190_W_fungsi cdecl yang dideklarasikan tidak memiliki parameter tinggi +% Fungsi yang dideklarasikan dengan pengubah cdecl tidak mengirimkan parameter ekstra implisit. +parser_w_cdecl_no_openstring=03191_W_fungsi cdecl yang dideklarasikan tidak mendukung string terbuka +% Openstring tidak didukung untuk fungsi yang dideklarasikan cdecl. +parser_e_initialized_not_for_threadvar=03192_E_Tidak bisa menginisialisasi variabel yang dideklarasikan sebagai threadvar +% Variabel yang dideklarasikan sebagai threadvar tidak bisa diinisialisasi dengan +% nilai default. Variabel akan selalu diisi dengan nol di awal thread baru. +parser_e_msg_only_for_classes=03193_E_Direktif message hanya dibolehkan dalam Kelas +% Direktif pesan hanya didukung untuk tipe Class. +parser_e_procedure_or_function_expected=03194_E_Procedure atau Function diharapkan +% Metode kelas hanya bisa ditetapkan untuk prosedur dan fungsi. +parser_e_illegal_calling_convention=03195_W_Direktif konvensi pemanggilan diabaikan: "$1" +% Beberapa konvensi pemanggilan hanya didukung oleh CPU tertentu. Misalnya dukungan banyak non-i386 port +% hanya konvensi pemanggilan standar ABI pada CPU. +parser_e_no_object_reintroduce=03196_E_REINTRODUCE tidak bisa dipakai dalam obyek +% \var{reintroduce} tidak didukung untuk obyek. +parser_e_paraloc_only_one_para=03197_E_Setiap argumen harus memiliki lokasi sendiri +% Jika lokasi untuk argumen ditetapkan secara eksplisit karena ia diperlukan oleh +% beberapa konvensi syscall, setiap argumen harus memiliki lokasinya sendiri, hal +% seperti \var{procedure p(i,j : longint 'r1');} tidak diijinkan +parser_e_paraloc_all_paras=03198_E_Setiap argumen harus memiliki lokasi eksplisit +% Jika satu argumen mempunyai lokasi argumen eksplisit, semua argument pada +% prosedur harus memilikinya. +parser_e_illegal_explicit_paraloc=03199_E_Lokasi argumen tidak dikenal +% Lokasi yang ditetapkan untuk argumen tidak dikenal oleh kompilator +parser_e_32bitint_or_pointer_variable_expected=03200_E_32 Bit-Integer atau variabel pointer diharapkan +% Libbase untuk MorphOS/AmigaOS hanya dapat diberikan sebagai \var{longint}, \var{dword} atau variabel pointer. +parser_e_goto_outside_proc=03201_E_Pernyataan goto tidak dibolehkan diantara prosedure yang berbeda +% Tidak diperkenankan menggunakan pernyataan \var{goto} mereferensi label di luar +% prosedur saat ini. Contoh berikut menampilkan masalah ini: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1; +% +% procedure p2; +% begin +% goto l1; // Goto ini TIDAK diijinkan +% end; +% +% begin +% p2 +% l1: +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_Prosedur terlalu kompleks, memerlukan terlalu banyak register +% Badan prosedur anda terlalu panjang bagi kompilator. Anda harus memisahkan +% prosedur ke dalam multipel prosedure lebih kecil. +parser_e_illegal_expression=03203_E_Ekspresi tidak benar +% Ini dapat terjadi di bawah banyak keadaan. Terutama saat mencoba untuk +% mengevaluasi ekspresi konstan. +parser_e_invalid_integer=03204_E_Ekspresi integer tidak benar +% Anda membuat ekspresi yang bukan integer, dan kompilator mengharapkan hasilnya +% adalah integer. +parser_e_invalid_qualifier=03205_E_Kualifier tidak benar +% Salah satu dari yang berikut terjadi : +% \begin{itemize} +% \item Anda mencoba untuk mengakses field variabel yang bukan sebuah record. +% \item Anda mengindeks variabel yang bukan sebuah array. +% \item Anda medereferensi variabel yang bukan sebuah pointer. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_Batas tinggi jakauan < batas rendah jangkauan +% You are declaring a subrange, and the lower limit is higher than the high +% limit of the range. +parser_e_macpas_exit_wrong_param=03207_E_Parameter Exit harus berupa nama prosedur yang dipakai +% Exit non lokal tidak dibolehkan. Kesalahan ini hanya terjadi dalam mode MacPas. +parser_e_illegal_assignment_to_count_var=03208_E_Penempatan ke variabel for-loop "$1" tidak benar +% Tipe variabel \var{for} loop harus berupa tipe ordinal. +% Variabel loop tidak bisa real atau string. Anda juga tidak bisa menempatkan +% nilai ke variabel loop di dalam loop (kecuali dalam mode Delphi dan TP). +% Sebaliknya gunakan while atau repeat loop jika anda perlu melakukan sesuatu +% seperti itu, karena konstruksinya dibangun untuk itu. +parser_e_no_local_var_external=03209_E_Tidak bisa mendeklarasikan variabel lokal sebagai EXTERNAL +% Mendeklarasikan variabel lokal sebagai external tidak dibolehkan. Hanya +% variabel global dapat mereferensi ke variabel external. +parser_e_proc_already_external=03210_E_Procedure sudah dideklarasikan EXTERNAL +% Prosedur sudah dideklarasikan dengan direktif EXTERNAL dalam interface atau +% deklarasi forward. +parser_w_implicit_uses_of_variants_unit=03211_W_Penggunaan implisit unit Variants +% Tipe Variant dipakai dalam unit tanpa menggunakan unit Variants. Kompilator +% telah menambahkan secara implisit unit Variants ke akhir daftar uses. Untuk +% menghapus peringatan ini, unit Variants perlu ditambahkan ke pernyataan uses. +parser_e_no_static_method_in_interfaces=03212_E_Kelas dan metode statis tidak bisa dipakai dalam INTERFACE +% Pembeda \var{class} dan direktif \var{static} tidak bisa dipakai dalam interface +% karena semua metode interface harus public. +parser_e_arithmetic_operation_overflow=03213_E_Overflow dalam operasi aritmatika +% Operasi pada dua nilai integer menghasilkan overflow +parser_e_protected_or_private_expected=03214_E_Protected atau private diharapkan +% \var{strict} hanya bisa dipakai bersama dengan \var{protected} atau \var{private}. +parser_e_illegal_slice=03215_E_SLICE tidak bisa dipakai di luar daftar parameter +% \var{slice} hanya bisa dipakai untuk argumen yang menerima parameter array terbuka +parser_e_dispinterface_cant_have_parent=03216_E_DISPINTERFACE tidak bisa mempunyai kelas leluhur +% DISPINMTERFACE adalah tipe khusus interface yang tidak memiliki kelas leluhur +parser_e_dispinterface_needs_a_guid=03217_E_DISPINTERFACE memerlukan sebuah guid +% DISPINMTERFACE selalu memerlukan identifikasi interface +parser_w_overridden_methods_not_same_ret=03218_W_Metode yang diganti harus tipe balik terkait. Kode ini mungkin rusak, ia tergantung pada bug pengurai Delphi ("$2" diganti dengan "$1" yang mempunyai tipe balik lain) +% Jika anda mendeklarasikan metode pengganti dalam definisi kelas, ia harus +% mempunyai tipe balik yang sama. Beberapa versi Delphi membolehkan anda untuk +% mengubah tipe balik pada metode interface, dan bahkan mengubah prosedur menjadi +% fungsi, tapi kode hasil bisa rusak tergantung pada tipe yang dipakai dan +% cara metode dipanggil. +parser_e_dispid_must_be_ord_const=03219_E_Dispatch ID harus konstan ordinal +parser_e_array_range_out_of_bounds=03220_E_Jangkauan array terlalu besar +% Meskipun ukuran tergantung elemennya, array tidak bisa memiliki lebih dari +% high(ptrint) elemen. Sebagai tambahan, tipe jangkauan harus sub jangkauan +% dari ptrint. +parser_e_packed_element_no_var_addr=03221_E_Alamat tidak bisa diambil dari elemen packed array dan field record +% Jika anda mendeklarasikan array atau record sebagai \var{packed} dalam mode Mac Pascal +% (atau sebagai \var{packed} dalam setiap mode dengan \var{\{\$bitpacking on\}}), +% ia akan di-packed di tingkat bit. Ini berarti ia menjadi tidak mungkin untuk +% mengambil alamat dari elemen individual array atau field record. Ini hanya +% kekecualian pada aturan ini bila elemen packed array yang ukuran pemadatannya +% adalah multpele dari 8 bit. +parser_e_packed_dynamic_open_array=03222_E_Array dinamis tidak bisa dipadatkan +% Hanya array reguler (dan mungkin ke depan juga yang terbuka) dapat dipadatkan +parser_e_packed_element_no_loop=03223_E_Bit elemen packed array dan field record tidak bisa dipakai sebagai variabel loop +% Jika anda mendeklarasikan array atau record sebagai \var{packed} dalam mode Mac Pascal (atau sebagai \var{packed} dalam setiap mode \var{\{\$bitpacking on\}}), +% ia akan dipadatkan di tingkat bit. Untuk alasan performansi, ia tidak bisa +% dipakai sebagai variabel loop. +parser_e_type_and_var_only_in_generics=03224_E_VAR dan TYPE hanya dibolehkan dalam generik +% Penggunaan VAR dan TYPE untuk mendeklarasikan tipe baru di dalam sebuah obyek +% hanya dibolehkan di dalam generik. +parser_e_cant_create_generics_of_this_type=03225_E_Tipe ini tidak bisa generik +% Hanya Class, Object, Interface dan Record dibolehkan untuk dipakai sebagai generik +parser_w_no_lineinfo_use_switch=03226_W_Jangan ambil unit LINEINFO secara manual, sebaliknya gunakan saklar kompilator -gl +% Jangan menggunakan unit LINEINFO secara langsung, gunakan saklar \var{-gl} +% yang secara otomatis menambahkan unit untuk membaca tipe informasi debug. +parser_e_no_funcret_specified=03227_E_Tidak ada tipe hasil fungsi yang ditetapkan untuk "$1" +% Pertama kali anda mendeklarasikan fungsi anda harus mendeklarasikannya dengan lengkap, +% termasuk seluruh parameter dan tipe hasil. +parser_e_special_onlygenerics=03228_E_Specialization hanya didukung untuk tipe generik +% Tipe yang bukan generik tidak bisa di spesialisasi +parser_e_no_generics_as_params=03229_E_Generik tidak bisa dipakai sebagai parameter saat menspesialisasi generik +% Ketika menspesialisasi generik, hanya tipe non-generik yang dapat dipakai sebagai parameter. +parser_e_type_object_constants=03230_E_Konstan obyek yang berisi VMT tidak dibolehkan +% Jika sebuah obyek memerlukan VMT baik karena ia berisi konstruktor ataupun metode virtual, +% tidak diijinkan untuk membuat konstan darinya. Dalam mode TP dan Delphi ini +% dibolehkan untuk alasan kompatibilitas. +parser_e_label_outside_proc=03231_E_Mengambil alamat label yang didefinisikan di luar lingkup saat ini tidak dibolehkan +% Tidak diperbolehkan untuk mengambil alamat label di luar prosedur +% saat ini. +parser_f_no_anonymous_specializations=03232_F_Spesialisasi generik anonim tidak diperbolehkan +% Sesuatu seperti +% \begin{verbatim} +% var +% MyLinkedList: specialize TLinkedList<TFixedString15>; +% \end{verbatim} +% tidak dibolehkan. Deklarasikan tipe spesialisasi lebih dulu: +% \begin{verbatim} +% type +% TMyLinkedList = specialize TLinkedList<TFixedString15>; +% var +% MyLinkedList: TMyLinkedList +% \end{verbatim} +parser_e_initialized_not_for_external=03233_E_Tidak bisa menginisialisasi variabel yang dideklarasikan sebagai external +% Variabel yang dideklarasikan sebagai external tidak bisa diinisialisasi dengan nilai default. +parser_e_illegal_function_result=03234_E_Tipe hasil fungsi tidak benar +% Beberapa tipe seperti tipe file tidak bisa dipakai sebagai hasil fungsi. +parser_e_no_common_type=03235_E_Tidak ada tipe umum yang mungkin antara "$1" dan "$2" +% Untuk melakukan operasi diantara integer, kompilator mengubah kedua operand +% ke tipe umum, yang terlihat tipe tidak benar. Untuk menentukan tipe umum +% dari operand, kompilator mengambil minimum dari nilai minimal kedua tipe, +% dan maksimum dari maksimal nilai kedua tipe. Tipe umum adalah +% minimum..maksimum. +parser_e_no_generics_as_types=03236_E_Generik tanpa spesialisasi tidak bisa dipakai sebagai tipe untuk variabel +% Generik harus selalu dispesialisasi sebelum dipakai sebagai tipe variabel +% \end{description} +# +# Pemeriksaan Tipe +# +# 04082 is the last used one +# +% \section{Kesalahan pemeriksaan tipe} +% Seksi ini mendaftarkan semua kesalahan yang terjadi saat pemeriksaan tipe +% dilakukan. +% \begin{description} +type_e_mismatch=04000_E_Tipe tidak sama +% Ini terjadi dalam banyak kasus: +% \begin{itemize} +% \item Variabel yang anda tempatkan adalah tipe berbeda dari ekspresi dalam +% penempatan. +% \item Anda memanggil fungsi atau prosedur dengan parameters yang tidak +% kompatibel dengan parameter dalam definisi fungsi atau prosedur. +% \end{itemize} +type_e_incompatible_types=04001_E_Tipe tidak kompatibel: didapat "$1" diharapkan "$2" +% Tidak ada konversi yang mungkin diantara kedua tipe +% Kemungkinan lain adalah bahwa keduanya dideklarasikan dalam deklarasi yang +% berbeda: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { Pernyataan ini juga menghasilkan kesalahan, ini +% dikarenakan pemeriksaan tipe ketat pada pascal } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_Tipe tidak sama antara "$1" dan "$2" +% Tipe tidak persis sama +type_e_type_id_expected=04003_E_Pengenal tipe diharapkan +% Pengenal bukan sebuah tipe, atau anda lupa menyertakan pengenal tipe. +type_e_variable_id_expected=04004_E_Pengenal variabel diharapkan +% Ini terjadi saat anda mengirimkan konstan ke sebuah rutin (seperti \var{Inc} var atau \var{Dec}) +% ketia ia mengharapkan sebuah variabel. Anda juga bisa mengirimkan variabel +% sebagai argumen ke fungsi ini. +type_e_integer_expr_expected=04005_E_Ekspresi integer diharapkan, tapi didapat "$1" +% Kompilator mengharapkan ekspresi tipe integer, tetapi mendapatkan tipe yang +% berbeda. +type_e_boolean_expr_expected=04006_E_Ekspresi boolean diharapkan, tapi didapat "$1" +% Ekspresi harus tipe boolean, ia harus mengembalikan true atau false. +type_e_ordinal_expr_expected=04007_E_Ekspresi Ordinal diharapkan +% Ekspresi harus tipe ordinal, misalnya maksimum \var{Longint}. +% Ini terjadi, misalnya ketika anda menetapkan argumen kedua +% ke \var{Inc} atau \var{Dec} yang tidak mengevaluasi ke nilai ordinal. +type_e_pointer_type_expected=04008_E_Tipe pointer diharapkan, tapi didapat "$1" +% Ekspresi variabel bukan tipe \var{pointer}. Ini terjadi ketika anda +% mengirimkan variabel yang bukan pointer ke \var{New} atau \var{Dispose}. +type_e_class_type_expected=04009_E_Tipe class diharapkan, tapi didapat "$1" +% Ekspresi variabel bukan tipe \var{class}. Ini terjadi biasanya ketika +% \begin{enumerate} +% \item Kelas leluhur dalam deklarasi kelas bukan sebuah class. +% \item Pengendali eksepsi (\var{On}) berisi pengenal tipe yang bukan sebuah +% class. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_Tidak bisa mengevaluasi ekspresi konstan +% Kesalahan ini bisa terjadi ketika batas array yang anda deklarasikan tidak +% mengevaluasi konstan ordinal +type_e_set_element_are_not_comp=04012_E_Set elemen tidak kompatibel +% Anda mencoba untuk membuat operasi pada dua set, ketika set tipe elemen +% tidak sama. Tipe basis dari sebuah set harus sama saat mengambil union +type_e_set_operation_unknown=04013_E_Operasi tidak diimplementasikan untuk set +% Beberapa operasi biner tidak mendefinisikan untuk set seperti +% div mod ** (juga >= <= untuk saat ini) +type_w_convert_real_2_comp=04014_W_Konversi tipe otomatis dari tipe floating ke COMP yang adalah tipe integer +% Konversi tipe implisit dari tipe real ke \var{comp} ditemukan. Karena +% \var{comp} adalah tipe integer 64 bit, ini bisa menandakan kesalahan. +type_h_use_div_for_int=04015_H_Sebaiknya gunakan DIV untuk mendapatkan hasil integer +% Ketika petunjuk dihidupkan, maka pembagian integer dengan operator '/' akan +% memunculkan pesan ini, karena hasil kemudian akan berupa tipe real +type_e_strict_var_string_violation=04016_E_Tipe string tidak sama, karena mode $V+ +% Ketika mengompilasi dalam mode \var{\{\$V+\}}, string yang anda kirimkan sebagai parameter +% harus tipe yang sama persis seperti parameter yang dideklarasikan pada procedure. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_succ atau pred pada enums dengan penempatan tidak mungkin +% Ketika anda mendeklarasikan tipe enumerasi yang mempunyai penempatan di dalamnya, seperti pada C, +% seperti yang berikut: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% anda tidak bisas menggunakan fungsi \var{Succ} atau \var{Pred} padanya. +type_e_cant_read_write_type=04018_E_Tidak bisa membaca atau menulis variabel dari tipe ini +% Anda mencoba untuk \var{read} atau \var{write} variabel dari atau ke sebuah +% file tipe teks, yang tidak mendukung itu. Hanya tipe integer, real, pchar, +% dan string dapat dibaca dari/ditulis ke file teks. Boolean hanya dapat +% ditulis ke file teks. +type_e_no_readln_writeln_for_typed_file=04019_E_Tidak bisa menggunakan readln atau writeln pada file +% \var{readln} dan \var{writeln} hanya dibolehkan untuk file teks. +type_e_no_read_write_for_untyped_file=04020_E_Tidak bisa memakai baca atau tulis pada file untyped. +% \var{read} dan \var{write} hanya dibolehkan untuk file teks atau biner. +type_e_typeconflict_in_set=04021_E_Tipe konflik diantara set elemen +% Ada setidaknya satu set elemen yang tipenya salah, misalnya bukan dari +% tipe set. +type_w_maybe_wrong_hi_lo=04022_W_lo/hi(dword/qword) mengembalikan upper/lower word/dword +% \fpc mendukung versi di-overload atas \var{lo/hi} untuk \var{longint/dword/int64/qword} +% yang mengembalikan lower/upper word/dword pada argumen. TP selalu menggunakan +% 16 bit \var{lo/hi} yang selalu mengembalikan bit 0..7 untuk \var{lo} dan +% bit 8..15 untuk \var{hi}. Jika anda menginginkan perilaku TP anda harus +% type cast argumennya ke \var{word/integer} +type_e_integer_or_real_expr_expected=04023_E_Ekspresi integer atau real diharapkan +% Argumen pertama pada \var{str} harus tipe real atau integer. +type_e_wrong_type_in_array_constructor=04024_E_Tipe "$1" salah dalam konstruktor array +% Anda mencoba untuk menggunakan tipe dalam konstruktor array yang tidak +% dibolehkan. +type_e_wrong_parameter_type=04025_E_Tipe tidak kompatibel untuk arg no. $1: Didapat "$2", diharapkan "$3" +% Anda mencoba untuk mengirimkan tipe yang salah untuk parameter yang ditetapkan. +type_e_no_method_and_procedure_not_compatible=04026_E_Metode (variabel) dan Prosedur (variabel) tidak kompatibel +% Anda tidak bisa menempatkan sebuah metode ke variabel prosedur atau prosedur +% ke sebuah pointer metode. +type_e_wrong_math_argument=04027_E_Konstan yang dikirimkan ke fungsi math internal tidak benar +% Argumen konstan yang dikirimkan ke fungsi ln atau sqrt di luar jangkauan +% definisi pada fungsi ini. +type_e_no_addr_of_constant=04028_E_Tidak bisas mengambil alamat dari ekspresi konstan +% Tidak mungkin untuk mendapatkan alamat ekspresi konstan, karena tidak disimpan +% dalam memori. Anda dapat mencoba membuat tipe konstan. Kesalahan ini juga bisa +% ditampilkan jika anda mencoba mengirimkan properti ke parameter var. +type_e_argument_cant_be_assigned=04029_E_Argumen tidak bisa ditempatkan +% Hanya ekspresi yang bisa di sisi kiri dari penempatan yang bisa dikirimkan +% sebagai panggilan dengan referensi argumen. +% Catatan: Properti hanya bisa dipakai pada sisi kiri dari penempatan, +% tapi ia tidak bisas digunakan sebagai argumen +type_e_cannot_local_proc_to_procvar=04030_E_Tidak bisa menempatkan prosedur/fungsi lokal ke variabel prosedur +% Tidak dibolehkan untuk menempatkan prosedur/fungsi lokal ke sebuah variabel +% prosedur, karena pemanggilan prosedur/fungsi lokal berbeda. Anda hanya bisa +% menempatkan prosedur/fungsi lokal ke sebuah pointer. +type_e_no_assign_to_addr=04031_E_Tidak bisa menempatkan nilai ke alamat +% Tidak dibolehkan untuk menempatkan nilai ke alamat dari variabel, konstan, +% prosedur atau fungsi. Anda dapat mencoba mengompilasi dengan -So jika pengenal +% adalah variabel procedure. +type_e_no_assign_to_const=04032_E_Tidak bisa menempatkan nilai ke variabel const +% Tidak dibolehkan untuk menempatkan nilai ke variabel yang dideklarasikan +% sebagai const. Ini biasanya parameter dideklarasikan sebagai const, untuk +% membolehkan perubahan nilai buat parameter sebagai parameter nilai atau var. +type_e_array_required=04033_E_Tipe array diperlukan +% Jika anda mengakses variabel menggunakan sebuah indeks '[<x>]' maka tipenya +% harus array. Dalam mode FPC, pointer juga dibolehkan. +type_e_interface_type_expected=04034_E_tipe interface diharapkan, tapi didapat "$1" +% Kompilator berharap menemukan nama tipe interface, tapi didapatkan yang lain. +% Kode berikut akan menimbulkan kesalahan ini: +% \begin{verbatim} +% Type +% TMyStream = Class(TStream,Integer) +% \end{verbatim} +type_w_mixed_signed_unsigned=04035_W_Mencampur ekspresi bertanda dan longword memberikan hasil 64bit +% Jika anda membagi (atau menghitung modulus dari) ekspresi bertanda dengan +% longword (atau sebaliknya), atau jika anda memiliki overflow dan/atau +% menghidupkan pemeriksaan jangkauan dan menggunakan ekspresi aritmatika +% (+, -, *, div, mod) dalam kedua angka bertanda dan longwords muncul, +% maka kesemuanya harus dievaluasi dalam 64bit yang lebih lambat daripada +% aritmatika 32bit normal. Anda bisa menghindari ini dengan typecasting satu +% operand agar ia sesuai tipe hasil atas yang lainnya. +type_w_mixed_signed_unsigned2=04036_W_Mencampur ekspresi bertanda dan cardinal di sini dapat menyebabkan kesalahan pemeriksaan jangkauan +% Jika anda menggunakan operator biner (and, or, xor) dan salah satu operand +% adalah longword sementara yang lainnya ekspresi bertanda, maka jika +% pemeriksaan jangkauan dihidupkan, anda akan mendapatkan kesalahan pemeriksaan +% jangkauan, karena kedua operand dikonversi ke longword sebelum operasi +% dilakukan. Anda dapat menghindari ini dengan typecasting satu operand agar +% sesuai dengan tipe hasil atas yang lain. +type_e_typecast_wrong_size_for_assignment=04037_E_Typecast mempunyai ukuran berbeda ($1 -> $2) dalam penempatan +% Type casting ke sebuah tipe dengan ukuran berbeda tidak dibolehkan saat +% variabel dipakai untuk penempatan. +type_e_array_index_enums_with_assign_not_possible=04038_E_enum dengan penempatan tidak bisa dipakai sebagai indeks array +% Ketika anda mendeklarasikan tipe enumerasi yang memiliki penempatan +% didalamnya, seperti dalam C, sepeprti berikut: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% anda tidak bisa menggunakannya sebagai indeks dari sebuah array. +type_e_classes_not_related=04039_E_Tipe Class atau Object "$1" dan "$2" tidak berkaitan +% Ada typecast dari satu kelas atau obyek ke yang lain sementara kelas/obyek itu +% tidak ada kaitannya. Ini akan menimbulkan kesalahan +type_w_classes_not_related=04040_W_Tipe kelas "$1" dan "$2" tidak berkaitan +% Ada typecast dari satu kelas atau obyek ke yang lain sementara kelas/obyek itu +% tidak ada kaitannya. Ini akan menimbulkan kesalahan +type_e_class_or_interface_type_expected=04041_E_Tipe Class atau interface diharapkan, tapi didapat "$1" +% Kompilator mengharapkan nama kelas atau interface, tapi mendapatkan tipe atau pengenal lain. +type_e_type_is_not_completly_defined=04042_E_Tipe "$1" tidak sepenuhnya didefinisikan +% Kesalahan ini terjadi saat tipe tidak lengkap: misalnya tipe pointer yang +% mengarah ke tipe tidak terdefinisi. +type_w_string_too_long=04043_W_Literal string memiliki lebih banyak karakter daripada panjang short string +% Ukuran string konstan, yang ditempatkan ke shortstring, lebih panjang daripada +% ukuran maksimum shortstring +type_w_signed_unsigned_always_false=04044_W_Perbandingan selalu salah karena jangkauan nilai +% Ada perbandingan antara nilai unsigned dan konstan bertanda yang kurang dari +% nol. Karena promosi tipe, pernyataan akan selalu dievaluasi menjadi false. +% Typecast secara eksplisit konstan ke jangkauan yang benar guna menghindari masalah ini. +type_w_signed_unsigned_always_true=04045_W_Perbandingan selalu true karena jangkauan nilai +% Ada perbandingan antara nilai unsigned dan konstan bertanda yang kurang dari +% nol. Karena promosi tipe, pernyataan akan selalu dievaluasi menjadi true. +% Typecast secara eksplisit konstan ke jangkauan yang benar guna menghindari masalah ini. +type_w_instance_with_abstract=04046_W_Membentuk sebuah kelas "$1" dengan metode abstrak +% Turunan kelas dibuat yang berisi metode abstrak tidak diimplementasikan. Ini +% dapat membawa kesalahan runtime 211 dalam kode jika rutin itu tidak pernah +% dibersihkan. Semua metode abstrak harus diganti. +type_h_in_range_check=04047_H_Operand kiri pada operator IN harus berukuran byte +% Operand kiri pada operator \var{in} bukan ordinal atau enumerasi yang sesuai +% dalam 8-bits, ini dapat mengakibatkan kesalahan pemeriksaan jangkauan. +% Operator \var{in} saat ini hanya mendukung operand kiri yang sesuai dalam byte. +% Dalam hal enumerasi, ukuran elemen pada enumerasi dapat dikontrol dengan +% saklar \var{\{\$PACKENUM\}} atau \var{\{\$Zn\}}. +type_w_smaller_possible_range_check=04048_W_Ukuran tipe tidak sama, kemungkinan kehilangan data / kesalahan pemeriksaan jangkauan +% Ada penempatan ke tipe lebih kecil daripada tipe sumber. Ini berarti bahwa +% ini dapat menyebabkan kesalahan pemeriksaan jangkauan, atau dapat mengakibatkan kehilangan data. +type_h_smaller_possible_range_check=04049_H_Ukuran tipe tidak sama, kemungkinan kehilangan data / kesalahan pemeriksaan jangkauan +% Ada penempatan ke tipe lebih kecil daripada tipe sumber. Ini berarti bahwa +% ini dapat menyebabkan kesalahan pemeriksaan jangkauan, atau dapat mengakibatkan kehilangan data. +type_e_cant_take_address_of_abstract_method=04050_E_Alamat metode abstrak tidak bisa diambil +% Metode abstrak tidak memiliki badan, maka alamat metode abstrak tidak bisa diambil. +type_e_assignment_not_allowed=04051_E_Penempatan ke parameter formal dan array terbuka tidak mungkin +% Anda mencoba untuk menempatkan nilai ke parameter formal (untyped var, const +% atau out), atau ke array terbuka. +type_e_constant_expr_expected=04052_E_Ekspresi Konstan diharapkan +% Kompilator mengharapkan ekspresi konstan, tapi mendapatkan ekspresi variabel. +type_e_operator_not_supported_for_types=04053_E_Operasi "$1" tidak didukung untuk tipe "$2" dan "$3" +% Operasi tidak dibolehkan untuk tipe yang disediakan +type_e_illegal_type_conversion=04054_E_Konversi tipe tidak benar: "$1" ke "$2" +% Ketika melakukan type-cast, anda harus berhati-hati bahwa ukuran variabel dan tipe +% tujuan adalah sama. +type_h_pointer_to_longint_conv_not_portable=04055_H_Konversi antara ordinal dan pointer tidak portabel +% Jika anda melakukan typecast pointer ke longint (atau sebaliknya), kode ini +% tidak akan dikompilasi pada mesin menggunakan 64-bit untuk penyimpanan pointer. +type_w_pointer_to_longint_conv_not_portable=04056_W_Konversi antara ordinal dan pointer tidak portabel +% Jika anda melakukan typecast pointer ke tipe ordinal pada ukuran berbeda +% (atau sebaliknya), ini dapat menyebabkan masalah. Ini adalah peringatan untuk +% membantu menemukan kode spesifik 32bit di mana cardinal/longint dipakai +% untuk typecast pointer ke ordinal. Solusinya sebaiknya menggunakan tipe ptrint/ptruint. +type_e_cant_choose_overload_function=04057_E_Tidak dapat menentukan fungsi di-overload mana yang dipanggil +% Anda memanggil fungsi di-overload dengan parameter yang tidak terkait ke daftar +% parameter fungsi yang dideklarasikan di manapun. Misalnya saat anda +% mendeklarasikan fungsi dengan parameter \var{word} dan \var{longint}, kemudian +% anda memanggilnya dengan parameter yang tipenya \var{integer}. +type_e_illegal_count_var=04058_E_Variabel penghitung tidak benar +% Tipe variabel loop \var{for} harus tipe ordinal. Variabel loop tidak bisa +% real atau string. +type_w_double_c_varargs=04059_W_Mengkonversi konstan nilai real ke double untuk argumen variabel C, tambah typecast eksplisit untuk menghindarinya. +% Dalam C, nilai konstan real adalah double standarnya. Untuk alasan ini, jika +% anda mengirimkan nilai konstan real ke argumen variabel bagian dari fungsi C, +% standarnya FPC mengkonversi konstan ini ke double juga. Jika anda ingin +% menghindari ini terjadi, tambah typecast eksplisit disekitar konstan. +type_e_class_or_cominterface_type_expected=04060_E_Tipe Class atau interface COM diharapkan, tapi didapat "$1" +% Beberapa operator seperti operator AS hanya berlaku pada kelas atau interface COM. +type_e_no_const_packed_array=04061_E_Konstan packed arrays belum didukung +% Anda tidak bisa mendeklarasikan (bit)packed array sebagai konstan type. +type_e_got_expected_packed_array=04062_E_Tipe tidak kompatibel untuk arg no. $1: Didapat "$2" diharapkan "(Bit)Packed Array" +% Kompilator mengharapkan (bit)packed array sebagai parameter yang dietapkan +type_e_got_expected_unpacked_array=04063_E_Tipe tidak kompatibel untuk arg no. $1: Didapat "$2" diharapkan "(Bit)Packed Array" +% Kompilator mengharapkan reguler (misalnya bukan packed) array sebagai parameter yang ditetapkan +type_e_no_packed_inittable=04064_E_Elemen pada packed arrays tidak bisa dari tipe yang perlu diinisialisasi +% Dukungan untuk packed array daru tuoe yang memerlukan inisialisasi (seperti +% ansistring, atau record yang berisi ansistring) belum diimplementasikan. +type_e_no_const_packed_record=04065_E_Konstan packed record dan obyek belum didukung +% Anda tidak bisa mendeklarasikan (bit)packed array sebagai typed konstan pada saat ini. +type_w_untyped_arithmetic_unportable=04066_W_Aritmatika "$1" pada pointer untyped tidak portabel bagi {$T+}, disarankan typecast +% Penambahan/pengurangan dari pointer untyped mungkin bekerja secara berbeda +% dalam \var{\{\$T+\}}, gunakan typecast untuk pointer typed +type_e_cant_take_address_of_local_subroutine=04076_E_Tidak bisa mengambil alamat dari subrutin yang ditandai sebagai lokal +% Alamat subrutin yang ditandai sebagai lokal tidak bisa diambil. +type_e_cant_export_local=04077_E_Tidak bisa mengekspor subrutin yang ditandai sebagai lokal dari sebuah unit +% Subrutin yang ditandai sebagai lokal tidak bisa diekspor dari sebuah unit. +type_e_not_automatable=04078_E_Tipe tidak bisa diotomasi: "$1" +% Hanya byte, integer, longint, smallint, currency, single, double, ansistring, +% widestring, tdatetime, variant, olevariant, wordbool dan semua interface bisa diotomasi. +type_h_convert_add_operands_to_prevent_overflow=04079_H_Mengkonversi operand ke "$1" sebelum melakukan penambahan dapat menghindari kesalahan overflow. +% Menambah dua tipe dapat menyebabkan kesalahan overflow. Karena anda +% mengkonversi hasil ke tipe lebih besar, anda dapat menghindari kesalahan +% seperti itu dengan mengubah operand ke tipe ini sebelum melakukan penambahan. +type_h_convert_sub_operands_to_prevent_overflow=04080_H_Mengkonversi operand ke "$1" sebelum melakukan pengurangan dapat menghindari kesalahan overflow. +% Pengurangan dua tipe dapat menyebabkan kesalahan overflow. Karena anda +% mengkonversi hasil ke tipe lebih besar, anda menghindari +% seperti itu dengan mengubah operand ke tipe ini sebelum melakukan pengurangan. +type_h_convert_mul_operands_to_prevent_overflow=04081_H_Mengkonversi operand ke "$1" sebelum melakukan perkalian dapat menghindari kesalahan overflow. +% Perkalian dua tipe dapat menyebabkan kesalahan overflow. Karena anda +% mengkonversi hasil ke tipe lebih besar, anda menghindari +% seperti itu dengan mengubah operand ke tipe ini sebelum melakukan pengurangan. +type_w_pointer_to_signed=04082_W_Mengkonversi pointer ke integer bertanda dapat membuat hasil perbandingan yang salah dan kesalahan jangkauan, sebaiknya gunakan tipe unsigned. +% Ruang alamat virtual pada mesin 32-bit berjalan dari \$00000000 sampai +% \$ffffffff. Banyak sistem operasi membeolehkan anda untuk mengalokasikan +% memori di atas \$80000000, sebagai contoh Windows dan Linux membolehkan +% pointer dalam jangkauan \$0000000 sampai \$bfffffff. Jika anda mengkonversi +% pointer ke tipe bertanda, ini dapat menyebabkan overflow dan kesalahan +% pemeriksaan jangkauan, tapi juga \$80000000 < \$7fffffff. +% Ini bisa menyebabkan kesalahan acak dalam kode seperti "if p>q". +% \end{description} +# +# Symtable +# +# 05060 is the last used one +# +% \section{Penanganan simbol} +% Seksi ini mendaftarkan semua pesan yang berkenaan dengan penanganan simbol. +% Ini berarti semua hal yang harus dilakukan dengan prosedur dan nama variabel. +% \begin{description} +sym_e_id_not_found=05000_E_Pengenal tidak ditemukan "$1" +% Kompilator tidak mengetahui simbol ini. Biasanya terjadi ketika anda salah +% mengeja nama variabel atau prosedur, atau ketika anda lupa untuk +% mendeklarasikan variabel. +sym_f_internal_error_in_symtablestack=05001_F_Kesalahan Internal dalam SymTableStack() +% Kesalahan internal terjadi dalam kompilator; Jika anda menemukan kesalahan ini, +% silahkan hubungi para pengembang dan coba untuk menyertakan penjelasan pasti +% dari keadaan di mana kesalahan terjadi. +sym_e_duplicate_id=05002_E_Duplikasi pengenal "$1" +% Pengenal sudah dideklarasikan dalam lingkup saat ini. +sym_h_duplicate_id_where=05003_H_Pengenal sudah didefinisikan dalam $1 pada baris $2 +% Pengenal sudah dideklarasikan dalam lingkup sebelumnya. +sym_e_unknown_id=05004_E_Pengenal "$1" tidak dikenal +% Pengenal ditemukan belum dideklarasikan, atai dipakai di luar lingkup +% di mana ia didefinisikan. +sym_e_forward_not_resolved=05005_E_Deklarasi fotidak memecahkan "$1" +% Ini dapat terjadi dalam dua kasus: +% \begin{itemize} +% \item Ini terjadi saat anda mendeklarasikan fungsi bagian (dalam \var{interface}, +% atau dengan direktif \var{forward}, tapi tidak mengimplementasikannya. +% \item Anda mereferensi tipe yang tidak dideklarasikan dalam blok \var{type} +% saat ini. +% \end{itemize} +sym_e_error_in_type_def=05007_E_Kesalahan dalam definisi tipe +% Ada kesalahan dalam definisi anda pada tipe array baru: +% \item Salah satu pembatas jangkauan dalam deklarasi array salah. +% Sebagai contoh, \var{Array [1..1.25]} akan memicu kesalahan ini. +sym_e_forward_type_not_resolved=05009_E_Tipe forward tidak memecahkan "$1" +% Simbol forward didefinisikan, tapi tidak ada deklarasi yang ditemukan. +sym_e_only_static_in_static=05010_E_Hanya variabel statis bisa dipakai dalam metode statis atau di luar metode +% Metode statis pada obyek hanya bisa mengakses variabel statis. +sym_f_type_must_be_rec_or_class=05012_F_tipe record atau class diharapkan +% Variabel atau ekspresi bukan tipe \var{record} atau \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_Turunan kelas atau obyek dengan metode abstrak tidak dibolehkan +% Anda mencoba untuk membuat turunan kelas yang memiliki metode abstrak yang +% tidak diganti. +sym_w_label_not_defined=05014_W_Label tidak didefinisikan "$1" +% Label dideklarasikan, tapi tidak didefinisikan. +sym_e_label_used_and_not_defined=05015_E_Label dipakai tapi tidak didefinisikan "$1" +% Label dideklarasikan dan dipakai, tapi tidak didefinisikan. +sym_e_ill_label_decl=05016_E_Deklarasi label tidak benar +% Kesalahan ini seharusnya tidak pernah terjadi; ia terjadi jika label +% didefinisikan di luar prosedur atau fungsi. +sym_e_goto_and_label_not_supported=05017_E_GOTO dan LABEL tidak didukung (gunakan saklar -Sg) +% Anda harus mengompilasi program yang mempunyai pernyataan \var{label}s dan \var{goto} +% dengan saklar \var{-Sg}. Standarnya, \var{label} dan \var{goto} tidak +% didukung. +sym_e_label_not_found=05018_E_Label tidak ditemukan +% \var{goto label} ditemukan, tapi label tidak dideklarasikan. +sym_e_id_is_no_label_id=05019_E_pengenal bukan sebuah label +% Pengenal ditetapkan setelah \var{goto} bukan tipe label. +sym_e_label_already_defined=05020_E_label sudah didefinisikan +% Anda mendefinisikan label dua kali. Anda bisa mendefinisikan label hanya sekali. +sym_e_ill_type_decl_set=05021_E_deklarasi tipe tidak benar pada set elemen +% Deklarasi sebuah set berisi definisi tipe yang tidak benar. +sym_e_class_forward_not_resolved=05022_E_Definisi kelas forward tidak memecahkan "$1" +% Anda mendeklarasikan kelas, tapi anda tidak mengimplementasikannya. +sym_n_unit_not_used=05023_H_Unit "$1" tidak dipakai dalam $2 +% Unit yang direferensi ulang dalam klausul \var{uses} tidak dipakai. +sym_h_para_identifier_not_used=05024_H_Parameter "$1" tidak dipakai +% Pengenal dideklarasikan (secara lokal atau global) tapi tidak dipakai +% (secara lokal atau global). +sym_n_local_identifier_not_used=05025_N_Variabel lokal "$1" tidak dipakai +% Anda telah mendeklarasikan, tapi tidak menggunakan variabel dalam implementasi +% prosedur atau fungsi. +sym_h_para_identifier_only_set=05026_H_Parameter nilai "$1" ditempati tetapi tidak dipakai +% Pengenal dideklarasikan (secara lokal atau global) dan disetel tapi tidak +% dipakai (secara lokal atau global). +sym_n_local_identifier_only_set=05027_N_Variabel lokal "$1" ditempati tapi tidak dipakai +% Implementasi variabel dalam prosedur atau fungsi dideklarasikan, disetel +% tapi tidak pernah digunakan. +sym_h_local_symbol_not_used=05028_H_Lokal $1 "$2" tidak dipakai +% Simbol lokal tidak pernah digunakan. +sym_n_private_identifier_not_used=05029_N_Field private "$1.$2" tidak pernah dipakai +% Field private didefinisikan, tapi tidak pernah dipakai dalam kode. +sym_n_private_identifier_only_set=05030_N_Field private "$1.$2" ditempati tapi tidak pernah dipakai +% Field private dideklarasikan, ditempati tapi tidak pernah dibaca. +sym_n_private_method_not_used=05031_N_Metode private "$1.$2" tidak pernah dipakai +% Metode private dideklarasikan tapi tidak pernah dipakai dalam kode. +sym_e_set_expected=05032_E_Tipe set diharapkan +% Variabel atau ekspresi bukan tipe \var{set}. Ini terjadi dalam pernyataan +% \var{in}. +sym_w_function_result_not_set=05033_W_Hasil fungsi nampaknya belum disetel +% Anda mendapatkan peringatan ini jika kompilator berpikir bahwa nilai kembalian +% fungsi tidak disetel. Ini tidak akan ditampilkan untuk prosedur assembler, +% atau prosedur yang berisi blok assembler. +sym_w_wrong_C_pack=05034_W_Tipe "$1" tidak dijajarkan dengan benar dalam record saat ini untuk C +% Array dengan ukuran tidak multipel dari 4 akan dijajarkan secara salah untuk +% struktur C. +sym_e_illegal_field=05035_E_Pengenal field record "$1" tidak dikenal +% Field tidak ada dalam definisi record/object. +sym_w_uninitialized_local_variable=05036_W_Variabel lokal "$1" nampaknya belum diinisialisasi +% Pesan ini ditampilkan jika kompilator berpikir bahwa variabel akan dipakai +% (misalnya muncul dalam ekspresi sisi-tangan-kanan) saat ia tidak +% diinisialisasi lebih dulu (misalnya muncul dalam sisi tangan-kiri pada +% penempatan) +sym_w_uninitialized_variable=05037_W_Variabel "$1" nampaknya belum diinisialisasi +% Pesan ini ditampilkan jika kompilator berpikir bahwa variabel akan dipakai +% (misalnya muncul dalam sisi tangan-kanan dari ekspresi) saat ia tidak +% diinisialisasi lebih dulu (misalnya muncul dalam sisi tangan-kiri pada +% penempatan) +sym_e_id_no_member=05038_E_pengenal idents tanpa anggota "$1" +% Kesalahan ini dibuat ketika pengenal record, field, atau metode diakses +% sementara ia tidak didefinisikan. +sym_h_param_list=05039_H_Ditemukan deklarasi: $1 +% Anda mendapatkan ini ketika anda menggunakan saklar \var{-vh}. Dalam hal +% prosedur yang di-overload tidak ditemukan, maka semua kandidat prosedur yang +% di-overload didaftarkan, dengan daftar parameternya. +sym_e_segment_too_large=05040_E_Elemen data terlalu besar +% Anda mendapatkan in ketika anda mendeklarasikan elemen data yang ukurannya +% melebihi batas yang ditetapkan (2 Gb pada prosesor 80386+/68020+) +sym_e_no_matching_implementation_found=05042_E_Tidak ada implementasi yang sesuai untuk metode interface "$1" yang ditemukan +% Tidak ada metode yang sama ditemukan yang dapat mengimplementasi metode +% interface. Periksa tipe argumen dan tipe hasil pada metode. +sym_w_deprecated_symbol=05043_W_Simbol "$1" tidak dipakai lagi +% Ini berarti bahwa simbol (variabel, rutin, dll...) yang dideklarasikan +% sebagai \var{deprecated} diterbitkan. Simbol deprecated mungkin tidak lagi +% tersedia dalam versi lebih baru atas unit / librari. Penggunaan simbol +% harus dihindari sebaik mungkin. +sym_w_non_portable_symbol=05044_W_Simbol "$1" tidak portabel +% Ini berarti bahwa sebuah simbol (variabel, rutin, dll...) yang dideklarasikan +% sebagai \var{platform} dipakai. Nilai simbol ini, penggunaannya serta +% ketersediaannya adalah spesifik platform dan tidak boleh dipakai jika kode +% sumber harus portabel. +sym_w_non_implemented_symbol=05055_W_Simbol "$1" tidak diimplementasikan +% Ini berarti bahwa sebuah simbol (variabel, rutin, dll...) yang dideklarasikan +% sebagai \var{unimplemented} dipakai. Simbol ini didefinisikan, tapi belum +% diimplementasikan pada spesifik platform ini. +sym_e_cant_create_unique_type=05056_E_Tidak bisa membuat tipe unik dari tipe ini +% Hanya tipe sederhana seperti ordinal, float dan tipe string didukung ketika +% mendefinisikan ulang tipe dengan \var{type newtype = type oldtype;}. +sym_h_uninitialized_local_variable=05057_H_Variabel lokal "$1" nampaknya belum diinisialisasi +% Pesan ini ditampilkan jika kompilator berpikir bahwa variabel yang akan +% dipakai (misalnya muncul dalam sisi-tangan-kiri atas ekspresi) saat ia tidak +% diinisialisasi lebih dulu (misalnya muncul dalam sisi tangan-kiri pada +% penempatan) +sym_h_uninitialized_variable=05058_H_Variabel "$1" nampaknya tidak diinisialisasi +% Pesan ini ditampilkan jika kompilator berpikir bahwa variabel yang akan +% dipakai (misalnya muncul dalam sisi-tangan-kiri atas ekspresi) saat ia tidak +% diinisialisasi lebih dulu (misalnya muncul dalam sisi tangan-kiri pada +% penempatan) +sym_w_function_result_uninitialized=05059_W_Variabel hasil fungsi nampaknya tidak diinisialisasi +% Pesan ini ditampilkan jika kompilator berpikir bahwa variabel hasil fungsi yang +% akan dipakai (misalnya muncul dalam sisi-tangan-kiri atas ekspresi) saat ia +% tidak diinisialisasi lebih dulu (misalnya muncul dalam sisi tangan-kiri pada +% penempatan) +sym_h_function_result_uninitialized=05060_H_Variabel hasil fungsi nampaknya tidak diinisialisasi +% Pesan ini ditampilkan jika kompilator berpikir bahwa variabel hasil fungsi +% yang akan dipakai (misalnya muncul dalam sisi-tangan-kanan atas ekspresi) saat +% tidak diinisialisasi lebih dulu (misalnya muncul dalam sisi tangan-kanan pada +% penempatan) +sym_w_identifier_only_read=05061_W_Variabel "$1" dibaca tapi tida ditempati dimanapun +% Anda membaca nilai sebuah variabel, tapi tidak menempatkan nilainya ke +% manapun. +sym_h_abstract_method_list=05062_H_Ditemukan metode abstrak: $1 +% Ketika mendapatkan peringatan mengenai pembentukan class/object dengan metode +% abstrak anda mendapatkan petunjuk ini untuk menemukan metode yang dipengaruhi. +% \end{description} +# +# Codegenerator +# +# 06040 is the last used one +# +% \section{Pesan pembuat kode} +% Seksi ini mendaftarkan semua pesan yang dapat ditampilkan jika generator +% kode menemukan kondisi kesalahan. +% \begin{description} +cg_e_parasize_too_big=06009_E_Ukuran daftar parameter melebihi 65535 byte +% Prosesor I386 membatasi daftar parameter ke 65535 byte (instruksi \var{RET} +% menyebabkan ini) +cg_e_file_must_call_by_reference=06012_E_Tipe file harus parameter var +% Anda tidak bisa menetapkan file sebagai parameter nilai, misalnya ia harus +% selalu dideklarasikan parameter \var{var}. +cg_e_cant_use_far_pointer_there=06013_E_Penggunaan pointer far tidak dibolehkan di sini +% Free Pascal tidak mendukung pointer far, maka anda tidak bisa mengambil alamat +% sebuah ekspresi yang memiliki referensi far sebagai hasil. Konstruksi \var{mem} +% mempunyai referensi far sebagai hasil, maka kode berikut akan menghasilkan +% kesalahan ini: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_Fungsi yang dideklarasikan EXPORT tidak bisa dipanggil +% Tidak dipakai lagi. +cg_w_member_cd_call_from_method=06016_W_Kemungkinan tidak benar pemanggilan atas constructor atau destructor +% Kompilator mendeteksi bahwa constructor atau destructor dipanggil di dalam +% sebuah metode. Ini mungkin akan menimbulkan masalah, karena constructors/ +% destructors memerlukan parameter saat masuk. +cg_n_inefficient_code=06017_N_Kode tidak efisien +% Pernyataan anda nampaknya diragukan oleh kompilator. +cg_w_unreachable_code=06018_W_Kode tidak bisa dicapai +% Anda menetapkan sebuah konstruksi yang tidak akan pernah dieksekusi. Contoh: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_Metode abstrak tidak bisa dipanggil secara langsung +% Anda tidak bisa memanggil metode abstrak secara langsung, sebaliknya anda +% harus memanggil metode anak penggantinya, karena metode abstrak tidak diterapkan. +cg_d_register_weight=06027_DL_Register $1 bobot $2 $3 +% Pesan debug. Ditampilkan saat kompilator menganggap variabel untuk dipelihara +% dalam register. +cg_d_stackframe_omited=06029_DL_Bingkai stack diabaikan +% Beberapa prosedur/fungsi tidak memerlukan bingkai stack lengkap, maka ia +% diabaikan. Pesan ini akan ditampilkan saat saklar {-vd} dipakai. +cg_e_unable_inline_object_methods=06031_E_Metode obyek atau kelas tidak bisa inline. +% Anda tidak bisa mempunyai metode obyek inlined. +cg_e_unable_inline_procvar=06032_E_Pemanggilan procvar tidak dalam inline. +% Prosedur dengan pemanggilan variabel prosedural tidak bisa disejajarkan. +cg_e_no_code_for_inline_stored=06033_E_Tidak ada kode untuk prosedur inline tersimpan +% Kompilator tidak bisa menyimpan kode untuk prosedur inline. +cg_e_can_access_element_zero=06035_E_Elemen nol dari ansi/wide- atau longstring tidak dapat diakses, sebaiknya gunakan (set)length +% Anda harus menggunakan \var{setlength} untuk menyetel panjang ansi/wide/longstring +% dan \var{length} untuk mendapatkan panjang dari tipe string tersebut +cg_e_cannot_call_cons_dest_inside_with=06037_E_Konstruktor atau Destruktor tidak bisa dipanggil di dalam klausul 'with' +% Di dalam klausul \var{with} anda tidak dapat memanggil sebuah konstruktor +% atau destruktor untuk obyek yang anda miliki dalam klausul \var{with}. +cg_e_cannot_call_message_direct=06038_E_Tidak bisa memanggil metode pengendali pesan secara langsung +% Pengendali metode pesan tidak bisa dipanggil secara langsung jika ia berisi +% argumen self eksplisit +cg_e_goto_inout_of_exception_block=06039_E_Lompat masuk atau keluar blok eksepsi +% Tidak dibolehkan untuk melompat masuk atau keluar dari blok eksepsi seperti \var{try..finally..end;}: +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // baris ini akan menimbulkan kesalahan +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_Pernyataan alur kontrol tidak dibolehkan dalam blok finally +% Tidak dibolehkan untuk menggunakan pernyataan alur kontrol \var{break}, +% \var{continue} dan \var{exit} +% di dalam pernyataan finally. Contoh berikut menampilkan masalah ini: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // Exit ini TIDAK diperbolehkan +% end; +% ... +% +% \end{verbatim} +% Jika prosedur \var{p} memunculkan eksepsi blok finally dijalankan. Jika +% eksekusi mencapai exit, tidak jelas apa yang dilakukan: +% keluar prosedur, atau mencari pengendali eksepsi yang lain +cg_w_parasize_too_big=06041_W_Ukuran parameters melebihi batas cpu tertentu +% Ini menunjukan bahwa anda mendeklarasikan lebih dari 64K parameter, yang +% mungkin tidak didukung pada prosesor target. +cg_w_localsize_too_big=06042_W_Ukuran variabel lokal melebihi batas untuk cpu tertetnu +% Ini menunjukan bahwa anda mendeklarasikan lebih dari 32K varbael lokal, yang +% mungkin tidak didukung pada prosesor target. +cg_e_localsize_too_big=06043_E_Ukuran variabel lokal melebihi batas yang didukung +% Ini menunjukan bahwa anda mendeklarasikan lebih dari 32K variabel lokal, yang +% tidak didukung oleh prosesor ini. +cg_e_break_not_allowed=06044_E_BREAK tidak diperbolehkan +% Anda mencoba untuk menggunakan \var{break} di luar konstruksi loop. +cg_e_continue_not_allowed=06045_E_CONTINUE tidak diperbolehkan +% Anda mencoba untuk menggunakan \var{continue} di luar konstruksi loop. +cg_f_unknown_compilerproc=06046_F_Tidak dikenal compilerproc "$1". Periksa apakah anda menggunakan run time library yang benar. +% Kompilator mengharapkan bahwa runtime library berisi subrutin tertentu. Jika +% anda melihat kesalahan ini dan anda tidak mengubah kode runtime library, +% nampaknya runtime library yang anda pakai tidak sesuai dengan kompilator. +% Jika anda mengubah runtime library kesalahan ini berarti bahwa anda +% menghapus subrutin yang diperlukan kompilator untuk pemakaian internalnya. +cg_f_unknown_system_type=06047_F_Tidak bisa menemukan tipe sistem "$1". Periksa apakah anda menggunakan run time library yang benar. +% Kompilator mengharapkan bahwa runtime library berisi definisi tipe tertentu. +% Jika anda melihat kesalahan ini dan anda tidak mengubah kode runtime library, +% nampaknya runtime library yang anda pakai tidak sesuai dengan kompilator. +% Jika anda mengubah runtime library kesalahan ini berarti bahwa anda +% menghapus subrutin yang diperlukan kompilator untuk pemakaian internalnya. +cg_h_inherited_ignored=06048_H_Pemanggilan turunan ke metode abstrak diabaikan +% Pesan ini hanya muncul dalam mode Delphi ketika anda memanggil metode abstract +% dari kelas leluhur via \var{inherited;}. Pemanggilan in kemudian diabaikan. +% \end{description} +# EndOfTeX + +# +# Assembler reader +# +# 07105 is the last used one +# +asmr_d_start_reading=07000_DL_Mulai penguraian assembler gaya $1 +% Ini memberitahu anda bahwa blok assembler sedang diuraikan +asmr_d_finish_reading=07001_DL_Selesasi penguraian assembler gaya $1 +% Ini memberitahu anda bahwa blok assembler sudah selesai. +asmr_e_none_label_contain_at=07002_E_Pola non-label berisi @ +% Pembeda yang bukan label tidak bisa berisi sebuah @. +asmr_e_building_record_offset=07004_E_Kesalahan pembangunan ofset record +% Terjadi kesalahan saat membangun ofset struktur record/object, +% ini bisa terjadi ketika tidak ada field yang ditetapkan sama sekali +% atau pembeda field yang dipakai tidak dikenal. +asmr_e_offset_without_identifier=07005_E_OFFSET dipakai tanpa pembeda +% Abda hanya bisa menggunakan OFFSET dengan sebuah pembeda. Sintaks lain tidak +% didukung +asmr_e_type_without_identifier=07006_E_TYPE dipakai tanpa pembeda +% Anda hanya bisa menggunakan TYPE dengan sebuah pembeda. Sintaks lain tidak +% didukung +asmr_e_no_local_or_para_allowed=07007_E_Tidak bisa menggunakan variabel lokal atau parameters di sini +% Anda tidak dapat menggunakan variabel lokal atau parameter di sini, karena +% pengalamatan lokal dan parameter dikerjakan menggunakan bingkai register pointer +% agar alamat tidak bisa diperoleh secara langsung. +asmr_e_need_offset=07008_E_perlu memakai OFFSET di sini +% Anda perlu menggunakan OFFSET <id> di sini untuk mendapatkan alamat pengenal. +asmr_e_need_dollar=07009_E_perlu memakai $ di sini +% Anda perlu menggunakan $<id> di sini untuk mendapatkan alamat pengenal. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_Tidak bisa menggunakan multipel simbol relocatable +% Anda tidak bisa mempunyai lebih dari satu simbol relocatable (variabel/konstan type) +% dalam satu argumen. +asmr_e_only_add_relocatable_symbol=07011_E_Simbol relocatable hanya dapat ditambahkan +% Simbol relocatable (variabel/konstan type) tidak bisa dipakai dengan operator +% lain. Hanya tambahan yang dibolehkan. +asmr_e_invalid_constant_expression=07012_E_Ekspresi konstan tidak benar +% Ada kesalahan dalam ekspresi konstan. +asmr_e_relocatable_symbol_not_allowed=07013_E_Simbol relocatable tidak dibolehkan +% Anda tidak bisa menggunakan simbol relocatable (variabel/konstan type) di sini. +asmr_e_invalid_reference_syntax=07014_E_Sintaks referensi tidak benar +% Ada kesalahan dalam referensi. +asmr_e_local_para_unreachable=07015_E_Anda tidak dapat mencapai $1 dari kode itu +% Anda tidak dapat membaca secara langsung nilai variabel lokal atau parameter +% dari tingkat prosedur lebih tinggi dalam kode assembler (kecuali untuk kode +% assembler lokal tanpa parameter maupun local). +asmr_e_local_label_not_allowed_as_ref=07016_E_Simbol local/label tidak dibolehkan sebagai referensi +% Anda tidak bisa menggunakan simbol lokal/label sebagai referensi +asmr_e_wrong_base_index=07017_E_Penggunaan basis dan indeks register tidak benar +% Ada kesalahan dengan base dan index register, keduanya mungkin +% tidak benar +asmr_w_possible_object_field_bug=07018_W_Kemungkinan kesalahan dalam penanganan field obyek +% Field obyek atau kelas dapat dicapai secara langsung dalam mode normal atau +% objfpc tapi mode TP dan Delphi memperlakukan nama field sebagai ofset sederhana. +asmr_e_wrong_scale_factor=07019_E_Faktor skala yang ditetapkan salah +% Faktor skala yang diberikan salah, hanya 1,2,4 dan 8 yang dibolehkan +asmr_e_multiple_index=07020_E_Penggunaan multipel indeks register +% Anda mencoba menggunakan lebih dari satu indeks register +asmr_e_invalid_operand_type=07021_E_Tipe operand tidak benar +% Tipe operand tidak sama dengan opcode yang dipakai +asmr_e_invalid_string_as_opcode_operand=07022_E_String sebagai opcode operand tidak benar: $1 +% String yang ditetapkan sebagai operand tidak sama dengan opcode ini +asmr_w_CODE_and_DATA_not_supported=07023_W_@CODE dan @DATA tidak didukung +% @CODE dan @DATA tidak didukung dan diabaikan. +asmr_e_null_label_ref_not_allowed=07024_E_Referensi label null tidak dibolehkan +asmr_e_expr_zero_divide=07025_E_Pembagian dengan nol dalam evaluator asm +% Ada pembagian dengan nol dalam ekspresi konstan +asmr_e_expr_illegal=07026_E_Ekspresi tidak benar +% Ada ekspresi tidak benar dalam ekspresi konstan +asmr_e_escape_seq_ignored=07027_E_urutan escape diabaikan: $1 +% Ada string bergaya-C, tapi urutan escape dalam string tidak dikenal, +% dan karenanya diabaikan +asmr_e_invalid_symbol_ref=07028_E_Referensi simbol tidak benar +asmr_w_fwait_emu_prob=07029_W_Fwait dapat menyebabkan masalah emulasi dengan emu387 +asmr_w_fadd_to_faddp=07030_W_$1 tanpa operand diterjemahkan menjadi $1P +asmr_w_enter_not_supported_by_linux=07031_W_Instruksi ENTER tidak didukung oleh Linux kernel +% Instruksi ENTER dapat membuat kesalahan halaman stack yang tidak ditangkap +% dengan benar oleh pengendali halaman i386 Linux. +asmr_w_calling_overload_func=07032_W_Pemanggilan fungsi overload dalam assembler +% Ada panggilan ke metode yang di-overload dalam blok assembler, ini dapat +% menjadi tanda di sana ada masalah +asmr_e_unsupported_symbol_type=07033_E_Tipe simbol untuk operand tidak didukung +asmr_e_constant_out_of_bounds=07034_E_Nilai konstan di luar jangkauan +asmr_e_error_converting_decimal=07035_E_Kesalahan konversi desimal $1 +% Nilai konstan desimal tidak memiliki sintaks yang benar +asmr_e_error_converting_octal=07036_E_Kesalahan konversi oktal $1 +% Nilai konstan oktal tidak memiliki sintaks yang benar +asmr_e_error_converting_binary=07037_E_Kesalahan konversi biner $1 +% Nilai konstan biner tidak memiliki sintaks yang benar +asmr_e_error_converting_hexadecimal=07038_E_Kesalahan konversi heksadesimal $1 +% Nilai konstan heksadesimal tidak memiliki sintaks yang benar +asmr_h_direct_global_to_mangled=07039_H_$1 diterjemahkan menjadi $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 dikaitkan ke fungsi yang di-overload +asmr_e_cannot_use_SELF_outside_a_method=07041_E_Tidak bisa menggunakan SELF di luar metode +% Ada referensi ke simbol \var{self} sementara ia tidak diijinkan. +% \var{self} hanya bisa direferensi di dalam metode +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_Tidak bisa menggunakan OLDEBP di luar prosedure yang diulang +% Ada referensi ke simbol \var{oldebp} sementara ia tidak diijinkan. +% \var{oldebp} hanya bisa direferensi di dalam rutin yang diulang +asmr_e_void_function=07043_W_Prosedure tidak bisa mengembalikan setiap nilai dalam kode asm +% Mencoba untuk mengembalikan nilai saat dalam sebuah prosedur. Sebuah prosedur +% tidak mempunyai nilai balik +asmr_e_SEG_not_supported=07044_E_SEG tidak didukung +asmr_e_size_suffix_and_dest_dont_match=07045_E_Ukuran sufiks dan tujuan atau sumber tidak sama +% Ukuran register dan sufiks ukuran opcode tidak sama. Ini mungkin kesalahan +% dalam pernyataan assembler +asmr_w_size_suffix_and_dest_dont_match=07046_W_Ukuran sufiks dan tujuan atau sumber tidak sama +% Ukuran register dan sufiks ukuran opcode tidak sama. Ini mungkin kesalahan +% dalam pernyataan assembler +asmr_e_syntax_error=07047_E_Sintaks assembler salah +% Ada kesalahan dalam sintaks assembler +asmr_e_invalid_opcode_and_operand=07048_E_Kombinasi opcode dan operand tidak benar +% Opcode tidak bisa dipakai dengan tipe operand ini +asmr_e_syn_operand=07049_E_Sintaks assembler salah dalam operand +asmr_e_syn_constant=07050_E_Kesalahan sintaks assembler dalam konstan +asmr_e_invalid_string_expression=07051_E_Ekspresi String tidak benar +asmr_w_const32bit_for_address=07052_W_konstan dengan simbol $1 untuk alamat yang tidak pada pointer +% Ekspresi konstan mewakili alamat yang tidak sesuai ke dalam sebuah pointer. +% Alamat mungkin tidak benar +asmr_e_unknown_opcode=07053_E_Opcode $1 tidak dikenal +% Opcode ini tidak dikenal +asmr_e_invalid_or_missing_opcode=07054_E_Tidak benar atau opcode hilang +asmr_e_invalid_prefix_and_opcode=07055_E_Kombinasi prefiks dan opcode tidak benar: $1 +asmr_e_invalid_override_and_opcode=07056_E_Kombinasi override dan opcode tidak benar: $1 +asmr_e_too_many_operands=07057_E_Terlalu banyak operand pada baris +% Ada terlalu banyak operand untuk opcode ini. Periksa sintaks assembler +% anda +asmr_w_near_ignored=07058_W_NEAR diabaikan +asmr_w_far_ignored=07059_W_FAR diabaikan +asmr_e_dup_local_sym=07060_E_Duplikasi simbol lokal $1 +asmr_e_unknown_local_sym=07061_E_Simbol lokal $1 tidak didefinisikan +asmr_e_unknown_label_identifier=07062_E_Pengenal label tidak dikenal $1 +asmr_e_invalid_register=07063_E_Nama register tidak benar +% Ada nama register tidak dikenal yang dipakai sebagai operand. +asmr_e_invalid_fpu_register=07064_E_Nama register floating point tidak benar +% Ada nama register tidak dikenal yang dipakai sebagai operand. +asmr_w_modulo_not_supported=07066_W_Modulo tidak didukung +asmr_e_invalid_float_const=07067_E_Konstan floating point $1 tidak benar +% Konstan floating point yang dideklarasikan dalam blok assembler tidak +% benar. +asmr_e_invalid_float_expr=07068_E_Ekspresi floating point tidak benar +% Ekspresi floating point yang dideklarasikan dalam blok assembler tidak +% benar. +asmr_e_wrong_sym_type=07069_E_Tipe simbol salah +asmr_e_cannot_index_relative_var=07070_E_Tidak bisa mengindeks var lokal atau parameter dengan register +% Mencoba untuk mengindeks menggunakan basis register simbol yang sudah relatif +% bagi register. Ini tidak mungkin, dan mungkin akan membawa kerusakan. +asmr_e_invalid_seg_override=07071_E_Ekspresi penggantian segmen tidak benar +asmr_w_id_supposed_external=07072_W_Pengenal $1 dianggap eksternal +% Ada referensi ke simbol yang tidak didefinisikan. Ini tidak menghasilkan +% kesalahan, karena simbol mungkin eksternal, tapi dapat menyebabkan masalah +% saat waktu link jika simbol tidak didefinisikan dimanapun. +asmr_e_string_not_allowed_as_const=07073_E_String tidak diijinkan sebagai konstan +% String karakter tidak dibolehkan sebagai konstan. +asmr_e_no_var_type_specified=07074_Tidak ada tipe variabel yang ditetapkan +% Sintaks mengharapkan tipe pengenal setelah titik, tapi tidak menemukan +% apapun. +asmr_w_assembler_code_not_returned_to_text=07075_E_kode assembler tidak dikembaliken ke seksi text +% Ada direktif dalam blok assembler untuk mengubah seksi, tapi di sana +% ada kekuarangan untuk ke seksi text di akhir blok assembler. Ini dapat +% menyebabkan kesalahan selama waktu link. +asmr_e_not_directive_or_local_symbol=07076_E_Bukan direktif atau simbol lokal $1 +% Simbol ini tidak dikenal. +asmr_w_using_defined_as_local=07077_E_Menggunakan nama yang didefinisikan sebagai label lokal +asmr_e_dollar_without_identifier=07078_E_Token dolar dipakai tanpa sebuah pengenal +% Ekspresi konstan memiliki pengenal yang tidak diawali dengan simbol $ +asmr_w_32bit_const_for_address=07079_W_Konstan 32bit dibuat untuk alamat +% Konstan dipakai sebagai alamat. Ini mungkin kesalahan karena menggunakan +% alamat absolut yang mungkin tidak akan bekerja. +asmr_n_align_is_target_specific=07080_N_.align adalah spesifik target, gunakan .balign atau .p2align +% Menggunakan direktif .align adalah spesifik platform, dan artinya akan +% berlainan dari satu platform ke yang lainnya. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_Tidak bisa mengakses field secara langsung untuk parameter +% Anda harus mengambil parameter lebih duku ke dalam register dan kemudian +% mengakses field menggunakan register itu. +asmr_e_cannot_access_object_field_directly=07082_E_Tidak bisa mengakses field dari obyek/kelas secara langsung +% Anda harus mengambil pointer self lebih dulu ke dalam register dan mengakses +% field menggunakan register sebagai basis. Standarnya pointer self tersedia +% dalam register esi pada i386. +asmr_e_unable_to_determine_reference_size=07083_E_Tidak ada ukuran yang ditetapkan dan tidak bisa menentukan besar operand +% Anda harus menetapkan secara eksplisit ukuran untuk referensi, karena kompilator +% tidak bisa menentukan ukuran apa (byte, word, dword, dll) ia harus dipakai +% untuk referensi. +asmr_e_cannot_use_RESULT_here=07084_E_Tidak bisa menggunakan RESULT dalam fungsi ini +% Beberapa fungsi yang mengembalikan tipe kompleks tidak bisa menggunakan kata +% kunci \var{result}. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" tanpa operand yang diterjemahkan ke dalam "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" diterjemahkan ke dalam "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" diterjemahkan ke dalam "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_Char < tidak dibolehkan di sini +% Operator shift memerlukan karakter <<. Hanya salah satu dari karakter itu +% yang ditemukan. +asmr_e_invalid_char_greater=07090_E_Char > tidak dibolehkan di sini +% Operator shift memerlukan karakter >>. Hanya salah satu dari karakter itu +% yang ditemukan. +asmr_w_align_not_supported=07093_W_ALIGN tidak didukung +asmr_e_no_inc_and_dec_together=07094_E_Inc dan Dec tidak bisa bersamaan +% Mencoba untuk menggunakan increment dan decrement di dalam opcode yang sama +% pada 680x0. Ini tidak mungkin. +asmr_e_invalid_reg_list_in_movem=07095_E_reglist untuk movem tidak benar +% Mencoba untuk menggunakan opcode \var{movem} dengan register yang tidak +% benar untuk menyimpan dan mengembalikan. +asmr_e_invalid_reg_list_for_opcode=07096_E_Reglist tidak benar untuk opcode +asmr_e_higher_cpu_mode_required=07097_E_Mode cpu lebih tinggi diperlukan ($1) +% Mencoba untuk menggunakan instruksi yang tidak didukung dalam mode cpu saat +% ini. Gunakan pembuatan cpu lebih tinggi agar bisa menggunakan opcode ini +% dalam blok assembler anda +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_Tidak ada ukuran yang ditetapkan dan tidak bisa menentukan besar operands, menggunakan DWORD sebagai standar +% Anda harus menetapkan secara eksplisit ukuran untuk referensi, karena +% kompilator tidak dapat menentukan ukuran apa (byte, word, dword, dll) +% yang harus dipakai untuk referensi. Peringatan ini hanya dipakai dalam mode +% Delphi di mana ia kembali menggunakan DWORD sebagai standar. +asmr_e_illegal_shifterop_syntax=07099_E_Kesalahan sintaks saat mencoba mengurai shifter operand +% Hanya ARM; ARM assembler mendukung apa yang disebut shifter operand. Sintaks +% yang dipakai bukan shifter operand yang benar. Contoh untuk operasi dengan shifter operand: +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +asmr_e_packed_element=07100_E_Alamat komponen yang di-packed tidak pada batasan byte +% Komponen yang di-packed (field record dan elemen array) dapat dimulai pada bit +% mana saja di dalam sebuah byte. Pada CPU yang tidak mendukung memori +% dialamatkan-bit (yang menyertakan semua CPU yang didukung oleh FPC saat ini) anda akan +% mendapatkan pesan kesalahan saat mencoba untuk mengindeks arrays dengan elemen +% yang ukurannya bukan multipel dari 8 bit. Hal yang sama untuk mengakses field record +% dengan alamat demikian dengan multipel dari 8 bit. +asmr_w_unable_to_determine_reference_size_using_byte=07101_W_Ukuran tidak ditetapkan dan tidak bisa menentukan besar dari operand, menggunakan BYTE sebagai standar +% Anda harus menetapkan secara eksplisit ukuran untuk referensi, karena +% kompilator tidak dapat menentukan ukuran apa (byte, word, dword, dll) +% yang harus dipakai untuk referensi. Peringatan ini hanya dipakai dalam mode +% Delphi di mana ia kembali menggunakan BYTE sebagai standar. +asmr_w_no_direct_ebp_for_parameter=07102_W_Penggunaan +offset(%ebp) untuk parameter di sini tidak benar +% Menggunakan referensi 8(%ebp) langsung untuk parameter fungsi/prosedur tidak +% benar jika parameter ada dalam register. +asmr_w_direct_ebp_for_parameter_regcall=07103_W_Penggunaan +offset(%ebp) tidak kompatibel dengan konvensi regcall +% Menggunakan referensi 8(%ebp) langsung untuk parameter fungsi/prosedur tidak +% benar jika parameter ada dalam register. +asmr_w_direct_ebp_neg_offset=07104_W_Penggunaan -offset(%ebp) tidak direkomendasikan untuk akses variabel lokal +% Menggunakan -8(%ebp) untuk mengakses variabel lokal tidak direkomendasikan +asmr_w_direct_esp_neg_offset=07105_W_Penggunaan -offset(%esp), akses dapat menyebabkan kerusakan atau nilai bisa hilang +% Menggunakan -8(%esp) untuk mengakses stack lokal tidak direkomendasikan karena +% bagian stack ini dapat diganti oleh setiap panggilan fungsi atau interrupt. +asmr_e_no_vmtoffset_possible=07106_E_VMTOffset harus dipakai dalam kombinasi dengan metode virtual, dan "$1" bukanlah virtual +% +# +# Assembler/binary writers +# +# 08018 is the last used one +# +asmw_f_too_many_asm_files=08000_F_Terlalu banyak file assembler +% Dengan menghidupkan smartlinking, ada terlalu banyak file assembler yang dibuat. +% Matikan smartlinking. +asmw_f_assembler_output_not_supported=08001_F_Output assembler yang dipilih tidak didukung +asmw_f_comp_not_supported=08002_F_Comp tidak didukung +asmw_f_direct_not_supported=08003_F_Direct tidak mendukung penulis biner +% Mode assembler direct tidak mendukung penulis biner. +asmw_e_alloc_data_only_in_bss=08004_E_Alikasi data hanya dibolehkan dalam seksi bss +asmw_f_no_binary_writer_selected=08005_F_Tidak ada penulis biner yang dipilih +asmw_e_opcode_not_in_table=08006_E_Asm: Opcode $1 tidak dalam tabel +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 kombinasi opcode dan operan tidak benar +asmw_e_16bit_not_supported=08008_E_Asm: referensi 16 Bit tidak didukung +asmw_e_invalid_effective_address=08009_E_Asm: Alamat efektif tidak benar +asmw_e_immediate_or_reference_expected=08010_E_Asm: Immediate atau referensi diharapkan +asmw_e_value_exceeds_bounds=08011_E_Asm: $1 nilai melebihi batasan $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: Lompat pendek di luar jangkauan $1 +asmw_e_undefined_label=08013_E_Asm: Label tidak didefinisikan $1 +asmw_e_comp_not_supported=08014_E_Asm: Tipe Comp tidak didukung untuk target ini +asmw_e_extended_not_supported=08015_E_Asm: Tipe Extended tidak didukung untuk target ini +asmw_e_duplicate_label=08016_E_Asm: Duplikasi label $1 +asmw_e_redefined_label=08017_E_Asm: Redefinisi label $1 +asmw_e_first_defined_label=08018_E_Asm: Pertama didefinisikan di sini +asmw_e_invalid_register=08019_E_Asm: register tidak benar $1 +asmw_e_16bit_32bit_not_supported=08020_E_Asm: Referensi 16 atau 32 Bit tidak didukung +asmw_e_64bit_not_supported=08021_E_Asm: 64 Bit operand tidak didukung + +# +# Menjalankan linker/assembler +# +# 09034 is the last used one +# +# BeginOfTeX +% +% \section{Kesalahan tahap assembling/linking} +% Seksi ini mendaftarkan kesalahan yang terjadi saat kompilator memproses +% baris perintah atau menangani file konfigurasi. +% \begin{description} +exec_w_source_os_redefined=09000_W_Sistem operasi sumber didefinisikan ulang +% Sistem operasi sumber didefinisikan ulang. +exec_i_assembling_pipe=09001_I_Assembling (pipe) $1 +% Meng-assembling menggunakan pipa ke assembler eksternal. +exec_d_cant_create_asmfile=09002_E_Tidak bisa membuat file assembler: $1 +% File yang disebutkan tadi tidak bisa dibuat. Periksa apakah anda memiliki +% perijinan akses untuk membuat file ini +exec_e_cant_create_objectfile=09003_E_Tidak bisa membuat file obyek: $1 +% File yang disebutkan tadi tidak bisa dibuat. Periksa apakah anda memiliki +% perijinan akses untuk membuat file ini +exec_e_cant_create_archivefile=09004_E_Tidak bisa membuat file arsip: $1 +% File yang disebutkan tadi tidak bisa dibuat. Periksa apakah anda memiliki +% perijinan akses untuk membuat file ini +exec_e_assembler_not_found=09005_E_Assembler $1 tidak ditemukan, beralih ke assmembling eksternal +% Program assembler tidak ditemukan. Kompilator akan menghasilkannaskah yang +% dapat dipakai untuk meng-assemble dan me-link program. +exec_t_using_assembler=09006_T_Menggunakan assembler: $1 +% Pesan informasi yang mengatakan assembler mana yang sedang dipakai. +exec_e_error_while_assembling=09007_E_Kesaslahan saat meng-assembling exitcode $1 +% Ada kesalahan saat meng-assembling file menggunakan assembler eksternal. +% Lihat dokumentasi piranti assembler guna mencari informasi lebih jauh +% mengenai kesalahan ini. +exec_e_cant_call_assembler=09008_E_Tidak bisa memanggil assembler, kesalahan $1 beralih ke assembling eksternal +% Kesalahan terjadi saat memanggil assembler eksternal, kompilator akan menghasilkan +% naskah yang dapat dipakai untuk meng-assemble dan link program. +exec_i_assembling=09009_I_Pemasangan $1 +% Pesan informasional yang menyatakan file yang sedang dipasang. +exec_i_assembling_smart=09010_I_Memasang dengan smartlinking $1 +% Pesan informasional yang menyatakan file mana yang sedang dipasang menggunakan smartlinking. +exec_w_objfile_not_found=09011_W_Obyek $1 tidak ditemukan, Linking bisa gagal ! +% Salah satu file obyek hilang, dan linking kemungkinan akan gagal. +% Periksa path anda. +exec_w_libfile_not_found=09012_W_Librari $1 tidak ditemukan, Linking bisa gagal ! +% Salah satu file librari hilang, dan linking kemungkinan akan gagal. +% Periksa path anda. +exec_e_error_while_linking=09013_E_Kesalahan saat me-link +% Kesalahan umum saat melakukan linking. +exec_e_cant_call_linker=09014_E_Tidak bisa memanggil linker, beralih ke eksternal linking +% Kesalahan terjadi saat memanggil linker eksternal, kompulator akan membuat naskah +% yang bisa dipakai untuk memasang dan me-link program. +exec_i_linking=09015_I_Linking $1 +% Pesan informasional, menampilkan program atau librari mana yang sedang di-link. +exec_e_util_not_found=09016_E_Util $1 tidak ditemukan, beralih ke eksternal linking +% Piranti eksternal tidak ditemukan, kompilator akan membuat naskah yang +% dapat dipakai untuk memasang dan me-link atau memproses akhir program. +exec_t_using_util=09017_T_Menggunakan util $1 +% Pesan informasional, menampilkan program eksternal mana (biasanya pemroses akhir) yang dipakai. +exec_e_exe_not_supported=09018_E_Pembuatan Executable tidak didukung +% Pembuatan program executable tidak didukung untuk platform ini, karena belum +% diimplementasikan dalam kompilator. +exec_e_dll_not_supported=09019_E_Pembuatan Librari Dinamis/Berbagai tidak didukung +% Pembuatan dynamically loadable libraries tidak didukung untuk platform ini, +% karena belum diimplementasikan dalam kompilator. +exec_i_closing_script=09020_I_Menutup naskah $1 +% Pesan informasional yang tampil saat naskah linking assembling eskternal selesai. +exec_e_res_not_found=09021_E_kompilator resource tidak ditemukan, beralih ke mode eksternal +% Kompilator resource eksternal tidak ditemukan, kompilator akan membuat naskah yang dapat +% dipakai untuk memasang, mengompilasi resources dan me-link atau memproses akhir program. +exec_i_compilingresource=09022_I_Mengompilasi resource $1 +% Pesan informasional, menampilkan resource mana yang sedang dikompilasi. +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_unit $1 tidak bisa di-link secara statis, beralih ke smart linking +% Link statis diminta, tapi unit yang dipakai bukan yang bisa di-link secara statis. +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_unit $1 tidak bisa di-link smart, beralih ke linking statis +% Smart linking diminta, tapi unit yang dipakai bukan yang bisa di-link samart. +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_unit $1 tidak bisa di-link berbagi, berlaih ke linking statis +% Link berbagi yang diminta, tapi unit yang dipakai bukan yang bisa berbagi link. +exec_e_unit_not_smart_or_static_linkable=09026_E_unit $1 tidak bisa di-link smart atau statis +% Link smart atau statis diminta, tapi unit yang dipakai tidak bisa digunakan untuk keduanya. +exec_e_unit_not_shared_or_static_linkable=09027_E_unit $1 tidak bisa di-link berbagi ataupun statis +% Link berbagi atau statis yang diminta, tapi unit bukan yang bisa melakukan keduanya. +exec_d_resbin_params=09028_D_Memanggil kompilator resource "$1" dengan "$2" sebagai baris perintah +% Pesan informasional yang menampilkan baris perintah mana yang dipakai untuk kompilator resource. +%\end{description} +# EndOfTeX + +# +# Informasi Executable +# +# BeginOfTeX +% \section{Pesan informasi executable.} +% Seksi ini mendaftarkan semua pesan yang dikeluarkan kompilator saat program +% executable dihasilkan, dan hanya ketika linker internal yang dipakai. +% \begin{description} +execinfo_f_cant_process_executable=09128_F_Tidak dapat memproses akhir executable $1 +% Kesalahan fatal saat kompilator tidak bisa memproses akhir sebuah executable. +execinfo_f_cant_open_executable=09129_F_Tidak bisa membuka executable $1 +% Kesalahan fatal saat kompilator tidak bisa membuka file untuk executable. +execinfo_x_codesize=09130_X_Besar Kode: $1 byte +% Pesan informasional yang menampilkan ukuran seksi kode yang dihasilkan. +execinfo_x_initdatasize=09131_X_Besar data diinisialisasi: $1 byte +% Pesan informasional yang menampilkan ukuran seksi data diinisialisasi. +execinfo_x_uninitdatasize=09132_X_Besar data tidak diinisialisasi: $1 byte +% Pesan informasional yang menampilkan ukuran seksi data yang tidak diinisialisasi. +execinfo_x_stackreserve=09133_X_Ruang stack terpakai: $1 byte +% Pesan informasional yang menampilkan ukuran stack yang dipakai kompilator untuk executable. +execinfo_x_stackcommit=09134_X_Ruang stack dikomit: $1 byte +% Pesan informasional yang menampilkan ukuran stack yang dikomit oleh kompilator untuk executable. +%\end{description} +# EndOfTeX + +# +# Pengambilan Unit +# +# 10041 is the last used one +# +# BeginOfTeX +% \section{Pesan pengambilan unit.} +% Seksi ini mendaftarkan semua pesan yang dapat terjadi saat kompilator +% menggambil unit dari disk ke dalam memori. Banyak dari pesan ini berupa +% pesan informasional. +% \begin{description} +unit_t_unitsearch=10000_T_Pencarian unit: $1 +% Ketika anda menggunakan saklar \var{-vt}, kompilator memberitahu anda ke mana +% ia mencoba mencari file unit. +unit_t_ppu_loading=10001_T_Pengambilan PPU $1 +% Saat saklar \var{-vt} dipakai, kompilator memberitahu anda +% unit apa yang diambil. +unit_u_ppu_name=10002_U_Nama PPU: $1 +% Saat anda menggunakan flag \var{-vu}, nama unit ditampilkan. +unit_u_ppu_flags=10003_U_Flag PPU: $1 +% Saat anda menggunakan flag \var{-vu}, flag unit ditampilkan. +unit_u_ppu_crc=10004_U_Crc PPU: $1 +% Saat anda memakai flag \var{-vu}, pemeriksaan CRC unit ditampilkan. +unit_u_ppu_time=10005_U_Waktu PPU: $1 +% Saat anda memakai flag \var{-vu}, waktu unit dikompilasi ditampilkan. +unit_u_ppu_file_too_short=10006_U_File PPU terlalu pendek +% File ppu terlalu pendek, tidak semua deklarasi ada di sana. +unit_u_ppu_invalid_header=10007_U_Header PPU tidak benar (tanpa PPU di awal) +% File unit berisi tiga byte pertama kode ascii \var{PPU} +unit_u_ppu_invalid_version=10008_U_Versi PPU tidak benar $1 +% File unit ini dikompilasi dengan versi kompilator berbeda, dan +% tidak bisa dibaca. +unit_u_ppu_invalid_processor=10009_U_PPU dikompilasi untuk prosesor lain +% File unit dikompilasi untuk tipe prosesor berbeda, dan +% tidak bisa dibaca +unit_u_ppu_invalid_target=10010_U_PPU dikompilasi untuk target lain +% File unit dikompilasi untuk target berbeda, dan +% tidak bisa dibaca +unit_u_ppu_source=10011_U_Sumber PPU: $1 +% Saat anda memakai flag \var{-vu}, nama file sumber ditampilkan. +unit_u_ppu_write=10012_U_Menuliskan $1 +% Saat anda menetapkan saklar \var{-vu}, kompilator akan memberitahu anda +% di mana ia menulis file unit. +unit_f_ppu_cannot_write=10013_F_Tidak bisa Menulis File-PPU +% Kesalahan terjadi saat menuliskan file unit. +unit_f_ppu_read_error=10014_F_Kesalahan membaca File-PPU +% Ini berarti bahwa file unit sudah rusak, dan berisi informasi tidak benar. +% Diperlukan rekompilasi. +unit_f_ppu_read_unexpected_end=10015_F_akhir File-PPU diharapkan +% Akhir file tidak diharapkan. Ini berarti bahwa file PPU +% rusak. +unit_f_ppu_invalid_entry=10016_F_Entri File-PPU tidak benar: $1 +% Unit yang coba dibaca kompilator rusak, atau dibuat dengan versi +% kompilator lebih baru. +unit_f_ppu_dbx_count_problem=10017_F_Masalah jumlah PPU Dbx +% Ada ketidak konsistenan dalam informasi debug pada unit. +unit_e_illegal_unit_name=10018_E_Nama unit tidak benar: $1 +% Nama unit tidak sama dengan nama file. +unit_f_too_much_units=10019_F_Terlalu banyak unit +% \fpc mempunyai batasan 1024 unit dalam sebuah program. Anda dapat mengubah +% perliaku ini dengan mengubah konstan \var{maxunits} dalam file \file{fmodule.pas} +% pada kompilator, dan mengompilasi ulang kompilator. +unit_f_circular_unit_reference=10020_F_Referensi unit berputar antara $1 dan $2 +% Dua unit saling menggunakan bagian interface. Ini hanya dibolehkan dalam +% bagian \var{implementation}. Setidaknya satu unit harus berisi satu yang +% lain dalam seksi \var{implementation}. +unit_f_cant_compile_unit=10021_F_Tidak bisa mengompilasi unit $1, tidak ada sumber tersedia +% Unit ditemukan yang memerlukan kompilasi ulang, tapi tidak ada file sumber +% yang tersedia. +unit_f_cant_find_ppu=10022_F_Tidak bisa menemukan unit $1 yang dipakai oleh $2 +% Anda mencoba untuk memakai sebuah unit di mana file PPU tidak ditemukan oleh +% kompilator. Periksas file konfigurasi anda untuk path unit +unit_w_unit_name_error=10023_W_Unit $1 tidak ditemukan tapi $2 ada +% Pesan kesalahan ini tidak dipakai lagi. +unit_f_unit_name_error=10024_F_Unit $1 dicari tapi $2 yang ditemukan +% Pemotongan Dos pada 8 huruf untuk file unit PPU dapat membawa +% masalah saat nama unit lebih panjang dari 8 huruf. +unit_w_switch_us_missed=10025_W_Mengompilasi unit sistem memerlukan saklar -Us +% Ketika mengompilasi ulang unit sistem (ia memerlukan perlakuan khusus), +% \var{-Us} harus ditetapkan. +unit_f_errors_in_unit=10026_F_Ada $1 kesalahan dalam mengompilasi modul, dihentikan +% Saat kompilator menemukan sebuah kesalahan fatal atau terlalu banyak kesalahan +% dalam sebuah modul maka ia berhenti dengan pesan ini. +unit_u_load_unit=10027_U_Diambil dari $1 ($2) unit $3 +% Saat anda memakai flag \var{-vu}, yang mana unit diambil dari unit itu +% ditampilkan. +unit_u_recompile_crc_change=10028_U_Rekompilasi $1, checksum berubah untuk $2 +% Unit dikompilasi ulang karena checksum unit di mana ia bergantung padanya +% sudah berubah. +unit_u_recompile_source_found_alone=10029_U_Rekompilasi $1, hanya ditemukan sumber +% Saat anda menggunakan flag \var{-vu}, pesan ini memberitahu anda mengapa +% unit saat ini dikompilasi ulang. +unit_u_recompile_staticlib_is_older=10030_U_Rekompilasi unit, lib statis lebih lama dari ppufile +% Saat anda menggunakan flag \var{-vu}, kompilator memperingatkan bila unit +% librari statis lebih lama dari file unit itu sendiri. +unit_u_recompile_sharedlib_is_older=10031_U_Rekompilasi unit, lib berbagi lebih lama dari ppufile +% Saat anda menggunakan flag \var{-vu}, kompilator memperingatkan bila unit +% librari berbagi lebih lama dari file unit itu sendiri. +unit_u_recompile_obj_and_asm_older=10032_U_Rekompilasi unit, obj dan asm lebih lama dari ppufile +% Saat anda menggunakan flag \var{-vu}, kompilator memperingatkan bila assembler +% atau file obyek pada unit lebih lama dari file unit itu sendiri. +unit_u_recompile_obj_older_than_asm=10033_U_Rekompilasi unit, obj lebih lama dari asm +% Saat anda menggunakan flag \var{-vu}, kompilator memperingatkan bila file +% assembler pada unit lebih lama dari file obyek dalam unit. +unit_u_parsing_interface=10034_U_Menguraikan interface pada $1 +% Saat anda menggunakan flag \var{-vu}, kompilator memperingatkan bahwa ia +% mulai menguraikan bagian interface pada unit +unit_u_parsing_implementation=10035_U_Menguraikan implementation pada $1 +% Saat anda menggunakan flag \var{-vu}, kompilator memperingatkan bahwa ia +% mulai menguraikan bagian implementation pada unit +unit_u_second_load_unit=10036_U_Pengambilan kedua untuk unit $1 +% Saat anda menggunakan flag \var{-vu}, kompilator memperingatkan bahwa ia +% mulai mengompilasi ulang unit untuk kedua kali. Ini dapat terjadi dengan +% unit interdependensi. +unit_u_check_time=10037_U_Pemeriksaan file PPU $1 waktu $2 +% Saat anda menggunakan flag \var{-vu}, kompilator menampilkan nama file dan +% tanggal serta waktu rekompilasi file diandalkan +### Dua pesan kesalahan berikut saat ini dimatikan. +#unit_h_cond_not_set_in_last_compile=10038_H_Kondisional $1 tidak disetel di awal dalam kompilasi terkahir $2 +#% Saat rekompilasi unit diperlukan, kompilator akan memeriksa kondisional +#% yang sama yang disetel untuk rekompilasi. Kompilator sudah menemukan +#% kondisional yang saat ini didefinisikan, tapi tidak dipakai terakhir kali +#% unit direkompilasi. +#unit_h_cond_set_in_last_compile=10039_H_Kondisional $1 disetel di awal dalam kompilasi terakhir $2 +#% Saat rekompilasi unit memerlukan kompilator memeriksa bahwa kondisional +#% yang sama disetel untuk rekompilasi. Kompilator sudah menemukan sebuah +#% kondisional yang dipakai terakhir kali unit dikompilasi, tetapi +#% kondisional saat ini tidak didefinisikan. +unit_w_cant_compile_unit_with_changed_incfile=10040_W_Tidak bisa merekompilasi unit $1, tapi ditemukan file include yang dimodifikasi +% Sebuah unit ditemukan di mana file include sudah diubah, tapi +% beberapa file sumber tidak ditemukan, maka rekompilasi tidak memungkinkan. +unit_u_source_modified=10041_U_File $1 lebih baru daripada file PPU $2 +% File sumber dimodifikasi untuk unit yang ditemukan kompilator. +unit_u_ppu_invalid_fpumode=10042_U_Mencoba menggunakan unit yang dikompilasi dengan mode FPU berbeda +% Mencoba untuk mengompilasi kode sementara menggunakan unit yang tidak +% dikompilasi dengan mode format pecahan yang sama. Baik semua kode harus +% dikompilasi dengan emulasi FPU on ataupun dengan emulasi FPU off. +unit_u_loading_interface_units=10043_U_Mengambil unit interface dari $1 +% Saat anda menggunakan flag \var{-vu}, kompilator meperingatkan bahwa ia +% mulai mengambil unit yang didefinisikan dalam bagian interface pada unit. +unit_u_loading_implementation_units=10044_U_Mengambil implementation unit dari $1 +% Saat anda menggunakan flag \var{-vu}, kompilator meperingatkan bahwa ia +% mulai mengambil unit yang didefinisikan dalam bagian implementation pada unit. +unit_u_interface_crc_changed=10045_U_CRC Interface berubah untuk unit $1 +% Saat anda menggunakan flag \var{-vu}, kompilator meperingatkan bahwa +% CRC yang dihitung untuk interface sudah berubah setelah interface +% diuraikan. +unit_u_implementation_crc_changed=10046_U_CRC Implementation berubah untuk unit $1 +% Saat anda menggunakan flag \var{-vu}, kompilator meperingatkan bahwa +% CRC yang dihitung sudah diubah setelah implementation +% diuraikan. +unit_u_finished_compiling=10047_U_Selesai mengompilasi unit $1 +% Saat anda menggunakan flag \var{-vu}, kompilator meperingatkan bahwa ia +% selesai mengompilasi unit. +unit_u_add_depend_to=10048_U_Menambah dependensi $1 ke $2 +% Saat anda menggunakan flag \var{-vu}, kompilator meperingatkan bahwa ia +% sudah menambahkan dependensi antara dua unit. +unit_u_no_reload_is_caller=10049_U_Tidak mengambil ulang, pemanggil: $1 +% Saat anda menggunakan flag \var{-vu}, kompilator meperingatkan bahwa ia +% tidak akan mengambil ulang unit karena ia adalah unit yang ingin +% mengambil unit ini +unit_u_no_reload_in_second_compile=10050_U_No reload, already in second compile: $1 +% Saat anda menggunakan flag \var{-vu}, kompilator meperingatkan bahwa ia +% tidak akan mengambil ulang unit karena sudah dalam rekompilasi kedua +unit_u_flag_for_reload=10051_U_Flag untuk mengambil ulang: $1 +% Saat anda menggunakan flag \var{-vu}, kompilator meperingatkan bahwa ia +% harus mengambil ulang unit +unit_u_forced_reload=10052_U_Pemaksaan pengambilan ulang +% Saat anda menggunakan flag \var{-vu}, kompilator meperingatkan bahwa ia +% mengambil ulang unit karen unit diperlukan +unit_u_previous_state=10053_U_Keadaan $1 sebelumnya: $2 +% Saat anda menggunakan flag \var{-vu}, kompilator menampilkan +% keadaan unit sebelumnya +unit_u_second_compile_unit=10054_U_Sudah mengompilasi $1, menyetel kompilasi kedua +% Saat anda menggunakan flag \var{-vu}, kompilator meperingatkan bahwa ia +% mulai mengompilasi ulang unit untuk kedua kali. Ini bisa terjadi dengan +% unit interdependensi. +unit_u_loading_unit=10055_U_Mengambil unit $1 +% Saat anda menggunakan flag \var{-vu}, kompilator meperingatkan bahwa ia +% mulai mengambil unit. +unit_u_finished_loading_unit=10056_U_Selesai mengambil unit $1 +% Saat anda menggunakan flag \var{-vu}, kompilator meperingatkan bahwa ia +% selesai mengambil unit. +unit_u_registering_new_unit=10057_U_Mendaftarkan unit baru $1 +% Saat anda menggunakan flag \var{-vu}, kompilator meperingatkan bahwa ia +% telah menemukan unit baru dan mendaftarkannya dalam daftar internal. +unit_u_reresolving_unit=10058_U_Memecahkan ulang unit $1 +% Saat anda menggunakan flag \var{-vu}, kompilator meperingatkan bahwa ia +% harus menghitung ulang data internal pada unit +unit_u_skipping_reresolving_unit=10059_U_Melewati pemecahan ulang unit $1, masih mengambil unit yang dipakai +% Saat anda menggunakan flag \var{-vu}, kompilator memperingatkan bahwa ia +% mulai melewati untuk menghitung ulang data internal pada unit karena di sana +% tidak ada data untuk dihitung ulang +% \end{description} +# EndOfTeX + +# +# Opsi +# +# 11041 is the last used one +# +option_usage=11000_O_$1 [opsi] <inputfile> [opsi] +# BeginOfTeX +% +% \section{Kesaslahan penanganan baris perintah} +% Seksi ini mendaftarkan kesalahan yang terjadi saat kompilator memproses +% baris perintah atau menangani file konfigurasi. +% \begin{description} +option_only_one_source_support=11001_W_Hanya satu file sumber didukung +% Anda dapat menetapkan hanya satu file sumber pada baris perintah. Yang +% pertama akan dikompilasi, yang lainnya akan diabaikan. Ini menunjukan bahwa +% anda melupakan tanda \var{'-'}. +option_def_only_for_os2=11002_W_File DEF hanya dapat dibuat untuk OS/2 +% Opsi ini hanya ditetapkan ketika anda mengompilasi untuk OS/2 +option_no_nested_response_file=11003_E_File respon berulang tidak didukung +% Anda tidak bisa mengulang file respon dengan opsi baris perintah \var{@file}. +option_no_source_found=11004_F_Nama file sumber tidak ada dalam baris perintah +% Kompilator mengharapkan nama file sumber pada baris perintah. +option_no_option_found=11005_N_Tidak ada opsi di dalam file konfig $1 +% Kompilator tidak menemukan setiap opsi dalam file konfig. +option_illegal_para=11006_E_Parameter tidak benar: $1 +% Anda menetapkan opsi yang tidak dikenal. +option_help_pages_para=11007_H_-? menulis halaman bantuan +% Ketika sebuah opsi tidak dikenal diberikan, pesan ini ditampilkan. +option_too_many_cfg_files=11008_F_Terlalu banyak file konfig yang diulang +% Anda hanya bisa mengulang sampai 16 file konfigurasi. +option_unable_open_file=11009_F_Tidak bisa membuka file $1 +% File opsi tidak bisa ditemukan. +option_reading_further_from=11010_D_Membaca opsi lanjutan dari $1 +% Ditampilkan saat anda menghidupkan catatan, dan kompilator beralih ke +% file opsi lain. +option_target_is_already_set=11011_W_Target sudah disetel ke: $1 +% Ditampilkan jika lebih dari satu opsi \var{-T} ditetapkan. +option_no_shared_lib_under_dos=11012_W_Libs berbagi tidak didukung pada DOS platform, membalikan ke statis +% Jika anda menetapkan \var{-CD} untuk platform \dos, pesan ini ditampilkan. +% Kompilator hanya mendukung libari statis di bawah \dos +option_too_many_ifdef=11013_F_terlalu banyak IF(N)DEF +% Pernyataan \var{\#IF(N)DEF} dalam file opsi tidak seimbang dengan pernyataan +% \var{\#ENDIF}. +option_too_many_endif=11014_F_terlalu banyak ENDIF +% Pernyataan \var{\#IF(N)DEF} dalam file opsi tidak seimbang dengan pernyataan +% \var{\#ENDIF}. +option_too_less_endif=11015_F_Kondisional terbuka di akhir file +% Pernyataan \var{\#IF(N)DEF} dalam file opsi tidak seimbang dengan pernyataan +% \var{\#ENDIF}. +option_no_debug_support=11016_W_Pembuatan informasi debug tidak didukung oleh executable ini +% Dimungkinkan untuk memiliki executable kompilator yang tidak mendukung +% pembuatan info debug. Jika anda menggunakan executable seperti itu dengan +% saklar \var{-g}, peringatan ini akan ditampilkan. +option_no_debug_support_recompile_fpc=11017_H_Coba rekompilasi dengan -dGDB +% Dimungkinkan untuk memiliki executable kompilator yang tidak mendukung +% pembuatan info debug. Jika anda menggunakan executable seperti itu dengan +% saklar \var{-g}, peringatan ini akan ditampilkan. +option_obsolete_switch=11018_W_Anda menggunakan saklar tidak terpakai $1 +% Ini memperingatkan anda saat anda menggunakan saklar yang tidak diperlukan/didukung lagi. +% Direkomendasikan bahwa anda menghapus saklar untuk menghindari masalah di masa +% mendatang, saat saklar mungkin diubah. +option_obsolete_switch_use_new=11019_W_Anda menggunakan saklar tidak terpakai $1, silahkan pakai $2 +% Ini memperingatkan anda saat anda memakai saklar yang tidak didukung lagi. +% sekarang sebaliknya anda harus menggunakan saklar kedua. +% Direkomendasikan bahwa anda menghapus saklar untuk menghindari masalah di masa +% mendatang, saat saklar mungkin diubah. +option_switch_bin_to_src_assembler=11020_N_Beralih assembler ke penulisan sumber assembler standar +% Ini memberitahu anda bahwa assembler sudah diubah karena anda menggunakan +% saklar -a yang tidak bisa dipakai dengan penulis assembler biner. +option_incompatible_asm=11021_W_Output assembler yang dipilih "$1" tidak kompatibel dengan "$2" +option_asm_forced=11022_W_"$1" assembler dipaksa dipakai +% Output assembler yang dipilih tidak dapat menghasilkan +% file obyek dengan format yang benar. Oleh karena itu, sebaliknya +% assembler standar untuk target ini digunakan. +option_using_file=11026_T_Membaca opsi dari file $1 +% Opsi juga dibaca dari file ini +option_using_env=11027_T_Membaca opsi dari lingkungan $1 +% Opsi juga dibaca dari string lingkungan ini +option_handling_option=11028_D_Menangani opsi "$1" +% Info debug yang opsinya ditemukan akan ditangani +option_help_press_enter=11029__*** tekan enter *** +option_start_reading_configfile=11030_H_Mulai membaca file konfigurasi $1 +% Memulai penguraian file konfigurasi. +option_end_reading_configfile=11031_H_Akhir pembacaan file konfigurasi $1 +% Akhir penguraian file konfigurasi. +option_interpreting_option=11032_D_menginterpretasikan opsi "$1" +option_interpreting_firstpass_option=11036_D_menginterpretasikan operan opsi pertama "$1" +option_interpreting_file_option=11033_D_menginterpretasikan opsi file "$1" +option_read_config_file=11034_D_Membaca file konfigurasi "$1" +option_found_file=11035_D_ditemukan nama file sumber "$1" +% Info tambahan mengenai opsi, ditampilkan saat anda menghidupkan opsi +% debug. +option_code_page_not_available=11039_E_Halaman kode tidak dikenal +option_config_is_dir=11040_F_File konfigurasi $1 adalah sebuah direktori +% Direktori tidak bisa dipakai sebagai file konfigurasi. +option_confict_asm_debug=11041_W_Output assembler yang dipilih "$1" tidak bisa menghasilkan info debug, debugging dimatikan +% Output assembler yang dipilih tidak dapat membuat informasi debug, +% oleh karenanya opsi debug dimatikan. +%\end{description} +# EndOfTeX + +# +# Logo (option -l) +# +option_logo=11023_[ +Free Pascal Compiler versi $FPCFULLVERSION [$FPCDATE] untuk $FPCCPU +Hak Cipta (c) 1993-2011 oleh Florian Klaempfl +] + +# +# Info (option -i) +# +option_info=11024_[ +Free Pascal Compiler versi $FPCVERSION + +Tanggal Kompilator : $FPCDATE +Target CPU Kompilator: $FPCCPU + +Target didukung: + $OSTARGETS + +Set instruksi CPU didukung: + $INSTRUCTIONSETS + +Set instruksi FPU didukung: + $FPUINSTRUCTIONSETS + +Optimasi Didukung: + $OPTIMIZATIONS + +Program ini datang bersama GNU General Public Licence +Untuk informasi lebih jauh baca COPYING.FPC + +Laporkan bugs, saran, dll ke: + http://bugs.freepascal.org +atau + bugs@freepascal.org +] + +# +# Halaman bantuan (opsi -? dan -h) +# +# Karakter pertama pada baris menunjukan siapa yang akan menampilkan baris +# ini, kemungkinan saat ini ialah : +# * = setiap target +# 3 = 80x86 target +# 6 = 680x0 target +# e = hanya dalam mode debug diperluas +# P = PowerPC target +# S = Sparc target +# V = Target mesin virtual +# Karakter kedua juga menunjukan siapa yang akan menampilkan baris ini, +# (jika karakter di atas adalah BENAR) kemungkinan saat ini ialah : +# * = setiap orang +# g = dengan info GDB yang didukung oleh kompilator +# O = OS/2 +# L = Sistem UNIX +# Karakter ketiga mewakili tingkat indentasi. +# +option_help_pages=11025_[ +**0*_Tambah + setelah opsi saklar boolean untuk menghidupkannya, - untuk mematikan +**1a_Kompilator tidak menghapus file assembler yang dibuat +**2al_Daftarkan baris kode sumber dalam file assembler +**2an_Daftarkan info node dalam file assembler +*L2ap_Gunakan pipa daripada pembuatan file assembler sementara +**2ar_Daftarkan info alokasi/pelepasan register dalam file assembler +**2at_Daftarkan info alokasi/pelepasan temp dalam file assembler +**1A<x>_Format output: +**2Adefault_Gunakan assembler standar +3*2Aas_Assemble menggunakan GNU AS +3*2Anasmcoff_File COFF (Go32v2) menggunakan Nasm +3*2Anasmelf_File ELF32 (Linux) menggunakan Nasm +3*2Anasmwin32_File obyek Win32 menggunakan Nasm +3*2Anasmwdosx_File obyek Win32/WDOSX menggunakan Nasm +3*2Awasm_File Obj menggunakan Wasm (Watcom) +3*2Anasmobj_File Obj menggunakan Nasm +3*2Amasm_File Obj menggunakan Masm (Microsoft) +3*2Atasm_File Obj menggunakan Tasm (Borland) +3*2Aelf_ELF (Linux) menggunakan penulis internal +3*2Acoff_COFF (Go32v2) menggunakan penulis internal +3*2Apecoff_PE-COFF (Win32) menggunakan penulis internal +4*2Aas_Rangkai menggunakan GNU AS +6*2Aas_File-0 Unix menggunakan GNU AS +6*2Agas_GNU Motorola assembler +6*2Amit_Sintaks MIT (GAS lama) +6*2Amot_Standard Motorola assembler +A*2Aas_Rangkai menggunakan GNU AS +P*2Aas_Rangkai menggunakan GNU AS +S*2Aas_Rangkai menggunakan GNU AS +**1b_Hasilkan info browser +**2bl_Hasilkan info simbol lokal +**1B_Bangun seluruh modul +**1C<x>_Opsi pembuatan kode: +**2Cc<x>_Setel konvensi pemanggilan standar ke <x> +**2CD_Buat juga librari dinamis (tidak didukung) +**2Ce_Kompilasi dengan opcode pecahan diemulasikan +**2Cf<x>_Pilih set instruksi fpu yang dipakai, lihat fpc -i untuk nilai yang mungkin +**2CF<x>_Minimal presisi konstan pecahan (standar, 32, 64) +**2Cg_Hasilkan kode PIC +**2Ch<n>_<n> byte heap (antara 1023 dan 67107840) +**2Ci_Pemeriksaan-IO +**2Cn_Abaikan tahap linking +**2Co_Periksa kelebihan untuk operasi integer +**2Cp<x>_Pilih set instruksi, lihat fpc -i untuk nilai yang mungkin +**2CP<x>=<y>_ setelan pemadatan +**3CPPACKSET=<y>_ <y> setel alokasi: 0, 1 atau DEFAULT atau NORMAL, 2, 4 dan 8 +**2Cr_Pemeriksaan jangkauan +**2CR_Verifikasi kebenaran pemanggilan metode obyek +**2Cs<n>_Setel besar stack menjadi <n> +**2Ct_Pemeriksaan stack +**2CX_Buat juga librari smartlinked +**1d<x>_Definisikan simbol <x> +**1D_Hasilkan file DEF +**2Dd<x>_Setel deskripsi menjadi <x> +**2Dv<x>_Setel versi DLL menjadi <x> +*O2Dw_Aplikasi PM +**1e<x>_Setel path ke executable +**1E_Sama seperti -Cn +**1fPIC_Sama seperti -Cg +**1F<x>_Setel nama file dan path: +**2Fa<x>[,y]_(untuk sebuah program) ambil unit <x> dan [y] sebelum uses diuraikan +**2Fc<x>_Setel input codepage menjadi <x> +**2FC<x>_Setel nama biner kompilator RC menjadi <x> +**2FD<x>_Setel direktori ke mana untuk menjcari utilitas kompilator +**2Fe<x>_Alihkan output kesalahan ke <x> +**2Ff<x>_Tambah <x> ke path kerangka kerja (hanya Darwin) +**2FE<x>_Setel path output exe/unit ke <x> +**2Fi<x>_Tambah <x> ke path include +**2Fl<x>_Tambah <x> ke path librari +**2FL<x>_Gunakan <x> sebagai linker dinamis +**2Fm<x>_Ambil tabel konversi unicode dari <x>.txt dalam dir kompilator +**2Fo<x>_Tambah <x> ke path obyek +**2Fr<x>_Ambil file pesan kesalahan <x> +**2FR<x>_Setel linker resource (.res) ke <x> +**2Fu<x>_Tambah <x> ke path unit +**2FU<x>_Setel path output unit ke <x>, ganti -FE +*g1g_Hasilkan informasi debug (format standar untuk target) +*g2gc_Hasilkan pemeriksaan untuk pointer +*g2gh_Gunakan unit heaptrace (untuk men-debug kebocoran/kerusakan memori) +*g2gl_Gunakan info baris unit (tampilkan info lebih lengkap dengan backtraces) +*g2go<x>_Setel opsi informasi debug +*g3godwarfsets_ Hidupkan informasi setelan debug Dwarf (pecahkan gdb < 6.5) +*g2gp_Siapkan jenis huruf dalam nama simbol stabs +*g2gs_Hasilkan informasi debug stabs +*g2gt_Bersihkan variabel lokal (untuk mendeteksi uses tak terinisialisasi) +*g2gv_Hasilkan program yang bisa dilacak oleh valgrind +*g2gw_Hasilkan informasi debug dwarf-2 (sama seperti -gw2) +*g2gw2_Hasilkan informasi debug dwarf-2 +*g2gw3_Hasilkan informasi debug dwarf-3 +**1i_Informasi +**2iD_Kembalikan tanggal kompilator +**2iV_Kembalikan versi pendek kompilator +**2iW_Kembalikan versi lengkap kompilator +**2iSO_Kemblikan OS kompilator +**2iSP_Kembalikan prosesor host kompilator +**2iTO_Kembalikan OS target +**2iTP_Kembalikan prosesor target +**1I<x>_Tambah <x> ke path include +**1k<x>_Operkan <x> ke linker +**1l_Tulis logo +**1M<x>_Setel mode bahasa menjadi <x> +**2Mfpc_Dialek Free Pascal (standar) +**2Mobjfpc_Mode FPC dengan dukungan Obyek Pascal +**2Mdelphi_Mode kompatibilitas Delphi 7 +**2Mtp_Mode kompatibilitas TP/BP 7.0 +**2Mmacpas_Mode kompatibilitas dialek Macintosh Pascal +**1n_Jangan baca file konfigurasi standar +**1N<x>_Optimasi susunan node +**2Nu_Jangan gulung pengulangan +**1o<x>_Ubah nama executable yang dihasilkan ke <x> +**1O<x>_Optimasi: +**2O-_Matikan optimasi +**2O1_Optimasi tingkat 1 (cepat dan ramah debugger) +**2O2_Optimasi tingkat 2 (-O1 + optimasi cepat) +**2O3_Optimasi tingkat 3 (-O2 + optimasi lambat) +**2Oa<x>=<y>_Setel penjajaran +**2Oo[NO]<x>_Hidupkan atau matikan optimasi, lihat fpc -i untuk nilai yang mungkin +**2Op<x>_Setel cpu target untuk optimasi, lihat fpc -i untuk nilai yang mungkin +**2Os_Optimasi untuk ukuran daripada kecepatan +**1pg_Hasilkan kode profil untuk gprof (definisikan FPC_PROFILE) +**1R<x>_Gaya pembacaan assembler: +**2Rdefault_Gunakan assembler standar untuk target +3*2Ratt_Baca gaya assembler AT&T +3*2Rintel_Baca gaya assembler Intel +6*2RMOT_Baca gaya assembler Motorola +**1S<x>_Opsi sintaks: +**2S2_Sama seperti -Mobjfpc +**2Sc_Dukung operator seperti C (*=,+=,/= and -=) +**2Sa_Hidupkan assertions +**2Sd_Sama seperti -Mdelphi +**2Se<x>_Opsi kesalahan. <x> adalah kombinasi dari yang berikut: +**3*_<n> : Kompilator batal setelah <n> kesalahan (standarnya 1) +**3*_w : Kompilator juga batal setelah peringatan +**3*_n : Kompilator juga batal setelah catatan +**3*_h : Kompilator juga batal setelah petunjuk +**2Sg_Hidupkan LABEL dan GOTO (standar dalam -Mtp dan -Mdelphi) +**2Sh_Gunakan ansistrings secara standar daripada shortstrings +**2Si_Hidupkan inlining procedures/functions yang dideklarisak sebagai "inline" +**2Sk_Ambil unit fpcylix +**2SI<x>_Setel gaya antarmuka ke <x> +**3SIcom_Antarmuka kompatibel COM (standar) +**3SIcorba_Antarmuka kompatibel CORBA +**2Sm_Dukung makro seperti C (global) +**2So_Sama seperti -Mtp +**2Ss_Nama konstruktor harus init (destruktor harus done) +**2Sx_Hidupkan kata kunci exception (standar dalam mode Delphi/ObjFPC) +**1s_Jangan panggil assembler dan linker +**2sh_Hasilkan naskah untuk me-link pada host +**2st_Hasilkan naskah untuk me-link pada target +**2sr_Lewati tahap alokasi register (gunakan dengan -alr) +**1T<x>_Sistem operasi target: +3*2Temx_OS/2 via EMX (termasuk EMX/RSX extender) +3*2Tfreebsd_FreeBSD +3*2Tgo32v2_Versi 2 pada DJ Delorie DOS extender +3*2Tlinux_Linux +3*2Tnetbsd_NetBSD +3*2Tnetware_Novell Netware Module (clib) +3*2Tnetwlibc_Novell Netware Module (libc) +3*2Topenbsd_OpenBSD +3*2Tos2_OS/2 / eComStation +3*2Tsunos_SunOS/Solaris +3*2Twatcom_Watcom kompatibel DOS extender +3*2Twdosx_WDOSX DOS extender +3*2Twin32_Windows 32 Bit +3*2Twince_Windows CE +4*2Tlinux_Linux +6*2Tamiga_Commodore Amiga +6*2Tatari_Atari ST/STe/TT +6*2Tlinux_Linux/m68k +6*2Tmacos_Macintosh m68k (tidak didukung) +6*2Tpalmos_PalmOS +A*2Tlinux_Linux +A*2Twince_Windows CE +P*2Tamiga_AmigaOS pada PowerPC +P*2Tdarwin_Darwin dan Mac OS X pada PowerPC +P*2Tlinux_Linux pada PowerPC +P*2Tmacos_Mac OS (klasik) pada PowerPC +P*2Tmorphos_MorphOS +S*2Tlinux_Linux +**1u<x>_Simbol tidak didefinisikan <x> +**1U_Opsi unit: +**2Un_Jangan periksa di mana nama unit sama dengan nama file +**2Ur_Hasilkan file unit rilis (jangan dikompilasi secara otomatis) +**2Us_Kompilasi unit sistem +**1v<x>_Ditampilkan. <x> adalah kombinasi dari huruf berikut: +**2*_e : Tampilkan kesalahan (default) 0 : Jangan tampilkan (kecuali kesalahan) +**2*_w : Tampilkan peringatan u : Tampilkan info unit +**2*_n : Tampilkan catatan t : Tampilkan file yang dicoba/dipakai +**2*_h : Tampilkan petunjuk c : Tampilkan kondisional +**2*_i : Tampilkan info umum d : Tampilkan info debug +**2*_l : Tampilkan nomor baris r : Mode kompatibilitas Rhide/GCC +**2*_a : Tampilkan semuanya x : Info executable (hanya Win32) +**2*_b : Tulis pesan nama file dengan path lengkap +**2*_v : Tulis fpcdebug.txt dengan p : Tulis tree.log dengan susunan urai +**2*_ banyak info debug +3*1W<x>_Opsi spesifik-target (target) +A*1W<x>_Opsi spesifik-target (target) +P*1W<x>_Opsi spesifik-target (target) +3*2Wb_Buat sebuah bundel daripada sebuah librari (Darwin) +P*2Wb_Buat sebuah bundel daripada sebuah librari (Darwin) +p*2Wb_Buat sebuah bundel daripada sebuah librari (Darwin) +3*2WB_Buat citra relokatabel (Windows) +A*2WB_Buat citra relokatabel (Windows, Symbian) +3*2WC_Tetapkan aplikasi tipe konsol (EMX, OS/2, Windows) +A*2WC_Tetapkan aplikasi tipe konsol (Windows) +P*2WC_Tetapkan aplikasi tipe konsol (Mac OS Klasik) +3*2WD_Gunakan DEFFILE untuk mengekspor fungsi DLL atau EXE (Windows) +A*2WD_Gunakan DEFFILE untuk mengekspor fungsi DLL atau EXE (Windows) +3*2WF_Tetapkan aplikasi tipe layar-penuh (EMX, OS/2) +3*2WG_Tetapkan aplikasi tipe grafis (EMX, OS/2, Windows) +A*2WG_Tetapkan aplikasi tipe grafis (Windows) +P*2WG_Tetapkan aplikasi tipe grafis (Classic Mac OS) +3*2WN_Jangan hasilkan kode relokasi, diperlukan untuk debugging (Windows) +A*2WN_Jangan hasilkan kode relokasi, diperlukan untuk debugging (Windows) +3*2WR_Hasilkan kode relokasi (Windows) +A*2WR_Hasilkan kode relokasi (Windows) +P*2WT_Tetapkan aplikasi tipe piranti MPW (Mac OS Klasik) +**1X_Opsi executable: +**2Xc_Oper --shared/-dynamic ke linker (BeOS, Darwin, FreeBSD, Linux) +**2Xd_Jangan gunakan path pencarian librari standar (diperlukan untuk kompilasi silang) +**2Xe_Gunakan linker eksternal +**2XD_Coba untuk me-link unit secara dinamis (definisikan FPC_LINK_DYNAMIC) +**2Xi_Gunakan linker internal +**2Xm_Hasilkan peta link +**2XM<x>_Set nama rutin program 'main' (standarnya 'main') +**2XP<x>_Awali nama binutils dengan prefiks <x> +**2Xr<x>_Setel path pencarian librari ke <x> (diperlukan untuk kompilasi silang) +**2Xs_Buang semua simbol dari executable +**2XS_Coba untuk me-link unit secara statis (standar, definisikan FPC_LINK_STATIC) +**2Xt_Link dengan librari statis (-static dioper ke linker) +**2XX_Coba untuk smartlink unit (definisikan FPC_LINK_SMART) +**1*_ +**1?_Tampilkan bantuan ini +**1h_Tampilkan bantuan ini tanpa menunggu +] + +# +# The End... diff --git a/closures/compiler/msg/erroriu.msg b/closures/compiler/msg/erroriu.msg new file mode 100644 index 0000000000..217f99b022 --- /dev/null +++ b/closures/compiler/msg/erroriu.msg @@ -0,0 +1,3048 @@ +# +# This file is part of the Free Pascal Compiler +# Copyright (c) 1999-2009 by the Free Pascal Development team +# +# Italian Language File for Free Pascal +# Contributed by Massimo Soricetti <notturno at quipo.it> +# Translation for FPC 2.4.2, april 16, 2011, Tolentino, Italy +# +# 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. +# +# +# The constants are build in the following order: +# <part>_<type>_<txtidentifier> +# +# <part> is the part of the compiler the message is used +# asmr_ assembler parsing +# asmw_ assembler writing/binary writers +# unit_ unit handling +# scan_ scanner +# parser_ parser +# type_ type checking +# general_ general info +# exec_ calls to assembler, external linker, binder +# link_ internal linker +# +# <type> the type of the message it should normally used for +# f_ fatal error +# e_ error +# w_ warning +# n_ note +# h_ hint +# i_ info +# l_ add linenumber +# u_ used +# t_ tried +# c_ conditional +# d_ debug message +# x_ executable informations +# o_ normal (e.g., "press enter to continue") +# + +# +# General +# +# 01023 is the last used one +# +# BeginOfTeX +% \section{General compiler messages} +% This section gives the compiler messages which are not fatal, but which +% display useful information. The number of such messages can be +% controlled with the various verbosity level \var{-v} switches. +% \begin{description} +general_t_compilername=01000_T_Compilatore: $1 +% When the \var{-vt} switch is used, this line tells you what compiler +% is used. +general_d_sourceos=01001_D_Sistema operativo del compilatore: $1 +% When the \var{-vd} switch is used, this line tells you what the source +% operating system is. +general_i_targetos=01002_I_Sistema operativo di destinazione: $1 +% When the \var{-vd} switch is used, this line tells you what the target +% operating system is. +general_t_exepath=01003_T_Path degli eseguibili: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its binaries. +general_t_unitpath=01004_T_Path delle unit: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for compiled units. You can set this path with the \var{-Fu} option. +general_t_includepath=01005_T_Path degli include: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its include files (files used in \var{\{\$I xxx\}} statements). +% You can set this path with the \var{-Fi} option. +general_t_librarypath=01006_T_Path delle library: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for the libraries. You can set this path with the \var{-Fl} option. +general_t_objectpath=01007_T_Path dei file oggetto: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for object files you link in (files used in \var{\{\$L xxx\}} statements). +% You can set this path with the \var{-Fo} option. +general_i_abslines_compiled=01008_I_$1 righe compilate, $2 sec $3 min +% When the \var{-vi} switch is used, the compiler reports the number +% of lines compiled, and the time it took to compile them (real time, +% not program time). +general_f_no_memory_left=01009_F_Memoria esaurita +% The compiler doesn't have enough memory to compile your program. There are +% several remedies for this: +% \begin{itemize} +% \item If you're using the build option of the compiler, try compiling the +% different units manually. +% \item If you're compiling a huge program, split it up into units, and compile +% these separately. +% \item If the previous two don't work, recompile the compiler with a bigger +% heap. (You can use the \var{-Ch} option for this, \seeo{Ch}.) +% \end{itemize} +general_i_writingresourcefile=01010_I_Scrivo il file di risorse della stringtable: $1 +% This message is shown when the compiler writes the Resource String Table +% file containing all the resource strings for a program. +general_e_errorwritingresourcefile=01011_E_Scrivo il file di risorse della stringtable: $1 +% This message is shown when the compiler encounters an error when writing +% the Resource String Table file. +# +# +# La finestra dei messaggi di Lazarus filtra via tutto quello che non comincia +# con uno di questi cinque prefissi in inglese (o meglio Lazarus versione 0.9.30 lo fa) +# per cui, almeno per ora, ce li dobbiamo tenere :-( +# Fanno eccezione 'Fatale' e 'Errore' perché sono identici alle versioni inglesi, ma più lunghi. +# +# +general_i_fatal=01012_I_Fatale: +% Prefix for Fatal Errors. +general_i_error=01013_I_Errore: +% Prefix for Errors. +general_i_warning=01014_I_Warning: +% Prefix for Warnings. +general_i_note=01015_I_Note: +% Prefix for Notes. +general_i_hint=01016_I_Hint: +% Prefix for Hints. +general_e_path_does_not_exist=01017_E_Il path "$1" non esiste +% The specified path does not exist. +general_f_compilation_aborted=01018_F_Compilazione abortita +% Compilation was aborted. +general_text_bytes_code=01019_I_$1 byte di codice +% The size of the generated executable code, in bytes. +general_text_bytes_data=01020_I_$1 byte di dati +% The size of the generated program data, in bytes. +general_i_number_of_warnings=01021_I_$1 attenzioni date +% Total number of warnings issued during compilation. +general_i_number_of_hints=01022_I_$1 consigli dati +% Total number of hints issued during compilation. +general_i_number_of_notes=01023_I_$1 note date +% Total number of notes issued during compilation. +% \end{description} +# +# Scanner +# +# 02086 is the last used one +# +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compilation handling. +% \begin{description} +scan_f_end_of_file=02000_F_Il file è terminato troppo presto +% This typically happens in one of the following cases: +% \begin{itemize} +% \item The source file ends before the final \var{end.} statement. This +% happens mostly when the \var{begin} and \var{end} statements aren't +% balanced; +% \item An include file ends in the middle of a statement. +% \item A comment was not closed. +% \end{itemize} +scan_f_string_exceeds_line=02001_F_La stringa continua su più righe +% There is a missing closing ' in a string, so it occupies +% multiple lines. +scan_f_illegal_char=02002_F_il carattere "$1" ($2) non è ammesso +% An illegal character was encountered in the input file. +scan_f_syn_expected=02003_F_Errore di sintassi: era atteso "$1" ma non "$2" +% This indicates that the compiler expected a different token than +% the one you typed. It can occur almost anywhere it is possible to make an error +% against the Pascal language. +scan_t_start_include_file=02004_TL_Inizio lettura del file include $1 +% When you provide the \var{-vt} switch, the compiler tells you +% when it starts reading an included file. +scan_w_comment_level=02005_W_Trovato commento di livello $1 +% When the \var{-vw} switch is used, then the compiler warns you if +% it finds nested comments. Nested comments are not allowed in Turbo Pascal +% and Delphi, and can be a possible source of errors. +scan_n_ignored_switch=02008_N_Ignorato lo switch "$1" del compilatore +% With \var{-vn} on, the compiler warns if it ignores a switch. +scan_w_illegal_switch=02009_W_Lo switch "$1" del compilatore non è ammesso +% You included a compiler switch (i.e. \var{\{\$... \}}) which the compiler +% does not recognise. +scan_w_switch_is_global=02010_W_Switch globale del compilatore fuori posto +% The compiler switch is misplaced, and should be located at +% the start of the unit or program. +scan_e_illegal_char_const=02011_E_Costante carattere illegale +% This happens when you specify a character with its ASCII code, as in +% \var{\#96}, but the number is either illegal, or out of range. +scan_f_cannot_open_input=02012_F_Impossibile aprire il file "$1" +% \fpc cannot find the program or unit source file you specified on the +% command line. +scan_f_cannot_open_includefile=02013_F_Impossibile aprire il file include "$1" +% \fpc cannot find the source file you specified in a \var{\{\$include ..\}} +% statement. +scan_e_illegal_pack_records=02015_E_L'allineamento dei record a "$1" è illegale +% You are specifying \var{\{\$PACKRECORDS n\} } or \var{\{\$ALIGN n\} } +% with an illegal value for \var{n}. For \$PACKRECORDS valid alignments are 1, 2, 4, 8, 16, 32, C, +% NORMAL, DEFAULT, and for \$ALIGN valid alignments are 1, 2, 4, 8, 16, 32, ON, +% OFF. Under mode MacPas \$ALIGN also supports MAC68K, POWER and RESET. +scan_e_illegal_pack_enum=02016_E_La dimensione minima "$1" per gli enum è illegale +% You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for +% \var{n}. Only 1,2,4, NORMAL or DEFAULT is valid here. +scan_e_endif_expected=02017_E_$ENDIF previsto per $1 $2 definito in $3 riga $4 +% Your conditional compilation statements are unbalanced. +scan_e_preproc_syntax_error=02018_E_Errore di sintassi nel parsing di una espressione di compilazione condizionale +% There is an error in the expression following the \var{\{\$if ..\}}, \var{\{\$ifc \}} +% or \var{\{\$setc \}} compiler directives. +scan_e_error_in_preproc_expr=02019_E_Espressione di compilazione condizionale errata +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc compiler +% directives. +scan_w_macro_cut_after_255_chars=02020_W_Le macro sono limitate a 255 caratteri di lunghezza +% The contents of macros cannot be longer than 255 characters. +scan_e_endif_without_if=02021_E_ENDIF senza IF(N)DEF +% Your \var{\{\$IFDEF ..\}} and {\{\$ENDIF\}} statements aren't balanced. +scan_f_user_defined=02022_F_Definito dall'utente: $1 +% A user defined fatal error occurred. See also the \progref. +scan_e_user_defined=02023_E_Definito dall'utente: $1 +% A user defined error occurred. See also the \progref. +scan_w_user_defined=02024_W_Definito dall'utente: $1 +% A user defined warning occurred. See also the \progref. +scan_n_user_defined=02025_N_Definito dall'utente: $1 +% A user defined note was encountered. See also the \progref. +scan_h_user_defined=02026_H_Definito dall'utente: $1 +% A user defined hint was encountered. See also the \progref. +scan_i_user_defined=02027_I_Definito dall'utente: $1 +% User defined information was encountered. See also the \progref. +scan_e_keyword_cant_be_a_macro=02028_E_Ridefinire parole chiave nelle macro non ha alcun effetto +% You cannot redefine keywords with macros. +scan_f_macro_buffer_overflow=02029_F_Buffer overflow di una macro durante la lettura o l'espansione +% Your macro or its result was too long for the compiler. +scan_w_macro_too_deep=02030_W_L'espansione della macro ha superato profondità 16 +% When expanding a macro, macros have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_w_wrong_styled_switch=02031_W_Gli switch del compilatore non funzionano nei commenti che iniziano con // +% Compiler switches should be in normal Pascal style comments. +scan_d_handling_switch=02032_DL_Valutazione dello switch "$1" +% When you set debugging info on (\var{-vd}) the compiler tells you when it +% is evaluating conditional compile statements. +scan_c_endif_found=02033_CL_ENDIF $1 trovato +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifdef_found=02034_CL_IFDEF $1 trovato, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifopt_found=02035_CL_IFOPT $1 trovato, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_if_found=02036_CL_IF $1 trovato, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifndef_found=02037_CL_IFNDEF $1 trovato, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_else_found=02038_CL_ELSE $1 trovato, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_skipping_until=02039_CL_Sarà ignorato tutto fino a... +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements, and whether it is skipping or +% compiling parts. +scan_i_press_enter=02040_I_Premere <Invio> per continuare +% When the \var{-vi} switch is used, the compiler stops compilation +% and waits for the \var{Enter} key to be pressed when it encounters +% a \var{\{\$STOP\}} directive. +scan_w_unsupported_switch=02041_W_Switch "$1" non supportato +% When warnings are turned on (\var{-vw}), the compiler warns you about +% unsupported switches. This means that the switch is used in Delphi or +% Turbo Pascal, but not in \fpc. +scan_w_illegal_directive=02042_W_La direttiva "$1" del compilatore è illegale +% When warnings are turned on (\var{-vw}), the compiler warns you about +% unrecognised switches. For a list of recognised switches, see the \progref. +scan_t_back_in=02043_TL_Torno in $1 +% When you use the \var{-vt} switch, the compiler tells you when it has finished +% reading an include file. +scan_w_unsupported_app_type=02044_W_Tipo di programma "$1" non supportato +% You get this warning if you specify an unknown application type +% with the directive \var{\{\$APPTYPE\}}. +scan_w_app_type_not_support=02045_W_APPTYPE non è supportato dall'OS destinazione +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_w_description_not_support=02046_W_DESCRIPTION non è supportata dall'OS di destinazione +% The \var{\{\$DESCRIPTION\}} direttiva non è supportata da questo OS destinazione. +scan_n_version_not_support=02047_N_VERSION non è supportata dall'OS di destinazione +% The \var{\{\$VERSION\}} direttiva non è supportata da questo OS destinazione. +scan_n_only_exe_version=02048_N_VERSION vale solo per exe o DLL +% The \var{\{\$VERSION\}} direttiva è usata solo per sorgenti eseguibili o DLL. +scan_w_wrong_version_ignored=02049_W_Formato errato per la direttiva VERSION "$1" +% The \var{\{\$VERSION\}} directive format is majorversion.minorversion +% where majorversion and minorversion are words. +scan_e_illegal_asmmode_specifier=02050_E_Lo stile assembler "$1" è illegale +% When you specify an assembler mode with the \var{\{\$ASMMODE xxx\}} directive, +% the compiler didn't recognize the mode you specified. +scan_w_no_asm_reader_switch_inside_asm=02051_W_Lo switch lettore ASM non è ammesso in una istruzione asm: "$1" sarà valido solo per la prossima +% It is not possible to switch from one assembler reader to another +% inside an assembler block. The new reader will be used for next +% assembler statements only. +scan_e_wrong_switch_toggle=02052_E_Interruttore switch errato, usare ON/OFF o +/- +% You need to use ON or OFF or a + or - to toggle the switch. +scan_e_resourcefiles_not_supported=02053_E_I resource file non sono supportati per questa destinazione +% The target you are compiling for doesn't support resource files. +scan_w_include_env_not_found=02054_W_La variabile ambiente "$1" per inclusione non esiste +% The included environment variable can't be found in the environment; it will +% be replaced by an empty string instead. +scan_e_invalid_maxfpureg_value=02055_E_Valore illegale per limiti registri FPU +% Valid values for this directive are 0..8 and NORMAL/DEFAULT. +scan_w_only_one_resourcefile_supported=02056_W_Questa destinazione supporta solo un file di risorse +% The target you are compiling for supports only one resource file. +% The first resource file found is used, the others are discarded. +scan_w_macro_support_turned_off=02057_W_Il supporto alle macro è disabilitato: macro ignorata +% A macro declaration has been found, but macro support is currently off, +% so the declaration will be ignored. To turn macro support on compile with +% -Sm on the command line or add \{\$MACRO ON\} in the source. +scan_e_invalid_interface_type=02058_E_Tipo di interfaccia illegale. Sono ammessi COM, CORBA o DEFAULT. +% The interface type that was specified is not supported. +scan_w_appid_not_support=02059_W_APPID è supportata solo da PalmOS +% The \var{\{\$APPID\}} directive is only supported for the PalmOS target. +scan_w_appname_not_support=02060_W_APPNAME è supportata solo da PalmOS +% The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target. +scan_e_string_exceeds_255_chars=02061_E_Le costanti stringa devono essere lunghe non più di 255 caratteri +% A single string constant can contain at most 255 chars. Try splitting up the +% string into multiple smaller parts and concatenate them with a + operator. +scan_f_include_deep_ten=02062_F_La inclusione nidificata di file include ha superato profondità 16. +% When including include files the files have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_e_too_many_push=02063_F_Troppi livelli di PUSH +% A maximum of 20 levels is allowed. This error occurs only in mode MacPas. +scan_e_too_many_pop=02064_E_Trovata POP senza una PUSH precedente +% This error occurs only in mode MacPas. +scan_e_error_macro_lacks_value=02065_E_La variable "$1" in una macro o espressione a tempo di compilazione non ha valore +% Thus the conditional compile time expression cannot be evaluated. +scan_e_wrong_switch_toggle_default=02066_E_Interruttore switch errato, usare ON/OFF/DEFAULT o +/-/* +% You need to use ON or OFF or DEFAULT or a + or - or * to toggle the switch. +scan_e_mode_switch_not_allowed=02067_E_Lo switch modale "$1" non è ammesso qui +% A mode switch has already been encountered, or, in the case of option -Mmacpas, +% a mode switch occurs after UNIT. +scan_e_error_macro_undefined=02068_E_La variabile o macro "$1" a tempo di compilazione non è definita. +% Thus the conditional compile time expression cannot be evaluated. Only in mode MacPas. +scan_e_utf8_bigger_than_65535=02069_E_Trovato un codice UTF-8 maggiore di 65535 +% \fpc handles UTF-8 strings internally as widestrings, i.e. the char codes are limited to 65535. +scan_e_utf8_malformed=02070_E_Stringa UTF-8 malformata +% The given string isn't a valid UTF-8 string. +scan_c_switching_to_utf8=02071_C_Trovata firma UTF-8, uso codifica UTF-8 +% The compiler found a UTF-8 encoding signature (\$ef, \$bb, \$bf) at the beginning of a file, +% so it interprets it as a UTF-8 file. +scan_e_compile_time_typeerror=02072_E_Espressione a tempo di compilazione: previsto $1 ma trovato $2 in $3 +% The type-check of a compile time expression failed. +scan_n_app_type_not_support=02073_N_APPTYPE non è supportato dall'OS di destinazione +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_e_illegal_optimization_specifier=02074_E_L'ottimizzazione specificata "$1" è illegale +% You specified an optimization with the \var{\{\$OPTIMIZATION xxx\}} directive, +% and the compiler didn't recognize the optimization you specified. +scan_w_setpeflags_not_support=02075_W_SETPEFLAGS non è supportato dall'OS di destinazione +% The \var{\{\$SETPEFLAGS\}} directive is not supported by the target OS. +scan_w_imagebase_not_support=02076_W_IMAGEBASE non è supportato dall'OS di destinazione +% The \var{\{\$IMAGEBASE\}} directive is not supported by the target OS. +scan_w_minstacksize_not_support=02077_W_MINSTACKSIZE non è supportato dall'OS di destinazione +% The \var{\{\$MINSTACKSIZE\}} directive is not supported by the target OS. +scan_w_maxstacksize_not_support=02078_W_MAXSTACKSIZE non è supportato dall'OS di destinazione +% The \var{\{\$MAXSTACKSIZE\}} directive non è supportato dall'OS di destinazione +scanner_e_illegal_warn_state=02079_E_Stato illegale per la direttiva $WARN +% Only ON and OFF can be used as state with a \var{\{\$WARN\}} compiler directive. +scan_e_only_packset=02080_E_Valore illegale di set packing +% Only 0, 1, 2, 4, 8, DEFAULT and NORMAL are allowed as packset parameters. +scan_w_pic_ignored=02081_W_Direttiva o switch PIC ignorati +% Several targets, such as \windows, do not support nor need PIC, +% so the PIC directive and switch are ignored. +scan_w_unsupported_switch_by_target=02082_W_Lo switch "$1" non è supportato dalla destinazione scelta +% Some compiler switches like \$E are not supported by all targets. +scan_w_frameworks_darwin_only=02084_W_Le opzioni relative al framework sono supportate solo da Darwin/Mac OS X +% Frameworks are not a known concept, or at least not supported by FPC, +% on operating systems other than Darwin/Mac OS X. +scan_e_illegal_minfpconstprec=02085_E_Precisione minima per costanti floating point "$1" illegale +% Valid minimal precisions for floating point constants are default, 32 and 64, +% which mean respectively minimal (usually 32 bit), 32 bit and 64 bit precision. +scan_w_multiple_main_name_overrides=02086_W_Nome della procedura "main" ridefinito: il vecchio nome era "$1" +% The name for the main entry procedure is specified more than once. Only the last +% name will be used. +% \end{description} +# +# Parser +# +# 03265 is the last used one +# +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your Pascal constructs +% are correct. +% \begin{description} +parser_e_syntax_error=03000_E_Analisi - Errore di sintassi +% An error against the Turbo Pascal language was encountered. This typically +% happens when an illegal character is found in the source file. +parser_e_dont_nest_interrupt=03004_E_Le procedure INTERRUPT non possono essere nidificate +% An \var{INTERRUPT} procedure must be global. +parser_w_proc_directive_ignored=03005_W_Tipo di procedura "$1" ignorato +% The specified procedure directive is ignored by FPC programs. +parser_e_no_overload_for_all_procs=03006_E_Non tutte le dichiarazioni di "$1" sono dichiarate con OVERLOAD +% When you want to use overloading using the \var{OVERLOAD} directive, then +% all declarations need to have \var{OVERLOAD} specified. +parser_e_export_name_double=03008_E_Nome di funzione esportata "$1" duplicato +% Exported function names inside a specific DLL must all be different. +parser_e_export_ordinal_double=03009_E_Indice di funzione esportata $1 duplicato +% Exported function indexes inside a specific DLL must all be different. +parser_e_export_invalid_index=03010_E_Indice di funzione esportata non valido +% DLL function index must be in the range \var{1..\$FFFF}. +parser_w_parser_reloc_no_debug=03011_W_Impossibile creare info di debug per DLL o eseguibile $1, perché è rilocabile. +% It is currently not possible to include debug information in a relocatable DLL. +parser_w_parser_win32_debug_needs_WN=03012_W_Per generare info di debug per codice win32 bisogna disabilitare la rilocazione con l'ozione -WN +% Stabs debug info is wrong for relocatable DLL or EXES. Use -WN +% if you want to debug win32 executables. +parser_e_constructorname_must_be_init=03013_E_Il nome del costruttore deve essere INIT +% You are declaring an object constructor with a name which is not \var{init}, and the +% \var{-Ss} switch is in effect. See the switch \seeo{Ss}. +parser_e_destructorname_must_be_done=03014_E_Il nome del distruttore deve essere DONE +% You are declaring an object destructor with a name which is not \var{done}, and the +% \var{-Ss} switch is in effect. See the switch \seeo{Ss}. +parser_e_proc_inline_not_supported=03016_E_Tipo di procedura INLINE non supportato +% You tried to compile a program with C++ style inlining, and forgot to +% specify the \var{-Si} option (\seeo{Si}). The compiler doesn't support C++ +% styled inlining by default. +parser_w_constructor_should_be_public=03018_W_Il costruttore dovrebbe essere pubblico +% Constructors must be in the 'public' part of an object (class) declaration. +parser_w_destructor_should_be_public=03019_W_Il distruttore dovrebbe essere pubblico +% Destructors must be in the 'public' part of an object (class) declaration. +parser_n_only_one_destructor=03020_N_Una classe dovrebbe avere un solo distruttore +% You can declare only one destructor for a class. +parser_e_no_local_objects=03021_E_Non sono ammesse definizioni di classi locali +% Classes must be defined globally. They cannot be defined inside a +% procedure or function. +parser_f_no_anonym_objects=03022_F_Non sono ammesse definizioni di classi anonime +% An invalid object (class) declaration was encountered, i.e. an +% object or class without methods that isn't derived from another object or +% class. For example: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% will trigger this error. +parser_n_object_has_no_vmt=03023_N_L'oggetto "$1" non ha VMT +% This is a note indicating that the declared object has no +% virtual method table. +parser_e_illegal_parameter_list=03024_E_Lista di parametri illegale +% You are calling a function with parameters that are of a different type than +% the declared parameters of the function. +parser_e_wrong_parameter_size=03026_E_La chiamata a "$1" ha un numero errato di parametri +% There is an error in the parameter list of the function or procedure -- +% the number of parameters is not correct. +parser_e_overloaded_no_procedure=03027_E_L'identificatore overloaded "$1" non è una funzione +% The compiler encountered a symbol with the same name as an overloaded +% function, but it is not a function it can overload. +parser_e_overloaded_have_same_parameters=03028_E_ Due o più funzioni overloaded hanno gli stessi parametri +% You're declaring overloaded functions, but with the same parameter list. +% Overloaded function must have at least 1 different parameter in their +% declaration. +parser_e_header_dont_match_forward=03029_E_La definizione della funzione è diversa dalla dichiarazione "$1" +% You declared a function with the same parameters but +% different result type or function modifiers. +parser_e_header_different_var_names=03030_E_La definizione della funzione "$1" è diversa dalla dichiarazione: $2 cambia in $3 +% You declared the function in the \var{interface} part, or with the +% \var{forward} directive, but defined it with a different parameter list. +parser_n_duplicate_enum=03031_N_I valori nei tipi enumerazioni devono essere ascendenti +% \fpc allows enumeration constructions as in C. Examine the following +% two declarations: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% The second declaration would produce an error. \var{A\_UAS} needs to have a +% value higher than \var{A\_E}, i.e. at least 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_Non si può usare With per variabili in un segmento diverso +% With stores a variable locally on the stack, +% but this is not possible if the variable belongs to another segment. +parser_e_too_much_lexlevel=03034_E_Nidificazione di funzioni supera profondità 31 +% You can nest function definitions only 31 levels deep. +parser_e_range_check_error=03035_E_Costanti fuori dalla gamma di valori ammessa +% The constants are out of their allowed range. +parser_w_range_check_error=03036_W_Costanti fuori dalla gamma di valori ammessa +% The constants are out of their allowed range. +parser_e_double_caselabel=03037_E_etichetta case duplicata +% You are specifying the same label 2 times in a \var{case} statement. +parser_e_case_lower_less_than_upper_bound=03038_E_Il limite superiore di un intervallo case è minore del limite inferiore +% The upper bound of a \var{case} label is less than the lower bound and this +% is useless. +parser_e_type_const_not_possible=03039_E_costanti di tipo classe o interfaccia non sono permesse +% You cannot declare a constant of type class or object. +parser_e_no_overloaded_procvars=03040_E_Variabili di funzioni in funzioni overloaded non sono permesse +% You are trying to assign an overloaded function to a procedural variable. +% This is not allowed. +parser_e_invalid_string_size=03041_E_La lunghezza di una stringa deve essere fra 1 e 255 +% The length of a shortstring in Pascal is limited to 255 characters. You are +% trying to declare a string with length less than 1 or greater than 255. +parser_w_use_extended_syntax_for_objects=03042_W_usate la sintassi estesa di NEW e DISPOSE per le istanze di oggetti +% If you have a pointer \var{a} to an object type, then the statement +% \var{new(a)} will not initialize the object (i.e. the constructor isn't +% called), although space will be allocated. You should issue the +% \var{new(a,init)} statement. This will allocate space, and call the +% constructor of the object. +parser_w_no_new_dispose_on_void_pointers=03043_W_non ha senso usare NEW o DISPOSE con puntatori senza tipo +parser_e_no_new_dispose_on_void_pointers=03044_E_usare NEW o DISPOSE con puntatori senza tipo non è permesso +% You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer +% because no size is associated to an untyped pointer. +% It is accepted for compatibility in \var{TP} and \var{DELPHI} modes, but the +% compiler will still warn you if it finds such a construct. +parser_e_class_id_expected=03045_E_Qui era atteso un identificatore di classe (ma non c'è) +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., an object or class method, but the type in front of the dot is not +% a known type. +parser_e_no_type_not_allowed_here=03046_E_gli identificatori di tipo non sono permessi qui +% You cannot use a type inside an expression. +parser_e_methode_id_expected=03047_E_Qui era atteso un identificatore di metodo (ma non c'è) +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., an object or class method, but the procedure name is not a +% procedure of this type. +parser_e_header_dont_match_any_member=03048_E_La definizione della funzione non corrisponde a nessun metodo di questa classe "$1" +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., an object or class method, but the procedure name is not a +% procedure of this type. +parser_d_procedure_start=03049_DL_procedura/funzione $1 +% When using the \var{-vd} switch, the compiler tells you when it starts +% processing a procedure or function implementation. +parser_e_error_in_real=03050_E_Costante in virgola mobile illegale +% The compiler expects a floating point expression, and gets something else. +parser_e_fail_only_in_constructor=03051_E_FAIL si può usare solo nei costruttori +% You are using the \var{fail} keyword outside a constructor method. +parser_e_no_paras_for_destructor=03052_E_I distruttori non possono avere parametri +% You are declaring a destructor with a parameter list. Destructor methods +% cannot have parameters. +parser_e_only_class_methods_via_class_ref=03053_E_Solo i metodi di classe si possono chiamare riferendosi a una classe +% This error occurs in a situation like the following: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} is not a class method and hence cannot be called with a class +% reference. +parser_e_only_class_methods=03054_E_Solo i metodi di classe si possono chiamare da altri metodi di classe +% This is related to the previous error. You cannot call a method of an object +% from inside a class method. The following code would produce this error: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% Because free is a normal method of a class it cannot be called from a class +% method. +parser_e_case_mismatch=03055_E_I tipi di un CASE e della sua costante non corrispondono +% One of the labels is not of the same type as the case variable. +parser_e_illegal_symbol_exported=03056_E_Simbolo non è esportabile da una libreria +% You can only export procedures and functions when you write a library. You +% cannot export variables or constants. +parser_w_should_use_override=03057_W_Un metodo ereditato è nascosto da "$1" +% A method that is declared \var{virtual} in a parent class, should be +% overridden in the descendant class with the \var{override} directive. If you +% don't specify the \var{override} directive, you will hide the parent method; +% you will not override it. +parser_e_nothing_to_be_overridden=03058_E_Non c'è un metodo "$1" da sovrascrivere nella classe padre +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_no_procedure_to_access_property=03059_E_Non sono forniti membri per accedere alla proprietà +% You specified no \var{read} directive for a property. +parser_w_stored_not_implemented=03060_W_Direttiva di proprietà stored non ancora implementata +% This message is no longer used, as the \var{stored} directive has been implemented. +parser_e_ill_property_access_sym=03061_E_Simbolo illegale per l'accesso alla proprietà +% There is an error in the \var{read} or \var{write} directives for an array +% property. When you declare an array property, you can only access it with +% procedures and functions. The following code would cause such an error. +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_Qui non si può accedere alla parte protetta di un oggetto +% Fields that are declared in a \var{protected} section of an object or class +% declaration cannot be accessed outside the module where the object is +% defined, or outside descendent object methods. +parser_e_cant_access_private_member=03063_E_Qui non si può accedere alla parte privata di un oggetto +% Fields that are declared in a \var{private} section of an object or class +% declaration cannot be accessed outside the module where the class is +% defined. +parser_e_overridden_methods_not_same_ret=03066_E_I metodi overridden devono avere lo stesso tipo di ritorno: "$2" è overriden da "$1" che ritorna un tipo diverso +% If you declare overridden methods in a class definition, they must +% have the same return type. +parser_e_dont_nest_export=03067_E_Funzioni dichiarate EXPORT non possono essere nidificate +% You cannot declare a function or procedure within a function or procedure +% that was declared as an export procedure. +parser_e_methods_dont_be_export=03068_E_I metodi di classe non si possono dichiarare EXPORT +% You cannot declare a procedure that is a method for an object as +% \var{export}ed. +parser_e_call_by_ref_without_typeconv=03069_E_I tipi nelle chiamate a funzioni var $1 devono corrispondere esattamente: passato "$2" ma serviva "$3" +% When calling a function declared with \var{var} parameters, the variables in +% the function call must be of exactly the same type. There is no automatic +% type conversion. +parser_e_no_super_class=03070_E_La classe non è una classe padre della classe corrente +% When calling inherited methods, you are trying to call a method of a non-related +% class. You can only call an inherited method of a parent class. +parser_e_self_not_in_method=03071_E_SELF is only allowed in methods +% You are trying to use the \var{self} parameter outside an object's method. +% Only methods get passed the \var{self} parameters. +parser_e_generic_methods_only_in_methods=03072_E_Solo i metodi si possono chiamare direttamente da altri metodi con l'identificatore della classe +% A construction like \var{sometype.somemethod} is only allowed in a method. +parser_e_illegal_colon_qualifier=03073_E_Uso illegale di ':' +% You are using the format \var{:} (colon) 2 times on an expression that +% is not a real expression. +parser_e_illegal_set_expr=03074_E_Errore di intervallo in un costruttore di insiemi, oppure elemento di insieme duplicato +% The declaration of a set contains an error. Either one of the elements is +% outside the range of the set type, or two of the elements are in fact +% the same. +parser_e_pointer_to_class_expected=03075_E_Qui era atteso un puntatore a un elemento +% You specified an illegal type in a \var{new} statement. +% The extended syntax of \var{new} needs an object as a parameter. +parser_e_expr_have_to_be_constructor_call=03076_E_L'espressione deve essere la chiamata di un costruttore +% When using the extended syntax of \var{new}, you must specify the constructor +% method of the object you are trying to create. The procedure you specified +% is not a constructor. +parser_e_expr_have_to_be_destructor_call=03077_E_L'espressione deve essere la chiamata di un distruttore +% When using the extended syntax of \var{dispose}, you must specify the +% destructor method of the object you are trying to dispose of. +% The procedure you specified is not a destructor. +parser_e_invalid_record_const=03078_E_Elementi del record disposti in ordine illegale +% When declaring a constant record, you specified the fields in the wrong +% order. +parser_e_false_with_expr=03079_E_L'espressione deve essere un tipo classe o record +% A \var{with} statement needs an argument that is of the type \var{record} +% or \var{class}. You are using \var{with} on an expression that is not of +% this type. +parser_e_void_function=03080_E_Le procedure non possono ritornare un valore +% In \fpc, you can specify a return value for a function when using +% the \var{exit} statement. This error occurs when you try to do this with a +% procedure. Procedures cannot return a value. +parser_e_constructors_always_objects=03081_E_Costruttori e distruttori devono essere metodi +% You're declaring a procedure as destructor or constructor, when the +% procedure isn't a class method. +parser_e_operator_not_overloaded=03082_E_L'operatore non ha overload per il tipo specificato +% You're trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_no_such_assignment=03083_E_Impossibile fare l'overload dell'assegnazione fra tipi uguali +% You cannot overload assignment for types +% that the compiler considers as equal. +parser_e_overload_impossible=03084_E_Overload di operatore impossibile +% The combination of operator, arguments and return type are +% incompatible. +parser_e_no_reraise_possible=03085_E_Il rilancio di un'eccezione non è permesso qui +% You are trying to re-raise an exception where it is not allowed. You can only +% re-raise exceptions in an \var{except} block. +parser_e_no_new_or_dispose_for_classes=03086_E_La sintassi estesa di new o dispose non è permessa per una classe +% You cannot generate an instance of a class with the extended syntax of +% \var{new}. The constructor must be used for that. For the same reason, you +% cannot call \var{dispose} to de-allocate an instance of a class, the +% destructor must be used for that. +parser_e_procedure_overloading_is_off=03088_E_L'overloading di procedure è disabilitato +% When using the \var{-So} switch, procedure overloading is switched off. +% Turbo Pascal does not support function overloading. +parser_e_overload_operator_failed=03089_E_Impossibile fare l'overload di questo operatore. Operatori overloadabili simili (se esistono): $1 +% You are trying to overload an operator which cannot be overloaded. +% The following operators can be overloaded : +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_L'operatore di confronto deve dare un valore booleano +% When overloading the \var{=} operator, the function must return a boolean +% value. +parser_e_only_virtual_methods_abstract=03091_E_Solo i metodi virtuali possono essere astratti +% You are declaring a method as abstract, when it is not declared to be +% virtual. +parser_f_unsupported_feature=03092_F_Uso di capacità non supportata! +% You're trying to force the compiler into doing something it cannot do yet. +parser_e_mix_of_classes_and_objects=03093_E_The mix of different kind of objects (class, object, interface, etc) isn't allowed +% You cannot derive \var{objects}, \var{classes}, \var{cppclasses} and \var{interfaces} intertwined. E.g. +% a class cannot have an object as parent and vice versa. +parser_w_unknown_proc_directive_ignored=03094_W_Ignorata una direttiva di procedura sconosciuta: "$1" +% The procedure directive you specified is unknown. +parser_e_absolute_only_one_var=03095_E_ABSOLUTE si può associare solo a una variabile +% You cannot specify more than one variable before the \var{absolute} directive. +% Thus, the following construct will provide this error: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +parser_e_absolute_only_to_var_or_const=03096_E_ABSOLUTE si può associare solo a variabili o costanti +% The address of an \var{absolute} directive can only point to a variable or +% constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +parser_e_initialized_only_one_var=03097_E_Si può inizializzare solo una variabile alla volta +% You cannot specify more than one variable with a initial value in Delphi mode. +parser_e_abstract_no_definition=03098_E_I metodi astratti non dovrebbero avere definizioni (il corpo funzione) +% Abstract methods can only be declared, you cannot implement them. They +% should be overridden by a descendant class. +parser_e_overloaded_must_be_all_global=03099_E_Questa funzione overloaded non può essere locale: deve essere esportata +% You are defining an overloaded function in the implementation part of a unit, +% but there is no corresponding declaration in the interface part of the unit. +parser_w_virtual_without_constructor=03100_W_In "$1" dei metodi virtuali sono usati senza costruttore +% If you declare objects or classes that contain virtual methods, you need +% to have a constructor and destructor to initialize them. The compiler +% encountered an object or class with virtual methods that doesn't have +% a constructor/destructor pair. +parser_c_macro_defined=03101_CL_Macro definita: $1 +% When \var{-vc} is used, the compiler tells you when it defines macros. +parser_c_macro_undefined=03102_CL_Macro non definita: $1 +% When \var{-vc} is used, the compiler tells you when it undefines macros. +parser_c_macro_set_to=03103_CL_Macro $1 impostata a $2 +% When \var{-vc} is used, the compiler tells you what values macros get. +parser_i_compiling=03104_I_Compilando $1 +% When you turn on information messages (\var{-vi}), the compiler tells you +% what units it is recompiling. +parser_u_parsing_interface=03105_UL_Interfaccia di analisi della unit $1 +% This tells you that the reading of the interface +% of the current unit has started +parser_u_parsing_implementation=03106_UL_Analisi dell'implementazione di $1 +% This tells you that the code reading of the implementation +% of the current unit, library or program starts +parser_d_compiling_second_time=03107_DL_Compilando $1 per la seconda volta +% When you request debug messages (\var{-vd}) the compiler tells you what +% units it recompiles for the second time. +parser_e_no_property_found_to_override=03109_E_Non ci sono proprietà di cui fare l'override +% You want to override a property of a parent class, when there is, in fact, +% no such property in the parent class. +parser_e_only_one_default_property=03110_E_E' permessa solo una proprietà di default +% You specified a property as \var{Default}, but the class already has a +% default property, and a class can have only one default property. +parser_e_property_need_paras=03111_E_La proprietà di default deve essere una proprietà array +% Only array properties of classes can be made \var{default} properties. +parser_e_constructor_cannot_be_not_virtual=03112_E_Costruttori virtuali sono supportati solo nel modello di oggetto classe +% You cannot have virtual constructors in objects. You can only have them +% in classes. +parser_e_no_default_property_available=03113_E_Nessuna proprietà di default disponibile +% You are trying to access a default property of a class, but this class (or one of +% its ancestors) doesn't have a default property. +parser_e_cant_have_published=03114_E_La classe non può avere una sezione pubblicata, usare lo switch {$M+} +% If you want a \var{published} section in a class definition, you must +% use the \var{\{\$M+\}} switch, which turns on generation of type +% information. +parser_e_forward_declaration_must_be_resolved=03115_E_La dichiarazione della classe "$1" deve essere risolta qui per poterla usare come padre +% To be able to use an object as an ancestor object, it must be defined +% first. This error occurs in the following situation: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% where \var{ParentClass} is declared but not defined. +parser_e_no_local_operator=03116_E_Operatori locali non supportati +% You cannot overload locally, i.e. inside procedures or function +% definitions. +parser_e_proc_dir_not_allowed_in_interface=03117_E_Direttiva di procedura "$1" non è permessa nella sezione interfaccia +% This procedure directive is not allowed in the \var{interface} section of +% a unit. You can only use it in the \var{implementation} section. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_Direttiva di procedura "$1" non è permessa nella sezione implementazione +% This procedure directive is not allowed in the \var{implementation} section of +% a unit. You can only use it in the \var{interface} section. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_Direttiva di procedura "$1" non è permessa in dichiarazioni procvar +% This procedure directive cannot be part of a procedural or function +% type declaration. +parser_e_function_already_declared_public_forward=03120_E_La funzione è già dichiarata Public/Forward "$1" +% You will get this error if a function is defined as \var{forward} twice. +% Or if it occurs in the \var{interface} section, and again as a \var{forward} +% declaration in the \var{implementation} section. +parser_e_not_external_and_export=03121_E_Non si possono usare sia EXPORT che EXTERNAL +% These two procedure directives are mutually exclusive. +parser_w_not_supported_for_inline=03123_W_"$1" non è ancora supportata all'interno di procedure o funzioni inline +% Inline procedures don't support this declaration. +parser_w_inlining_disabled=03124_W_Inlining disabilitato +% Inlining of procedures is disabled. +parser_i_writing_browser_log=03125_I_Scrivo il log del browser $1 +% When information messages are on, the compiler warns you when it +% writes the browser log (generated with the \var{\{\$Y+ \}} switch). +parser_h_maybe_deref_caret_missing=03126_H_Forse bisogna prima dereferenziare un puntatore +% The compiler thinks that a pointer may need a dereference. +parser_f_assembler_reader_not_supported=03127_F_Il lettore assembler scelto non è supportato +% The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not +% supported. The compiler can be compiled with or without support for a +% particular assembler reader. +parser_e_proc_dir_conflict=03128_E_Direttiva di procedura "$1" è in conflitto con altre direttive +% You specified a procedure directive that conflicts with other directives. +% For instance \var{cdecl} and \var{pascal} are mutually exclusive. +parser_e_call_convention_dont_match_forward=03129_E_La convenzione di chiamata non corrisponde alla dichiarazione +% This error happens when you declare a function or procedure with +% e.g. \var{cdecl;} but omit this directive in the implementation, or vice +% versa. The calling convention is part of the function declaration, and +% must be repeated in the function definition. +parser_e_property_cant_have_a_default_value=03131_E_La proprietà non può avere un valore di default +% Set properties or indexed properties cannot have a default value. +parser_e_property_default_value_must_const=03132_E_Il valore di default di una proprietà deve essere costante +% The value of a \var{default} declared property must be known at compile +% time. The value you specified is only known at run time. This happens +% e.g. if you specify a variable name as a default value. +parser_e_cant_publish_that=03133_E_Questo simbolo non può essere pubblicato, può essere solo una classe +% Only class type variables can be in a \var{published} section of a class +% if they are not declared as a property. +parser_e_cant_publish_that_property=03134_E_This kind of property can't be published +% Properties in a \var{published} section cannot be array properties. +% They must be moved to public sections. Properties in a \var{published} +% section must be an ordinal type, a real type, strings or sets. +parser_e_empty_import_name=03136_E_E' necessario un nome di importazione +% Some targets need a name for the imported procedure or a \var{cdecl} specifier. +parser_e_division_by_zero=03138_E_Divisione per zero +% A division by zero was encounted. +parser_e_invalid_float_operation=03139_E_Operazione in virgola mobile non valida +% An operation on two real type values produced an overflow or a division +% by zero. +parser_e_array_lower_less_than_upper_bound=03140_E_Limite superiore dell'intervallo minore del limite inferiore +% The upper bound of an array declaration is less than the lower bound and this +% is not possible. +parser_w_string_too_long=03141_W_La stringa "$1" è più lunga di "$2" +% The size of the constant string is larger than the size you specified in +% string type definition. +parser_e_string_larger_array=03142_E_La stringa è più lunga dell'array di char +% The size of the constant string is larger than the size you specified in +% the \var{Array[x..y] of char} definition. +parser_e_ill_msg_expr=03143_E_Espressione illegale dopo la direttiva di messaggio +% \fpc supports only integer or string values as message constants. +parser_e_ill_msg_param=03144_E_I gestori di messaggi possono prendere un solo parametro, dichiarato come chiamata per riferimento +% A method declared with the \var{message} directive as message handler +% can take only one parameter which must be declared as call by reference. +% Parameters are declared as call by reference using the \var{var}-directive. +parser_e_duplicate_message_label=03145_E_Label di messaggio duplicata: "$1" +% A label for a message is used twice in one object/class. +parser_e_self_in_non_message_handler=03146_E_In metodi che gestiscono messaggi, il parametro Self può essere solo esplicito +% The \var{Self} parameter can only be passed explicitly to a method which +% is declared as message handler. +parser_e_threadvars_only_sg=03147_E_Le threadvars possono essere solo statiche o globali +% Threadvars must be static or global; you can't declare a thread +% local to a procedure. Local variables are always local to a thread, +% because every thread has its own stack and local variables +% are stored on the stack. +parser_f_direct_assembler_not_allowed=03148_F_L'assembler diretto non è supportato dal formato binario di output +% You can't use direct assembler when using a binary writer. Choose an +% other output format or use another assembler reader. +parser_w_no_objpas_use_mode=03149_W_Non caricare manualmente la unit OBJPAS, usare \{\$mode objfpc\} oppure \{\$mode delphi\} +% You are trying to load the \file{ObjPas} unit manually from a \var{uses} clause. +% This is not a good idea. Use the \var{\{\$MODE OBJFPC\}} or +% \var{\{\$mode delphi\}} directives which load the unit automatically. +parser_e_no_object_override=03150_E_OVERRIDE non si può usare negli oggetti +% \var{Override} is not supported for objects, use \var{virtual} instead to override +% a method of a parent object. +parser_e_cant_use_inittable_here=03151_E_I Tipi di dato che richiedono inizializzazione/finalizzazione non si possono usare in record variant +% Some data types (e.g. \var{ansistring}) need initialization/finalization +% code which is implicitly generated by the compiler. Such data types +% can't be used in the variant part of a record. +parser_e_resourcestring_only_sg=03152_E_Le resourcestring possono essere solo o statiche o globali +% Resourcestring cannot be declared local, only global or using the static +% directive. +parser_e_exit_with_argument_not__possible=03153_E_L'istruzione Exit con argomenti non si può usare qui +% An exit statement with an argument for the return value can't be used here. This +% can happen for example in \var{try..except} or \var{try..finally} blocks. +parser_e_stored_property_must_be_boolean=03154_E_Il simbolo di storage deve essere di tipo boolean +% If you specify a storage symbol in a property declaration, it must be a +% boolean type. +parser_e_ill_property_storage_sym=03155_E_Questo simbolo non è ammesso come simbolo di storage +% You can't use this type of symbol as storage specifier in property +% declaration. You can use only methods with the result type boolean, +% boolean class fields or boolean constants. +parser_e_only_publishable_classes_can_be_published=03156_E_Si possono pubblicare solo classi compilate nel modo $M+ +% A class-typed field in the published section of a class can only be a class which was +% compiled in \var{\{\$M+\}} or which is derived from such a class. Normally +% such a class should be derived from \var{TPersistent}. +parser_e_proc_directive_expected=03157_E_Qui era attesa una direttiva di procedura (ma non c'è) +% This error is triggered when you have a \var{\{\$Calling\}} directive without +% a calling convention specified. +% It also happens when declaring a procedure in a const block and you +% used a ; after a procedure declaration which must be followed by a +% procedure directive. +% Correct declarations are: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_Il valore di un indice di proprietà deve essere un tipo ordinale +% The value you use to index a property must be of an ordinal type, for +% example an integer or enumerated type. +parser_e_procname_to_short_for_export=03159_E_Il nome di procedura è troppo corto per poterlo esportare +% The length of the procedure/function name must be at least 2 characters +% long. This is because of a bug in dlltool which doesn't parse the .def +% file correctly with a name of length 1. +parser_e_dlltool_unit_var_problem=03160_E_Non si possono generare voci DEFFILE per la variabili globali di una unit +parser_e_dlltool_unit_var_problem2=03161_E_Questo file deve essere compilato senza l'opzione -WD +% You need to compile this file without the -WD switch on the +% command line. +parser_f_need_objfpc_or_delphi_mode=03162_F_Questo file deve essere compilato in modo ObjFpc (-S2) o Delphi (-Sd) +% You need to use \var{\{\$MODE OBJFPC\}} or \var{\{\$MODE DELPHI\}} to compile this file. +% Or use the corresponding command line switch, either \var{-Mobjfpc} or \var{-MDelphi.} +parser_e_no_export_with_index_for_target=03163_E_Impossibile esportare con indice sulla piattaforma $1 +% Exporting of functions or procedures with a specified index is not +% supported on this target. +parser_e_no_export_of_variables_for_target=03164_E_L'esportazione di variabili non è supportata sulla piattaforma $1 +% Exporting of variables is not supported on this target. +parser_e_improper_guid_syntax=03165_E_Sintassi GUID errata +% The GUID indication does not have the proper syntax. It should be of the form +% \begin{verbatim} +% {XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX} +% \end{verbatim} +% Where each \var{X} represents a hexadecimal digit. +parser_w_interface_mapping_notfound=03168_W_Non c'è nessuna procedura di nome "$1" adatta per implementare $2.$3 +% The compiler cannot find a suitable procedure which implements the given method of an interface. +% A procedure with the same name is found, but the arguments do not match. +parser_e_interface_id_expected=03169_E_era atteso un identificatore di interfaccia (ma non c'è) +% This happens when the compiler scans a \var{class} declaration that contains +% \var{interface} function name mapping code like this: +% \begin{verbatim} +% type +% TMyObject = class(TObject, IDispatch) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% and the \var{interface} before the dot is not listed in the inheritance list. +parser_e_type_cant_be_used_in_array_index=03170_E_Il tipo "$1" non si può usare come indice di un array +% Types like \var{qword} or \var{int64} aren't allowed as array index type. +parser_e_no_con_des_in_interfaces=03171_E_Le interfacce non possono avere né costruttori né distruttori +% Constructor and destructor declarations aren't allowed in interfaces. +% In the most cases method \var{QueryInterface} of \var{IUnknown} can +% be used to create a new interface. +parser_e_no_access_specifier_in_interfaces=03172_E_Non si possono usare specificatori d'accesso in INTERFACES +% The access specifiers \var{public}, \var{private}, \var{protected} and +% \var{published} can't be used in interfaces because all methods +% of an interface must be public. +parser_e_no_vars_in_interfaces=03173_E_Una interfaccia non può contenere campi +% Declarations of fields aren't allowed in interfaces. An interface +% can contain only methods and properties with method read/write specifiers. +parser_e_no_local_proc_external=03174_E_Le procedure locali non si possono dichiarare EXTERNAL +% Declaring local procedures as external is not possible. Local procedures +% get hidden parameters that will make the chance of errors very high. +parser_w_skipped_fields_before=03175_W_Alcuni campi all'inizio di "$1" non sono stati inizializzati +% In Delphi mode, not all fields of a typed constant record have to be +% initialized, but the compiler warns you when it detects such situations. +parser_e_skipped_fields_before=03176_E_Alcuni campi all'inizio di "$1" non sono stati inizializzati +% In all syntax modes but Delphi mode, you can't leave some fields uninitialized +% in the middle of a typed constant record. +parser_w_skipped_fields_after=03177_W_Alcuni campi alla fine di "$1" non sono stati inizializzati +% You can leave some fields at the end of a type constant record uninitialized +% (The compiler will initialize them to zero automatically). This may be the cause +% of subtle problems. +parser_e_varargs_need_cdecl_and_external=03178_E_Trovata direttiva VarArgs (o '...' in MacPas) senza CDecl/CPPDecl/MWPascal ed External +% The varargs directive (or the ``...'' varargs parameter in MacPas mode) can only be +% used with procedures or functions that are declared with \var{external} and one of +% \var{cdecl}, \var{cppdecl} and \var{mwpascal}. This functionality +% is only supported to provide a compatible interface to C functions like printf. +parser_e_self_call_by_value=03179_E_Self deve essere un normale parametro (chiamata per valore) +% You can't declare \var{Self} as a const or var parameter, it must always be +% a call-by-value parameter. +parser_e_interface_has_no_guid=03180_E_L'interfaccia "$1" non ha identificazione di interfaccia +% When you want to assign an interface to a constant, then the interface +% must have a GUID value set. +parser_e_illegal_field_or_method=03181_E_Identificatore di classe sconosciuto per campo o metodo "$1" +% Properties must refer to a field or method in the same class. +parser_w_proc_overriding_calling=03182_W_Forzatura della convenzione di chiamata "$1" a "$2" +% There are two directives in the procedure declaration that specify a calling +% convention. Only the last directive will be used. +parser_e_no_procvarobj_const=03183_E_Costanti tipizzate del tipo "procedura di oggetto" possono solo essere inizializzate con NIL +% You can't assign the address of a method to a typed constant which has a +% 'procedure of object' type, because such a constant requires two addresses: +% that of the method (which is known at compile time) and that of the object or +% class instance it operates on (which cannot be known at compile time). +parser_e_default_value_only_one_para=03184_E_I valori di default si possono assegnare solo a un parametro per volta +% It is not possible to specify a default value for several parameters at once. +% The following is invalid: +% \begin{verbatim} +% Procedure MyProcedure (A,B : Integer = 0); +% \end{verbatim} +% Instead, this should be declared as +% \begin{verbatim} +% Procedure MyProcedure (A : Integer = 0; B : Integer = 0); +% \end{verbatim} +parser_e_default_value_expected_for_para=03185_E_Parametro di default necessario per "$1" +% The specified parameter requires a default value. +parser_w_unsupported_feature=03186_W_Uso di capacità non supportata! +% You're trying to force the compiler into doing something it cannot do yet. +parser_h_c_arrays_are_references=03187_H_Array C sono passati per riferimento +% Any array passed to a C function is passed +% by a pointer (i.e. by reference). +parser_e_C_array_of_const_must_be_last=03188_E_Array C di const devono essere l'ultimo argomento +% You cannot add any other argument after an \var{array of const} for +% \var{cdecl} functions, as the size pushed on stack for this argument is +% not known. +parser_h_type_redef=03189_H_Ridefinizione del tipo "$1" +% This is an indicator that a previously declared type is +% being redefined as something else. This may, or may not +% be, a potential source of errors. +parser_w_cdecl_has_no_high=03190_W_Le funzioni dichiarate cdecl non passano parametri impliciti extra +% Functions declared with the \var{cdecl} modifier do not pass an extra implicit parameter. +parser_w_cdecl_no_openstring=03191_W_Le funzioni dichiarate cdecl non supportano stringhe aperte +% Openstring is not supported for functions that have the \var{cdecl} modifier. +parser_e_initialized_not_for_threadvar=03192_E_Le variabili dichiarate come threadvar non si possono inizializzare +% Variables declared as threadvar cannot be initialized with a default value. +% The variables will always be filled with zero at the start of a new thread. +parser_e_msg_only_for_classes=03193_E_La direttiva Message è permessa solo nelle classi +% The message directive is only supported for Class types. +parser_e_procedure_or_function_expected=03194_E_Era attesa una procedura o una funzione (ma non ci sono) +% A class method can only be specified for procedures and functions. +parser_e_illegal_calling_convention=03195_W_Direttiva di convenzione di chiamata "$1" ignorata +% Some calling conventions are supported only by certain CPUs. I.e. most non-i386 ports support +% only the standard ABI calling convention of the CPU. +parser_e_no_object_reintroduce=03196_E_REINTRODUCE non si può usare negli oggetti +% \var{reintroduce} is not supported for objects. +parser_e_paraloc_only_one_para=03197_E_Ogni argomento deve avere la sua collocazione +% If locations for arguments are specified explicitly as it is required by +% some syscall conventions, each argument must have its own location. Things +% like +% \begin{verbatim} +% procedure p(i,j : longint 'r1'); +% \end{verbatim} +% aren't allowed. +parser_e_paraloc_all_paras=03198_E_Ogni argomento deve avere una collocazione esplicita +% If one argument has an explicit argument location, all arguments of a procedure +% must have one. +parser_e_illegal_explicit_paraloc=03199_E_Collocazione dell'argomento sconosciuta +% The location specified for an argument isn't recognized by the compiler. +parser_e_32bitint_or_pointer_variable_expected=03200_E_Qui era attesa una variabile intera o puntatore a 32 Bit (ma non c'è) +% The libbase for MorphOS/AmigaOS can be given only as \var{longint}, \var{dword} or any pointer variable. +parser_e_goto_outside_proc=03201_E_Le istruzioni Goto fra procedure diverse non sono permesse +% It isn't allowed to use \var{goto} statements referencing labels outside the +% current procedure. The following example shows the problem: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1; +% +% procedure p2; +% begin +% goto l1; // This goto ISN'T allowed +% end; +% +% begin +% p2 +% l1: +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_Procedura troppo complessa, richiede troppi registri +% Your procedure body is too long for the compiler. You should split the +% procedure into multiple smaller procedures. +parser_e_illegal_expression=03203_E_Espressione illegale +% This can occur under many circumstances. Usually when trying to evaluate +% constant expressions. +parser_e_invalid_integer=03204_E_Espressione intera non valida +% You made an expression which isn't an integer, and the compiler expects the +% result to be an integer. +parser_e_invalid_qualifier=03205_E_Qualificatore illegale +% One of the following is happening : +% \begin{itemize} +% \item You're trying to access a field of a variable that is not a record. +% \item You're indexing a variable that is not an array. +% \item You're dereferencing a variable that is not a pointer. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_Limite superiore di intervallo minore del limite inferiore +% You are declaring a subrange, and the high limit is less than the low limit of +% the range. +parser_e_macpas_exit_wrong_param=03207_E_I parametri di Exit devono essere il nome della procedura in cui è usato +% Non local exit is not allowed. This error occurs only in mode MacPas. +parser_e_illegal_assignment_to_count_var=03208_E_Assegnazione illegale della variabile "$1" del ciclo for-loop +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. You also cannot assign values to +% loop variables inside the loop (Except in Delphi and TP modes). Use a while or +% repeat loop instead if you need to do something like that, since those +% constructs were built for that. +parser_e_no_local_var_external=03209_E_Le variabili locali non si possono dichiarare EXTERNAL +% Declaring local variables as external is not allowed. Only global variables can reference +% external variables. +parser_e_proc_already_external=03210_E_La procedura è già dichiarata EXTERNAL +% The procedure is already declared with the EXTERNAL directive in an interface or +% forward declaration. +parser_w_implicit_uses_of_variants_unit=03211_W_Uso implicito della unit Variants +% The Variant type is used in the unit without any used unit using the Variants unit. The +% compiler has implicitly added the Variants unit to the uses list. To remove this warning +% the Variants unit needs to be added to the uses statement. +parser_e_no_static_method_in_interfaces=03212_E_Classi e metodi statici non si possono usare in INTERFACES +% The specifier \var{class} and directive \var{static} can't be used in interfaces +% because all methods of an interface must be public. +parser_e_arithmetic_operation_overflow=03213_E_Overflow in una operazione aritmetica +% An operation on two integer values produced an overflow. +parser_e_protected_or_private_expected=03214_E_Qui erano attesi Protected oppure private (ma non ci sono) +% \var{strict} can be only used together with \var{protected} or \var{private}. +parser_e_illegal_slice=03215_E_SLICE non si può usare fuori dalla lista dei parametri +% \var{slice} can be used only for arguments accepting an open array parameter. +parser_e_dispinterface_cant_have_parent=03216_E_Una DISPINTERFACE non può avere una classe antenato +% A DISPINTERFACE is a special type of interface which can't have a parent class. +parser_e_dispinterface_needs_a_guid=03217_E_Una DISPINTERFACE deve avere un GUID +% A DISPINTERFACE always needs an interface identification (a GUID). +parser_w_overridden_methods_not_same_ret=03218_W_I metodi overloadati devono avere un tipo di ritorno analogo. Questo codice può crashare a causa di un bug nel parser Delphi ("$2" è overloadato da "$1" che ritorna un tipo diverso) +% If you declare overridden methods in a class definition, they must +% have the same return type. Some versions of Delphi allow you to change the +% return type of interface methods, and even to change procedures into +% functions, but the resulting code may crash depending on the types used +% and the way the methods are called. +parser_e_dispid_must_be_ord_const=03219_E_Gli ID Dispatch devono essere costanti ordinali +% The \var{dispid} keyword must be followed by an ordinal constant (the dispid index). +parser_e_array_range_out_of_bounds=03220_E_L'intervallo dell'array è troppo grande +% Regardless of the size taken up by its elements, an array cannot have more +% than high(ptrint) elements. Additionally, the range type must be a subrange +% of ptrint. +parser_e_packed_element_no_var_addr=03221_E_Non si può accedere agli indirizzi di elementi di array o campi di record bit packed +% If you declare an array or record as \var{packed} in Mac Pascal mode +% (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will +% be packed at the bit level. This means it becomes impossible to take addresses +% of individual array elements or record fields. The only exception to this rule +% is in the case of packed arrays elements whose packed size is a multple of 8 bits. +parser_e_packed_dynamic_open_array=03222_E_Gli array dinamici non possono essere packed +% Only regular (and possibly in the future also open) arrays can be packed. +parser_e_packed_element_no_loop=03223_E_Non si possono usare elementi di array o campi di record bit packed come variabili di un loop +% If you declare an array or record as \var{packed} in Mac Pascal mode +% (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will +% be packed at the bit level. For performance reasons, they cannot be +% used as loop variables. +parser_e_type_and_var_only_in_generics=03224_E_VAR e TYPE sono permessi solo nei generic +% The usage of VAR and TYPE to declare new types inside an object is allowed only inside +% generics. +parser_e_cant_create_generics_of_this_type=03225_E_Questo tipo non può essere un generic +% Only Classes, Objects, Interfaces and Records are allowed to be used as generic. +parser_w_no_lineinfo_use_switch=03226_W_Non caricare la unit LINEINFO manualmente, Usare lo switch -gl del compilatore per farlo +% Do not use the \file{lineinfo} unit directly, Use the \var{-gl} switch which +% automatically adds the correct unit for reading the selected type of debugging +% information. The unit that needs to be used depends on the type of +% debug information used when compiling the binary. +parser_e_no_funcret_specified=03227_E_La funzione "$1" deve dichiarare il tipo del suo risultato +% The first time you declare a function you have to declare it completely, +% including all parameters and the result type. +parser_e_special_onlygenerics=03228_E_La specializzazione è supportata solo per i tipi generici +% Types which are not generics can't be specialized. +parser_e_no_generics_as_params=03229_E_Non si possono usare generici come parametri al momento della loro specializzazione +% When specializing a generic, only non-generic types can be used as parameters. +parser_e_type_object_constants=03230_E_Costanti di oggetti contenenti un VMT non sono permesse +% If an object requires a VMT either because it contains a constructor or virtual methods, +% it's not allowed to create constants of it. In TP and Delphi mode this is allowed +% for compatibility reasons. +parser_e_label_outside_proc=03231_E_Non è ammesso prendere l'indirizzo di label definite fuori della visibilità corrente +% It isn't allowed to take the address of labels outside the +% current procedure. +parser_e_initialized_not_for_external=03233_E_Non si possono inizializzare variabili dichiarate external +% Variables declared as external cannot be initialized with a default value. +parser_e_illegal_function_result=03234_E_Il tipo del risultato della funzione è illegale +% Some types like file types cannot be used as function result. +parser_e_no_common_type=03235_E_Non esistono tipi in comune fra "$1" e "$2" +% To perform an operation on integers, the compiler converts both operands +% to their common type, which appears to be an invalid type. To determine the +% common type of the operands, the compiler takes the minimum of the minimal values +% of both types, and the maximum of the maximal values of both types. The common +% type is then minimum..maximum. +parser_e_no_generics_as_types=03236_E_Generici senza specializzazione non si possono usare come tipi per una variabile +% Generics must be always specialized before being used as variable type. +parser_w_register_list_ignored=03237_W_Le liste di registri sono ignorate per routines in assembler puro +% When using pure assembler routines, the list with modified registers is ignored. +parser_e_implements_must_be_class_or_interface=03238_E_La proprietà IMPLEMENTS deve avere un tipo classe o interfaccia +% A property which implements an interface must be of type class or interface. +parser_e_implements_must_have_correct_type=03239_E_Le proprietà IMPLEMENTS devono implementare interfacce del tipo giusto. Trovato tipo "$1" ma serviva "$2" +% A property which implements an interface actually implements a different interface. +parser_e_implements_must_read_specifier=03240_E_Le proprietà IMPLEMENTS devono avere specificatore di lettura +% A property which implements an interface must have at least a read specifier. +parser_e_implements_must_not_have_write_specifier=03241_E_Le proprietà IMPLEMENTS non devono avere specificatore di scrittura +% A property which implements an interface may not have a write specifier. +parser_e_implements_must_not_have_stored_specifier=03242_E_Le proprietà IMPLEMENTS non devono avere specificatore stored +% A property which implements an interface may not have a stored specifier. +parser_e_implements_uses_non_implemented_interface=03243_E_Proprietà IMPLEMENTS usata su una interfaccia non implementata: "$1" +% The interface which is implemented by a property is not an interface implemented by the class. +parser_e_unsupported_real=03244_E_Questa destinazione non supporta la virgola mobile +% The compiler parsed a floating point expression, but it is not supported. +parser_e_class_doesnt_implement_interface=03245_E_La classe "$1" non implementa l'interfaccia "$2" +% The delegated interface is not implemented by the class given in the implements clause. +parser_e_class_implements_must_be_interface=03246_E_Il tipo usato da IMPLEMENTS deve essere un'interfaccia +% The \var{implements} keyword must be followed by an interface type. +parser_e_cant_export_var_different_name=03247_E_Non si possono esportare variabili con un nome diverso su questa destinazione, aggiungere il nome alla dichiarazione con la direttiva "export" (nome variabile: $1, nome di export dichiarato: $2) +% On most targets it is not possible to change the name under which a variable +% is exported inside the \var{exports} statement of a library. +% In that case, you have to specify the export name at the point where the +% variable is declared, using the \var{export} and \var{alias} directives. +parser_e_weak_external_not_supported=03248_E_La destinazione attuale non supporta simboli esterni deboli +% A "weak external" symbol is a symbol which may or may not exist at (either static +% or dynamic) link time. This concept may not be available (or implemented yet) +% on the current cpu/OS target. +parser_e_forward_mismatch=03249_E_La dichiarazione e l'implementazione del tipo non corrispondono +% Classes and interfaces being defined forward must have the same type +% when being implemented. A forward interface cannot be changed into a class. +parser_n_ignore_lower_visibility=03250_N_Il metodo virtuale "$1" ha una visibilità minore ($2) della classe padre $3 ($4) +% The virtual method overrides a method that is declared with a higher visibility. This might give +% unexpected results. In case the new visibility is private than it might be that a call to inherited in a +% new child class will call the higher visible method in a parent class and ignores the private method. +parser_e_field_not_allowed_here=03251_E_I campi non possono comparire dopo la definizione di un metodo o di una proprietà: iniziare una nuova sezione di visibilità prima +% Once a method or property has been defined in a class or object, you cannot define any fields afterwards +% without starting a new visibility section (such as \var{public}, \var{private}, etc.). The reason is +% that otherwise the source code can appear ambiguous to the compiler, since it is possible to use modifiers +% such as \var{default} and \var{register} also as field names. +parser_e_no_local_para_def=03252_E_I parametri non possono contenere definizioni di tipo locali. Usate una definizione di tipo a parte in un blocco type. +% In Pascal, types are not considered to be identical simply because they are semantically equivalent. +% Two variables or parameters are only considered to be of the same type if they refer to the +% same type definition. +% As a result, it is not allowed to define new types inside parameter lists, because then it is impossible to +% refer to the same type definition in the procedure headers of the interface and implementation of a unit +% (both procedure headers would define a separate type). Keep in mind that expressions such as +% ``file of byte'' or ``string[50]'' also define a new type. +parser_e_abstract_and_sealed_conflict=03253_E_Conflitto fra ABSTRACT e SEALED +% ABSTRACT and SEALED cannot be used together in one declaration +parser_e_sealed_descendant=03254_E_Non posso creare discendenti dalla classe "$1", perché è SEALED +% Sealed means that class cannot be derived by another class. +parser_e_sealed_class_cannot_have_abstract_methods=03255_E_Le classi SEALED non possono avere metodi ABSTRACT +% Sealed means that class cannot be derived. Therefore no one class is able to override an abstract method in a sealed class. +parser_e_only_virtual_methods_final=03256_E_Solo i metodi virtuali possono essere final +% You are declaring a method as final, when it is not declared to be +% virtual. +parser_e_final_can_no_be_overridden=03257_E_I metodi final non si possono overloadare: "$1" +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_invalid_enumerator_identifier=03259_E_Identificatore di enumeratore non valido: "$1" +% Only "MoveNext" and "Current" enumerator identifiers are supported. +parser_e_enumerator_identifier_required=03260_E_E' necessario un identificatore di enumeratore +% "MoveNext" or "Current" identifier must follow the \var{enumerator} modifier. +parser_e_enumerator_movenext_is_not_valid=03261_E_Il metodo pattern enumerator MoveNext non è valido. Il metodo deve essere una funzione con tipo di ritorno boolean e senza argomenti. +% "MoveNext" enumerator pattern method must be a function with Boolean return type and no required arguments +parser_e_enumerator_current_is_not_valid=03262_E_La proprietà del pattern enumerator Current non è valida. La proprietà deve avere un getter. +% "Current" enumerator pattern property must have a getter +parser_e_only_one_enumerator_movenext=03263_E_E' permesso un solo metodo enumerator MoveNext per classe/oggetto +% Class or Object can have only one enumerator MoveNext declaration. +parser_e_only_one_enumerator_current=03264_E_E' permessa una sola proprietà enumerator Current per classe/oggetto +% Class or Object can have only one enumerator Current declaration. +parser_e_for_in_loop_cannot_be_used_for_the_type=03265_E_Non si possono usare for in loop per il tipo "$1" +% For in loop can be used not for all types. For example it cannot be used for the enumerations with jumps. +% \end{description} +# +# Type Checking +# +# 04087 is the last used one +# +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +type_e_mismatch=04000_E_Type mismatch +% This can happen in many cases: +% \begin{itemize} +% \item The variable you're assigning to is of a different type than the +% expression in the assignment. +% \item You are calling a function or procedure with parameters that are +% incompatible with the parameters in the function or procedure definition. +% \end{itemize} +type_e_incompatible_types=04001_E_Incompatible types: got "$1" expected "$2" +% There is no conversion possible between the two types. +% Another possiblity is that they are declared in different +% declarations: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { This statement also gives this error. It +% is due to the strict type checking of Pascal } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_I tipi "$1" e "$2" devono essere uguali ma non lo sono +% The types are not equal. +type_e_type_id_expected=04003_E_Qui era atteso un identificatore di tipo (ma non c'è) +% The identifier is not a type, or you forgot to supply a type identifier. +type_e_variable_id_expected=04004_E_Qui era atteso un identificatore di variabile (ma non c'è) +% This happens when you pass a constant to a routine (such as \var{Inc} var or \var{Dec}) +% when it expects a variable. You can only pass variables as arguments to these functions. +type_e_integer_expr_expected=04005_E_Qui era attesa una espressione intera, invece c'è "$1" +% The compiler expects an expression of type integer, but gets a different +% type. +type_e_boolean_expr_expected=04006_E_Qui era attesa una espressione booleana, invece c'è "$1" +% The expression must be a boolean type. It should be return \var{True} or +% \var{False}. +type_e_ordinal_expr_expected=04007_E_Qui era attesa una espressione ordinale (ma non c'è) +% The expression must be of ordinal type, i.e., maximum a \var{Longint}. +% This happens, for instance, when you specify a second argument +% to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value. +type_e_pointer_type_expected=04008_E_Qui era atteso un tipo puntatore, invece c'è "$1" +% The variable or expression isn't of the type \var{pointer}. This +% happens when you pass a variable that isn't a pointer to \var{New} +% or \var{Dispose}. +type_e_class_type_expected=04009_E_Qui era atteso un tipo classe, invece c'è "$1" +% The variable or expression isn't of the type \var{class}. This happens +% typically when +% \begin{enumerate} +% \item The parent class in a class declaration isn't a class. +% \item An exception handler (\var{On}) contains a type identifier that +% isn't a class. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_L'espressione da valutare non ritorna una costante +% This error can occur when the bounds of an array you declared do +% not evaluate to ordinal constants. +type_e_set_element_are_not_comp=04012_E_Gli elementi dell'insieme non sono compatibili +% You are trying to perform an operation on two sets, when the set element types +% are not the same. The base type of a set must be the same when taking the +% union. +type_e_set_operation_unknown=04013_E_questa operazione non è implementata per gli insiemi +% several binary operations are not defined for sets. +% These include: \var{div}, \var{mod}, \var{**}, \var{>=} and \var{<=}. +% The last two may be defined for sets in the future. +type_w_convert_real_2_comp=04014_W_Conversione automatica di tipo da virgola mobile a COMP (che è un tipo intero) +% An implicit type conversion from a real type to a \var{comp} is +% encountered. Since \var{comp} is a 64 bit integer type, this may indicate +% an error. +type_h_use_div_for_int=04015_H_L'operatore di divisione fra tipi interi è 'DIV' e non '/' +% When hints are on, then an integer division with the '/' operator will +% produce this message, because the result will then be of type real. +type_e_strict_var_string_violation=04016_E_I tipi stringa non corrispondono, a causa dello switch $V+ +% When compiling in \var{\{\$V+\}} mode, the string you pass as a parameter +% should be of the exact same type as the declared parameter of the procedure. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_Non si possono usare succ o pred su enums con assegnazione stile C +% If you declare an enumeration type which has C-like assignments +% in it, such as in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% then you cannot use the \var{Succ} or \var{Pred} functions with this enumeration. +type_e_cant_read_write_type=04018_E_Le variabili di questo tipo non si possono leggere o scrivere da file direttamente +% You are trying to \var{read} or \var{write} a variable from or to a +% file of type text, which doesn't support that variable's type. +% Only integer types, reals, pchars and strings can be read from or +% written to a text file. Booleans can only be written to text files. +type_e_no_readln_writeln_for_typed_file=04019_E_Non si possono usare readln o writeln su file che non sono di tipo testo +% \var{readln} and \var{writeln} are only allowed for text files. +type_e_no_read_write_for_untyped_file=04020_E_Non si possono usare read o write su file senza tipo. +% \var{read} and \var{write} are only allowed for text or typed files. +type_e_typeconflict_in_set=04021_E_Conflitto di tipo fra elementi dell'insieme +% There is at least one set element which is of the wrong type, i.e. not of +% the set type. +type_w_maybe_wrong_hi_lo=04022_W_lo/hi(dword/qword) ritorna la word/dword inferiore/superiore +% \fpc supports an overloaded version of \var{lo/hi} for \var{longint/dword/int64/qword} +% which returns the lower/upper word/dword of the argument. \tp always uses +% a 16 bit \var{lo/hi} which always returns bits 0..7 for \var{lo} and the +% bits 8..15 for \var{hi}. If you want the \tp behavior you have +% to type cast the argument to a \var{word} or \var{integer}. +type_e_integer_or_real_expr_expected=04023_E_Qui era attesa una espressione intera o reale +% The first argument to \var{str} must be a real or integer type. +type_e_wrong_type_in_array_constructor=04024_E_Tipo "$1" errato nel costruttore dell'array +% You are trying to use a type in an array constructor which is not +% allowed. +type_e_wrong_parameter_type=04025_E_Tipo incompatibile per l'argomento n. $1: trovato "$2", serviva "$3" +% You are trying to pass an invalid type for the specified parameter. +type_e_no_method_and_procedure_not_compatible=04026_E_Non si può assegnare un metodo a una variabile procedura, né una procedura a un puntatore a metodo +% You can't assign a method to a procedure variable or a procedure to a +% method pointer. +type_e_wrong_math_argument=04027_E_Passata una costante illegale a una funzione matematica interna +% The constant argument passed to a \var{ln} or \var{sqrt} function is out of +% the definition range of these functions. +type_e_no_addr_of_constant=04028_E_Non si può ottenere l'indirizzo di una espressione costante +% It is not possible to get the address of a constant expression, because they +% aren't stored in memory. You can try making it a typed constant. This error +% can also be displayed if you try to pass a property to a var parameter. +type_e_argument_cant_be_assigned=04029_E_A questo argomento non possono essere assegnati valori +% Only expressions which can be on the left side of an +% assignment can be passed as call by reference arguments. +% +% Remark: Properties can be used on the left side of an assignment, +% nevertheless they cannot be used as arguments. +type_e_cannot_local_proc_to_procvar=04030_E_Non si possono assegnare procedure/funzioni locali a variabili procedura +% It's not allowed to assign a local procedure/function to a +% procedure variable, because the calling convention of a local procedure/function is +% different. You can only assign local procedure/function to a void pointer. +type_e_no_assign_to_addr=04031_E_Non si possono assegnare valori a un indirizzo di memoria +% It is not allowed to assign a value to an address of a variable, constant, +% procedure or function. You can try compiling with -So if the identifier +% is a procedure variable. +type_e_no_assign_to_const=04032_E_Non si possono assegnare valori a variabili dichiarate const +% It's not allowed to assign a value to a variable which is declared +% as a const. This is normally a parameter declared as const. To allow +% changing the value, pass the parameter by value, or a parameter by reference +% (using var). +type_e_array_required=04033_E_E' richiesto un tipo array +% If you are accessing a variable using an index '[<x>]' then +% the type must be an array. In FPC mode a pointer is also allowed. +type_e_interface_type_expected=04034_Qui era atteso un tipo interfaccia, invece c'è "$1" +% The compiler expected to encounter an interface type name, but got something else. +% The following code would produce this error: +% \begin{verbatim} +% Type +% TMyStream = Class(TStream,Integer) +% \end{verbatim} +type_h_mixed_signed_unsigned=04035_H_Mescolare longword ed espressioni con segno dà un risultato a 64bit +% If you divide (or calculate the modulus of) a signed expression by a longword (or vice versa), +% or if you have overflow and/or range checking turned on and use an arithmetic +% expression (+, -, *, div, mod) in which both signed numbers and longwords appear, +% then everything has to be evaluated in 64-bit arithmetic which is slower than normal +% 32-bit arithmetic. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_w_mixed_signed_unsigned2=04036_W_In questo punto, mescolare espressioni con segno e tipi cardinali può provocare un errore di controllo range +% If you use a binary operator (and, or, xor) and one of +% the operands is a longword while the other one is a signed expression, then, +% if range checking is turned on, you may get a range check error because in +% such a case both operands are converted to longword before the operation is +% carried out. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_e_typecast_wrong_size_for_assignment=04037_E_La conversione di tipo causa dimensioni diverse ($1 -> $2) nell'assegnazione +% Type casting to a type with a different size is not allowed when the variable is +% used in an assignment. +type_e_array_index_enums_with_assign_not_possible=04038_E_Gli enum con assegnazione non si possono usare come indici di array +% When you declared an enumeration type which has C-like +% assignments, such as in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use it as the index of an array. +type_e_classes_not_related=04039_E_I tipi classe o oggetto "$1" e "$2" non sono correlati. Conversione di tipo impossibile. +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors. +type_w_classes_not_related=04040_W_I tipi classe "$1" e "$2" non sono correlati. +% There is a typecast from one class to another while the classes +% are not related. This will probably lead to errors. +type_e_class_or_interface_type_expected=04041_E_Qui era atteso un tipo classe o interfaccia, invece c'è il tipo "$1" +% The compiler expected a class or interface name, but got another type or identifier. +type_e_type_is_not_completly_defined=04042_E_Il tipo "$1" non è completamente definito +% This error occurs when a type is not complete: i.e. a pointer type which points to +% an undefined type. +type_w_string_too_long=04043_W_Il letterale stringa è troppo lungo per una short string (lunghezza maggiore di 255) +% The size of the constant string, which is assigned to a shortstring, +% is longer than the maximum size of the shortstring (255 characters). +type_w_signed_unsigned_always_false=04044_W_A causa dei range diversi, il confronto è sempre FALSE +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% false. Explicitly typecast the constant to the correct range to avoid this problem. +type_w_signed_unsigned_always_true=04045_W_A causa dei range diversi, il confronto è sempre TRUE +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% true. Explicitly typecast the constant to the correct range to avoid this problem. +type_w_instance_with_abstract=04046_W_Costruzione della classe "$1" con metodo "$2" astratto +% An instance of a class is created which contains non-implemented abstract +% methods. This will probably lead to a runtime error 211 in the code if that +% routine is ever called. All abstract methods should be overriden. +type_h_in_range_check=04047_H_L'operando a sinistra dell'operatore IN dovrebbe avere la dimensione di un byte +% The left operand of the \var{in} operator is not an ordinal or enumeration which fits +% within 8 bits. This may lead to range check errors. The \var{in} operator +% currently only supports a left operand which fits within a byte. In the case of +% enumerations, the size of an element of an enumeration can be controlled with +% the \var{\{\$PACKENUM\}} or \var{\{\$Zn\}} switches. +type_w_smaller_possible_range_check=04048_W_Differenza nella dimensione dei tipi: possibili perdite di dati o errori di overflow +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_h_smaller_possible_range_check=04049_H_Differenza nella dimensione dei tipi: possibili perdite di dati o errori di overflow +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_e_cant_take_address_of_abstract_method=04050_E_Non si può prendere l'indirizzo di un metodo astratto +% An abstract method has no body, so the address of an abstract method can't be taken. +type_e_assignment_not_allowed=04051_E_Non si possono assegnare valori a parametri formali o ad array aperti +% You are trying to assign a value to a formal (untyped var, const or out) +% parameter, or to an open array. +type_e_constant_expr_expected=04052_E_Qui era attesa una espressione costante +% The compiler expects an constant expression, but gets a variable expression. +type_e_operator_not_supported_for_types=04053_E_L'operazione "$1" non è possibile sui tipi "$2" e "$3" +% The operation is not allowed for the supplied types. +type_e_illegal_type_conversion=04054_E_La conversione dal tipo "$1" al tipo "$2" è illegale +% When doing a type-cast, you must take care that the sizes of the variable and +% the destination type are the same. +type_h_pointer_to_longint_conv_not_portable=04055_H_La conversione fra ordinali e puntatori non è portabile +% If you typecast a pointer to a longint (or vice-versa), this code will not compile +% on a machine using 64 bits addressing. +type_w_pointer_to_longint_conv_not_portable=04056_W_La conversione fra ordinali e puntatori non è portabile +% If you typecast a pointer to an ordinal type of a different size (or vice-versa), this can +% cause problems. This is a warning to help in finding the 32-bit specific code where cardinal/longint is used +% to typecast pointers to ordinals. A solution is to use the ptrint/ptruint types instead. +type_e_cant_choose_overload_function=04057_E_La funzione non ha alcun overload per parametri di questo tipo +% You're calling overloaded functions with a parameter that doesn't correspond +% to any of the declared function parameter lists. e.g. when you have declared +% a function with parameters \var{word} and \var{longint}, and then you call +% it with a parameter which is of type \var{integer}. +type_e_illegal_count_var=04058_E_La variabile contatore del loop deve essere un tipo ordinale +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +type_w_double_c_varargs=04059_W_Conversione di costanti real a double per variabili argomento C: aggiungere un typecast esplicito per prevenirlo. +% In C, constant real values are double by default. For this reason, if you +% pass a constant real value to a variable argument part of a C function, FPC +% by default converts this constant to double as well. If you want to prevent +% this from happening, add an explicit typecast around the constant. +type_e_class_or_cominterface_type_expected=04060_E_Qui era atteso un tipo interfaccia classe o COM, invece c'è il tipo "$1" +% Some operators, such as the AS operator, are only applicable to classes or COM interfaces. +type_e_no_const_packed_array=04061_E_Array packed costanti non sono ancora supportati +% You cannot declare a (bit)packed array as a typed constant. +type_e_got_expected_packed_array=04062_E_Tipo incompatibile: argomento n. $1 di tipo "$2", invece deve essere "(Bit)Packed Array" +% The compiler expects a (bit)packed array as the specified parameter. +type_e_got_expected_unpacked_array=04063_E_Tipo incompatibile: argomento n. $1 di tipo "$2", invece deve essere "(not packed) Array" +% The compiler expects a regular (i.e., not packed) array as the specified parameter. +type_e_no_packed_inittable=04064_E_Gli elementi di un array packed non possono essere di un tipo che deve essere inizializzato +% Support for packed arrays of types that need initialization +% (such as ansistrings, or records which contain ansistrings) is not yet implemented. +type_e_no_const_packed_record=04065_E_Oggetti o record packed costanti non sono ancora supportati +% You cannot declare a (bit)packed array as a typed constant at this time. +type_w_untyped_arithmetic_unportable=04066_W_L'aritmetica "$1" su puntatori senza tipo non è portabile su {$T+}, si suggerisce un typecast +% Addition/subtraction from an untyped pointer may work differently in \var{\{\$T+\}}. +% Use a typecast to a typed pointer. +type_e_cant_take_address_of_local_subroutine=04076_E_Non si può prendere l'indirizzo di una subroutine marcata come local +% The address of a subroutine marked as local can't be taken. +type_e_cant_export_local=04077_E_Una subroutine marcata come local non è esportabile fuori dalla unit +% A subroutine marked as local can't be exported from a unit. +type_e_not_automatable=04078_E_Il tipo "$1" non è automatizzabile +% Only byte, integer, longint, smallint, currency, single, double, ansistring, +% widestring, tdatetime, variant, olevariant, wordbool and all interfaces are automatable. +type_h_convert_add_operands_to_prevent_overflow=04079_H_Convertire gli operandi a "$1" prima dell'addizione può evitare errori di overflow +% Adding two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the addition. +type_h_convert_sub_operands_to_prevent_overflow=04080_H_Convertire gli operandi a "$1" prima della sottrazione può evitare errori di overflow +% Subtracting two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the subtraction. +type_h_convert_mul_operands_to_prevent_overflow=04081_H_Convertire gli operandi a "$1" prima della moltiplicazione può evitare errori di overflow +% Multiplying two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the multiplication. +type_w_pointer_to_signed=04082_W_Convertire puntatori in interi con segno può portare a confronti errati ed errori di range: meglio usare un tipo senza segno +% The virtual address space on 32-bit machines runs from \$00000000 to \$ffffffff. +% Many operating systems allow you to allocate memory above \$80000000. +% For example both \windows and \linux allow pointers in the range \$0000000 to \$bfffffff. +% If you convert pointers to signed types, this can cause overflow and range check errors, +% but also \$80000000 < \$7fffffff. This can cause random errors in code like "if p>q". +type_interface_has_no_guid=04083_E_Il tipo interfaccia $1 non ha un GUID valido +% When applying the as-operator to an interface or class, the desired interface (i.e. the right operand of the +% as-operator) must have a valid GUID. +type_e_invalid_objc_selector_name=04084_E_Nome di selettore non valido +% An Objective-C selector cannot be empty, must be a valid identifier or a single colon, +% and if it contains at least one colon it must also end in one. +type_e_expected_objc_method_but_got=04085_E_Qui era atteso un metodo Objective-C, invece c'è $1 +% A selector can only be created for Objective-C methods, not for any other kind +% of procedure/function/method. +type_e_expected_objc_method=04086_E_Qui era atteso un metodo Objective-C o un nome di un metodo costante +% A selector can only be created for Objective-C methods, either by specifying +% the name using a string constant, or by using an Objective-C method identifier +% that is visible in the current scope. +type_e_no_type_info=04087_E_Nessuna informazione sul tipo disponibile per questo tipo +% Type information is not generated for some types, such as enumerations with gaps +% in their value range (this includes enumerations whose lower bound is different +% from zero). +% \end{description} +# +# Symtable +# +# 05069 is the last used one +# +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedure and variable names. +% \begin{description} +sym_e_id_not_found=05000_E_Identificatore "$1" non trovato +% The compiler doesn't know this symbol. Usually happens when you misspell +% the name of a variable or procedure, or when you forget to declare a +% variable. +sym_f_internal_error_in_symtablestack=05001_F_Errore interno del compilatore in SymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_Identificatore "$1" duplicato +% The identifier was already declared in the current scope. +sym_h_duplicate_id_where=05003_H_Identificatore già definito in $1 alla riga $2 +% The identifier was already declared in a previous scope. +sym_e_unknown_id=05004_E_Identificatore "$1" sconosciuto +% The identifier encountered has not been declared, or is used outside the +% scope where it is defined. +sym_e_forward_not_resolved=05005_E_Dichiarazione "$1" priva di implementazione +% This can happen in two cases: +% \begin{itemize} +% \item You declare a function in the \var{interface} part, or +% with a \var{forward} directive, but do not implement it. +% \item You reference a type which isn't declared in the current \var{type} +% block. +% \end{itemize} +sym_e_error_in_type_def=05007_E_Errore nella definizione del tipo +% There is an error in your definition of a new array type. +% One of the range delimiters in an array declaration is erroneous. +% For example, \var{Array [1..1.25]} will trigger this error. +sym_e_forward_type_not_resolved=05009_E_Tipo "$1" dichiarato ma non implementato +% A symbol was forward defined, but no declaration was encountered. +sym_e_only_static_in_static=05010_E_Al di fuori dei metodi o nei metodi statici si possono usare solo variabli statiche +% A static method of an object can only access static variables. +sym_f_type_must_be_rec_or_class=05012_F_Qui era atteso un tipo record o classe +% The variable or expression isn't of the type \var{record} or \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_Non sono permesse istanze di classi o di oggetti con un metodo astratto +% You are trying to generate an instance of a class which has an abstract +% method that wasn't overridden. +sym_w_label_not_defined=05014_W_Label "$1" non definita +% A label was declared, but not defined. +sym_e_label_used_and_not_defined=05015_E_Label "$1" usata ma non definita +% A label was declared and used, but not defined. +sym_e_ill_label_decl=05016_E_Dichiarazione di label illegale +% This error should never happen; it occurs if a label is defined outside a +% procedure or function. +sym_e_goto_and_label_not_supported=05017_E_GOTO e LABEL non sono supportati (usare lo switch -Sg) +% You must use the -Sg switch to compile a program which has \var{label}s +% and \var{goto} statements. By default, \var{label} and \var{goto} aren't +% supported. +sym_e_label_not_found=05018_E_Label non trovata +% A \var{goto label} was encountered, but the label wasn't declared. +sym_e_id_is_no_label_id=05019_E_L'identificatore non è una label +% The identifier specified after the \var{goto} isn't of type label. +sym_e_label_already_defined=05020_E_Label già definita +% You are defining a label twice. You can define a label only once. +sym_e_ill_type_decl_set=05021_E_La dichiarazione del tipo di un elemento in un insieme è illegale +% The declaration of a set contains an invalid type definition. +sym_e_class_forward_not_resolved=05022_E_Classe "$1" dichiarata ma non implementata +% You declared a class, but you did not implement it. +sym_n_unit_not_used=05023_H_La unit "$1" non è usata in $2 +% The unit referenced in the \var{uses} clause is not used. +sym_h_para_identifier_not_used=05024_H_Parametro "$1" non usato +% The identifier was declared (locally or globally) but +% was not used (locally or globally). +sym_n_local_identifier_not_used=05025_N_Variabile locale "$1" non usata +% You have declared, but not used, a variable in a procedure or function +% implementation. +sym_h_para_identifier_only_set=05026_H_Al parametro "$1" è assegnato un valore, ma poi non viene mai usato +% The identifier was declared (locally or globally) and +% assigned to, but is not used (locally or globally) after the assignment. +sym_n_local_identifier_only_set=05027_N_La variabile locale "$1" è assegnata ma non viene mai usata +% The variable in a procedure or function implementation is declared and +% assigned to, but is not used after the assignment. +sym_h_local_symbol_not_used=05028_H_Locale $1 "$2" non è mai usato +% A local symbol is never used. +sym_n_private_identifier_not_used=05029_N_Il campo privato "$1.$2" non viene mai usato +% The indicated private field is defined, but is never used in the code. +sym_n_private_identifier_only_set=05030_N_Il campo privato "$1.$2" è assegnato ma poi non viene mai usato +% The indicated private field is declared and assigned to, but never read. +sym_n_private_method_not_used=05031_N_Il metodo privato "$1.$2" non è mai usato +% The indicated private method is declared but is never used in the code. +sym_e_set_expected=05032_E_Qui era atteso un tipo insieme +% The variable or expression is not of type \var{set}. This happens in an +% \var{in} statement. +sym_w_function_result_not_set=05033_W_Il valore di ritorno della funzione non sembra essere mai assegnato +% You can get this warning if the compiler thinks that a function return +% value is not set. This will not be displayed for assembler procedures, +% or procedures that contain assembler blocks. +sym_w_wrong_C_pack=05034_W_Il tipo "$1" non è allineato correttamente per il linguaggio C +% Arrays with sizes not multiples of 4 will be wrongly aligned +% for C structures. +sym_e_illegal_field=05035_E_L'identificatore del campo di un record "$1" è sconosciuto +% The field doesn't exist in the record/object definition. +sym_w_uninitialized_local_variable=05036_W_La variabile locale "$1" non sembra essere inizializzata +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assignment). +sym_w_uninitialized_variable=05037_W_La variabile "$1" non sembra essere inizializzata +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assignment). +sym_e_id_no_member=05038_E_L'identificatore "$1" non identifica alcun membro +% This error is generated when an identifier of a record, +% field or method is accessed while it is not defined. +sym_h_param_list=05039_H_Trovata dichiarazione: $1 +% You get this when you use the \var{-vh} switch.In the case of an overloaded procedure +% not being found. Then all candidate overloaded procedures are +% listed, with their parameter lists. +sym_e_segment_too_large=05040_E_Elemento dati troppo grande +% You get this when you declare a data element whose size exceeds the +% prescribed limit (2 Gb on 80386+/68020+ processors). +sym_e_no_matching_implementation_found=05042_E_Non ci sono implementazioni corrispondenti per il metodo di interfaccia "$1" +% There was no matching method found which could implement the interface +% method. Check argument types and result type of the methods. +sym_w_deprecated_symbol=05043_W_Il simbolo "$1" è deprecato +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Use of this symbol +% should be avoided as much as possible. +sym_w_non_portable_symbol=05044_W_Il simbolo "$1" non è portabile +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{platform} is used. This symbol's value, use +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_non_implemented_symbol=05055_W_Il simbolo "$1" non è implementato +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{unimplemented} is used. This symbol is defined, +% but is not yet implemented on this specific platform. +sym_e_cant_create_unique_type=05056_E_Non si può creare un tipo univoco dal tipo fornito +% Only simple types like ordinal, float and string types are supported when +% redefining a type with \var{type newtype = type oldtype;}. +sym_h_uninitialized_local_variable=05057_H_La variabile locale "$1" non sembra essere inizializzata +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. it did not appear in the left-hand side of an +% assignment). +sym_h_uninitialized_variable=05058_H_La variabile "$1" non sembra essere inizializzata +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. t did not appear in the left-hand side of an +% assignment). +sym_w_function_result_uninitialized=05059_W_La variabile risultato della funzione sembra non essere ancora stata assegnata +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. it appears in the right-hand side of an expression) +% before it is initialized (i.e. before it appeared in the left-hand side of an +% assignment). +sym_h_function_result_uninitialized=05060_H_La variabile risultato della funzione sembra non essere ancora stata assegnata +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. it appears in the right-hand side of an expression) +% before it is initialized (i.e. it appears in the left-hand side of an +% assignment) +sym_w_identifier_only_read=05061_W_La variabile "$1" è letta ma mai assegnata +% You have read the value of a variable, but nowhere assigned a value to +% it. +sym_h_abstract_method_list=05062_H_Trovato metodo astratto: $1 +% When getting a warning about constructing a class/object with abstract methods +% you get this hint to assist you in finding the affected method. +sym_w_experimental_symbol=05063_W_Il simbolo "$1" è sperimentale +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{experimental} is used. Experimental symbols +% might disappear or change semantics in future versions. Usage of this symbol +% should be avoided as much as possible. +sym_w_forward_not_resolved=05064_W_Dichiarazione "$1" non implementata, si assume che sia external +% This happens if you declare a function in the \var{interface} of a unit in macpas mode, +% but do not implement it. +sym_w_library_symbol=05065_W_Il simbolo "$1" appartiene a una libreria +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{library} is used. Library symbols may not be +% available in other libraries. +sym_w_deprecated_symbol_with_msg=05066_W_Il simbolo "$1" è deprecato: "$2" +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Use of this symbol +% should be avoided as much as possible. +sym_e_no_enumerator=05067_E_Non c'è un enumeratore per il tipo "$1" +% This means that compiler cannot find an apropriate enumerator to use in the for-in loop. +% To create an enumerator you need to defind an operator enumerator or add a public or published +% GetEnumerator method to the class or object definition. +sym_e_no_enumerator_move=05068_E_Non c'è un metodo "MoveNext" nell'enumeratore "$1" +% This means that compiler cannot find a public MoveNext method with the Boolean return type in +% the enumerator class or object definition. +sym_e_no_enumerator_current=05069_E_Non c'è una proprietà "Current" nell'enumeratore "$1" +% This means that compiler cannot find a public Current property in the enumerator class or object +% definition. +% \end{description} +# +# Codegenerator +# +# 06049 is the last used one +# +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +cg_e_parasize_too_big=06009_E_La lista dei parametri è più grande di 65535 bytes +% The I386 processor limits the parameter list to 65535 bytes. (The \var{RET} +% instruction causes this.) +cg_e_file_must_call_by_reference=06012_E_I tipi file devono essere parametri var +% You cannot specify files as value parameters, i.e., they must always be +% declared \var{var} parameters. +cg_e_cant_use_far_pointer_there=06013_E_Usare un puntatore far non è permesso qui +% Free Pascal doesn't support far pointers, so you cannot take the address of +% an expression which has a far reference as a result. The \var{mem} construct +% has a far reference as a result, so the following code will produce this +% error: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_Le funzioni dichiarare EXPORT non possono essere chiamate +% No longer in use. +cg_w_member_cd_call_from_method=06016_W_Possibile chiamata illegale di un costruttore o distruttore +% The compiler detected that a constructor or destructor is called within a +% a method. This will probably lead to problems, since constructors / destructors +% require parameters on entry. +cg_n_inefficient_code=06017_N_Codice inefficiente +% Your statement seems dubious to the compiler. +cg_w_unreachable_code=06018_W_Codice irraggiungibile +% You specified a construct which will never be executed. Example: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_I metodi astratti non possono essere chiamati direttamente +% You cannot call an abstract method directly. Instead, you must call an +% overriding child method, because an abstract method isn't implemented. +cg_d_register_weight=06027_DL_Il Registro $1 pesa $2 $3 +% Debugging message. Shown when the compiler considers a variable for +% keeping in the registers. +cg_d_stackframe_omited=06029_DL_Stack frame omesso +% Some procedure/functions do not need a complete stack-frame, so it is omitted. +% This message will be displayed when the {-vd} switch is used. +cg_e_unable_inline_object_methods=06031_E_I metodi di oggetti e classi non possono essere inline +% You cannot have inlined object methods. +cg_e_unable_inline_procvar=06032_E_Chiamate procvar non possono essere inline +% A procedure with a procedural variable call cannot be inlined. +cg_e_no_code_for_inline_stored=06033_E_Non è stato memorizzato codice per la procedura inline +% The compiler couldn't store code for the inline procedure. +cg_e_can_access_element_zero=06035_E_Non si può accedere all'elemento zero di una ansi/wide/longstring, usare (set)length +% You should use \var{setlength} to set the length of an ansi/wide/longstring +% and \var{length} to get the length of such string type. +cg_e_cannot_call_cons_dest_inside_with=06037_E_Non si possono chiamare costruttoro o distruttori all'interno di una clausola 'with' +% Inside a \var{with} clause you cannot call a constructor or destructor for the +% object you have in the \var{with} clause. +cg_e_cannot_call_message_direct=06038_E_I metodi gestori di messaggi non possono essere chiamati direttamente +% A message method handler method cannot be called directly if it contains an +% explicit \var{Self} argument. +cg_e_goto_inout_of_exception_block=06039_E_Non è permesso saltare da dentro a fuori un blocco di gestione delle eccezioni o viceversa +% It is not allowed to jump in or outside of an exception block like \var{try..finally..end;}. +% For example, the following code will produce this error: + +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // this line will cause an error +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_Le istruzioni 'break', 'continue' ed 'exit' non sono ammesse in un blocco finally +% It isn't allowed to use the control flow statements \var{break}, +% \var{continue} and \var{exit} +% inside a finally statement. The following example shows the problem: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // This exit ISN'T allowed +% end; +% ... +% +% \end{verbatim} +% If the procedure \var{p} raises an exception the finally block is +% executed. If the execution reaches the exit, it's unclear what to do: +% exit the procedure or search for another exception handler. +cg_w_parasize_too_big=06041_W_La dimensione dei parametri eccede il limite massimo di alcune CPU +% This indicates that you are declaring more than 64K of parameters, which +% might not be supported on other processor targets. +cg_w_localsize_too_big=06042_W_La dimensione delle variabili locali eccede il limite massimo di alcune CPU +% This indicates that you are declaring more than 32K of local variables, which +% might not be supported on other processor targets. +cg_e_localsize_too_big=06043_E_La dimensione delle variabili locali è eccessiva +% This indicates that you are declaring more than 32K of local variables, which +% is not supported by this processor. +cg_e_break_not_allowed=06044_E_BREAK non è permesso fuori da un loop +% You're trying to use \var{break} outside a loop construction. +cg_e_continue_not_allowed=06045_E_CONTINUE non è permesso fuori da un loop +% You're trying to use \var{continue} outside a loop construction. +cg_f_unknown_compilerproc=06046_F_Compilerproc "$1" sconosciuta. Verificate di stare usando la giusta libreria di runtime +% The compiler expects that the runtime library contains certain subroutines. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the compiler in use. If you changed the runtime library this error means +% that you removed a subroutine which the compiler needs for internal use. +cg_f_unknown_system_type=06047_F_Il tipo di sistema "$1" non esiste. Verificate di stare usando la giusta libreria di runtime. +% The compiler expects that the runtime library contains certain type definitions. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the compiler in use. If you changed the runtime library this error means +% that you removed a type which the compiler needs for internal use. +cg_h_inherited_ignored=06048_H_Ignorata una chiamata ereditata a un metodo astratto +% This message appears only in Delphi mode when you call an abstract method +% of a parent class via \var{inherited;}. The call is then ignored. +cg_e_goto_label_not_found=06049_E_La label goto "$1" non è definita o è stata eliminata dalle ottimizzazioni +% The label used in the goto definition is not defined or optimized away by the +% unreachable code elemination. +% \end{description} +# EndOfTeX + +# +# Assembler reader +# +# 07107 is the last used one +# +asmr_d_start_reading=07000_DL_Inizio analisi assembler stile $1 +% This informs you that an assembler block is being parsed +asmr_d_finish_reading=07001_DL_Fine analisi assembler stile $1 +% This informs you that an assembler block has finished. +asmr_e_none_label_contain_at=07002_E_Il pattern contiene @ ma non è una label +% A identifier which isn't a label can't contain a @. +asmr_e_building_record_offset=07004_E_Errore nella costruzione dell'offset di un record +% There has an error occured while building the offset of a record/object +% structure, this can happend when there is no field specified at all or +% an unknown field identifier is used. +asmr_e_offset_without_identifier=07005_E_usato OFFSET senza identificatore +% You can only use OFFSET with an identifier. Other syntaxes aren't +% supported +asmr_e_type_without_identifier=07006_E_usato TYPE senza identificatore +% You can only use TYPE with an identifier. Other syntaxes aren't +% supported +asmr_e_no_local_or_para_allowed=07007_E_Qui non si possono usare variabili o parametri locali +% You can't use a local variable or parameter here, mostly because the +% addressing of locals and parameters is done using the frame pointer register so the +% address can't be obtained directly. +asmr_e_need_offset=07008_E_Qui è necessario usare OFFSET +% You need to use OFFSET <id> here to get the address of the identifier. +asmr_e_need_dollar=07009_E_Qui è necessario usare $ +% You need to use $<id> here to get the address of the identifier. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_Si può usare un solo simbolo rilocabile per ogni argomento +% You can't have more than one relocatable symbol (variable/typed constant) +% in one argument. +asmr_e_only_add_relocatable_symbol=07011_E_Un simbolo rilocabile puà solo essere sommato +% Relocatable symbols (variable/typed constant) can't be used with other +% operators. Only addition is allowed. +asmr_e_invalid_constant_expression=07012_E_Espressione costante non valida +% There is an error in the constant expression. +asmr_e_relocatable_symbol_not_allowed=07013_E_I simboli rilocabili non sono permessi qui +% You can't use a relocatable symbol (variable/typed constant) here. +asmr_e_invalid_reference_syntax=07014_E_Sintassi del reference non valida +% There is an error in the reference. +asmr_e_local_para_unreachable=07015_E_Impossibile raggiungere $1 da quel codice +% You cannot read directly the value of a local variable or parameter +% of a higher level procedure in assembler code (except for +% local assembler code without parameter nor locals). +asmr_e_local_label_not_allowed_as_ref=07016_E_Simboli o label locali non sono ammessi come reference +% You can't use local symbols/labels as references +asmr_e_wrong_base_index=07017_E_Uso errato dei registri base e indice +% There is an error with the base and index register, they are +% probably incorrect +asmr_w_possible_object_field_bug=07018_W_Possibile errore nella gestione dei campi di un oggetto +% Fields of objects or classes can be reached directly in normal or objfpc +% modes but TP and Delphi modes treat the field name as a simple offset. +asmr_e_wrong_scale_factor=07019_E_Specificato un fattore di scala errato +% The scale factor given is wrong, only 1,2,4 and 8 are allowed +asmr_e_multiple_index=07020_E_Uso di registri indice multipli +% You are trying to use more than one index register +asmr_e_invalid_operand_type=07021_E_Tipo di operando non valido +% The operand type doesn't match with the opcode used +asmr_e_invalid_string_as_opcode_operand=07022_E_Stringa non valida come operando dell'opcode: $1 +% The string specified as operand is not correct with this opcode +asmr_w_CODE_and_DATA_not_supported=07023_W_@CODE e @DATA non supportati +% @CODE and @DATA are unsupported and are ignored. +asmr_e_null_label_ref_not_allowed=07024_E_Non sono ammessi riferimenti a label nulle +asmr_e_expr_zero_divide=07025_E_Divisione per zero in una espressione asm costante +% There is a division by zero in a constant expression +asmr_e_expr_illegal=07026_E_Espressione illegale +% There is an illegal expression in a constant expression +asmr_e_escape_seq_ignored=07027_E_Ignorata sequenza di escape: $1 +% There is a C-styled string, but the escape sequence in the string +% is unknown, and is therefore ignored +asmr_e_invalid_symbol_ref=07028_E_Riferimento a simbolo non valido +asmr_w_fwait_emu_prob=07029_W_Fwait può creare problemi di emulazione con emu387 +asmr_w_fadd_to_faddp=07030_W_$1 senza operandi tradotto in $1P +asmr_w_enter_not_supported_by_linux=07031_W_L'istruzione ENTER non è supportata dal kernel Linux +% ENTER instruction can generate a stack page fault that is not +% caught correctly by the i386 Linux page handler. +asmr_w_calling_overload_func=07032_W_Chiamata da assembler di una funzione overloaded +% There is a call to an overloaded method in the assembler block, +% this might be the sign there is a problem +asmr_e_unsupported_symbol_type=07033_E_Tipo di simbolo non supportato per l'operando +asmr_e_constant_out_of_bounds=07034_E_Costante fuori dai limiti +asmr_e_error_converting_decimal=07035_E_Errore nella conversione decimale $1 +% A constant decimal value does not have the correct syntax +asmr_e_error_converting_octal=07036_E_Errore nella conversione ottale $1 +% A constant octal value does not have the correct syntax +asmr_e_error_converting_binary=07037_E_Errore nella conversione binaria $1 +% A constant binary value does not have the correct syntax +asmr_e_error_converting_hexadecimal=07038_E_Errore nella conversione esadecimale $1 +% A constant hexadecimal value does not have the correct syntax +asmr_h_direct_global_to_mangled=07039_H_$1 tradotto con $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 è associato a una funzione overloaded +asmr_e_cannot_use_SELF_outside_a_method=07041_E_Non si può usare SELF al di fuori di un metodo +% There is a reference to the \var{self} symbol while it is not +% allowed. \var{self} can only be referenced inside methods +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_Non si può usare OLDEBP al di fuori di una procedura nidificata +% There is a reference to the \var{oldebp} symbol while it is not +% allowed. \var{oldebp} can only be referenced inside nested routines +asmr_e_void_function=07043_W_Le procedure non possono ritornare alcun valore nel codice assembler +% Trying to return a value while in a procedure. A procedure +% does not have any return value +asmr_e_SEG_not_supported=07044_E_SEG non supportato +asmr_e_size_suffix_and_dest_dont_match=07045_E_Il suffisso di dimensione e la dimensione della destinazione non corrispondono +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_w_size_suffix_and_dest_dont_match=07046_W_Il suffisso di dimensione e la dimensione della destinazione non corrispondono +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_e_syntax_error=07047_E_Errore di sintassi nell'assembler +% There is an assembler syntax error +asmr_e_invalid_opcode_and_operand=07048_E_Combinazione di opcode e operandi non valida +% The opcode cannot be used with this type of operand +asmr_e_syn_operand=07049_E_Errore di sintassi nell'operando assembler +asmr_e_syn_constant=07050_E_Errore di sintassi nella costante assembler +asmr_e_invalid_string_expression=07051_E_Espressione stringa non valida +asmr_w_const32bit_for_address=07052_W_costante con simbolo di indirizzo $1 che non entra in un puntatore +% A constant expression represents an address which does not fit +% into a pointer. The address is probably incorrect +asmr_e_unknown_opcode=07053_E_Opcode $1 non riconosciuto +% This opcode is not known +asmr_e_invalid_or_missing_opcode=07054_E_Opcode non valido o mancante +asmr_e_invalid_prefix_and_opcode=07055_E_Combinazione di prefisso e opcode: $1 +asmr_e_invalid_override_and_opcode=07056_E_Combinazione di override e opcode $1 non valida +asmr_e_too_many_operands=07057_E_Troppi operandi su una sola riga +% There are too many operands for this opcode. Check your +% assembler syntax +asmr_w_near_ignored=07058_W_NEAR ignorato +asmr_w_far_ignored=07059_W_FAR ignorato +asmr_e_dup_local_sym=07060_E_Simbolo locale $1 ignorato +asmr_e_unknown_local_sym=07061_E_Simbolo locale $1 non definito +asmr_e_unknown_label_identifier=07062_E_Identificatore label $1 non riconosciuto +asmr_e_invalid_register=07063_E_Nome di registro non valido +% There is an unknown register name used as operand. +asmr_e_invalid_fpu_register=07064_E_Nome di registro virgola mobile non valido +% There is an unknown register name used as operand. +asmr_w_modulo_not_supported=07066_W_Modulo non supportato +asmr_e_invalid_float_const=07067_E_Costante in virgola mobile $1 non valida +% The floating point constant declared in an assembler block is +% invalid. +asmr_e_invalid_float_expr=07068_E_Espressione in virgola mobile non valida +% The floating point expression declared in an assembler block is +% invalid. +asmr_e_wrong_sym_type=07069_E_Tipo di simbolo errato +asmr_e_cannot_index_relative_var=07070_E_Non si possono indicizzare una variabile o un parametro locali con un registro +% Trying to index using a base register a symbol which is already relative +% to a register. This is not possible, and will probably lead to crashes. +asmr_e_invalid_seg_override=07071_E_Espressione di override di segmento non valida +asmr_w_id_supposed_external=07072_W_L'identificatore $1 non è definito: sarà considerato esterno +% There is a reference to an undefined symbol. This will not result +% in an error, since the symbol might be external, but may cause +% problems at link time if the symbol is not defined anywhere. +asmr_e_string_not_allowed_as_const=07073_E_Le stringhe non sono ammesse come costanti +% Character strings are not allowed as constants. +asmr_e_no_var_type_specified=07074_Nessun tipo di variabile specificato +% The syntax expects a type identifier after the dot, but +% none was found. +asmr_w_assembler_code_not_returned_to_text=07075_E_Il codice assembler non è tornato nella sezione text +% There was a directive in the assembler block to change sections, +% but there is a missing return to the text section at the end +% of the assembler block. This might cause errors during link time. +asmr_e_not_directive_or_local_symbol=07076_E_$1 non è una direttiva né un simbolo locale +% This symbol is unknown. +asmr_w_using_defined_as_local=07077_E_Uso di un nome definito come label locale +asmr_e_dollar_without_identifier=07078_E_Il token '$' è usato senza identificatori +% A constant expression has an identifier which does not start with +% the $ symbol. +asmr_w_32bit_const_for_address=07079_W_Creata una costante a 32 bit per l'indirizzo +% A constant was used as an address. This is probably an error, +% since using absolute addresses will probably not work. +asmr_n_align_is_target_specific=07080_N_.align è specifico per la destinazione: usare .balign oppure .p2align +% Using the .align directive is platform specific, and its meaning will vary +% from one platform to another. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_Non si può accedere direttamente dal parametro ai campi +% You should load the parameter first into a register and then access the +% fields using that register. +asmr_e_cannot_access_object_field_directly=07082_E_Non si può accedere direttamente dalla classe/oggetto ai campi +% You should load the self pointer first into a register and then access the +% fields using the register as base. By default the self pointer is available +% in the esi register on i386. +asmr_e_unable_to_determine_reference_size=07083_E_Dimensione degli operandi non specificata ed impossibile da determinare +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. +asmr_e_cannot_use_RESULT_here=07084_E_Non si può usare RESULT in questa funzione +% Some functions which return complex types cannot use the \var{result} +% keyword. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" senza operandi tradotto con "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" tradotto con "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" tradotto con "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_Il carattere '<' non è permesso qui +% The shift operator requires the << characters. Only one +% of those characters was found. +asmr_e_invalid_char_greater=07090_E_Il carattere '>' non è permesso qui +% The shift operator requires the >> characters. Only one +% of those characters was found. +asmr_w_align_not_supported=07093_W_ALIGN non è supportato +asmr_e_no_inc_and_dec_together=07094_E_Non si possono usare Inc e Dec insieme +% Trying to use an increment and a decrement within the same +% opcode on the 680x0. This is impossible. +asmr_e_invalid_reg_list_in_movem=07095_E_La reglist per movem non è valida +% Trying to use the \var{movem} opcode with invalid registers +% to save or restore. +asmr_e_invalid_reg_list_for_opcode=07096_E_La reglist per l'opcode non è valida +asmr_e_higher_cpu_mode_required=07097_E_Necessaria una classe di cpu più alta ($1) +% Trying to use an instruction which is not supported in the current +% cpu mode. Use a higher cpu generation to be able to use this +% opcode in your assembler block +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_Dimensione degli operandi non specificata ed impossibile da determinare, assunta DWORD come default +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use DWORD as default. +asmr_e_illegal_shifterop_syntax=07099_E_Errore di sintassi nell'analisi di un operando shifter +% ARM only; ARM assembler supports a so called shifter operand. The used syntax isn't +% a valid shifter operand. Example for an operation with shifter operand: +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +asmr_e_packed_element=07100_E_Indirizzo di componenti packed non allineato al byte +% Packed components (record fields and array elements) may start at an arbitrary +% bit inside a byte. On CPU which do not support bit-addressable memory (which +% includes all currently supported CPUs by FPC) you will therefore get an error +% message when trying to index arrays with elements whose size is not a multiple +% of 8 bits. The same goes for accessing record fields with such an address. +% multiple of 8 bits. +asmr_w_unable_to_determine_reference_size_using_byte=07101_W_Dimensione degli operandi non specificata ed impossibile da determinare, assunta BYTE come default +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use BYTE as default. +asmr_w_no_direct_ebp_for_parameter=07102_W_Qui non si può usare +offset(%ebp) per i parametri +% Using direct 8(%ebp) reference for function/procedure parameters is invalid +% if parameters are in registers. +asmr_w_direct_ebp_for_parameter_regcall=07103_W_Usare +offset(%ebp) non è compatibile con la convenzione di chiamata regcall +% Using direct 8(%ebp) reference for function/procedure parameters is invalid +% if parameters are in registers. +asmr_w_direct_ebp_neg_offset=07104_W_Usare -offset(%ebp) non è consigliato per accedere a variabili locali +% Using -8(%ebp) to access a local variable is not recommended +asmr_w_direct_esp_neg_offset=07105_W_Usando -offset(%esp), l'accesso può causare un crash o perdite di dati +% Using -8(%esp) to access a local stack is not recommended, as +% this stack portion can be overwritten by any function calls or interrupts. +asmr_e_no_vmtoffset_possible=07106_E_VMTOffset deve essere usato in combinazione con un metodo virtuale, ma "$1" non lo è +% Only virtual methods have VMT offsets +asmr_e_need_pic_ref=07107_E_Non si può generare PIC: ci sono reference dipendenti dalla posizione +% The compiler has been configured to generate position-independent code +% (PIC), but there are position-dependent references in the current +% handwritten assembler instruction. +# +# Assembler/binary writers +# +# 08020 is the last used one +# +asmw_f_too_many_asm_files=08000_F_Troppi file assembler +% With smartlinking enabled, there are too many assembler +% files generated. Disable smartlinking. +asmw_f_assembler_output_not_supported=08001_F_L'assembler di output selezionato non è supportato +asmw_f_comp_not_supported=08002_F_Comp not supported +asmw_f_direct_not_supported=08003_F_Modo diretto non supportato perscrittori binari +% Direct assembler mode is not supported for binary writers. +asmw_e_alloc_data_only_in_bss=08004_E_Si possono allocare dati solo nella sezione bss +asmw_f_no_binary_writer_selected=08005_F_Nessuno scrittore binario selezionato +asmw_e_opcode_not_in_table=08006_E_Asm: L'opcode $1 non è in tabella +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 combinazione di opcode e operandi non valida +asmw_e_16bit_not_supported=08008_E_Asm: riferimenti a 16 Bit non sono supportati +asmw_e_invalid_effective_address=08009_E_Asm: indirizzo effettivo non valido +asmw_e_immediate_or_reference_expected=08010_E_Asm: era previsto un immediate o un reference +asmw_e_value_exceeds_bounds=08011_E_Asm: valore $1 fuori dal limite $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: lo short jump è fuori dal limite $1 +asmw_e_undefined_label=08013_E_Asm: Label $1 non definita +asmw_e_comp_not_supported=08014_E_Asm: il tipo comp non è supportato per questa destinazione +asmw_e_extended_not_supported=08015_E_Asm: il tipo extended non è supportato per questa destinazione +asmw_e_duplicate_label=08016_E_Asm: label $1 duplicata +asmw_e_redefined_label=08017_E_Asm: label $1 ridefinita +asmw_e_first_defined_label=08018_E_Asm: definito qui per la prima volta +asmw_e_invalid_register=08019_E_Asm: registro $1 non valido +asmw_e_16bit_32bit_not_supported=08020_E_Asm: riferimenti a 16 o a 32 Bit non supportati +asmw_e_64bit_not_supported=08021_E_Asm: operandi a 64 Bit non supportati + +# +# Executing linker/assembler +# +# 09032 is the last used one +# +# BeginOfTeX +% +% \section{Errors of assembling/linking stage} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +exec_w_source_os_redefined=09000_W_Sistema operativo sorgente ridefinito +% The source operating system is redefined. +exec_i_assembling_pipe=09001_I_Uso del'assemblatore $1 (tramite pipe) +% Assembling using a pipe to an external assembler. +exec_d_cant_create_asmfile=09002_E_Non posso creare il file assembler $1 +% The mentioned file can't be created. Check if you have +% access permissions to create this file. +exec_e_cant_create_objectfile=09003_E_Non posso creare il file oggetto: $1 +% The mentioned file can't be created. Check if you have +% got access permissions to create this file. +exec_e_cant_create_archivefile=09004_E_Non posso creare il file archivio: $1 +% The mentioned file can't be created. Check if you have +% access permissions to create this file. +exec_e_assembler_not_found=09005_E_Assemblatore $1 non trovato, sarà usato un assemblatore esterno +% The assembler program was not found. The compiler will produce a script that +% can be used to assemble and link the program. +exec_t_using_assembler=09006_T_Assemblatore in uso: $1 +% An informational message saying which assembler is being used. +exec_e_error_while_assembling=09007_E_Errore nell'assembaggio dell'exitcode $1 +% There was an error while assembling the file using an external assembler. +% Consult the documentation of the assembler tool to find out more information +% on this error. +exec_e_cant_call_assembler=09008_E_Non è possibile chiamare l'assemblatore, errore $1: sarà usato un assemblatore esterno +% An error occurred when calling an external assembler. The compiler will produce a script that +% can be used to assemble and link the program. +exec_i_assembling=09009_I_Assemblaggio di $1 +% An informational message stating which file is being assembled. +exec_i_assembling_smart=09010_I_Assemblaggio con smartlinking di $1 +% An informational message stating which file is being assembled using smartlinking. +exec_w_objfile_not_found=09011_W_Oggetto $1 non trovato, il linking potrebbe fallire! +% One of the object files is missing, and linking will probably fail. +% Check your paths. +exec_w_libfile_not_found=09012_W_Libreria $1 non trovata, il linking potrebbe fallire! +% One of the library files is missing, and linking will probably fail. +% Check your paths. +exec_e_error_while_linking=09013_E_Errore durante il linking +% Generic error while linking. +exec_e_cant_call_linker=09014_E_Impossibile chiamare il linker, sarà usato un linker esterno +% An error occurred when calling an external linker. The compiler will produce a script that +% can be used to assemble and link the program. +exec_i_linking=09015_I_Linking di $1 +% An informational message, showing which program or library is being linked. +exec_e_util_not_found=09016_E_Utility $1 non trovata, sarà usato un linker esterno +% An external tool was not found. The compiler will produce a script that +% can be used to assemble and link or postprocess the program. +exec_t_using_util=09017_T_Uso di utility $1 +% An informational message, showing which external program (usually a postprocessor) is being used. +exec_e_exe_not_supported=09018_E_La creazione di eseguibili non è supportata +% Creating executable programs is not supported for this platform, because it was +% not yet implemented in the compiler. +exec_e_dll_not_supported=09019_E_La creazione di librerie dinamiche o condivise non è supportata +% Creating dynamically loadable libraries is not supported for this platform, because it was +% not yet implemented in the compiler. +exec_i_closing_script=09020_I_Chiusura dello script $1 +% Informational message showing when writing of the external assembling and linking script is finished. +exec_e_res_not_found=09021_E_Compilatore di risorse "$1" non trovato, creazione di uno script esterno +% An external resource compiler was not found. The compiler will produce a script that +% can be used to assemble, compile resources and link or postprocess the program. +exec_i_compilingresource=09022_I_Compilazione della risorsa $1 +% An informational message, showing which resource is being compiled. +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_La unit $1 non si può linkare staticamente, sarà usato lo smart linking +% Static linking was requested, but a unit which is not statically linkable was used. +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_La unit $1 deve essere linkata staticamente +% Smart linking was requested, but a unit which is not smart-linkable was used. +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_La unit $1 non si può linkare in modo shared o smart +% Shared linking was requested, but a unit which is not shared-linkable was used. +exec_e_unit_not_smart_or_static_linkable=09026_E_La unit $1 deve essere linkata in modo shared +% Smart or static linking was requested, but a unit which cannot be used for either was used. +exec_e_unit_not_shared_or_static_linkable=09027_E_La unit $1 non si può linkare in modo shared o statico +% Shared or static linking was requested, but a unit which cannot be used for either was used. +exec_d_resbin_params=09028_D_Chiamata al compilatore di risorse "$1" con riga di comando "$2" +% An informational message showing which command line is used for the resource compiler. +exec_e_error_while_compiling_resources=09029_E_Errore nella compilazione delle risorse +% The resource compiler or converter returned an error. +exec_e_cant_call_resource_compiler=09030_E_Impossibile chiamare il compilatore di risorse "$1", creazione di uno script esterno +% An error occurred when calling a resource compiler. The compiler will produce +% a script that can be used to assemble, compile resources and link or +% postprocess the program. +exec_e_cant_open_resource_file=09031_E_Impossibile aprire il file di risorse "$1" +% An error occurred resource file cannot be opened. +exec_e_cant_write_resource_file=09032_E_Impossibile scrivere il file di risorse "$1" +% An error occurred resource file cannot be written. +%\end{description} +# EndOfTeX + +# +# Executable information +# +# 09134 is the last used one +# +# BeginOfTeX +% \section{Executable information messages.} +% This section lists all messages that the compiler emits when an executable program is produced, +% and only when the internal linker is used. +% \begin{description} +execinfo_f_cant_process_executable=09128_F_Impossibile postprocessare l'eseguibile $1 +% Fatal error when the compiler is unable to post-process an executable. +execinfo_f_cant_open_executable=09129_F_Impossibile aprire l'eseguibile $1 +% Fatal error when the compiler cannot open the file for the executable. +execinfo_x_codesize=09130_X_Dimnesione del codice: $1 byte +% Informational message showing the size of the produced code section. +execinfo_x_initdatasize=09131_X_Dimensione dei dati inizializzati: $1 byte +% Informational message showing the size of the initialized data section. +execinfo_x_uninitdatasize=09132_X_Dimensione dei dati non inizializzati: $1 byte +% Informational message showing the size of the uninitialized data section. +execinfo_x_stackreserve=09133_X_Spazio di stack riservato: $1 byte +% Informational message showing the stack size that the compiler reserved for the executable. +execinfo_x_stackcommit=09134_X_Spazio di stack impegnato: $1 byte +% Informational message showing the stack size that the compiler committed for the executable. +%\end{description} +# EndOfTeX + +# +# Internal linker messages +# +# 09200 is the last used one +# +# BeginOfTeX +% \section{Linker messages} +% This section lists messages produced by internal linker. +% \begin{description} +link_f_executable_too_big=09200_F_L'immagine dell'eseguibile è troppo grande per la destinazione $1. +% Fatal error when resulting executable is too big. +link_w_32bit_absolute_reloc=09201_W_Il file oggetto "$1" contiene rilocazioni assolute a 32-bit al simbolo "$2". +% Warning when 64-bit object file contains 32-bit absolute relocations. +% In such case an executable image can be loaded into lower 4Gb of +% address space only. +%\end{description} +# EndOfTeX + +# +# Unit loading +# +# 10061 is the last used one +# +# BeginOfTeX +% \section{Unit loading messages.} +% This section lists all messages that can occur when the compiler is +% loading a unit from disk into memory. Many of these messages are +% informational messages. +% \begin{description} +unit_t_unitsearch=10000_T_Ricerca della unit: $1 +% When you use the \var{-vt} option, the compiler tells you where it tries to find +% unit files. +unit_t_ppu_loading=10001_T_Caricamento del PPU $1 +% When the \var{-vt} switch is used, the compiler tells you +% what units it loads. +unit_u_ppu_name=10002_U_Nome del PPU: $1 +% When you use the \var{-vu} flag, the unit name is shown. +unit_u_ppu_flags=10003_U_Flag del PPU: $1 +% When you use the \var{-vu} flag, the unit flags are shown. +unit_u_ppu_crc=10004_U_Crc del PPU: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_time=10005_U_Ora del PPU: $1 +% When you use the \var{-vu} flag, the time the unit was compiled is shown. +unit_u_ppu_file_too_short=10006_U_File PPU troppo corto +% The ppufile is too short, not all declarations are present. +unit_u_ppu_invalid_header=10007_U_Header del PPU non valido (non c'è PPU all'inizio) +% A unit file contains as the first three bytes the ASCII codes of the characters \var{PPU}. +unit_u_ppu_invalid_version=10008_U_Versione del PPU $1 non valida +% This unit file was compiled with a different version of the compiler, and +% cannot be read. +unit_u_ppu_invalid_processor=10009_U_Il PPU è compilato per un altro processore +% This unit file was compiled for a different processor type, and +% cannot be read. +unit_u_ppu_invalid_target=10010_U_Il PPU è compilato per un'altra destinazione +% This unit file was compiled for a different target, and +% cannot be read. +unit_u_ppu_source=10011_U_Sorgente del PPU: $1 +% When you use the \var{-vu} flag, the unit source file name is shown. +unit_u_ppu_write=10012_U_Scrittura di $1 +% When you specify the \var{-vu} switch, the compiler will tell you where it +% writes the unit file. +unit_f_ppu_cannot_write=10013_F_Impossibile scrivere il file PPU +% An error occurred when writing the unit file. +unit_f_ppu_read_error=10014_F_Impossibile leggere il file PPU +% This means that the unit file was corrupted, and contains invalid +% information. Recompilation will be necessary. +unit_f_ppu_read_unexpected_end=10015_F_Fine del file PPU inaspettata +% Unexpected end of file. This may mean that the PPU file is +% corrupted. +unit_f_ppu_invalid_entry=10016_F_Voce del file PPU non valida: $1 +% The unit the compiler is trying to read is corrupted, or generated with a +% newer version of the compiler. +unit_f_ppu_dbx_count_problem=10017_F_Problemi nel conteggi Dbx nel PPU +% There is an inconsistency in the debugging information of the unit. +unit_e_illegal_unit_name=10018_E_Nome della unit $1 illegale +% The name of the unit does not match the file name. +unit_f_too_much_units=10019_F_Troppe unit +% \fpc has a limit of 1024 units in a program. You can change this behavior +% by changing the \var{maxunits} constant in the \file{fmodule.pas} file of the +% compiler, and recompiling the compiler. +unit_f_circular_unit_reference=10020_F_Riferimento circolare fra le unit $1 e $2 +% Two units are using each other in the interface part. This is only allowed +% in the \var{implementation} part. At least one unit must contain the other one +% in the \var{implementation} section. +unit_f_cant_compile_unit=10021_F_Impossibile compilare la unit $1, i sorgenti non sono disponibili +% A unit was found that needs to be recompiled, but no sources are +% available. +unit_f_cant_find_ppu=10022_F_Impossibile trovare la unit unit $1 usata da $2 +% You tried to use a unit of which the PPU file isn't found by the +% compiler. Check your configuration file for the unit paths. +unit_w_unit_name_error=10023_W_La unit $1 non è stata trovata ma la $2 esiste +% This error message is no longer used. +unit_f_unit_name_error=10024_F_Cercata la unit $1 ma trovata la $2 +% \dos truncation of 8 letters for unit PPU files +% may lead to problems when unit name is longer than 8 letters. +unit_w_switch_us_missed=10025_W_E' necessario lo switch -Us per compilare la unit 'system' +% When recompiling the system unit (it needs special treatment), the +% \var{-Us} switch must be specified. +unit_f_errors_in_unit=10026_F_Riscontrati $1 errori nella compilazione del modulo: terminata. +% When the compiler encounters a fatal error or too many errors in a module +% then it stops with this message. +unit_u_load_unit=10027_U_Caricamento da $1 ($2) unit $3 +% When you use the \var{-vu} flag, which unit is loaded from which unit is +% shown. +unit_u_recompile_crc_change=10028_U_Ricompilazione di $1, il checksum di $2 è cambiato +% The unit is recompiled because the checksum of a unit it depends on has +% changed. +unit_u_recompile_source_found_alone=10029_U_Ricompilazione di $1, trovato solo il sorgente +% When you use the \var{-vu} flag, these messages tell you why the current +% unit is recompiled. +unit_u_recompile_staticlib_is_older=10030_U_La libreria statica è più vecchia del file PPU: ricompilo la unit +% When you use the \var{-vu} flag, the compiler warns if the static library +% of the unit is older than the unit file itself. +unit_u_recompile_sharedlib_is_older=10031_U_La libreria condivisa è più vecchia del file PPU: ricompilo la unit +% When you use the \var{-vu} flag, the compiler warns if the shared library +% of the unit is older than the unit file itself. +unit_u_recompile_obj_and_asm_older=10032_U_i file obj e asm sono più vecchi del file PPU: ricompilo la unit +% When you use the \var{-vu} flag, the compiler warns if the assembler or +% object file of the unit is older than the unit file itself. +unit_u_recompile_obj_older_than_asm=10033_U_Il file obj è più vecchio del file asm: ricompilo la unit +% When you use the \var{-vu} flag, the compiler warns if the assembler +% file of the unit is older than the object file of the unit. +unit_u_parsing_interface=10034_U_Analisi dell'interfaccia di $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the interface part of the unit. +unit_u_parsing_implementation=10035_U_Analisi dell'implementazione di $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the implementation part of the unit. +unit_u_second_load_unit=10036_U_Secondo caricamento della unit $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happen with +% interdependent units. +unit_u_check_time=10037_U_PPU Controllo del file $1 ora $2 +% When you use the \var{-vu} flag, the compiler shows the filename and +% date and time of the file on which a recompile depends. +### The following two error msgs is currently disabled. +#unit_h_cond_not_set_in_last_compile=10038_H_Il condizionale $1 non era settato all'inizio dell'ultima compilazione di $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that currently is defined, but was not used the last +#% time the unit was compiled. +#unit_h_cond_set_in_last_compile=10039_H_Il condizionale $1 era settato all'inizio dell'ultima compilazione di $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that was used the last time the unit was compiled, but +#% the conditional is currently not defined. +unit_w_cant_compile_unit_with_changed_incfile=10040_W_Impossibile ricompilare la unit $1, ma sono stati trovati file include modificati +% A unit was found to have modified include files, but +% some source files were not found, so recompilation is impossible. +unit_u_source_modified=10041_U_Il file $1 è più recente del file PPU $2 +% A modified source file for a compiler unit was found. +unit_u_ppu_invalid_fpumode=10042_U_Tentativo di usare una unit compilata con un modo FPU diverso +% Trying to compile code while using units which were not compiled with +% the same floating point format mode. Either all code should be compiled +% with FPU emulation on, or with FPU emulation off. +unit_u_loading_interface_units=10043_U_Caricamento delle unit dall'interfaccia di $1 +% When you use the \var{-vu} flag, the compiler warns that it is starting +% to load the units defined in the interface part of the unit. +unit_u_loading_implementation_units=10044_U_Caricamento delle unit dall'implementazione di $1 +% When you use the \var{-vu} flag, the compiler warns that it is starting +% to load the units defined in the implementation part of the unit. +unit_u_interface_crc_changed=10045_U_Il CRC dell'interfaccia per la unit $1 è cambiato +% When you use the \var{-vu} flag, the compiler warns that the +% CRC calculated for the interface has been changed after the implementation +% has been parsed. +unit_u_implementation_crc_changed=10046_U_Il CRC dell'implementazione per la unit $1 è cambiato +% When you use the \var{-vu} flag, the compiler warns that the +% CRC calculated has been changed after the implementation +% has been parsed. +unit_u_finished_compiling=10047_U_Compilazione della unit $1 terminata +% When you use the \var{-vu} flag, the compiler warns that it +% has finished compiling the unit. +unit_u_add_depend_to=10048_U_Aggiunta dipendenza da $1 a $2 +% When you use the \var{-vu} flag, the compiler warns that it +% has added a dependency between the two units. +unit_u_no_reload_is_caller=10049_U_Nessun ricaricamento, chiamante: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% will not reload the unit because it is the unit that wants +% to load this unit. +unit_u_no_reload_in_second_compile=10050_U_Nessun ricaricamento, già in ricompilazione: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% will not reload the unit because it is already in a second recompile. +unit_u_flag_for_reload=10051_U_Flag per il ricaricamento: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to reload the unit. +unit_u_forced_reload=10052_U_Ricaricamento forzato +% When you use the \var{-vu} flag, the compiler warns that it +% is reloading the unit because it was required. +unit_u_previous_state=10053_U_Stato precedente di $1: $2 +% When you use the \var{-vu} flag, the compiler shows the +% previous state of the unit. +unit_u_second_compile_unit=10054_U_Unit $1 già in fase di compilazione, sarà compilata una seconda volta +% When you use the \var{-vu} flag, the compiler warns that it is starting +% to recompile a unit for the second time. This can happen with interdependent +% units. +unit_u_loading_unit=10055_U_Caricamento della unit $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the unit. +unit_u_finished_loading_unit=10056_U_Finito di caricare la unit $1 +% When you use the \var{-vu} flag, the compiler warns that it finished +% loading the unit. +unit_u_registering_new_unit=10057_U_Registrazione della nuova unit $1 +% When you use the \var{-vu} flag, the compiler warns that it has +% found a new unit and is registering it in the internal lists. +unit_u_reresolving_unit=10058_U_Ri-risoluzione della unit $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to recalculate the internal data of the unit. +unit_u_skipping_reresolving_unit=10059_U_Abortita ri-risoluzione della unit $1, ancora caricamento delle unit usate +% When you use the \var{-vu} flag, the compiler warns that it is +% skipping the recalculation of the internal data of the unit +% because there is no data to recalculate. +unit_u_unload_resunit=10060_U_Unit di risorse $1 scaricata perché non necessaria +% When you use the \var{-vu} flag, the compiler warns that it is unloading the +% resource handling unit, since no resources are used. +unit_e_different_wpo_file=10061_E_La unit $1 è compilata con un diverso feedback di ottimizzazione globale ($2, $3); ricompilarla senza wpo o usare lo stesso file input wpo per questa compilazione +% When a unit has been compiled using a particular ottimizzazione globale (wpo) feedback file (\var{-FW<x>} \var{-OW<x>}), +% this compiled version of the unit is specialised for that particular compilation scenario and cannot be used in +% any other context. It has to be recompiled before you can use it in another program or with another wpo feedback input file. +% \end{description} +# EndOfTeX + +# +# Options +# +# 11047 is the last used one +# +option_usage=11000_O_$1 [options] <inputfile> [options] +# BeginOfTeX +% +% \section{Command line handling errors} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +option_only_one_source_support=11001_W_Supportato un solo file sorgente, cambio il file sorgente da compilare da "$1" in "$2" +% You can specify only one source file on the command line. The last +% one will be compiled, others will be ignored. This may indicate that +% you forgot a \var{'-'} sign. +option_def_only_for_os2=11002_W_I file DEF si possono creare solo per OS/2 +% This option can only be specified when you're compiling for OS/2. +option_no_nested_response_file=11003_E_I file di risposta nidificati non sono supportati +% You cannot nest response files with the \var{@file} command line option. +option_no_source_found=11004_F_Nella riga di comando manca il nome del file sorgente +% The compiler expects a source file name on the command line. +option_no_option_found=11005_N_Non ci sono opzioni nel file di configurazione $1 +% The compiler didn't find any option in that config file. +option_illegal_para=11006_E_Parametro $1 illegale +% You specified an unknown option. +option_help_pages_para=11007_H_-? fornisce le pagine di aiuto +% When an unknown option is given, this message is displayed. +option_too_many_cfg_files=11008_F_Troppi file di configurazione nidificati +% You can only nest up to 16 config files. +option_unable_open_file=11009_F_Impossibile aprire il file $1 +% The option file cannot be found. +option_reading_further_from=11010_D_Lettura di ulteriori opzioni da $1 +% Displayed when you have notes turned on, and the compiler switches +% to another options file. +option_target_is_already_set=11011_W_Destinazione già impostata a: $1 +% Displayed if more than one \var{-T} option is specified. +option_no_shared_lib_under_dos=11012_W_Le librerie condivise non sono supportate sotto DOS: passaggio a librerie statiche +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos. +option_too_many_ifdef=11013_F_Nel file opzioni $1 alla riga $2 ci sono troppi \var{\#IF(N)DEFs} +% The \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_many_endif=11014_F_Nel file opzioni $1 alla riga $2 c'è un \var{\#ENDIFs} che non dovrebbe esserci +% The \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_less_endif=11015_F_Condizionale aperto alla fine del file di opzioni +% The \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_no_debug_support=11016_W_La generazione delle informazioni di debug non è supportata da questo eseguibile +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_Provate a ricompilare il compilatore con -dGDB +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_W_State usando lo switch $1 che è obsoleto +% This warns you when you use a switch that is not needed/supported anymore. +% It is recommended that you remove the switch to overcome problems in the +% future, when the meaning of the switch may change. +option_obsolete_switch_use_new=11019_W_State usando lo switch $1, che è obsoleto: si prega usare $2 al suo posto +% This warns you when you use a switch that is not supported anymore. You +% must now use the second switch instead. +% It is recommended that you change the switch to overcome problems in the +% future, when the meaning of the switch may change. +option_switch_bin_to_src_assembler=11020_N_Cambio dell'assemblatore a quello di scrittora dei sorgenti di default +% This notifies you that the assembler has been changed because you used the +% -a switch, which can't be used with a binary assembler writer. +option_incompatible_asm=11021_W_L'output assembler selezionato "$1" non è compatibile con "$2" +option_asm_forced=11022_W_Forzato l'uso dell'assemblatore "$1" +% The assembler output selected cannot generate +% object files with the correct format. Therefore, the +% default assembler for this target is used instead. +option_using_file=11026_T_Lettura delle opzioni dal file $1 +% Options are also read from this file. +option_using_env=11027_T_Lettura dell opzioni dall'ambiente $1 +% Options are also read from this environment string. +option_handling_option=11028_D_Gestione dell'opzione "$1" +% Debug info that an option is found and will be handled. +option_help_press_enter=11029_O_*** premere invio *** +% Message shown when help is shown page per page. When pressing the ENTER +% Key, the next page of help is shown. If you press q and then ENTER, the +% compiler exits. +option_start_reading_configfile=11030_H_Inizio lettura del file di configurazione $1 +% Start of configuration file parsing. +option_end_reading_configfile=11031_H_Fine lettura del file di configurazione $1 +% End of configuration file parsing. +option_interpreting_option=11032_D_Interpretando l'opzione "$1" +% The compiler is interpreting an option +option_interpreting_firstpass_option=11036_D_Interpretando l'opzione "$1" (primo passo) +% The compiler is interpreting an option for the first time. +option_interpreting_file_option=11033_D_Interpretando l'opzione da file "$1" +% The compiler is interpreting an option which it read from the configuration file. +option_read_config_file=11034_D_Lettura del file di configurazione "$1" +% The compiler is starting to read the configuration file. +option_found_file=11035_D_trovato nome di file sorgente "$1" +% Additional information about options. +% Displayed when you have the debug option turned on. +option_code_page_not_available=11039_E_Codepage (lingua del sorgente) sconosciuta +% An unknown code page for the source files was requested. +% The compiler is compiled with support for several code pages built-in. +% The requested code page is not in that list. You will need to recompile +% the compiler with support for the codepage you need. +option_config_is_dir=11040_F_Il file di configurazione $1 è una directory +% Directories cannot be used as configuration files. +option_confict_asm_debug=11041_W_L'assemblatore selezionato "$1" non può gneerare informazioni di debug: debugging disabilitato +% The selected assembler output cannot generate +% debugging information, debugging option is therefore disabled. +option_ppc386_deprecated=11042_W_L'uso di ppc386.cfg è deprecato, prego usate fpc.cfg al suo posto +% Using ppc386.cfg is still supported for historical reasons, however, for a multiplatform +% system the naming makes no sense anymore. Please continue to use fpc.cfg instead. +option_else_without_if=11043_F_Nel file opzioni $1 alla riga $2 c'è una direttiva \var{\#ELSE} senza il \var{\#IF(N)DEF} corrispondente +% An \var{\#ELSE} statement was found in the options file without a matching \var{\#IF(N)DEF} statement. +option_unsupported_target=11044_F_L'opzione "$1" non è supportata sulla destinazione corrente +% Not all options are supported or implemented for all target platforms. This message informs you that a chosen +% option is incompatible with the currently selected target platform. +option_unsupported_target_for_feature=11045_F_La capacità "$1" non è supportata sulla destinazione corrente +% Not all features are supported or implemented for all target platforms. This message informs you that a chosen +% feature is incompatible with the currently selected target platform. +option_dwarf_smart_linking=11046_N_Le informazioni di debug DWARF non si possono usare con lo smart linking: passaggio al linking statico +% Smart linking is currently incompatble with DWARF debug information on most +% platforms, so smart linking is disabled in such cases. +option_ignored_target=11047_W_L'opzione "$1" è ignorata per la destinazione corrente +% Not all options are supported or implemented for all target platforms. This message informs you that a chosen +% option is ignored for the currently selected target platform. +%\end{description} +# EndOfTeX + +# +# Whole program optimization +# +# 12019 is the last used one +# +# BeginOfTeX +% +% \section{Whole program optimization messages} +% This section lists errors that occur when the compiler is performing +% ottimizzazione globale. +% \begin{description} +wpo_cant_find_file=12000_F_Impossibile aprire il file di feedback "$1" per la ottimizzazione globale +% The compiler cannot open the specified feedback file with ottimizzazione globale information. +wpo_begin_processing=12001_D_Elaborazione dell'informazione per l'ottimizzazione globale dal file di feedback "$1" +% The compiler starts processing ottimizzazione globale information found in the named file. +wpo_end_processing=12002_D_Fine elaborazione dell'informazione per l'ottimizzazione globale dal file di feedback "$1" +% The compiler has finished processing the ottimizzazione globale information found in the named file. +wpo_expected_section=12003_E_Header di sezione errato: trovato "$2" alla riga $1 del file di feedback +% The compiler expected a section header in the ottimizzazione globale file (starting with \%), +% but did not find it. +wpo_no_section_handler=12004_W_Nessun handler registrato per la sezione ottimizzazione globale "$2" alla riga $1 del file feedback wpo: sezione ignorata +% The compiler has no handler to deal with the mentioned ottimizzazione globale information +% section, and will therefore ignore it and skip to the next section. +wpo_found_section=12005_D_Trovata sezione WPO "$1" con informazioni su "$2" +% The compiler encountered a section with ottimizzazione globale information, and according +% to its handler this section contains information usable for the mentioned purpose. +wpo_no_input_specified=12006_F_Le ottimizzazioni globali selezionate richiedono un file di feedback pre-generato (usare -Fw per specificarlo) +% The compiler needs information gathered during a previous compilation run to perform the selected +% ottimizzazione globales. You can specify the location of the feedback file containing this +% information using the -Fw switch. +wpo_not_enough_info=12007_E_Non sono state trovate le informazioni necessarie per eseguire le ottimizzazioni globali "$1" +% While you pointed the compiler to a file containing ottimizzazione globale feedback, it +% did not contain the information necessary to perform the selected optimizations. You most likely +% have to recompile the program using the appropriate -OWxxx switch. +wpo_no_output_specified=12008_F_Specificare un file di feedback (usando -FW) in cui memorizzare le informazioni per l'ottimizzazione globale +% You have to specify the feedback file in which the compiler has to store the ottimizzazione globale +% feedback that is generated during the compilation run. This can be done using the -FW switch. +wpo_output_without_info_gen=12009_E_Non saranno generate informazioni per l'ottimizzazione globale, ma è stato comunque specificato un file (con -FW) +% The compiler was instructed to store ottimizzazione globale feedback into a file specified using -FW, +% but not to actually generated any ottimizzazione globale feedback. The classes of to be +% generated information can be speciied using -OWxxx. +wpo_input_without_info_use=12010_E_Non saranno generate informazioni per l'ottimizzazione globale, ma è stato comunque specificato un file (con -Fw) +% The compiler was not instructed to perform any ottimizzazione globales (no -Owxxx parameters), +% but nevertheless an input file with such feedback was specified (using -Fwyyy). Since this can +% indicate that you forgot to specify an -Owxxx parameter, the compiler generates an error in this case. +wpo_skipping_unnecessary_section=12011_D_Sezione del file di feedback "$1" ignorata, perché non necessaria per le ottimizzazioni richieste +% The ottimizzazione globale feedback file contains a section with information that is not +% required by the selected ottimizzazione globales. +wpo_duplicate_wpotype=12012_W_Sovrascrittura delle informazioni già lette dal file di feedback "$1" con le informazioni nella sezione "$2" +% The feedback file contains multiple sections that provide the same class of information (e.g., +% information about which virtual methods can be devirtualized). In this case, the information in last encountered +% section is used. Turn on debugging output (-vd) to see which class of information is provided by each section. +wpo_cannot_extract_live_symbol_info_strip=12013_E_Impossibile estrarre informazioni di vitalità dei simboli se il programma ne è privo: usate -Xs- +% Certain symbol liveness collectors extract the symbol information from the linked program. If the symbol information +% is stripped (option -Xs), this is not possible. +wpo_cannot_extract_live_symbol_info_no_link=12014_E_Impossibile estrarre informazioni di vitalità dei simboli se il programma non è in fase di linking +% Certain symbol liveness collectors extract the symbol information from the linked program. If the program is not +% linked by the compiler, this is not possible. +wpo_cannot_find_symbol_progs=12015_F_Impossibile trovare "$1" o "$2" per estrarre informazioni di vitalità dei simboli dal programma linkato +% Certain symbol liveness collectors need a helper program to extract the symbol information from the linked program. +% This helper program is normally 'nm', which is part of the GNU binutils. +wpo_error_reading_symbol_file=12016_E_Errore nella lettura delle informazioni di vitalità dei simboli prodotte da "$1" +% An error occurred during the reading of the symbol liveness file that was generated using the 'nm' or 'objdump' program. The reason +% can be that it was shorter than expected, or that its format was not understood. +wpo_error_executing_symbol_prog=12017_F_Errore nell'esecuzione di "$1" (exitcode: $2) per l'estrazione di informazioni sui simboli dal programma linkato +% Certain symbol liveness collectors need a helper program to extract the symbol information from the linked program. +% The helper program produced the reported error code when it was run on the linked program. +wpo_symbol_live_info_needs_smart_linking=12018_E_La raccolta di informazioni sulla vitalità dei simboli è utile solo in caso di smart linking: usate -CX -XX +% Whether or not a symbol is live is determined by looking whether it exists in the final linked program. +% Without smart linking/dead code stripping, all symbols are always included, regardless of whether they are +% actually used or not. So in that case all symbols will be seen as live, which makes this optimization ineffective. +wpo_cant_create_feedback_file=12019_E_Impossibile creare il file di feedback "$1" per l'ottimizzazione globale +% The compiler is unable to create the file specified using the -FW parameter to store the whole program optimisation information. +%\end{description} +# EndOfTeX + + +# +# Logo (option -l) +# +option_logo=11023_[ +Compilatore Free Pascal, versione $FPCFULLVERSION [$FPCDATE] per $FPCCPU +Copyright (c) 1993-2010 di Florian Klaempfl +] + +# +# Info (option -i) +# +option_info=11024_[ +Compilatore Free Pascal, versione $FPCVERSION + +Data creazione del compilatore : $FPCDATE +CPU nativa del compilatore : $FPCCPU + +Destinazioni supportate: + $OSTARGETS + +Set di istruzioni di CPU supportate: + $INSTRUCTIONSETS + +Set di istruzioni di FPU supportate: + $FPUINSTRUCTIONSETS + +Destinazioni ABI supportate: + $ABITARGETS + +Ottimizzazioni supportate: + $OPTIMIZATIONS + +Ottimizzazioni globali supportate: + All + $WPOPTIMIZATIONS + +Tipi di microcontroller supportati: + $CONTROLLERTYPES + +Questo programma è distribuito sotto la GNU General Public Licence +Per ulteriori informazioni leggere il file COPYING.FPC + +Riferire difetti, suggerimenti ecc. a: + http://bugs.freepascal.org +oppure a + bugs@freepascal.org +] + +# +# Help pages (option -? and -h) +# +# The first character on the line indicates who will display this +# line, the current possibilities are : +# * = every target +# 3 = 80x86 targets +# 6 = 680x0 targets +# e = in extended debug mode only +# P = PowerPC targets +# S = Sparc targets +# V = Virtual machine targets +# The second character also indicates who will display this line, +# (if the above character was TRUE) the current possibilities are : +# * = everyone +# g = with GDB info supported by the compiler +# O = OS/2 +# L = UNIX systems +# The third character represents the indentation level. +# +option_help_pages=11025_[ +**0*_Mettere + dopo uno switch per attivarlo, - per disattivarlo +**1a_Il compilatore non cancella i file asm generati +**2al_Elenca le linee del codice sorgente nel file asm +**2an_Elenca informazioni sui nodi nel file assembler +*L2ap_Usa pipes invece di creare file assembler temporanei +**2ar_Elenca info allocaz./rilascio registri nel file asm +**2at_Elenca info allocaz./rilascio nei file asm +**1A<x>_Formato di uscita: +**2Adefault_Usa l'assemblatore di default +3*2Aas_Assembla usando GNU AS +3*2Anasmcoff_File COFF (Go32v2) con Nasm +3*2Anasmelf_File ELF32 (Linux) con Nasm +3*2Anasmwin32_File oggetto Win32 con Nasm +3*2Anasmwdosx_File oggetto Win32/WDOSX con Nasm +3*2Awasm_File oggetto con Wasm (Watcom) +3*2Anasmobj_File oggetto con Nasm +3*2Amasm_File oggetto con Masm (Microsoft) +3*2Atasm_File oggetto con Tasm (Borland) +3*2Aelf_File ELF (Linux) con assemblatore interno +3*2Acoff_File COFF (Go32v2) con assemblatore interno +3*2Apecoff_File PE-COFF (Win32) con assemblatore interno +4*2Aas_Assembla using GNU AS +6*2Aas_Unix o-file using GNU AS +6*2Agas_GNU Motorola assembler +6*2Amit_MIT Syntax (old GAS) +6*2Amot_Usa l'assemblatore standard Motorola +A*2Aas_Assembla con GNU AS +P*2Aas_Assembla con GNU AS +S*2Aas_Assembla con GNU AS +**1b_Genera info per il browser +**2bl_Genera info sui simboli locali +**1B_Costruisce tutti i moduli +**1C<x>_Opzioni di generazione del codice: +**2Ca<x>_Seleziona l'ABI, vedi fpc -i per i valori possibili +**2Cb_Genera codice big-endian +**2Cc<x>_Imposta la convenzione di chiamata di default a <x> +**2CD_Crea anche la libreria dinamica (non supportato) +**2Ce_Compilazione con opcode in virgola mobile emulati +**2Cf<x>_Sceglie il set di istruzioni FPU, (vedi fpc -i) +**2CF<x>_Precisione minima per costanti virgola mobile (default/32/64) +**2Cg_Genera codice position-independent (PIC) +**2Ch<n>_<n> dimensione in byte dello heap +**3*_ (fra 1023 e 67107840) +**2Ci_controllo dell'I/O +**2Cn_Non fare il linking +**2Co_Controlla l'overflow di operazioni su interi +**2CO_Controlla il possibile overflow di operazioni su interi +**2Cp<x>_Scegli il set di istruzioni, +**3*_ (vedi fpc -i per i valori possibili) +**2CP<x>=<y>_ impostazioni per il packing +**3CPPACKSET=<y>_ <y> imposta l'allocazione: +**3*_ (0, 1 o DEFAULT o NORMAL, 2, 4 e 8) +**2Cr_Controllo degli intervalli (range) +**2CR_Controlla la validità di chiamate a metodi di oggetti +**2Cs<n>_Imposta controllo validità dello stack a <n> +**2Ct_Controllo stack (solo testing, vedi manuale) +**2CX_Crea anche librerie smartlinked +**1d<x>_Definisce il simbolo <x> +**1D_Genera un file DEF +**2Dd<x>_Imposta descrizione a <x> +**2Dv<x>_Imposta versione della DLL a <x> +*O2Dw_Applicazione PM +**1e<x>_Imposta il path all'eseguibile +**1E_Identico a -Cn +**1fPIC_Identico a -Cg +**1F<x>_Imposta nomi di file e path: +**2Fa<x>[,y]_(programma) carica unit <x> e [y] +**3*_ (prima di parsare la sezione uses) +**2Fc<x>_Imposta codepage di input a <x> +**2FC<x>_Imposta il nome dell'exe del compilatore RC a <x> +**2Fd_Disabilita cache interna delle dir. del compilatore +**2FD<x>_Imposta la directory in cui cercare le utility +**2Fe<x>_Redirezione l'output degli errori a <x> +**2Ff<x>_Aggiunge <x> al path del framework (solo Darwin) +**2FE<x>_Imposta il path di output exe/unit a <x> +**2Fi<x>_Aggiunge <x> al path degli include +**2Fl<x>_Aggiunge <x> al path delle library +**2FL<x>_Usa <x> come linker dinamico +**2Fm<x>_Carica tabella conversione unicode da <x>.txt +**3*_ (nella directory del compilatore) +**2Fo<x>_Aggiunge <x> al path dei file oggetto +**2Fr<x>_Carica file dei messaggi di errore <x> +**2FR<x>_Imposta linker delle risorse (.res) a <x> +**2Fu<x>_Aggiunge <x> al path delle unit +**2FU<x>_Setta output path delle unit a <x>, sovrascrive -FE +**2FW<x>_Memorizza il feedback per l'ottimizz. globale in <x> +**2Fw<x>_Carica info ottimizz. globale dal feedback file <x> +*g1g_Genera info di debug (formato di default per la destinaz.) +*g2gc_Genera controlli per i puntatori +*g2gh_Usa unit heaptrace (debug di memory leak o corruzioni) +*g2gl_Usa unit line info (mostra più info con i backtrace) +*g2go<x>_Imposta opzioni delle informazioni di debug +*g3godwarfsets_Abilita debug info tipo DWARF 'set' +*g3*_ (attenzione: fa crashare gdb < 6.5) +*g3gostabsabsincludes_Memorizza path assoluto per +*g3*_ gli include file in Stabs +*g3godwarfmethodclassprefix_Prefissa i nomi dei metodi +**3*_ in DWARF con il nome di classe +*g2gp_Conserva maiuscole nei nomi di simboli stabs +*g2gs_Genera info di debug Stabs +*g2gt_Scarta variabili locali +*g3*_ (rileva il loro uso non inizializzato) +*g2gv_Genera programmi tracciabili con Valgrind +*g2gw_Genera info di debug DWARFv2 (come -gw2) +*g2gw2_Genera info di debug DWARFv2 +*g2gw3_Genera info di debug DWARFv3 +**1i_Informazioni +**2iD_Ritorna la data del compilatore +**2iV_Ritorna la versione breve del compilatore +**2iW_Ritorna la versione completa del compilatore +**2iSO_Ritorna il sistema operativo del compilatore +**2iSP_Ritorna la CPU ospite del compilatore +**2iTO_Ritorna il sistema operativo di destinazione +**2iTP_Ritorna la CPU di destinazione +**1I<x>_Aggiunge <x> al path degli include file +**1k<x>_Passa <x> al linker +**1l_Scrive il logo +**1M<x>_Imposta il modo del linguaggio a <x> +**2Mfpc_Dialetto Free Pascal (default) +**2Mobjfpc_Modo FPC con supporto Object Pascal +**2Mdelphi_Modo compatibilità Delphi 7 +**2Mtp_Modo compatibilità TP/BP 7.0 +**2Mmacpas_Modo compatibilità Macintosh Pascal e dialetti +**1n_Non leggere i file configurazione di default +**1N<x>_Ottimizzazioni dell'albero dei nodi +**2Nu_Srotola i loop +**1o<x>_Rinomina l'eseguibile prodotto in <x> +**1O<x>_Ottimizzazioni: +**2O-_Disabilita le ottimizzazioni +**2O1_Ottimizzazione livello 1 +**3*_ (rapide e trasparenti al debugger) +**2O2_Ottimizzazione livello 2 (-O1 + ottimizz. veloce) +**2O3_Ottimizzazione livello 3 (-O2 + ottimizz. lenta) +**2Oa<x>=<y>_Imposta allineamento +**2Oo[NO]<x>_Abilita/disabilita ottimizzazioni, +**3*_ (vedi fpc -i per possibili valori) +**2Op<x>_Imposta ottimizzazione per una CPU specifica, +**3*_ (vedi fpc -i per possibili valori) +**2OW<x>_Genera feedback per l'ottimizz. globale <x> (vedi fpc -i) +**2Ow<x>_Esegue ottimizzazione globale <x> (vedi fpc -i) +**2Os_Ottimizza per la dimensione e non per la velocità +**1pg_Genera codici di profiling per gprof (FPC_PROFILE: on) +**1R<x>_Stile di lettura assembler: +**2Rdefault_Usa assembler di default per la destinazione +3*2Ratt_Leggi assembler stile AT&T +3*2Rintel_Leggi assembler stile Intel +6*2RMOT_Leggi assembler stile motorola +**1S<x>_Opzioni di sintassi: +**2S2_Come -Mobjfpc +**2Sc_Supporta operatori simil-C (*=,+=,/= e -=) +**2Sa_Abilita le asserzioni +**2Sd_Come -Mdelphi +**2Se<x>_Opzioni sugli errori. <x> è la combinazione di: +**3*_<n> : Il compilatore si ferma dopo <n> errori (default = 1) +**3*_w : Il compilatore si ferma anche con warning +**3*_n : Il compilatore si ferma anche con note +**3*_h : Il compilatore si ferma anche con consigli +**2Sg_Abilita LABEL e GOTO (default in -Mtp e -Mdelphi) +**2Sh_Usa ansistring per default invece di shortstring +**2Si_Abilita l'inlining di procedure e funzioni +**3*_ dichiarate come "inline" +**2Sk_Carica unit fpcylix +**2SI<x>_Imposta stile di interfacce a <x> +**3SIcom_Interfaccia COM compatibile (default) +**3SIcorba_Interfaccia CORBA compatible +**2Sm_Supporta macro simil-C (global) +**2So_Come -Mtp +**2Ss_Il nome del costruttore deve essere 'init' +**3*_ (e il nome del distruttore deve essere 'done') +**2St_Permetti la parola chiave static negli oggetti +**2Sx_Abilita la parola chiave exception +**3*_ (default nei modi Delphi/ObjFPC) +**1s_Non chiamare assembler e linker +**2sh_Genera script per il linking sull'host +**2st_Genera script per il linking sulla destinazione +**2sr_Salta la fase di allocazione dei registri (usare con -alr) +**1T<x>_Sistema operativo di destinazione: +3*2Temx_OS/2 via EMX (inclusi extender EMX/RSX) +3*2Tfreebsd_FreeBSD +3*2Tgo32v2_DJ Delorie DOS extender versione 2 +3*2Tlinux_Linux +3*2Tnetbsd_NetBSD +3*2Tnetware_Novell Netware Module (clib) +3*2Tnetwlibc_Novell Netware Module (libc) +3*2Topenbsd_OpenBSD +3*2Tos2_OS/2 / eComStation +3*2Tsunos_SunOS/Solaris +3*2Tsymbian_Symbian OS +3*2Twatcom_DOS extender compatibile Watcom +3*2Twdosx_WDOSX DOS extender +3*2Twin32_Windows 32 Bit +3*2Twince_Windows CE +4*2Tlinux_Linux +6*2Tamiga_Commodore Amiga +6*2Tatari_Atari ST/STe/TT +6*2Tlinux_Linux/m68k +6*2Tmacos_Macintosh m68k (non supportato) +6*2Tpalmos_PalmOS +A*2Tlinux_Linux +A*2Twince_Windows CE +P*2Tamiga_AmigaOS su PowerPC +P*2Tdarwin_Darwin e Mac OS X su PowerPC +P*2Tlinux_Linux su PowerPC +P*2Tmacos_Mac OS (classic) su PowerPC +P*2Tmorphos_MorphOS +S*2Tlinux_Linux +**1u<x>_Elimina il simbolo <x> +**1U_Opzioni per le unit: +**2Un_Non controllare se i nomi della unit e +**3*_ del file che la contiene sono uguali +**2Ur_Genera file di release delle unit +**3*_ (niente ricompilazione automatica) +**2Us_Compila una unit di sistema +**1v<x>_Prolisso. <x> è una combinazione dei seguenti: +**2*_e : Mostra errori (default) 0 : Mostra solo errori e basta +**2*_w : Mostra warning u : Mostra info sulla unit +**2*_n : Mostra note t : Mostra files usati/tentati +**2*_h : Mostra consigli c : Mostra i condizionali +**2*_i : Mostra info generiche d : Mostra info di debug +**2*_l : Mostra numri di riga r : Modo compatibile Rhide/GCC +**2*_s : Mostra date/ore q : Mostra numeri dei messaggi +**2*_a : Mostra tutto x : Info degli exe (solo Win32) +**2*_b : Nei messaggi scrivi nomi p : Scrivi parse tree in tree.log +**2*_ file con path completo v : Scrivi fpcdebug.txt con +**2*_ molte informazioni di debug +**2*_m<x>,<y> : Non mostrare messaggi con i numeri <x> e <y> +3*1W<x>_Opzioni specifiche della destinazione (destinazioni) +A*1W<x>_Opzioni specifiche della destinazione (destinazioni) +P*1W<x>_Opzioni specifiche della destinazione (destinazioni) +p*1W<x>_Opzioni specifiche della destinazione (destinazioni) +3*2Wb_Crea un bundle e non una libreria (Darwin) +P*2Wb_Crea un bundle e non una libreria (Darwin) +p*2Wb_Crea un bundle e non una libreria (Darwin) +3*2WB_Crea una immagine rilocabile (Windows) +A*2WB_Crea una immagine rilocabile (Windows, Symbian) +3*2WC_Specifica applicazione di tipo console +3*3*_ (EMX, OS/2, Windows) +A*2WC_Specifica applicazione console (Windows) +P*2WC_Specifica applicazione console (Classic Mac OS) +3*2WD_Usa DEFFILE per esportare funz. di DLL o EXE (Windows) +A*2WD_Usa DEFFILE per esportare funz. di DLL o EXE (Windows) +3*2We_Usa risorse esterne (Darwin) +P*2We_Usa risorse esterne (Darwin) +p*2We_Usa risorse esterne (Darwin) +3*2WF_Specifica un'applicazione a tutto schermo (EMX, OS/2) +3*2WG_Specifica una applicazione grafica (EMX, OS/2, Windows) +A*2WG_Specifica una applicazione grafica (Windows) +P*2WG_Specifica una applicazione grafica (Classic Mac OS) +3*2Wi_Usa risorse interne (Darwin) +P*2Wi_Usa risorse interne (Darwin) +p*2Wi_Usa risorse interne (Darwin) +3*2WN_Non generare codice di rilocazione, +3*3*_ (necessario per il debug sotto Windows) +A*2WN_Non generare codice di rilocazione, +A*3*_(necessario per il debug sotto Windows) +3*2WR_Genera codice di rilocazione (Windows) +A*2WR_Genera codice di rilocazione (Windows) +P*2WT_Specifica applicazione tipo tool MPW (Classic Mac OS) +3*2WX_Abilita stack dell'eseguibile (Linux) +A*2WX_Abilita stack dell'eseguibile (Linux) +p*2WX_Abilita stack dell'eseguibile (Linux) +P*2WX_Abilita stack dell'eseguibile (Linux) +**1X_Opzioni per gli eseguibili: +**2Xc_Passa --shared/-dynamic al linker +**3*_ (BeOS, Darwin, FreeBSD, Linux) +**2Xd_Non usare il path per la standard library +**3*_ (per crosscompilazione) +**2Xe_Usa linker esterno +**2Xg_Metti le info di debug in un file diverso e inserisci +**3*_ una sezione debuglink nell'eseguibile +**2XD_Cerca di linkare le unit dinamicamente +**3*_ (FPC_LINK_DYNAMIC: on) +**2Xi_Usa linker interno +**2Xm_Genera la mappa di linking +**2XM<x>_Rinomina la routine 'main' del programma (default: main) +**2XP<x>_Aggiunge il prefisso <x> ai nomi delle binutils +**2Xr<x>_Pone il path rlink del linker a <x> +**3*_ per crosscompilazioni, vedi manuale di ld (BeOS, Linux) +**2XR<x>_Prepone <x> ai path del linker +**3*_ (BeOS, Darwin, FreeBSD, Linux, Mac OS, Solaris) +**2Xs_Elimina tutti i simboli dall'eseguibile finale +**2XS_Prova a linkare tutte le unit staticamente +**3*_ (default, FPC_LINK_STATIC: on) +**2Xt_Linka a librerie statiche (passa -static al linker) +**2XX_Prova a usare lo smartlinking (FPC_LINK_SMART: on) +**1*_ +**1?_Mostra questo help +**1h_Mostra questo help senza interruzioni +] + +# +# The End... diff --git a/closures/compiler/msg/errorn.msg b/closures/compiler/msg/errorn.msg new file mode 100644 index 0000000000..ac7bef7f8a --- /dev/null +++ b/closures/compiler/msg/errorn.msg @@ -0,0 +1,2372 @@ +# +# This file is part of the Free Pascal Compiler +# Copyright (c) 1999-2008 by the Free Pascal Development team +# +# Dutch Language File for Free Pascal in CP850 (just one line in help affected) +# Latest updates contributed by Matthijs Willemstein <matthijs at willemstein.net> +# Based on errore.msg of SVN revision 3982 +# +# 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. +# +# +# The constants are build in the following order: +# <part>_<type>_<txtidentifier> +# +# <part> is the part of the compiler the message is used +# asmr_ assembler parsing +# asmw_ assembler writing/binary writers +# unit_ unit handling +# scan_ scanner +# parser_ parser +# type_ type checking +# general_ general info +# exec_ calls to assembler, linker, binder +# +# <type> the type of the message it should normally used for +# f_ fatal error +# e_ error +# w_ warning +# n_ note +# h_ hint +# i_ info +# l_ add linenumber +# u_ used +# t_ tried +# c_ conditional +# d_ debug message +# x_ executable informations +# +# +# General +# +# 01023 is the last used one +# +general_text_bytes_code=01019_bytes code +general_text_bytes_data=01020_bytes data +# BeginOfTeX +% \section{General compiler messages} +% This section gives the compiler messages which are not fatal, but which +% display useful information. The number of such messages can be +% controlled with the various verbosity level \var{-v} switches. +% \begin{description} +general_t_compilername=01000_T_Gebruikte compiler: $1 +% When the \var{-vt} switch is used, this line tells you what compiler +% is used. +general_d_sourceos=01001_D_Bronsysteem: $1 +% When the \var{-vd} switch is used, this line tells you what the source +% operating system is. +general_i_targetos=01002_I_Doelsysteem: $1 +% When the \var{-vd} switch is used, this line tells you what the target +% operating system is. +general_t_exepath=01003_T_Programmalocatie: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its binaries. +general_t_unitpath=01004_T_Locatie units: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for compiled units. You can set this path with the \var{-Fu} +general_t_includepath=01005_T_Locatie includes: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its include files (files used in \var{\{\$I xxx\}} statements). +% You can set this path with the \var{-I} option. +general_t_librarypath=01006_T_Locatie bibliotheken: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for the libraries. You can set this path with the \var{-Fl} option. +general_t_objectpath=01007_T_Locatie objectbestanden: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for object files you link in (files used in \var{\{\$L xxx\}} statements). +% You can set this path with the \var{-Fo} option. +general_i_abslines_compiled=01008_I_$1 Regels gecompileerd, $2 sec. +% When the \var{-vi} switch is used, the compiler reports the number +% of lines compiled, and the time it took to compile them (real time, +% not program time). +general_f_no_memory_left=01009_F_Geen geheugen meer vrij +% The compiler doesn't have enough memory to compile your program. There are +% several remedies for this: +% \begin{itemize} +% \item If you're using the build option of the compiler, try compiling the +% different units manually. +% \item If you're compiling a huge program, split it up in units, and compile +% these separately. +% \item If the previous two don't work, recompile the compiler with a bigger +% heap (you can use the \var{-Ch} option for this, \seeo{Ch}) +% \end{itemize} +general_i_writingresourcefile=01010_I_Schrijven van resource string tabel bestand: $1 +% This message is shown when the compiler writes the Resource String Table +% file containing all the resource strings for a program. +general_e_errorwritingresourcefile=01011_E_Schrijven van resource string tabel bestand: $1 +% This message is shown when the compiler encountered an error when writing +% the Resource String Table file +general_i_fatal=01012_I_Fatale fout: +% Prefix for Fatal Errors +general_i_error=01013_I_Fout: +% Prefix for Errors +general_i_warning=01014_I_Waarschuwing: +% Prefix for Warnings +general_i_note=01015_I_Noot: +% Prefix for Notes +general_i_hint=01016_I_Tip: +% Prefix for Hints +general_e_path_does_not_exist=01017_E_Pad "$1" bestaat niet +% The specified path does not exist. +general_f_compilation_aborted=01018_F_Compilatie afgebroken +% Compilation was aborted. +general_i_number_of_warnings=01021_I_$1 warning(s) issued +% Total number of warnings issued during compilation. +general_i_number_of_hints=01022_I_$1 hint(s) issued +% Total number of hints issued during compilation. +general_i_number_of_notes=01023_I_$1 tip(s) gegeven +# +# Scanner +# +# 02063 is the last used one +# +% Total number of notes issued during compilation. +% \end{description} +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compiling handling. +% \begin{description} +scan_f_end_of_file=02000_F_Onverwacht einde van bestand +% this typically happens in one of the following cases : +% \begin{itemize} +% \item The source file ends before the final \var{end.} statement. This +% happens mostly when the \var{begin} and \var{end} statements aren't +% balanced; +% \item An include file ends in the middle of a statement. +% \item A comment was not closed +% \end{itemize} +scan_f_string_exceeds_line=02001_F_String langer dan regel +% There is a missing closing ' in a string, so it occupies +% multiple lines. +scan_f_illegal_char=02002_F_ongeldig teken "$1" ($2) +% An illegal character was encountered in the input file. +scan_f_syn_expected=02003_F_Taalfout: $2 verwacht in kolom $1 +% This indicates that the compiler expected a different token than +% the one you typed. It can occur almost everywhere where you make a +% mistake against the pascal language. +scan_t_start_include_file=02004_TL_Ingevoegd bestand $1 word geopend +% When you provide the \var{-vt} switch, the compiler tells you +% when it starts reading an included file. +scan_w_comment_level=02005_W_Commentaar van niveau $1 gevonden +% When the \var{-vw} switch is used, then the compiler warns you if +% it finds nested comments. Nested comments are not allowed in Turbo Pascal +% and can be a possible source of errors. +scan_n_ignored_switch=02008_N_Genegeerde compileroptie $1 +% With \var{-vn} on, the compiler warns if it ignores a switch +scan_w_illegal_switch=02009_W_Foutieve compileroptie $1 +% You included a compiler switch (i.e. \var{\{\$... \}}) which the compiler +% does not recognise +scan_w_switch_is_global=02010_W_Deze compileroptie heeft ook een globaal effect +% The compiler switch is misplaced, and should be located at +% the start of the unit or program. +scan_e_illegal_char_const=02011_E_Foutieve constante voor een karakter +% This happens when you specify a character with its ASCII code, as in +% \var{\#96}, but the number is either illegal, or out of range. +scan_f_cannot_open_input=02012_F_Kan bestand "$1" niet openen +% \fpc cannot find the program or unit source file you specified on the +% command line. +scan_f_cannot_open_includefile=02013_F_Kan ingevoerd bestand niet openen $1 +% \fpc cannot find the source file you specified in a \var{\{\$include ..\}} +% statement. +scan_e_illegal_pack_records=02015_E_Ongeldige alignatie-aanduiding voor records: "$1" +% You are specifying the \var{\{\$PACKRECORDS n\} } or \var{\{\$ALIGN n\} } +% with an illegal value for \var{n}. For \$PACKRECORDS valid alignments are 1, 2, 4, 8, 16, 32, C, +% NORMAL, DEFAULT, and for \$ALIGN valid alignment are 1, 2, 4, 8, 16, 32, ON, +% OFF. Under mode MacPas \$ALIGN also supports MAC68K, POWER and RESET. +scan_e_illegal_pack_enum=02016_E_Ongeldige enumeratie grootte aanduiding "$1" +% You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for +% \var{n}. Only 1,2,4, NORMAL or DEFAULT are valid here. +scan_e_endif_expected=02017_E_$ENDIF verwacht voor $1 op $2 $3 lijn $4 +% Your conditional compilation statements are unbalanced. +scan_e_preproc_syntax_error=02018_E_Taalfout bij het compileren van een conditionele compilatie uitdrukking +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc compiler +% directives. +scan_e_error_in_preproc_expr=02019_E_Evalueren van een conditionele compilatie uitdrukking +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc compiler +% directives. +scan_w_macro_cut_after_255_chars=02020_W_Macro inhoud is afgekapt op 255 karakters voor evaluatie +% The contents of macros cannot be longer than 255 characters. +scan_e_endif_without_if=02021_E_ENDIF zonder IF(N)DEF +% Your \var{\{\$IFDEF ..\}} and {\{\$ENDIF\}} statements aren't balanced. +scan_f_user_defined=02022_F_Gebruiker definitie: $1 +% A user defined fatal error occurred. see also the \progref +scan_e_user_defined=02023_E_Gebruiker definitie: $1 +% A user defined error occurred. see also the \progref +scan_w_user_defined=02024_W_Gebruiker definitie: $1 +% A user defined warning occurred. see also the \progref +scan_n_user_defined=02025_N_Gebruiker definitie: $1 +% A user defined note was encountered. see also the \progref +scan_h_user_defined=02026_H_Gebruiker definitie: $1 +% A user defined hint was encountered. see also the \progref +scan_i_user_defined=02027_I_Gebruiker definitie: $1 +% User defined information was encountered. see also the \progref +scan_e_keyword_cant_be_a_macro=02028_E_Sleutelwoord herdefinieren als macro heeft geen effect +% You cannot redefine keywords with macros. +scan_f_macro_buffer_overflow=02029_F_Macro buffer overflow bij lezen of expansie van macro +% Your macro or its result was too long for the compiler. +scan_w_macro_too_deep=02030_W_Uitwerken van macros heeft niveau 16 overschreden +% When expanding a macro, macros have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_w_wrong_styled_switch=02031_W_Compiler opties in delphi commentaar stijl zijn niet ondersteund +% Compiler switches should be in normal pascal style comments. +scan_d_handling_switch=02032_DL_Behandel schakelaar "$1" +% When you set debugging info on (\var{-vd}) the compiler tells you when it +% is evaluating conditional compile statements. +scan_c_endif_found=02033_CL_ENDIF $1 gevonden +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifdef_found=02034_CL_IFDEF $1 gevonden, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifopt_found=02035_CL_IFOPT $1 gevonden, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_if_found=02036_CL_IF $1 gevonden, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifndef_found=02037_CL_IFNDEF $1 gevonden, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_else_found=02038_CL_ELSE $1 gevonden, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_skipping_until=02039_CL_Negeer tot... +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements, and whether it is skipping or +% compiling parts. +scan_i_press_enter=02040_I_Druk <return> om verder te gaan +% When the \var{-vi} switch is used, the compiler stops compilation +% and waits for the \var{Enter} key to be pressed when it encounters +% a \var{\{\$STOP\}} directive. +scan_w_unsupported_switch=02041_W_Niet ondersteunde optie $1 +% When warnings are turned on (\var{-vw}) the compiler warns you about +% unsupported switches. This means that the switch is used in Delphi or +% Turbo Pascal, but not in \fpc +scan_w_illegal_directive=02042_W_Ongeldige compiler optie $1 +% When warings are turned on (\var{-vw}) the compiler warns you about +% unrecognised switches. For a list of recognised switches, \progref +scan_t_back_in=02043_TL_Terug in $1 +% When you use (\var{-vt}) the compiler tells you when it has finished +% reading an include file. +scan_w_unsupported_app_type=02044_W_Niet ondersteund programmatype: $1 +% You get this warning, if you specify an unknown application type +% with the directive \var{\{\$APPTYPE\}} +scan_w_app_type_not_support=02045_W_$APPTYPE niet ondersteund op doelsysteem +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_w_description_not_support=02046_W_DESCRIPTIION is niet ondersteund op het geselecteerde OS +% The \var{\{\$DESCRIPTION\}} directive is not supported on this target OS +scan_n_version_not_support=02047_N_VERSION is niet ondersteund door het doel OS. +% The \var{\{\$VERSION\}} directive is not supported on this target OS +scan_n_only_exe_version=02048_N_VERSION kan alleen voor executables of bibliotheken +% The \var{\{\$VERSION\}} directive is only used for executable or DLL sources. +scan_w_wrong_version_ignored=02049_W_verkeerd formaat voor VERSION directive $1 +% The \var{\{\$VERSION\}} directive format is majorversion.minorversion +% where majorversion and minorversion are words. +scan_e_illegal_asmmode_specifier=02050_E_Ongeldige assembler-stijl opgegeven: "$1" +% When you specify an assembler mode with the \var{\{\$ASMMODE xxx\}} +% the compiler didn't recognize the mode you specified. +scan_w_no_asm_reader_switch_inside_asm=02051_W_ASM lezer-optie is niet mogelijk in een asm instructie, $1 ingesteld voor volgende blok +% It is not possible to switch from one assembler reader to another +% inside an assembler block. The new reader will be used for next +% assembler statements only. +scan_e_wrong_switch_toggle=02052_E_Verkeerde optiewaarde, gebruik ON/OFF of +/- +% You need to use ON or OFF or a + or - to toggle the switch +scan_e_resourcefiles_not_supported=02053_E_Resource bestanden worden niet ondersteund op doel OS +% The target you are compiling for doesn't support resource files. +scan_w_include_env_not_found=02054_W_Include omgevingsvariabele $1 niet gevonden in omgeving +% The included environment variable can't be found in the environment, it will +% be replaced by an empty string instead. +scan_e_invalid_maxfpureg_value=02055_E_Ongeldige waarde voor FPU register limiet +% Valid values for this directive are 0..8 and NORMAL/DEFAULT +scan_w_only_one_resourcefile_supported=02056_W_Slechts 1 resource bestand ondersteund voor dit operating systeem. +% The target you are compiling for supports only one resource file. +% The first resource file found is used, the others are discarded. +scan_w_macro_support_turned_off=02057_W_Macro ondersteuning is uitgeschakeld +% A macro declaration has been found, but macro support is currently off, +% so the declaration will be ignored. To turn macro support on compile with +% -Sm on the commandline or add \{\$MACRO ON\} in the source +scan_e_invalid_interface_type=02058_E_Ongeldig interface type opgegeven. Geldige waarden zijn COM, CORBA of DEFAULT +% The interface type that was specified is not supported +scan_w_appid_not_support=02059_W_APPID is slechts ondersteund op PalmOS +% The \var{\{\$APPID\}} directive is only supported for the PalmOS target. +scan_w_appname_not_support=02060_W_APPNAME is slechts ondersteund op PalmOS +% The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target. +scan_e_string_exceeds_255_chars=02061_E_Constante tekenreeksen (strings) kunnen niet langer dan 255 karakters zijn. +% A single string constant can contain at most 255 chars. Try splitting up the +% string in multiple smaller parts and concatenate them with a + operator. +scan_f_include_deep_ten=02062_F_Include bestanden kunnen maar tot op 16 niveaus genest worden +% When including include files the files have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_e_too_many_push=02063_F_Te veel PUSH niveaus +% A maximum of 20 levels is allowed. This error occurs only in mode MacPas. +scan_e_too_many_pop=02064_E_POP instructie zonder voorafgaande PUSH instructie +% This error occurs only in mode MacPas. +scan_e_error_macro_lacks_value=02065_E_Macro of compilatie-variabele "$1" heeft geen waarde +% Thus the conditional compile time expression cannot be evaluated. +scan_e_wrong_switch_toggle_default=02066_E_Verkeerde schakel-waarde. Gebruik ON/OFF/DEFAULT of +/-/* +% You need to use ON or OFF or DEFAULT or a + or - or * to toggle the switch +scan_e_mode_switch_not_allowed=02067_E_MODE schakel "$1" is niet toegestaan op deze plaats. +% A mode switch has already been encountered, or, in case of option -Mmacpas, +% a mode switch occur after UNIT. +scan_e_error_macro_undefined=02068_E_Macro of compilatie-variabele "$1" is niet gedefinieerd +% Thus the conditional compile time expression cannot be evaluated. Only in mode MacPas. +scan_e_utf8_bigger_than_65535=02069_E_UTF-8 code groter dan 65535 gevonden +% \fpc handles utf-8 strings internally as widestrings e.g. the char codes are limited to 65535 +scan_e_utf8_malformed=02070_E_Ongeldige UTF-8 tekenreeks +% The given string isn't a valid UTF-8 string +scan_c_switching_to_utf8=02071_C_UTF-8 handtekening gevonden, gebruik UTF-8 codering +% The compiler found an UTF-8 encoding signature (\$ef, \$bb, \$bf) at the beginning of a file, +% so it interprets it as an UTF-8 file +scan_e_compile_time_typeerror=02072_E_Compilatie-expressie: "$1" gevraagd, maar kreeg "$2" op "$3" +% Type check of a compile time expression failed. +scan_n_app_type_not_support=02073_N_APPTYPE wordt niet ondersteund door het doel OS +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_e_illegal_optimization_specifier=02074_E_Ongeldige optimalisatie gegeven "$1" +% When you specify an optimization with the \var{\{\$OPTIMIZATION xxx\}} +% the compiler didn't recognize the optimization you specified. +scan_w_setpeflags_not_support=02075_W_SETPEFLAGS wordt niet ondersteund door het doel OS +% The \var{\{\$SETPEFLAGS\}} directive is not supported by the target OS +scan_w_imagebase_not_support=02076_W_IMAGEBASE wordt niet ondersteunddoor het doel OS +% The \var{\{\$IMAGEBASE\}} directive is not supported by the target OS +scan_w_minstacksize_not_support=02077_W_MINSTACKSIZE wordt niet ondersteund door het doel OS +% The \var{\{\$MINSTACKSIZE\}} directive is not supported by the target OS +scan_w_maxstacksize_not_support=02078_W_MAXSTACKSIZE wordt niet ondersteund door het doel OS +# +# Parser +# +# 03192 is the last used one +# +% The \var{\{\$MAXSTACKSIZE\}} directive is not supported by the target OS +% \end{description} +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your pascal constructs +% are correct. +% \begin{description} +parser_e_syntax_error=03000_E_Parser - Taalfout +% An error against the Turbo Pascal language was encountered. This happens +% typically when an illegal character is found in the sources file. +parser_e_dont_nest_interrupt=03004_E_INTERRUPT procedures kunnen niet genest worden +% An \var{INTERRUPT} procedure must be global. +parser_w_proc_directive_ignored=03005_W_Procedure type $1 ignored +% The specified procedure directive is ignored by FPC programs. +parser_e_no_overload_for_all_procs=03006_E_Not all declarations of $1 are declared with OVERLOAD +% When you want to use overloading using the \var{OVERLOAD} directive, then +% all declarations need to have \var{OVERLOAD} specified. +parser_e_export_name_double=03008_E_Dubbel geexporteerde functienaam $1 +% Exported function names inside a specific DLL must all be different +parser_e_export_ordinal_double=03009_E_Dubbel geexporteerde functie index $1 +% Exported function names inside a specific DLL must all be different +parser_e_export_invalid_index=03010_E_Ongeldige index for geexporteerde functie +% DLL function index must be in the range \var{1..\$FFFF} +parser_w_parser_reloc_no_debug=03011_W_Relocatable bibliotheek of applicatie $1 debug informatie niet ondersteund. +parser_w_parser_win32_debug_needs_WN=03012_W_Om win32 code te debuggen moet relocatie afgezet worden door de -WN optie +% Stabs info is wrong for relocatable DLL or EXES use -WN +% if you want to debug win32 executables. +parser_e_constructorname_must_be_init=03013_E_Constructornaam moet INIT zijn +% You are declaring an object constructor with a name which is not \var{init}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_destructorname_must_be_done=03014_E_Destructornaam moet DONE zijn +% You are declaring an object destructor with a name which is not \var{done}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_proc_inline_not_supported=03016_E_Procedure type INLINE wordt niet ondersteund +% You tried to compile a program with C++ style inlining, and forgot to +% specify the \var{-Si} option (\seeo{Si}). The compiler doesn't support C++ +% styled inlining by default. +parser_w_constructor_should_be_public=03018_W_Constructor mag niet private or protected zijn +% Constructors must be in the 'public' part of an object (class) declaration. +parser_w_destructor_should_be_public=03019_W_Destructor mag niet private or protected zijn +% Destructors must be in the 'public' part of an object (class) declaration. +parser_n_only_one_destructor=03020_N_Klasse heeft slechts 1 destructor +% You can declare only one destructor for a class. +parser_e_no_local_objects=03021_E_Lokale klassedefinities zijn niet toegestaan +% Classes must be defined globally. They cannot be defined inside a +% procedure or function +parser_f_no_anonym_objects=03022_F_Anonieme klassedefinities zijn niet toegestaan +% An invalid object (class) declaration was encountered, i.e. an +% object or class without methods that isn't derived from another object or +% class. For example: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% will trigger this error. +parser_n_object_has_no_vmt=03023_N_Het object "$1" heeft geen VMT +% This is a note indicating that the declared object has no +% virtual method table. +parser_e_illegal_parameter_list=03024_E_Foutieve parameterlijst +% You are calling a function with parameters that are of a different type than +% the declared parameters of the function. +parser_e_wrong_parameter_size=03026_E_Onjuist aantal parameters meegegeven +% There is an error in the parameter list of the function or procedure, +% the number of parameters is not correct. +parser_e_overloaded_no_procedure=03027_E_Overladen symbool "$1" is geen procedure of functie +% The compiler encountered a symbol with the same name as an overloaded +% function, but it is not a function it can overload. +parser_e_overloaded_have_same_parameters=03028_E_Overroepen procedures hebben identieke parameterlijst +% You're declaring overloaded functions, but with the same parameter list. +% Overloaded function must have at least 1 different parameter in their +% declaration. +parser_e_header_dont_match_forward=03029_E_Declaratie komt niet overeen met eerdere declaratie: $1 +% You declared a function with same parameters but +% different result type or function modifiers. +parser_e_header_different_var_names=03030_E_Procedurehoofding $1 komt niet overeen met eerdere declaratie: variabelenaam veranderd $2 => $3 +% You declared the function in the \var{interface} part, or with the +% \var{forward} directive, but define it with a different parameter list. +parser_n_duplicate_enum=03031_N_Waarden in opsommingstypes moeten steeds stijgen +% \fpc allows enumeration constructions as in C. Given the following +% declaration two declarations: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% The second declaration would produce an error. \var{A\_UAS} needs to have a +% value higher than \var{A\_E}, i.e. at least 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_With kan niet gebruikt worden voor variabelen in verschillende segmenten +% With stores a variable locally on the stack, +% but this is not possible if the variable belongs to another segment. +parser_e_too_much_lexlevel=03034_E_Procedure meer dan 31 keer genest +% You can nest function definitions only 31 times. +parser_e_range_check_error=03035_E_Bereikfout bij evalueren constanten +% The constants are out of their allowed range. +parser_w_range_check_error=03036_W_Bereikscontrolefout bij evalueren constantes. +% The constants are out of their allowed range. +parser_e_double_caselabel=03037_E_Dubbel case-element +% You are specifying the same label 2 times in a \var{case} statement. +parser_e_case_lower_less_than_upper_bound=03038_E_Bovengrens van casebereik is lager dan ondergrens +% The upper bound of a \var{case} label is less than the lower bound and this +% is useless +parser_e_type_const_not_possible=03039_E_Getypeerde constanten van klassen zijn niet toegestaan +% You cannot declare a constant of type class or object. +parser_e_no_overloaded_procvars=03040_E_Procedurele variabelen van overroepen procedures zijn niet toegestaan +% You are trying to assign an overloaded function to a procedural variable. +% This is not allowed +parser_e_invalid_string_size=03041_E_Stringlengte moet tussen 1 en 255 liggen +% The length of a shortstring in Pascal is limited to 255 characters. You are +% trying to declare a string with length lower than 1 or greater than 255 +parser_w_use_extended_syntax_for_objects=03042_W_Gebruik de uitgebreide syntax van DISPOSE en NEW om nieuwe instanties van klassen te genereren +% If you have a pointer \var{a} to a class type, then the statement +% \var{new(a)} will not initialize the class (i.e. the constructor isn't +% called), although space will be allocated. you should issue the +% \var{new(a,init)} statement. This will allocate space, and call the +% constructor of the object +parser_w_no_new_dispose_on_void_pointers=03043_W_Het gebruik van NEW of DISPOSE voor pointers zonder type is zinloos +parser_e_no_new_dispose_on_void_pointers=03044_E_Het gebruik van NEW of DISPOSE is niet mogelijk voor pointers zonder type +% You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer +% because no size is associated to an untyped pointer. +% Accepted for compatibility in \var{tp} and \var{delphi} modes. +parser_e_class_id_expected=03045_E_Klasse verwacht +% This happens when the compiler scans a procedure declaration that contains +% a dot, +% i.e., a object or class method, but the type in front of the dot is not +% a known type. +parser_e_no_type_not_allowed_here=03046_E_Typesymbool is hier niet toegestaan +% You cannot use a type inside an expression. +parser_e_methode_id_expected=03047_E_Methode verwacht +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_e_header_dont_match_any_member=03048_E_Proceduredeclaratie komt niet overeen met een methode van deze klasse $1 +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_d_procedure_start=03049_DL_procedure/functie $1 +% When using the \var{-vd} switch, the compiler tells you when it starts +% processing a procedure or function implementation. +parser_e_error_in_real=03050_E_Foutieve vlottende-komma constante +% The compiler expects a floating point expression, and gets something else. +parser_e_fail_only_in_constructor=03051_E_FAIL mag alleen in constructors gebruikt worden +% You are using the \var{fail} keyword outside a constructor method. +parser_e_no_paras_for_destructor=03052_E_Destructors hebben geen parameters +% You are declaring a destructor with a parameter list. Destructor methods +% cannot have parameters. +parser_e_only_class_methods_via_class_ref=03053_E_Alleen klassemethoden kunnen gerefereerd worden via een klasse +% This error occurs in a situation like the following: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} is not a class method and hence cannot be called with a class +% reference. +parser_e_only_class_methods=03054_E_Alleen klassemethoden zijn toegankelijk in klassen +% This is related to the previous error. You cannot call a method of an object +% from a inside a class method. The following code would produce this error: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% Because free is a normal method of a class it cannot be called from a class +% method. +parser_e_case_mismatch=03055_E_Type van constante komt niet overeen met dat van de case uitrukking +% One of the labels is not of the same type as the case variable. +parser_e_illegal_symbol_exported=03056_E_Het symbool kan niet uitgevoerd worden uit een bibliotheek +% You can only export procedures and functions when you write a library. You +% cannot export variables or constants. +parser_w_should_use_override=03057_W_Een virtuele methode moet met OVERRIDE overroepen worden: $1 +% A method that is declared \var{virtual} in a parent class, should be +% overridden in the descendent class with the \var{override} directive. If you +% don't specify the \var{override} directive, you will hide the parent method; +% you will not override it. +parser_e_nothing_to_be_overridden=03058_E_Er is geen geerfde methode die overroepen kan worden: $1 +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_no_procedure_to_access_property=03059_E_Er is geen lid om de eigenschap te bereiken +% You specified no \var{read} directive for a property. +parser_w_stored_not_implemented=03060_W_Stored prorperty directive is not yet implemented +% The \var{stored} directive is not yet implemented +parser_e_ill_property_access_sym=03061_E_Ongeldig symbool voor eigenschaptoegang +% There is an error in the \var{read} or \var{write} directives for an array +% property. When you declare an array property, you can only access it with +% procedures and functions. The following code would cause such an error. +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_Kan niet in beschermd veld van een object schrijven +% Fields that are declared in a \var{protected} section of an object or class +% declaration cannot be accessed outside the module where the object is +% defined, or outside descendent object methods. +parser_e_cant_access_private_member=03063_E_Kan niet in prive-veld van een object schrijven +% Fields that are declared in a \var{private} section of an object or class +% declaration cannot be accessed outside the module where the class is +% defined. +parser_e_overridden_methods_not_same_ret=03066_E_Overridden methodes moeten dezelfde resultaat type hebben: "$2" wordt overridden door "$1" met een ander type +% If you declare overridden methods in a class definition, they must +% have the same return type. +parser_e_dont_nest_export=03067_E_Als EXPORT gedeclareerde procedures kunnen niet genest worden +% You cannot declare a function or procedure within a function or procedure +% that was declared as an export procedure. +parser_e_methods_dont_be_export=03068_E_Methoden kunnen niet geexporteerd worden. +% You cannot declare a procedure that is a method for an object as +% \var{export}ed. +parser_e_call_by_ref_without_typeconv=03069_E_Typen van referentieparameters moeten exact overeenkomen. "$1" gekregen, "$2" verwacht. +% When calling a function declared with \var{var} parameters, the variables in +% the function call must be of exactly the same type. There is no automatic +% type conversion. +parser_e_no_super_class=03070_E_Deze klasse is geen ouderklasse van de huidige klasse +% When calling inherited methods, you are trying to call a method of a non-related +% class. You can only call an inherited method of a parent class. +parser_e_self_not_in_method=03071_E_SELF is alleen toegelaten in methoden. +% You are trying to use the \var{self} parameter outside an object's method. +% Only methods get passed the \var{self} parameters. +parser_e_generic_methods_only_in_methods=03072_E_Methoden kunnen alleen in andere methoden worden aangeroepen met type symbool +% A construction like \var{sometype.somemethod} is only allowed in a method. +parser_e_illegal_colon_qualifier=03073_E_Ongeldig gebruik van ':' +% You are using the format \var{:} (colon) 2 times on an expression that +% is not a real expression. +parser_e_illegal_set_expr=03074_E_Bereikfout in setconstructor of dubbel setelement +% The declaration of a set contains an error. Either one of the elements is +% outside the range of the set type, either two of the elements are in fact +% the same. +parser_e_pointer_to_class_expected=03075_E_Pointer naar klasse verwacht +% You specified an illegal type in a \var{new} statement. +% The extended syntax of \var{new} needs an object as a parameter. +parser_e_expr_have_to_be_constructor_call=03076_E_Uitdrukking moet een constructoraanroep zijn. +% When using the extended syntax of \var{new}, you must specify the constructor +% method of the object you are trying to create. The procedure you specified +% is not a constructor. +parser_e_expr_have_to_be_destructor_call=03077_E_Uitdrukking moet een destructoraanroep zijn +% When using the extended syntax of \var{dispose}, you must specify the +% destructor method of the object you are trying to dispose of. +% The procedure you specified is not a destructor. +parser_e_invalid_record_const=03078_E_Ongeldige volgorde van record leden +% When declaring a constant record, you specified the fields in the wrong +% order. +parser_e_false_with_expr=03079_E_Type van uitdrukking moet class of record type zijn +% A \var{with} statement needs an argument that is of the type \var{record} +% or \var{class}. You are using \var{with} on an expression that is not of +% this type. +parser_e_void_function=03080_E_Procedures kunnen geen resultaat teruggeven +% In \fpc, you can specify a return value for a function when using +% the \var{exit} statement. This error occurs when you try to do this with a +% procedure. Procedures cannot return a value. +parser_e_only_methods_allowed=03081_E_Constructors, destructors en class operators moeten methoden zijn +% You're declaring a procedure as destructor, constructor or class operator, when the +% procedure isn't a class method. +parser_e_operator_not_overloaded=03082_E_Operator is niet hergedefineerd +% You're trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_no_such_assignment=03083_E_Het is niet toegestaan de toewijzingsoperator te overroepen voor gelijke typen +% You can not overload assignment for types +% that the compiler considers as equal. +parser_e_overload_impossible=03084_E_Het overroepen van deze operator is onmogelijk +% The combination of operator, arguments and return type are +% incompatible. +parser_e_no_reraise_possible=03085_E_Re-raise is hier niet mogelijk +% You are trying to raise an exception where it is not allowed. You can only +% raise exceptions in an \var{except} block. +parser_e_no_new_or_dispose_for_classes=03086_E_De uitgebreide syntax van NEW of DISPOSE is niet toegestaan voor klassen +% You cannot generate an instance of a class with the extended syntax of +% \var{new}. The constructor must be used for that. For the same reason, you +% cannot call \var{dispose} to de-allocate an instance of a class, the +% destructor must be used for that. +parser_e_procedure_overloading_is_off=03088_E_Procedure overroepen is afgezet +% When using the \var{-So} switch, procedure overloading is switched off. +% Turbo Pascal does not support function overloading. +parser_e_overload_operator_failed=03089_E_Deze operator kan niet overroepen worden. +% You are trying to overload an operator which cannot be overloaded. +% The following operators can be overloaded : +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_Vergelijkingsoperator moet een boolean type als resultaat hebben. +% When overloading the \var{=} operator, the function must return a boolean +% value. +parser_e_only_virtual_methods_abstract=03091_E_Enkel virtuele methoden kunnen abstract zijn +% You are declaring a method as abstract, when it is not declared to be +% virtual. +parser_f_unsupported_feature=03092_F_Gebruik van niet ondersteunde functionaliteit! +% You're trying to force the compiler into doing something it cannot do yet. +parser_e_mix_of_classes_and_objects=03093_E_CLASSES and OBJECTS kunnen niet gemengd worden. +% You cannot derive \var{objects}, \var{classes}, \var{cppclasses} and \var{interfaces} interttwined . E.g. +% a class cannot have an object as parent and vice versa. +parser_w_unknown_proc_directive_ignored=03094_W_Onbekende proceduredirective is genegeerd: $1 +% The procedure directive you specified is unknown. +parser_e_absolute_only_one_var=03095_E_Absolute kan maar aan een variabele verbonden worden. +% You cannot specify more than one variable before the \var{absolute} directive. +% Thus, the following construct will provide this error: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +% \item [ absolute can only be associated a var or const ] +% The address of a \var{absolute} directive can only point to a variable or a +% typed constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_absolute_only_to_var_or_const=03096_E_Absolute kan slechts aan variabelen of constanten verbonden worden. +% The address of a \var{absolute} directive can only point to a variable or +% constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_initialized_only_one_var=03097_E_Slechts 1 variabele kan geinitialiseerd worden. +% You cannot specify more than one variable with a initial value +% in Delphi mode. +parser_e_abstract_no_definition=03098_E_Abtracte methoden kunnen niet gedefineerd worden +% Abstract methods can only be declared, you cannot implement them. They +% should be overridden by a descendant class. +parser_e_overloaded_must_be_all_global=03099_E_Deze overroepen procedure kan niet lokaal zijn (moet geexporteerd worden) +% You are defining a overloaded function in the implementation part of a unit, +% but there is no corresponding declaration in the interface part of the unit. +parser_w_virtual_without_constructor=03100_W_Gebruik van virtuele methoden zonder constructor in "$1" +% If you declare objects or classes that contain virtual methods, you need +% to have a constructor and destructor to initialize them. The compiler +% encountered an object or class with virtual methods that doesn't have +% a constructor/destructor pair. +parser_c_macro_defined=03101_CL_Macro gedefinieerd: $1 +% When \var{-vc} is used, the compiler tells you when it defines macros. +parser_c_macro_undefined=03102_CL_Macro definitie verwijderd: $1 +% When \var{-vc} is used, the compiler tells you when it undefines macros. +parser_c_macro_set_to=03103_CL_Macro $1 heeft waarde $2 gekregen +% When \var{-vc} is used, the compiler tells you what values macros get. +parser_i_compiling=03104_I_Compilatie van $1 +% When you turn on information messages (\var{-vi}), the compiler tells you +% what units it is recompiling. +parser_u_parsing_interface=03105_UL_Parsen van de interface van unit $1 +% This tells you that the reading of the interface +% of the current unit starts +parser_u_parsing_implementation=03106_UL_Parsen van de implementatie van unit $1 +% This tells you that the code reading of the implementation +% of the current unit, library or program starts +parser_d_compiling_second_time=03107_DL_Compilatie van $1 voor de tweede keer. +% When you request debug messages (\var{-vd}) the compiler tells you what +% units it recompiles for the second time. +parser_e_no_property_found_to_override=03109_E_Geen eigenschap gevonden om te herdefinieren +% You want to override a property of a parent class, when there is, in fact, +% no such property in the parent class. +parser_e_only_one_default_property=03110_E_Slechts 1 standaardeigenschap is toegestaan, geerfde standaardeigenschap in kind gevonden. +% You specified a property as \var{Default}, but the class already has a +% default property, and a class can have only one default property. +parser_e_property_need_paras=03111_E_Standaardeigenschappen moeten van type array zijn. +% Only array properties of classes can be made \var{default} properties. +parser_e_constructor_cannot_be_not_virtual=03112_E_Virtuele constructors worden alleen ondersteunt in het klassemodel +% You cannot have virtual constructors in objects. You can only have them +% in classes. +parser_e_no_default_property_available=03113_E_Geen standaardeigenschap gevonden +% You are trying to access a default property of a class, but this class (or one of +% its ancestors) doesn't have a default property. +parser_e_cant_have_published=03114_E_De klasse kan geen gepubliceerde sectie hebben, gebruik {$M+} +% If you want a \var{published} section in a class definition, you must +% use the \var{\{\$M+\}} switch, whch turns on generation of type +% information. +parser_e_forward_declaration_must_be_resolved=03115_E_Declaratie van klasse $1 moet worden opgelost om de klasse als ouder te gebruiken +% To be able to use an object as an ancestor object, it must be defined +% first. This error occurs in the following situation: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% Where \var{ParentClass} is declared but not defined. +parser_e_no_local_operator=03116_E_Lokale operatoren worden niet ondersteund +% You cannot overload locally, i.e. inside procedures or function +% definitions. +parser_e_proc_dir_not_allowed_in_interface=03117_E_Procedure directive $1 niet toegestaan in interfacesectie +% This procedure directive is not allowed in the \var{interface} section of +% a unit. You can only use it in the \var{implementation} section. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_Procedure directive $1 niet toegestaan in implementatiesectie +% This procedure directive is not defined in the \var{implementation} section of +% a unit. You can only use it in the \var{interface} section. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_Procedure directive $1 niet toegestaan in procvar declaratie +% This procedure directive cannot be part of a procedural or function +% type declaration. +parser_e_function_already_declared_public_forward=03120_E_Functie is al publiek/forward gedeclareerd $1 +% You will get this error if a function is defined as \var{forward} twice. +% Or it is once in the \var{interface} section, and once as a \var{forward} +% declaration in the \var{implmentation} section. +parser_e_not_external_and_export=03121_E_Kan niet zowel EXPORT als EXTERNAL gebruiken +% These two procedure directives are mutually exclusive +parser_w_not_supported_for_inline=03123_W_$1 wordt niet ondersteund voor inline procedure/functie +% Inline procedures don't support this declaration. +parser_w_inlining_disabled=03124_W_Inlining uitgeschakeld +% Inlining of procedures is disabled. +parser_i_writing_browser_log=03125_I_Schrijven van browser logfile $1 +% When information messages are on, the compiler warns you when it +% writes the browser log (generated with the \var{\{\$Y+ \}} switch). +parser_h_maybe_deref_caret_missing=03126_H_misschien is het een pointer, ^ ontbreekt dan +% The compiler thinks that a pointer may need a dereference. +parser_f_assembler_reader_not_supported=03127_F_Geselecteerde assemblerlezer wordt niet ondersteund +% The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not +% supported. The compiler can be compiled with or without support for a +% particular assembler reader. +parser_e_proc_dir_conflict=03128_E_Procedure directive $1 geeft conflicten met andere directives +% You specified a procedure directive that conflicts with other directives. +% for instance \var{cdecl} and \var{pascal} are mutually exclusive. +parser_e_call_convention_dont_match_forward=03129_E_Aanroep conventie klopt niet met voorwaartse +% This error happens when you declare a function or procedure with +% e.g. \var{cdecl;} but omit this directive in the implementation, or vice +% versa. The calling convention is part of the function declaration, and +% must be repeated in the function definition. +parser_e_property_cant_have_a_default_value=03131_E_Eigenschap kan geen standaard waarde hebben +% Set properties or indexed properties cannot have a default value. +parser_e_property_default_value_must_const=03132_E_De standaard waarde van een eigenschap moet een constante zijn +% The value of a \var{default} declared property must be known at compile +% time. The value you specified is only known at run time. This happens +% .e.g. if you specify a variable name as a default value. +parser_e_cant_publish_that=03133_E_Symbool kan niet worden gepubliceerd, alleen mogelijk voor een klasse +% Only class type variables can be in a \var{published} section of a class +% if they are not declared as a property. +parser_e_cant_publish_that_property=03134_E_Dit soort eigenschappen kunnen niet worden gepubliceerd +% Properties in a \var{published} section cannot be array properties. +% they must be moved to public sections. Properties in a \var{published} +% section must be an ordinal type, a real type, strings or sets. +parser_e_empty_import_name=03136_E_Lege importnaam opgegeven +% Some targets need a name for the imported procedure or a \var{cdecl} specifier +parser_e_division_by_zero=03138_E_Deling door nul +% There is a division by zero encounted +parser_e_invalid_float_operation=03139_E_Ongeldige vlottende-komma bewerking. +% An operation on two real type values produced an overflow or a division +% by zero. +parser_e_array_lower_less_than_upper_bound=03140_E_Bovengrens van bereik is lager dan ondergrens +% The upper bound of a an array declaration is less than the lower bound and this +% is not possible +parser_w_string_too_long=03141_W_string "$1" is langer dan $2 +% The size of the constant string is larger than the size you specified in +% string type definition +parser_e_string_larger_array=03142_E_Stringlengte moet tussen 1 en 255 liggen +% The size of the constant string is larger than the size you specified in +% the array[x..y] of char definition +parser_e_ill_msg_expr=03143_E_Ongeldige uitdrukking achter message optie +% \fpc supports only integer or string values as message constants +parser_e_ill_msg_param=03144_E_Message handlers aanvaarden slechts 1 variabele parameter +% A method declared with the \var{message}-directive as message handler +% can take only one parameter which must be declared as call by reference +% Parameters are declared as call by reference using the \var{var}-directive +parser_e_duplicate_message_label=03145_E_Dubbel message label: $1 +% A label for a message is used twice in one object/class +parser_e_self_in_non_message_handler=03146_E_Self kan alleen een explicite parameter zijn bij string message handlers +% The self parameter can only be passed explicitly to a method which +% is declared as message handler. +parser_e_threadvars_only_sg=03147_E_Threadvariabelen kunnen alleen globaal of statisch zijn +% Threadvars must be static or global, you can't declare a thread +% local to a procedure. Local variables are always local to a thread, +% because every thread has its own stack and local variables +% are stored on the stack +parser_f_direct_assembler_not_allowed=03148_F_Directe assemblercode wordt niet ondersteund door de interne assembler. +% You can't use direct assembler when using a binary writer, choose an +% other outputformat or use another assembler reader +parser_w_no_objpas_use_mode=03149_W_Laad de OBJPAS unit niet manueel, gebruik {$mode objfpc} of {$mode delphi}. +% You are trying to load the ObjPas unit manually from a uses clause. This is +% not a good idea. Use the \var{\{\$mode objfpc\}} or +% \var{\{\$mode delphi\}} +% directives which load the unit automatically +parser_e_no_object_override=03150_E_OVERRIDE kan niet gebruikt worden in objecten +% Override is not supported for objects, use \var{virtual} instead to override +% a method of a parent object +parser_e_cant_use_inittable_here=03151_E_Datatypen die initialisatie/finalisatie vereisen zijn niet toegestaan in variabele records. +% Some data type (e.g. \var{ansistring}) needs initialization/finalization +% code which is implicitly generated by the compiler. Such data types +% can't be used in the variant part of a record. +parser_e_resourcestring_only_sg=03152_E_Resourcestrings kunnen alleen statisch of globaal zijn. +% Resourcestring can not be declared local, only global or using the static +% directive. +parser_e_exit_with_argument_not__possible=03153_E_Exit met parameter is hier niet toegestaan +% an exit statement with an argument for the return value can't be used here, this +% can happen e.g. in \var{try..except} or \var{try..finally} blocks +parser_e_stored_property_must_be_boolean=03154_E_De stored directive verwacht een boolean argument. +% If you specify a storage symbol in a property declaration, it must be of +% the type boolean +parser_e_ill_property_storage_sym=03155_E_Dit symbool is niet toegestaan achter het stored sleutelwoord. +% You can't use this type of symbol as storage specifier in property +% declaration. You can use only methods with the result type boolean, +% boolean class fields or boolean constants +parser_e_only_publishable_classes_can__be_published=03156_E_Alleen klassen gecompileerd in $M+ modus kunnen een published sectie hebben. +% In the published section of a class can be only class as fields used which +% are compiled in \var{\{\$M+\}} or which are derived from such a class. Normally +% such a class should be derived from TPersitent +parser_e_proc_directive_expected=03157_E_Proceduredirective verwacht. +% This error is triggered when you have a \var{\{\$Calling\}} directive without +% a calling convention specified. +% It also happens when declaring a procedure in a const block and you +% used a ; after a procedure declaration which must be followed by a +% procedure directive. +% Correct declarations are: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_De waarde voor een eigenschapindex moet een ordinale waarde zijn. +% The value you use to index a property must be of an ordinal type, for +% example an integer or enumerated type. +parser_e_procname_to_short_for_export=03159_E_Procedurenaam te kort om te exporteren. +% The length of the procedure/function name must be at least 2 characters +% long. This is because of a bug in dlltool which doesn't parse the .def +% file correct with a name of length 1. +parser_e_dlltool_unit_var_problem=03160_E_Kan geen DEFFILE item genereren voor globale variabelen. +parser_e_dlltool_unit_var_problem2=03161_E_Compileer zonder -WD optie +% You need to compile this file without the -WD switch on the +% commandline +parser_f_need_objfpc_or_delphi_mode=03162_F_U moet OBJFPC (-S2) of DELPHI (-Sd) mode gebruiken om deze code te compileren +% You need to use \{\$mode objfpc\} or \{\$mode delphi\} to compile this file. +% Or use the equivalent commandline switches -S2 or -Sd. +parser_e_no_export_with_index_for_target=03163_E_Kan niet exporteren met indexen kleiner dan $1 +% Exporting of functions or procedures with a specified index is not +% supported on this target. +parser_e_no_export_of_variables_for_target=03164_E_Exporteren van variabelen is niet ondersteund op $1 +% Exporting of variables is not supported on this target. +parser_e_improper_guid_syntax=03165_E_Ongeldige GUID aanduiding +parser_w_interface_mapping_notfound=03168_W_PGeen procedure genaamd "$1" om "$2.$3" te implementeren gevonden +parser_e_interface_id_expected=03169_E_Interface aanduiding verwacht +% This happens when the compiler scans a \var{class} declaration that contains +% \var{interface} function name mapping code like this: +% \begin{verbatim} +% type +% TMyObject = class(TObject, IDispatch) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% and the \var{interface} before the dot not listed in the inheritance list. +parser_e_type_cant_be_used_in_array_index=03170_E_Type "$1" kan niet als array index type gebruikt worden +% Types like \var{qword} or \var{int64} aren't allowed as array index type +parser_e_no_con_des_in_interfaces=03171_E_Constructors and destructors zijn niet toegestaan in interfaces +% Constructor and destructor declarations aren't allowed in interface +% In the most cases the method \var{QueryInterface} of \var{IUnknown} can +% be used to create a new interface. +parser_e_no_access_specifier_in_interfaces=03172_E_Toegangsmethoden kunnen niet gebruikt worden in interfaces +% The access specifiers \var{public}, \var{private}, \var{protected} and +% \var{pusblished} can't be used in interfaces because all methods +% of an interfaces must be public. +parser_e_no_vars_in_interfaces=03173_E_Een interface definitie kan geen velden bevatten +% Declarations of fields aren't allowed in interfaces. An interface +% can contain only methods +parser_e_no_local_proc_external=03174_E_Can lokale procedure niet als EXTERNAL definieren +% Declaring local procedures as external is not possible. Local procedures +% get hidden parameters that will make the chance of errors very high +parser_w_skipped_fields_before=03175_W_Sommige velden voor "$1" zijn niet geinitialiseerd +% In Delphi mode, not all fields of a typed constant record have to be +% initialized, but the compiler warns you when it detects such situations. +parser_e_skipped_fields_before=03176_E_Sommige velden voor "$1" zijn niet geinitialiseerd +% In all syntax modes but Delphi mode, you can't leave some fields uninitialized +% in the middle of a typed constant record +parser_w_skipped_fields_after=03177_W_Sommige velden na "$1" zijn niet geinitialiseerd +% You can leave some fields at the end of a type constant record uninitialized +% (the compiler will initialize them to zero automatically). This may be the cause +% of subtle problems. +parser_e_varargs_need_cdecl_and_external=03178_E_VARARGS aanduiding zonder CDECL of EXTERNAL +% The varargs directive can only be used with procedures or functions +% that are declared with \var{cdecl} and \var{external} directives. The varargs directive +% is only meant to provide a compatible interface to C functions like printf. +parser_e_self_call_by_value=03179_E_SELF moet een normale waarde parameter zijn +% You can't declare self as a const or var parameter, it must always be +% a call-by-value parameter +parser_e_interface_has_no_guid=03180_E_Interface "$1" heeft geen interface definitie +% When you want to assign an interface to a constant, then the interface +% must have a GUID value set. +parser_e_illegal_field_or_method=03181_E_Ongekend klasse-veld of methode aanduiding "$1" +% Properties must refer to a field or method in the same class. +parser_w_proc_overriding_calling=03182_W_Aanroep-modus "$1" vervangen door "$2" +% There are two directives in the procedure declaration that specify a calling +% convention. Only the last directive will be used +parser_e_no_procvarobj_const=03183_E_Getypeerde constanten van type "procedure of object" kunnen alleen met NIL geinitialiseerd worden +% You can't assign the address of a method to a typed constant which has a +% 'procedure of object' type, because such a constant requires two addresses: +% that of the method (which is known at compile time) and that of the object or +% class instance it operates on (which can not be known at compile time). +parser_e_default_value_only_one_para=03184_E_De default aanduiding kan maar bij 1 parameter horen. +parser_e_default_value_expected_for_para=03185_E_Default parameter vereist voor "$1" +parser_w_unsupported_feature=03186_W_Gebruik van niet-ondersteunde mogelijkheden +% You're trying to force the compiler into doing something it cannot do yet. +parser_h_c_arrays_are_references=03187_H_C arrays worden via referentie doorgegeven +% Any array passed to a C functions is passed +% by a pointer (i.e. by reference). +parser_e_C_array_of_const_must_be_last=03188_E_"C array of const" moet het laatste argument zijn +% You can not add any other argument after an \var{array of const} for +% \var{cdecl} functions, as the size pushed on stack for this argument is +% not known. +parser_h_type_redef=03189_H_Type "$1" herdefinitie +% This is an indicator that a previously declared type is +% being redefined as something else. This may, or may not +% be, a cause for errors. +parser_w_cdecl_has_no_high=03190_W_CDECL functies hebben geen HIGH parameter +% Functions declared with cdecl modifier do not pass an extra implicit parameter. +parser_w_cdecl_no_openstring=03191_W_CDECL functies ondersteunen geen open strings +% Openstring is not supported for cdecl'ared functions. +parser_e_initialized_not_for_threadvar=03192_E_Kan THREADVAR variabelen niet initialiseren +% Variables declared as threadvar can not be initialized with a default value. +% The variables will always be filled with zero at the start of a new thread. +parser_e_msg_only_for_classes=03193_E_de MESSAGE aanduiding is alleen toegestaan in classes +% The message directive is only supported for Class types. +parser_e_procedure_or_function_expected=03194_E_Procedure of functie verwacht +% A class method can only be specified for procedures and functions. +parser_e_illegal_calling_convention=03195_W_Aanroep-specificatie genegeerd: "$1" +% Some calling conventions are supported only by certain CPUs. I.e. most non-i386 ports support +% only the standard ABI calling convention of the CPU. +parser_e_no_object_reintroduce=03196_E_REINTRODUCE kan niet in objecten worden gebruikt +% \var{reintroduce} is not supported for objects. +parser_e_paraloc_only_one_para=03197_E_Elk argument moet zijn eigen locatie hebben +% If locations for arguments are specified explicitly as it is required by +% some syscall conventions, each argument must have it's only location, things +% like \var{procedure p(i,j : longint 'r1');} aren't allowed +parser_e_paraloc_all_paras=03198_E_Elk argument moet een expliciete locatie hebben +% If one argument has an explicit argument location, all arguments of a procedure +% must have one. +parser_e_illegal_explicit_paraloc=03199_E_Ongekende argument locatie +% The location specified for an argument isn't recognized by the compiler +parser_e_32bitint_or_pointer_variable_expected=03200_E_32-bit integer of pointer variabele verwacht +% The libbase for MorphOS/AmigaOS can be give only as \var{longint}, \var{dword} or any pointer variable. +parser_e_goto_outside_proc=03201_E_GOTO opdrachten zijn niet toegestaan tussen verschillende procedures +% It isn't allowed to use the \var{goto} statements referencing labels outside the +% current procedure. The following example shows the problem: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1; +% +% procedure p2; +% begin +% goto l1; // This goto ISN'T allowed +% end; +% +% begin +% p2 +% l1: +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_Procedure te moeilijk, te veel registers vereist +% Your procedure body is too long for the compiler. You should split the +% procedure into multiple smaller procedures. +parser_e_illegal_expression=03203_E_Ongeldige uitdrukking +% This can occur under many circumstances. Mostly when trying to evaluate +% constant expressions. +parser_e_invalid_integer=03204_E_Ongeldige integer uitdrukking +% You made an expression which isn't an integer, and the compiler expects the +% result to be an integer. +parser_e_invalid_qualifier=03205_E_Ongeldige aanduiding +% One of the following is happening : +% \begin{itemize} +% \item You're trying to access a field of a variable that is not a record. +% \item You're indexing a variable that is not an array. +% \item You're dereferencing a variable that is not a pointer. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_Bovengrens kleiner dan ondergrens +% You are declaring a subrange, and the lower limit is higher than the high +% limit of the range. +parser_e_macpas_exit_wrong_param=03207_E_Exit parameter moet de naam zijn van de procedure waarin het gebruikt wordt +% Non local exit is not allowed. This error occurs only in mode MacPas. +parser_e_illegal_assignment_to_count_var=03208_E_Ongeldige toekenning aan lus-variabele "$1" +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. You can also not assign values to +% loop variables inside the loop (except in Delphi and TP modes). Use a while or +% repeat loop instead if you need to do something like that, since those +% constructs were built for that. +parser_e_no_local_var_external=03209_E_Kan een locale variabele niet als EXTERNAL aanduiden +% Declaring local variables as external is not allowed. Only global variables can reference +% to external variables. +parser_e_proc_already_external=03210_E_De procedure is reeds als EXTERNAL aangeduid +% The procedure is already declared with the EXTERNAL directive in an interface or +% forward declaration. +parser_w_implicit_uses_of_variants_unit=03211_W_Impliciet gebruik van de VARIANTS unit +% The Variant type is used in the unit without any used unit using the Variants unit. The +% compiler has implicitly added the Variants unit to the uses list. To remove this warning +% the Variants unit needs to be added to the uses statement. +parser_e_no_static_method_in_interfaces=03212_E_Class en statische methoden kunnen niet gebruikt worden in interfaces +% The specifier \var{class} and directive \var{static} can't be used in interfaces +% because all methods of an interfaces must be public. +parser_e_arithmetic_operation_overflow=03213_E_Overflow in wiskundige berekening +% An operation on two integers values produced an overflow +parser_e_protected_or_private_expected=03214_E_Protected of Private verwacht +% \var{strict} can be only used together with \var{protected} or \var{private}. +parser_e_illegal_slice=03215_E_SLICE kan niet buiten de parameter lijst gebruikt worden +% \var{slice} can be used only for arguments accepting an open array parameter +parser_e_dispinterface_cant_have_parent=03216_E_Een DISPINTERFACE kan geen ouderklasse hebben. +% A DISPINMTERFACE is a special type of interface which can't have a parent class +parser_e_dispinterface_needs_a_guid=03217_E_Een DISPINTERFACE moet een GUID hebben +% A DISPINMTERFACE always needs an interface identification +parser_w_overridden_methods_not_same_ret=03218_W_Methodes die worden override-n moeten een soortgelijke return type hebben. Deze code kan crahsen omdat het afhankelijk is van een Delphi parser bug. ("$2" wordt override-n door "$1", deze heeft een andere return type) +% If you declare overridden methods in a class definition, they must +% have the same return type. Some versions of Delphi allow you to change the +% return type of interface methods, and even to change procedures into +% functions, but the resulting code may crash depending on the types used +% and the way the methods are called. +parser_e_dispid_must_be_ord_const=03219_E_Bericht ID-s moeten ordinale constanten zijn. +# +# Type Checking +# +# 04049 is the last used one +# +% \end{description} +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +type_e_mismatch=04000_E_Typen stemmen niet overeen +% This can happen in many cases: +% \begin{itemize} +% \item The variable you're assigning to is of a different type than the +% expression in the assignment. +% \item You are calling a function or procedure with parameters that are +% incompatible with the parameters in the function or procedure definition. +% \end{itemize} +type_e_incompatible_types=04001_E_Incompatibele typen: kreeg $1, verwachtte $2 +% There is no conversion possible between the two types +% Another possiblity is that they are declared in different +% declarations: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { This statement gives also this error, it +% is due the strict type checking of pascal } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_Typen komen niet overeen $1 en $2 +% The types are not equal +type_e_type_id_expected=04003_E_Typesymbool verwacht +% The identifier is not a type, or you forgot to supply a type identifier. +type_e_variable_id_expected=04004_E_Variabelesymbool verwacht +% This happens when you pass a constant to a routine (such as \var{Inc} var or \var{Dec}) +% when it expects a variable. You can only pass variables as arguments to these functions. +type_e_integer_expr_expected=04005_E_Gehele uitdrukking verwacht, $1 gekregen +% The compiler expects an expression of type integer, but gets a different +% type. +type_e_boolean_expr_expected=04006_E_Boolean waarde verwacht, kreeg echter "$1" +% The expression must be a boolean type, it should be return true or +% false. +type_e_ordinal_expr_expected=04007_E_Ordinale expressie verwacht +% The expression must be of ordinal type, i.e., maximum a \var{Longint}. +% This happens, for instance, when you specify a second argument +% to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value. +type_e_pointer_type_expected=04008_E_Pointer type verwacht, "$1" gekregen +% The variable or expression isn't of the type \var{pointer}. This +% happens when you pass a variable that isn't a pointer to \var{New} +% or \var{Dispose}. +type_e_class_type_expected=04009_E_Klasse type verwacht, "$1" gekregen +% The variable of expression isn't of the type \var{class}. This happens +% typically when +% \begin{enumerate} +% \item The parent class in a class declaration isn't a class. +% \item An exception handler (\var{On}) contains a type identifier that +% isn't a class. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_Kan constante expressie niet evalueren +% This error can occur when the bounds of an array you declared does +% not evaluate to ordinal constants +type_e_set_element_are_not_comp=04012_E_Elementen van set zijn niet compatible +% You are trying to make an operation on two sets, when the set element types +% are not the same. The base type of a set must be the same when taking the +% union +type_e_set_operation_unknown=04013_E_Bewerking niet ondersteund voor sets +% several binary operations are not defined for sets +% like div mod ** (also >= <= for now) +type_w_convert_real_2_comp=04014_W_Typeconversie van vlottende-komma type naar COMP, wat een integer type is. +% An implicit type conversion from a real type to a \var{comp} is +% encountered. Since \var{comp} is a 64 bit integer type, this may indicate +% an error. +type_h_use_div_for_int=04015_H_Gebruik DIV voor gehele getallen om geheel resultaat te krijgen +% When hints are on, then an integer division with the '/' operator will +% procuce this message, because the result will then be of type real +type_e_strict_var_string_violation=04016_E_String typen stemmen niet overeen wegens de $V+ modus +% When compiling in \var{\{\$V+\}} mode, the string you pass as a parameter +% should be of the exact same type as the declared parameter of the procedure. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_SUCC of PRED op enumeratietypen met toekenningen zijn niet mogelijk +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use the \var{Succ} or \var{Pred} functions on them. +type_e_cant_read_write_type=04018_E_Kan dit type variabelen niet lezen of schrijven +% You are trying to \var{read} or \var{write} a variable from or to a +% file of type text, which doesn't support that. Only integer types, +% reals, pchars and strings can be read from/written to a text file. +% Booleans can only be written to text files. +type_e_no_readln_writeln_for_typed_file=04019_E_Kan geen readln of writeln op getypeerde bestanden doen. +% \var{readln} and \var{writeln} are only allowed for text files. +type_e_no_read_write_for_untyped_file=04020_E_Kan geen read of write doen op ongetypeerde bestanden. +% \var{read} and \var{write} are only allowed for text or typed files. +type_e_typeconflict_in_set=04021_E_Typeconflict tussen setelementen. +% There is at least one set element which is of the wrong type, i.e. not of +% the set type. +type_w_maybe_wrong_hi_lo=04022_W_lo/hi(longint/dword) geeft hoog/laag (ipv byte) woord terug. +% \fpc supports an overloaded version of \var{lo/hi} for \var{longint/dword/int64/qword} +% which returns the lower/upper word/dword of the argument. TP always uses +% a 16 bit \var{lo/hi} which returns always bits 0..7 for \var{lo} and the +% bits 8..15 for \var{hi}. If you want the TP behavior you have +% to type cast the argument to \var{word/integer} +type_e_integer_or_real_expr_expected=04023_E_Integer of vlottende-komma uitdrukking verwacht +% The first argument to \var{str} must a real or integer type. +type_e_wrong_type_in_array_constructor=04024_E_Verkeerd type "$1" in array constructor +% You are trying to use a type in an array constructor which is not +% allowed. +type_e_wrong_parameter_type=04025_E_Incompatibel type voor argument #$1: kreeg $2, verwachtte $3 +% You are trying to pass an invalid type for the specified parameter. +type_e_no_method_and_procedure_not_compatible=04026_E_Methode (variabele) en Procedure (variable) zijn niet compatible +% You can't assign a method to a procedure variable or a procedure to a +% method pointer. +type_e_wrong_math_argument=04027_E_Ongeldige constante opgegeven aan interne wiskundige functie +% The constant argument passed to a ln or sqrt function is out of +% the definition range of these functions. +type_e_no_addr_of_constant=04028_E_Een constante heeft geen adres +% It is not possible to get the address of a constant, because they +% aren't stored in memory, you can try making it a typed constant. +type_e_argument_cant_be_assigned=04029_E_Kan geen waarde toekennen aan argument +% Only expressions which can be on the left side of an +% assignment can be passed as call by reference argument +% Remark: Properties can be only +% used on the left side of an assignment, but they cannot be used as arguments +type_e_cannot_local_proc_to_procvar=04030_E_Kan geen lokale procedure toekennen aan procedure variabele +% It's not allowed to assign a local procedure/function to a +% procedure variable, because the calling of local procedure/function is +% different. You can only assign local procedure/function to a void pointer. +type_e_no_assign_to_addr=04031_E_Kan geen waarde toekennen aan een adres +% It is not allowed to assign a value to an address of a variable,constant, +% procedure or function. You can try compiling with -So if the identifier +% is a procedure variable. +type_e_no_assign_to_const=04032_E_Kan geen waarde toekennen aan constante +% It's not allowed to assign a value to a variable which is declared +% as a const. This is normally a parameter declared as const, to allow +% changing the value make the parameter as a value parameter or a var. +type_e_array_required=04033_E_ARRAY type verwacht +% If you are accessing a variable using an index '[<x>]' then +% the type must be an array. In FPC mode also a pointer is allowed. +type_e_interface_type_expected=04034_E_Interface type verwacht, maar kreeg "$1" +type_w_mixed_signed_unsigned=04035_W_Mengen van mogelijk negatieve uitdrukkingen en longwords geeft een 64-bits resultaat +% If you divide (or calculate the modulus of) a signed expression by a longword (or vice versa), +% or if you have overflow and/or range checking turned on and use an arithmetic +% expression (+, -, *, div, mod) in which both signed numbers and longwords appear, +% then everything has to be evaluated in 64bit which is slower than normal +% 32bit arithmetic. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_w_mixed_signed_unsigned2=04036_W_Mengen van mogelijk negatieve uitdrukkingen en cardinals kan tot range check fouten leiden +% If you use a binary operator (and, or, xor) and one of +% the operands is a longword while the other one is a signed expression, then, +% if range checking is turned on, you may get a range check error because in +% such a case both operands are converted to longword before the operation is +% carried out. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_e_typecast_wrong_size_for_assignment=04037_E_Typecast heeft een verschillende grootte ($1 -> $2) in toekenning +% Type casting to a type with a different size is not allowed when the variable is +% used for assigning. +type_e_array_index_enums_with_assign_not_possible=04038_E_enumeratie typen met vaste waarden kunnen niet als array index gebruikt worden +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use it as index of an array. +type_e_classes_not_related=04039_E_Klasse of object types "$1" en "$2" zijn niet verwant +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_w_classes_not_related=04040_W_Klasse types "$1" en "$2" zijn niet verwant +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_e_class_or_interface_type_expected=04041_E_Klasse of interface type verwacht, maar kreeg "$1" +type_e_type_is_not_completly_defined=04042_E_Type "$1" is niet volledig gedefinieerd +type_w_string_too_long=04043_W_String constante heeft meer karakters dan de lengte van een shortstring +% The size of the constant string, which is assigned to a shortstring, +% is longer than the maximum size of the shortstring +type_w_signed_unsigned_always_false=04044_W_De vergelijking is steeds onwaar omwille van de interval waarden +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% false. Exlicitly typecast the constant to the correct range to avoid this problem. +type_w_signed_unsigned_always_true=04045_W_e vergelijking is steeds waar omwille van de interval waarden +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% true. Exlicitly typecast the constant to the correct range to avoid this problem. +type_w_instance_with_abstract=04046_W_Constructie van een klasse "$1" met abstracte methoden +% An instance of a class is created which contains non-implemented abstract +% methods. This will probably lead to a runtime error 211 in the code if that +% routine is ever called. All abstract methods should be overridden. +type_h_in_range_check=04047_H_De linker operand van de IN operator moet de grootte van een byte hebben +% The left operand of the \var{in} operator is not an ordinal or enumeration which fits +% within 8-bits, this may lead to range check errors. The \var{in} operator +% currently only supports a left operand which fits within a byte. In the case of +% enumerations, the size of an element of an enumeration can be controlled with +% the \var{\{\$PACKENUM\}} or \var{\{\$Zn\}} switches. +type_w_smaller_possible_range_check=04048_W_Grootte-fout voor type, mogelijk verlies van gegevens/interval-check fout +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_h_smaller_possible_range_check=04049_H_Grootte-fout voor type, mogelijk verlies van gegevens/interval-check fout +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_e_cant_take_address_of_abstract_method=04050_E_Het adres van een abstracte methode kan niet opgevraagd worden +% An abstract method has no body, so the address of an abstract method can't be taken. +type_e_operator_not_allowed=04051_E_De operator kan niet gebruikt worden op dit type operand +% You are trying an operator that is not available for the type of the +% operands +type_e_constant_expr_expected=04052_E_Constante uitdrukking verwacht +% The compiler expects an constant expression, but gets a variable expression. +type_e_operator_not_supported_for_types=04053_E_Operatie "$1" niet ondersteund voor types "$2" en "$3" +% The operation is not allowed for the supplied types +type_e_illegal_type_conversion=04054_E_Ongeldige type-conversie: "$1" naar "$2" +% When doing a type-cast, you must take care that the sizes of the variable and +% the destination type are the same. +type_h_pointer_to_longint_conv_not_portable=04055_H_Conversies tussen ordinalen en pointers is niet overzetbaar naar andere platformen +% If you typecast a pointer to a longint (or vice-versa), this code will not compile +% on a machine using 64-bit for pointer storage. +type_w_pointer_to_longint_conv_not_portable=04056_W_Conversies tussen ordinalen en pointers is niet overzetbaar naar andere platformen +% If you typecast a pointer to a ordinal type of a different size (or vice-versa), this can +% cause problems. This is a warning to help finding the 32bit specific code where cardinal/longint is used +% to typecast pointers to ordinals. A solution is to use the ptrint/ptruint types instead. +type_e_cant_choose_overload_function=04057_E_Kan niet beslissen welke overladen functie te kiezen +% You're calling overloaded functions with a parameter that doesn't correspond +% to any of the declared function parameter lists. e.g. when you have declared +% a function with parameters \var{word} and \var{longint}, and then you call +% it with a parameter which is of type \var{integer}. +type_e_illegal_count_var=04058_E_Ongeldige lus variabele +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +type_w_double_c_varargs=04059_W_Converteer een real constante waarde naar een double voor C compatbiliteit, doe een expliciete type cast om dit te voorkomen. +% In C, constant real values are double by default. For this reason, if you +% pass a constant real value to a variable argument part of a C function, FPC +% by default converts this constant to double as well. If you want to prevent +% this from happening, add an explicit typecast around the constant. +type_e_class_or_cominterface_type_expected=04060_E_Verwachtte een classe- of COM-interface, maar kreeg "$1" +# +# Symtable +# +# 05060 is the last used one +# +% Some operators like the AS operator are only appliable to classes or COM interfaces. +% \end{description} +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedure and variable names. +% \begin{description} +sym_e_id_not_found=05000_E_Symbool niet gevonden $1 +% The compiler doesn't know this symbol. Usually happens when you misspel +% the name of a variable or procedure, or when you forgot to declare a +% variable. +sym_f_internal_error_in_symtablestack=05001_F_Interne fout in SymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_Dubbel symbool $1 +% The identifier was already declared in the current scope. +sym_h_duplicate_id_where=05003_H_Symbool reeds gedefinieerd in $1 op lijn $2 +% The identifier was already declared in a previous scope. +sym_e_unknown_id=05004_E_Onbekende symbool $1 +% The identifier encountered has not been declared, or is used outside the +% scope where it is defined. +sym_e_forward_not_resolved=05005_E_Voorwaartse declaratie niet opgelost $1 +% This can happen in two cases: +% \begin{itemize} +% \item This happens when you declare a function (in the \var{interface} part, or +% with a \var{forward} directive, but do not implement it. +% \item You reference a type which isn't declared in the current \var{type} +% block. +% \end{itemize} +sym_e_error_in_type_def=05007_E_Fout in type definitie +% There is an error in your definition of a new array type: +% \item One of the range delimiters in an array declaration is erroneous. +% For example, \var{Array [1..1.25]} will trigger this error. +sym_e_forward_type_not_resolved=05009_E_Forward declaratie niet opgelost $1 +% A symbol was forward defined, but no declaration was encountered. +sym_e_only_static_in_static=05010_E_Alleen statische variabelen kunnen gebruikt worden in statische methoden +% A static method of an object can only access static variables. +sym_f_type_must_be_rec_or_class=05012_F_Record- of klassetype verwacht +% The variable or expression isn't of the type \var{record} or \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_U kunt geen vertegenwoordiger van een klasse met abstracte methoden instantieren +% You are trying to generate an instance of a class which has an abstract +% method that wasn't overridden. +sym_w_label_not_defined=05014_W_Label niet gedefineerd $1 +% A label was declared, but not defined. +sym_e_label_used_and_not_defined=05015_E_Label "$1" gebruikt maar niet gedefinieerd +% A label was declared and used, but not defined. +sym_e_ill_label_decl=05016_E_Label foutief gedefineerd +% This error should never happen; it occurs if a label is defined outside a +% procedure or function. +sym_e_goto_and_label_not_supported=05017_E_GOTO en LABEL zijn afgezet (gebruik -Sg) +% You must compile a program which has \var{label}s and \var{goto} statements +% with the \var{-Sg} switch. By default, \var{label} and \var{goto} aren't +% supported. +sym_e_label_not_found=05018_E_Label niet gevonden +% A \var{goto label} was encountered, but the label isn't declared. +sym_e_id_is_no_label_id=05019_E_Symbool is geen label +% The identifier specified after the \var{goto} isn't of type label. +sym_e_label_already_defined=05020_E_Label is al gedefineerd +% You are defining a label twice. You can define a label only once. +sym_e_ill_type_decl_set=05021_E_Type declaratie van set elementen is foutief +% The declaration of a set contains an invalid type definition. +sym_e_class_forward_not_resolved=05022_E_Voorwaartse definitie van klasse niet opgelost $1 +% You declared a class, but you did not implement it. +sym_n_unit_not_used=05023_H_Unit $1 wordt niet gebruikt in $2 +% The unit referenced in the \var{uses} clause is not used. +sym_h_para_identifier_not_used=05024_H_Parameter niet gebruikt $1 +% The identifier was declared (locally or globally) but +% was not used (locally or globally). +sym_n_local_identifier_not_used=05025_N_Lokale variabele niet gebruikt $1 +% You have declared, but not used a variable in a procedure or function +% implementation. +sym_h_para_identifier_only_set=05026_H_Waarde parameter $1 is gedeclareerd maar niet gebruikt. +% The identifier was declared (locally or globally) +% set but not used (locally or globally). +sym_n_local_identifier_only_set=05027_N_Lokale variabele $1 gedeclareerd maar niet gebruikt. +% The variable in a procedure or function +% implementation is declared, set but never used. +sym_h_local_symbol_not_used=05028_H_Lokaal $1 $2 is niet gebruikt +% A local symbol is never used. +sym_n_private_identifier_not_used=05029_N_Privaat veld $1.$2 wordt niet gebruikt +sym_n_private_identifier_only_set=05030_N_Privaat veld $1.$2 gedeclareerd maar niet gebruikt. +sym_n_private_method_not_used=05031_N_Private methode $1.$2 wordt nooit gebruikt. +sym_e_set_expected=05032_E_Set type verwacht +% The variable or expression is not of type \var{set}. This happens in an +% \var{in} statement. +sym_w_function_result_not_set=05033_W_Resultaat van functie lijkt niet te zijn toegekend +% You can get this warning if the compiler thinks that a function return +% value is not set. This will not be displayed for assembler procedures, +% or procedures that contain assembler blocks. +sym_w_wrong_C_pack=05034_W_Type $1 is not aligned correctly in current record for C +% Arrays with sizes not multiples of 4 will be wrongly aligned +% for C structures. +sym_e_illegal_field=05035_E_Onbekend record lid $1 +% The field doesn't exist in the record/object definition. +sym_w_uninitialized_local_variable=05036_W_Lokale variabele "$1" lijkt niet geinitialiseerd +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_w_uninitialized_variable=05037_W_okale variabele "$1" lijkt niet geinitialiseerd +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_e_id_no_member=05038_E_Geen lid met de naam $1 +% This error is generated when an identifier of a record, +% field, or method is accessed while it is not defined. +sym_h_param_list=05039_H_NDeclaratie "$1" gevonden +% You get this when you use the \var{-vh} switch. In case an overloaded +% procedure is not found, then all candidate overloaded procedures are +% listed, with their parameter lists. +sym_e_segment_too_large=05040_E_Data segment te groot (max. 2GB) +% You get this when you declare a data element whose size exceeds the +% prescribed limit (2 Gb on 80386+/68020+ processors) +sym_e_no_matching_implementation_found=05042_E_Geen overeenstemmende implementatie voor interface methode "$1" gevonden +% There was no matching method found which could implement the interface +% method. Check argument types and result type of the methods. +sym_w_deprecated_symbol=05043_W_Symbool "$1" is afgeraden +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Usage of this symbol +% should be avoided as much as possible. +sym_w_non_portable_symbol=05044_W_Symbool "$1" is niet overzetbaar naar andere platformen +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{platform} is used. This symbol's value, usage +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_non_implemented_symbol=05055_W_Symbool "$1" is niet geimplementeerd +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{unimplemented} is used. This symbol is defined, +% but is not yet implemented on this specific platform. +sym_e_cant_create_unique_type=05056_E_Kan geen uniek type aanmaken van dit type +% Only simple types like ordinal, float and string types are supported when +% redefining a type with \var{type newtype = type oldtype;}. +sym_h_uninitialized_local_variable=05057_H_ Lokale variabele "$1" lijkt niet geinitialiseerd +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_h_uninitialized_variable=05058_H_Lokale variabele "$1" lijkt niet geinitialiseerd +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_w_function_result_uninitialized=05059_W_Het resultaat van de Functie lijkt niet geinitialiseerd. +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. appears in the right-hand-side of an expression) +% before it is initialized (i.e. appeared in the left-hand side of an +% assigment) +sym_h_function_result_uninitialized=05060_H_Het resultaat van de functie lijkt niet geinitialiseerd te zijn. +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. appears in the right-hand-side of an expression) +% before it is initialized (i.e. appeared in the left-hand side of an +% assigment) +sym_w_identifier_only_read=05061_W_Variabele "$1" wordt gelezen, maar krijgt nergens een waarde +# +# Codegenerator +# +# 06040 is the last used one +# +% You have read the value of a variable, but nowhere assigned a value to +% it. +% \end{description} +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +cg_e_parasize_too_big=06009_E_Parameters gebruiken meer dan 64 kilobyte +% The I386 processor limits the parameter list to 65535 bytes (the \var{RET} +% instruction causes this) +cg_e_file_must_call_by_reference=06012_E_File variabelen moeten altijd var parameters zijn +% You cannot specify files as value parameters, i.e. they must always be +% declared \var{var} parameters. +cg_e_cant_use_far_pointer_there=06013_E_U kunt daar geen far pointer gebruiken +% Free Pascal doesn't support far pointers, so you cannot take the address of +% an expression which has a far reference as a result. The \var{mem} construct +% has a far reference as a result, so the following code will produce this +% error: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_Procedures die als EXPORT gedeclareerd staan kunnen niet aangeroepen worden +% No longer in use. +cg_w_member_cd_call_from_method=06016_W_Mogelijke ongeldige aanroep van constructor of destructor +% The compiler detected that a constructor or destructor is called within a +% a method. This will probably lead to problems, since constructors / destructors +% require parameters on entry. +cg_n_inefficient_code=06017_N_Inefficiente code +% Your statement seems dubious to the compiler. +cg_w_unreachable_code=06018_W_Deze code wordt nooit uitgevoerd +% You specified a construct which will never be executed. Example: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_Abstracte methoden kunnen niet direct aangeroepen worden +% You cannot call an abstract method directy, instead you must call a +% overriding child method, because an abstract method isn't implemented. +cg_d_register_weight=06027_DL_Register $1 gewicht $2 $3 +% Debugging message. Shown when the compiler considers a variable for +% keeping in the registers. +cg_d_stackframe_omited=06029_DL_Stackframe wordt niet gemaakt +% Some procedure/functions do not need a complete stack-frame, so it is omitted. +% This message will be displayed when the {-vd} switch is used. +cg_e_unable_inline_object_methods=06031_E_Kan inline niet gebruiken voor object methoden +% You cannot have inlined object methods. +cg_e_unable_inline_procvar=06032_E_Kan inline niet gebruiken voor procvar aanroepen +% A procedure with a procedural variable call cannot be inlined. +cg_e_no_code_for_inline_stored=06033_E_Geen code voor inline procedure opgeslagen +% The compiler couldn't store code for the inline procedure. +cg_e_can_access_element_zero=06035_E_Element nul van een ansi/wide- of longstring is niet toegankelijk, gebruik (set)length. +% You should use \var{setlength} to set the length of an ansi/wide/longstring +% and \var{length} to get the length of such a string types +cg_e_cannot_call_cons_dest_inside_with=06037_E_Constructors of destructors kunnen niet aangeroepen worden binnen een 'with' clausule +% Inside a \var{with} clause you cannot call a constructor or destructor for the +% object you have in the \var{with} clause. +cg_e_cannot_call_message_direct=06038_E_Een message handler methode kan niet direct aangeroepen worden. +% A message method handler method cannot be called directly if it contains an +% explicit self argument +cg_e_goto_inout_of_exception_block=06039_E_Sprong in of uit een exception blok +% It is not allowed to jump in or outside of an exception block like \var{try..finally..end;}: +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // this line will cause an error +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_Control flow statements niet toegestaan in een finally blok +% It isn't allowed to use the control flow statements \var{break}, +% \var{continue} and \var{exit} +% inside a finally statement. The following example shows the problem: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // This exit ISN'T allowed +% end; +% ... +% +% \end{verbatim} +% If the procedure \var{p} raises an exception the finally block is +% executed. If the execution reaches the exit, it's unclear what to do: +% exiting the procedure or searching for another exception handler +cg_w_parasize_too_big=06041_W_Grootte van de parameters is te groot voor bepaalde CPUs +% This indicates that you are declaring more than 64K of parameters, which +% might not be supported on other processor targets. +cg_w_localsize_too_big=06042_W_Grootte van lokale variabelen is te groot voor sommige CPUs +% This indicates that you are declaring more than 32K of local variables, which +% might not be supported on other processor targets. +cg_e_localsize_too_big=06043_E_Lokale variabelen te groot +% This indicates that you are declaring more than 32K of local variables, which +% is not supported by this processor. +cg_e_break_not_allowed=06044_E_BREAK niet toegelaten +% You're trying to use \var{break} outside a loop construction. +cg_e_continue_not_allowed=06045_E_CONTINUE niet toegelaten +% You're trying to use \var{continue} outside a loop construction. +cg_f_unknown_compilerproc=06046_F_Ongekende schakel-aanduiding "$1". Kijk na of u de correcte looptijd bibliotheek gebruikt +# EndOfTeX +# +# Assembler reader +# +# 07097 is the last used one +# +% The compiler expects that the runtime library contains some subrountines. If you see this error +% and you didn't mess with the runtime library, it's very likely that the runtime library +% you're using doesn't match the used compiler. If you changed the runtime library this error means +% that you removed a subroutine which the compiler needs for internal use. +% \end{description} +asmr_d_start_reading=07000_DL_Begonnen met verwerken van $1 assembler +% This informs you that an assembler block is being parsed +asmr_d_finish_reading=07001_DL_Gedaan met verwerken van $1 assembler +% This informs you that an assembler block has finished. +asmr_e_none_label_contain_at=07002_E_Symbool dat geen label is bevat "@" +% A identifier which isn't a label can't contain a @. +asmr_e_building_record_offset=07004_E_Fout bij berekenen offset in record +% There has an error occured while building the offset of a record/object +% structure, this can happend when there is no field specified at all or +% an unknown field identifier is used. +asmr_e_offset_without_identifier=07005_E_OFFSET gebruikt zonder symbool +% You can only use OFFSET with an identifier. Other syntaxes aren't +% supported +asmr_e_type_without_identifier=07006_E_TYPE gebruikt zonder symbool +% You can only use TYPE with an identifier. Other syntaxes aren't +% supported +asmr_e_no_local_or_para_allowed=07007_E_Kan hier geen lokale variabele of parameter gebruiken +% You can't use a local variable or parameter here, mostly because the +% addressing of locals and parameters is done using the frame pointer register so the +% address can't be obtained directly. +asmr_e_need_offset=07008_E_OFFSET moet hier gebruikt worden +% You need to use OFFSET <id> here to get the address of the identifier. +asmr_e_need_dollar=07009_E_Gebruik van $ is hier verplicht +% You need to use $<id> here to get the address of the identifier. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_Kan niet meerdere verplaatsbare symbolen gebruiken +% You can't have more than one relocatable symbol (variable/typed constant) +% in one argument. +asmr_e_only_add_relocatable_symbol=07011_E_Een verplaatsbaar symbool kan enkel toegevoegd worden +% Relocatable symbols (variable/typed constant) can't be used with other +% operators. Only addition is allowed. +asmr_e_invalid_constant_expression=07012_E_Ongeldige constante uitdrukking +% There is an error in the constant expression. +asmr_e_relocatable_symbol_not_allowed=07013_E_Verplaatsbaar symbool niet toegelaten +% You can't use a relocatable symbol (variable/typed constant) here. +asmr_e_invalid_reference_syntax=07014_E_Ongeldige geheugenlocatie schrijfwijze +% There is an error in the reference. +asmr_e_local_para_unreachable=07015_E_$1 niet bereikbaar vanuit deze code +% You can not read directly the value of a local variable or parameter +% of a higher level procedure in assembler code (except for +% local assembler code without parameter nor locals). +asmr_e_local_label_not_allowed_as_ref=07016_E_Lokale symbolen/labels niet toegestaan als referenties +% You can't use local symbols/labels as references +asmr_e_wrong_base_index=07017_E_Ongeldig gebruik van basis en index register +% There is an error with the base and index register, they are +% probably incorrect +asmr_w_possible_object_field_bug=07018_W_Mogelijke fout in behandeling velden van object. +% Fields of objects or classes can be reached directly in normal or objfpc +% modes but TP and Delphi modes treat the field name as a simple offset. +asmr_e_wrong_scale_factor=07019_E_Ongeldige schaalfactor +% The scale factor given is wrong, only 1,2,4 and 8 are allowed +asmr_e_multiple_index=07020_E_Meervoudig indexregister gebruik +% You are trying to use more than one index register +asmr_e_invalid_operand_type=07021_E_Ongeldig operandus type +% The operand type doesn't match with the opcode used +asmr_e_invalid_string_as_opcode_operand=07022_E_Ongeldige tekenreeks als instructie operandus: $1 +% The string specified as operand is not correct with this opcode +asmr_w_CODE_and_DATA_not_supported=07023_W_@CODE en @DATA worden niet ondersteund +% @CODE and @DATA are unsupported and are ignored. +asmr_e_null_label_ref_not_allowed=07024_E_Null label verwijzingen zijn niet toegelaten +asmr_e_expr_zero_divide=07025_E_Deling door nul +% There is a division by zero in a constant expression +asmr_e_expr_illegal=07026_E_Ongeldige uitdrukking +% There is an illegal expression in a constant expression +asmr_e_escape_seq_ignored=07027_E_Expliciete reeks genegeerd: $1 +% There is a C-styled string, but the escape sequence in the string +% is unknown, and is therefore ignored +asmr_e_invalid_symbol_ref=07028_E_Ongeldige symboolverwijzing +asmr_w_fwait_emu_prob=07029_W_Fwait kan emulatieproblemen met emu387 veroorzaken +asmr_w_fadd_to_faddp=07030_W_$1 zonder operand vertaald naar $1P +asmr_w_enter_not_supported_by_linux=07031_W_De ENTER instructie wordt niet ondersteund door de Linux kernel +% ENTER instruction can generate a stack page fault that is not +% caught correctly by the i386 Linux page handler. +asmr_w_calling_overload_func=07032_W_Een overroepen functie wordt aangeroepen vanuit assemblercode +% There is a call to an overloaded method in the assembler block, +% this might be the sign there is a problem +asmr_e_unsupported_symbol_type=07033_E_Niet ondersteund symbool type voor operandus +asmr_e_constant_out_of_bounds=07034_E_Constante waarde valt buiten bereik +asmr_e_error_converting_decimal=07035_E_Fout bij omzetten van decimaal getal $1 +% A constant decimal value does not have the correct syntax +asmr_e_error_converting_octal=07036_E_Fout bij omzetten van octaal getal $1 +% A constant octal value does not have the correct syntax +asmr_e_error_converting_binary=07037_E_Fout bij omzetten van binair getal $1 +% A constant binary value does not have the correct syntax +asmr_e_error_converting_hexadecimal=07038_E_Fout bij omzetten van hexadecimaal getal $1 +% A constant hexadecimal value does not have the correct syntax +asmr_h_direct_global_to_mangled=07039_H_$1 vertaald naar $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 is geassocieerd met een overroepen functie +asmr_e_cannot_use_SELF_outside_a_method=07041_E_Kan SELF niet buiten een methode gebruiken +% There is a reference to the \var{self} symbol while it is not +% allowed. \var{self} can only be referenced inside methods +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_Kan OLDEBP niet buiten een genestelde procedure gebruiken +% There is a reference to the \var{oldebp} symbol while it is not +% allowed. \var{oldebp} can only be referenced inside nested routines +asmr_e_void_function=07043_W_Functies met een ongedefinieerde teruggeefwaarde kunnen geen waarde teruggeven +% Trying to return a value while in a procedure. A procedure +% does not have any return value +asmr_e_SEG_not_supported=07044_E_SEG niet ondersteund +asmr_e_size_suffix_and_dest_dont_match=07045_E_Grootte-achtervoegsel en doel- of brongrootte komen niet overeen +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_w_size_suffix_and_dest_dont_match=07046_W_Grootte-achtervoegsel en doel- of brongrootte komen niet overeen +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_e_syntax_error=07047_E_Assembler taalfout +% There is an assembler syntax error +asmr_e_invalid_opcode_and_operand=07048_E_Ongeldige combinatie van instructie en operandi +% The opcode cannot be used with this type of operand +asmr_e_syn_operand=07049_E_Assembler taalfout in operandum +asmr_e_syn_constant=07050_E_Assembler taalfout in constante +asmr_e_invalid_string_expression=07051_E_Ongeldige String uitdrukking +asmr_w_const32bit_for_address=07052_W_ Constante met symbool $1 voor adres dat zich niet op een pointer bevindt +% A constant expression represents an address which does not fit +% into a pointer. The address is probably incorrect +asmr_e_unknown_opcode=07053_E_Ongekende opcode $1 +% This opcode is not known +asmr_e_invalid_or_missing_opcode=07054_E_Ongeldige of ontbrekende instructie +asmr_e_invalid_prefix_and_opcode=07055_E_Ongeldige combinatie van voorvoegsel en instructie: $1 +asmr_e_invalid_override_and_opcode=07056_E_Ongeldige combinatie van segment overroeping en instructie: $1 +asmr_e_too_many_operands=07057_E_Te veel operandi op een lijn +% There are too many operands for this opcode. Check your +% assembler syntax +asmr_w_near_ignored=07058_W_NEAR genegeerd +asmr_w_far_ignored=07059_W_FAR genegeerd +asmr_e_dup_local_sym=07060_E_Dubbel lokaal symbool $1 +asmr_e_unknown_local_sym=07061_E_Niet gedefinieerd lokaal symbool $1 +asmr_e_unknown_label_identifier=07062_E_Onbekende labelnaam $1 +asmr_e_invalid_register=07063_E_Ongeldige register naam +% There is an unknown register name used as operand. +asmr_e_invalid_fpu_register=07064_E_Ongeldig vlottende-komma registernaam +% There is an unknown register name used as operand. +asmr_w_modulo_not_supported=07066_W_Modulo wordt niet ondersteund +asmr_e_invalid_float_const=07067_E_Ongeldige vlottende-komma constante $1 +% The floating point constant declared in an assembler block is +% invalid. +asmr_e_invalid_float_expr=07068_E_Ongeldige vlottende-komma uitdrukking +% The floating point expression declared in an assembler block is +% invalid. +asmr_e_wrong_sym_type=07069_E_Verkeerd symbool type +asmr_e_cannot_index_relative_var=07070_E_Een lokale variabele of parameter kan niet geindedxeerd worden met een register +% Trying to index using a base register a symbol which is already relative +% to a register. This is not possible, and will probably lead to crashes. +asmr_e_invalid_seg_override=07071_E_Ongeldige segment overroeping +asmr_w_id_supposed_external=07072_W_Symbool $1 wordt verondersteld extern te zijn +% There is a reference to an undefined symbol. This will not result +% in an error, since the symbol might be external, but may cause +% problems at link time if the symbol is not defined anywhere. +asmr_e_string_not_allowed_as_const=07073_E_Strings zijn niet toegelaten als constante +% Character strings are not allowed as constants. +asmr_e_no_var_type_specified=07074_Geen type van de variabele gegeven +% The syntax expects a type idenfitifer after the dot, but +% none was found. +asmr_w_assembler_code_not_returned_to_text=07075_E_De assembler code stopt niet in een '.text' gedeelte +% There was a directive in the assembler block to change sections, +% but there is a missing return to the text section at the end +% of the assembler block. This might cause errors during link time. +asmr_e_not_directive_or_local_symbol=07076_E_Geen aanwijzing of lokaal symbool $1 +% This symbol is unknown. +asmr_w_using_defined_as_local=07077_E_Een gedfinieerde naam wordt gebruikt als assembler label +asmr_e_dollar_without_identifier=07078_E_Dollar teken gebruikt zonder identifier +% A constant expression has an identifier which does not start with +% the $ symbol. +asmr_w_32bit_const_for_address=07079_W_32bit constante aangemaakt voor adres +% A constant was used as an address. This is probably an error, +% since using absolute addresses will probably not work. +asmr_n_align_is_target_specific=07080_N_.align is doel specifiek, gebruik .balign of .p2align +% Using the .align directive is platform specific, and its meaning will vary +% from one platform to another. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_Kan velden niet direct gebruiken voor parameters. +% You should load the parameter first into a register and then access the +% fields using that register. +asmr_e_cannot_access_object_field_directly=07082_E_Kan velden van objecten/klassen niet direct aanspreken +% You should load the self pointer first into a register and then access the +% fields using the register as base. By default the self pointer is available +% in the esi register on i386. +asmr_e_unable_to_determine_reference_size=07083_E_Geen grootte aangegegeven en kan de grootte van de operanden niet bepalen +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. +asmr_e_cannot_use_RESULT_here=07084_E_Kan RESULT aanduiding niet gebruiken in deze functie +% Some functions which return complex types cannot use the \var{result} +% keyword. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" zonder operand vertaald naar "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" vertaald naar "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" vertaald naar "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_Karakter < hier niet toegestaan +% The shift operator requires the << characters. Only one +% of those characters was found. +asmr_e_invalid_char_greater=07090_E_Karakter > hier niet toegestaan +% The shift operator requires the >> characters. Only one +% of those characters was found. +asmr_w_align_not_supported=07093_W_ALIGN niet ondersteund +asmr_e_no_inc_and_dec_together=07094_E_INC en DEC kunnen niet samengaan +% Trying to use an increment and a decrement within the same +% opcode on the 680x0. This is impossible. +asmr_e_invalid_reg_list_in_movem=07095_E_Ongeldige register lijst voor movem +% Trying to use the \var{movem} opcode with invalid registers +% to save or restore. +asmr_e_invalid_reg_list_for_opcode=07096_E_Ongeldige register lijst voor opcode +asmr_e_higher_cpu_mode_required=07097_E_hogere CPU mode vereist ($1) +% Trying to use an instruction which is not supported in the current +% cpu mode. Use a higher cpu generation to be able to use this +% opcode in your assembler block +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_Grootte niet opgegeven en kan de grootte van de operanden niet bepalen. De standaard DWORD wordt gebruikt +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use DWORD as default. +asmr_e_illegal_shifterop_syntax=07099_E_Syntax fout bij het bepalen van een shift operand +# +# Assembler/binary writers +# +# 08018 is the last used one +# +% ARM only; ARM assembler supports a so called shifter operand. The used syntax isn't +% a valid shifter operand. Example for an operation with shifter operand: +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +asmw_f_too_many_asm_files=08000_F_Te veel assemblerbestanden +% With smartlinking enabled, there are too many assembler +% files generated. Disable smartlinking. +asmw_f_assembler_output_not_supported=08001_F_De geselecteerde assembler modus wordt hier niet ondersteund +asmw_f_comp_not_supported=08002_F_Het COMP type wordt hier niet ondersteund +asmw_f_direct_not_supported=08003_F_Directe assembler modus wordt niet ondersteund door de binaire assemblerschrijver +% Direct assembler mode is not supported for binary writers. +asmw_e_alloc_data_only_in_bss=08004_E_Ruimte voor gegevens reserveren mag enkel in een bss gedeelte +asmw_f_no_binary_writer_selected=08005_F_Binaire assemblerschrijver geselecteerd +asmw_e_opcode_not_in_table=08006_E_Asm: Opcode $1 not gevonden in interne tabel +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 Ongeldige combinatie van instructie en operandi +asmw_e_16bit_not_supported=08008_E_Asm: 16 Bit geheugenlocaties worden niet ondersteund +asmw_e_invalid_effective_address=08009_E_Asm: Ongeldig direct adres +asmw_e_immediate_or_reference_expected=08010_E_Asm: Constante of geheugenadres verwacht +asmw_e_value_exceeds_bounds=08011_E_Asm: $1 waarde overschrijdt grenzen van $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: Korte spronginstructie gaat te ver $1 +asmw_e_undefined_label=08013_E_Asm: Ongedefinieerd label $1 +asmw_e_comp_not_supported=08014_E_Asm: COMP type niet ondersteund voor dit platfirl +asmw_e_extended_not_supported=08015_E_Asm: EXTENDED type niet ondersteund voor dit platform +asmw_e_duplicate_label=08016_E_Asm: Label dubbel gebruikt: $1 +asmw_e_redefined_label=08017_E_Asm: Label opnieuw gedefinieerd: $1 +asmw_e_first_defined_label=08018_E_Asm: eerste definitie hier +asmw_e_invalid_register=08019_E_Asm: ongeldig register $1 +asmw_e_16bit_32bit_not_supported=08020_E_Asm: 16 or 32 Bit references not supported +asmw_e_64bit_not_supported=08021_E_Asm: 64 Bit operands not supported +# +# Executing linker/assembler +# +# 09034 is the last used one +# +# BeginOfTeX +% +% \section{Errors of assembling/linking stage} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +exec_w_source_os_redefined=09000_W_Bronbesturingssysteem geherdefinieerd +exec_i_assembling_pipe=09001_I_Assembleren (pijp) van $1 +exec_d_cant_create_asmfile=09002_E_Kan geen assembler bestand $1 niet maken +% The mentioned file can't be created. Check if you have got +% access permissions to create this file +exec_e_cant_create_objectfile=09003_E_Kan geen object bestand openen: $1 +% The mentioned file can't be created. Check if you've +% got access permissions to create this file +exec_e_cant_create_archivefile=09004_E_kan geen archief bestand openen: $1 +% The mentioned file can't be created. Check if you've +% access permissions to create this file +exec_e_assembler_not_found=09005_E_Assembler $1 niet gevonden. Schakel over op externe assemblage +exec_t_using_assembler=09006_T_Gebruikte assembler: $1 +exec_e_error_while_assembling=09007_E_Fout bij het assembleren, exit code $1 +% There was an error while assembling the file using an external assembler. +% Consult the documentation of the assembler tool to find out more information +% on this error. +exec_e_cant_call_assembler=09008_E_Kan de assembler niet oproepen, fout $1. Schakel over op externe assemblage +exec_i_assembling=09009_I_Assembleren van $1 +exec_i_assembling_smart=09010_I_Assembleren slim-link $1 +exec_w_objfile_not_found=09011_W_Bestand $1 niet gevonden, linken kan foutlopen ! +% One of the object file is missing, and linking will probably fail. +% Check your paths. +exec_w_libfile_not_found=09012_W_Bibliotheek $1 niet gevonden, linken kan foutlopen ! +% One of the library file is missing, and linking will probably fail. +% Check your paths. +exec_e_error_while_linking=09013_E_Fout bij het linken +% Generic error while linking. +exec_e_cant_call_linker=09014_E_Kan de linker niet oproepen, schakel over op extern linken +exec_i_linking=09015_I_Linken van $1 +exec_e_util_not_found=09016_E_Gereedschap $1 niet gevonden, schakel over op extern linken +exec_t_using_util=09017_T_Gebruik tool $1 +exec_e_exe_not_supported=09018_E_Creatie van executable bestanden niet ondersteund. +exec_e_dll_not_supported=09019_E_Dynamische bibliotheken niet ondersteund +exec_i_closing_script=09020_I_Afsluiten batch $1 +exec_e_res_not_found=09021_E_Resource compiler niet gevonde, schakel over op externe modus +exec_i_compilingresource=09022_I_Compileer resource $1 +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_Unit $1 kan niet statisch gelinkt worden. Schakel over op slim linken +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_Unit $1 kan niet slim gelinkt worden. Schakel over op statisch linken +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_Unit $1 kan niet gedeeld gelinkt worden, Schakel over op statisch linken +exec_e_unit_not_smart_or_static_linkable=09026_E_Unit $1 kan niet slim of statisch gelinkt worden +exec_e_unit_not_shared_or_static_linkable=09027_E_Unit $1 kan niet gedeeld of statisch gelinkt worden +exec_d_resbin_params=09028_D_Oproep resource compiler "$1" met "$2" als commando-lijn opties +# EndOfTeX +# +# Executable information +# +%\end{description} +execinfo_f_cant_process_executable=09128_F_Kan applicatie niet nabehandelen $1 +execinfo_f_cant_open_executable=09129_F_Kan applicatie niet openen $1 +execinfo_x_codesize=09130_X_Grootte van de code: $1 bytes +execinfo_x_initdatasize=09131_X_Grootte van geinitialiseerde data: $1 bytes +execinfo_x_uninitdatasize=09132_X_Grootte van niet-geinitialiseerde data: $1 bytes +execinfo_x_stackreserve=09133_X_Gereserveerde stackruimte: $1 bytes +execinfo_x_stackcommit=09134_X_Toegewezen stackruimte: $1 bytes +# +# Unit loading +# +# 10041 is the last used one +# +# BeginOfTeX +% \section{Unit loading messages.} +% This section lists all messages that can occur when the compiler is +% loading a unit from disk into memory. Many of these messages are +% informational messages. +% \begin{description} +unit_t_unitsearch=10000_T_Unit zoeken: $1 +% When you use the \var{-vt}, the compiler tells you where it tries to find +% unit files. +unit_t_ppu_loading=10001_T_PPU Laden $1 +% When the \var{-vt} switch is used, the compiler tells you +% what units it loads. +unit_u_ppu_name=10002_U_PPU Naam: $1 +% When you use the \var{-vu} flag, the unit name is shown. +unit_u_ppu_flags=10003_U_PPU Vlaggen: $1 +% When you use the \var{-vu} flag, the unit flags are shown. +unit_u_ppu_crc=10004_U_PPU CRC: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_time=10005_U_PPU Tijd: $1 +% When you use the \var{-vu} flag, the time the unit was compiled is shown. +unit_u_ppu_file_too_short=10006_U_PPU bestand te kort +% The ppufile is too short, not all declarations are present. +unit_u_ppu_invalid_header=10007_U_PPU Ongeldige kop (geen PPU aan het begin) +% A unit file contains as the first three bytes the ascii codes of \var{PPU} +unit_u_ppu_invalid_version=10008_U_PPU Ongeldige versie $1 +% This unit file was compiled with a different version of the compiler, and +% cannot be read. +unit_u_ppu_invalid_processor=10009_U_PPU is gecompileerd voor een andere processor +% This unit file was compiled for a different processor type, and +% cannot be read +unit_u_ppu_invalid_target=10010_U_PPU is gecompileerd voor een ander doelsysteem +% This unit file was compiled for a different target, and +% cannot be read +unit_u_ppu_source=10011_U_PPU bron: $1 +% When you use the \var{-vu} flag, the unit source file name is shown. +unit_u_ppu_write=10012_U_Schrijven van $1 +% When you specify the \var{-vu} switch, the compiler will tell you where it +% writes the unit file. +unit_f_ppu_cannot_write=10013_F_Kan PPU bestand niet schrijven +% An error occurred when writing the unit file. +unit_f_ppu_read_error=10014_F_Lezen van PPU bestand +% This means that the unit file was corrupted, and contains invalid +% information. Recompilation will be necessary. +unit_f_ppu_read_unexpected_end=10015_F_Onverwacht einde van PPU-bestand +% Unexpected end of file. This may mean that the PPU file is +% corrupted. +unit_f_ppu_invalid_entry=10016_F_Ongeldig PPU bestand post: $1 +% The unit the compiler is trying to read is corrupted, or generated with a +% newer version of the compiler. +unit_f_ppu_dbx_count_problem=10017_F_PPU Dbx aantal probleem +% There is an inconsistency in the debugging information of the unit. +unit_e_illegal_unit_name=10018_E_Ongeldige unitnaam: $1 +% The name of the unit does not match the file name. +unit_f_too_much_units=10019_F_Te veel units +% \fpc has a limit of 1024 units in a program. You can change this behavior +% by changing the \var{maxunits} constant in the \file{fmodule.pas} file of the +% compiler, and recompiling the compiler. +unit_f_circular_unit_reference=10020_F_Uses statement veroorzaakt vicieuze cirkel tussen $1 en $2 +% Two units are using each other in the interface part. This is only allowed +% in the \var{implementation} part. At least one unit must contain the other one +% in the \var{implementation} section. +unit_f_cant_compile_unit=10021_F_Kan unit $1 niet compileren, geen broncode beschikbaar +% A unit was found that needs to be recompiled, but no sources are +% available. +unit_f_cant_find_ppu=10022_F_Kan unit $1 niet vinden +% You tried to use a unit of which the PPU file isn't found by the +% compiler. Check your configuration file for the unit paths +unit_w_unit_name_error=10023_W_Unit $1 niet gevonden maar $2 bestaat +unit_f_unit_name_error=10024_F_Unit $1 gezocht maar $2 gevonden +% Dos truncation of 8 letters for unit PPU files +% may lead to problems when unit name is longer than 8 letters. +unit_w_switch_us_missed=10025_W_De systeemunit compileren vereist de -Us schakelaar +% When recompiling the system unit (it needs special treatment), the +% \var{-Us} must be specified. +unit_f_errors_in_unit=10026_F_Er waren fouten $1 bij het compileren van een module, compilatie gestopt. +% When the compiler encounters a fatal error or too many errors in a module +% then it stops with this message. +unit_u_load_unit=10027_U_Laden van $1 ($2) unit $3 +% When you use the \var{-vu} flag, which unit is loaded from which unit is +% shown. +unit_u_recompile_crc_change=10028_U_Hercompileer $1, checksum voor $2 veranderd +unit_u_recompile_source_found_alone=10029_U_herkompileer $1, alleen bron gevonden +% When you use the \var{-vu} flag, these messages tell you why the current +% unit is recompiled. +unit_u_recompile_staticlib_is_older=10030_U_Hercompileer unit, statische bibliotheek ouder dan ppu-bestand +% When you use the \var{-vu} flag, the compiler warns if the static library +% of the unit are older than the unit file itself. +unit_u_recompile_sharedlib_is_older=10031_U_Hercompileer unit, dynamische bibliotheek ouder dan ppu-bestand +% When you use the \var{-vu} flag, the compiler warns if the shared library +% of the unit are older than the unit file itself. +unit_u_recompile_obj_and_asm_older=10032_U_Hercompileer unit, object en asm zijn ouder dan ppu-bestand +% When you use the \var{-vu} flag, the compiler warns if the assembler or +% object file of the unit are older than the unit file itself. +unit_u_recompile_obj_older_than_asm=10033_U_Hercompileer unit, object is ouder dan assembler +% When you use the \var{-vu} flag, the compiler warns if the assembler +% file of the unit is older than the object file of the unit. +unit_u_parsing_interface=10034_U_Interface van $1 wordt geparsed +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the interface part of the unit +unit_u_parsing_implementation=10035_U_Implementatie van $1 wordt geparsed +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the implementation part of the unit +unit_u_second_load_unit=10036_U_Tweede maal unit $1 laden +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_check_time=10037_U_PPU Controleren van bestand $1 tijd $2 +### The following two error msgs is currently disabled. +#unit_h_cond_not_set_in_last_compile=10038_H_Conditional $1 was not set at startup in last compilation of $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that currently is defined, but was not used the last +#% time the unit was compiled. +#unit_h_cond_set_in_last_compile=10039_H_Conditional $1 was set at startup in last compilation of $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that was used the last time the unit was compiled, but +#% the conditional is currently not defined. +% When you use the \var{-vu} flag, the compiler show the filename and +% date and time of the file which a recompile depends on +unit_w_cant_compile_unit_with_changed_incfile=10040_W_Kan unit $1 niet hercompileren, maar vond gewijzigde include bestanden +% A unit was found to have modified include files, but +% some source files were not found, so recompilation is impossible. +unit_h_source_modified=10041_H_Bestand $1 is nieuwer dan release PPU bestand $2 +% A modified source file for a unit was found that was compiled with the +% release flag (-Ur). The unit will not implicitly be recompiled because +% this release flag is set. +unit_u_ppu_invalid_fpumode=10042_U_Er wordt een unit gebruikt die niet met de correcte FPU modus is gecompileerd +% Trying to compile code while using units which were not compiled with +% the same floating point format mode. Either all code should be compiled +% with FPU emulation on, or with FPU emulation off. +unit_u_loading_interface_units=10043_U_Laden van interface units voor unit $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the units defined in the interface part of the unit. +unit_u_loading_implementation_units=10044_U_Laden van implementatie units voor unit $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the units defined in the implementation part of the unit. +unit_u_interface_crc_changed=10045_U_Interface CRC voor unit $1 is gewijzigd +% When you use the \var{-vu} flag, the compiler warns that it the +% CRC calculated for the interface has been changed after the implementation +% has been parsed. +unit_u_implementation_crc_changed=10046_U_Implementatie CRC voor unit $1 is gewijzigd +% When you use the \var{-vu} flag, the compiler warns that it the +% CRC calculated has been changed after the implementation +% has been parsed. +unit_u_finished_compiling=10047_U_Klaar met compileren van unit $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has finished compiling the unit. +unit_u_add_depend_to=10048_U_Afhankelijkheid van $1 toegevoegd aan $2 +% When you use the \var{-vu} flag, the compiler warns that it +% has added a dependency between the two units. +unit_u_no_reload_is_caller=10049_U_Niet herladen, oproeper is: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has will not reload the unit because it is the unit that wants +% to load this unit +unit_u_no_reload_in_second_compile=10050_U_Niet herladen, reads in tweede compilatie: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has will not reload the unit because it is already in a second recompile +unit_u_flag_for_reload=10051_U_Vlaggen voor herladen: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to reload the unit +unit_u_forced_reload=10052_U_Verplicht herladen +% When you use the \var{-vu} flag, the compiler warns that it +% has is reloading the unit because it was required +unit_u_previous_state=10053_U_Vorige toestand van $1: $2 +% When you use the \var{-vu} flag, the compiler shows the +% previous state of the unit +unit_u_second_compile_unit=10054_U_$1 wordt reeds gecompileerd, tweede compile wordt gezet +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_loading_unit=10055_U_Laden unit $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the unit. +unit_u_finished_loading_unit=10056_U_Klaar met laden van unit $1 +% When you use the \var{-vu} flag, the compiler warns that it finished +% loading the unit. +unit_u_registering_new_unit=10057_U_Nieuwe unit $1 wordt geregistreerd +% When you use the \var{-vu} flag, the compiler warns that it has +% found a new unit and registers it in the internal lists. +unit_u_reresolving_unit=10058_U_Opnieuw oplossen van unit $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to recalculate the internal data of the unit +unit_u_skipping_reresolving_unit=10059_U_Oplossen van unit $1 wordt overgeslagen, gebruikte units worden nog geladen +# EndOfTeX +# +# Options +# +# 11039 is the last used one +# +% When you use the \var{-vu} flag, the compiler warns that it +% skips to recalculate the internal data of the unit because there +% is no data to recalculate +% \end{description} +option_usage=11000_O_$1 [opties] <bestand> [opties] +# BeginOfTeX +% +% \section{Command-line handling errors} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +option_only_one_source_support=11001_W_Maar een (1) bronbestand wordt ondersteunt +% You can specify only one source file on the command line. The first +% one will be compiled, others will be ignored. This may indicate that +% you forgot a \var{'-'} sign. +option_def_only_for_os2=11002_W_Een DEF file kan alleen worden gemaakt voor OS/2 +% This option can only be specified when you're compiling for OS/2 +option_no_nested_response_file=11003_E_Geneste optie bestanden niet ondersteund +% you cannot nest response files with the \var{@file} command-line option. +option_no_source_found=11004_F_Geen bronbestand op de commando-lijn +% The compiler expects a source file name on the command line. +option_no_option_found=11005_N_geen opties in configuratie bestand $1 +% The compiler didn't find any option in that config file. +option_illegal_para=11006_E_Ongeldige parameter: $1 +% You specified an unknown option. +option_help_pages_para=11007_H_-? druk hulp af +% When an unknown option is given, this message is diplayed. +option_too_many_cfg_files=11008_F_Te veel geneste instellingsbestanden +% You can only nest up to 16 config files. +option_unable_open_file=11009_F_Kan bestand $1 niet openen +% The option file cannot be found. +option_reading_further_from=11010_D_Meer instellingen worden gelezen van $1 +% Displayed when you have notes turned on, and the compiler switches +% to another options file. +option_target_is_already_set=11011_W_Doel is reeds ingesteld op: $1 +% Displayed if more than one \var{-T} option is specified. +option_no_shared_lib_under_dos=11012_W_Shared bibliotheken niet onderteund onder DOS, val terug op statisch +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos +option_too_many_ifdef=11013_F_Te veel IF(N)DEFs +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_many_endif=11014_F_Te veel ENDIFs +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_less_endif=11015_F_Open voorwaardelijke aan eind van bestand +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_no_debug_support=11016_W_Debug informatie generatie wordt niet ondersteund door deze applicatie +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_Hercompileer de compiler-applicatie met -dGDB +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_W_U gebruikt een in onbruik geraakte schakeloptie $1 +% this warns you when you use a switch that is not needed/supported anymore. +% It is recommended that you remove the switch to overcome problems in the +% future, when the switch meaning may change. +option_obsolete_switch_use_new=11019_W_U gebruikt een in onbruik geraakte schakeloptie $1, gebruik $2 a.u.b. +% this warns you when you use a switch that is not supported anymore. You +% must now use the second switch instead. +% It is recommended that you change the switch to overcome problems in the +% future, when the switch meaning may change. +option_switch_bin_to_src_assembler=11020_N_De assembler wordt veranderd in de standaard assemblerschrijver +% this notifies you that the assembler has been changed because you used the +% -a switch which can't be used with a binary assembler writer. +option_incompatible_asm=11021_W_Geselecteerde assembler "$1" is niet verenigbaar met "$2" +option_asm_forced=11022_W_Gebruik van "$1" assembler opgelegd +% The assembler output selected can not generate +% object files with the correct format. Therefore, the +% default assembler for this target is used instead. +option_using_file=11026_T_Opties worden gelezen van bestand $1 +% Options are also read from this file +option_using_env=11027_T_Opties worden gelezen van omgevingsvariabelen $1 +% Options are also read from this environment string +option_handling_option=11028_D_Behandelen van optie "$1" +% Debug info that an option is found and will be handled +option_help_press_enter=11029__***Druk op de ENTER toets*** +option_start_reading_configfile=11030_H_Start lezen van configuratie bestand $1 +% Starting of config file parsing. +option_end_reading_configfile=11031_H_Einde van lezen van configuratie bestand $1 +% End of config file parsing. +option_interpreting_option=11032_D_Optie $1 wordt behandeld +option_interpreting_firstpass_option=11036_D_Behandel prioritaire optie "$1" +option_interpreting_file_option=11033_D_Behandel bestandsoptie "$1" +option_read_config_file=11034_D_Lezen configuratie bestand "$1" +option_found_file=11035_D_Bronbestand "$1" gevonden +% Additional infos about options, displayed +% when you have debug option turned on. +option_code_page_not_available=11039_E_Ongekende coderingspagina +option_config_is_dir=11040_F_Config bestand $1 is een directorie +# EndOfTeX +# +# Logo (option -l) +# +% Directories can not be used as configuration files. +%\end{description} +option_logo=11023_[ +Free Pascal Compiler versie $FPCFULLVERSION [$FPCDATE] voor $FPCTARGET +Copyright (c) 1998-2011 door Florian Klaempfl en anderen +] +# +# Info (option -i) +# +option_info=11024_[ +Free Pascal Compiler versie $FPCVERSION +Compiler datum: $FPCDATE +Compiler doelsysteem: $FPCTARGET +Dit programma wordt verspreid onder de GNU General Public Licence +Voor meer informatie, lees COPYING.FPC. Hiervan is helaas geen +Nederlandse vertaling beschikbaar. + http://bugs.freepascal.org +of + bugs@freepascal.org +] +# +# Help pages (option -? and -h) +# +# The first character on the line indicates who will display this +# line, the current possibilities are : +# * = every target +# 3 = 80x86 targets +# 6 = 680x0 targets +# e = in extended debug mode only +# P = PowerPC targets +# S = Sparc targets +# V = Virtual machine targets +# The second character also indicates who will display this line, +# (if the above character was TRUE) the current possibilities are : +# * = everyone +# g = with GDB info supported by the compiler +# O = OS/2 +# L = UNIX systems +# The third character represents the indentation level. +# +option_help_pages=11025_[ +**0*_+ schakelt optie aan, - af +**1a_De compiler verwijdert gegenereerd assemblerbestand niet +**2al_Toon broncode in assemblerbestand +**2ar_Toon registerreservering/-vrijgave in assemblerbestand +**2at_Toon reservering/vrijgave van tijdelijke ruimte in assemblerbestand +**1b_genereer browserinfo +**2bl_genereer info voor lokale symbolen info +**1B_Bouw alle modules +**1C_Codegeneratie opties +3*2CD_Creeer dynamische bibliotheek +**2Ch<n>_<n> bytes heap (tussen 1023 en 67107840) +**2Ci_IO-checking +**2Cn_Laat linken achterwege +**2Co_Controleer overflow van integeroperaties +**2Cr_Bereikcontrole (range check) +**2Cs<n>_Stel stackgrootte in op <n> +**2Ct_Stackcontrole +3*2CS_Cre‰er dynamische bibliotheek +3*2Cx_Gebruik slim linken +**1d<x>_definieer het symbool <x> +*O1D_genereer een DEF bestand +*O2Dd<x>_Zet beschrijving op <x> +*O2Dw_PM applicatie +**1e<x>_Zet pad naar applicaties +**1E_Zelfde als -Cn +**1F_Zet bestandsnamen en paden +**2Fe<x>_Zend foutboodschappen naar bestand <x> +*L2Fg<x>_Zelfde als -Fl +**2Fi<x>_Voegt <x> toe aan invoegpad +**2Fl<x>_Voegt <x> toe aan bibliotheek-pad +*L2FL<x>_Gebruik <x> als dynamische linker +**2Fo<x>_Voeg <x> toe aan object-pad +**2Fr<x>_Lees foutmeldingen uit bestand <x> +**2Fu<x>_Voeg <x> toe aan unit pad +**2FU<x>_Schrijf units in folder <x>, (primeert op -FE) +*g1g_genereer debuginformatie +*g2gg_gebruik gsym +*g2gd_gebruik dbx +*g2gh_laad heaptrc unit automatisch +*g2gl_Gebruik regelinformatie unit voor meer informatie in backtraces +*g2gc_genereer controles voor pointers +**1i_informatie +**2iD_Toon compilerdatum +**2iV_Toon compilerversie +**2iSO_Toon compiler-OS +**2iSP_Toon compilerprocessor +**2iTO_Toon doel-OS +**2iTP_Toon doelprocessor +**1I<x>_Voeg <x> toe aan invoegpad +**1k<x>_Geef <x> door aan de linker +**1l_Druk logo af +**1n_Standaard configuratie bestand niet lezen +**1o<x>_Stel de naam van het applicatiebestand in op <x> +**1pg_genereer profile code voor gprof +*L1P_Gebruik pipes in plaats van tijdelijke assembler bestanden +**1S_Syntaxisinstellingen +**2S2_Schakel Delphi-2-uitbreidingen in +**2Sc_Ondersteun operatoren als in C (*=,+=,/= en -=) +**2sa_Voeg assertion code toe +**2S2_Tracht Delphi compatibel te zijn +**2Se<x>_Compiler stopt na <x> fouten (standaard 1) +**2Sg_Laat LABEL en GOTO toe +**2Sh_Gebruik ansistrings +**2Si_Ondersteun INLINE +**2Sm_Ondersteun macros zoals in C (globaal) +**2So_Probeer TP/BP-7.0-compatibel te zijn +**2Sp_Probeer GNU-Pascal-compatibel te zijn +**2Ss_Constructor naam moet init zijn (destructor moet done zijn) +**1s_Roep assembler en linker niet op (slechts met -a) +**1sh_Genereer een script om op het hostplatform te linken +**1sr_Voer geen registertoewijzing uit (optimalisaties worden uitgeschakeld) +**1st_Genereer een script om op het doelplatform te linken +**1u<x>_Verwijdert symbooldefinitie <x> +**1U_unit opties +**2Un_Unit naam niet nagaan +**2Us_Compileer een systeemunit +**1v<x>_Wees uitvoerig. <x> is een combinatie van volgende letters: +**2*_e : Toon fouten (standaard) d : Toon debug informatie +**2*_w : Toon waarschuwingen u : Toon gebruikte bestanden +**2*_n : Toon notas t : Toon geteste bestanden +**2*_h : Toon hints m : Toon gedefinieerde macros +**2*_i : Toon algemene informatie p : Toon gecompileerde routines +**2*_l : Toon regelnummers c : Toon voorwaardelijken +**2*_a : Toon alles 0 : Toon alleen fouten +**2*_b : Toon alle procedures r : Rhide-/GCC-compatibiliteitsmodus +**2*_ declaraties indien een x : Executable informatie (alleen Win32) +**2*_ fout optreedt +**1X_applicatie instellingen +*L2Xc_link met de C bibliotheek +**2Xs_verwijder alle symbolen uit applicatie +**2XD_link met dynamische bibliotheken (definieert FPC_LINK_DYNAMIC) +**2XS_link met statische bibliotheken (definieert FPC_LINK_STATIC) +**2XS_link slim (definieert FPC_LINK_STATIC_SMART) +**0*_Processor specifieke instellingen: +3*1A_Output formaat +3*2Aas_assembleer met GNU AS +3*2Aasaout_assembleer met GNU AS voor aout (Go32v1) +3*2Anasmcoff_Coff (Go32v2) bestand met Nasm +3*2Anasmelf_elf32 (linux) bestand met Nasm +3*2Anasmobj_obj bestand met Nasm +3*2Amasm_obj bestand met Masm (Microsoft) +3*2Atasm_obj bestand met Tasm (Borland) +3*2Acoff_coff (Go32v2) met interne assembler +3*2Apecoff_pecoff (Win32) met interne assembler +3*1R<x>_Geef de grammatica voor de assemblerlezer op: +3*2Ratt_Lees assembler in AT&T-stijl +3*2Rintel_Lees assembler in Intelstijl +3*2Rdirect_Kopieer assemblercode rechtstreeks naar assemblerbestand +**1O<x>_optimalisaties +**2O1_Niveau 1 optimalisaties (snel en debug-vriendelijk ) +**2O2_Niveau 2 optimalisaties (-O1 + snelle optimalisaties) +**2O3_Niveau 3 optimalisaties (-O2 + trage optimalisaties) +**2Oa<x>=<y>_Stel alignering in +**2Oo[NO]<x>_Schakel optimalisatie x aan of uit, zie fpc -i voor mogelijke waarden +**2Op<x>_Stel doel-cpu in voor optimalisaties, zie fpc -i voor mogelijke waarden +**2Os_Genereer kleinere code +6*1T<x>_Doel besturingssysteem: +3*2TGO32V2_versie 2 of DJ Delorie DOS-extender +3*2TLINUX_Linux +3*2TOS2_OS/2 / eComStation +3*2TWIN32_Windows 32-bit +3*1W<x>_Opties voor het Win32-doelplatform +3*2WB<x>_Stel Image base in op (hexadecimale) waarde <x> +3*2WC_Maak een console applicatie +3*2WD_Gebruik DEFFILE om functies van bibliotheek of applicatie te exporteren +3*2WG_Maak een grafische applicatie +3*2WN_Genereer geen relocatiecode (nodig voor debuggen) +3*2WR_Genereer relocatiecode +6*1A_output formaat +6*2Aas_Unix o-bestand met GNU AS +6*2Agas_GNU Motorola-assembler +6*2Amit_MIT Syntax (oude GAS) +6*2Amot_Standaard Motorola-assembler +6*1O_optimalisaties +6*2Oa_Gebruik de optimalisaties +6*2Og_Genereer kleinere code +6*2OG_Genereer snellere code (standaard) +6*2Ox_Optimizeer maximaal (nog steeds BUGGY!!!) +6*2O2_Stel doelprocessor in op MC68020+ +6*1R<x>_assembler reading style: +6*2RMOT_read motorola style assembler +6*1T<x>_Target operating system: +6*2TAMIGA_Commodore Amiga +6*2TATARI_Atari ST/STe/TT +6*2TMACOS_Macintosh m68k +6*2TLINUX_Linux-68k +**1*_ +**1?_Toont deze hulp +**1h_Toont deze hulp zonder wachten +] diff --git a/closures/compiler/msg/errorpl.msg b/closures/compiler/msg/errorpl.msg new file mode 100644 index 0000000000..0cec618f6a --- /dev/null +++ b/closures/compiler/msg/errorpl.msg @@ -0,0 +1,2385 @@ +# +# This file is part of the Free Pascal Compiler +# Copyright (c) 1999-2000 by the Free Pascal Development team +# +# Polish (CP 852) Language File for Free Pascal +# +# 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. +# +# +# The constants are build in the following order: +# <part>_<type>_<txtidentifier> +# +# <part> is the part of the compiler the message is used +# asmr_ assembler parsing +# asmw_ assembler writing/binary writers + +# unit_ unit handling +# scan_ scanner +# parser_ parser +# type_ type checking +# general_ general info +# exec_ calls to assembler, linker, binder +# +# <type> the type of the message it should normally used for +# f_ fatal error +# e_ error +# w_ warning +# n_ note +# h_ hint +# i_ info +# l_ linenumber +# u_ used +# t_ tried +# c_ conditional +# d_ debug message +# x_ executable informations +# + +# +# General +# +# 01016 is the last used one +# +# BeginOfTeX +% \section{General compiler messages} +% This section gives the compiler messages which are not fatal, but which +% display useful information. The number of such messages can be +% controlled with the various verbosity level \var{-v} switches. +% \begin{description} +general_t_compilername=01000_T_Kompilator: $1 +% When the \var{-vt} switch is used, this line tells you what compiler +% is used. +general_d_sourceos=01001_D_OS kompilatora: $1 +% When the \var{-vd} switch is used, this line tells you what the source +% operating system is. +general_i_targetos=01002_I_Docelowy OS: $1 +% When the \var{-vd} switch is used, this line tells you what the target +% operating system is. +general_t_exepath=01003_T_—cie¾ka narz©dzi: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its binaries. +general_t_unitpath=01004_T_—cie¾ka moduˆ¢w: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for compiled units. You can set this path with the \var{-Fu} +general_t_includepath=01005_T_—cie¾ka include'¢w: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its include files (files used in \var{\{\$I xxx\}} statements). +% You can set this path with the \var{-I} option. +general_t_librarypath=01006_T_—cie¾ka bibliotek: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for the libraries. You can set this path with the \var{-Fl} option. +general_t_objectpath=01007_T_—cie¾ka obiekt¢w: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for object files you link in (files used in \var{\{\$L xxx\}} statements). +% You can set this path with the \var{-Fo} option. +general_i_abslines_compiled=01008_I_$1 linii skompilowanych w $2 sek +% When the \var{-vi} switch is used, the compiler reports the number +% of lines compiled, and the time it took to compile them (real time, +% not program time). +general_f_no_memory_left=01009_F_Brak pami©ci +% The compiler doesn't have enough memory to compile your program. There are +% several remedies for this: +% \begin{itemize} +% \item If you're using the build option of the compiler, try compiling the +% different units manually. +% \item If you're compiling a huge program, split it up in units, and compile +% these separately. +% \item If the previous two don't work, recompile the compiler with a bigger +% heap (you can use the \var{-Ch} option for this, \seeo{Ch}) +% \end{itemize} +general_i_writingresourcefile=01010_I_Zapisywanie pliku zasob¢w: $1 +% This message is shown when the compiler writes the Resource String Table +% file containing all the resource strings for a program. +general_e_errorwritingresourcefile=01011_E_Bˆ¥d podczas zapisywania pliku zasob¢w: $1 +% This message is shown when the compiler encountered an error when writing +% the Resource String Table file +general_i_fatal=01012_I_Bˆ¥d krytyczny: +% Prefix for Fatal Errors +general_i_error=01013_I_Bˆ¥d: +% Prefix for Errors +general_i_warning=01014_I_Ostrze¾enie: +% Prefix for Warnings +general_i_note=01015_I_Nota: +% Prefix for Notes +general_i_hint=01016_I_Podpowied«: +% Prefix for Hints +general_e_path_does_not_exist=01017_E_—cie¾ka "$1" nie istnieje +% The specified path does not exist. +general_e_compilation_aborted=01018_E_Kompilacja zatrzymana +% \end{description} +# +# Scanner +# +# 02063 is the last used one +# +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compiling handling. +% \begin{description} +scan_f_end_of_file=02000_F_Nieoczekiwany koniec pliku +% this typically happens in one of the following cases : +% \begin{itemize} +% \item The source file ends before the final \var{end.} statement. This +% happens mostly when the \var{begin} and \var{end} statements aren't +% balanced; +% \item An include file ends in the middle of a statement. +% \item A comment wasn't closed. +% \end{itemize} +scan_f_string_exceeds_line=02001_F_String przekracza jedn¥ lini© +% You forgot probably to include the closing ' in a string, so it occupies +% multiple lines. +scan_f_illegal_char=02002_F_Nieprawidˆowy znak $1 ($2) +% An illegal character was encountered in the input file. +scan_f_syn_expected=02003_F_Bˆ¥d skˆadni, oczekiwano $1 ale napotkano $2 +% This indicates that the compiler expected a different token than +% the one you typed. It can occur almost everywhere where you make a +% mistake against the pascal language. +scan_t_start_include_file=02004_T_Rozpocz©cie czytania pliku include $1 +% When you provide the \var{-vt} switch, the compiler tells you +% when it starts reading an included file. +scan_w_comment_level=02005_W_Znaleziono komentarz $1 stopnia +% When the \var{-vw} switch is used, then the compiler warns you if +% it finds nested comments. Nested comments are not allowed in Turbo Pascal +% and can be a possible source of errors. +scan_n_ignored_switch=02008_N_Zignorowany przeˆ¥cznik kompilatora $1 +% With \var{-vn} on, the compiler warns if it ignores a switch +scan_w_illegal_switch=02009_W_Nieprawidˆowy przeˆ¥cznik kompilatora $1 +% You included a compiler switch (i.e. \var{\{\$... \}}) which the compiler +% doesn't know. +scan_w_switch_is_global=02010_W_Przeˆ¥cznik globalny w nieprawidˆowym miejscu +% The compiler switch is misplaced, and should be located at +% the start of the unit or program. +scan_e_illegal_char_const=02011_E_Nieprawidˆowa staˆa znakowa +% This happens when you specify a character with its ASCII code, as in +% \var{\#96}, but the number is either illegal, or out of range. +scan_f_cannot_open_input=02012_F_Nie mo¾na otworzy† pliku $1 +% \fpc cannot find the program or unit source file you specified on the +% command line. +scan_f_cannot_open_includefile=02013_F_Nie mo¾na otworzy† pliku include $1 +% \fpc cannot find the source file you specified in a \var{\{\$include ..\}} +% statement. +scan_w_only_pack_records=02015_W_Pola rekord¢w mog¥ by† wyr¢wnane tylko do 1,2,4,8,16 lub 32 bajt¢w +% You are specifying the \var{\{\$PACKRECORDS n\} } or \var{\{\$ALIGN n\} } +% with an illegal value for \var{n}. For $PACKRECORDS valid alignments are 1, 2, 4, 8, 16, 32, C, +% NORMAL, DEFAULT, and for $ALIGN valid alignment are 1, 2, 4, 8, 16, 32, ON, +% OFF. Under mode MacPas $ALIGN also supports MAC68K, POWER and RESET. +scan_w_only_pack_enum=02016_W_Wyliczenia mog¥ by† zapisane tylko na 1, 2 lub 4 bajtach +% You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for +% \var{n}. Only 1,2 or 4 are valid in this case. +scan_e_endif_expected=02017_E_Oczekiwano $ENDIF dla $1 $2 zdefiniowanych w linii $3 +% Your conditional compilation statements are unbalanced. +scan_e_preproc_syntax_error=02018_E_Bˆ¥d skˆadni podczas parsowania dyrektyw kompilacji warunkowej +% There is an error in the expression following the \var{\{\$if ..\}} compiler +% directive. +scan_e_error_in_preproc_expr=02019_E_Bˆ¥d obliczania wyra¾enia kompilacji warunkowej +% There is an error in the expression following the \var{\{\$if ..\}} compiler +% directive. +scan_w_macro_cut_after_255_chars=02020_W_Tre˜† makra zostaˆa obci©ta po 255 znaku +% The contents of macros canno be longer than 255 characters. +scan_e_endif_without_if=02021_E_ENDIF bez IF(N)DEF +% Your \var{\{\$IFDEF ..\}} and {\{\$ENDIF\}} statements aren't balanced. +scan_f_user_defined=02022_F_Zdefiniowany przez u¾ytkownika: $1 +% A user defined fatal error occurred. see also the \progref +scan_e_user_defined=02023_E_Zdefiniowany przez u¾ytkownika: $1 +% A user defined error occurred. see also the \progref +scan_w_user_defined=02024_W_Zdefiniowane przez u¾ytkownika: $1 +% A user defined warning occurred. see also the \progref +scan_n_user_defined=02025_N_Zdefiniowana przez u¾ytkownika: $1 +% A user defined note was encountered. see also the \progref +scan_h_user_defined=02026_H_Zdefiniowana przez u¾ytkownika: $1 +% A user defined hint was encountered. see also the \progref +scan_i_user_defined=02027_I_Zdefiniowana przez u¾ytkownika: $1 +% User defined information was encountered. see also the \progref +scan_e_keyword_cant_be_a_macro=02028_E_Sˆowo kluczowe nie mo¾e zosta† przedefiniowane przez makro +% You cannot redefine keywords with macros. +scan_f_macro_buffer_overflow=02029_F_Przepeˆnienie bufora podczas czytania lub rozwijania makra +% Your macro or its result was too long for the compiler. +scan_e_macro_deep_ten=02030_E_Rozwijanie makra przerwane po 16 rozwini©ciach. +% When expanding a macro macros have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_e_wrong_styled_switch=02031_E_Przeˆ¥czniki kompilatora nie s¥ dozwolone w komentarzach typu (* ... *) +% Compiler switches should always be between \var{\{ \}} comment delimiters. +scan_d_handling_switch=02032_D_Obsˆugiwanie przeˆ¥cznika "$1" +% When you set debugging info on (\var{-vd}) the compiler tells you when it +% is evaluating conditional compile statements. +scan_c_endif_found=02033_C_Znaleziono ENDIF $1 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifdef_found=02034_C_Znaleziono IFDEF $1 , $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifopt_found=02035_C_Znalezino IFOPT $1 , $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_if_found=02036_C_Znaleziono IF $1 , $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifndef_found=02037_C_Znaleziono IFNDEF $1 , $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_else_found=02038_C_Znaleziono ELSE $1 , $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_skipping_until=02039_C_Omijanie... +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements, and whether it is skipping or +% compiling parts. +scan_i_press_enter=02040_I_Naci˜nij <enter> aby kontynuowa† +% When the \var{-vi} switch is used, the compiler stops compilation +% and waits for the \var{Enter} key to be pressed when it encounters +% a \var{\{\$STOP\}} directive. +scan_w_unsupported_switch=02041_W_Nieobsˆugiwany przeˆ¥cznik $1 +% When warnings are turned on (\var{-vw}) the compiler warns you about +% unsupported switches. This means that the switch is used in Delphi or +% Turbo Pascal, but not in \fpc +scan_w_illegal_directive=02042_W_Nieprawidˆowa dyrektywa $1 +% When warings are turned on (\var{-vw}) the compiler warns you about +% unrecognised switches. For a list of recognised switches, \progref +scan_t_back_in=02043_TL_Z powrotem w $1 +% When you use (\var{-vt}) the compiler tells you when it has finished +% reading an include file. +scan_w_unsupported_app_type=02044_W_Nieprawidˆowy typ aplikacji: $1 +% You get this warning, if you specify an unknown application type +% with the directive \var{\{\$APPTYPE\}} +scan_w_app_type_not_support=02045_W_Typ aplikacji nieobsˆugiwany przez docelowy OS +% The \var{\{\$APPTYPE\}} directive is supported by win32 applications only. +scan_w_description_not_support=02046_W_Dyrektywa DESCRIPTION jest obsˆugiwany tylko przez OS2 i Win32 +% The \var{\{\$DESCRIPTION\}} directive is only supported for OS2 and Win32 targets. +scan_n_version_not_support=02047_N_Dyrektywa VERSION nie jest obsˆugiwana przez OS +% The \var{\{\$VERSION\}} directive is only supported by win32 target. +scan_n_only_exe_version=02048_N_Dyrektywa VERSION jest dost©na tylko dla program¢w i DLLi +% The \var{\{\$VERSION\}} directive is only used for executable or DLL sources. +scan_w_wrong_version_ignored=02049_W_Nieprawidˆowy format dyrektywy VERSION $1 +% The \var{\{\$VERSION\}} directive format is majorversion.minorversion +% where majorversion and minorversion are words. +scan_w_unsupported_asmmode_specifier=02050_W_Nieprawidˆowy styl asemblera $1 +% When you specify an assembler mode with the \var{\{\$ASMMODE xxx\}} +% the compiler didn't recognize the mode you specified. +scan_w_no_asm_reader_switch_inside_asm=02051_W_Przeˆ¥cznik stylu asemblera niedozwolony w bloku asemblera, $1 b©dzie dziaˆa† dopiero w nast©pnym bloku +% It is not possible to switch from one assembler reader to another +% inside an assmebler block. The new reader will be used for next +% assembler statement only. +scan_e_wrong_switch_toggle=02052_E_Zˆa warto˜† przeˆ¥cznika, u¾yj ON/OFF lub +/- +% You need to use ON or OFF or a + or - to toggle the switch +scan_e_resourcefiles_not_supported=02053_E_Pliki zasob¢w nie s¥ obsˆugiwane przez OS +% The target you are compiling for doesn't support resource files. +scan_w_include_env_not_found=02054_W_Zmienna ˜rodowiskowa $1 nie odnaleziona +% The included environment variable can't be found in the environment, it'll +% be replaced by an empty string instead. +scan_e_invalid_maxfpureg_value=02055_E_Nieprawidˆowa warto˜† limitu rejestru FPU +% Valid values for this directive are 0..8 and NORMAL/DEFAULT +scan_w_only_one_resourcefile_supported=02056_W_Tylko jeden plik zasob¢w jest obsˆugiwany przez docelowy OS +% The target you are compiling for supports only one resource file. +% The first resource file found is used, the others are discarded. +scan_w_macro_support_turned_off=02057_W_Obsˆuga makr jest wyˆ¥czona +% A macro declaration has been found, but macro support is currently off, +% so the declaration will be ignored. To turn macro support on compile with +% -Sm on the commandline or add {$MACRO ON} in the source +scan_e_invalid_interface_type=02058_E_Nieprawidˆowy typ interfejsu. Prawidˆowe s¥ COM, CORBA i DEFAULT. +% The interface type that was specified is not supported +scan_w_appid_not_support=02060_W_APPNAME jest obsˆugiwane tylko przez PalmOS +% The \var{\{\$APPID\}} directive is only supported for the PalmOS target. +scan_w_appname_not_support=02061_W_Dyrektywa APPNAME jest obsˆugiwana tylko przez PalmOS +% The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target. +scan_e_string_exceeds_255_chars=02061_E_Staˆe ˆaäcuchowe nie mog¥ by† dˆu¾sze ni¾ 255 znak¢w +% A single string constant can contain at most 255 chars. Try splitting up the +% string in multiple smaller parts and concatenate them with a + operator. +scan_f_include_deep_ten=02062_F_Przekroczono maksymaln¥ ilo˜† zagnie¾d¾onych include (16) +% When including include files the files have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_e_too_many_push=02063_F_Zbyt du¾o poziom¢w PUSH +% A maximum of 20 levels is allowed. This error occurs only in mode MacPas. +scan_e_too_many_pop=02064_E_Napotkano POP bez poprzedzaj¥cego go PUSH +% This error occurs only in mode MacPas. +scan_e_error_macro_lacks_value=02065_E_Makro lub zmienna "$1" nie ma przypisanej warto˜ci +% Thus the conditional compile time expression cannot be evaluated. +scan_e_wrong_switch_toggle_default=02066_E_Nieprawidˆowy przeˆ¥cznik, u¾yj ON/OFF/DEFAULT lub +/-/* +% You need to use ON or OFF or DEFAULT or a + or - or * to toggle the switch +scan_e_mode_switch_not_allowed=02067_E_Przeˆ¥cznik trybu "$1" jest niedozwolony w tym miejscu +% A mode switch has already been encountered, or, in case of option -Mmacpas, +% a mode switch occur after UNIT. +scan_e_error_macro_undefined=02068_E_Zmienna "$1" jest niezdefiniowana +% Thus the conditional compile time expression cannot be evaluated. +scan_e_utf8_bigger_than_65535=02069_E_Napotkano kod UTF-8 wi©kszy od 65535 +% \fpc handles utf-8 strings internally as widestrings e.g. the char codes are limited to 65535 +scan_e_utf8_malformed=02070_E_Znieksztaˆcony string UTF-8 +% The given string isn't a valid UTF-8 string +scan_c_switching_to_utf8=02071_C_Napotkano sygnatur© UTF-8, u¾ycie kodowania UTF-8 +% The compiler found an UTF-8 encoding signature ($ef, $bb, $bf) at the beginning of a file, +% so it interprets it as an UTF-8 file +% \end{description} +# +# Parser +# +# 03192 is the last used one +# +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your pascal constructs +% are correct. +% \begin{description} +parser_e_syntax_error=03000_E_Parser - Bˆ¥d skˆadni +% An error against the Turbo Pascal language was encountered. This happens +% typically when an illegal character is found in the sources file. +parser_e_dont_nest_interrupt=03004_E_Procedura typu INTERRUPT nie mo¾e by† zagnie¾d¾ona +% An \var{INTERRUPT} procedure must be global. +parser_w_proc_directive_ignored=03005_W_Dyrektywa $1 zignorowana +% The specified is ignored by FPC programs. +parser_e_no_overload_for_all_procs=03006_E_Nie wszystkie deklaracje $1 s¥ przeci¥¾one +% When you want to use overloading using the \var{OVERLOAD} directive, then +% all declarations need to have \var{OVERLOAD} specified. +parser_e_export_name_double=03008_E_Zduplikowana nazwa eksportu $1 +% Exported function names inside a specific DLL must all be different +parser_e_export_ordinal_double=03009_E_Zduplikowany indeks eksportowanej funkcji $1 +% Exported function names inside a specific DLL must all be different +parser_e_export_invalid_index=03010_E_Nieprawidˆowa warto˜† indeksu funkcji +% DLL function index must be in the range \var{1..\$FFFF} +parser_w_parser_reloc_no_debug=03011_W_Informacje debugera w DLLu lub programie $1 nie dziaˆaj¥, wyˆ¥czone. +parser_w_parser_win32_debug_needs_WN=03012_W_Aby m¢c debugowa† kod win32 musisz wyˆ¥czy† generowanie kodu relokacji przeˆ¥cznikiem -WN +% Stabs info is wrong for relocatable DLL or EXES use -WN +% if you want to debug win32 executables. +parser_e_constructorname_must_be_init=03013_E_Konstruktor musi nazywa† si© INIT +% You are declaring a constructor with a name which isn't \var{init}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_destructorname_must_be_done=03014_E_Destruktor musi nazywa† si© DONE +% You are declaring an object destructor with a name which is not \var{done}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_proc_inline_not_supported=03016_E_Typ INLINE nieobsˆugiwany (u¾yj opcji -Si) +% You tried to compile a program with C++ style inlining, and forgot to +% specify the \var{-Si} option (\seeo{Si}). The compiler doesn't support C++ +% styled inlining by default. +parser_w_constructor_should_be_public=03018_W_Konstruktor powinien by† publiczny +% Constructors must be in the 'public' part of an object (class) declaration. +parser_w_destructor_should_be_public=03019_W_Destruktor powinien by† publiczny +% Destructors must be in the 'public' part of an object (class) declaration. +parser_n_only_one_destructor=03020_N_Klasa powinna mie† tylko jeden destruktor +% You can declare only one destructor for a class. +parser_e_no_local_objects=03021_E_Definicje lokalne w klasie s¥ niedozwolone +% Classes must be defined globally. They cannot be defined inside a +% procedure or function +parser_f_no_anonym_objects=03022_F_Definicje anonimowych klas s¥ niedozwolone +% An invalid object (class) declaration was encountered, i.e. an +% object or class without methods that isn't derived from another object or +% class. For example: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% will trigger this error. +parser_object_has_no_vmt=03023_E_Obiekt $1 nie posiada VMT +% This is a note indicating that the declared object has no +% virtual method table. +parser_e_illegal_parameter_list=03024_E_Nieprawidˆowa lista parametr¢w +% You are calling a function with parameters that are of a different type than +% the declared parameters of the function. +parser_e_wrong_parameter_size=03026_E_Nieprawidˆowa ilo˜† parametr¢w +% There is an error in the parameter list of the function or procedure, +% the number of parameters is not correct. +parser_e_overloaded_no_procedure=03027_E_Przeci¥¾ony identyfikator $1 nie jest funkcj¥ +% The compiler encountered a symbol with the same name as an overloaded +% function, but it is not a function it can overload. +parser_e_overloaded_have_same_parameters=03028_E_Przeci¥¾ona funkcja musi mie† chocia¾ jeden parametr wyr¢¾niaj¥cy +% You're declaring overloaded functions, but with the same parameter list. +% Overloaded function must have at least 1 different parameter in their +% declaration. +parser_e_header_dont_match_forward=03029_E_Nagˆ¢wek funkcji nie pasuje do deklaracji $1 +% You declared a function with same parameters but +% different result type or function modifiers. +parser_e_header_different_var_names=03030_E_Nagˆ¢wek funkcji $1 nie pasuje : nazwy parametr¢w zmienione $2 => $3 +% You declared the function in the \var{interface} part, or with the +% \var{forward} directive, but define it with a different parameter list. +parser_n_duplicate_enum=03031_N_Ci¥g warto˜ci typu wyliczeniowego musi by† rosn¥cy +% \fpc allows enumeration constructions as in C. Given the following +% declaration two declarations: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% The second declaration would produce an error. \var{A\_UAS} needs to have a +% value higher than \var{A\_E}, i.e. at least 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_With nie mo¾e by† u¾yte ze zmiennymi w innym segmencie +% With stores a variable locally on the stack, +% but this is not possible if the variable belongs to another segment. +parser_e_too_much_lexlevel=03034_E_Przekroczono limit zagnie¾d¾enia funkcji +% You can nest function definitions only 31 times. +parser_e_range_check_error=03035_E_Bˆ¥d zakresu podczas obliczania staˆej +% The constants are out of their allowed range. +parser_w_range_check_error=03036_W_Bˆ¥d zakresu podczas obliczania staˆej +% The constants are out of their allowed range. +parser_e_double_caselabel=03037_E_Zduplikowana etykieta w instrukcji case +% You are specifying the same label 2 times in a \var{case} statement. +parser_e_case_lower_less_than_upper_bound=03038_E_G¢rna granica zakresu jest mniejsza od dolnej +% The upper bound of a \var{case} label is less than the lower bound and this +% is useless +parser_e_type_const_not_possible=03039_E_Staˆa typowana nie mo¾e by† klas¥ ani obiektem +% You cannot declare a constant of type class or object. +parser_e_no_overloaded_procvars=03040_E_Do zmiennych proceduralnych nie mo¾na przypisa† przeci¥¾onych funkcji +% You are trying to assign an overloaded function to a procedural variable. +% This isn't allowed. +parser_e_invalid_string_size=03041_E_Dˆugo˜† stringa musi zawiera† si© mi©dzy 1 a 255 +% The length of a shortstring in Pascal is limited to 255 characters. You are +% trying to declare a string with length lower than 1 or greater than 255 +parser_w_use_extended_syntax_for_objects=03042_W_U¾yj rozszerzonej skˆadni NEW i DISPOSE dla obiekt¢w +% If you have a pointer \var{a} to a class type, then the statement +% \var{new(a)} will not initialize the class (i.e. the constructor isn't +% called), although space will be allocated. you should issue the +% \var{new(a,init)} statement. This will allocate space, and call the +% constructor of the class. +parser_w_no_new_dispose_on_void_pointers=03043_W_U¾ycie NEW lub DISPOSE nie ma sensu dla nietypowanych wska«nik¢w +parser_e_no_new_dispose_on_void_pointers=03044_E_U¾ycie NEW lub DISPOSE jest niemo¾liwe dla nietypowanych wska«nik¢w +% You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer +% because no size is associated to an untyped pointer. +% Accepted for compatibility in \var{tp} and \var{delphi} modes. +parser_e_class_id_expected=03045_E_Oczekiwano identyfikatora klasy +% This happens when the compiler scans a procedure declaration that contains +% a dot, +% i.e., a object or class method, but the type in front of the dot is not +% a known type. +parser_e_no_type_not_allowed_here=03046_E_Identyfikator typu jest niedozwolony w tym miejscu +% You cannot use a type inside an expression. +parser_e_methode_id_expected=03047_E_Oczekiwano identyfikatora metody +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_e_header_dont_match_any_member=03048_E_Nagˆ¢wek funkcji nie pasuje do ¾adnej metody tej klasy $1 +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_d_procedure_start=03049_DL_Procedura/Funkcja $1 +% When using the \var{-vp} switch, the compiler tells you when it starts +% processing a procedure or function implementation. +parser_e_error_in_real=03050_E_Nieprawidˆowa warto˜† staˆej zmiennoprzecinkowej +% The compiler expects a floating point expression, and gets something else. +parser_e_fail_only_in_constructor=03051_E_FAIL mo¾e by† u¾yte tylko w konstruktorach +% You are using the \var{FAIL} instruction outside a constructor method. +parser_e_no_paras_for_destructor=03052_E_Destruktory nie mog¥ mie† parametr¢w +% You are declaring a destructor with a parameter list. Destructor methods +% cannot have parameters. +parser_e_only_class_methods_via_class_ref=03053_E_Tylko metody klasy mog¥ by† wywoˆywane w ten spos¢b +% This error occurs in a situation like the following: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} is not a class method and hence cannot be called with a class +% reference. +parser_e_only_class_methods=03054_E_W metodach klasy mo¾esz u¾ywa† tylko metod klasy +% This is related to the previous error. You cannot call a method of an object +% from a inside a class method. The following code would produce this error: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% Because free is a normal method of a class it cannot be called from a class +% method. +parser_e_case_mismatch=03055_E_Staˆa i zmienna u¾yta w CASE nie s¥ tego samego typu +% One of the labels is not of the same type as the case variable. +parser_e_illegal_symbol_exported=03056_E_Symbol nie mo¾e by† wyeksportowany +% You can only export procedures and functions when you write a library. You +% cannot export variables or constants. +parser_w_should_use_override=03057_W_Dziedziczona metoda jest ukryta przez $1 +% A method that is declared \var{virtual} in a parent class, should be +% overridden in the descendent class with the \var{override} directive. If you +% don't specify the \var{override} directive, you will hide the parent method; +% you will not override it. +parser_e_nothing_to_be_overridden=03058_E_Nie ma takiej metody w dziedziczonej klasie: $1 +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_no_procedure_to_access_property=03059_E_Brak metody do odczytania wˆasno˜ci +% You specified no \var{read} directive for a property. +parser_w_stored_not_implemented=03060_W_Dyrektywa stored nie jest jeszcze zaimplementowana +% The \var{stored} directive is not yet implemented +parser_e_ill_property_access_sym=03061_E_Nieprawidˆowy symbol dla dost©pu do wˆasno˜ci +% There is an error in the \var{read} or \var{write} directives for an array +% property. When you declare an array property, you can only access it with +% procedures and functions. The following code woud cause such an error. +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_Nie mo¾na si© odwoˆywa† do pola protected obiektu w tym miejscu +% Fields that are declared in a \var{protected} section of an object or class +% declaration cannot be accessed outside the module wher the object is +% defined, or outside descendent object methods. +parser_e_cant_access_private_member=03063_E_Nie mo¾na si© odwoˆywa† do pola private obiektu w tym miejscu +% Fields that are declared in a \var{private} section of an object or class +% declaration cannot be accessed outside the module where the class is +% defined. +parser_e_overridden_methods_not_same_ret=03066_E_Przeci¥¾one metody wirtualne powinny mie† taki sam typ zwracanych warto˜ci: "$2" jest przeci¥¾one przez "$" o innym zwracanym typie +% If you declare overridden methods in a class definition, they must +% have the same return type. +parser_e_dont_nest_export=03067_E_Eksportowane funkcje nie mog¥ by† zagnie¾d¾one +% You cannot declare a function or procedure within a function or procedure +% that was declared as an export procedure. +parser_e_methods_dont_be_export=03068_E_Metody nie mog¥ by† eksportowane +% You cannot declare a procedure that is a method for an object as +% \var{export}ed. That is, your methods cannot be called from a C program. +parser_e_call_by_ref_without_typeconv=03069_E_Przy przekazywaniu przez referencj© parametry musz¥ by† tego samego typu: Otrzymano $1, a oczekiwano $2 +% When calling a function declared with \var{var} parameters, the variables in +% the function call must be of exactly the same type. There is no automatic +% type conversion. +parser_e_no_super_class=03070_E_Ta klasa nie jest przodkiem bie¾¥cej klasy +% When calling inherited methods, you are trying to call a method of a strange +% class. You can only call an inherited method of a parent class. +parser_e_self_not_in_method=03071_E_SELF jest dost©pne tylko w metodach +% You are trying to use the \var{self} parameter outside an object's method. +% Only methods get passed the \var{self} parameters. +parser_e_generic_methods_only_in_methods=03072_E_Metody mog¥ by† wywoˆane bezpo˜rednio identyfikatorem typu klasy tylko w innych metodach +% A construction like \var{sometype.somemethod} is only allowed in a method. +parser_e_illegal_colon_qualifier=03073_E_Nieprawidˆowe u¾ycie ':' +% You are using the format \var{:} (colon) 2 times on an expression that +% is not a real expression. +parser_e_illegal_set_expr=03074_E_Bˆ¥d zakresu lub zduplikowany element w deklaracji zbioru +% The declaration of a set contains an error. Either one of the elements is +% outside the range of the set type, either two of the elements are in fact +% the same. +parser_e_pointer_to_class_expected=03075_E_Oczekiwano wska«nika do obiektu +% You specified an illegal type in a \var{New} statement. +% The extended syntax of \var{new} needs an object as a parameter. +parser_e_expr_have_to_be_constructor_call=03076_E_Wyra¾enie musi by† wywoˆaniem konstruktora +% When using the extended syntax of \var{new}, you must specify the constructor +% method of the object you are trying to create. The procedure you specified +% is not a constructor. +parser_e_expr_have_to_be_destructor_call=03077_E_Wyra¾enie musi by† wywoˆaniem destruktora +% When using the extended syntax of \var{dispose}, you must specify the +% destructor method of the object you are trying to dispose of. +% The procedure you specified is not a destructor. +parser_e_invalid_record_const=03078_E_Nieprawidˆowa kolejno˜† element¢w rekordu +% When declaring a constant record, you specified the fields in the wrong +% order. +parser_e_false_with_expr=03079_E_Wyra¾enie musi by† rekordem lub klas¥ +% A \var{with} statement needs an argument that is of the type \var{record} +% or \var{class}. You are using \var{with} on an expression that is not of +% this type. +parser_e_void_function=03080_E_Procedury nie mog¥ zwraca† warto˜ci +% In \fpc, you can specify a return value for a function when using +% the \var{exit} statement. This error occurs when you try to do this with a +% procedure. Procedures cannot return a value. +parser_e_only_methods_allowed=03081_E_Konstruktory, destruktory i class operators musz¥ by† metodami +% You're declaring a procedure as destructor, constructor or class operator, when the +% procedure isn't a class method. +parser_e_operator_not_overloaded=03082_E_Operator nie jest przeci¥¾ony +% You're trying to use an overloaded operator when it isn't overloaded for +% this type. +parser_e_no_such_assignment=03083_E_Nie mo¾a przeci¥¾y† przypisania dla takich samych typ¢w +% You can not overload assignment for types +% that the compiler considers as equal. +parser_e_overload_impossible=03084_E_Niemo¾liwe przeci¥¾enie operatora +% The combination of operator, arguments and return type are +% incompatible. +parser_e_no_reraise_possible=03085_E_Ponowne wywoˆanie wyj¥tku niemo¾liwe w tym miejscu +% You are trying to raise an exception where it isn't allowed. You can only +% raise exceptions in an \var{except} block. +parser_e_no_new_or_dispose_for_classes=03086_E_Rozszerzona skˆadnia new i dispose jest niedozwolona dla klas +% You cannot generate an instance of a class with the extended syntax of +% \var{new}. The constructor must be used for that. For the same reason, you +% cannot call \var{Dispose} to de-allocate an instance of a class, the +% destructor must be used for that. +parser_e_procedure_overloading_is_off=03088_E_Przeci¥¾anie procedur jest wyˆ¥czone +% When using the \var{-So} switch, procedure overloading is switched off. +% Turbo Pascal does not support function overloading. +parser_e_overload_operator_failed=03089_E_Przeci¥¾enie tego operatora jest niemo¾liwe +% You are trying to overload an operator which cannot be overloaded. +% The following operators can be overloaded : +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_Operator por¢wnania musi zwraca† warto˜† typu Boolean +% When overloading the \var{=} operator, the function must return a boolean +% value. +parser_e_only_virtual_methods_abstract=03091_E_Tylko metody wirtualne mog¥ by† abstrakcyjne +% You are declaring a method as abstract, when it isn't declared to be +% virtual. +parser_f_unsupported_feature=03092_F_U¾ycie nieobsˆugiwanej funkcji kompilatora! +% You're trying to force the compiler into doing something it cannot do yet. +parser_e_mix_of_classes_and_objects=03093_E_Mieszanie r¢¾nych typ¢w obiekt¢w (obiekt¢w, klas, interfejs¢w) jest niedozwolone +% You cannot derive \var{objects}, \var{classes}, \var{cppclasses} and \var{interfaces} interttwined . E.g. +% a class cannot have an object as parent and vice versa. +parser_w_unknown_proc_directive_ignored=03094_W_Nieznana dyrektywa procedury zostaˆa zignorowana: $1 +% The procedure directive you specified is unknown. +parser_e_absolute_only_one_var=03095_E_Absolute mo¾e by† powi¥zane tylko z jedn¥ zmienn¥ +% You cannot specify more than one variable before the \var{absolute} directive. +% Thus, the following construct will provide this error: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +% \item [ absolute can only be associated a var or const ] +% The address of a \var{absolute} directive can only point to a variable or a +% typed constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_absolute_only_to_var_or_const=03096_E_Absolute mo¾e by† u¾yte tylko w stosunku do zmiennej lub staˆej +% The address of a \var{absolute} directive can only point to a variable or +% constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_initialized_only_one_var=03097_E_Tylko jedna zmienna mo¾e by† zainicjowana +% You cannot specify more than one variable with a initial value +% in Delphi mode. +parser_e_abstract_no_definition=03098_E_Metody abstrakcyjne nie mog¥ by† zaimplementowane +% Abstract methods can only be declared, you cannot implement them. They +% should be overridden by a descendant class. +parser_e_overloaded_must_be_all_global=03099_E_Ta przeci¥¾ona funkcja nie mo¾e by† lokalna (musi by† wyeksportowana) +% You are defining a overloaded function in the implementation part of a unit, +% but there is no corresponding declaration in the interface part of the unit. +parser_w_virtual_without_constructor=03100_W_Metody wirtualne u¾yte bez konstruktora $1 +% If you declare objects or classes that contain virtual methods, you need +% to have a constructor and destructor to initialize them. The compiler +% encountered an object or class with virtual methods that doesn't have +% a constructor/destructor pair. +parser_c_macro_defined=03101_CL_Makro zdefiniowane: $1 +% When \var{-vm} is used, the compiler tells you when it defines macros. +parser_c_macro_undefined=03102_CL_Makro wymazane: $1 +% When \var{-vm} is used, the compiler tells you when it undefines macros. +parser_c_macro_set_to=03103_CL_Makro $1 ustawione na $2 +% When \var{-vm} is used, the compiler tells you what values macros get. +parser_i_compiling=03104_I_Kompilowanie $1 +% When you turn on information messages (\var{-vi}), the compiler tells you +% what units it is recompiling. +parser_u_parsing_interface=03105_UL_Parsowanie cz©˜ci interface moduˆu $1 +% This tells you that the reading of the interface +% of the current unit starts +parser_u_parsing_implementation=03106_UL_Parsowanie cz©˜ci implementation moduˆu $1 +% This tells you that the code reading of the implementation +% of the current unit, library or program starts +parser_d_compiling_second_time=03107_DL_Kompilowanie $1 po raz drugi +% When you request debug messages (\var{-vd}) the compiler tells you what +% units it recompiles for the second time. +parser_e_no_property_found_to_override=03109_E_Nie znaleziono wˆasno˜ci do przeci¥¾enia +% You want to overrride a property of a parent class, when there is, in fact, +% no such property in the parent class. +parser_e_only_one_default_property=03110_E_Dozwolona jest tylko jedna wˆasno˜† domy˜lna, a znaleziono odziedziczon¥ wˆasno˜† domy˜ln¥ $1 +% You specified a property as \var{Default}, but a parent class already has a +% default property, and a class can have only one default property. +parser_e_property_need_paras=03111_E_Wˆasno˜ci¥ domy˜ln¥ musi by† tablica +% Only array properties of classes can be made \var{default} properties. +parser_e_constructor_cannot_be_not_virtual=03112_E_Wirtualne konstruktory s¥ dost©pne tylko w klasach +% You cannot have virtual constructors in objects. You can only have them +% in classes. +parser_e_no_default_property_available=03113_E_Brak domy˜lnej wˆasno˜ci w tej klasie +% You are trying to access a default property of a class, but this class (or one of +% its ancestors) doesn't have a default property. +parser_e_cant_have_published=03114_E_Klasa nie mo¾e mie† sekcji published, u¾yj przeˆ¥cznika {$M+} +% If you want a \var{published} section in a class definition, you must +% use the \var{\{\$M+\}} switch, whch turns on generation of type +% information. +parser_e_forward_declaration_must_be_resolved=03115_E_Deklaracja naprz¢d klasy $1 musi by† rozwi¥zana, aby u¾y† klasy jako przodka innej klasy +% To be able to use an object as an ancestor object, it must be defined +% first. This error occurs in the following situation: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% Where \var{ParentClass} is declared but not defined. +parser_e_no_local_operator=03116_E_Lokalne przeci¥¾enia operator¢w niedost©pne +% You cannot overload locally, i.e. inside procedures or function +% definitions. +parser_e_proc_dir_not_allowed_in_interface=03117_E_Dyrektywa $1 niedozwolona w sekcji interface +% This procedure directive is not allowed in the \var{interface} section of +% a unit. You can only use it in the \var{implementation} section. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_Dyrektywa $1 niedozwolona w sekcji implementation +% This procedure directive is not defined in the \var{implementation} section of +% a unit. You can only use it in the \var{interface} section. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_Dyrektywa $1 niedozwolona w deklaracji typu proceduralnego +% This procedure directive cannot be part of a procedural or function +% type declaration. +parser_e_function_already_declared_public_forward=03120_E_Funkcja jest ju¾ zadeklarowana jako Public/Forward $1 +% You will get this error if a function is defined as \var{forward} twice. +% Or it is once in the \var{interface} section, and once as a \var{forward} +% declaration in the \var{implmentation} section. +parser_e_not_external_and_export=03121_E_Nie mo¾na u¾y† jednocze˜nie EXPORT i EXTERNAL +% These two procedure directives are mutually exclusive +parser_w_not_supported_for_inline=03123_W_$1 nieobsˆugiwane w procedurze/funkcji inline +% Inline procedures don't support this declaration. +parser_w_inlining_disabled=03124_W_Inline wyˆ¥czone +% Inlining of procedures is disabled. +parser_i_writing_browser_log=03125_I_Zapisywanie logu przegl¥darki $1 +% When information messages are on, the compiler warns you when it +% writes the browser log (generated with the \var{\{\$Y+ \}} switch). +parser_h_maybe_deref_caret_missing=03126_H_Mo¾liwe, ¾e brakuje dereferencji wska«nika +% The compiler thinks that a pointer may need a dereference. +parser_f_assembler_reader_not_supported=03127_F_Wybrany tryb asemblera nie jest obsˆugiwany +% The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not +% supported. The compiler can be compiled with or without support for a +% particular assembler reader. +parser_e_proc_dir_conflict=03128_E_Dyrektywa $1 koliduje z innymi dyrektywami +% You specified a procedure directive that conflicts with other directives. +% for instance \var{cdecl} and \var{pascal} are mutually exclusive. +parser_e_call_convention_dont_match_forward=03129_E_Konwencja wywoˆywania musi by† taka sama w cz©sci interface i implementation +% This error happens when you declare a function or procedure with +% e.g. \var{cdecl;} but omit this directive in the implementation, or vice +% versa. The calling convention is part of the function declaration, and +% must be repeated in the function definition. +parser_e_property_cant_have_a_default_value=03131_E_Ta wˆasno˜† nie mo¾e mie† domy˜lnej warto˜ci +% Set properties or indexed properties cannot have a default value. +parser_e_property_default_value_must_const=03132_E_Domy˜lna warto˜† wˆasno˜ci musi by† staˆ¥ +% The value of a \var{default} declared property must be known at compile +% time. The value you specified is only known at run time. This happens +% .e.g. if you specify a variable name as a default value. +parser_e_cant_publish_that=03133_E_Symbol nie mo¾e by† w sekcji published +% Only class type variables can be in a \var{published} section of a class +% if they are not declared as a property. +parser_e_cant_publish_that_property=03134_E_Ten typ warto˜ci nie mo¾e by† w sekcji published +% Properties in a \var{published} section cannot be array properties. +% they must be moved to public sections. Properties in a \var{published} +% section must be an ordinal type, a real type, strings or sets. +parser_e_empty_import_name=03136_W_Wymagana jest nazwa importu +% Some targets need a name for the imported procedure or a \var{cdecl} specifier +parser_e_division_by_zero=03138_E_Dzielenie przez zero +% There is a divsion by zero encounted +parser_e_invalid_float_operation=03139_E_Nieprawidˆowa operacja zmiennoprzecinkowa +% An operation on two real type values produced an overflow or a division +% by zero. +parser_e_array_lower_less_than_upper_bound=03140_E_G¢rna granica zakresu jest mniejsza od dolnej +% The upper bound of a an array declaration is less than the lower bound and this +% is not possible +parser_w_string_too_long=03141_W_String "$1" jest dˆu¾szy ni¾ $2 +% The size of the constant string is larger than the size you specified in +% string type definition +parser_e_string_larger_array=03142_E_Dˆugo˜† stringa jest wi©ksza ni¾ dˆugo˜† tablicy znak¢w +% The size of the constant string is larger than the size you specified in +% the array[x..y] of char definition +parser_e_ill_msg_expr=03143_E_Nieprawidˆowe wyra¾enie przy dyrektywie message +% \fpc supports only integer or string values as message constants +parser_e_ill_msg_param=03144_E_Funkcje obsˆuguj¥ce komunikaty (message) mog¥ pobiera† tylko jeden parametr przez referencj© +% A method declared with the \var{message}-directive as message handler +% can take only one parameter which must be declared as call by reference +% Parameters are declared as call by reference using the \var{var}-directive +parser_e_duplicate_message_label=03145_E_Zduplikowana etykieta komunikatu: $1 +% A label for a message is used twice in one object/class +parser_e_self_in_non_message_handler=03146_E_Self mo¾e by† parametrem tylko metod obsˆuguj¥cych komunikaty +% The self parameter can only be passed explicitly to a method which +% is declared as message handler. +parser_e_threadvars_only_sg=03147_E_Zmienne threadvar mog¥ by† tylko statyczne lub globalne +% Threadvars must be static or global, you can't declare a thread +% local to a procedure. Local variables are always local to a thread, +% because every thread has its own stack and local variables +% are stored on the stack +parser_f_direct_assembler_not_allowed=03148_F_Wstawki asemblera niedost©pne gdy wyj˜ciowym formatem jest wbudowane zapisywanie binarne +% You can't use direct assembler when using a binary writer, choose an +% other outputformat or use another assembler reader +parser_w_no_objpas_use_mode=03149_W_Nie ˆaduj moduˆu OBJPAS bezpo˜rednio - u¾yj trybu obiektowego (objfpc, delphi) +% You are trying to load the ObjPas unit manually from a uses clause. This is +% not a good idea. Use the \var{\{\$mode objfpc\}} or +% \var{\{\$mode delphi\}} +% directives which load the unit automatically +parser_e_no_object_override=03150_E_OVERRIDE nie mo¾e by† u¾yte dla obiekt¢w +% Override is not supported for objects, use \var{virtual} instead to override +% a method of a parent object +parser_e_cant_use_inittable_here=03151_E_Typy danych wymagaj¥ce inicjalizacji/finalizcji nie mog¥ by† u¾yte w rekordach z wariantami +% Some data type (e.g. \var{ansistring}) needs initialization/finalization +% code which is implicitly generated by the compiler. Such data types +% can't be used in the variant part of a record. +parser_e_resourcestring_only_sg=03152_E_Resourcestring mo¾e by† tylko statyczny lub globalny +% Resourcestring can not be declared local, only global or using the static +% directive. +parser_e_exit_with_argument_not__possible=03153_E_Exit z argumentem nie mo¾e by† tu u¾yte +% an exit statement with an argument for the return value can't be used here, this +% can happen e.g. in \var{try..except} or \var{try..finally} blocks +parser_e_stored_property_must_be_boolean=03154_E_Symbol przechowywania wˆasno˜ci musi by† typu boolean +% If you specify a storage symbol in a property declaration, it must be of +% the type boolean +parser_e_ill_property_storage_sym=03155_E_Ten symbol nie mo¾e by† symbolem przechowywania wˆasno˜ci +% You can't use this type of symbol as storage specifier in property +% declaration. You can use only methods with the result type boolean, +% boolean class fields or boolean constants +parser_e_only_publishable_classes_can__be_published=03156_E_Tylko klasy skompilowane w trybie $M+ mog¥ by† w sekcji published +% In the published section of a class can be only class as fields used which +% are compiled in \var{\{\$M+\}} or which are derived from such a class. Normally +% such a class should be derived from TPersitent +parser_e_proc_directive_expected=03157_E_Oczekiwano dyrektywy procedury +% When declaring a procedure in a const block you used a ; after the +% procedure declaration after which a procedure directive must follow. +% Correct declarations are: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_Warto˜† indeksu wˆasno˜ci musi by† typu porz¥dkowego +% The value you use to index a property must be of an ordinal type, for +% example an integer or enumerated type. +parser_e_procname_to_short_for_export=03159_E_Zbyt kr¢tka nazwa procedury, aby eksportowa† +% The length of the procedure/function name must be at least 2 characters +% long. This is because of a bug in dlltool which doesn't parse the .def +% file correct with a name of length 1. +parser_e_dlltool_unit_var_problem=03160_E_Nie mo¾na wygenerowa† pozycji DEFFILE dla zmiennych globalnych moduˆu +parser_e_dlltool_unit_var_problem2=03161_E_Skompiluj bez opcji -WD +% You need to compile this file without the -WD switch on the +% commandline +parser_f_need_objfpc_or_delphi_mode=03162_F_Aby skompilowa† ten moduˆ wymagany jest tryb ObjFpc (-S2) lub Delphi (-Sd) +% You need to use {$mode objfpc} or {$mode delphi} to compile this file. +% Or use the equivalent commandline switches -S2 or -Sd. +parser_e_no_export_with_index_for_target=03163_E_Nie mo¾na wyeksportowa† z indeksem pod $1 +% Exporting of functions or procedures with a specified index is not +% supported on this target. +parser_e_no_export_of_variables_for_target=03164_E_Nie mo¾na wyeksportowa† zmiennych pod $1 +% Exporting of variables is not supported on this target. +parser_e_improper_guid_syntax=03165_E_Nieprawidˆowa skˆadnia identyfikatora GUID +parser_w_interface_mapping_notfound=03168_W_Nie znaleziono procedury "$1", kt¢ra mogˆaby implementowa† $2.$3 +parser_e_interface_id_expected=03169_E_Oczekiwano interfejsu +% This happens when the compiler scans a \var{class} declaration that contains +% \var{interface} function name mapping code like this: +% \begin{verbatim} +% type +% TMyObject = class(TObject, IDispatch) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% and the \var{interface} before the dot not listed in the inheritance list. +parser_e_type_cant_be_used_in_array_index=03170_E_Typ "$1" nie mo¾e by† u¾yty jako indeks tablicy +% Types like \var{qword} or \var{int64} aren't allowed as array index type +parser_e_no_con_des_in_interfaces=03171_E_Konstruktory i destruktory s¥ niedozwolone w interfejsach +% Constructor and destructor declarations aren't allowed in interface +% In the most cases the method \var{QueryInterface} of \var{IUnknown} can +% be used to create a new interface. +parser_e_no_access_specifier_in_interfaces=03172_E_Okre˜lenia dost©pu nie mog¥ by† u¾yte w interfejsach +% The access specifiers \var{public}, \var{private}, \var{protected} and +% \var{pusblished} can't be used in interfaces because all methods +% of an interfaces must be public. +parser_e_no_vars_in_interfaces=03173_E_Interfejs nie mo¾e posiada† p¢l +% Declarations of fields aren't allowed in interfaces. An interface +% can contain only methods +parser_e_no_local_external=03174_E_Lokalne procedury nie mog¥ by† zadeklarowane jako EXTERNAL +% Declaring local procedures as external is not possible. Local procedures +% get hidden parameters that will make the chance of errors very high +parser_w_skipped_fields_before=03175_W_Niekt¢re pola przed "$1" nie zostaˆy zainicjalizowane +% In Delphi mode, not all fields of a typed constant record have to be +% initialized, but the compiler warns you when it detects such situations. +parser_e_skipped_fields_before=03176_E_Niekt¢re pola przed "$1" nie zostaˆy zainicjalizowane +% In all syntax modes but Delphi mode, you can't leave some fields uninitialized +% in the middle of a typed constant record +parser_w_skipped_fields_after=03177_W_Niekt¢re pola po "$1" nie zostaˆy zainicjalizowane +% You can leave some fields at the end of a type constant record uninitialized +% (the compiler will initialize them to zero automatically). This may be the cause +% of subtle problems. +parser_e_varargs_need_cdecl_and_external=03178_E_Dyrektywa VarArgs bez CDecl i External +% The varargs directive can only be used with procedures or functions +% that are declared with \var{cdecl} and \var{external} directives. The varargs directive +% is only meant to provide a compatible interface to C functions like printf. +parser_e_self_call_by_value=03179_E_Self musi by† normalnym parametrem (przekazywanym przez warto˜†) +% You can't declare self as a const or var parameter, it must always be +% a call-by-value parameter +parser_e_interface_has_no_guid=03180_E_Interfejs "$1" nie posiada identyfikatora GUID +% When you want to assign an interface to a constant, then the interface +% must have a GUID value set. +parser_e_illegal_field_or_method=03181_E_Nieznana metoda albo pole klasy "$1" +% Properties must refer to a field or method in the same class. +parser_w_proc_overriding_calling=03182_W_Zmiana sposobu wywoˆywania z "$1" na "$2" +% There are two directives in the procedure declaration that specify a calling +% convention. Only the last directive will be used +parser_e_no_procvarobj_const=03183_E_Typowane staˆe typu "procedure of object" mog¥ by† inicjowane tylko NILem +% You can't assign the address of a method to a typed constant which has a +% 'procedure of object' type, because such a constant requires two addresses: +% that of the method (which is known at compile time) and that of the object or +% class instance it operates on (which can not be known at compile time). +parser_e_default_value_only_one_para=03184_E_Domy˜lna warto˜† mo¾e by† przypisana tylko jednemu parametrowi +parser_e_default_value_expected_for_para=03185_E_Domy˜lna warto˜† wymagana dla "$1" +parser_w_unsupported_feature=03186_W_U¾ycie (jeszcze) nieobsˆugiwanej funkcji kompilatora! +% You're trying to force the compiler into doing something it cannot do yet. +parser_h_c_arrays_are_references=03187_H_Tablice C s¥ przekazywane przez referencj© +% Any array passed to a C functions is passed +% by a pointer (i.e. by reference). +parser_e_C_array_of_const_must_be_last=03188_E_Tablica staˆych musi by† ostatnim argumentem +% You can not add any other argument after an \var{array of const} for +% \var{cdecl} functions, as the size pushed on stack for this argument is +% not known. +parser_h_type_redef=03189_H_Powt¢rna definicja typu "$1" +% This is an indicator that a previously declared type is +% being redefined as something else. This may, or may not +% be, a cause for errors. +parser_w_cdecl_has_no_high=03190_W_Funkcje cdecl nie maj¥ parametru high +% Functions declared with cdecl modifier do not pass an extra implicit parameter. +parser_w_cdecl_no_openstring=03191_W_Funkcje cdecl nie obsˆuguj¥ open strings +%Openstring is not supported for cdecl'ared functions. +parser_e_initialized_not_for_threadvar=03192_E_Nie mo¾na zainicjalizowa† zmiennych zadeklarowanych jako threadvar +% Variables declared as threadvar can not be initialized with a default value. +% The variables will always be filled with zero at the start of a new thread. +parser_e_msg_only_for_classes=03193_E_Dyrektywa Message jest dozwolona tylko w klasach +% The message directive is only supported for Class types. +parser_e_procedure_or_function_expected=03194_E_Oczekiwano procedury lub funkcji +% A class method can only be specified for procedures and functions. +parser_e_illegal_calling_convention=03195_W_Dyrektywa "$1" zignorowana +% Some calling conventions are supported only by certain CPUs. I.e. most non-i386 ports support +% only the standard ABI calling convention of the CPU. +parser_e_no_object_reintroduce=03196_E_Nie mo¾na u¾y† REINTRODUCE dla obiekt¢w +% \var{reintroduce} is not supported for objects. +parser_e_paraloc_only_one_para=03197_E_Ka¾dy argument musi posiada† swoj¥ pozycj© +% If locations for arguments are specified explicitly as it is required by +% some syscall conventions, each argument must have it's only location, things +% like \var{procedure p(i,j : longint 'r1');} aren't allowed +parser_e_paraloc_all_paras=03198_E_Ka¾dy argument musi posiada† swoj¥ pozycj© +% If one argument has an explicit argument location, all arguments of a procedure +% must have one. +parser_e_illegal_explicit_paraloc=03199_E_Nieznana pozycja argumentu +% The location specified for an argument isn't recognized by the compiler +parser_e_32bitint_or_pointer_variable_expected=03200_E_Oczekiwano 32 bitowej liczby typu Integer albo wska«nika +% The libbase for MorphOS/AmigaOS can be give only as \var{longint}, \var{dword} or any pointer variable. +parser_e_goto_outside_proc=03201_E_Nie mo¾na u¾y† instrukcji GOTO pomi©dzy procedurami +% It isn't allowed to use the \var{goto} statements referencing labels outside the +% current procedure. The following example shows the problem: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1; +% +% procedure p2; +% begin +% goto l1; // This goto ISN'T allowed +% end; +% +% begin +% p2 +% l1: +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_Zbyt rozbudowana procedura, spr¢buj rozbi† j¥ na mniejsze +% Your procedure body is too long for the compiler. You should split the +% procedure into multiple smaller procedures. +parser_e_illegal_expression=03203_E_Nieprawidˆowe wyra¾enie +% This can occur under many circumstances. Mostly when trying to evaluate +% constant expressions. +parser_e_invalid_integer=03204_E_Nieprawidˆowe wyra¾enie (powinno zw¢ci† liczb© caˆkowit¥) +% You made an expression which isn't an integer, and the compiler expects the +% result to be an integer. +parser_e_invalid_qualifier=03205_E_Nieprawidˆowy kwalifikator +% One of the following is happening : +% \begin{itemize} +% \item You're trying to access a field of a variable that is not a record. +% \item You're indexing a variable that is not an array. +% \item You're dereferencing a variable that is not a pointer. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_G¢rna granica zakresu jest mniejsza od dolnej +% You are declaring a subrange, and the lower limit is higher than the high +% limit of the range. +parser_e_macpas_exit_wrong_param=03207_E_Parametr funkcji EXIT musi by† nazw¥ procedury, w kt¢rej jej u¾yto +% Non local exit is not allowed. This error occurs only in mode MacPas. +parser_e_illegal_assignment_to_count_var=03208_E_Nieprawidˆowe przypisanie do licznika p©tli "$1" +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +parser_e_no_local_var_external=03209_E_Lokalne zmienne nie mog¥ by† zadeklarowane jako EXTERNAL +% Declaring local variables as external is not allowed. Only global variables can reference +% to external variables. +parser_e_proc_already_external=03210_E_Procedura ju¾ zadeklarowana jako EXTERNAL +% The procedure is already declared with the EXTERNAL directive in an interface or +% forward declaration. +parser_w_implicit_uses_of_variants_unit=03211_W_Dopisanie moduˆu Variants do sekcji uses +% The Variant type is used in the unit without any used unit using the Variants unit. The +% compiler has implicitly added the Variants unit to the uses list. To remove this warning +% the Variants unit needs to be added to the uses statement. +parser_e_no_static_method_in_interfaces=03212_E_Metody statyczne nie mog¥ by† u¾yte w interfejsach +% The specifier \var{class} and directive \var{static} can't be used in interfaces +% because all methods of an interfaces must be public. +parser_e_arithmetic_operation_overflow=03213_E_Wyst¥piˆo przepeˆnienie w operacji arytmetycznej +% An operation on two integers values produced an overflow +parser_e_protected_or_private_expected=03214_E_Oczekiwano "protected" albo "private" +% \var{strict} can be only used together with \var{protected} or \var{private}. +% \end{description} +# +# Type Checking +# +# 04049 is the last one used +# +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +type_e_mismatch=04000_E_Nieprawidˆowy typ +% This can happen in many cases: +% \begin{itemize} +% \item The variable you're assigning to is of a different type than the +% expression in the assignment. +% \item You are calling a function or procedure with parameters that are +% incompatible with the parameters in the function or procedure definition. +% \end{itemize} +type_e_incompatible_types=04001_E_Niezgodno˜† typ¢w: otrzymano "$1" oczekiwano "$2" +% There is no conversion possible between the two types +% Another possiblity is that they are declared in different +% declarations: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { This statement gives also this error, it +% is due the strict type checking of pascal } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_Niezgodno˜† typ¢w pomi©dzy $1 i $2 +% The types are not equal +type_e_type_id_expected=04003_E_Oczekiwano identyfikatora typu +% The identifier is not a type, or you forgot to supply a type identifier. +type_e_variable_id_expected=04004_E_Oczekiwano identyfikatora zmiennej +% This happens when you pass a constant to a routine (such as \var{Inc} var or \var{Dec}) +% when it expects a variable. You can only pass variables as arguments to these functions. +type_e_integer_expr_expected=04005_E_Oczekiwano wyra¾enia caˆkowitego, ale otrzymano "$1" +% The compiler expects an expression of type integer, but gets a different +% type. +type_e_boolean_expr_expected=04006_E_Oczekiwano wyra¾enia logicznego, ale otrzymano "$1" +% The expression must be a boolean type, it should be return true or +% false. +type_e_ordinal_expr_expected=04007_E_Oczekiwano wyra¾enia porz¥dkowego +% The expression must be of ordinal type, i.e., maximum a \var{Longint}. +% This happens, for instance, when you specify a second argument +% to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value. +type_e_pointer_type_expected=04008_E_Oczekiwano wska«nika, ale otrzymano "$1" +% The variable or expression isn't of the type \var{pointer}. This +% happens when you pass a variable that isn't a pointer to \var{New} +% or \var{Dispose}. +type_e_class_type_expected=04009_E_Oczekiwano klasy, ale otrzymano "$1" +% The variable of expression isn't of the type \var{class}. This happens +% typically when +% \begin{enumerate} +% \item The parent class in a class declaration isn't a class. +% \item An exception handler (\var{On}) contains a type identifier that +% isn't a class. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_Nie mo¾na obliczy† warto˜ci wyra¾enia +% This error can occur when the bounds of an array you declared does +% not evaluate to ordinal constants +type_e_set_element_are_not_comp=04012_E_Niekompatybilne elementy zbioru +% You are trying to make an operation on two sets, when the set element types +% are not the same. The base type of a set must be the same when taking the +% union +type_e_set_operation_unknown=04013_E_Operacja niezaimplementowana dla zbioru +% several binary operations are not defined for sets +% like div mod ** (also >= <= for now) +type_w_convert_real_2_comp=04014_W_Konwersja typu zmiennoprzecinkowego do caˆkowitego typu COMP +% An implicit type conversion from a real type to a \var{comp} is +% encountered. Since \var{Comp} is a 64 bit integer type, this may indicate +% an error. +type_h_use_div_for_int=04015_H_U¾yj DIV zamiast '/' aby wynik byˆ caˆkowity +% When hints are on, then an integer division with the '/' operator will +% procuce this message, because the result will then be of type real +type_e_strict_var_string_violation=04016_E_Typy string¢w nie pasuj¥ z powodu trybu $V+ +% When compiling in \var{\{\$V+\}} mode, the string you pass as a parameter +% should be of the exact same type as the declared parameter of the procedure. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_Succ i Pred nie dziaˆaj¥ dla wyliczeä z przypisaniami +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use the \var{Succ} or \var{Pred} functions on them. +type_e_cant_read_write_type=04018_E_Nie mo¾na zapisa† lub odczyta† zmiennych tego typu +% You are trying to \var{read} or \var{write} a variable from or to a +% file of type text, which doesn't support that. Only integer types, +% reals, pchars and strings can be read from/written to a text file. +% Booleans can only be written to text files. +type_e_no_readln_writeln_for_typed_file=04019_E_Nie mo¾na u¾y† readln ani writeln na pliku tego typu +% \var{readln} and \var{writeln} are only allowed for text files. +type_e_no_read_write_for_untyped_file=04020_E_Nie mo¾na u¾y† readln ani writeln na nietypowanym pliku +% \var{read} and \var{write} are only allowed for text or typed files. +type_e_typeconflict_in_set=04021_E_Konflikt typ¢w pomi©dzy elementami zbioru +% There is at least one set element which is of the wrong type, i.e. not of +% the set type. +type_w_maybe_wrong_hi_lo=04022_W_lo/hi(dword/qword) zwraca starsze/mˆodsze sˆowo/podw¢jne sˆowo +% \fpc supports an overloaded version of \var{lo/hi} for \var{longint/dword/int64/qword} +% which returns the lower/upper word/dword of the argument. TP always uses +% a 16 bit \var{lo/hi} which returns always bits 0..7 for \var{lo} and the +% bits 8..15 for \var{hi}. If you want the TP behavior you have +% to type cast the argument to \var{word/integer} +type_e_integer_or_real_expr_expected=04023_E_Oczekiwano wyra¾enia caˆkowitego lub zmiennoprzecinkowego +% The first argument to \var{str} must a real or integer type. +type_e_wrong_type_in_array_constructor=04024_E_Nieprawidˆowy typ $1 w konstruktorze tablicy +% You are trying to use a type in an array constructor which is not +% allowed. +type_e_wrong_parameter_type=04025_E_Nieprawidˆowy typ parametru nr $1: Otrzymano $2, a oczekiwano $3 +% You are trying to pass an invalid type for the specified parameter. +type_e_no_method_and_procedure_not_compatible=04026_E_Metoda i Procedura nie s¥ zgodne (jako zmienne) +% You can't assign a method to a procedure variable or a procedure to a +% method pointer. +type_e_wrong_math_argument=04027_E_Nieprawidˆowa staˆa przekazana do wbudowanej funkcji matematycznej +% The constant argument passed to a ln or sqrt function is out of +% the definition range of these functions. +type_e_no_addr_of_constant=04028_E_Nie mo¾na pobra† adresu staˆej +% It's not possible to get the address of a constant, because they +% aren't stored in memory, you can try making it a typed constant. +type_e_argument_cant_be_assigned=04029_E_Ten argument nie mo¾e by† przekazany przez referencj© +% Only expressions which can be on the left side of an +% assignment can be passed as call by reference argument +% Remark: Properties can be only +% used on the left side of an assignment, but they can't be used as arguments +type_e_cannot_local_proc_to_procvar=04030_E_Nie mo¾na przypisa† lokalnej procedury/funkcji do zmiennej proceduralnej +% It's not allowed to assign a local procedure/function to a +% procedure variable, because the calling of local procedure/function is +% different. You can only assign local procedure/function to a void pointer. +type_e_no_assign_to_addr=04031_E_Nie mo¾na przypisa† warto˜ci adresowi +% It is not allowed to assign a value to an address of a variable, constant, +% procedure or function. You can try compiling with -So if the identifier +% is a procedure variable. +type_e_no_assign_to_const=04032_E_Nie mo¾na staˆej przypisa† warto˜ci +% It's not allowed to assign a value to a variable which is declared +% as a const. This is normally a parameter declared as const, to allow +% changing the value make the parameter as a value parameter or a var. +type_e_array_required=04033_E_Dozwolone tylko dla tablic +% If you are accessing a variable using an index '[<x>]' then +% the type must be an array. In FPC mode also a pointer is allowed. +type_e_interface_type_expected=04034_E_Oczekiwano interfejsu ale otrzymano "$1" +type_w_mixed_signed_unsigned=04035_W_U¾ywanie zmiennych typu Cardinal w wyra¾eniach ze znakiem daje 64bitowy wynik +% If you divide (or calculate the modulus of) a signed expression by a longword (or vice versa), +% or if you have overflow and/or range checking turned on and use an arithmetical +% expression (+, -, *, div, mod) in which both signed numbers and longwords appear, +% then everything has to be evaluated in 64bit which is slower than normal +% 32bit arithmetic. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_w_mixed_signed_unsigned2=04036_W_U¾ywanie zmiennych typu Cardinal w wyra¾eniach ze znakiem mo¾e spowodowa† bˆ¥d zakresu w tym miejscu +% If you use a binary operator (and, or, xor) and one of +% the operands is a cardinal while the other one is a signed expression, then, +% if range checking is turned on, you may get a range check error because in +% such a case both operands are converted to cardinal before the operation is +% carried out. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_e_typecast_wrong_size_for_assignment=04037_E_Rzutowanie typ¢w r¢¾nych rozmiar¢w ($1 -> $2) w przypisaniu +% Type casting to a type with a different size is not allowed when the variable is +% used for assigning. +type_e_array_index_enums_with_assign_not_possible=04038_E_Typ wyliczeniowy z przypisanymi warto˜ciami nie moze by† u¾yty do ideksowania tablicy +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use it as index of an array. +type_e_classes_not_related=04039_E_Typy obiektowe "$1" i "$2" nie s¥ pokrewne +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_w_classes_not_related=04040_W_Typy obiektowe "$1" i "$2" nie s¥ pokrewne +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_e_class_or_interface_type_expected=04041_E_Oczekiwano klasy lub interfejsu ale otrzymano "$1" +type_e_type_is_not_completly_defined=04042_E_Typ "$1" nie jest kompletnie zdefiniowany +type_w_string_too_long=04043_W_Przekroczona maksymalna dˆugo˜† ˆaäcucha +% The size of the constant string, which is assigned to a shortstring, +% is longer than the maximum size of the shortstring +type_w_signed_unsigned_always_false=04044_W_To por¢wnanie zawsze zwraca faˆsz z powodu zakres¢w warto˜ci zmiennych +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% false. Exlicitly typecast the constant to the correct range to avoid this problem. +type_w_signed_unsigned_always_true=04045_W_To por¢wnanie zawsze zwraca faˆsz z powodu zakres¢w warto˜ci zmiennych +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% true. Exlicitly typecast the constant to the correct range to avoid this problem. +type_w_instance_with_abstract=04046_W_Tworzenie klasy "$1" posiadaj¥cej metody abstrakcyjne +% An instance of a class is created which contains non-implemented abstract +% methods. This will probably lead to a runtime error 211 in the code if that +% routine is ever called. All abstract methods should be overridden. +type_h_in_range_check=04047_H_Lewy operand operatora IN powinien by† wielko˜ci jednego bajta +% The left operand of the \var{in} operator is not an ordinal or enumeration which fits +% within 8-bits, this may lead to range check errors. The \var{in} operator +% currently only supports a left operand which fits within a byte. In the case of +% enumerations, the size of an element of an enumeration can be controlled with +% the \var{\{\$PACKENUM\}} or \var{\{\$Zn\}} switches. +type_w_smaller_possible_range_check=04048_W_Typy r¢¾nej wielko˜ci - mo¾liwa utrata danych lub bˆ¥d zakresu +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_h_smaller_possible_range_check=04049_H_Typy r¢¾nej wielko˜ci - mo¾liwa utrata danych lub bˆ¥d zakresu +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_e_cant_take_address_of_abstract_method=04050_E_Nie mo¾na uzyska† adresu metody abstrakcyjnej +% An abstract method has no body, so the address of an abstract method can't be taken. +type_e_operator_not_allowed=04051_E_Operator nie pasuje do operandu +% You are trying an operator that is not available for the type of the +% operands +type_e_constant_expr_expected=04052_E_Oczekiwano staˆego wyra¾enia +% The compiler expects an constant expression, but gets a variable expression. +type_e_operator_not_supported_for_types=04053_E_Operacja "$1" niedozwolona dla typ¢w "$2" i "$3" +% The operation is not allowed for the supplied types +type_e_illegal_type_conversion=04054_E_Nieprawidˆowa konwersja typ¢w: "$1" do "$2" +% When doing a type-cast, you must take care that the sizes of the variable and +% the destination type are the same. +type_h_pointer_to_longint_conv_not_portable=04055_H_Konwersja pomi©dzy typami caˆkowitymi i wska«nikami jest nieprzeno˜na +% If you typecast a pointer to a longint (or vice-versa), this code will not compile +% on a machine using 64-bit for pointer storage. +type_w_pointer_to_longint_conv_not_portable=04056_W_Konwersja pomi©dzy typami caˆkowitymi i wska«nikami jest nieprzeno˜na +% If you typecast a pointer to a ordinal type of a different size (or vice-versa), this can +% cause problems. This is a warning to help finding the 32bit specific code where cardinal/longint is used +% to typecast pointers to ordinals. A solution is to use the ptrint/ptruint types instead. +type_e_cant_choose_overload_function=04057_E_Nie mo¾na okre˜li†, kt¢r¥ z przeci¥¾onych funkcji wywoˆa† +% You're calling overloaded functions with a parameter that doesn't correspond +% to any of the declared function parameter lists. e.g. when you have declared +% a function with parameters \var{word} and \var{longint}, and then you call +% it with a parameter which is of type \var{integer}. +type_e_illegal_count_var=04058_E_Nieprawidˆowy typ licznika p©tli +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +% \end{description} +# +# Symtable +# +# 05055 is the last one used +# +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedure and variable names. +% \begin{description} +sym_e_id_not_found=05000_E_Nie odnaleziono identyfikatora $1 +% The compiler doesn't know this symbol. Usually happens when you misspel +% the name of a variable or procedure, or when you forgot to declare a +% variable. +sym_f_internal_error_in_symtablestack=05001_F_Bˆ¥d wewn©trzny w SymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_Zduplikowany identyfikator $1 +% The identifier was already declared in the current scope. +sym_h_duplicate_id_where=05003_H_Identyfikator ju¾ zdefiniowany w $1 w lini $2 +% The identifier was already declared in a previous scope. +sym_e_unknown_id=05004_E_Nieznany identyfikator $1 +% The identifier encountered has not been declared, or is used outside the +% scope where it is defined. +sym_e_forward_not_resolved=05005_E_Deklaracaja naprz¢d nie rozwi¥zana $1 +% This can happen in two cases: +% \begin{itemize} +% \item This happens when you declare a function (in the \var{interface} part, or +% with a \var{forward} directive, but do not implement it. +% \item You reference a type which isn't declared in the current \var{type} +% block. +% \end{itemize} +sym_e_error_in_type_def=05007_E_Bˆ¥d w definicji typu +% There is an error in your definition of a new array type: +% \item One of the range delimiters in an array declaration is erroneous. +% For example, \var{Array [1..1.25]} will trigger this error. +sym_e_forward_type_not_resolved=05009_E_Brak definicji typu $1 +% A symbol was forward defined, but no declaration was encountered. +sym_e_only_static_in_static=05010_E_Tylko zmienne statyczne mog¥ by† u¾ywane w metodach statycznych +% A static method of an object can only access static variables. +sym_f_type_must_be_rec_or_class=05012_F_Oczekiwano rekordu lub klasy +% The variable or expression isn't of the type \var{record} or \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_Instancje klas i obiekt¢w z metodami abstrakcyjnymi niedozwolone +% You are trying to generate an instance of a class which has an abstract +% method that wasn't overridden. +sym_w_label_not_defined=05014_W_Etykieta nie zostaˆa zdefiniowana $1 +% A label was declared, but not defined. +sym_e_label_used_and_not_defined=05015_E_Etykieta niezdefiniowana przed u¾yciem $1 +% A label was declared and used, but not defined. +sym_e_ill_label_decl=05016_E_Nieprawidˆowa deklaracja etykiety +% This error should never happen; it occurs if a label is defined outside a +% procedure or function. +sym_e_goto_and_label_not_supported=05017_E_GOTO i LABEL nieobsˆugiwane (u¾yj opcji -Sg) +% You must compile a program which has \var{label}s and \var{goto} statements +% with the \var{-Sg} switch. By default, \var{label} and \var{goto} aren't +% supported. +sym_e_label_not_found=05018_E_Nie odnaleziono etykiety +% A \var{goto label} was encountered, but the label isn't declared. +sym_e_id_is_no_label_id=05019_E_Identyfikator nie jest etykiet¥ +% The identifier specified after the \var{goto} isn't of type label. +sym_e_label_already_defined=05020_E_Powt¢rna definicja etykiety +% You are defining a label twice. You can define a label only once. +sym_e_ill_type_decl_set=05021_E_Nieprawidˆowa deklaracja typu zbiorowego +% The declaration of a set contains an invalid type definition. +sym_e_class_forward_not_resolved=05022_E_Brak implementacji klasy $1 +% You declared a class, but you didn't implement it. +sym_n_unit_not_used=05023_H_Moduˆ $1 nieu¾ywany w $2 +% The unit referenced in the \var{uses} clause is not used. +sym_h_para_identifier_not_used=05024_H_Parametr $1 nieu¾ywany +% The identifier was declared (locally or globally) but +% was not used (locally or globally). +sym_n_local_identifier_not_used=05025_N_Lokalna zmienna $1 nieu¾ywana +% You have declared, but not used a variable in a procedure or function +% implementation. +sym_h_para_identifier_only_set=05026_H_Warto˜c przypisana do $1 nie jest nigdzie u¾yta +% The identifier was declared (locally or globally) +% set but not used (locally or globally). +sym_n_local_identifier_only_set=05027_N_Warto˜c przypisana do $1 nie jest nigdzie u¾yta +% The variable in a procedure or function +% implementation is declared, set but never used. +sym_h_local_symbol_not_used=05028_H_Lokalna(y) $1 $2 nie zostaˆ(a) u¾yta(y) +% A local symbol is never used. +sym_n_private_identifier_not_used=05029_N_Prywatne pole $1.$2 nieu¾ywane +sym_n_private_identifier_only_set=05030_N_Warto˜c przypisana do lokalnego pola $1.$2 nie jest nigdzie u¾yta +sym_n_private_method_not_used=05031_N_Metoda prywatna $1.$2 nieu¾ywana +sym_e_set_expected=05032_E_Oczekiwano typu zbiorowego +% The variable or expression is not of type \var{set}. This happens in an +% \var{in} statement. +sym_w_function_result_not_set=05033_W_Nie wygl¥da na to, ¾eby warto˜† zwracana przez funkcj© byˆa ustawiona +% You can get this warning if the compiler thinks that a function return +% value is not set. This will not be displayed for assembler procedures, +% or procedures that contain assembler blocks. +sym_w_wrong_C_pack=05034_W_Typ $1 jest «le wyr¢wnany dla C w bie¾¥cym rekordzie +% Arrays with sizes not multiples of 4 will be wrongly aligned +% for C structures. +sym_e_illegal_field=05035_E_Nieznany identyfikator pola rekordu $1 +% The field doesn't exist in the record definition. +sym_n_uninitialized_local_variable=05036_W_Nie wygl¥da na to, ¾eby lokalna zmienna $1 byˆa zainicjowana +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_n_uninitialized_variable=05037_W_Nie wygl¥da na to, ¾eby zmienna $1 byˆa zainicjowana +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_e_id_no_member=05038_E_Identyfikator nie wskazuje ¾adnej metody ani pola $1 +% This error is generated when an identifier of a record, +% field, or method is accessed while it is not defined. +sym_h_param_list=05039_H_Znaleziono deklaracj©: $1 +% You get this when you use the \var{-vb} switch. In case an overloaded +% procedure is not found, then all candidate overloaded procedures are +% listed, with their parameter lists. +sym_e_segment_too_large=05040_E_Element jest zbyt du¾y +% You get this when you declare a data element whose size exceeds the +% prescribed limit (2 Gb on 80386+/68020+ processors) +sym_e_no_matching_implementation_found=05042_E_Nie znaleziono implementacji metody interfejsu "$1" +% There was no matching method found which could implement the interface +% method. Check argument types and result type of the methods. +sym_w_deprecated_symbol=05043_W_Symbol "$1" jest przestarzaˆy +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Usage of this symbol +% should be avoided as much as possible. +sym_w_non_portable_symbol=05044_W_Symbolu "$1" nie da si© przenie˜† na inne platformy +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{platform} is used. This symbol's value, usage +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_non_implemented_symbol=05055_W_Symbol "$1" nie jest zaimplementowany +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{unimplemented} is used. This symbol is defined, +% but is not yet implemented on this specific platform. +sym_e_cant_create_unique_type=05056_E_Nie mo¾na utworzy† unikalnego typu z tego typu +% Only simple types like ordinal, float and string types are supported when +% redefining a type with \var{type newtype = type oldtype;}. +sym_h_uninitialized_local_variable=05057_H_Zmienna lokalna "$1" mo¾e nie by† zainicjalizowana +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_h_uninitialized_variable=05058_H_Zmienna "$1" mo¾e nie by† zainicjalizowana +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +% \end{description} +# +# Codegenerator +# +# 06040 is the last used one +# +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +cg_e_parasize_too_big=06009_E_Rozmiar listy parametr¢w przekracza 65535 bajt¢w +% The I386 processor limits the parameter list to 65535 bytes (the \var{RET} +% instruction causes this) +cg_e_file_must_call_by_reference=06012_E_Zmienne plikowe musz¥ by† przekazywane przez referencje +% You cannot specify files as value parameters, i.e. they must always be +% declared \var{var} parameters. +cg_e_cant_use_far_pointer_there=06013_E_U¾ycie wska«nika far niedozwolone w tym miejscu +% Free Pascal doesn't support far pointers, so you cannot take the address of +% an expression which has a far reference as a result. The \var{mem} construct +% has a far reference as a result, so the following code will produce this +% error: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_EXPORT declared functions can't be called +% No longer in use. +cg_w_member_cd_call_from_method=06016_W_Mo¾liwe nieprawidˆowe wywoˆanie konstruktora/destruktora +% The compiler detected that a constructor or destructor is called within a +% a method. This will probably lead to problems, since constructors / destructors +% require parameters on entry. +cg_n_inefficient_code=06017_N_Niewydajny kod +% Your statement seems dubious to the compiler. +cg_w_unreachable_code=06018_W_Kod nie zostanie nigdy wykonany +% You specified a construct which will never be executed. Example: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_Nie mo¾na bezpo˜rednio wywoˆa† metod abstrakcyjnych +% You cannot call an abstract method directy, instead you must call a +% overriding child method, because an abstract method isn't implemented. +cg_d_register_weight=06027_DL_Rejestr $1 waga $2 $3 +% Debugging message. Shown when the compiler considers a variable for +% keeping in the registers. +cg_d_stackframe_omited=06029_DL_Pomini©to ramk© stosu +% Some procedure/functions do not need a complete stack-frame, so it is omitted. +% This message will be displayed when the {-vd} switch is used. +cg_e_unable_inline_object_methods=06031_E_Metody obiekt¢w i klas nie mog¥ by† inline +% You cannot have inlined object methods. +cg_e_unable_inline_procvar=06032_E_Wywoˆania procedur ze zmiennych proceduralnych nie mog¥ by† inline +% A procedure with a procedural variable call cannot be inlined. +cg_e_no_code_for_inline_stored=06033_E_Brak kodu dla procedury inline +% The compiler couldn't store code for the inline procedure. +cg_e_can_access_element_zero=06035_E_Brak dost©pu do zerowego elementu ansi/wide- lub longstringa, u¾yj (set)length +% You should use \var{setlength} to set the length of an ansi/wide/longstring +% and \var{length} to get the length of such kinf of string +cg_e_cannot_call_cons_dest_inside_with=06037_E_Konstruktory i destruktory nie mog¥ by† wywoˆywane w klauzuli 'with' +% Inside a \var{with} clause you cannot call a constructor or destructor for the +% object you have in the \var{with} clause. +cg_e_cannot_call_message_direct=06038_E_Nie mo¾na wywoˆa† bezpo˜rednio metody obsˆuguj¥cej komunikaty +% A message method handler method cannot be called directly if it contains an +% explicit self argument +cg_e_goto_inout_of_exception_block=06039_E_Skok do bloku lub poza blok exception +% It is not allowed to jump in or outside of an exception block like \var{try..finally..end;}: +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // this line will cause an error +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_Break, Continue i Exit nie s¥ dozwolone w bloku finally +% It isn't allowed to use the control flow statements \var{break}, +% \var{continue} and \var{exit} +% inside a finally statement. The following example shows the problem: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // This exit ISN'T allowed +% end; +% ... +% +% \end{verbatim} +% If the procedure \var{p} raises an exception the finally block is +% executed. If the execution reaches the exit, it's unclear what to do: +% exiting the procedure or searching for another exception handler +cg_w_parasize_too_big=06041_W_Rozmiar parametr¢w przekroczyˆ limit dla niekt¢rych procesor¢w +% This indicates that you are declaring more than 64K of parameters, which +% might not be supported on other processor targets. +cg_w_localsize_too_big=06042_W_Rozmiar zmiennych lokalnych przekroczyˆ limit dla dla niekt¢rych procesor¢w +% This indicates that you are declaring more than 32K of lcoal variables, which +% might not be supported on other processor targets. +cg_e_localsize_too_big=06043_E_Rozmiar zmiennych lokalnych przekroczyˆ dopuszczalny limit +% This indicates that you are declaring more than 32K of lcoal variables, which +% is not supported by this processor. +cg_e_break_not_allowed=06044_E_BREAK mo¾na u¾y† tylko wewn¥trz p©tli +% You're trying to use \var{break} outside a loop construction. +cg_e_continue_not_allowed=06045_E_CONTINUE mo¾na u¾y† tylko wewn¥trz p©tli +% You're trying to use \var{continue} outside a loop construction. +% \end{description} +# EndOfTeX + +# +# Assembler reader +# +# 07097 is the last used one +# +asmr_d_start_reading=07000_DL_Rozpocz©cie parsowania bloku asemblera w stylu $1 +% This informs you that an assembler block is being parsed +asmr_d_finish_reading=07001_DL_Zakoäczenie parsowania bloku asemblera w stylu $1 +% This informs you that an assembler block has finished. +asmr_e_none_label_contain_at=07002_E_½aden identyfikator (poza etykietami) nie mo¾e zawiera† @ +% A identifier which isn't a label can't contain a @. +asmr_e_building_record_offset=07004_E_Bˆ¥d tworzenia offsetu rekordu +% There has an error occured while building the offset of a record/object +% structure, this can happend when there is no field specified at all or +% an unknown field identifier is used. +asmr_e_offset_without_identifier=07005_E_OFFSET u¾yty bez identyfikatora +% You can only use OFFSET with an identifier. Other syntaxes aren't +% supported +asmr_e_type_without_identifier=07006_E_TYPE u¾yte bez identyfikatora +% You can only use TYPE with an identifier. Other syntaxes aren't +% supported +asmr_e_no_local_or_para_allowed=07007_E_Nie mo¾na u¾ywa† lokalnych zmiennych i parametr¢w w tym miejscu +% You can't use a local variable or parameter here, mostly because the +% addressing of locals and parameters is done using the frame pointer register so the +% address can't be obtained directly. +asmr_e_need_offset=07008_E_Nale¾y tu u¾y† OFFSET +% You need to use OFFSET <id> here to get the address of the identifier. +asmr_e_need_dollar=07009_E_Nale¾y u¾y† tu $ +% You need to use $<id> here to get the address of the identifier. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_Mo¾na u¾y† tylko jednego symbolu relokacyjnego +% You can't have more than one relocatable symbol (variable/typed constant) +% in one argument. +asmr_e_only_add_relocatable_symbol=07011_E_Symbole relokacyjne mog¥ by† tylko dodane +% Relocatable symbols (variable/typed constant) can't be used with other +% operators. Only addition is allowed. +asmr_e_invalid_constant_expression=07012_E_Nieprawidˆowe staˆe wyra¾enie +% There is an error in the constant expression. +asmr_e_relocatable_symbol_not_allowed=07013_E_Nie mo¾na u¾y† symbolu relokacyjnego w tym miejscu +% You can't use a relocatable symbol (variable/typed constant) here. +asmr_e_invalid_reference_syntax=07014_E_Nieprawidˆowa skˆadnia referencji +% There is an error in the reference. +asmr_e_local_para_unreachable=07015_E_Nie mo¾na osi¥gn¥† $1 z tego kodu +% You can not read directly the value of local or para +% of a higher level in assembler code (except for +% local assembler code without parameter nor locals). +asmr_e_local_label_not_allowed_as_ref=07016_E_Lokalne symbole/etykiety nie s¥ dozwolone jako referencje +% You can't use local symbols/labels as references +asmr_e_wrong_base_index=07017_E_Nieprawidˆowe u¾ycie rejestru indeksu i bazy +% There is an error with the base and index register, they are +% probably incorrect +asmr_w_possible_object_field_bug=07018_W_Mo¾liwy bˆ¥d w obsˆugiwaniu pola obiektu +% Fields of objects or classes can be reached directly in normal or objfpc +% modes but TP and Delphi modes treat the field name as a simple offset. +asmr_e_wrong_scale_factor=07019_E_Nieprawidˆowa skala +% The scale factor given is wrong, only 1,2,4 and 8 are allowed +asmr_e_multiple_index=07020_E_U¾ycie wielu rejestr¢w indeksu +% You are trying to use more than one index register +asmr_e_invalid_operand_type=07021_E_Nieprawidˆowy typ operandu +% The operand type doesn't match with the opcode used +asmr_e_invalid_string_as_opcode_operand=07022_E_Nieprawidˆowy string jako operand: $1 +% The string specified as operand is not correct with this opcode +asmr_w_CODE_and_DATA_not_supported=07023_W_@CODE i @DATA nieobsˆugiwane +% @CODE and @DATA are unsupported and are ignored. +asmr_e_null_label_ref_not_allowed=07024_E_Puste etykiety referencji s¥ niedozwolone +asmr_e_expr_zero_divide=07025_E_Dzielenie przez zero +% There is a division by zero in a constant expression +asmr_e_expr_illegal=07026_E_Nieprawidˆowe wyra¾enie +% There is an illegal expression in a constant expression +asmr_e_escape_seq_ignored=07027_E_Sekwencja zignorowana: $1 +% There is a C-styled string, but the escape sequence in the string +% is unknown, and is therefore ignored +asmr_e_invalid_symbol_ref=07028_E_Nieprawidˆowa referencja symbolu +asmr_w_fwait_emu_prob=07029_W_Fwait mo¾e powodowa† problemy emulacji z emu387 +asmr_w_fadd_to_faddp=07030_W_$1 bez operandu przetˆumaczone na $1P +asmr_w_enter_not_supported_by_linux=07031_W_Instrukcja ENTER nie jest obsˆugiwana przez j¥dro Linuksa +% ENTER instruction can generate a stack page fault that is not +% caught correctly by the i386 Linux page handler. +asmr_w_calling_overload_func=07032_W_Wywoˆanie przeci¥¾onej funkcji z poziomu asemblera +% There is a call to an overloaded method in the assembler block, +% this might be the sign there is a problem +asmr_e_unsupported_symbol_type=07033_E_Nieobsˆugiwany typ symbolu dla operandu +asmr_e_constant_out_of_bounds=07034_E_Warto˜† staˆa przekracza zakres +asmr_e_error_converting_decimal=07035_E_Bˆ¥d konwersji liczby dziesi©tnej $1 +% A constant decimal value does not have the correct syntax +asmr_e_error_converting_octal=07036_E_Bˆ¥d konwersji liczby ¢semkowej $1 +% A constant octal value does not have the correct syntax +asmr_e_error_converting_binary=07037_E_Bˆ¥d konwersji liczby dw¢jkowej $1 +% A constant binary value does not have the correct syntax +asmr_e_error_converting_hexadecimal=07038_E_Bˆ¥d konwersji liczby szesnastkowej $1 +% A constant hexadecimal value does not have the correct syntax +asmr_h_direct_global_to_mangled=07039_H_$1 przetˆumaczone na $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 jest przypisane do przeci¥¾onej funkcji +asmr_e_cannot_use_SELF_outside_a_method=07041_E_Nie mo¾na u¾y† SELF poza metod¥ +% There is a reference to the \var{self} symbol while it is not +% allowed. \var{self} can only be referenced inside methods +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_Nie mo¾na u¾y† OLDEBP poza zagnie¾d¾on¥ procedur¥ +% There is a reference to the \var{oldebp} symbol while it is not +% allowed. \var{oldebp} can only be referenced inside nested routines +asmr_e_void_function=07043_W_Procedury nie mog¥ zwraca† warto˜ci w kodzie asemblera +% Trying to return a value while in a procedure. A procedure +% does not have any return value +asmr_e_SEG_not_supported=07044_E_SEG nie obsˆugiwane +asmr_e_size_suffix_and_dest_dont_match=07045_E_Przyrostek okre˜laj¥cy rozmiar nie pasuje do «r¢dˆa lub celu +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_w_size_suffix_and_dest_dont_match=07046_W_Przyrostek okre˜laj¥cy rozmiar nie pasuje do «r¢dˆa lub celu +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_e_syntax_error=07047_E_Bˆ¥d skˆadni asemblera +% There is an assembler syntax error +asmr_e_invalid_opcode_and_operand=07048_E_Nieprawidˆowa kombinacja opkodu i operandu +% The opcode cannot be used with this type of operand +asmr_e_syn_operand=07049_E_Bˆ¥d skˆadni asemblera w operandzie +asmr_e_syn_constant=07050_E_Bˆ¥d skˆadni asemblera w staˆej +asmr_e_invalid_string_expression=07051_E_Nieprawidˆowe wyra¾enie ze stringiem +asmr_w_const32bit_for_address=07052_W_Staˆa $1 prawdopodobnie nie powinna by† wska«nikiem +% A constant expression represents an address which does not fit +% into a pointer. The address is probably incorrect +asmr_e_unknown_opcode=07053_E_Nieznany opkod $1 +% This opcode is not known +asmr_e_invalid_or_missing_opcode=07054_E_Nieprawidˆowy opkod lub brak opkodu +asmr_e_invalid_prefix_and_opcode=07055_E_Nieprawidˆowa kombinacja prefiksu i opkodu: $1 +asmr_e_invalid_override_and_opcode=07056_E_Nieprawidˆowa kombinacja override i opkodu: $1 +asmr_e_too_many_operands=07057_E_Zbyt du¾o operand¢w +% There are too many operands for this opcode. Check your +% assembler syntax +asmr_w_near_ignored=07058_W_NEAR zignorowane +asmr_w_far_ignored=07059_W_FAR zignorowane +asmr_e_dup_local_sym=07060_E_Zduplikowany symbol lokalny $1 +asmr_e_unknown_local_sym=07061_E_Niezdefiniowany symbol lokalny $1 +asmr_e_unknown_label_identifier=07062_E_Nieznana etykieta $1 +asmr_e_invalid_register=07063_E_Nieprawidˆowa nazwa rejestru +% There is an unknown register name used as operand. +asmr_e_invalid_fpu_register=07064_E_Nieprawidˆowa nazwa rejestru zmiennoprzecinkowego +% There is an unknown register name used as operand. +asmr_w_modulo_not_supported=07066_W_Modulo nieobsˆugiwane +asmr_e_invalid_float_const=07067_E_Nieprawidˆowa staˆa zmiennoprzecinkowa $1 +% The floating point constant declared in an assembler block is +% invalid. +asmr_e_invalid_float_expr=07068_E_Nieprawidˆowe wyra¾enie zmiennoprzecinkowe +% The floating point expression declared in an assembler block is +% invalid. +asmr_e_wrong_sym_type=07069_E_Nieprawidˆowy typ symbolu +asmr_e_cannot_index_relative_var=07070_E_Nie mo¾na ideksowa† rejestrem zmiennej lokalnej/parametru +% Trying to index using a base register a symbol which is already relative +% to a register. This is not possible, and will probably lead to crashes. +asmr_e_invalid_seg_override=07071_E_Invalid segment override expression +asmr_w_id_supposed_external=07072_W_Identifier $1 supposed external +% There is a reference to an undefined symbol. This will not result +% in an error, since the symbol might be external, but may cause +% problems at link time if the symbol is not defined anywhere. +asmr_e_string_not_allowed_as_const=07073_E_Stringi nie mog¥ by† staˆymi +% Character strings are not allowed as constants. +asmr_e_no_var_type_specified=07074_Nie okre˜lono typu zmiennej +% The syntax expects a type idenfitifer after the dot, but +% none was found. +asmr_w_assembler_code_not_returned_to_text=07075_E_brak powrotu do sekcji text w kodzie asemblera +% There was a directive in the assembler block to change sections, +% but there is a missing return to the text section at the end +% of the assembler block. This might cause errors during link time. +asmr_e_not_directive_or_local_symbol=07076_E_To nie jest ani dyrektywa, ani symbol lokalny: $1 +% This symbol is unknown. +asmr_w_using_defined_as_local=07077_E_U¾ycie zdefiniowanej nazwy jako lokalnej etykiety +asmr_e_dollar_without_identifier=07078_E_Brak identyfikatora przy znaku dolara +% A constant expression has an identifier which does not start with +% the $ symbol. +asmr_w_32bit_const_for_address=07079_W_32bitowa staˆa u¾yta jako adres +% A constant was used as an address. This is probably an error, +% since using absolute addresses will probably not work. +asmr_n_align_is_target_specific=07080_N_.align nie jest przeno˜ne mi©dzy platformami, u¾yj .balign lub .p2align +% Using the .align directive is platform specific, and its meaning will vary +% from one platform to another. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_Nie mo¾na odwoˆywa† si© bezpo˜rednio do p¢l parametr¢w +% You should load the parameter first into a register and then access the +% fields using that register. +asmr_e_cannot_access_object_field_directly=07082_E_Nie mo¾na odwoˆywa† si© bezpo˜rednio do p¢l obiekt¢w/klas +% You should load the self pointer first into a register and then access the +% fields using the register as base. By default the self pointer is available +% in the esi register on i386. +asmr_e_unable_to_determine_reference_size=07083_E_Nie okre˜lono rozmiaru operandu +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. +asmr_e_cannot_use_RESULT_here=07084_E_Nie mo¾na u¾y† RESULT w tej funkcji +% Some functions which return complex types cannot use the \var{result} +% keyword. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" bez operandu przetˆumaczone na "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" przetˆumaczone na "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" przetˆumaczone na "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_Znak < niedozwolony w tym miejscu +% The shift operator requires the << characters. Only one +% of those characters was found. +asmr_e_invalid_char_greater=07090_E_Znak > niedozwolony w tym miejscu +% The shift operator requires the >> characters. Only one +% of those characters was found. +asmr_w_align_not_supported=07093_W_ALIGN nieobsˆugiwane +asmr_e_no_inc_and_dec_together=07094_E_Inc i Dec nie mog¥ wyst©powa† razem +% Trying to use an increment and a decrement within the same +% opcode on the 680x0. This is impossible. +asmr_e_invalid_reg_list_in_movem=07095_E_Nieprawidˆowa lista rejestr¢w dla movem +% Trying to use the \var{movem} opcode with invalid registers +% to save or restore. +asmr_e_invalid_reg_list_for_opcode=07096_E_Nieprawidˆowa lista rejestr¢w dla opkodu +asmr_e_higher_cpu_mode_required=07097_E_Ta instrukcja wymaga wy¾szego typu procesora ($1) +% Trying to use an instruction which is not supported in the current +% cpu mode. Use a higher cpu generation to be able to use this +% opcode in your assembler block +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_Nie okre˜lono rozmiaru operand¢w, domy˜lne u¾ycie DWORD +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use DWORD as default. +asmr_e_illegal_shifterop_syntax=07099_E_Bˆ¥d skˆadni przy operandzie shifter +% ARM only; ARM assembler supports a so called shifter operand. The used syntax isn't +% a valid shifter operand. Example for an operation with shifter operand: +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +# +# Assembler/binary writers +# +# 08018 is the last used one +# +asmw_f_too_many_asm_files=08000_F_Zbyt du¾o plik¢w asemblera +% With smartlinking enabled, there are too many assembler +% files generated. Disable smartlinking. +asmw_f_assembler_output_not_supported=08001_F_Wybrany typ wyj˜ciowy asemblera nieobsˆugiwany +asmw_f_comp_not_supported=08002_F_Comp nieobsˆugiwany +asmw_f_direct_not_supported=08003_F_Direct nieobsˆugiwane przy zapisywaniu bezpo˜rednim +% Direct assembler mode is not supported for binary writers. +asmw_e_alloc_data_only_in_bss=08004_E_Alokacja danych jest dozwolona tylko w sekcji bss +asmw_f_no_binary_writer_selected=08005_F_Nie wybrano sposobu zapisywania binari¢w +asmw_e_opcode_not_in_table=08006_E_Asm: Brak opkodu $1 w tablicy +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 nieprawidˆowa kombinacja opkodu i operand¢w +asmw_e_16bit_not_supported=08008_E_Asm: 16bitowe referencje nieobsˆugiwane +asmw_e_invalid_effective_address=08009_E_Asm: Nieprawidˆowy adres efektywny +asmw_e_immediate_or_reference_expected=08010_E_Asm: Immediate or reference expected +asmw_e_value_exceeds_bounds=08011_E_Asm: $1 warto˜† przekracza zakres $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: Kr¢tki skok poza zasi©g $1 +asmw_e_undefined_label=08013_E_Asm: Nieznana etykieta $1 +asmw_e_comp_not_supported=08014_E_Asm: Typ Comp nieobsˆugiwany dla tego celu +asmw_e_extended_not_supported=08015_E_Asm: Typ Extended nieobsˆugiwany dla tego celu +asmw_e_duplicate_label=08016_E_Asm: Zduplikowana etykieta $1 +asmw_e_redefined_label=08017_E_Asm: Etykieta powt¢rnie zdefiniowana $1 +asmw_e_first_defined_label=08018_E_Asm: Najpierw zdefiniowana tutaj +asmw_e_invalid_register=08019_E_Asm: Nieprawidˆowy rejestr $1 + +# +# Executing linker/assembler +# +# 09034 is the last used one +# +# BeginOfTeX +% +% \section{Errors of assembling/linking stage} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +exec_w_source_os_redefined=09000_W_Zmieniono «r¢dˆowy system operacyjny +exec_i_assembling_pipe=09001_I_Asemblowanie (potok) $1 +exec_d_cant_create_asmfile=09002_E_Nie mo¾na utworzy† plik¢w asemblera: $1 +% The mentioned file can't be created. Check if you have got +% access permissions to create this file +exec_e_cant_create_objectfile=09003_E_Nie mo¾na utworzy† pliku: $1 +% The mentioned file can't be created. Check if you've +% got access permissions to create this file +exec_e_cant_create_archivefile=09004_E_Nie mo¾na utworzy† pliku: $1 +% The mentioned file can't be created. Check if you've +% access permissions to create this file +exec_e_assembler_not_found=09005_E_Assembler $1 nie znaleziony, przeˆ¥czenie na zewn©trzn¥ asemblacj© +exec_t_using_assembler=09006_T_U¾ywanie assemblera: $1 +exec_e_error_while_assembling=09007_E_Bˆ¥d asemblera, kod wyj˜cia $1 +% There was an error while assembling the file using an external assembler. +% Consult the documentation of the assembler tool to find out more information +% on this error. +exec_e_cant_call_assembler=09008_E_Nie mo¾na wywoˆa† asemblera, bˆ¥d $1 przeˆ¥czenie na zewn©trzn¥ asemblacj© +exec_i_assembling=09009_I_Asemblowanie $1 +exec_i_assembling_smart=09010_I_Asemblowanie do linkowania smart $1 +exec_w_objfile_not_found=09011_W_Obiekt $1 nieodnaleziony, linkowanie mo¾e si© nie powie˜†! +% One of the object file is missing, and linking will probably fail. +% Check your paths. +exec_w_libfile_not_found=09012_W_Biblioteka $1 nieodnaleziona, Linkowanie mo¾e si© nie powie˜†! +% One of the library file is missing, and linking will probably fail. +% Check your paths. +exec_e_error_while_linking=09013_E_Bˆ¥d podczas linkowania +% Generic error while linking. +exec_e_cant_call_linker=09014_E_Nie mo¾na wywoˆa† linkera, przeˆ¥czenie na zewn©trzne linkowanie +exec_i_linking=09015_I_Linkowanie $1 +exec_e_util_not_found=09016_E_Narz©dzie $1 nieodnalezione, przeˆ¥czenie na zewn©trzne linkowanie +exec_t_using_util=09017_T_Uruchamianie $1 +exec_e_exe_not_supported=09018_E_Tworzenie plik¢w wykonywalnych nieobsˆugiwane +exec_e_dll_not_supported=09019_E_Tworzenie bibliotek dynamicznych/wsp¢ˆdzielonych nieobsˆugiwane +exec_i_closing_script=09020_I_Zamykanie skryptu $1 +exec_e_res_not_found=09021_E_Kompilator zasob¢w nieodnaleziony, przeˆ¥czenie na tryb zewn©trzny +exec_i_compilingresource=09022_I_Kompilacja zasobu $1 +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_Moduˆ $1 nie mo¾e by† linkowany statycznie, przeˆ¥czenie na linkowanie smart +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_Moduˆ $1 nie moze by† linkowany smart, przeˆ¥czenie na linkowanie statyczne +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_Moduˆ $1 nie mo¾e by† linkowany dynamicznie, przeˆ¥czenie na linkowanie statyczne +exec_e_unit_not_smart_or_static_linkable=09026_E_Moduˆ $1 nie mo¾e by† linkowany statycznie ani smart +exec_e_unit_not_shared_or_static_linkable=09027_E_Moduˆ $1 nie mo¾e by† linkowany statycznie ani dynamicznie +%\end{description} +# EndOfTeX + +# +# Executable information +# +execinfo_f_cant_process_executable=09128_F_Nie mo¾na przetwarza† pliku $1 +execinfo_f_cant_open_executable=09129_F_Nie mo¾na otworzy† pliku wykonywalnego $1 +execinfo_x_codesize=09130_X_Rozmiar kodu: $1 bajt¢w +execinfo_x_initdatasize=09131_X_Rozmiar zainicjowanych danych: $1 bajt¢w +execinfo_x_uninitdatasize=09132_X_Rozmiar niezainicjowanych danych: $1 bajt¢w +execinfo_x_stackreserve=09133_X_Zarezerwowany rozmiar stosu: $1 bajt¢w +execinfo_x_stackcommit=09134_X_Aktywny rozmiar stosu: $1 bajt¢w + +# +# Unit loading +# +# 10041 is the last used one +# +# BeginOfTeX +% \section{Unit loading messages.} +% This section lists all messages that can occur when the compiler is +% loading a unit from disk into memory. Many of these mesages are +% informational messages. +% \begin{description} +unit_t_unitsearch=10000_T_Poszukiwanie moduˆu: $1 +% When you use the \var{-vt}, the compiler tells you where it tries to find +% unit files. +unit_t_ppu_loading=10001_T_Otwieranie PPU $1 +% When the \var{-vt} switch is used, the compiler tells you +% what units it loads. +unit_u_ppu_name=10002_U_Nazwa PPU: $1 +% When you use the \var{-vu} flag, the unit name is shown. +unit_u_ppu_flags=10003_U_Flagi PPU: $1 +% When you use the \var{-vu} flag, the unit flags are shown. +unit_u_ppu_crc=10004_U_Crc PPU: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_time=10005_U_Czas PPU: $1 +% When you use the \var{-vu} flag, the time the unit was compiled is shown. +unit_u_ppu_file_too_short=10006_U_Plik PPU zbyt kr¢tki +% The ppufile is too short, not all declarations are present. +unit_u_ppu_invalid_header=10007_U_Nieprawidˆowy nagˆ¢wek PPU (brak PPU na pocz¥tku) +% A unit file contains as the first three bytes the ascii codes of \var{PPU} +unit_u_ppu_invalid_version=10008_U_Nieprawidˆowa wersja PPU $1 +% This unit file was compiled with a different version of the compiler, and +% cannot be read. +unit_u_ppu_invalid_processor=10009_U_PPU jest skompilowany dla innego procesora +% This unit file was compiled for a different processor type, and +% cannot be read +unit_u_ppu_invalid_target=10010_U_PPU skompilowany dla innej platformy docelowej +% This unit file was compiled for a different target, and +% cannot be read +unit_u_ppu_source=10011_U_r¢dˆo PPU: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_write=10012_U_Zapisywanie $1 +% When you specify the \var{-vu} switch, the compiler will tell you where it +% writes the unit file. +unit_f_ppu_cannot_write=10013_F_Nie mo¾na zapisa† pliku PPU +% An error occurred when writing the unit file. +unit_f_ppu_read_error=10014_F_Bˆ¥d podczas czytania pliku PPU +% This means that the unit file was corrupted, and contains invalid +% information. Recompilation will be necessary. +unit_f_ppu_read_unexpected_end=10015_F_Nieoczekiwane zakoäczenie pliku PPU +% Unexpected end of file. This may mean that the PPU file is +% corrupted. +unit_f_ppu_invalid_entry=10016_F_Nieprawidˆowy plik PPU: $1 +% The unit the compiler is trying to read is corrupted, or generated with a +% newer version of the compiler. +unit_f_ppu_dbx_count_problem=10017_F_Bˆ¥d podczas liczenia PPU Dbx +% There is an inconsistency in the debugging information of the unit. +unit_e_illegal_unit_name=10018_E_Nieprawidˆowa nazwa moduˆu: $1 +% The name of the unit does not match the file name. +unit_f_too_much_units=10019_F_Zbyt du¾o moduˆ¢w +% \fpc has a limit of 1024 units in a program. You can change this behavior +% by changing the \var{maxunits} constant in the \file{files.pas} file of the +% compiler, and recompiling the compiler. +unit_f_circular_unit_reference=10020_F_Zap©tlone nawi¥zanie pomi©dzy moduˆami $1 i $2 +% Two units are using each other in the interface part. This is only allowed +% in the \var{implementation} part. At least one unit must contain the other one +% in the \var{implementation} section. +unit_f_cant_compile_unit=10021_F_Nie mo¾na skompilowa† moduˆu $1, brak «r¢deˆ +% A unit was found that needs to be recompiled, but no sources are +% available. +unit_f_cant_find_ppu=10022_F_Nie mo¾na znale«† moduˆu $1 +% You tried to use a unit of which the PPU file isn't found by the +% compiler. Check your config files for the unit pathes +unit_w_unit_name_error=10023_W_Nie znaleziono moduˆu $1 ale istnieje $2 +unit_f_unit_name_error=10024_F_Szukano moduˆu $1 ale znaleziono tylko $2 +% Dos truncation of 8 letters for unit PPU files +% may lead to problems when unit name is longer than 8 letters. +unit_w_switch_us_missed=10025_W_Kompilowanie moduˆu System wymaga u¾ycia przeˆ¥cznika -Us +% When recompiling the system unit (it needs special treatment), the +% \var{-Us} must be specified. +unit_f_errors_in_unit=10026_F_Napotkano $1 bˆ©d¢w podczas kompilacji moduˆu, zatrzymanie +% When the compiler encounters a fatal error or too many errors in a module +% then it stops with this message. +unit_u_load_unit=10027_U_adowanie z $1 ($2) moduˆu $3 +% When you use the \var{-vu} flag, which unit is loaded from which unit is +% shown. +unit_u_recompile_crc_change=10028_U_Rekompilacja $1, suma kontrolna zmieniona dla $2 +unit_u_recompile_source_found_alone=10029_U_Rekompilacja $1, znaleziono tylko «r¢dˆo +% When you use the \var{-vu} flag, these messages tell you why the current +% unit is recompiled. +unit_u_recompile_staticlib_is_older=10030_U_Rekompilacja moduˆu, biblioteka statyczna jest starsza ni¾ plik ppu +% When you use the \var{-vu} flag, the compiler warns if the static library +% of the unit are older than the unit file itself. +unit_u_recompile_sharedlib_is_older=10031_U_Rekompilacja moduˆu, biblioteka wsp¢ˆdzielona jest starsza ni¾ plik ppu +% When you use the \var{-vu} flag, the compiler warns if the shared library +% of the unit are older than the unit file itself. +unit_u_recompile_obj_and_asm_older=10032_U_Rekompilacja moduˆu, obj i asm s¥ starsze ni¾ plik ppu +% When you use the \var{-vu} flag, the compiler warns if the assembler or +% object file of the unit are older than the unit file itself. +unit_u_recompile_obj_older_than_asm=10033_U_Rekompilacja moduˆu, obj jest starszy ni¾ asm +% When you use the \var{-vu} flag, the compiler warns if the assembler +% file of the unit is older than the object file of the unit. +unit_u_parsing_interface=10034_U_Parsowanie cz©˜ci interface moduˆu $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the interface part of the unit +unit_u_parsing_implementation=10035_U_Parsowanie cz©˜ci implementation moduˆu $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the implementation part of the unit +unit_u_second_load_unit=10036_U_Drugie zaˆadowanie pliku $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_check_time=10037_U_Sprawdzanie pliku PPU: $1 czas: $2 +% When you use the \var{-vu} flag, the compiler show the filename and +% date and time of the file which a recompile depends on +### The following two error msgs is currently disabled. +#unit_h_cond_not_set_in_last_compile=10038_H_Warunek $1 nie byˆ ustawiony na pocz¥tku ostatniej kompilacji moduˆu $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that currently is defined, but was not used the last +#% time the unit was compiled. +#unit_h_cond_set_in_last_compile=10039_H_Warunek $1 nie byˆ ustawiony na pocz¥tku ostatniej kompilacji moduˆu $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that was used the last time the unit was compiled, but +#% the conditional is currently not defined. +unit_w_cant_compile_unit_with_changed_incfile=10040_W_Nie mo¾na skompilowa† moduˆu $1, znaleziono zmodyfikowane pliki include +% A unit was found to have modified include files, but +% some source files were not found, so recompilation is impossible. +unit_h_source_modified=10041_H_Plik $1 jest nowszy ni¾ plik $2 +% A modified source file for a unit was found that was compiled with the +% release flag (-Ur). The unit will not implicitly be recompiled because +% this release flag is set. +unit_u_ppu_invalid_fpumode=10042_U_U¾ycie moduˆu skompilowanego z innym formatem zapisu liczb zmiennoprzecinkowych +% Trying to compile code while using units which were not compiled with +% the same floating point format mode. Either all code should be compiled +% with FPU emulation on, or with FPU emulation off. +unit_u_loading_interface_units=10043_U_adowanie moduˆ¢w z cz©«ci interface moduˆu $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the units defined in the interface part of the unit. +unit_u_loading_implementation_units=10044_U_adowanie moduˆ¢w z cz©«ci implementation moduˆu $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the units defined in the implementation part of the unit. +unit_u_interface_crc_changed=10045_U_Zmieniona suma CRC sekcji interface moduˆu $1 +% When you use the \var{-vu} flag, the compiler warns that it the +% CRC calculated for the interface has been changed after the implementation +% has been parsed. +unit_u_implementation_crc_changed=10046_U_Zmieniona suma CRC sekcji implementation moduˆu $1 +% When you use the \var{-vu} flag, the compiler warns that it the +% CRC calculated has been changed after the implementation +% has been parsed. +unit_u_finished_compiling=10047_U_Zakoäczono kompilacj© moduˆu $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has finished compiling the unit. +unit_u_add_depend_to=10048_U_Dodanie zale¾no˜ci $1 do $2 +% When you use the \var{-vu} flag, the compiler warns that it +% has added a dependency between the two units. +unit_u_no_reload_is_caller=10049_U_Omini©cie przeˆadowania moduˆu, to ten sam moduˆ: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has will not reload the unit because it is the unit that wants +% to load this unit +unit_u_no_reload_in_second_compile=10050_U_Omini©cie przeˆadowania moduˆu, trwa druga kompilacaja: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has will not reload the unit because it is already in a second recompile +unit_u_flag_for_reload=10051_U_Flaga do przeˆadowania: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to reload the unit +unit_u_forced_reload=10052_U_Wymuszone przeˆadowanie moduˆu +% When you use the \var{-vu} flag, the compiler warns that it +% has is reloading the unit because it was required +unit_u_previous_state=10053_U_Poprzedni stan moduˆu $1: $2 +% When you use the \var{-vu} flag, the compiler shows the +% previous state of the unit +unit_u_second_compile_unit=10054_U_Ju¾ kompilowane $1, ustawienie drugiej kompilacji +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_loading_unit=10055_U_adowanie moduˆu $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the unit. +unit_u_finished_loading_unit=10056_U_Zakoäczenie ˆadowania moduˆu $1 +% When you use the \var{-vu} flag, the compiler warns that it finished +% loading the unit. +unit_u_registering_new_unit=10057_U_Rejestrowanie nowego moduˆu $1 +% When you use the \var{-vu} flag, the compiler warns that it has +% found a new unit and registers it in the internal lists. +unit_u_reresolving_unit=10058_U_Powt¢rne odnajdowanie moduˆu $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to recalculate the internal data of the unit +unit_u_skipping_reresolving_unit=10059_U_Omini©cie powt¢rnego odnajdowania moduˆu $1, ci¥gle ˆaduje u¾ywane moduˆy +% When you use the \var{-vu} flag, the compiler warns that it +% skips to recalculate the internal data of the unit because there +% is no data to recalculate +% \end{description} +# EndOfTeX + +# +# Options +# +# 11039 is the last used one +# +option_usage=11000_O_$1 [opcje] <nazwapliku> [opcje] +# BeginOfTeX +% +% \section{Command-line handling errors} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +option_only_one_source_support=11001_W_Obsˆugiwany tylko jeden plik «r¢dˆowy +% You can specify only one source file on the command line. The first +% one will be compiled, others will be ignored. This may indicate that +% you forgot a \var{'-'} sign. +option_def_only_for_os2=11002_W_Plik DEF mo¾e by† stworzony tylko pod OS/2 +% This option can only be specified when you're compiling for OS/2 +option_no_nested_response_file=11003_E_Zagnie¾d¾enia plik¢w nieobsˆugiwane +% you cannot nest response files with the \var{@file} command-line option. +option_no_source_found=11004_F_Brak nazwy pliku w lini poleceä +% The compiler expects a source file name on the command line. +option_no_option_found=11005_N_Brak opcji w pliku konfiguracyjnym $1 +% The compiler didn't find any option in that config file. +option_illegal_para=11006_E_Nieprawidˆowy parametr: $1 +% You specified an unknown option. +option_help_pages_para=11007_H_-? wy˜wietla pomoc +% When an unknown option is given, this message is diplayed. +option_too_many_cfg_files=11008_F_Za du¾o zagnie¾d¾onych plik¢w konfiguracyjnych +% You can only nest up to 16 config files. +option_unable_open_file=11009_F_Nie mo¾na otworzy† pliku konfiguracyjnego $1 +% The option file cannot be found. +option_reading_further_from=11010_D_Czytanie dalszych opcji z $1 +% Displayed when you have notes turned on, and the compiler switches +% to another options file. +option_target_is_already_set=11011_W_Cel jest ju¾ ustawiony na: $1 +% Displayed if more than one \var{-T} option is specified. +option_no_shared_lib_under_dos=11012_W_Biblioteki wsp¢ˆdzielone nie s¥ obsˆugiwane w DOSie, reverting to static +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos +option_too_many_ifdef=11013_F_Za du¾o IF(N)DEF +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_many_endif=11014_F_Za du¾o ENDIF +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_less_endif=11015_F_Warunek wci¥¾ otwarty na koäcu pliku +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_no_debug_support=11016_W_Generowanie informacji do debugowania nieobsˆugiwane przez t¥ wersj© kompilatora +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_Spr¢buj przekompilowa† z -dGDB +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_E_U¾ycie przedawnionego przeˆ¥cznika $1 +% this warns you when you use a switch that is not needed/supported anymore. +% It is recommended that you remove the switch to overcome problems in the +% future, when the switch meaning may change. +option_obsolete_switch_use_new=11019_E_U¾ycie przedawnionego przeˆ¥cznika $1, prosz© u¾y† $2 +% this warns you when you use a switch that is not supported anymore. You +% must now use the second switch instead. +% It is recommended that you change the switch to overcome problems in the +% future, when the switch meaning may change. +option_switch_bin_to_src_assembler=11020_N_Przeˆ¥czenie na domy˜lny zapis asemblera +% this notifies you that the assembler has been changed because you used the +% -a switch which can't be used with a binary assembler writer. +option_incompatible_asm=11021_W_Wybrane wyj˜cie asemblera "$1" nie jest zgodne z "$2" +option_asm_forced=11022_W_Wymuszenie u¾ycia asemblera "$1" +% The assembler output selected can not generate +% object files with the correct format. Therefore, the +% default assembler for this target is used instead. +option_using_file=11026_T_Czytanie opcji z pliku $1 +% Options are also read from this file +option_using_env=11027_T_Czytanie opcji ze zmiennej ˜rodowiskowej $1 +% Options are also read from this environment string +option_handling_option=11028_D_Obsˆugiwanie opcji "$1" +% Debug info that an option is found and will be handled +option_help_press_enter=11029__*** naci˜nij enter *** +option_start_reading_configfile=11030_H_Rozpocz©to czytanie pliku konfiguracyjnego $1 +% Starting of config file parsing. +option_end_reading_configfile=11031_H_Zakoäczono czytanie pliku konfiguracyjnego $1 +% End of config file parsing. +option_interpreting_option=11032_D_Interpretowanie opcji "$1" +option_interpreting_firstpass_option=11036_D_Interpretowanie opcji "$1" +option_interpreting_file_option=11033_D_Interpretowanie opcji plikowej "$1" +option_read_config_file=11034_D_Czytanie pliku konfiguracyjnego "$1" +option_found_file=11035_D_Znaleziono nazw© pliku «r¢dˆowego "$1" +% Additional infos about options, displayed +% when you have debug option turned on. +option_code_page_not_available=11039_E_Nieznana strona kodowa +%\end{description} +# EndOfTeX + +# +# Logo (option -l) +# +option_logo=11023_[ +Free Pascal Compiler wersja $FPCFULLVERSION [$FPCDATE] dla $FPCCPU +Copyright (c) 1993-2011 by Florian Klaempfl +] + +# +# Info (option -i) +# +option_info=11024_[ +Free Pascal Compiler wersja $FPCVERSION + +Data kompilatora : $FPCDATE +Platforma docelowa: $FPCCPU + +Wspierane platformy: + $OSTARGETS + +Wspierane instrukcje CPU: + $INSTRUCTIONSETS + +Wspierane instrukcje FPU: + $FPUINSTRUCTIONSETS + +Ten program jest oparty na GNU General Public Licence +Przeczytaj COPYING.FPC aby dowiedzie† si© wi©cej + +Zgˆaszanie bˆ©d¢w, sugestii itp. + http://bugs.freepascal.org +lub + bugs@freepascal.org +] + +# +# Help pages (option -? and -h) +# +# The first character on the line indicates who will display this +# line, the current possibilities are : +# * = every target +# 3 = 80x86 targets +# 6 = 680x0 targets +# e = in extended debug mode only +# P = PowerPC targets +# S = Sparc targets +# V = Virtual machine targets +# The second character also indicates who will display this line, +# (if the above character was TRUE) the current possibilities are : +# * = everyone +# g = with GDB info supported by the compiler +# O = OS/2 +# L = UNIX systems +# The third character represents the indentation level. +# +option_help_pages=11025_[ +**0*_wpisz + po przeˆ¥czniku aby go aktywowa†, - aby dezaktywowa† +**1a_kompilator nie usuwa wygenerowanego pliku asemblera +**2al_wypisuje numery linii do pliku asemblera +**2an_wypisuje informacje o w©zˆach do pliku asemblera +*L2ap_u¾ycie potok¢w zamiast tymczasowych plik¢w asemblera +**2ar_wypisuje alokacje/zwalnianie rejestr¢w do pliku asemblera +**2at_wypisuje tymczasowe alokacje/zwalnianie do pliku asemblera +**1A<x>_format wyj˜ciowy: +**2Adefault_u¾ycie domy˜lnego asemblera +3*2Aas_asemblacja przy u¾yciu GNU AS +3*2Anasmcoff_plik coff (Go32v2) przy u¾yciu Nasm +3*2Anasmelf_plik elf32 (Linux) przy u¾yciu Nasm +3*2Anasmwin32_plik obj (Win32) przy u¾yciu Nasm +3*2Anasmwdosx_plik obj (Win32/WDOSX) przy u¾yciu Nasm +3*2Awasm_plik obj przy u¾yciu Wasm (Watcom) +3*2Anasmobj_plik obj przy u¾yciu Nasm +3*2Amasm_plik obj przy u¾yciu Masm (Microsoft) +3*2Atasm_plik obj przy u¾yciu Tasm (Borland) +3*2Aelf_bezpo˜redni zapis do pliku elf32 (Linux) +3*2Acoff_bezpo˜redni zapis do pliku coff (Go32v2) +3*2Apecoff_bezpo˜redni zapis do pliku pecoff (Win32) +4*2Aas_asemblacja przy u¾yciu GNU AS +6*2Aas_o-file (Unix) przy u¾yciu GNU AS +6*2Agas_asembler GNU Motorola +6*2Amit_skˆadnia MIT (dawniej GAS) +6*2Amot_standardowy asembler Motorola +A*2Aas_asemblacja przy u¾yciu GNU AS +P*2Aas_asemblacja przy u¾yciu GNU AS +S*2Aas_asemblacja przy u¾yciu GNU AS +**1b_generuje informacje przegl¥darki +**2bl_generuje informacje o lokalnych symbolach +**1B_budowanie wszystkich moduˆ¢w +**1C<x>_opcje generacji kodu: +**2Cc<x>_ustawia domy˜lny spos¢b wywoˆania funkcji/procedur na <x> +**2CD_tworzenie tak¾e bibliotek dynamicznych (niedost©pne) +**2Ce_kompilacja z emulowanymi opkodami zmiennoprzecinkowymi +**2Cf<x>_ustawia u¾ywany zbi¢r instrukcji FPU na <x> (u¾yj "fpc -i", aby zobaczy† mo¾liwe warto˜ci) +**2Cg_generowanie kodu PIC +**2Ch<n>_rozmiar sterty w bajtach (pomi©dzy 1023 i 67107840) +**2Ci_sprawdzanie operacji wej˜cia/wyj˜cia +**2Cn_pomini©cie etapu linkowania +**2Co_sprawdzanie przepeˆnienia liczb caˆkowitych +**2Cp<x>_ustawia u¾ywany zbi¢r instrukcji na <x> (u¾yj "fpc -i", aby zobaczy† mo¾liwe warto˜ci) +**2Cr_sprawdzanie zakresu +**2CR_sprawdzanie poprawno˜ci wywoˆywania metod obiekt¢w +**2Cs<n>_ustawienie rozmiar stosu na <n> +**2Ct_sprawdzanie stosu +**2CX_tworzenie bibliotek smartlinked +**1d<x>_zdefiniowanie symbolu <x> +*O1D_generacja pliku DEF +*O2Dd<x>_ustawienie opisu na <x> +**2Dv<x>_ustawienie wersji DLL na <x> +*O2Dw_aplikacja PM +**1e<x>_ustawienie ˜cie¾ki do asemblera i linkera +**1E_to samo co -Cn +**1F<x>_ustawianie nazw i ˜cie¾ek: +**2Fa<x>[,y]_wczytuje <x> (i [y]) zanim zostani¥ wczytane moduˆy z sekcji USES +**2Fc<x>_ustawienie strony kodowej «r¢deˆ na <x> +**2FD<x>_ustawienie katalogu z narz©dziami kompilatora +**2Fe<x>_przekierowanie komunikat¢w o bˆ©dach do pliku <x> +**2FE<x>_ustawienie katalogu dla skompilowanych program¢w/moduˆ¢w na <x> +**2Fi<x>_dodanie <x> do ˜cie¾ki include'¢w +**2Fl<x>_dodanie <x> do ˜cie¾ki bibliotek +**2FL<x>_u¾ycie <x> jako dynamicznego linkera +**2Fo<x>_dodanie <x> do ˜cie¾ki obiekt¢w +**2Fr<x>_ˆadowanie pliku <x> z komunikatami bˆ©d¢w +**2Fu<x>_dodanie <x> do ˜cie¾ki moduˆ¢w +**2FU<x>_ustawienie katalogu dla skompilowanych moduˆ¢w, uniewa¾nia -FE +*g1g_generacja informacji debuggera: +*g2gc_generacja kodu sprawdzaj¥cego wska«niki +*g2gd_u¾ycie dbx +*g2gg_u¾ycie gsym +*g2gh_u¾ycie moduˆu ˜ledzenia sterty(do wykrywania wyciek¢w pami©ci) +*g2gl_u¾ycie moduˆu z informacjami o numerach linii programu +*g2gv_generacja kodu mo¾liwego do ˜ledzenia przy pomocy valgrind +*g2gw_generacja informacji debuggera dwarf +**1i_informacje +**2iD_zwraca dat© kompilatora +**2iV_zwraca wersj© kompilatora +**2iSO_zwraca OS kompilatora +**2iSP_zwraca typ procesora kompilatora +**2iTO_zwraca docelowy OS +**2iTP_zwraca docelowy typ kompilatora +**1I<x>_dodanie <x> do ˜cie¾ki include'¢w +**1k<x>_podanie <x> do linkera +**1l_wypisanie logo +**1M<x>_ustawia tryb j©zyka na <x> +**2Mfpc_dialekt free pascala (domy˜lny) +**2Mobjfpc_wˆ¥czenie niekt¢rych rozszerzeä Delphi 2 +**2Mdelphi_kompatybilno˜† z Delphi +**2Mtp_kompatybilno˜† z TP/BP 7.0 +**2Mgpc_kompatybilno˜† z gpc +**2Mmac_kompatybilno˜† z dialektami pascala na Macintosha +**1n_zignorowanie standardowego pliku konfiguracyjnego +**1N<x>optymalizacje w©zˆ¢w drzewa +**2Nu_rozwijanie p©tli +**1o<x>_zmiana nazwy skompilowanego programu na <x> +3*1O<x>_optymalizacje: +3*2Og_generacja mniejszego kodu +3*2OG_generacja szybszego kodu (domy˜lne) +3*2Or_trzymanie niekt¢rych zmiennych w rejestrach +3*2Ou_wˆ¥czenie niepewnych optymalizacji (zobacz w dokumentacji) +3*2O1_optymalizacje pierwszego stopnia (szybkie) +3*2O2_optymalizacje drugiego stopnia (-O1 + wolniejsze) +3*2O3_optymalizacje trzeciego stopnia (powtarzane maksymalnie 5 razy -02) +3*2Op<x>_procesor docelowy: +3*3Op1_ustawienie procesora docelowego na 386/486 +3*3Op2_ustawienie procesora docelowego na Pentium/PentiumMMX (tm) +3*3Op3_ustawienie procesora docelowego na PPro/PII/c6x86/K6 (tm) +6*2Og_generacja mniejszego kodu +6*2OG_generacja szybszego kodu (domy˜lne) +6*2Ox_maksymalne optymalizacje (ci¥gle zawieraj¥ B¨DY!!!) +6*2O0_ustawia docelowy procesor na MC68000 +6*2O2_ustawia docelowy procesor na MC68020+ (domy˜lne) +**1pg_generacja kodu do profilowania przy pomocy gprof (definiuje FPC_PROFILE) +**1R<x>_styl asemblera u¾ywanego w «r¢dˆach: +**2Rdefault_u¾ycie domy˜lnego asemblera +3*2Ratt_styl AT&T +3*2Rintel_styl Intel +6*2RMOT_styl Motorola +**1S<x>_opcje skˆadni: +**2S2_to samo co -Mobjfpc +**2Sc_wspieranie operator¢w C (*=,+=,/= oraz -=) +**2Sa_doˆ¥czanie kodu asercji +**2Sd_to samo co -Mdelphi +**2Se<x>_opcje bˆ©d¢w. <x> jest kombinacj¥: +**3*_<n> : kompilator zatrzymuje si© po <x> bˆ©dach (domy˜lnie 1) +**3*_w : kompilator zatrzymuje si© tak¾e na ostrze¾eniach +**3*_n : kompilator zatrzymuje si© tak¾e na notkach +**3*_h : kompilator zatrzymuje si© tak¾e na podpowiedziach +**2Sg_zezwolenie na LABEL i GOTO +**2Sh_u¾ycie ansistring¢w +**2Si_wspieranie INLINE w stylu C++ +**2SI<x>_ustawia styl interfejs¢w na <x> +**3SIcom_interfejsy kompatybilne z COM (domy˜lne) +**3SIcorba_interfejsy kompatybilne z CORBA +**2Sm_wspieranie makr jak w C (opcja globalna) +**2So_to samo co -Mtp +**2Sp_to samo co -Mgpc +**2Ss_konstruktory musz¥ mie† nazw© init (destruktory - done) +**1s_pomini©cie wywoˆania asemblera i linkera +**2sh_generacja skryptu do linkowania na ho˜cie +**2st_generacja skryptu do linkowania na celu +**2sr_omini©cie fazy alokowania rejestr¢w (u¾ywaj z -alr) +**1T<x>_docelowy system operacyjny: +3*2Temx_OS/2 na EMX (wliczaj¥c EMX/RSX extender) +3*2Tfreebsd_FreeBSD +3*2Tgo32v2_DJ Delorie DOS extender - wersja 2 +3*2Tlinux_Linux +3*2Tnetbsd_NetBSD +3*2Tnetware_Novell Netware Module (clib) +3*2Tnetwlibc_Novell Netware Module (libc) +3*2Topenbsd_OpenBSD +3*2Tos2_OS/2 / eComStation +3*2Tsunos_SunOS/Solaris +3*2Twatcom_DOS extendery zgodne z Watcomem +3*2Twdosx_WDOSX DOS extender +3*2Twin32_32-bitowy Windows +4*2Tlinux_Linux +6*2Tamiga_Commodore Amiga +6*2Tatari_Atari ST/STe/TT +6*2Tlinux_Linux-68k +6*2Tmacos_Macintosh m68k (nie wspierane) +6*2Tpalmos_PalmOS +A*2Tlinux_Linux +P*2Tdarwin_Darwin i MacOS X na PowerPC +P*2Tlinux_Linux na PowerPC +P*2Tmacos_MacOS (klasyczny) na PowerPC +P*2Tmorphos_MorphOS +S*2Tlinux_Linux +**1u<x>_usuni©cie symbolu <x> +**1U_opcje moduˆ¢w: +**2Un_pomini©cie sprawdzania nazwy moduˆu +**2Ur_generacja moduˆu do wydania (release) +**2Us_kompilacja moduˆu system +**1v<x>_obszerne opisy. <x> jest kombinacj¥ nast©puj¥cych liter i cyfr: +**2*_e : pokazuje bˆ©dy (domy˜lne) 0 : nic nie pokazuje (opr¢cz bˆ©d¢w) +**2*_w : pokazuje ostrze¾enia u : pokazuje informacje o moduˆach +**2*_n : pokazuje notki t : pokazuje pr¢bowane/u¾yte pliki +**2*_h : pokazuje podpowiedzi c : pokazuje warunki +**2*_i : pokazuje og¢lne informacje d : pokazuje informacje debugowania +**2*_l : pokazuje numery lini r : tryb kompatybilno˜ci z Rhide/GCC +**2*_a : pokazuje wszystko x : informacje o pliku exe (tylko Win32) +**2*_v : zapisuje plik fpcdebug.txt p : zapisuje tree.log z drzewem +**2*_ z du¾¥ ilo˜ci¥ informacji parsowania +3*1W<x>_opcje dla Win32 i podobnych +3*2WB_tworzenie relokacyjnego obrazu +3*2WB<x>_ustawienie bazy obrazu na szesnastkow¥ warto˜† <x> +3*2WC_aplikacja konsolowa +3*2WD_u¾ycie DEFFILE do eksportu funkcji z DLLa lub EXE +3*2WF_aplikacja peˆnoekranowa (tylko OS/2) +3*2WG_aplikacja graficzna +3*2WN_nie generuje kodu relokacji (potrzebne do debugowania) +3*2WR_generuje kod relokacji +P*2WC_aplikacja konsolowa (tylko MacOS) +P*2WG_aplikacja graficzna (tylko MacOS) +P*2WT_aplikacja narz©dziowa (narz©dzie MPW, tylko MacOS) +**1X_opcje plik¢w wykonywalnych: +**2Xc_podaje --shared do linkera (tylko Unix) +**2Xd_nie u¾ywa standardowej ˜cie¾ki bibliotek (potrzebne do cross-kompilacji) +**2XD_linkowanie dynamiczne (definiuje FPC_LINK_DYNAMIC) +**2Xm_generuje link map +**2XM<x>_ustawia nazw© gˆ¢wnego bloku programu (domy˜lnie 'main') +**2XP<x>_poprzedza nazw© binutils tekstem <x> +**2Xr<x>_ustawia ˜cie¾k© bibliotek na <x> (potrzebne do cross-kompilacji) +**2Xs_wyci©cie wszystkich symboli z pliku +**2XS_linkowanie statycznie (domy˜lne)(definiuje FPC_LINK_STATIC) +**2Xt_linkuje z bibliotekami statycznymi (podaje -static do linkera) +**2XX_linkowanie smart (definiuje FPC_LINK_SMART) +**1*_ +**1?_pokazanie pomocy +**1h_pokazanie pomocy bez zatrzymywania +] + +# +# The End... diff --git a/closures/compiler/msg/errorpli.msg b/closures/compiler/msg/errorpli.msg new file mode 100644 index 0000000000..2660eaf4b8 --- /dev/null +++ b/closures/compiler/msg/errorpli.msg @@ -0,0 +1,2385 @@ +# +# This file is part of the Free Pascal Compiler +# Copyright (c) 1999-2000 by the Free Pascal Development team +# +# Polish (ISO 8859-2) Language File for Free Pascal +# +# 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. +# +# +# The constants are build in the following order: +# <part>_<type>_<txtidentifier> +# +# <part> is the part of the compiler the message is used +# asmr_ assembler parsing +# asmw_ assembler writing/binary writers + +# unit_ unit handling +# scan_ scanner +# parser_ parser +# type_ type checking +# general_ general info +# exec_ calls to assembler, linker, binder +# +# <type> the type of the message it should normally used for +# f_ fatal error +# e_ error +# w_ warning +# n_ note +# h_ hint +# i_ info +# l_ linenumber +# u_ used +# t_ tried +# c_ conditional +# d_ debug message +# x_ executable informations +# + +# +# General +# +# 01016 is the last used one +# +# BeginOfTeX +% \section{General compiler messages} +% This section gives the compiler messages which are not fatal, but which +% display useful information. The number of such messages can be +% controlled with the various verbosity level \var{-v} switches. +% \begin{description} +general_t_compilername=01000_T_Kompilator: $1 +% When the \var{-vt} switch is used, this line tells you what compiler +% is used. +general_d_sourceos=01001_D_OS kompilatora: $1 +% When the \var{-vd} switch is used, this line tells you what the source +% operating system is. +general_i_targetos=01002_I_Docelowy OS: $1 +% When the \var{-vd} switch is used, this line tells you what the target +% operating system is. +general_t_exepath=01003_T_¦cie¿ka narzêdzi: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its binaries. +general_t_unitpath=01004_T_¦cie¿ka modu³ów: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for compiled units. You can set this path with the \var{-Fu} +general_t_includepath=01005_T_¦cie¿ka include'ów: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its include files (files used in \var{\{\$I xxx\}} statements). +% You can set this path with the \var{-I} option. +general_t_librarypath=01006_T_¦cie¿ka bibliotek: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for the libraries. You can set this path with the \var{-Fl} option. +general_t_objectpath=01007_T_¦cie¿ka obiektów: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for object files you link in (files used in \var{\{\$L xxx\}} statements). +% You can set this path with the \var{-Fo} option. +general_i_abslines_compiled=01008_I_$1 linii skompilowanych w $2 sek +% When the \var{-vi} switch is used, the compiler reports the number +% of lines compiled, and the time it took to compile them (real time, +% not program time). +general_f_no_memory_left=01009_F_Brak pamiêci +% The compiler doesn't have enough memory to compile your program. There are +% several remedies for this: +% \begin{itemize} +% \item If you're using the build option of the compiler, try compiling the +% different units manually. +% \item If you're compiling a huge program, split it up in units, and compile +% these separately. +% \item If the previous two don't work, recompile the compiler with a bigger +% heap (you can use the \var{-Ch} option for this, \seeo{Ch}) +% \end{itemize} +general_i_writingresourcefile=01010_I_Zapisywanie pliku zasobów: $1 +% This message is shown when the compiler writes the Resource String Table +% file containing all the resource strings for a program. +general_e_errorwritingresourcefile=01011_E_B³±d podczas zapisywania pliku zasobów: $1 +% This message is shown when the compiler encountered an error when writing +% the Resource String Table file +general_i_fatal=01012_I_B³±d krytyczny: +% Prefix for Fatal Errors +general_i_error=01013_I_B³±d: +% Prefix for Errors +general_i_warning=01014_I_Ostrze¿enie: +% Prefix for Warnings +general_i_note=01015_I_Nota: +% Prefix for Notes +general_i_hint=01016_I_Podpowied¼: +% Prefix for Hints +general_e_path_does_not_exist=01017_E_¦cie¿ka "$1" nie istnieje +% The specified path does not exist. +general_e_compilation_aborted=01018_E_Kompilacja zatrzymana +% \end{description} +# +# Scanner +# +# 02063 is the last used one +# +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compiling handling. +% \begin{description} +scan_f_end_of_file=02000_F_Nieoczekiwany koniec pliku +% this typically happens in one of the following cases : +% \begin{itemize} +% \item The source file ends before the final \var{end.} statement. This +% happens mostly when the \var{begin} and \var{end} statements aren't +% balanced; +% \item An include file ends in the middle of a statement. +% \item A comment wasn't closed. +% \end{itemize} +scan_f_string_exceeds_line=02001_F_String przekracza jedn± liniê +% You forgot probably to include the closing ' in a string, so it occupies +% multiple lines. +scan_f_illegal_char=02002_F_Nieprawid³owy znak $1 ($2) +% An illegal character was encountered in the input file. +scan_f_syn_expected=02003_F_B³±d sk³adni, oczekiwano $1 ale napotkano $2 +% This indicates that the compiler expected a different token than +% the one you typed. It can occur almost everywhere where you make a +% mistake against the pascal language. +scan_t_start_include_file=02004_T_Rozpoczêcie czytania pliku include $1 +% When you provide the \var{-vt} switch, the compiler tells you +% when it starts reading an included file. +scan_w_comment_level=02005_W_Znaleziono komentarz $1 stopnia +% When the \var{-vw} switch is used, then the compiler warns you if +% it finds nested comments. Nested comments are not allowed in Turbo Pascal +% and can be a possible source of errors. +scan_n_ignored_switch=02008_N_Zignorowany prze³±cznik kompilatora $1 +% With \var{-vn} on, the compiler warns if it ignores a switch +scan_w_illegal_switch=02009_W_Nieprawid³owy prze³±cznik kompilatora $1 +% You included a compiler switch (i.e. \var{\{\$... \}}) which the compiler +% doesn't know. +scan_w_switch_is_global=02010_W_Prze³±cznik globalny w nieprawid³owym miejscu +% The compiler switch is misplaced, and should be located at +% the start of the unit or program. +scan_e_illegal_char_const=02011_E_Nieprawid³owa sta³a znakowa +% This happens when you specify a character with its ASCII code, as in +% \var{\#96}, but the number is either illegal, or out of range. +scan_f_cannot_open_input=02012_F_Nie mo¿na otworzyæ pliku $1 +% \fpc cannot find the program or unit source file you specified on the +% command line. +scan_f_cannot_open_includefile=02013_F_Nie mo¿na otworzyæ pliku include $1 +% \fpc cannot find the source file you specified in a \var{\{\$include ..\}} +% statement. +scan_w_only_pack_records=02015_W_Pola rekordów mog± byæ wyrównane tylko do 1,2,4,8,16 lub 32 bajtów +% You are specifying the \var{\{\$PACKRECORDS n\} } or \var{\{\$ALIGN n\} } +% with an illegal value for \var{n}. For $PACKRECORDS valid alignments are 1, 2, 4, 8, 16, 32, C, +% NORMAL, DEFAULT, and for $ALIGN valid alignment are 1, 2, 4, 8, 16, 32, ON, +% OFF. Under mode MacPas $ALIGN also supports MAC68K, POWER and RESET. +scan_w_only_pack_enum=02016_W_Wyliczenia mog± byæ zapisane tylko na 1, 2 lub 4 bajtach +% You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for +% \var{n}. Only 1,2 or 4 are valid in this case. +scan_e_endif_expected=02017_E_Oczekiwano $ENDIF dla $1 $2 zdefiniowanych w linii $3 +% Your conditional compilation statements are unbalanced. +scan_e_preproc_syntax_error=02018_E_B³±d sk³adni podczas parsowania dyrektyw kompilacji warunkowej +% There is an error in the expression following the \var{\{\$if ..\}} compiler +% directive. +scan_e_error_in_preproc_expr=02019_E_B³±d obliczania wyra¿enia kompilacji warunkowej +% There is an error in the expression following the \var{\{\$if ..\}} compiler +% directive. +scan_w_macro_cut_after_255_chars=02020_W_Tre¶æ makra zosta³a obciêta po 255 znaku +% The contents of macros canno be longer than 255 characters. +scan_e_endif_without_if=02021_E_ENDIF bez IF(N)DEF +% Your \var{\{\$IFDEF ..\}} and {\{\$ENDIF\}} statements aren't balanced. +scan_f_user_defined=02022_F_Zdefiniowany przez u¿ytkownika: $1 +% A user defined fatal error occurred. see also the \progref +scan_e_user_defined=02023_E_Zdefiniowany przez u¿ytkownika: $1 +% A user defined error occurred. see also the \progref +scan_w_user_defined=02024_W_Zdefiniowane przez u¿ytkownika: $1 +% A user defined warning occurred. see also the \progref +scan_n_user_defined=02025_N_Zdefiniowana przez u¿ytkownika: $1 +% A user defined note was encountered. see also the \progref +scan_h_user_defined=02026_H_Zdefiniowana przez u¿ytkownika: $1 +% A user defined hint was encountered. see also the \progref +scan_i_user_defined=02027_I_Zdefiniowana przez u¿ytkownika: $1 +% User defined information was encountered. see also the \progref +scan_e_keyword_cant_be_a_macro=02028_E_S³owo kluczowe nie mo¿e zostaæ przedefiniowane przez makro +% You cannot redefine keywords with macros. +scan_f_macro_buffer_overflow=02029_F_Przepe³nienie bufora podczas czytania lub rozwijania makra +% Your macro or its result was too long for the compiler. +scan_e_macro_deep_ten=02030_E_Rozwijanie makra przerwane po 16 rozwiniêciach. +% When expanding a macro macros have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_e_wrong_styled_switch=02031_E_Prze³±czniki kompilatora nie s± dozwolone w komentarzach typu (* ... *) +% Compiler switches should always be between \var{\{ \}} comment delimiters. +scan_d_handling_switch=02032_D_Obs³ugiwanie prze³±cznika "$1" +% When you set debugging info on (\var{-vd}) the compiler tells you when it +% is evaluating conditional compile statements. +scan_c_endif_found=02033_C_Znaleziono ENDIF $1 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifdef_found=02034_C_Znaleziono IFDEF $1 , $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifopt_found=02035_C_Znalezino IFOPT $1 , $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_if_found=02036_C_Znaleziono IF $1 , $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifndef_found=02037_C_Znaleziono IFNDEF $1 , $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_else_found=02038_C_Znaleziono ELSE $1 , $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_skipping_until=02039_C_Omijanie... +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements, and whether it is skipping or +% compiling parts. +scan_i_press_enter=02040_I_Naci¶nij <enter> aby kontynuowaæ +% When the \var{-vi} switch is used, the compiler stops compilation +% and waits for the \var{Enter} key to be pressed when it encounters +% a \var{\{\$STOP\}} directive. +scan_w_unsupported_switch=02041_W_Nieobs³ugiwany prze³±cznik $1 +% When warnings are turned on (\var{-vw}) the compiler warns you about +% unsupported switches. This means that the switch is used in Delphi or +% Turbo Pascal, but not in \fpc +scan_w_illegal_directive=02042_W_Nieprawid³owa dyrektywa $1 +% When warings are turned on (\var{-vw}) the compiler warns you about +% unrecognised switches. For a list of recognised switches, \progref +scan_t_back_in=02043_TL_Z powrotem w $1 +% When you use (\var{-vt}) the compiler tells you when it has finished +% reading an include file. +scan_w_unsupported_app_type=02044_W_Nieprawid³owy typ aplikacji: $1 +% You get this warning, if you specify an unknown application type +% with the directive \var{\{\$APPTYPE\}} +scan_w_app_type_not_support=02045_W_Typ aplikacji nieobs³ugiwany przez docelowy OS +% The \var{\{\$APPTYPE\}} directive is supported by win32 applications only. +scan_w_description_not_support=02046_W_Dyrektywa DESCRIPTION jest obs³ugiwany tylko przez OS2 i Win32 +% The \var{\{\$DESCRIPTION\}} directive is only supported for OS2 and Win32 targets. +scan_n_version_not_support=02047_N_Dyrektywa VERSION nie jest obs³ugiwana przez OS +% The \var{\{\$VERSION\}} directive is only supported by win32 target. +scan_n_only_exe_version=02048_N_Dyrektywa VERSION jest dostêna tylko dla programów i DLLi +% The \var{\{\$VERSION\}} directive is only used for executable or DLL sources. +scan_w_wrong_version_ignored=02049_W_Nieprawid³owy format dyrektywy VERSION $1 +% The \var{\{\$VERSION\}} directive format is majorversion.minorversion +% where majorversion and minorversion are words. +scan_w_unsupported_asmmode_specifier=02050_W_Nieprawid³owy styl asemblera $1 +% When you specify an assembler mode with the \var{\{\$ASMMODE xxx\}} +% the compiler didn't recognize the mode you specified. +scan_w_no_asm_reader_switch_inside_asm=02051_W_Prze³±cznik stylu asemblera niedozwolony w bloku asemblera, $1 bêdzie dzia³aæ dopiero w nastêpnym bloku +% It is not possible to switch from one assembler reader to another +% inside an assmebler block. The new reader will be used for next +% assembler statement only. +scan_e_wrong_switch_toggle=02052_E_Z³a warto¶æ prze³±cznika, u¿yj ON/OFF lub +/- +% You need to use ON or OFF or a + or - to toggle the switch +scan_e_resourcefiles_not_supported=02053_E_Pliki zasobów nie s± obs³ugiwane przez OS +% The target you are compiling for doesn't support resource files. +scan_w_include_env_not_found=02054_W_Zmienna ¶rodowiskowa $1 nie odnaleziona +% The included environment variable can't be found in the environment, it'll +% be replaced by an empty string instead. +scan_e_invalid_maxfpureg_value=02055_E_Nieprawid³owa warto¶æ limitu rejestru FPU +% Valid values for this directive are 0..8 and NORMAL/DEFAULT +scan_w_only_one_resourcefile_supported=02056_W_Tylko jeden plik zasobów jest obs³ugiwany przez docelowy OS +% The target you are compiling for supports only one resource file. +% The first resource file found is used, the others are discarded. +scan_w_macro_support_turned_off=02057_W_Obs³uga makr jest wy³±czona +% A macro declaration has been found, but macro support is currently off, +% so the declaration will be ignored. To turn macro support on compile with +% -Sm on the commandline or add {$MACRO ON} in the source +scan_e_invalid_interface_type=02058_E_Nieprawid³owy typ interfejsu. Prawid³owe s± COM, CORBA i DEFAULT. +% The interface type that was specified is not supported +scan_w_appid_not_support=02060_W_APPNAME jest obs³ugiwane tylko przez PalmOS +% The \var{\{\$APPID\}} directive is only supported for the PalmOS target. +scan_w_appname_not_support=02061_W_Dyrektywa APPNAME jest obs³ugiwana tylko przez PalmOS +% The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target. +scan_e_string_exceeds_255_chars=02061_E_Sta³e ³añcuchowe nie mog± byæ d³u¿sze ni¿ 255 znaków +% A single string constant can contain at most 255 chars. Try splitting up the +% string in multiple smaller parts and concatenate them with a + operator. +scan_f_include_deep_ten=02062_F_Przekroczono maksymaln± ilo¶æ zagnie¿d¿onych include (16) +% When including include files the files have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_e_too_many_push=02063_F_Zbyt du¿o poziomów PUSH +% A maximum of 20 levels is allowed. This error occurs only in mode MacPas. +scan_e_too_many_pop=02064_E_Napotkano POP bez poprzedzaj±cego go PUSH +% This error occurs only in mode MacPas. +scan_e_error_macro_lacks_value=02065_E_Makro lub zmienna "$1" nie ma przypisanej warto¶ci +% Thus the conditional compile time expression cannot be evaluated. +scan_e_wrong_switch_toggle_default=02066_E_Nieprawid³owy prze³±cznik, u¿yj ON/OFF/DEFAULT lub +/-/* +% You need to use ON or OFF or DEFAULT or a + or - or * to toggle the switch +scan_e_mode_switch_not_allowed=02067_E_Prze³±cznik trybu "$1" jest niedozwolony w tym miejscu +% A mode switch has already been encountered, or, in case of option -Mmacpas, +% a mode switch occur after UNIT. +scan_e_error_macro_undefined=02068_E_Zmienna "$1" jest niezdefiniowana +% Thus the conditional compile time expression cannot be evaluated. +scan_e_utf8_bigger_than_65535=02069_E_Napotkano kod UTF-8 wiêkszy od 65535 +% \fpc handles utf-8 strings internally as widestrings e.g. the char codes are limited to 65535 +scan_e_utf8_malformed=02070_E_Zniekszta³cony string UTF-8 +% The given string isn't a valid UTF-8 string +scan_c_switching_to_utf8=02071_C_Napotkano sygnaturê UTF-8, u¿ycie kodowania UTF-8 +% The compiler found an UTF-8 encoding signature ($ef, $bb, $bf) at the beginning of a file, +% so it interprets it as an UTF-8 file +% \end{description} +# +# Parser +# +# 03192 is the last used one +# +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your pascal constructs +% are correct. +% \begin{description} +parser_e_syntax_error=03000_E_Parser - B³±d sk³adni +% An error against the Turbo Pascal language was encountered. This happens +% typically when an illegal character is found in the sources file. +parser_e_dont_nest_interrupt=03004_E_Procedura typu INTERRUPT nie mo¿e byæ zagnie¿d¿ona +% An \var{INTERRUPT} procedure must be global. +parser_w_proc_directive_ignored=03005_W_Dyrektywa $1 zignorowana +% The specified is ignored by FPC programs. +parser_e_no_overload_for_all_procs=03006_E_Nie wszystkie deklaracje $1 s± przeci±¿one +% When you want to use overloading using the \var{OVERLOAD} directive, then +% all declarations need to have \var{OVERLOAD} specified. +parser_e_export_name_double=03008_E_Zduplikowana nazwa eksportu $1 +% Exported function names inside a specific DLL must all be different +parser_e_export_ordinal_double=03009_E_Zduplikowany indeks eksportowanej funkcji $1 +% Exported function names inside a specific DLL must all be different +parser_e_export_invalid_index=03010_E_Nieprawid³owa warto¶æ indeksu funkcji +% DLL function index must be in the range \var{1..\$FFFF} +parser_w_parser_reloc_no_debug=03011_W_Informacje debugera w DLLu lub programie $1 nie dzia³aj±, wy³±czone. +parser_w_parser_win32_debug_needs_WN=03012_W_Aby móc debugowaæ kod win32 musisz wy³±czyæ generowanie kodu relokacji prze³±cznikiem -WN +% Stabs info is wrong for relocatable DLL or EXES use -WN +% if you want to debug win32 executables. +parser_e_constructorname_must_be_init=03013_E_Konstruktor musi nazywaæ siê INIT +% You are declaring a constructor with a name which isn't \var{init}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_destructorname_must_be_done=03014_E_Destruktor musi nazywaæ siê DONE +% You are declaring an object destructor with a name which is not \var{done}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_proc_inline_not_supported=03016_E_Typ INLINE nieobs³ugiwany (u¿yj opcji -Si) +% You tried to compile a program with C++ style inlining, and forgot to +% specify the \var{-Si} option (\seeo{Si}). The compiler doesn't support C++ +% styled inlining by default. +parser_w_constructor_should_be_public=03018_W_Konstruktor powinien byæ publiczny +% Constructors must be in the 'public' part of an object (class) declaration. +parser_w_destructor_should_be_public=03019_W_Destruktor powinien byæ publiczny +% Destructors must be in the 'public' part of an object (class) declaration. +parser_n_only_one_destructor=03020_N_Klasa powinna mieæ tylko jeden destruktor +% You can declare only one destructor for a class. +parser_e_no_local_objects=03021_E_Definicje lokalne w klasie s± niedozwolone +% Classes must be defined globally. They cannot be defined inside a +% procedure or function +parser_f_no_anonym_objects=03022_F_Definicje anonimowych klas s± niedozwolone +% An invalid object (class) declaration was encountered, i.e. an +% object or class without methods that isn't derived from another object or +% class. For example: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% will trigger this error. +parser_object_has_no_vmt=03023_E_Obiekt $1 nie posiada VMT +% This is a note indicating that the declared object has no +% virtual method table. +parser_e_illegal_parameter_list=03024_E_Nieprawid³owa lista parametrów +% You are calling a function with parameters that are of a different type than +% the declared parameters of the function. +parser_e_wrong_parameter_size=03026_E_Nieprawid³owa ilo¶æ parametrów +% There is an error in the parameter list of the function or procedure, +% the number of parameters is not correct. +parser_e_overloaded_no_procedure=03027_E_Przeci±¿ony identyfikator $1 nie jest funkcj± +% The compiler encountered a symbol with the same name as an overloaded +% function, but it is not a function it can overload. +parser_e_overloaded_have_same_parameters=03028_E_Przeci±¿ona funkcja musi mieæ chocia¿ jeden parametr wyró¿niaj±cy +% You're declaring overloaded functions, but with the same parameter list. +% Overloaded function must have at least 1 different parameter in their +% declaration. +parser_e_header_dont_match_forward=03029_E_Nag³ówek funkcji nie pasuje do deklaracji $1 +% You declared a function with same parameters but +% different result type or function modifiers. +parser_e_header_different_var_names=03030_E_Nag³ówek funkcji $1 nie pasuje : nazwy parametrów zmienione $2 => $3 +% You declared the function in the \var{interface} part, or with the +% \var{forward} directive, but define it with a different parameter list. +parser_n_duplicate_enum=03031_N_Ci±g warto¶ci typu wyliczeniowego musi byæ rosn±cy +% \fpc allows enumeration constructions as in C. Given the following +% declaration two declarations: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% The second declaration would produce an error. \var{A\_UAS} needs to have a +% value higher than \var{A\_E}, i.e. at least 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_With nie mo¿e byæ u¿yte ze zmiennymi w innym segmencie +% With stores a variable locally on the stack, +% but this is not possible if the variable belongs to another segment. +parser_e_too_much_lexlevel=03034_E_Przekroczono limit zagnie¿d¿enia funkcji +% You can nest function definitions only 31 times. +parser_e_range_check_error=03035_E_B³±d zakresu podczas obliczania sta³ej +% The constants are out of their allowed range. +parser_w_range_check_error=03036_W_B³±d zakresu podczas obliczania sta³ej +% The constants are out of their allowed range. +parser_e_double_caselabel=03037_E_Zduplikowana etykieta w instrukcji case +% You are specifying the same label 2 times in a \var{case} statement. +parser_e_case_lower_less_than_upper_bound=03038_E_Górna granica zakresu jest mniejsza od dolnej +% The upper bound of a \var{case} label is less than the lower bound and this +% is useless +parser_e_type_const_not_possible=03039_E_Sta³a typowana nie mo¿e byæ klas± ani obiektem +% You cannot declare a constant of type class or object. +parser_e_no_overloaded_procvars=03040_E_Do zmiennych proceduralnych nie mo¿na przypisaæ przeci±¿onych funkcji +% You are trying to assign an overloaded function to a procedural variable. +% This isn't allowed. +parser_e_invalid_string_size=03041_E_D³ugo¶æ stringa musi zawieraæ siê miêdzy 1 a 255 +% The length of a shortstring in Pascal is limited to 255 characters. You are +% trying to declare a string with length lower than 1 or greater than 255 +parser_w_use_extended_syntax_for_objects=03042_W_U¿yj rozszerzonej sk³adni NEW i DISPOSE dla obiektów +% If you have a pointer \var{a} to a class type, then the statement +% \var{new(a)} will not initialize the class (i.e. the constructor isn't +% called), although space will be allocated. you should issue the +% \var{new(a,init)} statement. This will allocate space, and call the +% constructor of the class. +parser_w_no_new_dispose_on_void_pointers=03043_W_U¿ycie NEW lub DISPOSE nie ma sensu dla nietypowanych wska¼ników +parser_e_no_new_dispose_on_void_pointers=03044_E_U¿ycie NEW lub DISPOSE jest niemo¿liwe dla nietypowanych wska¼ników +% You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer +% because no size is associated to an untyped pointer. +% Accepted for compatibility in \var{tp} and \var{delphi} modes. +parser_e_class_id_expected=03045_E_Oczekiwano identyfikatora klasy +% This happens when the compiler scans a procedure declaration that contains +% a dot, +% i.e., a object or class method, but the type in front of the dot is not +% a known type. +parser_e_no_type_not_allowed_here=03046_E_Identyfikator typu jest niedozwolony w tym miejscu +% You cannot use a type inside an expression. +parser_e_methode_id_expected=03047_E_Oczekiwano identyfikatora metody +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_e_header_dont_match_any_member=03048_E_Nag³ówek funkcji nie pasuje do ¿adnej metody tej klasy $1 +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_d_procedure_start=03049_DL_Procedura/Funkcja $1 +% When using the \var{-vp} switch, the compiler tells you when it starts +% processing a procedure or function implementation. +parser_e_error_in_real=03050_E_Nieprawid³owa warto¶æ sta³ej zmiennoprzecinkowej +% The compiler expects a floating point expression, and gets something else. +parser_e_fail_only_in_constructor=03051_E_FAIL mo¿e byæ u¿yte tylko w konstruktorach +% You are using the \var{FAIL} instruction outside a constructor method. +parser_e_no_paras_for_destructor=03052_E_Destruktory nie mog± mieæ parametrów +% You are declaring a destructor with a parameter list. Destructor methods +% cannot have parameters. +parser_e_only_class_methods_via_class_ref=03053_E_Tylko metody klasy mog± byæ wywo³ywane w ten sposób +% This error occurs in a situation like the following: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} is not a class method and hence cannot be called with a class +% reference. +parser_e_only_class_methods=03054_E_W metodach klasy mo¿esz u¿ywaæ tylko metod klasy +% This is related to the previous error. You cannot call a method of an object +% from a inside a class method. The following code would produce this error: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% Because free is a normal method of a class it cannot be called from a class +% method. +parser_e_case_mismatch=03055_E_Sta³a i zmienna u¿yta w CASE nie s± tego samego typu +% One of the labels is not of the same type as the case variable. +parser_e_illegal_symbol_exported=03056_E_Symbol nie mo¿e byæ wyeksportowany +% You can only export procedures and functions when you write a library. You +% cannot export variables or constants. +parser_w_should_use_override=03057_W_Dziedziczona metoda jest ukryta przez $1 +% A method that is declared \var{virtual} in a parent class, should be +% overridden in the descendent class with the \var{override} directive. If you +% don't specify the \var{override} directive, you will hide the parent method; +% you will not override it. +parser_e_nothing_to_be_overridden=03058_E_Nie ma takiej metody w dziedziczonej klasie: $1 +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_no_procedure_to_access_property=03059_E_Brak metody do odczytania w³asno¶ci +% You specified no \var{read} directive for a property. +parser_w_stored_not_implemented=03060_W_Dyrektywa stored nie jest jeszcze zaimplementowana +% The \var{stored} directive is not yet implemented +parser_e_ill_property_access_sym=03061_E_Nieprawid³owy symbol dla dostêpu do w³asno¶ci +% There is an error in the \var{read} or \var{write} directives for an array +% property. When you declare an array property, you can only access it with +% procedures and functions. The following code woud cause such an error. +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_Nie mo¿na siê odwo³ywaæ do pola protected obiektu w tym miejscu +% Fields that are declared in a \var{protected} section of an object or class +% declaration cannot be accessed outside the module wher the object is +% defined, or outside descendent object methods. +parser_e_cant_access_private_member=03063_E_Nie mo¿na siê odwo³ywaæ do pola private obiektu w tym miejscu +% Fields that are declared in a \var{private} section of an object or class +% declaration cannot be accessed outside the module where the class is +% defined. +parser_e_overridden_methods_not_same_ret=03066_E_Przeci±¿one metody wirtualne powinny mieæ taki sam typ zwracanych warto¶ci: "$2" jest przeci±¿one przez "$" o innym zwracanym typie +% If you declare overridden methods in a class definition, they must +% have the same return type. +parser_e_dont_nest_export=03067_E_Eksportowane funkcje nie mog± byæ zagnie¿d¿one +% You cannot declare a function or procedure within a function or procedure +% that was declared as an export procedure. +parser_e_methods_dont_be_export=03068_E_Metody nie mog± byæ eksportowane +% You cannot declare a procedure that is a method for an object as +% \var{export}ed. That is, your methods cannot be called from a C program. +parser_e_call_by_ref_without_typeconv=03069_E_Przy przekazywaniu przez referencjê parametry musz± byæ tego samego typu: Otrzymano $1, a oczekiwano $2 +% When calling a function declared with \var{var} parameters, the variables in +% the function call must be of exactly the same type. There is no automatic +% type conversion. +parser_e_no_super_class=03070_E_Ta klasa nie jest przodkiem bie¿±cej klasy +% When calling inherited methods, you are trying to call a method of a strange +% class. You can only call an inherited method of a parent class. +parser_e_self_not_in_method=03071_E_SELF jest dostêpne tylko w metodach +% You are trying to use the \var{self} parameter outside an object's method. +% Only methods get passed the \var{self} parameters. +parser_e_generic_methods_only_in_methods=03072_E_Metody mog± byæ wywo³ane bezpo¶rednio identyfikatorem typu klasy tylko w innych metodach +% A construction like \var{sometype.somemethod} is only allowed in a method. +parser_e_illegal_colon_qualifier=03073_E_Nieprawid³owe u¿ycie ':' +% You are using the format \var{:} (colon) 2 times on an expression that +% is not a real expression. +parser_e_illegal_set_expr=03074_E_B³±d zakresu lub zduplikowany element w deklaracji zbioru +% The declaration of a set contains an error. Either one of the elements is +% outside the range of the set type, either two of the elements are in fact +% the same. +parser_e_pointer_to_class_expected=03075_E_Oczekiwano wska¼nika do obiektu +% You specified an illegal type in a \var{New} statement. +% The extended syntax of \var{new} needs an object as a parameter. +parser_e_expr_have_to_be_constructor_call=03076_E_Wyra¿enie musi byæ wywo³aniem konstruktora +% When using the extended syntax of \var{new}, you must specify the constructor +% method of the object you are trying to create. The procedure you specified +% is not a constructor. +parser_e_expr_have_to_be_destructor_call=03077_E_Wyra¿enie musi byæ wywo³aniem destruktora +% When using the extended syntax of \var{dispose}, you must specify the +% destructor method of the object you are trying to dispose of. +% The procedure you specified is not a destructor. +parser_e_invalid_record_const=03078_E_Nieprawid³owa kolejno¶æ elementów rekordu +% When declaring a constant record, you specified the fields in the wrong +% order. +parser_e_false_with_expr=03079_E_Wyra¿enie musi byæ rekordem lub klas± +% A \var{with} statement needs an argument that is of the type \var{record} +% or \var{class}. You are using \var{with} on an expression that is not of +% this type. +parser_e_void_function=03080_E_Procedury nie mog± zwracaæ warto¶ci +% In \fpc, you can specify a return value for a function when using +% the \var{exit} statement. This error occurs when you try to do this with a +% procedure. Procedures cannot return a value. +parser_e_only_methods_allowed=03081_E_Konstruktory, destructory i class operators musz± byæ metodami +% You're declaring a procedure as destructor, constructor or class operator, when the +% procedure isn't a class method. +parser_e_operator_not_overloaded=03082_E_Operator nie jest przeci±¿ony +% You're trying to use an overloaded operator when it isn't overloaded for +% this type. +parser_e_no_such_assignment=03083_E_Nie mo¿a przeci±¿yæ przypisania dla takich samych typów +% You can not overload assignment for types +% that the compiler considers as equal. +parser_e_overload_impossible=03084_E_Niemo¿liwe przeci±¿enie operatora +% The combination of operator, arguments and return type are +% incompatible. +parser_e_no_reraise_possible=03085_E_Ponowne wywo³anie wyj±tku niemo¿liwe w tym miejscu +% You are trying to raise an exception where it isn't allowed. You can only +% raise exceptions in an \var{except} block. +parser_e_no_new_or_dispose_for_classes=03086_E_Rozszerzona sk³adnia new i dispose jest niedozwolona dla klas +% You cannot generate an instance of a class with the extended syntax of +% \var{new}. The constructor must be used for that. For the same reason, you +% cannot call \var{Dispose} to de-allocate an instance of a class, the +% destructor must be used for that. +parser_e_procedure_overloading_is_off=03088_E_Przeci±¿anie procedur jest wy³±czone +% When using the \var{-So} switch, procedure overloading is switched off. +% Turbo Pascal does not support function overloading. +parser_e_overload_operator_failed=03089_E_Przeci±¿enie tego operatora jest niemo¿liwe +% You are trying to overload an operator which cannot be overloaded. +% The following operators can be overloaded : +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_Operator porównania musi zwracaæ warto¶æ typu Boolean +% When overloading the \var{=} operator, the function must return a boolean +% value. +parser_e_only_virtual_methods_abstract=03091_E_Tylko metody wirtualne mog± byæ abstrakcyjne +% You are declaring a method as abstract, when it isn't declared to be +% virtual. +parser_f_unsupported_feature=03092_F_U¿ycie nieobs³ugiwanej funkcji kompilatora! +% You're trying to force the compiler into doing something it cannot do yet. +parser_e_mix_of_classes_and_objects=03093_E_Mieszanie ró¿nych typów obiektów (obiektów, klas, interfejsów) jest niedozwolone +% You cannot derive \var{objects}, \var{classes}, \var{cppclasses} and \var{interfaces} interttwined . E.g. +% a class cannot have an object as parent and vice versa. +parser_w_unknown_proc_directive_ignored=03094_W_Nieznana dyrektywa procedury zosta³a zignorowana: $1 +% The procedure directive you specified is unknown. +parser_e_absolute_only_one_var=03095_E_Absolute mo¿e byæ powi±zane tylko z jedn± zmienn± +% You cannot specify more than one variable before the \var{absolute} directive. +% Thus, the following construct will provide this error: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +% \item [ absolute can only be associated a var or const ] +% The address of a \var{absolute} directive can only point to a variable or a +% typed constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_absolute_only_to_var_or_const=03096_E_Absolute mo¿e byæ u¿yte tylko w stosunku do zmiennej lub sta³ej +% The address of a \var{absolute} directive can only point to a variable or +% constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_initialized_only_one_var=03097_E_Tylko jedna zmienna mo¿e byæ zainicjowana +% You cannot specify more than one variable with a initial value +% in Delphi mode. +parser_e_abstract_no_definition=03098_E_Metody abstrakcyjne nie mog± byæ zaimplementowane +% Abstract methods can only be declared, you cannot implement them. They +% should be overridden by a descendant class. +parser_e_overloaded_must_be_all_global=03099_E_Ta przeci±¿ona funkcja nie mo¿e byæ lokalna (musi byæ wyeksportowana) +% You are defining a overloaded function in the implementation part of a unit, +% but there is no corresponding declaration in the interface part of the unit. +parser_w_virtual_without_constructor=03100_W_Metody wirtualne u¿yte bez konstruktora $1 +% If you declare objects or classes that contain virtual methods, you need +% to have a constructor and destructor to initialize them. The compiler +% encountered an object or class with virtual methods that doesn't have +% a constructor/destructor pair. +parser_c_macro_defined=03101_CL_Makro zdefiniowane: $1 +% When \var{-vm} is used, the compiler tells you when it defines macros. +parser_c_macro_undefined=03102_CL_Makro wymazane: $1 +% When \var{-vm} is used, the compiler tells you when it undefines macros. +parser_c_macro_set_to=03103_CL_Makro $1 ustawione na $2 +% When \var{-vm} is used, the compiler tells you what values macros get. +parser_i_compiling=03104_I_Kompilowanie $1 +% When you turn on information messages (\var{-vi}), the compiler tells you +% what units it is recompiling. +parser_u_parsing_interface=03105_UL_Parsowanie czê¶ci interface modu³u $1 +% This tells you that the reading of the interface +% of the current unit starts +parser_u_parsing_implementation=03106_UL_Parsowanie czê¶ci implementation modu³u $1 +% This tells you that the code reading of the implementation +% of the current unit, library or program starts +parser_d_compiling_second_time=03107_DL_Kompilowanie $1 po raz drugi +% When you request debug messages (\var{-vd}) the compiler tells you what +% units it recompiles for the second time. +parser_e_no_property_found_to_override=03109_E_Nie znaleziono w³asno¶ci do przeci±¿enia +% You want to overrride a property of a parent class, when there is, in fact, +% no such property in the parent class. +parser_e_only_one_default_property=03110_E_Dozwolona jest tylko jedna w³asno¶æ domy¶lna, a znaleziono odziedziczon± w³asno¶æ domy¶ln± $1 +% You specified a property as \var{Default}, but a parent class already has a +% default property, and a class can have only one default property. +parser_e_property_need_paras=03111_E_W³asno¶ci± domy¶ln± musi byæ tablica +% Only array properties of classes can be made \var{default} properties. +parser_e_constructor_cannot_be_not_virtual=03112_E_Wirtualne konstruktory s± dostêpne tylko w klasach +% You cannot have virtual constructors in objects. You can only have them +% in classes. +parser_e_no_default_property_available=03113_E_Brak domy¶lnej w³asno¶ci w tej klasie +% You are trying to access a default property of a class, but this class (or one of +% its ancestors) doesn't have a default property. +parser_e_cant_have_published=03114_E_Klasa nie mo¿e mieæ sekcji published, u¿yj prze³±cznika {$M+} +% If you want a \var{published} section in a class definition, you must +% use the \var{\{\$M+\}} switch, whch turns on generation of type +% information. +parser_e_forward_declaration_must_be_resolved=03115_E_Deklaracja naprzód klasy $1 musi byæ rozwi±zana, aby u¿yæ klasy jako przodka innej klasy +% To be able to use an object as an ancestor object, it must be defined +% first. This error occurs in the following situation: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% Where \var{ParentClass} is declared but not defined. +parser_e_no_local_operator=03116_E_Lokalne przeci±¿enia operatorów niedostêpne +% You cannot overload locally, i.e. inside procedures or function +% definitions. +parser_e_proc_dir_not_allowed_in_interface=03117_E_Dyrektywa $1 niedozwolona w sekcji interface +% This procedure directive is not allowed in the \var{interface} section of +% a unit. You can only use it in the \var{implementation} section. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_Dyrektywa $1 niedozwolona w sekcji implementation +% This procedure directive is not defined in the \var{implementation} section of +% a unit. You can only use it in the \var{interface} section. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_Dyrektywa $1 niedozwolona w deklaracji typu proceduralnego +% This procedure directive cannot be part of a procedural or function +% type declaration. +parser_e_function_already_declared_public_forward=03120_E_Funkcja jest ju¿ zadeklarowana jako Public/Forward $1 +% You will get this error if a function is defined as \var{forward} twice. +% Or it is once in the \var{interface} section, and once as a \var{forward} +% declaration in the \var{implmentation} section. +parser_e_not_external_and_export=03121_E_Nie mo¿na u¿yæ jednocze¶nie EXPORT i EXTERNAL +% These two procedure directives are mutually exclusive +parser_w_not_supported_for_inline=03123_W_$1 nieobs³ugiwane w procedurze/funkcji inline +% Inline procedures don't support this declaration. +parser_w_inlining_disabled=03124_W_Inline wy³±czone +% Inlining of procedures is disabled. +parser_i_writing_browser_log=03125_I_Zapisywanie logu przegl±darki $1 +% When information messages are on, the compiler warns you when it +% writes the browser log (generated with the \var{\{\$Y+ \}} switch). +parser_h_maybe_deref_caret_missing=03126_H_Mo¿liwe, ¿e brakuje dereferencji wska¼nika +% The compiler thinks that a pointer may need a dereference. +parser_f_assembler_reader_not_supported=03127_F_Wybrany tryb asemblera nie jest obs³ugiwany +% The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not +% supported. The compiler can be compiled with or without support for a +% particular assembler reader. +parser_e_proc_dir_conflict=03128_E_Dyrektywa $1 koliduje z innymi dyrektywami +% You specified a procedure directive that conflicts with other directives. +% for instance \var{cdecl} and \var{pascal} are mutually exclusive. +parser_e_call_convention_dont_match_forward=03129_E_Konwencja wywo³ywania musi byæ taka sama w czêsci interface i implementation +% This error happens when you declare a function or procedure with +% e.g. \var{cdecl;} but omit this directive in the implementation, or vice +% versa. The calling convention is part of the function declaration, and +% must be repeated in the function definition. +parser_e_property_cant_have_a_default_value=03131_E_Ta w³asno¶æ nie mo¿e mieæ domy¶lnej warto¶ci +% Set properties or indexed properties cannot have a default value. +parser_e_property_default_value_must_const=03132_E_Domy¶lna warto¶æ w³asno¶ci musi byæ sta³± +% The value of a \var{default} declared property must be known at compile +% time. The value you specified is only known at run time. This happens +% .e.g. if you specify a variable name as a default value. +parser_e_cant_publish_that=03133_E_Symbol nie mo¿e byæ w sekcji published +% Only class type variables can be in a \var{published} section of a class +% if they are not declared as a property. +parser_e_cant_publish_that_property=03134_E_Ten typ warto¶ci nie mo¿e byæ w sekcji published +% Properties in a \var{published} section cannot be array properties. +% they must be moved to public sections. Properties in a \var{published} +% section must be an ordinal type, a real type, strings or sets. +parser_e_empty_import_name=03136_W_Wymagana jest nazwa importu +% Some targets need a name for the imported procedure or a \var{cdecl} specifier +parser_e_division_by_zero=03138_E_Dzielenie przez zero +% There is a divsion by zero encounted +parser_e_invalid_float_operation=03139_E_Nieprawid³owa operacja zmiennoprzecinkowa +% An operation on two real type values produced an overflow or a division +% by zero. +parser_e_array_lower_less_than_upper_bound=03140_E_Górna granica zakresu jest mniejsza od dolnej +% The upper bound of a an array declaration is less than the lower bound and this +% is not possible +parser_w_string_too_long=03141_W_String "$1" jest d³u¿szy ni¿ $2 +% The size of the constant string is larger than the size you specified in +% string type definition +parser_e_string_larger_array=03142_E_D³ugo¶æ stringa jest wiêksza ni¿ d³ugo¶æ tablicy znaków +% The size of the constant string is larger than the size you specified in +% the array[x..y] of char definition +parser_e_ill_msg_expr=03143_E_Nieprawid³owe wyra¿enie przy dyrektywie message +% \fpc supports only integer or string values as message constants +parser_e_ill_msg_param=03144_E_Funkcje obs³uguj±ce komunikaty (message) mog± pobieraæ tylko jeden parametr przez referencjê +% A method declared with the \var{message}-directive as message handler +% can take only one parameter which must be declared as call by reference +% Parameters are declared as call by reference using the \var{var}-directive +parser_e_duplicate_message_label=03145_E_Zduplikowana etykieta komunikatu: $1 +% A label for a message is used twice in one object/class +parser_e_self_in_non_message_handler=03146_E_Self mo¿e byæ parametrem tylko metod obs³uguj±cych komunikaty +% The self parameter can only be passed explicitly to a method which +% is declared as message handler. +parser_e_threadvars_only_sg=03147_E_Zmienne threadvar mog± byæ tylko statyczne lub globalne +% Threadvars must be static or global, you can't declare a thread +% local to a procedure. Local variables are always local to a thread, +% because every thread has its own stack and local variables +% are stored on the stack +parser_f_direct_assembler_not_allowed=03148_F_Wstawki asemblera niedostêpne gdy wyj¶ciowym formatem jest wbudowane zapisywanie binarne +% You can't use direct assembler when using a binary writer, choose an +% other outputformat or use another assembler reader +parser_w_no_objpas_use_mode=03149_W_Nie ³aduj modu³u OBJPAS bezpo¶rednio - u¿yj trybu obiektowego (objfpc, delphi) +% You are trying to load the ObjPas unit manually from a uses clause. This is +% not a good idea. Use the \var{\{\$mode objfpc\}} or +% \var{\{\$mode delphi\}} +% directives which load the unit automatically +parser_e_no_object_override=03150_E_OVERRIDE nie mo¿e byæ u¿yte dla obiektów +% Override is not supported for objects, use \var{virtual} instead to override +% a method of a parent object +parser_e_cant_use_inittable_here=03151_E_Typy danych wymagaj±ce inicjalizacji/finalizcji nie mog± byæ u¿yte w rekordach z wariantami +% Some data type (e.g. \var{ansistring}) needs initialization/finalization +% code which is implicitly generated by the compiler. Such data types +% can't be used in the variant part of a record. +parser_e_resourcestring_only_sg=03152_E_Resourcestring mo¿e byæ tylko statyczny lub globalny +% Resourcestring can not be declared local, only global or using the static +% directive. +parser_e_exit_with_argument_not__possible=03153_E_Exit z argumentem nie mo¿e byæ tu u¿yte +% an exit statement with an argument for the return value can't be used here, this +% can happen e.g. in \var{try..except} or \var{try..finally} blocks +parser_e_stored_property_must_be_boolean=03154_E_Symbol przechowywania w³asno¶ci musi byæ typu boolean +% If you specify a storage symbol in a property declaration, it must be of +% the type boolean +parser_e_ill_property_storage_sym=03155_E_Ten symbol nie mo¿e byæ symbolem przechowywania w³asno¶ci +% You can't use this type of symbol as storage specifier in property +% declaration. You can use only methods with the result type boolean, +% boolean class fields or boolean constants +parser_e_only_publishable_classes_can__be_published=03156_E_Tylko klasy skompilowane w trybie $M+ mog± byæ w sekcji published +% In the published section of a class can be only class as fields used which +% are compiled in \var{\{\$M+\}} or which are derived from such a class. Normally +% such a class should be derived from TPersitent +parser_e_proc_directive_expected=03157_E_Oczekiwano dyrektywy procedury +% When declaring a procedure in a const block you used a ; after the +% procedure declaration after which a procedure directive must follow. +% Correct declarations are: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_Warto¶æ indeksu w³asno¶ci musi byæ typu porz±dkowego +% The value you use to index a property must be of an ordinal type, for +% example an integer or enumerated type. +parser_e_procname_to_short_for_export=03159_E_Zbyt krótka nazwa procedury, aby eksportowaæ +% The length of the procedure/function name must be at least 2 characters +% long. This is because of a bug in dlltool which doesn't parse the .def +% file correct with a name of length 1. +parser_e_dlltool_unit_var_problem=03160_E_Nie mo¿na wygenerowaæ pozycji DEFFILE dla zmiennych globalnych modu³u +parser_e_dlltool_unit_var_problem2=03161_E_Skompiluj bez opcji -WD +% You need to compile this file without the -WD switch on the +% commandline +parser_f_need_objfpc_or_delphi_mode=03162_F_Aby skompilowaæ ten modu³ wymagany jest tryb ObjFpc (-S2) lub Delphi (-Sd) +% You need to use {$mode objfpc} or {$mode delphi} to compile this file. +% Or use the equivalent commandline switches -S2 or -Sd. +parser_e_no_export_with_index_for_target=03163_E_Nie mo¿na wyeksportowaæ z indeksem pod $1 +% Exporting of functions or procedures with a specified index is not +% supported on this target. +parser_e_no_export_of_variables_for_target=03164_E_Nie mo¿na wyeksportowaæ zmiennych pod $1 +% Exporting of variables is not supported on this target. +parser_e_improper_guid_syntax=03165_E_Nieprawid³owa sk³adnia identyfikatora GUID +parser_w_interface_mapping_notfound=03168_W_Nie znaleziono procedury "$1", która mog³aby implementowaæ $2.$3 +parser_e_interface_id_expected=03169_E_Oczekiwano interfejsu +% This happens when the compiler scans a \var{class} declaration that contains +% \var{interface} function name mapping code like this: +% \begin{verbatim} +% type +% TMyObject = class(TObject, IDispatch) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% and the \var{interface} before the dot not listed in the inheritance list. +parser_e_type_cant_be_used_in_array_index=03170_E_Typ "$1" nie mo¿e byæ u¿yty jako indeks tablicy +% Types like \var{qword} or \var{int64} aren't allowed as array index type +parser_e_no_con_des_in_interfaces=03171_E_Konstruktory i destruktory s± niedozwolone w interfejsach +% Constructor and destructor declarations aren't allowed in interface +% In the most cases the method \var{QueryInterface} of \var{IUnknown} can +% be used to create a new interface. +parser_e_no_access_specifier_in_interfaces=03172_E_Okre¶lenia dostêpu nie mog± byæ u¿yte w interfejsach +% The access specifiers \var{public}, \var{private}, \var{protected} and +% \var{pusblished} can't be used in interfaces because all methods +% of an interfaces must be public. +parser_e_no_vars_in_interfaces=03173_E_Interfejs nie mo¿e posiadaæ pól +% Declarations of fields aren't allowed in interfaces. An interface +% can contain only methods +parser_e_no_local_external=03174_E_Lokalne procedury nie mog± byæ zadeklarowane jako EXTERNAL +% Declaring local procedures as external is not possible. Local procedures +% get hidden parameters that will make the chance of errors very high +parser_w_skipped_fields_before=03175_W_Niektóre pola przed "$1" nie zosta³y zainicjalizowane +% In Delphi mode, not all fields of a typed constant record have to be +% initialized, but the compiler warns you when it detects such situations. +parser_e_skipped_fields_before=03176_E_Niektóre pola przed "$1" nie zosta³y zainicjalizowane +% In all syntax modes but Delphi mode, you can't leave some fields uninitialized +% in the middle of a typed constant record +parser_w_skipped_fields_after=03177_W_Niektóre pola po "$1" nie zosta³y zainicjalizowane +% You can leave some fields at the end of a type constant record uninitialized +% (the compiler will initialize them to zero automatically). This may be the cause +% of subtle problems. +parser_e_varargs_need_cdecl_and_external=03178_E_Dyrektywa VarArgs bez CDecl i External +% The varargs directive can only be used with procedures or functions +% that are declared with \var{cdecl} and \var{external} directives. The varargs directive +% is only meant to provide a compatible interface to C functions like printf. +parser_e_self_call_by_value=03179_E_Self musi byæ normalnym parametrem (przekazywanym przez warto¶æ) +% You can't declare self as a const or var parameter, it must always be +% a call-by-value parameter +parser_e_interface_has_no_guid=03180_E_Interfejs "$1" nie posiada identyfikatora GUID +% When you want to assign an interface to a constant, then the interface +% must have a GUID value set. +parser_e_illegal_field_or_method=03181_E_Nieznana metoda albo pole klasy "$1" +% Properties must refer to a field or method in the same class. +parser_w_proc_overriding_calling=03182_W_Zmiana sposobu wywo³ywania z "$1" na "$2" +% There are two directives in the procedure declaration that specify a calling +% convention. Only the last directive will be used +parser_e_no_procvarobj_const=03183_E_Typowane sta³e typu "procedure of object" mog± byæ inicjowane tylko NILem +% You can't assign the address of a method to a typed constant which has a +% 'procedure of object' type, because such a constant requires two addresses: +% that of the method (which is known at compile time) and that of the object or +% class instance it operates on (which can not be known at compile time). +parser_e_default_value_only_one_para=03184_E_Domy¶lna warto¶æ mo¿e byæ przypisana tylko jednemu parametrowi +parser_e_default_value_expected_for_para=03185_E_Domy¶lna warto¶æ wymagana dla "$1" +parser_w_unsupported_feature=03186_W_U¿ycie (jeszcze) nieobs³ugiwanej funkcji kompilatora! +% You're trying to force the compiler into doing something it cannot do yet. +parser_h_c_arrays_are_references=03187_H_Tablice C s± przekazywane przez referencjê +% Any array passed to a C functions is passed +% by a pointer (i.e. by reference). +parser_e_C_array_of_const_must_be_last=03188_E_Tablica sta³ych musi byæ ostatnim argumentem +% You can not add any other argument after an \var{array of const} for +% \var{cdecl} functions, as the size pushed on stack for this argument is +% not known. +parser_h_type_redef=03189_H_Powtórna definicja typu "$1" +% This is an indicator that a previously declared type is +% being redefined as something else. This may, or may not +% be, a cause for errors. +parser_w_cdecl_has_no_high=03190_W_Funkcje cdecl nie maj± parametru high +% Functions declared with cdecl modifier do not pass an extra implicit parameter. +parser_w_cdecl_no_openstring=03191_W_Funkcje cdecl nie obs³uguj± open strings +%Openstring is not supported for cdecl'ared functions. +parser_e_initialized_not_for_threadvar=03192_E_Nie mo¿na zainicjalizowaæ zmiennych zadeklarowanych jako threadvar +% Variables declared as threadvar can not be initialized with a default value. +% The variables will always be filled with zero at the start of a new thread. +parser_e_msg_only_for_classes=03193_E_Dyrektywa Message jest dozwolona tylko w klasach +% The message directive is only supported for Class types. +parser_e_procedure_or_function_expected=03194_E_Oczekiwano procedury lub funkcji +% A class method can only be specified for procedures and functions. +parser_e_illegal_calling_convention=03195_W_Dyrektywa "$1" zignorowana +% Some calling conventions are supported only by certain CPUs. I.e. most non-i386 ports support +% only the standard ABI calling convention of the CPU. +parser_e_no_object_reintroduce=03196_E_Nie mo¿na u¿yæ REINTRODUCE dla obiektów +% \var{reintroduce} is not supported for objects. +parser_e_paraloc_only_one_para=03197_E_Ka¿dy argument musi posiadaæ swoj± pozycjê +% If locations for arguments are specified explicitly as it is required by +% some syscall conventions, each argument must have it's only location, things +% like \var{procedure p(i,j : longint 'r1');} aren't allowed +parser_e_paraloc_all_paras=03198_E_Ka¿dy argument musi posiadaæ swoj± pozycjê +% If one argument has an explicit argument location, all arguments of a procedure +% must have one. +parser_e_illegal_explicit_paraloc=03199_E_Nieznana pozycja argumentu +% The location specified for an argument isn't recognized by the compiler +parser_e_32bitint_or_pointer_variable_expected=03200_E_Oczekiwano 32 bitowej liczby typu Integer albo wska¼nika +% The libbase for MorphOS/AmigaOS can be give only as \var{longint}, \var{dword} or any pointer variable. +parser_e_goto_outside_proc=03201_E_Nie mo¿na u¿yæ instrukcji GOTO pomiêdzy procedurami +% It isn't allowed to use the \var{goto} statements referencing labels outside the +% current procedure. The following example shows the problem: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1; +% +% procedure p2; +% begin +% goto l1; // This goto ISN'T allowed +% end; +% +% begin +% p2 +% l1: +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_Zbyt rozbudowana procedura, spróbuj rozbiæ j± na mniejsze +% Your procedure body is too long for the compiler. You should split the +% procedure into multiple smaller procedures. +parser_e_illegal_expression=03203_E_Nieprawid³owe wyra¿enie +% This can occur under many circumstances. Mostly when trying to evaluate +% constant expressions. +parser_e_invalid_integer=03204_E_Nieprawid³owe wyra¿enie (powinno zwóciæ liczbê ca³kowit±) +% You made an expression which isn't an integer, and the compiler expects the +% result to be an integer. +parser_e_invalid_qualifier=03205_E_Nieprawid³owy kwalifikator +% One of the following is happening : +% \begin{itemize} +% \item You're trying to access a field of a variable that is not a record. +% \item You're indexing a variable that is not an array. +% \item You're dereferencing a variable that is not a pointer. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_Górna granica zakresu jest mniejsza od dolnej +% You are declaring a subrange, and the lower limit is higher than the high +% limit of the range. +parser_e_macpas_exit_wrong_param=03207_E_Parametr funkcji EXIT musi byæ nazw± procedury, w której jej u¿yto +% Non local exit is not allowed. This error occurs only in mode MacPas. +parser_e_illegal_assignment_to_count_var=03208_E_Nieprawid³owe przypisanie do licznika pêtli "$1" +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +parser_e_no_local_var_external=03209_E_Lokalne zmienne nie mog± byæ zadeklarowane jako EXTERNAL +% Declaring local variables as external is not allowed. Only global variables can reference +% to external variables. +parser_e_proc_already_external=03210_E_Procedura ju¿ zadeklarowana jako EXTERNAL +% The procedure is already declared with the EXTERNAL directive in an interface or +% forward declaration. +parser_w_implicit_uses_of_variants_unit=03211_W_Dopisanie modu³u Variants do sekcji uses +% The Variant type is used in the unit without any used unit using the Variants unit. The +% compiler has implicitly added the Variants unit to the uses list. To remove this warning +% the Variants unit needs to be added to the uses statement. +parser_e_no_static_method_in_interfaces=03212_E_Metody statyczne nie mog± byæ u¿yte w interfejsach +% The specifier \var{class} and directive \var{static} can't be used in interfaces +% because all methods of an interfaces must be public. +parser_e_arithmetic_operation_overflow=03213_E_Wyst±pi³o przepe³nienie w operacji arytmetycznej +% An operation on two integers values produced an overflow +parser_e_protected_or_private_expected=03214_E_Oczekiwano "protected" albo "private" +% \var{strict} can be only used together with \var{protected} or \var{private}. +% \end{description} +# +# Type Checking +# +# 04049 is the last one used +# +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +type_e_mismatch=04000_E_Nieprawid³owy typ +% This can happen in many cases: +% \begin{itemize} +% \item The variable you're assigning to is of a different type than the +% expression in the assignment. +% \item You are calling a function or procedure with parameters that are +% incompatible with the parameters in the function or procedure definition. +% \end{itemize} +type_e_incompatible_types=04001_E_Niezgodno¶æ typów: otrzymano "$1" oczekiwano "$2" +% There is no conversion possible between the two types +% Another possiblity is that they are declared in different +% declarations: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { This statement gives also this error, it +% is due the strict type checking of pascal } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_Niezgodno¶æ typów pomiêdzy $1 i $2 +% The types are not equal +type_e_type_id_expected=04003_E_Oczekiwano identyfikatora typu +% The identifier is not a type, or you forgot to supply a type identifier. +type_e_variable_id_expected=04004_E_Oczekiwano identyfikatora zmiennej +% This happens when you pass a constant to a routine (such as \var{Inc} var or \var{Dec}) +% when it expects a variable. You can only pass variables as arguments to these functions. +type_e_integer_expr_expected=04005_E_Oczekiwano wyra¿enia ca³kowitego, ale otrzymano "$1" +% The compiler expects an expression of type integer, but gets a different +% type. +type_e_boolean_expr_expected=04006_E_Oczekiwano wyra¿enia logicznego, ale otrzymano "$1" +% The expression must be a boolean type, it should be return true or +% false. +type_e_ordinal_expr_expected=04007_E_Oczekiwano wyra¿enia porz±dkowego +% The expression must be of ordinal type, i.e., maximum a \var{Longint}. +% This happens, for instance, when you specify a second argument +% to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value. +type_e_pointer_type_expected=04008_E_Oczekiwano wska¼nika, ale otrzymano "$1" +% The variable or expression isn't of the type \var{pointer}. This +% happens when you pass a variable that isn't a pointer to \var{New} +% or \var{Dispose}. +type_e_class_type_expected=04009_E_Oczekiwano klasy, ale otrzymano "$1" +% The variable of expression isn't of the type \var{class}. This happens +% typically when +% \begin{enumerate} +% \item The parent class in a class declaration isn't a class. +% \item An exception handler (\var{On}) contains a type identifier that +% isn't a class. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_Nie mo¿na obliczyæ warto¶ci wyra¿enia +% This error can occur when the bounds of an array you declared does +% not evaluate to ordinal constants +type_e_set_element_are_not_comp=04012_E_Niekompatybilne elementy zbioru +% You are trying to make an operation on two sets, when the set element types +% are not the same. The base type of a set must be the same when taking the +% union +type_e_set_operation_unknown=04013_E_Operacja niezaimplementowana dla zbioru +% several binary operations are not defined for sets +% like div mod ** (also >= <= for now) +type_w_convert_real_2_comp=04014_W_Konwersja typu zmiennoprzecinkowego do ca³kowitego typu COMP +% An implicit type conversion from a real type to a \var{comp} is +% encountered. Since \var{Comp} is a 64 bit integer type, this may indicate +% an error. +type_h_use_div_for_int=04015_H_U¿yj DIV zamiast '/' aby wynik by³ ca³kowity +% When hints are on, then an integer division with the '/' operator will +% procuce this message, because the result will then be of type real +type_e_strict_var_string_violation=04016_E_Typy stringów nie pasuj± z powodu trybu $V+ +% When compiling in \var{\{\$V+\}} mode, the string you pass as a parameter +% should be of the exact same type as the declared parameter of the procedure. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_Succ i Pred nie dzia³aj± dla wyliczeñ z przypisaniami +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use the \var{Succ} or \var{Pred} functions on them. +type_e_cant_read_write_type=04018_E_Nie mo¿na zapisaæ lub odczytaæ zmiennych tego typu +% You are trying to \var{read} or \var{write} a variable from or to a +% file of type text, which doesn't support that. Only integer types, +% reals, pchars and strings can be read from/written to a text file. +% Booleans can only be written to text files. +type_e_no_readln_writeln_for_typed_file=04019_E_Nie mo¿na u¿yæ readln ani writeln na pliku tego typu +% \var{readln} and \var{writeln} are only allowed for text files. +type_e_no_read_write_for_untyped_file=04020_E_Nie mo¿na u¿yæ readln ani writeln na nietypowanym pliku +% \var{read} and \var{write} are only allowed for text or typed files. +type_e_typeconflict_in_set=04021_E_Konflikt typów pomiêdzy elementami zbioru +% There is at least one set element which is of the wrong type, i.e. not of +% the set type. +type_w_maybe_wrong_hi_lo=04022_W_lo/hi(dword/qword) zwraca starsze/m³odsze s³owo/podwójne s³owo +% \fpc supports an overloaded version of \var{lo/hi} for \var{longint/dword/int64/qword} +% which returns the lower/upper word/dword of the argument. TP always uses +% a 16 bit \var{lo/hi} which returns always bits 0..7 for \var{lo} and the +% bits 8..15 for \var{hi}. If you want the TP behavior you have +% to type cast the argument to \var{word/integer} +type_e_integer_or_real_expr_expected=04023_E_Oczekiwano wyra¿enia ca³kowitego lub zmiennoprzecinkowego +% The first argument to \var{str} must a real or integer type. +type_e_wrong_type_in_array_constructor=04024_E_Nieprawid³owy typ $1 w konstruktorze tablicy +% You are trying to use a type in an array constructor which is not +% allowed. +type_e_wrong_parameter_type=04025_E_Nieprawid³owy typ parametru nr $1: Otrzymano $2, a oczekiwano $3 +% You are trying to pass an invalid type for the specified parameter. +type_e_no_method_and_procedure_not_compatible=04026_E_Metoda i Procedura nie s± zgodne (jako zmienne) +% You can't assign a method to a procedure variable or a procedure to a +% method pointer. +type_e_wrong_math_argument=04027_E_Nieprawid³owa sta³a przekazana do wbudowanej funkcji matematycznej +% The constant argument passed to a ln or sqrt function is out of +% the definition range of these functions. +type_e_no_addr_of_constant=04028_E_Nie mo¿na pobraæ adresu sta³ej +% It's not possible to get the address of a constant, because they +% aren't stored in memory, you can try making it a typed constant. +type_e_argument_cant_be_assigned=04029_E_Ten argument nie mo¿e byæ przekazany przez referencjê +% Only expressions which can be on the left side of an +% assignment can be passed as call by reference argument +% Remark: Properties can be only +% used on the left side of an assignment, but they can't be used as arguments +type_e_cannot_local_proc_to_procvar=04030_E_Nie mo¿na przypisaæ lokalnej procedury/funkcji do zmiennej proceduralnej +% It's not allowed to assign a local procedure/function to a +% procedure variable, because the calling of local procedure/function is +% different. You can only assign local procedure/function to a void pointer. +type_e_no_assign_to_addr=04031_E_Nie mo¿na przypisaæ warto¶ci adresowi +% It is not allowed to assign a value to an address of a variable, constant, +% procedure or function. You can try compiling with -So if the identifier +% is a procedure variable. +type_e_no_assign_to_const=04032_E_Nie mo¿na sta³ej przypisaæ warto¶ci +% It's not allowed to assign a value to a variable which is declared +% as a const. This is normally a parameter declared as const, to allow +% changing the value make the parameter as a value parameter or a var. +type_e_array_required=04033_E_Dozwolone tylko dla tablic +% If you are accessing a variable using an index '[<x>]' then +% the type must be an array. In FPC mode also a pointer is allowed. +type_e_interface_type_expected=04034_E_Oczekiwano interfejsu ale otrzymano "$1" +type_w_mixed_signed_unsigned=04035_W_U¿ywanie zmiennych typu Cardinal w wyra¿eniach ze znakiem daje 64bitowy wynik +% If you divide (or calculate the modulus of) a signed expression by a longword (or vice versa), +% or if you have overflow and/or range checking turned on and use an arithmetical +% expression (+, -, *, div, mod) in which both signed numbers and longwords appear, +% then everything has to be evaluated in 64bit which is slower than normal +% 32bit arithmetic. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_w_mixed_signed_unsigned2=04036_W_U¿ywanie zmiennych typu Cardinal w wyra¿eniach ze znakiem mo¿e spowodowaæ b³±d zakresu w tym miejscu +% If you use a binary operator (and, or, xor) and one of +% the operands is a cardinal while the other one is a signed expression, then, +% if range checking is turned on, you may get a range check error because in +% such a case both operands are converted to cardinal before the operation is +% carried out. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_e_typecast_wrong_size_for_assignment=04037_E_Rzutowanie typów ró¿nych rozmiarów ($1 -> $2) w przypisaniu +% Type casting to a type with a different size is not allowed when the variable is +% used for assigning. +type_e_array_index_enums_with_assign_not_possible=04038_E_Typ wyliczeniowy z przypisanymi warto¶ciami nie moze byæ u¿yty do ideksowania tablicy +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use it as index of an array. +type_e_classes_not_related=04039_E_Typy obiektowe "$1" i "$2" nie s± pokrewne +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_w_classes_not_related=04040_W_Typy obiektowe "$1" i "$2" nie s± pokrewne +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_e_class_or_interface_type_expected=04041_E_Oczekiwano klasy lub interfejsu ale otrzymano "$1" +type_e_type_is_not_completly_defined=04042_E_Typ "$1" nie jest kompletnie zdefiniowany +type_w_string_too_long=04043_W_Przekroczona maksymalna d³ugo¶æ ³añcucha +% The size of the constant string, which is assigned to a shortstring, +% is longer than the maximum size of the shortstring +type_w_signed_unsigned_always_false=04044_W_To porównanie zawsze zwraca fa³sz z powodu zakresów warto¶ci zmiennych +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% false. Exlicitly typecast the constant to the correct range to avoid this problem. +type_w_signed_unsigned_always_true=04045_W_To porównanie zawsze zwraca fa³sz z powodu zakresów warto¶ci zmiennych +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% true. Exlicitly typecast the constant to the correct range to avoid this problem. +type_w_instance_with_abstract=04046_W_Tworzenie klasy "$1" posiadaj±cej metody abstrakcyjne +% An instance of a class is created which contains non-implemented abstract +% methods. This will probably lead to a runtime error 211 in the code if that +% routine is ever called. All abstract methods should be overridden. +type_h_in_range_check=04047_H_Lewy operand operatora IN powinien byæ wielko¶ci jednego bajta +% The left operand of the \var{in} operator is not an ordinal or enumeration which fits +% within 8-bits, this may lead to range check errors. The \var{in} operator +% currently only supports a left operand which fits within a byte. In the case of +% enumerations, the size of an element of an enumeration can be controlled with +% the \var{\{\$PACKENUM\}} or \var{\{\$Zn\}} switches. +type_w_smaller_possible_range_check=04048_W_Typy ró¿nej wielko¶ci - mo¿liwa utrata danych lub b³±d zakresu +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_h_smaller_possible_range_check=04049_H_Typy ró¿nej wielko¶ci - mo¿liwa utrata danych lub b³±d zakresu +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_e_cant_take_address_of_abstract_method=04050_E_Nie mo¿na uzyskaæ adresu metody abstrakcyjnej +% An abstract method has no body, so the address of an abstract method can't be taken. +type_e_operator_not_allowed=04051_E_Operator nie pasuje do operandu +% You are trying an operator that is not available for the type of the +% operands +type_e_constant_expr_expected=04052_E_Oczekiwano sta³ego wyra¿enia +% The compiler expects an constant expression, but gets a variable expression. +type_e_operator_not_supported_for_types=04053_E_Operacja "$1" niedozwolona dla typów "$2" i "$3" +% The operation is not allowed for the supplied types +type_e_illegal_type_conversion=04054_E_Nieprawid³owa konwersja typów: "$1" do "$2" +% When doing a type-cast, you must take care that the sizes of the variable and +% the destination type are the same. +type_h_pointer_to_longint_conv_not_portable=04055_H_Konwersja pomiêdzy typami ca³kowitymi i wska¼nikami jest nieprzeno¶na +% If you typecast a pointer to a longint (or vice-versa), this code will not compile +% on a machine using 64-bit for pointer storage. +type_w_pointer_to_longint_conv_not_portable=04056_W_Konwersja pomiêdzy typami ca³kowitymi i wska¼nikami jest nieprzeno¶na +% If you typecast a pointer to a ordinal type of a different size (or vice-versa), this can +% cause problems. This is a warning to help finding the 32bit specific code where cardinal/longint is used +% to typecast pointers to ordinals. A solution is to use the ptrint/ptruint types instead. +type_e_cant_choose_overload_function=04057_E_Nie mo¿na okre¶liæ, któr± z przeci±¿onych funkcji wywo³aæ +% You're calling overloaded functions with a parameter that doesn't correspond +% to any of the declared function parameter lists. e.g. when you have declared +% a function with parameters \var{word} and \var{longint}, and then you call +% it with a parameter which is of type \var{integer}. +type_e_illegal_count_var=04058_E_Nieprawid³owy typ licznika pêtli +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +% \end{description} +# +# Symtable +# +# 05055 is the last one used +# +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedure and variable names. +% \begin{description} +sym_e_id_not_found=05000_E_Nie odnaleziono identyfikatora $1 +% The compiler doesn't know this symbol. Usually happens when you misspel +% the name of a variable or procedure, or when you forgot to declare a +% variable. +sym_f_internal_error_in_symtablestack=05001_F_B³±d wewnêtrzny w SymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_Zduplikowany identyfikator $1 +% The identifier was already declared in the current scope. +sym_h_duplicate_id_where=05003_H_Identyfikator ju¿ zdefiniowany w $1 w lini $2 +% The identifier was already declared in a previous scope. +sym_e_unknown_id=05004_E_Nieznany identyfikator $1 +% The identifier encountered has not been declared, or is used outside the +% scope where it is defined. +sym_e_forward_not_resolved=05005_E_Deklaracaja naprzód nie rozwi±zana $1 +% This can happen in two cases: +% \begin{itemize} +% \item This happens when you declare a function (in the \var{interface} part, or +% with a \var{forward} directive, but do not implement it. +% \item You reference a type which isn't declared in the current \var{type} +% block. +% \end{itemize} +sym_e_error_in_type_def=05007_E_B³±d w definicji typu +% There is an error in your definition of a new array type: +% \item One of the range delimiters in an array declaration is erroneous. +% For example, \var{Array [1..1.25]} will trigger this error. +sym_e_forward_type_not_resolved=05009_E_Brak definicji typu $1 +% A symbol was forward defined, but no declaration was encountered. +sym_e_only_static_in_static=05010_E_Tylko zmienne statyczne mog± byæ u¿ywane w metodach statycznych +% A static method of an object can only access static variables. +sym_f_type_must_be_rec_or_class=05012_F_Oczekiwano rekordu lub klasy +% The variable or expression isn't of the type \var{record} or \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_Instancje klas i obiektów z metodami abstrakcyjnymi niedozwolone +% You are trying to generate an instance of a class which has an abstract +% method that wasn't overridden. +sym_w_label_not_defined=05014_W_Etykieta nie zosta³a zdefiniowana $1 +% A label was declared, but not defined. +sym_e_label_used_and_not_defined=05015_E_Etykieta niezdefiniowana przed u¿yciem $1 +% A label was declared and used, but not defined. +sym_e_ill_label_decl=05016_E_Nieprawid³owa deklaracja etykiety +% This error should never happen; it occurs if a label is defined outside a +% procedure or function. +sym_e_goto_and_label_not_supported=05017_E_GOTO i LABEL nieobs³ugiwane (u¿yj opcji -Sg) +% You must compile a program which has \var{label}s and \var{goto} statements +% with the \var{-Sg} switch. By default, \var{label} and \var{goto} aren't +% supported. +sym_e_label_not_found=05018_E_Nie odnaleziono etykiety +% A \var{goto label} was encountered, but the label isn't declared. +sym_e_id_is_no_label_id=05019_E_Identyfikator nie jest etykiet± +% The identifier specified after the \var{goto} isn't of type label. +sym_e_label_already_defined=05020_E_Powtórna definicja etykiety +% You are defining a label twice. You can define a label only once. +sym_e_ill_type_decl_set=05021_E_Nieprawid³owa deklaracja typu zbiorowego +% The declaration of a set contains an invalid type definition. +sym_e_class_forward_not_resolved=05022_E_Brak implementacji klasy $1 +% You declared a class, but you didn't implement it. +sym_n_unit_not_used=05023_H_Modu³ $1 nieu¿ywany w $2 +% The unit referenced in the \var{uses} clause is not used. +sym_h_para_identifier_not_used=05024_H_Parametr $1 nieu¿ywany +% The identifier was declared (locally or globally) but +% was not used (locally or globally). +sym_n_local_identifier_not_used=05025_N_Lokalna zmienna $1 nieu¿ywana +% You have declared, but not used a variable in a procedure or function +% implementation. +sym_h_para_identifier_only_set=05026_H_Warto¶c przypisana do $1 nie jest nigdzie u¿yta +% The identifier was declared (locally or globally) +% set but not used (locally or globally). +sym_n_local_identifier_only_set=05027_N_Warto¶c przypisana do $1 nie jest nigdzie u¿yta +% The variable in a procedure or function +% implementation is declared, set but never used. +sym_h_local_symbol_not_used=05028_H_Lokalna(y) $1 $2 nie zosta³(a) u¿yta(y) +% A local symbol is never used. +sym_n_private_identifier_not_used=05029_N_Prywatne pole $1.$2 nieu¿ywane +sym_n_private_identifier_only_set=05030_N_Warto¶c przypisana do lokalnego pola $1.$2 nie jest nigdzie u¿yta +sym_n_private_method_not_used=05031_N_Metoda prywatna $1.$2 nieu¿ywana +sym_e_set_expected=05032_E_Oczekiwano typu zbiorowego +% The variable or expression is not of type \var{set}. This happens in an +% \var{in} statement. +sym_w_function_result_not_set=05033_W_Nie wygl±da na to, ¿eby warto¶æ zwracana przez funkcjê by³a ustawiona +% You can get this warning if the compiler thinks that a function return +% value is not set. This will not be displayed for assembler procedures, +% or procedures that contain assembler blocks. +sym_w_wrong_C_pack=05034_W_Typ $1 jest ¼le wyrównany dla C w bie¿±cym rekordzie +% Arrays with sizes not multiples of 4 will be wrongly aligned +% for C structures. +sym_e_illegal_field=05035_E_Nieznany identyfikator pola rekordu $1 +% The field doesn't exist in the record definition. +sym_n_uninitialized_local_variable=05036_W_Nie wygl±da na to, ¿eby lokalna zmienna $1 by³a zainicjowana +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_n_uninitialized_variable=05037_W_Nie wygl±da na to, ¿eby zmienna $1 by³a zainicjowana +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_e_id_no_member=05038_E_Identyfikator nie wskazuje ¿adnej metody ani pola $1 +% This error is generated when an identifier of a record, +% field, or method is accessed while it is not defined. +sym_h_param_list=05039_H_Znaleziono deklaracjê: $1 +% You get this when you use the \var{-vb} switch. In case an overloaded +% procedure is not found, then all candidate overloaded procedures are +% listed, with their parameter lists. +sym_e_segment_too_large=05040_E_Element jest zbyt du¿y +% You get this when you declare a data element whose size exceeds the +% prescribed limit (2 Gb on 80386+/68020+ processors) +sym_e_no_matching_implementation_found=05042_E_Nie znaleziono implementacji metody interfejsu "$1" +% There was no matching method found which could implement the interface +% method. Check argument types and result type of the methods. +sym_w_deprecated_symbol=05043_W_Symbol "$1" jest przestarza³y +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Usage of this symbol +% should be avoided as much as possible. +sym_w_non_portable_symbol=05044_W_Symbolu "$1" nie da siê przenie¶æ na inne platformy +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{platform} is used. This symbol's value, usage +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_non_implemented_symbol=05055_W_Symbol "$1" nie jest zaimplementowany +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{unimplemented} is used. This symbol is defined, +% but is not yet implemented on this specific platform. +sym_e_cant_create_unique_type=05056_E_Nie mo¿na utworzyæ unikalnego typu z tego typu +% Only simple types like ordinal, float and string types are supported when +% redefining a type with \var{type newtype = type oldtype;}. +sym_h_uninitialized_local_variable=05057_H_Zmienna lokalna "$1" mo¿e nie byæ zainicjalizowana +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_h_uninitialized_variable=05058_H_Zmienna "$1" mo¿e nie byæ zainicjalizowana +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +% \end{description} +# +# Codegenerator +# +# 06040 is the last used one +# +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +cg_e_parasize_too_big=06009_E_Rozmiar listy parametrów przekracza 65535 bajtów +% The I386 processor limits the parameter list to 65535 bytes (the \var{RET} +% instruction causes this) +cg_e_file_must_call_by_reference=06012_E_Zmienne plikowe musz± byæ przekazywane przez referencje +% You cannot specify files as value parameters, i.e. they must always be +% declared \var{var} parameters. +cg_e_cant_use_far_pointer_there=06013_E_U¿ycie wska¼nika far niedozwolone w tym miejscu +% Free Pascal doesn't support far pointers, so you cannot take the address of +% an expression which has a far reference as a result. The \var{mem} construct +% has a far reference as a result, so the following code will produce this +% error: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_EXPORT declared functions can't be called +% No longer in use. +cg_w_member_cd_call_from_method=06016_W_Mo¿liwe nieprawid³owe wywo³anie konstruktora/destruktora +% The compiler detected that a constructor or destructor is called within a +% a method. This will probably lead to problems, since constructors / destructors +% require parameters on entry. +cg_n_inefficient_code=06017_N_Niewydajny kod +% Your statement seems dubious to the compiler. +cg_w_unreachable_code=06018_W_Kod nie zostanie nigdy wykonany +% You specified a construct which will never be executed. Example: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_Nie mo¿na bezpo¶rednio wywo³aæ metod abstrakcyjnych +% You cannot call an abstract method directy, instead you must call a +% overriding child method, because an abstract method isn't implemented. +cg_d_register_weight=06027_DL_Rejestr $1 waga $2 $3 +% Debugging message. Shown when the compiler considers a variable for +% keeping in the registers. +cg_d_stackframe_omited=06029_DL_Pominiêto ramkê stosu +% Some procedure/functions do not need a complete stack-frame, so it is omitted. +% This message will be displayed when the {-vd} switch is used. +cg_e_unable_inline_object_methods=06031_E_Metody obiektów i klas nie mog± byæ inline +% You cannot have inlined object methods. +cg_e_unable_inline_procvar=06032_E_Wywo³ania procedur ze zmiennych proceduralnych nie mog± byæ inline +% A procedure with a procedural variable call cannot be inlined. +cg_e_no_code_for_inline_stored=06033_E_Brak kodu dla procedury inline +% The compiler couldn't store code for the inline procedure. +cg_e_can_access_element_zero=06035_E_Brak dostêpu do zerowego elementu ansi/wide- lub longstringa, u¿yj (set)length +% You should use \var{setlength} to set the length of an ansi/wide/longstring +% and \var{length} to get the length of such kinf of string +cg_e_cannot_call_cons_dest_inside_with=06037_E_Konstruktory i destruktory nie mog± byæ wywo³ywane w klauzuli 'with' +% Inside a \var{with} clause you cannot call a constructor or destructor for the +% object you have in the \var{with} clause. +cg_e_cannot_call_message_direct=06038_E_Nie mo¿na wywo³aæ bezpo¶rednio metody obs³uguj±cej komunikaty +% A message method handler method cannot be called directly if it contains an +% explicit self argument +cg_e_goto_inout_of_exception_block=06039_E_Skok do bloku lub poza blok exception +% It is not allowed to jump in or outside of an exception block like \var{try..finally..end;}: +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // this line will cause an error +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_Break, Continue i Exit nie s± dozwolone w bloku finally +% It isn't allowed to use the control flow statements \var{break}, +% \var{continue} and \var{exit} +% inside a finally statement. The following example shows the problem: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // This exit ISN'T allowed +% end; +% ... +% +% \end{verbatim} +% If the procedure \var{p} raises an exception the finally block is +% executed. If the execution reaches the exit, it's unclear what to do: +% exiting the procedure or searching for another exception handler +cg_w_parasize_too_big=06041_W_Rozmiar parametrów przekroczy³ limit dla niektórych procesorów +% This indicates that you are declaring more than 64K of parameters, which +% might not be supported on other processor targets. +cg_w_localsize_too_big=06042_W_Rozmiar zmiennych lokalnych przekroczy³ limit dla dla niektórych procesorów +% This indicates that you are declaring more than 32K of lcoal variables, which +% might not be supported on other processor targets. +cg_e_localsize_too_big=06043_E_Rozmiar zmiennych lokalnych przekroczy³ dopuszczalny limit +% This indicates that you are declaring more than 32K of lcoal variables, which +% is not supported by this processor. +cg_e_break_not_allowed=06044_E_BREAK mo¿na u¿yæ tylko wewn±trz pêtli +% You're trying to use \var{break} outside a loop construction. +cg_e_continue_not_allowed=06045_E_CONTINUE mo¿na u¿yæ tylko wewn±trz pêtli +% You're trying to use \var{continue} outside a loop construction. +% \end{description} +# EndOfTeX + +# +# Assembler reader +# +# 07097 is the last used one +# +asmr_d_start_reading=07000_DL_Rozpoczêcie parsowania bloku asemblera w stylu $1 +% This informs you that an assembler block is being parsed +asmr_d_finish_reading=07001_DL_Zakoñczenie parsowania bloku asemblera w stylu $1 +% This informs you that an assembler block has finished. +asmr_e_none_label_contain_at=07002_E_¯aden identyfikator (poza etykietami) nie mo¿e zawieraæ @ +% A identifier which isn't a label can't contain a @. +asmr_e_building_record_offset=07004_E_B³±d tworzenia offsetu rekordu +% There has an error occured while building the offset of a record/object +% structure, this can happend when there is no field specified at all or +% an unknown field identifier is used. +asmr_e_offset_without_identifier=07005_E_OFFSET u¿yty bez identyfikatora +% You can only use OFFSET with an identifier. Other syntaxes aren't +% supported +asmr_e_type_without_identifier=07006_E_TYPE u¿yte bez identyfikatora +% You can only use TYPE with an identifier. Other syntaxes aren't +% supported +asmr_e_no_local_or_para_allowed=07007_E_Nie mo¿na u¿ywaæ lokalnych zmiennych i parametrów w tym miejscu +% You can't use a local variable or parameter here, mostly because the +% addressing of locals and parameters is done using the frame pointer register so the +% address can't be obtained directly. +asmr_e_need_offset=07008_E_Nale¿y tu u¿yæ OFFSET +% You need to use OFFSET <id> here to get the address of the identifier. +asmr_e_need_dollar=07009_E_Nale¿y u¿yæ tu $ +% You need to use $<id> here to get the address of the identifier. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_Mo¿na u¿yæ tylko jednego symbolu relokacyjnego +% You can't have more than one relocatable symbol (variable/typed constant) +% in one argument. +asmr_e_only_add_relocatable_symbol=07011_E_Symbole relokacyjne mog± byæ tylko dodane +% Relocatable symbols (variable/typed constant) can't be used with other +% operators. Only addition is allowed. +asmr_e_invalid_constant_expression=07012_E_Nieprawid³owe sta³e wyra¿enie +% There is an error in the constant expression. +asmr_e_relocatable_symbol_not_allowed=07013_E_Nie mo¿na u¿yæ symbolu relokacyjnego w tym miejscu +% You can't use a relocatable symbol (variable/typed constant) here. +asmr_e_invalid_reference_syntax=07014_E_Nieprawid³owa sk³adnia referencji +% There is an error in the reference. +asmr_e_local_para_unreachable=07015_E_Nie mo¿na osi±gn±æ $1 z tego kodu +% You can not read directly the value of local or para +% of a higher level in assembler code (except for +% local assembler code without parameter nor locals). +asmr_e_local_label_not_allowed_as_ref=07016_E_Lokalne symbole/etykiety nie s± dozwolone jako referencje +% You can't use local symbols/labels as references +asmr_e_wrong_base_index=07017_E_Nieprawid³owe u¿ycie rejestru indeksu i bazy +% There is an error with the base and index register, they are +% probably incorrect +asmr_w_possible_object_field_bug=07018_W_Mo¿liwy b³±d w obs³ugiwaniu pola obiektu +% Fields of objects or classes can be reached directly in normal or objfpc +% modes but TP and Delphi modes treat the field name as a simple offset. +asmr_e_wrong_scale_factor=07019_E_Nieprawid³owa skala +% The scale factor given is wrong, only 1,2,4 and 8 are allowed +asmr_e_multiple_index=07020_E_U¿ycie wielu rejestrów indeksu +% You are trying to use more than one index register +asmr_e_invalid_operand_type=07021_E_Nieprawid³owy typ operandu +% The operand type doesn't match with the opcode used +asmr_e_invalid_string_as_opcode_operand=07022_E_Nieprawid³owy string jako operand: $1 +% The string specified as operand is not correct with this opcode +asmr_w_CODE_and_DATA_not_supported=07023_W_@CODE i @DATA nieobs³ugiwane +% @CODE and @DATA are unsupported and are ignored. +asmr_e_null_label_ref_not_allowed=07024_E_Puste etykiety referencji s± niedozwolone +asmr_e_expr_zero_divide=07025_E_Dzielenie przez zero +% There is a division by zero in a constant expression +asmr_e_expr_illegal=07026_E_Nieprawid³owe wyra¿enie +% There is an illegal expression in a constant expression +asmr_e_escape_seq_ignored=07027_E_Sekwencja zignorowana: $1 +% There is a C-styled string, but the escape sequence in the string +% is unknown, and is therefore ignored +asmr_e_invalid_symbol_ref=07028_E_Nieprawid³owa referencja symbolu +asmr_w_fwait_emu_prob=07029_W_Fwait mo¿e powodowaæ problemy emulacji z emu387 +asmr_w_fadd_to_faddp=07030_W_$1 bez operandu przet³umaczone na $1P +asmr_w_enter_not_supported_by_linux=07031_W_Instrukcja ENTER nie jest obs³ugiwana przez j±dro Linuksa +% ENTER instruction can generate a stack page fault that is not +% caught correctly by the i386 Linux page handler. +asmr_w_calling_overload_func=07032_W_Wywo³anie przeci±¿onej funkcji z poziomu asemblera +% There is a call to an overloaded method in the assembler block, +% this might be the sign there is a problem +asmr_e_unsupported_symbol_type=07033_E_Nieobs³ugiwany typ symbolu dla operandu +asmr_e_constant_out_of_bounds=07034_E_Warto¶æ sta³a przekracza zakres +asmr_e_error_converting_decimal=07035_E_B³±d konwersji liczby dziesiêtnej $1 +% A constant decimal value does not have the correct syntax +asmr_e_error_converting_octal=07036_E_B³±d konwersji liczby ósemkowej $1 +% A constant octal value does not have the correct syntax +asmr_e_error_converting_binary=07037_E_B³±d konwersji liczby dwójkowej $1 +% A constant binary value does not have the correct syntax +asmr_e_error_converting_hexadecimal=07038_E_B³±d konwersji liczby szesnastkowej $1 +% A constant hexadecimal value does not have the correct syntax +asmr_h_direct_global_to_mangled=07039_H_$1 przet³umaczone na $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 jest przypisane do przeci±¿onej funkcji +asmr_e_cannot_use_SELF_outside_a_method=07041_E_Nie mo¿na u¿yæ SELF poza metod± +% There is a reference to the \var{self} symbol while it is not +% allowed. \var{self} can only be referenced inside methods +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_Nie mo¿na u¿yæ OLDEBP poza zagnie¿d¿on± procedur± +% There is a reference to the \var{oldebp} symbol while it is not +% allowed. \var{oldebp} can only be referenced inside nested routines +asmr_e_void_function=07043_W_Procedury nie mog± zwracaæ warto¶ci w kodzie asemblera +% Trying to return a value while in a procedure. A procedure +% does not have any return value +asmr_e_SEG_not_supported=07044_E_SEG nie obs³ugiwane +asmr_e_size_suffix_and_dest_dont_match=07045_E_Przyrostek okre¶laj±cy rozmiar nie pasuje do ¼ród³a lub celu +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_w_size_suffix_and_dest_dont_match=07046_W_Przyrostek okre¶laj±cy rozmiar nie pasuje do ¼ród³a lub celu +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_e_syntax_error=07047_E_B³±d sk³adni asemblera +% There is an assembler syntax error +asmr_e_invalid_opcode_and_operand=07048_E_Nieprawid³owa kombinacja opkodu i operandu +% The opcode cannot be used with this type of operand +asmr_e_syn_operand=07049_E_B³±d sk³adni asemblera w operandzie +asmr_e_syn_constant=07050_E_B³±d sk³adni asemblera w sta³ej +asmr_e_invalid_string_expression=07051_E_Nieprawid³owe wyra¿enie ze stringiem +asmr_w_const32bit_for_address=07052_W_Sta³a $1 prawdopodobnie nie powinna byæ wska¼nikiem +% A constant expression represents an address which does not fit +% into a pointer. The address is probably incorrect +asmr_e_unknown_opcode=07053_E_Nieznany opkod $1 +% This opcode is not known +asmr_e_invalid_or_missing_opcode=07054_E_Nieprawid³owy opkod lub brak opkodu +asmr_e_invalid_prefix_and_opcode=07055_E_Nieprawid³owa kombinacja prefiksu i opkodu: $1 +asmr_e_invalid_override_and_opcode=07056_E_Nieprawid³owa kombinacja override i opkodu: $1 +asmr_e_too_many_operands=07057_E_Zbyt du¿o operandów +% There are too many operands for this opcode. Check your +% assembler syntax +asmr_w_near_ignored=07058_W_NEAR zignorowane +asmr_w_far_ignored=07059_W_FAR zignorowane +asmr_e_dup_local_sym=07060_E_Zduplikowany symbol lokalny $1 +asmr_e_unknown_local_sym=07061_E_Niezdefiniowany symbol lokalny $1 +asmr_e_unknown_label_identifier=07062_E_Nieznana etykieta $1 +asmr_e_invalid_register=07063_E_Nieprawid³owa nazwa rejestru +% There is an unknown register name used as operand. +asmr_e_invalid_fpu_register=07064_E_Nieprawid³owa nazwa rejestru zmiennoprzecinkowego +% There is an unknown register name used as operand. +asmr_w_modulo_not_supported=07066_W_Modulo nieobs³ugiwane +asmr_e_invalid_float_const=07067_E_Nieprawid³owa sta³a zmiennoprzecinkowa $1 +% The floating point constant declared in an assembler block is +% invalid. +asmr_e_invalid_float_expr=07068_E_Nieprawid³owe wyra¿enie zmiennoprzecinkowe +% The floating point expression declared in an assembler block is +% invalid. +asmr_e_wrong_sym_type=07069_E_Nieprawid³owy typ symbolu +asmr_e_cannot_index_relative_var=07070_E_Nie mo¿na ideksowaæ rejestrem zmiennej lokalnej/parametru +% Trying to index using a base register a symbol which is already relative +% to a register. This is not possible, and will probably lead to crashes. +asmr_e_invalid_seg_override=07071_E_Invalid segment override expression +asmr_w_id_supposed_external=07072_W_Identifier $1 supposed external +% There is a reference to an undefined symbol. This will not result +% in an error, since the symbol might be external, but may cause +% problems at link time if the symbol is not defined anywhere. +asmr_e_string_not_allowed_as_const=07073_E_Stringi nie mog± byæ sta³ymi +% Character strings are not allowed as constants. +asmr_e_no_var_type_specified=07074_Nie okre¶lono typu zmiennej +% The syntax expects a type idenfitifer after the dot, but +% none was found. +asmr_w_assembler_code_not_returned_to_text=07075_E_brak powrotu do sekcji text w kodzie asemblera +% There was a directive in the assembler block to change sections, +% but there is a missing return to the text section at the end +% of the assembler block. This might cause errors during link time. +asmr_e_not_directive_or_local_symbol=07076_E_To nie jest ani dyrektywa, ani symbol lokalny: $1 +% This symbol is unknown. +asmr_w_using_defined_as_local=07077_E_U¿ycie zdefiniowanej nazwy jako lokalnej etykiety +asmr_e_dollar_without_identifier=07078_E_Brak identyfikatora przy znaku dolara +% A constant expression has an identifier which does not start with +% the $ symbol. +asmr_w_32bit_const_for_address=07079_W_32bitowa sta³a u¿yta jako adres +% A constant was used as an address. This is probably an error, +% since using absolute addresses will probably not work. +asmr_n_align_is_target_specific=07080_N_.align nie jest przeno¶ne miêdzy platformami, u¿yj .balign lub .p2align +% Using the .align directive is platform specific, and its meaning will vary +% from one platform to another. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_Nie mo¿na odwo³ywaæ siê bezpo¶rednio do pól parametrów +% You should load the parameter first into a register and then access the +% fields using that register. +asmr_e_cannot_access_object_field_directly=07082_E_Nie mo¿na odwo³ywaæ siê bezpo¶rednio do pól obiektów/klas +% You should load the self pointer first into a register and then access the +% fields using the register as base. By default the self pointer is available +% in the esi register on i386. +asmr_e_unable_to_determine_reference_size=07083_E_Nie okre¶lono rozmiaru operandu +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. +asmr_e_cannot_use_RESULT_here=07084_E_Nie mo¿na u¿yæ RESULT w tej funkcji +% Some functions which return complex types cannot use the \var{result} +% keyword. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" bez operandu przet³umaczone na "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" przet³umaczone na "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" przet³umaczone na "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_Znak < niedozwolony w tym miejscu +% The shift operator requires the << characters. Only one +% of those characters was found. +asmr_e_invalid_char_greater=07090_E_Znak > niedozwolony w tym miejscu +% The shift operator requires the >> characters. Only one +% of those characters was found. +asmr_w_align_not_supported=07093_W_ALIGN nieobs³ugiwane +asmr_e_no_inc_and_dec_together=07094_E_Inc i Dec nie mog± wystêpowaæ razem +% Trying to use an increment and a decrement within the same +% opcode on the 680x0. This is impossible. +asmr_e_invalid_reg_list_in_movem=07095_E_Nieprawid³owa lista rejestrów dla movem +% Trying to use the \var{movem} opcode with invalid registers +% to save or restore. +asmr_e_invalid_reg_list_for_opcode=07096_E_Nieprawid³owa lista rejestrów dla opkodu +asmr_e_higher_cpu_mode_required=07097_E_Ta instrukcja wymaga wy¿szego typu procesora ($1) +% Trying to use an instruction which is not supported in the current +% cpu mode. Use a higher cpu generation to be able to use this +% opcode in your assembler block +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_Nie okre¶lono rozmiaru operandów, domy¶lne u¿ycie DWORD +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use DWORD as default. +asmr_e_illegal_shifterop_syntax=07099_E_B³±d sk³adni przy operandzie shifter +% ARM only; ARM assembler supports a so called shifter operand. The used syntax isn't +% a valid shifter operand. Example for an operation with shifter operand: +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +# +# Assembler/binary writers +# +# 08018 is the last used one +# +asmw_f_too_many_asm_files=08000_F_Zbyt du¿o plików asemblera +% With smartlinking enabled, there are too many assembler +% files generated. Disable smartlinking. +asmw_f_assembler_output_not_supported=08001_F_Wybrany typ wyj¶ciowy asemblera nieobs³ugiwany +asmw_f_comp_not_supported=08002_F_Comp nieobs³ugiwany +asmw_f_direct_not_supported=08003_F_Direct nieobs³ugiwane przy zapisywaniu bezpo¶rednim +% Direct assembler mode is not supported for binary writers. +asmw_e_alloc_data_only_in_bss=08004_E_Alokacja danych jest dozwolona tylko w sekcji bss +asmw_f_no_binary_writer_selected=08005_F_Nie wybrano sposobu zapisywania binariów +asmw_e_opcode_not_in_table=08006_E_Asm: Brak opkodu $1 w tablicy +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 nieprawid³owa kombinacja opkodu i operandów +asmw_e_16bit_not_supported=08008_E_Asm: 16bitowe referencje nieobs³ugiwane +asmw_e_invalid_effective_address=08009_E_Asm: Nieprawid³owy adres efektywny +asmw_e_immediate_or_reference_expected=08010_E_Asm: Immediate or reference expected +asmw_e_value_exceeds_bounds=08011_E_Asm: $1 warto¶æ przekracza zakres $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: Krótki skok poza zasiêg $1 +asmw_e_undefined_label=08013_E_Asm: Nieznana etykieta $1 +asmw_e_comp_not_supported=08014_E_Asm: Typ Comp nieobs³ugiwany dla tego celu +asmw_e_extended_not_supported=08015_E_Asm: Typ Extended nieobs³ugiwany dla tego celu +asmw_e_duplicate_label=08016_E_Asm: Zduplikowana etykieta $1 +asmw_e_redefined_label=08017_E_Asm: Etykieta powtórnie zdefiniowana $1 +asmw_e_first_defined_label=08018_E_Asm: Najpierw zdefiniowana tutaj +asmw_e_invalid_register=08019_E_Asm: Nieprawid³owy rejestr $1 + +# +# Executing linker/assembler +# +# 09034 is the last used one +# +# BeginOfTeX +% +% \section{Errors of assembling/linking stage} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +exec_w_source_os_redefined=09000_W_Zmieniono ¼ród³owy system operacyjny +exec_i_assembling_pipe=09001_I_Asemblowanie (potok) $1 +exec_d_cant_create_asmfile=09002_E_Nie mo¿na utworzyæ plików asemblera: $1 +% The mentioned file can't be created. Check if you have got +% access permissions to create this file +exec_e_cant_create_objectfile=09003_E_Nie mo¿na utworzyæ pliku: $1 +% The mentioned file can't be created. Check if you've +% got access permissions to create this file +exec_e_cant_create_archivefile=09004_E_Nie mo¿na utworzyæ pliku: $1 +% The mentioned file can't be created. Check if you've +% access permissions to create this file +exec_e_assembler_not_found=09005_E_Assembler $1 nie znaleziony, prze³±czenie na zewnêtrzn± asemblacjê +exec_t_using_assembler=09006_T_U¿ywanie assemblera: $1 +exec_e_error_while_assembling=09007_E_B³±d asemblera, kod wyj¶cia $1 +% There was an error while assembling the file using an external assembler. +% Consult the documentation of the assembler tool to find out more information +% on this error. +exec_e_cant_call_assembler=09008_E_Nie mo¿na wywo³aæ asemblera, b³±d $1 prze³±czenie na zewnêtrzn± asemblacjê +exec_i_assembling=09009_I_Asemblowanie $1 +exec_i_assembling_smart=09010_I_Asemblowanie do linkowania smart $1 +exec_w_objfile_not_found=09011_W_Obiekt $1 nieodnaleziony, linkowanie mo¿e siê nie powie¶æ! +% One of the object file is missing, and linking will probably fail. +% Check your paths. +exec_w_libfile_not_found=09012_W_Biblioteka $1 nieodnaleziona, Linkowanie mo¿e siê nie powie¶æ! +% One of the library file is missing, and linking will probably fail. +% Check your paths. +exec_e_error_while_linking=09013_E_B³±d podczas linkowania +% Generic error while linking. +exec_e_cant_call_linker=09014_E_Nie mo¿na wywo³aæ linkera, prze³±czenie na zewnêtrzne linkowanie +exec_i_linking=09015_I_Linkowanie $1 +exec_e_util_not_found=09016_E_Narzêdzie $1 nieodnalezione, prze³±czenie na zewnêtrzne linkowanie +exec_t_using_util=09017_T_Uruchamianie $1 +exec_e_exe_not_supported=09018_E_Tworzenie plików wykonywalnych nieobs³ugiwane +exec_e_dll_not_supported=09019_E_Tworzenie bibliotek dynamicznych/wspó³dzielonych nieobs³ugiwane +exec_i_closing_script=09020_I_Zamykanie skryptu $1 +exec_e_res_not_found=09021_E_Kompilator zasobów nieodnaleziony, prze³±czenie na tryb zewnêtrzny +exec_i_compilingresource=09022_I_Kompilacja zasobu $1 +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_Modu³ $1 nie mo¿e byæ linkowany statycznie, prze³±czenie na linkowanie smart +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_Modu³ $1 nie moze byæ linkowany smart, prze³±czenie na linkowanie statyczne +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_Modu³ $1 nie mo¿e byæ linkowany dynamicznie, prze³±czenie na linkowanie statyczne +exec_e_unit_not_smart_or_static_linkable=09026_E_Modu³ $1 nie mo¿e byæ linkowany statycznie ani smart +exec_e_unit_not_shared_or_static_linkable=09027_E_Modu³ $1 nie mo¿e byæ linkowany statycznie ani dynamicznie +%\end{description} +# EndOfTeX + +# +# Executable information +# +execinfo_f_cant_process_executable=09128_F_Nie mo¿na przetwarzaæ pliku $1 +execinfo_f_cant_open_executable=09129_F_Nie mo¿na otworzyæ pliku wykonywalnego $1 +execinfo_x_codesize=09130_X_Rozmiar kodu: $1 bajtów +execinfo_x_initdatasize=09131_X_Rozmiar zainicjowanych danych: $1 bajtów +execinfo_x_uninitdatasize=09132_X_Rozmiar niezainicjowanych danych: $1 bajtów +execinfo_x_stackreserve=09133_X_Zarezerwowany rozmiar stosu: $1 bajtów +execinfo_x_stackcommit=09134_X_Aktywny rozmiar stosu: $1 bajtów + +# +# Unit loading +# +# 10041 is the last used one +# +# BeginOfTeX +% \section{Unit loading messages.} +% This section lists all messages that can occur when the compiler is +% loading a unit from disk into memory. Many of these mesages are +% informational messages. +% \begin{description} +unit_t_unitsearch=10000_T_Poszukiwanie modu³u: $1 +% When you use the \var{-vt}, the compiler tells you where it tries to find +% unit files. +unit_t_ppu_loading=10001_T_Otwieranie PPU $1 +% When the \var{-vt} switch is used, the compiler tells you +% what units it loads. +unit_u_ppu_name=10002_U_Nazwa PPU: $1 +% When you use the \var{-vu} flag, the unit name is shown. +unit_u_ppu_flags=10003_U_Flagi PPU: $1 +% When you use the \var{-vu} flag, the unit flags are shown. +unit_u_ppu_crc=10004_U_Crc PPU: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_time=10005_U_Czas PPU: $1 +% When you use the \var{-vu} flag, the time the unit was compiled is shown. +unit_u_ppu_file_too_short=10006_U_Plik PPU zbyt krótki +% The ppufile is too short, not all declarations are present. +unit_u_ppu_invalid_header=10007_U_Nieprawid³owy nag³ówek PPU (brak PPU na pocz±tku) +% A unit file contains as the first three bytes the ascii codes of \var{PPU} +unit_u_ppu_invalid_version=10008_U_Nieprawid³owa wersja PPU $1 +% This unit file was compiled with a different version of the compiler, and +% cannot be read. +unit_u_ppu_invalid_processor=10009_U_PPU jest skompilowany dla innego procesora +% This unit file was compiled for a different processor type, and +% cannot be read +unit_u_ppu_invalid_target=10010_U_PPU skompilowany dla innej platformy docelowej +% This unit file was compiled for a different target, and +% cannot be read +unit_u_ppu_source=10011_U_¬ród³o PPU: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_write=10012_U_Zapisywanie $1 +% When you specify the \var{-vu} switch, the compiler will tell you where it +% writes the unit file. +unit_f_ppu_cannot_write=10013_F_Nie mo¿na zapisaæ pliku PPU +% An error occurred when writing the unit file. +unit_f_ppu_read_error=10014_F_B³±d podczas czytania pliku PPU +% This means that the unit file was corrupted, and contains invalid +% information. Recompilation will be necessary. +unit_f_ppu_read_unexpected_end=10015_F_Nieoczekiwane zakoñczenie pliku PPU +% Unexpected end of file. This may mean that the PPU file is +% corrupted. +unit_f_ppu_invalid_entry=10016_F_Nieprawid³owy plik PPU: $1 +% The unit the compiler is trying to read is corrupted, or generated with a +% newer version of the compiler. +unit_f_ppu_dbx_count_problem=10017_F_B³±d podczas liczenia PPU Dbx +% There is an inconsistency in the debugging information of the unit. +unit_e_illegal_unit_name=10018_E_Nieprawid³owa nazwa modu³u: $1 +% The name of the unit does not match the file name. +unit_f_too_much_units=10019_F_Zbyt du¿o modu³ów +% \fpc has a limit of 1024 units in a program. You can change this behavior +% by changing the \var{maxunits} constant in the \file{files.pas} file of the +% compiler, and recompiling the compiler. +unit_f_circular_unit_reference=10020_F_Zapêtlone nawi±zanie pomiêdzy modu³ami $1 i $2 +% Two units are using each other in the interface part. This is only allowed +% in the \var{implementation} part. At least one unit must contain the other one +% in the \var{implementation} section. +unit_f_cant_compile_unit=10021_F_Nie mo¿na skompilowaæ modu³u $1, brak ¼róde³ +% A unit was found that needs to be recompiled, but no sources are +% available. +unit_f_cant_find_ppu=10022_F_Nie mo¿na znale¼æ modu³u $1 +% You tried to use a unit of which the PPU file isn't found by the +% compiler. Check your config files for the unit pathes +unit_w_unit_name_error=10023_W_Nie znaleziono modu³u $1 ale istnieje $2 +unit_f_unit_name_error=10024_F_Szukano modu³u $1 ale znaleziono tylko $2 +% Dos truncation of 8 letters for unit PPU files +% may lead to problems when unit name is longer than 8 letters. +unit_w_switch_us_missed=10025_W_Kompilowanie modu³u System wymaga u¿ycia prze³±cznika -Us +% When recompiling the system unit (it needs special treatment), the +% \var{-Us} must be specified. +unit_f_errors_in_unit=10026_F_Napotkano $1 b³êdów podczas kompilacji modu³u, zatrzymanie +% When the compiler encounters a fatal error or too many errors in a module +% then it stops with this message. +unit_u_load_unit=10027_U_£adowanie z $1 ($2) modu³u $3 +% When you use the \var{-vu} flag, which unit is loaded from which unit is +% shown. +unit_u_recompile_crc_change=10028_U_Rekompilacja $1, suma kontrolna zmieniona dla $2 +unit_u_recompile_source_found_alone=10029_U_Rekompilacja $1, znaleziono tylko ¼ród³o +% When you use the \var{-vu} flag, these messages tell you why the current +% unit is recompiled. +unit_u_recompile_staticlib_is_older=10030_U_Rekompilacja modu³u, biblioteka statyczna jest starsza ni¿ plik ppu +% When you use the \var{-vu} flag, the compiler warns if the static library +% of the unit are older than the unit file itself. +unit_u_recompile_sharedlib_is_older=10031_U_Rekompilacja modu³u, biblioteka wspó³dzielona jest starsza ni¿ plik ppu +% When you use the \var{-vu} flag, the compiler warns if the shared library +% of the unit are older than the unit file itself. +unit_u_recompile_obj_and_asm_older=10032_U_Rekompilacja modu³u, obj i asm s± starsze ni¿ plik ppu +% When you use the \var{-vu} flag, the compiler warns if the assembler or +% object file of the unit are older than the unit file itself. +unit_u_recompile_obj_older_than_asm=10033_U_Rekompilacja modu³u, obj jest starszy ni¿ asm +% When you use the \var{-vu} flag, the compiler warns if the assembler +% file of the unit is older than the object file of the unit. +unit_u_parsing_interface=10034_U_Parsowanie czê¶ci interface modu³u $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the interface part of the unit +unit_u_parsing_implementation=10035_U_Parsowanie czê¶ci implementation modu³u $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the implementation part of the unit +unit_u_second_load_unit=10036_U_Drugie za³adowanie pliku $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_check_time=10037_U_Sprawdzanie pliku PPU: $1 czas: $2 +% When you use the \var{-vu} flag, the compiler show the filename and +% date and time of the file which a recompile depends on +### The following two error msgs is currently disabled. +#unit_h_cond_not_set_in_last_compile=10038_H_Warunek $1 nie by³ ustawiony na pocz±tku ostatniej kompilacji modu³u $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that currently is defined, but was not used the last +#% time the unit was compiled. +#unit_h_cond_set_in_last_compile=10039_H_Warunek $1 nie by³ ustawiony na pocz±tku ostatniej kompilacji modu³u $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that was used the last time the unit was compiled, but +#% the conditional is currently not defined. +unit_w_cant_compile_unit_with_changed_incfile=10040_W_Nie mo¿na skompilowaæ modu³u $1, znaleziono zmodyfikowane pliki include +% A unit was found to have modified include files, but +% some source files were not found, so recompilation is impossible. +unit_h_source_modified=10041_H_Plik $1 jest nowszy ni¿ plik $2 +% A modified source file for a unit was found that was compiled with the +% release flag (-Ur). The unit will not implicitly be recompiled because +% this release flag is set. +unit_u_ppu_invalid_fpumode=10042_U_U¿ycie modu³u skompilowanego z innym formatem zapisu liczb zmiennoprzecinkowych +% Trying to compile code while using units which were not compiled with +% the same floating point format mode. Either all code should be compiled +% with FPU emulation on, or with FPU emulation off. +unit_u_loading_interface_units=10043_U_£adowanie modu³ów z czê¼ci interface modu³u $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the units defined in the interface part of the unit. +unit_u_loading_implementation_units=10044_U_£adowanie modu³ów z czê¼ci implementation modu³u $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the units defined in the implementation part of the unit. +unit_u_interface_crc_changed=10045_U_Zmieniona suma CRC sekcji interface modu³u $1 +% When you use the \var{-vu} flag, the compiler warns that it the +% CRC calculated for the interface has been changed after the implementation +% has been parsed. +unit_u_implementation_crc_changed=10046_U_Zmieniona suma CRC sekcji implementation modu³u $1 +% When you use the \var{-vu} flag, the compiler warns that it the +% CRC calculated has been changed after the implementation +% has been parsed. +unit_u_finished_compiling=10047_U_Zakoñczono kompilacjê modu³u $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has finished compiling the unit. +unit_u_add_depend_to=10048_U_Dodanie zale¿no¶ci $1 do $2 +% When you use the \var{-vu} flag, the compiler warns that it +% has added a dependency between the two units. +unit_u_no_reload_is_caller=10049_U_Ominiêcie prze³adowania modu³u, to ten sam modu³: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has will not reload the unit because it is the unit that wants +% to load this unit +unit_u_no_reload_in_second_compile=10050_U_Ominiêcie prze³adowania modu³u, trwa druga kompilacaja: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has will not reload the unit because it is already in a second recompile +unit_u_flag_for_reload=10051_U_Flaga do prze³adowania: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to reload the unit +unit_u_forced_reload=10052_U_Wymuszone prze³adowanie modu³u +% When you use the \var{-vu} flag, the compiler warns that it +% has is reloading the unit because it was required +unit_u_previous_state=10053_U_Poprzedni stan modu³u $1: $2 +% When you use the \var{-vu} flag, the compiler shows the +% previous state of the unit +unit_u_second_compile_unit=10054_U_Ju¿ kompilowane $1, ustawienie drugiej kompilacji +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_loading_unit=10055_U_£adowanie modu³u $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the unit. +unit_u_finished_loading_unit=10056_U_Zakoñczenie ³adowania modu³u $1 +% When you use the \var{-vu} flag, the compiler warns that it finished +% loading the unit. +unit_u_registering_new_unit=10057_U_Rejestrowanie nowego modu³u $1 +% When you use the \var{-vu} flag, the compiler warns that it has +% found a new unit and registers it in the internal lists. +unit_u_reresolving_unit=10058_U_Powtórne odnajdowanie modu³u $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to recalculate the internal data of the unit +unit_u_skipping_reresolving_unit=10059_U_Ominiêcie powtórnego odnajdowania modu³u $1, ci±gle ³aduje u¿ywane modu³y +% When you use the \var{-vu} flag, the compiler warns that it +% skips to recalculate the internal data of the unit because there +% is no data to recalculate +% \end{description} +# EndOfTeX + +# +# Options +# +# 11039 is the last used one +# +option_usage=11000_O_$1 [opcje] <nazwapliku> [opcje] +# BeginOfTeX +% +% \section{Command-line handling errors} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +option_only_one_source_support=11001_W_Obs³ugiwany tylko jeden plik ¼ród³owy +% You can specify only one source file on the command line. The first +% one will be compiled, others will be ignored. This may indicate that +% you forgot a \var{'-'} sign. +option_def_only_for_os2=11002_W_Plik DEF mo¿e byæ stworzony tylko pod OS/2 +% This option can only be specified when you're compiling for OS/2 +option_no_nested_response_file=11003_E_Zagnie¿d¿enia plików nieobs³ugiwane +% you cannot nest response files with the \var{@file} command-line option. +option_no_source_found=11004_F_Brak nazwy pliku w lini poleceñ +% The compiler expects a source file name on the command line. +option_no_option_found=11005_N_Brak opcji w pliku konfiguracyjnym $1 +% The compiler didn't find any option in that config file. +option_illegal_para=11006_E_Nieprawid³owy parametr: $1 +% You specified an unknown option. +option_help_pages_para=11007_H_-? wy¶wietla pomoc +% When an unknown option is given, this message is diplayed. +option_too_many_cfg_files=11008_F_Za du¿o zagnie¿d¿onych plików konfiguracyjnych +% You can only nest up to 16 config files. +option_unable_open_file=11009_F_Nie mo¿na otworzyæ pliku konfiguracyjnego $1 +% The option file cannot be found. +option_reading_further_from=11010_D_Czytanie dalszych opcji z $1 +% Displayed when you have notes turned on, and the compiler switches +% to another options file. +option_target_is_already_set=11011_W_Cel jest ju¿ ustawiony na: $1 +% Displayed if more than one \var{-T} option is specified. +option_no_shared_lib_under_dos=11012_W_Biblioteki wspó³dzielone nie s± obs³ugiwane w DOSie, reverting to static +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos +option_too_many_ifdef=11013_F_Za du¿o IF(N)DEF +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_many_endif=11014_F_Za du¿o ENDIF +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_less_endif=11015_F_Warunek wci±¿ otwarty na koñcu pliku +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_no_debug_support=11016_W_Generowanie informacji do debugowania nieobs³ugiwane przez t± wersjê kompilatora +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_Spróbuj przekompilowaæ z -dGDB +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_E_U¿ycie przedawnionego prze³±cznika $1 +% this warns you when you use a switch that is not needed/supported anymore. +% It is recommended that you remove the switch to overcome problems in the +% future, when the switch meaning may change. +option_obsolete_switch_use_new=11019_E_U¿ycie przedawnionego prze³±cznika $1, proszê u¿yæ $2 +% this warns you when you use a switch that is not supported anymore. You +% must now use the second switch instead. +% It is recommended that you change the switch to overcome problems in the +% future, when the switch meaning may change. +option_switch_bin_to_src_assembler=11020_N_Prze³±czenie na domy¶lny zapis asemblera +% this notifies you that the assembler has been changed because you used the +% -a switch which can't be used with a binary assembler writer. +option_incompatible_asm=11021_W_Wybrane wyj¶cie asemblera "$1" nie jest zgodne z "$2" +option_asm_forced=11022_W_Wymuszenie u¿ycia asemblera "$1" +% The assembler output selected can not generate +% object files with the correct format. Therefore, the +% default assembler for this target is used instead. +option_using_file=11026_T_Czytanie opcji z pliku $1 +% Options are also read from this file +option_using_env=11027_T_Czytanie opcji ze zmiennej ¶rodowiskowej $1 +% Options are also read from this environment string +option_handling_option=11028_D_Obs³ugiwanie opcji "$1" +% Debug info that an option is found and will be handled +option_help_press_enter=11029__*** naci¶nij enter *** +option_start_reading_configfile=11030_H_Rozpoczêto czytanie pliku konfiguracyjnego $1 +% Starting of config file parsing. +option_end_reading_configfile=11031_H_Zakoñczono czytanie pliku konfiguracyjnego $1 +% End of config file parsing. +option_interpreting_option=11032_D_Interpretowanie opcji "$1" +option_interpreting_firstpass_option=11036_D_Interpretowanie opcji "$1" +option_interpreting_file_option=11033_D_Interpretowanie opcji plikowej "$1" +option_read_config_file=11034_D_Czytanie pliku konfiguracyjnego "$1" +option_found_file=11035_D_Znaleziono nazwê pliku ¼ród³owego "$1" +% Additional infos about options, displayed +% when you have debug option turned on. +option_code_page_not_available=11039_E_Nieznana strona kodowa +%\end{description} +# EndOfTeX + +# +# Logo (option -l) +# +option_logo=11023_[ +Free Pascal Compiler wersja $FPCFULLVERSION [$FPCDATE] dla $FPCCPU +Copyright (c) 1993-2011 by Florian Klaempfl +] + +# +# Info (option -i) +# +option_info=11024_[ +Free Pascal Compiler wersja $FPCVERSION + +Data kompilatora : $FPCDATE +Platforma docelowa: $FPCCPU + +Wspierane platformy: + $OSTARGETS + +Wspierane instrukcje CPU: + $INSTRUCTIONSETS + +Wspierane instrukcje FPU: + $FPUINSTRUCTIONSETS + +Ten program jest oparty na GNU General Public Licence +Przeczytaj COPYING.FPC aby dowiedzieæ siê wiêcej + +Zg³aszanie b³êdów, sugestii itp. + http://bugs.freepascal.org +lub + bugs@freepascal.org +] + +# +# Help pages (option -? and -h) +# +# The first character on the line indicates who will display this +# line, the current possibilities are : +# * = every target +# 3 = 80x86 targets +# 6 = 680x0 targets +# e = in extended debug mode only +# P = PowerPC targets +# S = Sparc targets +# V = Virtual machine targets +# The second character also indicates who will display this line, +# (if the above character was TRUE) the current possibilities are : +# * = everyone +# g = with GDB info supported by the compiler +# O = OS/2 +# L = UNIX systems +# The third character represents the indentation level. +# +option_help_pages=11025_[ +**0*_wpisz + po prze³±czniku aby go aktywowaæ, - aby dezaktywowaæ +**1a_kompilator nie usuwa wygenerowanego pliku asemblera +**2al_wypisuje numery linii do pliku asemblera +**2an_wypisuje informacje o wêz³ach do pliku asemblera +*L2ap_u¿ycie potoków zamiast tymczasowych plików asemblera +**2ar_wypisuje alokacje/zwalnianie rejestrów do pliku asemblera +**2at_wypisuje tymczasowe alokacje/zwalnianie do pliku asemblera +**1A<x>_format wyj¶ciowy: +**2Adefault_u¿ycie domy¶lnego asemblera +3*2Aas_asemblacja przy u¿yciu GNU AS +3*2Anasmcoff_plik coff (Go32v2) przy u¿yciu Nasm +3*2Anasmelf_plik elf32 (Linux) przy u¿yciu Nasm +3*2Anasmwin32_plik obj (Win32) przy u¿yciu Nasm +3*2Anasmwdosx_plik obj (Win32/WDOSX) przy u¿yciu Nasm +3*2Awasm_plik obj przy u¿yciu Wasm (Watcom) +3*2Anasmobj_plik obj przy u¿yciu Nasm +3*2Amasm_plik obj przy u¿yciu Masm (Microsoft) +3*2Atasm_plik obj przy u¿yciu Tasm (Borland) +3*2Aelf_bezpo¶redni zapis do pliku elf32 (Linux) +3*2Acoff_bezpo¶redni zapis do pliku coff (Go32v2) +3*2Apecoff_bezpo¶redni zapis do pliku pecoff (Win32) +4*2Aas_asemblacja przy u¿yciu GNU AS +6*2Aas_o-file (Unix) przy u¿yciu GNU AS +6*2Agas_asembler GNU Motorola +6*2Amit_sk³adnia MIT (dawniej GAS) +6*2Amot_standardowy asembler Motorola +A*2Aas_asemblacja przy u¿yciu GNU AS +P*2Aas_asemblacja przy u¿yciu GNU AS +S*2Aas_asemblacja przy u¿yciu GNU AS +**1b_generuje informacje przegl±darki +**2bl_generuje informacje o lokalnych symbolach +**1B_budowanie wszystkich modu³ów +**1C<x>_opcje generacji kodu: +**2Cc<x>_ustawia domy¶lny sposób wywo³ania funkcji/procedur na <x> +**2CD_tworzenie tak¿e bibliotek dynamicznych (niedostêpne) +**2Ce_kompilacja z emulowanymi opkodami zmiennoprzecinkowymi +**2Cf<x>_ustawia u¿ywany zbiór instrukcji FPU na <x> (u¿yj "fpc -i", aby zobaczyæ mo¿liwe warto¶ci) +**2Cg_generowanie kodu PIC +**2Ch<n>_rozmiar sterty w bajtach (pomiêdzy 1023 i 67107840) +**2Ci_sprawdzanie operacji wej¶cia/wyj¶cia +**2Cn_pominiêcie etapu linkowania +**2Co_sprawdzanie przepe³nienia liczb ca³kowitych +**2Cp<x>_ustawia u¿ywany zbiór instrukcji na <x> (u¿yj "fpc -i", aby zobaczyæ mo¿liwe warto¶ci) +**2Cr_sprawdzanie zakresu +**2CR_sprawdzanie poprawno¶ci wywo³ywania metod obiektów +**2Cs<n>_ustawienie rozmiar stosu na <n> +**2Ct_sprawdzanie stosu +**2CX_tworzenie bibliotek smartlinked +**1d<x>_zdefiniowanie symbolu <x> +*O1D_generacja pliku DEF +*O2Dd<x>_ustawienie opisu na <x> +**2Dv<x>_ustawienie wersji DLL na <x> +*O2Dw_aplikacja PM +**1e<x>_ustawienie ¶cie¿ki do asemblera i linkera +**1E_to samo co -Cn +**1F<x>_ustawianie nazw i ¶cie¿ek: +**2Fa<x>[,y]_wczytuje <x> (i [y]) zanim zostani± wczytane modu³y z sekcji USES +**2Fc<x>_ustawienie strony kodowej ¼róde³ na <x> +**2FD<x>_ustawienie katalogu z narzêdziami kompilatora +**2Fe<x>_przekierowanie komunikatów o b³êdach do pliku <x> +**2FE<x>_ustawienie katalogu dla skompilowanych programów/modu³ów na <x> +**2Fi<x>_dodanie <x> do ¶cie¿ki include'ów +**2Fl<x>_dodanie <x> do ¶cie¿ki bibliotek +**2FL<x>_u¿ycie <x> jako dynamicznego linkera +**2Fo<x>_dodanie <x> do ¶cie¿ki obiektów +**2Fr<x>_³adowanie pliku <x> z komunikatami b³êdów +**2Fu<x>_dodanie <x> do ¶cie¿ki modu³ów +**2FU<x>_ustawienie katalogu dla skompilowanych modu³ów, uniewa¿nia -FE +*g1g_generacja informacji debuggera: +*g2gc_generacja kodu sprawdzaj±cego wska¼niki +*g2gd_u¿ycie dbx +*g2gg_u¿ycie gsym +*g2gh_u¿ycie modu³u ¶ledzenia sterty(do wykrywania wycieków pamiêci) +*g2gl_u¿ycie modu³u z informacjami o numerach linii programu +*g2gv_generacja kodu mo¿liwego do ¶ledzenia przy pomocy valgrind +*g2gw_generacja informacji debuggera dwarf +**1i_informacje +**2iD_zwraca datê kompilatora +**2iV_zwraca wersjê kompilatora +**2iSO_zwraca OS kompilatora +**2iSP_zwraca typ procesora kompilatora +**2iTO_zwraca docelowy OS +**2iTP_zwraca docelowy typ kompilatora +**1I<x>_dodanie <x> do ¶cie¿ki include'ów +**1k<x>_podanie <x> do linkera +**1l_wypisanie logo +**1M<x>_ustawia tryb jêzyka na <x> +**2Mfpc_dialekt free pascala (domy¶lny) +**2Mobjfpc_w³±czenie niektórych rozszerzeñ Delphi 2 +**2Mdelphi_kompatybilno¶æ z Delphi +**2Mtp_kompatybilno¶æ z TP/BP 7.0 +**2Mgpc_kompatybilno¶æ z gpc +**2Mmac_kompatybilno¶æ z dialektami pascala na Macintosha +**1n_zignorowanie standardowego pliku konfiguracyjnego +**1N<x>optymalizacje wêz³ów drzewa +**2Nu_rozwijanie pêtli +**1o<x>_zmiana nazwy skompilowanego programu na <x> +3*1O<x>_optymalizacje: +3*2Og_generacja mniejszego kodu +3*2OG_generacja szybszego kodu (domy¶lne) +3*2Or_trzymanie niektórych zmiennych w rejestrach +3*2Ou_w³±czenie niepewnych optymalizacji (zobacz w dokumentacji) +3*2O1_optymalizacje pierwszego stopnia (szybkie) +3*2O2_optymalizacje drugiego stopnia (-O1 + wolniejsze) +3*2O3_optymalizacje trzeciego stopnia (powtarzane maksymalnie 5 razy -02) +3*2Op<x>_procesor docelowy: +3*3Op1_ustawienie procesora docelowego na 386/486 +3*3Op2_ustawienie procesora docelowego na Pentium/PentiumMMX (tm) +3*3Op3_ustawienie procesora docelowego na PPro/PII/c6x86/K6 (tm) +6*2Og_generacja mniejszego kodu +6*2OG_generacja szybszego kodu (domy¶lne) +6*2Ox_maksymalne optymalizacje (ci±gle zawieraj± B£ÊDY!!!) +6*2O0_ustawia docelowy procesor na MC68000 +6*2O2_ustawia docelowy procesor na MC68020+ (domy¶lne) +**1pg_generacja kodu do profilowania przy pomocy gprof (definiuje FPC_PROFILE) +**1R<x>_styl asemblera u¿ywanego w ¼ród³ach: +**2Rdefault_u¿ycie domy¶lnego asemblera +3*2Ratt_styl AT&T +3*2Rintel_styl Intel +6*2RMOT_styl Motorola +**1S<x>_opcje sk³adni: +**2S2_to samo co -Mobjfpc +**2Sc_wspieranie operatorów C (*=,+=,/= oraz -=) +**2Sa_do³±czanie kodu asercji +**2Sd_to samo co -Mdelphi +**2Se<x>_opcje b³êdów. <x> jest kombinacj±: +**3*_<n> : kompilator zatrzymuje siê po <x> b³êdach (domy¶lnie 1) +**3*_w : kompilator zatrzymuje siê tak¿e na ostrze¿eniach +**3*_n : kompilator zatrzymuje siê tak¿e na notkach +**3*_h : kompilator zatrzymuje siê tak¿e na podpowiedziach +**2Sg_zezwolenie na LABEL i GOTO +**2Sh_u¿ycie ansistringów +**2Si_wspieranie INLINE w stylu C++ +**2SI<x>_ustawia styl interfejsów na <x> +**3SIcom_interfejsy kompatybilne z COM (domy¶lne) +**3SIcorba_interfejsy kompatybilne z CORBA +**2Sm_wspieranie makr jak w C (opcja globalna) +**2So_to samo co -Mtp +**2Sp_to samo co -Mgpc +**2Ss_konstruktory musz± mieæ nazwê init (destruktory - done) +**1s_pominiêcie wywo³ania asemblera i linkera +**2sh_generacja skryptu do linkowania na ho¶cie +**2st_generacja skryptu do linkowania na celu +**2sr_ominiêcie fazy alokowania rejestrów (u¿ywaj z -alr) +**1T<x>_docelowy system operacyjny: +3*2Temx_OS/2 na EMX (wliczaj±c EMX/RSX extender) +3*2Tfreebsd_FreeBSD +3*2Tgo32v2_DJ Delorie DOS extender - wersja 2 +3*2Tlinux_Linux +3*2Tnetbsd_NetBSD +3*2Tnetware_Novell Netware Module (clib) +3*2Tnetwlibc_Novell Netware Module (libc) +3*2Topenbsd_OpenBSD +3*2Tos2_OS/2 / eComStation +3*2Tsunos_SunOS/Solaris +3*2Twatcom_DOS extendery zgodne z Watcomem +3*2Twdosx_WDOSX DOS extender +3*2Twin32_32-bitowy Windows +4*2Tlinux_Linux +6*2Tamiga_Commodore Amiga +6*2Tatari_Atari ST/STe/TT +6*2Tlinux_Linux-68k +6*2Tmacos_Macintosh m68k (nie wspierane) +6*2Tpalmos_PalmOS +A*2Tlinux_Linux +P*2Tdarwin_Darwin i MacOS X na PowerPC +P*2Tlinux_Linux na PowerPC +P*2Tmacos_MacOS (klasyczny) na PowerPC +P*2Tmorphos_MorphOS +S*2Tlinux_Linux +**1u<x>_usuniêcie symbolu <x> +**1U_opcje modu³ów: +**2Un_pominiêcie sprawdzania nazwy modu³u +**2Ur_generacja modu³u do wydania (release) +**2Us_kompilacja modu³u system +**1v<x>_obszerne opisy. <x> jest kombinacj± nastêpuj±cych liter i cyfr: +**2*_e : pokazuje b³êdy (domy¶lne) 0 : nic nie pokazuje (oprócz b³êdów) +**2*_w : pokazuje ostrze¿enia u : pokazuje informacje o modu³ach +**2*_n : pokazuje notki t : pokazuje próbowane/u¿yte pliki +**2*_h : pokazuje podpowiedzi c : pokazuje warunki +**2*_i : pokazuje ogólne informacje d : pokazuje informacje debugowania +**2*_l : pokazuje numery lini r : tryb kompatybilno¶ci z Rhide/GCC +**2*_a : pokazuje wszystko x : informacje o pliku exe (tylko Win32) +**2*_v : zapisuje plik fpcdebug.txt p : zapisuje tree.log z drzewem +**2*_ z du¿± ilo¶ci± informacji parsowania +3*1W<x>_opcje dla Win32 i podobnych +3*2WB_tworzenie relokacyjnego obrazu +3*2WB<x>_ustawienie bazy obrazu na szesnastkow± warto¶æ <x> +3*2WC_aplikacja konsolowa +3*2WD_u¿ycie DEFFILE do eksportu funkcji z DLLa lub EXE +3*2WF_aplikacja pe³noekranowa (tylko OS/2) +3*2WG_aplikacja graficzna +3*2WN_nie generuje kodu relokacji (potrzebne do debugowania) +3*2WR_generuje kod relokacji +P*2WC_aplikacja konsolowa (tylko MacOS) +P*2WG_aplikacja graficzna (tylko MacOS) +P*2WT_aplikacja narzêdziowa (narzêdzie MPW, tylko MacOS) +**1X_opcje plików wykonywalnych: +**2Xc_podaje --shared do linkera (tylko Unix) +**2Xd_nie u¿ywa standardowej ¶cie¿ki bibliotek (potrzebne do cross-kompilacji) +**2XD_linkowanie dynamiczne (definiuje FPC_LINK_DYNAMIC) +**2Xm_generuje link map +**2XM<x>_ustawia nazwê g³ównego bloku programu (domy¶lnie 'main') +**2XP<x>_poprzedza nazwê binutils tekstem <x> +**2Xr<x>_ustawia ¶cie¿kê bibliotek na <x> (potrzebne do cross-kompilacji) +**2Xs_wyciêcie wszystkich symboli z pliku +**2XS_linkowanie statycznie (domy¶lne)(definiuje FPC_LINK_STATIC) +**2Xt_linkuje z bibliotekami statycznymi (podaje -static do linkera) +**2XX_linkowanie smart (definiuje FPC_LINK_SMART) +**1*_ +**1?_pokazanie pomocy +**1h_pokazanie pomocy bez zatrzymywania +] + +# +# The End... diff --git a/closures/compiler/msg/errorpt.msg b/closures/compiler/msg/errorpt.msg new file mode 100644 index 0000000000..76abb6d4ed --- /dev/null +++ b/closures/compiler/msg/errorpt.msg @@ -0,0 +1,3447 @@ +# +# This file is part of the Free Pascal Compiler +# Copyright (c) 1999-2009 by the Free Pascal Development team +# +# Portuguese (CP850) language file for Free Pascal Compiler +# Contributed by Marcelo B Paula, based on errore.msg SVN Rev.19883 +# Former translator: Ari Ricardo Ody <ary.odi at japinfo.com.br> +# +# 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. +# +# +# The constants are build in the following order: +# <part>_<type>_<txtidentifier> +# +# <part> is the part of the compiler the message is used +# asmr_ assembler parsing +# asmw_ assembler writing/binary writers +# unit_ unit handling +# scan_ scanner +# parser_ parser +# type_ type checking +# general_ general info +# exec_ calls to assembler, external linker, binder +# link_ internal linker +# +# <type> the type of the message it should normally used for +# f_ fatal error +# e_ error +# w_ warning +# n_ note +# h_ hint +# i_ info +# l_ add linenumber +# u_ used +# t_ tried +# c_ conditional +# d_ debug message +# x_ executable informations +# o_ normal (e.g., "press enter to continue") +# +# <type> can contain a minus sign at the beginning to mark that +# the message is off by default. Look at type_w_explicit_string_cast +# for example. + +# +# General +# +# 01023 is the last used one +# +# BeginOfTeX +% \section{General compiler messages} +% This section gives the compiler messages which are not fatal, but which +% display useful information. The number of such messages can be +% controlled with the various verbosity level \var{-v} switches. +% \begin{description} +general_t_compilername=01000_T_Compilador: $1 +% When the \var{-vt} switch is used, this line tells you what compiler +% is used. +general_d_sourceos=01001_D_SO Compilador: $1 +% When the \var{-vd} switch is used, this line tells you what the source +% operating system is. +general_i_targetos=01002_I_SO Alvo: $1 +% When the \var{-vd} switch is used, this line tells you what the target +% operating system is. +general_t_exepath=01003_T_Usando caminho execut vel: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its binaries. +general_t_unitpath=01004_T_Usando caminho unidade: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for compiled units. You can set this path with the \var{-Fu} option. +general_t_includepath=01005_T_Usando caminho inclusäes: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its include files (files used in \var{\{\$I xxx\}} statements). +% You can set this path with the \var{-Fi} option. +general_t_librarypath=01006_T_Usando caminho biblioteca: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for the libraries. You can set this path with the \var{-Fl} option. +general_t_objectpath=01007_T_Usando caminho objeto: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for object files you link in (files used in \var{\{\$L xxx\}} statements). +% You can set this path with the \var{-Fo} option. +general_i_abslines_compiled=01008_I_$1 linhas compiladas, $2 seg$3 +% When the \var{-vi} switch is used, the compiler reports the number +% of lines compiled, and the time it took to compile them (real time, +% not program time). +general_f_no_memory_left=01009_F_Mem¢ria insuficiente +% The compiler doesn't have enough memory to compile your program. There are +% several remedies for this: +% \begin{itemize} +% \item If you're using the build option of the compiler, try compiling the +% different units manually. +% \item If you're compiling a huge program, split it up into units, and compile +% these separately. +% \item If the previous two don't work, recompile the compiler with a bigger +% heap. (You can use the \var{-Ch} option for this, \seeo{Ch}.) +% \end{itemize} +general_i_writingresourcefile=01010_I_Gravando arquivo Tabela Recursos 'String': $1 +% This message is shown when the compiler writes the Resource String Table +% file containing all the resource strings for a program. +general_e_errorwritingresourcefile=01011_E_Gravando arquivo Tabela Recursos 'String': $1 +% This message is shown when the compiler encounters an error when writing +% the Resource String Table file. +general_i_fatal=01012_I_Fatal: +% Prefix for Fatal Errors. +general_i_error=01013_I_Erro: +% Prefix for Errors. +general_i_warning=01014_I_Aviso: +% Prefix for Warnings. +general_i_note=01015_I_Nota: +% Prefix for Notes. +general_i_hint=01016_I_Dica: +% Prefix for Hints. +general_e_path_does_not_exist=01017_E_Caminho "$1" nÆo existe +% The specified path does not exist. +general_f_compilation_aborted=01018_F_Compila‡Æo abortada +% Compilation was aborted. +general_text_bytes_code=01019_bytes (c¢digo gerado) +% The size of the generated executable code, in bytes. +general_text_bytes_data=01020_bytes (dados gerados) +% The size of the generated program data, in bytes. +general_i_number_of_warnings=01021_I_$1 aviso(s) emitido(s) +% Total number of warnings issued during compilation. +general_i_number_of_hints=01022_I_$1 dica(s) emitida(s) +% Total number of hints issued during compilation. +general_i_number_of_notes=01023_I_$1 nota(s) emitida(s) +% Total number of notes issued during compilation. +general_f_ioerror=01024_F_Erro E/S: $1 +% During compilation an I/O error happened which allows no further compilation. +general_f_oserror=01025_F_Erro do sistema operacional: $1 +% During compilation an operanting system error happened which allows no further compilation. +% \end{description} +# +# Scanner +# +# 02087 is the last used one +# +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compilation handling. +% \begin{description} +scan_f_end_of_file=02000_F_Fim de arquivo inesperado +% This typically happens in one of the following cases: +% \begin{itemize} +% \item The source file ends before the final \var{end.} statement. This +% happens mostly when the \var{begin} and \var{end} statements aren't +% balanced; +% \item An include file ends in the middle of a statement. +% \item A comment was not closed. +% \end{itemize} +scan_f_string_exceeds_line=02001_F_'String' excendo linha +% There is a missing closing ' in a string, so it occupies +% multiple lines. +scan_f_illegal_char=02002_F_caractere ilegal "$1" ($2) +% An illegal character was encountered in the input file. +scan_f_syn_expected=02003_F_Erro sintaxe, "$1" esperado, mas "$2" encontrado +% This indicates that the compiler expected a different token than +% the one you typed. It can occur almost anywhere it is possible to make an error +% against the Pascal language. +scan_t_start_include_file=02004_TL_Iniciando leitura arquivo de inclusäes $1 +% When you provide the \var{-vt} switch, the compiler tells you +% when it starts reading an included file. +scan_w_comment_level=02005_W_N¡vel coment rio $1 encontrado +% When the \var{-vw} switch is used, then the compiler warns you if +% it finds nested comments. Nested comments are not allowed in Turbo Pascal +% and Delphi, and can be a possible source of errors. +scan_n_ignored_switch=02008_N_Ignorar chave compilador "$1" +% With \var{-vn} on, the compiler warns if it ignores a switch. +scan_w_illegal_switch=02009_W_Chave ilegal compilador "$1" +% You included a compiler switch (i.e. \var{\{\$... \}}) which the compiler +% does not recognise. +scan_w_switch_is_global=02010_W_Chave global compilador fora de lugar +% The compiler switch is misplaced, and should be located at +% the start of the unit or program. +scan_e_illegal_char_const=02011_E_Constante caractere ilegal +% This happens when you specify a character with its ASCII code, as in +% \var{\#96}, but the number is either illegal, or out of range. +scan_f_cannot_open_input=02012_F_Imposs¡vel abrir arquivo "$1" +% \fpc cannot find the program or unit source file you specified on the +% command line. +scan_f_cannot_open_includefile=02013_F_Imposs¡vel abrir arquivo de inclusäes "$1" +% \fpc cannot find the source file you specified in a \var{\{\$include ..\}} +% statement. +scan_e_illegal_pack_records=02015_E_Especificador alinhamento registro ilegal "$1" +% You are specifying \var{\{\$PACKRECORDS n\} } or \var{\{\$ALIGN n\} } +% with an illegal value for \var{n}. For \$PACKRECORDS valid alignments are 1, 2, 4, 8, 16, 32, C, +% NORMAL, DEFAULT, and for \$ALIGN valid alignments are 1, 2, 4, 8, 16, 32, ON, +% OFF. Under mode MacPas \$ALIGN also supports MAC68K, POWER and RESET. +scan_e_illegal_pack_enum=02016_E_Especificador tamanho-m¡nimo enumera‡Æo ilegal "$1" +% You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for +% \var{n}. Only 1,2,4, NORMAL or DEFAULT is valid here. +scan_e_endif_expected=02017_E_$ENDIF esperado para $1 $2 definido em $3 linha $4 +% Your conditional compilation statements are unbalanced. +scan_e_preproc_syntax_error=02018_E_Erro sintaxe enquanto analisando uma expressÆo compila‡Æo condicional +% There is an error in the expression following the \var{\{\$if ..\}}, \var{\{\$ifc \}} +% or \var{\{\$setc \}} compiler directives. +scan_e_error_in_preproc_expr=02019_E_Avaliando uma expressÆo compila‡Æo condicional +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc compiler +% directives. +scan_w_macro_cut_after_255_chars=02020_W_Conte£do macro limitada ao tamanho de 255 caracteres +% The contents of macros cannot be longer than 255 characters. +scan_e_endif_without_if=02021_E_ENDIF sem IF(N)DEF +% Your \var{\{\$IFDEF ..\}} and {\{\$ENDIF\}} statements aren't balanced. +scan_f_user_defined=02022_F_Definido pelo usu rio: $1 +% A user defined fatal error occurred. See also the \progref. +scan_e_user_defined=02023_E_Definido pelo usu rio: $1 +% A user defined error occurred. See also the \progref. +scan_w_user_defined=02024_W_Definido pelo usu rio: $1 +% A user defined warning occurred. See also the \progref. +scan_n_user_defined=02025_N_Definido pelo usu rio: $1 +% A user defined note was encountered. See also the \progref. +scan_h_user_defined=02026_H_Definido pelo usu rio: $1 +% A user defined hint was encountered. See also the \progref. +scan_i_user_defined=02027_I_Definido pelo usu rio: $1 +% User defined information was encountered. See also the \progref. +scan_e_keyword_cant_be_a_macro=02028_E_Palavra-chave redefinida como macro nÆo tem efeito +% You cannot redefine keywords with macros. +scan_f_macro_buffer_overflow=02029_F_Transbordamento "buffer" macro durante leitura ou expansÆo de uma macro +% Your macro or its result was too long for the compiler. +scan_w_macro_too_deep=02030_W_ExpansÆo de macros excede profundidade de 16. +% When expanding a macro, macros have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_w_wrong_styled_switch=02031_W_chaves compilador nÆo sÆo suportadas no estilo de coment rio // +% Compiler switches should be in normal Pascal style comments. +scan_d_handling_switch=02032_DL_Chave manipula‡Æo "$1" +% When you set debugging info on (\var{-vd}) the compiler tells you when it +% is evaluating conditional compile statements. +scan_c_endif_found=02033_CL_ENDIF $1 encontrado +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifdef_found=02034_CL_IFDEF $1 encontrado, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifopt_found=02035_CL_IFOPT $1 encontrado, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_if_found=02036_CL_IF $1 encontrado, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifndef_found=02037_CL_IFNDEF $1 encontrado, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_else_found=02038_CL_ELSE $1 encontrado, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_skipping_until=02039_CL_Pulando at‚... +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements, and whether it is skipping or +% compiling parts. +scan_i_press_enter=02040_I_Tecle <return> para continuar +% When the \var{-vi} switch is used, the compiler stops compilation +% and waits for the \var{Enter} key to be pressed when it encounters +% a \var{\{\$STOP\}} directive. +scan_w_unsupported_switch=02041_W_Chave nÆo suportada "$1" +% When warnings are turned on (\var{-vw}), the compiler warns you about +% unsupported switches. This means that the switch is used in Delphi or +% Turbo Pascal, but not in \fpc. +scan_w_illegal_directive=02042_W_Diretiva compilador ilegal "$1" +% When warnings are turned on (\var{-vw}), the compiler warns you about +% unrecognised switches. For a list of recognised switches, see the \progref. +scan_t_back_in=02043_TL_De volta $1 +% When you use the \var{-vt} switch, the compiler tells you when it has finished +% reading an include file. +scan_w_unsupported_app_type=02044_W_Tipo aplica‡Æo nÆo suportada: "$1" +% You get this warning if you specify an unknown application type +% with the directive \var{\{\$APPTYPE\}}. +scan_w_app_type_not_support=02045_W_APPTYPE nÆo ‚ suportado pelo SO alvo +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_w_description_not_support=02046_W_DESCRIPTION nÆo ‚ suportado pelo SO alvo +% The \var{\{\$DESCRIPTION\}} directive is not supported on this target OS. +scan_n_version_not_support=02047_N_VERSION nÆo ‚ suportado pelo SO alvo +% The \var{\{\$VERSION\}} directive is not supported on this target OS. +scan_n_only_exe_version=02048_N_VERSION apenas para EXEs ou DLLs +% The \var{\{\$VERSION\}} directive is only used for executable or DLL sources. +scan_w_wrong_version_ignored=02049_W_Formato incorreto para a diretiva VERSION "$1" +% The \var{\{\$VERSION\}} directive format is majorversion.minorversion +% where majorversion and minorversion are words. +scan_e_illegal_asmmode_specifier=02050_E_Estilo especificado assembler ilegal "$1" +% When you specify an assembler mode with the \var{\{\$ASMMODE xxx\}} directive, +% the compiler didn't recognize the mode you specified. +scan_w_no_asm_reader_switch_inside_asm=02051_W_ASM reader switch is not possible inside asm statement, "$1" will be effective only for next +% It is not possible to switch from one assembler reader to another +% inside an assembler block. The new reader will be used for next +% assembler statements only. +scan_e_wrong_switch_toggle=02052_E_Chave alternƒncia incorreta, usar ON/OFF ou +/- +% You need to use ON or OFF or a + or - to toggle the switch. +scan_e_resourcefiles_not_supported=02053_E_Arquivo recursos nÆo suportado para este alvo +% The target you are compiling for doesn't support resource files. +scan_w_include_env_not_found=02054_W_Vari vel inclusÆo ambiente "$1" nÆo encontrado no ambiente +% The included environment variable can't be found in the environment; it will +% be replaced by an empty string instead. +scan_e_invalid_maxfpureg_value=02055_E_Valor ilegal para o registrador limite UPF +% Valid values for this directive are 0..8 and NORMAL/DEFAULT. +scan_w_only_one_resourcefile_supported=02056_W_Apenas um arquivo de recursos ‚ suportado para este alvo +% The target you are compiling for supports only one resource file. +% The first resource file found is used, the others are discarded. +scan_w_macro_support_turned_off=02057_W_Suporte Macro foi desativado +% A macro declaration has been found, but macro support is currently off, +% so the declaration will be ignored. To turn macro support on compile with +% -Sm on the command line or add \{\$MACRO ON\} in the source. +scan_e_invalid_interface_type=02058_E_Tipo ilegal de interface especificado. SÆo v lidos COM, CORBA ou DEFAULT. +% The interface type that was specified is not supported. +scan_w_appid_not_support=02059_W_APPID ‚ suportado apenas para PalmOS +% The \var{\{\$APPID\}} directive is only supported for the PalmOS target. +scan_w_appname_not_support=02060_W_APPNAME ‚ suportado apenas para PalmOS +% The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target. +scan_e_string_exceeds_255_chars=02061_E_Constante 'String' nÆo pode ser maior que 255 caracteres +% A single string constant can contain at most 255 chars. Try splitting up the +% string into multiple smaller parts and concatenate them with a + operator. +scan_f_include_deep_ten=02062_F_Incluindo arquivos inclusÆo excede um n¡vel de 16. +% When including include files the files have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_e_too_many_push=02063_F_Muitos n¡veis de PUSH. Max. 20 +% A maximum of 20 levels is allowed. This error occurs only in mode MacPas. +scan_e_too_many_pop=02064_E_Um POP sem um PUSH anterior +% This error occurs only in mode MacPas. +scan_e_error_macro_lacks_value=02065_E_Macro ou vari vel tempo compila‡Æo "$1" sem nenhum valor +% Thus the conditional compile time expression cannot be evaluated. +scan_e_wrong_switch_toggle_default=02066_E_Chave alternƒncia incorreta, usar ON/OFF/DEFAULT ou +/-/* +% You need to use ON or OFF or DEFAULT or a + or - or * to toggle the switch. +scan_e_mode_switch_not_allowed=02067_E_Chave modo "$1" nÆo permitida aqui +% A mode switch has already been encountered, or, in the case of option -Mmacpas, +% a mode switch occurs after UNIT. +scan_e_error_macro_undefined=02068_E_Vari vel tempo compila‡Æo ou macro "$1" nÆo definida. +% Thus the conditional compile time expression cannot be evaluated. Only in mode MacPas. +scan_e_utf8_bigger_than_65535=02069_E_C¢digo UTF-8 maior que 65535 encontrado +% \fpc handles UTF-8 strings internally as widestrings, i.e. the char codes are limited to 65535. +scan_e_utf8_malformed=02070_E_'String' UTF-8 mal-formada +% The given string isn't a valid UTF-8 string. +scan_c_switching_to_utf8=02071_C_Assinatura UTF-8 encontrada, usando codifica‡Æo UTF-8 +% The compiler found a UTF-8 encoding signature (\$ef, \$bb, \$bf) at the beginning of a file, +% so it interprets it as a UTF-8 file. +scan_e_compile_time_typeerror=02072_E_ExpressÆo tempo compila‡Æo: Procurado $1 mas obtido $2 na $3 +% The type-check of a compile time expression failed. +scan_n_app_type_not_support=02073_N_APPTYPE nÆo ‚ suportado pelo SO alvo +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_e_illegal_optimization_specifier=02074_E_Otimiza‡Æo especificada ilegal "$1" +% You specified an optimization with the \var{\{\$OPTIMIZATION xxx\}} directive, +% and the compiler didn't recognize the optimization you specified. +scan_w_setpeflags_not_support=02075_W_SETPEFLAGS nÆo ‚ suportado pelo SO alvo +% The \var{\{\$SETPEFLAGS\}} directive is not supported by the target OS. +scan_w_imagebase_not_support=02076_W_IMAGEBASE nÆo ‚ suportado pelo SO alvo +% The \var{\{\$IMAGEBASE\}} directive is not supported by the target OS. +scan_w_minstacksize_not_support=02077_W_MINSTACKSIZE nÆo ‚ suportado pelo SO alvo +% The \var{\{\$MINSTACKSIZE\}} directive is not supported by the target OS. +scan_w_maxstacksize_not_support=02078_W_MAXSTACKSIZE nÆo ‚ suportado pelo SO alvo +% The \var{\{\$MAXSTACKSIZE\}} directive is not supported by the target OS. +scanner_e_illegal_warn_state=02079_E_Estado "$1" ilegal para a diretiva $WARN +% Only ON and OFF can be used as state with a \var{\{\$WARN\}} compiler directive. +scan_e_only_packset=02080_E_Valor ilegal para conjunto empacotamento +% Only 0, 1, 2, 4, 8, DEFAULT and NORMAL are allowed as packset parameters. +scan_w_pic_ignored=02081_W_Diretiva PIC ou chave ignorada +% Several targets, such as \windows, do not support nor need PIC, +% so the PIC directive and switch are ignored. +scan_w_unsupported_switch_by_target=02082_W_A chave "$1" nÆo ‚ suportada pelo alvo selecionado atualmente +% Some compiler switches like \$E are not supported by all targets. +scan_w_frameworks_darwin_only=02084_W_Op‡äes relacionadas a "Framework" sÆo apenas suportadas para Darwin/Mac OS X +% Frameworks are not a known concept, or at least not supported by FPC, +% on operating systems other than Darwin/Mac OS X. +scan_e_illegal_minfpconstprec=02085_E_Constante precisÆo m¡nima ponto flutuante ilegal "$1" +% Valid minimal precisions for floating point constants are default, 32 and 64, +% which mean respectively minimal (usually 32 bit), 32 bit and 64 bit precision. +scan_w_multiple_main_name_overrides=02086_W_Sobrescrevendo nome do procedimento "main" m£ltiplas vezes, foi previamente ajustado para "$1" +% The name for the main entry procedure is specified more than once. Only the last +% name will be used. +scanner_w_illegal_warn_identifier=02087_W_Identificador "$1" ilegal para a diretiva $WARN +% Identifier is not known by a \var{\{\$WARN\}} compiler directive. +scanner_e_illegal_alignment_directive=02088_E_Diretiva de alinhamento ilegal +% The alignment directive is not valid. Either the alignment type is not known or the alignment +% value is not a power of two. +% \end{description} +# +# Parser +# +# 03314 is the last used one +# +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your Pascal constructs +% are correct. +% \begin{description} +parser_e_syntax_error=03000_E_Analizador - Erro sintaxe +% An error against the Turbo Pascal language was encountered. This typically +% happens when an illegal character is found in the source file. +parser_e_dont_nest_interrupt=03004_E_Procedimento INTERRUPT nÆo pode ser aninhado +% An \var{INTERRUPT} procedure must be global. +parser_w_proc_directive_ignored=03005_W_Tipo procedimento "$1" ignorado +% The specified procedure directive is ignored by FPC programs. +parser_e_no_overload_for_all_procs=03006_E_Nem todas as declara‡äes de "$1" estÆo declaradas com OVERLOAD +% When you want to use overloading using the \var{OVERLOAD} directive, then +% all declarations need to have \var{OVERLOAD} specified. +parser_e_export_name_double=03008_E_Nome fun‡Æo exportada duplicada "$1" +% Exported function names inside a specific DLL must all be different. +parser_e_export_ordinal_double=03009_E_Öndice fun‡Æo exportada duplicada $1 +% Exported function indexes inside a specific DLL must all be different. +parser_e_export_invalid_index=03010_E_¡ndice inv lido para fun‡Æo exportada +% DLL function index must be in the range \var{1..\$FFFF}. +parser_w_parser_reloc_no_debug=03011_W_Informa‡Æo depura‡Æo DLL reloc vel ou execut vel $1 nÆo funciona, desabilitado. +% It is currently not possible to include debug information in a relocatable DLL. +parser_w_parser_win32_debug_needs_WN=03012_W_Para permitir depura‡Æo para c¢digo win32 vocˆ necessita desabilitar reloca‡Æo com op‡Æo -WN +% Stabs debug info is wrong for relocatable DLL or EXES. Use -WN +% if you want to debug win32 executables. +parser_e_constructorname_must_be_init=03013_E_Nome Construtor deve ser INIT +% You are declaring an object constructor with a name which is not \var{init}, and the +% \var{-Ss} switch is in effect. See the switch \seeo{Ss}. +parser_e_destructorname_must_be_done=03014_E_Nome Destruidor deve ser DONE +% You are declaring an object destructor with a name which is not \var{done}, and the +% \var{-Ss} switch is in effect. See the switch \seeo{Ss}. +parser_e_proc_inline_not_supported=03016_E_Tipo procedimento INLINE nÆo suportado +% You tried to compile a program with C++ style inlining, and forgot to +% specify the \var{-Si} option (\seeo{Si}). The compiler doesn't support C++ +% styled inlining by default. +parser_w_constructor_should_be_public=03018_W_Construtor deve ser p£blico +% Constructors must be in the 'public' part of an object (class) declaration. +parser_w_destructor_should_be_public=03019_W_Destruidor deve ser p£blico +% Destructors must be in the 'public' part of an object (class) declaration. +parser_n_only_one_destructor=03020_N_Classe deve ter apenas um destruidor +% You can declare only one destructor for a class. +parser_e_no_local_objects=03021_E_Defini‡äes classe local nÆo permitidas +% Classes must be defined globally. They cannot be defined inside a +% procedure or function. +parser_f_no_anonym_objects=03022_F_Defini‡äes classe an“nima nÆo permitidas +% An invalid object (class) declaration was encountered, i.e. an +% object or class without methods that isn't derived from another object or +% class. For example: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% will trigger this error. +parser_n_object_has_no_vmt=03023_N_O objeto "$1" nÆo tem VMT +% This is a note indicating that the declared object has no +% virtual method table. +parser_e_illegal_parameter_list=03024_E_Lista parƒmetros ilegal +% You are calling a function with parameters that are of a different type than +% the declared parameters of the function. +parser_e_wrong_parameter_size=03026_E_N£mero incorreto de parƒmetros especificado para chamada de "$1" +% There is an error in the parameter list of the function or procedure -- +% the number of parameters is not correct. +parser_e_overloaded_no_procedure=03027_E_Identificador sobrecarregado "$1" nÆo ‚ uma fun‡Æo +% The compiler encountered a symbol with the same name as an overloaded +% function, but it is not a function it can overload. +parser_e_overloaded_have_same_parameters=03028_E_Fun‡äes sobrecarregadas tˆm a mesma lista de parƒmetros +% You're declaring overloaded functions, but with the same parameter list. +% Overloaded function must have at least 1 different parameter in their +% declaration. +parser_e_header_dont_match_forward=03029_E_Cabe‡alho da fun‡Æo nÆo coincide com a declara‡Æo anterior de "$1" +% You declared a function with the same parameters but +% different result type or function modifiers. +parser_e_header_different_var_names=03030_E_Cabe‡alho fun‡Æo "$1" nÆo coincide com posterior : nome var modifica $2 => $3 +% You declared the function in the \var{interface} part, or with the +% \var{forward} directive, but defined it with a different parameter list. +parser_n_duplicate_enum=03031_N_Valores tipo enumera‡Æo tˆm que ser ascendentes +% \fpc allows enumeration constructions as in C. Examine the following +% two declarations: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% The second declaration would produce an error. \var{A\_UAS} needs to have a +% value higher than \var{A\_E}, i.e. at least 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_With nÆo pode ser usado para vari veis em segmentos diferentes +% With stores a variable locally on the stack, +% but this is not possible if the variable belongs to another segment. +parser_e_too_much_lexlevel=03034_E_Aninhamento fun‡Æo > 31 +% You can nest function definitions only 31 levels deep. +parser_e_range_check_error=03035_E_Erro verifica‡Æo de faixa enquanto avaliando constantes +% The constants are out of their allowed range. +parser_w_range_check_error=03036_W_Erro verifica‡Æo de faixa enquanto avaliando constantes +% The constants are out of their allowed range. +parser_e_double_caselabel=03037_E_R¢tulo duplicado declara‡Æo "case" +% You are specifying the same label 2 times in a \var{case} statement. +parser_e_case_lower_less_than_upper_bound=03038_E_Limite superior da faixa declara‡Æo "case" ‚ menor que o limite inferior +% The upper bound of a \var{case} label is less than the lower bound and this +% is useless. +parser_e_type_const_not_possible=03039_E_Constantes tipadas de classes ou interfaces nÆo sÆo permitidas +% You cannot declare a constant of type class or object. +parser_e_no_overloaded_procvars=03040_E_Vari veis fun‡Æo de fun‡äes sobrecarregadas nÆo sÆo permitidas +% You are trying to assign an overloaded function to a procedural variable. +% This is not allowed. +parser_e_invalid_string_size=03041_E_Comprimento 'String' deve ter valor entre 1 … 255 +% The length of a shortstring in Pascal is limited to 255 characters. You are +% trying to declare a string with length less than 1 or greater than 255. +parser_w_use_extended_syntax_for_objects=03042_W_Use sintaxe extendida de NEW e DISPOSE para instanciar objetos +% If you have a pointer \var{a} to an object type, then the statement +% \var{new(a)} will not initialize the object (i.e. the constructor isn't +% called), although space will be allocated. You should issue the +% \var{new(a,init)} statement. This will allocate space, and call the +% constructor of the object. +parser_w_no_new_dispose_on_void_pointers=03043_W_Uso de NEW ou DISPOSE para ponteiros nÆo tipados nÆo tem sentido +parser_e_no_new_dispose_on_void_pointers=03044_E_Uso de NEW ou DISPOSE nÆo ‚ poss¡vel para ponteiros nÆo tipados +% You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer +% because no size is associated to an untyped pointer. +% It is accepted for compatibility in \var{TP} and \var{DELPHI} modes, but the +% compiler will still warn you if it finds such a construct. +parser_e_class_id_expected=03045_E_Identificador de classe esperado +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., an object or class method, but the type in front of the dot is not +% a known type. +parser_e_no_type_not_allowed_here=03046_E_Identificador tipo nÆo permitido aqui +% You cannot use a type inside an expression. +parser_e_methode_id_expected=03047_E_Identificador de m‚todo esperado +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., an object or class method, but the procedure name is not a +% procedure of this type. +parser_e_header_dont_match_any_member=03048_E_Cabe‡alho fun‡Æo nÆo coincide com qualquer m‚todo desta classe "$1" +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., an object or class method, but the procedure name is not a +% procedure of this type. +parser_d_procedure_start=03049_DL_Procedimento/fun‡Æo $1 +% When using the \var{-vd} switch, the compiler tells you when it starts +% processing a procedure or function implementation. +parser_e_error_in_real=03050_E_Constante ponto flutuante ilegal +% The compiler expects a floating point expression, and gets something else. +parser_e_fail_only_in_constructor=03051_E_FAIL s¢ pode ser usado em contrutores +% You are using the \var{fail} keyword outside a constructor method. +parser_e_no_paras_for_destructor=03052_E_Destruidores nÆo podem ter parƒmetros +% You are declaring a destructor with a parameter list. Destructor methods +% cannot have parameters. +parser_e_only_class_members_via_class_ref=03053_E_Apenas m‚todos, propriedades e vari veis de classe podem ser referenciadas por referˆncias classe +% This error occurs in a situation like the following: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} is not a class method and hence cannot be called with a class +% reference. +parser_e_only_class_members=03054_E_Apenas m‚todos, propriedades e vari veis de classe podem ser acessadas em m‚todos de classe +% This is related to the previous error. You cannot call a method of an object +% from inside a class method. The following code would produce this error: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% Because free is a normal method of a class it cannot be called from a class +% method. +parser_e_case_mismatch=03055_E_Constante e tipo CASE incompat¡veis +% One of the labels is not of the same type as the case variable. +parser_e_illegal_symbol_exported=03056_E_S¡mbolos s¢ podem ser exportados em uma biblioteca +% You can only export procedures and functions when you write a library. You +% cannot export variables or constants. +parser_w_should_use_override=03057_W_Um m‚todo herdado ‚ ocultado por "$1" +% A method that is declared \var{virtual} in a parent class, should be +% overridden in the descendant class with the \var{override} directive. If you +% don't specify the \var{override} directive, you will hide the parent method; +% you will not override it. +parser_e_nothing_to_be_overridden=03058_E_NÆo h  m‚todo na classe ancestral para ser sobreposto: "$1" +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_no_procedure_to_access_property=03059_E_Nenhum membro foi provido para acessar a propriedade +% You specified no \var{read} directive for a property. +parser_w_stored_not_implemented=03060_W_Diretiva propriedade armazenamento ainda nÆo foi implementada +% This message is no longer used, as the \var{stored} directive has been implemented. +parser_e_ill_property_access_sym=03061_E_S¡mbolo ilegal para acesso propriedade +% There is an error in the \var{read} or \var{write} directives for an array +% property. When you declare an array property, you can only access it with +% procedures and functions. The following code would cause such an error. +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_NÆo ‚ poss¡vel acessar um campo protegido de um objeto aqui +% Fields that are declared in a \var{protected} section of an object or class +% declaration cannot be accessed outside the module where the object is +% defined, or outside descendent object methods. +parser_e_cant_access_private_member=03063_E_NÆo ‚ poss¡vel acessar um campo privado de um objeto aqui +% Fields that are declared in a \var{private} section of an object or class +% declaration cannot be accessed outside the module where the class is +% defined. +parser_e_overridden_methods_not_same_ret=03066_E_M‚todos sobrepostos devem ter o mesmo tipo de retorno: "$2" ‚ sobreposto por "$1" que possui outro tipo retorno +% If you declare overridden methods in a class definition, they must +% have the same return type. +parser_e_dont_nest_export=03067_E_Fun‡äes EXPORT declaradas nÆo podem estar aninhadas +% You cannot declare a function or procedure within a function or procedure +% that was declared as an export procedure. +parser_e_methods_dont_be_export=03068_E_M‚todos nÆo podem ser EXPORTados +% You cannot declare a procedure that is a method for an object as +% \var{export}ed. +parser_e_call_by_ref_without_typeconv=03069_E_Chamada por var. para arg. no. $1 tem que coincidir exatamente: Obtido "$2" esperado "$3" +% When calling a function declared with \var{var} parameters, the variables in +% the function call must be of exactly the same type. There is no automatic +% type conversion. +parser_e_no_super_class=03070_E_Classe nÆo ‚ uma classe pai da classe atual +% When calling inherited methods, you are trying to call a method of a non-related +% class. You can only call an inherited method of a parent class. +parser_e_self_not_in_method=03071_E_SELF ‚ permitido apenas em m‚todos +% You are trying to use the \var{self} parameter outside an object's method. +% Only methods get passed the \var{self} parameters. +parser_e_generic_methods_only_in_methods=03072_E_M‚todos s¢ podem estar em outros m‚todos se chamados diretamente com o identificador de tipo da classe +% A construction like \var{sometype.somemethod} is only allowed in a method. +parser_e_illegal_colon_qualifier=03073_E_Uso ilegal de ':' +% You are using the format \var{:} (colon) 2 times on an expression that +% is not a real expression. +parser_e_illegal_set_expr=03074_E_Erro verifica‡Æo de faixa em conjunto construtor ou elemento conjunto duplicado +% The declaration of a set contains an error. Either one of the elements is +% outside the range of the set type, or two of the elements are in fact +% the same. +parser_e_pointer_to_class_expected=03075_E_Ponteiro para objeto esperado +% You specified an illegal type in a \var{new} statement. +% The extended syntax of \var{new} needs an object as a parameter. +parser_e_expr_have_to_be_constructor_call=03076_E_ExpressÆo deve ser chamada ao construtor +% When using the extended syntax of \var{new}, you must specify the constructor +% method of the object you are trying to create. The procedure you specified +% is not a constructor. +parser_e_expr_have_to_be_destructor_call=03077_E_ExpressÆo deve ser chamada ao destruidor +% When using the extended syntax of \var{dispose}, you must specify the +% destructor method of the object you are trying to dispose of. +% The procedure you specified is not a destructor. +parser_e_invalid_record_const=03078_E_Ordem ilegal dos elementos do registro +% When declaring a constant record, you specified the fields in the wrong +% order. +parser_e_false_with_expr=03079_E_Tipo expressÆo deve ser classe ou tipo registro +% A \var{with} statement needs an argument that is of the type \var{record} +% or \var{class}. You are using \var{with} on an expression that is not of +% this type. +parser_e_void_function=03080_E_Procedimentos nÆo podem retornar um valor +% In \fpc, you can specify a return value for a function when using +% the \var{exit} statement. This error occurs when you try to do this with a +% procedure. Procedures cannot return a value. +parser_e_constructors_always_objects=03081_E_Construtores, destruidores e operadores de classe devem ser m‚todos +% You're declaring a procedure as destructor, constructor or class operator, when the +% procedure isn't a class method. +parser_e_operator_not_overloaded=03082_E_Operador nÆo ‚ sobrecarregado +% You're trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_no_such_assignment=03083_E_Imposs¡vel sobrecarregar atribui‡äes para tipos iguais +% You cannot overload assignment for types +% that the compiler considers as equal. +parser_e_overload_impossible=03084_E_Operador sobrecarga imposs¡vel +% The combination of operator, arguments and return type are +% incompatible. +parser_e_no_reraise_possible=03085_E_Re-elevar nÆo ‚ poss¡vel l  +% You are trying to re-raise an exception where it is not allowed. You can only +% re-raise exceptions in an \var{except} block. +parser_e_no_new_or_dispose_for_classes=03086_E_A sintaxe estendida para new ou dispose nÆo ‚ permitida para uma classe +% You cannot generate an instance of a class with the extended syntax of +% \var{new}. The constructor must be used for that. For the same reason, you +% cannot call \var{dispose} to de-allocate an instance of a class, the +% destructor must be used for that. +parser_e_procedure_overloading_is_off=03088_E_Sobrecarga de procimento est  desativada +% When using the \var{-So} switch, procedure overloading is switched off. +% Turbo Pascal does not support function overloading. +parser_e_overload_operator_failed=03089_E_NÆo ‚ poss¡vel sobrecarregar este operador. Operadores relacionados poss¡veis de sobrecarga (se algum) sÆo: $1 +% You are trying to overload an operator which cannot be overloaded. +% The following operators can be overloaded : +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_Operador de compara‡Æo deve retornar um valor booleano +% When overloading the \var{=} operator, the function must return a boolean +% value. +parser_e_only_virtual_methods_abstract=03091_E_Apenas m‚todos virtuais podem ser abstratos +% You are declaring a method as abstract, when it is not declared to be +% virtual. +parser_f_unsupported_feature=03092_F_Uso de caracter¡stica nÆo suportada! +% You're trying to force the compiler into doing something it cannot do yet. +parser_e_mix_of_classes_and_objects=03093_E_A mistura de diferentes esp‚cies de objetos (class, object, interface, etc) nÆo ‚ permitida +% You cannot derive \var{objects}, \var{classes}, \var{cppclasses} and \var{interfaces} intertwined. E.g. +% a class cannot have an object as parent and vice versa. +parser_w_unknown_proc_directive_ignored=03094_W_Diretiva desconhecida de procedimento teve que ser ignorada: "$1" +% The procedure directive you specified is unknown. +parser_e_absolute_only_one_var=03095_E_Absolute s¢ pode estar associada a uma vari vel +% You cannot specify more than one variable before the \var{absolute} directive. +% Thus, the following construct will provide this error: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +parser_e_absolute_only_to_var_or_const=03096_E_Absolute s¢ pode estar associada com uma vari vel ou constante +% The address of an \var{absolute} directive can only point to a variable or +% constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +parser_e_initialized_only_one_var=03097_E_Apenas uma vari vel pode ser inicializada +% You cannot specify more than one variable with a initial value in Delphi mode. +parser_e_abstract_no_definition=03098_E_M‚todos abstratos nÆo devem ter qualquer defini‡Æo (com corpo fun‡Æo) +% Abstract methods can only be declared, you cannot implement them. They +% should be overridden by a descendant class. +parser_e_overloaded_must_be_all_global=03099_E_Esta fun‡Æo sobrecarregada nÆo pode ser local (deve ser exportada) +% You are defining an overloaded function in the implementation part of a unit, +% but there is no corresponding declaration in the interface part of the unit. +parser_w_virtual_without_constructor=03100_W_M‚todos virtuais sÆo usados sem um construtor em "$1" +% If you declare objects or classes that contain virtual methods, you need +% to have a constructor and destructor to initialize them. The compiler +% encountered an object or class with virtual methods that doesn't have +% a constructor/destructor pair. +parser_c_macro_defined=03101_CL_Macro definida: $1 +% When \var{-vc} is used, the compiler tells you when it defines macros. +parser_c_macro_undefined=03102_CL_Macro indefinida: $1 +% When \var{-vc} is used, the compiler tells you when it undefines macros. +parser_c_macro_set_to=03103_CL_Macro $1 ajustada para $2 +% When \var{-vc} is used, the compiler tells you what values macros get. +parser_i_compiling=03104_I_Compilando $1 +% When you turn on information messages (\var{-vi}), the compiler tells you +% what units it is recompiling. +parser_u_parsing_interface=03105_UL_Analisando interface da unidade $1 +% This tells you that the reading of the interface +% of the current unit has started +parser_u_parsing_implementation=03106_UL_Analisando implementa‡Æo de $1 +% This tells you that the code reading of the implementation +% of the current unit, library or program starts +parser_d_compiling_second_time=03107_DL_Compilando $1 uma segunda vez +% When you request debug messages (\var{-vd}) the compiler tells you what +% units it recompiles for the second time. +parser_e_no_property_found_to_override=03109_E_Nenhuma propriedade encontrada para sobrepor +% You want to override a property of a parent class, when there is, in fact, +% no such property in the parent class. +parser_e_only_one_default_property=03110_E_Apenas uma propriedade padrÆo ‚ permitida +% You specified a property as \var{Default}, but the class already has a +% default property, and a class can have only one default property. +parser_e_property_need_paras=03111_E_A propriedade padrÆo deve ser uma propriedade matriz +% Only array properties of classes can be made \var{default} properties. +parser_e_constructor_cannot_be_not_virtual=03112_E_Construtores virtuais sÆo suportados apenas modelo objeto classe +% You cannot have virtual constructors in objects. You can only have them +% in classes. +parser_e_no_default_property_available=03113_E_Nenhuma propriedade padrÆo dispon¡vel +% You are trying to access a default property of a class, but this class (or one of +% its ancestors) doesn't have a default property. +parser_e_cant_have_published=03114_E_A classe nÆo pode ter uma se‡Æo PUBLISHED, use a chave {$M+} +% If you want a \var{published} section in a class definition, you must +% use the \var{\{\$M+\}} switch, which turns on generation of type +% information. +parser_e_forward_declaration_must_be_resolved=03115_E_Declara‡Æo posterior da classe "$1" deve ser resolvida aqui para usar a classe como ancestral +% To be able to use an object as an ancestor object, it must be defined +% first. This error occurs in the following situation: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% where \var{ParentClass} is declared but not defined. +parser_e_no_local_operator=03116_E_Operadores locais nÆo suportados +% You cannot overload locally, i.e. inside procedures or function +% definitions. +parser_e_proc_dir_not_allowed_in_interface=03117_E_Diretiva procedimento "$1" nÆo permitida na se‡Æo interface +% This procedure directive is not allowed in the \var{interface} section of +% a unit. You can only use it in the \var{implementation} section. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_Diretiva procedimento "$1" nÆo permitida na se‡Æo implementa‡Æo +% This procedure directive is not allowed in the \var{implementation} section of +% a unit. You can only use it in the \var{interface} section. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_Diretiva procedimento "$1" nÆo permitida na declara‡Æo procvar +% This procedure directive cannot be part of a procedural or function +% type declaration. +parser_e_function_already_declared_public_forward=03120_E_Fun‡Æo j  declarada como P£blica/Posterior "$1" +% You will get this error if a function is defined as \var{forward} twice. +% Or if it occurs in the \var{interface} section, and again as a \var{forward} +% declaration in the \var{implementation} section. +parser_e_not_external_and_export=03121_E_Imposs¡vel usar ambos EXPORT e EXTERNAL +% These two procedure directives are mutually exclusive. +parser_w_not_supported_for_inline=03123_W_"$1" nÆo suportado ainda dentro procedimento/fun‡Æo em linha +% Inline procedures don't support this declaration. +parser_w_inlining_disabled=03124_W_Procedimentos em linha desabilitados +% Inlining of procedures is disabled. +parser_i_writing_browser_log=03125_I_Gravando hist¢rio Navegador $1 +% When information messages are on, the compiler warns you when it +% writes the browser log (generated with the \var{\{\$Y+ \}} switch). +parser_h_maybe_deref_caret_missing=03126_H_Talvez desreferˆncia de ponteiro esteja faltando +% The compiler thinks that a pointer may need a dereference. +parser_f_assembler_reader_not_supported=03127_F_Leitor assembler selecionado nÆo suportado +% The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not +% supported. The compiler can be compiled with or without support for a +% particular assembler reader. +parser_e_proc_dir_conflict=03128_E_Diretiva procedimento "$1" tem conflitos com outras diretivas +% You specified a procedure directive that conflicts with other directives. +% For instance \var{cdecl} and \var{pascal} are mutually exclusive. +parser_e_call_convention_dont_match_forward=03129_E_Conven‡Æo de chamada nÆo coincide com declara‡Æo posterior +% This error happens when you declare a function or procedure with +% e.g. \var{cdecl;} but omit this directive in the implementation, or vice +% versa. The calling convention is part of the function declaration, and +% must be repeated in the function definition. +parser_e_property_cant_have_a_default_value=03131_E_Propriedade nÆo pode ter um valor padrÆo +% Set properties or indexed properties cannot have a default value. +parser_e_property_default_value_must_const=03132_E_O valor padrÆo de um propriedade deve ser uma constante +% The value of a \var{default} declared property must be known at compile +% time. The value you specified is only known at run time. This happens +% e.g. if you specify a variable name as a default value. +parser_e_cant_publish_that=03133_E_S¡mbolo nÆo pode ser PUBLISHED, pode ser apenas uma classe +% Only class type variables can be in a \var{published} section of a class +% if they are not declared as a property. +parser_e_cant_publish_that_property=03134_E_Este tipo de propriedade nÆo pode ser PUBLISHED +% Properties in a \var{published} section cannot be array properties. +% They must be moved to public sections. Properties in a \var{published} +% section must be an ordinal type, a real type, strings or sets. +parser_e_empty_import_name=03136_E_Um nome importa‡Æo ‚ requerido +% Some targets need a name for the imported procedure or a \var{cdecl} specifier. +parser_e_division_by_zero=03138_E_DivisÆo por zero +% A division by zero was encounted. +parser_e_invalid_float_operation=03139_E_Opera‡Æo ponto flutuante inv lida +% An operation on two real type values produced an overflow or a division +% by zero. +parser_e_array_lower_less_than_upper_bound=03140_E_Limite superior da faixa ‚ menor que o limite inferior +% The upper bound of an array declaration is less than the lower bound and this +% is not possible. +parser_w_string_too_long=03141_W_'String' "$1" ‚ maior que "$2" +% The size of the constant string is larger than the size you specified in +% string type definition. +parser_e_string_larger_array=03142_E_Comprimento 'String' ‚ maior que o comprimento da matriz de caractere +% The size of the constant string is larger than the size you specified in +% the \var{Array[x..y] of char} definition. +parser_e_ill_msg_expr=03143_E_ExpressÆo ilegal ap¢s diretiva mensagem +% \fpc supports only integer or string values as message constants. +parser_e_ill_msg_param=03144_E_Manipuladores mensagens podem ter apenas uma chamada por parƒmetro referˆncia +% A method declared with the \var{message} directive as message handler +% can take only one parameter which must be declared as call by reference. +% Parameters are declared as call by reference using the \var{var}-directive. +parser_e_duplicate_message_label=03145_E_R¢tulo mensagem duplicado: "$1" +% A label for a message is used twice in one object/class. +parser_e_self_in_non_message_handler=03146_E_Self pode ser um parƒmetro expl¡cito apenas em m‚todos que sÆo manipuladores de mensagens +% The \var{Self} parameter can only be passed explicitly to a method which +% is declared as message handler. +parser_e_threadvars_only_sg=03147_E_Threadvars podem ser apenas est ticas ou globais +% Threadvars must be static or global; you can't declare a thread +% local to a procedure. Local variables are always local to a thread, +% because every thread has its own stack and local variables +% are stored on the stack. +parser_f_direct_assembler_not_allowed=03148_F_Assembler direto nÆo suportado para formato de sa¡da bin rio +% You can't use direct assembler when using a binary writer. Choose an +% other output format or use another assembler reader. +parser_w_no_objpas_use_mode=03149_W_NÆo carregue a unidade OBJPAS manualmente, use \{\$mode objfpc\} ou \{\$mode delphi\} +% You are trying to load the \file{ObjPas} unit manually from a \var{uses} clause. +% This is not a good idea. Use the \var{\{\$MODE OBJFPC\}} or +% \var{\{\$mode delphi\}} directives which load the unit automatically. +parser_e_no_object_override=03150_E_OVERRIDE nÆo pode ser usado em objetos +% \var{Override} is not supported for objects, use \var{virtual} instead to override +% a method of a parent object. +parser_e_cant_use_inittable_here=03151_E_Tipos de dados que requerem inicializa‡Æo/finaliza‡Æo nÆo podem ser usados em registros variant +% Some data types (e.g. \var{ansistring}) need initialization/finalization +% code which is implicitly generated by the compiler. Such data types +% can't be used in the variant part of a record. +parser_e_resourcestring_only_sg=03152_E_Recursos 'String' podem ser apenas est ticos ou globais +% Resourcestring cannot be declared local, only global or using the static +% directive. +parser_e_exit_with_argument_not__possible=03153_E_EXIT com argumentos nÆo pode ser usado aqui +% An exit statement with an argument for the return value can't be used here. This +% can happen for example in \var{try..except} or \var{try..finally} blocks. +parser_e_stored_property_must_be_boolean=03154_E_O tipo do s¡mbolo de armazenamento deve ser booleano +% If you specify a storage symbol in a property declaration, it must be a +% boolean type. +parser_e_ill_property_storage_sym=03155_E_Este s¡mbolo nÆo ‚ permitido como s¡mbolo de armazenamento +% You can't use this type of symbol as storage specifier in property +% declaration. You can use only methods with the result type boolean, +% boolean class fields or boolean constants. +parser_e_only_publishable_classes_can_be_published=03156_E_Apenas classes que sÆo compiladas no modo $M+ podem ser PUBLISHED +% A class-typed field in the published section of a class can only be a class which was +% compiled in \var{\{\$M+\}} or which is derived from such a class. Normally +% such a class should be derived from \var{TPersistent}. +parser_e_proc_directive_expected=03157_E_Diretiva procedimento esperada +% This error is triggered when you have a \var{\{\$Calling\}} directive without +% a calling convention specified. +% It also happens when declaring a procedure in a const block and you +% used a ; after a procedure declaration which must be followed by a +% procedure directive. +% Correct declarations are: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_O valor de um ¡ndice de propriedade deve ser do tipo ordinal +% The value you use to index a property must be of an ordinal type, for +% example an integer or enumerated type. +parser_e_procname_to_short_for_export=03159_E_Nome procedimento muito curto para ser exportado +% The length of the procedure/function name must be at least 2 characters +% long. This is because of a bug in dlltool which doesn't parse the .def +% file correctly with a name of length 1. +parser_e_dlltool_unit_var_problem=03160_E_Nenhuma entrada DEFFILE pode ser gerada para vars. globais unidade +parser_e_dlltool_unit_var_problem2=03161_E_Compile sem a op‡Æo -WD +% You need to compile this file without the -WD switch on the +% command line. +parser_f_need_objfpc_or_delphi_mode=03162_F_Vocˆ precisa do modo ObjFpc (-S2) ou Delphi (-Sd) para compilar este m¢dulo +% You need to use \var{\{\$MODE OBJFPC\}} or \var{\{\$MODE DELPHI\}} to compile this file. +% Or use the corresponding command line switch, either \var{-Mobjfpc} or \var{-MDelphi.} +parser_e_no_export_with_index_for_target=03163_E_Imposs¡vel exportar com ¡ndice sob $1 +% Exporting of functions or procedures with a specified index is not +% supported on this target. +parser_e_no_export_of_variables_for_target=03164_E_Exporta‡Æo de vari veis nÆo ‚ suportada sob $1 +% Exporting of variables is not supported on this target. +parser_e_improper_guid_syntax=03165_E_Sintaxe GUID impr¢pria +% The GUID indication does not have the proper syntax. It should be of the form +% \begin{verbatim} +% {XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX} +% \end{verbatim} +% Where each \var{X} represents a hexadecimal digit. +parser_w_interface_mapping_notfound=03168_W_Procedimento chamado "$1" que fosse adequado … implementa‡Æo de $2.$3 nÆo encontrado +% The compiler cannot find a suitable procedure which implements the given method of an interface. +% A procedure with the same name is found, but the arguments do not match. +parser_e_interface_id_expected=03169_E_Identificador interface esperado +% This happens when the compiler scans a \var{class} declaration that contains +% \var{interface} function name mapping code like this: +% \begin{verbatim} +% type +% TMyObject = class(TObject, IDispatch) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% and the \var{interface} before the dot is not listed in the inheritance list. +parser_e_type_cant_be_used_in_array_index=03170_E_Tipo "$1" nÆo pode ser usado como tipo ¡ndice matriz +% Types like \var{qword} or \var{int64} aren't allowed as array index type. +parser_e_no_con_des_in_interfaces=03171_E_Construtor e destruidor nÆo permitidos em interfaces +% Constructor and destructor declarations aren't allowed in interfaces. +% In the most cases method \var{QueryInterface} of \var{IUnknown} can +% be used to create a new interface. +parser_e_no_access_specifier_in_interfaces=03172_E_Especificadores de acesso nÆo podem ser usados em INTERFACEs e OBJCPROTOCOLs +% The access specifiers \var{public}, \var{private}, \var{protected} and +% \var{published} can't be used in interfaces, Objective-C protocols and categories because all methods +% of an interface/protocol/category must be public. +parser_e_no_vars_in_interfaces=03173_E_Uma interface, auxiliar ou protocolo Objective-C ou categoria nÆo pode conter campos +% Declarations of fields are not allowed in interfaces, helpers and Objective-C protocols and categories. +% An interface/protocol/category can contain only methods and properties with method read/write specifiers. +parser_e_no_local_proc_external=03174_E_Imposs¡ve declarar procedimento local como EXTERNAL +% Declaring local procedures as external is not possible. Local procedures +% get hidden parameters that will make the chance of errors very high. +parser_w_skipped_fields_before=03175_W_Alguns campos que vˆm antes de "$1" nÆo foram inicializados +% In Delphi mode, not all fields of a typed constant record have to be +% initialized, but the compiler warns you when it detects such situations. +parser_e_skipped_fields_before=03176_E_Alguns campos que vˆm antes de "$1" nÆo foram inicializados +% In all syntax modes but Delphi mode, you can't leave some fields uninitialized +% in the middle of a typed constant record. +parser_w_skipped_fields_after=03177_W_Alguns campos que vˆm depois de "$1" nÆo foram inicializados +% You can leave some fields at the end of a type constant record uninitialized +% (The compiler will initialize them to zero automatically). This may be the cause +% of subtle problems. +parser_e_varargs_need_cdecl_and_external=03178_E_Diretiva VarArgs (ou '...' em MacPas) sem CDecl/CPPDecl/MWPascal e External +% The varargs directive (or the ``...'' varargs parameter in MacPas mode) can only be +% used with procedures or functions that are declared with \var{external} and one of +% \var{cdecl}, \var{cppdecl} and \var{mwpascal}. This functionality +% is only supported to provide a compatible interface to C functions like printf. +parser_e_self_call_by_value=03179_E_Self deve ser um parƒmetro normal (chamada-por-valor) +% You can't declare \var{Self} as a const or var parameter, it must always be +% a call-by-value parameter. +parser_e_interface_has_no_guid=03180_E_Interface "$1" nÆo tem identifica‡Æo de interface +% When you want to assign an interface to a constant, then the interface +% must have a GUID value set. +parser_e_illegal_field_or_method=03181_E_Campo classe ou identificador m‚todo "$1" desconhecido +% Properties must refer to a field or method in the same class. +parser_w_proc_overriding_calling=03182_W_Conven‡Æo chamada sobreposi‡Æo "$1" com "$2" +% There are two directives in the procedure declaration that specify a calling +% convention. Only the last directive will be used. +parser_e_no_procvarobj_const=03183_E_Constantes tipadas do tipo "procedimento de objeto" podem ser apenas inicializadas com NIL +% You cannot assign the address of a method to a typed constant which has a +% 'procedure of object' type, because such a constant requires two addresses: +% that of the method (which is known at compile time) and that of the object or +% class instance it operates on (which cannot be known at compile time). +parser_e_default_value_only_one_para=03184_E_Valor padrÆo pode ser atribu¡do apenas … um parƒmetro +% It is not possible to specify a default value for several parameters at once. +% The following is invalid: +% \begin{verbatim} +% Procedure MyProcedure (A,B : Integer = 0); +% \end{verbatim} +% Instead, this should be declared as +% \begin{verbatim} +% Procedure MyProcedure (A : Integer = 0; B : Integer = 0); +% \end{verbatim} +parser_e_default_value_expected_for_para=03185_E_Parƒmetro padrÆo requerido para "$1" +% The specified parameter requires a default value. +parser_w_unsupported_feature=03186_W_Uso de caracter¡stica nÆo suportada! +% You're trying to force the compiler into doing something it cannot do yet. +parser_h_c_arrays_are_references=03187_H_Matrizes C sÆo passadas por referˆncia +% Any array passed to a C function is passed +% by a pointer (i.e. by reference). +parser_e_C_array_of_const_must_be_last=03188_E_Matrizes de constantes C devem ser o £ltimo argumento +% You cannot add any other argument after an \var{array of const} for +% \var{cdecl} functions, as the size pushed on stack for this argument is +% not known. +parser_h_type_redef=03189_H_Redefini‡Æo do tipo "$1" +% This is an indicator that a previously declared type is +% being redefined as something else. This may, or may not +% be, a potential source of errors. +parser_w_cdecl_has_no_high=03190_W_Fun‡äes declaradas com cdecl nÆo tem um parƒmetro impl¡cito extra +% Functions declared with the \var{cdecl} modifier do not pass an extra implicit parameter. +parser_w_cdecl_no_openstring=03191_W_Fun‡äes declaradas com cdecl nÆo suportam 'String' aberta +% Openstring is not supported for functions that have the \var{cdecl} modifier. +parser_e_initialized_not_for_threadvar=03192_E_Imposs¡vel inicializar vari veis declaradas como threadvar +% Variables declared as threadvar cannot be initialized with a default value. +% The variables will always be filled with zero at the start of a new thread. +parser_e_msg_only_for_classes=03193_E_Diretiva mensagem ‚ permitida apenas em Classes +% The message directive is only supported for Class types. +parser_e_procedure_or_function_expected=03194_E_Procedimento ou Fun‡Æo esperados +% A class method can only be specified for procedures and functions. +parser_e_illegal_calling_convention=03195_W_Diretiva conven‡Æo de chamada ignorada: "$1" +% Some calling conventions are supported only by certain CPUs. I.e. most non-i386 ports support +% only the standard ABI calling convention of the CPU. +parser_e_no_object_reintroduce=03196_E_REINTRODUCE nÆo pode ser usado em objetos +% \var{reintroduce} is not supported for objects, Objective-C classes and Objective-C protocols. +parser_e_paraloc_only_one_para=03197_E_Cada argumento deve ter sua pr¢pria localiza‡Æo +% If locations for arguments are specified explicitly as it is required by +% some syscall conventions, each argument must have its own location. Things +% like +% \begin{verbatim} +% procedure p(i,j : longint 'r1'); +% \end{verbatim} +% aren't allowed. +parser_e_paraloc_all_paras=03198_E_Cada argumento deve ter uma localiza‡Æo expl¡cita +% If one argument has an explicit argument location, all arguments of a procedure +% must have one. +parser_e_illegal_explicit_paraloc=03199_E_Localiza‡Æo argumento desconhecida +% The location specified for an argument isn't recognized by the compiler. +parser_e_32bitint_or_pointer_variable_expected=03200_E_Inteiro 32-Bit ou vari vel ponteiro esperados +% The libbase for MorphOS/AmigaOS can be given only as \var{longint}, \var{dword} or any pointer variable. +parser_e_goto_outside_proc=03201_E_Declara‡Æo Goto nÆo permitida entre procedimentos diferentes +% It isn't allowed to use \var{goto} statements referencing labels outside the +% current procedure. The following example shows the problem: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1; +% +% procedure p2; +% begin +% goto l1; // This goto ISN'T allowed +% end; +% +% begin +% p2 +% l1: +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_Procedimento muito complexo, ele requer muitos registradores +% Your procedure body is too long for the compiler. You should split the +% procedure into multiple smaller procedures. +parser_e_illegal_expression=03203_E_ExpressÆo ilegal +% This can occur under many circumstances. Usually when trying to evaluate +% constant expressions. +parser_e_invalid_integer=03204_E_ExpressÆo inteira inv lida +% You made an expression which isn't an integer, and the compiler expects the +% result to be an integer. +parser_e_invalid_qualifier=03205_E_Qualifiador ilegal +% One of the following is happening : +% \begin{itemize} +% \item You're trying to access a field of a variable that is not a record. +% \item You're indexing a variable that is not an array. +% \item You're dereferencing a variable that is not a pointer. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_Limite de faixa alta < limite de faixa baixa +% You are declaring a subrange, and the high limit is less than the low limit of +% the range. +parser_e_macpas_exit_wrong_param=03207_E_Parƒmetro de sa¡da deve ser o nome do procedimento em que ele ‚ usado +% Non local exit is not allowed. This error occurs only in mode MacPas. +parser_e_illegal_assignment_to_count_var=03208_E_Atribui‡Æo ilegal para a vari vel for-loop "$1" +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. You also cannot assign values to +% loop variables inside the loop (Except in Delphi and TP modes). Use a while or +% repeat loop instead if you need to do something like that, since those +% constructs were built for that. +parser_e_no_local_var_external=03209_E_Imposs¡vel declarar vari vel local como EXTERNAL +% Declaring local variables as external is not allowed. Only global variables can reference +% external variables. +parser_e_proc_already_external=03210_E_Procedimento j  foi declarado como EXTERNAL +% The procedure is already declared with the EXTERNAL directive in an interface or +% forward declaration. +parser_w_implicit_uses_of_variants_unit=03211_W_Uso impl¡cito da unidade Variants +% The Variant type is used in the unit without any used unit using the Variants unit. The +% compiler has implicitly added the Variants unit to the uses list. To remove this warning +% the Variants unit needs to be added to the uses statement. +parser_e_no_static_method_in_interfaces=03212_E_Classe e m‚todos est ticos nÆo podem ser usados em INTERFACES +% The specifier \var{class} and directive \var{static} can't be used in interfaces +% because all methods of an interface must be public. +parser_e_arithmetic_operation_overflow=03213_E_Transbordamento em opera‡Æo aritim‚tica +% An operation on two integer values produced an overflow. +parser_e_protected_or_private_expected=03214_E_Protected ou private esperados +% \var{strict} can be only used together with \var{protected} or \var{private}. +parser_e_illegal_slice=03215_E_SLICE nÆo pode ser usado fora da lista de parƒmetros +% \var{slice} can be used only for arguments accepting an open array parameter. +parser_e_dispinterface_cant_have_parent=03216_E_Uma DISPINTERFACE nÆo pode ter uma classe pai +% A DISPINTERFACE is a special type of interface which can't have a parent class. Dispinterface always derive from IDispatch type. +parser_e_dispinterface_needs_a_guid=03217_E_Uma DISPINTERFACE necessita de um GUID +% A DISPINTERFACE always needs an interface identification (a GUID). +parser_w_overridden_methods_not_same_ret=03218_W_M‚todos susbtitu¡dos devem ter um tipo de retorno relacionados. Este c¢digo pode travar, ele depende de uma falha do analizador Delphi ("$2" ‚ sobreposto por "$1" que possue outro tipo de retorno) +% If you declare overridden methods in a class definition, they must +% have the same return type. Some versions of Delphi allow you to change the +% return type of interface methods, and even to change procedures into +% functions, but the resulting code may crash depending on the types used +% and the way the methods are called. +parser_e_dispid_must_be_ord_const=03219_E_IDs despacho devem ser constantes ordinais +% The \var{dispid} keyword must be followed by an ordinal constant (the dispid index). +parser_e_array_range_out_of_bounds=03220_E_A faixa da matriz ‚ demasiada grande +% Regardless of the size taken up by its elements, an array cannot have more +% than high(ptrint) elements. Additionally, the range type must be a subrange +% of ptrint. +parser_e_packed_element_no_var_addr=03221_E_O endere‡o nÆo pode ser obtido de elementos de matriz de bits compactados ou campos de registro +% If you declare an array or record as \var{packed} in Mac Pascal mode +% (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will +% be packed at the bit level. This means it becomes impossible to take addresses +% of individual array elements or record fields. The only exception to this rule +% is in the case of packed arrays elements whose packed size is a multple of 8 bits. +parser_e_packed_dynamic_open_array=03222_E_Matrizes dinƒmicas nÆo podem ser compactadas +% Only regular (and possibly in the future also open) arrays can be packed. +parser_e_packed_element_no_loop=03223_E_Elementos de matrizes de bits compactados ou campos de registro nÆo podem ser usadas como vari veis de la‡os +% If you declare an array or record as \var{packed} in Mac Pascal mode +% (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will +% be packed at the bit level. For performance reasons, they cannot be +% used as loop variables. +parser_e_type_var_const_only_in_records_and_classes=03224_E_VAR, TYPE e CONST sÆo permitidos apenas em registros, objetos e classes +% The usage of VAR, TYPE and CONST to declare new types inside an object is allowed only inside +% records, objects and classes. +parser_e_cant_create_generics_of_this_type=03225_E_Este tipo nÆo pode ser um gen‚rico +% Only Classes, Objects, Interfaces and Records are allowed to be used as generic. +parser_w_no_lineinfo_use_switch=03226_W_NÆo caregue a unidade LINEINFO manualmente, Em vez disso utilize a chave de compilador -gl +% Do not use the \file{lineinfo} unit directly, Use the \var{-gl} switch which +% automatically adds the correct unit for reading the selected type of debugging +% information. The unit that needs to be used depends on the type of +% debug information used when compiling the binary. +parser_e_no_funcret_specified=03227_E_Nenhum tipo de retorno de fun‡Æo especificado para a fun‡Æo "$1" +% The first time you declare a function you have to declare it completely, +% including all parameters and the result type. +parser_e_special_onlygenerics=03228_E_Especializa‡Æo ‚ suportado apenas por tipos gen‚ricos +% Types which are not generics can't be specialized. +parser_e_no_generics_as_params=03229_E_Gen‚ricos nÆo podem ser usados como parƒmetros quando especializando gen‚ricos +% When specializing a generic, only non-generic types can be used as parameters. +parser_e_type_object_constants=03230_E_Constantes de objetos contendo uma VMT nÆo sÆo permitidas +% If an object requires a VMT either because it contains a constructor or virtual methods, +% it's not allowed to create constants of it. In TP and Delphi mode this is allowed +% for compatibility reasons. +parser_e_label_outside_proc=03231_E_Obter o endere‡o de r¢tulos definidos fora do escopo atual nÆo ‚ permitido +% It isn't allowed to take the address of labels outside the +% current procedure. +parser_e_initialized_not_for_external=03233_E_Imposs¡vel inicializar vari veis declaradas como externas +% Variables declared as external cannot be initialized with a default value. +parser_e_illegal_function_result=03234_E_Tipo de retorno de fun‡Æo ilegal +% Some types like file types cannot be used as function result. +parser_e_no_common_type=03235_E_Nenhum tipo comum entre "$1" e "$2" +% To perform an operation on integers, the compiler converts both operands +% to their common type, which appears to be an invalid type. To determine the +% common type of the operands, the compiler takes the minimum of the minimal values +% of both types, and the maximum of the maximal values of both types. The common +% type is then minimum..maximum. +parser_e_no_generics_as_types=03236_E_Gen‚ricos sem especializa‡Æo nÆo podem ser usadas como um tipo para uma vari vel +% Generics must be always specialized before being used as variable type. +parser_w_register_list_ignored=03237_W_Lista registros ‚ ignorada para rotinas assembler puras +% When using pure assembler routines, the list with modified registers is ignored. +parser_e_implements_must_be_class_or_interface=03238_E_Propriedade 'Implements' deve ter tipo classe ou interface +% A property which implements an interface must be of type class or interface. +parser_e_implements_must_have_correct_type=03239_E_Propriedade 'Implements' deve implementar interface de tipo correto, encontrado "$1" esperado "$2" +% A property which implements an interface actually implements a different interface. +parser_e_implements_must_read_specifier=03240_E_Propriedade 'Implements' deve ter especificador de leitura +% A property which implements an interface must have at least a read specifier. +parser_e_implements_must_not_have_write_specifier=03241_E_Propriedade 'Implements' nÆo deve ter especificador de escrita +% A property which implements an interface may not have a write specifier. +parser_e_implements_must_not_have_stored_specifier=03242_E_Propriedade 'Implements' nÆo deve ter especificador de armazenagem +% A property which implements an interface may not have a stored specifier. +parser_e_implements_uses_non_implemented_interface=03243_E_Propriedade 'Implements' usada em interface nÆo implementada: "$1" +% The interface which is implemented by a property is not an interface implemented by the class. +parser_e_unsupported_real=03244_E_Ponto flutuante nÆo suportado para este alvo +% The compiler parsed a floating point expression, but it is not supported. +parser_e_class_doesnt_implement_interface=03245_E_Classe "$1" nÆo implementa interface "$2" +% The delegated interface is not implemented by the class given in the implements clause. +parser_e_class_implements_must_be_interface=03246_E_Tipo usado por implementa‡Æo deve ser uma interface +% The \var{implements} keyword must be followed by an interface type. +parser_e_cant_export_var_different_name=03247_E_Vari veis nÆo podem ser exportadas com um nome diferente neste alvo, adicione o nome na declara‡Æo usando a diretiva "export" (nome vari vel: $1, nome exporta‡Æo declarado: $2) +% On most targets it is not possible to change the name under which a variable +% is exported inside the \var{exports} statement of a library. +% In that case, you have to specify the export name at the point where the +% variable is declared, using the \var{export} and \var{alias} directives. +parser_e_weak_external_not_supported=03248_E_S¡mbolos externos fracos nÆo sÆo suportados para o atual alvo +% A "weak external" symbol is a symbol which may or may not exist at (either static +% or dynamic) link time. This concept may not be available (or implemented yet) +% on the current cpu/OS target. +parser_e_forward_mismatch=03249_E_Defini‡Æo posterior tipo incompat¡vel +% Classes and interfaces being defined forward must have the same type +% when being implemented. A forward interface cannot be changed into a class. +parser_n_ignore_lower_visibility=03250_N_M‚todo virtual "$1" tem baixa visibilidade ($2) que a classe pai $3 ($4) +% The virtual method overrides an method that is declared with a higher visibility. This might give +% unexpected results. In case the new visibility is private than it might be that a call to inherited in a +% new child class will call the higher visible method in a parent class and ignores the private method. +parser_e_field_not_allowed_here=03251_E_Campos nÆo podem aparecer depois dem um m‚todo ou defini‡Æo propriedade, inicie uma nova se‡Æo de visibilidade primeiro +% Once a method or property has been defined in a class or object, you cannot define any fields afterwards +% without starting a new visibility section (such as \var{public}, \var{private}, etc.). The reason is +% that otherwise the source code can appear ambiguous to the compiler, since it is possible to use modifiers +% such as \var{default} and \var{register} also as field names. +parser_e_no_local_para_def=03252_E_Parƒmetros ou tipos resultado nÆo podem conter defini‡äes locais de tipo. Use uma defini‡Æo de tipo separada em um bloco de tipos +% In Pascal, types are not considered to be identical simply because they are semantically equivalent. +% Two variables or parameters are only considered to be of the same type if they refer to the +% same type definition. +% As a result, it is not allowed to define new types inside parameter lists, because then it is impossible to +% refer to the same type definition in the procedure headers of the interface and implementation of a unit +% (both procedure headers would define a separate type). Keep in mind that expressions such as +% ``file of byte'' or ``string[50]'' also define a new type. +parser_e_abstract_and_sealed_conflict=03253_E_Conflito ABSTRACT e SEALED +% ABSTRACT and SEALED cannot be used together in one declaration +parser_e_sealed_descendant=03254_E_Imposs¡vel criar um descendente da classe selada "$1" +% Sealed means that class cannot be derived by another class. +parser_e_sealed_class_cannot_have_abstract_methods=03255_E_Classe selada nÆo pode ter um m‚todo abstrato +% Sealed means that class cannot be derived. Therefore no one class is able to override an abstract method in a sealed class. +parser_e_only_virtual_methods_final=03256_E_Apenas m‚todos virtuais podem ser finais +% You are declaring a method as final, when it is not declared to be +% virtual. +parser_e_final_can_no_be_overridden=03257_E_M‚todo final nÆo pode ser sobreposto: "$1" +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_multiple_messages=03258_E_Apenas uma mensagem pode ser usada por m‚todo. +% It is not possible to associate multiple messages with a single method. +parser_e_invalid_enumerator_identifier=03259_E_Identificador enumerador inv lido: "$1" +% Only "MoveNext" and "Current" enumerator identifiers are supported. +parser_e_enumerator_identifier_required=03260_E_Identificador enumerador requerido +% "MoveNext" or "Current" identifier must follow the \var{enumerator} modifier. +parser_e_enumerator_movenext_is_not_valid=03261_E_M‚todo enumerador 'MoveNext' padrÆo inv lido. M‚todo deve ser uma fun‡Æo com tipo de retorno booleano e sem argumentos requeridos. +% "MoveNext" enumerator pattern method must be a function with Boolean return type and no required arguments +parser_e_enumerator_current_is_not_valid=03262_E_Propriedade enumerador 'Current' padrÆo inv lido. Propriedade deve ter um 'getter'. +% "Current" enumerator pattern property must have a getter +parser_e_only_one_enumerator_movenext=03263_E_Apenas um m‚todo enumerador 'MoveNext' ‚ permitido por classe/objeto +% Class or Object can have only one enumerator MoveNext declaration. +parser_e_only_one_enumerator_current=03264_E_Apenas uma propriedade enumerador 'Current' ‚ permitida por classe/objeto +% Class or Object can have only one enumerator Current declaration. +parser_e_for_in_loop_cannot_be_used_for_the_type=03265_E_La‡o 'for in' nÆo pode ser usado para o tipo "$1" +% For in loop can be used not for all types. For example it cannot be used for the enumerations with jumps. +parser_e_objc_requires_msgstr=03266_E_Mensagens Objective-C requerem que seu nome seletor Objective-C seja especificado usando a diretiva "message". +% Objective-C messages require their Objective-C name (selector name) to be specified using the \var{message `someName:'} procedure directive. +% While bindings to other languages automatically generate such names based on the identifier you use (by replacing +% all underscores with colons), this is unsafe since nothing prevents an Objective-C method name to contain actual +% colons. +parser_e_objc_no_constructor_destructor=03267_E_Objective-C nÆo tem construtores nem destruidores formais. Use as mensagens 'alloc', 'initXXX' e 'dealloc'. +% The Objective-C language does not have any constructors or destructors. While there are some messages with a similar +% purpose (such as \var{init} and \var{dealloc}), these cannot be identified using automatic parsers and do not +% guarantee anything like Pascal constructors/destructors (e.g., you have to take care of only calling ``designated'' +% inherited ``constructors''). For these reasons, we have opted to follow the standard Objective-C patterns for +% instance creation/destruction. +parser_e_message_string_too_long=03268_E_Nome mensagem ‚ muito longo (max. 255 caracteres) +% Due to compiler implementation reasons, message names are currently limited to 255 characters. +parser_e_objc_message_name_too_long=03269_E_Nome s¡mbolo mensagem Objective-C para "$1" ‚ muito longo +% Due to compiler implementation reasons, mangled message names (i.e., the symbol names used in the assembler +% code) are currently limited to 255 characters. +parser_h_no_objc_parent=03270_H_Definindo uma nova classe raiz Objective-C. Para derivar de outra classe raiz (ex., NSObject), especifique-a como pai da classe +% If no parent class is specified for an Object Pascal class, then it automatically derives from TObject. +% Objective-C classes however do not automatically derive from NSObject, because one can have multiple +% root classes in Objective-C. For example, in the Cocoa framework both NSObject and NSProxy are root classes. +% Therefore, you have to explicitly define a parent class (such as NSObject) if you want to derive your +% Objective-C class from it. +parser_e_no_objc_published=03271_E_Classes Objective-C nÆo podem ter se‡äes PUBLISHED +% In Object Pascal, ``published'' determines whether or not RTTI is generated. Since the Objective-C runtime always needs +% RTTI for everything, this specified does not make sense for Objective-C classes. +parser_f_need_objc=03272_F_Este m¢dulo requer que seja especificado uma chave de modo Objective-C para ser compilado +% This error indicates the use of Objective-C language features without an Objective-C mode switch +% active. Enable one via the -M command line switch, or the {\$modeswitch x} directive. +parser_e_must_use_override_objc=03273_E_M‚todos herdados podem apenas ser sobrepostos em Objective-C, adicione "OVERRIDE" (m‚todo herdado definido em $1) +parser_h_should_use_override_objc=03274_H_M‚todos herdados podem apenas ser sobrepostos em Objective-C, adicione "OVERRIDE" (m‚todo herdado definido em $1). +% It is not possible to \var{reintroduce} methods in Objective-C like in Object Pascal. Methods with the same +% name always map to the same virtual method entry. In order to make this clear in the source code, +% the compiler always requires the \var{override} directive to be specified when implementing overriding +% Objective-C methods in Pascal. If the implementation is external, this rule is relaxed because Objective-C +% does not have any \var{override}-style keyword (since it's the default and only behaviour in that language), +% which makes it hard for automated header conversion tools to include it everywhere. +% The type in which the inherited method is defined is explicitly mentioned, because this may either +% be an objcclass or an objccategory. +parser_e_objc_message_name_changed=03275_E_Nome mensagem "$1" na classe herdada ‚ diferente do nome mensagem "$2" na classe atual. +% An overriding Objective-C method cannot have a different message name than an inherited method. The reason +% is that these message names uniquely define the message to the Objective-C runtime, which means that +% giving them a different message name breaks the ``override'' semantics. +parser_e_no_objc_unique=03276_E_Ainda nÆo ‚ poss¡vel fazer c¢pias £nicas de tipos Objective-C +% Duplicating an Objective-C type using \var{type x = type y;} is not yet supported. You may be able to +% obtain the desired effect using \var{type x = objcclass(y) end;} instead. +parser_e_no_category_as_types=03277_E_Categorias Objective-C e classes auxiliares Object Pascal nÆo podem ser usadas como tipos +% It is not possible to declare a variable as an instance of an Objective-C +% category or an Object Pascal class helper. A category/class helper adds +% methods to the scope of an existing class, but does not define a type by +% itself. An exception of this rule is when inheriting an Object Pascal class +% helper from another class helper. +parser_e_no_category_override=03278_E_Categorias nÆo sobrepäem, mas substituem m‚todos. Use "REINTRODUCE". +parser_e_must_use_reintroduce_objc=03279_E_M‚todos substitu¡dos podem apenas ser reintroduzidos em Objective-C, adicione "REINTRODUCE" (m‚todo substitu¡do definido em $1). +parser_h_should_use_reintroduce_objc=03280_H_M‚todos substitu¡dos podem apenas ser reintroduzidos em Objective-C, adicione "REINTRODUCE" (m‚todo substitu¡do definido em $1). +% A category replaces an existing method in an Objective-C class, rather than that it overrides it. +% Calling an inherited method from an category method will call that method in +% the extended class' parent, not in the extended class itself. The +% replaced method in the original class is basically lost, and can no longer be +% called or referred to. This behaviour corresponds somewhat more closely to +% \var{reintroduce} than to \var{override} (although in case of \var{reintroduce} +% in Object Pascal, hidden methods are still reachable via inherited). +% The type in which the inherited method is defined is explicitly mentioned, because this may either +% be an objcclass or an objccategory. +parser_e_implements_getter_not_default_cc=03281_E_'Getter' para implementa‡Æo interface deve usar a conven‡Æo de chamada padrÆo do alvo. +% Interface getters are called via a helper in the run time library, and hence +% have to use the default calling convention for the target (\var{register} on +% i386 and x86\_64, \var{stdcall} on other architectures). +parser_e_no_refcounted_typed_file=03282_E_Arquivos tipados nÆo podem conter tipos referˆncia-contados. +% The data in a typed file cannot be of a reference counted type (such as +% \var{ansistring} or a record containing a field that is reference counted). +parser_e_operator_not_overloaded_2=03283_E_Operador nÆo est  sobrecarregado: $2 "$1" +% You are trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_operator_not_overloaded_3=03284_E_Operador nÆo est  sobrecarregado: "$1" $2 "$3" +% You are trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_more_array_elements_expected=03285_E_Esperados outros $1 elementos matriz +% When declaring a typed constant array, you provided to few elements to initialize the array +parser_e_string_const_too_long=03286_E_Constante 'String' muito longa, enquanto 'ansistrings' estÆo desabilitadas +% Only when a piece of code is compiled with ansistrings enabled (\var{\{\$H+\}}), string constants +% longer than 255 characters are allowed. +parser_e_invalid_univ_para=03287_E_Tipo nÆo pode ser usado como parƒmetro 'univ' porque seu tamanho ‚ desconhecido em tempo compila‡Æo: "$1" +% \var{univ} parameters are compatible with all values of the same size, but this +% cannot be checked in case a parameter's size is unknown at compile time. +parser_e_only_one_class_constructor_allowed=03288_E_Apenas um construtor de classe pode ser definido na classe: "$1" +% You are trying to declare more than one class constructor but only one class constructor can be declared. +parser_e_only_one_class_destructor_allowed=03289_E_Apenas um destruidor de classe pode ser definido na classe: "$1" +% You are trying to declare more than one class destructor but only one class destructor can be declared. +parser_e_no_paras_for_class_constructor=03290_E_Construtores de classe nÆo podem ter parƒmetros +% You are declaring a class constructor with a parameter list. Class constructor methods +% cannot have parameters. +parser_e_no_paras_for_class_destructor=03291_E_Destruidores de classe nÆo podem ter parƒmetros +% You are declaring a class destructor with a parameter list. Class destructor methods +% cannot have parameters. +parser_f_modeswitch_objc_required=03292_F_Esta constru‡Æo requer que chave de modo \{\$modeswitch objectivec1\} esteja ativa +% Objective-Pascal constructs are not supported when \{\$modeswitch ObjectiveC1\} +% is not active. +parser_e_widestring_to_ansi_compile_time=03293_E_Constantes caracteres/unicode nÆo podem ser convertidas em "ansi/shortstring" em tempo de compila‡Æo +% It is not possible to use unicodechar and unicodestring constants in +% constant expressions that have to be converted into an ansistring or shortstring +% at compile time, for example inside typed constants. The reason is that the +% compiler cannot know what the actual ansi encoding will be at run time. +parser_e_objc_enumerator_2_0=03294_E_La‡os "For-in Objective-Pascal" requerem que a chave \{\$modeswitch ObjectiveC2\} esteja ativa +% Objective-C ``fast enumeration'' support was added in Objective-C 2.0, and +% hence the appropriate modeswitch has to be activated to expose this feature. +% Note that Objective-C 2.0 programs require Mac OS X 10.5 or later. +parser_e_objc_missing_enumeration_defs=03295_E_O compilador nÆo encontrou os tipos "NSFastEnumerationProtocol" ou "NSFastEnumerationState" na unidade "CocoaAll" +% Objective-C for-in loops (fast enumeration) require that the compiler can +% find a unit called CocoaAll that contains definitions for the +% NSFastEnumerationProtocol and NSFastEnumerationState types. If you get this +% error, most likely the compiler is finding and loading an alternate CocoaAll +% unit. +parser_e_no_procvarnested_const=03296_E_Constantes tipadas do tipo 'procedimento ‚ aninhado' s¢ podem ser inicializadas com NIL e procedimentos/fun‡äes globais +% A nested procedural variable consists of two components: the address of the +% procedure/function to call (which is always known at compile time), and also +% a parent frame pointer (which is never known at compile time) in case the +% procedural variable contains a reference to a nested procedure/function. +% Therefore such typed constants can only be initialized with global +% functions/procedures since these do not require a parent frame pointer. +parser_f_no_generic_inside_generic=03297_F_Declara‡Æo de classe gen‚rica dentro de outra classe gen‚rica nÆo ‚ permitido +% At the moment, scanner supports recording of only one token buffer at the time +% (guarded by internal error 200511173 in tscannerfile.startrecordtokens). +% Since generics are implemented by recording tokens, it is not possible to +% have declaration of generic class inside another generic class. +parser_e_forward_protocol_declaration_must_be_resolved=03298_E_Declara‡Æo posterior de objcprotocl "$1" deve ser resolvida antes de uma objcclass possa conform -la +% An objcprotocol must be fully defined before classes can conform to it. +% This error occurs in the following situation: +% \begin{verbatim} +% Type MyProtocol = objcprotoocl; +% ChildClass = Class(NSObject,MyProtocol) +% ... +% end; +% \end{verbatim} +% where \var{MyProtocol} is declared but not defined. +parser_e_no_record_published=03299_E_Tipos registro nÆo podem ter se‡äes publicadas +% Published sections can be used only inside classes. +parser_e_no_destructor_in_records=03300_E_Destruidores nÆo sÆo permitidos em registros ou auxiliares +% Destructor declarations aren't allowed in records or helpers. +parser_e_class_methods_only_static_in_records=03301_E_M‚todos de classe devem ser est ticos em registros +% Class methods declarations aren't allowed in records without static modifier. +% Records have no inheritance and therefore non static class methods have no sence for them. +parser_e_no_constructor_in_records=03302_E_Construtores nÆo sÆo permitidos em registros ou auxiliares de registro +% Constructor declarations aren't allowed in records or record helpers. +parser_e_at_least_one_argument_must_be_of_type=03303_E_Tanto o resultado ou ao menos um parƒmetro deve ser do tipo "$1" +% It is required that either the result of the routine or at least one of its parameters be of the specified type. +% For example class operators either take an instance of the structured type in which they are defined, or they return one. +parser_e_cant_use_type_parameters_here=03304_E_Parƒmetros de tipo podem requerer inicializa‡Æo/finaliza‡Æo - nÆo podem ser usados em registros variant +% Type parameters may be specialized with types which (e.g. \var{ansistring}) need initialization/finalization +% code which is implicitly generated by the compiler. +parser_e_externals_no_section=03305_E_Vari veis sendo declaradas como externas nÆo podem estar em uma se‡Æo customizada +% A section directive is not valid for variables being declared as external. +parser_e_section_no_locals=03306_E_Vari veis nÆo-est ticas e nÆo-globais nÆo podem ter uma diretiva de se‡Æo +% A variable placed in a custom section is always statically allocated so it must be either a static or global variable. +parser_e_not_allowed_in_helper=03307_E_"$1" nÆo ‚ permitido em tipos auxiliares +% Some directives and specifiers like "virtual", "dynamic", "override" aren't +% allowed inside helper types in mode ObjFPC (they are ignored in mode Delphi), +% because they have no meaning within helpers. Also "abstract" isn't allowed in +% either mode. +parser_e_no_class_constructor_in_helpers=03308_E_Construtores de classe nÆo sÆo permitidos em auxiliares +% Class constructor declarations aren't allowed in helpers. +parser_e_inherited_not_in_record=03309_E_O uso de "inherited" nÆo ‚ permitido em um registro +% As records don't suppport inheritance the use of "inherited" is prohibited for +% these as well as for record helpers (in mode "Delphi" only). +parser_e_no_types_in_local_anonymous_records=03310_E_Declara‡äes de tipo nÆo sÆo permitidas em registros locais ou an“nimos +% Records with types must be defined globally. Types cannot be defined inside records which are defined in a +% procedure or function or in anonymous records. +parser_e_duplicate_implements_clause=03311_E_Cl usula "implements" duplicada para a interface "$1" +% A class may delegate an interface using the "implements" clause only to a single property. Delegating it multiple times +% is a error. +parser_e_mapping_no_implements=03312_E_Interface "$1" nÆo pode ser delegada por "$2", j  possui resolu‡Æo de m‚todos +% Method resolution clause maps a method of an interface to a method of the current class. Therefore the current class +% has to implement the interface directly. Delegation is not possible. +parser_e_implements_no_mapping=03313_E_Interface "$1" nÆo pode ter resolu‡Æo de m‚todo, "$2" j  a delega +% Method resoulution is only possible for interfaces that are implemented directly, not by delegation. +parser_e_invalid_codepage=03314_E_Codepage inv lido +% When declaring a string with a given codepage, the range of valid codepages values is limited +% to 0 to 65535. +% \end{description} +# Type Checking +# +# 04108 is the last used one +# +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +type_e_mismatch=04000_E_Tipo incompat¡vel +% This can happen in many cases: +% \begin{itemize} +% \item The variable you're assigning to is of a different type than the +% expression in the assignment. +% \item You are calling a function or procedure with parameters that are +% incompatible with the parameters in the function or procedure definition. +% \end{itemize} +type_e_incompatible_types=04001_E_Tipos incompat¡veis: obtido "$1" esperado "$2" +% There is no conversion possible between the two types. +% Another possiblity is that they are declared in different +% declarations: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { This statement also gives this error. It +% is due to the strict type checking of Pascal } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_Tipos incompat¡veis entre "$1" e "$2" +% The types are not equal. +type_e_type_id_expected=04003_E_Identificador de tipo esperado +% The identifier is not a type, or you forgot to supply a type identifier. +type_e_variable_id_expected=04004_E_Identificador de vari vel esperado +% This happens when you pass a constant to a routine (such as \var{Inc} var or \var{Dec}) +% when it expects a variable. You can only pass variables as arguments to these functions. +type_e_integer_expr_expected=04005_E_ExpressÆo inteira esperada, mas obtido "$1" +% The compiler expects an expression of type integer, but gets a different +% type. +type_e_boolean_expr_expected=04006_E_ExpressÆo booleana esperada, mas obtido "$1" +% The expression must be a boolean type. It should be return \var{True} or +% \var{False}. +type_e_ordinal_expr_expected=04007_E_ExpressÆo ordinal esperada +% The expression must be of ordinal type, i.e., maximum a \var{Longint}. +% This happens, for instance, when you specify a second argument +% to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value. +type_e_pointer_type_expected=04008_E_Tipo ponteiro esperado, mas obtido "$1" +% The variable or expression isn't of the type \var{pointer}. This +% happens when you pass a variable that isn't a pointer to \var{New} +% or \var{Dispose}. +type_e_class_type_expected=04009_E_Tipo classe esperado, mas obtido "$1" +% The variable or expression isn't of the type \var{class}. This happens +% typically when +% \begin{enumerate} +% \item The parent class in a class declaration isn't a class. +% \item An exception handler (\var{On}) contains a type identifier that +% isn't a class. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_Imposs¡vel avaliar expressÆo constante +% This error can occur when the bounds of an array you declared do +% not evaluate to ordinal constants. +type_e_set_element_are_not_comp=04012_E_Elementos conjunto nÆo sÆo compat¡veis +% You are trying to perform an operation on two sets, when the set element types +% are not the same. The base type of a set must be the same when taking the +% union. +type_e_set_operation_unknown=04013_E_Opera‡Æo nÆo implementada para conjuntos +% several binary operations are not defined for sets. +% These include: \var{div}, \var{mod}, \var{**}, \var{>=} and \var{<=}. +% The last two may be defined for sets in the future. +type_w_convert_real_2_comp=04014_W_ConversÆo autom tica de tipo de ponto flutuante para COMP que ‚ um inteiro +% An implicit type conversion from a real type to a \var{comp} is +% encountered. Since \var{comp} is a 64 bit integer type, this may indicate +% an error. +type_h_use_div_for_int=04015_H_Use DIV como alternativa para obter um resultado inteiro +% When hints are on, then an integer division with the '/' operator will +% produce this message, because the result will then be of type real. +type_e_strict_var_string_violation=04016_E_Tipos 'String' devem coincidir exatamente no modo $V+ +% When compiling in \var{\{\$V+\}} mode, the string you pass as a parameter +% should be of the exact same type as the declared parameter of the procedure. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_'SUCC' ou 'PRED' nÆo ‚ poss¡vel em enumera‡äes com atribui‡äes +% If you declare an enumeration type which has C-like assignments +% in it, such as in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% then you cannot use the \var{Succ} or \var{Pred} functions with this enumeration. +type_e_cant_read_write_type=04018_E_Imposs¡vel ler ou gravar vari veis deste tipo +% You are trying to \var{read} or \var{write} a variable from or to a +% file of type text, which doesn't support that variable's type. +% Only integer types, reals, pchars and strings can be read from or +% written to a text file. Booleans can only be written to text files. +type_e_no_readln_writeln_for_typed_file=04019_E_Imposs¡vel usar 'readln' ou 'writeln' em arquivos tipados +% \var{readln} and \var{writeln} are only allowed for text files. +type_e_no_read_write_for_untyped_file=04020_E_Impossivel usar 'read' ou 'write' em arquivos nÆo tipados. +% \var{read} and \var{write} are only allowed for text or typed files. +type_e_typeconflict_in_set=04021_E_Conflito de tipos entre elementos de conjunto +% There is at least one set element which is of the wrong type, i.e. not of +% the set type. +type_w_maybe_wrong_hi_lo=04022_W_lo/hi(dword/qword) retorna 'upper/lower word/dword' +% \fpc supports an overloaded version of \var{lo/hi} for \var{longint/dword/int64/qword} +% which returns the lower/upper word/dword of the argument. \tp always uses +% a 16 bit \var{lo/hi} which always returns bits 0..7 for \var{lo} and the +% bits 8..15 for \var{hi}. If you want the \tp behavior you have +% to type cast the argument to a \var{word} or \var{integer}. +type_e_integer_or_real_expr_expected=04023_E_ExpressÆo inteira ou real esperada +% The first argument to \var{str} must be a real or integer type. +type_e_wrong_type_in_array_constructor=04024_E_Tipo incorreto "$1" no construtor matriz +% You are trying to use a type in an array constructor which is not +% allowed. +type_e_wrong_parameter_type=04025_E_Tipos incompat¡veis para o arg. no. $1: Obtido "$2", esperado "$3" +% You are trying to pass an invalid type for the specified parameter. +type_e_no_method_and_procedure_not_compatible=04026_E_M‚todo (vari vel) e Procedimento (vari vel) nÆo sÆo compat¡veis +% You can't assign a method to a procedure variable or a procedure to a +% method pointer. +type_e_wrong_math_argument=04027_E_Constante ilegal passada para fun‡Æo matem tica interna +% The constant argument passed to a \var{ln} or \var{sqrt} function is out of +% the definition range of these functions. +type_e_no_addr_of_constant=04028_E_Imposs¡vel obter o endere‡o de expressäes constantes +% It is not possible to get the address of a constant expression, because they +% aren't stored in memory. You can try making it a typed constant. This error +% can also be displayed if you try to pass a property to a var parameter. +type_e_argument_cant_be_assigned=04029_E_Argumento nÆo pode ser atribu¡do +% Only expressions which can be on the left side of an +% assignment can be passed as call by reference arguments. +% +% Remark: Properties can be used on the left side of an assignment, +% nevertheless they cannot be used as arguments. +type_e_cannot_local_proc_to_procvar=04030_E_Imposs¡vel atribuir procedimento/fun‡Æo local a vari vel procedimento +% It's not allowed to assign a local procedure/function to a +% procedure variable, because the calling convention of a local procedure/function is +% different. You can only assign local procedure/function to a void pointer. +type_e_no_assign_to_addr=04031_E_Imposs¡vel atribuir valores a um endere‡o +% It is not allowed to assign a value to an address of a variable, constant, +% procedure or function. You can try compiling with -So if the identifier +% is a procedure variable. +type_e_no_assign_to_const=04032_E_Imposs¡vel atribuir valors a uma vari vel constante +% It's not allowed to assign a value to a variable which is declared +% as a const. This is normally a parameter declared as const. To allow +% changing the value, pass the parameter by value, or a parameter by reference +% (using var). +type_e_array_required=04033_E_Tipo matriz requerido +% If you are accessing a variable using an index '[<x>]' then +% the type must be an array. In FPC mode a pointer is also allowed. +type_e_interface_type_expected=04034_E_Tipo interface esperado, mas obtido "$1" +% The compiler expected to encounter an interface type name, but got something else. +% The following code would produce this error: +% \begin{verbatim} +% Type +% TMyStream = Class(TStream,Integer) +% \end{verbatim} +type_h_mixed_signed_unsigned=04035_H_Misturando expressäes assinadas e 'longwords' obtem-se um resultado de 64bits +% If you divide (or calculate the modulus of) a signed expression by a longword (or vice versa), +% or if you have overflow and/or range checking turned on and use an arithmetic +% expression (+, -, *, div, mod) in which both signed numbers and longwords appear, +% then everything has to be evaluated in 64-bit arithmetic which is slower than normal +% 32-bit arithmetic. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_w_mixed_signed_unsigned2=04036_W_Misturando expressäes assinadas e cardinais pode causar um erro de verifica‡Æo de faixa +% If you use a binary operator (and, or, xor) and one of +% the operands is a longword while the other one is a signed expression, then, +% if range checking is turned on, you may get a range check error because in +% such a case both operands are converted to longword before the operation is +% carried out. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_e_typecast_wrong_size_for_assignment=04037_E_ConversÆo de tipo tem tamanhos diferentes ($1 -> $2) na atribui‡Æo +% Type casting to a type with a different size is not allowed when the variable is +% used in an assignment. +type_e_array_index_enums_with_assign_not_possible=04038_E_Enumera‡äes com atribui‡äes nÆo podem ser usadas como ¡ndice de matrizes +% When you declared an enumeration type which has C-like +% assignments, such as in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use it as the index of an array. +type_e_classes_not_related=04039_E_Tipos Classe ou Objeto "$1" e "$2" nÆo estÆo relacionados +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors. +type_w_classes_not_related=04040_W_Tipos Classe "$1" e "$2" nÆo estÆo relacionados +% There is a typecast from one class to another while the classes +% are not related. This will probably lead to errors. +type_e_class_or_interface_type_expected=04041_E_Tipo classe ou interface esperado, mas obtido "$1" +% The compiler expected a class or interface name, but got another type or identifier. +type_e_type_is_not_completly_defined=04042_E_Tipo "$1" nÆo est  completamente definido +% This error occurs when a type is not complete: i.e. a pointer type which points to +% an undefined type. +type_w_string_too_long=04043_W_Literal 'String' tem mais caracteres que comprimento 'string' curta +% The size of the constant string, which is assigned to a shortstring, +% is longer than the maximum size of the shortstring (255 characters). +type_w_signed_unsigned_always_false=04044_W_Compara‡Æo pode ser sempre falsa devido a faixa da constante e expressÆo +% There is a comparison between a constant and an expression where the constant is out of the +% valid range of values of the expression. Because of type promotion, the statement will always evaluate to +% false. Explicitly typecast the constant or the expression to the correct range to avoid this warning +% if you think the code is correct. +type_w_signed_unsigned_always_true=04045_W_Compara‡Æo pode ser sempre verdadeira devido a faixa da constante e expressÆo +% There is a comparison between a constant and an expression where the constant is out of the +% valid range of values of the expression. Because of type promotion, the statement will always evaluate to +% true. Explicitly typecast the constant or the expression to the correct range to avoid this warning +% if you think the code is correct. +type_w_instance_with_abstract=04046_W_Construindo uma classe "$1" com m‚todo abstrato "$2" +% An instance of a class is created which contains non-implemented abstract +% methods. This will probably lead to a runtime error 211 in the code if that +% routine is ever called. All abstract methods should be overridden. +type_h_in_range_check=04047_H_O operador esquerdo em um operador 'IN' deve ser tamanho byte +% The left operand of the \var{in} operator is not an ordinal or enumeration which fits +% within 8 bits. This may lead to range check errors. The \var{in} operator +% currently only supports a left operand which fits within a byte. In the case of +% enumerations, the size of an element of an enumeration can be controlled with +% the \var{\{\$PACKENUM\}} or \var{\{\$Zn\}} switches. +type_w_smaller_possible_range_check=04048_W_Tamanho tipo incompat¡vel, poss¡vel perda de dados / erro verifica‡Æo faixa +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_h_smaller_possible_range_check=04049_H_Tamanho tipo incompat¡vel, poss¡vel perda de dados / erro verifica‡Æo faixa +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_e_cant_take_address_of_abstract_method=04050_E_O endere‡o de um m‚todo abstrato nÆo pode ser obtido +% An abstract method has no body, so the address of an abstract method can't be taken. +type_e_assignment_not_allowed=04051_E_Atribui‡äes … parƒmetros formais e matrizes abertas nÆo sÆo poss¡veis +% You are trying to assign a value to a formal (untyped var, const or out) +% parameter, or to an open array. +type_e_constant_expr_expected=04052_E_ExpressÆo constante esperada +% The compiler expects an constant expression, but gets a variable expression. +type_e_operator_not_supported_for_types=04053_E_Opera‡Æo "$1" nÆo ‚ suportada para os tipos "$2" e "$3" +% The operation is not allowed for the supplied types. +type_e_illegal_type_conversion=04054_E_ConversÆo de tipo ilegal: "$1" para "$2" +% When doing a type-cast, you must take care that the sizes of the variable and +% the destination type are the same. +type_h_pointer_to_longint_conv_not_portable=04055_H_ConversÆo entre ordinais e ponteiros nÆo ‚ port vel +% If you typecast a pointer to a longint (or vice-versa), this code will not compile +% on a machine using 64 bits addressing. +type_w_pointer_to_longint_conv_not_portable=04056_W_ConversÆo entre ordinais e ponteiros nÆo ‚ port vel +% If you typecast a pointer to an ordinal type of a different size (or vice-versa), this can +% cause problems. This is a warning to help in finding the 32-bit specific code where cardinal/longint is used +% to typecast pointers to ordinals. A solution is to use the ptrint/ptruint types instead. +type_e_cant_choose_overload_function=04057_E_Imposs¡vel determinar qual fun‡Æo sobrecarregada chamar +% You're calling overloaded functions with a parameter that doesn't correspond +% to any of the declared function parameter lists. e.g. when you have declared +% a function with parameters \var{word} and \var{longint}, and then you call +% it with a parameter which is of type \var{integer}. +type_e_illegal_count_var=04058_E_Vari vel contador ilegal +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +type_w_double_c_varargs=04059_W_Convertendo constante valor real para 'double' para vari vel argumento C, adicione conversÆo de tipo expl¡cita para evitar isso. +% In C, constant real values are double by default. For this reason, if you +% pass a constant real value to a variable argument part of a C function, FPC +% by default converts this constant to double as well. If you want to prevent +% this from happening, add an explicit typecast around the constant. +type_e_class_or_cominterface_type_expected=04060_E_Tipo Classe ou interface COM esperado, mas obtido "$1" +% Some operators, such as the AS operator, are only applicable to classes or COM interfaces. +type_e_no_const_packed_array=04061_E_Matrizes constantes compactadas nÆo sÆo suportadas ainda +% You cannot declare a (bit)packed array as a typed constant. +type_e_got_expected_packed_array=04062_E_Tipos incompat¡veis para arg. no. $1: Obtido "$2" esperado "Matriz compactada (Bits)" +% The compiler expects a (bit)packed array as the specified parameter. +type_e_got_expected_unpacked_array=04063_E_Tipos incompat¡veis para arg. no. $1: Obtido "$2" esperado "Matriz (nÆo compactada)" +% The compiler expects a regular (i.e., not packed) array as the specified parameter. +type_e_no_packed_inittable=04064_E_Elementos de matrizes compactadas nÆo podem ser de um tipo que necessita ser inicializado +% Support for packed arrays of types that need initialization +% (such as ansistrings, or records which contain ansistrings) is not yet implemented. +type_e_no_const_packed_record=04065_E_Registros constantes compactadas e objetos nÆo sÆo suportados ainda +% You cannot declare a (bit)packed array as a typed constant at this time. +type_w_untyped_arithmetic_unportable=04066_W_Aritm‚tica "$1" em ponteiros nÆo tipados nÆo ‚ port vel {$T+}, sugere-se conversÆo de tipo +% Addition/subtraction from an untyped pointer may work differently in \var{\{\$T+\}}. +% Use a typecast to a typed pointer. +type_e_cant_take_address_of_local_subroutine=04076_E_Imposs¡vel obter endere‡o de uma subrotina marcada como local +% The address of a subroutine marked as local can't be taken. +type_e_cant_export_local=04077_E_Imposs¡vel exportar subrotina marcada como local de uma unidade +% A subroutine marked as local can't be exported from a unit. +type_e_not_automatable=04078_E_Tipo nÆo ‚ automatiz vel: "$1" +% Only byte, integer, longint, smallint, currency, single, double, ansistring, +% widestring, tdatetime, variant, olevariant, wordbool and all interfaces are automatable. +type_h_convert_add_operands_to_prevent_overflow=04079_H_Convertendo os operandos para "$1" antes de realizar a soma pode prevenir erros de transbordamento. +% Adding two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the addition. +type_h_convert_sub_operands_to_prevent_overflow=04080_H_Convertendo os operandos para "$1" antes de realizar a subtra‡Æo pode prevenir erros de transbordamento. +% Subtracting two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the subtraction. +type_h_convert_mul_operands_to_prevent_overflow=04081_H_Convertendo os operados para "$1" antes de realizar a multiplica‡Æo pode prevenir erros de transbordamento. +% Multiplying two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the multiplication. +type_w_pointer_to_signed=04082_W_Convertendo ponteiros para inteiros assinados pode resultar em compara‡äes de resultados incorretas e erros de faixa. Ao inv‚s disso, use tipos nÆo assinados. +% The virtual address space on 32-bit machines runs from \$00000000 to \$ffffffff. +% Many operating systems allow you to allocate memory above \$80000000. +% For example both \windows and \linux allow pointers in the range \$0000000 to \$bfffffff. +% If you convert pointers to signed types, this can cause overflow and range check errors, +% but also \$80000000 < \$7fffffff. This can cause random errors in code like "if p>q". +type_e_interface_has_no_guid=04083_E_Tipo interface $1 nÆo tem um GUID v lido +% When applying the as-operator to an interface or class, the desired interface (i.e. the right operand of the +% as-operator) must have a valid GUID. +type_e_invalid_objc_selector_name=04084_E_Nome seletor inv lido "$1" +% An Objective-C selector cannot be empty, must be a valid identifier or a single colon, +% and if it contains at least one colon it must also end in one. +type_e_expected_objc_method_but_got=04085_E_M‚todo Objective-C esperado, mas obtido $1 +% A selector can only be created for Objective-C methods, not for any other kind +% of procedure/function/method. +type_e_expected_objc_method=04086_E_M‚todo Objective-C ou nome m‚todo constante esperados +% A selector can only be created for Objective-C methods, either by specifying +% the name using a string constant, or by using an Objective-C method identifier +% that is visible in the current scope. +type_e_no_type_info=04087_E_Nenhuma informa‡Æo de tipo dispon¡vel para este tipo +% Type information is not generated for some types, such as enumerations with gaps +% in their value range (this includes enumerations whose lower bound is different +% from zero). +type_e_ordinal_or_string_expr_expected=04088_E_Ordinal ou expressÆo 'string' esperados +% The expression must be an ordinal or string type. +type_e_string_expr_expected=04089_E_ExpressÆo 'string' esperada +% The expression must be a string type. +type_w_zero_to_nil=04090_W_Convertendo 0 para NIL +% Use NIL rather than 0 when initialising a pointer. +type_e_protocol_type_expected=04091_E_Tipo protocolo Objective-C esperado, mas obtido "$1" +% The compiler expected a protocol type name, but found something else. +type_e_objc_type_unsupported=04092_E_O tipo "$1" nÆo ‚ suportado para intera‡Æo com c¢digo Objective-C de tempo execu‡Æo. +% Objective-C makes extensive use of run time type information (RTTI). This format +% is defined by the maintainers of the run time and can therefore not be adapted +% to all possible Object Pascal types. In particular, types that depend on +% reference counting by the compiler (such as ansistrings and certain kinds of +% interfaces) cannot be used as fields of Objective-C classes, cannot be +% directly passed to Objective-C methods, and cannot be encoded using \var{objc\_encode}. +type_e_class_or_objcclass_type_expected=04093_E_Tipo classe ou 'objcclass' esperados, mas obtido "$1" +% It is only possible to create class reference types of \var{class} and \var{objcclass} +type_e_objcclass_type_expected=04094_E_Tipo 'Objcclass' esperado +% The compiler expected an \var{objcclass} type +type_w_procvar_univ_conflicting_para=04095_W_Tipo parƒmetro 'univ' for‡ado em vari vel procedimental pode causar travamento ou corrup‡Æo de mem¢ria: $1 para $2 +% \var{univ} parameters are implicitly compatible with all types of the same size, +% also in procedural variable definitions. That means that the following code is +% legal, because \var{single} and \var{longint} have the same size: +% \begin{verbatim} +% {$mode macpas} +% Type +% TIntProc = procedure (l: univ longint); +% +% procedure test(s: single); +% begin +% writeln(s); +% end; +% +% var +% p: TIntProc; +% begin +% p:=test; +% p(4); +% end. +% \end{verbatim} +% This code may however crash on platforms that pass integers in registers and +% floating point values on the stack, because then the stack will be unbalanced. +% Note that this warning will not flagg all potentially dangerous situations. +% when \var{test} returns. +type_e_generics_cannot_reference_itself=04096_E_Parƒmetros de tipo de especializa‡äes de gen‚ricos nÆo podem referenciar o tipo especializado atual +% Recursive specializations of generics like \var{Type MyType = specialize MyGeneric<MyType>;} are not possible. +type_e_type_parameters_are_not_allowed_here=04097_E_Parƒmetros de tipo nÆo sÆo permitidos em procedimentos ou fun‡äes de classe/registro/objeto nÆo-gen‚rico +% Type parameters are only allowed for methods of generic classes, records or objects +type_e_generic_declaration_does_not_match=04098_E_Declara‡Æo gen‚rica de "$1" difere da declara‡Æo anterior +% Generic declaration does not match the previous declaration +type_e_helper_type_expected=04099_E_Tipo auxiliar esperado +% The compiler expected a \var{class helper} type. +type_e_record_type_expected=04100_E_Tipo registro esperado +% The compiler expected a \var{record} type. +type_e_class_helper_must_extend_subclass=04101_E_Classe auxiliar derivada deve extender a subclasse de "$1" ou a pr¢pria classe +% If a class helper inherits from another class helper the extended class must +% extend either the same class as the parent class helper or a subclass of it +type_e_record_helper_must_extend_same_record=04102_E_Registro auxiliar derivado deve extender "$1" +% If a record helper inherits from another record helper it must extend the same +% record that the parent record helper extended. +type_e_procedures_return_no_value=04103_E_Atribui‡Æo inv lida, procedimento nÆo retorna valor +% This error occurs when one tries to assign the result of a procedure or destructor call. +% A procedure or destructor returns no value so this is not +% possible. +type_w_implicit_string_cast=04104_W_ConversÆo de tipo 'string' impl¡cita de "$1" para "$2" +% An implicit type conversion from an ansi string type to an unicode string type is +% encountered. To avoid this warning perform an explicit type conversion. +type_w_implicit_string_cast_loss=04105_W_ConversÆo de tipo 'string' impl¡cita com potencial de perda de dados de "$1" para "$2" +% An implicit type conversion from an unicode string type to an ansi string type is +% encountered. This conversion can lose data since not all unicode characters may be represented in the codepage of +% destination string type. +type_w_explicit_string_cast=04106_-W_ConversÆo de tipo 'string' expl¡cita de "$1" para "$2" +% An explicit typecast from an ansi string type to an unicode string type is +% encountered. This warning is off by default. You can turn it on to see all suspicious string conversions. +type_w_explicit_string_cast_loss=04107_-W_ConversÆo de tipo 'string' expl¡cita com potencial de perda de dados de "$1" para "$2" +% An explicit typecast from an unicode string type to an ansi string type is +% encountered. This conversion can lose data since not all unicode characters may be represented in the codepage of +% destination string type. This warning is off by default. You can turn it on to see all the places with lossy string +% conversions. +type_w_unicode_data_loss=04108_W_ConversÆo de constante Unicode com potencial de perda de dados +% Conversion from a WideChar to AnsiChar can lose data since now all unicode characters may be represented in the current +% system codepage +% \end{description} +# +# Symtable +# +# 05084 is the last used one +# +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedure and variable names. +% \begin{description} +sym_e_id_not_found=05000_E_Identificador nÆo encontrado "$1" +% The compiler doesn't know this symbol. Usually happens when you misspell +% the name of a variable or procedure, or when you forget to declare a +% variable. +sym_f_internal_error_in_symtablestack=05001_F_Erro interno em SymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_Identificador duplicado "$1" +% The identifier was already declared in the current scope. +sym_h_duplicate_id_where=05003_H_Identificador j  definido em $1 na linha $2 +% The identifier was already declared in a previous scope. +sym_e_unknown_id=05004_E_Identificador desconhecido "$1" +% The identifier encountered has not been declared, or is used outside the +% scope where it is defined. +sym_e_forward_not_resolved=05005_E_Declara‡Æo posterior nÆo resolvida "$1" +% This can happen in two cases: +% \begin{itemize} +% \item You declare a function in the \var{interface} part, or +% with a \var{forward} directive, but do not implement it. +% \item You reference a type which isn't declared in the current \var{type} +% block. +% \end{itemize} +sym_e_error_in_type_def=05007_E_Erro na defini‡Æo de tipo +% There is an error in your definition of a new array type. +% One of the range delimiters in an array declaration is erroneous. +% For example, \var{Array [1..1.25]} will trigger this error. +sym_e_forward_type_not_resolved=05009_E_Tipo posterior nÆo resolvido "$1" +% A symbol was forward defined, but no declaration was encountered. +sym_e_only_static_in_static=05010_E_Apenas vari veis est ticas podem ser usadas em m‚todos est ticos ou m‚todos externos +% A static method of an object can only access static variables. +sym_f_type_must_be_rec_or_class=05012_F_Tipo registro ou classe esperados +% The variable or expression isn't of the type \var{record} or \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_Instƒncias de classes ou objetos com m‚todos abstratos nÆo sÆo permitidas +% You are trying to generate an instance of a class which has an abstract +% method that wasn't overridden. +sym_w_label_not_defined=05014_W_R¢tulo nÆo definido "$1" +% A label was declared, but not defined. +sym_e_label_used_and_not_defined=05015_E_R¢tulo usado mas nÆo definido "$1" +% A label was declared and used, but not defined. +sym_e_ill_label_decl=05016_E_Declara‡Æo r¢tulo ilegal +% This error should never happen; it occurs if a label is defined outside a +% procedure or function. +sym_e_goto_and_label_not_supported=05017_E_GOTO e LABEL nÆo sÆo suportados (use a chave -Sg) +% You must use the -Sg switch to compile a program which has \var{label}s +% and \var{goto} statements. By default, \var{label} and \var{goto} aren't +% supported. +sym_e_label_not_found=05018_E_R¢tulo nÆo encontrado +% A \var{goto label} was encountered, but the label wasn't declared. +sym_e_id_is_no_label_id=05019_E_Identificador nÆo ‚ um r¢tulo +% The identifier specified after the \var{goto} isn't of type label. +sym_e_label_already_defined=05020_E_R¢tulo j  definido +% You are defining a label twice. You can define a label only once. +sym_e_ill_type_decl_set=05021_E_Declara‡Æo de tipo de conjunto de elementos ilegal +% The declaration of a set contains an invalid type definition. +sym_e_class_forward_not_resolved=05022_E_Declara‡Æo posterior de classe nÆo resolvida "$1" +% You declared a class, but you did not implement it. +sym_n_unit_not_used=05023_H_Unidade "$1" nÆo usada em $2 +% The unit referenced in the \var{uses} clause is not used. +sym_h_para_identifier_not_used=05024_H_Parƒmetro "$1" nÆo usado +% The identifier was declared (locally or globally) but +% was not used (locally or globally). +sym_n_local_identifier_not_used=05025_N_Vari vel local "$1" nÆo usada +% You have declared, but not used, a variable in a procedure or function +% implementation. +sym_h_para_identifier_only_set=05026_H_Valor parƒmetro "$1" ‚ atribu¡do mas nunca usado +% The identifier was declared (locally or globally) and +% assigned to, but is not used (locally or globally) after the assignment. +sym_n_local_identifier_only_set=05027_N_Vari vel local "$1" ‚ atribu¡da mas nunca usada +% The variable in a procedure or function implementation is declared and +% assigned to, but is not used after the assignment. +sym_h_local_symbol_not_used=05028_H_Local $1 "$2" nÆo ‚ usado +% A local symbol is never used. +sym_n_private_identifier_not_used=05029_N_Campo privado "$1.$2" nunca usado +% The indicated private field is defined, but is never used in the code. +sym_n_private_identifier_only_set=05030_N_Campo privado "$1.$2" ‚ atribu¡do mas nunca usado +% The indicated private field is declared and assigned to, but never read. +sym_n_private_method_not_used=05031_N_M‚todo privado "$1.$2" nunca usado +% The indicated private method is declared but is never used in the code. +sym_e_set_expected=05032_E_Tipo conjunto esperado +% The variable or expression is not of type \var{set}. This happens in an +% \var{in} statement. +sym_w_function_result_not_set=05033_W_Retorno da fun‡Æo parece nÆo ter sido ajustado +% You can get this warning if the compiler thinks that a function return +% value is not set. This will not be displayed for assembler procedures, +% or procedures that contain assembler blocks. +sym_w_wrong_C_pack=05034_W_Tipo "$1" nÆo est  alinhado corretamente no atual registro para C +% Arrays with sizes not multiples of 4 will be wrongly aligned +% for C structures. +sym_e_illegal_field=05035_E_Identificador de campo de registro desconhecido "$1" +% The field doesn't exist in the record/object definition. +sym_w_uninitialized_local_variable=05036_W_Vari vel local "$1" nÆo parece ter sido inicializada +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assignment). +sym_w_uninitialized_variable=05037_W_Vari vel "$1" parece nÆo ter sido inicializada +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assignment). +sym_e_id_no_member=05038_E_Identificador nÆo identifica nenhum membro "$1" +% This error is generated when an identifier of a record, +% field or method is accessed while it is not defined. +sym_h_param_list=05039_H_Declara‡Æo encontrada: $1 +% You get this when you use the \var{-vh} switch.In the case of an overloaded procedure +% not being found. Then all candidate overloaded procedures are +% listed, with their parameter lists. +sym_e_segment_too_large=05040_E_Elemento de dados muito grande +% You get this when you declare a data element whose size exceeds the +% prescribed limit (2 Gb on 80386+/68020+ processors). +sym_e_no_matching_implementation_found=05042_E_Nenhuma implementa‡Æo coincidente para m‚todo interface "$1" encontrada +% There was no matching method found which could implement the interface +% method. Check argument types and result type of the methods. +sym_w_deprecated_symbol=05043_W_S¡mbolo "$1" est  depreciado +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Use of this symbol +% should be avoided as much as possible. +sym_w_non_portable_symbol=05044_W_S¡mbolo "$1" nÆo ‚ port vel +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{platform} is used. This symbol's value, use +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_non_implemented_symbol=05055_W_S¡mbolo "$1" nÆo est  implementado +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{unimplemented} is used. This symbol is defined, +% but is not yet implemented on this specific platform. +sym_e_cant_create_unique_type=05056_E_Imposs¡vel criar tipo £nico para este tipo +% Only simple types like ordinal, float and string types are supported when +% redefining a type with \var{type newtype = type oldtype;}. +sym_h_uninitialized_local_variable=05057_H_Vari vel local "$1" parece nÆo ter sido inicializada +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. it did not appear in the left-hand side of an +% assignment). +sym_h_uninitialized_variable=05058_H_Vari vel "$1" parece nÆo ter sido inicializada +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. t did not appear in the left-hand side of an +% assignment). +sym_w_function_result_uninitialized=05059_W_Vari vel de retorno da fun‡Æo parece nÆo ter sido inicializada +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. it appears in the right-hand side of an expression) +% before it is initialized (i.e. before it appeared in the left-hand side of an +% assignment). +sym_h_function_result_uninitialized=05060_H_Vari vel de retorno da fun‡Æo parece nÆo ter sido inicializada +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. it appears in the right-hand side of an expression) +% before it is initialized (i.e. it appears in the left-hand side of an +% assignment) +sym_w_identifier_only_read=05061_W_Vari vel "$1" lida mas nÆo atribu¡da em lugar algum +% You have read the value of a variable, but nowhere assigned a value to +% it. +sym_h_abstract_method_list=05062_H_M‚todo abstrato encontrado: $1 +% When getting a warning about constructing a class/object with abstract methods +% you get this hint to assist you in finding the affected method. +sym_w_experimental_symbol=05063_W_S¡mbolo "$1" ‚ experimental +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{experimental} is used. Experimental symbols +% might disappear or change semantics in future versions. Usage of this symbol +% should be avoided as much as possible. +sym_w_forward_not_resolved=05064_W_Declara‡Æo posterior "$1" nÆo resolvida, assumida como externa +% This happens if you declare a function in the \var{interface} of a unit in macpas mode, +% but do not implement it. +sym_w_library_symbol=05065_W_S¡mbolo "$1" pertence a uma biblioteca +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{library} is used. Library symbols may not be +% available in other libraries. +sym_w_deprecated_symbol_with_msg=05066_W_S¡mbolo "$1" est  depreciado: "$2" +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Use of this symbol +% should be avoided as much as possible. +sym_e_no_enumerator=05067_E_Imposs¡vel encontrar um enumerador para o tipo "$1" +% This means that compiler cannot find an apropriate enumerator to use in the for-in loop. +% To create an enumerator you need to defind an operator enumerator or add a public or published +% GetEnumerator method to the class or object definition. +sym_e_no_enumerator_move=05068_E_Imposs¡vel encontrar um m‚todo "MoveNext" no enumerador "$1" +% This means that compiler cannot find a public MoveNext method with the Boolean return type in +% the enumerator class or object definition. +sym_e_no_enumerator_current=05069_E_Imposs¡vel encontrar uma propriedade "Current" no enumerador "$1" +% This means that compiler cannot find a public Current property in the enumerator class or object +% definition. +sym_e_objc_para_mismatch=05070_E_Incompatibilidade entre n£mero de parƒmetros declarados e n£mero de dois pontos (:) na 'string' mensagem. +% In Objective-C, a message name automatically contains as many colons as parameters. +% In order to prevent mistakes when specifying the message name in FPC, the compiler +% checks whether this is also the case here. Note that in case of messages taking a +% variable number of arguments translated to FPC via an \var{array of const} parameter, +% this final \var{array of const} parameter is not counted. Neither are the hidden +% \var{self} and \var{\_cmd} parameters. +sym_n_private_type_not_used=05071_N_Tipo privado "$1.$2" nunca usado +% The indicated private type is declared but is never used in the code. +sym_n_private_const_not_used=05072_N_Constante privada "$1.$2" nunca usada +% The indicated private const is declared but is never used in the code. +sym_n_private_property_not_used=05073_N_Propriedade privada "$1.$2" nunca usada +% The indicated private property is declared but is never used in the code. +sym_w_deprecated_unit=05074_W_Unidade "$1" est  depreciada +% This means that a unit which is +% declared as \var{deprecated} is used. Deprecated units may no longer +% be available in newer versions of the library. Use of this unit +% should be avoided as much as possible. +sym_w_deprecated_unit_with_msg=05075_W_Unidade "$1" est  depreciada: "$2" +% This means that a unit which is +% declared as \var{deprecated} is used. Deprecated units may no longer +% be available in newer versions of the library. Use of this unit +% should be avoided as much as possible. +sym_w_non_portable_unit=05076_W_Unidade "$1" nÆo ‚ port vel +% This means that a unit which is +% declared as \var{platform} is used. This unit use +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_library_unit=05077_W_Unidade "$1" pertence a uma biblioteca +% This means that a unit which is +% declared as \var{library} is used. Library units may not be +% available in other libraries. +sym_w_non_implemented_unit=05078_W_Unidade "$1" nÆo est  implementada +% This means that a unit which is +% declared as \var{unimplemented} is used. This unit is defined, +% but is not yet implemented on this specific platform. +sym_w_experimental_unit=05079_W_Unidade "$1" ‚ experimental +% This means that a unit which is +% declared as \var{experimental} is used. Experimental units +% might disappear or change semantics in future versions. Usage of this unit +% should be avoided as much as possible. +sym_e_objc_formal_class_not_resolved=05080_E_Nenhuma defini‡Æo completa da classe objeto formalmente declarada "$1" est  no escopo +% Objecive-C classes can be imported formally, without using the the unit in which it is fully declared. +% This enables making forward references to such classes and breaking circular dependencies amongst units. +% However, as soon as you wish to actually do something with an entity of this class type (such as +% access one of its fields, send a message to it, or use it to inherit from), the compiler requires the full definition +% of the class to be in scope. +sym_e_interprocgoto_into_init_final_code_not_allowed=05081_E_Gotos dentro de blocos de inicializa‡Æo ou finaliza‡Æo de unidades nÆo sÆo permitidos +% Gotos into initialization or finalization blockse of units are not allowed. +sym_e_external_class_name_mismatch1=05082_E_Nome externo inv lido "$1" para classe formal "$2" +sym_e_external_class_name_mismatch2=05083_E_Complete a defini‡Æo de classe com nome externo "$1" aqui +% When a class is declared using a formal external definition, the actual external +% definition (if any) must specify the same external name as the formal definition +% (since both definitions refer to the same actual class type). +sym_w_library_overload=05084_W_Poss¡vel conflito em biblioteca: s¡mbolo "$1" da biblioteca "$2" tamb‚m encontrado na biblioteca "$3" +% Some OS do not have library specific namespaces, for those +% OS, the function declared as "external 'libname' name 'funcname'", +% the 'libname' part is only a hint, funcname might also be loaded +% by another library. This warning appears if 'funcname' is used twice +% with two different library names. +% +% \end{description} +# +# Codegenerator +# +# 06049 is the last used one +# +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +cg_e_parasize_too_big=06009_E_Tamanho da lista de parƒmetros excede 65535 bytes +% The I386 processor limits the parameter list to 65535 bytes. (The \var{RET} +% instruction causes this.) +cg_e_file_must_call_by_reference=06012_E_Tipos Arquivos devem ser parƒmetros var. +% You cannot specify files as value parameters, i.e., they must always be +% declared \var{var} parameters. +cg_e_cant_use_far_pointer_there=06013_E_O uso de ponteiro distante nÆo ‚ permitido l  +% Free Pascal doesn't support far pointers, so you cannot take the address of +% an expression which has a far reference as a result. The \var{mem} construct +% has a far reference as a result, so the following code will produce this +% error: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_Fun‡äes 'EXPORT' declaradas nÆo podem ser chamadas +% No longer in use. +cg_w_member_cd_call_from_method=06016_W_Poss¡vel chamada ilegal de construtor ou destruidor +% The compiler detected that a constructor or destructor is called within a +% a method. This will probably lead to problems, since constructors / destructors +% require parameters on entry. +cg_n_inefficient_code=06017_N_C¢dio ineficiente +% Your statement seems dubious to the compiler. +cg_w_unreachable_code=06018_W_C¢digo inacess¡vel +% You specified a construct which will never be executed. Example: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_M‚todos abstratos nÆo podem ser chamados diretamente +% You cannot call an abstract method directly. Instead, you must call an +% overriding child method, because an abstract method isn't implemented. +cg_d_register_weight=06027_DL_Registro $1 peso $2 $3 +% Debugging message. Shown when the compiler considers a variable for +% keeping in the registers. +cg_d_stackframe_omited=06029_DL_Quadro da pilha ‚ omitido +% Some procedure/functions do not need a complete stack-frame, so it is omitted. +% This message will be displayed when the {-vd} switch is used. +cg_e_unable_inline_object_methods=06031_E_Objeto ou m‚todos classe nÆo podem ser 'em linha'. +% You cannot have inlined object methods. +cg_e_unable_inline_procvar=06032_E_Chamadas 'Procvar' nÆo podem ser 'em linha'. +% A procedure with a procedural variable call cannot be inlined. +cg_e_no_code_for_inline_stored=06033_E_Nenhum c¢digo para procedimento 'em linha' armazenado +% The compiler couldn't store code for the inline procedure. +cg_e_can_access_element_zero=06035_E_Elemento zero de uma 'ansi/wide-' ou stringlonga pode ser acessado, usar '(set)length' +% You should use \var{setlength} to set the length of an ansi/wide/longstring +% and \var{length} to get the length of such string type. +cg_e_cannot_call_cons_dest_inside_with=06037_E_Construtores ou destruidores nÆo podem ser chamados de dentro de uma cl usula 'with' +% Inside a \var{with} clause you cannot call a constructor or destructor for the +% object you have in the \var{with} clause. +cg_e_cannot_call_message_direct=06038_E_Imposs¡vel chamar m‚todos manipuladores de mensagem diretamente +% A message method handler method cannot be called directly if it contains an +% explicit \var{Self} argument. +cg_e_goto_inout_of_exception_block=06039_E_Salto interno ou externo a um bloco de exce‡Æo +% It is not allowed to jump in or outside of an exception block like \var{try..finally..end;}. +% For example, the following code will produce this error: + +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // this line will cause an error +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_Instru‡äes de controle de fluxo nÆo sÆo permitidos em um bloco 'finally' +% It isn't allowed to use the control flow statements \var{break}, +% \var{continue} and \var{exit} +% inside a finally statement. The following example shows the problem: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // This exit ISN'T allowed +% end; +% ... +% +% \end{verbatim} +% If the procedure \var{p} raises an exception the finally block is +% executed. If the execution reaches the exit, it's unclear what to do: +% exit the procedure or search for another exception handler. +cg_w_parasize_too_big=06041_W_Tamanho parƒmetros excede limite para certas CPU's +% This indicates that you are declaring more than 64K of parameters, which +% might not be supported on other processor targets. +cg_w_localsize_too_big=06042_W_Tamanho vari vel local excede limite para certas CPU's +% This indicates that you are declaring more than 32K of local variables, which +% might not be supported on other processor targets. +cg_e_localsize_too_big=06043_E_Tamanho vari veis locais excedem limites suportados +% This indicates that you are declaring more than 32K of local variables, which +% is not supported by this processor. +cg_e_break_not_allowed=06044_E_BREAK nÆo permitido +% You're trying to use \var{break} outside a loop construction. +cg_e_continue_not_allowed=06045_E_CONTINUE nÆo permitido +% You're trying to use \var{continue} outside a loop construction. +cg_f_unknown_compilerproc=06046_F_'Compilerproc' desconhecido "$1". Verifique se vocˆ usa a biblioteca de tempo de execu‡Æo correta +% The compiler expects that the runtime library contains certain subroutines. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the compiler in use. If you changed the runtime library this error means +% that you removed a subroutine which the compiler needs for internal use. +cg_f_unknown_system_type=06047_F_Imposs¡vel encontrar tipo sistema "$1". Verifique se vocˆ usa a biblioteca de tempo de execu‡Æo correta +% The compiler expects that the runtime library contains certain type definitions. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the compiler in use. If you changed the runtime library this error means +% that you removed a type which the compiler needs for internal use. +cg_h_inherited_ignored=06048_H_Chamada herdada para m‚todo abstrato ignorada +% This message appears only in Delphi mode when you call an abstract method +% of a parent class via \var{inherited;}. The call is then ignored. +cg_e_goto_label_not_found=06049_E_R¢tulo 'Goto' "$1" nÆo definido ou eliminado pela otimiza‡Æo +% The label used in the goto definition is not defined or optimized away by the +% unreachable code elemination. +cg_f_unknown_type_in_unit=06050_F_Imposs¡vel encontrar o tipo "$1" na unidade "$2". Verifique se vocˆ usa a biblioteca de tempo de execu‡Æo correta. +% The compiler expects that the runtime library contains certain type definitions. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the compiler in use. If you changed the runtime library this error means +% that you removed a type which the compiler needs for internal use. +cg_e_interprocedural_goto_only_to_outer_scope_allowed=06051_E_Gotos interprocedimentos sÆo permitidos apenas para subrotinas externas +% Gotos between subroutines are only allowed if the goto jumps from an inner to an outer subroutine or +% from a subroutine to the main program +cg_e_labels_cannot_defined_outside_declaration_scope=06052_E_R¢tulo deve ser definido no mesmo escopo em que ‚ declarado +% In ISO mode, labels must be defined in the same scope as they are declared. +cg_e_goto_across_procedures_with_exceptions_not_allowed=06053_E_Deixar procedimentos contendo quadros de exce‡äes expl¡citas ou impl¡citas usando 'goto' nÆo ‚ permitido +% Non-local gotos might not be used to leave procedures using exceptions either implicitly or explicitly. Procedures +% which use automated types like ansistrings or class constructurs are affected by this too. +cg_e_mod_only_defined_for_pos_quotient=06054_E_No modo ISO, o operador 'mod' ‚ definido apenas para quociente positivo +% In ISO pascal, only positive values are allowed for the quotient: \var{n mod m} is only valid if \var{m>0}. +% \end{description} +# EndOfTeX + +# +# Assembler reader +# +# 07110 is the last used one +# +asmr_d_start_reading=07000_DL_Iniciando $1 an lise estilo assembler +% This informs you that an assembler block is being parsed +asmr_d_finish_reading=07001_DL_Finalizada $1 an lise estilo assembler +% This informs you that an assembler block has finished. +asmr_e_none_label_contain_at=07002_E_PadrÆo nÆo-r¢tulo contˆm @ +% A identifier which isn't a label can't contain a @. +asmr_e_building_record_offset=07004_E_Erro construindo deslocamento registro +% There has an error occured while building the offset of a record/object +% structure, this can happend when there is no field specified at all or +% an unknown field identifier is used. +asmr_e_offset_without_identifier=07005_E_'OFFSET' usado sem identificador +% You can only use OFFSET with an identifier. Other syntaxes aren't +% supported +asmr_e_type_without_identifier=07006_E_'TYPE' usado sem identificador +% You can only use TYPE with an identifier. Other syntaxes aren't +% supported +asmr_e_no_local_or_para_allowed=07007_E_Imposs¡vel usar vari vel local ou parƒmetro aqui +% You can't use a local variable or parameter here, mostly because the +% addressing of locals and parameters is done using the frame pointer register so the +% address can't be obtained directly. +asmr_e_need_offset=07008_E_Necess rio usar 'OFFSET' aqui +% You need to use OFFSET <id> here to get the address of the identifier. +asmr_e_need_dollar=07009_E_Necess rio usar $ aqui +% You need to use $<id> here to get the address of the identifier. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_Imposs¡vel usar m£ltiplos s¡mbolos reloc veis +% You can't have more than one relocatable symbol (variable/typed constant) +% in one argument. +asmr_e_only_add_relocatable_symbol=07011_E_S¡mbolo reloc vel pode apenas ser adicionado +% Relocatable symbols (variable/typed constant) can't be used with other +% operators. Only addition is allowed. +asmr_e_invalid_constant_expression=07012_E_ExpressÆo constante inv lida +% There is an error in the constant expression. +asmr_e_relocatable_symbol_not_allowed=07013_E_S¡mbolo reloc vel nÆo ‚ permitido +% You can't use a relocatable symbol (variable/typed constant) here. +asmr_e_invalid_reference_syntax=07014_E_Sintaxe referˆncia inv lida +% There is an error in the reference. +asmr_e_local_para_unreachable=07015_E_Vocˆ nÆo pode atingir $1 a partir desse c¢digo +% You cannot read directly the value of a local variable or parameter +% of a higher level procedure in assembler code (except for +% local assembler code without parameter nor locals). +asmr_e_local_label_not_allowed_as_ref=07016_E_S¡mbolos locais/r¢tulos nÆo sÆo permitidos como referˆncias +% You can't use local symbols/labels as references +asmr_e_wrong_base_index=07017_E_Uso registro base e ¡ndice inv lido +% There is an error with the base and index register, they are +% probably incorrect +asmr_w_possible_object_field_bug=07018_W_Poss¡vel erro na manipula‡Æo de campo de objeto +% Fields of objects or classes can be reached directly in normal or objfpc +% modes but TP and Delphi modes treat the field name as a simple offset. +asmr_e_wrong_scale_factor=07019_E_Fator incorreto de escala especificado +% The scale factor given is wrong, only 1,2,4 and 8 are allowed +asmr_e_multiple_index=07020_E_Uso m£ltiplo registro ¡ndice +% You are trying to use more than one index register +asmr_e_invalid_operand_type=07021_E_Tipo operando inv lido +% The operand type doesn't match with the opcode used +asmr_e_invalid_string_as_opcode_operand=07022_E_'String' inv lido como operando 'opcode': $1 +% The string specified as operand is not correct with this opcode +asmr_w_CODE_and_DATA_not_supported=07023_W_@CODE e @DATA nÆo suportados +% @CODE and @DATA are unsupported and are ignored. +asmr_e_null_label_ref_not_allowed=07024_E_Referˆncias nulas de r¢tulos nÆo sÆo permitidas +asmr_e_expr_zero_divide=07025_E_DivisÆo por zero em avaliador asm +% There is a division by zero in a constant expression +asmr_e_expr_illegal=07026_E_Expressao ilegal +% There is an illegal expression in a constant expression +asmr_e_escape_seq_ignored=07027_E_Sequˆncia de escape ignorada: $1 +% There is a C-styled string, but the escape sequence in the string +% is unknown, and is therefore ignored +asmr_e_invalid_symbol_ref=07028_E_Referˆncia s¡mbolo inv lida +asmr_w_fwait_emu_prob=07029_W_Fwait pode causar problemas de emula‡Æo com emu387 +asmr_w_fadd_to_faddp=07030_W_$1 sem operando traduzido em $1P +asmr_w_enter_not_supported_by_linux=07031_W_Instru‡Æo 'ENTER' nÆo suportada pelo kernel Linux +% ENTER instruction can generate a stack page fault that is not +% caught correctly by the i386 Linux page handler. +asmr_w_calling_overload_func=07032_W_Chamando uma fun‡Æo sobrecarregada em assembler +% There is a call to an overloaded method in the assembler block, +% this might be the sign there is a problem +asmr_e_unsupported_symbol_type=07033_E_Tipo s¡mbolo nÆo suportado para operando +asmr_e_constant_out_of_bounds=07034_E_Valor constante fora de faixa +asmr_e_error_converting_decimal=07035_E_Erro convertendo decimal $1 +% A constant decimal value does not have the correct syntax +asmr_e_error_converting_octal=07036_E_Erro convertendo octal $1 +% A constant octal value does not have the correct syntax +asmr_e_error_converting_binary=07037_E_Erro convertendo bin rio $1 +% A constant binary value does not have the correct syntax +asmr_e_error_converting_hexadecimal=07038_E_Erro convertendo hexadecimal $1 +% A constant hexadecimal value does not have the correct syntax +asmr_h_direct_global_to_mangled=07039_H_$1 traduzido para $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 est  associado a uma fun‡Æo sobrecarregada +asmr_e_cannot_use_SELF_outside_a_method=07041_E_Imposs¡vel usar 'SELF' fora de um m‚todo +% There is a reference to the \var{self} symbol while it is not +% allowed. \var{self} can only be referenced inside methods +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_Imposs¡vel usar 'OLDEBP' fora de um procedimento aninhado +% There is a reference to the \var{oldebp} symbol while it is not +% allowed. \var{oldebp} can only be referenced inside nested routines +asmr_e_void_function=07043_W_Procedimentos nÆo podem retornar qualquer valor em c¢digo asm +% Trying to return a value while in a procedure. A procedure +% does not have any return value +asmr_e_SEG_not_supported=07044_E_SEG nÆo suportado +asmr_e_size_suffix_and_dest_dont_match=07045_E_Tamanho sufixo e tamanho destino ou fonte nÆo coincidem +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_w_size_suffix_and_dest_dont_match=07046_W_Tamanho sufixo e tamanho destino ou fonte nÆo coincidem +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_e_syntax_error=07047_E_Erro de sintaxe assembler +% There is an assembler syntax error +asmr_e_invalid_opcode_and_operand=07048_E_Combina‡Æo inv lida de 'opcode' e operandos +% The opcode cannot be used with this type of operand +asmr_e_syn_operand=07049_E_Erro de sintaxe assembler em operando +asmr_e_syn_constant=07050_E_Erro de sintaxe assembler em constante +asmr_e_invalid_string_expression=07051_E_ExpressÆo 'String' inv lida +asmr_w_const32bit_for_address=07052_W_Constante com s¡mbolo $1 para endere‡o que nÆo est  em um ponteiro +% A constant expression represents an address which does not fit +% into a pointer. The address is probably incorrect +asmr_e_unknown_opcode=07053_E_'Opcode' desconhecido $1 +% This opcode is not known +asmr_e_invalid_or_missing_opcode=07054_E_'Opcode' inv lido ou faltando +asmr_e_invalid_prefix_and_opcode=07055_E_Combina‡Æo inv lida de prefixo e 'opcode': $1 +asmr_e_invalid_override_and_opcode=07056_E_Combina‡Æo inv lida de 'override' e 'opcode': $1 +asmr_e_too_many_operands=07057_E_Muitos operandos na linha +% There are too many operands for this opcode. Check your +% assembler syntax +asmr_w_near_ignored=07058_W_NEAR ignorado +asmr_w_far_ignored=07059_W_FAR ignorado +asmr_e_dup_local_sym=07060_E_S¡mbolo local duplicado $1 +asmr_e_unknown_local_sym=07061_E_S¡mbolo local indefinido $1 +asmr_e_unknown_label_identifier=07062_E_Identificador r¢tulo desconhecido $1 +asmr_e_invalid_register=07063_E_Nome registro inv lido +% There is an unknown register name used as operand. +asmr_e_invalid_fpu_register=07064_E_Nome registro ponto flutuante inv lido +% There is an unknown register name used as operand. +asmr_w_modulo_not_supported=07066_W_M¢dulo nÆo suportado +asmr_e_invalid_float_const=07067_E_Constante ponto flutuante inv lida $1 +% The floating point constant declared in an assembler block is +% invalid. +asmr_e_invalid_float_expr=07068_E_ExpressÆo ponto flutuante inv lida +% The floating point expression declared in an assembler block is +% invalid. +asmr_e_wrong_sym_type=07069_E_Tipo s¡mbolo incorreto +asmr_e_cannot_index_relative_var=07070_E_Imposs¡vel indexar uma var. local ou parƒmetro com um registro +% Trying to index using a base register a symbol which is already relative +% to a register. This is not possible, and will probably lead to crashes. +asmr_e_invalid_seg_override=07071_E_ExpressÆo sobreposi‡Æo segmento inv lida +asmr_w_id_supposed_external=07072_W_Identificador $1 supostamente externo +% There is a reference to an undefined symbol. This will not result +% in an error, since the symbol might be external, but may cause +% problems at link time if the symbol is not defined anywhere. +asmr_e_string_not_allowed_as_const=07073_E_'Strings' nÆo permitidas como constantes +% Character strings are not allowed as constants. +asmr_e_no_var_type_specified=07074_E_Nenhum tipo de vari vel especificado +% The syntax expects a type idenfitifer after the dot, but +% none was found. +asmr_w_assembler_code_not_returned_to_text=07075_E_C¢digo assembler nÆo retornou a se‡Æo texto +% There was a directive in the assembler block to change sections, +% but there is a missing return to the text section at the end +% of the assembler block. This might cause errors during link time. +asmr_e_not_directive_or_local_symbol=07076_E_NÆo ‚ uma diretiva ou s¡mbolo local $1 +% This symbol is unknown. +asmr_w_using_defined_as_local=07077_E_Usando um nome definido como um r¢tulo local +asmr_e_dollar_without_identifier=07078_E_Caracter D¢lar ‚ usado sem um identificador +% A constant expression has an identifier which does not start with +% the $ symbol. +asmr_w_32bit_const_for_address=07079_W_Constante 32bit criada para endere‡o +% A constant was used as an address. This is probably an error, +% since using absolute addresses will probably not work. +asmr_n_align_is_target_specific=07080_N_'.align' ‚ espec¡fico de alvo, use '.balign' ou '.p2align' +% Using the .align directive is platform specific, and its meaning will vary +% from one platform to another. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_Imposs¡vel acessar campos diretamente para parƒmetros +% You should load the parameter first into a register and then access the +% fields using that register. +asmr_e_cannot_access_object_field_directly=07082_E_Imposs¡vel acessar campos de objetos/classes diretamente +% You should load the self pointer first into a register and then access the +% fields using the register as base. By default the self pointer is available +% in the esi register on i386. +asmr_e_unable_to_determine_reference_size=07083_E_Tamanho nÆo especificado e incapaz de determinar o tamanho dos operandos +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. +asmr_e_cannot_use_RESULT_here=07084_E_Imposs¡vel usar 'RESULT' nesta fun‡Æo +% Some functions which return complex types cannot use the \var{result} +% keyword. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" sem operando traduzido em "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" traduzido em "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" translated em "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_Caracter < nÆo permitido aqui +% The shift operator requires the << characters. Only one +% of those characters was found. +asmr_e_invalid_char_greater=07090_E_Caracter > nÆo permitido aqui +% The shift operator requires the >> characters. Only one +% of those characters was found. +asmr_w_align_not_supported=07093_W_ALIGN nÆo suportado +asmr_e_no_inc_and_dec_together=07094_E_'Inc' e 'Dec' nÆo podem estar juntos +% Trying to use an increment and a decrement within the same +% opcode on the 680x0. This is impossible. +asmr_e_invalid_reg_list_in_movem=07095_E_'Reglist' para 'movem' inv lido +% Trying to use the \var{movem} opcode with invalid registers +% to save or restore. +asmr_e_invalid_reg_list_for_opcode=07096_E_'Reglist' inv lido para 'opcode' +asmr_e_higher_cpu_mode_required=07097_E_Modo CPU maior requerido ($1) +% Trying to use an instruction which is not supported in the current +% cpu mode. Use a higher cpu generation to be able to use this +% opcode in your assembler block +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_Nenhum tamanho especificado e incapaz de determinar o tamanho dos operandos, usando DWORD como padrÆo +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use DWORD as default. +asmr_e_illegal_shifterop_syntax=07099_E_Erro de sintaxe tentando analisar um operando deslocamento +% ARM only; ARM assembler supports a so called shifter operand. The used syntax isn't +% a valid shifter operand. Example for an operation with shifter operand: +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +asmr_e_packed_element=07100_E_Endere‡o de componente compactado nÆo est  no limite byte +% Packed components (record fields and array elements) may start at an arbitrary +% bit inside a byte. On CPU which do not support bit-addressable memory (which +% includes all currently supported CPUs by FPC) you will therefore get an error +% message when trying to index arrays with elements whose size is not a multiple +% of 8 bits. The same goes for accessing record fields with such an address. +% multiple of 8 bits. +asmr_w_unable_to_determine_reference_size_using_byte=07101_W_Nenhum tamanho especificado e incapaz de determinar o tamanho dos operandos, usando BYTE como padrÆo +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use BYTE as default. +asmr_w_no_direct_ebp_for_parameter=07102_W_Uso de '+offset(%ebp)' para parƒmetros inv lido aqui +% Using direct 8(%ebp) reference for function/procedure parameters is invalid +% if parameters are in registers. +asmr_w_direct_ebp_for_parameter_regcall=07103_W_Uso de '+offset(%ebp)' nÆo ‚ compat¡vel com a conven‡Æo 'regcall' +% Using direct 8(%ebp) reference for function/procedure parameters is invalid +% if parameters are in registers. +asmr_w_direct_ebp_neg_offset=07104_W_Uso de '-offset(%ebp)' nÆo ‚ recomendada para acesso a vari vel local +% Using -8(%ebp) to access a local variable is not recommended +asmr_w_direct_esp_neg_offset=07105_W_Uso de '-offset(%esp)', acesso pode causar travamento ou valor pode ser perdido +% Using -8(%esp) to access a local stack is not recommended, as +% this stack portion can be overwritten by any function calls or interrupts. +asmr_e_no_vmtoffset_possible=07106_E_'VMTOffset' deve ser usado em combina‡Æo com um m‚todo virtual, e "$1" nÆo ‚ virtual +% Only virtual methods have VMT offsets +asmr_e_need_pic_ref=07107_E_Gerando PIC, mas referˆncia nÆo ‚ segura (PIC-safe) +% The compiler has been configured to generate position-independent code +% (PIC), but there are position-dependent references in the current +% handwritten assembler instruction. +asmr_e_mixing_regtypes=07108_E_Todos os registros em um conjunto de registros devem ser do mesmo tipo e largura +% Instructions on the ARM architecture that take a register set as argument require that all registers +% in this set are of the same kind (e.g., integer, vfp) and width (e.g., single precision, double precision). +asmr_e_empty_regset=07109_E_Um conjunto de registros nÆo pode estar vazio +% Instructions on the ARM architecture that take a register set as argument require that such a set +% contains at least one register. + +asmr_w_useless_got_for_local=07110_W_@GOTPCREL ‚ in£til e potencialmente perigoso para s¡mbolos locais +% The use of @GOTPCREL supposes an extra indirection that is +% not present if the symbol is local, which might lead to wrong asembler code +asmr_w_general_segment_with_constant=07111_W_Constante com registro de segmento de prop¢sito geral +% General purpose register should not have constant offsets +% as OS memory allocation might not be compatible with that. +asmr_e_bad_seh_directive_offset=07112_E_Valor de deslocamento inv lido para $1 +% Win64 SEH directives have certain restrictions on possible offset values, e.g. they should +% be positive and have 3 or 4 low bits clear. +asmr_e_bad_seh_directive_register=07113_E_Registro inv lido para $1 +% Win64 SEH directives accept only 64-bit integer registers or XMM registers. +asmr_e_seh_in_pure_asm_only=07114_E_Diretivas SEH sÆo permitidas apenas em procedimentos assembler puros +% Win64 SEH directives are allowed only in pure assembler procedures, not in assembler +% blocks of regular procedures. +asmr_e_unsupported_directive=07115_E_Diretiva "$1" nÆo ‚ suportada pelo alvo atual + + +# +# Assembler/binary writers +# +# 08022 is the last used one +# +asmw_f_too_many_asm_files=08000_F_Muitos arquivos assembler +% With smartlinking enabled, there are too many assembler +% files generated. Disable smartlinking. +asmw_f_assembler_output_not_supported=08001_F_Sa¡da assembler selecionada nÆo suportada +asmw_f_comp_not_supported=08002_F_'Comp' nÆo suportado +asmw_f_direct_not_supported=08003_F_Modo direto nÆo suportado por gravadores bin rios +% Direct assembler mode is not supported for binary writers. +asmw_e_alloc_data_only_in_bss=08004_E_Alocamento de dados somente permitida na se‡Æo 'bss' +asmw_f_no_binary_writer_selected=08005_F_Nenhum gravador bin rio selecionado +asmw_e_opcode_not_in_table=08006_E_Asm: Opcode $1 nÆo est  na tabela +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 combina‡Æo inv lida de 'opcode' e operandos +asmw_e_16bit_not_supported=08008_E_Asm: referˆncias 16 Bits nÆo suportadas +asmw_e_invalid_effective_address=08009_E_Asm: Endere‡o efetivo inv lido +asmw_e_immediate_or_reference_expected=08010_E_Asm: Esperados 'Immediate' ou referˆncia +asmw_e_value_exceeds_bounds=08011_E_Asm: $1 valor excede limites $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: Salto curto fora de faixa $1 +asmw_e_undefined_label=08013_E_Asm: R¢tulo indefinido $1 +asmw_e_comp_not_supported=08014_E_Asm: Tipo 'Comp' nÆo suportado por este alvo +asmw_e_extended_not_supported=08015_E_Asm: Tipo extendido nÆo suportado por este alvo +asmw_e_duplicate_label=08016_E_Asm: R¢tulo duplicado $1 +asmw_e_redefined_label=08017_E_Asm: R¢tulo redefinido $1 +asmw_e_first_defined_label=08018_E_Asm: Primeiramente definido aqui +asmw_e_invalid_register=08019_E_Asm: Registro inv lido $1 +asmw_e_16bit_32bit_not_supported=08020_E_Asm: Referˆncias 16 ou 32 Bits nÆo suportadas +asmw_e_64bit_not_supported=08021_E_Asm: Operandos 64 Bits nÆo suportados +asmw_e_bad_reg_with_rex=08022_E_Asm: AH,BH,CH ou DH nÆo podem ser usados em uma instru‡Æo que requer o prefixo REX +% x86_64 only: instruction encoding of this platform does not allow using +% 8086 high byte registers (AH,BH,CH or DH) together with REX prefix in a single instruction. +% The REX prefix is required whenever the instruction operand size is 64 bits, or +% when it uses one of extended x86_64 registers (R8-R15 or XMM8-XMM15). +asmw_e_missing_endprologue=08023_E_Diretiva .seh_endprologue faltando +% x86_64-win64 only: Normally, SEH directives are handled internally by compiler. +% However, in pure assembler procedures .seh_endprologue directive is required +% if other SEH directives are present. +asmw_e_prologue_too_large=08024_E_Pr¢logo da fun‡Æo excede 255 bytes +% x86_64-win64: .seh_prologue directive must be placed within 255 bytes from function start. +asmw_e_handlerdata_no_handler=08025_E_Diretiva .seh_handlerdata sem .seh_handler precedente +% x86_64-win64: If .seh_handlerdata directive is used, then a .seh_handler directive must be +% present earlier in the same function. + +# +# Executing linker/assembler +# +# 09033 is the last used one +# +# BeginOfTeX +% +% \section{Errors of assembling/linking stage} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +exec_w_source_os_redefined=09000_W_Sistema operacional fonte redefinido +% The source operating system is redefined. +exec_i_assembling_pipe=09001_I_Montando (pipe) $1 +% Assembling using a pipe to an external assembler. +exec_d_cant_create_asmfile=09002_E_Imposs¡vel criar arquivo assembler: $1 +% The mentioned file can't be created. Check if you have +% access permissions to create this file. +exec_e_cant_create_objectfile=09003_E_Imposs¡vel criar arquivo objeto: $1 +% The mentioned file can't be created. Check if you have +% got access permissions to create this file. +exec_e_cant_create_archivefile=09004_E_Imposs¡vel criar arquivo: $1 +% The mentioned file can't be created. Check if you have +% access permissions to create this file. +exec_e_assembler_not_found=09005_E_Montador $1 nÆo encontrado, mudando para montador externo +% The assembler program was not found. The compiler will produce a script that +% can be used to assemble and link the program. +exec_t_using_assembler=09006_T_Usando montador: $1 +% An informational message saying which assembler is being used. +exec_e_error_while_assembling=09007_E_Erro ao montar c¢digo sa¡da $1 +% There was an error while assembling the file using an external assembler. +% Consult the documentation of the assembler tool to find out more information +% on this error. +exec_e_cant_call_assembler=09008_E_Imposs¡vel chamar montador, erro $1 mudando para montador externo +% An error occurred when calling an external assembler. The compiler will produce a script that +% can be used to assemble and link the program. +exec_i_assembling=09009_I_Montando $1 +% An informational message stating which file is being assembled. +exec_i_assembling_smart=09010_I_Montando com vincula‡Æo inteligente $1 +% An informational message stating which file is being assembled using smartlinking. +exec_w_objfile_not_found=09011_W_Objeto $1 nÆo encontrado, Vincula‡Æo pode falhar ! +% One of the object files is missing, and linking will probably fail. +% Check your paths. +exec_w_libfile_not_found=09012_W_Biblioteca $1 nÆo encontrada, Vincula‡Æo pode falhar ! +% One of the library files is missing, and linking will probably fail. +% Check your paths. +exec_e_error_while_linking=09013_E_Erro durante vincula‡Æo +% Generic error while linking. +exec_e_cant_call_linker=09014_E_Imposs¡vel chamar vinculador, mudando para vincula‡Æo externa +% An error occurred when calling an external linker. The compiler will produce a script that +% can be used to assemble and link the program. +exec_i_linking=09015_I_Vinculando $1 +% An informational message, showing which program or library is being linked. +exec_e_util_not_found=09016_E_Utilit rio $1 nÆo encontrado, mudando para vincula‡Æo externa +% An external tool was not found. The compiler will produce a script that +% can be used to assemble and link or postprocess the program. +exec_t_using_util=09017_T_Usando utilit rio $1 +% An informational message, showing which external program (usually a postprocessor) is being used. +exec_e_exe_not_supported=09018_E_Cria‡Æo de Execut veis nÆo suportada +% Creating executable programs is not supported for this platform, because it was +% not yet implemented in the compiler. +exec_e_dll_not_supported=09019_E_Cria‡Æo de bibliotecas Dinƒmicas/Compartilhadas nÆo suportada +% Creating dynamically loadable libraries is not supported for this platform, because it was +% not yet implemented in the compiler. +exec_i_closing_script=09020_I_Fechando roteiro $1 +% Informational message showing when writing of the external assembling and linking script is finished. +exec_e_res_not_found=09021_E_Compilador recursos "$1" nÆo encontrado, mudando para modo externo +% An external resource compiler was not found. The compiler will produce a script that +% can be used to assemble, compile resources and link or postprocess the program. +exec_i_compilingresource=09022_I_Compilando recursos $1 +% An informational message, showing which resource is being compiled. +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_Unidade $1 nÆo pode ser vinculada estaticamente, mudando para vincula‡Æo inteligente +% Static linking was requested, but a unit which is not statically linkable was used. +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_Unidade $1 nÆo pode ser vinculada inteligentemente, mudando para vincula‡Æo est tica +% Smart linking was requested, but a unit which is not smart-linkable was used. +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_Unidade $1 nÆo pode ser vinculada compartilhadamente, mudando para vincula‡Æo est tica +% Shared linking was requested, but a unit which is not shared-linkable was used. +exec_e_unit_not_smart_or_static_linkable=09026_E_Unidade $1 nÆo pode ser vinculada inteligentemente ou estaticamente +% Smart or static linking was requested, but a unit which cannot be used for either was used. +exec_e_unit_not_shared_or_static_linkable=09027_E_Unidade $1 nÆo pode ser vinculada compartilhadamente ou estaticamente +% Shared or static linking was requested, but a unit which cannot be used for either was used. +exec_d_resbin_params=09028_D_Chamando compilador recursos "$1" com "$2" como linha comando +% An informational message showing which command line is used for the resource compiler. +exec_e_error_while_compiling_resources=09029_E_Erro ao compilar recursos +% The resource compiler or converter returned an error. +exec_e_cant_call_resource_compiler=09030_E_Imposs¡vel chamar o compilador recursos "$1", mudando para modo externo +% An error occurred when calling a resource compiler. The compiler will produce +% a script that can be used to assemble, compile resources and link or +% postprocess the program. +exec_e_cant_open_resource_file=09031_E_Imposs¡vel abrir arquivo recursos "$1" +% An error occurred resource file cannot be opened. +exec_e_cant_write_resource_file=09032_E_Imposs¡vel gravar arquivo recursos "$1" +% An error occurred resource file cannot be written. +exec_n_backquote_cat_file_not_found=09033_N_Arquivo "$1" nÆo encontrado para comando 'cat' entre aspas +% The compiler did not find the file that should be expanded into linker parameters +%\end{description} +# EndOfTeX + +# +# Executable information +# +# 09134 is the last used one +# +# BeginOfTeX +% \section{Executable information messages.} +% This section lists all messages that the compiler emits when an executable program is produced, +% and only when the internal linker is used. +% \begin{description} +execinfo_f_cant_process_executable=09128_F_Imposs¡vel p¢s-processar execut vel $1 +% Fatal error when the compiler is unable to post-process an executable. +execinfo_f_cant_open_executable=09129_F_Imposs¡vel abrir execut vel $1 +% Fatal error when the compiler cannot open the file for the executable. +execinfo_x_codesize=09130_X_Tamanho do C¢digo: $1 bytes +% Informational message showing the size of the produced code section. +execinfo_x_initdatasize=09131_X_Tamanho dos dados inicializados: $1 bytes +% Informational message showing the size of the initialized data section. +execinfo_x_uninitdatasize=09132_X_Tamanho dos dados nÆo inicializados: $1 bytes +% Informational message showing the size of the uninitialized data section. +execinfo_x_stackreserve=09133_X_Espa‡o da Pilha reservado: $1 bytes +% Informational message showing the stack size that the compiler reserved for the executable. +execinfo_x_stackcommit=09134_X_Espa‡o da Pilha confirmado: $1 bytes +% Informational message showing the stack size that the compiler committed for the executable. +%\end{description} +# EndOfTeX + +# +# Internal linker messages +# +# 09200 is the last used one +# +# BeginOfTeX +% \section{Linker messages} +% This section lists messages produced by internal linker. +% \begin{description} +link_f_executable_too_big=09200_F_Tamanho imagem execut vel ‚ muito grande para alvo $1. +% Fatal error when resulting executable is too big. +link_w_32bit_absolute_reloc=09201_W_Arquivo objeto "$1" contˆm reloca‡Æo absoluta de 32-bits para s¡mbolo "$2". +% Warning when 64-bit object file contains 32-bit absolute relocations. +% In such case an executable image can be loaded into lower 4Gb of +% address space only. +%\end{description} +# EndOfTeX + +# +# Unit loading +# +# 10062 is the last used one +# +# BeginOfTeX +% \section{Unit loading messages.} +% This section lists all messages that can occur when the compiler is +% loading a unit from disk into memory. Many of these messages are +% informational messages. +% \begin{description} +unit_t_unitsearch=10000_T_Busca Unidade: $1 +% When you use the \var{-vt} option, the compiler tells you where it tries to find +% unit files. +unit_t_ppu_loading=10001_T_Carregando PPU $1 +% When the \var{-vt} switch is used, the compiler tells you +% what units it loads. +unit_u_ppu_name=10002_U_Nome PPU: $1 +% When you use the \var{-vu} flag, the unit name is shown. +unit_u_ppu_flags=10003_U_PPU 'Flags': $1 +% When you use the \var{-vu} flag, the unit flags are shown. +unit_u_ppu_crc=10004_U_PPU 'Crc': $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_time=10005_U_Hora PPU: $1 +% When you use the \var{-vu} flag, the time the unit was compiled is shown. +unit_u_ppu_file_too_short=10006_U_Arquivo PPU muito pequeno +% The ppufile is too short, not all declarations are present. +unit_u_ppu_invalid_header=10007_U_Cabe‡alho PPU inv lido (sem PPU no come‡o) +% A unit file contains as the first three bytes the ASCII codes of the characters \var{PPU}. +unit_u_ppu_invalid_version=10008_U_VersÆo PPU inv lida $1 +% This unit file was compiled with a different version of the compiler, and +% cannot be read. +unit_u_ppu_invalid_processor=10009_U_PPU foi compilado para outro processador +% This unit file was compiled for a different processor type, and +% cannot be read. +unit_u_ppu_invalid_target=10010_U_PPU foi compilado para outro alvo +% This unit file was compiled for a different target, and +% cannot be read. +unit_u_ppu_source=10011_U_Fonte PPU: $1 +% When you use the \var{-vu} flag, the unit source file name is shown. +unit_u_ppu_write=10012_U_Gravando $1 +% When you specify the \var{-vu} switch, the compiler will tell you where it +% writes the unit file. +unit_f_ppu_cannot_write=10013_F_Imposs¡vel gravar arquivo PPU +% An error occurred when writing the unit file. +unit_f_ppu_read_error=10014_F_Erro ao ler arquivo PPU +% This means that the unit file was corrupted, and contains invalid +% information. Recompilation will be necessary. +unit_f_ppu_read_unexpected_end=10015_F_Fim de arquivo PPU inesperado +% Unexpected end of file. This may mean that the PPU file is +% corrupted. +unit_f_ppu_invalid_entry=10016_F_Entrada inv lida arquivo PPU: $1 +% The unit the compiler is trying to read is corrupted, or generated with a +% newer version of the compiler. +unit_f_ppu_dbx_count_problem=10017_F_Problema contagem Dbx PPU +% There is an inconsistency in the debugging information of the unit. +unit_e_illegal_unit_name=10018_E_Nome unidade ilegal: $1 +% The name of the unit does not match the file name. +unit_f_too_much_units=10019_F_Muitas unidades +% \fpc has a limit of 1024 units in a program. You can change this behavior +% by changing the \var{maxunits} constant in the \file{fmodule.pas} file of the +% compiler, and recompiling the compiler. +unit_f_circular_unit_reference=10020_F_Referˆncia circular em unidade entre $1 e $2 +% Two units are using each other in the interface part. This is only allowed +% in the \var{implementation} part. At least one unit must contain the other one +% in the \var{implementation} section. +unit_f_cant_compile_unit=10021_F_Imposs¡vel compilar unidade $1, nenhum fonte dispon¡vel +% A unit was found that needs to be recompiled, but no sources are +% available. +unit_f_cant_find_ppu=10022_F_Imposs¡vel localizar unidade $1 usada por $2 +% You tried to use a unit of which the PPU file isn't found by the +% compiler. Check your configuration file for the unit paths. +unit_w_unit_name_error=10023_W_Unidade $1 nÆo foi encontrada mas $2 existe +% This error message is no longer used. +unit_f_unit_name_error=10024_F_Unidade $1 foi procurada mas $2 encontrada +% \dos truncation of 8 letters for unit PPU files +% may lead to problems when unit name is longer than 8 letters. +unit_w_switch_us_missed=10025_W_Compilar a unidade 'system' requer a chave -Us +% When recompiling the system unit (it needs special treatment), the +% \var{-Us} switch must be specified. +unit_f_errors_in_unit=10026_F_Houveram $1 erros ao compilar m¢dulo, parando +% When the compiler encounters a fatal error or too many errors in a module +% then it stops with this message. +unit_u_load_unit=10027_U_Carregar de $1 ($2) unidade $3 +% When you use the \var{-vu} flag, which unit is loaded from which unit is +% shown. +unit_u_recompile_crc_change=10028_U_Recompilando $1, 'checksum' alterado para $2 +% The unit is recompiled because the checksum of a unit it depends on has +% changed. +unit_u_recompile_source_found_alone=10029_U_Recompilando $1, apenas fonte encontrado +% When you use the \var{-vu} flag, these messages tell you why the current +% unit is recompiled. +unit_u_recompile_staticlib_is_older=10030_U_Recompilando unidade, bib est tica ‚ mais antiga que o arquivo ppu +% When you use the \var{-vu} flag, the compiler warns if the static library +% of the unit is older than the unit file itself. +unit_u_recompile_sharedlib_is_older=10031_U_Recompilando unidade, bib compartilhada ‚ mais antiga que o arquivo ppu +% When you use the \var{-vu} flag, the compiler warns if the shared library +% of the unit is older than the unit file itself. +unit_u_recompile_obj_and_asm_older=10032_U_Recompilando unidade, 'obj' e 'asm' sÆo mais antigos que o arquivo ppu +% When you use the \var{-vu} flag, the compiler warns if the assembler or +% object file of the unit is older than the unit file itself. +unit_u_recompile_obj_older_than_asm=10033_U_Recompilando unidade, 'obj' ‚ mais antigo que 'asm' +% When you use the \var{-vu} flag, the compiler warns if the assembler +% file of the unit is older than the object file of the unit. +unit_u_parsing_interface=10034_U_Analisando 'interface' de $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the interface part of the unit. +unit_u_parsing_implementation=10035_U_Analisando 'implementation' de $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the implementation part of the unit. +unit_u_second_load_unit=10036_U_Segundo carregamento para a unidade $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happen with +% interdependent units. +unit_u_check_time=10037_U_PPU Verifique arquivo $1 hora $2 +% When you use the \var{-vu} flag, the compiler shows the filename and +% date and time of the file on which a recompile depends. +### The following two error msgs is currently disabled. +#unit_h_cond_not_set_in_last_compile=10038_H_Conditional $1 was not set at startup in last compilation of $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that currently is defined, but was not used the last +#% time the unit was compiled. +#unit_h_cond_set_in_last_compile=10039_H_Conditional $1 was set at startup in last compilation of $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that was used the last time the unit was compiled, but +#% the conditional is currently not defined. +unit_w_cant_compile_unit_with_changed_incfile=10040_W_Imposs¡vel recompilar unidade $1, mas encontrados arquivos de inclusÆo modificados +% A unit was found to have modified include files, but +% some source files were not found, so recompilation is impossible. +unit_u_source_modified=10041_U_Arquivo $1 ‚ mais novo que o usado para criar o arquivo PPU $2 +% A modified source file for a compiler unit was found. +unit_u_ppu_invalid_fpumode=10042_U_Tentando usar uma unidade que foi compilada com um modo diferente de FPU +% Trying to compile code while using units which were not compiled with +% the same floating point format mode. Either all code should be compiled +% with FPU emulation on, or with FPU emulation off. +unit_u_loading_interface_units=10043_U_Carregando unidades 'interface' de $1 +% When you use the \var{-vu} flag, the compiler warns that it is starting +% to load the units defined in the interface part of the unit. +unit_u_loading_implementation_units=10044_U_Carregando unidades 'implementation' de $1 +% When you use the \var{-vu} flag, the compiler warns that it is starting +% to load the units defined in the implementation part of the unit. +unit_u_interface_crc_changed=10045_U_Interface CRC alterado para a unidade $1 +% When you use the \var{-vu} flag, the compiler warns that the +% CRC calculated for the interface has been changed after the implementation +% has been parsed. +unit_u_implementation_crc_changed=10046_U_Implementation CRC alterado para a unidade $1 +% When you use the \var{-vu} flag, the compiler warns that the +% CRC calculated has been changed after the implementation +% has been parsed. +unit_u_finished_compiling=10047_U_Terminada a compila‡Æo da unidade $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has finished compiling the unit. +unit_u_add_depend_to=10048_U_Adi‡Æo dependˆncia: $1 depende de $2 +% When you use the \var{-vu} flag, the compiler warns that it +% has added a dependency between the two units. +unit_u_no_reload_is_caller=10049_U_Nenhum recarregamento, ‚ o chamador: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% will not reload the unit because it is the unit that wants +% to load this unit. +unit_u_no_reload_in_second_compile=10050_U_Nenhum recarregamento, j  em segunda compila‡Æo: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% will not reload the unit because it is already in a second recompile. +unit_u_flag_for_reload=10051_U_'Flag' para recarregamento: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to reload the unit. +unit_u_forced_reload=10052_U_Recarregamento for‡ado +% When you use the \var{-vu} flag, the compiler warns that it +% is reloading the unit because it was required. +unit_u_previous_state=10053_U_Estado anterior de $1: $2 +% When you use the \var{-vu} flag, the compiler shows the +% previous state of the unit. +unit_u_second_compile_unit=10054_U_J  compilando $1, ajustando segunda compila‡Æo +% When you use the \var{-vu} flag, the compiler warns that it is starting +% to recompile a unit for the second time. This can happen with interdependent +% units. +unit_u_loading_unit=10055_U_Carregando unidade $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the unit. +unit_u_finished_loading_unit=10056_U_Terminado carregamento unidade $1 +% When you use the \var{-vu} flag, the compiler warns that it finished +% loading the unit. +unit_u_registering_new_unit=10057_U_Registrando nova unidade $1 +% When you use the \var{-vu} flag, the compiler warns that it has +% found a new unit and is registering it in the internal lists. +unit_u_reresolving_unit=10058_U_Re-solucionando unidade $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to recalculate the internal data of the unit. +unit_u_skipping_reresolving_unit=10059_U_Pulando re-solu‡Æo unidade $1, ainda carregando unidades usadas +% When you use the \var{-vu} flag, the compiler warns that it is +% skipping the recalculation of the internal data of the unit +% because there is no data to recalculate. +unit_u_unload_resunit=10060_U_Descarregando unidade recursos $1 (nÆo necess ria) +% When you use the \var{-vu} flag, the compiler warns that it is unloading the +% resource handling unit, since no resources are used. +unit_e_different_wpo_file=10061_E_Unidade $1 foi compilada usando uma entrada de retorno inteiramente diferente de otimiza‡Æo de programa ($2, $3); recompile-a sem 'wpo' ou use o mesmo arquivo de retorno de entrada 'wpo' para esta compila‡Æo +% When a unit has been compiled using a particular whole program optimization (wpo) feedback file (\var{-FW<x>} \var{-OW<x>}), +% this compiled version of the unit is specialised for that particular compilation scenario and cannot be used in +% any other context. It has to be recompiled before you can use it in another program or with another wpo feedback input file. +unit_u_indirect_crc_changed=10062_U_CRC interface indireta (objetos/classes) alterado para a unidade $1 +% When you use the \var{-vu} flag, the compiler warns that the +% indirect CRC calculated for the unit (this is the CRC of all classes/objects/interfaces/$\ldots$ +% in the interfaces of units directly or indirectly used by this unit in the interface) has been changed after the +% implementation has been parsed. +% \end{description} +# EndOfTeX + +# +# Options +# +# 11049 is the last used one +# +option_usage=11000_O_$1 [options] <inputfile> [options] +# BeginOfTeX +% +% \section{Command line handling errors} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +option_only_one_source_support=11001_W_Apenas uma arquivo fonte suportado, alterando arquivo fonte … compilar de "$1" para "$2" +% You can specify only one source file on the command line. The last +% one will be compiled, others will be ignored. This may indicate that +% you forgot a \var{'-'} sign. +option_def_only_for_os2=11002_W_Arquivo DEF pode ser criado apenas para OS/2 +% This option can only be specified when you're compiling for OS/2. +option_no_nested_response_file=11003_E_Arquivos respostas aninhados nÆo sÆo suportados +% You cannot nest response files with the \var{@file} command line option. +option_no_source_found=11004_F_Nenhm nome arquivo fonte na linha de comando +% The compiler expects a source file name on the command line. +option_no_option_found=11005_N_Nenhuma op‡Æo dentro do arquivo de configura‡äes $1 +% The compiler didn't find any option in that config file. +option_illegal_para=11006_E_Parƒmetro ilegal: $1 +% You specified an unknown option. +option_help_pages_para=11007_H_-? lista p ginas ajuda +% When an unknown option is given, this message is diplayed. +option_too_many_cfg_files=11008_F_Muitos arquivos de configura‡äes aninhados +% You can only nest up to 16 config files. +option_unable_open_file=11009_F_Incapaz de abrir arquivo $1 +% The option file cannot be found. +option_reading_further_from=11010_D_Lendo demais op‡äes de $1 +% Displayed when you have notes turned on, and the compiler switches +% to another options file. +option_target_is_already_set=11011_W_Alvo j  est  ajustado para: $1 +% Displayed if more than one \var{-T} option is specified. +option_no_shared_lib_under_dos=11012_W_Bibs compartilhadas nÆo sÆo suportadas pela plataforma DOS, revertendo para est tica +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos. +option_too_many_ifdef=11013_F_No arquivo op‡äes $1 na linha $2 muitos \var{\#IF(N)DEFs} encontrados +% The \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_many_endif=11014_F_No arquivo op‡äes $1 na linha $2 encontrados \var{\#ENDIFs} inesperados +% The \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_less_endif=11015_F_Condicional aberta no final do arquivo de op‡äes +% The \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_no_debug_support=11016_W_Gera‡Æo de informa‡äes depura‡Æo nÆo ‚ suportada por este execut vel +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_Tente recompilar com -dGDB +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_W_Vocˆ esta usando uma chave obsoleta $1 +% This warns you when you use a switch that is not needed/supported anymore. +% It is recommended that you remove the switch to overcome problems in the +% future, when the meaning of the switch may change. +option_obsolete_switch_use_new=11019_W_Vocˆ esta usando uma chave obsoleta $1, favor usar $2 +% This warns you when you use a switch that is not supported anymore. You +% must now use the second switch instead. +% It is recommended that you change the switch to overcome problems in the +% future, when the meaning of the switch may change. +option_switch_bin_to_src_assembler=11020_N_Mudando montador assembler para o padrÆo escrita de fontes +% This notifies you that the assembler has been changed because you used the +% -a switch, which can't be used with a binary assembler writer. +option_incompatible_asm=11021_W_Sa¡da Assembler selecionado "$1" incompat¡vel com "$2" +option_asm_forced=11022_W_"$1" uso for‡ado montador assembler +% The assembler output selected cannot generate +% object files with the correct format. Therefore, the +% default assembler for this target is used instead. +option_using_file=11026_T_Lendo op‡äes do arquivo $1 +% Options are also read from this file. +option_using_env=11027_T_Lendo op‡äes do ambiente $1 +% Options are also read from this environment string. +option_handling_option=11028_D_Manipulando op‡Æo "$1" +% Debug info that an option is found and will be handled. +option_help_press_enter=11029_O_*** pressione <enter> *** +% Message shown when help is shown page per page. When pressing the ENTER +% Key, the next page of help is shown. If you press q and then ENTER, the +% compiler exits. +option_start_reading_configfile=11030_H_In¡cio leitura do arquivo configura‡Æo $1 +% Start of configuration file parsing. +option_end_reading_configfile=11031_H_Final leitura do arquivo configura‡Æo $1 +% End of configuration file parsing. +option_interpreting_option=11032_D_Interpretando op‡Æo "$1" +% The compiler is interpreting an option +option_interpreting_firstpass_option=11036_D_Interpretando primeiro passo op‡Æo "$1" +% The compiler is interpreting an option for the first time. +option_interpreting_file_option=11033_D_Interpretando op‡Æo arquivo "$1" +% The compiler is interpreting an option which it read from the configuration file. +option_read_config_file=11034_D_Lendo arquivo configura‡Æo "$1" +% The compiler is starting to read the configuration file. +option_found_file=11035_D_Nome arquivo fonte encontrado "$1" +% Additional information about options. +% Displayed when you have the debug option turned on. +option_code_page_not_available=11039_E_Codepage desconhecido +% An unknown codepage for the source files was requested. +% The compiler is compiled with support for several codepages built-in. +% The requested codepage is not in that list. You will need to recompile +% the compiler with support for the codepage you need. +option_config_is_dir=11040_F_Arquivo configura‡Æo $1 ‚ um diret¢rio +% Directories cannot be used as configuration files. +option_confict_asm_debug=11041_W_Sa¡da montador Assembler selecionado "$1" nÆo pode gerar informa‡äes depura‡Æo, depura‡Æo desabilitada +% The selected assembler output cannot generate +% debugging information, debugging option is therefore disabled. +option_ppc386_deprecated=11042_W_Uso de 'ppc386.cfg' est  depreciado, favor usar 'fpc.cfg' +% Using ppc386.cfg is still supported for historical reasons, however, for a multiplatform +% system the naming makes no sense anymore. Please continue to use fpc.cfg instead. +option_else_without_if=11043_F_No arquivo op‡äes $1 na linha $2 diretiva \var{\#ELSE} sem \var{\#IF(N)DEF} encontrada +% An \var{\#ELSE} statement was found in the options file without a matching \var{\#IF(N)DEF} statement. +option_unsupported_target=11044_F_Op‡Æo "$1" nÆo ‚, ou ainda nÆo ‚, suportada pela plataforma alvo atual +% Not all options are supported or implemented for all target platforms. This message informs you that a chosen +% option is incompatible with the currently selected target platform. +option_unsupported_target_for_feature=11045_F_A caracter¡stica "$1" nÆo ‚, ou ainda nÆo ‚, suportada pela plataforma alvo selecionada +% Not all features are supported or implemented for all target platforms. This message informs you that a chosen +% feature is incompatible with the currently selected target platform. +option_dwarf_smart_linking=11046_N_Informa‡Æo de depura‡Æo DWARF nÆo pode ser usada com vincula‡Æo inteligente neste alvo, mudando para vincula‡Æo est tica +% Smart linking is currently incompatble with DWARF debug information on most +% platforms, so smart linking is disabled in such cases. +option_ignored_target=11047_W_Op‡Æo "$1" ignorada pela plataforma alvo atual +% Not all options are supported or implemented for all target platforms. This message informs you that a chosen +% option is ignored for the currently selected target platform. +option_debug_external_unsupported=11048_W_Desabilitando informa‡Æo externa depura‡Æo porque nÆo ‚ suportada pela combina‡Æo formato alvo/depura‡Æo selecionado. +% Not all debug formats can be stored in an external file on all platforms. In particular, on +% Mac OS X only DWARF debug information can be stored externally. +option_dwarf_smartlink_creation=11049_N_Informa‡Æo de depura‡Æo DWARF nÆo pode ser usada com vincula‡Æo inteligente com assembler externo, desabilitando cria‡Æo de biblioteca est tica. +% Smart linking is currently incompatble with DWARF debug information on most +% platforms, so smart linking is disabled in such cases. +%\end{description} +# EndOfTeX + +# +# Whole program optimization +# +# 12019 is the last used one +# +# BeginOfTeX +% +% \section{Whole program optimization messages} +% This section lists errors that occur when the compiler is performing +% whole program optimization. +% \begin{description} +wpo_cant_find_file=12000_F_Imposs¡vel abrir arquivo de retorno de otimiza‡Æo completa de programa "$1" +% The compiler cannot open the specified feedback file with whole program optimization information. +wpo_begin_processing=12001_D_Processando informa‡äes de otimiza‡Æo completa de programa no arquivo retorno 'wpo' "$1" +% The compiler starts processing whole program optimization information found in the named file. +wpo_end_processing=12002_D_Terminado processamento de otimiza‡Æo completea de programa no arquivo retorno 'wpo' "$1" +% The compiler has finished processing the whole program optimization information found in the named file. +wpo_expected_section=12003_E_Se‡Æo cabe‡alho esperada, mas obtido "$2" na linhae $1 do arquivo retorno 'wpo' +% The compiler expected a section header in the whole program optimization file (starting with \%), +% but did not find it. +wpo_no_section_handler=12004_W_Nenhum manipulador registrado para se‡Æo otimiza‡Æo completa de programa "$2" na linha $1 do arquivo de retorno 'wpo', ignorando +% The compiler has no handler to deal with the mentioned whole program optimization information +% section, and will therefore ignore it and skip to the next section. +wpo_found_section=12005_D_Encontrada se‡Æo otimiza‡Æo completa de programa "$1" com informa‡äes sobre "$2" +% The compiler encountered a section with whole program optimization information, and according +% to its handler this section contains information usable for the mentioned purpose. +wpo_no_input_specified=12006_F_As otimiza‡äes completas de programa selecionadas requerem um arquivo de retorno previamente gerado (use -Fw para especificar) +% The compiler needs information gathered during a previous compilation run to perform the selected +% whole program optimizations. You can specify the location of the feedback file containing this +% information using the -Fw switch. +wpo_not_enough_info=12007_E_Nenhuma informa‡Æo coletada necess ria para realizar "$1" otimiza‡Æo completa programa foi encontrada +% While you pointed the compiler to a file containing whole program optimization feedback, it +% did not contain the information necessary to perform the selected optimizations. You most likely +% have to recompile the program using the appropate -OWxxx switch. +wpo_no_output_specified=12008_F_Especifique um arquivo de retorno de otimiza‡Æo completa programa para armazenar as informa‡äes geradas (usando -FW) +% You have to specify the feedback file in which the compiler has to store the whole program optimization +% feedback that is generated during the compilation run. This can be done using the -FW switch. +wpo_output_without_info_gen=12009_E_NÆo gerando qualquer informa‡Æo otimiza‡Æo completa programa, assim mesmo um arquivo de retorno foi especificado (usando -FW) +% The compiler was instructed to store whole program optimization feedback into a file specified using -FW, +% but not to actually generated any whole program optimization feedback. The classes of to be +% generated information can be speciied using -OWxxx. +wpo_input_without_info_use=12010_E_NÆo realizando qualquer otimiza‡Æo completa programa, assim mesmo um arquivo de retorno foi especificado (usando -Fw) +% The compiler was not instructed to perform any whole program optimizations (no -Owxxx parameters), +% but nevertheless an input file with such feedback was specified (using -Fwyyy). Since this can +% indicate that you forgot to specify an -Owxxx parameter, the compiler generates an error in this case. +wpo_skipping_unnecessary_section=12011_D_Pulando se‡Æo otimiza‡Æo completa programa "$1", porque nÆo ‚ necess ria pelas otimiza‡äes solicitadas +% The whole program optimization feedback file contains a section with information that is not +% required by the selected whole program optimizations. +wpo_duplicate_wpotype=12012_W_Sobrepondo informa‡äes previamente lidas para "$1" do arquivo entrada retorno usando informa‡äes na se‡Æo "$2" +% The feedback file contains multiple sections that provide the same class of information (e.g., +% information about which virtual methods can be devirtualized). In this case, the information in last encountered +% section is used. Turn on debugging output (-vd) to see which class of information is provided by each section. +wpo_cannot_extract_live_symbol_info_strip=12013_E_Imposs¡vel extrair informa‡äes de vida de s¡mbolos do programa durante elimina‡Æo s¡mbolos, use -Xs- +% Certain symbol liveness collectors extract the symbol information from the linked program. If the symbol information +% is stripped (option -Xs), this is not possible. +wpo_cannot_extract_live_symbol_info_no_link=12014_E_Imposs¡vel extrair informa‡äes de vida de s¡mbolos do programa quando nÆo vinculando +% Certain symbol liveness collectors extract the symbol information from the linked program. If the program is not +% linked by the compiler, this is not possible. +wpo_cannot_find_symbol_progs=12015_F_Imposs¡vel encontrar "$1" ou "$2" para extrair informa‡äes de vida de s¡mbolos do programa vinculado +% Certain symbol liveness collectors need a helper program to extract the symbol information from the linked program. +% This helper program is normally 'nm', which is part of the GNU binutils. +wpo_error_reading_symbol_file=12016_E_Erro durante leitura das informa‡äes de v¡da de s¡mbolos produzidas por "$1" +% An error occurred during the reading of the symbol liveness file that was generated using the 'nm' or 'objdump' program. The reason +% can be that it was shorter than expected, or that its format was not understood. +wpo_error_executing_symbol_prog=12017_F_Erro executando "$1" (c¢digo sa¡da: $2) para extrair informa‡äes de s¡mbolos do programa vinculado +% Certain symbol liveness collectors need a helper program to extract the symbol information from the linked program. +% The helper program produced the reported error code when it was run on the linked program. +wpo_symbol_live_info_needs_smart_linking=12018_E_Cole‡Æo de informa‡äes de vida de s¡mbolos pode ajudar apenas quando usando vincula‡Æo inteligente, use -CX -XX +% Whether or not a symbol is live is determined by looking whether it exists in the final linked program. +% Without smart linking/dead code stripping, all symbols are always included, regardless of whether they are +% actually used or not. So in that case all symbols will be seen as live, which makes this optimization ineffective. +wpo_cant_create_feedback_file=12019_E_Imposs¡vel criar arquivo retorno otimiza‡äes completas de programa especificado "$1" +% The compiler is unable to create the file specified using the -FW parameter to store the whole program optimisation information. +%\end{description} +# EndOfTeX + + +# +# Logo (option -l) +# +option_logo=11023_[ +Compilador Free Pascal versÆo $FPCFULLVERSION [$FPCDATE] para $FPCCPU +Copyright (c) 1993-2011 by Florian Klaempfl +] + +# +# Info (option -i) +# +option_info=11024_[ +Compilador Free Pascal versÆo $FPCVERSION + +Data Compilador : $FPCDATE +CPU Alvo Copilador : $FPCCPU + +Alvos suportados: + $OSTARGETS + +Conjunto de instru‡äes CPU suportados: + $INSTRUCTIONSETS + +Conjunto de instru‡äes FPU suportados: + $FPUINSTRUCTIONSETS + +Alvos ABI suportados: + $ABITARGETS + +Otimiza‡äes suportadas: + $OPTIMIZATIONS + +Otimiza‡äs Completas Programa suportadas: + Todas + $WPOPTIMIZATIONS + +Tipos Microcontroladores suportados: + $CONTROLLERTYPES + +Este programa ‚ oferecido sob a Licen‡a Geral P£blica GNU +Para maiores informa‡äes leia COPYING.FPC + +Reportar falhas, sugestäes, etc. para: + http://bugs.freepascal.org +ou + bugs@freepascal.org +] + +# +# Help pages (option -? and -h) +# +# The first character on the line indicates who will display this +# line, the current possibilities are : +# * = every target +# 3 = 80x86 targets +# 4 = x86_64 +# 6 = 680x0 targets +# A = ARM +# e = in extended debug mode only +# P = PowerPC targets +# S = Sparc targets +# V = Virtual machine targets +# The second character also indicates who will display this line, +# (if the above character was TRUE) the current possibilities are : +# * = everyone +# g = with GDB info supported by the compiler +# O = OS/2 +# L = UNIX systems +# The third character represents the indentation level. +# +option_help_pages=11025_[ +**0*_Ponha + ap¢s uma chave de op‡Æo booleana para habilit -la, - para desabilit -la +**1a_O compilador nÆo elimina o arquivo gerado do montador assembler +**2al_Lista linhas do c¢digo fonte no arquivo assembler +**2an_Lista informa‡äes n¢ no arquivo assembler +*L2ap_Usa encadeadores (pipes) em vez de criar arquivos tempor rios assembler +**2ar_Lista informa‡äes aloca‡Æo/libera‡Æo registros no arquivo assembler +**2at_Lista informa‡äes tempor rias aloca‡Æo/libera‡Æo no arquivo assembler +**1A<x>_Formato sa¡da: +**2Adefault_Usa montador assembler padrÆo +3*2Aas_Monta usando o GNU AS +3*2Amacho_Mach-O (Darwin, Intel 32 bit) usando gravador interno +3*2Anasmcoff_Arquivo COFF (Go32v2) usando Nasm +3*2Anasmelf_Arquivo ELF32 (Linux) usando Nasm +3*2Anasmwin32_Arquivo objeto Win32 usando Nasm +3*2Anasmwdosx_Arquivo objeto Win32/WDOSX usando Nasm +3*2Awasm_Arquivo Obj usando Wasm (Watcom) +3*2Anasmobj_Arquivo Obj usando Nasm +3*2Amasm_Arquivo Obj usando Masm (Microsoft) +3*2Atasm_Arquivo Obj usando Tasm (Borland) +3*2Aelf_ELF (Linux) usando gravador interno +3*2Acoff_COFF (Go32v2) usando gravador interno +3*2Apecoff_PE-COFF (Win32) usando gravador interno +4*2Aas_Monta usando o GNU AS +4*2Agas_Monta usando o GNU GAS +4*2Agas-darwin_Monta darwin Mach-O64 usando GNU GAS +4*2Amasm_Win64 arquivo objeto usando ml64 (Microsoft) +4*2Apecoff_PE-COFF (Win64) usando escritor interno +4*2Aelf_ELF (Linux-64bit) usando escritor interno +6*2Aas_Arquivo Unix .o usando o GNU AS +6*2Agas_Montador assembler GNU Motorola +6*2Amit_Sintaxe MIT (antigo GAS) +6*2Amot_Montador assembler Motorola padrÆo +A*2Aas_Monta usando o GNU AS +P*2Aas_Monta usando o GNU AS +S*2Aas_Monta usando o GNU AS +**1b_Gera informa‡äes navegador +**2bl_Gera informa‡äes s¡mbolos locais +**1B_Constr¢i todos os m¢dulos +**1C<x>_Op‡äes gera‡Æo de c¢digo: +**2C3<x>_Ligar verifica‡Æo de erro ieee para constantes +**2Ca<x>_Seleciona ABI, veja fpc -i para poss¡veis valores +**2Cb_Gera c¢digo 'big-endian' +**2Cc<x>_Ajusta conven‡Æo de chamada para <x> +**2CD_Cria tamb‚m biblioteca dinƒmica (nÆo suportado) +**2Ce_Compila‡Æo com opcodes de ponto flutuante emulados +**2Cf<x>_Seleciona conjunto de instru‡äes fpu a usar, veja fpc -i para poss¡veis valores +**2CF<x>_PrecisÆo m¡nima constante ponto flutuante (padrÆo, 32, 64) +**2Cg_Gera c¢digo PIC +**2Ch<n>_<n> bytes heap (entre 1023 e 67107840) +**2Ci_Verifica‡Æo E/S +**2Cn_Omite est gio vincula‡Æo +**2Co_Verifica transbordamento de opera‡äes inteiras +**2CO_Verifica poss¡vel transbordamento de opera‡äes inteiras +**2Cp<x>_Seleciona conjunto de instru‡äes, veja fpc -i para poss¡ves valores +**2CP<x>=<y>_ Ajustes compacta‡Æo +**3CPPACKSET=<y>_ <y> conjunto aloca‡Æo: 0, 1 ou DEFAULT ou NORMAL, 2, 4 e 8 +**2Cr_Verifica‡Æo de faixa +**2CR_Verifica validade de chamada de m‚todo de objeto +**2Cs<n>_Ajusta verifica‡Æo tamanho da Pilha para <n> +**2Ct_Verifica‡Æo Pilha (apenas para testes, veja manual) +**2CX_Cria tamb‚m biblioteca inteligentemente vinculada +**1d<x>_Define o s¡mbolo <x> +**1D_Gera um arquivo DEF +**2Dd<x>_Ajusta descri‡Æo para <x> +**2Dv<x>_Ajusta versÆo DLL para <x> +*O2Dw_Aplica‡Æo PM +**1e<x>_Ajusta caminho para execut vel +**1E_Mesmo que -Cn +**1fPIC_Mesmo que -Cg +**1F<x>_Ajusta nomes de arquivo e caminhos: +**2Fa<x>[,y]_(para um programa) carregar unidades <x> e [y] antes de analisar cl usula 'uses' +**2Fc<x>_Ajusta entrada p gina de c¢digo para <x> +**2FC<x>_Ajusta nome do compilador RC bin rio para <x> +**2Fd_Disabilita o cache de diret¢rios interno do compilador +**2FD<x>_Ajusta o diret¢rio onde procurar por utilit rios para o compilador +**2Fe<x>_Redireciona sa¡da erros para <x> +**2Ff<x>_Adiciona <x> ao caminho framework (apenas Darwin) +**2FE<x>_Ajusta caminho sa¡da exe/unidade para <x> +**2Fi<x>_Adiciona <x> ao caminho inclusäes +**2Fl<x>_Adiciona <x> ao caminho bibliotecas +**2FL<x>_Use <x> como vinculador dinƒmico +**2Fm<x>_Carrega tabela conversÆo unicode de <x>.txt no dir. do compilador +**2Fo<x>_Adiciona <x> ao caminho objetos +**2Fr<x>_Carrega o arquivo mensagens erro <x> +**2FR<x>_Ajusta vinculador recursos (.res) para <x> +**2Fu<x>_Adiciona <x> ao caminho unidades +**2FU<x>_Ajusta caminho sa¡da unidade para <x>, sobrepäe -FE +**2FW<x>_Armazena retorno otimiza‡Æo completa programa gerada em <x> +**2Fw<x>_Carrega retorno otimiza‡Æo completa programa previamente armazenada de <x> +*g1g_Gerar informa‡äes depura‡Æo (formato padrÆo para o alvo) +*g2gc_Gerar verifica‡äes para ponteiros +*g2gh_Usa unidade heaptrace (para depura‡Æo vazamentos/corrup‡Æo mem¢ria) +*g2gl_Usa unidade informa‡äes linha (mostra mais info. com backtraces) +*g2go<x>_Ajusta op‡äes informa‡äes depura‡Æo +*g3godwarfsets_ Habilita 'conjunto' info. depura‡Æo DWARF (falhas gdb < 6.5) +*g3gostabsabsincludes_ Armazena caminhos absolutos/completos arquivos inclusäes em 'Stabs' +*g3godwarfmethodclassprefix_ Prefixa nomes m‚todos com nome classe em DWARF +*g2gp_Preserva caixa nomes s¡mbolos em 'stabs' +*g2gs_Gera informa‡äes depura‡Æo 'Stabs' +*g2gt_Inutiliza vari veis locais (para detetar utiliza‡Æo de nÆo-inicilizadas) +*g2gv_Gera programas rastre veis com 'Valgrind' +*g2gw_Gera informa‡äes depura‡Æo DWARFv2 (mesmo que -gw2) +*g2gw2_Gera informa‡äes depura‡Æo DWARFv2 +*g2gw3_Gera informa‡äes depura‡Æo DWARFv3 +*g2gw4_Gera informa‡äes depura‡Æo DWARFv4 (experimental) +**1i_Informa‡äes +**2iD_Retorna data compilador +**2iV_Retorna versÆo compilador curta +**2iW_Retorna versÆo compilador completa +**2iSO_Retorna SO compilador +**2iSP_Retorna processador servidor compilador +**2iTO_Retorna SO alvo +**2iTP_Retorna processador alvo +**1I<x>_Adiciona <x> ao caminho inclusäes +**1k<x>_Passa <x> ao vinculador +**1l_Grava logo +**1M<x>_Ajusta modo linguagem para <x> +**2Mfpc_Dialeto Free Pascal (padrÆo) +**2Mobjfpc_Modo FPC com suporte ao Object Pascal +**2Mdelphi_Modo compatibilidade Delphi 7 +**2Mtp_Modo compatibilidade TP/BP 7.0 +**2Mmacpas_Modo compatibilidade dialetos Macintosh Pascal +**1n_NÆo ler os arquivos de configura‡äes padrÆo +**1N<x>_Otimiza‡äes n¢s  rvore +**2Nu_Desdobra la‡os +**1o<x>_Altera o nome do execut vel produzido para <x> +**1O<x>_Otimiza‡äes: +**2O-_Disabilita otimiza‡äes +**2O1_N¡vel 1 otimiza‡äes (r pida e amig vel depurador) +**2O2_N¡vel 2 otimiza‡äes (-O1 + otimiza‡äes r pidas) +**2O3_N¡vel 3 otimiza‡äes (-O2 + otimiza‡äes lentas) +**2Oa<x>=<y>_Ajusta alinhamento +**2Oo[NO]<x>_Habilita ou desabilita otimiza‡äes, veja fpc -i para poss¡veis valores +**2Op<x>_Ajusta cpu alvo para otimiza‡äes, veja fpc -i para poss¡veis valores +**2OW<x>_Gera retorno otimiza‡Æo completa programa para otimiza‡äes <x>, veja fpc -i para poss¡veis valores +**2Ow<x>_Realiza otimiza‡Æo completa programa <x>, veja fpc -i para poss¡veis valores +**2Os_Otimiza tamanho ao inv‚s de velocidade +**1pg_Gera perfil c¢digo para 'gprof' (define FPC_PROFILE) +**1R<x>_Estilo leitura Assembler: +**2Rdefault_Use assembler padrÆo para alvo +3*2Ratt_Leia assembler estilo AT&T +3*2Rintel_Leia assembler estilo Intel +6*2RMOT_Leia assembler estilo motorola +**1S<x>_Op‡äes sintaxe: +**2S2_Mesmo que -Mobjfpc +**2Sc_Suporte operadores similares C (*=,+=,/= and -=) +**2Sa_Liga asser‡äes +**2Sd_Mesmo que -Mdelphi +**2Se<x>_Op‡äes erros. <x> ‚ uma combina‡Æo do seguinte: +**3*_<n> : Compilador para depois de <n> erros (padrÆo ‚ 1) +**3*_w : Compilador tamb‚m para ap¢s avisos +**3*_n : Compilador tamb‚m para ap¢s notas +**3*_h : Compilador tamb‚m para ap¢s dicas +**2Sg_Habilita LABEL e GOTO (padrÆo em -Mtp e -Mdelphi) +**2Sh_Use 'ansistrings' por padrÆo ao inv‚s de 'shortstrings' +**2Si_Liga 'inlining' de procedimentos/fun‡äes declaradas como "em-linha" (inline) +**2Sk_Carrega unidade 'fpcylix' +**2SI<x>_Ajusta estilo interface para <x> +**3SIcom_COM interface compat¡vel (padrÆo) +**3SIcorba_CORBA interface compat¡vel +**2Sm_Suporta macros semelhantes C (global) +**2So_Mesmo que -Mtp +**2Ss_Nome construtor deve ser 'init' (destruidor deve ser 'done') +**2Sx_Habilita palavras-chave exce‡äes (padrÆo nos modos Delphi/ObjFPC) +**2Sy_@<ponteiro> retorna um ponteiro tipado, mesmo que $T+ +**1s_NÆo chama o montador assembler e o vinculador +**2sh_Gera roteiro para vincular no servidor +**2st_Gera roteiro para vincular no alvo +**2sr_Pula fase aloca‡Æo registro (use com -alr) +**1T<x>_Sistema operacional alvo: +3*2Tdarwin_Darwin/Mac OS X +3*2Temx_OS/2 via EMX (incluidos extensor EMX/RSX) +3*2Tfreebsd_FreeBSD +3*2Tgo32v2_VersÆo 2 do extensor DOS DJ Delorie +3*2Tiphonesim_ iPhoneSimulator do iOS SDK 3.2+ (versäes antigas: -Tdarwin) +3*2Tlinux_Linux +3*2Tnetbsd_NetBSD +3*2Tnetware_M¢dulo Novell Netware (clib) +3*2Tnetwlibc_M¢dulo Novell Netware (libc) +3*2Topenbsd_OpenBSD +3*2Tos2_OS/2 / eComStation +3*2Tsunos_SunOS/Solaris +3*2Tsymbian_Symbian OS +3*2Tsolaris_Solaris +3*2Twatcom_Watcom compatible DOS extender +3*2Twdosx_WDOSX DOS extender +3*2Twin32_Windows 32 Bit +3*2Twince_Windows CE +4*2Tdarwin_Darwin/Mac OS X +4*2Tlinux_Linux +4*2Twin64_Win64 (sistemas Windows 64 bit) +6*2Tamiga_Commodore Amiga +6*2Tatari_Atari ST/STe/TT +6*2Tlinux_Linux +6*2Tpalmos_PalmOS +A*2Tdarwin_Darwin/iPhoneOS/iOS +A*2Tlinux_Linux +A*2Twince_Windows CE +P*2Tamiga_AmigaOS +P*2Tdarwin_Darwin/Mac OS X +P*2Tlinux_Linux +P*2Tmacos_Mac OS (cl ssico) +P*2Tmorphos_MorphOS +S*2Tsolaris_Solaris +S*2Tlinux_Linux +**1u<x>_Indefine o s¡mbolo <x> +**1U_Op‡äes unidades: +**2Un_NÆo verifica onde o nome unidade coincide com o nome arquivo +**2Ur_Gera arquivos lan‡amento unidades (nunca automaticamente recompilado) +**2Us_Compilar uma unidade sistema +**1v<x>_Ser detalhado. <x> ‚ uma combina‡Æo das seguintes letras: +**2*_e : Mostra erros (padrÆo) 0 : Nada mostra (exceto erros) +**2*_w : Mostra avisos u : Mostra info. unidade +**2*_n : Mostra notas t : Mostra arquivos tentados/usados +**2*_h : Mostra dicas c : Mostra condicionais +**2*_i : Mostra info. geral d : Mostra info. depura‡Æo +**2*_l : Mostra n£meros linhas r : Modo compatibilidade Rhide/GCC +**2*_s : Mostra Data/Hora q : Mostra n£meros mensagens +**2*_a : Mostra tudo x : Info. execut vel (apenas Win32) +**2*_b : Grava mensagens nome arqs. p : Grava tree.log com  rvore an lise +**2*_ com caminho completo v : Grava fpcdebug.txt com muitas +**2*_ informa‡äes de depura‡Æo +**2*_m<x>,<y> : NÆo mostra mensagens numeradas <x> e <y> +**1W<x>_Op‡äes espec¡ficas do alvo (alvos) +3*2WA_Especifica aplica‡Æo do tipo nativo (Windows) +4*2WA_Especifica aplica‡Æo do tipo nativo (Windows) +A*2WA_Especifica aplica‡Æo do tipo nativo (Windows) +3*2Wb_Cria um encarte ao inv‚s de uma biblioteca (Darwin) +P*2Wb_Cria um encarte ao inv‚s de uma biblioteca (Darwin) +p*2Wb_Cria um encarte ao inv‚s de uma biblioteca (Darwin) +A*2Wb_Cria um encarte ao inv‚s de uma biblioteca (Darwin) +4*2Wb_Cria um encarte ao inv‚s de uma biblioteca (Darwin) +3*2WB_Cria uma imagem reloc vel (Windows, Symbian) +3*2WBxxxx_Define base da imagem para xxxx (Windows, Symbian) +4*2WB_Cria uma imagem reloc vel (Windows) +4*2WBxxxx_Define base da imagem para xxxx (Windows) +A*2WB_Cria uma imagem reloc vel (Windows, Symbian) +A*2WBxxxx_Define base da imagem para xxxx (Windows, Symbian) +3*2WC_Especifica aplica‡Æo do tipo console (EMX, OS/2, Windows) +4*2WC_Especifica aplica‡Æo do tipo console (EMX, OS/2, Windows) +A*2WC_Especifica aplica‡Æo do tipo console (Windows) +P*2WC_Especifica aplica‡Æo do tipo console (Classic Mac OS) +3*2WD_Usa DEFFILE para exportar fun‡äes de DLL ou EXE (Windows) +4*2WD_Usa DEFFILE para exportar fun‡äes de DLL ou EXE (Windows) +A*2WD_Usa DEFFILE para exportar fun‡äes de DLL ou EXE (Windows) +3*2We_Usa recursos externos (Darwin) +4*2We_Usa recursos externos (Darwin) +A*2We_Usa recursos externos (Darwin) +P*2We_Usa recursos externos (Darwin) +p*2We_Usa recursos externos (Darwin) +3*2WF_Especifica aplica‡Æo do tipo tela-cheia (EMX, OS/2) +3*2WG_Especifica aplica‡Æo do tipo gr fica (EMX, OS/2, Windows) +4*2WG_Especifica aplica‡Æo do tipo gr fica (EMX, OS/2, Windows) +A*2WG_Especifica aplica‡Æo do tipo gr fica (Windows) +P*2WG_Especifica aplica‡Æo do tipo gr fica (Classic Mac OS) +3*2Wi_Usa recursos internos (Darwin) +4*2Wi_Usa recursos internos (Darwin) +A*2Wi_Usa recursos internos (Darwin) +P*2Wi_Usa recursos internos (Darwin) +p*2Wi_Usa recursos internos (Darwin) +3*2WI_Liga/desliga o uso de se‡äes de importa‡Æo (Windows) +4*2WI_Liga/desliga o uso de se‡äes de importa‡Æo (Windows) +A*2WI_Liga/desliga o uso de se‡äes de importa‡Æo (Windows) +3*2WN_NÆo gera c¢digo de reloca‡Æo, necess rio para depura‡Æo (Windows) +4*2WN_NÆo gera c¢digo de reloca‡Æo, necess rio para depura‡Æo (Windows) +A*2WN_NÆo gera c¢digo de reloca‡Æo, necess rio para depura‡Æo (Windows) +A*2Wpxxxx_Especifica o tipo de controlador, veja fpc -i para valores poss¡veis +V*2Wpxxxx_Especifica o tipo de controlador, veja fpc -i para valores poss¡veis +3*2WR_Gera c¢digo de reloca‡Æo (Windows) +4*2WR_Gera c¢digo de reloca‡Æo (Windows) +A*2WR_Gera c¢digo de reloca‡Æo (Windows) +P*2WT_Especifica aplica‡Æo do tipo ferramenta MPW (Classic Mac OS) +**2WX_Habilita pilha execut vel (Linux) +**1X_Op‡äes do execut vel: +**2Xc_Passar --shared/-dynamic para o vinculador (BeOS, Darwin, FreeBSD, Linux) +**2Xd_NÆo usar caminho padrÆo de busca de biblioteca (necess rio para compila‡Æo cross) +**2Xe_Usar vinculador externo +**2Xg_Cria informa‡Æo de depura‡Æo em um arquivo separado e adiciona uma se‡Æo de v¡nculo de depura‡Æo ao execut vel +**2XD_Tenta vincular unidades dinamicamente (define FPC_LINK_DYNAMIC) +**2Xi_Usa vinculador interno +**2Xm_Gera mapa de vincula‡Æo +**2XM<x>_Define o nome da rotina 'main' do programa (padrÆo ‚ 'main') +**2XP<x>_Apensa os nomes 'binutils' com o prefixo <x> +**2Xr<x>_Define o caminho-rlink do vinculador para <x> (necess rio para compila‡Æo 'cross', veja o manual do 'ld' para maiores informa‡äes) (BeOS, Linux) +**2XR<x>_Apensa todos os caminhos de busca do vinculador com <x> (BeOS, Darwin, FreeBSD, Linux, Mac OS, Solaris) +**2Xs_Remove todos os s¡mbolos do execut vel +**2XS_Tenta vincular unidades estaticamente (padrÆo, define FPC_LINK_STATIC) +**2Xt_Vincula com bibliotecas est ticas (-static ‚ passado ao vinculador) +**2XX_Tenta a vincula‡Æo inteligente de unidades (define FPC_LINK_SMART) +**1*_ +**1?_Exibe esta ajuda +**1h_Exibe esta ajuda sem espera +] + +# +# The End... diff --git a/closures/compiler/msg/errorptu.msg b/closures/compiler/msg/errorptu.msg new file mode 100644 index 0000000000..186279067f --- /dev/null +++ b/closures/compiler/msg/errorptu.msg @@ -0,0 +1,3447 @@ +# +# This file is part of the Free Pascal Compiler +# Copyright (c) 1999-2009 by the Free Pascal Development team +# +# Portuguese (UTF-8) language file for Free Pascal Compiler +# Contributed by Marcelo B Paula, based on errore.msg SVN Rev.19883 +# Former translator: Ari Ricardo Ody <ary.odi at japinfo.com.br> +# +# 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. +# +# +# The constants are build in the following order: +# <part>_<type>_<txtidentifier> +# +# <part> is the part of the compiler the message is used +# asmr_ assembler parsing +# asmw_ assembler writing/binary writers +# unit_ unit handling +# scan_ scanner +# parser_ parser +# type_ type checking +# general_ general info +# exec_ calls to assembler, external linker, binder +# link_ internal linker +# +# <type> the type of the message it should normally used for +# f_ fatal error +# e_ error +# w_ warning +# n_ note +# h_ hint +# i_ info +# l_ add linenumber +# u_ used +# t_ tried +# c_ conditional +# d_ debug message +# x_ executable informations +# o_ normal (e.g., "press enter to continue") +# +# <type> can contain a minus sign at the beginning to mark that +# the message is off by default. Look at type_w_explicit_string_cast +# for example. + +# +# General +# +# 01023 is the last used one +# +# BeginOfTeX +% \section{General compiler messages} +% This section gives the compiler messages which are not fatal, but which +% display useful information. The number of such messages can be +% controlled with the various verbosity level \var{-v} switches. +% \begin{description} +general_t_compilername=01000_T_Compilador: $1 +% When the \var{-vt} switch is used, this line tells you what compiler +% is used. +general_d_sourceos=01001_D_SO Compilador: $1 +% When the \var{-vd} switch is used, this line tells you what the source +% operating system is. +general_i_targetos=01002_I_SO Alvo: $1 +% When the \var{-vd} switch is used, this line tells you what the target +% operating system is. +general_t_exepath=01003_T_Usando caminho executável: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its binaries. +general_t_unitpath=01004_T_Usando caminho unidade: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for compiled units. You can set this path with the \var{-Fu} option. +general_t_includepath=01005_T_Usando caminho inclusões: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its include files (files used in \var{\{\$I xxx\}} statements). +% You can set this path with the \var{-Fi} option. +general_t_librarypath=01006_T_Usando caminho biblioteca: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for the libraries. You can set this path with the \var{-Fl} option. +general_t_objectpath=01007_T_Usando caminho objeto: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for object files you link in (files used in \var{\{\$L xxx\}} statements). +% You can set this path with the \var{-Fo} option. +general_i_abslines_compiled=01008_I_$1 linhas compiladas, $2 seg$3 +% When the \var{-vi} switch is used, the compiler reports the number +% of lines compiled, and the time it took to compile them (real time, +% not program time). +general_f_no_memory_left=01009_F_Memória insuficiente +% The compiler doesn't have enough memory to compile your program. There are +% several remedies for this: +% \begin{itemize} +% \item If you're using the build option of the compiler, try compiling the +% different units manually. +% \item If you're compiling a huge program, split it up into units, and compile +% these separately. +% \item If the previous two don't work, recompile the compiler with a bigger +% heap. (You can use the \var{-Ch} option for this, \seeo{Ch}.) +% \end{itemize} +general_i_writingresourcefile=01010_I_Gravando arquivo Tabela Recursos 'String': $1 +% This message is shown when the compiler writes the Resource String Table +% file containing all the resource strings for a program. +general_e_errorwritingresourcefile=01011_E_Gravando arquivo Tabela Recursos 'String': $1 +% This message is shown when the compiler encounters an error when writing +% the Resource String Table file. +general_i_fatal=01012_I_Fatal: +% Prefix for Fatal Errors. +general_i_error=01013_I_Erro: +% Prefix for Errors. +general_i_warning=01014_I_Aviso: +% Prefix for Warnings. +general_i_note=01015_I_Nota: +% Prefix for Notes. +general_i_hint=01016_I_Dica: +% Prefix for Hints. +general_e_path_does_not_exist=01017_E_Caminho "$1" não existe +% The specified path does not exist. +general_f_compilation_aborted=01018_F_Compilação abortada +% Compilation was aborted. +general_text_bytes_code=01019_bytes (código gerado) +% The size of the generated executable code, in bytes. +general_text_bytes_data=01020_bytes (dados gerados) +% The size of the generated program data, in bytes. +general_i_number_of_warnings=01021_I_$1 aviso(s) emitido(s) +% Total number of warnings issued during compilation. +general_i_number_of_hints=01022_I_$1 dica(s) emitida(s) +% Total number of hints issued during compilation. +general_i_number_of_notes=01023_I_$1 nota(s) emitida(s) +% Total number of notes issued during compilation. +general_f_ioerror=01024_F_Erro E/S: $1 +% During compilation an I/O error happened which allows no further compilation. +general_f_oserror=01025_F_Erro do sistema operacional: $1 +% During compilation an operanting system error happened which allows no further compilation. +% \end{description} +# +# Scanner +# +# 02087 is the last used one +# +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compilation handling. +% \begin{description} +scan_f_end_of_file=02000_F_Fim de arquivo inesperado +% This typically happens in one of the following cases: +% \begin{itemize} +% \item The source file ends before the final \var{end.} statement. This +% happens mostly when the \var{begin} and \var{end} statements aren't +% balanced; +% \item An include file ends in the middle of a statement. +% \item A comment was not closed. +% \end{itemize} +scan_f_string_exceeds_line=02001_F_'String' excendo linha +% There is a missing closing ' in a string, so it occupies +% multiple lines. +scan_f_illegal_char=02002_F_caractere ilegal "$1" ($2) +% An illegal character was encountered in the input file. +scan_f_syn_expected=02003_F_Erro sintaxe, "$1" esperado, mas "$2" encontrado +% This indicates that the compiler expected a different token than +% the one you typed. It can occur almost anywhere it is possible to make an error +% against the Pascal language. +scan_t_start_include_file=02004_TL_Iniciando leitura arquivo de inclusões $1 +% When you provide the \var{-vt} switch, the compiler tells you +% when it starts reading an included file. +scan_w_comment_level=02005_W_Nível comentário $1 encontrado +% When the \var{-vw} switch is used, then the compiler warns you if +% it finds nested comments. Nested comments are not allowed in Turbo Pascal +% and Delphi, and can be a possible source of errors. +scan_n_ignored_switch=02008_N_Ignorar chave compilador "$1" +% With \var{-vn} on, the compiler warns if it ignores a switch. +scan_w_illegal_switch=02009_W_Chave ilegal compilador "$1" +% You included a compiler switch (i.e. \var{\{\$... \}}) which the compiler +% does not recognise. +scan_w_switch_is_global=02010_W_Chave global compilador fora de lugar +% The compiler switch is misplaced, and should be located at +% the start of the unit or program. +scan_e_illegal_char_const=02011_E_Constante caractere ilegal +% This happens when you specify a character with its ASCII code, as in +% \var{\#96}, but the number is either illegal, or out of range. +scan_f_cannot_open_input=02012_F_Impossível abrir arquivo "$1" +% \fpc cannot find the program or unit source file you specified on the +% command line. +scan_f_cannot_open_includefile=02013_F_Impossível abrir arquivo de inclusões "$1" +% \fpc cannot find the source file you specified in a \var{\{\$include ..\}} +% statement. +scan_e_illegal_pack_records=02015_E_Especificador alinhamento registro ilegal "$1" +% You are specifying \var{\{\$PACKRECORDS n\} } or \var{\{\$ALIGN n\} } +% with an illegal value for \var{n}. For \$PACKRECORDS valid alignments are 1, 2, 4, 8, 16, 32, C, +% NORMAL, DEFAULT, and for \$ALIGN valid alignments are 1, 2, 4, 8, 16, 32, ON, +% OFF. Under mode MacPas \$ALIGN also supports MAC68K, POWER and RESET. +scan_e_illegal_pack_enum=02016_E_Especificador tamanho-mínimo enumeração ilegal "$1" +% You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for +% \var{n}. Only 1,2,4, NORMAL or DEFAULT is valid here. +scan_e_endif_expected=02017_E_$ENDIF esperado para $1 $2 definido em $3 linha $4 +% Your conditional compilation statements are unbalanced. +scan_e_preproc_syntax_error=02018_E_Erro sintaxe enquanto analisando uma expressão compilação condicional +% There is an error in the expression following the \var{\{\$if ..\}}, \var{\{\$ifc \}} +% or \var{\{\$setc \}} compiler directives. +scan_e_error_in_preproc_expr=02019_E_Avaliando uma expressão compilação condicional +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc compiler +% directives. +scan_w_macro_cut_after_255_chars=02020_W_Conteúdo macro limitada ao tamanho de 255 caracteres +% The contents of macros cannot be longer than 255 characters. +scan_e_endif_without_if=02021_E_ENDIF sem IF(N)DEF +% Your \var{\{\$IFDEF ..\}} and {\{\$ENDIF\}} statements aren't balanced. +scan_f_user_defined=02022_F_Definido pelo usuário: $1 +% A user defined fatal error occurred. See also the \progref. +scan_e_user_defined=02023_E_Definido pelo usuário: $1 +% A user defined error occurred. See also the \progref. +scan_w_user_defined=02024_W_Definido pelo usuário: $1 +% A user defined warning occurred. See also the \progref. +scan_n_user_defined=02025_N_Definido pelo usuário: $1 +% A user defined note was encountered. See also the \progref. +scan_h_user_defined=02026_H_Definido pelo usuário: $1 +% A user defined hint was encountered. See also the \progref. +scan_i_user_defined=02027_I_Definido pelo usuário: $1 +% User defined information was encountered. See also the \progref. +scan_e_keyword_cant_be_a_macro=02028_E_Palavra-chave redefinida como macro não tem efeito +% You cannot redefine keywords with macros. +scan_f_macro_buffer_overflow=02029_F_Transbordamento "buffer" macro durante leitura ou expansão de uma macro +% Your macro or its result was too long for the compiler. +scan_w_macro_too_deep=02030_W_Expansão de macros excede profundidade de 16. +% When expanding a macro, macros have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_w_wrong_styled_switch=02031_W_chaves compilador não são suportadas no estilo de comentário // +% Compiler switches should be in normal Pascal style comments. +scan_d_handling_switch=02032_DL_Chave manipulação "$1" +% When you set debugging info on (\var{-vd}) the compiler tells you when it +% is evaluating conditional compile statements. +scan_c_endif_found=02033_CL_ENDIF $1 encontrado +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifdef_found=02034_CL_IFDEF $1 encontrado, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifopt_found=02035_CL_IFOPT $1 encontrado, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_if_found=02036_CL_IF $1 encontrado, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifndef_found=02037_CL_IFNDEF $1 encontrado, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_else_found=02038_CL_ELSE $1 encontrado, $2 +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_skipping_until=02039_CL_Pulando até... +% When you turn on conditional messages (\var{-vc}), the compiler tells you +% where it encounters conditional statements, and whether it is skipping or +% compiling parts. +scan_i_press_enter=02040_I_Tecle <return> para continuar +% When the \var{-vi} switch is used, the compiler stops compilation +% and waits for the \var{Enter} key to be pressed when it encounters +% a \var{\{\$STOP\}} directive. +scan_w_unsupported_switch=02041_W_Chave não suportada "$1" +% When warnings are turned on (\var{-vw}), the compiler warns you about +% unsupported switches. This means that the switch is used in Delphi or +% Turbo Pascal, but not in \fpc. +scan_w_illegal_directive=02042_W_Diretiva compilador ilegal "$1" +% When warnings are turned on (\var{-vw}), the compiler warns you about +% unrecognised switches. For a list of recognised switches, see the \progref. +scan_t_back_in=02043_TL_De volta $1 +% When you use the \var{-vt} switch, the compiler tells you when it has finished +% reading an include file. +scan_w_unsupported_app_type=02044_W_Tipo aplicação não suportada: "$1" +% You get this warning if you specify an unknown application type +% with the directive \var{\{\$APPTYPE\}}. +scan_w_app_type_not_support=02045_W_APPTYPE não é suportado pelo SO alvo +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_w_description_not_support=02046_W_DESCRIPTION não é suportado pelo SO alvo +% The \var{\{\$DESCRIPTION\}} directive is not supported on this target OS. +scan_n_version_not_support=02047_N_VERSION não é suportado pelo SO alvo +% The \var{\{\$VERSION\}} directive is not supported on this target OS. +scan_n_only_exe_version=02048_N_VERSION apenas para EXEs ou DLLs +% The \var{\{\$VERSION\}} directive is only used for executable or DLL sources. +scan_w_wrong_version_ignored=02049_W_Formato incorreto para a diretiva VERSION "$1" +% The \var{\{\$VERSION\}} directive format is majorversion.minorversion +% where majorversion and minorversion are words. +scan_e_illegal_asmmode_specifier=02050_E_Estilo especificado assembler ilegal "$1" +% When you specify an assembler mode with the \var{\{\$ASMMODE xxx\}} directive, +% the compiler didn't recognize the mode you specified. +scan_w_no_asm_reader_switch_inside_asm=02051_W_ASM reader switch is not possible inside asm statement, "$1" will be effective only for next +% It is not possible to switch from one assembler reader to another +% inside an assembler block. The new reader will be used for next +% assembler statements only. +scan_e_wrong_switch_toggle=02052_E_Chave alternância incorreta, usar ON/OFF ou +/- +% You need to use ON or OFF or a + or - to toggle the switch. +scan_e_resourcefiles_not_supported=02053_E_Arquivo recursos não suportado para este alvo +% The target you are compiling for doesn't support resource files. +scan_w_include_env_not_found=02054_W_Variável inclusão ambiente "$1" não encontrado no ambiente +% The included environment variable can't be found in the environment; it will +% be replaced by an empty string instead. +scan_e_invalid_maxfpureg_value=02055_E_Valor ilegal para o registrador limite UPF +% Valid values for this directive are 0..8 and NORMAL/DEFAULT. +scan_w_only_one_resourcefile_supported=02056_W_Apenas um arquivo de recursos é suportado para este alvo +% The target you are compiling for supports only one resource file. +% The first resource file found is used, the others are discarded. +scan_w_macro_support_turned_off=02057_W_Suporte Macro foi desativado +% A macro declaration has been found, but macro support is currently off, +% so the declaration will be ignored. To turn macro support on compile with +% -Sm on the command line or add \{\$MACRO ON\} in the source. +scan_e_invalid_interface_type=02058_E_Tipo ilegal de interface especificado. São válidos COM, CORBA ou DEFAULT. +% The interface type that was specified is not supported. +scan_w_appid_not_support=02059_W_APPID é suportado apenas para PalmOS +% The \var{\{\$APPID\}} directive is only supported for the PalmOS target. +scan_w_appname_not_support=02060_W_APPNAME é suportado apenas para PalmOS +% The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target. +scan_e_string_exceeds_255_chars=02061_E_Constante 'String' não pode ser maior que 255 caracteres +% A single string constant can contain at most 255 chars. Try splitting up the +% string into multiple smaller parts and concatenate them with a + operator. +scan_f_include_deep_ten=02062_F_Incluindo arquivos inclusão excede um nível de 16. +% When including include files the files have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_e_too_many_push=02063_F_Muitos níveis de PUSH. Max. 20 +% A maximum of 20 levels is allowed. This error occurs only in mode MacPas. +scan_e_too_many_pop=02064_E_Um POP sem um PUSH anterior +% This error occurs only in mode MacPas. +scan_e_error_macro_lacks_value=02065_E_Macro ou variável tempo compilação "$1" sem nenhum valor +% Thus the conditional compile time expression cannot be evaluated. +scan_e_wrong_switch_toggle_default=02066_E_Chave alternância incorreta, usar ON/OFF/DEFAULT ou +/-/* +% You need to use ON or OFF or DEFAULT or a + or - or * to toggle the switch. +scan_e_mode_switch_not_allowed=02067_E_Chave modo "$1" não permitida aqui +% A mode switch has already been encountered, or, in the case of option -Mmacpas, +% a mode switch occurs after UNIT. +scan_e_error_macro_undefined=02068_E_Variável tempo compilação ou macro "$1" não definida. +% Thus the conditional compile time expression cannot be evaluated. Only in mode MacPas. +scan_e_utf8_bigger_than_65535=02069_E_Código UTF-8 maior que 65535 encontrado +% \fpc handles UTF-8 strings internally as widestrings, i.e. the char codes are limited to 65535. +scan_e_utf8_malformed=02070_E_'String' UTF-8 mal-formada +% The given string isn't a valid UTF-8 string. +scan_c_switching_to_utf8=02071_C_Assinatura UTF-8 encontrada, usando codificação UTF-8 +% The compiler found a UTF-8 encoding signature (\$ef, \$bb, \$bf) at the beginning of a file, +% so it interprets it as a UTF-8 file. +scan_e_compile_time_typeerror=02072_E_Expressão tempo compilação: Procurado $1 mas obtido $2 na $3 +% The type-check of a compile time expression failed. +scan_n_app_type_not_support=02073_N_APPTYPE não é suportado pelo SO alvo +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_e_illegal_optimization_specifier=02074_E_Otimização especificada ilegal "$1" +% You specified an optimization with the \var{\{\$OPTIMIZATION xxx\}} directive, +% and the compiler didn't recognize the optimization you specified. +scan_w_setpeflags_not_support=02075_W_SETPEFLAGS não é suportado pelo SO alvo +% The \var{\{\$SETPEFLAGS\}} directive is not supported by the target OS. +scan_w_imagebase_not_support=02076_W_IMAGEBASE não é suportado pelo SO alvo +% The \var{\{\$IMAGEBASE\}} directive is not supported by the target OS. +scan_w_minstacksize_not_support=02077_W_MINSTACKSIZE não é suportado pelo SO alvo +% The \var{\{\$MINSTACKSIZE\}} directive is not supported by the target OS. +scan_w_maxstacksize_not_support=02078_W_MAXSTACKSIZE não é suportado pelo SO alvo +% The \var{\{\$MAXSTACKSIZE\}} directive is not supported by the target OS. +scanner_e_illegal_warn_state=02079_E_Estado "$1" ilegal para a diretiva $WARN +% Only ON and OFF can be used as state with a \var{\{\$WARN\}} compiler directive. +scan_e_only_packset=02080_E_Valor ilegal para conjunto empacotamento +% Only 0, 1, 2, 4, 8, DEFAULT and NORMAL are allowed as packset parameters. +scan_w_pic_ignored=02081_W_Diretiva PIC ou chave ignorada +% Several targets, such as \windows, do not support nor need PIC, +% so the PIC directive and switch are ignored. +scan_w_unsupported_switch_by_target=02082_W_A chave "$1" não é suportada pelo alvo selecionado atualmente +% Some compiler switches like \$E are not supported by all targets. +scan_w_frameworks_darwin_only=02084_W_Opções relacionadas a "Framework" são apenas suportadas para Darwin/Mac OS X +% Frameworks are not a known concept, or at least not supported by FPC, +% on operating systems other than Darwin/Mac OS X. +scan_e_illegal_minfpconstprec=02085_E_Constante precisão mínima ponto flutuante ilegal "$1" +% Valid minimal precisions for floating point constants are default, 32 and 64, +% which mean respectively minimal (usually 32 bit), 32 bit and 64 bit precision. +scan_w_multiple_main_name_overrides=02086_W_Sobrescrevendo nome do procedimento "main" múltiplas vezes, foi previamente ajustado para "$1" +% The name for the main entry procedure is specified more than once. Only the last +% name will be used. +scanner_w_illegal_warn_identifier=02087_W_Identificador "$1" ilegal para a diretiva $WARN +% Identifier is not known by a \var{\{\$WARN\}} compiler directive. +scanner_e_illegal_alignment_directive=02088_E_Diretiva de alinhamento ilegal +% The alignment directive is not valid. Either the alignment type is not known or the alignment +% value is not a power of two. +% \end{description} +# +# Parser +# +# 03314 is the last used one +# +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your Pascal constructs +% are correct. +% \begin{description} +parser_e_syntax_error=03000_E_Analizador - Erro sintaxe +% An error against the Turbo Pascal language was encountered. This typically +% happens when an illegal character is found in the source file. +parser_e_dont_nest_interrupt=03004_E_Procedimento INTERRUPT não pode ser aninhado +% An \var{INTERRUPT} procedure must be global. +parser_w_proc_directive_ignored=03005_W_Tipo procedimento "$1" ignorado +% The specified procedure directive is ignored by FPC programs. +parser_e_no_overload_for_all_procs=03006_E_Nem todas as declarações de "$1" estão declaradas com OVERLOAD +% When you want to use overloading using the \var{OVERLOAD} directive, then +% all declarations need to have \var{OVERLOAD} specified. +parser_e_export_name_double=03008_E_Nome função exportada duplicada "$1" +% Exported function names inside a specific DLL must all be different. +parser_e_export_ordinal_double=03009_E_Ãndice função exportada duplicada $1 +% Exported function indexes inside a specific DLL must all be different. +parser_e_export_invalid_index=03010_E_índice inválido para função exportada +% DLL function index must be in the range \var{1..\$FFFF}. +parser_w_parser_reloc_no_debug=03011_W_Informação depuração DLL relocável ou executável $1 não funciona, desabilitado. +% It is currently not possible to include debug information in a relocatable DLL. +parser_w_parser_win32_debug_needs_WN=03012_W_Para permitir depuração para código win32 você necessita desabilitar relocação com opção -WN +% Stabs debug info is wrong for relocatable DLL or EXES. Use -WN +% if you want to debug win32 executables. +parser_e_constructorname_must_be_init=03013_E_Nome Construtor deve ser INIT +% You are declaring an object constructor with a name which is not \var{init}, and the +% \var{-Ss} switch is in effect. See the switch \seeo{Ss}. +parser_e_destructorname_must_be_done=03014_E_Nome Destruidor deve ser DONE +% You are declaring an object destructor with a name which is not \var{done}, and the +% \var{-Ss} switch is in effect. See the switch \seeo{Ss}. +parser_e_proc_inline_not_supported=03016_E_Tipo procedimento INLINE não suportado +% You tried to compile a program with C++ style inlining, and forgot to +% specify the \var{-Si} option (\seeo{Si}). The compiler doesn't support C++ +% styled inlining by default. +parser_w_constructor_should_be_public=03018_W_Construtor deve ser público +% Constructors must be in the 'public' part of an object (class) declaration. +parser_w_destructor_should_be_public=03019_W_Destruidor deve ser público +% Destructors must be in the 'public' part of an object (class) declaration. +parser_n_only_one_destructor=03020_N_Classe deve ter apenas um destruidor +% You can declare only one destructor for a class. +parser_e_no_local_objects=03021_E_Definições classe local não permitidas +% Classes must be defined globally. They cannot be defined inside a +% procedure or function. +parser_f_no_anonym_objects=03022_F_Definições classe anônima não permitidas +% An invalid object (class) declaration was encountered, i.e. an +% object or class without methods that isn't derived from another object or +% class. For example: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% will trigger this error. +parser_n_object_has_no_vmt=03023_N_O objeto "$1" não tem VMT +% This is a note indicating that the declared object has no +% virtual method table. +parser_e_illegal_parameter_list=03024_E_Lista parâmetros ilegal +% You are calling a function with parameters that are of a different type than +% the declared parameters of the function. +parser_e_wrong_parameter_size=03026_E_Número incorreto de parâmetros especificado para chamada de "$1" +% There is an error in the parameter list of the function or procedure -- +% the number of parameters is not correct. +parser_e_overloaded_no_procedure=03027_E_Identificador sobrecarregado "$1" não é uma função +% The compiler encountered a symbol with the same name as an overloaded +% function, but it is not a function it can overload. +parser_e_overloaded_have_same_parameters=03028_E_Funções sobrecarregadas têm a mesma lista de parâmetros +% You're declaring overloaded functions, but with the same parameter list. +% Overloaded function must have at least 1 different parameter in their +% declaration. +parser_e_header_dont_match_forward=03029_E_Cabeçalho da função não coincide com a declaração anterior de "$1" +% You declared a function with the same parameters but +% different result type or function modifiers. +parser_e_header_different_var_names=03030_E_Cabeçalho função "$1" não coincide com posterior : nome var modifica $2 => $3 +% You declared the function in the \var{interface} part, or with the +% \var{forward} directive, but defined it with a different parameter list. +parser_n_duplicate_enum=03031_N_Valores tipo enumeração têm que ser ascendentes +% \fpc allows enumeration constructions as in C. Examine the following +% two declarations: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% The second declaration would produce an error. \var{A\_UAS} needs to have a +% value higher than \var{A\_E}, i.e. at least 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_With não pode ser usado para variáveis em segmentos diferentes +% With stores a variable locally on the stack, +% but this is not possible if the variable belongs to another segment. +parser_e_too_much_lexlevel=03034_E_Aninhamento função > 31 +% You can nest function definitions only 31 levels deep. +parser_e_range_check_error=03035_E_Erro verificação de faixa enquanto avaliando constantes +% The constants are out of their allowed range. +parser_w_range_check_error=03036_W_Erro verificação de faixa enquanto avaliando constantes +% The constants are out of their allowed range. +parser_e_double_caselabel=03037_E_Rótulo duplicado declaração "case" +% You are specifying the same label 2 times in a \var{case} statement. +parser_e_case_lower_less_than_upper_bound=03038_E_Limite superior da faixa declaração "case" é menor que o limite inferior +% The upper bound of a \var{case} label is less than the lower bound and this +% is useless. +parser_e_type_const_not_possible=03039_E_Constantes tipadas de classes ou interfaces não são permitidas +% You cannot declare a constant of type class or object. +parser_e_no_overloaded_procvars=03040_E_Variáveis função de funções sobrecarregadas não são permitidas +% You are trying to assign an overloaded function to a procedural variable. +% This is not allowed. +parser_e_invalid_string_size=03041_E_Comprimento 'String' deve ter valor entre 1 à 255 +% The length of a shortstring in Pascal is limited to 255 characters. You are +% trying to declare a string with length less than 1 or greater than 255. +parser_w_use_extended_syntax_for_objects=03042_W_Use sintaxe extendida de NEW e DISPOSE para instanciar objetos +% If you have a pointer \var{a} to an object type, then the statement +% \var{new(a)} will not initialize the object (i.e. the constructor isn't +% called), although space will be allocated. You should issue the +% \var{new(a,init)} statement. This will allocate space, and call the +% constructor of the object. +parser_w_no_new_dispose_on_void_pointers=03043_W_Uso de NEW ou DISPOSE para ponteiros não tipados não tem sentido +parser_e_no_new_dispose_on_void_pointers=03044_E_Uso de NEW ou DISPOSE não é possível para ponteiros não tipados +% You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer +% because no size is associated to an untyped pointer. +% It is accepted for compatibility in \var{TP} and \var{DELPHI} modes, but the +% compiler will still warn you if it finds such a construct. +parser_e_class_id_expected=03045_E_Identificador de classe esperado +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., an object or class method, but the type in front of the dot is not +% a known type. +parser_e_no_type_not_allowed_here=03046_E_Identificador tipo não permitido aqui +% You cannot use a type inside an expression. +parser_e_methode_id_expected=03047_E_Identificador de método esperado +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., an object or class method, but the procedure name is not a +% procedure of this type. +parser_e_header_dont_match_any_member=03048_E_Cabeçalho função não coincide com qualquer método desta classe "$1" +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., an object or class method, but the procedure name is not a +% procedure of this type. +parser_d_procedure_start=03049_DL_Procedimento/função $1 +% When using the \var{-vd} switch, the compiler tells you when it starts +% processing a procedure or function implementation. +parser_e_error_in_real=03050_E_Constante ponto flutuante ilegal +% The compiler expects a floating point expression, and gets something else. +parser_e_fail_only_in_constructor=03051_E_FAIL só pode ser usado em contrutores +% You are using the \var{fail} keyword outside a constructor method. +parser_e_no_paras_for_destructor=03052_E_Destruidores não podem ter parâmetros +% You are declaring a destructor with a parameter list. Destructor methods +% cannot have parameters. +parser_e_only_class_members_via_class_ref=03053_E_Apenas métodos, propriedades e variáveis de classe podem ser referenciadas por referências classe +% This error occurs in a situation like the following: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} is not a class method and hence cannot be called with a class +% reference. +parser_e_only_class_members=03054_E_Apenas métodos, propriedades e variáveis de classe podem ser acessadas em métodos de classe +% This is related to the previous error. You cannot call a method of an object +% from inside a class method. The following code would produce this error: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% Because free is a normal method of a class it cannot be called from a class +% method. +parser_e_case_mismatch=03055_E_Constante e tipo CASE incompatíveis +% One of the labels is not of the same type as the case variable. +parser_e_illegal_symbol_exported=03056_E_Símbolos só podem ser exportados em uma biblioteca +% You can only export procedures and functions when you write a library. You +% cannot export variables or constants. +parser_w_should_use_override=03057_W_Um método herdado é ocultado por "$1" +% A method that is declared \var{virtual} in a parent class, should be +% overridden in the descendant class with the \var{override} directive. If you +% don't specify the \var{override} directive, you will hide the parent method; +% you will not override it. +parser_e_nothing_to_be_overridden=03058_E_Não há método na classe ancestral para ser sobreposto: "$1" +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_no_procedure_to_access_property=03059_E_Nenhum membro foi provido para acessar a propriedade +% You specified no \var{read} directive for a property. +parser_w_stored_not_implemented=03060_W_Diretiva propriedade armazenamento ainda não foi implementada +% This message is no longer used, as the \var{stored} directive has been implemented. +parser_e_ill_property_access_sym=03061_E_Símbolo ilegal para acesso propriedade +% There is an error in the \var{read} or \var{write} directives for an array +% property. When you declare an array property, you can only access it with +% procedures and functions. The following code would cause such an error. +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_Não é possível acessar um campo protegido de um objeto aqui +% Fields that are declared in a \var{protected} section of an object or class +% declaration cannot be accessed outside the module where the object is +% defined, or outside descendent object methods. +parser_e_cant_access_private_member=03063_E_Não é possível acessar um campo privado de um objeto aqui +% Fields that are declared in a \var{private} section of an object or class +% declaration cannot be accessed outside the module where the class is +% defined. +parser_e_overridden_methods_not_same_ret=03066_E_Métodos sobrepostos devem ter o mesmo tipo de retorno: "$2" é sobreposto por "$1" que possui outro tipo retorno +% If you declare overridden methods in a class definition, they must +% have the same return type. +parser_e_dont_nest_export=03067_E_Funções EXPORT declaradas não podem estar aninhadas +% You cannot declare a function or procedure within a function or procedure +% that was declared as an export procedure. +parser_e_methods_dont_be_export=03068_E_Métodos não podem ser EXPORTados +% You cannot declare a procedure that is a method for an object as +% \var{export}ed. +parser_e_call_by_ref_without_typeconv=03069_E_Chamada por var. para arg. no. $1 tem que coincidir exatamente: Obtido "$2" esperado "$3" +% When calling a function declared with \var{var} parameters, the variables in +% the function call must be of exactly the same type. There is no automatic +% type conversion. +parser_e_no_super_class=03070_E_Classe não é uma classe pai da classe atual +% When calling inherited methods, you are trying to call a method of a non-related +% class. You can only call an inherited method of a parent class. +parser_e_self_not_in_method=03071_E_SELF é permitido apenas em métodos +% You are trying to use the \var{self} parameter outside an object's method. +% Only methods get passed the \var{self} parameters. +parser_e_generic_methods_only_in_methods=03072_E_Métodos só podem estar em outros métodos se chamados diretamente com o identificador de tipo da classe +% A construction like \var{sometype.somemethod} is only allowed in a method. +parser_e_illegal_colon_qualifier=03073_E_Uso ilegal de ':' +% You are using the format \var{:} (colon) 2 times on an expression that +% is not a real expression. +parser_e_illegal_set_expr=03074_E_Erro verificação de faixa em conjunto construtor ou elemento conjunto duplicado +% The declaration of a set contains an error. Either one of the elements is +% outside the range of the set type, or two of the elements are in fact +% the same. +parser_e_pointer_to_class_expected=03075_E_Ponteiro para objeto esperado +% You specified an illegal type in a \var{new} statement. +% The extended syntax of \var{new} needs an object as a parameter. +parser_e_expr_have_to_be_constructor_call=03076_E_Expressão deve ser chamada ao construtor +% When using the extended syntax of \var{new}, you must specify the constructor +% method of the object you are trying to create. The procedure you specified +% is not a constructor. +parser_e_expr_have_to_be_destructor_call=03077_E_Expressão deve ser chamada ao destruidor +% When using the extended syntax of \var{dispose}, you must specify the +% destructor method of the object you are trying to dispose of. +% The procedure you specified is not a destructor. +parser_e_invalid_record_const=03078_E_Ordem ilegal dos elementos do registro +% When declaring a constant record, you specified the fields in the wrong +% order. +parser_e_false_with_expr=03079_E_Tipo expressão deve ser classe ou tipo registro +% A \var{with} statement needs an argument that is of the type \var{record} +% or \var{class}. You are using \var{with} on an expression that is not of +% this type. +parser_e_void_function=03080_E_Procedimentos não podem retornar um valor +% In \fpc, you can specify a return value for a function when using +% the \var{exit} statement. This error occurs when you try to do this with a +% procedure. Procedures cannot return a value. +parser_e_constructors_always_objects=03081_E_Construtores, destruidores e operadores de classe devem ser métodos +% You're declaring a procedure as destructor, constructor or class operator, when the +% procedure isn't a class method. +parser_e_operator_not_overloaded=03082_E_Operador não é sobrecarregado +% You're trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_no_such_assignment=03083_E_Impossível sobrecarregar atribuições para tipos iguais +% You cannot overload assignment for types +% that the compiler considers as equal. +parser_e_overload_impossible=03084_E_Operador sobrecarga impossível +% The combination of operator, arguments and return type are +% incompatible. +parser_e_no_reraise_possible=03085_E_Re-elevar não é possível lá +% You are trying to re-raise an exception where it is not allowed. You can only +% re-raise exceptions in an \var{except} block. +parser_e_no_new_or_dispose_for_classes=03086_E_A sintaxe estendida para new ou dispose não é permitida para uma classe +% You cannot generate an instance of a class with the extended syntax of +% \var{new}. The constructor must be used for that. For the same reason, you +% cannot call \var{dispose} to de-allocate an instance of a class, the +% destructor must be used for that. +parser_e_procedure_overloading_is_off=03088_E_Sobrecarga de procimento está desativada +% When using the \var{-So} switch, procedure overloading is switched off. +% Turbo Pascal does not support function overloading. +parser_e_overload_operator_failed=03089_E_Não é possível sobrecarregar este operador. Operadores relacionados possíveis de sobrecarga (se algum) são: $1 +% You are trying to overload an operator which cannot be overloaded. +% The following operators can be overloaded : +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_Operador de comparação deve retornar um valor booleano +% When overloading the \var{=} operator, the function must return a boolean +% value. +parser_e_only_virtual_methods_abstract=03091_E_Apenas métodos virtuais podem ser abstratos +% You are declaring a method as abstract, when it is not declared to be +% virtual. +parser_f_unsupported_feature=03092_F_Uso de característica não suportada! +% You're trying to force the compiler into doing something it cannot do yet. +parser_e_mix_of_classes_and_objects=03093_E_A mistura de diferentes espécies de objetos (class, object, interface, etc) não é permitida +% You cannot derive \var{objects}, \var{classes}, \var{cppclasses} and \var{interfaces} intertwined. E.g. +% a class cannot have an object as parent and vice versa. +parser_w_unknown_proc_directive_ignored=03094_W_Diretiva desconhecida de procedimento teve que ser ignorada: "$1" +% The procedure directive you specified is unknown. +parser_e_absolute_only_one_var=03095_E_Absolute só pode estar associada a uma variável +% You cannot specify more than one variable before the \var{absolute} directive. +% Thus, the following construct will provide this error: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +parser_e_absolute_only_to_var_or_const=03096_E_Absolute só pode estar associada com uma variável ou constante +% The address of an \var{absolute} directive can only point to a variable or +% constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +parser_e_initialized_only_one_var=03097_E_Apenas uma variável pode ser inicializada +% You cannot specify more than one variable with a initial value in Delphi mode. +parser_e_abstract_no_definition=03098_E_Métodos abstratos não devem ter qualquer definição (com corpo função) +% Abstract methods can only be declared, you cannot implement them. They +% should be overridden by a descendant class. +parser_e_overloaded_must_be_all_global=03099_E_Esta função sobrecarregada não pode ser local (deve ser exportada) +% You are defining an overloaded function in the implementation part of a unit, +% but there is no corresponding declaration in the interface part of the unit. +parser_w_virtual_without_constructor=03100_W_Métodos virtuais são usados sem um construtor em "$1" +% If you declare objects or classes that contain virtual methods, you need +% to have a constructor and destructor to initialize them. The compiler +% encountered an object or class with virtual methods that doesn't have +% a constructor/destructor pair. +parser_c_macro_defined=03101_CL_Macro definida: $1 +% When \var{-vc} is used, the compiler tells you when it defines macros. +parser_c_macro_undefined=03102_CL_Macro indefinida: $1 +% When \var{-vc} is used, the compiler tells you when it undefines macros. +parser_c_macro_set_to=03103_CL_Macro $1 ajustada para $2 +% When \var{-vc} is used, the compiler tells you what values macros get. +parser_i_compiling=03104_I_Compilando $1 +% When you turn on information messages (\var{-vi}), the compiler tells you +% what units it is recompiling. +parser_u_parsing_interface=03105_UL_Analisando interface da unidade $1 +% This tells you that the reading of the interface +% of the current unit has started +parser_u_parsing_implementation=03106_UL_Analisando implementação de $1 +% This tells you that the code reading of the implementation +% of the current unit, library or program starts +parser_d_compiling_second_time=03107_DL_Compilando $1 uma segunda vez +% When you request debug messages (\var{-vd}) the compiler tells you what +% units it recompiles for the second time. +parser_e_no_property_found_to_override=03109_E_Nenhuma propriedade encontrada para sobrepor +% You want to override a property of a parent class, when there is, in fact, +% no such property in the parent class. +parser_e_only_one_default_property=03110_E_Apenas uma propriedade padrão é permitida +% You specified a property as \var{Default}, but the class already has a +% default property, and a class can have only one default property. +parser_e_property_need_paras=03111_E_A propriedade padrão deve ser uma propriedade matriz +% Only array properties of classes can be made \var{default} properties. +parser_e_constructor_cannot_be_not_virtual=03112_E_Construtores virtuais são suportados apenas modelo objeto classe +% You cannot have virtual constructors in objects. You can only have them +% in classes. +parser_e_no_default_property_available=03113_E_Nenhuma propriedade padrão disponível +% You are trying to access a default property of a class, but this class (or one of +% its ancestors) doesn't have a default property. +parser_e_cant_have_published=03114_E_A classe não pode ter uma seção PUBLISHED, use a chave {$M+} +% If you want a \var{published} section in a class definition, you must +% use the \var{\{\$M+\}} switch, which turns on generation of type +% information. +parser_e_forward_declaration_must_be_resolved=03115_E_Declaração posterior da classe "$1" deve ser resolvida aqui para usar a classe como ancestral +% To be able to use an object as an ancestor object, it must be defined +% first. This error occurs in the following situation: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% where \var{ParentClass} is declared but not defined. +parser_e_no_local_operator=03116_E_Operadores locais não suportados +% You cannot overload locally, i.e. inside procedures or function +% definitions. +parser_e_proc_dir_not_allowed_in_interface=03117_E_Diretiva procedimento "$1" não permitida na seção interface +% This procedure directive is not allowed in the \var{interface} section of +% a unit. You can only use it in the \var{implementation} section. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_Diretiva procedimento "$1" não permitida na seção implementação +% This procedure directive is not allowed in the \var{implementation} section of +% a unit. You can only use it in the \var{interface} section. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_Diretiva procedimento "$1" não permitida na declaração procvar +% This procedure directive cannot be part of a procedural or function +% type declaration. +parser_e_function_already_declared_public_forward=03120_E_Função já declarada como Pública/Posterior "$1" +% You will get this error if a function is defined as \var{forward} twice. +% Or if it occurs in the \var{interface} section, and again as a \var{forward} +% declaration in the \var{implementation} section. +parser_e_not_external_and_export=03121_E_Impossível usar ambos EXPORT e EXTERNAL +% These two procedure directives are mutually exclusive. +parser_w_not_supported_for_inline=03123_W_"$1" não suportado ainda dentro procedimento/função em linha +% Inline procedures don't support this declaration. +parser_w_inlining_disabled=03124_W_Procedimentos em linha desabilitados +% Inlining of procedures is disabled. +parser_i_writing_browser_log=03125_I_Gravando histório Navegador $1 +% When information messages are on, the compiler warns you when it +% writes the browser log (generated with the \var{\{\$Y+ \}} switch). +parser_h_maybe_deref_caret_missing=03126_H_Talvez desreferência de ponteiro esteja faltando +% The compiler thinks that a pointer may need a dereference. +parser_f_assembler_reader_not_supported=03127_F_Leitor assembler selecionado não suportado +% The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not +% supported. The compiler can be compiled with or without support for a +% particular assembler reader. +parser_e_proc_dir_conflict=03128_E_Diretiva procedimento "$1" tem conflitos com outras diretivas +% You specified a procedure directive that conflicts with other directives. +% For instance \var{cdecl} and \var{pascal} are mutually exclusive. +parser_e_call_convention_dont_match_forward=03129_E_Convenção de chamada não coincide com declaração posterior +% This error happens when you declare a function or procedure with +% e.g. \var{cdecl;} but omit this directive in the implementation, or vice +% versa. The calling convention is part of the function declaration, and +% must be repeated in the function definition. +parser_e_property_cant_have_a_default_value=03131_E_Propriedade não pode ter um valor padrão +% Set properties or indexed properties cannot have a default value. +parser_e_property_default_value_must_const=03132_E_O valor padrão de um propriedade deve ser uma constante +% The value of a \var{default} declared property must be known at compile +% time. The value you specified is only known at run time. This happens +% e.g. if you specify a variable name as a default value. +parser_e_cant_publish_that=03133_E_Símbolo não pode ser PUBLISHED, pode ser apenas uma classe +% Only class type variables can be in a \var{published} section of a class +% if they are not declared as a property. +parser_e_cant_publish_that_property=03134_E_Este tipo de propriedade não pode ser PUBLISHED +% Properties in a \var{published} section cannot be array properties. +% They must be moved to public sections. Properties in a \var{published} +% section must be an ordinal type, a real type, strings or sets. +parser_e_empty_import_name=03136_E_Um nome importação é requerido +% Some targets need a name for the imported procedure or a \var{cdecl} specifier. +parser_e_division_by_zero=03138_E_Divisão por zero +% A division by zero was encounted. +parser_e_invalid_float_operation=03139_E_Operação ponto flutuante inválida +% An operation on two real type values produced an overflow or a division +% by zero. +parser_e_array_lower_less_than_upper_bound=03140_E_Limite superior da faixa é menor que o limite inferior +% The upper bound of an array declaration is less than the lower bound and this +% is not possible. +parser_w_string_too_long=03141_W_'String' "$1" é maior que "$2" +% The size of the constant string is larger than the size you specified in +% string type definition. +parser_e_string_larger_array=03142_E_Comprimento 'String' é maior que o comprimento da matriz de caractere +% The size of the constant string is larger than the size you specified in +% the \var{Array[x..y] of char} definition. +parser_e_ill_msg_expr=03143_E_Expressão ilegal após diretiva mensagem +% \fpc supports only integer or string values as message constants. +parser_e_ill_msg_param=03144_E_Manipuladores mensagens podem ter apenas uma chamada por parâmetro referência +% A method declared with the \var{message} directive as message handler +% can take only one parameter which must be declared as call by reference. +% Parameters are declared as call by reference using the \var{var}-directive. +parser_e_duplicate_message_label=03145_E_Rótulo mensagem duplicado: "$1" +% A label for a message is used twice in one object/class. +parser_e_self_in_non_message_handler=03146_E_Self pode ser um parâmetro explícito apenas em métodos que são manipuladores de mensagens +% The \var{Self} parameter can only be passed explicitly to a method which +% is declared as message handler. +parser_e_threadvars_only_sg=03147_E_Threadvars podem ser apenas estáticas ou globais +% Threadvars must be static or global; you can't declare a thread +% local to a procedure. Local variables are always local to a thread, +% because every thread has its own stack and local variables +% are stored on the stack. +parser_f_direct_assembler_not_allowed=03148_F_Assembler direto não suportado para formato de saída binário +% You can't use direct assembler when using a binary writer. Choose an +% other output format or use another assembler reader. +parser_w_no_objpas_use_mode=03149_W_Não carregue a unidade OBJPAS manualmente, use \{\$mode objfpc\} ou \{\$mode delphi\} +% You are trying to load the \file{ObjPas} unit manually from a \var{uses} clause. +% This is not a good idea. Use the \var{\{\$MODE OBJFPC\}} or +% \var{\{\$mode delphi\}} directives which load the unit automatically. +parser_e_no_object_override=03150_E_OVERRIDE não pode ser usado em objetos +% \var{Override} is not supported for objects, use \var{virtual} instead to override +% a method of a parent object. +parser_e_cant_use_inittable_here=03151_E_Tipos de dados que requerem inicialização/finalização não podem ser usados em registros variant +% Some data types (e.g. \var{ansistring}) need initialization/finalization +% code which is implicitly generated by the compiler. Such data types +% can't be used in the variant part of a record. +parser_e_resourcestring_only_sg=03152_E_Recursos 'String' podem ser apenas estáticos ou globais +% Resourcestring cannot be declared local, only global or using the static +% directive. +parser_e_exit_with_argument_not__possible=03153_E_EXIT com argumentos não pode ser usado aqui +% An exit statement with an argument for the return value can't be used here. This +% can happen for example in \var{try..except} or \var{try..finally} blocks. +parser_e_stored_property_must_be_boolean=03154_E_O tipo do símbolo de armazenamento deve ser booleano +% If you specify a storage symbol in a property declaration, it must be a +% boolean type. +parser_e_ill_property_storage_sym=03155_E_Este símbolo não é permitido como símbolo de armazenamento +% You can't use this type of symbol as storage specifier in property +% declaration. You can use only methods with the result type boolean, +% boolean class fields or boolean constants. +parser_e_only_publishable_classes_can_be_published=03156_E_Apenas classes que são compiladas no modo $M+ podem ser PUBLISHED +% A class-typed field in the published section of a class can only be a class which was +% compiled in \var{\{\$M+\}} or which is derived from such a class. Normally +% such a class should be derived from \var{TPersistent}. +parser_e_proc_directive_expected=03157_E_Diretiva procedimento esperada +% This error is triggered when you have a \var{\{\$Calling\}} directive without +% a calling convention specified. +% It also happens when declaring a procedure in a const block and you +% used a ; after a procedure declaration which must be followed by a +% procedure directive. +% Correct declarations are: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_O valor de um índice de propriedade deve ser do tipo ordinal +% The value you use to index a property must be of an ordinal type, for +% example an integer or enumerated type. +parser_e_procname_to_short_for_export=03159_E_Nome procedimento muito curto para ser exportado +% The length of the procedure/function name must be at least 2 characters +% long. This is because of a bug in dlltool which doesn't parse the .def +% file correctly with a name of length 1. +parser_e_dlltool_unit_var_problem=03160_E_Nenhuma entrada DEFFILE pode ser gerada para vars. globais unidade +parser_e_dlltool_unit_var_problem2=03161_E_Compile sem a opção -WD +% You need to compile this file without the -WD switch on the +% command line. +parser_f_need_objfpc_or_delphi_mode=03162_F_Você precisa do modo ObjFpc (-S2) ou Delphi (-Sd) para compilar este módulo +% You need to use \var{\{\$MODE OBJFPC\}} or \var{\{\$MODE DELPHI\}} to compile this file. +% Or use the corresponding command line switch, either \var{-Mobjfpc} or \var{-MDelphi.} +parser_e_no_export_with_index_for_target=03163_E_Impossível exportar com índice sob $1 +% Exporting of functions or procedures with a specified index is not +% supported on this target. +parser_e_no_export_of_variables_for_target=03164_E_Exportação de variáveis não é suportada sob $1 +% Exporting of variables is not supported on this target. +parser_e_improper_guid_syntax=03165_E_Sintaxe GUID imprópria +% The GUID indication does not have the proper syntax. It should be of the form +% \begin{verbatim} +% {XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX} +% \end{verbatim} +% Where each \var{X} represents a hexadecimal digit. +parser_w_interface_mapping_notfound=03168_W_Procedimento chamado "$1" que fosse adequado à implementação de $2.$3 não encontrado +% The compiler cannot find a suitable procedure which implements the given method of an interface. +% A procedure with the same name is found, but the arguments do not match. +parser_e_interface_id_expected=03169_E_Identificador interface esperado +% This happens when the compiler scans a \var{class} declaration that contains +% \var{interface} function name mapping code like this: +% \begin{verbatim} +% type +% TMyObject = class(TObject, IDispatch) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% and the \var{interface} before the dot is not listed in the inheritance list. +parser_e_type_cant_be_used_in_array_index=03170_E_Tipo "$1" não pode ser usado como tipo índice matriz +% Types like \var{qword} or \var{int64} aren't allowed as array index type. +parser_e_no_con_des_in_interfaces=03171_E_Construtor e destruidor não permitidos em interfaces +% Constructor and destructor declarations aren't allowed in interfaces. +% In the most cases method \var{QueryInterface} of \var{IUnknown} can +% be used to create a new interface. +parser_e_no_access_specifier_in_interfaces=03172_E_Especificadores de acesso não podem ser usados em INTERFACEs e OBJCPROTOCOLs +% The access specifiers \var{public}, \var{private}, \var{protected} and +% \var{published} can't be used in interfaces, Objective-C protocols and categories because all methods +% of an interface/protocol/category must be public. +parser_e_no_vars_in_interfaces=03173_E_Uma interface, auxiliar ou protocolo Objective-C ou categoria não pode conter campos +% Declarations of fields are not allowed in interfaces, helpers and Objective-C protocols and categories. +% An interface/protocol/category can contain only methods and properties with method read/write specifiers. +parser_e_no_local_proc_external=03174_E_Impossíve declarar procedimento local como EXTERNAL +% Declaring local procedures as external is not possible. Local procedures +% get hidden parameters that will make the chance of errors very high. +parser_w_skipped_fields_before=03175_W_Alguns campos que vêm antes de "$1" não foram inicializados +% In Delphi mode, not all fields of a typed constant record have to be +% initialized, but the compiler warns you when it detects such situations. +parser_e_skipped_fields_before=03176_E_Alguns campos que vêm antes de "$1" não foram inicializados +% In all syntax modes but Delphi mode, you can't leave some fields uninitialized +% in the middle of a typed constant record. +parser_w_skipped_fields_after=03177_W_Alguns campos que vêm depois de "$1" não foram inicializados +% You can leave some fields at the end of a type constant record uninitialized +% (The compiler will initialize them to zero automatically). This may be the cause +% of subtle problems. +parser_e_varargs_need_cdecl_and_external=03178_E_Diretiva VarArgs (ou '...' em MacPas) sem CDecl/CPPDecl/MWPascal e External +% The varargs directive (or the ``...'' varargs parameter in MacPas mode) can only be +% used with procedures or functions that are declared with \var{external} and one of +% \var{cdecl}, \var{cppdecl} and \var{mwpascal}. This functionality +% is only supported to provide a compatible interface to C functions like printf. +parser_e_self_call_by_value=03179_E_Self deve ser um parâmetro normal (chamada-por-valor) +% You can't declare \var{Self} as a const or var parameter, it must always be +% a call-by-value parameter. +parser_e_interface_has_no_guid=03180_E_Interface "$1" não tem identificação de interface +% When you want to assign an interface to a constant, then the interface +% must have a GUID value set. +parser_e_illegal_field_or_method=03181_E_Campo classe ou identificador método "$1" desconhecido +% Properties must refer to a field or method in the same class. +parser_w_proc_overriding_calling=03182_W_Convenção chamada sobreposição "$1" com "$2" +% There are two directives in the procedure declaration that specify a calling +% convention. Only the last directive will be used. +parser_e_no_procvarobj_const=03183_E_Constantes tipadas do tipo "procedimento de objeto" podem ser apenas inicializadas com NIL +% You cannot assign the address of a method to a typed constant which has a +% 'procedure of object' type, because such a constant requires two addresses: +% that of the method (which is known at compile time) and that of the object or +% class instance it operates on (which cannot be known at compile time). +parser_e_default_value_only_one_para=03184_E_Valor padrão pode ser atribuído apenas à um parâmetro +% It is not possible to specify a default value for several parameters at once. +% The following is invalid: +% \begin{verbatim} +% Procedure MyProcedure (A,B : Integer = 0); +% \end{verbatim} +% Instead, this should be declared as +% \begin{verbatim} +% Procedure MyProcedure (A : Integer = 0; B : Integer = 0); +% \end{verbatim} +parser_e_default_value_expected_for_para=03185_E_Parâmetro padrão requerido para "$1" +% The specified parameter requires a default value. +parser_w_unsupported_feature=03186_W_Uso de característica não suportada! +% You're trying to force the compiler into doing something it cannot do yet. +parser_h_c_arrays_are_references=03187_H_Matrizes C são passadas por referência +% Any array passed to a C function is passed +% by a pointer (i.e. by reference). +parser_e_C_array_of_const_must_be_last=03188_E_Matrizes de constantes C devem ser o último argumento +% You cannot add any other argument after an \var{array of const} for +% \var{cdecl} functions, as the size pushed on stack for this argument is +% not known. +parser_h_type_redef=03189_H_Redefinição do tipo "$1" +% This is an indicator that a previously declared type is +% being redefined as something else. This may, or may not +% be, a potential source of errors. +parser_w_cdecl_has_no_high=03190_W_Funções declaradas com cdecl não tem um parâmetro implícito extra +% Functions declared with the \var{cdecl} modifier do not pass an extra implicit parameter. +parser_w_cdecl_no_openstring=03191_W_Funções declaradas com cdecl não suportam 'String' aberta +% Openstring is not supported for functions that have the \var{cdecl} modifier. +parser_e_initialized_not_for_threadvar=03192_E_Impossível inicializar variáveis declaradas como threadvar +% Variables declared as threadvar cannot be initialized with a default value. +% The variables will always be filled with zero at the start of a new thread. +parser_e_msg_only_for_classes=03193_E_Diretiva mensagem é permitida apenas em Classes +% The message directive is only supported for Class types. +parser_e_procedure_or_function_expected=03194_E_Procedimento ou Função esperados +% A class method can only be specified for procedures and functions. +parser_e_illegal_calling_convention=03195_W_Diretiva convenção de chamada ignorada: "$1" +% Some calling conventions are supported only by certain CPUs. I.e. most non-i386 ports support +% only the standard ABI calling convention of the CPU. +parser_e_no_object_reintroduce=03196_E_REINTRODUCE não pode ser usado em objetos +% \var{reintroduce} is not supported for objects, Objective-C classes and Objective-C protocols. +parser_e_paraloc_only_one_para=03197_E_Cada argumento deve ter sua própria localização +% If locations for arguments are specified explicitly as it is required by +% some syscall conventions, each argument must have its own location. Things +% like +% \begin{verbatim} +% procedure p(i,j : longint 'r1'); +% \end{verbatim} +% aren't allowed. +parser_e_paraloc_all_paras=03198_E_Cada argumento deve ter uma localização explícita +% If one argument has an explicit argument location, all arguments of a procedure +% must have one. +parser_e_illegal_explicit_paraloc=03199_E_Localização argumento desconhecida +% The location specified for an argument isn't recognized by the compiler. +parser_e_32bitint_or_pointer_variable_expected=03200_E_Inteiro 32-Bit ou variável ponteiro esperados +% The libbase for MorphOS/AmigaOS can be given only as \var{longint}, \var{dword} or any pointer variable. +parser_e_goto_outside_proc=03201_E_Declaração Goto não permitida entre procedimentos diferentes +% It isn't allowed to use \var{goto} statements referencing labels outside the +% current procedure. The following example shows the problem: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1; +% +% procedure p2; +% begin +% goto l1; // This goto ISN'T allowed +% end; +% +% begin +% p2 +% l1: +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_Procedimento muito complexo, ele requer muitos registradores +% Your procedure body is too long for the compiler. You should split the +% procedure into multiple smaller procedures. +parser_e_illegal_expression=03203_E_Expressão ilegal +% This can occur under many circumstances. Usually when trying to evaluate +% constant expressions. +parser_e_invalid_integer=03204_E_Expressão inteira inválida +% You made an expression which isn't an integer, and the compiler expects the +% result to be an integer. +parser_e_invalid_qualifier=03205_E_Qualifiador ilegal +% One of the following is happening : +% \begin{itemize} +% \item You're trying to access a field of a variable that is not a record. +% \item You're indexing a variable that is not an array. +% \item You're dereferencing a variable that is not a pointer. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_Limite de faixa alta < limite de faixa baixa +% You are declaring a subrange, and the high limit is less than the low limit of +% the range. +parser_e_macpas_exit_wrong_param=03207_E_Parâmetro de saída deve ser o nome do procedimento em que ele é usado +% Non local exit is not allowed. This error occurs only in mode MacPas. +parser_e_illegal_assignment_to_count_var=03208_E_Atribuição ilegal para a variável for-loop "$1" +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. You also cannot assign values to +% loop variables inside the loop (Except in Delphi and TP modes). Use a while or +% repeat loop instead if you need to do something like that, since those +% constructs were built for that. +parser_e_no_local_var_external=03209_E_Impossível declarar variável local como EXTERNAL +% Declaring local variables as external is not allowed. Only global variables can reference +% external variables. +parser_e_proc_already_external=03210_E_Procedimento já foi declarado como EXTERNAL +% The procedure is already declared with the EXTERNAL directive in an interface or +% forward declaration. +parser_w_implicit_uses_of_variants_unit=03211_W_Uso implícito da unidade Variants +% The Variant type is used in the unit without any used unit using the Variants unit. The +% compiler has implicitly added the Variants unit to the uses list. To remove this warning +% the Variants unit needs to be added to the uses statement. +parser_e_no_static_method_in_interfaces=03212_E_Classe e métodos estáticos não podem ser usados em INTERFACES +% The specifier \var{class} and directive \var{static} can't be used in interfaces +% because all methods of an interface must be public. +parser_e_arithmetic_operation_overflow=03213_E_Transbordamento em operação aritimética +% An operation on two integer values produced an overflow. +parser_e_protected_or_private_expected=03214_E_Protected ou private esperados +% \var{strict} can be only used together with \var{protected} or \var{private}. +parser_e_illegal_slice=03215_E_SLICE não pode ser usado fora da lista de parâmetros +% \var{slice} can be used only for arguments accepting an open array parameter. +parser_e_dispinterface_cant_have_parent=03216_E_Uma DISPINTERFACE não pode ter uma classe pai +% A DISPINTERFACE is a special type of interface which can't have a parent class. Dispinterface always derive from IDispatch type. +parser_e_dispinterface_needs_a_guid=03217_E_Uma DISPINTERFACE necessita de um GUID +% A DISPINTERFACE always needs an interface identification (a GUID). +parser_w_overridden_methods_not_same_ret=03218_W_Métodos susbtituídos devem ter um tipo de retorno relacionados. Este código pode travar, ele depende de uma falha do analizador Delphi ("$2" é sobreposto por "$1" que possue outro tipo de retorno) +% If you declare overridden methods in a class definition, they must +% have the same return type. Some versions of Delphi allow you to change the +% return type of interface methods, and even to change procedures into +% functions, but the resulting code may crash depending on the types used +% and the way the methods are called. +parser_e_dispid_must_be_ord_const=03219_E_IDs despacho devem ser constantes ordinais +% The \var{dispid} keyword must be followed by an ordinal constant (the dispid index). +parser_e_array_range_out_of_bounds=03220_E_A faixa da matriz é demasiada grande +% Regardless of the size taken up by its elements, an array cannot have more +% than high(ptrint) elements. Additionally, the range type must be a subrange +% of ptrint. +parser_e_packed_element_no_var_addr=03221_E_O endereço não pode ser obtido de elementos de matriz de bits compactados ou campos de registro +% If you declare an array or record as \var{packed} in Mac Pascal mode +% (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will +% be packed at the bit level. This means it becomes impossible to take addresses +% of individual array elements or record fields. The only exception to this rule +% is in the case of packed arrays elements whose packed size is a multple of 8 bits. +parser_e_packed_dynamic_open_array=03222_E_Matrizes dinâmicas não podem ser compactadas +% Only regular (and possibly in the future also open) arrays can be packed. +parser_e_packed_element_no_loop=03223_E_Elementos de matrizes de bits compactados ou campos de registro não podem ser usadas como variáveis de laços +% If you declare an array or record as \var{packed} in Mac Pascal mode +% (or as \var{packed} in any mode with \var{\{\$bitpacking on\}}), it will +% be packed at the bit level. For performance reasons, they cannot be +% used as loop variables. +parser_e_type_var_const_only_in_records_and_classes=03224_E_VAR, TYPE e CONST são permitidos apenas em registros, objetos e classes +% The usage of VAR, TYPE and CONST to declare new types inside an object is allowed only inside +% records, objects and classes. +parser_e_cant_create_generics_of_this_type=03225_E_Este tipo não pode ser um genérico +% Only Classes, Objects, Interfaces and Records are allowed to be used as generic. +parser_w_no_lineinfo_use_switch=03226_W_Não caregue a unidade LINEINFO manualmente, Em vez disso utilize a chave de compilador -gl +% Do not use the \file{lineinfo} unit directly, Use the \var{-gl} switch which +% automatically adds the correct unit for reading the selected type of debugging +% information. The unit that needs to be used depends on the type of +% debug information used when compiling the binary. +parser_e_no_funcret_specified=03227_E_Nenhum tipo de retorno de função especificado para a função "$1" +% The first time you declare a function you have to declare it completely, +% including all parameters and the result type. +parser_e_special_onlygenerics=03228_E_Especialização é suportado apenas por tipos genéricos +% Types which are not generics can't be specialized. +parser_e_no_generics_as_params=03229_E_Genéricos não podem ser usados como parâmetros quando especializando genéricos +% When specializing a generic, only non-generic types can be used as parameters. +parser_e_type_object_constants=03230_E_Constantes de objetos contendo uma VMT não são permitidas +% If an object requires a VMT either because it contains a constructor or virtual methods, +% it's not allowed to create constants of it. In TP and Delphi mode this is allowed +% for compatibility reasons. +parser_e_label_outside_proc=03231_E_Obter o endereço de rótulos definidos fora do escopo atual não é permitido +% It isn't allowed to take the address of labels outside the +% current procedure. +parser_e_initialized_not_for_external=03233_E_Impossível inicializar variáveis declaradas como externas +% Variables declared as external cannot be initialized with a default value. +parser_e_illegal_function_result=03234_E_Tipo de retorno de função ilegal +% Some types like file types cannot be used as function result. +parser_e_no_common_type=03235_E_Nenhum tipo comum entre "$1" e "$2" +% To perform an operation on integers, the compiler converts both operands +% to their common type, which appears to be an invalid type. To determine the +% common type of the operands, the compiler takes the minimum of the minimal values +% of both types, and the maximum of the maximal values of both types. The common +% type is then minimum..maximum. +parser_e_no_generics_as_types=03236_E_Genéricos sem especialização não podem ser usadas como um tipo para uma variável +% Generics must be always specialized before being used as variable type. +parser_w_register_list_ignored=03237_W_Lista registros é ignorada para rotinas assembler puras +% When using pure assembler routines, the list with modified registers is ignored. +parser_e_implements_must_be_class_or_interface=03238_E_Propriedade 'Implements' deve ter tipo classe ou interface +% A property which implements an interface must be of type class or interface. +parser_e_implements_must_have_correct_type=03239_E_Propriedade 'Implements' deve implementar interface de tipo correto, encontrado "$1" esperado "$2" +% A property which implements an interface actually implements a different interface. +parser_e_implements_must_read_specifier=03240_E_Propriedade 'Implements' deve ter especificador de leitura +% A property which implements an interface must have at least a read specifier. +parser_e_implements_must_not_have_write_specifier=03241_E_Propriedade 'Implements' não deve ter especificador de escrita +% A property which implements an interface may not have a write specifier. +parser_e_implements_must_not_have_stored_specifier=03242_E_Propriedade 'Implements' não deve ter especificador de armazenagem +% A property which implements an interface may not have a stored specifier. +parser_e_implements_uses_non_implemented_interface=03243_E_Propriedade 'Implements' usada em interface não implementada: "$1" +% The interface which is implemented by a property is not an interface implemented by the class. +parser_e_unsupported_real=03244_E_Ponto flutuante não suportado para este alvo +% The compiler parsed a floating point expression, but it is not supported. +parser_e_class_doesnt_implement_interface=03245_E_Classe "$1" não implementa interface "$2" +% The delegated interface is not implemented by the class given in the implements clause. +parser_e_class_implements_must_be_interface=03246_E_Tipo usado por implementação deve ser uma interface +% The \var{implements} keyword must be followed by an interface type. +parser_e_cant_export_var_different_name=03247_E_Variáveis não podem ser exportadas com um nome diferente neste alvo, adicione o nome na declaração usando a diretiva "export" (nome variável: $1, nome exportação declarado: $2) +% On most targets it is not possible to change the name under which a variable +% is exported inside the \var{exports} statement of a library. +% In that case, you have to specify the export name at the point where the +% variable is declared, using the \var{export} and \var{alias} directives. +parser_e_weak_external_not_supported=03248_E_Símbolos externos fracos não são suportados para o atual alvo +% A "weak external" symbol is a symbol which may or may not exist at (either static +% or dynamic) link time. This concept may not be available (or implemented yet) +% on the current cpu/OS target. +parser_e_forward_mismatch=03249_E_Definição posterior tipo incompatível +% Classes and interfaces being defined forward must have the same type +% when being implemented. A forward interface cannot be changed into a class. +parser_n_ignore_lower_visibility=03250_N_Método virtual "$1" tem baixa visibilidade ($2) que a classe pai $3 ($4) +% The virtual method overrides an method that is declared with a higher visibility. This might give +% unexpected results. In case the new visibility is private than it might be that a call to inherited in a +% new child class will call the higher visible method in a parent class and ignores the private method. +parser_e_field_not_allowed_here=03251_E_Campos não podem aparecer depois dem um método ou definição propriedade, inicie uma nova seção de visibilidade primeiro +% Once a method or property has been defined in a class or object, you cannot define any fields afterwards +% without starting a new visibility section (such as \var{public}, \var{private}, etc.). The reason is +% that otherwise the source code can appear ambiguous to the compiler, since it is possible to use modifiers +% such as \var{default} and \var{register} also as field names. +parser_e_no_local_para_def=03252_E_Parâmetros ou tipos resultado não podem conter definições locais de tipo. Use uma definição de tipo separada em um bloco de tipos +% In Pascal, types are not considered to be identical simply because they are semantically equivalent. +% Two variables or parameters are only considered to be of the same type if they refer to the +% same type definition. +% As a result, it is not allowed to define new types inside parameter lists, because then it is impossible to +% refer to the same type definition in the procedure headers of the interface and implementation of a unit +% (both procedure headers would define a separate type). Keep in mind that expressions such as +% ``file of byte'' or ``string[50]'' also define a new type. +parser_e_abstract_and_sealed_conflict=03253_E_Conflito ABSTRACT e SEALED +% ABSTRACT and SEALED cannot be used together in one declaration +parser_e_sealed_descendant=03254_E_Impossível criar um descendente da classe selada "$1" +% Sealed means that class cannot be derived by another class. +parser_e_sealed_class_cannot_have_abstract_methods=03255_E_Classe selada não pode ter um método abstrato +% Sealed means that class cannot be derived. Therefore no one class is able to override an abstract method in a sealed class. +parser_e_only_virtual_methods_final=03256_E_Apenas métodos virtuais podem ser finais +% You are declaring a method as final, when it is not declared to be +% virtual. +parser_e_final_can_no_be_overridden=03257_E_Método final não pode ser sobreposto: "$1" +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_multiple_messages=03258_E_Apenas uma mensagem pode ser usada por método. +% It is not possible to associate multiple messages with a single method. +parser_e_invalid_enumerator_identifier=03259_E_Identificador enumerador inválido: "$1" +% Only "MoveNext" and "Current" enumerator identifiers are supported. +parser_e_enumerator_identifier_required=03260_E_Identificador enumerador requerido +% "MoveNext" or "Current" identifier must follow the \var{enumerator} modifier. +parser_e_enumerator_movenext_is_not_valid=03261_E_Método enumerador 'MoveNext' padrão inválido. Método deve ser uma função com tipo de retorno booleano e sem argumentos requeridos. +% "MoveNext" enumerator pattern method must be a function with Boolean return type and no required arguments +parser_e_enumerator_current_is_not_valid=03262_E_Propriedade enumerador 'Current' padrão inválido. Propriedade deve ter um 'getter'. +% "Current" enumerator pattern property must have a getter +parser_e_only_one_enumerator_movenext=03263_E_Apenas um método enumerador 'MoveNext' é permitido por classe/objeto +% Class or Object can have only one enumerator MoveNext declaration. +parser_e_only_one_enumerator_current=03264_E_Apenas uma propriedade enumerador 'Current' é permitida por classe/objeto +% Class or Object can have only one enumerator Current declaration. +parser_e_for_in_loop_cannot_be_used_for_the_type=03265_E_Laço 'for in' não pode ser usado para o tipo "$1" +% For in loop can be used not for all types. For example it cannot be used for the enumerations with jumps. +parser_e_objc_requires_msgstr=03266_E_Mensagens Objective-C requerem que seu nome seletor Objective-C seja especificado usando a diretiva "message". +% Objective-C messages require their Objective-C name (selector name) to be specified using the \var{message `someName:'} procedure directive. +% While bindings to other languages automatically generate such names based on the identifier you use (by replacing +% all underscores with colons), this is unsafe since nothing prevents an Objective-C method name to contain actual +% colons. +parser_e_objc_no_constructor_destructor=03267_E_Objective-C não tem construtores nem destruidores formais. Use as mensagens 'alloc', 'initXXX' e 'dealloc'. +% The Objective-C language does not have any constructors or destructors. While there are some messages with a similar +% purpose (such as \var{init} and \var{dealloc}), these cannot be identified using automatic parsers and do not +% guarantee anything like Pascal constructors/destructors (e.g., you have to take care of only calling ``designated'' +% inherited ``constructors''). For these reasons, we have opted to follow the standard Objective-C patterns for +% instance creation/destruction. +parser_e_message_string_too_long=03268_E_Nome mensagem é muito longo (max. 255 caracteres) +% Due to compiler implementation reasons, message names are currently limited to 255 characters. +parser_e_objc_message_name_too_long=03269_E_Nome símbolo mensagem Objective-C para "$1" é muito longo +% Due to compiler implementation reasons, mangled message names (i.e., the symbol names used in the assembler +% code) are currently limited to 255 characters. +parser_h_no_objc_parent=03270_H_Definindo uma nova classe raiz Objective-C. Para derivar de outra classe raiz (ex., NSObject), especifique-a como pai da classe +% If no parent class is specified for an Object Pascal class, then it automatically derives from TObject. +% Objective-C classes however do not automatically derive from NSObject, because one can have multiple +% root classes in Objective-C. For example, in the Cocoa framework both NSObject and NSProxy are root classes. +% Therefore, you have to explicitly define a parent class (such as NSObject) if you want to derive your +% Objective-C class from it. +parser_e_no_objc_published=03271_E_Classes Objective-C não podem ter seções PUBLISHED +% In Object Pascal, ``published'' determines whether or not RTTI is generated. Since the Objective-C runtime always needs +% RTTI for everything, this specified does not make sense for Objective-C classes. +parser_f_need_objc=03272_F_Este módulo requer que seja especificado uma chave de modo Objective-C para ser compilado +% This error indicates the use of Objective-C language features without an Objective-C mode switch +% active. Enable one via the -M command line switch, or the {\$modeswitch x} directive. +parser_e_must_use_override_objc=03273_E_Métodos herdados podem apenas ser sobrepostos em Objective-C, adicione "OVERRIDE" (método herdado definido em $1) +parser_h_should_use_override_objc=03274_H_Métodos herdados podem apenas ser sobrepostos em Objective-C, adicione "OVERRIDE" (método herdado definido em $1). +% It is not possible to \var{reintroduce} methods in Objective-C like in Object Pascal. Methods with the same +% name always map to the same virtual method entry. In order to make this clear in the source code, +% the compiler always requires the \var{override} directive to be specified when implementing overriding +% Objective-C methods in Pascal. If the implementation is external, this rule is relaxed because Objective-C +% does not have any \var{override}-style keyword (since it's the default and only behaviour in that language), +% which makes it hard for automated header conversion tools to include it everywhere. +% The type in which the inherited method is defined is explicitly mentioned, because this may either +% be an objcclass or an objccategory. +parser_e_objc_message_name_changed=03275_E_Nome mensagem "$1" na classe herdada é diferente do nome mensagem "$2" na classe atual. +% An overriding Objective-C method cannot have a different message name than an inherited method. The reason +% is that these message names uniquely define the message to the Objective-C runtime, which means that +% giving them a different message name breaks the ``override'' semantics. +parser_e_no_objc_unique=03276_E_Ainda não é possível fazer cópias únicas de tipos Objective-C +% Duplicating an Objective-C type using \var{type x = type y;} is not yet supported. You may be able to +% obtain the desired effect using \var{type x = objcclass(y) end;} instead. +parser_e_no_category_as_types=03277_E_Categorias Objective-C e classes auxiliares Object Pascal não podem ser usadas como tipos +% It is not possible to declare a variable as an instance of an Objective-C +% category or an Object Pascal class helper. A category/class helper adds +% methods to the scope of an existing class, but does not define a type by +% itself. An exception of this rule is when inheriting an Object Pascal class +% helper from another class helper. +parser_e_no_category_override=03278_E_Categorias não sobrepõem, mas substituem métodos. Use "REINTRODUCE". +parser_e_must_use_reintroduce_objc=03279_E_Métodos substituídos podem apenas ser reintroduzidos em Objective-C, adicione "REINTRODUCE" (método substituído definido em $1). +parser_h_should_use_reintroduce_objc=03280_H_Métodos substituídos podem apenas ser reintroduzidos em Objective-C, adicione "REINTRODUCE" (método substituído definido em $1). +% A category replaces an existing method in an Objective-C class, rather than that it overrides it. +% Calling an inherited method from an category method will call that method in +% the extended class' parent, not in the extended class itself. The +% replaced method in the original class is basically lost, and can no longer be +% called or referred to. This behaviour corresponds somewhat more closely to +% \var{reintroduce} than to \var{override} (although in case of \var{reintroduce} +% in Object Pascal, hidden methods are still reachable via inherited). +% The type in which the inherited method is defined is explicitly mentioned, because this may either +% be an objcclass or an objccategory. +parser_e_implements_getter_not_default_cc=03281_E_'Getter' para implementação interface deve usar a convenção de chamada padrão do alvo. +% Interface getters are called via a helper in the run time library, and hence +% have to use the default calling convention for the target (\var{register} on +% i386 and x86\_64, \var{stdcall} on other architectures). +parser_e_no_refcounted_typed_file=03282_E_Arquivos tipados não podem conter tipos referência-contados. +% The data in a typed file cannot be of a reference counted type (such as +% \var{ansistring} or a record containing a field that is reference counted). +parser_e_operator_not_overloaded_2=03283_E_Operador não está sobrecarregado: $2 "$1" +% You are trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_operator_not_overloaded_3=03284_E_Operador não está sobrecarregado: "$1" $2 "$3" +% You are trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_more_array_elements_expected=03285_E_Esperados outros $1 elementos matriz +% When declaring a typed constant array, you provided to few elements to initialize the array +parser_e_string_const_too_long=03286_E_Constante 'String' muito longa, enquanto 'ansistrings' estão desabilitadas +% Only when a piece of code is compiled with ansistrings enabled (\var{\{\$H+\}}), string constants +% longer than 255 characters are allowed. +parser_e_invalid_univ_para=03287_E_Tipo não pode ser usado como parâmetro 'univ' porque seu tamanho é desconhecido em tempo compilação: "$1" +% \var{univ} parameters are compatible with all values of the same size, but this +% cannot be checked in case a parameter's size is unknown at compile time. +parser_e_only_one_class_constructor_allowed=03288_E_Apenas um construtor de classe pode ser definido na classe: "$1" +% You are trying to declare more than one class constructor but only one class constructor can be declared. +parser_e_only_one_class_destructor_allowed=03289_E_Apenas um destruidor de classe pode ser definido na classe: "$1" +% You are trying to declare more than one class destructor but only one class destructor can be declared. +parser_e_no_paras_for_class_constructor=03290_E_Construtores de classe não podem ter parâmetros +% You are declaring a class constructor with a parameter list. Class constructor methods +% cannot have parameters. +parser_e_no_paras_for_class_destructor=03291_E_Destruidores de classe não podem ter parâmetros +% You are declaring a class destructor with a parameter list. Class destructor methods +% cannot have parameters. +parser_f_modeswitch_objc_required=03292_F_Esta construção requer que chave de modo \{\$modeswitch objectivec1\} esteja ativa +% Objective-Pascal constructs are not supported when \{\$modeswitch ObjectiveC1\} +% is not active. +parser_e_widestring_to_ansi_compile_time=03293_E_Constantes caracteres/unicode não podem ser convertidas em "ansi/shortstring" em tempo de compilação +% It is not possible to use unicodechar and unicodestring constants in +% constant expressions that have to be converted into an ansistring or shortstring +% at compile time, for example inside typed constants. The reason is that the +% compiler cannot know what the actual ansi encoding will be at run time. +parser_e_objc_enumerator_2_0=03294_E_Laços "For-in Objective-Pascal" requerem que a chave \{\$modeswitch ObjectiveC2\} esteja ativa +% Objective-C ``fast enumeration'' support was added in Objective-C 2.0, and +% hence the appropriate modeswitch has to be activated to expose this feature. +% Note that Objective-C 2.0 programs require Mac OS X 10.5 or later. +parser_e_objc_missing_enumeration_defs=03295_E_O compilador não encontrou os tipos "NSFastEnumerationProtocol" ou "NSFastEnumerationState" na unidade "CocoaAll" +% Objective-C for-in loops (fast enumeration) require that the compiler can +% find a unit called CocoaAll that contains definitions for the +% NSFastEnumerationProtocol and NSFastEnumerationState types. If you get this +% error, most likely the compiler is finding and loading an alternate CocoaAll +% unit. +parser_e_no_procvarnested_const=03296_E_Constantes tipadas do tipo 'procedimento é aninhado' só podem ser inicializadas com NIL e procedimentos/funções globais +% A nested procedural variable consists of two components: the address of the +% procedure/function to call (which is always known at compile time), and also +% a parent frame pointer (which is never known at compile time) in case the +% procedural variable contains a reference to a nested procedure/function. +% Therefore such typed constants can only be initialized with global +% functions/procedures since these do not require a parent frame pointer. +parser_f_no_generic_inside_generic=03297_F_Declaração de classe genérica dentro de outra classe genérica não é permitido +% At the moment, scanner supports recording of only one token buffer at the time +% (guarded by internal error 200511173 in tscannerfile.startrecordtokens). +% Since generics are implemented by recording tokens, it is not possible to +% have declaration of generic class inside another generic class. +parser_e_forward_protocol_declaration_must_be_resolved=03298_E_Declaração posterior de objcprotocl "$1" deve ser resolvida antes de uma objcclass possa conformá-la +% An objcprotocol must be fully defined before classes can conform to it. +% This error occurs in the following situation: +% \begin{verbatim} +% Type MyProtocol = objcprotoocl; +% ChildClass = Class(NSObject,MyProtocol) +% ... +% end; +% \end{verbatim} +% where \var{MyProtocol} is declared but not defined. +parser_e_no_record_published=03299_E_Tipos registro não podem ter seções publicadas +% Published sections can be used only inside classes. +parser_e_no_destructor_in_records=03300_E_Destruidores não são permitidos em registros ou auxiliares +% Destructor declarations aren't allowed in records or helpers. +parser_e_class_methods_only_static_in_records=03301_E_Métodos de classe devem ser estáticos em registros +% Class methods declarations aren't allowed in records without static modifier. +% Records have no inheritance and therefore non static class methods have no sence for them. +parser_e_no_constructor_in_records=03302_E_Construtores não são permitidos em registros ou auxiliares de registro +% Constructor declarations aren't allowed in records or record helpers. +parser_e_at_least_one_argument_must_be_of_type=03303_E_Tanto o resultado ou ao menos um parâmetro deve ser do tipo "$1" +% It is required that either the result of the routine or at least one of its parameters be of the specified type. +% For example class operators either take an instance of the structured type in which they are defined, or they return one. +parser_e_cant_use_type_parameters_here=03304_E_Parâmetros de tipo podem requerer inicialização/finalização - não podem ser usados em registros variant +% Type parameters may be specialized with types which (e.g. \var{ansistring}) need initialization/finalization +% code which is implicitly generated by the compiler. +parser_e_externals_no_section=03305_E_Variáveis sendo declaradas como externas não podem estar em uma seção customizada +% A section directive is not valid for variables being declared as external. +parser_e_section_no_locals=03306_E_Variáveis não-estáticas e não-globais não podem ter uma diretiva de seção +% A variable placed in a custom section is always statically allocated so it must be either a static or global variable. +parser_e_not_allowed_in_helper=03307_E_"$1" não é permitido em tipos auxiliares +% Some directives and specifiers like "virtual", "dynamic", "override" aren't +% allowed inside helper types in mode ObjFPC (they are ignored in mode Delphi), +% because they have no meaning within helpers. Also "abstract" isn't allowed in +% either mode. +parser_e_no_class_constructor_in_helpers=03308_E_Construtores de classe não são permitidos em auxiliares +% Class constructor declarations aren't allowed in helpers. +parser_e_inherited_not_in_record=03309_E_O uso de "inherited" não é permitido em um registro +% As records don't suppport inheritance the use of "inherited" is prohibited for +% these as well as for record helpers (in mode "Delphi" only). +parser_e_no_types_in_local_anonymous_records=03310_E_Declarações de tipo não são permitidas em registros locais ou anônimos +% Records with types must be defined globally. Types cannot be defined inside records which are defined in a +% procedure or function or in anonymous records. +parser_e_duplicate_implements_clause=03311_E_Cláusula "implements" duplicada para a interface "$1" +% A class may delegate an interface using the "implements" clause only to a single property. Delegating it multiple times +% is a error. +parser_e_mapping_no_implements=03312_E_Interface "$1" não pode ser delegada por "$2", já possui resolução de métodos +% Method resolution clause maps a method of an interface to a method of the current class. Therefore the current class +% has to implement the interface directly. Delegation is not possible. +parser_e_implements_no_mapping=03313_E_Interface "$1" não pode ter resolução de método, "$2" já a delega +% Method resoulution is only possible for interfaces that are implemented directly, not by delegation. +parser_e_invalid_codepage=03314_E_Codepage inválido +% When declaring a string with a given codepage, the range of valid codepages values is limited +% to 0 to 65535. +% \end{description} +# Type Checking +# +# 04108 is the last used one +# +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +type_e_mismatch=04000_E_Tipo incompatível +% This can happen in many cases: +% \begin{itemize} +% \item The variable you're assigning to is of a different type than the +% expression in the assignment. +% \item You are calling a function or procedure with parameters that are +% incompatible with the parameters in the function or procedure definition. +% \end{itemize} +type_e_incompatible_types=04001_E_Tipos incompatíveis: obtido "$1" esperado "$2" +% There is no conversion possible between the two types. +% Another possiblity is that they are declared in different +% declarations: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { This statement also gives this error. It +% is due to the strict type checking of Pascal } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_Tipos incompatíveis entre "$1" e "$2" +% The types are not equal. +type_e_type_id_expected=04003_E_Identificador de tipo esperado +% The identifier is not a type, or you forgot to supply a type identifier. +type_e_variable_id_expected=04004_E_Identificador de variável esperado +% This happens when you pass a constant to a routine (such as \var{Inc} var or \var{Dec}) +% when it expects a variable. You can only pass variables as arguments to these functions. +type_e_integer_expr_expected=04005_E_Expressão inteira esperada, mas obtido "$1" +% The compiler expects an expression of type integer, but gets a different +% type. +type_e_boolean_expr_expected=04006_E_Expressão booleana esperada, mas obtido "$1" +% The expression must be a boolean type. It should be return \var{True} or +% \var{False}. +type_e_ordinal_expr_expected=04007_E_Expressão ordinal esperada +% The expression must be of ordinal type, i.e., maximum a \var{Longint}. +% This happens, for instance, when you specify a second argument +% to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value. +type_e_pointer_type_expected=04008_E_Tipo ponteiro esperado, mas obtido "$1" +% The variable or expression isn't of the type \var{pointer}. This +% happens when you pass a variable that isn't a pointer to \var{New} +% or \var{Dispose}. +type_e_class_type_expected=04009_E_Tipo classe esperado, mas obtido "$1" +% The variable or expression isn't of the type \var{class}. This happens +% typically when +% \begin{enumerate} +% \item The parent class in a class declaration isn't a class. +% \item An exception handler (\var{On}) contains a type identifier that +% isn't a class. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_Impossível avaliar expressão constante +% This error can occur when the bounds of an array you declared do +% not evaluate to ordinal constants. +type_e_set_element_are_not_comp=04012_E_Elementos conjunto não são compatíveis +% You are trying to perform an operation on two sets, when the set element types +% are not the same. The base type of a set must be the same when taking the +% union. +type_e_set_operation_unknown=04013_E_Operação não implementada para conjuntos +% several binary operations are not defined for sets. +% These include: \var{div}, \var{mod}, \var{**}, \var{>=} and \var{<=}. +% The last two may be defined for sets in the future. +type_w_convert_real_2_comp=04014_W_Conversão automática de tipo de ponto flutuante para COMP que é um inteiro +% An implicit type conversion from a real type to a \var{comp} is +% encountered. Since \var{comp} is a 64 bit integer type, this may indicate +% an error. +type_h_use_div_for_int=04015_H_Use DIV como alternativa para obter um resultado inteiro +% When hints are on, then an integer division with the '/' operator will +% produce this message, because the result will then be of type real. +type_e_strict_var_string_violation=04016_E_Tipos 'String' devem coincidir exatamente no modo $V+ +% When compiling in \var{\{\$V+\}} mode, the string you pass as a parameter +% should be of the exact same type as the declared parameter of the procedure. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_'SUCC' ou 'PRED' não é possível em enumerações com atribuições +% If you declare an enumeration type which has C-like assignments +% in it, such as in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% then you cannot use the \var{Succ} or \var{Pred} functions with this enumeration. +type_e_cant_read_write_type=04018_E_Impossível ler ou gravar variáveis deste tipo +% You are trying to \var{read} or \var{write} a variable from or to a +% file of type text, which doesn't support that variable's type. +% Only integer types, reals, pchars and strings can be read from or +% written to a text file. Booleans can only be written to text files. +type_e_no_readln_writeln_for_typed_file=04019_E_Impossível usar 'readln' ou 'writeln' em arquivos tipados +% \var{readln} and \var{writeln} are only allowed for text files. +type_e_no_read_write_for_untyped_file=04020_E_Impossivel usar 'read' ou 'write' em arquivos não tipados. +% \var{read} and \var{write} are only allowed for text or typed files. +type_e_typeconflict_in_set=04021_E_Conflito de tipos entre elementos de conjunto +% There is at least one set element which is of the wrong type, i.e. not of +% the set type. +type_w_maybe_wrong_hi_lo=04022_W_lo/hi(dword/qword) retorna 'upper/lower word/dword' +% \fpc supports an overloaded version of \var{lo/hi} for \var{longint/dword/int64/qword} +% which returns the lower/upper word/dword of the argument. \tp always uses +% a 16 bit \var{lo/hi} which always returns bits 0..7 for \var{lo} and the +% bits 8..15 for \var{hi}. If you want the \tp behavior you have +% to type cast the argument to a \var{word} or \var{integer}. +type_e_integer_or_real_expr_expected=04023_E_Expressão inteira ou real esperada +% The first argument to \var{str} must be a real or integer type. +type_e_wrong_type_in_array_constructor=04024_E_Tipo incorreto "$1" no construtor matriz +% You are trying to use a type in an array constructor which is not +% allowed. +type_e_wrong_parameter_type=04025_E_Tipos incompatíveis para o arg. no. $1: Obtido "$2", esperado "$3" +% You are trying to pass an invalid type for the specified parameter. +type_e_no_method_and_procedure_not_compatible=04026_E_Método (variável) e Procedimento (variável) não são compatíveis +% You can't assign a method to a procedure variable or a procedure to a +% method pointer. +type_e_wrong_math_argument=04027_E_Constante ilegal passada para função matemática interna +% The constant argument passed to a \var{ln} or \var{sqrt} function is out of +% the definition range of these functions. +type_e_no_addr_of_constant=04028_E_Impossível obter o endereço de expressões constantes +% It is not possible to get the address of a constant expression, because they +% aren't stored in memory. You can try making it a typed constant. This error +% can also be displayed if you try to pass a property to a var parameter. +type_e_argument_cant_be_assigned=04029_E_Argumento não pode ser atribuído +% Only expressions which can be on the left side of an +% assignment can be passed as call by reference arguments. +% +% Remark: Properties can be used on the left side of an assignment, +% nevertheless they cannot be used as arguments. +type_e_cannot_local_proc_to_procvar=04030_E_Impossível atribuir procedimento/função local a variável procedimento +% It's not allowed to assign a local procedure/function to a +% procedure variable, because the calling convention of a local procedure/function is +% different. You can only assign local procedure/function to a void pointer. +type_e_no_assign_to_addr=04031_E_Impossível atribuir valores a um endereço +% It is not allowed to assign a value to an address of a variable, constant, +% procedure or function. You can try compiling with -So if the identifier +% is a procedure variable. +type_e_no_assign_to_const=04032_E_Impossível atribuir valors a uma variável constante +% It's not allowed to assign a value to a variable which is declared +% as a const. This is normally a parameter declared as const. To allow +% changing the value, pass the parameter by value, or a parameter by reference +% (using var). +type_e_array_required=04033_E_Tipo matriz requerido +% If you are accessing a variable using an index '[<x>]' then +% the type must be an array. In FPC mode a pointer is also allowed. +type_e_interface_type_expected=04034_E_Tipo interface esperado, mas obtido "$1" +% The compiler expected to encounter an interface type name, but got something else. +% The following code would produce this error: +% \begin{verbatim} +% Type +% TMyStream = Class(TStream,Integer) +% \end{verbatim} +type_h_mixed_signed_unsigned=04035_H_Misturando expressões assinadas e 'longwords' obtem-se um resultado de 64bits +% If you divide (or calculate the modulus of) a signed expression by a longword (or vice versa), +% or if you have overflow and/or range checking turned on and use an arithmetic +% expression (+, -, *, div, mod) in which both signed numbers and longwords appear, +% then everything has to be evaluated in 64-bit arithmetic which is slower than normal +% 32-bit arithmetic. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_w_mixed_signed_unsigned2=04036_W_Misturando expressões assinadas e cardinais pode causar um erro de verificação de faixa +% If you use a binary operator (and, or, xor) and one of +% the operands is a longword while the other one is a signed expression, then, +% if range checking is turned on, you may get a range check error because in +% such a case both operands are converted to longword before the operation is +% carried out. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_e_typecast_wrong_size_for_assignment=04037_E_Conversão de tipo tem tamanhos diferentes ($1 -> $2) na atribuição +% Type casting to a type with a different size is not allowed when the variable is +% used in an assignment. +type_e_array_index_enums_with_assign_not_possible=04038_E_Enumerações com atribuições não podem ser usadas como índice de matrizes +% When you declared an enumeration type which has C-like +% assignments, such as in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use it as the index of an array. +type_e_classes_not_related=04039_E_Tipos Classe ou Objeto "$1" e "$2" não estão relacionados +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors. +type_w_classes_not_related=04040_W_Tipos Classe "$1" e "$2" não estão relacionados +% There is a typecast from one class to another while the classes +% are not related. This will probably lead to errors. +type_e_class_or_interface_type_expected=04041_E_Tipo classe ou interface esperado, mas obtido "$1" +% The compiler expected a class or interface name, but got another type or identifier. +type_e_type_is_not_completly_defined=04042_E_Tipo "$1" não está completamente definido +% This error occurs when a type is not complete: i.e. a pointer type which points to +% an undefined type. +type_w_string_too_long=04043_W_Literal 'String' tem mais caracteres que comprimento 'string' curta +% The size of the constant string, which is assigned to a shortstring, +% is longer than the maximum size of the shortstring (255 characters). +type_w_signed_unsigned_always_false=04044_W_Comparação pode ser sempre falsa devido a faixa da constante e expressão +% There is a comparison between a constant and an expression where the constant is out of the +% valid range of values of the expression. Because of type promotion, the statement will always evaluate to +% false. Explicitly typecast the constant or the expression to the correct range to avoid this warning +% if you think the code is correct. +type_w_signed_unsigned_always_true=04045_W_Comparação pode ser sempre verdadeira devido a faixa da constante e expressão +% There is a comparison between a constant and an expression where the constant is out of the +% valid range of values of the expression. Because of type promotion, the statement will always evaluate to +% true. Explicitly typecast the constant or the expression to the correct range to avoid this warning +% if you think the code is correct. +type_w_instance_with_abstract=04046_W_Construindo uma classe "$1" com método abstrato "$2" +% An instance of a class is created which contains non-implemented abstract +% methods. This will probably lead to a runtime error 211 in the code if that +% routine is ever called. All abstract methods should be overridden. +type_h_in_range_check=04047_H_O operador esquerdo em um operador 'IN' deve ser tamanho byte +% The left operand of the \var{in} operator is not an ordinal or enumeration which fits +% within 8 bits. This may lead to range check errors. The \var{in} operator +% currently only supports a left operand which fits within a byte. In the case of +% enumerations, the size of an element of an enumeration can be controlled with +% the \var{\{\$PACKENUM\}} or \var{\{\$Zn\}} switches. +type_w_smaller_possible_range_check=04048_W_Tamanho tipo incompatível, possível perda de dados / erro verificação faixa +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_h_smaller_possible_range_check=04049_H_Tamanho tipo incompatível, possível perda de dados / erro verificação faixa +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_e_cant_take_address_of_abstract_method=04050_E_O endereço de um método abstrato não pode ser obtido +% An abstract method has no body, so the address of an abstract method can't be taken. +type_e_assignment_not_allowed=04051_E_Atribuições à parâmetros formais e matrizes abertas não são possíveis +% You are trying to assign a value to a formal (untyped var, const or out) +% parameter, or to an open array. +type_e_constant_expr_expected=04052_E_Expressão constante esperada +% The compiler expects an constant expression, but gets a variable expression. +type_e_operator_not_supported_for_types=04053_E_Operação "$1" não é suportada para os tipos "$2" e "$3" +% The operation is not allowed for the supplied types. +type_e_illegal_type_conversion=04054_E_Conversão de tipo ilegal: "$1" para "$2" +% When doing a type-cast, you must take care that the sizes of the variable and +% the destination type are the same. +type_h_pointer_to_longint_conv_not_portable=04055_H_Conversão entre ordinais e ponteiros não é portável +% If you typecast a pointer to a longint (or vice-versa), this code will not compile +% on a machine using 64 bits addressing. +type_w_pointer_to_longint_conv_not_portable=04056_W_Conversão entre ordinais e ponteiros não é portável +% If you typecast a pointer to an ordinal type of a different size (or vice-versa), this can +% cause problems. This is a warning to help in finding the 32-bit specific code where cardinal/longint is used +% to typecast pointers to ordinals. A solution is to use the ptrint/ptruint types instead. +type_e_cant_choose_overload_function=04057_E_Impossível determinar qual função sobrecarregada chamar +% You're calling overloaded functions with a parameter that doesn't correspond +% to any of the declared function parameter lists. e.g. when you have declared +% a function with parameters \var{word} and \var{longint}, and then you call +% it with a parameter which is of type \var{integer}. +type_e_illegal_count_var=04058_E_Variável contador ilegal +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +type_w_double_c_varargs=04059_W_Convertendo constante valor real para 'double' para variável argumento C, adicione conversão de tipo explícita para evitar isso. +% In C, constant real values are double by default. For this reason, if you +% pass a constant real value to a variable argument part of a C function, FPC +% by default converts this constant to double as well. If you want to prevent +% this from happening, add an explicit typecast around the constant. +type_e_class_or_cominterface_type_expected=04060_E_Tipo Classe ou interface COM esperado, mas obtido "$1" +% Some operators, such as the AS operator, are only applicable to classes or COM interfaces. +type_e_no_const_packed_array=04061_E_Matrizes constantes compactadas não são suportadas ainda +% You cannot declare a (bit)packed array as a typed constant. +type_e_got_expected_packed_array=04062_E_Tipos incompatíveis para arg. no. $1: Obtido "$2" esperado "Matriz compactada (Bits)" +% The compiler expects a (bit)packed array as the specified parameter. +type_e_got_expected_unpacked_array=04063_E_Tipos incompatíveis para arg. no. $1: Obtido "$2" esperado "Matriz (não compactada)" +% The compiler expects a regular (i.e., not packed) array as the specified parameter. +type_e_no_packed_inittable=04064_E_Elementos de matrizes compactadas não podem ser de um tipo que necessita ser inicializado +% Support for packed arrays of types that need initialization +% (such as ansistrings, or records which contain ansistrings) is not yet implemented. +type_e_no_const_packed_record=04065_E_Registros constantes compactadas e objetos não são suportados ainda +% You cannot declare a (bit)packed array as a typed constant at this time. +type_w_untyped_arithmetic_unportable=04066_W_Aritmética "$1" em ponteiros não tipados não é portável {$T+}, sugere-se conversão de tipo +% Addition/subtraction from an untyped pointer may work differently in \var{\{\$T+\}}. +% Use a typecast to a typed pointer. +type_e_cant_take_address_of_local_subroutine=04076_E_Impossível obter endereço de uma subrotina marcada como local +% The address of a subroutine marked as local can't be taken. +type_e_cant_export_local=04077_E_Impossível exportar subrotina marcada como local de uma unidade +% A subroutine marked as local can't be exported from a unit. +type_e_not_automatable=04078_E_Tipo não é automatizável: "$1" +% Only byte, integer, longint, smallint, currency, single, double, ansistring, +% widestring, tdatetime, variant, olevariant, wordbool and all interfaces are automatable. +type_h_convert_add_operands_to_prevent_overflow=04079_H_Convertendo os operandos para "$1" antes de realizar a soma pode prevenir erros de transbordamento. +% Adding two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the addition. +type_h_convert_sub_operands_to_prevent_overflow=04080_H_Convertendo os operandos para "$1" antes de realizar a subtração pode prevenir erros de transbordamento. +% Subtracting two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the subtraction. +type_h_convert_mul_operands_to_prevent_overflow=04081_H_Convertendo os operados para "$1" antes de realizar a multiplicação pode prevenir erros de transbordamento. +% Multiplying two types can cause overflow errors. Since you are converting the result to a larger type, you +% could prevent such errors by converting the operands to this type before doing the multiplication. +type_w_pointer_to_signed=04082_W_Convertendo ponteiros para inteiros assinados pode resultar em comparações de resultados incorretas e erros de faixa. Ao invés disso, use tipos não assinados. +% The virtual address space on 32-bit machines runs from \$00000000 to \$ffffffff. +% Many operating systems allow you to allocate memory above \$80000000. +% For example both \windows and \linux allow pointers in the range \$0000000 to \$bfffffff. +% If you convert pointers to signed types, this can cause overflow and range check errors, +% but also \$80000000 < \$7fffffff. This can cause random errors in code like "if p>q". +type_e_interface_has_no_guid=04083_E_Tipo interface $1 não tem um GUID válido +% When applying the as-operator to an interface or class, the desired interface (i.e. the right operand of the +% as-operator) must have a valid GUID. +type_e_invalid_objc_selector_name=04084_E_Nome seletor inválido "$1" +% An Objective-C selector cannot be empty, must be a valid identifier or a single colon, +% and if it contains at least one colon it must also end in one. +type_e_expected_objc_method_but_got=04085_E_Método Objective-C esperado, mas obtido $1 +% A selector can only be created for Objective-C methods, not for any other kind +% of procedure/function/method. +type_e_expected_objc_method=04086_E_Método Objective-C ou nome método constante esperados +% A selector can only be created for Objective-C methods, either by specifying +% the name using a string constant, or by using an Objective-C method identifier +% that is visible in the current scope. +type_e_no_type_info=04087_E_Nenhuma informação de tipo disponível para este tipo +% Type information is not generated for some types, such as enumerations with gaps +% in their value range (this includes enumerations whose lower bound is different +% from zero). +type_e_ordinal_or_string_expr_expected=04088_E_Ordinal ou expressão 'string' esperados +% The expression must be an ordinal or string type. +type_e_string_expr_expected=04089_E_Expressão 'string' esperada +% The expression must be a string type. +type_w_zero_to_nil=04090_W_Convertendo 0 para NIL +% Use NIL rather than 0 when initialising a pointer. +type_e_protocol_type_expected=04091_E_Tipo protocolo Objective-C esperado, mas obtido "$1" +% The compiler expected a protocol type name, but found something else. +type_e_objc_type_unsupported=04092_E_O tipo "$1" não é suportado para interação com código Objective-C de tempo execução. +% Objective-C makes extensive use of run time type information (RTTI). This format +% is defined by the maintainers of the run time and can therefore not be adapted +% to all possible Object Pascal types. In particular, types that depend on +% reference counting by the compiler (such as ansistrings and certain kinds of +% interfaces) cannot be used as fields of Objective-C classes, cannot be +% directly passed to Objective-C methods, and cannot be encoded using \var{objc\_encode}. +type_e_class_or_objcclass_type_expected=04093_E_Tipo classe ou 'objcclass' esperados, mas obtido "$1" +% It is only possible to create class reference types of \var{class} and \var{objcclass} +type_e_objcclass_type_expected=04094_E_Tipo 'Objcclass' esperado +% The compiler expected an \var{objcclass} type +type_w_procvar_univ_conflicting_para=04095_W_Tipo parâmetro 'univ' forçado em variável procedimental pode causar travamento ou corrupção de memória: $1 para $2 +% \var{univ} parameters are implicitly compatible with all types of the same size, +% also in procedural variable definitions. That means that the following code is +% legal, because \var{single} and \var{longint} have the same size: +% \begin{verbatim} +% {$mode macpas} +% Type +% TIntProc = procedure (l: univ longint); +% +% procedure test(s: single); +% begin +% writeln(s); +% end; +% +% var +% p: TIntProc; +% begin +% p:=test; +% p(4); +% end. +% \end{verbatim} +% This code may however crash on platforms that pass integers in registers and +% floating point values on the stack, because then the stack will be unbalanced. +% Note that this warning will not flagg all potentially dangerous situations. +% when \var{test} returns. +type_e_generics_cannot_reference_itself=04096_E_Parâmetros de tipo de especializações de genéricos não podem referenciar o tipo especializado atual +% Recursive specializations of generics like \var{Type MyType = specialize MyGeneric<MyType>;} are not possible. +type_e_type_parameters_are_not_allowed_here=04097_E_Parâmetros de tipo não são permitidos em procedimentos ou funções de classe/registro/objeto não-genérico +% Type parameters are only allowed for methods of generic classes, records or objects +type_e_generic_declaration_does_not_match=04098_E_Declaração genérica de "$1" difere da declaração anterior +% Generic declaration does not match the previous declaration +type_e_helper_type_expected=04099_E_Tipo auxiliar esperado +% The compiler expected a \var{class helper} type. +type_e_record_type_expected=04100_E_Tipo registro esperado +% The compiler expected a \var{record} type. +type_e_class_helper_must_extend_subclass=04101_E_Classe auxiliar derivada deve extender a subclasse de "$1" ou a própria classe +% If a class helper inherits from another class helper the extended class must +% extend either the same class as the parent class helper or a subclass of it +type_e_record_helper_must_extend_same_record=04102_E_Registro auxiliar derivado deve extender "$1" +% If a record helper inherits from another record helper it must extend the same +% record that the parent record helper extended. +type_e_procedures_return_no_value=04103_E_Atribuição inválida, procedimento não retorna valor +% This error occurs when one tries to assign the result of a procedure or destructor call. +% A procedure or destructor returns no value so this is not +% possible. +type_w_implicit_string_cast=04104_W_Conversão de tipo 'string' implícita de "$1" para "$2" +% An implicit type conversion from an ansi string type to an unicode string type is +% encountered. To avoid this warning perform an explicit type conversion. +type_w_implicit_string_cast_loss=04105_W_Conversão de tipo 'string' implícita com potencial de perda de dados de "$1" para "$2" +% An implicit type conversion from an unicode string type to an ansi string type is +% encountered. This conversion can lose data since not all unicode characters may be represented in the codepage of +% destination string type. +type_w_explicit_string_cast=04106_-W_Conversão de tipo 'string' explícita de "$1" para "$2" +% An explicit typecast from an ansi string type to an unicode string type is +% encountered. This warning is off by default. You can turn it on to see all suspicious string conversions. +type_w_explicit_string_cast_loss=04107_-W_Conversão de tipo 'string' explícita com potencial de perda de dados de "$1" para "$2" +% An explicit typecast from an unicode string type to an ansi string type is +% encountered. This conversion can lose data since not all unicode characters may be represented in the codepage of +% destination string type. This warning is off by default. You can turn it on to see all the places with lossy string +% conversions. +type_w_unicode_data_loss=04108_W_Conversão de constante Unicode com potencial de perda de dados +% Conversion from a WideChar to AnsiChar can lose data since now all unicode characters may be represented in the current +% system codepage +% \end{description} +# +# Symtable +# +# 05084 is the last used one +# +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedure and variable names. +% \begin{description} +sym_e_id_not_found=05000_E_Identificador não encontrado "$1" +% The compiler doesn't know this symbol. Usually happens when you misspell +% the name of a variable or procedure, or when you forget to declare a +% variable. +sym_f_internal_error_in_symtablestack=05001_F_Erro interno em SymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_Identificador duplicado "$1" +% The identifier was already declared in the current scope. +sym_h_duplicate_id_where=05003_H_Identificador já definido em $1 na linha $2 +% The identifier was already declared in a previous scope. +sym_e_unknown_id=05004_E_Identificador desconhecido "$1" +% The identifier encountered has not been declared, or is used outside the +% scope where it is defined. +sym_e_forward_not_resolved=05005_E_Declaração posterior não resolvida "$1" +% This can happen in two cases: +% \begin{itemize} +% \item You declare a function in the \var{interface} part, or +% with a \var{forward} directive, but do not implement it. +% \item You reference a type which isn't declared in the current \var{type} +% block. +% \end{itemize} +sym_e_error_in_type_def=05007_E_Erro na definição de tipo +% There is an error in your definition of a new array type. +% One of the range delimiters in an array declaration is erroneous. +% For example, \var{Array [1..1.25]} will trigger this error. +sym_e_forward_type_not_resolved=05009_E_Tipo posterior não resolvido "$1" +% A symbol was forward defined, but no declaration was encountered. +sym_e_only_static_in_static=05010_E_Apenas variáveis estáticas podem ser usadas em métodos estáticos ou métodos externos +% A static method of an object can only access static variables. +sym_f_type_must_be_rec_or_class=05012_F_Tipo registro ou classe esperados +% The variable or expression isn't of the type \var{record} or \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_Instâncias de classes ou objetos com métodos abstratos não são permitidas +% You are trying to generate an instance of a class which has an abstract +% method that wasn't overridden. +sym_w_label_not_defined=05014_W_Rótulo não definido "$1" +% A label was declared, but not defined. +sym_e_label_used_and_not_defined=05015_E_Rótulo usado mas não definido "$1" +% A label was declared and used, but not defined. +sym_e_ill_label_decl=05016_E_Declaração rótulo ilegal +% This error should never happen; it occurs if a label is defined outside a +% procedure or function. +sym_e_goto_and_label_not_supported=05017_E_GOTO e LABEL não são suportados (use a chave -Sg) +% You must use the -Sg switch to compile a program which has \var{label}s +% and \var{goto} statements. By default, \var{label} and \var{goto} aren't +% supported. +sym_e_label_not_found=05018_E_Rótulo não encontrado +% A \var{goto label} was encountered, but the label wasn't declared. +sym_e_id_is_no_label_id=05019_E_Identificador não é um rótulo +% The identifier specified after the \var{goto} isn't of type label. +sym_e_label_already_defined=05020_E_Rótulo já definido +% You are defining a label twice. You can define a label only once. +sym_e_ill_type_decl_set=05021_E_Declaração de tipo de conjunto de elementos ilegal +% The declaration of a set contains an invalid type definition. +sym_e_class_forward_not_resolved=05022_E_Declaração posterior de classe não resolvida "$1" +% You declared a class, but you did not implement it. +sym_n_unit_not_used=05023_H_Unidade "$1" não usada em $2 +% The unit referenced in the \var{uses} clause is not used. +sym_h_para_identifier_not_used=05024_H_Parâmetro "$1" não usado +% The identifier was declared (locally or globally) but +% was not used (locally or globally). +sym_n_local_identifier_not_used=05025_N_Variável local "$1" não usada +% You have declared, but not used, a variable in a procedure or function +% implementation. +sym_h_para_identifier_only_set=05026_H_Valor parâmetro "$1" é atribuído mas nunca usado +% The identifier was declared (locally or globally) and +% assigned to, but is not used (locally or globally) after the assignment. +sym_n_local_identifier_only_set=05027_N_Variável local "$1" é atribuída mas nunca usada +% The variable in a procedure or function implementation is declared and +% assigned to, but is not used after the assignment. +sym_h_local_symbol_not_used=05028_H_Local $1 "$2" não é usado +% A local symbol is never used. +sym_n_private_identifier_not_used=05029_N_Campo privado "$1.$2" nunca usado +% The indicated private field is defined, but is never used in the code. +sym_n_private_identifier_only_set=05030_N_Campo privado "$1.$2" é atribuído mas nunca usado +% The indicated private field is declared and assigned to, but never read. +sym_n_private_method_not_used=05031_N_Método privado "$1.$2" nunca usado +% The indicated private method is declared but is never used in the code. +sym_e_set_expected=05032_E_Tipo conjunto esperado +% The variable or expression is not of type \var{set}. This happens in an +% \var{in} statement. +sym_w_function_result_not_set=05033_W_Retorno da função parece não ter sido ajustado +% You can get this warning if the compiler thinks that a function return +% value is not set. This will not be displayed for assembler procedures, +% or procedures that contain assembler blocks. +sym_w_wrong_C_pack=05034_W_Tipo "$1" não está alinhado corretamente no atual registro para C +% Arrays with sizes not multiples of 4 will be wrongly aligned +% for C structures. +sym_e_illegal_field=05035_E_Identificador de campo de registro desconhecido "$1" +% The field doesn't exist in the record/object definition. +sym_w_uninitialized_local_variable=05036_W_Variável local "$1" não parece ter sido inicializada +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assignment). +sym_w_uninitialized_variable=05037_W_Variável "$1" parece não ter sido inicializada +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assignment). +sym_e_id_no_member=05038_E_Identificador não identifica nenhum membro "$1" +% This error is generated when an identifier of a record, +% field or method is accessed while it is not defined. +sym_h_param_list=05039_H_Declaração encontrada: $1 +% You get this when you use the \var{-vh} switch.In the case of an overloaded procedure +% not being found. Then all candidate overloaded procedures are +% listed, with their parameter lists. +sym_e_segment_too_large=05040_E_Elemento de dados muito grande +% You get this when you declare a data element whose size exceeds the +% prescribed limit (2 Gb on 80386+/68020+ processors). +sym_e_no_matching_implementation_found=05042_E_Nenhuma implementação coincidente para método interface "$1" encontrada +% There was no matching method found which could implement the interface +% method. Check argument types and result type of the methods. +sym_w_deprecated_symbol=05043_W_Símbolo "$1" está depreciado +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Use of this symbol +% should be avoided as much as possible. +sym_w_non_portable_symbol=05044_W_Símbolo "$1" não é portável +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{platform} is used. This symbol's value, use +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_non_implemented_symbol=05055_W_Símbolo "$1" não está implementado +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{unimplemented} is used. This symbol is defined, +% but is not yet implemented on this specific platform. +sym_e_cant_create_unique_type=05056_E_Impossível criar tipo único para este tipo +% Only simple types like ordinal, float and string types are supported when +% redefining a type with \var{type newtype = type oldtype;}. +sym_h_uninitialized_local_variable=05057_H_Variável local "$1" parece não ter sido inicializada +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. it did not appear in the left-hand side of an +% assignment). +sym_h_uninitialized_variable=05058_H_Variável "$1" parece não ter sido inicializada +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. it appears in the right-hand side of an expression) when it +% was not initialized first (i.e. t did not appear in the left-hand side of an +% assignment). +sym_w_function_result_uninitialized=05059_W_Variável de retorno da função parece não ter sido inicializada +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. it appears in the right-hand side of an expression) +% before it is initialized (i.e. before it appeared in the left-hand side of an +% assignment). +sym_h_function_result_uninitialized=05060_H_Variável de retorno da função parece não ter sido inicializada +% This message is displayed if the compiler thinks that the function result +% variable will be used (i.e. it appears in the right-hand side of an expression) +% before it is initialized (i.e. it appears in the left-hand side of an +% assignment) +sym_w_identifier_only_read=05061_W_Variável "$1" lida mas não atribuída em lugar algum +% You have read the value of a variable, but nowhere assigned a value to +% it. +sym_h_abstract_method_list=05062_H_Método abstrato encontrado: $1 +% When getting a warning about constructing a class/object with abstract methods +% you get this hint to assist you in finding the affected method. +sym_w_experimental_symbol=05063_W_Símbolo "$1" é experimental +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{experimental} is used. Experimental symbols +% might disappear or change semantics in future versions. Usage of this symbol +% should be avoided as much as possible. +sym_w_forward_not_resolved=05064_W_Declaração posterior "$1" não resolvida, assumida como externa +% This happens if you declare a function in the \var{interface} of a unit in macpas mode, +% but do not implement it. +sym_w_library_symbol=05065_W_Símbolo "$1" pertence a uma biblioteca +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{library} is used. Library symbols may not be +% available in other libraries. +sym_w_deprecated_symbol_with_msg=05066_W_Símbolo "$1" está depreciado: "$2" +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Use of this symbol +% should be avoided as much as possible. +sym_e_no_enumerator=05067_E_Impossível encontrar um enumerador para o tipo "$1" +% This means that compiler cannot find an apropriate enumerator to use in the for-in loop. +% To create an enumerator you need to defind an operator enumerator or add a public or published +% GetEnumerator method to the class or object definition. +sym_e_no_enumerator_move=05068_E_Impossível encontrar um método "MoveNext" no enumerador "$1" +% This means that compiler cannot find a public MoveNext method with the Boolean return type in +% the enumerator class or object definition. +sym_e_no_enumerator_current=05069_E_Impossível encontrar uma propriedade "Current" no enumerador "$1" +% This means that compiler cannot find a public Current property in the enumerator class or object +% definition. +sym_e_objc_para_mismatch=05070_E_Incompatibilidade entre número de parâmetros declarados e número de dois pontos (:) na 'string' mensagem. +% In Objective-C, a message name automatically contains as many colons as parameters. +% In order to prevent mistakes when specifying the message name in FPC, the compiler +% checks whether this is also the case here. Note that in case of messages taking a +% variable number of arguments translated to FPC via an \var{array of const} parameter, +% this final \var{array of const} parameter is not counted. Neither are the hidden +% \var{self} and \var{\_cmd} parameters. +sym_n_private_type_not_used=05071_N_Tipo privado "$1.$2" nunca usado +% The indicated private type is declared but is never used in the code. +sym_n_private_const_not_used=05072_N_Constante privada "$1.$2" nunca usada +% The indicated private const is declared but is never used in the code. +sym_n_private_property_not_used=05073_N_Propriedade privada "$1.$2" nunca usada +% The indicated private property is declared but is never used in the code. +sym_w_deprecated_unit=05074_W_Unidade "$1" está depreciada +% This means that a unit which is +% declared as \var{deprecated} is used. Deprecated units may no longer +% be available in newer versions of the library. Use of this unit +% should be avoided as much as possible. +sym_w_deprecated_unit_with_msg=05075_W_Unidade "$1" está depreciada: "$2" +% This means that a unit which is +% declared as \var{deprecated} is used. Deprecated units may no longer +% be available in newer versions of the library. Use of this unit +% should be avoided as much as possible. +sym_w_non_portable_unit=05076_W_Unidade "$1" não é portável +% This means that a unit which is +% declared as \var{platform} is used. This unit use +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_library_unit=05077_W_Unidade "$1" pertence a uma biblioteca +% This means that a unit which is +% declared as \var{library} is used. Library units may not be +% available in other libraries. +sym_w_non_implemented_unit=05078_W_Unidade "$1" não está implementada +% This means that a unit which is +% declared as \var{unimplemented} is used. This unit is defined, +% but is not yet implemented on this specific platform. +sym_w_experimental_unit=05079_W_Unidade "$1" é experimental +% This means that a unit which is +% declared as \var{experimental} is used. Experimental units +% might disappear or change semantics in future versions. Usage of this unit +% should be avoided as much as possible. +sym_e_objc_formal_class_not_resolved=05080_E_Nenhuma definição completa da classe objeto formalmente declarada "$1" está no escopo +% Objecive-C classes can be imported formally, without using the the unit in which it is fully declared. +% This enables making forward references to such classes and breaking circular dependencies amongst units. +% However, as soon as you wish to actually do something with an entity of this class type (such as +% access one of its fields, send a message to it, or use it to inherit from), the compiler requires the full definition +% of the class to be in scope. +sym_e_interprocgoto_into_init_final_code_not_allowed=05081_E_Gotos dentro de blocos de inicialização ou finalização de unidades não são permitidos +% Gotos into initialization or finalization blockse of units are not allowed. +sym_e_external_class_name_mismatch1=05082_E_Nome externo inválido "$1" para classe formal "$2" +sym_e_external_class_name_mismatch2=05083_E_Complete a definição de classe com nome externo "$1" aqui +% When a class is declared using a formal external definition, the actual external +% definition (if any) must specify the same external name as the formal definition +% (since both definitions refer to the same actual class type). +sym_w_library_overload=05084_W_Possível conflito em biblioteca: símbolo "$1" da biblioteca "$2" também encontrado na biblioteca "$3" +% Some OS do not have library specific namespaces, for those +% OS, the function declared as "external 'libname' name 'funcname'", +% the 'libname' part is only a hint, funcname might also be loaded +% by another library. This warning appears if 'funcname' is used twice +% with two different library names. +% +% \end{description} +# +# Codegenerator +# +# 06049 is the last used one +# +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +cg_e_parasize_too_big=06009_E_Tamanho da lista de parâmetros excede 65535 bytes +% The I386 processor limits the parameter list to 65535 bytes. (The \var{RET} +% instruction causes this.) +cg_e_file_must_call_by_reference=06012_E_Tipos Arquivos devem ser parâmetros var. +% You cannot specify files as value parameters, i.e., they must always be +% declared \var{var} parameters. +cg_e_cant_use_far_pointer_there=06013_E_O uso de ponteiro distante não é permitido lá +% Free Pascal doesn't support far pointers, so you cannot take the address of +% an expression which has a far reference as a result. The \var{mem} construct +% has a far reference as a result, so the following code will produce this +% error: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_Funções 'EXPORT' declaradas não podem ser chamadas +% No longer in use. +cg_w_member_cd_call_from_method=06016_W_Possível chamada ilegal de construtor ou destruidor +% The compiler detected that a constructor or destructor is called within a +% a method. This will probably lead to problems, since constructors / destructors +% require parameters on entry. +cg_n_inefficient_code=06017_N_Códio ineficiente +% Your statement seems dubious to the compiler. +cg_w_unreachable_code=06018_W_Código inacessível +% You specified a construct which will never be executed. Example: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_Métodos abstratos não podem ser chamados diretamente +% You cannot call an abstract method directly. Instead, you must call an +% overriding child method, because an abstract method isn't implemented. +cg_d_register_weight=06027_DL_Registro $1 peso $2 $3 +% Debugging message. Shown when the compiler considers a variable for +% keeping in the registers. +cg_d_stackframe_omited=06029_DL_Quadro da pilha é omitido +% Some procedure/functions do not need a complete stack-frame, so it is omitted. +% This message will be displayed when the {-vd} switch is used. +cg_e_unable_inline_object_methods=06031_E_Objeto ou métodos classe não podem ser 'em linha'. +% You cannot have inlined object methods. +cg_e_unable_inline_procvar=06032_E_Chamadas 'Procvar' não podem ser 'em linha'. +% A procedure with a procedural variable call cannot be inlined. +cg_e_no_code_for_inline_stored=06033_E_Nenhum código para procedimento 'em linha' armazenado +% The compiler couldn't store code for the inline procedure. +cg_e_can_access_element_zero=06035_E_Elemento zero de uma 'ansi/wide-' ou stringlonga pode ser acessado, usar '(set)length' +% You should use \var{setlength} to set the length of an ansi/wide/longstring +% and \var{length} to get the length of such string type. +cg_e_cannot_call_cons_dest_inside_with=06037_E_Construtores ou destruidores não podem ser chamados de dentro de uma cláusula 'with' +% Inside a \var{with} clause you cannot call a constructor or destructor for the +% object you have in the \var{with} clause. +cg_e_cannot_call_message_direct=06038_E_Impossível chamar métodos manipuladores de mensagem diretamente +% A message method handler method cannot be called directly if it contains an +% explicit \var{Self} argument. +cg_e_goto_inout_of_exception_block=06039_E_Salto interno ou externo a um bloco de exceção +% It is not allowed to jump in or outside of an exception block like \var{try..finally..end;}. +% For example, the following code will produce this error: + +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // this line will cause an error +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_Instruções de controle de fluxo não são permitidos em um bloco 'finally' +% It isn't allowed to use the control flow statements \var{break}, +% \var{continue} and \var{exit} +% inside a finally statement. The following example shows the problem: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // This exit ISN'T allowed +% end; +% ... +% +% \end{verbatim} +% If the procedure \var{p} raises an exception the finally block is +% executed. If the execution reaches the exit, it's unclear what to do: +% exit the procedure or search for another exception handler. +cg_w_parasize_too_big=06041_W_Tamanho parâmetros excede limite para certas CPU's +% This indicates that you are declaring more than 64K of parameters, which +% might not be supported on other processor targets. +cg_w_localsize_too_big=06042_W_Tamanho variável local excede limite para certas CPU's +% This indicates that you are declaring more than 32K of local variables, which +% might not be supported on other processor targets. +cg_e_localsize_too_big=06043_E_Tamanho variáveis locais excedem limites suportados +% This indicates that you are declaring more than 32K of local variables, which +% is not supported by this processor. +cg_e_break_not_allowed=06044_E_BREAK não permitido +% You're trying to use \var{break} outside a loop construction. +cg_e_continue_not_allowed=06045_E_CONTINUE não permitido +% You're trying to use \var{continue} outside a loop construction. +cg_f_unknown_compilerproc=06046_F_'Compilerproc' desconhecido "$1". Verifique se você usa a biblioteca de tempo de execução correta +% The compiler expects that the runtime library contains certain subroutines. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the compiler in use. If you changed the runtime library this error means +% that you removed a subroutine which the compiler needs for internal use. +cg_f_unknown_system_type=06047_F_Impossível encontrar tipo sistema "$1". Verifique se você usa a biblioteca de tempo de execução correta +% The compiler expects that the runtime library contains certain type definitions. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the compiler in use. If you changed the runtime library this error means +% that you removed a type which the compiler needs for internal use. +cg_h_inherited_ignored=06048_H_Chamada herdada para método abstrato ignorada +% This message appears only in Delphi mode when you call an abstract method +% of a parent class via \var{inherited;}. The call is then ignored. +cg_e_goto_label_not_found=06049_E_Rótulo 'Goto' "$1" não definido ou eliminado pela otimização +% The label used in the goto definition is not defined or optimized away by the +% unreachable code elemination. +cg_f_unknown_type_in_unit=06050_F_Impossível encontrar o tipo "$1" na unidade "$2". Verifique se você usa a biblioteca de tempo de execução correta. +% The compiler expects that the runtime library contains certain type definitions. If you see this error +% and you didn't change the runtime library code, it's very likely that the runtime library +% you're using doesn't match the compiler in use. If you changed the runtime library this error means +% that you removed a type which the compiler needs for internal use. +cg_e_interprocedural_goto_only_to_outer_scope_allowed=06051_E_Gotos interprocedimentos são permitidos apenas para subrotinas externas +% Gotos between subroutines are only allowed if the goto jumps from an inner to an outer subroutine or +% from a subroutine to the main program +cg_e_labels_cannot_defined_outside_declaration_scope=06052_E_Rótulo deve ser definido no mesmo escopo em que é declarado +% In ISO mode, labels must be defined in the same scope as they are declared. +cg_e_goto_across_procedures_with_exceptions_not_allowed=06053_E_Deixar procedimentos contendo quadros de exceções explícitas ou implícitas usando 'goto' não é permitido +% Non-local gotos might not be used to leave procedures using exceptions either implicitly or explicitly. Procedures +% which use automated types like ansistrings or class constructurs are affected by this too. +cg_e_mod_only_defined_for_pos_quotient=06054_E_No modo ISO, o operador 'mod' é definido apenas para quociente positivo +% In ISO pascal, only positive values are allowed for the quotient: \var{n mod m} is only valid if \var{m>0}. +% \end{description} +# EndOfTeX + +# +# Assembler reader +# +# 07110 is the last used one +# +asmr_d_start_reading=07000_DL_Iniciando $1 análise estilo assembler +% This informs you that an assembler block is being parsed +asmr_d_finish_reading=07001_DL_Finalizada $1 análise estilo assembler +% This informs you that an assembler block has finished. +asmr_e_none_label_contain_at=07002_E_Padrão não-rótulo contêm @ +% A identifier which isn't a label can't contain a @. +asmr_e_building_record_offset=07004_E_Erro construindo deslocamento registro +% There has an error occured while building the offset of a record/object +% structure, this can happend when there is no field specified at all or +% an unknown field identifier is used. +asmr_e_offset_without_identifier=07005_E_'OFFSET' usado sem identificador +% You can only use OFFSET with an identifier. Other syntaxes aren't +% supported +asmr_e_type_without_identifier=07006_E_'TYPE' usado sem identificador +% You can only use TYPE with an identifier. Other syntaxes aren't +% supported +asmr_e_no_local_or_para_allowed=07007_E_Impossível usar variável local ou parâmetro aqui +% You can't use a local variable or parameter here, mostly because the +% addressing of locals and parameters is done using the frame pointer register so the +% address can't be obtained directly. +asmr_e_need_offset=07008_E_Necessário usar 'OFFSET' aqui +% You need to use OFFSET <id> here to get the address of the identifier. +asmr_e_need_dollar=07009_E_Necessário usar $ aqui +% You need to use $<id> here to get the address of the identifier. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_Impossível usar múltiplos símbolos relocáveis +% You can't have more than one relocatable symbol (variable/typed constant) +% in one argument. +asmr_e_only_add_relocatable_symbol=07011_E_Símbolo relocável pode apenas ser adicionado +% Relocatable symbols (variable/typed constant) can't be used with other +% operators. Only addition is allowed. +asmr_e_invalid_constant_expression=07012_E_Expressão constante inválida +% There is an error in the constant expression. +asmr_e_relocatable_symbol_not_allowed=07013_E_Símbolo relocável não é permitido +% You can't use a relocatable symbol (variable/typed constant) here. +asmr_e_invalid_reference_syntax=07014_E_Sintaxe referência inválida +% There is an error in the reference. +asmr_e_local_para_unreachable=07015_E_Você não pode atingir $1 a partir desse código +% You cannot read directly the value of a local variable or parameter +% of a higher level procedure in assembler code (except for +% local assembler code without parameter nor locals). +asmr_e_local_label_not_allowed_as_ref=07016_E_Símbolos locais/rótulos não são permitidos como referências +% You can't use local symbols/labels as references +asmr_e_wrong_base_index=07017_E_Uso registro base e índice inválido +% There is an error with the base and index register, they are +% probably incorrect +asmr_w_possible_object_field_bug=07018_W_Possível erro na manipulação de campo de objeto +% Fields of objects or classes can be reached directly in normal or objfpc +% modes but TP and Delphi modes treat the field name as a simple offset. +asmr_e_wrong_scale_factor=07019_E_Fator incorreto de escala especificado +% The scale factor given is wrong, only 1,2,4 and 8 are allowed +asmr_e_multiple_index=07020_E_Uso múltiplo registro índice +% You are trying to use more than one index register +asmr_e_invalid_operand_type=07021_E_Tipo operando inválido +% The operand type doesn't match with the opcode used +asmr_e_invalid_string_as_opcode_operand=07022_E_'String' inválido como operando 'opcode': $1 +% The string specified as operand is not correct with this opcode +asmr_w_CODE_and_DATA_not_supported=07023_W_@CODE e @DATA não suportados +% @CODE and @DATA are unsupported and are ignored. +asmr_e_null_label_ref_not_allowed=07024_E_Referências nulas de rótulos não são permitidas +asmr_e_expr_zero_divide=07025_E_Divisão por zero em avaliador asm +% There is a division by zero in a constant expression +asmr_e_expr_illegal=07026_E_Expressao ilegal +% There is an illegal expression in a constant expression +asmr_e_escape_seq_ignored=07027_E_Sequência de escape ignorada: $1 +% There is a C-styled string, but the escape sequence in the string +% is unknown, and is therefore ignored +asmr_e_invalid_symbol_ref=07028_E_Referência símbolo inválida +asmr_w_fwait_emu_prob=07029_W_Fwait pode causar problemas de emulação com emu387 +asmr_w_fadd_to_faddp=07030_W_$1 sem operando traduzido em $1P +asmr_w_enter_not_supported_by_linux=07031_W_Instrução 'ENTER' não suportada pelo kernel Linux +% ENTER instruction can generate a stack page fault that is not +% caught correctly by the i386 Linux page handler. +asmr_w_calling_overload_func=07032_W_Chamando uma função sobrecarregada em assembler +% There is a call to an overloaded method in the assembler block, +% this might be the sign there is a problem +asmr_e_unsupported_symbol_type=07033_E_Tipo símbolo não suportado para operando +asmr_e_constant_out_of_bounds=07034_E_Valor constante fora de faixa +asmr_e_error_converting_decimal=07035_E_Erro convertendo decimal $1 +% A constant decimal value does not have the correct syntax +asmr_e_error_converting_octal=07036_E_Erro convertendo octal $1 +% A constant octal value does not have the correct syntax +asmr_e_error_converting_binary=07037_E_Erro convertendo binário $1 +% A constant binary value does not have the correct syntax +asmr_e_error_converting_hexadecimal=07038_E_Erro convertendo hexadecimal $1 +% A constant hexadecimal value does not have the correct syntax +asmr_h_direct_global_to_mangled=07039_H_$1 traduzido para $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 está associado a uma função sobrecarregada +asmr_e_cannot_use_SELF_outside_a_method=07041_E_Impossível usar 'SELF' fora de um método +% There is a reference to the \var{self} symbol while it is not +% allowed. \var{self} can only be referenced inside methods +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_Impossível usar 'OLDEBP' fora de um procedimento aninhado +% There is a reference to the \var{oldebp} symbol while it is not +% allowed. \var{oldebp} can only be referenced inside nested routines +asmr_e_void_function=07043_W_Procedimentos não podem retornar qualquer valor em código asm +% Trying to return a value while in a procedure. A procedure +% does not have any return value +asmr_e_SEG_not_supported=07044_E_SEG não suportado +asmr_e_size_suffix_and_dest_dont_match=07045_E_Tamanho sufixo e tamanho destino ou fonte não coincidem +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_w_size_suffix_and_dest_dont_match=07046_W_Tamanho sufixo e tamanho destino ou fonte não coincidem +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_e_syntax_error=07047_E_Erro de sintaxe assembler +% There is an assembler syntax error +asmr_e_invalid_opcode_and_operand=07048_E_Combinação inválida de 'opcode' e operandos +% The opcode cannot be used with this type of operand +asmr_e_syn_operand=07049_E_Erro de sintaxe assembler em operando +asmr_e_syn_constant=07050_E_Erro de sintaxe assembler em constante +asmr_e_invalid_string_expression=07051_E_Expressão 'String' inválida +asmr_w_const32bit_for_address=07052_W_Constante com símbolo $1 para endereço que não está em um ponteiro +% A constant expression represents an address which does not fit +% into a pointer. The address is probably incorrect +asmr_e_unknown_opcode=07053_E_'Opcode' desconhecido $1 +% This opcode is not known +asmr_e_invalid_or_missing_opcode=07054_E_'Opcode' inválido ou faltando +asmr_e_invalid_prefix_and_opcode=07055_E_Combinação inválida de prefixo e 'opcode': $1 +asmr_e_invalid_override_and_opcode=07056_E_Combinação inválida de 'override' e 'opcode': $1 +asmr_e_too_many_operands=07057_E_Muitos operandos na linha +% There are too many operands for this opcode. Check your +% assembler syntax +asmr_w_near_ignored=07058_W_NEAR ignorado +asmr_w_far_ignored=07059_W_FAR ignorado +asmr_e_dup_local_sym=07060_E_Símbolo local duplicado $1 +asmr_e_unknown_local_sym=07061_E_Símbolo local indefinido $1 +asmr_e_unknown_label_identifier=07062_E_Identificador rótulo desconhecido $1 +asmr_e_invalid_register=07063_E_Nome registro inválido +% There is an unknown register name used as operand. +asmr_e_invalid_fpu_register=07064_E_Nome registro ponto flutuante inválido +% There is an unknown register name used as operand. +asmr_w_modulo_not_supported=07066_W_Módulo não suportado +asmr_e_invalid_float_const=07067_E_Constante ponto flutuante inválida $1 +% The floating point constant declared in an assembler block is +% invalid. +asmr_e_invalid_float_expr=07068_E_Expressão ponto flutuante inválida +% The floating point expression declared in an assembler block is +% invalid. +asmr_e_wrong_sym_type=07069_E_Tipo símbolo incorreto +asmr_e_cannot_index_relative_var=07070_E_Impossível indexar uma var. local ou parâmetro com um registro +% Trying to index using a base register a symbol which is already relative +% to a register. This is not possible, and will probably lead to crashes. +asmr_e_invalid_seg_override=07071_E_Expressão sobreposição segmento inválida +asmr_w_id_supposed_external=07072_W_Identificador $1 supostamente externo +% There is a reference to an undefined symbol. This will not result +% in an error, since the symbol might be external, but may cause +% problems at link time if the symbol is not defined anywhere. +asmr_e_string_not_allowed_as_const=07073_E_'Strings' não permitidas como constantes +% Character strings are not allowed as constants. +asmr_e_no_var_type_specified=07074_E_Nenhum tipo de variável especificado +% The syntax expects a type idenfitifer after the dot, but +% none was found. +asmr_w_assembler_code_not_returned_to_text=07075_E_Código assembler não retornou a seção texto +% There was a directive in the assembler block to change sections, +% but there is a missing return to the text section at the end +% of the assembler block. This might cause errors during link time. +asmr_e_not_directive_or_local_symbol=07076_E_Não é uma diretiva ou símbolo local $1 +% This symbol is unknown. +asmr_w_using_defined_as_local=07077_E_Usando um nome definido como um rótulo local +asmr_e_dollar_without_identifier=07078_E_Caracter Dólar é usado sem um identificador +% A constant expression has an identifier which does not start with +% the $ symbol. +asmr_w_32bit_const_for_address=07079_W_Constante 32bit criada para endereço +% A constant was used as an address. This is probably an error, +% since using absolute addresses will probably not work. +asmr_n_align_is_target_specific=07080_N_'.align' é específico de alvo, use '.balign' ou '.p2align' +% Using the .align directive is platform specific, and its meaning will vary +% from one platform to another. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_Impossível acessar campos diretamente para parâmetros +% You should load the parameter first into a register and then access the +% fields using that register. +asmr_e_cannot_access_object_field_directly=07082_E_Impossível acessar campos de objetos/classes diretamente +% You should load the self pointer first into a register and then access the +% fields using the register as base. By default the self pointer is available +% in the esi register on i386. +asmr_e_unable_to_determine_reference_size=07083_E_Tamanho não especificado e incapaz de determinar o tamanho dos operandos +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. +asmr_e_cannot_use_RESULT_here=07084_E_Impossível usar 'RESULT' nesta função +% Some functions which return complex types cannot use the \var{result} +% keyword. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" sem operando traduzido em "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" traduzido em "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" translated em "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_Caracter < não permitido aqui +% The shift operator requires the << characters. Only one +% of those characters was found. +asmr_e_invalid_char_greater=07090_E_Caracter > não permitido aqui +% The shift operator requires the >> characters. Only one +% of those characters was found. +asmr_w_align_not_supported=07093_W_ALIGN não suportado +asmr_e_no_inc_and_dec_together=07094_E_'Inc' e 'Dec' não podem estar juntos +% Trying to use an increment and a decrement within the same +% opcode on the 680x0. This is impossible. +asmr_e_invalid_reg_list_in_movem=07095_E_'Reglist' para 'movem' inválido +% Trying to use the \var{movem} opcode with invalid registers +% to save or restore. +asmr_e_invalid_reg_list_for_opcode=07096_E_'Reglist' inválido para 'opcode' +asmr_e_higher_cpu_mode_required=07097_E_Modo CPU maior requerido ($1) +% Trying to use an instruction which is not supported in the current +% cpu mode. Use a higher cpu generation to be able to use this +% opcode in your assembler block +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_Nenhum tamanho especificado e incapaz de determinar o tamanho dos operandos, usando DWORD como padrão +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use DWORD as default. +asmr_e_illegal_shifterop_syntax=07099_E_Erro de sintaxe tentando analisar um operando deslocamento +% ARM only; ARM assembler supports a so called shifter operand. The used syntax isn't +% a valid shifter operand. Example for an operation with shifter operand: +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +asmr_e_packed_element=07100_E_Endereço de componente compactado não está no limite byte +% Packed components (record fields and array elements) may start at an arbitrary +% bit inside a byte. On CPU which do not support bit-addressable memory (which +% includes all currently supported CPUs by FPC) you will therefore get an error +% message when trying to index arrays with elements whose size is not a multiple +% of 8 bits. The same goes for accessing record fields with such an address. +% multiple of 8 bits. +asmr_w_unable_to_determine_reference_size_using_byte=07101_W_Nenhum tamanho especificado e incapaz de determinar o tamanho dos operandos, usando BYTE como padrão +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use BYTE as default. +asmr_w_no_direct_ebp_for_parameter=07102_W_Uso de '+offset(%ebp)' para parâmetros inválido aqui +% Using direct 8(%ebp) reference for function/procedure parameters is invalid +% if parameters are in registers. +asmr_w_direct_ebp_for_parameter_regcall=07103_W_Uso de '+offset(%ebp)' não é compatível com a convenção 'regcall' +% Using direct 8(%ebp) reference for function/procedure parameters is invalid +% if parameters are in registers. +asmr_w_direct_ebp_neg_offset=07104_W_Uso de '-offset(%ebp)' não é recomendada para acesso a variável local +% Using -8(%ebp) to access a local variable is not recommended +asmr_w_direct_esp_neg_offset=07105_W_Uso de '-offset(%esp)', acesso pode causar travamento ou valor pode ser perdido +% Using -8(%esp) to access a local stack is not recommended, as +% this stack portion can be overwritten by any function calls or interrupts. +asmr_e_no_vmtoffset_possible=07106_E_'VMTOffset' deve ser usado em combinação com um método virtual, e "$1" não é virtual +% Only virtual methods have VMT offsets +asmr_e_need_pic_ref=07107_E_Gerando PIC, mas referência não é segura (PIC-safe) +% The compiler has been configured to generate position-independent code +% (PIC), but there are position-dependent references in the current +% handwritten assembler instruction. +asmr_e_mixing_regtypes=07108_E_Todos os registros em um conjunto de registros devem ser do mesmo tipo e largura +% Instructions on the ARM architecture that take a register set as argument require that all registers +% in this set are of the same kind (e.g., integer, vfp) and width (e.g., single precision, double precision). +asmr_e_empty_regset=07109_E_Um conjunto de registros não pode estar vazio +% Instructions on the ARM architecture that take a register set as argument require that such a set +% contains at least one register. + +asmr_w_useless_got_for_local=07110_W_@GOTPCREL é inútil e potencialmente perigoso para símbolos locais +% The use of @GOTPCREL supposes an extra indirection that is +% not present if the symbol is local, which might lead to wrong asembler code +asmr_w_general_segment_with_constant=07111_W_Constante com registro de segmento de propósito geral +% General purpose register should not have constant offsets +% as OS memory allocation might not be compatible with that. +asmr_e_bad_seh_directive_offset=07112_E_Valor de deslocamento inválido para $1 +% Win64 SEH directives have certain restrictions on possible offset values, e.g. they should +% be positive and have 3 or 4 low bits clear. +asmr_e_bad_seh_directive_register=07113_E_Registro inválido para $1 +% Win64 SEH directives accept only 64-bit integer registers or XMM registers. +asmr_e_seh_in_pure_asm_only=07114_E_Diretivas SEH são permitidas apenas em procedimentos assembler puros +% Win64 SEH directives are allowed only in pure assembler procedures, not in assembler +% blocks of regular procedures. +asmr_e_unsupported_directive=07115_E_Diretiva "$1" não é suportada pelo alvo atual + + +# +# Assembler/binary writers +# +# 08022 is the last used one +# +asmw_f_too_many_asm_files=08000_F_Muitos arquivos assembler +% With smartlinking enabled, there are too many assembler +% files generated. Disable smartlinking. +asmw_f_assembler_output_not_supported=08001_F_Saída assembler selecionada não suportada +asmw_f_comp_not_supported=08002_F_'Comp' não suportado +asmw_f_direct_not_supported=08003_F_Modo direto não suportado por gravadores binários +% Direct assembler mode is not supported for binary writers. +asmw_e_alloc_data_only_in_bss=08004_E_Alocamento de dados somente permitida na seção 'bss' +asmw_f_no_binary_writer_selected=08005_F_Nenhum gravador binário selecionado +asmw_e_opcode_not_in_table=08006_E_Asm: Opcode $1 não está na tabela +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 combinação inválida de 'opcode' e operandos +asmw_e_16bit_not_supported=08008_E_Asm: referências 16 Bits não suportadas +asmw_e_invalid_effective_address=08009_E_Asm: Endereço efetivo inválido +asmw_e_immediate_or_reference_expected=08010_E_Asm: Esperados 'Immediate' ou referência +asmw_e_value_exceeds_bounds=08011_E_Asm: $1 valor excede limites $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: Salto curto fora de faixa $1 +asmw_e_undefined_label=08013_E_Asm: Rótulo indefinido $1 +asmw_e_comp_not_supported=08014_E_Asm: Tipo 'Comp' não suportado por este alvo +asmw_e_extended_not_supported=08015_E_Asm: Tipo extendido não suportado por este alvo +asmw_e_duplicate_label=08016_E_Asm: Rótulo duplicado $1 +asmw_e_redefined_label=08017_E_Asm: Rótulo redefinido $1 +asmw_e_first_defined_label=08018_E_Asm: Primeiramente definido aqui +asmw_e_invalid_register=08019_E_Asm: Registro inválido $1 +asmw_e_16bit_32bit_not_supported=08020_E_Asm: Referências 16 ou 32 Bits não suportadas +asmw_e_64bit_not_supported=08021_E_Asm: Operandos 64 Bits não suportados +asmw_e_bad_reg_with_rex=08022_E_Asm: AH,BH,CH ou DH não podem ser usados em uma instrução que requer o prefixo REX +% x86_64 only: instruction encoding of this platform does not allow using +% 8086 high byte registers (AH,BH,CH or DH) together with REX prefix in a single instruction. +% The REX prefix is required whenever the instruction operand size is 64 bits, or +% when it uses one of extended x86_64 registers (R8-R15 or XMM8-XMM15). +asmw_e_missing_endprologue=08023_E_Diretiva .seh_endprologue faltando +% x86_64-win64 only: Normally, SEH directives are handled internally by compiler. +% However, in pure assembler procedures .seh_endprologue directive is required +% if other SEH directives are present. +asmw_e_prologue_too_large=08024_E_Prólogo da função excede 255 bytes +% x86_64-win64: .seh_prologue directive must be placed within 255 bytes from function start. +asmw_e_handlerdata_no_handler=08025_E_Diretiva .seh_handlerdata sem .seh_handler precedente +% x86_64-win64: If .seh_handlerdata directive is used, then a .seh_handler directive must be +% present earlier in the same function. + +# +# Executing linker/assembler +# +# 09033 is the last used one +# +# BeginOfTeX +% +% \section{Errors of assembling/linking stage} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +exec_w_source_os_redefined=09000_W_Sistema operacional fonte redefinido +% The source operating system is redefined. +exec_i_assembling_pipe=09001_I_Montando (pipe) $1 +% Assembling using a pipe to an external assembler. +exec_d_cant_create_asmfile=09002_E_Impossível criar arquivo assembler: $1 +% The mentioned file can't be created. Check if you have +% access permissions to create this file. +exec_e_cant_create_objectfile=09003_E_Impossível criar arquivo objeto: $1 +% The mentioned file can't be created. Check if you have +% got access permissions to create this file. +exec_e_cant_create_archivefile=09004_E_Impossível criar arquivo: $1 +% The mentioned file can't be created. Check if you have +% access permissions to create this file. +exec_e_assembler_not_found=09005_E_Montador $1 não encontrado, mudando para montador externo +% The assembler program was not found. The compiler will produce a script that +% can be used to assemble and link the program. +exec_t_using_assembler=09006_T_Usando montador: $1 +% An informational message saying which assembler is being used. +exec_e_error_while_assembling=09007_E_Erro ao montar código saída $1 +% There was an error while assembling the file using an external assembler. +% Consult the documentation of the assembler tool to find out more information +% on this error. +exec_e_cant_call_assembler=09008_E_Impossível chamar montador, erro $1 mudando para montador externo +% An error occurred when calling an external assembler. The compiler will produce a script that +% can be used to assemble and link the program. +exec_i_assembling=09009_I_Montando $1 +% An informational message stating which file is being assembled. +exec_i_assembling_smart=09010_I_Montando com vinculação inteligente $1 +% An informational message stating which file is being assembled using smartlinking. +exec_w_objfile_not_found=09011_W_Objeto $1 não encontrado, Vinculação pode falhar ! +% One of the object files is missing, and linking will probably fail. +% Check your paths. +exec_w_libfile_not_found=09012_W_Biblioteca $1 não encontrada, Vinculação pode falhar ! +% One of the library files is missing, and linking will probably fail. +% Check your paths. +exec_e_error_while_linking=09013_E_Erro durante vinculação +% Generic error while linking. +exec_e_cant_call_linker=09014_E_Impossível chamar vinculador, mudando para vinculação externa +% An error occurred when calling an external linker. The compiler will produce a script that +% can be used to assemble and link the program. +exec_i_linking=09015_I_Vinculando $1 +% An informational message, showing which program or library is being linked. +exec_e_util_not_found=09016_E_Utilitário $1 não encontrado, mudando para vinculação externa +% An external tool was not found. The compiler will produce a script that +% can be used to assemble and link or postprocess the program. +exec_t_using_util=09017_T_Usando utilitário $1 +% An informational message, showing which external program (usually a postprocessor) is being used. +exec_e_exe_not_supported=09018_E_Criação de Executáveis não suportada +% Creating executable programs is not supported for this platform, because it was +% not yet implemented in the compiler. +exec_e_dll_not_supported=09019_E_Criação de bibliotecas Dinâmicas/Compartilhadas não suportada +% Creating dynamically loadable libraries is not supported for this platform, because it was +% not yet implemented in the compiler. +exec_i_closing_script=09020_I_Fechando roteiro $1 +% Informational message showing when writing of the external assembling and linking script is finished. +exec_e_res_not_found=09021_E_Compilador recursos "$1" não encontrado, mudando para modo externo +% An external resource compiler was not found. The compiler will produce a script that +% can be used to assemble, compile resources and link or postprocess the program. +exec_i_compilingresource=09022_I_Compilando recursos $1 +% An informational message, showing which resource is being compiled. +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_Unidade $1 não pode ser vinculada estaticamente, mudando para vinculação inteligente +% Static linking was requested, but a unit which is not statically linkable was used. +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_Unidade $1 não pode ser vinculada inteligentemente, mudando para vinculação estática +% Smart linking was requested, but a unit which is not smart-linkable was used. +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_Unidade $1 não pode ser vinculada compartilhadamente, mudando para vinculação estática +% Shared linking was requested, but a unit which is not shared-linkable was used. +exec_e_unit_not_smart_or_static_linkable=09026_E_Unidade $1 não pode ser vinculada inteligentemente ou estaticamente +% Smart or static linking was requested, but a unit which cannot be used for either was used. +exec_e_unit_not_shared_or_static_linkable=09027_E_Unidade $1 não pode ser vinculada compartilhadamente ou estaticamente +% Shared or static linking was requested, but a unit which cannot be used for either was used. +exec_d_resbin_params=09028_D_Chamando compilador recursos "$1" com "$2" como linha comando +% An informational message showing which command line is used for the resource compiler. +exec_e_error_while_compiling_resources=09029_E_Erro ao compilar recursos +% The resource compiler or converter returned an error. +exec_e_cant_call_resource_compiler=09030_E_Impossível chamar o compilador recursos "$1", mudando para modo externo +% An error occurred when calling a resource compiler. The compiler will produce +% a script that can be used to assemble, compile resources and link or +% postprocess the program. +exec_e_cant_open_resource_file=09031_E_Impossível abrir arquivo recursos "$1" +% An error occurred resource file cannot be opened. +exec_e_cant_write_resource_file=09032_E_Impossível gravar arquivo recursos "$1" +% An error occurred resource file cannot be written. +exec_n_backquote_cat_file_not_found=09033_N_Arquivo "$1" não encontrado para comando 'cat' entre aspas +% The compiler did not find the file that should be expanded into linker parameters +%\end{description} +# EndOfTeX + +# +# Executable information +# +# 09134 is the last used one +# +# BeginOfTeX +% \section{Executable information messages.} +% This section lists all messages that the compiler emits when an executable program is produced, +% and only when the internal linker is used. +% \begin{description} +execinfo_f_cant_process_executable=09128_F_Impossível pós-processar executável $1 +% Fatal error when the compiler is unable to post-process an executable. +execinfo_f_cant_open_executable=09129_F_Impossível abrir executável $1 +% Fatal error when the compiler cannot open the file for the executable. +execinfo_x_codesize=09130_X_Tamanho do Código: $1 bytes +% Informational message showing the size of the produced code section. +execinfo_x_initdatasize=09131_X_Tamanho dos dados inicializados: $1 bytes +% Informational message showing the size of the initialized data section. +execinfo_x_uninitdatasize=09132_X_Tamanho dos dados não inicializados: $1 bytes +% Informational message showing the size of the uninitialized data section. +execinfo_x_stackreserve=09133_X_Espaço da Pilha reservado: $1 bytes +% Informational message showing the stack size that the compiler reserved for the executable. +execinfo_x_stackcommit=09134_X_Espaço da Pilha confirmado: $1 bytes +% Informational message showing the stack size that the compiler committed for the executable. +%\end{description} +# EndOfTeX + +# +# Internal linker messages +# +# 09200 is the last used one +# +# BeginOfTeX +% \section{Linker messages} +% This section lists messages produced by internal linker. +% \begin{description} +link_f_executable_too_big=09200_F_Tamanho imagem executável é muito grande para alvo $1. +% Fatal error when resulting executable is too big. +link_w_32bit_absolute_reloc=09201_W_Arquivo objeto "$1" contêm relocação absoluta de 32-bits para símbolo "$2". +% Warning when 64-bit object file contains 32-bit absolute relocations. +% In such case an executable image can be loaded into lower 4Gb of +% address space only. +%\end{description} +# EndOfTeX + +# +# Unit loading +# +# 10062 is the last used one +# +# BeginOfTeX +% \section{Unit loading messages.} +% This section lists all messages that can occur when the compiler is +% loading a unit from disk into memory. Many of these messages are +% informational messages. +% \begin{description} +unit_t_unitsearch=10000_T_Busca Unidade: $1 +% When you use the \var{-vt} option, the compiler tells you where it tries to find +% unit files. +unit_t_ppu_loading=10001_T_Carregando PPU $1 +% When the \var{-vt} switch is used, the compiler tells you +% what units it loads. +unit_u_ppu_name=10002_U_Nome PPU: $1 +% When you use the \var{-vu} flag, the unit name is shown. +unit_u_ppu_flags=10003_U_PPU 'Flags': $1 +% When you use the \var{-vu} flag, the unit flags are shown. +unit_u_ppu_crc=10004_U_PPU 'Crc': $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_time=10005_U_Hora PPU: $1 +% When you use the \var{-vu} flag, the time the unit was compiled is shown. +unit_u_ppu_file_too_short=10006_U_Arquivo PPU muito pequeno +% The ppufile is too short, not all declarations are present. +unit_u_ppu_invalid_header=10007_U_Cabeçalho PPU inválido (sem PPU no começo) +% A unit file contains as the first three bytes the ASCII codes of the characters \var{PPU}. +unit_u_ppu_invalid_version=10008_U_Versão PPU inválida $1 +% This unit file was compiled with a different version of the compiler, and +% cannot be read. +unit_u_ppu_invalid_processor=10009_U_PPU foi compilado para outro processador +% This unit file was compiled for a different processor type, and +% cannot be read. +unit_u_ppu_invalid_target=10010_U_PPU foi compilado para outro alvo +% This unit file was compiled for a different target, and +% cannot be read. +unit_u_ppu_source=10011_U_Fonte PPU: $1 +% When you use the \var{-vu} flag, the unit source file name is shown. +unit_u_ppu_write=10012_U_Gravando $1 +% When you specify the \var{-vu} switch, the compiler will tell you where it +% writes the unit file. +unit_f_ppu_cannot_write=10013_F_Impossível gravar arquivo PPU +% An error occurred when writing the unit file. +unit_f_ppu_read_error=10014_F_Erro ao ler arquivo PPU +% This means that the unit file was corrupted, and contains invalid +% information. Recompilation will be necessary. +unit_f_ppu_read_unexpected_end=10015_F_Fim de arquivo PPU inesperado +% Unexpected end of file. This may mean that the PPU file is +% corrupted. +unit_f_ppu_invalid_entry=10016_F_Entrada inválida arquivo PPU: $1 +% The unit the compiler is trying to read is corrupted, or generated with a +% newer version of the compiler. +unit_f_ppu_dbx_count_problem=10017_F_Problema contagem Dbx PPU +% There is an inconsistency in the debugging information of the unit. +unit_e_illegal_unit_name=10018_E_Nome unidade ilegal: $1 +% The name of the unit does not match the file name. +unit_f_too_much_units=10019_F_Muitas unidades +% \fpc has a limit of 1024 units in a program. You can change this behavior +% by changing the \var{maxunits} constant in the \file{fmodule.pas} file of the +% compiler, and recompiling the compiler. +unit_f_circular_unit_reference=10020_F_Referência circular em unidade entre $1 e $2 +% Two units are using each other in the interface part. This is only allowed +% in the \var{implementation} part. At least one unit must contain the other one +% in the \var{implementation} section. +unit_f_cant_compile_unit=10021_F_Impossível compilar unidade $1, nenhum fonte disponível +% A unit was found that needs to be recompiled, but no sources are +% available. +unit_f_cant_find_ppu=10022_F_Impossível localizar unidade $1 usada por $2 +% You tried to use a unit of which the PPU file isn't found by the +% compiler. Check your configuration file for the unit paths. +unit_w_unit_name_error=10023_W_Unidade $1 não foi encontrada mas $2 existe +% This error message is no longer used. +unit_f_unit_name_error=10024_F_Unidade $1 foi procurada mas $2 encontrada +% \dos truncation of 8 letters for unit PPU files +% may lead to problems when unit name is longer than 8 letters. +unit_w_switch_us_missed=10025_W_Compilar a unidade 'system' requer a chave -Us +% When recompiling the system unit (it needs special treatment), the +% \var{-Us} switch must be specified. +unit_f_errors_in_unit=10026_F_Houveram $1 erros ao compilar módulo, parando +% When the compiler encounters a fatal error or too many errors in a module +% then it stops with this message. +unit_u_load_unit=10027_U_Carregar de $1 ($2) unidade $3 +% When you use the \var{-vu} flag, which unit is loaded from which unit is +% shown. +unit_u_recompile_crc_change=10028_U_Recompilando $1, 'checksum' alterado para $2 +% The unit is recompiled because the checksum of a unit it depends on has +% changed. +unit_u_recompile_source_found_alone=10029_U_Recompilando $1, apenas fonte encontrado +% When you use the \var{-vu} flag, these messages tell you why the current +% unit is recompiled. +unit_u_recompile_staticlib_is_older=10030_U_Recompilando unidade, bib estática é mais antiga que o arquivo ppu +% When you use the \var{-vu} flag, the compiler warns if the static library +% of the unit is older than the unit file itself. +unit_u_recompile_sharedlib_is_older=10031_U_Recompilando unidade, bib compartilhada é mais antiga que o arquivo ppu +% When you use the \var{-vu} flag, the compiler warns if the shared library +% of the unit is older than the unit file itself. +unit_u_recompile_obj_and_asm_older=10032_U_Recompilando unidade, 'obj' e 'asm' são mais antigos que o arquivo ppu +% When you use the \var{-vu} flag, the compiler warns if the assembler or +% object file of the unit is older than the unit file itself. +unit_u_recompile_obj_older_than_asm=10033_U_Recompilando unidade, 'obj' é mais antigo que 'asm' +% When you use the \var{-vu} flag, the compiler warns if the assembler +% file of the unit is older than the object file of the unit. +unit_u_parsing_interface=10034_U_Analisando 'interface' de $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the interface part of the unit. +unit_u_parsing_implementation=10035_U_Analisando 'implementation' de $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the implementation part of the unit. +unit_u_second_load_unit=10036_U_Segundo carregamento para a unidade $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happen with +% interdependent units. +unit_u_check_time=10037_U_PPU Verifique arquivo $1 hora $2 +% When you use the \var{-vu} flag, the compiler shows the filename and +% date and time of the file on which a recompile depends. +### The following two error msgs is currently disabled. +#unit_h_cond_not_set_in_last_compile=10038_H_Conditional $1 was not set at startup in last compilation of $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that currently is defined, but was not used the last +#% time the unit was compiled. +#unit_h_cond_set_in_last_compile=10039_H_Conditional $1 was set at startup in last compilation of $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that was used the last time the unit was compiled, but +#% the conditional is currently not defined. +unit_w_cant_compile_unit_with_changed_incfile=10040_W_Impossível recompilar unidade $1, mas encontrados arquivos de inclusão modificados +% A unit was found to have modified include files, but +% some source files were not found, so recompilation is impossible. +unit_u_source_modified=10041_U_Arquivo $1 é mais novo que o usado para criar o arquivo PPU $2 +% A modified source file for a compiler unit was found. +unit_u_ppu_invalid_fpumode=10042_U_Tentando usar uma unidade que foi compilada com um modo diferente de FPU +% Trying to compile code while using units which were not compiled with +% the same floating point format mode. Either all code should be compiled +% with FPU emulation on, or with FPU emulation off. +unit_u_loading_interface_units=10043_U_Carregando unidades 'interface' de $1 +% When you use the \var{-vu} flag, the compiler warns that it is starting +% to load the units defined in the interface part of the unit. +unit_u_loading_implementation_units=10044_U_Carregando unidades 'implementation' de $1 +% When you use the \var{-vu} flag, the compiler warns that it is starting +% to load the units defined in the implementation part of the unit. +unit_u_interface_crc_changed=10045_U_Interface CRC alterado para a unidade $1 +% When you use the \var{-vu} flag, the compiler warns that the +% CRC calculated for the interface has been changed after the implementation +% has been parsed. +unit_u_implementation_crc_changed=10046_U_Implementation CRC alterado para a unidade $1 +% When you use the \var{-vu} flag, the compiler warns that the +% CRC calculated has been changed after the implementation +% has been parsed. +unit_u_finished_compiling=10047_U_Terminada a compilação da unidade $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has finished compiling the unit. +unit_u_add_depend_to=10048_U_Adição dependência: $1 depende de $2 +% When you use the \var{-vu} flag, the compiler warns that it +% has added a dependency between the two units. +unit_u_no_reload_is_caller=10049_U_Nenhum recarregamento, é o chamador: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% will not reload the unit because it is the unit that wants +% to load this unit. +unit_u_no_reload_in_second_compile=10050_U_Nenhum recarregamento, já em segunda compilação: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% will not reload the unit because it is already in a second recompile. +unit_u_flag_for_reload=10051_U_'Flag' para recarregamento: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to reload the unit. +unit_u_forced_reload=10052_U_Recarregamento forçado +% When you use the \var{-vu} flag, the compiler warns that it +% is reloading the unit because it was required. +unit_u_previous_state=10053_U_Estado anterior de $1: $2 +% When you use the \var{-vu} flag, the compiler shows the +% previous state of the unit. +unit_u_second_compile_unit=10054_U_Já compilando $1, ajustando segunda compilação +% When you use the \var{-vu} flag, the compiler warns that it is starting +% to recompile a unit for the second time. This can happen with interdependent +% units. +unit_u_loading_unit=10055_U_Carregando unidade $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the unit. +unit_u_finished_loading_unit=10056_U_Terminado carregamento unidade $1 +% When you use the \var{-vu} flag, the compiler warns that it finished +% loading the unit. +unit_u_registering_new_unit=10057_U_Registrando nova unidade $1 +% When you use the \var{-vu} flag, the compiler warns that it has +% found a new unit and is registering it in the internal lists. +unit_u_reresolving_unit=10058_U_Re-solucionando unidade $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to recalculate the internal data of the unit. +unit_u_skipping_reresolving_unit=10059_U_Pulando re-solução unidade $1, ainda carregando unidades usadas +% When you use the \var{-vu} flag, the compiler warns that it is +% skipping the recalculation of the internal data of the unit +% because there is no data to recalculate. +unit_u_unload_resunit=10060_U_Descarregando unidade recursos $1 (não necessária) +% When you use the \var{-vu} flag, the compiler warns that it is unloading the +% resource handling unit, since no resources are used. +unit_e_different_wpo_file=10061_E_Unidade $1 foi compilada usando uma entrada de retorno inteiramente diferente de otimização de programa ($2, $3); recompile-a sem 'wpo' ou use o mesmo arquivo de retorno de entrada 'wpo' para esta compilação +% When a unit has been compiled using a particular whole program optimization (wpo) feedback file (\var{-FW<x>} \var{-OW<x>}), +% this compiled version of the unit is specialised for that particular compilation scenario and cannot be used in +% any other context. It has to be recompiled before you can use it in another program or with another wpo feedback input file. +unit_u_indirect_crc_changed=10062_U_CRC interface indireta (objetos/classes) alterado para a unidade $1 +% When you use the \var{-vu} flag, the compiler warns that the +% indirect CRC calculated for the unit (this is the CRC of all classes/objects/interfaces/$\ldots$ +% in the interfaces of units directly or indirectly used by this unit in the interface) has been changed after the +% implementation has been parsed. +% \end{description} +# EndOfTeX + +# +# Options +# +# 11049 is the last used one +# +option_usage=11000_O_$1 [options] <inputfile> [options] +# BeginOfTeX +% +% \section{Command line handling errors} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +option_only_one_source_support=11001_W_Apenas uma arquivo fonte suportado, alterando arquivo fonte à compilar de "$1" para "$2" +% You can specify only one source file on the command line. The last +% one will be compiled, others will be ignored. This may indicate that +% you forgot a \var{'-'} sign. +option_def_only_for_os2=11002_W_Arquivo DEF pode ser criado apenas para OS/2 +% This option can only be specified when you're compiling for OS/2. +option_no_nested_response_file=11003_E_Arquivos respostas aninhados não são suportados +% You cannot nest response files with the \var{@file} command line option. +option_no_source_found=11004_F_Nenhm nome arquivo fonte na linha de comando +% The compiler expects a source file name on the command line. +option_no_option_found=11005_N_Nenhuma opção dentro do arquivo de configurações $1 +% The compiler didn't find any option in that config file. +option_illegal_para=11006_E_Parâmetro ilegal: $1 +% You specified an unknown option. +option_help_pages_para=11007_H_-? lista páginas ajuda +% When an unknown option is given, this message is diplayed. +option_too_many_cfg_files=11008_F_Muitos arquivos de configurações aninhados +% You can only nest up to 16 config files. +option_unable_open_file=11009_F_Incapaz de abrir arquivo $1 +% The option file cannot be found. +option_reading_further_from=11010_D_Lendo demais opções de $1 +% Displayed when you have notes turned on, and the compiler switches +% to another options file. +option_target_is_already_set=11011_W_Alvo já está ajustado para: $1 +% Displayed if more than one \var{-T} option is specified. +option_no_shared_lib_under_dos=11012_W_Bibs compartilhadas não são suportadas pela plataforma DOS, revertendo para estática +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos. +option_too_many_ifdef=11013_F_No arquivo opções $1 na linha $2 muitos \var{\#IF(N)DEFs} encontrados +% The \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_many_endif=11014_F_No arquivo opções $1 na linha $2 encontrados \var{\#ENDIFs} inesperados +% The \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_less_endif=11015_F_Condicional aberta no final do arquivo de opções +% The \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_no_debug_support=11016_W_Geração de informações depuração não é suportada por este executável +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_Tente recompilar com -dGDB +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_W_Você esta usando uma chave obsoleta $1 +% This warns you when you use a switch that is not needed/supported anymore. +% It is recommended that you remove the switch to overcome problems in the +% future, when the meaning of the switch may change. +option_obsolete_switch_use_new=11019_W_Você esta usando uma chave obsoleta $1, favor usar $2 +% This warns you when you use a switch that is not supported anymore. You +% must now use the second switch instead. +% It is recommended that you change the switch to overcome problems in the +% future, when the meaning of the switch may change. +option_switch_bin_to_src_assembler=11020_N_Mudando montador assembler para o padrão escrita de fontes +% This notifies you that the assembler has been changed because you used the +% -a switch, which can't be used with a binary assembler writer. +option_incompatible_asm=11021_W_Saída Assembler selecionado "$1" incompatível com "$2" +option_asm_forced=11022_W_"$1" uso forçado montador assembler +% The assembler output selected cannot generate +% object files with the correct format. Therefore, the +% default assembler for this target is used instead. +option_using_file=11026_T_Lendo opções do arquivo $1 +% Options are also read from this file. +option_using_env=11027_T_Lendo opções do ambiente $1 +% Options are also read from this environment string. +option_handling_option=11028_D_Manipulando opção "$1" +% Debug info that an option is found and will be handled. +option_help_press_enter=11029_O_*** pressione <enter> *** +% Message shown when help is shown page per page. When pressing the ENTER +% Key, the next page of help is shown. If you press q and then ENTER, the +% compiler exits. +option_start_reading_configfile=11030_H_Início leitura do arquivo configuração $1 +% Start of configuration file parsing. +option_end_reading_configfile=11031_H_Final leitura do arquivo configuração $1 +% End of configuration file parsing. +option_interpreting_option=11032_D_Interpretando opção "$1" +% The compiler is interpreting an option +option_interpreting_firstpass_option=11036_D_Interpretando primeiro passo opção "$1" +% The compiler is interpreting an option for the first time. +option_interpreting_file_option=11033_D_Interpretando opção arquivo "$1" +% The compiler is interpreting an option which it read from the configuration file. +option_read_config_file=11034_D_Lendo arquivo configuração "$1" +% The compiler is starting to read the configuration file. +option_found_file=11035_D_Nome arquivo fonte encontrado "$1" +% Additional information about options. +% Displayed when you have the debug option turned on. +option_code_page_not_available=11039_E_Codepage desconhecido +% An unknown codepage for the source files was requested. +% The compiler is compiled with support for several codepages built-in. +% The requested codepage is not in that list. You will need to recompile +% the compiler with support for the codepage you need. +option_config_is_dir=11040_F_Arquivo configuração $1 é um diretório +% Directories cannot be used as configuration files. +option_confict_asm_debug=11041_W_Saída montador Assembler selecionado "$1" não pode gerar informações depuração, depuração desabilitada +% The selected assembler output cannot generate +% debugging information, debugging option is therefore disabled. +option_ppc386_deprecated=11042_W_Uso de 'ppc386.cfg' está depreciado, favor usar 'fpc.cfg' +% Using ppc386.cfg is still supported for historical reasons, however, for a multiplatform +% system the naming makes no sense anymore. Please continue to use fpc.cfg instead. +option_else_without_if=11043_F_No arquivo opções $1 na linha $2 diretiva \var{\#ELSE} sem \var{\#IF(N)DEF} encontrada +% An \var{\#ELSE} statement was found in the options file without a matching \var{\#IF(N)DEF} statement. +option_unsupported_target=11044_F_Opção "$1" não é, ou ainda não é, suportada pela plataforma alvo atual +% Not all options are supported or implemented for all target platforms. This message informs you that a chosen +% option is incompatible with the currently selected target platform. +option_unsupported_target_for_feature=11045_F_A característica "$1" não é, ou ainda não é, suportada pela plataforma alvo selecionada +% Not all features are supported or implemented for all target platforms. This message informs you that a chosen +% feature is incompatible with the currently selected target platform. +option_dwarf_smart_linking=11046_N_Informação de depuração DWARF não pode ser usada com vinculação inteligente neste alvo, mudando para vinculação estática +% Smart linking is currently incompatble with DWARF debug information on most +% platforms, so smart linking is disabled in such cases. +option_ignored_target=11047_W_Opção "$1" ignorada pela plataforma alvo atual +% Not all options are supported or implemented for all target platforms. This message informs you that a chosen +% option is ignored for the currently selected target platform. +option_debug_external_unsupported=11048_W_Desabilitando informação externa depuração porque não é suportada pela combinação formato alvo/depuração selecionado. +% Not all debug formats can be stored in an external file on all platforms. In particular, on +% Mac OS X only DWARF debug information can be stored externally. +option_dwarf_smartlink_creation=11049_N_Informação de depuração DWARF não pode ser usada com vinculação inteligente com assembler externo, desabilitando criação de biblioteca estática. +% Smart linking is currently incompatble with DWARF debug information on most +% platforms, so smart linking is disabled in such cases. +%\end{description} +# EndOfTeX + +# +# Whole program optimization +# +# 12019 is the last used one +# +# BeginOfTeX +% +% \section{Whole program optimization messages} +% This section lists errors that occur when the compiler is performing +% whole program optimization. +% \begin{description} +wpo_cant_find_file=12000_F_Impossível abrir arquivo de retorno de otimização completa de programa "$1" +% The compiler cannot open the specified feedback file with whole program optimization information. +wpo_begin_processing=12001_D_Processando informações de otimização completa de programa no arquivo retorno 'wpo' "$1" +% The compiler starts processing whole program optimization information found in the named file. +wpo_end_processing=12002_D_Terminado processamento de otimização completea de programa no arquivo retorno 'wpo' "$1" +% The compiler has finished processing the whole program optimization information found in the named file. +wpo_expected_section=12003_E_Seção cabeçalho esperada, mas obtido "$2" na linhae $1 do arquivo retorno 'wpo' +% The compiler expected a section header in the whole program optimization file (starting with \%), +% but did not find it. +wpo_no_section_handler=12004_W_Nenhum manipulador registrado para seção otimização completa de programa "$2" na linha $1 do arquivo de retorno 'wpo', ignorando +% The compiler has no handler to deal with the mentioned whole program optimization information +% section, and will therefore ignore it and skip to the next section. +wpo_found_section=12005_D_Encontrada seção otimização completa de programa "$1" com informações sobre "$2" +% The compiler encountered a section with whole program optimization information, and according +% to its handler this section contains information usable for the mentioned purpose. +wpo_no_input_specified=12006_F_As otimizações completas de programa selecionadas requerem um arquivo de retorno previamente gerado (use -Fw para especificar) +% The compiler needs information gathered during a previous compilation run to perform the selected +% whole program optimizations. You can specify the location of the feedback file containing this +% information using the -Fw switch. +wpo_not_enough_info=12007_E_Nenhuma informação coletada necessária para realizar "$1" otimização completa programa foi encontrada +% While you pointed the compiler to a file containing whole program optimization feedback, it +% did not contain the information necessary to perform the selected optimizations. You most likely +% have to recompile the program using the appropate -OWxxx switch. +wpo_no_output_specified=12008_F_Especifique um arquivo de retorno de otimização completa programa para armazenar as informações geradas (usando -FW) +% You have to specify the feedback file in which the compiler has to store the whole program optimization +% feedback that is generated during the compilation run. This can be done using the -FW switch. +wpo_output_without_info_gen=12009_E_Não gerando qualquer informação otimização completa programa, assim mesmo um arquivo de retorno foi especificado (usando -FW) +% The compiler was instructed to store whole program optimization feedback into a file specified using -FW, +% but not to actually generated any whole program optimization feedback. The classes of to be +% generated information can be speciied using -OWxxx. +wpo_input_without_info_use=12010_E_Não realizando qualquer otimização completa programa, assim mesmo um arquivo de retorno foi especificado (usando -Fw) +% The compiler was not instructed to perform any whole program optimizations (no -Owxxx parameters), +% but nevertheless an input file with such feedback was specified (using -Fwyyy). Since this can +% indicate that you forgot to specify an -Owxxx parameter, the compiler generates an error in this case. +wpo_skipping_unnecessary_section=12011_D_Pulando seção otimização completa programa "$1", porque não é necessária pelas otimizações solicitadas +% The whole program optimization feedback file contains a section with information that is not +% required by the selected whole program optimizations. +wpo_duplicate_wpotype=12012_W_Sobrepondo informações previamente lidas para "$1" do arquivo entrada retorno usando informações na seção "$2" +% The feedback file contains multiple sections that provide the same class of information (e.g., +% information about which virtual methods can be devirtualized). In this case, the information in last encountered +% section is used. Turn on debugging output (-vd) to see which class of information is provided by each section. +wpo_cannot_extract_live_symbol_info_strip=12013_E_Impossível extrair informações de vida de símbolos do programa durante eliminação símbolos, use -Xs- +% Certain symbol liveness collectors extract the symbol information from the linked program. If the symbol information +% is stripped (option -Xs), this is not possible. +wpo_cannot_extract_live_symbol_info_no_link=12014_E_Impossível extrair informações de vida de símbolos do programa quando não vinculando +% Certain symbol liveness collectors extract the symbol information from the linked program. If the program is not +% linked by the compiler, this is not possible. +wpo_cannot_find_symbol_progs=12015_F_Impossível encontrar "$1" ou "$2" para extrair informações de vida de símbolos do programa vinculado +% Certain symbol liveness collectors need a helper program to extract the symbol information from the linked program. +% This helper program is normally 'nm', which is part of the GNU binutils. +wpo_error_reading_symbol_file=12016_E_Erro durante leitura das informações de vída de símbolos produzidas por "$1" +% An error occurred during the reading of the symbol liveness file that was generated using the 'nm' or 'objdump' program. The reason +% can be that it was shorter than expected, or that its format was not understood. +wpo_error_executing_symbol_prog=12017_F_Erro executando "$1" (código saída: $2) para extrair informações de símbolos do programa vinculado +% Certain symbol liveness collectors need a helper program to extract the symbol information from the linked program. +% The helper program produced the reported error code when it was run on the linked program. +wpo_symbol_live_info_needs_smart_linking=12018_E_Coleção de informações de vida de símbolos pode ajudar apenas quando usando vinculação inteligente, use -CX -XX +% Whether or not a symbol is live is determined by looking whether it exists in the final linked program. +% Without smart linking/dead code stripping, all symbols are always included, regardless of whether they are +% actually used or not. So in that case all symbols will be seen as live, which makes this optimization ineffective. +wpo_cant_create_feedback_file=12019_E_Impossível criar arquivo retorno otimizações completas de programa especificado "$1" +% The compiler is unable to create the file specified using the -FW parameter to store the whole program optimisation information. +%\end{description} +# EndOfTeX + + +# +# Logo (option -l) +# +option_logo=11023_[ +Compilador Free Pascal versão $FPCFULLVERSION [$FPCDATE] para $FPCCPU +Copyright (c) 1993-2011 by Florian Klaempfl +] + +# +# Info (option -i) +# +option_info=11024_[ +Compilador Free Pascal versão $FPCVERSION + +Data Compilador : $FPCDATE +CPU Alvo Copilador : $FPCCPU + +Alvos suportados: + $OSTARGETS + +Conjunto de instruções CPU suportados: + $INSTRUCTIONSETS + +Conjunto de instruções FPU suportados: + $FPUINSTRUCTIONSETS + +Alvos ABI suportados: + $ABITARGETS + +Otimizações suportadas: + $OPTIMIZATIONS + +Otimizaçõs Completas Programa suportadas: + Todas + $WPOPTIMIZATIONS + +Tipos Microcontroladores suportados: + $CONTROLLERTYPES + +Este programa é oferecido sob a Licença Geral Pública GNU +Para maiores informações leia COPYING.FPC + +Reportar falhas, sugestões, etc. para: + http://bugs.freepascal.org +ou + bugs@freepascal.org +] + +# +# Help pages (option -? and -h) +# +# The first character on the line indicates who will display this +# line, the current possibilities are : +# * = every target +# 3 = 80x86 targets +# 4 = x86_64 +# 6 = 680x0 targets +# A = ARM +# e = in extended debug mode only +# P = PowerPC targets +# S = Sparc targets +# V = Virtual machine targets +# The second character also indicates who will display this line, +# (if the above character was TRUE) the current possibilities are : +# * = everyone +# g = with GDB info supported by the compiler +# O = OS/2 +# L = UNIX systems +# The third character represents the indentation level. +# +option_help_pages=11025_[ +**0*_Ponha + após uma chave de opção booleana para habilitá-la, - para desabilitá-la +**1a_O compilador não elimina o arquivo gerado do montador assembler +**2al_Lista linhas do código fonte no arquivo assembler +**2an_Lista informações nó no arquivo assembler +*L2ap_Usa encadeadores (pipes) em vez de criar arquivos temporários assembler +**2ar_Lista informações alocação/liberação registros no arquivo assembler +**2at_Lista informações temporárias alocação/liberação no arquivo assembler +**1A<x>_Formato saída: +**2Adefault_Usa montador assembler padrão +3*2Aas_Monta usando o GNU AS +3*2Amacho_Mach-O (Darwin, Intel 32 bit) usando gravador interno +3*2Anasmcoff_Arquivo COFF (Go32v2) usando Nasm +3*2Anasmelf_Arquivo ELF32 (Linux) usando Nasm +3*2Anasmwin32_Arquivo objeto Win32 usando Nasm +3*2Anasmwdosx_Arquivo objeto Win32/WDOSX usando Nasm +3*2Awasm_Arquivo Obj usando Wasm (Watcom) +3*2Anasmobj_Arquivo Obj usando Nasm +3*2Amasm_Arquivo Obj usando Masm (Microsoft) +3*2Atasm_Arquivo Obj usando Tasm (Borland) +3*2Aelf_ELF (Linux) usando gravador interno +3*2Acoff_COFF (Go32v2) usando gravador interno +3*2Apecoff_PE-COFF (Win32) usando gravador interno +4*2Aas_Monta usando o GNU AS +4*2Agas_Monta usando o GNU GAS +4*2Agas-darwin_Monta darwin Mach-O64 usando GNU GAS +4*2Amasm_Win64 arquivo objeto usando ml64 (Microsoft) +4*2Apecoff_PE-COFF (Win64) usando escritor interno +4*2Aelf_ELF (Linux-64bit) usando escritor interno +6*2Aas_Arquivo Unix .o usando o GNU AS +6*2Agas_Montador assembler GNU Motorola +6*2Amit_Sintaxe MIT (antigo GAS) +6*2Amot_Montador assembler Motorola padrão +A*2Aas_Monta usando o GNU AS +P*2Aas_Monta usando o GNU AS +S*2Aas_Monta usando o GNU AS +**1b_Gera informações navegador +**2bl_Gera informações símbolos locais +**1B_Constrói todos os módulos +**1C<x>_Opções geração de código: +**2C3<x>_Ligar verificação de erro ieee para constantes +**2Ca<x>_Seleciona ABI, veja fpc -i para possíveis valores +**2Cb_Gera código 'big-endian' +**2Cc<x>_Ajusta convenção de chamada para <x> +**2CD_Cria também biblioteca dinâmica (não suportado) +**2Ce_Compilação com opcodes de ponto flutuante emulados +**2Cf<x>_Seleciona conjunto de instruções fpu a usar, veja fpc -i para possíveis valores +**2CF<x>_Precisão mínima constante ponto flutuante (padrão, 32, 64) +**2Cg_Gera código PIC +**2Ch<n>_<n> bytes heap (entre 1023 e 67107840) +**2Ci_Verificação E/S +**2Cn_Omite estágio vinculação +**2Co_Verifica transbordamento de operações inteiras +**2CO_Verifica possível transbordamento de operações inteiras +**2Cp<x>_Seleciona conjunto de instruções, veja fpc -i para possíves valores +**2CP<x>=<y>_ Ajustes compactação +**3CPPACKSET=<y>_ <y> conjunto alocação: 0, 1 ou DEFAULT ou NORMAL, 2, 4 e 8 +**2Cr_Verificação de faixa +**2CR_Verifica validade de chamada de método de objeto +**2Cs<n>_Ajusta verificação tamanho da Pilha para <n> +**2Ct_Verificação Pilha (apenas para testes, veja manual) +**2CX_Cria também biblioteca inteligentemente vinculada +**1d<x>_Define o símbolo <x> +**1D_Gera um arquivo DEF +**2Dd<x>_Ajusta descrição para <x> +**2Dv<x>_Ajusta versão DLL para <x> +*O2Dw_Aplicação PM +**1e<x>_Ajusta caminho para executável +**1E_Mesmo que -Cn +**1fPIC_Mesmo que -Cg +**1F<x>_Ajusta nomes de arquivo e caminhos: +**2Fa<x>[,y]_(para um programa) carregar unidades <x> e [y] antes de analisar cláusula 'uses' +**2Fc<x>_Ajusta entrada página de código para <x> +**2FC<x>_Ajusta nome do compilador RC binário para <x> +**2Fd_Disabilita o cache de diretórios interno do compilador +**2FD<x>_Ajusta o diretório onde procurar por utilitários para o compilador +**2Fe<x>_Redireciona saída erros para <x> +**2Ff<x>_Adiciona <x> ao caminho framework (apenas Darwin) +**2FE<x>_Ajusta caminho saída exe/unidade para <x> +**2Fi<x>_Adiciona <x> ao caminho inclusões +**2Fl<x>_Adiciona <x> ao caminho bibliotecas +**2FL<x>_Use <x> como vinculador dinâmico +**2Fm<x>_Carrega tabela conversão unicode de <x>.txt no dir. do compilador +**2Fo<x>_Adiciona <x> ao caminho objetos +**2Fr<x>_Carrega o arquivo mensagens erro <x> +**2FR<x>_Ajusta vinculador recursos (.res) para <x> +**2Fu<x>_Adiciona <x> ao caminho unidades +**2FU<x>_Ajusta caminho saída unidade para <x>, sobrepõe -FE +**2FW<x>_Armazena retorno otimização completa programa gerada em <x> +**2Fw<x>_Carrega retorno otimização completa programa previamente armazenada de <x> +*g1g_Gerar informações depuração (formato padrão para o alvo) +*g2gc_Gerar verificações para ponteiros +*g2gh_Usa unidade heaptrace (para depuração vazamentos/corrupção memória) +*g2gl_Usa unidade informações linha (mostra mais info. com backtraces) +*g2go<x>_Ajusta opções informações depuração +*g3godwarfsets_ Habilita 'conjunto' info. depuração DWARF (falhas gdb < 6.5) +*g3gostabsabsincludes_ Armazena caminhos absolutos/completos arquivos inclusões em 'Stabs' +*g3godwarfmethodclassprefix_ Prefixa nomes métodos com nome classe em DWARF +*g2gp_Preserva caixa nomes símbolos em 'stabs' +*g2gs_Gera informações depuração 'Stabs' +*g2gt_Inutiliza variáveis locais (para detetar utilização de não-inicilizadas) +*g2gv_Gera programas rastreáveis com 'Valgrind' +*g2gw_Gera informações depuração DWARFv2 (mesmo que -gw2) +*g2gw2_Gera informações depuração DWARFv2 +*g2gw3_Gera informações depuração DWARFv3 +*g2gw4_Gera informações depuração DWARFv4 (experimental) +**1i_Informações +**2iD_Retorna data compilador +**2iV_Retorna versão compilador curta +**2iW_Retorna versão compilador completa +**2iSO_Retorna SO compilador +**2iSP_Retorna processador servidor compilador +**2iTO_Retorna SO alvo +**2iTP_Retorna processador alvo +**1I<x>_Adiciona <x> ao caminho inclusões +**1k<x>_Passa <x> ao vinculador +**1l_Grava logo +**1M<x>_Ajusta modo linguagem para <x> +**2Mfpc_Dialeto Free Pascal (padrão) +**2Mobjfpc_Modo FPC com suporte ao Object Pascal +**2Mdelphi_Modo compatibilidade Delphi 7 +**2Mtp_Modo compatibilidade TP/BP 7.0 +**2Mmacpas_Modo compatibilidade dialetos Macintosh Pascal +**1n_Não ler os arquivos de configurações padrão +**1N<x>_Otimizações nós árvore +**2Nu_Desdobra laços +**1o<x>_Altera o nome do executável produzido para <x> +**1O<x>_Otimizações: +**2O-_Disabilita otimizações +**2O1_Nível 1 otimizações (rápida e amigável depurador) +**2O2_Nível 2 otimizações (-O1 + otimizações rápidas) +**2O3_Nível 3 otimizações (-O2 + otimizações lentas) +**2Oa<x>=<y>_Ajusta alinhamento +**2Oo[NO]<x>_Habilita ou desabilita otimizações, veja fpc -i para possíveis valores +**2Op<x>_Ajusta cpu alvo para otimizações, veja fpc -i para possíveis valores +**2OW<x>_Gera retorno otimização completa programa para otimizações <x>, veja fpc -i para possíveis valores +**2Ow<x>_Realiza otimização completa programa <x>, veja fpc -i para possíveis valores +**2Os_Otimiza tamanho ao invés de velocidade +**1pg_Gera perfil código para 'gprof' (define FPC_PROFILE) +**1R<x>_Estilo leitura Assembler: +**2Rdefault_Use assembler padrão para alvo +3*2Ratt_Leia assembler estilo AT&T +3*2Rintel_Leia assembler estilo Intel +6*2RMOT_Leia assembler estilo motorola +**1S<x>_Opções sintaxe: +**2S2_Mesmo que -Mobjfpc +**2Sc_Suporte operadores similares C (*=,+=,/= and -=) +**2Sa_Liga asserções +**2Sd_Mesmo que -Mdelphi +**2Se<x>_Opções erros. <x> é uma combinação do seguinte: +**3*_<n> : Compilador para depois de <n> erros (padrão é 1) +**3*_w : Compilador também para após avisos +**3*_n : Compilador também para após notas +**3*_h : Compilador também para após dicas +**2Sg_Habilita LABEL e GOTO (padrão em -Mtp e -Mdelphi) +**2Sh_Use 'ansistrings' por padrão ao invés de 'shortstrings' +**2Si_Liga 'inlining' de procedimentos/funções declaradas como "em-linha" (inline) +**2Sk_Carrega unidade 'fpcylix' +**2SI<x>_Ajusta estilo interface para <x> +**3SIcom_COM interface compatível (padrão) +**3SIcorba_CORBA interface compatível +**2Sm_Suporta macros semelhantes C (global) +**2So_Mesmo que -Mtp +**2Ss_Nome construtor deve ser 'init' (destruidor deve ser 'done') +**2Sx_Habilita palavras-chave exceções (padrão nos modos Delphi/ObjFPC) +**2Sy_@<ponteiro> retorna um ponteiro tipado, mesmo que $T+ +**1s_Não chama o montador assembler e o vinculador +**2sh_Gera roteiro para vincular no servidor +**2st_Gera roteiro para vincular no alvo +**2sr_Pula fase alocação registro (use com -alr) +**1T<x>_Sistema operacional alvo: +3*2Tdarwin_Darwin/Mac OS X +3*2Temx_OS/2 via EMX (incluidos extensor EMX/RSX) +3*2Tfreebsd_FreeBSD +3*2Tgo32v2_Versão 2 do extensor DOS DJ Delorie +3*2Tiphonesim_ iPhoneSimulator do iOS SDK 3.2+ (versões antigas: -Tdarwin) +3*2Tlinux_Linux +3*2Tnetbsd_NetBSD +3*2Tnetware_Módulo Novell Netware (clib) +3*2Tnetwlibc_Módulo Novell Netware (libc) +3*2Topenbsd_OpenBSD +3*2Tos2_OS/2 / eComStation +3*2Tsunos_SunOS/Solaris +3*2Tsymbian_Symbian OS +3*2Tsolaris_Solaris +3*2Twatcom_Watcom compatible DOS extender +3*2Twdosx_WDOSX DOS extender +3*2Twin32_Windows 32 Bit +3*2Twince_Windows CE +4*2Tdarwin_Darwin/Mac OS X +4*2Tlinux_Linux +4*2Twin64_Win64 (sistemas Windows 64 bit) +6*2Tamiga_Commodore Amiga +6*2Tatari_Atari ST/STe/TT +6*2Tlinux_Linux +6*2Tpalmos_PalmOS +A*2Tdarwin_Darwin/iPhoneOS/iOS +A*2Tlinux_Linux +A*2Twince_Windows CE +P*2Tamiga_AmigaOS +P*2Tdarwin_Darwin/Mac OS X +P*2Tlinux_Linux +P*2Tmacos_Mac OS (clássico) +P*2Tmorphos_MorphOS +S*2Tsolaris_Solaris +S*2Tlinux_Linux +**1u<x>_Indefine o símbolo <x> +**1U_Opções unidades: +**2Un_Não verifica onde o nome unidade coincide com o nome arquivo +**2Ur_Gera arquivos lançamento unidades (nunca automaticamente recompilado) +**2Us_Compilar uma unidade sistema +**1v<x>_Ser detalhado. <x> é uma combinação das seguintes letras: +**2*_e : Mostra erros (padrão) 0 : Nada mostra (exceto erros) +**2*_w : Mostra avisos u : Mostra info. unidade +**2*_n : Mostra notas t : Mostra arquivos tentados/usados +**2*_h : Mostra dicas c : Mostra condicionais +**2*_i : Mostra info. geral d : Mostra info. depuração +**2*_l : Mostra números linhas r : Modo compatibilidade Rhide/GCC +**2*_s : Mostra Data/Hora q : Mostra números mensagens +**2*_a : Mostra tudo x : Info. executável (apenas Win32) +**2*_b : Grava mensagens nome arqs. p : Grava tree.log com árvore análise +**2*_ com caminho completo v : Grava fpcdebug.txt com muitas +**2*_ informações de depuração +**2*_m<x>,<y> : Não mostra mensagens numeradas <x> e <y> +**1W<x>_Opções específicas do alvo (alvos) +3*2WA_Especifica aplicação do tipo nativo (Windows) +4*2WA_Especifica aplicação do tipo nativo (Windows) +A*2WA_Especifica aplicação do tipo nativo (Windows) +3*2Wb_Cria um encarte ao invés de uma biblioteca (Darwin) +P*2Wb_Cria um encarte ao invés de uma biblioteca (Darwin) +p*2Wb_Cria um encarte ao invés de uma biblioteca (Darwin) +A*2Wb_Cria um encarte ao invés de uma biblioteca (Darwin) +4*2Wb_Cria um encarte ao invés de uma biblioteca (Darwin) +3*2WB_Cria uma imagem relocável (Windows, Symbian) +3*2WBxxxx_Define base da imagem para xxxx (Windows, Symbian) +4*2WB_Cria uma imagem relocável (Windows) +4*2WBxxxx_Define base da imagem para xxxx (Windows) +A*2WB_Cria uma imagem relocável (Windows, Symbian) +A*2WBxxxx_Define base da imagem para xxxx (Windows, Symbian) +3*2WC_Especifica aplicação do tipo console (EMX, OS/2, Windows) +4*2WC_Especifica aplicação do tipo console (EMX, OS/2, Windows) +A*2WC_Especifica aplicação do tipo console (Windows) +P*2WC_Especifica aplicação do tipo console (Classic Mac OS) +3*2WD_Usa DEFFILE para exportar funções de DLL ou EXE (Windows) +4*2WD_Usa DEFFILE para exportar funções de DLL ou EXE (Windows) +A*2WD_Usa DEFFILE para exportar funções de DLL ou EXE (Windows) +3*2We_Usa recursos externos (Darwin) +4*2We_Usa recursos externos (Darwin) +A*2We_Usa recursos externos (Darwin) +P*2We_Usa recursos externos (Darwin) +p*2We_Usa recursos externos (Darwin) +3*2WF_Especifica aplicação do tipo tela-cheia (EMX, OS/2) +3*2WG_Especifica aplicação do tipo gráfica (EMX, OS/2, Windows) +4*2WG_Especifica aplicação do tipo gráfica (EMX, OS/2, Windows) +A*2WG_Especifica aplicação do tipo gráfica (Windows) +P*2WG_Especifica aplicação do tipo gráfica (Classic Mac OS) +3*2Wi_Usa recursos internos (Darwin) +4*2Wi_Usa recursos internos (Darwin) +A*2Wi_Usa recursos internos (Darwin) +P*2Wi_Usa recursos internos (Darwin) +p*2Wi_Usa recursos internos (Darwin) +3*2WI_Liga/desliga o uso de seções de importação (Windows) +4*2WI_Liga/desliga o uso de seções de importação (Windows) +A*2WI_Liga/desliga o uso de seções de importação (Windows) +3*2WN_Não gera código de relocação, necessário para depuração (Windows) +4*2WN_Não gera código de relocação, necessário para depuração (Windows) +A*2WN_Não gera código de relocação, necessário para depuração (Windows) +A*2Wpxxxx_Especifica o tipo de controlador, veja fpc -i para valores possíveis +V*2Wpxxxx_Especifica o tipo de controlador, veja fpc -i para valores possíveis +3*2WR_Gera código de relocação (Windows) +4*2WR_Gera código de relocação (Windows) +A*2WR_Gera código de relocação (Windows) +P*2WT_Especifica aplicação do tipo ferramenta MPW (Classic Mac OS) +**2WX_Habilita pilha executável (Linux) +**1X_Opções do executável: +**2Xc_Passar --shared/-dynamic para o vinculador (BeOS, Darwin, FreeBSD, Linux) +**2Xd_Não usar caminho padrão de busca de biblioteca (necessário para compilação cross) +**2Xe_Usar vinculador externo +**2Xg_Cria informação de depuração em um arquivo separado e adiciona uma seção de vínculo de depuração ao executável +**2XD_Tenta vincular unidades dinamicamente (define FPC_LINK_DYNAMIC) +**2Xi_Usa vinculador interno +**2Xm_Gera mapa de vinculação +**2XM<x>_Define o nome da rotina 'main' do programa (padrão é 'main') +**2XP<x>_Apensa os nomes 'binutils' com o prefixo <x> +**2Xr<x>_Define o caminho-rlink do vinculador para <x> (necessário para compilação 'cross', veja o manual do 'ld' para maiores informações) (BeOS, Linux) +**2XR<x>_Apensa todos os caminhos de busca do vinculador com <x> (BeOS, Darwin, FreeBSD, Linux, Mac OS, Solaris) +**2Xs_Remove todos os símbolos do executável +**2XS_Tenta vincular unidades estaticamente (padrão, define FPC_LINK_STATIC) +**2Xt_Vincula com bibliotecas estáticas (-static é passado ao vinculador) +**2XX_Tenta a vinculação inteligente de unidades (define FPC_LINK_SMART) +**1*_ +**1?_Exibe esta ajuda +**1h_Exibe esta ajuda sem espera +] + +# +# The End... diff --git a/closures/compiler/msg/errorr.msg b/closures/compiler/msg/errorr.msg new file mode 100644 index 0000000000..9982500555 --- /dev/null +++ b/closures/compiler/msg/errorr.msg @@ -0,0 +1,2832 @@ +# +# This file is part of the Free Pascal Compiler +# Copyright (c) 1999-2009 by the Free Pascal Development team +# +# Russian (utf-8) Language File for Free Pascal +# +# This file corresponds to SVN revision 13665 of errore.msg +# Translated by Sergei Gorelkin <sergei_gorelkin at mail.ru> +# +# 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. +# +# +# Š®­áâ ­âë § ¯¨á뢠îâáï ¢ á«¥¤yî饬 ¢¨¤¥: +# <part>_<type>_<txtidentifier> +# +# <part> - ç áâì ª®¬¯¨«ïâ®à , ¢ ª®â®à®© ¨á¯®«ì§ã¥âáï á®®¡é¥­¨¥: +# asmr_ ç⥭¨¥  áᥬ¡«¥à  +# asmw_ § ¯¨áì  áᥬ¡«¥à /®¡ì¥ªâ­ëå ä ©«®¢ +# unit_ ®¡à ¡®âª  ¬®¤ã«¥© +# scan_ ᪠­¥à +# parser_ ᥬ ­â¨ç¥áª¨©  ­ «¨§ â®à +# type_ ª®­â஫ì ᮮ⢥âá⢨ï ⨯®¢ +# general_ ®¡é ï ¨­ä®à¬ æ¨ï +# exec_ ¢ë§®¢ë ¢­¥è­¨å ¯à®£à ¬¬ ( áᥬ¡«¥à , ª®¬¯®­®¢é¨ª  ¨ â.¤.) +# link_ ¢­ãâ७­¨© ª®¬¯®­®¢é¨ª +# +# <type> ⨯ á®®¡é¥­¨ï: +# f_ ä â «ì­ ï ®è¨¡ª  +# e_ ®è¨¡ª  +# w_ ¯à¥¤ã¯à¥¦¤¥­¨¥ +# n_ ¯à¨¬¥ç ­¨¥ +# h_ ¯®¤áª §ª  +# i_ ¨­ä®à¬ æ¨ï +# l_ ¤®¡ ¢«ï¥âáï ­®¬¥p áâp®ª¨ +# u_ ¨á¯®«ì§®¢ ­¨¥ +# t_ ¯®¯ë⪠ ¨á¯®«ì§®¢ âì +# c_ ãá«®¢­®¥ ¢ëà ¦¥­¨¥ +# d_ ®â« ¤®ç­®¥ á®®¡é¥­¨¥ +# x_ ¨­ä®à¬ æ¨ï ® ¨á¯®«­ï¥¬ëå ä ©« å +# o_ ®¡ëç­ë¥ ("­ ¦¬¨â¥ «î¡ãî ª« ¢¨èã") +# + +# +# General +# +# 01023 is the last used one +# +# BeginOfTeX +% \section{Ž¡é¨¥ á®®¡é¥­¨ï ª®¬¯¨«ïâ®à } +% â®â à §¤¥« ᮤ¥à¦¨â á®®¡é¥­¨ï ¨­ä®à¬ æ¨®­­®£® ­ §­ ç¥­¨ï. +% Š®«¨ç¥á⢮ â ª¨å á®®¡é¥­¨© ã¯à ¢«ï¥âáï +% à §«¨ç­ë¬¨ ­ áâp®©ª ¬¨ yp®¢­ï ¯®¤à®¡­®á⨠\var{-v}. +% \begin{description} +general_t_compilername=01000_T_Š®¬¯¨«ïâ®p: $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vt} íâ  áâப  á®®¡é ¥â ¢ ¬, ª ª®© +% ª®¬¯¨«ïâ®à ¨á¯®«ì§ã¥âáï. +general_d_sourceos=01001_D_Ž‘ ª®¬¯¨«ïâ®à : $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vd} íâ  áâப  á®®¡é ¥â ­ §¢ ­¨¥ +% ®¯¥à æ¨®­­®© á¨á⥬ë, ¢ ª®â®à®© ¯à®¨á室¨â ª®¬¯¨«ïæ¨ï. +general_i_targetos=01002_I_–¥«¥¢ ï Ž‘: $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vd} íâ  áâப  á®®¡é ¥â ­ §¢ ­¨¥ +% ®¯¥à æ¨®­­®© á¨á⥬ë, ¤«ï ª®â®à®© ᮧ¤ ¥âáï ä ©«. +general_t_exepath=01003_T_yâì ¨á¯®«­ï¥¬ëå ä ©«®¢: $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vt} íâ  áâப  á®®¡é ¥â ¯ãâì, +% ¯® ª®â®à®¬ã ª®¬¯¨«ïâ®à ¨é¥â ¨á¯®«­ï¥¬ë¥ ä ©«ë. +general_t_unitpath=01004_T_ãâì ¬®¤ã«¥©: $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vt} íâ  áâப  á®®¡é ¥â ¯ãâì, +% ¯® ª®â®à®¬ã ª®¬¯¨«ïâ®à ¨é¥â ª®¬¯¨«¨àã¥¬ë¥ ¬®¤ã«¨. â®â ¯ãâì +% ¬®¦¥â ¡ëâì ¨§¬¥­¥­ á ¯®¬®éìî ª«îç  \var{-Fu}. +general_t_includepath=01005_T_yâì ¢ª«îç ¥¬ëå ä ©«®¢: $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vt} íâ  áâப  á®®¡é ¥â ¯ãâì, +% ¯® ª®â®à®¬ã ª®¬¯¨«ïâ®à ¨é¥â ¢ª«îç ¥¬ë¥ ä ©«ë (ä ©«ë, ¨á¯®«ì§ã¥¬ë¥ ¢ ¤¨à¥ªâ¨¢ å +% \var{\{\$I xxx\}}). â®â ¯ãâì ¬®¦¥â ¡ëâì ¨§¬¥­¥­ á ¯®¬®éìî ª«îç  \var{-I}. +general_t_librarypath=01006_T_yâì ¡¨¡«¨®â¥ª: $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vt} íâ  áâப  á®®¡é ¥â ¯ãâì, +% ¯® ª®â®à®¬ã ª®¬¯¨«ïâ®à ¨é¥â ¡¨¡«¨®â¥ª¨. â®â ¯ãâì ¬®¦¥â ¡ëâì ¨§¬¥­¥­ +% á ¯®¬®éìî ª«îç  \var{-Fl}. +general_t_objectpath=01007_T_yâì ®¡ê¥ªâ­ëå ä ©«®¢: $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vt} íâ  áâப  á®®¡é ¥â ¯ãâì, ¯® ª®â®à®¬ã +% ª®¬¯¨«ïâ®à ¨é¥â ®¡ê¥ªâ­ë¥ ä ©«ë (ä ©«ë, ¨á¯®«ì§ã¥¬ë¥ ¢ ¤¨à¥ªâ¨¢ å +% \var{\{\$L xxx \}}). â®â ¯ãâì ¬®¦¥â ¡ëâì ¨§¬¥­¥­ á ¯®¬®éìî ª«îç  \var{-Fo}. +general_i_abslines_compiled=01008_I_$1 áâப ᪮¬¯¨«¨p®¢ ­®, $2 ᥪ.$3 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vi} ª®¬¯¨«ïâ®à á®®¡é ¥â ç¨á«® +% ᪮¬¯¨«¨p®¢ ­­ëå áâப, ¨ ¢à¥¬ï, ª®â®à®¥ ¯®âp¥¡®¢ «®áì ¤«ï í⮣®. +% (ॠ«ì­®¥, ­¥ ¯à®£à ¬¬­®¥ ¢à¥¬ï). +general_f_no_memory_left=01009_F_H¥¤®áâ â®ç­® ¯ ¬ï⨠+% Š®¬¯¨«ïâ®àã ­¥ 墠⨫® ¯ ¬ï⨠¤«ï ª®¬¯¨«ï樨 ¢ è¥© ¯à®£à ¬¬ë. +% ˆ¬¥¥âáï ­¥áª®«ìª® p¥ª®¬¥­¤ æ¨© ¤«ï p¥è¥­¨ï í⮣® ¢®¯p®á : +% \begin{itemize} +% \item ‚¬¥áâ® ¯®«­®© ᡮન ¯à®¥ªâ , ¯®¯à®¡ã©â¥ ª®¬¯¨«¨à®¢ âì +% ®â¤¥«ì­ë¥ ¬®¤ã«¨ ¢àãç­ãî. +% \item …᫨ à §¬¥à ¯à®£à ¬¬ë ¡®«ì让, à §¡¥©â¥ ¥¥ ­  ¬®¤ã«¨, ¨ +% ª®¬¯¨«¨àã©â¥ ¨å ®â¤¥«ì­®. +% \item …᫨ ¯à¥¤ë¤ã騥 ४®¬¥­¤ æ¨¨ ­¥ à ¡®â îâ, ¯¥à¥á®¡¥à¨â¥ ª®¬¯¨«ïâ®à +% á ¡®«ì訬 p §¬¥p®¬ ªyç¨ (¤«ï í⮣® ¨á¯®«ì§ã¥âáï ª«îç \var{-Ch}, \seeo{Ch}) +% \end{itemize} +general_i_writingresourcefile=01010_I_‡ ¯¨áì ä ©«  â ¡«¨æë áâp®ª®¢ëå p¥áypᮢ: $1 +% ‘®®¡é¥­¨¥ ®§­ ç ¥â, çâ® ª®¬¯¨«ïâ®à ᮧ¤ ¥â ä ©«, ᮤ¥à¦ é¨© ¢á¥ à¥áãàá­ë¥ áâப¨ ¯à®£à ¬¬ë +% (â ¡«¨æã áâப®¢ëå à¥áãàᮢ). +general_e_errorwritingresourcefile=01011_E_Žè¨¡ª  § ¯¨á¨ ä ©«  â ¡«¨æë áâp®ª®¢ëå p¥áypᮢ: $1 +% ‘®®¡é¥­¨¥ ®§­ ç ¥â, çâ® ¢ ¯à®æ¥áᥠ§ ¯¨á¨ ä ©«  áâப®¢ëå à¥áãàᮢ +% ¯à®¨§®è«  ®è¨¡ª . +general_i_fatal=01012_I_” â «ì­®: +% à¥ä¨ªá ¤«ï ä â «ì­ëå ®è¨¡®ª +general_i_error=01013_I_Žè¨¡ª : +% à¥ä¨ªá ¤«ï ®è¨¡®ª +general_i_warning=01014_I_‚­¨¬ ­¨¥: +% à¥ä¨ªá ¤«ï ¯à¥¤ã¯à¥¦¤¥­¨© (!! "।ã¯à¥¦¤¥­¨¥:" ®¡à¥§ ¥âáï, ¯® ªà ©­¥© ¬¥à¥ ¢ utf-8 !!) +general_i_note=01015_I_‡ ¬¥âª : +% à¥ä¨ªá ¤«ï § ¬¥â®ª +general_i_hint=01016_I_®¤áª §ª : +% à¥ä¨ªá ¤«ï ¯®¤áª §®ª +general_e_path_does_not_exist=01017_E_ãâì "$1" ­¥ áãé¥áâ¢ã¥â +% “ª § ­­ë© ¯ãâì ­¥ áãé¥áâ¢ã¥â. +general_f_compilation_aborted=01018_F_Š®¬¯¨«ïæ¨ï ¯à¥à¢ ­  +% Š®¬¯¨«ïæ¨ï ¡ë«  ¯à¥à¢ ­ . +general_text_bytes_code=01019_¡ ©â ª®¤  +%  §¬¥à ᣥ­¥à¨à®¢ ­­®£® ª®¤ , ¢ ¡ ©â å. +general_text_bytes_data=01020_¡ ©â ¤ ­­ëå +%  §¬¥à ᣥ­¥à¨à®¢ ­­ëå ¤ ­­ëå ¯à®£à ¬¬ë, ¢ ¡ ©â å +general_i_number_of_warnings=01021_I_$1 ¯à¥¤ã¯à¥¦¤¥­¨© +% Ž¡é¥¥ ç¨á«® ¯à¥¤ã¯à¥¦¤¥­¨©, ¢ë¤ ­­ëå ¢ ¯à®æ¥áᥠª®¬¯¨«ï樨. +general_i_number_of_hints=01022_I_$1 ¯®¤áª §®ª +% Ž¡é¥¥ ç¨á«® ¯®¤áª §®ª, ¢ë¤ ­­ëå ¢ ¯à®æ¥áᥠª®¬¯¨«ï樨. +general_i_number_of_notes=01023_I_$1 § ¬¥â®ª +% Ž¡é¥¥ ç¨á«® § ¬¥â®ª, ¢ë¤ ­­ëå ¢ ¯à®æ¥áᥠª®¬¯¨«ï樨. +% \end{description} +# +# Scanner +# +# 02086 is the last used one +# +% \section {‘®®¡é¥­¨ï ᪠­¥à .} +% â®â à §¤¥« ¯¥à¥ç¨á«ï¥â á®®¡é¥­¨ï, ª®â®pë¥ ¢ë¤ ¥â ᪠­¥à. ‘ª ­¥à ®áãé¥á⢫ï¥â +% «¥ªá¨ç¥áª¨©  ­ «¨§ áâàãªâãàë ¨á室­®£® ä ©« , â.¥. ­ å®¤¨â +% § à¥§¥à¢¨à®¢ ­­ë¥ á«®¢ , áâப¨, ¨ â.¤. ‘ª ­¥à â ª¦¥ ®¡à ¡ â뢠¥â ¤¨à¥ªâ¨¢ë ¨ +% ¢ëà ¦¥­¨ï ãá«®¢­®© ª®¬¯¨«ï樨. +% \begin{description} +scan_f_end_of_file=02000_F_H¥®¦¨¤ ­­ë© ª®­¥æ ä ©«  +% â® ®¡ëç­® ¯à®¨á室¨â ¢ á«¥¤ãîé¨å á«ãç ïå: +% \begin{itemize} +% \item ˆá室­ë© ä ©« § ª ­ç¨¢ ¥âáï ¤® ¯®á«¥¤­¥£® ¢ëà ¦¥­¨ï \var{end}. +% — é¥ ¢á¥£® ¯à®¨á室¨â, ¥á«¨ ¢ëà ¦¥­¨ï \var{begin} ¨ \var{end} ­¥ +% á¡ « ­á¨à®¢ ­ë (¨å ª®«¨ç¥á⢮ ­¥ ᮢ¯ ¤ ¥â); +% \item ‚ª«îç ¥¬ë© ä ©« § ª ­ç¨¢ ¥âáï ¢ á¥à¥¤¨­¥ ¢ëp ¦¥­¨ï. +% \item ¥ ¡ë« § ªàëâ ª®¬¬¥­â à¨©. +% \end{itemize} +scan_f_string_exceeds_line=02001_F_¥ § ªàëâ  áâப®¢ ï ª®­áâ ­â  +% Žâáãâáâ¢ã¥â § ªà뢠î騩 ᨬ¢®« ' áâப®¢®£® ª®­áâ ­âë, â ª çâ® ª®­áâ ­â  § ­¨¬ ¥â +% ­¥áª®«ìª® áâப ä ©« . +scan_f_illegal_char=02002_F_‡ ¯p¥é¥­­ë© ᨬ¢®« "$1" ($2) +% ‚ ¨á室­®¬ ä ©«¥ ®¡­ à㦥­ § ¯à¥é¥­­ë© ᨬ¢®«. +scan_f_syn_expected=02003_F_‘¨­â ªá¨ç¥áª ï ®è¨¡ª , ®¦¨¤ ¥âáï "$1", ­® ®¡­ à㦥­® "$2" +% Š®¬¯¨«ïâ®à ®¦¨¤ « ­¥ â®â ⮪¥­, ª®â®àë© ¥¬ã ¢áâà¥â¨«áï. â® ¬®¦¥â +% ¯à®¨á室¨âì ¢¥§¤¥, £¤¥ ⮫쪮 ¢®§¬®¦­® ­ àãè¨âì ¯à ¢¨«  +% ï§ëª   áª «ì. +scan_t_start_include_file=02004_TL_H ç «® ç⥭¨ï ¢ª«îç ¥¬®£® ä ©«  $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vt} ª®¬¯¨«ïâ®à á®®¡é ¥â, +% ª®£¤  ®­ ­ ç¨­ ¥â ç¨â âì ¢ª«îç ¥¬ë© ä ©«. +scan_w_comment_level=02005_W_H ©¤¥­ ª®¬¬¥­â à¨© $1 yp®¢­ï +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vw} ª®¬¯¨«ïâ®à ¯à¥¤ã¯à¥¦¤ ¥â ® ⮬, +% çâ® ®­ ®¡­ à㦨« ¢«®¦¥­­ë© ª®¬¬¥­â à¨©. ‚«®¦¥­­ë¥ ª®¬¬¥­â à¨¨ ­¥ à §à¥è¥­ë ¢ +% Turbo Pascal ¨ ¬®£ãâ ¡ëâì ¢®§¬®¦­ë¬ ¨áâ®ç­¨ª®¬ ®è¨¡®ª. +scan_n_ignored_switch=02008_N_„¨à¥ªâ¨¢  ª®¬¯¨«ïâ®à  $1 ¨£­®à¨à®¢ ­  +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vn} ª®¬¯¨«ïâ®à ¯à¥¤ã¯à¥¦¤ ¥â ® ⮬, çâ® ®­ ¨£­®à¨àã¥â ¤¨à¥ªâ¨¢ã. +scan_w_illegal_switch=02009_W_H¥¨§¢¥áâ­ ï ¤¨à¥ªâ¨¢  ª®¬¯¨«ïâ®p  $1 +% ë«  ¨á¯®«ì§®¢ ­  ¤¨à¥ªâ¨¢  ª®¬¯¨«ïâ®à  (â® ¥áâì \var{\{\$... \}}), ª®â®à ï +% ª®¬¯¨«ïâ®àã ­¥ ¨§¢¥áâ­ . +scan_w_switch_is_global=02010_W_ƒ«®¡ «ì­ ï ¤¨à¥ªâ¨¢  ­¥ ­  ᢮¥¬ ¬¥á⥠+% ƒ«®¡ «ì­ë¥ ¤¨à¥ªâ¨¢ë ¤®«¦­ë ­ å®¤¨âìáï ¢ ­ ç «¥ ¯à®£à ¬¬ë ¨«¨ ¬®¤ã«ï. +scan_e_illegal_char_const=02011_E_H¥¢¥à­® § ¤ ­ ᨬ¢®« +% â® á«ãç ¥âáï ¯à¨ ®¯à¥¤¥«¥­¨¨ ᨬ¢®«  á ¯®¬®éìî ASCII-ª®¤ , ­ ¯à¨¬¥à, +% \var{\#96}, ­® ç¨á«® «¨¡® ï¥âáï ­¥¢¥à­ë¬, «¨¡® ¢­¥ ¤®¯ãá⨬®£® ¤¨ ¯ §®­ . +scan_f_cannot_open_input=02012_F_H¥¢®§¬®¦­® ®âªpëâì ä ©« "$1" +% \fpc ­¥ ¬®¦¥â ­ ©â¨ ¨á室­ë© ä ©« ¯à®£à ¬¬ë ¨«¨ ¬®¤ã«ï, 㪠§ ­­ë© +% ¢ ª®¬ ­¤­®© áâப¥. +scan_f_cannot_open_includefile=02013_F_H¥¢®§¬®¦­® ®âªpëâì ¢ª«îç ¥¬ë© ä ©« "$1" +% \fpc ­¥ ¬®¦¥â ­ ©â¨ ¨á室­ë© ä ©«, 㪠§ ­­ë© ¢ ¤¨à¥ªâ¨¢¥ \var{\{\$include \}}. +scan_e_illegal_pack_records=02015_E_¥¢¥à­®¥ 㪠§ ­¨¥ ¢ëà ¢­¨¢ ­¨ï § ¯¨á¨ "$1" +% ‚ ¤¨à¥ªâ¨¢¥ \var{\{\$PACKRECORDS n\} } ¨«¨ \var{\{\$ALIGN n\} } ¨á¯®«ì§ã¥âáï ­¥¢¥à­®¥ §­ ç¥­¨¥ +% \var{n}. „«ï \$PACKRECORDS ¤®¯ãá⨬ë ⮫쪮 1, 2, 4, 8, 16, 32, C, +% NORMAL, DEFAULT,   ¤«ï \$ALIGN ¤®¯ãáâ¨¬ë §­ ç¥­¨ï 1, 2, 4, 8, 16, 32, ON, +% OFF. ‚ ०¨¬¥ MacPas \$ALIGN â ª¦¥ ¯®¤¤¥à¦¨¢ ¥â MAC68K, POWER ¨ RESET. +scan_e_illegal_pack_enum=02016_E_¥¢¥à­®¥ 㪠§ ­¨¥ ¬¨­¨¬ «ì­®£® à §¬¥à  ¯¥à¥ç¨á«¥­¨ï "$1" +% ‚ ¤¨à¥ªâ¨¢¥ \var{\{\$PACKENUM n \}} ¨á¯®«ì§ã¥âáï ­¥¢¥à­®¥ §­ ç¥­¨¥ +% \var {n}. „®¯ãá⨬묨 ïîâáï §­ ç¥­¨ï 1,2,4, NORMAL ¨ DEFAULT. +scan_e_endif_expected=02017_E_Ž¦¨¤ ¥âáï $ENDIF ¤«ï $1 $2, ®¯à¥¤¥«¥­­®£® ¢ $3 áâப  $4 +% „¨à¥ªâ¨¢ë ãá«®¢­®© ª®¬¯¨«ï樨 ­¥ á¡ « ­á¨à®¢ ­ë. +scan_e_preproc_syntax_error=02018_E_‘¨­â ªá¨ç¥áª ï ®è¨¡ª  ¢ ¢ëà ¦¥­¨¨ ãá«®¢­®© ª®¬¯¨«ï樨 +% ‚ ¢ëà ¦¥­¨¨, á«¥¤ãî饬 ¯®á«¥ ¤¨à¥ªâ¨¢ë \var{\{\$if \}}, $ifc ¨«¨ $setc, ¤®¯ã饭  ®è¨¡ª . +scan_e_error_in_preproc_expr=02019_E_Žè¨¡ª  ¯à¨ ¢ëç¨á«¥­¨¨ ¢ëà ¦¥­¨ï ãá«®¢­®© ª®¬¯¨«ï樨 +% ‚ ¢ëà ¦¥­¨¨, á«¥¤ãî饬 ¯®á«¥ ¤¨à¥ªâ¨¢ë \var{\{\$if \}}, $ifc ¨«¨ $setc, ¤®¯ã饭  ®è¨¡ª . +scan_w_macro_cut_after_255_chars=02020_W_„«¨­  ¬ ªp®á  ®£à ­¨ç¥­  255 ᨬ¢®« ¬¨ +% „«¨­  ¬ ªà®ª®¬ ­¤ë ­¥ ¬®¦¥â ¯à¥¢ëè âì 255 ᨬ¢®«®¢. +scan_e_endif_without_if=02021_E_ENDIF ¡¥§ IF(N)DEF +% „¨à¥ªâ¨¢ë \var{\{\$IFDEF.. \}} ¨ {\ {\$ENDIF \}} ­¥ á¡ « ­á¨à®¢ ­ë. +scan_f_user_defined=02022_F_‡ ¤ ­® ¯®«ì§®¢ â¥«¥¬: $1 +% p®¨§®è«  ä â «ì­ ï ®è¨¡ª , § ¤ ­­ ï ¯®«ì§®¢ â¥«¥¬. ‘¬. â ª¦¥ \progref +scan_e_user_defined=02023_E_‡ ¤ ­® ¯®«ì§®¢ â¥«¥¬: $1 +% p®¨§®è«  ®è¨¡ª , § ¤ ­­ ï ¯®«ì§®¢ â¥«¥¬. ‘¬. â ª¦¥ \progref +scan_w_user_defined=02024_W_‡ ¤ ­® ¯®«ì§®¢ â¥«¥¬: $1 +% p¥¤ã¯à¥¦¤¥­¨¥, § ¤ ­­®¥ ¯®«ì§®¢ â¥«¥¬. ‘¬. â ª¦¥ \progref +scan_n_user_defined=02025_N_‡ ¤ ­® ¯®«ì§®¢ â¥«¥¬: $1 +% ‡ ¬¥âª , § ¤ ­­ ï ¯®«ì§®¢ â¥«¥¬. ‘¬. â ª¦¥ \progref +scan_h_user_defined=02026_H_‡ ¤ ­® ¯®«ì§®¢ â¥«¥¬: $1 +% ®¤áª §ª , § ¤ ­­ ï ¯®«ì§®¢ â¥«¥¬. ‘¬. â ª¦¥ \progref +scan_i_user_defined=02027_I_‡ ¤ ­® ¯®«ì§®¢ â¥«¥¬: $1 +% ˆ­ä®à¬ æ¨ï, § ¤ ­­ ï ¯®«ì§®¢ â¥«¥¬. ‘¬. â ª¦¥ \progref +scan_e_keyword_cant_be_a_macro=02028_E_Š«î祢®¥ á«®¢®, ¯¥à¥®¯à¥¤¥«¥­­®¥ ª ª ¬ ªà®á, ­¥ ¨¬¥¥â íää¥ªâ  +% Š«îç¥¢ë¥ á«®¢  ­¥ ¬®£ãâ ¡ëâì ¯¥à¥®¯à¥¤¥«¥­ë á ¯®¬®éìî ¬ ªà®ª®¬ ­¤. +scan_f_macro_buffer_overflow=02029_F_¥à¥¯®«­¥­¨¥ ¡yä¥p  ¬ ªp®á®¢ ¯à¨ ç⥭¨¨ ¨«¨ à áè¨à¥­¨¨ ¬ ªà®ª®¬ ­¤ë +% „«¨­  ¬ ªp®ª®¬ ­¤ë ¨«¨ ¥¥ १ã«ìâ â  ᫨誮¬ ¢¥«¨ª . +scan_w_macro_too_deep=02030_W_—¨á«® ã஢­¥© à áè¨p¥­¨ï ¬ ªà®ª®¬ ­¤ë ¯à¥¢ëè ¥â 16. +% ਠà áè¨à¥­¨¨ ¬ ªà®ª®¬ ­¤ë ¡ë«® ¨á¯®«ì§®¢ ­® ¡®«¥¥ 16 yp®¢­¥© ¢«®¦¥­­®áâ¨. +% Š®¬¯¨«ïâ®à ­¥ ¡ã¤¥â p áè¨pïâì ¤ «ìè¥, â ª ª ª íâ® ¬®¦¥â ¡ëâì ¯à¨§­ ª®¬ ¨á¯®«ì§®¢ ­¨ï ४ãàᨨ. +scan_w_wrong_styled_switch=02031_W_„¨à¥ªâ¨¢ë ª®¬¯¨«ïâ®p  ¢ ª®¬¬¥­â à¨ïå á⨫ï // ­¥ ¯®¤¤¥à¦¨¢ îâáï. +% „¨à¥ªâ¨¢ë ª®¬¯¨«ïâ®à  ¤®«¦­ë ¡ëâì ¢ ª®¬¬¥­â à¨ïå áâ¨«ï  áª «ì. +scan_d_handling_switch=02032_DL_Ž¡à ¡®âª  ¤¨à¥ªâ¨¢ë "$1" +% ਠ¢ª«î祭¨¨ ®â« ¤®ç­®© ¨­ä®à¬ æ¨¨ (\var{-vd}), ª®¬¯¨«ïâ®à á®®¡é ¥â +% ® ⮬, çâ® ®­ ¢ëç¨á«ï¥â ¢ëà ¦¥­¨¥ ãá«®¢­®© ª®¬¯¨«ï樨. +scan_c_endif_found=02033_CL_ENDIF $1 ­ ©¤¥­® +% ਠ¢ª«î祭¨¨ á®®¡é¥­¨© ®¡ ãá«®¢­ëå ¢ëà ¦¥­¨ïå (\var{-vc}), ª®¬¯¨«ïâ®à á®®¡é ¥â +% ® ⮬, £¤¥ ®­ ®¡à ¡ â뢠¥â ¢ëà ¦¥­¨ï ãá«®¢­®© ª®¬¯¨«ï樨. +scan_c_ifdef_found=02034_CL_IFDEF $1 ­ ©¤¥­®, $2 +% ਠ¢ª«î祭¨¨ á®®¡é¥­¨© ®¡ ãá«®¢­ëå ¢ëà ¦¥­¨ïå (\var{-vc}), ª®¬¯¨«ïâ®à á®®¡é ¥â +% ® ⮬, £¤¥ ®­ ®¡à ¡ â뢠¥â ¢ëà ¦¥­¨ï ãá«®¢­®© ª®¬¯¨«ï樨. +scan_c_ifopt_found=02035_CL_IFOPT $1 ­ ©¤¥­®, $2 +% ਠ¢ª«î祭¨¨ á®®¡é¥­¨© ®¡ ãá«®¢­ëå ¢ëà ¦¥­¨ïå (\var{-vc}), ª®¬¯¨«ïâ®à á®®¡é ¥â +% ® ⮬, £¤¥ ®­ ®¡à ¡ â뢠¥â ¢ëà ¦¥­¨ï ãá«®¢­®© ª®¬¯¨«ï樨. +scan_c_if_found=02036_CL_IF $1 ­ ©¤¥­®, $2 +% ਠ¢ª«î祭¨¨ á®®¡é¥­¨© ®¡ ãá«®¢­ëå ¢ëà ¦¥­¨ïå (\var{-vc}), ª®¬¯¨«ïâ®à á®®¡é ¥â +% ® ⮬, £¤¥ ®­ ®¡à ¡ â뢠¥â ¢ëà ¦¥­¨ï ãá«®¢­®© ª®¬¯¨«ï樨. +scan_c_ifndef_found=02037_CL_IFNDEF $1 ­ ©¤¥­®, $2 +% ਠ¢ª«î祭¨¨ á®®¡é¥­¨© ®¡ ãá«®¢­ëå ¢ëà ¦¥­¨ïå (\var{-vc}), ª®¬¯¨«ïâ®à á®®¡é ¥â +% ® ⮬, £¤¥ ®­ ®¡à ¡ â뢠¥â ¢ëà ¦¥­¨ï ãá«®¢­®© ª®¬¯¨«ï樨. +scan_c_else_found=02038_CL_ELSE $1 ­ ©¤¥­®, $2 +% ਠ¢ª«î祭¨¨ á®®¡é¥­¨© ®¡ ãá«®¢­ëå ¢ëà ¦¥­¨ïå (\var{-vc}), ª®¬¯¨«ïâ®à á®®¡é ¥â +% ® ⮬, £¤¥ ®­ ®¡à ¡ â뢠¥â ¢ëà ¦¥­¨ï ãá«®¢­®© ª®¬¯¨«ï樨. +scan_c_skipping_until=02039_CL_p®¯y᪠¥¬ ¤® ... +% ਠ¢ª«î祭¨¨ á®®¡é¥­¨© ®¡ ãá«®¢­ëå ¢ëà ¦¥­¨ïå (\var{-vc}), ª®¬¯¨«ïâ®à á®®¡é ¥â +% ® ⮬, çâ® ®­ ¯à®¯ã᪠¥â ç áâì ãá«®¢­®£® ¢ëà ¦¥­¨ï, ­¥ 㤮¢«¥â¢®àïîéãî ãá«®¢¨î. +scan_i_press_enter=02040_I_H ¦¬¨â¥ <ENTER> ¤«ï ¯à®¤®«¦¥­¨ï +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vi} ª®¬¯¨«ïâ®à ®áâ ­ ¢«¨¢ ¥âáï +% ¨ ¦¤¥â ­ ¦ â¨ï ­  ª« ¢¨èã \var{enter}, ¥á«¨ ¢ ¨á室­®¬ ä ©«¥ +% ¢áâà¥ç ¥âáï ¤¨p¥ªâ¨¢  \var {\{\$STOP\}}. +scan_w_unsupported_switch=02041_W_„¨à¥ªâ¨¢  "$1" ­¥ ¯®¤¤¥à¦¨¢ ¥âáï +% ਠ¢ª«î祭­ëå ¯à¥¤ã¯à¥¦¤¥­¨ïå (\var{-vw}), ª®¬¯¨«ïâ®à ¯à¥¤ã¯à¥¦¤ ¥â +% ® ­¥¯®¤¤¥à¦¨¢ ¥¬ëå ¤¨à¥ªâ¨¢ å. â® ®§­ ç ¥â, çâ® ¤¨à¥ªâ¨¢  ¨á¯®«ì§ã¥âáï +% ¢ Delphi ¨«¨ Turbo Pascal, ­® ­¥ ¢ \fpc +scan_w_illegal_directive=02042_W_H¥¢¥à­ ï ¤¨à¥ªâ¨¢  ª®¬¯¨«ïâ®à  "$1" +% ਠ¢ª«î祭­ëå ¯p¥¤y¯p¥¦¤¥­¨ïå (\var{-vw}), ª®¬¯¨«ïâ®à ¯à¥¤ã¯à¥¦¤ ¥â +% ® ­¥¢¥à­ëå ¤¨p¥ªâ¨¢ å. ‘¯¨á®ª à á¯®§­ ¢ ¥¬ëå ¤¨p¥ªâ¨¢ á¬. ¢ \progref +scan_t_back_in=02043_TL_‚®§¢p â ¢ $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  (\var{-vt}) ª®¬¯¨«ïâ®à á®®¡é ¥â ®¡ ®ª®­ç ­¨¨ +% ç⥭¨ï ¢ª«îç ¥¬®£® ä ©« . +scan_w_unsupported_app_type=02044_W_’¨¯ ¯p¨«®¦¥­¨ï "$1" ­¥ ¯®¤¤¥à¦¨¢ ¥âáï +% â® ¯à¥¤ã¯à¥¦¤¥­¨¥ ¢ë¤ ¥âáï ¯à¨ ¨á¯®«ì§®¢ ­¨¨ ­¥¨§¢¥áâ­®£® ⨯  +% ¯à¨«®¦¥­¨ï ¢ ¤¨à¥ªâ¨¢¥ \var{\{\$APPTYPE\}} +scan_w_app_type_not_support=02045_W_APPTYPE ­¥ ¯®¤¤¥à¦¨¢ ¥âáï 楫¥¢®© Ž‘ +% „¨à¥ªâ¨¢  \var{\{\$APPTYPE\}} ¯®¤¤¥à¦¨¢ ¥âáï ⮫쪮 ­¥ª®â®à묨 ®¯¥à æ¨®­­ë¬¨ á¨á⥬ ¬¨. +scan_w_description_not_support=02046_W_DESCRIPTION ­¥ ¯®¤¤¥à¦¨¢ ¥âáï 楫¥¢®© Ž‘ +% „¨à¥ªâ¨¢  \var{\{\$DESCRIPTION\}} ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ­  ¤ ­­®© 楫¥¢®© Ž‘. +scan_n_version_not_support=02047_N_VERSION ­¥ ¯®¤¤¥à¦¨¢ ¥âáï 楫¥¢®© Ž‘ +% „¨à¥ªâ¨¢  \var{\{\$VERSION\}} ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ­  ¤ ­­®© 楫¥¢®© Ž‘. +scan_n_only_exe_version=02048_N_VERSION ¨á¯®«ì§ã¥âáï ⮫쪮 ¤«ï .EXE ¨ .DLL ¨á室­¨ª®¢ +% „¨à¥ªâ¨¢  \var{\{\$VERSION\}} ¨á¯®«ì§ã¥âáï ⮫쪮 ¤«ï .EXE ¨ .DLL ¨á室­¨ª®¢. +scan_w_wrong_version_ignored=02049_W_¥¢¥à­ë© ä®à¬ â VERSION ¤«ï ¤¨à¥ªâ¨¢ë "$1" +% ”®à¬ â ¤¨à¥ªâ¨¢ë \var{\{\$VERSION\}} - major_version.minor_version +% £¤¥ major_version ¨ minor_version ïîâáï á«®¢ ¬¨. +scan_e_illegal_asmmode_specifier=02050_E_H¥¢¥à­ë© áâ¨«ì  áᥬ¡«¥p : "$1" +% ਠ®¯à¥¤¥«¥­¨¨ ०¨¬   áᥬ¡«¥à  ¤¨à¥ªâ¨¢®© \var{\{\$ASMMODE xxx\}} +% 㪠§ ­ ­¥¢¥à­ë© ०¨¬. +scan_w_no_asm_reader_switch_inside_asm=02051_W_‘¬¥­  ⨯   áᥬ¡«¥p  ­¥¢®§¬®¦­  ¢­ãâਠ¡«®ª , "$1" ¡y¤¥â ¤¥©á⢮¢ âì ⮫쪮 ¤«ï á«¥¤yî饣® ¡«®ª  +% ‚­ãâਠ áᥬ¡«¥à­®£® ¡«®ª  ­¥¢®§¬®¦­® ¯¥à¥ª«î祭¨¥  áᥬ¡«¥à  á ®¤­®£® ⨯  ­  ¤à㣮©. +% “ª § ­­ë© ०¨¬ ­ ç­¥â ¤¥©á⢮¢ âì ⮫쪮 ¤«ï á«¥¤ãî饣®  áᥬ¡«¥à­®£® ¡«®ª . +scan_e_wrong_switch_toggle=02052_E_H¥¢¥p­®¥ ¯¥à¥ª«î祭¨¥ ०¨¬ , ¨á¯®«ì§ã©â¥ ON/OFF ¨«¨ +/- +% „«ï ¯¥à¥ª«î祭¨ï ०¨¬®¢ á«¥¤ã¥â ¨á¯®«ì§®¢ âì ON ¨«¨ OFF, «¨¡® + ¨«¨ - +scan_e_resourcefiles_not_supported=02053_E_” ©«ë p¥áypᮢ ­¥ ¯®¤¤¥à¦¨¢ îâáï 楫¥¢®© Ž‘ +% Ž¯¥à æ¨®­­ ï á¨á⥬ , ¤«ï ª®â®à®© ¯à®¨á室¨â ª®¬¯¨«ïæ¨ï, ­¥ ¯®¤¤¥à¦¨¢ ¥â ä ©«ë à¥áãàᮢ. +scan_w_include_env_not_found=02054_W_‚ª«îç ¥¬ ï ¯¥p¥¬¥­­ ï ®ªpy¦¥­¨ï "$1" ­¥ ­ ©¤¥­  +% “ª § ­­ ï ¯¥à¥¬¥­­ ï ®ªà㦥­¨ï ­¥ ­ ©¤¥­ , ¢¬¥áâ® ­¥¥ ¡ã¤¥â ¯®¤áâ ¢«¥­  ¯ãáâ ï áâப . +scan_e_invalid_maxfpureg_value=02055_E_¥¢¥à­®¥ §­ ç¥­¨¥ ¤«ï ¬ ªá¨¬ «ì­®£® ç¨á«  ॣ¨áâ஢ ᮯà®æ¥áá®à  +% „®¯ãá⨬묨 §­ ç¥­¨ï¬¨ ¤«ï í⮩ ¤¨à¥ªâ¨¢ë ïîâáï 0..8 ¨ NORMAL/DEFAULT +scan_w_only_one_resourcefile_supported=02056_W_„«ï í⮩ á¨áâ¥¬ë ¯®¤¤¥à¦¨¢ ¥âáï ⮫쪮 ®¤¨­ ä ©« à¥áãàᮢ +% „«ï ®¯¥à æ¨®­­®© á¨áâ¥¬ë ­ §­ ç¥­¨ï ¯®¤¤¥à¦¨¢ ¥âáï ⮫쪮 ®¤¨­ ä ©« à¥áãàᮢ. +% 㤥⠨ᯮ«ì§®¢ ­ ¯¥à¢ë© ­ ©¤¥­­ë© ä ©«, ®áâ «ì­ë¥ ¡ã¤ãâ ¨£­®à¨à®¢ ­ë. +scan_w_macro_support_turned_off=02057_W_®¤¤¥p¦ª  ¬ ªp®á®¢ ®âª«î祭  +% Ž¡­ à㦥­® ®¡ê¥­¨¥ ¬ ªà®á , ­® ०¨¬ ¯®¤¤¥à¦ª¨ ¬ ªà®á®¢ ®âª«î祭, +% ¯®í⮬㠮¡ê¥­¨¥ ¡ã¤¥â ¨£­®à¨à®¢ ­®. „«ï ¢ª«î祭¨ï ¯®¤¤¥à¦ª¨ ¬ ªà®á®¢ ¨á¯®«ì§ã©â¥ +% -Sm ¢ ª®¬ ­¤­®© áâப¥ ¨«¨ ¤®¡ ¢ì⥠{$MACRO ON} ¢ ¨á室­ë© ä ©«. +scan_e_invalid_interface_type=02058_E_¥¢¥à­ë© ⨯ interface. „®¯ãá⨬ë ⮫쪮 COM, COBRA ¨«¨ DEFAULT +% “ª § ­­ë© ⨯ ¨­â¥àä¥©á  ­¥ ¯®¤¤¥à¦¨¢ ¥âáï. +scan_w_appid_not_support=02059_W_APPID ¯®¤¤¥à¦¨¢ ¥âáï ⮫쪮 ¤«ï PalmOS +% „¨à¥ªâ¨¢  \var{\{\$APPID\}} ¯®¤¤¥à¦¨¢ ¥âáï ⮫쪮 ¯à¨ ª®¬¯¨«ï樨 ¤«ï PalmOS. +scan_w_appname_not_support=02060_W_APPNAME ¯®¤¤¥à¦¨¢ ¥âáï ⮫쪮 ¤«ï PalmOS +% „¨à¥ªâ¨¢  \var{\{\$APPNAME\}} ¯®¤¤¥à¦¨¢ ¥âáï ⮫쪮 ¯à¨ ª®¬¯¨«ï樨 ¤«ï PalmOS. +scan_e_string_exceeds_255_chars=02061_E_‘âப®¢ ï ª®­áâ ­â  ­¥ ¬®¦¥â ¡ëâì ¤«¨­­¥¥ 255 ᨬ¢®«®¢ +% Ž¤­  áâப®¢ ï ª®­áâ ­â  ¬®¦¥â ᮤ¥à¦ âì 255 ᨬ¢®«®¢ ¬ ªá¨¬ã¬. ®«¥¥ ¤«¨­­ãî +% áâபã á«¥¤ã¥â à §¡¨âì ­  ç á⨠¨ ᮥ¤¨­¨âì ¨å ®¯¥à â®à®¬ +. +scan_f_include_deep_ten=02062_F_“஢¥­ì ¢«®¦¥­¨ï ¢ª«îç ¥¬ëå ä ©«®¢ ¯à¥¢®á室¨â 16. +% ਠç⥭¨¨ ¢ª«îç ¥¬ëå ä ©«®¢ ¤®á⨣­ãâ ã஢¥­ì ¢«®¦¥­­®á⨠16. +% Š®¬¯¨«ïâ®à ¯à¥ªà é ¥â à ¡®âã, â.ª. íâ® ¬®¦¥â ïâìáï ¯à¨§­ ª®¬ ४ãàᨨ. +scan_e_too_many_push=02063_F_‘«¨èª®¬ ¬­®£® ã஢­¥© PUSH +% „®¯ãáâ¨¬ë© ¬ ªá¨¬ã¬ á®áâ ¢«ï¥â 20. â  ®è¨¡ª  ¢®§­¨ª ¥â ⮫쪮 ¢ ०¨¬¥ MacPas. +scan_e_too_many_pop=02064_E_„¨à¥ªâ¨¢  POP ¡¥§ ¯à¥¤è¥áâ¢ãî饩 PUSH +% â  ®è¨¡ª  ¢®§­¨ª ¥â ⮫쪮 ¢ ०¨¬¥ MacPas. +scan_e_error_macro_lacks_value=02065_E_Œ ªà®á ¨«¨ ¯¥à¥¬¥­­ ï ¢à¥¬¥­¨ ª®¬¯¨«ï樨 "$1" ­¥ ¨¬¥¥â ¯à¨á¢®¥­­®£® §­ ç¥­¨ï +% ˆ§-§  í⮣® ¢ëà ¦¥­¨¥ ¢à¥¬¥­¨ ª®¬¯¨«ï樨 ­¥ ¬®¦¥â ¡ëâì ¢ëç¨á«¥­®. +scan_e_wrong_switch_toggle_default=02066_E_¥¢¥à­®¥ ¯¥à¥ª«î祭¨¥ ०¨¬ , ¨á¯®«ì§ã©â¥ ON/OFF/DEFAULT ¨«¨ +/-/* +% ‘«¥¤ã¥â ¯¥à¥ª«îç âì ०¨¬, ¨á¯®«ì§ãï ON ¨«¨ OFF ¨«¨ DEFAULT, «¨¡® + ¨«¨ - ¨«¨ * +scan_e_mode_switch_not_allowed=02067_E_„¨à¥ªâ¨¢  ०¨¬  "$1" §¤¥áì ­¥ ¤®¯ãá⨬  +% „¨à¥ªâ¨¢  ०¨¬  ª®¬¯¨«ï樨 㦥 ¡ë«  ®¡à ¡®â ­ , ¨«¨, ¢ á«ãç ¥ ०¨¬  -Mmacpas, +% ¯¥à¥ª«î祭¨¥ ०¨¬  ¯à®¨á室¨â ¯®á«¥ UNIT. +scan_e_error_macro_undefined=02068_E_¥à¥¬¥­­ ï ¢à¥¬¥­¨ ª®¬¯¨«ï樨 ¨«¨ ¬ ªà®á "$1" ­¥ ®¯à¥¤¥«¥­. +% ˆ§-§  í⮣® ¢ëà ¦¥­¨¥ ¢à¥¬¥­¨ ª®¬¯¨«ï樨 ­¥ ¬®¦¥â ¡ëâì ¢ëç¨á«¥­®. ’®«ìª® ¤«ï ०¨¬  MacPas. +scan_e_utf8_bigger_than_65535=02069_E_Ž¡­ à㦥­ ª®¤ UTF-8, ¯à¥¢ëè î騩 65535 +% \fpc ®¡à ¡ â뢠¥â áâப¨ utf-8 ª ª widestring, â.¥. ª®¤ë ᨬ¢®«®¢ ®£à ­¨ç¥­ë 65535 +scan_e_utf8_malformed=02070_E_¥¢¥à­ ï UTF-8 áâப  +% „ ­­ ï áâப  ­¥ ï¥âáï ¤®¯ãá⨬®© ¢ ª®¤¨à®¢ª¥ UTF-8 +scan_c_switching_to_utf8=02071_C_ ©¤¥­  ᨣ­ âãà  UTF-8, ¨á¯®«ì§ãî ª®¤¨à®¢ªã UTF-8 +% Š®¬¯¨«ïâ®à ®¡­ à㦨« ᨣ­ âãàã UTF-8 (\$ef, \$bb, \$bf) ¢ ­ ç «¥ ä ©« , +% ¯®í⮬㠮­ ¡ã¤¥â ®¡à ¡ â뢠âì ä ©« ª ª UTF-8 +scan_e_compile_time_typeerror=02072_E_‚ëà ¦¥­¨¥ ¢à¥¬¥­¨ ª®¬¯¨«ï樨: Ž¦¨¤ «®áì $1, ­® ¯®«ã祭® $2 ¢ $3 +% Žè¨¡ª  ⨯®¢ ¢ ¢ëà ¦¥­¨¨ ¢à¥¬¥­¨ ª®¬¯¨«ï樨. +scan_n_app_type_not_support=02073_N_APPTYPE ­¥ ¯®¤¤¥à¦¨¢ ¥âáï 楫¥¢®© Ž‘ +% „¨à¥ªâ¨¢  \var{\{\$APPTYPE\}} ¯®¤¤¥à¦¨¢ ¥âáï ⮫쪮 ¤«ï ­¥ª®â®àëå ®¯¥à æ¨®­­ëå á¨á⥬. +scan_e_illegal_optimization_specifier=02074_E_¥¢¥à­ë© ⨯ ®¯â¨¬¨§ æ¨¨ "$1" +% ‚ ¤¨à¥ªâ¨¢¥ \var{\{\$OPTIMIZATION xxx\}} 㪠§ ­® ­¥¢¥à­®¥ §­ ç¥­¨¥. +scan_w_setpeflags_not_support=02075_W_SETPEFLAGS ­¥ ¯®¤¤¥à¦¨¢ ¥âáï 楫¥¢®© Ž‘ +% „¨à¥ªâ¨¢  \var{\{\$SETPEFLAGS\}} ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ®¯¥à æ¨®­­®© á¨á⥬®© ­ §­ ç¥­¨ï. +scan_w_imagebase_not_support=02076_W_IMAGEBASE ­¥ ¯®¤¤¥à¦¨¢ ¥âáï Ž‘ ­ § ­ ç¥­¨ï +% „¨à¥ªâ¨¢  \var{\{\$IMAGEBASE\}} ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ®¯¥à æ¨®­­®© á¨á⥬®© ­ §­ ç¥­¨ï. +scan_w_minstacksize_not_support=02077_W_MINSTACKSIZE ­¥ ¯®¤¤¥à¦¨¢ ¥âáï Ž‘ ­ § ­ ç¥­¨ï +% „¨à¥ªâ¨¢  \var{\{\$MINSTACKSIZE\}} ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ®¯¥à æ¨®­­®© á¨á⥬®© ­ §­ ç¥­¨ï. +scan_w_maxstacksize_not_support=02078_W_MAXSTACKSIZE ­¥ ¯®¤¤¥à¦¨¢ ¥âáï Ž‘ ­ § ­ ç¥­¨ï +% „¨à¥ªâ¨¢  \var{\{\$MAXSTACKSIZE\}} ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ®¯¥à æ¨®­­®© á¨á⥬®© ­ §­ ç¥­¨ï. +scanner_e_illegal_warn_state=02079_E_¥¢¥à­ë© ०¨¬ ¤¨à¥ªâ¨¢ë $WARN +% „¨à¥ªâ¨¢  \$warn ¤®¯ã᪠¥â ⮫쪮 ON ¨ OFF ¤«ï 㪠§ ­¨ï ०¨¬  +scan_e_only_packset=02080_E_¥¢¥à­®¥ §­ ç¥­¨¥ 㯠ª®¢ª¨ ¬­®¦¥á⢠+% „®¯ãá⨬묨 §­ ç¥­¨ï¬¨ ïîâáï 0, 1, 2, 4, 8, DEFAULT ¨ NORMAL +scan_w_pic_ignored=02081_W_„¨à¥ªâ¨¢  ¨«¨ ª«îç PIC ¨£­®à¨à®¢ ­ë +% ¥ª®â®àë¥ ¯« âä®à¬ë, ­ ¯à¨¬¥à, Windows, ­¥ ¯®¤¤¥à¦¨¢ îâ ¨ ­¥ âॡãîâ ¯®§¨æ¨®­­®-­¥§ ¢¨á¨¬ë© ª®¤ (PIC), +% ¯®í⮬ã ᮮ⢥âáâ¢ãî騥 ¤¨àª¥ªâ¨¢ë ¨ ª«îç¨ ª®¬ ­¤­®© áâப¨ ¤«ï ­¨å ¨£­®à¨àãîâáï. +scan_w_unsupported_switch_by_target=02082_W_„¨à¥ªâ¨¢  "$1" ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ¤«ï ⥪ã饩 ¯« âä®à¬ë ­ §­ ç¥­¨ï +% ¥ª®â®àë¥ ¤¨à¥ªâ¨¢ë, ­ ¯à¨¬¥à, \$E, ¯®¤¤¥à¦¨¢ îâáï ­¥ ¤«ï ¢á¥å ¯« âä®à¬. +scan_w_frameworks_darwin_only=02084_W_„¨à¥ªâ¨¢ë ¤«ï Framework ¯®¤¤¥à¦¨¢ îâáï ⮫쪮 ¤«ï Darwin/Mac OS X +% Š®­æ¥¯æ¨ï ä३¬¢®àª®¢ ­¥ ¯®¤¤¥à¦¨¢ ¥âáï FPC ¤«ï ®¯¥à æ¨®­­ëå á¨á⥬, ®â«¨ç­ëå ®â Darwin/Mac OS X. +scan_e_illegal_minfpconstprec=02085_E_¥¢¥à­®¥ 㪠§ ­¨¥ ¬¨­¨¬ «ì­®© â®ç­®á⨠ª®­áâ ­â á ¯« ¢ î饩 § ¯ï⮩ "$1" +% „®¯ãá⨬묨 §­ ç¥­¨ï¬¨ ïîâáï default, 32 ¨ 64, ª®â®àë¥ ®§­ ç îâ ᮮ⢥âá⢥­­® ¬¨­¨¬ «ì­ãî (®¡ëç­® 32 ¡¨â ), 32 ¡¨â ¨ 64 ¡¨â â®ç­®áâì. +scan_w_multiple_main_name_overrides=02086_W_Œ­®£®ªà â­®¥ 㪠§ ­¨¥ ¨¬¥­¨ ¯à®æ¥¤ãàë "main", ¯¥à¢®­ ç «ì­® ¡ë«® "$1" +% ˆ¬ï ®á­®¢­®© â®çª¨ ¢å®¤  㪠§ ­® ¡®«¥¥ ®¤­®£® à § . 㤥⠨ᯮ«ì§®¢ ­® ⮫쪮 ¯®á«¥¤­¥¥ ¨¬ï. +% \end{description} +# +# Parser +# +# 03252 is the last used one +# +% \section {á®®¡é¥­¨ï ᨭ⠪á¨ç¥áª®£®  ­ «¨§ â®à } +% â®â à §¤¥« ¯¥à¥ç¨á«ï¥â ¢á¥ á®®¡é¥­¨ï ᨭ⠪á¨ç¥áª®£®  ­ «¨§ â®à . +% ‘¨­â ªá¨ç¥áª¨©  ­ «¨§ â®à ®áãé¥á⢫ï¥â ᥬ ­â¨ç¥áª¨©  ­ «¨§, â.¥. +% ®¯à¥¤¥«ï¥â ¯à ¢¨«ì­®áâì ¢ëà ¦¥­¨©  áª «ï. +% \begin{description} +parser_e_syntax_error=03000_E_‘¨­â ªá¨ç¥áª ï ®è¨¡ª  ¢  ­ «¨§ â®à¥ +% Ž¡­ à㦥­  ®è¨¡ª  ᨭ⠪á¨á  ï§ëª . Ž¡ëç­® ¯à®¨á室¨â, ª®£¤  ¢ ¨á室­®¬ ä ©«¥ +% ¢áâà¥ç ¥âáï ­¥¤®¯ãáâ¨¬ë© á¨¬¢®«. +parser_e_dont_nest_interrupt=03004_E_INTERRUPT ¯à®æ¥¤ãà  ­¥ ¬®¦¥â ¡ëâì ¢«®¦¥­­®© +% à®æ¥¤ãà  â¨¯  \VAR{INTERRUPT} ¤®«¦­  ¡ëâì £«®¡ «ì­®©. +parser_w_proc_directive_ignored=03005_W_„¨à¥ªâ¨¢  ¯à®æ¥¤ãàë "$1" ¨£­®à¨à®¢ ­  +% “ª § ­­ë© ¬®¤¨ä¨ªâ®à ⨯  ¯à®æ¥¤ãàë ¨£­®à¨à®¢ ­ ª®¬¯¨«ïâ®à®¬. +parser_e_no_overload_for_all_procs=03006_E_¥ ¢á¥ ®¡ê¥­¨ï "$1" ¯¥à¥£à㦥­ë (®¯à¥¤¥«¥­ë ª ª OVERLOAD) +% ਠ¯¥à¥£à㧪¥ ¯à®æ¥¤ãà á ¯®¬®éìî ¤¨à¥ªâ¨¢ë \var{OVERLOAD}, ¥¥ á«¥¤ã¥â +% 㪠§ë¢ âì ¤«ï ¢á¥å ®¡ê¥­¨© ¯¥à¥£à㦥­­®© ¯à®æ¥¤ãàë. +parser_e_export_name_double=03008_E_ˆ¬ï äy­ªæ¨¨ "$1" íªá¯®àâ¨àã¥âáï ¤¢ ¦¤ë +% ‚ᥠä㭪樨, íªá¯®àâ¨àã¥¬ë¥ ¨§ ®¤­®© DLL, ¤®«¦­ë ¨¬¥âì à §«¨ç­ë¥ ¨¬¥­ . +parser_e_export_ordinal_double=03009_E_ˆ­¤¥ªá ä㭪樨 $1 íªá¯®àâ¨àã¥âáï ¤¢ ¦¤ë +% ‚ᥠä㭪樨, íªá¯®àâ¨àã¥¬ë¥ ¨§ ®¤­®© DLL, ¤®«¦­ë ¨¬¥âì à §«¨ç­ë¥ ¨­¤¥ªáë. +parser_e_export_invalid_index=03010_E_H¥¢¥p­ë© ¨­¤¥ªá íªá¯®pâ¨py¥¬®© äy­ªæ¨¨ +% ˆ­¤¥ªá íªá¯®àâ¨à㥬®© ä㭪樨 ¤®«¦¥­ ¡ëâì ¢ ¤¨ ¯ §®­¥ \var{1..\$FFFF} +parser_w_parser_reloc_no_debug=03011_W_Žâ« ¤®ç­ ï ¨­ä®à¬ æ¨ï ¢ ¯¥à¥¬¥é ¥¬®¬ DLL/EXE ä ©«¥ $1 ­¥ à ¡®â®á¯®á®¡­ , ®âª«î祭 . +% ‚ ­ áâ®ï饥 ¢à¥¬ï ¢ª«î祭¨¥ ®â« ¤®ç­®© ¨­ä®à¬ æ¨¨ ¢ ¯¥à¥¬¥é ¥¬ãî DLL ­¥¢®§¬®¦­®. +parser_w_parser_win32_debug_needs_WN=03012_W_„«ï ®â« ¤ª¨ win32-ª®¤ , á«¥¤ã¥â ®âª«îç¨âì ¯¥à¥¬¥é¥­¨¥ ª«î箬 -WN +% Žâ« ¤®ç­ ï ¨­ä®à¬ æ¨ï Stabs ­¥ à ¡®â ¥â ¢ ¯¥à¥¬¥é ¥¬ëå DLL ¨«¨ EXE ä ©« å, ¨á¯®«ì§ã©â¥ -WN +% ¥á«¨ âॡã¥âáï ®â« ¤ª . +parser_e_constructorname_must_be_init=03013_E_Š®­áâpyªâ®p ¤®«¦¥­ ¨¬¥âì ¨¬ï INIT +% Š®­áâàãªâ®à ®¡ê¥­ á ¨¬¥­¥¬, ®â«¨ç­ë¬ ®â \var{init}, ¨ ¤¥©áâ¢ã¥â ª«îç +% \var{-Ss}. ‘¬. ®¯¨á ­¨¥ ¤¥©áâ¢¨ï ª«îç  \var{-Ss} (\seeo{Ss}). +parser_e_destructorname_must_be_done=03014_E_„¥áâpyªâ®p ¤®«¦¥­ ¨¬¥âì ¨¬ï DONE +% „¥áâàãªâ®à ®¡ê¥­ á ¨¬¥­¥¬, ®â«¨ç­ë¬ ®â \var{done}, ¨ ¤¥©áâ¢ã¥â ª«îç +% \var{-Ss}. ‘¬. ®¯¨á ­¨¥ ¤¥©áâ¢¨ï ª«îç  \var{-Ss} (\seeo{Ss}). +parser_e_proc_inline_not_supported=03016_E_„¨à¥ªâ¨¢  INLINE ­¥ ¯®¤¤¥p¦¨¢ ¥âáï +% ਠª®¬¯¨«ï樨 ¯à®£à ¬¬ë á inlining ¢ á⨫¥ C++ ­¥ ¡ë« ¨á¯®«ì§®¢ ­ ª«îç +% \var{-Si} (\seeo{Si}). ® 㬮«ç ­¨î ª®¬¯¨«ïâ®à ­¥ ¯®¤¤¥à¦¨¢ ¥â inlining ¢ á⨫¥ C++. +parser_w_constructor_should_be_public=03018_W_Š®­áâpyªâ®p ¤®«¦¥­ ¡ëâì public +% Š®­áâàãªâ®àë ¤®«¦­ë ¡ëâì ¢ 'public' ᥪ樨 ®¡ê¥­¨ï ®¡ê¥ªâ  (ª« áá ). +parser_w_destructor_should_be_public=03019_W_„¥áâpyªâ®p ¤®«¦¥­ ¡ëâì public +% „¥áâàãªâ®àë ¤®«¦­ë ¡ëâì ¢ 'public' ᥪ樨 ®¡ê¥­¨ï ®¡ê¥ªâ  (ª« áá ). +parser_n_only_one_destructor=03020_N_Š« áá ¬®¦¥â ¨¬¥âì ⮫쪮 ®¤¨­ ¤¥áâpyªâ®p +% „«ï ª« áá  ¬®¦­® ®¯à¥¤¥«¨âì ⮫쪮 ®¤¨­ ¤¥áâàãªâ®à. +parser_e_no_local_objects=03021_E_‹®ª «ì­ë¥ ®¡ê¥­¨ï ª« áᮢ ­¥ ¯®¤¤¥p¦¨¢ îâáï +% Š« ááë ¤®«¦­ë ¡ëâì ®¡ê¥­ë £«®¡ «ì­®. Ž­¨ ­¥ ¬®£ãâ ¡ëâì ®¡ê¥­ë ¢­ãâਠ+% ¯à®æ¥¤ãàë ¨«¨ ä㭪樨. +parser_f_no_anonym_objects=03022_F_€­®­¨¬­ë¥ ®¡ê¥­¨ï ª« áᮢ ­¥ ¯®¤¤¥p¦¨¢ ¥âáï +% ‚áâà¥ç¥­® ­¥¤®¯ãá⨬®¥ ®¡ê¥­¨¥ ®¡ê¥ªâ  (ª« áá ), â.¥. ®¡ê¥ªâ ¨«¨ ª« áá, +% ­¥ ¨¬¥î騩 ¬¥â®¤®¢ ¨ ­¥ ã­ á«¥¤®¢ ­­ë© ®â ¤à㣮£® ®¡ê¥ªâ  (ª« áá ). +%  ¯à¨¬¥à, ®¡ê¥­¨¥: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% ¢ë§®¢¥â íâ㠮訡ªã. +parser_n_object_has_no_vmt=03023_N_Ž¡ê¥ªâ "$1" ­¥ ¨¬¥¥â â ¡«¨æë VMT +% â® § ¬¥âª  ® ⮬, çâ® ®¡ê¥­­ë© ®¡ê¥ªâ ­¥ ¨¬¥¥â â ¡«¨æë ¢¨àâã «ì­ëå ¬¥â®¤®¢ (VMT). +parser_e_illegal_parameter_list=03024_E_H¥¢¥p­ë© ᯨ᮪ ¯ p ¬¥âp®¢ +% ”ã­ªæ¨ï ¢ë§ë¢ ¥âáï á ¯ à ¬¥âà ¬¨, ⨯ ª®â®àëå ®â«¨ç ¥âáï ®â ⨯®¢ ¯ à ¬¥â஢, ¨á¯®«ì§®¢ ­­ëå +% ¯à¨ ®¡ê¥­¨¨ ä㭪樨. +parser_e_wrong_parameter_size=03026_E_¥¢¥à­®¥ ª®«¨ç¥á⢮ ¯ p ¬¥âp®¢ ¯à¨ ¢ë§®¢¥ "$1" +% Žè¨¡ª  ¢ ᯨ᪥ ¯ à ¬¥â஢ ¢ë§ë¢ ¥¬®© ¯à®æ¥¤ãàë ¨«¨ ä㭪樨, ª®«¨ç¥á⢮ ¯ à ¬¥â஢ ­¥¢¥à­®. +parser_e_overloaded_no_procedure=03027_E_¥à¥£à㦥­­ë© ¨¤¥­â¨ä¨ª â®p "$1" ­¥ ï¥âáï äy­ªæ¨¥© +% Š®¬¯¨«ïâ®à ®¡­ à㦨« ᨬ¢®« á ⥬ ¦¥ ¨¬¥­¥¬, çâ® ¨ ¯¥à¥£à㦥­­ ï äã­ªæ¨ï, ­® ­¥ ïî騩áï ä㭪樥©. +parser_e_overloaded_have_same_parameters=03028_E_¥à¥£à㦥­­ë¥ äy­ªæ¨¨ ¨¬¥îâ ®¤¨­ ª®¢ë© ᯨ᮪ ¯ p ¬¥âp®¢ +% ®¯ë⪠ ®¡ê¥­¨ï ¯¥à¥£à㦥­­ëå ä㭪権 á ®¤­¨¬ ¨ ⥬ ¦¥ ᯨ᪮¬ ¯ à ¬¥â஢. +% —â®¡ë ¯¥à¥£à㧪  ¡ë«  ¢®§¬®¦­ , ¯® ªà ©­¥© ¬¥à¥ ®¤¨­ ¨§ ¯ à ¬¥â஢ ¤®«¦¥­ ®â«¨ç âìáï. +parser_e_header_dont_match_forward=03029_E_‡ £®«®¢®ª äy­ªæ¨¨ ­¥ ᮮ⢥âáâ¢y¥â ¯p¥¤ë¤y饬y ®¡ê¥­¨î "$1" +% Ž¡ê¥­  äã­ªæ¨ï á ⥬ ¦¥ ᯨ᪮¬ ¯ à ¬¥â஬, ­® ®â«¨ç î騬áï ⨯®¬ १ã«ìâ â  «¨¡® ¬®¤¨ä¨ª â®à®¬. +parser_e_header_different_var_names=03030_E_‡ £®«®¢®ª äy­ªæ¨¨ "$1" ­¥ ᮮ⢥âáâ¢y¥â ¯p¥¤ë¤y饬y ®¯p¥¤¥«¥­¨î ¢ forward : ¨§¬¥­ï¥âáï ¨¬ï ¯¥à¥¬¥­­®© $2 => $3 +% ”ã­ªæ¨ï ®¡ê¥­  ¢ ᥪ樨 \var{interface} «¨¡® á ¤¨à¥ªâ¨¢®© +% \var{forward},   § â¥¬ ®¯à¥¤¥«¥­  á ®â«¨ç î騬áï ᯨ᪮¬ ¯ à ¬¥â஢. +parser_n_duplicate_enum=03031_N_‡­ ç¥­¨ï ¢ ¯¥à¥ç¨á«ï¥¬ëå ⨯ å ¤®«¦­ë ¡ëâì ¢®§à áâ î騬¨ +% \fpc ¤®¯ã᪠¥â ®¡ê¥­¨¥ ¯¥à¥ç¨á«¥­¨© ª ª ¢ C. ˆ§ á«¥¤ãîé¨å ¤¢ãå ®¡ê¥­¨©: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% ‚â®à®¥ ®¡ê¥­¨¥ ¢ë§®¢¥â íâ® á®®¡é¥­¨¥. ‡­ ç¥­¨¥ \var{A\_UAS} ¤®«¦­® ¡ëâì ¡®«ìè¥, +% 祬 §­ ç¥­¨¥ \var{A\_E}, â.¥. ¯® ªà ©­¥© ¬¥à¥ 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_With ­¥ ¬®¦¥â ¡ëâì ¨á¯®«ì§®¢ ­ ¤«ï ¯¥p¥¬¥­­ëå ¨§ ¤à㣮£® ᥣ¬¥­â  +% With á®åà ­ï¥â ¯¥à¥¬¥­­ãî «®ª «ì­® ­  á⥪¥, +% ­® íâ® ­¥¢®§¬®¦­®, ¥á«¨ ¯¥à¥¬¥­­ ï ­ å®¤¨âáï ¢ ¤à㣮¬ ᥣ¬¥­â¥. +parser_e_too_much_lexlevel=03034_E_“஢¥­ì ¢«®¦¥­¨ï äy­ªæ¨© ¯à¥¢ëè ¥â 31 +% Š®«¨ç¥á⢮ ã஢­¥© ¢«®¦¥­¨ï ä㭪権 ®£à ­¨ç¥­® 31. +parser_e_range_check_error=03035_E_Žè¨¡ª  ¯à®¢¥àª¨ ¤¨ ¯ §®­  ¯p¨ ¢ëç¨á«¥­¨¨ ª®­áâ ­â +% ‡­ ç¥­¨¥ ª®­áâ ­â ­ å®¤¨âáï ¢­¥ ¤®¯ãá⨬®£® ¤«ï ­¨å ¤¨ ¯ §®­ . +parser_w_range_check_error=03036_W_Žè¨¡ª  ¯à®¢¥àª¨ ¤¨ ¯ §®­  ¯p¨ ¢ëç¨á«¥­¨¨ ª®­áâ ­â +% ‡­ ç¥­¨¥ ª®­áâ ­â ­ å®¤¨âáï ¢­¥ ¤®¯ãá⨬®£® ¤«ï ­¨å ¤¨ ¯ §®­ . +parser_e_double_caselabel=03037_E_®¢â®pïîé ïáï ¬¥âª  CASE +% Ž¤­  ¨ â  ¦¥ ¬¥âª  㪠§ ­  2 à §  ¢ ®¤­®¬ ¢ëà ¦¥­¨¨ \var{case}. +parser_e_case_lower_less_than_upper_bound=03038_E_‚¥på­ïï £p ­¨æ  ¤¨ ¯ §®­  case ¬¥­ìè¥, 祬 ­¨¦­ïï +% ‚¥àå­ïï £à ­¨æ  ¬¥âª¨ \var{case} ¬¥­ìè¥ ­¨¦­¥© £à ­¨æë, ¯®í⮬㠬¥âª  ­¥ ¨¬¥¥â á¬ëá« . +parser_e_type_const_not_possible=03039_E_’¨¯¨§¨p®¢ ­­ë¥ ª®­áâ ­âë ª« áᮢ ¨ ¨­â¥à䥩ᮢ ­¥ ¯®¤¤¥p¦¨¢ îâáï +% Ž¡ê¥­¨ï ª®­áâ ­â, ¨¬¥îé¨å ⨯ ª« áá  «¨¡® ¨­â¥à䥩á , ­¥ ¤®¯ã᪠¥âáï. +parser_e_no_overloaded_procvars=03040_E_¥à¥¬¥­­ë¥ ¯¥à¥£à㦥­­ëå ä㭪権 ­¥ ¯®¤¤¥p¦¨¢ îâáï +% ¥¤®¯ãá⨬ ï ¯®¯ë⪠ ¯à¨á¢®¥­¨ï ¯¥à¥£à㦥­­®© ä㭪樨 ¯à®æ¥¤ãà­®© ¯¥à¥¬¥­­®©. +parser_e_invalid_string_size=03041_E_„«¨­  áâp®ª¨ ¤®«¦­  ¡ëâì ¢ ¤¨ ¯ §®­¥ 1 .. 255 +% „«¨­  áâப¨ ⨯  shortstring ®£à ­¨ç¥­  255 ᨬ¢®« ¬¨. ®¯ë⪠ ®¡êâì áâபã +% á ¤«¨­®© ¬¥­¥¥ 1 ¨«¨ ¡®«¥¥ 255. +parser_w_use_extended_syntax_for_objects=03042_W_ˆá¯®«ì§ã©â¥ p áè¨p¥­­ë© ᨭ⠪á¨á NEW ¨ DISPOSE ¤«ï ᮧ¤ ­¨ï íª§¥¬¯«ï஢ ®¡ê¥ªâ®¢ +% ਠ­ «¨ç¨¨ 㪠§ â¥«ï \var{a} ­  ⨯ ª« áá , ¢ë§®¢ +% \var{new(a)} ­¥ ¯à®¨­¨æ¨ «¨§¨àã¥â ª« áá (â.¥. ª®­áâàãªâ®à ­¥ ¡ã¤¥â +% ¢ë§¢ ­), å®âï ¯ ¬ïâì ¡ã¤¥â ¢ë¤¥«¥­ . ‘«¥¤ã¥â ¨á¯®«ì§®¢ âì ¢ë§®¢ +% \var{new(a,init)}, ª®â®àë© ¢ë¤¥«¨â ¯ ¬ïâì ¨ ¢ë§®¢¥â ª®­áâàãªâ®à ª« áá . +parser_w_no_new_dispose_on_void_pointers=03043_W_ˆá¯®«ì§®¢ ­¨¥ NEW ¨ DISPOSE ¤«ï ­¥â¨¯¨§¨p®¢ ­­ëå yª § â¥«¥© ¡¥áá¬ëá«¥­­® +parser_e_no_new_dispose_on_void_pointers=03044_E_ˆá¯®«ì§®¢ ­¨¥ NEW ¨ DISPOSE ¤«ï ­¥â¨¯¨§¨p®¢ ­­ëå yª § â¥«¥© ­¥¢®§¬®¦­® +% ‚맮¢ë \var{new(p)} ¨«¨ \var{dispose(p)} ­¥¢®§¬®¦­ë, ¥á«¨ \var{p} ï¥âáï ­¥â¨¯¨§¨à®¢ ­­ë¬ 㪠§ â¥«¥¬, +% â.ª. ¯à¨ í⮬ ®âáãâáâ¢ã¥â ¨­ä®à¬ æ¨ï ® à §¬¥à¥ ¢ë¤¥«ï¥¬®© ¯ ¬ïâ¨. +% ਭ¨¬ ¥âáï ¤«ï ᮢ¬¥á⨬®á⨠¢ ०¨¬ å \var{tp} ¨ \var{delphi}. +parser_e_class_id_expected=03045_E_Ž¦¨¤ ¥âáï ¨¤¥­â¨ä¨ª â®p ª« áá  +% நá室¨â ¯à¨ ᪠­¨à®¢ ­¨¨ ¨¬¥­¨ ¯à®æ¥¤ãàë, ᮤ¥à¦ é¥£® â®çªã, â.¥. ¬¥â®¤  +% ª« áá  ¨«¨ ®¡ê¥ªâ , ­® ⨯ ¯¥à¥¤ â®çª®© ­¥¨§¢¥á⥭. +parser_e_no_type_not_allowed_here=03046_E_ˆ¤¥­â¨ä¨ª â®p ⨯  §¤¥áì ­¥¤®¯ãá⨬ +% ˆ¤¥­â¨ä¨ª â®à ⨯  ­¥ ¬®¦¥â ¡ëâì ¨á¯®«ì§®¢ ­ ¢ ¢ëà ¦¥­¨¨. +parser_e_methode_id_expected=03047_E_Ž¦¨¤ ¥âáï ¨¤¥­â¨ä¨ª â®p ¬¥â®¤  +% ˆ¤¥­â¨ä¨ª â®à ­¥ ï¥âáï ¬¥â®¤®¬. +% நá室¨â ¯à¨ ᪠­¨à®¢ ­¨¨ ¨¬¥­¨ ¯à®æ¥¤ãàë, ᮤ¥à¦ é¥£® â®çªã, â.¥. ¬¥â®¤  +% ª« áá  ¨«¨ ®¡ê¥ªâ , ­® ¨¬ï ¯à®æ¥¤ãàë ®âáãâáâ¢ã¥â ¢ ®¡ê¥­¨¨ ª« áá . +parser_e_header_dont_match_any_member=03048_E_‡ £®«®¢®ª äy­ªæ¨¨ ­¥ ᮮ⢥âáâ¢ã¥â ­¨ ®¤­®¬ã ¨§ ¬¥â®¤®¢ ª« áá  "$1" +% ˆ¤¥­â¨ä¨ª â®à ­¥ ï¥âáï ¬¥â®¤®¬. +% நá室¨â ¯à¨ ᪠­¨à®¢ ­¨¨ ¨¬¥­¨ ¯à®æ¥¤ãàë, ᮤ¥à¦ é¥£® â®çªã, â.¥. ¬¥â®¤  +% ª« áá  ¨«¨ ®¡ê¥ªâ , ­® ¨¬ï ¯à®æ¥¤ãàë ®âáãâáâ¢ã¥â ¢ ®¡ê¥­¨¨ ª« áá . +parser_d_procedure_start=03049_DL_p®æ¥¤yp /”y­ªæ¨ï $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vd} ª®¬¯¨«ïâ®à á®®¡é ¥â ® ­ ç «¥ ®¡à ¡®âª¨ +% ⥫  ¯à®æ¥¤ãàë ¨«¨ ä㭪樨. +parser_e_error_in_real=03050_E_H¥¢¥p­ ï ª®­áâ ­â  á ¯« ¢ î饩 § ¯ï⮩ +% Š®¬¯¨«ïâ®à ®¦¨¤ ¥â ¢ëà ¦¥­¨¥ ¢¥é¥á⢥­­®£® ⨯ , ­® ¯®«ãç ¥â çâ®-â® ¤à㣮¥. +parser_e_fail_only_in_constructor=03051_E_FAIL ¤®¯ãá⨬ ⮫쪮 ¢ ª®­áâpyªâ®p å +% ˆ­áâàãªæ¨ï \var{FAIL} ¨á¯®«ì§®¢ ­  ¢­¥ ¬¥â®¤  ª®­áâàãªâ®à . +parser_e_no_paras_for_destructor=03052_E_„¥áâpyªâ®pë ­¥ ¬®£yâ ¨¬¥âì ¯ p ¬¥âp®¢ +% „¥áâàãªâ®à ®¡ê¥­ ᮠᯨ᪮¬ ¯ à ¬¥â஢. Œ¥â®¤ë ¤¥áâàãªâ®à®¢ ­¥ ¬®£ãâ ¨¬¥âì ¯ à ¬¥â஢. +% cannot have parameters. +parser_e_only_class_methods_via_class_ref=03053_E_® áá뫪¥ ­  ª« áá ¬®£ãâ ¡ëâì ¢ë§¢ ­ë ⮫쪮 ª« áá-¬¥â®¤ë +% Žè¨¡ª  ¢®§­¨ª ¥â ¢ á«¥¤ãî饩 á¨âã æ¨¨: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} ­¥ ï¥âáï ª« áá-¬¥â®¤®¬ ¨ ¯®í⮬㠭¥ ¬®¦¥â ¡ëâì ¢ë§¢ ­ ¯® áá뫪¥ ­  ª« áá. +parser_e_only_class_methods=03054_E_‚ ª« áá-¬¥â®¤ å ¤®áâ㯭ë ⮫쪮 ¤à㣨¥ ª« áá-¬¥â®¤ë +% ˆ¬¥¥â ®â­®è¥­¨¥ ª ¯à¥¤ë¤ã饩 ®è¨¡ª¥. ˆ§ ª« áá-¬¥â®¤  ­¥«ì§ï ¢ë§¢ âì ®¡ëç­ë© ¬¥â®¤ ®¡ê¥ªâ . +% ‘«¥¤ãî騩 ª®¤ ¯à¨¢¥¤¥â ª í⮩ ®è¨¡ª¥: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% ®áª®«ìªã free ï¥âáï ®¡ëç­ë¬ ¬¥â®¤®¬, ¥£® ­¥«ì§ï ¢ë§¢ âì ¨§ ª« áá-¬¥â®¤ . +parser_e_case_mismatch=03055_E_’¨¯ ª®­áâ ­âë ­¥ ᮢ¯ ¤ ¥â á ⨯®¬ ¢ëp ¦¥­¨ï CASE +% Ž¤­  ¨§ ¬¥â®ª ¨¬¥¥â ⨯, ®â«¨ç­ë© ®â ⨯  ¢ëà ¦¥­¨ï case. +parser_e_illegal_symbol_exported=03056_E_‘¨¬¢®« ­¥ ¬®¦¥â ¡ëâì íªá¯®àâ¨à®¢ ­ ¨§ ¡¨¡«¨®â¥ª¨ +% ਠ­ ¯¨á ­¨¨ ¡¨¡«¨®â¥ª¨ ¬®¦­® íªá¯®àâ¨à®¢ âì ⮫쪮 ¯à®æ¥¤ãàë ¨ ä㭪樨. ’ ª¨¥ ⨯ë, +% ª ª ¯¥à¥¬¥­­ë¥ ¨ ª®­áâ ­âë, íªá¯®àâ¨à®¢ âì ­¥«ì§ï. +parser_w_should_use_override=03057_W_“­ á«¥¤®¢ ­­ë© ¬¥â®¤ "$1" áªàëâ, ¨á¯®«ì§ã©â¥ override +% Œ¥â®¤, ®¡ê¥­­ë© ¢ த¨â¥«ì᪮¬ ª« áᥠª ª \var{virtual}, ¤®«¦¥­ ¡ëâì +% ¯¥à¥ªàëâ ¢ ª« áá¥-­ á«¥¤­¨ª¥ ¤¨à¥ªâ¨¢®© \var{override}. …᫨ ¤¨à¥ªâ¨¢  +% \var{override} ­¥ 㪠§ ­ , ã­ á«¥¤®¢ ­­ë© ¬¥â®¤ ¡ã¤¥â áªàëâ,   ­¥ ¯¥à¥ªàëâ. +parser_e_nothing_to_be_overridden=03058_E_‚ த¨â¥«ì᪮¬ ª« áᥠ­¥â ¬¥â®¤  ¤«ï ¯¥p¥ªàëâ¨ï: "$1" +% ®¯ë⪠ ¯¥à¥ªàëâì \var{override} ¢¨àâã «ì­ë© ¬¥â®¤, ®âáãâáâ¢ãî騩 ¢ த¨â¥«ì᪮¬ ª« áá¥î. +parser_e_no_procedure_to_access_property=03059_E_¥ 㪠§ ­ ᯮᮡ ¤®áâ㯠 ª ᢮©áâ¢ã +% „«ï ᢮©á⢠ ­¥ 㪠§ ­  ¤¨à¥ªâ¨¢  \var{read}. +parser_w_stored_not_implemented=03060_W_„¨à¥ªâ¨¢  stored ¤«ï ᢮©á⢠¥é¥ ­¥ p¥ «¨§®¢ ­  +% „¨à¥ªâ¨¢  \var{stored} ¥é¥ ­¥ ॠ«¨§®¢ ­  +parser_e_ill_property_access_sym=03061_E_H¥¢¥p­ë© ᨬ¢®« ¤«ï ¤®áâ㯠 ª ᢮©áâ¢y +% Žè¨¡ª  ¢ ¤¨à¥ªâ¨¢¥ \var{read} ¨«¨ \var{write} ¤«ï ᢮©á⢠ ⨯  ¬ áᨢ. +% „®áâ㯠ª ᢮©áâ¢ã ⨯  ¬ áᨢ ¢®§¬®¦¥­ ⮫쪮 á ¯®¬®éìî ¯à®æ¥¤ãà ¨ ä㭪権. +% ‘«¥¤ãî騩 ª®¤ ¢ë§®¢¥â ®è¨¡ªã: +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_„®áâ㯠ª protected ¯®«î ®¡ê¥ªâ  §¤¥áì ­¥¢®§¬®¦¥­ +% ®«ï, ®¯à¥¤¥«¥­­ë¥ ¢ ᥪ樨 \var{protected} ®¡ê¥­¨ï ª« áá , +% ­¥¤®áâã¯­ë ¢­¥ ¬®¤ã«ï, ¢ ª®â®à®¬ ®¡ê¥­ ª« áá, ¨ ¢­¥ ¬¥â®¤®¢ ®¡ê¥ªâ®¢-­ á«¥¤­¨ª®¢. +parser_e_cant_access_private_member=03063_E_„®áâ㯠ª private ¯®«î ®¡ê¥ªâ  §¤¥áì ­¥¢®§¬®¦¥­ +% ®«ï, ®¯à¥¤¥«¥­­ë¥ ¢ ᥪ樨 \var{private} ®¡ê¥­¨ï ª« áá , +% ­¥¤®áâã¯­ë ¢­¥ ¬®¤ã«ï, ¢ ª®â®à®¬ ®¡ê¥­ ª« áá. +parser_e_overridden_methods_not_same_ret=03066_E_¥à¥ªàëâë¥ ¬¥â®¤ë ¤®«¦­ë ¨¬¥âì ®¤¨­ ª®¢ë© ⨯ १ã«ìâ â : "$2" ¯¥à¥ªàëâ "$1", ª®â®àë© ¢®§¢à é ¥â ¤à㣮© ⨯ +% ¥à¥ªàëâë¥ ¬¥â®¤ë ¤®«¦­ë ¢®§¢à é âì १ã«ìâ â ®¤¨­ ª®¢®£® ⨯ . +parser_e_dont_nest_export=03067_E_ªá¯®àâ¨àã¥¬ë¥ äy­ªæ¨¨ ­¥ ¬®£yâ ¡ëâì ¢«®¦¥­­ë¬¨ +% ¥«ì§ï ®¡êâì ¯à®æ¥¤ãàã ¨«¨ äã­ªæ¨î, ¢«®¦¥­­ãî ¢ ¯à®æ¥¤ãàã ¨«¨ äã­ªæ¨î, ®¡ê¥­­ãî ª ª íªá¯®àâ¨à㥬 ï. +parser_e_methods_dont_be_export=03068_E_Œ¥â®¤ë ­¥ ¬®£yâ íªá¯®pâ¨p®¢ âìáï +% Œ¥â®¤ ª« áá  ¨«¨ ®¡ê¥ªâ  ­¥ ¬®¦¥â ¡ëâì ®¡ê¥­ ª ª +% \var{export}. +parser_e_call_by_ref_without_typeconv=03069_E_’¨¯ ¯ à ¬¥âà  no. $1 ¯à¨ ¯¥à¥¤ ç¥ ¯® áá뫪¥ ¤®«¦¥­ ᮢ¯ ¤ âì: ¯®«ã祭® "$2", ®¦¨¤ «®áì "$3" +% ਠ¢ë§®¢¥ ä㭪樨, ¨¬¥î饩 ¯ à ¬¥âàë ¯® áá뫪¥ (\var{var}), ⨯ ¯ à ¬¥âà  +% ¤®«¦¥­ áâண® ᮢ¯ ¤ âì á ®¡ê¥­­ë¬. €¢â®¬ â¨ç¥áª®¥ ¯à¥®¡à §®¢ ­¨¥ ⨯®¢ +% ¢ í⮬ á«ãç ¥ ®âáãâáâ¢ã¥â. +parser_e_no_super_class=03070_E_Š« áá ­¥ ï¥âáï த¨â¥«ì᪨¬ ¤«ï ⥪ã饣® ª« áá  +% ਠ¢ë§®¢¥ ã­ á«¥¤®¢ ­­®£® ¬¥â®¤  㪠§ ­ ª« áá, ®â«¨ç­ë© ®â த¨â¥«ì᪮£®. +% “­ á«¥¤®¢ ­­ë© ¬¥â®¤ ¬®¦­® ¢ë§ë¢ âì ⮫쪮 ã த¨â¥«ì᪮£® ª« áá . +parser_e_self_not_in_method=03071_E_SELF ¤®¯ãá⨬ ⮫쪮 ¢ ¬¥â®¤ å +% ®¯ë⪠ ¨á¯®«ì§®¢ ­¨ï ¯ à ¬¥âà  \var{self} ¢­¥ ¬¥â®¤  ®¡ê¥ªâ . +%  à ¬¥âà \var{self} ¯¥à¥¤ ¥âáï ⮫쪮 ¢ ¬¥â®¤ë. +parser_e_generic_methods_only_in_methods=03072_E_‚맮¢ ¬¥â®¤®¢ á ¨¤¥­â¨ä¨ª â®à®¬ ⨯  ª« áá  ¢®§¬®¦¥­ ⮫쪮 ¨§ ¤àã£¨å ¬¥â®¤®¢ +% Š®­áâàãªæ¨ï ¢¨¤  \var{sometype.somemethod} ¤®¯ãá⨬  ⮫쪮 ¢­ãâਠ¬¥â®¤®¢. +parser_e_illegal_colon_qualifier=03073_E_H¥¢¥à­®¥ ¨á¯®«ì§®¢ ­¨¥ ':' +% ”®à¬ â \var{:} (¤¢®¥â®ç¨¥) 2 à §  ¨á¯®«ì§ã¥âáï ­  ¢ëà ¦¥­¨¨, ª®â®à®¥ ­¥ ï¥âáï ¢¥é¥á⢥­­ë¬. +parser_e_illegal_set_expr=03074_E_Žè¨¡ª  ¯à®¢¥àª¨ ¤¨ ¯ §®­  ¢ ª®­áâàãªâ®à¥ ¬­®¦¥á⢠ ¨«¨ ¯®¢â®àïî騩áï í«¥¬¥­â ¬­®¦¥á⢠ +% Žè¨¡ª  ¢ ®¡ê¥­¨¨ ¬­®¦¥á⢠. ‹¨¡® ®¤¨­ ¨§ í«¥¬¥­â®¢ ¢ë室¨â §  ¤®¯ãáâ¨¬ë© ¤¨ ¯ §®­, +% «¨¡® ª ª¨¥-«¨¡® ¤¢  í«¥¬¥­â  ¨¬¥îâ ®¤­® ¨ â® ¦¥ §­ ç¥­¨¥. +parser_e_pointer_to_class_expected=03075_E_Ž¦¨¤ ¥âáï yª § â¥«ì ­  ®¡ê¥ªâ +% ˆá¯®«ì§®¢ ­ ­¥¢¥à­ë© ⨯ ¢ ¢ëà ¦¥­¨¨ \var{New}. +%  áè¨à¥­­ë© ᨭ⠪á¨á \var{New} âॡã¥â ¯ à ¬¥âà  â¨¯  ®¡ê¥ªâ. +parser_e_expr_have_to_be_constructor_call=03076_E_‚ëp ¦¥­¨¥ ¤®«¦­® ¢ë§ë¢ âì ª®­áâpyªâ®p +% ਠ¨á¯®«ì§®¢ ­¨¨ à áè¨à¥­­®£® ᨭ⠪á¨á  \var{new} ­ã¦­® 㪠§ë¢ âì ª®­áâàãªâ®à ®¡ê¥ªâ . +% “ª § ­­ ï ¯à®æ¥¤ãà  ­¥ ï¥âáï ª®­áâàãªâ®à®¬. +parser_e_expr_have_to_be_destructor_call=03077_E_‚ëp ¦¥­¨¥ ¤®«¦­® ¢ë§ë¢ âì ¤¥áâpyªâ®p +% ਠ¨á¯®«ì§®¢ ­¨¨ à áè¨à¥­­®£® ᨭ⠪á¨á  \var{dispose} ­ã¦­® 㪠§ë¢ âì ¤¥áâàãªâ®à ®¡ê¥ªâ . +% “ª § ­­ ï ¯à®æ¥¤ãà  ­¥ ï¥âáï ¤¥áâàãªâ®à®¬. +parser_e_invalid_record_const=03078_E_H¥¢¥p­ë© ¯®p冷ª í«¥¬¥­â®¢ § ¯¨á¨ +% ਠ®¡ê¥­¨¨ ª®­áâ ­âë ⨯  § ¯¨áì, ¯®«ï 㪠§ ­ë ¢ ­¥¢¥à­®¬ ¯®à浪¥. +parser_e_false_with_expr=03079_E_’¨¯ ¢ëp ¦¥­¨ï ¤®«¦¥­ ¡ëâì CLASS ¨«¨ RECORD +% €à£ã¬¥­â ¢ëà ¦¥­¨ï \var{with} ¤®«¦¥­ ¡ëâì ⨯  \var{record} ¨«¨ +% \var{class}. ˆá¯®«ì§®¢ ­  à£ã¬¥­â á ⨯®¬, ®â«¨ç­ë¬ ®â 㪠§ ­­ëå. +parser_e_void_function=03080_E_p®æ¥¤yp  ­¥ ¬®¦¥â ¢®§¢p é âì §­ ç¥­¨¥ +% \fpc ¯®§¢®«ï¥â 㪠§ âì ¢®§¢à é ¥¬®¥ §­ ç¥­¨¥ ¤«ï ä㭪樨 ¯à¨ ¨á¯®«ì§®¢ ­¨¨ +% ¢ëà ¦¥­¨ï \var{exit}. Žè¨¡ª  ¢®§­¨ª ¥â ¯à¨ ¯®¯ë⪥ ᤥ« âì íâ® ¢ ¯à®æ¥¤ãà¥. +% à®æ¥¤ãà  ­¥ ¬®¦¥â ¢®§¢à é âì §­ ç¥­¨¥. +parser_e_only_methods_allowed=03081_E_Š®­áâpyªâ®pë, ¤¥áâpyªâ®pë ¨ ®¯¥à â®àë ª« áá  ¤®«¦­ë ¡ëâì ¬¥â®¤ ¬¨ +% ®¯ë⪠ ®¯à¥¤¥«¨âì ¯à®æ¥¤ãàã, ­¥ ïîéãîáï ¬¥â®¤®¬ ª« áá , ª ª ª®­áâàãªâ®à, ¤¥áâàãªâ®à ¨«¨ ®¯¥à â®à ª« áá . +parser_e_operator_not_overloaded=03082_E_Ž¯¥p â®p ­¥ ¯¥p¥£py¦¥­ +% ®¯ë⪠ ¨á¯®«ì§®¢ âì ¯¥à¥£à㦥­­ë© ®¯¥à â®à, ª®£¤  ®­ ­¥ ¯¥à¥£à㦥­ ¤«ï ¤ ­­®£® ⨯ . +parser_e_no_such_assignment=03083_E_¥¢®§¬®¦­® ¯¥à¥£à㧨âì ¯à¨á¢®¥­¨¥ ¤«ï ®¤¨­ ª®¢ëå ⨯®¢ +% ¥à¥£à㦥­­®¥ ¯à¨á¢®¥­¨¥ ­¥¢®§¬®¦­® ¤«ï ⨯®¢, ª®â®àë¥ ª®¬¯¨«ïâ®à áç¨â ¥â ®¤¨­ ª®¢ë¬¨. +parser_e_overload_impossible=03084_E_¥à¥£à㧪  ®¯¥à â®à  ­¥¢®§¬®¦­  +% ‘®ç¥â ­¨¥ ®¯¥à â®à ,  à£ã¬¥­â®¢ ¨ ¢®§¢à é ¥¬®£® §­ ç¥­¨ï ï¥âáï ­¥á®¢¬¥á⨬ë¬. +parser_e_no_reraise_possible=03085_E_®¢â®à­®¥ ¡à®á ­¨¥ ¨áª«î祭¨ï §¤¥áì ­¥¢®§¬®¦­® +% ®¯ë⪠ ¯®¢â®à­®£® ¡à®á ­¨ï ¨áª«î祭¨ï ¢ ­¥¤®¯ãá⨬®¬ ¬¥áâ¥. â® à §à¥è¥­® ¤¥« âì ⮫쪮 +% ¢ ¡«®ª¥ \var{except}. +parser_e_no_new_or_dispose_for_classes=03086_E_ áè¨p¥­­ë© ᨭ⠪á¨á NEW ¨ DISPOSE ­¥ à §à¥è¥­ ¤«ï ª« áᮢ +% ª§¥¬¯«ïà ª« áá  ­¥ ¬®¦¥â ¡ëâì ᮧ¤ ­ á ¯®¬®éìî à áè¨à¥­­®£® ᨭ⠪á¨á  +% \var{new}, ¤«ï í⮣® á«¥¤ã¥â ¨á¯®«ì§®¢ âì ª®­áâàãªâ®à. €­ «®£¨ç­®, ¤«ï +% 㤠«¥­¨ï íª§¥¬¯«ïà  ª« áá  á«¥¤ã¥â ¨á¯®«ì§®¢ âì ­¥ \var{Dispose},   ¤¥áâàãªâ®à. +parser_e_procedure_overloading_is_off=03088_E_¥à¥£à㧪  ¯p®æ¥¤yp ®âª«î祭  +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-So} ¯¥à¥£à㧪  ¯à®æ¥¤ãà ®âª«î祭 . +% Turbo Pascal ­¥ ¯®¤¤¥à¦¨¢ ¥â ¯¥à¥£à㧪ã. +parser_e_overload_operator_failed=03089_E_¥à¥£à㧪  í⮣® ®¯¥à â®à  ­¥¢®§¬®¦­ . ¥à¥£à㦠¥¬ë¥ ®¯¥à â®àë (¥á«¨ ¥áâì): $1 +% ®¯ë⪠ ¯¥à¥£à㧨âì ®¯¥à â®à, ª®â®àë© ­¥ ¬®¦¥â ¡ëâì ¯¥à¥£à㦥­. +% ‘«¥¤ãî騥 ®¯¥à â®àë ¬®£ãâ ¡ëâì ¯¥à¥£à㦥­ë: +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_Ž¯¥à â®à áà ¢­¥­¨ï ¤®«¦¥­ ¢®§¢à é âì §­ ç¥­¨¥ ⨯  boolean +% ਠ¯¥à¥£à㧪¥ ®¯¥à â®à  áà ¢­¥­¨ï \var{=}, äã­ªæ¨ï ¤®«¦­  ¢®§¢à é âì §­ ç¥­¨¥ ⨯  boolean. +parser_e_only_virtual_methods_abstract=03091_E_’®«ìª® ¢¨àâã «ì­ë¥ ¬¥â®¤ë ¬®£ãâ ¡ëâì  ¡áâà ªâ­ë¬¨ +% ®¯ë⪠ ®¯à¥¤¥«¨âì  ¡áâà ªâ­ë© ¬¥â®¤, ­¥ ïî騩áï ¯à¨ í⮬ ¢¨àâã «ì­ë¬. +parser_f_unsupported_feature=03092_F_ˆá¯®«ì§®¢ ­¨¥ ¯®ª  ­¥¯®¤¤¥à¦¨¢ ¥¬®© ®á®¡¥­­®á⨠ª®¬¯¨«ïâ®à ! +% ®¯ë⪠ § áâ ¢¨âì ª®¬¯¨«ïâ®à ᤥ« âì ­¥çâ®, 祣® ®­ ¯®ª  ¥é¥ ­¥ 㬥¥â. +parser_e_mix_of_classes_and_objects=03093_E_‘¬¥è¨¢ ­¨¥ à §«¨ç­ëå ⨯®¢ ®¡ê¥ªâ®¢ (class, object, interface) ­¥ ¤®¯ã᪠¥âáï +% ˆ§¬¥­¥­¨¥ ¡ §®¢®£® ⨯  ¯à¨ ­ á«¥¤®¢ ­¨¨ ­¥ ¤®¯ã᪠¥âáï. â®, ¢ ç áâ­®áâ¨, ®§­ ç ¥â, çâ® +% class ­¥ ¬®¦¥â ¡ëâì ¯®à®¦¤¥­ ®â object, ¨ ­ ®¡®à®â. +parser_w_unknown_proc_directive_ignored=03094_W_¥¨§¢¥áâ­ ï ¤¨à¥ªâ¨¢  ¯à®æ¥¤ãàë: "$1", ¨£­®à¨à®¢ ­® +% “ª § ­­ ï ¤¨à¥ªâ¨¢  ¯à®æ¥¤ãàë ­¥¨§¢¥áâ­  ª®¬¯¨«ïâ®àã. +parser_e_absolute_only_one_var=03095_E_ABSOLUTE ¬®¦¥â ¡ëâì 㪠§ ­® ⮫쪮 ¤«ï ®¤­®© ¯¥p¥¬¥­­®© +% ¥«ì§ï 㪠§ë¢ âì ¡®«¥¥ ®¤­®© ¯¥à¥¬¥­­®© ¯¥à¥¤ ¤¨à¥ªâ¨¢®© \var{absolute}. +% ‘«¥¤ãîé ï ª®­áâàãªæ¨ï ¯à¨¢¥¤¥â ª ®è¨¡ª¥: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +parser_e_absolute_only_to_var_or_const=03096_E_ABSOLUTE ¬®¦¥â ¡ëâì á¢ï§ ­  ⮫쪮 á ¯¥p¥¬¥­­®© ¨«¨ ª®­á⠭⮩ +% €¤à¥á ¤¨à¥ªâ¨¢ë \var{absolute} ¬®¦¥â 㪠§ë¢ âì ⮫쪮 ­  ¯¥à¥¬¥­­ãî ¨«¨ +% ª®­áâ ­âã. ‘«¥¤ãî騩 ª®¤ ¯à¨¢¥¤¥â ª ®è¨¡ª¥: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_initialized_only_one_var=03097_E_ˆ­¨æ¨ «¨§ æ¨ï ¤®¯ãá⨬  ⮫쪮 ¤«ï ®¤­®© ¯¥à¥¬¥­­®© +% ¥¤®¯ãá⨬® 㪠§ ­¨¥ ­ ç «ì­®£® §­ ç¥­¨ï ¡®«¥¥ 祬 ¤«ï ®¤­®© ¯¥à¥¬¥­­®© ¢ +% ᨭ⠪á¨á¥ Delphi. +parser_e_abstract_no_definition=03098_E_€¡áâà ªâ­ë¥ ¬¥â®¤ë ­¥ ¬®£ãâ ¨¬¥âì ॠ«¨§ æ¨î (⥫®) +% €¡áâà ªâ­ë¥ ¬¥â®¤ë ¬®£ãâ ¨¬¥âì ⮫쪮 ®¡ê¥­¨¥, ॠ«¨§ æ¨ï ¤«ï ­¨å ­¥¤®¯ãá⨬ . Ž­¨ +% ¤®«¦­ë ¡ëâì ¯¥à¥ªàëâë ¢ ã­ á«¥¤®¢ ­­ëå ª« áá å. +parser_e_overloaded_must_be_all_global=03099_E_â  ¯¥à¥£à㦥­­ ï äã­ªæ¨ï ­¥ ¬®¦¥â ¡ëâì «®ª «ì­®© (¤®«¦­  íªá¯®àâ¨à®¢ âìáï) +% ®¯ë⪠ ®¯à¥¤¥«¨âì ¯¥à¥£à㦥­­ãî äã­ªæ¨î ¢ ᥪ樨 implementation ¬®¤ã«ï, +% ¤«ï ª®â®à®© ®âáãâáâ¢ã¥â ®¡ê¥­¨¥ ¢ ᥪ樨 interface. +parser_w_virtual_without_constructor=03100_W_‚¨àâã «ì­ë¥ ¬¥â®¤ë ¨á¯®«ì§ãîâáï ¡¥§ ª®­áâàãªâ®à  ¢ "$1" +% ਠ®¡ê¥­¨¨ ®¡ê¥ªâ  ¨«¨ ª« áá , ᮤ¥à¦ é¥£® ¢¨àâã «ì­ë¥ ¬¥â®¤ë, ¤«ï +% ¨å ª®à४⭮© ¨­¨æ¨ «¨§ æ¨¨ âॡã¥âáï ª®­áâàãªâ®à. Š®¬¯¨«ïâ®à ¢áâà¥â¨« ®¡ê¥­¨¥ +% ª« áá  ¨«¨ ®¡ê¥ªâ  á ¢¨àâã «ì­ë¬¨ ¬¥â®¤ ¬¨, ­® ¡¥§ ¯ àë ª®­áâàãªâ®à/¤¥áâàãªâ®à. +parser_c_macro_defined=03101_CL_Ž¯p¥¤¥«¥­ ¬ ªp®á: $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ \var{-vc} ª®¬¯¨«ïâ®à á®®¡é ¥â ®¡ ®¯à¥¤¥«¥­¨¨ ¬ ªà®á®¢. +parser_c_macro_undefined=03102_CL_“¤ «¥­® ®¯à¥¤¥«¥­¨¥ ¬ ªà®á : $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ \var{-vc} ª®¬¯¨«ïâ®à á®®¡é ¥â ® ⮬, çâ® ¬ ªà®á ¡®«ìè¥ ­¥ ®¯à¥¤¥«¥­. +parser_c_macro_set_to=03103_CL_Œ ªp®á $1 yáâ ­®¢«¥­ ¢ $2 +% ਠ¨á¯®«ì§®¢ ­¨¨ \var{-vc} ª®¬¯¨«ïâ®à á®®¡é ¥â ®¡ ¨§¬¥­¥­¨¨ §­ ç¥­¨ï ¬ ªà®á . +parser_i_compiling=03104_I_Š®¬¯¨«ïæ¨ï $1 +% ਠ¢ª«î祭¨¨ ¨­ä®à¬ æ¨®­­ëå á®®¡é¥­¨© (\var{-vi}), ª®¬¯¨«ïâ®à á®®¡é ¥â ® ⮬, +% ª ª¨¥ ¬®¤ã«¨ ®­ ª®¬¯¨«¨àã¥â. +parser_u_parsing_interface=03105_UL_€­ «¨§ ¨­â¥àä¥©á  ¬®¤y«ï $1 +% ‘®®¡é ¥â ® ­ ç «¥ à §¡®à  ¨­â¥à䥩᭮© ç á⨠⥪ã饣® ¬®¤ã«ï. +parser_u_parsing_implementation=03106_UL_€­ «¨§ ॠ«¨§ æ¨¨ ¬®¤y«ï $1 +% ‘®®¡é ¥â ® ­ ç «¥ à §¡®à  ॠ«¨§ æ¨¨ ⥪ã饣® ¬®¤ã«ï, ¯à®£à ¬¬ë ¨«¨ ¡¨¡«¨®â¥ª¨. +parser_d_compiling_second_time=03107_DL_®¢â®à­ ï ª®¬¯¨«ïæ¨ï $1 +% ਠ¢ª«î祭¨¨ ®â« ¤®ç­ëå á®®¡é¥­¨© (\var{-vd}) ª®¬¯¨«ïâ®à á®®¡é ¥â ® ⮬, +% ª ª¨¥ ¬®¤ã«¨ ®­ ª®¬¯¨«¨àã¥â ¯®¢â®à­®. +parser_e_no_property_found_to_override=03109_E_Žâáãâáâ¢ã¥â ᢮©á⢮ ¤«ï ¯¥p¥®¯p¥¤¥«¥­¨ï +% ®¯ë⪠ ¯¥à¥®¯à¥¤¥«¨âì ᢮©á⢮ த¨â¥«ì᪮£® ª« áá , ¯à¨ ®âáãâá⢨¨ â ª®¢®£® ¢ த¨â¥«ì᪮¬ ª« áá¥. +parser_e_only_one_default_property=03110_E_„®¯ãá⨬® ⮫쪮 ®¤­® ᢮©á⢮ ¯® 㬮«ç ­¨î +% ‘¢®©á⢮ ®¯à¥¤¥«¥­® ª ª \var{Default}, ­® த¨â¥«ì᪨© ª« áá 㦥 ¨¬¥¥â ®¯à¥¤¥«¥­­®¥ â ª¨¬ ¦¥ ®¡à §®¬ +% ᢮©á⢮. +parser_e_property_need_paras=03111_E_‘¢®©á⢮ ¯® 㬮«ç ­¨î ¤®«¦­® ¨¬¥âì ⨯ ¬ áᨢ  +% ’®«ìª® ᢮©á⢠ ⨯  ¬ áᨢ ¬®£ãâ ¡ëâì ®¡ê¥­ë ª ª \var{default}. +parser_e_constructor_cannot_be_not_virtual=03112_E_‚¨pây «ì­ë¥ ª®­áâpyªâ®pë ¤®¯ãá⨬ë ⮫쪮 ¢ ª« áá å +% ‚¨àâã «ì­ë¥ ª®­áâàãªâ®àë ¤®¯ãá⨬ë ⮫쪮 ¢ ª« áá å, ¨å ­¥«ì§ï +% ®¡êïâì ¢ ®¡ê¥ªâ å. +parser_e_no_default_property_available=03113_E_Žâáãâáâ¢ã¥â ᢮©á⢮ ¯® 㬮«ç ­¨î +% ®¯ë⪠ ¤®áâ㯠 ª ᢮©áâ¢ã ¯® 㬮«ç ­¨î ª« áá , ª®â®àë© ­¥ ¨¬¥¥â â ª®£® ᢮©á⢠. +parser_e_cant_have_published=03114_E_Š« áá ­¥ ¬®¦¥â ¨¬¥âì PUBLISHED à §¤¥«, ¨á¯®«ì§y©â¥ ª«îç {$M+} +% …᫨ âॡã¥âáï à §¤¥« \var{published} ¢ ®¡ê¥­¨¨ ª« áá , á«¥¤ã¥â +% ¨á¯®«ì§®¢ âì ª«îç \var{\{\$M+\}}, ª®â®àë© ¢ª«î砥⠣¥­¥à æ¨î ¨­ä®à¬ æ¨¨ ® ⨯ å. +parser_e_forward_declaration_must_be_resolved=03115_E_ ­­¥¥ ®¯p¥¤¥«¥­¨¥ ª« áá  "$1" ¤®«¦­® ¡ëâì à §à¥è¥­® §¤¥áì, çâ®¡ë ¨á¯®«ì§®¢ âì ¥£® ª ª ¯à¥¤®ª +% —â®¡ë ª« áá ¬®¦­® ¡ë«® ¨á¯®«ì§®¢ âì ª ª ¯à¥¤®ª, ®­ ¤®«¦¥­ ¡ëâì á­ ç «  ®¯à¥¤¥«¥­. +% Žè¨¡ª  ¢®§­¨ª ¥â ¢ á«¥¤ãî饩 á¨âã æ¨¨: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% ƒ¤¥ \var{ParentClass} ®¡ê¥­, ­® ­¥ ®¯à¥¤¥«¥­. +parser_e_no_local_operator=03116_E_‹®ª «ì­ë¥ ®¯¥p â®pë ­¥ ¯®¤¤¥p¦¨¢ îâáï +% Ž¯¥à â®à ­¥«ì§ï ¯¥à¥£à㧨âì «®ª «ì­®, â.¥. ¢­ãâਠ®¯à¥¤¥«¥­¨ï ¯à®æ¥¤ãàë ¨«¨ +% ä㭪樨. +parser_e_proc_dir_not_allowed_in_interface=03117_E_„¨p¥ªâ¨¢  ¯à®æ¥¤ãàë "$1" ­¥¤®¯ãá⨬  ¢ ¨­â¥à䥩᭮© ç á⨠¬®¤ã«ï +% „ ­­ ï ¤¨à¥ªâ¨¢  ­¥ ¤®¯ãá⨬  ¢ ᥪ樨 \var{interface} ¬®¤ã«ï. +% …¥ ¬®¦­® ¨á¯®«ì§®¢ âì ⮫쪮 ¢ ᥪ樨 \var{implementation}. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_„¨p¥ªâ¨¢  ¯à®æ¥¤ãàë "$1" ­¥¤®¯ãá⨬  ¢ ॠ«¨§ æ¨®­­®© ç á⨠¬®¤ã«ï +% „ ­­ ï ¤¨à¥ªâ¨¢  ­¥ ¤®¯ãá⨬  ¢ ᥪ樨 \var{implementation} ¬®¤ã«ï. +% …¥ ¬®¦­® ¨á¯®«ì§®¢ âì ⮫쪮 ¢ ᥪ樨 \var{interface}. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_„¨p¥ªâ¨¢  ¯à®æ¥¤ãàë "$1" ­¥¤®¯ãá⨬  ¢ ®¡ê¥­¨¨ ¯à®æ¥¤ãà­®© ¯¥à¥¬¥­­®© +% „ ­­ ï ¤¨à¥ªâ¨¢  ­¥ ¬®¦¥â ¡ëâì ç áâìî ®¡ê¥­¨ï ⨯  ¯à®æ¥¤ãàë ¨«¨ ä㭪樨. +parser_e_function_already_declared_public_forward=03120_E_”ã­ªæ¨ï "$1" 㦥 ®¡ê¥­  ª ª PUBLIC ¨«¨ FORWARD +% Žè¨¡ª  ¢®§­¨ª ¥â ¯à¨ ¤¢ãªà â­®¬ ®¡ê¥­¨¨ ä㭪樨 ª ª \var{forward}. +% ˆ«¨ ¯à¨ ®¡ê¥­¨¨ ¥¥ ¢ ᥪ樨 \var{interface} ¨ ¯®á«¥¤ãî饬 ®¤­®ªà â­®¬ ®¡ê¥­¨¨ ª ª \var{forward} +% ¢ ᥪ樨 \var{implmentation}. +parser_e_not_external_and_export=03121_E_H¥«ì§ï ¨á¯®«ì§®¢ âì EXPORT ᮢ¬¥áâ­® á EXTERNAL +% ⨠¤¢¥ ¤¨à¥ªâ¨¢ë ïîâáï ¢§ ¨¬®¨áª«îç î騬¨ +parser_w_not_supported_for_inline=03123_W_"$1" ­¥ ¯®¤¤¥p¦¨¢ ¥âáï ¢­yâp¨ INLINE ¯p®æ¥¤ypë/äy­ªæ¨¨ +% ‚áâà ¨¢ ¥¬ë¥ ¯à®æ¥¤ãàë ­¥ ¯®¤¤¥à¦¨¢ îâ íâ®â ⨯ ®¡ê¥­¨ï. +parser_w_inlining_disabled=03124_W_‚áâà ¨¢ ­¨¥ (INLINE) ®âª«î祭® +% ‚áâà ¨¢ ­¨¥ ¯à®æ¥¤ãà ®âª«î祭®. +parser_i_writing_browser_log=03125_I_‡ ¯¨á뢠¥¬ «®£ ¡p y§¥p  $1 +% Š®£¤  ¢ª«îç¥­ë ¨­ä®à¬ æ¨®­­ë¥ á®®¡é¥­¨ï, ª®¬¯¨«ïâ®à á®®¡é ¥â +% ® § ¯¨á¨ ¤ ­­ëå ¤«ï ¡à ã§¥à  (¢ª«îç ¥¬®£® ¤¨à¥ªâ¨¢®© \var{\{\$Y+ \}}). +parser_h_maybe_deref_caret_missing=03126_H_‚®§¬®¦­®, ¯à®¯ã饭® p §ë¬¥­®¢ ­¨¥ yª § â¥«ï +% Š®¬¯¨«ïâ®à áç¨â ¥â, ç⮠㪠§ â¥«ì ¬®¦¥â âॡ®¢ âì ࠧ묥­®¢ ­¨ï. +parser_f_assembler_reader_not_supported=03127_F_‚ë¡p ­­ë© ⨯  áᥬ¡«¥p  ­¥ ¯®¤¤¥p¦¨¢ ¥âáï +% ‚ë¡à ­­ë© ⨯  áᥬ¡«¥à  (á ¯®¬®éìî \var{\{\$ASMMODE xxx\}}) ­¥ ¯®¤¤¥à¦¨¢ ¥âáï. +% ®¤¤¥à¦ª  ⮣® ¨«¨ ¨­®£®  áᥬ¡«¥à  ¬®¦¥â ¡ëâì ¯®¤ª«î祭  ¯à¨ ᡮથ ª®¬¯¨«ïâ®à . +parser_e_proc_dir_conflict=03128_E_„¨p¥ªâ¨¢  ¯à®æ¥¤ãàë "$1" ­¥á®¢¬¥á⨬  á ¤py£¨¬¨ ¤¨p¥ªâ¨¢ ¬¨ +% “ª § ­­ ï ¤¨à¥ªâ¨¢  ­¥á®¢¬¥á⨬  á ¤à㣨¬¨ ¤¨à¥ªâ¨¢ ¬¨. +%  ¯à¨¬¥à, \var{cdecl} ¨ \var{pascal} ¨áª«îç îâ ¤à㣠¤à㣠. +parser_e_call_convention_dont_match_forward=03129_E_’¨¯ ¢ë§®¢  ¯p®æ¥¤ypë/äy­ªæ¨¨ ­¥ ᮮ⢥âáâ¢ã¥â yª § ­­®¬y à ­¥¥ +% Žè¨¡ª  ¯à®¨á室¨â ¯à¨ ®¡ê¥­¨¨ ¯à®æ¥¤ãàë ¨«¨ ä㭪樨, ­ ¯à¨¬¥à, +% ª ª \var{cdecl;} ¨ ¯à®¯ã᪮¬ í⮩ ¤¨à¥ªâ¨¢ë ¯à¨ ®¯à¥¤¥«¥­¨¨, ¨«¨ ­ ®¡®à®â. +% ’¨¯ ¢ë§®¢  ï¥âáï ç áâìî ®¡ê¥­¨ï ¯à®æ¥¤ãàë ¨ ¤®«¦¥­ ¯®¢â®àïâìáï +% ¯à¨ ¥¥ ®¯à¥¤¥«¥­¨¨. +parser_e_property_cant_have_a_default_value=03131_E_‘¢®©á⢮ ­¥ ¬®¦¥â ¨¬¥âì §­ ç¥­¨¥ ¯® y¬®«ç ­¨î +% ‘¢®©á⢠ ⨯  ¬­®¦¥á⢮ ¨«¨ ¨­¤¥ªá¨à®¢ ­­ë¥ ᢮©á⢠ ­¥ ¬®£ãâ ¨¬¥âì §­ ç¥­¨¥ ¯® 㬮«ç ­¨î. +parser_e_property_default_value_must_const=03132_E_‡­ ç¥­¨¥ ᢮©á⢠ ¯® y¬®«ç ­¨î ¤®«¦­® ¡ëâì ª®­á⠭⮩ +% ‡­ ç¥­¨¥ ᢮©á⢠, ®¡ê¥­­®¥ ª ª \var{default}, ¤®«¦­® ¡ëâì ¨§¢¥áâ­® ¢® ¢à¥¬ï ª®¬¯¨«ï樨. +% Žè¨¡ª  ¯à®¨á室¨â, ¥á«¨ 㪠§ ­® §­ ç¥­¨¥, ¨§¢¥áâ­®¥ ⮫쪮 ¢® ¢à¥¬ï ¢ë¯®«­¥­¨ï, ­ ¯à¨¬¥à, ¨¬ï ¯¥à¥¬¥­­®©. +parser_e_cant_publish_that=03133_E_‘¨¬¢®« ­¥ ¬®¦¥â ¡ëâì PUBLISHED, §¤¥áì ¤®¯ãá⨬ ⮫쪮 ª« áá +% ’®«ìª® ¯¥à¥¬¥­­ë¥ ⨯  ª« áá  ¬®£ãâ ¡ëâì ¢ \var{published} ᥪ樨 ®¡ê¥­¨ï ª« áá , +% ¥á«¨ ®­¨ ­¥ ®¡ê¥­ë ª ª ᢮©á⢮. +parser_e_cant_publish_that_property=03134_E_‘¢®©á⢮ í⮣® ⨯  ­¥ ¬®¦¥â ¡ëâì PUBLISHED +% ‘¢®©á⢠ ¢ \var{published} ᥪ樨 ­¥ ¬®£ãâ ¡ëâì ⨯  ¬ áᨢ, ®­¨ +% ¤®«¦­ë ¡ëâì ¯¥à¥­¥á¥­ë ¢ ᥪæ¨î public. ‘¢®©á⢠ ¢ ᥪ樨 \var{published} +% ¬®£ãâ ¡ëâì ¯¥à¥ç¨á«ï¥¬®£®, ¢¥é¥á⢥­­®£®, áâப®¢®£® ⨯  «¨¡® ¬­®¦¥á⢠¬¨. +parser_e_empty_import_name=03136_E_’ॡã¥âáï ¨¬ï ¨¬¯®àâ  +% „«ï ­¥ª®â®àëå ¯« âä®à¬ âॡã¥âáï ¨¬ï ¨¬¯®àâ¨à㥬®© ¯à®æ¥¤ãàë ¨«¨ 㪠§ â¥«ï cdecl +parser_e_division_by_zero=03138_E_„¥«¥­¨¥ ­  ­®«ì +% ந§®è«® ¤¥«¥­¨¥ ­  ­®«ì. +parser_e_invalid_float_operation=03139_E_H¥¯p ¢¨«ì­ ï ®¯¥p æ¨ï á ¯« ¢ î饩 § ¯ï⮩ +% Ž¯¥à æ¨ï ­ ¤ ¤¢ã¬ï ¢¥é¥á⢥­­ë¬¨ ç¨á« ¬¨ ¢ë§¢ «  ¯¥à¥¯®«­¥­¨¥ ¨«¨ ¤¥«¥­¨¥ ­  ­®«ì. +parser_e_array_lower_less_than_upper_bound=03140_E_‚¥på­ïï £p ­¨æ  ¤¨ ¯ §®­  ¬¥­ìè¥, 祬 ­¨¦­ïï +% ‚¥àå­ïï £à ­¨æ  ¢ ®¡ê¥­¨¨ ¬ áᨢ  ¬¥­ìè¥ ­¨¦­¥© £à ­¨æë, çâ® ­¥¤®¯ãá⨬®. +parser_w_string_too_long=03141_W_‘âப  "$1" ¤«¨­­¥¥, 祬 "$2" +% „«¨­  áâப®¢®© ª®­áâ ­âë ¯à¥¢ë蠥⠤«¨­ã, 㪠§ ­­ãî ¢ ®¡ê¥­¨¨ ⨯  áâப¨. +parser_e_string_larger_array=03142_E_„«¨­  áâப¨ ¯à¥¢ë蠥⠤«¨­ã ¬ áᨢ  ᨬ¢®«®¢ +% „«¨­  áâப®¢®© ª®­áâ ­âë ¯à¥¢ëè ¥â à §¬¥à, 㪠§ ­­ë© ¢ ®¡ê¥­¨¨ ¬ áᨢ  +% array[x..y] of char. +parser_e_ill_msg_expr=03143_E_H¥¢¥p­®¥ ¢ëp ¦¥­¨¥ ¯®á«¥ ¤¨p¥ªâ¨¢ë message +% \fpc ¯®¤¤¥à¦¨¢ ¥â ⮫쪮 楫®ç¨á«¥­­ë¥ ¨ áâப®¢ë¥ ¢ëà ¦¥­¨ï ª ª ¨¤¥­â¨ä¨ª â®àë á®®¡é¥­¨©. +parser_e_ill_msg_param=03144_E_Ž¡p ¡®â稪¨ á®®¡é¥­¨© ¯à¨­¨¬ îâ ⮫쪮 ®¤¨­ ¯ à ¬¥âà ¯® áá뫪¥ +% Œ¥â®¤, ®¡ê¥­­ë© á ¤¨à¥ªâ¨¢®© \var{message} ª ª ®¡à ¡®â稪 á®®¡é¥­¨©, +% ¬®¦¥â ¯à¨­¨¬ âì ⮫쪮 ®¤¨­ ¯ à ¬¥âà, ª®â®àë© ¤®«¦¥­ ¯¥à¥¤ ¢ âìáï ¯® áá뫪¥. +%  à ¬¥âà ¯¥à¥¤ ¥âáï ¯® áá뫪¥ ¯®á।á⢮¬ ¤¨à¥ªâ¨¢ë \var{var}. +parser_e_duplicate_message_label=03145_E_®¢â®p­ ï ¬¥âª  á®®¡é¥­¨ï: "$1" +% Ž¤­  ¨ â  ¦¥ ¬¥âª  á®®¡é¥­¨ï ¨á¯®«ì§®¢ ­  ¤¢ ¦¤ë ¢ ®¤­®¬ ®¡ê¥ªâ¥/ª« áá¥. +parser_e_self_in_non_message_handler=03146_E_SELF ¬®¦¥â ¡ëâì ⮫쪮 ª ª ï¢­ë© ¯ à ¬¥âà ¢ ®¡à ¡®â稪 å á®®¡é¥­¨ï +%  à ¬¥âà self ¬®¦¥â ¡ëâì ⮫쪮 ® ¯¥à¥¤ ­ ¢ ¬¥â®¤, ®¡ê¥­­ë© ª ª ®¡à ¡®â稪 á®®¡é¥­¨©. +parser_e_threadvars_only_sg=03147_E_¥p¥¬¥­­ë¥ threadvar ¬®£yâ ¡ëâì ⮫쪮 áâ â¨ç¥áª¨¬¨ ¨«¨ £«®¡ «ì­ë¬¨ +% ¥à¥¬¥­­ë¥ threadvar ¤®«¦­ë ¡ëâì áâ â¨ç¥áª¨¬¨ ¨«¨ £«®¡ «ì­ë¬¨, ¨å ­¥«ì§ï ®¡êïâì «®ª «ì­® +% ¢ ¯à®æ¥¤ãà¥. ‹®ª «ì­ë¥ ¯¥à¥¬¥­­ë¥ ¯à®æ¥¤ãàë ¢á¥£¤  ïîâáï «®ª «ì­ë¬¨ ¤«ï ¯®â®ª , +% ¯®â®¬ã çâ® ª ¦¤ë© ¯®â®ª ¨¬¥¥â ᮡá⢥­­ë© á⥪,   «®ª «ì­ë¥ ¯¥à¥¬¥­­ë¥ åà ­ïâáï ­  á⥪¥. +parser_f_direct_assembler_not_allowed=03148_F_’¨¯  áᥬ¡«¥p  direct ­¥ ¯®¤¤¥p¦¨¢ ¥âáï ¯à¨ ¤¢®¨ç­®¬ ä®p¬ â¥ ¢ë室­®£® ä ©«  +% ’¨¯  áᥬ¡«¥à  direct ­¥ ¬®¦¥â ¡ëâì ¨á¯®«ì§®¢ ­ ᮢ¬¥áâ­® á ¤¢®¨ç­ë¬ ä®à¬ â®¬ ¢ë室­ëå ä ©«®¢, +% ¨á¯®«ì§ã©â¥ ¤à㣮© ¢ë室­®© ä®à¬ â ¨«¨ ¤à㣮©  áᥬ¡«¥à. +parser_w_no_objpas_use_mode=03149_W_H¥ § £py¦ ©â¥ ¬®¤ã«ì OBJPAS ¢àãç­ãî, ¨á¯®«ì§y©â¥ {$mode objfpc} ¨«¨ {$mode delphi} +% ®¯ë⪠ § £à㧨âì ¬®¤ã«ì ObjPas ¢àãç­ãî ¢ ᥪ樨 uses. â®â ¬®¤ã«ì ¯à¥¤­ §­ ç¥­ ¤«ï +%  ¢â®¬ â¨ç¥áª®© § £à㧪¨ á ¯®¬®éìî ¤¨à¥ªâ¨¢ \var{\{\$mode objfpc\}} ¨«¨ +% \var{\{\$mode delphi\}}. +parser_e_no_object_override=03150_E_OVERRIDE ­¥ ¬®¦¥â ¡ëâì ¨á¯®«ì§®¢ ­® ¢ ®¡ê¥ªâ å +% „¨à¥ªâ¨¢  override ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ¤«ï ®¡ê¥ªâ®¢, ¤«ï ¯¥à¥ªàëâ¨ï ¬¥â®¤®¢ த¨â¥«ì᪮£® +% ®¡ê¥ªâ  á«¥¤ã¥â ¨á¯®«ì§®¢ âì \var{virtual}. +parser_e_cant_use_inittable_here=03151_E_’¨¯ ¤ ­­ëå, âp¥¡ãî騩 ¨­¨æ¨ «¨§ æ¨¨/䨭 «¨§ æ¨¨, ­¥«ì§ï ¨á¯®«ì§®¢ âì ¢ ¢ à¨ ­â­ëå § ¯¨áïå +% ¥ª®â®àë¥ â¨¯ë ¤ ­­ëå (­ ¯à¨¬¥à, \var{ansistring}) âॡãîâ ª®¤ ¨­¨æ¨ «¨§ æ¨¨/䨭 «¨§ æ¨¨, +% ª®â®àë© ­¥ï¢­® £¥­¥à¨àã¥âáï ª®¬¨¯¨«ïâ®à®¬. ’ ª¨¥ â¨¯ë ¤ ­­ëå ­¥ ¬®£ãâ ¡ëâì ¨á¯®«ì§®¢ ­ë +% ¢ ¢ à¨ ­â­®© ç á⨠§ ¯¨á¥©. +parser_e_resourcestring_only_sg=03152_E_‘âப¨ à¥áãàᮢ ¬®£ãâ ¡ëâì ⮫쪮 áâ â¨ç¥áª¨¬¨ ¨«¨ £«®¡ «ì­ë¬¨ +% ‘âப¨ à¥áãàᮢ ­¥ ¬®£ãâ ¡ëâì ®¡ê¥­ë ­  «®ª «ì­®¬ ã஢­¥, ⮫쪮 ­  ã஢­¥ ¬®¤ã«ï. +parser_e_exit_with_argument_not__possible=03153_E_à®æ¥¤ãà  Exit á  à£ã¬¥­â®¬ §¤¥áì ­¥¤®¯ãá⨬  +% ‚맮¢ exit á  à£ã¬¥­â®¬ ¤«ï ¢®§¢à é ¥¬®£® §­ ç¥­¨ï ­¥ ¬®¦¥â ¡ëâì ¨á¯®«ì§®¢ ­ ¢ í⮬ ¬¥áâ¥, +% ¢ ç áâ­®áâ¨, ¢ ¡«®ª å \var{try..except} ¨«¨ \var{try..finally}. +parser_e_stored_property_must_be_boolean=03154_E_’¨¯ ᨬ¢®«  stored ¤®«¦¥­ ¡ëâì boolean +% …᫨ ¢ ®¡ê¥­¨¨ ᢮©á⢠ ¨á¯®«ì§ã¥âáï ᨬ¢®« stored, ®­ ¤®«¦¥­ ¨¬¥âì ⨯ boolean. +parser_e_ill_property_storage_sym=03155_E_â®â ᨬ¢®« ­¥¤®¯ãá⨬ ¢ ª ç¥á⢥ stored +% „ ­­ë© ⨯ ᨬ¢®«  ­¥ ¬®¦¥â ¡ëâì ¨á¯®«ì§®¢ ­ ¤«ï 㪠§ ­¨ï ¯à¨§­ ª  á®åà ­¥­¨ï ᢮©áâ¢. +% „®¯ãá⨬® ¨á¯®«ì§®¢ âì ¬¥â®¤ë, ¢®§¢à é î騥 boolean, ¯®«ï ⨯  boolean, +% «¨¡® ª®­áâ ­âë í⮣® ⨯ . +parser_e_only_publishable_classes_can_be_published=03156_E_’®«ìª® ª« ááë, ᪮¬¯¨«¨p®¢ ­­ë¥ ¢ ०¨¬¥ $M+, ¬®£ãâ ¡ëâì published +% ‚ ᥪ樨 published ®¡ê¥­¨ï ª« áá  ¬®£ã⠨ᯮ«ì§®¢ âìáï ¯®«ï ⮫쪮 ⨯  ª« áá , +% ª®â®àë© ª®¬¯¨«¨àã¥âáï ¢ ०¨¬¥ $M+ ¨«¨ ã­ á«¥¤®¢ ­­ë© ®â â ª®£® ª« áá . Ž¡ëç­® +% ¨á¯®«ì§ãîâáï ­ á«¥¤­¨ª¨ TPersitent. +parser_e_proc_directive_expected=03157_E_Ž¦¨¤ ¥âáï ¯p®æ¥¤yp­ ï ¤¨p¥ªâ¨¢  +% Žè¨¡ª  ¯à®¨á室¨â, ¥á«¨ ¢ ¤¨à¥ªâ¨¢¥ \var{\{\$Calling\}} ­¥ 㪠§ ­ ⨯ ¢ë§®¢ . +% ’ ª¦¥ ¯à®¨á室¨â, ¥á«¨ ¯à¨ ®¡ê¥­¨¨ ¯à®æ¥¤ãà ¢ ¡«®ª¥ ª®­á⠭⠨ᯮ«ì§ã¥âáï ; ¯®á«¥ +% ®¡ê¥­¨ï ¯à®æ¥¤ãàë, ¯®á«¥ 祣® ¤®«¦­  á«¥¤®¢ âì ¯à®æ¥¤ãà­ ï ¤¨à¥ªâ¨¢ . +% ਬ¥àë ¯à ¢¨«ì­ëå ®¡ê¥­¨©: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_‡­ ç¥­¨¥ ¨­¤¥ªá  ᢮©á⢠ ¤®«¦­® ¡ëâì ¯®à浪®¢®£® ⨯  +% ‡­ ç¥­¨¥, ¨á¯®«ì㧥¬®¥ ª ª ¨­¤¥ªá ᢮©á⢠, ¤®«¦­® ¡ëâì ¯®à浪®¢®£® ⨯ , ­ ¯à¨¬¥à, +% æ¥«ë¬ ç¨á«®¬ ¨«¨ ¯¥à¥ç¨á«¥­¨¥¬. +parser_e_procname_to_short_for_export=03159_E_ˆ¬ï ¯p®æ¥¤ypë ᫨誮¬ ª®p®âª®¥ ¤«ï íªá¯®pâ  +% „«¨­  íªá¯®àâ­®£® ¨¬¥­¨ ¯à®æ¥¤ãàë/ä㭪樨 ¤®«¦­  á®áâ ¢«ïâì ¯® ªà ©­¥© ¬¥à¥ 2 ᨬ¢®« . +% â® ®¡ãá«®¢«¥­® ®è¨¡ª®© ¢ ã⨫¨â¥ dlltool, ª®â®à ï ­¥ ¬®¦¥â ª®à४⭮ ¯à®ç¨â âì .def ä ©« +% á ¤«¨­®© ¨¬¥­, à ¢­®© 1. +parser_e_dlltool_unit_var_problem=03160_E_¥¢®§¬®¦­® ᮧ¤ âì § ¯¨áì DEFFILE ¤«ï £«®¡ «ì­ëå ¯¥à¥¬¥­­ëå ¬®¤ã«ï +parser_e_dlltool_unit_var_problem2=03161_E_Š®¬¯¨«¨àã©â¥ ¡¥§ ª«îç  -WD +% â®â ä ©« ­¥®¡å®¤¨¬® ª®¬¯¨«¨à®¢ âì ¡¥§ 㪠§ ­¨ï ª«îç  -WD ¢ ª®¬ ­¤­®© áâப¥. +parser_f_need_objfpc_or_delphi_mode=03162_F_„«ï í⮣® ¬®¤ã«ï ­¥®¡å®¤¨¬ ०¨¬ ObjFpc (-S2) ¨«¨ Delphi (-Sd) +% „«ï ª®¬¯¨«ï樨 ¤ ­­®£® ¬®¤ã«ï âॡã¥âáï {$mode objfpc} or {$mode delphi}, +% «¨¡® ¨á¯®«ì§®¢ ­¨¥  ­ «®£¨ç­ëå ª«î祩 ª®¬ ­¤­®© áâப¨ -S2 ¨«¨ -Sd. +parser_e_no_export_with_index_for_target=03163_E_ªá¯®pâ ¯® ¨­¤¥ªáã ­¥¢®§¬®¦¥­ ¯®¤ $1 +% ªá¯®àâ ¯à®æ¥¤ãà/ä㭪権 á 㪠§ ­¨¥¬ ¨­¤¥ªá  ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ¤«ï ¯« âä®à¬ë ­ §­ ç¥­¨ï. +parser_e_no_export_of_variables_for_target=03164_E_ªá¯®pâ ¯¥p¥¬¥­­ëå ­¥ ¯®¤¤¥p¦¨¢ ¥âáï ¯®¤ $1 +% ªá¯®àâ ¯¥à¥¬¥­­ëå ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ¤«ï ¯« âä®à¬ë ­ §­ ç¥­¨ï. +parser_e_improper_guid_syntax=03165_E_¥¢¥à­ë© ᨭ⠪á¨á GUID +% Žè¨¡ª  ¢ ᨭ⠪á¨á¥ GUID. Š®à४â­ë© GUID ¤®«¦¥­ ¡ëâì ¢ ä®à¬¥ +% \begin{verbatim} +% {XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX} +% \end{verbatim} +% ƒ¤¥ ª ¦¤ë© \var{X} ¯à¥¤áâ ¢«ï¥â ᮡ®© è¥áâ­ ¤æ â¥à¨ç­ãî æ¨äàã. +parser_w_interface_mapping_notfound=03168_W_¥ ­ ©¤¥­  ¯à®æ¥¤ãà  á ¨¬¥­¥¬ "$1", ¯®¤å®¤ïé ï ¤«ï ॠ«¨§ æ¨¨ $2.$3 +% Š®¬¯¨«ïâ®à ­¥ ¬®¦¥â ­ ©â¨ ¯à®æ¥¤ãàã, ¯®¤å®¤ïéãî ¤«ï ॠ«¨§ æ¨¨ 㪠§ ­­®£® ¬¥â®¤  ¨­â¥à䥩á . +% à®æ¥¤ãà  á ᮢ¯ ¤ î騬 ¨¬¥­¥¬ ­ ©¤¥­ , ­® ­¥ ᮢ¯ ¤ ¥â ᯨ᮪ ¯ à ¬¥â஢. +parser_e_interface_id_expected=03169_E_Ž¦¨¤ ¥âáï ¨¤¥­â¨ä¨ª â®à ¨­â¥àä¥©á  +% நá室¨â ¯à¨  ­ «¨§¥ ®¡ê¥­¨ï \var{class}, ª®â®à®¥ ᮤ¥à¦¨â +% ®¯¨á ­¨¥ ᮮ⢥âáâ¢¨ï ¬¥â®¤®¢ \var{interface} ¯® ¨¬¥­¨, ­ ¯à¨¬¥à: +% \begin{verbatim} +% type +% TMyObject = class(TObject, IDispatch) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% ¨ ¨¬ï \var{interface} ¯¥à¥¤ â®çª®© ­¥ ¯¥à¥ç¨á«¥­® ¢ ᯨ᪥ ­ á«¥¤®¢ ­¨ï. +parser_e_type_cant_be_used_in_array_index=03170_E_’¨¯ "$1" ­¥ ¬®¦¥â ¨á¯®«ì§®¢ âìáï ª ª ¨­¤¥ªá ¬ áᨢ  +% ’ ª¨¥ ⨯ë, ª ª \var{qword} ¨«¨ \var{int64}, ­¥¤®¯ãáâ¨¬ë ¢ ª ç¥á⢥ ¨­¤¥ªá®¢ ¬ áᨢ  +parser_e_no_con_des_in_interfaces=03171_E_Constructor ¨ destructor ­¥¤®¯ãáâ¨¬ë ¢ interface +% ˆá¯®«ì§®¢ ­¨¥ ª®­áâàãªâ®à®¢ ¨ ¤¥áâàãªâ®à®¢ ¢ ¨­â¥à䥩á å ­¥ à §à¥è ¥âáï. +% ‚ ¡®«ì設á⢥ á«ãç ¥¢ ¤«ï ᮧ¤ ­¨ï íª§¥¬¯«ï஢ ¨­â¥àä¥©á  ¬®¦¥â ¡ëâì ¨á¯®«ì§®¢ ­ ¬¥â®¤ +% \var{QueryInterface} ¨­â¥àä¥©á  \var{IUnknown}. +parser_e_no_access_specifier_in_interfaces=03172_E_“ª § ­¨¥ ⨯  ¤®áâ㯠 ­¥¤®¯ãá⨬® ¢ interface +% ’¨¯ ¤®áâ㯠 \var{public}, \var{private}, \var{protected} ¨ +% \var{pusblished} ­¥ ¬®¦¥â ¡ëâì 㪠§ ­ ¤«ï ¬¥â®¤®¢ ¨­â¥à䥩á . +% ‚ᥠ¬¥â®¤ë ¨­âä¥àä¥©á  ï¢«ïîâáï ®¡é¥¤®áâ㯭묨 (public). +parser_e_no_vars_in_interfaces=03173_E_Interface ­¥ ¬®¦¥â ᮤ¥à¦ âì ¯®«ï +% Ž¡ê¥­¨¥ ¯®«¥© ¢ ¨­â¥à䥩ᥠ­¥ ¤®¯ã᪠¥âáï. ˆ­â¥àä¥©á ¬®¦¥â +% ᮤ¥à¦ âì ⮫쪮 ¬¥â®¤ë. +parser_e_no_local_proc_external=03174_E_‹®ª «ì­ ï ¯à®æ¥¤ãà  ­¥ ¬®¦¥â ¡ëâì EXTERNAL +% Ž¡ê¥­¨¥ «®ª «ì­ëå ¯à®æ¥¤ãà ª ª external ­¥¢®§¬®¦­®. ‹®ª «ì­ë¥ ¯à®æ¥¤ãàë +% ¯®«ãç îâ áªàëâë¥ ¯ à ¬¥âàë, çâ® ¤¥« ¥â ¢¥à®ïâ­®áâì ®è¨¡®ª ®ç¥­ì ¢ë᮪®©. +parser_w_skipped_fields_before=03175_W_¥ª®â®àë¥ ¯®«ï ¯¥à¥¤ "$1" ­¥ ¡ë«¨ ¨­¨æ¨ «¨§¨à®¢ ­ë +% ‚ ०¨¬¥ Delphi, ¨­¨æ¨ «¨§ æ¨ï ­¥ª®â®àëå ¯®«¥© ª®­áâ ­â ⨯  § ¯¨áì ¬®¦¥â ¡ëâì ¯à®¯ã饭 , +% ­® ª®¬¯¨«ïâ®à ¯à¥¤ã¯à¥¦¤ ¥â ® ­ «¨ç¨¨ â ª®© á¨âã æ¨¨. +parser_e_skipped_fields_before=03176_E_¥ª®â®àë¥ ¯®«ï ¯¥à¥¤ "$1" ­¥ ¡ë«¨ ¨­¨æ¨ «¨§¨à®¢ ­ë +% ‚ ०¨¬ å, ®â«¨ç­ëå ®â Delphi, ­¥ ¤®¯ã᪠¥âáï ®áâ ¢«ïâì ­¥¨­¨æ¨ «¨§¨à®¢ ­­ë¥ ¯®«ï +% ¢ á¥à¥¤¨­¥ ª®­áâ ­âë ⨯  § ¯¨áì. +parser_w_skipped_fields_after=03177_W_¥ª®â®àë¥ ¯®«ï ¯®á«¥ "$1" ­¥ ¡ë«¨ ¨­¨æ¨ «¨§¨à®¢ ­ë +% ®«ï ¢ ª®­æ¥ ª®­áâ ­âë ⨯  § ¯¨áì ¬®£ãâ ¡ëâì ®áâ ¢«¥­ë ¡¥§ ¨­¨æ¨ «¨§ æ¨¨ +% (ª®¬¯¨«ïâ®à  ¢â®¬ â¨ç¥áª¨ ¨­¨æ¨ «¨§¨àã¥â ¨å ­ã«¥¢ë¬¨ §­ ç¥­¨ï¬¨). â® +% ¬®¦¥â ïâìáï ¯à¨ç¨­®© ­¥ª®â®àëå ¯à®¡«¥¬. +parser_e_varargs_need_cdecl_and_external=03178_E_„¨à¥ªâ¨¢  VarArgs (¨«¨ '...' ¢ MacPas) ¡¥§ CDecl/CPPDecl/MWPascal ¨ External +% „¨à¥ªâ¨¢  varargs (¨«¨ ¯ à ¬¥âà ``...'' ¢ ०¨¬¥ MacPas) ¬®¦¥â ¡ëâì ¨á¯®«ì§®¢ ­  ⮫쪮 á +% ¯à®æ¥¤ãà ¬¨/äã­ªæ¨ï¬¨, ®¡ê¥­­ë¬¨ á ¤¨à¥ªâ¨¢ ¬¨ \var{external} ¨ ®¤­®© ¨§ \var{cdecl}, +% \var{cppdecl} ¨«¨ \var{mwpascal}. â  ä㭪樮­ «ì­®áâì ¯®¤¤¥à¦¨¢ ¥âáï ⮫쪮 ¤«ï +% ᮢ¬¥á⨬®á⨠á äã­ªæ¨ï¬¨ ï§ëª  C ⨯  printf. +parser_e_self_call_by_value=03179_E_Self ¤®«¦¥­ ¡ëâì ¯ à ¬¥â஬ á ¯¥à¥¤ ç¥© ¯® §­ ç¥­¨î +%  à ¬¥âà Self ­¥ ¬®¦¥â ¡ëâì ¯¥à¥¤ ­ ¯® áá뫪¥ (á var ¨«¨ const), ¥£® ­ã¦­® ¯¥à¥¤ ¢ âì ¯® +% §­ ç¥­¨î +parser_e_interface_has_no_guid=03180_E_ˆ­â¥à䥩á "$1" ­¥ ¨¬¥¥â ¨¤¥­â¨ä¨ª â®à  +% ਠ¯à¨á¢®¥­¨¨ ¨­â¥àä¥©á  ª®­áâ ­â¥, ¨­â¥àä¥©á ¤®«¦¥­ ¨¬¥âì §­ ç¥­¨¥ GUID. +parser_e_illegal_field_or_method=03181_E_¥¨§¢¥áâ­ë© ¨¤¥­â¨ä¨ª â®à ¯®«ï ¨«¨ ¬¥â®¤  "$1" +% ‘¢®©á⢠ ¤®«¦­ë ááë« âìáï ­  ¯®«ï ¨ ¬¥â®¤ë ⮣® ¦¥ ª« áá , ¢ ª®â®à®¬ ®¡ê¥­ë. +parser_w_proc_overriding_calling=03182_W_’¨¯ ¢ë§®¢  "$2" ¯¥à¥ªà뢠¥â "$1" +% ‚ ®¡ê¥­¨¨ ¯à®æ¥¤ãàë ¯à¨áãâáâ¢ãîâ ¤¢¥ ¤¨à¥ªâ¨¢ë, ®¯à¥¤¥«ïî騥 ⨯ ¢ë§®¢ . +% 㤥⠨ᯮ«ì§®¢ ­  ¯®á«¥¤­ïï ¤¨à¥ªâ¨¢ . +parser_e_no_procvarobj_const=03183_E_Š®­áâ ­â  â¨¯  "procedure of object" ¬®¦¥â ¡ëâì ¨­¨æ¨ «¨§¨à®¢ ­  ⮫쪮 §­ ç¥­¨¥¬ NIL +% €¤à¥á ¬¥â®¤  ­¥ ¬®¦¥â ¡ëâì ¨á¯®«ì§®¢ ­ ¤«ï ¨­¨æ¨ «¨§ æ¨¨ ⨯¨§¨à®¢ ­­®© ª®­áâ ­âë ⨯  +% 'procedure of object', ¯®â®¬ã çâ® â ª ï ª®­áâ ­â  á®á⮨⠨§ ¤¢ãå  ¤à¥á®¢: +%  ¤à¥á ¬¥â®¤  (¨§¢¥áâ­ë© ¢® ¢à¥¬ï ª®¬¯¨«ï樨) ¨  ¤à¥á íª§¥¬¯«ïà  ®¡ê¥ªâ  ¨«¨ +% ª« áá  (­¥ ¬®¦¥â ¡ëâì ®¯à¥¤¥«¥­ ¯à¨ ª®¬¯¨«ï樨). +parser_e_default_value_only_one_para=03184_E_‡­ ç¥­¨¥ ¯® 㬮«ç ­¨î ¬®¦¥â ¡ëâì ¯à¨á¢®¥­® ⮫쪮 ®¤­®¬ã ¯ à ¬¥âàã +% ¥¢®§¬®¦­® ¯à¨á¢®¨âì §­ ç¥­¨¥ ¯® 㬮«ç ­¨î áࠧ㠭¥áª®«ìª¨¬ ¯ à ¬¥âà ¬. +% ‘«¥¤ãî騩 ª®¤ ­¥¢¥à¥­: +% \begin{verbatim} +% Procedure MyProcedure (A,B : Integer = 0); +% \end{verbatim} +% ‚¬¥áâ® íâ® á«¥¤ã¥â ®¡êâì ¯à®æ¥¤ãàã ª ª: +% \begin{verbatim} +% Procedure MyProcedure (A : Integer = 0; B : Integer = 0); +% \end{verbatim} +parser_e_default_value_expected_for_para=03185_E_„«ï "$1" âॡã¥âáï §­ ç¥­¨¥ ¯® 㬮«ç ­¨î +% “ª § ­­ë© ¯ à ¬¥âà âॡã¥â §­ ç¥­¨¥ ¯® 㬮«ç ­¨î. +parser_w_unsupported_feature=03186_W_ˆá¯®«ì§®¢ ­¨¥ ¯®ª  ­¥¯®¤¤¥à¦¨¢ ¥¬®© ®á®¡¥­­®á⨠ª®¬¯¨«ïâ®à ! +% ®¯ë⪠ § áâ ¢¨âì ª®¬¯¨«ïâ®à ᤥ« âì ­¥çâ®, 祣® ®­ ¯®ª  ¥é¥ ­¥ 㬥¥â. +parser_h_c_arrays_are_references=03187_H_Œ áᨢë C ¯¥à¥¤ îâáï ¯® áá뫪¥ +% ¥à¥¤ ç  ¬ áᨢ®¢ ¢ ä㭪樨 ­  ï§ëª¥ C ¢á¥£¤  +% ®áãé¥á⢫ï¥âáï ¯®á।á⢮¬ 㪠§ â¥«ï (â.¥. ¯® áá뫪¥). +parser_e_C_array_of_const_must_be_last=03188_E_Œ áᨢ ª®­áâ ­â ¢ C ¤®«¦¥­ ¡ëâì ¯®á«¥¤­¨¬ ¯ à ¬¥â஬ +% ¥«ì§ï ¤®¡ ¢«ïâì ¤à㣨¥ ¯ à ¬¥âàë ¯®á«¥ ¯ à ¬¥âà  â¨¯  \var{array of const}, +% ¯¥à¥¤ ¢ ¥¬®£® ¢ äã­ªæ¨î, ®¡ê¥­­ãî ª ª \var{cdecl}, ¯®â®¬ã çâ® ¤«ï ­¥£® +% § à ­¥¥ ­¥ ¨§¢¥á⥭ à §¬¥à ¤ ­­ëå, ¯®¬¥é ¥¬ëå ­  á⥪. +parser_h_type_redef=03189_H_®¢â®à­®¥ ®¡ê¥­¨¥ ⨯  "$1" +% ‘®®¡é ¥â ® ⮬, çâ® ¤«ï à ­¥¥ ®¯à¥¤¥«¥­­®£® ⨯  ¢áâà¥â¨«®áì +% ¯®¢â®à­®¥ ®â«¨ç î饥áï ®¡ê¥­¨¥. â® ¬®¦¥â ¡ëâì (  ¬®¦¥â ¨ ­¥ ¡ëâì) +% ¯à¨ç¨­®© ®è¨¡®ª. +parser_w_cdecl_has_no_high=03190_W_”㭪樨 cdecl ­¥ ¨¬¥îâ ¯ à ¬¥âà  high +% ‚ ä㭪樨, ®¡ê¥­­ë¥ ª ª cdecl, ­¥ ¯¥à¥¤ ¥âáï áªàëâë© ¯ à ¬¥âà high. +parser_w_cdecl_no_openstring=03191_W_”㭪樨 cdecl ­¥ ¯®¤¤¥à¦¨¢ îâ ®âªàëâë¥ áâப¨ +% ‘âப¨ ⨯  openstring ­¥ ¯®¤¤¥à¦¨¢ îâáï ¢ cdecl äã­ªæ¨ïå. +parser_e_initialized_not_for_threadvar=03192_E_ˆ­¨æ¨ «¨§ æ¨ï ¯¥à¥¬¥­­®© ⨯  threadvar ­¥¢®§¬®¦­  +% ¥à¥¬¥­­ë¥, ®¡ê¥­­ë¥ ª ª threadvar, ­¥ ¬®£ãâ ¨¬¥âì ­ ç «ì­®£® §­ ç¥­¨ï. +% Ž­¨ ¢á¥£¤  ¯®«ãç îâ ­ã«¥¢®¥ §­ ç¥­¨¥ ¯à¨ áâ à⥠­®¢®£® ¯®â®ª . +parser_e_msg_only_for_classes=03193_E_„¨à¥ªâ¨¢  message à §à¥è¥­  ⮫쪮 ¤«ï ª« áᮢ +% „¨à¥ªâ¨¢  message ¯®¤¤¥à¦¨¢ ¥âáï ⮫쪮 ¤«ï ⨯®¢ Class. +parser_e_procedure_or_function_expected=03194_E_Ž¦¨¤ ¥âáï "procedure" ¨«¨ "function" +% Š« áá-¬¥â®¤ ¬¨ ¬®£ãâ ¡ëâì ⮫쪮 ¯à®æ¥¤ãàë ¨ ä㭪樨. +parser_e_illegal_calling_convention=03195_W_’¨¯ ¢ë§®¢  ¨£­®à¨à®¢ ­: "$1" +% ¥ª®â®àë¥ â¨¯ë ¢ë§®¢®¢ ¯®¤¤¥à¦¨¢ îâáï ⮫쪮 ­  ®¯à¥¤¥«¥­­ëå ¯à®æ¥áá®à å. ’ ª, ¤«ï ¡®«ì設á⢠ +% ­¥-i386 ¯®¤¤¥à¦¨¢ îâáï ⮫쪮 â¨¯ë ¢ë§®¢  áâ ­¤ àâ­®£® ABI. +parser_e_no_object_reintroduce=03196_E_REINTRODUCE ­¥«ì§ï ¨á¯®«ì§®¢ âì ¤«ï ®¡ê¥ªâ®¢ +% „¨à¥ªâ¨¢  \var{reintroduce} ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ¤«ï ®¡ê¥ªâ®¢. +parser_e_paraloc_only_one_para=03197_E_ á¯®«®¦¥­¨¥  à£ã¬¥­â®¢ ­¥ ¬®¦¥â ᮢ¯ ¤ âì +% …᫨ à á¯®«®¦¥­¨¥  à£ã¬¥­â®¢ 㪠§ë¢ îâáï ®, ª ª ⮣® âॡãîâ ­¥ª®â®àë¥ +% â¨¯ë ¢ë§®¢®¢ syscall, à á¯®«®¦¥­¨¥ ª ¦¤®£® ¨§  à£ã¬¥­â®¢ ¤®«¦­® ¡ëâì ã­¨ª «ì­ë¬, +% ª®­áâàãªæ¨¨ ¢¨¤  \var{procedure p(i,j : longint 'r1');} ­¥ ¤®¯ã᪠îâáï. +parser_e_paraloc_all_paras=03198_E_㦭® 㪠§ âì à á¯®«®¦¥­¨¥ ¤«ï ¢á¥å  à£ã¬¥­â®¢ +% …᫨ à á¯®«®¦¥­¨¥ 㪠§ ­® ¤«ï ®¤­®£®  à£ã¬¥­â®¢, ¥£® ­ã¦­® 㪠§ âì ¨ ¤«ï ¢á¥å +% ®áâ «ì­ëå. +parser_e_illegal_explicit_paraloc=03199_E_¥¨§¢¥áâ­®¥ à á¯®«®¦¥­¨¥  à£ã¬¥­â  +% “ª § ­­®¥ à á¯®«®¦¥­¨¥ ­¥ ï¥âáï ¤®¯ãáâ¨¬ë¬ á â®çª¨ §à¥­¨ï ª®¬¯¨«ïâ®à . +parser_e_32bitint_or_pointer_variable_expected=03200_E_Ž¦¨¤ ¥âáï 32-¡¨â­®¥ 楫®¥ «¨¡® 㪠§ â¥«ì +% libbase ¤«ï MorphOS/AmigaOS ¬®¦­® § ¤ ¢ âì ⮫쪮 ª ª \var{longint}, \var{dword}, «¨¡® 㪠§ â¥«ì +% «î¡®£® ⨯ . +parser_e_goto_outside_proc=03201_E_¥ ¤®¯ã᪠¥âáï goto ¬¥¦¤ã à §«¨ç­ë¬¨ ¯à®æ¥¤ãà ¬¨ +% ¥ ¤®¯ã᪠¥âáï ¨á¯®«ì§®¢ ­¨¥ \var{goto} ¤«ï ¯¥à¥å®¤  ­  ¬¥âªã, ®¯à¥¤¥«¥­­ãî ¢­¥ +% ⥪ã饩 ¯à®æ¥¤ãàë. ‘«¥¤ãî騩 ¯à¨¬¥à ¤¥¬®­áâà¨àã¥â ¯à®¡«¥¬ã: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1; +% +% procedure p2; +% begin +% goto l1; // â  ¨­áâàãªæ¨ï goto ­¥ à §à¥è ¥âáï +% end; +% +% begin +% p2 +% l1: +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_‘«¨èª®¬ á«®¦­ ï ¯à®æ¥¤ãà , ­¥ 墠⠥â ॣ¨áâ஢ +% ’¥«® ¯à®æ¥¤ãàë ï¥âáï ᫨誮¬ á«®¦­ë¬ ¤«ï ª®¬¯¨«ï樨. ‘«¥¤ã¥â à §¡¨âì ¥¥ +% ­  ­¥áª®«ìª® ¡®«¥¥ ¯à®áâëå ¯à®æ¥¤ãà. +parser_e_illegal_expression=03203_E_¥¤®¯ãá⨬®¥ ¢ëà ¦¥­¨¥ +% Œ®¦¥â ¢®§­¨ª âì ¯® à §­ë¬ ¯à¨ç¨­ ¬.  ¨¡®«¥¥ ç áâ® - ¯à¨ ¢ëç¨á«¥­¨¨ +% ª®­áâ ­â­ëå ¢ëà ¦¥­¨©. +parser_e_invalid_integer=03204_E_¥¢¥à­®¥ 楫®ç¨á«¥­­®¥ ¢ëà ¦¥­¨¥ +% ‚ëà ¦¥­¨¥ ­¥ ï¥âáï æ¥«ë¬ ç¨á«®¬, ¢ â® ¢à¥¬ï ª ª ª®¬¯¨«ïâ®à ®¦¨¤ ¥â +% ¨¬¥­­® 楫®ç¨á«¥­­ë© १ã«ìâ â. +parser_e_invalid_qualifier=03205_E_¥¢¥à­ë© ª¢ «¨ä¨ª â®à +% நá室¨â ¯® ®¤­®© ¨§ á«¥¤ãîé¨å ¯à¨ç¨­: +% \begin{itemize} +% \item ®¯ë⪠ ¤®áâ㯠 ª ¯®«î ¯¥à¥¬¥­­®©, ª®â®à ï ­¥ ï¥âáï § ¯¨áìî. +% \item “ª § ­¨¥ ¨­¤¥ªá  ¤«ï ¯¥à¥¬¥­­®©, ­¥ ïî饩áï ¬ áᨢ®¬. +% \item  §ë¬¥­®¢ ­¨¥ ¯¥à¥¬¥­­®©, ­¥ ïî饩áï 㪠§ â¥«¥¬. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_‚¥àå­¨© ¯à¥¤¥« ¤¨ ¯ §®­  < ­¨¦­¥£® +% ਠ®¡ê¥­¨¨ ¯®¤¤¨ ¯ §®­ , ­¨¦­¨© ¯à¥¤¥« ®ª § «áï ¡®«ìè¥ +% ¢¥àå­¥£®. +parser_e_macpas_exit_wrong_param=03207_E_ à ¬¥âà Exit ¤®«¦¥­ ¡ëâì ¨¬¥­¥¬ ⥪ã饩 ¯à®æ¥¤ãàë +% ¥-«®ª «ì­ë© exit ­¥ ¤®¯ã᪠¥âáï. â  ®è¨¡ª  ¢®§­¨ª ¥â ⮫쪮 ¢ ०¨¬¥ MacPas. +parser_e_illegal_assignment_to_count_var=03208_E_¥¢¥à­®¥ ¯à¨á¢®¥­¨¥ ¯¥à¥¬¥­­®© for-横«  "$1" +% ’¨¯ ¯¥à¥¬¥­­®© ¤«ï 横«  \var{for} ¤®«¦¥­ ¡ëâì ¯®à浪®¢ë¬. +% ‚¥é¥á⢥­­ë¥ ¨ áâப®¢ë¥ â¨¯ë ­¥ ¤®¯ã᪠îâáï. Šà®¬¥ ⮣®, ­¥ ¤®¯ã᪠¥âáï ¯à¨á¢®¥­¨¥ +% ã¯à ¢«ïî饩 ¯¥à¥¬¥­­®© ¢­ãâਠ横«  (ªà®¬¥ ०¨¬®¢ Delphi ¨ TP). …᫨ âॡã¥âáï +% ¯à¨á¢®¥­¨¥, ¢¬¥á⮠横«  for á«¥¤ã¥â ¨á¯®«ì§®¢ âì ¯à¥¤­ §­ ç¥­­ë¥ ¤«ï í⮣® +% 横«ë while ¨«¨ repeat. +parser_e_no_local_var_external=03209_E_‹®ª «ì­ ï ¯¥à¥¬¥­­ ï ­¥ ¬®¦¥â ¡ëâì EXTERNAL +% Ž¡ê¥­¨¥ «®ª «ì­ëå ¯¥à¥¬¥­­ëå ª ª ¢­¥è­¨å ­¥ ¤®¯ã᪠¥âáï. ‚­¥è­¨¬¨ ¬®£ãâ ¡ëâì +% ⮫쪮 £«®¡ «ì­ë¥ ¯¥à¥¬¥­­ë¥. +parser_e_proc_already_external=03210_E_à®æ¥¤ãà  ã¦¥ ®¡ê¥­  ª ª EXTERNAL +% à®æ¥¤ãà  ã¦¥ ®¡ê¥­  á ¤¨à¥ªâ¨¢®© EXTERNAL ¢ ¨­â¥à䥩ᥠ¬®¤ã«ï ¨«¨ +% ¢ à ­­¥¬ ®¡ê¥­¨¨. +parser_w_implicit_uses_of_variants_unit=03211_W_¥ï¢­®¥ ¨á¯®«ì§®¢ ­¨¥ ¬®¤ã«ï Variants +% ‚ ¬®¤ã«¥ ¨á¯®«ì§ã¥âáï ⨯ Variant, ­® ¬®¤ã«ì Variants ­¥ ¯®¤ª«î祭 ­¨ ª ®¤­®¬ã ¨§ ¨á¯®«ì§ã¥¬ëå +% ¬®¤ã«¥©. Š®¬¯¨«ïâ®à ­¥ï¢­® ¤®¡ ¢«ï¥â Variants ¢ ᯨ᮪ ¨á¯®«ì§ã¥¬ëå ¬®¤ã«¥©. +% —â®¡ë ¨§¡ ¢¨âìáï ®â ¯à¥¤ã¯à¥¦¤¥­¨ï, ¤®¡ ¢ì⥠Variants ¢ ᯨ᮪ uses. +parser_e_no_static_method_in_interfaces=03212_E_Œ¥â®¤ë class and static ­¥ ¤®¯ã᪠îâáï ¢ INTERFACE +% ‘¯¥æ¨ä¨ª â®à \var{class} ¨ ¤¨à¥ªâ¨¢  \var{static} ­¥ ¯à¨¬¥­¨¬ë ¢ ¨­â¥à䥩á å, +% â.ª. ¢á¥ ¬¥â®¤ë ¨­â¥àä¥©á  ¤®«¦­ë ¡ëâì ¯ã¡«¨ç­ë¬¨. +parser_e_arithmetic_operation_overflow=03213_E_¥à¥¯®«­¥­¨¥ ¢  à¨ä¬¥â¨ç¥áª®© ®¯¥à æ¨¨ +% Ž¯¥à æ¨ï ­ ¤ 楫묨 ç¨á« ¬¨ ¯à¨¢¥«  ª ¯¥à¥¯®«­¥­¨î +parser_e_protected_or_private_expected=03214_E_Ž¦¨¤ ¥âáï "protected" ¨«¨ "private" +% \var{strict} ¬®¦¥â ¨á¯®«ì§®¢ âìáï ⮫쪮 ¢ á®ç¥â ­¨¨ á \var{protected} ¨«¨ \var{private}. +parser_e_illegal_slice=03215_E_SLICE ­¥«ì§ï ¨á¯®«ì§®¢ âì ¢­¥ ᯨ᪠ ¯ à ¬¥â஢ +% \var{slice} ¬®¦­® ¨á¯®«ì§®¢ âì ⮫쪮 ¤«ï  à£ã¬¥­â®¢, ¯à¨­¨¬ îé¨å ⨯ ®âªàë⮣® ¬ áᨢ  +parser_e_dispinterface_cant_have_parent=03216_E_DISPINTERFACE ­¥ ¬®¦¥â ¨¬¥âì த¨â¥«ï +% DISPINTERFACE ï¥âáï ®á®¡ë¬ â¨¯®¬ ¨­â¥àä¥©á  ¨ ­¥ ¬®¦¥â ¨¬¥âì த¨â¥«ì᪨© ª« áá +parser_e_dispinterface_needs_a_guid=03217_E_„«ï DISPINTERFACE âॡã¥âáï GUID +% DISPINTERFACE ¢á¥£¤  âॡã¥â ¨¤¥­â¨ä¨ª æ¨¨ á ¯®¬®éìî GUID +parser_w_overridden_methods_not_same_ret=03218_W_¥à¥ªàëâë¥ ¬¥â®¤ë ¤®«¦­ë ¨¬¥âì ®¤¨­ ª®¢ë© ⨯ १ã«ìâ â . â®â ª®¤ ¨á¯®«ì§ã¥â ®è¨¡ªã ¢ ¯ àá¥à¥ Delphi ¨ ¡ã¤¥â à ¡®â âì ­¥¯à¥¤áª §ã¥¬® ("$2" ¯¥à¥ªàëâ® "$1", ¨¬¥î騬 ¤à㣮© ⨯ १ã«ìâ â ) +% ¥à¥ªàëâë¥ ¬¥â®¤ë ¤®«¦­ë ¢®§¢à é âì ®¤¨­ ¨ â®â ¦¥ ⨯ १ã«ìâ â . +% ¥ª®â®àë¥ ¢¥àᨨ Delphi ¯®§¢®«ïîâ ¨§¬¥­ïâì ⨯ë १ã«ìâ â  ¨ ¤ ¦¥ ¯à¥¢à é âì +% ¯à®æ¥¤ãàë ¢ ä㭪樨, ­® à ¡®â®á¯®á®¡­®áâì ¯®«ã祭­®£® ª®¤  § ¢¨á¨â ®â +% ¨á¯®«ì§®¢ ­­ëå ⨯®¢ ¨ ᯮᮡ  ¢ë§®¢  ¬¥â®¤®¢. +parser_e_dispid_must_be_ord_const=03219_E_Dispatch ID ¤®«¦­ë ¡ëâì ¯®à浪®¢ë¬¨ ª®­áâ ­â ¬¨ +% ‡  ª«îç¥¢ë¬ á«®¢®¬ \var{dispid} ¤®«¦­  á«¥¤®¢ âì ¯®à浪®¢ ï ª®­áâ ­â  (¨­¤¥ªá). +parser_e_array_range_out_of_bounds=03220_E_„¨ ¯ §®­ ¬ áᨢ  ᫨誮¬ ¢¥«¨ª +% ¥§ ¢¨á¨¬® ®â ª®«¨ç¥á⢠ ¯ ¬ïâ¨, § ­¨¬ ¥¬®© í«¥¬¥­â ¬¨, ¬ áá¨¢ë ­¥ ¬®£ãâ ᮤ¥à¦ âì +% ¡®«ìè¥ ç¥¬ high(ptrint) í«¥¬¥­â®¢. Šà®¬¥ ⮣®, ⨯ ¤¨ ¯ §®­  ¤®«¦¥­ ¡ëâì ¯®¤¤¨ ¯ §®­®¬ +% ⨯  ptrint. +parser_e_packed_element_no_var_addr=03221_E_¥«ì§ï ¢§ïâì  ¤à¥á í«¥¬¥­â®¢/¯®«¥© ¯®¡¨â­®-㯠ª®¢ ­­ëå ¬ áᨢ®¢/§ ¯¨á¥© +% ®«ï § ¯¨á¨ ¨«¨ í«¥¬¥­âë ¬ áᨢ , ®¡ê¥­­ëå ª ª \var{packed} ¢ ०¨¬¥ Mac Pascal («¨¡® ª ª +% \var{packed} ¢ «î¡®¬ ०¨¬¥ ¯à¨ ãá«®¢¨¨ \var{\{\$bitpacking on\}}), ¡ã¤ãâ 㯠ª®¢ ­ë ­  ã஢­¥ +% ¡¨â. â® ®§­ ç ¥â ­¥¢®§¬®¦­®áâì ¯®«ã祭¨ï  ¤à¥á®¢ ®â¤¥«ì­ëå í«¥¬¥­â®¢ ¬ áᨢ  ¨«¨ ¯®«¥© § ¯¨á¨. +% ˆáª«î祭¨¥¬ ¨§ í⮣® ¯à ¢¨«  ïîâáï 㯠ª®¢ ­­ë¥ ¬ áᨢë, à §¬¥à í«¥¬¥­â®¢ ª®â®àëå ªà â¥­ 8 ¡¨â ¬. +parser_e_packed_dynamic_open_array=03222_E_„¨­ ¬¨ç¥áª¨¥ ¬ áá¨¢ë ­¥ ¬®£ãâ ¡ëâì 㯠ª®¢ ­­ë¬¨ +% “¯ ª®¢ ­­ë¬¨ ¬®£ãâ ¡ëâì ⮫쪮 ®¡ëç­ë¥ (¨, ¢®§¬®¦­®, ¢ ¡ã¤ã饬 â ª¦¥ ®âªàëâë¥) ¬ áᨢë. +parser_e_packed_element_no_loop=03223_E_«¥¬¥­âë/¯®«ï ¯®¡¨â­®-㯠ª®¢ ­­ëå ¬ áᨢ®¢/§ ¯¨á¥© ­¥«ì§ï ¨á¯®«ì§®¢ âì ª ª ¯¥à¥¬¥­­ë¥ 横«  for +% ®«ï § ¯¨á¨ ¨«¨ í«¥¬¥­âë ¬ áᨢ , ®¡ê¥­­ëå ª ª \var{packed} ¢ ०¨¬¥ Mac Pascal («¨¡® ª ª +% \var{packed} ¢ «î¡®¬ ०¨¬¥ ¯à¨ ãá«®¢¨¨ \var{\{\$bitpacking on\}}), ¡ã¤ãâ 㯠ª®¢ ­ë ­  ã஢­¥ +% ¡¨â. ® ¯à¨ç¨­ ¬ ¡ëáâத¥©áâ¢¨ï ¨å ­¥«ì§ï ¨á¯®«ì§®¢ âì ª ª ¯¥à¥¬¥­­ë¥ ¤«ï for-横« . +parser_e_type_and_var_only_in_generics=03224_E_VAR ¨ TYPE ¤®¯ãá⨬ë ⮫쪮 ¢ ®¡®¡é¥­¨ïå (generic) +% ˆá¯®«ì§®¢ ­¨¥ VAR ¨ TYPE ¤«ï ®¡ê¥­¨ï ­®¢ëå ⨯®¢ ¢­ãâਠ®¡ê¥ªâ  à §à¥è ¥âáï ⮫쪮 ¤«ï +% ®¡®¡é¥­¨©. +parser_e_cant_create_generics_of_this_type=03225_E_â®â ⨯ ­¥ ¬®¦¥â ¡ëâì ®¡®¡é¥­¨¥¬ +% Ž¡®¡é¥­¨ï ¤®¯ã᪠îâáï ⮫쪮 ¤«ï ª« áᮢ, ®¡ê¥ªâ®¢, ¨­â¥à䥩ᮢ ¨ § ¯¨á¥©. +parser_w_no_lineinfo_use_switch=03226_W_¥ ¯®¤ª«î砩⥠¬®¤ã«ì LINEINFO ¢àãç­ãî, ¨á¯®«ì§ã©â¥ ¤«ï í⮣® ª«îç -gl +% ¥ ¯®¤ª«î砩⥠¬®¤ã«ì LINEINFO ¢àãç­ãî, ¨á¯®«ì§®¢ ­¨¥ ª«îç  \var{-gl}  ¢â®¬ â¨ç¥áª¨ ¯®¤ª«îç ¥â +% à §«¨ç­ë¥ ¬®¤ã«¨ ¢ § ¢¨á¨¬®á⨠®â ⨯  £¥­¥à¨à㥬®© ®â« ¤®ç­®© ¨­ä®à¬ æ¨¨. +parser_e_no_funcret_specified=03227_E_„«ï ä㭪樨 "$1" ­¥ 㪠§ ­ ⨯ १ã«ìâ â  +% ¥à¢®¥ ®¡ê¥­¨¥ ä㭪樨 ¤®«¦­® ¡ëâì ¯®«­ë¬, ¢ª«îç ï ¢á¥ ¯ à ¬¥âàë ¨ ⨯ १ã«ìâ â . +parser_e_special_onlygenerics=03228_E_‘¯¥æ¨ «¨§ æ¨ï ¢®§¬®¦­  ⮫쪮 ¤«ï ®¡®¡é¥­­ëå ⨯®¢. +% ’¨¯ë, ­¥ ïî騥áï ®¡®¡é¥­¨ï¬¨, ­¥ ¬®£ãâ ¡ëâì ᯥ樠«¨§¨à®¢ ­ë. +parser_e_no_generics_as_params=03229_E_Ž¡®¡é¥­¨ï ­¥«ì§ï ¨á¯®«ì§®¢ âì ª ª ¯ à ¬¥âàë ᯥ樠«¨§ æ¨¨ ¤àã£¨å ®¡®¡é¥­¨© +% ਠᯥ樠«¨§ æ¨¨ ®¡®¡é¥­¨ï, ¢ ª ç¥á⢥ ¯ à ¬¥â஢ ¬®¦­® ¨á¯®«ì§®¢ âì ⮫쪮 ®¡ëç­ë¥ ⨯ë. +parser_e_type_object_constants=03230_E_Š®­áâ ­â­ë¥ ®¡ê¥ªâë, ᮤ¥à¦ é¨¥ VMT, ­¥ ¤®¯ã᪠îâáï +% …᫨ ®¡ê¥ªâ âॡã¥â VMT ¨§-§  ­ «¨ç¨ï ª®­áâàãªâ®à  «¨¡® ¢¨àâã «ì­ëå ¬¥â®¤®¢, +% ᮧ¤ ­¨¥ ª®­áâ ­â ¥£® ⨯  ­¥ ¤®¯ã᪠¥âáï. ‚ ०¨¬ å TP ¨ Delphi, ⥬ ­¥ ¬¥­¥¥, +% íâ® à §à¥è¥­® ¢ 楫ïå ᮢ¬¥á⨬®áâ¨. +parser_e_label_outside_proc=03231_E_¥ ¤®¯ã᪠¥âáï ¢§ï⨥  ¤à¥á®¢ ¬¥â®ª, ®¯à¥¤¥«¥­­ëå ¢­¥ ⥪ã饩 ®¡« á⨠¢¨¤¨¬®á⨠+% ¥ à §à¥è ¥âáï ¯®«ã祭¨¥  ¤à¥á®¢ ¬¥â®ª, ­ å®¤ïé¨åáï ¢­¥ ⥪ã饩 ¯à®æ¥¤ãàë. +parser_e_initialized_not_for_external=03233_E_¥ ¤®¯ã᪠¥âáï ¨­¨æ¨ «¨§ æ¨ï ¯¥à¥¬¥­­ëå, ®¡ê¥­­ëå ª ª external +% ¥à¥¬¥­­ë¥, ®¡ê¥­­ë¥ ª ª external, ­¥ ¬®£ãâ ¨¬¥âì §­ ç¥­¨¥ ¯® 㬮«ç ­¨î. +parser_e_illegal_function_result=03234_E_¥¢¥à­ë© ⨯ ¢®§¢à é ¥¬®£® §­ ç¥­¨ï +% ¥ª®â®àë¥ â¨¯ë, â ª¨¥ ª ª ä ©«ë, ­¥ ¬®£ãâ ¡ëâì ¨á¯®«ì§®¢ ­ë ¢ ª ç¥á⢥ १ã«ìâ â  ä㭪樨. +parser_e_no_common_type=03235_E_Žâáãâáâ¢ã¥â ®¡é¨© ⨯ ¤«ï "$1" ¨ "$2" +% —â®¡ë ¢ë¯®«­¨âì ®¯¥à æ¨î ­ ¤ 楫묨 ç¨á« ¬¨, ª®¬¯¨«ïâ®à ¯à¨¢®¤¨â ¨å ª ®¡é¥¬ã ⨯ã, +% 祣® ¥¬ã ¢ ¤ ­­®¬ á«ãç ¥ ­¥ 㤠¥âáï. „«ï ®¯à¥¤¥«¥­¨ï ®¡é¥£® ⨯  ®¯¥à ­¤®¢ +% ª®¬¯¨«ïâ®à ¡¥à¥â ¬¥­ì襥 ¨§ ¬¨­¨¬ «ì­ëå §­ ç¥­¨© ®¡®¨å ⨯®¢ ¨ ¡®«ì襥 ¨§ ¬ ªá¨¬ «ì­ëå +% §­ ç¥­¨©. Ž¡é¨© ⨯ ¡ã¤¥â ¨¬¥âì ¤¨ ¯ §®­ ¬¨­¨¬ã¬..¬ ªá¨¬ã¬. +parser_e_no_generics_as_types=03236_E_Ž¡®¡é¥­¨ï ¡¥§ ᯥ樠«¨§ æ¨¨ ­¥ ¬®£ãâ ¡ëâì ¨á¯®«ì§®¢ ­ë ª ª ⨯ ¯¥à¥¬¥­­®© +% Ž¡®¡é¥­¨ï ¢á¥£¤  ¤®«¦­ë ¡ëâì ᯥ樠«¨§¨à®¢ ­ë ¯¥à¥¤ ¨á¯®«ì§®¢ ­¨¥¬ ¢ ª ç¥á⢥ ⨯  ¤«ï ¯¥à¥¬¥­­ëå. +parser_w_register_list_ignored=03237_W_¥à¥ç¥­ì ॣ¨áâ஢ ¤«ï ¯à®æ¥¤ãà ¯®«­®áâìî ­   áᥬ¡«¥à¥ ¨£­®à¨à®¢ ­ +% ‚ ¯à®æ¥¤ãà å, ­ ¯¨á ­­ëå ¯®«­®áâìî ­   áᥬ¡«¥à¥, ¯¥à¥ç¥­ì ¨§¬¥­¥­­ëå ॣ¨áâ஢ ¨£­®à¨àã¥âáï. +parser_e_implements_must_be_class_or_interface=03238_E_‘¢®©á⢮ implements ¤®«¦­® ¡ëâì ⨯  ª« áá ¨«¨ ¨­â¥à䥩á +% ‘¢®©á⢮, ॠ«¨§ãî饥 ¨­â¥à䥩á, ¤®«¦­® ¨¬¥âì ⨯ ª« áá  ¨«¨ ¨­â¥à䥩á . +parser_e_implements_must_have_correct_type=03239_E_‘¢®©á⢮ implements ¤®«¦­® ॠ«¨§®¢ë¢ âì ¨­â¥à䥩á 㪠§ ­­®£® ⨯ , ­ ©¤¥­® "$1" ®¦¨¤ «®áì "$2" +% ‘¢®©á⢮, ॠ«¨§ãî饥 ¨­â¥à䥩á, ॠ«¨§ã¥â ­¥ â®â ⨯ ¨­â¥à䥩á . +parser_e_implements_must_read_specifier=03240_E_‘¢®©á⢮ implements ¤®«¦­® ¡ëâì ¤®áâã¯­ë¬ ¤«ï ç⥭¨ï +% ‘¢®©á⢮, ॠ«¨§ãî饥 ¨­â¥à䥩á, ¤®«¦­® ¨¬¥âì ᯥæ¨ä¨ª â®à read. +parser_e_implements_must_not_have_write_specifier=03241_E_‘¢®©á⢮ implements ­¥ ¤®«¦­® ¡ëâì ¤®áâã¯­ë¬ ¤«ï § ¯¨á¨ +% ‘¢®©á⢮, ॠ«¨§ãî饥 ¨­â¥à䥩á, ­¥ ¬®¦¥â ¨¬¥âì ᯥæ¨ä¨ª â®à write. +parser_e_implements_must_not_have_stored_specifier=03242_E_‘¢®©á⢮ implements ­¥ ¬®¦¥â ¡ëâì stored +% ‘¢®©á⢮, ॠ«¨§ãî饥 ¨­â¥à䥩á, ­¥ ¬®¦¥â ¨¬¥âì ᯥæ¨ä¨ª â®à stored. +parser_e_implements_uses_non_implemented_interface=03243_E_‘¢®©á⢮ implements ¨á¯®«ì§®¢ ­® ¤«ï ­¥à¥ «¨§®¢ ­­®£® ¨­â¥à䥩á : "$1" +% ˆ­â¥à䥩á, ॠ«¨§ã¥¬ë© ᢮©á⢮¬, ¤®«¦¥­ ¡ëâì ¢ ᯨ᪥ ¨­â¥à䥩ᮢ, ॠ«¨§ã¥¬ëå ª« áᮬ. +parser_e_unsupported_real=03244_E_‚ëç¨á«¥­¨ï á ¯« ¢ î饩 § ¯ï⮩ ­¥ ¤®áâã¯­ë ¤«ï 楫¥¢®© ¯« âä®à¬ë +% ‚áâà¥â¨«®áì ¢¥é¥á⢥­­®¥ ¢ëà ¦¥­¨¥, ­® ­  楫¥¢®© ¯« âä®à¬¥ ®­¨ ­¥ ¯®¤¤¥à¦¨¢ îâáï +parser_e_class_doesnt_implement_interface=03245_E_Š« áá "$1" ­¥ ॠ«¨§ã¥â ¨­â¥à䥩á "$2" +% „¥«¥£¨à®¢ ­­ë© ¨­â¥àä¥©á ­¥ ॠ«¨§®¢ ­ ª« áᮬ, 㪠§ ­­ë¬ ¢ ¢ëà ¦¥­¨¨ implements. +parser_e_class_implements_must_be_interface=03246_E_’¨¯, ¨á¯®«ì§ã¥¬ë© implements, ¤®«¦¥­ ¡ëâì ¨­â¥à䥩ᮬ +% ‡  ª«îç¥¢ë¬ á«®¢®¬ \var{implements} ¤®«¦­® á«¥¤®¢ âì ¨¬ï ⨯  ¨­â¥à䥩á . +parser_e_cant_export_var_different_name=03247_E_  í⮩ ¯« âä®à¬¥ ¯¥à¥¬¥­­ë¥ ­¥«ì§ï íªá¯®àâ¨à®¢ âì á ¤à㣨¬ ¨¬¥­¥¬, ¤®¡ ¢ì⥠¨¬ï ª ®¡ê¥­¨î á ¯®¬®éìî ¤¨à¥ªâ¨¢ë "export" (¨¬ï ¯¥à¥¬¥­­®©: $1, ®¡ê¥­­®¥ ¨¬ï íªá¯®àâ : $2) +% On most targets it is not possible to change the name under which a variable +% is exported inside the \var{exports} statement of a library. +% In that case, you have to specify the export name at the point where the +% variable is declared, using the \var{export} and \var{alias} directives. +parser_e_weak_external_not_supported=03248_E_‘¨¬¢®«ë "weak external" ­¥ ¯®¤¤¥à¦¨¢ îâáï ­  楫¥¢®© ¯« âä®à¬¥ +% A "weak external" symbol is a symbol which may or may not exist at (either static +% or dynamic) link time. This concept may not be available (or implemented yet) +% on the current cpu/OS target. +parser_e_forward_mismatch=03249_E_’¨¯ ­¥ ᮮ⢥âáâ¢ã¥â à ­­¥¬ã ®¡ê¥­¨î +% ਠ࠭­¥¬ ®¡ê¥­¨¨ ª« áᮢ ¨ ¨­â¥à䥩ᮢ ⨯ë à ­­¥£® ¨ ä ªâ¨ç¥áª®£® ®¡ê¥­¨© +% ¤®«¦­ë ᮢ¯ ¤ âì.  ­¥¥ ®¡ê¥­­ë© ¨­â¥àä¥©á ­¥ ¬®¦¥â ¡ëâì ¯à¥¢à é¥­ ¢ ª« áá. +parser_n_ignore_lower_visibility=03250_N_‚¨àâã «ì­ë© ¬¥â®¤ "$1" ¨¬¥¥â ¬¥­ìèãî ¢¨¤¨¬®áâì ($2), 祬 ¢ த¨â¥«ì᪮¬ ª« áᥠ$3 ($4) +% ¥à¥ªà뢠î騩 ¢¨àâã «ì­ë© ¬¥â®¤ ¢¨¤¨¬®áâì ¬¥­ìè¥, 祬 ¯¥à¥ªà뢠¥¬ë©. â® ¬®¦¥â ¯à¨¢®¤¨âì ª +% ­¥®¦¨¤ ­­ë¬ १ã«ìâ â ¬. …᫨ ­®¢ ï ¢¨¤¨¬®áâì - private, â® ¢ë§®¢ inherited ¢ ­®¢®¬ ª« áᥠ+% ¯®â®¬ª  ¬®¦¥â ¢ë§ë¢ âì ¬¥â®¤ á ¡®«ì襩 ¢¨¤¨¬®áâìî ¢ த¨â¥«ì᪮¬ ª« áá¥, ¨£­®à¨àãï private ¬¥â®¤. +parser_e_field_not_allowed_here=03251_E_®«ï ­¥«ì§ï ®¡êïâì ¯®á«¥ ¬¥â®¤®¢ ¨«¨ ᢮©áâ¢, á­ ç «  ­ ç­¨â¥ ­®¢ãî ᥪæ¨î ¢¨¤¨¬®á⨠+% ®á«¥ ®¡ê¥­¨ï ¬¥â®¤  ¨«¨ ᢮©á⢠ ¢ ª« áᥠ¨«¨ ®¡ê¥ªâ¥, ¤ «ì­¥©è¥¥ ®¡ê¥­¨¥ ¯®«¥© ¢®§¬®¦­® +% ⮫쪮 ¢ ­®¢®© ᥪ樨 ®¡« á⨠¢¨¤¨¬®á⨠(\var{public}, \var{private} ¨ â.¤.). â® ­¥®¡å®¤¨¬® +% ¤«ï ®¤­®§­ ç­®£® ¯®­¨¬ ­¨ï ª®¤  ª®¬¯¨«ïâ®à®¬, ¯®áª®«ìªã ¬®¤¨ä¨ª â®àë ¬¥â®¤®¢, +% â ª¨¥ ª ª \var{default} ¨ \var{register} ¬®£ãâ â ª¦¥ ¨á¯®«ì§®¢ âìáï ª ª ¨¬¥­  ¯®«¥©. +parser_e_no_local_para_def=03252_E_ à ¬¥âàë ­¥ ¬®£ãâ ᮤ¥à¦ âì «®ª «ì­ë¥ ®¡ê¥­¨ï ⨯®¢. ˆá¯®«ì§ã©â¥ ®â¤¥«ì­®¥ ®¡ê¥­¨¥ ⨯  ¢ ¡«®ª¥ type. +% ‚  áª «¥ ᥬ ­â¨ç¥áª¨ à ¢­®§­ ç­ë¥ â¨¯ë ­¥ áç¨â îâáï ¨¤¥­â¨ç­ë¬¨. +% ¥à¥¬¥­­ë¥ ¨«¨ ¯ à ¬¥âàë áç¨â îâáï ®¤­®â¨¯­ë¬¨ ⮫쪮 ¢ ⮬ á«ãç ¥, ¥á«¨ ®­¨ ááë« îâáï ­  ®¤­® ¨ â® ¦¥ +% ®¡ê¥­¨¥ ⨯ . +% Š ª á«¥¤á⢨¥, ®¡ê¥­¨¥ ⨯®¢ ¢ ᯨ᪥ ¯ à ¬¥â஢ ­¥ ¤®¯ã᪠¥âáï, â.ª. ­  «®ª «ì­®¥ ®¡ê¥­¨¥ ­¥¢®§¬®¦­® +% á®á« âìáï ¨§¢­¥, ¨ ¤¢  § £®«®¢ª  ¯à®æ¥¤ãàë ¢ ¨­â¥à䥩᭮© ¨ ॠ«¨§ æ¨®­­®© ç á⨠¬®¤ã«ï ®¡ê﫨 ¡ë +% ¤¢  à §«¨ç­ëå ⨯ . ˆ¬¥©â¥ ¢ ¢¨¤ã, çâ® ¢ëà ¦¥­¨ï ¢¨¤  ``file of byte'' ¨«¨ ``string[50]'' â ª¦¥ ®¯à¥¤¥«ïîâ +% ­®¢ë© ⨯. +% \end{description} +# +# Type Checking +# +# 04087 is the last used one +# +% \section{Žè¨¡ª¨ ¯à®¢¥àª¨ ⨯®¢} +% ‚ à §¤¥«¥ ¯¥à¥ç¨á«¥­ë ¢á¥ ®è¨¡ª¨, ª®â®àë¥ ¬®£ãâ ¢®§­¨ª âì ¢ ¯à®æ¥áᥠ+% ¯à®¢¥àª¨ ⨯®¢. +% \begin{description} +type_e_mismatch=04000_E_’¨¯ ­¥ ᮢ¯ ¤ ¥â +% Œ®¦¥â ¨¬¥âì ¬¥áâ® ¢® ¬­®£¨å á«ãç ïå: +% \begin{itemize} +% \item à¨á¢ ¨¢ ¥¬ ï ¯¥à¥¬¥­­ ï ¨¬¥¥â ⨯, ®â«¨ç­ë© ®â ¯à¨á¢ ¨¢ ¥¬®£® ¢ëà ¦¥­¨ï. +% \item ‚맮¢ ä㭪樨 ¨«¨ ¯à®æ¥¤ãàë á ¯ à ¬¥âà ¬¨, ­¥á®¢¬¥á⨬묨 +% á ⥬¨, ª®â®àë¥ ¡ë«¨ ¨á¯®«ì§®¢ ­ë ¯à¨ ®¡ê¥­¨¨ ä㭪樨. +% \end{itemize} +type_e_incompatible_types=04001_E_H¥á®¢¬¥áâ¨¬ë¥ â¨¯ë: ¯®«y祭® "$1", ®¦¨¤ «®áì "$2" +% ८¡à §®¢ ­¨¥ ¨§ ®¤­®£® ⨯  ¢ ¤à㣮© ­¥¢®§¬®¦­®. +% ’ ª¦¥ ¢®§¬®¦­®, çâ® â¨¯ë ®¡ê¥­ë ¢ à §«¨ç­ëå ®¡ê¥­¨ïå: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { ਢ¥¤¥â ª ®è¨¡ª¥ ¨§-§  âॡ®¢ ­¨ï +% áâண®£® ᮮ⢥âá⢨ï ⨯®¢ ¢  áª «¥ } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_H¥á®¢¯ ¤¥­¨¥ ⨯®¢ ¬¥¦¤y "$1" ¨ "$2" +% ’¨¯ë ­¥ à ¢­ë +type_e_type_id_expected=04003_E_Ž¦¨¤ ¥âáï ¨¤¥­â䨪 â®à ⨯  +% ˆ¤¥­â¨ä¨ª â®à ­¥ ï¥âáï ⨯®¬, «¨¡® ¨¤¥­â¨ä¨ª â®à ⨯  ¯à®¯ã饭. +type_e_variable_id_expected=04004_E_Ž¦¨¤ ¥âáï ¨¤¥­â¨ä¨ª â®à ¯¥à¥¬¥­­®© +% நá室¨â ¯à¨ ¯®¯ë⪥ ¯¥à¥¤ ç¨ ª®­áâ ­âë ¢ ¯à®æ¥¤ãàã \var{Inc} ¨«¨ \var{Dec}. +% ˆ¬ ¬®¦­® ¯¥à¥¤ ¢ âì ⮫쪮 ¯¥à¥¬¥­­ë¥. +type_e_integer_expr_expected=04005_E_Ž¦¨¤ ¥âáï ¢ëp ¦¥­¨¥ ⨯  INTEGER, ­® ¯®«ã祭® "$1" +% Š®¬¯¨«ïâ®à ®¦¨¤ ¥â ¢ëà ¦¥­¨¥ ⨯  integer, ­® ¯®«ã砥⠭¥çâ® ¨­®¥. +type_e_boolean_expr_expected=04006_E_Ž¦¨¤ ¥âáï ¢ëà ¦¥­¨¥ ⨯  BOOLEAN, ­® ¯®«ã祭® "$1" +% ‚ëà ¦¥­¨¥ ¤®«¦­® ¡ëâì ¡ã«¥¢®£® ⨯ , ¤®«¦­® ¡ëâì ¢®§¢à é¥­® true ¨«¨ +% false. +type_e_ordinal_expr_expected=04007_E_Ž¦¨¤ ¥âáï ¢ëp ¦¥­¨¥ ¯®à浪®¢®£® ⨯  +% ’¨¯ ¢ëà ¦¥­¨ï ¤®«¦¥­ ¡ëâì ¯®à浪®¢ë¬, â.¥., ¬ ªá¨¬ã¬ \var{Longint}. +% நá室¨â, ­ ¯à¨¬¥à, ¥á«¨ ¢â®à®©  à£ã¬¥­â +% \var{Inc} ¨«¨ \var{Dec} ­¥ ¢ëç¨á«ï¥âáï ª ª ¯®à浪®¢ë© ⨯. +type_e_pointer_type_expected=04008_E_Ž¦¨¤ ¥âáï ⨯ POINTER, ­® ¯®«ã祭® "$1" +% ¥à¥¬¥­­ ï ¨«¨ ¢ëà ¦¥­¨¥ ¨¬¥¥â ⨯, ®â«¨ç­ë© ®â \var{pointer}. நá室¨â, +% ­ ¯à¨¬¥à, ¯à¨ ¯¥à¥¤ ç¥ 楫®© ¯¥à¥¬¥­­®© ¢ ª ç¥á⢥  à£ã¬¥­â  \var{New} +% ¨«¨ \var{Dispose}. +type_e_class_type_expected=04009_E_Ž¦¨¤ ¥âáï ⨯ CLASS, ­® ¯®«ã祭® "$1" +% ¥à¥¬¥­­ ï ¨«¨ ¢ëà ¦¥­¨¥ ¨¬¥¥â ⨯, ®â«¨ç­ë© ®â \var{class}. Ž¡ëç­® +% á«ãç ¥âáï, ¥á«¨ +% \begin{enumerate} +% \item ®¤¨â¥«ì᪨© ª« áá ¢ ®¡ê¥­¨¨ ª« áá  ­¥ ï¥âáï ª« áᮬ. +% \item Ž¡à ¡®â稪 ¨áª«î祭¨© (\var{On}) ᮤ¥à¦¨â ¨¤¥­â¨ä¨ª â®à ⨯ , +% ­¥ ïî騩áï ª« áᮬ. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_H¥¢®§¬®¦­® ¢ëç¨á«¨âì ª®­áâ ­â­®¥ ¢ëà ¦¥­¨¥ +% நá室¨â, ¥á«¨ £à ­¨æë ®¡ê¥­­®£® ¬ áᨢ  ­¥ ¢ëç¨á«ïîâáï ª ª ¯®à浪®¢ë¥ ª®­áâ ­âë. +type_e_set_element_are_not_comp=04012_E_«¥¬¥­âë ¬­®¦¥á⢠ ­¥ ᮢ¬¥á⨬ë +% ‚®§­¨ª ¥â ¯à¨ ®¯¥à æ¨¨ ­ ¤ ¤¢ã¬ï ¬­®¦¥á⢠¬¨, ¨¬¥î騬¨ à §«¨ç­ë© ⨯ í«¥¬¥­â®¢. +% „«ï ®¡ê¥¤¨­¥­¨ï ¬­®¦¥á⢠®­¨ ¤®«¦­ë ¨¬¥âì ®¤¨­ ª®¢ë© ¡ §®¢ë© ⨯. +type_e_set_operation_unknown=04013_E_Ž¯¥p æ¨ï ­¥ p¥ «¨§®¢ ­  ¤«ï ¬­®¦¥á⢠+% ¥ª®â®àë¥ ¯ à­ë¥ ®¯¥à æ¨¨ ­¥ ®¯à¥¤¥«¥­ë ¤«ï ¬­®¦¥áâ¢, +% ­ ¯à¨¬¥à, div mod ** (â ª¦¥, ¢ ­ áâ®ï饥 ¢à¥¬ï, >= <=). +type_w_convert_real_2_comp=04014_W_€¢â®¬ â¨ç¥áª®¥ ¯p¥®¡p §®¢ ­¨¥ ¨§ ¢¥é¥á⢥­­®£® ⨯  ¢ COMP, ª®â®pë© ï¢«ï¥âáï 楫®ç¨á«¥­­ë¬ +% ‚áâà¥â¨«®áì ­¥ï¢­®¥ ¯à¥®¡à §®¢ ­¨¥ ¢¥é¥á⢥­­®£® ⨯  ¢ \var{comp}. +% ®áª®«ìªã \var{Comp} ï¥âáï 64-¡¨â­ë¬ 楫ë¬, íâ® ¬®¦¥â ᢨ¤¥â¥«ìá⢮¢ âì ®¡ ®è¨¡ª¥. +type_h_use_div_for_int=04015_H_„«ï ¯®«y祭¨ï 楫®ç¨á«¥­­®£® p¥§y«ìâ â  ¨á¯®«ì§y©â¥ DIV +% ਠ¢ª«î祭­ëå ¯®¤áª §ª å, á®®¡é¥­¨¥ ¡ã¤¥â ¢ë¤ ¢ âìáï ¯à¨ æ¥«®ç¨á«¥­­®¬ ¤¥«¥­¨¨ +% á ¯®¬®éìî '/', ¯®áª®«ìªã १ã«ìâ â ¢ í⮬ á«ãç ¥ ¡ã¤¥â ¢¥é¥á⢥­­ë¬. +type_e_strict_var_string_violation=04016_E_’¨¯ë áâப ­¥ ᮢ¯ ¤ îâ ¨§-§  ०¨¬  $V+ +% ਠª®¬¯¨«ï樨 ¢ ०¨¬¥ \var{\{\$V+\}}, ⨯ áâப, ¯¥à¥¤ ¢ ¥¬ëå ª ª ¯ à ¬¥âàë, +% ¤®«¦¥­ ¢ â®ç­®á⨠ᮢ¯ ¤ âì á ⨯®¬ ¢ ®¡ê¥­¨¨ ä㭪樨. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_SUCC ¨«¨ PRED ­¥¢®§¬®¦­ë ­  ¯¥p¥ç¨á«¥­¨ïå á ¯à¨á¢®¥­¨ï¬¨ +% …᫨ ¯¥à¥ç¨á«ï¥¬ë© ⨯ ᮤ¥à¦¨â ¯à¨á¢®¥­¨ï, ª ª ¢ ï§ëª¥ C, +% ­ ¯à¨¬¥à: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% â® ¤«ï ­¥£® ­¥«ì§ï ¨á¯®«ì§®¢ âì ä㭪樨 \var{Succ} ¨«¨ \var{Pred}. +type_e_cant_read_write_type=04018_E_—⥭¨¥ ¨ § ¯¨áì ¯¥p¥¬¥­­ëå í⮣® ⨯  ­¥¢®§¬®¦­  +% ®¯ë⪠ ç⥭¨ï (\var{read}) ¨«¨ § ¯¨á¨ (\var{write}) ¯¥à¥¬¥­­®©, ⨯ ª®â®à®© ­¥ +% ¯®¤¤¥à¦¨¢ ¥âáï, ¢ ä ©« ⨯  ⥪áâ. ®¤¤¥à¦¨¢ îâáï ⮫쪮 楫ë¥, +% ¡ã«¥¢ë, ¢¥é¥á⢥­­ë¥ ¯¥à¥¬¥­­ë¥, ¯¥à¥¬¥­­ë¥ ⨯  pchar ¨ áâப¨. +type_e_no_readln_writeln_for_typed_file=04019_E_Readln ¨«¨ Writeln ­¥¤®¯ãáâ¨¬ë ­  ⨯¨§¨à®¢ ­­®¬ ä ©«¥ +% \var{readln} ¨ \var{writeln} ¤®¯ã᪠îâáï ⮫쪮 ¤«ï ⥪á⮢ëå ä ©«®¢. +type_e_no_read_write_for_untyped_file=04020_E_Read ¨«¨ Write ­¥¤®¯ãáâ¨¬ë ­  ­¥â¨¯¨§¨à®¢ ­­®¬ ä ©«¥ +% \var{read} ¨ \var{write} ¤®¯ã᪠îâáï ⮫쪮 ¤«ï ⥪á⮢ëå ¨ ⨯¨§¨à®¢ ­­ëå ä ©«®¢. +type_e_typeconflict_in_set=04021_E_Š®­ä«¨ªâ ⨯®¢ ¬¥¦¤y í«¥¬¥­â ¬¨ ¬­®¦¥á⢠ +% ’¨¯ ¯® ªà ©­¥© ¬¥à¥ ®¤­®£® í«¥¬¥­â  ­¥ ᮢ¯ ¤ ¥â á ¡ §®¢ë¬ ⨯®¬ ¬­®¦¥á⢠. +type_w_maybe_wrong_hi_lo=04022_W_Lo/Hi(dword/qword) ¢®§¢p é îâ ¬« ¤è¥¥/áâ à襥 word/dword +% \fpc ¯®¤¤¥à¦¨¢ ¥â ¯¥à¥£à㦥­­ë¥ ¢ à¨ ­âë \var{lo/hi} ¤«ï \var{longint/dword/int64/qword}, +% ª®â®àë¥ ¢®§¢à é îâ ¬« ¤èãî/áâ àèãî ¯®«®¢¨­ã  à£ã¬¥­â  (⨯  word/dword). TP ¢á¥£¤  ¨á¯®«ì§ã¥â +% 16-¡¨â­ë¥ \var{lo/hi}, ª®â®àë¥ ¢á¥£¤  ¢®§¢à é îâ ¡¨âë 0..7 ¤«ï \var{lo} ¨ +% ¡¨âë 8..15 ¤«ï \var{hi}. …᫨ âॡã¥âáï ¯®¢¥¤¥­¨¥ TP, ­ã¦­® ¯à¨¢¥á⨠ à£ã¬¥­â +% ª \var{word/integer}. +type_e_integer_or_real_expr_expected=04023_E_Ž¦¨¤ ¥âáï ¢ëp ¦¥­¨¥ 楫®£® ¨«¨ ¢¥é¥á⢥­­®£® ⨯  +% ¥à¢ë©  à£ã¬¥­â \var{str} ¤®«¦¥­ ¨¬¥âì æ¥«ë© «¨¡® ¢¥é¥á⢥­­ë© ⨯. +type_e_wrong_type_in_array_constructor=04024_E_H¥¢¥p­ë© ⨯ "$1" ¢ ª®­áâpyªâ®p¥ ¬ áᨢ  +% ®¯ë⪠ ¨á¯®«ì§®¢ ­¨ï ­¥¤®¯ãá⨬®£® ⨯  ¢ ª®­áâàãªâ®à¥ ¬ áᨢ . +type_e_wrong_parameter_type=04025_E_H¥á®¢¯ ¤¥­¨¥ ⨯   p£y¬¥­â  # $1: ¯®«ã祭® "$2", ®¦¨¤ «®áì "$3" +% ®¯ë⪠ ¯¥à¥¤ âì ­¥¢¥à­ë© ⨯ ¤«ï 㪠§ ­­®£® ¯ à ¬¥âà . +type_e_no_method_and_procedure_not_compatible=04026_E_Œ¥â®¤ (¯¥p¥¬¥­­ ï) ¨ ¯p®æ¥¤yp  (¯¥p¥¬¥­­ ï) ­¥ ᮢ¬¥á⨬ë +% ¥«ì§ï ¯à¨á¢®¨âì ¬¥â®¤ ¯¥à¥¬¥­­®© ⨯  ¯à®æ¥¤ãà , ¨«¨ ¯à®æ¥¤ãàã ¯¥à¥¬¥­­®© ⨯  +% ¬¥â®¤. +type_e_wrong_math_argument=04027_E_¥¢¥à­ ï ª®­áâ ­â  ¯¥p¥¤ ­  ¢áâ஥­­®© ¬ â¥¬ â¨ç¥áª®© äy­ªæ¨¨ +% Š®­áâ ­â­ë©  à£ã¬¥­â ä㭪樨 ln ¨«¨ sqrt ­ å®¤¨âáï ¢­¥ ®¯à¥¤¥«¥­­®£® ¤«ï ­¨å +% ¤¨ ¯ §®­ . +type_e_no_addr_of_constant=04028_E_H¥«ì§ï ¢§ïâì  ¤à¥á ª®­áâ ­â­®£® ¢ëà ¦¥­¨ï +% ‚§ïâì  ¤à¥á ª®­áâ ­â­®£® ¢ëà ¦¥­¨ï ­¥¢®§¬®¦­®, ¯®â®¬ã çâ® ª®­áâ ­âë ­¥ +% åà ­ïâáï ¢ ¯ ¬ïâ¨. Œ®¦­® ¯®¯à®¡®¢ âì ®¡êâì ⨯¨§¨à®¢ ­­ãî ª®­áâ ­âã. +type_e_argument_cant_be_assigned=04029_E_€à£ã¬¥­âã ­¥¢®§¬®¦­® ¯à¨á¢®¨âì §­ ç¥­¨¥ +% ‚ ª ç¥á⢥ ¯ à ¬¥âà  ¯® áá뫪¥ ¬®£ãâ ¡ëâì ¯¥à¥¤ ­ë ⮫쪮 ⥠¢ëà ¦¥­¨ï, +% ª®â®àë¥ ¬®¦­® ¨á¯®«ì§®¢ âì á «¥¢®© áâ®à®­ë ®¯¥à â®à  ¯à¨á¢ ¨¢ ­¨ï. +% ‡ ¬¥ç ­¨ï: ‘¢®©á⢠ ¬®¦­® ¨á¯®«ì§®¢ âì á «¥¢®© áâ®à®­ë ¯à¨á¢ ¨¢ ­¨ï, ­® +% ­¥«ì§ï ¯¥à¥¤ ¢ âì ¯® áá뫪¥. +type_e_cannot_local_proc_to_procvar=04030_E_‹®ª «ì­ ï ¯à®æ¥¤ãà  ­¥ ¬®¦¥â ¡ëâì ¯à¨á¢®¥­  ¯¥à¥¬¥­­®© ¯à®æ¥¤ãà­®£® ⨯  +% à¨á¢®¥­¨¥ «®ª «ì­ëå ¯à®æ¥¤ãà/ä㭪権 ¯à®æ¥¤ãà­ë¬ ¯¥à¥¬¥­­ë¬ ­¥ ¤®¯ã᪠¥âáï, +% â.ª. ã ­¨å ¤à㣮© ᯮᮡ ¢ë§®¢ . ‹®ª «ì­ë¥ ¯à®æ¥¤ãàë/ä㭪樨 +% ¬®¦­® ¯à¨á¢®¨âì ⮫쪮 ­¥â¨¯¨§¨à®¢ ­­®¬ã 㪠§ â¥«î. +type_e_no_assign_to_addr=04031_E_H¥«ì§ï ¯à¨á¢®¨âì §­ ç¥­¨¥  ¤p¥áy +% ¥ ¤®¯ã᪠¥âáï ¯à¨á¢®¥­¨¥ §­ ç¥­¨©  ¤à¥á ¬ ¯¥à¥¬¥­­ëå, ª®­áâ ­â, ¯à®æ¥¤ãà +% ¨ ä㭪権. …᫨ ¨¤¥­â¨ä¨ª â®à ï¥âáï ¯à®æ¥¤ãà­®© ¯¥à¥¬¥­­®©, ¬®¦­® ¯®¯à®¡®¢ âì +% ª®¬¯¨«ïæ¨î á ª«î箬 -So. +type_e_no_assign_to_const=04032_E_H¥«ì§ï ¯à¨á¢®¨âì §­ ç¥­¨¥ ª®­á⠭⥠+% ¥ ¤®¯ã᪠¥âáï ¯à¨á¢®¥­¨¥ §­ ç¥­¨© ¯¥à¥¬¥­­ë¬, ®¡ê¥­­ë¬ ª ª ª®­áâ ­â­ë¥. +% Š ª ¯à ¢¨«®, íâ® ¯ à ¬¥âàë, ®¡ê¥­­ë¥ ª ª const. —â®¡ë ¨å ¬®¦­® ¡ë«® +% ¯à¨á¢ ¨¢ âì, ¯®¬¥­ï©â¥ ¨å ­  var ¨«¨ ­  ¯ à ¬¥âà-§­ ç¥­¨¥. +type_e_array_required=04033_E_’p¥¡y¥âáï ⨯ ¬ áᨢ  +% ਠ¤®áâ㯥 ª ¯¥à¥¬¥­­®© ¯® ¨­¤¥ªáã '[<x>]' ⨯ í⮩ ¯¥à¥¬¥­­®© ¤®«¦­  ¡ëâì +% ¬ áᨢ®¬. ‚ ०¨¬¥ FPC â ª¦¥ ¤®¯ã᪠îâáï 㪠§ â¥«¨. +type_e_interface_type_expected=04034_E_’ॡã¥âáï ⨯ ¨­â¥à䥩á , ­® ¯®«ã祭® "$1" +% Š®¬¯¨«ïâ®à ®¦¨¤ « ¢áâà¥â¨âì ¨¬ï ⨯  ¨­â¥à䥩á , ­® ¢áâà¥â¨« çâ®-â® ¤à㣮¥. +% Žè¨¡ª  ¬®¦¥â ¡ëâì ¢ë§¢ ­  á«¥¤ãî騬 ª®¤®¬: +% \begin{verbatim} +% Type +% TMyStream = Class(TStream,Integer) +% \end{verbatim} +type_h_mixed_signed_unsigned=04035_H_‘¬¥è¨¢ ­¨¥ §­ ª®¢ëå ¨ ¡¥§§­ ª®¢ëå ¢ëà ¦¥­¨© ¤ ¥â 64-¡¨â­ë© १ã«ìâ â +% ਠ¤¥«¥­¨¨ (¨«¨ ¢ëç¨á«¥­¨¨ ®áâ âª ) §­ ª®¢®£® ¢ëà ¦¥­¨ï ­  ¡¥§§­ ª®¢®¥ (¨«¨ ­ ®¡®à®â), +% ¨«¨ ¦¥ ¢ª«î祭  ¯à®¢¥àª  ¯¥à¥¯®«­¥­¨© ¨/¨«¨ ¤¨ ¯ §®­®¢ ¨ ¨á¯®«ì§ã¥âáï  à¨ä¬¥â¨ç¥áª®¥ +% ¢ëà ¦¥­¨¥ (+, -, *, div, mod), ¢ ª®â®à®¬ ¢áâà¥ç îâáï ª ª §­ ª®¢ë¥, â ª ¨ ¡¥§§­ ª®¢ë¥ §­ ç¥­¨ï, +% ¢ëç¨á«¥­¨¥ ¡ã¤¥â ¯à®¨§¢®¤¨âìáï ¢ 64-¡¨â­®¬ ०¨¬¥, ª®â®àë© ¬¥¤«¥­­¥¥ ®¡ëç­®© +% 32-¡¨â­®©  à¨ä¬¥â¨ª¨. ⮣® ¬®¦­® ¨§¡¥¦ âì, ¯à¨¢¥¤ï ⨯ ®¤­®£® ¨§ ®¯¥à ­¤®¢ ª ⨯ã +% ¤à㣮£®. +type_w_mixed_signed_unsigned2=04036_W_‘¬¥è¨¢ ­¨¥ §­ ª®¢ëå ¨ ¡¥§§­ ª®¢ëå ¢ëà ¦¥­¨© ⨯  ¬®¦¥â ¢ë§¢ âì ®è¨¡ªã ¢ë室  §  ¤¨ ¯ §®­ +% ਠ¨á¯®«ì§®¢ ­¨¨ ¤¢®¨ç­ëå ®¯¥à æ¨© (and, or, xor), ®¤¨­ ¨§ ®¯¥à ­¤®¢ ª®â®àëå +% ï¥âáï ¡¥§§­ ª®¢ë¬ ¢ëà ¦¥­¨¥¬,   ¤à㣮© - ¢ëà ¦¥­¨¥¬ á® §­ ª®¬, ¨ ¢ª«î祭  +% ¯à®¢¥àª  ¤¨ ¯ §®­®¢, ¬®¦¥â ¢®§­¨ª­ãâì ®è¨¡ª , â.ª. ¢ í⮬ á«ãç ¥ ®¡  ®¯¥à ­¤  +% ¡ã¤ã⠯८¡à §®¢ ­ë ¢ ¡¥§§­ ª®¢ë© cardinal. ⮣® ¬®¦­® ¨§¡¥¦ âì, ¯à¨¢¥¤ï ⨯ +% ®¤­®£® ¨§ ®¯¥à ­¤®¢ ª ⨯㠤à㣮£®. +type_e_typecast_wrong_size_for_assignment=04037_E_ਢ¥¤¥­¨¥ ⨯®¢ à §­®£® à §¬¥à  ($1 -> $2) ¢ ¯à¨á¢ ¨¢ ­¨¨ +% ਢ¥¤¥­¨¥ ⨯  ª ⨯㠤à㣮£® à §¬¥à  ­¥¢®§¬®¦­®, ¥á«¨ ¯¥à¥¬¥­­ ï ¨á¯®«ì§ã¥âáï +% ¢ ¯à¨á¢ ¨¢ ­¨¨. +type_e_array_index_enums_with_assign_not_possible=04038_E_¥à¥ç¨á«¥­¨ï á ¯à¨á¢®¥­¨ï¬¨ ­¥«ì§ï ¨á¯®«ì§®¢ âì ª ª ¨­¤¥ªá ¬ áᨢ  +% «¥¬¥­âë ¯¥à¥ç¨á«ï¥¬®£® ⨯ , ®¡ê¥­­®£® á ¯à¨á¢®¥­¨ï¬¨, ª ª ¢ ï§ëª¥ C, +% ­ ¯à¨¬¥à: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% ­¥«ì§ï ¨á¯®«ì§®¢ âì ª ª ¨­¤¥ªáë ¬ áᨢ®¢. +type_e_classes_not_related=04039_E_’¨¯ë ª« áᮢ ¨«¨ ®¡ê¥ªâ®¢ "$1" ¨ "$2" ­¥ ᮮ⭮áïâáï +% ਢ¥¤¥­¨¥ ⨯  ®¤­®£® ª« áá  ¨«¨ ®¡ê¥ªâ  ª ¤à㣮¬ã, ­¥ ¨¬¥î饣® ª ­¥¬ã ®â­®è¥­¨ï. +% â® ­ ¢¥à­ïª  ¯à¨¢¥¤¥â ª ®è¨¡ª ¬. +type_w_classes_not_related=04040_W_’¨¯ë ª« áᮢ "$1" ¨ "$2" ­¥ ᮮ⭮áïâáï +% ਢ¥¤¥­¨¥ ⨯  ®¤­®£® ª« áá  ¨«¨ ®¡ê¥ªâ  ª ¤à㣮¬ã, ­¥ ¨¬¥î饣® ª ­¥¬ã ®â­®è¥­¨ï. +% â® ­ ¢¥à­ïª  ¯à¨¢¥¤¥â ª ®è¨¡ª ¬. +type_e_class_or_interface_type_expected=04041_E_Ž¦¨¤ ¥âáï ⨯ ª« áá  ¨«¨ ¨­â¥à䥩á , ­® ¯®«ã祭® "$1" +% Š®¬¯¨«ïâ®à ®¦¨¤ « ¢áâà¥â¨âì ¨¬ï ª« áá  ¨«¨ ¨­â¥à䥩á , ­® ¢áâà¥â¨« çâ®-â® ¤à㣮¥. +type_e_type_is_not_completly_defined=04042_E_’¨¯ "$1" ­¥ ®¯à¥¤¥«¥­ ¯®«­®áâìî +% ந室¨â, ¥á«¨ ⨯ ­¥ ®¯à¥¤¥«¥­ ¯®«­®áâìî, ­ ¯à¨¬¥à, í⮠⨯ 㪠§ â¥«ï, ª®â®àë© ãª §ë¢ ¥â +% ­  ­¥®¯à¥¤¥«¥­­ë© ⨯. +type_w_string_too_long=04043_W_‘âப®¢ë© «¨â¥à « ᮤ¥à¦¨â ¡®«ìè¥ á¨¬¢®«®¢, 祬 ¬®¦¥â ¢¬¥áâ¨âì shortstring +% ®¯ë⪠ ¯à¨á¢®¨âì ª®à®âª®© áâப¥ ª®­áâ ­â­®¥ §­ ç¥­¨¥, ª®â®à®¥ ᮤ¥à¦¨â ¡®«ìè¥ á¨¬¢®«®¢, +% 祬 ¬ ªá¨¬ «ì­ ï ¤«¨­  áâப¨. +type_w_signed_unsigned_always_false=04044_W_‘à ¢­¥­¨¥ ¢á¥£¤  «®¦­® ¨§-§  ¤¨ ¯ §®­®¢ §­ ç¥­¨© +% ‘à ¢­¥­¨¥ ¡¥§§­ ª®¢®£® §­ ç¥­¨ï á® §­ ª®¢®© ª®­á⠭⮩, ¬¥­ì襩 ­ã«ï. ¥§ã«ìâ â â ª®£® ¢ëà ¦¥­¨ï +% ¡ã¤¥â ¢á¥£¤  «®¦­ë¬. ‘«¥¤ã¥â ® ¯à¨¢¥á⨠⨯ ª®­áâ ­âë ª ­ã¦­®¬ã ¤¨ ¯ §®­ã. +type_w_signed_unsigned_always_true=04045_W_‘à ¢­¥­¨¥ ¢á¥£¤  ¨á⨭­® ¨§-§  ¤¨ ¯ §®­®¢ §­ ç¥­¨© +% ‘à ¢­¥­¨¥ ¡¥§§­ ª®¢®£® §­ ç¥­¨ï á® §­ ª®¢®© ª®­á⠭⮩, ¬¥­ì襩 ­ã«ï. ¥§ã«ìâ â â ª®£® ¢ëà ¦¥­¨ï +% ¡ã¤¥â ¢á¥£¤  ¨á⨭­ë¬. ‘«¥¤ã¥â ® ¯à¨¢¥á⨠⨯ ª®­áâ ­âë ª ­ã¦­®¬ã ¤¨ ¯ §®­ã. +type_w_instance_with_abstract=04046_W_‘®§¤ ­¨¥ ª« áá  "$1" á  ¡áâà ªâ­ë¬ ¬¥â®¤®¬ "$2" +% ‘®§¤ ¥âáï íª§¥¬¯«ïà ª« áá , ᮤ¥à¦ é¥£® ­¥¯¥à¥ªàëâë©  ¡áâà ªâ­ë© ¬¥â®¤. +% ‚맮¢ â ª®£® ¬¥â®¤  ¢® ¢à¥¬ï ¢ë¯®«­¥­¨ï ¯à®£à ¬¬ë ¯à¨¢¥¤¥â ª ®è¨¡ª¥ 211. +% ‚ᥠ ¡áâà ªâ­ë¥ ¬¥â®¤ë ¤®«¦­ë ¡ëâì ¯¥à¥ªàëâë. +type_h_in_range_check=04047_H_‹¥¢ë© ®¯¥à ­¤ ®¯¥à â®à  IN ¤®«¦¥­ ¨¬¥âì à §¬¥à ¡ ©â  +% ‹¥¢ë© ®¯¥à ­¤ ®¯¥à â®à  \var{in} ­¥ ï¥âáï ¯®à浪®¢ë¬ ¨«¨ ¯¥à¥ç¨á«ï¥¬ë¬ §­ ç¥­¨¥¬, +% ¯®¬¥é î騬áï ¢ 8 ¡¨â, íâ® ¬®¦¥â ¯à¨¢®¤¨âì ª ®è¨¡ª ¬ ¯à®¢¥àª¨ ¤¨ ¯ §®­ . Ž¯¥à â®à \var{in} +% ¢ ­ áâ®ï饥 ¢à¥¬ï ¯®¤¤¥à¦¨¢ ¥â «¥¢ë© ®¯¥à ­¤ ⮫쪮 ¡ ©â®¢®£® ¤¨ ¯ §®­ . ‚ á«ãç ¥ +% ¯¥à¥ç¨á«¥­¨©, à §¬¥à®¬ í«¥¬¥­â®¢ ¯¥à¥ç¨á«¥­¨ï ¬®¦­® ã¯à ¢«ïâì á ¯®¬®éìî +% ª«î祩 \var{\{\$PACKENUM\}} ¨«¨ \var{\{\$Zn\}}. +type_w_smaller_possible_range_check=04048_W_¥á®¢¯ ¤¥­¨¥ à §¬¥à®¢ ⨯®¢, ¢®§¬®¦­  ¯®â¥àï ¤ ­­ëå / ®è¨¡ª¨ ¤¨ ¯ §®­  +% à¨á¢®¥­¨¥ ⨯㠬¥­ì襣® à §¬¥à , 祬 ¨á室­ë© ⨯. â® ¬®¦¥â ¯à¨¢®¤¨âì ª ®è¨¡ª ¬ ¯à®¢¥àª¨ +% ¤¨ ¯ §®­ , ¨«¨ ç áâ¨ç­®© ¯®â¥à¥ ¤ ­­ëå. +type_h_smaller_possible_range_check=04049_H_¥á®¢¯ ¤¥­¨¥ à §¬¥à®¢ ⨯®¢, ¢®§¬®¦­  ¯®â¥àï ¤ ­­ëå / ®è¨¡ª¨ ¤¨ ¯ §®­  +% à¨á¢®¥­¨¥ ⨯㠬¥­ì襣® à §¬¥à , 祬 ¨á室­ë© ⨯. â® ¬®¦¥â ¯à¨¢®¤¨âì ª ®è¨¡ª ¬ ¯à®¢¥àª¨ +% ¤¨ ¯ §®­ , ¨«¨ ç áâ¨ç­®© ¯®â¥à¥ ¤ ­­ëå. +type_e_cant_take_address_of_abstract_method=04050_E_‚§ï⨥  ¤à¥á   ¡áâࠪ⭮£® ¬¥â®¤  ­¥¢®§¬®¦­® +% €¡áâà ªâ­ë© ¬¥â®¤ ­¥ ¨¬¥¥â ⥫ , ¯®íâ®¬ã  ¤à¥á ¡à âì ­¥ ®â 祣®. +type_e_assignment_not_allowed=04051_E_¥¢®§¬®¦­® ¯à¨á¢®¥­¨¥ ä®à¬ «ì­ëå ¯ à ¬¥â஢ ¨ ®âªàëâëå ¬ áᨢ®¢ +% ®¯ë⪠ ¯à¨á¢®¨âì §­ ç¥­¨¥ ä®à¬ «ì­®¬ã (­¥â¨¯¨§¨à®¢ ­­®¬ã var, const ¨«¨ out) +% ¯ à ¬¥âàã, «¨¡® ®âªàë⮬㠬 áᨢã. +type_e_constant_expr_expected=04052_E_Ž¦¨¤ ¥âáï ª®­áâ ­â­®¥ ¢ëà ¦¥­¨¥ +% Š®¬¯¨«ïâ®à ®¦¨¤ ¥â ª®­áâ ­â­®¥ ¢ëà ¦¥­¨¥, ­® ¯®«ã砥⠯¥à¥¬¥­­®¥. +type_e_operator_not_supported_for_types=04053_E_Ž¯¥à æ¨ï "$1" ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ¤«ï ⨯®¢ "$2" ¨ "$3" +% “ª § ­­ ï ®¯¥à æ¨ï ­¥¤®¯ãá⨬  ¤«ï 㪠§ ­­ëå ⨯®¢. +type_e_illegal_type_conversion=04054_E_¥¤®¯ãá⨬®¥ ¯à¨¢¥¤¥­¨¥ ⨯®¢: "$1" ª "$2" +% ਠ¯à¨¢¥¤¥­¨¨ ⨯®¢ á«¥¤ã¥â ᮡ«î¤ âì à ¢¥­á⢮ à §¬¥à®¢ ¨áâ®ç­¨ª  ¨ ¯®«ãç â¥«ï. +type_h_pointer_to_longint_conv_not_portable=04055_H_८¡à §®¢ ­¨¥ ¬¥¦¤ã ¯®à浪®¢ë¬¨ ⨯ ¬¨ ¨ 㪠§ â¥«ï¬¨ ï¥âáï ­¥¯®àâ¨àã¥¬ë¬ +% Š®¤, ¢ ª®â®à®¬ 㪠§ â¥«¨ ¯à¨¢®¤ïâáï ª longint (¨«¨ ­ ®¡®à®â), ­¥ ¡ã¤¥â à ¡®â âì +% ­  ¯« âä®à¬ å, ã ª®â®àëå à §¬¥à 㪠§ â¥«ï à ¢¥­ 64 ¡¨â ¬. +type_w_pointer_to_longint_conv_not_portable=04056_W_८¡à §®¢ ­¨¥ ¬¥¦¤ã ¯®à浪®¢ë¬¨ ⨯ ¬¨ ¨ 㪠§ â¥«ï¬¨ ï¥âáï ­¥¯®àâ¨àã¥¬ë¬ +% ਢ¥¤¥­¨¥ 㪠§ â¥«¥© ª ¯®à浪®¢ë¬ ⨯ ¬ ¤à㣮£® à §¬¥à  (¨«¨ ­ ®¡®à®â), ¬®¦¥â +% ¢ë§ë¢ âì ¯à®¡«¥¬ë. â® ¯à¥¤ã¯à¥¦¤¥­¨¥ ¯®¬®£ ¥â ­ å®¤¨âì ᯥæ¨ä¨ç­ë© 32-¡¨â­ë© ª®¤, ¢ ª®â®à®¬ +% ⨯ longint/cardinal ¨á¯®«ì§ã¥âáï ¢§ ¨¬®§ ¬¥­ï¥¬® á 㪠§ â¥«ï¬¨. ¥è¥­¨¥ § ª«îç ¥âáï ¢ ¨á¯®«ì§®¢ ­¨¨ +% ⨯®¢ ptrint/ptruint. +type_e_cant_choose_overload_function=04057_E_¥¢®§¬®¦­® ®¯à¥¤¥«¨âì, ª®â®àãî ¨§ ¯¥à¥£à㦥­­ëå ä㭪樨 ¢ë§ë¢ âì +% ‚맮¢ ¯¥à¥£à㦥­­®© ä㭪樨 ᮠᯨ᪮¬ ¯ à ¬¥â஢, ª®â®àë© ­¥ ᮮ⢥âáâ¢ã¥â ­¨ +% ®¤­®© ¨§ ®¡ê¥­­ëå ä㭪権.  ¯à¨¬¥à, ¥á«¨ ®¡ê¥­ë ä㭪樨 á ¯ à ¬¥âà ¬¨ +% ⨯  \var{word} ¨ \var{longint},   ¢ë§®¢ ¯à®¨§¢®¤¨âáï á ¯ à ¬¥â஬ ⨯  +% \var{integer}. +type_e_illegal_count_var=04058_E_¥¢¥à­ ï ¯¥à¥¬¥­­ ï áç¥â稪  +% ’¨¯ ¯¥à¥¬¥­­®© ¤«ï 横«  \var{for} ¤®«¦¥­ ¡ëâì ¯®à浪®¢ë¬. +% ‚¥é¥á⢥­­ë¥ ¨ áâப®¢ë¥ â¨¯ë ­¥ ¤®¯ã᪠îâáï. +type_w_double_c_varargs=04059_W_‚¥é¥á⢥­­ ï ª®­áâ ­â  ¯à¥®¡à §®¢ ­  ¢ double ¤«ï ä-樨 C á ¯¥à¥¬¥­­ë¬ ç¨á«®¬ ¯ à ¬¥â஢ +% ‚ ï§ëª¥ C ¢¥é¥á⢥­­ë¥ ª®­áâ ­âë ¯® 㬮«ç ­¨î ¨¬¥îâ ⨯ double. ®í⮬㠯ਠ¯¥à¥¤ ç¥ +% ¢¥é¥á⢥­­®© ª®­áâ ­âë ¢ äã­ªæ¨î ­  C á ¯¥à¥¬¥­­ë¬ ç¨á«®¬  à£ã¬¥­â®¢ FPC +% ¯® 㬮«ç ­¨î ¯à¥®¡à §ã¥â ¥¥ ¢ double. …᫨ íâ® ¯®¢¥¤¥­¨¥ ­¥¦¥« â¥«ì­®, +% ¯à¨¢¥¤¨â¥ ª®­áâ ­âã ª ­ã¦­®¬ã ⨯ã ®. +type_e_class_or_cominterface_type_expected=04060_E_Ž¦¨¤ ¥âáï ⨯ ª« áá  ¨«¨ COM-¨­â¥à䥩á , ­® ¯®«ã祭® "$1" +% ¥ª®â®àë¥ ®¯¥à â®àë, â ª¨¥ ª ª AS, ¯à¨¬¥­¨¬ë ⮫쪮 ª ª« áá ¬ ¨«¨ COM-¨­â¥à䥩ᠬ. +type_e_no_const_packed_array=04061_E_Š®­áâ ­â­ë¥ 㯠ª®¢ ­­ë¥ ¬ áá¨¢ë ¯®ª  ­¥ ¯®¤¤¥à¦¨¢ îâáï +% ¥«ì§ï ®¡êâì ª®­áâ ­âã ⨯  (¯®¡¨â­®)㯠ª®¢ ­­ë© ¬ áᨢ. +type_e_got_expected_packed_array=04062_E_¥á®¢¯ ¤¥­¨¥ ⨯   à£ã¬¥­â  no. $1: ®«ã祭® "$2" ®¦¨¤ «®áì "(Bit)Packed Array" +% Š®¬¯¨«ïâ®à ®¦¨¤ ¥â (¯®¡¨â­®)㯠ª®¢ ­­ë© ¬ áᨢ ¢ ª ç¥á⢥ 㪠§ ­­®£® ¯ à ¬¥âà . +type_e_got_expected_unpacked_array=04063_E_¥á®¢¯ ¤¥­¨¥ ⨯   à£ã¬¥­â  no. $1: ®«ã祭® "$2" ®¦¨¤ «®áì "(not packed) Array" +% Š®¬¯¨«ïâ®à ®¦¨¤ ¥â ®¡ëç­ë© (­¥ã¯ ª®¢ ­­ë©) ¬ áᨢ ¢ ª ç¥á⢥ 㪠§ ­­®£® ¯ à ¬¥âà . +type_e_no_packed_inittable=04064_E_«¥¬¥­âë 㯠ª®¢ ­­®£® ¬ áᨢ  ­¥ ¬®£ãâ ¨¬¥âì ⨯, âॡãî騩 ¨­¨æ¨ «¨§ æ¨¨ +% “¯ ª®¢ ­­ë¥ ¬ áᨢë á ⨯ ¬¨, âॡãî騬¨ ¨­¨æ¨ «¨§ æ¨î (â ª¨¬¨ ª ª ansistring, ¨«¨ § ¯¨á¨, ᮤ¥à¦ é¨¥ +% ansistring), ¯®ª  ­¥ ¯®¤¤¥à¦¨¢ îâáï. +type_e_no_const_packed_record=04065_E_Š®­áâ ­â­ë¥ 㯠ª®¢ ­­ë¥ § ¯¨á¨ ¨ ®¡ê¥ªâë ¯®ª  ­¥ ¯®¤¤¥à¦¨¢ îâáï +% ‚ ­ áâ®ï饥 ¢à¥¬ï ­¥«ì§ï ®¡êâì ª®­áâ ­âã ⨯  (¯®¡¨â­®)㯠ª®¢ ­­ ï § ¯¨áì/®¡ê¥ªâ. +type_w_untyped_arithmetic_unportable=04066_W_€à¨ä¬¥â¨ª  "$1" ­¥â¨¯¨§¨à®¢ ­­ëå 㪠§ â¥«¥© ­¥á®¢¬¥á⨬  á ०¨¬®¬ {$T+}, ¯à¥¤« £ ¥âáï ¯à¨¢¥¤¥­¨¥ ⨯  +% ‘«®¦¥­¨¥/¢ëç¨â ­¨¥ ­¥â¨¯¨§¨à®¢ ­­ëå 㪠§ â¥«¥© ¬®¦¥â à ¡®â âì ¯®-¤à㣮¬ã ¢ ०¨¬¥ \var{\{\$T+\}}, +% ¯à¨¢¥¤¨â¥ ⨯ ª ⨯¨§¨à®¢ ­­®¬ã 㪠§ â¥«î. +type_e_cant_take_address_of_local_subroutine=04076_E_¥«ì§ï ¢§ïâì  ¤à¥á ¯à®æ¥¤ãàë, ¯®¬¥ç¥­­®© ª ª «®ª «ì­ ï +% ‚§ï⨥  ¤à¥á  ¯à®æ¥¤ãàë, ¯®¬¥ç¥­­®© ª ª «®ª «ì­ ï, ­¥¢®§¬®¦­®. +type_e_cant_export_local=04077_E_à®æ¥¤ãà , ®â¬¥ç¥­­ ï ª ª «®ª «ì­ ï, ­¥ ¬®¦¥â ¡ëâì íªá¯®àâ¨à®¢ ­  ¨§ ¬®¤ã«ï +% à®æ¥¤ãà , ®â¬¥ç¥­­ ï ª ª «®ª «ì­ ï, ­¥ ¬®¦¥â ¡ëâì íªá¯®àâ¨à®¢ ­  ¨§ ¬®¤ã«ï. +type_e_not_automatable=04078_E_’¨¯ ­¥  ¢â®¬ â¨§¨à㥬ë©: "$1" +% ‚ ª ç¥á⢥  ¢â®¬ â¨§¨à®¢ ­­ëå ¤®¯ã᪠îâáï byte, integer, longint, smallint, currency, single, double, +% ansistring, widestring, tdatetime, variant, olevariant, wordbool ¨ ¢á¥ ¨­â¥à䥩á­ë¥ ⨯ë. +type_h_convert_add_operands_to_prevent_overflow=04079_H_ਢ¥¤¥­¨¥ ®¯¥à ­¤®¢ ª "$1" ¯¥à¥¤ á«®¦¥­¨¥¬ ¯à¥¤®â¢à â¨â ®è¨¡ª¨ ¯¥à¥¯®«­¥­¨ï. +% ‘«®¦¥­¨¥ ¬®¦¥â ¢ë§ë¢ âì ¯¥à¥¯®«­¥­¨¥. ’.ª. १ã«ìâ â ¯à¥®¡à §ã¥âáï ¢ ⨯ ¡®«ì襣® à §¬¥à , +% ¯¥à¥¯®«­¥­¨ï ¬®¦­® ¨§¡¥¦ âì, ¯à¨¢¥¤ï ®¯¥à ­¤ë ª ⨯ã १ã«ìâ â  ¯¥à¥¤ á«®¦¥­¨¥¬. +type_h_convert_sub_operands_to_prevent_overflow=04080_H_ਢ¥¤¥­¨¥ ®¯¥à ­¤®¢ ª "$1" ¯¥à¥¤ ¢ëç¨â ­¨¥¬ ¯à¥¤®â¢à â¨â ®è¨¡ª¨ ¯¥à¥¯®«­¥­¨ï. +% ‚ëç¨â ­¨¥ ¬®¦¥â ¢ë§ë¢ âì ¯¥à¥¯®«­¥­¨¥. ’.ª. १ã«ìâ â ¯à¥®¡à §ã¥âáï ¢ ⨯ ¡®«ì襣® à §¬¥à , +% ¯¥à¥¯®«­¥­¨ï ¬®¦­® ¨§¡¥¦ âì, ¯à¨¢¥¤ï ®¯¥à ­¤ë ª ⨯ã १ã«ìâ â  ¯¥à¥¤ ¢ëç¨â ­¨¥¬. +type_h_convert_mul_operands_to_prevent_overflow=04081_H_ਢ¥¤¥­¨¥ ®¯¥à ­¤®¢ ª "$1" ¯¥à¥¤ 㬭®¦¥­¨¥¬ ¯à¥¤®â¢à â¨â ®è¨¡ª¨ ¯¥à¥¯®«­¥­¨ï. +% “¬­®¦¥­¨¥ ¬®¦¥â ¢ë§ë¢ âì ¯¥à¥¯®«­¥­¨¥. ’.ª. १ã«ìâ â ¯à¥®¡à §ã¥âáï ¢ ⨯ ¡®«ì襣® à §¬¥à , +% ¯¥à¥¯®«­¥­¨ï ¬®¦­® ¨§¡¥¦ âì, ¯à¨¢¥¤ï ®¯¥à ­¤ë ª ⨯ã १ã«ìâ â  ¯¥à¥¤ 㬭®¦¥­¨¥¬. +type_w_pointer_to_signed=04082_W_ਢ¥¤¥­¨¥ 㪠§ â¥«¥© ª æ¥«ë¬ á® §­ ª®¬ ¬®¦¥â ¯à¨¢®¤¨âì ª ®è¨¡ª ¬ áà ¢­¥­¨ï ¨ ¢ë室㠧  ¤¨ ¯ §®­, ¨á¯®«ì§ã©â¥ ¡¥§§­ ª®¢ë© ⨯. +% ‚¨àâã «ì­®¥  ¤à¥á­®¥ ¯à®áâà ­á⢮ ­  32-¡¨â­ëå á¨á⥬ å ¨¬¥¥â ¤¨ ¯ §®­ ®â \$00000000 ¤® \$ffffffff. +% Œ­®£¨¥ ®¯¥à æ¨®­­ë¥ á¨áâ¥¬ë ¯®§¢®«ïî⠢뤥«ïâì ¯ ¬ïâì á¢ëè¥ \$80000000, ­ ¯à¨¬¥à, Windows ¨ Linux +% ¤®¯ã᪠îâ 㪠§ â¥«¨ ¢ ¤¨ ¯ §®­¥ ®â \$0000000 ¤® \$bfffffff. …᫨ ¯à¨¢®¤¨âì 㪠§ â¥«¨ ª §­ ª®¢ë¬ ⨯ ¬, +% ¬®£ãâ ¢®§­¨ª âì ®è¨¡ª¨ ¯¥à¥¯®«­¥­¨ï ¨ ¤¨ ¯ §®­ , ªà®¬¥ ⮣®, \$80000000 < \$7fffffff. +% â® ¬®¦¥â ¢ë§ë¢ âì á«ãç ©­ë¥ ®è¨¡ª¨ ¢ ª®¤¥ ­ ¯®¤®¡¨¥ "if p>q". +type_interface_has_no_guid=04083_E_’¨¯ ¨­â¥àä¥©á  $1 ­¥ ¨¬¥¥â GUID +% ਠ¨á¯®«ì§®¢ ­¨¨ ®¯¥à â®à  as ­ã¦­ë© ¨­â¥à䥩á, â.¥ ¯à ¢ë© ®¯¥à ­¤ ®¯¥à â®à  as, +% ¤®«¦¥­ ¨¬¥âì ¯à ¢¨«ì­ë© GUID. +type_e_invalid_objc_selector_name=04084_E_¥¢¥à­®¥ ¨¬ï ᥫ¥ªâ®à  +% ‘¥«¥ªâ®à Objective-C ­¥ ¬®¦¥â ¡ëâì ¯ãáâë¬, ®­ ¤®«¦¥­ ¡ëâì ¨¤¥­â¨ä¨ª â®à®¬ «¨¡® ®¤¨­®ç­ë¬ ¤¢®¥â®ç¨¥¬, +% ¨, ¥á«¨ ®­ ᮤ¥à¦¨â ¤¢®¥â®ç¨¥, â® ¤®«¦¥­ ¤¢®¥â®ç¨¥¬ ¨ § ª ­ç¨¢ âìáï. +type_e_expected_objc_method_but_got=04085_E_Ž¦¨¤ ¥âáï ¬¥â®¤ Objective-C, ­® ¯®«ã祭® $1 +% ‘¥«¥ªâ®à ¬®¦¥â ¡ëâì ᮧ¤ ­ ⮫쪮 ¤«ï ¬¥â®¤®¢ Objective-C, ­¨ª ª®© ¤à㣮© ⨯ +% ¯à®æ¥¤ãà/ä㭪権/¬¥â®¤®¢ ­¥ ¤®¯ãá⨬. +type_e_expected_objc_method=04086_E_Ž¦¨¤ ¥âáï ¬¥â®¤ Objective-C ¨«¨ ª®­áâ ­â­®¥ ¨¬ï ¬¥â®¤  +% ‘¥«¥ªâ®à ¬®¦¥â ¡ëâì ᮧ¤ ­ ⮫쪮 ¤«ï ¬¥â®¤®¢ Objective-C, «¨¡® ¯ã⥬ 㪠§ ­¨ï ¨¬¥­¨ +% ¢ ¢¨¤¥ áâப®¢®© ª®­áâ ­âë, «¨¡® á ¨á¯®«ì§®¢ ­¨ï ¨¤¥­â¨ä¨ª â®à  ¬¥â®¤  Objective-C, +% ¤¥©á⢨⥫쭮£® ¢ ⥪ã饩 ®¡« á⨠¢¨¤¨¬®áâ¨. +type_e_no_type_info=04087_E_ˆ­ä®à¬ æ¨ï ® ⨯¥ ­¥¤®áâ㯭  ¤«ï í⮣® ⨯  +% ˆ­ä®à¬ æ¨ï ® ⨯¥ ­¥ £¥­¥à¨àã¥âáï ¤«ï ­¥ª®â®àëå ⨯®¢, â ª¨å ª ª ¯¥à¥ç¨á«¥­¨ï á à §à뢠¬¨ +% ¢ ¤¨ ¯ §®­¥ §­ ç¥­¨© (¢ª«îç ï ¯¥à¥ç¨á«¥­¨ï, ã ª®â®àëå ­¨¦­ïï £à ­¨æ  ¤¨ ¯ §®­  ®â«¨ç ¥âáï ®â +% ­ã«ï). +type_e_ordinal_or_string_expr_expected=04088_E_’ॡã¥âáï ¢ëà ¦¥­¨¥ ¯®à浪®¢®£® ¨«¨ áâப®¢®£® ⨯  +% ‚ëà ¦¥­¨¥ ¤®«¦­® ¨¬¥âì ¯®à浪®¢ë© ¨«¨ áâப®¢ë© ⨯. +type_e_string_expr_expected=04089_E_’ॡã¥âáï áâப®¢®¥ ¢ëà ¦¥­¨¥ +% ‚ëà ¦¥­¨¥ ¤®«¦­® ¨¬¥âì áâப®¢ë© ⨯. +% \end{description} +# +# Symtable +# +# 05064 is the last used one +# +% \section{Symbol handling} +% „ ­­ë© à §¤¥« ᮤ¥à¦¨â á®®¡é¥­¨ï, ®â­®áï騥áï ª ®¡à ¡®âª¥ ᨬ¢®«®¢, +% â.¥. ¢á¥£®, çâ® á¢ï§ ­® á ¨¬¥­ ¬¨ ¯à®æ¥¤ãà ¨ ¯¥à¥¬¥­­ëå. +% \begin{description} +sym_e_id_not_found=05000_E_ˆ¤¥­â¨ä¨ª â®p "$1" ­¥ ­ ©¤¥­ +% „ ­­ë© ᨬ¢®« ­¥¨§¢¥á⥭ ª®¬¯¨«ïâ®àã. Ž¡ëç­® ¯à®¨á室¨â ¯à¨ ®è¨¡ª å ­ ¯¨á ­¨ï +% ¨¬¥­¨ ¯¥à¥¬¥­­®© ¨«¨ ¯à®æ¥¤ãàë, ¨«¨ ¥á«¨ ¢ë § ¡ë«¨ ®¡êâì +% ¯¥à¥¬¥­­ãî. +sym_f_internal_error_in_symtablestack=05001_F_‚­yâp¥­­ïï ®è¨¡ª  ¢ SymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_ˆ¤¥­â¨ä¨ª â®p "$1" ¯®¢â®àï¥âáï +% “ª § ­­ë© ¨¤¥­â¨ä¨ª â®à 㦥 ¡ë« ®¡ê¥­ ¢ ⥪ã饩 ®¡« áâ¨. +sym_h_duplicate_id_where=05003_H_ˆ¤¥­â¨ä¨ª â®p y¦¥ ®¯p¥¤¥«¥­ ¢ $1 (áâp®ª  $2) +% ˆ¤¥­â¨ä¨ª â®à 㦥 ¡ë« ®¡ê¥­ ¢ 㪠§ ­­®© ®¡« áâ¨. +sym_e_unknown_id=05004_E_H¥¨§¢¥áâ­ë© ¨¤¥­â¨ä¨ª â®p "$1" +% “ª § ­­ë© ¨¤¥­â¨ä¨ª â®à ­¥ ¡ë« ®¡ê¥­, «¨¡® ¨á¯®«ì§ã¥âáï §  ¯à¥¤¥« ¬¨ +% ®¡« áâ¨, ¤«ï ª®â®à®© ®­ ¡ë« ®¯à¥¤¥«¥­. +sym_e_forward_not_resolved=05005_E_Žâáãâáâ¢ã¥â ॠ«¨§ æ¨ï ¯à®æ¥¤ãàë ¨«¨ ¬¥â®¤  "$1" +% Œ®¦¥â ¯à®¨á室¨âì ¢ ¤¢ãå á«ãç ïå: +% \begin{itemize} +% \item …᫨ äã­ªæ¨ï ®¡ê¥­  (¢ ᥪ樨 \var{interface}, «¨¡® +% á ¤¨à¥ªâ¨¢®© \var{forward}, ­® ­¥ ॠ«¨§®¢ ­ . +% \item ਠáá뫪¥ ­  ⨯, ª®â®àë© ­¥ ®¡ê¥­ ¢ ⥪ã饬 ¡«®ª¥ \var{type}. +% \end{itemize} +sym_e_error_in_type_def=05007_E_Žè¨¡ª  ¢ ®¯p¥¤¥«¥­¨¨ ⨯  +% Žè¨¡ª  ¯à¨ ®¯à¥¤¥«¥­¨¨ ­®¢®£® ⨯  ¬ áᨢ : +% \item Ž¤­  ¨§ £à ­¨æ ¤¨ ¯ §®­  ï¥âáï ®è¨¡®ç­®©. +%  ¯à¨¬¥à, \var{Array [1..1.25]} ¢ë§®¢¥â ¤ ­­ãî ®è¨¡ªã. +sym_e_forward_type_not_resolved=05009_E_ ­­¥¥ ®¡ê¥­¨¥ ⨯  "$1" ­¥ à¥è¥­® +% ‘¨¬¢®« ¡ë« ®¡ê¥­ § à ­¥¥, ­® ®¯à¥¤¥«¥­¨¥ ¤«ï ­¥£® ­¥ ¡ë«® ®¡­ à㦥­®. +sym_e_only_static_in_static=05010_E_’®«ìª® áâ â¨ç¥áª¨¥ ¯¥à¥¬¥­­ë¥ ¬®£ã⠨ᯮ«ì§®¢ âìáï ¢ áâ â¨ç¥áª¨å ¬¥â®¤ å ¨«¨ ¢­¥ ¬¥â®¤®¢ +% ‘â â¨ç¥áª¨© ¬¥â®¤ ®¡ê¥ªâ  ¨¬¥¥â ¤®áâ㯠⮫쪮 ª áâ â¨ç¥áª¨¬ ¯¥à¥¬¥­­ë¬. +sym_f_type_must_be_rec_or_class=05012_F_Ž¦¨¤ ¥âáï ⨯ record ¨«¨ class +% ¥à¥¬¥­­ ï ¨«¨ ¢ëà ¦¥­¨¥ ¨¬¥¥â ⨯, ®â«¨ç­ë© ®â \var{record} ¨«¨ \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_ª§¥¬¯«ïàë ª« áᮢ ¨«¨ ®¡ê¥ªâ®¢ á  ¡áâp ªâ­ë¬ ¬¥â®¤®¬ ­¥ ¤®¯ã᪠îâáï +% ®¯ë⪠ ᮧ¤ âì íª§¥¬¯«ïà ª« áá  á  ¡áâà ªâ­ë¬ ¬¥â®¤®¬, ª®â®àë© ­¥ ¡ë« ¯¥à¥ªàëâ. +sym_w_label_not_defined=05014_W_Œ¥âª  "$1" ­¥ ®¯p¥¤¥«¥­  +% Œ¥âª  ¡ë«  ®¡ê¥­ , ­® ­¥ ¡ë«  ®¯à¥¤¥«¥­ . +sym_e_label_used_and_not_defined=05015_E_Œ¥âª  "$1" ¨á¯®«ì§ã¥âáï, ­® ­¥ ®¯à¥¤¥«¥­  +% Œ¥âª  ¡ë«  ®¡ê¥­  ¨ ¨á¯®«ì§®¢ ­ , ­® ­¥ ¡ë«  ®¯à¥¤¥«¥­ . +sym_e_ill_label_decl=05016_E_H¥¢¥p­®¥ ®¡ê¥­¨¥ ¬¥âª¨ +% நá室¨â, ¥á«¨ ¬¥âª  ®¡ê¥­  ¢­¥ ¯à®æ¥¤ãàë ¨«¨ ä㭪樨; í⮣® ­¨ª®£¤  +% ­¥ ¤®«¦­® á«ãç âìáï. +sym_e_goto_and_label_not_supported=05017_E_GOTO ¨ LABEL ­¥ ¯®¤¤¥p¦¨¢ îâáï (¨á¯®«ì§y©â¥ ª«îç -Sg) +% ணࠬ¬ã, ᮤ¥à¦ éãî ¬¥âª¨ ¨ ¯¥à¥å®¤ë \var{goto}, ­¥®¡å®¤¨¬® ª®¬¯¨«¨à®¢ âì +% á ª«î箬 \var{-Sg}. ® 㬮«ç ­¨î, ¬¥âª¨ ¨ ¯¥à¥å®¤ë ­¥ ¯®¤¤¥à¦¨¢ îâáï. +sym_e_label_not_found=05018_E_Œ¥âª  ­¥ ­ ©¤¥­  +% ‚áâà¥â¨«®áì \var{goto label}, ­® ¬¥âª  ­¥ ¡ë«  ®¡ê¥­ . +sym_e_id_is_no_label_id=05019_E_ˆ¤¥­â¨ä¨ª â®p ­¥ ï¥âáï ¬¥âª®© +% ˆ¤¥­â¨ä¨ª â®à, á«¥¤ãî騩 §  \var{goto}, ­¥ ¨¬¥¥â ⨯ ¬¥âª¨. +sym_e_label_already_defined=05020_E_®¢â®p­®¥ ®¯p¥¤¥«¥­¨¥ ¬¥âª¨ +% ®¯ë⪠ ®¯à¥¤¥«¨âì ¬¥âªã ¤¢ ¦¤ë. Œ¥âª  ¬®¦¥â ¡ëâì ®¯à¥¤¥«¥­  ⮫쪮 ®¤¨­ à §. +sym_e_ill_type_decl_set=05021_E_¥¢¥p­®¥ ®¡ê¥­¨¥ ⨯  í«¥¬¥­â®¢ ¬­®¦¥á⢠ +% Ž¡ê¥­¨¥ ¬­®¦¥á⢠ ᮤ¥à¦¨â ­¥¤®¯ãá⨬®¥ ®¯à¥¤¥«¥­¨¥ ⨯ . +sym_e_class_forward_not_resolved=05022_E_ ­¥¥ ®¡ê¥­¨¥ ª« áá  "$1" ­¥ à¥è¥­® +% Š« áá ¡ë« ®¡ê¥­, ­® ­¥ ¡ë« ॠ«¨§®¢ ­. +sym_n_unit_not_used=05023_H_Œ®¤ã«ì "$1" ­¥ ¨á¯®«ì§ã¥âáï ¢ $2 +% Œ®¤ã«ì, 㪠§ ­­ë© ¢ ᥪ樨 \var{uses}, ­¥ ¨á¯®«ì§ã¥âáï. +sym_h_para_identifier_not_used=05024_H_ p ¬¥âp "$1" ­¥ ¨á¯®«ì§y¥âáï +% ˆ¤¥­â¨ä¨ª â®à ¡ë« ®¡ê¥­ («®ª «ì­® ¨«¨ £«®¡ «ì­®), ­® +% ­¥ ¡ë« ¨á¯®«ì§®¢ ­. +sym_n_local_identifier_not_used=05025_N_‹®ª «ì­ ï ¯¥p¥¬¥­­ ï "$1" ­¥ ¨á¯®«ì§y¥âáï +% ¥à¥¬¥­­ ï ®¡ê¥­ , ­® ­¥ ¨á¯®«ì§®¢ ­  ¢ ॠ«¨§ æ¨¨ ¯à®æ¥¤ãàë +% ¨«¨ ä㭪樨. +sym_h_para_identifier_only_set=05026_H_ à ¬¥âà-§­ ç¥­¨¥ "$1" ¯à¨á¢®¥­, ­® ­¥ ¨á¯®«ì§®¢ ­ +%  à ¬¥âàã ¯à¨á¢®¥­® §­ ç¥­¨¥, ª®â®à®¥ ¢ ¤ «ì­¥©è¥¬ ­¨£¤¥ ­¥ ¨á¯®«ì§ã¥âáï. +sym_n_local_identifier_only_set=05027_N_‹®ª «ì­ ï ¯¥à¥¬¥­­ ï "$1" ¯à¨á¢®¥­ , ­® ­¥ ¨á¯®«ì§®¢ ­  +% ‹®ª «ì­®© ¯¥à¥¬¥­­®© ¯à¨á¢®¥­® §­ ç¥­¨¥, ª®â®à®¥ ¢ ¤ «ì­¥©è¥¬ ­¨£¤¥ ­¥ ¨á¯®«ì§ã¥âáï. +sym_h_local_symbol_not_used=05028_H_‹®ª «ì­ë© ᨬ¢®« $1 "$2" ­¥ ¨á¯®«ì§ã¥âáï +% ‹®ª «ì­ë© ᨬ¢®« ­¥ ¨á¯®«ì§ã¥âáï. +sym_n_private_identifier_not_used=05029_N_Private ¯®«¥ "$1.$2" ­¥ ¨á¯®«ì§ã¥âáï +% “ª § ­­®¥ private ¯®«¥ ®¯à¥¤¥«¥­®, ­® ­¥ ¨á¯®«ì§ã¥âáï ­¨£¤¥ ¢ ª®¤¥. +sym_n_private_identifier_only_set=05030_N_Private ¯®«¥ "$1.$2" ¯à¨á¢®¥­®, ­® ­¥ ¨á¯®«ì§®¢ ­® +% “ª § ­­®¥ private ¯®«¥ ®¯à¥¤¥«¥­® ¨ ¥¬ã ¯à¨á¢®¥­® §­ ç¥­¨¥, ª®â®à®¥ ­¨£¤¥ ­¥ ç¨â ¥âáï. +sym_n_private_method_not_used=05031_N_Private ¬¥â®¤ "$1.$2" ­¥ ¨á¯®«ì§ã¥âáï +% “ª § ­­ë© private ¬¥â®¤ ®¯à¥¤¥«¥­, ­® ­¥ ¨á¯®«ì§ã¥âáï ­¨£¤¥ ¢ ª®¤¥. +sym_e_set_expected=05032_E_Ž¦¨¤ ¥âáï ⨯ ¬­®¦¥á⢠ +% ¥à¥¬¥­­ ï ¨«¨ ¢ëà ¦¥­¨¥ ¨¬¥¥â ⨯, ®â«¨ç­ë© ®â \var{set}. â® á«ãç ¥âáï ¢ +% ¢ëà ¦¥­¨ïå \var{in}. +sym_w_function_result_not_set=05033_W_¥§y«ìâ â äy­ªæ¨¨, ¢®§¬®¦­®, ­¥ ¯à¨á¢®¥­ +% ।ã¯à¥¦¤¥­¨¥ ¢ë¤ ¥âáï, ¥á«¨ ª®¬¯¨«ïâ®à ¯®« £ ¥â, ç⮠१ã«ìâ â, ¢®§¢à é ¥¬ë© ä㭪樥©, +% ­¥ ¯à¨á¢®¥­. …᫨ äã­ªæ¨ï ­ ¯¨á ­  ­   áᥬ¡«¥à¥, ¨«¨ ᮤ¥à¦¨â  áᥬ¡«¥à­ë© ¡«®ª, +% ¯à¥¤ã¯à¥¦¤¥­¨¥ ­¥ ¢ë¤ ¥âáï. +sym_w_wrong_C_pack=05034_W_’¨¯ "$1" ­¥ª®à४⭮ ¢ë஢­¥­ ¢ ⥪ã饩 § ¯¨á¨ ¤«ï ï§ëª  C +% Œ áᨢë á à §¬¥à ¬¨, ­¥ ªà â­ë¬¨ 4, ¡ã¤ãâ ­¥¢¥à­® ¢ë஢­¥­ë ¢ áâàãªâãà å ï§ëª  C. +sym_e_illegal_field=05035_E_H¥¨§¢¥áâ­®¥ ¯®«¥ § ¯¨á¨ "$1" +% “ª § ­­®¥ ¯®«¥ ®âáãâáâ¢ã¥â ¢ ®¯à¥¤¥«¥­¨¨ § ¯¨á¨. +sym_w_uninitialized_local_variable=05036_W_‹®ª «ì­ ï ¯¥p¥¬¥­­ ï "$1" ­¥ ¨­¨æ¨ «¨§¨p®¢ ­  +% ‘®®¡é¥­¨¥ ¢ë¤ ¥âáï, ª®£¤  ª®¬¯¨«ïâ®à áç¨â ¥â, çâ® «®ª «ì­ ï ¯¥à¥¬¥­­ ï ¡ã¤¥â +% ¨á¯®«ì§®¢ ­  (â.¥. ¢áâà¥â¨« áì ¢ ¯à ¢®© ç á⨠¢ëà ¦¥­¨ï), ­® ­¥ ¡ë«  +% ¨­¨æ¨ «¨§¨à®¢ ­  (â.¥. ­¥ ¯®ï¢«ï« áì à ­¥¥ ¢ «¥¢®© ç á⨠¯à¨á¢ ¨¢ ­¨ï). +sym_w_uninitialized_variable=05037_W_¥p¥¬¥­­ ï "$1" ­¥ ¨­¨æ¨ «¨§¨p®¢ ­  +% ‘®®¡é¥­¨¥ ¢ë¤ ¥âáï, ª®£¤  ª®¬¯¨«ïâ®à áç¨â ¥â, çâ® ¯¥à¥¬¥­­ ï ¡ã¤¥â ¨á¯®«ì§®¢ ­  +% (â.¥. ¢áâà¥â¨« áì ¢ ¯à ¢®© ç á⨠¢ëà ¦¥­¨ï), ­® ­¥ ¡ë«  ¨­¨æ¨ «¨§¨à®¢ ­  (â.¥. +% ­¥ ¯®ï¢«ï« áì à ­¥¥ ¢ «¥¢®© ç á⨠¯à¨á¢ ¨¢ ­¨ï). +sym_e_id_no_member=05038_E_ˆ¤¥­â¨ä¨ª â®p ­¥ ®¯à¥¤¥«ï¥â í«¥¬¥­â "$1" +% ‘®®¡é¥­¨¥ ¢ë¤ ¥âáï ¯à¨ ¯®¯ë⪥ ¤®áâ㯠 ª ­¥®¯à¥¤¥«¥­­®¬ã ¯®«î § ¯¨á¨ +% ¨«¨ ®¡ê¥ªâ , «¨¡® ¬¥â®¤ã. +sym_h_param_list=05039_H_H ©¤¥­® ®¯p¥¤¥«¥­¨¥: $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vh}, ¥á«¨ ­¥ ­ ©¤¥­  ¯¥à¥£à㦥­­ ï ¯à®æ¥¤ãà , +% ¯¥à¥ç¨á«ïîâáï ¢á¥ ¯®¤å®¤ï騥 ¯¥à¥£à㦥­­ë¥ ¯à®æ¥¤ãàë ¨ ᯨ᪨ ¨å +% ¯ à ¬¥â஢. +sym_e_segment_too_large=05040_E_‘«¨èª®¬ ¡®«ì让 í«¥¬¥­â ¤ ­­ëå +% ‚뤠¥âáï ¯à¨ ¯®¯ë⪥ ®¡êâì í«¥¬¥­â ¤ ­­ëå, à §¬¥à ª®â®à®£® ¯à¥¢ëè ¥â +% ãáâ ­®¢«¥­­ë© ¯à¥¤¥« (2 ƒ ¤«ï ¯à®æ¥áá®à®¢ 80386+/68020+) +sym_e_no_matching_implementation_found=05042_E_¥ ­ ©¤¥­  ¯®¤å®¤ïé ï ॠ«¨§ æ¨ï ¬¥â®¤  ¨­â¥àä¥©á  "$1" +% ¥ ­ ©¤¥­ ¬¥â®¤, ª®â®àë© ¬®£ ¡ë ॠ«¨§®¢ âì 㪠§ ­­ë© ¬¥â®¤ ¨­â¥à䥩á . +% ஢¥àìâ¥ â¨¯ë  à£ã¬¥­â®¢ ¨ â¨¯ë ¢®§¢à é ¥¬ëå §­ ç¥­¨©. +sym_w_deprecated_symbol=05043_W_‘¨¬¢®« "$1" ãáâ à¥« +% ˆá¯®«ì§®¢ ­ ᨬ¢®« (¯¥à¥¬¥­­ ï, ¯à®æ¥¤ãà  ¨ â.¯.), ª®â®àë© ¡ë« +% ®¡ê¥­ ª ª \var{deprecated}. ’ ª®© ãáâ à¥¢è¨© ᨬ¢®« ¬®¦¥â ¡ëâì +% ­¥¤®áâ㯥­ ¢ ­®¢ëå ¢¥àá¨ïå ¬®¤ã«ï / ¡¨¡«¨®â¥ª¨. ® ¢®§¬®¦­®áâ¨, +% ­ã¦­® ¨§¡¥£ âì ¨á¯®«ì§®¢ ­¨ï ãáâ à¥¢è¨å ᨬ¢®«®¢. +sym_w_non_portable_symbol=05044_W_‘¨¬¢®« "$1" ­¥ ¯®àâ ¡¥«¥­ +% ˆá¯®«ì§®¢ ­ ᨬ¢®« (¯¥à¥¬¥­­ ï, ¯à®æ¥¤ãà  ¨ â.¯.), ª®â®àë© ¡ë« +% ®¡ê¥­ ª ª \var{platform}. ‡­ ç¥­¨¥, ¨á¯®«ì§®¢ ­¨¥ ¨ ¤®áâ㯭®áâì +% â ª®£® ᨬ¢®«  § ¢¨á¨â ®â ¯« âä®à¬ë. …᫨ ¨á室­ë© ª®¤ ¤®«¦¥­ ¡ëâì +% ¯®àâ¨à㥬ë¬, ¨á¯®«ì§®¢ âì â ª¨¥ ᨬ¢®«ë ­¥ á«¥¤ã¥â. +sym_w_non_implemented_symbol=05055_W_‘¨¬¢®« "$1" ­¥ ॠ«¨§®¢ ­ +% ˆá¯®«ì§®¢ ­ ᨬ¢®« (¯¥à¥¬¥­­ ï, ¯à®æ¥¤ãà  ¨ â.¯.), ª®â®àë© ¡ë« +% ®¡ê¥­ ª ª \var{unimplemented}. â®â ᨬ¢®« ®¯à¥¤¥«¥­, +% ­® ¥é¥ ­¥ ॠ«¨§®¢ ­ ¤«ï ¤ ­­®© ¯« âä®à¬ë. +sym_e_cant_create_unique_type=05056_E_â®â ⨯ ­¥«ì§ï ¨á¯®«ì§®¢ âì ¤«ï ®¡ê¥­¨ï ã­¨ª «ì­®£® ⨯  +% ਠ®¡ê¥­¨¨ ã­¨ª «ì­®£® ⨯  á ¯®¬®éìî ¢ëà ¦¥­¨ï \var{type newtype = type oldtype;} +% ¬®¦­® ¨á¯®«ì§®¢ âì ⮫쪮 ¯à®áâë¥ â¨¯ë (¯®à浪®¢ë¥, ¢¥é¥á⢥­­ë¥ ¨ áâப®¢ë¥). +sym_h_uninitialized_local_variable=05057_H_‹®ª «ì­ ï ¯¥à¥¬¥­­ ï "$1" ­¥ ¨­¨æ¨ «¨§¨à®¢ ­  +% ‘®®¡é¥­¨¥ ¢ë¤ ¥âáï, ª®£¤  ª®¬¯¨«ïâ®à áç¨â ¥â, çâ® «®ª «ì­ ï ¯¥à¥¬¥­­ ï ¡ã¤¥â +% ¨á¯®«ì§®¢ ­  (â.¥. ¢áâà¥â¨« áì ¢ ¯à ¢®© ç á⨠¢ëà ¦¥­¨ï), ­® ­¥ ¡ë«  +% ¨­¨æ¨ «¨§¨à®¢ ­  (â.¥. ­¥ ¯®ï¢«ï« áì à ­¥¥ ¢ «¥¢®© ç á⨠¯à¨á¢ ¨¢ ­¨ï). +sym_h_uninitialized_variable=05058_H_¥à¥¬¥­­ ï "$1" ­¥ ¨­¨æ¨ «¨§¨à®¢ ­  +% ‘®®¡é¥­¨¥ ¢ë¤ ¥âáï, ª®£¤  ª®¬¯¨«ïâ®à áç¨â ¥â, çâ® ¯¥à¥¬¥­­ ï ¡ã¤¥â +% ¨á¯®«ì§®¢ ­  (â.¥. ¢áâà¥â¨« áì ¢ ¯à ¢®© ç á⨠¢ëà ¦¥­¨ï), ­® ­¥ ¡ë«  +% ¨­¨æ¨ «¨§¨à®¢ ­  (â.¥. ­¥ ¯®ï¢«ï« áì à ­¥¥ ¢ «¥¢®© ç á⨠¯à¨á¢ ¨¢ ­¨ï). +sym_w_function_result_uninitialized=05059_W_¥à¥¬¥­­ ï १ã«ìâ â  ä㭪樨 ­¥ ¨­¨æ¨ «¨§¨à®¢ ­  +% ‘®®¡é¥­¨¥ ¢ë¤ ¥âáï, ª®£¤  ª®¬¯¨«ïâ®à áç¨â ¥â, çâ® ¯¥à¥¬¥­­ ï १ã«ìâ â  +% ä㭪樨 ¡ã¤¥â ¨á¯®«ì§®¢ ­  (â.¥. ¢áâà¥â¨« áì ¢ ¯à ¢®© ç á⨠¢ëà ¦¥­¨ï), +% ­® ­¥ ¡ë«  ¨­¨æ¨ «¨§¨à®¢ ­  (â.¥. ­¥ ¯®ï¢«ï« áì à ­¥¥ ¢ «¥¢®© ç á⨠+% ¯à¨á¢ ¨¢ ­¨ï). +sym_h_function_result_uninitialized=05060_H_¥à¥¬¥­­ ï १ã«ìâ â  ä㭪樨 ­¥ ¨­¨æ¨ «¨§¨à®¢ ­  +% ‘®®¡é¥­¨¥ ¢ë¤ ¥âáï, ª®£¤  ª®¬¯¨«ïâ®à áç¨â ¥â, çâ® ¯¥à¥¬¥­­ ï १ã«ìâ â  +% ä㭪樨 ¡ã¤¥â ¨á¯®«ì§®¢ ­  (â.¥. ¢áâà¥â¨« áì ¢ ¯à ¢®© ç á⨠¢ëà ¦¥­¨ï), +% ­® ­¥ ¡ë«  ¨­¨æ¨ «¨§¨à®¢ ­  (â.¥. ­¥ ¯®ï¢«ï« áì à ­¥¥ ¢ «¥¢®© ç á⨠+% ¯à¨á¢ ¨¢ ­¨ï). +sym_w_identifier_only_read=05061_W_¥à¥¬¥­­ ï "$1" ç¨â ¥âáï, ­® ­¥ ¯à¨á¢®¥­  +% ‡­ ç¥­¨¥ ¯¥à¥¬¥­­®© áç¨â뢠¥âáï, ­® ­¨£¤¥ ­¥ ¯à¨á¢ ¨¢ ¥âáï. +sym_h_abstract_method_list=05062_H_ ©¤¥­  ¡áâà ªâ­ë© ¬¥â®¤: $1 +% ਠ¢ë¤ ç¥ ¯à¥¤ã¯à¥¦¤¥­¨ï ® ᮧ¤ ­¨¨ ª« áá /®¡ê¥ªâ  á  ¡áâà ªâ­ë¬¨ ¬¥â®¤ ¬¨ +% íâ  ¯®¤áª §ª  ®¡«¥£ç ¥â ¯®¨áª ¯à®¡«¥¬­®£® ¬¥â®¤ . +sym_w_experimental_symbol=05063_W_‘¨¬¢®« "$1" ï¥âáï íªá¯¥à¨¬¥­â «ì­ë¬ +% ˆá¯®«ì§®¢ ­ ᨬ¢®« (¯¥à¥¬¥­­ ï, ¯à®æ¥¤ãà  ¨ â.¯.), ª®â®àë© ¡ë« +% ®¡ê¥­ ª ª \var{experimental}. ªá¯¥à¨¬¥­â «ì­ë¥ ᨬ¢®«ë ¬®£ãâ +% ¨á祧­ãâì ¨«¨ ¨§¬¥­¨âì ¯®¢¥¤¥­¨¥ ¢ ¡ã¤ã饩 ¢¥àᨨ. ˆá¯®«ì§®¢ ­¨ï +% â ª¨å ᨬ¢®«®¢ á«¥¤ã¥â ¯® ¢®§¬®¦­®á⨠¨§¡¥£ âì. +sym_w_forward_not_resolved=05064_W_ ­¥¥ ®¡ê¥­¨¥ "$1" ­¥ à §à¥è¨«®áì, ¯à¥¤¯®« £ ¥âáï external +% நá室¨â, ¥á«¨ äã­ªæ¨ï ¡ë«  ®¡ê¥­  ¢ ᥪ樨 \var{interface} ¬®¤ã«ï ¢ ०¨¬¥ macpas, +% ­® ­¥ ¡ë«  ॠ«¨§®¢ ­ . +% \end{description} + +# +# Š®¤®£¥­¥à â®à +# +# 06049 ­®¬¥à ¯®á«¥¤­¥£® á®®¡é¥­¨ï +# +% \section{Code generator messages} +%  §¤¥« ᮤ¥à¦¨â á®®¡é¥­¨ï, ª®â®àë¥ ¬®£ãâ ¡ëâì ¢ë¤ ­ë ¯à¨ ®è¨¡ª å +% ª®¤®£¥­¥à æ¨¨. +% \begin{description} +cg_e_parasize_too_big=06009_E_ §¬¥p ᯨ᪠ ¯ p ¬¥âp®¢ ¯p¥¢ëè ¥â 65535 ¡ ©â +% à®æ¥áá®à I386 ®£à ­¨ç¨¢ ¥â ᯨ᮪ ¯ à ¬¥â஢ ¤® 65535 ¡ ©â (¨§-§  ®á®¡¥­­®á⨠+% ¨­áâàãªæ¨¨ \var{RET}) +cg_e_file_must_call_by_reference=06012_E_” ©«®¢ë¥ ⨯ë á«¥¤ã¥â ¯¥à¥¤ ¢ âì ¯® áá뫪¥ +% ” ©«ë ­¥«ì§ï ¯¥à¥¤ ¢ âì ¯® §­ ç¥­¨î, â.¥. ®­¨ ¢á¥£¤  ¤®«¦­ë ¡ëâì ®¡ê¥­ë +% ª ª \var{var} ¯ à ¬¥âàë. +cg_e_cant_use_far_pointer_there=06013_E_ˆá¯®«ì§®¢ ­¨¥ FAR yª § â¥«ï §¤¥áì ­¥¤®¯ãá⨬® +% Free Pascal ­¥ ¯®¤¤¥à¦¨¢ ¥â ¤ «ì­¨¥ 㪠§ â¥«¨, ¯®í⮬㠭¥¢®§¬®¦­® ¢§ïâì  ¤à¥á +% ¢ëà ¦¥­¨ï, ¢ १ã«ìâ â¥ ª®â®à®£® ¯®«ãç¨âáï ¤ «ì­¨© 㪠§ â¥«ì. Š®­áâàãªæ¨ï \var{mem} +% ï¥âáï ¯à¨¬¥à®¬ â ª®£® ¢ëà ¦¥­¨ï, ¯®í⮬ã á«¥¤ãî騩 ª®¤ ¢ë§®¢¥â ¤ ­­ãî ®è¨¡ªã: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_‚맮¢ EXPORT ä㭪樨 ­¥¢®§¬®¦¥­ +% ®«ìè¥ ­¥ ¨á¯®«ì§ã¥âáï. +cg_w_member_cd_call_from_method=06016_W_‚®§¬®¦­®, ­¥¢¥à­ë© ¢ë§®¢ ª®­áâpyªâ®p  ¨«¨ ¤¥áâpyªâ®p  +% Ž¡­ à㦥­ ¢ë§®¢ ª®­áâàãªâ®à  ¨«¨ ¤¥áâàãªâ®à  ¨§ ¬¥â®¤ . â®, ᪮॥ ¢á¥£®, ¯à¨¢¥¤¥â ª +% ¯à®¡«¥¬ ¬, â.ª. ¤«ï ª®­áâàãªâ®à®¢/¤¥áâàãªâ®à®¢ âॡãîâáï ®á®¡ë¥ ¯ à ¬¥âàë. +cg_n_inefficient_code=06017_N_H¥íä䥪⨢­ë© ª®¤ +%  ¯¨á ­­ ï ¢ ¬¨ ª®­áâàãªæ¨ï ª ¦¥âáï ª®¬¯¨«ïâ®à㠮祭ì ᮬ­¨â¥«ì­®©. +cg_w_unreachable_code=06018_W_H¥¤®á⨦¨¬ë© ª®¤ +%  ¯¨á ­­ ï ª®­áâàãªæ¨ï ­¨ª®£¤  ­¥ ¡ã¤¥â ¢ë¯®«­¥­ . ਬ¥à: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_€¡áâp ªâ­ë¥ ¬¥â®¤ë ­¥«ì§ï ¢ë§ë¢ âì ­ ¯pï¬yî +% €¡áâà ªâ­ë© ¬¥â®¤ ­¥«ì§ï ¢ë§¢ âì ­¥¯®á।á⢥­­®, ¢¬¥áâ® ­¥£® á«¥¤ã¥â ¢ë§ë¢ âì +% ¯¥à¥ªà뢠î騩 ¬¥â®¤ ¯®â®¬ª , ¯®â®¬ã çâ®  ¡áâà ªâ­ë© ¬¥â®¤ ­¥ ¨¬¥¥â ॠ«¨§ æ¨¨. +cg_d_register_weight=06027_DL_¥£¨áâp $1 ¢¥á $2 $3 +% Žâ« ¤®ç­®¥ á®®¡é¥­¨¥. ‚뢮¤¨âáï, ª®£¤  ª®¬¯¨«ïâ®à à áᬠâਢ ¥â ¢®§¬®¦­®áâì +% à §¬¥é¥­¨ï ¯¥à¥¬¥­­ëå ¢ ॣ¨áâà å. +cg_d_stackframe_omited=06029_DL_Š ¤à á⥪  ­¥ ᮧ¤ ­ (­¥ âॡã¥âáï) +% ¥ª®â®àë¬ ¯à®æ¥¤ãà ¬/äã­ªæ¨ï¬ ­¥ âॡã¥âáï ¯®«­ë© ª ¤à á⥪ , ¨ ¥£® ¬®¦­® ®¯ãáâ¨âì. +% ‘®®¡é¥­¨¥ ¢ë¢®¤¨âáï ¯à¨ ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vd}. +cg_e_unable_inline_object_methods=06031_E_Œ¥â®¤ë ®¡ê¥ªâ å ¨«¨ ª« áᮢ ­¥ ¬®£ãâ ¡ëâì ¢áâà ¨¢ ¥¬ë¬¨ (inline) +% Œ¥â®¤ë ®¡ê¥ªâ  ­¥«ì§ï ¢áâà ¨¢ âì. +cg_e_unable_inline_procvar=06032_E_‚맮¢ë ¯à®æ¥¤ãà­ëå ¯¥à¥¬¥­­ëå ­¥ ¬®£ã£ ¡ëâì ¢áâà ¨¢ ¥¬ë¬¨ (inline) +% ‚맮¢ ¯à®æ¥¤ãà­®© ¯¥à¥¬¥­­®© ­¥ ¬®¦¥â ¡ëâì ¢áâ஥­. +cg_e_no_code_for_inline_stored=06033_E_H¥â ª®¤  ¤«ï inline +% Š®¬¯¨«ïâ®à ­¥ ᬮ£ á®åà ­¨âì ª®¤ ¤«ï ¢áâà ¨¢ ¥¬®© ¯à®æ¥¤ãàë. +cg_e_can_access_element_zero=06035_E_Hy«¥¢®© í«¥¬¥­â ansi/wide- áâp®ª¨ ­¥¤®áây¯¥­, ¨á¯®«ì§y©â¥ (set)length +% „«ï ¨§¬¥­¥­¨ï ¤«¨­ë áâப¨ ⨯  ansi/wide/longstring á«¥¤ã¥â ¨á¯®«ì§®¢ âì +% ¯à®æ¥¤ãàã \var{setlength},   ¤«ï ¯®«ã祭¨ï - äã­ªæ¨î \var{length}. +cg_e_cannot_call_cons_dest_inside_with=06037_E_Š®­áâpyªâ®p ¨«¨ ¤¥áâpyªâ®p ­¥«ì§ï ¢ë§ë¢ âì ¢­yâp¨ ¢ëà ¦¥­¨© 'WITH' +% ‚­ãâਠª®­áâàãªæ¨¨ \var{With} ¢ë§®¢ ª®­áâàãªâ®à  ¨«¨ ¤¥áâàãªâ®à  ¤«ï ®¡ê¥ªâ - à£ã¬¥­â  +% \var{with} ­¥¢®§¬®¦¥­. +cg_e_cannot_call_message_direct=06038_E_H¥¯®á।á⢥­­ë© ¢ë§®¢ ¬¥â®¤ -®¡p ¡®â稪  ᮡë⨩ ­¥¢®§¬®¦¥­ +% A message method handler method can't be called directly if it contains an +% explicit self argument +cg_e_goto_inout_of_exception_block=06039_E_¥à¥å®¤ ç¥à¥§ £à ­¨æã ¡«®ª  ¨áª«î祭¨© +% ¥à¥å®¤ ¢­ãâàì ¡«®ª  ®¡à ¡®âª¨ ¨áª«î祭¨© \var{try..finally..end;} ¨«¨ ¨§ ­¥£® ­¥ ¤®¯ã᪠¥âáï: +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // ¢ í⮩ áâப¥ ¡ã¤¥â ®è¨¡ª  +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_“¯à ¢«ïî騥 ¢ëà ¦¥­¨ï (break, continue ¨ exit) ­¥¤®¯ãáâ¨¬ë ¢ ¡«®ª¥ finally +% ˆá¯®«ì§®¢ ­¨¥ ¢ëà ¦¥­¨©, ¨§¬¥­ïîé¨å 室 ¢ë¯®«­¥­¨ï (\var{break}, +% \var{continue} ¨ \var{exit}), ­¥ ¤®¯ã᪠¥âáï +% ¢­ãâਠ¡«®ª  finally. ‘«¥¤ãî騩 ª®¤ ¢ë§®¢¥â ®è¨¡ªã: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // â®â exit ­¥¤®¯ãá⨬ +% end; +% ... +% +% \end{verbatim} +% …᫨ ¯à¨ ¢ë¯®«­¥­¨¨ ¯à®æ¥¤ãà  \var{p} ¯à®¨á室¨â ¨áª«î祭¨¥, ¢ë¯®«­ï¥âáï ¡«®ª +% finally. …᫨ ¢ë¯®«­¥­¨¥ ¤®å®¤¨â ¤® exit, ­¥¯®­ïâ­® çâ® ¤¥« âì: +% ¢ë室¨âì ¨§ ¯à®æ¥¤ãਠ¨«¨ ¨áª âì ¤à㣮© ®¡à ¡®â稪 ¨áª«î祭¨©. +cg_w_parasize_too_big=06041_W_ §¬¥à ¯ à ¬¥â஢ ¯à¥¢ë蠥⠯।¥« ¤«ï ­¥ª®â®àëå ¯à®æ¥áá®à®¢ +% Ž§­ ç ¥â, çâ® ¡ë«® ®¡ê¥­® ¡®«¥¥ 64 ª ©â ¯ à ¬¥â஢, çâ® +% ¬®¦¥â ­¥ ¯®¤¤¥à¦¨¢ âìáï ¯à¨ ª®¬¯¨«ï樨 ¤«ï ¤àã£¨å ¯« âä®à¬. +cg_w_localsize_too_big=06042_W_ §¬¥à «®ª «ì­ëå ¯¥à¥¬¥­­ëå ¯à¥¢ë蠥⠯।¥« ¤«ï ­¥ª®â®àëå ¯à®æ¥áá®à®¢ +% Ž§­ ç ¥â, çâ® ¡ë«® ®¡ê¥­® ¡®«¥¥ 32 ª ©â «®ª «ì­ëå ¯¥à¥¬¥­­ëå, çâ® +% ¬®¦¥â ­¥ ¯®¤¤¥à¦¨¢ âìáï ¯à¨ ª®¬¯¨«ï樨 ¤«ï ¤àã£¨å ¯« âä®à¬. +cg_e_localsize_too_big=06043_E_ §¬¥à «®ª «ì­ëå ¯¥à¥¬¥­­ëå ¯à¥¢ë蠥⠤®¯ãáâ¨¬ë© ¯à¥¤¥« +% Ž§­ ç ¥â, çâ® ®¡ê¥­® ¡®«¥¥ 32 ª ©â «®ª «ì­ëå ¯¥à¥¬¥­­ëå, çâ® +% ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ¤«ï ¤ ­­®£® ¯à®æ¥áá®à . +cg_e_break_not_allowed=06044_E_BREAK ­¥¤®¯ãá⨬® +% ®¯ë⪠ ¨á¯®«ì§®¢ ­¨ï \var{break} ¢­¥ ª®­áâàãªæ¨¨ 横« . +cg_e_continue_not_allowed=06045_E_CONTINUE ­¥¤®¯ãá⨬® +% ®¯ë⪠ ¨á¯®«ì§®¢ ­¨ï \var{continue} ¢­¥ ª®­áâàãªæ¨¨ 横« . +cg_f_unknown_compilerproc=06046_F_¥¨§¢¥áâ­ ï ¢­ãâ७­ïï ¯à®æ¥¤ãà  "$1". ஢¥àì⥠¢¥àá¨î ¡¨¡«¨®â¥ª¨ RTL. +% Š®¬¯¨«ïâ®à ®¦¨¤ ¥â, çâ® ¡¨¡«¨®â¥ª  ¢à¥¬¥­¨ ¢ë¯®«­¥­¨ï (RTL) ᮤ¥à¦¨â ®¯à¥¤¥«¥­­ë¥ ¯à®æ¥¤ãàë. …᫨ +% ¢ë ¢¨¤¨â¥ íâ® á®®¡é¥­¨¥, ­¥ § ­¨¬ ïáì á ¬®áâ®ï⥫쭮© ¬®¤¨ä¨ª æ¨¥© ª®¤  ¡¨¡«¨®â¥ª¨ RTL, â®, ᪮॥ +% ¢á¥£®, ¨á¯®«ì§ã¥¬ ï ¡¨¡«¨®â¥ª  RTL ­¥ ᮮ⢥âáâ¢ã¥â ª®¬¯¨«ïâ®àã. …᫨ ¦¥ ¢ë ¬®¤¨ä¨æ¨à®¢ «¨ RTL, §­ ç¨â, +% ¢ë 㤠«¨«¨ ¯à®æ¥¤ãàã, ª®â®à ï ­ã¦­  ª®¬¯¨«ïâ®àã ¤«ï ¢­ãâ७­¥£® ¨á¯®«ì§®¢ ­¨ï. +cg_f_unknown_system_type=06047_F_¥ ­ ©¤¥­ á¨á⥬­ë© ⨯ "$1". ஢¥àì⥠¢¥àá¨î ¡¨¡«¨®â¥ª¨ RTL. +% Š®¬¯¨«ïâ®à ®¦¨¤ ¥â, çâ® ¡¨¡«¨®â¥ª  ¢à¥¬¥­¨ ¢ë¯®«­¥­¨ï (RTL) ᮤ¥à¦¨â ®¯à¥¤¥«¥­­ë¥ ®¡ê¥­¨ï +% ⨯®¢. …᫨ ¢ë ¢¨¤¨â¥ íâ® á®®¡é¥­¨¥, ­¥ § ­¨¬ ïáì á ¬®áâ®ï⥫쭮© ¬®¤¨ä¨ª æ¨¥© ª®¤  ¡¨¡«¨®â¥ª¨ RTL, â®, +% ᪮॥ ¢á¥£®, ¨á¯®«ì§ã¥¬ ï ¡¨¡«¨®â¥ª  RTL ­¥ ᮮ⢥âáâ¢ã¥â ª®¬¯¨«ïâ®àã. …᫨ ¦¥ ¢ë ¬®¤¨ä¨æ¨à®¢ «¨ RTL, +% §­ ç¨â, ¢ë 㤠«¨«¨ ⨯, ­ã¦­ë© ª®¬¯¨«ïâ®àã ¤«ï ¢­ãâ७­¥£® ¨á¯®«ì§®¢ ­¨ï. +cg_h_inherited_ignored=06048_H_‚맮¢  ¡áâࠪ⭮£® ¬¥â®¤  ¯®á।á⢮¬ inherited ¨£­®à¨à®¢ ­ +% ‘®®¡é¥­¨¥ ¢ë¤ ¥âáï ⮫쪮 ¢ ०¨¬¥ Delphi, ¯à¨ ¯®¯ë⪥ ¢ë§¢ âì  ¡áâà ªâ­ë© ¬¥â®¤ +% த¨â¥«ì᪮£® ª« áá  á ¯®¬®éìî \var{inherited;}. ’ ª®© ¢ë§®¢ ¨£­®à¨àã¥âáï. +cg_e_goto_label_not_found=06049_E_Œ¥âª  "$1" ­¥ ®¯à¥¤¥«¥­  ¨«¨ 㤠«¥­  ®¯â¨¬¨§ æ¨¥© +% Œ¥âª , ¨á¯®«ì§®¢ ­­ ï ¢ goto, ­¥ ®¯à¥¤¥«¥­  «¨¡® ¡ë«  㤠«¥­  ¯à¨ 㤠«¥­¨¨ +% ­¥¤®áâ㯭®£® ª®¤ . +% \end{description} +# EndOfTeX + +# +# Assembler reader +# +# 07107 is the last used one +# +asmr_d_start_reading=07000_DL_H ç «® ç⥭¨ï  áᥬ¡«¥p  ⨯  $1 +% ˆ­ä®à¬¨àã¥â ® ­ ç «¥ ç⥭¨ï  áᥬ¡«¥à­®£® ¡«®ª . +asmr_d_finish_reading=07001_DL_Š®­¥æ ç⥭¨ï  áᥬ¡«¥p  ⨯  $1 +% ˆ­ä®à¬¨àã¥â ® § ¢¥à襭¨¨ ç⥭¨ï  áᥬ¡«¥à­®£® ¡«®ª . +asmr_e_none_label_contain_at=07002_E_’®ª¥­, ­¥ ïî騩áï ¬¥âª®©, ᮤ¥p¦¨â @ +% ˆ¤¥­â¨ä¨ª â®à, ­¥ ïî騩áï ¬¥âª®©, ­¥ ¬®¦¥â ᮤ¥à¦ âì ᨬ¢®« @. +asmr_e_building_record_offset=07004_E_Žè¨¡ª  ¯®áâp®¥­¨ï ᬥ饭¨ï ¢ § ¯¨á¨ +% Žè¨¡ª  ¢ëç¨á«¥­¨ï ᬥ饭¨ï ¢ § ¯¨á¨/®¡ê¥ªâ¥, ¬®¦¥â ¯à®¨á室¨âì, ¥á«¨ +% ¯®«¥ ­¥ 㪠§ ­® ¢®®¡é¥ ¨«¨ ¨á¯®«ì§®¢ ­ ­¥¨§¢¥áâ­ë© ¨¤¥­â¨ä¨ª â®à ¯®«ï. +asmr_e_offset_without_identifier=07005_E_ˆá¯®«ì§®¢ ­¨¥ OFFSET ¡¥§ ¨¤¥­â¨ä¨ª â®p  +% Š«î祢®¥ á«®¢® OFFSET ¬®¦­® ¨á¯®«ì§®¢ âì ⮫쪮 ᮢ¬¥áâ­® á ¨¤¥­â¨ä¨ª â®à®¬. +% „à㣨¥ ᨭ⠪á¨áë ­¥ ¯®¤¤¥à¦¨¢ îâáï. +asmr_e_type_without_identifier=07006_E_ˆá¯®«ì§®¢ ­¨¥ TYPE ¡¥§ ¨¤¥­â¨ä¨ª â®p  +% Š«î祢®¥ á«®¢® TYPE ¬®¦­® ¨á¯®«ì§®¢ âì ⮫쪮 ᮢ¬¥áâ­® á ¨¤¥­â¨ä¨ª â®à®¬. +% „à㣨¥ ᨭ⠪á¨áë ­¥ ¯®¤¤¥à¦¨¢ îâáï. +asmr_e_no_local_or_para_allowed=07007_E_‡¤¥áì ­¥«ì§ï ¨á¯®«ì§®¢ âì «®ª «ì­ë¥ ¯¥p¥¬¥­­ë¥ ¨«¨ ¯ p ¬¥âpë +% ‹®ª «ì­ë¥ ¯¥à¥¬¥­­ë¥ ¨ ¯ à ¬¥âàë ®¡ëç­®  ¤à¥áãîâáï ª ª ᬥ饭¨¥ ®â ॣ¨áâà  +% %ebp, ¯®íâ®¬ã ¨å  ¤à¥á ­¥ ¬®¦¥â ¡ëâì ¯®«ã祭 ­¥¯®á।á⢥­­®. +asmr_e_need_offset=07008_E_‡¤¥áì ­¥®¡å®¤¨¬® ¨á¯®«ì§®¢ âì OFFSET +% „«ï ¯®«ã祭¨ï  ¤à¥á  ¤ ­­®£® ¨¤¥­â¨ä¨ª â®à  ­¥®¡å®¤¨¬® ¨á¯®«ì§®¢ âì OFFSET <id>. +asmr_e_need_dollar=07009_E_‡¤¥áì ­¥®¡å®¤¨¬® ¨á¯®«ì§®¢ âì §­ ª ¤®«« à  ('$') +% „«ï ¯®«ã祭¨ï  ¤à¥á  ¤ ­­®£® ¨¤¥­¨ä¨ª â®à  ­¥®¡å®¤¨¬® ¨á¯®«ì§®¢ âì $<id>. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_H¥ ¤®¯ã᪠îâáï ¬­®¦¥á⢥­­ë¥ ¯¥p¥¬¥é ¥¬ë¥ ᨬ¢®«ë +% ¥ ¤®¯ã᪠¥âáï ¡®«¥¥ ®¤­®£® ¯¥à¥¬¥é ¥¬®£® ᨬ¢®«  (¯¥à¥¬¥­­ ï/⨯¨§¨à®¢ ­­ ï ª®­áâ ­â ) +% ¢ ®¤­®¬  à£ã¬¥­â¥. +asmr_e_only_add_relocatable_symbol=07011_E_¥p¥¬¥é ¥¬ë© ᨬ¢®« ¤®¯ã᪠¥â ⮫쪮 á«®¦¥­¨¥ +% ¥à¥¬¥é ¥¬ë¥ ᨬ¢®«ë (¯¥à¥¬¥­­ë¥/⨯¨§¨à®¢ ­­ë¥ ª®­áâ ­âë) ­¥ ¬®£ãâ ¡ëâì ¨á¯®«ì§®¢ ­ë á ¤à㣨¬¨ +% ®¯¥à â®à ¬¨. „®¯ã᪠¥âáï ⮫쪮 á«®¦¥­¨¥. +asmr_e_invalid_constant_expression=07012_E_H¥¢¥à­®¥ ª®­áâ ­â­®¥ ¢ëp ¦¥­¨¥ +% Žè¨¡ª  ¢ ª®­áâ ­â­®¬ ¢ëà ¦¥­¨¨. +asmr_e_relocatable_symbol_not_allowed=07013_E_¥p¥¬¥é ¥¬ë© ᨬ¢®« §¤¥áì ­¥ p §p¥è¥­ +% ‚ ¤ ­­®¬ ¬¥á⥠­¥ ¬®¦¥â ¡ëâì ¨á¯®«ì§®¢ ­ ¯¥à¥¬¥é ¥¬ë© ᨬ¢®« (¯¥à¥¬¥­­ ï/⨯¨§¨à®¢ ­­ ï ª®­áâ ­â ). +asmr_e_invalid_reference_syntax=07014_E_H¥¢¥p­ë© ᨭ⠪á¨á áá뫪¨ +% ‘¨­â ªá¨ç¥áª ï ®è¨¡ª  ¢ § ¯¨á¨ áá뫪¨. +asmr_e_local_para_unreachable=07015_E_$1 ­¥¤®áâ㯭® ¨§ í⮣® ª®¤  +% ‚® ¢«®¦¥­­®© ¯à®æ¥¤ãॠ­¥¢®§¬®¦¥­ ¯àאַ© ¤®áâ㯠ª §­ ç¥­ï¬ «®ª «ì­ëå ¯¥à¥¬¥­­ëå ¨«¨ ¯ à ¬¥â஢ +% ¢­¥è­¥© ¯à®æ¥¤ãàë (ªà®¬¥ á«ãç ï, ª®£¤  ¢«®¦¥­­ ï ¯à®æ¥¤ãà  á ¬  ­¥ ¨¬¥¥â ¯ à ¬¥â஢ ¨ «®ª «ì­ëå +% ¯¥à¥¬¥­­ëå). +asmr_e_local_label_not_allowed_as_ref=07016_E_‹®ª «ì­ë¥ ᨬ¢®«ë ¨«¨ ¬¥âª¨ ­¥«ì§ï ¨á¯®«ì§®¢ âì ª ª áá뫪¨ +% ‚ë ­¥ ¬®¦¥â¥ ¨á¯®«ì§®¢ âì «®ª «ì­ë¥ ᨬ¢®«ë ¨«¨ ¬¥âª¨ ª ª áá뫪¨ +asmr_e_wrong_base_index=07017_E_H¥¢¥p­®¥ ¨á¯®«ì§®¢ ­¨¥ ॣ¨áâ஢ ¡ §ë ¨ ¨­¤¥ªá  +% Žè¨¡ª  ¯à¨ ¨á¯®«ì§®¢ ­¨¨ ॣ¨áâ஢ ¡ §ë ¨ ¨­¤¥ªá  +asmr_w_possible_object_field_bug=07018_W_‚®§¬®¦­ ï ®è¨¡ª  ¢ ®¡à ¡®âª¥ ¯®«ï ®¡ê¥ªâ  +% ®«ï ª« áᮢ/®¡ê¥ªâ®¢ ­¥¤®áâã¯­ë ­ ¯àï¬ãî ¢ ०¨¬ å fpc ¨ objfpc, +% ­® ¢ ०¨¬ å TP ¨ Delphi ¨¬¥­  ¯®«¥© ®¡à ¡ â뢠îâáï ª ª ®¡ëç­ë¥ ᬥ饭¨ï. +asmr_e_wrong_scale_factor=07019_E_H¥¢¥p­ë© ¬­®¦¨â¥«ì +% “ª § ­ ­¥¢¥à­ë© ¬­®¦¨â¥«ì, à §à¥è¥­ë ⮫쪮 §­ ç¥­¨ï 1,2,4 ¨ 8 +asmr_e_multiple_index=07020_E_Œ­®¦¥á⢥­­®¥ ¨á¯®«ì§®¢ ­¨¥ ¨­¤¥ªá­®£® p¥£¨áâp  +% ®¯ë⪠ ¨á¯®«ì§®¢ ­¨ï ¡®«¥¥ 祬 ®¤­®£® ¨­¤¥ªá­®£® ॣ¨áâà . +asmr_e_invalid_operand_type=07021_E_H¥¢¥p­ë© ⨯ ®¯¥p ­¤  +% ’¨¯ ®¯¥à ­¤  ­¥ ᮮ⢥âáâ¢ã¥â ª®¤ã ª®¬ ­¤ë. +asmr_e_invalid_string_as_opcode_operand=07022_E_‘âp®ª  ­¥¯à¨£®¤­  ¢ ª ç¥á⢥ ®¯¥p ­¤  ¨­áâàãªæ¨¨: $1 +% ‘âப , 㪠§ ­­ ï ª ª ®¯¥à ­¤, ­¥ª®à४⭠ ¤«ï ¤ ­­®© ª®¬ ­¤ë. +asmr_w_CODE_and_DATA_not_supported=07023_W_@CODE ¨ @DATA ­¥ ¯®¤¤¥p¦¨¢ îâáï +% @CODE ¨ @DATA ­¥ ¯®¤¤¥à¦¨¢ îâáï ¨ ¨£­®à¨àãîâáï. +asmr_e_null_label_ref_not_allowed=07024_E_‘á뫪¨ ­  ¡¥§ë¬ï­­ë¥ ¬¥âª¨ ­¥ ¤®¯ã᪠îâáï +asmr_e_expr_zero_divide=07025_E_„¥«¥­¨¥ ­  ­®«ì ¢ ¢ëà ¦¥­¨¨  áᥬ¡«¥à  +% ‚ ª®­áâ ­â­®¬ ¢ëà ¦¥­¨¨ ᮤ¥à¦¨âáï ¤¥«¥­¨¥ ­  ­®«ì +asmr_e_expr_illegal=07026_E_¥¢¥à­®¥ ¢ëà ¦¥­¨¥ +% Š®­áâ ­â­®¥ ¢ëà ¦¥­¨¥ ­¥¢¥à­® +asmr_e_escape_seq_ignored=07027_E_Escape-¯®á«¥¤®¢ â¥«ì­®áâì ¨£­®p¨p®¢ ­ : $1 +% ‚ áâப¥ á⨫ï ï§ëª  C ᮤ¥à¦¨âáï ­¥¨§¢¥áâ­ ï escape-¯®á«¥¤®¢ â¥«ì­®áâì, +% ª®â®à ï ¨£­®à¨àã¥âáï. +asmr_e_invalid_symbol_ref=07028_E_H¥¢¥p­ ï áá뫪  ­  ᨬ¢®« +asmr_w_fwait_emu_prob=07029_W_FWAIT ¬®¦¥â ¢ë§¢ âì ¯p®¡«¥¬ë í¬y«ï樨 á EMU387 +asmr_w_fadd_to_faddp=07030_W_$1 ¡¥§ ®¯¥à ­¤  â࠭᫨àã¥âáï ¢ $1P +asmr_w_enter_not_supported_by_linux=07031_W_ˆ­áâàãªæ¨ï ENTER ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ï¤à®¬ Linux +% ˆ­áâàãªæ¨ï ENTER ¬®¦¥â ¯à¨¢¥á⨠ª ®è¨¡ª¥ § é¨âë áâà ­¨æë á⥪ , ª®â®à ï ­¥ª®à४⭮ +% "«®¢¨âáï" ®¡à ¡®â稪®¬ ¢ i386 Linux. +asmr_w_calling_overload_func=07032_W_‚맮¢ ¯¥p¥£py¦¥­­®© äy­ªæ¨¨ ¢  áᥬ¡«¥p¥ +% ‚맮¢ ¯¥à¥£à㦥­­®© ä㭪樨 ¨§  áᥬ¡«¥à­®£® ¡«®ª , +% ª ª ¯à ¢¨«®, ï¥âáï ¯à¨§­ ª®¬ ¯à®¡«¥¬ë. +asmr_e_unsupported_symbol_type=07033_E_H¥ ¯®¤¤¥p¦¨¢ ¥¬ë© ⨯ ᨬ¢®«  ¤«ï ®¯¥p ­¤  +asmr_e_constant_out_of_bounds=07034_E_‡­ ç¥­¨¥ ª®­áâ ­âë ¢­¥ ¤¨ ¯ §®­  +asmr_e_error_converting_decimal=07035_E_"$1" ­¥ ï¥âáï ¤¥áïâ¨ç­ë¬ ç¨á«®¬ +% ¥¢¥à­ë© ᨭ⠪á¨á ¤¥áïâ¨ç­®£® ç¨á« . +asmr_e_error_converting_octal=07036_E_"$1" ­¥ ï¥âáï ¢®á쬥p¨ç­ë¬ ç¨á«®¬ +% ¥¢¥à­ë© ᨭ⠪á¨á ¢®á쬥à¨ç­®£® ç¨á« . +asmr_e_error_converting_binary=07037_E_"$1" ­¥ ï¥âáï ¤¢®¨ç­ë¬ ç¨á«®¬ +% ¥¢¥à­ë© ᨭ⠪á¨á ¤¢®¨ç­®£® ç¨á« . +asmr_e_error_converting_hexadecimal=07038_E_"$1" ­¥ ï¥âáï è¥áâ­ ¤æ â¥p¨ç­ë¬ ç¨á«®¬ +% ¥¢¥à­ë© ᨭ⠪á¨á è¥áâ­ ¤æ â¥à¨ç­®£® ç¨á« . +asmr_h_direct_global_to_mangled=07039_H_$1 ¯p¥®¡p §®¢ ­® ¢ $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 á¢ï§ ­® á ¯¥p¥£py¦¥­­®© äy­ªæ¨¥© +asmr_e_cannot_use_SELF_outside_a_method=07041_E_H¥ ¤®¯ã᪠¥âáï ¨á¯®«ì§®¢ ­¨¥ SELF ¢­¥ ¬¥â®¤  +% ¥¤®¯ãá⨬ ï áá뫪  ­  ᨬ¢®« \var{self}. +%   \var{self} ¬®¦­® ááë« âìáï ⮫쪮 ¢ ¬¥â®¤ å. +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_H¥ ¤®¯ã᪠¥âáï ¨á¯®«ì§®¢ ­¨¥ OLDEBP ¢­¥ ¢«®¦¥­­®© ¯p®æ¥¤ypë +% ¥¤®¯ãá⨬ ï áá뫪  ­  ᨬ¢®« \var{oldebp}. +%   \var{oldebp} ¬®¦­® ááë« âìáï ⮫쪮 ¢® ¢«®¦¥­­ëå ¯à®æ¥¤ãà å. +asmr_e_void_function=07043_W_஥楤ãàë ­¥ ¬®£ãâ ¢®§¢p é âì §­ ç¥­¨ï ¨§  áᥬ¡«¥à­®£® ª®¤  +% ®¯ë⪠ ¢¥à­ãâì §­ ç¥­¨¥ ¨§ ¯à®æ¥¤ãàë. à®æ¥¤ãà  ­¥ ¬®¦¥â ¢®§¢à é âì §­ ç¥­¨ï. +asmr_e_SEG_not_supported=07044_E_SEG ­¥ ¯®¤¤¥p¦¨¢ ¥âáï +asmr_e_size_suffix_and_dest_dont_match=07045_E_‘yä䨪á p §¬¥p  ­¥ ᮮ⢥âáâ¢ã¥â à §¬¥àã ®¯¥à ­¤®¢ +%  §¬¥à ॣ¨áâà  ¨ áãä䨪á à §¬¥à  ¢ ª®¤¥ ª®¬ ­¤ë ­¥ ᮮ⢥âá¢ãîâ. ‘ª®à¥¥ ¢á¥£®, +% ª®¬ ­¤   áᥬ¡«¥à  § ¯¨á ­  á ®è¨¡ª®©. +asmr_w_size_suffix_and_dest_dont_match=07046_W_‘yä䨪á p §¬¥p  ­¥ ᮮ⢥âáâ¢ã¥â à §¬¥àã ®¯¥à ­¤®¢ +%  §¬¥à ॣ¨áâà  ¨ áãä䨪á à §¬¥à  ¢ ª®¤¥ ª®¬ ­¤ë ­¥ ᮮ⢥âá¢ãîâ. ‘ª®à¥¥ ¢á¥£®, +% ª®¬ ­¤   áᥬ¡«¥à  § ¯¨á ­  á ®è¨¡ª®©. +asmr_e_syntax_error=07047_E_‘¨­â ªá¨ç¥áª ï ®è¨¡ª   áᥬ¡«¥à  +% ‘¨­â ªá¨ç¥áª ï ®è¨¡ª   áᥬ¡«¥à  +asmr_e_invalid_opcode_and_operand=07048_E_H¥¢¥p­ ï ª®¬¡¨­ æ¨ï ª®¬ ­¤ë ¨ ®¯¥p ­¤®¢ +% „ ­­ ï ª®¬ ­¤  ­¥ ¬®¦¥â ¨¬¥âì ®¯¥à ­¤ë ¤ ­­®£® ⨯ . +asmr_e_syn_operand=07049_E_‘¨­â ªá¨ç¥áª ï ®è¨¡ª   áᥬ¡«¥à  ¢ ®¯¥p ­¤¥ +asmr_e_syn_constant=07050_E_‘¨­â ªá¨ç¥áª ï ®è¨¡ª   áᥬ¡«¥à  ¢ ª®­á⠭⥠+asmr_e_invalid_string_expression=07051_E_H¥¢¥p­®¥ áâp®ª®¢®¥ ¢ëp ¦¥­¨¥ +asmr_w_const32bit_for_address=07052_W_ª®­áâ ­â  á ᨬ¢®«®¬ $1 ¤«ï  ¤à¥á , à §¬¥à ª®â®à®£® ®â«¨ç ¥âáï ®â 㪠§ â¥«ï +% Š®­áâ ­â­®¥ ¢ëà ¦¥­¨¥, ¯à¥¤áâ ¢«ïî饥  ¤à¥á, ­¥ 㬥頥âáï ¢ ¤¨ ¯ §®­ 㪠§ â¥«ï. +% €¤à¥á, ᪮॥ ¢á¥£®, ­¥¢¥à¥­. +asmr_e_unknown_opcode=07053_E_¥¨§¢¥áâ­ë© ª®¤ ®¯¥à æ¨¨ $1 +% ¥¨§¢¥áâ­ ï ª®¬ ­¤   áᥬ¡«¥à  +asmr_e_invalid_or_missing_opcode=07054_E_H¥¢¥p­ ï ¨«¨ ¯p®¯y饭­ ï ®¯¥à æ¨ï +asmr_e_invalid_prefix_and_opcode=07055_E_H¥¢¥p­ ï ª®¬¡¨­ æ¨ï ¯p¥ä¨ªá  ¨ ®¯¥à æ¨¨: $1 +asmr_e_invalid_override_and_opcode=07056_E_H¥¢¥p­ ï ª®¬¡¨­ æ¨ï ¯¥p¥®¯p¥¤¥«¥­¨ï ¨ ®¯¥à æ¨¨: $1 +asmr_e_too_many_operands=07057_E_‘«¨èª®¬ ¬­®£® ®¯¥p ­¤®¢ ¢ áâp®ª¥ +% ‘«¨èª®¬ ¬­®£® ®¯¥à ­¤®¢ ¤«ï ¤ ­­®© ª®¬ ­¤ë. ஢¥àì⥠ᨭ⠪á¨á. +asmr_w_near_ignored=07058_W_„¨à¥ªâ¨¢  NEAR ¨£­®p¨p®¢ ­  +asmr_w_far_ignored=07059_W_„¨à¥ªâ¨¢  FAR ¨£­®p¨p®¢ ­  +asmr_e_dup_local_sym=07060_E_®¢â®p­®¥ ®¯p¥¤¥«¥­¨¥ «®ª «ì­®£® ᨬ¢®«  $1 +asmr_e_unknown_local_sym=07061_E_H¥¨§¢¥áâ­ë© «®ª «ì­ë© ᨬ¢®« $1 +asmr_e_unknown_label_identifier=07062_E_H¥¨§¢¥áâ­ ï ¬¥âª  $1 +asmr_e_invalid_register=07063_E_¥¢¥à­®¥ ¨¬ï ॣ¨áâà  +% There is an unknown register name used as operand. +asmr_e_invalid_fpu_register=07064_E_H¥¢¥à­®¥ ¨¬ï p¥£¨áâp  ¤«ï ®¯¥p æ¨¨ á ¯« ¢ î饩 § ¯ï⮩ +% ë«® ¨á¯®«ì§®¢ ­® ­¥¨§¢¥áâ­®¥ ¨¬ï ॣ¨áâà . +asmr_w_modulo_not_supported=07066_W_MODULO ­¥ ¯®¤¤¥p¦¨¢ ¥âáï +asmr_e_invalid_float_const=07067_E_H¥¢¥p­ ï ¢¥é¥á⢥­­ ï ª®­áâ ­â  $1 +% Š®­áâ ­â  á ¯« ¢ î饩 § ¯ï⮩, ®¡ê¥­­ ï ¢  áᥬ¡«¥à­®¬ ¡«®ª¥, ­¥¢¥à­ . +asmr_e_invalid_float_expr=07068_E_H¥¢¥p­®¥ ¢¥é¥á⢥­­®¥ ¢ëp ¦¥­¨¥ +% ‚ëà ¦¥­¨¥ á ¯« ¢ î饩 § ¯ï⮩, ®¡ê¥­­®¥ ¢  áᥬ¡«¥à­®¬ ¡«®ª¥, ­¥¢¥à­®. +asmr_e_wrong_sym_type=07069_E_H¥¢¥p­ë© ⨯ ᨬ¢®«  +asmr_e_cannot_index_relative_var=07070_E_H¥«ì§ï ¨­¤¥ªá¨p®¢ âì «®ª «ì­yî ¯¥p¥¬¥­­yî ¨«¨ ¯ p ¬¥âp á ¯®¬®éìî p¥£¨áâp  +%  §®¢ë© ॣ¨áâà ¨á¯®«ì§ã¥âáï ¤«ï ¨­¤¥ªá æ¨¨ ᨬ¢®« , ª®â®àë© ã¦¥ ï¥âáï ®â­®á¨â¥«ì­ë¬ +% ¯® ®â­®è¥­¨î ª ॣ¨áâàã. â® ­¥¢®§¬®¦­®, ¨ ­ ¢¥à­ïª  ¯à¨¢¥¤¥â ª ®è¨¡ª¥ ¯à¨ ¢ë¯®«­¥­¨¨. +asmr_e_invalid_seg_override=07071_E_H¥¢¥p­®¥ ¢ëp ¦¥­¨¥ ¯¥p¥®¯p¥¤¥«¥­¨ï ᥣ¬¥­â  +asmr_w_id_supposed_external=07072_W_ˆ¤¥­â¨ä¨ª â®p $1, ¯p¥¤¯®«®¦¨â¥«ì­®, ¢­¥è­¨© +% ‘á뫪  ­¥ ­¥®¯à¥¤¥«¥­­ë© ᨬ¢®«.â® ­¥ ï¥âáï ®è¨¡ª®©, +% â.ª. ᨬ¢®« ¬®¦¥â ¨¬¥âì ¢­¥è­¥¥ ®¯à¥¤¥«¥­¨¥, ­® ¬®¦¥â ¯à¨¢¥á⨠ª ¯à®¡«¥¬ ¬ +% ¯à¨ ª®¬¯®­®¢ª¥, ¥á«¨ ᨬ¢®« ­¥ ¡ë« ®¯à¥¤¥«¥­ £¤¥-­¨¡ã¤ì ¥é¥. +asmr_e_string_not_allowed_as_const=07073_E_H¥«ì§ï ¨á¯®«ì§®¢ âì áâp®ª¨ ª ª ª®­áâ ­âë +% ‘âப¨ ᨬ¢®«®¢ ­¥«ì§ï ¨á¯®«ì§®¢ âì ¢ ª ç¥á⢥ ª®­áâ ­â. +asmr_e_no_var_type_specified=07074_¥ 㪠§ ­ ⨯ ¯¥p¥¬¥­­®© +% ‘¨­â ªá¨á ¯à¥¤¯®« £ ¥â ¨¬ï ⨯  ¯®á«¥ â®çª¨, ­® ®­® ­¥ ¡ë«® ®¡­ à㦥­®. +asmr_w_assembler_code_not_returned_to_text=07075_E_€áᥬ¡«¥p­ë© ª®¤ ­¥ ¢®§¢p é ¥âáï ¢ ᥣ¬¥­â TEXT +% ‚  áᥬ¡«¥à­®¬ ¡«®ª¥ ¡ë«  ¤¨à¥ªâ¨¢  ᬥ­ë ᥪ権, ­® ¢ ª®­æ¥ ¡«®ª  ®âáãâáâ¢ã¥â ¤¨à¥ªâ¨¢  +% ¢®§¢à â  ¢ ᥣ¬¥­â ⥪áâ . Œ®¦¥â ¡ëâì ¯à¨ç¨­®© ®è¨¡®ª ¯à¨ ª®¬¯®­®¢ª¥. +asmr_e_not_directive_or_local_symbol=07076_E_$1 ­¥ ï¥âáï ¤¨p¥ªâ¨¢®© ¨«¨ «®ª «ì­ë¬ ᨬ¢®«®¬ +% “ª § ­­ë© ᨬ¢®« ­¥¨§¢¥á⥭. +asmr_w_using_defined_as_local=07077_E_ˆá¯®«ì§®¢ ­¨¥ ®¯p¥¤¥«¥­­®£® ¨¬¥­¨ ¢ ª ç¥á⢥ «®ª «ì­®© ¬¥âª¨ +asmr_e_dollar_without_identifier=07078_E_‘¨¬¢®« '$' ¨á¯®«ì§y¥âáï ¡¥§ ¨¤¥­â¨ä¨ª â®p  +% ‚ ª®­áâ ­â­®¬ ¢ëà ¦¥­¨¨ ¢áâà¥â¨«áï ¨¤¥­â¨ä¨ª â®à, ­¥ ­ ç¨­ î騩áï á ᨬ¢®«  $. +asmr_w_32bit_const_for_address=07079_W_32-¡¨â­ ï ª®­áâ ­â  ¨á¯®«ì§®¢ ­  ¤«ï  ¤p¥á  +% Š®­áâ ­â  ¨á¯®«ì§®¢ ­  ¢ ª ç¥á⢥  ¤à¥á . ⮠ï¥âáï ¯à¨§­ ª®¬ ®è¨¡ª¨, +% ¯®áª®«ìªã  ¡á®«îâ­ ï  ¤à¥á æ¨ï ®¡ëç­® ­¥ à ¡®â ¥â. +asmr_n_align_is_target_specific=07080_N_.ALIGN ï¥âáï ¯« âä®à¬¥­­®-§ ¢¨á¨¬®©, ¨á¯®«ì§y©â¥ .BALIGN ¨«¨ .P2ALIGN +% „¥©á⢨¥ ¨ §­ ç¥­¨¥ ¤¨à¥ªâ¨¢ë .align ¬®¦¥â ¨§¬¥­ïâìáï ¢ § ¢¨á¨¬®á⨠®â +% 楫¥¢®© ¯« âä®à¬ë. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_®«ï ¯ p ¬¥âp  ­¥¤®áâã¯­ë ­ ¯pï¬yî, ¨á¯®«ì§y©â¥ p¥£¨áâpë +%  à ¬¥âà á«¥¤ã¥â § £à㧨âì ¢ ॣ¨áâà ¨ § â¥¬  ¤à¥á®¢ âì ¯®«ï ¯ à ¬¥âà  ®â­®á¨â¥«ì­® +% í⮣® ॣ¨áâà . +asmr_e_cannot_access_object_field_directly=07082_E_®«ï ®¡ê¥ªâ®¢/ª« áᮢ ­¥¤®áâã¯­ë ­ ¯pï¬yî, ¨á¯®«ì§y©â¥ p¥£¨áâpë +% ‘«¥¤ã¥â § £à㧨âì 㪠§ â¥«ì ­  self ¢ ॣ¨áâà ¨ § â¥¬  ¤à¥á®¢ âì ¯®«ï, ¨á¯®«ì§ãï ॣ¨áâà +% ¢ ª ç¥á⢥ ¡ §ë. ® 㬮«ç ­¨î 㪠§ â¥«ì ­  self ¤®áâ㯥­ +% ¢ ॣ¨áâॠesi ­  i386. +asmr_e_unable_to_determine_reference_size=07083_E_ §¬¥p ®¯¥à ­¤®¢ ­¥ 㪠§ ­ ¨ ¥£® ®¯à¥¤¥«¥­¨¥ ­¥¢®§¬®¦­® +%  §¬¥à áá뫪¨ á«¥¤ã¥â 㪠§ âì ®, â.ª. ª®¬¯¨«ïâ®à ­¥ ¬®¦¥â +% ®¯à¥¤¥«¨âì, ª ª®© à §¬¥à (byte,word,dword ¨ â.¤.) ®­ +% ¤®«¦¥­ ¨á¯®«ì§®¢ âì. +asmr_e_cannot_use_RESULT_here=07084_E_‚ í⮩ ä㭪樨 ¨á¯®«ì§®¢ âì RESULT ­¥«ì§ï +% ¥ª®â®àë¥ ä㭪樨, ¢®§¢à é î騥 १ã«ìâ â á«®¦­®£® ⨯ , ­¥ ¬®£ã⠨ᯮ«ì§®¢ âì ¯¥à¥¬¥­­ãî +% \var{result}. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" ¡¥§ ®¯¥à ­¤  â࠭᫨àã¥âáï ¢ "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" â࠭᫨àã¥âáï ¢ "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" â࠭᫨àã¥âáï ¢ "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_‘¨¬¢®« < §¤¥áì ­¥ à §à¥è¥­ +% Ž¯¥à â®à ᤢ¨£  âॡã¥â ᨬ¢®«®¢ <<. ë« ®¡­ à㦥­ ⮫쪮 ®¤¨­ ¨§ ­¨å. +asmr_e_invalid_char_greater=07090_E_‘¨¬¢®« > §¤¥áì ­¥ à §à¥è¥­ +% Ž¯¥à â®à ᤢ¨£  âॡã¥â ᨬ¢®«®¢ >>. ë« ®¡­ à㦥­ ⮫쪮 ®¤¨­ ¨§ ­¨å. +asmr_w_align_not_supported=07093_W_ALIGN ­¥ ¯®¤¤¥à¦¨¢ ¥âáï +asmr_e_no_inc_and_dec_together=07094_E_Inc ¨ Dec ­¥ ¬®£ã⠨ᯮ«ì§®¢ âìáï ®¤­®¢à¥¬¥­­® +% Ž¤­®¢à¥¬¥­­®¥ ¨á¯®«ì§®¢ ­¨¥ ¨­ªà¥¬¥­â  ¨ ¤¥ªà¥¬¥­â  ¢ ®¤­®¬ ®¯¥à ­¤¥ +% ­  680x0. â® ­¥¤®¯ãá⨬®. +asmr_e_invalid_reg_list_in_movem=07095_E_¥¢¥à­ë© ᯨ᮪ ॣ¨áâ஢ ¤«ï movem +% ˆá¯®«ì§®¢ ­¨¥ ¨­áâàãªæ¨¨ \var{movem} á ­¥¢¥à­ë¬¨ ॣ¨áâà ¬¨ ¤«ï á®åà ­¥­¨ï/¢®ááâ ­®¢«¥­¨ï. +asmr_e_invalid_reg_list_for_opcode=07096_E_¥¢¥à­ë© ᯨ᮪ ॣ¨áâ஢ ¤«ï ª®¬ ­¤ë +asmr_e_higher_cpu_mode_required=07097_E_’ॡã¥âáï ०¨¬ ¡®«¥¥ ᮢ६¥­­®£® ¯à®æ¥áá®à  ($1) +% ˆá¯®«ì§®¢ ­¨¥ ¨­áâàãªæ¨¨, ª®â®à ï ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ¢ ⥪ã饬 ०¨¬¥ ¯à®æ¥áá®à . +% ˆá¯®«ì§ã©â¥ ०¨¬ ¤«ï á«¥¤ãîé¨å ¯®ª®«¥­¨© ¯à®æ¥áá®à®¢. +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_ §¬¥à ®¯¥à ­¤®¢ ­¥ 㪠§ ­ ¨ ¥£® ­¥ 㤠¥âáï ®¯à¥¤¥«¨âì, ¨á¯®«ì§ã¥âáï DWORD ¯® 㬮«ç ­¨î +%  §¬¥à áá뫪¨ á«¥¤ã¥â 㪠§ âì ®, â.ª. ª®¬¯¨«ïâ®à ­¥ ¬®¦¥â +% ®¯à¥¤¥«¨âì, ª ª®© à §¬¥à (byte,word,dword ¨ â.¤.) ®­ +% ¤®«¦¥­ ¨á¯®«ì§®¢ âì. ‚뤠¥âáï ⮫쪮 ¢ ०¨¬¥ Delphi, ª®£¤  +% ¯® 㬮«ç ­¨î ¨á¯®«ì§ã¥âáï à §¬¥à DWORD. +asmr_e_illegal_shifterop_syntax=07099_E_‘¨­â ªá¨ç¥áª ï ®è¨¡ª  ¢ ®¯¥à ­¤¥ ᤢ¨£  +% ’®«ìª® ARM;  áᥬ¡«¥à ARM ¯®¤¤¥à¦¨¢ ¥â â.­. ®¯¥à ­¤ ᤢ¨£ . ˆá¯®«ì§®¢ ­­ë© ¤«ï ­¥£® ᨭ⠪á¨á +% ­¥¢¥à¥­. ਬ¥à ¨­áâàãªæ¨¨ á ®¯¥à ­¤®¬ ᤢ¨£ : +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +asmr_e_packed_element=07100_E_€¤à¥á 㯠ª®¢ ­­®£® ª®¬¯®­¥­â  ­¥ ᮢ¯ ¤ ¥â á £à ­¨æ¥© ¡ ©â  +% “¯ ª®¢ ­­ë¥ ª®¬¯®­¥­âë (¯®«ï § ¯¨á¥© ¨ í«¥¬¥­âë ¬ áᨢ®¢) ¬®£ãâ ­ ç¨­ âìáï +% á ¯à®¨§¢®«ì­®£® ¡¨â  ¢ ¡ ©â¥. ‘«¥¤®¢ â¥«ì­®, ­  ¯à®æ¥áá®à¥, ­¥ ¯®¤¤¥à¦¨¢ î饣® +% ¡¨â®¢ãî  ¤à¥á æ¨î ¯ ¬ï⨠(  ¢á¥ ¯®¤¤¥à¦¨¢ ¥¬ë¥ FPC ¯à®æ¥áá®àë ïîâáï ¨¬¥­­® â ª¨¬¨), +% ¡ã¤¥â ¢ë¤ ­  ®è¨¡ª  ¯à¨ ¯®¯ë⪥ ¤®áâ㯠 ¯® ¨­¤¥ªáã ª ¬ áᨢ ¬, à §¬¥à í«¥¬¥­â  ª®â®àëå +% ­¥ ªà â¥­ 8 ¡¨â ¬. â® á¯à ¢¥¤«¨¢® ¨ ¤«ï ¯®«¥© § ¯¨á¥© á â ª¨¬¨  ¤à¥á ¬¨. +asmr_w_unable_to_determine_reference_size_using_byte=07101_W_ §¬¥à ®¯¥à ­¤®¢ ­¥ 㪠§ ­ ¨ ¥£® ­¥ 㤠¥âáï ®¯à¥¤¥«¨âì, ¨á¯®«ì§ã¥âáï BYTE ¯® 㬮«ç ­¨î +%  §¬¥à áá뫪¨ á«¥¤ã¥â 㪠§ âì ®, â.ª. ª®¬¯¨«ïâ®à ­¥ ¬®¦¥â +% ®¯à¥¤¥«¨âì, ª ª®© à §¬¥à (byte,word,dword ¨ â.¤.) ®­ +% ¤®«¦¥­ ¨á¯®«ì§®¢ âì. ‚뤠¥âáï ⮫쪮 ¢ ०¨¬¥ Delphi, ª®£¤  +% ¯® 㬮«ç ­¨î ¨á¯®«ì§ã¥âáï à §¬¥à BYTE. +asmr_w_no_direct_ebp_for_parameter=07102_W_‡¤¥áì ­¥«ì§ï ¨á¯®«ì§®¢ âì +offset(%ebp) ¤«ï ¯ à ¬¥â஢ +% ˆá¯®«ì§®¢ ­¨¥ ¯àאַ© áá뫪¨ ¢¨¤  8(%ebp) ¤«ï ¯ à ¬¥â஢ ¯à®æ¥¤ãàë/ä㭪樨 ­¥¢¥à­®, ¥á«¨ +% ¯ à ¬¥âàë ­ å®¤ïâáï ¢ ॣ¨áâà å. +asmr_w_direct_ebp_for_parameter_regcall=07103_W_ˆá¯®«ì§®¢ ­¨¥ +offset(%ebp) ­¥á®¢¬¥á⨬® á ⨯®¬ ¢ë§®¢  regcall +% ˆá¯®«ì§®¢ ­¨¥ ¯àאַ© áá뫪¨ ¢¨¤  8(%ebp) ¤«ï ¯ à ¬¥â஢ ¯à®æ¥¤ãàë/ä㭪樨 ­¥¢¥à­®, ¥á«¨ +% ¯ à ¬¥âàë ­ å®¤ïâáï ¢ ॣ¨áâà å. +asmr_w_direct_ebp_neg_offset=07104_W_ˆá¯®«ì§®¢ ­¨¥ -offset(%ebp) ¤«ï «®ª «ì­ëå ¯¥à¥¬¥­­ëå ­¥ ४®¬¥­¤ã¥âáï +% ˆá¯®«ì§®¢ ­¨¥ ááë«®ª ¢¨¤  -8(%ebp) ¤«ï ¤®áâ㯠 ª «®ª «ì­ë¬ ¯¥à¥¬¥­­ë¬ ­¥ ४®¬¥­¤ã¥âáï. +asmr_w_direct_esp_neg_offset=07105_W_ˆá¯®«ì§®¢ ­¨¥ -offset(%esp), ¢®§¬®¦¥­ á¡®© ¯à¨ ¤®áâ㯥 ¨«¨ ¯®â¥àï §­ ç¥­¨ï +% ˆá¯®«ì§®¢ ­¨¥ ááë«®ª ¢¨¤  -8(%esp) ¤«ï ¤®áâ㯠 ª «®ª «ì­®¬ã á⥪㠭¥ ४®¬¥­¤ã¥âáï, +% ¯®â®¬ã çâ® íâ  ç áâì á⥪  ¬®¦¥â ¡ëâì § â¥àâ  ¯à¨ ¢ë§®¢¥ «î¡®© ä㭪樨 ¨«¨ ¯à¨ ¯à¥à뢠­¨¨. +asmr_e_no_vmtoffset_possible=07106_E_VMTOffset á«¥¤ã¥â ¨á¯®«ì§®¢ âì ¢ ª®¬¡¨­ æ¨¨ á ¢¨àâã «ì­ë¬ ¬¥â®¤®¬, "$1" ­¥ ï¥âáï ¢¨àâã «ì­ë¬ +% ’®«ìª® ¢¨àâã «ì­ë¥ ¬¥â®¤ë ¨¬¥îâ ᬥ饭¨¥ ¢ VMT. +asmr_e_need_pic_ref=07107_E_‚ ०¨¬¥ ¯®§¨æ¨®­­®-­¥§ ¢¨á¨¬®£® ª®¤  ­ ©¤¥­  ¯®§¨æ¨®­­®-§ ¢¨á¨¬ ï áá뫪  +% ¥¦¨¬ ª®¬¯¨«ï樨 ¯à¥¤ãᬠâਢ ¥â £¥­¥à æ¨î ¯®§¨æ¨®­­®-­¥§ ¢¨á¨¬®£® ª®¤  +% (PIC), ­® ¢ ¤ ­­®© ­ ¯¨á ­­®© ¢àãç­ãî  áᥬ¡«¥à­®© ¨­áâàãªæ¨¨ ᮤ¥à¦¨âáï +% ¯®§¨æ¨®­­®-§ ¢¨á¨¬ ï áá뫪 . +# +# Assembler/binary writers +# +# 08020 is the last used one +# +asmw_f_too_many_asm_files=08000_F_‘«¨èª®¬ ¬­®£®  áᥬ¡«¥à­ëå ä ©«®¢ +% "“¬­ ï" ª®¬¯®­®¢ª  ¯à¨¢®¤¨â ª ¯®«ã祭¨î ᫨誮¬ ¡®«ì讣® ª®«¨ç¥á⢠ +%  áᥬ¡«¥à­ëå ä ©«®¢. Žâª«îç¨â¥ ¥¥. +asmw_f_assembler_output_not_supported=08001_F_‚ë¡p ­­ë© ¢ë室­®© ä®à¬ â  áᥬ¡«¥p  ­¥ ¯®¤¤¥p¦¨¢ ¥âáï +asmw_f_comp_not_supported=08002_F_COMP ­¥ ¯®¤¤¥p¦¨¢ ¥âáï +asmw_f_direct_not_supported=08003_F_’¨¯  áᥬ¡«¥p  direct ­¥ ¯®¤¤¥p¦¨¢ ¥âáï á ¤¢®¨ç­ë¬ ¢ë室­ë¬ ä®à¬ â®¬ +% ’¨¯  áᥬ¡«¥à  direct ¯à¥¤¯®« £ ¥â § ¯¨áì ¯à®ç¨â ­­®£®  áᥬ¡«¥à­®£® ⥪áâ  ­ ¯àï¬ãî ¢ ¢ë室­®© ä ©«, +% ¯à¨ í⮬ ¢ë室­®© ä ©« ­¥ ¬®¦¥â ¡ëâì ¤¢®¨ç­ë¬. ‚ë¡¥à¨â¥ ⥪áâ®¢ë© ä®à¬ â ¢ë室­ëå ä ©«®¢. +asmw_e_alloc_data_only_in_bss=08004_E_‚뤥«¥­¨¥ ¯ ¬ï⨠¤«ï ¤ ­­ëå à §à¥è¥­® ⮫쪮 ¢ ᥪ樨 BSS +asmw_f_no_binary_writer_selected=08005_F_¥ ¢ë¡à ­ ¤¢®¨ç­ë© ¢ë室­®© ä®à¬ â +asmw_e_opcode_not_in_table=08006_E_Asm: Š®¤  ª®¬ ­¤ë $1 ­¥â ¢ ᯨ᪥ +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 ­¥¢¥p­®¥ á®ç¥â ­¨¥ ª®¬ ­¤ë ¨ ®¯¥p ­¤®¢ +asmw_e_16bit_not_supported=08008_E_Asm: 16-¡¨â­ë¥ áá뫪¨ ­¥ ¯®¤¤¥p¦¨¢ îâáï +asmw_e_invalid_effective_address=08009_E_Asm: H¥¢¥p­ë© íä䥪⨢­ë©  ¤p¥á +asmw_e_immediate_or_reference_expected=08010_E_Asm: Ž¦¨¤ ¥âáï IMMEDIATE ¨«¨ áá뫪  +asmw_e_value_exceeds_bounds=08011_E_Asm: §­ ç¥­¨¥ $1 ¢ë室¨â §  £p ­¨æë $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: Š®à®âª¨© ¯¥à¥å®¤ ¢ë室¨â §  £p ­¨æë $1 +asmw_e_undefined_label=08013_E_Asm: Œ¥âª  $1 ­¥ ®¯à¥¤¥«¥­  +asmw_e_comp_not_supported=08014_E_Asm: ’¨¯ comp ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ¤«ï í⮩ ¯« âä®à¬ë +asmw_e_extended_not_supported=08015_E_Asm: ’¨¯ extended ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ¤«ï í⮩ ¯« âä®à¬ë +asmw_e_duplicate_label=08016_E_Asm: ®¢â®àïîé ïáï ¬¥âª  $1 +asmw_e_redefined_label=08017_E_Asm: ®¢â®à­®¥ ®¯à¥¤¥«¥­¨¥ ¬¥âª¨ $1 +asmw_e_first_defined_label=08018_E_Asm: ¥à¢®­ ç «ì­® ®¯à¥¤¥«ï¥âáï §¤¥áì +asmw_e_invalid_register=08019_E_Asm: ¥¢¥à­ë© ॣ¨áâà $1 +asmw_e_16bit_32bit_not_supported=08020_E_Asm: 16- ¨ 32-¡¨â­ë¥ áá뫪¨ ­¥ ¯®¤¤¥à¦¨¢ îâáï +asmw_e_64bit_not_supported=08021_E_Asm: 64-¡¨â­ë¥ ®¯¥à ­¤ë ­¥ ¯®¤¤¥à¦¨¢ îâáï + +# +# Executing linker/assembler +# +# 09032 is the last used one +# +# BeginOfTeX +% +% \section{Žè¨¡ª¨ áâ ¤¨¨  áᥬ¡«¨à®¢ ­¨ï/ª®¬¯®­®¢ª¨} +% ¥à¥ç¨á«ïîâáï ®è¨¡ª¨, ª®â®àë¥ ¬®£ãâ ¨¬¥âì ¬¥áâ® ¢® ¢à¥¬ï ®¡à ¡®âª¨ +% ª®¬ ­¤­®© áâப¨ ¨ ä ©«®¢ ª®­ä¨£ãà æ¨¨. +% \begin{description} +exec_w_source_os_redefined=09000_W_ˆá室­ ï ®¯¥p æ¨®­­ ï á¨á⥬  ¯¥p¥®¯p¥¤¥«¥­  +% ˆá室­ ï ®¯¥à æ¨®­­ ï á¨áâ¥¬ë ¯¥à¥®¯à¥¤¥«¥­ . +exec_i_assembling_pipe=09001_I_€áᥬ¡«¨py¥âáï (pipe) $1 +% €áᥬ¡«¨à®¢ ­¨¥ á ¨á¯®«ì§®¢ ­¨¥¬ ª ­ «  (pipe) ¤«ï ®¡¬¥­  ¤ ­­ë¬¨ á ¢­¥è­¨¬  áᥬ¡«¥à®¬. +exec_d_cant_create_asmfile=09002_E_H¥¢®§¬®¦­® ᮧ¤ âì  áᬥ¡«¥p­ë© ä ©«: $1 +% “ª § ­­ë© ä ©« ­¥ ¬®¦¥â ¡ëâì ᮧ¤ ­. ஢¥àìâ¥, ¥á«¨ «¨ +% à §à¥è¥­¨¥ ­  ᮧ¤ ­¨¥ ä ©« . +exec_e_cant_create_objectfile=09003_E_¥¢®§¬®¦­® ᮧ¤ âì ®¡ê¥ªâ­ë© ä ©«: $1 +% “ª § ­­ë© ä ©« ­¥ ¬®¦¥â ¡ëâì ᮧ¤ ­. ஢¥àìâ¥, ¥á«¨ «¨ +% à §à¥è¥­¨¥ ­  ᮧ¤ ­¨¥ ä ©« . +exec_e_cant_create_archivefile=09004_E_¥¢®§¬®¦­® ᮧ¤ âì ä ©«  à娢 : $1 +% “ª § ­­ë© ä ©« ­¥ ¬®¦¥â ¡ëâì ᮧ¤ ­. ஢¥àìâ¥, ¥á«¨ «¨ +% à §à¥è¥­¨¥ ­  ᮧ¤ ­¨¥ ä ©« . +exec_e_assembler_not_found=09005_E_€áᥬ¡«¥p $1 ­¥ ­ ©¤¥­, ¯¥à¥å®¤ ­  ¢­¥è­îî á¡®àªã +% ணࠬ¬   áᥬ¡«¥à  ­¥ ­ ©¤¥­ . Š®¬¯¨«ïâ®à ᮧ¤ áâ áªà¨¯â, +% ¯®§¢®«ïî騩  áᥬ¡«¨à®¢ âì ¨ ᪮¬¯®­®¢ âì ¯à®£à ¬¬ã ¯®§¤­¥¥. +exec_t_using_assembler=09006_T_ˆá¯®«ì§y¥âáï  áᥬ¡«¥p: $1 +% ˆ­ä®à¬ æ¨ï ® ⮬, ª ª®© ¨¬¥­­®  áᥬ¡«¥à ¨á¯®«ì§ã¥âáï. +exec_e_error_while_assembling=09007_E_Žè¨¡ª   áᥬ¡«¨p®¢ ­¨ï, ª®¤ ¢®§¢à â  $1 +% ਠ®¡à ¡®âª¥ ä ©«  ¢­¥è­¨¬  áᥬ¡«¥à®¬ ¯à®¨§®è«  ®è¨¡ª . ®¤à®¡­®á⨠+% ¬®¦­® ­ ©â¨ ¢ à㪮¢®¤á⢥ ª ¨á¯®«ì§ã¥¬®© ¯à®£à ¬¬¥  áᥬ¡«¥à . +exec_e_cant_call_assembler=09008_E_Žè¨¡ª  $1 ¯à¨ § ¯ã᪥  áᥬ¡«¥à , ¯¥à¥å®¤ ­  ¢­¥è­îî á¡®àªã +% Žè¨¡ª  ¯à¨ § ¯ã᪥ ¢­¥è­¥£®  áᥬ¡«¥à . Š®¬¯¨«ïâ®à ᮧ¤ áâ áªà¨¯â, +% ¯®§¢®«ïî騩  áᥬ¡«¨à®¢ âì ¨ ᪮¬¯®­®¢ âì ¯à®£à ¬¬ã ¯®§¤­¥¥. +exec_i_assembling=09009_I_€áᥬ¡«¨pã¥âáï $1 +% ˆ­ä®à¬ æ¨ï ® ⮬, ª ª®© ä ©«  áᥬ¡«¨àã¥âáï. +exec_i_assembling_smart=09010_I_€áᥬ¡«¨pã¥âáï á "㬭®©" ᡮમ© $1 +% ˆ­ä®à¬ æ¨ï ® ⮬, ª ª®© ä ©«  áᥬ¡«¨àã¥âáï á ¯®¤¤¥à¦ª®© "㬭®©" ᡮન. +exec_w_objfile_not_found=09011_W_Ž¡ê¥ªâ­ë© ä ©« $1 ­¥ ­ ©¤¥­, ª®¬¯®­®¢ª  ¬®¦¥â ­¥ y¤ âìáï! +% Ž¤¨­ ¨§ ®¡ê¥ªâ­ëå ä ©«®¢ ­¥ ­ ©¤¥­, ¨ ª®¬¯®­®¢ª , ᪮॥ ¢á¥£®, ­¥ 㤠áâáï. +% ஢¥àì⥠¯ãâ¨. +exec_w_libfile_not_found=09012_W_¨¡«¨®â¥ª  $1 ­¥ ­ ©¤¥­ , ª®¬¯®­®¢ª  ¬®¦¥â ­¥ y¤ âìáï! +% Ž¤¨­ ¨§ ä ©«®¢ ¡¨¡«¨®â¥ª ­¥ ­ ©¤¥­, ¨ ª®¬¯®­®¢ª , ᪮॥ ¢á¥£®, ­¥ 㤠áâáï. +% ஢¥àì⥠¯ãâ¨. +exec_e_error_while_linking=09013_E_Žè¨¡ª  ¯p¨ ª®¬¯®­®¢ª¥ +% Ž¡é ï ®è¨¡ª  ¯à¨ ª®¬¯®­®¢ª¥. +exec_e_cant_call_linker=09014_E_H¥ 㤠¥âáï ¢ë§¢ âì ª®¬¯®­®¢é¨ª, ¯¥à¥å®¤ ­  ¢­¥è­îî ª®¬¯®­®¢ªã +% Žè¨¡ª  ¯à¨ § ¯ã᪥ ¢­¥è­¥£® ª®¬¯®­®¢é¨ª . Š®¬¯¨«ïâ®à ᮧ¤ áâ áªà¨¯â, +% ¯®§¢®«ïî騩  áᥬ¡«¨à®¢ âì ¨ ᪮¬¯®­®¢ âì ¯à®£à ¬¬ã ¯®§¤­¥¥. +exec_i_linking=09015_I_Š®¬¯®­®¢ª  $1 +% ˆ­ä®à¬ æ¨ï ® ⮬, ª ª ï ¯à®£à ¬¬  ¨«¨ ¡¨¡«¨®â¥ª  ª®¬¯®­ã¥âáï. +exec_e_util_not_found=09016_E_“⨫¨â  $1 ­¥ ­ ©¤¥­ , ¯¥p¥å®¤ ­  ¢­¥è­îî ª®¬¯®­®¢ªã +% ‚­¥è­ïï ã⨫¨â  ­¥ ­ ©¤¥­ . Š®¬¯¨«ïâ®à ᮧ¤ áâ áªà¨¯â, +% ¯®§¢®«ïî騩 ¯à®¨§¢¥á⨠­¥ã¤ ¢è¨¥áï ¤¥©áâ¢¨ï ¯®§¤­¥¥. +exec_t_using_util=09017_T_ˆá¯®«ì§ã¥âáï ã⨫¨â  $1 +% ˆ­ä®à¬ æ¨®­­®¥ á®®¡é¥­¨¥ ® ⮬, ª ª ï ã⨫¨â  ¨á¯®«ì§ã¥âáï (®¡ëç­® íâ® ¯®áâ-¯à®æ¥áá®à). +exec_e_exe_not_supported=09018_E_‘®§¤ ­¨¥ ¨á¯®«­ï¥¬ëå ä ©«®¢ ­¥ ¯®¤¤¥p¦¨¢ ¥âáï +% ‘®§¤ ­¨¥ ¨á¯®«­ï¥¬ëå ä ©«®¢ ¤«ï í⮩ ¯« âä®à¬ë ¥é¥ ­¥ ॠ«¨§®¢ ­® ¢ ª®¬¯¨«ïâ®à¥ +% ¨ ¯®â®¬ã ­¥¢®§¬®¦­®. +exec_e_dll_not_supported=09019_E_‘®§¤ ­¨¥ ¤¨­ ¬¨ç¥áª¨å ¡¨¡«¨®â¥ª (DLL) ­¥ ¯®¤¤¥p¦¨¢ îâáï +% ‘®§¤ ­¨¥ ¤¨­ ¬¨ç¥áª¨ § £à㦠¥¬ëå ¡¨¡«¨®â¥ª ¤«ï í⮩ ¯« âä®à¬ë ¥é¥ ­¥ ॠ«¨§®¢ ­® ¢ ª®¬¯¨«ïâ®à¥ +% ¨ ¯®â®¬ã ­¥¢®§¬®¦­®. +exec_i_closing_script=09020_I_‘®§¤ ­ áªp¨¯â $1 +% ˆ­ä®à¬ æ¨ï ®¡ ®ª®­ç ­¨¨ § ¯¨á¨ áªà¨¯â  ¤«ï ¢­¥è­¥£®  áᥬ¡«¨à®¢ ­¨ï/ª®¬¯®­®¢ª¨. +exec_e_res_not_found=09021_E_Š®¬¯¨«ïâ®p p¥áypᮢ "$1" ­¥ ­ ©¤¥­, ¯¥p¥å®¤ ¢® ¢­¥è­¨© ०¨¬ +% Žè¨¡ª  ¯à¨ § ¯ã᪥ ¢­¥è­¥£® ª®¬¯¨«ïâ®à  à¥áãàᮢ. Š®¬¯¨«ïâ®à ᮧ¤ áâ áªà¨¯â, +% ¯®§¢®«ïî騩 ¢ë¯®«­¨âì ­¥ã¤ ¢è¨¥áï ¤¥©áâ¢¨ï ¨ § ¢¥àè¨âì ᮧ¤ ­¨¥ ¯à®£à ¬¬ë ¯®§¤­¥¥. +exec_i_compilingresource=09022_I_Š®¬¯¨«ïæ¨ï p¥áypá  $1 +% ˆ­ä®à¬ æ¨ï ® ⮬, ª ª®© ä ©« à¥áãàᮢ ª®¬¯¨«¨àã¥âáï. +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_¬®¤y«ì $1 ­¥ ¬®¦¥â ¡ëâì ᪮¬¯®­®¢ ­ áâ â¨ç¥áª¨, ¯¥à¥å®¤ ­  "㬭ãî" ª®¬¯®­®¢ªã +% ‡ ¯à®è¥­  áâ â¨ç¥áª ï ª®¬¯®­®¢ª , ­® ¨á¯®«ì§®¢ ­­ë© ¬®¤ã«ì ­¥ ¤®¯ã᪠¥â íâ®â ०¨¬. +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_¬®¤y«ì $1 ­¥ ¬®¦¥â ¡ëâì ᪮¬¯®­®¢ ­ ¢ "㬭®¬" p¥¦¨¬¥, ¯¥à¥å®¤ ­  áâ â¨ç¥áªãî ª®¬¯®­®¢ªã +% ‡ ¯à®è¥­  "㬭 ï" ª®¬¯®­®¢ª , ­® ¨á¯®«ì§®¢ ­­ë© ¬®¤ã«ì ­¥ ¤®¯ã᪠¥â íâ®â ०¨¬. +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_¬®¤y«ì $1 ­¥ ¬®¦¥â ¡ëâì ᪮¬¯®­®¢ ­ ¢ p¥¦¨¬¥ shared, ¯¥à¥å®¤ ­  áâ â¨ç¥áªãî ª®¬¯®­®¢ªã +% ‡ ¯à®è¥­  à §¤¥«ï¥¬ ï ª®¬¯®­®¢ª , ­® ¨á¯®«ì§®¢ ­­ë© ¬®¤ã«ì ­¥ ¤®¯ã᪠¥â íâ®â ०¨¬. +exec_e_unit_not_smart_or_static_linkable=09026_E_¬®¤y«ì $1 ­¥ ¬®¦¥â ¡ëâì ᪮¬¯®­®¢ ­ ¢ p¥¦¨¬ å smart ¨«¨ static +% ‡ ¯à®è¥­  "㬭 ï" ¨«¨ áâ â¨ç¥áª ï ª®¬¯®­®¢ª , ­® ¨á¯®«ì§®¢ ­­ë© ¬®¤ã«ì ­¥ ¤®¯ã᪠¥â ­¨ ®¤¨­ ¨§ íâ¨å ०¨¬®¢. +exec_e_unit_not_shared_or_static_linkable=09027_E_¬®¤y«ì $1 ­¥ ¬®¦¥â ¡ëâì ᮡp ­ ¢ p¥¦¨¬ å shared ¨«¨ static +% ‡ ¯à®è¥­  à §¤¥«ï¥¬ ï ¨«¨ áâ â¨ç¥áª ï ª®¬¯®­®¢ª , ­® ¨á¯®«ì§®¢ ­­ë© ¬®¤ã«ì ­¥ ¤®¯ã᪠¥â ­¨ ®¤¨­ ¨§ íâ¨å ०¨¬®¢. +exec_d_resbin_params=09028_D_‚맮¢ ª®¬¯¨«ïâ®à  à¥áãàᮢ "$1" á ª®¬ ­¤­®© áâப®© "$2" +% ˆ­ä®à¬ æ¨ï ®¡ ¨á¯®«ì§ã¥¬®¬ ª®¬¯¨«ïâ®à¥ à¥áãàᮢ ¨ ¥£® ª®¬ ­¤­®© áâப¥. +exec_e_error_while_compiling_resources=09029_E_Žè¨¡ª  ¯à¨ ª®¬¯¨«ï樨 à¥áãàᮢ +% Š®¬¯¨«ïâ®à ¨«¨ ª®­¢¥àâ®à à¥áãàᮢ § ¢¥à訫áï á ®è¨¡ª®©. +exec_e_cant_call_resource_compiler=09030_E_‚맮¢ ª®¬¯¨«ïâ®à  à¥áãàᮢ "$1" ­¥¢®§¬®¦¥­, ¯¥à¥å®¤ ¢® ¢­¥è­¨© ०¨¬ +% Žè¨¡ª  ¯à¨ ¢ë§®¢¥ ª®¬¯¨«ïâ®à  à¥áãàᮢ. Š®¬¯¨«ïâ®à ᮧ¤ áâ áªà¨¯â, +% ¯®§¢®«ïî騩 ¯®¢â®à¨âì ­¥ã¤ ¢è¨¥áï ¤¥©áâ¢¨ï ¨ § ¢¥àè¨âì ᮧ¤ ­¨¥ ¯à®£à ¬¬ë +% ¯®§¤­¥¥. +exec_e_cant_open_resource_file=09031_E_¥¢®§¬®¦­® ®âªàëâì ä ©« à¥áãàᮢ "$1" +% Žè¨¡ª  ¯à¨ ®âªàë⨨ 㪠§ ­­®£® ä ©«  à¥áãàᮢ. +exec_e_cant_write_resource_file=09032_E_Žè¨¡ª  § ¯¨á¨ ä ©«  à¥áãàᮢ "$1" +% Žè¨¡ª  ¯à¨ § ¯¨á¨ 㪠§ ­­®£® ä ©«  à¥áãàᮢ. +%\end{description} +# EndOfTeX + +# +# Executable information +# +# 09134 is the last used one +# +# BeginOfTeX +% \section{ˆ­ä®à¬ æ¨ï ®¡ ¨á¯®«­ï¥¬ëå ä ©« å.} +% ‘®¤¥à¦¨â á®®¡é¥­¨ï, ¢ë¤ ¢ ¥¬ë¥ ¯à¨ ᮧ¤ ­¨¨ ¨á¯®«­ï¥¬®£® ä ©«  +% á ¨á¯®«ì§®¢ ­¨¥¬ ¢­ãâ७­¥£® ª®¬¯®­®¢é¨ª . +% \begin{description} +execinfo_f_cant_process_executable=09128_F_®áâ-®¡à ¡®âª  ¨á¯®«­ï¥¬®£® ä ©«  $1 ­¥¢®§¬®¦­  +% ” â «ì­ ï ®è¨¡ª  ¯à¨ ­¥¢®§¬®¦­®á⨠¯®áâ-®¡à ¡®âª¨ ¨á¯®«­ï¥¬®£® ä ©« . +execinfo_f_cant_open_executable=09129_F_¥¢®§¬®¦­® ®âªàëâì ¨á¯®«­ï¥¬ë© ä ©« $1 +% ” â «ì­ ï ®è¨¡ª  ¯à¨ ­¥¢®§¬®¦­®á⨠®âªàëâì ¨á¯®«­ï¥¬ë© ä ©«. +execinfo_x_codesize=09130_X_ §¬¥à ª®¤ : $1 ¡ ©â +% ˆ­ä®à¬ æ¨ï ® à §¬¥à¥ ᮧ¤ ­­®© ᥪ樨 ª®¤ . +execinfo_x_initdatasize=09131_X_ §¬¥à ¨­¨æ¨ «¨§¨à®¢ ­­ëå ¤ ­­ëå: $1 ¡ ©â +% ˆ­ä®à¬ æ¨ï ® à §¬¥à¥ ᮧ¤ ­­®© ᥪ樨 ¨­¨æ¨ «¨§¨à®¢ ­­ëå ¤ ­­ëå. +execinfo_x_uninitdatasize=09132_X_ §¬¥à ­¥¨­¨æ¨ «¨§¨à®¢ ­­ëå ¤ ­­ëå: $1 bytes +% ˆ­ä®à¬ æ¨ï ® à §¬¥à¥ ᥪ樨 ­¥¨­¨æ¨ «¨§¨à®¢ ­­ëå ¤ ­­ëå. +execinfo_x_stackreserve=09133_X_ §¬¥à á⥪  (§ à¥§¥à¢¨à®¢ ­­ë©): $1 bytes +% ˆ­ä®à¬ æ¨ï ® § à¥§¥à¢¨à®¢ ­­®¬ à §¬¥à¥ á⥪  ¨á¯®«­ï¥¬®£® ä ©« . +execinfo_x_stackcommit=09134_X_ §¬¥à á⥪  (¯®¤ª«î祭­ë©): $1 bytes +% ˆ­ä®à¬ æ¨ï ® ¯®¤ª«î祭­®¬ à §¬¥à¥ á⥪  ¨á¯®«­ï¥¬®£® ä ©« . +%\end{description} +# EndOfTeX + +# +# Internal linker messages +# +# 09200 is the last used one +# +# BeginOfTeX +% \section{‘®®¡é¥­¨ï ª®¬¯®­®¢é¨ª } +% ‘®®¡é¥­¨ï, ¢ë¤ ¢ ¥¬ë¥ ¢­ãâ७­¨¬ ª®¬¯®­®¢é¨ª®¬. +% \begin{description} +link_f_executable_too_big=09200_F_ §¬¥à ¨á¯®«­ï¥¬®£® ®¡à §  ᫨誮¬ ¢¥«¨ª ¤«ï ¯« âä®à¬ë $1. +% ” â «ì­ ï ®è¨¡ª , ¢®§­¨ª îé ï ¢ á«ãç ¥, ¥á«¨ ᮧ¤ ­­ë© ¨á¯®«­ï¥¬ë© ä ©« ᫨誮¬ ¢¥«¨ª. +link_w_32bit_absolute_reloc=09201_W_Ž¡ê¥ªâ­ë© ä ©« "$1" ᮤ¥à¦¨â 32-¡¨â­®¥  ¡á®«îâ­®¥ ¯¥à¥¬¥é¥­¨¥ ¤«ï ᨬ¢®«  "$2". +% ‚ á«ãç ¥, ª®£¤  64-¡¨â­ë© ®¡ê¥ªâ­ë© ä ©« ᮤ¥à¦¨â 32-¡¨â­ë¥  ¡á®«îâ­ë¥ ¯¥à¥¬¥é¥­¨ï, +% ¯®«ã祭­ë© ¨á¯®«­ï¥¬ë© ®¡à § ¬®¦¥â ¡ëâì § £à㦥­ ⮫쪮 ¢ ­¨¦­¨¥ 4 ƒ  ¤à¥á­®£® +% ¯à®áâà ­á⢠. +%\end{description} +# EndOfTeX + +# +# Unit loading +# +# 10061 is the last used one +# +# BeginOfTeX +% \section{‘®®¡é¥­¨ï § £à㧪¨ ¬®¤ã«¥©.} +% ‘®®¡é¥­¨ï, ¢ë¤ ¢ ¥¬ë¥ ¯à¨ § £à㧪¥ ¬®¤ã«¥© á ¤¨áª  ¢ ¯ ¬ïâì. +% Œ­®£¨¥ ¨§ ­¨å ­®áïâ ¨­ä®à¬ æ¨®­­ë© å à ªâ¥à. +% \begin{description} +unit_t_unitsearch=10000_T_®¨áª ¬®¤y«ï: $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vt} á®®¡é ¥â ® ⮬, £¤¥ ª®¬¯¨«ïâ®à ¨é¥â +% ä ©«ë ¬®¤ã«¥©. +unit_t_ppu_loading=10001_T_‡ £py§ª  PPU $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vt} á®®¡é ¥â ¨¬ï ä ©«  § £à㦠¥¬®£® ¬®¤ã«ï. +unit_u_ppu_name=10002_U_ˆ¬ï PPU: $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ¨¬ï ¬®¤ã«ï. +unit_u_ppu_flags=10003_U_”« £¨ PPU: $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} ¯®ª §ë¢ ¥â ä« £¨ ¬®¤ã«ï. +unit_u_ppu_crc=10004_U_CRC PPU: $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} ¯®ª §ë¢ ¥â ª®­â஫ì­ãî á㬬㠬®¤ã«ï. +unit_u_ppu_time=10005_U_‚६ï PPU: $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} ¯®ª §ë¢ ¥â ¢à¥¬ï, ª®£¤  ¬®¤ã«ì ¡ë« ᪮¬¯¨«¨à®¢ ­. +unit_u_ppu_file_too_short=10006_U_PPU ä ©« ᫨誮¬ ª®p®âª¨© +% ” ©« ¬®¤ã«ï ᫨誮¬ ª®à®âª¨©, ¢ ­¥¬ ᮤ¥à¦ âáï ­¥ ¢á¥ ®¡ê¥­¨ï. +unit_u_ppu_invalid_header=10007_U_H¥¢¥p­ë© § £®«®¢®ª PPU (­¥â ᨣ­ âãàë PPU ¢ ­ ç «¥) +% ¥à¢ë¬¨ âà¥¬ï ¡ ©â ¬¨ ä ©«  PPU ¤®«¦­ë ¡ëâì ª®¤ë ᨬ¢®«®¢ \var{PPU} +unit_u_ppu_invalid_version=10008_U_H¥¢¥p­ ï ¢¥pá¨ï PPU ä ©«  $1 +% “ª § ­­ë© ä ©« ¬®¤ã«ï ¡ë« ᮧ¤ ­ ¤à㣮© ¢¥àᨥ© ª®¬¯¨«ïâ®à , ¨ ¯®í⮬㠭¥ ¬®¦¥â ¡ëâì +% ¯à®ç¨â ­. +unit_u_ppu_invalid_processor=10009_U_PPU ä ©« ᮧ¤ ­ ¤«ï ¤py£®£® ¯p®æ¥áá®p  +% â®â ¬®¤ã«ì ¡ë« ᪮¬¯¨«¨à®¢ ­ ¤«ï ¤à㣮£® ⨯  ¯à®æ¥áá®à , ¨ ¯®í⮬㠭¥ ¬®¦¥â +% ¡ëâì ¯à®ç¨â ­. +unit_u_ppu_invalid_target=10010_U_PPU ä ©« ᮧ¤ ­ ¤«ï ¤py£®© Ž‘ +% â®â ¬®¤ã«ì ¡ë« ᪮¬¯¨«¨à®¢ ­ ¤«ï ¤à㣮© ®¯¥à æ¨®­­®© á¨á⥬ë, ¨ ¯®í⮬㠭¥ ¬®¦¥â +% ¡ëâì ¯à®ç¨â ­. +unit_u_ppu_source=10011_U_ˆá室­ë© ä ©« PPU: $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} ¯®ª §ë¢ ¥â ¨¬ï ¨á室­®£® ä ©«  ¬®¤ã«ï. +unit_u_ppu_write=10012_U_‡ ¯¨áì $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â, ªã¤  ª®¬¯¨«ïâ®à § ¯¨á뢠¥â +% ä ©« ¬®¤ã«ï. +unit_f_ppu_cannot_write=10013_F_H¥¢®§¬®¦­® § ¯¨á âì PPU-ä ©« +% ਠ§ ¯¨á¨ ä ©«  ¬®¤ã«ï ¯à®¨§®è«  ®è¨¡ª . +unit_f_ppu_read_error=10014_F_Žè¨¡ª  ç⥭¨ï PPU-ä ©«  +% ” ©« ¬®¤ã«ï ¯®¢à¥¦¤¥­ ¨ ᮤ¥à¦¨â ­¥¢¥à­ãî +% ¨­ä®à¬ æ¨î. ®âॡã¥âáï ४®¬¯¨«ïæ¨ï. +unit_f_ppu_read_unexpected_end=10015_F_¥®¦¨¤ ­­ë© ª®­¥æ PPU-ä ©«  +% ¥®¦¨¤ ­­ë© ª®­¥æ ä ©« . +unit_f_ppu_invalid_entry=10016_F_H¥¢¥à­ ï § ¯¨áì PPU-ä ©« : $1 +% ” ©« ¬®¤ã«ï ¯®¢à¥¦¤¥­, ¨«¨ ¡ë« ᮧ¤ ­ ¡®«¥¥ ­®¢®© ¢¥àᨥ© ª®¬¯¨«ïâ®à . +unit_f_ppu_dbx_count_problem=10017_F_Žè¨¡ª  PPU DBX count +% ¥áâ몮¢ª¨ ¢ ®â« ¤®ç­®© ¨­ä®à¬ æ¨¨ ¬®¤ã«ï. +unit_e_illegal_unit_name=10018_E_H¥¢¥p­®¥ ¨¬ï ¬®¤y«ï: $1 +% ˆ¬ï ¬®¤ã«ï ­¥ ᮢ¯ ¤ ¥â á ¨¬¥­¥¬ ä ©«  ¬®¤ã«ï. +unit_f_too_much_units=10019_F_‘«¨èª®¬ ¬­®£® ¬®¤y«¥© +% Š®¬¯¨«ïâ®à ¨¬¥¥â ¯à¥¤¥« 1024 ¬®¤ã«ï ¢ ¯à®£à ¬¬¥. …£® ¬®¦­® 㢥«¨ç¨âì, +% ¨§¬¥­¨¢ §­ ç¥­¨¥ ª®­áâ ­âë \var{maxunits} ¢ ä ©«¥ \file{files.pas} ª®¬¯¨«ïâ®à , +% ¨ ¯¥à¥ª®¬¯¨«¨à®¢ ¢ ª®¬¯¨«ïâ®à. +unit_f_circular_unit_reference=10020_F_Š®«ì楢 ï áá뫪  ¬¥¦¤y ¬®¤ã«ï¬¨ $1 ¨ $2 +% „¢  ¬®¤ã«ï ¨á¯®«ì§ãîâ ¤à㣠¤à㣠 ¢ ¨­â¥à䥩᭮© ᥪ樨. â® à §à¥è¥­® ⮫쪮 ¢ +% ᥪ樨 \var{implementation}. ® ªà ©­¥© ¬¥à¥ ®¤¨­ ¨§ ¬®¤ã«¥© ¤®«¦¥­ ᮤ¥à¦ âì +% áá뫪㠭  ¤à㣮© ¢ ᥪ樨 \var{implementation}. +unit_f_cant_compile_unit=10021_F_Š®¬¯¨«ïæ¨ï ¬®¤y«ï $1 ­¥¢®§¬®¦­ , ®âáãâáâ¢ãîâ ¨á室­¨ª¨. +%  ©¤¥­ ¬®¤ã«ì, âॡãî騩 ¯¥à¥ª®¬¯¨«ï樨, ­® ¨á室­ë¥ ä ©«ë ¤«ï ­¥£® ®âáãâáâ¢ãîâ. +unit_f_cant_find_ppu=10022_F_H¥ ­ ©¤¥­ ¬®¤ã«ì $1, ¨á¯®«ì§ã¥¬ë© $2 +% ®¯ë⪠ ¨á¯®«ì§®¢ ­¨ï ¬®¤ã«ï, ¤«ï ª®â®à®£® ­¥ ­ ©¤¥­ ä ©« PPU. +% ஢¥àì⥠¯ã⨠¬®¤ã«¥© ¢ ä ©«¥ ª®­ä¨£ãà æ¨¨. +unit_w_unit_name_error=10023_W_Œ®¤ã«ì $1 ­¥ ­ ©¤¥­, ­® $2 áãé¥áâ¢ã¥â +% ®«ìè¥ ­¥ ¨á¯®«ì§ã¥âáï. +unit_f_unit_name_error=10024_F_ਠ¯®¨áª¥ ¬®¤ã«ï $1 ¡ë« ­ ©¤¥­ $2 +% Ž£à ­¨ç¥­¨¥ DOS ­  ¤«¨­ã ¨¬¥­ ä ©«®¢ ¢ 8 ᨬ¢®«®¢ ¬®¦¥â ¢ë§ë¢ âì +% ¯à®¡«¥¬ë, ¥á«¨ ¨¬ï ¬®¤ã«ï ¨¬¥¥â ¡®«ìèãî ¤«¨­ã. +unit_w_switch_us_missed=10025_W_„«ï ª®¬¯¨«ï樨 ¬®¤ã«ï system âॡã¥âáï ª«îç -Us +% ਠª®¬¯¨«ï樨 ¬®¤ã«ï system (âॡãî饣® ®á®¡®© ®¡à ¡®âª¨), á«¥¤ã¥â +% 㪠§ë¢ âì ª«îç \var{-Us}. +unit_f_errors_in_unit=10026_F_p¨ ª®¬¯¨«ï樨 ¬®¤y«ï ¯à®¨§®è«® $1 ®è¨¡®ª, à ¡®â  ¯à¥à¢ ­  +% Š®¬¯¨«ïâ®à ¯à¥ªà é ¥â à ¡®âã á í⨬ á®®¡é¥­¨¥¬ ¯à¨ ¢®§­¨ª­®¢¥­¨¨ ä â «ì­®© ®è¨¡ª¨, +% ¨«¨ ¯à¨ ¯à¥¢ë襭¨¨ ¯à¥¤¥«ì­®£® ª®«¨ç¥á⢠ ®è¨¡®ª. +unit_u_load_unit=10027_U_‡ £py§ª  ¨§ $1 ($2) ¬®¤y«ì $3 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â, ª®â®àë© ¬®¤ã«ì ®âªã¤  § £à㦠¥âáï. +% shown. +unit_u_recompile_crc_change=10028_U_¥p¥ª®¬¯¨«ïæ¨ï $1, ¨§¬¥­¨« áì ª®­âp®«ì­ ï áy¬¬  $2 +% Œ®¤ã«ì ¯¥à¥ª®¬¯¨«¨àã¥âáï, ¯®â®¬ã çâ® ¨§¬¥­¨« áì ª®­â஫쭠ï á㬬  ¬®¤ã«ï, ®â ª®â®à®£® +% ®­ § ¢¨á¨â. +unit_u_recompile_source_found_alone=10029_U_¥p¥ª®¬¯¨«ïæ¨ï $1, ­ ©¤¥­ë ⮫쪮 ¨á室­ë¥ ä ©«ë +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ¯à¨ç¨­ã ¯¥à¥ª®¬¯¨«ï樨 㪠§ ­­®£® ¬®¤ã«ï. +unit_u_recompile_staticlib_is_older=10030_U_¥p¥ª®¬¯¨«ïæ¨ï ¬®¤y«ï, áâ â¨ç¥áª ï ¡¨¡«¨®â¥ª  áâ pè¥ ç¥¬ ppu-ä ©« +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® ⮬, çâ® áâ â¨ç¥áª ï ¡¨¡«¨®â¥ª  ¬®¤ã«ï +% áâ àè¥, 祬 ppu-ä ©« ¬®¤ã«ï. +unit_u_recompile_sharedlib_is_older=10031_U_¥p¥ª®¬¯¨«ïæ¨ï ¬®¤y«ï, à §¤¥«ï¥¬ ï ¡¨¡«¨®â¥ª  áâ pè¥ ç¥¬ ppu-ä ©« +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® ⮬, çâ® à §¤¥«ï¥¬ ï ¡¨¡«¨®â¥ª  ¬®¤ã«ï +% áâ àè¥, 祬 ppu-ä ©« ¬®¤ã«ï. +unit_u_recompile_obj_and_asm_older=10032_U_¥p¥ª®¬¯¨«ïæ¨ï ¬®¤y«ï, .as ¨ .obj ä ©«ë áâ pè¥ ç¥¬ ppu-ä ©« +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® ⮬, çâ®  áᥬ¡«¥à­ë© ¨«¨ ®¡ê¥ªâ­ë© ä ©« ¬®¤ã«ï +% áâ àè¥, 祬 ppu-ä ©« ¬®¤ã«ï. +unit_u_recompile_obj_older_than_asm=10033_U_¥p¥ª®¬¯¨«ïæ¨ï ¬®¤y«ï, .obj ä ©« áâ pè¥ ç¥¬ .as ä ©« +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® ⮬, çâ® ®¡ê¥ªâ­ë© ä ©« ¬®¤ã«ï +% áâ àè¥, 祬 ¥£®  áᥬ¡«¥à­ë© ä ©«. +unit_u_parsing_interface=10034_U_€­ «¨§ ¨­â¥pä¥©á  $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® ­ ç «¥  ­ «¨§  +% ¨­â¥à䥩᭮© ç á⨠¬®¤ã«ï. +unit_u_parsing_implementation=10035_U_€­ «¨§ p¥ «¨§ æ¨¨ $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® ­ ç «¥  ­ «¨§  +% ॠ«¨§ æ¨®­­®© ç á⨠¬®¤ã«ï. +unit_u_second_load_unit=10036_U_®¢â®à­ ï § £py§ª  ¬®¤y«ï $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® ­ ç «¥ ¯®¢â®à­®© ª®¬¯¨«ï樨 +% ¬®¤ã«ç. â® ¬®¦¥â ¯à®¨á室¨âì ¯à¨ ­ «¨ç¨¨ ¢§ ¨¬®§ ¢¨á¨¬ëå ¬®¤ã«¥©. +unit_u_check_time=10037_U_஢¥àª  PPU ä ©«  $1 ¢p¥¬ï $2 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} ¯®ª §¢ ¥â ¨¬ï ¨ ¤ âã/¢à¥¬ï ä ©« , +% ®â ª®â®à®£® § ¢¨á¨â ४®¬¯¨«ïæ¨ï. +### The following two error msgs is currently disabled. +#unit_h_cond_not_set_in_last_compile=10038_H_“á«®¢­®¥ ¢ëp ¦¥­¨¥ $1 ­¥ ¡ë«® yáâ ­®¢«¥­® ¯p¨ ¯®á«¥¤­¥© ª®¬¯¨«ï樨 $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that currently is defined, but was not used the last +#% time the unit was compiled. +#unit_h_cond_set_in_last_compile=10039_H_“á«®¢­®¥ ¢ëp ¦¥­¨¥ $1 ¡ë«® yáâ ­®¢«¥­® ¯p¨ ¯®á«¥¤­¥© ª®¬¯¨«ï樨 $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that was used the last time the unit was compiled, but +#% the conditional is currently not defined. +unit_w_cant_compile_unit_with_changed_incfile=10040_W_ ©¤¥­ë ¨§¬¥­¥­­ë¥ ¢ª«îç ¥¬ë¥ ä ©«ë, ­® ª®¬¯¨«ïæ¨ï $1 ­¥¢®§¬®¦­  +% Ž¡­ à㦥­® ¨§¬¥­¥­¨¥ ¢ª«îç ¥¬ëå ä ©«®¢ ¬®¤ã«ï, ­® ­¥ª®â®àë¥ ¨á室­ë¥ ä ©«ë +% ­¥ ­ ©¤¥­ë, ¯®í⮬ã ४®¬¯¨«ïæ¨ï ­¥¢®§¬®¦­ . +unit_u_source_modified=10041_U_” ©« $1 ­®¢¥¥, 祬 $2 +%  ©¤¥­ ¨§¬¥­¥­­ë© ¨á室­ë© ä ©« ¬®¤ã«ï. +unit_u_ppu_invalid_fpumode=10042_U_®¯ë⪠ ¨á¯®«ì§®¢ ­¨ï ¬®¤ã«ï, ᪮¬¯¨«¨à®¢ ­­®£® á ¤à㣨¬ ०¨¬®¬ ᮯà®æ¥áá®à  +% ®¯ë⪠ ¨á¯®«ì§®¢ ­¨ï ¬®¤ã«¥©, ª®â®àë¥ ¡ë«¨ ᪮¬¯¨«¨à®¢ ­ë á ®â«¨ç î騬áï ०¨¬®¬ +% ä®à¬ â  ¯« ¢ î饩 § ¯ï⮩. ‚ᥠ¬®¤ã«¨ ¤®«¦­ë ¡ëâì ᪮¬¯¨«¨à®¢ ­ë «¨¡® á ¢ª«î祭­®© +% í¬ã«ï樥© ᮯà®æ¥áá®à , «¨¡® á ®âª«î祭­®©, ­® ­¥ ¢¯¥à¥¬¥èªã. +unit_u_loading_interface_units=10043_U_‡ £à㧪  ¬®¤ã«¥© ¨§ ¨­â¥à䥩᭮© ç á⨠$1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® ­ ç «¥ § £à㧪¨ ¬®¤ã«¥©, +% ¨á¯®«ì§ã¥¬ëå ¢ ¨­â¥à䥩᭮© ç á⨠㪠§ ­­®£® ¬®¤ã«ï. +unit_u_loading_implementation_units=10044_U_‡ £à㧪  ¬®¤ã«¥© ¨§ ॠ«¨§ æ¨®­­®© ç á⨠$1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® ­ ç «¥ § £à㧪¨ ¬®¤ã«¥©, +% ¨á¯®«ì§ã¥¬ëå ¢ ॠ«¨§ æ¨®­­®© ç á⨠㪠§ ­­®£® ¬®¤ã«ï. +unit_u_interface_crc_changed=10045_U_“ ¬®¤ã«ï $1 ¨§¬¥­¨« áì ª®­â஫쭠ï á㬬  ¨­â¥àä¥©á  +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® ⮬, çâ® ª®­â஫쭠ï á㬬 , +% ¢ëç¨á«¥­­ ï ¤«ï ¨­â¥à䥩᭮© ç á⨠¬®¤ã«ï, ¨§¬¥­¨« áì ¯®á«¥ à §¡®à  ¥£® ॠ«¨§ æ¨®­­®© +% ç áâ¨. +unit_u_implementation_crc_changed=10046_U_“ ¬®¤ã«ï $1 ¨§¬¥­¨« áì ª®­â஫쭠ï á㬬  ॠ«¨§ æ¨¨ +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â, çâ® ª®­â஫쭠ï á㬬  ¬®¤ã«ï +% ¨§¬¥­¨« áì ¯®á«¥ à §¡®à  ¥£® ॠ«¨§ æ¨®­­®© ç áâ¨. +unit_u_finished_compiling=10047_U_‡ ¢¥à襭  ª®¬¯¨«ïæ¨ï ¬®¤ã«ï $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® § ¢¥à襭¨ ª®¬¯¨«ï樨 ¬®¤ã«ï. +unit_u_add_depend_to=10048_U_„®¡ ¢«¥­  § ¢¨á¨¬®áâì $1 ®â $2 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® ⮬, çâ® ¡ë«  ¤®¡ ¢«¥­  +% § ¢¨á¨¬®áâì ¬¥¦¤ã ¤¢ã¬ï ¬®¤ã«ï¬¨. +unit_u_no_reload_is_caller=10049_U_¥§ ¯¥à¥§ £à㧪¨, íâ® ¨­¨æ¨ â®à: $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} ¯à¥¤ã¯à¥¦¤ ¥â ® ⮬, çâ® +% ¬®¤ã«ì ­¥ ¡ã¤¥â ¯¥à¥§ £à㦥­, ¯®â®¬ã çâ® ®­ á ¬ ï¥âáï ¨­¨æ¨ â®à®¬ ᢮¥© +% ¯¥à¥§ £à㧪¨. +unit_u_no_reload_in_second_compile=10050_U_¥§ ¯¥à¥§ £à㧪¨, 㦥 ¯®¢â®à­ ï ª®¬¯¨«ïæ¨ï: $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} ¯à¥¤ã¯à¥¦¤ ¥â, çâ® ¬®¤ã«ì +% ­¥ ¡ã¤¥â ¯¥à¥§ £à㦥­, â.ª. ®­ 㦥 ¡ë« ¯¥à¥§ £à㦥­ ¨ ª®¬¯¨«¨àã¥âáï ¢® ¢â®à®© à §. +unit_u_flag_for_reload=10051_U_®¬¥ç¥­® ¤«ï ¯¥à¥§ £à㧪¨: $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® ⮬, çâ® ¬®¤ã«ì ¡ã¤¥â ¯¥à¥§ £à㦥­. +unit_u_forced_reload=10052_U_‚ë­ã¦¤¥­­ ï ¯¥à¥§ £à㧪  +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® ⮬, çâ® ¬®¤ã«ì ¯à¨è«®áì ¯¥à¥§ £à㧨âì. +unit_u_previous_state=10053_U_०­¨© áâ âãá $1: $2 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} ¯®ª §ë¢ ¥â ¯à¥¤ë¤ã騩 áâ âãá ¬®¤ã«ï. +unit_u_second_compile_unit=10054_U_$1 㦥 ª®¬¯¨«¨àã¥âáï, ¯¥à¥å®¤ ª ¯®¢â®à­®© ª®¬¯¨«ï樨 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} ¯à¥¤ã¯à¥¦¤ ¥â ® ­ ç «¥ ¯¥à¥ª®¬¯¨«ï樨 ¬®¤ã«ï +% ¢® ¢â®à®© à §. â® ¬®¦¥â ¯à®¨á室¨âì á® ¢§ ¨¬®§ ¢¨á¨¬ë¬¨ ¬®¤ã«ï¬¨. +unit_u_loading_unit=10055_U_‡ £à㧪  ¬®¤ã«ï $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® ­ ç «¥ § £à㧪¨ ¬®¤ã«ï. +unit_u_finished_loading_unit=10056_U_‡ £à㧪  ¬®¤ã«ï $1 § ¢¥à襭  +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® § ¢¥à襭¨¨ § £à㧪¨ ¬®¤ã«ï. +unit_u_registering_new_unit=10057_U_¥£¨áâà æ¨ï ­®¢®£® ¬®¤ã«ï $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® ⮬, çâ® ª®¬¯¨«ïâ®à ¢áâà¥â¨« ­®¢ë© ¬®¤ã«ì +% ¨ § à¥£¨áâà¨à®¢ « ¥£® ¢® ¢­ãâ७­¨å ᯨ᪠å. +unit_u_reresolving_unit=10058_U_®¢â®à­®¥ à §à¥è¥­¨¥ § ¢¨á¨¬®á⥩ ¬®¤ã«ï $1 +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} ¯à¥¤ã¯à¥¦¤ ¥â ® ⮬, çâ® ª®¬¯¨«ïâ®àã ¯à¨è«®áì +% ¯®¢â®à­® ¢ëç¨á«¨âì ¢­ãâ७­¨¥ ¤ ­­ë¥ 㪠§ ­­®£® ¬®¤ã«ï. +unit_u_skipping_reresolving_unit=10059_U_யã᪠¯®¢â®à­®£® à §à¥è¥­¨ï ¬®¤ã«ï $1, § £à㧪  ¨á¯®«ì§ã¥¬ëå ¬®¤ã«¥© ¯à®¤®«¦ ¥âáï +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® ⮬, çâ® ¯®¢â®à­®¥ ¢ëç¨á«¥­¨¥ ¤ ­­ëå +% ¬®¤ã«ï ¯à®¯ã饭®, ¯®â®¬ã çâ® ¢ëç¨á«ïâì ¯®ª  ­¥ç¥£®. +unit_u_unload_resunit=10060_U_‚ë£à㧪  ¬®¤ã«ï ®¡à ¡®âª¨ à¥áãàᮢ $1 (­¥ ­ã¦¥­) +% ਠ¨á¯®«ì§®¢ ­¨¨ ª«îç  \var{-vu} á®®¡é ¥â ® ⮬, çâ® ¬®¤ã«ì ®¡à ¡®âª¨ à¥áãàᮢ +% ¢ë£à㦠¥âáï, â.ª. à¥áãàáë ­¥ ¨á¯®«ì§ãîâáï ¯à®£à ¬¬®©. +unit_e_different_wpo_file=10061_E_Œ®¤ã«ì $1 ᪮¬¯¨«¨à®¢ ­ á ¨á¯®«ì§®¢ ­¨¥¬ ®â«¨ç îé¨åáï ­ áâ஥ª ®¯â¨¬¨§ æ¨¨ ¢á¥© ¯à®£à ¬¬ë (wpo) ($2, $3); ¯¥à¥ª®¬¯¨«¨àã©â¥ ¥£® ¡¥§ wpo ¨«¨ á ⥬ ¦¥ ä ©«®¬ ®¡à â­®© á¢ï§¨ +% Š®£¤  ¬®¤ã«ì ¡ë« ᪮¬¯¨«¨à®¢ ­ á ®¯à¥¤¥«¥­­ë¬ ä ©«®¬ ®¡à â­®© á¢ï§¨ ®¯â¨¬¨§ æ¨¨ ¢á¥© ¯à®£à ¬¬ë (wpo) (\var{-FW<x>} \var{-OW<x>}), +% ¥£® ᪮¬¯¨«¨à®¢ ­­ ï ¢¥àá¨ï ᯥ樠«¨§¨à®¢ ­  ¯®¤ ¤ ­­ë© á業 à¨© ª®¬¯¨«ï樨 ¨ ­¥ ¬®¦¥â ¡ëâì ¨á¯®«ì§®¢ ­  +% ¯® ¤à㣮¬ã ­ §­ ç¥­¨î. „«ï ¨á¯®«ì§®¢ ­¨ï ¬®¤ã«ï ¢ ¤à㣮© ¯à®£à ¬¬¥ ¨«¨ á ¤à㣨¬¨ ­ áâனª ¬¨ wpo +% ¥£® ­¥®¡å®¤¨¬® ¯¥à¥ª®¬¯¨«¨à®¢ âì. +% \end{description} +# EndOfTeX + +# +# Options +# +# 11047 is the last used one +# +option_usage=11000_O_$1 [®¯æ¨¨] <ä ©«> [®¯æ¨¨] +# BeginOfTeX +% +% \section{Žè¨¡ª¨ ®¡à ¡®âª¨ ª®¬ ­¤­®© áâப¨} +% Žè¨¡ª¨, ª®â®àë¥ ¬®£ãâ ¢®§­¨ª âì ¢® ¢à¥¬ï ®¡à ¡®âª¨ ª®¬ ­¤­®© áâப¨ +% ¨«¨ ä ©«®¢ ª®­ä¨£ãà æ¨¨. +% \begin{description} +option_only_one_source_support=11001_W_®¤¤¥p¦¨¢ ¥âáï ⮫쪮 ®¤¨­ ¨á室­ë© ä ©«, ¢¬¥áâ® $1 ¡ã¤¥â ᪮¬¯¨«¨à®¢ ­ $2 +% ‚ ª®¬ ­¤­®© áâப¥ ¬®¦­® 㪠§ë¢ âì ⮫쪮 ®¤¨­ ä ©«. ¥à¢ë© ®¡­ à㦥­­ë© ä ©« ¡ã¤¥â +% ᪮¬¯¨«¨à®¢ ­, ®áâ «ì­ë¥ ¨£­®à¨àãîâáï. Œ®¦¥â ¡ëâì ¯à¨§­ ª®¬ ⮣®, çâ® +% ¯¥à¥¤ ®¯æ¨¥© § ¡ëâ §­ ª \var{'-'}. +option_def_only_for_os2=11002_W_DEF ä ©« ¬®¦­® ᮧ¤ ¢ âì ⮫쪮 ¤«ï OS/2 +% This option can only be specified when you're compiling for OS/2 +option_no_nested_response_file=11003_E_‚«®¦¥­­ë¥ ä ©«ë ®â¢¥â  ­¥ ¯®¤¤¥p¦¨¢ îâáï +% Ž¯æ¨ï ª®¬ ­¤­®© áâப¨ \var{@file} ­¥ ¯®§¢®«ï¥â ¨á¯®«ì§®¢ âì ¢«®¦¥­­ë¥ ä ©«ë ®â¢¥â . +option_no_source_found=11004_F_‚ ª®¬ ­¤­®© áâப¥ ®âáãâáâ¢ã¥â ¨¬ï ¨á室­®£® ä ©«  +% ‚ ª®¬ ­¤­®© áâப¥ ¤®«¦­® ¯à¨áãâá⢮¢ âì ¨¬ï ¨á室­®£® ä ©« . +option_no_option_found=11005_N_” ©« ª®­ä¨£ãà æ¨¨ $1 ­¥ ᮤ¥à¦¨â ®¯æ¨© ª®¬¯¨«ïâ®à  +% ‚ 㪠§ ­­®¬ ä ©«¥ ª®­ä¨£ãà æ¨¨ ­¥ ®¡­ à㦥­® ­¨ ®¤­®© ®¯æ¨¨. +option_illegal_para=11006_E_H¥¢¥p­ë© ¯ p ¬¥âp: $1 +% “ª § ­  ­¥¨§¢¥áâ­ ï ®¯æ¨ï. +option_help_pages_para=11007_H_-? ¢ë¢®¤¨â áâp ­¨æë á¯à ¢ª¨ +% â® á®®¡é¥­¨¥ ¢ë¢®¤¨âáï, ¥á«¨ 㪠§ ­  ­¥¨§¢¥áâ­ ï ®¯æ¨ï. +option_too_many_cfg_files=11008_F_‘«¨èª®¬ ¬­®£® ¢«®¦¥­­ëå ä ©«®¢ ª®­ä¨£ãà æ¨¨ +% “஢¥­ì ¢«®¦¥­¨ï ä ©«®¢ ª®­ä¨£ãà æ¨¨ ®£à ­¨ç¥­ ç¨á«®¬ 16. +option_unable_open_file=11009_F_H¥¢®§¬®¦­® ®âªpëâì $1 +% Žè¨¡ª  ¯à¨ ®âªàë⨨ ä ©«  ª®­ä¨£ãà æ¨¨. +option_reading_further_from=11010_D_த®«¦ ¥âáï ç⥭¨¥ ¯ p ¬¥âp®¢ ¨§ $1 +% ‚뤠¥âáï, ¥á«¨ ¢ª«î祭 ¢ë¢®¤ § ¬¥â®ª, ¨ ª®¬¯¨«ïâ®à ¯¥à¥ª«îç ¥âáï ­  +% ¤à㣮© ä ©« ª®­ä¨£ãà æ¨¨. +option_target_is_already_set=11011_W_–¥«¥¢ ï ¯« âä®à¬  㦥 yáâ ­®¢«¥­  ¢: $1 +% “ª § ­® ¡®«¥¥ ®¤­®© ®¯æ¨¨ \var{-T}, ®¯à¥¤¥«ïî饩 楫¥¢ãî ¯« âä®à¬ã. +option_no_shared_lib_under_dos=11012_W_ §¤¥«ï¥¬ë¥ ¡¨¡«¨®â¥ª¨ ­¥ ¯®¤¤¥p¦¨¢ îâáï ¤«ï DOS, ¡ã¤ãâ áâ â¨ç¥áª¨¬¨ +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos +option_too_many_ifdef=11013_F_‘«¨èª®¬ ¬­®£® $IFDEF ¨«¨ $IFNDEF ¢ ä ©«¥ ®¯æ¨© $1 áâப  $2 +% Š®«¨ç¥á⢮ ¤¨à¥ªâ¨¢ \var{\#IF(N)DEF} ¢ ä ©«¥ ª®­ä¨£ãà æ¨¨ ­¥ ᮢ¯ ¤ ¥â á ª®«¨ç¥á⢮¬ +% ¤¨à¥ªâ¨¢ \var{\#ENDIF}. +option_too_many_endif=11014_F_¥®¦¨¤ ­­ë© $ENDIF ¢ ä ©«¥ ®¯æ¨© $1 áâப  $2 +% Š®«¨ç¥á⢮ ¤¨à¥ªâ¨¢ \var{\#IF(N)DEF} ¢ ä ©«¥ ª®­ä¨£ãà æ¨¨ ­¥ ᮢ¯ ¤ ¥â á ª®«¨ç¥á⢮¬ +% ¤¨à¥ªâ¨¢ \var{\#ENDIF}. +option_too_less_endif=11015_F_¥§ ªàë⮥ yá«®¢­®¥ ¢ëp ¦¥­¨¥ ¢ ª®­æ¥ ä ©«  ®¯æ¨© +% Š®«¨ç¥á⢮ ¤¨à¥ªâ¨¢ \var{\#IF(N)DEF} ¢ ä ©«¥ ª®­ä¨£ãà æ¨¨ ­¥ ᮢ¯ ¤ ¥â á ª®«¨ç¥á⢮¬ +% ¤¨à¥ªâ¨¢ \var{\#ENDIF}. +option_no_debug_support=11016_W_â®â íª§¥¬¯«ïà ª®¬¯¨«ïâ®à  ­¥ ¯®¤¤¥à¦¨¢ ¥â £¥­¥p æ¨î ®â« ¤®ç­®© ¨­ä®p¬ æ¨¨ +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_®¯p®¡y©â¥ ᮡà âì á ®¯æ¨¥© -dGDB +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_W_ˆá¯®«ì§y¥âáï yáâ p¥¢è¨© ª«îç $1 +% ।ã¯à¥¦¤ ¥â, ç⮠㪠§ ­­ ï ®¯æ¨ï ¡®«ìè¥ ­¥ ­ã¦­ /­¥ ¯®¤¤¥à¦¨¢ ¥âáï. +% …¥ ४®¬¥­¤ã¥âáï 㤠«¨âì, çâ®¡ë ¨§¡¥¦ âì ¯à®¡«¥¬ ¢ á«ãç ¥, ¥á«¨ +% ¢ ¡ã¤ã饬 §­ ç¥­¨¥ ®¯æ¨¨ ¨§¬¥­¨âáï. +option_obsolete_switch_use_new=11019_W_ˆá¯®«ì§y¥âáï yáâ p¥¢è¨© ª«îç $1, ¨á¯®«ì§y©â¥ ¢¬¥áâ® ­¥£® ª«îç $2 +% ।ã¯à¥¦¤ ¥â, ç⮠㪠§ ­­ ï ®¯æ¨ï ¡®«ìè¥ ­¥ ¯®¤¤¥à¦¨¢ ¥âáï ¨ ¢¬¥áâ® ­¥¥ á«¥¤ã¥â ¨á¯®«ì§®¢ âì ¤àã£ãî. +% ¥ª®¬¥­¤ã¥âáï § ¬¥­¨âì ª«îç, çâ®¡ë ¨§¡¥¦ âì ¯à®¡«¥¬ ¢ á«ãç ¥, ¥á«¨ +% ¢ ¡ã¤ã饬 ¥£® §­ ç¥­¨¥ ¨§¬¥­¨âáï. +option_switch_bin_to_src_assembler=11020_N_¥p¥ª«î祭¨¥ ­   áᥬ¡«¥p, £¥­¥à¨àãî騩 ⥪áâ +% €áᥬ¡«¥à (á ¤¢®¨ç­ë¬ ä®à¬ â®¬ ¢ë室­ëå ä ©«®¢) ¡ë« ¨§¬¥­¥­, ¯®â®¬ã çâ® ¡ë« ¨á¯®«ì§®¢ ­ ª«îç -a, +% ª®â®àë© ®§­ ç ¥â ᮧ¤ ­¨¥  áᥬ¡«¥à­ëå ä ©«®¢ ¢ ⥪á⮢®¬ ä®à¬ â¥. +option_incompatible_asm=11021_W_‚ë¡à ­­ë©  áᥬ¡«¥à "$1" ­¥ ᮢ¬¥á⨬ á "$2" +option_asm_forced=11022_W_‚ë­ã¦¤¥­­® ¨á¯®«ì§¥âáï  áᥬ¡«¥à "$1" +% ‡ ¤ ­­ë© ⨯  áᥬ¡«¥à  ­¥ ¯®§¢®«ï¥â ᮧ¤ ¢ âì ®¡ê¥ªâ­ë¥ ä ©«ë +% ¢ ¯à ¢¨«ì­®¬ ä®à¬ â¥. ‚¬¥áâ® ­¥£® ¡ã¤¥â ¨á¯®«ì§®¢ ­  áᥬ¡«¥à ¯® 㬮«ç ­¨î +% ¤«ï ¢ë¡à ­­®© ¯« âä®à¬ë. +option_using_file=11026_T_—⥭¨¥ ®¯æ¨© ¨§ ä ©«  $1 +% Ž¯æ¨¨ ç¨â îâáï â ª¦¥ ¨§ 㪠§ ­­®£® ä ©« . +option_using_env=11027_T_—⥭¨¥ ®¯æ¨© ¨§ ¯¥à¥¬¥­­®© ®ªà㦥­¨ï $1 +% Ž¯æ¨¨ ç¨â îâáï â ª¦¥ ¨§ 㪠§ ­­®© ¯¥à¥¬¥­­®© ®ªà㦥­¨ï. +option_handling_option=11028_D_Ž¡à ¡®âª  ®¯æ¨¨ "$1" +% Žâ« ¤®ç­®¥ á®®¡é¥­¨¥ ® ⮬, çâ® ®¯æ¨ï ­ ©¤¥­  ¨ ¡ã¤¥â ®¡à ¡®â ­ . +option_help_press_enter=11029_O_*** ­ ¦¬¨â¥ enter *** +% ‘®®¡é¥­¨ ¢ë¤ ¥âáï ¯à¨ ¯®áâà ­¨ç­®¬ ¢ë¢®¤¥ á¯à ¢ª¨.  ¦ â¨¥ ª« ¢¨è¨ ENTER +% ¢ë§ë¢ ¥â ¯®ª § á«¥¤ãî饩 áâà ­¨æë. …᫨ ­ ¦ âì q ¨ § â¥¬ ENTER, ª®¬¯¨«ïâ®à +% § ¢¥àè ¥â à ¡®âã. +option_start_reading_configfile=11030_H_ ç «® ç⥭¨ï ä ©«  ª®­ä¨£ãà æ¨¨ $1 +%  ç «® ç⥭¨ï ä ©«  ª®­ä¨£ãà æ¨¨. +option_end_reading_configfile=11031_H_Š®­¥æ ç⥭¨ï ä ©«  ª®­ä¨£ãà æ¨¨ $1 +% Žª®­ç ­¨¥ ç⥭¨ï ä ©«  ª®­ä¨£ãà æ¨¨. +option_interpreting_option=11032_D_¨­â¥à¯à¥â æ¨ï ®¯æ¨¨ "$1" +% Š®¬¯¨«ïâ®à ¨­â¥à¯à¥â¨àã¥â ®¯æ¨î. +option_interpreting_firstpass_option=11036_D_¨­â¥à¯à¥â æ¨ï ®¯æ¨¨ ¯¥à¢®£® ¯à®å®¤  "$1" +% Š®¬¯¨«ïâ®à ¨­â¥à¯à¥â¨àã¥â ®¯æ¨î ¢ ¯¥à¢ë© à §. +option_interpreting_file_option=11033_D_¨­â¥à¯à¥â æ¨ï ®¯æ¨¨ ¨§ ä ©«  "$1" +% Š®¬¯¨«ïâ®à ¨­â¥à¯à¥â¨àã¥â ®¯æ¨î, ¯à®ç¨â ­­ãî ¨§ ä ©«  ª®­ä¨£ãà æ¨¨. +option_read_config_file=11034_D_—⥭¨¥ ä ©«  ª®­ä¨£ãà æ¨¨ "$1" +%  ç «® ç⥭¨ï 㪠§ ­­®£® ä ©«  ª®­ä¨£ãà æ¨¨ (®â« ¤®ç­®¥ á®®¡é¥­¨¥). +option_found_file=11035_D_­ ©¤¥­® ¨¬ï ¨á室­®£® ä ©«  "$1" +% „®¯®«­¨â¥«ì­ ï ¨­ä®à¬ æ¨ï ®¡ ®¯æ¨ïå, ¢ë¢®¤¨âáï ¯à¨ +% ¢ª«î祭­ëå ®â« ¤®ç­ëå á®®¡é¥­¨ïå. +option_code_page_not_available=11039_E_¥¨§¢¥áâ­ ï ª®¤®¢ ï áâà ­¨æ  +% “ª § ­  ­¥¨§¢¥áâ­ ï ª®¤®¢ ï áâà ­¨æ  ¤«ï ¨á室­ëå ä ©«®¢. +% Š®¬¯¨«ïâ®à ¨¬¥¥â ¢áâ஥­­ãî ¯®¤¤¥à¦ªã ­¥áª®«ìª¨å ª®¤®¢ëå áâà ­¨æ. +% ‡ ¯à®è¥­­ ï ª®¤®¢ ï áâà ­¨æ  ¢ ¨å ç¨á«® ­¥ ¢å®¤¨â. „«ï ¤®¡ ¢«¥­¨ï +% ¯®¤¤¥à¦ª¨ ¯®âॡã¥âáï ¯¥à¥á¡®àª  ª®¬¯¨«ïâ®à . +option_config_is_dir=11040_F_” ©« ª®­ä¨£ãà æ¨¨ $1 - ¤¨à¥ªâ®à¨ï +% „¨à¥ªâ®à¨¨ ­¥«ì§ï ¨á¯®«ì§®¢ âì ¢ ª ç¥á⢥ ä ©«®¢ ª®­ä¨£ãà æ¨¨. +option_confict_asm_debug=11041_W_‚ë¡à ­­ë© ⨯  áᥬ¡«¥à  "$1" ­¥ ¯®¤¤¥à¦¨¢ ¥â ®â« ¤®ç­ãî ¨­ä®à¬ æ¨î, ®â« ¤ª  ®âª«î祭  +% ‚ë¡à ­­ë©  áᥬ¡«¥à ­¥ ¯®¤¤¥à¦¨¢ ¥â £¥­¥à æ¨î ®â« ¤®ç­®© ¨­ä®à¬ æ¨¨, +% ¯®í⮬㠢®§¬®¦­®áâì ®â« ¤ª¨ ®âª«î祭 . +option_ppc386_deprecated=11042_W_ˆá¯®«ì§®¢ ­¨¥ ppc386.cfg ï¥âáï ãáâ à¥¢è¨¬, ¢¬¥áâ® ­¥£® á«¥¤ã¥â ¨á¯®«ì§®¢ âì fpc.cfg +% Using ppc386.cfg is still supported for historical reasons, however, for a multiplatform +% system the naming makes no sense anymore. Please continue to use fpc.cfg instead. +option_else_without_if=11043_F_‚ ä ©«¥ ®¯æ¨© $1 áâப  $2 ®¡­ à㦥­  ¤¨à¥ªâ¨¢  \var{\#ELSE} ¡¥§ ¯à¥¤¢ à¨â¥«ì­®© \var{\#IF(N)DEF} +% ‚ ä ©«¥ ª®­ä¨£ãà æ¨¨ ®¡­ à㦥­  ¤¨à¥ªâ¨¢  \var{\#ELSE} ¡¥§ ¯à¥¤¢ à¨â¥«ì­®© ¤¨à¥ªâ¨¢ë \var{\#IF(N)DEF}. +option_unsupported_target=11044_F_Ž¯æ¨ï "$1" ­¥ ¯®¤¤¥à¦¨¢ ¥âáï (¨«¨ ¯®ª  ­¥ ¯®¤¤¥à¦¨¢ ¥âáï) ¤«ï 楫¥¢®© ¯« âä®à¬ë +% ¥ ¢á¥ ®¯æ¨¨ ¯®¤¤¥à¦¨¢ îâáï ¨«¨ ॠ«¨§®¢ ­ë ¤«ï ¢á¥å ¯« âä®à¬. â® á®®¡é¥­¨¥ ® ⮬, +% çâ® ¢ë¡à ­­ ï ®¯æ¨ï ­¥á®¢¬¥á⨬  á ⥪ã饩 ¯« âä®à¬®©. +option_unsupported_target_for_feature=11045_F_Žá®¡¥­­®áâì "$1" ­¥ ¯®¤¤¥à¦¨¢ ¥âáï (¨«¨ ¯®ª  ­¥ ¯®¤¤¥à¦¨¢ ¥âáï) ¤«ï ¢ë¡à ­­®© 楫¥¢®© ¯« âä®à¬ë +% ¥ ¢á¥ ®¯æ¨¨ ¯®¤¤¥à¦¨¢ îâáï ¨«¨ ॠ«¨§®¢ ­ë ¤«ï ¢á¥å ¯« âä®à¬. â® á®®¡é¥­¨¥ ® ⮬, +% çâ® ¢ë¡à ­­ ï ®¯æ¨ï ­¥á®¢¬¥á⨬  á ⥪ã饩 ¯« âä®à¬®©. +option_dwarf_smart_linking=11046_N_  ¢ë¡à ­­®© ¯« âä®à¬¥ ­¥«ì§ï ¨á¯®«ì§®¢ âì ®â« ¤®ç­ãî ¨­ä®à¬ æ¨î ⨯  DWARF ᮢ¬¥áâ­® á "㬭®©" ª®¬¯®­®¢ª®©, ¯¥à¥ª«î祭¨¥ ­  áâ â¨ç¥áªãî ª®¬¯®­®¢ªã +% "“¬­ ï" ª®¬¯®­®¢ª  ¢ ­ áâ®ï饥 ¢à¥¬ï ­¥á®¢¬¥á⨬  á ®â« ¤®ç­®© ¨­ä®à¬ æ¨¥© ⨯  DWARF ­  ¡®«ì設á⢥ +% ¯« âä®à¬, ¯®í⮬㠯ਠ¢ë¡®à¥ ä®à¬ â  DWARF "㬭 ï" ª®¬¯®­®¢ª  ®âª«îç ¥âáï. +option_ignored_target=11047_W_Ž¯æ¨ï "$1" ¨£­®à¨àã¥âáï ¤«ï ¢ë¡à ­­®© 楫¥¢®© ¯« âä®à¬ë. +% ¥ ¢á¥ ®¯æ¨¨ ¯®¤¤¥à¦¨¢ îâáï ¨«¨ ॠ«¨§®¢ ­ë ¤«ï ¢á¥å ¯« âä®à¬. â® á®®¡é¥­¨¥ ® ⮬, +% çâ® ¢ë¡à ­­ ï ®¯æ¨ï ¨£­®à¨àã¥âáï ¤«ï ⥪ã饩 ¯« âä®à¬ë. +% \end{description} +# EndOfTeX + +# +# Whole program optimization +# +# 12019 is the last used one +# +# BeginOfTeX +% +% \section{‘®®¡é¥­¨ï ®¯â¨¬¨§ æ¨¨ ¢á¥© ¯à®£à ¬¬ë} +%  §¤¥« ᮤ¥à¦¨â á®®¡é¥­¨ï ®¡ ®è¨¡ª å, ª®â®àë¥ ¬®£ãâ ¢®§­¨ª âì +% ¢ ¯à®æ¥áᥠ®¯â¨¬¨§ æ¨¨ ¢á¥© ¯à®£à ¬¬ë (wpo). +% \begin{description} +wpo_cant_find_file=12000_F_¥¢®§¬®¦­® ®âªàëâì ä ©« ¤ ­­ëå WPO "$1" +% Š®¬¯¨«ïâ®à ­¥ ¬®¦¥â ®âªàëâì 㪠§ ­­ë© ä ©« á ¤ ­­ë¬¨ ®¯â¨¬¨§ æ¨¨ ¢á¥© ¯à®£à ¬¬ë. +wpo_begin_processing=12001_D_Ž¡à ¡®âª  ¨­ä®à¬ æ¨¨ WPO ¢ ä ©«¥ "$1" +% Š®¬¯¨«ïâ®à ­ ç¨­ ¥â ®¡à ¡®âªã ¤ ­­ëå ¤«ï ®¯â¨¬¨§ æ¨¨ ¢á¥© ¯à®£à ¬¬ë ¢ 㪠§ ­­®¬ ä ©«¥. +wpo_end_processing=12002_D_‡ ª®­ç¥­  ®¡à ¡®âª  ¨­ä®à¬ æ¨¨ WPO ¢ ä ©«¥ "$1" +% Š®¬¯¨«ïâ®à § ª®­ç¨« ®¡à ¡®âªã ¤ ­­ëå ¤«ï ®¯â¨¬¨§ æ¨¨ ¢á¥© ¯à®£à ¬¬ë ¢ 㪠§ ­­®¬ ä ©«¥. +wpo_expected_section=12003_E_Ž¦¨¤ «áï § £®«®¢®ª ᥪ樨, ­® ¯®«ã祭® "$2" ¢ áâப¥ $1 ä ©«  WPO-¨­ä®à¬ æ¨¨ +% ਠ®¡à ¡®âª¥ ä ©«  ®¯â¨¬¨§ æ¨¨ ¢á¥© ¯à®£à ¬¬ë ª®¬¯¨«ïâ®à ®¦¨¤ « § £®«®¢®ª ᥪ樨 (­ ç¨­ ¥âáï á \%), +% ­® ­¥ ­ è¥« ¥£®. +wpo_no_section_handler=12004_W_¥ § à¥£¨áâà¨à®¢ ­ ®¡à ¡®â稪 ¤«ï ᥪ樨 "$2" ¢ áâப¥ $1 ä ©«  WPO, ¨£­®à¨àã¥âáï +% Š®¬¯¨«ïâ®à ­¥ ¨¬¥¥â ®¡à ¡®â稪  ¤«ï 㯮¬ï­ã⮩ ᥪ樨 ä ©«  WPO-¨­ä®à¬ æ¨¨, +% ¯®í⮬㠮­ ¯à®¯ã᪠¥â íâã ᥪæ¨î ¨ ¯¥à¥å®¤¨â ª á«¥¤ãî饩. +wpo_found_section=12005_D_ ©¤¥­  ᥪæ¨ï "$1" á ¨­ä®à¬ æ¨¥© ® "$2" +% Š®¬¯¨«ïâ®à ®¡­ à㦨« ¢ ä ©«¥ WPO ᥪæ¨î á ¨­ä®à¬ æ¨¥©, ª®â®àãî ®­ ¬®¦¥â ®¡à ¡®â âì. +wpo_no_input_specified=12006_F_‚ë¡à ­­ë¥ ०¨¬ë ®¯â¨¬¨§ æ¨¨ ¢á¥© ¯à®£à ¬¬ë âॡãî⠯।¢ à¨â¥«ì­® ᮧ¤ ­­®£® ä ©«  ®¡à â­®© á¢ï§¨ (㪠¦¨â¥ á ¯®¬®éìî -Fw) +% —â®¡ë ¢ë¯®«­¨âì ¢ë¡à ­­ãî ®¯â¨¬¨§ æ¨î ¢á¥© ¯à®£à ¬¬ë, ª®¬¯¨«ïâ®àã âॡã¥âáï ¨­ä®à¬ æ¨ï, +% ᮡ࠭­ ï ¢ ¯à®æ¥áᥠ¯à¥¤ë¤ã饩 ª®¬¯¨«ï樨. ” ©«, ᮤ¥à¦ é¨© íâã ¨­ä®à¬ æ¨î, ¤®«¦¥­ ¡ëâì 㪠§ ­ +% á ¯®¬®éìî ª«îç  -Fw. +wpo_not_enough_info=12007_E_” ©« ®¡à â­®© á¢ï§¨ ­¥ ᮤ¥à¦¨â ¨­ä®à¬ æ¨¨, ­¥®¡å®¤¨¬®© ¤«ï ¯à®¢¥¤¥­¨ï ®¯â¨¬¨§ æ¨¨ "$1" +% “ª § ­­ë© ä ©« ®¡à â­®© á¢ï§¨ ­¥ ᮤ¥à¦¨â ¨­ä®à¬ æ¨î, ª®â®à® ï ­ã¦­  ¤«ï ¯à®¢¥¤¥­¨ï âॡ㥬®£® ¢¨¤  +% ®¯â¨¬¨§ æ¨¨. ‘ª®à¥¥ ¢á¥£®, ­ã¦­® ¯¥à¥ª®¬¯¨«¨à®¢ âì ¯à®£à ¬¬ã, 㪠§ ¢ ¯®¤å®¤ï騩 ª«îç -OWxxx. +wpo_no_output_specified=12008_F_“ª ¦¨â¥ ä ©« ®¡à â­®© á¢ï§¨ ¤«ï § ¯¨á¨ ᮡ࠭­®© ¨­ä®à¬ æ¨¨ (á ¯®¬®éìî -FW) +% ¥®¡å®¤¨¬® 㪠§ âì ä ©«, ¢ ª®â®àë© ª®¬¯¨«ïâ®à § ¯¨è¥â ᮡ࠭­ë¥ ¢® ¢à¥¬ï ª®¬¯¨«ï樨 +% ¤ ­­ë¥ ¤«ï ®¯â¨¬¨§ æ¨¨ ¢á¥© ¯à®£à ¬¬ë. â® ¤¥« ¥âáï á ¯®¬®éìî ª«îç  -FW. +wpo_output_without_info_gen=12009_E_” ©« ®¡à â­®© á¢ï§¨ 㪠§ ­ (á ¯®¬®éìî -FW), ­® ­¥ 㪠§ ­ âà¥¡ã¥¬ë© â¨¯ ᮡ¨à ¥¬®© ¨­ä®à¬ æ¨¨ +% ®¬¨¬® 㪠§ ­¨ï ¨¬¥­¨ ä ©«  ®¡à â­®© á¢ï§¨ wpo á ¯®¬®éìî -FW, á«¥¤ã¥â 㪠§ë¢ âì +% âà¥¡ã¥¬ë¥ ¢¨¤ë ®¯â¨¬¨§ æ¨¨ á ¯®¬®éìî -OWxxx, ¨­ ç¥ ¯®«¥§­ ï ¨­ä®à¬ æ¨ï ¢ ä ©« § ¯¨á ­  +% ­¥ ¡ã¤¥â. +wpo_input_without_info_use=12010_E_” ©« ®¡à â­®© á¢ï§¨ 㪠§ ­ (á ¯®¬®éìî -Fw), ­® ­¥ 㪠§ ­ ⨯ ®¯â¨¬¨§ æ¨¨, ª®â®àë© á«¥¤ã¥â ¢ë¯®«­¨âì +% …᫨ 㪠§ ­ ä ©« ®¡à â­®© á¢ï§¨ wpo á ¯®¬®éìî -Fw, ­® ­¥ § ¤ ­ë ¢¨¤ë ®¯â¨¬¨§ æ¨¨ á ¯®¬®éìî -Owxxx, +% ¡ã¤¥â ¢ë¤ ­  ¤ ­­ ï ®è¨¡ª . “ª § ­­ë¥ ª«îç¨ á«¥¤ã¥â ¨á¯®«ì§®¢ âì ᮢ¬¥áâ­®. +wpo_skipping_unnecessary_section=12011_D_‘¥ªæ¨ï wpo ¯à®¯ã饭  "$1", ¯®áª®«ìªã ­¥ âॡã¥âáï ¤«ï § ¯à®è¥­­ëå ®¯â¨¬¨§ æ¨© +% ” ©« ®¡à â­®© á¢ï§¨ wpo ᮤ¥à¦¨â ᥪæ¨î á ¨­ä®à¬ æ¨¥©, ª®â®à ï ­¥ âॡã¥âáï +% ¤«ï ¯à®¢¥¤¥­¨ï ¢ë¡à ­­ëå ⨯®¢ ®¯â¨¬¨§ æ¨¨. +wpo_duplicate_wpotype=12012_W_ˆ­ä®à¬ æ¨ï, à ­¥¥ ¯à®ç¨â ­­ ï ¨§ ä ©«  ®¡à â­®© á¢ï§¨ ¤«ï "$1", ¯¥à¥ªà뢠¥âáï ¨­ä®à¬ æ¨¥© ¨§ ᥪ樨 "$2" +% ” ©« ®¡à â­®© á¢ï§¨ wpo ᮤ¥à¦¨â ­¥áª®«ìª® ᥪ権 á ®¤­®â¨¯­®© ¨­ä®à¬ æ¨¥© (­ ¯à¨¬¥à, +% ® ⮬, ª ª¨¥ ¢¨àâã «ì­ë¥ ¬¥â®¤ë ¬®£ãâ ¡ëâì ¤¥-¢¨àâã «¨§¨à®¢ ­ë). ‚ í⮬ á«ãç ¥ ¨á¯®«ì§ã¥âáï ¨­ä®à¬ æ¨ï +% ¨§ ¯®á«¥¤­¥© ᥪ樨. ‚ª«îç¨â¥ ®â« ¤®ç­ë¥ á®®¡é¥­¨ï (-vd), ç⮡ë 㢨¤¥âì, ª ª¨¥ ª« ááë ¨­ä®à¬ æ¨¨ ᮤ¥à¦ âáï +% ¢ ª ¦¤®© ¨§ ᥪ権. +wpo_cannot_extract_live_symbol_info_strip=12013_E_ˆ­ä®à¬ æ¨ï ® ¦¨¢ãç¥á⨠ᨬ¢®«®¢ ­¥ ¬®¦¥â ¡ëâì ¯®«ã祭  ¨§ ¯à®£à ¬¬ë ¡¥§ ®â« ¤®ç­®© ¨­ä®à¬ æ¨¨, ¨á¯®«ì§ã©â¥ -Xs- +% ¥ª®â®àë¥ á¯®á®¡ë á¡®à  ¨­ä®à¬ æ¨¨ ® ¦¨¢ãç¥á⨠ᨬ¢®«®¢ ¯à¥¤¯®« £ îâ  ­ «¨§ ᨬ¢®«ì­®© ¨­ä®à¬ æ¨¨ +% £®â®¢®© ¯à®£à ¬¬ë. …᫨ íâ  ¨­ä®à¬ æ¨ï 㤠«¥­  (®¯æ¨ï -Xs), â ª®©  ­ «¨§ ­¥¢®§¬®¦¥­. +wpo_cannot_extract_live_symbol_info_no_link=12014_E_ˆ­ä®à¬ æ¨ï ® ¦¨¢ãç¥á⨠ᨬ¢®«®¢ ­¥ ¬®¦¥â ¡ëâì ¯®«ã祭  ¡¥§ ᪮¬¯®­®¢ ­­®© ¯à®£à ¬¬ë +% ¥ª®â®àë¥ á¯®á®¡ë á¡®à  ¨­ä®à¬ æ¨¨ ® ¦¨¢ãç¥á⨠ᨬ¢®«®¢ ¯à¥¤¯®« £ îâ  ­ «¨§ ᨬ¢®«ì­®© ¨­ä®à¬ æ¨¨ +% £®â®¢®© ¯à®£à ¬¬ë. …᫨ ¯à®£à ¬¬  ­¥ ᪮¬¯®­®¢ ­ , â ª®©  ­ «¨§ ­¥¢®§¬®¦¥­. +wpo_cannot_find_symbol_progs=12015_F_¥ ­ ©¤¥­ë "$1" ¨«¨ "$2" ¤«ï ¨§¢«¥ç¥­¨ï ¨­ä®à¬ æ¨¨ ® ᨬ¢®« å ¨§ ᪮¬¯®­®¢ ­­®© ¯à®£à ¬¬ë +% ¥ª®â®àë¥ á¯®á®¡ë á¡®à  ¨­ä®à¬ æ¨¨ ® ¦¨¢ãç¥á⨠ᨬ¢®«®¢ ¨á¯®«ì§ãî⠢ᯮ¬®£ â¥«ì­ë¥ ¯à®£à ¬¬ë +% ¤«ï ¯®«ã祭¨ï ¨­ä®à¬ æ¨¨ ® ᨬ¢®« å ¯à®£à ¬¬ë. Ž¡ëç­® íâ® ¯à®£à ¬¬  'nm', ¢å®¤ïé ï ¢ á®áâ ¢ GNU binutils. +wpo_error_reading_symbol_file=12016_E_Žè¨¡ª  ç⥭¨ï ¨­ä®à¬ æ¨¨ ® ¦¨¢ãç¥á⨠ᨬ¢®«®¢, ¯®«ã祭­®© ®â "$1" +% ਠ¯®«ã祭¨¨ ¨­ä®à¬ æ¨¨ ® ᨬ¢®« å á ¯®¬®éìî ¢á¯®¬®£ â¥«ì­®© ¯à®£à ¬¬ë ('nm' ¨«¨ 'objdump') ¯à®¨§®è«  +% ®è¨¡ª . ‚뢮¤ ¢á¯®¬®£ â¥«ì­®© ¯à®£à ¬¬ë ®ª § «áï ª®à®ç¥ ®¦¨¤ ¥¬®£®, ¨«¨ ¨¬¥¥â ­¥¢¥à­ë© ä®à¬ â. +wpo_error_executing_symbol_prog=12017_F_Žè¨¡ª  ¢ë¯®«­¥­¨ï "$1" (ª®¤ ¢ë室 : $2) ¯à¨ ¨§¢«¥ç¥­¨¨ ¨­ä®à¬ æ¨¨ ® ᨬ¢®« å +% ਠ¯®«ã祭¨¨ ¨­ä®à¬ æ¨¨ ® ᨬ¢®« å á ¯®¬®éìî ¢á¯®¬®£ â¥«ì­®© ¯à®£à ¬¬ë ('nm' ¨«¨ 'objdump') ¯à®¨§®è«  +% ®è¨¡ª . ‚ᯮ¬®£ â¥«ì­ ï ¯à®£à ¬¬  ¢¥à­ã«  㪠§ ­­ë© ª®¤ ®è¨¡ª¨. +wpo_symbol_live_info_needs_smart_linking=12018_E_‘¡®à ¨­ä®à¬ æ¨¨ ® ¦¨¢ãç¥á⨠ᨬ¢®«®¢ ¯®«¥§¥­ ⮫쪮 ¯à¨ "㬭®©" ª®¬¯®­®¢ª¥, ¨á¯®«ì§ã©â¥ -CX -XX +% †¨¢ãç¥áâì ᨬ¢®«  ®¯à¥¤¥«ï¥âáï 䠪⮬ ¥£® ­ «¨ç¨ï ¢ £®â®¢®© ᪮¬¯®­®¢ ­­®© ¯à®£à ¬¬¥. …᫨ ®âª«î祭  +% "㬭 ï" ª®¬¯®­®¢ª , ¢á¥ ᨬ¢®«ë ¢ªîç îâáï ¢ ¯à®£à ¬¬ã ­¥§ ¢¨á¨¬® ®â ⮣®, ¨á¯®«ì§ãîâáï ®­¨ ¨«¨ ­¥â. +% â® ¤¥« ¥â á¡®à ¨­ä®à¬ æ¨¨ ® ¦¨¢ãç¥á⨠ᨬ¢®«®¢ ¡¥áá¬ëá«¥­­ë¬. +wpo_cant_create_feedback_file=12019_E_¥¢®§¬®¦­® ᮧ¤ âì ä ©« ®¡à â­®© á¢ï§¨ "$1" +% ” ©« ®¡à â­®© á¢ï§¨ wpo, 㪠§ ­­ë© á ¯®¬®éìî ª«îç  -FW, ­¥ ¬®¦¥â ¡ëâì ᮧ¤ ­. +%\end{description} +# EndOfTeX + + +# +# Logo (option -l) +# +option_logo=11023_[ +Š®¬¯¨«ïâ®à Free Pascal ¢¥àᨨ $FPCFULLVERSION [$FPCDATE] ¤«ï $FPCCPU +Copyright (c) 1993-2011 by Florian Klaempfl +] + +# +# Info (option -i) +# +option_info=11024_[ +Free Pascal Compiler version $FPCVERSION + +Compiler Date : $FPCDATE +Compiler CPU Target: $FPCCPU + +®¤¤¥à¦¨¢ ¥¬ë¥ ¯« âä®à¬ë: + $OSTARGETS + +®¤¤¥à¦¨¢ ¥¬ë¥ ­ ¡®àë ª®¬ ­¤ CPU: + $INSTRUCTIONSETS + +®¤¤¥à¦¨¢ ¥¬ë¥ ­ ¡®àë ª®¬ ­¤ FPU: + $FPUINSTRUCTIONSETS + +®¤¤¥à¦¨¢ ¥¬ë¥ ABI: + $ABITARGETS + +®¤¤¥à¦¨¢ ¥¬ë¥ ®¯â¨¬¨§ æ¨¨: + $OPTIMIZATIONS + +®¤¤¥à¦¨¢ ¥¬ë¥ ®¯â¨¬¨§ æ¨¨ ¢á¥© ¯à®£à ¬¬ë: + All + $WPOPTIMIZATIONS + +®¤¤¥à¦¨¢ ¥¬ë¥ â¨¯ë ¬¨ªà®ª®­â஫«¥à®¢: + $CONTROLLERTYPES + +This program comes under the GNU General Public Licence +For more information read COPYING.FPC + +Report bugs, suggestions, etc. to: + http://bugs.freepascal.org +or + bugs@freepascal.org +] + +# +# Help pages (option -? and -h) +# +# The first character on the line indicates who will display this +# line, the current possibilities are : +# * = every target +# 3 = 80x86 targets +# 6 = 680x0 targets +# e = in extended debug mode only +# P = PowerPC targets +# S = Sparc targets +# V = Virtual machine targets +# The second character also indicates who will display this line, +# (if the above character was TRUE) the current possibilities are : +# * = everyone +# g = with GDB info supported by the compiler +# O = OS/2 +# L = UNIX systems +# The third character represents the indentation level. +# +option_help_pages=11025_[ +**0*_„®¡ ¢ì⥠'+' ¯®á«¥ ®¯æ¨¨ ¡ã«¥¢  ª«îç  ¤«ï ¥£® ¢ª«î祭¨ï ¨ '-' ¤«ï ®âª«î祭¨ï +**1a_Š®¬¯¨«ïâ®à ­¥ 㤠«ï¥â ᮧ¤ ­­ë©  áᥬ¡«¥à­ë© ä ©« +**2al_‚뢮¤ ­®¬¥p®¢ áâப ¢  áᥬ¡«¥à­ë© ä ©« +**2an_‚뢮¤ ¨­ä®à¬ æ¨¨ ®¡ 㧫 å £à ä  ¢  áᥬ¡«¥à­ë© ä ©« +*L2ap_ˆá¯®«ì§®¢ âì ¯ ©¯ë ¢¬¥áâ® ¢à¥¬¥­­ëå  áᥬ¡«¥à­ë© ä ©«®¢ +**2ar_¥à¥ç¨á«ïâì ¢ë¤¥«¥­¨ï/®á¢®¡®¦¤¥­¨ï p¥£¨áâp®¢ ¢  áᥬ¡«¥p­®¬ ä ©«¥ +**2at_¥à¥ç¨á«ïâì ¢ë¤¥«¥­¨ï/®á¢®¡®¦¤¥­¨ï ¢p¥¬¥­­ëå ¯¥p¥¬¥­­ëå ¢  áᥬ¡«¥p­®¬ ä ©«¥ +**1A<x>_”®à¬ â ¢ë¢®¤ : +**2Adefault_€áᥬ¡«¥à ¯® 㬮«ç ­¨î +3*2Aas_€áᥬ¡«¥à GNU AS +3*2Anasmcoff_COFF ä ©« (Go32v2), ¨á¯®«ì§ãï Nasm +3*2Anasmelf_ELF32 ä ©« (Linux), ¨á¯®«ì§ãï Nasm +3*2Anasmwin32_Win32 ®¡ê¥ªâ­ë© ä ©«, ¨á¯®«ì§ãï Nasm +3*2Anasmwdosx_Win32/WDOSX ®¡ê¥ªâ­ë© ä ©«, ¨á¯®«ì§ãï Nasm +3*2Awasm_Obj ä ©«, ¨á¯®«ì§ãï Wasm (Watcom) +3*2Anasmobj_Obj ä ©«, ¨á¯®«ì§ãï Nasm +3*2Amasm_Obj ä ©«, ¨á¯®«ì§ãï Masm (Microsoft) +3*2Atasm_Obj ä ©«, ¨á¯®«ì§ãï Tasm (Borland) +3*2Aelf_ELF (Linux) ¨á¯®«ì§ãï ¢­ãâ७­¨© £¥­¥à â®à +3*2Acoff_COFF (Go32v2) ¨á¯®«ì§ãï ¢­ãâ७­¨© £¥­¥à â®à +3*2Apecoff_PE-COFF (Win32) ¨á¯®«ì§ãï ¢­ãâ७­¨© £¥­¥à â®à +4*2Aas_€áᥬ¡«¥à GNU AS +6*2Aas_Unix o-ä ©«, ¨á¯®«ì§ãï GNU AS +6*2Agas_GNU Motorola  áᥬ¡«¥à +6*2Amit_‘¨­â ªá¨á MIT (áâ àë© GAS) +6*2Amot_‘â ­¤ àâ­ë©  áᥬ¡«¥à Motorola +A*2Aas_€áᥬ¡«¥à GNU AS +P*2Aas_€áᥬ¡«¥à GNU AS +S*2Aas_€áᥬ¡«¥à GNU AS +**1b_ƒ¥­¥p¨p®¢ âì ¨­ä®p¬ æ¨î ¤«ï ¡p y§¥p  (IDE) +**2bl_ƒ¥­¥p¨p®¢ âì â ª¦¥ ¨­ä®p¬ æ¨î ® «®ª «ì­ëå ᨬ¢®« å +**1B_¥p¥á¡®àª  ¢á¥å ¬®¤y«¥© +**1C<x>_Ž¯æ¨¨ £¥­¥p â®à  ª®¤ : +**2Ca<x>_‚ë¡®à ABI, á¬. fpc -i ¤«ï ¢®§¬®¦­ëå §­ ç¥­¨© +**2Cb_ƒ¥­¥à¨à®¢ âì big-endian ª®¤ +**2Cc<x>_“áâ ­®¢¨âì ⨯ ¢ë§®¢  ¯® 㬮«ç ­¨î ¢ <x> +**2CD_‘®§¤ âì â ª¦¥ ¤¨­ ¬¨ç¥áªyî ¡¨¡«¨®â¥ªy (­¥ ¯®¤¤¥p¦¨¢ ¥âáï) +**2Ce_Š®¬¯¨«¨à®¢ âì á í¬ã«¨à®¢ ­­ë¬¨ ¨­áâàãªæ¨ï¬¨ á ¯« ¢ î饩 § ¯ï⮩ +**2Cf<x>_‚ë¡®à ­ ¡®à  ª®¬ ­¤ ᮯà®æ¥áá®à , á¬. fpc -i ¤«ï ¢®§¬®¦­ëå §­ ç¥­¨© +**2CF<x>_Œ¨­¨¬ «ì­ ï â®ç­®áâì ª®­áâ ­â á ¯« ¢ î饩 § ¯ï⮩ (default, 32, 64) +**2Cg_ƒ¥­¥à¨à®¢ âì ¯®§¨æ¨®­­®-­¥§ ¢¨á¨¬ë© ª®¤ (PIC) +**2Ch<n>_<n> ¡ ©â ªyç¨ (®â 1023 ¤® 67107840) +**2Ci_p®¢¥pª  ¢¢®¤ -¢ë¢®¤  +**2Cn_p®¯yáâ¨âì áâ ¤¨î ª®¬¯®­®¢ª¨ +**2Co_p®¢¥pª  ¯¥à¥¯®«­¥­¨ï 楫®ç¨á«¥­­ëå ®¯¥à æ¨© +**2CO_஢¥àª  ¢®§¬®¦­®£® ¯¥à¥¯®«­¥­¨ï 楫®ç¨á«¥­­ëå ®¯¥à æ¨© +**2Cp<x>_‚ë¡®à ­ ¡®à  ª®¬ ­¤, á¬. fpc -i ¤«ï ¢®§¬®¦­ëå §­ ç¥­¨© +**2CP<x>=<y>_ ­ áâனª¨ 㯠ª®¢ª¨ +**3CPPACKSET=<y>_ <y> 㯠ª®¢ª  ¬­®¦¥áâ¢: 0, 1 ¨«¨ DEFAULT ¨«¨ NORMAL, 2, 4 ¨ 8 +**2Cr_p®¢¥pª  ¤¨ ¯ §®­®¢ +**2CR_஢¥àª  ¯à ¢¨«ì­®á⨠¢ë§®¢  ¬¥â®¤®¢ ®¡ê¥ªâ®¢ +**2Cs<n>_“áâ ­®¢¨âì p §¬¥p á⥪  ¢ <n> +**2Ct_஢¥àª  á⥪  (⮫쪮 â¥áâ¨à®¢ ­¨¥, á¬. à㪮¢®¤á⢮) +**2CX_‘®§¤ âì â ª¦¥ smartlink-¡¨¡«¨®â¥ªã +**1d<x>_Ž¯p¥¤¥«¨âì ᨬ¢®« <x> +**1D_‘®§¤ âì DEF-ä ©« +**2Dd<x>_“áâ ­®¢¨âì ®¯¨á ­¨¥ ¢ <x> +**2Dv<x>_“áâ ­®¢¨âì ¢¥àá¨î DLL ¢ <x> +*O2Dw_ਫ®¦¥­¨¥ PM +**1e<x>_“áâ ­®¢¨âì ¯yâì ¤«ï ¨á¯®«­ï¥¬ëå ä ©«®¢ +**1E_’® ¦¥, çâ® ¨ -Cn +**1fPIC_’® ¦¥, çâ® ¨ -Cg +**1F<x>_“áâ ­®¢ª  ¨¬¥­ ¨ ¯ã⥩ ä ©«®¢ +**2Fa<x>[,y]_(¤«ï ¯à®£à ¬¬ë) § £à㧨âì ¬®¤ã«¨ <x> ¨ [y] ¯¥à¥¤ ç⥭¨¥¬ ᥪ樨 uses +**2Fc<x>_“áâ ­®¢¨âì ª®¤®¢ãî áâà ­¨æã ¨á室­®£® ä ©«  ¢ <x> +**2FC<x>_“áâ ­®¢¨âì ¨¬ï ª®¬¯¨«ïâ®à  à¥áãàᮢ (.rc) ¢ <x> +**2Fd_Žâª«îç¨âì ¢­ãâ७­¨© ªíè ¤¨à¥ªâ®à¨© ª®¬¯¨«ïâ®à  +**2FD<x>_“áâ ­®¢¨âì ¯yâì ¯®¨áª  ã⨫¨â ª®¬¯¨«ïâ®à  +**2Fe<x>_¥p¥­ ¯p ¢¨âì ¢ë¢®¤ ®è¨¡®ª ¢ <x> +**2Ff<x>_„®¡ ¢¨âì <x> ª ¯ã⨠ä३¬¢®àª  (⮫쪮 Darwin) +**2FE<x>_“áâ ­®¢¨âì ¯ãâì ¢ë¢®¤  exe/¬®¤ã«¥© ¢ <x> +**2Fi<x>_„®¡ ¢¨âì <x> ª ¯yâï¬ ¢ª«îç ¥¬ëå ä ©«®¢ +**2Fl<x>_„®¡ ¢¨âì <x> ª ¯yâï¬ ¡¨¡«¨®â¥ª +**2FL<x>_ˆá¯®«ì§®¢ âì <x> ª ª ¤¨­ ¬¨ç¥áª¨© ª®¬¯®­®¢é¨ª +**2Fm<x>_‡ £à㧨âì â ¡«¨æ㠯८¡à §®¢ ­¨ï unicode ¨§ <x>.txt ¢ ¤¨à¥ªâ®à¨¨ ª®¬¯¨«ïâ®à  +**2Fo<x>_„®¡ ¢¨âì <x> ª ¯yâï¬ ®¡ê¥ªâ­ëå ä ©«®¢ +**2Fr<x>_‡ £py§¨âì ä ©« á®®¡é¥­¨© ®¡ ®è¨¡ª å <x> +**2FR<x>_“áâ ­®¢¨âì ¨¬ï ª®¬¯®­®¢é¨ª  à¥áãàᮢ (.res) ¢ <x> +**2Fu<x>_„®¡ ¢¨âì <x> ª ¯ãâï¬ ¬®¤ã«¥© +**2FU<x>_“áâ ­®¢¨âì ¯yâì ¢ë¢®¤  ¬®¤y«¥© ¢ <x>, ®â¬¥­ï¥â -FE +**2FW<x>_‡ ¯¨á âì ä ©« ®¡à â­®© á¢ï§¨ ®¯â¨¬¨§ æ¨¨ ¢á¥© ¯à®£à ¬¬ë ¢ <x> +**2Fw<x>_‡ £à㧨âì à ­¥¥ ᮧ¤ ­­ë© ä ©« ®¡à â­®© á¢ï§¨ ¨§ <x> +*g1g_‘®§¤ ¢ âì ®â« ¤®ç­ãî ¨­ä®à¬ æ¨î (ä®à¬ â¥ ¯® 㬮«ç ­¨î ¤«ï 楫¥¢®© ¯« âä®à¬ë) +*g2gc_‘®§¤ ¢ âì ¯à®¢¥àª¨ 㪠§ â¥«¥© +*g2gh_ˆá¯®«ì§®¢ âì ¬®¤y«ì heaptrc (¤«ï ®â« ¤ª¨ yâ¥ç¥ª/¯®¢à¥¦¤¥­¨© ¯ ¬ïâ¨) +*g2gl_ˆá¯®«ì§®¢ âì ¬®¤ã«ì lineinfo (¡®«ìè¥ ¨­ä®à¬ æ¨¨ ® á⥪¥ ¢ë§®¢®¢) +*g2go<x>_Ž¯æ¨¨ ®â« ¤®ç­®© ¨­ä®à¬ æ¨¨ +*g3godwarfsets_ ‚ª«îç¨âì ¨­ä®à¬ æ¨î ® ¬­®¦¥á⢠å DWARF («®¬ ¥â gdb < 6.5) +*g3gostabsabsincludes_ ‘®åà ­ïâì  ¡á®«îâ­ë¥/¯®«­ë¥ ¯ã⨠¢ª«îç ¥¬ëå ä ©«®¢ ¢ Stabs +*g2gp_‘®åà ­ïâì ॣ¨áâà ¢ ¨¬¥­ å ᨬ¢®«®¢ stabs +*g2gs_Žâ« ¤®ç­ ï ¨­ä®à¬ æ¨ï ¢ ä®à¬ â¥ Stabs +*g2gt_‡ â¨à âì «®ª «ì­ë¥ ¯¥à¥¬¥­­ë¥ (¢ë¥­¨¥ ¨á¯®«ì§®¢ ­¨ï ¡¥§ ¨­¨æ¨ «¨§ æ¨¨) +*g2gv_®¤¤¥à¦ª  âà áá¨à®¢ª¨ á ¯®¬®éìî Valgrind +*g2gw_Žâ« ¤®ç­ ï ¨­ä®à¬ æ¨ï ¢ ä®à¬ â¥ DWARFv2 (â® ¦¥, çâ® ¨ -gw2) +*g2gw2_Žâ« ¤®ç­ ï ¨­ä®à¬ æ¨ï ¢ ä®à¬ â¥ DWARFv2 +*g2gw3_Žâ« ¤®ç­ ï ¨­ä®à¬ æ¨ï ¢ ä®à¬ â¥ DWARFv3 +**1i_ˆ­ä®p¬ æ¨ï +**2iD_‚¥à­ãâì ¤ ây ª®¬¯¨«ïâ®p  +**2iV_‚¥à­ãâì ª®à®âªãî ¢¥pá¨î ª®¬¯¨«ïâ®à  +**2iW_‚¥à­ãâì ¯®«­ãî ¢¥àá¨î ª®¬¯¨«ïâ®à  +**2iSO_‚¥à­ãâì ⨯ Ž‘ ª®¬¯¨«ïâ®à  +**2iSP_‚¥à­ãâì ⨯ ¯p®æ¥áá®p  ª®¬¯¨«ïâ®à  +**2iTO_‚¥à­ãâì ⨯ 楫¥¢®© Ž‘ +**2iTP_‚¥à­ãâì ⨯ 楫¥¢®£® ¯p®æ¥áá®p  +**1I<x>_„®¡ ¢¨âì <x> ª ¯y⨠¤® ¢ª«îç ¥¬ëå ä ©«®¢ +**1k<x>_¥à¥¤ âì <x> ª®¬¯®­®¢é¨ªy +**1l_‚뢥á⨠«®£®â¨¯ +**1M<x>_“áâ ­®¢¨âì ०¨¬ ï§ëª  ¢ <x> +**2Mfpc_„¨ «¥ªâ Free Pascal (¯® 㬮«ç ­¨î) +**2Mobjfpc_¥¦¨¬ FPC á ¯®¤¤¥à¦ª®© Object Pascal +**2Mdelphi_¥¦¨¬ ᮢ¬¥á⨬®á⨠á Delphi 7 +**2Mtp_¥¦¨¬ ᮢ¬¥á⨬®á⨠á TP/BP 7.0 +**2Mmacpas_¥¦¨¬ ᮢ¬¥á⨬®áâ¨ á ¤¨ «¥ªâ ¬¨ Macintosh Pascal +**1n_¥ ç¨â âì áâ ­¤ pâ­ë¥ ä ©«ë ª®­ä¨£ãà æ¨¨ +**1N<x>_Ž¯â¨¬¨§ æ¨ï £à ä  +**2Nu_ §¢®à ç¨¢ âì 横«ë +**1o<x>_ˆ§¬¥­¨âì ¨¬ï ¯®«ãç ¥¬®£® ¨á¯®«­ï¥¬®£® ä ©«  ­  <x> +**1O<x>_Ž¯â¨¬¨§ æ¨¨: +**2O-_Žâª«îç¨âì ®¯â¨¬¨§ æ¨¨ +**2O1_Ž¯â¨¬¨§ æ¨¨ ã஢­ï 1 (¡ëáâà® ¨ ᮢ¬¥á⨬® á ®â« ¤ç¨ª®¬) +**2O2_Ž¯â¨¬¨§ æ¨¨ ã஢­ï 2 (-O1 + ¡ëáâàë¥ ®¯â¨¬¨§ æ¨¨) +**2O3_Ž¯â¨¬¨§ æ¨¨ ã஢­ï 3 (-O2 + ¬¥¤«¥­­ë¥ ®¯â¨¬¨§ æ¨¨) +**2Oa<x>=<y>_“áâ ­®¢¨âì ¢ëà ¢­¨¢ ­¨¥ +**2Oo[NO]<x>_‚ª«îç¨âì ¨«¨ ®âª«îç¨âì ®â¤¥«ì­ë¥ ®¯â¨¬¨§ æ¨¨, á¬. fpc -i ¤«ï ¢®§¬®¦­ëå §­ ç¥­¨© +**2Op<x>_‡ ¤ âì ¯à®æ¥áá®à ¤«ï ®¯â¨¬¨§ æ¨¨, á¬. fpc -i ¤«ï ¢®§¬®¦­ëå §­ ç¥­¨© +**2OW<x>_ƒ¥­¥à æ¨ï ä ©«  ®¡à â­®© á¢ï§¨ wpo ¤«ï ®¯â¨¬¨§ æ¨¨ <x>, á¬. fpc -i ¤«ï ¢®§¬®¦­ëå §­ ç¥­¨© +**2Ow<x>_‚믮«­¨âì ®¯â¨¬¨§ æ¨î <x> ¢á¥© ¯à®£à ¬¬ë, á¬. fpc -i ¤«ï ¢®§¬®¦­ëå §­ ç¥­¨© +**2Os_Ž¯â¨¬¨§ æ¨ï ¯® à §¬¥àã ¢¬¥á⮠᪮à®á⨠+**1pg_ƒ¥­¥p æ¨ï ª®¤  ¤«ï ¯à®ä¨«¨à®¢ ­¨ï á ¯®¬®éìî gprof (®¯p¥¤¥«ï¥â ᨬ¢®« FPC_PROFILE) +**1R<x>_‘⨫ì ç⥭¨ï  áᥬ¡«¥à : +**2Rdefault_€áᥬ¡«¥à ¯® 㬮«ç ­¨î ¤«ï 楫¥¢®© ¯« âä®à¬ë +3*2Ratt_—⥭¨¥  áᥬ¡«¥à  ¢ á⨫¥ AT&T +3*2Rintel_—⥭¨¥  áᥬ¡«¥à  ¢ á⨫¥ Intel +6*2RMOT_—⥭¨¥  áᥬ¡«¥à  ¢ á⨫¥ Motorola +**1S<x>_Ž¯æ¨¨ ᨭ⠪á¨á : +**2S2_’® ¦¥, çâ® ¨ -Mobjfpc +**2Sc_®¤¤¥p¦ª  ®¯¥à â®à®¢ ª ª ¢ C (*=,+=,/= ¨ -=) +**2sa_‚ª«îç¨âì ¯à®¢¥àª¨ Assert +**2Sd_’® ¦¥, çâ® ¨ -Mdelphi +**2Se<x>_Ž¯æ¨¨ ®è¨¡®ª. <x> - ª®¬¡¨­ æ¨ï á«¥¤ãîé¨å ᨬ¢®«®¢: +**3*_<n> : Žáâ ­®¢ª  ª®¬¯¨«ï樨 ¯®á«¥ <n> ®è¨¡®ª (¯® 㬮«ç ­¨î 1) +**3*_w : Š®¬¯¨«ïâ®à â ª¦¥ ®áâ ­ ¢«¨¢ ¥âáï ¯®á«¥ ¯à¥¤ã¯à¥¦¤¥­¨© +**3*_n : Š®¬¯¨«ïâ®à â ª¦¥ ®áâ ­ ¢«¨¢ ¥âáï ¯®á«¥ § ¬¥â®ª +**3*_h : Š®¬¯¨«ïâ®à â ª¦¥ ®áâ ­ ¢«¨¢ ¥âáï ¯®á«¥ ¯®¤áª §®ª +**2Sg_ §à¥è¨âì LABEL ¨ GOTO (¯® 㬮«ç ­¨î ¢ -Mtp ¨ -Mdelphi) +**2Sh_ˆá¯®«ì§®¢ âì áâp®ª¨ ansistring ¯® 㬮«ç ­¨î ¢¬¥áâ® shortstring +**2Si_‚ª«îç¨âì ¢áâà ¨¢ ­¨¥ ¯à®æ¥¤ãà/ä㭪権, ®¡ê¥­­ëå ª ª "inline" +**2Sk_‡ £à㧨âì ¬®¤ã«ì fpcylix +**2SI<x>_“áâ ­®¢¨âì áâ¨«ì ¨­â¥à䥩ᮢ ¢ <x> +**3SIcom_COM-ᮢ¬¥áâ¨¬ë¥ ¨­â¥à䥩áë (¯® 㬮«ç ­¨î) +**3SIcorba_CORBA-ᮢ¬¥áâ¨¬ë¥ ¨­â¥à䥩áë +**2Sm_®¤¤¥p¦ª  ¬ ªà®ª®¬ ­¤ ª ª ¢ C (£«®¡ «ì­®) +**2So_’® ¦¥, çâ® ¨ -Mtp +**2Ss_ˆ¬¥­  ª®­áâàãªâ®à®¢/¤¥áâàãªâ®à®¢ ¤®«¦­ë ¡ëâì init/done +**2Sx_®¤¤¥à¦ª  ª«î祢ëå á«®¢ ¨áª«î祭¨© (¯® 㬮«ç ­¨î ¢ ०¨¬ å Delphi/ObjFPC) +**1s_¥ ¢ë§ë¢ âì  áᥬ¡«¥à ¨ ª®¬¯®­®¢é¨ª +**2sh_‘®§¤ âì áªà¨¯â ¤«ï ª®¬¯®­®¢ª¨ ­  å®á⥠+**2st_‘®§¤ âì áªà¨¯â ¤«ï ª®¬¯®­®¢ª¨ ­  ¯« âä®à¬¥ ­ §­ ç¥­¨ï +**2sr_யãáâ¨âì ä §ã à á¯à¥¤¥«¥­¨ï ॣ¨áâ஢ (¨á¯®«ì§ã¥âáï á -alr) +**1T<x>_Ž¯¥à æ¨®­­ ï á¨á⥬  ­ §­ ç¥­¨ï: +3*2Temx_OS/2 ç¥à¥§ EMX (¢ª«îç ï à áè¨à¨â¥«ì EMX/RSX) +3*2Tfreebsd_FreeBSD +3*2Tgo32v2_‚¥àá¨ï 2 à áè¨à¨â¥«ï DOS DJ Delorie +3*2Tlinux_Linux +3*2Tnetbsd_NetBSD +3*2Tnetware_Œ®¤ã«ì Novell Netware (clib) +3*2Tnetwlibc_Œ®¤ã«ì Novell Netware (libc) +3*2Topenbsd_OpenBSD +3*2Tos2_OS/2 / eComStation +3*2Tsunos_SunOS/Solaris +3*2Tsymbian_Symbian OS +3*2Twatcom_Watcom-ᮢ¬¥áâ¨¬ë© à áè¨à¨â¥«ì DOS +3*2Twdosx_ áè¨à¨â¥«ì DOS WDOSX +3*2Twin32_Windows 32 ¡¨â  +3*2Twince_Windows CE +4*2Tlinux_Linux +6*2Tamiga_Commodore Amiga +6*2Tatari_Atari ST/STe/TT +6*2Tlinux_Linux/m68k +6*2Tmacos_Macintosh m68k (­¥ ¯®¤¤¥à¦¨¢ ¥âáï) +6*2Tpalmos_PalmOS +A*2Tlinux_Linux +A*2Twince_Windows CE +P*2Tamiga_AmigaOS ­  PowerPC +P*2Tdarwin_Darwin ¨ Mac OS X ­  PowerPC +P*2Tlinux_Linux ­  PowerPC +P*2Tmacos_Mac OS (classic) ­  PowerPC +P*2Tmorphos_MorphOS +S*2Tlinux_Linux +**1u<x>_y¤ «ï¥â ®¯p¥¤¥«¥­¨¥ ᨬ¢®«  <x> +**1U_Ž¯æ¨¨ ¬®¤y«¥©: +**2Un_¥ ¯p®¢¥pïâì ᮮ⢥âá⢨¥ ¨¬¥­¨ ¬®¤y«ï ¨ ¨¬¥­¨ ä ©«  +**2Ur_ƒ¥­¥à¨à®¢ âì ५¨§­ë¥ ä ©«ë ¬®¤ã«¥© (­¥ ¯¥à¥ª®¬¯¨«¨àãîâáï  ¢â®¬ â¨ç¥áª¨) +**2Us_Š®¬¯¨«¨p®¢ âì ¬®¤y«ì system +**1v<x>_“஢¥­ì ¯®¤p®¡­®áâ¨. <x> - ª®¬¡¨­ æ¨ï á«¥¤yîé¨å ᨬ¢®«®¢: +**2*_e : Žè¨¡ª¨ (¯® 㬮«ç ­¨î) 0 : ¨ç¥£® (ªà®¬¥ ®è¨¡®ª) +**2*_w : ।ã¯à¥¦¤¥­¨ï u : ˆ­ä®à¬ æ¨ï ® ¬®¤ã«ïå +**2*_n : ਬ¥ç ­¨ï t : ®¯à®¡®¢ ­­ë¥/¨á¯®«ì§®¢ ­­ë¥ ä ©«ë +**2*_h : ®¤áª §ª¨ c : “á«®¢­ë¥ ¢ëà ¦¥­¨ï +**2*_i : Ž¡é ï ¨­ä®à¬ æ¨ï d : Žâ« ¤®ç­ë¥ á®®¡é¥­¨ï +**2*_l : H®¬¥p  áâப c : ¥¦¨¬ ᮢ¬¥á⨬®á⨠á Rhide/GCC +**2*_s : Žâ¬¥âª¨ ¢à¥¬¥­¨ q : ®¬¥à  á®®¡é¥­¨© +**2*_a : ®ª §ë¢ âì ¢á¥ x : ˆ­ä®à¬ æ¨ï ® ¨á¯®«­ï¥¬®¬ ä ©«¥ (⮫쪮 Win32) +**2*_b : ‘®®¡é¥­¨ï ® ä ©« å p : ‡ ¯¨áì tree.log á £à ä®¬ à §¡®à  +**2*_ á ¯®«­ë¬¨ ¯ãâﬨ x : ‡ ¯¨áì fpcdebug.txt á ¯®¤à®¡­®© +**2*_ ¨¬¥­­® ¢ ­¥© ®â« ¤®ç­®© ¨­ä®à¬ æ¨¥© +**2*_m<x>,<y> : ¥ ¯®ª §ë¢ âì á®®¡é¥­¨ï á ­®¬¥à ¬¨ <x> ¨ <y> +3*1W<x>_« âä®à¬¥­­®-ᯥæ¨ä¨ç­ë¥ ®¯æ¨¨ (¯« âä®à¬ë) +A*1W<x>_« âä®à¬¥­­®-ᯥæ¨ä¨ç­ë¥ ®¯æ¨¨ (¯« âä®à¬ë) +P*1W<x>_« âä®à¬¥­­®-ᯥæ¨ä¨ç­ë¥ ®¯æ¨¨ (¯« âä®à¬ë) +p*1W<x>_« âä®à¬¥­­®-ᯥæ¨ä¨ç­ë¥ ®¯æ¨¨ (¯« âä®à¬ë) +3*2Wb_‘®§¤ ¢ âì bundle ¢¬¥áâ® ¡¨¡«¨®â¥ª¨ (Darwin) +P*2Wb_‘®§¤ ¢ âì bundle ¢¬¥áâ® ¡¨¡«¨®â¥ª¨ (Darwin) +p*2Wb_‘®§¤ ¢ âì bundle ¢¬¥áâ® ¡¨¡«¨®â¥ª¨ (Darwin) +3*2WB_‘®§¤ ¢ âì ¯¥à¥¬¥é ¥¬ë© ®¡à § (Windows) +A*2WB_‘®§¤ ¢ âì ¯¥à¥¬¥é ¥¬ë© ®¡à § (Windows, Symbian) +3*2WC_“ª § âì ª®­á®«ì­ë© ⨯ ¯à¨«®¦¥­¨ï (EMX, OS/2, Windows) +A*2WC_“ª § âì ª®­á®«ì­ë© ⨯ ¯à¨«®¦¥­¨ï (Windows) +P*2WC_“ª § âì ª®­á®«ì­ë© ⨯ ¯à¨«®¦¥­¨ï (Classic Mac OS) +3*2WD_ˆá¯®«ì§®¢ âì DEFFILE ¤«ï íªá¯®àâ  ä㭪樨 DLL ¨«¨ EXE (Windows) +A*2WD_ˆá¯®«ì§®¢ âì DEFFILE ¤«ï íªá¯®àâ  ä㭪樨 DLL ¨«¨ EXE (Windows) +3*2We_ˆá¯®«ì§®¢ âì ¢­¥è­¨¥ à¥áãàáë (Darwin) +P*2We_ˆá¯®«ì§®¢ âì ¢­¥è­¨¥ à¥áãàáë (Darwin) +p*2We_ˆá¯®«ì§®¢ âì ¢­¥è­¨¥ à¥áãàáë (Darwin) +3*2WF_“ª § âì ¯®«­®íªà ­­ë© ⨯ ¯à¨«®¦¥­¨ï (EMX, OS/2) +3*2WG_“ª § âì £à ä¨ç¥áª¨© ⨯ ¯à¨«®¦¥­¨ï (EMX, OS/2, Windows) +A*2WG_“ª § âì £à ä¨ç¥áª¨© ⨯ ¯à¨«®¦¥­¨ï (Windows) +P*2WG_“ª § âì £à ä¨ç¥áª¨© ⨯ ¯à¨«®¦¥­¨ï (Classic Mac OS) +3*2Wi_ˆá¯®«ì§®¢ âì ¢­ãâ७­¨¥ à¥áãàáë (Darwin) +P*2Wi_ˆá¯®«ì§®¢ âì ¢­ãâ७­¨¥ à¥áãàáë (Darwin) +p*2Wi_ˆá¯®«ì§®¢ âì ¢­ãâ७­¨¥ à¥áãàáë (Darwin) +3*2WN_¥ £¥­¥à¨à®¢ âì ª®¤ ¯¥à¥¬¥é¥­¨ï, ­ã¦­® ¤«ï ®â« ¤ª¨ (Windows) +A*2WN_¥ £¥­¥à¨à®¢ âì ª®¤ ¯¥à¥¬¥é¥­¨ï, ­ã¦­® ¤«ï ®â« ¤ª¨ (Windows) +3*2WR_ƒ¥­¥à¨à®¢ âì ª®¤ ¯¥à¥¬¥é¥­¨ï (Windows) +A*2WR_ƒ¥­¥à¨à®¢ âì ª®¤ ¯¥à¥¬¥é¥­¨ï (Windows) +P*2WT_“ª § âì ⨯ ¯à¨«®¦¥­¨ï MPW tool (Classic Mac OS) +3*2WX_ §à¥è¨âì ¨á¯®«­ï¥¬ë© á⥪ (Linux) +A*2WX_ §à¥è¨âì ¨á¯®«­ï¥¬ë© á⥪ (Linux) +p*2WX_ §à¥è¨âì ¨á¯®«­ï¥¬ë© á⥪ (Linux) +P*2WX_ §à¥è¨âì ¨á¯®«­ï¥¬ë© á⥪ (Linux) +**1X_®¯æ¨¨ ¢ë¯®«­¥­¨ï +**2Xc_¥à¥¤ âì ª®¬¯®­®¢é¨ªã --shared/-dynamic (BeOS, Darwin, FreeBSD, Linux) +**2Xd_¥ ¨á¯®«ì§®¢ âì áâ ­¤ àâ­ë© ¯ãâì ¯®¨áª  ¡¨¡«¨®â¥ª (­ã¦­® ¤«ï ªà®á᪮¬¯¨«ï樨) +**2Xe_ˆá¯®«ì§®¢ âì ¢­¥è­¨© ª®¬¯®­®¢é¨ª +**2Xg_‘®§¤ âì ®â« ¤®ç­ãî ¨­ä®à¬ æ¨î ¢ ®â¤¥«ì­®¬ ä ©«¥ ¨ ¤®¡ ¢¨âì ᥪæ¨î debuglink ¢ ¨á¯®«­ï¥¬ë© ä ©« +**2XD_®¯à®¡®¢ âì ᪮¬¯®­®¢ âì ¤¨­ ¬¨ç¥áª¨ (®¯à¥¤¥«ï¥â ᨬ¢®« FPC_LINK_DYNAMIC) +**2Xi_ˆá¯®«ì§®¢ âì ¢­ãâ७­¨© ª®¬¯®­®¢é¨ª +**2Xm_‘®§¤ âì ª àâã ª®¬¯®­®¢ª¨ +**2XM<x>_‡ ¤ âì ¨¬ï ®á­®¢­®© â®çª¨ ¢å®¤  'main' (¯® 㬮«ç ­¨î 'main') +**2XP<x>_„®¡ ¢¨âì ª ¨¬¥­ ¬ binutils ¯à¥ä¨ªá <x> +**2Xr<x>_“áâ ­®¢¨âì rlink-path ª®¬¯®­®¢é¨ª  ¢ <x> (­ã¦­® ¤«ï ªà®á᪮¬¯¨«ï樨, á¬. à㪮¢®¤á⢮ ld) (BeOS, Linux) +**2XR<x>_„®¡ ¢¨â ¯à¥ä¨ªá <x> ª® ¢á¥¬ ¯ãâï¬ ¯®¨áª  ª®¬¯®­®¢é¨ª  (BeOS, Darwin, FreeBSD, Linux, Mac OS, Solaris) +**2Xs_“¡à âì ¢á¥ á¨¬¢®«ë ¨§ ¨á¯®«­ï¥¬®£® ä ©«  +**2XS_®¯à®¡®¢ âì ᪮¬¯®­®¢ âì áâ â¨ç¥áª¨ (¯® 㬮«ç ­¨î, ®¯à¥¤¥«ï¥â ᨬ¢®« FPC_LINK_STATIC) +**2Xt_Š®¬¯®­®¢ª  á® áâ â¨ç¥áª¨¬¨ ¡¨¡«¨®â¥ª ¬¨ (ª®¬¯®­®¢é¨ªã ¯¥à¥¤ ¥âáï -static) +**2XX_®¯à®¡®¢ âì "㬭ãî" ª®¬¯®­®¢ªã (®¯à¥¤¥«ï¥â ᨬ¢®« FPC_LINK_SMART) +**1*_ +**1?_¯®ª § âì íây á¯à ¢ªy +**1h_¯®ª § âì íây á¯à ¢ªy ¡¥§ ®¦¨¤ ­¨ï +] + +# +# The End... diff --git a/closures/compiler/msg/errorru.msg b/closures/compiler/msg/errorru.msg new file mode 100644 index 0000000000..4efaf6146b --- /dev/null +++ b/closures/compiler/msg/errorru.msg @@ -0,0 +1,2832 @@ +# +# This file is part of the Free Pascal Compiler +# Copyright (c) 1999-2009 by the Free Pascal Development team +# +# Russian (utf-8) Language File for Free Pascal +# +# This file corresponds to SVN revision 13665 of errore.msg +# Translated by Sergei Gorelkin <sergei_gorelkin at mail.ru> +# +# 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. +# +# +# КонÑтанты запиÑываютÑÑ Ð² Ñледyющем виде: +# <part>_<type>_<txtidentifier> +# +# <part> - чаÑÑ‚ÑŒ компилÑтора, в которой иÑпользуетÑÑ Ñообщение: +# asmr_ чтение аÑÑемблера +# asmw_ запиÑÑŒ аÑÑемблера/обьектных файлов +# unit_ обработка модулей +# scan_ Ñканер +# parser_ ÑемантичеÑкий анализатор +# type_ контроль ÑоответÑÑ‚Ð²Ð¸Ñ Ñ‚Ð¸Ð¿Ð¾Ð² +# general_ Ð¾Ð±Ñ‰Ð°Ñ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ +# exec_ вызовы внешних программ (аÑÑемблера, компоновщика и Ñ‚.д.) +# link_ внутренний компоновщик +# +# <type> тип ÑообщениÑ: +# f_ Ñ„Ð°Ñ‚Ð°Ð»ÑŒÐ½Ð°Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ° +# e_ ошибка +# w_ предупреждение +# n_ примечание +# h_ подÑказка +# i_ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ +# l_ добавлÑетÑÑ Ð½Ð¾Ð¼Ðµp ÑÑ‚pоки +# u_ иÑпользование +# t_ попытка иÑпользовать +# c_ уÑловное выражение +# d_ отладочное Ñообщение +# x_ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ иÑполнÑемых файлах +# o_ обычные ("нажмите любую клавишу") +# + +# +# General +# +# 01023 is the last used one +# +# BeginOfTeX +% \section{Общие ÑÐ¾Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ ÐºÐ¾Ð¼Ð¿Ð¸Ð»Ñтора} +% Этот раздел Ñодержит ÑÐ¾Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ð¾Ð½Ð½Ð¾Ð³Ð¾ назначениÑ. +% КоличеÑтво таких Ñообщений управлÑетÑÑ +% различными наÑÑ‚pойками ypÐ¾Ð²Ð½Ñ Ð¿Ð¾Ð´Ñ€Ð¾Ð±Ð½Ð¾Ñти \var{-v}. +% \begin{description} +general_t_compilername=01000_T_КомпилÑтоp: $1 +% При иÑпользовании ключа \var{-vt} Ñта Ñтрока Ñообщает вам, какой +% компилÑтор иÑпользуетÑÑ. +general_d_sourceos=01001_D_ОС компилÑтора: $1 +% При иÑпользовании ключа \var{-vd} Ñта Ñтрока Ñообщает название +% операционной ÑиÑтемы, в которой проиÑходит компилÑциÑ. +general_i_targetos=01002_I_Ð¦ÐµÐ»ÐµÐ²Ð°Ñ ÐžÐ¡: $1 +% При иÑпользовании ключа \var{-vd} Ñта Ñтрока Ñообщает название +% операционной ÑиÑтемы, Ð´Ð»Ñ ÐºÐ¾Ñ‚Ð¾Ñ€Ð¾Ð¹ ÑоздаетÑÑ Ñ„Ð°Ð¹Ð». +general_t_exepath=01003_T_ПyÑ‚ÑŒ иÑполнÑемых файлов: $1 +% При иÑпользовании ключа \var{-vt} Ñта Ñтрока Ñообщает путь, +% по которому компилÑтор ищет иÑполнÑемые файлы. +general_t_unitpath=01004_T_Путь модулей: $1 +% При иÑпользовании ключа \var{-vt} Ñта Ñтрока Ñообщает путь, +% по которому компилÑтор ищет компилируемые модули. Этот путь +% может быть изменен Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ ключа \var{-Fu}. +general_t_includepath=01005_T_ПyÑ‚ÑŒ включаемых файлов: $1 +% При иÑпользовании ключа \var{-vt} Ñта Ñтрока Ñообщает путь, +% по которому компилÑтор ищет включаемые файлы (файлы, иÑпользуемые в директивах +% \var{\{\$I xxx\}}). Этот путь может быть изменен Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ ключа \var{-I}. +general_t_librarypath=01006_T_ПyÑ‚ÑŒ библиотек: $1 +% При иÑпользовании ключа \var{-vt} Ñта Ñтрока Ñообщает путь, +% по которому компилÑтор ищет библиотеки. Этот путь может быть изменен +% Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ ключа \var{-Fl}. +general_t_objectpath=01007_T_ПyÑ‚ÑŒ объектных файлов: $1 +% При иÑпользовании ключа \var{-vt} Ñта Ñтрока Ñообщает путь, по которому +% компилÑтор ищет объектные файлы (файлы, иÑпользуемые в директивах +% \var{\{\$L xxx \}}). Этот путь может быть изменен Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ ключа \var{-Fo}. +general_i_abslines_compiled=01008_I_$1 Ñтрок Ñкомпилиpовано, $2 Ñек.$3 +% При иÑпользовании ключа \var{-vi} компилÑтор Ñообщает чиÑло +% Ñкомпилиpованных Ñтрок, и времÑ, которое потpебовалоÑÑŒ Ð´Ð»Ñ Ñтого. +% (реальное, не программное времÑ). +general_f_no_memory_left=01009_F_HедоÑтаточно памÑти +% КомпилÑтору не хватило памÑти Ð´Ð»Ñ ÐºÐ¾Ð¼Ð¿Ð¸Ð»Ñции вашей программы. +% ИмеетÑÑ Ð½ÐµÑколько pекомендаций Ð´Ð»Ñ pÐµÑˆÐµÐ½Ð¸Ñ Ñтого вопpоÑа: +% \begin{itemize} +% \item ВмеÑто полной Ñборки проекта, попробуйте компилировать +% отдельные модули вручную. +% \item ЕÑли размер программы большой, разбейте ее на модули, и +% компилируйте их отдельно. +% \item ЕÑли предыдущие рекомендации не работают, переÑоберите компилÑтор +% Ñ Ð±Ð¾Ð»ÑŒÑˆÐ¸Ð¼ pазмеpом кyчи (Ð´Ð»Ñ Ñтого иÑпользуетÑÑ ÐºÐ»ÑŽÑ‡ \var{-Ch}, \seeo{Ch}) +% \end{itemize} +general_i_writingresourcefile=01010_I_ЗапиÑÑŒ файла таблицы ÑÑ‚pоковых pеÑypÑов: $1 +% Сообщение означает, что компилÑтор Ñоздает файл, Ñодержащий вÑе реÑурÑные Ñтроки программы +% (таблицу Ñтроковых реÑурÑов). +general_e_errorwritingresourcefile=01011_E_Ошибка запиÑи файла таблицы ÑÑ‚pоковых pеÑypÑов: $1 +% Сообщение означает, что в процеÑÑе запиÑи файла Ñтроковых реÑурÑов +% произошла ошибка. +general_i_fatal=01012_I_Фатально: +% ÐŸÑ€ÐµÑ„Ð¸ÐºÑ Ð´Ð»Ñ Ñ„Ð°Ñ‚Ð°Ð»ÑŒÐ½Ñ‹Ñ… ошибок +general_i_error=01013_I_Ошибка: +% ÐŸÑ€ÐµÑ„Ð¸ÐºÑ Ð´Ð»Ñ Ð¾ÑˆÐ¸Ð±Ð¾Ðº +general_i_warning=01014_I_Внимание: +% ÐŸÑ€ÐµÑ„Ð¸ÐºÑ Ð´Ð»Ñ Ð¿Ñ€ÐµÐ´ÑƒÐ¿Ñ€ÐµÐ¶Ð´ÐµÐ½Ð¸Ð¹ (!! "Предупреждение:" обрезаетÑÑ, по крайней мере в utf-8 !!) +general_i_note=01015_I_Заметка: +% ÐŸÑ€ÐµÑ„Ð¸ÐºÑ Ð´Ð»Ñ Ð·Ð°Ð¼ÐµÑ‚Ð¾Ðº +general_i_hint=01016_I_ПодÑказка: +% ÐŸÑ€ÐµÑ„Ð¸ÐºÑ Ð´Ð»Ñ Ð¿Ð¾Ð´Ñказок +general_e_path_does_not_exist=01017_E_Путь "$1" не ÑущеÑтвует +% Указанный путь не ÑущеÑтвует. +general_f_compilation_aborted=01018_F_КомпилÑÑ†Ð¸Ñ Ð¿Ñ€ÐµÑ€Ð²Ð°Ð½Ð° +% КомпилÑÑ†Ð¸Ñ Ð±Ñ‹Ð»Ð° прервана. +general_text_bytes_code=01019_байт кода +% Размер Ñгенерированного кода, в байтах. +general_text_bytes_data=01020_байт данных +% Размер Ñгенерированных данных программы, в байтах +general_i_number_of_warnings=01021_I_$1 предупреждений +% Общее чиÑло предупреждений, выданных в процеÑÑе компилÑции. +general_i_number_of_hints=01022_I_$1 подÑказок +% Общее чиÑло подÑказок, выданных в процеÑÑе компилÑции. +general_i_number_of_notes=01023_I_$1 заметок +% Общее чиÑло заметок, выданных в процеÑÑе компилÑции. +% \end{description} +# +# Scanner +# +# 02086 is the last used one +# +% \section {Ð¡Ð¾Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ Ñканера.} +% Этот раздел перечиÑлÑет ÑообщениÑ, котоpые выдает Ñканер. Сканер оÑущеÑтвлÑет +% лекÑичеÑкий анализ Ñтруктуры иÑходного файла, Ñ‚.е. находит +% зарезервированные Ñлова, Ñтроки, и Ñ‚.д. Сканер также обрабатывает директивы и +% Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ ÑƒÑловной компилÑции. +% \begin{description} +scan_f_end_of_file=02000_F_Hеожиданный конец файла +% Это обычно проиÑходит в Ñледующих ÑлучаÑÑ…: +% \begin{itemize} +% \item ИÑходный файл заканчиваетÑÑ Ð´Ð¾ поÑледнего Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ \var{end}. +% Чаще вÑего проиÑходит, еÑли Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ \var{begin} и \var{end} не +% ÑбаланÑированы (их количеÑтво не Ñовпадает); +% \item Включаемый файл заканчиваетÑÑ Ð² Ñередине выpажениÑ. +% \item Ðе был закрыт комментарий. +% \end{itemize} +scan_f_string_exceeds_line=02001_F_Ðе закрыта ÑÑ‚Ñ€Ð¾ÐºÐ¾Ð²Ð°Ñ ÐºÐ¾Ð½Ñтанта +% ОтÑутÑтвует закрывающий Ñимвол ' Ñтрокового конÑтанты, так что конÑтанта занимает +% неÑколько Ñтрок файла. +scan_f_illegal_char=02002_F_Запpещенный Ñимвол "$1" ($2) +% Ð’ иÑходном файле обнаружен запрещенный Ñимвол. +scan_f_syn_expected=02003_F_СинтакÑичеÑÐºÐ°Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ°, ожидаетÑÑ "$1", но обнаружено "$2" +% КомпилÑтор ожидал не тот токен, который ему вÑтретилÑÑ. Это может +% проиÑходить везде, где только возможно нарушить правила +% Ñзыка ПаÑкаль. +scan_t_start_include_file=02004_TL_Hачало Ñ‡Ñ‚ÐµÐ½Ð¸Ñ Ð²ÐºÐ»ÑŽÑ‡Ð°ÐµÐ¼Ð¾Ð³Ð¾ файла $1 +% При иÑпользовании ключа \var{-vt} компилÑтор Ñообщает, +% когда он начинает читать включаемый файл. +scan_w_comment_level=02005_W_Hайден комментарий $1 ypÐ¾Ð²Ð½Ñ +% При иÑпользовании ключа \var{-vw} компилÑтор предупреждает о том, +% что он обнаружил вложенный комментарий. Вложенные комментарии не разрешены в +% Turbo Pascal и могут быть возможным иÑточником ошибок. +scan_n_ignored_switch=02008_N_Директива компилÑтора $1 игнорирована +% При иÑпользовании ключа \var{-vn} компилÑтор предупреждает о том, что он игнорирует директиву. +scan_w_illegal_switch=02009_W_HеизвеÑÑ‚Ð½Ð°Ñ Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¸Ð²Ð° компилÑтоpа $1 +% Была иÑпользована директива компилÑтора (то еÑÑ‚ÑŒ \var{\{\$... \}}), ÐºÐ¾Ñ‚Ð¾Ñ€Ð°Ñ +% компилÑтору не извеÑтна. +scan_w_switch_is_global=02010_W_Ð“Ð»Ð¾Ð±Ð°Ð»ÑŒÐ½Ð°Ñ Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¸Ð²Ð° не на Ñвоем меÑте +% Глобальные директивы должны находитьÑÑ Ð² начале программы или модулÑ. +scan_e_illegal_char_const=02011_E_Hеверно задан Ñимвол +% Это ÑлучаетÑÑ Ð¿Ñ€Ð¸ определении Ñимвола Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ ASCII-кода, например, +% \var{\#96}, но чиÑло либо ÑвлÑетÑÑ Ð½ÐµÐ²ÐµÑ€Ð½Ñ‹Ð¼, либо вне допуÑтимого диапазона. +scan_f_cannot_open_input=02012_F_Hевозможно откpÑ‹Ñ‚ÑŒ файл "$1" +% \fpc не может найти иÑходный файл программы или модулÑ, указанный +% в командной Ñтроке. +scan_f_cannot_open_includefile=02013_F_Hевозможно откpÑ‹Ñ‚ÑŒ включаемый файл "$1" +% \fpc не может найти иÑходный файл, указанный в директиве \var{\{\$include \}}. +scan_e_illegal_pack_records=02015_E_Ðеверное указание Ð²Ñ‹Ñ€Ð°Ð²Ð½Ð¸Ð²Ð°Ð½Ð¸Ñ Ð·Ð°Ð¿Ð¸Ñи "$1" +% Ð’ директиве \var{\{\$PACKRECORDS n\} } или \var{\{\$ALIGN n\} } иÑпользуетÑÑ Ð½ÐµÐ²ÐµÑ€Ð½Ð¾Ðµ значение +% \var{n}. Ð”Ð»Ñ \$PACKRECORDS допуÑтимы только 1, 2, 4, 8, 16, 32, C, +% NORMAL, DEFAULT, а Ð´Ð»Ñ \$ALIGN допуÑтимы Ð·Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ 1, 2, 4, 8, 16, 32, ON, +% OFF. Ð’ режиме MacPas \$ALIGN также поддерживает MAC68K, POWER и RESET. +scan_e_illegal_pack_enum=02016_E_Ðеверное указание минимального размера перечиÑÐ»ÐµÐ½Ð¸Ñ "$1" +% Ð’ директиве \var{\{\$PACKENUM n \}} иÑпользуетÑÑ Ð½ÐµÐ²ÐµÑ€Ð½Ð¾Ðµ значение +% \var {n}. ДопуÑтимыми ÑвлÑÑŽÑ‚ÑÑ Ð·Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ 1,2,4, NORMAL и DEFAULT. +scan_e_endif_expected=02017_E_ОжидаетÑÑ $ENDIF Ð´Ð»Ñ $1 $2, определенного в $3 Ñтрока $4 +% Директивы уÑловной компилÑции не ÑбаланÑированы. +scan_e_preproc_syntax_error=02018_E_СинтакÑичеÑÐºÐ°Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ° в выражении уÑловной компилÑции +% Ð’ выражении, Ñледующем поÑле директивы \var{\{\$if \}}, $ifc или $setc, допущена ошибка. +scan_e_error_in_preproc_expr=02019_E_Ошибка при вычиÑлении Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ ÑƒÑловной компилÑции +% Ð’ выражении, Ñледующем поÑле директивы \var{\{\$if \}}, $ifc или $setc, допущена ошибка. +scan_w_macro_cut_after_255_chars=02020_W_Длина макpоÑа ограничена 255 Ñимволами +% Длина макрокоманды не может превышать 255 Ñимволов. +scan_e_endif_without_if=02021_E_ENDIF без IF(N)DEF +% Директивы \var{\{\$IFDEF.. \}} и {\ {\$ENDIF \}} не ÑбаланÑированы. +scan_f_user_defined=02022_F_Задано пользователем: $1 +% Пpоизошла Ñ„Ð°Ñ‚Ð°Ð»ÑŒÐ½Ð°Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ°, Ð·Ð°Ð´Ð°Ð½Ð½Ð°Ñ Ð¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ñ‚ÐµÐ»ÐµÐ¼. См. также \progref +scan_e_user_defined=02023_E_Задано пользователем: $1 +% Пpоизошла ошибка, Ð·Ð°Ð´Ð°Ð½Ð½Ð°Ñ Ð¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ñ‚ÐµÐ»ÐµÐ¼. См. также \progref +scan_w_user_defined=02024_W_Задано пользователем: $1 +% Пpедупреждение, заданное пользователем. См. также \progref +scan_n_user_defined=02025_N_Задано пользователем: $1 +% Заметка, Ð·Ð°Ð´Ð°Ð½Ð½Ð°Ñ Ð¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ñ‚ÐµÐ»ÐµÐ¼. См. также \progref +scan_h_user_defined=02026_H_Задано пользователем: $1 +% ПодÑказка, Ð·Ð°Ð´Ð°Ð½Ð½Ð°Ñ Ð¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ñ‚ÐµÐ»ÐµÐ¼. См. также \progref +scan_i_user_defined=02027_I_Задано пользователем: $1 +% ИнформациÑ, Ð·Ð°Ð´Ð°Ð½Ð½Ð°Ñ Ð¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ñ‚ÐµÐ»ÐµÐ¼. См. также \progref +scan_e_keyword_cant_be_a_macro=02028_E_Ключевое Ñлово, переопределенное как макроÑ, не имеет Ñффекта +% Ключевые Ñлова не могут быть переопределены Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ макрокоманд. +scan_f_macro_buffer_overflow=02029_F_Переполнение бyфеpа макpоÑов при чтении или раÑширении макрокоманды +% Длина макpокоманды или ее результата Ñлишком велика. +scan_w_macro_too_deep=02030_W_ЧиÑло уровней раÑшиpÐµÐ½Ð¸Ñ Ð¼Ð°ÐºÑ€Ð¾ÐºÐ¾Ð¼Ð°Ð½Ð´Ñ‹ превышает 16. +% При раÑширении макрокоманды было иÑпользовано более 16 ypовней вложенноÑти. +% КомпилÑтор не будет pаÑшиpÑÑ‚ÑŒ дальше, так как Ñто может быть признаком иÑÐ¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ð½Ð¸Ñ Ñ€ÐµÐºÑƒÑ€Ñии. +scan_w_wrong_styled_switch=02031_W_Директивы компилÑтоpа в комментариÑÑ… ÑÑ‚Ð¸Ð»Ñ // не поддерживаютÑÑ. +% Директивы компилÑтора должны быть в комментариÑÑ… ÑÑ‚Ð¸Ð»Ñ ÐŸÐ°Ñкаль. +scan_d_handling_switch=02032_DL_Обработка директивы "$1" +% При включении отладочной информации (\var{-vd}), компилÑтор Ñообщает +% о том, что он вычиÑлÑет выражение уÑловной компилÑции. +scan_c_endif_found=02033_CL_ENDIF $1 найдено +% При включении Ñообщений об уÑловных выражениÑÑ… (\var{-vc}), компилÑтор Ñообщает +% о том, где он обрабатывает Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ ÑƒÑловной компилÑции. +scan_c_ifdef_found=02034_CL_IFDEF $1 найдено, $2 +% При включении Ñообщений об уÑловных выражениÑÑ… (\var{-vc}), компилÑтор Ñообщает +% о том, где он обрабатывает Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ ÑƒÑловной компилÑции. +scan_c_ifopt_found=02035_CL_IFOPT $1 найдено, $2 +% При включении Ñообщений об уÑловных выражениÑÑ… (\var{-vc}), компилÑтор Ñообщает +% о том, где он обрабатывает Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ ÑƒÑловной компилÑции. +scan_c_if_found=02036_CL_IF $1 найдено, $2 +% При включении Ñообщений об уÑловных выражениÑÑ… (\var{-vc}), компилÑтор Ñообщает +% о том, где он обрабатывает Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ ÑƒÑловной компилÑции. +scan_c_ifndef_found=02037_CL_IFNDEF $1 найдено, $2 +% При включении Ñообщений об уÑловных выражениÑÑ… (\var{-vc}), компилÑтор Ñообщает +% о том, где он обрабатывает Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ ÑƒÑловной компилÑции. +scan_c_else_found=02038_CL_ELSE $1 найдено, $2 +% При включении Ñообщений об уÑловных выражениÑÑ… (\var{-vc}), компилÑтор Ñообщает +% о том, где он обрабатывает Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ ÑƒÑловной компилÑции. +scan_c_skipping_until=02039_CL_ПpопyÑкаем до ... +% При включении Ñообщений об уÑловных выражениÑÑ… (\var{-vc}), компилÑтор Ñообщает +% о том, что он пропуÑкает чаÑÑ‚ÑŒ уÑловного выражениÑ, не удовлетворÑющую уÑловию. +scan_i_press_enter=02040_I_Hажмите <ENTER> Ð´Ð»Ñ Ð¿Ñ€Ð¾Ð´Ð¾Ð»Ð¶ÐµÐ½Ð¸Ñ +% При иÑпользовании ключа \var{-vi} компилÑтор оÑтанавливаетÑÑ +% и ждет Ð½Ð°Ð¶Ð°Ñ‚Ð¸Ñ Ð½Ð° клавишу \var{enter}, еÑли в иÑходном файле +% вÑтречаетÑÑ Ð´Ð¸pектива \var {\{\$STOP\}}. +scan_w_unsupported_switch=02041_W_Директива "$1" не поддерживаетÑÑ +% При включенных предупреждениÑÑ… (\var{-vw}), компилÑтор предупреждает +% о неподдерживаемых директивах. Это означает, что директива иÑпользуетÑÑ +% в Delphi или Turbo Pascal, но не в \fpc +scan_w_illegal_directive=02042_W_HÐµÐ²ÐµÑ€Ð½Ð°Ñ Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¸Ð²Ð° компилÑтора "$1" +% При включенных пpедyпpеждениÑÑ… (\var{-vw}), компилÑтор предупреждает +% о неверных диpективах. СпиÑок раÑпознаваемых диpектив Ñм. в \progref +scan_t_back_in=02043_TL_Возвpат в $1 +% При иÑпользовании ключа (\var{-vt}) компилÑтор Ñообщает об окончании +% Ñ‡Ñ‚ÐµÐ½Ð¸Ñ Ð²ÐºÐ»ÑŽÑ‡Ð°ÐµÐ¼Ð¾Ð³Ð¾ файла. +scan_w_unsupported_app_type=02044_W_Тип пpÐ¸Ð»Ð¾Ð¶ÐµÐ½Ð¸Ñ "$1" не поддерживаетÑÑ +% Это предупреждение выдаетÑÑ Ð¿Ñ€Ð¸ иÑпользовании неизвеÑтного типа +% Ð¿Ñ€Ð¸Ð»Ð¾Ð¶ÐµÐ½Ð¸Ñ Ð² директиве \var{\{\$APPTYPE\}} +scan_w_app_type_not_support=02045_W_APPTYPE не поддерживаетÑÑ Ñ†ÐµÐ»ÐµÐ²Ð¾Ð¹ ОС +% Директива \var{\{\$APPTYPE\}} поддерживаетÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ некоторыми операционными ÑиÑтемами. +scan_w_description_not_support=02046_W_DESCRIPTION не поддерживаетÑÑ Ñ†ÐµÐ»ÐµÐ²Ð¾Ð¹ ОС +% Директива \var{\{\$DESCRIPTION\}} не поддерживаетÑÑ Ð½Ð° данной целевой ОС. +scan_n_version_not_support=02047_N_VERSION не поддерживаетÑÑ Ñ†ÐµÐ»ÐµÐ²Ð¾Ð¹ ОС +% Директива \var{\{\$VERSION\}} не поддерживаетÑÑ Ð½Ð° данной целевой ОС. +scan_n_only_exe_version=02048_N_VERSION иÑпользуетÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ Ð´Ð»Ñ .EXE и .DLL иÑходников +% Директива \var{\{\$VERSION\}} иÑпользуетÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ Ð´Ð»Ñ .EXE и .DLL иÑходников. +scan_w_wrong_version_ignored=02049_W_Ðеверный формат VERSION Ð´Ð»Ñ Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¸Ð²Ñ‹ "$1" +% Формат директивы \var{\{\$VERSION\}} - major_version.minor_version +% где major_version и minor_version ÑвлÑÑŽÑ‚ÑÑ Ñловами. +scan_e_illegal_asmmode_specifier=02050_E_Hеверный Ñтиль аÑÑемблеpа: "$1" +% При определении режима аÑÑемблера директивой \var{\{\$ASMMODE xxx\}} +% указан неверный режим. +scan_w_no_asm_reader_switch_inside_asm=02051_W_Смена типа аÑÑемблеpа невозможна внутри блока, "$1" бyдет дейÑтвовать только Ð´Ð»Ñ Ñледyющего блока +% Внутри аÑÑемблерного блока невозможно переключение аÑÑемблера Ñ Ð¾Ð´Ð½Ð¾Ð³Ð¾ типа на другой. +% Указанный режим начнет дейÑтвовать только Ð´Ð»Ñ Ñледующего аÑÑемблерного блока. +scan_e_wrong_switch_toggle=02052_E_Hевеpное переключение режима, иÑпользуйте ON/OFF или +/- +% Ð”Ð»Ñ Ð¿ÐµÑ€ÐµÐºÐ»ÑŽÑ‡ÐµÐ½Ð¸Ñ Ñ€ÐµÐ¶Ð¸Ð¼Ð¾Ð² Ñледует иÑпользовать ON или OFF, либо + или - +scan_e_resourcefiles_not_supported=02053_E_Файлы pеÑypÑов не поддерживаютÑÑ Ñ†ÐµÐ»ÐµÐ²Ð¾Ð¹ ОС +% ÐžÐ¿ÐµÑ€Ð°Ñ†Ð¸Ð¾Ð½Ð½Ð°Ñ ÑиÑтема, Ð´Ð»Ñ ÐºÐ¾Ñ‚Ð¾Ñ€Ð¾Ð¹ проиÑходит компилÑциÑ, не поддерживает файлы реÑурÑов. +scan_w_include_env_not_found=02054_W_Ð’ÐºÐ»ÑŽÑ‡Ð°ÐµÐ¼Ð°Ñ Ð¿ÐµpÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ð¾ÐºpyÐ¶ÐµÐ½Ð¸Ñ "$1" не найдена +% Ð£ÐºÐ°Ð·Ð°Ð½Ð½Ð°Ñ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ð¾ÐºÑ€ÑƒÐ¶ÐµÐ½Ð¸Ñ Ð½Ðµ найдена, вмеÑто нее будет подÑтавлена пуÑÑ‚Ð°Ñ Ñтрока. +scan_e_invalid_maxfpureg_value=02055_E_Ðеверное значение Ð´Ð»Ñ Ð¼Ð°ÐºÑимального чиÑла региÑтров ÑопроцеÑÑора +% ДопуÑтимыми значениÑми Ð´Ð»Ñ Ñтой директивы ÑвлÑÑŽÑ‚ÑÑ 0..8 и NORMAL/DEFAULT +scan_w_only_one_resourcefile_supported=02056_W_Ð”Ð»Ñ Ñтой ÑиÑтемы поддерживаетÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ один файл реÑурÑов +% Ð”Ð»Ñ Ð¾Ð¿ÐµÑ€Ð°Ñ†Ð¸Ð¾Ð½Ð½Ð¾Ð¹ ÑиÑтемы Ð½Ð°Ð·Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ Ð¿Ð¾Ð´Ð´ÐµÑ€Ð¶Ð¸Ð²Ð°ÐµÑ‚ÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ один файл реÑурÑов. +% Будет иÑпользован первый найденный файл, оÑтальные будут игнорированы. +scan_w_macro_support_turned_off=02057_W_Поддеpжка макpоÑов отключена +% Обнаружено объÑвление макроÑа, но режим поддержки макроÑов отключен, +% поÑтому объÑвление будет игнорировано. Ð”Ð»Ñ Ð²ÐºÐ»ÑŽÑ‡ÐµÐ½Ð¸Ñ Ð¿Ð¾Ð´Ð´ÐµÑ€Ð¶ÐºÐ¸ макроÑов иÑпользуйте +% -Sm в командной Ñтроке или добавьте {$MACRO ON} в иÑходный файл. +scan_e_invalid_interface_type=02058_E_Ðеверный тип interface. ДопуÑтимы только COM, COBRA или DEFAULT +% Указанный тип интерфейÑа не поддерживаетÑÑ. +scan_w_appid_not_support=02059_W_APPID поддерживаетÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ Ð´Ð»Ñ PalmOS +% Директива \var{\{\$APPID\}} поддерживаетÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ при компилÑции Ð´Ð»Ñ PalmOS. +scan_w_appname_not_support=02060_W_APPNAME поддерживаетÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ Ð´Ð»Ñ PalmOS +% Директива \var{\{\$APPNAME\}} поддерживаетÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ при компилÑции Ð´Ð»Ñ PalmOS. +scan_e_string_exceeds_255_chars=02061_E_Ð¡Ñ‚Ñ€Ð¾ÐºÐ¾Ð²Ð°Ñ ÐºÐ¾Ð½Ñтанта не может быть длиннее 255 Ñимволов +% Одна ÑÑ‚Ñ€Ð¾ÐºÐ¾Ð²Ð°Ñ ÐºÐ¾Ð½Ñтанта может Ñодержать 255 Ñимволов макÑимум. Более длинную +% Ñтроку Ñледует разбить на чаÑти и Ñоединить их оператором +. +scan_f_include_deep_ten=02062_F_Уровень Ð²Ð»Ð¾Ð¶ÐµÐ½Ð¸Ñ Ð²ÐºÐ»ÑŽÑ‡Ð°ÐµÐ¼Ñ‹Ñ… файлов превоÑходит 16. +% При чтении включаемых файлов доÑтигнут уровень вложенноÑти 16. +% КомпилÑтор прекращает работу, Ñ‚.к. Ñто может ÑвлÑÑ‚ÑŒÑÑ Ð¿Ñ€Ð¸Ð·Ð½Ð°ÐºÐ¾Ð¼ рекурÑии. +scan_e_too_many_push=02063_F_Слишком много уровней PUSH +% ДопуÑтимый макÑимум ÑоÑтавлÑет 20. Эта ошибка возникает только в режиме MacPas. +scan_e_too_many_pop=02064_E_Директива POP без предшеÑтвующей PUSH +% Эта ошибка возникает только в режиме MacPas. +scan_e_error_macro_lacks_value=02065_E_ÐœÐ°ÐºÑ€Ð¾Ñ Ð¸Ð»Ð¸ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ð²Ñ€ÐµÐ¼ÐµÐ½Ð¸ компилÑции "$1" не имеет приÑвоенного Ð·Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ +% Из-за Ñтого выражение времени компилÑции не может быть вычиÑлено. +scan_e_wrong_switch_toggle_default=02066_E_Ðеверное переключение режима, иÑпользуйте ON/OFF/DEFAULT или +/-/* +% Следует переключать режим, иÑÐ¿Ð¾Ð»ÑŒÐ·ÑƒÑ ON или OFF или DEFAULT, либо + или - или * +scan_e_mode_switch_not_allowed=02067_E_Директива режима "$1" здеÑÑŒ не допуÑтима +% Директива режима компилÑции уже была обработана, или, в Ñлучае режима -Mmacpas, +% переключение режима проиÑходит поÑле UNIT. +scan_e_error_macro_undefined=02068_E_ÐŸÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ð²Ñ€ÐµÐ¼ÐµÐ½Ð¸ компилÑции или Ð¼Ð°ÐºÑ€Ð¾Ñ "$1" не определен. +% Из-за Ñтого выражение времени компилÑции не может быть вычиÑлено. Только Ð´Ð»Ñ Ñ€ÐµÐ¶Ð¸Ð¼Ð° MacPas. +scan_e_utf8_bigger_than_65535=02069_E_Обнаружен код UTF-8, превышающий 65535 +% \fpc обрабатывает Ñтроки utf-8 как widestring, Ñ‚.е. коды Ñимволов ограничены 65535 +scan_e_utf8_malformed=02070_E_ÐÐµÐ²ÐµÑ€Ð½Ð°Ñ UTF-8 Ñтрока +% Ð”Ð°Ð½Ð½Ð°Ñ Ñтрока не ÑвлÑетÑÑ Ð´Ð¾Ð¿ÑƒÑтимой в кодировке UTF-8 +scan_c_switching_to_utf8=02071_C_Ðайдена Ñигнатура UTF-8, иÑпользую кодировку UTF-8 +% КомпилÑтор обнаружил Ñигнатуру UTF-8 (\$ef, \$bb, \$bf) в начале файла, +% поÑтому он будет обрабатывать файл как UTF-8 +scan_e_compile_time_typeerror=02072_E_Выражение времени компилÑции: ОжидалоÑÑŒ $1, но получено $2 в $3 +% Ошибка типов в выражении времени компилÑции. +scan_n_app_type_not_support=02073_N_APPTYPE не поддерживаетÑÑ Ñ†ÐµÐ»ÐµÐ²Ð¾Ð¹ ОС +% Директива \var{\{\$APPTYPE\}} поддерживаетÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ Ð´Ð»Ñ Ð½ÐµÐºÐ¾Ñ‚Ð¾Ñ€Ñ‹Ñ… операционных ÑиÑтем. +scan_e_illegal_optimization_specifier=02074_E_Ðеверный тип оптимизации "$1" +% Ð’ директиве \var{\{\$OPTIMIZATION xxx\}} указано неверное значение. +scan_w_setpeflags_not_support=02075_W_SETPEFLAGS не поддерживаетÑÑ Ñ†ÐµÐ»ÐµÐ²Ð¾Ð¹ ОС +% Директива \var{\{\$SETPEFLAGS\}} не поддерживаетÑÑ Ð¾Ð¿ÐµÑ€Ð°Ñ†Ð¸Ð¾Ð½Ð½Ð¾Ð¹ ÑиÑтемой назначениÑ. +scan_w_imagebase_not_support=02076_W_IMAGEBASE не поддерживаетÑÑ ÐžÐ¡ Ð½Ð°Ð·Ð°Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ +% Директива \var{\{\$IMAGEBASE\}} не поддерживаетÑÑ Ð¾Ð¿ÐµÑ€Ð°Ñ†Ð¸Ð¾Ð½Ð½Ð¾Ð¹ ÑиÑтемой назначениÑ. +scan_w_minstacksize_not_support=02077_W_MINSTACKSIZE не поддерживаетÑÑ ÐžÐ¡ Ð½Ð°Ð·Ð°Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ +% Директива \var{\{\$MINSTACKSIZE\}} не поддерживаетÑÑ Ð¾Ð¿ÐµÑ€Ð°Ñ†Ð¸Ð¾Ð½Ð½Ð¾Ð¹ ÑиÑтемой назначениÑ. +scan_w_maxstacksize_not_support=02078_W_MAXSTACKSIZE не поддерживаетÑÑ ÐžÐ¡ Ð½Ð°Ð·Ð°Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ +% Директива \var{\{\$MAXSTACKSIZE\}} не поддерживаетÑÑ Ð¾Ð¿ÐµÑ€Ð°Ñ†Ð¸Ð¾Ð½Ð½Ð¾Ð¹ ÑиÑтемой назначениÑ. +scanner_e_illegal_warn_state=02079_E_Ðеверный режим директивы $WARN +% Директива \$warn допуÑкает только ON и OFF Ð´Ð»Ñ ÑƒÐºÐ°Ð·Ð°Ð½Ð¸Ñ Ñ€ÐµÐ¶Ð¸Ð¼Ð° +scan_e_only_packset=02080_E_Ðеверное значение упаковки множеÑтв +% ДопуÑтимыми значениÑми ÑвлÑÑŽÑ‚ÑÑ 0, 1, 2, 4, 8, DEFAULT и NORMAL +scan_w_pic_ignored=02081_W_Директива или ключ PIC игнорированы +% Ðекоторые платформы, например, Windows, не поддерживают и не требуют позиционно-незавиÑимый код (PIC), +% поÑтому ÑоответÑтвующие диркективы и ключи командной Ñтроки Ð´Ð»Ñ Ð½Ð¸Ñ… игнорируютÑÑ. +scan_w_unsupported_switch_by_target=02082_W_Директива "$1" не поддерживаетÑÑ Ð´Ð»Ñ Ñ‚ÐµÐºÑƒÑ‰ÐµÐ¹ платформы Ð½Ð°Ð·Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ +% Ðекоторые директивы, например, \$E, поддерживаютÑÑ Ð½Ðµ Ð´Ð»Ñ Ð²Ñех платформ. +scan_w_frameworks_darwin_only=02084_W_Директивы Ð´Ð»Ñ Framework поддерживаютÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ Ð´Ð»Ñ Darwin/Mac OS X +% ÐšÐ¾Ð½Ñ†ÐµÐ¿Ñ†Ð¸Ñ Ñ„Ñ€ÐµÐ¹Ð¼Ð²Ð¾Ñ€ÐºÐ¾Ð² не поддерживаетÑÑ FPC Ð´Ð»Ñ Ð¾Ð¿ÐµÑ€Ð°Ñ†Ð¸Ð¾Ð½Ð½Ñ‹Ñ… ÑиÑтем, отличных от Darwin/Mac OS X. +scan_e_illegal_minfpconstprec=02085_E_Ðеверное указание минимальной точноÑти конÑтант Ñ Ð¿Ð»Ð°Ð²Ð°ÑŽÑ‰ÐµÐ¹ запÑтой "$1" +% ДопуÑтимыми значениÑми ÑвлÑÑŽÑ‚ÑÑ default, 32 и 64, которые означают ÑоответÑтвенно минимальную (обычно 32 бита), 32 бит и 64 бит точноÑÑ‚ÑŒ. +scan_w_multiple_main_name_overrides=02086_W_Многократное указание имени процедуры "main", первоначально было "$1" +% Ð˜Ð¼Ñ Ð¾Ñновной точки входа указано более одного раза. Будет иÑпользовано только поÑледнее имÑ. +% \end{description} +# +# Parser +# +# 03252 is the last used one +# +% \section {ÑÐ¾Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ ÑинтакÑичеÑкого анализатора} +% Этот раздел перечиÑлÑет вÑе ÑÐ¾Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ ÑинтакÑичеÑкого анализатора. +% СинтакÑичеÑкий анализатор оÑущеÑтвлÑет ÑемантичеÑкий анализ, Ñ‚.е. +% определÑет правильноÑÑ‚ÑŒ выражений ПаÑкалÑ. +% \begin{description} +parser_e_syntax_error=03000_E_СинтакÑичеÑÐºÐ°Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ° в анализаторе +% Обнаружена ошибка ÑинтакÑиÑа Ñзыка. Обычно проиÑходит, когда в иÑходном файле +% вÑтречаетÑÑ Ð½ÐµÐ´Ð¾Ð¿ÑƒÑтимый Ñимвол. +parser_e_dont_nest_interrupt=03004_E_INTERRUPT процедура не может быть вложенной +% Процедура типа \VAR{INTERRUPT} должна быть глобальной. +parser_w_proc_directive_ignored=03005_W_Директива процедуры "$1" игнорирована +% Указанный модификтор типа процедуры игнорирован компилÑтором. +parser_e_no_overload_for_all_procs=03006_E_Ðе вÑе объÑÐ²Ð»ÐµÐ½Ð¸Ñ "$1" перегружены (определены как OVERLOAD) +% При перегрузке процедур Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ директивы \var{OVERLOAD}, ее Ñледует +% указывать Ð´Ð»Ñ Ð²Ñех объÑвлений перегруженной процедуры. +parser_e_export_name_double=03008_E_Ð˜Ð¼Ñ Ñ„yнкции "$1" ÑкÑпортируетÑÑ Ð´Ð²Ð°Ð¶Ð´Ñ‹ +% Ð’Ñе функции, ÑкÑпортируемые из одной DLL, должны иметь различные имена. +parser_e_export_ordinal_double=03009_E_Ð˜Ð½Ð´ÐµÐºÑ Ñ„ÑƒÐ½ÐºÑ†Ð¸Ð¸ $1 ÑкÑпортируетÑÑ Ð´Ð²Ð°Ð¶Ð´Ñ‹ +% Ð’Ñе функции, ÑкÑпортируемые из одной DLL, должны иметь различные индекÑÑ‹. +parser_e_export_invalid_index=03010_E_Hевеpный Ð¸Ð½Ð´ÐµÐºÑ ÑкÑпоpтиpyемой Ñ„yнкции +% Ð˜Ð½Ð´ÐµÐºÑ ÑкÑпортируемой функции должен быть в диапазоне \var{1..\$FFFF} +parser_w_parser_reloc_no_debug=03011_W_ÐžÑ‚Ð»Ð°Ð´Ð¾Ñ‡Ð½Ð°Ñ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð² перемещаемом DLL/EXE файле $1 не работоÑпоÑобна, отключена. +% Ð’ наÑтоÑщее Ð²Ñ€ÐµÐ¼Ñ Ð²ÐºÐ»ÑŽÑ‡ÐµÐ½Ð¸Ðµ отладочной информации в перемещаемую DLL невозможно. +parser_w_parser_win32_debug_needs_WN=03012_W_Ð”Ð»Ñ Ð¾Ñ‚Ð»Ð°Ð´ÐºÐ¸ win32-кода, Ñледует отключить перемещение ключом -WN +% ÐžÑ‚Ð»Ð°Ð´Ð¾Ñ‡Ð½Ð°Ñ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Stabs не работает в перемещаемых DLL или EXE файлах, иÑпользуйте -WN +% еÑли требуетÑÑ Ð¾Ñ‚Ð»Ð°Ð´ÐºÐ°. +parser_e_constructorname_must_be_init=03013_E_КонÑÑ‚pyктоp должен иметь Ð¸Ð¼Ñ INIT +% КонÑтруктор объÑвлен Ñ Ð¸Ð¼ÐµÐ½ÐµÐ¼, отличным от \var{init}, и дейÑтвует ключ +% \var{-Ss}. См. опиÑание дейÑÑ‚Ð²Ð¸Ñ ÐºÐ»ÑŽÑ‡Ð° \var{-Ss} (\seeo{Ss}). +parser_e_destructorname_must_be_done=03014_E_ДеÑÑ‚pyктоp должен иметь Ð¸Ð¼Ñ DONE +% ДеÑтруктор объÑвлен Ñ Ð¸Ð¼ÐµÐ½ÐµÐ¼, отличным от \var{done}, и дейÑтвует ключ +% \var{-Ss}. См. опиÑание дейÑÑ‚Ð²Ð¸Ñ ÐºÐ»ÑŽÑ‡Ð° \var{-Ss} (\seeo{Ss}). +parser_e_proc_inline_not_supported=03016_E_Директива INLINE не поддеpживаетÑÑ +% При компилÑции программы Ñ inlining в Ñтиле C++ не был иÑпользован ключ +% \var{-Si} (\seeo{Si}). По умолчанию компилÑтор не поддерживает inlining в Ñтиле C++. +parser_w_constructor_should_be_public=03018_W_КонÑÑ‚pyктоp должен быть public +% КонÑтрукторы должны быть в 'public' Ñекции объÑÐ²Ð»ÐµÐ½Ð¸Ñ Ð¾Ð±ÑŠÐµÐºÑ‚Ð° (клаÑÑа). +parser_w_destructor_should_be_public=03019_W_ДеÑÑ‚pyктоp должен быть public +% ДеÑтрукторы должны быть в 'public' Ñекции объÑÐ²Ð»ÐµÐ½Ð¸Ñ Ð¾Ð±ÑŠÐµÐºÑ‚Ð° (клаÑÑа). +parser_n_only_one_destructor=03020_N_КлаÑÑ Ð¼Ð¾Ð¶ÐµÑ‚ иметь только один деÑÑ‚pyктоp +% Ð”Ð»Ñ ÐºÐ»Ð°ÑÑа можно определить только один деÑтруктор. +parser_e_no_local_objects=03021_E_Локальные объÑÐ²Ð»ÐµÐ½Ð¸Ñ ÐºÐ»Ð°ÑÑов не поддеpживаютÑÑ +% КлаÑÑÑ‹ должны быть объÑвлены глобально. Они не могут быть объÑвлены внутри +% процедуры или функции. +parser_f_no_anonym_objects=03022_F_Ðнонимные объÑÐ²Ð»ÐµÐ½Ð¸Ñ ÐºÐ»Ð°ÑÑов не поддеpживаетÑÑ +% Ð’Ñтречено недопуÑтимое объÑвление объекта (клаÑÑа), Ñ‚.е. объект или клаÑÑ, +% не имеющий методов и не унаÑледованный от другого объекта (клаÑÑа). +% Ðапример, объÑвление: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% вызовет Ñту ошибку. +parser_n_object_has_no_vmt=03023_N_Объект "$1" не имеет таблицы VMT +% Это заметка о том, что объÑвленный объект не имеет таблицы виртуальных методов (VMT). +parser_e_illegal_parameter_list=03024_E_Hевеpный ÑпиÑок паpаметpов +% Ð¤ÑƒÐ½ÐºÑ†Ð¸Ñ Ð²Ñ‹Ð·Ñ‹Ð²Ð°ÐµÑ‚ÑÑ Ñ Ð¿Ð°Ñ€Ð°Ð¼ÐµÑ‚Ñ€Ð°Ð¼Ð¸, тип которых отличаетÑÑ Ð¾Ñ‚ типов параметров, иÑпользованных +% при объÑвлении функции. +parser_e_wrong_parameter_size=03026_E_Ðеверное количеÑтво паpаметpов при вызове "$1" +% Ошибка в ÑпиÑке параметров вызываемой процедуры или функции, количеÑтво параметров неверно. +parser_e_overloaded_no_procedure=03027_E_Перегруженный идентификатоp "$1" не ÑвлÑетÑÑ Ñ„yнкцией +% КомпилÑтор обнаружил Ñимвол Ñ Ñ‚ÐµÐ¼ же именем, что и Ð¿ÐµÑ€ÐµÐ³Ñ€ÑƒÐ¶ÐµÐ½Ð½Ð°Ñ Ñ„ÑƒÐ½ÐºÑ†Ð¸Ñ, но не ÑвлÑющийÑÑ Ñ„ÑƒÐ½ÐºÑ†Ð¸ÐµÐ¹. +parser_e_overloaded_have_same_parameters=03028_E_Перегруженные Ñ„yнкции имеют одинаковый ÑпиÑок паpаметpов +% Попытка объÑÐ²Ð»ÐµÐ½Ð¸Ñ Ð¿ÐµÑ€ÐµÐ³Ñ€ÑƒÐ¶ÐµÐ½Ð½Ñ‹Ñ… функций Ñ Ð¾Ð´Ð½Ð¸Ð¼ и тем же ÑпиÑком параметров. +% Чтобы перегрузка была возможна, по крайней мере один из параметров должен отличатьÑÑ. +parser_e_header_dont_match_forward=03029_E_Заголовок Ñ„yнкции не ÑоответÑтвyет пpедыдyщемy объÑвлению "$1" +% ОбъÑвлена Ñ„ÑƒÐ½ÐºÑ†Ð¸Ñ Ñ Ñ‚ÐµÐ¼ же ÑпиÑком параметром, но отличающимÑÑ Ñ‚Ð¸Ð¿Ð¾Ð¼ результата либо модификатором. +parser_e_header_different_var_names=03030_E_Заголовок Ñ„yнкции "$1" не ÑоответÑтвyет пpедыдyщемy опpеделению в forward : изменÑетÑÑ Ð¸Ð¼Ñ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð¾Ð¹ $2 => $3 +% Ð¤ÑƒÐ½ÐºÑ†Ð¸Ñ Ð¾Ð±ÑŠÑвлена в Ñекции \var{interface} либо Ñ Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¸Ð²Ð¾Ð¹ +% \var{forward}, а затем определена Ñ Ð¾Ñ‚Ð»Ð¸Ñ‡Ð°ÑŽÑ‰Ð¸Ð¼ÑÑ ÑпиÑком параметров. +parser_n_duplicate_enum=03031_N_Ð—Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ Ð² перечиÑлÑемых типах должны быть возраÑтающими +% \fpc допуÑкает объÑвление перечиÑлений как в C. Из Ñледующих двух объÑвлений: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% Второе объÑвление вызовет Ñто Ñообщение. Значение \var{A\_UAS} должно быть больше, +% чем значение \var{A\_E}, Ñ‚.е. по крайней мере 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_With не может быть иÑпользован Ð´Ð»Ñ Ð¿Ðµpеменных из другого Ñегмента +% With ÑохранÑет переменную локально на Ñтеке, +% но Ñто невозможно, еÑли Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ð½Ð°Ñ…Ð¾Ð´Ð¸Ñ‚ÑÑ Ð² другом Ñегменте. +parser_e_too_much_lexlevel=03034_E_Уровень Ð²Ð»Ð¾Ð¶ÐµÐ½Ð¸Ñ Ñ„yнкций превышает 31 +% КоличеÑтво уровней Ð²Ð»Ð¾Ð¶ÐµÐ½Ð¸Ñ Ñ„ÑƒÐ½ÐºÑ†Ð¸Ð¹ ограничено 31. +parser_e_range_check_error=03035_E_Ошибка проверки диапазона пpи вычиÑлении конÑтант +% Значение конÑтант находитÑÑ Ð²Ð½Ðµ допуÑтимого Ð´Ð»Ñ Ð½Ð¸Ñ… диапазона. +parser_w_range_check_error=03036_W_Ошибка проверки диапазона пpи вычиÑлении конÑтант +% Значение конÑтант находитÑÑ Ð²Ð½Ðµ допуÑтимого Ð´Ð»Ñ Ð½Ð¸Ñ… диапазона. +parser_e_double_caselabel=03037_E_ПовтоpÑющаÑÑÑ Ð¼ÐµÑ‚ÐºÐ° CASE +% Одна и та же метка указана 2 раза в одном выражении \var{case}. +parser_e_case_lower_less_than_upper_bound=03038_E_ВеpхнÑÑ Ð³pаница диапазона case меньше, чем нижнÑÑ +% ВерхнÑÑ Ð³Ñ€Ð°Ð½Ð¸Ñ†Ð° метки \var{case} меньше нижней границы, поÑтому метка не имеет ÑмыÑла. +parser_e_type_const_not_possible=03039_E_Типизиpованные конÑтанты клаÑÑов и интерфейÑов не поддеpживаютÑÑ +% ОбъÑÐ²Ð»ÐµÐ½Ð¸Ñ ÐºÐ¾Ð½Ñтант, имеющих тип клаÑÑа либо интерфейÑа, не допуÑкаетÑÑ. +parser_e_no_overloaded_procvars=03040_E_Переменные перегруженных функций не поддеpживаютÑÑ +% ÐедопуÑÑ‚Ð¸Ð¼Ð°Ñ Ð¿Ð¾Ð¿Ñ‹Ñ‚ÐºÐ° приÑÐ²Ð¾ÐµÐ½Ð¸Ñ Ð¿ÐµÑ€ÐµÐ³Ñ€ÑƒÐ¶ÐµÐ½Ð½Ð¾Ð¹ функции процедурной переменной. +parser_e_invalid_string_size=03041_E_Длина ÑÑ‚pоки должна быть в диапазоне 1 .. 255 +% Длина Ñтроки типа shortstring ограничена 255 Ñимволами. Попытка объÑвить Ñтроку +% Ñ Ð´Ð»Ð¸Ð½Ð¾Ð¹ менее 1 или более 255. +parser_w_use_extended_syntax_for_objects=03042_W_ИÑпользуйте pаÑшиpенный ÑинтакÑÐ¸Ñ NEW и DISPOSE Ð´Ð»Ñ ÑÐ¾Ð·Ð´Ð°Ð½Ð¸Ñ ÑкземплÑров объектов +% При наличии ÑƒÐºÐ°Ð·Ð°Ñ‚ÐµÐ»Ñ \var{a} на тип клаÑÑа, вызов +% \var{new(a)} не проинициализирует клаÑÑ (Ñ‚.е. конÑтруктор не будет +% вызван), Ñ…Ð¾Ñ‚Ñ Ð¿Ð°Ð¼ÑÑ‚ÑŒ будет выделена. Следует иÑпользовать вызов +% \var{new(a,init)}, который выделит памÑÑ‚ÑŒ и вызовет конÑтруктор клаÑÑа. +parser_w_no_new_dispose_on_void_pointers=03043_W_ИÑпользование NEW и DISPOSE Ð´Ð»Ñ Ð½ÐµÑ‚Ð¸Ð¿Ð¸Ð·Ð¸pованных yказателей беÑÑмыÑленно +parser_e_no_new_dispose_on_void_pointers=03044_E_ИÑпользование NEW и DISPOSE Ð´Ð»Ñ Ð½ÐµÑ‚Ð¸Ð¿Ð¸Ð·Ð¸pованных yказателей невозможно +% Вызовы \var{new(p)} или \var{dispose(p)} невозможны, еÑли \var{p} ÑвлÑетÑÑ Ð½ÐµÑ‚Ð¸Ð¿Ð¸Ð·Ð¸Ñ€Ð¾Ð²Ð°Ð½Ð½Ñ‹Ð¼ указателем, +% Ñ‚.к. при Ñтом отÑутÑтвует Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ размере выделÑемой памÑти. +% ПринимаетÑÑ Ð´Ð»Ñ ÑовмеÑтимоÑти в режимах \var{tp} и \var{delphi}. +parser_e_class_id_expected=03045_E_ОжидаетÑÑ Ð¸Ð´ÐµÐ½Ñ‚Ð¸Ñ„Ð¸ÐºÐ°Ñ‚Ð¾p клаÑÑа +% ПроиÑходит при Ñканировании имени процедуры, Ñодержащего точку, Ñ‚.е. метода +% клаÑÑа или объекта, но тип перед точкой неизвеÑтен. +parser_e_no_type_not_allowed_here=03046_E_Идентификатоp типа здеÑÑŒ недопуÑтим +% Идентификатор типа не может быть иÑпользован в выражении. +parser_e_methode_id_expected=03047_E_ОжидаетÑÑ Ð¸Ð´ÐµÐ½Ñ‚Ð¸Ñ„Ð¸ÐºÐ°Ñ‚Ð¾p метода +% Идентификатор не ÑвлÑетÑÑ Ð¼ÐµÑ‚Ð¾Ð´Ð¾Ð¼. +% ПроиÑходит при Ñканировании имени процедуры, Ñодержащего точку, Ñ‚.е. метода +% клаÑÑа или объекта, но Ð¸Ð¼Ñ Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€Ñ‹ отÑутÑтвует в объÑвлении клаÑÑа. +parser_e_header_dont_match_any_member=03048_E_Заголовок Ñ„yнкции не ÑоответÑтвует ни одному из методов клаÑÑа "$1" +% Идентификатор не ÑвлÑетÑÑ Ð¼ÐµÑ‚Ð¾Ð´Ð¾Ð¼. +% ПроиÑходит при Ñканировании имени процедуры, Ñодержащего точку, Ñ‚.е. метода +% клаÑÑа или объекта, но Ð¸Ð¼Ñ Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€Ñ‹ отÑутÑтвует в объÑвлении клаÑÑа. +parser_d_procedure_start=03049_DL_Пpоцедypа/ФyÐ½ÐºÑ†Ð¸Ñ $1 +% При иÑпользовании ключа \var{-vd} компилÑтор Ñообщает о начале обработки +% тела процедуры или функции. +parser_e_error_in_real=03050_E_HевеpÐ½Ð°Ñ ÐºÐ¾Ð½Ñтанта Ñ Ð¿Ð»Ð°Ð²Ð°ÑŽÑ‰ÐµÐ¹ запÑтой +% КомпилÑтор ожидает выражение вещеÑтвенного типа, но получает что-то другое. +parser_e_fail_only_in_constructor=03051_E_FAIL допуÑтим только в конÑÑ‚pyктоpах +% ИнÑÑ‚Ñ€ÑƒÐºÑ†Ð¸Ñ \var{FAIL} иÑпользована вне метода конÑтруктора. +parser_e_no_paras_for_destructor=03052_E_ДеÑÑ‚pyктоpÑ‹ не могyÑ‚ иметь паpаметpов +% ДеÑтруктор объÑвлен Ñо ÑпиÑком параметров. Методы деÑтрукторов не могут иметь параметров. +% cannot have parameters. +parser_e_only_class_methods_via_class_ref=03053_E_По ÑÑылке на клаÑÑ Ð¼Ð¾Ð³ÑƒÑ‚ быть вызваны только клаÑÑ-методы +% Ошибка возникает в Ñледующей Ñитуации: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} не ÑвлÑетÑÑ ÐºÐ»Ð°ÑÑ-методом и поÑтому не может быть вызван по ÑÑылке на клаÑÑ. +parser_e_only_class_methods=03054_E_Ð’ клаÑÑ-методах доÑтупны только другие клаÑÑ-методы +% Имеет отношение к предыдущей ошибке. Из клаÑÑ-метода Ð½ÐµÐ»ÑŒÐ·Ñ Ð²Ñ‹Ð·Ð²Ð°Ñ‚ÑŒ обычный метод объекта. +% Следующий код приведет к Ñтой ошибке: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% ПоÑкольку free ÑвлÑетÑÑ Ð¾Ð±Ñ‹Ñ‡Ð½Ñ‹Ð¼ методом, его Ð½ÐµÐ»ÑŒÐ·Ñ Ð²Ñ‹Ð·Ð²Ð°Ñ‚ÑŒ из клаÑÑ-метода. +parser_e_case_mismatch=03055_E_Тип конÑтанты не Ñовпадает Ñ Ñ‚Ð¸Ð¿Ð¾Ð¼ выpÐ°Ð¶ÐµÐ½Ð¸Ñ CASE +% Одна из меток имеет тип, отличный от типа Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ case. +parser_e_illegal_symbol_exported=03056_E_Символ не может быть ÑкÑпортирован из библиотеки +% При напиÑании библиотеки можно ÑкÑпортировать только процедуры и функции. Такие типы, +% как переменные и конÑтанты, ÑкÑпортировать нельзÑ. +parser_w_should_use_override=03057_W_УнаÑледованный метод "$1" Ñкрыт, иÑпользуйте override +% Метод, объÑвленный в родительÑком клаÑÑе как \var{virtual}, должен быть +% перекрыт в клаÑÑе-наÑледнике директивой \var{override}. ЕÑли директива +% \var{override} не указана, унаÑледованный метод будет Ñкрыт, а не перекрыт. +parser_e_nothing_to_be_overridden=03058_E_Ð’ родительÑком клаÑÑе нет метода Ð´Ð»Ñ Ð¿ÐµpекрытиÑ: "$1" +% Попытка перекрыть \var{override} виртуальный метод, отÑутÑтвующий в родительÑком клаÑÑею. +parser_e_no_procedure_to_access_property=03059_E_Ðе указан ÑпоÑоб доÑтупа к ÑвойÑтву +% Ð”Ð»Ñ ÑвойÑтва не указана директива \var{read}. +parser_w_stored_not_implemented=03060_W_Директива stored Ð´Ð»Ñ ÑвойÑтв еще не pеализована +% Директива \var{stored} еще не реализована +parser_e_ill_property_access_sym=03061_E_Hевеpный Ñимвол Ð´Ð»Ñ Ð´Ð¾Ñтупа к ÑвойÑтвy +% Ошибка в директиве \var{read} или \var{write} Ð´Ð»Ñ ÑвойÑтва типа маÑÑив. +% ДоÑтуп к ÑвойÑтву типа маÑÑив возможен только Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ процедур и функций. +% Следующий код вызовет ошибку: +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_ДоÑтуп к protected полю объекта здеÑÑŒ невозможен +% ПолÑ, определенные в Ñекции \var{protected} объÑÐ²Ð»ÐµÐ½Ð¸Ñ ÐºÐ»Ð°ÑÑа, +% недоÑтупны вне модулÑ, в котором объÑвлен клаÑÑ, и вне методов объектов-наÑледников. +parser_e_cant_access_private_member=03063_E_ДоÑтуп к private полю объекта здеÑÑŒ невозможен +% ПолÑ, определенные в Ñекции \var{private} объÑÐ²Ð»ÐµÐ½Ð¸Ñ ÐºÐ»Ð°ÑÑа, +% недоÑтупны вне модулÑ, в котором объÑвлен клаÑÑ. +parser_e_overridden_methods_not_same_ret=03066_E_Перекрытые методы должны иметь одинаковый тип результата: "$2" перекрыт "$1", который возвращает другой тип +% Перекрытые методы должны возвращать результат одинакового типа. +parser_e_dont_nest_export=03067_E_ЭкÑпортируемые Ñ„yнкции не могyÑ‚ быть вложенными +% ÐÐµÐ»ÑŒÐ·Ñ Ð¾Ð±ÑŠÑвить процедуру или функцию, вложенную в процедуру или функцию, объÑвленную как ÑкÑпортируемаÑ. +parser_e_methods_dont_be_export=03068_E_Методы не могyÑ‚ ÑкÑпоpтиpоватьÑÑ +% Метод клаÑÑа или объекта не может быть объÑвлен как +% \var{export}. +parser_e_call_by_ref_without_typeconv=03069_E_Тип параметра no. $1 при передаче по ÑÑылке должен Ñовпадать: получено "$2", ожидалоÑÑŒ "$3" +% При вызове функции, имеющей параметры по ÑÑылке (\var{var}), тип параметра +% должен Ñтрого Ñовпадать Ñ Ð¾Ð±ÑŠÑвленным. ÐвтоматичеÑкое преобразование типов +% в Ñтом Ñлучае отÑутÑтвует. +parser_e_no_super_class=03070_E_КлаÑÑ Ð½Ðµ ÑвлÑетÑÑ Ñ€Ð¾Ð´Ð¸Ñ‚ÐµÐ»ÑŒÑким Ð´Ð»Ñ Ñ‚ÐµÐºÑƒÑ‰ÐµÐ³Ð¾ клаÑÑа +% При вызове унаÑледованного метода указан клаÑÑ, отличный от родительÑкого. +% УнаÑледованный метод можно вызывать только у родительÑкого клаÑÑа. +parser_e_self_not_in_method=03071_E_SELF допуÑтим только в методах +% Попытка иÑÐ¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ð½Ð¸Ñ Ð¿Ð°Ñ€Ð°Ð¼ÐµÑ‚Ñ€Ð° \var{self} вне метода объекта. +% Параметр \var{self} передаетÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ в методы. +parser_e_generic_methods_only_in_methods=03072_E_Вызов методов Ñ Ð¸Ð´ÐµÐ½Ñ‚Ð¸Ñ„Ð¸ÐºÐ°Ñ‚Ð¾Ñ€Ð¾Ð¼ типа клаÑÑа возможен только из других методов +% КонÑÑ‚Ñ€ÑƒÐºÑ†Ð¸Ñ Ð²Ð¸Ð´Ð° \var{sometype.somemethod} допуÑтима только внутри методов. +parser_e_illegal_colon_qualifier=03073_E_Hеверное иÑпользование ':' +% Формат \var{:} (двоеточие) 2 раза иÑпользуетÑÑ Ð½Ð° выражении, которое не ÑвлÑетÑÑ Ð²ÐµÑ‰ÐµÑтвенным. +parser_e_illegal_set_expr=03074_E_Ошибка проверки диапазона в конÑтрукторе множеÑтва или повторÑющийÑÑ Ñлемент множеÑтва +% Ошибка в объÑвлении множеÑтва. Либо один из Ñлементов выходит за допуÑтимый диапазон, +% либо какие-либо два Ñлемента имеют одно и то же значение. +parser_e_pointer_to_class_expected=03075_E_ОжидаетÑÑ yказатель на объект +% ИÑпользован неверный тип в выражении \var{New}. +% РаÑширенный ÑинтакÑÐ¸Ñ \var{New} требует параметра типа объект. +parser_e_expr_have_to_be_constructor_call=03076_E_Ð’Ñ‹pажение должно вызывать конÑÑ‚pyктоp +% При иÑпользовании раÑширенного ÑинтакÑиÑа \var{new} нужно указывать конÑтруктор объекта. +% Ð£ÐºÐ°Ð·Ð°Ð½Ð½Ð°Ñ Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€Ð° не ÑвлÑетÑÑ ÐºÐ¾Ð½Ñтруктором. +parser_e_expr_have_to_be_destructor_call=03077_E_Ð’Ñ‹pажение должно вызывать деÑÑ‚pyктоp +% При иÑпользовании раÑширенного ÑинтакÑиÑа \var{dispose} нужно указывать деÑтруктор объекта. +% Ð£ÐºÐ°Ð·Ð°Ð½Ð½Ð°Ñ Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€Ð° не ÑвлÑетÑÑ Ð´ÐµÑтруктором. +parser_e_invalid_record_const=03078_E_Hевеpный поpÑдок Ñлементов запиÑи +% При объÑвлении конÑтанты типа запиÑÑŒ, Ð¿Ð¾Ð»Ñ ÑƒÐºÐ°Ð·Ð°Ð½Ñ‹ в неверном порÑдке. +parser_e_false_with_expr=03079_E_Тип выpÐ°Ð¶ÐµÐ½Ð¸Ñ Ð´Ð¾Ð»Ð¶ÐµÐ½ быть CLASS или RECORD +% Ðргумент Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ \var{with} должен быть типа \var{record} или +% \var{class}. ИÑпользован аргумент Ñ Ñ‚Ð¸Ð¿Ð¾Ð¼, отличным от указанных. +parser_e_void_function=03080_E_Пpоцедypа не может возвpащать значение +% \fpc позволÑет указать возвращаемое значение Ð´Ð»Ñ Ñ„ÑƒÐ½ÐºÑ†Ð¸Ð¸ при иÑпользовании +% Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ \var{exit}. Ошибка возникает при попытке Ñделать Ñто в процедуре. +% Процедура не может возвращать значение. +parser_e_only_methods_allowed=03081_E_КонÑÑ‚pyктоpÑ‹, деÑÑ‚pyктоpÑ‹ и операторы клаÑÑа должны быть методами +% Попытка определить процедуру, не ÑвлÑющуюÑÑ Ð¼ÐµÑ‚Ð¾Ð´Ð¾Ð¼ клаÑÑа, как конÑтруктор, деÑтруктор или оператор клаÑÑа. +parser_e_operator_not_overloaded=03082_E_Опеpатоp не пеpегpyжен +% Попытка иÑпользовать перегруженный оператор, когда он не перегружен Ð´Ð»Ñ Ð´Ð°Ð½Ð½Ð¾Ð³Ð¾ типа. +parser_e_no_such_assignment=03083_E_Ðевозможно перегрузить приÑвоение Ð´Ð»Ñ Ð¾Ð´Ð¸Ð½Ð°ÐºÐ¾Ð²Ñ‹Ñ… типов +% Перегруженное приÑвоение невозможно Ð´Ð»Ñ Ñ‚Ð¸Ð¿Ð¾Ð², которые компилÑтор Ñчитает одинаковыми. +parser_e_overload_impossible=03084_E_Перегрузка оператора невозможна +% Сочетание оператора, аргументов и возвращаемого Ð·Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ ÑвлÑетÑÑ Ð½ÐµÑовмеÑтимым. +parser_e_no_reraise_possible=03085_E_Повторное броÑание иÑÐºÐ»ÑŽÑ‡ÐµÐ½Ð¸Ñ Ð·Ð´ÐµÑÑŒ невозможно +% Попытка повторного броÑÐ°Ð½Ð¸Ñ Ð¸ÑÐºÐ»ÑŽÑ‡ÐµÐ½Ð¸Ñ Ð² недопуÑтимом меÑте. Это разрешено делать только +% в блоке \var{except}. +parser_e_no_new_or_dispose_for_classes=03086_E_РаÑшиpенный ÑинтакÑÐ¸Ñ NEW и DISPOSE не разрешен Ð´Ð»Ñ ÐºÐ»Ð°ÑÑов +% ЭкземплÑÑ€ клаÑÑа не может быть Ñоздан Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ раÑширенного ÑинтакÑиÑа +% \var{new}, Ð´Ð»Ñ Ñтого Ñледует иÑпользовать конÑтруктор. Ðналогично, Ð´Ð»Ñ +% ÑƒÐ´Ð°Ð»ÐµÐ½Ð¸Ñ ÑкземплÑра клаÑÑа Ñледует иÑпользовать не \var{Dispose}, а деÑтруктор. +parser_e_procedure_overloading_is_off=03088_E_Перегрузка пpоцедyp отключена +% При иÑпользовании ключа \var{-So} перегрузка процедур отключена. +% Turbo Pascal не поддерживает перегрузку. +parser_e_overload_operator_failed=03089_E_Перегрузка Ñтого оператора невозможна. Перегружаемые операторы (еÑли еÑÑ‚ÑŒ): $1 +% Попытка перегрузить оператор, который не может быть перегружен. +% Следующие операторы могут быть перегружены: +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_Оператор ÑÑ€Ð°Ð²Ð½ÐµÐ½Ð¸Ñ Ð´Ð¾Ð»Ð¶ÐµÐ½ возвращать значение типа boolean +% При перегрузке оператора ÑÑ€Ð°Ð²Ð½ÐµÐ½Ð¸Ñ \var{=}, Ñ„ÑƒÐ½ÐºÑ†Ð¸Ñ Ð´Ð¾Ð»Ð¶Ð½Ð° возвращать значение типа boolean. +parser_e_only_virtual_methods_abstract=03091_E_Только виртуальные методы могут быть абÑтрактными +% Попытка определить абÑтрактный метод, не ÑвлÑющийÑÑ Ð¿Ñ€Ð¸ Ñтом виртуальным. +parser_f_unsupported_feature=03092_F_ИÑпользование пока неподдерживаемой оÑобенноÑти компилÑтора! +% Попытка заÑтавить компилÑтор Ñделать нечто, чего он пока еще не умеет. +parser_e_mix_of_classes_and_objects=03093_E_Смешивание различных типов объектов (class, object, interface) не допуÑкаетÑÑ +% Изменение базового типа при наÑледовании не допуÑкаетÑÑ. Это, в чаÑтноÑти, означает, что +% class не может быть порожден от object, и наоборот. +parser_w_unknown_proc_directive_ignored=03094_W_ÐеизвеÑÑ‚Ð½Ð°Ñ Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¸Ð²Ð° процедуры: "$1", игнорировано +% Ð£ÐºÐ°Ð·Ð°Ð½Ð½Ð°Ñ Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¸Ð²Ð° процедуры неизвеÑтна компилÑтору. +parser_e_absolute_only_one_var=03095_E_ABSOLUTE может быть указано только Ð´Ð»Ñ Ð¾Ð´Ð½Ð¾Ð¹ пеpеменной +% ÐÐµÐ»ÑŒÐ·Ñ ÑƒÐºÐ°Ð·Ñ‹Ð²Ð°Ñ‚ÑŒ более одной переменной перед директивой \var{absolute}. +% Ð¡Ð»ÐµÐ´ÑƒÑŽÑ‰Ð°Ñ ÐºÐ¾Ð½ÑÑ‚Ñ€ÑƒÐºÑ†Ð¸Ñ Ð¿Ñ€Ð¸Ð²ÐµÐ´ÐµÑ‚ к ошибке: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +parser_e_absolute_only_to_var_or_const=03096_E_ABSOLUTE может быть ÑвÑзана только Ñ Ð¿Ðµpеменной или конÑтантой +% ÐÐ´Ñ€ÐµÑ Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¸Ð²Ñ‹ \var{absolute} может указывать только на переменную или +% конÑтанту. Следующий код приведет к ошибке: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_initialized_only_one_var=03097_E_Ð˜Ð½Ð¸Ñ†Ð¸Ð°Ð»Ð¸Ð·Ð°Ñ†Ð¸Ñ Ð´Ð¾Ð¿ÑƒÑтима только Ð´Ð»Ñ Ð¾Ð´Ð½Ð¾Ð¹ переменной +% ÐедопуÑтимо указание начального Ð·Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ Ð±Ð¾Ð»ÐµÐµ чем Ð´Ð»Ñ Ð¾Ð´Ð½Ð¾Ð¹ переменной в +% ÑинтакÑиÑе Delphi. +parser_e_abstract_no_definition=03098_E_ÐбÑтрактные методы не могут иметь реализацию (тело) +% ÐбÑтрактные методы могут иметь только объÑвление, Ñ€ÐµÐ°Ð»Ð¸Ð·Ð°Ñ†Ð¸Ñ Ð´Ð»Ñ Ð½Ð¸Ñ… недопуÑтима. Они +% должны быть перекрыты в унаÑледованных клаÑÑах. +parser_e_overloaded_must_be_all_global=03099_E_Эта Ð¿ÐµÑ€ÐµÐ³Ñ€ÑƒÐ¶ÐµÐ½Ð½Ð°Ñ Ñ„ÑƒÐ½ÐºÑ†Ð¸Ñ Ð½Ðµ может быть локальной (должна ÑкÑпортироватьÑÑ) +% Попытка определить перегруженную функцию в Ñекции implementation модулÑ, +% Ð´Ð»Ñ ÐºÐ¾Ñ‚Ð¾Ñ€Ð¾Ð¹ отÑутÑтвует объÑвление в Ñекции interface. +parser_w_virtual_without_constructor=03100_W_Виртуальные методы иÑпользуютÑÑ Ð±ÐµÐ· конÑтруктора в "$1" +% При объÑвлении объекта или клаÑÑа, Ñодержащего виртуальные методы, Ð´Ð»Ñ +% их корректной инициализации требуетÑÑ ÐºÐ¾Ð½Ñтруктор. КомпилÑтор вÑтретил объÑвление +% клаÑÑа или объекта Ñ Ð²Ð¸Ñ€Ñ‚ÑƒÐ°Ð»ÑŒÐ½Ñ‹Ð¼Ð¸ методами, но без пары конÑтруктор/деÑтруктор. +parser_c_macro_defined=03101_CL_Опpеделен макpоÑ: $1 +% При иÑпользовании \var{-vc} компилÑтор Ñообщает об определении макроÑов. +parser_c_macro_undefined=03102_CL_Удалено определение макроÑа: $1 +% При иÑпользовании \var{-vc} компилÑтор Ñообщает о том, что Ð¼Ð°ÐºÑ€Ð¾Ñ Ð±Ð¾Ð»ÑŒÑˆÐµ не определен. +parser_c_macro_set_to=03103_CL_МакpÐ¾Ñ $1 yÑтановлен в $2 +% При иÑпользовании \var{-vc} компилÑтор Ñообщает об изменении Ð·Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ Ð¼Ð°ÐºÑ€Ð¾Ñа. +parser_i_compiling=03104_I_КомпилÑÑ†Ð¸Ñ $1 +% При включении информационных Ñообщений (\var{-vi}), компилÑтор Ñообщает о том, +% какие модули он компилирует. +parser_u_parsing_interface=03105_UL_Ðнализ интерфейÑа модyÐ»Ñ $1 +% Сообщает о начале разбора интерфейÑной чаÑти текущего модулÑ. +parser_u_parsing_implementation=03106_UL_Ðнализ реализации модyÐ»Ñ $1 +% Сообщает о начале разбора реализации текущего модулÑ, программы или библиотеки. +parser_d_compiling_second_time=03107_DL_ÐŸÐ¾Ð²Ñ‚Ð¾Ñ€Ð½Ð°Ñ ÐºÐ¾Ð¼Ð¿Ð¸Ð»ÑÑ†Ð¸Ñ $1 +% При включении отладочных Ñообщений (\var{-vd}) компилÑтор Ñообщает о том, +% какие модули он компилирует повторно. +parser_e_no_property_found_to_override=03109_E_ОтÑутÑтвует ÑвойÑтво Ð´Ð»Ñ Ð¿ÐµpеопpÐµÐ´ÐµÐ»ÐµÐ½Ð¸Ñ +% Попытка переопределить ÑвойÑтво родительÑкого клаÑÑа, при отÑутÑтвии такового в родительÑком клаÑÑе. +parser_e_only_one_default_property=03110_E_ДопуÑтимо только одно ÑвойÑтво по умолчанию +% СвойÑтво определено как \var{Default}, но родительÑкий клаÑÑ ÑƒÐ¶Ðµ имеет определенное таким же образом +% ÑвойÑтво. +parser_e_property_need_paras=03111_E_СвойÑтво по умолчанию должно иметь тип маÑÑива +% Только ÑвойÑтва типа маÑÑив могут быть объÑвлены как \var{default}. +parser_e_constructor_cannot_be_not_virtual=03112_E_ВиpÑ‚yальные конÑÑ‚pyктоpÑ‹ допуÑтимы только в клаÑÑах +% Виртуальные конÑтрукторы допуÑтимы только в клаÑÑах, их Ð½ÐµÐ»ÑŒÐ·Ñ +% объÑвлÑÑ‚ÑŒ в объектах. +parser_e_no_default_property_available=03113_E_ОтÑутÑтвует ÑвойÑтво по умолчанию +% Попытка доÑтупа к ÑвойÑтву по умолчанию клаÑÑа, который не имеет такого ÑвойÑтва. +parser_e_cant_have_published=03114_E_КлаÑÑ Ð½Ðµ может иметь PUBLISHED раздел, иÑпользyйте ключ {$M+} +% ЕÑли требуетÑÑ Ñ€Ð°Ð·Ð´ÐµÐ» \var{published} в объÑвлении клаÑÑа, Ñледует +% иÑпользовать ключ \var{\{\$M+\}}, который включает генерацию информации о типах. +parser_e_forward_declaration_must_be_resolved=03115_E_Раннее опpеделение клаÑÑа "$1" должно быть разрешено здеÑÑŒ, чтобы иÑпользовать его как предок +% Чтобы клаÑÑ Ð¼Ð¾Ð¶Ð½Ð¾ было иÑпользовать как предок, он должен быть Ñначала определен. +% Ошибка возникает в Ñледующей Ñитуации: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% Где \var{ParentClass} объÑвлен, но не определен. +parser_e_no_local_operator=03116_E_Локальные опеpатоpÑ‹ не поддеpживаютÑÑ +% Оператор Ð½ÐµÐ»ÑŒÐ·Ñ Ð¿ÐµÑ€ÐµÐ³Ñ€ÑƒÐ·Ð¸Ñ‚ÑŒ локально, Ñ‚.е. внутри Ð¾Ð¿Ñ€ÐµÐ´ÐµÐ»ÐµÐ½Ð¸Ñ Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€Ñ‹ или +% функции. +parser_e_proc_dir_not_allowed_in_interface=03117_E_Диpектива процедуры "$1" недопуÑтима в интерфейÑной чаÑти Ð¼Ð¾Ð´ÑƒÐ»Ñ +% Ð”Ð°Ð½Ð½Ð°Ñ Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¸Ð²Ð° не допуÑтима в Ñекции \var{interface} модулÑ. +% Ее можно иÑпользовать только в Ñекции \var{implementation}. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_Диpектива процедуры "$1" недопуÑтима в реализационной чаÑти Ð¼Ð¾Ð´ÑƒÐ»Ñ +% Ð”Ð°Ð½Ð½Ð°Ñ Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¸Ð²Ð° не допуÑтима в Ñекции \var{implementation} модулÑ. +% Ее можно иÑпользовать только в Ñекции \var{interface}. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_Диpектива процедуры "$1" недопуÑтима в объÑвлении процедурной переменной +% Ð”Ð°Ð½Ð½Ð°Ñ Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¸Ð²Ð° не может быть чаÑтью объÑÐ²Ð»ÐµÐ½Ð¸Ñ Ñ‚Ð¸Ð¿Ð° процедуры или функции. +parser_e_function_already_declared_public_forward=03120_E_Ð¤ÑƒÐ½ÐºÑ†Ð¸Ñ "$1" уже объÑвлена как PUBLIC или FORWARD +% Ошибка возникает при двукратном объÑвлении функции как \var{forward}. +% Или при объÑвлении ее в Ñекции \var{interface} и поÑледующем однократном объÑвлении как \var{forward} +% в Ñекции \var{implmentation}. +parser_e_not_external_and_export=03121_E_HÐµÐ»ÑŒÐ·Ñ Ð¸Ñпользовать EXPORT ÑовмеÑтно Ñ EXTERNAL +% Эти две директивы ÑвлÑÑŽÑ‚ÑÑ Ð²Ð·Ð°Ð¸Ð¼Ð¾Ð¸Ñключающими +parser_w_not_supported_for_inline=03123_W_"$1" не поддеpживаетÑÑ Ð²Ð½yÑ‚pи INLINE пpоцедypÑ‹/Ñ„yнкции +% Ð’Ñтраиваемые процедуры не поддерживают Ñтот тип объÑвлениÑ. +parser_w_inlining_disabled=03124_W_Ð’Ñтраивание (INLINE) отключено +% Ð’Ñтраивание процедур отключено. +parser_i_writing_browser_log=03125_I_ЗапиÑываем лог бpаyзеpа $1 +% Когда включены информационные ÑообщениÑ, компилÑтор Ñообщает +% о запиÑи данных Ð´Ð»Ñ Ð±Ñ€Ð°ÑƒÐ·ÐµÑ€Ð° (включаемого директивой \var{\{\$Y+ \}}). +parser_h_maybe_deref_caret_missing=03126_H_Возможно, пропущено pазыменование yÐºÐ°Ð·Ð°Ñ‚ÐµÐ»Ñ +% КомпилÑтор Ñчитает, что указатель может требовать разыменованиÑ. +parser_f_assembler_reader_not_supported=03127_F_Выбpанный тип аÑÑемблеpа не поддеpживаетÑÑ +% Выбранный тип аÑÑемблера (Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ \var{\{\$ASMMODE xxx\}}) не поддерживаетÑÑ. +% Поддержка того или иного аÑÑемблера может быть подключена при Ñборке компилÑтора. +parser_e_proc_dir_conflict=03128_E_Диpектива процедуры "$1" неÑовмеÑтима Ñ Ð´pyгими диpективами +% Ð£ÐºÐ°Ð·Ð°Ð½Ð½Ð°Ñ Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¸Ð²Ð° неÑовмеÑтима Ñ Ð´Ñ€ÑƒÐ³Ð¸Ð¼Ð¸ директивами. +% Ðапример, \var{cdecl} и \var{pascal} иÑключают друг друга. +parser_e_call_convention_dont_match_forward=03129_E_Тип вызова пpоцедypÑ‹/Ñ„yнкции не ÑоответÑтвует yказанномy ранее +% Ошибка проиÑходит при объÑвлении процедуры или функции, например, +% как \var{cdecl;} и пропуÑком Ñтой директивы при определении, или наоборот. +% Тип вызова ÑвлÑетÑÑ Ñ‡Ð°Ñтью объÑÐ²Ð»ÐµÐ½Ð¸Ñ Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€Ñ‹ и должен повторÑÑ‚ÑŒÑÑ +% при ее определении. +parser_e_property_cant_have_a_default_value=03131_E_СвойÑтво не может иметь значение по yмолчанию +% СвойÑтва типа множеÑтво или индекÑированные ÑвойÑтва не могут иметь значение по умолчанию. +parser_e_property_default_value_must_const=03132_E_Значение ÑвойÑтва по yмолчанию должно быть конÑтантой +% Значение ÑвойÑтва, объÑвленное как \var{default}, должно быть извеÑтно во Ð²Ñ€ÐµÐ¼Ñ ÐºÐ¾Ð¼Ð¿Ð¸Ð»Ñции. +% Ошибка проиÑходит, еÑли указано значение, извеÑтное только во Ð²Ñ€ÐµÐ¼Ñ Ð²Ñ‹Ð¿Ð¾Ð»Ð½ÐµÐ½Ð¸Ñ, например, Ð¸Ð¼Ñ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð¾Ð¹. +parser_e_cant_publish_that=03133_E_Символ не может быть PUBLISHED, здеÑÑŒ допуÑтим только клаÑÑ +% Только переменные типа клаÑÑа могут быть в \var{published} Ñекции объÑÐ²Ð»ÐµÐ½Ð¸Ñ ÐºÐ»Ð°ÑÑа, +% еÑли они не объÑвлены как ÑвойÑтво. +parser_e_cant_publish_that_property=03134_E_СвойÑтво Ñтого типа не может быть PUBLISHED +% СвойÑтва в \var{published} Ñекции не могут быть типа маÑÑив, они +% должны быть перенеÑены в Ñекцию public. СвойÑтва в Ñекции \var{published} +% могут быть перечиÑлÑемого, вещеÑтвенного, Ñтрокового типа либо множеÑтвами. +parser_e_empty_import_name=03136_E_ТребуетÑÑ Ð¸Ð¼Ñ Ð¸Ð¼Ð¿Ð¾Ñ€Ñ‚Ð° +% Ð”Ð»Ñ Ð½ÐµÐºÐ¾Ñ‚Ð¾Ñ€Ñ‹Ñ… платформ требуетÑÑ Ð¸Ð¼Ñ Ð¸Ð¼Ð¿Ð¾Ñ€Ñ‚Ð¸Ñ€ÑƒÐµÐ¼Ð¾Ð¹ процедуры или ÑƒÐºÐ°Ð·Ð°Ñ‚ÐµÐ»Ñ cdecl +parser_e_division_by_zero=03138_E_Деление на ноль +% Произошло деление на ноль. +parser_e_invalid_float_operation=03139_E_HепpÐ°Ð²Ð¸Ð»ÑŒÐ½Ð°Ñ Ð¾Ð¿ÐµpÐ°Ñ†Ð¸Ñ Ñ Ð¿Ð»Ð°Ð²Ð°ÑŽÑ‰ÐµÐ¹ запÑтой +% ÐžÐ¿ÐµÑ€Ð°Ñ†Ð¸Ñ Ð½Ð°Ð´ Ð´Ð²ÑƒÐ¼Ñ Ð²ÐµÑ‰ÐµÑтвенными чиÑлами вызвала переполнение или деление на ноль. +parser_e_array_lower_less_than_upper_bound=03140_E_ВеpхнÑÑ Ð³pаница диапазона меньше, чем нижнÑÑ +% ВерхнÑÑ Ð³Ñ€Ð°Ð½Ð¸Ñ†Ð° в объÑвлении маÑÑива меньше нижней границы, что недопуÑтимо. +parser_w_string_too_long=03141_W_Строка "$1" длиннее, чем "$2" +% Длина Ñтроковой конÑтанты превышает длину, указанную в объÑвлении типа Ñтроки. +parser_e_string_larger_array=03142_E_Длина Ñтроки превышает длину маÑÑива Ñимволов +% Длина Ñтроковой конÑтанты превышает размер, указанный в объÑвлении маÑÑива +% array[x..y] of char. +parser_e_ill_msg_expr=03143_E_Hевеpное выpажение поÑле диpективы message +% \fpc поддерживает только целочиÑленные и Ñтроковые Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ ÐºÐ°Ðº идентификаторы Ñообщений. +parser_e_ill_msg_param=03144_E_Обpаботчики Ñообщений принимают только один параметр по ÑÑылке +% Метод, объÑвленный Ñ Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¸Ð²Ð¾Ð¹ \var{message} как обработчик Ñообщений, +% может принимать только один параметр, который должен передаватьÑÑ Ð¿Ð¾ ÑÑылке. +% Параметр передаетÑÑ Ð¿Ð¾ ÑÑылке поÑредÑтвом директивы \var{var}. +parser_e_duplicate_message_label=03145_E_ПовтоpÐ½Ð°Ñ Ð¼ÐµÑ‚ÐºÐ° ÑообщениÑ: "$1" +% Одна и та же метка ÑÐ¾Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ Ð¸Ñпользована дважды в одном объекте/клаÑÑе. +parser_e_self_in_non_message_handler=03146_E_SELF может быть только как Ñвный параметр в обработчиках ÑÐ¾Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ +% Параметр self может быть только Ñвно передан в метод, объÑвленный как обработчик Ñообщений. +parser_e_threadvars_only_sg=03147_E_Пеpеменные threadvar могyÑ‚ быть только ÑтатичеÑкими или глобальными +% Переменные threadvar должны быть ÑтатичеÑкими или глобальными, их Ð½ÐµÐ»ÑŒÐ·Ñ Ð¾Ð±ÑŠÑвлÑÑ‚ÑŒ локально +% в процедуре. Локальные переменные процедуры вÑегда ÑвлÑÑŽÑ‚ÑÑ Ð»Ð¾ÐºÐ°Ð»ÑŒÐ½Ñ‹Ð¼Ð¸ Ð´Ð»Ñ Ð¿Ð¾Ñ‚Ð¾ÐºÐ°, +% потому что каждый поток имеет ÑобÑтвенный Ñтек, а локальные переменные хранÑÑ‚ÑÑ Ð½Ð° Ñтеке. +parser_f_direct_assembler_not_allowed=03148_F_Тип аÑÑемблеpа direct не поддеpживаетÑÑ Ð¿Ñ€Ð¸ двоичном фоpмате выходного файла +% Тип аÑÑемблера direct не может быть иÑпользован ÑовмеÑтно Ñ Ð´Ð²Ð¾Ð¸Ñ‡Ð½Ñ‹Ð¼ форматом выходных файлов, +% иÑпользуйте другой выходной формат или другой аÑÑемблер. +parser_w_no_objpas_use_mode=03149_W_Hе загpyжайте модуль OBJPAS вручную, иÑпользyйте {$mode objfpc} или {$mode delphi} +% Попытка загрузить модуль ObjPas вручную в Ñекции uses. Этот модуль предназначен Ð´Ð»Ñ +% автоматичеÑкой загрузки Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ директив \var{\{\$mode objfpc\}} или +% \var{\{\$mode delphi\}}. +parser_e_no_object_override=03150_E_OVERRIDE не может быть иÑпользовано в объектах +% Директива override не поддерживаетÑÑ Ð´Ð»Ñ Ð¾Ð±ÑŠÐµÐºÑ‚Ð¾Ð², Ð´Ð»Ñ Ð¿ÐµÑ€ÐµÐºÑ€Ñ‹Ñ‚Ð¸Ñ Ð¼ÐµÑ‚Ð¾Ð´Ð¾Ð² родительÑкого +% объекта Ñледует иÑпользовать \var{virtual}. +parser_e_cant_use_inittable_here=03151_E_Тип данных, Ñ‚pебующий инициализации/финализации, Ð½ÐµÐ»ÑŒÐ·Ñ Ð¸Ñпользовать в вариантных запиÑÑÑ… +% Ðекоторые типы данных (например, \var{ansistring}) требуют код инициализации/финализации, +% который неÑвно генерируетÑÑ ÐºÐ¾Ð¼Ð¸Ð¿Ð¸Ð»Ñтором. Такие типы данных не могут быть иÑпользованы +% в вариантной чаÑти запиÑей. +parser_e_resourcestring_only_sg=03152_E_Строки реÑурÑов могут быть только ÑтатичеÑкими или глобальными +% Строки реÑурÑов не могут быть объÑвлены на локальном уровне, только на уровне модулÑ. +parser_e_exit_with_argument_not__possible=03153_E_Процедура Exit Ñ Ð°Ñ€Ð³ÑƒÐ¼ÐµÐ½Ñ‚Ð¾Ð¼ здеÑÑŒ недопуÑтима +% Вызов exit Ñ Ð°Ñ€Ð³ÑƒÐ¼ÐµÐ½Ñ‚Ð¾Ð¼ Ð´Ð»Ñ Ð²Ð¾Ð·Ð²Ñ€Ð°Ñ‰Ð°ÐµÐ¼Ð¾Ð³Ð¾ Ð·Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ Ð½Ðµ может быть иÑпользован в Ñтом меÑте, +% в чаÑтноÑти, в блоках \var{try..except} или \var{try..finally}. +parser_e_stored_property_must_be_boolean=03154_E_Тип Ñимвола stored должен быть boolean +% ЕÑли в объÑвлении ÑвойÑтва иÑпользуетÑÑ Ñимвол stored, он должен иметь тип boolean. +parser_e_ill_property_storage_sym=03155_E_Этот Ñимвол недопуÑтим в качеÑтве stored +% Данный тип Ñимвола не может быть иÑпользован Ð´Ð»Ñ ÑƒÐºÐ°Ð·Ð°Ð½Ð¸Ñ Ð¿Ñ€Ð¸Ð·Ð½Ð°ÐºÐ° ÑÐ¾Ñ…Ñ€Ð°Ð½ÐµÐ½Ð¸Ñ ÑвойÑтв. +% ДопуÑтимо иÑпользовать методы, возвращающие boolean, Ð¿Ð¾Ð»Ñ Ñ‚Ð¸Ð¿Ð° boolean, +% либо конÑтанты Ñтого типа. +parser_e_only_publishable_classes_can_be_published=03156_E_Только клаÑÑÑ‹, Ñкомпилиpованные в режиме $M+, могут быть published +% Ð’ Ñекции published объÑÐ²Ð»ÐµÐ½Ð¸Ñ ÐºÐ»Ð°ÑÑа могут иÑпользоватьÑÑ Ð¿Ð¾Ð»Ñ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ типа клаÑÑа, +% который компилируетÑÑ Ð² режиме $M+ или унаÑледованный от такого клаÑÑа. Обычно +% иÑпользуютÑÑ Ð½Ð°Ñледники TPersitent. +parser_e_proc_directive_expected=03157_E_ОжидаетÑÑ Ð¿pоцедypÐ½Ð°Ñ Ð´Ð¸pектива +% Ошибка проиÑходит, еÑли в директиве \var{\{\$Calling\}} не указан тип вызова. +% Также проиÑходит, еÑли при объÑвлении процедур в блоке конÑтант иÑпользуетÑÑ ; поÑле +% объÑÐ²Ð»ÐµÐ½Ð¸Ñ Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€Ñ‹, поÑле чего должна Ñледовать Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€Ð½Ð°Ñ Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¸Ð²Ð°. +% Примеры правильных объÑвлений: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_Значение индекÑа ÑвойÑтва должно быть порÑдкового типа +% Значение, иÑпольуземое как Ð¸Ð½Ð´ÐµÐºÑ ÑвойÑтва, должно быть порÑдкового типа, например, +% целым чиÑлом или перечиÑлением. +parser_e_procname_to_short_for_export=03159_E_Ð˜Ð¼Ñ Ð¿pоцедypÑ‹ Ñлишком коpоткое Ð´Ð»Ñ ÑкÑпоpта +% Длина ÑкÑпортного имени процедуры/функции должна ÑоÑтавлÑÑ‚ÑŒ по крайней мере 2 Ñимвола. +% Это обуÑловлено ошибкой в утилите dlltool, ÐºÐ¾Ñ‚Ð¾Ñ€Ð°Ñ Ð½Ðµ может корректно прочитать .def файл +% Ñ Ð´Ð»Ð¸Ð½Ð¾Ð¹ имен, равной 1. +parser_e_dlltool_unit_var_problem=03160_E_Ðевозможно Ñоздать запиÑÑŒ DEFFILE Ð´Ð»Ñ Ð³Ð»Ð¾Ð±Ð°Ð»ÑŒÐ½Ñ‹Ñ… переменных Ð¼Ð¾Ð´ÑƒÐ»Ñ +parser_e_dlltool_unit_var_problem2=03161_E_Компилируйте без ключа -WD +% Этот файл необходимо компилировать без ÑƒÐºÐ°Ð·Ð°Ð½Ð¸Ñ ÐºÐ»ÑŽÑ‡Ð° -WD в командной Ñтроке. +parser_f_need_objfpc_or_delphi_mode=03162_F_Ð”Ð»Ñ Ñтого Ð¼Ð¾Ð´ÑƒÐ»Ñ Ð½ÐµÐ¾Ð±Ñ…Ð¾Ð´Ð¸Ð¼ режим ObjFpc (-S2) или Delphi (-Sd) +% Ð”Ð»Ñ ÐºÐ¾Ð¼Ð¿Ð¸Ð»Ñции данного Ð¼Ð¾Ð´ÑƒÐ»Ñ Ñ‚Ñ€ÐµÐ±ÑƒÐµÑ‚ÑÑ {$mode objfpc} or {$mode delphi}, +% либо иÑпользование аналогичных ключей командной Ñтроки -S2 или -Sd. +parser_e_no_export_with_index_for_target=03163_E_ЭкÑпоpÑ‚ по индекÑу невозможен под $1 +% ЭкÑпорт процедур/функций Ñ ÑƒÐºÐ°Ð·Ð°Ð½Ð¸ÐµÐ¼ индекÑа не поддерживаетÑÑ Ð´Ð»Ñ Ð¿Ð»Ð°Ñ‚Ñ„Ð¾Ñ€Ð¼Ñ‹ назначениÑ. +parser_e_no_export_of_variables_for_target=03164_E_ЭкÑпоpÑ‚ пеpеменных не поддеpживаетÑÑ Ð¿Ð¾Ð´ $1 +% ЭкÑпорт переменных не поддерживаетÑÑ Ð´Ð»Ñ Ð¿Ð»Ð°Ñ‚Ñ„Ð¾Ñ€Ð¼Ñ‹ назначениÑ. +parser_e_improper_guid_syntax=03165_E_Ðеверный ÑинтакÑÐ¸Ñ GUID +% Ошибка в ÑинтакÑиÑе GUID. Корректный GUID должен быть в форме +% \begin{verbatim} +% {XXXXXXXX-XXXX-XXXX-XXXX-XXXXXXXXXXXX} +% \end{verbatim} +% Где каждый \var{X} предÑтавлÑет Ñобой шеÑтнадцатеричную цифру. +parser_w_interface_mapping_notfound=03168_W_Ðе найдена процедура Ñ Ð¸Ð¼ÐµÐ½ÐµÐ¼ "$1", подходÑÑ‰Ð°Ñ Ð´Ð»Ñ Ñ€ÐµÐ°Ð»Ð¸Ð·Ð°Ñ†Ð¸Ð¸ $2.$3 +% КомпилÑтор не может найти процедуру, подходÑщую Ð´Ð»Ñ Ñ€ÐµÐ°Ð»Ð¸Ð·Ð°Ñ†Ð¸Ð¸ указанного метода интерфейÑа. +% Процедура Ñ Ñовпадающим именем найдена, но не Ñовпадает ÑпиÑок параметров. +parser_e_interface_id_expected=03169_E_ОжидаетÑÑ Ð¸Ð´ÐµÐ½Ñ‚Ð¸Ñ„Ð¸ÐºÐ°Ñ‚Ð¾Ñ€ интерфейÑа +% ПроиÑходит при анализе объÑÐ²Ð»ÐµÐ½Ð¸Ñ \var{class}, которое Ñодержит +% опиÑание ÑоответÑÑ‚Ð²Ð¸Ñ Ð¼ÐµÑ‚Ð¾Ð´Ð¾Ð² \var{interface} по имени, например: +% \begin{verbatim} +% type +% TMyObject = class(TObject, IDispatch) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% и Ð¸Ð¼Ñ \var{interface} перед точкой не перечиÑлено в ÑпиÑке наÑледованиÑ. +parser_e_type_cant_be_used_in_array_index=03170_E_Тип "$1" не может иÑпользоватьÑÑ ÐºÐ°Ðº Ð¸Ð½Ð´ÐµÐºÑ Ð¼Ð°ÑÑива +% Такие типы, как \var{qword} или \var{int64}, недопуÑтимы в качеÑтве индекÑов маÑÑива +parser_e_no_con_des_in_interfaces=03171_E_Constructor и destructor недопуÑтимы в interface +% ИÑпользование конÑтрукторов и деÑтрукторов в интерфейÑах не разрешаетÑÑ. +% Ð’ большинÑтве Ñлучаев Ð´Ð»Ñ ÑÐ¾Ð·Ð´Ð°Ð½Ð¸Ñ ÑкземплÑров интерфейÑа может быть иÑпользован метод +% \var{QueryInterface} интерфейÑа \var{IUnknown}. +parser_e_no_access_specifier_in_interfaces=03172_E_Указание типа доÑтупа недопуÑтимо в interface +% Тип доÑтупа \var{public}, \var{private}, \var{protected} и +% \var{pusblished} не может быть указан Ð´Ð»Ñ Ð¼ÐµÑ‚Ð¾Ð´Ð¾Ð² интерфейÑа. +% Ð’Ñе методы интферфейÑа ÑвлÑÑŽÑ‚ÑÑ Ð¾Ð±Ñ‰ÐµÐ´Ð¾Ñтупными (public). +parser_e_no_vars_in_interfaces=03173_E_Interface не может Ñодержать Ð¿Ð¾Ð»Ñ +% ОбъÑвление полей в интерфейÑе не допуÑкаетÑÑ. Ð˜Ð½Ñ‚ÐµÑ€Ñ„ÐµÐ¹Ñ Ð¼Ð¾Ð¶ÐµÑ‚ +% Ñодержать только методы. +parser_e_no_local_proc_external=03174_E_Ð›Ð¾ÐºÐ°Ð»ÑŒÐ½Ð°Ñ Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€Ð° не может быть EXTERNAL +% ОбъÑвление локальных процедур как external невозможно. Локальные процедуры +% получают Ñкрытые параметры, что делает вероÑтноÑÑ‚ÑŒ ошибок очень выÑокой. +parser_w_skipped_fields_before=03175_W_Ðекоторые Ð¿Ð¾Ð»Ñ Ð¿ÐµÑ€ÐµÐ´ "$1" не были инициализированы +% Ð’ режиме Delphi, Ð¸Ð½Ð¸Ñ†Ð¸Ð°Ð»Ð¸Ð·Ð°Ñ†Ð¸Ñ Ð½ÐµÐºÐ¾Ñ‚Ð¾Ñ€Ñ‹Ñ… полей конÑтант типа запиÑÑŒ может быть пропущена, +% но компилÑтор предупреждает о наличии такой Ñитуации. +parser_e_skipped_fields_before=03176_E_Ðекоторые Ð¿Ð¾Ð»Ñ Ð¿ÐµÑ€ÐµÐ´ "$1" не были инициализированы +% Ð’ режимах, отличных от Delphi, не допуÑкаетÑÑ Ð¾ÑтавлÑÑ‚ÑŒ неинициализированные Ð¿Ð¾Ð»Ñ +% в Ñередине конÑтанты типа запиÑÑŒ. +parser_w_skipped_fields_after=03177_W_Ðекоторые Ð¿Ð¾Ð»Ñ Ð¿Ð¾Ñле "$1" не были инициализированы +% ÐŸÐ¾Ð»Ñ Ð² конце конÑтанты типа запиÑÑŒ могут быть оÑтавлены без инициализации +% (компилÑтор автоматичеÑки инициализирует их нулевыми значениÑми). Это +% может ÑвлÑÑ‚ÑŒÑÑ Ð¿Ñ€Ð¸Ñ‡Ð¸Ð½Ð¾Ð¹ некоторых проблем. +parser_e_varargs_need_cdecl_and_external=03178_E_Директива VarArgs (или '...' в MacPas) без CDecl/CPPDecl/MWPascal и External +% Директива varargs (или параметр ``...'' в режиме MacPas) может быть иÑпользована только Ñ +% процедурами/функциÑми, объÑвленными Ñ Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¸Ð²Ð°Ð¼Ð¸ \var{external} и одной из \var{cdecl}, +% \var{cppdecl} или \var{mwpascal}. Эта функциональноÑÑ‚ÑŒ поддерживаетÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ Ð´Ð»Ñ +% ÑовмеÑтимоÑти Ñ Ñ„ÑƒÐ½ÐºÑ†Ð¸Ñми Ñзыка C типа printf. +parser_e_self_call_by_value=03179_E_Self должен быть параметром Ñ Ð¿ÐµÑ€ÐµÐ´Ð°Ñ‡ÐµÐ¹ по значению +% Параметр Self не может быть передан по ÑÑылке (Ñ var или const), его нужно передавать по +% значению +parser_e_interface_has_no_guid=03180_E_Ð˜Ð½Ñ‚ÐµÑ€Ñ„ÐµÐ¹Ñ "$1" не имеет идентификатора +% При приÑвоении интерфейÑа конÑтанте, Ð¸Ð½Ñ‚ÐµÑ€Ñ„ÐµÐ¹Ñ Ð´Ð¾Ð»Ð¶ÐµÐ½ иметь значение GUID. +parser_e_illegal_field_or_method=03181_E_ÐеизвеÑтный идентификатор Ð¿Ð¾Ð»Ñ Ð¸Ð»Ð¸ метода "$1" +% СвойÑтва должны ÑÑылатьÑÑ Ð½Ð° Ð¿Ð¾Ð»Ñ Ð¸ методы того же клаÑÑа, в котором объÑвлены. +parser_w_proc_overriding_calling=03182_W_Тип вызова "$2" перекрывает "$1" +% Ð’ объÑвлении процедуры приÑутÑтвуют две директивы, определÑющие тип вызова. +% Будет иÑпользована поÑледнÑÑ Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¸Ð²Ð°. +parser_e_no_procvarobj_const=03183_E_КонÑтанта типа "procedure of object" может быть инициализирована только значением NIL +% ÐÐ´Ñ€ÐµÑ Ð¼ÐµÑ‚Ð¾Ð´Ð° не может быть иÑпользован Ð´Ð»Ñ Ð¸Ð½Ð¸Ñ†Ð¸Ð°Ð»Ð¸Ð·Ð°Ñ†Ð¸Ð¸ типизированной конÑтанты типа +% 'procedure of object', потому что Ñ‚Ð°ÐºÐ°Ñ ÐºÐ¾Ð½Ñтанта ÑоÑтоит из двух адреÑов: +% Ð°Ð´Ñ€ÐµÑ Ð¼ÐµÑ‚Ð¾Ð´Ð° (извеÑтный во Ð²Ñ€ÐµÐ¼Ñ ÐºÐ¾Ð¼Ð¿Ð¸Ð»Ñции) и Ð°Ð´Ñ€ÐµÑ ÑкземплÑра объекта или +% клаÑÑа (не может быть определен при компилÑции). +parser_e_default_value_only_one_para=03184_E_Значение по умолчанию может быть приÑвоено только одному параметру +% Ðевозможно приÑвоить значение по умолчанию Ñразу неÑкольким параметрам. +% Следующий код неверен: +% \begin{verbatim} +% Procedure MyProcedure (A,B : Integer = 0); +% \end{verbatim} +% ВмеÑто Ñто Ñледует объÑвить процедуру как: +% \begin{verbatim} +% Procedure MyProcedure (A : Integer = 0; B : Integer = 0); +% \end{verbatim} +parser_e_default_value_expected_for_para=03185_E_Ð”Ð»Ñ "$1" требуетÑÑ Ð·Ð½Ð°Ñ‡ÐµÐ½Ð¸Ðµ по умолчанию +% Указанный параметр требует значение по умолчанию. +parser_w_unsupported_feature=03186_W_ИÑпользование пока неподдерживаемой оÑобенноÑти компилÑтора! +% Попытка заÑтавить компилÑтор Ñделать нечто, чего он пока еще не умеет. +parser_h_c_arrays_are_references=03187_H_МаÑÑивы C передаютÑÑ Ð¿Ð¾ ÑÑылке +% Передача маÑÑивов в функции на Ñзыке C вÑегда +% оÑущеÑтвлÑетÑÑ Ð¿Ð¾ÑредÑтвом ÑƒÐºÐ°Ð·Ð°Ñ‚ÐµÐ»Ñ (Ñ‚.е. по ÑÑылке). +parser_e_C_array_of_const_must_be_last=03188_E_МаÑÑив конÑтант в C должен быть поÑледним параметром +% ÐÐµÐ»ÑŒÐ·Ñ Ð´Ð¾Ð±Ð°Ð²Ð»ÑÑ‚ÑŒ другие параметры поÑле параметра типа \var{array of const}, +% передаваемого в функцию, объÑвленную как \var{cdecl}, потому что Ð´Ð»Ñ Ð½ÐµÐ³Ð¾ +% заранее не извеÑтен размер данных, помещаемых на Ñтек. +parser_h_type_redef=03189_H_Повторное объÑвление типа "$1" +% Сообщает о том, что Ð´Ð»Ñ Ñ€Ð°Ð½ÐµÐµ определенного типа вÑтретилоÑÑŒ +% повторное отличающееÑÑ Ð¾Ð±ÑŠÑвление. Это может быть (а может и не быть) +% причиной ошибок. +parser_w_cdecl_has_no_high=03190_W_Функции cdecl не имеют параметра high +% Ð’ функции, объÑвленные как cdecl, не передаетÑÑ Ñкрытый параметр high. +parser_w_cdecl_no_openstring=03191_W_Функции cdecl не поддерживают открытые Ñтроки +% Строки типа openstring не поддерживаютÑÑ Ð² cdecl функциÑÑ…. +parser_e_initialized_not_for_threadvar=03192_E_Ð˜Ð½Ð¸Ñ†Ð¸Ð°Ð»Ð¸Ð·Ð°Ñ†Ð¸Ñ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð¾Ð¹ типа threadvar невозможна +% Переменные, объÑвленные как threadvar, не могут иметь начального значениÑ. +% Они вÑегда получают нулевое значение при Ñтарте нового потока. +parser_e_msg_only_for_classes=03193_E_Директива message разрешена только Ð´Ð»Ñ ÐºÐ»Ð°ÑÑов +% Директива message поддерживаетÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ Ð´Ð»Ñ Ñ‚Ð¸Ð¿Ð¾Ð² Class. +parser_e_procedure_or_function_expected=03194_E_ОжидаетÑÑ "procedure" или "function" +% КлаÑÑ-методами могут быть только процедуры и функции. +parser_e_illegal_calling_convention=03195_W_Тип вызова игнорирован: "$1" +% Ðекоторые типы вызовов поддерживаютÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ на определенных процеÑÑорах. Так, Ð´Ð»Ñ Ð±Ð¾Ð»ÑŒÑˆÐ¸Ð½Ñтва +% не-i386 поддерживаютÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ типы вызова Ñтандартного ABI. +parser_e_no_object_reintroduce=03196_E_REINTRODUCE Ð½ÐµÐ»ÑŒÐ·Ñ Ð¸Ñпользовать Ð´Ð»Ñ Ð¾Ð±ÑŠÐµÐºÑ‚Ð¾Ð² +% Директива \var{reintroduce} не поддерживаетÑÑ Ð´Ð»Ñ Ð¾Ð±ÑŠÐµÐºÑ‚Ð¾Ð². +parser_e_paraloc_only_one_para=03197_E_РаÑположение аргументов не может Ñовпадать +% ЕÑли раÑположение аргументов указываютÑÑ Ñвно, как того требуют некоторые +% типы вызовов syscall, раÑположение каждого из аргументов должно быть уникальным, +% конÑтрукции вида \var{procedure p(i,j : longint 'r1');} не допуÑкаютÑÑ. +parser_e_paraloc_all_paras=03198_E_Ðужно указать раÑположение Ð´Ð»Ñ Ð²Ñех аргументов +% ЕÑли раÑположение указано Ð´Ð»Ñ Ð¾Ð´Ð½Ð¾Ð³Ð¾ аргументов, его нужно указать и Ð´Ð»Ñ Ð²Ñех +% оÑтальных. +parser_e_illegal_explicit_paraloc=03199_E_ÐеизвеÑтное раÑположение аргумента +% Указанное раÑположение не ÑвлÑетÑÑ Ð´Ð¾Ð¿ÑƒÑтимым Ñ Ñ‚Ð¾Ñ‡ÐºÐ¸ Ð·Ñ€ÐµÐ½Ð¸Ñ ÐºÐ¾Ð¼Ð¿Ð¸Ð»Ñтора. +parser_e_32bitint_or_pointer_variable_expected=03200_E_ОжидаетÑÑ 32-битное целое либо указатель +% libbase Ð´Ð»Ñ MorphOS/AmigaOS можно задавать только как \var{longint}, \var{dword}, либо указатель +% любого типа. +parser_e_goto_outside_proc=03201_E_Ðе допуÑкаетÑÑ goto между различными процедурами +% Ðе допуÑкаетÑÑ Ð¸Ñпользование \var{goto} Ð´Ð»Ñ Ð¿ÐµÑ€ÐµÑ…Ð¾Ð´Ð° на метку, определенную вне +% текущей процедуры. Следующий пример демонÑтрирует проблему: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1; +% +% procedure p2; +% begin +% goto l1; // Эта инÑÑ‚Ñ€ÑƒÐºÑ†Ð¸Ñ goto не разрешаетÑÑ +% end; +% +% begin +% p2 +% l1: +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_Слишком ÑÐ»Ð¾Ð¶Ð½Ð°Ñ Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€Ð°, не хватает региÑтров +% Тело процедуры ÑвлÑетÑÑ Ñлишком Ñложным Ð´Ð»Ñ ÐºÐ¾Ð¼Ð¿Ð¸Ð»Ñции. Следует разбить ее +% на неÑколько более проÑÑ‚Ñ‹Ñ… процедур. +parser_e_illegal_expression=03203_E_ÐедопуÑтимое выражение +% Может возникать по разным причинам. Ðаиболее чаÑто - при вычиÑлении +% конÑтантных выражений. +parser_e_invalid_integer=03204_E_Ðеверное целочиÑленное выражение +% Выражение не ÑвлÑетÑÑ Ñ†ÐµÐ»Ñ‹Ð¼ чиÑлом, в то Ð²Ñ€ÐµÐ¼Ñ ÐºÐ°Ðº компилÑтор ожидает +% именно целочиÑленный результат. +parser_e_invalid_qualifier=03205_E_Ðеверный квалификатор +% ПроиÑходит по одной из Ñледующих причин: +% \begin{itemize} +% \item Попытка доÑтупа к полю переменной, ÐºÐ¾Ñ‚Ð¾Ñ€Ð°Ñ Ð½Ðµ ÑвлÑетÑÑ Ð·Ð°Ð¿Ð¸Ñью. +% \item Указание индекÑа Ð´Ð»Ñ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð¾Ð¹, не ÑвлÑющейÑÑ Ð¼Ð°ÑÑивом. +% \item Разыменование переменной, не ÑвлÑющейÑÑ ÑƒÐºÐ°Ð·Ð°Ñ‚ÐµÐ»ÐµÐ¼. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_Верхний предел диапазона < нижнего +% При объÑвлении поддиапазона, нижний предел оказалÑÑ Ð±Ð¾Ð»ÑŒÑˆÐµ +% верхнего. +parser_e_macpas_exit_wrong_param=03207_E_Параметр Exit должен быть именем текущей процедуры +% Ðе-локальный exit не допуÑкаетÑÑ. Эта ошибка возникает только в режиме MacPas. +parser_e_illegal_assignment_to_count_var=03208_E_Ðеверное приÑвоение переменной for-цикла "$1" +% Тип переменной Ð´Ð»Ñ Ñ†Ð¸ÐºÐ»Ð° \var{for} должен быть порÑдковым. +% ВещеÑтвенные и Ñтроковые типы не допуÑкаютÑÑ. Кроме того, не допуÑкаетÑÑ Ð¿Ñ€Ð¸Ñвоение +% управлÑющей переменной внутри цикла (кроме режимов Delphi и TP). ЕÑли требуетÑÑ +% приÑвоение, вмеÑто цикла for Ñледует иÑпользовать предназначенные Ð´Ð»Ñ Ñтого +% циклы while или repeat. +parser_e_no_local_var_external=03209_E_Ð›Ð¾ÐºÐ°Ð»ÑŒÐ½Ð°Ñ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ð½Ðµ может быть EXTERNAL +% ОбъÑвление локальных переменных как внешних не допуÑкаетÑÑ. Внешними могут быть +% только глобальные переменные. +parser_e_proc_already_external=03210_E_Процедура уже объÑвлена как EXTERNAL +% Процедура уже объÑвлена Ñ Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¸Ð²Ð¾Ð¹ EXTERNAL в интерфейÑе Ð¼Ð¾Ð´ÑƒÐ»Ñ Ð¸Ð»Ð¸ +% в раннем объÑвлении. +parser_w_implicit_uses_of_variants_unit=03211_W_ÐеÑвное иÑпользование Ð¼Ð¾Ð´ÑƒÐ»Ñ Variants +% Ð’ модуле иÑпользуетÑÑ Ñ‚Ð¸Ð¿ Variant, но модуль Variants не подключен ни к одному из иÑпользуемых +% модулей. КомпилÑтор неÑвно добавлÑет Variants в ÑпиÑок иÑпользуемых модулей. +% Чтобы избавитьÑÑ Ð¾Ñ‚ предупреждениÑ, добавьте Variants в ÑпиÑок uses. +parser_e_no_static_method_in_interfaces=03212_E_Методы class and static не допуÑкаютÑÑ Ð² INTERFACE +% Спецификатор \var{class} и директива \var{static} не применимы в интерфейÑах, +% Ñ‚.к. вÑе методы интерфейÑа должны быть публичными. +parser_e_arithmetic_operation_overflow=03213_E_Переполнение в арифметичеÑкой операции +% ÐžÐ¿ÐµÑ€Ð°Ñ†Ð¸Ñ Ð½Ð°Ð´ целыми чиÑлами привела к переполнению +parser_e_protected_or_private_expected=03214_E_ОжидаетÑÑ "protected" или "private" +% \var{strict} может иÑпользоватьÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ в Ñочетании Ñ \var{protected} или \var{private}. +parser_e_illegal_slice=03215_E_SLICE Ð½ÐµÐ»ÑŒÐ·Ñ Ð¸Ñпользовать вне ÑпиÑка параметров +% \var{slice} можно иÑпользовать только Ð´Ð»Ñ Ð°Ñ€Ð³ÑƒÐ¼ÐµÐ½Ñ‚Ð¾Ð², принимающих тип открытого маÑÑива +parser_e_dispinterface_cant_have_parent=03216_E_DISPINTERFACE не может иметь Ñ€Ð¾Ð´Ð¸Ñ‚ÐµÐ»Ñ +% DISPINTERFACE ÑвлÑетÑÑ Ð¾Ñобым типом интерфейÑа и не может иметь родительÑкий клаÑÑ +parser_e_dispinterface_needs_a_guid=03217_E_Ð”Ð»Ñ DISPINTERFACE требуетÑÑ GUID +% DISPINTERFACE вÑегда требует идентификации Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ GUID +parser_w_overridden_methods_not_same_ret=03218_W_Перекрытые методы должны иметь одинаковый тип результата. Этот код иÑпользует ошибку в парÑере Delphi и будет работать непредÑказуемо ("$2" перекрыто "$1", имеющим другой тип результата) +% Перекрытые методы должны возвращать один и тот же тип результата. +% Ðекоторые верÑии Delphi позволÑÑŽÑ‚ изменÑÑ‚ÑŒ типы результата и даже превращать +% процедуры в функции, но работоÑпоÑобноÑÑ‚ÑŒ полученного кода завиÑит от +% иÑпользованных типов и ÑпоÑоба вызова методов. +parser_e_dispid_must_be_ord_const=03219_E_Dispatch ID должны быть порÑдковыми конÑтантами +% За ключевым Ñловом \var{dispid} должна Ñледовать порÑÐ´ÐºÐ¾Ð²Ð°Ñ ÐºÐ¾Ð½Ñтанта (индекÑ). +parser_e_array_range_out_of_bounds=03220_E_Диапазон маÑÑива Ñлишком велик +% ÐезавиÑимо от количеÑтва памÑти, занимаемой Ñлементами, маÑÑивы не могут Ñодержать +% больше чем high(ptrint) Ñлементов. Кроме того, тип диапазона должен быть поддиапазоном +% типа ptrint. +parser_e_packed_element_no_var_addr=03221_E_ÐÐµÐ»ÑŒÐ·Ñ Ð²Ð·ÑÑ‚ÑŒ Ð°Ð´Ñ€ÐµÑ Ñлементов/полей побитно-упакованных маÑÑивов/запиÑей +% ÐŸÐ¾Ð»Ñ Ð·Ð°Ð¿Ð¸Ñи или Ñлементы маÑÑива, объÑвленных как \var{packed} в режиме Mac Pascal (либо как +% \var{packed} в любом режиме при уÑловии \var{\{\$bitpacking on\}}), будут упакованы на уровне +% бит. Это означает невозможноÑÑ‚ÑŒ Ð¿Ð¾Ð»ÑƒÑ‡ÐµÐ½Ð¸Ñ Ð°Ð´Ñ€ÐµÑов отдельных Ñлементов маÑÑива или полей запиÑи. +% ИÑключением из Ñтого правила ÑвлÑÑŽÑ‚ÑÑ ÑƒÐ¿Ð°ÐºÐ¾Ð²Ð°Ð½Ð½Ñ‹Ðµ маÑÑивы, размер Ñлементов которых кратен 8 битам. +parser_e_packed_dynamic_open_array=03222_E_ДинамичеÑкие маÑÑивы не могут быть упакованными +% Упакованными могут быть только обычные (и, возможно, в будущем также открытые) маÑÑивы. +parser_e_packed_element_no_loop=03223_E_Элементы/Ð¿Ð¾Ð»Ñ Ð¿Ð¾Ð±Ð¸Ñ‚Ð½Ð¾-упакованных маÑÑивов/запиÑей Ð½ÐµÐ»ÑŒÐ·Ñ Ð¸Ñпользовать как переменные цикла for +% ÐŸÐ¾Ð»Ñ Ð·Ð°Ð¿Ð¸Ñи или Ñлементы маÑÑива, объÑвленных как \var{packed} в режиме Mac Pascal (либо как +% \var{packed} в любом режиме при уÑловии \var{\{\$bitpacking on\}}), будут упакованы на уровне +% бит. По причинам быÑтродейÑÑ‚Ð²Ð¸Ñ Ð¸Ñ… Ð½ÐµÐ»ÑŒÐ·Ñ Ð¸Ñпользовать как переменные Ð´Ð»Ñ for-цикла. +parser_e_type_and_var_only_in_generics=03224_E_VAR и TYPE допуÑтимы только в обобщениÑÑ… (generic) +% ИÑпользование VAR и TYPE Ð´Ð»Ñ Ð¾Ð±ÑŠÑÐ²Ð»ÐµÐ½Ð¸Ñ Ð½Ð¾Ð²Ñ‹Ñ… типов внутри объекта разрешаетÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ Ð´Ð»Ñ +% обобщений. +parser_e_cant_create_generics_of_this_type=03225_E_Этот тип не может быть обобщением +% ÐžÐ±Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ Ð´Ð¾Ð¿ÑƒÑкаютÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ Ð´Ð»Ñ ÐºÐ»Ð°ÑÑов, объектов, интерфейÑов и запиÑей. +parser_w_no_lineinfo_use_switch=03226_W_Ðе подключайте модуль LINEINFO вручную, иÑпользуйте Ð´Ð»Ñ Ñтого ключ -gl +% Ðе подключайте модуль LINEINFO вручную, иÑпользование ключа \var{-gl} автоматичеÑки подключает +% различные модули в завиÑимоÑти от типа генерируемой отладочной информации. +parser_e_no_funcret_specified=03227_E_Ð”Ð»Ñ Ñ„ÑƒÐ½ÐºÑ†Ð¸Ð¸ "$1" не указан тип результата +% Первое объÑвление функции должно быть полным, Ð²ÐºÐ»ÑŽÑ‡Ð°Ñ Ð²Ñе параметры и тип результата. +parser_e_special_onlygenerics=03228_E_Ð¡Ð¿ÐµÑ†Ð¸Ð°Ð»Ð¸Ð·Ð°Ñ†Ð¸Ñ Ð²Ð¾Ð·Ð¼Ð¾Ð¶Ð½Ð° только Ð´Ð»Ñ Ð¾Ð±Ð¾Ð±Ñ‰ÐµÐ½Ð½Ñ‹Ñ… типов. +% Типы, не ÑвлÑющиеÑÑ Ð¾Ð±Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñми, не могут быть Ñпециализированы. +parser_e_no_generics_as_params=03229_E_ÐžÐ±Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ Ð½ÐµÐ»ÑŒÐ·Ñ Ð¸Ñпользовать как параметры Ñпециализации других обобщений +% При Ñпециализации обобщениÑ, в качеÑтве параметров можно иÑпользовать только обычные типы. +parser_e_type_object_constants=03230_E_КонÑтантные объекты, Ñодержащие VMT, не допуÑкаютÑÑ +% ЕÑли объект требует VMT из-за Ð½Ð°Ð»Ð¸Ñ‡Ð¸Ñ ÐºÐ¾Ð½Ñтруктора либо виртуальных методов, +% Ñоздание конÑтант его типа не допуÑкаетÑÑ. Ð’ режимах TP и Delphi, тем не менее, +% Ñто разрешено в целÑÑ… ÑовмеÑтимоÑти. +parser_e_label_outside_proc=03231_E_Ðе допуÑкаетÑÑ Ð²Ð·Ñтие адреÑов меток, определенных вне текущей облаÑти видимоÑти +% Ðе разрешаетÑÑ Ð¿Ð¾Ð»ÑƒÑ‡ÐµÐ½Ð¸Ðµ адреÑов меток, находÑщихÑÑ Ð²Ð½Ðµ текущей процедуры. +parser_e_initialized_not_for_external=03233_E_Ðе допуÑкаетÑÑ Ð¸Ð½Ð¸Ñ†Ð¸Ð°Ð»Ð¸Ð·Ð°Ñ†Ð¸Ñ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ñ‹Ñ…, объÑвленных как external +% Переменные, объÑвленные как external, не могут иметь значение по умолчанию. +parser_e_illegal_function_result=03234_E_Ðеверный тип возвращаемого Ð·Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ +% Ðекоторые типы, такие как файлы, не могут быть иÑпользованы в качеÑтве результата функции. +parser_e_no_common_type=03235_E_ОтÑутÑтвует общий тип Ð´Ð»Ñ "$1" и "$2" +% Чтобы выполнить операцию над целыми чиÑлами, компилÑтор приводит их к общему типу, +% чего ему в данном Ñлучае не удаетÑÑ. Ð”Ð»Ñ Ð¾Ð¿Ñ€ÐµÐ´ÐµÐ»ÐµÐ½Ð¸Ñ Ð¾Ð±Ñ‰ÐµÐ³Ð¾ типа операндов +% компилÑтор берет меньшее из минимальных значений обоих типов и большее из макÑимальных +% значений. Общий тип будет иметь диапазон минимум..макÑимум. +parser_e_no_generics_as_types=03236_E_ÐžÐ±Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ Ð±ÐµÐ· Ñпециализации не могут быть иÑпользованы как тип переменной +% ÐžÐ±Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ Ð²Ñегда должны быть Ñпециализированы перед иÑпользованием в качеÑтве типа Ð´Ð»Ñ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ñ‹Ñ…. +parser_w_register_list_ignored=03237_W_Перечень региÑтров Ð´Ð»Ñ Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€ полноÑтью на аÑÑемблере игнорирован +% Ð’ процедурах, напиÑанных полноÑтью на аÑÑемблере, перечень измененных региÑтров игнорируетÑÑ. +parser_e_implements_must_be_class_or_interface=03238_E_СвойÑтво implements должно быть типа клаÑÑ Ð¸Ð»Ð¸ Ð¸Ð½Ñ‚ÐµÑ€Ñ„ÐµÐ¹Ñ +% СвойÑтво, реализующее интерфейÑ, должно иметь тип клаÑÑа или интерфейÑа. +parser_e_implements_must_have_correct_type=03239_E_СвойÑтво implements должно реализовывать Ð¸Ð½Ñ‚ÐµÑ€Ñ„ÐµÐ¹Ñ ÑƒÐºÐ°Ð·Ð°Ð½Ð½Ð¾Ð³Ð¾ типа, найдено "$1" ожидалоÑÑŒ "$2" +% СвойÑтво, реализующее интерфейÑ, реализует не тот тип интерфейÑа. +parser_e_implements_must_read_specifier=03240_E_СвойÑтво implements должно быть доÑтупным Ð´Ð»Ñ Ñ‡Ñ‚ÐµÐ½Ð¸Ñ +% СвойÑтво, реализующее интерфейÑ, должно иметь Ñпецификатор read. +parser_e_implements_must_not_have_write_specifier=03241_E_СвойÑтво implements не должно быть доÑтупным Ð´Ð»Ñ Ð·Ð°Ð¿Ð¸Ñи +% СвойÑтво, реализующее интерфейÑ, не может иметь Ñпецификатор write. +parser_e_implements_must_not_have_stored_specifier=03242_E_СвойÑтво implements не может быть stored +% СвойÑтво, реализующее интерфейÑ, не может иметь Ñпецификатор stored. +parser_e_implements_uses_non_implemented_interface=03243_E_СвойÑтво implements иÑпользовано Ð´Ð»Ñ Ð½ÐµÑ€ÐµÐ°Ð»Ð¸Ð·Ð¾Ð²Ð°Ð½Ð½Ð¾Ð³Ð¾ интерфейÑа: "$1" +% ИнтерфейÑ, реализуемый ÑвойÑтвом, должен быть в ÑпиÑке интерфейÑов, реализуемых клаÑÑом. +parser_e_unsupported_real=03244_E_ВычиÑÐ»ÐµÐ½Ð¸Ñ Ñ Ð¿Ð»Ð°Ð²Ð°ÑŽÑ‰ÐµÐ¹ запÑтой не доÑтупны Ð´Ð»Ñ Ñ†ÐµÐ»ÐµÐ²Ð¾Ð¹ платформы +% Ð’ÑтретилоÑÑŒ вещеÑтвенное выражение, но на целевой платформе они не поддерживаютÑÑ +parser_e_class_doesnt_implement_interface=03245_E_КлаÑÑ "$1" не реализует Ð¸Ð½Ñ‚ÐµÑ€Ñ„ÐµÐ¹Ñ "$2" +% Делегированный Ð¸Ð½Ñ‚ÐµÑ€Ñ„ÐµÐ¹Ñ Ð½Ðµ реализован клаÑÑом, указанным в выражении implements. +parser_e_class_implements_must_be_interface=03246_E_Тип, иÑпользуемый implements, должен быть интерфейÑом +% За ключевым Ñловом \var{implements} должно Ñледовать Ð¸Ð¼Ñ Ñ‚Ð¸Ð¿Ð° интерфейÑа. +parser_e_cant_export_var_different_name=03247_E_Ðа Ñтой платформе переменные Ð½ÐµÐ»ÑŒÐ·Ñ ÑкÑпортировать Ñ Ð´Ñ€ÑƒÐ³Ð¸Ð¼ именем, добавьте Ð¸Ð¼Ñ Ðº объÑвлению Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ директивы "export" (Ð¸Ð¼Ñ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð¾Ð¹: $1, объÑвленное Ð¸Ð¼Ñ ÑкÑпорта: $2) +% On most targets it is not possible to change the name under which a variable +% is exported inside the \var{exports} statement of a library. +% In that case, you have to specify the export name at the point where the +% variable is declared, using the \var{export} and \var{alias} directives. +parser_e_weak_external_not_supported=03248_E_Символы "weak external" не поддерживаютÑÑ Ð½Ð° целевой платформе +% A "weak external" symbol is a symbol which may or may not exist at (either static +% or dynamic) link time. This concept may not be available (or implemented yet) +% on the current cpu/OS target. +parser_e_forward_mismatch=03249_E_Тип не ÑоответÑтвует раннему объÑвлению +% При раннем объÑвлении клаÑÑов и интерфейÑов типы раннего и фактичеÑкого объÑвлений +% должны Ñовпадать. Ранее объÑвленный Ð¸Ð½Ñ‚ÐµÑ€Ñ„ÐµÐ¹Ñ Ð½Ðµ может быть превращен в клаÑÑ. +parser_n_ignore_lower_visibility=03250_N_Виртуальный метод "$1" имеет меньшую видимоÑÑ‚ÑŒ ($2), чем в родительÑком клаÑÑе $3 ($4) +% Перекрывающий виртуальный метод видимоÑÑ‚ÑŒ меньше, чем перекрываемый. Это может приводить к +% неожиданным результатам. ЕÑли Ð½Ð¾Ð²Ð°Ñ Ð²Ð¸Ð´Ð¸Ð¼Ð¾ÑÑ‚ÑŒ - private, то вызов inherited в новом клаÑÑе +% потомка может вызывать метод Ñ Ð±Ð¾Ð»ÑŒÑˆÐµÐ¹ видимоÑтью в родительÑком клаÑÑе, Ð¸Ð³Ð½Ð¾Ñ€Ð¸Ñ€ÑƒÑ private метод. +parser_e_field_not_allowed_here=03251_E_ÐŸÐ¾Ð»Ñ Ð½ÐµÐ»ÑŒÐ·Ñ Ð¾Ð±ÑŠÑвлÑÑ‚ÑŒ поÑле методов или ÑвойÑтв, Ñначала начните новую Ñекцию видимоÑти +% ПоÑле объÑÐ²Ð»ÐµÐ½Ð¸Ñ Ð¼ÐµÑ‚Ð¾Ð´Ð° или ÑвойÑтва в клаÑÑе или объекте, дальнейшее объÑвление полей возможно +% только в новой Ñекции облаÑти видимоÑти (\var{public}, \var{private} и Ñ‚.д.). Это необходимо +% Ð´Ð»Ñ Ð¾Ð´Ð½Ð¾Ð·Ð½Ð°Ñ‡Ð½Ð¾Ð³Ð¾ Ð¿Ð¾Ð½Ð¸Ð¼Ð°Ð½Ð¸Ñ ÐºÐ¾Ð´Ð° компилÑтором, поÑкольку модификаторы методов, +% такие как \var{default} и \var{register} могут также иÑпользоватьÑÑ ÐºÐ°Ðº имена полей. +parser_e_no_local_para_def=03252_E_Параметры не могут Ñодержать локальные объÑÐ²Ð»ÐµÐ½Ð¸Ñ Ñ‚Ð¸Ð¿Ð¾Ð². ИÑпользуйте отдельное объÑвление типа в блоке type. +% Ð’ ПаÑкале ÑемантичеÑки равнозначные типы не ÑчитаютÑÑ Ð¸Ð´ÐµÐ½Ñ‚Ð¸Ñ‡Ð½Ñ‹Ð¼Ð¸. +% Переменные или параметры ÑчитаютÑÑ Ð¾Ð´Ð½Ð¾Ñ‚Ð¸Ð¿Ð½Ñ‹Ð¼Ð¸ только в том Ñлучае, еÑли они ÑÑылаютÑÑ Ð½Ð° одно и то же +% объÑвление типа. +% Как ÑледÑтвие, объÑвление типов в ÑпиÑке параметров не допуÑкаетÑÑ, Ñ‚.к. на локальное объÑвление невозможно +% ÑоÑлатьÑÑ Ð¸Ð·Ð²Ð½Ðµ, и два заголовка процедуры в интерфейÑной и реализационной чаÑти Ð¼Ð¾Ð´ÑƒÐ»Ñ Ð¾Ð±ÑŠÑвлÑли бы +% два различных типа. Имейте в виду, что Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ Ð²Ð¸Ð´Ð° ``file of byte'' или ``string[50]'' также определÑÑŽÑ‚ +% новый тип. +% \end{description} +# +# Type Checking +# +# 04087 is the last used one +# +% \section{Ошибки проверки типов} +% Ð’ разделе перечиÑлены вÑе ошибки, которые могут возникать в процеÑÑе +% проверки типов. +% \begin{description} +type_e_mismatch=04000_E_Тип не Ñовпадает +% Может иметь меÑто во многих ÑлучаÑÑ…: +% \begin{itemize} +% \item ПриÑÐ²Ð°Ð¸Ð²Ð°ÐµÐ¼Ð°Ñ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ð¸Ð¼ÐµÐµÑ‚ тип, отличный от приÑваиваемого выражениÑ. +% \item Вызов функции или процедуры Ñ Ð¿Ð°Ñ€Ð°Ð¼ÐµÑ‚Ñ€Ð°Ð¼Ð¸, неÑовмеÑтимыми +% Ñ Ñ‚ÐµÐ¼Ð¸, которые были иÑпользованы при объÑвлении функции. +% \end{itemize} +type_e_incompatible_types=04001_E_HеÑовмеÑтимые типы: полyчено "$1", ожидалоÑÑŒ "$2" +% Преобразование из одного типа в другой невозможно. +% Также возможно, что типы объÑвлены в различных объÑвлениÑÑ…: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { Приведет к ошибке из-за Ñ‚Ñ€ÐµÐ±Ð¾Ð²Ð°Ð½Ð¸Ñ +% Ñтрогого ÑоответÑÑ‚Ð²Ð¸Ñ Ñ‚Ð¸Ð¿Ð¾Ð² в ПаÑкале } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_HеÑовпадение типов междy "$1" и "$2" +% Типы не равны +type_e_type_id_expected=04003_E_ОжидаетÑÑ Ð¸Ð´ÐµÐ½Ñ‚Ñ„Ð¸ÐºÐ°Ñ‚Ð¾Ñ€ типа +% Идентификатор не ÑвлÑетÑÑ Ñ‚Ð¸Ð¿Ð¾Ð¼, либо идентификатор типа пропущен. +type_e_variable_id_expected=04004_E_ОжидаетÑÑ Ð¸Ð´ÐµÐ½Ñ‚Ð¸Ñ„Ð¸ÐºÐ°Ñ‚Ð¾Ñ€ переменной +% ПроиÑходит при попытке передачи конÑтанты в процедуру \var{Inc} или \var{Dec}. +% Им можно передавать только переменные. +type_e_integer_expr_expected=04005_E_ОжидаетÑÑ Ð²Ñ‹pажение типа INTEGER, но получено "$1" +% КомпилÑтор ожидает выражение типа integer, но получает нечто иное. +type_e_boolean_expr_expected=04006_E_ОжидаетÑÑ Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ðµ типа BOOLEAN, но получено "$1" +% Выражение должно быть булевого типа, должно быть возвращено true или +% false. +type_e_ordinal_expr_expected=04007_E_ОжидаетÑÑ Ð²Ñ‹pажение порÑдкового типа +% Тип Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ Ð´Ð¾Ð»Ð¶ÐµÐ½ быть порÑдковым, Ñ‚.е., макÑимум \var{Longint}. +% ПроиÑходит, например, еÑли второй аргумент +% \var{Inc} или \var{Dec} не вычиÑлÑетÑÑ ÐºÐ°Ðº порÑдковый тип. +type_e_pointer_type_expected=04008_E_ОжидаетÑÑ Ñ‚Ð¸Ð¿ POINTER, но получено "$1" +% ÐŸÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ð¸Ð»Ð¸ выражение имеет тип, отличный от \var{pointer}. ПроиÑходит, +% например, при передаче целой переменной в качеÑтве аргумента \var{New} +% или \var{Dispose}. +type_e_class_type_expected=04009_E_ОжидаетÑÑ Ñ‚Ð¸Ð¿ CLASS, но получено "$1" +% ÐŸÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ð¸Ð»Ð¸ выражение имеет тип, отличный от \var{class}. Обычно +% ÑлучаетÑÑ, еÑли +% \begin{enumerate} +% \item РодительÑкий клаÑÑ Ð² объÑвлении клаÑÑа не ÑвлÑетÑÑ ÐºÐ»Ð°ÑÑом. +% \item Обработчик иÑключений (\var{On}) Ñодержит идентификатор типа, +% не ÑвлÑющийÑÑ ÐºÐ»Ð°ÑÑом. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_Hевозможно вычиÑлить конÑтантное выражение +% ПроиÑходит, еÑли границы объÑвленного маÑÑива не вычиÑлÑÑŽÑ‚ÑÑ ÐºÐ°Ðº порÑдковые конÑтанты. +type_e_set_element_are_not_comp=04012_E_Элементы множеÑтва не ÑовмеÑтимы +% Возникает при операции над Ð´Ð²ÑƒÐ¼Ñ Ð¼Ð½Ð¾Ð¶ÐµÑтвами, имеющими различный тип Ñлементов. +% Ð”Ð»Ñ Ð¾Ð±ÑŠÐµÐ´Ð¸Ð½ÐµÐ½Ð¸Ñ Ð¼Ð½Ð¾Ð¶ÐµÑтв они должны иметь одинаковый базовый тип. +type_e_set_operation_unknown=04013_E_ОпеpÐ°Ñ†Ð¸Ñ Ð½Ðµ pеализована Ð´Ð»Ñ Ð¼Ð½Ð¾Ð¶ÐµÑтв +% Ðекоторые парные операции не определены Ð´Ð»Ñ Ð¼Ð½Ð¾Ð¶ÐµÑтв, +% например, div mod ** (также, в наÑтоÑщее времÑ, >= <=). +type_w_convert_real_2_comp=04014_W_ÐвтоматичеÑкое пpеобpазование из вещеÑтвенного типа в COMP, котоpый ÑвлÑетÑÑ Ñ†ÐµÐ»Ð¾Ñ‡Ð¸Ñленным +% Ð’ÑтретилоÑÑŒ неÑвное преобразование вещеÑтвенного типа в \var{comp}. +% ПоÑкольку \var{Comp} ÑвлÑетÑÑ 64-битным целым, Ñто может ÑвидетельÑтвовать об ошибке. +type_h_use_div_for_int=04015_H_Ð”Ð»Ñ Ð¿Ð¾Ð»yÑ‡ÐµÐ½Ð¸Ñ Ñ†ÐµÐ»Ð¾Ñ‡Ð¸Ñленного pезyльтата иÑпользyйте DIV +% При включенных подÑказках, Ñообщение будет выдаватьÑÑ Ð¿Ñ€Ð¸ целочиÑленном делении +% Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ '/', поÑкольку результат в Ñтом Ñлучае будет вещеÑтвенным. +type_e_strict_var_string_violation=04016_E_Типы Ñтрок не Ñовпадают из-за режима $V+ +% При компилÑции в режиме \var{\{\$V+\}}, тип Ñтрок, передаваемых как параметры, +% должен в точноÑти Ñовпадать Ñ Ñ‚Ð¸Ð¿Ð¾Ð¼ в объÑвлении функции. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_SUCC или PRED невозможны на пеpечиÑлениÑÑ… Ñ Ð¿Ñ€Ð¸ÑвоениÑми +% ЕÑли перечиÑлÑемый тип Ñодержит приÑвоениÑ, как в Ñзыке C, +% например: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% то Ð´Ð»Ñ Ð½ÐµÐ³Ð¾ Ð½ÐµÐ»ÑŒÐ·Ñ Ð¸Ñпользовать функции \var{Succ} или \var{Pred}. +type_e_cant_read_write_type=04018_E_Чтение и запиÑÑŒ пеpеменных Ñтого типа невозможна +% Попытка Ñ‡Ñ‚ÐµÐ½Ð¸Ñ (\var{read}) или запиÑи (\var{write}) переменной, тип которой не +% поддерживаетÑÑ, в файл типа текÑÑ‚. ПоддерживаютÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ целые, +% булевы, вещеÑтвенные переменные, переменные типа pchar и Ñтроки. +type_e_no_readln_writeln_for_typed_file=04019_E_Readln или Writeln недопуÑтимы на типизированном файле +% \var{readln} и \var{writeln} допуÑкаютÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ Ð´Ð»Ñ Ñ‚ÐµÐºÑтовых файлов. +type_e_no_read_write_for_untyped_file=04020_E_Read или Write недопуÑтимы на нетипизированном файле +% \var{read} и \var{write} допуÑкаютÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ Ð´Ð»Ñ Ñ‚ÐµÐºÑтовых и типизированных файлов. +type_e_typeconflict_in_set=04021_E_Конфликт типов междy Ñлементами множеÑтва +% Тип по крайней мере одного Ñлемента не Ñовпадает Ñ Ð±Ð°Ð·Ð¾Ð²Ñ‹Ð¼ типом множеÑтва. +type_w_maybe_wrong_hi_lo=04022_W_Lo/Hi(dword/qword) возвpащают младшее/Ñтаршее word/dword +% \fpc поддерживает перегруженные варианты \var{lo/hi} Ð´Ð»Ñ \var{longint/dword/int64/qword}, +% которые возвращают младшую/Ñтаршую половину аргумента (типа word/dword). TP вÑегда иÑпользует +% 16-битные \var{lo/hi}, которые вÑегда возвращают биты 0..7 Ð´Ð»Ñ \var{lo} и +% биты 8..15 Ð´Ð»Ñ \var{hi}. ЕÑли требуетÑÑ Ð¿Ð¾Ð²ÐµÐ´ÐµÐ½Ð¸Ðµ TP, нужно привеÑти аргумент +% к \var{word/integer}. +type_e_integer_or_real_expr_expected=04023_E_ОжидаетÑÑ Ð²Ñ‹pажение целого или вещеÑтвенного типа +% Первый аргумент \var{str} должен иметь целый либо вещеÑтвенный тип. +type_e_wrong_type_in_array_constructor=04024_E_Hевеpный тип "$1" в конÑÑ‚pyктоpе маÑÑива +% Попытка иÑÐ¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ð½Ð¸Ñ Ð½ÐµÐ´Ð¾Ð¿ÑƒÑтимого типа в конÑтрукторе маÑÑива. +type_e_wrong_parameter_type=04025_E_HеÑовпадение типа аpгyмента # $1: получено "$2", ожидалоÑÑŒ "$3" +% Попытка передать неверный тип Ð´Ð»Ñ ÑƒÐºÐ°Ð·Ð°Ð½Ð½Ð¾Ð³Ð¾ параметра. +type_e_no_method_and_procedure_not_compatible=04026_E_Метод (пеpеменнаÑ) и пpоцедypа (пеpеменнаÑ) не ÑовмеÑтимы +% ÐÐµÐ»ÑŒÐ·Ñ Ð¿Ñ€Ð¸Ñвоить метод переменной типа процедура, или процедуру переменной типа +% метод. +type_e_wrong_math_argument=04027_E_ÐÐµÐ²ÐµÑ€Ð½Ð°Ñ ÐºÐ¾Ð½Ñтанта пеpедана вÑтроенной математичеÑкой Ñ„yнкции +% КонÑтантный аргумент функции ln или sqrt находитÑÑ Ð²Ð½Ðµ определенного Ð´Ð»Ñ Ð½Ð¸Ñ… +% диапазона. +type_e_no_addr_of_constant=04028_E_HÐµÐ»ÑŒÐ·Ñ Ð²Ð·ÑÑ‚ÑŒ Ð°Ð´Ñ€ÐµÑ ÐºÐ¾Ð½Ñтантного Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ +% ВзÑÑ‚ÑŒ Ð°Ð´Ñ€ÐµÑ ÐºÐ¾Ð½Ñтантного Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ Ð½ÐµÐ²Ð¾Ð·Ð¼Ð¾Ð¶Ð½Ð¾, потому что конÑтанты не +% хранÑÑ‚ÑÑ Ð² памÑти. Можно попробовать объÑвить типизированную конÑтанту. +type_e_argument_cant_be_assigned=04029_E_Ðргументу невозможно приÑвоить значение +% Ð’ качеÑтве параметра по ÑÑылке могут быть переданы только те выражениÑ, +% которые можно иÑпользовать Ñ Ð»ÐµÐ²Ð¾Ð¹ Ñтороны оператора приÑваиваниÑ. +% ЗамечаниÑ: СвойÑтва можно иÑпользовать Ñ Ð»ÐµÐ²Ð¾Ð¹ Ñтороны приÑваиваниÑ, но +% Ð½ÐµÐ»ÑŒÐ·Ñ Ð¿ÐµÑ€ÐµÐ´Ð°Ð²Ð°Ñ‚ÑŒ по ÑÑылке. +type_e_cannot_local_proc_to_procvar=04030_E_Ð›Ð¾ÐºÐ°Ð»ÑŒÐ½Ð°Ñ Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€Ð° не может быть приÑвоена переменной процедурного типа +% ПриÑвоение локальных процедур/функций процедурным переменным не допуÑкаетÑÑ, +% Ñ‚.к. у них другой ÑпоÑоб вызова. Локальные процедуры/функции +% можно приÑвоить только нетипизированному указателю. +type_e_no_assign_to_addr=04031_E_HÐµÐ»ÑŒÐ·Ñ Ð¿Ñ€Ð¸Ñвоить значение адpеÑy +% Ðе допуÑкаетÑÑ Ð¿Ñ€Ð¸Ñвоение значений адреÑам переменных, конÑтант, процедур +% и функций. ЕÑли идентификатор ÑвлÑетÑÑ Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€Ð½Ð¾Ð¹ переменной, можно попробовать +% компилÑцию Ñ ÐºÐ»ÑŽÑ‡Ð¾Ð¼ -So. +type_e_no_assign_to_const=04032_E_HÐµÐ»ÑŒÐ·Ñ Ð¿Ñ€Ð¸Ñвоить значение конÑтанте +% Ðе допуÑкаетÑÑ Ð¿Ñ€Ð¸Ñвоение значений переменным, объÑвленным как конÑтантные. +% Как правило, Ñто параметры, объÑвленные как const. Чтобы их можно было +% приÑваивать, поменÑйте их на var или на параметр-значение. +type_e_array_required=04033_E_ТpебyетÑÑ Ñ‚Ð¸Ð¿ маÑÑива +% При доÑтупе к переменной по индекÑу '[<x>]' тип Ñтой переменной должна быть +% маÑÑивом. Ð’ режиме FPC также допуÑкаютÑÑ ÑƒÐºÐ°Ð·Ð°Ñ‚ÐµÐ»Ð¸. +type_e_interface_type_expected=04034_E_ТребуетÑÑ Ñ‚Ð¸Ð¿ интерфейÑа, но получено "$1" +% КомпилÑтор ожидал вÑтретить Ð¸Ð¼Ñ Ñ‚Ð¸Ð¿Ð° интерфейÑа, но вÑтретил что-то другое. +% Ошибка может быть вызвана Ñледующим кодом: +% \begin{verbatim} +% Type +% TMyStream = Class(TStream,Integer) +% \end{verbatim} +type_h_mixed_signed_unsigned=04035_H_Смешивание знаковых и беззнаковых выражений дает 64-битный результат +% При делении (или вычиÑлении оÑтатка) знакового Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ Ð½Ð° беззнаковое (или наоборот), +% или же включена проверка переполнений и/или диапазонов и иÑпользуетÑÑ Ð°Ñ€Ð¸Ñ„Ð¼ÐµÑ‚Ð¸Ñ‡ÐµÑкое +% выражение (+, -, *, div, mod), в котором вÑтречаютÑÑ ÐºÐ°Ðº знаковые, так и беззнаковые значениÑ, +% вычиÑление будет производитьÑÑ Ð² 64-битном режиме, который медленнее обычной +% 32-битной арифметики. Этого можно избежать, Ð¿Ñ€Ð¸Ð²ÐµÐ´Ñ Ñ‚Ð¸Ð¿ одного из операндов к типу +% другого. +type_w_mixed_signed_unsigned2=04036_W_Смешивание знаковых и беззнаковых выражений типа может вызвать ошибку выхода за диапазон +% При иÑпользовании двоичных операций (and, or, xor), один из операндов которых +% ÑвлÑетÑÑ Ð±ÐµÐ·Ð·Ð½Ð°ÐºÐ¾Ð²Ñ‹Ð¼ выражением, а другой - выражением Ñо знаком, и включена +% проверка диапазонов, может возникнуть ошибка, Ñ‚.к. в Ñтом Ñлучае оба операнда +% будут преобразованы в беззнаковый cardinal. Этого можно избежать, Ð¿Ñ€Ð¸Ð²ÐµÐ´Ñ Ñ‚Ð¸Ð¿ +% одного из операндов к типу другого. +type_e_typecast_wrong_size_for_assignment=04037_E_Приведение типов разного размера ($1 -> $2) в приÑваивании +% Приведение типа к типу другого размера невозможно, еÑли Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ð¸ÑпользуетÑÑ +% в приÑваивании. +type_e_array_index_enums_with_assign_not_possible=04038_E_ПеречиÑÐ»ÐµÐ½Ð¸Ñ Ñ Ð¿Ñ€Ð¸ÑвоениÑми Ð½ÐµÐ»ÑŒÐ·Ñ Ð¸Ñпользовать как Ð¸Ð½Ð´ÐµÐºÑ Ð¼Ð°ÑÑива +% Элементы перечиÑлÑемого типа, объÑвленного Ñ Ð¿Ñ€Ð¸ÑвоениÑми, как в Ñзыке C, +% например: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% Ð½ÐµÐ»ÑŒÐ·Ñ Ð¸Ñпользовать как индекÑÑ‹ маÑÑивов. +type_e_classes_not_related=04039_E_Типы клаÑÑов или объектов "$1" и "$2" не ÑоотноÑÑÑ‚ÑÑ +% Приведение типа одного клаÑÑа или объекта к другому, не имеющего к нему отношениÑ. +% Это навернÑка приведет к ошибкам. +type_w_classes_not_related=04040_W_Типы клаÑÑов "$1" и "$2" не ÑоотноÑÑÑ‚ÑÑ +% Приведение типа одного клаÑÑа или объекта к другому, не имеющего к нему отношениÑ. +% Это навернÑка приведет к ошибкам. +type_e_class_or_interface_type_expected=04041_E_ОжидаетÑÑ Ñ‚Ð¸Ð¿ клаÑÑа или интерфейÑа, но получено "$1" +% КомпилÑтор ожидал вÑтретить Ð¸Ð¼Ñ ÐºÐ»Ð°ÑÑа или интерфейÑа, но вÑтретил что-то другое. +type_e_type_is_not_completly_defined=04042_E_Тип "$1" не определен полноÑтью +% Проиходит, еÑли тип не определен полноÑтью, например, Ñто тип указателÑ, который указывает +% на неопределенный тип. +type_w_string_too_long=04043_W_Строковый литерал Ñодержит больше Ñимволов, чем может вмеÑтить shortstring +% Попытка приÑвоить короткой Ñтроке конÑтантное значение, которое Ñодержит больше Ñимволов, +% чем макÑÐ¸Ð¼Ð°Ð»ÑŒÐ½Ð°Ñ Ð´Ð»Ð¸Ð½Ð° Ñтроки. +type_w_signed_unsigned_always_false=04044_W_Сравнение вÑегда ложно из-за диапазонов значений +% Сравнение беззнакового Ð·Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ Ñо знаковой конÑтантой, меньшей нулÑ. Результат такого Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ +% будет вÑегда ложным. Следует Ñвно привеÑти тип конÑтанты к нужному диапазону. +type_w_signed_unsigned_always_true=04045_W_Сравнение вÑегда иÑтинно из-за диапазонов значений +% Сравнение беззнакового Ð·Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ Ñо знаковой конÑтантой, меньшей нулÑ. Результат такого Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ +% будет вÑегда иÑтинным. Следует Ñвно привеÑти тип конÑтанты к нужному диапазону. +type_w_instance_with_abstract=04046_W_Создание клаÑÑа "$1" Ñ Ð°Ð±Ñтрактным методом "$2" +% СоздаетÑÑ ÑкземплÑÑ€ клаÑÑа, Ñодержащего неперекрытый абÑтрактный метод. +% Вызов такого метода во Ð²Ñ€ÐµÐ¼Ñ Ð²Ñ‹Ð¿Ð¾Ð»Ð½ÐµÐ½Ð¸Ñ Ð¿Ñ€Ð¾Ð³Ñ€Ð°Ð¼Ð¼Ñ‹ приведет к ошибке 211. +% Ð’Ñе абÑтрактные методы должны быть перекрыты. +type_h_in_range_check=04047_H_Левый операнд оператора IN должен иметь размер байта +% Левый операнд оператора \var{in} не ÑвлÑетÑÑ Ð¿Ð¾Ñ€Ñдковым или перечиÑлÑемым значением, +% помещающимÑÑ Ð² 8 бит, Ñто может приводить к ошибкам проверки диапазона. Оператор \var{in} +% в наÑтоÑщее Ð²Ñ€ÐµÐ¼Ñ Ð¿Ð¾Ð´Ð´ÐµÑ€Ð¶Ð¸Ð²Ð°ÐµÑ‚ левый операнд только байтового диапазона. Ð’ Ñлучае +% перечиÑлений, размером Ñлементов перечиÑÐ»ÐµÐ½Ð¸Ñ Ð¼Ð¾Ð¶Ð½Ð¾ управлÑÑ‚ÑŒ Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ +% ключей \var{\{\$PACKENUM\}} или \var{\{\$Zn\}}. +type_w_smaller_possible_range_check=04048_W_ÐеÑовпадение размеров типов, возможна Ð¿Ð¾Ñ‚ÐµÑ€Ñ Ð´Ð°Ð½Ð½Ñ‹Ñ… / ошибки диапазона +% ПриÑвоение типу меньшего размера, чем иÑходный тип. Это может приводить к ошибкам проверки +% диапазона, или чаÑтичной потере данных. +type_h_smaller_possible_range_check=04049_H_ÐеÑовпадение размеров типов, возможна Ð¿Ð¾Ñ‚ÐµÑ€Ñ Ð´Ð°Ð½Ð½Ñ‹Ñ… / ошибки диапазона +% ПриÑвоение типу меньшего размера, чем иÑходный тип. Это может приводить к ошибкам проверки +% диапазона, или чаÑтичной потере данных. +type_e_cant_take_address_of_abstract_method=04050_E_ВзÑтие адреÑа абÑтрактного метода невозможно +% ÐбÑтрактный метод не имеет тела, поÑтому Ð°Ð´Ñ€ÐµÑ Ð±Ñ€Ð°Ñ‚ÑŒ не от чего. +type_e_assignment_not_allowed=04051_E_Ðевозможно приÑвоение формальных параметров и открытых маÑÑивов +% Попытка приÑвоить значение формальному (нетипизированному var, const или out) +% параметру, либо открытому маÑÑиву. +type_e_constant_expr_expected=04052_E_ОжидаетÑÑ ÐºÐ¾Ð½Ñтантное выражение +% КомпилÑтор ожидает конÑтантное выражение, но получает переменное. +type_e_operator_not_supported_for_types=04053_E_ÐžÐ¿ÐµÑ€Ð°Ñ†Ð¸Ñ "$1" не поддерживаетÑÑ Ð´Ð»Ñ Ñ‚Ð¸Ð¿Ð¾Ð² "$2" и "$3" +% Ð£ÐºÐ°Ð·Ð°Ð½Ð½Ð°Ñ Ð¾Ð¿ÐµÑ€Ð°Ñ†Ð¸Ñ Ð½ÐµÐ´Ð¾Ð¿ÑƒÑтима Ð´Ð»Ñ ÑƒÐºÐ°Ð·Ð°Ð½Ð½Ñ‹Ñ… типов. +type_e_illegal_type_conversion=04054_E_ÐедопуÑтимое приведение типов: "$1" к "$2" +% При приведении типов Ñледует Ñоблюдать равенÑтво размеров иÑточника и получателÑ. +type_h_pointer_to_longint_conv_not_portable=04055_H_Преобразование между порÑдковыми типами и указателÑми ÑвлÑетÑÑ Ð½ÐµÐ¿Ð¾Ñ€Ñ‚Ð¸Ñ€ÑƒÐµÐ¼Ñ‹Ð¼ +% Код, в котором указатели приводÑÑ‚ÑÑ Ðº longint (или наоборот), не будет работать +% на платформах, у которых размер ÑƒÐºÐ°Ð·Ð°Ñ‚ÐµÐ»Ñ Ñ€Ð°Ð²ÐµÐ½ 64 битам. +type_w_pointer_to_longint_conv_not_portable=04056_W_Преобразование между порÑдковыми типами и указателÑми ÑвлÑетÑÑ Ð½ÐµÐ¿Ð¾Ñ€Ñ‚Ð¸Ñ€ÑƒÐµÐ¼Ñ‹Ð¼ +% Приведение указателей к порÑдковым типам другого размера (или наоборот), может +% вызывать проблемы. Это предупреждение помогает находить Ñпецифичный 32-битный код, в котором +% тип longint/cardinal иÑпользуетÑÑ Ð²Ð·Ð°Ð¸Ð¼Ð¾Ð·Ð°Ð¼ÐµÐ½Ñемо Ñ ÑƒÐºÐ°Ð·Ð°Ñ‚ÐµÐ»Ñми. Решение заключаетÑÑ Ð² иÑпользовании +% типов ptrint/ptruint. +type_e_cant_choose_overload_function=04057_E_Ðевозможно определить, которую из перегруженных функции вызывать +% Вызов перегруженной функции Ñо ÑпиÑком параметров, который не ÑоответÑтвует ни +% одной из объÑвленных функций. Ðапример, еÑли объÑвлены функции Ñ Ð¿Ð°Ñ€Ð°Ð¼ÐµÑ‚Ñ€Ð°Ð¼Ð¸ +% типа \var{word} и \var{longint}, а вызов производитÑÑ Ñ Ð¿Ð°Ñ€Ð°Ð¼ÐµÑ‚Ñ€Ð¾Ð¼ типа +% \var{integer}. +type_e_illegal_count_var=04058_E_ÐÐµÐ²ÐµÑ€Ð½Ð°Ñ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ñчетчика +% Тип переменной Ð´Ð»Ñ Ñ†Ð¸ÐºÐ»Ð° \var{for} должен быть порÑдковым. +% ВещеÑтвенные и Ñтроковые типы не допуÑкаютÑÑ. +type_w_double_c_varargs=04059_W_ВещеÑÑ‚Ð²ÐµÐ½Ð½Ð°Ñ ÐºÐ¾Ð½Ñтанта преобразована в double Ð´Ð»Ñ Ñ„-ции C Ñ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ñ‹Ð¼ чиÑлом параметров +% Ð’ Ñзыке C вещеÑтвенные конÑтанты по умолчанию имеют тип double. ПоÑтому при передаче +% вещеÑтвенной конÑтанты в функцию на C Ñ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ñ‹Ð¼ чиÑлом аргументов FPC +% по умолчанию преобразует ее в double. ЕÑли Ñто поведение нежелательно, +% приведите конÑтанту к нужному типу Ñвно. +type_e_class_or_cominterface_type_expected=04060_E_ОжидаетÑÑ Ñ‚Ð¸Ð¿ клаÑÑа или COM-интерфейÑа, но получено "$1" +% Ðекоторые операторы, такие как AS, применимы только к клаÑÑам или COM-интерфейÑам. +type_e_no_const_packed_array=04061_E_КонÑтантные упакованные маÑÑивы пока не поддерживаютÑÑ +% ÐÐµÐ»ÑŒÐ·Ñ Ð¾Ð±ÑŠÑвить конÑтанту типа (побитно)упакованный маÑÑив. +type_e_got_expected_packed_array=04062_E_ÐеÑовпадение типа аргумента no. $1: Получено "$2" ожидалоÑÑŒ "(Bit)Packed Array" +% КомпилÑтор ожидает (побитно)упакованный маÑÑив в качеÑтве указанного параметра. +type_e_got_expected_unpacked_array=04063_E_ÐеÑовпадение типа аргумента no. $1: Получено "$2" ожидалоÑÑŒ "(not packed) Array" +% КомпилÑтор ожидает обычный (неупакованный) маÑÑив в качеÑтве указанного параметра. +type_e_no_packed_inittable=04064_E_Элементы упакованного маÑÑива не могут иметь тип, требующий инициализации +% Упакованные маÑÑивы Ñ Ñ‚Ð¸Ð¿Ð°Ð¼Ð¸, требующими инициализацию (такими как ansistring, или запиÑи, Ñодержащие +% ansistring), пока не поддерживаютÑÑ. +type_e_no_const_packed_record=04065_E_КонÑтантные упакованные запиÑи и объекты пока не поддерживаютÑÑ +% Ð’ наÑтоÑщее Ð²Ñ€ÐµÐ¼Ñ Ð½ÐµÐ»ÑŒÐ·Ñ Ð¾Ð±ÑŠÑвить конÑтанту типа (побитно)ÑƒÐ¿Ð°ÐºÐ¾Ð²Ð°Ð½Ð½Ð°Ñ Ð·Ð°Ð¿Ð¸ÑÑŒ/объект. +type_w_untyped_arithmetic_unportable=04066_W_Ðрифметика "$1" нетипизированных указателей неÑовмеÑтима Ñ Ñ€ÐµÐ¶Ð¸Ð¼Ð¾Ð¼ {$T+}, предлагаетÑÑ Ð¿Ñ€Ð¸Ð²ÐµÐ´ÐµÐ½Ð¸Ðµ типа +% Сложение/вычитание нетипизированных указателей может работать по-другому в режиме \var{\{\$T+\}}, +% приведите тип к типизированному указателю. +type_e_cant_take_address_of_local_subroutine=04076_E_ÐÐµÐ»ÑŒÐ·Ñ Ð²Ð·ÑÑ‚ÑŒ Ð°Ð´Ñ€ÐµÑ Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€Ñ‹, помеченной как Ð»Ð¾ÐºÐ°Ð»ÑŒÐ½Ð°Ñ +% ВзÑтие адреÑа процедуры, помеченной как локальнаÑ, невозможно. +type_e_cant_export_local=04077_E_Процедура, Ð¾Ñ‚Ð¼ÐµÑ‡ÐµÐ½Ð½Ð°Ñ ÐºÐ°Ðº локальнаÑ, не может быть ÑкÑпортирована из Ð¼Ð¾Ð´ÑƒÐ»Ñ +% Процедура, Ð¾Ñ‚Ð¼ÐµÑ‡ÐµÐ½Ð½Ð°Ñ ÐºÐ°Ðº локальнаÑ, не может быть ÑкÑпортирована из модулÑ. +type_e_not_automatable=04078_E_Тип не автоматизируемый: "$1" +% Ð’ качеÑтве автоматизированных допуÑкаютÑÑ byte, integer, longint, smallint, currency, single, double, +% ansistring, widestring, tdatetime, variant, olevariant, wordbool и вÑе интерфейÑные типы. +type_h_convert_add_operands_to_prevent_overflow=04079_H_Приведение операндов к "$1" перед Ñложением предотвратит ошибки переполнениÑ. +% Сложение может вызывать переполнение. Т.к. результат преобразуетÑÑ Ð² тип большего размера, +% Ð¿ÐµÑ€ÐµÐ¿Ð¾Ð»Ð½ÐµÐ½Ð¸Ñ Ð¼Ð¾Ð¶Ð½Ð¾ избежать, Ð¿Ñ€Ð¸Ð²ÐµÐ´Ñ Ð¾Ð¿ÐµÑ€Ð°Ð½Ð´Ñ‹ к типу результата перед Ñложением. +type_h_convert_sub_operands_to_prevent_overflow=04080_H_Приведение операндов к "$1" перед вычитанием предотвратит ошибки переполнениÑ. +% Вычитание может вызывать переполнение. Т.к. результат преобразуетÑÑ Ð² тип большего размера, +% Ð¿ÐµÑ€ÐµÐ¿Ð¾Ð»Ð½ÐµÐ½Ð¸Ñ Ð¼Ð¾Ð¶Ð½Ð¾ избежать, Ð¿Ñ€Ð¸Ð²ÐµÐ´Ñ Ð¾Ð¿ÐµÑ€Ð°Ð½Ð´Ñ‹ к типу результата перед вычитанием. +type_h_convert_mul_operands_to_prevent_overflow=04081_H_Приведение операндов к "$1" перед умножением предотвратит ошибки переполнениÑ. +% Умножение может вызывать переполнение. Т.к. результат преобразуетÑÑ Ð² тип большего размера, +% Ð¿ÐµÑ€ÐµÐ¿Ð¾Ð»Ð½ÐµÐ½Ð¸Ñ Ð¼Ð¾Ð¶Ð½Ð¾ избежать, Ð¿Ñ€Ð¸Ð²ÐµÐ´Ñ Ð¾Ð¿ÐµÑ€Ð°Ð½Ð´Ñ‹ к типу результата перед умножением. +type_w_pointer_to_signed=04082_W_Приведение указателей к целым Ñо знаком может приводить к ошибкам ÑÑ€Ð°Ð²Ð½ÐµÐ½Ð¸Ñ Ð¸ выходу за диапазон, иÑпользуйте беззнаковый тип. +% Виртуальное адреÑное проÑтранÑтво на 32-битных ÑиÑтемах имеет диапазон от \$00000000 до \$ffffffff. +% Многие операционные ÑиÑтемы позволÑÑŽÑ‚ выделÑÑ‚ÑŒ памÑÑ‚ÑŒ Ñвыше \$80000000, например, Windows и Linux +% допуÑкают указатели в диапазоне от \$0000000 до \$bfffffff. ЕÑли приводить указатели к знаковым типам, +% могут возникать ошибки Ð¿ÐµÑ€ÐµÐ¿Ð¾Ð»Ð½ÐµÐ½Ð¸Ñ Ð¸ диапазона, кроме того, \$80000000 < \$7fffffff. +% Это может вызывать Ñлучайные ошибки в коде наподобие "if p>q". +type_interface_has_no_guid=04083_E_Тип интерфейÑа $1 не имеет GUID +% При иÑпользовании оператора as нужный интерфейÑ, Ñ‚.е правый операнд оператора as, +% должен иметь правильный GUID. +type_e_invalid_objc_selector_name=04084_E_Ðеверное Ð¸Ð¼Ñ Ñелектора +% Селектор Objective-C не может быть пуÑтым, он должен быть идентификатором либо одиночным двоеточием, +% и, еÑли он Ñодержит двоеточие, то должен двоеточием и заканчиватьÑÑ. +type_e_expected_objc_method_but_got=04085_E_ОжидаетÑÑ Ð¼ÐµÑ‚Ð¾Ð´ Objective-C, но получено $1 +% Селектор может быть Ñоздан только Ð´Ð»Ñ Ð¼ÐµÑ‚Ð¾Ð´Ð¾Ð² Objective-C, никакой другой тип +% процедур/функций/методов не допуÑтим. +type_e_expected_objc_method=04086_E_ОжидаетÑÑ Ð¼ÐµÑ‚Ð¾Ð´ Objective-C или конÑтантное Ð¸Ð¼Ñ Ð¼ÐµÑ‚Ð¾Ð´Ð° +% Селектор может быть Ñоздан только Ð´Ð»Ñ Ð¼ÐµÑ‚Ð¾Ð´Ð¾Ð² Objective-C, либо путем ÑƒÐºÐ°Ð·Ð°Ð½Ð¸Ñ Ð¸Ð¼ÐµÐ½Ð¸ +% в виде Ñтроковой конÑтанты, либо Ñ Ð¸ÑÐ¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ð½Ð¸Ñ Ð¸Ð´ÐµÐ½Ñ‚Ð¸Ñ„Ð¸ÐºÐ°Ñ‚Ð¾Ñ€Ð° метода Objective-C, +% дейÑтвительного в текущей облаÑти видимоÑти. +type_e_no_type_info=04087_E_Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ типе недоÑтупна Ð´Ð»Ñ Ñтого типа +% Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ типе не генерируетÑÑ Ð´Ð»Ñ Ð½ÐµÐºÐ¾Ñ‚Ð¾Ñ€Ñ‹Ñ… типов, таких как перечиÑÐ»ÐµÐ½Ð¸Ñ Ñ Ñ€Ð°Ð·Ñ€Ñ‹Ð²Ð°Ð¼Ð¸ +% в диапазоне значений (Ð²ÐºÐ»ÑŽÑ‡Ð°Ñ Ð¿ÐµÑ€ÐµÑ‡Ð¸ÑлениÑ, у которых нижнÑÑ Ð³Ñ€Ð°Ð½Ð¸Ñ†Ð° диапазона отличаетÑÑ Ð¾Ñ‚ +% нулÑ). +type_e_ordinal_or_string_expr_expected=04088_E_ТребуетÑÑ Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ðµ порÑдкового или Ñтрокового типа +% Выражение должно иметь порÑдковый или Ñтроковый тип. +type_e_string_expr_expected=04089_E_ТребуетÑÑ Ñтроковое выражение +% Выражение должно иметь Ñтроковый тип. +% \end{description} +# +# Symtable +# +# 05064 is the last used one +# +% \section{Symbol handling} +% Данный раздел Ñодержит ÑообщениÑ, отноÑÑщиеÑÑ Ðº обработке Ñимволов, +% Ñ‚.е. вÑего, что ÑвÑзано Ñ Ð¸Ð¼ÐµÐ½Ð°Ð¼Ð¸ процедур и переменных. +% \begin{description} +sym_e_id_not_found=05000_E_Идентификатоp "$1" не найден +% Данный Ñимвол неизвеÑтен компилÑтору. Обычно проиÑходит при ошибках напиÑÐ°Ð½Ð¸Ñ +% имени переменной или процедуры, или еÑли вы забыли объÑвить +% переменную. +sym_f_internal_error_in_symtablestack=05001_F_ВнyÑ‚pеннÑÑ Ð¾ÑˆÐ¸Ð±ÐºÐ° в SymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_Идентификатоp "$1" повторÑетÑÑ +% Указанный идентификатор уже был объÑвлен в текущей облаÑти. +sym_h_duplicate_id_where=05003_H_Идентификатоp yже опpеделен в $1 (ÑÑ‚pока $2) +% Идентификатор уже был объÑвлен в указанной облаÑти. +sym_e_unknown_id=05004_E_HеизвеÑтный идентификатоp "$1" +% Указанный идентификатор не был объÑвлен, либо иÑпользуетÑÑ Ð·Ð° пределами +% облаÑти, Ð´Ð»Ñ ÐºÐ¾Ñ‚Ð¾Ñ€Ð¾Ð¹ он был определен. +sym_e_forward_not_resolved=05005_E_ОтÑутÑтвует Ñ€ÐµÐ°Ð»Ð¸Ð·Ð°Ñ†Ð¸Ñ Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€Ñ‹ или метода "$1" +% Может проиÑходить в двух ÑлучаÑÑ…: +% \begin{itemize} +% \item ЕÑли Ñ„ÑƒÐ½ÐºÑ†Ð¸Ñ Ð¾Ð±ÑŠÑвлена (в Ñекции \var{interface}, либо +% Ñ Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¸Ð²Ð¾Ð¹ \var{forward}, но не реализована. +% \item При ÑÑылке на тип, который не объÑвлен в текущем блоке \var{type}. +% \end{itemize} +sym_e_error_in_type_def=05007_E_Ошибка в опpеделении типа +% Ошибка при определении нового типа маÑÑива: +% \item Одна из границ диапазона ÑвлÑетÑÑ Ð¾ÑˆÐ¸Ð±Ð¾Ñ‡Ð½Ð¾Ð¹. +% Ðапример, \var{Array [1..1.25]} вызовет данную ошибку. +sym_e_forward_type_not_resolved=05009_E_Раннее объÑвление типа "$1" не решено +% Символ был объÑвлен заранее, но определение Ð´Ð»Ñ Ð½ÐµÐ³Ð¾ не было обнаружено. +sym_e_only_static_in_static=05010_E_Только ÑтатичеÑкие переменные могут иÑпользоватьÑÑ Ð² ÑтатичеÑких методах или вне методов +% СтатичеÑкий метод объекта имеет доÑтуп только к ÑтатичеÑким переменным. +sym_f_type_must_be_rec_or_class=05012_F_ОжидаетÑÑ Ñ‚Ð¸Ð¿ record или class +% ÐŸÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ð¸Ð»Ð¸ выражение имеет тип, отличный от \var{record} или \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_ЭкземплÑры клаÑÑов или объектов Ñ Ð°Ð±ÑÑ‚pактным методом не допуÑкаютÑÑ +% Попытка Ñоздать ÑкземплÑÑ€ клаÑÑа Ñ Ð°Ð±Ñтрактным методом, который не был перекрыт. +sym_w_label_not_defined=05014_W_Метка "$1" не опpеделена +% Метка была объÑвлена, но не была определена. +sym_e_label_used_and_not_defined=05015_E_Метка "$1" иÑпользуетÑÑ, но не определена +% Метка была объÑвлена и иÑпользована, но не была определена. +sym_e_ill_label_decl=05016_E_Hевеpное объÑвление метки +% ПроиÑходит, еÑли метка объÑвлена вне процедуры или функции; Ñтого никогда +% не должно ÑлучатьÑÑ. +sym_e_goto_and_label_not_supported=05017_E_GOTO и LABEL не поддеpживаютÑÑ (иÑпользyйте ключ -Sg) +% Программу, Ñодержащую метки и переходы \var{goto}, необходимо компилировать +% Ñ ÐºÐ»ÑŽÑ‡Ð¾Ð¼ \var{-Sg}. По умолчанию, метки и переходы не поддерживаютÑÑ. +sym_e_label_not_found=05018_E_Метка не найдена +% Ð’ÑтретилоÑÑŒ \var{goto label}, но метка не была объÑвлена. +sym_e_id_is_no_label_id=05019_E_Идентификатоp не ÑвлÑетÑÑ Ð¼ÐµÑ‚ÐºÐ¾Ð¹ +% Идентификатор, Ñледующий за \var{goto}, не имеет тип метки. +sym_e_label_already_defined=05020_E_Повтоpное опpеделение метки +% Попытка определить метку дважды. Метка может быть определена только один раз. +sym_e_ill_type_decl_set=05021_E_Ðевеpное объÑвление типа Ñлементов множеÑтва +% ОбъÑвление множеÑтва Ñодержит недопуÑтимое определение типа. +sym_e_class_forward_not_resolved=05022_E_Ранее объÑвление клаÑÑа "$1" не решено +% КлаÑÑ Ð±Ñ‹Ð» объÑвлен, но не был реализован. +sym_n_unit_not_used=05023_H_Модуль "$1" не иÑпользуетÑÑ Ð² $2 +% Модуль, указанный в Ñекции \var{uses}, не иÑпользуетÑÑ. +sym_h_para_identifier_not_used=05024_H_Паpаметp "$1" не иÑпользyетÑÑ +% Идентификатор был объÑвлен (локально или глобально), но +% не был иÑпользован. +sym_n_local_identifier_not_used=05025_N_Ð›Ð¾ÐºÐ°Ð»ÑŒÐ½Ð°Ñ Ð¿ÐµpÐµÐ¼ÐµÐ½Ð½Ð°Ñ "$1" не иÑпользyетÑÑ +% ÐŸÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ð¾Ð±ÑŠÑвлена, но не иÑпользована в реализации процедуры +% или функции. +sym_h_para_identifier_only_set=05026_H_Параметр-значение "$1" приÑвоен, но не иÑпользован +% Параметру приÑвоено значение, которое в дальнейшем нигде не иÑпользуетÑÑ. +sym_n_local_identifier_only_set=05027_N_Ð›Ð¾ÐºÐ°Ð»ÑŒÐ½Ð°Ñ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ "$1" приÑвоена, но не иÑпользована +% Локальной переменной приÑвоено значение, которое в дальнейшем нигде не иÑпользуетÑÑ. +sym_h_local_symbol_not_used=05028_H_Локальный Ñимвол $1 "$2" не иÑпользуетÑÑ +% Локальный Ñимвол не иÑпользуетÑÑ. +sym_n_private_identifier_not_used=05029_N_Private поле "$1.$2" не иÑпользуетÑÑ +% Указанное private поле определено, но не иÑпользуетÑÑ Ð½Ð¸Ð³Ð´Ðµ в коде. +sym_n_private_identifier_only_set=05030_N_Private поле "$1.$2" приÑвоено, но не иÑпользовано +% Указанное private поле определено и ему приÑвоено значение, которое нигде не читаетÑÑ. +sym_n_private_method_not_used=05031_N_Private метод "$1.$2" не иÑпользуетÑÑ +% Указанный private метод определен, но не иÑпользуетÑÑ Ð½Ð¸Ð³Ð´Ðµ в коде. +sym_e_set_expected=05032_E_ОжидаетÑÑ Ñ‚Ð¸Ð¿ множеÑтва +% ÐŸÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ð¸Ð»Ð¸ выражение имеет тип, отличный от \var{set}. Это ÑлучаетÑÑ Ð² +% выражениÑÑ… \var{in}. +sym_w_function_result_not_set=05033_W_Резyльтат Ñ„yнкции, возможно, не приÑвоен +% Предупреждение выдаетÑÑ, еÑли компилÑтор полагает, что результат, возвращаемый функцией, +% не приÑвоен. ЕÑли Ñ„ÑƒÐ½ÐºÑ†Ð¸Ñ Ð½Ð°Ð¿Ð¸Ñана на аÑÑемблере, или Ñодержит аÑÑемблерный блок, +% предупреждение не выдаетÑÑ. +sym_w_wrong_C_pack=05034_W_Тип "$1" некорректно выровнен в текущей запиÑи Ð´Ð»Ñ Ñзыка C +% МаÑÑивы Ñ Ñ€Ð°Ð·Ð¼ÐµÑ€Ð°Ð¼Ð¸, не кратными 4, будут неверно выровнены в Ñтруктурах Ñзыка C. +sym_e_illegal_field=05035_E_HеизвеÑтное поле запиÑи "$1" +% Указанное поле отÑутÑтвует в определении запиÑи. +sym_w_uninitialized_local_variable=05036_W_Ð›Ð¾ÐºÐ°Ð»ÑŒÐ½Ð°Ñ Ð¿ÐµpÐµÐ¼ÐµÐ½Ð½Ð°Ñ "$1" не инициализиpована +% Сообщение выдаетÑÑ, когда компилÑтор Ñчитает, что Ð»Ð¾ÐºÐ°Ð»ÑŒÐ½Ð°Ñ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ð±ÑƒÐ´ÐµÑ‚ +% иÑпользована (Ñ‚.е. вÑтретилаÑÑŒ в правой чаÑти выражениÑ), но не была +% инициализирована (Ñ‚.е. не поÑвлÑлаÑÑŒ ранее в левой чаÑти приÑваиваниÑ). +sym_w_uninitialized_variable=05037_W_ПеpÐµÐ¼ÐµÐ½Ð½Ð°Ñ "$1" не инициализиpована +% Сообщение выдаетÑÑ, когда компилÑтор Ñчитает, что Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ð±ÑƒÐ´ÐµÑ‚ иÑпользована +% (Ñ‚.е. вÑтретилаÑÑŒ в правой чаÑти выражениÑ), но не была инициализирована (Ñ‚.е. +% не поÑвлÑлаÑÑŒ ранее в левой чаÑти приÑваиваниÑ). +sym_e_id_no_member=05038_E_Идентификатоp не определÑет Ñлемент "$1" +% Сообщение выдаетÑÑ Ð¿Ñ€Ð¸ попытке доÑтупа к неопределенному полю запиÑи +% или объекта, либо методу. +sym_h_param_list=05039_H_Hайдено опpеделение: $1 +% При иÑпользовании ключа \var{-vh}, еÑли не найдена Ð¿ÐµÑ€ÐµÐ³Ñ€ÑƒÐ¶ÐµÐ½Ð½Ð°Ñ Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€Ð°, +% перечиÑлÑÑŽÑ‚ÑÑ Ð²Ñе подходÑщие перегруженные процедуры и ÑпиÑки их +% параметров. +sym_e_segment_too_large=05040_E_Слишком большой Ñлемент данных +% ВыдаетÑÑ Ð¿Ñ€Ð¸ попытке объÑвить Ñлемент данных, размер которого превышает +% уÑтановленный предел (2 ГБ Ð´Ð»Ñ Ð¿Ñ€Ð¾Ñ†ÐµÑÑоров 80386+/68020+) +sym_e_no_matching_implementation_found=05042_E_Ðе найдена подходÑÑ‰Ð°Ñ Ñ€ÐµÐ°Ð»Ð¸Ð·Ð°Ñ†Ð¸Ñ Ð¼ÐµÑ‚Ð¾Ð´Ð° интерфейÑа "$1" +% Ðе найден метод, который мог бы реализовать указанный метод интерфейÑа. +% Проверьте типы аргументов и типы возвращаемых значений. +sym_w_deprecated_symbol=05043_W_Символ "$1" уÑтарел +% ИÑпользован Ñимвол (переменнаÑ, процедура и Ñ‚.п.), который был +% объÑвлен как \var{deprecated}. Такой уÑтаревший Ñимвол может быть +% недоÑтупен в новых верÑиÑÑ… Ð¼Ð¾Ð´ÑƒÐ»Ñ / библиотеки. По возможноÑти, +% нужно избегать иÑÐ¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ð½Ð¸Ñ ÑƒÑтаревших Ñимволов. +sym_w_non_portable_symbol=05044_W_Символ "$1" не портабелен +% ИÑпользован Ñимвол (переменнаÑ, процедура и Ñ‚.п.), который был +% объÑвлен как \var{platform}. Значение, иÑпользование и доÑтупноÑÑ‚ÑŒ +% такого Ñимвола завиÑит от платформы. ЕÑли иÑходный код должен быть +% портируемым, иÑпользовать такие Ñимволы не Ñледует. +sym_w_non_implemented_symbol=05055_W_Символ "$1" не реализован +% ИÑпользован Ñимвол (переменнаÑ, процедура и Ñ‚.п.), который был +% объÑвлен как \var{unimplemented}. Этот Ñимвол определен, +% но еще не реализован Ð´Ð»Ñ Ð´Ð°Ð½Ð½Ð¾Ð¹ платформы. +sym_e_cant_create_unique_type=05056_E_Этот тип Ð½ÐµÐ»ÑŒÐ·Ñ Ð¸Ñпользовать Ð´Ð»Ñ Ð¾Ð±ÑŠÑÐ²Ð»ÐµÐ½Ð¸Ñ ÑƒÐ½Ð¸ÐºÐ°Ð»ÑŒÐ½Ð¾Ð³Ð¾ типа +% При объÑвлении уникального типа Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ \var{type newtype = type oldtype;} +% можно иÑпользовать только проÑтые типы (порÑдковые, вещеÑтвенные и Ñтроковые). +sym_h_uninitialized_local_variable=05057_H_Ð›Ð¾ÐºÐ°Ð»ÑŒÐ½Ð°Ñ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ "$1" не инициализирована +% Сообщение выдаетÑÑ, когда компилÑтор Ñчитает, что Ð»Ð¾ÐºÐ°Ð»ÑŒÐ½Ð°Ñ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ð±ÑƒÐ´ÐµÑ‚ +% иÑпользована (Ñ‚.е. вÑтретилаÑÑŒ в правой чаÑти выражениÑ), но не была +% инициализирована (Ñ‚.е. не поÑвлÑлаÑÑŒ ранее в левой чаÑти приÑваиваниÑ). +sym_h_uninitialized_variable=05058_H_ÐŸÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ "$1" не инициализирована +% Сообщение выдаетÑÑ, когда компилÑтор Ñчитает, что Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ð±ÑƒÐ´ÐµÑ‚ +% иÑпользована (Ñ‚.е. вÑтретилаÑÑŒ в правой чаÑти выражениÑ), но не была +% инициализирована (Ñ‚.е. не поÑвлÑлаÑÑŒ ранее в левой чаÑти приÑваиваниÑ). +sym_w_function_result_uninitialized=05059_W_ÐŸÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ñ€ÐµÐ·ÑƒÐ»ÑŒÑ‚Ð°Ñ‚Ð° функции не инициализирована +% Сообщение выдаетÑÑ, когда компилÑтор Ñчитает, что Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ñ€ÐµÐ·ÑƒÐ»ÑŒÑ‚Ð°Ñ‚Ð° +% функции будет иÑпользована (Ñ‚.е. вÑтретилаÑÑŒ в правой чаÑти выражениÑ), +% но не была инициализирована (Ñ‚.е. не поÑвлÑлаÑÑŒ ранее в левой чаÑти +% приÑваиваниÑ). +sym_h_function_result_uninitialized=05060_H_ÐŸÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ñ€ÐµÐ·ÑƒÐ»ÑŒÑ‚Ð°Ñ‚Ð° функции не инициализирована +% Сообщение выдаетÑÑ, когда компилÑтор Ñчитает, что Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ Ñ€ÐµÐ·ÑƒÐ»ÑŒÑ‚Ð°Ñ‚Ð° +% функции будет иÑпользована (Ñ‚.е. вÑтретилаÑÑŒ в правой чаÑти выражениÑ), +% но не была инициализирована (Ñ‚.е. не поÑвлÑлаÑÑŒ ранее в левой чаÑти +% приÑваиваниÑ). +sym_w_identifier_only_read=05061_W_ÐŸÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ð°Ñ "$1" читаетÑÑ, но не приÑвоена +% Значение переменной ÑчитываетÑÑ, но нигде не приÑваиваетÑÑ. +sym_h_abstract_method_list=05062_H_Ðайден абÑтрактный метод: $1 +% При выдаче Ð¿Ñ€ÐµÐ´ÑƒÐ¿Ñ€ÐµÐ¶Ð´ÐµÐ½Ð¸Ñ Ð¾ Ñоздании клаÑÑа/объекта Ñ Ð°Ð±Ñтрактными методами +% Ñта подÑказка облегчает поиÑк проблемного метода. +sym_w_experimental_symbol=05063_W_Символ "$1" ÑвлÑетÑÑ ÑкÑпериментальным +% ИÑпользован Ñимвол (переменнаÑ, процедура и Ñ‚.п.), который был +% объÑвлен как \var{experimental}. ЭкÑпериментальные Ñимволы могут +% иÑчезнуть или изменить поведение в будущей верÑии. ИÑÐ¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ð½Ð¸Ñ +% таких Ñимволов Ñледует по возможноÑти избегать. +sym_w_forward_not_resolved=05064_W_Ранее объÑвление "$1" не разрешилоÑÑŒ, предполагаетÑÑ external +% ПроиÑходит, еÑли Ñ„ÑƒÐ½ÐºÑ†Ð¸Ñ Ð±Ñ‹Ð»Ð° объÑвлена в Ñекции \var{interface} Ð¼Ð¾Ð´ÑƒÐ»Ñ Ð² режиме macpas, +% но не была реализована. +% \end{description} + +# +# Кодогенератор +# +# 06049 номер поÑледнего ÑÐ¾Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ +# +% \section{Code generator messages} +% Раздел Ñодержит ÑообщениÑ, которые могут быть выданы при ошибках +% кодогенерации. +% \begin{description} +cg_e_parasize_too_big=06009_E_Размеp ÑпиÑка паpаметpов пpевышает 65535 байт +% ПроцеÑÑор I386 ограничивает ÑпиÑок параметров до 65535 байт (из-за оÑобенноÑти +% инÑтрукции \var{RET}) +cg_e_file_must_call_by_reference=06012_E_Файловые типы Ñледует передавать по ÑÑылке +% Файлы Ð½ÐµÐ»ÑŒÐ·Ñ Ð¿ÐµÑ€ÐµÐ´Ð°Ð²Ð°Ñ‚ÑŒ по значению, Ñ‚.е. они вÑегда должны быть объÑвлены +% как \var{var} параметры. +cg_e_cant_use_far_pointer_there=06013_E_ИÑпользование FAR yÐºÐ°Ð·Ð°Ñ‚ÐµÐ»Ñ Ð·Ð´ÐµÑÑŒ недопуÑтимо +% Free Pascal не поддерживает дальние указатели, поÑтому невозможно взÑÑ‚ÑŒ Ð°Ð´Ñ€ÐµÑ +% выражениÑ, в результате которого получитÑÑ Ð´Ð°Ð»ÑŒÐ½Ð¸Ð¹ указатель. КонÑÑ‚Ñ€ÑƒÐºÑ†Ð¸Ñ \var{mem} +% ÑвлÑетÑÑ Ð¿Ñ€Ð¸Ð¼ÐµÑ€Ð¾Ð¼ такого выражениÑ, поÑтому Ñледующий код вызовет данную ошибку: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_Вызов EXPORT функции невозможен +% Больше не иÑпользуетÑÑ. +cg_w_member_cd_call_from_method=06016_W_Возможно, неверный вызов конÑÑ‚pyктоpа или деÑÑ‚pyктоpа +% Обнаружен вызов конÑтруктора или деÑтруктора из метода. Это, Ñкорее вÑего, приведет к +% проблемам, Ñ‚.к. Ð´Ð»Ñ ÐºÐ¾Ð½Ñтрукторов/деÑтрукторов требуютÑÑ Ð¾Ñобые параметры. +cg_n_inefficient_code=06017_N_HеÑффективный код +% ÐапиÑÐ°Ð½Ð½Ð°Ñ Ð²Ð°Ð¼Ð¸ конÑÑ‚Ñ€ÑƒÐºÑ†Ð¸Ñ ÐºÐ°Ð¶ÐµÑ‚ÑÑ ÐºÐ¾Ð¼Ð¿Ð¸Ð»Ñтору очень Ñомнительной. +cg_w_unreachable_code=06018_W_HедоÑтижимый код +% ÐапиÑÐ°Ð½Ð½Ð°Ñ ÐºÐ¾Ð½ÑÑ‚Ñ€ÑƒÐºÑ†Ð¸Ñ Ð½Ð¸ÐºÐ¾Ð³Ð´Ð° не будет выполнена. Пример: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_ÐбÑÑ‚pактные методы Ð½ÐµÐ»ÑŒÐ·Ñ Ð²Ñ‹Ð·Ñ‹Ð²Ð°Ñ‚ÑŒ напpÑмyÑŽ +% ÐбÑтрактный метод Ð½ÐµÐ»ÑŒÐ·Ñ Ð²Ñ‹Ð·Ð²Ð°Ñ‚ÑŒ непоÑредÑтвенно, вмеÑто него Ñледует вызывать +% перекрывающий метод потомка, потому что абÑтрактный метод не имеет реализации. +cg_d_register_weight=06027_DL_РегиÑÑ‚p $1 Ð²ÐµÑ $2 $3 +% Отладочное Ñообщение. ВыводитÑÑ, когда компилÑтор раÑÑматривает возможноÑÑ‚ÑŒ +% Ñ€Ð°Ð·Ð¼ÐµÑ‰ÐµÐ½Ð¸Ñ Ð¿ÐµÑ€ÐµÐ¼ÐµÐ½Ð½Ñ‹Ñ… в региÑтрах. +cg_d_stackframe_omited=06029_DL_Кадр Ñтека не Ñоздан (не требуетÑÑ) +% Ðекоторым процедурам/функциÑм не требуетÑÑ Ð¿Ð¾Ð»Ð½Ñ‹Ð¹ кадр Ñтека, и его можно опуÑтить. +% Сообщение выводитÑÑ Ð¿Ñ€Ð¸ иÑпользовании ключа \var{-vd}. +cg_e_unable_inline_object_methods=06031_E_Методы объектах или клаÑÑов не могут быть вÑтраиваемыми (inline) +% Методы объекта Ð½ÐµÐ»ÑŒÐ·Ñ Ð²Ñтраивать. +cg_e_unable_inline_procvar=06032_E_Вызовы процедурных переменных не могуг быть вÑтраиваемыми (inline) +% Вызов процедурной переменной не может быть вÑтроен. +cg_e_no_code_for_inline_stored=06033_E_Hет кода Ð´Ð»Ñ inline +% КомпилÑтор не Ñмог Ñохранить код Ð´Ð»Ñ Ð²Ñтраиваемой процедуры. +cg_e_can_access_element_zero=06035_E_Hyлевой Ñлемент ansi/wide- ÑÑ‚pоки недоÑÑ‚yпен, иÑпользyйте (set)length +% Ð”Ð»Ñ Ð¸Ð·Ð¼ÐµÐ½ÐµÐ½Ð¸Ñ Ð´Ð»Ð¸Ð½Ñ‹ Ñтроки типа ansi/wide/longstring Ñледует иÑпользовать +% процедуру \var{setlength}, а Ð´Ð»Ñ Ð¿Ð¾Ð»ÑƒÑ‡ÐµÐ½Ð¸Ñ - функцию \var{length}. +cg_e_cannot_call_cons_dest_inside_with=06037_E_КонÑÑ‚pyктоp или деÑÑ‚pyктоp Ð½ÐµÐ»ÑŒÐ·Ñ Ð²Ñ‹Ð·Ñ‹Ð²Ð°Ñ‚ÑŒ внyÑ‚pи выражений 'WITH' +% Внутри конÑтрукции \var{With} вызов конÑтруктора или деÑтруктора Ð´Ð»Ñ Ð¾Ð±ÑŠÐµÐºÑ‚Ð°-аргумента +% \var{with} невозможен. +cg_e_cannot_call_message_direct=06038_E_HепоÑредÑтвенный вызов метода-обpаботчика Ñобытий невозможен +% A message method handler method can't be called directly if it contains an +% explicit self argument +cg_e_goto_inout_of_exception_block=06039_E_Переход через границу блока иÑключений +% Переход внутрь блока обработки иÑключений \var{try..finally..end;} или из него не допуÑкаетÑÑ: +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // в Ñтой Ñтроке будет ошибка +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_УправлÑющие Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ (break, continue и exit) недопуÑтимы в блоке finally +% ИÑпользование выражений, изменÑющих ход Ð²Ñ‹Ð¿Ð¾Ð»Ð½ÐµÐ½Ð¸Ñ (\var{break}, +% \var{continue} и \var{exit}), не допуÑкаетÑÑ +% внутри блока finally. Следующий код вызовет ошибку: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // Этот exit недопуÑтим +% end; +% ... +% +% \end{verbatim} +% ЕÑли при выполнении процедура \var{p} проиÑходит иÑключение, выполнÑетÑÑ Ð±Ð»Ð¾Ðº +% finally. ЕÑли выполнение доходит до exit, непонÑтно что делать: +% выходить из процедури или иÑкать другой обработчик иÑключений. +cg_w_parasize_too_big=06041_W_Размер параметров превышает предел Ð´Ð»Ñ Ð½ÐµÐºÐ¾Ñ‚Ð¾Ñ€Ñ‹Ñ… процеÑÑоров +% Означает, что было объÑвлено более 64 кБайт параметров, что +% может не поддерживатьÑÑ Ð¿Ñ€Ð¸ компилÑции Ð´Ð»Ñ Ð´Ñ€ÑƒÐ³Ð¸Ñ… платформ. +cg_w_localsize_too_big=06042_W_Размер локальных переменных превышает предел Ð´Ð»Ñ Ð½ÐµÐºÐ¾Ñ‚Ð¾Ñ€Ñ‹Ñ… процеÑÑоров +% Означает, что было объÑвлено более 32 кБайт локальных переменных, что +% может не поддерживатьÑÑ Ð¿Ñ€Ð¸ компилÑции Ð´Ð»Ñ Ð´Ñ€ÑƒÐ³Ð¸Ñ… платформ. +cg_e_localsize_too_big=06043_E_Размер локальных переменных превышает допуÑтимый предел +% Означает, что объÑвлено более 32 кБайт локальных переменных, что +% не поддерживаетÑÑ Ð´Ð»Ñ Ð´Ð°Ð½Ð½Ð¾Ð³Ð¾ процеÑÑора. +cg_e_break_not_allowed=06044_E_BREAK недопуÑтимо +% Попытка иÑÐ¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ð½Ð¸Ñ \var{break} вне конÑтрукции цикла. +cg_e_continue_not_allowed=06045_E_CONTINUE недопуÑтимо +% Попытка иÑÐ¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ð½Ð¸Ñ \var{continue} вне конÑтрукции цикла. +cg_f_unknown_compilerproc=06046_F_ÐеизвеÑÑ‚Ð½Ð°Ñ Ð²Ð½ÑƒÑ‚Ñ€ÐµÐ½Ð½ÑÑ Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€Ð° "$1". Проверьте верÑию библиотеки RTL. +% КомпилÑтор ожидает, что библиотека времени Ð²Ñ‹Ð¿Ð¾Ð»Ð½ÐµÐ½Ð¸Ñ (RTL) Ñодержит определенные процедуры. ЕÑли +% вы видите Ñто Ñообщение, не занимаÑÑÑŒ ÑамоÑтоÑтельной модификацией кода библиотеки RTL, то, Ñкорее +% вÑего, иÑÐ¿Ð¾Ð»ÑŒÐ·ÑƒÐµÐ¼Ð°Ñ Ð±Ð¸Ð±Ð»Ð¸Ð¾Ñ‚ÐµÐºÐ° RTL не ÑоответÑтвует компилÑтору. ЕÑли же вы модифицировали RTL, значит, +% вы удалили процедуру, ÐºÐ¾Ñ‚Ð¾Ñ€Ð°Ñ Ð½ÑƒÐ¶Ð½Ð° компилÑтору Ð´Ð»Ñ Ð²Ð½ÑƒÑ‚Ñ€ÐµÐ½Ð½ÐµÐ³Ð¾ иÑпользованиÑ. +cg_f_unknown_system_type=06047_F_Ðе найден ÑиÑтемный тип "$1". Проверьте верÑию библиотеки RTL. +% КомпилÑтор ожидает, что библиотека времени Ð²Ñ‹Ð¿Ð¾Ð»Ð½ÐµÐ½Ð¸Ñ (RTL) Ñодержит определенные объÑÐ²Ð»ÐµÐ½Ð¸Ñ +% типов. ЕÑли вы видите Ñто Ñообщение, не занимаÑÑÑŒ ÑамоÑтоÑтельной модификацией кода библиотеки RTL, то, +% Ñкорее вÑего, иÑÐ¿Ð¾Ð»ÑŒÐ·ÑƒÐµÐ¼Ð°Ñ Ð±Ð¸Ð±Ð»Ð¸Ð¾Ñ‚ÐµÐºÐ° RTL не ÑоответÑтвует компилÑтору. ЕÑли же вы модифицировали RTL, +% значит, вы удалили тип, нужный компилÑтору Ð´Ð»Ñ Ð²Ð½ÑƒÑ‚Ñ€ÐµÐ½Ð½ÐµÐ³Ð¾ иÑпользованиÑ. +cg_h_inherited_ignored=06048_H_Вызов абÑтрактного метода поÑредÑтвом inherited игнорирован +% Сообщение выдаетÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ в режиме Delphi, при попытке вызвать абÑтрактный метод +% родительÑкого клаÑÑа Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ \var{inherited;}. Такой вызов игнорируетÑÑ. +cg_e_goto_label_not_found=06049_E_Метка "$1" не определена или удалена оптимизацией +% Метка, иÑÐ¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ð½Ð½Ð°Ñ Ð² goto, не определена либо была удалена при удалении +% недоÑтупного кода. +% \end{description} +# EndOfTeX + +# +# Assembler reader +# +# 07107 is the last used one +# +asmr_d_start_reading=07000_DL_Hачало Ñ‡Ñ‚ÐµÐ½Ð¸Ñ Ð°ÑÑемблеpа типа $1 +% Информирует о начале Ñ‡Ñ‚ÐµÐ½Ð¸Ñ Ð°ÑÑемблерного блока. +asmr_d_finish_reading=07001_DL_Конец Ñ‡Ñ‚ÐµÐ½Ð¸Ñ Ð°ÑÑемблеpа типа $1 +% Информирует о завершении Ñ‡Ñ‚ÐµÐ½Ð¸Ñ Ð°ÑÑемблерного блока. +asmr_e_none_label_contain_at=07002_E_Токен, не ÑвлÑющийÑÑ Ð¼ÐµÑ‚ÐºÐ¾Ð¹, Ñодеpжит @ +% Идентификатор, не ÑвлÑющийÑÑ Ð¼ÐµÑ‚ÐºÐ¾Ð¹, не может Ñодержать Ñимвол @. +asmr_e_building_record_offset=07004_E_Ошибка поÑÑ‚pÐ¾ÐµÐ½Ð¸Ñ ÑÐ¼ÐµÑ‰ÐµÐ½Ð¸Ñ Ð² запиÑи +% Ошибка вычиÑÐ»ÐµÐ½Ð¸Ñ ÑÐ¼ÐµÑ‰ÐµÐ½Ð¸Ñ Ð² запиÑи/объекте, может проиÑходить, еÑли +% поле не указано вообще или иÑпользован неизвеÑтный идентификатор полÑ. +asmr_e_offset_without_identifier=07005_E_ИÑпользование OFFSET без идентификатоpа +% Ключевое Ñлово OFFSET можно иÑпользовать только ÑовмеÑтно Ñ Ð¸Ð´ÐµÐ½Ñ‚Ð¸Ñ„Ð¸ÐºÐ°Ñ‚Ð¾Ñ€Ð¾Ð¼. +% Другие ÑинтакÑиÑÑ‹ не поддерживаютÑÑ. +asmr_e_type_without_identifier=07006_E_ИÑпользование TYPE без идентификатоpа +% Ключевое Ñлово TYPE можно иÑпользовать только ÑовмеÑтно Ñ Ð¸Ð´ÐµÐ½Ñ‚Ð¸Ñ„Ð¸ÐºÐ°Ñ‚Ð¾Ñ€Ð¾Ð¼. +% Другие ÑинтакÑиÑÑ‹ не поддерживаютÑÑ. +asmr_e_no_local_or_para_allowed=07007_E_ЗдеÑÑŒ Ð½ÐµÐ»ÑŒÐ·Ñ Ð¸Ñпользовать локальные пеpеменные или паpаметpÑ‹ +% Локальные переменные и параметры обычно адреÑуютÑÑ ÐºÐ°Ðº Ñмещение от региÑтра +% %ebp, поÑтому их Ð°Ð´Ñ€ÐµÑ Ð½Ðµ может быть получен непоÑредÑтвенно. +asmr_e_need_offset=07008_E_ЗдеÑÑŒ необходимо иÑпользовать OFFSET +% Ð”Ð»Ñ Ð¿Ð¾Ð»ÑƒÑ‡ÐµÐ½Ð¸Ñ Ð°Ð´Ñ€ÐµÑа данного идентификатора необходимо иÑпользовать OFFSET <id>. +asmr_e_need_dollar=07009_E_ЗдеÑÑŒ необходимо иÑпользовать знак доллара ('$') +% Ð”Ð»Ñ Ð¿Ð¾Ð»ÑƒÑ‡ÐµÐ½Ð¸Ñ Ð°Ð´Ñ€ÐµÑа данного иденификатора необходимо иÑпользовать $<id>. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_Hе допуÑкаютÑÑ Ð¼Ð½Ð¾Ð¶ÐµÑтвенные пеpемещаемые Ñимволы +% Ðе допуÑкаетÑÑ Ð±Ð¾Ð»ÐµÐµ одного перемещаемого Ñимвола (переменнаÑ/Ñ‚Ð¸Ð¿Ð¸Ð·Ð¸Ñ€Ð¾Ð²Ð°Ð½Ð½Ð°Ñ ÐºÐ¾Ð½Ñтанта) +% в одном аргументе. +asmr_e_only_add_relocatable_symbol=07011_E_Пеpемещаемый Ñимвол допуÑкает только Ñложение +% Перемещаемые Ñимволы (переменные/типизированные конÑтанты) не могут быть иÑпользованы Ñ Ð´Ñ€ÑƒÐ³Ð¸Ð¼Ð¸ +% операторами. ДопуÑкаетÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ Ñложение. +asmr_e_invalid_constant_expression=07012_E_Hеверное конÑтантное выpажение +% Ошибка в конÑтантном выражении. +asmr_e_relocatable_symbol_not_allowed=07013_E_Пеpемещаемый Ñимвол здеÑÑŒ не pазpешен +% Ð’ данном меÑте не может быть иÑпользован перемещаемый Ñимвол (переменнаÑ/Ñ‚Ð¸Ð¿Ð¸Ð·Ð¸Ñ€Ð¾Ð²Ð°Ð½Ð½Ð°Ñ ÐºÐ¾Ð½Ñтанта). +asmr_e_invalid_reference_syntax=07014_E_Hевеpный ÑинтакÑÐ¸Ñ ÑÑылки +% СинтакÑичеÑÐºÐ°Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ° в запиÑи ÑÑылки. +asmr_e_local_para_unreachable=07015_E_$1 недоÑтупно из Ñтого кода +% Во вложенной процедуре невозможен прÑмой доÑтуп к значенÑм локальных переменных или параметров +% внешней процедуры (кроме ÑлучаÑ, когда Ð²Ð»Ð¾Ð¶ÐµÐ½Ð½Ð°Ñ Ð¿Ñ€Ð¾Ñ†ÐµÐ´ÑƒÑ€Ð° Ñама не имеет параметров и локальных +% переменных). +asmr_e_local_label_not_allowed_as_ref=07016_E_Локальные Ñимволы или метки Ð½ÐµÐ»ÑŒÐ·Ñ Ð¸Ñпользовать как ÑÑылки +% Ð’Ñ‹ не можете иÑпользовать локальные Ñимволы или метки как ÑÑылки +asmr_e_wrong_base_index=07017_E_Hевеpное иÑпользование региÑтров базы и индекÑа +% Ошибка при иÑпользовании региÑтров базы и индекÑа +asmr_w_possible_object_field_bug=07018_W_Ð’Ð¾Ð·Ð¼Ð¾Ð¶Ð½Ð°Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ° в обработке Ð¿Ð¾Ð»Ñ Ð¾Ð±ÑŠÐµÐºÑ‚Ð° +% ÐŸÐ¾Ð»Ñ ÐºÐ»Ð°ÑÑов/объектов недоÑтупны напрÑмую в режимах fpc и objfpc, +% но в режимах TP и Delphi имена полей обрабатываютÑÑ ÐºÐ°Ðº обычные ÑмещениÑ. +asmr_e_wrong_scale_factor=07019_E_Hевеpный множитель +% Указан неверный множитель, разрешены только Ð·Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ 1,2,4 и 8 +asmr_e_multiple_index=07020_E_МножеÑтвенное иÑпользование индекÑного pегиÑÑ‚pа +% Попытка иÑÐ¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ð½Ð¸Ñ Ð±Ð¾Ð»ÐµÐµ чем одного индекÑного региÑтра. +asmr_e_invalid_operand_type=07021_E_Hевеpный тип опеpанда +% Тип операнда не ÑоответÑтвует коду команды. +asmr_e_invalid_string_as_opcode_operand=07022_E_Стpока непригодна в качеÑтве опеpанда инÑтрукции: $1 +% Строка, ÑƒÐºÐ°Ð·Ð°Ð½Ð½Ð°Ñ ÐºÐ°Ðº операнд, некорректна Ð´Ð»Ñ Ð´Ð°Ð½Ð½Ð¾Ð¹ команды. +asmr_w_CODE_and_DATA_not_supported=07023_W_@CODE и @DATA не поддеpживаютÑÑ +% @CODE и @DATA не поддерживаютÑÑ Ð¸ игнорируютÑÑ. +asmr_e_null_label_ref_not_allowed=07024_E_СÑылки на безымÑнные метки не допуÑкаютÑÑ +asmr_e_expr_zero_divide=07025_E_Деление на ноль в выражении аÑÑемблера +% Ð’ конÑтантном выражении ÑодержитÑÑ Ð´ÐµÐ»ÐµÐ½Ð¸Ðµ на ноль +asmr_e_expr_illegal=07026_E_Ðеверное выражение +% КонÑтантное выражение неверно +asmr_e_escape_seq_ignored=07027_E_Escape-поÑледовательноÑÑ‚ÑŒ игноpиpована: $1 +% Ð’ Ñтроке ÑÑ‚Ð¸Ð»Ñ Ñзыка C ÑодержитÑÑ Ð½ÐµÐ¸Ð·Ð²ÐµÑÑ‚Ð½Ð°Ñ escape-поÑледовательноÑÑ‚ÑŒ, +% ÐºÐ¾Ñ‚Ð¾Ñ€Ð°Ñ Ð¸Ð³Ð½Ð¾Ñ€Ð¸Ñ€ÑƒÐµÑ‚ÑÑ. +asmr_e_invalid_symbol_ref=07028_E_HевеpÐ½Ð°Ñ ÑÑылка на Ñимвол +asmr_w_fwait_emu_prob=07029_W_FWAIT может вызвать пpоблемы ÑмyлÑции Ñ EMU387 +asmr_w_fadd_to_faddp=07030_W_$1 без операнда транÑлируетÑÑ Ð² $1P +asmr_w_enter_not_supported_by_linux=07031_W_ИнÑÑ‚Ñ€ÑƒÐºÑ†Ð¸Ñ ENTER не поддерживаетÑÑ Ñдром Linux +% ИнÑÑ‚Ñ€ÑƒÐºÑ†Ð¸Ñ ENTER может привеÑти к ошибке защиты Ñтраницы Ñтека, ÐºÐ¾Ñ‚Ð¾Ñ€Ð°Ñ Ð½ÐµÐºÐ¾Ñ€Ñ€ÐµÐºÑ‚Ð½Ð¾ +% "ловитÑÑ" обработчиком в i386 Linux. +asmr_w_calling_overload_func=07032_W_Вызов пеpегpyженной Ñ„yнкции в аÑÑемблеpе +% Вызов перегруженной функции из аÑÑемблерного блока, +% как правило, ÑвлÑетÑÑ Ð¿Ñ€Ð¸Ð·Ð½Ð°ÐºÐ¾Ð¼ проблемы. +asmr_e_unsupported_symbol_type=07033_E_Hе поддеpживаемый тип Ñимвола Ð´Ð»Ñ Ð¾Ð¿Ðµpанда +asmr_e_constant_out_of_bounds=07034_E_Значение конÑтанты вне диапазона +asmr_e_error_converting_decimal=07035_E_"$1" не ÑвлÑетÑÑ Ð´ÐµÑÑтичным чиÑлом +% Ðеверный ÑинтакÑÐ¸Ñ Ð´ÐµÑÑтичного чиÑла. +asmr_e_error_converting_octal=07036_E_"$1" не ÑвлÑетÑÑ Ð²Ð¾Ñьмеpичным чиÑлом +% Ðеверный ÑинтакÑÐ¸Ñ Ð²Ð¾Ñьмеричного чиÑла. +asmr_e_error_converting_binary=07037_E_"$1" не ÑвлÑетÑÑ Ð´Ð²Ð¾Ð¸Ñ‡Ð½Ñ‹Ð¼ чиÑлом +% Ðеверный ÑинтакÑÐ¸Ñ Ð´Ð²Ð¾Ð¸Ñ‡Ð½Ð¾Ð³Ð¾ чиÑла. +asmr_e_error_converting_hexadecimal=07038_E_"$1" не ÑвлÑетÑÑ ÑˆÐµÑтнадцатеpичным чиÑлом +% Ðеверный ÑинтакÑÐ¸Ñ ÑˆÐµÑтнадцатеричного чиÑла. +asmr_h_direct_global_to_mangled=07039_H_$1 пpеобpазовано в $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 ÑвÑзано Ñ Ð¿Ðµpегpyженной Ñ„yнкцией +asmr_e_cannot_use_SELF_outside_a_method=07041_E_Hе допуÑкаетÑÑ Ð¸Ñпользование SELF вне метода +% ÐедопуÑÑ‚Ð¸Ð¼Ð°Ñ ÑÑылка на Ñимвол \var{self}. +% Ðа \var{self} можно ÑÑылатьÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ в методах. +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_Hе допуÑкаетÑÑ Ð¸Ñпользование OLDEBP вне вложенной пpоцедypÑ‹ +% ÐедопуÑÑ‚Ð¸Ð¼Ð°Ñ ÑÑылка на Ñимвол \var{oldebp}. +% Ðа \var{oldebp} можно ÑÑылатьÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ во вложенных процедурах. +asmr_e_void_function=07043_W_Проецедуры не могут возвpащать Ð·Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ Ð¸Ð· аÑÑемблерного кода +% Попытка вернуть значение из процедуры. Процедура не может возвращать значениÑ. +asmr_e_SEG_not_supported=07044_E_SEG не поддеpживаетÑÑ +asmr_e_size_suffix_and_dest_dont_match=07045_E_СyÑ„Ñ„Ð¸ÐºÑ pазмеpа не ÑоответÑтвует размеру операндов +% Размер региÑтра и ÑÑƒÑ„Ñ„Ð¸ÐºÑ Ñ€Ð°Ð·Ð¼ÐµÑ€Ð° в коде команды не ÑоответÑвуют. Скорее вÑего, +% команда аÑÑемблера запиÑана Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ¾Ð¹. +asmr_w_size_suffix_and_dest_dont_match=07046_W_СyÑ„Ñ„Ð¸ÐºÑ pазмеpа не ÑоответÑтвует размеру операндов +% Размер региÑтра и ÑÑƒÑ„Ñ„Ð¸ÐºÑ Ñ€Ð°Ð·Ð¼ÐµÑ€Ð° в коде команды не ÑоответÑвуют. Скорее вÑего, +% команда аÑÑемблера запиÑана Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ¾Ð¹. +asmr_e_syntax_error=07047_E_СинтакÑичеÑÐºÐ°Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ° аÑÑемблера +% СинтакÑичеÑÐºÐ°Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ° аÑÑемблера +asmr_e_invalid_opcode_and_operand=07048_E_HевеpÐ½Ð°Ñ ÐºÐ¾Ð¼Ð±Ð¸Ð½Ð°Ñ†Ð¸Ñ ÐºÐ¾Ð¼Ð°Ð½Ð´Ñ‹ и опеpандов +% Ð”Ð°Ð½Ð½Ð°Ñ ÐºÐ¾Ð¼Ð°Ð½Ð´Ð° не может иметь операнды данного типа. +asmr_e_syn_operand=07049_E_СинтакÑичеÑÐºÐ°Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ° аÑÑемблера в опеpанде +asmr_e_syn_constant=07050_E_СинтакÑичеÑÐºÐ°Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ° аÑÑемблера в конÑтанте +asmr_e_invalid_string_expression=07051_E_Hевеpное ÑÑ‚pоковое выpажение +asmr_w_const32bit_for_address=07052_W_конÑтанта Ñ Ñимволом $1 Ð´Ð»Ñ Ð°Ð´Ñ€ÐµÑа, размер которого отличаетÑÑ Ð¾Ñ‚ ÑƒÐºÐ°Ð·Ð°Ñ‚ÐµÐ»Ñ +% КонÑтантное выражение, предÑтавлÑющее адреÑ, не умещаетÑÑ Ð² диапазон указателÑ. +% ÐдреÑ, Ñкорее вÑего, неверен. +asmr_e_unknown_opcode=07053_E_ÐеизвеÑтный код операции $1 +% ÐеизвеÑÑ‚Ð½Ð°Ñ ÐºÐ¾Ð¼Ð°Ð½Ð´Ð° аÑÑемблера +asmr_e_invalid_or_missing_opcode=07054_E_HевеpÐ½Ð°Ñ Ð¸Ð»Ð¸ пpопyÑ‰ÐµÐ½Ð½Ð°Ñ Ð¾Ð¿ÐµÑ€Ð°Ñ†Ð¸Ñ +asmr_e_invalid_prefix_and_opcode=07055_E_HевеpÐ½Ð°Ñ ÐºÐ¾Ð¼Ð±Ð¸Ð½Ð°Ñ†Ð¸Ñ Ð¿pефикÑа и операции: $1 +asmr_e_invalid_override_and_opcode=07056_E_HевеpÐ½Ð°Ñ ÐºÐ¾Ð¼Ð±Ð¸Ð½Ð°Ñ†Ð¸Ñ Ð¿ÐµpеопpÐµÐ´ÐµÐ»ÐµÐ½Ð¸Ñ Ð¸ операции: $1 +asmr_e_too_many_operands=07057_E_Слишком много опеpандов в ÑÑ‚pоке +% Слишком много операндов Ð´Ð»Ñ Ð´Ð°Ð½Ð½Ð¾Ð¹ команды. Проверьте ÑинтакÑиÑ. +asmr_w_near_ignored=07058_W_Директива NEAR игноpиpована +asmr_w_far_ignored=07059_W_Директива FAR игноpиpована +asmr_e_dup_local_sym=07060_E_Повтоpное опpеделение локального Ñимвола $1 +asmr_e_unknown_local_sym=07061_E_HеизвеÑтный локальный Ñимвол $1 +asmr_e_unknown_label_identifier=07062_E_HеизвеÑÑ‚Ð½Ð°Ñ Ð¼ÐµÑ‚ÐºÐ° $1 +asmr_e_invalid_register=07063_E_Ðеверное Ð¸Ð¼Ñ Ñ€ÐµÐ³Ð¸Ñтра +% There is an unknown register name used as operand. +asmr_e_invalid_fpu_register=07064_E_Hеверное Ð¸Ð¼Ñ pегиÑÑ‚pа Ð´Ð»Ñ Ð¾Ð¿Ðµpации Ñ Ð¿Ð»Ð°Ð²Ð°ÑŽÑ‰ÐµÐ¹ запÑтой +% Было иÑпользовано неизвеÑтное Ð¸Ð¼Ñ Ñ€ÐµÐ³Ð¸Ñтра. +asmr_w_modulo_not_supported=07066_W_MODULO не поддеpживаетÑÑ +asmr_e_invalid_float_const=07067_E_HевеpÐ½Ð°Ñ Ð²ÐµÑ‰ÐµÑÑ‚Ð²ÐµÐ½Ð½Ð°Ñ ÐºÐ¾Ð½Ñтанта $1 +% КонÑтанта Ñ Ð¿Ð»Ð°Ð²Ð°ÑŽÑ‰ÐµÐ¹ запÑтой, объÑÐ²Ð»ÐµÐ½Ð½Ð°Ñ Ð² аÑÑемблерном блоке, неверна. +asmr_e_invalid_float_expr=07068_E_Hевеpное вещеÑтвенное выpажение +% Выражение Ñ Ð¿Ð»Ð°Ð²Ð°ÑŽÑ‰ÐµÐ¹ запÑтой, объÑвленное в аÑÑемблерном блоке, неверно. +asmr_e_wrong_sym_type=07069_E_Hевеpный тип Ñимвола +asmr_e_cannot_index_relative_var=07070_E_HÐµÐ»ÑŒÐ·Ñ Ð¸Ð½Ð´ÐµÐºÑиpовать локальнyÑŽ пеpеменнyÑŽ или паpаметp Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ pегиÑÑ‚pа +% Базовый региÑÑ‚Ñ€ иÑпользуетÑÑ Ð´Ð»Ñ Ð¸Ð½Ð´ÐµÐºÑации Ñимвола, который уже ÑвлÑетÑÑ Ð¾Ñ‚Ð½Ð¾Ñительным +% по отношению к региÑтру. Это невозможно, и навернÑка приведет к ошибке при выполнении. +asmr_e_invalid_seg_override=07071_E_Hевеpное выpажение пеpеопpÐµÐ´ÐµÐ»ÐµÐ½Ð¸Ñ Ñегмента +asmr_w_id_supposed_external=07072_W_Идентификатоp $1, пpедположительно, внешний +% СÑылка не неопределенный Ñимвол.Это не ÑвлÑетÑÑ Ð¾ÑˆÐ¸Ð±ÐºÐ¾Ð¹, +% Ñ‚.к. Ñимвол может иметь внешнее определение, но может привеÑти к проблемам +% при компоновке, еÑли Ñимвол не был определен где-нибудь еще. +asmr_e_string_not_allowed_as_const=07073_E_HÐµÐ»ÑŒÐ·Ñ Ð¸Ñпользовать ÑÑ‚pоки как конÑтанты +% Строки Ñимволов Ð½ÐµÐ»ÑŒÐ·Ñ Ð¸Ñпользовать в качеÑтве конÑтант. +asmr_e_no_var_type_specified=07074_Ðе указан тип пеpеменной +% СинтакÑÐ¸Ñ Ð¿Ñ€ÐµÐ´Ð¿Ð¾Ð»Ð°Ð³Ð°ÐµÑ‚ Ð¸Ð¼Ñ Ñ‚Ð¸Ð¿Ð° поÑле точки, но оно не было обнаружено. +asmr_w_assembler_code_not_returned_to_text=07075_E_ÐÑÑемблеpный код не возвpащаетÑÑ Ð² Ñегмент TEXT +% Ð’ аÑÑемблерном блоке была директива Ñмены Ñекций, но в конце блока отÑутÑтвует директива +% возврата в Ñегмент текÑта. Может быть причиной ошибок при компоновке. +asmr_e_not_directive_or_local_symbol=07076_E_$1 не ÑвлÑетÑÑ Ð´Ð¸pективой или локальным Ñимволом +% Указанный Ñимвол неизвеÑтен. +asmr_w_using_defined_as_local=07077_E_ИÑпользование опpеделенного имени в качеÑтве локальной метки +asmr_e_dollar_without_identifier=07078_E_Символ '$' иÑпользyетÑÑ Ð±ÐµÐ· идентификатоpа +% Ð’ конÑтантном выражении вÑтретилÑÑ Ð¸Ð´ÐµÐ½Ñ‚Ð¸Ñ„Ð¸ÐºÐ°Ñ‚Ð¾Ñ€, не начинающийÑÑ Ñ Ñимвола $. +asmr_w_32bit_const_for_address=07079_W_32-Ð±Ð¸Ñ‚Ð½Ð°Ñ ÐºÐ¾Ð½Ñтанта иÑпользована Ð´Ð»Ñ Ð°Ð´pеÑа +% КонÑтанта иÑпользована в качеÑтве адреÑа. Это ÑвлÑетÑÑ Ð¿Ñ€Ð¸Ð·Ð½Ð°ÐºÐ¾Ð¼ ошибки, +% поÑкольку абÑÐ¾Ð»ÑŽÑ‚Ð½Ð°Ñ Ð°Ð´Ñ€ÐµÑÐ°Ñ†Ð¸Ñ Ð¾Ð±Ñ‹Ñ‡Ð½Ð¾ не работает. +asmr_n_align_is_target_specific=07080_N_.ALIGN ÑвлÑетÑÑ Ð¿Ð»Ð°Ñ‚Ñ„Ð¾Ñ€Ð¼ÐµÐ½Ð½Ð¾-завиÑимой, иÑпользyйте .BALIGN или .P2ALIGN +% ДейÑтвие и значение директивы .align может изменÑÑ‚ÑŒÑÑ Ð² завиÑимоÑти от +% целевой платформы. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_ÐŸÐ¾Ð»Ñ Ð¿Ð°pаметpа недоÑтупны напpÑмyÑŽ, иÑпользyйте pегиÑÑ‚pÑ‹ +% Параметр Ñледует загрузить в региÑÑ‚Ñ€ и затем адреÑовать Ð¿Ð¾Ð»Ñ Ð¿Ð°Ñ€Ð°Ð¼ÐµÑ‚Ñ€Ð° отноÑительно +% Ñтого региÑтра. +asmr_e_cannot_access_object_field_directly=07082_E_ÐŸÐ¾Ð»Ñ Ð¾Ð±ÑŠÐµÐºÑ‚Ð¾Ð²/клаÑÑов недоÑтупны напpÑмyÑŽ, иÑпользyйте pегиÑÑ‚pÑ‹ +% Следует загрузить указатель на self в региÑÑ‚Ñ€ и затем адреÑовать полÑ, иÑÐ¿Ð¾Ð»ÑŒÐ·ÑƒÑ Ñ€ÐµÐ³Ð¸ÑÑ‚Ñ€ +% в качеÑтве базы. По умолчанию указатель на self доÑтупен +% в региÑтре esi на i386. +asmr_e_unable_to_determine_reference_size=07083_E_Размеp операндов не указан и его определение невозможно +% Размер ÑÑылки Ñледует указать Ñвно, Ñ‚.к. компилÑтор не может +% определить, какой размер (byte,word,dword и Ñ‚.д.) он +% должен иÑпользовать. +asmr_e_cannot_use_RESULT_here=07084_E_Ð’ Ñтой функции иÑпользовать RESULT Ð½ÐµÐ»ÑŒÐ·Ñ +% Ðекоторые функции, возвращающие результат Ñложного типа, не могут иÑпользовать переменную +% \var{result}. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" без операнда транÑлируетÑÑ Ð² "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" транÑлируетÑÑ Ð² "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" транÑлируетÑÑ Ð² "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_Символ < здеÑÑŒ не разрешен +% Оператор Ñдвига требует Ñимволов <<. Был обнаружен только один из них. +asmr_e_invalid_char_greater=07090_E_Символ > здеÑÑŒ не разрешен +% Оператор Ñдвига требует Ñимволов >>. Был обнаружен только один из них. +asmr_w_align_not_supported=07093_W_ALIGN не поддерживаетÑÑ +asmr_e_no_inc_and_dec_together=07094_E_Inc и Dec не могут иÑпользоватьÑÑ Ð¾Ð´Ð½Ð¾Ð²Ñ€ÐµÐ¼ÐµÐ½Ð½Ð¾ +% Одновременное иÑпользование инкремента и декремента в одном операнде +% на 680x0. Это недопуÑтимо. +asmr_e_invalid_reg_list_in_movem=07095_E_Ðеверный ÑпиÑок региÑтров Ð´Ð»Ñ movem +% ИÑпользование инÑтрукции \var{movem} Ñ Ð½ÐµÐ²ÐµÑ€Ð½Ñ‹Ð¼Ð¸ региÑтрами Ð´Ð»Ñ ÑохранениÑ/воÑÑтановлениÑ. +asmr_e_invalid_reg_list_for_opcode=07096_E_Ðеверный ÑпиÑок региÑтров Ð´Ð»Ñ ÐºÐ¾Ð¼Ð°Ð½Ð´Ñ‹ +asmr_e_higher_cpu_mode_required=07097_E_ТребуетÑÑ Ñ€ÐµÐ¶Ð¸Ð¼ более Ñовременного процеÑÑора ($1) +% ИÑпользование инÑтрукции, ÐºÐ¾Ñ‚Ð¾Ñ€Ð°Ñ Ð½Ðµ поддерживаетÑÑ Ð² текущем режиме процеÑÑора. +% ИÑпользуйте режим Ð´Ð»Ñ Ñледующих поколений процеÑÑоров. +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_Размер операндов не указан и его не удаетÑÑ Ð¾Ð¿Ñ€ÐµÐ´ÐµÐ»Ð¸Ñ‚ÑŒ, иÑпользуетÑÑ DWORD по умолчанию +% Размер ÑÑылки Ñледует указать Ñвно, Ñ‚.к. компилÑтор не может +% определить, какой размер (byte,word,dword и Ñ‚.д.) он +% должен иÑпользовать. ВыдаетÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ в режиме Delphi, когда +% по умолчанию иÑпользуетÑÑ Ñ€Ð°Ð·Ð¼ÐµÑ€ DWORD. +asmr_e_illegal_shifterop_syntax=07099_E_СинтакÑичеÑÐºÐ°Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ° в операнде Ñдвига +% Только ARM; аÑÑемблер ARM поддерживает Ñ‚.н. операнд Ñдвига. ИÑпользованный Ð´Ð»Ñ Ð½ÐµÐ³Ð¾ ÑинтакÑÐ¸Ñ +% неверен. Пример инÑтрукции Ñ Ð¾Ð¿ÐµÑ€Ð°Ð½Ð´Ð¾Ð¼ Ñдвига: +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +asmr_e_packed_element=07100_E_ÐÐ´Ñ€ÐµÑ ÑƒÐ¿Ð°ÐºÐ¾Ð²Ð°Ð½Ð½Ð¾Ð³Ð¾ компонента не Ñовпадает Ñ Ð³Ñ€Ð°Ð½Ð¸Ñ†ÐµÐ¹ байта +% Упакованные компоненты (Ð¿Ð¾Ð»Ñ Ð·Ð°Ð¿Ð¸Ñей и Ñлементы маÑÑивов) могут начинатьÑÑ +% Ñ Ð¿Ñ€Ð¾Ð¸Ð·Ð²Ð¾Ð»ÑŒÐ½Ð¾Ð³Ð¾ бита в байте. Следовательно, на процеÑÑоре, не поддерживающего +% битовую адреÑацию памÑти (а вÑе поддерживаемые FPC процеÑÑоры ÑвлÑÑŽÑ‚ÑÑ Ð¸Ð¼ÐµÐ½Ð½Ð¾ такими), +% будет выдана ошибка при попытке доÑтупа по индекÑу к маÑÑивам, размер Ñлемента которых +% не кратен 8 битам. Это Ñправедливо и Ð´Ð»Ñ Ð¿Ð¾Ð»ÐµÐ¹ запиÑей Ñ Ñ‚Ð°ÐºÐ¸Ð¼Ð¸ адреÑами. +asmr_w_unable_to_determine_reference_size_using_byte=07101_W_Размер операндов не указан и его не удаетÑÑ Ð¾Ð¿Ñ€ÐµÐ´ÐµÐ»Ð¸Ñ‚ÑŒ, иÑпользуетÑÑ BYTE по умолчанию +% Размер ÑÑылки Ñледует указать Ñвно, Ñ‚.к. компилÑтор не может +% определить, какой размер (byte,word,dword и Ñ‚.д.) он +% должен иÑпользовать. ВыдаетÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ в режиме Delphi, когда +% по умолчанию иÑпользуетÑÑ Ñ€Ð°Ð·Ð¼ÐµÑ€ BYTE. +asmr_w_no_direct_ebp_for_parameter=07102_W_ЗдеÑÑŒ Ð½ÐµÐ»ÑŒÐ·Ñ Ð¸Ñпользовать +offset(%ebp) Ð´Ð»Ñ Ð¿Ð°Ñ€Ð°Ð¼ÐµÑ‚Ñ€Ð¾Ð² +% ИÑпользование прÑмой ÑÑылки вида 8(%ebp) Ð´Ð»Ñ Ð¿Ð°Ñ€Ð°Ð¼ÐµÑ‚Ñ€Ð¾Ð² процедуры/функции неверно, еÑли +% параметры находÑÑ‚ÑÑ Ð² региÑтрах. +asmr_w_direct_ebp_for_parameter_regcall=07103_W_ИÑпользование +offset(%ebp) неÑовмеÑтимо Ñ Ñ‚Ð¸Ð¿Ð¾Ð¼ вызова regcall +% ИÑпользование прÑмой ÑÑылки вида 8(%ebp) Ð´Ð»Ñ Ð¿Ð°Ñ€Ð°Ð¼ÐµÑ‚Ñ€Ð¾Ð² процедуры/функции неверно, еÑли +% параметры находÑÑ‚ÑÑ Ð² региÑтрах. +asmr_w_direct_ebp_neg_offset=07104_W_ИÑпользование -offset(%ebp) Ð´Ð»Ñ Ð»Ð¾ÐºÐ°Ð»ÑŒÐ½Ñ‹Ñ… переменных не рекомендуетÑÑ +% ИÑпользование ÑÑылок вида -8(%ebp) Ð´Ð»Ñ Ð´Ð¾Ñтупа к локальным переменным не рекомендуетÑÑ. +asmr_w_direct_esp_neg_offset=07105_W_ИÑпользование -offset(%esp), возможен Ñбой при доÑтупе или Ð¿Ð¾Ñ‚ÐµÑ€Ñ Ð·Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ +% ИÑпользование ÑÑылок вида -8(%esp) Ð´Ð»Ñ Ð´Ð¾Ñтупа к локальному Ñтеку не рекомендуетÑÑ, +% потому что Ñта чаÑÑ‚ÑŒ Ñтека может быть затерта при вызове любой функции или при прерывании. +asmr_e_no_vmtoffset_possible=07106_E_VMTOffset Ñледует иÑпользовать в комбинации Ñ Ð²Ð¸Ñ€Ñ‚ÑƒÐ°Ð»ÑŒÐ½Ñ‹Ð¼ методом, "$1" не ÑвлÑетÑÑ Ð²Ð¸Ñ€Ñ‚ÑƒÐ°Ð»ÑŒÐ½Ñ‹Ð¼ +% Только виртуальные методы имеют Ñмещение в VMT. +asmr_e_need_pic_ref=07107_E_Ð’ режиме позиционно-незавиÑимого кода найдена позиционно-завиÑÐ¸Ð¼Ð°Ñ ÑÑылка +% Режим компилÑции предуÑматривает генерацию позиционно-незавиÑимого кода +% (PIC), но в данной напиÑанной вручную аÑÑемблерной инÑтрукции ÑодержитÑÑ +% позиционно-завиÑÐ¸Ð¼Ð°Ñ ÑÑылка. +# +# Assembler/binary writers +# +# 08020 is the last used one +# +asmw_f_too_many_asm_files=08000_F_Слишком много аÑÑемблерных файлов +% "УмнаÑ" компоновка приводит к получению Ñлишком большого количеÑтва +% аÑÑемблерных файлов. Отключите ее. +asmw_f_assembler_output_not_supported=08001_F_Выбpанный выходной формат аÑÑемблеpа не поддеpживаетÑÑ +asmw_f_comp_not_supported=08002_F_COMP не поддеpживаетÑÑ +asmw_f_direct_not_supported=08003_F_Тип аÑÑемблеpа direct не поддеpживаетÑÑ Ñ Ð´Ð²Ð¾Ð¸Ñ‡Ð½Ñ‹Ð¼ выходным форматом +% Тип аÑÑемблера direct предполагает запиÑÑŒ прочитанного аÑÑемблерного текÑта напрÑмую в выходной файл, +% при Ñтом выходной файл не может быть двоичным. Выберите текÑтовый формат выходных файлов. +asmw_e_alloc_data_only_in_bss=08004_E_Выделение памÑти Ð´Ð»Ñ Ð´Ð°Ð½Ð½Ñ‹Ñ… разрешено только в Ñекции BSS +asmw_f_no_binary_writer_selected=08005_F_Ðе выбран двоичный выходной формат +asmw_e_opcode_not_in_table=08006_E_Asm: Кода команды $1 нет в ÑпиÑке +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 невеpное Ñочетание команды и опеpандов +asmw_e_16bit_not_supported=08008_E_Asm: 16-битные ÑÑылки не поддеpживаютÑÑ +asmw_e_invalid_effective_address=08009_E_Asm: Hевеpный Ñффективный адpÐµÑ +asmw_e_immediate_or_reference_expected=08010_E_Asm: ОжидаетÑÑ IMMEDIATE или ÑÑылка +asmw_e_value_exceeds_bounds=08011_E_Asm: значение $1 выходит за гpаницы $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: Короткий переход выходит за гpаницы $1 +asmw_e_undefined_label=08013_E_Asm: Метка $1 не определена +asmw_e_comp_not_supported=08014_E_Asm: Тип comp не поддерживаетÑÑ Ð´Ð»Ñ Ñтой платформы +asmw_e_extended_not_supported=08015_E_Asm: Тип extended не поддерживаетÑÑ Ð´Ð»Ñ Ñтой платформы +asmw_e_duplicate_label=08016_E_Asm: ПовторÑющаÑÑÑ Ð¼ÐµÑ‚ÐºÐ° $1 +asmw_e_redefined_label=08017_E_Asm: Повторное определение метки $1 +asmw_e_first_defined_label=08018_E_Asm: Первоначально определÑетÑÑ Ð·Ð´ÐµÑÑŒ +asmw_e_invalid_register=08019_E_Asm: Ðеверный региÑÑ‚Ñ€ $1 +asmw_e_16bit_32bit_not_supported=08020_E_Asm: 16- и 32-битные ÑÑылки не поддерживаютÑÑ +asmw_e_64bit_not_supported=08021_E_Asm: 64-битные операнды не поддерживаютÑÑ + +# +# Executing linker/assembler +# +# 09032 is the last used one +# +# BeginOfTeX +% +% \section{Ошибки Ñтадии аÑÑемблированиÑ/компоновки} +% ПеречиÑлÑÑŽÑ‚ÑÑ Ð¾ÑˆÐ¸Ð±ÐºÐ¸, которые могут иметь меÑто во Ð²Ñ€ÐµÐ¼Ñ Ð¾Ð±Ñ€Ð°Ð±Ð¾Ñ‚ÐºÐ¸ +% командной Ñтроки и файлов конфигурации. +% \begin{description} +exec_w_source_os_redefined=09000_W_ИÑÑ…Ð¾Ð´Ð½Ð°Ñ Ð¾Ð¿ÐµpÐ°Ñ†Ð¸Ð¾Ð½Ð½Ð°Ñ ÑиÑтема пеpеопpеделена +% ИÑÑ…Ð¾Ð´Ð½Ð°Ñ Ð¾Ð¿ÐµÑ€Ð°Ñ†Ð¸Ð¾Ð½Ð½Ð°Ñ ÑиÑтемы переопределена. +exec_i_assembling_pipe=09001_I_ÐÑÑемблиpyетÑÑ (pipe) $1 +% ÐÑÑемблирование Ñ Ð¸Ñпользованием канала (pipe) Ð´Ð»Ñ Ð¾Ð±Ð¼ÐµÐ½Ð° данными Ñ Ð²Ð½ÐµÑˆÐ½Ð¸Ð¼ аÑÑемблером. +exec_d_cant_create_asmfile=09002_E_Hевозможно Ñоздать аÑÑмеблеpный файл: $1 +% Указанный файл не может быть Ñоздан. Проверьте, еÑли ли +% разрешение на Ñоздание файла. +exec_e_cant_create_objectfile=09003_E_Ðевозможно Ñоздать объектный файл: $1 +% Указанный файл не может быть Ñоздан. Проверьте, еÑли ли +% разрешение на Ñоздание файла. +exec_e_cant_create_archivefile=09004_E_Ðевозможно Ñоздать файл архива: $1 +% Указанный файл не может быть Ñоздан. Проверьте, еÑли ли +% разрешение на Ñоздание файла. +exec_e_assembler_not_found=09005_E_ÐÑÑемблеp $1 не найден, переход на внешнюю Ñборку +% Программа аÑÑемблера не найдена. КомпилÑтор ÑоздаÑÑ‚ Ñкрипт, +% позволÑющий аÑÑемблировать и Ñкомпоновать программу позднее. +exec_t_using_assembler=09006_T_ИÑпользyетÑÑ Ð°ÑÑемблеp: $1 +% Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ том, какой именно аÑÑемблер иÑпользуетÑÑ. +exec_e_error_while_assembling=09007_E_Ошибка аÑÑемблиpованиÑ, код возврата $1 +% При обработке файла внешним аÑÑемблером произошла ошибка. ПодробноÑти +% можно найти в руководÑтве к иÑпользуемой программе аÑÑемблера. +exec_e_cant_call_assembler=09008_E_Ошибка $1 при запуÑке аÑÑемблера, переход на внешнюю Ñборку +% Ошибка при запуÑке внешнего аÑÑемблера. КомпилÑтор ÑоздаÑÑ‚ Ñкрипт, +% позволÑющий аÑÑемблировать и Ñкомпоновать программу позднее. +exec_i_assembling=09009_I_ÐÑÑемблиpуетÑÑ $1 +% Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ том, какой файл аÑÑемблируетÑÑ. +exec_i_assembling_smart=09010_I_ÐÑÑемблиpуетÑÑ Ñ "умной" Ñборкой $1 +% Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ том, какой файл аÑÑемблируетÑÑ Ñ Ð¿Ð¾Ð´Ð´ÐµÑ€Ð¶ÐºÐ¾Ð¹ "умной" Ñборки. +exec_w_objfile_not_found=09011_W_Объектный файл $1 не найден, компоновка может не yдатьÑÑ! +% Один из объектных файлов не найден, и компоновка, Ñкорее вÑего, не удаÑÑ‚ÑÑ. +% Проверьте пути. +exec_w_libfile_not_found=09012_W_Библиотека $1 не найдена, компоновка может не yдатьÑÑ! +% Один из файлов библиотек не найден, и компоновка, Ñкорее вÑего, не удаÑÑ‚ÑÑ. +% Проверьте пути. +exec_e_error_while_linking=09013_E_Ошибка пpи компоновке +% ÐžÐ±Ñ‰Ð°Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ° при компоновке. +exec_e_cant_call_linker=09014_E_Hе удаетÑÑ Ð²Ñ‹Ð·Ð²Ð°Ñ‚ÑŒ компоновщик, переход на внешнюю компоновку +% Ошибка при запуÑке внешнего компоновщика. КомпилÑтор ÑоздаÑÑ‚ Ñкрипт, +% позволÑющий аÑÑемблировать и Ñкомпоновать программу позднее. +exec_i_linking=09015_I_Компоновка $1 +% Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ том, ÐºÐ°ÐºÐ°Ñ Ð¿Ñ€Ð¾Ð³Ñ€Ð°Ð¼Ð¼Ð° или библиотека компонуетÑÑ. +exec_e_util_not_found=09016_E_Утилита $1 не найдена, пеpеход на внешнюю компоновку +% ВнешнÑÑ ÑƒÑ‚Ð¸Ð»Ð¸Ñ‚Ð° не найдена. КомпилÑтор ÑоздаÑÑ‚ Ñкрипт, +% позволÑющий произвеÑти неудавшиеÑÑ Ð´ÐµÐ¹ÑÑ‚Ð²Ð¸Ñ Ð¿Ð¾Ð·Ð´Ð½ÐµÐµ. +exec_t_using_util=09017_T_ИÑпользуетÑÑ ÑƒÑ‚Ð¸Ð»Ð¸Ñ‚Ð° $1 +% Информационное Ñообщение о том, ÐºÐ°ÐºÐ°Ñ ÑƒÑ‚Ð¸Ð»Ð¸Ñ‚Ð° иÑпользуетÑÑ (обычно Ñто поÑÑ‚-процеÑÑор). +exec_e_exe_not_supported=09018_E_Создание иÑполнÑемых файлов не поддеpживаетÑÑ +% Создание иÑполнÑемых файлов Ð´Ð»Ñ Ñтой платформы еще не реализовано в компилÑторе +% и потому невозможно. +exec_e_dll_not_supported=09019_E_Создание динамичеÑких библиотек (DLL) не поддеpживаютÑÑ +% Создание динамичеÑки загружаемых библиотек Ð´Ð»Ñ Ñтой платформы еще не реализовано в компилÑторе +% и потому невозможно. +exec_i_closing_script=09020_I_Создан Ñкpипт $1 +% Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾Ð± окончании запиÑи Ñкрипта Ð´Ð»Ñ Ð²Ð½ÐµÑˆÐ½ÐµÐ³Ð¾ аÑÑемблированиÑ/компоновки. +exec_e_res_not_found=09021_E_КомпилÑтоp pеÑypÑов "$1" не найден, пеpеход во внешний режим +% Ошибка при запуÑке внешнего компилÑтора реÑурÑов. КомпилÑтор ÑоздаÑÑ‚ Ñкрипт, +% позволÑющий выполнить неудавшиеÑÑ Ð´ÐµÐ¹ÑÑ‚Ð²Ð¸Ñ Ð¸ завершить Ñоздание программы позднее. +exec_i_compilingresource=09022_I_КомпилÑÑ†Ð¸Ñ pеÑypÑа $1 +% Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ том, какой файл реÑурÑов компилируетÑÑ. +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_модyль $1 не может быть Ñкомпонован ÑтатичеÑки, переход на "умную" компоновку +% Запрошена ÑтатичеÑÐºÐ°Ñ ÐºÐ¾Ð¼Ð¿Ð¾Ð½Ð¾Ð²ÐºÐ°, но иÑпользованный модуль не допуÑкает Ñтот режим. +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_модyль $1 не может быть Ñкомпонован в "умном" pежиме, переход на ÑтатичеÑкую компоновку +% Запрошена "умнаÑ" компоновка, но иÑпользованный модуль не допуÑкает Ñтот режим. +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_модyль $1 не может быть Ñкомпонован в pежиме shared, переход на ÑтатичеÑкую компоновку +% Запрошена разделÑÐµÐ¼Ð°Ñ ÐºÐ¾Ð¼Ð¿Ð¾Ð½Ð¾Ð²ÐºÐ°, но иÑпользованный модуль не допуÑкает Ñтот режим. +exec_e_unit_not_smart_or_static_linkable=09026_E_модyль $1 не может быть Ñкомпонован в pежимах smart или static +% Запрошена "умнаÑ" или ÑтатичеÑÐºÐ°Ñ ÐºÐ¾Ð¼Ð¿Ð¾Ð½Ð¾Ð²ÐºÐ°, но иÑпользованный модуль не допуÑкает ни один из Ñтих режимов. +exec_e_unit_not_shared_or_static_linkable=09027_E_модyль $1 не может быть Ñобpан в pежимах shared или static +% Запрошена разделÑÐµÐ¼Ð°Ñ Ð¸Ð»Ð¸ ÑтатичеÑÐºÐ°Ñ ÐºÐ¾Ð¼Ð¿Ð¾Ð½Ð¾Ð²ÐºÐ°, но иÑпользованный модуль не допуÑкает ни один из Ñтих режимов. +exec_d_resbin_params=09028_D_Вызов компилÑтора реÑурÑов "$1" Ñ ÐºÐ¾Ð¼Ð°Ð½Ð´Ð½Ð¾Ð¹ Ñтрокой "$2" +% Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾Ð± иÑпользуемом компилÑторе реÑурÑов и его командной Ñтроке. +exec_e_error_while_compiling_resources=09029_E_Ошибка при компилÑции реÑурÑов +% КомпилÑтор или конвертор реÑурÑов завершилÑÑ Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ¾Ð¹. +exec_e_cant_call_resource_compiler=09030_E_Вызов компилÑтора реÑурÑов "$1" невозможен, переход во внешний режим +% Ошибка при вызове компилÑтора реÑурÑов. КомпилÑтор ÑоздаÑÑ‚ Ñкрипт, +% позволÑющий повторить неудавшиеÑÑ Ð´ÐµÐ¹ÑÑ‚Ð²Ð¸Ñ Ð¸ завершить Ñоздание программы +% позднее. +exec_e_cant_open_resource_file=09031_E_Ðевозможно открыть файл реÑурÑов "$1" +% Ошибка при открытии указанного файла реÑурÑов. +exec_e_cant_write_resource_file=09032_E_Ошибка запиÑи файла реÑурÑов "$1" +% Ошибка при запиÑи указанного файла реÑурÑов. +%\end{description} +# EndOfTeX + +# +# Executable information +# +# 09134 is the last used one +# +# BeginOfTeX +% \section{Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾Ð± иÑполнÑемых файлах.} +% Содержит ÑообщениÑ, выдаваемые при Ñоздании иÑполнÑемого файла +% Ñ Ð¸Ñпользованием внутреннего компоновщика. +% \begin{description} +execinfo_f_cant_process_executable=09128_F_ПоÑÑ‚-обработка иÑполнÑемого файла $1 невозможна +% Ð¤Ð°Ñ‚Ð°Ð»ÑŒÐ½Ð°Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ° при невозможноÑти поÑÑ‚-обработки иÑполнÑемого файла. +execinfo_f_cant_open_executable=09129_F_Ðевозможно открыть иÑполнÑемый файл $1 +% Ð¤Ð°Ñ‚Ð°Ð»ÑŒÐ½Ð°Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ° при невозможноÑти открыть иÑполнÑемый файл. +execinfo_x_codesize=09130_X_Размер кода: $1 байт +% Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ размере Ñозданной Ñекции кода. +execinfo_x_initdatasize=09131_X_Размер инициализированных данных: $1 байт +% Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ размере Ñозданной Ñекции инициализированных данных. +execinfo_x_uninitdatasize=09132_X_Размер неинициализированных данных: $1 bytes +% Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ размере Ñекции неинициализированных данных. +execinfo_x_stackreserve=09133_X_Размер Ñтека (зарезервированный): $1 bytes +% Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ зарезервированном размере Ñтека иÑполнÑемого файла. +execinfo_x_stackcommit=09134_X_Размер Ñтека (подключенный): $1 bytes +% Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ подключенном размере Ñтека иÑполнÑемого файла. +%\end{description} +# EndOfTeX + +# +# Internal linker messages +# +# 09200 is the last used one +# +# BeginOfTeX +% \section{Ð¡Ð¾Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ ÐºÐ¾Ð¼Ð¿Ð¾Ð½Ð¾Ð²Ñ‰Ð¸ÐºÐ°} +% СообщениÑ, выдаваемые внутренним компоновщиком. +% \begin{description} +link_f_executable_too_big=09200_F_Размер иÑполнÑемого образа Ñлишком велик Ð´Ð»Ñ Ð¿Ð»Ð°Ñ‚Ñ„Ð¾Ñ€Ð¼Ñ‹ $1. +% Ð¤Ð°Ñ‚Ð°Ð»ÑŒÐ½Ð°Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ°, Ð²Ð¾Ð·Ð½Ð¸ÐºÐ°ÑŽÑ‰Ð°Ñ Ð² Ñлучае, еÑли Ñозданный иÑполнÑемый файл Ñлишком велик. +link_w_32bit_absolute_reloc=09201_W_Объектный файл "$1" Ñодержит 32-битное абÑолютное перемещение Ð´Ð»Ñ Ñимвола "$2". +% Ð’ Ñлучае, когда 64-битный объектный файл Ñодержит 32-битные абÑолютные перемещениÑ, +% полученный иÑполнÑемый образ может быть загружен только в нижние 4 ГБ адреÑного +% проÑтранÑтва. +%\end{description} +# EndOfTeX + +# +# Unit loading +# +# 10061 is the last used one +# +# BeginOfTeX +% \section{Ð¡Ð¾Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ Ð·Ð°Ð³Ñ€ÑƒÐ·ÐºÐ¸ модулей.} +% СообщениÑ, выдаваемые при загрузке модулей Ñ Ð´Ð¸Ñка в памÑÑ‚ÑŒ. +% Многие из них ноÑÑÑ‚ информационный характер. +% \begin{description} +unit_t_unitsearch=10000_T_ПоиÑк модyлÑ: $1 +% При иÑпользовании ключа \var{-vt} Ñообщает о том, где компилÑтор ищет +% файлы модулей. +unit_t_ppu_loading=10001_T_Загpyзка PPU $1 +% При иÑпользовании ключа \var{-vt} Ñообщает Ð¸Ð¼Ñ Ñ„Ð°Ð¹Ð»Ð° загружаемого модулÑ. +unit_u_ppu_name=10002_U_Ð˜Ð¼Ñ PPU: $1 +% При иÑпользовании ключа \var{-vu} Ñообщает Ð¸Ð¼Ñ Ð¼Ð¾Ð´ÑƒÐ»Ñ. +unit_u_ppu_flags=10003_U_Флаги PPU: $1 +% При иÑпользовании ключа \var{-vu} показывает флаги модулÑ. +unit_u_ppu_crc=10004_U_CRC PPU: $1 +% При иÑпользовании ключа \var{-vu} показывает контрольную Ñумму модулÑ. +unit_u_ppu_time=10005_U_Ð’Ñ€ÐµÐ¼Ñ PPU: $1 +% При иÑпользовании ключа \var{-vu} показывает времÑ, когда модуль был Ñкомпилирован. +unit_u_ppu_file_too_short=10006_U_PPU файл Ñлишком коpоткий +% Файл Ð¼Ð¾Ð´ÑƒÐ»Ñ Ñлишком короткий, в нем ÑодержатÑÑ Ð½Ðµ вÑе объÑвлениÑ. +unit_u_ppu_invalid_header=10007_U_Hевеpный заголовок PPU (нет Ñигнатуры PPU в начале) +% Первыми Ñ‚Ñ€ÐµÐ¼Ñ Ð±Ð°Ð¹Ñ‚Ð°Ð¼Ð¸ файла PPU должны быть коды Ñимволов \var{PPU} +unit_u_ppu_invalid_version=10008_U_HевеpÐ½Ð°Ñ Ð²ÐµpÑÐ¸Ñ PPU файла $1 +% Указанный файл Ð¼Ð¾Ð´ÑƒÐ»Ñ Ð±Ñ‹Ð» Ñоздан другой верÑией компилÑтора, и поÑтому не может быть +% прочитан. +unit_u_ppu_invalid_processor=10009_U_PPU файл Ñоздан Ð´Ð»Ñ Ð´pyгого пpоцеÑÑоpа +% Этот модуль был Ñкомпилирован Ð´Ð»Ñ Ð´Ñ€ÑƒÐ³Ð¾Ð³Ð¾ типа процеÑÑора, и поÑтому не может +% быть прочитан. +unit_u_ppu_invalid_target=10010_U_PPU файл Ñоздан Ð´Ð»Ñ Ð´pyгой ОС +% Этот модуль был Ñкомпилирован Ð´Ð»Ñ Ð´Ñ€ÑƒÐ³Ð¾Ð¹ операционной ÑиÑтемы, и поÑтому не может +% быть прочитан. +unit_u_ppu_source=10011_U_ИÑходный файл PPU: $1 +% При иÑпользовании ключа \var{-vu} показывает Ð¸Ð¼Ñ Ð¸Ñходного файла модулÑ. +unit_u_ppu_write=10012_U_ЗапиÑÑŒ $1 +% При иÑпользовании ключа \var{-vu} Ñообщает, куда компилÑтор запиÑывает +% файл модулÑ. +unit_f_ppu_cannot_write=10013_F_Hевозможно запиÑать PPU-файл +% При запиÑи файла Ð¼Ð¾Ð´ÑƒÐ»Ñ Ð¿Ñ€Ð¾Ð¸Ð·Ð¾ÑˆÐ»Ð° ошибка. +unit_f_ppu_read_error=10014_F_Ошибка Ñ‡Ñ‚ÐµÐ½Ð¸Ñ PPU-файла +% Файл Ð¼Ð¾Ð´ÑƒÐ»Ñ Ð¿Ð¾Ð²Ñ€ÐµÐ¶Ð´ÐµÐ½ и Ñодержит неверную +% информацию. ПотребуетÑÑ Ñ€ÐµÐºÐ¾Ð¼Ð¿Ð¸Ð»ÑциÑ. +unit_f_ppu_read_unexpected_end=10015_F_Ðеожиданный конец PPU-файла +% Ðеожиданный конец файла. +unit_f_ppu_invalid_entry=10016_F_HÐµÐ²ÐµÑ€Ð½Ð°Ñ Ð·Ð°Ð¿Ð¸ÑÑŒ PPU-файла: $1 +% Файл Ð¼Ð¾Ð´ÑƒÐ»Ñ Ð¿Ð¾Ð²Ñ€ÐµÐ¶Ð´ÐµÐ½, или был Ñоздан более новой верÑией компилÑтора. +unit_f_ppu_dbx_count_problem=10017_F_Ошибка PPU DBX count +% ÐеÑтыковки в отладочной информации модулÑ. +unit_e_illegal_unit_name=10018_E_Hевеpное Ð¸Ð¼Ñ Ð¼Ð¾Ð´yлÑ: $1 +% Ð˜Ð¼Ñ Ð¼Ð¾Ð´ÑƒÐ»Ñ Ð½Ðµ Ñовпадает Ñ Ð¸Ð¼ÐµÐ½ÐµÐ¼ файла модулÑ. +unit_f_too_much_units=10019_F_Слишком много модyлей +% КомпилÑтор имеет предел 1024 Ð¼Ð¾Ð´ÑƒÐ»Ñ Ð² программе. Его можно увеличить, +% изменив значение конÑтанты \var{maxunits} в файле \file{files.pas} компилÑтора, +% и перекомпилировав компилÑтор. +unit_f_circular_unit_reference=10020_F_ÐšÐ¾Ð»ÑŒÑ†ÐµÐ²Ð°Ñ ÑÑылка междy модулÑми $1 и $2 +% Два Ð¼Ð¾Ð´ÑƒÐ»Ñ Ð¸Ñпользуют друг друга в интерфейÑной Ñекции. Это разрешено только в +% Ñекции \var{implementation}. По крайней мере один из модулей должен Ñодержать +% ÑÑылку на другой в Ñекции \var{implementation}. +unit_f_cant_compile_unit=10021_F_КомпилÑÑ†Ð¸Ñ Ð¼Ð¾Ð´yÐ»Ñ $1 невозможна, отÑутÑтвуют иÑходники. +% Ðайден модуль, требующий перекомпилÑции, но иÑходные файлы Ð´Ð»Ñ Ð½ÐµÐ³Ð¾ отÑутÑтвуют. +unit_f_cant_find_ppu=10022_F_Hе найден модуль $1, иÑпользуемый $2 +% Попытка иÑÐ¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ð½Ð¸Ñ Ð¼Ð¾Ð´ÑƒÐ»Ñ, Ð´Ð»Ñ ÐºÐ¾Ñ‚Ð¾Ñ€Ð¾Ð³Ð¾ не найден файл PPU. +% Проверьте пути модулей в файле конфигурации. +unit_w_unit_name_error=10023_W_Модуль $1 не найден, но $2 ÑущеÑтвует +% Больше не иÑпользуетÑÑ. +unit_f_unit_name_error=10024_F_При поиÑке Ð¼Ð¾Ð´ÑƒÐ»Ñ $1 был найден $2 +% Ограничение DOS на длину имен файлов в 8 Ñимволов может вызывать +% проблемы, еÑли Ð¸Ð¼Ñ Ð¼Ð¾Ð´ÑƒÐ»Ñ Ð¸Ð¼ÐµÐµÑ‚ большую длину. +unit_w_switch_us_missed=10025_W_Ð”Ð»Ñ ÐºÐ¾Ð¼Ð¿Ð¸Ð»Ñции Ð¼Ð¾Ð´ÑƒÐ»Ñ system требуетÑÑ ÐºÐ»ÑŽÑ‡ -Us +% При компилÑции Ð¼Ð¾Ð´ÑƒÐ»Ñ system (требующего оÑобой обработки), Ñледует +% указывать ключ \var{-Us}. +unit_f_errors_in_unit=10026_F_Пpи компилÑции модyÐ»Ñ Ð¿Ñ€Ð¾Ð¸Ð·Ð¾ÑˆÐ»Ð¾ $1 ошибок, работа прервана +% КомпилÑтор прекращает работу Ñ Ñтим Ñообщением при возникновении фатальной ошибки, +% или при превышении предельного количеÑтва ошибок. +unit_u_load_unit=10027_U_Загpyзка из $1 ($2) модyль $3 +% При иÑпользовании ключа \var{-vu} Ñообщает, который модуль откуда загружаетÑÑ. +% shown. +unit_u_recompile_crc_change=10028_U_ПеpекомпилÑÑ†Ð¸Ñ $1, изменилаÑÑŒ контpÐ¾Ð»ÑŒÐ½Ð°Ñ Ñyмма $2 +% Модуль перекомпилируетÑÑ, потому что изменилаÑÑŒ ÐºÐ¾Ð½Ñ‚Ñ€Ð¾Ð»ÑŒÐ½Ð°Ñ Ñумма модулÑ, от которого +% он завиÑит. +unit_u_recompile_source_found_alone=10029_U_ПеpекомпилÑÑ†Ð¸Ñ $1, найдены только иÑходные файлы +% При иÑпользовании ключа \var{-vu} Ñообщает причину перекомпилÑции указанного модулÑ. +unit_u_recompile_staticlib_is_older=10030_U_ПеpекомпилÑÑ†Ð¸Ñ Ð¼Ð¾Ð´yлÑ, ÑтатичеÑÐºÐ°Ñ Ð±Ð¸Ð±Ð»Ð¸Ð¾Ñ‚ÐµÐºÐ° Ñтаpше чем ppu-файл +% При иÑпользовании ключа \var{-vu} Ñообщает о том, что ÑтатичеÑÐºÐ°Ñ Ð±Ð¸Ð±Ð»Ð¸Ð¾Ñ‚ÐµÐºÐ° Ð¼Ð¾Ð´ÑƒÐ»Ñ +% Ñтарше, чем ppu-файл модулÑ. +unit_u_recompile_sharedlib_is_older=10031_U_ПеpекомпилÑÑ†Ð¸Ñ Ð¼Ð¾Ð´yлÑ, разделÑÐµÐ¼Ð°Ñ Ð±Ð¸Ð±Ð»Ð¸Ð¾Ñ‚ÐµÐºÐ° Ñтаpше чем ppu-файл +% При иÑпользовании ключа \var{-vu} Ñообщает о том, что разделÑÐµÐ¼Ð°Ñ Ð±Ð¸Ð±Ð»Ð¸Ð¾Ñ‚ÐµÐºÐ° Ð¼Ð¾Ð´ÑƒÐ»Ñ +% Ñтарше, чем ppu-файл модулÑ. +unit_u_recompile_obj_and_asm_older=10032_U_ПеpекомпилÑÑ†Ð¸Ñ Ð¼Ð¾Ð´yлÑ, .as и .obj файлы Ñтаpше чем ppu-файл +% При иÑпользовании ключа \var{-vu} Ñообщает о том, что аÑÑемблерный или объектный файл Ð¼Ð¾Ð´ÑƒÐ»Ñ +% Ñтарше, чем ppu-файл модулÑ. +unit_u_recompile_obj_older_than_asm=10033_U_ПеpекомпилÑÑ†Ð¸Ñ Ð¼Ð¾Ð´yлÑ, .obj файл Ñтаpше чем .as файл +% При иÑпользовании ключа \var{-vu} Ñообщает о том, что объектный файл Ð¼Ð¾Ð´ÑƒÐ»Ñ +% Ñтарше, чем его аÑÑемблерный файл. +unit_u_parsing_interface=10034_U_Ðнализ интеpфейÑа $1 +% При иÑпользовании ключа \var{-vu} Ñообщает о начале анализа +% интерфейÑной чаÑти модулÑ. +unit_u_parsing_implementation=10035_U_Ðнализ pеализации $1 +% При иÑпользовании ключа \var{-vu} Ñообщает о начале анализа +% реализационной чаÑти модулÑ. +unit_u_second_load_unit=10036_U_ÐŸÐ¾Ð²Ñ‚Ð¾Ñ€Ð½Ð°Ñ Ð·Ð°Ð³pyзка модyÐ»Ñ $1 +% При иÑпользовании ключа \var{-vu} Ñообщает о начале повторной компилÑции +% модулч. Это может проиÑходить при наличии взаимозавиÑимых модулей. +unit_u_check_time=10037_U_Проверка PPU файла $1 вpÐµÐ¼Ñ $2 +% При иÑпользовании ключа \var{-vu} показвает Ð¸Ð¼Ñ Ð¸ дату/Ð²Ñ€ÐµÐ¼Ñ Ñ„Ð°Ð¹Ð»Ð°, +% от которого завиÑит рекомпилÑциÑ. +### The following two error msgs is currently disabled. +#unit_h_cond_not_set_in_last_compile=10038_H_УÑловное выpажение $1 не было yÑтановлено пpи поÑледней компилÑции $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that currently is defined, but was not used the last +#% time the unit was compiled. +#unit_h_cond_set_in_last_compile=10039_H_УÑловное выpажение $1 было yÑтановлено пpи поÑледней компилÑции $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that was used the last time the unit was compiled, but +#% the conditional is currently not defined. +unit_w_cant_compile_unit_with_changed_incfile=10040_W_Ðайдены измененные включаемые файлы, но компилÑÑ†Ð¸Ñ $1 невозможна +% Обнаружено изменение включаемых файлов модулÑ, но некоторые иÑходные файлы +% не найдены, поÑтому рекомпилÑÑ†Ð¸Ñ Ð½ÐµÐ²Ð¾Ð·Ð¼Ð¾Ð¶Ð½Ð°. +unit_u_source_modified=10041_U_Файл $1 новее, чем $2 +% Ðайден измененный иÑходный файл модулÑ. +unit_u_ppu_invalid_fpumode=10042_U_Попытка иÑÐ¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ð½Ð¸Ñ Ð¼Ð¾Ð´ÑƒÐ»Ñ, Ñкомпилированного Ñ Ð´Ñ€ÑƒÐ³Ð¸Ð¼ режимом ÑопроцеÑÑора +% Попытка иÑÐ¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ð½Ð¸Ñ Ð¼Ð¾Ð´ÑƒÐ»ÐµÐ¹, которые были Ñкомпилированы Ñ Ð¾Ñ‚Ð»Ð¸Ñ‡Ð°ÑŽÑ‰Ð¸Ð¼ÑÑ Ñ€ÐµÐ¶Ð¸Ð¼Ð¾Ð¼ +% формата плавающей запÑтой. Ð’Ñе модули должны быть Ñкомпилированы либо Ñ Ð²ÐºÐ»ÑŽÑ‡ÐµÐ½Ð½Ð¾Ð¹ +% ÑмулÑцией ÑопроцеÑÑора, либо Ñ Ð¾Ñ‚ÐºÐ»ÑŽÑ‡ÐµÐ½Ð½Ð¾Ð¹, но не вперемешку. +unit_u_loading_interface_units=10043_U_Загрузка модулей из интерфейÑной чаÑти $1 +% При иÑпользовании ключа \var{-vu} Ñообщает о начале загрузки модулей, +% иÑпользуемых в интерфейÑной чаÑти указанного модулÑ. +unit_u_loading_implementation_units=10044_U_Загрузка модулей из реализационной чаÑти $1 +% При иÑпользовании ключа \var{-vu} Ñообщает о начале загрузки модулей, +% иÑпользуемых в реализационной чаÑти указанного модулÑ. +unit_u_interface_crc_changed=10045_U_У Ð¼Ð¾Ð´ÑƒÐ»Ñ $1 изменилаÑÑŒ ÐºÐ¾Ð½Ñ‚Ñ€Ð¾Ð»ÑŒÐ½Ð°Ñ Ñумма интерфейÑа +% При иÑпользовании ключа \var{-vu} Ñообщает о том, что ÐºÐ¾Ð½Ñ‚Ñ€Ð¾Ð»ÑŒÐ½Ð°Ñ Ñумма, +% вычиÑÐ»ÐµÐ½Ð½Ð°Ñ Ð´Ð»Ñ Ð¸Ð½Ñ‚ÐµÑ€Ñ„ÐµÐ¹Ñной чаÑти модулÑ, изменилаÑÑŒ поÑле разбора его реализационной +% чаÑти. +unit_u_implementation_crc_changed=10046_U_У Ð¼Ð¾Ð´ÑƒÐ»Ñ $1 изменилаÑÑŒ ÐºÐ¾Ð½Ñ‚Ñ€Ð¾Ð»ÑŒÐ½Ð°Ñ Ñумма реализации +% При иÑпользовании ключа \var{-vu} Ñообщает, что ÐºÐ¾Ð½Ñ‚Ñ€Ð¾Ð»ÑŒÐ½Ð°Ñ Ñумма Ð¼Ð¾Ð´ÑƒÐ»Ñ +% изменилаÑÑŒ поÑле разбора его реализационной чаÑти. +unit_u_finished_compiling=10047_U_Завершена компилÑÑ†Ð¸Ñ Ð¼Ð¾Ð´ÑƒÐ»Ñ $1 +% При иÑпользовании ключа \var{-vu} Ñообщает о завершени компилÑции модулÑ. +unit_u_add_depend_to=10048_U_Добавлена завиÑимоÑÑ‚ÑŒ $1 от $2 +% При иÑпользовании ключа \var{-vu} Ñообщает о том, что была добавлена +% завиÑимоÑÑ‚ÑŒ между Ð´Ð²ÑƒÐ¼Ñ Ð¼Ð¾Ð´ÑƒÐ»Ñми. +unit_u_no_reload_is_caller=10049_U_Без перезагрузки, Ñто инициатор: $1 +% При иÑпользовании ключа \var{-vu} предупреждает о том, что +% модуль не будет перезагружен, потому что он Ñам ÑвлÑетÑÑ Ð¸Ð½Ð¸Ñ†Ð¸Ð°Ñ‚Ð¾Ñ€Ð¾Ð¼ Ñвоей +% перезагрузки. +unit_u_no_reload_in_second_compile=10050_U_Без перезагрузки, уже Ð¿Ð¾Ð²Ñ‚Ð¾Ñ€Ð½Ð°Ñ ÐºÐ¾Ð¼Ð¿Ð¸Ð»ÑциÑ: $1 +% При иÑпользовании ключа \var{-vu} предупреждает, что модуль +% не будет перезагружен, Ñ‚.к. он уже был перезагружен и компилируетÑÑ Ð²Ð¾ второй раз. +unit_u_flag_for_reload=10051_U_Помечено Ð´Ð»Ñ Ð¿ÐµÑ€ÐµÐ·Ð°Ð³Ñ€ÑƒÐ·ÐºÐ¸: $1 +% При иÑпользовании ключа \var{-vu} Ñообщает о том, что модуль будет перезагружен. +unit_u_forced_reload=10052_U_Ð’Ñ‹Ð½ÑƒÐ¶Ð´ÐµÐ½Ð½Ð°Ñ Ð¿ÐµÑ€ÐµÐ·Ð°Ð³Ñ€ÑƒÐ·ÐºÐ° +% При иÑпользовании ключа \var{-vu} Ñообщает о том, что модуль пришлоÑÑŒ перезагрузить. +unit_u_previous_state=10053_U_Прежний ÑÑ‚Ð°Ñ‚ÑƒÑ $1: $2 +% При иÑпользовании ключа \var{-vu} показывает предыдущий ÑÑ‚Ð°Ñ‚ÑƒÑ Ð¼Ð¾Ð´ÑƒÐ»Ñ. +unit_u_second_compile_unit=10054_U_$1 уже компилируетÑÑ, переход к повторной компилÑции +% При иÑпользовании ключа \var{-vu} предупреждает о начале перекомпилÑции Ð¼Ð¾Ð´ÑƒÐ»Ñ +% во второй раз. Это может проиÑходить Ñо взаимозавиÑимыми модулÑми. +unit_u_loading_unit=10055_U_Загрузка Ð¼Ð¾Ð´ÑƒÐ»Ñ $1 +% При иÑпользовании ключа \var{-vu} Ñообщает о начале загрузки модулÑ. +unit_u_finished_loading_unit=10056_U_Загрузка Ð¼Ð¾Ð´ÑƒÐ»Ñ $1 завершена +% При иÑпользовании ключа \var{-vu} Ñообщает о завершении загрузки модулÑ. +unit_u_registering_new_unit=10057_U_РегиÑÑ‚Ñ€Ð°Ñ†Ð¸Ñ Ð½Ð¾Ð²Ð¾Ð³Ð¾ Ð¼Ð¾Ð´ÑƒÐ»Ñ $1 +% При иÑпользовании ключа \var{-vu} Ñообщает о том, что компилÑтор вÑтретил новый модуль +% и зарегиÑтрировал его во внутренних ÑпиÑках. +unit_u_reresolving_unit=10058_U_Повторное разрешение завиÑимоÑтей Ð¼Ð¾Ð´ÑƒÐ»Ñ $1 +% При иÑпользовании ключа \var{-vu} предупреждает о том, что компилÑтору пришлоÑÑŒ +% повторно вычиÑлить внутренние данные указанного модулÑ. +unit_u_skipping_reresolving_unit=10059_U_ПропуÑк повторного Ñ€Ð°Ð·Ñ€ÐµÑˆÐµÐ½Ð¸Ñ Ð¼Ð¾Ð´ÑƒÐ»Ñ $1, загрузка иÑпользуемых модулей продолжаетÑÑ +% При иÑпользовании ключа \var{-vu} Ñообщает о том, что повторное вычиÑление данных +% Ð¼Ð¾Ð´ÑƒÐ»Ñ Ð¿Ñ€Ð¾Ð¿ÑƒÑ‰ÐµÐ½Ð¾, потому что вычиÑлÑÑ‚ÑŒ пока нечего. +unit_u_unload_resunit=10060_U_Выгрузка Ð¼Ð¾Ð´ÑƒÐ»Ñ Ð¾Ð±Ñ€Ð°Ð±Ð¾Ñ‚ÐºÐ¸ реÑурÑов $1 (не нужен) +% При иÑпользовании ключа \var{-vu} Ñообщает о том, что модуль обработки реÑурÑов +% выгружаетÑÑ, Ñ‚.к. реÑурÑÑ‹ не иÑпользуютÑÑ Ð¿Ñ€Ð¾Ð³Ñ€Ð°Ð¼Ð¼Ð¾Ð¹. +unit_e_different_wpo_file=10061_E_Модуль $1 Ñкомпилирован Ñ Ð¸Ñпользованием отличающихÑÑ Ð½Ð°Ñтроек оптимизации вÑей программы (wpo) ($2, $3); перекомпилируйте его без wpo или Ñ Ñ‚ÐµÐ¼ же файлом обратной ÑвÑзи +% Когда модуль был Ñкомпилирован Ñ Ð¾Ð¿Ñ€ÐµÐ´ÐµÐ»ÐµÐ½Ð½Ñ‹Ð¼ файлом обратной ÑвÑзи оптимизации вÑей программы (wpo) (\var{-FW<x>} \var{-OW<x>}), +% его ÑÐºÐ¾Ð¼Ð¿Ð¸Ð»Ð¸Ñ€Ð¾Ð²Ð°Ð½Ð½Ð°Ñ Ð²ÐµÑ€ÑÐ¸Ñ Ñпециализирована под данный Ñценарий компилÑции и не может быть иÑпользована +% по другому назначению. Ð”Ð»Ñ Ð¸ÑÐ¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ð½Ð¸Ñ Ð¼Ð¾Ð´ÑƒÐ»Ñ Ð² другой программе или Ñ Ð´Ñ€ÑƒÐ³Ð¸Ð¼Ð¸ наÑтройками wpo +% его необходимо перекомпилировать. +% \end{description} +# EndOfTeX + +# +# Options +# +# 11047 is the last used one +# +option_usage=11000_O_$1 [опции] <файл> [опции] +# BeginOfTeX +% +% \section{Ошибки обработки командной Ñтроки} +% Ошибки, которые могут возникать во Ð²Ñ€ÐµÐ¼Ñ Ð¾Ð±Ñ€Ð°Ð±Ð¾Ñ‚ÐºÐ¸ командной Ñтроки +% или файлов конфигурации. +% \begin{description} +option_only_one_source_support=11001_W_ПоддеpживаетÑÑ Ñ‚Ð¾Ð»ÑŒÐºÐ¾ один иÑходный файл, вмеÑто $1 будет Ñкомпилирован $2 +% Ð’ командной Ñтроке можно указывать только один файл. Первый обнаруженный файл будет +% Ñкомпилирован, оÑтальные игнорируютÑÑ. Может быть признаком того, что +% перед опцией забыт знак \var{'-'}. +option_def_only_for_os2=11002_W_DEF файл можно Ñоздавать только Ð´Ð»Ñ OS/2 +% This option can only be specified when you're compiling for OS/2 +option_no_nested_response_file=11003_E_Вложенные файлы ответа не поддеpживаютÑÑ +% ÐžÐ¿Ñ†Ð¸Ñ ÐºÐ¾Ð¼Ð°Ð½Ð´Ð½Ð¾Ð¹ Ñтроки \var{@file} не позволÑет иÑпользовать вложенные файлы ответа. +option_no_source_found=11004_F_Ð’ командной Ñтроке отÑутÑтвует Ð¸Ð¼Ñ Ð¸Ñходного файла +% Ð’ командной Ñтроке должно приÑутÑтвовать Ð¸Ð¼Ñ Ð¸Ñходного файла. +option_no_option_found=11005_N_Файл конфигурации $1 не Ñодержит опций компилÑтора +% Ð’ указанном файле конфигурации не обнаружено ни одной опции. +option_illegal_para=11006_E_Hевеpный паpаметp: $1 +% Указана неизвеÑÑ‚Ð½Ð°Ñ Ð¾Ð¿Ñ†Ð¸Ñ. +option_help_pages_para=11007_H_-? выводит ÑÑ‚pаницы Ñправки +% Это Ñообщение выводитÑÑ, еÑли указана неизвеÑÑ‚Ð½Ð°Ñ Ð¾Ð¿Ñ†Ð¸Ñ. +option_too_many_cfg_files=11008_F_Слишком много вложенных файлов конфигурации +% Уровень Ð²Ð»Ð¾Ð¶ÐµÐ½Ð¸Ñ Ñ„Ð°Ð¹Ð»Ð¾Ð² конфигурации ограничен чиÑлом 16. +option_unable_open_file=11009_F_Hевозможно откpÑ‹Ñ‚ÑŒ $1 +% Ошибка при открытии файла конфигурации. +option_reading_further_from=11010_D_ПродолжаетÑÑ Ñ‡Ñ‚ÐµÐ½Ð¸Ðµ паpаметpов из $1 +% ВыдаетÑÑ, еÑли включен вывод заметок, и компилÑтор переключаетÑÑ Ð½Ð° +% другой файл конфигурации. +option_target_is_already_set=11011_W_Ð¦ÐµÐ»ÐµÐ²Ð°Ñ Ð¿Ð»Ð°Ñ‚Ñ„Ð¾Ñ€Ð¼Ð° уже yÑтановлена в: $1 +% Указано более одной опции \var{-T}, определÑющей целевую платформу. +option_no_shared_lib_under_dos=11012_W_РазделÑемые библиотеки не поддеpживаютÑÑ Ð´Ð»Ñ DOS, будут ÑтатичеÑкими +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos +option_too_many_ifdef=11013_F_Слишком много $IFDEF или $IFNDEF в файле опций $1 Ñтрока $2 +% КоличеÑтво директив \var{\#IF(N)DEF} в файле конфигурации не Ñовпадает Ñ ÐºÐ¾Ð»Ð¸Ñ‡ÐµÑтвом +% директив \var{\#ENDIF}. +option_too_many_endif=11014_F_Ðеожиданный $ENDIF в файле опций $1 Ñтрока $2 +% КоличеÑтво директив \var{\#IF(N)DEF} в файле конфигурации не Ñовпадает Ñ ÐºÐ¾Ð»Ð¸Ñ‡ÐµÑтвом +% директив \var{\#ENDIF}. +option_too_less_endif=11015_F_Ðезакрытое yÑловное выpажение в конце файла опций +% КоличеÑтво директив \var{\#IF(N)DEF} в файле конфигурации не Ñовпадает Ñ ÐºÐ¾Ð»Ð¸Ñ‡ÐµÑтвом +% директив \var{\#ENDIF}. +option_no_debug_support=11016_W_Этот ÑкземплÑÑ€ компилÑтора не поддерживает генеpацию отладочной инфоpмации +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_Попpобyйте Ñобрать Ñ Ð¾Ð¿Ñ†Ð¸ÐµÐ¹ -dGDB +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_W_ИÑпользyетÑÑ yÑтаpевший ключ $1 +% Предупреждает, что ÑƒÐºÐ°Ð·Ð°Ð½Ð½Ð°Ñ Ð¾Ð¿Ñ†Ð¸Ñ Ð±Ð¾Ð»ÑŒÑˆÐµ не нужна/не поддерживаетÑÑ. +% Ее рекомендуетÑÑ ÑƒÐ´Ð°Ð»Ð¸Ñ‚ÑŒ, чтобы избежать проблем в Ñлучае, еÑли +% в будущем значение опции изменитÑÑ. +option_obsolete_switch_use_new=11019_W_ИÑпользyетÑÑ yÑтаpевший ключ $1, иÑпользyйте вмеÑто него ключ $2 +% Предупреждает, что ÑƒÐºÐ°Ð·Ð°Ð½Ð½Ð°Ñ Ð¾Ð¿Ñ†Ð¸Ñ Ð±Ð¾Ð»ÑŒÑˆÐµ не поддерживаетÑÑ Ð¸ вмеÑто нее Ñледует иÑпользовать другую. +% РекомендуетÑÑ Ð·Ð°Ð¼ÐµÐ½Ð¸Ñ‚ÑŒ ключ, чтобы избежать проблем в Ñлучае, еÑли +% в будущем его значение изменитÑÑ. +option_switch_bin_to_src_assembler=11020_N_Пеpеключение на аÑÑемблеp, генерирующий текÑÑ‚ +% ÐÑÑемблер (Ñ Ð´Ð²Ð¾Ð¸Ñ‡Ð½Ñ‹Ð¼ форматом выходных файлов) был изменен, потому что был иÑпользован ключ -a, +% который означает Ñоздание аÑÑемблерных файлов в текÑтовом формате. +option_incompatible_asm=11021_W_Выбранный аÑÑемблер "$1" не ÑовмеÑтим Ñ "$2" +option_asm_forced=11022_W_Вынужденно иÑпользетÑÑ Ð°ÑÑемблер "$1" +% Заданный тип аÑÑемблера не позволÑет Ñоздавать объектные файлы +% в правильном формате. ВмеÑто него будет иÑпользован аÑÑемблер по умолчанию +% Ð´Ð»Ñ Ð²Ñ‹Ð±Ñ€Ð°Ð½Ð½Ð¾Ð¹ платформы. +option_using_file=11026_T_Чтение опций из файла $1 +% Опции читаютÑÑ Ñ‚Ð°ÐºÐ¶Ðµ из указанного файла. +option_using_env=11027_T_Чтение опций из переменной Ð¾ÐºÑ€ÑƒÐ¶ÐµÐ½Ð¸Ñ $1 +% Опции читаютÑÑ Ñ‚Ð°ÐºÐ¶Ðµ из указанной переменной окружениÑ. +option_handling_option=11028_D_Обработка опции "$1" +% Отладочное Ñообщение о том, что Ð¾Ð¿Ñ†Ð¸Ñ Ð½Ð°Ð¹Ð´ÐµÐ½Ð° и будет обработана. +option_help_press_enter=11029_O_*** нажмите enter *** +% Сообщени выдаетÑÑ Ð¿Ñ€Ð¸ поÑтраничном выводе Ñправки. Ðажатие клавиши ENTER +% вызывает показ Ñледующей Ñтраницы. ЕÑли нажать q и затем ENTER, компилÑтор +% завершает работу. +option_start_reading_configfile=11030_H_Ðачало Ñ‡Ñ‚ÐµÐ½Ð¸Ñ Ñ„Ð°Ð¹Ð»Ð° конфигурации $1 +% Ðачало Ñ‡Ñ‚ÐµÐ½Ð¸Ñ Ñ„Ð°Ð¹Ð»Ð° конфигурации. +option_end_reading_configfile=11031_H_Конец Ñ‡Ñ‚ÐµÐ½Ð¸Ñ Ñ„Ð°Ð¹Ð»Ð° конфигурации $1 +% Окончание Ñ‡Ñ‚ÐµÐ½Ð¸Ñ Ñ„Ð°Ð¹Ð»Ð° конфигурации. +option_interpreting_option=11032_D_Ð¸Ð½Ñ‚ÐµÑ€Ð¿Ñ€ÐµÑ‚Ð°Ñ†Ð¸Ñ Ð¾Ð¿Ñ†Ð¸Ð¸ "$1" +% КомпилÑтор интерпретирует опцию. +option_interpreting_firstpass_option=11036_D_Ð¸Ð½Ñ‚ÐµÑ€Ð¿Ñ€ÐµÑ‚Ð°Ñ†Ð¸Ñ Ð¾Ð¿Ñ†Ð¸Ð¸ первого прохода "$1" +% КомпилÑтор интерпретирует опцию в первый раз. +option_interpreting_file_option=11033_D_Ð¸Ð½Ñ‚ÐµÑ€Ð¿Ñ€ÐµÑ‚Ð°Ñ†Ð¸Ñ Ð¾Ð¿Ñ†Ð¸Ð¸ из файла "$1" +% КомпилÑтор интерпретирует опцию, прочитанную из файла конфигурации. +option_read_config_file=11034_D_Чтение файла конфигурации "$1" +% Ðачало Ñ‡Ñ‚ÐµÐ½Ð¸Ñ ÑƒÐºÐ°Ð·Ð°Ð½Ð½Ð¾Ð³Ð¾ файла конфигурации (отладочное Ñообщение). +option_found_file=11035_D_найдено Ð¸Ð¼Ñ Ð¸Ñходного файла "$1" +% Ð”Ð¾Ð¿Ð¾Ð»Ð½Ð¸Ñ‚ÐµÐ»ÑŒÐ½Ð°Ñ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾Ð± опциÑÑ…, выводитÑÑ Ð¿Ñ€Ð¸ +% включенных отладочных ÑообщениÑÑ…. +option_code_page_not_available=11039_E_ÐеизвеÑÑ‚Ð½Ð°Ñ ÐºÐ¾Ð´Ð¾Ð²Ð°Ñ Ñтраница +% Указана неизвеÑÑ‚Ð½Ð°Ñ ÐºÐ¾Ð´Ð¾Ð²Ð°Ñ Ñтраница Ð´Ð»Ñ Ð¸Ñходных файлов. +% КомпилÑтор имеет вÑтроенную поддержку неÑкольких кодовых Ñтраниц. +% Ð—Ð°Ð¿Ñ€Ð¾ÑˆÐµÐ½Ð½Ð°Ñ ÐºÐ¾Ð´Ð¾Ð²Ð°Ñ Ñтраница в их чиÑло не входит. Ð”Ð»Ñ Ð´Ð¾Ð±Ð°Ð²Ð»ÐµÐ½Ð¸Ñ +% поддержки потребуетÑÑ Ð¿ÐµÑ€ÐµÑборка компилÑтора. +option_config_is_dir=11040_F_Файл конфигурации $1 - Ð´Ð¸Ñ€ÐµÐºÑ‚Ð¾Ñ€Ð¸Ñ +% Директории Ð½ÐµÐ»ÑŒÐ·Ñ Ð¸Ñпользовать в качеÑтве файлов конфигурации. +option_confict_asm_debug=11041_W_Выбранный тип аÑÑемблера "$1" не поддерживает отладочную информацию, отладка отключена +% Выбранный аÑÑемблер не поддерживает генерацию отладочной информации, +% поÑтому возможноÑÑ‚ÑŒ отладки отключена. +option_ppc386_deprecated=11042_W_ИÑпользование ppc386.cfg ÑвлÑетÑÑ ÑƒÑтаревшим, вмеÑто него Ñледует иÑпользовать fpc.cfg +% Using ppc386.cfg is still supported for historical reasons, however, for a multiplatform +% system the naming makes no sense anymore. Please continue to use fpc.cfg instead. +option_else_without_if=11043_F_Ð’ файле опций $1 Ñтрока $2 обнаружена директива \var{\#ELSE} без предварительной \var{\#IF(N)DEF} +% Ð’ файле конфигурации обнаружена директива \var{\#ELSE} без предварительной директивы \var{\#IF(N)DEF}. +option_unsupported_target=11044_F_ÐžÐ¿Ñ†Ð¸Ñ "$1" не поддерживаетÑÑ (или пока не поддерживаетÑÑ) Ð´Ð»Ñ Ñ†ÐµÐ»ÐµÐ²Ð¾Ð¹ платформы +% Ðе вÑе опции поддерживаютÑÑ Ð¸Ð»Ð¸ реализованы Ð´Ð»Ñ Ð²Ñех платформ. Это Ñообщение о том, +% что Ð²Ñ‹Ð±Ñ€Ð°Ð½Ð½Ð°Ñ Ð¾Ð¿Ñ†Ð¸Ñ Ð½ÐµÑовмеÑтима Ñ Ñ‚ÐµÐºÑƒÑ‰ÐµÐ¹ платформой. +option_unsupported_target_for_feature=11045_F_ОÑобенноÑÑ‚ÑŒ "$1" не поддерживаетÑÑ (или пока не поддерживаетÑÑ) Ð´Ð»Ñ Ð²Ñ‹Ð±Ñ€Ð°Ð½Ð½Ð¾Ð¹ целевой платформы +% Ðе вÑе опции поддерживаютÑÑ Ð¸Ð»Ð¸ реализованы Ð´Ð»Ñ Ð²Ñех платформ. Это Ñообщение о том, +% что Ð²Ñ‹Ð±Ñ€Ð°Ð½Ð½Ð°Ñ Ð¾Ð¿Ñ†Ð¸Ñ Ð½ÐµÑовмеÑтима Ñ Ñ‚ÐµÐºÑƒÑ‰ÐµÐ¹ платформой. +option_dwarf_smart_linking=11046_N_Ðа выбранной платформе Ð½ÐµÐ»ÑŒÐ·Ñ Ð¸Ñпользовать отладочную информацию типа DWARF ÑовмеÑтно Ñ "умной" компоновкой, переключение на ÑтатичеÑкую компоновку +% "УмнаÑ" компоновка в наÑтоÑщее Ð²Ñ€ÐµÐ¼Ñ Ð½ÐµÑовмеÑтима Ñ Ð¾Ñ‚Ð»Ð°Ð´Ð¾Ñ‡Ð½Ð¾Ð¹ информацией типа DWARF на большинÑтве +% платформ, поÑтому при выборе формата DWARF "умнаÑ" компоновка отключаетÑÑ. +option_ignored_target=11047_W_ÐžÐ¿Ñ†Ð¸Ñ "$1" игнорируетÑÑ Ð´Ð»Ñ Ð²Ñ‹Ð±Ñ€Ð°Ð½Ð½Ð¾Ð¹ целевой платформы. +% Ðе вÑе опции поддерживаютÑÑ Ð¸Ð»Ð¸ реализованы Ð´Ð»Ñ Ð²Ñех платформ. Это Ñообщение о том, +% что Ð²Ñ‹Ð±Ñ€Ð°Ð½Ð½Ð°Ñ Ð¾Ð¿Ñ†Ð¸Ñ Ð¸Ð³Ð½Ð¾Ñ€Ð¸Ñ€ÑƒÐµÑ‚ÑÑ Ð´Ð»Ñ Ñ‚ÐµÐºÑƒÑ‰ÐµÐ¹ платформы. +% \end{description} +# EndOfTeX + +# +# Whole program optimization +# +# 12019 is the last used one +# +# BeginOfTeX +% +% \section{Ð¡Ð¾Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ Ð¾Ð¿Ñ‚Ð¸Ð¼Ð¸Ð·Ð°Ñ†Ð¸Ð¸ вÑей программы} +% Раздел Ñодержит ÑÐ¾Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ Ð¾Ð± ошибках, которые могут возникать +% в процеÑÑе оптимизации вÑей программы (wpo). +% \begin{description} +wpo_cant_find_file=12000_F_Ðевозможно открыть файл данных WPO "$1" +% КомпилÑтор не может открыть указанный файл Ñ Ð´Ð°Ð½Ð½Ñ‹Ð¼Ð¸ оптимизации вÑей программы. +wpo_begin_processing=12001_D_Обработка информации WPO в файле "$1" +% КомпилÑтор начинает обработку данных Ð´Ð»Ñ Ð¾Ð¿Ñ‚Ð¸Ð¼Ð¸Ð·Ð°Ñ†Ð¸Ð¸ вÑей программы в указанном файле. +wpo_end_processing=12002_D_Закончена обработка информации WPO в файле "$1" +% КомпилÑтор закончил обработку данных Ð´Ð»Ñ Ð¾Ð¿Ñ‚Ð¸Ð¼Ð¸Ð·Ð°Ñ†Ð¸Ð¸ вÑей программы в указанном файле. +wpo_expected_section=12003_E_ОжидалÑÑ Ð·Ð°Ð³Ð¾Ð»Ð¾Ð²Ð¾Ðº Ñекции, но получено "$2" в Ñтроке $1 файла WPO-информации +% При обработке файла оптимизации вÑей программы компилÑтор ожидал заголовок Ñекции (начинаетÑÑ Ñ \%), +% но не нашел его. +wpo_no_section_handler=12004_W_Ðе зарегиÑтрирован обработчик Ð´Ð»Ñ Ñекции "$2" в Ñтроке $1 файла WPO, игнорируетÑÑ +% КомпилÑтор не имеет обработчика Ð´Ð»Ñ ÑƒÐ¿Ð¾Ð¼Ñнутой Ñекции файла WPO-информации, +% поÑтому он пропуÑкает Ñту Ñекцию и переходит к Ñледующей. +wpo_found_section=12005_D_Ðайдена ÑÐµÐºÑ†Ð¸Ñ "$1" Ñ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸ÐµÐ¹ о "$2" +% КомпилÑтор обнаружил в файле WPO Ñекцию Ñ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸ÐµÐ¹, которую он может обработать. +wpo_no_input_specified=12006_F_Выбранные режимы оптимизации вÑей программы требуют предварительно Ñозданного файла обратной ÑвÑзи (укажите Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ -Fw) +% Чтобы выполнить выбранную оптимизацию вÑей программы, компилÑтору требуетÑÑ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ, +% ÑÐ¾Ð±Ñ€Ð°Ð½Ð½Ð°Ñ Ð² процеÑÑе предыдущей компилÑции. Файл, Ñодержащий Ñту информацию, должен быть указан +% Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ ключа -Fw. +wpo_not_enough_info=12007_E_Файл обратной ÑвÑзи не Ñодержит информации, необходимой Ð´Ð»Ñ Ð¿Ñ€Ð¾Ð²ÐµÐ´ÐµÐ½Ð¸Ñ Ð¾Ð¿Ñ‚Ð¸Ð¼Ð¸Ð·Ð°Ñ†Ð¸Ð¸ "$1" +% Указанный файл обратной ÑвÑзи не Ñодержит информацию, ÐºÐ¾Ñ‚Ð¾Ñ€Ð¾Ð°Ñ Ð½ÑƒÐ¶Ð½Ð° Ð´Ð»Ñ Ð¿Ñ€Ð¾Ð²ÐµÐ´ÐµÐ½Ð¸Ñ Ñ‚Ñ€ÐµÐ±ÑƒÐµÐ¼Ð¾Ð³Ð¾ вида +% оптимизации. Скорее вÑего, нужно перекомпилировать программу, указав подходÑщий ключ -OWxxx. +wpo_no_output_specified=12008_F_Укажите файл обратной ÑвÑзи Ð´Ð»Ñ Ð·Ð°Ð¿Ð¸Ñи Ñобранной информации (Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ -FW) +% Ðеобходимо указать файл, в который компилÑтор запишет Ñобранные во Ð²Ñ€ÐµÐ¼Ñ ÐºÐ¾Ð¼Ð¿Ð¸Ð»Ñции +% данные Ð´Ð»Ñ Ð¾Ð¿Ñ‚Ð¸Ð¼Ð¸Ð·Ð°Ñ†Ð¸Ð¸ вÑей программы. Это делаетÑÑ Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ ключа -FW. +wpo_output_without_info_gen=12009_E_Файл обратной ÑвÑзи указан (Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ -FW), но не указан требуемый тип Ñобираемой информации +% Помимо ÑƒÐºÐ°Ð·Ð°Ð½Ð¸Ñ Ð¸Ð¼ÐµÐ½Ð¸ файла обратной ÑвÑзи wpo Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ -FW, Ñледует указывать +% требуемые виды оптимизации Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ -OWxxx, иначе Ð¿Ð¾Ð»ÐµÐ·Ð½Ð°Ñ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð² файл запиÑана +% не будет. +wpo_input_without_info_use=12010_E_Файл обратной ÑвÑзи указан (Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ -Fw), но не указан тип оптимизации, который Ñледует выполнить +% ЕÑли указан файл обратной ÑвÑзи wpo Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ -Fw, но не заданы виды оптимизации Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ -Owxxx, +% будет выдана Ð´Ð°Ð½Ð½Ð°Ñ Ð¾ÑˆÐ¸Ð±ÐºÐ°. Указанные ключи Ñледует иÑпользовать ÑовмеÑтно. +wpo_skipping_unnecessary_section=12011_D_Ð¡ÐµÐºÑ†Ð¸Ñ wpo пропущена "$1", поÑкольку не требуетÑÑ Ð´Ð»Ñ Ð·Ð°Ð¿Ñ€Ð¾ÑˆÐµÐ½Ð½Ñ‹Ñ… оптимизаций +% Файл обратной ÑвÑзи wpo Ñодержит Ñекцию Ñ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸ÐµÐ¹, ÐºÐ¾Ñ‚Ð¾Ñ€Ð°Ñ Ð½Ðµ требуетÑÑ +% Ð´Ð»Ñ Ð¿Ñ€Ð¾Ð²ÐµÐ´ÐµÐ½Ð¸Ñ Ð²Ñ‹Ð±Ñ€Ð°Ð½Ð½Ñ‹Ñ… типов оптимизации. +wpo_duplicate_wpotype=12012_W_ИнформациÑ, ранее Ð¿Ñ€Ð¾Ñ‡Ð¸Ñ‚Ð°Ð½Ð½Ð°Ñ Ð¸Ð· файла обратной ÑвÑзи Ð´Ð»Ñ "$1", перекрываетÑÑ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸ÐµÐ¹ из Ñекции "$2" +% Файл обратной ÑвÑзи wpo Ñодержит неÑколько Ñекций Ñ Ð¾Ð´Ð½Ð¾Ñ‚Ð¸Ð¿Ð½Ð¾Ð¹ информацией (например, +% о том, какие виртуальные методы могут быть де-виртуализированы). Ð’ Ñтом Ñлучае иÑпользуетÑÑ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ +% из поÑледней Ñекции. Включите отладочные ÑÐ¾Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ (-vd), чтобы увидеть, какие клаÑÑÑ‹ информации ÑодержатÑÑ +% в каждой из Ñекций. +wpo_cannot_extract_live_symbol_info_strip=12013_E_Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ живучеÑти Ñимволов не может быть получена из программы без отладочной информации, иÑпользуйте -Xs- +% Ðекоторые ÑпоÑобы Ñбора информации о живучеÑти Ñимволов предполагают анализ Ñимвольной информации +% готовой программы. ЕÑли Ñта Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ ÑƒÐ´Ð°Ð»ÐµÐ½Ð° (Ð¾Ð¿Ñ†Ð¸Ñ -Xs), такой анализ невозможен. +wpo_cannot_extract_live_symbol_info_no_link=12014_E_Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ живучеÑти Ñимволов не может быть получена без Ñкомпонованной программы +% Ðекоторые ÑпоÑобы Ñбора информации о живучеÑти Ñимволов предполагают анализ Ñимвольной информации +% готовой программы. ЕÑли программа не Ñкомпонована, такой анализ невозможен. +wpo_cannot_find_symbol_progs=12015_F_Ðе найдены "$1" или "$2" Ð´Ð»Ñ Ð¸Ð·Ð²Ð»ÐµÑ‡ÐµÐ½Ð¸Ñ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ð¸ о Ñимволах из Ñкомпонованной программы +% Ðекоторые ÑпоÑобы Ñбора информации о живучеÑти Ñимволов иÑпользуют вÑпомогательные программы +% Ð´Ð»Ñ Ð¿Ð¾Ð»ÑƒÑ‡ÐµÐ½Ð¸Ñ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ð¸ о Ñимволах программы. Обычно Ñто программа 'nm', входÑÑ‰Ð°Ñ Ð² ÑоÑтав GNU binutils. +wpo_error_reading_symbol_file=12016_E_Ошибка Ñ‡Ñ‚ÐµÐ½Ð¸Ñ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ð¸ о живучеÑти Ñимволов, полученной от "$1" +% При получении информации о Ñимволах Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ вÑпомогательной программы ('nm' или 'objdump') произошла +% ошибка. Вывод вÑпомогательной программы оказалÑÑ ÐºÐ¾Ñ€Ð¾Ñ‡Ðµ ожидаемого, или имеет неверный формат. +wpo_error_executing_symbol_prog=12017_F_Ошибка Ð²Ñ‹Ð¿Ð¾Ð»Ð½ÐµÐ½Ð¸Ñ "$1" (код выхода: $2) при извлечении информации о Ñимволах +% При получении информации о Ñимволах Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ вÑпомогательной программы ('nm' или 'objdump') произошла +% ошибка. Ð’ÑÐ¿Ð¾Ð¼Ð¾Ð³Ð°Ñ‚ÐµÐ»ÑŒÐ½Ð°Ñ Ð¿Ñ€Ð¾Ð³Ñ€Ð°Ð¼Ð¼Ð° вернула указанный код ошибки. +wpo_symbol_live_info_needs_smart_linking=12018_E_Сбор информации о живучеÑти Ñимволов полезен только при "умной" компоновке, иÑпользуйте -CX -XX +% ЖивучеÑÑ‚ÑŒ Ñимвола определÑетÑÑ Ñ„Ð°ÐºÑ‚Ð¾Ð¼ его Ð½Ð°Ð»Ð¸Ñ‡Ð¸Ñ Ð² готовой Ñкомпонованной программе. ЕÑли отключена +% "умнаÑ" компоновка, вÑе Ñимволы вкючаютÑÑ Ð² программу незавиÑимо от того, иÑпользуютÑÑ Ð¾Ð½Ð¸ или нет. +% Это делает Ñбор информации о живучеÑти Ñимволов беÑÑмыÑленным. +wpo_cant_create_feedback_file=12019_E_Ðевозможно Ñоздать файл обратной ÑвÑзи "$1" +% Файл обратной ÑвÑзи wpo, указанный Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ ключа -FW, не может быть Ñоздан. +%\end{description} +# EndOfTeX + + +# +# Logo (option -l) +# +option_logo=11023_[ +КомпилÑтор Free Pascal верÑии $FPCFULLVERSION [$FPCDATE] Ð´Ð»Ñ $FPCCPU +Copyright (c) 1993-2011 by Florian Klaempfl +] + +# +# Info (option -i) +# +option_info=11024_[ +Free Pascal Compiler version $FPCVERSION + +Compiler Date : $FPCDATE +Compiler CPU Target: $FPCCPU + +Поддерживаемые платформы: + $OSTARGETS + +Поддерживаемые наборы команд CPU: + $INSTRUCTIONSETS + +Поддерживаемые наборы команд FPU: + $FPUINSTRUCTIONSETS + +Поддерживаемые ABI: + $ABITARGETS + +Поддерживаемые оптимизации: + $OPTIMIZATIONS + +Поддерживаемые оптимизации вÑей программы: + All + $WPOPTIMIZATIONS + +Поддерживаемые типы микроконтроллеров: + $CONTROLLERTYPES + +This program comes under the GNU General Public Licence +For more information read COPYING.FPC + +Report bugs, suggestions, etc. to: + http://bugs.freepascal.org +or + bugs@freepascal.org +] + +# +# Help pages (option -? and -h) +# +# The first character on the line indicates who will display this +# line, the current possibilities are : +# * = every target +# 3 = 80x86 targets +# 6 = 680x0 targets +# e = in extended debug mode only +# P = PowerPC targets +# S = Sparc targets +# V = Virtual machine targets +# The second character also indicates who will display this line, +# (if the above character was TRUE) the current possibilities are : +# * = everyone +# g = with GDB info supported by the compiler +# O = OS/2 +# L = UNIX systems +# The third character represents the indentation level. +# +option_help_pages=11025_[ +**0*_Добавьте '+' поÑле опции булева ключа Ð´Ð»Ñ ÐµÐ³Ð¾ Ð²ÐºÐ»ÑŽÑ‡ÐµÐ½Ð¸Ñ Ð¸ '-' Ð´Ð»Ñ Ð¾Ñ‚ÐºÐ»ÑŽÑ‡ÐµÐ½Ð¸Ñ +**1a_КомпилÑтор не удалÑет Ñозданный аÑÑемблерный файл +**2al_Вывод номеpов Ñтрок в аÑÑемблерный файл +**2an_Вывод информации об узлах графа в аÑÑемблерный файл +*L2ap_ИÑпользовать пайпы вмеÑто временных аÑÑемблерный файлов +**2ar_ПеречиÑлÑÑ‚ÑŒ выделениÑ/оÑÐ²Ð¾Ð±Ð¾Ð¶Ð´ÐµÐ½Ð¸Ñ pегиÑÑ‚pов в аÑÑемблеpном файле +**2at_ПеречиÑлÑÑ‚ÑŒ выделениÑ/оÑÐ²Ð¾Ð±Ð¾Ð¶Ð´ÐµÐ½Ð¸Ñ Ð²pеменных пеpеменных в аÑÑемблеpном файле +**1A<x>_Формат вывода: +**2Adefault_ÐÑÑемблер по умолчанию +3*2Aas_ÐÑÑемблер GNU AS +3*2Anasmcoff_COFF файл (Go32v2), иÑÐ¿Ð¾Ð»ÑŒÐ·ÑƒÑ Nasm +3*2Anasmelf_ELF32 файл (Linux), иÑÐ¿Ð¾Ð»ÑŒÐ·ÑƒÑ Nasm +3*2Anasmwin32_Win32 объектный файл, иÑÐ¿Ð¾Ð»ÑŒÐ·ÑƒÑ Nasm +3*2Anasmwdosx_Win32/WDOSX объектный файл, иÑÐ¿Ð¾Ð»ÑŒÐ·ÑƒÑ Nasm +3*2Awasm_Obj файл, иÑÐ¿Ð¾Ð»ÑŒÐ·ÑƒÑ Wasm (Watcom) +3*2Anasmobj_Obj файл, иÑÐ¿Ð¾Ð»ÑŒÐ·ÑƒÑ Nasm +3*2Amasm_Obj файл, иÑÐ¿Ð¾Ð»ÑŒÐ·ÑƒÑ Masm (Microsoft) +3*2Atasm_Obj файл, иÑÐ¿Ð¾Ð»ÑŒÐ·ÑƒÑ Tasm (Borland) +3*2Aelf_ELF (Linux) иÑÐ¿Ð¾Ð»ÑŒÐ·ÑƒÑ Ð²Ð½ÑƒÑ‚Ñ€ÐµÐ½Ð½Ð¸Ð¹ генератор +3*2Acoff_COFF (Go32v2) иÑÐ¿Ð¾Ð»ÑŒÐ·ÑƒÑ Ð²Ð½ÑƒÑ‚Ñ€ÐµÐ½Ð½Ð¸Ð¹ генератор +3*2Apecoff_PE-COFF (Win32) иÑÐ¿Ð¾Ð»ÑŒÐ·ÑƒÑ Ð²Ð½ÑƒÑ‚Ñ€ÐµÐ½Ð½Ð¸Ð¹ генератор +4*2Aas_ÐÑÑемблер GNU AS +6*2Aas_Unix o-файл, иÑÐ¿Ð¾Ð»ÑŒÐ·ÑƒÑ GNU AS +6*2Agas_GNU Motorola аÑÑемблер +6*2Amit_СинтакÑÐ¸Ñ MIT (Ñтарый GAS) +6*2Amot_Стандартный аÑÑемблер Motorola +A*2Aas_ÐÑÑемблер GNU AS +P*2Aas_ÐÑÑемблер GNU AS +S*2Aas_ÐÑÑемблер GNU AS +**1b_Генеpиpовать инфоpмацию Ð´Ð»Ñ Ð±pаyзеpа (IDE) +**2bl_Генеpиpовать также инфоpмацию о локальных Ñимволах +**1B_ПеpеÑборка вÑех модyлей +**1C<x>_Опции генеpатора кода: +**2Ca<x>_Выбор ABI, Ñм. fpc -i Ð´Ð»Ñ Ð²Ð¾Ð·Ð¼Ð¾Ð¶Ð½Ñ‹Ñ… значений +**2Cb_Генерировать big-endian код +**2Cc<x>_УÑтановить тип вызова по умолчанию в <x> +**2CD_Создать также динамичеÑкyÑŽ библиотекy (не поддеpживаетÑÑ) +**2Ce_Компилировать Ñ Ñмулированными инÑтрукциÑми Ñ Ð¿Ð»Ð°Ð²Ð°ÑŽÑ‰ÐµÐ¹ запÑтой +**2Cf<x>_Выбор набора команд ÑопроцеÑÑора, Ñм. fpc -i Ð´Ð»Ñ Ð²Ð¾Ð·Ð¼Ð¾Ð¶Ð½Ñ‹Ñ… значений +**2CF<x>_ÐœÐ¸Ð½Ð¸Ð¼Ð°Ð»ÑŒÐ½Ð°Ñ Ñ‚Ð¾Ñ‡Ð½Ð¾ÑÑ‚ÑŒ конÑтант Ñ Ð¿Ð»Ð°Ð²Ð°ÑŽÑ‰ÐµÐ¹ запÑтой (default, 32, 64) +**2Cg_Генерировать позиционно-незавиÑимый код (PIC) +**2Ch<n>_<n> байт кyчи (от 1023 до 67107840) +**2Ci_Пpовеpка ввода-вывода +**2Cn_ПpопyÑтить Ñтадию компоновки +**2Co_Пpовеpка Ð¿ÐµÑ€ÐµÐ¿Ð¾Ð»Ð½ÐµÐ½Ð¸Ñ Ñ†ÐµÐ»Ð¾Ñ‡Ð¸Ñленных операций +**2CO_Проверка возможного Ð¿ÐµÑ€ÐµÐ¿Ð¾Ð»Ð½ÐµÐ½Ð¸Ñ Ñ†ÐµÐ»Ð¾Ñ‡Ð¸Ñленных операций +**2Cp<x>_Выбор набора команд, Ñм. fpc -i Ð´Ð»Ñ Ð²Ð¾Ð·Ð¼Ð¾Ð¶Ð½Ñ‹Ñ… значений +**2CP<x>=<y>_ наÑтройки упаковки +**3CPPACKSET=<y>_ <y> упаковка множеÑтв: 0, 1 или DEFAULT или NORMAL, 2, 4 и 8 +**2Cr_Пpовеpка диапазонов +**2CR_Проверка правильноÑти вызова методов объектов +**2Cs<n>_УÑтановить pазмеp Ñтека в <n> +**2Ct_Проверка Ñтека (только теÑтирование, Ñм. руководÑтво) +**2CX_Создать также smartlink-библиотеку +**1d<x>_Опpеделить Ñимвол <x> +**1D_Создать DEF-файл +**2Dd<x>_УÑтановить опиÑание в <x> +**2Dv<x>_УÑтановить верÑию DLL в <x> +*O2Dw_Приложение PM +**1e<x>_УÑтановить пyÑ‚ÑŒ Ð´Ð»Ñ Ð¸ÑполнÑемых файлов +**1E_То же, что и -Cn +**1fPIC_То же, что и -Cg +**1F<x>_УÑтановка имен и путей файлов +**2Fa<x>[,y]_(Ð´Ð»Ñ Ð¿Ñ€Ð¾Ð³Ñ€Ð°Ð¼Ð¼Ñ‹) загрузить модули <x> и [y] перед чтением Ñекции uses +**2Fc<x>_УÑтановить кодовую Ñтраницу иÑходного файла в <x> +**2FC<x>_УÑтановить Ð¸Ð¼Ñ ÐºÐ¾Ð¼Ð¿Ð¸Ð»Ñтора реÑурÑов (.rc) в <x> +**2Fd_Отключить внутренний кÑш директорий компилÑтора +**2FD<x>_УÑтановить пyÑ‚ÑŒ поиÑка утилит компилÑтора +**2Fe<x>_Пеpенапpавить вывод ошибок в <x> +**2Ff<x>_Добавить <x> к пути фреймворка (только Darwin) +**2FE<x>_УÑтановить путь вывода exe/модулей в <x> +**2Fi<x>_Добавить <x> к пyÑ‚Ñм включаемых файлов +**2Fl<x>_Добавить <x> к пyÑ‚Ñм библиотек +**2FL<x>_ИÑпользовать <x> как динамичеÑкий компоновщик +**2Fm<x>_Загрузить таблицу Ð¿Ñ€ÐµÐ¾Ð±Ñ€Ð°Ð·Ð¾Ð²Ð°Ð½Ð¸Ñ unicode из <x>.txt в директории компилÑтора +**2Fo<x>_Добавить <x> к пyÑ‚Ñм объектных файлов +**2Fr<x>_Загpyзить файл Ñообщений об ошибках <x> +**2FR<x>_УÑтановить Ð¸Ð¼Ñ ÐºÐ¾Ð¼Ð¿Ð¾Ð½Ð¾Ð²Ñ‰Ð¸ÐºÐ° реÑурÑов (.res) в <x> +**2Fu<x>_Добавить <x> к путÑм модулей +**2FU<x>_УÑтановить пyÑ‚ÑŒ вывода модyлей в <x>, отменÑет -FE +**2FW<x>_ЗапиÑать файл обратной ÑвÑзи оптимизации вÑей программы в <x> +**2Fw<x>_Загрузить ранее Ñозданный файл обратной ÑвÑзи из <x> +*g1g_Создавать отладочную информацию (формате по умолчанию Ð´Ð»Ñ Ñ†ÐµÐ»ÐµÐ²Ð¾Ð¹ платформы) +*g2gc_Создавать проверки указателей +*g2gh_ИÑпользовать модyль heaptrc (Ð´Ð»Ñ Ð¾Ñ‚Ð»Ð°Ð´ÐºÐ¸ yтечек/повреждений памÑти) +*g2gl_ИÑпользовать модуль lineinfo (больше информации о Ñтеке вызовов) +*g2go<x>_Опции отладочной информации +*g3godwarfsets_ Включить информацию о множеÑтвах DWARF (ломает gdb < 6.5) +*g3gostabsabsincludes_ СохранÑÑ‚ÑŒ абÑолютные/полные пути включаемых файлов в Stabs +*g2gp_СохранÑÑ‚ÑŒ региÑÑ‚Ñ€ в именах Ñимволов stabs +*g2gs_ÐžÑ‚Ð»Ð°Ð´Ð¾Ñ‡Ð½Ð°Ñ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð² формате Stabs +*g2gt_Затирать локальные переменные (выÑвление иÑÐ¿Ð¾Ð»ÑŒÐ·Ð¾Ð²Ð°Ð½Ð¸Ñ Ð±ÐµÐ· инициализации) +*g2gv_Поддержка траÑÑировки Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ Valgrind +*g2gw_ÐžÑ‚Ð»Ð°Ð´Ð¾Ñ‡Ð½Ð°Ñ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð² формате DWARFv2 (то же, что и -gw2) +*g2gw2_ÐžÑ‚Ð»Ð°Ð´Ð¾Ñ‡Ð½Ð°Ñ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð² формате DWARFv2 +*g2gw3_ÐžÑ‚Ð»Ð°Ð´Ð¾Ñ‡Ð½Ð°Ñ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð² формате DWARFv3 +**1i_ИнфоpÐ¼Ð°Ñ†Ð¸Ñ +**2iD_Вернуть датy компилÑтоpа +**2iV_Вернуть короткую веpÑию компилÑтора +**2iW_Вернуть полную верÑию компилÑтора +**2iSO_Вернуть тип ОС компилÑтора +**2iSP_Вернуть тип пpоцеÑÑоpа компилÑтора +**2iTO_Вернуть тип целевой ОС +**2iTP_Вернуть тип целевого пpоцеÑÑоpа +**1I<x>_Добавить <x> к пyти до включаемых файлов +**1k<x>_Передать <x> компоновщикy +**1l_ВывеÑти логотип +**1M<x>_УÑтановить режим Ñзыка в <x> +**2Mfpc_Диалект Free Pascal (по умолчанию) +**2Mobjfpc_Режим FPC Ñ Ð¿Ð¾Ð´Ð´ÐµÑ€Ð¶ÐºÐ¾Ð¹ Object Pascal +**2Mdelphi_Режим ÑовмеÑтимоÑти Ñ Delphi 7 +**2Mtp_Режим ÑовмеÑтимоÑти Ñ TP/BP 7.0 +**2Mmacpas_Режим ÑовмеÑтимоÑти Ñ Ð´Ð¸Ð°Ð»ÐµÐºÑ‚Ð°Ð¼Ð¸ Macintosh Pascal +**1n_Ðе читать Ñтандаpтные файлы конфигурации +**1N<x>_ÐžÐ¿Ñ‚Ð¸Ð¼Ð¸Ð·Ð°Ñ†Ð¸Ñ Ð³Ñ€Ð°Ñ„Ð° +**2Nu_Разворачивать циклы +**1o<x>_Изменить Ð¸Ð¼Ñ Ð¿Ð¾Ð»ÑƒÑ‡Ð°ÐµÐ¼Ð¾Ð³Ð¾ иÑполнÑемого файла на <x> +**1O<x>_Оптимизации: +**2O-_Отключить оптимизации +**2O1_Оптимизации ÑƒÑ€Ð¾Ð²Ð½Ñ 1 (быÑтро и ÑовмеÑтимо Ñ Ð¾Ñ‚Ð»Ð°Ð´Ñ‡Ð¸ÐºÐ¾Ð¼) +**2O2_Оптимизации ÑƒÑ€Ð¾Ð²Ð½Ñ 2 (-O1 + быÑтрые оптимизации) +**2O3_Оптимизации ÑƒÑ€Ð¾Ð²Ð½Ñ 3 (-O2 + медленные оптимизации) +**2Oa<x>=<y>_УÑтановить выравнивание +**2Oo[NO]<x>_Включить или отключить отдельные оптимизации, Ñм. fpc -i Ð´Ð»Ñ Ð²Ð¾Ð·Ð¼Ð¾Ð¶Ð½Ñ‹Ñ… значений +**2Op<x>_Задать процеÑÑор Ð´Ð»Ñ Ð¾Ð¿Ñ‚Ð¸Ð¼Ð¸Ð·Ð°Ñ†Ð¸Ð¸, Ñм. fpc -i Ð´Ð»Ñ Ð²Ð¾Ð·Ð¼Ð¾Ð¶Ð½Ñ‹Ñ… значений +**2OW<x>_Ð“ÐµÐ½ÐµÑ€Ð°Ñ†Ð¸Ñ Ñ„Ð°Ð¹Ð»Ð° обратной ÑвÑзи wpo Ð´Ð»Ñ Ð¾Ð¿Ñ‚Ð¸Ð¼Ð¸Ð·Ð°Ñ†Ð¸Ð¸ <x>, Ñм. fpc -i Ð´Ð»Ñ Ð²Ð¾Ð·Ð¼Ð¾Ð¶Ð½Ñ‹Ñ… значений +**2Ow<x>_Выполнить оптимизацию <x> вÑей программы, Ñм. fpc -i Ð´Ð»Ñ Ð²Ð¾Ð·Ð¼Ð¾Ð¶Ð½Ñ‹Ñ… значений +**2Os_ÐžÐ¿Ñ‚Ð¸Ð¼Ð¸Ð·Ð°Ñ†Ð¸Ñ Ð¿Ð¾ размеру вмеÑто ÑкороÑти +**1pg_ГенеpÐ°Ñ†Ð¸Ñ ÐºÐ¾Ð´Ð° Ð´Ð»Ñ Ð¿Ñ€Ð¾Ñ„Ð¸Ð»Ð¸Ñ€Ð¾Ð²Ð°Ð½Ð¸Ñ Ñ Ð¿Ð¾Ð¼Ð¾Ñ‰ÑŒÑŽ gprof (опpеделÑет Ñимвол FPC_PROFILE) +**1R<x>_Стиль Ñ‡Ñ‚ÐµÐ½Ð¸Ñ Ð°ÑÑемблера: +**2Rdefault_ÐÑÑемблер по умолчанию Ð´Ð»Ñ Ñ†ÐµÐ»ÐµÐ²Ð¾Ð¹ платформы +3*2Ratt_Чтение аÑÑемблера в Ñтиле AT&T +3*2Rintel_Чтение аÑÑемблера в Ñтиле Intel +6*2RMOT_Чтение аÑÑемблера в Ñтиле Motorola +**1S<x>_Опции ÑинтакÑиÑа: +**2S2_То же, что и -Mobjfpc +**2Sc_Поддеpжка операторов как в C (*=,+=,/= и -=) +**2sa_Включить проверки Assert +**2Sd_То же, что и -Mdelphi +**2Se<x>_Опции ошибок. <x> - ÐºÐ¾Ð¼Ð±Ð¸Ð½Ð°Ñ†Ð¸Ñ Ñледующих Ñимволов: +**3*_<n> : ОÑтановка компилÑции поÑле <n> ошибок (по умолчанию 1) +**3*_w : КомпилÑтор также оÑтанавливаетÑÑ Ð¿Ð¾Ñле предупреждений +**3*_n : КомпилÑтор также оÑтанавливаетÑÑ Ð¿Ð¾Ñле заметок +**3*_h : КомпилÑтор также оÑтанавливаетÑÑ Ð¿Ð¾Ñле подÑказок +**2Sg_Разрешить LABEL и GOTO (по умолчанию в -Mtp и -Mdelphi) +**2Sh_ИÑпользовать ÑÑ‚pоки ansistring по умолчанию вмеÑто shortstring +**2Si_Включить вÑтраивание процедур/функций, объÑвленных как "inline" +**2Sk_Загрузить модуль fpcylix +**2SI<x>_УÑтановить Ñтиль интерфейÑов в <x> +**3SIcom_COM-ÑовмеÑтимые интерфейÑÑ‹ (по умолчанию) +**3SIcorba_CORBA-ÑовмеÑтимые интерфейÑÑ‹ +**2Sm_Поддеpжка макрокоманд как в C (глобально) +**2So_То же, что и -Mtp +**2Ss_Имена конÑтрукторов/деÑтрукторов должны быть init/done +**2Sx_Поддержка ключевых Ñлов иÑключений (по умолчанию в режимах Delphi/ObjFPC) +**1s_Ðе вызывать аÑÑемблер и компоновщик +**2sh_Создать Ñкрипт Ð´Ð»Ñ ÐºÐ¾Ð¼Ð¿Ð¾Ð½Ð¾Ð²ÐºÐ¸ на хоÑте +**2st_Создать Ñкрипт Ð´Ð»Ñ ÐºÐ¾Ð¼Ð¿Ð¾Ð½Ð¾Ð²ÐºÐ¸ на платформе Ð½Ð°Ð·Ð½Ð°Ñ‡ÐµÐ½Ð¸Ñ +**2sr_ПропуÑтить фазу раÑÐ¿Ñ€ÐµÐ´ÐµÐ»ÐµÐ½Ð¸Ñ Ñ€ÐµÐ³Ð¸Ñтров (иÑпользуетÑÑ Ñ -alr) +**1T<x>_ÐžÐ¿ÐµÑ€Ð°Ñ†Ð¸Ð¾Ð½Ð½Ð°Ñ ÑиÑтема назначениÑ: +3*2Temx_OS/2 через EMX (Ð²ÐºÐ»ÑŽÑ‡Ð°Ñ Ñ€Ð°Ñширитель EMX/RSX) +3*2Tfreebsd_FreeBSD +3*2Tgo32v2_ВерÑÐ¸Ñ 2 раÑÑˆÐ¸Ñ€Ð¸Ñ‚ÐµÐ»Ñ DOS DJ Delorie +3*2Tlinux_Linux +3*2Tnetbsd_NetBSD +3*2Tnetware_Модуль Novell Netware (clib) +3*2Tnetwlibc_Модуль Novell Netware (libc) +3*2Topenbsd_OpenBSD +3*2Tos2_OS/2 / eComStation +3*2Tsunos_SunOS/Solaris +3*2Tsymbian_Symbian OS +3*2Twatcom_Watcom-ÑовмеÑтимый раÑширитель DOS +3*2Twdosx_РаÑширитель DOS WDOSX +3*2Twin32_Windows 32 бита +3*2Twince_Windows CE +4*2Tlinux_Linux +6*2Tamiga_Commodore Amiga +6*2Tatari_Atari ST/STe/TT +6*2Tlinux_Linux/m68k +6*2Tmacos_Macintosh m68k (не поддерживаетÑÑ) +6*2Tpalmos_PalmOS +A*2Tlinux_Linux +A*2Twince_Windows CE +P*2Tamiga_AmigaOS на PowerPC +P*2Tdarwin_Darwin и Mac OS X на PowerPC +P*2Tlinux_Linux на PowerPC +P*2Tmacos_Mac OS (classic) на PowerPC +P*2Tmorphos_MorphOS +S*2Tlinux_Linux +**1u<x>_yдалÑет опpеделение Ñимвола <x> +**1U_Опции модyлей: +**2Un_Ðе пpовеpÑÑ‚ÑŒ ÑоответÑтвие имени модyÐ»Ñ Ð¸ имени файла +**2Ur_Генерировать релизные файлы модулей (не перекомпилируютÑÑ Ð°Ð²Ñ‚Ð¾Ð¼Ð°Ñ‚Ð¸Ñ‡ÐµÑки) +**2Us_Компилиpовать модyль system +**1v<x>_Уровень подpобноÑти. <x> - ÐºÐ¾Ð¼Ð±Ð¸Ð½Ð°Ñ†Ð¸Ñ Ñледyющих Ñимволов: +**2*_e : Ошибки (по умолчанию) 0 : Ðичего (кроме ошибок) +**2*_w : ÐŸÑ€ÐµÐ´ÑƒÐ¿Ñ€ÐµÐ¶Ð´ÐµÐ½Ð¸Ñ u : Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ модулÑÑ… +**2*_n : ÐŸÑ€Ð¸Ð¼ÐµÑ‡Ð°Ð½Ð¸Ñ t : Попробованные/иÑпользованные файлы +**2*_h : ПодÑказки c : УÑловные Ð²Ñ‹Ñ€Ð°Ð¶ÐµÐ½Ð¸Ñ +**2*_i : ÐžÐ±Ñ‰Ð°Ñ Ð¸Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ d : Отладочные ÑÐ¾Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ +**2*_l : Hомеpа Ñтрок c : Режим ÑовмеÑтимоÑти Ñ Rhide/GCC +**2*_s : Отметки времени q : Ðомера Ñообщений +**2*_a : Показывать вÑе x : Ð˜Ð½Ñ„Ð¾Ñ€Ð¼Ð°Ñ†Ð¸Ñ Ð¾ иÑполнÑемом файле (только Win32) +**2*_b : Ð¡Ð¾Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ Ð¾ файлах p : ЗапиÑÑŒ tree.log Ñ Ð³Ñ€Ð°Ñ„Ð¾Ð¼ разбора +**2*_ Ñ Ð¿Ð¾Ð»Ð½Ñ‹Ð¼Ð¸ путÑми x : ЗапиÑÑŒ fpcdebug.txt Ñ Ð¿Ð¾Ð´Ñ€Ð¾Ð±Ð½Ð¾Ð¹ +**2*_ именно в ней отладочной информацией +**2*_m<x>,<y> : Ðе показывать ÑÐ¾Ð¾Ð±Ñ‰ÐµÐ½Ð¸Ñ Ñ Ð½Ð¾Ð¼ÐµÑ€Ð°Ð¼Ð¸ <x> и <y> +3*1W<x>_Платформенно-Ñпецифичные опции (платформы) +A*1W<x>_Платформенно-Ñпецифичные опции (платформы) +P*1W<x>_Платформенно-Ñпецифичные опции (платформы) +p*1W<x>_Платформенно-Ñпецифичные опции (платформы) +3*2Wb_Создавать bundle вмеÑто библиотеки (Darwin) +P*2Wb_Создавать bundle вмеÑто библиотеки (Darwin) +p*2Wb_Создавать bundle вмеÑто библиотеки (Darwin) +3*2WB_Создавать перемещаемый образ (Windows) +A*2WB_Создавать перемещаемый образ (Windows, Symbian) +3*2WC_Указать конÑольный тип Ð¿Ñ€Ð¸Ð»Ð¾Ð¶ÐµÐ½Ð¸Ñ (EMX, OS/2, Windows) +A*2WC_Указать конÑольный тип Ð¿Ñ€Ð¸Ð»Ð¾Ð¶ÐµÐ½Ð¸Ñ (Windows) +P*2WC_Указать конÑольный тип Ð¿Ñ€Ð¸Ð»Ð¾Ð¶ÐµÐ½Ð¸Ñ (Classic Mac OS) +3*2WD_ИÑпользовать DEFFILE Ð´Ð»Ñ ÑкÑпорта функции DLL или EXE (Windows) +A*2WD_ИÑпользовать DEFFILE Ð´Ð»Ñ ÑкÑпорта функции DLL или EXE (Windows) +3*2We_ИÑпользовать внешние реÑурÑÑ‹ (Darwin) +P*2We_ИÑпользовать внешние реÑурÑÑ‹ (Darwin) +p*2We_ИÑпользовать внешние реÑурÑÑ‹ (Darwin) +3*2WF_Указать полноÑкранный тип Ð¿Ñ€Ð¸Ð»Ð¾Ð¶ÐµÐ½Ð¸Ñ (EMX, OS/2) +3*2WG_Указать графичеÑкий тип Ð¿Ñ€Ð¸Ð»Ð¾Ð¶ÐµÐ½Ð¸Ñ (EMX, OS/2, Windows) +A*2WG_Указать графичеÑкий тип Ð¿Ñ€Ð¸Ð»Ð¾Ð¶ÐµÐ½Ð¸Ñ (Windows) +P*2WG_Указать графичеÑкий тип Ð¿Ñ€Ð¸Ð»Ð¾Ð¶ÐµÐ½Ð¸Ñ (Classic Mac OS) +3*2Wi_ИÑпользовать внутренние реÑурÑÑ‹ (Darwin) +P*2Wi_ИÑпользовать внутренние реÑурÑÑ‹ (Darwin) +p*2Wi_ИÑпользовать внутренние реÑурÑÑ‹ (Darwin) +3*2WN_Ðе генерировать код перемещениÑ, нужно Ð´Ð»Ñ Ð¾Ñ‚Ð»Ð°Ð´ÐºÐ¸ (Windows) +A*2WN_Ðе генерировать код перемещениÑ, нужно Ð´Ð»Ñ Ð¾Ñ‚Ð»Ð°Ð´ÐºÐ¸ (Windows) +3*2WR_Генерировать код Ð¿ÐµÑ€ÐµÐ¼ÐµÑ‰ÐµÐ½Ð¸Ñ (Windows) +A*2WR_Генерировать код Ð¿ÐµÑ€ÐµÐ¼ÐµÑ‰ÐµÐ½Ð¸Ñ (Windows) +P*2WT_Указать тип Ð¿Ñ€Ð¸Ð»Ð¾Ð¶ÐµÐ½Ð¸Ñ MPW tool (Classic Mac OS) +3*2WX_Разрешить иÑполнÑемый Ñтек (Linux) +A*2WX_Разрешить иÑполнÑемый Ñтек (Linux) +p*2WX_Разрешить иÑполнÑемый Ñтек (Linux) +P*2WX_Разрешить иÑполнÑемый Ñтек (Linux) +**1X_опции Ð²Ñ‹Ð¿Ð¾Ð»Ð½ÐµÐ½Ð¸Ñ +**2Xc_Передать компоновщику --shared/-dynamic (BeOS, Darwin, FreeBSD, Linux) +**2Xd_Ðе иÑпользовать Ñтандартный путь поиÑка библиотек (нужно Ð´Ð»Ñ ÐºÑ€Ð¾ÑÑкомпилÑции) +**2Xe_ИÑпользовать внешний компоновщик +**2Xg_Создать отладочную информацию в отдельном файле и добавить Ñекцию debuglink в иÑполнÑемый файл +**2XD_Попробовать Ñкомпоновать динамичеÑки (определÑет Ñимвол FPC_LINK_DYNAMIC) +**2Xi_ИÑпользовать внутренний компоновщик +**2Xm_Создать карту компоновки +**2XM<x>_Задать Ð¸Ð¼Ñ Ð¾Ñновной точки входа 'main' (по умолчанию 'main') +**2XP<x>_Добавить к именам binutils Ð¿Ñ€ÐµÑ„Ð¸ÐºÑ <x> +**2Xr<x>_УÑтановить rlink-path компоновщика в <x> (нужно Ð´Ð»Ñ ÐºÑ€Ð¾ÑÑкомпилÑции, Ñм. руководÑтво ld) (BeOS, Linux) +**2XR<x>_Добавит Ð¿Ñ€ÐµÑ„Ð¸ÐºÑ <x> ко вÑем путÑм поиÑка компоновщика (BeOS, Darwin, FreeBSD, Linux, Mac OS, Solaris) +**2Xs_Убрать вÑе Ñимволы из иÑполнÑемого файла +**2XS_Попробовать Ñкомпоновать ÑтатичеÑки (по умолчанию, определÑет Ñимвол FPC_LINK_STATIC) +**2Xt_Компоновка Ñо ÑтатичеÑкими библиотеками (компоновщику передаетÑÑ -static) +**2XX_Попробовать "умную" компоновку (определÑет Ñимвол FPC_LINK_SMART) +**1*_ +**1?_показать ÑÑ‚y Ñправкy +**1h_показать ÑÑ‚y Ñправкy без Ð¾Ð¶Ð¸Ð´Ð°Ð½Ð¸Ñ +] + +# +# The End... diff --git a/closures/compiler/msg/errorues.msg b/closures/compiler/msg/errorues.msg new file mode 100644 index 0000000000..64ebb12297 --- /dev/null +++ b/closures/compiler/msg/errorues.msg @@ -0,0 +1,2369 @@ +# +# This file is part of the Free Pascal Compiler +# Copyright (c) 1999-2000 by the Free Pascal Development team +# +# Spanish Language File for Free Pascal +# +# 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. +# +# +# The constants are build in the following order: +# <part>_<type>_<txtidentifier> +# +# <part> is the part of the compiler the message is used +# asmr_ assembler parsing +# asmw_ assembler writing/binary writers + +# unit_ unit handling +# scan_ scanner +# parser_ parser +# type_ type checking +# general_ general info +# exec_ calls to assembler, linker, binder +# +# <type> the type of the message it should normally used for +# f_ fatal error +# e_ error +# w_ warning +# n_ note +# h_ hint +# i_ info +# l_ add linenumber +# u_ used +# t_ tried +# c_ conditional +# d_ debug message +# x_ executable informations +# + +# +# General +# +# 01016 is the last used one +# +# BeginOfTeX +% \section{General compiler messages} +% This section gives the compiler messages which are not fatal, but which +% display useful information. The number of such messages can be +% controlled with the various verbosity level \var{-v} switches. +% \begin{description} +general_t_compilername=01000_T_Compilador: $1 +% When the \var{-vt} switch is used, this line tells you what compiler +% is used. +general_d_sourceos=01001_D_SO del host: $1 +% When the \var{-vd} switch is used, this line tells you what the source +% operating system is. +general_i_targetos=01002_I_SO de destino: $1 +% When the \var{-vd} switch is used, this line tells you what the target +% operating system is. +general_t_exepath=01003_T_Usando la ruta para ejecutables: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its binaries. +general_t_unitpath=01004_T_Usando la ruta para unidades: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for compiled units. You can set this path with the \var{-Fu} +general_t_includepath=01005_T_Usando la ruta para inclusiones: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for its include files (files used in \var{\{\$I xxx\}} statements). +% You can set this path with the \var{-I} option. +general_t_librarypath=01006_T_Usando la ruta para bibliotecas: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for the libraries. You can set this path with the \var{-Fl} option. +general_t_objectpath=01007_T_Usando la ruta para objetos: $1 +% When the \var{-vt} switch is used, this line tells you where the compiler +% looks for object files you link in (files used in \var{\{\$L xxx\}} statements). +% You can set this path with the \var{-Fo} option. +general_i_abslines_compiled=01008_I_$1 Líneas compiladas, $2 seg +% When the \var{-vi} switch is used, the compiler reports the number +% of lines compiled, and the time it took to compile them (real time, +% not program time). +general_f_no_memory_left=01009_F_No queda suficiente memoria disponible +% The compiler doesn't have enough memory to compile your program. There are +% several remedies for this: +% \begin{itemize} +% \item If you're using the build option of the compiler, try compiling the +% different units manually. +% \item If you're compiling a huge program, split it up in units, and compile +% these separately. +% \item If the previous two don't work, recompile the compiler with a bigger +% heap (you can use the \var{-Ch} option for this, \seeo{Ch}) +% \end{itemize} +general_i_writingresourcefile=01010_I_Escribiendo archivo de recursos de tabla de cadenas: $1 +% This message is shown when the compiler writes the Resource String Table +% file containing all the resource strings for a program. +general_e_errorwritingresourcefile=01011_E_Escribiendo archivo de recursos de tabla de cadenas: $1 +% This message is shown when the compiler encountered an error when writing +% the Resource String Table file +general_i_fatal=01012_I_Fatal: +% Prefix for Fatal Errors +general_i_error=01013_I_Error: +% Prefix for Errors +general_i_warning=01014_I_Aviso: +% Prefix for Warnings +general_i_note=01015_I_Nota: +% Prefix for Notes +general_i_hint=01016_I_Consejo: +% Prefix for Hints +general_e_path_does_not_exist=01017_E_La ruta "$1" no existe +% The specified path does not exist. +general_e_compilation_aborted=01018_E_Compilación abortada +% \end{description} +# +# Scanner +# +# 02063 is the last used one +# +% \section{Scanner messages.} +% This section lists the messages that the scanner emits. The scanner takes +% care of the lexical structure of the pascal file, i.e. it tries to find +% reserved words, strings, etc. It also takes care of directives and +% conditional compiling handling. +% \begin{description} +scan_f_end_of_file=02000_F_Final de fichero inesperado +% this typically happens in one of the following cases : +% \begin{itemize} +% \item The source file ends before the final \var{end.} statement. This +% happens mostly when the \var{begin} and \var{end} statements aren't +% balanced; +% \item An include file ends in the middle of a statement. +% \item A comment was not closed +% \end{itemize} +scan_f_string_exceeds_line=02001_F_La cadena excede la línea +% There is a missing closing ' in a string, so it occupies +% multiple lines. +scan_f_illegal_char=02002_F_Caracter inválido +% An illegal character was encountered in the input file. +scan_f_syn_expected=02003_F_Error de sintaxis, se esperaba "$1" pero se encontró "$2" +% This indicates that the compiler expected a different token than +% the one you typed. It can occur almost everywhere where you make a +% mistake against the pascal language. +scan_t_start_include_file=02004_TL_Empezando a leer el fichero incluido $1 +% When you provide the \var{-vt} switch, the compiler tells you +% when it starts reading an included file. +scan_w_comment_level=02005_W_Nivel de comentario anidado $1 encontrado +% When the \var{-vw} switch is used, then the compiler warns you if +% it finds nested comments. Nested comments are not allowed in Turbo Pascal +% and can be a possible source of errors. +scan_n_ignored_switch=02008_N_Directiva de compilación $1 ignorado +% With \var{-vn} on, the compiler warns if it ignores a switch +scan_w_illegal_switch=02009_W_Directiva de compilación $i inválida +% You included a compiler switch (i.e. \var{\{\$... \}}) which the compiler +% does not recognise +scan_w_switch_is_global=02010_W_Esta opción de compilacion tiene un efecto global +% The compiler switch is misplaced, and should be located at +% the start of the unit or program. +scan_e_illegal_char_const=02011_E_Constante de caracter inválido +% This happens when you specify a character with its ASCII code, as in +% \var{\#96}, but the number is either illegal, or out of range. +scan_f_cannot_open_input=02012_F_No se puede abrir el fichero "$1" +% \fpc cannot find the program or unit source file you specified on the +% command line. +scan_f_cannot_open_includefile=02013_F_No se puede abrir el fichero de inclusion "$1" +% \fpc cannot find the source file you specified in a \var{\{\$include ..\}} +% statement. +scan_w_only_pack_records=02015_W_Los campos de los registros pueden ser alineados solo a 1, 2, 4 o 16 bytes +% You are specifying the \var{\{\$PACKRECORDS n\} } with an illegal value for +% \var{n}. Only 1, 2, 4, 8, 16 and 32 are valid in this case. +scan_w_only_pack_enum=02016_W_Los tipos enumerados solo pueden ser almacenados en 1, 2 o 4 bytes +% You are specifying the \var{\{\$PACKENUM n\}} with an illegal value for +% \var{n}. Only 1,2 or 4 are valid in this case. +scan_e_endif_expected=02017_E_$1 esperado para $2 definido en la línea $3 +% Your conditional compilation statements are unbalanced. +scan_e_preproc_syntax_error=02018_E_Error de sintaxis mientras se procesaba una expresión de compilación condicional +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc compiler +% directives. +scan_e_error_in_preproc_expr=02019_E_Evaluando una expresión de compilación condicional +% There is an error in the expression following the \var{\{\$if ..\}}, $ifc or $setc compiler +% directives. +scan_w_macro_cut_after_255_chars=02020_W_El contenido de las macros esta limitado a 255 caracteres de longitud +% The contents of macros cannot be longer than 255 characters. +scan_e_endif_without_if=02021_E_ENDIF sin IF(N)DEF +% Your \var{\{\$IFDEF ..\}} and {\{\$ENDIF\}} statements aren't balanced. +scan_f_user_defined=02022_F_Error de usuario: $1 +% A user defined fatal error occurred. see also the \progref +scan_e_user_defined=02023_E_Error de usuario: $1 +% A user defined error occurred. see also the \progref +scan_w_user_defined=02024_W_Aviso de usuario: $1 +% A user defined warning occurred. see also the \progref +scan_n_user_defined=02025_N_Nota de usuario: $1 +% A user defined note was encountered. see also the \progref +scan_h_user_defined=02026_H_Consejo de usuario: $1 +% A user defined hint was encountered. see also the \progref +scan_i_user_defined=02027_I_Informacion de usuario: $1 +% User defined information was encountered. see also the \progref +scan_e_keyword_cant_be_a_macro=02028_E_Palabra clave redefinida como macro no tiene efecto +% You cannot redefine keywords with macros. +scan_f_macro_buffer_overflow=02029_F_Desbordamiento del buffer de macro durante la lextura o expansión +% Your macro or its result was too long for the compiler. +can_w_macro_too_deep=02030_W_La expansión de macros excede una profundidad de 16. +% When expanding a macro, macros have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_w_wrong_styled_switch=02031_W_Las directivas de compilacióon no estan soportadas en comentarios estilo // +% Compiler switches should be in normal pascal style comments. +scan_d_handling_switch=02032_DL_Manejando la directiva "$1" +% When you set debugging info on (\var{-vd}) the compiler tells you when it +% is evaluating conditional compile statements. +scan_c_endif_found=02033_CL_ENDIF $1 encontrado +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifdef_found=02034_CL_IFDEF $1 encontrado, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifopt_found=02035_CL_IFOPT $1 encontrado, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_if_found=02036_CL_IF $1 encontrado, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_ifndef_found=02037_CL_IFNDEF $1 encontrado, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_else_found=02038_CL_ELSE $1 encontrado, $2 +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements. +scan_c_skipping_until=02039_CL_Omitiendo hasta... +% When you turn on conditional messages(\var{-vc}), the compiler tells you +% where it encounters conditional statements, and whether it is skipping or +% compiling parts. +scan_i_press_enter=02040_I_Presione <retorno> para continuar +% When the \var{-vi} switch is used, the compiler stops compilation +% and waits for the \var{Enter} key to be pressed when it encounters +% a \var{\{\$STOP\}} directive. +scan_w_unsupported_switch=02041_W_Conmutador "$1" no soportado +% When warnings are turned on (\var{-vw}) the compiler warns you about +% unsupported switches. This means that the switch is used in Delphi or +% Turbo Pascal, but not in \fpc +scan_w_illegal_directive=02042_W_Directiva de compilación "$1" inválida +% When warings are turned on (\var{-vw}) the compiler warns you about +% unrecognised switches. For a list of recognised switches, \progref +scan_t_back_in=02043_TL_Vuelve en $1 +% When you use (\var{-vt}) the compiler tells you when it has finished +% reading an include file. +scan_w_unsupported_app_type=02044_W_Tipo de aplicación no soportada: "$1" +% You get this warning, if you specify an unknown application type +% with the directive \var{\{\$APPTYPE\}} +scan_w_app_type_not_support=02045_W_APPTYPE no es soportado por el SO de destino +% The \var{\{\$APPTYPE\}} directive is supported by certain operating systems only. +scan_w_description_not_support=02046_W_DESCRIPTION no es soportado por el SO de destino +% The \var{\{\$DESCRIPTION\}} directive is not supported on this target OS +scan_n_version_not_support=02047_N_VERSION no es soportado por el SO de destino +% The \var{\{\$VERSION\}} directive is not supported on this target OS +scan_n_only_exe_version=02048_N_VERSION sólo para EXEs o DLLs +% The \var{\{\$VERSION\}} directive is only used for executable or DLL sources. +scan_w_wrong_version_ignored=02049_W_Formato erroneo para la directiva VERSION: "$1" +% The \var{\{\$VERSION\}} directive format is majorversion.minorversion +% where majorversion and minorversion are words. +scan_e_illegal_asmmode_specifier=02050_E_Estilo de ensamblador inváalido especificado: "$1" +% When you specify an assembler mode with the \var{\{\$ASMMODE xxx\}} +% the compiler didn't recognize the mode you specified. +scan_w_no_asm_reader_switch_inside_asm=02051_W_No es posible cambiar el lector dentro de una sentencia asm. "$1" solo sera efectivo en los siguientes +% It is not possible to switch from one assembler reader to another +% inside an assmebler block. The new reader will be used for next +% assembler statements only. +scan_e_wrong_switch_toggle=02052_E_Modificador de conmutador erróneo, use ON/OFF o +/- +% You need to use ON or OFF or a + or - to toggle the switch +scan_e_resourcefiles_not_supported=02053_E_Los ficheros de recursos no son soportados por la plataforma de destino +% The target you are compiling for doesn't support resource files. +scan_w_include_env_not_found=02054_W_Variable de entorno incluida "$1" no encontrada. +% The included environment variable can't be found in the environment, it will +% be replaced by an empty string instead. +scan_e_invalid_maxfpureg_value=02055_E_Valor inválido para el registro de la FPU +% Valid values for this directive are 0..8 and NORMAL/DEFAULT +scan_w_only_one_resourcefile_supported=02056_W_La plataforma de destino solo soporta un archivo de recursos +% The target you are compiling for supports only one resource file. +% The first resource file found is used, the others are discarded. +scan_w_macro_support_turned_off=02057_W_El soporte para macros ha sido deshabilitado +% A macro declaration has been found, but macro support is currently off, +% so the declaration will be ignored. To turn macro support on compile with +% -Sm on the commandline or add \{\$MACRO ON\} in the source +scan_e_invalid_interface_type=02058_E_El tipo de interfaz especificado es inválido. Debe ser COM, CORBA o DEFAULT +% The interface type that was specified is not supported +scan_w_appid_not_support=02059_W_APPID solo esta soportado para PalmOS +% The \var{\{\$APPID\}} directive is only supported for the PalmOS target. +scan_w_appname_not_support=02060_W_APPNAME solo esta soportado para PalmOS +% The \var{\{\$APPNAME\}} directive is only supported for the PalmOS target. +scan_e_string_exceeds_255_chars=02061_E_Las constantes de cadena no pueden ser de mas de 255 caracteres de longitud +% A single string constant can contain at most 255 chars. Try splitting up the +% string in multiple smaller parts and concatenate them with a + operator. +scan_f_include_deep_ten=02062_F_La inclusion de archivos no puede exceder 16 niveles +% When including include files the files have been nested to a level of 16. +% The compiler will expand no further, since this may be a sign that +% recursion is used. +scan_e_too_many_push=02063_F_Demasiados niveles de PUSH +% A maximum of 20 levels is allowed. This error occurs only in mode MacPas. +scan_e_too_many_pop=02064_E_A POP sin un PUSH previo +% This error occurs only in mode MacPas. +scan_e_error_macro_lacks_value=02065_E_Macro o variable de compilación "$1" no tiene ningún valor +% Thus the conditional compiling expression cannot be evaluated. +scan_e_wrong_switch_toggle_default=02066_E_Valor invalido para el conmutado, use ON/OFF/DEFAULT o +/-/* +% You need to use ON or OFF or DEFAULT or a + or - or * to toggle the switch +scan_e_mode_switch_not_allowed=02067_E_No esta permitido cambiar de modo a "$1" aqui +% A mode switch has already been encountered, or, in case of option -Mmacpas, +% a mode switch occur after UNIT. +scan_e_error_macro_undefined=02068_E_Variable en tiempo de compilación "$1" no ha sido definida. +% Thus the conditional compile time expression cannot be evaluated. +% \end{description} +# +# Parser +# +# 03192 is the last used one +# +% \section{Parser messages} +% This section lists all parser messages. The parser takes care of the +% semantics of you language, i.e. it determines if your pascal constructs +% are correct. +% \begin{description} +parser_e_syntax_error=03000_E_Analizador - Error de sintaxis +% An error against the Turbo Pascal language was encountered. This happens +% typically when an illegal character is found in the sources file. +parser_e_dont_nest_interrupt=03004_E_Los procedimientos INTERRUPT no pueden ser anidados +% An \var{INTERRUPT} procedure must be global. +parser_w_proc_directive_ignored=03005_W_Tipo de procedimiento "$1" ignorado +% The specified is ignored by FPC programs. +parser_e_no_overload_for_all_procs=03006_E_No todas las declaraciones de "$1" llevan OVERLOAD +% When you want to use overloading using the \var{OVERLOAD} directive, then +% all declarations need to have \var{OVERLOAD} specified. +parser_e_export_name_double=03008_E_Nombre de funcion exportada "$1" duplicado +% Exported function names inside a specific DLL must all be different +parser_e_export_ordinal_double=03009_E_Indice de funcion exportada "$1" duplicado +% Exported function names inside a specific DLL must all be different +parser_e_export_invalid_index=03010_E_Indice de funcion exportada inválido +% DLL function index must be in the range \var{1..\$FFFF} +parser_w_parser_reloc_no_debug=03011_W_La informacion de depurado $1 para ejecutables o DLLs reubicables no funciona. Desactivado. +parser_w_parser_win32_debug_needs_WN=03012_W_Para permitir el depurado en win32 las reubicaciones deben ser desactivadas con la opcion -WN +% Stabs info is wrong for relocatable DLL or EXES use -WN +% if you want to debug win32 executables. +parser_e_constructorname_must_be_init=03013_E_El nombre del constructor debe ser INIT +% You are declaring an object constructor with a name which is not \var{init}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_destructorname_must_be_done=03014_E_El nombre del destructor debe ser DONE +% You are declaring an object destructor with a name which is not \var{done}, and the +% \var{-Ss} switch is in effect. See the \var{-Ss} switch (\seeo{Ss}). +parser_e_proc_inline_not_supported=03016_E_Procedimientos tipo INLINE no soportados +% You tried to compile a program with C++ style inlining, and forgot to +% specify the \var{-Si} option (\seeo{Si}). The compiler doesn't support C++ +% styled inlining by default. +parser_w_constructor_should_be_public=03018_W_El constructor debería ser público +% Constructors must be in the 'public' part of an object (class) declaration. +parser_w_destructor_should_be_public=03019_W_El destructor debería ser público +% Destructors must be in the 'public' part of an object (class) declaration. +parser_n_only_one_destructor=03020_N_Una clase debería tener solo un destructor +% You can declare only one destructor for a class. +parser_e_no_local_objects=03021_E_Las definiciones de clases locales no están permitidas +% Classes must be defined globally. They cannot be defined inside a +% procedure or function +parser_f_no_anonym_objects=03022_F_Las definiciones de clases anónimas no están permitidas +% An invalid object (class) declaration was encountered, i.e. an +% object or class without methods that isn't derived from another object or +% class. For example: +% \begin{verbatim} +% Type o = object +% a : longint; +% end; +% \end{verbatim} +% will trigger this error. +parser_n_object_has_no_vmt=03023_N_El objeto "$1" no tiene VMT +% This is a note indicating that the declared object has no +% virtual method table. +parser_e_illegal_parameter_list=03024_E_Lista de parámetros inválida +% You are calling a function with parameters that are of a different type than +% the declared parameters of the function. +parser_e_wrong_parameter_size=03026_E_Numero de parámetros incorrecto +% There is an error in the parameter list of the function or procedure, +% the number of parameters is not correct. +parser_e_overloaded_no_procedure=03027_E_el identificador sobrecargado "$1" no es una función +% The compiler encountered a symbol with the same name as an overloaded +% function, but it is not a function it can overload. +parser_e_overloaded_have_same_parameters=03028_E_funciones sobrecargadas tienen los mismos par metros +% You're declaring overloaded functions, but with the same parameter list. +% Overloaded function must have at least 1 different parameter in their +% declaration. +parser_e_header_dont_match_forward=03029_E_la cabecera de la función no concuerda con la declaración posterior "$1" +% You declared a function with same parameters but +% different result type or function modifiers. +parser_e_header_different_var_names=03030_E_la cabecera de la funcion "$1" no concuerda con la posterior declaración : el nombre de la variable cambia $2 => $3 +% You declared the function in the \var{interface} part, or with the +% \var{forward} directive, but define it with a different parameter list. +parser_n_duplicate_enum=03031_N_el orden de los valores en una enumeracion debe ser ascendente +% \fpc allows enumeration constructions as in C. Given the following +% declaration two declarations: +% \begin{verbatim} +% type a = (A_A,A_B,A_E:=6,A_UAS:=200); +% type a = (A_A,A_B,A_E:=6,A_UAS:=4); +% \end{verbatim} +% The second declaration would produce an error. \var{A\_UAS} needs to have a +% value higher than \var{A\_E}, i.e. at least 7. +parser_e_no_with_for_variable_in_other_segments=03033_E_With no puede ser usado con variables en segmentos diferentes +% With stores a variable locally on the stack, +% but this is not possible if the variable belongs to another segment. +parser_e_too_much_lexlevel=03034_E_Anidado de funciones > 31 +% You can nest function definitions only 31 times. +parser_e_range_check_error=03035_E_error en la comprobación de rangos mientras se evaluaban constantes +% The constants are out of their allowed range. +parser_w_range_check_error=03036_W_error en la comprobacion de rangos mientras se evaluaban constantes +% The constants are out of their allowed range. +parser_e_double_caselabel=03037_E_etiqueta de caso duplicada +% You are specifying the same label 2 times in a \var{case} statement. +parser_e_case_lower_less_than_upper_bound=03038_E_El líimite superior del caso es menor que el inferior +% The upper bound of a \var{case} label is less than the lower bound and this +% is useless +parser_e_type_const_not_possible=03039_E_no se permiten constantes con tipo de clases +% You cannot declare a constant of type class or object. +parser_e_no_overloaded_procvars=03040_E_no se permite asignar a variables de funcion funciones sobrecargadas +% You are trying to assign an overloaded function to a procedural variable. +% This is not allowed +parser_e_invalid_string_size=03041_E_la longitud de una cadena tiene que ser un valor entre 1 y 255 +% The length of a shortstring in Pascal is limited to 255 characters. You are +% trying to declare a string with length lower than 1 or greater than 255 +parser_w_use_extended_syntax_for_objects=03042_W_use la sintaxis estendida de DISPOSE y NEW para instancias de objetos +% If you have a pointer \var{a} to a class type, then the statement +% \var{new(a)} will not initialize the class (i.e. the constructor isn't +% called), although space will be allocated. you should issue the +% \var{new(a,init)} statement. This will allocate space, and call the +% constructor of the object +parser_w_no_new_dispose_on_void_pointers=03043_W_el uso de NEW o DISPOSE para punteros sin tipo no tiene sentido +parser_e_no_new_dispose_on_void_pointers=03044_E_el uso de NEW o DISPOSE no es posible con punteros sin tipo +% You cannot use \var{new(p)} or \var{dispose(p)} if \var{p} is an untyped pointer +% because no size is associated to an untyped pointer. +% Accepted for compatibility in \var{tp} and \var{delphi} modes. +parser_e_class_id_expected=03045_E_identificador de clase esperado +% This happens when the compiler scans a procedure declaration that contains +% a dot, +% i.e., a object or class method, but the type in front of the dot is not +% a known type. +parser_e_no_type_not_allowed_here=03046_E_identificador de tipo no permitido aquí +% You cannot use a type inside an expression. +parser_e_methode_id_expected=03047_E_identificador de método esperado +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_e_header_dont_match_any_member=03048_E_la cabecera de la funcion no concuerda con ningún método de esta clase "$1" +% This identifier is not a method. +% This happens when the compiler scans a procedure declaration that contains +% a dot, i.e., a object or class method, but the procedure name is not a +% procedure of this type. +parser_d_procedure_start=03049_DL_proceduimiento/función $1 +% When using the \var{-vd} switch, the compiler tells you when it starts +% processing a procedure or function implementation. +parser_e_error_in_real=03050_E_Constante de punto flotante inválida +% The compiler expects a floating point expression, and gets something else. +parser_e_fail_only_in_constructor=03051_E_FAIL solo puede ser usado en constructores +% You are using the \var{fail} keyword outside a constructor method. +parser_e_no_paras_for_destructor=03052_E_Los destructores no pueden tener parámetros +% You are declaring a destructor with a parameter list. Destructor methods +% cannot have parameters. +parser_e_only_class_methods_via_class_ref=03053_E_Solo los métodos de clases pueden ser referidos con referencias de clase +% This error occurs in a situation like the following: +% \begin{verbatim} +% Type : +% Tclass = Class of Tobject; +% +% Var C : TClass; +% +% begin +% ... +% C.free +% \end{verbatim} +% \var{Free} is not a class method and hence cannot be called with a class +% reference. +parser_e_only_class_methods=03054_E_Los métodos de clase solo pueden ser acceder a otros métodos de clase +% This is related to the previous error. You cannot call a method of an object +% from a inside a class method. The following code would produce this error: +% \begin{verbatim} +% class procedure tobject.x; +% +% begin +% free +% \end{verbatim} +% Because free is a normal method of a class it cannot be called from a class +% method. +parser_e_case_mismatch=03055_E_Los tipos de la constante y del CASE no concuerdan +% One of the labels is not of the same type as the case variable. +parser_e_illegal_symbol_exported=03056_E_El símbolo no puede ser exportado de una librería +% You can only export procedures and functions when you write a library. You +% cannot export variables or constants. +parser_w_should_use_override=03057_W_Un método heredado ha sido ocultado por "$1" +% A method that is declared \var{virtual} in a parent class, should be +% overridden in the descendent class with the \var{override} directive. If you +% don't specify the \var{override} directive, you will hide the parent method; +% you will not override it. +parser_e_nothing_to_be_overridden=03058_E_No hay un método en una clase antepasada para ser substituido: "$1" +% You are trying to \var{override} a virtual method of a parent class that does +% not exist. +parser_e_no_procedure_to_access_property=03059_E_No se suministro un miembro para acceder a propiedad +% You specified no \var{read} directive for a property. +parser_w_stored_not_implemented=03060_W_La directiva de propiedad Stored no esta implementada aún +% The \var{stored} directive is not yet implemented +parser_e_ill_property_access_sym=03061_E_símbolo inváalido para el acceso a la propiedad +% There is an error in the \var{read} or \var{write} directives for an array +% property. When you declare an array property, you can only access it with +% procedures and functions. The following code woud cause such an error. +% \begin{verbatim} +% tmyobject = class +% i : integer; +% property x [i : integer]: integer read I write i; +% \end{verbatim} +% +parser_e_cant_access_protected_member=03062_E_No se puede acceder a un campo protegido de un objeto aquí +% Fields that are declared in a \var{protected} section of an object or class +% declaration cannot be accessed outside the module wher the object is +% defined, or outside descendent object methods. +parser_e_cant_access_private_member=03063_E_No se puede acceder a un campo privado de un objeto aquí +% Fields that are declared in a \var{private} section of an object or class +% declaration cannot be accessed outside the module where the class is +% defined. +parser_e_overridden_methods_not_same_ret=03066_E_los métodos reemplazados deben tener el mismo tipo de dato devuelto: "$2" es reemplazado por "$1" que devuelve otro tipo +% If you declare overridden methods in a class definition, they must +% have the same return type. +parser_e_dont_nest_export=03067_E_Las funciones declarados como EXPORT no pueden estar anidados +% You cannot declare a function or procedure within a function or procedure +% that was declared as an export procedure. +parser_e_methods_dont_be_export=03068_E_los métodos no pueden ser EXPORTados +% You cannot declare a procedure that is a method for an object as +% \var{export}ed. +parser_e_call_by_ref_without_typeconv=03069_E_en llamadas con parámetros VAR los tipos deben coincidir exactamente. Se recibio "$1" cuando se esperaba "$2" +% When calling a function declared with \var{var} parameters, the variables in +% the function call must be of exactly the same type. There is no automatic +% type conversion. +parser_e_no_super_class=03070_E_La clase no es un ancestor de la clase actual +% When calling inherited methods, you are trying to call a method of a non-related +% class. You can only call an inherited method of a parent class. +parser_e_self_not_in_method=03071_E_SELF solo está permitido en métodos +% You are trying to use the \var{self} parameter outside an object's method. +% Only methods get passed the \var{self} parameters. +parser_e_generic_methods_only_in_methods=03072_E_los métodos solo pueden estar en otros métodos llamados directamente con el tipo identificador de la clase +% A construction like \var{sometype.somemethod} is only allowed in a method. +parser_e_illegal_colon_qualifier=03073_E_Uso inválido de ':' +% You are using the format \var{:} (colon) 2 times on an expression that +% is not a real expression. +parser_e_illegal_set_expr=03074_E_Error en la comprobación de rangos en el constructor del set, o elemento duplicado en el set +% The declaration of a set contains an error. Either one of the elements is +% outside the range of the set type, either two of the elements are in fact +% the same. +parser_e_pointer_to_class_expected=03075_E_Se esperaba un puntero a objeto +% You specified an illegal type in a \var{new} statement. +% The extended syntax of \var{new} needs an object as a parameter. +parser_e_expr_have_to_be_constructor_call=03076_E_La expresión tiene que ser una llamada al constructor +% When using the extended syntax of \var{new}, you must specify the constructor +% method of the object you are trying to create. The procedure you specified +% is not a constructor. +parser_e_expr_have_to_be_destructor_call=03077_E_La expresión tiene que ser una llamada al destructor +% When using the extended syntax of \var{dispose}, you must specify the +% destructor method of the object you are trying to dispose of. +% The procedure you specified is not a destructor. +parser_e_invalid_record_const=03078_E_Orden de los campos del registro incorrecto +% When declaring a constant record, you specified the fields in the wrong +% order. +parser_e_false_with_expr=03079_E_El tipo de la expresión tiene que ser class o record +% A \var{with} statement needs an argument that is of the type \var{record} +% or \var{class}. You are using \var{with} on an expression that is not of +% this type. +parser_e_void_function=03080_E_Los procedimientos no pueden devolver ningún valor +% In \fpc, you can specify a return value for a function when using +% the \var{exit} statement. This error occurs when you try to do this with a +% procedure. Procedures cannot return a value. +parser_e_only_methods_allowed=03081_E_constructores, destructores y class operators deben ser métodos +% You're declaring a procedure as destructor, constructor or class operator, when the +% procedure isn't a class method. +parser_e_operator_not_overloaded=03082_E_El operador no esta sobrecargado +% You're trying to use an overloaded operator when it is not overloaded for +% this type. +parser_e_no_such_assignment=03083_E_Imposible sobrecargar operador de asignacion para tipos iguales +% You can not overload assignment for types +% that the compiler considers as equal. +parser_e_overload_impossible=03084_E_Sobrecarga de operador imposible +% The combination of operator, arguments and return type are +% incompatible. +parser_e_no_reraise_possible=03085_E_Re-lanzamiento de la excepcion no es posible aquí +% You are trying to raise an exception where it is not allowed. You can only +% raise exceptions in an \var{except} block. +parser_e_no_new_or_dispose_for_classes=03086_E_La sintaxis extendida de new o dispose no está permitida para una clase +% You cannot generate an instance of a class with the extended syntax of +% \var{new}. The constructor must be used for that. For the same reason, you +% cannot call \var{dispose} to de-allocate an instance of a class, the +% destructor must be used for that. +parser_e_procedure_overloading_is_off=03088_E_La sobrecarga de funciones no esta activada +% When using the \var{-So} switch, procedure overloading is switched off. +% Turbo Pascal does not support function overloading. +parser_e_overload_operator_failed=03089_E_No es posible sobrecargar este operador (sobrecarge en cambio "=" ) +% You are trying to overload an operator which cannot be overloaded. +% The following operators can be overloaded : +% \begin{verbatim} +% +, -, *, /, =, >, <, <=, >=, is, as, in, **, := +% \end{verbatim} +parser_e_comparative_operator_return_boolean=03090_E_Operador comparativo tiene que devolver un valor booleano +% When overloading the \var{=} operator, the function must return a boolean +% value. +parser_e_only_virtual_methods_abstract=03091_E_Solo los métodos virtuales pueden ser abstractos +% You are declaring a method as abstract, when it is not declared to be +% virtual. +parser_f_unsupported_feature=03092_F_Uso de característica no soportada! +% You're trying to force the compiler into doing something it cannot do yet. +parser_e_mix_of_classes_and_objects=03093_E_No se permite la mezcla de objetos de diferentes tipos (class, object, interface, etc) +% You cannot derive \var{objects}, \var{classes}, \var{cppclasses} and \var{interfaces} interttwined . E.g. +% a class cannot have an object as parent and vice versa. +parser_w_unknown_proc_directive_ignored=03094_W_Directiva de procedimiento desconocida fue ignorada: "$1" +% The procedure directive you specified is unknown. +parser_e_absolute_only_one_var=03095_E_absolute solo puede estar asociado a una variable +% You cannot specify more than one variable before the \var{absolute} directive. +% Thus, the following construct will provide this error: +% \begin{verbatim} +% Var Z : Longint; +% X,Y : Longint absolute Z; +% \end{verbatim} +% \item [ absolute can only be associated a var or const ] +% The address of a \var{absolute} directive can only point to a variable or a +% typed constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_absolute_only_to_var_or_const=03096_E_absolute solo puede ser asociado con var o const +% The address of a \var{absolute} directive can only point to a variable or +% constant. Therefore, the following code will produce this error: +% \begin{verbatim} +% Procedure X; +% +% var p : longint absolute x; +% \end{verbatim} +% +parser_e_initialized_only_one_var=03097_E_Solo una variable puede ser inicializada +% You cannot specify more than one variable with a initial value +% in Delphi mode. +parser_e_abstract_no_definition=03098_E_Métodos abstractos no deberían tener ninguna definición (con el cuerpo de la función) +% Abstract methods can only be declared, you cannot implement them. They +% should be overridden by a descendant class. +parser_e_overloaded_must_be_all_global=03099_E_Esta función sobrecargada no puede ser local (debe ser exportada) +% You are defining a overloaded function in the implementation part of a unit, +% but there is no corresponding declaration in the interface part of the unit. +parser_w_virtual_without_constructor=03100_W_Métodos virtuales están siendo usados sin un constructor en "$1" +% If you declare objects or classes that contain virtual methods, you need +% to have a constructor and destructor to initialize them. The compiler +% encountered an object or class with virtual methods that doesn't have +% a constructor/destructor pair. +parser_c_macro_defined=03101_CL_Macro definido: $1 +% When \var{-vc} is used, the compiler tells you when it defines macros. +parser_c_macro_undefined=03102_CL_Macro indefinido: $1 +% When \var{-vc} is used, the compiler tells you when it undefines macros. +parser_c_macro_set_to=03103_CL_Macro $1 asignado a $2 +% When \var{-vc} is used, the compiler tells you what values macros get. +parser_i_compiling=03104_I_Compilando $1 +% When you turn on information messages (\var{-vi}), the compiler tells you +% what units it is recompiling. +parser_u_parsing_interface=03105_UL_Interpretando interfaz de la unidad $1 +% This tells you that the reading of the interface +% of the current unit starts +parser_u_parsing_implementation=03106_UL_Interpretando implementacion de la unidad $1 +% This tells you that the code reading of the implementation +% of the current unit, library or program starts +parser_d_compiling_second_time=03107_DL_Compilando $1 por segunda vez +% When you request debug messages (\var{-vd}) the compiler tells you what +% units it recompiles for the second time. +parser_e_no_property_found_to_override=03109_E_No se encontro la propiedad a reemplazar +% You want to overrride a property of a parent class, when there is, in fact, +% no such property in the parent class. +parser_e_only_one_default_property=03110_E_Sólo se permite una única propiedad por defecto +% You specified a property as \var{Default}, but the class already has a +% default property, and a class can have only one default property. +parser_e_property_need_paras=03111_E_La propiedad por defecto tiene que ser un array +% Only array properties of classes can be made \var{default} properties. +parser_e_constructor_cannot_be_not_virtual=03112_E_Solo las clases soportan constructores virtuales +% You cannot have virtual constructors in objects. You can only have them +% in classes. +parser_e_no_default_property_available=03113_E_No hay propiedad por defecto disponible +% You are trying to access a default property of a class, but this class (or one of +% its ancestors) doesn't have a default property. +parser_e_cant_have_published=03114_E_La clase no puede tener una sección published, use el conmutador {$M+} +% If you want a \var{published} section in a class definition, you must +% use the \var{\{\$M+\}} switch, whch turns on generation of type +% information. +parser_e_forward_declaration_must_be_resolved=03115_E_Declaración posterior de la clase "$1" tiene que ser resuelta aquí para usar la clase como antepasado +% To be able to use an object as an ancestor object, it must be defined +% first. This error occurs in the following situation: +% \begin{verbatim} +% Type ParentClas = Class; +% ChildClass = Class(ParentClass) +% ... +% end; +% \end{verbatim} +% Where \var{ParentClass} is declared but not defined. +parser_e_no_local_operator=03116_E_Operadores locales no soportados +% You cannot overload locally, i.e. inside procedures or function +% definitions. +parser_e_proc_dir_not_allowed_in_interface=03117_E_Directiva de procedimiento "$1" no permitida en la sección de interfaz +% This procedure directive is not allowed in the \var{interface} section of +% a unit. You can only use it in the \var{implementation} section. +parser_e_proc_dir_not_allowed_in_implementation=03118_E_Directiva de procedimiento "$1" no permitida en la sección de implementacion +% This procedure directive is not defined in the \var{implementation} section of +% a unit. You can only use it in the \var{interface} section. +parser_e_proc_dir_not_allowed_in_procvar=03119_E_Directiva de procedimiento "$1" no permitida en la declaración de tipo +% This procedure directive cannot be part of a procedural or function +% type declaration. +parser_e_function_already_declared_public_forward=03120_E_La función esta actualmente declarada como Public/Forward "$1" +% You will get this error if a function is defined as \var{forward} twice. +% Or it is once in the \var{interface} section, and once as a \var{forward} +% declaration in the \var{implmentation} section. +parser_e_not_external_and_export=03121_E_No se pueden usar ambos EXPORT y EXTERNAL +% These two procedure directives are mutually exclusive +parser_w_not_supported_for_inline=03123_W_"$1" aún no soportado en procedimientos/funciones inline +% Inline procedures don't support this declaration. +parser_w_inlining_disabled=03124_W_Inlining deshabilitado +% Inlining of procedures is disabled. +parser_i_writing_browser_log=03125_I_Escribiendo Browser log $1 +% When information messages are on, the compiler warns you when it +% writes the browser log (generated with the \var{\{\$Y+ \}} switch). +parser_h_maybe_deref_caret_missing=03126_H_podría ser que falte la de-referencia del puntero +% The compiler thinks that a pointer may need a dereference. +parser_f_assembler_reader_not_supported=03127_F_Lector del ensamblador seleccionado no soportado +% The selected assembler reader (with \var{\{\$ASMMODE xxx\}} is not +% supported. The compiler can be compiled with or without support for a +% particular assembler reader. +parser_e_proc_dir_conflict=03128_E_Directiva de procedimiento "$1" causa conflicto con otras directivas +% You specified a procedure directive that conflicts with other directives. +% for instance \var{cdecl} and \var{pascal} are mutually exclusive. +parser_e_call_convention_dont_match_forward=03129_E_La convencion de llamada actual no concuerda con la definida anteriormente +% This error happens when you declare a function or procedure with +% e.g. \var{cdecl;} but omit this directive in the implementation, or vice +% versa. The calling convention is part of the function declaration, and +% must be repeated in the function definition. +parser_e_property_cant_have_a_default_value=03131_E_La propiedad no puede tener un valor por defecto +% Set properties or indexed properties cannot have a default value. +parser_e_property_default_value_must_const=03132_E_El valor por defecto de una propiedad tiene que ser constante +% The value of a \var{default} declared property must be known at compile +% time. The value you specified is only known at run time. This happens +% .e.g. if you specify a variable name as a default value. +parser_e_cant_publish_that=03133_E_El símbolo no puede ser published, solo puede ser una clase +% Only class type variables can be in a \var{published} section of a class +% if they are not declared as a property. +parser_e_cant_publish_that_property=03134_E_Este tipo de propiedad no puede ser published +% Properties in a \var{published} section cannot be array properties. +% they must be moved to public sections. Properties in a \var{published} +% section must be an ordinal type, a real type, strings or sets. +parser_e_empty_import_name=03136_E_Se requiere un nombre de importación +% Some targets need a name for the imported procedure or a \var{cdecl} specifier +parser_e_division_by_zero=03138_E_Division por cero +% There is a divsion by zero encounted +parser_e_invalid_float_operation=03139_E_Operacion de punto flotante no válida +% An operation on two real type values produced an overflow or a division +% by zero. +parser_e_array_lower_less_than_upper_bound=03140_E_Límite superior del rango es menor que el límite inferior +% The upper bound of a an array declaration is less than the lower bound and this +% is not possible +parser_w_string_too_long=03141_W_La cadena "$1" es mas larga que $2 +% The size of the constant string is larger than the size you specified in +% string type definition +parser_e_string_larger_array=03142_E_La longitud de la cadena es mayor que el tamaño array de carácteres +% The size of the constant string is larger than the size you specified in +% the array[x..y] of char definition +parser_e_ill_msg_expr=03143_E_Expresión inválida tras la directiva de mensaje +% \fpc supports only integer or string values as message constants +parser_e_ill_msg_param=03144_E_Los méetodos de manejo de mensajes deben tener un único parámetro por referencia +% A method declared with the \var{message}-directive as message handler +% can take only one parameter which must be declared as call by reference +% Parameters are declared as call by reference using the \var{var}-directive +parser_e_duplicate_message_label=03145_E_Etiqueta de mensaje duplicada: "$1" +% A label for a message is used twice in one object/class +parser_e_self_in_non_message_handler=03146_E_Self solo puede ser un parámetro explícito en manejadores de mensajes +% The self parameter can only be passed explicitly to a method which +% is declared as message handler. +parser_e_threadvars_only_sg=03147_E_Threadvars sólo pueden ser globales o estáticos +% Threadvars must be static or global, you can't declare a thread +% local to a procedure. Local variables are always local to a thread, +% because every thread has its own stack and local variables +% are stored on the stack +parser_f_direct_assembler_not_allowed=03148_F_Ensamblador directo no soportado para formato binario de salida +% You can't use direct assembler when using a binary writer, choose an +% other outputformat or use another assembler reader +parser_w_no_objpas_use_mode=03149_W_No carges manuamente la unidad OBJPAS, usa \{\$mode objfpc\} o \{\$mode delphi\} +% You are trying to load the ObjPas unit manually from a uses clause. This is +% not a good idea. Use the \var{\{\$mode objfpc\}} or +% \var{\{\$mode delphi\}} +% directives which load the unit automatically +parser_e_no_object_override=03150_E_OVERRIDE no puede ser usado en objetos +% Override is not supported for objects, use \var{virtual} instead to override +% a method of a parent object +parser_e_cant_use_inittable_here=03151_E_Tipos de datos que requieran inicializacion/finalizacion no pueden ser usados en registros variables +% Some data type (e.g. \var{ansistring}) needs initialization/finalization +% code which is implicitly generated by the compiler. Such data types +% can't be used in the variant part of a record. +parser_e_resourcestring_only_sg=03152_E_Resourcestrings solo pueden ser globales o estáaticos +% Resourcestring can not be declared local, only global or using the static +% directive. +parser_e_exit_with_argument_not__possible=03153_E_Exit con parámetro no puede ser usado aquí +% an exit statement with an argument for the return value can't be used here, this +% can happen e.g. in \var{try..except} or \var{try..finally} blocks +parser_e_stored_property_must_be_boolean=03154_E_El tipo del símbolo en stored debe ser de tipo booleano +% If you specify a storage symbol in a property declaration, it must be of +% the type boolean +parser_e_ill_property_storage_sym=03155_E_Este símbolo no puede ser usado en storage para una propiedad +% You can't use this type of symbol as storage specifier in property +% declaration. You can use only methods with the result type boolean, +% boolean class fields or boolean constants +parser_e_only_publishable_classes_can__be_published=03156_E_Solo clases compiladas en $M+ pueden ser publicadas +% In the published section of a class can be only class as fields used which +% are compiled in \var{\{\$M+\}} or which are derived from such a class. Normally +% such a class should be derived from TPersitent +parser_e_proc_directive_expected=03157_E_Directiva de procedimiento esperada +% When declaring a procedure in a const block you used a ; after the +% procedure declaration after which a procedure directive must follow. +% Correct declarations are: +% \begin{verbatim} +% const +% p : procedure;stdcall=nil; +% p : procedure stdcall=nil; +% \end{verbatim} +parser_e_invalid_property_index_value=03158_E_El valor para el índice de una propiedad debe ser de tipo ordinal +% The value you use to index a property must be of an ordinal type, for +% example an integer or enumerated type. +parser_e_procname_to_short_for_export=03159_E_Nombre del procedimiento demasiado corto para ser exportado +% The length of the procedure/function name must be at least 2 characters +% long. This is because of a bug in dlltool which doesn't parse the .def +% file correct with a name of length 1. +parser_e_dlltool_unit_var_problem=03160_E_No se puede generar una entrada DEFFILE para las variables globales de la unidad +parser_e_dlltool_unit_var_problem2=03161_E_Compile sin la opcion -WD +% You need to compile this file without the -WD switch on the +% commandline +parser_f_need_objfpc_or_delphi_mode=03162_F_Se requiere el modo ObjFpc (-S2) o Delphi (-Sd) para compilar este módulo +% You need to use \{\$mode objfpc\} or \{\$mode delphi\} to compile this file. +% Or use the equivalent commandline switches -S2 or -Sd. +parser_e_no_export_with_index_for_target=03163_E_No se pueden exportar funciones o procedimientos por indice en $1 +% Exporting of functions or procedures with a specified index is not +% supported on this target. +parser_e_no_export_of_variables_for_target=03164_E_Exportar variables no esta soportado en $1 +% Exporting of variables is not supported on this target. +parser_e_improper_guid_syntax=03165_E_Sintaxis de GUID incorrecta +parser_w_interface_mapping_notfound=03168_W_No se encontro el procedimiento de nombre "$1" apropiado para implementar $2.$3 +parser_e_interface_id_expected=03169_E_identificador de interfaz esperado +% This happens when the compiler scans a \var{class} declaration that contains +% \var{interface} function name mapping code like this: +% \begin{verbatim} +% type +% TMyObject = class(TObject, IDispatch) +% function IUnknown.QueryInterface=MyQueryInterface; +% .... +% \end{verbatim} +% and the \var{interface} before the dot not listed in the inheritance list. +parser_e_type_cant_be_used_in_array_index=03170_E_El tipo "$1" no puede ser usado como indice en arrays +% Types like \var{qword} or \var{int64} aren't allowed as array index type +parser_e_no_con_des_in_interfaces=03171_E_No se permiten constructores/destructores en interfaces +% Constructor and destructor declarations aren't allowed in interface +% In the most cases the method \var{QueryInterface} of \var{IUnknown} can +% be used to create a new interface. +parser_e_no_access_specifier_in_interfaces=03172_E_No se permiten especificadores de acceso en interfaces +% The access specifiers \var{public}, \var{private}, \var{protected} and +% \var{pusblished} can't be used in interfaces because all methods +% of an interfaces must be public. +parser_e_no_vars_in_interfaces=03173_E_Una interfaz no puede contener campos +% Declarations of fields aren't allowed in interfaces. An interface +% can contain only methods +parser_e_no_local_proc_external=03174_E_No se puede declarar un procedimiento local como externo +% Declaring local procedures as external is not possible. Local procedures +% get hidden parameters that will make the chance of errors very high +parser_w_skipped_fields_before=03175_W_Algunos campos anteriores a "$1" no fueron inicializados +% In Delphi mode, not all fields of a typed constant record have to be +% initialized, but the compiler warns you when it detects such situations. +parser_e_skipped_fields_before=03176_E_Algunos campos anteriores a "$1" no fueron inicializados +% In all syntax modes but Delphi mode, you can't leave some fields uninitialized +% in the middle of a typed constant record +parser_w_skipped_fields_after=03177_W_Algunos campos tras "$1" no fueron inicializados +% You can leave some fields at the end of a type constant record uninitialized +% (the compiler will initialize them to zero automatically). This may be the cause +% of subtle problems. +parser_e_varargs_need_cdecl_and_external=03178_E_Directiva VarArgs sólo es válida con CDecl o External +% The varargs directive can only be used with procedures or functions +% that are declared with \var{cdecl} and \var{external} directives. The varargs directive +% is only meant to provide a compatible interface to C functions like printf. +parser_e_self_call_by_value=03179_E_Self debe ser un parámetro normal por valor +% You can't declare self as a const or var parameter, it must always be +% a call-by-value parameter +parser_e_interface_has_no_guid=03180_E_La interfaz "$1" no tiene identificacion +% When you want to assign an interface to a constant, then the interface +% must have a GUID value set. +parser_e_illegal_field_or_method=03181_E_Campo de la clase o método desconocido "$1" +% Properties must refer to a field or method in the same class. +parser_w_proc_overriding_calling=03182_W_Varias convenciones de llamada especificadas, "$1" ignorado al especificar "$2" +% There are two directives in the procedure declaration that specify a calling +% convention. Only the last directive will be used +parser_e_no_procvarobj_const=03183_E_constantes con tipo de tipo Procedure/Function (...) of Object solo pueden ser inicializados a NIL +% You can't assign the address of a method to a typed constant which has a +% 'procedure of object' type, because such a constant requires two addresses: +% that of the method (which is known at compile time) and that of the object or +% class instance it operates on (which can not be known at compile time). +parser_e_default_value_only_one_para=03184_E_Sólo se puede asignar valor por defecto a un parámetro +parser_e_default_value_expected_for_para=03185_E_Parámetro por defecto requerido para "$1" +parser_w_unsupported_feature=03186_W_¡Uso de una caracteristica no soportada! +% You're trying to force the compiler into doing something it cannot do yet. +parser_h_c_arrays_are_references=03187_H_Arrays tipo C son pasados por referencia +% Any array passed to a C functions is passed +% by a pointer (i.e. by reference). +parser_e_C_array_of_const_must_be_last=03188_E_Array tipo C de const debe ser el ultimo parámetro +% You can not add any other argument after an \var{array of const} for +% \var{cdecl} functions, as the size pushed on stack for this argument is +% not known. +parser_h_type_redef=03189_H_Redefinición del tipo "$1" +% This is an indicator that a previously declared type is +% being redefined as something else. This may, or may not +% be, a cause for errors. +parser_w_cdecl_has_no_high=03190_W_Procedimientos y funciones declarados como cdecl no reciben de parámetro el límite superior +% Functions declared with cdecl modifier do not pass an extra implicit parameter. +parser_w_cdecl_no_openstring=03191_W_open strings no son soportados en funciones cdecl +% Openstring is not supported for cdecl'ared functions. +parser_e_initialized_not_for_threadvar=03192_E_No se pueden inicializar variables declaradas como threadvar +% Variables declared as threadvar can not be initialized with a default value. +% The variables will always be filled with zero at the start of a new thread. +parser_e_msg_only_for_classes=03193_E_La directiva Message sólo es valida en clases +% The message directive is only supported for Class types. +parser_e_procedure_or_function_expected=03194_E_Se esperaba un procedimiento o funcion +% A class method can only be specified for procedures and functions. +parser_e_illegal_calling_convention=03195_W_Directiva de convención de llama "$1" ignorada +% Some calling conventions are supported only by certain CPUs. I.e. most non-i386 ports support +% only the standard ABI calling convention of the CPU. +parser_e_no_object_reintroduce=03196_E_REINTRODUCE no puede ser utilizado en objetos +% \var{reintroduce} is not supported for objects. +parser_e_paraloc_only_one_para=03197_E_Cada parámetro debe tener su propia posición +% If locations for arguments are specified explicitly as it is required by +% some syscall conventions, each argument must have it's only location, things +% like \var{procedure p(i,j : longint 'r1');} aren't allowed +parser_e_paraloc_all_paras=03198_E_Cada parámetro debe tener su propia posición +% If one argument has an explicit argument location, all arguments of a procedure +% must have one. +parser_e_illegal_explicit_paraloc=03199_E_Localizacón en el segmento desconocida +% The location specified for an argument isn't recognized by the compiler +parser_e_32bitint_or_pointer_variable_expected=03200_E_Se esperaba una variable entera de 32 bits o un puntero +% The libbase for MorphOS/AmigaOS can be give only as \var{longint}, \var{dword} or any pointer variable. +parser_e_goto_outside_proc=03201_E_No se puede usar Goto para saltar a otro procedimiento +% It isn't allowed to use the \var{goto} statements referencing labels outside the +% current procedure. The following example shows the problem: +% \begin{verbatim} +% ... +% procedure p1; +% label +% l1; +% +% procedure p2; +% begin +% goto l1; // This goto ISN'T allowed +% end; +% +% begin +% p2 +% l1: +% end; +% ... +% +% \end{verbatim} +parser_f_too_complex_proc=03202_F_Procedimiento demasiado complejo. Se requieren demasiados registros +% Your procedure body is too long for the compiler. You should split the +% procedure into multiple smaller procedures. +parser_e_illegal_expression=03203_E_Expresión inválida +% This can occur under many circumstances. Mostly when trying to evaluate +% constant expressions. +parser_e_invalid_integer=03204_E_La expresión no evalua un número entero +% You made an expression which isn't an integer, and the compiler expects the +% result to be an integer. +parser_e_invalid_qualifier=03205_E_calificador inválido +% One of the following is happening : +% \begin{itemize} +% \item You're trying to access a field of a variable that is not a record. +% \item You're indexing a variable that is not an array. +% \item You're dereferencing a variable that is not a pointer. +% \end{itemize} +parser_e_upper_lower_than_lower=03206_E_El limite superior especificado es menor que el inferior +% You are declaring a subrange, and the lower limit is higher than the high +% limit of the range. +parser_e_macpas_exit_wrong_param=03207_E_El parámetro de Exit debe ser el nombre del mismo procedimiento en el que está +% Non local exit is not allowed. This error occurs only in mode MacPas. +parser_e_illegal_assignment_to_count_var=03208_E_Asignación inválida a la variable de bucle "$1" +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +parser_e_no_local_var_external=03209_E_No se puede declarar una variable local como externa +% Declaring local variables as external is not allowed. Only global variables can reference +% to external variables. +parser_e_proc_already_external=03210_E_El procedimiento ya ha sido declarado como externo con anterioridad +% The procedure is already declared with the EXTERNAL directive in an interface or +% forward declaration. +parser_w_implicit_uses_of_variants_unit=03211_W_Uso implícito de la unidad Variants +% The Variant type is used in the unit without any used unit using the Variants unit. The +% compiler has implicitly added the Variants unit to the uses list. To remove this warning +% the Variants unit needs to be added to the uses statement. +parser_e_no_static_method_in_interfaces=03212_E_Clases y métodos estáticos no pueden ser utilizados en interfaces +% The specifier \var{class} and directive \var{static} can't be used in interfaces +% because all methods of an interfaces must be public. +parser_e_arithmetic_operation_overflow=03213_E_Desbordamiento en la operación aritmética +% An operation on two integers values produced an overflow +% \end{description} +# +# Type Checking +# +# 04049 is the last used one +# +% \section{Type checking errors} +% This section lists all errors that can occur when type checking is +% performed. +% \begin{description} +type_e_mismatch=04000_E_Los tipos no concuerdan +% This can happen in many cases: +% \begin{itemize} +% \item The variable you're assigning to is of a different type than the +% expression in the assignment. +% \item You are calling a function or procedure with parameters that are +% incompatible with the parameters in the function or procedure definition. +% \end{itemize} +type_e_incompatible_types=04001_E_Tipos incompatibles: se encontró "$1" esperado "$2" +% There is no conversion possible between the two types +% Another possiblity is that they are declared in different +% declarations: +% \begin{verbatim} +% Var +% A1 : Array[1..10] Of Integer; +% A2 : Array[1..10] Of Integer; +% +% Begin +% A1:=A2; { This statement gives also this error, it +% is due the strict type checking of pascal } +% End. +% \end{verbatim} +type_e_not_equal_types=04002_E_Los tipos $1 y $2 no concuerdan +% The types are not equal +type_e_type_id_expected=04003_E_Identificador de tipo esperado +% The identifier is not a type, or you forgot to supply a type identifier. +type_e_variable_id_expected=04004_E_Identificador de variable esperado +% This happens when you pass a constant to a routine (such as \var{Inc} var or \var{Dec}) +% when it expects a variable. You can only pass variables as arguments to these functions. +type_e_integer_expr_expected=04005_E_expression entera esperada, pero se encontró "$1" +% The compiler expects an expression of type integer, but gets a different +% type. +type_e_boolean_expr_expected=04006_E_Expresion booleana esperada, pero se encontró "$1" +% The expression must be a boolean type, it should be return true or +% false. +type_e_ordinal_expr_expected=04007_E_Espresión ordinal esperada +% The expression must be of ordinal type, i.e., maximum a \var{Longint}. +% This happens, for instance, when you specify a second argument +% to \var{Inc} or \var{Dec} that doesn't evaluate to an ordinal value. +type_e_pointer_type_expected=04008_E_Se esperaba un tipo puntero, pero se encontró "$1" +% The variable or expression isn't of the type \var{pointer}. This +% happens when you pass a variable that isn't a pointer to \var{New} +% or \var{Dispose}. +type_e_class_type_expected=04009_E_Se esperaba un tipo de clase, pero se encontró "$1" +% The variable of expression isn't of the type \var{class}. This happens +% typically when +% \begin{enumerate} +% \item The parent class in a class declaration isn't a class. +% \item An exception handler (\var{On}) contains a type identifier that +% isn't a class. +% \end{enumerate} +type_e_cant_eval_constant_expr=04011_E_No se puede evaluar la espresión constante +% This error can occur when the bounds of an array you declared does +% not evaluate to ordinal constants +type_e_set_element_are_not_comp=04012_E_Elementos de sets incompatibles +% You are trying to make an operation on two sets, when the set element types +% are not the same. The base type of a set must be the same when taking the +% union +type_e_set_operation_unknown=04013_E_Operación no implementada para sets +% several binary operations are not defined for sets +% like div mod ** (also >= <= for now) +type_w_convert_real_2_comp=04014_W_Conversion automática de tipo de punto flotante a COMP el cual es un tipo entero +% An implicit type conversion from a real type to a \var{comp} is +% encountered. Since \var{comp} is a 64 bit integer type, this may indicate +% an error. +type_h_use_div_for_int=04015_H_usa DIV para tener un resultado entero +% When hints are on, then an integer division with the '/' operator will +% procuce this message, because the result will then be of type real +type_e_strict_var_string_violation=04016_E_Tipos de cadena no concuerdan por la presencia de la opción $V+ +% When compiling in \var{\{\$V+\}} mode, the string you pass as a parameter +% should be of the exact same type as the declared parameter of the procedure. +type_e_succ_and_pred_enums_with_assign_not_possible=04017_E_No se permite el uso de Succ o Pred en enumeraciones que tienen valores asignados explícitamente +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use the \var{Succ} or \var{Pred} functions on them. +type_e_cant_read_write_type=04018_E_No se puede leer o escribir variables de este tipo +% You are trying to \var{read} or \var{write} a variable from or to a +% file of type text, which doesn't support that. Only integer types, +% reals, pchars and strings can be read from/written to a text file. +% Booleans can only be written to text files. +type_e_no_readln_writeln_for_typed_file=04019_E_No se puede utilizar readln o writeln en ficheros con tipo +% \var{readln} and \var{writeln} are only allowed for text files. +type_e_no_read_write_for_untyped_file=04020_E_No se pueden usar read o write en ficheros sin tipo +% \var{read} and \var{write} are only allowed for text or typed files. +type_e_typeconflict_in_set=04021_E_El set contiene un elemento que no es de tipo compatible +% There is at least one set element which is of the wrong type, i.e. not of +% the set type. +type_w_maybe_wrong_hi_lo=04022_W_lo/hi(longint/dword) devuelve la parte superior/inferior de tipo word +% \fpc supports an overloaded version of \var{lo/hi} for \var{longint/dword/int64/qword} +% which returns the lower/upper word/dword of the argument. TP always uses +% a 16 bit \var{lo/hi} which returns always bits 0..7 for \var{lo} and the +% bits 8..15 for \var{hi}. If you want the TP behavior you have +% to type cast the argument to \var{word/integer} +type_e_integer_or_real_expr_expected=04023_E_Espresión entera o real esperada +% The first argument to \var{str} must a real or integer type. +type_e_wrong_type_in_array_constructor=04024_E_Tipo "$1" erróneo en el constructor del array +% You are trying to use a type in an array constructor which is not +% allowed. +type_e_wrong_parameter_type=04025_E_Tipo incompatible para el parámetro número $1: Se recibió "$2", cuando se esperaba "$3" +% You are trying to pass an invalid type for the specified parameter. +type_e_no_method_and_procedure_not_compatible=04026_E_Variables de tipo método y procedimiento no son compatibles entre si +% You can't assign a method to a procedure variable or a procedure to a +% method pointer. +type_e_wrong_math_argument=04027_E_Constante pasada a la función matematica interna no válida +% The constant argument passed to a ln or sqrt function is out of +% the definition range of these functions. +type_e_no_addr_of_constant=04028_E_No se puede obtener una dirección de una constante +% It is not possible to get the address of a constant, because they +% aren't stored in memory, you can try making it a typed constant. +type_e_argument_cant_be_assigned=04029_E_No se puede asignar un valor al parámetro +% Only expressions which can be on the left side of an +% assignment can be passed as call by reference argument +% Remark: Properties can be only +% used on the left side of an assignment, but they cannot be used as arguments +type_e_cannot_local_proc_to_procvar=04030_E_No se puede asignar un prodecimiento o funcion local a una variable +% It's not allowed to assign a local procedure/function to a +% procedure variable, because the calling of local procedure/function is +% different. You can only assign local procedure/function to a void pointer. +type_e_no_assign_to_addr=04031_E_No se puede asignar un valor a una dirección +% It is not allowed to assign a value to an address of a variable,constant, +% procedure or function. You can try compiling with -So if the identifier +% is a procedure variable. +type_e_no_assign_to_const=04032_E_No se pueden asignar valores a variables constantes +% It's not allowed to assign a value to a variable which is declared +% as a const. This is normally a parameter declared as const, to allow +% changing the value make the parameter as a value parameter or a var. +type_e_array_required=04033_E_Se requiere un array para usar [ ] +% If you are accessing a variable using an index '[<x>]' then +% the type must be an array. In FPC mode also a pointer is allowed. +type_e_interface_type_expected=04034_E_Se esperaba "interface" pero se encontró "$1" +type_w_mixed_signed_unsigned=04035_W_Operaciones mezclando enteros de 32 bits con signo son convertidas a 64 bits +% If you divide (or calculate the modulus of) a signed expression by a longword (or vice versa), +% or if you have overflow and/or range checking turned on and use an arithmetic +% expression (+, -, *, div, mod) in which both signed numbers and longwords appear, +% then everything has to be evaluated in 64bit which is slower than normal +% 32bit arithmetic. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_w_mixed_signed_unsigned2=04036_W_Mezclar operando con signo y sin signo aqui puede causar errores de comprobación de rango +% If you use a binary operator (and, or, xor) and one of +% the operands is a longword while the other one is a signed expression, then, +% if range checking is turned on, you may get a range check error because in +% such a case both operands are converted to longword before the operation is +% carried out. You can avoid this by typecasting one operand so it +% matches the result type of the other one. +type_e_typecast_wrong_size_for_assignment=04037_E_La conversión de tipos ($1 -> $2) en la asignación tiene diferentes tamaños +% Type casting to a type with a different size is not allowed when the variable is +% used for assigning. +type_e_array_index_enums_with_assign_not_possible=04038_E_No se pueden usar enums con asignaciones como indices de arrays +% When you declared an enumeration type which has assignments in it, as in C, +% like in the following: +% \begin{verbatim} +% Tenum = (a,b,e:=5); +% \end{verbatim} +% you cannot use it as index of an array. +type_e_classes_not_related=04039_E_Las clases u objetos "$1" y "$2" no están relacionados +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_w_classes_not_related=04040_W_Los tipos de clases "$1" y "$2" no están relacionados +% There is a typecast from one class or object to another while the class/object +% are not related. This will probably lead to errors +type_e_class_or_interface_type_expected=04041_E_Se esperaba una clase o interfaz, pero se encotró "$1" +type_e_type_is_not_completly_defined=04042_E_El tipo "$1" no esta definido completamente aún +type_w_string_too_long=04043_W_La cadena contiene mas caracteres que los admitidos por una cadena corta +% The size of the constant string, which is assigned to a shortstring, +% is longer than the maximum size of the shortstring +type_w_signed_unsigned_always_false=04044_W_La comparación es siempre falsa debido a los rangos de los valores +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% false. Exlicitly typecast the constant to the correct range to avoid this problem. +type_w_signed_unsigned_always_true=04045_W_La comparación es siempre verdadera debido a los rangos de los valores +% There is a comparison between an unsigned value and a signed constant which is +% less than zero. Because of type promotion, the statement will always evaluate to +% true. Exlicitly typecast the constant to the correct range to avoid this problem. +type_w_instance_with_abstract=04046_W_Constuyendo un objeto de clase "$1" que contiene métodos abstractos +% An instance of a class is created which contains non-implemented abstract +% methods. This will probably lead to a runtime error 211 in the code if that +% routine is ever called. All abstract methods should be overridden. +type_h_in_range_check=04047_H_El operando a la izquierda de IN debe ser de tamaño un byte +% The left operand of the \var{in} operator is not an ordinal or enumeration which fits +% within 8-bits, this may lead to range check errors. The \var{in} operator +% currently only supports a left operand which fits within a byte. In the case of +% enumerations, the size of an element of an enumeration can be controlled with +% the \var{\{\$PACKENUM\}} or \var{\{\$Zn\}} switches. +type_w_smaller_possible_range_check=04048_W_Diferencia del tamaño de los tipos puede causar pérdida de datos o errores de comprobación de rango +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_h_smaller_possible_range_check=04049_H_Diferencia del tamaño de los tipos puede causar pérdida de datos o errores de comprobación de rango +% There is an assignment to a smaller type than the source type. This means that +% this may cause a range-check error, or may lead to possible loss of data. +type_e_cant_take_address_of_abstract_method=04050_E_No se puede obtener la dirección de un método abstracto +% An abstract method has no body, so the address of an abstract method can't be taken. +type_e_operator_not_allowed=04051_E_El operador no es aplicable con los operandos especificados +% You are trying an operator that is not available for the type of the +% operands +type_e_constant_expr_expected=04052_E_Se esperaba una expresió constante +% The compiler expects an constant expression, but gets a variable expression. +type_e_operator_not_supported_for_types=04053_E_La operacion "$1" no está soportada para los tipos "$2" y "$3" +% The operation is not allowed for the supplied types +type_e_illegal_type_conversion=04054_E_No es posible realizar una conversión de "$1" a "$2" +% When doing a type-cast, you must take care that the sizes of the variable and +% the destination type are the same. +type_h_pointer_to_longint_conv_not_portable=04055_H_La conversion entre punteros y ordinales no es portable +% If you typecast a pointer to a longint (or vice-versa), this code will not compile +% on a machine using 64-bit for pointer storage. +type_w_pointer_to_longint_conv_not_portable=04056_W_La conversion entre punteros y ordinales no es portable +% If you typecast a pointer to a ordinal type of a different size (or vice-versa), this can +% cause problems. This is a warning to help finding the 32bit specific code where cardinal/longint is used +% to typecast pointers to ordinals. A solution is to use the ptrint/ptruint types instead. +type_e_cant_choose_overload_function=04057_E_No se pudo determinar que funcion sobrecargada llamar +% You're calling overloaded functions with a parameter that doesn't correspond +% to any of the declared function parameter lists. e.g. when you have declared +% a function with parameters \var{word} and \var{longint}, and then you call +% it with a parameter which is of type \var{integer}. +type_e_illegal_count_var=04058_E_Variable de contador inválida +% The type of a \var{for} loop variable must be an ordinal type. +% Loop variables cannot be reals or strings. +% \end{description} +# +# Symtable +# +# 05055 is the last used one +# +% \section{Symbol handling} +% This section lists all the messages that concern the handling of symbols. +% This means all things that have to do with procedure and variable names. +% \begin{description} +sym_e_id_not_found=05000_E_Identificador no encontrado "$1" +% The compiler doesn't know this symbol. Usually happens when you misspel +% the name of a variable or procedure, or when you forgot to declare a +% variable. +sym_f_internal_error_in_symtablestack=05001_F_Error interno en SymTableStack() +% An internal error occurred in the compiler; If you encounter such an error, +% please contact the developers and try to provide an exact description of +% the circumstances in which the error occurs. +sym_e_duplicate_id=05002_E_Identificador duplicado "$1" +% The identifier was already declared in the current scope. +sym_h_duplicate_id_where=05003_H_El identificador ya está definido en $1 en la línea $2 +% The identifier was already declared in a previous scope. +sym_e_unknown_id=05004_E_Identificador desconocido "$1" +% The identifier encountered has not been declared, or is used outside the +% scope where it is defined. +sym_e_forward_not_resolved=05005_E_Declaración posterior no solucionada "$1" +% This can happen in two cases: +% \begin{itemize} +% \item This happens when you declare a function (in the \var{interface} part, or +% with a \var{forward} directive, but do not implement it. +% \item You reference a type which isn't declared in the current \var{type} +% block. +% \end{itemize} +sym_e_error_in_type_def=05007_E_Error en definición de tipo +% There is an error in your definition of a new array type: +% \item One of the range delimiters in an array declaration is erroneous. +% For example, \var{Array [1..1.25]} will trigger this error. +sym_e_forward_type_not_resolved=05009_E_Tipo posterior no resuelto "$1" +% A symbol was forward defined, but no declaration was encountered. +sym_e_only_static_in_static=05010_E_Solo las variables estáticas pueden ser usadas en métodos estáticos o fuera de métodos +% A static method of an object can only access static variables. +sym_f_type_must_be_rec_or_class=05012_F_tipo record o class esperado +% The variable or expression isn't of the type \var{record} or \var{class}. +sym_e_no_instance_of_abstract_object=05013_E_No se permiten instancias de clases u objetos con un métodos abstractos +% You are trying to generate an instance of a class which has an abstract +% method that wasn't overridden. +sym_w_label_not_defined=05014_W_Etiqueta no definida "$1" +% A label was declared, but not defined. +sym_e_label_used_and_not_defined=05015_E_Etiqueta "$1" usada pero no definida +% A label was declared and used, but not defined. +sym_e_ill_label_decl=05016_E_Declaración inválida de la etiqueta +% This error should never happen; it occurs if a label is defined outside a +% procedure or function. +sym_e_goto_and_label_not_supported=05017_E_GOTO y LABEL no son soportados (debe ser habilitado con -Sg) +% You must compile a program which has \var{label}s and \var{goto} statements +% with the \var{-Sg} switch. By default, \var{label} and \var{goto} aren't +% supported. +sym_e_label_not_found=05018_E_Etiqueta no encontrada +% A \var{goto label} was encountered, but the label isn't declared. +sym_e_id_is_no_label_id=05019_E_el identificador no es una etiqueta +% The identifier specified after the \var{goto} isn't of type label. +sym_e_label_already_defined=05020_E_Etiqueta ya definida +% You are defining a label twice. You can define a label only once. +sym_e_ill_type_decl_set=05021_E_Definicion de tipo set inválida +% The declaration of a set contains an invalid type definition. +sym_e_class_forward_not_resolved=05022_E_Definición posterior de la clase "$1" no resuelta +% You declared a class, but you did not implement it. +sym_n_unit_not_used=05023_H_Unidad "$1" no utilizada en $2 +% The unit referenced in the \var{uses} clause is not used. +sym_h_para_identifier_not_used=05024_H_Parámetro "$1" no usado +% The identifier was declared (locally or globally) but +% was not used (locally or globally). +sym_n_local_identifier_not_used=05025_N_Variable local no usada "$1" +% You have declared, but not used a variable in a procedure or function +% implementation. +sym_h_para_identifier_only_set=05026_H_Valor asignado a "$1" pero no utilizado +% The identifier was declared (locally or globally) +% set but not used (locally or globally). +sym_n_local_identifier_only_set=05027_N_Valor asignado a la variable local "$1" no utilizado +% The variable in a procedure or function +% implementation is declared, set but never used. +sym_h_local_symbol_not_used=05028_H_Símbolo local $1 "$2" no utilizado +% A local symbol is never used. +sym_n_private_identifier_not_used=05029_N_Campo privado $1.$2 no utilizado +sym_n_private_identifier_only_set=05030_N_Valor asignado al campo privado $1.$2 pero nunca es utilizado +sym_n_private_method_not_used=05031_N_Método privado $1.$2 no utilizado +sym_e_set_expected=05032_E_Tipo set esperado +% The variable or expression is not of type \var{set}. This happens in an +% \var{in} statement. +sym_w_function_result_not_set=05033_W_El resultado de la función puede no haber sido asignado +% You can get this warning if the compiler thinks that a function return +% value is not set. This will not be displayed for assembler procedures, +% or procedures that contain assembler blocks. +sym_w_wrong_C_pack=05034_W_El tipo "$1" no esta correctamente alineado para C +% Arrays with sizes not multiples of 4 will be wrongly aligned +% for C structures. +sym_e_illegal_field=05035_E_Identificador de campo de registro desconocido: "$1" +% The field doesn't exist in the record/object definition. +sym_w_uninitialized_local_variable=05036_W_La variable local "$1" no parace haber sido inicializada +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_w_uninitialized_variable=05037_W_La variable "$1" no parece haber sido inicializada +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_e_id_no_member=05038_E_El identificador "$1" no identifica ningún miembro +% This error is generated when an identifier of a record, +% field, or method is accessed while it is not defined. +sym_h_param_list=05039_H_Declaracion encontrada: $1 +% You get this when you use the \var{-vh} switch. In case an overloaded +% procedure is not found, then all candidate overloaded procedures are +% listed, with their parameter lists. +sym_e_segment_too_large=05040_E_Segmento de datos demasiado grande +% You get this when you declare a data element whose size exceeds the +% prescribed limit (2 Gb on 80386+/68020+ processors) +sym_e_no_matching_implementation_found=05042_E_No se encontro una implementación para el método "$1" de la interfaz +% There was no matching method found which could implement the interface +% method. Check argument types and result type of the methods. +sym_w_deprecated_symbol=05043_W_Símbolo "$1" desaconsejado +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{deprecated} is used. Deprecated symbols may no longer +% be available in newer versions of the unit / library. Usage of this symbol +% should be avoided as much as possible. +sym_w_non_portable_symbol=05044_W_El símbolo "$1" no es portable +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{platform} is used. This symbol's value, usage +% and availability is platform specific and should not be used +% if the source code must be portable. +sym_w_non_implemented_symbol=05055_W_El símbolo "$1" no está implementado +% This means that a symbol (a variable, routine, etc...) which is +% declared as \var{unimplemented} is used. This symbol is defined, +% but is not yet implemented on this specific platform. +sym_e_cant_create_unique_type=05056_E_No se puede crear un tipo único a partir de este tipo +% Only simple types like ordinal, float and string types are supported when +% redefining a type with \var{type newtype = type oldtype;}. +sym_h_uninitialized_local_variable=05057_H_La variable local "$1" no parece haber sido inicializada +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +sym_h_uninitialized_variable=05058_H_La variable "$1" no parece haber sido inicializada +% This message is displayed if the compiler thinks that a variable will +% be used (i.e. appears in the right-hand-side of an expression) when it +% was not initialized first (i.e. appeared in the left-hand side of an +% assigment) +% \end{description} +# +# Codegenerator +# +# 06040 is the last used one +# +% \section{Code generator messages} +% This section lists all messages that can be displayed if the code +% generator encounters an error condition. +% \begin{description} +cg_e_parasize_too_big=06009_E_El tamaño de la lista de par metros excede 65535 bytes +% The I386 processor limits the parameter list to 65535 bytes (the \var{RET} +% instruction causes this) +cg_e_file_must_call_by_reference=06012_E_Los tipos File deben ser pasados por referencia +% You cannot specify files as value parameters, i.e. they must always be +% declared \var{var} parameters. +cg_e_cant_use_far_pointer_there=06013_E_El uso de punteros "far" no esta permitido aqií +% Free Pascal doesn't support far pointers, so you cannot take the address of +% an expression which has a far reference as a result. The \var{mem} construct +% has a far reference as a result, so the following code will produce this +% error: +% \begin{verbatim} +% var p : pointer; +% ... +% p:=@mem[a000:000]; +% \end{verbatim} +cg_e_dont_call_exported_direct=06015_E_las funciones declaradas como EXPORT no pueden ser llamadas +% No longer in use. +cg_w_member_cd_call_from_method=06016_W_Posible llamada inválida de un constructor o destructor +% The compiler detected that a constructor or destructor is called within a +% a method. This will probably lead to problems, since constructors / destructors +% require parameters on entry. +cg_n_inefficient_code=06017_N_código ineficiente +% Your statement seems dubious to the compiler. +cg_w_unreachable_code=06018_W_El código no será ejecutado nunca +% You specified a construct which will never be executed. Example: +% \begin{verbatim} +% while false do +% begin +% {.. code ...} +% end; +% \end{verbatim} +cg_e_cant_call_abstract_method=06020_E_Los métodos abstractos no pueden ser llamados directamente +% You cannot call an abstract method directy, instead you must call a +% overriding child method, because an abstract method isn't implemented. +cg_d_register_weight=06027_DL_Registro $1 peso $2 $3 +% Debugging message. Shown when the compiler considers a variable for +% keeping in the registers. +cg_d_stackframe_omited=06029_DL_Se omite generar stack frame +% Some procedure/functions do not need a complete stack-frame, so it is omitted. +% This message will be displayed when the {-vd} switch is used. +cg_e_unable_inline_object_methods=06031_E_Métodos de objetos o clases no pueden ser inline +% You cannot have inlined object methods. +cg_e_unable_inline_procvar=06032_E_Variables de procedimiento o función no pueden ser inline +% A procedure with a procedural variable call cannot be inlined. +cg_e_no_code_for_inline_stored=06033_E_No hay código almacenado para procedimientos inline +% The compiler couldn't store code for the inline procedure. +cg_e_can_access_element_zero=06035_E_No se puede acceder al elemento 0 de cadenas largas, use SetLength/Length +% You should use \var{setlength} to set the length of an ansi/wide/longstring +% and \var{length} to get the length of such a string types +cg_e_cannot_call_cons_dest_inside_with=06037_E_No se pueden llamar a constructores o destructores en with +% Inside a \var{with} clause you cannot call a constructor or destructor for the +% object you have in the \var{with} clause. +cg_e_cannot_call_message_direct=06038_E_No se pueden llamar a métodos manejadores de mensajes directamente +% A message method handler method cannot be called directly if it contains an +% explicit self argument +cg_e_goto_inout_of_exception_block=06039_E_Salto fuera de un bloque de excepción +% It is not allowed to jump in or outside of an exception block like \var{try..finally..end;}: +% \begin{verbatim} +% label 1; +% +% ... +% +% try +% if not(final) then +% goto 1; // this line will cause an error +% finally +% ... +% end; +% 1: +% ... +% \end{verbatim} +cg_e_control_flow_outside_finally=06040_E_No se admiten instrucciones de control de flujo en un bloque finally +% It isn't allowed to use the control flow statements \var{break}, +% \var{continue} and \var{exit} +% inside a finally statement. The following example shows the problem: +% \begin{verbatim} +% ... +% try +% p; +% finally +% ... +% exit; // This exit ISN'T allowed +% end; +% ... +% +% \end{verbatim} +% If the procedure \var{p} raises an exception the finally block is +% executed. If the execution reaches the exit, it's unclear what to do: +% exiting the procedure or searching for another exception handler +cg_w_parasize_too_big=06041_W_El tamaño del parámetro excede el límite de algunas CPU +% This indicates that you are declaring more than 64K of parameters, which +% might not be supported on other processor targets. +cg_w_localsize_too_big=06042_W_El tamaño de las variables locales excede el límite de algunas CPU +% This indicates that you are declaring more than 32K of lcoal variables, which +% might not be supported on other processor targets. +cg_e_localsize_too_big=06043_E_El tamaño de las variables locales excede el límite de la CPU de destino +% This indicates that you are declaring more than 32K of lcoal variables, which +% is not supported by this processor. +cg_e_break_not_allowed=06044_E_BREAK no permitido aquí +% You're trying to use \var{break} outside a loop construction. +cg_e_continue_not_allowed=06045_E_CONTINUE no permitido aquí +% You're trying to use \var{continue} outside a loop construction. +% \end{description} +# EndOfTeX + +# +# Assembler reader +# +# 07097 is the last used one +# +asmr_d_start_reading=07000_DL_Iniciando interpretado de ensamblador de estilo $1 +% This informs you that an assembler block is being parsed +asmr_d_finish_reading=07001_DL_Finalizado interpretado de ensamblador de estilo $1 +% This informs you that an assembler block has finished. +asmr_e_none_label_contain_at=07002_E_Una patrón que no es una etiqueta contiene @ +% A identifier which isn't a label can't contain a @. +asmr_e_building_record_offset=07004_E_Error construyendo desplazamiento de registro (record) +% There has an error occured while building the offset of a record/object +% structure, this can happend when there is no field specified at all or +% an unknown field identifier is used. +asmr_e_offset_without_identifier=07005_E_OFFSET usado sin identificador +% You can only use OFFSET with an identifier. Other syntaxes aren't +% supported +asmr_e_type_without_identifier=07006_E_TYPE usado sin identificador +% You can only use TYPE with an identifier. Other syntaxes aren't +% supported +asmr_e_no_local_or_para_allowed=07007_E_No es posible usar una variable local o parámetro aquí +% You can't use a local variable or parameter here, mostly because the +% addressing of locals and parameters is done using the frame pointer register so the +% address can't be obtained directly. +asmr_e_need_offset=07008_E_Es necesario el uso de OFFSET aquí +% You need to use OFFSET <id> here to get the address of the identifier. +asmr_e_need_dollar=07009_E_Es necesario el uso de $ auqí +% You need to use $<id> here to get the address of the identifier. +asmr_e_cant_have_multiple_relocatable_symbols=07010_E_No es posible utilizar varios símbolos reubicables +% You can't have more than one relocatable symbol (variable/typed constant) +% in one argument. +asmr_e_only_add_relocatable_symbol=07011_E_Símbolos reubicables solo pueden ser añadidos +% Relocatable symbols (variable/typed constant) can't be used with other +% operators. Only addition is allowed. +asmr_e_invalid_constant_expression=07012_E_Espresió constante inválida +% There is an error in the constant expression. +asmr_e_relocatable_symbol_not_allowed=07013_E_Símbolo reubicable no permitido +% You can't use a relocatable symbol (variable/typed constant) here. +asmr_e_invalid_reference_syntax=07014_E_Sintaxis de referencia inválida +% There is an error in the reference. +asmr_e_local_para_unreachable=07015_E_No se puede llegar a $1 desde este código +% You can not read directly the value of local or para +% of a higher level in assembler code (except for +% local assembler code without parameter nor locals). +asmr_e_local_label_not_allowed_as_ref=07016_E_No está permitido el uso símbolos locales o etiquetas como referencias +% You can't use local symbols/labels as references +asmr_e_wrong_base_index=07017_E_Uso inválido de registros indice y base +% There is an error with the base and index register, they are +% probably incorrect +asmr_w_possible_object_field_bug=07018_W_Posible error en el manejo de campos de objetos +% Fields of objects or classes can be reached directly in normal or objfpc +% modes but TP and Delphi modes treat the field name as a simple offset. +asmr_e_wrong_scale_factor=07019_E_Factor de escala erróneo +% The scale factor given is wrong, only 1,2,4 and 8 are allowed +asmr_e_multiple_index=07020_E_Uso de multiples registros índice +% You are trying to use more than one index register +asmr_e_invalid_operand_type=07021_E_Tipo del operando no válido +% The operand type doesn't match with the opcode used +asmr_e_invalid_string_as_opcode_operand=07022_E_Cadena no vólida como operando de esta instrucción: $1 +% The string specified as operand is not correct with this opcode +asmr_w_CODE_and_DATA_not_supported=07023_W_@CODE y @DATA no son soportados +% @CODE and @DATA are unsupported and are ignored. +asmr_e_null_label_ref_not_allowed=07024_E_Referencias a etiqueta nula no permitida +asmr_e_expr_zero_divide=07025_E_Division entre cero en el evaluador de ensamblador +% There is a division by zero in a constant expression +asmr_e_expr_illegal=07026_E_Expresión inválida +% There is an illegal expression in a constant expression +asmr_e_escape_seq_ignored=07027_E_Sequencia de escape ignorada: $1 +% There is a C-styled string, but the escape sequence in the string +% is unknown, and is therefore ignored +asmr_e_invalid_symbol_ref=07028_E_Referencia a símbolo inválida +asmr_w_fwait_emu_prob=07029_W_Fwait puede causar problemas de emulación con emu387 +asmr_w_fadd_to_faddp=07030_W_$1 sin operando interpretado como $1P +asmr_w_enter_not_supported_by_linux=07031_W_La instruccion ENTER no está soportada por el kernel de Linux +% ENTER instruction can generate a stack page fault that is not +% caught correctly by the i386 Linux page handler. +asmr_w_calling_overload_func=07032_W_Llamando a una funcion sobrecargada desde ensamblador +% There is a call to an overloaded method in the assembler block, +% this might be the sign there is a problem +asmr_e_unsupported_symbol_type=07033_E_Tipo de símbolo no soportado para el operando +asmr_e_constant_out_of_bounds=07034_E_Valor de la constante fuera de rango +asmr_e_error_converting_decimal=07035_E_Error convirtiendo decimal $1 +% A constant decimal value does not have the correct syntax +asmr_e_error_converting_octal=07036_E_Error convirtiendo octal $1 +% A constant octal value does not have the correct syntax +asmr_e_error_converting_binary=07037_E_Error convirtiendo binario $1 +% A constant binary value does not have the correct syntax +asmr_e_error_converting_hexadecimal=07038_E_Error convirtiendo hexadecimal $1 +% A constant hexadecimal value does not have the correct syntax +asmr_h_direct_global_to_mangled=07039_H_$1 traducido a $2 +asmr_w_direct_global_is_overloaded_func=07040_W_$1 esta asociado a una función sobrecargada +asmr_e_cannot_use_SELF_outside_a_method=07041_E_No se puede usar SELF fuera de un método +% There is a reference to the \var{self} symbol while it is not +% allowed. \var{self} can only be referenced inside methods +asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042_E_No se puede usar OLDEBP fuera de un procedimiento anidado +% There is a reference to the \var{oldebp} symbol while it is not +% allowed. \var{oldebp} can only be referenced inside nested routines +asmr_e_void_function=07043_W_No es posible devolver un valor en procedimientos desde código asm +% Trying to return a value while in a procedure. A procedure +% does not have any return value +asmr_e_SEG_not_supported=07044_E_SEG no soportado +asmr_e_size_suffix_and_dest_dont_match=07045_E_No concuerdan el tamaño del prefijo y el del origen o destino +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_w_size_suffix_and_dest_dont_match=07046_W_No concuerdan el tamaño del prefijo y el del origen o destino +% The register size and the opcode size suffix don't match. This is +% probably an error in the assembler statement +asmr_e_syntax_error=07047_E_Error de sintaxis de ensamblador +% There is an assembler syntax error +asmr_e_invalid_opcode_and_operand=07048_E_Combinación inválida de operacion y operandos +% The opcode cannot be used with this type of operand +asmr_e_syn_operand=07049_E_Error de sintaxis de ensamblador en operando +asmr_e_syn_constant=07050_E_Error de sintaxis de ensamblador en constante +asmr_e_invalid_string_expression=07051_E_Espresión de cadena noáv lida +asmr_w_const32bit_for_address=07052_W_constante con la direccion del símbolo $1 que no es un puntero +% A constant expression represents an address which does not fit +% into a pointer. The address is probably incorrect +asmr_e_unknown_opcode=07053_E_Instrucción $1 no reconocida +% This opcode is not known +asmr_e_invalid_or_missing_opcode=07054_E_Falta la instrucción o no es válida +asmr_e_invalid_prefix_and_opcode=07055_E_Combinación de prefijo y operación inválidos: $1 +asmr_e_invalid_override_and_opcode=07056_E_Combinación de sobrecarga y operación inválidos: $1 +asmr_e_too_many_operands=07057_E_Demasiados operandos en la línea +% There are too many operands for this opcode. Check your +% assembler syntax +asmr_w_near_ignored=07058_W_NEAR ignorado +asmr_w_far_ignored=07059_W_FAR ignorado +asmr_e_dup_local_sym=07060_E_Símbolo local duplicado $1 +asmr_e_unknown_local_sym=07061_E_Símbolo local indefinido $1 +asmr_e_unknown_label_identifier=07062_E_Identificador de etiqueta desconocido $1 +asmr_e_invalid_register=07063_E_Nombre de registro incorrecto +% There is an unknown register name used as operand. +asmr_e_invalid_fpu_register=07064_E_Nombre de registro de punto flotante no válido +% There is an unknown register name used as operand. +asmr_w_modulo_not_supported=07066_W_Modulo no soportado +asmr_e_invalid_float_const=07067_E_Constante de punto flotante no válida $1 +% The floating point constant declared in an assembler block is +% invalid. +asmr_e_invalid_float_expr=07068_E_Espresión de punto flotante no válida +% The floating point expression declared in an assembler block is +% invalid. +asmr_e_wrong_sym_type=07069_E_Tipo de símbolo erróneo +asmr_e_cannot_index_relative_var=07070_E_No se puede indexar una var. local o un parámetro con un registro +% Trying to index using a base register a symbol which is already relative +% to a register. This is not possible, and will probably lead to crashes. +asmr_e_invalid_seg_override=07071_E_Espresión reemplazo de segmento inválida +asmr_w_id_supposed_external=07072_W_Identificador $1 se supone externo +% There is a reference to an undefined symbol. This will not result +% in an error, since the symbol might be external, but may cause +% problems at link time if the symbol is not defined anywhere. +asmr_e_string_not_allowed_as_const=07073_E_Cadenas no permitidas como constantes +% Character strings are not allowed as constants. +asmr_e_no_var_type_specified=07074_E_No hay tipo de variable especificado +% The syntax expects a type idenfitifer after the dot, but +% none was found. +asmr_w_assembler_code_not_returned_to_text=07075_E_Código ensamblador no devuelto a sección de texto +% There was a directive in the assembler block to change sections, +% but there is a missing return to the text section at the end +% of the assembler block. This might cause errors during link time. +asmr_e_not_directive_or_local_symbol=07076_E_No es una directiva o un símbolo local $1 +% This symbol is unknown. +asmr_w_using_defined_as_local=07077_E_Usando un nombre definido como una etiqueta local +asmr_e_dollar_without_identifier=07078_E_Tóken de dólar usado sin identificador +% A constant expression has an identifier which does not start with +% the $ symbol. +asmr_w_32bit_const_for_address=07079_W_Constante de 32 bits creada para la dirección +% A constant was used as an address. This is probably an error, +% since using absolute addresses will probably not work. +asmr_n_align_is_target_specific=07080_N_.align es dependiente de la plataforma, use .balign o .p2align +% Using the .align directive is platform specific, and its meaning will vary +% from one platform to another. +asmr_e_cannot_access_field_directly_for_parameters=07081_E_No se puede acceder directamente a los campos de los parámetros +% You should load the parameter first into a register and then access the +% fields using that register. +asmr_e_cannot_access_object_field_directly=07082_E_No se puede acceder directamente a los campos de objetos o clases +% You should load the self pointer first into a register and then access the +% fields using the register as base. By default the self pointer is available +% in the esi register on i386. +asmr_e_unable_to_determine_reference_size=07083_E_No se especificó un tamaño y no es posible determinar el tamaño del operando +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. +asmr_e_cannot_use_RESULT_here=07084_E_No se puede utilizar RESULT en esta función +% Some functions which return complex types cannot use the \var{result} +% keyword. +asmr_w_adding_explicit_args_fXX=07086_W_"$1" sin operando traducido como "$1 %st,%st(1)" +asmr_w_adding_explicit_first_arg_fXX=07087_W_"$1 %st(n)" traducido como "$1 %st,%st(n)" +asmr_w_adding_explicit_second_arg_fXX=07088_W_"$1 %st(n)" traducido como "$1 %st(n),%st" +asmr_e_invalid_char_smaller=07089_E_El carácter < no está permitido aquí +% The shift operator requires the << characters. Only one +% of those characters was found. +asmr_e_invalid_char_greater=07090_E_El carácter > no está permitido aqui +% The shift operator requires the >> characters. Only one +% of those characters was found. +asmr_w_align_not_supported=07093_W_ALIGN no es soportado +asmr_e_no_inc_and_dec_together=07094_E_Inc y Dec no pueden estar juntos en la misma instrucción +% Trying to use an increment and a decrement within the same +% opcode on the 680x0. This is impossible. +asmr_e_invalid_reg_list_in_movem=07095_E_Lista de registros inválida para movem +% Trying to use the \var{movem} opcode with invalid registers +% to save or restore. +asmr_e_invalid_reg_list_for_opcode=07096_E_Lista de registros inválida para la instrucción +asmr_e_higher_cpu_mode_required=07097_E_Se requiere un modo de CPU superior ($1) +% Trying to use an instruction which is not supported in the current +% cpu mode. Use a higher cpu generation to be able to use this +% opcode in your assembler block +asmr_w_unable_to_determine_reference_size_using_dword=07098_W_No se especificó el tamaño del operando y no pudo ser determinado. Se utilizará DWORD por defecto +% You should specify explicitly a size for the reference, because +% the compiler is unable to determine what size (byte,word,dword,etc.) it +% should use for the reference. This warning is only used in Delphi mode where +% it falls back to use DWORD as default. +asmr_e_illegal_shifterop_syntax=07099_E_Error de sintaxis tratando de interpretar un operando de desplazamiento +% ARM only; ARM assembler supports a so called shifter operand. The used syntax isn't +% a valid shifter operand. Example for an operation with shifter operand: +% \begin{verbatim} +% asm +% orr r2,r2,r2,lsl #8 +% end; +% \end{verbatim} +# +# Assembler/binary writers +# +# 08018 is the last used one +# +asmw_f_too_many_asm_files=08000_F_Demasiados archivos de ensamblador abiertos +% With smartlinking enabled, there are too many assembler +% files generated. Disable smartlinking. +asmw_f_assembler_output_not_supported=08001_F_Salida a ensamblador seleccionada no soportada +asmw_f_comp_not_supported=08002_F_Comp no soportado +asmw_f_direct_not_supported=08003_F_Direct no soportado por escritores binarios +% Direct assembler mode is not supported for binary writers. +asmw_e_alloc_data_only_in_bss=08004_E_Sólo esta permitido alojar datos en la seccion bss +asmw_f_no_binary_writer_selected=08005_F_No hay seleccionado un escritor binario +asmw_e_opcode_not_in_table=08006_E_Asm: Opcode $1 no está en la tabla +asmw_e_invalid_opcode_and_operands=08007_E_Asm: $1 combinacion inválida de opcode y operandos +asmw_e_16bit_not_supported=08008_E_Asm: Referencias de 16 Bit no soportadas +asmw_e_invalid_effective_address=08009_E_Asm: Dirección efectiva no válida +asmw_e_immediate_or_reference_expected=08010_E_Asm: Inmediato o referencia esperado +asmw_e_value_exceeds_bounds=08011_E_Asm: $1 valor excede los límites $2 +asmw_e_short_jmp_out_of_range=08012_E_Asm: Salto corto es fuera de rango $1 +asmw_e_undefined_label=08013_E_Asm: Etiqueta no definida $1 +asmw_e_comp_not_supported=08014_E_Asm: El tipo Comp no está soportado en esta plataforma +asmw_e_extended_not_supported=08015_E_Asm: El tipo Extended no está soportado en esta plataforma +asmw_e_duplicate_label=08016_E_Asm: Etiquita $1 duplicada +asmw_e_redefined_label=08017_E_Asm: Etiqueta $1 redefinida +asmw_e_first_defined_label=08018_E_Asm: Se definió por primera vez aquí +asmw_e_invalid_register=08019_E_Asm: Registro $1 inválido + +# +# Executing linker/assembler +# +# 09034 is the last used one +# +# BeginOfTeX +% +% \section{Errors of assembling/linking stage} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +exec_w_source_os_redefined=09000_W_Sistema operativo de origen redefinido +exec_i_assembling_pipe=09001_I_Ensamblando (pipe) $1 +exec_d_cant_create_asmfile=09002_E_No se puede crear fichero ensamblador $1 +% The mentioned file can't be created. Check if you have got +% access permissions to create this file +exec_e_cant_create_objectfile=09003_E_No se puede crear fichero objeto: $1 +% The mentioned file can't be created. Check if you've +% got access permissions to create this file +exec_e_cant_create_archivefile=09004_E_No se puede crear fichero de archivado: $1 +% The mentioned file can't be created. Check if you've +% access permissions to create this file +exec_e_assembler_not_found=09005_E_Ensamblador $1 no encontrado, cambiando a ensamblado externo +exec_t_using_assembler=09006_T_Usando ensamblador: $1 +exec_e_error_while_assembling=09007_E_Error mientras se ensamblaba, codigo de terminación $1 +% There was an error while assembling the file using an external assembler. +% Consult the documentation of the assembler tool to find out more information +% on this error. +exec_e_cant_call_assembler=09008_E_No se pudo llamar al ensamblador, error $1. Cambiando a ensamblador externo +exec_i_assembling=09009_I_Ensamblando $1 +exec_i_assembling_smart=09010_I_Assembling con enlazado inteligente $1 +exec_w_objfile_not_found=09011_W_Objeto $1 no encontrado, el enlazado podria fallar! +% One of the object file is missing, and linking will probably fail. +% Check your paths. +exec_w_libfile_not_found=09012_W_Librería $1 no encontrada, el enlazado podria fallar! +% One of the library file is missing, and linking will probably fail. +% Check your paths. +exec_e_error_while_linking=09013_E_Error durante el enlazado +% Generic error while linking. +exec_e_cant_call_linker=09014_E_No se puede llamar al enlazador, cambiando a enlazado externo +exec_i_linking=09015_I_Enlazando $1 +exec_e_util_not_found=09016_E_Utilidad $1 no encontrada, cambiando a enlazado externo +exec_t_using_util=09017_T_Utilizando utilidad $1 +exec_e_exe_not_supported=09018_E_Creacion de ejecutables no soportado +exec_e_dll_not_supported=09019_E_Creacion de librerías dinámicas/compartidas no soportado +exec_i_closing_script=09020_I_Cerrando script $1 +exec_e_res_not_found=09021_E_Compilador de recursos no encontrado, cambiando a modo externo +exec_i_compilingresource=09022_I_Compilando resource $1 +exec_t_unit_not_static_linkable_switch_to_smart=09023_T_La unidad $1 no puede ser enlazada estáticamente, cambiando a enlazado inteligente +exec_t_unit_not_smart_linkable_switch_to_static=09024_T_La unidad $1 no puede ser enlazada inteligentemente, cambiando a enlazado estático +exec_t_unit_not_shared_linkable_switch_to_static=09025_T_La unidad $1 no admite enlazado compartido, cambiando a enlazado estático +exec_e_unit_not_smart_or_static_linkable=09026_E_La unidad $1 no puede ser enlazada estática o inteligentemente +exec_e_unit_not_shared_or_static_linkable=09027_E_La unidad $1 no admite enlazado compartido o estático +%\end{description} +# EndOfTeX + +# +# Executable information +# +execinfo_f_cant_process_executable=09128_F_No se puede post-procesar el ejecutable $1 +execinfo_f_cant_open_executable=09129_F_No se puede abrir el ejecutable $1 +execinfo_x_codesize=09130_X_Tamaño de Código: $1 bytes +execinfo_x_initdatasize=09131_X_Tamaño de datos inicializados: $1 bytes +execinfo_x_uninitdatasize=09132_X_Tamaño de datos sin inicializar: $1 bytes +execinfo_x_stackreserve=09133_X_Espacio reservado para la pila: $1 bytes +execinfo_x_stackcommit=09134_X_Stack space commited: $1 bytes + +# +# Unit loading +# +# 10041 is the last used one +# +# BeginOfTeX +% \section{Unit loading messages.} +% This section lists all messages that can occur when the compiler is +% loading a unit from disk into memory. Many of these messages are +% informational messages. +% \begin{description} +unit_t_unitsearch=10000_T_Buscando unidad: $1 +% When you use the \var{-vt}, the compiler tells you where it tries to find +% unit files. +unit_t_ppu_loading=10001_T_Cargando PPU $1 +% When the \var{-vt} switch is used, the compiler tells you +% what units it loads. +unit_u_ppu_name=10002_U_PPU Nombre: $1 +% When you use the \var{-vu} flag, the unit name is shown. +unit_u_ppu_flags=10003_U_PPU Banderas: $1 +% When you use the \var{-vu} flag, the unit flags are shown. +unit_u_ppu_crc=10004_U_PPU CRC: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_time=10005_U_PPU Fecha: $1 +% When you use the \var{-vu} flag, the time the unit was compiled is shown. +unit_u_ppu_file_too_short=10006_U_Fichero PPU demasiado corto +% The ppufile is too short, not all declarations are present. +unit_u_ppu_invalid_header=10007_U_Cabecera PPU inválida (no comienza por PPU) +% A unit file contains as the first three bytes the ascii codes of \var{PPU} +unit_u_ppu_invalid_version=10008_U_Versión $1 inválida +% This unit file was compiled with a different version of the compiler, and +% cannot be read. +unit_u_ppu_invalid_processor=10009_U_PPU está compilada para otro procesador +% This unit file was compiled for a different processor type, and +% cannot be read +unit_u_ppu_invalid_target=10010_U_PPU está compilada para otra plataforma +% This unit file was compiled for a different target, and +% cannot be read +unit_u_ppu_source=10011_U_Origen PPU: $1 +% When you use the \var{-vu} flag, the unit CRC check is shown. +unit_u_ppu_write=10012_U_Escribiendo $1 +% When you specify the \var{-vu} switch, the compiler will tell you where it +% writes the unit file. +unit_f_ppu_cannot_write=10013_F_No se puede escribir el fichero PPU +% An error occurred when writing the unit file. +unit_f_ppu_read_error=10014_F_Error leyendo fichero PPU +% This means that the unit file was corrupted, and contains invalid +% information. Recompilation will be necessary. +unit_f_ppu_read_unexpected_end=10015_F_Fin de fichero inesperado +% Unexpected end of file. This may mean that the PPU file is +% corrupted. +unit_f_ppu_invalid_entry=10016_F_Entrada inválida en fichero PPU: $1 +% The unit the compiler is trying to read is corrupted, or generated with a +% newer version of the compiler. +unit_f_ppu_dbx_count_problem=10017_F_Problema en el contador PPU Dbx +% There is an inconsistency in the debugging information of the unit. +unit_e_illegal_unit_name=10018_E_Nombre de unidad inválido: $1 +% The name of the unit does not match the file name. +unit_f_too_much_units=10019_F_Demasiades unidades +% \fpc has a limit of 1024 units in a program. You can change this behavior +% by changing the \var{maxunits} constant in the \file{fmodule.pas} file of the +% compiler, and recompiling the compiler. +unit_f_circular_unit_reference=10020_F_Referencia circular entre unidades $1 y $2 +% Two units are using each other in the interface part. This is only allowed +% in the \var{implementation} part. At least one unit must contain the other one +% in the \var{implementation} section. +unit_f_cant_compile_unit=10021_F_No se puede compilar la unidad $1, no hay código fuente disponible +% A unit was found that needs to be recompiled, but no sources are +% available. +unit_f_cant_find_ppu=10022_F_No se puede encontrar la unidad $1 +% You tried to use a unit of which the PPU file isn't found by the +% compiler. Check your configuration file for the unit paths +unit_w_unit_name_error=10023_W_La unidad $1 no pudo ser encontrada, pero $2 existe +unit_f_unit_name_error=10024_F_Se buscó la unidad $1 pero se encontró $2 +% Dos truncation of 8 letters for unit PPU files +% may lead to problems when unit name is longer than 8 letters. +unit_w_switch_us_missed=10025_W_Compilar la unidad System requiere el conmutador -Us +% When recompiling the system unit (it needs special treatment), the +% \var{-Us} must be specified. +unit_f_errors_in_unit=10026_F_Hubo $1 errores compilando el modulo, parando +% When the compiler encounters a fatal error or too many errors in a module +% then it stops with this message. +unit_u_load_unit=10027_U_Cargado de $1 ($2) unidad $3 +% When you use the \var{-vu} flag, which unit is loaded from which unit is +% shown. +unit_u_recompile_crc_change=10028_U_Recompilando $1, checksum cambiado por $2 +unit_u_recompile_source_found_alone=10029_U_Recompilando $1, solo se encontró el código fuente +% When you use the \var{-vu} flag, these messages tell you why the current +% unit is recompiled. +unit_u_recompile_staticlib_is_older=10030_U_Recompilando unidad, la lib estática es más antigua que la ppu +% When you use the \var{-vu} flag, the compiler warns if the static library +% of the unit are older than the unit file itself. +unit_u_recompile_sharedlib_is_older=10031_U_Recompilando unidad, la lib compartida es más antigua que la ppu +% When you use the \var{-vu} flag, the compiler warns if the shared library +% of the unit are older than the unit file itself. +unit_u_recompile_obj_and_asm_older=10032_U_Recompilando unidad, obj y asm son más antiguos que ppu +% When you use the \var{-vu} flag, the compiler warns if the assembler or +% object file of the unit are older than the unit file itself. +unit_u_recompile_obj_older_than_asm=10033_U_Recompilando unidad, obj es más antiguo que asm +% When you use the \var{-vu} flag, the compiler warns if the assembler +% file of the unit is older than the object file of the unit. +unit_u_parsing_interface=10034_U_Interpretando interfaz de $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the interface part of the unit +unit_u_parsing_implementation=10035_U_Interpretando implementacion de $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% parsing the implementation part of the unit +unit_u_second_load_unit=10036_U_Segunda carga para la unidad $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_check_time=10037_U_Chequeo de fichero PPU $1 fecha $2 +% When you use the \var{-vu} flag, the compiler show the filename and +% date and time of the file which a recompile depends on +### The following two error msgs is currently disabled. +#unit_h_cond_not_set_in_last_compile=10038_H_Conditional $1 was not set at startup in last compilation of $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that currently is defined, but was not used the last +#% time the unit was compiled. +#unit_h_cond_set_in_last_compile=10039_H_Conditional $1 was set at startup in last compilation of $2 +#% when recompilation of an unit is required the compiler will check that +#% the same conditionals are set for the recompiliation. The compiler has +#% found a conditional that was used the last time the unit was compiled, but +#% the conditional is currently not defined. +unit_w_cant_compile_unit_with_changed_incfile=10040_W_No se pudo recompilar la unida $1, pero se encontraron ficheros de inclusió modificados +% A unit was found to have modified include files, but +% some source files were not found, so recompilation is impossible. +unit_h_source_modified=10041_H_El fichero $1 es mas moderno que la versión Release del archivo PPU $2 +% A modified source file for a unit was found that was compiled with the +% release flag (-Ur). The unit will not implicitly be recompiled because +% this release flag is set. +unit_u_ppu_invalid_fpumode=10042_U_Se esta utilizando una unidad que no fue compilada con el modo de FPU correcto +% Trying to compile code while using units which were not compiled with +% the same floating point format mode. Either all code should be compiled +% with FPU emulation on, or with FPU emulation off. +unit_u_loading_interface_units=10043_U_Cargando unidades de interfaz de $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the units defined in the interface part of the unit. +unit_u_loading_implementation_units=10044_U_Cargando unidades de implementación de $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the units defined in the implementation part of the unit. +unit_u_interface_crc_changed=10045_U_CRC de la interfaz de la unidad $1 cambiado +% When you use the \var{-vu} flag, the compiler warns that it the +% CRC calculated for the interface has been changed after the implementation +% has been parsed. +unit_u_implementation_crc_changed=10046_U_CRC de la implementacion de la unidad $1 cambiado +% When you use the \var{-vu} flag, the compiler warns that it the +% CRC calculated has been changed after the implementation +% has been parsed. +unit_u_finished_compiling=10047_U_Finalizando compilado de la unidad $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has finished compiling the unit. +unit_u_add_depend_to=10048_U_Añadida dependencia de $1 a $2 +% When you use the \var{-vu} flag, the compiler warns that it +% has added a dependency between the two units. +unit_u_no_reload_is_caller=10049_U_No hay recarga, es llamada de: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has will not reload the unit because it is the unit that wants +% to load this unit +unit_u_no_reload_in_second_compile=10050_U_No hay recarga, ya se esta en la segunda compilación de: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has will not reload the unit because it is already in a second recompile +unit_u_flag_for_reload=10051_U_Marcado para recarga: $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to reload the unit +unit_u_forced_reload=10052_U_Recarga forzada +% When you use the \var{-vu} flag, the compiler warns that it +% has is reloading the unit because it was required +unit_u_previous_state=10053_U_Estado anterior de $1: $2 +% When you use the \var{-vu} flag, the compiler shows the +% previous state of the unit +unit_u_second_compile_unit=10054_U_Ya se está compilando $1, estableciendo segunda compilación +% When you use the \var{-vu} flag, the compiler warns that it starts +% recompiling a unit for the second time. This can happend with interdepend +% units. +unit_u_loading_unit=10055_U_Cargando unidad $1 +% When you use the \var{-vu} flag, the compiler warns that it starts +% loading the unit. +unit_u_finished_loading_unit=10056_U_Carga de la unidad $1 completada +% When you use the \var{-vu} flag, the compiler warns that it finished +% loading the unit. +unit_u_registering_new_unit=10057_U_Registrando nueva unidad $1 +% When you use the \var{-vu} flag, the compiler warns that it has +% found a new unit and registers it in the internal lists. +unit_u_reresolving_unit=10058_U_Re-resolviendo unidad $1 +% When you use the \var{-vu} flag, the compiler warns that it +% has to recalculate the internal data of the unit +unit_u_skipping_reresolving_unit=10059_U_Saltando re-resolución de $1, aún se estan cargando las unidades utilizadas +% When you use the \var{-vu} flag, the compiler warns that it +% skips to recalculate the internal data of the unit because there +% is no data to recalculate +% \end{description} +# EndOfTeX + +# +# Options +# +# 11039 is the last used one +# +option_usage=11000_O_$1 [opciones] <fichero_entrada> [opciones] +# BeginOfTeX +% +% \section{Command-line handling errors} +% This section lists errors that occur when the compiler is processing the +% command line or handling the configuration files. +% \begin{description} +option_only_one_source_support=11001_W_Solo es soportado un fichero fuente +% You can specify only one source file on the command line. The first +% one will be compiled, others will be ignored. This may indicate that +% you forgot a \var{'-'} sign. +option_def_only_for_os2=11002_W_Fichero DEF solo puede ser creado para OS/2 +% This option can only be specified when you're compiling for OS/2 +option_no_nested_response_file=11003_E_Ficheros de respuesta anidados no son soportados +% you cannot nest response files with the \var{@file} command-line option. +option_no_source_found=11004_F_No hay fichero fuente en la línea de comandos +% The compiler expects a source file name on the command line. +option_no_option_found=11005_N_No hay opciones en el archivo de configuración $1 +% The compiler didn't find any option in that config file. +option_illegal_para=11006_E_Parámetro incorrecto: $1 +% You specified an unknown option. +option_help_pages_para=11007_H_-? escribe las páginas de ayuda +% When an unknown option is given, this message is diplayed. +option_too_many_cfg_files=11008_F_Demasiados ficheros de configuración anidados +% You can only nest up to 16 config files. +option_unable_open_file=11009_F_Imposible abrir fichero $1 +% The option file cannot be found. +option_reading_further_from=11010_D_Leyendo opciones adicionales de $1 +% Displayed when you have notes turned on, and the compiler switches +% to another options file. +option_target_is_already_set=11011_W_Destino está ya puesto a: $1 +% Displayed if more than one \var{-T} option is specified. +option_no_shared_lib_under_dos=11012_W_Librerías compartidas no soportadas en la plataforma DOS, regresando a estáticas +% If you specify \var{-CD} for the \dos platform, this message is displayed. +% The compiler supports only static libraries under \dos +option_too_many_ifdef=11013_F_demasiados IF(N)DEFs +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_many_endif=11014_F_demasiados ENDIFs +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_too_less_endif=11015_F_condicional abierto al final del fichero +% the \var{\#IF(N)DEF} statements in the options file are not balanced with +% the \var{\#ENDIF} statements. +option_no_debug_support=11016_W_La generación de información de depuración no es soportada por este ejecutable +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_no_debug_support_recompile_fpc=11017_H_Prueba recompilando con -dGDB +% It is possible to have a compiler executable that doesn't support +% the generation of debugging info. If you use such an executable with the +% \var{-g} switch, this warning will be displayed. +option_obsolete_switch=11018_E_Estas usando el conmutador obsoleto $1 +% this warns you when you use a switch that is not needed/supported anymore. +% It is recommended that you remove the switch to overcome problems in the +% future, when the switch meaning may change. +option_obsolete_switch_use_new=11019_E_Estás usando el conmutador obsoleto $1, porfavor usa $2 +% this warns you when you use a switch that is not supported anymore. You +% must now use the second switch instead. +% It is recommended that you change the switch to overcome problems in the +% future, when the switch meaning may change. +option_switch_bin_to_src_assembler=11020_N_Cambiando a ensamblador de escritura de código fuente por defecto +% this notifies you that the assembler has been changed because you used the +% -a switch which can't be used with a binary assembler writer. +option_incompatible_asm=11021_W_La salida de ensamblador "$1" no es compatible con "$2" +option_asm_forced=11022_W_Forzado el uso de ensamblador "$1" +% The assembler output selected can not generate +% object files with the correct format. Therefore, the +% default assembler for this target is used instead. +option_using_file=11026_T_Leyendo opciones del fichero $1 +% Options are also read from this file +option_using_env=11027_T_Leyendo opciones del entorno $1 +% Options are also read from this environment string +option_handling_option=11028_D_Procesando pción "$1" +% Debug info that an option is found and will be handled +option_help_press_enter=11029__*** presione retorno *** +option_start_reading_configfile=11030_H_Inicio de lectura del archivo de configuración $1 +% Starting of config file parsing. +option_end_reading_configfile=11031_H_Fin de lectura del archivo de configuración $1 +% End of config file parsing. +option_interpreting_option=11032_D_Interpretando opción "$1" +option_interpreting_firstpass_option=11036_D_Interpretando primera pasada de la opción "$1" +option_interpreting_file_option=11033_D_Interpretando opción de archivo "$1" +option_read_config_file=11034_D_Leyendo archivo de configuración "$1" +option_found_file=11035_D_encontrado nombre del archivo fuente "$1" +% Additional infos about options, displayed +% when you have debug option turned on. +option_code_page_not_available=11039_E_Código de página desconocido +%\end{description} +# EndOfTeX + +# +# Logo (option -l) +# +option_logo=11023_[ +Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPCCPU +Copyright (c) 1993-2011 by Florian Klaempfl +] + +# +# Info (option -i) +# +option_info=11024_[ +Free Pascal Compiler versión $FPCVERSION + +Fecha del Compilador : $FPCDATE +CPU de destino : $FPCCPU + +Plataformas soportadas: + $OSTARGETS + +Sets de instrucciones de la CPU soportados: + $INSTRUCTIONSETS + +Sets de instrucciones de la FPU soportados: + $FPUINSTRUCTIONSETS + +Este programa esta bajo la licencia GNU General Public Licence +Para mas informació lea COPYING.FPC + +Para informar de errores, sugerencias, etc: + http://bugs.freepascal.org +o + bugs@freepascal.org +] + +# +# Help pages (option -? and -h) +# +# The first character on the line indicates who will display this +# line, the current possibilities are : +# * = every target +# 3 = 80x86 targets +# 6 = 680x0 targets +# e = in extended debug mode only +# P = PowerPC targets +# S = Sparc targets +# V = Virtual machine targets +# The second character also indicates who will display this line, +# (if the above character was TRUE) the current possibilities are : +# * = everyone +# g = with GDB info supported by the compiler +# O = OS/2 +# L = UNIX systems +# The third character represents the indentation level. +# +option_help_pages=11025_[ +**0*_ponga + tras un conmutador booleano para activarlo, - para desactivarlo +**1a_el compilador no borra los ficheros de ensamblador generados +**2al_incluir los números de línea del codigo fuente en el archivo ensamblador +**2an_incluir la informacion de nodos en el archivo ensamblador generado +*L2ap_usar tuberías (pipes) en lugar de crear archivos de ensamblado temporales +**2ar_incluir reserva y liberació de registros en el archivo ensamblador +**2at_incluir informacion de reserva y liberación temporales en el archivo ensamblador +**1A<x>_formato de salida: +**2Adefault_usar ensamblador por defecto +3*2Aas_ensamblar usando GNU AS +3*2Anasmcoff_coff (Go32v2) usando Nasm +3*2Anasmelf_elf32 (Linux) usando Nasm +3*2Anasmwin32_objeto Win32 usando Nasm +3*2Anasmwdosx_objeto Win32/WDOSX usando Nasm +3*2Awasm_fichero obj usando Wasm (Watcom) +3*2Anasmobj_fichero obj usando Nasm +3*2Amasm_fichero obj usando Masm (Microsoft) +3*2Atasm_fichero obj usando Tasm (Borland) +3*2Aelf_elf32 (Linux) usando escritor interno +3*2Acoff_coff (Go32v2) usando escritor interno +3*2Apecoff_pecoff (Win32) usando escritor interno +4*2Aas_ensamblar usando GNU AS +6*2Aas_archivo o de Unix usando GNU AS +6*2Agas_ensamblador GNU Motorola +6*2Amit_Sintaxis MIT (GAS antiguo) +6*2Amot_Ensamblador Motorola estándar +A*2Aas_ensamblar usando GNU AS +P*2Aas_ensamblar usando GNU AS +S*2Aas_ensamblar usando GNU AS +**1b_generar informacion de navegado +**2bl_generar informació de símbolos locales +**1B_construir(build) todos los modulos +**1C<x>_opciones de generado de código: +**2Cc<x>_cambiar la convencion de llamada por defecto a <x> +**2CD_crear adicionalmente una librería dinámica (no soportado) +**2Ce_Compilar con opcodes de punto flotante emulados +**2Cf<x>_Cambiar el set de instrucciones de la FPU usado, fpc -i para posibles valores<x> +**2Cg_Generar código PIC +**2Ch<n>_<n> bytes heap (entre 1023 y 67107840) +**2Ci_Comprobación de E/S +**2Cn_omitir etapa de enlazado +**2Co_comprobar desbordamiento en operaciones de enteros +**2Cp<x>_Cambiar el set de instrucciones usado, fpc -i para posibles valores +**2Cr_comprobación de rango +**2CR_verificar validez de objetos de llamada +**2Cs<n>_definir el tamaño de la pila a <n> +**2Ct_comprobación de pila +**2CX_crear adicionalmente una librerí con enlazado inteligente +**1d<x>_define el símbol <x> +**1D_generar fichero DEF +**2Dd<x>_establece la descripción a <x> +**2Dv<x>_establece la version de la DLL a <x> +*O2Dw_Aplicación PM +**1e<x>_establecer ruta al ejecutable +**1E_igual que -Cn +**1F<x>_establecer ficheros y rutas: +**2Fa<x>[,y]_para hacer que el programa cargue las unidades <x> e [y] antes de procesar su uses +**2Fc<x>_establece el código de pagina de la entrada a <x> +**2FD<x>_establece la ruta donde buscar las utilidades del compilador +**2Fe<x>_redirige la salida de errores a <x> +**2FE<x>_establece la ruta de destino de exe/unidades a <x> +**2Fi<x>_añade <x> a las rutas de inclusión +**2Fl<x>_añade <x> a las rutas de librerías +**2FL<x>_usa <x> como enlazador dinámico +**2Fo<x>_añade <x> a las rutas de objetos +**2Fr<x>_load error message file <x> +**2Fu<x>_adds <x> a las rutas de unidades +**2FU<x>_establece la ruta de salida de unidades a <x>, reemplaza -FE anteriores +*g1g_generar información de depurado: +*g2gc_generar comprobación de punteros +*g2gd_usar dbx +*g2gg_usar gsym +*g2gh_usar unidad de trazado de memoria (para depurar pérdidas de memoria) +*g2gl_usar informacion de líneas de las unidades para la traza de ejecución (backtrace) +*g2gv_genera programas trazables con valgrind +*g2gw_generar información de depurado dwarf +**1i_información +**2iD_devuelve la fecha del compilador +**2iV_devuelve la versión del compilador +**2iSO_devuelve el SO del compilador +**2iSP_devuelve el procesador del compilador +**2iTO_devuelve el SO de destino +**2iTP_devuelve el procesador de destino +**1I<x>_añade <x> a las rutas de iclusión +**1k<x>_Pasar <x> al enlazador +**1l_mostrar logo +**1M<x>_establecer modo del lenguaje a <x> +**2Mfpc_dialecto de free pascal(default) +**2Mobjfpc_activar algunas extensiones de Delphi 2 +**2Mdelphi_tratar de ser compatible con Delphi +**2Mtp_tratar de ser compatible con TP/BP 7.0 +**2Mgpc_tratar de ser compatible con gpc +**2Mmacpas_tratar de ser compatible con dialectos de macintosh pascal +**1n_no leer la configuración por defecto +**1o<x>_cambiar el nombre del ejecutable producido a <x> +**1O<x>_optimizaciones: +3*2Og_generar código más pequeño +3*2OG_generar código más rápido (defecto) +**2Or_mantener algunas variables en registros +3*2Ou_activar optimizaciones inseguras (ver docs) +3*2O1_optimizaciones nivel 1 (optimizaciones rápidas) +3*2O2_optimizaciones nivel 2 (-O1 + optimizaciones más lentas) +3*2O3_optimizaciones nivel 3 (-O2 repetidamente, max 5 veces) +3*2Op<x>_procesador de destino: +3*3Op1_establecer procesador de destino a 386/486 +3*3Op2_establecer procesador de destino a Pentium/PentiumMMX (tm) +3*3Op3_establecer procesador de destino a PPro/PII/c6x86/K6 (tm) +6*2Og_generar código más pequeño +6*2OG_generatr código más rápido (defecto) +6*2Ox_optimizar al máximo (AUN CON ERRORES!!!) +6*2O0_establecer procesador de destino a MC68000 +6*2O2_establecer procesador de destino a MC68020+ (defecto) +**1pg_generar código de perfilado gprof (define FPC_PROFILE) +**1R<x>_estilo de lectura de ensamblador: +**2Rdefault_usar ensamblador por defecto +3*2Ratt_leer ensamblador estilo AT&T +3*2Rintel_leer ensamblador estilo Intel +6*2RMOT_leer ensamblador estilo motorola +**1S<x>_opciones de sintaxis: +**2S2_igual que -Mobjfpc +**2Sc_soportar operadores estilo C (*=,+=,/= and -=) +**2Sa_incluir código de aserción. +**2Sd_igual que -Mdelphi +**2Se<x>_opciones de error. <x> es una combinación de los siguientes: +**3*_<n> : detener el compilador tras <n> errores (por defecto 1) +**3*_w : detener también tras avisos +**3*_n : detener también tras notas +**3*_h : detener también tras consejos +**2Sg_permitir LABEL y GOTO +**2Sh_Usar cadenas largas (ansistrings) +**2Si_soportar INLINE estilo C++ +**2SI<x>_establecer estilo de interfaz a <x> +**3SIcom_interfaces compatibles COM (defecto) +**3SIcorba_interfaces compatibles CORBA +**2Sm_soportar macros tipo C (global) +**2So_igual que -Mtp +**2Sp_igual que -Mgpc +**2Ss_el nombre del constructor debe ser init (el destructor debe ser done) +**1s_no llamar al ensamblador ni enlazador +**2sh_Generar script para enlazar en host +**2st_Generar script para enlazar en destino +**2sr_Saltar fase de reserva de registros (usar con -alr) +**1T<x>_Sistema operativo de destino: +3*2Temx_OS/2 usando EMX (incluyendo extensor EMX/RSX) +3*2Tfreebsd_FreeBSD +3*2Tgo32v2_Version 2 de DJ Delorie DOS extender +3*2Tlinux_Linux +3*2Tnetbsd_NetBSD +3*2Tnetware_Novell Netware Module (clib) +3*2Tnetwlibc_Novell Netware Module (libc) +3*2Topenbsd_OpenBSD +3*2Tos2_OS/2 / eComStation +3*2Tsunos_SunOS/Solaris +3*2Twatcom_extensor DOS compatible Watcom +3*2Twdosx_extensor WDOSX DOS +3*2Twin32_Windows 32 Bit +4*2Tlinux_Linux +6*2Tamiga_Commodore Amiga +6*2Tatari_Atari ST/STe/TT +6*2Tlinux_Linux-68k +6*2Tmacos_Macintosh m68k (no soportado) +6*2Tpalmos_PalmOS +A*2Tlinux_Linux +P*2Tdarwin_Darwin y MacOS X en PowerPC +P*2Tlinux_Linux en PowerPC +P*2Tmacos_MacOS (clásico) en PowerPC +P*2Tmorphos_MorphOS +S*2Tlinux_Linux +**1u<x>_elimina la definición del símbolo <x> +**1U_opciones de unidad: +**2Un_no comprobar el nombre de la unidad +**2Ur_generar unidades para distribución (release) +**2Us_compilar la unidad System +**1v<x>_Mostrar detalles. <x> es una combinación de las siguientes letras: +**2*_e : Mostrar errores (defecto) 0 : No mostrar nada (excepto errores) +**2*_w : Mostrar avisos u : Mostrar info. de la unidad +**2*_n : Mostrar notas t : Mostrar archivos usados / intentados +**2*_h : Mostrar consejos c : Mostrar condicionales +**2*_i : Mostrar info. general d : Mostrar info. de depurado +**2*_l : Mostrar num de lineas r : Modo compatible con Rhide/GCC +**2*_a : Mostrar todo x : Info. del ejecutable (Win32 solo) +**2*_v : escribe fpcdebug.txt con p : Escribir el árbol de parser en tree.log +**2*_ mucha informacón de depurado +3*1W<x>_opciones de Win32 o similares +3*2WB<x>_Establece la dirección hex de base a <x> +3*2WC_Especifica que la aplicación es de consola +3*2WD_Usa DEFFILE para exportar funciones de la DLL o EXE +3*2WF_Especifica aplicación de pantalla completa (OS/2 sólo) +3*2WG_Especifica que la aplicación es para entorno gráfico +3*2WN_No generar código de reubicación (necesario para depurar) +3*2WR_Generar código de reubicación +P*2WC_Especifica aplicación de colnsola (MacOS sólo) +P*2WG_Especifica aplicación gráfica (MacOS sólo) +P*2WT_Especifica aplicación de tipo herramienta (herramienta MPW, MacOS sólo) +**1X_opciones de ejecutable: +**2Xc_pasar --shared al enlazador (Unix sólo) +**2Xd_no utilizar la ruta de librería por defecto (necesario para compilación cruzada) +**2XD_tratar de enlazar dinámicamente (define FPC_LINK_DYNAMIC) +**2XP<x>_pone <x> delante de los nombres de binutils +**2Xr<x>_establece la ruta de librerías a <x> (necesario para compilación cruzada) +**2Xs_eliminar todos los símbolos del ejecutable +**2XS_tratar de enlazar estáticamente (defecto) (define FPC_LINK_STATIC) +**2Xt_enlazar con librerias estáticas (-static es pasado al enlazador) +**2XX_tratar de enlazar inteligentemente (define FPC_LINK_SMART) +**1*_ +**1?_muestra esta ayuda +**1h_muestra esta ayuda sin esperas +] + +# +# The End... diff --git a/closures/compiler/msgidx.inc b/closures/compiler/msgidx.inc new file mode 100644 index 0000000000..f83c84d146 --- /dev/null +++ b/closures/compiler/msgidx.inc @@ -0,0 +1,926 @@ +const + general_t_compilername=01000; + general_d_sourceos=01001; + general_i_targetos=01002; + general_t_exepath=01003; + general_t_unitpath=01004; + general_t_includepath=01005; + general_t_librarypath=01006; + general_t_objectpath=01007; + general_i_abslines_compiled=01008; + general_f_no_memory_left=01009; + general_i_writingresourcefile=01010; + general_e_errorwritingresourcefile=01011; + general_i_fatal=01012; + general_i_error=01013; + general_i_warning=01014; + general_i_note=01015; + general_i_hint=01016; + general_e_path_does_not_exist=01017; + general_f_compilation_aborted=01018; + general_text_bytes_code=01019; + general_text_bytes_data=01020; + general_i_number_of_warnings=01021; + general_i_number_of_hints=01022; + general_i_number_of_notes=01023; + general_f_ioerror=01024; + general_f_oserror=01025; + scan_f_end_of_file=02000; + scan_f_string_exceeds_line=02001; + scan_f_illegal_char=02002; + scan_f_syn_expected=02003; + scan_t_start_include_file=02004; + scan_w_comment_level=02005; + scan_n_ignored_switch=02008; + scan_w_illegal_switch=02009; + scan_w_switch_is_global=02010; + scan_e_illegal_char_const=02011; + scan_f_cannot_open_input=02012; + scan_f_cannot_open_includefile=02013; + scan_e_illegal_pack_records=02015; + scan_e_illegal_pack_enum=02016; + scan_e_endif_expected=02017; + scan_e_preproc_syntax_error=02018; + scan_e_error_in_preproc_expr=02019; + scan_w_macro_cut_after_255_chars=02020; + scan_e_endif_without_if=02021; + scan_f_user_defined=02022; + scan_e_user_defined=02023; + scan_w_user_defined=02024; + scan_n_user_defined=02025; + scan_h_user_defined=02026; + scan_i_user_defined=02027; + scan_e_keyword_cant_be_a_macro=02028; + scan_f_macro_buffer_overflow=02029; + scan_w_macro_too_deep=02030; + scan_w_wrong_styled_switch=02031; + scan_d_handling_switch=02032; + scan_c_endif_found=02033; + scan_c_ifdef_found=02034; + scan_c_ifopt_found=02035; + scan_c_if_found=02036; + scan_c_ifndef_found=02037; + scan_c_else_found=02038; + scan_c_skipping_until=02039; + scan_i_press_enter=02040; + scan_w_unsupported_switch=02041; + scan_w_illegal_directive=02042; + scan_t_back_in=02043; + scan_w_unsupported_app_type=02044; + scan_w_app_type_not_support=02045; + scan_w_description_not_support=02046; + scan_n_version_not_support=02047; + scan_n_only_exe_version=02048; + scan_w_wrong_version_ignored=02049; + scan_e_illegal_asmmode_specifier=02050; + scan_w_no_asm_reader_switch_inside_asm=02051; + scan_e_wrong_switch_toggle=02052; + scan_e_resourcefiles_not_supported=02053; + scan_w_include_env_not_found=02054; + scan_e_invalid_maxfpureg_value=02055; + scan_w_only_one_resourcefile_supported=02056; + scan_w_macro_support_turned_off=02057; + scan_e_invalid_interface_type=02058; + scan_w_appid_not_support=02059; + scan_w_appname_not_support=02060; + scan_e_string_exceeds_255_chars=02061; + scan_f_include_deep_ten=02062; + scan_e_too_many_push=02063; + scan_e_too_many_pop=02064; + scan_e_error_macro_lacks_value=02065; + scan_e_wrong_switch_toggle_default=02066; + scan_e_mode_switch_not_allowed=02067; + scan_e_error_macro_undefined=02068; + scan_e_utf8_bigger_than_65535=02069; + scan_e_utf8_malformed=02070; + scan_c_switching_to_utf8=02071; + scan_e_compile_time_typeerror=02072; + scan_n_app_type_not_support=02073; + scan_e_illegal_optimization_specifier=02074; + scan_w_setpeflags_not_support=02075; + scan_w_imagebase_not_support=02076; + scan_w_minstacksize_not_support=02077; + scan_w_maxstacksize_not_support=02078; + scanner_e_illegal_warn_state=02079; + scan_e_only_packset=02080; + scan_w_pic_ignored=02081; + scan_w_unsupported_switch_by_target=02082; + scan_w_frameworks_darwin_only=02084; + scan_e_illegal_minfpconstprec=02085; + scan_w_multiple_main_name_overrides=02086; + scanner_w_illegal_warn_identifier=02087; + scanner_e_illegal_alignment_directive=02088; + parser_e_syntax_error=03000; + parser_e_dont_nest_interrupt=03004; + parser_w_proc_directive_ignored=03005; + parser_e_no_overload_for_all_procs=03006; + parser_e_export_name_double=03008; + parser_e_export_ordinal_double=03009; + parser_e_export_invalid_index=03010; + parser_w_parser_reloc_no_debug=03011; + parser_w_parser_win32_debug_needs_WN=03012; + parser_e_constructorname_must_be_init=03013; + parser_e_destructorname_must_be_done=03014; + parser_e_proc_inline_not_supported=03016; + parser_w_constructor_should_be_public=03018; + parser_w_destructor_should_be_public=03019; + parser_n_only_one_destructor=03020; + parser_e_no_local_objects=03021; + parser_f_no_anonym_objects=03022; + parser_n_object_has_no_vmt=03023; + parser_e_illegal_parameter_list=03024; + parser_e_wrong_parameter_size=03026; + parser_e_overloaded_no_procedure=03027; + parser_e_overloaded_have_same_parameters=03028; + parser_e_header_dont_match_forward=03029; + parser_e_header_different_var_names=03030; + parser_n_duplicate_enum=03031; + parser_e_no_with_for_variable_in_other_segments=03033; + parser_e_too_much_lexlevel=03034; + parser_e_range_check_error=03035; + parser_w_range_check_error=03036; + parser_e_double_caselabel=03037; + parser_e_case_lower_less_than_upper_bound=03038; + parser_e_type_const_not_possible=03039; + parser_e_no_overloaded_procvars=03040; + parser_e_invalid_string_size=03041; + parser_w_use_extended_syntax_for_objects=03042; + parser_w_no_new_dispose_on_void_pointers=03043; + parser_e_no_new_dispose_on_void_pointers=03044; + parser_e_class_id_expected=03045; + parser_e_no_type_not_allowed_here=03046; + parser_e_methode_id_expected=03047; + parser_e_header_dont_match_any_member=03048; + parser_d_procedure_start=03049; + parser_e_error_in_real=03050; + parser_e_fail_only_in_constructor=03051; + parser_e_no_paras_for_destructor=03052; + parser_e_only_class_members_via_class_ref=03053; + parser_e_only_class_members=03054; + parser_e_case_mismatch=03055; + parser_e_illegal_symbol_exported=03056; + parser_w_should_use_override=03057; + parser_e_nothing_to_be_overridden=03058; + parser_e_no_procedure_to_access_property=03059; + parser_w_stored_not_implemented=03060; + parser_e_ill_property_access_sym=03061; + parser_e_cant_access_protected_member=03062; + parser_e_cant_access_private_member=03063; + parser_e_overridden_methods_not_same_ret=03066; + parser_e_dont_nest_export=03067; + parser_e_methods_dont_be_export=03068; + parser_e_call_by_ref_without_typeconv=03069; + parser_e_no_super_class=03070; + parser_e_self_not_in_method=03071; + parser_e_generic_methods_only_in_methods=03072; + parser_e_illegal_colon_qualifier=03073; + parser_e_illegal_set_expr=03074; + parser_e_pointer_to_class_expected=03075; + parser_e_expr_have_to_be_constructor_call=03076; + parser_e_expr_have_to_be_destructor_call=03077; + parser_e_invalid_record_const=03078; + parser_e_false_with_expr=03079; + parser_e_void_function=03080; + parser_e_only_methods_allowed=03081; + parser_e_operator_not_overloaded=03082; + parser_e_no_such_assignment=03083; + parser_e_overload_impossible=03084; + parser_e_no_reraise_possible=03085; + parser_e_no_new_or_dispose_for_classes=03086; + parser_e_procedure_overloading_is_off=03088; + parser_e_overload_operator_failed=03089; + parser_e_comparative_operator_return_boolean=03090; + parser_e_only_virtual_methods_abstract=03091; + parser_f_unsupported_feature=03092; + parser_e_mix_of_classes_and_objects=03093; + parser_w_unknown_proc_directive_ignored=03094; + parser_e_absolute_only_one_var=03095; + parser_e_absolute_only_to_var_or_const=03096; + parser_e_initialized_only_one_var=03097; + parser_e_abstract_no_definition=03098; + parser_e_overloaded_must_be_all_global=03099; + parser_w_virtual_without_constructor=03100; + parser_c_macro_defined=03101; + parser_c_macro_undefined=03102; + parser_c_macro_set_to=03103; + parser_i_compiling=03104; + parser_u_parsing_interface=03105; + parser_u_parsing_implementation=03106; + parser_d_compiling_second_time=03107; + parser_e_no_property_found_to_override=03109; + parser_e_only_one_default_property=03110; + parser_e_property_need_paras=03111; + parser_e_constructor_cannot_be_not_virtual=03112; + parser_e_no_default_property_available=03113; + parser_e_cant_have_published=03114; + parser_e_forward_declaration_must_be_resolved=03115; + parser_e_no_local_operator=03116; + parser_e_proc_dir_not_allowed_in_interface=03117; + parser_e_proc_dir_not_allowed_in_implementation=03118; + parser_e_proc_dir_not_allowed_in_procvar=03119; + parser_e_function_already_declared_public_forward=03120; + parser_e_not_external_and_export=03121; + parser_w_not_supported_for_inline=03123; + parser_w_inlining_disabled=03124; + parser_i_writing_browser_log=03125; + parser_h_maybe_deref_caret_missing=03126; + parser_f_assembler_reader_not_supported=03127; + parser_e_proc_dir_conflict=03128; + parser_e_call_convention_dont_match_forward=03129; + parser_e_property_cant_have_a_default_value=03131; + parser_e_property_default_value_must_const=03132; + parser_e_cant_publish_that=03133; + parser_e_cant_publish_that_property=03134; + parser_e_empty_import_name=03136; + parser_e_division_by_zero=03138; + parser_e_invalid_float_operation=03139; + parser_e_array_lower_less_than_upper_bound=03140; + parser_w_string_too_long=03141; + parser_e_string_larger_array=03142; + parser_e_ill_msg_expr=03143; + parser_e_ill_msg_param=03144; + parser_e_duplicate_message_label=03145; + parser_e_self_in_non_message_handler=03146; + parser_e_threadvars_only_sg=03147; + parser_f_direct_assembler_not_allowed=03148; + parser_w_no_objpas_use_mode=03149; + parser_e_no_object_override=03150; + parser_e_cant_use_inittable_here=03151; + parser_e_resourcestring_only_sg=03152; + parser_e_exit_with_argument_not__possible=03153; + parser_e_stored_property_must_be_boolean=03154; + parser_e_ill_property_storage_sym=03155; + parser_e_only_publishable_classes_can_be_published=03156; + parser_e_proc_directive_expected=03157; + parser_e_invalid_property_index_value=03158; + parser_e_procname_to_short_for_export=03159; + parser_e_dlltool_unit_var_problem=03160; + parser_e_dlltool_unit_var_problem2=03161; + parser_f_need_objfpc_or_delphi_mode=03162; + parser_e_no_export_with_index_for_target=03163; + parser_e_no_export_of_variables_for_target=03164; + parser_e_improper_guid_syntax=03165; + parser_w_interface_mapping_notfound=03168; + parser_e_interface_id_expected=03169; + parser_e_type_cant_be_used_in_array_index=03170; + parser_e_no_con_des_in_interfaces=03171; + parser_e_no_access_specifier_in_interfaces=03172; + parser_e_no_vars_in_interfaces=03173; + parser_e_no_local_proc_external=03174; + parser_w_skipped_fields_before=03175; + parser_e_skipped_fields_before=03176; + parser_w_skipped_fields_after=03177; + parser_e_varargs_need_cdecl_and_external=03178; + parser_e_self_call_by_value=03179; + parser_e_interface_has_no_guid=03180; + parser_e_illegal_field_or_method=03181; + parser_w_proc_overriding_calling=03182; + parser_e_no_procvarobj_const=03183; + parser_e_default_value_only_one_para=03184; + parser_e_default_value_expected_for_para=03185; + parser_w_unsupported_feature=03186; + parser_h_c_arrays_are_references=03187; + parser_e_C_array_of_const_must_be_last=03188; + parser_h_type_redef=03189; + parser_w_cdecl_has_no_high=03190; + parser_w_cdecl_no_openstring=03191; + parser_e_initialized_not_for_threadvar=03192; + parser_e_msg_only_for_classes=03193; + parser_e_procedure_or_function_expected=03194; + parser_e_illegal_calling_convention=03195; + parser_e_no_object_reintroduce=03196; + parser_e_paraloc_only_one_para=03197; + parser_e_paraloc_all_paras=03198; + parser_e_illegal_explicit_paraloc=03199; + parser_e_32bitint_or_pointer_variable_expected=03200; + parser_e_goto_outside_proc=03201; + parser_f_too_complex_proc=03202; + parser_e_illegal_expression=03203; + parser_e_invalid_integer=03204; + parser_e_invalid_qualifier=03205; + parser_e_upper_lower_than_lower=03206; + parser_e_macpas_exit_wrong_param=03207; + parser_e_illegal_assignment_to_count_var=03208; + parser_e_no_local_var_external=03209; + parser_e_proc_already_external=03210; + parser_w_implicit_uses_of_variants_unit=03211; + parser_e_no_static_method_in_interfaces=03212; + parser_e_arithmetic_operation_overflow=03213; + parser_e_protected_or_private_expected=03214; + parser_e_illegal_slice=03215; + parser_e_dispinterface_cant_have_parent=03216; + parser_e_dispinterface_needs_a_guid=03217; + parser_w_overridden_methods_not_same_ret=03218; + parser_e_dispid_must_be_ord_const=03219; + parser_e_array_range_out_of_bounds=03220; + parser_e_packed_element_no_var_addr=03221; + parser_e_packed_dynamic_open_array=03222; + parser_e_packed_element_no_loop=03223; + parser_e_type_var_const_only_in_records_and_classes=03224; + parser_e_cant_create_generics_of_this_type=03225; + parser_w_no_lineinfo_use_switch=03226; + parser_e_no_funcret_specified=03227; + parser_e_special_onlygenerics=03228; + parser_e_no_generics_as_params=03229; + parser_e_type_object_constants=03230; + parser_e_label_outside_proc=03231; + parser_e_initialized_not_for_external=03233; + parser_e_illegal_function_result=03234; + parser_e_no_common_type=03235; + parser_e_no_generics_as_types=03236; + parser_w_register_list_ignored=03237; + parser_e_implements_must_be_class_or_interface=03238; + parser_e_implements_must_have_correct_type=03239; + parser_e_implements_must_read_specifier=03240; + parser_e_implements_must_not_have_write_specifier=03241; + parser_e_implements_must_not_have_stored_specifier=03242; + parser_e_implements_uses_non_implemented_interface=03243; + parser_e_unsupported_real=03244; + parser_e_class_doesnt_implement_interface=03245; + parser_e_class_implements_must_be_interface=03246; + parser_e_cant_export_var_different_name=03247; + parser_e_weak_external_not_supported=03248; + parser_e_forward_mismatch=03249; + parser_n_ignore_lower_visibility=03250; + parser_e_field_not_allowed_here=03251; + parser_e_no_local_para_def=03252; + parser_e_abstract_and_sealed_conflict=03253; + parser_e_sealed_descendant=03254; + parser_e_sealed_class_cannot_have_abstract_methods=03255; + parser_e_only_virtual_methods_final=03256; + parser_e_final_can_no_be_overridden=03257; + parser_e_multiple_messages=03258; + parser_e_invalid_enumerator_identifier=03259; + parser_e_enumerator_identifier_required=03260; + parser_e_enumerator_movenext_is_not_valid=03261; + parser_e_enumerator_current_is_not_valid=03262; + parser_e_only_one_enumerator_movenext=03263; + parser_e_only_one_enumerator_current=03264; + parser_e_for_in_loop_cannot_be_used_for_the_type=03265; + parser_e_objc_requires_msgstr=03266; + parser_e_objc_no_constructor_destructor=03267; + parser_e_message_string_too_long=03268; + parser_e_objc_message_name_too_long=03269; + parser_h_no_objc_parent=03270; + parser_e_no_objc_published=03271; + parser_f_need_objc=03272; + parser_e_must_use_override_objc=03273; + parser_h_should_use_override_objc=03274; + parser_e_objc_message_name_changed=03275; + parser_e_no_objc_unique=03276; + parser_e_no_category_as_types=03277; + parser_e_no_category_override=03278; + parser_e_must_use_reintroduce_objc=03279; + parser_h_should_use_reintroduce_objc=03280; + parser_e_implements_getter_not_default_cc=03281; + parser_e_no_refcounted_typed_file=03282; + parser_e_operator_not_overloaded_2=03283; + parser_e_operator_not_overloaded_3=03284; + parser_e_more_array_elements_expected=03285; + parser_e_string_const_too_long=03286; + parser_e_invalid_univ_para=03287; + parser_e_only_one_class_constructor_allowed=03288; + parser_e_only_one_class_destructor_allowed=03289; + parser_e_no_paras_for_class_constructor=03290; + parser_e_no_paras_for_class_destructor=03291; + parser_f_modeswitch_objc_required=03292; + parser_e_widestring_to_ansi_compile_time=03293; + parser_e_objc_enumerator_2_0=03294; + parser_e_objc_missing_enumeration_defs=03295; + parser_e_no_procvarnested_const=03296; + parser_f_no_generic_inside_generic=03297; + parser_e_forward_protocol_declaration_must_be_resolved=03298; + parser_e_no_record_published=03299; + parser_e_no_destructor_in_records=03300; + parser_e_class_methods_only_static_in_records=03301; + parser_e_no_constructor_in_records=03302; + parser_e_at_least_one_argument_must_be_of_type=03303; + parser_e_cant_use_type_parameters_here=03304; + parser_e_externals_no_section=03305; + parser_e_section_no_locals=03306; + parser_e_not_allowed_in_helper=03307; + parser_e_no_class_constructor_in_helpers=03308; + parser_e_inherited_not_in_record=03309; + parser_e_no_types_in_local_anonymous_records=03310; + parser_e_duplicate_implements_clause=03311; + parser_e_mapping_no_implements=03312; + parser_e_implements_no_mapping=03313; + parser_e_invalid_codepage=03314; + type_e_mismatch=04000; + type_e_incompatible_types=04001; + type_e_not_equal_types=04002; + type_e_type_id_expected=04003; + type_e_variable_id_expected=04004; + type_e_integer_expr_expected=04005; + type_e_boolean_expr_expected=04006; + type_e_ordinal_expr_expected=04007; + type_e_pointer_type_expected=04008; + type_e_class_type_expected=04009; + type_e_cant_eval_constant_expr=04011; + type_e_set_element_are_not_comp=04012; + type_e_set_operation_unknown=04013; + type_w_convert_real_2_comp=04014; + type_h_use_div_for_int=04015; + type_e_strict_var_string_violation=04016; + type_e_succ_and_pred_enums_with_assign_not_possible=04017; + type_e_cant_read_write_type=04018; + type_e_no_readln_writeln_for_typed_file=04019; + type_e_no_read_write_for_untyped_file=04020; + type_e_typeconflict_in_set=04021; + type_w_maybe_wrong_hi_lo=04022; + type_e_integer_or_real_expr_expected=04023; + type_e_wrong_type_in_array_constructor=04024; + type_e_wrong_parameter_type=04025; + type_e_no_method_and_procedure_not_compatible=04026; + type_e_wrong_math_argument=04027; + type_e_no_addr_of_constant=04028; + type_e_argument_cant_be_assigned=04029; + type_e_cannot_local_proc_to_procvar=04030; + type_e_no_assign_to_addr=04031; + type_e_no_assign_to_const=04032; + type_e_array_required=04033; + type_e_interface_type_expected=04034; + type_h_mixed_signed_unsigned=04035; + type_w_mixed_signed_unsigned2=04036; + type_e_typecast_wrong_size_for_assignment=04037; + type_e_array_index_enums_with_assign_not_possible=04038; + type_e_classes_not_related=04039; + type_w_classes_not_related=04040; + type_e_class_or_interface_type_expected=04041; + type_e_type_is_not_completly_defined=04042; + type_w_string_too_long=04043; + type_w_comparison_always_false=04044; + type_w_comparison_always_true=04045; + type_w_instance_with_abstract=04046; + type_h_in_range_check=04047; + type_w_smaller_possible_range_check=04048; + type_h_smaller_possible_range_check=04049; + type_e_cant_take_address_of_abstract_method=04050; + type_e_assignment_not_allowed=04051; + type_e_constant_expr_expected=04052; + type_e_operator_not_supported_for_types=04053; + type_e_illegal_type_conversion=04054; + type_h_pointer_to_longint_conv_not_portable=04055; + type_w_pointer_to_longint_conv_not_portable=04056; + type_e_cant_choose_overload_function=04057; + type_e_illegal_count_var=04058; + type_w_double_c_varargs=04059; + type_e_class_or_cominterface_type_expected=04060; + type_e_no_const_packed_array=04061; + type_e_got_expected_packed_array=04062; + type_e_got_expected_unpacked_array=04063; + type_e_no_packed_inittable=04064; + type_e_no_const_packed_record=04065; + type_w_untyped_arithmetic_unportable=04066; + type_e_cant_take_address_of_local_subroutine=04076; + type_e_cant_export_local=04077; + type_e_not_automatable=04078; + type_h_convert_add_operands_to_prevent_overflow=04079; + type_h_convert_sub_operands_to_prevent_overflow=04080; + type_h_convert_mul_operands_to_prevent_overflow=04081; + type_w_pointer_to_signed=04082; + type_e_interface_has_no_guid=04083; + type_e_invalid_objc_selector_name=04084; + type_e_expected_objc_method_but_got=04085; + type_e_expected_objc_method=04086; + type_e_no_type_info=04087; + type_e_ordinal_or_string_expr_expected=04088; + type_e_string_expr_expected=04089; + type_w_zero_to_nil=04090; + type_e_protocol_type_expected=04091; + type_e_objc_type_unsupported=04092; + type_e_class_or_objcclass_type_expected=04093; + type_e_objcclass_type_expected=04094; + type_w_procvar_univ_conflicting_para=04095; + type_e_generics_cannot_reference_itself=04096; + type_e_type_parameters_are_not_allowed_here=04097; + type_e_generic_declaration_does_not_match=04098; + type_e_helper_type_expected=04099; + type_e_record_type_expected=04100; + type_e_class_helper_must_extend_subclass=04101; + type_e_record_helper_must_extend_same_record=04102; + type_e_procedures_return_no_value=04103; + type_w_implicit_string_cast=04104; + type_w_implicit_string_cast_loss=04105; + type_w_explicit_string_cast=04106; + type_w_explicit_string_cast_loss=04107; + type_w_unicode_data_loss=04108; + sym_e_id_not_found=05000; + sym_f_internal_error_in_symtablestack=05001; + sym_e_duplicate_id=05002; + sym_h_duplicate_id_where=05003; + sym_e_unknown_id=05004; + sym_e_forward_not_resolved=05005; + sym_e_error_in_type_def=05007; + sym_e_forward_type_not_resolved=05009; + sym_e_only_static_in_static=05010; + sym_f_type_must_be_rec_or_class=05012; + sym_e_no_instance_of_abstract_object=05013; + sym_w_label_not_defined=05014; + sym_e_label_used_and_not_defined=05015; + sym_e_ill_label_decl=05016; + sym_e_goto_and_label_not_supported=05017; + sym_e_label_not_found=05018; + sym_e_id_is_no_label_id=05019; + sym_e_label_already_defined=05020; + sym_e_ill_type_decl_set=05021; + sym_e_class_forward_not_resolved=05022; + sym_n_unit_not_used=05023; + sym_h_para_identifier_not_used=05024; + sym_n_local_identifier_not_used=05025; + sym_h_para_identifier_only_set=05026; + sym_n_local_identifier_only_set=05027; + sym_h_local_symbol_not_used=05028; + sym_n_private_identifier_not_used=05029; + sym_n_private_identifier_only_set=05030; + sym_n_private_method_not_used=05031; + sym_e_set_expected=05032; + sym_w_function_result_not_set=05033; + sym_w_wrong_C_pack=05034; + sym_e_illegal_field=05035; + sym_w_uninitialized_local_variable=05036; + sym_w_uninitialized_variable=05037; + sym_e_id_no_member=05038; + sym_h_param_list=05039; + sym_e_segment_too_large=05040; + sym_e_no_matching_implementation_found=05042; + sym_w_deprecated_symbol=05043; + sym_w_non_portable_symbol=05044; + sym_w_non_implemented_symbol=05055; + sym_e_cant_create_unique_type=05056; + sym_h_uninitialized_local_variable=05057; + sym_h_uninitialized_variable=05058; + sym_w_function_result_uninitialized=05059; + sym_h_function_result_uninitialized=05060; + sym_w_identifier_only_read=05061; + sym_h_abstract_method_list=05062; + sym_w_experimental_symbol=05063; + sym_w_forward_not_resolved=05064; + sym_w_library_symbol=05065; + sym_w_deprecated_symbol_with_msg=05066; + sym_e_no_enumerator=05067; + sym_e_no_enumerator_move=05068; + sym_e_no_enumerator_current=05069; + sym_e_objc_para_mismatch=05070; + sym_n_private_type_not_used=05071; + sym_n_private_const_not_used=05072; + sym_n_private_property_not_used=05073; + sym_w_deprecated_unit=05074; + sym_w_deprecated_unit_with_msg=05075; + sym_w_non_portable_unit=05076; + sym_w_library_unit=05077; + sym_w_non_implemented_unit=05078; + sym_w_experimental_unit=05079; + sym_e_objc_formal_class_not_resolved=05080; + sym_e_interprocgoto_into_init_final_code_not_allowed=05081; + sym_e_external_class_name_mismatch1=05082; + sym_e_external_class_name_mismatch2=05083; + sym_w_library_overload=05084; + cg_e_parasize_too_big=06009; + cg_e_file_must_call_by_reference=06012; + cg_e_cant_use_far_pointer_there=06013; + cg_e_dont_call_exported_direct=06015; + cg_w_member_cd_call_from_method=06016; + cg_n_inefficient_code=06017; + cg_w_unreachable_code=06018; + cg_e_cant_call_abstract_method=06020; + cg_d_register_weight=06027; + cg_d_stackframe_omited=06029; + cg_e_unable_inline_object_methods=06031; + cg_e_unable_inline_procvar=06032; + cg_e_no_code_for_inline_stored=06033; + cg_e_can_access_element_zero=06035; + cg_e_cannot_call_cons_dest_inside_with=06037; + cg_e_cannot_call_message_direct=06038; + cg_e_goto_inout_of_exception_block=06039; + cg_e_control_flow_outside_finally=06040; + cg_w_parasize_too_big=06041; + cg_w_localsize_too_big=06042; + cg_e_localsize_too_big=06043; + cg_e_break_not_allowed=06044; + cg_e_continue_not_allowed=06045; + cg_f_unknown_compilerproc=06046; + cg_f_unknown_system_type=06047; + cg_h_inherited_ignored=06048; + cg_e_goto_label_not_found=06049; + cg_f_unknown_type_in_unit=06050; + cg_e_interprocedural_goto_only_to_outer_scope_allowed=06051; + cg_e_labels_cannot_defined_outside_declaration_scope=06052; + cg_e_goto_across_procedures_with_exceptions_not_allowed=06053; + cg_e_mod_only_defined_for_pos_quotient=06054; + asmr_d_start_reading=07000; + asmr_d_finish_reading=07001; + asmr_e_none_label_contain_at=07002; + asmr_e_building_record_offset=07004; + asmr_e_offset_without_identifier=07005; + asmr_e_type_without_identifier=07006; + asmr_e_no_local_or_para_allowed=07007; + asmr_e_need_offset=07008; + asmr_e_need_dollar=07009; + asmr_e_cant_have_multiple_relocatable_symbols=07010; + asmr_e_only_add_relocatable_symbol=07011; + asmr_e_invalid_constant_expression=07012; + asmr_e_relocatable_symbol_not_allowed=07013; + asmr_e_invalid_reference_syntax=07014; + asmr_e_local_para_unreachable=07015; + asmr_e_local_label_not_allowed_as_ref=07016; + asmr_e_wrong_base_index=07017; + asmr_w_possible_object_field_bug=07018; + asmr_e_wrong_scale_factor=07019; + asmr_e_multiple_index=07020; + asmr_e_invalid_operand_type=07021; + asmr_e_invalid_string_as_opcode_operand=07022; + asmr_w_CODE_and_DATA_not_supported=07023; + asmr_e_null_label_ref_not_allowed=07024; + asmr_e_expr_zero_divide=07025; + asmr_e_expr_illegal=07026; + asmr_e_escape_seq_ignored=07027; + asmr_e_invalid_symbol_ref=07028; + asmr_w_fwait_emu_prob=07029; + asmr_w_fadd_to_faddp=07030; + asmr_w_enter_not_supported_by_linux=07031; + asmr_w_calling_overload_func=07032; + asmr_e_unsupported_symbol_type=07033; + asmr_e_constant_out_of_bounds=07034; + asmr_e_error_converting_decimal=07035; + asmr_e_error_converting_octal=07036; + asmr_e_error_converting_binary=07037; + asmr_e_error_converting_hexadecimal=07038; + asmr_h_direct_global_to_mangled=07039; + asmr_w_direct_global_is_overloaded_func=07040; + asmr_e_cannot_use_SELF_outside_a_method=07041; + asmr_e_cannot_use_OLDEBP_outside_nested_procedure=07042; + asmr_e_void_function=07043; + asmr_e_SEG_not_supported=07044; + asmr_e_size_suffix_and_dest_dont_match=07045; + asmr_w_size_suffix_and_dest_dont_match=07046; + asmr_e_syntax_error=07047; + asmr_e_invalid_opcode_and_operand=07048; + asmr_e_syn_operand=07049; + asmr_e_syn_constant=07050; + asmr_e_invalid_string_expression=07051; + asmr_w_const32bit_for_address=07052; + asmr_e_unknown_opcode=07053; + asmr_e_invalid_or_missing_opcode=07054; + asmr_e_invalid_prefix_and_opcode=07055; + asmr_e_invalid_override_and_opcode=07056; + asmr_e_too_many_operands=07057; + asmr_w_near_ignored=07058; + asmr_w_far_ignored=07059; + asmr_e_dup_local_sym=07060; + asmr_e_unknown_local_sym=07061; + asmr_e_unknown_label_identifier=07062; + asmr_e_invalid_register=07063; + asmr_e_invalid_fpu_register=07064; + asmr_w_modulo_not_supported=07066; + asmr_e_invalid_float_const=07067; + asmr_e_invalid_float_expr=07068; + asmr_e_wrong_sym_type=07069; + asmr_e_cannot_index_relative_var=07070; + asmr_e_invalid_seg_override=07071; + asmr_w_id_supposed_external=07072; + asmr_e_string_not_allowed_as_const=07073; + asmr_e_no_var_type_specified=07074; + asmr_w_assembler_code_not_returned_to_text=07075; + asmr_e_not_directive_or_local_symbol=07076; + asmr_w_using_defined_as_local=07077; + asmr_e_dollar_without_identifier=07078; + asmr_w_32bit_const_for_address=07079; + asmr_n_align_is_target_specific=07080; + asmr_e_cannot_access_field_directly_for_parameters=07081; + asmr_e_cannot_access_object_field_directly=07082; + asmr_e_unable_to_determine_reference_size=07083; + asmr_e_cannot_use_RESULT_here=07084; + asmr_w_adding_explicit_args_fXX=07086; + asmr_w_adding_explicit_first_arg_fXX=07087; + asmr_w_adding_explicit_second_arg_fXX=07088; + asmr_e_invalid_char_smaller=07089; + asmr_e_invalid_char_greater=07090; + asmr_w_align_not_supported=07093; + asmr_e_no_inc_and_dec_together=07094; + asmr_e_invalid_reg_list_in_movem=07095; + asmr_e_invalid_reg_list_for_opcode=07096; + asmr_e_higher_cpu_mode_required=07097; + asmr_w_unable_to_determine_reference_size_using_dword=07098; + asmr_e_illegal_shifterop_syntax=07099; + asmr_e_packed_element=07100; + asmr_w_unable_to_determine_reference_size_using_byte=07101; + asmr_w_no_direct_ebp_for_parameter=07102; + asmr_w_direct_ebp_for_parameter_regcall=07103; + asmr_w_direct_ebp_neg_offset=07104; + asmr_w_direct_esp_neg_offset=07105; + asmr_e_no_vmtoffset_possible=07106; + asmr_e_need_pic_ref=07107; + asmr_e_mixing_regtypes=07108; + asmr_e_empty_regset=07109; + asmr_w_useless_got_for_local=07110; + asmr_w_general_segment_with_constant=07111; + asmr_e_bad_seh_directive_offset=07112; + asmr_e_bad_seh_directive_register=07113; + asmr_e_seh_in_pure_asm_only=07114; + asmr_e_unsupported_directive=07115; + asmw_f_too_many_asm_files=08000; + asmw_f_assembler_output_not_supported=08001; + asmw_f_comp_not_supported=08002; + asmw_f_direct_not_supported=08003; + asmw_e_alloc_data_only_in_bss=08004; + asmw_f_no_binary_writer_selected=08005; + asmw_e_opcode_not_in_table=08006; + asmw_e_invalid_opcode_and_operands=08007; + asmw_e_16bit_not_supported=08008; + asmw_e_invalid_effective_address=08009; + asmw_e_immediate_or_reference_expected=08010; + asmw_e_value_exceeds_bounds=08011; + asmw_e_short_jmp_out_of_range=08012; + asmw_e_undefined_label=08013; + asmw_e_comp_not_supported=08014; + asmw_e_extended_not_supported=08015; + asmw_e_duplicate_label=08016; + asmw_e_redefined_label=08017; + asmw_e_first_defined_label=08018; + asmw_e_invalid_register=08019; + asmw_e_16bit_32bit_not_supported=08020; + asmw_e_64bit_not_supported=08021; + asmw_e_bad_reg_with_rex=08022; + asmw_e_missing_endprologue=08023; + asmw_e_prologue_too_large=08024; + asmw_e_handlerdata_no_handler=08025; + exec_w_source_os_redefined=09000; + exec_i_assembling_pipe=09001; + exec_d_cant_create_asmfile=09002; + exec_e_cant_create_objectfile=09003; + exec_e_cant_create_archivefile=09004; + exec_e_assembler_not_found=09005; + exec_t_using_assembler=09006; + exec_e_error_while_assembling=09007; + exec_e_cant_call_assembler=09008; + exec_i_assembling=09009; + exec_i_assembling_smart=09010; + exec_w_objfile_not_found=09011; + exec_w_libfile_not_found=09012; + exec_e_error_while_linking=09013; + exec_e_cant_call_linker=09014; + exec_i_linking=09015; + exec_e_util_not_found=09016; + exec_t_using_util=09017; + exec_e_exe_not_supported=09018; + exec_e_dll_not_supported=09019; + exec_i_closing_script=09020; + exec_e_res_not_found=09021; + exec_i_compilingresource=09022; + exec_t_unit_not_static_linkable_switch_to_smart=09023; + exec_t_unit_not_smart_linkable_switch_to_static=09024; + exec_t_unit_not_shared_linkable_switch_to_static=09025; + exec_e_unit_not_smart_or_static_linkable=09026; + exec_e_unit_not_shared_or_static_linkable=09027; + exec_d_resbin_params=09028; + exec_e_error_while_compiling_resources=09029; + exec_e_cant_call_resource_compiler=09030; + exec_e_cant_open_resource_file=09031; + exec_e_cant_write_resource_file=09032; + exec_n_backquote_cat_file_not_found=09033; + execinfo_f_cant_process_executable=09128; + execinfo_f_cant_open_executable=09129; + execinfo_x_codesize=09130; + execinfo_x_initdatasize=09131; + execinfo_x_uninitdatasize=09132; + execinfo_x_stackreserve=09133; + execinfo_x_stackcommit=09134; + link_f_executable_too_big=09200; + link_w_32bit_absolute_reloc=09201; + unit_t_unitsearch=10000; + unit_t_ppu_loading=10001; + unit_u_ppu_name=10002; + unit_u_ppu_flags=10003; + unit_u_ppu_crc=10004; + unit_u_ppu_time=10005; + unit_u_ppu_file_too_short=10006; + unit_u_ppu_invalid_header=10007; + unit_u_ppu_invalid_version=10008; + unit_u_ppu_invalid_processor=10009; + unit_u_ppu_invalid_target=10010; + unit_u_ppu_source=10011; + unit_u_ppu_write=10012; + unit_f_ppu_cannot_write=10013; + unit_f_ppu_read_error=10014; + unit_f_ppu_read_unexpected_end=10015; + unit_f_ppu_invalid_entry=10016; + unit_f_ppu_dbx_count_problem=10017; + unit_e_illegal_unit_name=10018; + unit_f_too_much_units=10019; + unit_f_circular_unit_reference=10020; + unit_f_cant_compile_unit=10021; + unit_f_cant_find_ppu=10022; + unit_w_unit_name_error=10023; + unit_f_unit_name_error=10024; + unit_w_switch_us_missed=10025; + unit_f_errors_in_unit=10026; + unit_u_load_unit=10027; + unit_u_recompile_crc_change=10028; + unit_u_recompile_source_found_alone=10029; + unit_u_recompile_staticlib_is_older=10030; + unit_u_recompile_sharedlib_is_older=10031; + unit_u_recompile_obj_and_asm_older=10032; + unit_u_recompile_obj_older_than_asm=10033; + unit_u_parsing_interface=10034; + unit_u_parsing_implementation=10035; + unit_u_second_load_unit=10036; + unit_u_check_time=10037; + unit_w_cant_compile_unit_with_changed_incfile=10040; + unit_u_source_modified=10041; + unit_u_ppu_invalid_fpumode=10042; + unit_u_loading_interface_units=10043; + unit_u_loading_implementation_units=10044; + unit_u_interface_crc_changed=10045; + unit_u_implementation_crc_changed=10046; + unit_u_finished_compiling=10047; + unit_u_add_depend_to=10048; + unit_u_no_reload_is_caller=10049; + unit_u_no_reload_in_second_compile=10050; + unit_u_flag_for_reload=10051; + unit_u_forced_reload=10052; + unit_u_previous_state=10053; + unit_u_second_compile_unit=10054; + unit_u_loading_unit=10055; + unit_u_finished_loading_unit=10056; + unit_u_registering_new_unit=10057; + unit_u_reresolving_unit=10058; + unit_u_skipping_reresolving_unit=10059; + unit_u_unload_resunit=10060; + unit_e_different_wpo_file=10061; + unit_u_indirect_crc_changed=10062; + option_usage=11000; + option_only_one_source_support=11001; + option_def_only_for_os2=11002; + option_no_nested_response_file=11003; + option_no_source_found=11004; + option_no_option_found=11005; + option_illegal_para=11006; + option_help_pages_para=11007; + option_too_many_cfg_files=11008; + option_unable_open_file=11009; + option_reading_further_from=11010; + option_target_is_already_set=11011; + option_no_shared_lib_under_dos=11012; + option_too_many_ifdef=11013; + option_too_many_endif=11014; + option_too_less_endif=11015; + option_no_debug_support=11016; + option_no_debug_support_recompile_fpc=11017; + option_obsolete_switch=11018; + option_obsolete_switch_use_new=11019; + option_switch_bin_to_src_assembler=11020; + option_incompatible_asm=11021; + option_asm_forced=11022; + option_using_file=11026; + option_using_env=11027; + option_handling_option=11028; + option_help_press_enter=11029; + option_start_reading_configfile=11030; + option_end_reading_configfile=11031; + option_interpreting_option=11032; + option_interpreting_firstpass_option=11036; + option_interpreting_file_option=11033; + option_read_config_file=11034; + option_found_file=11035; + option_code_page_not_available=11039; + option_config_is_dir=11040; + option_confict_asm_debug=11041; + option_ppc386_deprecated=11042; + option_else_without_if=11043; + option_unsupported_target=11044; + option_unsupported_target_for_feature=11045; + option_dwarf_smart_linking=11046; + option_ignored_target=11047; + option_debug_external_unsupported=11048; + option_dwarf_smartlink_creation=11049; + wpo_cant_find_file=12000; + wpo_begin_processing=12001; + wpo_end_processing=12002; + wpo_expected_section=12003; + wpo_no_section_handler=12004; + wpo_found_section=12005; + wpo_no_input_specified=12006; + wpo_not_enough_info=12007; + wpo_no_output_specified=12008; + wpo_output_without_info_gen=12009; + wpo_input_without_info_use=12010; + wpo_skipping_unnecessary_section=12011; + wpo_duplicate_wpotype=12012; + wpo_cannot_extract_live_symbol_info_strip=12013; + wpo_cannot_extract_live_symbol_info_no_link=12014; + wpo_cannot_find_symbol_progs=12015; + wpo_error_reading_symbol_file=12016; + wpo_error_executing_symbol_prog=12017; + wpo_symbol_live_info_needs_smart_linking=12018; + wpo_cant_create_feedback_file=12019; + option_logo=11023; + option_info=11024; + option_help_pages=11025; + + MsgTxtSize = 62116; + + MsgIdxMax : array[1..20] of longint=( + 26,89,315,109,85,55,116,26,202,63, + 50,20,1,1,1,1,1,1,1,1 + ); diff --git a/closures/compiler/msgtxt.inc b/closures/compiler/msgtxt.inc new file mode 100644 index 0000000000..6f0ef14f37 --- /dev/null +++ b/closures/compiler/msgtxt.inc @@ -0,0 +1,1453 @@ +{$ifdef Delphi} +const msgtxt : array[0..000258] of string[240]=( +{$else Delphi} +const msgtxt : array[0..000258,1..240] of char=( +{$endif Delphi} + '01000_T_Compiler: $1'#000+ + '01001_D_Compiler OS: $1'#000+ + '01002_I_Target OS: $1'#000+ + '01003_T_Using executable path: $1'#000+ + '01004_T_Using unit path: $1'#000+ + '01005_T_Using include path: $1'#000+ + '01006_T_Using library path: $1'#000+ + '01007_T_Using object path: $1'#000+ + '01008_I_$1 lines co','mpiled, $2 sec$3'#000+ + '01009_F_No memory left'#000+ + '01010_I_Writing Resource String Table file: $1'#000+ + '01011_E_Writing Resource String Table file: $1'#000+ + '01012_I_Fatal:'#000+ + '01013_I_Error:'#000+ + '01014_I_Warning:'#000+ + '01015_I_Note:'#000+ + '01016_I_Hint:'#000+ + '01017_E_Path "$1" does not exis','t'#000+ + '01018_F_Compilation aborted'#000+ + '01019_bytes code'#000+ + '01020_bytes data'#000+ + '01021_I_$1 warning(s) issued'#000+ + '01022_I_$1 hint(s) issued'#000+ + '01023_I_$1 note(s) issued'#000+ + '01024_F_I/O error: $1'#000+ + '01025_F_Operating system error: $1'#000+ + '02000_F_Unexpected end of file'#000+ + '02001_F','_String exceeds line'#000+ + '02002_F_illegal character "$1" ($2)'#000+ + '02003_F_Syntax error, "$1" expected but "$2" found'#000+ + '02004_TL_Start reading includefile $1'#000+ + '02005_W_Comment level $1 found'#000+ + '02008_N_Ignored compiler switch "$1"'#000+ + '02009_W_Illegal compiler s','witch "$1"'#000+ + '02010_W_Misplaced global compiler switch'#000+ + '02011_E_Illegal char constant'#000+ + '02012_F_Can'#039't open file "$1"'#000+ + '02013_F_Can'#039't open include file "$1"'#000+ + '02015_E_Illegal record alignment specifier "$1"'#000+ + '02016_E_Illegal enum minimum-size specifier ','"$1"'#000+ + '02017_E_$ENDIF expected for $1 $2 defined in $3 line $4'#000+ + '02018_E_Syntax error while parsing a conditional compiling expression'#000+ + '02019_E_Evaluating a conditional compiling expression'#000+ + '02020_W_Macro contents are limited to 255 characters in',' length'#000+ + '02021_E_ENDIF without IF(N)DEF'#000+ + '02022_F_User defined: $1'#000+ + '02023_E_User defined: $1'#000+ + '02024_W_User defined: $1'#000+ + '02025_N_User defined: $1'#000+ + '02026_H_User defined: $1'#000+ + '02027_I_User defined: $1'#000+ + '02028_E_Keyword redefined as macro has no effect'#000+ + '02','029_F_Macro buffer overflow while reading or expanding a macro'#000+ + '02030_W_Expanding of macros exceeds a depth of 16.'#000+ + '02031_W_compiler switches aren'#039't supported in // styled comments'#000+ + '02032_DL_Handling switch "$1"'#000+ + '02033_CL_ENDIF $1 found'#000+ + '02034_C','L_IFDEF $1 found, $2'#000+ + '02035_CL_IFOPT $1 found, $2'#000+ + '02036_CL_IF $1 found, $2'#000+ + '02037_CL_IFNDEF $1 found, $2'#000+ + '02038_CL_ELSE $1 found, $2'#000+ + '02039_CL_Skipping until...'#000+ + '02040_I_Press <return> to continue'#000+ + '02041_W_Unsupported switch "$1"'#000+ + '02042_W_Illegal ','compiler directive "$1"'#000+ + '02043_TL_Back in $1'#000+ + '02044_W_Unsupported application type: "$1"'#000+ + '02045_W_APPTYPE is not supported by the target OS'#000+ + '02046_W_DESCRIPTION is not supported by the target OS'#000+ + '02047_N_VERSION is not supported by target OS'#000+ + '020','48_N_VERSION only for exes or DLLs'#000+ + '02049_W_Wrong format for VERSION directive "$1"'#000+ + '02050_E_Illegal assembler style specified "$1"'#000+ + '02051_W_ASM reader switch is not possible inside asm statement, "$1" w'+ + 'ill be effective only for next'#000+ + '02052_E_W','rong switch toggle, use ON/OFF or +/-'#000+ + '02053_E_Resource files are not supported for this target'#000+ + '02054_W_Include environment "$1" not found in environment'#000+ + '02055_E_Illegal value for FPU register limit'#000+ + '02056_W_Only one resource file is supporte','d for this target'#000+ + '02057_W_Macro support has been turned off'#000+ + '02058_E_Illegal interface type specified. Valids are COM, CORBA or DEF'+ + 'AULT.'#000+ + '02059_W_APPID is only supported for PalmOS'#000+ + '02060_W_APPNAME is only supported for PalmOS'#000+ + '02061_E_Constant',' strings can'#039't be longer than 255 chars'#000+ + '02062_F_Including include files exceeds a depth of 16.'#000+ + '02063_F_Too many levels of PUSH'#000+ + '02064_E_A POP without a preceding PUSH'#000+ + '02065_E_Macro or compile time variable "$1" does not have any value'#000+ + '02066_','E_Wrong switch toggle, use ON/OFF/DEFAULT or +/-/*'#000+ + '02067_E_Mode switch "$1" not allowed here'#000+ + '02068_E_Compile time variable or macro "$1" is not defined.'#000+ + '02069_E_UTF-8 code greater than 65535 found'#000+ + '02070_E_Malformed UTF-8 string'#000+ + '02071_C_UTF-','8 signature found, using UTF-8 encoding'#000+ + '02072_E_Compile time expression: Wanted $1 but got $2 at $3'#000+ + '02073_N_APPTYPE is not supported by the target OS'#000+ + '02074_E_Illegal optimization specified "$1"'#000+ + '02075_W_SETPEFLAGS is not supported by the tar','get OS'#000+ + '02076_W_IMAGEBASE is not supported by the target OS'#000+ + '02077_W_MINSTACKSIZE is not supported by the target OS'#000+ + '02078_W_MAXSTACKSIZE is not supported by the target OS'#000+ + '02079_E_Illegal state "$1" for $WARN directive'#000+ + '02080_E_Illegal set pack','ing value'#000+ + '02081_W_PIC directive or switch ignored'#000+ + '02082_W_The switch "$1" is not supported by the currently selected tar'+ + 'get'#000+ + '02084_W_Framework-related options are only supported for Darwin/Mac OS'+ + ' X'#000+ + '02085_E_Illegal minimal floating point cons','tant precision "$1"'#000+ + '02086_W_Overriding name of "main" procedure multiple times, was previo'+ + 'usly set to "$1"'#000+ + '02087_W_Illegal identifier "$1" for $WARN directive'#000+ + '02088_E_Illegal alignment directive'#000+ + '03000_E_Parser - Syntax Error'#000+ + '03004_E_INTERRU','PT procedure can'#039't be nested'#000+ + '03005_W_Procedure type "$1" ignored'#000+ + '03006_E_Not all declarations of "$1" are declared with OVERLOAD'#000+ + '03008_E_Duplicate exported function name "$1"'#000+ + '03009_E_Duplicate exported function index $1'#000+ + '03010_E_Invalid inde','x for exported function'#000+ + '03011_W_Relocatable DLL or executable $1 debug info does not work, dis'+ + 'abled.'#000+ + '03012_W_To allow debugging for win32 code you need to disable relocati'+ + 'on with -WN option'#000+ + '03013_E_Constructor name must be INIT'#000+ + '03014_E_Dest','ructor name must be DONE'#000+ + '03016_E_Procedure type INLINE not supported'#000+ + '03018_W_Constructor should be public'#000+ + '03019_W_Destructor should be public'#000+ + '03020_N_Class should have one destructor only'#000+ + '03021_E_Local class definitions are not allowed'#000+ + '0302','2_F_Anonymous class definitions are not allowed'#000+ + '03023_N_The object "$1" has no VMT'#000+ + '03024_E_Illegal parameter list'#000+ + '03026_E_Wrong number of parameters specified for call to "$1"'#000+ + '03027_E_overloaded identifier "$1" isn'#039't a function'#000+ + '03028_E_over','loaded functions have the same parameter list'#000+ + '03029_E_function header doesn'#039't match the previous declaration "$1'+ + '"'#000+ + '03030_E_function header "$1" doesn'#039't match forward : var name chan'+ + 'ges $2 => $3'#000+ + '03031_N_Values in enumeration types have to be ','ascending'#000+ + '03033_E_With cannot be used for variables in a different segment'#000+ + '03034_E_function nesting > 31'#000+ + '03035_E_range check error while evaluating constants'#000+ + '03036_W_range check error while evaluating constants'#000+ + '03037_E_duplicate case label'#000, + '03038_E_Upper bound of case range is less than lower bound'#000+ + '03039_E_typed constants of classes or interfaces are not allowed'#000+ + '03040_E_functions variables of overloaded functions are not allowed'#000+ + '03041_E_string length must be a value from 1 to ','255'#000+ + '03042_W_use extended syntax of NEW and DISPOSE for instances of object'+ + 's'#000+ + '03043_W_use of NEW or DISPOSE for untyped pointers is meaningless'#000+ + '03044_E_use of NEW or DISPOSE is not possible for untyped pointers'#000+ + '03045_E_class identifier expect','ed'#000+ + '03046_E_type identifier not allowed here'#000+ + '03047_E_method identifier expected'#000+ + '03048_E_function header doesn'#039't match any method of this class "$1'+ + '"'#000+ + '03049_DL_procedure/function $1'#000+ + '03050_E_Illegal floating point constant'#000+ + '03051_E_FAIL can be us','ed in constructors only'#000+ + '03052_E_Destructors can'#039't have parameters'#000+ + '03053_E_Only class methods, class properties and class variables can b'+ + 'e referred with class references'#000+ + '03054_E_Only class methods, class properties and class variables can b'+ + 'e',' accessed in class methods'#000+ + '03055_E_Constant and CASE types do not match'#000+ + '03056_E_The symbol can'#039't be exported from a library'#000+ + '03057_W_An inherited method is hidden by "$1"'#000+ + '03058_E_There is no method in an ancestor class to be overridden: "$1"', + #000+ + '03059_E_No member is provided to access property'#000+ + '03060_W_Stored property directive is not yet implemented'#000+ + '03061_E_Illegal symbol for property access'#000+ + '03062_E_Cannot access a protected field of an object here'#000+ + '03063_E_Cannot access a private ','field of an object here'#000+ + '03066_E_Overridden methods must have the same return type: "$2" is ove'+ + 'rridden by "$1" which has another return type'#000+ + '03067_E_EXPORT declared functions can'#039't be nested'#000+ + '03068_E_Methods can'#039't be EXPORTed'#000+ + '03069_E_Call by ','var for arg no. $1 has to match exactly: Got "$2" ex'+ + 'pected "$3"'#000+ + '03070_E_Class isn'#039't a parent class of the current class'#000+ + '03071_E_SELF is only allowed in methods'#000+ + '03072_E_Methods can be only in other methods called direct with type i'+ + 'dentifier ','of the class'#000+ + '03073_E_Illegal use of '#039':'#039#000+ + '03074_E_range check error in set constructor or duplicate set element'#000+ + '03075_E_Pointer to object expected'#000+ + '03076_E_Expression must be constructor call'#000+ + '03077_E_Expression must be destructor call'#000+ + '03078_E_','Illegal order of record elements'#000+ + '03079_E_Expression type must be class or record type'#000+ + '03080_E_Procedures can'#039't return a value'#000+ + '03081_E_constructors, destructors and class operators must be methods'#000+ + '03082_E_Operator is not overloaded'#000+ + '03083_E_I','mpossible to overload assignment for equal types'#000+ + '03084_E_Impossible operator overload'#000+ + '03085_E_Re-raise isn'#039't possible there'#000+ + '03086_E_The extended syntax of new or dispose isn'#039't allowed for a '+ + 'class'#000+ + '03088_E_Procedure overloading is switched of','f'#000+ + '03089_E_It is not possible to overload this operator. Related overload'+ + 'able operators (if any) are: $1'#000+ + '03090_E_Comparative operator must return a boolean value'#000+ + '03091_E_Only virtual methods can be abstract'#000+ + '03092_F_Use of unsupported feature','!'#000+ + '03093_E_The mix of different kind of objects (class, object, interface'+ + ', etc) isn'#039't allowed'#000+ + '03094_W_Unknown procedure directive had to be ignored: "$1"'#000+ + '03095_E_absolute can only be associated to one variable'#000+ + '03096_E_absolute can only be as','sociated with a var or const'#000+ + '03097_E_Only one variable can be initialized'#000+ + '03098_E_Abstract methods shouldn'#039't have any definition (with funct'+ + 'ion body)'#000+ + '03099_E_This overloaded function can'#039't be local (must be exported)'+ + #000+ + '03100_W_Virtual methods',' are used without a constructor in "$1"'#000+ + '03101_CL_Macro defined: $1'#000+ + '03102_CL_Macro undefined: $1'#000+ + '03103_CL_Macro $1 set to $2'#000+ + '03104_I_Compiling $1'#000+ + '03105_UL_Parsing interface of unit $1'#000+ + '03106_UL_Parsing implementation of $1'#000+ + '03107_DL_Compiling ','$1 for the second time'#000+ + '03109_E_No property found to override'#000+ + '03110_E_Only one default property is allowed'#000+ + '03111_E_The default property must be an array property'#000+ + '03112_E_Virtual constructors are only supported in class object model'#000+ + '03113_E_N','o default property available'#000+ + '03114_E_The class can'#039't have a published section, use the {$M+} sw'+ + 'itch'#000+ + '03115_E_Forward declaration of class "$1" must be resolved here to use'+ + ' the class as ancestor'#000+ + '03116_E_Local operators not supported'#000+ + '03117_E_P','rocedure directive "$1" not allowed in interface section'#000+ + '03118_E_Procedure directive "$1" not allowed in implementation section'+ + #000+ + '03119_E_Procedure directive "$1" not allowed in procvar declaration'#000+ + '03120_E_Function is already declared Public/','Forward "$1"'#000+ + '03121_E_Can'#039't use both EXPORT and EXTERNAL'#000+ + '03123_W_"$1" not yet supported inside inline procedure/function'#000+ + '03124_W_Inlining disabled'#000+ + '03125_I_Writing Browser log $1'#000+ + '03126_H_may be pointer dereference is missing'#000+ + '03127_F_Selected ','assembler reader not supported'#000+ + '03128_E_Procedure directive "$1" has conflicts with other directives'#000+ + '03129_E_Calling convention doesn'#039't match forward'#000+ + '03131_E_Property can'#039't have a default value'#000+ + '03132_E_The default value of a property must be',' constant'#000+ + '03133_E_Symbol can'#039't be published, can be only a class'#000+ + '03134_E_This kind of property can'#039't be published'#000+ + '03136_E_An import name is required'#000+ + '03138_E_Division by zero'#000+ + '03139_E_Invalid floating point operation'#000+ + '03140_E_Upper bound of ra','nge is less than lower bound'#000+ + '03141_W_string "$1" is longer than "$2"'#000+ + '03142_E_string length is larger than array of char length'#000+ + '03143_E_Illegal expression after message directive'#000+ + '03144_E_Message handlers can take only one call by ref. parame','ter'#000+ + '03145_E_Duplicate message label: "$1"'#000+ + '03146_E_Self can only be an explicit parameter in methods which are me'+ + 'ssage handlers'#000+ + '03147_E_Threadvars can be only static or global'#000+ + '03148_F_Direct assembler not supported for binary output format'#000+ + '0','3149_W_Don'#039't load OBJPAS unit manually, use \{\$mode objfpc\} o'+ + 'r \{\$mode delphi\} instead'#000+ + '03150_E_OVERRIDE can'#039't be used in objects'#000+ + '03151_E_Data types which require initialization/finalization can'#039't'+ + ' be used in variant records'#000+ + '03152_E_Resou','rcestrings can be only static or global'#000+ + '03153_E_Exit with argument can'#039't be used here'#000+ + '03154_E_The type of the storage symbol must be boolean'#000+ + '03155_E_This symbol isn'#039't allowed as storage symbol'#000+ + '03156_E_Only classes which are compiled in $M+ ','mode can be published'+ + #000+ + '03157_E_Procedure directive expected'#000+ + '03158_E_The value for a property index must be of an ordinal type'#000+ + '03159_E_Procedure name too short to be exported'#000+ + '03160_E_No DEFFILE entry can be generated for unit global vars'#000+ + '0316','1_E_Compile without -WD option'#000+ + '03162_F_You need ObjFpc (-S2) or Delphi (-Sd) mode to compile this mod'+ + 'ule'#000+ + '03163_E_Can'#039't export with index under $1'#000+ + '03164_E_Exporting of variables is not supported under $1'#000+ + '03165_E_Improper GUID syntax'#000+ + '03168_W_','Procedure named "$1" not found that is suitable for implemen'+ + 'ting the $2.$3'#000+ + '03169_E_interface identifier expected'#000+ + '03170_E_Type "$1" can'#039't be used as array index type'#000+ + '03171_E_Con- and destructors aren'#039't allowed in interfaces'#000+ + '03172_E_Access sp','ecifiers can'#039't be used in INTERFACEs and OBJCPR'+ + 'OTOCOLs'#000+ + '03173_E_An interface, helper or Objective-C protocol or category canno'+ + 't contain fields'#000+ + '03174_E_Can'#039't declare local procedure as EXTERNAL'#000+ + '03175_W_Some fields coming before "$1" weren'#039't i','nitialized'#000+ + '03176_E_Some fields coming before "$1" weren'#039't initialized'#000+ + '03177_W_Some fields coming after "$1" weren'#039't initialized'#000+ + '03178_E_VarArgs directive (or '#039'...'#039' in MacPas) without CDecl/C'+ + 'PPDecl/MWPascal and External'#000+ + '03179_E_Self must be ','a normal (call-by-value) parameter'#000+ + '03180_E_Interface "$1" has no interface identification'#000+ + '03181_E_Unknown class field or method identifier "$1"'#000+ + '03182_W_Overriding calling convention "$1" with "$2"'#000+ + '03183_E_Typed constants of the type "proced','ure of object" can only b'+ + 'e initialized with NIL'#000+ + '03184_E_Default value can only be assigned to one parameter'#000+ + '03185_E_Default parameter required for "$1"'#000+ + '03186_W_Use of unsupported feature!'#000+ + '03187_H_C arrays are passed by reference'#000+ + '03188_E_C a','rray of const must be the last argument'#000+ + '03189_H_Type "$1" redefinition'#000+ + '03190_W_cdecl'#039'ared functions have no high parameter'#000+ + '03191_W_cdecl'#039'ared functions do not support open strings'#000+ + '03192_E_Cannot initialize variables declared as threadvar'#000+ + '03','193_E_Message directive is only allowed in Classes'#000+ + '03194_E_Procedure or Function expected'#000+ + '03195_W_Calling convention directive ignored: "$1"'#000+ + '03196_E_REINTRODUCE can'#039't be used in objects'#000+ + '03197_E_Each argument must have its own location'#000+ + '03198','_E_Each argument must have an explicit location'#000+ + '03199_E_Unknown argument location'#000+ + '03200_E_32 Bit-Integer or pointer variable expected'#000+ + '03201_E_Goto statements aren'#039't allowed between different procedure'+ + 's'#000+ + '03202_F_Procedure too complex, it requ','ires too many registers'#000+ + '03203_E_Illegal expression'#000+ + '03204_E_Invalid integer expression'#000+ + '03205_E_Illegal qualifier'#000+ + '03206_E_High range limit < low range limit'#000+ + '03207_E_Exit'#039's parameter must be the name of the procedure it is u'+ + 'sed in'#000+ + '03208_E_Ille','gal assignment to for-loop variable "$1"'#000+ + '03209_E_Can'#039't declare local variable as EXTERNAL'#000+ + '03210_E_Procedure is already declared EXTERNAL'#000+ + '03211_W_Implicit uses of Variants unit'#000+ + '03212_E_Class and static methods can'#039't be used in INTERFACES'#000+ + '032','13_E_Overflow in arithmetic operation'#000+ + '03214_E_Protected or private expected'#000+ + '03215_E_SLICE can'#039't be used outside of parameter list'#000+ + '03216_E_A DISPINTERFACE can'#039't have a parent class'#000+ + '03217_E_A DISPINTERFACE needs a guid'#000+ + '03218_W_Overridden meth','ods must have a related return type. This cod'+ + 'e may crash, it depends on a Delphi parser bug ("$2" is overridden by '+ + '"$1" which has another return type)'#000+ + '03219_E_Dispatch IDs must be ordinal constants'#000+ + '03220_E_The range of the array is too larg','e'#000+ + '03221_E_The address cannot be taken of bit packed array elements and r'+ + 'ecord fields'#000+ + '03222_E_Dynamic arrays cannot be packed'#000+ + '03223_E_Bit packed array elements and record fields cannot be used as '+ + 'loop variables'#000+ + '03224_E_VAR, TYPE and CONST ar','e allowed only in records, objects and'+ + ' classes'#000+ + '03225_E_This type can'#039't be a generic'#000+ + '03226_W_Don'#039't load LINEINFO unit manually, Use the -gl compiler sw'+ + 'itch instead'#000+ + '03227_E_No function result type specified for function "$1"'#000+ + '03228_E_Specializ','ation is only supported for generic types'#000+ + '03229_E_Generics can'#039't be used as parameters when specializing gen'+ + 'erics'#000+ + '03230_E_Constants of objects containing a VMT aren'#039't allowed'#000+ + '03231_E_Taking the address of labels defined outside the current ','sco'+ + 'pe isn'#039't allowed'#000+ + '03233_E_Cannot initialize variables declared as external'#000+ + '03234_E_Illegal function result type'#000+ + '03235_E_No common type possible between "$1" and "$2"'#000+ + '03236_E_Generics without specialization cannot be used as a type for a'+ + ' v','ariable'#000+ + '03237_W_Register list is ignored for pure assembler routines'#000+ + '03238_E_Implements property must have class or interface type'#000+ + '03239_E_Implements-property must implement interface of correct type, '+ + 'found "$1" expected "$2"'#000+ + '03240_E_Implem','ents-property must have read specifier'#000+ + '03241_E_Implements-property must not have write-specifier'#000+ + '03242_E_Implements-property must not have stored-specifier'#000+ + '03243_E_Implements-property used on unimplemented interface: "$1"'#000+ + '03244_E_Floating p','oint not supported for this target'#000+ + '03245_E_Class "$1" does not implement interface "$2"'#000+ + '03246_E_Type used by implements must be an interface'#000+ + '03247_E_Variables cannot be exported with a different name on this tar'+ + 'get, add the name to the decl','aration using the "export" directive (v'+ + 'ariable name: $1, declared export name: $2)'#000+ + '03248_E_Weak external symbols are not supported for the current target'+ + #000+ + '03249_E_Forward type definition does not match'#000+ + '03250_N_Virtual method "$1" has a lower',' visibility ($2) than parent '+ + 'class $3 ($4)'#000+ + '03251_E_Fields cannot appear after a method or property definition, st'+ + 'art a new visibility section first'#000+ + '03252_E_Parameters or result types cannot contain local type definitio'+ + 'ns. Use a separate typ','e definition in a type block.'#000+ + '03253_E_ABSTRACT and SEALED conflict'#000+ + '03254_E_Cannot create a descendant of the sealed class "$1"'#000+ + '03255_E_SEALED class cannot have an ABSTRACT method'#000+ + '03256_E_Only virtual methods can be final'#000+ + '03257_E_Final metho','d cannot be overridden: "$1"'#000+ + '03258_E_Only one message can be used per method.'#000+ + '03259_E_Invalid enumerator identifier: "$1"'#000+ + '03260_E_Enumerator identifier required'#000+ + '03261_E_Enumerator MoveNext pattern method is not valid. Method must b'+ + 'e a funct','ion with the Boolean return type and no required arguments.'+ + #000+ + '03262_E_Enumerator Current pattern property is not valid. Property mus'+ + 't have a getter.'#000+ + '03263_E_Only one enumerator MoveNext method is allowed per class/objec'+ + 't'#000+ + '03264_E_Only one enum','erator Current property is allowed per class/ob'+ + 'ject'#000+ + '03265_E_For in loop cannot be used for the type "$1"'#000+ + '03266_E_Objective-C messages require their Objective-C selector name t'+ + 'o be specified using the "message" directive.'#000+ + '03267_E_Objective-C',' does not have formal constructors nor destructor'+ + 's. Use the alloc, initXXX and dealloc messages.'#000+ + '03268_E_Message name is too long (max. 255 characters)'#000+ + '03269_E_Objective-C message symbol name for "$1" is too long'#000+ + '03270_H_Defining a new Obje','ctive-C root class. To derive from anothe'+ + 'r root class (e.g., NSObject), specify it as the parent class.'#000+ + '03271_E_Objective-C classes cannot have published sections.'#000+ + '03272_F_This module requires an Objective-C mode switch to be compiled'+ + #000+ + '03273','_E_Inherited methods can only be overridden in Objective-C, add'+ + ' "override" (inherited method defined in $1)'#000+ + '03274_H_Inherited methods can only be overridden in Objective-C, add "'+ + 'override" (inherited method defined in $1).'#000+ + '03275_E_Message na','me "$1" in inherited class is different from messa'+ + 'ge name "$2" in current class.'#000+ + '03276_E_It is not yet possible to make unique copies of Objective-C ty'+ + 'pes'#000+ + '03277_E_Objective-C categories and Object Pascal class helpers cannot '+ + 'be used as type','s'#000+ + '03278_E_Categories do not override, but replace methods. Use "reintrod'+ + 'uce" instead.'#000+ + '03279_E_Replaced methods can only be reintroduced in Objective-C, add '+ + '"reintroduce" (replaced method defined in $1).'#000+ + '03280_H_Replaced methods can only be ','reintroduced in Objective-C, ad'+ + 'd "reintroduce" (replaced method defined in $1).'#000+ + '03281_E_Getter for implements interface must use the target'#039's defa'+ + 'ult calling convention.'#000+ + '03282_E_Typed files cannot contain reference-counted types.'#000+ + '03283_E_Op','erator is not overloaded: $2 "$1"'#000+ + '03284_E_Operator is not overloaded: "$1" $2 "$3"'#000+ + '03285_E_Expected another $1 array elements'#000+ + '03286_E_String constant too long while ansistrings are disabled'#000+ + '03287_E_Type cannot be used as univ parameter beca','use its size is un'+ + 'known at compile time: "$1"'#000+ + '03288_E_Only one class constructor can be declared in class: "$1"'#000+ + '03289_E_Only one class destructor can be declared in class: "$1"'#000+ + '03290_E_Class constructors can'#039't have parameters'#000+ + '03291_E_Class ','destructors can'#039't have parameters'#000+ + '03292_F_This construct requires the \{\$modeswitch objectivec1\} mode '+ + 'switch to be active'#000+ + '03293_E_Unicodechar/string constants cannot be converted to ansi/short'+ + 'string at compile-time'#000+ + '03294_E_For-in Objectiv','e-Pascal loops require \{\$modeswitch Objecti'+ + 'veC2\} to be active'#000+ + '03295_E_The compiler cannot find the NSFastEnumerationProtocol or NSFa'+ + 'stEnumerationState type in the CocoaAll unit'#000+ + '03296_E_Typed constants of the type '#039'procedure is nested'#039' ca','n'+ + ' only be initialized with NIL and global procedures/functions'#000+ + '03297_F_Declaration of generic class inside another generic class is n'+ + 'ot allowed'#000+ + '03298_E_Forward declaration of objcprotocol "$1" must be resolved befo'+ + 're an objcclass can confor','m to it'#000+ + '03299_E_Record types cannot have published sections'#000+ + '03300_E_Destructors aren'#039't allowed in records or helpers'#000+ + '03301_E_Class methods must be static in records'#000+ + '03302_E_Constructors aren'#039't allowed in records or record helpers'#000+ + '03303_E_Ei','ther the result or at least one parameter must be of type '+ + '"$1"'#000+ + '03304_E_Type parameters may require initialization/finalization - can'#039+ + 't be used in variant records'#000+ + '03305_E_Variables being declared as external cannot be in a custom sec'+ + 'tion'#000+ + '033','06_E_Non-static and non-global variables cannot have a section di'+ + 'rective'#000+ + '03307_E_"$1" is not allowed in helper types'#000+ + '03308_E_Class constructors aren'#039't allowed in helpers'#000+ + '03309_E_The use of "inherited" is not allowed in a record'#000+ + '03310_E_Type',' declarations are not allowed in local or anonymous reco'+ + 'rds'#000+ + '03311_E_Duplicate implements clause for interface "$1"'#000+ + '03312_E_Interface "$1" can'#039't be delegated by "$2", it already has '+ + 'method resolutions'#000+ + '03313_E_Interface "$1" can'#039't have method',' resolutions, "$2" alrea'+ + 'dy delegates it'#000+ + '03314_E_Invalid codepage'#000+ + '04000_E_Type mismatch'#000+ + '04001_E_Incompatible types: got "$1" expected "$2"'#000+ + '04002_E_Type mismatch between "$1" and "$2"'#000+ + '04003_E_Type identifier expected'#000+ + '04004_E_Variable identifi','er expected'#000+ + '04005_E_Integer expression expected, but got "$1"'#000+ + '04006_E_Boolean expression expected, but got "$1"'#000+ + '04007_E_Ordinal expression expected'#000+ + '04008_E_pointer type expected, but got "$1"'#000+ + '04009_E_class type expected, but got "$1"'#000+ + '04011_','E_Can'#039't evaluate constant expression'#000+ + '04012_E_Set elements are not compatible'#000+ + '04013_E_Operation not implemented for sets'#000+ + '04014_W_Automatic type conversion from floating type to COMP which is '+ + 'an integer type'#000+ + '04015_H_use DIV instead to get an ','integer result'#000+ + '04016_E_String types have to match exactly in $V+ mode'#000+ + '04017_E_succ or pred on enums with assignments not possible'#000+ + '04018_E_Can'#039't read or write variables of this type'#000+ + '04019_E_Can'#039't use readln or writeln on typed file'#000+ + '04020_E_C','an'#039't use read or write on untyped file.'#000+ + '04021_E_Type conflict between set elements'#000+ + '04022_W_lo/hi(dword/qword) returns the upper/lower word/dword'#000+ + '04023_E_Integer or real expression expected'#000+ + '04024_E_Wrong type "$1" in array constructor'#000+ + '04025_','E_Incompatible type for arg no. $1: Got "$2", expected "$3"'#000+ + '04026_E_Method (variable) and Procedure (variable) are not compatible'#000+ + '04027_E_Illegal constant passed to internal math function'#000+ + '04028_E_Can'#039't take the address of constant expressio','ns'#000+ + '04029_E_Argument can'#039't be assigned to'#000+ + '04030_E_Can'#039't assign local procedure/function to procedure variabl'+ + 'e'#000+ + '04031_E_Can'#039't assign values to an address'#000+ + '04032_E_Can'#039't assign values to const variable'#000+ + '04033_E_Array type required'#000+ + '04034_E_interfa','ce type expected, but got "$1"'#000+ + '04035_H_Mixing signed expressions and longwords gives a 64bit result'#000+ + '04036_W_Mixing signed expressions and cardinals here may cause a range'+ + ' check error'#000+ + '04037_E_Typecast has different size ($1 -> $2) in assignm','ent'#000+ + '04038_E_enums with assignments can'#039't be used as array index'#000+ + '04039_E_Class or Object types "$1" and "$2" are not related'#000+ + '04040_W_Class types "$1" and "$2" are not related'#000+ + '04041_E_Class or interface type expected, but got "$1"'#000+ + '04042_E_Typ','e "$1" is not completely defined'#000+ + '04043_W_String literal has more characters than short string length'#000+ + '04044_W_Comparison might be always false due to range of constant and '+ + 'expression'#000+ + '04045_W_Comparison might be always true due to range of co','nstant and'+ + ' expression'#000+ + '04046_W_Constructing a class "$1" with abstract method "$2"'#000+ + '04047_H_The left operand of the IN operator should be byte sized'#000+ + '04048_W_Type size mismatch, possible loss of data / range check error'#000+ + '04049_H_Type size misma','tch, possible loss of data / range check erro'+ + 'r'#000+ + '04050_E_The address of an abstract method can'#039't be taken'#000+ + '04051_E_Assignments to formal parameters and open arrays are not possi'+ + 'ble'#000+ + '04052_E_Constant Expression expected'#000+ + '04053_E_Operation "$1" no','t supported for types "$2" and "$3"'#000+ + '04054_E_Illegal type conversion: "$1" to "$2"'#000+ + '04055_H_Conversion between ordinals and pointers is not portable'#000+ + '04056_W_Conversion between ordinals and pointers is not portable'#000+ + '04057_E_Can'#039't determine whic','h overloaded function to call'#000+ + '04058_E_Illegal counter variable'#000+ + '04059_W_Converting constant real value to double for C variable argume'+ + 'nt, add explicit typecast to prevent this.'#000+ + '04060_E_Class or COM interface type expected, but got "$1"'#000+ + '04061','_E_Constant packed arrays are not yet supported'#000+ + '04062_E_Incompatible type for arg no. $1: Got "$2" expected "(Bit)Pack'+ + 'ed Array"'#000+ + '04063_E_Incompatible type for arg no. $1: Got "$2" expected "(not pack'+ + 'ed) Array"'#000+ + '04064_E_Elements of packed arra','ys cannot be of a type which need to '+ + 'be initialised'#000+ + '04065_E_Constant packed records and objects are not yet supported'#000+ + '04066_W_Arithmetic "$1" on untyped pointer is unportable to {$T+}, sug'+ + 'gest typecast'#000+ + '04076_E_Can'#039't take address of a subrou','tine marked as local'#000+ + '04077_E_Can'#039't export subroutine marked as local from a unit'#000+ + '04078_E_Type is not automatable: "$1"'#000+ + '04079_H_Converting the operands to "$1" before doing the add could pre'+ + 'vent overflow errors.'#000+ + '04080_H_Converting the operan','ds to "$1" before doing the subtract co'+ + 'uld prevent overflow errors.'#000+ + '04081_H_Converting the operands to "$1" before doing the multiply coul'+ + 'd prevent overflow errors.'#000+ + '04082_W_Converting pointers to signed integers may result in wrong com'+ + 'paris','on results and range errors, use an unsigned type instead.'#000+ + '04083_E_Interface type $1 has no valid GUID'#000+ + '04084_E_Invalid selector name "$1"'#000+ + '04085_E_Expected Objective-C method, but got $1'#000+ + '04086_E_Expected Objective-C method or constant method',' name'#000+ + '04087_E_No type info available for this type'#000+ + '04088_E_Ordinal or string expression expected'#000+ + '04089_E_String expression expected'#000+ + '04090_W_Converting 0 to NIL'#000+ + '04091_E_Objective-C protocol type expected, but got "$1"'#000+ + '04092_E_The type "$1" i','s not supported for interaction with the Obje'+ + 'ctive-C runtime.'#000+ + '04093_E_Class or objcclass type expected, but got "$1"'#000+ + '04094_E_Objcclass type expected'#000+ + '04095_W_Coerced univ parameter type in procedural variable may cause c'+ + 'rash or memory corrup','tion: $1 to $2'#000+ + '04096_E_Type parameters of specializations of generics cannot referenc'+ + 'e the currently specialized type'#000+ + '04097_E_Type parameters are not allowed on non-generic class/record/ob'+ + 'ject procedure or function'#000+ + '04098_E_Generic declarati','on of "$1" differs from previous declaratio'+ + 'n'#000+ + '04099_E_Helper type expected'#000+ + '04100_E_Record type expected'#000+ + '04101_E_Derived class helper must extend a subclass of "$1" or the cla'+ + 'ss itself'#000+ + '04102_E_Derived record helper must extend "$1"'#000+ + '04103_E_In','valid assignment, procedures return no value'#000+ + '04104_W_Implicit string type conversion from "$1" to "$2"'#000+ + '04105_W_Implicit string type conversion with potential data loss from '+ + '"$1" to "$2"'#000+ + '04106_-W_Explicit string typecast from "$1" to "$2"'#000+ + '04','107_-W_Explicit string typecast with potential data loss from "$1"'+ + ' to "$2"'#000+ + '04108_W_Unicode constant cast with potential data loss'#000+ + '05000_E_Identifier not found "$1"'#000+ + '05001_F_Internal Error in SymTableStack()'#000+ + '05002_E_Duplicate identifier "$1"'#000, + '05003_H_Identifier already defined in $1 at line $2'#000+ + '05004_E_Unknown identifier "$1"'#000+ + '05005_E_Forward declaration not solved "$1"'#000+ + '05007_E_Error in type definition'#000+ + '05009_E_Forward type not resolved "$1"'#000+ + '05010_E_Only static variables can be use','d in static methods or outsi'+ + 'de methods'#000+ + '05012_F_record or class type expected'#000+ + '05013_E_Instances of classes or objects with an abstract method are no'+ + 't allowed'#000+ + '05014_W_Label not defined "$1"'#000+ + '05015_E_Label used but not defined "$1"'#000+ + '05016_E_Ille','gal label declaration'#000+ + '05017_E_GOTO and LABEL are not supported (use switch -Sg)'#000+ + '05018_E_Label not found'#000+ + '05019_E_identifier isn'#039't a label'#000+ + '05020_E_label already defined'#000+ + '05021_E_illegal type declaration of set elements'#000+ + '05022_E_Forward class de','finition not resolved "$1"'#000+ + '05023_H_Unit "$1" not used in $2'#000+ + '05024_H_Parameter "$1" not used'#000+ + '05025_N_Local variable "$1" not used'#000+ + '05026_H_Value parameter "$1" is assigned but never used'#000+ + '05027_N_Local variable "$1" is assigned but never used'#000, + '05028_H_Local $1 "$2" is not used'#000+ + '05029_N_Private field "$1.$2" is never used'#000+ + '05030_N_Private field "$1.$2" is assigned but never used'#000+ + '05031_N_Private method "$1.$2" never used'#000+ + '05032_E_Set type expected'#000+ + '05033_W_Function result does not seem',' to be set'#000+ + '05034_W_Type "$1" is not aligned correctly in current record for C'#000+ + '05035_E_Unknown record field identifier "$1"'#000+ + '05036_W_Local variable "$1" does not seem to be initialized'#000+ + '05037_W_Variable "$1" does not seem to be initialized'#000+ + '050','38_E_identifier idents no member "$1"'#000+ + '05039_H_Found declaration: $1'#000+ + '05040_E_Data element too large'#000+ + '05042_E_No matching implementation for interface method "$1" found'#000+ + '05043_W_Symbol "$1" is deprecated'#000+ + '05044_W_Symbol "$1" is not portable'#000+ + '0505','5_W_Symbol "$1" is not implemented'#000+ + '05056_E_Can'#039't create unique type from this type'#000+ + '05057_H_Local variable "$1" does not seem to be initialized'#000+ + '05058_H_Variable "$1" does not seem to be initialized'#000+ + '05059_W_Function result variable does not s','eem to initialized'#000+ + '05060_H_Function result variable does not seem to be initialized'#000+ + '05061_W_Variable "$1" read but nowhere assigned'#000+ + '05062_H_Found abstract method: $1'#000+ + '05063_W_Symbol "$1" is experimental'#000+ + '05064_W_Forward declaration "$1" not r','esolved, assumed external'#000+ + '05065_W_Symbol "$1" is belongs to a library'#000+ + '05066_W_Symbol "$1" is deprecated: "$2"'#000+ + '05067_E_Cannot find an enumerator for the type "$1"'#000+ + '05068_E_Cannot find a "MoveNext" method in enumerator "$1"'#000+ + '05069_E_Cannot find',' a "Current" property in enumerator "$1"'#000+ + '05070_E_Mismatch between number of declared parameters and number of c'+ + 'olons in message string.'#000+ + '05071_N_Private type "$1.$2" never used'#000+ + '05072_N_Private const "$1.$2" never used'#000+ + '05073_N_Private propert','y "$1.$2" never used'#000+ + '05074_W_Unit "$1" is deprecated'#000+ + '05075_W_Unit "$1" is deprecated: "$2"'#000+ + '05076_W_Unit "$1" is not portable'#000+ + '05077_W_Unit "$1" is belongs to a library'#000+ + '05078_W_Unit "$1" is not implemented'#000+ + '05079_W_Unit "$1" is experimental'#000+ + '05','080_E_No complete definition of the formally declared objcclass "$'+ + '1" is in scope'#000+ + '05081_E_Gotos into initialization or finalization blocks of units are '+ + 'not allowed'#000+ + '05082_E_Invalid external name "$1" for formal class "$2"'#000+ + '05083_E_Complete cla','ss definition with external name "$1" here'#000+ + '05084_W_Possible library conflict: symbol "$1" from library "$2" also '+ + 'found in library "$3"'#000+ + '06009_E_Parameter list size exceeds 65535 bytes'#000+ + '06012_E_File types must be var parameters'#000+ + '06013_E_The use',' of a far pointer isn'#039't allowed there'#000+ + '06015_E_EXPORT declared functions can'#039't be called'#000+ + '06016_W_Possible illegal call of constructor or destructor'#000+ + '06017_N_Inefficient code'#000+ + '06018_W_unreachable code'#000+ + '06020_E_Abstract methods can'#039't be called di','rectly'#000+ + '06027_DL_Register $1 weight $2 $3'#000+ + '06029_DL_Stack frame is omitted'#000+ + '06031_E_Object or class methods can'#039't be inline.'#000+ + '06032_E_Procvar calls cannot be inline.'#000+ + '06033_E_No code for inline procedure stored'#000+ + '06035_E_Element zero of an ansi/wi','de- or longstring can'#039't be acc'+ + 'essed, use (set)length instead'#000+ + '06037_E_Constructors or destructors cannot be called inside a '#039'wit'+ + 'h'#039' clause'#000+ + '06038_E_Cannot call message handler methods directly'#000+ + '06039_E_Jump in or outside of an exception block'#000+ + '0','6040_E_Control flow statements aren'#039't allowed in a finally bloc'+ + 'k'#000+ + '06041_W_Parameters size exceeds limit for certain cpu'#039's'#000+ + '06042_W_Local variable size exceed limit for certain cpu'#039's'#000+ + '06043_E_Local variables size exceeds supported limit'#000+ + '06044_E','_BREAK not allowed'#000+ + '06045_E_CONTINUE not allowed'#000+ + '06046_F_Unknown compilerproc "$1". Check if you use the correct run ti'+ + 'me library.'#000+ + '06047_F_Cannot find system type "$1". Check if you use the correct run'+ + ' time library.'#000+ + '06048_H_Inherited call to',' abstract method ignored'#000+ + '06049_E_Goto label "$1" not defined or optimized away'#000+ + '06050_F_Cannot find type "$1" in unit "$2". Check if you use the corre'+ + 'ct run time library.'#000+ + '06051_E_Interprocedural gotos are allowed only to outer subroutines'#000+ + '06','052_E_Label must be defined in the same scope as it is declared'#000+ + '06053_E_Leaving procedures containing explicit or implicit exceptions '+ + 'frames using goto is not allowed'#000+ + '06054_E_In ISO mode, the mod operator is defined only for positive quo'+ + 'tie','nt'#000+ + '07000_DL_Starting $1 styled assembler parsing'#000+ + '07001_DL_Finished $1 styled assembler parsing'#000+ + '07002_E_Non-label pattern contains @'#000+ + '07004_E_Error building record offset'#000+ + '07005_E_OFFSET used without identifier'#000+ + '07006_E_TYPE used without identi','fier'#000+ + '07007_E_Cannot use local variable or parameters here'#000+ + '07008_E_need to use OFFSET here'#000+ + '07009_E_need to use $ here'#000+ + '07010_E_Cannot use multiple relocatable symbols'#000+ + '07011_E_Relocatable symbol can only be added'#000+ + '07012_E_Invalid constant expre','ssion'#000+ + '07013_E_Relocatable symbol is not allowed'#000+ + '07014_E_Invalid reference syntax'#000+ + '07015_E_You cannot reach $1 from that code'#000+ + '07016_E_Local symbols/labels aren'#039't allowed as references'#000+ + '07017_E_Invalid base and index register usage'#000+ + '07018_W_Poss','ible error in object field handling'#000+ + '07019_E_Wrong scale factor specified'#000+ + '07020_E_Multiple index register usage'#000+ + '07021_E_Invalid operand type'#000+ + '07022_E_Invalid string as opcode operand: $1'#000+ + '07023_W_@CODE and @DATA not supported'#000+ + '07024_E_Null labe','l references are not allowed'#000+ + '07025_E_Divide by zero in asm evaluator'#000+ + '07026_E_Illegal expression'#000+ + '07027_E_escape sequence ignored: $1'#000+ + '07028_E_Invalid symbol reference'#000+ + '07029_W_Fwait can cause emulation problems with emu387'#000+ + '07030_W_$1 without o','perand translated into $1P'#000+ + '07031_W_ENTER instruction is not supported by Linux kernel'#000+ + '07032_W_Calling an overload function in assembler'#000+ + '07033_E_Unsupported symbol type for operand'#000+ + '07034_E_Constant value out of bounds'#000+ + '07035_E_Error convertin','g decimal $1'#000+ + '07036_E_Error converting octal $1'#000+ + '07037_E_Error converting binary $1'#000+ + '07038_E_Error converting hexadecimal $1'#000+ + '07039_H_$1 translated to $2'#000+ + '07040_W_$1 is associated to an overloaded function'#000+ + '07041_E_Cannot use SELF outside a metho','d'#000+ + '07042_E_Cannot use OLDEBP outside a nested procedure'#000+ + '07043_W_Procedures can'#039't return any value in asm code'#000+ + '07044_E_SEG not supported'#000+ + '07045_E_Size suffix and destination or source size do not match'#000+ + '07046_W_Size suffix and destination or so','urce size do not match'#000+ + '07047_E_Assembler syntax error'#000+ + '07048_E_Invalid combination of opcode and operands'#000+ + '07049_E_Assembler syntax error in operand'#000+ + '07050_E_Assembler syntax error in constant'#000+ + '07051_E_Invalid String expression'#000+ + '07052_W_constant',' with symbol $1 for address which is not on a pointe'+ + 'r'#000+ + '07053_E_Unrecognized opcode $1'#000+ + '07054_E_Invalid or missing opcode'#000+ + '07055_E_Invalid combination of prefix and opcode: $1'#000+ + '07056_E_Invalid combination of override and opcode: $1'#000+ + '07057_E_Too m','any operands on line'#000+ + '07058_W_NEAR ignored'#000+ + '07059_W_FAR ignored'#000+ + '07060_E_Duplicate local symbol $1'#000+ + '07061_E_Undefined local symbol $1'#000+ + '07062_E_Unknown label identifier $1'#000+ + '07063_E_Invalid register name'#000+ + '07064_E_Invalid floating point register name',#000+ + '07066_W_Modulo not supported'#000+ + '07067_E_Invalid floating point constant $1'#000+ + '07068_E_Invalid floating point expression'#000+ + '07069_E_Wrong symbol type'#000+ + '07070_E_Cannot index a local var or parameter with a register'#000+ + '07071_E_Invalid segment override expr','ession'#000+ + '07072_W_Identifier $1 supposed external'#000+ + '07073_E_Strings not allowed as constants'#000+ + '07074_E_No type of variable specified'#000+ + '07075_E_assembler code not returned to text section'#000+ + '07076_E_Not a directive or local symbol $1'#000+ + '07077_E_Using a def','ined name as a local label'#000+ + '07078_E_Dollar token is used without an identifier'#000+ + '07079_W_32bit constant created for address'#000+ + '07080_N_.align is target specific, use .balign or .p2align'#000+ + '07081_E_Can'#039't access fields directly for parameters'#000+ + '07082_E_','Can'#039't access fields of objects/classes directly'#000+ + '07083_E_No size specified and unable to determine the size of the oper'+ + 'ands'#000+ + '07084_E_Cannot use RESULT in this function'#000+ + '07086_W_"$1" without operand translated into "$1 %st,%st(1)"'#000+ + '07087_W_"$1 %','st(n)" translated into "$1 %st,%st(n)"'#000+ + '07088_W_"$1 %st(n)" translated into "$1 %st(n),%st"'#000+ + '07089_E_Char < not allowed here'#000+ + '07090_E_Char > not allowed here'#000+ + '07093_W_ALIGN not supported'#000+ + '07094_E_Inc and Dec cannot be together'#000+ + '07095_E_Invalid re','glist for movem'#000+ + '07096_E_Reglist invalid for opcode'#000+ + '07097_E_Higher cpu mode required ($1)'#000+ + '07098_W_No size specified and unable to determine the size of the oper'+ + 'ands, using DWORD as default'#000+ + '07099_E_Syntax error while trying to parse a shifter',' operand'#000+ + '07100_E_Address of packed component is not at a byte boundary'#000+ + '07101_W_No size specified and unable to determine the size of the oper'+ + 'ands, using BYTE as default'#000+ + '07102_W_Use of +offset(%ebp) for parameters invalid here'#000+ + '07103_W_Use of',' +offset(%ebp) is not compatible with regcall conventi'+ + 'on'#000+ + '07104_W_Use of -offset(%ebp) is not recommended for local variable acc'+ + 'ess'#000+ + '07105_W_Use of -offset(%esp), access may cause a crash or value may be'+ + ' lost'#000+ + '07106_E_VMTOffset must be used in',' combination with a virtual method,'+ + ' and "$1" is not virtual'#000+ + '07107_E_Generating PIC, but reference is not PIC-safe'#000+ + '07108_E_All registers in a register set must be of the same kind and w'+ + 'idth'#000+ + '07109_E_A register set cannot be empty'#000+ + '07110_W_@GOT','PCREL is useless and potentially dangereous for local sy'+ + 'mbols'#000+ + '07111_W_Constant with general purpose segment register'#000+ + '07112_E_Invalid offset value for $1'#000+ + '07113_E_Invalid register for $1'#000+ + '07114_E_SEH directives are allowed only in pure assembl','er procedures'+ + #000+ + '07115_E_Directive "$1" is not supported for the current target'#000+ + '08000_F_Too many assembler files'#000+ + '08001_F_Selected assembler output not supported'#000+ + '08002_F_Comp not supported'#000+ + '08003_F_Direct not support for binary writers'#000+ + '08004_E_A','llocating of data is only allowed in bss section'#000+ + '08005_F_No binary writer selected'#000+ + '08006_E_Asm: Opcode $1 not in table'#000+ + '08007_E_Asm: $1 invalid combination of opcode and operands'#000+ + '08008_E_Asm: 16 Bit references not supported'#000+ + '08009_E_Asm: Inva','lid effective address'#000+ + '08010_E_Asm: Immediate or reference expected'#000+ + '08011_E_Asm: $1 value exceeds bounds $2'#000+ + '08012_E_Asm: Short jump is out of range $1'#000+ + '08013_E_Asm: Undefined label $1'#000+ + '08014_E_Asm: Comp type not supported for this target'#000+ + '08015','_E_Asm: Extended type not supported for this target'#000+ + '08016_E_Asm: Duplicate label $1'#000+ + '08017_E_Asm: Redefined label $1'#000+ + '08018_E_Asm: First defined here'#000+ + '08019_E_Asm: Invalid register $1'#000+ + '08020_E_Asm: 16 or 32 Bit references not supported'#000+ + '08021_E_','Asm: 64 Bit operands not supported'#000+ + '08022_E_Asm: AH,BH,CH or DH cannot be used in an instruction requiring'+ + ' REX prefix'#000+ + '08023_E_Missing .seh_endprologue directive'#000+ + '08024_E_Function prologue exceeds 255 bytes'#000+ + '08025_E_.seh_handlerdata directive w','ithout preceding .seh_handler'#000+ + '09000_W_Source operating system redefined'#000+ + '09001_I_Assembling (pipe) $1'#000+ + '09002_E_Can'#039't create assembler file: $1'#000+ + '09003_E_Can'#039't create object file: $1 (error code: $2)'#000+ + '09004_E_Can'#039't create archive file: $1'#000+ + '09005_E','_Assembler $1 not found, switching to external assembling'#000+ + '09006_T_Using assembler: $1'#000+ + '09007_E_Error while assembling exitcode $1'#000+ + '09008_E_Can'#039't call the assembler, error $1 switching to external a'+ + 'ssembling'#000+ + '09009_I_Assembling $1'#000+ + '09010_I_Assem','bling with smartlinking $1'#000+ + '09011_W_Object $1 not found, Linking may fail !'#000+ + '09012_W_Library $1 not found, Linking may fail !'#000+ + '09013_E_Error while linking'#000+ + '09014_E_Can'#039't call the linker, switching to external linking'#000+ + '09015_I_Linking $1'#000+ + '09016_E_','Util $1 not found, switching to external linking'#000+ + '09017_T_Using util $1'#000+ + '09018_E_Creation of Executables not supported'#000+ + '09019_E_Creation of Dynamic/Shared Libraries not supported'#000+ + '09020_I_Closing script $1'#000+ + '09021_E_resource compiler "$1" not fou','nd, switching to external mode'+ + #000+ + '09022_I_Compiling resource $1'#000+ + '09023_T_unit $1 can'#039't be statically linked, switching to smart lin'+ + 'king'#000+ + '09024_T_unit $1 can'#039't be smart linked, switching to static linking'+ + #000+ + '09025_T_unit $1 can'#039't be shared linked, s','witching to static link'+ + 'ing'#000+ + '09026_E_unit $1 can'#039't be smart or static linked'#000+ + '09027_E_unit $1 can'#039't be shared or static linked'#000+ + '09028_D_Calling resource compiler "$1" with "$2" as command line'#000+ + '09029_E_Error while compiling resources'#000+ + '09030_E_Can',#039't call the resource compiler "$1", switching to extern'+ + 'al mode'#000+ + '09031_E_Can'#039't open resource file "$1"'#000+ + '09032_E_Can'#039't write resource file "$1"'#000+ + '09033_N_File "$1" not found for backquoted cat command'#000+ + '09128_F_Can'#039't post process executable $1'#000+ + '0912','9_F_Can'#039't open executable $1'#000+ + '09130_X_Size of Code: $1 bytes'#000+ + '09131_X_Size of initialized data: $1 bytes'#000+ + '09132_X_Size of uninitialized data: $1 bytes'#000+ + '09133_X_Stack space reserved: $1 bytes'#000+ + '09134_X_Stack space committed: $1 bytes'#000+ + '09200_F_Execu','table image size is too big for $1 target.'#000+ + '09201_W_Object file "$1" contains 32-bit absolute relocation to symbol'+ + ' "$2".'#000+ + '10000_T_Unitsearch: $1'#000+ + '10001_T_PPU Loading $1'#000+ + '10002_U_PPU Name: $1'#000+ + '10003_U_PPU Flags: $1'#000+ + '10004_U_PPU Crc: $1'#000+ + '10005_U_PPU',' Time: $1'#000+ + '10006_U_PPU File too short'#000+ + '10007_U_PPU Invalid Header (no PPU at the begin)'#000+ + '10008_U_PPU Invalid Version $1'#000+ + '10009_U_PPU is compiled for another processor'#000+ + '10010_U_PPU is compiled for another target'#000+ + '10011_U_PPU Source: $1'#000+ + '10012_U_Wri','ting $1'#000+ + '10013_F_Can'#039't Write PPU-File'#000+ + '10014_F_Error reading PPU-File'#000+ + '10015_F_unexpected end of PPU-File'#000+ + '10016_F_Invalid PPU-File entry: $1'#000+ + '10017_F_PPU Dbx count problem'#000+ + '10018_E_Illegal unit name: $1'#000+ + '10019_F_Too much units'#000+ + '10020_F_Circular un','it reference between $1 and $2'#000+ + '10021_F_Can'#039't compile unit $1, no sources available'#000+ + '10022_F_Can'#039't find unit $1 used by $2'#000+ + '10023_W_Unit $1 was not found but $2 exists'#000+ + '10024_F_Unit $1 searched but $2 found'#000+ + '10025_W_Compiling the system unit req','uires the -Us switch'#000+ + '10026_F_There were $1 errors compiling module, stopping'#000+ + '10027_U_Load from $1 ($2) unit $3'#000+ + '10028_U_Recompiling $1, checksum changed for $2'#000+ + '10029_U_Recompiling $1, source found only'#000+ + '10030_U_Recompiling unit, static lib is',' older than ppufile'#000+ + '10031_U_Recompiling unit, shared lib is older than ppufile'#000+ + '10032_U_Recompiling unit, obj and asm are older than ppufile'#000+ + '10033_U_Recompiling unit, obj is older than asm'#000+ + '10034_U_Parsing interface of $1'#000+ + '10035_U_Parsing impl','ementation of $1'#000+ + '10036_U_Second load for unit $1'#000+ + '10037_U_PPU Check file $1 time $2'#000+ + '10040_W_Can'#039't recompile unit $1, but found modifed include files'#000+ + '10041_U_File $1 is newer than the one used for creating PPU file $2'#000+ + '10042_U_Trying to use a ','unit which was compiled with a different FPU'+ + ' mode'#000+ + '10043_U_Loading interface units from $1'#000+ + '10044_U_Loading implementation units from $1'#000+ + '10045_U_Interface CRC changed for unit $1'#000+ + '10046_U_Implementation CRC changed for unit $1'#000+ + '10047_U_Finished',' compiling unit $1'#000+ + '10048_U_Adding dependency: $1 depends on $2'#000+ + '10049_U_No reload, is caller: $1'#000+ + '10050_U_No reload, already in second compile: $1'#000+ + '10051_U_Flag for reload: $1'#000+ + '10052_U_Forced reloading'#000+ + '10053_U_Previous state of $1: $2'#000+ + '10054_U_A','lready compiling $1, setting second compile'#000+ + '10055_U_Loading unit $1'#000+ + '10056_U_Finished loading unit $1'#000+ + '10057_U_Registering new unit $1'#000+ + '10058_U_Re-resolving unit $1'#000+ + '10059_U_Skipping re-resolving unit $1, still loading used units'#000+ + '10060_U_Unload','ing resource unit $1 (not needed)'#000+ + '10061_E_Unit $1 was compiled using a different whole program optimizat'+ + 'ion feedback input ($2, $3); recompile it without wpo or use the same '+ + 'wpo feedback input file for this compilation invocation'#000+ + '10062_U_In','direct interface (objects/classes) CRC changed for unit $1'+ + #000+ + '11000_O_$1 [options] <inputfile> [options]'#000+ + '11001_W_Only one source file supported, changing source file to compil'+ + 'e from "$1" into "$2"'#000+ + '11002_W_DEF file can be created only for OS/2'#000, + '11003_E_nested response files are not supported'#000+ + '11004_F_No source file name in command line'#000+ + '11005_N_No option inside $1 config file'#000+ + '11006_E_Illegal parameter: $1'#000+ + '11007_H_-? writes help pages'#000+ + '11008_F_Too many config files nested'#000+ + '11009_F_Unab','le to open file $1'#000+ + '11010_D_Reading further options from $1'#000+ + '11011_W_Target is already set to: $1'#000+ + '11012_W_Shared libs not supported on DOS platform, reverting to static'+ + #000+ + '11013_F_In options file $1 at line $2 too many \var{\#IF(N)DEFs} encou'+ + 'nte','red'#000+ + '11014_F_In options file $1 at line $2 unexpected \var{\#ENDIFs} encoun'+ + 'tered'#000+ + '11015_F_Open conditional at the end of the options file'#000+ + '11016_W_Debug information generation is not supported by this executab'+ + 'le'#000+ + '11017_H_Try recompiling with -d','GDB'#000+ + '11018_W_You are using the obsolete switch $1'#000+ + '11019_W_You are using the obsolete switch $1, please use $2'#000+ + '11020_N_Switching assembler to default source writing assembler'#000+ + '11021_W_Assembler output selected "$1" is not compatible with "$2"'#000, + '11022_W_"$1" assembler use forced'#000+ + '11026_T_Reading options from file $1'#000+ + '11027_T_Reading options from environment $1'#000+ + '11028_D_Handling option "$1"'#000+ + '11029_O_*** press enter ***'#000+ + '11030_H_Start of reading config file $1'#000+ + '11031_H_End of reading confi','g file $1'#000+ + '11032_D_interpreting option "$1"'#000+ + '11036_D_interpreting firstpass option "$1"'#000+ + '11033_D_interpreting file option "$1"'#000+ + '11034_D_Reading config file "$1"'#000+ + '11035_D_found source file name "$1"'#000+ + '11039_E_Unknown codepage'#000+ + '11040_F_Config file $1',' is a directory'#000+ + '11041_W_Assembler output selected "$1" cannot generate debug info, deb'+ + 'ugging disabled'#000+ + '11042_W_Use of ppc386.cfg is deprecated, please use fpc.cfg instead'#000+ + '11043_F_In options file $1 at line $2 \var{\#ELSE} directive without \', + 'var{\#IF(N)DEF} found'#000+ + '11044_F_Option "$1" is not, or not yet, supported on the current targe'+ + 't platform'#000+ + '11045_F_The feature "$1" is not, or not yet, supported on the selected'+ + ' target platform'#000+ + '11046_N_DWARF debug information cannot be used wit','h smart linking on'+ + ' this target, switching to static linking'#000+ + '11047_W_Option "$1" is ignored for the current target platform.'#000+ + '11048_W_Disabling external debug information because it is unsupported'+ + ' for the selected target/debug format combinat','ion.'#000+ + '11049_N_DWARF debug information cannot be used with smart linking with'+ + ' external assembler, disabling static library creation.'#000+ + '12000_F_Cannot open whole program optimization feedback file "$1"'#000+ + '12001_D_Processing whole program optimizati','on information in wpo fee'+ + 'dback file "$1"'#000+ + '12002_D_Finished processing the whole program optimization information'+ + ' in wpo feedback file "$1"'#000+ + '12003_E_Expected section header, but got "$2" at line $1 of wpo feedba'+ + 'ck file'#000+ + '12004_W_No handler regis','tered for whole program optimization section'+ + ' "$2" at line $1 of wpo feedback file, ignoring'#000+ + '12005_D_Found whole program optimization section "$1" with information'+ + ' about "$2"'#000+ + '12006_F_The selected whole program optimizations require a previou','sl'+ + 'y generated feedback file (use -Fw to specify)'#000+ + '12007_E_No collected information necessary to perform "$1" whole progr'+ + 'am optimization found'#000+ + '12008_F_Specify a whole program optimization feedback file to store th'+ + 'e generated info in (using -F','W)'#000+ + '12009_E_Not generating any whole program optimization information, yet'+ + ' a feedback file was specified (using -FW)'#000+ + '12010_E_Not performing any whole program optimizations, yet an input f'+ + 'eedback file was specified (using -Fw)'#000+ + '12011_D_Skippin','g whole program optimization section "$1", because no'+ + 't needed by the requested optimizations'#000+ + '12012_W_Overriding previously read information for "$1" from feedback '+ + 'input file using information in section "$2"'#000+ + '12013_E_Cannot extract symbol li','veness information from program when'+ + ' stripping symbols, use -Xs-'#000+ + '12014_E_Cannot extract symbol liveness information from program when w'+ + 'hen not linking'#000+ + '12015_F_Cannot find "$1" or "$2" to extract symbol liveness informatio'+ + 'n from linked progr','am'#000+ + '12016_E_Error during reading symbol liveness information produced by "'+ + '$1"'#000+ + '12017_F_Error executing "$1" (exitcode: $2) to extract symbol informat'+ + 'ion from linked program'#000+ + '12018_E_Collection of symbol liveness information can only help when ', + 'using smart linking, use -CX -XX'#000+ + '12019_E_Cannot create specified whole program optimisation feedback fi'+ + 'le "$1"'#000+ + '11023_Free Pascal Compiler version $FPCFULLVERSION [$FPCDATE] for $FPC'+ + 'CPU'#010+ + 'Copyright (c) 1993-2011 by Florian Klaempfl and others'#000, + '11024_Free Pascal Compiler version $FPCVERSION'#010+ + #010+ + 'Compiler Date : $FPCDATE'#010+ + 'Compiler CPU Target: $FPCCPU'#010+ + #010+ + 'Supported targets:'#010+ + ' $OSTARGETS'#010+ + #010+ + 'Supported CPU instruction sets:'#010+ + ' $INSTRUCTIONSETS'#010+ + #010+ + 'Supported FPU instruction sets:'#010+ + ' $FPUINSTRUCTI','ONSETS'#010+ + #010+ + 'Supported ABI targets:'#010+ + ' $ABITARGETS'#010+ + #010+ + 'Supported Optimizations:'#010+ + ' $OPTIMIZATIONS'#010+ + #010+ + 'Supported Whole Program Optimizations:'#010+ + ' All'#010+ + ' $WPOPTIMIZATIONS'#010+ + #010+ + 'Supported Microcontroller types:'#010+ + ' $CONTROLLERTYPES'#010+ + #010+ + 'This program comes under the GNU ','General Public Licence'#010+ + 'For more information read COPYING.FPC'#010+ + #010+ + 'Report bugs, suggestions, etc. to:'#010+ + ' http://bugs.freepascal.org'#010+ + 'or'#010+ + ' bugs@freepascal.org'#000+ + '11025_**0*_Put + after a boolean switch option to enable it',', - to di'+ + 'sable it'#010+ + '**1a_The compiler doesn'#039't delete the generated assembler file'#010+ + '**2al_List sourcecode lines in assembler file'#010+ + '**2an_List node info in assembler file'#010+ + '*L2ap_Use pipes instead of creating temporary assembler files'#010+ + '**2ar_List re','gister allocation/release info in assembler file'#010+ + '**2at_List temp allocation/release info in assembler file'#010+ + '**1A<x>_Output format:'#010+ + '**2Adefault_Use default assembler'#010+ + '3*2Aas_Assemble using GNU AS'#010+ + '3*2Amacho_Mach-O (Darwin, Intel 32 bit) using i','nternal writer'#010+ + '3*2Anasmcoff_COFF (Go32v2) file using Nasm'#010+ + '3*2Anasmelf_ELF32 (Linux) file using Nasm'#010+ + '3*2Anasmwin32_Win32 object file using Nasm'#010+ + '3*2Anasmwdosx_Win32/WDOSX object file using Nasm'#010+ + '3*2Awasm_Obj file using Wasm (Watcom)'#010+ + '3*2Anasmob','j_Obj file using Nasm'#010+ + '3*2Amasm_Obj file using Masm (Microsoft)'#010+ + '3*2Atasm_Obj file using Tasm (Borland)'#010+ + '3*2Aelf_ELF (Linux) using internal writer'#010+ + '3*2Acoff_COFF (Go32v2) using internal writer'#010+ + '3*2Apecoff_PE-COFF (Win32) using internal writer'#010+ + '4*','2Aas_Assemble using GNU AS'#010+ + '4*2Agas_Assemble using GNU GAS'#010+ + '4*2Agas-darwin_Assemble darwin Mach-O64 using GNU GAS'#010+ + '4*2Amasm_Win64 object file using ml64 (Microsoft)'#010+ + '4*2Apecoff_PE-COFF (Win64) using internal writer'#010+ + '4*2Aelf_ELF (Linux-64bit) usi','ng internal writer'#010+ + '6*2Aas_Unix o-file using GNU AS'#010+ + '6*2Agas_GNU Motorola assembler'#010+ + '6*2Amit_MIT Syntax (old GAS)'#010+ + '6*2Amot_Standard Motorola assembler'#010+ + 'A*2Aas_Assemble using GNU AS'#010+ + 'P*2Aas_Assemble using GNU AS'#010+ + 'S*2Aas_Assemble using GNU AS'#010+ + '**1b_G','enerate browser info'#010+ + '**2bl_Generate local symbol info'#010+ + '**1B_Build all modules'#010+ + '**1C<x>_Code generation options:'#010+ + '**2C3<x>_Turn on ieee error checking for constants'#010+ + '**2Ca<x>_Select ABI, see fpc -i for possible values'#010+ + '**2Cb_Generate big-endian c','ode'#010+ + '**2Cc<x>_Set default calling convention to <x>'#010+ + '**2CD_Create also dynamic library (not supported)'#010+ + '**2Ce_Compilation with emulated floating point opcodes'#010+ + '**2Cf<x>_Select fpu instruction set to use, see fpc -i for possible va'+ + 'lues'#010+ + '**2CF<x>_','Minimal floating point constant precision (default, 32, 64)'+ + #010+ + '**2Cg_Generate PIC code'#010+ + '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+ + '**2Ci_IO-checking'#010+ + '**2Cn_Omit linking stage'#010+ + '**2Co_Check overflow of integer operations'#010+ + '**2CO_Check for po','ssible overflow of integer operations'#010+ + '**2Cp<x>_Select instruction set, see fpc -i for possible values'#010+ + '**2CP<x>=<y>_ packing settings'#010+ + '**3CPPACKSET=<y>_ <y> set allocation: 0, 1 or DEFAULT or NORMAL, 2, 4 '+ + 'and 8'#010+ + '**2Cr_Range checking'#010+ + '**2CR_Veri','fy object method call validity'#010+ + '**2Cs<n>_Set stack checking size to <n>'#010+ + '**2Ct_Stack checking (for testing only, see manual)'#010+ + '**2CX_Create also smartlinked library'#010+ + '**1d<x>_Defines the symbol <x>'#010+ + '**1D_Generate a DEF file'#010+ + '**2Dd<x>_Set descriptio','n to <x>'#010+ + '**2Dv<x>_Set DLL version to <x>'#010+ + '*O2Dw_PM application'#010+ + '**1e<x>_Set path to executable'#010+ + '**1E_Same as -Cn'#010+ + '**1fPIC_Same as -Cg'#010+ + '**1F<x>_Set file names and paths:'#010+ + '**2Fa<x>[,y]_(for a program) load units <x> and [y] before uses is par'+ + 'sed'#010+ + '**','2Fc<x>_Set input codepage to <x>'#010+ + '**2FC<x>_Set RC compiler binary name to <x>'#010+ + '**2Fd_Disable the compiler'#039's internal directory cache'#010+ + '**2FD<x>_Set the directory where to search for compiler utilities'#010+ + '**2Fe<x>_Redirect error output to <x>'#010+ + '**2Ff','<x>_Add <x> to framework path (Darwin only)'#010+ + '**2FE<x>_Set exe/unit output path to <x>'#010+ + '**2Fi<x>_Add <x> to include path'#010+ + '**2Fl<x>_Add <x> to library path'#010+ + '**2FL<x>_Use <x> as dynamic linker'#010+ + '**2Fm<x>_Load unicode conversion table from <x>.txt in',' the compiler '+ + 'dir'#010+ + '**2Fo<x>_Add <x> to object path'#010+ + '**2Fr<x>_Load error message file <x>'#010+ + '**2FR<x>_Set resource (.res) linker to <x>'#010+ + '**2Fu<x>_Add <x> to unit path'#010+ + '**2FU<x>_Set unit output path to <x>, overrides -FE'#010+ + '**2FW<x>_Store generated who','le-program optimization feedback in <x>'#010+ + '**2Fw<x>_Load previously stored whole-program optimization feedback fr'+ + 'om <x>'#010+ + '*g1g_Generate debug information (default format for target)'#010+ + '*g2gc_Generate checks for pointers'#010+ + '*g2gh_Use heaptrace unit (fo','r memory leak/corruption debugging)'#010+ + '*g2gl_Use line info unit (show more info with backtraces)'#010+ + '*g2go<x>_Set debug information options'#010+ + '*g3godwarfsets_ Enable DWARF '#039'set'#039' type debug information (bre'+ + 'aks gdb < 6.5)'#010+ + '*g3gostabsabsincludes_ Store a','bsolute/full include file paths in Sta'+ + 'bs'#010+ + '*g3godwarfmethodclassprefix_ Prefix method names in DWARF with class n'+ + 'ame'#010+ + '*g2gp_Preserve case in stabs symbol names'#010+ + '*g2gs_Generate Stabs debug information'#010+ + '*g2gt_Trash local variables (to detect unini','tialized uses)'#010+ + '*g2gv_Generates programs traceable with Valgrind'#010+ + '*g2gw_Generate DWARFv2 debug information (same as -gw2)'#010+ + '*g2gw2_Generate DWARFv2 debug information'#010+ + '*g2gw3_Generate DWARFv3 debug information'#010+ + '*g2gw4_Generate DWARFv4 debug inform','ation (experimental)'#010+ + '**1i_Information'#010+ + '**2iD_Return compiler date'#010+ + '**2iV_Return short compiler version'#010+ + '**2iW_Return full compiler version'#010+ + '**2iSO_Return compiler OS'#010+ + '**2iSP_Return compiler host processor'#010+ + '**2iTO_Return target OS'#010+ + '**2iTP_Return ta','rget processor'#010+ + '**1I<x>_Add <x> to include path'#010+ + '**1k<x>_Pass <x> to the linker'#010+ + '**1l_Write logo'#010+ + '**1M<x>_Set language mode to <x>'#010+ + '**2Mfpc_Free Pascal dialect (default)'#010+ + '**2Mobjfpc_FPC mode with Object Pascal support'#010+ + '**2Mdelphi_Delphi 7 compatib','ility mode'#010+ + '**2Mtp_TP/BP 7.0 compatibility mode'#010+ + '**2Mmacpas_Macintosh Pascal dialects compatibility mode'#010+ + '**1n_Do not read the default config files'#010+ + '**1N<x>_Node tree optimizations'#010+ + '**2Nu_Unroll loops'#010+ + '**1o<x>_Change the name of the executable pr','oduced to <x>'#010+ + '**1O<x>_Optimizations:'#010+ + '**2O-_Disable optimizations'#010+ + '**2O1_Level 1 optimizations (quick and debugger friendly)'#010+ + '**2O2_Level 2 optimizations (-O1 + quick optimizations)'#010+ + '**2O3_Level 3 optimizations (-O2 + slow optimizations)'#010+ + '**2Oa<','x>=<y>_Set alignment'#010+ + '**2Oo[NO]<x>_Enable or disable optimizations, see fpc -i for possible '+ + 'values'#010+ + '**2Op<x>_Set target cpu for optimizing, see fpc -i for possible values'+ + #010+ + '**2OW<x>_Generate whole-program optimization feedback for optimization'+ + ' ','<x>, see fpc -i for possible values'#010+ + '**2Ow<x>_Perform whole-program optimization <x>, see fpc -i for possib'+ + 'le values'#010+ + '**2Os_Optimize for size rather than speed'#010+ + '**1pg_Generate profile code for gprof (defines FPC_PROFILE)'#010+ + '**1R<x>_Assembler read','ing style:'#010+ + '**2Rdefault_Use default assembler for target'#010+ + '3*2Ratt_Read AT&T style assembler'#010+ + '3*2Rintel_Read Intel style assembler'#010+ + '6*2RMOT_Read motorola style assembler'#010+ + '**1S<x>_Syntax options:'#010+ + '**2S2_Same as -Mobjfpc'#010+ + '**2Sc_Support operators like',' C (*=,+=,/= and -=)'#010+ + '**2Sa_Turn on assertions'#010+ + '**2Sd_Same as -Mdelphi'#010+ + '**2Se<x>_Error options. <x> is a combination of the following:'#010+ + '**3*_<n> : Compiler halts after the <n> errors (default is 1)'#010+ + '**3*_w : Compiler also halts after warnings'#010+ + '**','3*_n : Compiler also halts after notes'#010+ + '**3*_h : Compiler also halts after hints'#010+ + '**2Sg_Enable LABEL and GOTO (default in -Mtp and -Mdelphi)'#010+ + '**2Sh_Use ansistrings by default instead of shortstrings'#010+ + '**2Si_Turn on inlining of procedures/functio','ns declared as "inline"'#010+ + '**2Sk_Load fpcylix unit'#010+ + '**2SI<x>_Set interface style to <x>'#010+ + '**3SIcom_COM compatible interface (default)'#010+ + '**3SIcorba_CORBA compatible interface'#010+ + '**2Sm_Support macros like C (global)'#010+ + '**2So_Same as -Mtp'#010+ + '**2Ss_Constructor ','name must be init (destructor must be done)'#010+ + '**2Sx_Enable exception keywords (default in Delphi/ObjFPC modes)'#010+ + '**2Sy_@<pointer> returns a typed pointer, same as $T+'#010+ + '**1s_Do not call assembler and linker'#010+ + '**2sh_Generate script to link on host'#010+ + '*','*2st_Generate script to link on target'#010+ + '**2sr_Skip register allocation phase (use with -alr)'#010+ + '**1T<x>_Target operating system:'#010+ + '3*2Tdarwin_Darwin/Mac OS X'#010+ + '3*2Temx_OS/2 via EMX (including EMX/RSX extender)'#010+ + '3*2Tfreebsd_FreeBSD'#010+ + '3*2Tgo32v2_Version',' 2 of DJ Delorie DOS extender'#010+ + '3*2Tiphonesim_ iPhoneSimulator from iOS SDK 3.2+ (older versions: -Tda'+ + 'rwin)'#010+ + '3*2Tlinux_Linux'#010+ + '3*2Tnetbsd_NetBSD'#010+ + '3*2Tnetware_Novell Netware Module (clib)'#010+ + '3*2Tnetwlibc_Novell Netware Module (libc)'#010+ + '3*2Topenbsd_OpenB','SD'#010+ + '3*2Tos2_OS/2 / eComStation'#010+ + '3*2Tsunos_SunOS/Solaris'#010+ + '3*2Tsymbian_Symbian OS'#010+ + '3*2Tsolaris_Solaris'#010+ + '3*2Twatcom_Watcom compatible DOS extender'#010+ + '3*2Twdosx_WDOSX DOS extender'#010+ + '3*2Twin32_Windows 32 Bit'#010+ + '3*2Twince_Windows CE'#010+ + '4*2Tdarwin_Darwin/Mac OS X',#010+ + '4*2Tlinux_Linux'#010+ + '4*2Twin64_Win64 (64 bit Windows systems)'#010+ + '6*2Tamiga_Commodore Amiga'#010+ + '6*2Tatari_Atari ST/STe/TT'#010+ + '6*2Tlinux_Linux'#010+ + '6*2Tpalmos_PalmOS'#010+ + 'A*2Tdarwin_Darwin/iPhoneOS/iOS'#010+ + 'A*2Tlinux_Linux'#010+ + 'A*2Twince_Windows CE'#010+ + 'P*2Tamiga_AmigaOS'#010+ + 'P*2Tdarwin','_Darwin/Mac OS X'#010+ + 'P*2Tlinux_Linux'#010+ + 'P*2Tmacos_Mac OS (classic)'#010+ + 'P*2Tmorphos_MorphOS'#010+ + 'S*2Tsolaris_Solaris'#010+ + 'S*2Tlinux_Linux'#010+ + '**1u<x>_Undefines the symbol <x>'#010+ + '**1U_Unit options:'#010+ + '**2Un_Do not check where the unit name matches the file name'#010+ + '**2Ur_Gener','ate release unit files (never automatically recompiled)'#010+ + '**2Us_Compile a system unit'#010+ + '**1v<x>_Be verbose. <x> is a combination of the following letters:'#010+ + '**2*_e : Show errors (default) 0 : Show nothing (except errors)'#010+ + '**2*_w : Show warni','ngs u : Show unit info'#010+ + '**2*_n : Show notes t : Show tried/used files'#010+ + '**2*_h : Show hints c : Show conditionals'#010+ + '**2*_i : Show general info d : Show debug info'#010+ + '**2*_l : Show linenumber','s r : Rhide/GCC compatibility mod'+ + 'e'#010+ + '**2*_s : Show time stamps q : Show message numbers'#010+ + '**2*_a : Show everything x : Executable info (Win32 only)'#010+ + '**2*_b : Write file names messages p : Write tree.log with p','arse t'+ + 'ree'#010+ + '**2*_ with full path v : Write fpcdebug.txt with'#010+ + '**2*_ lots of debugging info'#010+ + '**2*_m<x>,<y> : Don'#039't show messages numbered <x> and <y>'#010+ + '**1W<x>_Target-specific options (targets)'#010+ + '3*','2WA_Specify native type application (Windows)'#010+ + '4*2WA_Specify native type application (Windows)'#010+ + 'A*2WA_Specify native type application (Windows)'#010+ + '3*2Wb_Create a bundle instead of a library (Darwin)'#010+ + 'P*2Wb_Create a bundle instead of a library (Da','rwin)'#010+ + 'p*2Wb_Create a bundle instead of a library (Darwin)'#010+ + 'A*2Wb_Create a bundle instead of a library (Darwin)'#010+ + '4*2Wb_Create a bundle instead of a library (Darwin)'#010+ + '3*2WB_Create a relocatable image (Windows, Symbian)'#010+ + '3*2WBxxxx_Set image base t','o xxxx (Windows, Symbian)'#010+ + '4*2WB_Create a relocatable image (Windows)'#010+ + '4*2WBxxxx_Set image base to xxxx (Windows)'#010+ + 'A*2WB_Create a relocatable image (Windows, Symbian)'#010+ + 'A*2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+ + '3*2WC_Specify console ty','pe application (EMX, OS/2, Windows)'#010+ + '4*2WC_Specify console type application (EMX, OS/2, Windows)'#010+ + 'A*2WC_Specify console type application (Windows)'#010+ + 'P*2WC_Specify console type application (Classic Mac OS)'#010+ + '3*2WD_Use DEFFILE to export functions o','f DLL or EXE (Windows)'#010+ + '4*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+ + 'A*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+ + '3*2We_Use external resources (Darwin)'#010+ + '4*2We_Use external resources (Darwin)'#010+ + 'A*2We_Use externa','l resources (Darwin)'#010+ + 'P*2We_Use external resources (Darwin)'#010+ + 'p*2We_Use external resources (Darwin)'#010+ + '3*2WF_Specify full-screen type application (EMX, OS/2)'#010+ + '3*2WG_Specify graphic type application (EMX, OS/2, Windows)'#010+ + '4*2WG_Specify graphic type a','pplication (EMX, OS/2, Windows)'#010+ + 'A*2WG_Specify graphic type application (Windows)'#010+ + 'P*2WG_Specify graphic type application (Classic Mac OS)'#010+ + '3*2Wi_Use internal resources (Darwin)'#010+ + '4*2Wi_Use internal resources (Darwin)'#010+ + 'A*2Wi_Use internal resource','s (Darwin)'#010+ + 'P*2Wi_Use internal resources (Darwin)'#010+ + 'p*2Wi_Use internal resources (Darwin)'#010+ + '3*2WI_Turn on/off the usage of import sections (Windows)'#010+ + '4*2WI_Turn on/off the usage of import sections (Windows)'#010+ + 'A*2WI_Turn on/off the usage of import s','ections (Windows)'#010+ + '3*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+ + '4*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+ + 'A*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+ + 'A*2Wpxxxx_Sp','ecify the controller type, see fpc -i for possible value'+ + 's'#010+ + 'V*2Wpxxxx_Specify the controller type, see fpc -i for possible values'#010+ + '3*2WR_Generate relocation code (Windows)'#010+ + '4*2WR_Generate relocation code (Windows)'#010+ + 'A*2WR_Generate relocation code',' (Windows)'#010+ + 'P*2WT_Specify MPW tool type application (Classic Mac OS)'#010+ + '**2WX_Enable executable stack (Linux)'#010+ + '**1X_Executable options:'#010+ + '**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Lin'+ + 'ux)'#010+ + '**2Xd_Do not use standard library s','earch path (needed for cross comp'+ + 'ile)'#010+ + '**2Xe_Use external linker'#010+ + '**2Xg_Create debuginfo in a separate file and add a debuglink section '+ + 'to executable'#010+ + '**2XD_Try to link units dynamically (defines FPC_LINK_DYNAMIC)'#010+ + '**2Xi_Use internal linke','r'#010+ + '**2Xm_Generate link map'#010+ + '**2XM<x>_Set the name of the '#039'main'#039' program routine (default i'+ + 's '#039'main'#039')'#010+ + '**2XP<x>_Prepend the binutils names with the prefix <x>'#010+ + '**2Xr<x>_Set the linker'#039's rlink-path to <x> (needed for cross comp'+ + 'ile, see the ld manu','al for more information) (BeOS, Linux)'#010+ + '**2XR<x>_Prepend <x> to all linker search paths (BeOS, Darwin, FreeBSD'+ + ', Linux, Mac OS, Solaris)'#010+ + '**2Xs_Strip all symbols from executable'#010+ + '**2XS_Try to link units statically (default, defines FPC_LINK_STA','TIC'+ + ')'#010+ + '**2Xt_Link with static libraries (-static is passed to linker)'#010+ + '**2XX_Try to smartlink units (defines FPC_LINK_SMART)'#010+ + '**1*_'#010+ + '**1?_Show this help'#010+ + '**1h_Shows this help without waiting' +); diff --git a/closures/compiler/nadd.pas b/closures/compiler/nadd.pas new file mode 100644 index 0000000000..28666600c8 --- /dev/null +++ b/closures/compiler/nadd.pas @@ -0,0 +1,3070 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Type checking and simplification for add 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 nadd; + +{$i fpcdefs.inc} + +{ define addstringopt} + +interface + + uses + node,symtype; + + type + taddnode = class(tbinopnode) + private + resultrealdefderef: tderef; + function pass_typecheck_internal:tnode; + public + resultrealdef : tdef; + constructor create(tt : tnodetype;l,r : tnode);override; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function simplify(forinline: boolean) : tnode;override; + function dogetcopy : tnode;override; + function docompare(p: tnode): boolean; override; + {$ifdef state_tracking} + function track_state_pass(exec_known:boolean):boolean;override; + {$endif} + protected + { override the following if you want to implement } + { parts explicitely in the code generator (JM) } + function first_addstring: tnode; virtual; + function first_addset: tnode; virtual; + { only implements "muln" nodes, the rest always has to be done in } + { the code generator for performance reasons (JM) } + function first_add64bitint: tnode; virtual; + + { override and return false if you can handle 32x32->64 } + { bit multiplies directly in your code generator. If } + { this function is overridden to return false, you can } + { get multiplies with left/right both s32bit or u32bit, } + { and resultdef of the muln s64bit or u64bit } + function use_generic_mul32to64: boolean; virtual; + + { This routine calls internal runtime library helpers + for all floating point arithmetic in the case + where the emulation switches is on. Otherwise + returns nil, and everything must be done in + the code generation phase. + } + function first_addfloat : tnode; virtual; + private + { checks whether a muln can be calculated as a 32bit } + { * 32bit -> 64 bit } + function try_make_mul32to64: boolean; + { Match against the ranges, i.e.: + var a:1..10; + begin + if a>0 then + ... + always evaluates to true. (DM) + } + function cmp_of_disjunct_ranges(var res : boolean) : boolean; + end; + taddnodeclass = class of taddnode; + + var + { caddnode is used to create nodes of the add type } + { the virtual constructor allows to assign } + { another class type to caddnode => processor } + { specific node types can be created } + caddnode : taddnodeclass = taddnode; + +implementation + + uses +{$IFNDEF USE_FAKE_SYSUTILS} + sysutils, +{$ELSE} + fksysutl, +{$ENDIF} + globtype,systems,constexp, + cutils,verbose,globals,widestr, + symconst,symdef,symsym,symtable,defutil,defcmp, + cgbase, + htypechk,pass_1, + nld,nbas,nmat,ncnv,ncon,nset,nopt,ncal,ninl,nmem,nutils, + {$ifdef state_tracking} + nstate, + {$endif} + cpuinfo,procinfo; + + +{***************************************************************************** + TADDNODE +*****************************************************************************} + +{$maxfpuregisters 0} + + function getbestreal(t1,t2 : tdef) : tdef; + const + floatweight : array[tfloattype] of byte = + (2,3,4,5,0,1,6); + begin + if t1.typ=floatdef then + begin + result:=t1; + if t2.typ=floatdef then + begin + { when a comp or currency is used, use always the + best float type to calculate the result } + if (tfloatdef(t2).floattype in [s64comp,s64currency]) or + (tfloatdef(t2).floattype in [s64comp,s64currency]) then + result:=pbestrealtype^ + else + if floatweight[tfloatdef(t2).floattype]>floatweight[tfloatdef(t1).floattype] then + result:=t2; + end; + end + else if t2.typ=floatdef then + result:=t2 + else internalerror(200508061); + end; + + + constructor taddnode.create(tt : tnodetype;l,r : tnode); + begin + inherited create(tt,l,r); + end; + + + constructor taddnode.ppuload(t: tnodetype; ppufile: tcompilerppufile); + begin + inherited ppuload(t, ppufile); + ppufile.getderef(resultrealdefderef); + end; + + + procedure taddnode.ppuwrite(ppufile: tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(resultrealdefderef); + end; + + + procedure taddnode.buildderefimpl; + begin + inherited buildderefimpl; + resultrealdefderef.build(resultrealdef); + end; + + + procedure taddnode.derefimpl; + begin + inherited derefimpl; + resultrealdef:=tdef(resultrealdefderef.resolve); + end; + + + function taddnode.cmp_of_disjunct_ranges(var res : boolean) : boolean; + var + hp : tnode; + realdef : tdef; + v : tconstexprint; + begin + result:=false; + { check for comparision with known result because the ranges of the operands don't overlap } + if (is_constintnode(right) and (left.resultdef.typ=orddef) and + { don't ignore type checks } + is_subequal(right.resultdef,left.resultdef)) or + (is_constintnode(left) and (right.resultdef.typ=orddef) and + { don't ignore type checks } + is_subequal(left.resultdef,right.resultdef)) then + begin + if is_constintnode(right) then + begin + hp:=left; + v:=Tordconstnode(right).value; + end + else + begin + hp:=right; + v:=Tordconstnode(left).value; + end; + + realdef:=hp.resultdef; + { stop with finding the real def when we either encounter + a) an explicit type conversion (then the value has to be + re-interpreted) + b) an "absolute" type conversion (also requires + re-interpretation) + } + while (hp.nodetype=typeconvn) and + ([nf_internal,nf_explicit,nf_absolute] * hp.flags = []) do + begin + hp:=ttypeconvnode(hp).left; + realdef:=hp.resultdef; + end; + if is_constintnode(left) then + with torddef(realdef) do + case nodetype of + ltn: + if v<low then + begin + result:=true; + res:=true; + end + else if v>=high then + begin + result:=true; + res:=false; + end; + lten: + if v<=low then + begin + result:=true; + res:=true; + end + else if v>high then + begin + result:=true; + res:=false; + end; + gtn: + if v<=low then + begin + result:=true; + res:=false; + end + else if v>high then + begin + result:=true; + res:=true; + end; + gten : + if v<low then + begin + result:=true; + res:=false; + end + else if v>=high then + begin + result:=true; + res:=true; + end; + equaln: + if (v<low) or (v>high) then + begin + result:=true; + res:=false; + end; + unequaln: + if (v<low) or (v>high) then + begin + result:=true; + res:=true; + end; + end + else + with torddef(realdef) do + case nodetype of + ltn: + if high<v then + begin + result:=true; + res:=true; + end + else if low>=v then + begin + result:=true; + res:=false; + end; + lten: + if high<=v then + begin + result:=true; + res:=true; + end + else if low>v then + begin + result:=true; + res:=false; + end; + gtn: + if high<=v then + begin + result:=true; + res:=false; + end + else if low>v then + begin + result:=true; + res:=true; + end; + gten: + if high<v then + begin + result:=true; + res:=false; + end + else if low>=v then + begin + result:=true; + res:=true; + end; + equaln: + if (v<low) or (v>high) then + begin + result:=true; + res:=false; + end; + unequaln: + if (v<low) or (v>high) then + begin + result:=true; + res:=true; + end; + end; + end; + end; + + + function taddnode.simplify(forinline : boolean) : tnode; + var + t : tnode; + lt,rt : tnodetype; + rd,ld : tdef; + rv,lv,v : tconstexprint; + rvd,lvd : bestreal; + ws1,ws2 : pcompilerwidestring; + concatstrings : boolean; + c1,c2 : array[0..1] of char; + s1,s2 : pchar; + l1,l2 : longint; + resultset : Tconstset; + res, + b : boolean; + begin + result:=nil; + + { load easier access variables } + rd:=right.resultdef; + ld:=left.resultdef; + rt:=right.nodetype; + lt:=left.nodetype; + + if (nodetype = slashn) and + (((rt = ordconstn) and + (tordconstnode(right).value = 0)) or + ((rt = realconstn) and + (trealconstnode(right).value_real = 0.0))) then + begin + if floating_point_range_check_error then + begin + result:=crealconstnode.create(1,pbestrealtype^); + Message(parser_e_division_by_zero); + exit; + end; + end; + + { both are int constants } + if ( + ( + is_constintnode(left) and + is_constintnode(right) + ) or + ( + is_constboolnode(left) and + is_constboolnode(right) and + (nodetype in [slashn,ltn,lten,gtn,gten,equaln,unequaln,andn,xorn,orn]) + ) or + ( + is_constenumnode(left) and + is_constenumnode(right) and + allowenumop(nodetype)) + ) or + ( + (lt = pointerconstn) and + is_constintnode(right) and + (nodetype in [addn,subn]) + ) or + ( + (lt in [pointerconstn,niln]) and + (rt in [pointerconstn,niln]) and + (nodetype in [ltn,lten,gtn,gten,equaln,unequaln,subn]) + ) then + begin + t:=nil; + + { load values } + case lt of + ordconstn: + lv:=tordconstnode(left).value; + pointerconstn: + lv:=tpointerconstnode(left).value; + niln: + lv:=0; + else + internalerror(2002080202); + end; + case rt of + ordconstn: + rv:=tordconstnode(right).value; + pointerconstn: + rv:=tpointerconstnode(right).value; + niln: + rv:=0; + else + internalerror(2002080203); + end; + { type checking already took care of multiplying } + { integer constants with pointeddef.size if necessary } + case nodetype of + addn : + begin + v:=lv+rv; + if v.overflow then + begin + Message(parser_e_arithmetic_operation_overflow); + { Recover } + t:=genintconstnode(0) + end + else if (lt=pointerconstn) then + t := cpointerconstnode.create(qword(v),resultdef) + else + if is_integer(ld) then + t := create_simplified_ord_const(v,resultdef,forinline) + else + t := cordconstnode.create(v,resultdef,(ld.typ<>enumdef)); + end; + subn : + begin + v:=lv-rv; + if v.overflow then + begin + Message(parser_e_arithmetic_operation_overflow); + { Recover } + t:=genintconstnode(0) + end + else if (lt=pointerconstn) then + { pointer-pointer results in an integer } + if (rt=pointerconstn) then + begin + if not(nf_has_pointerdiv in flags) then + internalerror(2008030101); + t := cpointerconstnode.create(qword(v),resultdef) + end + else + t := cpointerconstnode.create(qword(v),resultdef) + else + if is_integer(ld) then + t := create_simplified_ord_const(v,resultdef,forinline) + else + t:=cordconstnode.create(v,resultdef,(ld.typ<>enumdef)); + end; + muln : + begin + v:=lv*rv; + if v.overflow then + begin + message(parser_e_arithmetic_operation_overflow); + { Recover } + t:=genintconstnode(0) + end + else + t := create_simplified_ord_const(v,resultdef,forinline) + end; + xorn : + if is_integer(ld) then + t := create_simplified_ord_const(lv xor rv,resultdef,forinline) + else + t:=cordconstnode.create(lv xor rv,resultdef,true); + orn : + if is_integer(ld) then + t:=create_simplified_ord_const(lv or rv,resultdef,forinline) + else + t:=cordconstnode.create(lv or rv,resultdef,true); + andn : + if is_integer(ld) then + t:=create_simplified_ord_const(lv and rv,resultdef,forinline) + else + t:=cordconstnode.create(lv and rv,resultdef,true); + ltn : + t:=cordconstnode.create(ord(lv<rv),pasbool8type,true); + lten : + t:=cordconstnode.create(ord(lv<=rv),pasbool8type,true); + gtn : + t:=cordconstnode.create(ord(lv>rv),pasbool8type,true); + gten : + t:=cordconstnode.create(ord(lv>=rv),pasbool8type,true); + equaln : + t:=cordconstnode.create(ord(lv=rv),pasbool8type,true); + unequaln : + t:=cordconstnode.create(ord(lv<>rv),pasbool8type,true); + slashn : + begin + { int/int becomes a real } + rvd:=rv; + lvd:=lv; + t:=crealconstnode.create(lvd/rvd,resultrealdef); + end; + else + internalerror(2008022101); + end; + result:=t; + exit; + end + else if cmp_of_disjunct_ranges(res) then + begin + if res then + t:=Cordconstnode.create(1,pasbool8type,true) + else + t:=Cordconstnode.create(0,pasbool8type,true); + { don't do this optimization, if the variable expression might + have a side effect } + if (is_constintnode(left) and might_have_sideeffects(right)) or + (is_constintnode(right) and might_have_sideeffects(left)) then + t.free + else + result:=t; + exit; + end; + + { Add,Sub,Mul with constant 0, 1 or -1? } + if is_constintnode(right) and is_integer(left.resultdef) then + begin + if tordconstnode(right).value = 0 then + begin + case nodetype of + addn,subn: + result := left.getcopy; + muln: + result:=cordconstnode.create(0,resultdef,true); + end; + end + else if tordconstnode(right).value = 1 then + begin + case nodetype of + muln: + result := left.getcopy; + end; + end +{$ifdef VER2_2} + else if (tordconstnode(right).value.svalue = -1) and (tordconstnode(right).value.signed) then +{$else} + else if tordconstnode(right).value = -1 then +{$endif} + begin + case nodetype of + muln: + result := cunaryminusnode.create(left.getcopy); + end; + end; + if assigned(result) then + exit; + end; + if is_constintnode(left) and is_integer(right.resultdef) then + begin + if tordconstnode(left).value = 0 then + begin + case nodetype of + addn: + result := right.getcopy; + subn: + result := cunaryminusnode.create(right.getcopy); + muln: + result:=cordconstnode.create(0,right.resultdef,true); + end; + end + else if tordconstnode(left).value = 1 then + begin + case nodetype of + muln: + result := right.getcopy; + end; + end +{$ifdef VER2_2} + else if (tordconstnode(left).value.svalue = -1) and (tordconstnode(left).value.signed) then +{$else} + else if tordconstnode(left).value = -1 then +{$endif} + begin + case nodetype of + muln: + result := cunaryminusnode.create(right.getcopy); + end; + end; + if assigned(result) then + exit; + end; + + { both real constants ? } + if (lt=realconstn) and (rt=realconstn) then + begin + lvd:=trealconstnode(left).value_real; + rvd:=trealconstnode(right).value_real; + case nodetype of + addn : + t:=crealconstnode.create(lvd+rvd,resultrealdef); + subn : + t:=crealconstnode.create(lvd-rvd,resultrealdef); + muln : + t:=crealconstnode.create(lvd*rvd,resultrealdef); + starstarn: + begin + if lvd<0 then + begin + Message(parser_e_invalid_float_operation); + t:=crealconstnode.create(0,resultrealdef); + end + else if lvd=0 then + t:=crealconstnode.create(1.0,resultrealdef) + else + t:=crealconstnode.create(exp(ln(lvd)*rvd),resultrealdef); + end; + slashn : + t:=crealconstnode.create(lvd/rvd,resultrealdef); + ltn : + t:=cordconstnode.create(ord(lvd<rvd),pasbool8type,true); + lten : + t:=cordconstnode.create(ord(lvd<=rvd),pasbool8type,true); + gtn : + t:=cordconstnode.create(ord(lvd>rvd),pasbool8type,true); + gten : + t:=cordconstnode.create(ord(lvd>=rvd),pasbool8type,true); + equaln : + t:=cordconstnode.create(ord(lvd=rvd),pasbool8type,true); + unequaln : + t:=cordconstnode.create(ord(lvd<>rvd),pasbool8type,true); + else + internalerror(2008022102); + end; + result:=t; + exit; + end; + + { first, we handle widestrings, so we can check later for } + { stringconstn only } + + { widechars are converted above to widestrings too } + { this isn't ver y efficient, but I don't think } + { that it does matter that much (FK) } + if (lt=stringconstn) and (rt=stringconstn) and + (tstringconstnode(left).cst_type in [cst_widestring,cst_unicodestring]) and + (tstringconstnode(right).cst_type in [cst_widestring,cst_unicodestring]) then + begin + initwidestring(ws1); + initwidestring(ws2); + copywidestring(pcompilerwidestring(tstringconstnode(left).value_str),ws1); + copywidestring(pcompilerwidestring(tstringconstnode(right).value_str),ws2); + case nodetype of + addn : + begin + concatwidestrings(ws1,ws2); + t:=cstringconstnode.createwstr(ws1); + end; + ltn : + t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<0),pasbool8type,true); + lten : + t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<=0),pasbool8type,true); + gtn : + t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>0),pasbool8type,true); + gten : + t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)>=0),pasbool8type,true); + equaln : + t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)=0),pasbool8type,true); + unequaln : + t:=cordconstnode.create(byte(comparewidestrings(ws1,ws2)<>0),pasbool8type,true); + else + internalerror(2008022103); + end; + donewidestring(ws1); + donewidestring(ws2); + result:=t; + exit; + end; + + { concating strings ? } + concatstrings:=false; + + if (lt=ordconstn) and (rt=ordconstn) and + is_char(ld) and is_char(rd) then + begin + c1[0]:=char(int64(tordconstnode(left).value)); + c1[1]:=#0; + l1:=1; + c2[0]:=char(int64(tordconstnode(right).value)); + c2[1]:=#0; + l2:=1; + s1:=@c1[0]; + s2:=@c2[0]; + concatstrings:=true; + end + else if (lt=stringconstn) and (rt=ordconstn) and is_char(rd) then + begin + s1:=tstringconstnode(left).value_str; + l1:=tstringconstnode(left).len; + c2[0]:=char(int64(tordconstnode(right).value)); + c2[1]:=#0; + s2:=@c2[0]; + l2:=1; + concatstrings:=true; + end + else if (lt=ordconstn) and (rt=stringconstn) and is_char(ld) then + begin + c1[0]:=char(int64(tordconstnode(left).value)); + c1[1]:=#0; + l1:=1; + s1:=@c1[0]; + s2:=tstringconstnode(right).value_str; + l2:=tstringconstnode(right).len; + concatstrings:=true; + end + else if (lt=stringconstn) and (rt=stringconstn) then + begin + s1:=tstringconstnode(left).value_str; + l1:=tstringconstnode(left).len; + s2:=tstringconstnode(right).value_str; + l2:=tstringconstnode(right).len; + concatstrings:=true; + end; + if concatstrings then + begin + case nodetype of + addn : + begin + t:=cstringconstnode.createpchar(concatansistrings(s1,s2,l1,l2),l1+l2); + typecheckpass(t); + tstringconstnode(t).changestringtype(resultdef); + end; + ltn : + t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<0),pasbool8type,true); + lten : + t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<=0),pasbool8type,true); + gtn : + t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>0),pasbool8type,true); + gten : + t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)>=0),pasbool8type,true); + equaln : + t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)=0),pasbool8type,true); + unequaln : + t:=cordconstnode.create(byte(compareansistrings(s1,s2,l1,l2)<>0),pasbool8type,true); + else + internalerror(2008022104); + end; + result:=t; + exit; + end; + + { set constant evaluation } + if (right.nodetype=setconstn) and + not assigned(tsetconstnode(right).left) and + (left.nodetype=setconstn) and + not assigned(tsetconstnode(left).left) then + begin + case nodetype of + addn : + begin + resultset:=tsetconstnode(right).value_set^ + tsetconstnode(left).value_set^; + t:=csetconstnode.create(@resultset,resultdef); + end; + muln : + begin + resultset:=tsetconstnode(right).value_set^ * tsetconstnode(left).value_set^; + t:=csetconstnode.create(@resultset,resultdef); + end; + subn : + begin + resultset:=tsetconstnode(left).value_set^ - tsetconstnode(right).value_set^; + t:=csetconstnode.create(@resultset,resultdef); + end; + symdifn : + begin + resultset:=tsetconstnode(right).value_set^ >< tsetconstnode(left).value_set^; + t:=csetconstnode.create(@resultset,resultdef); + end; + unequaln : + begin + b:=tsetconstnode(right).value_set^ <> tsetconstnode(left).value_set^; + t:=cordconstnode.create(byte(b),pasbool8type,true); + end; + equaln : + begin + b:=tsetconstnode(right).value_set^ = tsetconstnode(left).value_set^; + t:=cordconstnode.create(byte(b),pasbool8type,true); + end; + lten : + begin + b:=tsetconstnode(left).value_set^ <= tsetconstnode(right).value_set^; + t:=cordconstnode.create(byte(b),pasbool8type,true); + end; + gten : + begin + b:=tsetconstnode(left).value_set^ >= tsetconstnode(right).value_set^; + t:=cordconstnode.create(byte(b),pasbool8type,true); + end; + else + internalerror(2008022105); + end; + result:=t; + exit; + end; + + { slow simplifications } + if (cs_opt_level2 in current_settings.optimizerswitches) then + begin + { the comparison is might be expensive and the nodes are usually only + equal if some previous optimizations were done so don't check + this simplification always + } + if is_boolean(left.resultdef) and is_boolean(right.resultdef) and + { since the expressions might have sideeffects, we may only remove them + if short boolean evaluation is turned on } + (nf_short_bool in flags) then + begin + if left.isequal(right) then + begin + case nodetype of + andn,orn: + begin + result:=left; + left:=nil; + exit; + end; + { + xorn: + begin + result:=cordconstnode.create(0,resultdef,true); + exit; + end; + } + end; + end; + end; + + { using sqr(x) for reals instead of x*x might reduces register pressure and/or + memory accesses while sqr(<real>) has no drawback } + if +{$ifdef cpufpemu} + (current_settings.fputype<>fpu_soft) and + not(cs_fp_emulation in current_settings.moduleswitches) and +{$endif cpufpemu} + (nodetype=muln) and + is_real(left.resultdef) and is_real(right.resultdef) and + left.isequal(right) and + not(might_have_sideeffects(left)) then + begin + result:=cinlinenode.create(in_sqr_real,false,left); + left:=nil; + exit; + end; +{$ifdef cpurox} + { optimize (i shl x) or (i shr (bitsizeof(i)-x)) into rol(x,i) (and different flavours with shl/shr swapped etc.) } + if (nodetype=orn) +{$ifndef cpu64bitalu} + and (left.resultdef.typ=orddef) and + not(torddef(left.resultdef).ordtype in [s64bit,u64bit,scurrency]) +{$endif cpu64bitalu} + then + begin + if (left.nodetype=shrn) and (right.nodetype=shln) and + is_constintnode(tshlshrnode(left).right) and + is_constintnode(tshlshrnode(right).right) and + (tordconstnode(tshlshrnode(right).right).value>0) and + (tordconstnode(tshlshrnode(left).right).value>0) and + tshlshrnode(left).left.isequal(tshlshrnode(right).left) and + not(might_have_sideeffects(tshlshrnode(left).left)) then + begin + if tordconstnode(tshlshrnode(left).right).value= + tshlshrnode(left).left.resultdef.size*8-tordconstnode(tshlshrnode(right).right).value then + begin + result:=cinlinenode.create(in_ror_x_y,false, + ccallparanode.create(tshlshrnode(left).right, + ccallparanode.create(tshlshrnode(left).left,nil))); + tshlshrnode(left).left:=nil; + tshlshrnode(left).right:=nil; + exit; + end + else if tordconstnode(tshlshrnode(right).right).value= + tshlshrnode(left).left.resultdef.size*8-tordconstnode(tshlshrnode(left).right).value then + begin + result:=cinlinenode.create(in_rol_x_y,false, + ccallparanode.create(tshlshrnode(right).right, + ccallparanode.create(tshlshrnode(left).left,nil))); + tshlshrnode(left).left:=nil; + tshlshrnode(right).right:=nil; + exit; + end; + end; + if (left.nodetype=shln) and (right.nodetype=shrn) and + is_constintnode(tshlshrnode(left).right) and + is_constintnode(tshlshrnode(right).right) and + (tordconstnode(tshlshrnode(right).right).value>0) and + (tordconstnode(tshlshrnode(left).right).value>0) and + tshlshrnode(left).left.isequal(tshlshrnode(right).left) and + not(might_have_sideeffects(tshlshrnode(left).left)) then + begin + if tordconstnode(tshlshrnode(left).right).value= + tshlshrnode(left).left.resultdef.size*8-tordconstnode(tshlshrnode(right).right).value then + begin + result:=cinlinenode.create(in_rol_x_y,false, + ccallparanode.create(tshlshrnode(left).right, + ccallparanode.create(tshlshrnode(left).left,nil))); + tshlshrnode(left).left:=nil; + tshlshrnode(left).right:=nil; + exit; + end + else if tordconstnode(tshlshrnode(right).right).value= + tshlshrnode(left).left.resultdef.size*8-tordconstnode(tshlshrnode(left).right).value then + begin + result:=cinlinenode.create(in_ror_x_y,false, + ccallparanode.create(tshlshrnode(right).right, + ccallparanode.create(tshlshrnode(left).left,nil))); + tshlshrnode(left).left:=nil; + tshlshrnode(right).right:=nil; + exit; + end; + end; + end; +{$endif cpurox} + end; + end; + + + function taddnode.dogetcopy: tnode; + var + n: taddnode; + begin + n:=taddnode(inherited dogetcopy); + n.resultrealdef:=resultrealdef; + result:=n; + end; + + + function taddnode.docompare(p: tnode): boolean; + begin + result:= + inherited docompare(p) and + equal_defs(taddnode(p).resultrealdef,resultrealdef); + end; + + + function taddnode.pass_typecheck:tnode; + begin + { This function is small to keep the stack small for recursive of + large + operations } + typecheckpass(left); + typecheckpass(right); + result:=pass_typecheck_internal; + end; + + + function taddnode.pass_typecheck_internal:tnode; + var + hp : tnode; + rd,ld,nd : tdef; + hsym : tfieldvarsym; + llow,lhigh, + rlow,rhigh : tconstexprint; + strtype : tstringtype; + res, + b : boolean; + lt,rt : tnodetype; + ot : tnodetype; +{$ifdef state_tracking} + factval : Tnode; + change : boolean; +{$endif} + + begin + result:=nil; + { avoid any problems with type parameters later on } + if is_typeparam(left.resultdef) or is_typeparam(right.resultdef) then + begin + resultdef:=cundefinedtype; + exit; + end; + + { both left and right need to be valid } + set_varstate(left,vs_read,[vsf_must_be_valid]); + set_varstate(right,vs_read,[vsf_must_be_valid]); + if codegenerror then + exit; + + { tp procvar support } + maybe_call_procvar(left,true); + maybe_call_procvar(right,true); + + { convert array constructors to sets, because there is no other operator + possible for array constructors } + if is_array_constructor(left.resultdef) then + begin + arrayconstructor_to_set(left); + typecheckpass(left); + end; + if is_array_constructor(right.resultdef) then + begin + arrayconstructor_to_set(right); + typecheckpass(right); + end; + + { allow operator overloading } + hp:=self; + if isbinaryoverloaded(hp) then + begin + result:=hp; + exit; + end; + { Stop checking when an error was found in the operator checking } + if codegenerror then + begin + result:=cerrornode.create; + exit; + end; + + + { Kylix allows enum+ordconstn in an enum type declaration, we need to do + the conversion here before the constant folding } + if (m_delphi in current_settings.modeswitches) and + (blocktype in [bt_type,bt_const_type,bt_var_type]) then + begin + if (left.resultdef.typ=enumdef) and + (right.resultdef.typ=orddef) then + begin + { insert explicit typecast to default signed int } + left:=ctypeconvnode.create_internal(left,sinttype); + typecheckpass(left); + end + else + if (left.resultdef.typ=orddef) and + (right.resultdef.typ=enumdef) then + begin + { insert explicit typecast to default signed int } + right:=ctypeconvnode.create_internal(right,sinttype); + typecheckpass(right); + end; + end; + + { is one a real float, then both need to be floats, this + need to be done before the constant folding so constant + operation on a float and int are also handled } +{$ifdef x86} + { use extended as default real type only when the x87 fpu is used } + {$ifdef i386} + if not(current_settings.fputype=fpu_x87) then + resultrealdef:=s64floattype + else + resultrealdef:=pbestrealtype^; + {$endif i386} + {$ifdef x86_64} + { x86-64 has no x87 only mode, so use always double as default } + resultrealdef:=s64floattype; + {$endif x86_6} +{$else not x86} + resultrealdef:=pbestrealtype^; +{$endif not x86} + + if (right.resultdef.typ=floatdef) or (left.resultdef.typ=floatdef) then + begin + { when both floattypes are already equal then use that + floattype for results } + if (right.resultdef.typ=floatdef) and + (left.resultdef.typ=floatdef) and + (tfloatdef(left.resultdef).floattype=tfloatdef(right.resultdef).floattype) then + resultrealdef:=left.resultdef + { when there is a currency type then use currency, but + only when currency is defined as float } + else + if (is_currency(right.resultdef) or + is_currency(left.resultdef)) and + ((s64currencytype.typ = floatdef) or + (nodetype <> slashn)) then + begin + resultrealdef:=s64currencytype; + inserttypeconv(right,resultrealdef); + inserttypeconv(left,resultrealdef); + end + else + begin + resultrealdef:=getbestreal(left.resultdef,right.resultdef); + inserttypeconv(right,resultrealdef); + inserttypeconv(left,resultrealdef); + end; + end; + + { If both operands are constant and there is a unicodestring + or unicodestring then convert everything to unicodestring } + if is_constnode(right) and is_constnode(left) and + (is_unicodestring(right.resultdef) or + is_unicodestring(left.resultdef)) then + begin + inserttypeconv(right,cunicodestringtype); + inserttypeconv(left,cunicodestringtype); + end; + + { If both operands are constant and there is a widechar + or widestring then convert everything to widestring. This + allows constant folding like char+widechar } + if is_constnode(right) and is_constnode(left) and + (is_widestring(right.resultdef) or + is_widestring(left.resultdef) or + is_widechar(right.resultdef) or + is_widechar(left.resultdef)) then + begin + inserttypeconv(right,cwidestringtype); + inserttypeconv(left,cwidestringtype); + end; + + { load easier access variables } + rd:=right.resultdef; + ld:=left.resultdef; + rt:=right.nodetype; + lt:=left.nodetype; + + { 4 character constant strings are compatible with orddef } + { in macpas mode (become cardinals) } + if (m_mac in current_settings.modeswitches) and + { only allow for comparisons, additions etc are } + { normally program errors } + (nodetype in [ltn,lten,gtn,gten,unequaln,equaln]) and + (((lt=stringconstn) and + (tstringconstnode(left).len=4) and + (rd.typ=orddef)) or + ((rt=stringconstn) and + (tstringconstnode(right).len=4) and + (ld.typ=orddef))) then + begin + if (rt=stringconstn) then + begin + inserttypeconv(right,u32inttype); + rt:=right.nodetype; + rd:=right.resultdef; + end + else + begin + inserttypeconv(left,u32inttype); + lt:=left.nodetype; + ld:=left.resultdef; + end; + end; + + { but an int/int gives real/real! } + if (nodetype=slashn) and not(is_vector(left.resultdef)) and not(is_vector(right.resultdef)) then + begin + if is_currency(left.resultdef) and + is_currency(right.resultdef) then + { In case of currency, converting to float means dividing by 10000 } + { However, since this is already a division, both divisions by } + { 10000 are eliminated when we divide the results -> we can skip } + { them. } + if s64currencytype.typ = floatdef then + begin + { there's no s64comptype or so, how do we avoid the type conversion? + left.resultdef := s64comptype; + right.resultdef := s64comptype; } + end + else + begin + left.resultdef := s64inttype; + right.resultdef := s64inttype; + end; + inserttypeconv(right,resultrealdef); + inserttypeconv(left,resultrealdef); + end + + { if both are orddefs then check sub types } + else if (ld.typ=orddef) and (rd.typ=orddef) then + begin + { set for & and | operations in macpas mode: they only work on } + { booleans, and always short circuit evaluation } + if (nf_short_bool in flags) then + begin + if not is_boolean(ld) then + begin + inserttypeconv(left,pasbool8type); + ld := left.resultdef; + end; + if not is_boolean(rd) then + begin + inserttypeconv(right,pasbool8type); + rd := right.resultdef; + end; + end; + + { 2 booleans? Make them equal to the largest boolean } + if (is_boolean(ld) and is_boolean(rd)) then + begin + if (torddef(left.resultdef).size>torddef(right.resultdef).size) or + (is_cbool(left.resultdef) and not is_cbool(right.resultdef)) then + begin + right:=ctypeconvnode.create_internal(right,left.resultdef); + ttypeconvnode(right).convtype:=tc_bool_2_bool; + typecheckpass(right); + end + else if (torddef(left.resultdef).size<torddef(right.resultdef).size) or + (not is_cbool(left.resultdef) and is_cbool(right.resultdef)) then + begin + left:=ctypeconvnode.create_internal(left,right.resultdef); + ttypeconvnode(left).convtype:=tc_bool_2_bool; + typecheckpass(left); + end; + case nodetype of + xorn, + andn, + orn: + begin + end; + ltn, + lten, + gtn, + gten: + begin + { convert both to pasbool to perform the comparison (so + that longbool(4) = longbool(2), since both represent + "true" } + inserttypeconv(left,pasbool8type); + inserttypeconv(right,pasbool8type); + end; + unequaln, + equaln: + begin + if not(cs_full_boolean_eval in current_settings.localswitches) or + (nf_short_bool in flags) then + begin + { Remove any compares with constants } + if (left.nodetype=ordconstn) then + begin + hp:=right; + b:=(tordconstnode(left).value<>0); + ot:=nodetype; + left.free; + left:=nil; + right:=nil; + if (not(b) and (ot=equaln)) or + (b and (ot=unequaln)) then + begin + hp:=cnotnode.create(hp); + end; + result:=hp; + exit; + end; + if (right.nodetype=ordconstn) then + begin + hp:=left; + b:=(tordconstnode(right).value<>0); + ot:=nodetype; + right.free; + right:=nil; + left:=nil; + if (not(b) and (ot=equaln)) or + (b and (ot=unequaln)) then + begin + hp:=cnotnode.create(hp); + end; + result:=hp; + exit; + end; + end; + { Delphi-compatibility: convert both to pasbool to + perform the equality comparison } + inserttypeconv(left,pasbool8type); + inserttypeconv(right,pasbool8type); + end; + else + begin + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + result:=cnothingnode.create; + exit; + end; + end; + end + { Both are chars? } + else if is_char(rd) and is_char(ld) then + begin + if nodetype=addn then + begin + resultdef:=cshortstringtype; + if not(is_constcharnode(left) and is_constcharnode(right)) then + begin + inserttypeconv(left,cshortstringtype); +{$ifdef addstringopt} + hp := genaddsstringcharoptnode(self); + result := hp; + exit; +{$endif addstringopt} + end + end + else if not(nodetype in [ltn,lten,gtn,gten,unequaln,equaln]) then + begin + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + result:=cnothingnode.create; + exit; + end; + end + { There is a widechar? } + else if is_widechar(rd) or is_widechar(ld) then + begin + { widechar+widechar gives widestring } + if nodetype=addn then + begin + inserttypeconv(left,cwidestringtype); + if (torddef(rd).ordtype<>uwidechar) then + inserttypeconv(right,cwidechartype); + resultdef:=cwidestringtype; + end + else + begin + if (torddef(ld).ordtype<>uwidechar) then + inserttypeconv(left,cwidechartype); + if (torddef(rd).ordtype<>uwidechar) then + inserttypeconv(right,cwidechartype); + end; + end + { is there a currency type ? } + else if ((torddef(rd).ordtype=scurrency) or (torddef(ld).ordtype=scurrency)) then + begin + if (torddef(ld).ordtype<>scurrency) then + inserttypeconv(left,s64currencytype); + if (torddef(rd).ordtype<>scurrency) then + inserttypeconv(right,s64currencytype); + end + { "and" does't care about the sign of integers } + { "xor", "or" and compares don't need extension to native int } + { size either as long as both values are signed or unsigned } + { "xor" and "or" also don't care about the sign if the values } + { occupy an entire register } + { don't do it if either type is 64 bit, since in that case we } + { can't safely find a "common" type } + else if is_integer(ld) and is_integer(rd) and + not is_64bitint(ld) and not is_64bitint(rd) and + ((nodetype=andn) or + ((nodetype in [orn,xorn,equaln,unequaln,gtn,gten,ltn,lten]) and + not(is_signed(ld) xor is_signed(rd)))) then + begin + if (rd.size>ld.size) or + { Delphi-compatible: prefer unsigned type for "and" with equal size } + ((rd.size=ld.size) and + not is_signed(rd)) then + begin + if (rd.size=ld.size) and + is_signed(ld) then + inserttypeconv_internal(left,rd) + else + begin + { not to left right.resultdef, because that may + cause a range error if left and right's def don't + completely overlap } + nd:=get_common_intdef(torddef(ld),torddef(rd),true); + inserttypeconv(left,nd); + inserttypeconv(right,nd); + end; + end + else + begin + if (rd.size=ld.size) and + is_signed(rd) then + inserttypeconv_internal(right,ld) + else + begin + nd:=get_common_intdef(torddef(ld),torddef(rd),true); + inserttypeconv(left,nd); + inserttypeconv(right,nd); + end; + end + end + { is there a signed 64 bit type ? } + else if ((torddef(rd).ordtype=s64bit) or (torddef(ld).ordtype=s64bit)) then + begin + if (torddef(ld).ordtype<>s64bit) then + inserttypeconv(left,s64inttype); + if (torddef(rd).ordtype<>s64bit) then + inserttypeconv(right,s64inttype); + end + { is there a unsigned 64 bit type ? } + else if ((torddef(rd).ordtype=u64bit) or (torddef(ld).ordtype=u64bit)) then + begin + if (torddef(ld).ordtype<>u64bit) then + inserttypeconv(left,u64inttype); + if (torddef(rd).ordtype<>u64bit) then + inserttypeconv(right,u64inttype); + end + { 64 bit cpus do calculations always in 64 bit } +{$ifndef cpu64bitaddr} + { is there a cardinal? } + else if ((torddef(rd).ordtype=u32bit) or (torddef(ld).ordtype=u32bit)) then + begin + { convert positive constants to u32bit } + if (torddef(ld).ordtype<>u32bit) and + is_constintnode(left) and + (tordconstnode(left).value >= 0) then + inserttypeconv(left,u32inttype); + if (torddef(rd).ordtype<>u32bit) and + is_constintnode(right) and + (tordconstnode(right).value >= 0) then + inserttypeconv(right,u32inttype); + { when one of the operand is signed or the operation is subn then perform + the operation in 64bit, can't use rd/ld here because there + could be already typeconvs inserted. + This is compatible with the code below for other unsigned types (PFV) } + if is_signed(left.resultdef) or + is_signed(right.resultdef) or + (nodetype=subn) then + begin + if nodetype<>subn then + CGMessage(type_h_mixed_signed_unsigned); + { mark as internal in case added for a subn, so } + { ttypeconvnode.simplify can remove the 64 bit } + { typecast again if semantically correct. Even } + { if we could detect that here already, we } + { mustn't do it here because that would change } + { overload choosing behaviour etc. The code in } + { ncnv.pas is run after that is already decided } + if (not is_signed(left.resultdef) and + not is_signed(right.resultdef)) or + (nodetype in [orn,xorn]) then + include(flags,nf_internal); + inserttypeconv(left,s64inttype); + inserttypeconv(right,s64inttype); + end + else + begin + if (torddef(left.resultdef).ordtype<>u32bit) then + inserttypeconv(left,u32inttype); + if (torddef(right.resultdef).ordtype<>u32bit) then + inserttypeconv(right,u32inttype); + end; + end +{$endif cpu64bitaddr} + { generic ord conversion is sinttype } + else + begin + { When there is a signed type or there is a minus operation + we convert to signed int. Otherwise (both are unsigned) we keep + the result also unsigned. This is compatible with Delphi (PFV) } + if is_signed(ld) or + is_signed(rd) or + (nodetype=subn) then + begin +{$ifdef cpunodefaultint} + { for small cpus we use the smallest common type } + nd:=get_common_intdef(torddef(ld),torddef(rd),false); + inserttypeconv(right,nd); + inserttypeconv(left,nd); +{$else cpunodefaultint} + inserttypeconv(right,sinttype); + inserttypeconv(left,sinttype); +{$endif cpunodefaultint} + end + else + begin + inserttypeconv(right,uinttype); + inserttypeconv(left,uinttype); + end; + end; + end + + { if both are floatdefs, conversion is already done before constant folding } + else if (ld.typ=floatdef) then + begin + if not(nodetype in [addn,subn,muln,slashn,equaln,unequaln,ltn,lten,gtn,gten]) then + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + end + + { left side a setdef, must be before string processing, + else array constructor can be seen as array of char (PFV) } + else if (ld.typ=setdef) then + begin + if not(nodetype in [addn,subn,symdifn,muln,equaln,unequaln,lten,gten]) then + CGMessage(type_e_set_operation_unknown); + { right must either be a set or a set element } + if (rd.typ<>setdef) and + (rt<>setelementn) then + CGMessage(type_e_mismatch) + { Make operands the same setdef. If one's elementtype fits } + { entirely inside the other's, pick the one with the largest } + { range. Otherwise create a new setdef with a range which } + { can contain both. } + else if not(equal_defs(ld,rd)) then + begin + { note: ld cannot be an empty set with elementdef=nil in } + { case right is not a set, arrayconstructor_to_set takes } + { care of that } + + { 1: rd is a set with an assigned elementdef, and ld is } + { either an empty set without elementdef or a set whose } + { elementdef fits in rd's elementdef -> convert to rd } + if ((rd.typ=setdef) and + assigned(tsetdef(rd).elementdef) and + (not assigned(tsetdef(ld).elementdef) or + is_in_limit(ld,rd))) then + inserttypeconv(left,rd) + { 2: rd is either an empty set without elementdef or a set } + { whose elementdef fits in ld's elementdef, or a set } + { element whose def fits in ld's elementdef -> convert } + { to ld. ld's elementdef can't be nil here, is caught } + { previous case and "note:" above } + else if ((rd.typ=setdef) and + (not assigned(tsetdef(rd).elementdef) or + is_in_limit(rd,ld))) or + ((rd.typ<>setdef) and + is_in_limit(rd,tsetdef(ld).elementdef)) then + if (rd.typ=setdef) then + inserttypeconv(right,ld) + else + inserttypeconv(right,tsetdef(ld).elementdef) + { 3: otherwise create setdef which encompasses both, taking } + { into account empty sets without elementdef } + else + begin + if assigned(tsetdef(ld).elementdef) then + begin + llow:=tsetdef(ld).setbase; + lhigh:=tsetdef(ld).setmax; + end; + if (rd.typ=setdef) then + if assigned(tsetdef(rd).elementdef) then + begin + rlow:=tsetdef(rd).setbase; + rhigh:=tsetdef(rd).setmax; + end + else + begin + { ld's elementdef must have been valid } + rlow:=llow; + rhigh:=lhigh; + end + else + getrange(rd,rlow,rhigh); + if not assigned(tsetdef(ld).elementdef) then + begin + llow:=rlow; + lhigh:=rhigh; + end; + nd:=tsetdef.create(tsetdef(ld).elementdef,min(llow,rlow),max(lhigh,rhigh)); + inserttypeconv(left,nd); + if (rd.typ=setdef) then + inserttypeconv(right,nd) + else + inserttypeconv(right,tsetdef(nd).elementdef); + end; + end; + end + { pointer comparision and subtraction } + else if ( + (rd.typ=pointerdef) and (ld.typ=pointerdef) + ) or + { compare/add pchar to variable (not stringconst) char arrays + by addresses like BP/Delphi } + ( + (nodetype in [equaln,unequaln,subn,addn]) and + ( + ((is_pchar(ld) or (lt=niln)) and is_chararray(rd) and (rt<>stringconstn)) or + ((is_pchar(rd) or (rt=niln)) and is_chararray(ld) and (lt<>stringconstn)) + ) + ) then + begin + { convert char array to pointer } + if is_chararray(rd) then + begin + inserttypeconv(right,charpointertype); + rd:=right.resultdef; + end + else if is_chararray(ld) then + begin + inserttypeconv(left,charpointertype); + ld:=left.resultdef; + end; + + case nodetype of + equaln,unequaln : + begin + if is_voidpointer(right.resultdef) then + inserttypeconv(right,left.resultdef) + else if is_voidpointer(left.resultdef) then + inserttypeconv(left,right.resultdef) + else if not(equal_defs(ld,rd)) then + IncompatibleTypes(ld,rd); + { now that the type checking is done, convert both to charpointer, } + { because methodpointers are 8 bytes even though only the first 4 } + { bytes must be compared. This can happen here if we are in } + { TP/Delphi mode, because there @methodpointer = voidpointer (but } + { a voidpointer of 8 bytes). A conversion to voidpointer would be } + { optimized away, since the result already was a voidpointer, so } + { use a charpointer instead (JM) } + inserttypeconv_internal(left,charpointertype); + inserttypeconv_internal(right,charpointertype); + end; + ltn,lten,gtn,gten: + begin + if (cs_extsyntax in current_settings.moduleswitches) then + begin + if is_voidpointer(right.resultdef) then + inserttypeconv(right,left.resultdef) + else if is_voidpointer(left.resultdef) then + inserttypeconv(left,right.resultdef) + else if not(equal_defs(ld,rd)) then + IncompatibleTypes(ld,rd); + end + else + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + end; + subn: + begin + if (cs_extsyntax in current_settings.moduleswitches) then + begin + if is_voidpointer(right.resultdef) then + begin + if is_big_untyped_addrnode(right) then + CGMessage1(type_w_untyped_arithmetic_unportable,node2opstr(nodetype)); + inserttypeconv(right,left.resultdef) + end + else if is_voidpointer(left.resultdef) then + inserttypeconv(left,right.resultdef) + else if not(equal_defs(ld,rd)) then + IncompatibleTypes(ld,rd); + end + else + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + + if not(nf_has_pointerdiv in flags) and + (tpointerdef(rd).pointeddef.size>1) then + begin + hp:=getcopy; + include(hp.flags,nf_has_pointerdiv); + result:=cmoddivnode.create(divn,hp,cordconstnode.create(tpointerdef(rd).pointeddef.size,sinttype,false)); + end; + resultdef:=sinttype; + exit; + end; + else + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + end; + end + + { is one of the operands a string?, + chararrays are also handled as strings (after conversion), also take + care of chararray+chararray and chararray+char. + Note: Must be done after pointerdef+pointerdef has been checked, else + pchar is converted to string } + else if (rd.typ=stringdef) or + (ld.typ=stringdef) or + { stringconstn's can be arraydefs } + (lt=stringconstn) or + (rt=stringconstn) or + ((is_pchar(rd) or is_chararray(rd) or is_char(rd) or is_open_chararray(rd) or + is_pwidechar(rd) or is_widechararray(rd) or is_widechar(rd) or is_open_widechararray(rd)) and + (is_pchar(ld) or is_chararray(ld) or is_char(ld) or is_open_chararray(ld) or + is_pwidechar(ld) or is_widechararray(ld) or is_widechar(ld) or is_open_widechararray(ld))) then + begin + if (nodetype in [addn,equaln,unequaln,lten,gten,ltn,gtn]) then + begin + { Is there a unicodestring? } + if is_unicodestring(rd) or is_unicodestring(ld) then + strtype:=st_unicodestring + else + { Is there a widestring? } + if is_widestring(rd) or is_widestring(ld) or + is_pwidechar(rd) or is_widechararray(rd) or is_widechar(rd) or is_open_widechararray(rd) or + is_pwidechar(ld) or is_widechararray(ld) or is_widechar(ld) or is_open_widechararray(ld) then + strtype:=st_widestring + else + if is_ansistring(rd) or is_ansistring(ld) or + ((cs_ansistrings in current_settings.localswitches) and + //todo: Move some of this to longstring's then they are implemented? + ( + is_pchar(rd) or (is_chararray(rd) and (rd.size > 255)) or is_open_chararray(rd) or (lt = stringconstn) or + is_pchar(ld) or (is_chararray(ld) and (ld.size > 255)) or is_open_chararray(ld) or (rt = stringconstn) + ) + ) then + strtype:=st_ansistring + else + if is_longstring(rd) or is_longstring(ld) then + strtype:=st_longstring + else + begin + { TODO: todo: add a warning/hint here if one converting a too large array} + { nodes is PChar, array [with size > 255] or OpenArrayOfChar. + Note: Delphi halts with error if "array [0..xx] of char" + is assigned to ShortString and string length is less + then array size } + strtype:= st_shortstring; + end; + + // Now convert nodes to common string type + case strtype of + st_widestring : + begin + if not(is_widestring(rd)) then + inserttypeconv(right,cwidestringtype); + if not(is_widestring(ld)) then + inserttypeconv(left,cwidestringtype); + end; + st_unicodestring : + begin + if not(is_unicodestring(rd)) then + inserttypeconv(right,cunicodestringtype); + if not(is_unicodestring(ld)) then + inserttypeconv(left,cunicodestringtype); + end; + st_ansistring : + begin + { use same code page if possible (don't force same code + page in case both are ansistrings with code page <> + CP_NONE, since then data loss can occur (the ansistring + helpers will convert them at run time to an encoding + that can represent both encodings) } + if is_ansistring(ld) and + (tstringdef(ld).encoding<>0) and + (tstringdef(ld).encoding<>globals.CP_NONE) and + (not is_ansistring(rd) or + (tstringdef(rd).encoding=0) or + (tstringdef(rd).encoding=globals.CP_NONE)) then + inserttypeconv(right,ld) + else if is_ansistring(rd) and + (tstringdef(rd).encoding<>0) and + (tstringdef(rd).encoding<>globals.CP_NONE) and + (not is_ansistring(ld) or + (tstringdef(ld).encoding=0) or + (tstringdef(ld).encoding=globals.CP_NONE)) then + inserttypeconv(left,rd) + else + begin + if not is_ansistring(ld) then + inserttypeconv(left,getansistringdef); + if not is_ansistring(rd) then + inserttypeconv(right,getansistringdef); + end; + end; + st_longstring : + begin + if not(is_longstring(rd)) then + inserttypeconv(right,clongstringtype); + if not(is_longstring(ld)) then + inserttypeconv(left,clongstringtype); + end; + st_shortstring : + begin + if not(is_shortstring(ld)) then + inserttypeconv(left,cshortstringtype); + { don't convert char, that can be handled by the optimized node } + if not(is_shortstring(rd) or is_char(rd)) then + inserttypeconv(right,cshortstringtype); + end; + else + internalerror(2005101); + end; + end + else + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + end + + { implicit pointer object type comparison } + else if is_implicit_pointer_object_type(rd) or is_implicit_pointer_object_type(ld) then + begin + if (nodetype in [equaln,unequaln]) then + begin + if is_implicit_pointer_object_type(rd) and is_implicit_pointer_object_type(ld) then + begin + if tobjectdef(rd).is_related(tobjectdef(ld)) then + inserttypeconv(right,left.resultdef) + else + inserttypeconv(left,right.resultdef); + end + else if is_implicit_pointer_object_type(rd) then + inserttypeconv(left,right.resultdef) + else + inserttypeconv(right,left.resultdef); + end + else + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + end + + else if (rd.typ=classrefdef) and (ld.typ=classrefdef) then + begin + if (nodetype in [equaln,unequaln]) then + begin + if tobjectdef(tclassrefdef(rd).pointeddef).is_related( + tobjectdef(tclassrefdef(ld).pointeddef)) then + inserttypeconv(right,left.resultdef) + else + inserttypeconv(left,right.resultdef); + end + else + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + end + + { allow comparison with nil pointer } + else if is_implicit_pointer_object_type(rd) or (rd.typ=classrefdef) then + begin + if (nodetype in [equaln,unequaln]) then + inserttypeconv(left,right.resultdef) + else + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + end + + else if is_implicit_pointer_object_type(ld) or (ld.typ=classrefdef) then + begin + if (nodetype in [equaln,unequaln]) then + inserttypeconv(right,left.resultdef) + else + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + end + + { support procvar=nil,procvar<>nil } + else if ((ld.typ=procvardef) and (rt=niln)) or + ((rd.typ=procvardef) and (lt=niln)) then + begin + if not(nodetype in [equaln,unequaln]) then + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + { find proc field in methodpointer record } + hsym:=tfieldvarsym(trecorddef(methodpointertype).symtable.Find('proc')); + if not assigned(hsym) then + internalerror(200412043); + { For methodpointers compare only tmethodpointer.proc } + if (rd.typ=procvardef) and + (not tprocvardef(rd).is_addressonly) then + begin + right:=csubscriptnode.create( + hsym, + ctypeconvnode.create_internal(right,methodpointertype)); + typecheckpass(right); + end; + if (ld.typ=procvardef) and + (not tprocvardef(ld).is_addressonly) then + begin + left:=csubscriptnode.create( + hsym, + ctypeconvnode.create_internal(left,methodpointertype)); + typecheckpass(left); + end; + end + + { support dynamicarray=nil,dynamicarray<>nil } + else if (is_dynamic_array(ld) and (rt=niln)) or + (is_dynamic_array(rd) and (lt=niln)) or + (is_dynamic_array(ld) and is_dynamic_array(rd)) then + begin + if not(nodetype in [equaln,unequaln]) then + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + end + +{$ifdef SUPPORT_MMX} + { mmx support, this must be before the zero based array + check } + else if (cs_mmx in current_settings.localswitches) and + is_mmx_able_array(ld) and + is_mmx_able_array(rd) and + equal_defs(ld,rd) then + begin + case nodetype of + addn,subn,xorn,orn,andn: + ; + { mul is a little bit restricted } + muln: + if not(mmx_type(ld) in [mmxu16bit,mmxs16bit,mmxfixed16]) then + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + else + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + end; + end +{$endif SUPPORT_MMX} + { vector support, this must be before the zero based array + check } + else if (cs_support_vectors in current_settings.globalswitches) and + is_vector(ld) and + is_vector(rd) and + equal_defs(ld,rd) then + begin + if not(nodetype in [addn,subn,xorn,orn,andn,muln,slashn]) then + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + { both defs must be equal, so taking left or right as resultdef doesn't matter } + resultdef:=left.resultdef; + end + + { this is a little bit dangerous, also the left type } + { pointer to should be checked! This broke the mmx support } + else if (rd.typ=pointerdef) or + (is_zero_based_array(rd) and (rt<>stringconstn)) then + begin + if is_zero_based_array(rd) then + begin + resultdef:=tpointerdef.create(tarraydef(rd).elementdef); + inserttypeconv(right,resultdef); + end + else + resultdef:=right.resultdef; + inserttypeconv(left,sinttype); + if nodetype=addn then + begin + if not(cs_extsyntax in current_settings.moduleswitches) or + (not (is_pchar(ld) or is_chararray(ld) or is_open_chararray(ld) or is_widechar(ld) or is_widechararray(ld) or is_open_widechararray(ld)) and + not(cs_pointermath in current_settings.localswitches) and + not((ld.typ=pointerdef) and tpointerdef(ld).has_pointer_math)) then + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + if (rd.typ=pointerdef) and + (tpointerdef(rd).pointeddef.size>1) then + begin + left:=caddnode.create(muln,left, + cordconstnode.create(tpointerdef(rd).pointeddef.size,sinttype,true)); + typecheckpass(left); + end; + end + else + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + end + + else if (ld.typ=pointerdef) or + (is_zero_based_array(ld) and (lt<>stringconstn)) then + begin + if is_zero_based_array(ld) then + begin + resultdef:=tpointerdef.create(tarraydef(ld).elementdef); + inserttypeconv(left,resultdef); + end + else + resultdef:=left.resultdef; + + inserttypeconv(right,sinttype); + if nodetype in [addn,subn] then + begin + if (lt=niln) then + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),'NIL',rd.typename); + if not(cs_extsyntax in current_settings.moduleswitches) or + (not (is_pchar(ld) or is_chararray(ld) or is_open_chararray(ld) or is_widechar(ld) or is_widechararray(ld) or is_open_widechararray(ld)) and + not(cs_pointermath in current_settings.localswitches) and + not((ld.typ=pointerdef) and tpointerdef(ld).has_pointer_math)) then + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + if (ld.typ=pointerdef) then + begin + if is_big_untyped_addrnode(left) then + CGMessage1(type_w_untyped_arithmetic_unportable,node2opstr(nodetype)); + if (tpointerdef(ld).pointeddef.size>1) then + begin + right:=caddnode.create(muln,right, + cordconstnode.create(tpointerdef(ld).pointeddef.size,sinttype,true)); + typecheckpass(right); + end + end else + if is_zero_based_array(ld) and + (tarraydef(ld).elementdef.size>1) then + begin + right:=caddnode.create(muln,right, + cordconstnode.create(tarraydef(ld).elementdef.size,sinttype,true)); + typecheckpass(right); + end; + end + else + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + end + + else if (rd.typ=procvardef) and + (ld.typ=procvardef) and + equal_defs(rd,ld) then + begin + if (nodetype in [equaln,unequaln]) then + begin + if tprocvardef(rd).is_addressonly then + begin + inserttypeconv_internal(right,voidpointertype); + inserttypeconv_internal(left,voidpointertype); + end + else + begin + { find proc field in methodpointer record } + hsym:=tfieldvarsym(trecorddef(methodpointertype).symtable.Find('proc')); + if not assigned(hsym) then + internalerror(200412043); + { Compare tmehodpointer(left).proc } + right:=csubscriptnode.create( + hsym, + ctypeconvnode.create_internal(right,methodpointertype)); + typecheckpass(right); + left:=csubscriptnode.create( + hsym, + ctypeconvnode.create_internal(left,methodpointertype)); + typecheckpass(left); + end; + end + else + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + end + + { enums } + else if (ld.typ=enumdef) and (rd.typ=enumdef) then + begin + if allowenumop(nodetype) then + inserttypeconv(right,left.resultdef) + else + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,rd.typename); + end + + { generic conversion, this is for error recovery } + else + begin + inserttypeconv(left,sinttype); + inserttypeconv(right,sinttype); + end; + + if cmp_of_disjunct_ranges(res) then + begin + if res then + CGMessage(type_w_comparison_always_true) + else + CGMessage(type_w_comparison_always_false); + end; + + { set resultdef if not already done } + if not assigned(resultdef) then + begin + case nodetype of + ltn,lten,gtn,gten,equaln,unequaln : + resultdef:=pasbool8type; + slashn : + resultdef:=resultrealdef; + addn: + begin + { for strings, return is always a 255 char string } + if is_shortstring(left.resultdef) then + resultdef:=cshortstringtype + else + { for ansistrings set resultdef to assignment left node + if it is an assignment and left node expects ansistring } + if is_ansistring(left.resultdef) and + assigned(aktassignmentnode) and + (aktassignmentnode.right=self) and + is_ansistring(aktassignmentnode.left.resultdef) then + resultdef:=aktassignmentnode.left.resultdef + else + resultdef:=left.resultdef; + end; + else + resultdef:=left.resultdef; + end; + end; + + { when the result is currency we need some extra code for + multiplication and division. this should not be done when + the muln or slashn node is created internally } + if not(nf_is_currency in flags) and + is_currency(resultdef) then + begin + case nodetype of + slashn : + begin + { slashn will only work with floats } + hp:=caddnode.create(muln,getcopy,crealconstnode.create(10000.0,s64currencytype)); + include(hp.flags,nf_is_currency); + result:=hp; + end; + muln : + begin + if s64currencytype.typ=floatdef then + hp:=caddnode.create(slashn,getcopy,crealconstnode.create(10000.0,s64currencytype)) + else + hp:=cmoddivnode.create(divn,getcopy,cordconstnode.create(10000,s64currencytype,false)); + include(hp.flags,nf_is_currency); + result:=hp + end; + end; + end; + + if not codegenerror and + not assigned(result) then + result:=simplify(false); + end; + + + function taddnode.first_addstring: tnode; + const + swap_relation: array [ltn..unequaln] of Tnodetype=(gtn, gten, ltn, lten, equaln, unequaln); + var + p: tnode; + newstatement : tstatementnode; + tempnode (*,tempnode2*) : ttempcreatenode; + cmpfuncname: string; + para: tcallparanode; + begin + { when we get here, we are sure that both the left and the right } + { node are both strings of the same stringtype (JM) } + case nodetype of + addn: + begin + if (left.nodetype=stringconstn) and (tstringconstnode(left).len=0) then + begin + result:=right; + left.free; + left:=nil; + right:=nil; + exit; + end; + if (right.nodetype=stringconstn) and (tstringconstnode(right).len=0) then + begin + result:=left; + left:=nil; + right.free; + right:=nil; + exit; + end; + { create the call to the concat routine both strings as arguments } + if assigned(aktassignmentnode) and + (aktassignmentnode.right=self) and + (aktassignmentnode.left.resultdef=resultdef) and + valid_for_var(aktassignmentnode.left,false) then + begin + para:=ccallparanode.create( + right, + ccallparanode.create( + left, + ccallparanode.create(aktassignmentnode.left.getcopy,nil) + ) + ); + if is_ansistring(resultdef) then + para:=ccallparanode.create( + cordconstnode.create( + getparaencoding(resultdef), + u16inttype, + true + ), + para + ); + result:=ccallnode.createintern( + 'fpc_'+tstringdef(resultdef).stringtypname+'_concat', + para + ); + include(aktassignmentnode.flags,nf_assign_done_in_right); + firstpass(result); + end + else + begin + result:=internalstatements(newstatement); + tempnode:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true); + addstatement(newstatement,tempnode); + para:=ccallparanode.create( + right, + ccallparanode.create( + left, + ccallparanode.create(ctemprefnode.create(tempnode),nil) + ) + ); + if is_ansistring(resultdef) then + para:=ccallparanode.create( + cordconstnode.create( + getparaencoding(resultdef), + u16inttype, + true + ), + para + ); + addstatement( + newstatement, + ccallnode.createintern( + 'fpc_'+tstringdef(resultdef).stringtypname+'_concat', + para + ) + ); + addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode)); + addstatement(newstatement,ctemprefnode.create(tempnode)); + end; + { we reused the arguments } + left := nil; + right := nil; + end; + ltn,lten,gtn,gten,equaln,unequaln : + begin + { generate better code for comparison with empty string, we + only need to compare the length with 0 } + if (nodetype in [equaln,unequaln,gtn,gten,ltn,lten]) and + { windows widestrings are too complicated to be handled optimized } + not(is_widestring(left.resultdef) and (target_info.system in systems_windows)) and + (((left.nodetype=stringconstn) and (tstringconstnode(left).len=0)) or + ((right.nodetype=stringconstn) and (tstringconstnode(right).len=0))) then + begin + { switch so that the constant is always on the right } + if left.nodetype = stringconstn then + begin + p := left; + left := right; + right := p; + nodetype:=swap_relation[nodetype]; + end; + if is_shortstring(left.resultdef) or + (nodetype in [gtn,gten,ltn,lten]) then + { compare the length with 0 } + result := caddnode.create(nodetype, + cinlinenode.create(in_length_x,false,left), + cordconstnode.create(0,s32inttype,false)) + else + begin + (* + if is_widestring(left.resultdef) and + (target_info.system in system_windows) then + begin + { windows like widestrings requires that we also check the length } + result:=internalstatements(newstatement); + tempnode:=ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true); + tempnode2:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true); + addstatement(newstatement,tempnode); + addstatement(newstatement,tempnode2); + { poor man's cse } + addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(tempnode), + ctypeconvnode.create_internal(left,voidpointertype)) + ); + addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(tempnode2), + caddnode.create(orn, + caddnode.create(nodetype, + ctemprefnode.create(tempnode), + cpointerconstnode.create(0,voidpointertype) + ), + caddnode.create(nodetype, + ctypeconvnode.create_internal(cderefnode.create(ctemprefnode.create(tempnode)),s32inttype), + cordconstnode.create(0,s32inttype,false) + ) + ) + )); + addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode)); + addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode2)); + addstatement(newstatement,ctemprefnode.create(tempnode2)); + end + else + *) + begin + { compare the pointer with nil (for ansistrings etc), } + { faster than getting the length (JM) } + result:= caddnode.create(nodetype, + ctypeconvnode.create_internal(left,voidpointertype), + cpointerconstnode.create(0,voidpointertype)); + end; + end; + { left is reused } + left := nil; + { right isn't } + right.free; + right := nil; + exit; + end; + { no string constant -> call compare routine } + cmpfuncname := 'fpc_'+tstringdef(left.resultdef).stringtypname+'_compare'; + { for equality checks use optimized version } + if nodetype in [equaln,unequaln] then + cmpfuncname := cmpfuncname + '_equal'; + + result := ccallnode.createintern(cmpfuncname, + ccallparanode.create(right,ccallparanode.create(left,nil))); + { and compare its result with 0 according to the original operator } + result := caddnode.create(nodetype,result, + cordconstnode.create(0,s32inttype,false)); + left := nil; + right := nil; + end; + end; + end; + + + function taddnode.first_addset : tnode; + + procedure call_varset_helper(const n : string); + var + newstatement : tstatementnode; + temp : ttempcreatenode; + begin + { add two var sets } + result:=internalstatements(newstatement); + + { create temp for result } + temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true); + addstatement(newstatement,temp); + + addstatement(newstatement,ccallnode.createintern(n, + ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false), + ccallparanode.create(ctemprefnode.create(temp), + ccallparanode.create(right, + ccallparanode.create(left,nil))))) + ); + + { remove reused parts from original node } + left:=nil; + right:=nil; + { the last statement should return the value as + location and type, this is done be referencing the + temp and converting it first from a persistent temp to + normal temp } + addstatement(newstatement,ctempdeletenode.create_normal_temp(temp)); + addstatement(newstatement,ctemprefnode.create(temp)); + end; + + var + procname: string[31]; + tempn: tnode; + newstatement : tstatementnode; + temp : ttempcreatenode; + begin + result:=nil; + case nodetype of + equaln,unequaln,lten,gten: + begin + case nodetype of + equaln,unequaln: + procname := 'fpc_varset_comp_sets'; + lten,gten: + begin + procname := 'fpc_varset_contains_sets'; + { (left >= right) = (right <= left) } + if nodetype = gten then + begin + tempn := left; + left := right; + right := tempn; + end; + end; + end; + result := ccallnode.createinternres(procname, + ccallparanode.create(cordconstnode.create(left.resultdef.size,sinttype,false), + ccallparanode.create(right, + ccallparanode.create(left,nil))),resultdef); + { left and right are reused as parameters } + left := nil; + right := nil; + { for an unequaln, we have to negate the result of comp_sets } + if nodetype = unequaln then + result := cnotnode.create(result); + end; + addn: + begin + { optimize first loading of a set } + if (right.nodetype=setelementn) and + not(assigned(tsetelementnode(right).right)) and + is_emptyset(left) then + begin + result:=internalstatements(newstatement); + + { create temp for result } + temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true); + addstatement(newstatement,temp); + + { adjust for set base } + tsetelementnode(right).left:=caddnode.create(subn, + ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype), + cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false)); + + addstatement(newstatement,ccallnode.createintern('fpc_varset_create_element', + ccallparanode.create(ctemprefnode.create(temp), + ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false), + ccallparanode.create(tsetelementnode(right).left,nil)))) + ); + + { the last statement should return the value as + location and type, this is done be referencing the + temp and converting it first from a persistent temp to + normal temp } + addstatement(newstatement,ctempdeletenode.create_normal_temp(temp)); + addstatement(newstatement,ctemprefnode.create(temp)); + + tsetelementnode(right).left := nil; + end + else + begin + if right.nodetype=setelementn then + begin + result:=internalstatements(newstatement); + + { create temp for result } + temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true); + addstatement(newstatement,temp); + + { adjust for set base } + tsetelementnode(right).left:=caddnode.create(subn, + ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype), + cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false)); + + { add a range or a single element? } + if assigned(tsetelementnode(right).right) then + begin + { adjust for set base } + tsetelementnode(right).right:=caddnode.create(subn, + ctypeconvnode.create_internal(tsetelementnode(right).right,sinttype), + cordconstnode.create(tsetdef(resultdef).setbase,sinttype,false)); + addstatement(newstatement,ccallnode.createintern('fpc_varset_set_range', + ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false), + ccallparanode.create(tsetelementnode(right).right, + ccallparanode.create(tsetelementnode(right).left, + ccallparanode.create(ctemprefnode.create(temp), + ccallparanode.create(left,nil)))))) + ); + end + else + addstatement(newstatement,ccallnode.createintern('fpc_varset_set', + ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false), + ccallparanode.create(ctypeconvnode.create_internal(tsetelementnode(right).left,sinttype), + ccallparanode.create(ctemprefnode.create(temp), + ccallparanode.create(left,nil))))) + ); + { remove reused parts from original node } + tsetelementnode(right).right:=nil; + tsetelementnode(right).left:=nil; + left:=nil; + { the last statement should return the value as + location and type, this is done be referencing the + temp and converting it first from a persistent temp to + normal temp } + addstatement(newstatement,ctempdeletenode.create_normal_temp(temp)); + addstatement(newstatement,ctemprefnode.create(temp)); + end + else + call_varset_helper('fpc_varset_add_sets'); + end + end; + subn: + call_varset_helper('fpc_varset_sub_sets'); + symdifn: + call_varset_helper('fpc_varset_symdif_sets'); + muln: + call_varset_helper('fpc_varset_mul_sets'); + else + internalerror(200609241); + end; + end; + + + function taddnode.use_generic_mul32to64: boolean; + begin + result := true; + end; + + + function taddnode.try_make_mul32to64: boolean; + + function canbe32bitint(v: tconstexprint): boolean; + begin + result := ((v >= int64(low(longint))) and (v <= int64(high(longint)))) or + ((v >= qword(low(cardinal))) and (v <= qword(high(cardinal)))) + end; + + var + temp: tnode; + begin + result := false; + if ((left.nodetype = typeconvn) and + is_integer(ttypeconvnode(left).left.resultdef) and + (not(torddef(ttypeconvnode(left).left.resultdef).ordtype in [u64bit,s64bit])) and + (((right.nodetype = ordconstn) and canbe32bitint(tordconstnode(right).value)) or + ((right.nodetype = typeconvn) and + is_integer(ttypeconvnode(right).left.resultdef) and + not(torddef(ttypeconvnode(right).left.resultdef).ordtype in [u64bit,s64bit])) and + ((is_signed(ttypeconvnode(left).left.resultdef) = + is_signed(ttypeconvnode(right).left.resultdef)) or + (is_signed(ttypeconvnode(left).left.resultdef) and + (torddef(ttypeconvnode(right).left.resultdef).ordtype in [u8bit,u16bit]))))) then + begin + temp := ttypeconvnode(left).left; + ttypeconvnode(left).left := nil; + left.free; + left := temp; + if (right.nodetype = typeconvn) then + begin + temp := ttypeconvnode(right).left; + ttypeconvnode(right).left := nil; + right.free; + right := temp; + end; + if (is_signed(left.resultdef)) then + begin + inserttypeconv(left,s32inttype); + inserttypeconv(right,s32inttype); + end + else + begin + inserttypeconv(left,u32inttype); + inserttypeconv(right,u32inttype); + end; + firstpass(left); + firstpass(right); + result := true; + end; + end; + + + function taddnode.first_add64bitint: tnode; + var + procname: string[31]; + temp: tnode; + power: longint; + begin + result := nil; + { create helper calls mul } + if nodetype <> muln then + exit; + + { make sure that if there is a constant, that it's on the right } + if left.nodetype = ordconstn then + begin + temp := right; + right := left; + left := temp; + end; + + { can we use a shift instead of a mul? } + if not (cs_check_overflow in current_settings.localswitches) and + (right.nodetype = ordconstn) and + ispowerof2(tordconstnode(right).value,power) then + begin + tordconstnode(right).value := power; + result := cshlshrnode.create(shln,left,right); + { left and right are reused } + left := nil; + right := nil; + { return firstpassed new node } + exit; + end; + + if not(use_generic_mul32to64) and + try_make_mul32to64 then + exit; + + { when currency is used set the result of the + parameters to s64bit, so they are not converted } + if is_currency(resultdef) then + begin + left.resultdef:=s64inttype; + right.resultdef:=s64inttype; + end; + + { otherwise, create the parameters for the helper } + right := ccallparanode.create( + cordconstnode.create(ord(cs_check_overflow in current_settings.localswitches),pasbool8type,true), + ccallparanode.create(right,ccallparanode.create(left,nil))); + left := nil; + { only qword needs the unsigned code, the + signed code is also used for currency } + if is_signed(resultdef) then + procname := 'fpc_mul_int64' + else + procname := 'fpc_mul_qword'; + result := ccallnode.createintern(procname,right); + right := nil; + end; + + + function taddnode.first_addfloat : tnode; + var + procname: string[31]; + { do we need to reverse the result ? } + notnode : boolean; + fdef : tdef; + begin + result := nil; + notnode := false; + { In non-emulation mode, real opcodes are + emitted for floating point values. + } + if not (cs_fp_emulation in current_settings.moduleswitches) then + exit; + + if not(target_info.system in systems_wince) then + begin + case tfloatdef(left.resultdef).floattype of + s32real: + begin + fdef:=search_system_type('FLOAT32REC').typedef; + procname:='float32'; + end; + s64real: + begin + fdef:=search_system_type('FLOAT64').typedef; + procname:='float64'; + end; + {!!! not yet implemented + s128real: + } + else + internalerror(2005082601); + end; + + case nodetype of + addn: + procname:=procname+'_add'; + muln: + procname:=procname+'_mul'; + subn: + procname:=procname+'_sub'; + slashn: + procname:=procname+'_div'; + ltn: + procname:=procname+'_lt'; + lten: + procname:=procname+'_le'; + gtn: + begin + procname:=procname+'_le'; + notnode:=true; + end; + gten: + begin + procname:=procname+'_lt'; + notnode:=true; + end; + equaln: + procname:=procname+'_eq'; + unequaln: + begin + procname:=procname+'_eq'; + notnode:=true; + end; + else + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),left.resultdef.typename,right.resultdef.typename); + end; + end + else + begin + case nodetype of + addn: + procname:='ADD'; + muln: + procname:='MUL'; + subn: + procname:='SUB'; + slashn: + procname:='DIV'; + ltn: + procname:='LT'; + lten: + procname:='LE'; + gtn: + procname:='GT'; + gten: + procname:='GE'; + equaln: + procname:='EQ'; + unequaln: + procname:='NE'; + else + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),left.resultdef.typename,right.resultdef.typename); + end; + case tfloatdef(left.resultdef).floattype of + s32real: + begin + procname:=procname+'S'; + if nodetype in [addn,muln,subn,slashn] then + procname:=lower(procname); + end; + s64real: + procname:=procname+'D'; + {!!! not yet implemented + s128real: + } + else + internalerror(2005082602); + end; + + end; + { cast softfpu result? } + if not(target_info.system in systems_wince) then + begin + if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then + resultdef:=pasbool8type; + result:=ctypeconvnode.create_internal(ccallnode.createintern(procname,ccallparanode.create( + ctypeconvnode.create_internal(right,fdef), + ccallparanode.create( + ctypeconvnode.create_internal(left,fdef),nil))),resultdef); + end + else + result:=ccallnode.createintern(procname,ccallparanode.create(right, + ccallparanode.create(left,nil))); + left:=nil; + right:=nil; + + { do we need to reverse the result } + if notnode then + result:=cnotnode.create(result); + end; + + + function taddnode.pass_1 : tnode; + var +{$ifdef addstringopt} + hp : tnode; +{$endif addstringopt} + rd,ld : tdef; + i : longint; + lt,rt : tnodetype; +{$ifdef cpuneedsmulhelper} + procname : string[32]; +{$endif cpuneedsmulhelper} + begin + result:=nil; + + { Can we optimize multiple string additions into a single call? + This need to be done on a complete tree to detect the multiple + add nodes and is therefor done before the subtrees are processed } + if canbemultistringadd(self) then + begin + result := genmultistringadd(self); + exit; + end; + + { first do the two subtrees } + firstpass(left); + firstpass(right); + + if codegenerror then + exit; + + { load easier access variables } + rd:=right.resultdef; + ld:=left.resultdef; + rt:=right.nodetype; + lt:=left.nodetype; + + { int/int gives real/real! } + if nodetype=slashn then + begin +{$ifdef cpufpemu} + if (current_settings.fputype=fpu_soft) or (cs_fp_emulation in current_settings.moduleswitches) then + begin + result:=first_addfloat; + if assigned(result) then + exit; + end; +{$endif cpufpemu} + expectloc:=LOC_FPUREGISTER; + end + + { if both are orddefs then check sub types } + else if (ld.typ=orddef) and (rd.typ=orddef) then + begin + { optimize multiplacation by a power of 2 } + if not(cs_check_overflow in current_settings.localswitches) and + (nodetype = muln) and + (((left.nodetype = ordconstn) and + ispowerof2(tordconstnode(left).value,i)) or + ((right.nodetype = ordconstn) and + ispowerof2(tordconstnode(right).value,i))) then + begin + if left.nodetype = ordconstn then + begin + tordconstnode(left).value := i; + result := cshlshrnode.create(shln,right,left); + end + else + begin + tordconstnode(right).value := i; + result := cshlshrnode.create(shln,left,right); + end; + left := nil; + right := nil; + exit; + end; + + { 2 booleans ? } + if is_boolean(ld) and is_boolean(rd) then + begin + if (not(cs_full_boolean_eval in current_settings.localswitches) or + (nf_short_bool in flags)) and + (nodetype in [andn,orn]) then + expectloc:=LOC_JUMP + else + begin + if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then + expectloc:=LOC_FLAGS + else + expectloc:=LOC_REGISTER; + end; + end + else + { Both are chars? only convert to shortstrings for addn } + if is_char(ld) then + begin + if nodetype=addn then + internalerror(200103291); + expectloc:=LOC_FLAGS; + end +{$ifndef cpu64bitaddr} + { is there a 64 bit type ? } + else if (torddef(ld).ordtype in [s64bit,u64bit,scurrency]) then + begin + result := first_add64bitint; + if assigned(result) then + exit; + if nodetype in [addn,subn,muln,andn,orn,xorn] then + expectloc:=LOC_REGISTER + else + expectloc:=LOC_JUMP; + end +{$endif cpu64bitaddr} +{$ifndef cpuneedsmulhelper} + { is there a cardinal? } + else if (torddef(ld).ordtype=u32bit) then + begin + if nodetype in [addn,subn,muln,andn,orn,xorn] then + expectloc:=LOC_REGISTER + else + expectloc:=LOC_FLAGS; + end +{$endif cpuneedsmulhelper} + { generic s32bit conversion } + else + begin +{$ifdef cpuneedsmulhelper} + if (nodetype=muln) and not(torddef(resultdef).ordtype in [u8bit,s8bit]) then + begin + result := nil; + + case torddef(resultdef).ordtype of + s16bit: + procname := 'fpc_mul_integer'; + u16bit: + procname := 'fpc_mul_word'; + s32bit: + procname := 'fpc_mul_longint'; + u32bit: + procname := 'fpc_mul_dword'; + else + internalerror(2011022301); + end; + result := ccallnode.createintern(procname, + ccallparanode.create(cordconstnode.create(0,pasbool8type,false), + ccallparanode.create(right, + ccallparanode.create(left,nil)))); + left := nil; + right := nil; + firstpass(result); + exit; + end; +{$endif cpuneedsmulhelper} + if nodetype in [addn,subn,muln,andn,orn,xorn] then + expectloc:=LOC_REGISTER + else + expectloc:=LOC_FLAGS; + end; + end + + { left side a setdef, must be before string processing, + else array constructor can be seen as array of char (PFV) } + else if (ld.typ=setdef) then + begin + { small sets are handled inline by the compiler. + small set doesn't have support for adding ranges } + if is_smallset(ld) and + not( + (right.nodetype=setelementn) and + assigned(tsetelementnode(right).right) + ) then + begin + if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then + expectloc:=LOC_FLAGS + else + expectloc:=LOC_REGISTER; + end + else + begin + result := first_addset; + if assigned(result) then + exit; + expectloc:=LOC_CREFERENCE; + end; + end + + { compare pchar by addresses like BP/Delphi } + else if is_pchar(ld) then + begin + if nodetype in [addn,subn,muln,andn,orn,xorn] then + expectloc:=LOC_REGISTER + else + expectloc:=LOC_FLAGS; + end + + { is one of the operands a string } + else if (ld.typ=stringdef) then + begin + if is_widestring(ld) then + begin + { this is only for add, the comparisaion is handled later } + expectloc:=LOC_REGISTER; + end + else if is_unicodestring(ld) then + begin + { this is only for add, the comparisaion is handled later } + expectloc:=LOC_REGISTER; + end + else if is_ansistring(ld) then + begin + { this is only for add, the comparisaion is handled later } + expectloc:=LOC_REGISTER; + end + else if is_longstring(ld) then + begin + { this is only for add, the comparisaion is handled later } + expectloc:=LOC_REFERENCE; + end + else + begin +{$ifdef addstringopt} + { can create a call which isn't handled by callparatemp } + if canbeaddsstringcharoptnode(self) then + begin + hp := genaddsstringcharoptnode(self); + pass_1 := hp; + exit; + end + else +{$endif addstringopt} + begin + { Fix right to be shortstring } + if is_char(right.resultdef) then + begin + inserttypeconv(right,cshortstringtype); + firstpass(right); + end; + end; +{$ifdef addstringopt} + { can create a call which isn't handled by callparatemp } + if canbeaddsstringcsstringoptnode(self) then + begin + hp := genaddsstringcsstringoptnode(self); + pass_1 := hp; + exit; + end; +{$endif addstringopt} + end; + { otherwise, let addstring convert everything } + result := first_addstring; + exit; + end + + { is one a real float ? } + else if (rd.typ=floatdef) or (ld.typ=floatdef) then + begin +{$ifdef cpufpemu} + if (current_settings.fputype=fpu_soft) or (cs_fp_emulation in current_settings.moduleswitches) then + begin + result:=first_addfloat; + if assigned(result) then + exit; + end; +{$endif cpufpemu} + if nodetype in [addn,subn,muln,andn,orn,xorn] then + expectloc:=LOC_FPUREGISTER + else + expectloc:=LOC_FLAGS; + end + + { pointer comperation and subtraction } + else if (ld.typ=pointerdef) then + begin + if nodetype in [addn,subn,muln,andn,orn,xorn] then + expectloc:=LOC_REGISTER + else + expectloc:=LOC_FLAGS; + end + + else if is_implicit_pointer_object_type(ld) then + begin + expectloc:=LOC_FLAGS; + end + + else if (ld.typ=classrefdef) then + begin + expectloc:=LOC_FLAGS; + end + + { support procvar=nil,procvar<>nil } + else if ((ld.typ=procvardef) and (rt=niln)) or + ((rd.typ=procvardef) and (lt=niln)) then + begin + expectloc:=LOC_FLAGS; + end + +{$ifdef SUPPORT_MMX} + { mmx support, this must be before the zero based array + check } + else if (cs_mmx in current_settings.localswitches) and is_mmx_able_array(ld) and + is_mmx_able_array(rd) then + begin + expectloc:=LOC_MMXREGISTER; + end +{$endif SUPPORT_MMX} + + else if (rd.typ=pointerdef) or (ld.typ=pointerdef) then + begin + expectloc:=LOC_REGISTER; + end + + else if (rd.typ=procvardef) and + (ld.typ=procvardef) and + equal_defs(rd,ld) then + begin + expectloc:=LOC_FLAGS; + end + + else if (ld.typ=enumdef) then + begin + expectloc:=LOC_FLAGS; + end + +{$ifdef SUPPORT_MMX} + else if (cs_mmx in current_settings.localswitches) and + is_mmx_able_array(ld) and + is_mmx_able_array(rd) then + begin + expectloc:=LOC_MMXREGISTER; + end +{$endif SUPPORT_MMX} + + { the general solution is to convert to 32 bit int } + else + begin + expectloc:=LOC_REGISTER; + end; + end; + +{$ifdef state_tracking} + function Taddnode.track_state_pass(exec_known:boolean):boolean; + + var factval:Tnode; + + begin + track_state_pass:=false; + if left.track_state_pass(exec_known) then + begin + track_state_pass:=true; + left.resultdef:=nil; + do_typecheckpass(left); + end; + factval:=aktstate.find_fact(left); + if factval<>nil then + begin + track_state_pass:=true; + left.destroy; + left:=factval.getcopy; + end; + if right.track_state_pass(exec_known) then + begin + track_state_pass:=true; + right.resultdef:=nil; + do_typecheckpass(right); + end; + factval:=aktstate.find_fact(right); + if factval<>nil then + begin + track_state_pass:=true; + right.destroy; + right:=factval.getcopy; + end; + end; +{$endif} + +end. diff --git a/closures/compiler/nbas.pas b/closures/compiler/nbas.pas new file mode 100644 index 0000000000..78b741fcf8 --- /dev/null +++ b/closures/compiler/nbas.pas @@ -0,0 +1,1130 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + This unit implements some basic 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 nbas; + +{$i fpcdefs.inc} + +interface + + uses + globtype, + cpuinfo,cpubase,cgbase,cgutils, + aasmbase,aasmtai,aasmdata,aasmcpu, + node, + symtype; + + type + tnothingnode = class(tnode) + constructor create;virtual; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + end; + tnothingnodeclass = class of tnothingnode; + + terrornode = class(tnode) + constructor create;virtual; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + procedure mark_write;override; + end; + terrornodeclass = class of terrornode; + + tasmnode = class(tnode) + p_asm : TAsmList; + currenttai : tai; + { Used registers in assembler block } + used_regs_int, + used_regs_fpu : tcpuregisterset; + constructor create(p : TAsmList);virtual; + constructor create_get_position; + destructor destroy;override; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + function dogetcopy : tnode;override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function docompare(p: tnode): boolean; override; + end; + tasmnodeclass = class of tasmnode; + + tstatementnode = class(tbinarynode) + constructor create(l,r : tnode);virtual; + function simplify(forinline : boolean) : tnode; override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + procedure printnodetree(var t:text);override; + property statement : tnode read left write left; + property next : tnode read right write right; + end; + tstatementnodeclass = class of tstatementnode; + + tblocknode = class(tunarynode) + constructor create(l : tnode);virtual; + destructor destroy; override; + function simplify(forinline : boolean) : tnode; override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; +{$ifdef state_tracking} + function track_state_pass(exec_known:boolean):boolean;override; +{$endif state_tracking} + property statements : tnode read left write left; + end; + tblocknodeclass = class of tblocknode; + + ttempcreatenode = class; + + ttempinfoflag = (ti_may_be_in_reg,ti_valid,ti_nextref_set_hookoncopy_nil, + ti_addr_taken,ti_executeinitialisation); + ttempinfoflags = set of ttempinfoflag; + + const + tempinfostoreflags = [ti_may_be_in_reg,ti_addr_taken]; + + type + { to allow access to the location by temp references even after the temp has } + { already been disposed and to make sure the coherency between temps and } + { temp references is kept after a getcopy } + ptempinfo = ^ttempinfo; + ttempinfo = record + { set to the copy of a tempcreate pnode (if it gets copied) so that the } + { refs and deletenode can hook to this copy once they get copied too } + hookoncopy : ptempinfo; + typedef : tdef; + typedefderef : tderef; + temptype : ttemptype; + owner : ttempcreatenode; + withnode : tnode; + location : tlocation; + flags : ttempinfoflags; + tempinitcode : tnode; + end; + + { a node which will create a (non)persistent temp of a given type with a given } + { size (the size is separate to allow creating "void" temps with a custom size) } + ttempcreatenode = class(tnode) + size: tcgint; + tempinfo: ptempinfo; + ftemplvalue : tnode; + { * persistent temps are used in manually written code where the temp } + { be usable among different statements and where you can manually say } + { when the temp has to be freed (using a ttempdeletenode) } + { * non-persistent temps are mostly used in typeconversion helpers, } + { where the node that receives the temp becomes responsible for } + { freeing it. In this last case, you must use only one reference } + { to it and *not* generate a ttempdeletenode } + constructor create(_typedef: tdef; _size: tcgint; _temptype: ttemptype;allowreg:boolean); virtual; + constructor create_withnode(_typedef: tdef; _size: tcgint; _temptype: ttemptype; allowreg:boolean; withnode: tnode); virtual; + constructor create_value(_typedef:tdef; _size: tcgint; _temptype: ttemptype;allowreg:boolean; templvalue: tnode); + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + function dogetcopy: tnode; override; + function pass_1 : tnode; override; + function pass_typecheck: tnode; override; + function docompare(p: tnode): boolean; override; + procedure printnodedata(var t:text);override; + end; + ttempcreatenodeclass = class of ttempcreatenode; + + { a node which is a reference to a certain temp } + ttemprefnode = class(tnode) + tempinfo: ptempinfo; + + constructor create(const temp: ttempcreatenode); virtual; + constructor create_offset(const temp: ttempcreatenode;aoffset:longint); + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure resolveppuidx;override; + function dogetcopy: tnode; override; + function pass_1 : tnode; override; + function pass_typecheck : tnode; override; + procedure mark_write;override; + function docompare(p: tnode): boolean; override; + procedure printnodedata(var t:text);override; + protected + offset : longint; + private + tempidx : longint; + end; + ttemprefnodeclass = class of ttemprefnode; + + { a node which removes a temp } + ttempdeletenode = class(tnode) + tempinfo: ptempinfo; + constructor create(const temp: ttempcreatenode); virtual; + { this will convert the persistant temp to a normal temp + for returning to the other nodes } + constructor create_normal_temp(const temp: ttempcreatenode); + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure resolveppuidx;override; + function dogetcopy: tnode; override; + function pass_1: tnode; override; + function pass_typecheck: tnode; override; + function docompare(p: tnode): boolean; override; + destructor destroy; override; + procedure printnodedata(var t:text);override; + protected + release_to_normal : boolean; + private + tempidx : longint; + end; + ttempdeletenodeclass = class of ttempdeletenode; + + var + cnothingnode : tnothingnodeclass = tnothingnode; + cerrornode : terrornodeclass = terrornode; + casmnode : tasmnodeclass = tasmnode; + cstatementnode : tstatementnodeclass = tstatementnode; + cblocknode : tblocknodeclass = tblocknode; + ctempcreatenode : ttempcreatenodeclass = ttempcreatenode; + ctemprefnode : ttemprefnodeclass = ttemprefnode; + ctempdeletenode : ttempdeletenodeclass = ttempdeletenode; + + { Create a blocknode and statement node for multiple statements + generated internally by the parser } + function internalstatements(var laststatement:tstatementnode):tblocknode; + function laststatement(block:tblocknode):tstatementnode; + procedure addstatement(var laststatement:tstatementnode;n:tnode); + + +implementation + + uses + cutils, + verbose,globals,systems, + symconst,symdef,defutil,defcmp, + pass_1, + nutils,nld,ncal,nflw, + procinfo + ; + + +{***************************************************************************** + Helpers +*****************************************************************************} + + function internalstatements(var laststatement:tstatementnode):tblocknode; + begin + { create dummy initial statement } + laststatement := cstatementnode.create(cnothingnode.create,nil); + internalstatements := cblocknode.create(laststatement); + end; + + + function laststatement(block:tblocknode):tstatementnode; + begin + result:=tstatementnode(block.left); + while assigned(result) and assigned(result.right) do + result:=tstatementnode(result.right); + end; + + + procedure addstatement(var laststatement:tstatementnode;n:tnode); + begin + if assigned(laststatement.right) then + internalerror(200204201); + laststatement.right:=cstatementnode.create(n,nil); + laststatement:=tstatementnode(laststatement.right); + end; + + +{***************************************************************************** + TFIRSTNOTHING +*****************************************************************************} + + constructor tnothingnode.create; + begin + inherited create(nothingn); + end; + + + function tnothingnode.pass_typecheck:tnode; + begin + result:=nil; + resultdef:=voidtype; + end; + + + function tnothingnode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_VOID; + end; + + +{***************************************************************************** + TFIRSTERROR +*****************************************************************************} + + constructor terrornode.create; + + begin + inherited create(errorn); + end; + + + function terrornode.pass_typecheck:tnode; + begin + result:=nil; + include(flags,nf_error); + codegenerror:=true; + resultdef:=generrordef; + end; + + + function terrornode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_VOID; + codegenerror:=true; + end; + + + procedure terrornode.mark_write; + begin + end; + +{***************************************************************************** + TSTATEMENTNODE +*****************************************************************************} + + constructor tstatementnode.create(l,r : tnode); + + begin + inherited create(statementn,l,r); + end; + + + function is_exit_statement(var n: tnode; arg: pointer): foreachnoderesult; + begin + if (n.nodetype<>exitn) then + result:=fen_false + else + result:=fen_norecurse_true; + end; + + + function no_exit_statement_in_block(n: tnode): boolean; + begin + result:=not foreachnodestatic(n,@is_exit_statement,nil); + end; + + + function tstatementnode.simplify(forinline: boolean) : tnode; + begin + result:=nil; + { these "optimizations" are only to make it more easy to recognise } + { blocknodes which at the end of inlining only contain one single } + { statement. Simplifying inside blocknode.simplify could be dangerous } + { because if the main blocknode which makes up a procedure/function } + { body were replaced with a statementn/nothingn, this could cause } + { problems elsewhere in the compiler which expects a blocknode } + + { remove next statement if it's a nothing-statement (since if it's } + { the last, it won't remove itself -- see next simplification) } + while assigned(right) and + (tstatementnode(right).left.nodetype = nothingn) do + begin + result:=tstatementnode(right).right; + tstatementnode(right).right:=nil; + right.free; + right:=result; + result:=nil; + end; + + { Remove initial nothingn if there are other statements. If there } + { are no other statements, returning nil doesn't help (will be } + { interpreted as "can't be simplified") and replacing the } + { statementnode with a nothingnode cannot be done (because it's } + { possible this statementnode is a child of a blocknode, and } + { blocknodes are expected to only contain statementnodes) } + if (left.nodetype = nothingn) and + assigned(right) then + begin + result:=right; + right:=nil; + exit; + end; + + { if the current statement contains a block with one statement, } + { replace the current statement with that block's statement } + { (but only if the block does not have nf_block_with_exit set } + { or has no exit statement, because otherwise it needs an own } + { exit label, see tests/test/tinline10) } + if (left.nodetype = blockn) and + (not(nf_block_with_exit in left.flags) or + no_exit_statement_in_block(left)) and + assigned(tblocknode(left).left) and + not assigned(tstatementnode(tblocknode(left).left).right) then + begin + result:=tblocknode(left).left; + tstatementnode(result).right:=right; + right:=nil; + tblocknode(left).left:=nil; + exit; + end; + end; + + + function tstatementnode.pass_typecheck:tnode; + begin + result:=nil; + resultdef:=voidtype; + + { left is the statement itself calln assignn or a complex one } + typecheckpass(left); + if codegenerror then + exit; + + { right is the next statement in the list } + if assigned(right) then + typecheckpass(right); + if codegenerror then + exit; + end; + + + function tstatementnode.pass_1 : tnode; + begin + result:=nil; + { left is the statement itself calln assignn or a complex one } + firstpass(left); + if codegenerror then + exit; + expectloc:=left.expectloc; + { right is the next in the list } + if assigned(right) then + firstpass(right); + if codegenerror then + exit; + end; + + + procedure tstatementnode.printnodetree(var t:text); + begin + printnodelist(t); + end; + +{***************************************************************************** + TBLOCKNODE +*****************************************************************************} + + constructor tblocknode.create(l : tnode); + + begin + inherited create(blockn,l); + end; + + destructor tblocknode.destroy; + + var + hp, next: tstatementnode; + begin + hp := tstatementnode(left); + left := nil; + while assigned(hp) do + begin + next := tstatementnode(hp.right); + hp.right := nil; + hp.free; + hp := next; + end; + inherited destroy; + end; + + + function tblocknode.simplify(forinline : boolean): tnode; + begin + result := nil; + { Warning: never replace a blocknode with another node type, } + { since the block may be the main block of a procedure/function/ } + { main program body, and those nodes should always be blocknodes } + { since that's what the compiler expects elsewhere. } + + { if the current block contains only one statement, and } + { this one statement only contains another block, replace } + { this block with that other block. } + if assigned(left) and + not assigned(tstatementnode(left).right) and + (tstatementnode(left).left.nodetype = blockn) then + begin + result:=tstatementnode(left).left; + tstatementnode(left).left:=nil; + { make sure the nf_block_with_exit flag is safeguarded } + result.flags:=result.flags+(flags * [nf_block_with_exit]); + exit; + end; + end; + + + function tblocknode.pass_typecheck:tnode; + var + hp : tstatementnode; + begin + result:=nil; + resultdef:=voidtype; + + hp:=tstatementnode(left); + while assigned(hp) do + begin + if assigned(hp.left) then + begin + codegenerror:=false; + typecheckpass(hp.left); + { the resultdef of the block is the last type that is + returned. Normally this is a voidtype. But when the + compiler inserts a block of multiple statements then the + last entry can return a value } + resultdef:=hp.left.resultdef; + end; + hp:=tstatementnode(hp.right); + end; + end; + + + function tblocknode.pass_1 : tnode; + var + hp : tstatementnode; + //count : longint; + begin + result:=nil; + expectloc:=LOC_VOID; + //count:=0; + hp:=tstatementnode(left); + while assigned(hp) do + begin + if assigned(hp.left) then + begin + codegenerror:=false; + firstpass(hp.left); + hp.expectloc:=hp.left.expectloc; + end; + expectloc:=hp.expectloc; + //inc(count); + hp:=tstatementnode(hp.right); + end; + end; + +{$ifdef state_tracking} + function Tblocknode.track_state_pass(exec_known:boolean):boolean; + + var hp:Tstatementnode; + + begin + track_state_pass:=false; + hp:=Tstatementnode(left); + while assigned(hp) do + begin + if hp.left.track_state_pass(exec_known) then + track_state_pass:=true; + hp:=Tstatementnode(hp.right); + end; + end; +{$endif state_tracking} + +{***************************************************************************** + TASMNODE +*****************************************************************************} + + constructor tasmnode.create(p : TAsmList); + begin + inherited create(asmn); + p_asm:=p; + currenttai:=nil; + used_regs_int:=[]; + used_regs_fpu:=[]; + end; + + + constructor tasmnode.create_get_position; + begin + inherited create(asmn); + p_asm:=nil; + include(flags,nf_get_asm_position); + currenttai:=nil; + end; + + + destructor tasmnode.destroy; + begin + if assigned(p_asm) then + p_asm.free; + inherited destroy; + end; + + + constructor tasmnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + var + hp : tai; + begin + inherited ppuload(t,ppufile); + if not(nf_get_asm_position in flags) then + begin + p_asm:=TAsmList.create; + repeat + hp:=ppuloadai(ppufile); + if hp=nil then + break; + p_asm.concat(hp); + until false; + end + else + p_asm:=nil; + currenttai:=nil; + end; + + + procedure tasmnode.ppuwrite(ppufile:tcompilerppufile); + var + hp : tai; + begin + inherited ppuwrite(ppufile); +{ TODO: FIXME Add saving of register sets} + if not(nf_get_asm_position in flags) then + begin + hp:=tai(p_asm.first); + while assigned(hp) do + begin + ppuwriteai(ppufile,hp); + hp:=tai(hp.next); + end; + { end is marked by a nil } + ppuwriteai(ppufile,nil); + end; + end; + + + procedure tasmnode.buildderefimpl; + var + hp : tai; + begin + inherited buildderefimpl; + if not(nf_get_asm_position in flags) then + begin + hp:=tai(p_asm.first); + while assigned(hp) do + begin + hp.buildderefimpl; + hp:=tai(hp.next); + end; + end; + end; + + + procedure tasmnode.derefimpl; + var + hp : tai; + begin + inherited derefimpl; + if not(nf_get_asm_position in flags) then + begin + hp:=tai(p_asm.first); + while assigned(hp) do + begin + hp.derefimpl; + hp:=tai(hp.next); + end; + end; + end; + + + function tasmnode.dogetcopy: tnode; + var + n: tasmnode; + begin + n := tasmnode(inherited dogetcopy); + if assigned(p_asm) then + begin + n.p_asm:=TAsmList.create; + n.p_asm.concatlistcopy(p_asm); + end + else n.p_asm := nil; + n.currenttai:=currenttai; + result:=n; + end; + + + function tasmnode.pass_typecheck:tnode; + begin + result:=nil; + resultdef:=voidtype; + if not(nf_get_asm_position in flags) then + include(current_procinfo.flags,pi_has_assembler_block); + end; + + + function tasmnode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_VOID; + end; + + + function tasmnode.docompare(p: tnode): boolean; + begin + { comparing of asmlists is not implemented (JM) } + docompare := false; + end; + + +{***************************************************************************** + TEMPCREATENODE +*****************************************************************************} + + constructor ttempcreatenode.create(_typedef:tdef; _size: tcgint; _temptype: ttemptype;allowreg:boolean); + begin + inherited create(tempcreaten); + size := _size; + new(tempinfo); + fillchar(tempinfo^,sizeof(tempinfo^),0); + tempinfo^.typedef := _typedef; + tempinfo^.temptype := _temptype; + tempinfo^.owner := self; + tempinfo^.withnode := nil; + if allowreg and + { temp must fit a single register } + (tstoreddef(_typedef).is_fpuregable or + (tstoreddef(_typedef).is_intregable and + (_size<=TCGSize2Size[OS_64]))) and + { size of register operations must be known } + (def_cgsize(_typedef)<>OS_NO) and + { no init/final needed } + not is_managed_type(_typedef) then + include(tempinfo^.flags,ti_may_be_in_reg); + end; + + + constructor ttempcreatenode.create_withnode(_typedef: tdef; _size: tcgint; _temptype: ttemptype; allowreg:boolean; withnode: tnode); + begin + self.create(_typedef,_size,_temptype,allowreg); + tempinfo^.withnode:=withnode.getcopy; + end; + + + constructor ttempcreatenode.create_value(_typedef:tdef; _size: tcgint; _temptype: ttemptype;allowreg:boolean; templvalue: tnode); + begin + self.create(_typedef,_size,_temptype,allowreg); + // store in ppuwrite + ftemplvalue:=templvalue; + // create from stored ftemplvalue in ppuload + tempinfo^.tempinitcode:=cassignmentnode.create(ctemprefnode.create(self),ftemplvalue); + end; + + + function ttempcreatenode.dogetcopy: tnode; + var + n: ttempcreatenode; + begin + n := ttempcreatenode(inherited dogetcopy); + n.size := size; + + new(n.tempinfo); + fillchar(n.tempinfo^,sizeof(n.tempinfo^),0); + n.tempinfo^.owner:=n; + n.tempinfo^.typedef := tempinfo^.typedef; + n.tempinfo^.temptype := tempinfo^.temptype; + n.tempinfo^.flags := tempinfo^.flags * tempinfostoreflags; + + { when the tempinfo has already a hookoncopy then it is not + reset by a tempdeletenode } + if assigned(tempinfo^.hookoncopy) then + internalerror(200211262); + { signal the temprefs that the temp they point to has been copied, } + { so that if the refs get copied as well, they can hook themselves } + { to the copy of the temp } + tempinfo^.hookoncopy := n.tempinfo; + exclude(tempinfo^.flags,ti_nextref_set_hookoncopy_nil); + + if assigned(tempinfo^.withnode) then + n.tempinfo^.withnode := tempinfo^.withnode.getcopy + else + n.tempinfo^.withnode := nil; + + if assigned(tempinfo^.tempinitcode) then + n.tempinfo^.tempinitcode := tempinfo^.tempinitcode.getcopy + else + n.tempinfo^.tempinitcode := nil; + + result := n; + end; + + + constructor ttempcreatenode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + + size:=ppufile.getlongint; + new(tempinfo); + fillchar(tempinfo^,sizeof(tempinfo^),0); + ppufile.getsmallset(tempinfo^.flags); + ppufile.getderef(tempinfo^.typedefderef); + tempinfo^.temptype := ttemptype(ppufile.getbyte); + tempinfo^.owner:=self; + tempinfo^.withnode:=ppuloadnode(ppufile); + ftemplvalue:=ppuloadnode(ppufile); + end; + + + procedure ttempcreatenode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putlongint(size); + ppufile.putsmallset(tempinfo^.flags); + ppufile.putderef(tempinfo^.typedefderef); + ppufile.putbyte(byte(tempinfo^.temptype)); + ppuwritenode(ppufile,tempinfo^.withnode); + ppuwritenode(ppufile,ftemplvalue); + end; + + + procedure ttempcreatenode.buildderefimpl; + begin + inherited buildderefimpl; + tempinfo^.typedefderef.build(tempinfo^.typedef); + if assigned(tempinfo^.withnode) then + tempinfo^.withnode.buildderefimpl; + if assigned(ftemplvalue) then + ftemplvalue.buildderefimpl; + end; + + + procedure ttempcreatenode.derefimpl; + begin + inherited derefimpl; + tempinfo^.typedef:=tdef(tempinfo^.typedefderef.resolve); + if assigned(tempinfo^.withnode) then + tempinfo^.withnode.derefimpl; + if assigned(ftemplvalue) then + begin + ftemplvalue.derefimpl; + tempinfo^.tempinitcode:=cassignmentnode.create(ctemprefnode.create(self),ftemplvalue); + end; + end; + + + function ttempcreatenode.pass_1 : tnode; + begin + result := nil; + expectloc:=LOC_VOID; + if (tempinfo^.typedef.needs_inittable) then + include(current_procinfo.flags,pi_needs_implicit_finally); + if assigned(tempinfo^.withnode) then + firstpass(tempinfo^.withnode); + if assigned(tempinfo^.tempinitcode) then + firstpass(tempinfo^.tempinitcode); + end; + + + function ttempcreatenode.pass_typecheck: tnode; + begin + result := nil; + { a tempcreatenode doesn't have a resultdef, only temprefnodes do } + resultdef := voidtype; + if assigned(tempinfo^.withnode) then + typecheckpass(tempinfo^.withnode); + if assigned(tempinfo^.tempinitcode) then + typecheckpass(tempinfo^.tempinitcode); + end; + + + function ttempcreatenode.docompare(p: tnode): boolean; + begin + result := + inherited docompare(p) and + (ttempcreatenode(p).size = size) and + (ttempcreatenode(p).tempinfo^.flags*tempinfostoreflags=tempinfo^.flags*tempinfostoreflags) and + equal_defs(ttempcreatenode(p).tempinfo^.typedef,tempinfo^.typedef) and + (ttempcreatenode(p).tempinfo^.withnode.isequal(tempinfo^.withnode)) and + (ttempcreatenode(p).tempinfo^.tempinitcode.isequal(tempinfo^.tempinitcode)); + end; + + + procedure ttempcreatenode.printnodedata(var t:text); + begin + inherited printnodedata(t); + writeln(t,printnodeindention,'size = ',size,', temptypedef = ',tempinfo^.typedef.typesymbolprettyname,' = "', + tempinfo^.typedef.GetTypeName,'", tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2)); + end; + +{***************************************************************************** + TEMPREFNODE +*****************************************************************************} + + constructor ttemprefnode.create(const temp: ttempcreatenode); + begin + inherited create(temprefn); + tempinfo := temp.tempinfo; + offset:=0; + end; + + + constructor ttemprefnode.create_offset(const temp: ttempcreatenode;aoffset:longint); + begin + self.create(temp); + offset := aoffset; + end; + + + function ttemprefnode.dogetcopy: tnode; + var + n: ttemprefnode; + begin + n := ttemprefnode(inherited dogetcopy); + n.offset := offset; + + if assigned(tempinfo^.hookoncopy) then + { if the temp has been copied, assume it becomes a new } + { temp which has to be hooked by the copied reference } + begin + { hook the ref to the copied temp } + n.tempinfo := tempinfo^.hookoncopy; + { if we passed a ttempdeletenode that changed the temp } + { from a persistent one into a normal one, we must be } + { the last reference (since our parent should free the } + { temp (JM) } + if (ti_nextref_set_hookoncopy_nil in tempinfo^.flags) then + tempinfo^.hookoncopy := nil; + end + else + { if the temp we refer to hasn't been copied, assume } + { we're just a new reference to that temp } + begin + n.tempinfo := tempinfo; + end; + + if not assigned(n.tempinfo) then + internalerror(2005071901); + + result := n; + end; + + + constructor ttemprefnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + tempidx:=ppufile.getlongint; + offset:=ppufile.getlongint; + end; + + + procedure ttemprefnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putlongint(tempinfo^.owner.ppuidx); + ppufile.putlongint(offset); + end; + + + procedure ttemprefnode.resolveppuidx; + var + temp : ttempcreatenode; + begin + temp:=ttempcreatenode(nodeppuidxget(tempidx)); + if temp.nodetype<>tempcreaten then + internalerror(200311075); + tempinfo:=temp.tempinfo; + end; + + + function ttemprefnode.pass_1 : tnode; + begin + expectloc := LOC_REFERENCE; + if not tempinfo^.typedef.needs_inittable and + (ti_may_be_in_reg in tempinfo^.flags) then + begin + if tempinfo^.typedef.typ=floatdef then + begin + if not use_vectorfpu(tempinfo^.typedef) then + if (tempinfo^.temptype = tt_persistent) then + expectloc := LOC_CFPUREGISTER + else + expectloc := LOC_FPUREGISTER + else + if (tempinfo^.temptype = tt_persistent) then + expectloc := LOC_CMMREGISTER + else + expectloc := LOC_MMREGISTER + end + else + begin + if (tempinfo^.temptype = tt_persistent) then + expectloc := LOC_CREGISTER + else + expectloc := LOC_REGISTER; + end; + end; + result := nil; + end; + + + function ttemprefnode.pass_typecheck: tnode; + begin + { check if the temp is already resultdef passed } + if not assigned(tempinfo^.typedef) then + internalerror(200108233); + result := nil; + resultdef := tempinfo^.typedef; + end; + + + function ttemprefnode.docompare(p: tnode): boolean; + begin + result := + inherited docompare(p) and + (ttemprefnode(p).tempinfo = tempinfo) and + (ttemprefnode(p).offset = offset); + end; + + + procedure ttemprefnode.mark_write; + + begin + include(flags,nf_write); + end; + + procedure ttemprefnode.printnodedata(var t:text); + begin + inherited printnodedata(t); + writeln(t,printnodeindention,'temptypedef = ',tempinfo^.typedef.typesymbolprettyname,' = "', + tempinfo^.typedef.GetTypeName,'", tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2)); + end; + + +{***************************************************************************** + TEMPDELETENODE +*****************************************************************************} + + constructor ttempdeletenode.create(const temp: ttempcreatenode); + begin + inherited create(tempdeleten); + tempinfo := temp.tempinfo; + release_to_normal := false; + end; + + + constructor ttempdeletenode.create_normal_temp(const temp: ttempcreatenode); + begin + inherited create(tempdeleten); + tempinfo := temp.tempinfo; + release_to_normal := true; + if tempinfo^.temptype <> tt_persistent then + internalerror(200204211); + end; + + + function ttempdeletenode.dogetcopy: tnode; + var + n: ttempdeletenode; + begin + n:=ttempdeletenode(inherited dogetcopy); + n.release_to_normal:=release_to_normal; + + if assigned(tempinfo^.hookoncopy) then + { if the temp has been copied, assume it becomes a new } + { temp which has to be hooked by the copied deletenode } + begin + { hook the tempdeletenode to the copied temp } + n.tempinfo:=tempinfo^.hookoncopy; + { the temp shall not be used, reset hookoncopy } + { Only if release_to_normal is false, otherwise } + { the temp can still be referenced once more (JM) } + if (not release_to_normal) then + tempinfo^.hookoncopy:=nil + else + include(tempinfo^.flags,ti_nextref_set_hookoncopy_nil); + end + else + { if the temp we refer to hasn't been copied, we have a } + { problem since that means we now have two delete nodes } + { for one temp } + internalerror(200108234); + result:=n; + end; + + + constructor ttempdeletenode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + tempidx:=ppufile.getlongint; + release_to_normal:=(ppufile.getbyte<>0); + end; + + + procedure ttempdeletenode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putlongint(tempinfo^.owner.ppuidx); + ppufile.putbyte(byte(release_to_normal)); + end; + + + procedure ttempdeletenode.resolveppuidx; + var + temp : ttempcreatenode; + begin + temp:=ttempcreatenode(nodeppuidxget(tempidx)); + if temp.nodetype<>tempcreaten then + internalerror(200311075); + tempinfo:=temp.tempinfo; + end; + + + function ttempdeletenode.pass_1 : tnode; + begin + expectloc:=LOC_VOID; + result := nil; + end; + + function ttempdeletenode.pass_typecheck: tnode; + begin + result := nil; + resultdef := voidtype; + end; + + function ttempdeletenode.docompare(p: tnode): boolean; + begin + result := + inherited docompare(p) and + (ttemprefnode(p).tempinfo = tempinfo); + end; + + destructor ttempdeletenode.destroy; + begin + if assigned(tempinfo^.withnode) then + begin + tempinfo^.withnode.free; + end; + dispose(tempinfo); + end; + + procedure ttempdeletenode.printnodedata(var t:text); + begin + inherited printnodedata(t); + writeln(t,printnodeindention,'release_to_normal: ',release_to_normal,', temptypedef = ',tempinfo^.typedef.typesymbolprettyname,' = "', + tempinfo^.typedef.GetTypeName,'", tempinfo = $',hexstr(ptrint(tempinfo),sizeof(ptrint)*2)); + end; + +end. diff --git a/closures/compiler/ncal.pas b/closures/compiler/ncal.pas new file mode 100644 index 0000000000..eeb6e26865 --- /dev/null +++ b/closures/compiler/ncal.pas @@ -0,0 +1,3888 @@ +{ + This file implements the node for sub procedure calling. + + Copyright (c) 1998-2002 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 ncal; + +{$i fpcdefs.inc} + +interface + + uses + cutils,cclasses, + globtype,constexp, + paramgr,parabase,cgbase, + node,nbas,nutils, + {$ifdef state_tracking} + nstate, + {$endif state_tracking} + symbase,symtype,symsym,symdef,symtable; + + type + tcallnodeflag = ( + cnf_typedefset, + cnf_return_value_used, + cnf_do_inline, + cnf_inherited, + cnf_anon_inherited, + cnf_new_call, + cnf_dispose_call, + cnf_member_call, { called with implicit methodpointer tree } + cnf_uses_varargs, { varargs are used in the declaration } + cnf_create_failed, { exception thrown in constructor -> don't call beforedestruction } + cnf_objc_processed, { the procedure name has been set to the appropriate objc_msgSend* variant -> don't process again } + cnf_objc_id_call, { the procedure is a member call via id -> any ObjC method of any ObjC type in scope is fair game } + cnf_unit_specified { the unit in which the procedure has to be searched has been specified } + ); + tcallnodeflags = set of tcallnodeflag; + + tcallparanode = class; + + tcallnode = class(tbinarynode) + private + { number of parameters passed from the source, this does not include the hidden parameters } + paralength : smallint; + function is_simple_para_load(p:tnode; may_be_in_reg: boolean):boolean; + procedure maybe_load_in_temp(var p:tnode); + function gen_high_tree(var p:tnode;paradef:tdef):tnode; + function gen_procvar_context_tree:tnode; + function gen_self_tree:tnode; + function gen_vmt_tree:tnode; + procedure gen_hidden_parameters; + function funcret_can_be_reused:boolean; + procedure maybe_create_funcret_node; + procedure bind_parasym; + procedure add_init_statement(n:tnode); + procedure add_done_statement(n:tnode); + procedure convert_carg_array_of_const; + procedure order_parameters; + procedure check_inlining; + function pass1_normal:tnode; + procedure register_created_object_types; + function get_expect_loc: tcgloc; + protected + procedure objc_convert_to_message_send;virtual; + + private + { inlining support } + inlinelocals : TFPObjectList; + inlineinitstatement, + inlinecleanupstatement : tstatementnode; + procedure createinlineparas; + function replaceparaload(var n: tnode; arg: pointer): foreachnoderesult; + procedure createlocaltemps(p:TObject;arg:pointer); + function optimize_funcret_assignment(inlineblock: tblocknode): tnode; + function pass1_inline:tnode; + protected + pushedparasize : longint; + { Objective-C support: force the call node to call the routine with + this name rather than the name of symtableprocentry (don't store + to ppu, is set while processing the node) } + fobjcforcedprocname: pshortstring; + public + { the symbol containing the definition of the procedure } + { to call } + symtableprocentry : tprocsym; + symtableprocentryderef : tderef; + { symtable where the entry was found, needed for with support } + symtableproc : TSymtable; + { the definition of the procedure to call } + procdefinition : tabstractprocdef; + procdefinitionderef : tderef; + { tree that contains the pointer to the object for this method } + methodpointer : tnode; + { initialize/finalization of temps } + callinitblock, + callcleanupblock : tblocknode; + { function return node for initialized types or supplied return variable. + When the result is passed in a parameter then it is set to nil } + funcretnode : tnode; + { varargs parasyms } + varargsparas : tvarargsparalist; + + { separately specified resultdef for some compilerprocs (e.g. } + { you can't have a function with an "array of char" resultdef } + { the RTL) (JM) } + typedef: tdef; + callnodeflags : tcallnodeflags; + + { only the processor specific nodes need to override this } + { constructor } + constructor create(l:tnode; v : tprocsym;st : TSymtable; mp: tnode; callflags:tcallnodeflags);virtual; + constructor create_procvar(l,r:tnode); + constructor createintern(const name: string; params: tnode); + constructor createinternfromunit(const fromunit, procname: string; params: tnode); + constructor createinternres(const name: string; params: tnode; res:tdef); + constructor createinternresfromunit(const fromunit, procname: string; params: tnode; res:tdef); + constructor createinternreturn(const name: string; params: tnode; returnnode : tnode); + destructor destroy;override; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + function dogetcopy : tnode;override; + { Goes through all symbols in a class and subclasses and calls + verify abstract for each . + } + procedure verifyabstractcalls; + { called for each definition in a class and verifies if a method + is abstract or not, if it is abstract, give out a warning + } + procedure verifyabstract(sym:TObject;arg:pointer); + procedure insertintolist(l : tnodelist);override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + {$ifdef state_tracking} + function track_state_pass(exec_known:boolean):boolean;override; + {$endif state_tracking} + function docompare(p: tnode): boolean; override; + procedure printnodedata(var t:text);override; + function para_count:longint; + function required_para_count:longint; + { checks if there are any parameters which end up at the stack, i.e. + which have LOC_REFERENCE and set pi_has_stackparameter if this applies } + procedure check_stack_parameters; + { force the name of the to-be-called routine to a particular string, + used for Objective-C message sending. } + property parameters : tnode read left write left; + property pushed_parasize: longint read pushedparasize; + private + AbstractMethodsList : TFPHashList; + end; + tcallnodeclass = class of tcallnode; + + tcallparaflag = ( + cpf_is_colon_para, + cpf_varargs_para { belongs this para to varargs } + ); + tcallparaflags = set of tcallparaflag; + + tcallparanode = class(ttertiarynode) + private + fcontains_stack_tainting_call_cached, + ffollowed_by_stack_tainting_call_cached : boolean; + public + callparaflags : tcallparaflags; + parasym : tparavarsym; + { only the processor specific nodes need to override this } + { constructor } + constructor create(expr,next : tnode);virtual; + destructor destroy;override; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function dogetcopy : tnode;override; + procedure insertintolist(l : tnodelist);override; + function pass_typecheck : tnode;override; + function pass_1 : tnode;override; + procedure get_paratype; + procedure firstcallparan; + procedure insert_typeconv; + procedure secondcallparan;virtual;abstract; + function docompare(p: tnode): boolean; override; + procedure printnodetree(var t:text);override; + { returns whether a parameter contains a type conversion from } + { a refcounted into a non-refcounted type } + function can_be_inlined: boolean; + + property nextpara : tnode read right write right; + { third is reused to store the parameter name (only while parsing + vardispatch calls, never in real node tree) and copy of 'high' + parameter tree when the parameter is an open array of managed type } + property parametername : tnode read third write third; + + { returns whether the evaluation of this parameter involves a + stack tainting call } + function contains_stack_tainting_call: boolean; + { initialises the fcontains_stack_tainting_call_cached field with the + result of contains_stack_tainting_call so that it can be quickly + accessed via the contains_stack_tainting_call_cached property } + procedure init_contains_stack_tainting_call_cache; + { returns result of contains_stack_tainting_call cached during last + call to init_contains_stack_tainting_call_cache } + property contains_stack_tainting_call_cached: boolean read fcontains_stack_tainting_call_cached; + { returns whether this parameter is followed by at least one other + parameter whose evaluation involves a stack tainting parameter + (result is only valid after order_parameters has been called) } + property followed_by_stack_tainting_call_cached: boolean read ffollowed_by_stack_tainting_call_cached; + end; + tcallparanodeclass = class of tcallparanode; + + tdispcalltype = ( + dct_method, + dct_propget, + dct_propput + ); + + function reverseparameters(p: tcallparanode): tcallparanode; + function translate_disp_call(selfnode,parametersnode: tnode; calltype: tdispcalltype; const methodname : ansistring; + dispid : longint;resultdef : tdef) : tnode; + + var + ccallnode : tcallnodeclass = tcallnode; + ccallparanode : tcallparanodeclass = tcallparanode; + + { Current callnode, this is needed for having a link + between the callparanodes and the callnode they belong to } + aktcallnode : tcallnode; + + +implementation + + uses + systems, + verbose,globals, + symconst,defutil,defcmp, + htypechk,pass_1, + ncnv,nld,ninl,nadd,ncon,nmem,nset,nobjc, + objcutil, + procinfo,cpuinfo, + wpobase + ; + + type + tobjectinfoitem = class(tlinkedlistitem) + objinfo : tobjectdef; + constructor create(def : tobjectdef); + end; + + +{**************************************************************************** + HELPERS + ****************************************************************************} + + function reverseparameters(p: tcallparanode): tcallparanode; + var + hp1, hp2: tcallparanode; + begin + hp1:=nil; + while assigned(p) do + begin + { pull out } + hp2:=p; + p:=tcallparanode(p.right); + { pull in } + hp2.right:=hp1; + hp1:=hp2; + end; + reverseparameters:=hp1; + end; + + function translate_disp_call(selfnode,parametersnode: tnode; calltype: tdispcalltype; const methodname : ansistring; + dispid : longint;resultdef : tdef) : tnode; + const + DISPATCH_METHOD = $1; + DISPATCH_PROPERTYGET = $2; + DISPATCH_PROPERTYPUT = $4; + DISPATCH_PROPERTYPUTREF = $8; + DISPATCH_CONSTRUCT = $4000; + + calltypes: array[tdispcalltype] of byte = ( + DISPATCH_METHOD, DISPATCH_PROPERTYGET, DISPATCH_PROPERTYPUT + ); + var + statements : tstatementnode; + result_data, + params : ttempcreatenode; + paramssize : cardinal; + calldescnode : tdataconstnode; + resultvalue : tnode; + para : tcallparanode; + namedparacount, + paracount : longint; + assignmenttype, + vardatadef, + pvardatadef : tdef; + useresult: boolean; + restype: byte; + + names : ansistring; + variantdispatch : boolean; + + function is_byref_para(out assign_type: tdef): boolean; + begin + result:=(assigned(para.parasym) and (para.parasym.varspez in [vs_var,vs_out,vs_constref])) or + (variantdispatch and valid_for_var(para.left,false)); + + if result or (para.left.resultdef.typ in [variantdef]) then + assign_type:=voidpointertype + else + case para.left.resultdef.size of + 1..4: + assign_type:=u32inttype; + 8: + assign_type:=u64inttype; + else + internalerror(2007042801); + end; + end; + + function getvardef(sourcedef: TDef): longint; + begin + if is_ansistring(sourcedef) then + result:=varStrArg + else + if is_unicodestring(sourcedef) then + result:=varUStrArg + else + if is_interfacecom_or_dispinterface(sourcedef) then + begin + { distinct IDispatch and IUnknown interfaces } + if tobjectdef(sourcedef).is_related(tobjectdef(search_system_type('IDISPATCH').typedef)) then + result:=vardispatch + else + result:=varunknown; + end + else + result:=sourcedef.getvardef; + end; + + begin + variantdispatch:=selfnode.resultdef.typ=variantdef; + result:=internalstatements(statements); + + useresult := assigned(resultdef) and not is_void(resultdef); + if useresult then + begin + { get temp for the result } + result_data:=ctempcreatenode.create(colevarianttype,colevarianttype.size,tt_persistent,true); + addstatement(statements,result_data); + end; + + { first, count and check parameters } + para:=tcallparanode(parametersnode); + paracount:=0; + namedparacount:=0; + while assigned(para) do + begin + typecheckpass(para.left); + + { skip hidden dispinterface parameters like $self, $result, + but count skipped variantdispatch parameters. } + if (not variantdispatch) and (para.left.nodetype=nothingn) then + begin + para:=tcallparanode(para.nextpara); + continue; + end; + inc(paracount); + if assigned(para.parametername) then + inc(namedparacount); + + { insert some extra casts } + if para.left.nodetype=stringconstn then + inserttypeconv_internal(para.left,cwidestringtype) + + { force automatable boolean type } + else if is_boolean(para.left.resultdef) then + inserttypeconv_internal(para.left,bool16type) + + { force automatable float type } + else if is_extended(para.left.resultdef) + and (current_settings.fputype<>fpu_none) then + inserttypeconv_internal(para.left,s64floattype) + + else if is_shortstring(para.left.resultdef) then + inserttypeconv_internal(para.left,cwidestringtype) + + { skip this check if we've already typecasted to automatable type } + else if (para.left.nodetype<>nothingn) and (not is_automatable(para.left.resultdef)) then + CGMessagePos1(para.left.fileinfo,type_e_not_automatable,para.left.resultdef.typename); + + para:=tcallparanode(para.nextpara); + end; + + { create a temp to store parameter values } + params:=ctempcreatenode.create(voidtype,0,tt_persistent,true); + addstatement(statements,params); + + calldescnode:=cdataconstnode.create; + + if not variantdispatch then { generate a tdispdesc record } + begin + { dispid } + calldescnode.append(dispid,sizeof(dispid)); + { restype } + if useresult then + restype:=getvardef(resultdef) + else + restype:=0; + calldescnode.appendbyte(restype); + end; + + calldescnode.appendbyte(calltypes[calltype]); + calldescnode.appendbyte(paracount); + calldescnode.appendbyte(namedparacount); + + { build up parameters and description } + para:=tcallparanode(parametersnode); + paramssize:=0; + names := ''; + while assigned(para) do + begin + { Skipped parameters are actually (varType=varError, vError=DISP_E_PARAMNOTFOUND). + Generate only varType here, the value will be added by RTL. } + if para.left.nodetype=nothingn then + begin + if variantdispatch then + calldescnode.appendbyte(varError); + para:=tcallparanode(para.nextpara); + continue; + end; + + if assigned(para.parametername) then + begin + if para.parametername.nodetype=stringconstn then + names:=names+tstringconstnode(para.parametername).value_str+#0 + else + internalerror(200611041); + end; + + restype:=getvardef(para.left.resultdef); + if is_byref_para(assignmenttype) then + restype:=restype or $80; + + { assign the argument/parameter to the temporary location } + { for Variants, we always pass a pointer, RTL helpers must handle it + depending on byref bit } + + if assignmenttype=voidpointertype then + begin + addstatement(statements,cassignmentnode.create( + ctypeconvnode.create_internal(cderefnode.create(caddnode.create(addn, + caddrnode.create(ctemprefnode.create(params)), + cordconstnode.create(qword(paramssize),ptruinttype,false) + )),voidpointertype), + ctypeconvnode.create_internal(caddrnode.create_internal(para.left),voidpointertype))); + end + else + addstatement(statements,cassignmentnode.create( + ctypeconvnode.create_internal(cderefnode.create(caddnode.create(addn, + caddrnode.create(ctemprefnode.create(params)), + cordconstnode.create(paramssize,ptruinttype,false) + )),assignmenttype), + ctypeconvnode.create_internal(para.left,assignmenttype))); + + inc(paramssize,max(voidpointertype.size,assignmenttype.size)); + calldescnode.appendbyte(restype); + + para.left:=nil; + para:=tcallparanode(para.nextpara); + end; + + { Set final size for parameter block } + params.size:=paramssize; + + { old argument list skeleton isn't needed anymore } + parametersnode.free; + + pvardatadef:=tpointerdef(search_system_type('PVARDATA').typedef); + + if useresult then + resultvalue:=caddrnode.create(ctemprefnode.create(result_data)) + else + resultvalue:=cpointerconstnode.create(0,voidpointertype); + + if variantdispatch then + begin + calldescnode.append(pointer(methodname)^,length(methodname)); + calldescnode.appendbyte(0); + calldescnode.append(pointer(names)^,length(names)); + + { actual call } + vardatadef:=trecorddef(search_system_type('TVARDATA').typedef); + + addstatement(statements,ccallnode.createintern('fpc_dispinvoke_variant', + { parameters are passed always reverted, i.e. the last comes first } + ccallparanode.create(caddrnode.create(ctemprefnode.create(params)), + ccallparanode.create(caddrnode.create(calldescnode), + ccallparanode.create(ctypeconvnode.create_internal(selfnode,vardatadef), + ccallparanode.create(ctypeconvnode.create_internal(resultvalue,pvardatadef),nil))))) + ); + end + else + begin + addstatement(statements,ccallnode.createintern('fpc_dispatch_by_id', + { parameters are passed always reverted, i.e. the last comes first } + ccallparanode.create(caddrnode.create(ctemprefnode.create(params)), + ccallparanode.create(caddrnode.create(calldescnode), + ccallparanode.create(ctypeconvnode.create_internal(selfnode,voidpointertype), + ccallparanode.create(ctypeconvnode.create_internal(resultvalue,pvardatadef),nil))))) + ); + end; + addstatement(statements,ctempdeletenode.create(params)); + if useresult then + begin + { clean up } + addstatement(statements,ctempdeletenode.create_normal_temp(result_data)); + addstatement(statements,ctemprefnode.create(result_data)); + end; + end; + + +{**************************************************************************** + TOBJECTINFOITEM + ****************************************************************************} + + constructor tobjectinfoitem.create(def : tobjectdef); + begin + inherited create; + objinfo := def; + end; + + +{**************************************************************************** + TCALLPARANODE + ****************************************************************************} + + constructor tcallparanode.create(expr,next : tnode); + + begin + inherited create(callparan,expr,next,nil); + if not assigned(expr) then + internalerror(200305091); + expr.fileinfo:=fileinfo; + callparaflags:=[]; + if expr.nodetype = typeconvn then + ttypeconvnode(expr).warn_pointer_to_signed:=false; + end; + + destructor tcallparanode.destroy; + + begin + inherited destroy; + end; + + + constructor tcallparanode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + ppufile.getsmallset(callparaflags); + end; + + + procedure tcallparanode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putsmallset(callparaflags); + end; + + + function tcallparanode.dogetcopy : tnode; + + var + n : tcallparanode; + + begin + n:=tcallparanode(inherited dogetcopy); + n.callparaflags:=callparaflags; + n.parasym:=parasym; + result:=n; + end; + + + procedure tcallparanode.insertintolist(l : tnodelist); + begin + end; + + + function tcallparanode.pass_typecheck : tnode; + begin + { need to use get_paratype } + internalerror(200709251); + result:=nil; + end; + + + function tcallparanode.pass_1 : tnode; + begin + { need to use firstcallparan } + internalerror(200709252); + result:=nil; + end; + + + procedure tcallparanode.get_paratype; + var + old_array_constructor : boolean; + begin + if assigned(right) then + tcallparanode(right).get_paratype; + old_array_constructor:=allow_array_constructor; + allow_array_constructor:=true; + typecheckpass(left); + if assigned(third) then + typecheckpass(third); + allow_array_constructor:=old_array_constructor; + if codegenerror then + resultdef:=generrordef + else + resultdef:=left.resultdef; + end; + + + procedure tcallparanode.firstcallparan; + begin + if assigned(right) then + tcallparanode(right).firstcallparan; + if not assigned(left.resultdef) then + get_paratype; + firstpass(left); + if assigned(third) then + firstpass(third); + expectloc:=left.expectloc; + end; + + + procedure tcallparanode.insert_typeconv; + var + olddef : tdef; + hp : tnode; + block : tblocknode; + statements : tstatementnode; + temp : ttempcreatenode; + owningprocdef: tprocdef; + begin + { Be sure to have the resultdef } + if not assigned(left.resultdef) then + typecheckpass(left); + + if (left.nodetype<>nothingn) then + begin + { convert loads of the function result variable into procvars + representing the current function in case the formal parameter is + a procvar (CodeWarrior Pascal contains the same kind of + automatic disambiguation; you can use the function name in both + meanings, so we cannot statically pick either the function result + or the function definition in pexpr) } + if (m_mac in current_settings.modeswitches) and + (parasym.vardef.typ=procvardef) and + is_ambiguous_funcret_load(left,owningprocdef) then + begin + hp:=cloadnode.create_procvar(owningprocdef.procsym,owningprocdef,owningprocdef.procsym.owner); + typecheckpass(hp); + left.free; + left:=hp; + end; + + { Convert tp procvars, this is needs to be done + here to make the change permanent. in the overload + choosing the changes are only made temporarily } + if (left.resultdef.typ=procvardef) and + not(parasym.vardef.typ in [procvardef,formaldef]) then + begin + if maybe_call_procvar(left,true) then + resultdef:=left.resultdef + end; + + { Remove implicitly inserted typecast to pointer for + @procvar in macpas } + if (m_mac_procvar in current_settings.modeswitches) and + (parasym.vardef.typ=procvardef) and + (left.nodetype=typeconvn) and + is_voidpointer(left.resultdef) and + (ttypeconvnode(left).left.nodetype=typeconvn) and + (ttypeconvnode(ttypeconvnode(left).left).convtype=tc_proc_2_procvar) then + begin + hp:=left; + left:=ttypeconvnode(left).left; + ttypeconvnode(hp).left:=nil; + hp.free; + end; + maybe_global_proc_to_nested(left,parasym.vardef); + + { Handle varargs and hidden paras directly, no typeconvs or } + { pass_typechecking needed } + if (cpf_varargs_para in callparaflags) then + begin + { this should only happen vor C varargs } + { the necessary conversions have already been performed in } + { tarrayconstructornode.insert_typeconvs } + set_varstate(left,vs_read,[vsf_must_be_valid]); + insert_varargstypeconv(left,true); + resultdef:=left.resultdef; + { also update parasym type to get the correct parameter location + for the new types } + parasym.vardef:=left.resultdef; + end + else + if (vo_is_hidden_para in parasym.varoptions) then + begin + set_varstate(left,vs_read,[vsf_must_be_valid]); + resultdef:=left.resultdef; + end + else + begin + + { Do we need arrayconstructor -> set conversion, then insert + it here before the arrayconstructor node breaks the tree + with its conversions of enum->ord } + if (left.nodetype=arrayconstructorn) and + (parasym.vardef.typ=setdef) then + inserttypeconv(left,parasym.vardef); + + { set some settings needed for arrayconstructor } + if is_array_constructor(left.resultdef) then + begin + if left.nodetype<>arrayconstructorn then + internalerror(200504041); + if is_array_of_const(parasym.vardef) then + begin + { force variant array } + include(left.flags,nf_forcevaria); + end + else + begin + include(left.flags,nf_novariaallowed); + { now that the resultting type is know we can insert the required + typeconvs for the array constructor } + if parasym.vardef.typ=arraydef then + tarrayconstructornode(left).force_type(tarraydef(parasym.vardef).elementdef); + end; + end; + + { check if local proc/func is assigned to procvar } + if left.resultdef.typ=procvardef then + test_local_to_procvar(tprocvardef(left.resultdef),parasym.vardef); + + { test conversions } + if not(is_shortstring(left.resultdef) and + is_shortstring(parasym.vardef)) and + (parasym.vardef.typ<>formaldef) and + not(parasym.univpara) then + begin + { Process open parameters } + if paramanager.push_high_param(parasym.varspez,parasym.vardef,aktcallnode.procdefinition.proccalloption) then + begin + { insert type conv but hold the ranges of the array } + olddef:=left.resultdef; + inserttypeconv(left,parasym.vardef); + left.resultdef:=olddef; + end + else + begin + check_ranges(left.fileinfo,left,parasym.vardef); + inserttypeconv(left,parasym.vardef); + end; + if codegenerror then + exit; + end; + + { truncate shortstring value parameters at the caller side if } + { they are passed by value (if passed by reference, then the } + { callee will truncate when copying in the string) } + { This happens e.g. on x86_64 for small strings } + if is_shortstring(left.resultdef) and + is_shortstring(parasym.vardef) and + (parasym.varspez=vs_value) and + not paramanager.push_addr_param(parasym.varspez,parasym.vardef, + aktcallnode.procdefinition.proccalloption) and + ((is_open_string(left.resultdef) and + (tstringdef(parasym.vardef).len < 255)) or + (not is_open_string(left.resultdef) and + { when a stringconstn is typeconverted, then only its } + { def is modified, not the contents (needed because in } + { Delphi/TP, if you pass a longer string to a const } + { parameter, then the callee has to see this longer } + { string) } + (((left.nodetype<>stringconstn) and + (tstringdef(parasym.vardef).len<tstringdef(left.resultdef).len)) or + ((left.nodetype=stringconstn) and + (tstringdef(parasym.vardef).len<tstringconstnode(left).len))))) then + begin + block:=internalstatements(statements); + { temp for the new string } + temp:=ctempcreatenode.create(parasym.vardef,parasym.vardef.size, + tt_persistent,true); + addstatement(statements,temp); + { assign parameter to temp } + addstatement(statements,cassignmentnode.create(ctemprefnode.create(temp),left)); + left:=nil; + { release temp after next use } + addstatement(statements,ctempdeletenode.create_normal_temp(temp)); + addstatement(statements,ctemprefnode.create(temp)); + typecheckpass(tnode(block)); + left:=block; + end; + + { check var strings } + if (cs_strict_var_strings in current_settings.localswitches) and + is_shortstring(left.resultdef) and + is_shortstring(parasym.vardef) and + (parasym.varspez in [vs_out,vs_var,vs_constref]) and + not(is_open_string(parasym.vardef)) and + not(equal_defs(left.resultdef,parasym.vardef)) then + begin + CGMessagePos(left.fileinfo,type_e_strict_var_string_violation); + end; + + { passing a value to an "univ" parameter implies an explicit + typecast to the parameter type. Must be done before the + valid_for_var() check, since the typecast can result in + an invalid lvalue in case of var/out parameters. } + if (parasym.univpara) then + begin + { load procvar if a procedure is passed } + if ((m_tp_procvar in current_settings.modeswitches) or + (m_mac_procvar in current_settings.modeswitches)) and + (left.nodetype=calln) and + (is_void(left.resultdef)) then + begin + load_procvar_from_calln(left); + { load_procvar_from_calln() creates a loadn for a + a procedure, which means that the type conversion + below will type convert the first instruction + bytes of the procedure -> convert to a procvar } + left:=ctypeconvnode.create_proc_to_procvar(left); + typecheckpass(left); + end; + inserttypeconv_explicit(left,parasym.vardef); + end; + + { Handle formal parameters separate } + if (parasym.vardef.typ=formaldef) then + begin + { load procvar if a procedure is passed } + if ((m_tp_procvar in current_settings.modeswitches) or + (m_mac_procvar in current_settings.modeswitches)) and + (left.nodetype=calln) and + (is_void(left.resultdef)) then + load_procvar_from_calln(left); + + case parasym.varspez of + vs_var, + vs_constref, + vs_out : + begin + if not valid_for_formal_var(left,true) then + CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list); + end; + vs_const : + begin + if not valid_for_formal_const(left,true) then + CGMessagePos(left.fileinfo,parser_e_illegal_parameter_list); + end; + end; + end + else + begin + { check if the argument is allowed } + if (parasym.varspez in [vs_out,vs_var]) then + valid_for_var(left,true); + end; + + if parasym.varspez in [vs_var,vs_out,vs_constref] then + set_unique(left); + + { When the address needs to be pushed then the register is + not regable. Exception is when the location is also a var + parameter and we can pass the address transparently (but + that is handled by make_not_regable if ra_addr_regable is + passed, and make_not_regable always needs to called for + the ra_addr_taken info for non-invisble parameters) } + if ( + not( + (vo_is_hidden_para in parasym.varoptions) and + (left.resultdef.typ in [pointerdef,classrefdef]) + ) and + paramanager.push_addr_param(parasym.varspez,parasym.vardef, + aktcallnode.procdefinition.proccalloption) + ) then + { pushing the address of a variable to take the place of a temp } + { as the complex function result of a function does not make its } + { address escape the current block, as the "address of the } + { function result" is not something which can be stored } + { persistently by the callee (it becomes invalid when the callee } + { returns) } + if not(vo_is_funcret in parasym.varoptions) then + make_not_regable(left,[ra_addr_regable,ra_addr_taken]) + else + make_not_regable(left,[ra_addr_regable]); + + case parasym.varspez of + vs_out : + begin + { first set written separately to avoid false } + { uninitialized warnings (tbs/tb0542) } + set_varstate(left,vs_written,[]); + set_varstate(left,vs_readwritten,[]); + end; + vs_var, + vs_constref: + set_varstate(left,vs_readwritten,[vsf_must_be_valid,vsf_use_hints]); + else + set_varstate(left,vs_read,[vsf_must_be_valid]); + end; + { must only be done after typeconv PM } + resultdef:=parasym.vardef; + end; + end; + + { process next node } + if assigned(right) then + tcallparanode(right).insert_typeconv; + end; + + + function tcallparanode.can_be_inlined: boolean; + var + n: tnode; + begin + n:=left; + result:=false; + while assigned(n) and + (n.nodetype=typeconvn) do + begin + { look for type conversion nodes which convert a } + { refcounted type into a non-refcounted type } + if not is_managed_type(n.resultdef) and + is_managed_type(ttypeconvnode(n).left.resultdef) then + exit; + n:=ttypeconvnode(n).left; + end; + { also check for dereferencing constant pointers, like } + { tsomerecord(nil^) passed to a const r: tsomerecord } + { parameter } + if (n.nodetype=derefn) then + begin + repeat + n:=tunarynode(n).left; + until (n.nodetype<>typeconvn); + if (n.nodetype in [niln,pointerconstn]) then + exit + end; + result:=true; + end; + + + function check_contains_stack_tainting_call(var n: tnode; arg: pointer): foreachnoderesult; + begin + if (n.nodetype=calln) and + tcallnode(n).procdefinition.stack_tainting_parameter(callerside) then + result:=fen_norecurse_true + else + result:=fen_false; + end; + + + function tcallparanode.contains_stack_tainting_call: boolean; + begin + result:=foreachnodestatic(pm_postprocess,left,@check_contains_stack_tainting_call,nil); + end; + + + procedure tcallparanode.init_contains_stack_tainting_call_cache; + begin + fcontains_stack_tainting_call_cached:=contains_stack_tainting_call; + end; + + + function tcallparanode.docompare(p: tnode): boolean; + begin + docompare := + inherited docompare(p) and + (callparaflags = tcallparanode(p).callparaflags) + ; + end; + + + procedure tcallparanode.printnodetree(var t:text); + begin + printnodelist(t); + end; + + +{**************************************************************************** + TCALLNODE + ****************************************************************************} + + constructor tcallnode.create(l:tnode;v : tprocsym;st : TSymtable; mp: tnode; callflags:tcallnodeflags); + begin + inherited create(calln,l,nil); + symtableprocentry:=v; + symtableproc:=st; + callnodeflags:=callflags+[cnf_return_value_used]; + methodpointer:=mp; + callinitblock:=nil; + callcleanupblock:=nil; + procdefinition:=nil; + funcretnode:=nil; + paralength:=-1; + varargsparas:=nil; + end; + + + constructor tcallnode.create_procvar(l,r:tnode); + begin + inherited create(calln,l,r); + symtableprocentry:=nil; + symtableproc:=nil; + methodpointer:=nil; + callinitblock:=nil; + callcleanupblock:=nil; + procdefinition:=nil; + callnodeflags:=[cnf_return_value_used]; + funcretnode:=nil; + paralength:=-1; + varargsparas:=nil; + end; + + + constructor tcallnode.createintern(const name: string; params: tnode); + var + srsym: tsym; + begin + srsym := tsym(systemunit.Find(name)); + if not assigned(srsym) and + (cs_compilesystem in current_settings.moduleswitches) then + srsym := tsym(systemunit.Find(upper(name))); + if not assigned(srsym) or + (srsym.typ<>procsym) then + Message1(cg_f_unknown_compilerproc,name); + create(params,tprocsym(srsym),srsym.owner,nil,[]); + end; + + + constructor tcallnode.createinternfromunit(const fromunit, procname: string; params: tnode); + var + srsym: tsym; + srsymtable: tsymtable; + begin + if not searchsym_in_named_module(fromunit,procname,srsym,srsymtable) or + (srsym.typ<>procsym) then + Message1(cg_f_unknown_compilerproc,fromunit+'.'+procname); + create(params,tprocsym(srsym),srsymtable,nil,[]); + end; + + + constructor tcallnode.createinternres(const name: string; params: tnode; res:tdef); + var + pd : tprocdef; + begin + createintern(name,params); + typedef:=res; + include(callnodeflags,cnf_typedefset); + pd:=tprocdef(symtableprocentry.ProcdefList[0]); + { both the normal and specified resultdef either have to be returned via a } + { parameter or not, but no mixing (JM) } + if paramanager.ret_in_param(typedef,pd.proccalloption) xor + paramanager.ret_in_param(pd.returndef,pd.proccalloption) then + internalerror(2001082911); + end; + + + constructor tcallnode.createinternresfromunit(const fromunit, procname: string; params: tnode; res:tdef); + var + pd : tprocdef; + begin + createinternfromunit(fromunit,procname,params); + typedef:=res; + include(callnodeflags,cnf_typedefset); + pd:=tprocdef(symtableprocentry.ProcdefList[0]); + { both the normal and specified resultdef either have to be returned via a } + { parameter or not, but no mixing (JM) } + if paramanager.ret_in_param(typedef,pd.proccalloption) xor + paramanager.ret_in_param(pd.returndef,pd.proccalloption) then + internalerror(200108291); + end; + + + constructor tcallnode.createinternreturn(const name: string; params: tnode; returnnode : tnode); + begin + createintern(name,params); + funcretnode:=returnnode; + end; + + + destructor tcallnode.destroy; + begin + methodpointer.free; + callinitblock.free; + callcleanupblock.free; + funcretnode.free; + if assigned(varargsparas) then + varargsparas.free; + stringdispose(fobjcforcedprocname); + inherited destroy; + end; + + + constructor tcallnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + callinitblock:=tblocknode(ppuloadnode(ppufile)); + methodpointer:=ppuloadnode(ppufile); + callcleanupblock:=tblocknode(ppuloadnode(ppufile)); + funcretnode:=ppuloadnode(ppufile); + inherited ppuload(t,ppufile); + ppufile.getderef(symtableprocentryderef); +{ TODO: FIXME: No withsymtable support} + symtableproc:=nil; + ppufile.getderef(procdefinitionderef); + ppufile.getsmallset(callnodeflags); + end; + + + procedure tcallnode.ppuwrite(ppufile:tcompilerppufile); + begin + ppuwritenode(ppufile,callinitblock); + ppuwritenode(ppufile,methodpointer); + ppuwritenode(ppufile,callcleanupblock); + ppuwritenode(ppufile,funcretnode); + inherited ppuwrite(ppufile); + ppufile.putderef(symtableprocentryderef); + ppufile.putderef(procdefinitionderef); + ppufile.putsmallset(callnodeflags); + end; + + + procedure tcallnode.buildderefimpl; + begin + inherited buildderefimpl; + symtableprocentryderef.build(symtableprocentry); + procdefinitionderef.build(procdefinition); + if assigned(methodpointer) then + methodpointer.buildderefimpl; + if assigned(callinitblock) then + callinitblock.buildderefimpl; + if assigned(callcleanupblock) then + callcleanupblock.buildderefimpl; + if assigned(funcretnode) then + funcretnode.buildderefimpl; + end; + + + procedure tcallnode.derefimpl; + var + pt : tcallparanode; + i : integer; + begin + inherited derefimpl; + symtableprocentry:=tprocsym(symtableprocentryderef.resolve); + if assigned(symtableprocentry) then + symtableproc:=symtableprocentry.owner; + procdefinition:=tabstractprocdef(procdefinitionderef.resolve); + if assigned(methodpointer) then + methodpointer.derefimpl; + if assigned(callinitblock) then + callinitblock.derefimpl; + if assigned(callcleanupblock) then + callcleanupblock.derefimpl; + if assigned(funcretnode) then + funcretnode.derefimpl; + { generic method has no procdefinition } + if assigned(procdefinition) then + begin + { Connect parasyms } + pt:=tcallparanode(left); + while assigned(pt) and + (cpf_varargs_para in pt.callparaflags) do + pt:=tcallparanode(pt.right); + for i:=procdefinition.paras.count-1 downto 0 do + begin + if not assigned(pt) then + internalerror(200311077); + pt.parasym:=tparavarsym(procdefinition.paras[i]); + pt:=tcallparanode(pt.right); + end; + if assigned(pt) then + internalerror(200311078); + end; + end; + + + function tcallnode.dogetcopy : tnode; + var + n : tcallnode; + i : integer; + hp,hpn : tparavarsym; + oldleft : tnode; + begin + { Need to use a hack here to prevent the parameters from being copied. + The parameters must be copied between callinitblock/callcleanupblock because + they can reference methodpointer } + oldleft:=left; + left:=nil; + n:=tcallnode(inherited dogetcopy); + left:=oldleft; + n.symtableprocentry:=symtableprocentry; + n.symtableproc:=symtableproc; + n.procdefinition:=procdefinition; + n.typedef := typedef; + n.callnodeflags := callnodeflags; + if assigned(callinitblock) then + n.callinitblock:=tblocknode(callinitblock.dogetcopy) + else + n.callinitblock:=nil; + { callinitblock is copied, now references to the temp will also be copied + correctly. We can now copy the parameters, funcret and methodpointer } + if assigned(left) then + n.left:=left.dogetcopy + else + n.left:=nil; + if assigned(methodpointer) then + n.methodpointer:=methodpointer.dogetcopy + else + n.methodpointer:=nil; + if assigned(funcretnode) then + n.funcretnode:=funcretnode.dogetcopy + else + n.funcretnode:=nil; + if assigned(callcleanupblock) then + n.callcleanupblock:=tblocknode(callcleanupblock.dogetcopy) + else + n.callcleanupblock:=nil; + if assigned(varargsparas) then + begin + n.varargsparas:=tvarargsparalist.create(true); + for i:=0 to varargsparas.count-1 do + begin + hp:=tparavarsym(varargsparas[i]); + hpn:=tparavarsym.create(hp.realname,hp.paranr,hp.varspez,hp.vardef,[]); + n.varargsparas.add(hpn); + end; + end + else + n.varargsparas:=nil; + result:=n; + end; + + + function tcallnode.docompare(p: tnode): boolean; + begin + docompare := + inherited docompare(p) and + (symtableprocentry = tcallnode(p).symtableprocentry) and + (procdefinition = tcallnode(p).procdefinition) and + (methodpointer.isequal(tcallnode(p).methodpointer)) and + (((cnf_typedefset in callnodeflags) and (cnf_typedefset in tcallnode(p).callnodeflags) and + (equal_defs(typedef,tcallnode(p).typedef))) or + (not(cnf_typedefset in callnodeflags) and not(cnf_typedefset in tcallnode(p).callnodeflags))); + end; + + + procedure tcallnode.printnodedata(var t:text); + begin + if assigned(procdefinition) and + (procdefinition.typ=procdef) then + writeln(t,printnodeindention,'proc = ',tprocdef(procdefinition).fullprocname(true)) + else + begin + if assigned(symtableprocentry) then + writeln(t,printnodeindention,'proc = ',symtableprocentry.name) + else + writeln(t,printnodeindention,'proc = <nil>'); + end; + + if assigned(methodpointer) then + begin + writeln(t,printnodeindention,'methodpointer ='); + printnode(t,methodpointer); + end; + + if assigned(callinitblock) then + begin + writeln(t,printnodeindention,'callinitblock ='); + printnode(t,callinitblock); + end; + + if assigned(callcleanupblock) then + begin + writeln(t,printnodeindention,'callcleanupblock ='); + printnode(t,callcleanupblock); + end; + + if assigned(right) then + begin + writeln(t,printnodeindention,'right ='); + printnode(t,right); + end; + + if assigned(left) then + begin + writeln(t,printnodeindention,'left ='); + printnode(t,left); + end; + end; + + + procedure tcallnode.insertintolist(l : tnodelist); + begin + end; + + + procedure tcallnode.add_init_statement(n:tnode); + var + lastinitstatement : tstatementnode; + begin + if not assigned(callinitblock) then + callinitblock:=internalstatements(lastinitstatement) + else + lastinitstatement:=laststatement(callinitblock); + { all these nodes must be immediately typechecked, because this routine } + { can be called from pass_1 (i.e., after typecheck has already run) and } + { moreover, the entire blocks themselves are also only typechecked in } + { pass_1, while the the typeinfo is already required after the } + { typecheck pass for simplify purposes (not yet perfect, because the } + { statementnodes themselves are not typechecked this way) } + typecheckpass(n); + addstatement(lastinitstatement,n); + end; + + + procedure tcallnode.add_done_statement(n:tnode); + var + lastdonestatement : tstatementnode; + begin + if not assigned(callcleanupblock) then + callcleanupblock:=internalstatements(lastdonestatement) + else + lastdonestatement:=laststatement(callcleanupblock); + { see comments in add_init_statement } + typecheckpass(n); + addstatement(lastdonestatement,n); + end; + + + function tcallnode.para_count:longint; + var + ppn : tcallparanode; + begin + result:=0; + ppn:=tcallparanode(left); + while assigned(ppn) do + begin + if not(assigned(ppn.parasym) and + (vo_is_hidden_para in ppn.parasym.varoptions)) then + inc(result); + ppn:=tcallparanode(ppn.right); + end; + end; + + + function tcallnode.required_para_count: longint; + var + ppn : tcallparanode; + begin + result:=0; + ppn:=tcallparanode(left); + while assigned(ppn) do + begin + if not(assigned(ppn.parasym) and + ((vo_is_hidden_para in ppn.parasym.varoptions) or + assigned(ppn.parasym.defaultconstsym))) then + inc(result); + ppn:=tcallparanode(ppn.right); + end; + end; + + + function tcallnode.is_simple_para_load(p:tnode; may_be_in_reg: boolean):boolean; + var + hp : tnode; + begin + hp:=p; + while assigned(hp) and + (hp.nodetype=typeconvn) and + (ttypeconvnode(hp).convtype=tc_equal) do + hp:=tunarynode(hp).left; + result:=(hp.nodetype in [typen,loadvmtaddrn,loadn,temprefn,arrayconstructorn,addrn]); + if result and + not(may_be_in_reg) then + case hp.nodetype of + loadn: + result:=(tabstractvarsym(tloadnode(hp).symtableentry).varregable in [vr_none,vr_addr]); + temprefn: + result:=not(ti_may_be_in_reg in ttemprefnode(hp).tempinfo^.flags); + end; + end; + + function look_for_call(var n: tnode; arg: pointer): foreachnoderesult; + begin + case n.nodetype of + calln: + result := fen_norecurse_true; + typen,loadvmtaddrn,loadn,temprefn,arrayconstructorn: + result := fen_norecurse_false; + else + result := fen_false; + end; + end; + + procedure tcallnode.maybe_load_in_temp(var p:tnode); + var + loadp, + refp : tnode; + hdef : tdef; + ptemp : ttempcreatenode; + usederef : boolean; + begin + { Load all complex loads into a temp to prevent + double calls to a function. We can't simply check for a hp.nodetype=calln } + if assigned(p) and + foreachnodestatic(p,@look_for_call,nil) then + begin + { temp create } + usederef:=(p.resultdef.typ in [arraydef,recorddef]) or + is_shortstring(p.resultdef) or + is_object(p.resultdef); + + if usederef then + hdef:=tpointerdef.create(p.resultdef) + else + hdef:=p.resultdef; + + ptemp:=ctempcreatenode.create(hdef,hdef.size,tt_persistent,true); + if usederef then + begin + loadp:=caddrnode.create_internal(p); + refp:=cderefnode.create(ctemprefnode.create(ptemp)); + end + else + begin + loadp:=p; + refp:=ctemprefnode.create(ptemp) + end; + add_init_statement(ptemp); + add_init_statement(cassignmentnode.create( + ctemprefnode.create(ptemp), + loadp)); + add_done_statement(ctempdeletenode.create(ptemp)); + { new tree is only a temp reference } + p:=refp; + typecheckpass(p); + end; + end; + + + function tcallnode.gen_high_tree(var p:tnode;paradef:tdef):tnode; + { When passing an array to an open array, or a string to an open string, + some code is needed that generates the high bound of the array. This + function returns a tree containing the nodes for it. } + var + temp: tnode; + len : integer; + loadconst : boolean; + hightree,l,r : tnode; + defkind: tdeftyp; + begin + len:=-1; + loadconst:=true; + hightree:=nil; + { constant strings are internally stored as array of char, but if the + parameter is a string also treat it like one } + defkind:=p.resultdef.typ; + if (p.nodetype=stringconstn) and + (paradef.typ=stringdef) then + defkind:=stringdef; + case defkind of + arraydef : + begin + if (paradef.typ<>arraydef) then + internalerror(200405241); + { passing a string to an array of char } + if (p.nodetype=stringconstn) and + is_char(tarraydef(paradef).elementdef) then + begin + len:=tstringconstnode(p).len; + if len>0 then + dec(len); + end + else + { handle special case of passing an single array to an array of array } + if compare_defs(tarraydef(paradef).elementdef,p.resultdef,nothingn)>=te_equal then + len:=0 + else + begin + { handle via a normal inline in_high_x node } + loadconst:=false; + { slice? } + if (p.nodetype=inlinen) and (tinlinenode(p).inlinenumber=in_slice_x) then + with Tcallparanode(Tinlinenode(p).left) do + begin + {Array slice using slice builtin function.} + l:=Tcallparanode(right).left; + hightree:=caddnode.create(subn,l,genintconstnode(1)); + Tcallparanode(right).left:=nil; + + {Remove the inline node.} + temp:=p; + p:=left; + Tcallparanode(tinlinenode(temp).left).left:=nil; + temp.free; + + typecheckpass(hightree); + end + else if (p.nodetype=vecn) and (Tvecnode(p).right.nodetype=rangen) then + begin + {Array slice using .. operator.} + with Trangenode(Tvecnode(p).right) do + begin + l:=left; {Get lower bound.} + r:=right; {Get upper bound.} + end; + {In the procedure the array range is 0..(upper_bound-lower_bound).} + hightree:=caddnode.create(subn,r,l); + + {Replace the rangnode in the tree by its lower_bound, and + dispose the rangenode.} + temp:=Tvecnode(p).right; + Tvecnode(p).right:=l.getcopy; + + {Typecheckpass can only be performed *after* the l.getcopy since it + can modify the tree, and l is in the hightree.} + typecheckpass(hightree); + + with Trangenode(temp) do + begin + left:=nil; + right:=nil; + end; + temp.free; + + {Tree changed from p[l..h] to p[l], recalculate resultdef.} + p.resultdef:=nil; + typecheckpass(p); + end + else + begin + maybe_load_in_temp(p); + hightree:=geninlinenode(in_high_x,false,p.getcopy); + typecheckpass(hightree); + { only substract low(array) if it's <> 0 } + temp:=geninlinenode(in_low_x,false,p.getcopy); + typecheckpass(temp); + if (temp.nodetype <> ordconstn) or + (tordconstnode(temp).value <> 0) then + hightree := caddnode.create(subn,hightree,temp) + else + temp.free; + end; + end; + end; + stringdef : + begin + if is_open_string(paradef) then + begin + { a stringconstn is not a simple parameter and hence would be + loaded in a temp, but in that case the high() node + a) goes wrong (it cannot deal with a temp node) + b) would give a generic result instead of one specific to + this constant string + } + if p.nodetype<>stringconstn then + maybe_load_in_temp(p); + { handle via a normal inline in_high_x node } + loadconst := false; + hightree := geninlinenode(in_high_x,false,p.getcopy); + end + else + { handle special case of passing an single string to an array of string } + if compare_defs(tarraydef(paradef).elementdef,p.resultdef,nothingn)>=te_equal then + len:=0 + else + { passing a string to an array of char } + if (p.nodetype=stringconstn) and + is_char(tarraydef(paradef).elementdef) then + begin + len:=tstringconstnode(p).len; + if len>0 then + dec(len); + end + else + begin + maybe_load_in_temp(p); + hightree:=caddnode.create(subn,geninlinenode(in_length_x,false,p.getcopy), + cordconstnode.create(1,sinttype,false)); + loadconst:=false; + end; + end; + else + len:=0; + end; + if loadconst then + hightree:=cordconstnode.create(len,sinttype,true) + else + begin + if not assigned(hightree) then + internalerror(200304071); + { Need to use explicit, because it can also be a enum } + hightree:=ctypeconvnode.create_internal(hightree,sinttype); + end; + result:=hightree; + end; + + + function tcallnode.gen_procvar_context_tree:tnode; + begin + { Load tmehodpointer(right).self (either self or parentfp) } + result:=genloadfield(ctypeconvnode.create_internal( + right.getcopy,methodpointertype), + 'self'); + end; + + + function tcallnode.gen_self_tree:tnode; + var + selftree : tnode; + selfdef : tdef; + begin + selftree:=nil; + + { When methodpointer was a callnode we must load it first into a + temp to prevent processing the callnode twice } + if (methodpointer.nodetype=calln) then + internalerror(200405121); + + { Objective-C: objc_convert_to_message_send() already did all necessary + transformation on the methodpointer } + if (procdefinition.typ=procdef) and + (po_objc in tprocdef(procdefinition).procoptions) then + selftree:=methodpointer.getcopy + { inherited } + else if (cnf_inherited in callnodeflags) then + begin + selftree:=load_self_node; + { we can call an inherited class static/method from a regular method + -> self node must change from instance pointer to vmt pointer) + } + if (procdefinition.procoptions*[po_classmethod,po_staticmethod] <> []) and + (selftree.resultdef.typ<>classrefdef) then + selftree:=cloadvmtaddrnode.create(selftree); + end + else + { constructors } + if (procdefinition.proctypeoption=potype_constructor) then + begin + { push 0 as self when allocation is needed } + if (methodpointer.resultdef.typ=classrefdef) or + (cnf_new_call in callnodeflags) then + selftree:=cpointerconstnode.create(0,voidpointertype) + else + begin + if methodpointer.nodetype=typen then + selftree:=load_self_node + else + selftree:=methodpointer.getcopy; + end; + end + else + { Calling a static/class method } + if (po_classmethod in procdefinition.procoptions) or + (po_staticmethod in procdefinition.procoptions) then + begin + if (procdefinition.typ<>procdef) then + internalerror(200305062); + { if the method belongs to a helper then we need to use the + extended type for references to Self } + if is_objectpascal_helper(tprocdef(procdefinition).struct) then + selfdef:=tobjectdef(tprocdef(procdefinition).struct).extendeddef + else + selfdef:=tprocdef(procdefinition).struct; + if (selfdef.typ in [recorddef,objectdef]) and + (oo_has_vmt in tabstractrecorddef(selfdef).objectoptions) then + begin + { we only need the vmt, loading self is not required and there is no + need to check for typen, because that will always get the + loadvmtaddrnode added } + selftree:=methodpointer.getcopy; + if (methodpointer.resultdef.typ<>classrefdef) or + (methodpointer.nodetype = typen) then + selftree:=cloadvmtaddrnode.create(selftree); + end + else + selftree:=cpointerconstnode.create(0,voidpointertype); + end + else + begin + if methodpointer.nodetype=typen then + selftree:=load_self_node + else + selftree:=methodpointer.getcopy; + end; + result:=selftree; + end; + + + procedure tcallnode.register_created_object_types; + + function checklive(def: tdef): boolean; + begin + if assigned(current_procinfo) and + not(po_inline in current_procinfo.procdef.procoptions) and + not wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname) then + begin +{$ifdef debug_deadcode} + writeln(' NOT adding creadion of ',def.typename,' because performed in dead stripped proc: ',current_procinfo.procdef.typename); +{$endif debug_deadcode} + result:=false; + end + else + result:=true; + end; + + var + crefdef, + systobjectdef : tdef; + begin + { only makes sense for methods } + if not assigned(methodpointer) then + exit; + if (methodpointer.resultdef.typ=classrefdef) then + begin + { constructor call via classreference => allocate memory } + if (procdefinition.proctypeoption=potype_constructor) then + begin + { Only a typenode can be passed when it is called with <class of xx>.create } + if (methodpointer.nodetype=typen) then + begin + if checklive(methodpointer.resultdef) then + { we know the exact class type being created } + tclassrefdef(methodpointer.resultdef).pointeddef.register_created_object_type + end + else + begin + { the loadvmtaddrnode is already created in case of classtype.create } + if (methodpointer.nodetype=loadvmtaddrn) and + (tloadvmtaddrnode(methodpointer).left.nodetype=typen) then + begin + if checklive(methodpointer.resultdef) then + tclassrefdef(methodpointer.resultdef).pointeddef.register_created_object_type + end + else + begin + if checklive(methodpointer.resultdef) then + begin + { special case: if the classref comes from x.classtype (with classtype, + being tobject.classtype) then the created instance is x or a descendant + of x (rather than tobject or a descendant of tobject) + } + systobjectdef:=search_system_type('TOBJECT').typedef; + if (methodpointer.nodetype=calln) and + { not a procvar call } + not assigned(right) and + { procdef is owned by system.tobject } + (tprocdef(tcallnode(methodpointer).procdefinition).owner.defowner=systobjectdef) and + { we're calling system.tobject.classtype } + (tcallnode(methodpointer).symtableprocentry.name='CLASSTYPE') and + { could again be a classrefdef, but unlikely } + (tcallnode(methodpointer).methodpointer.resultdef.typ=objectdef) and + { don't go through this trouble if it was already a tobject } + (tcallnode(methodpointer).methodpointer.resultdef<>systobjectdef) then + begin + { register this object type as classref, so all descendents will also + be marked as instantiatable (only the pointeddef will actually be + recorded, so it's no problem that the clasrefdef is only temporary) + } + crefdef:=tclassrefdef.create(tcallnode(methodpointer).methodpointer.resultdef); + { and register it } + crefdef.register_created_object_type; + end + else + { the created class can be any child class as well -> register classrefdef } + methodpointer.resultdef.register_created_object_type; + end; + end; + end; + end + end + else + { Old style object } + if is_object(methodpointer.resultdef) then + begin + { constructor with extended syntax called from new } + if (cnf_new_call in callnodeflags) then + begin + if checklive(methodpointer.resultdef) then + methodpointer.resultdef.register_created_object_type; + end + else + { normal object call like obj.proc } + if not(cnf_dispose_call in callnodeflags) and + not(cnf_inherited in callnodeflags) and + not(cnf_member_call in callnodeflags) then + begin + if (procdefinition.proctypeoption=potype_constructor) then + begin + if (methodpointer.nodetype<>typen) and + checklive(methodpointer.resultdef) then + methodpointer.resultdef.register_created_object_type; + end + end; + end; + end; + + + function tcallnode.get_expect_loc: tcgloc; + var + realresdef: tstoreddef; + begin + if not assigned(typedef) then + realresdef:=tstoreddef(resultdef) + else + realresdef:=tstoreddef(typedef); + if realresdef.is_intregable then + result:=LOC_REGISTER + else if (realresdef.typ=floatdef) and + not(cs_fp_emulation in current_settings.moduleswitches) then + if use_vectorfpu(realresdef) then + result:=LOC_MMREGISTER + else + result:=LOC_FPUREGISTER + else + result:=LOC_REFERENCE + end; + + + procedure tcallnode.objc_convert_to_message_send; + var + block, + selftree : tnode; + statements : tstatementnode; + field : tfieldvarsym; + temp : ttempcreatenode; + selfrestype, + objcsupertype : tdef; + srsym : tsym; + srsymtable : tsymtable; + msgsendname : string; + begin + if not(m_objectivec1 in current_settings.modeswitches) then + Message(parser_f_modeswitch_objc_required); + { typecheck pass must already have run on the call node, + because pass1 calls this method + } + + { default behaviour: call objc_msgSend and friends; + 64 bit targets for Mac OS X can override this as they + can call messages via an indirect function call similar to + dynamically linked functions, ARM maybe as well (not checked) + + Which variant of objc_msgSend is used depends on the + result type, and on whether or not it's an inherited call. + } + + { make sure we don't perform this transformation twice in case + firstpass would be called multiple times } + include(callnodeflags,cnf_objc_processed); + + { make sure the methodpointer doesn't get translated into a call + as well (endless loop) } + if methodpointer.nodetype=loadvmtaddrn then + tloadvmtaddrnode(methodpointer).forcall:=true; + + { A) set the appropriate objc_msgSend* variant to call } + + { record returned via implicit pointer } + if paramanager.ret_in_param(resultdef,procdefinition.proccalloption) then + begin + if not(cnf_inherited in callnodeflags) then + msgsendname:='OBJC_MSGSEND_STRET' +{$if defined(onlymacosx10_6) or defined(arm) } + else if (target_info.system in systems_objc_nfabi) then + msgsendname:='OBJC_MSGSENDSUPER2_STRET' +{$endif onlymacosx10_6 or arm} + else + msgsendname:='OBJC_MSGSENDSUPER_STRET' + end +{$ifdef i386} + { special case for fpu results on i386 for non-inherited calls } + { TODO: also for x86_64 "extended" results } + else if (resultdef.typ=floatdef) and + not(cnf_inherited in callnodeflags) then + msgsendname:='OBJC_MSGSEND_FPRET' +{$endif} + { default } + else if not(cnf_inherited in callnodeflags) then + msgsendname:='OBJC_MSGSEND' +{$if defined(onlymacosx10_6) or defined(arm) } + else if (target_info.system in systems_objc_nfabi) then + msgsendname:='OBJC_MSGSENDSUPER2' +{$endif onlymacosx10_6 or arm} + else + msgsendname:='OBJC_MSGSENDSUPER'; + + { get the mangled name } + if not searchsym_in_named_module('OBJC',msgsendname,srsym,srsymtable) or + (srsym.typ<>procsym) or + (tprocsym(srsym).ProcdefList.count<>1) then + Message1(cg_f_unknown_compilerproc,'objc.'+msgsendname); + fobjcforcedprocname:=stringdup(tprocdef(tprocsym(srsym).ProcdefList[0]).mangledname); + + { B) Handle self } + { 1) in case of sending a message to a superclass, self is a pointer to + an objc_super record + } + if (cnf_inherited in callnodeflags) then + begin + block:=internalstatements(statements); + objcsupertype:=search_named_unit_globaltype('OBJC','OBJC_SUPER',true).typedef; + if (objcsupertype.typ<>recorddef) then + internalerror(2009032901); + { temp for the for the objc_super record } + temp:=ctempcreatenode.create(objcsupertype,objcsupertype.size,tt_persistent,false); + addstatement(statements,temp); + { initialize objc_super record } + selftree:=load_self_node; + + { we can call an inherited class static/method from a regular method + -> self node must change from instance pointer to vmt pointer) + } + if (po_classmethod in procdefinition.procoptions) and + (selftree.resultdef.typ<>classrefdef) then + begin + selftree:=cloadvmtaddrnode.create(selftree); + { since we're in a class method of the current class, its + information has already been initialized (and that of all of + its parent classes too) } + tloadvmtaddrnode(selftree).forcall:=true; + typecheckpass(selftree); + end; + selfrestype:=selftree.resultdef; + field:=tfieldvarsym(trecorddef(objcsupertype).symtable.find('RECEIVER')); + if not assigned(field) then + internalerror(2009032902); + { first the destination object/class instance } + addstatement(statements, + cassignmentnode.create( + csubscriptnode.create(field,ctemprefnode.create(temp)), + selftree + ) + ); + { and secondly, the class type in which the selector must be looked + up (the parent class in case of an instance method, the parent's + metaclass in case of a class method) } + field:=tfieldvarsym(trecorddef(objcsupertype).symtable.find('_CLASS')); + if not assigned(field) then + internalerror(2009032903); + addstatement(statements, + cassignmentnode.create( + csubscriptnode.create(field,ctemprefnode.create(temp)), + objcsuperclassnode(selftree.resultdef) + ) + ); + { result of this block is the address of this temp } + addstatement(statements,ctypeconvnode.create_internal( + caddrnode.create_internal(ctemprefnode.create(temp)),selfrestype) + ); + { replace the method pointer with the address of this temp } + methodpointer.free; + methodpointer:=block; + typecheckpass(block); + end + else + { 2) regular call (not inherited) } + begin + { a) If we're calling a class method, use a class ref. } + if (po_classmethod in procdefinition.procoptions) and + ((methodpointer.nodetype=typen) or + (methodpointer.resultdef.typ<>classrefdef)) then + begin + methodpointer:=cloadvmtaddrnode.create(methodpointer); + { no need to obtain the class ref by calling class(), sending + this message will initialize it if necessary } + tloadvmtaddrnode(methodpointer).forcall:=true; + firstpass(methodpointer); + end; + end; + end; + + + function tcallnode.gen_vmt_tree:tnode; + var + vmttree : tnode; + begin + vmttree:=nil; + if not(procdefinition.proctypeoption in [potype_constructor,potype_destructor]) then + internalerror(200305051); + + { When methodpointer was a callnode we must load it first into a + temp to prevent the processing callnode twice } + if (methodpointer.nodetype=calln) then + internalerror(200405122); + + { Handle classes and legacy objects separate to make it + more maintainable } + if (methodpointer.resultdef.typ=classrefdef) then + begin + if not is_class(tclassrefdef(methodpointer.resultdef).pointeddef) then + internalerror(200501041); + + { constructor call via classreference => allocate memory } + if (procdefinition.proctypeoption=potype_constructor) then + begin + vmttree:=methodpointer.getcopy; + { Only a typenode can be passed when it is called with <class of xx>.create } + if vmttree.nodetype=typen then + begin + vmttree:=cloadvmtaddrnode.create(vmttree); + tloadvmtaddrnode(vmttree).forcall:=true; + end; + end + else + begin + { Call afterconstruction } + vmttree:=cpointerconstnode.create(1,voidpointertype); + end; + end + else + { Class style objects } + if is_class(methodpointer.resultdef) then + begin + { inherited call, no create/destroy } + if (cnf_inherited in callnodeflags) then + vmttree:=cpointerconstnode.create(0,voidpointertype) + else + { do not create/destroy when called from member function + without specifying self explicit } + if (cnf_member_call in callnodeflags) then + begin + { destructor (in the same class, since cnf_member_call): + if not called from a destructor then + call beforedestruction and release instance, vmt=1 + else + don't release instance, vmt=0 + constructor (in the same class, since cnf_member_call): + if called from a constructor then + don't call afterconstruction, vmt=0 + else + call afterconstrution, vmt=1 } + if (procdefinition.proctypeoption=potype_destructor) then + if (current_procinfo.procdef.proctypeoption<>potype_constructor) then + vmttree:=cpointerconstnode.create(1,voidpointertype) + else + vmttree:=cpointerconstnode.create(0,voidpointertype) + else if (current_procinfo.procdef.proctypeoption=potype_constructor) and + (procdefinition.proctypeoption=potype_constructor) then + vmttree:=cpointerconstnode.create(0,voidpointertype) + else + vmttree:=cpointerconstnode.create(1,voidpointertype); + end + else + { normal call to method like cl1.proc } + begin + { destructor: + if not called from exception block in constructor + call beforedestruction and release instance, vmt=1 + else + don't call beforedestruction and release instance, vmt=-1 + constructor: + if called from a constructor in the same class using self.create then + don't call afterconstruction, vmt=0 + else + call afterconstruction, vmt=1 } + if (procdefinition.proctypeoption=potype_destructor) then + if not(cnf_create_failed in callnodeflags) then + vmttree:=cpointerconstnode.create(1,voidpointertype) + else + vmttree:=cpointerconstnode.create(TConstPtrUInt(-1),voidpointertype) + else + begin + if (current_procinfo.procdef.proctypeoption=potype_constructor) and + (procdefinition.proctypeoption=potype_constructor) and + (methodpointer.nodetype=loadn) and + (loadnf_is_self in tloadnode(methodpointer).loadnodeflags) then + vmttree:=cpointerconstnode.create(0,voidpointertype) + else + vmttree:=cpointerconstnode.create(1,voidpointertype); + end; + end; + end + else + { Old style object } + begin + { constructor with extended syntax called from new } + if (cnf_new_call in callnodeflags) then + vmttree:=cloadvmtaddrnode.create(ctypenode.create(methodpointer.resultdef)) + else + { destructor with extended syntax called from dispose } + if (cnf_dispose_call in callnodeflags) then + vmttree:=cloadvmtaddrnode.create(methodpointer.getcopy) + else + { inherited call, no create/destroy } + if (cnf_inherited in callnodeflags) then + vmttree:=cpointerconstnode.create(0,voidpointertype) + else + { do not create/destroy when called from member function + without specifying self explicit } + if (cnf_member_call in callnodeflags) then + begin + { destructor: don't release instance, vmt=0 + constructor: don't initialize instance, vmt=0 } + vmttree:=cpointerconstnode.create(0,voidpointertype) + end + else + { normal object call like obj.proc } + begin + { destructor: direct call, no dispose, vmt=0 + constructor: initialize object, load vmt } + if (procdefinition.proctypeoption=potype_constructor) then + begin + { old styled inherited call? } + if (methodpointer.nodetype=typen) then + vmttree:=cpointerconstnode.create(0,voidpointertype) + else + vmttree:=cloadvmtaddrnode.create(ctypenode.create(methodpointer.resultdef)) + end + else + vmttree:=cpointerconstnode.create(0,voidpointertype); + end; + end; + result:=vmttree; + end; + + + + function check_funcret_used_as_para(var n: tnode; arg: pointer): foreachnoderesult; + var + destsym : tsym absolute arg; + begin + result := fen_false; + if (n.nodetype=loadn) and + (tloadnode(n).symtableentry = destsym) then + result := fen_norecurse_true; + end; + + + function tcallnode.funcret_can_be_reused:boolean; + var + realassignmenttarget: tnode; + alignment: longint; + begin + result:=false; + + { we are processing an assignment node? } + if not(assigned(aktassignmentnode) and + (aktassignmentnode.right=self) and + (aktassignmentnode.left.resultdef=resultdef)) then + exit; + + { destination must be able to be passed as var parameter } + if not valid_for_var(aktassignmentnode.left,false) then + exit; + + { destination must be a simple load so it doesn't need a temp when + it is evaluated } + if not is_simple_para_load(aktassignmentnode.left,false) then + exit; + + { remove possible typecasts } + realassignmenttarget:=aktassignmentnode.left.actualtargetnode; + + { when it is not passed in a parameter it will only be used after the + function call } + if not paramanager.ret_in_param(resultdef,procdefinition.proccalloption) then + begin + result:=true; + exit; + end; + + { if the result is the same as the self parameter (in case of objects), + we can't optimise. We have to check this explicitly becaise + hidden parameters such as self have not yet been inserted at this + point + } + if assigned(methodpointer) and + realassignmenttarget.isequal(methodpointer.actualtargetnode) then + exit; + + { when we substitute a function result inside an inlined function, + we may take the address of this function result. Therefore the + substituted function result may not be in a register, as we cannot + take its address in that case } + if (realassignmenttarget.nodetype=temprefn) and + not(ti_addr_taken in ttemprefnode(realassignmenttarget).tempinfo^.flags) and + not(ti_may_be_in_reg in ttemprefnode(realassignmenttarget).tempinfo^.flags) then + begin + result:=true; + exit; + end; + + if (realassignmenttarget.nodetype=loadn) and + { nested procedures may access the current procedure's locals } + (procdefinition.parast.symtablelevel=normal_function_level) and + { must be a local variable, a value para or a hidden function result } + { parameter (which can be passed by address, but in that case it got } + { through these same checks at the caller side and is thus safe } + ( + (tloadnode(realassignmenttarget).symtableentry.typ=localvarsym) or + ( + (tloadnode(realassignmenttarget).symtableentry.typ=paravarsym) and + ((tparavarsym(tloadnode(realassignmenttarget).symtableentry).varspez = vs_value) or + (vo_is_funcret in tparavarsym(tloadnode(realassignmenttarget).symtableentry).varoptions)) + ) + ) and + { the address may not have been taken of the variable/parameter, because } + { otherwise it's possible that the called function can access it via a } + { global variable or other stored state } + ( + not(tabstractvarsym(tloadnode(realassignmenttarget).symtableentry).addr_taken) and + (tabstractvarsym(tloadnode(realassignmenttarget).symtableentry).varregable in [vr_none,vr_addr]) + ) then + begin + { If the funcret is also used as a parameter we can't optimize because the funcret + and the parameter will point to the same address. That means that a change of the result variable + will result also in a change of the parameter value } + result:=not foreachnodestatic(left,@check_funcret_used_as_para,tloadnode(realassignmenttarget).symtableentry); + { ensure that it is aligned using the default alignment } + alignment:=tabstractvarsym(tloadnode(realassignmenttarget).symtableentry).vardef.alignment; + if (used_align(alignment,target_info.alignment.localalignmin,target_info.alignment.localalignmax)<> + used_align(alignment,current_settings.alignment.localalignmin,current_settings.alignment.localalignmax)) then + result:=false; + exit; + end; + end; + + + procedure tcallnode.maybe_create_funcret_node; + var + temp : ttempcreatenode; + begin + { For the function result we need to create a temp node for: + - Inlined functions + - Types requiring initialization/finalization + - Types passed in parameters } + if not is_void(resultdef) and + not assigned(funcretnode) and + ( + (cnf_do_inline in callnodeflags) or + is_managed_type(resultdef) or + paramanager.ret_in_param(resultdef,procdefinition.proccalloption) + ) then + begin + { Optimize calls like x:=f() where we can use x directly as + result instead of using a temp. Condition is that x cannot be accessed from f(). + This implies that x is a local variable or value parameter of the current block + and its address is not passed to f. One problem: what if someone takes the + address of x, puts it in a pointer variable/field and then accesses it that way + from within the function? This is solved (in a conservative way) using the + ti_addr_taken flag. + + When the result is not not passed in a parameter there are no problem because + then it means only reference counted types (eg. ansistrings) that need a decr + of the refcount before being assigned. This is all done after the call so there + is no issue with exceptions and possible use of the old value in the called + function } + if funcret_can_be_reused then + begin + funcretnode:=aktassignmentnode.left.getcopy; + include(funcretnode.flags,nf_is_funcret); + { notify the assignment node that the assignment can be removed } + include(aktassignmentnode.flags,nf_assign_done_in_right); + end + else + begin + temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent, + (cnf_do_inline in callnodeflags) and + not(tabstractvarsym(tprocdef(procdefinition).funcretsym).varregable in [vr_none,vr_addr])); + include(temp.flags,nf_is_funcret); + add_init_statement(temp); + { When the function result is not used in an inlined function + we need to delete the temp. This can currently only be done by + a tempdeletenode and not after converting it to a normal temp } + if not(cnf_return_value_used in callnodeflags) and + (cnf_do_inline in callnodeflags) then + add_done_statement(ctempdeletenode.create(temp)) + else + add_done_statement(ctempdeletenode.create_normal_temp(temp)); + funcretnode:=ctemprefnode.create(temp); + include(funcretnode.flags,nf_is_funcret); + end; + end; + end; + + + procedure tcallnode.gen_hidden_parameters; + var + para : tcallparanode; + begin + para:=tcallparanode(left); + while assigned(para) do + begin + { The processing of high() and typeinfo() is already + done in the typecheckpass. We only need to process the + nodes that still have a nothingn } + if (vo_is_hidden_para in para.parasym.varoptions) and + (para.left.nodetype=nothingn) then + begin + { remove dummy nothingn } + para.left.free; + para.left:=nil; + { generate the corresponding nodes for the hidden parameter type } + if (vo_is_funcret in para.parasym.varoptions) then + begin + if not assigned(funcretnode) then + internalerror(200709083); + para.left:=funcretnode; + funcretnode:=nil; + end + else + if vo_is_self in para.parasym.varoptions then + begin + if assigned(right) then + para.left:=gen_procvar_context_tree + else + para.left:=gen_self_tree; + end + else + if vo_is_vmt in para.parasym.varoptions then + begin + para.left:=gen_vmt_tree; + end +{$if defined(powerpc) or defined(m68k)} + else + if vo_is_syscall_lib in para.parasym.varoptions then + begin + { lib parameter has no special type but proccalloptions must be a syscall } + para.left:=cloadnode.create(tprocdef(procdefinition).libsym,tprocdef(procdefinition).libsym.owner); + end +{$endif powerpc or m68k} + else + if vo_is_parentfp in para.parasym.varoptions then + begin + if not assigned(right) then + begin + if assigned(procdefinition.owner.defowner) then + para.left:=cloadparentfpnode.create(tprocdef(procdefinition.owner.defowner)) + { exceptfilters called from main level are not owned } + else if procdefinition.proctypeoption=potype_exceptfilter then + para.left:=cloadparentfpnode.create(current_procinfo.procdef) + else + internalerror(200309287); + end + else + para.left:=gen_procvar_context_tree; + end + else + if vo_is_range_check in para.parasym.varoptions then + begin + para.left:=cordconstnode.create(Ord(cs_check_range in current_settings.localswitches),pasbool8type,false); + end + else + if vo_is_overflow_check in para.parasym.varoptions then + begin + para.left:=cordconstnode.create(Ord(cs_check_overflow in current_settings.localswitches),pasbool8type,false); + end + else + if vo_is_msgsel in para.parasym.varoptions then + begin + para.left:=cobjcselectornode.create(cstringconstnode.createstr(tprocdef(procdefinition).messageinf.str^)); + end; + end; + if not assigned(para.left) then + internalerror(200709084); + para:=tcallparanode(para.right); + end; + end; + + + procedure tcallnode.verifyabstract(sym:TObject;arg:pointer); + var + pd : tprocdef; + i : longint; + j : integer; + hs : string; + begin + if (tsym(sym).typ<>procsym) then + exit; + for i:=0 to tprocsym(sym).ProcdefList.Count-1 do + begin + pd:=tprocdef(tprocsym(sym).ProcdefList[i]); + hs:=pd.procsym.name+pd.typename_paras(false); + j:=AbstractMethodsList.FindIndexOf(hs); + if j<>-1 then + AbstractMethodsList[j]:=pd + else + AbstractMethodsList.Add(hs,pd); + end; + end; + + + procedure tcallnode.verifyabstractcalls; + var + objectdf : tobjectdef; + parents : tlinkedlist; + objectinfo : tobjectinfoitem; + pd : tprocdef; + i : integer; + begin + objectdf := nil; + { verify if trying to create an instance of a class which contains + non-implemented abstract methods } + + { first verify this class type, no class than exit } + { also, this checking can only be done if the constructor is directly + called, indirect constructor calls cannot be checked. + } + if assigned(methodpointer) and + not((methodpointer.nodetype=loadn) and + (loadnf_is_self in tloadnode(methodpointer).loadnodeflags)) then + begin + if (methodpointer.resultdef.typ = objectdef) then + objectdf:=tobjectdef(methodpointer.resultdef) + else + if (methodpointer.resultdef.typ = classrefdef) and + (tclassrefdef(methodpointer.resultdef).pointeddef.typ = objectdef) and + (methodpointer.nodetype in [typen,loadvmtaddrn]) then + objectdf:=tobjectdef(tclassrefdef(methodpointer.resultdef).pointeddef); + end; + if not assigned(objectdf) then + exit; + + parents := tlinkedlist.create; + AbstractMethodsList := TFPHashList.create; + + { insert all parents in this class : the first item in the + list will be the base parent of the class . + } + while assigned(objectdf) do + begin + objectinfo:=tobjectinfoitem.create(objectdf); + parents.insert(objectinfo); + objectdf := objectdf.childof; + end; + { now all parents are in the correct order + insert all abstract methods in the list, and remove + those which are overridden by parent classes. + } + objectinfo:=tobjectinfoitem(parents.first); + while assigned(objectinfo) do + begin + objectdf := objectinfo.objinfo; + if assigned(objectdf.symtable) then + objectdf.symtable.SymList.ForEachCall(@verifyabstract,nil); + objectinfo:=tobjectinfoitem(objectinfo.next); + end; + if assigned(parents) then + parents.free; + { Finally give out a warning for each abstract method still in the list } + for i:=0 to AbstractMethodsList.Count-1 do + begin + pd:=tprocdef(AbstractMethodsList[i]); + if po_abstractmethod in pd.procoptions then + begin + Message2(type_w_instance_with_abstract,objectdf.objrealname^,pd.procsym.RealName); + MessagePos1(pd.fileinfo,sym_h_abstract_method_list,pd.fullprocname(true)); + end; + end; + if assigned(AbstractMethodsList) then + AbstractMethodsList.Free; + end; + + + procedure tcallnode.convert_carg_array_of_const; + var + hp : tarrayconstructornode; + oldleft : tcallparanode; + begin + oldleft:=tcallparanode(left); + if oldleft.left.nodetype<>arrayconstructorn then + begin + CGMessage1(type_e_wrong_type_in_array_constructor,oldleft.left.resultdef.typename); + exit; + end; + include(callnodeflags,cnf_uses_varargs); + { Get arrayconstructor node and insert typeconvs } + hp:=tarrayconstructornode(oldleft.left); + { Add c args parameters } + { It could be an empty set } + if assigned(hp) and + assigned(hp.left) then + begin + while assigned(hp) do + begin + left:=ccallparanode.create(hp.left,left); + { set callparanode resultdef and flags } + left.resultdef:=hp.left.resultdef; + include(tcallparanode(left).callparaflags,cpf_varargs_para); + hp.left:=nil; + hp:=tarrayconstructornode(hp.right); + end; + end; + { Remove value of old array of const parameter, but keep it + in the list because it is required for bind_parasym. + Generate a nothign to keep callparanoed.left valid } + oldleft.left.free; + oldleft.left:=cnothingnode.create; + end; + + + procedure tcallnode.bind_parasym; + type + pcallparanode = ^tcallparanode; + var + i : integer; + pt : tcallparanode; + oldppt : pcallparanode; + varargspara, + currpara : tparavarsym; + hiddentree : tnode; + paradef : tdef; + begin + pt:=tcallparanode(left); + oldppt:=pcallparanode(@left); + + { flag all callparanodes that belong to the varargs } + i:=paralength; + while (i>procdefinition.maxparacount) do + begin + include(pt.callparaflags,cpf_varargs_para); + oldppt:=pcallparanode(@pt.right); + pt:=tcallparanode(pt.right); + dec(i); + end; + + { skip varargs that are inserted by array of const } + while assigned(pt) and + (cpf_varargs_para in pt.callparaflags) do + pt:=tcallparanode(pt.right); + + { process normal parameters and insert hidden parameter nodes, the content + of the hidden parameters will be updated in pass1 } + for i:=procdefinition.paras.count-1 downto 0 do + begin + currpara:=tparavarsym(procdefinition.paras[i]); + if vo_is_hidden_para in currpara.varoptions then + begin + { Here we handle only the parameters that depend on + the types of the previous parameter. The typeconversion + can change the type in the next step. For example passing + an array can be change to a pointer and a deref } + if vo_is_high_para in currpara.varoptions then + begin + if not assigned(pt) or (i=0) then + internalerror(200304081); + { we need the information of the previous parameter } + paradef:=tparavarsym(procdefinition.paras[i-1]).vardef; + hiddentree:=gen_high_tree(pt.left,paradef); + { for open array of managed type, a copy of high parameter is + necessary to properly initialize before the call } + if is_open_array(paradef) and + (tparavarsym(procdefinition.paras[i-1]).varspez=vs_out) and + is_managed_type(tarraydef(paradef).elementdef) then + begin + typecheckpass(hiddentree); + {this eliminates double call to fpc_dynarray_high, if any} + maybe_load_in_temp(hiddentree); + oldppt^.third:=hiddentree.getcopy; + end; + end + else + if vo_is_typinfo_para in currpara.varoptions then + begin + if not assigned(pt) or (i=0) then + internalerror(200304082); + hiddentree:=caddrnode.create_internal( + crttinode.create(Tstoreddef(pt.resultdef),fullrtti,rdt_normal) + ); + end + else + hiddentree:=cnothingnode.create; + pt:=ccallparanode.create(hiddentree,oldppt^); + oldppt^:=pt; + end; + if not assigned(pt) then + internalerror(200310052); + pt.parasym:=currpara; + oldppt:=pcallparanode(@pt.right); + pt:=tcallparanode(pt.right); + end; + + { Create parasyms for varargs, first count the number of varargs paras, + then insert the parameters with numbering in reverse order. The SortParas + will set the correct order at the end} + pt:=tcallparanode(left); + i:=0; + while assigned(pt) do + begin + if cpf_varargs_para in pt.callparaflags then + inc(i); + pt:=tcallparanode(pt.right); + end; + if (i>0) then + begin + varargsparas:=tvarargsparalist.create; + pt:=tcallparanode(left); + while assigned(pt) do + begin + if cpf_varargs_para in pt.callparaflags then + begin + varargspara:=tparavarsym.create('va'+tostr(i),i,vs_value,pt.resultdef,[]); + dec(i); + { varargspara is left-right, use insert + instead of concat } + varargsparas.add(varargspara); + pt.parasym:=varargspara; + end; + pt:=tcallparanode(pt.right); + end; + varargsparas.sortparas; + end; + end; + + + function tcallnode.pass_typecheck:tnode; + var + candidates : tcallcandidates; + oldcallnode : tcallnode; + hpt : tnode; + pt : tcallparanode; + lastpara : longint; + paraidx, + cand_cnt : integer; + i : longint; + ignorevisibility, + is_const : boolean; + statements : tstatementnode; + converted_result_data : ttempcreatenode; + calltype: tdispcalltype; + label + errorexit; + begin + result:=nil; + candidates:=nil; + + oldcallnode:=aktcallnode; + aktcallnode:=self; + + { determine length of parameter list } + pt:=tcallparanode(left); + paralength:=0; + while assigned(pt) do + begin + inc(paralength); + pt:=tcallparanode(pt.right); + end; + + { determine the type of the parameters } + if assigned(left) then + begin + tcallparanode(left).get_paratype; + if codegenerror then + goto errorexit; + end; + + if assigned(methodpointer) then + typecheckpass(methodpointer); + + { procedure variable ? } + if assigned(right) then + begin + set_varstate(right,vs_read,[vsf_must_be_valid]); + typecheckpass(right); + if codegenerror then + exit; + + procdefinition:=tabstractprocdef(right.resultdef); + + { Compare parameters from right to left } + paraidx:=procdefinition.Paras.count-1; + { Skip default parameters } + if not(po_varargs in procdefinition.procoptions) then + begin + { ignore hidden parameters } + while (paraidx>=0) and (vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) do + dec(paraidx); + for i:=1 to procdefinition.maxparacount-paralength do + begin + if paraidx<0 then + internalerror(200402261); + if not assigned(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym) then + begin + CGMessage1(parser_e_wrong_parameter_size,'<Procedure Variable>'); + goto errorexit; + end; + dec(paraidx); + end; + end; + while (paraidx>=0) and (vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) do + dec(paraidx); + pt:=tcallparanode(left); + lastpara:=paralength; + while (paraidx>=0) and assigned(pt) do + begin + { only goto next para if we're out of the varargs } + if not(po_varargs in procdefinition.procoptions) or + (lastpara<=procdefinition.maxparacount) then + begin + repeat + dec(paraidx); + until (paraidx<0) or not(vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions); + end; + pt:=tcallparanode(pt.right); + dec(lastpara); + end; + if assigned(pt) or + ((paraidx>=0) and + not assigned(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym)) then + begin + if assigned(pt) then + current_filepos:=pt.fileinfo; + CGMessage1(parser_e_wrong_parameter_size,'<Procedure Variable>'); + goto errorexit; + end; + end + else + { not a procedure variable } + begin + { do we know the procedure to call ? } + if not(assigned(procdefinition)) then + begin + { ignore possible private for properties or in delphi mode for anon. inherited (FK) } + ignorevisibility:=(nf_isproperty in flags) or + ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags)); + candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility, + not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags, + callnodeflags*[cnf_anon_inherited,cnf_inherited]=[],cnf_anon_inherited in callnodeflags); + + { no procedures found? then there is something wrong + with the parameter size or the procedures are + not accessible } + if candidates.count=0 then + begin + { when it's an auto inherited call and there + is no procedure found, but the procedures + were defined with overload directive and at + least two procedures are defined then we ignore + this inherited by inserting a nothingn. Only + do this ugly hack in Delphi mode as it looks more + like a bug. It's also not documented } + if (m_delphi in current_settings.modeswitches) and + (cnf_anon_inherited in callnodeflags) and + (symtableprocentry.owner.symtabletype=ObjectSymtable) and + (po_overload in tprocdef(symtableprocentry.ProcdefList[0]).procoptions) and + (symtableprocentry.ProcdefList.Count>=2) then + result:=cnothingnode.create + else + begin + { in tp mode we can try to convert to procvar if + there are no parameters specified } + if not(assigned(left)) and + not(cnf_inherited in callnodeflags) and + ((m_tp_procvar in current_settings.modeswitches) or + (m_mac_procvar in current_settings.modeswitches)) and + (not assigned(methodpointer) or + (methodpointer.nodetype <> typen)) then + begin + hpt:=cloadnode.create(tprocsym(symtableprocentry),symtableproc); + if assigned(methodpointer) then + tloadnode(hpt).set_mp(methodpointer.getcopy); + typecheckpass(hpt); + result:=hpt; + end + else + begin + CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,symtableprocentry.realname); + symtableprocentry.write_parameter_lists(nil); + end; + end; + candidates.free; + goto errorexit; + end; + + { Retrieve information about the candidates } + candidates.get_information; +{$ifdef EXTDEBUG} + { Display info when multiple candidates are found } + if candidates.count>1 then + candidates.dump_info(V_Debug); +{$endif EXTDEBUG} + + { Choose the best candidate and count the number of + candidates left } + cand_cnt:=candidates.choose_best(procdefinition, + assigned(left) and + not assigned(tcallparanode(left).right) and + (tcallparanode(left).left.resultdef.typ=variantdef)); + + { All parameters are checked, check if there are any + procedures left } + if cand_cnt>0 then + begin + { Multiple candidates left? } + if cand_cnt>1 then + begin + CGMessage(type_e_cant_choose_overload_function); +{$ifdef EXTDEBUG} + candidates.dump_info(V_Hint); +{$else EXTDEBUG} + candidates.list(false); +{$endif EXTDEBUG} + { we'll just use the first candidate to make the + call } + end; + + { assign procdefinition } + if symtableproc=nil then + symtableproc:=procdefinition.owner; + end + else + begin + { No candidates left, this must be a type error, + because wrong size is already checked. procdefinition + is filled with the first (random) definition that is + found. We use this definition to display a nice error + message that the wrong type is passed } + candidates.find_wrong_para; + candidates.list(true); +{$ifdef EXTDEBUG} + candidates.dump_info(V_Hint); +{$endif EXTDEBUG} + + { We can not proceed, release all procs and exit } + candidates.free; + goto errorexit; + end; + + candidates.free; + end; { end of procedure to call determination } + end; + + { check for hints (deprecated etc) } + if (procdefinition.typ = procdef) then + check_hints(tprocdef(procdefinition).procsym,tprocdef(procdefinition).symoptions,tprocdef(procdefinition).deprecatedmsg); + + { add needed default parameters } + if assigned(procdefinition) and + (paralength<procdefinition.maxparacount) then + begin + paraidx:=0; + i:=0; + while (i<paralength) do + begin + if paraidx>=procdefinition.Paras.count then + internalerror(200306181); + if not(vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) then + inc(i); + inc(paraidx); + end; + while (paraidx<procdefinition.paras.count) and (vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions) do + inc(paraidx); + while (paraidx<procdefinition.paras.count) do + begin + if not assigned(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym) then + internalerror(200212142); + left:=ccallparanode.create(genconstsymtree( + tconstsym(tparavarsym(procdefinition.paras[paraidx]).defaultconstsym)),left); + { Ignore vs_hidden parameters } + repeat + inc(paraidx); + until (paraidx>=procdefinition.paras.count) or + not(vo_is_hidden_para in tparavarsym(procdefinition.paras[paraidx]).varoptions); + end; + end; + + { recursive call? } + if assigned(current_procinfo) and + (procdefinition=current_procinfo.procdef) then + include(current_procinfo.flags,pi_is_recursive); + + { handle predefined procedures } + is_const:=(po_internconst in procdefinition.procoptions) and + ((block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) or + (assigned(left) and (tcallparanode(left).left.nodetype in [realconstn,ordconstn]))); + if (procdefinition.proccalloption=pocall_internproc) or is_const then + begin + if assigned(left) then + begin + { convert types to those of the prototype, this is required by functions like ror, rol, sar + some use however a dummy type (Typedfile) so this would break them } + if not(tprocdef(procdefinition).extnumber in [fpc_in_Reset_TypedFile,fpc_in_Rewrite_TypedFile]) then + begin + { bind parasyms to the callparanodes and insert hidden parameters } + bind_parasym; + + { insert type conversions for parameters } + if assigned(left) then + tcallparanode(left).insert_typeconv; + end; + + { ptr and settextbuf need two args } + if assigned(tcallparanode(left).right) then + begin + hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,left); + left:=nil; + end + else + begin + hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,tcallparanode(left).left); + tcallparanode(left).left:=nil; + end; + end + else + hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,nil); + result:=hpt; + goto errorexit; + end; + + { ensure that the result type is set } + if not(cnf_typedefset in callnodeflags) then + begin + { constructors return their current class type, not the type where the + constructor is declared, this can be different because of inheritance } + if (procdefinition.proctypeoption=potype_constructor) and + assigned(methodpointer) and + assigned(methodpointer.resultdef) and + (methodpointer.resultdef.typ=classrefdef) then + resultdef:=tclassrefdef(methodpointer.resultdef).pointeddef + else + { Member call to a (inherited) constructor from the class, the return + value is always self, so we change it to voidtype to generate an + error and to prevent users from generating non-working code + when they expect to clone the current instance, see bug 3662 (PFV) } + if (procdefinition.proctypeoption=potype_constructor) and + is_class(tprocdef(procdefinition).struct) and + assigned(methodpointer) and + (methodpointer.nodetype=loadn) and + (loadnf_is_self in tloadnode(methodpointer).loadnodeflags) then + resultdef:=voidtype + else + resultdef:=procdefinition.returndef; + end + else + resultdef:=typedef; + + { Check object/class for methods } + if assigned(methodpointer) then + begin + { direct call to inherited abstract method, then we + can already give a error in the compiler instead + of a runtime error } + if (cnf_inherited in callnodeflags) and + (po_abstractmethod in procdefinition.procoptions) then + begin + if (m_delphi in current_settings.modeswitches) and + (cnf_anon_inherited in callnodeflags) then + begin + CGMessage(cg_h_inherited_ignored); + result:=cnothingnode.create; + exit; + end + else + CGMessage(cg_e_cant_call_abstract_method); + end; + + { directly calling an interface/protocol/category/class helper + method via its type is not possible (always must be called via + the actual instance) } + if (methodpointer.nodetype=typen) and + (is_interface(methodpointer.resultdef) or + is_objc_protocol_or_category(methodpointer.resultdef)) then + CGMessage1(type_e_class_type_expected,methodpointer.resultdef.typename); + + { if an inherited con- or destructor should be } + { called in a con- or destructor then a warning } + { will be made } + { con- and destructors need a pointer to the vmt } + if (cnf_inherited in callnodeflags) and + (procdefinition.proctypeoption in [potype_constructor,potype_destructor]) and + is_object(methodpointer.resultdef) and + not(current_procinfo.procdef.proctypeoption in [potype_constructor,potype_destructor]) then + CGMessage(cg_w_member_cd_call_from_method); + + if methodpointer.nodetype<>typen then + begin + { Remove all postfix operators } + hpt:=methodpointer; + while assigned(hpt) and (hpt.nodetype in [subscriptn,vecn]) do + hpt:=tunarynode(hpt).left; + + if ((hpt.nodetype=loadvmtaddrn) or + ((hpt.nodetype=loadn) and assigned(tloadnode(hpt).resultdef) and (tloadnode(hpt).resultdef.typ=classrefdef))) and + not (procdefinition.proctypeoption=potype_constructor) and + not (po_classmethod in procdefinition.procoptions) and + not (po_staticmethod in procdefinition.procoptions) then + { error: we are calling instance method from the class method/static method } + CGMessage(parser_e_only_class_members); + + if (procdefinition.proctypeoption=potype_constructor) and + assigned(symtableproc) and + (symtableproc.symtabletype=withsymtable) and + (tnode(twithsymtable(symtableproc).withrefnode).nodetype=temprefn) then + CGmessage(cg_e_cannot_call_cons_dest_inside_with); + + { R.Init then R will be initialized by the constructor, + Also allow it for simple loads } + if (procdefinition.proctypeoption=potype_constructor) or + ((hpt.nodetype=loadn) and + (methodpointer.resultdef.typ=objectdef) and + not(oo_has_virtual in tobjectdef(methodpointer.resultdef).objectoptions) + ) then + { a constructor will and a method may write something to } + { the fields } + set_varstate(methodpointer,vs_readwritten,[]) + else + set_varstate(methodpointer,vs_read,[vsf_must_be_valid]); + end; + + { if we are calling the constructor check for abstract + methods. Ignore inherited and member calls, because the + class is then already created } + if (procdefinition.proctypeoption=potype_constructor) and + not(cnf_inherited in callnodeflags) and + not(cnf_member_call in callnodeflags) then + verifyabstractcalls; + end + else + begin + { When this is method the methodpointer must be available } + if (right=nil) and + (procdefinition.owner.symtabletype in [ObjectSymtable,recordsymtable]) and + not procdefinition.no_self_node then + internalerror(200305061); + end; + + { Set flag that the procedure uses varargs, also if they are not passed it is still + needed for x86_64 to pass the number of SSE registers used } + if po_varargs in procdefinition.procoptions then + include(callnodeflags,cnf_uses_varargs); + + { Change loading of array of const to varargs } + if assigned(left) and + is_array_of_const(tparavarsym(procdefinition.paras[procdefinition.paras.count-1]).vardef) and + (procdefinition.proccalloption in cdecl_pocalls) then + convert_carg_array_of_const; + + { bind parasyms to the callparanodes and insert hidden parameters } + bind_parasym; + + { insert type conversions for parameters } + if assigned(left) then + tcallparanode(left).insert_typeconv; + + { dispinterface methode invoke? } + if assigned(methodpointer) and is_dispinterface(methodpointer.resultdef) then + begin + case procdefinition.proctypeoption of + potype_propgetter: calltype:=dct_propget; + potype_propsetter: calltype:=dct_propput; + else + calltype:=dct_method; + end; + { if the result is used, we've to insert a call to convert the type to be on the "safe side" } + if (cnf_return_value_used in callnodeflags) and not is_void(procdefinition.returndef) then + begin + result:=internalstatements(statements); + converted_result_data:=ctempcreatenode.create(procdefinition.returndef,sizeof(procdefinition.returndef), + tt_persistent,true); + addstatement(statements,converted_result_data); + addstatement(statements,cassignmentnode.create(ctemprefnode.create(converted_result_data), + ctypeconvnode.create_internal( + translate_disp_call(methodpointer,parameters,calltype,'',tprocdef(procdefinition).dispid,procdefinition.returndef), + procdefinition.returndef))); + addstatement(statements,ctempdeletenode.create_normal_temp(converted_result_data)); + addstatement(statements,ctemprefnode.create(converted_result_data)); + end + else + result:=translate_disp_call(methodpointer,parameters,calltype,'',tprocdef(procdefinition).dispid,voidtype); + + { don't free reused nodes } + methodpointer:=nil; + parameters:=nil; + end; + + errorexit: + aktcallnode:=oldcallnode; + end; + + + procedure tcallnode.order_parameters; + var + hp,hpcurr,hpnext,hpfirst,hpprev : tcallparanode; + currloc : tcgloc; + begin + hpfirst:=nil; + hpcurr:=tcallparanode(left); + { cache all info about parameters containing stack tainting calls, + since we will need it a lot below and calculting it can be expensive } + while assigned(hpcurr) do + begin + hpcurr.init_contains_stack_tainting_call_cache; + hpcurr:=tcallparanode(hpcurr.right); + end; + hpcurr:=tcallparanode(left); + while assigned(hpcurr) do + begin + { pull out } + hpnext:=tcallparanode(hpcurr.right); + { pull in at the correct place. + Used order: + 1. LOC_REFERENCE with smallest offset (i386 only) + 2. LOC_REFERENCE with least complexity (non-i386 only) + 3. LOC_REFERENCE with most complexity (non-i386 only) + 4. LOC_REGISTER with most complexity + 5. LOC_REGISTER with least complexity + For the moment we only look at the first parameter field. Combining it + with multiple parameter fields will make things a lot complexer (PFV) + + The reason for the difference regarding complexity ordering + between LOC_REFERENCE and LOC_REGISTER is mainly for calls: + we first want to treat the LOC_REFERENCE destinations whose + calculation does not require a call, because their location + may contain registers which might otherwise have to be saved + if a call has to be evaluated first. The calculated value is + stored on the stack and will thus no longer occupy any + register. + + Similarly, for the register parameters we first want to + evaluate the calls, because otherwise the already loaded + register parameters will have to be saved so the intermediate + call can be evaluated (JM) } + if not assigned(hpcurr.parasym.paraloc[callerside].location) then + internalerror(200412152); + currloc:=hpcurr.parasym.paraloc[callerside].location^.loc; + hpprev:=nil; + hp:=hpfirst; + { on fixed_stack targets, always evaluate parameters containing + a call with stack parameters before all other parameters, + because they will prevent any other parameters from being put + in their final place; if both the current and the next para + contain a stack tainting call, don't do anything to prevent + them from keeping on chasing eachother's tail } + while assigned(hp) do + begin + if paramanager.use_fixed_stack and + hpcurr.contains_stack_tainting_call_cached then + break; + case currloc of + LOC_REFERENCE : + begin + case hp.parasym.paraloc[callerside].location^.loc of + LOC_REFERENCE : + begin + { Offset is calculated like: + sub esp,12 + mov [esp+8],para3 + mov [esp+4],para2 + mov [esp],para1 + call function + That means the for pushes the para with the + highest offset (see para3) needs to be pushed first + } +{$ifdef i386} + { the i386 code generator expects all reference } + { parameter to be in this order so it can use } + { pushes in case of no fixed stack } + if (not paramanager.use_fixed_stack and + (hpcurr.parasym.paraloc[callerside].location^.reference.offset> + hp.parasym.paraloc[callerside].location^.reference.offset)) or + (paramanager.use_fixed_stack and + (node_complexity(hpcurr)<node_complexity(hp))) then +{$else i386} + if (node_complexity(hpcurr)<node_complexity(hp)) then +{$endif i386} + break; + end; + LOC_MMREGISTER, + LOC_REGISTER, + LOC_FPUREGISTER : + break; + end; + end; + LOC_MMREGISTER, + LOC_FPUREGISTER, + LOC_REGISTER : + begin + if (hp.parasym.paraloc[callerside].location^.loc<>LOC_REFERENCE) and + (node_complexity(hpcurr)>node_complexity(hp)) then + break; + end; + end; + hpprev:=hp; + hp:=tcallparanode(hp.right); + end; + hpcurr.right:=hp; + if assigned(hpprev) then + hpprev.right:=hpcurr + else + hpfirst:=hpcurr; + { next } + hpcurr:=hpnext; + end; + left:=hpfirst; + { now mark each parameter that is followed by a stack-tainting call, + to determine on use_fixed_stack targets which ones can immediately be + put in their final destination. Unforunately we can never put register + parameters immediately in their final destination (even on register- + rich architectures such as the PowerPC), because the code generator + can still insert extra calls that only make use of register + parameters (fpc_move() etc. } + hpcurr:=hpfirst; + while assigned(hpcurr) do + begin + if hpcurr.contains_stack_tainting_call_cached then + begin + { all parameters before this one are followed by a stack + tainting call } + hp:=hpfirst; + while hp<>hpcurr do + begin + hp.ffollowed_by_stack_tainting_call_cached:=true; + hp:=tcallparanode(hp.right); + end; + hpfirst:=hpcurr; + end; + hpcurr:=tcallparanode(hpcurr.right); + end; + end; + + + procedure tcallnode.check_stack_parameters; + var + hp : tcallparanode; + begin + hp:=tcallparanode(left); + while assigned(hp) do + begin + if assigned(hp.parasym) and + assigned(hp.parasym.paraloc[callerside].location) and + (hp.parasym.paraloc[callerside].location^.loc=LOC_REFERENCE) then + include(current_procinfo.flags,pi_has_stackparameter); + hp:=tcallparanode(hp.right); + end; + end; + + + procedure tcallnode.check_inlining; + var + st : tsymtable; + para : tcallparanode; + begin + { Can we inline the procedure? } + if ([po_inline,po_has_inlininginfo] <= procdefinition.procoptions) then + begin + include(callnodeflags,cnf_do_inline); + { Check if we can inline the procedure when it references proc/var that + are not in the globally available } + st:=procdefinition.owner; + if (st.symtabletype=ObjectSymtable) then + st:=st.defowner.owner; + if (pi_uses_static_symtable in tprocdef(procdefinition).inlininginfo^.flags) and + (st.symtabletype=globalsymtable) and + (not st.iscurrentunit) then + begin + Comment(V_lineinfo+V_Debug,'Not inlining "'+tprocdef(procdefinition).procsym.realname+'", references static symtable'); + exclude(callnodeflags,cnf_do_inline); + end; + para:=tcallparanode(parameters); + while assigned(para) do + begin + if not para.can_be_inlined then + begin + Comment(V_lineinfo+V_Debug,'Not inlining "'+tprocdef(procdefinition).procsym.realname+ + '", invocation parameter contains an unsafe/unsupported construct'); + exclude(callnodeflags,cnf_do_inline); + break; + end; + para:=tcallparanode(para.nextpara); + end; + end; + end; + + + function tcallnode.pass_1 : tnode; + begin + result:=nil; + + { as pass_1 is never called on the methodpointer node, we must check + here that it's not a helper type } + if assigned(methodpointer) and + (methodpointer.nodetype=typen) and + is_objectpascal_helper(ttypenode(methodpointer).typedef) and + not ttypenode(methodpointer).helperallowed then + Message(parser_e_no_category_as_types); + + { convert Objective-C calls into a message call } + if (procdefinition.typ=procdef) and + (po_objc in tprocdef(procdefinition).procoptions) then + begin + if not(cnf_objc_processed in callnodeflags) then + objc_convert_to_message_send; + end + else + begin + { The following don't apply to obj-c: obj-c methods can never be + inlined because they're always virtual and the destination can + change at run, and for the same reason we also can't perform + WPO on them (+ they have no constructors) } + + { Check if the call can be inlined, sets the cnf_do_inline flag } + check_inlining; + + { must be called before maybe_load_in_temp(methodpointer), because + it converts the methodpointer into a temp in case it's a call + (and we want to know the original call) + } + register_created_object_types; + end; + + { Maybe optimize the loading of the methodpointer using a temp. When the methodpointer + is a calln this is even required to not execute the calln twice. + This needs to be done after the resulttype pass, because in the resulttype we can still convert the + calln to a loadn (PFV) } + if assigned(methodpointer) then + maybe_load_in_temp(methodpointer); + + { Create destination (temp or assignment-variable reuse) for function result if it not yet set } + maybe_create_funcret_node; + + { Insert the self,vmt,function result in the parameters } + gen_hidden_parameters; + + { Remove useless nodes from init/final blocks } + { (simplify depends on typecheck info) } + if assigned(callinitblock) then + begin + typecheckpass(tnode(callinitblock)); + doinlinesimplify(tnode(callinitblock)); + end; + if assigned(callcleanupblock) then + begin + typecheckpass(tnode(callcleanupblock)); + doinlinesimplify(tnode(callcleanupblock)); + end; + + { Continue with checking a normal call or generate the inlined code } + if cnf_do_inline in callnodeflags then + result:=pass1_inline + else + result:=pass1_normal; + end; + + + function tcallnode.pass1_normal : tnode; + begin + result:=nil; + + { calculate the parameter info for the procdef } + procdefinition.init_paraloc_info(callerside); + + { calculate the parameter size needed for this call include varargs if they are available } + if assigned(varargsparas) then + pushedparasize:=paramanager.create_varargs_paraloc_info(procdefinition,varargsparas) + else + pushedparasize:=procdefinition.callerargareasize; + + { record maximum parameter size used in this proc } + current_procinfo.allocate_push_parasize(pushedparasize); + + { check for stacked parameters } + if assigned(left) and + (current_settings.optimizerswitches*[cs_opt_stackframe,cs_opt_level1]<>[]) then + check_stack_parameters; + + if assigned(callinitblock) then + firstpass(tnode(callinitblock)); + + { function result node (tempref or simple load) } + if assigned(funcretnode) then + firstpass(funcretnode); + + { parameters } + if assigned(left) then + tcallparanode(left).firstcallparan; + + { procedure variable ? } + if assigned(right) then + firstpass(right); + + if assigned(methodpointer) and + (methodpointer.nodetype<>typen) then + firstpass(methodpointer); + + if assigned(callcleanupblock) then + firstpass(tnode(callcleanupblock)); + + if not (block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) then + include(current_procinfo.flags,pi_do_call); + + { order parameters } + order_parameters; + + { get a register for the return value } + if (not is_void(resultdef)) then + begin + if paramanager.ret_in_param(resultdef,procdefinition.proccalloption) then + begin + expectloc:=LOC_REFERENCE; + end + else + { ansi/widestrings must be registered, so we can dispose them } + if is_ansistring(resultdef) or + is_widestring(resultdef) or + is_unicodestring(resultdef) then + begin + expectloc:=LOC_REFERENCE; + end + else + { we have only to handle the result if it is used } + if (cnf_return_value_used in callnodeflags) then + expectloc:=get_expect_loc + else + expectloc:=LOC_VOID; + end + else + expectloc:=LOC_VOID; + end; + +{$ifdef state_tracking} + function Tcallnode.track_state_pass(exec_known:boolean):boolean; + + var hp:Tcallparanode; + value:Tnode; + + begin + track_state_pass:=false; + hp:=Tcallparanode(left); + while assigned(hp) do + begin + if left.track_state_pass(exec_known) then + begin + left.resultdef:=nil; + do_typecheckpass(left); + end; + value:=aktstate.find_fact(hp.left); + if value<>nil then + begin + track_state_pass:=true; + hp.left.destroy; + hp.left:=value.getcopy; + do_typecheckpass(hp.left); + end; + hp:=Tcallparanode(hp.right); + end; + end; +{$endif} + + +{************************************************************************** + INLINING SUPPORT +**************************************************************************} + + function tcallnode.replaceparaload(var n: tnode; arg: pointer): foreachnoderesult; + var + paras: tcallparanode; + temp: tnode; + indexnr : integer; + begin + result := fen_false; + n.fileinfo := pfileposinfo(arg)^; + if (n.nodetype = loadn) then + begin + case tloadnode(n).symtableentry.typ of + paravarsym : + begin + paras := tcallparanode(left); + while assigned(paras) and + (paras.parasym <> tloadnode(n).symtableentry) do + paras := tcallparanode(paras.right); + if assigned(paras) then + begin + n.free; + n := paras.left.getcopy; + typecheckpass(n); + result := fen_true; + end; + end; + localvarsym : + begin + { local? } + if (tloadnode(n).symtableentry.owner <> tprocdef(procdefinition).localst) then + exit; + indexnr:=tloadnode(n).symtableentry.owner.SymList.IndexOf(tloadnode(n).symtableentry); + if (indexnr >= inlinelocals.count) or + not assigned(inlinelocals[indexnr]) then + internalerror(20040720); + temp := tnode(inlinelocals[indexnr]).getcopy; + n.free; + n := temp; + typecheckpass(n); + result := fen_true; + end; + end; + end; + end; + + + procedure tcallnode.createlocaltemps(p:TObject;arg:pointer); + var + tempnode: ttempcreatenode; + indexnr : integer; + begin + if (TSym(p).typ <> localvarsym) then + exit; + indexnr:=TSym(p).Owner.SymList.IndexOf(p); + if (indexnr >= inlinelocals.count) then + inlinelocals.count:=indexnr+10; + if (vo_is_funcret in tabstractvarsym(p).varoptions) then + begin + if not assigned(funcretnode) then + internalerror(200709081); + inlinelocals[indexnr] := funcretnode.getcopy + end + else + begin + tempnode :=ctempcreatenode.create(tabstractvarsym(p).vardef, + tabstractvarsym(p).vardef.size,tt_persistent,tabstractvarsym(p).is_regvar(false)); + addstatement(inlineinitstatement,tempnode); + addstatement(inlinecleanupstatement,ctempdeletenode.create(tempnode)); + { inherit addr_taken flag } + if (tabstractvarsym(p).addr_taken) then + include(tempnode.tempinfo^.flags,ti_addr_taken); + inlinelocals[indexnr] := ctemprefnode.create(tempnode); + end; + end; + + + function nonlocalvars(var n: tnode; arg: pointer): foreachnoderesult; + begin + result := fen_false; + { this is just to play it safe, there are more safe situations } + if (n.nodetype = derefn) or + ((n.nodetype = loadn) and + { globals and fields of (possibly global) objects could always be changed in the callee } + ((tloadnode(n).symtable.symtabletype in [globalsymtable,ObjectSymtable]) or + { statics can only be modified by functions in the same unit } + ((tloadnode(n).symtable.symtabletype = staticsymtable) and + (tloadnode(n).symtable = TSymtable(arg))))) or + ((n.nodetype = subscriptn) and + (tsubscriptnode(n).vs.owner.symtabletype = ObjectSymtable)) then + result := fen_norecurse_true; + end; + + + procedure tcallnode.createinlineparas; + var + para: tcallparanode; + tempnode: ttempcreatenode; + n: tnode; + paraaddr: taddrnode; + ptrtype: tpointerdef; + paracomplexity: longint; + begin + { parameters } + para := tcallparanode(left); + while assigned(para) do + begin + if (para.parasym.typ = paravarsym) then + begin + { must take copy of para.left, because if it contains a } + { temprefn pointing to a copied temp (e.g. methodpointer), } + { then this parameter must be changed to point to the copy of } + { that temp (JM) } + n := para.left.getcopy; + para.left.free; + para.left := n; + + firstpass(para.left); + + { create temps for value parameters, function result and also for } + { const parameters which are passed by value instead of by reference } + { we need to take care that we use the type of the defined parameter and not of the + passed parameter, because these can be different in case of a formaldef (PFV) } + paracomplexity := node_complexity(para.left); + { check if we have to create a temp, assign the parameter's } + { contents to that temp and then substitute the paramter } + { with the temp everywhere in the function } + if + ((tparavarsym(para.parasym).varregable in [vr_none,vr_addr]) and + not(para.left.expectloc in [LOC_REFERENCE,LOC_CREFERENCE])) or + { we can't assign to formaldef temps } + ((para.parasym.vardef.typ<>formaldef) and + ( + { if paracomplexity > 1, we normally take the address of } + { the parameter expression, store it in a temp and } + { substitute the dereferenced temp in the inlined function } + { We can't do this if we can't take the address of the } + { parameter expression, so in that case assign to a temp } + not(para.left.expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CONSTANT]) or + ((paracomplexity > 1) and + (not valid_for_addr(para.left,false) or + (para.left.nodetype = calln) or + is_constnode(para.left))) or + { we do not need to create a temp for value parameters } + { which are not modified in the inlined function } + { const parameters can get vs_readwritten if their } + { address is taken } + ((((para.parasym.varspez = vs_value) and + (para.parasym.varstate in [vs_initialised,vs_declared,vs_read])) or + { in case of const, this is only necessary if the } + { variable would be passed by value normally, or if } + { there is such a variable somewhere in an expression } + ((para.parasym.varspez = vs_const) and + (not paramanager.push_addr_param(vs_const,para.parasym.vardef,procdefinition.proccalloption) or + (paracomplexity > 1)))) and + { however, if we pass a global variable, an object field or} + { an expression containing a pointer dereference as } + { parameter, this value could be modified in other ways as } + { well and in such cases create a temp to be on the safe } + { side } + foreachnodestatic(para.left,@nonlocalvars,pointer(symtableproc))) or + { value parameters of which we know they are modified by } + { definition have to be copied to a temp } + { the same goes for cases of "x:=f(x)" where x is passed } + { as value parameter to f(), at least if we optimized } + { invocation by setting the funcretnode to x to avoid } + { assignment afterwards (since x may be read inside the } + { function after it modified result==x) } + ((para.parasym.varspez = vs_value) and + (not(para.parasym.varstate in [vs_initialised,vs_declared,vs_read]) or + (assigned(aktassignmentnode) and + (aktassignmentnode.right=self) and + (nf_assign_done_in_right in aktassignmentnode.flags) and + aktassignmentnode.left.isequal(para.left)))) or + { the compiler expects that it can take the address of parameters passed by reference in + the case of const so we can't replace the node simply by a constant node + When playing with this code, ensure that + function f(const a,b : longint) : longint;inline; + begin + result:=a*b; + end; + + [...] + ...:=f(10,20)); + [...] + + is still folded. (FK) + } + ((para.parasym.varspez = vs_const) and + { const para's can get vs_readwritten if their address } + { is taken } + ((para.parasym.varstate = vs_readwritten) or + { call-by-reference const's may need to be passed by } + { reference to function called in the inlined code } + (paramanager.push_addr_param(vs_const,para.parasym.vardef,procdefinition.proccalloption) and + not valid_for_addr(para.left,false)) + )) + ) + ) then + begin + { don't create a new temp unnecessarily, but make sure we + do create a new one if the old one could be a regvar and + the new one cannot be one } + if (para.left.nodetype<>temprefn) or + (((tparavarsym(para.parasym).varregable in [vr_none,vr_addr])) and + (ti_may_be_in_reg in ttemprefnode(para.left).tempinfo^.flags)) then + begin + tempnode := ctempcreatenode.create(para.parasym.vardef,para.parasym.vardef.size, + tt_persistent,tparavarsym(para.parasym).is_regvar(false)); + addstatement(inlineinitstatement,tempnode); + addstatement(inlinecleanupstatement,ctempdeletenode.create(tempnode)); + addstatement(inlineinitstatement,cassignmentnode.create(ctemprefnode.create(tempnode), + para.left)); + para.left := ctemprefnode.create(tempnode); + { inherit addr_taken flag } + if (tabstractvarsym(para.parasym).addr_taken) then + include(tempnode.tempinfo^.flags,ti_addr_taken); + end; + end + { otherwise if the parameter is "complex", take the address } + { of the parameter expression, store it in a temp and replace } + { occurrences of the parameter with dereferencings of this } + { temp } + else if (paracomplexity > 1) then + begin + ptrtype:=tpointerdef.create(para.left.resultdef); + tempnode := ctempcreatenode.create(ptrtype,ptrtype.size,tt_persistent,tparavarsym(para.parasym).is_regvar(true)); + addstatement(inlineinitstatement,tempnode); + addstatement(inlinecleanupstatement,ctempdeletenode.create(tempnode)); + { inherit addr_taken flag } + if (tabstractvarsym(para.parasym).addr_taken) then + include(tempnode.tempinfo^.flags,ti_addr_taken); + paraaddr:=caddrnode.create_internal(para.left); + include(paraaddr.flags,nf_typedaddr); + addstatement(inlineinitstatement,cassignmentnode.create(ctemprefnode.create(tempnode), + paraaddr)); + para.left:=cderefnode.create(ctemprefnode.create(tempnode)); + end; + end; + para := tcallparanode(para.right); + end; + { local variables } + if not assigned(tprocdef(procdefinition).localst) or + (tprocdef(procdefinition).localst.SymList.count = 0) then + exit; + inlinelocals.count:=tprocdef(procdefinition).localst.SymList.count; + tprocdef(procdefinition).localst.SymList.ForEachCall(@createlocaltemps,nil); + end; + + + function tcallnode.optimize_funcret_assignment(inlineblock: tblocknode): tnode; + var + hp : tstatementnode; + hp2 : tnode; + resassign : tassignmentnode; + begin + result:=nil; + if not assigned(funcretnode) or + not(cnf_return_value_used in callnodeflags) then + exit; + + { tempcreatenode for the function result } + hp:=tstatementnode(inlineblock.left); + if not(assigned(hp)) or + (hp.left.nodetype <> tempcreaten) or + not(nf_is_funcret in hp.left.flags) then + exit; + + { constant assignment? right must be a constant (mainly to avoid trying + to reuse local temps which may already be freed afterwards once these + checks are made looser) } + hp:=tstatementnode(hp.right); + if not(assigned(hp)) or + (hp.left.nodetype<>assignn) or + not is_constnode(tassignmentnode(hp.left).right) then + exit; + + { left must be function result } + resassign:=tassignmentnode(hp.left); + hp2:=resassign.left; + { can have extra type conversion due to absolute mapping + of <fucntionname> on function result var } + if (hp2.nodetype=typeconvn) and (ttypeconvnode(hp2).convtype=tc_equal) then + hp2:=ttypeconvnode(hp2).left; + if (hp2.nodetype<>temprefn) or + not(nf_is_funcret in hp2.flags) then + exit; + + { tempdelete to normal of the function result } + hp:=tstatementnode(hp.right); + if not(assigned(hp)) or + (hp.left.nodetype <> tempdeleten) then + exit; + + { the function result once more } + hp:=tstatementnode(hp.right); + if not(assigned(hp)) or + (hp.left.nodetype<>temprefn) or + not(nf_is_funcret in hp.left.flags) then + exit; + + { should be the end } + if assigned(hp.right) then + exit; + + { we made it! } + result:=tassignmentnode(resassign).right.getcopy; + firstpass(result); + end; + + + function tcallnode.pass1_inline:tnode; + var + n, + body : tnode; + para : tcallparanode; + inlineblock, + inlinecleanupblock : tblocknode; + begin + result:=nil; + if not(assigned(tprocdef(procdefinition).inlininginfo) and + assigned(tprocdef(procdefinition).inlininginfo^.code)) then + internalerror(200412021); + + inlinelocals:=TFPObjectList.create(true); + + { inherit flags } + current_procinfo.flags:=current_procinfo.flags+ + ((procdefinition as tprocdef).inlininginfo^.flags*inherited_inlining_flags); + + { Create new code block for inlining } + inlineblock:=internalstatements(inlineinitstatement); + inlinecleanupblock:=internalstatements(inlinecleanupstatement); + + if assigned(callinitblock) then + addstatement(inlineinitstatement,callinitblock.getcopy); + + { replace complex parameters with temps } + createinlineparas; + + { create a copy of the body and replace parameter loads with the parameter values } + body:=tprocdef(procdefinition).inlininginfo^.code.getcopy; + foreachnode(pm_preprocess,body,@replaceparaload,@fileinfo); + + { Concat the body and finalization parts } + addstatement(inlineinitstatement,body); + addstatement(inlineinitstatement,inlinecleanupblock); + inlinecleanupblock:=nil; + + if assigned(callcleanupblock) then + addstatement(inlineinitstatement,callcleanupblock.getcopy); + + { the last statement of the new inline block must return the + location and type of the function result. + This is not needed when the result is not used, also the tempnode is then + already destroyed by a tempdelete in the callcleanupblock tree } + if not is_void(resultdef) and + (cnf_return_value_used in callnodeflags) then + begin + if assigned(funcretnode) then + addstatement(inlineinitstatement,funcretnode.getcopy) + else + begin + para:=tcallparanode(left); + while assigned(para) do + begin + if (vo_is_hidden_para in para.parasym.varoptions) and + (vo_is_funcret in para.parasym.varoptions) then + begin + addstatement(inlineinitstatement,para.left.getcopy); + break; + end; + para:=tcallparanode(para.right); + end; + end; + end; + + { consider it must not be inlined if called + again inside the args or itself } + exclude(procdefinition.procoptions,po_inline); + typecheckpass(tnode(inlineblock)); + doinlinesimplify(tnode(inlineblock)); + firstpass(tnode(inlineblock)); + include(procdefinition.procoptions,po_inline); + result:=inlineblock; + + { if the function result is used then verify that the blocknode + returns the same result type as the original callnode } + if (cnf_return_value_used in callnodeflags) and + (result.resultdef<>resultdef) then + internalerror(200709171); + + { free the temps for the locals } + inlinelocals.free; + inlinelocals:=nil; + inlineinitstatement:=nil; + inlinecleanupstatement:=nil; + + { if all that's left of the inlined function is an constant assignment + to the result, replace the whole block with the constant only } + n:=optimize_funcret_assignment(inlineblock); + if assigned(n) then + begin + inlineblock.free; + result:=n; + end; + +{$ifdef DEBUGINLINE} + writeln; + writeln('**************************',tprocdef(procdefinition).mangledname); + printnode(output,result); +{$endif DEBUGINLINE} + end; + +end. diff --git a/closures/compiler/ncgadd.pas b/closures/compiler/ncgadd.pas new file mode 100644 index 0000000000..45b6a9af25 --- /dev/null +++ b/closures/compiler/ncgadd.pas @@ -0,0 +1,854 @@ +{ + Copyright (c) 2000-2002 by the FPC development team + + Code generation for add nodes (generic version) + + 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 ncgadd; + +{$i fpcdefs.inc} + +interface + + uses + node,nadd,cpubase; + + type + tcgaddnode = class(taddnode) +{ function pass_1: tnode; override;} + procedure pass_generate_code;override; + protected + { call secondpass for both left and right } + procedure pass_left_right; + { set the register of the result location } + procedure set_result_location_reg; + { load left and right nodes into registers } + procedure force_reg_left_right(allow_swap,allow_constant:boolean); + + procedure second_opfloat; + procedure second_opboolean; + procedure second_opsmallset; + procedure second_op64bit; + procedure second_opordinal; + + procedure second_addstring;virtual; + procedure second_addfloat;virtual;abstract; + procedure second_addboolean;virtual; + procedure second_addsmallset;virtual; + procedure second_addsmallsetelement;virtual; +{$ifdef x86} +{$ifdef SUPPORT_MMX} + procedure second_opmmx;virtual;abstract; +{$endif SUPPORT_MMX} +{$endif x86} + procedure second_opvector;virtual;abstract; + procedure second_add64bit;virtual; + procedure second_addordinal;virtual; + procedure second_cmpfloat;virtual;abstract; + procedure second_cmpboolean;virtual; + procedure second_cmpsmallset;virtual;abstract; + procedure second_cmp64bit;virtual;abstract; + procedure second_cmpordinal;virtual;abstract; + end; + + implementation + + uses + globtype,systems, + cutils,verbose,globals, + symconst,symdef,paramgr, + aasmbase,aasmtai,aasmdata,defutil, + cgbase,procinfo,pass_2,tgobj, + nutils,ncon,nset,ncgutil,cgobj,cgutils + ; + + +{***************************************************************************** + Helpers +*****************************************************************************} + + procedure tcgaddnode.pass_left_right; + var + tmpreg : tregister; +{$ifdef x86} + pushedfpu, +{$endif x86} + isjump : boolean; + otl,ofl : tasmlabel; + begin + { calculate the operator which is more difficult } + firstcomplex(self); + + { in case of constant put it to the left } + if (left.nodetype=ordconstn) then + swapleftright; + + isjump:=(left.expectloc=LOC_JUMP); + if isjump then + begin + otl:=current_procinfo.CurrTrueLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + ofl:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + end; + secondpass(left); + if left.location.loc in [LOC_FLAGS,LOC_JUMP] then + location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(resultdef),false); + if isjump then + begin + current_procinfo.CurrTrueLabel:=otl; + current_procinfo.CurrFalseLabel:=ofl; + end; + +{$ifdef x86} + { are too few registers free? } + pushedfpu:=false; + if (left.location.loc=LOC_FPUREGISTER) and + (node_resources_fpu(right)>=maxfpuregs) then + begin + location_force_mem(current_asmdata.CurrAsmList,left.location); + pushedfpu:=true; + end; +{$endif x86} + + isjump:=(right.expectloc=LOC_JUMP); + if isjump then + begin + otl:=current_procinfo.CurrTrueLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + ofl:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + end; + secondpass(right); + if right.location.loc in [LOC_FLAGS,LOC_JUMP] then + location_force_reg(current_asmdata.CurrAsmList,right.location,def_cgsize(resultdef),false); + if isjump then + begin + current_procinfo.CurrTrueLabel:=otl; + current_procinfo.CurrFalseLabel:=ofl; + end; +{$ifdef x86} + if pushedfpu then + begin + if use_vectorfpu(left.resultdef) then + begin + tmpreg := cg.getmmregister(current_asmdata.CurrAsmList,left.location.size); + cg.a_loadmm_loc_reg(current_asmdata.CurrAsmList,left.location.size,left.location,tmpreg,mms_movescalar); + location_freetemp(current_asmdata.CurrAsmList,left.location); + location_reset(left.location,LOC_MMREGISTER,left.location.size); + left.location.register:=tmpreg; + end + else + begin + tmpreg := cg.getfpuregister(current_asmdata.CurrAsmList,left.location.size); + cg.a_loadfpu_loc_reg(current_asmdata.CurrAsmList,left.location.size,left.location,tmpreg); + location_freetemp(current_asmdata.CurrAsmList,left.location); + location_reset(left.location,LOC_FPUREGISTER,left.location.size); + left.location.register := tmpreg; + { left operand is now on top of the stack, instead of the right one! } + if (right.location.loc=LOC_FPUREGISTER) then + toggleflag(nf_swapped); + end; + end; +{$endif x86} + end; + + + procedure tcgaddnode.set_result_location_reg; + begin + location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); +{$ifdef x86} + if left.location.loc=LOC_REGISTER then + begin + if TCGSize2Size[left.location.size]<>TCGSize2Size[location.size] then + internalerror(200307041); +{$ifndef cpu64bitalu} + if location.size in [OS_64,OS_S64] then + begin + location.register64.reglo := left.location.register64.reglo; + location.register64.reghi := left.location.register64.reghi; + end + else +{$endif} + location.register := left.location.register; + end + else + if right.location.loc=LOC_REGISTER then + begin + if TCGSize2Size[right.location.size]<>TCGSize2Size[location.size] then + internalerror(200307042); +{$ifndef cpu64bitalu} + if location.size in [OS_64,OS_S64] then + begin + location.register64.reglo := right.location.register64.reglo; + location.register64.reghi := right.location.register64.reghi; + end + else +{$endif} + location.register := right.location.register; + end + else +{$endif} + begin +{$ifndef cpu64bitalu} + if location.size in [OS_64,OS_S64] then + begin + location.register64.reglo := cg.getintregister(current_asmdata.CurrAsmList,OS_32); + location.register64.reghi := cg.getintregister(current_asmdata.CurrAsmList,OS_32); + end + else +{$endif} + location.register := cg.getintregister(current_asmdata.CurrAsmList,location.size); + end; + end; + + + procedure tcgaddnode.force_reg_left_right(allow_swap,allow_constant:boolean); + begin + if (left.location.loc<>LOC_REGISTER) and + not( + allow_constant and + (left.location.loc in [LOC_CONSTANT,LOC_CREGISTER]) + ) then + location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,false); + if (right.location.loc<>LOC_REGISTER) and + not( + allow_constant and + (right.location.loc in [LOC_CONSTANT,LOC_CREGISTER]) and + (left.location.loc<>LOC_CONSTANT) + ) then + location_force_reg(current_asmdata.CurrAsmList,right.location,right.location.size,false); + + { Left is always a register, right can be register or constant } + if left.location.loc=LOC_CONSTANT then + begin + { when it is not allowed to swap we have a constant on + left, that will give problems } + if not allow_swap then + internalerror(200307043); + swapleftright; + end; + end; + + +{***************************************************************************** + Smallsets +*****************************************************************************} + + procedure tcgaddnode.second_opsmallset; + begin + { when a setdef is passed, it has to be a smallset } + if not( + ((left.nodetype=setelementn) or is_smallset(left.resultdef)) and + ((right.nodetype=setelementn) or is_smallset(right.resultdef)) + ) then + internalerror(200203302); + if (left.nodetype=setelementn) or (right.nodetype=setelementn) then + second_addsmallsetelement + else if nodetype in [equaln,unequaln,gtn,gten,lten,ltn] then + second_cmpsmallset + else + second_addsmallset; + end; + + + procedure tcgaddnode.second_addsmallset; + var + cgop : TOpCg; + opdone : boolean; + begin + opdone := false; + pass_left_right; + force_reg_left_right(true,true); + set_result_location_reg; + case nodetype of + addn : + cgop:=OP_OR; + symdifn : + cgop:=OP_XOR; + muln : + cgop:=OP_AND; + subn : + begin + cgop:=OP_AND; + if (not(nf_swapped in flags)) then + if (right.location.loc=LOC_CONSTANT) then + right.location.value := not(right.location.value) + else + opdone := true + else if (left.location.loc=LOC_CONSTANT) then + left.location.value := not(left.location.value) + else + begin + swapleftright; + opdone := true; + end; + if opdone then + begin + if (right.location.size<>left.location.size) or + (location.size<>left.location.size) then + internalerror(2010123001); + { make sure that location.register is different from + left.location.register, since right will overwrite it + and we'll use left afterwards } + if (right.location.loc=LOC_REGISTER) then + location.register:=right.location.register + else + location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size); + { make sure we don't modify left/right.location, because we told + force_reg_left_right above that they can be constant } + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NOT,location.size,right.location.register,location.register); + if left.location.loc = LOC_CONSTANT then + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_AND,location.size,left.location.value,location.register) + else + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_AND,location.size,left.location.register,location.register); + end; + end; + else + internalerror(2002072701); + end; + + if not opdone then + begin + // these are all commutative operations + if (left.location.loc = LOC_CONSTANT) then + swapleftright; + if (right.location.loc = LOC_CONSTANT) then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,cgop,location.size, + right.location.value,left.location.register, + location.register) + else + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,cgop,location.size, + right.location.register,left.location.register, + location.register); + end; + end; + + + procedure tcgaddnode.second_addsmallsetelement; + var + tmpreg : tregister; + mask, + setbase : aint; + cgop : TOpCg; + begin + if nodetype<>addn then + internalerror(20080302); + { no range support for smallsets } + if assigned(tsetelementnode(right).right) then + internalerror(20080303); + pass_left_right; + { setelementn is a special case, it must be on right } + if (nf_swapped in flags) and + (left.nodetype=setelementn) then + swapleftright; + force_reg_left_right(false,false); + set_result_location_reg; + setbase:=tsetdef(left.resultdef).setbase; + if (right.location.loc = LOC_CONSTANT) then + begin + if (target_info.endian=endian_big) then + mask:=aint((aword(1) shl (resultdef.size*8-1)) shr aword(right.location.value-setbase)) + else + mask:=aint(1 shl (right.location.value-setbase)); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_OR,location.size, + mask,left.location.register,location.register); + end + else + begin + if (target_info.endian=endian_big) then + begin + mask:=aint((aword(1) shl (resultdef.size*8-1))); + cgop:=OP_SHR + end + else + begin + mask:=1; + cgop:=OP_SHL + end; + tmpreg := cg.getintregister(current_asmdata.CurrAsmList,location.size); + cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,mask,tmpreg); + location_force_reg(current_asmdata.CurrAsmList,right.location,location.size,true); + register_maybe_adjust_setbase(current_asmdata.CurrAsmList,right.location,setbase); + cg.a_op_reg_reg(current_asmdata.CurrAsmList,cgop,location.size, + right.location.register,tmpreg); + if left.location.loc <> LOC_CONSTANT then + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,location.size,tmpreg, + left.location.register,location.register) + else + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_OR,location.size, + left.location.value,tmpreg,location.register); + end; + end; + + +{***************************************************************************** + Boolean +*****************************************************************************} + + procedure tcgaddnode.second_opboolean; + begin + if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then + second_cmpboolean + else + second_addboolean; + end; + + + procedure tcgaddnode.second_addboolean; + var + cgop : TOpCg; + otl,ofl : tasmlabel; + oldflowcontrol : tflowcontrol; + begin + { And,Or will only evaluate from left to right only the + needed nodes unless full boolean evaluation is enabled } + if (nodetype in [orn,andn]) and + (not(cs_full_boolean_eval in current_settings.localswitches) or + (nf_short_bool in flags)) then + begin + location_reset(location,LOC_JUMP,OS_NO); + case nodetype of + andn : + begin + otl:=current_procinfo.CurrTrueLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + secondpass(left); + maketojumpbool(current_asmdata.CurrAsmList,left,lr_load_regvars); + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel); + current_procinfo.CurrTrueLabel:=otl; + end; + orn : + begin + ofl:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + secondpass(left); + maketojumpbool(current_asmdata.CurrAsmList,left,lr_load_regvars); + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + current_procinfo.CurrFalseLabel:=ofl; + end; + else + internalerror(200307044); + end; + { these jumps mean we're now in a flow control construct } + oldflowcontrol:=flowcontrol; + include(flowcontrol,fc_inflowcontrol); + + secondpass(right); + maketojumpbool(current_asmdata.CurrAsmList,right,lr_load_regvars); + + flowcontrol:=oldflowcontrol+(flowcontrol-[fc_inflowcontrol]); + end + else + begin + pass_left_right; + force_reg_left_right(false,true); + set_result_location_reg; + + case nodetype of + xorn : + cgop:=OP_XOR; + orn : + cgop:=OP_OR; + andn : + cgop:=OP_AND; + else + internalerror(200203247); + end; +{$ifndef cpu64bitalu} + if right.location.size in [OS_64,OS_S64] then + begin + if right.location.loc <> LOC_CONSTANT then + cg64.a_op64_reg_reg_reg(current_asmdata.CurrAsmList,cgop,location.size, + left.location.register64,right.location.register64, + location.register64) + else + cg64.a_op64_const_reg_reg(current_asmdata.CurrAsmList,cgop,location.size, + right.location.value,left.location.register64, + location.register64); + end + else +{$endif cpu64bitalu} + begin + if right.location.loc <> LOC_CONSTANT then + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,cgop,location.size, + left.location.register,right.location.register, + location.register) + else + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,cgop,location.size, + right.location.value,left.location.register, + location.register); + end; + end; + end; + + +{***************************************************************************** + 64-bit +*****************************************************************************} + + procedure tcgaddnode.second_op64bit; + begin + if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then + second_cmp64bit + else + second_add64bit; + end; + + + procedure tcgaddnode.second_add64bit; + var + op : TOpCG; + checkoverflow : boolean; + ovloc : tlocation; + begin + ovloc.loc:=LOC_VOID; + + pass_left_right; + force_reg_left_right(false,true); + set_result_location_reg; + + { assume no overflow checking is required } + checkoverflow := false; + case nodetype of + addn : + begin + op:=OP_ADD; + checkoverflow:=true; + end; + subn : + begin + op:=OP_SUB; + checkoverflow:=true; + end; + xorn: + op:=OP_XOR; + orn: + op:=OP_OR; + andn: + op:=OP_AND; + muln: + begin + { should be handled in pass_1 (JM) } + internalerror(200109051); + end; + else + internalerror(2002072705); + end; + + checkoverflow:= + checkoverflow and + (left.resultdef.typ<>pointerdef) and + (right.resultdef.typ<>pointerdef); + +{$ifdef cpu64bitalu} + case nodetype of + xorn,orn,andn,addn: + begin + if (right.location.loc = LOC_CONSTANT) then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,op,location.size,right.location.value, + left.location.register,location.register) + else + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,op,location.size,right.location.register, + left.location.register,location.register); + end; + subn: + begin + if (nf_swapped in flags) then + swapleftright; + + if left.location.loc <> LOC_CONSTANT then + begin + if right.location.loc <> LOC_CONSTANT then + // reg64 - reg64 + cg.a_op_reg_reg_reg_checkoverflow(current_asmdata.CurrAsmList,OP_SUB,location.size, + right.location.register,left.location.register,location.register, + checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc) + else + // reg64 - const64 + cg.a_op_const_reg_reg_checkoverflow(current_asmdata.CurrAsmList,OP_SUB,location.size, + right.location.value,left.location.register,location.register, + checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc); + end + else + begin + // const64 - reg64 + location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,true); + cg.a_op_reg_reg_reg_checkoverflow(current_asmdata.CurrAsmList,OP_SUB,location.size, + right.location.register,left.location.register,location.register, + checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc); + end; + end; + else + internalerror(2002072803); + end; +{$else cpu64bitalu} + case nodetype of + xorn,orn,andn,addn: + begin + if (right.location.loc = LOC_CONSTANT) then + cg64.a_op64_const_reg_reg_checkoverflow(current_asmdata.CurrAsmList,op,location.size,right.location.value64, + left.location.register64,location.register64, + checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc) + else + cg64.a_op64_reg_reg_reg_checkoverflow(current_asmdata.CurrAsmList,op,location.size,right.location.register64, + left.location.register64,location.register64, + checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc); + end; + subn: + begin + if (nf_swapped in flags) then + swapleftright; + + if left.location.loc <> LOC_CONSTANT then + begin + if right.location.loc <> LOC_CONSTANT then + // reg64 - reg64 + cg64.a_op64_reg_reg_reg_checkoverflow(current_asmdata.CurrAsmList,OP_SUB,location.size, + right.location.register64,left.location.register64, + location.register64, + checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc) + else + // reg64 - const64 + cg64.a_op64_const_reg_reg_checkoverflow(current_asmdata.CurrAsmList,OP_SUB,location.size, + right.location.value64,left.location.register64, + location.register64, + checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc) + end + else + begin + // const64 - reg64 + location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,true); + cg64.a_op64_reg_reg_reg_checkoverflow(current_asmdata.CurrAsmList,OP_SUB,location.size, + right.location.register64,left.location.register64, + location.register64, + checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc); + end; + end; + else + internalerror(2002072803); + end; +{$endif cpu64bitalu} + + { emit overflow check if enabled } + if checkoverflow then + cg.g_overflowcheck_loc(current_asmdata.CurrAsmList,Location,resultdef,ovloc); + end; + + +{***************************************************************************** + Strings +*****************************************************************************} + + procedure tcgaddnode.second_addstring; + begin + { this should already be handled in pass1 } + internalerror(2002072402); + end; + + +{***************************************************************************** + Floats +*****************************************************************************} + + procedure tcgaddnode.second_opfloat; + begin + if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then + second_cmpfloat + else + second_addfloat; + end; + + +{***************************************************************************** + Ordinals +*****************************************************************************} + + procedure tcgaddnode.second_opordinal; + begin + if (nodetype in [ltn,lten,gtn,gten,equaln,unequaln]) then + second_cmpordinal + else + second_addordinal; + end; + + + procedure tcgaddnode.second_addordinal; + var + unsigned, + checkoverflow : boolean; + cgop : topcg; + tmpreg : tregister; + ovloc : tlocation; + begin + ovloc.loc:=LOC_VOID; + + pass_left_right; + force_reg_left_right(false,true); + set_result_location_reg; + + { determine if the comparison will be unsigned } + unsigned:=not(is_signed(left.resultdef)) or + not(is_signed(right.resultdef)); + + { assume no overflow checking is require } + checkoverflow := false; + + case nodetype of + addn: + begin + cgop:=OP_ADD; + checkoverflow:=true; + end; + xorn : + begin + cgop:=OP_XOR; + end; + orn : + begin + cgop:=OP_OR; + end; + andn: + begin + cgop:=OP_AND; + end; + muln: + begin + checkoverflow:=true; + if unsigned then + cgop:=OP_MUL + else + cgop:=OP_IMUL; + end; + subn : + begin + checkoverflow:=true; + cgop:=OP_SUB; + end; + end; + + checkoverflow:= + checkoverflow and + (left.resultdef.typ<>pointerdef) and + (right.resultdef.typ<>pointerdef); + + if nodetype<>subn then + begin + if (right.location.loc<>LOC_CONSTANT) then + cg.a_op_reg_reg_reg_checkoverflow(current_asmdata.CurrAsmList,cgop,location.size, + left.location.register,right.location.register, + location.register,checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc) + else + cg.a_op_const_reg_reg_checkoverflow(current_asmdata.CurrAsmList,cgop,location.size, + right.location.value,left.location.register, + location.register,checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc); + end + else { subtract is a special case since its not commutative } + begin + if (nf_swapped in flags) then + swapleftright; + if left.location.loc<>LOC_CONSTANT then + begin + if right.location.loc<>LOC_CONSTANT then + cg.a_op_reg_reg_reg_checkoverflow(current_asmdata.CurrAsmList,OP_SUB,location.size, + right.location.register,left.location.register, + location.register,checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc) + else + cg.a_op_const_reg_reg_checkoverflow(current_asmdata.CurrAsmList,OP_SUB,location.size, + right.location.value,left.location.register, + location.register,checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc); + end + else + begin + tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,location.size); + cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size, + left.location.value,tmpreg); + cg.a_op_reg_reg_reg_checkoverflow(current_asmdata.CurrAsmList,OP_SUB,location.size, + right.location.register,tmpreg,location.register,checkoverflow and (cs_check_overflow in current_settings.localswitches),ovloc); + end; + end; + + { emit overflow check if required } + if checkoverflow then + cg.g_overflowcheck_loc(current_asmdata.CurrAsmList,Location,resultdef,ovloc); + end; + + + procedure tcgaddnode.second_cmpboolean; + begin + second_cmpordinal; + end; + + +{***************************************************************************** + pass_generate_code; +*****************************************************************************} + + procedure tcgaddnode.pass_generate_code; + begin + case left.resultdef.typ of + orddef : + begin + { handling boolean expressions } + if is_boolean(left.resultdef) and + is_boolean(right.resultdef) then + second_opboolean + { 64bit operations } + else if is_64bit(left.resultdef) then + second_op64bit + else + second_opordinal; + end; + stringdef : + begin + second_addstring; + end; + setdef : + begin + if is_smallset(tsetdef(left.resultdef)) then + second_opsmallset + else + internalerror(200109041); + end; + arraydef : + begin + { support dynarr=nil } + if is_dynamic_array(left.resultdef) then + second_opordinal + else + if (cs_support_vectors in current_settings.globalswitches) and + is_vector(left.resultdef) then + second_opvector +{$ifdef SUPPORT_MMX} + else + if is_mmx_able_array(left.resultdef) then + second_opmmx +{$endif SUPPORT_MMX} + else + internalerror(200306016); + end; + floatdef : + second_opfloat; + else + second_opordinal; + end; + end; + +begin + caddnode:=tcgaddnode; +end. diff --git a/closures/compiler/ncgbas.pas b/closures/compiler/ncgbas.pas new file mode 100644 index 0000000000..a8625aa749 --- /dev/null +++ b/closures/compiler/ncgbas.pas @@ -0,0 +1,558 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + This unit implements some basic 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 ncgbas; + +{$i fpcdefs.inc} + +interface + + uses + cpubase,cgutils, + node,nbas; + + type + tcgnothingnode = class(tnothingnode) + procedure pass_generate_code;override; + end; + + tcgasmnode = class(tasmnode) + procedure pass_generate_code;override; + end; + + tcgstatementnode = class(tstatementnode) + procedure pass_generate_code;override; + end; + + tcgblocknode = class(tblocknode) + procedure pass_generate_code;override; + end; + + tcgtempcreatenode = class(ttempcreatenode) + procedure pass_generate_code;override; + end; + + tcgtemprefnode = class(ttemprefnode) + procedure pass_generate_code;override; + { Changes the location of this temp to ref. Useful when assigning } + { another temp to this one. The current location will be freed. } + { Can only be called in pass 2 (since earlier, the temp location } + { isn't known yet) } + procedure changelocation(const ref: treference); + end; + + tcgtempdeletenode = class(ttempdeletenode) + procedure pass_generate_code;override; + end; + + implementation + + uses + globtype,globals,systems, + cutils,verbose, + aasmbase,aasmtai,aasmdata,aasmcpu, + symsym,symconst,symdef,defutil, + nflw,pass_2,ncgutil, + cgbase,cgobj, + procinfo, + tgobj + ; + +{***************************************************************************** + TNOTHING +*****************************************************************************} + + procedure tcgnothingnode.pass_generate_code; + begin + location_reset(location,LOC_VOID,OS_NO); + + { avoid an abstract rte } + end; + + +{***************************************************************************** + TSTATEMENTNODE +*****************************************************************************} + + procedure tcgstatementnode.pass_generate_code; + var + hp : tstatementnode; + begin + location_reset(location,LOC_VOID,OS_NO); + + hp:=self; + while assigned(hp) do + begin + if assigned(hp.left) then + begin + secondpass(hp.left); + { Compiler inserted blocks can return values } + location_copy(hp.location,hp.left.location); + end; + hp:=tstatementnode(hp.right); + end; + end; + + +{***************************************************************************** + TASMNODE +*****************************************************************************} + + procedure tcgasmnode.pass_generate_code; + + procedure ReLabel(var p:tasmsymbol); + begin + { Only relabel local tasmlabels } + if (p.bind = AB_LOCAL) and + (p is tasmlabel) then + begin + if not assigned(p.altsymbol) then + current_asmdata.GenerateAltSymbol(p); + p:=p.altsymbol; + p.increfs; + end; + end; + + procedure ResolveRef(var op:toper); + var + sym : tabstractnormalvarsym; +{$ifdef x86} + scale : byte; +{$endif x86} + forceref, + getoffset : boolean; + indexreg : tregister; + sofs : longint; + begin + if (op.typ=top_local) then + begin + sofs:=op.localoper^.localsymofs; + indexreg:=op.localoper^.localindexreg; +{$ifdef x86} + scale:=op.localoper^.localscale; +{$endif x86} + getoffset:=op.localoper^.localgetoffset; + forceref:=op.localoper^.localforceref; + sym:=tabstractnormalvarsym(pointer(op.localoper^.localsym)); + dispose(op.localoper); + case sym.localloc.loc of + LOC_REFERENCE : + begin + if getoffset then + begin + if indexreg=NR_NO then + begin + op.typ:=top_const; + op.val:=sym.localloc.reference.offset+sofs; + end + else + begin + op.typ:=top_ref; + new(op.ref); + reference_reset_base(op.ref^,indexreg,sym.localloc.reference.offset+sofs, + newalignment(sym.localloc.reference.alignment,sofs)); + end; + end + else + begin + op.typ:=top_ref; + new(op.ref); + reference_reset_base(op.ref^,sym.localloc.reference.base,sym.localloc.reference.offset+sofs, + newalignment(sym.localloc.reference.alignment,sofs)); + op.ref^.index:=indexreg; +{$ifdef x86} + op.ref^.scalefactor:=scale; +{$endif x86} + end; + end; + LOC_REGISTER : + begin + if getoffset then + Message(asmr_e_invalid_reference_syntax); + { Subscribed access } + if forceref or + (sofs<>0) then + begin + op.typ:=top_ref; + new(op.ref); + { no idea about the actual alignment } + reference_reset_base(op.ref^,sym.localloc.register,sofs,1); + op.ref^.index:=indexreg; +{$ifdef x86} + op.ref^.scalefactor:=scale; +{$endif x86} + end + else + begin + op.typ:=top_reg; + op.reg:=sym.localloc.register; + end; + end; + LOC_MMREGISTER : + begin + if getoffset then + Message(asmr_e_invalid_reference_syntax); + { Subscribed access } + if forceref or (sofs<>0) then + internalerror(201001032) + else + begin + op.typ:=top_reg; + op.reg:=sym.localloc.register; + end; + end; + else + internalerror(201001031); + end; + end; + end; + + var + hp,hp2 : tai; + i : longint; + begin + location_reset(location,LOC_VOID,OS_NO); + + if (nf_get_asm_position in flags) then + begin + { Add a marker, to be sure the list is not empty } + current_asmdata.CurrAsmList.concat(tai_marker.create(mark_Position)); + currenttai:=tai(current_asmdata.CurrAsmList.last); + exit; + end; + + { Allocate registers used in the assembler block } + cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,used_regs_int); + + if (po_inline in current_procinfo.procdef.procoptions) then + begin + hp:=tai(p_asm.first); + while assigned(hp) do + begin + hp2:=tai(hp.getcopy); + case hp2.typ of + ait_label : + ReLabel(tasmsymbol(tai_label(hp2).labsym)); + ait_const : + begin + if assigned(tai_const(hp2).sym) then + ReLabel(tai_const(hp2).sym); + if assigned(tai_const(hp2).endsym) then + ReLabel(tai_const(hp2).endsym); + end; + ait_instruction : + begin + { remove cached insentry, because the new code can + require another less optimized instruction } +{$ifdef i386} +{$ifndef NOAG386BIN} + taicpu(hp2).ResetPass1; +{$endif} +{$endif} + { fixup the references } + for i:=1 to taicpu(hp2).ops do + begin + ResolveRef(taicpu(hp2).oper[i-1]^); + with taicpu(hp2).oper[i-1]^ do + begin + case typ of + top_ref : + begin + if assigned(ref^.symbol) then + ReLabel(ref^.symbol); + if assigned(ref^.relsymbol) then + ReLabel(ref^.relsymbol); + end; + end; + end; + end; +{$ifdef x86} + { can only be checked now that all local operands } + { have been resolved } + taicpu(hp2).CheckIfValid; +{$endif x86} + end; + end; + current_asmdata.CurrAsmList.concat(hp2); + hp:=tai(hp.next); + end; + { restore used symbols } + current_asmdata.ResetAltSymbols; + end + else + begin + hp:=tai(p_asm.first); + while assigned(hp) do + begin + case hp.typ of + ait_instruction : + begin + { remove cached insentry, because the new code can + require another less optimized instruction } +{$ifdef i386} +{$ifndef NOAG386BIN} + taicpu(hp).ResetPass1; +{$endif} +{$endif} + { fixup the references } + for i:=1 to taicpu(hp).ops do + ResolveRef(taicpu(hp).oper[i-1]^); +{$ifdef x86} + { can only be checked now that all local operands } + { have been resolved } + taicpu(hp).CheckIfValid; +{$endif x86} + end; + end; + hp:=tai(hp.next); + end; + { insert the list } + current_asmdata.CurrAsmList.concatlist(p_asm); + end; + + { Release register used in the assembler block } + cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,used_regs_int); + end; + + +{***************************************************************************** + TBLOCKNODE +*****************************************************************************} + + procedure tcgblocknode.pass_generate_code; + var + hp : tstatementnode; + oldexitlabel : tasmlabel; + oldflowcontrol : tflowcontrol; + begin + location_reset(location,LOC_VOID,OS_NO); + + { replace exitlabel? } + if nf_block_with_exit in flags then + begin + oldexitlabel:=current_procinfo.CurrExitLabel; + current_asmdata.getjumplabel(current_procinfo.CurrExitLabel); + oldflowcontrol:=flowcontrol; + { the nested block will not span an exit statement of the parent } + exclude(flowcontrol,fc_exit); + end; + + { do second pass on left node } + if assigned(left) then + begin + hp:=tstatementnode(left); + while assigned(hp) do + begin + if assigned(hp.left) then + begin + secondpass(hp.left); + location_copy(hp.location,hp.left.location); + end; + location_copy(location,hp.location); + hp:=tstatementnode(hp.right); + end; + end; + + { write exitlabel } + if nf_block_with_exit in flags then + begin + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrExitLabel); + current_procinfo.CurrExitLabel:=oldexitlabel; + { the exit statements inside this block are not exit statements } + { out of the parent } + flowcontrol:=oldflowcontrol+(flowcontrol - [fc_exit]); + end; + end; + + +{***************************************************************************** + TTEMPCREATENODE +*****************************************************************************} + + procedure tcgtempcreatenode.pass_generate_code; + begin + location_reset(location,LOC_VOID,OS_NO); + + { if we're secondpassing the same tcgtempcreatenode twice, we have a bug } + if (ti_valid in tempinfo^.flags) then + internalerror(200108222); + + { get a (persistent) temp } + if is_managed_type(tempinfo^.typedef) then + begin + location_reset_ref(tempinfo^.location,LOC_REFERENCE,def_cgsize(tempinfo^.typedef),0); + tg.GetTempTyped(current_asmdata.CurrAsmList,tempinfo^.typedef,tempinfo^.temptype,tempinfo^.location.reference); + { the temp could have been used previously either because the memory location was reused or + because we're in a loop } + cg.g_finalize(current_asmdata.CurrAsmList,tempinfo^.typedef,tempinfo^.location.reference); + end + else if (ti_may_be_in_reg in tempinfo^.flags) then + begin + location_allocate_register(current_asmdata.CurrAsmList,tempinfo^.location,tempinfo^.typedef,tempinfo^.temptype = tt_persistent); + end + else + begin + location_reset_ref(tempinfo^.location,LOC_REFERENCE,def_cgsize(tempinfo^.typedef),0); + tg.GetTemp(current_asmdata.CurrAsmList,size,tempinfo^.typedef.alignment,tempinfo^.temptype,tempinfo^.location.reference); + end; + include(tempinfo^.flags,ti_valid); + if assigned(tempinfo^.tempinitcode) then + include(tempinfo^.flags,ti_executeinitialisation); + end; + + +{***************************************************************************** + TTEMPREFNODE +*****************************************************************************} + + procedure tcgtemprefnode.pass_generate_code; + begin + if ti_executeinitialisation in tempinfo^.flags then + begin + { avoid recursion } + exclude(tempinfo^.flags, ti_executeinitialisation); + secondpass(tempinfo^.tempinitcode); + end; + { check if the temp is valid } + if not(ti_valid in tempinfo^.flags) then + internalerror(200108231); + location:=tempinfo^.location; + case tempinfo^.location.loc of + LOC_REFERENCE: + begin + inc(location.reference.offset,offset); + location.reference.alignment:=newalignment(location.reference.alignment,offset); + { ti_valid should be excluded if it's a normal temp } + end; + LOC_REGISTER, + LOC_FPUREGISTER, + LOC_MMREGISTER : + exclude(tempinfo^.flags,ti_valid); + end; + end; + + + procedure tcgtemprefnode.changelocation(const ref: treference); + begin + { check if the temp is valid } + if not(ti_valid in tempinfo^.flags) then + internalerror(200306081); + if (tempinfo^.location.loc<>LOC_REFERENCE) then + internalerror(2004020203); + if (tempinfo^.temptype = tt_persistent) then + tg.ChangeTempType(current_asmdata.CurrAsmList,tempinfo^.location.reference,tt_normal); + tg.ungettemp(current_asmdata.CurrAsmList,tempinfo^.location.reference); + tempinfo^.location.reference := ref; + tg.ChangeTempType(current_asmdata.CurrAsmList,tempinfo^.location.reference,tempinfo^.temptype); + { adapt location } + location.reference := ref; + inc(location.reference.offset,offset); + location.reference.alignment:=newalignment(location.reference.alignment,offset); + end; + + +{***************************************************************************** + TTEMPDELETENODE +*****************************************************************************} + + procedure tcgtempdeletenode.pass_generate_code; + begin + location_reset(location,LOC_VOID,OS_NO); + + case tempinfo^.location.loc of + LOC_REFERENCE: + begin + if release_to_normal then + tg.ChangeTempType(current_asmdata.CurrAsmList,tempinfo^.location.reference,tt_normal) + else + begin + tg.UnGetTemp(current_asmdata.CurrAsmList,tempinfo^.location.reference); + exclude(tempinfo^.flags,ti_valid); + end; + end; + LOC_CREGISTER, + LOC_REGISTER: + begin + if not(cs_opt_regvar in current_settings.optimizerswitches) or + (pi_has_label in current_procinfo.flags) then + begin + { make sure the register allocator doesn't reuse the } + { register e.g. in the middle of a loop } +{$ifndef cpu64bitalu} + if tempinfo^.location.size in [OS_64,OS_S64] then + begin + cg.a_reg_sync(current_asmdata.CurrAsmList,tempinfo^.location.register64.reghi); + cg.a_reg_sync(current_asmdata.CurrAsmList,tempinfo^.location.register64.reglo); + end + else +{$endif not cpu64bitalu} + cg.a_reg_sync(current_asmdata.CurrAsmList,tempinfo^.location.register); + end; + if release_to_normal then + tempinfo^.location.loc := LOC_REGISTER + else + exclude(tempinfo^.flags,ti_valid); + end; + LOC_CFPUREGISTER, + LOC_FPUREGISTER: + begin + if not(cs_opt_regvar in current_settings.optimizerswitches) or + (pi_has_label in current_procinfo.flags) then + begin + { make sure the register allocator doesn't reuse the } + { register e.g. in the middle of a loop } + cg.a_reg_sync(current_asmdata.CurrAsmList,tempinfo^.location.register); + end; + if release_to_normal then + tempinfo^.location.loc := LOC_FPUREGISTER + else + exclude(tempinfo^.flags,ti_valid); + end; + LOC_CMMREGISTER, + LOC_MMREGISTER: + begin + if not(cs_opt_regvar in current_settings.optimizerswitches) or + (pi_has_label in current_procinfo.flags) then + begin + { make sure the register allocator doesn't reuse the } + { register e.g. in the middle of a loop } + cg.a_reg_sync(current_asmdata.CurrAsmList,tempinfo^.location.register); + end; + if release_to_normal then + tempinfo^.location.loc := LOC_MMREGISTER + else + exclude(tempinfo^.flags,ti_valid); + end; + else + internalerror(200507161); + end; + end; + + +begin + cnothingnode:=tcgnothingnode; + casmnode:=tcgasmnode; + cstatementnode:=tcgstatementnode; + cblocknode:=tcgblocknode; + ctempcreatenode:=tcgtempcreatenode; + ctemprefnode:=tcgtemprefnode; + ctempdeletenode:=tcgtempdeletenode; +end. diff --git a/closures/compiler/ncgcal.pas b/closures/compiler/ncgcal.pas new file mode 100644 index 0000000000..46cf0fb1ea --- /dev/null +++ b/closures/compiler/ncgcal.pas @@ -0,0 +1,976 @@ + { + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate assembler for 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 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 ncgcal; + +{$i fpcdefs.inc} + +interface + + uses + cpubase, + globtype, + parabase,cgutils, + symdef,node,ncal; + + type + tcgcallparanode = class(tcallparanode) + private + tempcgpara : tcgpara; + procedure push_addr_para; + procedure push_value_para; + public + constructor create(expr,next : tnode);override; + destructor destroy;override; + procedure secondcallparan;override; + end; + + tcgcallnode = class(tcallnode) + private + + procedure handle_return_value; + procedure release_unused_return_value; + procedure release_para_temps; + procedure pushparas; + procedure freeparas; + protected + retloc: tcgpara; + + framepointer_paraloc : tcgpara; + {# This routine is used to push the current frame pointer + on the stack. This is used in nested routines where the + value of the frame pointer is always pushed as an extra + parameter. + + The default handling is the standard handling used on + most stack based machines, where the frame pointer is + the first invisible parameter. + } + procedure pop_parasize(pop_size:longint);virtual; + procedure extra_interrupt_code;virtual; + procedure extra_call_code;virtual; + procedure extra_post_call_code;virtual; + procedure do_syscall;virtual;abstract; + + { The function result is returned in a tcgpara. This tcgpara has to + be translated into a tlocation so the rest of the code generator + can work with it. This routine decides what the most appropriate + tlocation is and sets self.location based on that. } + procedure set_result_location(realresdef: tstoreddef);virtual; + public + procedure pass_generate_code;override; + destructor destroy;override; + end; + + +implementation + + uses + systems, + cutils,verbose,globals, + cpuinfo, + symconst,symtable,defutil,paramgr, + cgbase,pass_2, + aasmbase,aasmtai,aasmdata, + nbas,nmem,nld,ncnv,nutils, +{$ifdef x86} + cga,cgx86,aasmcpu, +{$endif x86} + ncgutil, + cgobj,tgobj, + procinfo, + wpobase; + + +{***************************************************************************** + TCGCALLPARANODE +*****************************************************************************} + + constructor tcgcallparanode.create(expr,next : tnode); + begin + inherited create(expr,next); + tempcgpara.init; + end; + + + destructor tcgcallparanode.destroy; + begin + tempcgpara.done; + inherited destroy; + end; + + + procedure tcgcallparanode.push_addr_para; + begin + if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then + internalerror(200304235); + cg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,left.location.reference,tempcgpara); + end; + + + procedure tcgcallparanode.push_value_para; + begin + { we've nothing to push when the size of the parameter is 0 } + if left.resultdef.size=0 then + exit; + + { Move flags and jump in register to make it less complex } + if left.location.loc in [LOC_FLAGS,LOC_JUMP,LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF] then + location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),false); + + { load the parameter's tlocation into its cgpara } + gen_load_loc_cgpara(current_asmdata.CurrAsmList,left.resultdef,left.location,tempcgpara) + end; + + + procedure tcgcallparanode.secondcallparan; + var + href : treference; + otlabel, + oflabel : tasmlabel; + begin + if not(assigned(parasym)) then + internalerror(200304242); + + { Skip nothingn nodes which are used after disabling + a parameter } + if (left.nodetype<>nothingn) then + begin + otlabel:=current_procinfo.CurrTrueLabel; + oflabel:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + secondpass(left); + + maybechangeloadnodereg(current_asmdata.CurrAsmList,left,true); + + { release memory for refcnt out parameters } + if (parasym.varspez=vs_out) and + is_managed_type(left.resultdef) then + begin + location_get_data_ref(current_asmdata.CurrAsmList,left.location,href,false,sizeof(pint)); + if is_open_array(resultdef) then + begin + { if elementdef is not managed, omit fpc_decref_array + because it won't do anything anyway } + if is_managed_type(tarraydef(resultdef).elementdef) then + begin + if third=nil then + InternalError(201103063); + secondpass(third); + cg.g_array_rtti_helper(current_asmdata.CurrAsmList,tarraydef(resultdef).elementdef, + href,third.location,'FPC_FINALIZE_ARRAY'); + end; + end + else + cg.g_finalize(current_asmdata.CurrAsmList,left.resultdef,href) + end; + + paramanager.createtempparaloc(current_asmdata.CurrAsmList,aktcallnode.procdefinition.proccalloption,parasym,not followed_by_stack_tainting_call_cached,tempcgpara); + + { handle varargs first, because parasym is not valid } + if (cpf_varargs_para in callparaflags) then + begin + if paramanager.push_addr_param(vs_value,left.resultdef, + aktcallnode.procdefinition.proccalloption) then + push_addr_para + else + push_value_para; + end + { hidden parameters } + else if (vo_is_hidden_para in parasym.varoptions) then + begin + { don't push a node that already generated a pointer type + by address for implicit hidden parameters } + if (vo_is_funcret in parasym.varoptions) or + { pass "this" in C++ classes explicitly as pointer + because push_addr_param might not be true for them } + (is_cppclass(parasym.vardef) and (vo_is_self in parasym.varoptions)) or + (not(left.resultdef.typ in [pointerdef,classrefdef]) and + paramanager.push_addr_param(parasym.varspez,parasym.vardef, + aktcallnode.procdefinition.proccalloption)) then + push_addr_para + else + push_value_para; + end + { formal def } + else if (parasym.vardef.typ=formaldef) then + begin + { allow passing of a constant to a const formaldef } + if (parasym.varspez=vs_const) and + (left.location.loc in [LOC_CONSTANT,LOC_REGISTER]) then + location_force_mem(current_asmdata.CurrAsmList,left.location); + push_addr_para; + end + { Normal parameter } + else + begin + { don't push a node that already generated a pointer type + by address for implicit hidden parameters } + if (not( + (vo_is_hidden_para in parasym.varoptions) and + (left.resultdef.typ in [pointerdef,classrefdef]) + ) and + paramanager.push_addr_param(parasym.varspez,parasym.vardef, + aktcallnode.procdefinition.proccalloption)) and + { dyn. arrays passed to an array of const must be passed by value, see tests/webtbs/tw4219.pp } + not( + is_array_of_const(parasym.vardef) and + is_dynamic_array(left.resultdef) + ) then + begin + { Passing a var parameter to a var parameter, we can + just push the address transparently } + if (left.nodetype=loadn) and + (tloadnode(left).is_addr_param_load) then + begin + if (left.location.reference.index<>NR_NO) or + (left.location.reference.offset<>0) then + internalerror(200410107); + cg.a_load_reg_cgpara(current_asmdata.CurrAsmList,OS_ADDR,left.location.reference.base,tempcgpara) + end + else + begin + { Force to be in memory } + if not(left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then + location_force_mem(current_asmdata.CurrAsmList,left.location); + push_addr_para; + end; + end + else + push_value_para; + end; + current_procinfo.CurrTrueLabel:=otlabel; + current_procinfo.CurrFalseLabel:=oflabel; + + { update return location in callnode when this is the function + result } + if assigned(parasym) and + (vo_is_funcret in parasym.varoptions) then + location_copy(aktcallnode.location,left.location); + end; + + { next parameter } + if assigned(right) then + tcallparanode(right).secondcallparan; + end; + + +{***************************************************************************** + TCGCALLNODE +*****************************************************************************} + +{$if first_mm_imreg = 0} + {$WARN 4044 OFF} { Comparison might be always false ... } +{$endif} + + procedure tcgcallnode.extra_interrupt_code; + begin + end; + + + procedure tcgcallnode.extra_call_code; + begin + end; + + + procedure tcgcallnode.extra_post_call_code; + begin + end; + + + procedure tcgcallnode.set_result_location(realresdef: tstoreddef); + begin + if realresdef.is_intregable or + realresdef.is_fpuregable or + { avoid temporarily storing pointer-sized entities that can't be + regvars, such as reference-counted pointers, to memory -- + no exception can occur right now (except in case of existing + memory corruption), and we'd store them to a regular temp + anyway and that is not safer than keeping them in a register } + ((realresdef.size=sizeof(aint)) and + (retloc.location^.loc=LOC_REGISTER) and + not assigned(retloc.location^.next)) then + location_allocate_register(current_asmdata.CurrAsmList,location,realresdef,false) + else + begin + location_reset_ref(location,LOC_REFERENCE,def_cgsize(realresdef),0); + tg.GetTemp(current_asmdata.CurrAsmList,retloc.intsize,retloc.Alignment,tt_normal,location.reference); + end; + end; + + + procedure tcgcallnode.pop_parasize(pop_size:longint); + begin + end; + + + procedure tcgcallnode.handle_return_value; + var + realresdef: tstoreddef; + begin + { Check that the return location is set when the result is passed in + a parameter } + if (procdefinition.proctypeoption<>potype_constructor) and + paramanager.ret_in_param(resultdef,procdefinition.proccalloption) then + begin + { self.location is set near the end of secondcallparan so it + refers to the implicit result parameter } + if location.loc<>LOC_REFERENCE then + internalerror(200304241); + exit; + end; + + if not assigned(typedef) then + realresdef:=tstoreddef(resultdef) + else + realresdef:=tstoreddef(typedef); + +{$ifdef x86} + if (retloc.location^.loc=LOC_FPUREGISTER) then + begin + tcgx86(cg).inc_fpu_stack; + location_reset(location,LOC_FPUREGISTER,retloc.location^.size); + location.register:=retloc.location^.register; + end + else +{$endif x86} + begin + { get a tlocation that can hold the return value that's currently in + the the return value's tcgpara } + set_result_location(realresdef); + + { Do not move the physical register to a virtual one in case + the return value is not used, because if the virtual one is + then mapped to the same register as the physical one, we will + end up with two deallocs of this register (one inserted here, + one inserted by the register allocator), which unbalances the + register allocation information. The return register(s) will + be freed by location_free() in release_unused_return_value + (mantis #13536). } + if (cnf_return_value_used in callnodeflags) or + assigned(funcretnode) then + begin + gen_load_cgpara_loc(current_asmdata.CurrAsmList,realresdef,retloc,location,false); +{$ifdef arm} + if (resultdef.typ=floatdef) and + (location.loc=LOC_REGISTER) and + (current_settings.fputype in [fpu_fpa,fpu_fpa10,fpu_fpa11]) then + begin + location_force_mem(current_asmdata.CurrAsmList,location); + end; +{$endif arm} + end; + end; + + { copy value to the final location if this was already provided to the + callnode. This must be done after the call node, because the location can + also be used as parameter and may not be finalized yet } + if assigned(funcretnode) then + begin + funcretnode.pass_generate_code; + { Decrease refcount for refcounted types, this can be skipped when + we have used a temp, because then it is already done from tempcreatenode. + Also no finalize is needed, because there is no risk of exceptions from the + function since this is code is only executed after the function call has returned } + if is_managed_type(funcretnode.resultdef) and + (funcretnode.nodetype<>temprefn) then + cg.g_finalize(current_asmdata.CurrAsmList,funcretnode.resultdef,funcretnode.location.reference); + + case location.loc of + LOC_REGISTER : + begin +{$ifndef cpu64bitalu} + if location.size in [OS_64,OS_S64] then + cg64.a_load64_reg_loc(current_asmdata.CurrAsmList,location.register64,funcretnode.location) + else +{$endif} + cg.a_load_reg_loc(current_asmdata.CurrAsmList,location.size,location.register,funcretnode.location); + location_free(current_asmdata.CurrAsmList,location); + end; + LOC_REFERENCE: + begin + case funcretnode.location.loc of + LOC_REGISTER: + cg.a_load_ref_reg(current_asmdata.CurrAsmList,location.size,location.size,location.reference,funcretnode.location.register); + LOC_REFERENCE: + cg.g_concatcopy(current_asmdata.CurrAsmList,location.reference,funcretnode.location.reference,resultdef.size); + else + internalerror(200802121); + end; + location_freetemp(current_asmdata.CurrAsmList,location); + end; + else + internalerror(200709085); + end; + location := funcretnode.location; + end; + end; + + + procedure tcgcallnode.release_unused_return_value; + begin + { When the result is not used we need to finalize the result and + can release the temp. This need to be after the callcleanupblock + tree is generated, because that converts the temp from persistent to normal } + if not(cnf_return_value_used in callnodeflags) then + begin + case location.loc of + LOC_REFERENCE : + begin + if is_managed_type(resultdef) then + cg.g_finalize(current_asmdata.CurrAsmList,resultdef,location.reference); + tg.ungetiftemp(current_asmdata.CurrAsmList,location.reference); + end; +{$ifdef x86} + LOC_FPUREGISTER : + begin + { release FPU stack } + emit_reg(A_FSTP,S_NO,NR_FPU_RESULT_REG); + tcgx86(cg).dec_fpu_stack; + end; +{$endif x86} + end; + if (retloc.intsize<>0) then + paramanager.freecgpara(current_asmdata.CurrAsmList,retloc); + location_reset(location,LOC_VOID,OS_NO); + end; + end; + + + procedure tcgcallnode.release_para_temps; + var + hp, + hp2 : tnode; + ppn : tcallparanode; + begin + { Release temps from parameters } + ppn:=tcallparanode(left); + while assigned(ppn) do + begin + if assigned(ppn.left) then + begin + { don't release the funcret temp } + if not(assigned(ppn.parasym)) or + not(vo_is_funcret in ppn.parasym.varoptions) then + location_freetemp(current_asmdata.CurrAsmList,ppn.left.location); + { process also all nodes of an array of const } + hp:=ppn.left; + while (hp.nodetype=typeconvn) do + hp:=ttypeconvnode(hp).left; + if (hp.nodetype=arrayconstructorn) and + assigned(tarrayconstructornode(hp).left) then + begin + while assigned(hp) do + begin + hp2:=tarrayconstructornode(hp).left; + { ignore typeconvs and addrn inserted by arrayconstructn for + passing a shortstring } + if (hp2.nodetype=typeconvn) and + (tunarynode(hp2).left.nodetype=addrn) then + hp2:=tunarynode(tunarynode(hp2).left).left; + location_freetemp(current_asmdata.CurrAsmList,hp2.location); + hp:=tarrayconstructornode(hp).right; + end; + end; + end; + ppn:=tcallparanode(ppn.right); + end; + end; + + + procedure tcgcallnode.pushparas; + var + ppn : tcgcallparanode; + callerparaloc, + tmpparaloc : pcgparalocation; + sizeleft: aint; + htempref, + href : treference; + calleralignment, + tmpalignment: longint; + skipiffinalloc: boolean; + begin + { copy all resources to the allocated registers } + ppn:=tcgcallparanode(left); + while assigned(ppn) do + begin + if (ppn.left.nodetype<>nothingn) then + begin + { better check for the real location of the parameter here, when stack passed parameters + are saved temporary in registers, checking for the tmpparaloc.loc is wrong + } + paramanager.freecgpara(current_asmdata.CurrAsmList,ppn.tempcgpara); + tmpparaloc:=ppn.tempcgpara.location; + sizeleft:=ppn.tempcgpara.intsize; + calleralignment:=ppn.parasym.paraloc[callerside].alignment; + tmpalignment:=ppn.tempcgpara.alignment; + if (tmpalignment=0) or + (calleralignment=0) then + internalerror(2009020701); + callerparaloc:=ppn.parasym.paraloc[callerside].location; + skipiffinalloc:= + not paramanager.use_fixed_stack or + not(ppn.followed_by_stack_tainting_call_cached); + while assigned(callerparaloc) do + begin + { Every paraloc must have a matching tmpparaloc } + if not assigned(tmpparaloc) then + internalerror(200408224); + if callerparaloc^.size<>tmpparaloc^.size then + internalerror(200408225); + case callerparaloc^.loc of + LOC_REGISTER: + begin + if tmpparaloc^.loc<>LOC_REGISTER then + internalerror(200408221); + if getsupreg(callerparaloc^.register)<first_int_imreg then + cg.getcpuregister(current_asmdata.CurrAsmList,callerparaloc^.register); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size, + tmpparaloc^.register,callerparaloc^.register); + end; + LOC_FPUREGISTER: + begin + if tmpparaloc^.loc<>LOC_FPUREGISTER then + internalerror(200408222); + if getsupreg(callerparaloc^.register)<first_fpu_imreg then + cg.getcpuregister(current_asmdata.CurrAsmList,callerparaloc^.register); + cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,tmpparaloc^.size,ppn.tempcgpara.size,tmpparaloc^.register,callerparaloc^.register); + end; + LOC_MMREGISTER: + begin + if tmpparaloc^.loc<>LOC_MMREGISTER then + internalerror(200408223); + if getsupreg(callerparaloc^.register)<first_mm_imreg then + cg.getcpuregister(current_asmdata.CurrAsmList,callerparaloc^.register); + cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size, + tmpparaloc^.register,callerparaloc^.register,mms_movescalar); + end; + LOC_REFERENCE: + begin + if not(skipiffinalloc and + paramanager.is_stack_paraloc(callerparaloc)) then + begin + { Can't have a data copied to the stack, every location + must contain a valid size field } + + if (tmpparaloc^.size=OS_NO) and + ((tmpparaloc^.loc<>LOC_REFERENCE) or + assigned(tmpparaloc^.next)) then + internalerror(200501281); + reference_reset_base(href,callerparaloc^.reference.index,callerparaloc^.reference.offset,calleralignment); + { copy parameters in case they were moved to a temp. location because we've a fixed stack } + case tmpparaloc^.loc of + LOC_REFERENCE: + begin + reference_reset_base(htempref,tmpparaloc^.reference.index,tmpparaloc^.reference.offset,tmpalignment); + { use concatcopy, because it can also be a float which fails when + load_ref_ref is used } + if (ppn.tempcgpara.size <> OS_NO) then + cg.g_concatcopy(current_asmdata.CurrAsmList,htempref,href,tcgsize2size[tmpparaloc^.size]) + else + cg.g_concatcopy(current_asmdata.CurrAsmList,htempref,href,sizeleft) + end; + LOC_REGISTER: + cg.a_load_reg_ref(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,href); + LOC_FPUREGISTER: + cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,href); + LOC_MMREGISTER: + cg.a_loadmm_reg_ref(current_asmdata.CurrAsmList,tmpparaloc^.size,tmpparaloc^.size,tmpparaloc^.register,href,mms_movescalar); + else + internalerror(200402081); + end; + end; + end; + end; + dec(sizeleft,tcgsize2size[tmpparaloc^.size]); + callerparaloc:=callerparaloc^.next; + tmpparaloc:=tmpparaloc^.next; + end; + end; + ppn:=tcgcallparanode(ppn.right); + end; + end; + + + procedure tcgcallnode.freeparas; + var + ppn : tcgcallparanode; + begin + { free the resources allocated for the parameters } + ppn:=tcgcallparanode(left); + while assigned(ppn) do + begin + if (ppn.left.nodetype<>nothingn) then + begin + if (ppn.parasym.paraloc[callerside].location^.loc <> LOC_REFERENCE) then + paramanager.freecgpara(current_asmdata.CurrAsmList,ppn.parasym.paraloc[callerside]); + end; + ppn:=tcgcallparanode(ppn.right); + end; + end; + + + + procedure tcgcallnode.pass_generate_code; + var + name_to_call: shortstring; + regs_to_save_int, + regs_to_save_fpu, + regs_to_save_mm : Tcpuregisterset; + href : treference; + pop_size : longint; + vmtoffset : aint; + pvreg, + vmtreg : tregister; + oldaktcallnode : tcallnode; + retlocitem: pcgparalocation; +{$ifdef vtentry} + sym : tasmsymbol; +{$endif vtentry} +{$ifdef x86_64} + cgpara : tcgpara; +{$endif x86_64} + begin + if not assigned(procdefinition) or + not(procdefinition.has_paraloc_info in [callerside,callbothsides]) then + internalerror(200305264); + + if assigned(callinitblock) then + secondpass(tnode(callinitblock)); + + regs_to_save_int:=paramanager.get_volatile_registers_int(procdefinition.proccalloption); + regs_to_save_fpu:=paramanager.get_volatile_registers_fpu(procdefinition.proccalloption); + regs_to_save_mm:=paramanager.get_volatile_registers_mm(procdefinition.proccalloption); + + { Include Function result registers } + if (not is_void(resultdef)) then + begin + { The forced returntype may have a different size than the one + declared for the procdef } + if not assigned(typedef) then + retloc:=procdefinition.funcretloc[callerside] + else + retloc:=paramanager.get_funcretloc(procdefinition,callerside,typedef); + retlocitem:=retloc.location; + while assigned(retlocitem) do + begin + case retlocitem^.loc of + LOC_REGISTER: + include(regs_to_save_int,getsupreg(retlocitem^.register)); + LOC_FPUREGISTER: + include(regs_to_save_fpu,getsupreg(retlocitem^.register)); + LOC_MMREGISTER: + include(regs_to_save_mm,getsupreg(retlocitem^.register)); + LOC_REFERENCE, + LOC_VOID: + ; + else + internalerror(2004110213); + end; + retlocitem:=retlocitem^.next; + end; + end; + + { Process parameters, register parameters will be loaded + in imaginary registers. The actual load to the correct + register is done just before the call } + oldaktcallnode:=aktcallnode; + aktcallnode:=self; + if assigned(left) then + tcallparanode(left).secondcallparan; + aktcallnode:=oldaktcallnode; + + { procedure variable or normal function call ? } + if (right=nil) then + begin + { register call for WPO (must be done before wpo test below, + otherwise optimised called methods are no longer registered) + } + if (po_virtualmethod in procdefinition.procoptions) and + not is_objectpascal_helper(tprocdef(procdefinition).struct) and + assigned(methodpointer) and + (methodpointer.nodetype<>typen) and + (not assigned(current_procinfo) or + wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname)) then + tobjectdef(tprocdef(procdefinition).struct).register_vmt_call(tprocdef(procdefinition).extnumber); +{$ifdef vtentry} + if not is_interface(tprocdef(procdefinition)._class) then + begin + inc(current_asmdata.NextVTEntryNr); + current_asmdata.CurrAsmList.Concat(tai_symbol.CreateName('VTREF'+tostr(current_asmdata.NextVTEntryNr)+'_'+tprocdef(procdefinition).struct.vmt_mangledname+'$$'+tostr(vmtoffset div sizeof(pint)),AT_FUNCTION,0)); + end; +{$endif vtentry} + + name_to_call:=''; + if assigned(fobjcforcedprocname) then + name_to_call:=fobjcforcedprocname^; + { When methodpointer is typen we don't need (and can't) load + a pointer. We can directly call the correct procdef (PFV) } + if (name_to_call='') and + (po_virtualmethod in procdefinition.procoptions) and + not is_objectpascal_helper(tprocdef(procdefinition).struct) and + assigned(methodpointer) and + (methodpointer.nodetype<>typen) and + not wpoinfomanager.can_be_devirtualized(methodpointer.resultdef,procdefinition,name_to_call) then + begin + { virtual methods require an index } + if tprocdef(procdefinition).extnumber=$ffff then + internalerror(200304021); + + secondpass(methodpointer); + + { Load VMT from self } + if methodpointer.resultdef.typ=objectdef then + gen_load_vmt_register(current_asmdata.CurrAsmList,tobjectdef(methodpointer.resultdef),methodpointer.location,vmtreg) + else + begin + { Load VMT value in register } + location_force_reg(current_asmdata.CurrAsmList,methodpointer.location,OS_ADDR,false); + vmtreg:=methodpointer.location.register; + end; + + { test validity of VMT } + if not(is_interface(tprocdef(procdefinition).struct)) and + not(is_cppclass(tprocdef(procdefinition).struct)) then + cg.g_maybe_testvmt(current_asmdata.CurrAsmList,vmtreg,tobjectdef(tprocdef(procdefinition).struct)); + + { Call through VMT, generate a VTREF symbol to notify the linker } + vmtoffset:=tobjectdef(tprocdef(procdefinition).struct).vmtmethodoffset(tprocdef(procdefinition).extnumber); + { register call for WPO } + if (not assigned(current_procinfo) or + wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname)) then + tobjectdef(tprocdef(procdefinition).struct).register_vmt_call(tprocdef(procdefinition).extnumber); +{$ifndef x86} + pvreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR); +{$endif not x86} + reference_reset_base(href,vmtreg,vmtoffset,sizeof(pint)); +{$ifndef x86} + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,pvreg); +{$endif not x86} + + { Load parameters that are in temporary registers in the + correct parameter register } + if assigned(left) then + begin + pushparas; + { free the resources allocated for the parameters } + freeparas; + end; + + cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int); + if cg.uses_registers(R_FPUREGISTER) then + cg.alloccpuregisters(current_asmdata.CurrAsmList,R_FPUREGISTER,regs_to_save_fpu); + if cg.uses_registers(R_MMREGISTER) then + cg.alloccpuregisters(current_asmdata.CurrAsmList,R_MMREGISTER,regs_to_save_mm); + + { call method } + extra_call_code; +{$ifdef x86} + cg.a_call_ref(current_asmdata.CurrAsmList,href); +{$else x86} + cg.a_call_reg(current_asmdata.CurrAsmList,pvreg); +{$endif x86} + extra_post_call_code; + end + else + begin + { Load parameters that are in temporary registers in the + correct parameter register } + if assigned(left) then + begin + pushparas; + { free the resources allocated for the parameters } + freeparas; + end; + + cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int); + if cg.uses_registers(R_FPUREGISTER) then + cg.alloccpuregisters(current_asmdata.CurrAsmList,R_FPUREGISTER,regs_to_save_fpu); + if cg.uses_registers(R_MMREGISTER) then + cg.alloccpuregisters(current_asmdata.CurrAsmList,R_MMREGISTER,regs_to_save_mm); + + if procdefinition.proccalloption=pocall_syscall then + do_syscall + else + begin + { Calling interrupt from the same code requires some + extra code } + if (po_interrupt in procdefinition.procoptions) then + extra_interrupt_code; + extra_call_code; + if (name_to_call='') then + cg.a_call_name(current_asmdata.CurrAsmList,tprocdef(procdefinition).mangledname,po_weakexternal in procdefinition.procoptions) + else + cg.a_call_name(current_asmdata.CurrAsmList,name_to_call,po_weakexternal in procdefinition.procoptions); + extra_post_call_code; + end; + end; + end + else + { now procedure variable case } + begin + secondpass(right); + + pvreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR); + { Only load OS_ADDR from the reference } + if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,right.location.reference,pvreg) + else + cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_ADDR,right.location,pvreg); + location_freetemp(current_asmdata.CurrAsmList,right.location); + + { Load parameters that are in temporary registers in the + correct parameter register } + if assigned(left) then + begin + pushparas; + { free the resources allocated for the parameters } + freeparas; + end; + + cg.alloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int); + if cg.uses_registers(R_FPUREGISTER) then + cg.alloccpuregisters(current_asmdata.CurrAsmList,R_FPUREGISTER,regs_to_save_fpu); + if cg.uses_registers(R_MMREGISTER) then + cg.alloccpuregisters(current_asmdata.CurrAsmList,R_MMREGISTER,regs_to_save_mm); + + { Calling interrupt from the same code requires some + extra code } + if (po_interrupt in procdefinition.procoptions) then + extra_interrupt_code; + extra_call_code; + cg.a_call_reg(current_asmdata.CurrAsmList,pvreg); + extra_post_call_code; + end; + + { Need to remove the parameters from the stack? } + if (procdefinition.proccalloption in clearstack_pocalls) then + begin + pop_size:=pushedparasize; + { for Cdecl functions we don't need to pop the funcret when it + was pushed by para. Except for safecall functions with + safecall-exceptions enabled. In that case the funcret is always + returned as a para which is considered a normal para on the + c-side, so the funcret has to be pop'ed normally. } + if not ((procdefinition.proccalloption=pocall_safecall) and + (tf_safecall_exceptions in target_info.flags)) and + paramanager.ret_in_param(procdefinition.returndef,procdefinition.proccalloption) then + dec(pop_size,sizeof(pint)); + { Remove parameters/alignment from the stack } + pop_parasize(pop_size); + end + { frame pointer parameter is popped by the caller when it's passed the + Delphi way } + else if (po_delphi_nested_cc in procdefinition.procoptions) and + not paramanager.use_fixed_stack then + pop_parasize(sizeof(pint)); + { Release registers, but not the registers that contain the + function result } + if (not is_void(resultdef)) then + begin + retlocitem:=retloc.location; + while assigned(retlocitem) do + begin + case retlocitem^.loc of + LOC_REGISTER: + exclude(regs_to_save_int,getsupreg(retlocitem^.register)); + LOC_FPUREGISTER: + exclude(regs_to_save_fpu,getsupreg(retlocitem^.register)); + LOC_MMREGISTER: + exclude(regs_to_save_mm,getsupreg(retlocitem^.register)); + LOC_REFERENCE, + LOC_VOID: + ; + else + internalerror(2004110214); + end; + retlocitem:=retlocitem^.next; + end; + end; + +{$if defined(x86) or defined(arm)} + if (procdefinition.proccalloption=pocall_safecall) and + (tf_safecall_exceptions in target_info.flags) then + begin +{$ifdef x86_64} + cgpara.init; + paramanager.getintparaloc(pocall_default,1,cgpara); + cg.a_load_reg_cgpara(current_asmdata.CurrAsmList,OS_ADDR,NR_RAX,cgpara); + cgpara.done; +{$endif x86_64} + cg.allocallcpuregisters(current_asmdata.CurrAsmList); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_SAFECALLCHECK',false); + cg.deallocallcpuregisters(current_asmdata.CurrAsmList); + end; +{$endif} + + if cg.uses_registers(R_MMREGISTER) then + cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_MMREGISTER,regs_to_save_mm); + if cg.uses_registers(R_FPUREGISTER) then + cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_FPUREGISTER,regs_to_save_fpu); + cg.dealloccpuregisters(current_asmdata.CurrAsmList,R_INTREGISTER,regs_to_save_int); + + { handle function results } + if (not is_void(resultdef)) then + handle_return_value + else + location_reset(location,LOC_VOID,OS_NO); + + { convert persistent temps for parameters and function result to normal temps } + if assigned(callcleanupblock) then + secondpass(tnode(callcleanupblock)); + + { release temps and finalize unused return values, must be + after the callcleanupblock because that converts temps + from persistent to normal } + release_unused_return_value; + + { release temps of paras } + release_para_temps; + + { perhaps i/o check ? } + if (cs_check_io in current_settings.localswitches) and + (po_iocheck in procdefinition.procoptions) and + not(po_iocheck in current_procinfo.procdef.procoptions) and + { no IO check for methods and procedure variables } + (right=nil) and + not(po_virtualmethod in procdefinition.procoptions) then + begin + cg.allocallcpuregisters(current_asmdata.CurrAsmList); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_IOCHECK',false); + cg.deallocallcpuregisters(current_asmdata.CurrAsmList); + end; + end; + + + destructor tcgcallnode.destroy; + begin + if assigned(typedef) then + retloc.done; + inherited destroy; + end; + + +begin + ccallparanode:=tcgcallparanode; + ccallnode:=tcgcallnode; +end. diff --git a/closures/compiler/ncgcnv.pas b/closures/compiler/ncgcnv.pas new file mode 100644 index 0000000000..ad20c667a1 --- /dev/null +++ b/closures/compiler/ncgcnv.pas @@ -0,0 +1,760 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + Generate assembler for nodes that handle type conversions which are + the same for all (most) 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. + + **************************************************************************** +} +unit ncgcnv; + +{$i fpcdefs.inc} + +interface + + uses + node,ncnv,defutil,defcmp; + + type + + { tcgtypeconvnode } + + tcgtypeconvnode = class(ttypeconvnode) + protected +{$ifdef cpuflags} + { CPUs without flags need a specific implementation of int -> bool } + procedure second_int_to_bool;override; +{$endif cpuflags} + procedure second_int_to_int;override; + procedure second_cstring_to_pchar;override; + procedure second_cstring_to_int;override; + procedure second_string_to_chararray;override; + procedure second_array_to_pointer;override; + procedure second_pointer_to_array;override; + procedure second_char_to_string;override; + procedure second_real_to_real;override; + procedure second_cord_to_pointer;override; + procedure second_proc_to_procvar;override; + procedure second_nil_to_methodprocvar;override; + procedure second_bool_to_int;override; + procedure second_bool_to_bool;override; + procedure second_ansistring_to_pchar;override; + procedure second_class_to_intf;override; + procedure second_char_to_char;override; + procedure second_nothing;override; + public + procedure pass_generate_code;override; + end; + + tcgasnode = class(tasnode) + procedure pass_generate_code;override; + end; + + implementation + + uses + cutils,verbose,globtype,globals, + aasmbase,aasmtai,aasmdata,aasmcpu,symconst,symdef,paramgr, + nutils,ncon,ncal, + cpubase,systems, + procinfo,pass_2, + cgbase, + cgutils,cgobj, + ncgutil, + tgobj + ; + + + procedure tcgtypeconvnode.second_int_to_int; + var + orgsize, + newsize : tcgsize; + ressize, + leftsize : longint; + begin + newsize:=def_cgsize(resultdef); + + { insert range check if not explicit conversion } + if not(nf_explicit in flags) then + cg.g_rangecheck(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef); + + { is the result size smaller? when typecasting from void + we always reuse the current location, because there is + nothing that we can load in a register } + ressize := resultdef.size; + leftsize := left.resultdef.size; + if ((ressize<>leftsize) or + is_bitpacked_access(left)) and + not is_void(left.resultdef) then + begin + location_copy(location,left.location); + { reuse a loc_reference when the newsize is smaller than + than the original, else load it to a register } + if (location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and + (ressize<leftsize) then + begin + location.size:=newsize; + if (target_info.endian = ENDIAN_BIG) then + begin + inc(location.reference.offset,leftsize-ressize); + location.reference.alignment:=newalignment(location.reference.alignment,leftsize-ressize); + end; + end + else + location_force_reg(current_asmdata.CurrAsmList,location,newsize,false); + end + else + begin + { no special loading is required, reuse current location } + + { that's not true, if you go from signed to unsiged or } + { vice versa, you need sign extension/removal if the } + { value is already in a register (at least for archs } + { which don't have 8bit register components etc) (JM) } + location_copy(location,left.location); + location.size:=newsize; + orgsize := def_cgsize(left.resultdef); + if (ressize < sizeof(aint)) and + (location.loc in [LOC_REGISTER,LOC_CREGISTER]) and + (orgsize <> newsize) then + begin + location.register := cg.getintregister(current_asmdata.CurrAsmList,newsize); + location.loc := LOC_REGISTER; + cg.a_load_reg_reg(current_asmdata.CurrAsmList,orgsize,newsize,left.location.register,location.register); + end; + end; + end; + + +{$ifdef cpuflags} + procedure tcgtypeconvnode.second_int_to_bool; + var + hregister : tregister; + href : treference; + resflags : tresflags; + hlabel,oldTrueLabel,oldFalseLabel : tasmlabel; + newsize : tcgsize; + begin + oldTrueLabel:=current_procinfo.CurrTrueLabel; + oldFalseLabel:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + secondpass(left); + if codegenerror then + exit; + + { Explicit typecasts from any ordinal type to a boolean type } + { must not change the ordinal value } + if (nf_explicit in flags) and + not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then + begin + location_copy(location,left.location); + newsize:=def_cgsize(resultdef); + { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend } + if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or + ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then + location_force_reg(current_asmdata.CurrAsmList,location,newsize,true) + else + location.size:=newsize; + current_procinfo.CurrTrueLabel:=oldTrueLabel; + current_procinfo.CurrFalseLabel:=oldFalseLabel; + exit; + end; + { though ppc/ppc64 doesn't use the generic code, we need to ifdef here + because the code is included into the powerpc compilers } +{$if defined(POWERPC) or defined(POWERPC64)} + resflags.cr := RS_CR0; + resflags.flag:=F_NE; +{$else defined(POWERPC) or defined(POWERPC64)} + { Load left node into flag F_NE/F_E } + resflags:=F_NE; +{$endif defined(POWERPC) or defined(POWERPC64)} + case left.location.loc of + LOC_CREFERENCE, + LOC_REFERENCE : + begin + if left.location.size in [OS_64,OS_S64] then + begin + hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.reference,hregister); + href:=left.location.reference; + inc(href.offset,4); + cg.a_op_ref_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,href,hregister); + end + else + begin + location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,true); + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,left.location.size,left.location.register,left.location.register); + end; + end; + LOC_FLAGS : + begin + resflags:=left.location.resflags; + end; + LOC_REGISTER,LOC_CREGISTER : + begin +{$ifndef cpu64bitalu} + if left.location.size in [OS_64,OS_S64] then + begin + hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.register64.reglo,hregister); + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,left.location.register64.reghi,hregister); + end + else +{$endif cpu64bitalu} + begin + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,left.location.size,left.location.register,left.location.register); + end; + end; + LOC_JUMP : + begin + hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + current_asmdata.getjumplabel(hlabel); + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hregister); + cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel); + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hregister); + cg.a_label(current_asmdata.CurrAsmList,hlabel); + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_INT,hregister,hregister); + end; + else + internalerror(200311301); + end; + { load flags to register } + location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); + location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size); + cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,location.register); + if (is_cbool(resultdef)) then + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,location.register,location.register); + current_procinfo.CurrTrueLabel:=oldTrueLabel; + current_procinfo.CurrFalseLabel:=oldFalseLabel; + end; +{$endif cpuflags} + + + procedure tcgtypeconvnode.second_cstring_to_pchar; + + var + hr : treference; + + begin + if left.nodetype<>stringconstn then + internalerror(200601131); + location_reset(location,LOC_REGISTER,OS_ADDR); + case tstringconstnode(left).cst_type of + cst_conststring : + begin + location.register:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,location.register); + end; + cst_shortstring : + begin + inc(left.location.reference.offset); + location.reference.alignment:=1; + location.register:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,location.register); + end; + cst_widestring, + cst_unicodestring, + cst_ansistring : + begin + if tstringconstnode(left).len=0 then + begin + { FPC_EMPTYCHAR is a widechar -> 2 bytes } + reference_reset(hr,2); + hr.symbol:=current_asmdata.RefAsmSymbol('FPC_EMPTYCHAR'); + location.register:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,hr,location.register); + end + else + begin + location_copy(location,left.location); + end; + end; + cst_longstring: + begin + {!!!!!!!} + internalerror(8888); + end; + else + internalerror(200808241); + end; + end; + + + procedure tcgtypeconvnode.second_cstring_to_int; + begin + { this can't happen because constants are already processed in + pass 1 } + internalerror(200510013); + end; + + + procedure tcgtypeconvnode.second_string_to_chararray; + begin + if is_chararray(left.resultdef) then + begin + location_copy(location,left.location); + exit; + end; + { should be handled already in resultdef pass (JM) } + internalerror(200108292); + end; + + + procedure tcgtypeconvnode.second_array_to_pointer; + + begin + location_reset(location,LOC_REGISTER,OS_ADDR); + location.register:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,location.register); + end; + + + procedure tcgtypeconvnode.second_pointer_to_array; + + begin + { assume natural alignment } + location_reset_ref(location,LOC_REFERENCE,OS_NO,resultdef.alignment); + case left.location.loc of + LOC_CREGISTER, + LOC_REGISTER : + begin + {$ifdef cpu_uses_separate_address_registers} + if getregtype(left.location.register)<>R_ADDRESSREGISTER then + begin + location.reference.base:=rg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR, + left.location.register,location.reference.base); + end + else + {$endif} + location.reference.base := left.location.register; + end; + LOC_REFERENCE, + LOC_CREFERENCE : + begin + location.reference.base:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.reference, + location.reference.base); + location_freetemp(current_asmdata.CurrAsmList,left.location); + end; + else + internalerror(2002032216); + end; + end; + + + procedure tcgtypeconvnode.second_char_to_string; + begin + location_reset_ref(location,LOC_REFERENCE,OS_NO,2); + case tstringdef(resultdef).stringtype of + st_shortstring : + begin + tg.GetTemp(current_asmdata.CurrAsmList,256,2,tt_normal,location.reference); + cg.a_load_loc_ref(current_asmdata.CurrAsmList,left.location.size,left.location, + location.reference); + location_freetemp(current_asmdata.CurrAsmList,left.location); + end; + { the rest is removed in the resultdef pass and converted to compilerprocs } + else + internalerror(4179); + end; + end; + + + procedure tcgtypeconvnode.second_real_to_real; +{$ifdef x86} + var + tr: treference; +{$endif x86} + begin + location_reset(location,expectloc,def_cgsize(resultdef)); +{$ifdef x86} + { extended types in memory which should be loaded into the sse unit + must be converted by the fpu first, so force them to be loaded into + the fpu } + if (expectloc=LOC_MMREGISTER) and + (left.location.size in [OS_F80,OS_C64]) then + begin + if (left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then + location_force_fpureg(current_asmdata.CurrAsmList,left.location,false); + { round them down to the proper precision } + tg.gettemp(current_asmdata.currasmlist,resultdef.size,resultdef.alignment,tt_normal,tr); + cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,tr); + location_reset_ref(left.location,LOC_REFERENCE,location.size,tr.alignment); + left.location.reference:=tr; + end; +{$endif x86} + { ARM VFP values are in integer registers when they are function results } + if (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then + location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,false); + case left.location.loc of + LOC_FPUREGISTER, + LOC_CFPUREGISTER: + begin + case expectloc of + LOC_FPUREGISTER: + begin + { on sparc a move from double -> single means from two to one register. } + { On all other platforms it also needs rounding to avoid that } + { single(double_regvar) = double_regvar is true in all cases } + location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size); + cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register); + end; + LOC_MMREGISTER: + begin + location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,false); + location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size); + cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register,mms_movescalar); + end + else + internalerror(2003012262); + end; + exit + end; + LOC_CREFERENCE, + LOC_REFERENCE: + begin + if expectloc=LOC_MMREGISTER then + begin + location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size); + cg.a_loadmm_loc_reg(current_asmdata.CurrAsmList,location.size,left.location,location.register,mms_movescalar) + end + else + begin + location_force_fpureg(current_asmdata.CurrAsmList,left.location,false); + location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size); + cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register); + end; + location_freetemp(current_asmdata.CurrAsmList,left.location); + end; + LOC_MMREGISTER, + LOC_CMMREGISTER: + begin + case expectloc of + LOC_FPUREGISTER: + begin + location_force_fpureg(current_asmdata.CurrAsmList,left.location,false); + location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size); + cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register); + end; + LOC_MMREGISTER: + begin + location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size); + cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register,mms_movescalar); + end; + else + internalerror(2003012261); + end; + end; + else + internalerror(2002032215); + end; + end; + + + procedure tcgtypeconvnode.second_cord_to_pointer; + begin + { this can't happen because constants are already processed in + pass 1 } + internalerror(47423985); + end; + + + procedure tcgtypeconvnode.second_proc_to_procvar; + var + tmpreg: tregister; + begin + if tabstractprocdef(resultdef).is_addressonly then + begin + location_reset(location,LOC_REGISTER,OS_ADDR); + location.register:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,location.register); + end + else + begin + if not tabstractprocdef(left.resultdef).is_addressonly then + location_copy(location,left.location) + else + begin + { assigning a global function to a nested procvar -> create + tmethodpointer record and set the "frame pointer" to nil } + location_reset_ref(location,LOC_REFERENCE,int_cgsize(sizeof(pint)*2),sizeof(pint)); + tg.gettemp(current_asmdata.CurrAsmList,resultdef.size,sizeof(pint),tt_normal,location.reference); + tmpreg:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,tmpreg); + cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,tmpreg,location.reference); + { setting the frame pointer to nil is not strictly necessary + since the global procedure won't use it, but it can help with + debugging } + inc(location.reference.offset,sizeof(pint)); + cg.a_load_const_ref(current_asmdata.CurrAsmList,OS_ADDR,0,location.reference); + dec(location.reference.offset,sizeof(pint)); + end; + end; + end; + + procedure Tcgtypeconvnode.second_nil_to_methodprocvar; + + var r:Treference; + + begin + tg.gettemp(current_asmdata.currasmlist,2*sizeof(puint),sizeof(puint),tt_normal,r); + location_reset_ref(location,LOC_REFERENCE,def_cgsize(resultdef),0); + location.reference:=r; + cg.a_load_const_ref(current_asmdata.currasmlist,OS_ADDR,0,r); + inc(r.offset,sizeof(puint)); + cg.a_load_const_ref(current_asmdata.currasmlist,OS_ADDR,0,r); + end; + + procedure tcgtypeconvnode.second_bool_to_int; + var + newsize: tcgsize; + oldTrueLabel,oldFalseLabel : tasmlabel; + begin + oldTrueLabel:=current_procinfo.CurrTrueLabel; + oldFalseLabel:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + secondpass(left); + location_copy(location,left.location); + newsize:=def_cgsize(resultdef); + { byte(bytebool) or word(wordbool) or longint(longbool) must be } + { accepted for var parameters and assignments, and must not } + { change the ordinal value or value location. } + { htypechk.valid_for_assign ensures that such locations with a } + { size<sizeof(register) cannot be LOC_CREGISTER (they otherwise } + { could be in case of a plain assignment), and LOC_REGISTER can } + { never be an assignment target. The remaining LOC_REGISTER/ } + { LOC_CREGISTER locations do have to be sign/zero-extended. } + if not(nf_explicit in flags) or + (location.loc in [LOC_FLAGS,LOC_JUMP]) or + { change of size/signedness? Then we have to sign/ } + { zero-extend in case of a loc_(c)register } + ((newsize<>left.location.size) and + ((left.resultdef.size<>resultdef.size) or + not(location.loc in [LOC_REFERENCE,LOC_CREFERENCE]))) then + location_force_reg(current_asmdata.CurrAsmList,location,newsize,true) + else + { may differ in sign, e.g. bytebool -> byte } + location.size:=newsize; + current_procinfo.CurrTrueLabel:=oldTrueLabel; + current_procinfo.CurrFalseLabel:=oldFalseLabel; + end; + + + procedure tcgtypeconvnode.second_bool_to_bool; + begin + { we can reuse the conversion already available + in bool_to_int to resize the value. But when the + size of the new boolean is smaller we need to calculate + the value as is done in int_to_bool. This is needed because + the bits that define the true status can be outside the limits + of the new size and truncating the register can result in a 0 + value } + if (left.expectloc in [LOC_FLAGS,LOC_JUMP]) and + { a cbool must be converted to -1/0 } + not is_cbool(resultdef) then + begin + secondpass(left); + if (left.location.loc <> left.expectloc) then + internalerror(2010081601); + location_copy(location,left.location); + end + else if (resultdef.size=left.resultdef.size) and + (is_cbool(resultdef)=is_cbool(left.resultdef)) then + second_bool_to_int + else + begin + if (resultdef.size<>left.resultdef.size) then + { remove nf_explicit to perform full conversion if boolean sizes are different } + exclude(flags, nf_explicit); + second_int_to_bool; + end; + end; + + + procedure tcgtypeconvnode.second_ansistring_to_pchar; + var + l1 : tasmlabel; + hr : treference; + begin + location_reset(location,LOC_REGISTER,OS_ADDR); + current_asmdata.getjumplabel(l1); + case left.location.loc of + LOC_CREGISTER,LOC_REGISTER: + begin + {$ifdef cpu_uses_separate_address_registers} + if getregtype(left.location.register)<>R_ADDRESSREGISTER then + begin + location.register:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR, + left.location.register,location.register); + end + else + {$endif} + location.register := left.location.register; + end; + LOC_CREFERENCE,LOC_REFERENCE: + begin + location.register:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.reference,location.register); + end; + else + internalerror(2002032214); + end; + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_ADDR,OC_NE,0,location.register,l1); + { FPC_EMPTYCHAR is a widechar -> 2 bytes } + reference_reset(hr,2); + hr.symbol:=current_asmdata.RefAsmSymbol('FPC_EMPTYCHAR'); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,hr,location.register); + cg.a_label(current_asmdata.CurrAsmList,l1); + end; + + + procedure tcgtypeconvnode.second_class_to_intf; + var + l1 : tasmlabel; + hd : tobjectdef; + ImplIntf : TImplementedInterface; + begin + location_reset(location,LOC_REGISTER,OS_ADDR); + case left.location.loc of + LOC_CREFERENCE, + LOC_REFERENCE: + begin + location.register:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.reference,location.register); + location_freetemp(current_asmdata.CurrAsmList,left.location); + end; + LOC_CREGISTER: + begin + location.register:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.register,location.register); + end; + LOC_REGISTER: + location.register:=left.location.register; + else + internalerror(121120001); + end; + hd:=tobjectdef(left.resultdef); + while assigned(hd) do + begin + ImplIntf:=hd.find_implemented_interface(tobjectdef(resultdef)); + if assigned(ImplIntf) then + begin + case ImplIntf.IType of + etStandard: + begin + current_asmdata.getjumplabel(l1); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_ADDR,OC_EQ,0,location.register,l1); + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_ADD,OS_ADDR,ImplIntf.ioffset,location.register); + break; + end; + else + internalerror(200802163); + end; + end; + hd:=hd.childof; + end; + if hd=nil then + internalerror(2002081301); + cg.a_label(current_asmdata.CurrAsmList,l1); + end; + + + procedure tcgtypeconvnode.second_char_to_char; + begin + internalerror(2007081202); + end; + + + procedure tcgtypeconvnode.second_nothing; + var + newsize : tcgsize; + begin + { we reuse the old value } + location_copy(location,left.location); + + { Floats should never be returned as LOC_CONSTANT, do the + moving to memory before the new size is set. + Also when converting from a float to a non-float + or the other way round, move to memory first to prevent + invalid LOC_FPUREGISTER locations } + if ( + (resultdef.typ=floatdef) and + (location.loc=LOC_CONSTANT) + ) or + ( + (left.resultdef.typ=floatdef) xor + (resultdef.typ=floatdef) + ) then + location_force_mem(current_asmdata.CurrAsmList,location); + + { but use the new size, but we don't know the size of all arrays } + newsize:=def_cgsize(resultdef); + location.size:=newsize; + end; + + +{$ifdef TESTOBJEXT2} + procedure tcgtypeconvnode.checkobject; + begin + { no checking by default } + end; +{$endif TESTOBJEXT2} + + + procedure tcgtypeconvnode.pass_generate_code; + begin + { the boolean routines can be called with LOC_JUMP and + call secondpass themselves in the helper } + if not(convtype in [tc_bool_2_int,tc_bool_2_bool,tc_int_2_bool]) then + begin + secondpass(left); + if codegenerror then + exit; + end; + + second_call_helper(convtype); + +{$ifdef TESTOBJEXT2} + { Check explicit conversions to objects pointers !! } + if p^.explizit and + (p^.resultdef.typ=pointerdef) and + (tpointerdef(p^.resultdef).definition.typ=objectdef) and not + (tobjectdef(tpointerdef(p^.resultdef).definition).isclass) and + ((tobjectdef(tpointerdef(p^.resultdef).definition).options and oo_hasvmt)<>0) and + (cs_check_range in current_settings.localswitches) then + checkobject; +{$endif TESTOBJEXT2} + end; + + + procedure tcgasnode.pass_generate_code; + begin + secondpass(call); + location_copy(location,call.location); + end; + + +begin + ctypeconvnode := tcgtypeconvnode; + casnode := tcgasnode; +end. diff --git a/closures/compiler/ncgcon.pas b/closures/compiler/ncgcon.pas new file mode 100644 index 0000000000..b64d25ed00 --- /dev/null +++ b/closures/compiler/ncgcon.pas @@ -0,0 +1,493 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate assembler for constant nodes which are the same for + all (most) 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. + + **************************************************************************** +} +unit ncgcon; + +{$i fpcdefs.inc} + +interface + + uses + node,ncon; + + type + tcgdataconstnode = class(tdataconstnode) + procedure pass_generate_code;override; + end; + + tcgrealconstnode = class(trealconstnode) + procedure pass_generate_code;override; + end; + + tcgordconstnode = class(tordconstnode) + procedure pass_generate_code;override; + end; + + tcgpointerconstnode = class(tpointerconstnode) + procedure pass_generate_code;override; + end; + + tcgstringconstnode = class(tstringconstnode) + procedure pass_generate_code;override; + end; + + tcgsetconstnode = class(tsetconstnode) + procedure pass_generate_code;override; + end; + + tcgnilnode = class(tnilnode) + procedure pass_generate_code;override; + end; + + tcgguidconstnode = class(tguidconstnode) + procedure pass_generate_code;override; + end; + + +implementation + + uses + globtype,widestr,systems, + verbose,globals,cutils, + symconst,symdef,aasmbase,aasmtai,aasmdata,aasmcpu,defutil, + cpuinfo,cpubase, + cgbase,cgobj,cgutils, + ncgutil, cclasses,asmutils + ; + + +{***************************************************************************** + TCGREALCONSTNODE +*****************************************************************************} + + procedure tcgdataconstnode.pass_generate_code; + var + l : tasmlabel; + i : longint; + b : byte; + begin + location_reset_ref(location,LOC_CREFERENCE,OS_NO,const_align(maxalign)); + current_asmdata.getdatalabel(l); + maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]); + new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata,l.name,const_align(maxalign)); + current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l)); + data.seek(0); + for i:=0 to data.size-1 do + begin + data.read(b,1); + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(b)); + end; + location.reference.symbol:=l; + end; + +{***************************************************************************** + TCGREALCONSTNODE +*****************************************************************************} + + procedure tcgrealconstnode.pass_generate_code; + { 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_real_80bit,ait_comp_64bit,ait_comp_64bit,ait_real_128bit); + + { Since the value is stored always as bestreal, we share a single pool + between all float types. This requires type and hiloswapped flag to + be matched along with the value } + type + tfloatkey = record + value: bestreal; + typ: tfloattype; + swapped: boolean; + end; + + var + lastlabel : tasmlabel; + realait : taitype; + entry : PHashSetItem; + key: tfloatkey; +{$ifdef ARM} + hiloswapped : boolean; +{$endif ARM} + + begin + location_reset_ref(location,LOC_CREFERENCE,def_cgsize(resultdef),const_align(resultdef.alignment)); + lastlabel:=nil; + realait:=floattype2ait[tfloatdef(resultdef).floattype]; +{$ifdef ARM} + hiloswapped:=is_double_hilo_swapped; +{$endif ARM} + { const already used ? } + if not assigned(lab_real) then + begin + { there may be gap between record fields, zero it out } + fillchar(key,sizeof(key),0); + key.value:=value_real; + key.typ:=tfloatdef(resultdef).floattype; +{$ifdef ARM} + key.swapped:=hiloswapped; +{$endif ARM} + entry := current_asmdata.ConstPools[sp_floats].FindOrAdd(@key, sizeof(key)); + + lab_real := TAsmLabel(entry^.Data); // is it needed anymore? + + { :-(, we must generate a new entry } + if not assigned(lab_real) then + begin + current_asmdata.getdatalabel(lastlabel); + entry^.Data:=lastlabel; + lab_real:=lastlabel; + maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]); + new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,lastlabel.name,const_align(resultdef.alignment)); + current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(lastlabel)); + case realait of + ait_real_32bit : + begin + current_asmdata.asmlists[al_typedconsts].concat(Tai_real_32bit.Create(ts32real(value_real))); + { range checking? } + if floating_point_range_check_error and + (tai_real_32bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then + Message(parser_e_range_check_error); + end; + + ait_real_64bit : + begin +{$ifdef ARM} + if hiloswapped then + current_asmdata.asmlists[al_typedconsts].concat(Tai_real_64bit.Create_hiloswapped(ts64real(value_real))) + else +{$endif ARM} + current_asmdata.asmlists[al_typedconsts].concat(Tai_real_64bit.Create(ts64real(value_real))); + + { range checking? } + if floating_point_range_check_error and + (tai_real_64bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then + Message(parser_e_range_check_error); + end; + + ait_real_80bit : + begin + current_asmdata.asmlists[al_typedconsts].concat(Tai_real_80bit.Create(value_real,resultdef.size)); + + { range checking? } + if floating_point_range_check_error and + (tai_real_80bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) then + Message(parser_e_range_check_error); + end; +{$ifdef cpufloat128} + ait_real_128bit : + begin + current_asmdata.asmlists[al_typedconsts].concat(Tai_real_128bit.Create(value_real)); + + { range checking? } + if floating_point_range_check_error and + (tai_real_128bit(current_asmdata.asmlists[al_typedconsts].last).value=MathInf.Value) 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_asmdata.asmlists[al_typedconsts].concat(Tai_comp_64bit.Create(round(value_real))); + else + internalerror(10120); + end; + end; + end; + location.reference.symbol:=lab_real; + end; + +{***************************************************************************** + TCGORDCONSTNODE +*****************************************************************************} + + procedure tcgordconstnode.pass_generate_code; + begin + location_reset(location,LOC_CONSTANT,def_cgsize(resultdef)); +{$ifdef cpu64bitalu} + location.value:=value.svalue; +{$else cpu64bitalu} + location.value64:=value.svalue; +{$endif cpu64bitalu} + end; + + +{***************************************************************************** + TCGPOINTERCONSTNODE +*****************************************************************************} + + procedure tcgpointerconstnode.pass_generate_code; + begin + { an integer const. behaves as a memory reference } + location_reset(location,LOC_CONSTANT,OS_ADDR); + location.value:=aint(value); + end; + + +{***************************************************************************** + TCGSTRINGCONSTNODE +*****************************************************************************} + + procedure tcgstringconstnode.pass_generate_code; + var + lastlabel: tasmlabel; + pc: pchar; + l: longint; + href: treference; + pool: THashSet; + entry: PHashSetItem; + + const + PoolMap: array[tconststringtype] of TConstPoolType = ( + sp_conststr, + sp_shortstr, + sp_longstr, + sp_ansistr, + sp_widestr, + sp_unicodestr + ); + begin + { for empty ansistrings we could return a constant 0 } + if (cst_type in [cst_ansistring,cst_widestring,cst_unicodestring]) and (len=0) then + begin + location_reset(location,LOC_CONSTANT,OS_ADDR); + location.value:=0; + exit; + end; + { const already used ? } + if not assigned(lab_str) then + begin + pool := current_asmdata.ConstPools[PoolMap[cst_type]]; + + if cst_type in [cst_widestring, cst_unicodestring] then + entry := pool.FindOrAdd(pcompilerwidestring(value_str)^.data,len*cwidechartype.size) + else + if cst_type = cst_ansistring then + entry := PHashSetItem(TTagHashSet(pool).FindOrAdd(value_str,len,tstringdef(resultdef).encoding)) + else + entry := pool.FindOrAdd(value_str,len); + + lab_str := TAsmLabel(entry^.Data); // is it needed anymore? + + { :-(, we must generate a new entry } + if not assigned(entry^.Data) then + begin + case cst_type of + cst_ansistring: + begin + if len=0 then + InternalError(2008032301) { empty string should be handled above } + else + lastlabel:=emit_ansistring_const(current_asmdata.AsmLists[al_typedconsts],value_str,len,tstringdef(resultdef).encoding); + end; + cst_unicodestring, + cst_widestring: + begin + if len=0 then + InternalError(2008032302) { empty string should be handled above } + else + lastlabel := emit_unicodestring_const(current_asmdata.AsmLists[al_typedconsts], + value_str, + tstringdef(resultdef).encoding, + (cst_type=cst_widestring) and (tf_winlikewidestring in target_info.flags)); + end; + cst_shortstring: + begin + current_asmdata.getdatalabel(lastlabel); + maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]); + new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,lastlabel.name,const_align(sizeof(pint))); + + current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(lastlabel)); + { truncate strings larger than 255 chars } + if len>255 then + l:=255 + else + l:=len; + { include length and terminating zero for quick conversion to pchar } + getmem(pc,l+2); + move(value_str^,pc[1],l); + pc[0]:=chr(l); + pc[l+1]:=#0; + current_asmdata.asmlists[al_typedconsts].concat(Tai_string.Create_pchar(pc,l+2)); + end; + cst_conststring: + begin + current_asmdata.getdatalabel(lastlabel); + maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]); + new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,lastlabel.name,const_align(sizeof(pint))); + + current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(lastlabel)); + { include terminating zero } + getmem(pc,len+1); + move(value_str^,pc[0],len); + pc[len]:=#0; + current_asmdata.asmlists[al_typedconsts].concat(Tai_string.Create_pchar(pc,len+1)); + end; + end; + lab_str:=lastlabel; + entry^.Data:=lastlabel; + end; + end; + if cst_type in [cst_ansistring, cst_widestring, cst_unicodestring] then + begin + location_reset(location, LOC_REGISTER, OS_ADDR); + reference_reset_symbol(href, lab_str, 0, const_align(sizeof(pint))); + location.register:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,href,location.register); + end + else + begin + location_reset_ref(location, LOC_CREFERENCE, def_cgsize(resultdef), const_align(sizeof(pint))); + location.reference.symbol:=lab_str; + end; + end; + + +{***************************************************************************** + TCGSETCONSTNODE +*****************************************************************************} + + procedure tcgsetconstnode.pass_generate_code; + + type + setbytes=array[0..31] of byte; + Psetbytes=^setbytes; + + procedure smallsetconst; + begin + location_reset(location,LOC_CONSTANT,int_cgsize(resultdef.size)); + if (source_info.endian=target_info.endian) then + begin + { not plongint, because that will "sign extend" the set on 64 bit platforms } + { if changed to "paword", please also modify "32-resultdef.size*8" and } + { cross-endian code below } + { Extra aint type cast to avoid range errors } + location.value:=aint(pCardinal(value_set)^) + end + else + begin + location.value:=swapendian(Pcardinal(value_set)^); + location.value:=aint( + reverse_byte (location.value and $ff) or + (reverse_byte((location.value shr 8) and $ff) shl 8) or + (reverse_byte((location.value shr 16) and $ff) shl 16) or + (reverse_byte((location.value shr 24) and $ff) shl 24) + ); + end; + if (target_info.endian=endian_big) then + location.value:=location.value shr (32-resultdef.size*8); + end; + + procedure varsetconst; + var + lastlabel : tasmlabel; + i : longint; + entry : PHashSetItem; + begin + location_reset_ref(location,LOC_CREFERENCE,OS_NO,const_align(8)); + lastlabel:=nil; + { const already used ? } + if not assigned(lab_set) then + begin + entry := current_asmdata.ConstPools[sp_varsets].FindOrAdd(value_set, 32); + + lab_set := TAsmLabel(entry^.Data); // is it needed anymore? + + { :-(, we must generate a new entry } + if not assigned(entry^.Data) then + begin + current_asmdata.getdatalabel(lastlabel); + lab_set:=lastlabel; + entry^.Data:=lastlabel; + maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]); + new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,lastlabel.name,const_align(8)); + current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(lastlabel)); + if (source_info.endian=target_info.endian) then + for i:=0 to 31 do + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(Psetbytes(value_set)^[i])) + else + for i:=0 to 31 do + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(reverse_byte(Psetbytes(value_set)^[i]))); + end; + end; + location.reference.symbol:=lab_set; + end; + + begin + adjustforsetbase; + + { small sets are loaded as constants } + if is_smallset(resultdef) then + smallsetconst + else + varsetconst; + end; + + +{***************************************************************************** + TCGNILNODE +*****************************************************************************} + + procedure tcgnilnode.pass_generate_code; + begin + location_reset(location,LOC_CONSTANT,OS_ADDR); + location.value:=0; + end; + + +{***************************************************************************** + TCGGUIDCONSTNODE +*****************************************************************************} + + procedure tcgguidconstnode.pass_generate_code; + var + tmplabel : TAsmLabel; + i : integer; + begin + location_reset_ref(location,LOC_CREFERENCE,OS_NO,const_align(16)); + { label for GUID } + current_asmdata.getdatalabel(tmplabel); + maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]); + new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,tmplabel.name,const_align(16)); + current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(tmplabel)); + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit(longint(value.D1))); + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_16bit(value.D2)); + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_16bit(value.D3)); + for i:=low(value.D4) to high(value.D4) do + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(value.D4[i])); + location.reference.symbol:=tmplabel; + end; + + +begin + cdataconstnode:=tcgdataconstnode; + crealconstnode:=tcgrealconstnode; + cordconstnode:=tcgordconstnode; + cpointerconstnode:=tcgpointerconstnode; + cstringconstnode:=tcgstringconstnode; + csetconstnode:=tcgsetconstnode; + cnilnode:=tcgnilnode; + cguidconstnode:=tcgguidconstnode; +end. diff --git a/closures/compiler/ncgflw.pas b/closures/compiler/ncgflw.pas new file mode 100644 index 0000000000..3ff66ee81f --- /dev/null +++ b/closures/compiler/ncgflw.pas @@ -0,0 +1,1662 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate assembler for nodes that influence the flow which are + the same for all (most?) 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. + + **************************************************************************** +} +unit ncgflw; + +{$i fpcdefs.inc} + +interface + + uses + aasmbase,node,nflw,ncgutil; + + type + tcgwhilerepeatnode = class(twhilerepeatnode) + usedregvars: tusedregvars; + + procedure pass_generate_code;override; + procedure sync_regvars(checkusedregvars: boolean); + end; + + tcgifnode = class(tifnode) + procedure pass_generate_code;override; + end; + + tcgfornode = class(tfornode) + usedregvars: tusedregvars; + + procedure pass_generate_code;override; + procedure sync_regvars(checkusedregvars: boolean); + end; + + tcgexitnode = class(texitnode) + procedure pass_generate_code;override; + end; + + tcgbreaknode = class(tbreaknode) + procedure pass_generate_code;override; + end; + + tcgcontinuenode = class(tcontinuenode) + procedure pass_generate_code;override; + end; + + tcggotonode = class(tgotonode) + procedure pass_generate_code;override; + end; + + tcglabelnode = class(tlabelnode) + private + asmlabel : tasmlabel; + public + function getasmlabel : tasmlabel; + procedure pass_generate_code;override; + end; + + tcgraisenode = class(traisenode) + procedure pass_generate_code;override; + end; + + tcgtryexceptnode = class(ttryexceptnode) + procedure pass_generate_code;override; + end; + + tcgtryfinallynode = class(ttryfinallynode) + procedure handle_safecall_exception; + procedure pass_generate_code;override; + end; + + tcgonnode = class(tonnode) + procedure pass_generate_code;override; + end; + +implementation + + uses + verbose,globals,systems,globtype,constexp, + symconst,symdef,symsym,aasmtai,aasmdata,aasmcpu,defutil, + procinfo,cgbase,pass_2,parabase, + cpubase,cpuinfo, + nld,ncon, + tgobj,paramgr, + regvars, + cgutils,cgobj,nutils + ; + +{***************************************************************************** + Second_While_RepeatN +*****************************************************************************} + + procedure tcgwhilerepeatnode.sync_regvars(checkusedregvars: boolean); + begin + if (cs_opt_regvar in current_settings.optimizerswitches) and + not(pi_has_label in current_procinfo.flags) then + begin + if checkusedregvars then + begin + usedregvars.intregvars.init; + usedregvars.fpuregvars.init; + usedregvars.mmregvars.init; + + { we have to synchronise both the regvars used in the loop } + { and the ones in the while/until condition } + get_used_regvars(self,usedregvars); + gen_sync_regvars(current_asmdata.CurrAsmList,usedregvars); + end + else + begin + gen_sync_regvars(current_asmdata.CurrAsmList,usedregvars); + usedregvars.intregvars.done; + usedregvars.fpuregvars.done; + usedregvars.mmregvars.done; + end; + end; + end; + + + procedure tcgwhilerepeatnode.pass_generate_code; + var + lcont,lbreak,lloop, + oldclabel,oldblabel : tasmlabel; + otlabel,oflabel : tasmlabel; + oldflowcontrol : tflowcontrol; + oldexecutionweight : longint; + begin + location_reset(location,LOC_VOID,OS_NO); + + current_asmdata.getjumplabel(lloop); + current_asmdata.getjumplabel(lcont); + current_asmdata.getjumplabel(lbreak); + { arrange continue and breaklabels: } + oldflowcontrol:=flowcontrol; + oldclabel:=current_procinfo.CurrContinueLabel; + oldblabel:=current_procinfo.CurrBreakLabel; + include(flowcontrol,fc_inflowcontrol); + + sync_regvars(true); +{$ifdef OLDREGVARS} + load_all_regvars(current_asmdata.CurrAsmList); +{$endif OLDREGVARS} + { handling code at the end as it is much more efficient, and makes + while equal to repeat loop, only the end true/false is swapped (PFV) } + if lnf_testatbegin in loopflags then + cg.a_jmp_always(current_asmdata.CurrAsmList,lcont); + + if not(cs_opt_size in current_settings.optimizerswitches) then + { align loop target } + current_asmdata.CurrAsmList.concat(Tai_align.Create(current_settings.alignment.loopalign)); + + cg.a_label(current_asmdata.CurrAsmList,lloop); + + current_procinfo.CurrContinueLabel:=lcont; + current_procinfo.CurrBreakLabel:=lbreak; + + if assigned(right) then + begin + { calc register weight } + oldexecutionweight:=cg.executionweight; + cg.executionweight:=cg.executionweight*8; + secondpass(right); + cg.executionweight:=oldexecutionweight; + end; + +{$ifdef OLDREGVARS} + load_all_regvars(current_asmdata.CurrAsmList); +{$endif OLDREGVARS} + + cg.a_label(current_asmdata.CurrAsmList,lcont); + otlabel:=current_procinfo.CurrTrueLabel; + oflabel:=current_procinfo.CurrFalseLabel; + if lnf_checknegate in loopflags then + begin + current_procinfo.CurrTrueLabel:=lbreak; + current_procinfo.CurrFalseLabel:=lloop; + end + else + begin + current_procinfo.CurrTrueLabel:=lloop; + current_procinfo.CurrFalseLabel:=lbreak; + end; + secondpass(left); + + maketojumpbool(current_asmdata.CurrAsmList,left,lr_load_regvars); + cg.a_label(current_asmdata.CurrAsmList,lbreak); + + sync_regvars(false); + + current_procinfo.CurrTrueLabel:=otlabel; + current_procinfo.CurrFalseLabel:=oflabel; + + current_procinfo.CurrContinueLabel:=oldclabel; + current_procinfo.CurrBreakLabel:=oldblabel; + { a break/continue in a while/repeat block can't be seen outside } + flowcontrol:=oldflowcontrol+(flowcontrol-[fc_break,fc_continue,fc_inflowcontrol]); + end; + + +{***************************************************************************** + tcgIFNODE +*****************************************************************************} + + procedure tcgifnode.pass_generate_code; + + var + hl,otlabel,oflabel : tasmlabel; + oldflowcontrol: tflowcontrol; + oldexecutionweight : longint; +(* + org_regvar_loaded_other, + then_regvar_loaded_other, + else_regvar_loaded_other : regvarother_booleanarray; + org_regvar_loaded_int, + then_regvar_loaded_int, + else_regvar_loaded_int : Tsuperregisterset; + org_list, + then_list, + else_list : TAsmList; +*) + + begin + location_reset(location,LOC_VOID,OS_NO); + + oldflowcontrol := flowcontrol; + include(flowcontrol,fc_inflowcontrol); + otlabel:=current_procinfo.CurrTrueLabel; + oflabel:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + secondpass(left); + +(* + { save regvars loaded in the beginning so that we can restore them } + { when processing the else-block } + if cs_opt_regvar in current_settings.optimizerswitches then + begin + org_list := current_asmdata.CurrAsmList; + current_asmdata.CurrAsmList := TAsmList.create; + end; +*) + maketojumpbool(current_asmdata.CurrAsmList,left,lr_dont_load_regvars); + +(* + if cs_opt_regvar in current_settings.optimizerswitches then + begin + org_regvar_loaded_int := rg.regvar_loaded_int; + org_regvar_loaded_other := rg.regvar_loaded_other; + end; +*) + { determines registers weigths } + oldexecutionweight:=cg.executionweight; + cg.executionweight:=cg.executionweight div 2; + if cg.executionweight<1 then + cg.executionweight:=1; + + if assigned(right) then + begin + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel); + secondpass(right); + end; + + { save current asmlist (previous instructions + then-block) and } + { loaded regvar state and create new clean ones } +{ + if cs_opt_regvar in current_settings.optimizerswitches then + begin + then_regvar_loaded_int := rg.regvar_loaded_int; + then_regvar_loaded_other := rg.regvar_loaded_other; + rg.regvar_loaded_int := org_regvar_loaded_int; + rg.regvar_loaded_other := org_regvar_loaded_other; + then_list := current_asmdata.CurrAsmList; + current_asmdata.CurrAsmList := TAsmList.create; + end; +} + + if assigned(t1) then + begin + if assigned(right) then + begin + current_asmdata.getjumplabel(hl); + { do go back to if line !! } +(* + if not(cs_opt_regvar in current_settings.optimizerswitches) then +*) + current_filepos:=current_asmdata.CurrAsmList.getlasttaifilepos^ +(* + else + current_filepos:=then_list.getlasttaifilepos^ +*) + ; + cg.a_jmp_always(current_asmdata.CurrAsmList,hl); + end; + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + secondpass(t1); +(* + { save current asmlist (previous instructions + else-block) } + { and loaded regvar state and create a new clean list } + if cs_opt_regvar in current_settings.optimizerswitches then + begin +{ else_regvar_loaded_int := rg.regvar_loaded_int; + else_regvar_loaded_other := rg.regvar_loaded_other;} + else_list := current_asmdata.CurrAsmList; + current_asmdata.CurrAsmList := TAsmList.create; + end; +*) + if assigned(right) then + cg.a_label(current_asmdata.CurrAsmList,hl); + end + else + begin +(* + if cs_opt_regvar in current_settings.optimizerswitches then + begin +{ else_regvar_loaded_int := rg.regvar_loaded_int; + else_regvar_loaded_other := rg.regvar_loaded_other;} + else_list := current_asmdata.CurrAsmList; + current_asmdata.CurrAsmList := TAsmList.create; + end; +*) + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + end; + if not(assigned(right)) then + begin + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel); + end; + +(* + if cs_opt_regvar in current_settings.optimizerswitches then + begin + { add loads of regvars at the end of the then- and else-blocks } + { so that at the end of both blocks the same regvars are loaded } + + { no else block? } + if not assigned(t1) then + begin + sync_regvars_int(org_list,then_list,org_regvar_loaded_int,then_regvar_loaded_int); + sync_regvars_other(org_list,then_list,org_regvar_loaded_other,then_regvar_loaded_other); + end + { no then block? } + else if not assigned(right) then + begin + sync_regvars_int(org_list,else_list,org_regvar_loaded_int,else_regvar_loaded_int); + sync_regvars_other(org_list,else_list,org_regvar_loaded_other,else_regvar_loaded_other); + end + { both else and then blocks } + else + begin + sync_regvars_int(then_list,else_list,then_regvar_loaded_int,else_regvar_loaded_int); + sync_regvars_other(then_list,else_list,then_regvar_loaded_other,else_regvar_loaded_other); + end; + { add all lists together } + org_list.concatlist(then_list); + then_list.free; + org_list.concatlist(else_list); + else_list.free; + org_list.concatlist(current_asmdata.CurrAsmList); + current_asmdata.CurrAsmList.free; + current_asmdata.CurrAsmList := org_list; + end; +*) + + cg.executionweight:=oldexecutionweight; + + current_procinfo.CurrTrueLabel:=otlabel; + current_procinfo.CurrFalseLabel:=oflabel; + flowcontrol := oldflowcontrol + (flowcontrol - [fc_inflowcontrol]); + end; + + +{***************************************************************************** + SecondFor +*****************************************************************************} + + procedure tcgfornode.sync_regvars(checkusedregvars: boolean); + begin + if (cs_opt_regvar in current_settings.optimizerswitches) and + not(pi_has_label in current_procinfo.flags) then + begin + if checkusedregvars then + begin + usedregvars.intregvars.init; + usedregvars.fpuregvars.init; + usedregvars.mmregvars.init; + + { We have to synchronise the loop variable and loop body. } + { The loop end is not necessary, unless it's a register } + { variable. The start value also doesn't matter. } + + { loop var } + get_used_regvars(right,usedregvars); + { loop body } + get_used_regvars(t2,usedregvars); + { end value (t1) is not necessary (it cannot be a regvar, } + { see webtbs/tw8883) } + + gen_sync_regvars(current_asmdata.CurrAsmList,usedregvars); + end + else + begin + gen_sync_regvars(current_asmdata.CurrAsmList,usedregvars); + usedregvars.intregvars.done; + usedregvars.fpuregvars.done; + usedregvars.mmregvars.done; + end; + end; + end; + + + procedure tcgfornode.pass_generate_code; + var + l3,oldclabel,oldblabel, + otl, ofl : tasmlabel; + temptovalue : boolean; + hop : topcg; + hcond : topcmp; + opsize : tcgsize; + count_var_is_signed,do_loopvar_at_end : boolean; + cmp_const:Tconstexprint; + oldflowcontrol : tflowcontrol; + oldexecutionweight : longint; + isjump: boolean; + begin + location_reset(location,LOC_VOID,OS_NO); + oldclabel:=current_procinfo.CurrContinueLabel; + oldblabel:=current_procinfo.CurrBreakLabel; + current_asmdata.getjumplabel(current_procinfo.CurrContinueLabel); + current_asmdata.getjumplabel(current_procinfo.CurrBreakLabel); + current_asmdata.getjumplabel(l3); + + { only calculate reference } + opsize := def_cgsize(left.resultdef); + count_var_is_signed:=is_signed(left.resultdef); + + { first set the to value + because the count var can be in the expression ! } + do_loopvar_at_end:=(lnf_dont_mind_loopvar_on_exit in loopflags) + { if the loop is unrolled and there is a jump into the loop, + then we can't do the trick with incrementing the loop var only at the + end + } + and not(assigned(entrylabel)); + + isjump:=(t1.expectloc=LOC_JUMP); + if isjump then + begin + otl:=current_procinfo.CurrTrueLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + ofl:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + end; + secondpass(t1); + if t1.location.loc in [LOC_FLAGS,LOC_JUMP] then + location_force_reg(current_asmdata.CurrAsmList,t1.location,def_cgsize(t1.resultdef),false); + if isjump then + begin + current_procinfo.CurrTrueLabel:=otl; + current_procinfo.CurrFalseLabel:=ofl; + end; + { calculate pointer value and check if changeable and if so } + { load into temporary variable } + if t1.nodetype<>ordconstn then + begin + do_loopvar_at_end:=false; + location_force_reg(current_asmdata.CurrAsmList,t1.location,t1.location.size,false); + temptovalue:=true; + end + else + temptovalue:=false; + + { load loopvar, prefer loopvar being a register variable } + oldexecutionweight:=cg.executionweight; + inc(cg.executionweight,8); + secondpass(left); + cg.executionweight:=oldexecutionweight; + + { load from value } + isjump:=(right.expectloc=LOC_JUMP); + if isjump then + begin + otl:=current_procinfo.CurrTrueLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + ofl:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + end; + secondpass(right); + if right.location.loc in [LOC_FLAGS,LOC_JUMP] then + location_force_reg(current_asmdata.CurrAsmList,right.location,def_cgsize(right.resultdef),false); + if isjump then + begin + current_procinfo.CurrTrueLabel:=otl; + current_procinfo.CurrFalseLabel:=ofl; + end; + + maybechangeloadnodereg(current_asmdata.CurrAsmList,left,false); + oldflowcontrol:=flowcontrol; + include(flowcontrol,fc_inflowcontrol); + { produce start assignment } + case left.location.loc of + LOC_REFERENCE, + LOC_CREFERENCE : + cg.a_load_loc_ref(current_asmdata.CurrAsmList,left.location.size,right.location,left.location.reference); + LOC_REGISTER, + LOC_CREGISTER: + cg.a_load_loc_reg(current_asmdata.CurrAsmList,left.location.size,right.location,left.location.register); + LOC_SUBSETREG, + LOC_CSUBSETREG : + cg.a_load_loc_subsetreg(current_asmdata.CurrAsmList,left.location.size,right.location,left.location.sreg); + else + internalerror(200501311); + end; + + if lnf_backward in loopflags then + if count_var_is_signed then + hcond:=OC_LT + else + hcond:=OC_B + else + if count_var_is_signed then + hcond:=OC_GT + else + hcond:=OC_A; + + sync_regvars(true); +{$ifdef OLDREGVARS} + load_all_regvars(current_asmdata.CurrAsmList); +{$endif OLDREGVARS} + + if temptovalue then + begin + cg.a_cmp_reg_loc_label(current_asmdata.CurrAsmList,opsize,hcond, + t1.location.register,left.location,current_procinfo.CurrBreakLabel); + end + else + begin + if lnf_testatbegin in loopflags then + begin + cg.a_cmp_const_loc_label(current_asmdata.CurrAsmList,opsize,hcond, + tordconstnode(t1).value.svalue, + left.location,current_procinfo.CurrBreakLabel); + end; + end; + + {If the loopvar doesn't mind on exit, we avoid this ugly + dec instruction and do the loopvar inc/dec after the loop + body.} + if not do_loopvar_at_end then + begin + if lnf_backward in loopflags then + hop:=OP_ADD + else + hop:=OP_SUB; + cg.a_op_const_loc(current_asmdata.CurrAsmList,hop,1,left.location); + end; + + if assigned(entrylabel) then + cg.a_jmp_always(current_asmdata.CurrAsmList,tcglabelnode(entrylabel).getasmlabel); + + { align loop target } + if not(cs_opt_size in current_settings.optimizerswitches) then + current_asmdata.CurrAsmList.concat(Tai_align.Create(current_settings.alignment.loopalign)); + cg.a_label(current_asmdata.CurrAsmList,l3); + + {If the loopvar doesn't mind on exit, we avoid the loopvar inc/dec + after the loop body instead of here.} + if not do_loopvar_at_end then + begin + { according to count direction DEC or INC... } + if lnf_backward in loopflags then + hop:=OP_SUB + else + hop:=OP_ADD; + cg.a_op_const_loc(current_asmdata.CurrAsmList,hop,1,left.location); + end; + + if assigned(t2) then + begin + { Calc register weight } + oldexecutionweight:=cg.executionweight; + cg.executionweight:=cg.executionweight*8; + secondpass(t2); + cg.executionweight:=oldexecutionweight; +{$ifdef OLDREGVARS} + load_all_regvars(current_asmdata.CurrAsmList); +{$endif OLDREGVARS} + end; + + {If the loopvar doesn't mind on exit, we do the loopvar inc/dec + after the loop body instead of here.} + if do_loopvar_at_end then + begin + { according to count direction DEC or INC... } + if lnf_backward in loopflags then + hop:=OP_SUB + else + hop:=OP_ADD; + cg.a_op_const_loc(current_asmdata.CurrAsmList,hop,1,left.location); + end; + + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrContinueLabel); + + if do_loopvar_at_end then + if lnf_backward in loopflags then + if count_var_is_signed then + hcond:=OC_GTE + else + hcond:=OC_AE + else + if count_var_is_signed then + hcond:=OC_LTE + else + hcond:=OC_BE + else + if lnf_backward in loopflags then + if count_var_is_signed then + hcond:=OC_GT + else + hcond:=OC_A + else + if count_var_is_signed then + hcond:=OC_LT + else + hcond:=OC_B; +{$ifdef OLDREGVARS} + load_all_regvars(current_asmdata.CurrAsmList); +{$endif OLDREGVARS} + + { produce comparison and the corresponding } + { jump } + if temptovalue then + begin + cg.a_cmp_reg_loc_label(current_asmdata.CurrAsmList,opsize,hcond,t1.location.register, + left.location,l3); + end + else + begin + cmp_const:=Tordconstnode(t1).value; + if do_loopvar_at_end then + begin + {Watch out for wrap around 255 -> 0.} + {Ugly: This code is way to long... Use tables?} + case opsize of + OS_8: + begin + if lnf_backward in loopflags then + begin + if byte(cmp_const.svalue)=low(byte) then + begin + hcond:=OC_NE; + cmp_const:=high(byte); + end + end + else + begin + if byte(cmp_const.svalue)=high(byte) then + begin + hcond:=OC_NE; + cmp_const:=low(byte); + end + end + end; + OS_16: + begin + if lnf_backward in loopflags then + begin + if word(cmp_const.svalue)=high(word) then + begin + hcond:=OC_NE; + cmp_const:=low(word); + end + end + else + begin + if word(cmp_const.svalue)=low(word) then + begin + hcond:=OC_NE; + cmp_const:=high(word); + end + end + end; + OS_32: + begin + if lnf_backward in loopflags then + begin + if cardinal(cmp_const.svalue)=high(cardinal) then + begin + hcond:=OC_NE; + cmp_const:=low(cardinal); + end + end + else + begin + if cardinal(cmp_const.svalue)=low(cardinal) then + begin + hcond:=OC_NE; + cmp_const:=high(cardinal); + end + end + end; + OS_64: + begin + if lnf_backward in loopflags then + begin + if qword(cmp_const.uvalue)=high(qword) then + begin + hcond:=OC_NE; + cmp_const:=low(qword); + end + end + else + begin + if qword(cmp_const.uvalue)=low(qword) then + begin + hcond:=OC_NE; + cmp_const:=high(qword); + end + end + end; + OS_S8: + begin + if lnf_backward in loopflags then + begin + if shortint(cmp_const.svalue)=low(shortint) then + begin + hcond:=OC_NE; + cmp_const:=high(shortint); + end + end + else + begin + if shortint(cmp_const.svalue)=high(shortint) then + begin + hcond:=OC_NE; + cmp_const:=int64(low(shortint)); + end + end + end; + OS_S16: + begin + if lnf_backward in loopflags then + begin + if integer(cmp_const.svalue)=high(smallint) then + begin + hcond:=OC_NE; + cmp_const:=int64(low(smallint)); + end + end + else + begin + if integer(cmp_const.svalue)=low(smallint) then + begin + hcond:=OC_NE; + cmp_const:=int64(high(smallint)); + end + end + end; + OS_S32: + begin + if lnf_backward in loopflags then + begin + if longint(cmp_const.svalue)=high(longint) then + begin + hcond:=OC_NE; + cmp_const:=int64(low(longint)); + end + end + else + begin + if longint(cmp_const.svalue)=low(longint) then + begin + hcond:=OC_NE; + cmp_const:=int64(high(longint)); + end + end + end; + OS_S64: + begin + if lnf_backward in loopflags then + begin + if int64(cmp_const.svalue)=high(int64) then + begin + hcond:=OC_NE; + cmp_const:=low(int64); + end + end + else + begin + if int64(cmp_const.svalue)=low(int64) then + begin + hcond:=OC_NE; + cmp_const:=high(int64); + end + end + end; + else + internalerror(200201021); + end; + end; + + cg.a_cmp_const_loc_label(current_asmdata.CurrAsmList,opsize,hcond, + aint(cmp_const.svalue),left.location,l3); + end; + + { this is the break label: } + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrBreakLabel); + + sync_regvars(false); + + current_procinfo.CurrContinueLabel:=oldclabel; + current_procinfo.CurrBreakLabel:=oldblabel; + { a break/continue in a while/repeat block can't be seen outside } + flowcontrol:=oldflowcontrol+(flowcontrol-[fc_break,fc_continue,fc_inflowcontrol]); + end; + + +{***************************************************************************** + SecondExitN +*****************************************************************************} + + procedure tcgexitnode.pass_generate_code; + begin + location_reset(location,LOC_VOID,OS_NO); + + include(flowcontrol,fc_exit); + if assigned(left) then + secondpass(left); + if (fc_unwind in flowcontrol) then + cg.g_local_unwind(current_asmdata.CurrAsmList,current_procinfo.CurrExitLabel) + else + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrExitLabel); + end; + + +{***************************************************************************** + SecondBreakN +*****************************************************************************} + + procedure tcgbreaknode.pass_generate_code; + begin + location_reset(location,LOC_VOID,OS_NO); + + include(flowcontrol,fc_break); + if current_procinfo.CurrBreakLabel<>nil then + begin +{$ifdef OLDREGVARS} + load_all_regvars(current_asmdata.CurrAsmList); +{$endif OLDREGVARS} + if (fc_unwind in flowcontrol) then + cg.g_local_unwind(current_asmdata.CurrAsmList,current_procinfo.CurrBreakLabel) + else + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrBreakLabel) + end + else + CGMessage(cg_e_break_not_allowed); + end; + + +{***************************************************************************** + SecondContinueN +*****************************************************************************} + + procedure tcgcontinuenode.pass_generate_code; + begin + location_reset(location,LOC_VOID,OS_NO); + + include(flowcontrol,fc_continue); + if current_procinfo.CurrContinueLabel<>nil then + begin +{$ifdef OLDREGVARS} + load_all_regvars(current_asmdata.CurrAsmList); +{$endif OLDREGVARS} + if (fc_unwind in flowcontrol) then + cg.g_local_unwind(current_asmdata.CurrAsmList,current_procinfo.CurrContinueLabel) + else + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrContinueLabel) + end + else + CGMessage(cg_e_continue_not_allowed); + end; + + +{***************************************************************************** + SecondGoto +*****************************************************************************} + + procedure tcggotonode.pass_generate_code; + + begin + location_reset(location,LOC_VOID,OS_NO); + + include(flowcontrol,fc_gotolabel); +{$ifdef OLDREGVARS} + load_all_regvars(current_asmdata.CurrAsmList); +{$endif OLDREGVARS} + cg.a_jmp_always(current_asmdata.CurrAsmList,tcglabelnode(labelnode).getasmlabel) + end; + + +{***************************************************************************** + SecondLabel +*****************************************************************************} + + function tcglabelnode.getasmlabel : tasmlabel; + begin + if not(assigned(asmlabel)) then + { labsym is not set in inlined procedures, but since assembler } + { routines can't be inlined, that shouldn't matter } + if assigned(labsym) and + labsym.nonlocal then + current_asmdata.getglobaljumplabel(asmlabel) + else + current_asmdata.getjumplabel(asmlabel); + result:=asmlabel + end; + + + procedure tcglabelnode.pass_generate_code; + begin + location_reset(location,LOC_VOID,OS_NO); + + include(flowcontrol,fc_gotolabel); +{$ifdef OLDREGVARS} + load_all_regvars(current_asmdata.CurrAsmList); +{$endif OLDREGVARS} + cg.a_label(current_asmdata.CurrAsmList,getasmlabel); + + { Write also extra label if this label was referenced from + assembler block } + if assigned(labsym) and + assigned(labsym.asmblocklabel) then + cg.a_label(current_asmdata.CurrAsmList,labsym.asmblocklabel); + + secondpass(left); + end; + + +{***************************************************************************** + SecondRaise +*****************************************************************************} + + procedure tcgraisenode.pass_generate_code; + + var + a : tasmlabel; + href2: treference; + 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); + location_reset(location,LOC_VOID,OS_NO); + + if assigned(left) then + begin + { multiple parameters? } + if assigned(right) then + begin + { frame tree } + if assigned(third) then + secondpass(third); + secondpass(right); + end; + secondpass(left); + if codegenerror then + exit; + + { Push parameters } + if assigned(right) then + begin + { frame tree } + if assigned(third) then + cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,third.location,paraloc3) + else + cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_INT,0,paraloc3); + { push address } + cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,right.location,paraloc2); + end + else + begin + { get current address } + current_asmdata.getaddrlabel(a); + cg.a_label(current_asmdata.CurrAsmList,a); + reference_reset_symbol(href2,a,0,1); + { push current frame } + cg.a_load_reg_cgpara(current_asmdata.CurrAsmList,OS_ADDR,NR_FRAME_POINTER_REG,paraloc3); + { push current address } + if target_info.system <> system_powerpc_macos then + cg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,href2,paraloc2) + else + cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_INT,0,paraloc2); + end; + cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,left.location,paraloc1); + paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1); + paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc2); + paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc3); + cg.allocallcpuregisters(current_asmdata.CurrAsmList); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RAISEEXCEPTION',false); + cg.deallocallcpuregisters(current_asmdata.CurrAsmList); + end + else + begin + cg.allocallcpuregisters(current_asmdata.CurrAsmList); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK',false); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false); + cg.deallocallcpuregisters(current_asmdata.CurrAsmList); + end; + paraloc1.done; + paraloc2.done; + paraloc3.done; + end; + + +{***************************************************************************** + SecondTryExcept +*****************************************************************************} + + var + endexceptlabel : tasmlabel; + + + { does the necessary things to clean up the object stack } + { in the except block } + procedure cleanupobjectstack; + begin + cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION'); + end; + + { generates code to be executed when another exeception is raised while + control is inside except block } + procedure handle_nested_exception(list:TAsmList;const t:texceptiontemps;entrylabel:TAsmLabel); + var + exitlabel: tasmlabel; + begin + { don't generate line info for internal cleanup } + list.concat(tai_marker.create(mark_NoLineInfoStart)); + current_asmdata.getjumplabel(exitlabel); + cg.a_label(list,entrylabel); + free_exception(list,t,0,exitlabel,false); + { we don't need to save/restore registers here because reraise never } + { returns } + cg.a_call_name(list,'FPC_RAISE_NESTED',false); + cg.a_label(list,exitlabel); + cleanupobjectstack; + end; + + + procedure tcgtryexceptnode.pass_generate_code; + + var + exceptlabel,doexceptlabel,oldendexceptlabel, + lastonlabel, + exitexceptlabel, + continueexceptlabel, + breakexceptlabel, + exittrylabel, + continuetrylabel, + breaktrylabel, + doobjectdestroyandreraise, + oldCurrExitLabel, + oldContinueLabel, + oldBreakLabel : tasmlabel; + oldflowcontrol,tryflowcontrol, + exceptflowcontrol : tflowcontrol; + destroytemps, + excepttemps : texceptiontemps; + label + errorexit; + begin + location_reset(location,LOC_VOID,OS_NO); + + oldflowcontrol:=flowcontrol; + flowcontrol:=[fc_inflowcontrol]; + { this can be called recursivly } + oldBreakLabel:=nil; + oldContinueLabel:=nil; + oldendexceptlabel:=endexceptlabel; + + { save the old labels for control flow statements } + oldCurrExitLabel:=current_procinfo.CurrExitLabel; + if assigned(current_procinfo.CurrBreakLabel) then + begin + oldContinueLabel:=current_procinfo.CurrContinueLabel; + oldBreakLabel:=current_procinfo.CurrBreakLabel; + end; + + { get new labels for the control flow statements } + current_asmdata.getjumplabel(exittrylabel); + current_asmdata.getjumplabel(exitexceptlabel); + if assigned(current_procinfo.CurrBreakLabel) then + begin + current_asmdata.getjumplabel(breaktrylabel); + current_asmdata.getjumplabel(continuetrylabel); + current_asmdata.getjumplabel(breakexceptlabel); + current_asmdata.getjumplabel(continueexceptlabel); + end; + + current_asmdata.getjumplabel(exceptlabel); + current_asmdata.getjumplabel(doexceptlabel); + current_asmdata.getjumplabel(endexceptlabel); + current_asmdata.getjumplabel(lastonlabel); + + get_exception_temps(current_asmdata.CurrAsmList,excepttemps); + new_exception(current_asmdata.CurrAsmList,excepttemps,exceptlabel); + + { try block } + { set control flow labels for the try block } + current_procinfo.CurrExitLabel:=exittrylabel; + if assigned(oldBreakLabel) then + begin + current_procinfo.CurrContinueLabel:=continuetrylabel; + current_procinfo.CurrBreakLabel:=breaktrylabel; + end; + + flowcontrol:=[fc_inflowcontrol]; + secondpass(left); + tryflowcontrol:=flowcontrol; + if codegenerror then + goto errorexit; + + { don't generate line info for internal cleanup } + current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart)); + + cg.a_label(current_asmdata.CurrAsmList,exceptlabel); + + free_exception(current_asmdata.CurrAsmList, excepttemps, 0, endexceptlabel, false); + + cg.a_label(current_asmdata.CurrAsmList,doexceptlabel); + + { end cleanup } + current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd)); + + { set control flow labels for the except block } + { and the on statements } + current_procinfo.CurrExitLabel:=exitexceptlabel; + if assigned(oldBreakLabel) then + begin + current_procinfo.CurrContinueLabel:=continueexceptlabel; + current_procinfo.CurrBreakLabel:=breakexceptlabel; + end; + + flowcontrol:=[fc_inflowcontrol]; + { on statements } + if assigned(right) then + secondpass(right); + + { don't generate line info for internal cleanup } + current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart)); + + cg.a_label(current_asmdata.CurrAsmList,lastonlabel); + { default handling except handling } + if assigned(t1) then + begin + { FPC_CATCHES with 'default handler' flag (=-1) need no longer be called, + it doesn't change any state and its return value is ignored (Sergei) + } + + { the destruction of the exception object must be also } + { guarded by an exception frame, but it can be omitted } + { if there's no user code in 'except' block } + + if not (has_no_code(t1)) then + begin + current_asmdata.getjumplabel(doobjectdestroyandreraise); + + get_exception_temps(current_asmdata.CurrAsmList,destroytemps); + new_exception(current_asmdata.CurrAsmList,destroytemps,doobjectdestroyandreraise); + + { except block needs line info } + current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd)); + + { here we don't have to reset flowcontrol } + { the default and on flowcontrols are handled equal } + secondpass(t1); + exceptflowcontrol:=flowcontrol; + + handle_nested_exception(current_asmdata.CurrAsmList,destroytemps,doobjectdestroyandreraise); + + unget_exception_temps(current_asmdata.CurrAsmList,destroytemps); + cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel); + end + else + begin + exceptflowcontrol:=flowcontrol; + cleanupobjectstack; + cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel); + end; + end + else + begin + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false); + exceptflowcontrol:=flowcontrol; + end; + + if fc_exit in exceptflowcontrol then + begin + { do some magic for exit in the try block } + cg.a_label(current_asmdata.CurrAsmList,exitexceptlabel); + { we must also destroy the address frame which guards } + { exception object } + cg.g_call(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK'); + cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf); + cleanupobjectstack; + cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel); + { from g_exception_reason_load } + cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG); + end; + + if fc_break in exceptflowcontrol then + begin + cg.a_label(current_asmdata.CurrAsmList,breakexceptlabel); + { we must also destroy the address frame which guards } + { exception object } + cg.g_call(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK'); + cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf); + cleanupobjectstack; + cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel); + { from g_exception_reason_load } + cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG); + end; + + if fc_continue in exceptflowcontrol then + begin + cg.a_label(current_asmdata.CurrAsmList,continueexceptlabel); + { we must also destroy the address frame which guards } + { exception object } + cg.g_call(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK'); + cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf); + cleanupobjectstack; + cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel); + { from g_exception_reason_load } + cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG); + end; + + if fc_exit in tryflowcontrol then + begin + { do some magic for exit in the try block } + cg.a_label(current_asmdata.CurrAsmList,exittrylabel); + cg.g_call(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK'); + cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf); + cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel); + { from g_exception_reason_load } + cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG); + end; + + if fc_break in tryflowcontrol then + begin + cg.a_label(current_asmdata.CurrAsmList,breaktrylabel); + cg.g_call(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK'); + cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf); + cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel); + { from g_exception_reason_load } + cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG); + end; + + if fc_continue in tryflowcontrol then + begin + cg.a_label(current_asmdata.CurrAsmList,continuetrylabel); + cg.g_call(current_asmdata.CurrAsmList,'FPC_POPADDRSTACK'); + cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf); + cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel); + { from g_exception_reason_load } + cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG); + end; + unget_exception_temps(current_asmdata.CurrAsmList,excepttemps); + cg.a_label(current_asmdata.CurrAsmList,endexceptlabel); + + { end cleanup } + current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd)); + + errorexit: + { restore all saved labels } + endexceptlabel:=oldendexceptlabel; + + { restore the control flow labels } + current_procinfo.CurrExitLabel:=oldCurrExitLabel; + if assigned(oldBreakLabel) then + begin + current_procinfo.CurrContinueLabel:=oldContinueLabel; + current_procinfo.CurrBreakLabel:=oldBreakLabel; + end; + + { return all used control flow statements } + flowcontrol:=oldflowcontrol+(exceptflowcontrol + + tryflowcontrol - [fc_inflowcontrol]); + end; + + + procedure tcgonnode.pass_generate_code; + var + nextonlabel, + exitonlabel, + continueonlabel, + breakonlabel, + oldCurrExitLabel, + oldContinueLabel, + doobjectdestroyandreraise, + oldBreakLabel : tasmlabel; + oldflowcontrol : tflowcontrol; + excepttemps : texceptiontemps; + href2: treference; + paraloc1 : tcgpara; + exceptvarsym : tlocalvarsym; + begin + paraloc1.init; + location_reset(location,LOC_VOID,OS_NO); + + oldflowcontrol:=flowcontrol; + flowcontrol:=[fc_inflowcontrol]; + current_asmdata.getjumplabel(nextonlabel); + + { send the vmt parameter } + reference_reset_symbol(href2,current_asmdata.RefAsmSymbol(excepttype.vmt_mangledname),0,sizeof(pint)); + paramanager.getintparaloc(pocall_default,1,paraloc1); + cg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,href2,paraloc1); + paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1); + cg.g_call(current_asmdata.CurrAsmList,'FPC_CATCHES'); + + cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG); + { is it this catch? No. go to next onlabel } + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_ADDR,OC_EQ,0,NR_FUNCTION_RESULT_REG,nextonlabel); + + { Retrieve exception variable } + if assigned(excepTSymtable) then + exceptvarsym:=tlocalvarsym(excepTSymtable.SymList[0]) + else + exceptvarsym:=nil; + + if assigned(exceptvarsym) then + begin + exceptvarsym.localloc.loc:=LOC_REFERENCE; + exceptvarsym.localloc.size:=OS_ADDR; + tg.GetLocal(current_asmdata.CurrAsmList,sizeof(pint),voidpointertype,exceptvarsym.localloc.reference); + cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,exceptvarsym.localloc.reference); + end; + cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG); + + { in the case that another exception is risen + we've to destroy the old one } + current_asmdata.getjumplabel(doobjectdestroyandreraise); + + { call setjmp, and jump to finally label on non-zero result } + get_exception_temps(current_asmdata.CurrAsmList,excepttemps); + new_exception(current_asmdata.CurrAsmList,excepttemps,doobjectdestroyandreraise); + + oldBreakLabel:=nil; + oldContinueLabel:=nil; + if assigned(right) then + begin + oldCurrExitLabel:=current_procinfo.CurrExitLabel; + current_asmdata.getjumplabel(exitonlabel); + current_procinfo.CurrExitLabel:=exitonlabel; + if assigned(current_procinfo.CurrBreakLabel) then + begin + oldContinueLabel:=current_procinfo.CurrContinueLabel; + oldBreakLabel:=current_procinfo.CurrBreakLabel; + current_asmdata.getjumplabel(breakonlabel); + current_asmdata.getjumplabel(continueonlabel); + current_procinfo.CurrContinueLabel:=continueonlabel; + current_procinfo.CurrBreakLabel:=breakonlabel; + end; + + secondpass(right); + end; + + handle_nested_exception(current_asmdata.CurrAsmList,excepttemps,doobjectdestroyandreraise); + + { clear some stuff } + if assigned(exceptvarsym) then + begin + tg.UngetLocal(current_asmdata.CurrAsmList,exceptvarsym.localloc.reference); + exceptvarsym.localloc.loc:=LOC_INVALID; + end; + cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel); + + if assigned(right) then + begin + { special handling for control flow instructions } + if fc_exit in flowcontrol then + begin + { the address and object pop does secondtryexcept } + cg.a_label(current_asmdata.CurrAsmList,exitonlabel); + cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel); + end; + + if fc_break in flowcontrol then + begin + { the address and object pop does secondtryexcept } + cg.a_label(current_asmdata.CurrAsmList,breakonlabel); + cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel); + end; + + if fc_continue in flowcontrol then + begin + { the address and object pop does secondtryexcept } + cg.a_label(current_asmdata.CurrAsmList,continueonlabel); + cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel); + end; + + current_procinfo.CurrExitLabel:=oldCurrExitLabel; + if assigned(oldBreakLabel) then + begin + current_procinfo.CurrContinueLabel:=oldContinueLabel; + current_procinfo.CurrBreakLabel:=oldBreakLabel; + end; + end; + + unget_exception_temps(current_asmdata.CurrAsmList,excepttemps); + cg.a_label(current_asmdata.CurrAsmList,nextonlabel); + flowcontrol:=oldflowcontrol+(flowcontrol-[fc_inflowcontrol]); + paraloc1.done; + current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd)); + + { next on node } + if assigned(left) then + secondpass(left); + end; + +{***************************************************************************** + SecondTryFinally +*****************************************************************************} + + procedure tcgtryfinallynode.handle_safecall_exception; + var + cgpara: tcgpara; + selfsym: tparavarsym; + begin + { call fpc_safecallhandler, passing self for methods of classes, + nil otherwise. } + cgpara.init; + paramanager.getintparaloc(pocall_default,1,cgpara); + if is_class(current_procinfo.procdef.struct) then + begin + selfsym:=tparavarsym(current_procinfo.procdef.parast.Find('self')); + if (selfsym=nil) or (selfsym.typ<>paravarsym) then + InternalError(2011123101); + cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,selfsym.localloc,cgpara); + end + else + cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_ADDR,0,cgpara); + paramanager.freecgpara(current_asmdata.CurrAsmList,cgpara); + cgpara.done; + cg.g_call(current_asmdata.CurrAsmList,'FPC_SAFECALLHANDLER'); + end; + + procedure tcgtryfinallynode.pass_generate_code; + var + reraiselabel, + finallylabel, + endfinallylabel, + exitfinallylabel, + continuefinallylabel, + breakfinallylabel, + oldCurrExitLabel, + oldContinueLabel, + oldBreakLabel : tasmlabel; + oldflowcontrol,tryflowcontrol : tflowcontrol; + decconst : longint; + excepttemps : texceptiontemps; + begin + location_reset(location,LOC_VOID,OS_NO); + + { check if child nodes do a break/continue/exit } + oldflowcontrol:=flowcontrol; + flowcontrol:=[fc_inflowcontrol]; + current_asmdata.getjumplabel(finallylabel); + current_asmdata.getjumplabel(endfinallylabel); + current_asmdata.getjumplabel(reraiselabel); + + { the finally block must catch break, continue and exit } + { statements } + oldCurrExitLabel:=current_procinfo.CurrExitLabel; + if implicitframe then + exitfinallylabel:=finallylabel + else + current_asmdata.getjumplabel(exitfinallylabel); + current_procinfo.CurrExitLabel:=exitfinallylabel; + if assigned(current_procinfo.CurrBreakLabel) then + begin + oldContinueLabel:=current_procinfo.CurrContinueLabel; + oldBreakLabel:=current_procinfo.CurrBreakLabel; + if implicitframe then + begin + breakfinallylabel:=finallylabel; + continuefinallylabel:=finallylabel; + end + else + begin + current_asmdata.getjumplabel(breakfinallylabel); + current_asmdata.getjumplabel(continuefinallylabel); + end; + current_procinfo.CurrContinueLabel:=continuefinallylabel; + current_procinfo.CurrBreakLabel:=breakfinallylabel; + end; + + { call setjmp, and jump to finally label on non-zero result } + get_exception_temps(current_asmdata.CurrAsmList,excepttemps); + new_exception(current_asmdata.CurrAsmList,excepttemps,finallylabel); + + { try code } + if assigned(left) then + begin + secondpass(left); + tryflowcontrol:=flowcontrol; + if codegenerror then + exit; + end; + + { don't generate line info for internal cleanup } + current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart)); + + cg.a_label(current_asmdata.CurrAsmList,finallylabel); + { just free the frame information } + free_exception(current_asmdata.CurrAsmList,excepttemps,1,finallylabel,true); + + { end cleanup } + current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd)); + + { finally code } + flowcontrol:=[fc_inflowcontrol]; + secondpass(right); + { goto is allowed if it stays inside the finally block, + this is checked using the exception block number } + if (flowcontrol-[fc_gotolabel])<>[fc_inflowcontrol] then + CGMessage(cg_e_control_flow_outside_finally); + if codegenerror then + exit; + + { don't generate line info for internal cleanup } + current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoStart)); + + { the value should now be in the exception handler } + cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf); + if implicitframe then + begin + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,endfinallylabel); + { from g_exception_reason_load } + cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG); + { finally code only needed to be executed on exception } + flowcontrol:=[fc_inflowcontrol]; + secondpass(t1); + if flowcontrol<>[fc_inflowcontrol] then + CGMessage(cg_e_control_flow_outside_finally); + if codegenerror then + exit; +{$if defined(x86) or defined(arm)} + if (tf_safecall_exceptions in target_info.flags) and + (current_procinfo.procdef.proccalloption=pocall_safecall) then + handle_safecall_exception + else +{$endif} + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false); + end + else + begin + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,endfinallylabel); + if (tryflowcontrol*[fc_exit,fc_break,fc_continue]<>[]) then + begin + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,1,NR_FUNCTION_RESULT_REG); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,reraiselabel); + if fc_exit in tryflowcontrol then + begin + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,1,NR_FUNCTION_RESULT_REG); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,oldCurrExitLabel); + decconst:=1; + end + else + decconst:=2; + if fc_break in tryflowcontrol then + begin + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,decconst,NR_FUNCTION_RESULT_REG); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,oldBreakLabel); + decconst:=1; + end + else + inc(decconst); + if fc_continue in tryflowcontrol then + begin + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,decconst,NR_FUNCTION_RESULT_REG); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,NR_FUNCTION_RESULT_REG,oldContinueLabel); + end; + end; + cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG); + cg.a_label(current_asmdata.CurrAsmList,reraiselabel); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE',false); + { do some magic for exit,break,continue in the try block } + if fc_exit in tryflowcontrol then + begin + cg.a_label(current_asmdata.CurrAsmList,exitfinallylabel); + cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf); + cg.g_exception_reason_save_const(current_asmdata.CurrAsmList,excepttemps.reasonbuf,2); + cg.a_jmp_always(current_asmdata.CurrAsmList,finallylabel); + { from g_exception_reason_load } + cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG); + end; + if fc_break in tryflowcontrol then + begin + cg.a_label(current_asmdata.CurrAsmList,breakfinallylabel); + cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf); + cg.g_exception_reason_save_const(current_asmdata.CurrAsmList,excepttemps.reasonbuf,3); + cg.a_jmp_always(current_asmdata.CurrAsmList,finallylabel); + { from g_exception_reason_load } + cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG); + end; + if fc_continue in tryflowcontrol then + begin + cg.a_label(current_asmdata.CurrAsmList,continuefinallylabel); + cg.g_exception_reason_load(current_asmdata.CurrAsmList,excepttemps.reasonbuf); + cg.g_exception_reason_save_const(current_asmdata.CurrAsmList,excepttemps.reasonbuf,4); + cg.a_jmp_always(current_asmdata.CurrAsmList,finallylabel); + { from g_exception_reason_load } + cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG); + end; + end; + unget_exception_temps(current_asmdata.CurrAsmList,excepttemps); + cg.a_label(current_asmdata.CurrAsmList,endfinallylabel); + + { end cleanup } + current_asmdata.CurrAsmList.concat(tai_marker.create(mark_NoLineInfoEnd)); + + current_procinfo.CurrExitLabel:=oldCurrExitLabel; + if assigned(current_procinfo.CurrBreakLabel) then + begin + current_procinfo.CurrContinueLabel:=oldContinueLabel; + current_procinfo.CurrBreakLabel:=oldBreakLabel; + end; + flowcontrol:=oldflowcontrol+(tryflowcontrol-[fc_inflowcontrol]); + end; + + +begin + cwhilerepeatnode:=tcgwhilerepeatnode; + cifnode:=tcgifnode; + cfornode:=tcgfornode; + cexitnode:=tcgexitnode; + cbreaknode:=tcgbreaknode; + ccontinuenode:=tcgcontinuenode; + cgotonode:=tcggotonode; + clabelnode:=tcglabelnode; + craisenode:=tcgraisenode; + ctryexceptnode:=tcgtryexceptnode; + ctryfinallynode:=tcgtryfinallynode; + connode:=tcgonnode; +end. diff --git a/closures/compiler/ncginl.pas b/closures/compiler/ncginl.pas new file mode 100644 index 0000000000..d2b8d84a8f --- /dev/null +++ b/closures/compiler/ncginl.pas @@ -0,0 +1,835 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl and Carl Eric Codere + + Generate generic 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 ncginl; + +{$i fpcdefs.inc} + +interface + + uses + node,ninl; + + type + tcginlinenode = class(tinlinenode) + procedure pass_generate_code;override; + procedure second_assert;virtual; + procedure second_sizeoftypeof;virtual; + procedure second_length;virtual; + procedure second_predsucc;virtual; + procedure second_incdec;virtual; + procedure second_typeinfo;virtual; + procedure second_includeexclude;virtual; + procedure second_pi; virtual; + procedure second_arctan_real; virtual; + procedure second_abs_real; virtual; + procedure second_sqr_real; virtual; + procedure second_sqrt_real; virtual; + procedure second_ln_real; virtual; + procedure second_cos_real; virtual; + procedure second_sin_real; virtual; + procedure second_assigned; virtual; + procedure second_get_frame;virtual; + procedure second_get_caller_frame;virtual; + procedure second_get_caller_addr;virtual; + procedure second_prefetch; virtual; + procedure second_round_real; virtual; + procedure second_trunc_real; virtual; + procedure second_abs_long; virtual; + procedure second_rox; virtual; + procedure second_sar; virtual; + procedure second_bsfbsr; virtual; + end; + +implementation + + uses + globtype,systems,constexp, + cutils,verbose,globals,fmodule, + symconst,symdef,defutil,symsym, + aasmbase,aasmtai,aasmdata,aasmcpu,parabase, + cgbase,pass_1,pass_2, + cpuinfo,cpubase,paramgr,procinfo, + nbas,ncon,ncal,ncnv,nld,ncgrtti, + tgobj,ncgutil, + cgutils,cgobj +{$ifndef cpu64bitalu} + ,cg64f32 +{$endif not cpu64bitalu} + ; + + +{***************************************************************************** + TCGINLINENODE +*****************************************************************************} + + + procedure tcginlinenode.pass_generate_code; + begin + location_reset(location,LOC_VOID,OS_NO); + + case inlinenumber of + in_assert_x_y: + second_Assert; + in_sizeof_x, + in_typeof_x : + second_SizeofTypeOf; + in_length_x : + second_Length; + in_pred_x, + in_succ_x: + second_PredSucc; + in_dec_x, + in_inc_x : + second_IncDec; + in_typeinfo_x: + second_TypeInfo; + in_include_x_y, + in_exclude_x_y: + second_IncludeExclude; + in_pi_real: + second_pi; + in_sin_real: + second_sin_real; + in_arctan_real: + second_arctan_real; + in_abs_real: + second_abs_real; + in_abs_long: + second_abs_long; + in_round_real: + second_round_real; + in_trunc_real: + second_trunc_real; + in_sqr_real: + second_sqr_real; + in_sqrt_real: + second_sqrt_real; + in_ln_real: + second_ln_real; + in_cos_real: + second_cos_real; + in_prefetch_var: + second_prefetch; + in_assigned_x: + second_assigned; + in_get_frame: + second_get_frame; + in_get_caller_frame: + second_get_caller_frame; + in_get_caller_addr: + second_get_caller_addr; + in_unaligned_x: + begin + secondpass(tcallparanode(left).left); + location:=tcallparanode(left).left.location; + if location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then + location.reference.alignment:=1; + end; +{$ifdef SUPPORT_MMX} + in_mmx_pcmpeqb..in_mmx_pcmpgtw: + begin + location_reset(location,LOC_MMXREGISTER,OS_NO); + if left.location.loc=LOC_REGISTER then + begin + {!!!!!!!} + end + else if tcallparanode(left).left.location.loc=LOC_REGISTER then + begin + {!!!!!!!} + end + else + begin + {!!!!!!!} + end; + end; +{$endif SUPPORT_MMX} + in_rol_x, + in_rol_x_y, + in_ror_x, + in_ror_x_y: + second_rox; + in_sar_x, + in_sar_x_y: + second_sar; + in_bsf_x, + in_bsr_x: + second_BsfBsr; + else internalerror(9); + end; + end; + + +{***************************************************************************** + ASSERT GENERIC HANDLING +*****************************************************************************} + procedure tcginlinenode.second_Assert; + var + hp2,hp3 : tnode; + otlabel,oflabel : tasmlabel; + paraloc1,paraloc2, + paraloc3,paraloc4 : tcgpara; + begin + { the node should be removed in the firstpass } + if not (cs_do_assertion in current_settings.localswitches) then + internalerror(7123458); + paraloc1.init; + paraloc2.init; + paraloc3.init; + paraloc4.init; + paramanager.getintparaloc(pocall_default,1,paraloc1); + paramanager.getintparaloc(pocall_default,2,paraloc2); + paramanager.getintparaloc(pocall_default,3,paraloc3); + paramanager.getintparaloc(pocall_default,4,paraloc4); + otlabel:=current_procinfo.CurrTrueLabel; + oflabel:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + secondpass(tcallparanode(left).left); + maketojumpbool(current_asmdata.CurrAsmList,tcallparanode(left).left,lr_load_regvars); + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + { First call secondpass() before we can push the parameters, otherwise + parameters allocated in the registers can be destroyed } + { generate filename string parameter } + hp2:=ctypeconvnode.create(cstringconstnode.createstr(current_module.sourcefiles.get_file_name(current_filepos.fileindex)),cshortstringtype); + firstpass(hp2); + secondpass(hp2); + if codegenerror then + exit; + { message parameter } + hp3:=tcallparanode(tcallparanode(left).right).left; + secondpass(hp3); + if codegenerror then + exit; + { push erroraddr } + cg.a_load_reg_cgpara(current_asmdata.CurrAsmList,OS_ADDR,NR_FRAME_POINTER_REG,paraloc4); + { push lineno } + cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_INT,current_filepos.line,paraloc3); + { push filename } + cg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,hp2.location.reference,paraloc2); + { push msg } + cg.a_loadaddr_ref_cgpara(current_asmdata.CurrAsmList,hp3.location.reference,paraloc1); + { call } + paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1); + paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc2); + paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc3); + paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc4); + cg.allocallcpuregisters(current_asmdata.CurrAsmList); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_ASSERT',false); + cg.deallocallcpuregisters(current_asmdata.CurrAsmList); + location_freetemp(current_asmdata.CurrAsmList,hp3.location); + location_freetemp(current_asmdata.CurrAsmList,hp2.location); + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel); + current_procinfo.CurrTrueLabel:=otlabel; + current_procinfo.CurrFalseLabel:=oflabel; + paraloc1.done; + paraloc2.done; + paraloc3.done; + paraloc4.done; + hp2.free; + end; + + +{***************************************************************************** + SIZEOF / TYPEOF GENERIC HANDLING +*****************************************************************************} + + { second_handle_ the sizeof and typeof routines } + procedure tcginlinenode.second_SizeOfTypeOf; + var + href, + hrefvmt : treference; + hregister : tregister; + begin + if inlinenumber=in_sizeof_x then + location_reset(location,LOC_REGISTER,def_cgsize(resultdef)) + else + location_reset(location,LOC_REGISTER,OS_ADDR); + { for both cases load vmt } + if left.nodetype=typen then + begin + hregister:=cg.getaddressregister(current_asmdata.CurrAsmList); + reference_reset_symbol(href,current_asmdata.RefAsmSymbol(tobjectdef(left.resultdef).vmt_mangledname),0,sizeof(pint)); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,href,hregister); + end + else + begin + secondpass(left); + hregister:=cg.getaddressregister(current_asmdata.CurrAsmList); + + { handle self inside a method of a class } + case left.location.loc of + LOC_CREGISTER, + LOC_REGISTER : + begin + if (left.resultdef.typ=classrefdef) or + (po_staticmethod in current_procinfo.procdef.procoptions) then + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.register,hregister) + else + begin + { load VMT pointer } + reference_reset_base(hrefvmt,left.location.register,tobjectdef(left.resultdef).vmt_offset,sizeof(pint)); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,hrefvmt,hregister); + end + end; + LOC_REFERENCE, + LOC_CREFERENCE : + begin + if is_class(left.resultdef) then + begin + { deref class } + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.reference,hregister); + cg.g_maybe_testself(current_asmdata.CurrAsmList,hregister); + { load VMT pointer } + reference_reset_base(hrefvmt,hregister,tobjectdef(left.resultdef).vmt_offset,sizeof(pint)); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,hrefvmt,hregister); + end + else + begin + { load VMT pointer, but not for classrefdefs } + if (left.resultdef.typ=objectdef) then + begin + inc(left.location.reference.offset,tobjectdef(left.resultdef).vmt_offset); + left.location.reference.alignment:=newalignment(left.location.reference.alignment,tobjectdef(left.resultdef).vmt_offset); + end; + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.reference,hregister); + end; + end; + else + internalerror(200301301); + end; + end; + { in sizeof load size } + if inlinenumber=in_sizeof_x then + begin + reference_reset_base(href,hregister,0,sizeof(pint)); + hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,href,hregister); + end; + location.register:=hregister; + end; + + +{***************************************************************************** + LENGTH GENERIC HANDLING +*****************************************************************************} + + procedure tcginlinenode.second_Length; + var + lengthlab : tasmlabel; + hregister : tregister; + href : treference; + begin + secondpass(left); + if is_shortstring(left.resultdef) then + begin + location_copy(location,left.location); + location.size:=OS_8; + end + else + begin + { length in ansi/wide strings is at offset -sizeof(pint) } + location_force_reg(current_asmdata.CurrAsmList,left.location,OS_ADDR,false); + current_asmdata.getjumplabel(lengthlab); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_ADDR,OC_EQ,0,left.location.register,lengthlab); + if is_widestring(left.resultdef) and (tf_winlikewidestring in target_info.flags) then + begin + reference_reset_base(href,left.location.register,-sizeof(dword),sizeof(dword)); + hregister:=cg.makeregsize(current_asmdata.CurrAsmList,left.location.register,OS_INT); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_32,OS_INT,href,hregister); + end + else + begin + reference_reset_base(href,left.location.register,-sizeof(pint),sizeof(pint)); + hregister:=cg.makeregsize(current_asmdata.CurrAsmList,left.location.register,OS_INT); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,href,hregister); + end; + if is_widestring(left.resultdef) then + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHR,OS_INT,1,hregister); + cg.a_label(current_asmdata.CurrAsmList,lengthlab); + location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); + location.register:=hregister; + end; + end; + + +{***************************************************************************** + PRED/SUCC GENERIC HANDLING +*****************************************************************************} + + procedure tcginlinenode.second_PredSucc; + var + cgsize : TCGSize; + cgop : topcg; + begin + secondpass(left); + if inlinenumber=in_pred_x then + cgop:=OP_SUB + else + cgop:=OP_ADD; + cgsize:=def_cgsize(resultdef); + + { we need a value in a register } + location_copy(location,left.location); + location_force_reg(current_asmdata.CurrAsmList,location,cgsize,false); + +{$ifndef cpu64bitalu} + if cgsize in [OS_64,OS_S64] then + cg64.a_op64_const_reg(current_asmdata.CurrAsmList,cgop,cgsize,1,location.register64) + else +{$endif not cpu64bitalu} + cg.a_op_const_reg(current_asmdata.CurrAsmList,cgop,location.size,1,location.register); + end; + + +{***************************************************************************** + INC/DEC GENERIC HANDLING +*****************************************************************************} + procedure tcginlinenode.second_IncDec; + const + addsubop:array[in_inc_x..in_dec_x] of TOpCG=(OP_ADD,OP_SUB); + var + addvalue : TConstExprInt; + addconstant : boolean; +{$ifndef cpu64bitalu} + hregisterhi, +{$endif not cpu64bitalu} + hregister : tregister; + cgsize : tcgsize; + begin + { set defaults } + addconstant:=true; + { first secondpass second argument, because if the first arg } + { is used in that expression then SSL may move it to another } + { register } + if assigned(tcallparanode(left).right) then + secondpass(tcallparanode(tcallparanode(left).right).left); + { load first parameter, must be a reference } + secondpass(tcallparanode(left).left); + cgsize:=def_cgsize(tcallparanode(left).left.resultdef); + { get addvalue } + case tcallparanode(left).left.resultdef.typ of + orddef, + enumdef : + addvalue:=1; + pointerdef : + begin + if is_void(tpointerdef(tcallparanode(left).left.resultdef).pointeddef) then + addvalue:=1 + else + addvalue:=tpointerdef(tcallparanode(left).left.resultdef).pointeddef.size; + end; + else + internalerror(10081); + end; + { second_ argument specified?, must be a s32bit in register } + if assigned(tcallparanode(left).right) then + begin + { when constant, just multiply the addvalue } + if is_constintnode(tcallparanode(tcallparanode(left).right).left) then + addvalue:=addvalue*get_ordinal_value(tcallparanode(tcallparanode(left).right).left) + else if is_constpointernode(tcallparanode(tcallparanode(left).right).left) then + addvalue:=addvalue*tpointerconstnode(tcallparanode(tcallparanode(left).right).left).value + else + begin + location_force_reg(current_asmdata.CurrAsmList,tcallparanode(tcallparanode(left).right).left.location,cgsize,addvalue<=1); + hregister:=tcallparanode(tcallparanode(left).right).left.location.register; +{$ifndef cpu64bitalu} + hregisterhi:=tcallparanode(tcallparanode(left).right).left.location.register64.reghi; +{$endif not cpu64bitalu} + { insert multiply with addvalue if its >1 } + if addvalue>1 then + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_IMUL,cgsize,addvalue.svalue,hregister); + addconstant:=false; + end; + end; + { write the add instruction } + if addconstant then + begin +{$ifndef cpu64bitalu} + if cgsize in [OS_64,OS_S64] then + cg64.a_op64_const_loc(current_asmdata.CurrAsmList,addsubop[inlinenumber],cgsize,addvalue,tcallparanode(left).left.location) + else +{$endif not cpu64bitalu} + cg.a_op_const_loc(current_asmdata.CurrAsmList,addsubop[inlinenumber], + aint(addvalue.svalue),tcallparanode(left).left.location); + end + else + begin +{$ifndef cpu64bitalu} + if cgsize in [OS_64,OS_S64] then + cg64.a_op64_reg_loc(current_asmdata.CurrAsmList,addsubop[inlinenumber],cgsize, + joinreg64(hregister,hregisterhi),tcallparanode(left).left.location) + else +{$endif not cpu64bitalu} + cg.a_op_reg_loc(current_asmdata.CurrAsmList,addsubop[inlinenumber], + hregister,tcallparanode(left).left.location); + end; + { no overflow checking for pointers (see ninl), and range checking } + { is not applicable for them } + if (tcallparanode(left).left.resultdef.typ <> pointerdef) then + begin + { things which can overflow must NOT pass via here, but have to be } + { handled via a regular add node (conversion in tinlinenode.pass_1) } + { Or someone has to rewrite the above to use a_op_const_reg_reg_ov } + { and friends in case of overflow checking, and ask everyone to } + { implement these methods since they don't exist for all cpus (JM) } + { Similarly, range checking also has to be handled separately, } + { see mantis #14841 (JM) } + if ([cs_check_overflow,cs_check_range] * current_settings.localswitches <> []) then + internalerror(2006111010); +// cg.g_overflowcheck(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).resultdef); +// cg.g_rangecheck(current_asmdata.CurrAsmList,tcallparanode(left).left.location,tcallparanode(left).left.resultdef, +// tcallparanode(left).left.resultdef); + end; + end; + + +{***************************************************************************** + TYPEINFO GENERIC HANDLING +*****************************************************************************} + procedure tcginlinenode.second_typeinfo; + var + href : treference; + begin + location_reset(location,LOC_REGISTER,OS_ADDR); + location.register:=cg.getaddressregister(current_asmdata.CurrAsmList); + reference_reset_symbol(href,RTTIWriter.get_rtti_label(left.resultdef,fullrtti),0,sizeof(pint)); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,href,location.register); + end; + + +{***************************************************************************** + INCLUDE/EXCLUDE GENERIC HANDLING +*****************************************************************************} + + procedure tcginlinenode.second_IncludeExclude; + var + setpara, elepara: tnode; + begin + { the set } + secondpass(tcallparanode(left).left); + { the element to set } + secondpass(tcallparanode(tcallparanode(left).right).left); + + setpara:=tcallparanode(left).left; + elepara:=tcallparanode(tcallparanode(left).right).left; + + if elepara.location.loc=LOC_CONSTANT then + begin + cg.a_bit_set_const_loc(current_asmdata.CurrAsmList,(inlinenumber=in_include_x_y), + elepara.location.value-tsetdef(setpara.resultdef).setbase,setpara.location); + end + else + begin + location_force_reg(current_asmdata.CurrAsmList,elepara.location,OS_INT,true); + register_maybe_adjust_setbase(current_asmdata.CurrAsmList,elepara.location,tsetdef(setpara.resultdef).setbase); + cg.a_bit_set_reg_loc(current_asmdata.CurrAsmList,(inlinenumber=in_include_x_y), + elepara.location.size,elepara.location.register,setpara.location); + end; + end; + + +{***************************************************************************** + FLOAT GENERIC HANDLING +*****************************************************************************} + +{ + These routines all call internal RTL routines, so if they are + called here, they give an internal error +} + procedure tcginlinenode.second_pi; + begin + internalerror(20020718); + end; + + procedure tcginlinenode.second_arctan_real; + begin + internalerror(20020718); + end; + + procedure tcginlinenode.second_abs_real; + begin + internalerror(20020718); + end; + + procedure tcginlinenode.second_round_real; + begin + internalerror(20020718); + end; + + procedure tcginlinenode.second_trunc_real; + begin + internalerror(20020718); + end; + + procedure tcginlinenode.second_sqr_real; + begin + internalerror(20020718); + end; + + procedure tcginlinenode.second_sqrt_real; + begin + internalerror(20020718); + end; + + procedure tcginlinenode.second_ln_real; + begin + internalerror(20020718); + end; + + procedure tcginlinenode.second_cos_real; + begin + internalerror(20020718); + end; + + procedure tcginlinenode.second_sin_real; + begin + internalerror(20020718); + end; + + + procedure tcginlinenode.second_prefetch; + begin + end; + + procedure tcginlinenode.second_abs_long; + var + opsize : tcgsize; + tempreg1, tempreg2 : tregister; + begin + opsize := def_cgsize(left.resultdef); + + secondpass(left); + location_force_reg(current_asmdata.CurrAsmList, left.location, opsize, false); + location := left.location; + location.register := cg.getintregister(current_asmdata.CurrAsmList, opsize); + + tempreg1 := cg.getintregister(current_asmdata.CurrAsmList, opsize); + tempreg2 := cg.getintregister(current_asmdata.CurrAsmList, opsize); + + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SAR, OS_INT, tcgsize2size[opsize]*8-1, left.location.register, tempreg1); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_XOR, OS_INT, left.location.register, tempreg1, tempreg2); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmlist, OP_SUB, OS_INT, tempreg1, tempreg2, location.register); + end; + + +{***************************************************************************** + ASSIGNED GENERIC HANDLING +*****************************************************************************} + + procedure tcginlinenode.second_assigned; + begin + secondpass(tcallparanode(left).left); + cg.a_cmp_const_loc_label(current_asmdata.CurrAsmList,def_cgsize(left.resultdef),OC_NE,0,tcallparanode(left).left.location,current_procinfo.CurrTrueLabel); + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + location_reset(location,LOC_JUMP,OS_NO); + end; + + procedure Tcginlinenode.second_get_frame; + + begin +{$if defined(x86) or defined(arm)} + if current_procinfo.framepointer=NR_STACK_POINTER_REG then + begin + location_reset(location,LOC_CONSTANT,OS_ADDR); + location.value:=0; + end + else +{$endif defined(x86) or defined(arm)} + begin + location_reset(location,LOC_CREGISTER,OS_ADDR); + location.register:=current_procinfo.framepointer; + end; + end; + + procedure Tcginlinenode.second_get_caller_frame; + + var + frame_reg:Tregister; + use_frame_pointer:boolean; + + begin + if left<>nil then + begin + secondpass(left); + if left.location.loc=LOC_CONSTANT then + use_frame_pointer:=true + else + begin + location_force_reg(current_asmdata.currasmlist,left.location,OS_ADDR,false); + frame_reg:=left.location.register; + use_frame_pointer:=false; + end + end + else + begin + use_frame_pointer:=current_procinfo.framepointer=NR_STACK_POINTER_REG; + frame_reg:=current_procinfo.framepointer; + end; + + if use_frame_pointer then + begin + location_reset(location,LOC_CREGISTER,OS_ADDR); + location.register:=NR_FRAME_POINTER_REG; + end + else + begin + location_reset_ref(location,LOC_REFERENCE,OS_ADDR,sizeof(pint)); + location.reference.base:=frame_reg; + end; + end; + + procedure Tcginlinenode.second_get_caller_addr; + var + frame_ref:Treference; + begin + if current_procinfo.framepointer=NR_STACK_POINTER_REG then + begin + location_reset(location,LOC_REGISTER,OS_ADDR); + location.register:=cg.getaddressregister(current_asmdata.currasmlist); + reference_reset_base(frame_ref,NR_STACK_POINTER_REG,{current_procinfo.calc_stackframe_size}tg.lasttemp,sizeof(pint)); + cg.a_load_ref_reg(current_asmdata.currasmlist,OS_ADDR,OS_ADDR,frame_ref,location.register); + end + else + begin + location_reset(location,LOC_REGISTER,OS_ADDR); + location.register:=cg.getaddressregister(current_asmdata.currasmlist); + reference_reset_base(frame_ref,current_procinfo.framepointer,sizeof(pint),sizeof(pint)); + cg.a_load_ref_reg(current_asmdata.currasmlist,OS_ADDR,OS_ADDR,frame_ref,location.register); + end; + end; + + + procedure tcginlinenode.second_rox; + var + op : topcg; + {hcountreg : tregister;} + op1,op2 : tnode; + begin + { one or two parameters? } + if (left.nodetype=callparan) and + assigned(tcallparanode(left).right) then + begin + op1:=tcallparanode(tcallparanode(left).right).left; + op2:=tcallparanode(left).left; + end + else + op1:=left; + + secondpass(op1); + { load left operator in a register } + location_copy(location,op1.location); + case inlinenumber of + in_ror_x, + in_ror_x_y: + op:=OP_ROR; + in_rol_x, + in_rol_x_y: + op:=OP_ROL; + end; + location_force_reg(current_asmdata.CurrAsmList,location,location.size,false); + + if (left.nodetype=callparan) and + assigned(tcallparanode(left).right) then + begin + secondpass(op2); + { rotating by a constant directly coded: } + if op2.nodetype=ordconstn then + cg.a_op_const_reg(current_asmdata.CurrAsmList,op,location.size, + tordconstnode(op2).value.uvalue and (resultdef.size*8-1),location.register) + else + begin + location_force_reg(current_asmdata.CurrAsmList,op2.location,location.size,false); + { do modulo 2 operation } + cg.a_op_reg_reg(current_asmdata.CurrAsmList,op,location.size,op2.location.register,location.register); + end; + end + else + cg.a_op_const_reg(current_asmdata.CurrAsmList,op,location.size,1,location.register); + end; + + + procedure tcginlinenode.second_sar; + var + {hcountreg : tregister;} + op1,op2 : tnode; + begin + if (left.nodetype=callparan) and + assigned(tcallparanode(left).right) then + begin + op1:=tcallparanode(tcallparanode(left).right).left; + op2:=tcallparanode(left).left; + end + else + begin + op1:=left; + op2:=nil; + end; + secondpass(op1); + { load left operator in a register } + location_copy(location,op1.location); + + location_force_reg(current_asmdata.CurrAsmList,location,location.size,false); + + if not(assigned(op2)) then + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SAR,location.size,1,location.register) + else + begin + secondpass(op2); + { shifting by a constant directly coded: } + if op2.nodetype=ordconstn then + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SAR,location.size, + tordconstnode(op2).value.uvalue and (resultdef.size*8-1),location.register) + else + begin + location_force_reg(current_asmdata.CurrAsmList,op2.location,location.size,false); + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_SAR,location.size,op2.location.register,location.register); + end; + end; + end; + + + procedure tcginlinenode.second_BsfBsr; + var + reverse: boolean; + opsize: tcgsize; + begin + reverse:=(inlinenumber = in_bsr_x); + secondpass(left); + + opsize:=tcgsize2unsigned[left.location.size]; + if opsize < OS_32 then + opsize:=OS_32; + + if (left.location.loc <> LOC_REGISTER) or + (left.location.size <> opsize) then + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,true); + + location_reset(location,LOC_REGISTER,opsize); + location.register := cg.getintregister(current_asmdata.CurrAsmList,opsize); + cg.a_bit_scan_reg_reg(current_asmdata.CurrAsmList,reverse,opsize,left.location.register,location.register); + end; + + +begin + cinlinenode:=tcginlinenode; +end. diff --git a/closures/compiler/ncgld.pas b/closures/compiler/ncgld.pas new file mode 100644 index 0000000000..789b065e8c --- /dev/null +++ b/closures/compiler/ncgld.pas @@ -0,0 +1,1286 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate assembler for nodes that handle loads and assignments which + are the same for all (most) 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. + + **************************************************************************** +} +unit ncgld; + +{$i fpcdefs.inc} + +interface + + uses + node,nld,cgutils; + + type + tcgloadnode = class(tloadnode) + procedure pass_generate_code;override; + procedure generate_picvaraccess;virtual; + procedure changereflocation(const ref: treference); + end; + + tcgassignmentnode = class(tassignmentnode) + procedure pass_generate_code;override; + end; + + tcgarrayconstructornode = class(tarrayconstructornode) + procedure pass_generate_code;override; + end; + + tcgrttinode = class(trttinode) + procedure pass_generate_code;override; + end; + + +implementation + + uses + cutils, + systems, + verbose,globtype,globals,constexp, + nutils, + symtable,symconst,symtype,symdef,symsym,defutil,paramgr, + ncnv,ncon,nmem,nbas,ncgrtti, + aasmbase,aasmtai,aasmdata,aasmcpu, + cgbase,pass_2, + procinfo, + cpubase,parabase, + tgobj,ncgutil, + cgobj, + ncgbas,ncgflw, + wpobase; + +{***************************************************************************** + SSA (for memory temps) support +*****************************************************************************} + + type + preplacerefrec = ^treplacerefrec; + treplacerefrec = record + old, new: preference; + ressym: tsym; + end; + + function doreplaceref(var n: tnode; para: pointer): foreachnoderesult; + var + rr: preplacerefrec absolute para; + begin + result := fen_false; + case n.nodetype of + loadn: + begin + { regular variable } + if (tabstractvarsym(tloadnode(n).symtableentry).varoptions * [vo_is_dll_var, vo_is_thread_var] = []) and + not assigned(tloadnode(n).left) and + { not function result, or no exit in function } + (((tloadnode(n).symtableentry <> rr^.ressym) and + not(vo_is_funcret in tabstractvarsym(tloadnode(n).symtableentry).varoptions)) or + not(fc_exit in flowcontrol)) and + { stored in memory... } + (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.loc in [LOC_REFERENCE]) and + { ... at the place we are looking for } + references_equal(tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.reference,rr^.old^) and + { its address cannot have escaped the current routine } + not(tabstractvarsym(tloadnode(n).symtableentry).addr_taken) then + begin + { relocate variable } + tcgloadnode(n).changereflocation(rr^.new^); + result := fen_norecurse_true; + end; + end; + temprefn: + begin + if (ti_valid in ttemprefnode(n).tempinfo^.flags) and + { memory temp... } + (ttemprefnode(n).tempinfo^.location.loc in [LOC_REFERENCE]) and + { ... at the place we are looking for } + references_equal(ttemprefnode(n).tempinfo^.location.reference,rr^.old^) and + { its address cannot have escaped the current routine } + not(ti_addr_taken in ttemprefnode(n).tempinfo^.flags) then + begin + { relocate the temp } + tcgtemprefnode(n).changelocation(rr^.new^); + result := fen_norecurse_true; + end; + end; + { Subscriptn must be rejected, otherwise we may replace an + an entire record with a temp for its first field, mantis #13948) + Exception: the field's size is the same as the entire record + + The same goes for array indexing + } + subscriptn, + vecn: + if not(tunarynode(n).left.resultdef.typ in [recorddef,objectdef,arraydef,stringdef]) or + { make sure we don't try to call resultdef.size for types that + don't have a compile-time size such as open arrays } + is_special_array(tunarynode(n).left.resultdef) or + (tsubscriptnode(n).left.resultdef.size <> tunarynode(n).resultdef.size) then + result := fen_norecurse_false; + + { optimize the searching a bit } + derefn,addrn, + calln,inlinen,casen, + addn,subn,muln, + andn,orn,xorn, + ltn,lten,gtn,gten,equaln,unequaln, + slashn,divn,shrn,shln,notn, + inn, + asn,isn: + result := fen_norecurse_false; + end; + end; + + + function maybechangetemp(list: TAsmList; var n: tnode; const newref: treference): boolean; + var + rr: treplacerefrec; + begin + result := false; + + { only do for -O2 or higher (breaks debugging since } + { variables move to different memory locations) } + if not(cs_opt_level2 in current_settings.optimizerswitches) or + { must be a copy to a memory location ... } + (n.location.loc <> LOC_REFERENCE) or + { not inside a control flow statement and no goto's in sight } + ([fc_inflowcontrol,fc_gotolabel] * flowcontrol <> []) or + { not for refcounted types, because those locations are } + { still used later on in initialisation/finalisation code } + is_managed_type(n.resultdef) or + { source and destination are temps (= not global variables) } + not tg.istemp(n.location.reference) or + not tg.istemp(newref) or + { and both point to the start of a temp, and the source is a } + { non-persistent temp (otherwise we need some kind of copy- } + { on-write support in case later on both are still used) } + (tg.gettypeoftemp(newref) <> tt_normal) or + not (tg.gettypeoftemp(n.location.reference) in [tt_normal,tt_persistent]) or + { and both have the same size } + (tg.sizeoftemp(current_asmdata.CurrAsmList,newref) <> tg.sizeoftemp(current_asmdata.CurrAsmList,n.location.reference)) then + exit; + + { find the source of the old reference (loadnode or tempnode) } + { and replace it with the new reference } + rr.old := @n.location.reference; + rr.new := @newref; + rr.ressym := nil; + + if assigned(current_procinfo.procdef.funcretsym) and + (tabstractvarsym(current_procinfo.procdef.funcretsym).refs <> 0) then + if (current_procinfo.procdef.proctypeoption=potype_constructor) then + rr.ressym:=tsym(current_procinfo.procdef.parast.Find('self')) + else + rr.ressym:=current_procinfo.procdef.funcretsym; + + { if source not found, don't do anything } + if not foreachnodestatic(n,@doreplaceref,@rr) then + exit; + + n.location.reference := newref; + result:=true; + end; + +{***************************************************************************** + SecondLoad +*****************************************************************************} + + procedure tcgloadnode.generate_picvaraccess; + begin +{$ifndef sparc} + location.reference.base:=current_procinfo.got; + location.reference.symbol:=current_asmdata.RefAsmSymbol(tstaticvarsym(symtableentry).mangledname+'@GOT'); +{$endif sparc} + end; + + + procedure tcgloadnode.changereflocation(const ref: treference); + var + oldtemptype: ttemptype; + begin + if (location.loc<>LOC_REFERENCE) then + internalerror(2007020812); + if not tg.istemp(location.reference) then + internalerror(2007020813); + oldtemptype:=tg.gettypeoftemp(location.reference); + if (oldtemptype = tt_persistent) then + tg.ChangeTempType(current_asmdata.CurrAsmList,location.reference,tt_normal); + tg.ungettemp(current_asmdata.CurrAsmList,location.reference); + location.reference:=ref; + tg.ChangeTempType(current_asmdata.CurrAsmList,location.reference,oldtemptype); + tabstractnormalvarsym(symtableentry).localloc:=location; + end; + + + procedure tcgloadnode.pass_generate_code; + var + hregister : tregister; + vs : tabstractnormalvarsym; + gvs : tstaticvarsym; + pd : tprocdef; + href : treference; + newsize : tcgsize; + endrelocatelab, + norelocatelab : tasmlabel; + paraloc1 : tcgpara; + begin + { we don't know the size of all arrays } + newsize:=def_cgsize(resultdef); + { alignment is overridden per case below } + location_reset_ref(location,LOC_REFERENCE,newsize,resultdef.alignment); + case symtableentry.typ of + absolutevarsym : + begin + { this is only for toasm and toaddr } + case tabsolutevarsym(symtableentry).abstyp of + toaddr : + begin +{$ifdef i386} + if tabsolutevarsym(symtableentry).absseg then + location.reference.segment:=NR_FS; +{$endif i386} + location.reference.offset:=aint(tabsolutevarsym(symtableentry).addroffset); + end; + toasm : + location.reference.symbol:=current_asmdata.RefAsmSymbol(tabsolutevarsym(symtableentry).mangledname); + else + internalerror(200310283); + end; + end; + constsym: + begin + if tconstsym(symtableentry).consttyp=constresourcestring then + begin + location_reset_ref(location,LOC_CREFERENCE,OS_ADDR,sizeof(pint)); + location.reference.symbol:=current_asmdata.RefAsmSymbol(make_mangledname('RESSTR',symtableentry.owner,symtableentry.name)); + { Resourcestring layout: + TResourceStringRecord = Packed Record + Name, + CurrentValue, + DefaultValue : AnsiString; + HashValue : LongWord; + end; + } + location.reference.offset:=sizeof(pint); + end + else + internalerror(22798); + end; + staticvarsym : + begin + gvs:=tstaticvarsym(symtableentry); + if ([vo_is_dll_var,vo_is_external] * gvs.varoptions <> []) then + begin + { assume external variables use the default alignment } + location.reference.alignment:=gvs.vardef.alignment; + location.reference.base := cg.g_indirect_sym_load(current_asmdata.CurrAsmList,tstaticvarsym(symtableentry).mangledname, + vo_is_weak_external in gvs.varoptions); + if (location.reference.base <> NR_NO) then + exit; + end + else + begin + location.reference.alignment:=var_align(gvs.vardef.alignment); + end; + + + if (vo_is_dll_var in gvs.varoptions) then + { DLL variable } + begin + hregister:=cg.getaddressregister(current_asmdata.CurrAsmList); + if not(vo_is_weak_external in gvs.varoptions) then + location.reference.symbol:=current_asmdata.RefAsmSymbol(tstaticvarsym(symtableentry).mangledname) + else + location.reference.symbol:=current_asmdata.WeakRefAsmSymbol(tstaticvarsym(symtableentry).mangledname); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,location.reference,hregister); + reference_reset_base(location.reference,hregister,0,location.reference.alignment); + end + { Thread variable } + else if (vo_is_thread_var in gvs.varoptions) and + not(tf_section_threadvars in target_info.flags) then + begin + if (tf_section_threadvars in target_info.flags) then + begin + if gvs.localloc.loc=LOC_INVALID then + if not(vo_is_weak_external in gvs.varoptions) then + reference_reset_symbol(location.reference,current_asmdata.RefAsmSymbol(gvs.mangledname),0,location.reference.alignment) + else + reference_reset_symbol(location.reference,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),0,location.reference.alignment) + else + location:=gvs.localloc; +{$ifdef i386} + case target_info.system of + system_i386_linux: + location.reference.segment:=NR_GS; + system_i386_win32: + location.reference.segment:=NR_FS; + end; +{$endif i386} + end + else + begin + { + Thread var loading is optimized to first check if + a relocate function is available. When the function + is available it is called to retrieve the address. + Otherwise the address is loaded with the symbol + + The code needs to be in the order to first handle the + call and then the address load to be sure that the + register that is used for returning is the same (PFV) + } + current_asmdata.getjumplabel(norelocatelab); + current_asmdata.getjumplabel(endrelocatelab); + { make sure hregister can't allocate the register necessary for the parameter } + paraloc1.init; + paramanager.getintparaloc(pocall_default,1,paraloc1); + hregister:=cg.getaddressregister(current_asmdata.CurrAsmList); + reference_reset_symbol(href,current_asmdata.RefAsmSymbol('FPC_THREADVAR_RELOCATE'),0,sizeof(pint)); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,hregister); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_ADDR,OC_EQ,0,hregister,norelocatelab); + { don't save the allocated register else the result will be destroyed later } + if not(vo_is_weak_external in gvs.varoptions) then + reference_reset_symbol(href,current_asmdata.RefAsmSymbol(gvs.mangledname),0,sizeof(pint)) + else + reference_reset_symbol(href,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),0,sizeof(pint)); + cg.a_load_ref_cgpara(current_asmdata.CurrAsmList,OS_32,href,paraloc1); + paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1); + paraloc1.done; + cg.allocallcpuregisters(current_asmdata.CurrAsmList); + cg.a_call_reg(current_asmdata.CurrAsmList,hregister); + cg.deallocallcpuregisters(current_asmdata.CurrAsmList); + cg.getcpuregister(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG); + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG); + hregister:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_ADDR,NR_FUNCTION_RESULT_REG,hregister); + cg.a_jmp_always(current_asmdata.CurrAsmList,endrelocatelab); + cg.a_label(current_asmdata.CurrAsmList,norelocatelab); + { no relocation needed, load the address of the variable only, the + layout of a threadvar is (4 bytes pointer): + 0 - Threadvar index + 4 - Threadvar value in single threading } + if not(vo_is_weak_external in gvs.varoptions) then + reference_reset_symbol(href,current_asmdata.RefAsmSymbol(gvs.mangledname),sizeof(pint),sizeof(pint)) + else + reference_reset_symbol(href,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),sizeof(pint),sizeof(pint)); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,href,hregister); + cg.a_label(current_asmdata.CurrAsmList,endrelocatelab); + location.reference.base:=hregister; + end; + end + { Normal (or external) variable } + else + begin + if gvs.localloc.loc=LOC_INVALID then + if not(vo_is_weak_external in gvs.varoptions) then + reference_reset_symbol(location.reference,current_asmdata.RefAsmSymbol(gvs.mangledname),0,location.reference.alignment) + else + reference_reset_symbol(location.reference,current_asmdata.WeakRefAsmSymbol(gvs.mangledname),0,location.reference.alignment) + else + location:=gvs.localloc; + end; + + { make const a LOC_CREFERENCE } + if (gvs.varspez=vs_const) and + (location.loc=LOC_REFERENCE) then + location.loc:=LOC_CREFERENCE; + end; + paravarsym, + localvarsym : + begin + vs:=tabstractnormalvarsym(symtableentry); + { Nested variable } + if assigned(left) then + begin + secondpass(left); + if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then + internalerror(200309286); + if vs.localloc.loc<>LOC_REFERENCE then + internalerror(200409241); + reference_reset_base(location.reference,left.location.register,vs.localloc.reference.offset,vs.localloc.reference.alignment); + end + else + location:=vs.localloc; + + { handle call by reference variables when they are not + already copied to local copies. Also ignore the reference + when we need to load the self pointer for objects } + if is_addr_param_load then + begin + if (location.loc in [LOC_CREGISTER,LOC_REGISTER]) then + hregister:=location.register + else + begin + hregister:=cg.getaddressregister(current_asmdata.CurrAsmList); + { we need to load only an address } + location.size:=OS_ADDR; + cg.a_load_loc_reg(current_asmdata.CurrAsmList,location.size,location,hregister); + end; + { assume packed records may always be unaligned } + if not(resultdef.typ in [recorddef,objectdef]) or + (tabstractrecordsymtable(tabstractrecorddef(resultdef).symtable).usefieldalignment<>1) then + location_reset_ref(location,LOC_REFERENCE,newsize,resultdef.alignment) + else + location_reset_ref(location,LOC_REFERENCE,newsize,1); + location.reference.base:=hregister; + end; + + { make const a LOC_CREFERENCE } + if (vs.varspez=vs_const) and + (location.loc=LOC_REFERENCE) then + location.loc:=LOC_CREFERENCE; + end; + procsym: + begin + if not assigned(procdef) then + internalerror(200312011); + if assigned(left) then + begin + {$if sizeof(pint) = 4} + location_reset_ref(location,LOC_CREFERENCE,OS_64,sizeof(pint)); + {$else} {$if sizeof(pint) = 8} + location_reset_ref(location,LOC_CREFERENCE,OS_128,sizeof(pint)); + {$else} + internalerror(20020520); + {$endif} {$endif} + tg.GetTemp(current_asmdata.CurrAsmList,2*sizeof(pint),sizeof(pint),tt_normal,location.reference); + secondpass(left); + + { load class instance/classrefdef address } + if left.location.loc=LOC_CONSTANT then + location_force_reg(current_asmdata.CurrAsmList,left.location,OS_ADDR,false); + case left.location.loc of + LOC_CREGISTER, + LOC_REGISTER: + begin + { this is not possible for objects } + if is_object(left.resultdef) then + internalerror(200304234); + hregister:=left.location.register; + end; + LOC_CREFERENCE, + LOC_REFERENCE: + begin + hregister:=cg.getaddressregister(current_asmdata.CurrAsmList); + if not is_object(left.resultdef) then + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.reference,hregister) + else + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,hregister); + location_freetemp(current_asmdata.CurrAsmList,left.location); + end; + else + internalerror(200610311); + end; + + { store the class instance or classredef address } + href:=location.reference; + inc(href.offset,sizeof(pint)); + cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,hregister,href); + + { virtual method ? } + if (po_virtualmethod in procdef.procoptions) and + not(loadnf_inherited in loadnodeflags) and + not is_objectpascal_helper(procdef.struct) then + begin + if (not assigned(current_procinfo) or + wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname)) then + tobjectdef(procdef.struct).register_vmt_call(procdef.extnumber); + {$ifdef vtentry} + if not is_interface(procdef.struct) then + begin + inc(current_asmdata.NextVTEntryNr); + current_asmdata.CurrAsmList.Concat(tai_symbol.CreateName('VTREF'+tostr(current_asmdata.NextVTEntryNr)+'_'+procdef._class.vmt_mangledname+'$$'+tostr(vmtoffset div sizeof(pint)),AT_FUNCTION,0)); + end; + {$endif vtentry} + { a classrefdef already points to the VMT } + if (left.resultdef.typ<>classrefdef) then + begin + { load vmt pointer } + reference_reset_base(href,hregister,tobjectdef(left.resultdef).vmt_offset,sizeof(pint)); + hregister:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,hregister); + end; + { load method address } + reference_reset_base(href,hregister,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint)); + hregister:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,hregister); + { ... and store it } + cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,hregister,location.reference); + end + else + begin + { load address of the function } + reference_reset_symbol(href,current_asmdata.RefAsmSymbol(procdef.mangledname),0,sizeof(pint)); + hregister:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,href,hregister); + cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,hregister,location.reference); + end; + end + else + begin + pd:=tprocdef(tprocsym(symtableentry).ProcdefList[0]); + if (po_external in pd.procoptions) then + location.reference.base := + cg.g_indirect_sym_load(current_asmdata.CurrAsmList,pd.mangledname, + po_weakexternal in pd.procoptions); + {!!!!! Be aware, work on virtual methods too } + if (location.reference.base = NR_NO) then + if not(po_weakexternal in pd.procoptions) then + location.reference.symbol:=current_asmdata.RefAsmSymbol(procdef.mangledname) + else + location.reference.symbol:=current_asmdata.WeakRefAsmSymbol(procdef.mangledname); + end; + end; + labelsym : + if assigned(tlabelsym(symtableentry).asmblocklabel) then + location.reference.symbol:=tlabelsym(symtableentry).asmblocklabel + else + location.reference.symbol:=tcglabelnode((tlabelsym(symtableentry).code)).getasmlabel; + else internalerror(200510032); + end; + end; + + +{***************************************************************************** + SecondAssignment +*****************************************************************************} + + procedure tcgassignmentnode.pass_generate_code; + var + otlabel,hlabel,oflabel : tasmlabel; + href : treference; + releaseright : boolean; + alignmentrequirement, + len : aint; + r : tregister; + r64 : tregister64; + oldflowcontrol : tflowcontrol; + begin + location_reset(location,LOC_VOID,OS_NO); + { managed types should be handled in firstpass } + if is_managed_type(left.resultdef) or is_managed_type(right.resultdef) then + InternalError(2012011901); + + otlabel:=current_procinfo.CurrTrueLabel; + oflabel:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + + { + in most cases we can process first the right node which contains + the most complex code. Exceptions for this are: + - result is in flags, loading left will then destroy the flags + - result is a jump, loading left must be already done before the jump is made + - result need reference count, when left points to a value used in + right then decreasing the refcnt on left can possibly release + the memory before right increased the refcnt, result is that an + empty value is assigned + + But not when the result is in the flags, then + loading the left node afterwards can destroy the flags. + } + if not(right.expectloc in [LOC_FLAGS,LOC_JUMP]) and + (node_complexity(right)>node_complexity(left)) then + begin + secondpass(right); + if codegenerror then + exit; + + secondpass(left); + if codegenerror then + exit; + end + else + begin + { calculate left sides } + secondpass(left); + if codegenerror then + exit; + + { tell the SSA/SSL code that the left side was handled first so + ni SSL is done + } + oldflowcontrol:=flowcontrol; + include(flowcontrol,fc_lefthandled); + + secondpass(right); + flowcontrol:=oldflowcontrol; + + if codegenerror then + exit; + end; + + releaseright:=true; + + { shortstring assignments are handled separately } + if is_shortstring(left.resultdef) then + begin + { + we can get here only in the following situations + for the right node: + - empty constant string + - char + } + + { The addn is replaced by a blockn or calln that already returns + a shortstring } + if is_shortstring(right.resultdef) and + (right.nodetype in [blockn,calln]) then + begin + { nothing to do } + end + { empty constant string } + else if (right.nodetype=stringconstn) and + (tstringconstnode(right).len=0) then + begin + cg.a_load_const_ref(current_asmdata.CurrAsmList,OS_8,0,left.location.reference); + end + { char loading } + else if is_char(right.resultdef) then + begin + if right.nodetype=ordconstn then + begin + if (target_info.endian = endian_little) then + cg.a_load_const_ref(current_asmdata.CurrAsmList,OS_16,(tordconstnode(right).value.svalue shl 8) or 1, + setalignment(left.location.reference,1)) + else + cg.a_load_const_ref(current_asmdata.CurrAsmList,OS_16,tordconstnode(right).value.svalue or (1 shl 8), + setalignment(left.location.reference,1)); + end + else + begin + href:=left.location.reference; + cg.a_load_const_ref(current_asmdata.CurrAsmList,OS_8,1,href); + inc(href.offset,1); + case right.location.loc of + LOC_REGISTER, + LOC_CREGISTER : + begin + r:=cg.makeregsize(current_asmdata.CurrAsmList,right.location.register,OS_8); + cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_8,OS_8,r,href); + end; + LOC_REFERENCE, + LOC_CREFERENCE : + cg.a_load_ref_ref(current_asmdata.CurrAsmList,OS_8,OS_8,right.location.reference,href); + else + internalerror(200205111); + end; + end; + end + else + internalerror(2002042410); + end + { try to reuse memory locations instead of copying } + { copy to a memory location ... } + else if (right.location.loc = LOC_REFERENCE) and + maybechangetemp(current_asmdata.CurrAsmList,left,right.location.reference) then + begin + { if it worked, we're done } + end + else + begin + { SSA support } + maybechangeloadnodereg(current_asmdata.CurrAsmList,left,false); + maybechangeloadnodereg(current_asmdata.CurrAsmList,right,true); + case right.location.loc of + LOC_CONSTANT : + begin +{$ifndef cpu64bitalu} + if (left.location.size in [OS_64,OS_S64]) or (right.location.size in [OS_64,OS_S64]) then + cg64.a_load64_const_loc(current_asmdata.CurrAsmList,right.location.value64,left.location) + else +{$endif not cpu64bitalu} + cg.a_load_const_loc(current_asmdata.CurrAsmList,right.location.value,left.location); + end; + LOC_REFERENCE, + LOC_CREFERENCE : + begin + case left.location.loc of + LOC_REGISTER, + LOC_CREGISTER : + begin +{$ifndef cpu64bitalu} + if left.location.size in [OS_64,OS_S64] then + cg64.a_load64_ref_reg(current_asmdata.CurrAsmList,right.location.reference,left.location.register64) + else +{$endif not cpu64bitalu} + cg.a_load_ref_reg(current_asmdata.CurrAsmList,right.location.size,left.location.size,right.location.reference,left.location.register); + end; + LOC_FPUREGISTER, + LOC_CFPUREGISTER : + begin + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList, + right.location.size,left.location.size, + right.location.reference, + left.location.register); + end; + LOC_REFERENCE, + LOC_CREFERENCE : + begin + if (left.resultdef.typ=floatdef) and + (right.resultdef.typ=floatdef) and + (left.location.size<>right.location.size) then + begin + cg.a_loadfpu_ref_ref(current_asmdata.CurrAsmList, + right.location.size,left.location.size, + right.location.reference,left.location.reference) + end + else + begin +{ TODO: HACK: unaligned test, maybe remove all unaligned locations (array of char) from the compiler} + { Use unaligned copy when the offset is not aligned } + len:=left.resultdef.size; + + { data smaller than an aint has less alignment requirements } + { max(1,...) avoids div by zero in case of an empty record } + alignmentrequirement:=min(max(1,len),sizeof(aint)); + + if (right.location.reference.offset mod alignmentrequirement<>0) or + (left.location.reference.offset mod alignmentrequirement<>0) or + (right.resultdef.alignment<alignmentrequirement) or + ((right.location.reference.alignment<>0) and + (right.location.reference.alignment<alignmentrequirement)) or + ((left.location.reference.alignment<>0) and + (left.location.reference.alignment<alignmentrequirement)) then + cg.g_concatcopy_unaligned(current_asmdata.CurrAsmList,right.location.reference,left.location.reference,len) + else + cg.g_concatcopy(current_asmdata.CurrAsmList,right.location.reference,left.location.reference,len); + end; + end; + LOC_MMREGISTER, + LOC_CMMREGISTER: + begin +{$ifdef x86} + if (right.resultdef.typ=floatdef) and + not use_vectorfpu(right.resultdef) then + begin + { perform size conversion if needed (the mm-code cannot } + { convert an extended into a double/single, since sse } + { doesn't support extended) } + r:=cg.getfpuregister(current_asmdata.CurrAsmList,right.location.size); + tg.gettemp(current_asmdata.CurrAsmList,left.resultdef.size,left.resultdef.alignment,tt_normal,href); + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,right.location.size,right.location.size,right.location.reference,r); + cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,right.location.size,left.location.size,r,href); + if releaseright then + location_freetemp(current_asmdata.CurrAsmList,right.location); + releaseright:=true; + location_reset_ref(right.location,LOC_REFERENCE,left.location.size,0); + right.location.reference:=href; + end; +{$endif} + cg.a_loadmm_ref_reg(current_asmdata.CurrAsmList, + right.location.size, + left.location.size, + right.location.reference, + left.location.register,mms_movescalar); + end; + LOC_SUBSETREG, + LOC_CSUBSETREG: + cg.a_load_ref_subsetreg(current_asmdata.CurrAsmList,right.location.size,left.location.size,right.location.reference,left.location.sreg); + LOC_SUBSETREF, + LOC_CSUBSETREF: +{$ifndef cpu64bitalu} + if right.location.size in [OS_64,OS_S64] then + cg64.a_load64_ref_subsetref(current_asmdata.CurrAsmList,right.location.reference,left.location.sref) + else +{$endif not cpu64bitalu} + cg.a_load_ref_subsetref(current_asmdata.CurrAsmList,right.location.size,left.location.size,right.location.reference,left.location.sref); + else + internalerror(200203284); + end; + end; +{$ifdef SUPPORT_MMX} + LOC_CMMXREGISTER, + LOC_MMXREGISTER: + begin + if left.location.loc=LOC_CMMXREGISTER then + cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,OS_M64,OS_M64,right.location.register,left.location.register,nil) + else + cg.a_loadmm_reg_ref(current_asmdata.CurrAsmList,OS_M64,OS_M64,right.location.register,left.location.reference,nil); + end; +{$endif SUPPORT_MMX} + LOC_MMREGISTER, + LOC_CMMREGISTER: + begin + if left.resultdef.typ=arraydef then + begin + end + else + begin + case left.location.loc of + LOC_CMMREGISTER, + LOC_MMREGISTER: + cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,right.location.size,left.location.size,right.location.register,left.location.register,mms_movescalar); + LOC_REFERENCE, + LOC_CREFERENCE: + cg.a_loadmm_reg_ref(current_asmdata.CurrAsmList,right.location.size,left.location.size,right.location.register,left.location.reference,mms_movescalar); + else + internalerror(2009112601); + end; + end; + end; + LOC_REGISTER, + LOC_CREGISTER : + begin +{$ifndef cpu64bitalu} + { also OS_F64 in case of mmreg -> intreg } + if left.location.size in [OS_64,OS_S64,OS_F64] then + cg64.a_load64_reg_loc(current_asmdata.CurrAsmList, + right.location.register64,left.location) + else +{$endif not cpu64bitalu} + cg.a_load_reg_loc(current_asmdata.CurrAsmList,right.location.size,right.location.register,left.location); + end; + LOC_FPUREGISTER, + LOC_CFPUREGISTER : + begin + { we can't do direct moves between fpu and mm registers } + if left.location.loc in [LOC_MMREGISTER,LOC_CMMREGISTER] then + begin +{$ifdef x86} + if not use_vectorfpu(right.resultdef) then + begin + { perform size conversion if needed (the mm-code cannot convert an } + { extended into a double/single, since sse doesn't support extended) } + tg.gettemp(current_asmdata.CurrAsmList,left.resultdef.size,left.resultdef.alignment,tt_normal,href); + cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,right.location.size,left.location.size,right.location.register,href); + location_reset_ref(right.location,LOC_REFERENCE,left.location.size,0); + right.location.reference:=href; + end; +{$endif} + location_force_mmregscalar(current_asmdata.CurrAsmList,right.location,false); + cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList, + right.location.size,left.location.size, + right.location.register,left.location.register,mms_movescalar); + end + else + cg.a_loadfpu_reg_loc(current_asmdata.CurrAsmList, + right.location.size, + right.location.register,left.location); + end; + LOC_SUBSETREG, + LOC_CSUBSETREG: + begin + cg.a_load_subsetreg_loc(current_asmdata.CurrAsmList, + right.location.size,right.location.sreg,left.location); + end; + LOC_SUBSETREF, + LOC_CSUBSETREF: + begin +{$ifndef cpu64bitalu} + if right.location.size in [OS_64,OS_S64] then + cg64.a_load64_subsetref_loc(current_asmdata.CurrAsmList,right.location.sref,left.location) + else +{$endif not cpu64bitalu} + cg.a_load_subsetref_loc(current_asmdata.CurrAsmList, + right.location.size,right.location.sref,left.location); + end; + LOC_JUMP : + begin + current_asmdata.getjumplabel(hlabel); + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel); + if is_pasbool(left.resultdef) then + begin +{$ifndef cpu64bitalu} + if left.location.size in [OS_64,OS_S64] then + cg64.a_load64_const_loc(current_asmdata.CurrAsmList,1,left.location) + else +{$endif not cpu64bitalu} + cg.a_load_const_loc(current_asmdata.CurrAsmList,1,left.location) + end + else + begin +{$ifndef cpu64bitalu} + if left.location.size in [OS_64,OS_S64] then + cg64.a_load64_const_loc(current_asmdata.CurrAsmList,-1,left.location) + else +{$endif not cpu64bitalu} + cg.a_load_const_loc(current_asmdata.CurrAsmList,-1,left.location); + end; + + cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel); + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); +{$ifndef cpu64bitalu} + if left.location.size in [OS_64,OS_S64] then + cg64.a_load64_const_loc(current_asmdata.CurrAsmList,0,left.location) + else +{$endif not cpu64bitalu} + cg.a_load_const_loc(current_asmdata.CurrAsmList,0,left.location); + cg.a_label(current_asmdata.CurrAsmList,hlabel); + end; +{$ifdef cpuflags} + LOC_FLAGS : + begin + if is_pasbool(left.resultdef) then + begin + case left.location.loc of + LOC_REGISTER,LOC_CREGISTER: +{$ifdef cpu32bitalu} + if left.location.size in [OS_S64,OS_64] then + begin + cg.g_flags2reg(current_asmdata.CurrAsmList,OS_32,right.location.resflags,left.location.register64.reglo); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,left.location.register64.reghi); + end + else +{$endif cpu32bitalu} + cg.g_flags2reg(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,left.location.register); + LOC_REFERENCE: + { i386 has a hack in its code generator so that it can + deal with 64 bit locations in this parcticular case } +{$if defined(cpu32bitalu) and not defined(x86)} + if left.location.size in [OS_S64,OS_64] then + begin + r64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + r64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + cg.g_flags2reg(current_asmdata.CurrAsmList,OS_32,right.location.resflags,r64.reglo); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,r64.reghi); + cg64.a_load64_reg_ref(current_asmdata.CurrAsmList,r64,left.location.reference); + end + else +{$endif cpu32bitalu} + cg.g_flags2ref(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,left.location.reference); + LOC_SUBSETREG,LOC_SUBSETREF: + begin + r:=cg.getintregister(current_asmdata.CurrAsmList,left.location.size); + cg.g_flags2reg(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,r); + cg.a_load_reg_loc(current_asmdata.CurrAsmList,left.location.size,r,left.location); + end; + else + internalerror(200203273); + end; + end + else + begin +{$ifdef cpu32bitalu} + if left.location.size in [OS_S64,OS_64] then + begin + r64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + r64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + cg.g_flags2reg(current_asmdata.CurrAsmList,OS_32,right.location.resflags,r64.reglo); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,r64.reghi); + cg64.a_op64_reg_reg(current_asmdata.CurrAsmList,OP_NEG,OS_S64, + r64,r64); + cg64.a_load64_reg_loc(current_asmdata.CurrAsmList,r64,left.location); + end + else +{$endif cpu32bitalu} + begin + r:=cg.getintregister(current_asmdata.CurrAsmList,left.location.size); + cg.g_flags2reg(current_asmdata.CurrAsmList,left.location.size,right.location.resflags,r); + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,left.location.size,r,r); + cg.a_load_reg_loc(current_asmdata.CurrAsmList,left.location.size,r,left.location); + end + end; + end; +{$endif cpuflags} + end; + end; + + if releaseright then + location_freetemp(current_asmdata.CurrAsmList,right.location); + + current_procinfo.CurrTrueLabel:=otlabel; + current_procinfo.CurrFalseLabel:=oflabel; + end; + + +{***************************************************************************** + SecondArrayConstruct +*****************************************************************************} + + const + vtInteger = 0; + vtBoolean = 1; + vtChar = 2; + vtExtended = 3; + vtString = 4; + vtPointer = 5; + vtPChar = 6; + vtObject = 7; + vtClass = 8; + vtWideChar = 9; + vtPWideChar = 10; + vtAnsiString32 = 11; + vtCurrency = 12; + vtVariant = 13; + vtInterface = 14; + vtWideString = 15; + vtInt64 = 16; + vtQWord = 17; + vtUnicodeString = 18; + vtAnsiString16 = 19; + vtAnsiString64 = 20; + + procedure tcgarrayconstructornode.pass_generate_code; + var + hp : tarrayconstructornode; + href : treference; + lt : tdef; + paraloc : tcgparalocation; + otlabel, + oflabel : tasmlabel; + vtype : longint; + elesize, + elealign : longint; + tmpreg : tregister; + vaddr : boolean; + freetemp, + dovariant : boolean; + begin + if is_packed_array(resultdef) then + internalerror(200608042); + dovariant:=(nf_forcevaria in flags) or is_variant_array(resultdef); + if dovariant then + begin + elesize:=sizeof(pint)+sizeof(pint); + elealign:=sizeof(pint); + end + else + begin + elesize:=tarraydef(resultdef).elesize; + elealign:=tarraydef(resultdef).elementdef.alignment; + end; + { alignment is filled in by tg.gettemp below } + location_reset_ref(location,LOC_CREFERENCE,OS_NO,0); + fillchar(paraloc,sizeof(paraloc),0); + { Allocate always a temp, also if no elements are required, to + be sure that location is valid (PFV) } + if tarraydef(resultdef).highrange=-1 then + tg.GetTemp(current_asmdata.CurrAsmList,elesize,elealign,tt_normal,location.reference) + else + tg.GetTemp(current_asmdata.CurrAsmList,(tarraydef(resultdef).highrange+1)*elesize,resultdef.alignment,tt_normal,location.reference); + href:=location.reference; + { Process nodes in array constructor } + hp:=self; + while assigned(hp) do + begin + if assigned(hp.left) then + begin + freetemp:=true; + if (hp.left.expectloc=LOC_JUMP) then + begin + otlabel:=current_procinfo.CurrTrueLabel; + oflabel:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + end; + secondpass(hp.left); + { Move flags and jump in register } + if hp.left.location.loc in [LOC_FLAGS,LOC_JUMP] then + location_force_reg(current_asmdata.CurrAsmList,hp.left.location,def_cgsize(hp.left.resultdef),false); + + if (hp.left.location.loc=LOC_JUMP) then + begin + if (hp.left.expectloc<>LOC_JUMP) then + internalerror(2007103101); + current_procinfo.CurrTrueLabel:=otlabel; + current_procinfo.CurrFalseLabel:=oflabel; + end; + + if dovariant then + begin + { find the correct vtype value } + vtype:=$ff; + vaddr:=false; + lt:=hp.left.resultdef; + case lt.typ of + enumdef, + orddef : + begin + if is_64bit(lt) then + begin + case torddef(lt).ordtype of + scurrency: + vtype:=vtCurrency; + s64bit: + vtype:=vtInt64; + u64bit: + vtype:=vtQWord; + end; + freetemp:=false; + vaddr:=true; + end + else if (lt.typ=enumdef) or + is_integer(lt) then + vtype:=vtInteger + else + if is_boolean(lt) then + vtype:=vtBoolean + else + if (lt.typ=orddef) then + begin + case torddef(lt).ordtype of + uchar: + vtype:=vtChar; + uwidechar: + vtype:=vtWideChar; + end; + end; + end; + floatdef : + begin + if is_currency(lt) then + vtype:=vtCurrency + else + vtype:=vtExtended; + freetemp:=false; + vaddr:=true; + end; + procvardef, + pointerdef : + begin + if is_pchar(lt) then + vtype:=vtPChar + else if is_pwidechar(lt) then + vtype:=vtPWideChar + else + vtype:=vtPointer; + end; + variantdef : + begin + vtype:=vtVariant; + vaddr:=true; + freetemp:=false; + end; + classrefdef : + vtype:=vtClass; + objectdef : + if is_interface(lt) then + vtype:=vtInterface + { vtObject really means a class based on TObject } + else if is_class(lt) then + vtype:=vtObject + else + internalerror(200505171); + stringdef : + begin + if is_shortstring(lt) then + begin + vtype:=vtString; + vaddr:=true; + freetemp:=false; + end + else + if is_ansistring(lt) then + begin + vtype:=vtAnsiString; + freetemp:=false; + end + else + if is_widestring(lt) then + begin + vtype:=vtWideString; + freetemp:=false; + end + else + if is_unicodestring(lt) then + begin + vtype:=vtUnicodeString; + freetemp:=false; + end; + end; + end; + if vtype=$ff then + internalerror(14357); + { write changing field update href to the next element } + inc(href.offset,sizeof(pint)); + if vaddr then + begin + location_force_mem(current_asmdata.CurrAsmList,hp.left.location); + tmpreg:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,hp.left.location.reference,tmpreg); + cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,tmpreg,href); + end + else + cg.a_load_loc_ref(current_asmdata.CurrAsmList,OS_ADDR,hp.left.location,href); + { update href to the vtype field and write it } + dec(href.offset,sizeof(pint)); + cg.a_load_const_ref(current_asmdata.CurrAsmList, OS_INT,vtype,href); + { goto next array element } + inc(href.offset,sizeof(pint)*2); + end + else + { normal array constructor of the same type } + begin + if is_managed_type(resultdef) then + freetemp:=false; + case hp.left.location.loc of + LOC_MMREGISTER, + LOC_CMMREGISTER: + cg.a_loadmm_reg_ref(current_asmdata.CurrAsmList,hp.left.location.size,hp.left.location.size, + hp.left.location.register,href,mms_movescalar); + LOC_FPUREGISTER, + LOC_CFPUREGISTER : + cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,hp.left.location.size,hp.left.location.size,hp.left.location.register,href); + LOC_REFERENCE, + LOC_CREFERENCE : + begin + if is_shortstring(hp.left.resultdef) then + cg.g_copyshortstring(current_asmdata.CurrAsmList,hp.left.location.reference,href, + Tstringdef(hp.left.resultdef).len) + else + cg.g_concatcopy(current_asmdata.CurrAsmList,hp.left.location.reference,href,elesize); + end; + else + begin +{$ifndef cpu64bitalu} + if hp.left.location.size in [OS_64,OS_S64] then + cg64.a_load64_loc_ref(current_asmdata.CurrAsmList,hp.left.location,href) + else +{$endif not cpu64bitalu} + cg.a_load_loc_ref(current_asmdata.CurrAsmList,hp.left.location.size,hp.left.location,href); + end; + end; + inc(href.offset,elesize); + end; + if freetemp then + location_freetemp(current_asmdata.CurrAsmList,hp.left.location); + end; + { load next entry } + hp:=tarrayconstructornode(hp.right); + end; + end; + + +{***************************************************************************** + SecondRTTI +*****************************************************************************} + + procedure tcgrttinode.pass_generate_code; + begin + location_reset_ref(location,LOC_CREFERENCE,OS_NO,sizeof(pint)); + case rttidatatype of + rdt_normal: + location.reference.symbol:=RTTIWriter.get_rtti_label(rttidef,rttitype); + rdt_ord2str: + location.reference.symbol:=RTTIWriter.get_rtti_label_ord2str(rttidef,rttitype); + rdt_str2ord: + location.reference.symbol:=RTTIWriter.get_rtti_label_str2ord(rttidef,rttitype); + end; + end; + + + +begin + cloadnode:=tcgloadnode; + cassignmentnode:=tcgassignmentnode; + carrayconstructornode:=tcgarrayconstructornode; + crttinode:=tcgrttinode; +end. diff --git a/closures/compiler/ncgmat.pas b/closures/compiler/ncgmat.pas new file mode 100644 index 0000000000..2d47e78ec4 --- /dev/null +++ b/closures/compiler/ncgmat.pas @@ -0,0 +1,519 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate generic mathematical 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 ncgmat; + +{$i fpcdefs.inc} + +interface + + uses + node,nmat,cpubase,cgbase; + + type + tcgunaryminusnode = class(tunaryminusnode) + protected + { This routine is called to change the sign of the + floating point value in the floating point + register r. + + This routine should be overridden, since + the generic version is not optimal at all. The + generic version assumes that floating + point values are stored in the register + in IEEE-754 format. + } + procedure emit_float_sign_change(r: tregister; _size : tcgsize);virtual; +{$ifdef SUPPORT_MMX} + procedure second_mmx;virtual;abstract; +{$endif SUPPORT_MMX} +{$ifndef cpu64bitalu} + procedure second_64bit;virtual; +{$endif not cpu64bitalu} + procedure second_integer;virtual; + procedure second_float;virtual; + public + procedure pass_generate_code;override; + end; + + tcgmoddivnode = class(tmoddivnode) + procedure pass_generate_code;override; + protected + { This routine must do an actual 32-bit division, be it + signed or unsigned. The result must set into the the + @var(num) register. + + @param(signed Indicates if the division must be signed) + @param(denum Register containing the denominator + @param(num Register containing the numerator, will also receive result) + + The actual optimizations regarding shifts have already + been done and emitted, so this should really a do a divide. + } + procedure emit_div_reg_reg(signed: boolean;denum,num : tregister);virtual;abstract; + { This routine must do an actual 32-bit modulo, be it + signed or unsigned. The result must set into the the + @var(num) register. + + @param(signed Indicates if the modulo must be signed) + @param(denum Register containing the denominator + @param(num Register containing the numerator, will also receive result) + + The actual optimizations regarding shifts have already + been done and emitted, so this should really a do a modulo. + } + procedure emit_mod_reg_reg(signed: boolean;denum,num : tregister);virtual;abstract; +{$ifndef cpu64bitalu} + { This routine must do an actual 64-bit division, be it + signed or unsigned. The result must set into the the + @var(num) register. + + @param(signed Indicates if the division must be signed) + @param(denum Register containing the denominator + @param(num Register containing the numerator, will also receive result) + + The actual optimizations regarding shifts have already + been done and emitted, so this should really a do a divide. + Currently, this routine should only be implemented on + 64-bit systems, otherwise a helper is called in 1st pass. + } + procedure emit64_div_reg_reg(signed: boolean;denum,num : tregister64);virtual; +{$endif not cpu64bitalu} + end; + + tcgshlshrnode = class(tshlshrnode) +{$ifndef cpu64bitalu} + procedure second_64bit;virtual; +{$endif not cpu64bitalu} + procedure second_integer;virtual; + procedure pass_generate_code;override; + end; + + tcgnotnode = class(tnotnode) + protected + procedure second_boolean;virtual;abstract; +{$ifdef SUPPORT_MMX} + procedure second_mmx;virtual;abstract; +{$endif SUPPORT_MMX} +{$ifndef cpu64bitalu} + procedure second_64bit;virtual; +{$endif not cpu64bitalu} + procedure second_integer;virtual; + public + procedure pass_generate_code;override; + end; + + +implementation + + uses + globtype,systems, + cutils,verbose,globals, + symconst,aasmbase,aasmtai,aasmdata,aasmcpu,defutil, + parabase, + pass_2, + ncon, + tgobj,ncgutil,cgobj,cgutils,paramgr +{$ifndef cpu64bitalu} + ,cg64f32 +{$endif not cpu64bitalu} + ; + +{***************************************************************************** + TCGUNARYMINUSNODE +*****************************************************************************} + + procedure tcgunaryminusnode.emit_float_sign_change(r: tregister; _size : tcgsize); + var + href, + href2 : treference; + begin + { get a temporary memory reference to store the floating + point value + } + tg.gettemp(current_asmdata.CurrAsmList,tcgsize2size[_size],tcgsize2size[_size],tt_normal,href); + { store the floating point value in the temporary memory area } + cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,_size,_size,r,href); + { only single and double ieee are supported, for little endian + the signed bit is in the second dword } + href2:=href; + case _size of + OS_F64 : + if target_info.endian = endian_little then + inc(href2.offset,4); + OS_F32 : + ; + else + internalerror(200406021); + end; + { flip sign-bit (bit 31/63) of single/double } + cg.a_op_const_ref(current_asmdata.CurrAsmList,OP_XOR,OS_32,aint($80000000),href2); + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,_size,_size,href,r); + tg.ungetiftemp(current_asmdata.CurrAsmList,href); + end; + + +{$ifndef cpu64bitalu} + procedure tcgunaryminusnode.second_64bit; + var + tr: tregister; + hl: tasmlabel; + begin + secondpass(left); + location_reset(location,LOC_REGISTER,left.location.size); + location.register64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg64.a_op64_loc_reg(current_asmdata.CurrAsmList,OP_NEG,OS_S64, + left.location,joinreg64(location.register64.reglo,location.register64.reghi)); + { there's only overflow in case left was low(int64) -> -left = left } + if (cs_check_overflow in current_settings.localswitches) then + begin + tr:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_INT, + aint($80000000),location.register64.reghi,tr); + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_INT, + location.register64.reglo,tr); + current_asmdata.getjumplabel(hl); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_NE,0,tr,hl); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false); + cg.a_label(current_asmdata.CurrAsmList,hl); + end; + end; +{$endif not cpu64bitalu} + + procedure tcgunaryminusnode.second_float; + begin + secondpass(left); + location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); + case left.location.loc of + LOC_REFERENCE, + LOC_CREFERENCE : + begin + location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size); + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList, + left.location.size,location.size, + left.location.reference,location.register); + emit_float_sign_change(location.register,def_cgsize(left.resultdef)); + end; + LOC_FPUREGISTER: + begin + location.register:=left.location.register; + emit_float_sign_change(location.register,def_cgsize(left.resultdef)); + end; + LOC_CFPUREGISTER: + begin + location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size); + cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,location.register); + emit_float_sign_change(location.register,def_cgsize(left.resultdef)); + end; + else + internalerror(200306021); + end; + end; + + + procedure tcgunaryminusnode.second_integer; + var + hl: tasmlabel; + begin + secondpass(left); + { load left operator in a register } + location_copy(location,left.location); + location_force_reg(current_asmdata.CurrAsmList,location,OS_SINT,false); + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,OS_SINT,location.register,location.register); + + if (cs_check_overflow in current_settings.localswitches) then + begin + current_asmdata.getjumplabel(hl); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_SINT,OC_NE,low(aint),location.register,hl); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false); + cg.a_label(current_asmdata.CurrAsmList,hl); + end; + end; + + + procedure tcgunaryminusnode.pass_generate_code; + begin +{$ifndef cpu64bitalu} + if is_64bit(left.resultdef) then + second_64bit + else +{$endif not cpu64bitalu} +{$ifdef SUPPORT_MMX} + if (cs_mmx in current_settings.localswitches) and is_mmx_able_array(left.resultdef) then + second_mmx + else +{$endif SUPPORT_MMX} + if (left.resultdef.typ=floatdef) then + second_float + else + second_integer; + end; + + +{***************************************************************************** + TCGMODDIVNODE +*****************************************************************************} + +{$ifndef cpu64bitalu} + procedure tcgmoddivnode.emit64_div_reg_reg(signed: boolean; denum,num:tregister64); + begin + { handled in pass_1 already, unless pass_1 is + overridden + } + { should be handled in pass_1 (JM) } + internalerror(200109052); + end; +{$endif not cpu64bitalu} + + + procedure tcgmoddivnode.pass_generate_code; + var + hreg1 : tregister; + hdenom : tregister; + power : longint; + hl : tasmlabel; + paraloc1 : tcgpara; + opsize : tcgsize; + begin + secondpass(left); + if codegenerror then + exit; + secondpass(right); + if codegenerror then + exit; + location_copy(location,left.location); + +{$ifndef cpu64bitalu} + if is_64bit(resultdef) then + begin + if is_signed(left.resultdef) then + opsize:=OS_S64 + else + opsize:=OS_64; + + { this code valid for 64-bit cpu's only , + otherwise helpers are called in pass_1 + } + location_force_reg(current_asmdata.CurrAsmList,location,opsize,false); + location_copy(location,left.location); + location_force_reg(current_asmdata.CurrAsmList,right.location,opsize,false); + emit64_div_reg_reg(is_signed(left.resultdef), + joinreg64(right.location.register64.reglo,right.location.register64.reghi), + joinreg64(location.register64.reglo,location.register64.reghi)); + end + else +{$endif not cpu64bitalu} + begin + if is_signed(left.resultdef) then + opsize:=OS_SINT + else + opsize:=OS_INT; + + { put numerator in register } + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,false); + hreg1:=left.location.register; + + if (nodetype=divn) and + (right.nodetype=ordconstn) and + ispowerof2(tordconstnode(right).value.svalue,power) then + Begin + { for signed numbers, the numerator must be adjusted before the + shift instruction, but not wih unsigned numbers! Otherwise, + "Cardinal($ffffffff) div 16" overflows! (JM) } + If is_signed(left.resultdef) Then + Begin + current_asmdata.getjumplabel(hl); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_GT,0,hreg1,hl); + if power=1 then + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_ADD,OS_INT,1,hreg1) + else + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_ADD,OS_INT,Tordconstnode(right).value.svalue-1,hreg1); + cg.a_label(current_asmdata.CurrAsmList,hl); + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SAR,OS_INT,power,hreg1); + End + Else { not signed } + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHR,OS_INT,power,hreg1); + End + else + begin + { bring denominator to hdenom } + { hdenom is always free, it's } + { only used for temporary } + { purposes } + hdenom := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.a_load_loc_reg(current_asmdata.CurrAsmList,right.location.size,right.location,hdenom); + { verify if the divisor is zero, if so return an error + immediately + } + current_asmdata.getjumplabel(hl); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_NE,0,hdenom,hl); + paraloc1.init; + paramanager.getintparaloc(pocall_default,1,paraloc1); + cg.a_load_const_cgpara(current_asmdata.CurrAsmList,OS_S32,aint(200),paraloc1); + paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_HANDLEERROR',false); + paraloc1.done; + cg.a_label(current_asmdata.CurrAsmList,hl); + if nodetype = modn then + emit_mod_reg_reg(is_signed(left.resultdef),hdenom,hreg1) + else + emit_div_reg_reg(is_signed(left.resultdef),hdenom,hreg1); + end; + location_reset(location,LOC_REGISTER,opsize); + location.register:=hreg1; + end; + cg.g_overflowcheck(current_asmdata.CurrAsmList,location,resultdef); + end; + + +{***************************************************************************** + TCGSHLRSHRNODE +*****************************************************************************} + + +{$ifndef cpu64bitalu} + procedure tcgshlshrnode.second_64bit; + begin + { already hanled in 1st pass } + internalerror(2002081501); + end; +{$endif not cpu64bitalu} + + + procedure tcgshlshrnode.second_integer; + var + op : topcg; + hcountreg : tregister; + opsize : tcgsize; + begin + { determine operator } + case nodetype of + shln: op:=OP_SHL; + shrn: op:=OP_SHR; + end; +{$ifdef cpunodefaultint} + opsize:=left.location.size; +{$else cpunodefaultint} + { load left operators in a register } + if is_signed(left.resultdef) then + opsize:=OS_SINT + else + opsize:=OS_INT; +{$endif cpunodefaultint} + + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,true); + location_reset(location,LOC_REGISTER,opsize); + location.register:=cg.getintregister(current_asmdata.CurrAsmList,opsize); + + { shifting by a constant directly coded: } + if (right.nodetype=ordconstn) then + begin + { l shl 32 should 0 imho, but neither TP nor Delphi do it in this way (FK) + if right.value<=31 then + } + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,op,location.size, + tordconstnode(right).value.uvalue and 31,left.location.register,location.register); + { + else + emit_reg_reg(A_XOR,S_L,hregister1, + hregister1); + } + end + else + begin + { load right operators in a register - this + is done since most target cpu which will use this + node do not support a shift count in a mem. location (cec) + } + if right.location.loc<>LOC_REGISTER then + begin + hcountreg:=cg.getintregister(current_asmdata.CurrAsmList,opsize); + cg.a_load_loc_reg(current_asmdata.CurrAsmList,right.location.size,right.location,hcountreg); + end + else + hcountreg:=right.location.register; + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,op,opsize,hcountreg,left.location.register,location.register); + end; + end; + + + procedure tcgshlshrnode.pass_generate_code; + begin + secondpass(left); + secondpass(right); +{$ifndef cpu64bitalu} + if is_64bit(left.resultdef) then + second_64bit + else +{$endif not cpu64bitalu} + second_integer; + end; + + +{***************************************************************************** + TCGNOTNODE +*****************************************************************************} + +{$ifndef cpu64bitalu} + procedure tcgnotnode.second_64bit; + begin + secondpass(left); + location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),false); + location_copy(location,left.location); + { perform the NOT operation } + cg64.a_op64_reg_reg(current_asmdata.CurrAsmList,OP_NOT,location.size,left.location.register64,location.register64); + end; +{$endif not cpu64bitalu} + + + procedure tcgnotnode.second_integer; + begin + secondpass(left); + location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),false); + location_copy(location,left.location); + { perform the NOT operation } + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NOT,location.size,location.register,location.register); + end; + + + procedure tcgnotnode.pass_generate_code; + begin + if is_boolean(resultdef) then + second_boolean +{$ifdef SUPPORT_MMX} + else if (cs_mmx in current_settings.localswitches) and is_mmx_able_array(left.resultdef) then + second_mmx +{$endif SUPPORT_MMX} +{$ifndef cpu64bitalu} + else if is_64bit(left.resultdef) then + second_64bit +{$endif not cpu64bitalu} + else + second_integer; + end; + +begin + cmoddivnode:=tcgmoddivnode; + cunaryminusnode:=tcgunaryminusnode; + cshlshrnode:=tcgshlshrnode; + cnotnode:=tcgnotnode; +end. diff --git a/closures/compiler/ncgmem.pas b/closures/compiler/ncgmem.pas new file mode 100644 index 0000000000..3e77038df9 --- /dev/null +++ b/closures/compiler/ncgmem.pas @@ -0,0 +1,1005 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate assembler for memory related nodes which are + the same for all (most?) 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. + + **************************************************************************** +} +unit ncgmem; + +{$i fpcdefs.inc} + +interface + + uses + globtype,cgbase,cpuinfo,cpubase, + node,nmem; + + type + tcgloadvmtaddrnode = class(tloadvmtaddrnode) + procedure pass_generate_code;override; + end; + + tcgloadparentfpnode = class(tloadparentfpnode) + procedure pass_generate_code;override; + end; + + tcgaddrnode = class(taddrnode) + procedure pass_generate_code;override; + end; + + tcgderefnode = class(tderefnode) + procedure pass_generate_code;override; + end; + + tcgsubscriptnode = class(tsubscriptnode) + procedure pass_generate_code;override; + end; + + tcgwithnode = class(twithnode) + procedure pass_generate_code;override; + end; + + tcgvecnode = class(tvecnode) + function get_mul_size : aint; + private + procedure rangecheck_array; + procedure rangecheck_string; + protected + {# This routine is used to calculate the address of the reference. + On entry reg contains the index in the array, + and l contains the size of each element in the array. + This routine should update location.reference correctly, + so it points to the correct address. + } + procedure update_reference_reg_mul(maybe_const_reg:tregister;l:aint);virtual; + procedure update_reference_reg_packed(maybe_const_reg:tregister;l:aint);virtual; + procedure second_wideansistring;virtual; + procedure second_dynamicarray;virtual; + public + procedure pass_generate_code;override; + end; + + +implementation + + uses + systems, + cutils,cclasses,verbose,globals,constexp, + symconst,symdef,symsym,symtable,defutil,paramgr, + aasmbase,aasmtai,aasmdata, + procinfo,pass_2,parabase, + pass_1,nld,ncon,nadd,nutils, + cgutils,cgobj, + tgobj,ncgutil,objcgutl + ; + + +{***************************************************************************** + TCGLOADVMTADDRNODE +*****************************************************************************} + + procedure tcgloadvmtaddrnode.pass_generate_code; + var + href : treference; + pool : THashSet; + entry : PHashSetItem; + + begin + location_reset(location,LOC_REGISTER,OS_ADDR); + if (left.nodetype=typen) then + begin + location.register:=cg.getaddressregister(current_asmdata.CurrAsmList); + if not is_objcclass(left.resultdef) then + begin + reference_reset_symbol(href, + current_asmdata.RefAsmSymbol(tobjectdef(tclassrefdef(resultdef).pointeddef).vmt_mangledname),0, + sizeof(pint)); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,href,location.register); + end + else + begin + pool:=current_asmdata.ConstPools[sp_objcclassnamerefs]; + entry:=pool.FindOrAdd(@tobjectdef(left.resultdef).objextname^[1],length(tobjectdef(left.resultdef).objextname^)); + if (target_info.system in systems_objc_nfabi) then + begin + { find/add necessary classref/classname pool entries } + objcfinishclassrefnfpoolentry(entry,tobjectdef(left.resultdef)); + end + else + begin + { find/add necessary classref/classname pool entries } + objcfinishstringrefpoolentry(entry,sp_objcclassnames,sec_objc_cls_refs,sec_objc_class_names); + end; + reference_reset_symbol(href,tasmlabel(entry^.Data),0,sizeof(pint)); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,location.register); + end; + end + else + begin + { left contains self, load vmt from self } + secondpass(left); + gen_load_vmt_register(current_asmdata.CurrAsmList,tobjectdef(left.resultdef),left.location,location.register); + end; + end; + + +{***************************************************************************** + TCGLOADPARENTFPNODE +*****************************************************************************} + + procedure tcgloadparentfpnode.pass_generate_code; + var + currpi : tprocinfo; + hsym : tparavarsym; + href : treference; + begin + if (current_procinfo.procdef.parast.symtablelevel=parentpd.parast.symtablelevel) then + begin + location_reset(location,LOC_REGISTER,OS_ADDR); + location.register:=current_procinfo.framepointer; + end + else + begin + currpi:=current_procinfo; + location_reset(location,LOC_REGISTER,OS_ADDR); + location.register:=cg.getaddressregister(current_asmdata.CurrAsmList); + { load framepointer of current proc } + hsym:=tparavarsym(currpi.procdef.parast.Find('parentfp')); + if not assigned(hsym) then + internalerror(200309281); + cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_ADDR,hsym.localloc,location.register); + { walk parents } + while (currpi.procdef.owner.symtablelevel>parentpd.parast.symtablelevel) do + begin + currpi:=currpi.parent; + if not assigned(currpi) then + internalerror(200311201); + hsym:=tparavarsym(currpi.procdef.parast.Find('parentfp')); + if not assigned(hsym) then + internalerror(200309282); + + if hsym.localloc.loc<>LOC_REFERENCE then + internalerror(200309283); + + reference_reset_base(href,location.register,hsym.localloc.reference.offset,sizeof(pint)); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,location.register); + end; + end; + end; + + +{***************************************************************************** + TCGADDRNODE +*****************************************************************************} + + procedure tcgaddrnode.pass_generate_code; + begin + secondpass(left); + + location_reset(location,LOC_REGISTER,OS_ADDR); + location.register:=cg.getaddressregister(current_asmdata.CurrAsmList); + if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then + { on x86_64-win64, array of chars can be returned in registers, however, + when passing these arrays to other functions, the compiler wants to take + the address of the array so when the addrnode has been created internally, + we have to force the data into memory, see also tw14388.pp + } + if nf_internal in flags then + location_force_mem(current_asmdata.CurrAsmList,left.location) + else + internalerror(2006111510); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,location.register); + end; + + +{***************************************************************************** + TCGDEREFNODE +*****************************************************************************} + + procedure tcgderefnode.pass_generate_code; + var + paraloc1 : tcgpara; + begin + secondpass(left); + { assume natural alignment, except for packed records } + if not(resultdef.typ in [recorddef,objectdef]) or + (tabstractrecordsymtable(tabstractrecorddef(resultdef).symtable).usefieldalignment<>1) then + location_reset_ref(location,LOC_REFERENCE,def_cgsize(resultdef),resultdef.alignment) + else + location_reset_ref(location,LOC_REFERENCE,def_cgsize(resultdef),1); + if not(left.location.loc in [LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE,LOC_CONSTANT]) then + location_force_reg(current_asmdata.CurrAsmList,left.location,OS_ADDR,true); + case left.location.loc of + LOC_CREGISTER, + LOC_REGISTER: + begin + maybechangeloadnodereg(current_asmdata.CurrAsmList,left,true); + {$ifdef cpu_uses_separate_address_registers} + if getregtype(left.location.register)<>R_ADDRESSREGISTER then + begin + location.reference.base := cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.register, + location.reference.base); + end + else + {$endif} + location.reference.base := left.location.register; + end; + LOC_CREFERENCE, + LOC_REFERENCE: + begin + location.reference.base:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_ADDR,left.location,location.reference.base); + end; + LOC_CONSTANT: + begin + location.reference.offset:=left.location.value; + end; + else + internalerror(200507031); + end; + if (cs_use_heaptrc in current_settings.globalswitches) and + (cs_checkpointer in current_settings.localswitches) and + not(cs_compilesystem in current_settings.moduleswitches) and + not(tpointerdef(left.resultdef).is_far) and + not(nf_no_checkpointer in flags) and + { can be NR_NO in case of LOC_CONSTANT } + (location.reference.base<>NR_NO) then + begin + paraloc1.init; + paramanager.getintparaloc(pocall_default,1,paraloc1); + cg.a_load_reg_cgpara(current_asmdata.CurrAsmList, OS_ADDR,location.reference.base,paraloc1); + paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1); + paraloc1.done; + cg.allocallcpuregisters(current_asmdata.CurrAsmList); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CHECKPOINTER',false); + cg.deallocallcpuregisters(current_asmdata.CurrAsmList); + end; + end; + + +{***************************************************************************** + TCGSUBSCRIPTNODE +*****************************************************************************} + + procedure tcgsubscriptnode.pass_generate_code; + var + sym: tasmsymbol; + paraloc1 : tcgpara; + hreg : tregister; + tmpref: treference; + sref: tsubsetreference; + begin + secondpass(left); + if codegenerror then + exit; + paraloc1.init; + { several object types must be dereferenced implicitly } + if is_implicit_pointer_object_type(left.resultdef) then + begin + if not is_managed_type(left.resultdef) then + begin + { the contents of a class are aligned to a sizeof(pointer) } + location_reset_ref(location,LOC_REFERENCE,def_cgsize(resultdef),sizeof(pint)); + case left.location.loc of + LOC_CREGISTER, + LOC_REGISTER: + begin + {$ifdef cpu_uses_separate_address_registers} + if getregtype(left.location.register)<>R_ADDRESSREGISTER then + begin + location.reference.base:=rg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR, + left.location.register,location.reference.base); + end + else + {$endif} + location.reference.base := left.location.register; + end; + LOC_CREFERENCE, + LOC_REFERENCE: + begin + location.reference.base:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_ADDR,left.location,location.reference.base); + end; + LOC_CONSTANT: + begin + { can happen with @classtype(pointerconst).field } + location.reference.offset:=left.location.value; + end; + else + internalerror(2009092401); + end; + { implicit deferencing } + if (cs_use_heaptrc in current_settings.globalswitches) and + (cs_checkpointer in current_settings.localswitches) and + not(cs_compilesystem in current_settings.moduleswitches) then + begin + paramanager.getintparaloc(pocall_default,1,paraloc1); + cg.a_load_reg_cgpara(current_asmdata.CurrAsmList, OS_ADDR,location.reference.base,paraloc1); + paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1); + cg.allocallcpuregisters(current_asmdata.CurrAsmList); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_CHECKPOINTER',false); + cg.deallocallcpuregisters(current_asmdata.CurrAsmList); + end; + end + else + { reference-counted implicit pointer object types don't have + fields -> cannot be subscripted (calls are handled via call + nodes) } + internalerror(2011011901); + end + else + begin + location_copy(location,left.location); + { some abi's require that functions return (some) records in } + { registers } + case location.loc of + LOC_REFERENCE, + LOC_CREFERENCE: + ; + LOC_REGISTER, + LOC_CREGISTER, + LOC_MMREGISTER, + LOC_FPUREGISTER: + begin + // in case the result is not something that can be put + // into an integer register (e.g. + // function_returning_record().non_regable_field, or + // a function returning a value > sizeof(intreg)) + // -> force to memory + if not tstoreddef(left.resultdef).is_intregable or + not tstoreddef(resultdef).is_intregable or + (location.loc in [LOC_MMREGISTER,LOC_FPUREGISTER]) then + location_force_mem(current_asmdata.CurrAsmList,location) + else + begin + if (left.location.loc = LOC_REGISTER) then + location.loc := LOC_SUBSETREG + else + location.loc := LOC_CSUBSETREG; + location.size:=def_cgsize(resultdef); + location.sreg.subsetreg := left.location.register; + location.sreg.subsetregsize := left.location.size; + if not is_packed_record_or_object(left.resultdef) then + begin + if (target_info.endian = ENDIAN_BIG) then + location.sreg.startbit := (tcgsize2size[location.sreg.subsetregsize] - tcgsize2size[location.size] - vs.fieldoffset) * 8 + else + location.sreg.startbit := (vs.fieldoffset * 8); + location.sreg.bitlen := tcgsize2size[location.size] * 8; + end + else + begin + location.sreg.bitlen := resultdef.packedbitsize; + if (target_info.endian = ENDIAN_BIG) then + location.sreg.startbit := (tcgsize2size[location.sreg.subsetregsize]*8 - location.sreg.bitlen) - vs.fieldoffset + else + location.sreg.startbit := vs.fieldoffset; + end; + end; + end; + LOC_SUBSETREG, + LOC_CSUBSETREG: + begin + location.size:=def_cgsize(resultdef); + if not is_packed_record_or_object(left.resultdef) then + begin + if (target_info.endian = ENDIAN_BIG) then + inc(location.sreg.startbit, (left.resultdef.size - tcgsize2size[location.size] - vs.fieldoffset) * 8) + else + inc(location.sreg.startbit, vs.fieldoffset * 8); + location.sreg.bitlen := tcgsize2size[location.size] * 8; + end + else + begin + location.sreg.bitlen := resultdef.packedbitsize; + if (target_info.endian = ENDIAN_BIG) then + inc(location.sreg.startbit, left.location.sreg.bitlen - location.sreg.bitlen - vs.fieldoffset) + else + inc(location.sreg.startbit, vs.fieldoffset); + end; + end; + else + internalerror(2006031901); + end; + end; + + if is_objc_class_or_protocol(left.resultdef) and + (target_info.system in systems_objc_nfabi) then + begin + if (location.loc<>LOC_REFERENCE) or + (location.reference.index<>NR_NO) then + internalerror(2009092402); + { the actual field offset is stored in memory (to solve the + "fragile base class" problem: this way the layout of base + classes can be changed without breaking programs compiled against + earlier versions) + } + hreg:=cg.g_indirect_sym_load(current_asmdata.CurrAsmList,vs.mangledname,false); + { TODO: clean up. g_indirect_sym_load cannot perform + a plain load for targets that don't need an indirect load + because it's also used in ncgld, but this is not very nice... + } + if (hreg=NR_NO) then + begin + sym:=current_asmdata.RefAsmSymbol(vs.mangledname); + reference_reset_symbol(tmpref,sym,0,sizeof(pint)); + location.reference.index:=cg.getaddressregister(current_asmdata.CurrAsmList); + end + else + begin + reference_reset_base(tmpref,hreg,0,sizeof(pint)); + location.reference.index:=hreg; + end; + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,tmpref,location.reference.index); + { always packrecords C -> natural alignment } + location.reference.alignment:=vs.vardef.alignment; + end + else if (location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then + begin + if not is_packed_record_or_object(left.resultdef) then + begin + inc(location.reference.offset,vs.fieldoffset); + location.reference.alignment:=newalignment(location.reference.alignment,vs.fieldoffset); + end + else if (vs.fieldoffset mod 8 = 0) and + (resultdef.packedbitsize mod 8 = 0) and + { is different in case of e.g. packenum 2 and an enum } + { which fits in 8 bits } + (resultdef.size*8 = resultdef.packedbitsize) then + begin + inc(location.reference.offset,vs.fieldoffset div 8); + location.reference.alignment:=newalignment(location.reference.alignment,vs.fieldoffset div 8); + end + else + begin + sref.ref:=location.reference; + sref.ref.alignment:=1; + sref.bitindexreg:=NR_NO; + inc(sref.ref.offset,vs.fieldoffset div 8); + sref.startbit:=vs.fieldoffset mod 8; + sref.bitlen:=resultdef.packedbitsize; + if (left.location.loc=LOC_REFERENCE) then + location.loc:=LOC_SUBSETREF + else + location.loc:=LOC_CSUBSETREF; + location.sref:=sref; + end; + { also update the size of the location } + location.size:=def_cgsize(resultdef); + end; + paraloc1.done; + end; + + +{***************************************************************************** + TCGWITHNODE +*****************************************************************************} + + procedure tcgwithnode.pass_generate_code; + begin + location_reset(location,LOC_VOID,OS_NO); + + if assigned(left) then + secondpass(left); + end; + + +{***************************************************************************** + TCGVECNODE +*****************************************************************************} + + function tcgvecnode.get_mul_size : aint; + begin + if nf_memindex in flags then + get_mul_size:=1 + else + begin + if (left.resultdef.typ=arraydef) then + if not is_packed_array(left.resultdef) then + get_mul_size:=tarraydef(left.resultdef).elesize + else + get_mul_size:=tarraydef(left.resultdef).elepackedbitsize + else + get_mul_size:=resultdef.size; + end + end; + + + { this routine must, like any other routine, not change the contents } + { of base/index registers of references, as these may be regvars. } + { The register allocator can coalesce one LOC_REGISTER being moved } + { into another (as their live ranges won't overlap), but not a } + { LOC_CREGISTER moved into a LOC_(C)REGISTER most of the time (as } + { the live range of the LOC_CREGISTER will most likely overlap the } + { the live range of the target LOC_(C)REGISTER) } + { The passed register may be a LOC_CREGISTER as well. } + procedure tcgvecnode.update_reference_reg_mul(maybe_const_reg:tregister;l:aint); + var + hreg: tregister; + begin + if l<>1 then + begin + hreg:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_IMUL,OS_ADDR,l,maybe_const_reg,hreg); + maybe_const_reg:=hreg; + end; + if location.reference.base=NR_NO then + location.reference.base:=maybe_const_reg + else if location.reference.index=NR_NO then + location.reference.index:=maybe_const_reg + else + begin + hreg:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,location.reference,hreg); + reference_reset_base(location.reference,hreg,0,location.reference.alignment); + { insert new index register } + location.reference.index:=maybe_const_reg; + end; + { update alignment } + if (location.reference.alignment=0) then + internalerror(2009020704); + location.reference.alignment:=newalignment(location.reference.alignment,l); + end; + + + { see remarks for tcgvecnode.update_reference_reg_mul above } + procedure tcgvecnode.update_reference_reg_packed(maybe_const_reg:tregister;l:aint); + var + sref: tsubsetreference; + offsetreg, hreg: tregister; + alignpower: aint; + temp : longint; + begin + { only orddefs are bitpacked. Even then we only need special code in } + { case the bitpacked *byte size* is not a power of two, otherwise } + { everything can be handled using the the regular array code. } + if ((l mod 8) = 0) and + (ispowerof2(l div 8,temp) or + not is_ordinal(resultdef) +{$ifndef cpu64bitalu} + or is_64bitint(resultdef) +{$endif not cpu64bitalu} + ) then + begin + update_reference_reg_mul(maybe_const_reg,l div 8); + exit; + end; + if (l > 8*sizeof(aint)) then + internalerror(200608051); + sref.ref := location.reference; + hreg := cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,tarraydef(left.resultdef).lowrange,maybe_const_reg,hreg); + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_IMUL,OS_INT,l,hreg); + { keep alignment for index } + sref.ref.alignment := left.resultdef.alignment; + if not ispowerof2(sref.ref.alignment,temp) then + internalerror(2006081201); + alignpower:=temp; + offsetreg := cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_ADDR,3+alignpower,hreg,offsetreg); + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SHL,OS_ADDR,alignpower,offsetreg); + if (sref.ref.base = NR_NO) then + sref.ref.base := offsetreg + else if (sref.ref.index = NR_NO) then + sref.ref.index := offsetreg + else + begin + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_ADD,OS_ADDR,sref.ref.base,offsetreg); + sref.ref.base := offsetreg; + end; + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_AND,OS_INT,(1 shl (3+alignpower))-1,hreg); + sref.bitindexreg := hreg; + sref.startbit := 0; + sref.bitlen := resultdef.packedbitsize; + if (left.location.loc = LOC_REFERENCE) then + location.loc := LOC_SUBSETREF + else + location.loc := LOC_CSUBSETREF; + location.sref := sref; + end; + + + procedure tcgvecnode.second_wideansistring; + begin + end; + + procedure tcgvecnode.second_dynamicarray; + begin + end; + + + procedure tcgvecnode.rangecheck_array; + var + hightree : tnode; + poslabel, + neglabel : tasmlabel; + hreg : tregister; + paraloc1,paraloc2 : tcgpara; + begin + { omit range checking when this is an array access to a pointer which has been + typecasted from an array } + if (ado_isconvertedpointer in tarraydef(left.resultdef).arrayoptions) then + exit; + paraloc1.init; + paraloc2.init; + if is_open_array(left.resultdef) or + is_array_of_const(left.resultdef) then + begin + { cdecl functions don't have high() so we can not check the range } + { (can't use current_procdef, since it may be a nested procedure) } + if not(tprocdef(tparasymtable(tparavarsym(tloadnode(left).symtableentry).owner).defowner).proccalloption in cdecl_pocalls) then + begin + { Get high value } + hightree:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry)); + { it must be available } + if not assigned(hightree) then + internalerror(200212201); + firstpass(hightree); + secondpass(hightree); + { generate compares } + if (right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then + hreg:=cg.makeregsize(current_asmdata.CurrAsmList,right.location.register,OS_INT) + else + begin + hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_INT,right.location,hreg); + end; + current_asmdata.getjumplabel(neglabel); + current_asmdata.getjumplabel(poslabel); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_LT,0,hreg,poslabel); + cg.a_cmp_loc_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_BE,hightree.location,hreg,neglabel); + cg.a_label(current_asmdata.CurrAsmList,poslabel); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RANGEERROR',false); + cg.a_label(current_asmdata.CurrAsmList,neglabel); + { release hightree } + hightree.free; + end; + end + else + if is_dynamic_array(left.resultdef) then + begin + paramanager.getintparaloc(pocall_default,1,paraloc1); + paramanager.getintparaloc(pocall_default,2,paraloc2); + cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,right.location,paraloc2); + cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,left.location,paraloc1); + paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1); + paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc2); + cg.allocallcpuregisters(current_asmdata.CurrAsmList); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DYNARRAY_RANGECHECK',false); + cg.deallocallcpuregisters(current_asmdata.CurrAsmList); + end; +{ for regular arrays, we don't have to do anything because the index has been + type converted to the index type, which already inserted a range check if + necessary } + paraloc1.done; + paraloc2.done; + end; + + procedure tcgvecnode.rangecheck_string; + var + paraloc1, + paraloc2: tcgpara; + begin + paraloc1.init; + paraloc2.init; + case tstringdef(left.resultdef).stringtype of + { it's the same for ansi- and wide strings } + st_unicodestring, + st_widestring, + st_ansistring: + begin + paramanager.getintparaloc(pocall_default,1,paraloc1); + paramanager.getintparaloc(pocall_default,2,paraloc2); + cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,left.location,paraloc1); + cg.a_load_loc_cgpara(current_asmdata.CurrAsmList,right.location,paraloc2); + + paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc1); + paramanager.freecgpara(current_asmdata.CurrAsmList,paraloc2); + cg.allocallcpuregisters(current_asmdata.CurrAsmList); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_'+upper(tstringdef(left.resultdef).stringtypname)+'_RANGECHECK',false); + cg.deallocallcpuregisters(current_asmdata.CurrAsmList); + end; + + st_shortstring: + begin + {!!!!!!!!!!!!!!!!!} + { if this one is implemented making use of the high parameter for openshortstrings, update ncgutils.do_get_used_regvars() too (JM) } + end; + + st_longstring: + begin + {!!!!!!!!!!!!!!!!!} + end; + end; + paraloc1.done; + paraloc2.done; + end; + + procedure tcgvecnode.pass_generate_code; + + var + offsetdec, + extraoffset : aint; + t : tnode; + otl,ofl : tasmlabel; + newsize : tcgsize; + mulsize, + bytemulsize, + alignpow : aint; + isjump : boolean; + paraloc1, + paraloc2 : tcgpara; + subsetref : tsubsetreference; + temp : longint; + begin + paraloc1.init; + paraloc2.init; + mulsize:=get_mul_size; + if not is_packed_array(left.resultdef) then + bytemulsize:=mulsize + else + bytemulsize:=mulsize div 8; + + newsize:=def_cgsize(resultdef); + secondpass(left); + if left.location.loc=LOC_CREFERENCE then + location_reset_ref(location,LOC_CREFERENCE,newsize,left.location.reference.alignment) + else + location_reset_ref(location,LOC_REFERENCE,newsize,left.location.reference.alignment); + + { an ansistring needs to be dereferenced } + if is_ansistring(left.resultdef) or + is_wide_or_unicode_string(left.resultdef) then + begin + if nf_callunique in flags then + internalerror(200304236); + + {DM!!!!!} + case left.location.loc of + LOC_REGISTER, + LOC_CREGISTER : + begin +{$ifdef m68k} + location.reference.base:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.register,location.reference.base); +{$else m68k} + location.reference.base:=left.location.register; +{$endif m68k} + end; + LOC_CREFERENCE, + LOC_REFERENCE : + begin + location.reference.base:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.reference,location.reference.base); + end; + else + internalerror(2002032218); + end; + + { in ansistrings/widestrings S[1] is p<w>char(S)[0] !! } + if is_ansistring(left.resultdef) then + offsetdec:=1 + else + offsetdec:=2; + location.reference.alignment:=offsetdec; + dec(location.reference.offset,offsetdec); + end + else if is_dynamic_array(left.resultdef) then + begin + case left.location.loc of + LOC_REGISTER, + LOC_CREGISTER : + location.reference.base:=left.location.register; + LOC_REFERENCE, + LOC_CREFERENCE : + begin + location.reference.base:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR, + left.location.reference,location.reference.base); + end; + else + internalerror(2002032219); + end; + { a dynarray points to the start of a memory block, which + we assume to be always aligned to a multiple of the + pointer size + } + location.reference.alignment:=sizeof(pint); + end + else + begin + { may happen in case of function results } + case left.location.loc of + LOC_REGISTER, + LOC_MMREGISTER: + location_force_mem(current_asmdata.CurrAsmList,left.location); + end; + location_copy(location,left.location); + end; + + { location must be memory } + if not(location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then + internalerror(200411013); + + { offset can only differ from 0 if arraydef } + if (left.resultdef.typ=arraydef) and + not(is_dynamic_array(left.resultdef)) and + (not(is_packed_array(left.resultdef)) or + ((mulsize mod 8 = 0) and + ispowerof2(mulsize div 8,temp)) or + { only orddefs are bitpacked } + not is_ordinal(resultdef) +{$ifndef cpu64bitalu} + or is_64bitint(resultdef) +{$endif not cpu64bitalu} + ) then + dec(location.reference.offset,bytemulsize*tarraydef(left.resultdef).lowrange); + + if right.nodetype=ordconstn then + begin + { offset can only differ from 0 if arraydef } + if cs_check_range in current_settings.localswitches then + begin + secondpass(right); + case left.resultdef.typ of + arraydef : + rangecheck_array; + stringdef : + rangecheck_string; + end; + end; + if not(is_packed_array(left.resultdef)) or + ((mulsize mod 8 = 0) and + (ispowerof2(mulsize div 8,temp) or + { only orddefs are bitpacked } + not is_ordinal(resultdef))) then + begin + extraoffset:=bytemulsize*tordconstnode(right).value.svalue; + inc(location.reference.offset,extraoffset); + { adjust alignment after to this change } + location.reference.alignment:=newalignment(location.reference.alignment,extraoffset); + { don't do this for floats etc.; needed to properly set the } + { size for bitpacked arrays (e.g. a bitpacked array of } + { enums who are size 2 but fit in one byte -> in the array } + { they will be one byte and have to be stored like that) } + if is_packed_array(left.resultdef) and + (tcgsize2size[newsize] <> bytemulsize) then + newsize:=int_cgsize(bytemulsize); + end + else + begin + subsetref.ref := location.reference; + subsetref.ref.alignment := left.resultdef.alignment; + if not ispowerof2(subsetref.ref.alignment,temp) then + internalerror(2006081212); + alignpow:=temp; + inc(subsetref.ref.offset,((mulsize * (tordconstnode(right).value.svalue-tarraydef(left.resultdef).lowrange)) shr (3+alignpow)) shl alignpow); + subsetref.bitindexreg := NR_NO; + subsetref.startbit := (mulsize * (tordconstnode(right).value.svalue-tarraydef(left.resultdef).lowrange)) and ((1 shl (3+alignpow))-1); + subsetref.bitlen := resultdef.packedbitsize; + if (left.location.loc = LOC_REFERENCE) then + location.loc := LOC_SUBSETREF + else + location.loc := LOC_CSUBSETREF; + location.sref := subsetref; + end; + end + else + { not nodetype=ordconstn } + begin + if (cs_opt_level1 in current_settings.optimizerswitches) and + { if we do range checking, we don't } + { need that fancy code (it would be } + { buggy) } + not(cs_check_range in current_settings.localswitches) and + (left.resultdef.typ=arraydef) and + not is_packed_array(left.resultdef) then + begin + extraoffset:=0; + if (right.nodetype=addn) then + begin + if taddnode(right).right.nodetype=ordconstn then + begin + extraoffset:=tordconstnode(taddnode(right).right).value.svalue; + t:=taddnode(right).left; + taddnode(right).left:=nil; + right.free; + right:=t; + end + else if taddnode(right).left.nodetype=ordconstn then + begin + extraoffset:=tordconstnode(taddnode(right).left).value.svalue; + t:=taddnode(right).right; + taddnode(right).right:=nil; + right.free; + right:=t; + end; + end + else if (right.nodetype=subn) then + begin + if taddnode(right).right.nodetype=ordconstn then + begin + extraoffset:=-tordconstnode(taddnode(right).right).value.svalue; + t:=taddnode(right).left; + taddnode(right).left:=nil; + right.free; + right:=t; + end; + end; + inc(location.reference.offset, + mulsize*extraoffset); + end; + { calculate from left to right } + if not(location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then + internalerror(200304237); + isjump:=(right.expectloc=LOC_JUMP); + if isjump then + begin + otl:=current_procinfo.CurrTrueLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + ofl:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + end; + secondpass(right); + + { if mulsize = 1, we won't have to modify the index } + location_force_reg(current_asmdata.CurrAsmList,right.location,OS_ADDR,true); + + if isjump then + begin + current_procinfo.CurrTrueLabel:=otl; + current_procinfo.CurrFalseLabel:=ofl; + end + else if (right.location.loc = LOC_JUMP) then + internalerror(2006010801); + + { produce possible range check code: } + if cs_check_range in current_settings.localswitches then + begin + if left.resultdef.typ=arraydef then + rangecheck_array + else if (left.resultdef.typ=stringdef) then + rangecheck_string; + end; + + { insert the register and the multiplication factor in the + reference } + if not is_packed_array(left.resultdef) then + update_reference_reg_mul(right.location.register,mulsize) + else + update_reference_reg_packed(right.location.register,mulsize); + end; + + location.size:=newsize; + paraloc1.done; + paraloc2.done; + end; + + +begin + cloadvmtaddrnode:=tcgloadvmtaddrnode; + cloadparentfpnode:=tcgloadparentfpnode; + caddrnode:=tcgaddrnode; + cderefnode:=tcgderefnode; + csubscriptnode:=tcgsubscriptnode; + cwithnode:=tcgwithnode; + cvecnode:=tcgvecnode; +end. diff --git a/closures/compiler/ncgobjc.pas b/closures/compiler/ncgobjc.pas new file mode 100644 index 0000000000..39a063c86e --- /dev/null +++ b/closures/compiler/ncgobjc.pas @@ -0,0 +1,102 @@ +{ + Copyright (c) 2009 by Jonas Maebe + + This unit implements code generator support for Objective-C 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 ncgobjc; + +{$i fpcdefs.inc} + +interface + +uses + nobjc; + +type + tcgobjcselectornode = class(tobjcselectornode) + procedure pass_generate_code; override; + end; + + tcgobjcprotocolnode = class(tobjcprotocolnode) + procedure pass_generate_code; override; + end; + +implementation + +uses + globtype,cclasses, + aasmbase,aasmdata,aasmtai, + cgbase,cgutils,defutil,objcgutl, + symconst,symsym,symdef, + node,nld,ncon, + verbose; + +{***************************************************************************** + TCGOBJCSELECTORNODE +*****************************************************************************} + +procedure tcgobjcselectornode.pass_generate_code; + var + pool : THashSet; + entry : PHashSetItem; + name : pshortstring; + begin + pool:=current_asmdata.ConstPools[sp_varnamerefs]; + + case left.nodetype of + loadn: + begin + if (tloadnode(left).symtableentry.typ<>procsym) then + internalerror(2009051602); + if (tprocsym(tloadnode(left).symtableentry).procdeflist.count<>1) then + internalerror(2009051701); + name:=tprocdef(tprocsym(tloadnode(left).symtableentry).procdeflist[0]).messageinf.str; + entry:=pool.FindOrAdd(@name^[1],length(name^)) + end; + stringconstn: + begin + entry:=pool.FindOrAdd(tstringconstnode(left).value_str,tstringconstnode(left).len); + end; + else + internalerror(2009030701); + end; + + objcfinishstringrefpoolentry(entry,sp_objcvarnames,sec_objc_message_refs,sec_objc_meth_var_names); + + location_reset_ref(location,LOC_CREFERENCE,def_cgsize(resultdef),sizeof(pint)); + location.reference.symbol:=tasmlabel(entry^.Data); + end; + + +{***************************************************************************** + TCGOBJCPROTOCOLNODE +*****************************************************************************} + +procedure tcgobjcprotocolnode.pass_generate_code; + begin + { first needs support for writing class definitions } + internalerror(2009072601); + end; + + +begin + cobjcselectornode:=tcgobjcselectornode; + cobjcprotocolnode:=tcgobjcprotocolnode; +end. diff --git a/closures/compiler/ncgopt.pas b/closures/compiler/ncgopt.pas new file mode 100644 index 0000000000..1393eaef9b --- /dev/null +++ b/closures/compiler/ncgopt.pas @@ -0,0 +1,188 @@ +{ + Copyright (c) 1998-2003 by Jonas Maebe + + This unit implements the generic implementation of optimized 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 ncgopt; + +{$i fpcdefs.inc} + +interface +uses node, nopt; + +type + tcgaddsstringcharoptnode = class(taddsstringcharoptnode) + function pass_typecheck: tnode; override; + function pass_1: tnode; override; + procedure pass_generate_code; override; + end; + + +implementation + +uses + globtype,globals, + pass_1,defutil,htypechk, + symdef,paramgr, + aasmbase,aasmtai,aasmdata, + ncnv, ncon, pass_2, + cgbase, cpubase, + tgobj, cgobj, cgutils,ncgutil; + + +{***************************************************************************** + TCGADDOPTNODE +*****************************************************************************} + +function tcgaddsstringcharoptnode.pass_typecheck: tnode; +begin + pass_typecheck := nil; + typecheckpass(left); + typecheckpass(right); + if codegenerror then + exit; + { update the curmaxlen field (before converting to a string!) } + updatecurmaxlen; + if not is_shortstring(left.resultdef) then + inserttypeconv(left,cshortstringtype); + resultdef:=left.resultdef; +end; + + +function tcgaddsstringcharoptnode.pass_1: tnode; +begin + pass_1 := nil; + firstpass(left); + firstpass(right); + if codegenerror then + exit; + expectloc:=LOC_REFERENCE; +end; + + +procedure tcgaddsstringcharoptnode.pass_generate_code; +var + l: tasmlabel; + href,href2 : treference; + hreg, lengthreg: tregister; + checklength: boolean; + len : integer; +begin + { first, we have to more or less replicate some code from } + { ti386addnode.pass_generate_code } + secondpass(left); + if not(tg.istemp(left.location.reference) and + (tg.sizeoftemp(current_asmdata.CurrAsmList,left.location.reference) = 256)) then + begin + tg.Gettemp(current_asmdata.CurrAsmList,256,1,tt_normal,href); + cg.g_copyshortstring(current_asmdata.CurrAsmList,left.location.reference,href,255); + location_freetemp(current_asmdata.CurrAsmList,left.location); + { return temp reference } + location_reset_ref(left.location,LOC_REFERENCE,def_cgsize(resultdef),1); + left.location.reference:=href; + end; + secondpass(right); + { special case for string := string + char (JM) } + hreg:=NR_NO; + + { we have to load the char before checking the length, because we } + { may need registers from the reference } + + { is it a constant char? } + if not is_constcharnode(right) then + { no, make sure it is in a register } + if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then + begin + { get register for the char } + hreg := cg.getintregister(current_asmdata.CurrAsmList,OS_8); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_8,OS_8,right.location.reference,hreg); + { I don't think a temp char exists, but it won't hurt (JM) } + tg.ungetiftemp(current_asmdata.CurrAsmList,right.location.reference); + end + else hreg := right.location.register; + + { load the current string length } + lengthreg := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_8,OS_INT,left.location.reference,lengthreg); + + { do we have to check the length ? } + if tg.istemp(left.location.reference) then + checklength := curmaxlen = 255 + else + checklength := curmaxlen >= tstringdef(left.resultdef).len; + if checklength then + begin + { is it already maximal? } + current_asmdata.getjumplabel(l); + if tg.istemp(left.location.reference) then + len:=255 + else + len:=tstringdef(left.resultdef).len; + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,len,lengthreg,l) + end; + + { no, so increase the length and add the new character } + href2 := left.location.reference; + + { we need a new reference to store the character } + { at the end of the string. Check if the base or } + { index register is still free } + if (href2.base <> NR_NO) and + (href2.index <> NR_NO) then + begin + { they're not free, so add the base reg to } + { the string length (since the index can } + { have a scalefactor) and use lengthreg as base } + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_ADD,OS_INT,href2.base,lengthreg); + href2.base := lengthreg; + end + else + { at least one is still free, so put EDI there } + if href2.base = NR_NO then + href2.base := lengthreg + else + begin + href2.index := lengthreg; +{$ifdef x86} + href2.scalefactor := 1; +{$endif x86} + end; + { we need to be one position after the last char } + inc(href2.offset); + { store the character at the end of the string } + if (right.nodetype <> ordconstn) then + begin + { no new_reference(href2) because it's only } + { used once (JM) } + cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_8,OS_8,hreg,href2); + end + else + cg.a_load_const_ref(current_asmdata.CurrAsmList,OS_8,tordconstnode(right).value.svalue,href2); + lengthreg:=cg.makeregsize(current_asmdata.CurrAsmList,lengthreg,OS_8); + { increase the string length } + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_ADD,OS_8,1,lengthreg); + cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_8,OS_8,lengthreg,left.location.reference); + if checklength then + cg.a_label(current_asmdata.CurrAsmList,l); + location_copy(location,left.location); +end; + +begin + caddsstringcharoptnode := tcgaddsstringcharoptnode; +end. diff --git a/closures/compiler/ncgrtti.pas b/closures/compiler/ncgrtti.pas new file mode 100644 index 0000000000..2d0e7df123 --- /dev/null +++ b/closures/compiler/ncgrtti.pas @@ -0,0 +1,1244 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Routines for the code generation of RTTI data structures + + 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 ncgrtti; + +{$i fpcdefs.inc} + +interface + + uses + cclasses,constexp, + aasmbase, + symbase,symconst,symtype,symdef; + + type + + { TRTTIWriter } + + TRTTIWriter=class + private + procedure fields_write_rtti(st:tsymtable;rt:trttitype); + procedure fields_write_rtti_data(def:tabstractrecorddef;rt:trttitype); + procedure write_rtti_extrasyms(def:Tdef;rt:Trttitype;mainrtti:Tasmsymbol); + procedure published_write_rtti(st:tsymtable;rt:trttitype); + function published_properties_count(st:tsymtable):longint; + procedure published_properties_write_rtti_data(propnamelist:TFPHashObjectList;st:tsymtable); + procedure collect_propnamelist(propnamelist:TFPHashObjectList;objdef:tobjectdef); + procedure write_rtti_name(def:tdef); + procedure write_rtti_data(def:tdef;rt:trttitype); + procedure write_child_rtti_data(def:tdef;rt:trttitype); + function ref_rtti(def:tdef;rt:trttitype):tasmsymbol; + procedure write_header(def: tdef; typekind: byte); + procedure write_string(const s: string); + procedure maybe_write_align; + public + procedure write_rtti(def:tdef;rt:trttitype); + function get_rtti_label(def:tdef;rt:trttitype):tasmsymbol; + function get_rtti_label_ord2str(def:tdef;rt:trttitype):tasmsymbol; + function get_rtti_label_str2ord(def:tdef;rt:trttitype):tasmsymbol; + end; + + var + RTTIWriter : TRTTIWriter; + + +implementation + + uses + cutils, + globals,globtype,verbose,systems, + fmodule, + symsym, + aasmtai,aasmdata, + defutil, + wpobase + ; + + + const + rttidefstate : array[trttitype] of tdefstate = + (ds_rtti_table_written,ds_init_table_written, + { Objective-C related, does not pass here } + symconst.ds_none,symconst.ds_none, + symconst.ds_none,symconst.ds_none); + + type + TPropNameListItem = class(TFPHashObject) + propindex : longint; + propowner : TSymtable; + end; + + +{*************************************************************************** + TRTTIWriter +***************************************************************************} + + procedure TRTTIWriter.maybe_write_align; + begin + if (tf_requires_proper_alignment in target_info.flags) then + current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt))); + end; + + procedure TRTTIWriter.write_string(const s: string); + begin + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(s))); + current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(s)); + end; + + procedure TRTTIWriter.write_header(def: tdef; typekind: byte); + begin + if def.typ=arraydef then + InternalError(201012211); + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(typekind)); + if assigned(def.typesym) then + write_string(ttypesym(def.typesym).realname) + else + current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(#0)); + end; + + procedure TRTTIWriter.write_rtti_name(def:tdef); + var + hs : string; + begin + if is_open_array(def) then + { open arrays never have a typesym with a name, since you cannot + define an "open array type". Kylix prints the type of the + elements in the array in this case (so together with the pfArray + flag, you can reconstruct the full typename, I assume (JM)) + } + def:=tarraydef(def).elementdef; + { name } + if assigned(def.typesym) then + begin + hs:=ttypesym(def.typesym).realname; + current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(chr(length(hs))+hs)); + end + else + current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(#0)); + end; + + { writes a 32-bit count followed by array of field infos for given symtable } + procedure TRTTIWriter.fields_write_rtti_data(def:tabstractrecorddef;rt:trttitype); + var + i : longint; + sym : tsym; + fieldcnt: longint; + lastai: TLinkedListItem; + st: tsymtable; + begin + fieldcnt:=0; + { Count will be inserted at this location. It cannot be nil as we've just + written header for this symtable owner. But stay safe. } + lastai:=current_asmdata.asmlists[al_rtti].last; + if lastai=nil then + InternalError(201012212); + + { For objects, treat parent (if any) as a field with offset 0. This + provides correct handling of entire instance with RTL rtti routines. } + if (def.typ=objectdef) and (tobjectdef(def).objecttype=odt_object) and + Assigned(tobjectdef(def).childof) and + ((rt=fullrtti) or (tobjectdef(def).childof.needs_inittable)) then + begin + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(tobjectdef(def).childof,rt))); + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(0)); + inc(fieldcnt); + end; + st:=def.symtable; + for i:=0 to st.SymList.Count-1 do + begin + sym:=tsym(st.SymList[i]); + if (tsym(sym).typ=fieldvarsym) and + not(sp_static in tsym(sym).symoptions) and + ( + (rt=fullrtti) or + tfieldvarsym(sym).vardef.needs_inittable + ) and + not is_objc_class_or_protocol(tfieldvarsym(sym).vardef) then + begin + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(tfieldvarsym(sym).vardef,rt))); + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tfieldvarsym(sym).fieldoffset)); + inc(fieldcnt); + end; + end; + { insert field count before data } + current_asmdata.asmlists[al_rtti].InsertAfter(Tai_const.Create_32bit(fieldcnt),lastai) + end; + + + procedure TRTTIWriter.fields_write_rtti(st:tsymtable;rt:trttitype); + var + i : longint; + sym : tsym; + begin + for i:=0 to st.SymList.Count-1 do + begin + sym:=tsym(st.SymList[i]); + if (tsym(sym).typ=fieldvarsym) and + not(sp_static in tsym(sym).symoptions) and + ( + (rt=fullrtti) or + tfieldvarsym(sym).vardef.needs_inittable + ) then + write_rtti(tfieldvarsym(sym).vardef,rt); + end; + end; + + + procedure TRTTIWriter.published_write_rtti(st:tsymtable;rt:trttitype); + var + i : longint; + sym : tsym; + begin + for i:=0 to st.SymList.Count-1 do + begin + sym:=tsym(st.SymList[i]); + if (sym.visibility=vis_published) then + begin + case tsym(sym).typ of + propertysym: + write_rtti(tpropertysym(sym).propdef,rt); + fieldvarsym: + write_rtti(tfieldvarsym(sym).vardef,rt); + end; + end; + end; + end; + + + function TRTTIWriter.published_properties_count(st:tsymtable):longint; + var + i : longint; + sym : tsym; + begin + result:=0; + for i:=0 to st.SymList.Count-1 do + begin + sym:=tsym(st.SymList[i]); + if (tsym(sym).typ=propertysym) and + (sym.visibility=vis_published) then + inc(result); + end; + end; + + + procedure TRTTIWriter.collect_propnamelist(propnamelist:TFPHashObjectList;objdef:tobjectdef); + var + i : longint; + sym : tsym; + pn : tpropnamelistitem; + begin + if assigned(objdef.childof) then + collect_propnamelist(propnamelist,objdef.childof); + for i:=0 to objdef.symtable.SymList.Count-1 do + begin + sym:=tsym(objdef.symtable.SymList[i]); + if (tsym(sym).typ=propertysym) and + (sym.visibility=vis_published) then + begin + pn:=TPropNameListItem(propnamelist.Find(tsym(sym).name)); + if not assigned(pn) then + begin + pn:=tpropnamelistitem.create(propnamelist,tsym(sym).name); + pn.propindex:=propnamelist.count-1; + pn.propowner:=tsym(sym).owner; + end; + end; + end; + end; + + + procedure TRTTIWriter.published_properties_write_rtti_data(propnamelist:TFPHashObjectList;st:tsymtable); + var + i : longint; + sym : tsym; + proctypesinfo : byte; + propnameitem : tpropnamelistitem; + + procedure writeaccessproc(pap:tpropaccesslisttypes; shiftvalue : byte; unsetvalue: byte); + var + typvalue : byte; + hp : ppropaccesslistitem; + address,space : longint; + def : tdef; + hpropsym : tpropertysym; + propaccesslist : tpropaccesslist; + begin + hpropsym:=tpropertysym(sym); + repeat + propaccesslist:=hpropsym.propaccesslist[pap]; + if not propaccesslist.empty then + break; + hpropsym:=hpropsym.overriddenpropsym; + until not assigned(hpropsym); + if not(assigned(propaccesslist) and assigned(propaccesslist.firstsym)) then + begin + current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,unsetvalue)); + typvalue:=3; + end + else if propaccesslist.firstsym^.sym.typ=fieldvarsym then + begin + address:=0; + hp:=propaccesslist.firstsym; + def:=nil; + while assigned(hp) do + begin + case hp^.sltype of + sl_load : + begin + def:=tfieldvarsym(hp^.sym).vardef; + inc(address,tfieldvarsym(hp^.sym).fieldoffset); + end; + sl_subscript : + begin + if not(assigned(def) and + ((def.typ=recorddef) or + is_object(def))) then + internalerror(200402171); + inc(address,tfieldvarsym(hp^.sym).fieldoffset); + def:=tfieldvarsym(hp^.sym).vardef; + end; + sl_vec : + begin + if not(assigned(def) and (def.typ=arraydef)) then + internalerror(200402172); + def:=tarraydef(def).elementdef; + {Hp.value is a Tconstexprint, which can be rather large, + sanity check for longint overflow.} + space:=(high(address)-address) div def.size; + if int64(space)<hp^.value then + internalerror(200706101); + inc(address,int64(def.size*hp^.value)); + end; + end; + hp:=hp^.next; + end; + current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,address)); + typvalue:=0; + end + else + begin + { When there was an error then procdef is not assigned } + if not assigned(propaccesslist.procdef) then + exit; + if not(po_virtualmethod in tprocdef(propaccesslist.procdef).procoptions) or + is_objectpascal_helper(tprocdef(propaccesslist.procdef).struct) then + begin + current_asmdata.asmlists[al_rtti].concat(Tai_const.createname(tprocdef(propaccesslist.procdef).mangledname,0)); + typvalue:=1; + end + else + begin + { virtual method, write vmt offset } + current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr, + tobjectdef(tprocdef(propaccesslist.procdef).struct).vmtmethodoffset(tprocdef(propaccesslist.procdef).extnumber))); + { register for wpo } + tobjectdef(tprocdef(propaccesslist.procdef).struct).register_vmt_call(tprocdef(propaccesslist.procdef).extnumber); + {$ifdef vtentry} + { not sure if we can insert those vtentry symbols safely here } + {$error register methods used for published properties} + {$endif vtentry} + typvalue:=2; + end; + end; + proctypesinfo:=proctypesinfo or (typvalue shl shiftvalue); + end; + + begin + for i:=0 to st.SymList.Count-1 do + begin + sym:=tsym(st.SymList[i]); + if (sym.typ=propertysym) and + (sym.visibility=vis_published) then + begin + if ppo_indexed in tpropertysym(sym).propoptions then + proctypesinfo:=$40 + else + proctypesinfo:=0; + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(tpropertysym(sym).propdef,fullrtti))); + writeaccessproc(palt_read,0,0); + writeaccessproc(palt_write,2,0); + { is it stored ? } + if not(ppo_stored in tpropertysym(sym).propoptions) then + begin + { no, so put a constant zero } + current_asmdata.asmlists[al_rtti].concat(Tai_const.create(aitconst_ptr,0)); + proctypesinfo:=proctypesinfo or (3 shl 4); + end + else + writeaccessproc(palt_stored,4,1); { maybe; if no procedure put a constant 1 (=true) } + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tpropertysym(sym).index)); + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tpropertysym(sym).default)); + propnameitem:=TPropNameListItem(propnamelist.Find(tpropertysym(sym).name)); + if not assigned(propnameitem) then + internalerror(200512201); + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(propnameitem.propindex)); + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(proctypesinfo)); + write_string(tpropertysym(sym).realname); + maybe_write_align; + end; + end; + end; + + + procedure TRTTIWriter.write_rtti_data(def:tdef;rt:trttitype); + + procedure unknown_rtti(def:tstoreddef); + begin + current_asmdata.asmlists[al_rtti].concat(tai_const.create_8bit(tkUnknown)); + write_rtti_name(def); + end; + + procedure variantdef_rtti(def:tvariantdef); + begin + write_header(def,tkVariant); + end; + + procedure stringdef_rtti(def:tstringdef); + begin + case def.stringtype of + st_ansistring: + write_header(def,tkAString); + + st_widestring: + write_header(def,tkWString); + + st_unicodestring: + write_header(def,tkUString); + + st_longstring: + write_header(def,tkLString); + + st_shortstring: + begin + write_header(def,tkSString); + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(def.len)); + maybe_write_align; // is align necessary here? + end; + end; + end; + + procedure enumdef_rtti(def:tenumdef); + var + i : integer; + hp : tenumsym; + begin + write_header(def,tkEnumeration); + maybe_write_align; + case longint(def.size) of + 1 : + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUByte)); + 2 : + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUWord)); + 4 : + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otULong)); + end; + { we need to align by Tconstptruint here to satisfy the alignment rules set by + records: in the typinfo unit we overlay a TTypeData record on this data, which at + the innermost variant record needs an alignment of TConstPtrUint due to e.g. + the "CompType" member for tkSet (also the "BaseType" member for tkEnumeration). + We need to adhere to this, otherwise things will break. + Note that other code (e.g. enumdef_rtti_calcstringtablestart()) relies on the + exact sequence too. } + maybe_write_align; + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.min)); + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.max)); + maybe_write_align; // is align necessary here? + { write base type } + if assigned(def.basedef) then + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.basedef,rt))) + else + current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil)); + for i := 0 to def.symtable.SymList.Count - 1 do + begin + hp:=tenumsym(def.symtable.SymList[i]); + if hp.value<def.minval then + continue + else + if hp.value>def.maxval then + break; + write_string(hp.realname); + end; + { write unit name } + write_string(current_module.realmodulename^); + { write zero which is required by RTL } + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(0)); + end; + + procedure orddef_rtti(def:torddef); + + procedure dointeger(typekind: byte); + const + trans : array[tordtype] of byte = + (otUByte{otNone}, + otUByte,otUWord,otULong,otUByte{otNone}, + otSByte,otSWord,otSLong,otUByte{otNone}, + otUByte,otUWord,otULong,otUByte, + otSByte,otSWord,otSLong,otSByte, + otUByte,otUWord,otUByte); + begin + write_header(def,typekind); + maybe_write_align; + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(byte(trans[def.ordtype]))); + maybe_write_align; + {Convert to longint to smuggle values in high(longint)+1..high(cardinal) into asmlist.} + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.low.svalue))); + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.high.svalue))); + end; + + begin + case def.ordtype of + s64bit : + begin + write_header(def,tkInt64); + maybe_write_align; + { low } + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.low.svalue)); + { high } + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.high.svalue)); + end; + u64bit : + begin + write_header(def,tkQWord); + maybe_write_align; + {use svalue because Create_64bit accepts int64, prevents range checks} + { low } + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.low.svalue)); + { high } + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_64bit(def.high.svalue)); + end; + pasbool8: + dointeger(tkBool); + uchar: + dointeger(tkChar); + uwidechar: + dointeger(tkWChar); + scurrency: + begin + write_header(def,tkFloat); + maybe_write_align; + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(ftCurr)); + end; + else + dointeger(tkInteger); + end; + end; + + + procedure floatdef_rtti(def:tfloatdef); + const + {tfloattype = (s32real,s64real,s80real,sc80real,s64bit,s128bit);} + translate : array[tfloattype] of byte = + (ftSingle,ftDouble,ftExtended,ftExtended,ftComp,ftCurr,ftFloat128); + begin + write_header(def,tkFloat); + maybe_write_align; + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(translate[def.floattype])); + end; + + + procedure setdef_rtti(def:tsetdef); + begin + write_header(def,tkSet); + maybe_write_align; + case def.size of + 1: + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUByte)); + 2: + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUWord)); + 4: + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otULong)); + else + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(otUByte)); + end; + maybe_write_align; + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.elementdef,rt))); + end; + + + procedure arraydef_rtti(def:tarraydef); + begin + if ado_IsDynamicArray in def.arrayoptions then + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkdynarray)) + else + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkarray)); + write_rtti_name(def); + maybe_write_align; + { size of elements } + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_pint(def.elesize)); + + if not(ado_IsDynamicArray in def.arrayoptions) then + begin + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_pint(pint(def.elecount))); + { element type } + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.elementdef,rt))); + end + else + { write a delphi almost compatible dyn. array entry: + there are two types, eltype and eltype2, the latter is nil if the element type needs + no finalization, the former is always valid, delphi has this swapped, but for + compatibility with older fpc versions we do it different, to be delphi compatible, + the names are swapped in typinfo.pp + } + begin + { element type } + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.elementdef,rt))); + end; + { variant type } + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(tstoreddef(def.elementdef).getvardef)); + if ado_IsDynamicArray in def.arrayoptions then + begin + { element type } + if def.elementdef.needs_inittable then + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.elementdef,rt))) + else + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_pint(0)); + { write unit name } + write_string(current_module.realmodulename^); + end; + end; + + procedure recorddef_rtti(def:trecorddef); + begin + write_header(def,tkRecord); + maybe_write_align; + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size)); + fields_write_rtti_data(def,rt); + end; + + + procedure procvardef_rtti(def:tprocvardef); + + const + ProcCallOptionToCallConv: array[tproccalloption] of byte = ( + { pocall_none } 0, + { pocall_cdecl } 1, + { pocall_cppdecl } 5, + { pocall_far16 } 6, + { pocall_oldfpccall } 7, + { pocall_internproc } 8, + { pocall_syscall } 9, + { pocall_pascal } 2, + { pocall_register } 0, + { pocall_safecall } 4, + { pocall_stdcall } 3, + { pocall_softfloat } 10, + { pocall_mwpascal } 11, + { pocall_interrupt } 12 + ); + + procedure write_para(parasym:tparavarsym); + var + paraspec : byte; + begin + { only store user visible parameters } + if not(vo_is_hidden_para in parasym.varoptions) then + begin + case parasym.varspez of + vs_value : paraspec := 0; + vs_const : paraspec := pfConst; + vs_var : paraspec := pfVar; + vs_out : paraspec := pfOut; + vs_constref: paraspec := pfConstRef; + end; + { Kylix also seems to always add both pfArray and pfReference + in this case + } + if is_open_array(parasym.vardef) then + paraspec:=paraspec or pfArray or pfReference; + { and these for classes and interfaces (maybe because they + are themselves addresses?) + } + if is_class_or_interface(parasym.vardef) then + paraspec:=paraspec or pfAddress; + { set bits run from the highest to the lowest bit on + big endian systems + } + if (target_info.endian = endian_big) then + paraspec:=reverse_byte(paraspec); + { write flags for current parameter } + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(paraspec)); + { write name of current parameter } + write_string(parasym.realname); + { write name of type of current parameter } + write_rtti_name(parasym.vardef); + end; + end; + + var + methodkind : byte; + i : integer; + begin + if po_methodpointer in def.procoptions then + begin + { write method id and name } + write_header(def,tkMethod); + maybe_write_align; + + { write kind of method } + case def.proctypeoption of + potype_constructor: methodkind:=mkConstructor; + potype_destructor: methodkind:=mkDestructor; + potype_class_constructor: methodkind:=mkClassConstructor; + potype_class_destructor: methodkind:=mkClassDestructor; + potype_operator: methodkind:=mkOperatorOverload; + potype_procedure: + if po_classmethod in def.procoptions then + methodkind:=mkClassProcedure + else + methodkind:=mkProcedure; + potype_function: + if po_classmethod in def.procoptions then + methodkind:=mkClassFunction + else + methodkind:=mkFunction; + else + begin + if def.returndef = voidtype then + methodkind:=mkProcedure + else + methodkind:=mkFunction; + end; + end; + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(methodkind)); + + { write parameter info. The parameters must be written in reverse order + if this method uses right to left parameter pushing! } + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(def.maxparacount)); + + for i:=0 to def.paras.count-1 do + write_para(tparavarsym(def.paras[i])); + + if (methodkind=mkFunction) or (methodkind=mkClassFunction) then + begin + { write name of result type } + write_rtti_name(def.returndef); + maybe_write_align; + + { write result typeinfo } + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.returndef,fullrtti))) + end; + + { write calling convention } + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(ProcCallOptionToCallConv[def.proccalloption])); + maybe_write_align; + + { write params typeinfo } + for i:=0 to def.paras.count-1 do + if not(vo_is_hidden_para in tparavarsym(def.paras[i]).varoptions) then + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(tparavarsym(def.paras[i]).vardef,fullrtti))); + end + else + write_header(def,tkProcvar); + end; + + + procedure objectdef_rtti(def:tobjectdef); + + procedure objectdef_rtti_fields(def:tobjectdef); + begin + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size)); + fields_write_rtti_data(def,rt); + end; + + procedure objectdef_rtti_interface_init(def:tobjectdef); + begin + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(def.size)); + end; + + procedure objectdef_rtti_class_full(def:tobjectdef); + var + propnamelist : TFPHashObjectList; + begin + { Collect unique property names with nameindex } + propnamelist:=TFPHashObjectList.Create; + collect_propnamelist(propnamelist,def); + + if not is_objectpascal_helper(def) then + if (oo_has_vmt in def.objectoptions) then + current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(def.vmt_mangledname,0)) + else + current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil)); + + { write parent typeinfo } + if assigned(def.childof) then + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.childof,fullrtti))) + else + current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil)); + + { write typeinfo of extended type } + if is_objectpascal_helper(def) then + if assigned(def.extendeddef) then + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.extendeddef,fullrtti))) + else + InternalError(2011033001); + + { total number of unique properties } + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(propnamelist.count)); + + { write unit name } + write_string(current_module.realmodulename^); + maybe_write_align; + + { write published properties for this object } + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(published_properties_count(def.symtable))); + maybe_write_align; + published_properties_write_rtti_data(propnamelist,def.symtable); + + propnamelist.free; + end; + + procedure objectdef_rtti_interface_full(def:tobjectdef); + var + i : longint; + propnamelist : TFPHashObjectList; + { if changed to a set, make sure it's still a byte large, and + swap appropriately when cross-compiling + } + IntfFlags: byte; + begin + { Collect unique property names with nameindex } + propnamelist:=TFPHashObjectList.Create; + collect_propnamelist(propnamelist,def); + + { write parent typeinfo } + if assigned(def.childof) then + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.childof,fullrtti))) + else + current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil)); + + { interface: write flags, iid and iidstr } + IntfFlags:=0; + if assigned(def.iidguid) then + IntfFlags:=IntfFlags or (1 shl ord(ifHasGuid)); + if assigned(def.iidstr) then + IntfFlags:=IntfFlags or (1 shl ord(ifHasStrGUID)); + if (def.objecttype=odt_dispinterface) then + IntfFlags:=IntfFlags or (1 shl ord(ifDispInterface)); + if (target_info.endian=endian_big) then + IntfFlags:=reverse_byte(IntfFlags); + { + ifDispatch, } + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(IntfFlags)); + maybe_write_align; + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_32bit(longint(def.iidguid^.D1))); + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(def.iidguid^.D2)); + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(def.iidguid^.D3)); + for i:=Low(def.iidguid^.D4) to High(def.iidguid^.D4) do + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(def.iidguid^.D4[i])); + + { write unit name } + write_string(current_module.realmodulename^); + maybe_write_align; + + { write iidstr } + if assigned(def.iidstr) then + write_string(def.iidstr^) + else + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(0)); + maybe_write_align; + + { write published properties for this object } + published_properties_write_rtti_data(propnamelist,def.symtable); + + propnamelist.free; + end; + + begin + case def.objecttype of + odt_class: + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkclass)); + odt_object: + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkobject)); + odt_dispinterface, + odt_interfacecom: + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterface)); + odt_interfacecorba: + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterfaceCorba)); + odt_helper: + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkhelper)); + else + internalerror(200611034); + end; + + { generate the name } + write_string(def.objrealname^); + maybe_write_align; + + case rt of + initrtti : + begin + if def.objecttype in [odt_class,odt_object,odt_helper] then + objectdef_rtti_fields(def) + else + objectdef_rtti_interface_init(def); + end; + fullrtti : + begin + case def.objecttype of + odt_helper, + odt_class: + objectdef_rtti_class_full(def); + odt_object: + objectdef_rtti_fields(def); + else + objectdef_rtti_interface_full(def); + end; + end; + end; + end; + + begin + case def.typ of + variantdef : + variantdef_rtti(tvariantdef(def)); + stringdef : + stringdef_rtti(tstringdef(def)); + enumdef : + enumdef_rtti(tenumdef(def)); + orddef : + orddef_rtti(torddef(def)); + floatdef : + floatdef_rtti(tfloatdef(def)); + setdef : + setdef_rtti(tsetdef(def)); + procvardef : + procvardef_rtti(tprocvardef(def)); + arraydef : + begin + if ado_IsBitPacked in tarraydef(def).arrayoptions then + unknown_rtti(tstoreddef(def)) + else + arraydef_rtti(tarraydef(def)); + end; + recorddef : + begin + if trecorddef(def).is_packed then + unknown_rtti(tstoreddef(def)) + else + recorddef_rtti(trecorddef(def)); + end; + objectdef : + objectdef_rtti(tobjectdef(def)); + else + unknown_rtti(tstoreddef(def)); + end; + end; + + procedure TRTTIWriter.write_rtti_extrasyms(def:Tdef;rt:Trttitype;mainrtti:Tasmsymbol); + + type Penumsym = ^Tenumsym; + + function enumdef_rtti_calcstringtablestart(const def : Tenumdef) : integer; + begin + { the alignment calls must correspond to the ones used during generating the + actual data structure created elsewhere in this file } + result:=1; + if assigned(def.typesym) then + inc(result,length(def.typesym.realname)+1) + else + inc(result); + if (tf_requires_proper_alignment in target_info.flags) then + result:=align(result,sizeof(Tconstptruint)); + inc(result); + if (tf_requires_proper_alignment in target_info.flags) then + result:=align(result,sizeof(Tconstptruint)); + inc(result, sizeof(longint) * 2); + if (tf_requires_proper_alignment in target_info.flags) then + result:=align(result,sizeof(Tconstptruint)); + inc(result, sizeof(pint)); + end; + + { Writes a helper table for accelerated conversion of ordinal enum values to strings. + If you change something in this method, make sure to adapt the corresponding code + in sstrings.inc. } + procedure enumdef_rtti_ord2stringindex(const sym_count:longint; const offsets:plongint; const syms:Penumsym; const st:longint); + + var rttilab:Tasmsymbol; + h,i,o:longint; + mode:(lookup,search); {Modify with care, ordinal value of enum is written.} + r:single; {Must be real type because of integer overflow risk.} + + begin + + {Decide wether a lookup array is size efficient.} + mode:=lookup; + if sym_count>0 then + begin + i:=1; + r:=0; + h:=syms[0].value; {Next expected enum value is min.} + while i<sym_count do + begin + {Calculate size of hole between values. Avoid integer overflows.} + r:=r+(single(syms[i].value)-single(h))-1; + h:=syms[i].value; + inc(i); + end; + if r>sym_count then + mode:=search; {Don't waste more than 50% space.} + end; + { write rtti data; make sure that the alignment matches the corresponding data structure + in the code that uses it (if alignment is required). } + with current_asmdata do + begin + rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_o2s',AB_GLOBAL,AT_DATA); + maybe_new_object_file(asmlists[al_rtti]); + new_section(asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint))); + asmlists[al_rtti].concat(Tai_symbol.create_global(rttilab,0)); + asmlists[al_rtti].concat(Tai_const.create_32bit(longint(mode))); + if mode=lookup then + begin + maybe_write_align; + o:=syms[0].value; {Start with min value.} + for i:=0 to sym_count-1 do + begin + while o<syms[i].value do + begin + asmlists[al_rtti].concat(Tai_const.create_pint(0)); + inc(o); + end; + inc(o); + asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i])); + end; + end + else + begin + maybe_write_align; + asmlists[al_rtti].concat(Tai_const.create_32bit(sym_count)); + for i:=0 to sym_count-1 do + begin + maybe_write_align; + asmlists[al_rtti].concat(Tai_const.create_32bit(syms[i].value)); + maybe_write_align; + asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i])); + end; + end; + asmlists[al_rtti].concat(Tai_symbol_end.create(rttilab)); + end; + end; + + { Writes a helper table for accelerated conversion of string to ordinal enum values. + If you change something in this method, make sure to adapt the corresponding code + in sstrings.inc. } + procedure enumdef_rtti_string2ordindex(const sym_count:longint; const offsets:plongint; const syms:Penumsym; const st:longint); + + var rttilab:Tasmsymbol; + i:longint; + + begin + { write rtti data } + with current_asmdata do + begin + rttilab:=defineasmsymbol(Tstoreddef(def).rtti_mangledname(rt)+'_s2o',AB_GLOBAL,AT_DATA); + maybe_new_object_file(asmlists[al_rtti]); + new_section(asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint))); + asmlists[al_rtti].concat(Tai_symbol.create_global(rttilab,0)); + asmlists[al_rtti].concat(Tai_const.create_32bit(sym_count)); + { need to align the entry record according to the largest member } + maybe_write_align; + for i:=0 to sym_count-1 do + begin + if (tf_requires_proper_alignment in target_info.flags) then + current_asmdata.asmlists[al_rtti].concat(cai_align.Create(4)); // necessary? + asmlists[al_rtti].concat(Tai_const.create_32bit(syms[i].value)); + maybe_write_align; + asmlists[al_rtti].concat(Tai_const.create_sym_offset(mainrtti,st+offsets[i])); + end; + asmlists[al_rtti].concat(Tai_symbol_end.create(rttilab)); + end; + end; + + procedure enumdef_rtti_extrasyms(def:Tenumdef); + var + t:Tenumsym; + syms:Penumsym; + sym_count,sym_alloc:sizeuint; + offsets:^longint; + h,i,p,o,st:longint; + begin + {Random access needed, put in array.} + getmem(syms,64*sizeof(Tenumsym)); + getmem(offsets,64*sizeof(longint)); + sym_count:=0; + sym_alloc:=64; + st:=0; + for i := 0 to def.symtable.SymList.Count - 1 do + begin + t:=tenumsym(def.symtable.SymList[i]); + if t.value<def.minval then + continue + else + if t.value>def.maxval then + break; + if sym_count>=sym_alloc then + begin + reallocmem(syms,2*sym_alloc*sizeof(Tenumsym)); + reallocmem(offsets,2*sym_alloc*sizeof(longint)); + sym_alloc:=sym_alloc*2; + end; + syms[sym_count]:=t; + offsets[sym_count]:=st; + inc(sym_count); + st:=st+length(t.realname)+1; + end; + {Sort the syms by enum name} + if sym_count>=2 then + begin + p:=1; + while 2*p<sym_count do + p:=2*p; + while p<>0 do + begin + for h:=p to sym_count-1 do + begin + i:=h; + t:=syms[i]; + o:=offsets[i]; + repeat + if syms[i-p].name<=t.name then + break; + syms[i]:=syms[i-p]; + offsets[i]:=offsets[i-p]; + dec(i,p); + until i<p; + syms[i]:=t; + offsets[i]:=o; + end; + p:=p shr 1; + end; + end; + st:=enumdef_rtti_calcstringtablestart(def); + enumdef_rtti_string2ordindex(sym_count,offsets,syms,st); + { Sort the syms by enum value } + if sym_count>=2 then + begin + p:=1; + while 2*p<sym_count do + p:=2*p; + while p<>0 do + begin + for h:=p to sym_count-1 do + begin + i:=h; + t:=syms[i]; + o:=offsets[i]; + repeat + if syms[i-p].value<=t.value then + break; + syms[i]:=syms[i-p]; + offsets[i]:=offsets[i-p]; + dec(i,p); + until i<p; + syms[i]:=t; + offsets[i]:=o; + end; + p:=p shr 1; + end; + end; + enumdef_rtti_ord2stringindex(sym_count,offsets,syms,st); + freemem(syms); + freemem(offsets); + end; + + + begin + case def.typ of + enumdef: + if rt=fullrtti then + begin + enumdef_rtti_extrasyms(Tenumdef(def)); + end; + end; + end; + + procedure TRTTIWriter.write_child_rtti_data(def:tdef;rt:trttitype); + begin + case def.typ of + enumdef : + if assigned(tenumdef(def).basedef) then + write_rtti(tenumdef(def).basedef,rt); + setdef : + write_rtti(tsetdef(def).elementdef,rt); + arraydef : + write_rtti(tarraydef(def).elementdef,rt); + recorddef : + fields_write_rtti(trecorddef(def).symtable,rt); + objectdef : + begin + if assigned(tobjectdef(def).childof) then + write_rtti(tobjectdef(def).childof,rt); + if (rt=initrtti) or (tobjectdef(def).objecttype=odt_object) then + fields_write_rtti(tobjectdef(def).symtable,rt) + else + published_write_rtti(tobjectdef(def).symtable,rt); + end; + end; + end; + + + function TRTTIWriter.ref_rtti(def:tdef;rt:trttitype):tasmsymbol; + begin + result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt)); + end; + + + procedure TRTTIWriter.write_rtti(def:tdef;rt:trttitype); + var + rttilab : tasmsymbol; + begin + { only write rtti of definitions from the current module } + if not findunitsymtable(def.owner).iscurrentunit then + exit; + { prevent recursion } + if rttidefstate[rt] in def.defstates then + exit; + include(def.defstates,rttidefstate[rt]); + { write first all dependencies } + write_child_rtti_data(def,rt); + { write rtti data } + rttilab:=current_asmdata.DefineAsmSymbol(tstoreddef(def).rtti_mangledname(rt),AB_GLOBAL,AT_DATA); + maybe_new_object_file(current_asmdata.asmlists[al_rtti]); + new_section(current_asmdata.asmlists[al_rtti],sec_rodata,rttilab.name,const_align(sizeof(pint))); + current_asmdata.asmlists[al_rtti].concat(Tai_symbol.Create_global(rttilab,0)); + write_rtti_data(def,rt); + current_asmdata.asmlists[al_rtti].concat(Tai_symbol_end.Create(rttilab)); + write_rtti_extrasyms(def,rt,rttilab); + end; + + + function TRTTIWriter.get_rtti_label(def:tdef;rt:trttitype):tasmsymbol; + begin + result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt)); + end; + + function TRTTIWriter.get_rtti_label_ord2str(def:tdef;rt:trttitype):tasmsymbol; + begin + result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt)+'_o2s'); + end; + + function TRTTIWriter.get_rtti_label_str2ord(def:tdef;rt:trttitype):tasmsymbol; + begin + result:=current_asmdata.RefAsmSymbol(def.rtti_mangledname(rt)+'_s2o'); + end; + +end. + diff --git a/closures/compiler/ncgset.pas b/closures/compiler/ncgset.pas new file mode 100644 index 0000000000..c5491deeb8 --- /dev/null +++ b/closures/compiler/ncgset.pas @@ -0,0 +1,879 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl and Carl Eric Codere + + Generate generic assembler for in set/case labels + + 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 ncgset; + +{$i fpcdefs.inc} + +interface + + uses + globtype,globals,constexp, + node,nset,cpubase,cgbase,cgutils,cgobj,aasmbase,aasmtai,aasmdata; + + type + tcgsetelementnode = class(tsetelementnode) + procedure pass_generate_code;override; + end; + + + Tsetpart=record + range : boolean; {Part is a range.} + start,stop : byte; {Start/stop when range; Stop=element when an element.} + end; + Tsetparts=array[1..8] of Tsetpart; + + tcginnode = class(tinnode) + function pass_1: tnode;override; + procedure pass_generate_code;override; + protected + function checkgenjumps(out setparts: Tsetparts; out numparts: byte; out use_small: boolean): boolean; virtual; + function analizeset(const Aset:Tconstset;out setparts: Tsetparts; out numparts: byte;is_small:boolean):boolean;virtual; + end; + + tcgcasenode = class(tcasenode) + { + Emits the case node statement. Contrary to the intel + 80x86 version, this version does not emit jump tables, + because of portability problems. + } + procedure pass_generate_code;override; + + protected + with_sign : boolean; + opsize : tcgsize; + jmp_gt,jmp_lt,jmp_le : topcmp; + { register with case expression } + hregister,hregister2 : tregister; + endlabel,elselabel : tasmlabel; + + { true, if we can omit the range check of the jump table } + jumptable_no_range : boolean; + { has the implementation jumptable support } + min_label : tconstexprint; + + function blocklabel(id:longint):tasmlabel; + procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);virtual; + function has_jumptable : boolean;virtual; + procedure genjumptable(hp : pcaselabel;min_,max_ : aint); virtual; + procedure genlinearlist(hp : pcaselabel); virtual; + procedure genlinearcmplist(hp : pcaselabel); virtual; + end; + + +implementation + + uses + systems, + verbose, + symconst,symdef,defutil, + paramgr, + procinfo,pass_2,tgobj, + nbas,ncon,nflw, + ncgutil; + + +{***************************************************************************** + TCGSETELEMENTNODE +*****************************************************************************} + + procedure tcgsetelementnode.pass_generate_code; + begin + { load first value in 32bit register } + secondpass(left); + if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then + location_force_reg(current_asmdata.CurrAsmList,left.location,OS_32,false); + + { also a second value ? } + if assigned(right) then + begin + secondpass(right); + if codegenerror then + exit; + if right.location.loc in [LOC_REGISTER,LOC_CREGISTER] then + location_force_reg(current_asmdata.CurrAsmList,right.location,OS_32,false); + end; + + { we doesn't modify the left side, we check only the type } + location_copy(location,left.location); + end; + + +{***************************************************************************** +*****************************************************************************} + + function tcginnode.analizeset(const Aset:Tconstset; out setparts:tsetparts; out numparts: byte; is_small:boolean):boolean; + var + compares,maxcompares:word; + i:byte; + begin + analizeset:=false; + fillchar(setparts,sizeof(setparts),0); + numparts:=0; + compares:=0; + { Lots of comparisions take a lot of time, so do not allow + too much comparisions. 8 comparisions are, however, still + smalller than emitting the set } + if cs_opt_size in current_settings.optimizerswitches then + maxcompares:=8 + else + maxcompares:=5; + { when smallset is possible allow only 3 compares the smallset + code is for littlesize also smaller when more compares are used } + if is_small then + maxcompares:=3; + for i:=0 to 255 do + if i in Aset then + begin + if (numparts=0) or (i<>setparts[numparts].stop+1) then + begin + {Set element is a separate element.} + inc(compares); + if compares>maxcompares then + exit; + inc(numparts); + setparts[numparts].range:=false; + setparts[numparts].stop:=i; + end + else + {Set element is part of a range.} + if not setparts[numparts].range then + begin + {Transform an element into a range.} + setparts[numparts].range:=true; + setparts[numparts].start:=setparts[numparts].stop; + setparts[numparts].stop:=i; + { there's only one compare per range anymore. Only a } + { sub is added, but that's much faster than a } + { cmp/jcc combo so neglect its effect } +{ inc(compares); + if compares>maxcompares then + exit; } + end + else + begin + {Extend a range.} + setparts[numparts].stop:=i; + end; + end; + analizeset:=true; + end; + + + function tcginnode.checkgenjumps(out setparts: Tsetparts; out numparts: byte;out use_small: boolean): boolean; + begin + { check if we can use smallset operation using btl which is limited + to 32 bits, the left side may also not contain higher values !! } + use_small:=is_smallset(right.resultdef) and + not is_signed(left.resultdef) and + ((left.resultdef.typ=orddef) and (torddef(left.resultdef).high<32) or + (left.resultdef.typ=enumdef) and (tenumdef(left.resultdef).max<32)); + + { Can we generate jumps? Possible for all types of sets } + checkgenjumps:=(right.nodetype=setconstn) and + analizeset(Tsetconstnode(right).value_set^,setparts,numparts,use_small); + end; + + + function tcginnode.pass_1: tnode; + var + setparts: Tsetparts; + numparts: byte; + use_small: boolean; + begin + result := inherited pass_1; + if not(assigned(result)) and + checkgenjumps(setparts,numparts,use_small) then + expectloc := LOC_JUMP; + end; + + procedure tcginnode.pass_generate_code; + var + adjustment, + setbase : aint; + l, l2 : tasmlabel; + otl, ofl : tasmlabel; + hr, + pleftreg : tregister; + setparts : Tsetparts; + opsize : tcgsize; + uopsize : tcgsize; + orgopsize : tcgsize; + genjumps, + use_small, + isjump : boolean; + i,numparts : byte; + needslabel : Boolean; + begin + { We check first if we can generate jumps, this can be done + because the resultdef is already set in firstpass } + + genjumps := checkgenjumps(setparts,numparts,use_small); + + orgopsize := def_cgsize(left.resultdef); + uopsize := OS_32; + if is_signed(left.resultdef) then + opsize := tcgsize(ord(uopsize)+(ord(OS_S8)-ord(OS_8))) + else + opsize := uopsize; + needslabel := false; + + isjump:=false; + if (left.expectloc=LOC_JUMP) then + begin + otl:=current_procinfo.CurrTrueLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + ofl:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + isjump:=true; + end + else if not genjumps then + { calculate both operators } + { the complex one first } + { only if left will not be a LOC_JUMP, to keep complexity in the } + { code generator down. This almost never happens anyway, only in } + { case like "if ((a in someset) in someboolset) then" etc } + { also not in case of genjumps, because then we don't secondpass } + { right at all (so we have to make sure that "right" really is } + { "right" and not "swapped left" in that case) } + firstcomplex(self); + + secondpass(left); + if isjump then + begin + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,true); + current_procinfo.CurrTrueLabel:=otl; + current_procinfo.CurrFalseLabel:=ofl; + end + else if (left.location.loc=LOC_JUMP) then + internalerror(2007070101); + + { Only process the right if we are not generating jumps } + if not genjumps then + secondpass(right); + if codegenerror then + exit; + + { ofcourse not commutative } + if nf_swapped in flags then + swapleftright; + + setbase:=tsetdef(right.resultdef).setbase; + if genjumps then + begin + { location is always LOC_JUMP } + location_reset(location,LOC_JUMP,OS_NO); + + { If register is used, use only lower 8 bits } + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,false); + pleftreg := left.location.register; + + { how much have we already substracted from the x in the } + { "x in [y..z]" expression } + adjustment := 0; + hr:=NR_NO; + + for i:=1 to numparts do + if setparts[i].range then + { use fact that a <= x <= b <=> aword(x-a) <= aword(b-a) } + begin + { is the range different from all legal values? } + if (setparts[i].stop-setparts[i].start <> 255) or not (orgopsize = OS_8) then + begin + { yes, is the lower bound <> 0? } + if (setparts[i].start <> 0) then + { we're going to substract from the left register, } + { so in case of a LOC_CREGISTER first move the value } + { to edi (not done before because now we can do the } + { move and substract in one instruction with LEA) } + if (left.location.loc = LOC_CREGISTER) and + (hr<>pleftreg) then + begin + { don't change this back to a_op_const_reg/a_load_reg_reg, since pleftreg must not be modified } + hr:=cg.getintregister(current_asmdata.CurrAsmList,opsize); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,opsize,setparts[i].start,pleftreg,hr); + pleftreg:=hr; + end + else + begin + { otherwise, the value is already in a register } + { that can be modified } + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,opsize, + setparts[i].start-adjustment,pleftreg) + end; + { new total value substracted from x: } + { adjustment + (setparts[i].start - adjustment) } + adjustment := setparts[i].start; + + { check if result < b-a+1 (not "result <= b-a", since } + { we need a carry in case the element is in the range } + { (this will never overflow since we check at the } + { beginning whether stop-start <> 255) } + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_B, + setparts[i].stop-setparts[i].start+1,pleftreg,current_procinfo.CurrTrueLabel); + end + else + { if setparts[i].start = 0 and setparts[i].stop = 255, } + { it's always true since "in" is only allowed for bytes } + begin + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel); + end; + end + else + begin + { Emit code to check if left is an element } + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_EQ, + setparts[i].stop-adjustment,pleftreg,current_procinfo.CurrTrueLabel); + end; + { To compensate for not doing a second pass } + right.location.reference.symbol:=nil; + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + end + else + {*****************************************************************} + { NO JUMP TABLE GENERATION } + {*****************************************************************} + begin + { location is always LOC_REGISTER } + location_reset(location, LOC_REGISTER, uopsize{def_cgsize(resultdef)}); + { allocate a register for the result } + location.register := cg.getintregister(current_asmdata.CurrAsmList, uopsize); + + { We will now generated code to check the set itself, no jmps, + handle smallsets separate, because it allows faster checks } + if use_small then + begin + {**************************** SMALL SET **********************} + if left.location.loc=LOC_CONSTANT then + begin + cg.a_bit_test_const_loc_reg(current_asmdata.CurrAsmList,location.size, + left.location.value-setbase,right.location, + location.register); + end + else + begin + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,true); + register_maybe_adjust_setbase(current_asmdata.CurrAsmList,left.location,setbase); + cg.a_bit_test_reg_loc_reg(current_asmdata.CurrAsmList,left.location.size, + location.size,left.location.register,right.location,location.register); + end; + end + else + {************************** NOT SMALL SET ********************} + begin + if right.location.loc=LOC_CONSTANT then + begin + { can it actually occur currently? CEC } + { yes: "if bytevar in [1,3,5,7,9,11,13,15]" (JM) } + + { note: this code assumes that left in [0..255], which is a valid } + { assumption (other cases will be caught by range checking) (JM) } + + { load left in register } + location_force_reg(current_asmdata.CurrAsmList,left.location,location.size,true); + register_maybe_adjust_setbase(current_asmdata.CurrAsmList,left.location,setbase); + { emit bit test operation -- warning: do not use + location_force_reg() to force a set into a register, except + to a register of the same size as the set. The reason is + that on big endian systems, this would require moving the + set to the most significant part of the new register, + and location_force_register can't do that (it does not + know the type). + + a_bit_test_reg_loc_reg() properly takes into account the + size of the set to adjust the register index to test } + cg.a_bit_test_reg_loc_reg(current_asmdata.CurrAsmList, + left.location.size,location.size, + left.location.register,right.location,location.register); + + { now zero the result if left > nr_of_bits_in_right_register } + hr := cg.getintregister(current_asmdata.CurrAsmList,location.size); + { if left > tcgsize2size[opsize]*8 then hr := 0 else hr := $ffffffff } + { (left.location.size = location.size at this point) } + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SUB, location.size, tcgsize2size[opsize]*8, left.location.register, hr); + cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SAR, location.size, (tcgsize2size[opsize]*8)-1, hr); + + { if left > tcgsize2size[opsize]*8-1, then result := 0 else result := result of bit test } + cg.a_op_reg_reg(current_asmdata.CurrAsmList, OP_AND, location.size, hr, location.register); + end { of right.location.loc=LOC_CONSTANT } + { do search in a normal set which could have >32 elements + but also used if the left side contains higher values > 32 } + else if (left.location.loc=LOC_CONSTANT) then + begin + if (left.location.value < setbase) or (((left.location.value-setbase) shr 3) >= right.resultdef.size) then + {should be caught earlier } + internalerror(2007020402); + + cg.a_bit_test_const_loc_reg(current_asmdata.CurrAsmList,location.size,left.location.value-setbase, + right.location,location.register); + end + else + begin + location_force_reg(current_asmdata.CurrAsmList, left.location, opsize, true); + register_maybe_adjust_setbase(current_asmdata.CurrAsmList,left.location,setbase); + pleftreg := left.location.register; + + if (opsize >= OS_S8) or { = if signed } + ((left.resultdef.typ=orddef) and + ((torddef(left.resultdef).low < int64(tsetdef(right.resultdef).setbase)) or + (torddef(left.resultdef).high > int64(tsetdef(right.resultdef).setmax)))) or + ((left.resultdef.typ=enumdef) and + ((tenumdef(left.resultdef).min < aint(tsetdef(right.resultdef).setbase)) or + (tenumdef(left.resultdef).max > aint(tsetdef(right.resultdef).setmax)))) then + begin + current_asmdata.getjumplabel(l); + current_asmdata.getjumplabel(l2); + needslabel := True; + + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, left.location.size, OC_BE, tsetdef(right.resultdef).setmax-tsetdef(right.resultdef).setbase, pleftreg, l); + + cg.a_load_const_reg(current_asmdata.CurrAsmList, location.size, 0, location.register); + cg.a_jmp_always(current_asmdata.CurrAsmList, l2); + + cg.a_label(current_asmdata.CurrAsmList, l); + end; + + cg.a_bit_test_reg_loc_reg(current_asmdata.CurrAsmList,left.location.size,location.size, + pleftreg,right.location,location.register); + + if needslabel then + cg.a_label(current_asmdata.CurrAsmList, l2); + end; + end; + end; + location_freetemp(current_asmdata.CurrAsmList, right.location); + + location.size := def_cgsize(resultdef); + location.register := cg.makeregsize(current_asmdata.CurrAsmList, location.register, location.size); + end; + +{***************************************************************************** + TCGCASENODE +*****************************************************************************} + + function tcgcasenode.blocklabel(id:longint):tasmlabel; + begin + if not assigned(blocks[id]) then + internalerror(200411301); + result:=pcaseblock(blocks[id])^.blocklabel; + end; + + + procedure tcgcasenode.optimizevalues(var max_linear_list:aint;var max_dist:aword); + begin + { no changes by default } + end; + + + function tcgcasenode.has_jumptable : boolean; + begin + { No jumptable support in the default implementation } + has_jumptable:=false; + end; + + + procedure tcgcasenode.genjumptable(hp : pcaselabel;min_,max_ : aint); + begin + internalerror(200209161); + end; + + + procedure tcgcasenode.genlinearlist(hp : pcaselabel); + + var + first : boolean; + last : TConstExprInt; + scratch_reg: tregister; + + procedure genitem(t : pcaselabel); + + procedure gensub(value:aint); + begin + { here, since the sub and cmp are separate we need + to move the result before subtract to help + the register allocator + } + cg.a_load_reg_reg(current_asmdata.CurrAsmList, opsize, opsize, hregister, scratch_reg); + cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, value, hregister); + end; + + begin + if assigned(t^.less) then + genitem(t^.less); + { do we need to test the first value? } + if first and (t^._low>get_min_value(left.resultdef)) then + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,jmp_lt,aint(t^._low.svalue),hregister,elselabel); + if t^._low=t^._high then + begin + if t^._low-last=0 then + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,OC_EQ,0,hregister,blocklabel(t^.blockid)) + else + begin + gensub(aint(t^._low.svalue-last.svalue)); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize, + OC_EQ,aint(t^._low.svalue-last.svalue),scratch_reg,blocklabel(t^.blockid)); + end; + last:=t^._low; + end + else + begin + { it begins with the smallest label, if the value } + { is even smaller then jump immediately to the } + { ELSE-label } + if first then + begin + { have we to ajust the first value ? } + if (t^._low>get_min_value(left.resultdef)) or (get_min_value(left.resultdef)<>0) then + gensub(aint(t^._low.svalue)); + end + else + begin + { if there is no unused label between the last and the } + { present label then the lower limit can be checked } + { immediately. else check the range in between: } + gensub(aint(t^._low.svalue-last.svalue)); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize,jmp_lt,aint(t^._low.svalue-last.svalue),scratch_reg,elselabel); + end; + gensub(aint(t^._high.svalue-t^._low.svalue)); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,jmp_le,aint(t^._high.svalue-t^._low.svalue),scratch_reg,blocklabel(t^.blockid)); + last:=t^._high; + end; + first:=false; + if assigned(t^.greater) then + genitem(t^.greater); + end; + + begin + { do we need to generate cmps? } + if (with_sign and (min_label<0)) then + genlinearcmplist(hp) + else + begin + last:=0; + first:=true; + scratch_reg:=cg.getintregister(current_asmdata.CurrAsmList,opsize); + genitem(hp); + cg.a_jmp_always(current_asmdata.CurrAsmList,elselabel); + end; + end; + + + procedure tcgcasenode.genlinearcmplist(hp : pcaselabel); + + var + last : TConstExprInt; + lastwasrange: boolean; + + procedure genitem(t : pcaselabel); + +{$ifndef cpu64bitalu} + var + l1 : tasmlabel; +{$endif not cpu64bitalu} + + begin + if assigned(t^.less) then + genitem(t^.less); + if t^._low=t^._high then + begin +{$ifndef cpu64bitalu} + if opsize in [OS_S64,OS_64] then + begin + current_asmdata.getjumplabel(l1); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, OS_32, OC_NE, aint(hi(int64(t^._low.svalue))),hregister2,l1); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, OS_32, OC_EQ, aint(lo(int64(t^._low.svalue))),hregister, blocklabel(t^.blockid)); + cg.a_label(current_asmdata.CurrAsmList,l1); + end + else +{$endif not cpu64bitalu} + begin + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_EQ, aint(t^._low.svalue),hregister, blocklabel(t^.blockid)); + end; + { Reset last here, because we've only checked for one value and need to compare + for the next range both the lower and upper bound } + lastwasrange := false; + end + else + begin + { it begins with the smallest label, if the value } + { is even smaller then jump immediately to the } + { ELSE-label } + if not lastwasrange or (t^._low-last>1) then + begin +{$ifndef cpu64bitalu} + if opsize in [OS_64,OS_S64] then + begin + current_asmdata.getjumplabel(l1); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, OS_32, jmp_lt, aint(hi(int64(t^._low.svalue))), + hregister2, elselabel); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, OS_32, jmp_gt, aint(hi(int64(t^._low.svalue))), + hregister2, l1); + { the comparisation of the low dword must be always unsigned! } + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, OS_32, OC_B, aint(lo(int64(t^._low.svalue))), hregister, elselabel); + cg.a_label(current_asmdata.CurrAsmList,l1); + end + else +{$endif not cpu64bitalu} + begin + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_lt, aint(t^._low.svalue), hregister, + elselabel); + end; + end; +{$ifndef cpu64bitalu} + if opsize in [OS_S64,OS_64] then + begin + current_asmdata.getjumplabel(l1); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, OS_32, jmp_lt, aint(hi(int64(t^._high.svalue))), hregister2, + blocklabel(t^.blockid)); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, OS_32, jmp_gt, aint(hi(int64(t^._high.svalue))), hregister2, + l1); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, OS_32, OC_BE, aint(lo(int64(t^._high.svalue))), hregister, blocklabel(t^.blockid)); + cg.a_label(current_asmdata.CurrAsmList,l1); + end + else +{$endif not cpu64bitalu} + begin + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, jmp_le, aint(t^._high.svalue), hregister, blocklabel(t^.blockid)); + end; + + last:=t^._high; + lastwasrange := true; + end; + if assigned(t^.greater) then + genitem(t^.greater); + end; + + begin + last:=0; + lastwasrange:=false; + genitem(hp); + cg.a_jmp_always(current_asmdata.CurrAsmList,elselabel); + end; + + + procedure tcgcasenode.pass_generate_code; + var + oldflowcontrol: tflowcontrol; + i : longint; + distv, + lv,hv, + max_label: tconstexprint; + labelcnt : aint; + max_linear_list : aint; + otl, ofl: tasmlabel; + isjump : boolean; + max_dist, + dist : aword; + oldexecutionweight : longint; + begin + location_reset(location,LOC_VOID,OS_NO); + + oldflowcontrol := flowcontrol; + include(flowcontrol,fc_inflowcontrol); + { Allocate labels } + current_asmdata.getjumplabel(endlabel); + current_asmdata.getjumplabel(elselabel); + for i:=0 to blocks.count-1 do + current_asmdata.getjumplabel(pcaseblock(blocks[i])^.blocklabel); + + with_sign:=is_signed(left.resultdef); + if with_sign then + begin + jmp_gt:=OC_GT; + jmp_lt:=OC_LT; + jmp_le:=OC_LTE; + end + else + begin + jmp_gt:=OC_A; + jmp_lt:=OC_B; + jmp_le:=OC_BE; + end; + + { save current current_procinfo.CurrTrueLabel and current_procinfo.CurrFalseLabel } + isjump:=false; + if left.expectloc=LOC_JUMP then + begin + otl:=current_procinfo.CurrTrueLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + ofl:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + isjump:=true; + end; + secondpass(left); + { determines the size of the operand } + opsize:=def_cgsize(left.resultdef); + { copy the case expression to a register } + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,false); +{$ifndef cpu64bitalu} + if opsize in [OS_S64,OS_64] then + begin + hregister:=left.location.register64.reglo; + hregister2:=left.location.register64.reghi; + end + else +{$endif not cpu64bitalu} + hregister:=left.location.register; + if isjump then + begin + current_procinfo.CurrTrueLabel:=otl; + current_procinfo.CurrFalseLabel:=ofl; + end + else + if (left.location.loc=LOC_JUMP) then + internalerror(2006050501); + + { we need the min_label always to choose between } + { cmps and subs/decs } + min_label:=case_get_min(labels); + + { Generate the jumps } +{$ifdef OLDREGVARS} + load_all_regvars(current_asmdata.CurrAsmList); +{$endif OLDREGVARS} +{$ifndef cpu64bitalu} + if opsize in [OS_64,OS_S64] then + genlinearcmplist(labels) + else +{$endif not cpu64bitalu} + begin + if cs_opt_level1 in current_settings.optimizerswitches then + begin + { procedures are empirically passed on } + { consumption can also be calculated } + { but does it pay on the different } + { processors? } + { moreover can the size only be appro- } + { ximated as it is not known if rel8, } + { rel16 or rel32 jumps are used } + max_label:=case_get_max(labels); + labelcnt:=case_count_labels(labels); + { can we omit the range check of the jump table ? } + getrange(left.resultdef,lv,hv); + jumptable_no_range:=(lv=min_label) and (hv=max_label); + { hack a little bit, because the range can be greater } + { than the positive range of a aint } + + if (min_label<0) and (max_label>0) then + distv:=max_label+min_label + else + distv:=max_label-min_label; + if (distv>=0) then + dist:=distv.uvalue + else + dist:=-distv.svalue; + + { optimize for size ? } + if cs_opt_size in current_settings.optimizerswitches then + begin + if has_jumptable and + (min_label>=int64(low(aint))) and + (max_label<=high(aint)) and + not((labelcnt<=2) or + ((max_label-min_label)<0) or + ((max_label-min_label)>3*labelcnt)) then + begin + { if the labels less or more a continuum then } + genjumptable(labels,min_label.svalue,max_label.svalue); + end + else + begin + { a linear list is always smaller than a jump tree } + genlinearlist(labels); + end; + end + else + begin + max_dist:=4*labelcnt; + if jumptable_no_range then + max_linear_list:=4 + else + max_linear_list:=2; + + { allow processor specific values } + optimizevalues(max_linear_list,max_dist); + + if (labelcnt<=max_linear_list) then + genlinearlist(labels) + else + begin + if (has_jumptable) and + (dist<max_dist) and + (min_label>=int64(low(aint))) and + (max_label<=high(aint)) then + genjumptable(labels,min_label.svalue,max_label.svalue) + else + genlinearlist(labels); + end; + end; + end + else + { it's always not bad } + genlinearlist(labels); + end; + + { estimates the repeat of each instruction } + oldexecutionweight:=cg.executionweight; + cg.executionweight:=cg.executionweight div case_count_labels(labels); + if cg.executionweight<1 then + cg.executionweight:=1; + + { generate the instruction blocks } + for i:=0 to blocks.count-1 do + begin + current_asmdata.CurrAsmList.concat(cai_align.create(current_settings.alignment.jumpalign)); + cg.a_label(current_asmdata.CurrAsmList,pcaseblock(blocks[i])^.blocklabel); + secondpass(pcaseblock(blocks[i])^.statement); + { don't come back to case line } + current_filepos:=current_asmdata.CurrAsmList.getlasttaifilepos^; +{$ifdef OLDREGVARS} + load_all_regvars(current_asmdata.CurrAsmList); +{$endif OLDREGVARS} + cg.a_jmp_always(current_asmdata.CurrAsmList,endlabel); + end; + current_asmdata.CurrAsmList.concat(cai_align.create(current_settings.alignment.jumpalign)); + { ...and the else block } + cg.a_label(current_asmdata.CurrAsmList,elselabel); + if assigned(elseblock) then + begin + secondpass(elseblock); +{$ifdef OLDREGVARS} + load_all_regvars(current_asmdata.CurrAsmList); +{$endif OLDREGVARS} + end; + + cg.executionweight:=oldexecutionweight; + + current_asmdata.CurrAsmList.concat(cai_align.create(current_settings.alignment.jumpalign)); + cg.a_label(current_asmdata.CurrAsmList,endlabel); + + { Reset labels } + for i:=0 to blocks.count-1 do + pcaseblock(blocks[i])^.blocklabel:=nil; + flowcontrol := oldflowcontrol + (flowcontrol - [fc_inflowcontrol]); + end; + + +begin + csetelementnode:=tcgsetelementnode; + cinnode:=tcginnode; + ccasenode:=tcgcasenode; +end. diff --git a/closures/compiler/ncgutil.pas b/closures/compiler/ncgutil.pas new file mode 100644 index 0000000000..093708bf55 --- /dev/null +++ b/closures/compiler/ncgutil.pas @@ -0,0 +1,3252 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Helper routines for all code generators + + 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 ncgutil; + +{$i fpcdefs.inc} + +interface + + uses + node,cpuinfo, + globtype, + cpubase,cgbase,parabase,cgutils, + aasmbase,aasmtai,aasmdata,aasmcpu, + symconst,symbase,symdef,symsym,symtype,symtable +{$ifndef cpu64bitalu} + ,cg64f32 +{$endif not cpu64bitalu} + ; + + type + tloadregvars = (lr_dont_load_regvars, lr_load_regvars); + + pusedregvars = ^tusedregvars; + tusedregvars = record + intregvars, fpuregvars, mmregvars: Tsuperregisterworklist; + end; + +{ + Not used currently, implemented because I thought we had to + synchronise around if/then/else as well, but not needed. May + still be useful for SSA once we get around to implementing + that (JM) + + pusedregvarscommon = ^tusedregvarscommon; + tusedregvarscommon = record + allregvars, commonregvars, myregvars: tusedregvars; + end; +} + + procedure firstcomplex(p : tbinarynode); + procedure maketojumpbool(list:TAsmList; p : tnode; loadregvars: tloadregvars); +// procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset); + + procedure location_force_reg(list:TAsmList;var l:tlocation;dst_size:TCGSize;maybeconst:boolean); + procedure location_force_fpureg(list:TAsmList;var l: tlocation;maybeconst:boolean); + procedure location_force_mem(list:TAsmList;var l:tlocation); + procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;maybeconst:boolean); + procedure location_force_mmreg(list:TAsmList;var l: tlocation;maybeconst:boolean); + procedure location_allocate_register(list:TAsmList;out l: tlocation;def: tdef;constant: boolean); + + { load a tlocation into a cgpara } + procedure gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara); + { loads a cgpara into a tlocation; assumes that loc.loc is already + initialised } + procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean); + + { allocate registers for a tlocation; assumes that loc.loc is already + set to LOC_CREGISTER/LOC_CFPUREGISTER/... } + procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation); + + procedure register_maybe_adjust_setbase(list: TAsmList; var l: tlocation; setbase: aint); + + { Retrieve the location of the data pointed to in location l, when the location is + a register it is expected to contain the address of the data } + procedure location_get_data_ref(list:TAsmList;const l:tlocation;var ref:treference;loadref:boolean; alignment: longint); + + function has_alias_name(pd:tprocdef;const s:string):boolean; + procedure alloc_proc_symbol(pd: tprocdef); + procedure gen_proc_symbol(list:TAsmList); + procedure gen_proc_symbol_end(list:TAsmList); + procedure gen_proc_entry_code(list:TAsmList); + procedure gen_proc_exit_code(list:TAsmList); + procedure gen_stack_check_size_para(list:TAsmList); + procedure gen_stack_check_call(list:TAsmList); + procedure gen_save_used_regs(list:TAsmList); + procedure gen_restore_used_regs(list:TAsmList); + procedure gen_initialize_code(list:TAsmList); + procedure gen_finalize_code(list:TAsmList); + procedure gen_entry_code(list:TAsmList); + procedure gen_exit_code(list:TAsmList); + procedure gen_load_para_value(list:TAsmList); + procedure gen_load_return_value(list:TAsmList); + + procedure gen_external_stub(list:TAsmList;pd:tprocdef;const externalname:string); + procedure gen_intf_wrappers(list:TAsmList;st:TSymtable;nested:boolean); + procedure gen_load_vmt_register(list:TAsmList;objdef:tobjectdef;selfloc:tlocation;var vmtreg:tregister); + + procedure get_used_regvars(n: tnode; var rv: tusedregvars); + { adds the regvars used in n and its children to rv.allregvars, + those which were already in rv.allregvars to rv.commonregvars and + uses rv.myregvars as scratch (so that two uses of the same regvar + in a single tree to make it appear in commonregvars). Useful to + find out which regvars are used in two different node trees + (e.g. in the "else" and "then" path, or in various case blocks } +// procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon); + procedure gen_sync_regvars(list:TAsmList; var rv: tusedregvars); + + { if the result of n is a LOC_C(..)REGISTER, try to find the corresponding } + { loadn and change its location to a new register (= SSA). In case reload } + { is true, transfer the old to the new register } + procedure maybechangeloadnodereg(list: TAsmList; var n: tnode; reload: boolean); + + {# + Allocate the buffers for exception management and setjmp environment. + Return a pointer to these buffers, send them to the utility routine + so they are registered, and then call setjmp. + + Then compare the result of setjmp with 0, and if not equal + to zero, then jump to exceptlabel. + + Also store the result of setjmp to a temporary space by calling g_save_exception_reason + + It is to note that this routine may be called *after* the stackframe of a + routine has been called, therefore on machines where the stack cannot + be modified, all temps should be allocated on the heap instead of the + stack. + } + + const + + EXCEPT_BUF_SIZE = 3*sizeof(pint); + type + texceptiontemps=record + jmpbuf, + envbuf, + reasonbuf : treference; + end; + + procedure get_exception_temps(list:TAsmList;var t:texceptiontemps); + procedure unget_exception_temps(list:TAsmList;const t:texceptiontemps); + procedure new_exception(list:TAsmList;const t:texceptiontemps;exceptlabel:tasmlabel); + procedure free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean); + + procedure insertbssdata(sym : tstaticvarsym); + + procedure gen_alloc_symtable(list:TAsmList;st:TSymtable); + procedure gen_free_symtable(list:TAsmList;st:TSymtable); + + procedure location_free(list: TAsmList; const location : TLocation); + + function getprocalign : shortint; + + procedure gen_fpc_dummy(list : TAsmList); + + procedure InsertInterruptTable; + +implementation + + uses + version, + cutils,cclasses, + globals,systems,verbose,export, + ppu,defutil, + procinfo,paramgr,fmodule, + regvars,dbgbase, + pass_1,pass_2, + nbas,ncon,nld,nmem,nutils, + tgobj,cgobj,cgcpu +{$ifdef powerpc} + , cpupi +{$endif} +{$ifdef powerpc64} + , cpupi +{$endif} +{$ifdef SUPPORT_MMX} + , cgx86 +{$endif SUPPORT_MMX} +; + + +{***************************************************************************** + Misc Helpers +*****************************************************************************} +{$if first_mm_imreg = 0} + {$WARN 4044 OFF} { Comparison might be always false ... } +{$endif} + + procedure location_free(list: TAsmList; const location : TLocation); + begin + case location.loc of + LOC_VOID: + ; + LOC_REGISTER, + LOC_CREGISTER: + begin +{$ifdef cpu64bitaddr} + { x86-64 system v abi: + structs with up to 16 bytes are returned in registers } + if location.size in [OS_128,OS_S128] then + begin + if getsupreg(location.register)<first_int_imreg then + cg.ungetcpuregister(list,location.register); + if getsupreg(location.registerhi)<first_int_imreg then + cg.ungetcpuregister(list,location.registerhi); + end +{$else cpu64bitaddr} + if location.size in [OS_64,OS_S64] then + begin + if getsupreg(location.register64.reglo)<first_int_imreg then + cg.ungetcpuregister(list,location.register64.reglo); + if getsupreg(location.register64.reghi)<first_int_imreg then + cg.ungetcpuregister(list,location.register64.reghi); + end +{$endif} + else + if getsupreg(location.register)<first_int_imreg then + cg.ungetcpuregister(list,location.register); + end; + LOC_FPUREGISTER, + LOC_CFPUREGISTER: + begin + if getsupreg(location.register)<first_fpu_imreg then + cg.ungetcpuregister(list,location.register); + end; + LOC_MMREGISTER, + LOC_CMMREGISTER : + begin + if getsupreg(location.register)<first_mm_imreg then + cg.ungetcpuregister(list,location.register); + end; + LOC_REFERENCE, + LOC_CREFERENCE : + begin + if paramanager.use_fixed_stack then + location_freetemp(list,location); + end; + else + internalerror(2004110211); + end; + end; + + + procedure firstcomplex(p : tbinarynode); + var + fcl, fcr: longint; + ncl, ncr: longint; + begin + { always calculate boolean AND and OR from left to right } + if (p.nodetype in [orn,andn]) and + is_boolean(p.left.resultdef) then + begin + if nf_swapped in p.flags then + internalerror(200709253); + end + else + begin + fcl:=node_resources_fpu(p.left); + fcr:=node_resources_fpu(p.right); + ncl:=node_complexity(p.left); + ncr:=node_complexity(p.right); + { We swap left and right if + a) right needs more floating point registers than left, and + left needs more than 0 floating point registers (if it + doesn't need any, swapping won't change the floating + point register pressure) + b) both left and right need an equal amount of floating + point registers or right needs no floating point registers, + and in addition right has a higher complexity than left + (+- needs more integer registers, but not necessarily) + } + if ((fcr>fcl) and + (fcl>0)) or + (((fcr=fcl) or + (fcr=0)) and + (ncr>ncl)) then + p.swapleftright + end; + end; + + + procedure maketojumpbool(list:TAsmList; p : tnode; loadregvars: tloadregvars); + { + produces jumps to true respectively false labels using boolean expressions + + depending on whether the loading of regvars is currently being + synchronized manually (such as in an if-node) or automatically (most of + the other cases where this procedure is called), loadregvars can be + "lr_load_regvars" or "lr_dont_load_regvars" + } + var + opsize : tcgsize; + storepos : tfileposinfo; + tmpreg : tregister; + begin + if nf_error in p.flags then + exit; + storepos:=current_filepos; + current_filepos:=p.fileinfo; + if is_boolean(p.resultdef) then + begin +{$ifdef OLDREGVARS} + if loadregvars = lr_load_regvars then + load_all_regvars(list); +{$endif OLDREGVARS} + if is_constboolnode(p) then + begin + if Tordconstnode(p).value.uvalue<>0 then + cg.a_jmp_always(list,current_procinfo.CurrTrueLabel) + else + cg.a_jmp_always(list,current_procinfo.CurrFalseLabel) + end + else + begin + opsize:=def_cgsize(p.resultdef); + case p.location.loc of + LOC_SUBSETREG,LOC_CSUBSETREG, + LOC_SUBSETREF,LOC_CSUBSETREF: + begin + tmpreg := cg.getintregister(list,OS_INT); + cg.a_load_loc_reg(list,OS_INT,p.location,tmpreg); + cg.a_cmp_const_reg_label(list,OS_INT,OC_NE,0,tmpreg,current_procinfo.CurrTrueLabel); + cg.a_jmp_always(list,current_procinfo.CurrFalseLabel); + end; + LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE : + begin +{$ifndef cpu64bitalu} + if opsize in [OS_64,OS_S64] then + begin + location_force_reg(list,p.location,opsize,true); + tmpreg:=cg.getintregister(list,OS_32); + cg.a_op_reg_reg_reg(list,OP_OR,OS_32,p.location.register64.reglo,p.location.register64.reghi,tmpreg); + location_reset(p.location,LOC_REGISTER,OS_32); + p.location.register:=tmpreg; + opsize:=OS_32; + end; +{$endif not cpu64bitalu} + cg.a_cmp_const_loc_label(list,opsize,OC_NE,0,p.location,current_procinfo.CurrTrueLabel); + cg.a_jmp_always(list,current_procinfo.CurrFalseLabel); + end; + LOC_JUMP: + ; +{$ifdef cpuflags} + LOC_FLAGS : + begin + cg.a_jmp_flags(list,p.location.resflags,current_procinfo.CurrTrueLabel); + cg.a_jmp_always(list,current_procinfo.CurrFalseLabel); + end; +{$endif cpuflags} + else + begin + printnode(output,p); + internalerror(200308241); + end; + end; + end; + end + else + internalerror(200112305); + current_filepos:=storepos; + end; + + + (* + This code needs fixing. It is not safe to use rgint; on the m68000 it + would be rgaddr. + + procedure remove_non_regvars_from_loc(const t: tlocation; var regs:Tsuperregisterset); + begin + case t.loc of + LOC_REGISTER: + begin + { can't be a regvar, since it would be LOC_CREGISTER then } + exclude(regs,getsupreg(t.register)); + if t.register64.reghi<>NR_NO then + exclude(regs,getsupreg(t.register64.reghi)); + end; + LOC_CREFERENCE,LOC_REFERENCE: + begin + if not(cs_opt_regvar in current_settings.optimizerswitches) or + (getsupreg(t.reference.base) in cg.rgint.usableregs) then + exclude(regs,getsupreg(t.reference.base)); + if not(cs_opt_regvar in current_settings.optimizerswitches) or + (getsupreg(t.reference.index) in cg.rgint.usableregs) then + exclude(regs,getsupreg(t.reference.index)); + end; + end; + end; + *) + + +{***************************************************************************** + EXCEPTION MANAGEMENT +*****************************************************************************} + + procedure get_exception_temps(list:TAsmList;var t:texceptiontemps); + var + srsym : ttypesym; + begin + if jmp_buf_size=-1 then + begin + srsym:=search_system_type('JMP_BUF'); + jmp_buf_size:=srsym.typedef.size; + jmp_buf_align:=srsym.typedef.alignment; + end; + tg.GetTemp(list,EXCEPT_BUF_SIZE,sizeof(pint),tt_persistent,t.envbuf); + tg.GetTemp(list,jmp_buf_size,jmp_buf_align,tt_persistent,t.jmpbuf); + tg.GetTemp(list,sizeof(pint),sizeof(pint),tt_persistent,t.reasonbuf); + end; + + + procedure unget_exception_temps(list:TAsmList;const t:texceptiontemps); + begin + tg.Ungettemp(list,t.jmpbuf); + tg.ungettemp(list,t.envbuf); + tg.ungettemp(list,t.reasonbuf); + end; + + + procedure new_exception(list:TAsmList;const t:texceptiontemps;exceptlabel:tasmlabel); + 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); + cg.a_loadaddr_ref_cgpara(list,t.envbuf,paraloc3); + cg.a_loadaddr_ref_cgpara(list,t.jmpbuf,paraloc2); + { push type of exceptionframe } + cg.a_load_const_cgpara(list,OS_S32,1,paraloc1); + paramanager.freecgpara(list,paraloc3); + paramanager.freecgpara(list,paraloc2); + paramanager.freecgpara(list,paraloc1); + cg.allocallcpuregisters(list); + cg.a_call_name(list,'FPC_PUSHEXCEPTADDR',false); + cg.deallocallcpuregisters(list); + + paramanager.getintparaloc(pocall_default,1,paraloc1); + cg.a_load_reg_cgpara(list,OS_ADDR,NR_FUNCTION_RESULT_REG,paraloc1); + paramanager.freecgpara(list,paraloc1); + cg.allocallcpuregisters(list); + cg.a_call_name(list,'FPC_SETJMP',false); + cg.deallocallcpuregisters(list); + cg.alloccpuregisters(list,R_INTREGISTER,[RS_FUNCTION_RESULT_REG]); + + cg.g_exception_reason_save(list, t.reasonbuf); + cg.a_cmp_const_reg_label(list,OS_S32,OC_NE,0,cg.makeregsize(list,NR_FUNCTION_RESULT_REG,OS_S32),exceptlabel); + cg.dealloccpuregisters(list,R_INTREGISTER,[RS_FUNCTION_RESULT_REG]); + paraloc1.done; + paraloc2.done; + paraloc3.done; + end; + + + procedure free_exception(list:TAsmList;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean); + begin + cg.allocallcpuregisters(list); + cg.a_call_name(list,'FPC_POPADDRSTACK',false); + cg.deallocallcpuregisters(list); + + if not onlyfree then + begin + { g_exception_reason_load already allocates NR_FUNCTION_RESULT_REG } + cg.g_exception_reason_load(list, t.reasonbuf); + cg.a_cmp_const_reg_label(list,OS_INT,OC_EQ,a,NR_FUNCTION_RESULT_REG,endexceptlabel); + cg.a_reg_dealloc(list,NR_FUNCTION_RESULT_REG); + end; + end; + + +{***************************************************************************** + TLocation +*****************************************************************************} + +{$ifndef cpu64bitalu} + { 32-bit version } + procedure location_force_reg(list:TAsmList;var l:tlocation;dst_size:TCGSize;maybeconst:boolean); + var + hregister, + hregisterhi : tregister; + hreg64 : tregister64; + hl : tasmlabel; + oldloc : tlocation; + const_location: boolean; + begin + oldloc:=l; + if dst_size=OS_NO then + internalerror(200309144); + { handle transformations to 64bit separate } + if dst_size in [OS_64,OS_S64] then + begin + if not (l.size in [OS_64,OS_S64]) then + begin + { load a smaller size to OS_64 } + if l.loc=LOC_REGISTER then + begin +{$ifdef AVR} + { on avr, we cannot change the size of a register + due to the nature how register with size > OS8 are handled + } + hregister:=cg.getintregister(list,OS_32); +{$else AVR} + hregister:=cg.makeregsize(list,l.register64.reglo,OS_32); +{$endif AVR} + cg.a_load_reg_reg(list,l.size,OS_32,l.register64.reglo,hregister); + end + else + hregister:=cg.getintregister(list,OS_32); + { load value in low register } + case l.loc of +{$ifdef cpuflags} + LOC_FLAGS : + cg.g_flags2reg(list,OS_INT,l.resflags,hregister); +{$endif cpuflags} + LOC_JUMP : + begin + cg.a_label(list,current_procinfo.CurrTrueLabel); + cg.a_load_const_reg(list,OS_INT,1,hregister); + current_asmdata.getjumplabel(hl); + cg.a_jmp_always(list,hl); + cg.a_label(list,current_procinfo.CurrFalseLabel); + cg.a_load_const_reg(list,OS_INT,0,hregister); + cg.a_label(list,hl); + end; + else + cg.a_load_loc_reg(list,OS_INT,l,hregister); + end; + { reset hi part, take care of the signed bit of the current value } + hregisterhi:=cg.getintregister(list,OS_32); + if (l.size in [OS_S8,OS_S16,OS_S32]) then + begin + if l.loc=LOC_CONSTANT then + begin + if (longint(l.value)<0) then + cg.a_load_const_reg(list,OS_32,aint($ffffffff),hregisterhi) + else + cg.a_load_const_reg(list,OS_32,0,hregisterhi); + end + else + begin + cg.a_op_const_reg_reg(list,OP_SAR,OS_32,31,hregister, + hregisterhi); + end; + end + else + cg.a_load_const_reg(list,OS_32,0,hregisterhi); + location_reset(l,LOC_REGISTER,dst_size); + l.register64.reglo:=hregister; + l.register64.reghi:=hregisterhi; + end + else + begin + { 64bit to 64bit } + if ((l.loc=LOC_CREGISTER) and maybeconst) then + begin + hregister:=l.register64.reglo; + hregisterhi:=l.register64.reghi; + const_location := true; + end + else + begin + hregister:=cg.getintregister(list,OS_32); + hregisterhi:=cg.getintregister(list,OS_32); + const_location := false; + end; + hreg64.reglo:=hregister; + hreg64.reghi:=hregisterhi; + { load value in new register } + cg64.a_load64_loc_reg(list,l,hreg64); + if not const_location then + location_reset(l,LOC_REGISTER,dst_size) + else + location_reset(l,LOC_CREGISTER,dst_size); + l.register64.reglo:=hregister; + l.register64.reghi:=hregisterhi; + end; + end + else + begin + {Do not bother to recycle the existing register. The register + allocator eliminates unnecessary moves, so it's not needed + and trying to recycle registers can cause problems because + the registers changes size and may need aditional constraints. + + Not if it's about LOC_CREGISTER's (JM) + } + const_location := + (maybeconst) and + (l.loc = LOC_CREGISTER) and + (TCGSize2Size[l.size] = TCGSize2Size[dst_size]) and + ((l.size = dst_size) or + (TCGSize2Size[l.size] = sizeof(aint))); + if not const_location then + hregister:=cg.getintregister(list,dst_size) + else + hregister := l.register; + { load value in new register } + case l.loc of +{$ifdef cpuflags} + LOC_FLAGS : + cg.g_flags2reg(list,dst_size,l.resflags,hregister); +{$endif cpuflags} + LOC_JUMP : + begin + cg.a_label(list,current_procinfo.CurrTrueLabel); + cg.a_load_const_reg(list,dst_size,1,hregister); + current_asmdata.getjumplabel(hl); + cg.a_jmp_always(list,hl); + cg.a_label(list,current_procinfo.CurrFalseLabel); + cg.a_load_const_reg(list,dst_size,0,hregister); + cg.a_label(list,hl); + end; + else + begin + { load_loc_reg can only handle size >= l.size, when the + new size is smaller then we need to adjust the size + of the orignal and maybe recalculate l.register for i386 } + if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then + begin + if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then + l.register:=cg.makeregsize(list,l.register,dst_size); + { for big endian systems, the reference's offset must } + { be increased in this case, since they have the } + { MSB first in memory and e.g. byte(word_var) should } + { return the second byte in this case (JM) } + if (target_info.endian = ENDIAN_BIG) and + (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then + begin + inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]); + l.reference.alignment:=newalignment(l.reference.alignment,TCGSize2Size[l.size]-TCGSize2Size[dst_size]); + end; +{$ifdef x86} + if not (l.loc in [LOC_SUBSETREG,LOC_CSUBSETREG]) then + l.size:=dst_size; +{$endif x86} + end; + cg.a_load_loc_reg(list,dst_size,l,hregister); + if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) +{$ifdef x86} + and (l.loc in [LOC_SUBSETREG,LOC_CSUBSETREG]) +{$endif x86} + then + l.size:=dst_size; + end; + end; + if not const_location then + location_reset(l,LOC_REGISTER,dst_size) + else + location_reset(l,LOC_CREGISTER,dst_size); + l.register:=hregister; + end; + { Release temp when it was a reference } + if oldloc.loc=LOC_REFERENCE then + location_freetemp(list,oldloc); + end; + +{$else not cpu64bitalu} + + { 64-bit version } + procedure location_force_reg(list:TAsmList;var l:tlocation;dst_size:TCGSize;maybeconst:boolean); + var + hregister : tregister; + hl : tasmlabel; + oldloc : tlocation; + begin + oldloc:=l; + hregister:=cg.getintregister(list,dst_size); + { load value in new register } + case l.loc of + LOC_FLAGS : + cg.g_flags2reg(list,dst_size,l.resflags,hregister); + LOC_JUMP : + begin + cg.a_label(list,current_procinfo.CurrTrueLabel); + cg.a_load_const_reg(list,dst_size,1,hregister); + current_asmdata.getjumplabel(hl); + cg.a_jmp_always(list,hl); + cg.a_label(list,current_procinfo.CurrFalseLabel); + cg.a_load_const_reg(list,dst_size,0,hregister); + cg.a_label(list,hl); + end; + else + begin + { load_loc_reg can only handle size >= l.size, when the + new size is smaller then we need to adjust the size + of the orignal and maybe recalculate l.register for i386 } + if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then + begin + if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then + l.register:=cg.makeregsize(list,l.register,dst_size); + { for big endian systems, the reference's offset must } + { be increased in this case, since they have the } + { MSB first in memory and e.g. byte(word_var) should } + { return the second byte in this case (JM) } + if (target_info.endian = ENDIAN_BIG) and + (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then + begin + inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]); + l.reference.alignment:=newalignment(l.reference.alignment,TCGSize2Size[l.size]-TCGSize2Size[dst_size]); + end; +{$ifdef x86} + l.size:=dst_size; +{$endif x86} + end; + cg.a_load_loc_reg(list,dst_size,l,hregister); +{$ifndef x86} + if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then + l.size:=dst_size; +{$endif not x86} + end; + end; + if (l.loc <> LOC_CREGISTER) or + not maybeconst then + location_reset(l,LOC_REGISTER,dst_size) + else + location_reset(l,LOC_CREGISTER,dst_size); + l.register:=hregister; + { Release temp when it was a reference } + if oldloc.loc=LOC_REFERENCE then + location_freetemp(list,oldloc); + end; +{$endif not cpu64bitalu} + + + procedure location_force_fpureg(list:TAsmList;var l: tlocation;maybeconst:boolean); + var + reg : tregister; + href : treference; + begin + if (l.loc<>LOC_FPUREGISTER) and + ((l.loc<>LOC_CFPUREGISTER) or (not maybeconst)) then + begin + { if it's in an mm register, store to memory first } + if (l.loc in [LOC_MMREGISTER,LOC_CMMREGISTER]) then + begin + tg.GetTemp(list,tcgsize2size[l.size],tcgsize2size[l.size],tt_normal,href); + cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,href,mms_movescalar); + location_reset_ref(l,LOC_REFERENCE,l.size,0); + l.reference:=href; + end; + reg:=cg.getfpuregister(list,l.size); + cg.a_loadfpu_loc_reg(list,l.size,l,reg); + location_freetemp(list,l); + location_reset(l,LOC_FPUREGISTER,l.size); + l.register:=reg; + end; + end; + + + procedure location_force_mmregscalar(list:TAsmList;var l: tlocation;maybeconst:boolean); + var + reg : tregister; + href : treference; + newsize : tcgsize; + begin + if (l.loc<>LOC_MMREGISTER) and + ((l.loc<>LOC_CMMREGISTER) or (not maybeconst)) then + begin + { if it's in an fpu register, store to memory first } + if (l.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) then + begin + tg.GetTemp(list,tcgsize2size[l.size],tcgsize2size[l.size],tt_normal,href); + cg.a_loadfpu_reg_ref(list,l.size,l.size,l.register,href); + location_reset_ref(l,LOC_REFERENCE,l.size,0); + l.reference:=href; + end; +{$ifndef cpu64bitalu} + if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) and + (l.size in [OS_64,OS_S64]) then + begin + reg:=cg.getmmregister(list,OS_F64); + cg64.a_loadmm_intreg64_reg(list,OS_F64,l.register64,reg); + l.size:=OS_F64 + end + else +{$endif not cpu64bitalu} + begin + { on ARM, CFP values may be located in integer registers, + and its second_int_to_real() also uses this routine to + force integer (memory) values in an mmregister } + if (l.size in [OS_32,OS_S32]) then + newsize:=OS_F32 + else if (l.size in [OS_64,OS_S64]) then + newsize:=OS_F64 + else + newsize:=l.size; + reg:=cg.getmmregister(list,newsize); + cg.a_loadmm_loc_reg(list,newsize,l,reg,mms_movescalar); + l.size:=newsize; + end; + location_freetemp(list,l); + location_reset(l,LOC_MMREGISTER,l.size); + l.register:=reg; + end; + end; + + + procedure gen_loadfpu_loc_cgpara(list: TAsmList; const l: tlocation;const cgpara: tcgpara;locintsize: longint); + var +{$ifdef i386} + href : treference; + size : longint; +{$endif i386} + locsize : tcgsize; + tmploc : tlocation; + begin + if not(l.size in [OS_32,OS_S32,OS_64,OS_S64,OS_128,OS_S128]) then + locsize:=l.size + else + locsize:=int_float_cgsize(tcgsize2size[l.size]); +{$ifdef i386} + case l.loc of + LOC_FPUREGISTER, + LOC_CFPUREGISTER: + begin + case cgpara.location^.loc of + LOC_REFERENCE: + begin + size:=align(locintsize,cgpara.alignment); + if (not paramanager.use_fixed_stack) and + (cgpara.location^.reference.index=NR_STACK_POINTER_REG) then + begin + cg.g_stackpointer_alloc(list,size); + reference_reset_base(href,NR_STACK_POINTER_REG,0,sizeof(pint)); + end + else + reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment); + cg.a_loadfpu_reg_ref(list,locsize,locsize,l.register,href); + end; + LOC_FPUREGISTER: + begin + cg.a_loadfpu_reg_reg(list,locsize,cgpara.location^.size,l.register,cgpara.location^.register); + end; + { can happen if a record with only 1 "single field" is + returned in a floating point register and then is directly + passed to a regcall parameter } + LOC_REGISTER: + begin + tmploc:=l; + location_force_mem(list,tmploc); + case locsize of + OS_F32: + tmploc.size:=OS_32; + OS_F64: + tmploc.size:=OS_64; + else + internalerror(2010053116); + end; + cg.a_load_loc_cgpara(list,tmploc,cgpara); + location_freetemp(list,tmploc); + end + else + internalerror(2010053003); + end; + end; + LOC_MMREGISTER, + LOC_CMMREGISTER: + begin + case cgpara.location^.loc of + LOC_REFERENCE: + begin + { can't use TCGSize2Size[l.size], because the size of an + 80 bit extended parameter can be either 10 or 12 bytes } + size:=align(locintsize,cgpara.alignment); + if (not paramanager.use_fixed_stack) and + (cgpara.location^.reference.index=NR_STACK_POINTER_REG) then + begin + cg.g_stackpointer_alloc(list,size); + reference_reset_base(href,NR_STACK_POINTER_REG,0,sizeof(pint)); + end + else + reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment); + cg.a_loadmm_reg_ref(list,locsize,locsize,l.register,href,mms_movescalar); + end; + LOC_FPUREGISTER: + begin + tmploc:=l; + location_force_mem(list,tmploc); + cg.a_loadfpu_ref_cgpara(list,tmploc.size,tmploc.reference,cgpara); + location_freetemp(list,tmploc); + end; + else + internalerror(2010053004); + end; + end; + LOC_REFERENCE, + LOC_CREFERENCE : + begin + case cgpara.location^.loc of + LOC_REFERENCE: + begin + size:=align(locintsize,cgpara.alignment); + if (not paramanager.use_fixed_stack) and + (cgpara.location^.reference.index=NR_STACK_POINTER_REG) then + cg.a_load_ref_cgpara(list,locsize,l.reference,cgpara) + else + begin + reference_reset_base(href,cgpara.location^.reference.index,cgpara.location^.reference.offset,cgpara.alignment); + cg.g_concatcopy(list,l.reference,href,size); + end; + end; + LOC_FPUREGISTER: + begin + cg.a_loadfpu_ref_cgpara(list,locsize,l.reference,cgpara); + end; + else + internalerror(2010053005); + end; + end; + else + internalerror(2002042430); + end; +{$else i386} + case l.loc of + LOC_MMREGISTER, + LOC_CMMREGISTER: + case cgpara.location^.loc of + LOC_REFERENCE, + LOC_CREFERENCE, + LOC_MMREGISTER, + LOC_CMMREGISTER, + LOC_REGISTER, + LOC_CREGISTER : + cg.a_loadmm_reg_cgpara(list,locsize,l.register,cgpara,mms_movescalar); + LOC_FPUREGISTER, + LOC_CFPUREGISTER: + begin + tmploc:=l; + location_force_fpureg(list,tmploc,false); + cg.a_loadfpu_reg_cgpara(list,tmploc.size,tmploc.register,cgpara); + end; + else + internalerror(200204249); + end; + LOC_FPUREGISTER, + LOC_CFPUREGISTER: + case cgpara.location^.loc of + LOC_MMREGISTER, + LOC_CMMREGISTER: + begin + tmploc:=l; + location_force_mmregscalar(list,tmploc,false); + cg.a_loadmm_reg_cgpara(list,tmploc.size,tmploc.register,cgpara,mms_movescalar); + end; + { Some targets pass floats in normal registers } + LOC_REGISTER, + LOC_CREGISTER, + LOC_REFERENCE, + LOC_CREFERENCE, + LOC_FPUREGISTER, + LOC_CFPUREGISTER: + cg.a_loadfpu_reg_cgpara(list,locsize,l.register,cgpara); + else + internalerror(2002042433); + end; + LOC_REFERENCE, + LOC_CREFERENCE: + case cgpara.location^.loc of + LOC_MMREGISTER, + LOC_CMMREGISTER: + cg.a_loadmm_ref_cgpara(list,locsize,l.reference,cgpara,mms_movescalar); + { Some targets pass floats in normal registers } + LOC_REGISTER, + LOC_CREGISTER, + LOC_REFERENCE, + LOC_CREFERENCE, + LOC_FPUREGISTER, + LOC_CFPUREGISTER: + cg.a_loadfpu_ref_cgpara(list,locsize,l.reference,cgpara); + else + internalerror(2002042431); + end; + LOC_REGISTER, + LOC_CREGISTER : + begin +{$ifndef cpu64bitalu} + { Only a_load_ref_cgpara supports multiple locations, when the + value is still a const or in a register then write it + to a reference first. This situation can be triggered + by typecasting an int64 constant to a record of 8 bytes } + if locsize = OS_F64 then + begin + tmploc:=l; + location_force_mem(list,tmploc); + cg.a_load_loc_cgpara(list,tmploc,cgpara); + location_freetemp(list,tmploc); + end + else +{$endif not cpu64bitalu} + cg.a_load_loc_cgpara(list,l,cgpara); + end; + else + internalerror(2002042432); + end; +{$endif i386} + end; + + + procedure gen_load_loc_cgpara(list: TAsmList; vardef: tdef; const l: tlocation; const cgpara: tcgpara); +{$ifndef cpu64bitalu} + var + tmploc: tlocation; +{$endif not cpu64bitalu} + begin + { Handle Floating point types differently + + This doesn't depend on emulator settings, emulator settings should + be handled by cpupara } + if (vardef.typ=floatdef) or + { some ABIs return certain records in an fpu register } + (l.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER]) or + (assigned(cgpara.location) and + (cgpara.Location^.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER])) then + begin + gen_loadfpu_loc_cgpara(list,l,cgpara,vardef.size); + exit; + end; + + case l.loc of + LOC_CONSTANT, + LOC_REGISTER, + LOC_CREGISTER, + LOC_REFERENCE, + LOC_CREFERENCE : + begin +{$ifndef cpu64bitalu} + { use cg64 only for int64, not for 8 byte records } + if is_64bit(vardef) then + cg64.a_load64_loc_cgpara(list,l,cgpara) + else +{$endif not cpu64bitalu} + begin +{$ifndef cpu64bitalu} + { Only a_load_ref_cgpara supports multiple locations, when the + value is still a const or in a register then write it + to a reference first. This situation can be triggered + by typecasting an int64 constant to a record of 8 bytes } + if l.size in [OS_64,OS_S64] then + begin + tmploc:=l; + location_force_mem(list,tmploc); + cg.a_load_loc_cgpara(list,tmploc,cgpara); + { do not free the tmploc in case the original value was + already in memory, because the caller (ncgcal) will then + free it again later } + if not(l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then + location_freetemp(list,tmploc); + end + else +{$endif not cpu64bitalu} + cg.a_load_loc_cgpara(list,l,cgpara); + end; + end; + LOC_MMREGISTER, + LOC_CMMREGISTER: + begin + case l.size of + OS_F32, + OS_F64: + cg.a_loadmm_loc_cgpara(list,l,cgpara,mms_movescalar); + else + cg.a_loadmm_loc_cgpara(list,l,cgpara,nil); + end; + end; +{$ifdef SUPPORT_MMX} + LOC_MMXREGISTER, + LOC_CMMXREGISTER: + cg.a_loadmm_reg_cgpara(list,OS_M64,l.register,cgpara,nil); +{$endif SUPPORT_MMX} + else + internalerror(200204241); + end; + end; + + + procedure register_maybe_adjust_setbase(list: TAsmList; var l: tlocation; setbase: aint); + var + tmpreg: tregister; + begin + if (setbase<>0) then + begin + if not(l.loc in [LOC_REGISTER,LOC_CREGISTER]) then + internalerror(2007091502); + { subtract the setbase } + case l.loc of + LOC_CREGISTER: + begin + tmpreg := cg.getintregister(list,l.size); + cg.a_op_const_reg_reg(list,OP_SUB,l.size,setbase,l.register,tmpreg); + l.loc:=LOC_REGISTER; + l.register:=tmpreg; + end; + LOC_REGISTER: + begin + cg.a_op_const_reg(list,OP_SUB,l.size,setbase,l.register); + end; + end; + end; + end; + + + procedure location_force_mmreg(list:TAsmList;var l: tlocation;maybeconst:boolean); + var + reg : tregister; + begin + if (l.loc<>LOC_MMREGISTER) and + ((l.loc<>LOC_CMMREGISTER) or (not maybeconst)) then + begin + reg:=cg.getmmregister(list,OS_VECTOR); + cg.a_loadmm_loc_reg(list,OS_VECTOR,l,reg,nil); + location_freetemp(list,l); + location_reset(l,LOC_MMREGISTER,OS_VECTOR); + l.register:=reg; + end; + end; + + + procedure location_allocate_register(list: TAsmList;out l: tlocation;def: tdef;constant: boolean); + begin + l.size:=def_cgsize(def); + if (def.typ=floatdef) and + not(cs_fp_emulation in current_settings.moduleswitches) then + begin + if use_vectorfpu(def) then + begin + if constant then + location_reset(l,LOC_CMMREGISTER,l.size) + else + location_reset(l,LOC_MMREGISTER,l.size); + l.register:=cg.getmmregister(list,l.size); + end + else + begin + if constant then + location_reset(l,LOC_CFPUREGISTER,l.size) + else + location_reset(l,LOC_FPUREGISTER,l.size); + l.register:=cg.getfpuregister(list,l.size); + end; + end + else + begin + if constant then + location_reset(l,LOC_CREGISTER,l.size) + else + location_reset(l,LOC_REGISTER,l.size); +{$ifndef cpu64bitalu} + if l.size in [OS_64,OS_S64,OS_F64] then + begin + l.register64.reglo:=cg.getintregister(list,OS_32); + l.register64.reghi:=cg.getintregister(list,OS_32); + end + else +{$endif not cpu64bitalu} + l.register:=cg.getintregister(list,l.size); + end; + end; + + + procedure location_force_mem(list:TAsmList;var l:tlocation); + var + r : treference; + begin + case l.loc of + LOC_FPUREGISTER, + LOC_CFPUREGISTER : + begin + tg.GetTemp(list,TCGSize2Size[l.size],TCGSize2Size[l.size],tt_normal,r); + cg.a_loadfpu_reg_ref(list,l.size,l.size,l.register,r); + location_reset_ref(l,LOC_REFERENCE,l.size,0); + l.reference:=r; + end; + LOC_MMREGISTER, + LOC_CMMREGISTER: + begin + tg.GetTemp(list,TCGSize2Size[l.size],TCGSize2Size[l.size],tt_normal,r); + cg.a_loadmm_reg_ref(list,l.size,l.size,l.register,r,mms_movescalar); + location_reset_ref(l,LOC_REFERENCE,l.size,0); + l.reference:=r; + end; + LOC_CONSTANT, + LOC_REGISTER, + LOC_CREGISTER : + begin + tg.GetTemp(list,TCGSize2Size[l.size],TCGSize2Size[l.size],tt_normal,r); +{$ifndef cpu64bitalu} + if l.size in [OS_64,OS_S64] then + cg64.a_load64_loc_ref(list,l,r) + else +{$endif not cpu64bitalu} + cg.a_load_loc_ref(list,l.size,l,r); + location_reset_ref(l,LOC_REFERENCE,l.size,0); + l.reference:=r; + end; + LOC_SUBSETREG, + LOC_CSUBSETREG, + LOC_SUBSETREF, + LOC_CSUBSETREF: + begin + tg.GetTemp(list,TCGSize2Size[l.size],TCGSize2Size[l.size],tt_normal,r); + cg.a_load_loc_ref(list,l.size,l,r); + location_reset_ref(l,LOC_REFERENCE,l.size,0); + l.reference:=r; + end; + LOC_CREFERENCE, + LOC_REFERENCE : ; + else + internalerror(200203219); + end; + end; + + + procedure location_get_data_ref(list:TAsmList;const l:tlocation;var ref:treference;loadref:boolean; alignment: longint); + begin + case l.loc of + LOC_REGISTER, + LOC_CREGISTER : + begin + if not loadref then + internalerror(200410231); + reference_reset_base(ref,l.register,0,alignment); + end; + LOC_REFERENCE, + LOC_CREFERENCE : + begin + if loadref then + begin + reference_reset_base(ref,cg.getaddressregister(list),0,alignment); + cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,l.reference,ref.base); + end + else + ref:=l.reference; + end; + else + internalerror(200309181); + end; + end; + + +{**************************************************************************** + Init/Finalize Code +****************************************************************************} + + procedure copyvalueparas(p:TObject;arg:pointer); + var + href : treference; + hreg : tregister; + list : TAsmList; + hsym : tparavarsym; + l : longint; + localcopyloc : tlocation; + begin + list:=TAsmList(arg); + if (tsym(p).typ=paravarsym) and + (tparavarsym(p).varspez=vs_value) and + (paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then + begin + { we have no idea about the alignment at the caller side } + location_get_data_ref(list,tparavarsym(p).initialloc,href,true,1); + if is_open_array(tparavarsym(p).vardef) or + is_array_of_const(tparavarsym(p).vardef) then + begin + { cdecl functions don't have a high pointer so it is not possible to generate + a local copy } + if not(current_procinfo.procdef.proccalloption in cdecl_pocalls) then + begin + hsym:=tparavarsym(get_high_value_sym(tparavarsym(p))); + if not assigned(hsym) then + internalerror(200306061); + hreg:=cg.getaddressregister(list); + if not is_packed_array(tparavarsym(p).vardef) then + cg.g_copyvaluepara_openarray(list,href,hsym.initialloc,tarraydef(tparavarsym(p).vardef).elesize,hreg) + else + internalerror(2006080401); +// cg.g_copyvaluepara_packedopenarray(list,href,hsym.intialloc,tarraydef(tparavarsym(p).vardef).elepackedbitsize,hreg); + cg.a_load_reg_loc(list,OS_ADDR,hreg,tparavarsym(p).initialloc); + end; + end + else + begin + { Allocate space for the local copy } + l:=tparavarsym(p).getsize; + localcopyloc.loc:=LOC_REFERENCE; + localcopyloc.size:=int_cgsize(l); + tg.GetLocal(list,l,tparavarsym(p).vardef,localcopyloc.reference); + { Copy data } + if is_shortstring(tparavarsym(p).vardef) then + begin + { this code is only executed before the code for the body and the entry/exit code is generated + so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore + } + include(current_procinfo.flags,pi_do_call); + cg.g_copyshortstring(list,href,localcopyloc.reference,tstringdef(tparavarsym(p).vardef).len) + end + else if tparavarsym(p).vardef.typ = variantdef then + begin + { this code is only executed before the code for the body and the entry/exit code is generated + so we're allowed to include pi_do_call here; after pass1 is run, this isn't allowed anymore + } + include(current_procinfo.flags,pi_do_call); + cg.g_copyvariant(list,href,localcopyloc.reference) + end + else + begin + { pass proper alignment info } + localcopyloc.reference.alignment:=tparavarsym(p).vardef.alignment; + cg.g_concatcopy(list,href,localcopyloc.reference,tparavarsym(p).vardef.size); + end; + { update localloc of varsym } + tg.Ungetlocal(list,tparavarsym(p).localloc.reference); + tparavarsym(p).localloc:=localcopyloc; + tparavarsym(p).initialloc:=localcopyloc; + end; + end; + end; + + + const +{$ifdef cpu64bitalu} + trashintvalues: array[0..nroftrashvalues-1] of aint = ($5555555555555555,aint($AAAAAAAAAAAAAAAA),aint($EFEFEFEFEFEFEFEF),0); +{$endif cpu64bitalu} +{$ifdef cpu32bitalu} + trashintvalues: array[0..nroftrashvalues-1] of aint = ($55555555,aint($AAAAAAAA),aint($EFEFEFEF),0); +{$endif cpu32bitalu} +{$ifdef cpu8bitalu} + trashintvalues: array[0..nroftrashvalues-1] of aint = ($55,aint($AA),aint($EF),0); +{$endif cpu8bitalu} + + procedure trash_reference(list: TAsmList; const ref: treference; size: aint); + var + countreg, valuereg: tregister; + hl: tasmlabel; + trashintval: aint; + tmpref: treference; + begin + trashintval := trashintvalues[localvartrashing]; + case size of + 0: ; { empty record } + 1: cg.a_load_const_ref(list,OS_8,byte(trashintval),ref); + 2: cg.a_load_const_ref(list,OS_16,word(trashintval),ref); + 4: cg.a_load_const_ref(list,OS_32,longint(trashintval),ref); + {$ifdef cpu64bitalu} + 8: cg.a_load_const_ref(list,OS_64,int64(trashintval),ref); + {$endif cpu64bitalu} + else + begin + countreg := cg.getintregister(list,OS_ADDR); + valuereg := cg.getintregister(list,OS_8); + cg.a_load_const_reg(list,OS_INT,size,countreg); + cg.a_load_const_reg(list,OS_8,byte(trashintval),valuereg); + current_asmdata.getjumplabel(hl); + tmpref := ref; + if (tmpref.index <> NR_NO) then + internalerror(200607201); + tmpref.index := countreg; + dec(tmpref.offset); + cg.a_label(list,hl); + cg.a_load_reg_ref(list,OS_8,OS_8,valuereg,tmpref); + cg.a_op_const_reg(list,OP_SUB,OS_INT,1,countreg); + cg.a_cmp_const_reg_label(list,OS_INT,OC_NE,0,countreg,hl); + cg.a_reg_sync(list,tmpref.base); + cg.a_reg_sync(list,valuereg); + end; + end; + end; + + + { trash contents of local variables or parameters (function result) } + procedure trash_variable(p:TObject;arg:pointer); + var + trashintval: aint; + list: TAsmList absolute arg; + begin + if ((tsym(p).typ=localvarsym) or + ((tsym(p).typ=paravarsym) and + (vo_is_funcret in tparavarsym(p).varoptions))) and + not(is_managed_type(tabstractnormalvarsym(p).vardef)) and + not(assigned(tabstractnormalvarsym(p).defaultconstsym)) then + begin + trashintval := trashintvalues[localvartrashing]; + case tabstractnormalvarsym(p).initialloc.loc of + LOC_CREGISTER : +{$push} +{$q-} + begin + { avoid problems with broken x86 shifts } + case tcgsize2size[tabstractnormalvarsym(p).initialloc.size] of + 1: cg.a_load_const_reg(list,OS_8,byte(trashintval),tabstractnormalvarsym(p).initialloc.register); + 2: cg.a_load_const_reg(list,OS_16,word(trashintval),tabstractnormalvarsym(p).initialloc.register); + 4: cg.a_load_const_reg(list,OS_32,longint(trashintval),tabstractnormalvarsym(p).initialloc.register); + 8: + begin +{$ifdef cpu64bitalu} + cg.a_load_const_reg(list,OS_64,aint(trashintval),tabstractnormalvarsym(p).initialloc.register); +{$else} + cg64.a_load64_const_reg(list,int64(trashintval) shl 32 or int64(trashintval),tabstractnormalvarsym(p).initialloc.register64); +{$endif} + end; + else + internalerror(2010060801); + end; + end; +{$pop} + LOC_REFERENCE : + begin + if ((tsym(p).typ=localvarsym) and + not(vo_is_funcret in tabstractvarsym(p).varoptions)) or + not is_shortstring(tabstractnormalvarsym(p).vardef) then + trash_reference(list,tabstractnormalvarsym(p).initialloc.reference, + tlocalvarsym(p).getsize) + else + { may be an open string, even if is_open_string() returns } + { false (for some helpers in the system unit) } + { an open string has at least size 2 } + trash_reference(list,tabstractnormalvarsym(p).initialloc.reference, + 2); + end; + LOC_CMMREGISTER : + ; + LOC_CFPUREGISTER : + ; + else + internalerror(200410124); + end; + end; + end; + + + { initializes the regvars from staticsymtable with 0 } + procedure initialize_regvars(p:TObject;arg:pointer); + var + href : treference; + begin + if (tsym(p).typ=staticvarsym) then + begin + { Static variables can have the initialloc only set to LOC_CxREGISTER + or LOC_INVALID, for explaination see gen_alloc_symtable (PFV) } + case tstaticvarsym(p).initialloc.loc of + LOC_CREGISTER : + begin +{$ifndef cpu64bitalu} + if (tstaticvarsym(p).initialloc.size in [OS_64,OS_S64]) then + cg64.a_load64_const_reg(TAsmList(arg),0,tstaticvarsym(p).initialloc.register64) + else +{$endif not cpu64bitalu} + cg.a_load_const_reg(TAsmList(arg),reg_cgsize(tstaticvarsym(p).initialloc.register),0, + tstaticvarsym(p).initialloc.register); + end; + LOC_CMMREGISTER : + { clear the whole register } + cg.a_opmm_reg_reg(TAsmList(arg),OP_XOR,reg_cgsize(tstaticvarsym(p).initialloc.register), + tstaticvarsym(p).initialloc.register, + tstaticvarsym(p).initialloc.register, + nil); + LOC_CFPUREGISTER : + begin + { initialize fpu regvar by loading from memory } + reference_reset_symbol(href, + current_asmdata.RefAsmSymbol(tstaticvarsym(p).mangledname), 0, + var_align(tstaticvarsym(p).vardef.alignment)); + cg.a_loadfpu_ref_reg(TAsmList(arg), tstaticvarsym(p).initialloc.size, + tstaticvarsym(p).initialloc.size, href, tstaticvarsym(p).initialloc.register); + end; + LOC_INVALID : + ; + else + internalerror(200410124); + end; + end; + end; + + + { generates the code for initialisation of local data } + procedure initialize_data(p:TObject;arg:pointer); + var + OldAsmList : TAsmList; + hp : tnode; + begin + if (tsym(p).typ = localvarsym) and + { local (procedure or unit) variables only need initialization if + they are used } + ((tabstractvarsym(p).refs>0) or + { managed return symbols must be inited } + ((tsym(p).typ=localvarsym) and (vo_is_funcret in tlocalvarsym(p).varoptions)) + ) and + not(vo_is_typed_const in tabstractvarsym(p).varoptions) and + not(vo_is_external in tabstractvarsym(p).varoptions) and + (is_managed_type(tabstractvarsym(p).vardef) or + ((m_iso in current_settings.modeswitches) and (tabstractvarsym(p).vardef.typ=filedef)) + ) then + begin + OldAsmList:=current_asmdata.CurrAsmList; + current_asmdata.CurrAsmList:=TAsmList(arg); + hp:=initialize_data_node(cloadnode.create(tsym(p),tsym(p).owner)); + firstpass(hp); + secondpass(hp); + hp.free; + current_asmdata.CurrAsmList:=OldAsmList; + end; + end; + + + procedure finalize_sym(asmlist:TAsmList;sym:tsym); + var + hp : tnode; + OldAsmList : TAsmList; + begin + include(current_procinfo.flags,pi_needs_implicit_finally); + OldAsmList:=current_asmdata.CurrAsmList; + current_asmdata.CurrAsmList:=asmlist; + hp:=cloadnode.create(sym,sym.owner); + if (sym.typ=staticvarsym) and (vo_force_finalize in tstaticvarsym(sym).varoptions) then + include(tloadnode(hp).loadnodeflags,loadnf_isinternal_ignoreconst); + hp:=finalize_data_node(hp); + firstpass(hp); + secondpass(hp); + hp.free; + current_asmdata.CurrAsmList:=OldAsmList; + end; + + + { generates the code for finalisation of local variables } + procedure finalize_local_vars(p:TObject;arg:pointer); + begin + if (tsym(p).typ=localvarsym) and + (tlocalvarsym(p).refs>0) and + not(vo_is_external in tlocalvarsym(p).varoptions) and + not(vo_is_funcret in tlocalvarsym(p).varoptions) and + is_managed_type(tlocalvarsym(p).vardef) then + finalize_sym(TAsmList(arg),tsym(p)); + end; + + + { generates the code for finalization of static symtable and + all local (static) typed consts } + procedure finalize_static_data(p:TObject;arg:pointer); + var + i : longint; + pd : tprocdef; + begin + case tsym(p).typ of + staticvarsym : + begin + { local (procedure or unit) variables only need finalization + if they are used + } + if ((tstaticvarsym(p).refs>0) or + { global (unit) variables always need finalization, since + they may also be used in another unit + } + (tstaticvarsym(p).owner.symtabletype=globalsymtable)) and + ( + (tstaticvarsym(p).varspez<>vs_const) or + (vo_force_finalize in tstaticvarsym(p).varoptions) + ) and + not(vo_is_funcret in tstaticvarsym(p).varoptions) and + not(vo_is_external in tstaticvarsym(p).varoptions) and + is_managed_type(tstaticvarsym(p).vardef) then + finalize_sym(TAsmList(arg),tsym(p)); + end; + procsym : + begin + for i:=0 to tprocsym(p).ProcdefList.Count-1 do + begin + pd:=tprocdef(tprocsym(p).ProcdefList[i]); + if assigned(pd.localst) and + (pd.procsym=tprocsym(p)) and + (pd.localst.symtabletype<>staticsymtable) then + pd.localst.SymList.ForEachCall(@finalize_static_data,arg); + end; + end; + end; + end; + + + { generates the code for incrementing the reference count of parameters and + initialize out parameters } + procedure init_paras(p:TObject;arg:pointer); + var + href : treference; + hsym : tparavarsym; + eldef : tdef; + tmpreg : tregister; + list : TAsmList; + needs_inittable, + do_trashing : boolean; + begin + list:=TAsmList(arg); + if (tsym(p).typ=paravarsym) then + begin + needs_inittable:=is_managed_type(tparavarsym(p).vardef); + do_trashing:= + (localvartrashing <> -1) and + (not assigned(tparavarsym(p).defaultconstsym)) and + not needs_inittable; + case tparavarsym(p).varspez of + vs_value : + if needs_inittable then + begin + { variants are already handled by the call to fpc_variant_copy_overwrite if + they are passed by reference } + if not((tparavarsym(p).vardef.typ=variantdef) and + paramanager.push_addr_param(tparavarsym(p).varspez,tparavarsym(p).vardef,current_procinfo.procdef.proccalloption)) then + begin + location_get_data_ref(list,tparavarsym(p).initialloc,href,is_open_array(tparavarsym(p).vardef),sizeof(pint)); + if is_open_array(tparavarsym(p).vardef) then + begin + { open arrays do not contain correct element count in their rtti, + the actual count must be passed separately. } + hsym:=tparavarsym(get_high_value_sym(tparavarsym(p))); + eldef:=tarraydef(tparavarsym(p).vardef).elementdef; + if not assigned(hsym) then + internalerror(201003031); + cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_ADDREF_ARRAY'); + end + else + cg.g_incrrefcount(list,tparavarsym(p).vardef,href); + end; + end; + vs_out : + begin + if needs_inittable or + do_trashing then + begin + tmpreg:=cg.getaddressregister(list); + cg.a_load_loc_reg(list,OS_ADDR,tparavarsym(p).initialloc,tmpreg); + { we have no idea about the alignment at the callee side, + and the user also cannot specify "unaligned" here, so + assume worst case } + reference_reset_base(href,tmpreg,0,1); + if do_trashing and + { needs separate implementation to trash open arrays } + { since their size is only known at run time } + not is_special_array(tparavarsym(p).vardef) then + { may be an open string, even if is_open_string() returns } + { false (for some helpers in the system unit) } + if not is_shortstring(tparavarsym(p).vardef) then + trash_reference(list,href,tparavarsym(p).vardef.size) + else + trash_reference(list,href,2); + if needs_inittable then + begin + if is_open_array(tparavarsym(p).vardef) then + begin + hsym:=tparavarsym(get_high_value_sym(tparavarsym(p))); + eldef:=tarraydef(tparavarsym(p).vardef).elementdef; + if not assigned(hsym) then + internalerror(201103033); + cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_INITIALIZE_ARRAY'); + end + else + cg.g_initialize(list,tparavarsym(p).vardef,href); + end; + end; + end; + else if do_trashing and + ([vo_is_funcret,vo_is_hidden_para] * tparavarsym(p).varoptions = [vo_is_funcret,vo_is_hidden_para]) then + begin + tmpreg:=cg.getaddressregister(list); + cg.a_load_loc_reg(list,OS_ADDR,tparavarsym(p).initialloc,tmpreg); + { should always have standard alignment. If a function is assigned + to a non-aligned variable, the optimisation to pass this variable + directly as hidden function result must/cannot be performed + (see tcallnode.funcret_can_be_reused) + } + reference_reset_base(href,tmpreg,0, + used_align(tparavarsym(p).vardef.alignment,current_settings.alignment.localalignmin,current_settings.alignment.localalignmax)); + { may be an open string, even if is_open_string() returns } + { false (for some helpers in the system unit) } + if not is_shortstring(tparavarsym(p).vardef) then + trash_reference(list,href,tparavarsym(p).vardef.size) + else + { an open string has at least size 2 } + trash_reference(list,href,2); + end + end; + end; + end; + + + { generates the code for decrementing the reference count of parameters } + procedure final_paras(p:TObject;arg:pointer); + var + list : TAsmList; + href : treference; + hsym : tparavarsym; + eldef : tdef; + begin + if not(tsym(p).typ=paravarsym) then + exit; + list:=TAsmList(arg); + if is_managed_type(tparavarsym(p).vardef) then + begin + if (tparavarsym(p).varspez=vs_value) then + begin + include(current_procinfo.flags,pi_needs_implicit_finally); + location_get_data_ref(list,tparavarsym(p).localloc,href,is_open_array(tparavarsym(p).vardef),sizeof(pint)); + if is_open_array(tparavarsym(p).vardef) then + begin + hsym:=tparavarsym(get_high_value_sym(tparavarsym(p))); + eldef:=tarraydef(tparavarsym(p).vardef).elementdef; + if not assigned(hsym) then + internalerror(201003032); + cg.g_array_rtti_helper(list,eldef,href,hsym.initialloc,'FPC_FINALIZE_ARRAY'); + end + else + cg.g_finalize(list,tparavarsym(p).vardef,href); + end; + end; + { open arrays can contain elements requiring init/final code, so the else has been removed here } + if (tparavarsym(p).varspez=vs_value) and + (is_open_array(tparavarsym(p).vardef) or + is_array_of_const(tparavarsym(p).vardef)) then + begin + { cdecl functions don't have a high pointer so it is not possible to generate + a local copy } + if not(current_procinfo.procdef.proccalloption in cdecl_pocalls) then + cg.g_releasevaluepara_openarray(list,tparavarsym(p).localloc); + end; + end; + + + { Initialize temp ansi/widestrings,interfaces } + procedure inittempvariables(list:TAsmList); + var + hp : ptemprecord; + href : treference; + begin + hp:=tg.templist; + while assigned(hp) do + begin + if assigned(hp^.def) and + is_managed_type(hp^.def) then + begin + reference_reset_base(href,current_procinfo.framepointer,hp^.pos,sizeof(pint)); + cg.g_initialize(list,hp^.def,href); + end; + hp:=hp^.next; + end; + end; + + + procedure finalizetempvariables(list:TAsmList); + var + hp : ptemprecord; + href : treference; + begin + hp:=tg.templist; + while assigned(hp) do + begin + if assigned(hp^.def) and + is_managed_type(hp^.def) then + begin + include(current_procinfo.flags,pi_needs_implicit_finally); + reference_reset_base(href,current_procinfo.framepointer,hp^.pos,sizeof(pint)); + cg.g_finalize(list,hp^.def,href); + end; + hp:=hp^.next; + end; + end; + + + procedure gen_load_return_value(list:TAsmList); + var + ressym : tabstractnormalvarsym; + funcretloc : TCGPara; + begin + { Is the loading needed? } + if is_void(current_procinfo.procdef.returndef) or + ( + (po_assembler in current_procinfo.procdef.procoptions) and + (not(assigned(current_procinfo.procdef.funcretsym)) or + (tabstractvarsym(current_procinfo.procdef.funcretsym).refs=0)) + ) then + exit; + + funcretloc:=current_procinfo.procdef.funcretloc[calleeside]; + + { constructors return self } + if (current_procinfo.procdef.proctypeoption=potype_constructor) then + ressym:=tabstractnormalvarsym(current_procinfo.procdef.parast.Find('self')) + else + ressym:=tabstractnormalvarsym(current_procinfo.procdef.funcretsym); + if (ressym.refs>0) or + is_managed_type(ressym.vardef) then + begin + { was: don't do anything if funcretloc.loc in [LOC_INVALID,LOC_REFERENCE] } + if not paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef.proccalloption) then + gen_load_loc_cgpara(list,ressym.vardef,ressym.localloc,funcretloc); + end +{$ifdef x86} + else + begin + { the caller will pop a value from the fpu stack } + if assigned(funcretloc.location) and + (funcretloc.location^.loc = LOC_FPUREGISTER) then + list.concat(taicpu.op_none(A_FLDZ)); + end; +{$endif x86} + end; + + + procedure gen_alloc_regloc(list:TAsmList;var loc: tlocation); + begin + case loc.loc of + LOC_CREGISTER: + begin +{$ifndef cpu64bitalu} + if loc.size in [OS_64,OS_S64] then + begin + loc.register64.reglo:=cg.getintregister(list,OS_32); + loc.register64.reghi:=cg.getintregister(list,OS_32); + end + else +{$endif cpu64bitalu} + loc.register:=cg.getintregister(list,loc.size); + end; + LOC_CFPUREGISTER: + begin + loc.register:=cg.getfpuregister(list,loc.size); + end; + LOC_CMMREGISTER: + begin + loc.register:=cg.getmmregister(list,loc.size); + end; + end; + end; + + + procedure gen_alloc_regvar(list:TAsmList;sym: tabstractnormalvarsym; allocreg: boolean); + begin + if allocreg then + gen_alloc_regloc(list,sym.initialloc); + if (pi_has_label in current_procinfo.flags) then + begin + { Allocate register already, to prevent first allocation to be + inside a loop } +{$ifndef cpu64bitalu} + if sym.initialloc.size in [OS_64,OS_S64] then + begin + cg.a_reg_sync(list,sym.initialloc.register64.reglo); + cg.a_reg_sync(list,sym.initialloc.register64.reghi); + end + else +{$endif not cpu64bitalu} + cg.a_reg_sync(list,sym.initialloc.register); + end; + sym.localloc:=sym.initialloc; + end; + + + procedure gen_load_cgpara_loc(list: TAsmList; vardef: tdef; const para: TCGPara; var destloc: tlocation; reusepara: boolean); + + procedure unget_para(const paraloc:TCGParaLocation); + begin + case paraloc.loc of + LOC_REGISTER : + begin + if getsupreg(paraloc.register)<first_int_imreg then + cg.ungetcpuregister(list,paraloc.register); + end; + LOC_MMREGISTER : + begin + if getsupreg(paraloc.register)<first_mm_imreg then + cg.ungetcpuregister(list,paraloc.register); + end; + LOC_FPUREGISTER : + begin + if getsupreg(paraloc.register)<first_fpu_imreg then + cg.ungetcpuregister(list,paraloc.register); + end; + end; + end; + + var + paraloc : pcgparalocation; + href : treference; + sizeleft : aint; +{$if defined(sparc) or defined(arm)} + tempref : treference; +{$endif sparc} +{$ifndef cpu64bitalu} + reg64: tregister64; +{$endif not cpu64bitalu} + begin + paraloc:=para.location; + if not assigned(paraloc) then + internalerror(200408203); + { skip e.g. empty records } + if (paraloc^.loc = LOC_VOID) then + exit; + case destloc.loc of + LOC_REFERENCE : + begin + { If the parameter location is reused we don't need to copy + anything } + if not reusepara then + begin + href:=destloc.reference; + sizeleft:=para.intsize; + while assigned(paraloc) do + begin + if (paraloc^.size=OS_NO) then + begin + { Can only be a reference that contains the rest + of the parameter } + if (paraloc^.loc<>LOC_REFERENCE) or + assigned(paraloc^.next) then + internalerror(2005013010); + cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment); + inc(href.offset,sizeleft); + sizeleft:=0; + end + else + begin + cg.a_load_cgparaloc_ref(list,paraloc^,href,tcgsize2size[paraloc^.size],destloc.reference.alignment); + inc(href.offset,TCGSize2Size[paraloc^.size]); + dec(sizeleft,TCGSize2Size[paraloc^.size]); + end; + unget_para(paraloc^); + paraloc:=paraloc^.next; + end; + end; + end; + LOC_REGISTER, + LOC_CREGISTER : + begin +{$ifndef cpu64bitalu} + if (para.size in [OS_64,OS_S64,OS_F64]) and + (is_64bit(vardef) or + { in case of fpu emulation, or abi's that pass fpu values + via integer registers } + (vardef.typ=floatdef)) then + begin + case paraloc^.loc of + LOC_REGISTER: + begin + if not assigned(paraloc^.next) then + internalerror(200410104); + if (target_info.endian=ENDIAN_BIG) then + begin + { paraloc^ -> high + paraloc^.next -> low } + unget_para(paraloc^); + gen_alloc_regloc(list,destloc); + { reg->reg, alignment is irrelevant } + cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^,destloc.register64.reghi,4); + unget_para(paraloc^.next^); + cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,destloc.register64.reglo,4); + end + else + begin + { paraloc^ -> low + paraloc^.next -> high } + unget_para(paraloc^); + gen_alloc_regloc(list,destloc); + cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^,destloc.register64.reglo,4); + unget_para(paraloc^.next^); + cg.a_load_cgparaloc_anyreg(list,OS_32,paraloc^.next^,destloc.register64.reghi,4); + end; + end; + LOC_REFERENCE: + begin + gen_alloc_regloc(list,destloc); + reference_reset_base(href,paraloc^.reference.index,paraloc^.reference.offset,para.alignment); + cg64.a_load64_ref_reg(list,href,destloc.register64); + unget_para(paraloc^); + end; + else + internalerror(2005101501); + end + end + else +{$endif not cpu64bitalu} + begin + if assigned(paraloc^.next) then + internalerror(200410105); + unget_para(paraloc^); + gen_alloc_regloc(list,destloc); + cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,sizeof(aint)); + end; + end; + LOC_FPUREGISTER, + LOC_CFPUREGISTER : + begin +{$if defined(sparc) or defined(arm)} + { Arm and Sparc passes floats in int registers, when loading to fpu register + we need a temp } + sizeleft := TCGSize2Size[destloc.size]; + tg.GetTemp(list,sizeleft,sizeleft,tt_normal,tempref); + href:=tempref; + while assigned(paraloc) do + begin + unget_para(paraloc^); + cg.a_load_cgparaloc_ref(list,paraloc^,href,sizeleft,destloc.reference.alignment); + inc(href.offset,TCGSize2Size[paraloc^.size]); + dec(sizeleft,TCGSize2Size[paraloc^.size]); + paraloc:=paraloc^.next; + end; + gen_alloc_regloc(list,destloc); + cg.a_loadfpu_ref_reg(list,destloc.size,destloc.size,tempref,destloc.register); + tg.UnGetTemp(list,tempref); +{$else sparc} + unget_para(paraloc^); + gen_alloc_regloc(list,destloc); + { from register to register -> alignment is irrelevant } + cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0); + if assigned(paraloc^.next) then + internalerror(200410109); +{$endif sparc} + end; + LOC_MMREGISTER, + LOC_CMMREGISTER : + begin +{$ifndef cpu64bitalu} + { ARM vfp floats are passed in integer registers } + if (para.size=OS_F64) and + (paraloc^.size in [OS_32,OS_S32]) and + use_vectorfpu(vardef) then + begin + { we need 2x32bit reg } + if not assigned(paraloc^.next) or + assigned(paraloc^.next^.next) then + internalerror(2009112421); + unget_para(paraloc^); + unget_para(paraloc^.next^); + gen_alloc_regloc(list,destloc); + if (target_info.endian=endian_big) then + { paraloc^ -> high + paraloc^.next -> low } + reg64:=joinreg64(paraloc^.next^.register,paraloc^.register) + else + reg64:=joinreg64(paraloc^.register,paraloc^.next^.register); + cg64.a_loadmm_intreg64_reg(list,OS_F64,reg64,destloc.register); + end + else +{$endif not cpu64bitalu} + begin + unget_para(paraloc^); + gen_alloc_regloc(list,destloc); + { from register to register -> alignment is irrelevant } + cg.a_load_cgparaloc_anyreg(list,destloc.size,paraloc^,destloc.register,0); + { data could come in two memory locations, for now + we simply ignore the sanity check (FK) + if assigned(paraloc^.next) then + internalerror(200410108); + } + end; + end; + else + internalerror(2010052903); + end; + end; + + + procedure gen_load_para_value(list:TAsmList); + + procedure get_para(const paraloc:TCGParaLocation); + begin + case paraloc.loc of + LOC_REGISTER : + begin + if getsupreg(paraloc.register)<first_int_imreg then + cg.getcpuregister(list,paraloc.register); + end; + LOC_MMREGISTER : + begin + if getsupreg(paraloc.register)<first_mm_imreg then + cg.getcpuregister(list,paraloc.register); + end; + LOC_FPUREGISTER : + begin + if getsupreg(paraloc.register)<first_fpu_imreg then + cg.getcpuregister(list,paraloc.register); + end; + end; + end; + + + var + i : longint; + currpara : tparavarsym; + paraloc : pcgparalocation; + begin + if (po_assembler in current_procinfo.procdef.procoptions) or + { exceptfilters have a single hidden 'parentfp' parameter, which + is handled by tcg.g_proc_entry. } + (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then + exit; + + { Allocate registers used by parameters } + for i:=0 to current_procinfo.procdef.paras.count-1 do + begin + currpara:=tparavarsym(current_procinfo.procdef.paras[i]); + paraloc:=currpara.paraloc[calleeside].location; + while assigned(paraloc) do + begin + if paraloc^.loc in [LOC_REGISTER,LOC_FPUREGISTER,LOC_MMREGISTER] then + get_para(paraloc^); + paraloc:=paraloc^.next; + end; + end; + + { Copy parameters to local references/registers } + for i:=0 to current_procinfo.procdef.paras.count-1 do + begin + currpara:=tparavarsym(current_procinfo.procdef.paras[i]); + gen_load_cgpara_loc(list,currpara.vardef,currpara.paraloc[calleeside],currpara.initialloc,paramanager.param_use_paraloc(currpara.paraloc[calleeside])); + { gen_load_cgpara_loc() already allocated the initialloc + -> don't allocate again } + if currpara.initialloc.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMREGISTER] then + gen_alloc_regvar(list,currpara,false); + end; + + { generate copies of call by value parameters, must be done before + the initialization and body is parsed because the refcounts are + incremented using the local copies } + current_procinfo.procdef.parast.SymList.ForEachCall(@copyvalueparas,list); +{$ifdef powerpc} + { unget the register that contains the stack pointer before the procedure entry, } + { which is used to access the parameters in their original callee-side location } + if (tppcprocinfo(current_procinfo).needs_frame_pointer) then + cg.a_reg_dealloc(list,NR_R12); +{$endif powerpc} +{$ifdef powerpc64} + { unget the register that contains the stack pointer before the procedure entry, } + { which is used to access the parameters in their original callee-side location } + if (tppcprocinfo(current_procinfo).needs_frame_pointer) then + cg.a_reg_dealloc(list, NR_OLD_STACK_POINTER_REG); +{$endif powerpc64} + if not(po_assembler in current_procinfo.procdef.procoptions) then + begin + { has to be done here rather than in gen_initialize_code, because + the initialisation code is generated a) later and b) with + rad_backwards, so the register allocator would generate + information as if this code comes before loading the parameters + from their original registers to their local location } + if (localvartrashing <> -1) then + current_procinfo.procdef.localst.SymList.ForEachCall(@trash_variable,list); + { initialize refcounted paras, and trash others. Needed here + instead of in gen_initialize_code, because when a reference is + intialised or trashed while the pointer to that reference is kept + in a regvar, we add a register move and that one again has to + come after the parameter loading code as far as the register + allocator is concerned } + current_procinfo.procdef.parast.SymList.ForEachCall(@init_paras,list); + end; + end; + + + procedure gen_initialize_code(list:TAsmList); + begin + { initialize local data like ansistrings } + case current_procinfo.procdef.proctypeoption of + potype_unitinit: + begin + { this is also used for initialization of variables in a + program which does not have a globalsymtable } + if assigned(current_module.globalsymtable) then + TSymtable(current_module.globalsymtable).SymList.ForEachCall(@initialize_data,list); + TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_data,list); + TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_regvars,list); + end; + { units have seperate code for initilization and finalization } + potype_unitfinalize: ; + { program init/final is generated in separate procedure } + potype_proginit: + begin + TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_regvars,list); + end; + else + current_procinfo.procdef.localst.SymList.ForEachCall(@initialize_data,list); + end; + + { initialisizes temp. ansi/wide string data } + if (current_procinfo.procdef.proctypeoption<>potype_exceptfilter) then + inittempvariables(list); + +{$ifdef OLDREGVARS} + load_regvars(list,nil); +{$endif OLDREGVARS} + end; + + + procedure gen_finalize_code(list:TAsmList); + var + old_current_procinfo: tprocinfo; + begin + old_current_procinfo:=current_procinfo; + if (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then + begin + if (current_procinfo.parent.finalize_procinfo<>current_procinfo) then + exit; + current_procinfo:=current_procinfo.parent; + end; + +{$ifdef OLDREGVARS} + cleanup_regvars(list); +{$endif OLDREGVARS} + + { finalize temporary data } + finalizetempvariables(list); + + { finalize local data like ansistrings} + case current_procinfo.procdef.proctypeoption of + potype_unitfinalize: + begin + { this is also used for initialization of variables in a + program which does not have a globalsymtable } + if assigned(current_module.globalsymtable) then + TSymtable(current_module.globalsymtable).SymList.ForEachCall(@finalize_static_data,list); + TSymtable(current_module.localsymtable).SymList.ForEachCall(@finalize_static_data,list); + end; + { units/progs have separate code for initialization and finalization } + potype_unitinit: ; + { program init/final is generated in separate procedure } + potype_proginit: ; + else + current_procinfo.procdef.localst.SymList.ForEachCall(@finalize_local_vars,list); + end; + + { finalize paras data } + if assigned(current_procinfo.procdef.parast) and + not(po_assembler in current_procinfo.procdef.procoptions) then + current_procinfo.procdef.parast.SymList.ForEachCall(@final_paras,list); + current_procinfo:=old_current_procinfo; + end; + + + procedure gen_entry_code(list:TAsmList); + begin + { the actual profile code can clobber some registers, + therefore if the context must be saved, do it before + the actual call to the profile code + } + if (cs_profile in current_settings.moduleswitches) and + not(po_assembler in current_procinfo.procdef.procoptions) then + begin + { non-win32 can call mcout even in main } + if not (target_info.system in [system_i386_win32,system_i386_wdosx]) or + not (current_procinfo.procdef.proctypeoption=potype_proginit) then + begin + cg.g_profilecode(list); + end; + end; + + { call startup helpers from main program } + if (current_procinfo.procdef.proctypeoption=potype_proginit) then + begin + { initialize units } + cg.allocallcpuregisters(list); + if not(current_module.islibrary) then + cg.a_call_name(list,'FPC_INITIALIZEUNITS',false) + else + cg.a_call_name(list,'FPC_LIBINITIALIZEUNITS',false); + cg.deallocallcpuregisters(list); + end; + + list.concat(Tai_force_line.Create); + +{$ifdef OLDREGVARS} + load_regvars(list,nil); +{$endif OLDREGVARS} + end; + + + procedure gen_exit_code(list:TAsmList); + begin + { call __EXIT for main program } + if (not DLLsource) and + (current_procinfo.procdef.proctypeoption=potype_proginit) then + cg.a_call_name(list,'FPC_DO_EXIT',false); + end; + + +{**************************************************************************** + Entry/Exit +****************************************************************************} + + function has_alias_name(pd:tprocdef;const s:string):boolean; + var + item : TCmdStrListItem; + begin + result:=true; + if pd.mangledname=s then + exit; + item := TCmdStrListItem(pd.aliasnames.first); + while assigned(item) do + begin + if item.str=s then + exit; + item := TCmdStrListItem(item.next); + end; + result:=false; + end; + + + procedure alloc_proc_symbol(pd: tprocdef); + var + item : TCmdStrListItem; + begin + item := TCmdStrListItem(pd.aliasnames.first); + while assigned(item) do + begin + current_asmdata.DefineAsmSymbol(item.str,AB_GLOBAL,AT_FUNCTION); + item := TCmdStrListItem(item.next); + end; + end; + + + procedure gen_proc_symbol(list:TAsmList); + var + item, + previtem : TCmdStrListItem; + begin + previtem:=nil; + item := TCmdStrListItem(current_procinfo.procdef.aliasnames.first); + while assigned(item) do + begin +{$ifdef arm} + if current_settings.cputype in cpu_thumb2 then + list.concat(tai_thumb_func.create); +{$endif arm} + { "double link" all procedure entry symbols via .reference } + { directives on darwin, because otherwise the linker } + { sometimes strips the procedure if only on of the symbols } + { is referenced } + if assigned(previtem) and + (target_info.system in systems_darwin) then + list.concat(tai_directive.create(asd_reference,item.str)); + if (cs_profile in current_settings.moduleswitches) or + (po_global in current_procinfo.procdef.procoptions) then + list.concat(Tai_symbol.createname_global(item.str,AT_FUNCTION,0)) + else + list.concat(Tai_symbol.createname(item.str,AT_FUNCTION,0)); + if assigned(previtem) and + (target_info.system in systems_darwin) then + list.concat(tai_directive.create(asd_reference,previtem.str)); + if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then + list.concat(Tai_function_name.create(item.str)); + previtem:=item; + item := TCmdStrListItem(item.next); + end; + current_procinfo.procdef.procstarttai:=tai(list.last); + end; + + + + procedure gen_proc_symbol_end(list:TAsmList); + begin + list.concat(Tai_symbol_end.Createname(current_procinfo.procdef.mangledname)); + + current_procinfo.procdef.procendtai:=tai(list.last); + + if (current_module.islibrary) then + if (current_procinfo.procdef.proctypeoption = potype_proginit) then + { setinitname may generate a new section -> don't add to the + current list, because we assume this remains a text section } + exportlib.setinitname(current_asmdata.AsmLists[al_exports],current_procinfo.procdef.mangledname); + + if (current_procinfo.procdef.proctypeoption=potype_proginit) then + begin + if (target_info.system in (systems_darwin+[system_powerpc_macos])) and + not(current_module.islibrary) then + begin + new_section(list,sec_code,'',4); + list.concat(tai_symbol.createname_global( + target_info.cprefix+mainaliasname,AT_FUNCTION,0)); + { keep argc, argv and envp properly on the stack } + cg.a_jmp_name(list,target_info.cprefix+'FPC_SYSTEMMAIN'); + end; + end; + end; + + + procedure gen_proc_entry_code(list:TAsmList); + var + hitemp, + lotemp : longint; + begin + { generate call frame marker for dwarf call frame info } + current_asmdata.asmcfi.start_frame(list); + + { All temps are know, write offsets used for information } + if (cs_asm_source in current_settings.globalswitches) then + begin + if tg.direction>0 then + begin + lotemp:=current_procinfo.tempstart; + hitemp:=tg.lasttemp; + end + else + begin + lotemp:=tg.lasttemp; + hitemp:=current_procinfo.tempstart; + end; + list.concat(Tai_comment.Create(strpnew('Temps allocated between '+std_regname(current_procinfo.framepointer)+ + tostr_with_plus(lotemp)+' and '+std_regname(current_procinfo.framepointer)+tostr_with_plus(hitemp)))); + end; + + { generate target specific proc entry code } + cg.g_proc_entry(list,current_procinfo.calc_stackframe_size,(po_nostackframe in current_procinfo.procdef.procoptions)); + end; + + + procedure gen_proc_exit_code(list:TAsmList); + var + parasize : longint; + begin + { c style clearstack does not need to remove parameters from the stack, only the + return value when it was pushed by arguments } + if current_procinfo.procdef.proccalloption in clearstack_pocalls then + begin + parasize:=0; + if paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef.proccalloption) then + inc(parasize,sizeof(pint)); + end + else + begin + parasize:=current_procinfo.para_stack_size; + { the parent frame pointer para has to be removed by the caller in + case of Delphi-style parent frame pointer passing } + if not paramanager.use_fixed_stack and + (po_delphi_nested_cc in current_procinfo.procdef.procoptions) then + dec(parasize,sizeof(pint)); + end; + + { generate target specific proc exit code } + cg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions)); + + { release return registers, needed for optimizer } + if not is_void(current_procinfo.procdef.returndef) then + paramanager.freecgpara(list,current_procinfo.procdef.funcretloc[calleeside]); + + { end of frame marker for call frame info } + current_asmdata.asmcfi.end_frame(list); + end; + + + procedure gen_stack_check_size_para(list:TAsmList); + var + paraloc1 : tcgpara; + begin + paraloc1.init; + paramanager.getintparaloc(pocall_default,1,paraloc1); + cg.a_load_const_cgpara(list,OS_INT,current_procinfo.calc_stackframe_size,paraloc1); + paramanager.freecgpara(list,paraloc1); + paraloc1.done; + end; + + + procedure gen_stack_check_call(list:TAsmList); + var + paraloc1 : tcgpara; + begin + paraloc1.init; + { Also alloc the register needed for the parameter } + paramanager.getintparaloc(pocall_default,1,paraloc1); + paramanager.freecgpara(list,paraloc1); + { Call the helper } + cg.allocallcpuregisters(list); + cg.a_call_name(list,'FPC_STACKCHECK',false); + cg.deallocallcpuregisters(list); + paraloc1.done; + end; + + + procedure gen_save_used_regs(list:TAsmList); + begin + { Pure assembler routines need to save the registers themselves } + if (po_assembler in current_procinfo.procdef.procoptions) then + exit; + + { oldfpccall expects all registers to be destroyed } + if current_procinfo.procdef.proccalloption<>pocall_oldfpccall then + cg.g_save_registers(list); + end; + + + procedure gen_restore_used_regs(list:TAsmList); + begin + { Pure assembler routines need to save the registers themselves } + if (po_assembler in current_procinfo.procdef.procoptions) then + exit; + + { oldfpccall expects all registers to be destroyed } + if current_procinfo.procdef.proccalloption<>pocall_oldfpccall then + cg.g_restore_registers(list); + end; + + +{**************************************************************************** + External handling +****************************************************************************} + + procedure gen_external_stub(list:TAsmList;pd:tprocdef;const externalname:string); + begin + create_codegen; + { add the procedure to the al_procedures } + maybe_new_object_file(list); + new_section(list,sec_code,lower(pd.mangledname),current_settings.alignment.procalign); + list.concat(Tai_align.create(current_settings.alignment.procalign)); + if (po_global in pd.procoptions) then + list.concat(Tai_symbol.createname_global(pd.mangledname,AT_FUNCTION,0)) + else + list.concat(Tai_symbol.createname(pd.mangledname,AT_FUNCTION,0)); + + cg.g_external_wrapper(list,pd,externalname); + destroy_codegen; + end; + +{**************************************************************************** + Const Data +****************************************************************************} + + procedure insertbssdata(sym : tstaticvarsym); + var + l : asizeint; + varalign : shortint; + storefilepos : tfileposinfo; + list : TAsmList; + sectype : TAsmSectiontype; + begin + storefilepos:=current_filepos; + current_filepos:=sym.fileinfo; + l:=sym.getsize; + varalign:=sym.vardef.alignment; + if (varalign=0) then + varalign:=var_align_size(l) + else + varalign:=var_align(varalign); + if tf_section_threadvars in target_info.flags then + begin + if (vo_is_thread_var in sym.varoptions) then + begin + list:=current_asmdata.asmlists[al_threadvars]; + sectype:=sec_threadvar; + end + else + begin + list:=current_asmdata.asmlists[al_globals]; + sectype:=sec_bss; + end; + end + else + begin + if (vo_is_thread_var in sym.varoptions) then + begin + inc(l,sizeof(pint)); + { it doesn't help to set a higher alignment, as } + { the first sizeof(pint) bytes field will offset } + { everything anyway } + varalign:=sizeof(pint); + end; + list:=current_asmdata.asmlists[al_globals]; + sectype:=sec_bss; + end; + maybe_new_object_file(list); + if vo_has_section in sym.varoptions then + new_section(list,sec_user,sym.section,varalign) + else + new_section(list,sectype,lower(sym.mangledname),varalign); + if (sym.owner.symtabletype=globalsymtable) or + create_smartlink or + DLLSource or + (assigned(current_procinfo) and + (po_inline in current_procinfo.procdef.procoptions)) or + (vo_is_public in sym.varoptions) then + list.concat(Tai_datablock.create_global(sym.mangledname,l)) + else + list.concat(Tai_datablock.create(sym.mangledname,l)); + current_filepos:=storefilepos; + end; + + + procedure gen_alloc_symtable(list:TAsmList;st:TSymtable); + + procedure setlocalloc(vs:tabstractnormalvarsym); + begin + if cs_asm_source in current_settings.globalswitches then + begin + case vs.initialloc.loc of + LOC_REFERENCE : + begin + if not assigned(vs.initialloc.reference.symbol) then + list.concat(Tai_comment.Create(strpnew('Var '+vs.realname+' located at '+ + std_regname(vs.initialloc.reference.base)+tostr_with_plus(vs.initialloc.reference.offset)))); + end; + end; + end; + vs.localloc:=vs.initialloc; + end; + + var + i : longint; + sym : tsym; + vs : tabstractnormalvarsym; + isaddr : boolean; + begin + for i:=0 to st.SymList.Count-1 do + begin + sym:=tsym(st.SymList[i]); + case sym.typ of + staticvarsym : + begin + vs:=tabstractnormalvarsym(sym); + { The code in loadnode.pass_generatecode will create the + LOC_REFERENCE instead for all none register variables. This is + required because we can't store an asmsymbol in the localloc because + the asmsymbol is invalid after an unit is compiled. This gives + problems when this procedure is inlined in another unit (PFV) } + if vs.is_regvar(false) then + begin + vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable]; + vs.initialloc.size:=def_cgsize(vs.vardef); + gen_alloc_regvar(list,vs,true); + setlocalloc(vs); + end; + end; + paravarsym : + begin + vs:=tabstractnormalvarsym(sym); + { Parameters passed to assembler procedures need to be kept + in the original location } + if (po_assembler in current_procinfo.procdef.procoptions) then + tparavarsym(vs).paraloc[calleeside].get_location(vs.initialloc) + { exception filters receive their frame pointer as a parameter } + else if (current_procinfo.procdef.proctypeoption=potype_exceptfilter) and + (vo_is_parentfp in vs.varoptions) then + begin + location_reset(vs.initialloc,LOC_REGISTER,OS_ADDR); + vs.initialloc.register:=NR_FRAME_POINTER_REG; + end + else + begin + isaddr:=paramanager.push_addr_param(vs.varspez,vs.vardef,current_procinfo.procdef.proccalloption); + if isaddr then + vs.initialloc.size:=OS_ADDR + else + vs.initialloc.size:=def_cgsize(vs.vardef); + + if vs.is_regvar(isaddr) then + vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable] + else + begin + vs.initialloc.loc:=LOC_REFERENCE; + { Reuse the parameter location for values to are at a single location on the stack } + if paramanager.param_use_paraloc(tparavarsym(sym).paraloc[calleeside]) then + begin + reference_reset_base(vs.initialloc.reference,tparavarsym(sym).paraloc[calleeside].location^.reference.index, + tparavarsym(sym).paraloc[calleeside].location^.reference.offset,tparavarsym(sym).paraloc[calleeside].alignment); + end + else + begin + if isaddr then + tg.GetLocal(list,sizeof(pint),voidpointertype,vs.initialloc.reference) + else + tg.GetLocal(list,vs.getsize,tparavarsym(sym).paraloc[calleeside].alignment,vs.vardef,vs.initialloc.reference); + end; + end; + end; + setlocalloc(vs); + end; + localvarsym : + begin + vs:=tabstractnormalvarsym(sym); + vs.initialloc.size:=def_cgsize(vs.vardef); + if (m_delphi in current_settings.modeswitches) and + (po_assembler in current_procinfo.procdef.procoptions) and + (vo_is_funcret in vs.varoptions) and + (vs.refs=0) then + begin + { not referenced, so don't allocate. Use dummy to } + { avoid ie's later on because of LOC_INVALID } + vs.initialloc.loc:=LOC_REGISTER; + vs.initialloc.size:=OS_INT; + vs.initialloc.register:=NR_FUNCTION_RESULT_REG; + end + else if vs.is_regvar(false) then + begin + vs.initialloc.loc:=tvarregable2tcgloc[vs.varregable]; + gen_alloc_regvar(list,vs,true); + end + else + begin + vs.initialloc.loc:=LOC_REFERENCE; + tg.GetLocal(list,vs.getsize,vs.vardef,vs.initialloc.reference); + end; + setlocalloc(vs); + end; + end; + end; + end; + + + procedure add_regvars(var rv: tusedregvars; const location: tlocation); + begin + case location.loc of + LOC_CREGISTER: +{$ifndef cpu64bitalu} + if location.size in [OS_64,OS_S64] then + begin + rv.intregvars.addnodup(getsupreg(location.register64.reglo)); + rv.intregvars.addnodup(getsupreg(location.register64.reghi)); + end + else +{$endif not cpu64bitalu} + rv.intregvars.addnodup(getsupreg(location.register)); + LOC_CFPUREGISTER: + rv.fpuregvars.addnodup(getsupreg(location.register)); + LOC_CMMREGISTER: + rv.mmregvars.addnodup(getsupreg(location.register)); + end; + end; + + + function do_get_used_regvars(var n: tnode; arg: pointer): foreachnoderesult; + var + rv: pusedregvars absolute arg; + begin + case (n.nodetype) of + temprefn: + { We only have to synchronise a tempnode before a loop if it is } + { not created inside the loop, and only synchronise after the } + { loop if it's not destroyed inside the loop. If it's created } + { before the loop and not yet destroyed, then before the loop } + { is secondpassed tempinfo^.valid will be true, and we get the } + { correct registers. If it's not destroyed inside the loop, } + { then after the loop has been secondpassed tempinfo^.valid } + { be true and we also get the right registers. In other cases, } + { tempinfo^.valid will be false and so we do not add } + { unnecessary registers. This way, we don't have to look at } + { tempcreate and tempdestroy nodes to get this info (JM) } + if (ti_valid in ttemprefnode(n).tempinfo^.flags) then + add_regvars(rv^,ttemprefnode(n).tempinfo^.location); + loadn: + if (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then + add_regvars(rv^,tabstractnormalvarsym(tloadnode(n).symtableentry).localloc); + vecn: + { range checks sometimes need the high parameter } + if (cs_check_range in current_settings.localswitches) and + (is_open_array(tvecnode(n).left.resultdef) or + is_array_of_const(tvecnode(n).left.resultdef)) and + not(current_procinfo.procdef.proccalloption in cdecl_pocalls) then + add_regvars(rv^,tabstractnormalvarsym(get_high_value_sym(tparavarsym(tloadnode(tvecnode(n).left).symtableentry))).localloc) + + end; + result := fen_true; + end; + + + procedure get_used_regvars(n: tnode; var rv: tusedregvars); + begin + foreachnodestatic(n,@do_get_used_regvars,@rv); + end; + +(* + See comments at declaration of pusedregvarscommon + + function do_get_used_regvars_common(var n: tnode; arg: pointer): foreachnoderesult; + var + rv: pusedregvarscommon absolute arg; + begin + if (n.nodetype = loadn) and + (tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) then + with tabstractnormalvarsym(tloadnode(n).symtableentry).localloc do + case loc of + LOC_CREGISTER: + { if not yet encountered in this node tree } + if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and + { but nevertheless already encountered somewhere } + not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then + { then it's a regvar used in two or more node trees } + rv^.commonregvars.intregvars.addnodup(getsupreg(register)); + LOC_CFPUREGISTER: + if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and + not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then + rv^.commonregvars.intregvars.addnodup(getsupreg(register)); + LOC_CMMREGISTER: + if (rv^.myregvars.intregvars.addnodup(getsupreg(register))) and + not(rv^.allregvars.intregvars.addnodup(getsupreg(register))) then + rv^.commonregvars.intregvars.addnodup(getsupreg(register)); + end; + result := fen_true; + end; + + + procedure get_used_regvars_common(n: tnode; var rv: tusedregvarscommon); + begin + rv.myregvars.intregvars.clear; + rv.myregvars.fpuregvars.clear; + rv.myregvars.mmregvars.clear; + foreachnodestatic(n,@do_get_used_regvars_common,@rv); + end; +*) + + procedure gen_sync_regvars(list:TAsmList; var rv: tusedregvars); + var + count: longint; + begin + for count := 1 to rv.intregvars.length do + cg.a_reg_sync(list,newreg(R_INTREGISTER,rv.intregvars.readidx(count-1),R_SUBWHOLE)); + for count := 1 to rv.fpuregvars.length do + cg.a_reg_sync(list,newreg(R_FPUREGISTER,rv.fpuregvars.readidx(count-1),R_SUBWHOLE)); + for count := 1 to rv.mmregvars.length do + cg.a_reg_sync(list,newreg(R_MMREGISTER,rv.mmregvars.readidx(count-1),R_SUBWHOLE)); + end; + + +{***************************************************************************** + SSA support +*****************************************************************************} + + type + preplaceregrec = ^treplaceregrec; + treplaceregrec = record + old, new: tregister; +{$ifndef cpu64bitalu} + oldhi, newhi: tregister; +{$endif not cpu64bitalu} + ressym: tsym; + { moved sym } + sym : tsym; + end; + + + function doreplace(var n: tnode; para: pointer): foreachnoderesult; + var + rr: preplaceregrec absolute para; + begin + result := fen_false; + if (nf_is_funcret in n.flags) and (fc_exit in flowcontrol) then + exit; + case n.nodetype of + loadn: + begin + if (tabstractvarsym(tloadnode(n).symtableentry).varoptions * [vo_is_dll_var, vo_is_thread_var] = []) and + not assigned(tloadnode(n).left) and + ((tloadnode(n).symtableentry <> rr^.ressym) or + not(fc_exit in flowcontrol) + ) and + (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and + (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register = rr^.old) then + begin +{$ifndef cpu64bitalu} + { it's possible a 64 bit location was shifted and/xor typecasted } + { in a 32 bit value, so only 1 register was left in the location } + if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.size in [OS_64,OS_S64]) then + if (tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register64.reghi = rr^.oldhi) then + tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register64.reghi := rr^.newhi + else + exit; +{$endif not cpu64bitalu} + tabstractnormalvarsym(tloadnode(n).symtableentry).localloc.register := rr^.new; + rr^.sym := tabstractnormalvarsym(tloadnode(n).symtableentry); + result := fen_norecurse_true; + end; + end; + temprefn: + begin + if (ti_valid in ttemprefnode(n).tempinfo^.flags) and + (ttemprefnode(n).tempinfo^.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) and + (ttemprefnode(n).tempinfo^.location.register = rr^.old) then + begin +{$ifndef cpu64bitalu} + { it's possible a 64 bit location was shifted and/xor typecasted } + { in a 32 bit value, so only 1 register was left in the location } + if (ttemprefnode(n).tempinfo^.location.size in [OS_64,OS_S64]) then + if (ttemprefnode(n).tempinfo^.location.register64.reghi = rr^.oldhi) then + ttemprefnode(n).tempinfo^.location.register64.reghi := rr^.newhi + else + exit; +{$endif not cpu64bitalu} + ttemprefnode(n).tempinfo^.location.register := rr^.new; + result := fen_norecurse_true; + end; + end; + { optimize the searching a bit } + derefn,addrn, + calln,inlinen,casen, + addn,subn,muln, + andn,orn,xorn, + ltn,lten,gtn,gten,equaln,unequaln, + slashn,divn,shrn,shln,notn, + inn, + asn,isn: + result := fen_norecurse_false; + end; + end; + + + procedure maybechangeloadnodereg(list: TAsmList; var n: tnode; reload: boolean); + var + rr: treplaceregrec; + begin + if not (n.location.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMXREGISTER,LOC_CMMREGISTER]) or + ([fc_inflowcontrol,fc_gotolabel,fc_lefthandled] * flowcontrol <> []) then + exit; + rr.old := n.location.register; + rr.ressym := nil; + rr.sym := nil; + {$ifndef cpu64bitalu} + rr.oldhi := NR_NO; + {$endif not cpu64bitalu} + case n.location.loc of + LOC_CREGISTER: + begin + {$ifndef cpu64bitalu} + if (n.location.size in [OS_64,OS_S64]) then + begin + rr.oldhi := n.location.register64.reghi; + rr.new := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + rr.newhi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + end + else + {$endif not cpu64bitalu} + rr.new := cg.getintregister(current_asmdata.CurrAsmList,n.location.size); + end; + LOC_CFPUREGISTER: + rr.new := cg.getfpuregister(current_asmdata.CurrAsmList,n.location.size); + {$ifdef SUPPORT_MMX} + LOC_CMMXREGISTER: + rr.new := tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList); + {$endif SUPPORT_MMX} + LOC_CMMREGISTER: + rr.new := cg.getmmregister(current_asmdata.CurrAsmList,n.location.size); + else + exit; + end; + + if not is_void(current_procinfo.procdef.returndef) and + assigned(current_procinfo.procdef.funcretsym) and + (tabstractvarsym(current_procinfo.procdef.funcretsym).refs <> 0) then + if (current_procinfo.procdef.proctypeoption=potype_constructor) then + rr.ressym:=tsym(current_procinfo.procdef.parast.Find('self')) + else + rr.ressym:=current_procinfo.procdef.funcretsym; + + if not foreachnodestatic(n,@doreplace,@rr) then + exit; + + if reload then + case n.location.loc of + LOC_CREGISTER: + begin + {$ifndef cpu64bitalu} + if (n.location.size in [OS_64,OS_S64]) then + cg64.a_load64_reg_reg(list,n.location.register64,joinreg64(rr.new,rr.newhi)) + else + {$endif not cpu64bitalu} + cg.a_load_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new); + end; + LOC_CFPUREGISTER: + cg.a_loadfpu_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new); + {$ifdef SUPPORT_MMX} + LOC_CMMXREGISTER: + cg.a_loadmm_reg_reg(list,OS_M64,OS_M64,n.location.register,rr.new,nil); + {$endif SUPPORT_MMX} + LOC_CMMREGISTER: + cg.a_loadmm_reg_reg(list,n.location.size,n.location.size,n.location.register,rr.new,nil); + else + internalerror(2006090920); + end; + + { now that we've change the loadn/temp, also change the node result location } + {$ifndef cpu64bitalu} + if (n.location.size in [OS_64,OS_S64]) then + begin + n.location.register64.reglo := rr.new; + n.location.register64.reghi := rr.newhi; + if assigned(rr.sym) then + list.concat(tai_varloc.create64(rr.sym,rr.new,rr.newhi)); + end + else + {$endif not cpu64bitalu} + begin + n.location.register := rr.new; + if assigned(rr.sym) then + list.concat(tai_varloc.create(rr.sym,rr.new)); + end; + end; + + + procedure gen_free_symtable(list:TAsmList;st:TSymtable); + var + i : longint; + sym : tsym; + begin + for i:=0 to st.SymList.Count-1 do + begin + sym:=tsym(st.SymList[i]); + if (sym.typ in [staticvarsym,localvarsym,paravarsym]) then + begin + with tabstractnormalvarsym(sym) do + begin + { Note: We need to keep the data available in memory + for the sub procedures that can access local data + in the parent procedures } + case localloc.loc of + LOC_CREGISTER : + if (pi_has_label in current_procinfo.flags) then +{$ifndef cpu64bitalu} + if def_cgsize(vardef) in [OS_64,OS_S64] then + begin + cg.a_reg_sync(list,localloc.register64.reglo); + cg.a_reg_sync(list,localloc.register64.reghi); + end + else +{$endif not cpu64bitalu} + cg.a_reg_sync(list,localloc.register); + LOC_CFPUREGISTER, + LOC_CMMREGISTER: + if (pi_has_label in current_procinfo.flags) then + cg.a_reg_sync(list,localloc.register); + LOC_REFERENCE : + begin + if typ in [localvarsym,paravarsym] then + tg.Ungetlocal(list,localloc.reference); + end; + end; + end; + end; + end; + end; + + + procedure gen_intf_wrapper(list:TAsmList;_class:tobjectdef); + var + i,j : longint; + tmps : string; + pd : TProcdef; + ImplIntf : TImplementedInterface; + begin + for i:=0 to _class.ImplementedInterfaces.count-1 do + begin + ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]); + if (ImplIntf=ImplIntf.VtblImplIntf) and + assigned(ImplIntf.ProcDefs) then + begin + maybe_new_object_file(list); + for j:=0 to ImplIntf.ProcDefs.Count-1 do + begin + pd:=TProcdef(ImplIntf.ProcDefs[j]); + tmps:=make_mangledname('WRPR',_class.owner,_class.objname^+'_$_'+ + ImplIntf.IntfDef.objname^+'_$_'+tostr(j)+'_$_'+pd.mangledname); + { create wrapper code } + new_section(list,sec_code,tmps,0); + cg.init_register_allocators; + cg.g_intf_wrapper(list,pd,tmps,ImplIntf.ioffset); + cg.done_register_allocators; + end; + end; + end; + end; + + + procedure gen_intf_wrappers(list:TAsmList;st:TSymtable;nested:boolean); + var + i : longint; + def : tdef; + begin + if not nested then + create_codegen; + for i:=0 to st.DefList.Count-1 do + begin + def:=tdef(st.DefList[i]); + { if def can contain nested types then handle it symtable } + if def.typ in [objectdef,recorddef] then + gen_intf_wrappers(list,tabstractrecorddef(def).symtable,true); + if is_class(def) then + gen_intf_wrapper(list,tobjectdef(def)); + end; + if not nested then + destroy_codegen; + end; + + + procedure gen_load_vmt_register(list:TAsmList;objdef:tobjectdef;selfloc:tlocation;var vmtreg:tregister); + var + href : treference; + begin + if is_object(objdef) then + begin + case selfloc.loc of + LOC_CREFERENCE, + LOC_REFERENCE: + begin + reference_reset_base(href,cg.getaddressregister(list),objdef.vmt_offset,sizeof(pint)); + cg.a_loadaddr_ref_reg(list,selfloc.reference,href.base); + end; + else + internalerror(200305056); + end; + end + else + { This is also valid for Objective-C classes: vmt_offset is 0 there, + and the first "field" of an Objective-C class instance is a pointer + to its "meta-class". } + begin + case selfloc.loc of + LOC_REGISTER: + begin +{$ifdef cpu_uses_separate_address_registers} + if getregtype(left.location.register)<>R_ADDRESSREGISTER then + begin + reference_reset_base(href,cg.getaddressregister(list),objdef.vmt_offset,sizeof(pint)); + cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,selfloc.register,href.base); + end + else +{$endif cpu_uses_separate_address_registers} + reference_reset_base(href,selfloc.register,objdef.vmt_offset,sizeof(pint)); + end; + LOC_CREGISTER, + LOC_CREFERENCE, + LOC_REFERENCE: + begin + reference_reset_base(href,cg.getaddressregister(list),objdef.vmt_offset,sizeof(pint)); + cg.a_load_loc_reg(list,OS_ADDR,selfloc,href.base); + end; + else + internalerror(200305057); + end; + end; + vmtreg:=cg.getaddressregister(list); + cg.g_maybe_testself(list,href.base); + cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,vmtreg); + + { test validity of VMT } + if not(is_interface(objdef)) and + not(is_cppclass(objdef)) and + not(is_objc_class_or_protocol(objdef)) then + cg.g_maybe_testvmt(list,vmtreg,objdef); + end; + + + function getprocalign : shortint; + begin + { gprof uses 16 byte granularity } + if (cs_profile in current_settings.moduleswitches) then + result:=16 + else + result:=current_settings.alignment.procalign; + end; + + + procedure gen_fpc_dummy(list : TAsmList); + begin +{$ifdef i386} + { fix me! } + list.concat(Taicpu.Op_const_reg(A_MOV,S_L,1,NR_EAX)); + list.concat(Taicpu.Op_const(A_RET,S_W,12)); +{$endif i386} + end; + + + procedure InsertInterruptTable; + + procedure WriteVector(const name: string); +{$IFDEF arm} + var + ai: taicpu; +{$ENDIF arm} + begin +{$IFDEF arm} + if current_settings.cputype in [cpu_armv7m] then + current_asmdata.asmlists[al_globals].concat(tai_const.Createname(name,0)) + else + begin + ai:=taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(name)); + ai.is_jmp:=true; + current_asmdata.asmlists[al_globals].concat(ai); + end; +{$ENDIF arm} + end; + + function GetInterruptTableLength: longint; + begin +{$if defined(ARM)} + result:=embedded_controllers[current_settings.controllertype].interruptvectors; +{$else} + result:=0; +{$endif} + end; + + var + hp: tused_unit; + sym: tsym; + i, i2: longint; + interruptTable: array of tprocdef; + pd: tprocdef; + begin + SetLength(interruptTable, GetInterruptTableLength); + FillChar(interruptTable[0], length(interruptTable)*sizeof(pointer), 0); + + hp:=tused_unit(usedunits.first); + while assigned(hp) do + begin + for i := 0 to hp.u.symlist.Count-1 do + begin + sym:=tsym(hp.u.symlist[i]); + if not assigned(sym) then + continue; + if sym.typ = procsym then + begin + for i2 := 0 to tprocsym(sym).ProcdefList.Count-1 do + begin + pd:=tprocdef(tprocsym(sym).ProcdefList[i2]); + if pd.interruptvector >= 0 then + begin + if pd.interruptvector > high(interruptTable) then + Internalerror(2011030602); + if interruptTable[pd.interruptvector] <> nil then + internalerror(2011030601); + + interruptTable[pd.interruptvector]:=pd; + break; + end; + end; + end; + end; + hp:=tused_unit(hp.next); + end; + + new_section(current_asmdata.asmlists[al_globals],sec_init,'VECTORS',sizeof(pint)); + current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('VECTORS',AT_DATA,0)); +{$IFDEF arm} + if current_settings.cputype in [cpu_armv7m] then + current_asmdata.asmlists[al_globals].concat(tai_const.Createname('_stack_top',0)); { ARMv7-M processors have the initial stack value at address 0 } +{$ENDIF arm} + + for i:=0 to high(interruptTable) do + begin + if interruptTable[i]<>nil then + writeVector(interruptTable[i].mangledname) + else + writeVector('DefaultHandler'); { Default handler name } + end; + end; + + +end. diff --git a/closures/compiler/ncnv.pas b/closures/compiler/ncnv.pas new file mode 100644 index 0000000000..dd989610b4 --- /dev/null +++ b/closures/compiler/ncnv.pas @@ -0,0 +1,3703 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + Type checking and register allocation 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 ncnv; + +{$i fpcdefs.inc} + +interface + + uses + node, + symtype, + defutil,defcmp, + nld + ; + + type + ttypeconvnode = class(tunarynode) + totypedef : tdef; + totypedefderef : tderef; + convtype : tconverttype; + warn_pointer_to_signed: boolean; + constructor create(node : tnode;def:tdef);virtual; + constructor create_explicit(node : tnode;def:tdef); + constructor create_internal(node : tnode;def:tdef); + constructor create_proc_to_procvar(node : tnode); + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + function dogetcopy : tnode;override; + function actualtargetnode: tnode;override; + procedure printnodeinfo(var t : text);override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function simplify(forinline : boolean):tnode; override; + procedure mark_write;override; + function docompare(p: tnode) : boolean; override; + function retains_value_location:boolean; + function assign_allowed:boolean; + procedure second_call_helper(c : tconverttype); + private + function typecheck_int_to_int : tnode; + function typecheck_cord_to_pointer : tnode; + function typecheck_chararray_to_string : tnode; + function typecheck_string_to_chararray : tnode; + function typecheck_string_to_string : tnode; + function typecheck_char_to_string : tnode; + function typecheck_char_to_chararray : tnode; + function typecheck_int_to_real : tnode; + function typecheck_real_to_real : tnode; + function typecheck_real_to_currency : tnode; + function typecheck_cchar_to_pchar : tnode; + function typecheck_cstring_to_pchar : tnode; + function typecheck_cstring_to_int : tnode; + function typecheck_char_to_char : tnode; + function typecheck_arrayconstructor_to_set : tnode; + function typecheck_set_to_set : tnode; + function typecheck_pchar_to_string : tnode; + function typecheck_interface_to_string : tnode; + function typecheck_interface_to_guid : tnode; + function typecheck_dynarray_to_openarray : tnode; + function typecheck_pwchar_to_string : tnode; + function typecheck_variant_to_dynarray : tnode; + function typecheck_dynarray_to_variant : tnode; + function typecheck_call_helper(c : tconverttype) : tnode; + function typecheck_variant_to_enum : tnode; + function typecheck_enum_to_variant : tnode; + function typecheck_proc_to_procvar : tnode; + function typecheck_variant_to_interface : tnode; + function typecheck_interface_to_variant : tnode; + function typecheck_array_2_dynarray : tnode; + protected + function first_int_to_int : tnode;virtual; + function first_cstring_to_pchar : tnode;virtual; + function first_cstring_to_int : tnode;virtual; + function first_string_to_chararray : tnode;virtual; + function first_char_to_string : tnode;virtual; + function first_nothing : tnode;virtual; + function first_array_to_pointer : tnode;virtual; + function first_int_to_real : tnode;virtual; + function first_real_to_real : tnode;virtual; + function first_pointer_to_array : tnode;virtual; + function first_cchar_to_pchar : tnode;virtual; + function first_bool_to_int : tnode;virtual; + function first_int_to_bool : tnode;virtual; + function first_bool_to_bool : tnode;virtual; + function first_proc_to_procvar : tnode;virtual; + function first_nil_to_methodprocvar : tnode;virtual; + function first_set_to_set : tnode;virtual; + function first_cord_to_pointer : tnode;virtual; + function first_ansistring_to_pchar : tnode;virtual; + function first_arrayconstructor_to_set : tnode;virtual; + function first_class_to_intf : tnode;virtual; + function first_char_to_char : tnode;virtual; + function first_string_to_string : tnode;virtual; + function first_call_helper(c : tconverttype) : tnode; + + { these wrapper are necessary, because the first_* stuff is called } + { through a table. Without the wrappers override wouldn't have } + { any effect } + function _first_int_to_int : tnode; + function _first_cstring_to_pchar : tnode; + function _first_cstring_to_int : tnode; + function _first_string_to_chararray : tnode; + function _first_char_to_string : tnode; + function _first_nothing : tnode; + function _first_array_to_pointer : tnode; + function _first_int_to_real : tnode; + function _first_real_to_real: tnode; + function _first_pointer_to_array : tnode; + function _first_cchar_to_pchar : tnode; + function _first_bool_to_int : tnode; + function _first_int_to_bool : tnode; + function _first_bool_to_bool : tnode; + function _first_proc_to_procvar : tnode; + function _first_nil_to_methodprocvar : tnode; + function _first_cord_to_pointer : tnode; + function _first_ansistring_to_pchar : tnode; + function _first_arrayconstructor_to_set : tnode; + function _first_class_to_intf : tnode; + function _first_char_to_char : tnode; + function _first_set_to_set : tnode; + function _first_string_to_string : tnode; + + procedure _second_int_to_int;virtual; + procedure _second_string_to_string;virtual; + procedure _second_cstring_to_pchar;virtual; + procedure _second_cstring_to_int;virtual; + procedure _second_string_to_chararray;virtual; + procedure _second_array_to_pointer;virtual; + procedure _second_pointer_to_array;virtual; + procedure _second_chararray_to_string;virtual; + procedure _second_char_to_string;virtual; + procedure _second_int_to_real;virtual; + procedure _second_real_to_real;virtual; + procedure _second_cord_to_pointer;virtual; + procedure _second_proc_to_procvar;virtual; + procedure _second_nil_to_methodprocvar;virtual; + procedure _second_bool_to_int;virtual; + procedure _second_int_to_bool;virtual; + procedure _second_bool_to_bool;virtual; + procedure _second_set_to_set;virtual; + procedure _second_ansistring_to_pchar;virtual; + procedure _second_class_to_intf;virtual; + procedure _second_char_to_char;virtual; + procedure _second_nothing; virtual; + + procedure second_int_to_int;virtual;abstract; + procedure second_string_to_string;virtual;abstract; + procedure second_cstring_to_pchar;virtual;abstract; + procedure second_cstring_to_int;virtual;abstract; + procedure second_string_to_chararray;virtual;abstract; + procedure second_array_to_pointer;virtual;abstract; + procedure second_pointer_to_array;virtual;abstract; + procedure second_chararray_to_string;virtual;abstract; + procedure second_char_to_string;virtual;abstract; + procedure second_int_to_real;virtual;abstract; + procedure second_real_to_real;virtual;abstract; + procedure second_cord_to_pointer;virtual;abstract; + procedure second_proc_to_procvar;virtual;abstract; + procedure second_nil_to_methodprocvar;virtual;abstract; + procedure second_bool_to_int;virtual;abstract; + procedure second_int_to_bool;virtual;abstract; + procedure second_bool_to_bool;virtual;abstract; + procedure second_set_to_set;virtual;abstract; + procedure second_ansistring_to_pchar;virtual;abstract; + procedure second_class_to_intf;virtual;abstract; + procedure second_char_to_char;virtual;abstract; + procedure second_nothing; virtual;abstract; + end; + ttypeconvnodeclass = class of ttypeconvnode; + + { common functionality of as-nodes and is-nodes } + tasisnode = class(tbinarynode) + public + function pass_typecheck:tnode;override; + end; + + tasnode = class(tasisnode) + { as nodes cannot be translated directly into call nodes bcause: + + When using -CR, explicit class typecasts are replaced with as-nodes to perform + class type checking. The problem is that if a typecasted class instance is + passed as a var-parameter, then you cannot replace it with a function call. So the as-node + a) call the as helper to perform the type checking + b) still pass the original instance as parameter to var-parameters + (and in general: to return it as the result of the as-node) + + so the call field is required + } + call: tnode; + constructor create(l,r : tnode);virtual; + function pass_1 : tnode;override; + function dogetcopy: tnode;override; + function docompare(p: tnode): boolean; override; + destructor destroy; override; + end; + tasnodeclass = class of tasnode; + + tisnode = class(tasisnode) + constructor create(l,r : tnode);virtual; + function pass_1 : tnode;override; + procedure pass_generate_code;override; + end; + tisnodeclass = class of tisnode; + + var + ctypeconvnode : ttypeconvnodeclass = ttypeconvnode; + casnode : tasnodeclass = tasnode; + cisnode : tisnodeclass=tisnode; + + procedure inserttypeconv(var p:tnode;def:tdef); + procedure inserttypeconv_explicit(var p:tnode;def:tdef); + procedure inserttypeconv_internal(var p:tnode;def:tdef); + procedure arrayconstructor_to_set(var p : tnode); + procedure insert_varargstypeconv(var p : tnode; iscvarargs: boolean); + + function maybe_global_proc_to_nested(var fromnode: tnode; todef: tdef): boolean; + + +implementation + + uses + globtype,systems,constexp, + cutils,verbose,globals,widestr, + symconst,symdef,symsym,symbase,symtable, + ncon,ncal,nset,nadd,ninl,nmem,nmat,nbas,nutils, + cgbase,procinfo, + htypechk,pass_1,cpuinfo; + + +{***************************************************************************** + Helpers +*****************************************************************************} + type + ttypeconvnodetype = (tct_implicit,tct_explicit,tct_internal); + + procedure do_inserttypeconv(var p: tnode;def: tdef; convtype: ttypeconvnodetype); + + begin + if not assigned(p.resultdef) then + begin + typecheckpass(p); + if codegenerror then + exit; + end; + + { don't insert superfluous type conversions, but + in case of bitpacked accesses, the original type must + remain too so that not too many/few bits are laoded } + if equal_defs(p.resultdef,def) and + not is_bitpacked_access(p) then + begin + { don't replace encoded string constants to rawbytestring encoding. + preserve the codepage } + if not (is_rawbytestring(def) and (p.nodetype=stringconstn)) then + p.resultdef:=def + end + else + begin + case convtype of + tct_implicit: + p:=ctypeconvnode.create(p,def); + tct_explicit: + p:=ctypeconvnode.create_explicit(p,def); + tct_internal: + p:=ctypeconvnode.create_internal(p,def); + end; + p.fileinfo:=ttypeconvnode(p).left.fileinfo; + typecheckpass(p); + end; + end; + + + procedure inserttypeconv(var p:tnode;def:tdef); + + begin + do_inserttypeconv(p,def,tct_implicit); + end; + + + procedure inserttypeconv_explicit(var p: tnode; def: tdef); + + begin + do_inserttypeconv(p,def,tct_explicit); + end; + + procedure inserttypeconv_internal(var p:tnode;def:tdef); + + begin + do_inserttypeconv(p,def,tct_internal); + end; + + +{***************************************************************************** + Array constructor to Set Conversion +*****************************************************************************} + + procedure arrayconstructor_to_set(var p : tnode); + + var + constp : tsetconstnode; + buildp, + p2,p3,p4 : tnode; + hdef : tdef; + constset : Pconstset; + constsetlo, + constsethi : TConstExprInt; + + procedure update_constsethi(def:tdef; maybetruncenumrange: boolean); + begin + if (def.typ=orddef) and + ((torddef(def).high>=constsethi) or + (torddef(def).low <=constsetlo)) then + begin + if torddef(def).ordtype=uwidechar then + begin + constsethi:=255; + constsetlo:=0; + if hdef=nil then + hdef:=def; + end + else + begin + if (torddef(def).high>=constsethi) then + constsethi:=torddef(def).high; + if (torddef(def).low<=constsetlo) then + constsetlo:=torddef(def).low; + if hdef=nil then + begin + if (constsethi>255) or + (torddef(def).low<0) then + hdef:=u8inttype + else + hdef:=def; + end; + if constsethi>255 then + constsethi:=255; + if constsetlo<0 then + constsetlo:=0; + end; + end + else if (def.typ=enumdef) and + ((tenumdef(def).max>=constsethi) or + (tenumdef(def).min<=constsetlo)) then + begin + if hdef=nil then + hdef:=def; + if (tenumdef(def).max>=constsethi) then + constsethi:=tenumdef(def).max; + if (tenumdef(def).min<=constsetlo) then + constsetlo:=tenumdef(def).min; + { for constant set elements, delphi allows the usage of elements of enumerations which + have value>255 if there is no element with a value > 255 used } + if (maybetruncenumrange) then + begin + if constsethi>255 then + constsethi:=255; + if constsetlo<0 then + constsetlo:=0; + end; + end; + end; + + procedure do_set(pos : longint); + begin + if (pos and not $ff)<>0 then + Message(parser_e_illegal_set_expr); + if pos>constsethi then + constsethi:=pos; + if pos<constsetlo then + constsetlo:=pos; + if pos in constset^ then + Message(parser_e_illegal_set_expr); + include(constset^,pos); + end; + + var + l : Longint; + lr,hr : TConstExprInt; + hp : tarrayconstructornode; + oldfilepos: tfileposinfo; + begin + if p.nodetype<>arrayconstructorn then + internalerror(200205105); + new(constset); + constset^:=[]; + hdef:=nil; + { make sure to set constsetlo correctly for empty sets } + if assigned(tarrayconstructornode(p).left) then + constsetlo:=high(aint) + else + constsetlo:=0; + constsethi:=0; + constp:=csetconstnode.create(nil,hdef); + constp.value_set:=constset; + buildp:=constp; + hp:=tarrayconstructornode(p); + if assigned(hp.left) then + begin + while assigned(hp) do + begin + p4:=nil; { will contain the tree to create the set } + {split a range into p2 and p3 } + if hp.left.nodetype=arrayconstructorrangen then + begin + p2:=tarrayconstructorrangenode(hp.left).left; + p3:=tarrayconstructorrangenode(hp.left).right; + tarrayconstructorrangenode(hp.left).left:=nil; + tarrayconstructorrangenode(hp.left).right:=nil; + end + else + begin + p2:=hp.left; + hp.left:=nil; + p3:=nil; + end; + typecheckpass(p2); + set_varstate(p2,vs_read,[vsf_must_be_valid]); + if assigned(p3) then + begin + typecheckpass(p3); + set_varstate(p3,vs_read,[vsf_must_be_valid]); + end; + if codegenerror then + break; + oldfilepos:=current_filepos; + current_filepos:=p2.fileinfo; + case p2.resultdef.typ of + enumdef, + orddef: + begin + { widechars are not yet supported } + if is_widechar(p2.resultdef) then + begin + inserttypeconv(p2,cchartype); + if (p2.nodetype<>ordconstn) then + incompatibletypes(cwidechartype,cchartype); + end; + + getrange(p2.resultdef,lr,hr); + if assigned(p3) then + begin + if is_widechar(p3.resultdef) then + begin + inserttypeconv(p3,cchartype); + if (p3.nodetype<>ordconstn) then + begin + current_filepos:=p3.fileinfo; + incompatibletypes(cwidechartype,cchartype); + end; + end; + { this isn't good, you'll get problems with + type t010 = 0..10; + ts = set of t010; + var s : ts;b : t010 + begin s:=[1,2,b]; end. + if is_integer(p3^.resultdef) then + begin + inserttypeconv(p3,u8bitdef); + end; + } + if assigned(hdef) and not(equal_defs(hdef,p3.resultdef)) then + begin + CGMessagePos(p3.fileinfo,type_e_typeconflict_in_set); + end + else + begin + if (p2.nodetype=ordconstn) and (p3.nodetype=ordconstn) then + begin + if not(is_integer(p3.resultdef)) then + hdef:=p3.resultdef + else + begin + inserttypeconv(p3,u8inttype); + inserttypeconv(p2,u8inttype); + end; + + for l:=tordconstnode(p2).value.svalue to tordconstnode(p3).value.svalue do + do_set(l); + p2.free; + p3.free; + end + else + begin + update_constsethi(p2.resultdef,false); + inserttypeconv(p2,hdef); + + update_constsethi(p3.resultdef,false); + inserttypeconv(p3,hdef); + + if assigned(hdef) then + inserttypeconv(p3,hdef) + else + inserttypeconv(p3,u8inttype); + p4:=csetelementnode.create(p2,p3); + end; + end; + end + else + begin + { Single value } + if p2.nodetype=ordconstn then + begin + if not(is_integer(p2.resultdef)) then + update_constsethi(p2.resultdef,true); + + if assigned(hdef) then + inserttypeconv(p2,hdef) + else + inserttypeconv(p2,u8inttype); + + do_set(tordconstnode(p2).value.svalue); + p2.free; + end + else + begin + update_constsethi(p2.resultdef,false); + + if assigned(hdef) then + inserttypeconv(p2,hdef) + else + inserttypeconv(p2,u8inttype); + + p4:=csetelementnode.create(p2,nil); + end; + end; + end; + + stringdef : + begin + if (p2.nodetype<>stringconstn) then + Message(parser_e_illegal_expression) + { if we've already set elements which are constants } + { throw an error } + else if ((hdef=nil) and assigned(buildp)) or + not(is_char(hdef)) then + CGMessage(type_e_typeconflict_in_set) + else + for l:=1 to length(pshortstring(tstringconstnode(p2).value_str)^) do + do_set(ord(pshortstring(tstringconstnode(p2).value_str)^[l])); + if hdef=nil then + hdef:=cchartype; + p2.free; + end; + + else + CGMessage(type_e_ordinal_expr_expected); + end; + { insert the set creation tree } + if assigned(p4) then + buildp:=caddnode.create(addn,buildp,p4); + { load next and dispose current node } + p2:=hp; + hp:=tarrayconstructornode(tarrayconstructornode(p2).right); + tarrayconstructornode(p2).right:=nil; + p2.free; + current_filepos:=oldfilepos; + end; + if (hdef=nil) then + hdef:=u8inttype; + end + else + begin + { empty set [], only remove node } + p.free; + end; + { set the initial set type } + constp.resultdef:=tsetdef.create(hdef,constsetlo.svalue,constsethi.svalue); + { determine the resultdef for the tree } + typecheckpass(buildp); + { set the new tree } + p:=buildp; + end; + + + procedure insert_varargstypeconv(var p : tnode; iscvarargs: boolean); + begin + { procvars without arguments in variant arrays are always called by + Delphi } + if not(iscvarargs) then + maybe_call_procvar(p,true); + if not(iscvarargs) and + (p.nodetype=stringconstn) and + { don't cast to AnsiString if already casted to Wide/UnicodeString, issue #18266 } + (tstringconstnode(p).cst_type in [cst_conststring,cst_shortstring,cst_longstring]) then + p:=ctypeconvnode.create_internal(p,getansistringdef) + else + case p.resultdef.typ of + enumdef : + p:=ctypeconvnode.create_internal(p,s32inttype); + arraydef : + begin + if is_chararray(p.resultdef) then + p:=ctypeconvnode.create_internal(p,charpointertype) + else + if is_widechararray(p.resultdef) then + p:=ctypeconvnode.create_internal(p,widecharpointertype) + else + CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resultdef.typename); + end; + orddef : + begin + if is_integer(p.resultdef) and + not(is_64bitint(p.resultdef)) then + if not(m_delphi in current_settings.modeswitches) then + p:=ctypeconvnode.create(p,s32inttype) + else + { delphi doesn't generate a range error when passing a + cardinal >= $80000000, but since these are seen as + longint on the callee side, this causes data loss; + as a result, we require an explicit longint() + typecast in FPC mode on the caller side if range + checking should be disabled, but not in Delphi mode } + p:=ctypeconvnode.create_internal(p,s32inttype) + else if is_void(p.resultdef) then + CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resultdef.typename) + else if iscvarargs and is_currency(p.resultdef) + and (current_settings.fputype<>fpu_none) then + p:=ctypeconvnode.create(p,s64floattype); + end; + floatdef : + if not(iscvarargs) then + begin + if not(is_currency(p.resultdef)) then + p:=ctypeconvnode.create(p,pbestrealtype^); + end + else + begin + if is_constrealnode(p) and + not(nf_explicit in p.flags) then + MessagePos(p.fileinfo,type_w_double_c_varargs); + if (tfloatdef(p.resultdef).floattype in [s32real,s64currency]) or + (is_constrealnode(p) and + not(nf_explicit in p.flags)) then + p:=ctypeconvnode.create(p,s64floattype); + end; + procvardef : + p:=ctypeconvnode.create(p,voidpointertype); + stringdef: + if iscvarargs then + p:=ctypeconvnode.create(p,charpointertype); + variantdef: + if iscvarargs then + CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resultdef.typename); + { maybe warn in case it's not using "packrecords c"? } + recorddef: + if not iscvarargs then + CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resultdef.typename); + pointerdef: + ; + classrefdef: + if iscvarargs then + p:=ctypeconvnode.create(p,voidpointertype); + objectdef : + if (iscvarargs and + not is_objc_class_or_protocol(p.resultdef)) or + is_object(p.resultdef) then + CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resultdef.typename); + else + CGMessagePos1(p.fileinfo,type_e_wrong_type_in_array_constructor,p.resultdef.typename); + end; + typecheckpass(p); + end; + + + { in FPC mode, @procname immediately has to be evaluated as a + procvar. If procname is global, then this will be a global + procvar. Since converting global procvars to local procvars is + not allowed (see point d in defcmp.proc_to_procvar_equal()), + this results in errors when passing global procedures to local + procvar parameters or assigning them to nested procvars. The + solution is to remove the (wrong) conversion to a global procvar, + and instead insert a conversion to the local procvar type. } + function maybe_global_proc_to_nested(var fromnode: tnode; todef: tdef): boolean; + var + hp: tnode; + begin + result:=false; + if (m_nested_procvars in current_settings.modeswitches) and + not(m_tp_procvar in current_settings.modeswitches) and + (todef.typ=procvardef) and + is_nested_pd(tprocvardef(todef)) and + (fromnode.nodetype=typeconvn) and + (ttypeconvnode(fromnode).convtype=tc_proc_2_procvar) and + not is_nested_pd(tprocvardef(fromnode.resultdef)) and + (proc_to_procvar_equal(tprocdef(ttypeconvnode(fromnode).left.resultdef),tprocvardef(todef),false)>=te_convert_l1) then + begin + hp:=fromnode; + fromnode:=ctypeconvnode.create_proc_to_procvar(ttypeconvnode(fromnode).left); + ttypeconvnode(fromnode).totypedef:=todef; + typecheckpass(fromnode); + ttypeconvnode(hp).left:=nil; + hp.free; + result:=true; + end; + end; + +{***************************************************************************** + TTYPECONVNODE +*****************************************************************************} + + + constructor ttypeconvnode.create(node : tnode;def:tdef); + + begin + inherited create(typeconvn,node); + convtype:=tc_none; + totypedef:=def; + if def=nil then + internalerror(200103281); + fileinfo:=node.fileinfo; + {An attempt to convert the result of a floating point division + (with the / operator) to an integer type will fail. Give a hint + to use the div operator.} + if (node.nodetype=slashn) and (def.typ=orddef) then + cgmessage(type_h_use_div_for_int); + {In expressions like int64:=longint+longint, an integer overflow could be avoided + by simply converting the operands to int64 first. Give a hint to do this.} + if (node.nodetype in [addn,subn,muln]) and + (def.typ=orddef) and (node.resultdef<>nil) and (node.resultdef.typ=orddef) and + ((Torddef(node.resultdef).low>=Torddef(def).low) and (Torddef(node.resultdef).high<=Torddef(def).high)) and + ((Torddef(node.resultdef).low>Torddef(def).low) or (Torddef(node.resultdef).high<Torddef(def).high)) then + case node.nodetype of + addn: + cgmessage1(type_h_convert_add_operands_to_prevent_overflow,def.typename); + subn: + cgmessage1(type_h_convert_sub_operands_to_prevent_overflow,def.typename); + muln: + cgmessage1(type_h_convert_mul_operands_to_prevent_overflow,def.typename); + end; + end; + + + constructor ttypeconvnode.create_explicit(node : tnode;def:tdef); + + begin + self.create(node,def); + include(flags,nf_explicit); + end; + + + constructor ttypeconvnode.create_internal(node : tnode;def:tdef); + + begin + self.create(node,def); + { handle like explicit conversions } + include(flags,nf_explicit); + include(flags,nf_internal); + end; + + + constructor ttypeconvnode.create_proc_to_procvar(node : tnode); + + begin + self.create(node,voidtype); + convtype:=tc_proc_2_procvar; + end; + + + constructor ttypeconvnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + ppufile.getderef(totypedefderef); + convtype:=tconverttype(ppufile.getbyte); + end; + + + procedure ttypeconvnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(totypedefderef); + ppufile.putbyte(byte(convtype)); + end; + + + procedure ttypeconvnode.buildderefimpl; + begin + inherited buildderefimpl; + totypedefderef.build(totypedef); + end; + + + procedure ttypeconvnode.derefimpl; + begin + inherited derefimpl; + totypedef:=tdef(totypedefderef.resolve); + end; + + + function ttypeconvnode.dogetcopy : tnode; + var + n : ttypeconvnode; + begin + n:=ttypeconvnode(inherited dogetcopy); + n.convtype:=convtype; + n.totypedef:=totypedef; + dogetcopy:=n; + end; + + procedure ttypeconvnode.printnodeinfo(var t : text); + const + convtyp2str : array[tconverttype] of pchar = ( + '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_nil_2_methodprocvar', + 'tc_arrayconstructor_2_set', + 'tc_set_2_set', + 'tc_cord_2_pointer', + 'tc_intf_2_string', + 'tc_intf_2_guid', + 'tc_class_2_intf', + 'tc_char_2_char', + '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' + ); + begin + inherited printnodeinfo(t); + write(t,', convtype = ',strpas(convtyp2str[convtype])); + end; + + + function ttypeconvnode.typecheck_cord_to_pointer : tnode; + + begin + result:=nil; + if left.nodetype=ordconstn then + begin + { check if we have a valid pointer constant (JM) } + {$if sizeof(pointer) > sizeof(TConstPtrUInt)} + {$if sizeof(TConstPtrUInt) = 4} + if (tordconstnode(left).value < int64(low(longint))) or + (tordconstnode(left).value > int64(high(cardinal))) then + CGMessage(parser_e_range_check_error); + {$else} {$if sizeof(TConstPtrUInt) = 8} + if (tordconstnode(left).value < int64(low(int64))) or + (tordconstnode(left).value > int64(high(qword))) then + CGMessage(parser_e_range_check_error); + {$else} + internalerror(2001020801); + {$endif} {$endif} + {$endif} + + if not(nf_explicit in flags) then + if (tordconstnode(left).value.svalue=0) then + CGMessage(type_w_zero_to_nil) + else + { in Delphi mode, these aren't caught in compare_defs_ext } + IncompatibleTypes(left.resultdef,resultdef); + result:=cpointerconstnode.create(TConstPtrUInt(tordconstnode(left).value.uvalue),resultdef); + end + else + internalerror(200104023); + end; + + + function ttypeconvnode.typecheck_chararray_to_string : tnode; + var + chartype : string[8]; + newblock : tblocknode; + newstat : tstatementnode; + restemp : ttempcreatenode; + begin + if is_widechar(tarraydef(left.resultdef).elementdef) then + chartype:='widechar' + else + chartype:='char'; + if tstringdef(resultdef).stringtype=st_shortstring then + begin + newblock:=internalstatements(newstat); + restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false); + addstatement(newstat,restemp); + addstatement(newstat,ccallnode.createintern('fpc_'+chartype+'array_to_shortstr', + ccallparanode.create(cordconstnode.create( + ord(tarraydef(left.resultdef).lowrange=0),pasbool8type,false), + ccallparanode.create(left,ccallparanode.create( + ctemprefnode.create(restemp),nil))))); + addstatement(newstat,ctempdeletenode.create_normal_temp(restemp)); + addstatement(newstat,ctemprefnode.create(restemp)); + result:=newblock; + end + else if (tstringdef(resultdef).stringtype=st_ansistring) then + begin + result:=ccallnode.createinternres( + 'fpc_'+chartype+'array_to_'+tstringdef(resultdef).stringtypname, + ccallparanode.create( + cordconstnode.create( + ord(tarraydef(left.resultdef).lowrange=0), + pasbool8type, + false + ), + ccallparanode.create( + cordconstnode.create( + getparaencoding(resultdef), + u16inttype, + true + ), + ccallparanode.create(left,nil) + ) + ), + resultdef + ); + end + else + result:=ccallnode.createinternres( + 'fpc_'+chartype+'array_to_'+tstringdef(resultdef).stringtypname, + ccallparanode.create(cordconstnode.create( + ord(tarraydef(left.resultdef).lowrange=0),pasbool8type,false), + ccallparanode.create(left,nil)),resultdef); + left:=nil; + end; + + + function ttypeconvnode.typecheck_string_to_chararray : tnode; + var + newblock : tblocknode; + newstat : tstatementnode; + restemp : ttempcreatenode; + pchtemp : pchar; + arrsize : aint; + chartype : string[8]; + begin + result := nil; + with tarraydef(resultdef) do + begin + if highrange<lowrange then + internalerror(200501051); + arrsize := highrange-lowrange+1; + end; + if (left.nodetype = stringconstn) and + (tstringconstnode(left).cst_type=cst_conststring) then + begin + { if the array of char is large enough we can use the string + constant directly. This is handled in ncgcnv } + if (arrsize>=tstringconstnode(left).len) and + is_char(tarraydef(resultdef).elementdef) then + begin + { pad the constant string with #0 to the array len } + { (2.0.x compatible) } + if (arrsize>tstringconstnode(left).len) then + begin + pchtemp:=concatansistrings(tstringconstnode(left).value_str,pchar(StringOfChar(#0,arrsize-tstringconstnode(left).len)),tstringconstnode(left).len,arrsize-tstringconstnode(left).len); + left.free; + left:=cstringconstnode.createpchar(pchtemp,arrsize); + typecheckpass(left); + end; + exit; + end; + { Convert to wide/short/ansistring and call default helper } + if is_widechar(tarraydef(resultdef).elementdef) then + inserttypeconv(left,cwidestringtype) + else + begin + if tstringconstnode(left).len>255 then + inserttypeconv(left,getansistringdef) + else + inserttypeconv(left,cshortstringtype); + end; + end; + if is_widechar(tarraydef(resultdef).elementdef) then + chartype:='widechar' + else + chartype:='char'; + newblock:=internalstatements(newstat); + restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false); + addstatement(newstat,restemp); + addstatement(newstat,ccallnode.createintern('fpc_'+tstringdef(left.resultdef).stringtypname+ + '_to_'+chartype+'array',ccallparanode.create(left,ccallparanode.create( + ctemprefnode.create(restemp),nil)))); + addstatement(newstat,ctempdeletenode.create_normal_temp(restemp)); + addstatement(newstat,ctemprefnode.create(restemp)); + result:=newblock; + left:=nil; + end; + + + function ttypeconvnode.typecheck_char_to_string : tnode; + var + procname: string[31]; + para : tcallparanode; + hp : tstringconstnode; + ws : pcompilerwidestring; + newblock : tblocknode; + newstat : tstatementnode; + restemp : ttempcreatenode; + sa : ansistring; + cw : tcompilerwidechar; + l : SizeUInt; + begin + result:=nil; + if (left.nodetype=ordconstn) and + ((tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring,st_ansistring]) or + (torddef(left.resultdef).ordtype in [uchar,uwidechar])) then + begin + if (tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring]) then + begin + initwidestring(ws); + if torddef(left.resultdef).ordtype=uwidechar then + concatwidestringchar(ws,tcompilerwidechar(tordconstnode(left).value.uvalue)) + else + concatwidestringchar(ws,asciichar2unicode(chr(tordconstnode(left).value.uvalue))); + hp:=cstringconstnode.createwstr(ws); + hp.changestringtype(resultdef); + donewidestring(ws); + end + else + begin + if (torddef(left.resultdef).ordtype=uwidechar) then + begin + if (current_settings.sourcecodepage<>CP_UTF8) then + begin + if tordconstnode(left).value.uvalue>127 then + Message(type_w_unicode_data_loss); + hp:=cstringconstnode.createstr(unicode2asciichar(tcompilerwidechar(tordconstnode(left).value.uvalue))); + end + else + begin + cw:=tcompilerwidechar(tordconstnode(left).value.uvalue); + SetLength(sa,5); + l:=UnicodeToUtf8(@(sa[1]),Length(sa),@cw,1); + SetLength(sa,l-1); + hp:=cstringconstnode.createstr(sa); + end + end + else + hp:=cstringconstnode.createstr(chr(tordconstnode(left).value.uvalue)); + { output string consts in local ansistring encoding } + if is_ansistring(resultdef) and ((tstringdef(resultdef).encoding=0) or (tstringdef(resultdef).encoding=globals.CP_NONE)) then + tstringconstnode(hp).changestringtype(getansistringdef) + else + tstringconstnode(hp).changestringtype(resultdef); + end; + result:=hp; + end + else + { shortstrings are handled 'inline' (except for widechars) } + if (tstringdef(resultdef).stringtype<>st_shortstring) or + (torddef(left.resultdef).ordtype=uwidechar) then + begin + if (tstringdef(resultdef).stringtype<>st_shortstring) then + begin + { parameter } + para:=ccallparanode.create(left,nil); + { encoding required? } + if tstringdef(resultdef).stringtype=st_ansistring then + para:=ccallparanode.create(cordconstnode.create(getparaencoding(resultdef),u16inttype,true),para); + + { create the procname } + if torddef(left.resultdef).ordtype<>uwidechar then + begin + procname:='fpc_char_to_'; + if tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring] then + if nf_explicit in flags then + Message2(type_w_explicit_string_cast,left.resultdef.typename,resultdef.typename) + else + Message2(type_w_implicit_string_cast,left.resultdef.typename,resultdef.typename); + end + else + begin + procname:='fpc_uchar_to_'; + if not (tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring]) then + if nf_explicit in flags then + Message2(type_w_explicit_string_cast_loss,left.resultdef.typename,resultdef.typename) + else + Message2(type_w_implicit_string_cast_loss,left.resultdef.typename,resultdef.typename); + end; + procname:=procname+tstringdef(resultdef).stringtypname; + + { and finally the call } + result:=ccallnode.createinternres(procname,para,resultdef); + end + else + begin + if nf_explicit in flags then + Message2(type_w_explicit_string_cast_loss,left.resultdef.typename,resultdef.typename) + else + Message2(type_w_implicit_string_cast_loss,left.resultdef.typename,resultdef.typename); + newblock:=internalstatements(newstat); + restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false); + addstatement(newstat,restemp); + addstatement(newstat,ccallnode.createintern('fpc_wchar_to_shortstr',ccallparanode.create(left,ccallparanode.create( + ctemprefnode.create(restemp),nil)))); + addstatement(newstat,ctempdeletenode.create_normal_temp(restemp)); + addstatement(newstat,ctemprefnode.create(restemp)); + result:=newblock; + end; + left := nil; + end + else + begin + { create word(byte(char) shl 8 or 1) for litte endian machines } + { and word(byte(char) or 256) for big endian machines } + left := ctypeconvnode.create_internal(left,u8inttype); + if (target_info.endian = endian_little) then + left := caddnode.create(orn, + cshlshrnode.create(shln,left,cordconstnode.create(8,s32inttype,false)), + cordconstnode.create(1,s32inttype,false)) + else + left := caddnode.create(orn,left, + cordconstnode.create(1 shl 8,s32inttype,false)); + left := ctypeconvnode.create_internal(left,u16inttype); + typecheckpass(left); + end; + end; + + function ttypeconvnode.typecheck_string_to_string : tnode; + begin + result:=nil; + if (left.nodetype=stringconstn) and + (((tstringdef(resultdef).stringtype=st_ansistring) and + (tstringdef(resultdef).encoding<>CP_NONE) + ) + ) and + (tstringdef(left.resultdef).stringtype in [st_unicodestring,st_widestring]) then + begin + tstringconstnode(left).changestringtype(resultdef); + Result:=left; + left:=nil; + end + else if (tstringdef(resultdef).stringtype=st_ansistring) and + (tstringdef(left.resultdef).stringtype=st_ansistring) and + (tstringdef(resultdef).encoding<>tstringdef(left.resultdef).encoding) then + begin + result:=ccallnode.createinternres( + 'fpc_ansistr_to_ansistr', + ccallparanode.create( + cordconstnode.create( + tstringdef(resultdef).encoding, + u16inttype, + true + ), + ccallparanode.create(left,nil) + ), + resultdef + ); + left:=nil; + end + else if (left.nodetype=stringconstn) and + (tstringdef(left.resultdef).stringtype in [st_unicodestring,st_widestring]) and + (tstringdef(resultdef).stringtype=st_shortstring) then + begin + if not hasnonasciichars(pcompilerwidestring(tstringconstnode(left).value_str)) then + begin + tstringconstnode(left).changestringtype(resultdef); + Result:=left; + left:=nil; + end; + end + else if (tstringdef(left.resultdef).stringtype in [st_unicodestring,st_widestring]) and + not (tstringdef(resultdef).stringtype in [st_unicodestring,st_widestring]) then + begin + if nf_explicit in flags then + Message2(type_w_explicit_string_cast_loss,left.resultdef.typename,resultdef.typename) + else + Message2(type_w_implicit_string_cast_loss,left.resultdef.typename,resultdef.typename); + end + else if not (tstringdef(left.resultdef).stringtype in [st_unicodestring,st_widestring]) and + (tstringdef(resultdef).stringtype in [st_unicodestring,st_widestring]) then + begin + if nf_explicit in flags then + Message2(type_w_explicit_string_cast,left.resultdef.typename,resultdef.typename) + else + Message2(type_w_implicit_string_cast,left.resultdef.typename,resultdef.typename); + end + end; + + function ttypeconvnode.typecheck_char_to_chararray : tnode; + begin + if resultdef.size <> 1 then + begin + { convert first to string, then to chararray } + inserttypeconv(left,cshortstringtype); + inserttypeconv(left,resultdef); + result:=left; + left := nil; + exit; + end; + result := nil; + end; + + + function ttypeconvnode.typecheck_char_to_char : tnode; + var + hp : tordconstnode; + begin + result:=nil; + if (left.nodetype=ordconstn) and + ((torddef(resultdef).ordtype<>uchar) or + (torddef(left.resultdef).ordtype<>uwidechar) or + (current_settings.sourcecodepage<>CP_UTF8)) + then + begin + if (torddef(resultdef).ordtype=uchar) and + (torddef(left.resultdef).ordtype=uwidechar) and + (current_settings.sourcecodepage<>CP_UTF8) then + begin + if tordconstnode(left).value.uvalue>127 then + Message(type_w_unicode_data_loss); + hp:=cordconstnode.create( + ord(unicode2asciichar(tcompilerwidechar(tordconstnode(left).value.uvalue))), + cchartype,true); + result:=hp; + end + else if (torddef(resultdef).ordtype=uwidechar) and + (torddef(left.resultdef).ordtype=uchar) then + begin + hp:=cordconstnode.create( + asciichar2unicode(chr(tordconstnode(left).value.uvalue)), + cwidechartype,true); + result:=hp; + end + else + internalerror(200105131); + exit; + end; + end; + + + function ttypeconvnode.typecheck_int_to_int : tnode; + var + v : TConstExprInt; + begin + result:=nil; + if left.nodetype=ordconstn then + begin + v:=tordconstnode(left).value; + if is_currency(resultdef) then + v:=v*10000; + if (resultdef.typ=pointerdef) then + result:=cpointerconstnode.create(TConstPtrUInt(v.uvalue),resultdef) + else + begin + if is_currency(left.resultdef) then + v:=v div 10000; + result:=cordconstnode.create(v,resultdef,false); + end; + end + else if left.nodetype=pointerconstn then + begin + v:=tpointerconstnode(left).value; + if (resultdef.typ=pointerdef) then + result:=cpointerconstnode.create(v.uvalue,resultdef) + else + begin + if is_currency(resultdef) then + v:=v*10000; + result:=cordconstnode.create(v,resultdef,false); + end; + end + else + begin + { multiply by 10000 for currency. We need to use getcopy to pass + the argument because the current node is always disposed. Only + inserting the multiply in the left node is not possible because + it'll get in an infinite loop to convert int->currency } + if is_currency(resultdef) then + begin + result:=caddnode.create(muln,getcopy,cordconstnode.create(10000,resultdef,false)); + include(result.flags,nf_is_currency); + end + else if is_currency(left.resultdef) then + begin + result:=cmoddivnode.create(divn,getcopy,cordconstnode.create(10000,resultdef,false)); + include(result.flags,nf_is_currency); + end; + end; + end; + + + function ttypeconvnode.typecheck_int_to_real : tnode; + var + rv : bestreal; + begin + result:=nil; + if left.nodetype=ordconstn then + begin + rv:=tordconstnode(left).value; + if is_currency(resultdef) then + rv:=rv*10000.0 + else if is_currency(left.resultdef) then + rv:=rv/10000.0; + result:=crealconstnode.create(rv,resultdef); + end + else + begin + { multiply by 10000 for currency. We need to use getcopy to pass + the argument because the current node is always disposed. Only + inserting the multiply in the left node is not possible because + it'll get in an infinite loop to convert int->currency } + if is_currency(resultdef) then + begin + result:=caddnode.create(muln,getcopy,crealconstnode.create(10000.0,resultdef)); + include(result.flags,nf_is_currency); + end + else if is_currency(left.resultdef) then + begin + result:=caddnode.create(slashn,getcopy,crealconstnode.create(10000.0,resultdef)); + include(result.flags,nf_is_currency); + end; + end; + end; + + + function ttypeconvnode.typecheck_real_to_currency : tnode; + begin + if not is_currency(resultdef) then + internalerror(200304221); + result:=nil; + left:=caddnode.create(muln,left,crealconstnode.create(10000.0,left.resultdef)); + include(left.flags,nf_is_currency); + typecheckpass(left); + { Convert constants directly, else call Round() } + if left.nodetype=realconstn then + result:=cordconstnode.create(round(trealconstnode(left).value_real),resultdef,false) + else + begin + result:=ccallnode.createinternres('fpc_round_real', + ccallparanode.create(left,nil),resultdef); + left:=nil; + end; + end; + + + function ttypeconvnode.typecheck_real_to_real : tnode; + begin + result:=nil; + if is_currency(left.resultdef) and not(is_currency(resultdef)) then + begin + left:=caddnode.create(slashn,left,crealconstnode.create(10000.0,left.resultdef)); + include(left.flags,nf_is_currency); + typecheckpass(left); + end + else + if is_currency(resultdef) and not(is_currency(left.resultdef)) then + begin + left:=caddnode.create(muln,left,crealconstnode.create(10000.0,left.resultdef)); + include(left.flags,nf_is_currency); + typecheckpass(left); + end; + end; + + + function ttypeconvnode.typecheck_cchar_to_pchar : tnode; + + begin + result:=nil; + if is_pwidechar(resultdef) then + inserttypeconv(left,cwidestringtype) + else + inserttypeconv(left,cshortstringtype); + { evaluate again, reset resultdef so the convert_typ + will be calculated again and cstring_to_pchar will + be used for futher conversion } + convtype:=tc_none; + result:=pass_typecheck; + end; + + + function ttypeconvnode.typecheck_cstring_to_pchar : tnode; + + begin + result:=nil; + if is_pwidechar(resultdef) then + inserttypeconv(left,cwidestringtype) + else + if is_pchar(resultdef) and + (is_widestring(left.resultdef) or + is_unicodestring(left.resultdef)) then + begin + inserttypeconv(left,getansistringdef); + { the second pass of second_cstring_to_pchar expects a } + { strinconstn, but this may become a call to the } + { widestring manager in case left contains "high ascii" } + if (left.nodetype<>stringconstn) then + begin + result:=left; + left:=nil; + end; + end; + end; + + + function ttypeconvnode.typecheck_cstring_to_int : tnode; + var + fcc : cardinal; + pb : pbyte; + begin + result:=nil; + if left.nodetype<>stringconstn then + internalerror(200510012); + if tstringconstnode(left).len=4 then + begin + pb:=pbyte(tstringconstnode(left).value_str); + fcc:=(pb[0] shl 24) or (pb[1] shl 16) or (pb[2] shl 8) or pb[3]; + result:=cordconstnode.create(fcc,u32inttype,false); + end + else + CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename); + end; + + + function ttypeconvnode.typecheck_arrayconstructor_to_set : tnode; + var + hp : tnode; + begin + result:=nil; + if left.nodetype<>arrayconstructorn then + internalerror(5546); + { remove typeconv node } + hp:=left; + left:=nil; + { create a set constructor tree } + arrayconstructor_to_set(hp); + result:=hp; + end; + + + function ttypeconvnode.typecheck_set_to_set : tnode; + begin + result:=nil; + { constant sets can be converted by changing the type only } + if (left.nodetype=setconstn) then + begin + left.resultdef:=resultdef; + result:=left; + left:=nil; + exit; + end; + end; + + + function ttypeconvnode.typecheck_pchar_to_string : tnode; + var + newblock : tblocknode; + newstat : tstatementnode; + restemp : ttempcreatenode; + begin + if tstringdef(resultdef).stringtype=st_shortstring then + begin + newblock:=internalstatements(newstat); + restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false); + addstatement(newstat,restemp); + addstatement(newstat,ccallnode.createintern('fpc_pchar_to_shortstr',ccallparanode.create(left,ccallparanode.create( + ctemprefnode.create(restemp),nil)))); + addstatement(newstat,ctempdeletenode.create_normal_temp(restemp)); + addstatement(newstat,ctemprefnode.create(restemp)); + result:=newblock; + end + else if tstringdef(resultdef).stringtype=st_ansistring then + result := ccallnode.createinternres( + 'fpc_pchar_to_'+tstringdef(resultdef).stringtypname, + ccallparanode.create( + cordconstnode.create(getparaencoding(resultdef),u16inttype,true), + ccallparanode.create(left,nil) + ), + resultdef + ) + else + result := ccallnode.createinternres( + 'fpc_pchar_to_'+tstringdef(resultdef).stringtypname, + ccallparanode.create(left,nil),resultdef); + left:=nil; + end; + + + function ttypeconvnode.typecheck_interface_to_string : tnode; + begin + if assigned(tobjectdef(left.resultdef).iidstr) then + begin + if not(oo_has_valid_guid in tobjectdef(left.resultdef).objectoptions) then + CGMessage1(type_e_interface_has_no_guid,tobjectdef(left.resultdef).typename); + result:=cstringconstnode.createstr(tobjectdef(left.resultdef).iidstr^); + tstringconstnode(result).changestringtype(cshortstringtype); + end; + end; + + + function ttypeconvnode.typecheck_interface_to_guid : tnode; + begin + if assigned(tobjectdef(left.resultdef).iidguid) then + begin + if not(oo_has_valid_guid in tobjectdef(left.resultdef).objectoptions) then + CGMessage1(type_e_interface_has_no_guid,tobjectdef(left.resultdef).typename); + result:=cguidconstnode.create(tobjectdef(left.resultdef).iidguid^); + end; + end; + + + function ttypeconvnode.typecheck_dynarray_to_openarray : tnode; + begin + { a dynamic array is a pointer to an array, so to convert it to } + { an open array, we have to dereference it (JM) } + result := ctypeconvnode.create_internal(left,voidpointertype); + typecheckpass(result); + { left is reused } + left := nil; + result := cderefnode.create(result); + include(result.flags,nf_no_checkpointer); + result.resultdef := resultdef; + end; + + + function ttypeconvnode.typecheck_pwchar_to_string : tnode; + var + newblock : tblocknode; + newstat : tstatementnode; + restemp : ttempcreatenode; + begin + if tstringdef(resultdef).stringtype=st_shortstring then + begin + newblock:=internalstatements(newstat); + restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false); + addstatement(newstat,restemp); + addstatement(newstat,ccallnode.createintern('fpc_pwidechar_to_shortstr',ccallparanode.create(left,ccallparanode.create( + ctemprefnode.create(restemp),nil)))); + addstatement(newstat,ctempdeletenode.create_normal_temp(restemp)); + addstatement(newstat,ctemprefnode.create(restemp)); + result:=newblock; + end + else if tstringdef(resultdef).stringtype=st_ansistring then + begin + result:=ccallnode.createinternres( + 'fpc_pwidechar_to_'+tstringdef(resultdef).stringtypname, + ccallparanode.create( + cordconstnode.create( + getparaencoding(resultdef), + u16inttype, + true + ), + ccallparanode.create(left,nil) + ), + resultdef + ); + end + else + result := ccallnode.createinternres( + 'fpc_pwidechar_to_'+tstringdef(resultdef).stringtypname, + ccallparanode.create(left,nil),resultdef); + left:=nil; + end; + + + function ttypeconvnode.typecheck_variant_to_dynarray : tnode; + begin + result := ccallnode.createinternres( + 'fpc_variant_to_dynarray', + ccallparanode.create(caddrnode.create_internal(crttinode.create(tstoreddef(resultdef),initrtti,rdt_normal)), + ccallparanode.create(left,nil) + ),resultdef); + typecheckpass(result); + left:=nil; + end; + + + function ttypeconvnode.typecheck_dynarray_to_variant : tnode; + begin + result := ccallnode.createinternres( + 'fpc_dynarray_to_variant', + ccallparanode.create(caddrnode.create_internal(crttinode.create(tstoreddef(left.resultdef),initrtti,rdt_normal)), + ccallparanode.create(ctypeconvnode.create_explicit(left,voidpointertype),nil) + ),resultdef); + typecheckpass(result); + left:=nil; + end; + + + function ttypeconvnode.typecheck_variant_to_interface : tnode; + begin + if tobjectdef(resultdef).is_related(tobjectdef(search_system_type('IDISPATCH').typedef)) then + result := ccallnode.createinternres( + 'fpc_variant_to_idispatch', + ccallparanode.create(left,nil) + ,resultdef) + else + result := ccallnode.createinternres( + 'fpc_variant_to_interface', + ccallparanode.create(left,nil) + ,resultdef); + typecheckpass(result); + left:=nil; + end; + + + function ttypeconvnode.typecheck_interface_to_variant : tnode; + begin + if tobjectdef(left.resultdef).is_related(tobjectdef(search_system_type('IDISPATCH').typedef)) then + result := ccallnode.createinternres( + 'fpc_idispatch_to_variant', + ccallparanode.create(left,nil) + ,resultdef) + else + result := ccallnode.createinternres( + 'fpc_interface_to_variant', + ccallparanode.create(left,nil) + ,resultdef); + typecheckpass(result); + left:=nil; + end; + + + function ttypeconvnode.typecheck_variant_to_enum : tnode; + + begin + result := ctypeconvnode.create_internal(left,sinttype); + result := ctypeconvnode.create_internal(result,resultdef); + typecheckpass(result); + { left is reused } + left := nil; + end; + + + function ttypeconvnode.typecheck_enum_to_variant : tnode; + + begin + result := ctypeconvnode.create_internal(left,sinttype); + result := ctypeconvnode.create_internal(result,cvarianttype); + typecheckpass(result); + { left is reused } + left := nil; + end; + + + function ttypeconvnode.typecheck_array_2_dynarray : tnode; + var + newstatement : tstatementnode; + temp : ttempcreatenode; + temp2 : ttempcreatenode; + begin + { create statements with call to getmem+initialize } + result:=internalstatements(newstatement); + + { create temp for result } + temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true); + addstatement(newstatement,temp); + + { get temp for array of lengths } + temp2:=ctempcreatenode.create(sinttype,sinttype.size,tt_persistent,false); + addstatement(newstatement,temp2); + + { one dimensional } + addstatement(newstatement,cassignmentnode.create( + ctemprefnode.create_offset(temp2,0), + cordconstnode.create + (tarraydef(left.resultdef).highrange+1,s32inttype,true))); + { create call to fpc_dynarr_setlength } + addstatement(newstatement,ccallnode.createintern('fpc_dynarray_setlength', + ccallparanode.create(caddrnode.create_internal + (ctemprefnode.create(temp2)), + ccallparanode.create(cordconstnode.create + (1,s32inttype,true), + ccallparanode.create(caddrnode.create_internal + (crttinode.create(tstoreddef(resultdef),initrtti,rdt_normal)), + ccallparanode.create( + ctypeconvnode.create_internal( + ctemprefnode.create(temp),voidpointertype), + nil)))) + + )); + addstatement(newstatement,ctempdeletenode.create(temp2)); + + { copy ... } + addstatement(newstatement,cassignmentnode.create( + ctypeconvnode.create_internal(cderefnode.create(ctypeconvnode.create_internal(ctemprefnode.create(temp),voidpointertype)),left.resultdef), + left + )); + { left is reused } + left:=nil; + { the last statement should return the value as + location and type, this is done be referencing the + temp and converting it first from a persistent temp to + normal temp } + addstatement(newstatement,ctempdeletenode.create_normal_temp(temp)); + addstatement(newstatement,ctemprefnode.create(temp)); + end; + + + procedure copyparasym(p:TObject;arg:pointer); + var + newparast : TSymtable absolute arg; + vs : tparavarsym; + begin + if tsym(p).typ<>paravarsym then + exit; + with tparavarsym(p) do + begin + vs:=tparavarsym.create(realname,paranr,varspez,vardef,varoptions); + vs.defaultconstsym:=defaultconstsym; + newparast.insert(vs); + end; + end; + + + function ttypeconvnode.typecheck_proc_to_procvar : tnode; + var + pd : tabstractprocdef; + nestinglevel : byte; + begin + result:=nil; + pd:=tabstractprocdef(left.resultdef); + + { create procvardef (default for create_proc_to_procvar is voiddef, + but if later a regular inserttypeconvnode() is used to insert a type + conversion to the actual procvardef, totypedef will be set to the + real procvartype that we are converting to) } + if assigned(totypedef) and + (totypedef.typ=procvardef) then + resultdef:=totypedef + else + begin + nestinglevel:=pd.parast.symtablelevel; + resultdef:=tprocvardef.create(nestinglevel); + tprocvardef(resultdef).proctypeoption:=pd.proctypeoption; + tprocvardef(resultdef).proccalloption:=pd.proccalloption; + tprocvardef(resultdef).procoptions:=pd.procoptions; + tprocvardef(resultdef).returndef:=pd.returndef; + { method ? then set the methodpointer flag } + if (pd.owner.symtabletype=ObjectSymtable) then + include(tprocvardef(resultdef).procoptions,po_methodpointer); + { only need the address of the method? this is needed + for @tobject.create. In this case there will be a loadn without + a methodpointer. } + if (left.nodetype=loadn) and + not assigned(tloadnode(left).left) and + (not(m_nested_procvars in current_settings.modeswitches) or + not is_nested_pd(tprocvardef(resultdef))) then + include(tprocvardef(resultdef).procoptions,po_addressonly); + + { Add parameters use only references, we don't need to keep the + parast. We use the parast from the original function to calculate + our parameter data and reset it afterwards } + pd.parast.SymList.ForEachCall(@copyparasym,tprocvardef(resultdef).parast); + tprocvardef(resultdef).calcparas; + end; + end; + + + function ttypeconvnode.typecheck_call_helper(c : tconverttype) : tnode; + const + resultdefconvert : array[tconverttype] of pointer = ( + {none} nil, + {equal} nil, + {not_possible} nil, + { string_2_string } @ttypeconvnode.typecheck_string_to_string, + { char_2_string } @ttypeconvnode.typecheck_char_to_string, + { char_2_chararray } @ttypeconvnode.typecheck_char_to_chararray, + { pchar_2_string } @ttypeconvnode.typecheck_pchar_to_string, + { cchar_2_pchar } @ttypeconvnode.typecheck_cchar_to_pchar, + { cstring_2_pchar } @ttypeconvnode.typecheck_cstring_to_pchar, + { cstring_2_int } @ttypeconvnode.typecheck_cstring_to_int, + { ansistring_2_pchar } nil, + { string_2_chararray } @ttypeconvnode.typecheck_string_to_chararray, + { chararray_2_string } @ttypeconvnode.typecheck_chararray_to_string, + { array_2_pointer } nil, + { pointer_2_array } nil, + { int_2_int } @ttypeconvnode.typecheck_int_to_int, + { int_2_bool } nil, + { bool_2_bool } nil, + { bool_2_int } nil, + { real_2_real } @ttypeconvnode.typecheck_real_to_real, + { int_2_real } @ttypeconvnode.typecheck_int_to_real, + { real_2_currency } @ttypeconvnode.typecheck_real_to_currency, + { proc_2_procvar } @ttypeconvnode.typecheck_proc_to_procvar, + { nil_2_methodprocvar } nil, + { arrayconstructor_2_set } @ttypeconvnode.typecheck_arrayconstructor_to_set, + { set_to_set } @ttypeconvnode.typecheck_set_to_set, + { cord_2_pointer } @ttypeconvnode.typecheck_cord_to_pointer, + { intf_2_string } @ttypeconvnode.typecheck_interface_to_string, + { intf_2_guid } @ttypeconvnode.typecheck_interface_to_guid, + { class_2_intf } nil, + { char_2_char } @ttypeconvnode.typecheck_char_to_char, + { dynarray_2_openarray} @ttypeconvnode.typecheck_dynarray_to_openarray, + { pwchar_2_string} @ttypeconvnode.typecheck_pwchar_to_string, + { variant_2_dynarray} @ttypeconvnode.typecheck_variant_to_dynarray, + { dynarray_2_variant} @ttypeconvnode.typecheck_dynarray_to_variant, + { variant_2_enum} @ttypeconvnode.typecheck_variant_to_enum, + { enum_2_variant} @ttypeconvnode.typecheck_enum_to_variant, + { variant_2_interface} @ttypeconvnode.typecheck_interface_to_variant, + { interface_2_variant} @ttypeconvnode.typecheck_variant_to_interface, + { array_2_dynarray} @ttypeconvnode.typecheck_array_2_dynarray + ); + type + tprocedureofobject = function : tnode of object; + var + r : packed record + proc : pointer; + obj : pointer; + end; + begin + result:=nil; + { this is a little bit dirty but it works } + { and should be quite portable too } + r.proc:=resultdefconvert[c]; + r.obj:=self; + if assigned(r.proc) then + result:=tprocedureofobject(r)(); + end; + + + function ttypeconvnode.actualtargetnode: tnode; + begin + result:=self; + while (result.nodetype=typeconvn) and + ttypeconvnode(result).retains_value_location do + result:=ttypeconvnode(result).left; + end; + + + function ttypeconvnode.pass_typecheck:tnode; + + var + hdef : tdef; + hp : tnode; + currprocdef : tabstractprocdef; + aprocdef : tprocdef; + eq : tequaltype; + cdoptions : tcompare_defs_options; + newblock: tblocknode; + newstatement: tstatementnode; + tempnode: ttempcreatenode; + begin + result:=nil; + resultdef:=totypedef; + + typecheckpass(left); + if codegenerror then + exit; + + { When absolute force tc_equal } + if (nf_absolute in flags) then + begin + convtype:=tc_equal; + if not(tstoreddef(resultdef).is_intregable) and + not(tstoreddef(resultdef).is_fpuregable) then + make_not_regable(left,[ra_addr_regable]); + exit; + end; + + { tp procvar support. Skip typecasts to procvar, record or set. Those + convert on the procvar value. This is used to access the + fields of a methodpointer } + if not(nf_load_procvar in flags) and + not(resultdef.typ in [procvardef,recorddef,setdef]) then + maybe_call_procvar(left,true); + + { convert array constructors to sets, because there is no conversion + possible for array constructors } + if (resultdef.typ<>arraydef) and + is_array_constructor(left.resultdef) then + begin + arrayconstructor_to_set(left); + typecheckpass(left); + end; + + if convtype=tc_none then + begin + cdoptions:=[cdo_check_operator,cdo_allow_variant,cdo_warn_incompatible_univ]; + if nf_explicit in flags then + include(cdoptions,cdo_explicit); + if nf_internal in flags then + include(cdoptions,cdo_internal); + eq:=compare_defs_ext(left.resultdef,resultdef,left.nodetype,convtype,aprocdef,cdoptions); + case eq of + te_exact, + te_equal : + begin + result := simplify(false); + if assigned(result) then + exit; + + { in case of bitpacked accesses, the original type must + remain so that not too many/few bits are laoded } + if is_bitpacked_access(left) then + convtype:=tc_int_2_int; + { Only leave when there is no conversion to do. + We can still need to call a conversion routine, + like the routine to convert a stringconstnode } + if (convtype in [tc_equal,tc_not_possible]) and + { some conversions, like dynarray to pointer in Delphi + mode, must not be removed, because then we get memory + leaks due to missing temp finalization } + (not is_managed_type(left.resultdef) or + { different kinds of refcounted types may need calls + to different kinds of refcounting helpers } + (resultdef=left.resultdef)) then + begin + left.resultdef:=resultdef; + if (nf_explicit in flags) and (left.nodetype = addrn) then + include(left.flags, nf_typedaddr); + result:=left; + left:=nil; + exit; + end; + end; + + te_convert_l1, + te_convert_l2, + te_convert_l3, + te_convert_l4, + te_convert_l5: + { nothing to do } + ; + + te_convert_operator : + begin + include(current_procinfo.flags,pi_do_call); + addsymref(aprocdef.procsym); + hp:=ccallnode.create(ccallparanode.create(left,nil),Tprocsym(aprocdef.procsym),nil,nil,[]); + { tell explicitly which def we must use !! (PM) } + tcallnode(hp).procdefinition:=aprocdef; + left:=nil; + result:=hp; + exit; + end; + + te_incompatible : + begin + { Procedures have a resultdef of voiddef and functions of their + own resultdef. They will therefore always be incompatible with + a procvar. Because isconvertable cannot check for procedures we + use an extra check for them.} + if (left.nodetype=calln) and + (tcallnode(left).required_para_count=0) and + (resultdef.typ=procvardef) and + ( + (m_tp_procvar in current_settings.modeswitches) or + (m_mac_procvar in current_settings.modeswitches) + ) then + begin + if assigned(tcallnode(left).right) then + begin + { this is already a procvar, if it is really equal + is checked below } + convtype:=tc_equal; + hp:=tcallnode(left).right.getcopy; + currprocdef:=tabstractprocdef(hp.resultdef); + end + else + begin + convtype:=tc_proc_2_procvar; + currprocdef:=Tprocsym(Tcallnode(left).symtableprocentry).Find_procdef_byprocvardef(Tprocvardef(resultdef)); + hp:=cloadnode.create_procvar(tprocsym(tcallnode(left).symtableprocentry), + tprocdef(currprocdef),tcallnode(left).symtableproc); + if (tcallnode(left).symtableprocentry.owner.symtabletype=ObjectSymtable) then + begin + if assigned(tcallnode(left).methodpointer) then + tloadnode(hp).set_mp(tcallnode(left).methodpointer.getcopy) + else + tloadnode(hp).set_mp(load_self_node); + end; + typecheckpass(hp); + end; + left.free; + left:=hp; + { Now check if the procedure we are going to assign to + the procvar, is compatible with the procvar's type } + if not(nf_explicit in flags) and + (proc_to_procvar_equal(currprocdef,tprocvardef(resultdef),false)=te_incompatible) then + IncompatibleTypes(left.resultdef,resultdef); + exit; + end + else if maybe_global_proc_to_nested(left,resultdef) then + begin + result:=left; + left:=nil; + exit; + end; + + { Handle explicit type conversions } + if nf_explicit in flags then + begin + { do common tc_equal cast } + convtype:=tc_equal; + + { ordinal constants can be resized to 1,2,4,8 bytes } + if (left.nodetype=ordconstn) then + begin + { Insert typeconv for ordinal to the correct size first on left, after + that the other conversion can be done } + hdef:=nil; + case longint(resultdef.size) of + 1 : + hdef:=s8inttype; + 2 : + hdef:=s16inttype; + 4 : + hdef:=s32inttype; + 8 : + hdef:=s64inttype; + end; + { we need explicit, because it can also be an enum } + if assigned(hdef) then + inserttypeconv_internal(left,hdef) + else + CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename); + end; + + { check if the result could be in a register } + if (not(tstoreddef(resultdef).is_intregable) and + not(tstoreddef(resultdef).is_fpuregable)) or + ((left.resultdef.typ = floatdef) and + (resultdef.typ <> floatdef)) then + make_not_regable(left,[ra_addr_regable]); + + { class/interface to class/interface, with checkobject support } + if is_class_or_interface_or_objc(resultdef) and + is_class_or_interface_or_objc(left.resultdef) then + begin + { check if the types are related } + if not(nf_internal in flags) and + (not(tobjectdef(left.resultdef).is_related(tobjectdef(resultdef)))) and + (not(tobjectdef(resultdef).is_related(tobjectdef(left.resultdef)))) then + begin + { Give an error when typecasting class to interface, this is compatible + with delphi } + if is_interface(resultdef) and + not is_interface(left.resultdef) then + CGMessage2(type_e_classes_not_related, + FullTypeName(left.resultdef,resultdef), + FullTypeName(resultdef,left.resultdef)) + else + CGMessage2(type_w_classes_not_related, + FullTypeName(left.resultdef,resultdef), + FullTypeName(resultdef,left.resultdef)) + end; + + { Add runtime check? } + if not is_objc_class_or_protocol(resultdef) and + not is_objc_class_or_protocol(left.resultdef) and + (cs_check_object in current_settings.localswitches) and + not(nf_internal in flags) then + begin + { we can translate the typeconvnode to 'as' when + typecasting to a class or interface } + { we need to make sure the result can still be + passed as a var parameter } + newblock:=internalstatements(newstatement); + if (valid_for_var(left,false)) then + begin + tempnode:=ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true); + addstatement(newstatement,tempnode); + addstatement(newstatement,cassignmentnode.create( + ctemprefnode.create(tempnode), + caddrnode.create_internal(left))); + left:=ctypeconvnode.create_internal(cderefnode.create(ctemprefnode.create(tempnode)),left.resultdef); + end + else + begin + tempnode:=ctempcreatenode.create(left.resultdef,left.resultdef.size,tt_persistent,true); + addstatement(newstatement,tempnode); + addstatement(newstatement,cassignmentnode.create( + ctemprefnode.create(tempnode), + left)); + left:=ctemprefnode.create(tempnode); + end; + addstatement(newstatement,casnode.create(left.getcopy,cloadvmtaddrnode.create(ctypenode.create(resultdef)))); + addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode)); + addstatement(newstatement,ctypeconvnode.create_internal(left,resultdef)); + left:=nil; + result:=newblock; + exit; + end; + end + + else + begin + { only if the same size or formal def, and } + { don't allow type casting of constants to } + { structured types } + if not( + (left.resultdef.typ=formaldef) or + ( + not(is_open_array(left.resultdef)) and + not(is_array_constructor(left.resultdef)) and + not(is_array_of_const(left.resultdef)) and + (left.resultdef.size=resultdef.size) and + { disallow casts of const nodes } + (not is_constnode(left) or + { however, there are some exceptions } + (not(resultdef.typ in [arraydef,recorddef,setdef,stringdef, + filedef,variantdef,objectdef]) or + is_class_or_interface_or_objc(resultdef) or + { the softfloat code generates casts <const. float> to record } + (nf_internal in flags) + )) + ) or + ( + is_void(left.resultdef) and + (left.nodetype=derefn) + ) + ) then + CGMessage2(type_e_illegal_type_conversion,left.resultdef.typename,resultdef.typename); + end; + end + else + IncompatibleTypes(left.resultdef,resultdef); + end; + + else + internalerror(200211231); + end; + end; + { Give hint or warning for unportable code, exceptions are + - typecasts from constants + - void } + if not(nf_internal in flags) and + (left.nodetype<>ordconstn) and + not(is_void(left.resultdef)) and + (((left.resultdef.typ=orddef) and + (resultdef.typ in [pointerdef,procvardef,classrefdef])) or + ((resultdef.typ=orddef) and + (left.resultdef.typ in [pointerdef,procvardef,classrefdef]))) then + begin + {Converting pointers to signed integers is a bad idea. Warn.} + warn_pointer_to_signed:=(resultdef.typ=orddef) and (Torddef(resultdef).ordtype in [s8bit,s16bit,s32bit,s64bit]); + { Give a warning when sizes don't match, because then info will be lost } + if left.resultdef.size=resultdef.size then + CGMessage(type_h_pointer_to_longint_conv_not_portable) + else + CGMessage(type_w_pointer_to_longint_conv_not_portable); + end; + + { tc_cord_2_pointer still requires a type check, which + simplify does not do } + if (convtype<>tc_cord_2_pointer) then + begin + result := simplify(false); + if assigned(result) then + exit; + end; + + { now call the resultdef helper to do constant folding } + result:=typecheck_call_helper(convtype); + end; + + +{$ifndef cpu64bitalu} + + { checks whether we can safely remove 64 bit typeconversions } + { in case range and overflow checking are off, and in case } + { the result of this node tree is downcasted again to a } + { 8/16/32 bit value afterwards } + function checkremove64bittypeconvs(n: tnode; out gotsint: boolean): boolean; + var + gotmuldivmod: boolean; + + { checks whether a node is either an u32bit, or originally } + { was one but was implicitly converted to s64bit } + function wasoriginallyint32(n: tnode): boolean; + begin + if (n.resultdef.typ<>orddef) then + exit(false); + if (torddef(n.resultdef).ordtype in [s32bit,u32bit]) then + begin + if (torddef(n.resultdef).ordtype=s32bit) then + gotsint:=true; + exit(true); + end; + if (torddef(n.resultdef).ordtype=s64bit) and + { nf_explicit is also set for explicitly typecasted } + { ordconstn's } + ([nf_internal,nf_explicit]*n.flags=[]) and + { either a typeconversion node coming from u32bit } + (((n.nodetype=typeconvn) and + (ttypeconvnode(n).left.resultdef.typ=orddef) and + (torddef(ttypeconvnode(n).left.resultdef).ordtype in [s32bit,u32bit])) or + { or an ordconstnode which was/is a valid cardinal } + ((n.nodetype=ordconstn) and + (tordconstnode(n).value>=int64(low(longint))) and + (tordconstnode(n).value<=high(cardinal)))) then + begin + if ((n.nodetype=typeconvn) and + (torddef(ttypeconvnode(n).left.resultdef).ordtype=s32bit)) or + ((n.nodetype=ordconstn) and + (tordconstnode(n).value<0)) then + gotsint:=true; + exit(true); + end; + result:=false; + end; + + + function docheckremove64bittypeconvs(n: tnode): boolean; + begin + result:=false; + if wasoriginallyint32(n) then + exit(true); + case n.nodetype of + subn,orn,xorn: + begin + { nf_internal is set by taddnode.typecheckpass in } + { case the arguments of this subn were u32bit, but } + { upcasted to s64bit for calculation correctness } + { (normally only needed when range checking, but } + { also done otherwise so there is no difference } + { in overload choosing etc between $r+ and $r-) } + if (nf_internal in n.flags) then + result:=true + else + result:= + docheckremove64bittypeconvs(tbinarynode(n).left) and + docheckremove64bittypeconvs(tbinarynode(n).right); + end; + addn,muln,divn,modn,andn: + begin + if n.nodetype in [muln,divn,modn] then + gotmuldivmod:=true; + result:= + docheckremove64bittypeconvs(tbinarynode(n).left) and + docheckremove64bittypeconvs(tbinarynode(n).right); + end; + end; + end; + + begin { checkremove64bittypeconvs } + gotmuldivmod:=false; + gotsint:=false; + result:= + docheckremove64bittypeconvs(n) and + not(gotmuldivmod and gotsint); + end; + + + procedure doremove64bittypeconvs(var n: tnode; todef: tdef; forceunsigned: boolean); + begin + case n.nodetype of + subn,addn,muln,divn,modn,xorn,andn,orn: + begin + exclude(n.flags,nf_internal); + if not forceunsigned and + is_signed(n.resultdef) then + begin + doremove64bittypeconvs(tbinarynode(n).left,s32inttype,false); + doremove64bittypeconvs(tbinarynode(n).right,s32inttype,false); + n.resultdef:=s32inttype + end + else + begin + doremove64bittypeconvs(tbinarynode(n).left,u32inttype,forceunsigned); + doremove64bittypeconvs(tbinarynode(n).right,u32inttype,forceunsigned); + n.resultdef:=u32inttype + end; + end; + ordconstn: + inserttypeconv_internal(n,todef); + typeconvn: + begin + n.resultdef:=todef; + ttypeconvnode(n).totypedef:=todef; + end; + end; + end; +{$endif not cpu64bitalu} + + + function ttypeconvnode.simplify(forinline : boolean): tnode; + var + hp: tnode; +{$ifndef cpu64bitalu} + foundsint: boolean; +{$endif not cpu64bitalu} + begin + result := nil; + { Constant folding and other node transitions to + remove the typeconv node } + case left.nodetype of + stringconstn : + if (convtype=tc_string_2_string) and + ( + ((not is_widechararray(left.resultdef) and + not is_wide_or_unicode_string(left.resultdef)) or + (tstringdef(resultdef).stringtype in [st_widestring,st_unicodestring,st_ansistring]) + ) + ) then + begin + { output string consts in local ansistring encoding } + if is_ansistring(resultdef) and ((tstringdef(resultdef).encoding=0)or(tstringdef(resultdef).encoding=globals.CP_NONE)) then + tstringconstnode(left).changestringtype(getansistringdef) + else + tstringconstnode(left).changestringtype(resultdef); + result:=left; + resultdef:=left.resultdef; + left:=nil; + exit; + end; + realconstn : + begin + if (convtype = tc_real_2_currency) then + result := typecheck_real_to_currency + else if (convtype = tc_real_2_real) then + result := typecheck_real_to_real + else + exit; + if not(assigned(result)) then + begin + result := left; + left := nil; + end; + if (result.nodetype = realconstn) then + begin + hp:=result; + result:=crealconstnode.create(trealconstnode(hp).value_real,resultdef); + if ([nf_explicit,nf_internal] * flags <> []) then + include(result.flags, nf_explicit); + hp.free; + end; + end; + niln : + begin + { nil to ordinal node } + if (resultdef.typ=orddef) then + begin + hp:=cordconstnode.create(0,resultdef,true); + if ([nf_explicit,nf_internal] * flags <> []) then + include(hp.flags, nf_explicit); + result:=hp; + exit; + end + else + { fold nil to any pointer type } + if (resultdef.typ=pointerdef) then + begin + hp:=cnilnode.create; + hp.resultdef:=resultdef; + if ([nf_explicit,nf_internal] * flags <> []) then + include(hp.flags, nf_explicit); + result:=hp; + exit; + end + else + { remove typeconv after niln, but not when the result is a + methodpointer. The typeconv of the methodpointer will then + take care of updateing size of niln to OS_64 } + if not((resultdef.typ=procvardef) and + not(tprocvardef(resultdef).is_addressonly)) then + begin + left.resultdef:=resultdef; + if ([nf_explicit,nf_internal] * flags <> []) then + include(left.flags, nf_explicit); + result:=left; + left:=nil; + exit; + end; + end; + + ordconstn : + begin + { ordinal contants can be directly converted } + { but not char to char because it is a widechar to char or via versa } + { which needs extra code to do the code page transistion } + { constant ordinal to pointer } + if (resultdef.typ=pointerdef) and + (convtype<>tc_cchar_2_pchar) then + begin + hp:=cpointerconstnode.create(TConstPtrUInt(tordconstnode(left).value.uvalue),resultdef); + if ([nf_explicit,nf_internal] * flags <> []) then + include(hp.flags, nf_explicit); + result:=hp; + exit; + end + else if is_ordinal(resultdef) and + not(convtype=tc_char_2_char) then + begin + { replace the resultdef and recheck the range } + if ([nf_explicit,nf_internal] * flags <> []) then + include(left.flags, nf_explicit) + else + { no longer an ordconst with an explicit typecast } + exclude(left.flags, nf_explicit); + { when converting from one boolean type to another, force } + { booleans to 0/1, and byte/word/long/qwordbool to 0/-1 } + { (Delphi-compatibile) } + if is_boolean(left.resultdef) and + is_boolean(resultdef) and + (is_cbool(left.resultdef) or + is_cbool(resultdef)) then + begin + if is_pasbool(resultdef) then + tordconstnode(left).value:=ord(tordconstnode(left).value<>0) + else +{$ifdef VER2_2} + tordconstnode(left).value:=ord(tordconstnode(left).value<>0); + tordconstnode(left).value:=-tordconstnode(left).value; +{$else} + tordconstnode(left).value:=-ord(tordconstnode(left).value<>0); +{$endif VER2_2} + end + else + testrange(resultdef,tordconstnode(left).value,(nf_explicit in flags),false); + left.resultdef:=resultdef; + tordconstnode(left).typedef:=resultdef; + result:=left; + left:=nil; + exit; + end; + end; + + pointerconstn : + begin + { pointerconstn to any pointer is folded too } + if (resultdef.typ=pointerdef) then + begin + left.resultdef:=resultdef; + if ([nf_explicit,nf_internal] * flags <> []) then + include(left.flags, nf_explicit) + else + { no longer an ordconst with an explicit typecast } + exclude(left.flags, nf_explicit); + result:=left; + left:=nil; + exit; + end + { constant pointer to ordinal } + else if is_ordinal(resultdef) then + begin + hp:=cordconstnode.create(TConstExprInt(tpointerconstnode(left).value), + resultdef,not(nf_explicit in flags)); + if ([nf_explicit,nf_internal] * flags <> []) then + include(hp.flags, nf_explicit); + result:=hp; + exit; + end; + end; + end; + +{$ifndef cpu64bitalu} + { must be done before code below, because we need the + typeconversions for ordconstn's as well } + case convtype of + tc_int_2_int: + begin + if (localswitches * [cs_check_range,cs_check_overflow] = []) and + (resultdef.typ in [pointerdef,orddef,enumdef]) and + (resultdef.size <= 4) and + is_64bitint(left.resultdef) and + (left.nodetype in [subn,addn,muln,divn,modn,xorn,andn,orn]) and + checkremove64bittypeconvs(left,foundsint) then + begin + { avoid unnecessary widening of intermediary calculations } + { to 64 bit } + doremove64bittypeconvs(left,generrordef,not foundsint); + end; + end; + end; +{$endif not cpu64bitalu} + + end; + + + procedure Ttypeconvnode.mark_write; + begin + left.mark_write; + end; + + function ttypeconvnode.first_cord_to_pointer : tnode; + + begin + result:=nil; + internalerror(200104043); + end; + + + function ttypeconvnode.first_int_to_int : tnode; + + begin + first_int_to_int:=nil; + expectloc:=left.expectloc; + if not is_void(left.resultdef) then + begin + if (left.expectloc<>LOC_REGISTER) and + ((resultdef.size>left.resultdef.size) or + (left.expectloc in [LOC_SUBSETREF,LOC_CSUBSETREF,LOC_SUBSETREG,LOC_CSUBSETREG])) then + expectloc:=LOC_REGISTER + else + if (left.expectloc=LOC_CREGISTER) and + (resultdef.size<left.resultdef.size) then + expectloc:=LOC_REGISTER; + end; + end; + + + function ttypeconvnode.first_cstring_to_pchar : tnode; + + begin + result:=nil; + expectloc:=LOC_REGISTER; + end; + + + function ttypeconvnode.first_cstring_to_int : tnode; + + begin + result:=nil; + internalerror(200510014); + end; + + + function ttypeconvnode.first_string_to_chararray : tnode; + + begin + first_string_to_chararray:=nil; + expectloc:=left.expectloc; + end; + + + function ttypeconvnode.first_char_to_string : tnode; + + begin + first_char_to_string:=nil; + expectloc:=LOC_REFERENCE; + end; + + + function ttypeconvnode.first_nothing : tnode; + begin + first_nothing:=nil; + end; + + + function ttypeconvnode.first_array_to_pointer : tnode; + + begin + first_array_to_pointer:=nil; + expectloc:=LOC_REGISTER; + end; + + + function ttypeconvnode.first_int_to_real: tnode; + var + fname: string[32]; + begin + if target_info.system in systems_wince then + begin + { converting a 64bit integer to a float requires a helper } + if is_64bitint(left.resultdef) or + is_currency(left.resultdef) then + begin + { hack to avoid double division by 10000, as it's + already done by typecheckpass.resultdef_int_to_real } + if is_currency(left.resultdef) then + left.resultdef := s64inttype; + if is_signed(left.resultdef) then + fname:='I64TO' + else + fname:='UI64TO'; + end + else + { other integers are supposed to be 32 bit } + begin + if is_signed(left.resultdef) then + fname:='ITO' + else + fname:='UTO'; + firstpass(left); + end; + if tfloatdef(resultdef).floattype=s64real then + fname:=fname+'D' + else + fname:=fname+'S'; + result:=ccallnode.createintern(fname,ccallparanode.create( + left,nil)); + left:=nil; + firstpass(result); + exit; + end + else + begin + { converting a 64bit integer to a float requires a helper } + if is_64bitint(left.resultdef) or + is_currency(left.resultdef) then + begin + { hack to avoid double division by 10000, as it's + already done by typecheckpass.resultdef_int_to_real } + if is_currency(left.resultdef) then + left.resultdef := s64inttype; + if is_signed(left.resultdef) then + fname:='int64_to_' + else + { we can't do better currently } + fname:='qword_to_'; + end + else + { other integers are supposed to be 32 bit } + begin + if is_signed(left.resultdef) then + fname:='int32_to_' + else + fname:='int64_to_'; + firstpass(left); + end; + if tfloatdef(resultdef).floattype=s64real then + fname:=fname+'float64' + else + fname:=fname+'float32'; + result:=ctypeconvnode.create_internal(ccallnode.createintern(fname,ccallparanode.create( + left,nil)),resultdef); + left:=nil; + firstpass(result); + exit; + end; + end; + + + function ttypeconvnode.first_real_to_real : tnode; + begin +{$ifdef cpufpemu} + if cs_fp_emulation in current_settings.moduleswitches then + begin + if target_info.system in systems_wince then + begin + case tfloatdef(left.resultdef).floattype of + s32real: + case tfloatdef(resultdef).floattype of + s64real: + result:=ccallnode.createintern('STOD',ccallparanode.create(left,nil)); + s32real: + begin + result:=left; + left:=nil; + end; + else + internalerror(2005082704); + end; + s64real: + case tfloatdef(resultdef).floattype of + s32real: + result:=ccallnode.createintern('DTOS',ccallparanode.create(left,nil)); + s64real: + begin + result:=left; + left:=nil; + end; + else + internalerror(2005082703); + end; + else + internalerror(2005082702); + end; + left:=nil; + firstpass(result); + exit; + end + else + begin + case tfloatdef(left.resultdef).floattype of + s32real: + case tfloatdef(resultdef).floattype of + s64real: + result:=ctypeconvnode.create_explicit(ccallnode.createintern('float32_to_float64',ccallparanode.create( + ctypeconvnode.create_internal(left,search_system_type('FLOAT32REC').typedef),nil)),resultdef); + s32real: + begin + result:=left; + left:=nil; + end; + else + internalerror(200610151); + end; + s64real: + case tfloatdef(resultdef).floattype of + s32real: + result:=ctypeconvnode.create_explicit(ccallnode.createintern('float64_to_float32',ccallparanode.create( + ctypeconvnode.create_internal(left,search_system_type('FLOAT64').typedef),nil)),resultdef); + s64real: + begin + result:=left; + left:=nil; + end; + else + internalerror(200610152); + end; + else + internalerror(200610153); + end; + left:=nil; + firstpass(result); + exit; + end; + end + else +{$endif cpufpemu} + begin + first_real_to_real:=nil; + if not use_vectorfpu(resultdef) then + expectloc:=LOC_FPUREGISTER + else + expectloc:=LOC_MMREGISTER; + end; + end; + + + function ttypeconvnode.first_pointer_to_array : tnode; + + begin + first_pointer_to_array:=nil; + expectloc:=LOC_REFERENCE; + end; + + + function ttypeconvnode.first_cchar_to_pchar : tnode; + + begin + first_cchar_to_pchar:=nil; + internalerror(200104021); + end; + + + function ttypeconvnode.first_bool_to_int : tnode; + + begin + first_bool_to_int:=nil; + { byte(boolean) or word(wordbool) or longint(longbool) must + be accepted for var parameters } + if (nf_explicit in flags) and + (left.resultdef.size=resultdef.size) and + (left.expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then + exit; + { when converting to 64bit, first convert to a 32bit int and then } + { convert to a 64bit int (only necessary for 32bit processors) (JM) } + if resultdef.size > sizeof(aint) then + begin + result := ctypeconvnode.create_internal(left,s32inttype); + result := ctypeconvnode.create(result,resultdef); + left := nil; + firstpass(result); + exit; + end; + expectloc:=LOC_REGISTER; + end; + + + function ttypeconvnode.first_int_to_bool : tnode; + + begin + first_int_to_bool:=nil; + { byte(boolean) or word(wordbool) or longint(longbool) must + be accepted for var parameters } + if (nf_explicit in flags) and + (left.resultdef.size=resultdef.size) and + (left.expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then + exit; + { when converting 64bit int to C-ctyle boolean, first convert to an int32 and then } + { convert to a boolean (only necessary for 32bit processors) } + if (left.resultdef.size > sizeof(aint)) and (left.resultdef.size<>resultdef.size) + and is_cbool(resultdef) then + begin + left:=ctypeconvnode.create_internal(left,s32inttype); + firstpass(left); + exit; + end; + expectloc:=LOC_REGISTER; + end; + + + function ttypeconvnode.first_bool_to_bool : tnode; + begin + first_bool_to_bool:=nil; + if (left.expectloc in [LOC_FLAGS,LOC_JUMP]) then + expectloc := left.expectloc + else + expectloc:=LOC_REGISTER; + end; + + + function ttypeconvnode.first_char_to_char : tnode; + var + fname: string[18]; + begin + if (torddef(resultdef).ordtype=uchar) and + (torddef(left.resultdef).ordtype=uwidechar) then + fname := 'fpc_uchar_to_char' + else if (torddef(resultdef).ordtype=uwidechar) and + (torddef(left.resultdef).ordtype=uchar) then + fname := 'fpc_char_to_uchar' + else + internalerror(2007081201); + + result := ccallnode.createintern(fname,ccallparanode.create(left,nil)); + left:=nil; + firstpass(result); + end; + + + function ttypeconvnode.first_proc_to_procvar : tnode; + begin + first_proc_to_procvar:=nil; + { if we take the address of a nested function, the current function/ + procedure needs a stack frame since it's required to construct + the nested procvar } + if is_nested_pd(tprocvardef(resultdef)) then + include(current_procinfo.flags,pi_needs_stackframe); + if tabstractprocdef(resultdef).is_addressonly then + expectloc:=LOC_REGISTER + else + begin + if not(left.expectloc in [LOC_CREFERENCE,LOC_REFERENCE]) then + CGMessage(parser_e_illegal_expression); + expectloc:=left.expectloc; + end; + end; + + + function ttypeconvnode.first_nil_to_methodprocvar : tnode; + begin + first_nil_to_methodprocvar:=nil; + expectloc:=LOC_REFERENCE; + end; + + + function ttypeconvnode.first_set_to_set : tnode; + var + newstatement : tstatementnode; + temp : ttempcreatenode; + begin + { in theory, we should do range checking here, + but Delphi doesn't do it either (FK) } + + if left.nodetype=setconstn then + begin + left.resultdef:=resultdef; + result:=left; + left:=nil; + end + { equal sets for the code generator? } + else if (left.resultdef.size=resultdef.size) and + (tsetdef(left.resultdef).setbase=tsetdef(resultdef).setbase) then + { TODO: This causes wrong (but Delphi-compatible) results for disjoint subsets} + { e.g., this prints true because of this: + var + sa: set of 1..2; + sb: set of 5..6; + b: byte; + begin + b:=1; + sa:=[1..2]; + sb:=sa; + writeln(b in sb); + end. + } + begin + result:=left; + left:=nil; + end + else + begin + result:=internalstatements(newstatement); + + { in case left is a smallset expression, it can be an addn or so. } + { fpc_varset_load expects a formal const parameter, which doesn't } + { accept set addn's -> assign to a temp first and pass the temp } + if not(left.expectloc in [LOC_REFERENCE,LOC_CREFERENCE]) then + begin + temp:=ctempcreatenode.create(left.resultdef,left.resultdef.size,tt_persistent,false); + addstatement(newstatement,temp); + { temp := left } + addstatement(newstatement,cassignmentnode.create( + ctemprefnode.create(temp),left)); + addstatement(newstatement,ctempdeletenode.create_normal_temp(temp)); + addstatement(newstatement,ctemprefnode.create(temp)); + left:=result; + firstpass(left); + { recreate the result's internalstatements list } + result:=internalstatements(newstatement); + end; + + { create temp for result } + temp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true); + addstatement(newstatement,temp); + + addstatement(newstatement,ccallnode.createintern('fpc_varset_load', + ccallparanode.create(cordconstnode.create(tsetdef(left.resultdef).setbase div 8 - tsetdef(resultdef).setbase div 8,sinttype,false), + ccallparanode.create(cordconstnode.create(resultdef.size,sinttype,false), + ccallparanode.create(ctemprefnode.create(temp), + ccallparanode.create(cordconstnode.create(left.resultdef.size,sinttype,false), + ccallparanode.create(left,nil)))))) + ); + addstatement(newstatement,ctempdeletenode.create_normal_temp(temp)); + addstatement(newstatement,ctemprefnode.create(temp)); + left:=nil; + end; + end; + + + function ttypeconvnode.first_ansistring_to_pchar : tnode; + begin + first_ansistring_to_pchar:=nil; + expectloc:=LOC_REGISTER; + end; + + + function ttypeconvnode.first_arrayconstructor_to_set : tnode; + begin + first_arrayconstructor_to_set:=nil; + internalerror(200104022); + end; + + + function ttypeconvnode.first_class_to_intf : tnode; + var + hd : tobjectdef; + ImplIntf : TImplementedInterface; + begin + result:=nil; + expectloc:=LOC_REGISTER; + hd:=tobjectdef(left.resultdef); + while assigned(hd) do + begin + ImplIntf:=hd.find_implemented_interface(tobjectdef(resultdef)); + if assigned(ImplIntf) then + begin + case ImplIntf.IType of + etStandard: + { handle in pass 2 } + ; + etFieldValue, etFieldValueClass: + if is_interface(tobjectdef(resultdef)) then + begin + result:=left; + propaccesslist_to_node(result,tpropertysym(implintf.implementsgetter).owner,tpropertysym(implintf.implementsgetter).propaccesslist[palt_read]); + { this ensures proper refcounting when field is of class type } + if not is_interface(result.resultdef) then + inserttypeconv(result, resultdef); + left:=nil; + end + else + begin + internalerror(200802213); + end; + etStaticMethodResult, etStaticMethodClass, + etVirtualMethodResult, etVirtualMethodClass: + if is_interface(tobjectdef(resultdef)) then + begin + { TODO: generating a call to TObject.GetInterface instead could yield + smaller code size. OTOH, refcounting gotchas are possible that way. } + { constructor create(l:tnode; v : tprocsym;st : TSymtable; mp: tnode; callflags:tcallnodeflags); } + result:=ccallnode.create(nil,tprocsym(tpropertysym(implintf.implementsgetter).propaccesslist[palt_read].firstsym^.sym), + tprocsym(tpropertysym(implintf.implementsgetter).propaccesslist[palt_read].firstsym^.sym).owner, + left,[]); + addsymref(tpropertysym(implintf.implementsgetter).propaccesslist[palt_read].firstsym^.sym); + { if it is a class, process it further in a similar way } + if not is_interface(result.resultdef) then + inserttypeconv(result, resultdef); + left:=nil; + end + else if is_class(tobjectdef(resultdef)) then + begin + internalerror(200802211); + end + else + internalerror(200802231); + else + internalerror(200802165); + end; + break; + end; + hd:=hd.childof; + end; + if hd=nil then + internalerror(200802164); + end; + + + function ttypeconvnode.first_string_to_string : tnode; + var + procname: string[31]; + newblock : tblocknode; + newstat : tstatementnode; + restemp : ttempcreatenode; + begin + { get the correct procedure name } + procname := 'fpc_'+tstringdef(left.resultdef).stringtypname+ + '_to_'+tstringdef(resultdef).stringtypname; + + if tstringdef(resultdef).stringtype=st_shortstring then + begin + newblock:=internalstatements(newstat); + restemp:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,false); + addstatement(newstat,restemp); + addstatement(newstat,ccallnode.createintern(procname,ccallparanode.create(left,ccallparanode.create( + ctemprefnode.create(restemp),nil)))); + addstatement(newstat,ctempdeletenode.create_normal_temp(restemp)); + addstatement(newstat,ctemprefnode.create(restemp)); + result:=newblock; + end + { encoding parameter required? } + else if (tstringdef(resultdef).stringtype=st_ansistring) and + (tstringdef(left.resultdef).stringtype in [st_widestring,st_unicodestring,st_shortstring,st_ansistring]) then + result:=ccallnode.createinternres(procname, + ccallparanode.create(cordconstnode.create(getparaencoding(resultdef),u16inttype,true), + ccallparanode.create(left,nil)),resultdef) + else + result:=ccallnode.createinternres(procname,ccallparanode.create(left,nil),resultdef); + + left:=nil; + end; + + + function ttypeconvnode._first_int_to_int : tnode; + begin + result:=first_int_to_int; + end; + + function ttypeconvnode._first_cstring_to_pchar : tnode; + begin + result:=first_cstring_to_pchar; + end; + + function ttypeconvnode._first_cstring_to_int : tnode; + begin + result:=first_cstring_to_int; + end; + + function ttypeconvnode._first_string_to_chararray : tnode; + begin + result:=first_string_to_chararray; + end; + + function ttypeconvnode._first_char_to_string : tnode; + begin + result:=first_char_to_string; + end; + + function ttypeconvnode._first_nothing : tnode; + begin + result:=first_nothing; + end; + + function ttypeconvnode._first_array_to_pointer : tnode; + begin + result:=first_array_to_pointer; + end; + + function ttypeconvnode._first_int_to_real : tnode; + begin + result:=first_int_to_real; + end; + + function ttypeconvnode._first_real_to_real : tnode; + begin + result:=first_real_to_real; + end; + + function ttypeconvnode._first_pointer_to_array : tnode; + begin + result:=first_pointer_to_array; + end; + + function ttypeconvnode._first_cchar_to_pchar : tnode; + begin + result:=first_cchar_to_pchar; + end; + + function ttypeconvnode._first_bool_to_int : tnode; + begin + result:=first_bool_to_int; + end; + + function ttypeconvnode._first_int_to_bool : tnode; + begin + result:=first_int_to_bool; + end; + + function ttypeconvnode._first_bool_to_bool : tnode; + begin + result:=first_bool_to_bool; + end; + + function ttypeconvnode._first_proc_to_procvar : tnode; + begin + result:=first_proc_to_procvar; + end; + + function ttypeconvnode._first_nil_to_methodprocvar : tnode; + begin + result:=first_nil_to_methodprocvar; + end; + + function ttypeconvnode._first_set_to_set : tnode; + begin + result:=first_set_to_set; + end; + + function ttypeconvnode._first_cord_to_pointer : tnode; + begin + result:=first_cord_to_pointer; + end; + + function ttypeconvnode._first_ansistring_to_pchar : tnode; + begin + result:=first_ansistring_to_pchar; + end; + + function ttypeconvnode._first_arrayconstructor_to_set : tnode; + begin + result:=first_arrayconstructor_to_set; + end; + + function ttypeconvnode._first_class_to_intf : tnode; + begin + result:=first_class_to_intf; + end; + + function ttypeconvnode._first_char_to_char : tnode; + begin + result:=first_char_to_char; + end; + + function ttypeconvnode._first_string_to_string : tnode; + begin + result:=first_string_to_string; + end; + + function ttypeconvnode.first_call_helper(c : tconverttype) : tnode; + + const + firstconvert : array[tconverttype] of pointer = ( + nil, { none } + @ttypeconvnode._first_nothing, {equal} + @ttypeconvnode._first_nothing, {not_possible} + @ttypeconvnode._first_string_to_string, + @ttypeconvnode._first_char_to_string, + @ttypeconvnode._first_nothing, { char_2_chararray, needs nothing extra } + nil, { removed in typecheck_chararray_to_string } + @ttypeconvnode._first_cchar_to_pchar, + @ttypeconvnode._first_cstring_to_pchar, + @ttypeconvnode._first_cstring_to_int, + @ttypeconvnode._first_ansistring_to_pchar, + @ttypeconvnode._first_string_to_chararray, + nil, { removed in typecheck_chararray_to_string } + @ttypeconvnode._first_array_to_pointer, + @ttypeconvnode._first_pointer_to_array, + @ttypeconvnode._first_int_to_int, + @ttypeconvnode._first_int_to_bool, + @ttypeconvnode._first_bool_to_bool, + @ttypeconvnode._first_bool_to_int, + @ttypeconvnode._first_real_to_real, + @ttypeconvnode._first_int_to_real, + nil, { removed in typecheck_real_to_currency } + @ttypeconvnode._first_proc_to_procvar, + @ttypeconvnode._first_nil_to_methodprocvar, + @ttypeconvnode._first_arrayconstructor_to_set, + @ttypeconvnode._first_set_to_set, + @ttypeconvnode._first_cord_to_pointer, + @ttypeconvnode._first_nothing, + @ttypeconvnode._first_nothing, + @ttypeconvnode._first_class_to_intf, + @ttypeconvnode._first_char_to_char, + @ttypeconvnode._first_nothing, + @ttypeconvnode._first_nothing, + nil, + nil, + nil, + nil, + nil, + nil, + nil + ); + type + tprocedureofobject = function : tnode of object; + var + r : packed record + proc : pointer; + obj : pointer; + end; + begin + { this is a little bit dirty but it works } + { and should be quite portable too } + r.proc:=firstconvert[c]; + r.obj:=self; + if not assigned(r.proc) then + internalerror(200312081); + first_call_helper:=tprocedureofobject(r)() + end; + + + function ttypeconvnode.pass_1 : tnode; + begin + if warn_pointer_to_signed then + cgmessage(type_w_pointer_to_signed); + result:=nil; + firstpass(left); + if codegenerror then + exit; + expectloc:=left.expectloc; + result:=first_call_helper(convtype); + end; + + + function ttypeconvnode.retains_value_location:boolean; + begin + result:=(convtype=tc_equal) or + { typecasting from void is always allowed } + is_void(left.resultdef) or + (left.resultdef.typ=formaldef) or + { int 2 int with same size reuses same location, or for + tp7 mode also allow size < orignal size } + ( + (convtype=tc_int_2_int) and + ( + not is_bitpacked_access(left) and + (resultdef.size=left.resultdef.size) or + ((m_tp7 in current_settings.modeswitches) and + (resultdef.size<left.resultdef.size)) + ) + ) or + { int 2 bool/bool 2 int, explicit typecast, see also nx86cnv } + ((convtype in [tc_int_2_bool,tc_bool_2_int,tc_bool_2_bool]) and + (nf_explicit in flags) and + (resultdef.size=left.resultdef.size)); + end; + + + function ttypeconvnode.assign_allowed:boolean; + begin + result:=retains_value_location; + + { When using only a part of the value it can't be in a register since + that will load the value in a new register first } + { the same goes for changing the sign of equal-sized values which + are smaller than an entire register } + if result and + (resultdef.size<left.resultdef.size) or + ((resultdef.size=left.resultdef.size) and + (left.resultdef.size<sizeof(aint)) and + (is_signed(resultdef) xor is_signed(left.resultdef))) then + make_not_regable(left,[ra_addr_regable]); + end; + + + function ttypeconvnode.docompare(p: tnode) : boolean; + begin + docompare := + inherited docompare(p) and + (convtype = ttypeconvnode(p).convtype) and + equal_defs(totypedef,ttypeconvnode(p).totypedef); + end; + + + procedure ttypeconvnode._second_int_to_int; + begin + second_int_to_int; + end; + + + procedure ttypeconvnode._second_string_to_string; + begin + second_string_to_string; + end; + + + procedure ttypeconvnode._second_cstring_to_pchar; + begin + second_cstring_to_pchar; + end; + + + procedure ttypeconvnode._second_cstring_to_int; + begin + second_cstring_to_int; + end; + + + procedure ttypeconvnode._second_string_to_chararray; + begin + second_string_to_chararray; + end; + + + procedure ttypeconvnode._second_array_to_pointer; + begin + second_array_to_pointer; + end; + + + procedure ttypeconvnode._second_pointer_to_array; + begin + second_pointer_to_array; + end; + + + procedure ttypeconvnode._second_chararray_to_string; + begin + second_chararray_to_string; + end; + + + procedure ttypeconvnode._second_char_to_string; + begin + second_char_to_string; + end; + + + procedure ttypeconvnode._second_int_to_real; + begin + second_int_to_real; + end; + + + procedure ttypeconvnode._second_real_to_real; + begin + second_real_to_real; + end; + + + procedure ttypeconvnode._second_cord_to_pointer; + begin + second_cord_to_pointer; + end; + + + procedure ttypeconvnode._second_proc_to_procvar; + begin + second_proc_to_procvar; + end; + + procedure ttypeconvnode._second_nil_to_methodprocvar; + begin + second_nil_to_methodprocvar; + end; + + procedure ttypeconvnode._second_bool_to_int; + begin + second_bool_to_int; + end; + + + procedure ttypeconvnode._second_int_to_bool; + begin + second_int_to_bool; + end; + + + procedure ttypeconvnode._second_bool_to_bool; + begin + second_bool_to_bool; + end; + + + procedure ttypeconvnode._second_set_to_set; + begin + second_set_to_set; + end; + + + procedure ttypeconvnode._second_ansistring_to_pchar; + begin + second_ansistring_to_pchar; + end; + + + procedure ttypeconvnode._second_class_to_intf; + begin + second_class_to_intf; + end; + + + procedure ttypeconvnode._second_char_to_char; + begin + second_char_to_char; + end; + + + procedure ttypeconvnode._second_nothing; + begin + second_nothing; + end; + + + procedure ttypeconvnode.second_call_helper(c : tconverttype); + const + secondconvert : array[tconverttype] of pointer = ( + @ttypeconvnode._second_nothing, {none} + @ttypeconvnode._second_nothing, {equal} + @ttypeconvnode._second_nothing, {not_possible} + @ttypeconvnode._second_nothing, {second_string_to_string, handled in resultdef pass } + @ttypeconvnode._second_char_to_string, + @ttypeconvnode._second_nothing, {char_to_charray} + @ttypeconvnode._second_nothing, { pchar_to_string, handled in resultdef pass } + @ttypeconvnode._second_nothing, {cchar_to_pchar} + @ttypeconvnode._second_cstring_to_pchar, + @ttypeconvnode._second_cstring_to_int, + @ttypeconvnode._second_ansistring_to_pchar, + @ttypeconvnode._second_string_to_chararray, + @ttypeconvnode._second_nothing, { chararray_to_string, handled in resultdef pass } + @ttypeconvnode._second_array_to_pointer, + @ttypeconvnode._second_pointer_to_array, + @ttypeconvnode._second_int_to_int, + @ttypeconvnode._second_int_to_bool, + @ttypeconvnode._second_bool_to_bool, + @ttypeconvnode._second_bool_to_int, + @ttypeconvnode._second_real_to_real, + @ttypeconvnode._second_int_to_real, + @ttypeconvnode._second_nothing, { real_to_currency, handled in resultdef pass } + @ttypeconvnode._second_proc_to_procvar, + @ttypeconvnode._second_nil_to_methodprocvar, + @ttypeconvnode._second_nothing, { arrayconstructor_to_set } + @ttypeconvnode._second_nothing, { second_set_to_set, handled in first pass } + @ttypeconvnode._second_cord_to_pointer, + @ttypeconvnode._second_nothing, { interface 2 string } + @ttypeconvnode._second_nothing, { interface 2 guid } + @ttypeconvnode._second_class_to_intf, + @ttypeconvnode._second_char_to_char, + @ttypeconvnode._second_nothing, { dynarray_2_openarray } + @ttypeconvnode._second_nothing, { pwchar_2_string } + @ttypeconvnode._second_nothing, { variant_2_dynarray } + @ttypeconvnode._second_nothing, { dynarray_2_variant} + @ttypeconvnode._second_nothing, { variant_2_enum } + @ttypeconvnode._second_nothing, { enum_2_variant } + @ttypeconvnode._second_nothing, { variant_2_interface } + @ttypeconvnode._second_nothing, { interface_2_variant } + @ttypeconvnode._second_nothing { array_2_dynarray } + ); + type + tprocedureofobject = procedure of object; + + var + r : packed record + proc : pointer; + obj : pointer; + end; + + begin + { this is a little bit dirty but it works } + { and should be quite portable too } + r.proc:=secondconvert[c]; + r.obj:=self; + tprocedureofobject(r)(); + end; + +{***************************************************************************** + TASNODE +*****************************************************************************} + + function tasisnode.pass_typecheck: tnode; + var + hp : tnode; + begin + result:=nil; + typecheckpass(right); + typecheckpass(left); + + set_varstate(right,vs_read,[vsf_must_be_valid]); + set_varstate(left,vs_read,[vsf_must_be_valid]); + + if codegenerror then + exit; + + if (right.resultdef.typ=classrefdef) then + begin + { left maybe an interface reference } + if is_interfacecom(left.resultdef) then + begin + { relation checks are not possible } + end + { or left must be a class } + else if is_class(left.resultdef) then + begin + { the operands must be related } + if (not(tobjectdef(left.resultdef).is_related( + tobjectdef(tclassrefdef(right.resultdef).pointeddef)))) and + (not(tobjectdef(tclassrefdef(right.resultdef).pointeddef).is_related( + tobjectdef(left.resultdef)))) then + CGMessage2(type_e_classes_not_related, + FullTypeName(left.resultdef,tclassrefdef(right.resultdef).pointeddef), + FullTypeName(tclassrefdef(right.resultdef).pointeddef,left.resultdef)); + end + else + CGMessage1(type_e_class_or_cominterface_type_expected,left.resultdef.typename); + case nodetype of + isn: + resultdef:=pasbool8type; + asn: + resultdef:=tclassrefdef(right.resultdef).pointeddef; + end; + end + else if is_interface(right.resultdef) or is_dispinterface(right.resultdef) then + begin + { left is a class } + if not(is_class(left.resultdef) or + is_interfacecom(left.resultdef)) then + CGMessage1(type_e_class_or_cominterface_type_expected,left.resultdef.typename); + + case nodetype of + isn: + resultdef:=pasbool8type; + asn: + resultdef:=right.resultdef; + end; + + { load the GUID of the interface } + if (right.nodetype=typen) then + begin + if tobjectdef(right.resultdef).objecttype=odt_interfacecorba then + begin + if assigned(tobjectdef(right.resultdef).iidstr) then + begin + hp:=cstringconstnode.createstr(tobjectdef(right.resultdef).iidstr^); + tstringconstnode(hp).changestringtype(cshortstringtype); + right.free; + right:=hp; + end + else + internalerror(201006131); + end + else + begin + if assigned(tobjectdef(right.resultdef).iidguid) then + begin + if not(oo_has_valid_guid in tobjectdef(right.resultdef).objectoptions) then + CGMessage1(type_e_interface_has_no_guid,tobjectdef(right.resultdef).typename); + hp:=cguidconstnode.create(tobjectdef(right.resultdef).iidguid^); + right.free; + right:=hp; + end + else + internalerror(201006132); + end; + typecheckpass(right); + end; + end + else + CGMessage1(type_e_class_or_interface_type_expected,right.resultdef.typename); + end; + +{***************************************************************************** + TISNODE +*****************************************************************************} + + constructor tisnode.create(l,r : tnode); + + begin + inherited create(isn,l,r); + end; + + function tisnode.pass_1 : tnode; + var + procname: string; + begin + result:=nil; + { Passing a class type to an "is" expression cannot result in a class + of that type to be constructed. + } + include(right.flags,nf_ignore_for_wpo); + + if is_class(left.resultdef) and + (right.resultdef.typ=classrefdef) then + result := ccallnode.createinternres('fpc_do_is', + ccallparanode.create(left,ccallparanode.create(right,nil)), + resultdef) + else + begin + if is_class(left.resultdef) then + if is_shortstring(right.resultdef) then + procname := 'fpc_class_is_corbaintf' + else + procname := 'fpc_class_is_intf' + else + if right.resultdef.typ=classrefdef then + procname := 'fpc_intf_is_class' + else + procname := 'fpc_intf_is'; + result := ctypeconvnode.create_internal(ccallnode.createintern(procname, + ccallparanode.create(right,ccallparanode.create(left,nil))),resultdef); + end; + left := nil; + right := nil; + //firstpass(call); + if codegenerror then + exit; + end; + + { dummy pass_2, it will never be called, but we need one since } + { you can't instantiate an abstract class } + procedure tisnode.pass_generate_code; + begin + end; + + +{***************************************************************************** + TASNODE +*****************************************************************************} + + constructor tasnode.create(l,r : tnode); + + begin + inherited create(asn,l,r); + call := nil; + end; + + + destructor tasnode.destroy; + + begin + call.free; + inherited destroy; + end; + + + function tasnode.dogetcopy: tnode; + begin + result := inherited dogetcopy; + if assigned(call) then + tasnode(result).call := call.getcopy + else + tasnode(result).call := nil; + end; + + + function tasnode.docompare(p: tnode): boolean; + begin + result:= + inherited docompare(p) and + tasnode(p).call.isequal(call); + end; + + + function tasnode.pass_1 : tnode; + var + procname: string; + begin + result:=nil; + { Passing a class type to an "as" expression cannot result in a class + of that type to be constructed. + } + include(right.flags,nf_ignore_for_wpo); + if not assigned(call) then + begin + if is_class(left.resultdef) and + (right.resultdef.typ=classrefdef) then + call := ccallnode.createinternres('fpc_do_as', + ccallparanode.create(left,ccallparanode.create(right,nil)), + resultdef) + else + begin + if is_class(left.resultdef) then + if is_shortstring(right.resultdef) then + procname := 'fpc_class_as_corbaintf' + else + procname := 'fpc_class_as_intf' + else + if right.resultdef.typ=classrefdef then + procname := 'fpc_intf_as_class' + else + procname := 'fpc_intf_as'; + call := ctypeconvnode.create_internal(ccallnode.createintern(procname, + ccallparanode.create(right,ccallparanode.create(left,nil))),resultdef); + end; + left := nil; + right := nil; + firstpass(call); + if codegenerror then + exit; + expectloc:=call.expectloc; + end; + end; + +end. diff --git a/closures/compiler/ncon.pas b/closures/compiler/ncon.pas new file mode 100644 index 0000000000..60141f3b61 --- /dev/null +++ b/closures/compiler/ncon.pas @@ -0,0 +1,1314 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + Type checking and register allocation for constants + + 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 ncon; + +{$i fpcdefs.inc} + +interface + + uses + globtype,widestr,constexp, + cclasses, + node, + aasmbase,aasmtai,aasmdata,cpuinfo,globals, + symconst,symtype,symdef,symsym; + + type + tdataconstnode = class(tnode) + data : tdynamicarray; + maxalign : word; + constructor create;virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + destructor destroy;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function dogetcopy : tnode;override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function docompare(p: tnode) : boolean; override; + procedure printnodedata(var t:text);override; + procedure append(const d;len : aint); + procedure appendbyte(b : byte); + procedure align(value : word); + end; + tdataconstnodeclass = class of tdataconstnode; + + trealconstnode = class(tnode) + typedef : tdef; + typedefderef : tderef; + value_real : bestreal; + value_currency : currency; + lab_real : tasmlabel; + constructor create(v : bestreal;def:tdef);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + function dogetcopy : tnode;override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function docompare(p: tnode) : boolean; override; + procedure printnodedata(var t:text);override; + end; + trealconstnodeclass = class of trealconstnode; + + tordconstnode = class(tnode) + typedef : tdef; + typedefderef : tderef; + value : TConstExprInt; + rangecheck : boolean; + { create an ordinal constant node of the specified type and value. + _rangecheck determines if the value of the ordinal should be checked + against the ranges of the type definition. + } + constructor create(v : tconstexprint;def:tdef; _rangecheck : boolean);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + function dogetcopy : tnode;override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function docompare(p: tnode) : boolean; override; + procedure printnodedata(var t:text);override; + end; + tordconstnodeclass = class of tordconstnode; + + tpointerconstnode = class(tnode) + typedef : tdef; + typedefderef : tderef; + value : TConstPtrUInt; + constructor create(v : TConstPtrUInt;def:tdef);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + function dogetcopy : tnode;override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function docompare(p: tnode) : boolean; override; + end; + tpointerconstnodeclass = class of tpointerconstnode; + + tconststringtype = ( + cst_conststring, + cst_shortstring, + cst_longstring, + cst_ansistring, + cst_widestring, + cst_unicodestring + ); + + tstringconstnode = class(tnode) + value_str : pchar; + len : longint; + lab_str : tasmlabel; + cst_type : tconststringtype; + constructor createstr(const s : string);virtual; + constructor createpchar(s : pchar;l : longint);virtual; + constructor createwstr(w : pcompilerwidestring);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + destructor destroy;override; + function dogetcopy : tnode;override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function getpcharcopy : pchar; + function docompare(p: tnode) : boolean; override; + procedure changestringtype(def:tdef); + function fullcompare(p: tstringconstnode): longint; + end; + tstringconstnodeclass = class of tstringconstnode; + + tsetconstnode = class(tunarynode) + typedef : tdef; + typedefderef : tderef; + value_set : pconstset; + lab_set : tasmlabel; + constructor create(s : pconstset;def:tdef);virtual; + destructor destroy;override; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + procedure adjustforsetbase; + function dogetcopy : tnode;override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function docompare(p: tnode) : boolean; override; + end; + tsetconstnodeclass = class of tsetconstnode; + + tnilnode = class(tnode) + constructor create;virtual; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + end; + tnilnodeclass = class of tnilnode; + + tguidconstnode = class(tnode) + value : tguid; + constructor create(const g:tguid);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function dogetcopy : tnode;override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function docompare(p: tnode) : boolean; override; + end; + tguidconstnodeclass = class of tguidconstnode; + + var + crealconstnode : trealconstnodeclass = trealconstnode; + cordconstnode : tordconstnodeclass = tordconstnode; + cpointerconstnode : tpointerconstnodeclass = tpointerconstnode; + cstringconstnode : tstringconstnodeclass = tstringconstnode; + csetconstnode : tsetconstnodeclass = tsetconstnode; + cguidconstnode : tguidconstnodeclass = tguidconstnode; + cnilnode : tnilnodeclass=tnilnode; + cdataconstnode : tdataconstnodeclass = tdataconstnode; + + function genintconstnode(v : TConstExprInt) : tordconstnode; + function genenumnode(v : tenumsym) : tordconstnode; + + { some helper routines } + function get_ordinal_value(p : tnode) : TConstExprInt; + function get_string_value(p : tnode; def: tstringdef) : tstringconstnode; + function is_constresourcestringnode(p : tnode) : boolean; + function is_emptyset(p : tnode):boolean; + function genconstsymtree(p : tconstsym) : tnode; + +implementation + + uses + cutils, + verbose,systems,sysutils, + defutil, + cpubase,cgbase, + nld; + + function genintconstnode(v : TConstExprInt) : tordconstnode; + var + htype : tdef; + begin + int_to_type(v,htype); + genintconstnode:=cordconstnode.create(v,htype,true); + end; + + + function genenumnode(v : tenumsym) : tordconstnode; + var + htype : tdef; + begin + htype:=v.definition; + genenumnode:=cordconstnode.create(int64(v.value),htype,true); + end; + + + function get_ordinal_value(p : tnode) : TConstExprInt; + begin + get_ordinal_value:=0; + if is_constnode(p) then + begin + if p.nodetype=ordconstn then + get_ordinal_value:=tordconstnode(p).value + else + Message(type_e_ordinal_expr_expected); + end + else + Message(type_e_constant_expr_expected); + end; + + function get_string_value(p: tnode; def: tstringdef): tstringconstnode; + var + stringVal: string; + pWideStringVal: pcompilerwidestring; + begin + if is_constcharnode(p) then + begin + SetLength(stringVal,1); + stringVal[1]:=char(tordconstnode(p).value.uvalue); + result:=cstringconstnode.createstr(stringVal); + end + else if is_constwidecharnode(p) then + begin + initwidestring(pWideStringVal); + concatwidestringchar(pWideStringVal, tcompilerwidechar(tordconstnode(p).value.uvalue)); + result:=cstringconstnode.createwstr(pWideStringVal); + end + else if is_conststringnode(p) then + result:=tstringconstnode(p.getcopy) + else + begin + Message(type_e_string_expr_expected); + stringVal:=''; + result:=cstringconstnode.createstr(stringVal); + end; + result.changestringtype(def); + end; + + + function is_constresourcestringnode(p : tnode) : boolean; + begin + is_constresourcestringnode:=(p.nodetype=loadn) and + (tloadnode(p).symtableentry.typ=constsym) and + (tconstsym(tloadnode(p).symtableentry).consttyp=constresourcestring); + end; + + + function is_emptyset(p : tnode):boolean; + begin + is_emptyset:=(p.nodetype=setconstn) and + (Tsetconstnode(p).value_set^=[]); + end; + + + function genconstsymtree(p : tconstsym) : tnode; + var + p1 : tnode; + len : longint; + pc : pchar; + begin + p1:=nil; + case p.consttyp of + constord : + begin + if p.constdef=nil then + internalerror(200403232); + p1:=cordconstnode.create(p.value.valueord,p.constdef,true); + end; + conststring : + begin + len:=p.value.len; + if not(cs_ansistrings in current_settings.localswitches) and (len>255) then + begin + message(parser_e_string_const_too_long); + len:=255; + end; + getmem(pc,len+1); + move(pchar(p.value.valueptr)^,pc^,len); + pc[len]:=#0; + p1:=cstringconstnode.createpchar(pc,len); + end; + constwstring : + p1:=cstringconstnode.createwstr(pcompilerwidestring(p.value.valueptr)); + constreal : + p1:=crealconstnode.create(pbestreal(p.value.valueptr)^,pbestrealtype^); + constset : + p1:=csetconstnode.create(pconstset(p.value.valueptr),p.constdef); + constpointer : + p1:=cpointerconstnode.create(p.value.valueordptr,p.constdef); + constnil : + p1:=cnilnode.create; + constguid : + p1:=cguidconstnode.create(pguid(p.value.valueptr)^); + else + internalerror(200205103); + end; + genconstsymtree:=p1; + end; + + +{***************************************************************************** + TDATACONSTNODE +*****************************************************************************} + + constructor tdataconstnode.create; + begin + inherited create(dataconstn); + data:=tdynamicarray.create(128); + end; + + + constructor tdataconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + var + len : tcgint; + buf : array[0..255] of byte; + begin + inherited ppuload(t,ppufile); + len:=ppufile.getaint; + if len<4096 then + data:=tdynamicarray.create(len) + else + data:=tdynamicarray.create(4096); + while len>0 do + begin + if len>sizeof(buf) then + begin + ppufile.getdata(buf,sizeof(buf)); + data.write(buf,sizeof(buf)); + dec(len,sizeof(buf)); + end + else + begin + ppufile.getdata(buf,len); + data.write(buf,len); + len:=0; + end; + end; + end; + + + destructor tdataconstnode.destroy; + begin + data.free; + inherited destroy; + end; + + + procedure tdataconstnode.ppuwrite(ppufile:tcompilerppufile); + var + len : tcgint; + buf : array[0..255] of byte; + begin + inherited ppuwrite(ppufile); + len:=data.size; + ppufile.putaint(len); + data.seek(0); + while len>0 do + begin + if len>sizeof(buf) then + begin + data.read(buf,sizeof(buf)); + ppufile.putdata(buf,sizeof(buf)); + dec(len,sizeof(buf)); + end + else + begin + data.read(buf,len); + ppufile.putdata(buf,len); + len:=0; + end; + end; + end; + + + function tdataconstnode.dogetcopy : tnode; + var + n : tdataconstnode; + len : tcgint; + buf : array[0..255] of byte; + begin + n:=tdataconstnode(inherited dogetcopy); + len:=data.size; + if len<4096 then + n.data:=tdynamicarray.create(len) + else + n.data:=tdynamicarray.create(4096); + data.seek(0); + while len>0 do + begin + if len>sizeof(buf) then + begin + data.read(buf,sizeof(buf)); + n.data.write(buf,sizeof(buf)); + dec(len,sizeof(buf)); + end + else + begin + data.read(buf,len); + n.data.write(buf,len); + len:=0; + end; + end; + dogetcopy := n; + end; + + + function tdataconstnode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_CREFERENCE; + end; + + + function tdataconstnode.pass_typecheck:tnode; + begin + result:=nil; + resultdef:=voidpointertype; + end; + + + function tdataconstnode.docompare(p: tnode) : boolean; + var + b1,b2 : byte; + I : longint; + begin + docompare := + inherited docompare(p) and (data.size=tdataconstnode(p).data.size); + if docompare then + begin + data.seek(0); + tdataconstnode(p).data.seek(0); + for i:=0 to data.size-1 do + begin + data.read(b1,1); + tdataconstnode(p).data.read(b2,1); + if b1<>b2 then + begin + docompare:=false; + exit; + end; + end; + end; + end; + + + procedure tdataconstnode.printnodedata(var t:text); + var + i : longint; + b : byte; + begin + inherited printnodedata(t); + write(t,printnodeindention,'data size = ',data.size,' data = '); + data.seek(0); + for i:=0 to data.size-1 do + begin + data.read(b,1); + if i=data.size-1 then + writeln(t,b) + else + write(t,b,','); + end; + end; + + + procedure tdataconstnode.append(const d;len : aint); + begin + data.seek(data.size); + data.write(d,len); + end; + + procedure tdataconstnode.appendbyte(b : byte); + begin + data.seek(data.size); + data.write(b,1); + end; + + procedure tdataconstnode.align(value : word); + begin + if value>maxalign then + maxalign:=value; + data.align(value); + end; + +{***************************************************************************** + TREALCONSTNODE +*****************************************************************************} + + { generic code } + { overridden by: } + { i386 } + constructor trealconstnode.create(v : bestreal;def:tdef); + begin + if current_settings.fputype=fpu_none then + internalerror(2008022401); + inherited create(realconstn); + typedef:=def; + value_real:=v; + value_currency:=v; + lab_real:=nil; + end; + + constructor trealconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + var + i : int64; + begin + inherited ppuload(t,ppufile); + ppufile.getderef(typedefderef); + value_real:=ppufile.getreal; + i:=ppufile.getint64; + value_currency:=PCurrency(@i)^; + lab_real:=tasmlabel(ppufile.getasmsymbol); + end; + + + procedure trealconstnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(typedefderef); + ppufile.putreal(value_real); + ppufile.putint64(PInt64(@value_currency)^); + ppufile.putasmsymbol(lab_real); + end; + + + procedure trealconstnode.buildderefimpl; + begin + inherited buildderefimpl; + typedefderef.build(typedef); + end; + + + procedure trealconstnode.derefimpl; + begin + inherited derefimpl; + typedef:=tdef(typedefderef.resolve); + end; + + + function trealconstnode.dogetcopy : tnode; + var + n : trealconstnode; + begin + n:=trealconstnode(inherited dogetcopy); + n.value_real:=value_real; + n.value_currency:=value_currency; + n.lab_real:=lab_real; + dogetcopy:=n; + end; + + function trealconstnode.pass_typecheck:tnode; + begin + result:=nil; + resultdef:=typedef; + end; + + function trealconstnode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_CREFERENCE; + end; + + function trealconstnode.docompare(p: tnode): boolean; + begin + docompare := + inherited docompare(p) and + (value_real = trealconstnode(p).value_real) and + { floating point compares for non-numbers give strange results usually } + is_number_float(value_real) and + is_number_float(trealconstnode(p).value_real); + end; + + + procedure Trealconstnode.printnodedata(var t:text); + begin + inherited printnodedata(t); + writeln(t,printnodeindention,'value = ',value_real); + end; + + +{***************************************************************************** + TORDCONSTNODE +*****************************************************************************} + + constructor tordconstnode.create(v : tconstexprint;def:tdef;_rangecheck : boolean); + + begin + inherited create(ordconstn); + value:=v; + typedef:=def; + rangecheck := _rangecheck; + end; + + + constructor tordconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + ppufile.getderef(typedefderef); + value:=ppufile.getexprint; + { normally, the value is already compiled, so we don't need + to do once again a range check + } + rangecheck := false; + end; + + + procedure tordconstnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(typedefderef); + ppufile.putexprint(value); + end; + + + procedure tordconstnode.buildderefimpl; + begin + inherited buildderefimpl; + typedefderef.build(typedef); + end; + + + procedure tordconstnode.derefimpl; + begin + inherited derefimpl; + typedef:=tdef(typedefderef.resolve); + end; + + + function tordconstnode.dogetcopy : tnode; + + var + n : tordconstnode; + + begin + n:=tordconstnode(inherited dogetcopy); + n.value:=value; + n.typedef := typedef; + dogetcopy:=n; + end; + + function tordconstnode.pass_typecheck:tnode; + begin + result:=nil; + resultdef:=typedef; + { only do range checking when explicitly asked for it + and if the type can be range checked, see tests/tbs/tb0539.pp } + if (resultdef.typ in [orddef,enumdef]) then + testrange(resultdef,value,not rangecheck,false) + end; + + function tordconstnode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_CONSTANT; + end; + + function tordconstnode.docompare(p: tnode): boolean; + begin + docompare := + inherited docompare(p) and + (value = tordconstnode(p).value); + end; + + + procedure Tordconstnode.printnodedata(var t:text); + begin + inherited printnodedata(t); + writeln(t,printnodeindention,'value = ',tostr(value)); + end; + + +{***************************************************************************** + TPOINTERCONSTNODE +*****************************************************************************} + + constructor tpointerconstnode.create(v : TConstPtrUInt;def:tdef); + + begin + inherited create(pointerconstn); + value:=v; + typedef:=def; + end; + + + constructor tpointerconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + ppufile.getderef(typedefderef); + value:=ppufile.getptruint; + end; + + + procedure tpointerconstnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(typedefderef); + ppufile.putptruint(value); + end; + + + procedure tpointerconstnode.buildderefimpl; + begin + inherited buildderefimpl; + typedefderef.build(typedef); + end; + + + procedure tpointerconstnode.derefimpl; + begin + inherited derefimpl; + typedef:=tdef(typedefderef.resolve); + end; + + + function tpointerconstnode.dogetcopy : tnode; + + var + n : tpointerconstnode; + + begin + n:=tpointerconstnode(inherited dogetcopy); + n.value:=value; + n.typedef := typedef; + dogetcopy:=n; + end; + + function tpointerconstnode.pass_typecheck:tnode; + begin + result:=nil; + resultdef:=typedef; + end; + + function tpointerconstnode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_CONSTANT; + end; + + function tpointerconstnode.docompare(p: tnode): boolean; + begin + docompare := + inherited docompare(p) and + (value = tpointerconstnode(p).value); + end; + + +{***************************************************************************** + TSTRINGCONSTNODE +*****************************************************************************} + + constructor tstringconstnode.createstr(const s : string); + var + l : longint; + begin + inherited create(stringconstn); + l:=length(s); + len:=l; + { stringdup write even past a #0 } + getmem(value_str,l+1); + move(s[1],value_str^,l); + value_str[l]:=#0; + lab_str:=nil; + cst_type:=cst_conststring; + end; + + + constructor tstringconstnode.createwstr(w : pcompilerwidestring); + begin + inherited create(stringconstn); + len:=getlengthwidestring(w); + initwidestring(pcompilerwidestring(value_str)); + copywidestring(w,pcompilerwidestring(value_str)); + lab_str:=nil; + cst_type:=cst_widestring; + end; + + + constructor tstringconstnode.createpchar(s : pchar;l : longint); + begin + inherited create(stringconstn); + len:=l; + value_str:=s; + cst_type:=cst_conststring; + lab_str:=nil; + end; + + + destructor tstringconstnode.destroy; + begin + if cst_type in [cst_widestring,cst_unicodestring] then + donewidestring(pcompilerwidestring(value_str)) + else + ansistringdispose(value_str,len); + inherited destroy; + end; + + + constructor tstringconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + var + pw : pcompilerwidestring; + i : longint; + begin + inherited ppuload(t,ppufile); + cst_type:=tconststringtype(ppufile.getbyte); + len:=ppufile.getlongint; + if cst_type in [cst_widestring,cst_unicodestring] then + begin + initwidestring(pw); + setlengthwidestring(pw,len); + { don't use getdata, because the compilerwidechars may have to + be byteswapped + } +{$if sizeof(tcompilerwidechar) = 2} + for i:=0 to pw^.len-1 do + pw^.data[i]:=ppufile.getword; +{$elseif sizeof(tcompilerwidechar) = 4} + for i:=0 to pw^.len-1 do + pw^.data[i]:=cardinal(ppufile.getlongint); +{$else} + {$error Unsupported tcompilerwidechar size} +{$endif} + pcompilerwidestring(value_str):=pw + end + else + begin + getmem(value_str,len+1); + ppufile.getdata(value_str^,len); + value_str[len]:=#0; + end; + lab_str:=tasmlabel(ppufile.getasmsymbol); + end; + + + procedure tstringconstnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putbyte(byte(cst_type)); + ppufile.putlongint(len); + if cst_type in [cst_widestring,cst_unicodestring] then + ppufile.putdata(pcompilerwidestring(value_str)^.data^,len*sizeof(tcompilerwidechar)) + else + ppufile.putdata(value_str^,len); + ppufile.putasmsymbol(lab_str); + end; + + + procedure tstringconstnode.buildderefimpl; + begin + inherited buildderefimpl; + end; + + + procedure tstringconstnode.derefimpl; + begin + inherited derefimpl; + end; + + + function tstringconstnode.dogetcopy : tnode; + + var + n : tstringconstnode; + + begin + n:=tstringconstnode(inherited dogetcopy); + n.cst_type:=cst_type; + n.len:=len; + n.lab_str:=lab_str; + if cst_type in [cst_widestring,cst_unicodestring] then + begin + initwidestring(pcompilerwidestring(n.value_str)); + copywidestring(pcompilerwidestring(value_str),pcompilerwidestring(n.value_str)); + end + else + n.value_str:=getpcharcopy; + dogetcopy:=n; + end; + + function tstringconstnode.pass_typecheck:tnode; + var + l : aint; + begin + result:=nil; + case cst_type of + cst_conststring : + begin + { handle and store as array[0..len-1] of char } + if len>0 then + l:=len-1 + else + l:=0; + resultdef:=tarraydef.create(0,l,s32inttype); + tarraydef(resultdef).elementdef:=cchartype; + include(tarraydef(resultdef).arrayoptions,ado_IsConstString); + end; + cst_shortstring : + resultdef:=cshortstringtype; + cst_ansistring : + resultdef:=getansistringdef; + cst_unicodestring : + resultdef:=cunicodestringtype; + cst_widestring : + resultdef:=cwidestringtype; + cst_longstring : + resultdef:=clongstringtype; + end; + end; + + function tstringconstnode.pass_1 : tnode; + begin + result:=nil; + if (cst_type in [cst_ansistring,cst_widestring,cst_unicodestring]) then + begin + if len=0 then + expectloc:=LOC_CONSTANT + else + expectloc:=LOC_REGISTER + end + else + expectloc:=LOC_CREFERENCE; + end; + + + function tstringconstnode.getpcharcopy : pchar; + var + pc : pchar; + begin + pc:=nil; + getmem(pc,len+1); + if pc=nil then + Message(general_f_no_memory_left); + move(value_str^,pc^,len+1); + getpcharcopy:=pc; + end; + + function tstringconstnode.docompare(p: tnode): boolean; + begin + docompare := + inherited docompare(p) and + (len = tstringconstnode(p).len) and + { Don't compare the pchars, since they may contain null chars } + { Since all equal constant strings are replaced by the same } + { label, the following compare should be enough (JM) } + (lab_str = tstringconstnode(p).lab_str); + end; + + + procedure tstringconstnode.changestringtype(def:tdef); + const + st2cst : array[tstringtype] of tconststringtype = ( + cst_shortstring,cst_longstring,cst_ansistring,cst_widestring,cst_unicodestring); + var + pw : pcompilerwidestring; + pc : pchar; + cp1 : tstringencoding; + cp2 : tstringencoding; + l,l2 : longint; + begin + if def.typ<>stringdef then + internalerror(200510011); + { convert ascii 2 unicode } + if (tstringdef(def).stringtype in [st_widestring,st_unicodestring]) and + not(cst_type in [cst_widestring,cst_unicodestring]) then + begin + initwidestring(pw); + ascii2unicode(value_str,len,current_settings.sourcecodepage,pw); + ansistringdispose(value_str,len); + pcompilerwidestring(value_str):=pw; + end + else + { convert unicode 2 ascii } + if (cst_type in [cst_widestring,cst_unicodestring]) and + not(tstringdef(def).stringtype in [st_widestring,st_unicodestring]) then + begin + cp1:=tstringdef(def).encoding; + if (cp1=CP_NONE) or (cp1=0) then + cp1:=current_settings.sourcecodepage; + if (cp1=CP_UTF8) then + begin + pw:=pcompilerwidestring(value_str); + l2:=len; + l:=UnicodeToUtf8(nil,0,PUnicodeChar(pw^.data),l2); + getmem(pc,l); + UnicodeToUtf8(pc,l,PUnicodeChar(pw^.data),l2); + len:=l-1; + donewidestring(pw); + value_str:=pc; + end + else + begin + pw:=pcompilerwidestring(value_str); + getmem(pc,getlengthwidestring(pw)+1); + unicode2ascii(pw,pc,cp1); + donewidestring(pw); + value_str:=pc; + end; + end + else + if (tstringdef(def).stringtype = st_ansistring) and + not(cst_type in [cst_widestring,cst_unicodestring]) then + begin + cp1:=tstringdef(def).encoding; + if cp1=0 then + cp1:=current_settings.sourcecodepage; + if (cst_type = cst_ansistring) then + begin + cp2:=tstringdef(resultdef).encoding; + if cp2=0 then + cp2:=current_settings.sourcecodepage; + end + else if (cst_type in [cst_shortstring,cst_conststring,cst_longstring]) then + cp2:=current_settings.sourcecodepage; + { don't change string if codepages are equal or string length is 0 } + if (cp1<>cp2) and (len>0) then + begin + if cpavailable(cp1) and cpavailable(cp2) then + changecodepage(value_str,len,cp2,value_str,cp1) + else if (cp1 <> CP_NONE) and (cp2 <> CP_NONE) then + begin + { if source encoding is UTF8 convert using UTF8->UTF16->destination encoding } + if (cp2=CP_UTF8) then + begin + if not cpavailable(cp1) then + Message1(option_code_page_not_available,IntToStr(cp1)); + initwidestring(pw); + setlengthwidestring(pw,len); + l:=Utf8ToUnicode(PUnicodeChar(pw^.data),len,value_str,len); + if (l<>getlengthwidestring(pw)) then + begin + setlengthwidestring(pw,l); + ReAllocMem(value_str,l); + end; + unicode2ascii(pw,value_str,cp1); + donewidestring(pw); + end + else + { if destination encoding is UTF8 convert using source encoding->UTF16->UTF8 } + if (cp1=CP_UTF8) then + begin + if not cpavailable(cp2) then + Message1(option_code_page_not_available,IntToStr(cp2)); + initwidestring(pw); + setlengthwidestring(pw,len); + ascii2unicode(value_str,len,cp2,pw); + l:=UnicodeToUtf8(nil,0,PUnicodeChar(pw^.data),len); + if l<>len then + ReAllocMem(value_str,l); + len:=l-1; + UnicodeToUtf8(value_str,PUnicodeChar(pw^.data),l); + donewidestring(pw); + end + else + begin + { output error message that encoding is not available for the compiler } + if not cpavailable(cp1) then + Message1(option_code_page_not_available,IntToStr(cp1)); + if not cpavailable(cp2) then + Message1(option_code_page_not_available,IntToStr(cp2)); + end; + end; + end; + end; + cst_type:=st2cst[tstringdef(def).stringtype]; + resultdef:=def; + end; + + function tstringconstnode.fullcompare(p: tstringconstnode): longint; + begin + if cst_type<>p.cst_type then + InternalError(2009121701); + if cst_type in [cst_widestring,cst_unicodestring] then + result:=comparewidestrings(pcompilerwidestring(value_str),pcompilerwidestring(p.value_str)) + else + result:=compareansistrings(value_str,p.value_str,len,p.len); + end; + +{***************************************************************************** + TSETCONSTNODE +*****************************************************************************} + + constructor tsetconstnode.create(s : pconstset;def:tdef); + + begin + inherited create(setconstn,nil); + typedef:=def; + if assigned(s) then + begin + new(value_set); + value_set^:=s^; + end + else + value_set:=nil; + end; + + destructor tsetconstnode.destroy; + begin + if assigned(value_set) then + dispose(value_set); + inherited destroy; + end; + + + constructor tsetconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + ppufile.getderef(typedefderef); + new(value_set); + ppufile.getnormalset(value_set^); + end; + + + procedure tsetconstnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(typedefderef); + ppufile.putnormalset(value_set^); + end; + + + procedure tsetconstnode.buildderefimpl; + begin + inherited buildderefimpl; + typedefderef.build(typedef); + end; + + + procedure tsetconstnode.derefimpl; + begin + inherited derefimpl; + typedef:=tdef(typedefderef.resolve); + end; + + + procedure tsetconstnode.adjustforsetbase; + type + setbytes = array[0..31] of byte; + Psetbytes = ^setbytes; + var + i, diff: longint; + begin + { Internally, the compiler stores all sets with setbase 0, so we have } + { to convert the set to its actual format in case setbase<>0 when } + { writing it out } + if (tsetdef(resultdef).setbase<>0) then + begin + if (tsetdef(resultdef).setbase and 7)<>0 then + internalerror(2007091501); + diff:=tsetdef(resultdef).setbase div 8; + { This is endian-neutral in the new set format: in both cases, } + { the first byte contains the first elements of the set. } + { Since the compiler/base rtl cannot contain packed sets before } + { they work for big endian, it's no problem that the code below } + { is wrong for the old big endian set format (setbase cannot be } + { <>0 with non-packed sets). } + for i:=0 to tsetdef(resultdef).size-1 do + begin + Psetbytes(value_set)^[i]:=Psetbytes(value_set)^[i+diff]; + Psetbytes(value_set)^[i+diff]:=0; + end; + end; + end; + + + + function tsetconstnode.dogetcopy : tnode; + + var + n : tsetconstnode; + + begin + n:=tsetconstnode(inherited dogetcopy); + if assigned(value_set) then + begin + new(n.value_set); + n.value_set^:=value_set^ + end + else + n.value_set:=nil; + n.typedef := typedef; + n.lab_set:=lab_set; + dogetcopy:=n; + end; + + function tsetconstnode.pass_typecheck:tnode; + begin + result:=nil; + resultdef:=typedef; + end; + + function tsetconstnode.pass_1 : tnode; + begin + result:=nil; + if is_smallset(resultdef) then + expectloc:=LOC_CONSTANT + else + expectloc:=LOC_CREFERENCE; + end; + + + function tsetconstnode.docompare(p: tnode): boolean; + begin + docompare:=(inherited docompare(p)) and + (value_set^=Tsetconstnode(p).value_set^); + end; + + +{***************************************************************************** + TNILNODE +*****************************************************************************} + + constructor tnilnode.create; + + begin + inherited create(niln); + end; + + function tnilnode.pass_typecheck:tnode; + begin + result:=nil; + resultdef:=voidpointertype; + end; + + function tnilnode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_CONSTANT; + end; + +{***************************************************************************** + TGUIDCONSTNODE +*****************************************************************************} + + constructor tguidconstnode.create(const g:tguid); + + begin + inherited create(guidconstn); + value:=g; + end; + + constructor tguidconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + ppufile.getguid(value); + end; + + + procedure tguidconstnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putguid(value); + end; + + + function tguidconstnode.dogetcopy : tnode; + + var + n : tguidconstnode; + + begin + n:=tguidconstnode(inherited dogetcopy); + n.value:=value; + dogetcopy:=n; + end; + + function tguidconstnode.pass_typecheck:tnode; + begin + result:=nil; + resultdef:=rec_tguid; + end; + + function tguidconstnode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_CREFERENCE; + end; + + function tguidconstnode.docompare(p: tnode): boolean; + begin + docompare := + inherited docompare(p) and + (guid2string(value) = guid2string(tguidconstnode(p).value)); + end; + +end. diff --git a/closures/compiler/nflw.pas b/closures/compiler/nflw.pas new file mode 100644 index 0000000000..b8c058422c --- /dev/null +++ b/closures/compiler/nflw.pas @@ -0,0 +1,2144 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Type checking and register allocation for nodes that influence + the flow + + 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 nflw; + +{$i fpcdefs.inc} + +interface + + uses + cclasses, + node,cpubase, + symnot, + symtype,symbase,symdef,symsym, + optloop; + + type + { flags used by loop nodes } + tloopflag = ( + { set if it is a for ... downto ... do loop } + lnf_backward, + { Do we need to parse childs to set var state? } + lnf_varstate, + { Do a test at the begin of the loop?} + lnf_testatbegin, + { Negate the loop test? } + lnf_checknegate, + { Should the value of the loop variable on exit be correct. } + lnf_dont_mind_loopvar_on_exit, + { Loop simplify flag } + lnf_simplify_processing); + tloopflags = set of tloopflag; + + const + { loop flags which must match to consider loop nodes equal regarding the flags } + loopflagsequal = [lnf_backward]; + + type + tlabelnode = class; + + tloopnode = class(tbinarynode) + t1,t2 : tnode; + loopflags : tloopflags; + constructor create(tt : tnodetype;l,r,_t1,_t2 : tnode);virtual; + destructor destroy;override; + function dogetcopy : tnode;override; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + procedure insertintolist(l : tnodelist);override; + procedure printnodetree(var t:text);override; + function docompare(p: tnode): boolean; override; + end; + + twhilerepeatnode = class(tloopnode) + constructor create(l,r:Tnode;tab,cn:boolean);virtual;reintroduce; + function pass_typecheck:tnode;override; + function pass_1 : tnode;override; +{$ifdef state_tracking} + function track_state_pass(exec_known:boolean):boolean;override; +{$endif} + end; + twhilerepeatnodeclass = class of twhilerepeatnode; + + tifnode = class(tloopnode) + constructor create(l,r,_t1 : tnode);virtual;reintroduce; + function pass_typecheck:tnode;override; + function pass_1 : tnode;override; + function simplify(forinline : boolean) : tnode;override; + private + function internalsimplify(warn: boolean) : tnode; + end; + tifnodeclass = class of tifnode; + + tfornode = class(tloopnode) + { if count isn divisable by unrolls then + the for loop must jump to this label to get the correct + number of executions } + entrylabel : tnode; + loopvar_notid:cardinal; + constructor create(l,r,_t1,_t2 : tnode;back : boolean);virtual;reintroduce; + procedure loop_var_access(not_type:Tnotification_flag;symbol:Tsym); + function pass_typecheck:tnode;override; + function pass_1 : tnode;override; + function simplify(forinline : boolean) : tnode;override; + end; + tfornodeclass = class of tfornode; + + texitnode = class(tunarynode) + constructor create(l:tnode);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function pass_typecheck:tnode;override; + function pass_1 : tnode;override; + end; + texitnodeclass = class of texitnode; + + tbreaknode = class(tnode) + constructor create;virtual; + function pass_typecheck:tnode;override; + function pass_1 : tnode;override; + end; + tbreaknodeclass = class of tbreaknode; + + tcontinuenode = class(tnode) + constructor create;virtual; + function pass_typecheck:tnode;override; + function pass_1 : tnode;override; + end; + tcontinuenodeclass = class of tcontinuenode; + + tgotonode = class(tnode) + private + labelnodeidx : longint; + public + labelsym : tlabelsym; + labelnode : tlabelnode; + exceptionblock : integer; + constructor create(p : tlabelsym);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + procedure resolveppuidx;override; + function dogetcopy : tnode;override; + function pass_typecheck:tnode;override; + function pass_1 : tnode;override; + function docompare(p: tnode): boolean; override; + end; + tgotonodeclass = class of tgotonode; + + tlabelnode = class(tunarynode) + exceptionblock : integer; + { when copying trees, this points to the newly created copy of a label } + copiedto : tlabelnode; + labsym : tlabelsym; + constructor create(l:tnode;alabsym:tlabelsym);virtual; + destructor destroy;override; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + function dogetcopy : tnode;override; + function pass_typecheck:tnode;override; + function pass_1 : tnode;override; + function docompare(p: tnode): boolean; override; + end; + tlabelnodeclass = class of tlabelnode; + + traisenode = class(ttertiarynode) + constructor create(l,taddr,tframe:tnode);virtual; + function pass_typecheck:tnode;override; + function pass_1 : tnode;override; + end; + traisenodeclass = class of traisenode; + + ttryexceptnode = class(tloopnode) + constructor create(l,r,_t1 : tnode);virtual;reintroduce; + function pass_typecheck:tnode;override; + function pass_1 : tnode;override; + end; + ttryexceptnodeclass = class of ttryexceptnode; + + ttryfinallynode = class(tloopnode) + implicitframe : boolean; + constructor create(l,r:tnode);virtual;reintroduce; + constructor create_implicit(l,r,_t1:tnode);virtual; + function pass_typecheck:tnode;override; + function pass_1 : tnode;override; + function simplify(forinline:boolean): tnode;override; + end; + ttryfinallynodeclass = class of ttryfinallynode; + + tonnode = class(tbinarynode) + excepTSymtable : TSymtable; + excepttype : tobjectdef; + constructor create(l,r:tnode);virtual; + destructor destroy;override; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + function pass_typecheck:tnode;override; + function pass_1 : tnode;override; + function dogetcopy : tnode;override; + function docompare(p: tnode): boolean; override; + end; + tonnodeclass = class of tonnode; + + var + cwhilerepeatnode : twhilerepeatnodeclass=twhilerepeatnode; + cifnode : tifnodeclass = tifnode; + cfornode : tfornodeclass = tfornode; + cexitnode : texitnodeclass = texitnode; + cgotonode : tgotonodeclass = tgotonode; + clabelnode : tlabelnodeclass = tlabelnode; + craisenode : traisenodeclass = traisenode; + ctryexceptnode : ttryexceptnodeclass = ttryexceptnode; + ctryfinallynode : ttryfinallynodeclass = ttryfinallynode; + connode : tonnodeclass = tonnode; + cbreaknode : tbreaknodeclass = tbreaknode; + ccontinuenode : tcontinuenodeclass = tcontinuenode; + + // for-in loop helpers + function create_type_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode; + function create_string_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode; + function create_array_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode; + function create_set_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode; + function create_enumerator_for_in_loop(hloopvar, hloopbody, expr: tnode; + enumerator_get, enumerator_move: tprocdef; enumerator_current: tpropertysym): tnode; + function create_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode; + +implementation + + uses + globtype,systems,constexp, + cutils,verbose,globals, + symconst,symtable,paramgr,defcmp,defutil,htypechk,pass_1, + ncal,nadd,ncon,nmem,nld,ncnv,nbas,cgobj,nutils,ninl,nset, + {$ifdef state_tracking} + nstate, + {$endif} + cgbase,procinfo + ; + + + // for-in loop helpers + + function create_type_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode; + begin + result:=cfornode.create(hloopvar, + cinlinenode.create(in_low_x,false,expr.getcopy), + cinlinenode.create(in_high_x,false,expr.getcopy), + hloopbody, + false); + end; + + + function create_objc_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode; + var + mainstatement, outerloopbodystatement, innerloopbodystatement, tempstatement: tstatementnode; + state, mutationcheck, currentamount, innerloopcounter, items, expressiontemp: ttempcreatenode; + outerloop, innerloop, hp: tnode; + itemsarraydef: tarraydef; + sym: tsym; + begin + { Objective-C enumerators require Objective-C 2.0 } + if not(m_objectivec2 in current_settings.modeswitches) then + begin + result:=cerrornode.create; + MessagePos(expr.fileinfo,parser_e_objc_enumerator_2_0); + exit; + end; + { Requires the NSFastEnumeration protocol and NSFastEnumerationState + record } + maybeloadcocoatypes; + if not assigned(objc_fastenumeration) or + not assigned(objc_fastenumerationstate) then + begin + result:=cerrornode.create; + MessagePos(expr.fileinfo,parser_e_objc_missing_enumeration_defs); + exit; + end; + + (* Original code: + for hloopvar in expression do + <hloopbody> + + Pascal code equivalent into which it has to be transformed + (sure would be nice if the compiler had some kind of templates ;) : + var + state: NSFastEnumerationState; + expressiontemp: NSFastEnumerationProtocol; + mutationcheck, + currentamount, + innerloopcounter: culong; + { size can be increased/decreased if desired } + items: array[1..16] of id; + begin + fillchar(state,sizeof(state),0); + expressiontemp:=expression; + repeat + currentamount:=expressiontemp.countByEnumeratingWithState_objects_count(@state,@items,length(items)); + if currentamount=0 then + begin + { "The iterating variable is set to nil when the loop ends by + exhausting the source pool of objects" } + hloopvar:=nil; + break; + end; + mutationcheck:=state.mutationsptr^; + innerloopcounter:=culong(-1); + repeat + { at the start so that "continue" in <loopbody> works correctly } + { don't use for-loop, because then the value of the iteration + counter is undefined on exit and we have to check it in the + outer repeat/until condition } + {$push} + {$r-,q-} + inc(innerloopcounter); + {$pop} + if innerloopcounter=currentamount then + break; + if mutationcheck<>state.mutationsptr^ then + { raises Objective-C exception... } + objc_enumerationMutation(expressiontemp); + hloopvar:=state.itemsPtr[innerloopcounter]; + { if continue in loopbody -> jumps to start, increases count and checks } + { if break in loopbody: goes to outer repeat/until and innerloopcount + will be < currentamount -> stops } + <hloopbody> + until false; + { if the inner loop terminated early, "break" was used and we have + to stop } + { "If the loop is terminated early, the iterating variable is left + pointing to the last iteration item." } + until innerloopcounter<currentamount; + end; + *) + + result:=internalstatements(mainstatement); + { the fast enumeration state } + state:=ctempcreatenode.create(objc_fastenumerationstate,objc_fastenumerationstate.size,tt_persistent,false); + typecheckpass(tnode(state)); + addstatement(mainstatement,state); + { the temporary items array } + itemsarraydef:=tarraydef.create(1,16,u32inttype); + itemsarraydef.elementdef:=objc_idtype; + items:=ctempcreatenode.create(itemsarraydef,itemsarraydef.size,tt_persistent,false); + addstatement(mainstatement,items); + typecheckpass(tnode(items)); + { temp for the expression/collection through which we iterate } + expressiontemp:=ctempcreatenode.create(objc_fastenumeration,objc_fastenumeration.size,tt_persistent,true); + addstatement(mainstatement,expressiontemp); + { currentamount temp (not really clean: we use ptruint instead of + culong) } + currentamount:=ctempcreatenode.create(ptruinttype,ptruinttype.size,tt_persistent,true); + typecheckpass(tnode(currentamount)); + addstatement(mainstatement,currentamount); + { mutationcheck temp (idem) } + mutationcheck:=ctempcreatenode.create(ptruinttype,ptruinttype.size,tt_persistent,true); + typecheckpass(tnode(mutationcheck)); + addstatement(mainstatement,mutationcheck); + { innerloopcounter temp (idem) } + innerloopcounter:=ctempcreatenode.create(ptruinttype,ptruinttype.size,tt_persistent,true); + typecheckpass(tnode(innerloopcounter)); + addstatement(mainstatement,innerloopcounter); + { initialise the state with 0 } + addstatement(mainstatement,ccallnode.createinternfromunit('SYSTEM','FILLCHAR', + ccallparanode.create(genintconstnode(0), + ccallparanode.create(genintconstnode(objc_fastenumerationstate.size), + ccallparanode.create(ctemprefnode.create(state),nil) + ) + ) + )); + { this will also check whether the expression (potentially) conforms + to the NSFastEnumeration protocol (use expr.getcopy, because the + caller will free expr) } + addstatement(mainstatement,cassignmentnode.create(ctemprefnode.create(expressiontemp),expr.getcopy)); + + { we add the "repeat..until" afterwards, now just create the body } + outerloop:=internalstatements(outerloopbodystatement); + { the countByEnumeratingWithState_objects_count call } + hp:=ccallparanode.create(cinlinenode.create(in_length_x,false,ctypenode.create(itemsarraydef)), + ccallparanode.create(caddrnode.create(ctemprefnode.create(items)), + ccallparanode.create(caddrnode.create(ctemprefnode.create(state)),nil) + ) + ); + sym:=search_struct_member(objc_fastenumeration,'COUNTBYENUMERATINGWITHSTATE_OBJECTS_COUNT'); + if not assigned(sym) or + (sym.typ<>procsym) then + internalerror(2010061901); + hp:=ccallnode.create(hp,tprocsym(sym),sym.owner,ctemprefnode.create(expressiontemp),[]); + addstatement(outerloopbodystatement,cassignmentnode.create( + ctemprefnode.create(currentamount),hp)); + { if currentamount = 0, bail out (use copy of hloopvar, because we + have to use it again below) } + hp:=internalstatements(tempstatement); + addstatement(tempstatement,cassignmentnode.create( + hloopvar.getcopy,cnilnode.create)); + addstatement(tempstatement,cbreaknode.create); + addstatement(outerloopbodystatement,cifnode.create( + caddnode.create(equaln,ctemprefnode.create(currentamount),genintconstnode(0)), + hp,nil)); + { initial value of mutationcheck } + hp:=ctemprefnode.create(state); + typecheckpass(hp); + hp:=cderefnode.create(genloadfield(hp,'MUTATIONSPTR')); + addstatement(outerloopbodystatement,cassignmentnode.create( + ctemprefnode.create(mutationcheck),hp)); + { initialise innerloopcounter } + addstatement(outerloopbodystatement,cassignmentnode.create( + ctemprefnode.create(innerloopcounter),cordconstnode.create(-1,ptruinttype,false))); + + { and now the inner loop, again adding the repeat/until afterwards } + innerloop:=internalstatements(innerloopbodystatement); + { inc(innerloopcounter) without range/overflowchecking (because + we go from culong(-1) to 0 during the first iteration } + hp:=cinlinenode.create( + in_inc_x,false,ccallparanode.create( + ctemprefnode.create(innerloopcounter),nil)); + hp.localswitches:=hp.localswitches-[cs_check_range,cs_check_overflow]; + addstatement(innerloopbodystatement,hp); + { if innerloopcounter=currentamount then break to the outer loop } + addstatement(innerloopbodystatement,cifnode.create( + caddnode.create(equaln, + ctemprefnode.create(innerloopcounter), + ctemprefnode.create(currentamount)), + cbreaknode.create, + nil)); + { verify that the collection didn't change in the mean time } + hp:=ctemprefnode.create(state); + typecheckpass(hp); + addstatement(innerloopbodystatement,cifnode.create( + caddnode.create(unequaln, + ctemprefnode.create(mutationcheck), + cderefnode.create(genloadfield(hp,'MUTATIONSPTR')) + ), + ccallnode.createinternfromunit('OBJC','OBJC_ENUMERATIONMUTATION', + ccallparanode.create(ctemprefnode.create(expressiontemp),nil)), + nil)); + { finally: actually get the next element } + hp:=ctemprefnode.create(state); + typecheckpass(hp); + hp:=genloadfield(hp,'ITEMSPTR'); + typecheckpass(hp); + { don't simply use a vecn, because indexing a pointer won't work in + non-FPC modes } + if hp.resultdef.typ<>pointerdef then + internalerror(2010061904); + inserttypeconv(hp, + tarraydef.create_from_pointer(tpointerdef(hp.resultdef).pointeddef)); + hp:=cvecnode.create(hp,ctemprefnode.create(innerloopcounter)); + addstatement(innerloopbodystatement, + cassignmentnode.create(hloopvar,hp)); + { the actual loop body! } + addstatement(innerloopbodystatement,hloopbody); + + { create the inner repeat/until and add it to the body of the outer + one } + hp:=cwhilerepeatnode.create( + { repeat .. until false } + cordconstnode.create(0,pasbool8type,false),innerloop,false,true); + addstatement(outerloopbodystatement,hp); + + { create the outer repeat/until and add it to the the main body } + hp:=cwhilerepeatnode.create( + { repeat .. until innerloopcounter<currentamount } + caddnode.create(ltn, + ctemprefnode.create(innerloopcounter), + ctemprefnode.create(currentamount)), + outerloop,false,true); + addstatement(mainstatement,hp); + + { release the temps } + addstatement(mainstatement,ctempdeletenode.create(state)); + addstatement(mainstatement,ctempdeletenode.create(mutationcheck)); + addstatement(mainstatement,ctempdeletenode.create(currentamount)); + addstatement(mainstatement,ctempdeletenode.create(innerloopcounter)); + addstatement(mainstatement,ctempdeletenode.create(items)); + addstatement(mainstatement,ctempdeletenode.create(expressiontemp)); + end; + + + function create_string_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode; + var + loopstatement, loopbodystatement: tstatementnode; + loopvar, stringvar: ttempcreatenode; + stringindex, loopbody, forloopnode: tnode; + begin + { result is a block of statements } + result:=internalstatements(loopstatement); + + { create a temp variable for expression } + stringvar := ctempcreatenode.create( + expr.resultdef, + expr.resultdef.size, + tt_persistent,true); + + addstatement(loopstatement,stringvar); + addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(stringvar),expr.getcopy)); + + { create a loop counter: signed integer with size of string length } + loopvar := ctempcreatenode.create( + sinttype, + sinttype.size, + tt_persistent,true); + + addstatement(loopstatement,loopvar); + + stringindex:=ctemprefnode.create(loopvar); + + loopbody:=internalstatements(loopbodystatement); + // for-in loop variable := string_expression[index] + addstatement(loopbodystatement, + cassignmentnode.create(hloopvar, cvecnode.create(ctemprefnode.create(stringvar),stringindex))); + + { add the actual statement to the loop } + addstatement(loopbodystatement,hloopbody); + + forloopnode:=cfornode.create(ctemprefnode.create(loopvar), + genintconstnode(1), + cinlinenode.create(in_length_x,false,ctemprefnode.create(stringvar)), + loopbody, + false); + + addstatement(loopstatement,forloopnode); + { free the loop counter } + addstatement(loopstatement,ctempdeletenode.create(loopvar)); + { free the temp variable for expression } + addstatement(loopstatement,ctempdeletenode.create(stringvar)); + end; + + + function create_array_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode; + var + loopstatement, loopbodystatement: tstatementnode; + loopvar, arrayvar: ttempcreatenode; + arrayindex, lowbound, highbound, loopbody, forloopnode, expression: tnode; + is_string: boolean; + tmpdef, convertdef: tdef; + elementcount: aword; + begin + expression := expr; + + { result is a block of statements } + result:=internalstatements(loopstatement); + + is_string:=ado_IsConstString in tarraydef(expr.resultdef).arrayoptions; + + // if array element type <> loovar type then create a conversion if possible + if compare_defs(tarraydef(expression.resultdef).elementdef,hloopvar.resultdef,nothingn)=te_incompatible then + begin + tmpdef:=expression.resultdef; + elementcount:=1; + while assigned(tmpdef) and (tmpdef.typ=arraydef) and + (tarraydef(tmpdef).arrayoptions = []) and + (compare_defs(tarraydef(tmpdef).elementdef,hloopvar.resultdef,nothingn)=te_incompatible) do + begin + elementcount:=elementcount*tarraydef(tmpdef).elecount; + tmpdef:=tarraydef(tmpdef).elementdef; + end; + if assigned(tmpdef) and (tmpdef.typ=arraydef) and (tarraydef(tmpdef).arrayoptions = []) then + begin + elementcount:=elementcount*tarraydef(tmpdef).elecount; + convertdef:=tarraydef.create(0,elementcount-1,s32inttype); + tarraydef(convertdef).elementdef:=tarraydef(tmpdef).elementdef; + expression:=expr.getcopy; + expression:=ctypeconvnode.create_internal(expression,convertdef); + typecheckpass(expression); + addstatement(loopstatement,expression); + end; + end; + + if (node_complexity(expression) > 1) and not is_open_array(expression.resultdef) then + begin + { create a temp variable for expression } + arrayvar := ctempcreatenode.create( + expression.resultdef, + expression.resultdef.size, + tt_persistent,true); + + if is_string then + begin + lowbound:=genintconstnode(1); + highbound:=cinlinenode.create(in_length_x,false,ctemprefnode.create(arrayvar)) + end + else + begin + lowbound:=cinlinenode.create(in_low_x,false,ctemprefnode.create(arrayvar)); + highbound:=cinlinenode.create(in_high_x,false,ctemprefnode.create(arrayvar)); + end; + + addstatement(loopstatement,arrayvar); + addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(arrayvar),expression.getcopy)); + end + else + begin + arrayvar:=nil; + if is_string then + begin + lowbound:=genintconstnode(1); + highbound:=cinlinenode.create(in_length_x,false,expression.getcopy); + end + else + begin + lowbound:=cinlinenode.create(in_low_x,false,expression.getcopy); + highbound:=cinlinenode.create(in_high_x,false,expression.getcopy); + end; + end; + + { create a loop counter } + loopvar := ctempcreatenode.create( + tarraydef(expression.resultdef).rangedef, + tarraydef(expression.resultdef).rangedef.size, + tt_persistent,true); + + addstatement(loopstatement,loopvar); + + arrayindex:=ctemprefnode.create(loopvar); + + loopbody:=internalstatements(loopbodystatement); + // for-in loop variable := array_expression[index] + if assigned(arrayvar) then + addstatement(loopbodystatement, + cassignmentnode.create(hloopvar,cvecnode.create(ctemprefnode.create(arrayvar),arrayindex))) + else + addstatement(loopbodystatement, + cassignmentnode.create(hloopvar,cvecnode.create(expression.getcopy,arrayindex))); + + { add the actual statement to the loop } + addstatement(loopbodystatement,hloopbody); + + forloopnode:=cfornode.create(ctemprefnode.create(loopvar), + lowbound, + highbound, + loopbody, + false); + + addstatement(loopstatement,forloopnode); + { free the loop counter } + addstatement(loopstatement,ctempdeletenode.create(loopvar)); + { free the temp variable for expression if needed } + if arrayvar<>nil then + addstatement(loopstatement,ctempdeletenode.create(arrayvar)); + end; + + + function create_set_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode; + var + loopstatement, loopbodystatement: tstatementnode; + loopvar, setvar: ttempcreatenode; + loopbody, forloopnode: tnode; + begin + // first check is set is empty and if it so then skip other processing + if not Assigned(tsetdef(expr.resultdef).elementdef) then + begin + result:=cnothingnode.create; + // free unused nodes + hloopvar.free; + hloopbody.free; + exit; + end; + { result is a block of statements } + result:=internalstatements(loopstatement); + + { create a temp variable for expression } + setvar := ctempcreatenode.create( + expr.resultdef, + expr.resultdef.size, + tt_persistent,true); + + addstatement(loopstatement,setvar); + addstatement(loopstatement,cassignmentnode.create(ctemprefnode.create(setvar),expr.getcopy)); + + { create a loop counter } + loopvar := ctempcreatenode.create( + tsetdef(expr.resultdef).elementdef, + tsetdef(expr.resultdef).elementdef.size, + tt_persistent,true); + + addstatement(loopstatement,loopvar); + + // if loopvar in set then + // begin + // hloopvar := loopvar + // for-in loop body + // end + + loopbody:=cifnode.create( + cinnode.create(ctemprefnode.create(loopvar),ctemprefnode.create(setvar)), + internalstatements(loopbodystatement), + nil); + + addstatement(loopbodystatement,cassignmentnode.create(hloopvar,ctemprefnode.create(loopvar))); + { add the actual statement to the loop } + addstatement(loopbodystatement,hloopbody); + + forloopnode:=cfornode.create(ctemprefnode.create(loopvar), + cinlinenode.create(in_low_x,false,ctemprefnode.create(setvar)), + cinlinenode.create(in_high_x,false,ctemprefnode.create(setvar)), + loopbody, + false); + + addstatement(loopstatement,forloopnode); + { free the loop counter } + addstatement(loopstatement,ctempdeletenode.create(loopvar)); + { free the temp variable for expression } + addstatement(loopstatement,ctempdeletenode.create(setvar)); + end; + + + function create_enumerator_for_in_loop(hloopvar, hloopbody, expr: tnode; + enumerator_get, enumerator_move: tprocdef; enumerator_current: tpropertysym): tnode; + var + loopstatement, loopbodystatement: tstatementnode; + enumvar: ttempcreatenode; + loopbody, whileloopnode, + enum_get, enum_move, enum_current, enum_get_params: tnode; + propaccesslist: tpropaccesslist; + enumerator_is_class: boolean; + enumerator_destructor: tprocdef; + begin + { result is a block of statements } + result:=internalstatements(loopstatement); + + enumerator_is_class := is_class(enumerator_get.returndef); + + { create a temp variable for enumerator } + enumvar := ctempcreatenode.create( + enumerator_get.returndef, + enumerator_get.returndef.size, + tt_persistent,true); + + addstatement(loopstatement,enumvar); + + if enumerator_get.proctypeoption=potype_operator then + begin + enum_get_params:=ccallparanode.create(expr.getcopy,nil); + enum_get:=ccallnode.create(enum_get_params, tprocsym(enumerator_get.procsym), nil, nil, []); + tcallnode(enum_get).procdefinition:=enumerator_get; + addsymref(enumerator_get.procsym); + end + else + enum_get:=ccallnode.create(nil, tprocsym(enumerator_get.procsym), enumerator_get.owner, expr.getcopy, []); + + addstatement(loopstatement, + cassignmentnode.create( + ctemprefnode.create(enumvar), + enum_get + )); + + loopbody:=internalstatements(loopbodystatement); + { for-in loop variable := enumerator.current } + if getpropaccesslist(enumerator_current,palt_read,propaccesslist) then + begin + case propaccesslist.firstsym^.sym.typ of + fieldvarsym : + begin + { generate access code } + enum_current:=ctemprefnode.create(enumvar); + propaccesslist_to_node(enum_current,enumerator_current.owner,propaccesslist); + include(enum_current.flags,nf_isproperty); + end; + procsym : + begin + { generate the method call } + enum_current:=ccallnode.create(nil,tprocsym(propaccesslist.firstsym^.sym),enumerator_current.owner,ctemprefnode.create(enumvar),[]); + include(enum_current.flags,nf_isproperty); + end + else + begin + enum_current:=cerrornode.create; + Message(type_e_mismatch); + end; + end; + end + else + enum_current:=cerrornode.create; + + addstatement(loopbodystatement, + cassignmentnode.create(hloopvar, enum_current)); + + { add the actual statement to the loop } + addstatement(loopbodystatement,hloopbody); + + enum_move:=ccallnode.create(nil, tprocsym(enumerator_move.procsym), enumerator_move.owner, ctemprefnode.create(enumvar), []); + whileloopnode:=cwhilerepeatnode.create(enum_move,loopbody,true,false); + + if enumerator_is_class then + begin + { insert a try-finally and call the destructor for the enumerator in the finally section } + enumerator_destructor:=tobjectdef(enumerator_get.returndef).find_destructor; + if assigned(enumerator_destructor) then + begin + whileloopnode:=ctryfinallynode.create( + whileloopnode, // try node + ccallnode.create(nil,tprocsym(enumerator_destructor.procsym), // finally node + enumerator_destructor.procsym.owner,ctemprefnode.create(enumvar),[])); + end; + { if getenumerator <> nil then do the loop } + whileloopnode:=cifnode.create( + caddnode.create(unequaln, ctemprefnode.create(enumvar), cnilnode.create), + whileloopnode, + nil); + end; + + addstatement(loopstatement, whileloopnode); + + if is_object(enumerator_get.returndef) then + begin + // call the object destructor too + enumerator_destructor:=tobjectdef(enumerator_get.returndef).find_destructor; + if assigned(enumerator_destructor) then + begin + addstatement(loopstatement, + ccallnode.create(nil,tprocsym(enumerator_destructor.procsym), + enumerator_destructor.procsym.owner,ctemprefnode.create(enumvar),[])); + end; + end; + + { free the temp variable for enumerator } + addstatement(loopstatement,ctempdeletenode.create(enumvar)); + end; + + + function create_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode; + var + pd, movenext: tprocdef; + helperdef: tobjectdef; + current: tpropertysym; + storefilepos: tfileposinfo; + begin + storefilepos:=current_filepos; + current_filepos:=hloopvar.fileinfo; + if expr.nodetype=typen then + begin + if (expr.resultdef.typ=enumdef) and tenumdef(expr.resultdef).has_jumps then + begin + result:=cerrornode.create; + hloopvar.free; + hloopbody.free; + MessagePos1(expr.fileinfo,parser_e_for_in_loop_cannot_be_used_for_the_type,expr.resultdef.typename); + end + else + result:=create_type_for_in_loop(hloopvar, hloopbody, expr); + end + else + begin + { loop is made for an expression } + // Objective-C uses different conventions (and it's only supported for Objective-C 2.0) + if is_objc_class_or_protocol(hloopvar.resultdef) or + is_objc_class_or_protocol(expr.resultdef) then + begin + result:=create_objc_for_in_loop(hloopvar,hloopbody,expr); + if result.nodetype=errorn then + begin + hloopvar.free; + hloopbody.free; + end; + end + else + begin + // search for operator first + pd:=search_enumerator_operator(expr.resultdef, hloopvar.resultdef); + // if there is no operator then search for class/object enumerator method + if (pd=nil) and (expr.resultdef.typ in [objectdef,recorddef]) then + begin + { first search using the helper hierarchy } + if search_last_objectpascal_helper(tabstractrecorddef(expr.resultdef),nil,helperdef) then + repeat + pd:=helperdef.search_enumerator_get; + helperdef:=helperdef.childof; + until (pd<>nil) or (helperdef=nil); + { we didn't find an enumerator in a helper, so search in the + class/record/object itself } + if pd=nil then + pd:=tabstractrecorddef(expr.resultdef).search_enumerator_get; + end; + if pd<>nil then + begin + // seach movenext and current symbols + movenext:=tabstractrecorddef(pd.returndef).search_enumerator_move; + if movenext = nil then + begin + result:=cerrornode.create; + hloopvar.free; + hloopbody.free; + MessagePos1(expr.fileinfo,sym_e_no_enumerator_move,pd.returndef.typename); + end + else + begin + current:=tpropertysym(tabstractrecorddef(pd.returndef).search_enumerator_current); + if current = nil then + begin + result:=cerrornode.create; + hloopvar.free; + hloopbody.free; + MessagePos1(expr.fileinfo,sym_e_no_enumerator_current,pd.returndef.typename); + end + else + result:=create_enumerator_for_in_loop(hloopvar, hloopbody, expr, pd, movenext, current); + end; + end + else + begin + case expr.resultdef.typ of + stringdef: result:=create_string_for_in_loop(hloopvar, hloopbody, expr); + arraydef: result:=create_array_for_in_loop(hloopvar, hloopbody, expr); + setdef: result:=create_set_for_in_loop(hloopvar, hloopbody, expr); + else + begin + result:=cerrornode.create; + hloopvar.free; + hloopbody.free; + MessagePos1(expr.fileinfo,sym_e_no_enumerator,expr.resultdef.typename); + end; + end; + end; + end; + end; + current_filepos:=storefilepos; + end; + +{**************************************************************************** + TLOOPNODE +*****************************************************************************} + + constructor tloopnode.create(tt : tnodetype;l,r,_t1,_t2 : tnode); + + begin + inherited create(tt,l,r); + t1:=_t1; + t2:=_t2; + fileinfo:=l.fileinfo; + end; + + destructor tloopnode.destroy; + + begin + t1.free; + t2.free; + inherited destroy; + end; + + + constructor tloopnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + t1:=ppuloadnode(ppufile); + t2:=ppuloadnode(ppufile); + ppufile.getsmallset(loopflags); + end; + + + procedure tloopnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppuwritenode(ppufile,t1); + ppuwritenode(ppufile,t2); + ppufile.putsmallset(loopflags); + end; + + + procedure tloopnode.buildderefimpl; + begin + inherited buildderefimpl; + if assigned(t1) then + t1.buildderefimpl; + if assigned(t2) then + t2.buildderefimpl; + end; + + + procedure tloopnode.derefimpl; + begin + inherited derefimpl; + if assigned(t1) then + t1.derefimpl; + if assigned(t2) then + t2.derefimpl; + end; + + + function tloopnode.dogetcopy : tnode; + + var + p : tloopnode; + + begin + p:=tloopnode(inherited dogetcopy); + if assigned(t1) then + p.t1:=t1.dogetcopy + else + p.t1:=nil; + if assigned(t2) then + p.t2:=t2.dogetcopy + else + p.t2:=nil; + p.loopflags:=loopflags; + dogetcopy:=p; + end; + + procedure tloopnode.insertintolist(l : tnodelist); + + begin + end; + + + procedure tloopnode.printnodetree(var t:text); + begin + write(t,printnodeindention,'('); + printnodeindent; + printnodeinfo(t); + writeln(t); + printnode(t,left); + printnode(t,right); + printnode(t,t1); + printnode(t,t2); + printnodeunindent; + writeln(t,printnodeindention,')'); + end; + + + function tloopnode.docompare(p: tnode): boolean; + begin + docompare := + inherited docompare(p) and + (loopflags*loopflagsequal=tloopnode(p).loopflags*loopflagsequal) and + t1.isequal(tloopnode(p).t1) and + t2.isequal(tloopnode(p).t2); + end; + +{**************************************************************************** + TWHILEREPEATNODE +*****************************************************************************} + + constructor Twhilerepeatnode.create(l,r:Tnode;tab,cn:boolean); + begin + inherited create(whilerepeatn,l,r,nil,nil); + if tab then + include(loopflags, lnf_testatbegin); + if cn then + include(loopflags,lnf_checknegate); + end; + + function twhilerepeatnode.pass_typecheck:tnode; + var + t:Tunarynode; + begin + result:=nil; + resultdef:=voidtype; + + typecheckpass(left); + + { tp procvar support } + maybe_call_procvar(left,true); + + {A not node can be removed.} + if left.nodetype=notn then + begin + t:=Tunarynode(left); + left:=Tunarynode(left).left; + t.left:=nil; + t.destroy; + {Symdif operator, in case you are wondering:} + loopflags:=loopflags >< [lnf_checknegate]; + end; + { loop instruction } + if assigned(right) then + typecheckpass(right); + set_varstate(left,vs_read,[vsf_must_be_valid]); + if codegenerror then + exit; + + if not(is_boolean(left.resultdef)) and + not(is_typeparam(left.resultdef)) then + begin + if left.resultdef.typ=variantdef then + inserttypeconv(left,pasbool8type) + else + CGMessage1(type_e_boolean_expr_expected,left.resultdef.typename); + end; + + { Give warnings for code that will never be executed for + while false do } + if (lnf_testatbegin in loopflags) and + (left.nodetype=ordconstn) and + (tordconstnode(left).value.uvalue=0) and + assigned(right) then + CGMessagePos(right.fileinfo,cg_w_unreachable_code); + end; + + +{$ifdef prefetchnext} + type + passignmentquery = ^tassignmentquery; + tassignmentquery = record + towhat: tnode; + source: tassignmentnode; + statementcount: cardinal; + end; + + function checkassignment(var n: tnode; arg: pointer): foreachnoderesult; + var + query: passignmentquery absolute arg; + temp, prederef: tnode; + begin + result := fen_norecurse_false; + if (n.nodetype in [assignn,inlinen,forn,calln,whilerepeatn,casen,ifn]) then + inc(query^.statementcount); + { make sure there's something else in the loop besides going to the } + { next item } + if (query^.statementcount > 1) and + (n.nodetype = assignn) then + begin + { skip type conversions of assignment target } + temp := tassignmentnode(n).left; + while (temp.nodetype = typeconvn) do + temp := ttypeconvnode(temp).left; + + { assignment to x of the while assigned(x) check? } + if not(temp.isequal(query^.towhat)) then + exit; + + { right hand side of assignment dereferenced field of } + { x? (no derefn in case of class) } + temp := tassignmentnode(n).right; + while (temp.nodetype = typeconvn) do + temp := ttypeconvnode(temp).left; + if (temp.nodetype <> subscriptn) then + exit; + + prederef := tsubscriptnode(temp).left; + temp := prederef; + while (temp.nodetype = typeconvn) do + temp := ttypeconvnode(temp).left; + + { see tests/test/prefetch1.pp } + if (temp.nodetype = derefn) then + temp := tderefnode(temp).left + else + temp := prederef; + + if temp.isequal(query^.towhat) then + begin + query^.source := tassignmentnode(n); + result := fen_norecurse_true; + end + end + { don't check nodes which can't contain an assignment or whose } + { final assignment can vary a lot } + else if not(n.nodetype in [calln,inlinen,casen,whilerepeatn,forn]) then + result := fen_false; + end; + + + function findassignment(where: tnode; towhat: tnode): tassignmentnode; + var + query: tassignmentquery; + begin + query.towhat := towhat; + query.source := nil; + query.statementcount := 0; + if foreachnodestatic(where,@checkassignment,@query) then + result := query.source + else + result := nil; + end; +{$endif prefetchnext} + + + function twhilerepeatnode.pass_1 : tnode; +{$ifdef prefetchnext} + var + runnernode, prefetchcode: tnode; + assignmentnode: tassignmentnode; + prefetchstatements: tstatementnode; +{$endif prefetchnext} + begin + result:=nil; + expectloc:=LOC_VOID; + + firstpass(left); + if codegenerror then + exit; + + { loop instruction } + if assigned(right) then + begin + firstpass(right); + if codegenerror then + exit; + end; + +{$ifdef prefetchnext} + { do at the end so all complex typeconversions are already } + { converted to calln's } + if (cs_opt_level1 in current_settings.optimizerswitches) and + (lnf_testatbegin in loopflags) then + begin + { get first component of the while check } + runnernode := left; + while (runnernode.nodetype in [andn,orn,notn,xorn,typeconvn]) do + runnernode := tunarynode(runnernode).left; + { is it an assigned(x) check? } + if ((runnernode.nodetype = inlinen) and + (tinlinenode(runnernode).inlinenumber = in_assigned_x)) or + ((runnernode.nodetype = unequaln) and + (taddnode(runnernode).right.nodetype = niln)) then + begin + runnernode := tunarynode(runnernode).left; + { in case of in_assigned_x, there's a callparan in between } + if (runnernode.nodetype = callparan) then + runnernode := tcallparanode(runnernode).left; + while (runnernode.nodetype = typeconvn) do + runnernode := ttypeconvnode(runnernode).left; + { is there an "x := x(^).somefield"? } + assignmentnode := findassignment(right,runnernode); + if assigned(assignmentnode) then + begin + prefetchcode := internalstatements(prefetchstatements); + addstatement(prefetchstatements,geninlinenode(in_prefetch_var,false, + cderefnode.create(ctypeconvnode.create(assignmentnode.right.getcopy,voidpointertype)))); + addstatement(prefetchstatements,right); + right := prefetchcode; + typecheckpass(right); + end; + end; + end; +{$endif prefetchnext} + end; + +{$ifdef state_tracking} + function Twhilerepeatnode.track_state_pass(exec_known:boolean):boolean; + + var condition:Tnode; + code:Tnode; + done:boolean; + value:boolean; + change:boolean; + firsttest:boolean; + factval:Tnode; + + begin + track_state_pass:=false; + done:=false; + firsttest:=true; + {For repeat until statements, first do a pass through the code.} + if not(lnf_testatbegin in flags) then + begin + code:=right.getcopy; + if code.track_state_pass(exec_known) then + track_state_pass:=true; + code.destroy; + end; + repeat + condition:=left.getcopy; + code:=right.getcopy; + change:=condition.track_state_pass(exec_known); + factval:=aktstate.find_fact(left); + if factval<>nil then + begin + condition.destroy; + condition:=factval.getcopy; + change:=true; + end; + if change then + begin + track_state_pass:=true; + {Force new resultdef pass.} + condition.resultdef:=nil; + do_typecheckpass(condition); + end; + if is_constboolnode(condition) then + begin + {Try to turn a while loop into a repeat loop.} + if firsttest then + exclude(flags,testatbegin); + value:=(Tordconstnode(condition).value<>0) xor checknegate; + if value then + begin + if code.track_state_pass(exec_known) then + track_state_pass:=true; + end + else + done:=true; + end + else + begin + {Remove any modified variables from the state.} + code.track_state_pass(false); + done:=true; + end; + code.destroy; + condition.destroy; + firsttest:=false; + until done; + {The loop condition is also known, for example: + while i<10 do + begin + ... + end; + + When the loop is done, we do know that i<10 = false. + } + condition:=left.getcopy; + if condition.track_state_pass(exec_known) then + begin + track_state_pass:=true; + {Force new resultdef pass.} + condition.resultdef:=nil; + do_typecheckpass(condition); + end; + if not is_constboolnode(condition) then + aktstate.store_fact(condition, + cordconstnode.create(byte(checknegate),pasbool8type,true)) + else + condition.destroy; + end; +{$endif} + +{***************************************************************************** + TIFNODE +*****************************************************************************} + + constructor tifnode.create(l,r,_t1 : tnode); + begin + inherited create(ifn,l,r,_t1,nil); + end; + + + function tifnode.internalsimplify(warn: boolean) : tnode; + begin + result:=nil; + { optimize constant expressions } + if (left.nodetype=ordconstn) then + begin + if tordconstnode(left).value.uvalue=1 then + begin + if assigned(right) then + result:=right + else + result:=cnothingnode.create; + right:=nil; + if warn and assigned(t1) then + CGMessagePos(t1.fileinfo,cg_w_unreachable_code); + end + else + begin + if assigned(t1) then + result:=t1 + else + result:=cnothingnode.create; + t1:=nil; + if warn and assigned(right) then + CGMessagePos(right.fileinfo,cg_w_unreachable_code); + end; + end; + end; + + + function tifnode.simplify(forinline : boolean) : tnode; + begin + result:=internalsimplify(false); + end; + + + function tifnode.pass_typecheck:tnode; + begin + result:=nil; + resultdef:=voidtype; + + typecheckpass(left); + + { tp procvar support } + maybe_call_procvar(left,true); + + { if path } + if assigned(right) then + typecheckpass(right); + { else path } + if assigned(t1) then + typecheckpass(t1); + set_varstate(left,vs_read,[vsf_must_be_valid]); + if codegenerror then + exit; + + if not(is_boolean(left.resultdef)) and + not(is_typeparam(left.resultdef)) then + begin + if left.resultdef.typ=variantdef then + inserttypeconv(left,pasbool8type) + else + Message1(type_e_boolean_expr_expected,left.resultdef.typename); + end; + result:=internalsimplify(true); + end; + + + function tifnode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_VOID; + firstpass(left); + + { if path } + if assigned(right) then + firstpass(right); + + { else path } + if assigned(t1) then + firstpass(t1); + + { leave if we've got an error in one of the paths } + + if codegenerror then + exit; + end; + + +{***************************************************************************** + TFORNODE +*****************************************************************************} + + constructor tfornode.create(l,r,_t1,_t2 : tnode;back : boolean); + + begin + inherited create(forn,l,r,_t1,_t2); + if back then + include(loopflags,lnf_backward); + include(loopflags,lnf_testatbegin); + end; + + procedure Tfornode.loop_var_access(not_type:Tnotification_flag; + symbol:Tsym); + + begin + {If there is a read access, the value of the loop counter is important; + at the end of the loop the loop variable should contain the value it + had in the last iteration.} + if not_type=vn_onwrite then + begin + writeln('Loopvar does not matter on exit'); + end + else + begin + exclude(loopflags,lnf_dont_mind_loopvar_on_exit); + writeln('Loopvar does matter on exit'); + end; + Tabstractvarsym(symbol).unregister_notification(loopvar_notid); + end; + + + function tfornode.simplify(forinline : boolean) : tnode; + begin + result:=nil; + if (t1.nodetype=ordconstn) and + (right.nodetype=ordconstn) and + ( + ( + (lnf_backward in loopflags) and + (tordconstnode(right).value<tordconstnode(t1).value) + ) or + ( + not(lnf_backward in loopflags) and + (tordconstnode(right).value>tordconstnode(t1).value) + ) + ) then + result:=cnothingnode.create; + end; + + + function tfornode.pass_typecheck:tnode; + var + res : tnode; + begin + result:=nil; + resultdef:=voidtype; + + { process the loopvar, from and to, varstates are already set } + typecheckpass(left); + typecheckpass(right); + typecheckpass(t1); + + set_varstate(left,vs_written,[]); + + { loop unrolling } + if cs_opt_loopunroll in current_settings.optimizerswitches then + begin + res:=unroll_loop(self); + if assigned(res) then + begin + typecheckpass(res); + result:=res; + exit; + end; + end; + + { Can we spare the first comparision? } + if (t1.nodetype=ordconstn) and + (right.nodetype=ordconstn) and + ( + ( + (lnf_backward in loopflags) and + (Tordconstnode(right).value>=Tordconstnode(t1).value) + ) or + ( + not(lnf_backward in loopflags) and + (Tordconstnode(right).value<=Tordconstnode(t1).value) + ) + ) then + exclude(loopflags,lnf_testatbegin); + + { Make sure that the loop var and the + from and to values are compatible types } + check_ranges(right.fileinfo,right,left.resultdef); + inserttypeconv(right,left.resultdef); + + check_ranges(t1.fileinfo,t1,left.resultdef); + inserttypeconv(t1,left.resultdef); + + if assigned(t2) then + typecheckpass(t2); + end; + + + function tfornode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_VOID; + + firstpass(left); + firstpass(right); + firstpass(t1); + + if assigned(t2) then + begin + firstpass(t2); + if codegenerror then + exit; + end; + end; + + +{***************************************************************************** + TEXITNODE +*****************************************************************************} + + constructor texitnode.create(l:tnode); + begin + inherited create(exitn,l); + if assigned(left) then + begin + { add assignment to funcretsym } + left:=ctypeconvnode.create(left,current_procinfo.procdef.returndef); + left:=cassignmentnode.create( + cloadnode.create(current_procinfo.procdef.funcretsym,current_procinfo.procdef.funcretsym.owner), + left); + end; + end; + + + constructor texitnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + end; + + + procedure texitnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + end; + + + function texitnode.pass_typecheck:tnode; + var + newstatement : tstatementnode; + begin + result:=nil; + if assigned(left) then + begin + result:=internalstatements(newstatement); + addstatement(newstatement,left); + left:=nil; + addstatement(newstatement,self.getcopy); + end; + resultdef:=voidtype; + end; + + + function texitnode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_VOID; + if assigned(left) then + internalerror(2011052801); + end; + + +{***************************************************************************** + TBREAKNODE +*****************************************************************************} + + constructor tbreaknode.create; + + begin + inherited create(breakn); + end; + + + function tbreaknode.pass_typecheck:tnode; + begin + result:=nil; + resultdef:=voidtype; + end; + + + function tbreaknode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_VOID; + end; + + +{***************************************************************************** + TCONTINUENODE +*****************************************************************************} + + constructor tcontinuenode.create; + begin + inherited create(continuen); + end; + + + function tcontinuenode.pass_typecheck:tnode; + begin + result:=nil; + resultdef:=voidtype; + end; + + + function tcontinuenode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_VOID; + end; + + +{***************************************************************************** + TGOTONODE +*****************************************************************************} + + constructor tgotonode.create(p : tlabelsym); + begin + inherited create(goton); + exceptionblock:=current_exceptblock; + labelnode:=nil; + labelsym:=p; + end; + + + constructor tgotonode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + labelnodeidx:=ppufile.getlongint; + exceptionblock:=ppufile.getbyte; + end; + + + procedure tgotonode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + labelnodeidx:=labelnode.ppuidx; + ppufile.putlongint(labelnodeidx); + ppufile.putbyte(exceptionblock); + end; + + + procedure tgotonode.buildderefimpl; + begin + inherited buildderefimpl; + end; + + + procedure tgotonode.derefimpl; + begin + inherited derefimpl; + end; + + + procedure tgotonode.resolveppuidx; + begin + labelnode:=tlabelnode(nodeppuidxget(labelnodeidx)); + if labelnode.nodetype<>labeln then + internalerror(200809021); + end; + + + function tgotonode.pass_typecheck:tnode; + begin + result:=nil; + resultdef:=voidtype; + end; + + + function tgotonode.pass_1 : tnode; + var + p2 : tprocinfo; + begin + result:=nil; + expectloc:=LOC_VOID; + + { The labelnode can already be set when + this node was copied } + if not(assigned(labelnode)) then + begin + { inner procedure goto? } + if assigned(labelsym.code) and + ((assigned(labelsym.owner) and (current_procinfo.procdef.parast.symtablelevel=labelsym.owner.symtablelevel)) or + { generated by the optimizer? } + not(assigned(labelsym.owner))) then + labelnode:=tlabelnode(labelsym.code) + else if (m_non_local_goto in current_settings.modeswitches) and + assigned(labelsym.owner) then + begin + if current_procinfo.procdef.parast.symtablelevel>labelsym.owner.symtablelevel then + begin + { don't mess with the exception blocks, global gotos in/out side exception blocks are not allowed } + if exceptionblock>0 then + CGMessage(cg_e_goto_inout_of_exception_block); + + { goto across procedures using exception? + this is not allowed because we cannot + easily unwind the exception frame + stack + } + p2:=current_procinfo; + while true do + begin + if (p2.flags*[pi_needs_implicit_finally,pi_uses_exceptions,pi_has_implicit_finally])<>[] then + Message(cg_e_goto_across_procedures_with_exceptions_not_allowed); + if labelsym.owner=p2.procdef.localst then + break; + p2:=p2.parent + end; + + if assigned(labelsym.jumpbuf) then + begin + labelsym.nonlocal:=true; + result:=ccallnode.createintern('fpc_longjmp', + ccallparanode.create(cordconstnode.create(1,sinttype,true), + ccallparanode.create(cloadnode.create(labelsym.jumpbuf,labelsym.jumpbuf.owner), + nil))); + end + else + CGMessage1(cg_e_goto_label_not_found,labelsym.realname); + end + else + CGMessage(cg_e_interprocedural_goto_only_to_outer_scope_allowed); + end + else + CGMessage1(cg_e_goto_label_not_found,labelsym.realname); + end; + + { check if we don't mess with exception blocks } + if assigned(labelnode) and + (exceptionblock<>labelnode.exceptionblock) then + CGMessage(cg_e_goto_inout_of_exception_block); + end; + + + function tgotonode.dogetcopy : tnode; + var + p : tgotonode; + begin + p:=tgotonode(inherited dogetcopy); + p.exceptionblock:=exceptionblock; + + { generate labelnode if not done yet } + if not(assigned(labelnode)) then + begin + if assigned(labelsym) and assigned(labelsym.code) then + labelnode:=tlabelnode(labelsym.code) + end; + + p.labelsym:=labelsym; + if assigned(labelnode) then + p.labelnode:=tlabelnode(labelnode.dogetcopy) + else + begin + { don't trigger IE when there was already an error, i.e. the + label is not defined. See tw11763 (PFV) } + if errorcount=0 then + internalerror(200610291); + end; + result:=p; + end; + + + function tgotonode.docompare(p: tnode): boolean; + begin + docompare := false; + end; + + +{***************************************************************************** + TLABELNODE +*****************************************************************************} + + constructor tlabelnode.create(l:tnode;alabsym:tlabelsym); + begin + inherited create(labeln,l); + exceptionblock:=current_exceptblock; + labsym:=alabsym; + { Register labelnode in labelsym } + labsym.code:=self; + end; + + + constructor tlabelnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + exceptionblock:=ppufile.getbyte; + end; + + + destructor tlabelnode.destroy; + begin + { Remove reference in labelsym, this is to prevent + goto's to this label } + if assigned(labsym) and (labsym.code=pointer(self)) then + labsym.code:=nil; + inherited destroy; + end; + + + procedure tlabelnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putbyte(exceptionblock); + end; + + + procedure tlabelnode.buildderefimpl; + begin + inherited buildderefimpl; + end; + + + procedure tlabelnode.derefimpl; + begin + inherited derefimpl; + end; + + + function tlabelnode.pass_typecheck:tnode; + begin + result:=nil; + { left could still be unassigned } + if assigned(left) then + typecheckpass(left); + resultdef:=voidtype; + end; + + + function tlabelnode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_VOID; + + include(current_procinfo.flags,pi_has_label); + + if assigned(labsym) and labsym.nonlocal then + include(current_procinfo.flags,pi_has_interproclabel); + + if assigned(left) then + firstpass(left); + if (m_non_local_goto in current_settings.modeswitches) and + (current_procinfo.procdef.parast.symtablelevel<>labsym.owner.symtablelevel) then + CGMessage(cg_e_labels_cannot_defined_outside_declaration_scope) + end; + + + function tlabelnode.dogetcopy : tnode; + begin + if not(assigned(copiedto)) then + copiedto:=tlabelnode(inherited dogetcopy); + copiedto.exceptionblock:=exceptionblock; + + result:=copiedto; + end; + + + function tlabelnode.docompare(p: tnode): boolean; + begin + docompare := false; + end; + + +{***************************************************************************** + TRAISENODE +*****************************************************************************} + + constructor traisenode.create(l,taddr,tframe:tnode); + begin + inherited create(raisen,l,taddr,tframe); + end; + + + function traisenode.pass_typecheck:tnode; + begin + result:=nil; + resultdef:=voidtype; + if assigned(left) then + begin + { first para must be a _class_ } + typecheckpass(left); + set_varstate(left,vs_read,[vsf_must_be_valid]); + if codegenerror then + exit; + if not(is_class(left.resultdef)) then + CGMessage1(type_e_class_type_expected,left.resultdef.typename); + { insert needed typeconvs for addr,frame } + if assigned(right) then + begin + { addr } + typecheckpass(right); + inserttypeconv(right,voidpointertype); + { frame } + if assigned(third) then + begin + typecheckpass(third); + inserttypeconv(third,voidpointertype); + end; + end; + end; + end; + + + function traisenode.pass_1 : tnode; + begin + result:=nil; + include(current_procinfo.flags,pi_do_call); + expectloc:=LOC_VOID; + if assigned(left) then + begin + { first para must be a _class_ } + firstpass(left); + { insert needed typeconvs for addr,frame } + if assigned(right) then + begin + { addr } + firstpass(right); + { frame } + if assigned(third) then + firstpass(third); + end; + end; + end; + + +{***************************************************************************** + TTRYEXCEPTNODE +*****************************************************************************} + + constructor ttryexceptnode.create(l,r,_t1 : tnode); + begin + inherited create(tryexceptn,l,r,_t1,nil); + end; + + + function ttryexceptnode.pass_typecheck:tnode; + begin + result:=nil; + typecheckpass(left); + { on statements } + if assigned(right) then + typecheckpass(right); + { else block } + if assigned(t1) then + typecheckpass(t1); + resultdef:=voidtype; + end; + + + function ttryexceptnode.pass_1 : tnode; + begin + result:=nil; + include(current_procinfo.flags,pi_do_call); + include(current_procinfo.flags,pi_uses_exceptions); + expectloc:=LOC_VOID; + firstpass(left); + { on statements } + if assigned(right) then + firstpass(right); + { else block } + if assigned(t1) then + firstpass(t1); + end; + + +{***************************************************************************** + TTRYFINALLYNODE +*****************************************************************************} + + constructor ttryfinallynode.create(l,r:tnode); + begin + inherited create(tryfinallyn,l,r,nil,nil); + include(current_procinfo.flags,pi_uses_exceptions); + implicitframe:=false; + end; + + + constructor ttryfinallynode.create_implicit(l,r,_t1:tnode); + begin + inherited create(tryfinallyn,l,r,_t1,nil); + implicitframe:=true; + end; + + + function ttryfinallynode.pass_typecheck:tnode; + begin + result:=nil; + include(current_procinfo.flags,pi_do_call); + resultdef:=voidtype; + + typecheckpass(left); + // "try block" is "used"? (JM) + set_varstate(left,vs_readwritten,[vsf_must_be_valid]); + + typecheckpass(right); + // "except block" is "used"? (JM) + set_varstate(right,vs_readwritten,[vsf_must_be_valid]); + + { special finally block only executed when there was an exception } + if assigned(t1) then + begin + typecheckpass(t1); + // "finally block" is "used"? (JM) + set_varstate(t1,vs_readwritten,[vsf_must_be_valid]); + end; + end; + + + function ttryfinallynode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_VOID; + firstpass(left); + + firstpass(right); + + if assigned(t1) then + firstpass(t1); + end; + + + function ttryfinallynode.simplify(forinline : boolean): tnode; + begin + result:=nil; + { if the try contains no code, we can kill + the try and except and return only the + finally part } + if has_no_code(left) then + begin + result:=right; + right:=nil; + end; + end; + + +{***************************************************************************** + TONNODE +*****************************************************************************} + + constructor tonnode.create(l,r:tnode); + begin + inherited create(onn,l,r); + excepTSymtable:=nil; + excepttype:=nil; + end; + + + destructor tonnode.destroy; + begin + { copied nodes don't need to release the symtable } + if assigned(excepTSymtable) then + excepTSymtable.free; + inherited destroy; + end; + + + constructor tonnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + excepTSymtable:=nil; + excepttype:=nil; + end; + + + function tonnode.dogetcopy : tnode; + var + n : tonnode; + begin + n:=tonnode(inherited dogetcopy); + if assigned(exceptsymtable) then + n.exceptsymtable:=exceptsymtable.getcopy + else + n.exceptsymtable:=nil; + n.excepttype:=excepttype; + result:=n; + end; + + + function tonnode.pass_typecheck:tnode; + begin + result:=nil; + resultdef:=voidtype; + if not(is_class(excepttype)) then + CGMessage1(type_e_class_type_expected,excepttype.typename); + if assigned(left) then + typecheckpass(left); + if assigned(right) then + typecheckpass(right); + end; + + + function tonnode.pass_1 : tnode; + begin + result:=nil; + include(current_procinfo.flags,pi_do_call); + expectloc:=LOC_VOID; + if assigned(left) then + firstpass(left); + + if assigned(right) then + firstpass(right); + end; + + + function tonnode.docompare(p: tnode): boolean; + begin + docompare := false; + end; + +end. diff --git a/closures/compiler/ninl.pas b/closures/compiler/ninl.pas new file mode 100644 index 0000000000..647978002c --- /dev/null +++ b/closures/compiler/ninl.pas @@ -0,0 +1,3375 @@ +{ + Copyright (c) 1998-2007 by Florian Klaempfl + + Type checking and register allocation for 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 ninl; + +{$i fpcdefs.inc} + +interface + + uses + node,htypechk,cpuinfo,symtype; + + {$i compinnr.inc} + + type + tinlinenode = class(tunarynode) + inlinenumber : byte; + constructor create(number : byte;is_const:boolean;l : tnode);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function dogetcopy : tnode;override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function simplify(forinline : boolean): tnode;override; + function docompare(p: tnode): boolean; override; + + { pack and unpack are changed into for-loops by the compiler } + function first_pack_unpack: tnode; virtual; + + { All the following routines currently + call compilerprocs, unless they are + overridden in which case, the code + generator handles them. + } + function first_pi: tnode ; virtual; + function first_arctan_real: tnode; virtual; + function first_abs_real: tnode; virtual; + function first_sqr_real: tnode; virtual; + function first_sqrt_real: tnode; virtual; + function first_ln_real: tnode; virtual; + function first_cos_real: tnode; virtual; + function first_sin_real: tnode; virtual; + function first_exp_real: tnode; virtual; + function first_frac_real: tnode; virtual; + function first_round_real: tnode; virtual; + function first_trunc_real: tnode; virtual; + function first_int_real: tnode; virtual; + function first_abs_long: tnode; virtual; + private + function handle_str: tnode; + function handle_reset_rewrite_typed: tnode; + function handle_text_read_write(filepara,params:Ttertiarynode;var newstatement:Tnode):boolean; + function handle_typed_read_write(filepara,params:Ttertiarynode;var newstatement:Tnode):boolean; + function handle_read_write: tnode; + function handle_val: tnode; + end; + tinlinenodeclass = class of tinlinenode; + + var + cinlinenode : tinlinenodeclass = tinlinenode; + + function geninlinenode(number : byte;is_const:boolean;l : tnode) : tinlinenode; + +implementation + + uses + verbose,globals,systems,constexp, + globtype, cutils, + symconst,symdef,symsym,symtable,paramgr,defutil, + pass_1, + ncal,ncon,ncnv,nadd,nld,nbas,nflw,nmem,nmat,nutils, + nobjc,objcdef, + cgbase,procinfo + ; + + function geninlinenode(number : byte;is_const:boolean;l : tnode) : tinlinenode; + + begin + geninlinenode:=cinlinenode.create(number,is_const,l); + end; + +{***************************************************************************** + TINLINENODE +*****************************************************************************} + + constructor tinlinenode.create(number : byte;is_const:boolean;l : tnode); + + begin + inherited create(inlinen,l); + if is_const then + include(flags,nf_inlineconst); + inlinenumber:=number; + end; + + + constructor tinlinenode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + inlinenumber:=ppufile.getbyte; + end; + + + procedure tinlinenode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putbyte(inlinenumber); + end; + + + function tinlinenode.dogetcopy : tnode; + var + n : tinlinenode; + begin + n:=tinlinenode(inherited dogetcopy); + n.inlinenumber:=inlinenumber; + result:=n; + end; + + + function tinlinenode.handle_str : tnode; + var + lenpara, + fracpara, + newparas, + tmppara, + dest, + source : tcallparanode; + procname: string; + is_real,is_enum : boolean; + rt : aint; + + begin + result := cerrornode.create; + + { get destination string } + dest := tcallparanode(left); + + { get source para (number) } + source := dest; + while assigned(source.right) do + source := tcallparanode(source.right); + + { destination parameter must be a normal (not a colon) parameter, this + check is needed because str(v:len) also has 2 parameters } + if (source=dest) or + (cpf_is_colon_para in tcallparanode(dest).callparaflags) then + begin + CGMessage1(parser_e_wrong_parameter_size,'Str'); + exit; + end; + + { in case we are in a generic definition, we cannot + do all checks, the parameters might be type parameters } + if df_generic in current_procinfo.procdef.defoptions then + begin + result.Free; + result:=nil; + resultdef:=voidtype; + exit; + end; + + is_real:=(source.resultdef.typ = floatdef) or is_currency(source.resultdef); + is_enum:=source.left.resultdef.typ=enumdef; + + if ((dest.left.resultdef.typ<>stringdef) and + not(is_chararray(dest.left.resultdef))) or + not(is_real or is_enum or + (source.left.resultdef.typ=orddef)) then + begin + CGMessagePos(fileinfo,parser_e_illegal_expression); + exit; + end; + + { get len/frac parameters } + lenpara := nil; + fracpara := nil; + if (cpf_is_colon_para in tcallparanode(dest.right).callparaflags) then + begin + lenpara := tcallparanode(dest.right); + + { we can let the callnode do the type checking of these parameters too, } + { but then the error messages aren't as nice } + if not is_integer(lenpara.resultdef) then + begin + CGMessagePos1(lenpara.fileinfo, + type_e_integer_expr_expected,lenpara.resultdef.typename); + exit; + end; + if (cpf_is_colon_para in tcallparanode(lenpara.right).callparaflags) then + begin + { parameters are in reverse order! } + fracpara := lenpara; + lenpara := tcallparanode(lenpara.right); + if not is_real then + begin + CGMessagePos(lenpara.fileinfo,parser_e_illegal_colon_qualifier); + exit + end; + if not is_integer(lenpara.resultdef) then + begin + CGMessagePos1(lenpara.fileinfo, + type_e_integer_expr_expected,lenpara.resultdef.typename); + exit; + end; + end; + end; + + { generate the parameter list for the compilerproc } + newparas := dest; + + { if we have a float parameter, insert the realtype, len and fracpara parameters } + if is_real then + begin + { insert realtype parameter } + if not is_currency(source.resultdef) then + begin + rt:=ord(tfloatdef(source.left.resultdef).floattype); + newparas.right := ccallparanode.create(cordconstnode.create( + rt,s32inttype,true),newparas.right); + tmppara:=tcallparanode(newparas.right); + end + else + tmppara:=newparas; + { if necessary, insert a fraction parameter } + if not assigned(fracpara) then + begin + tmppara.right := ccallparanode.create( + cordconstnode.create(int64(-1),s32inttype,false), + tmppara.right); + fracpara := tcallparanode(tmppara.right); + end; + { if necessary, insert a length para } + if not assigned(lenpara) then + fracpara.right := ccallparanode.create( + cordconstnode.create(int64(-32767),s32inttype,false), + fracpara.right); + end + else if is_enum then + begin + {Insert a reference to the ord2string index.} + newparas.right:=Ccallparanode.create( + Caddrnode.create_internal( + Crttinode.create(Tenumdef(source.left.resultdef),fullrtti,rdt_normal) + ), + newparas.right); + {Insert a reference to the typinfo.} + newparas.right:=Ccallparanode.create( + Caddrnode.create_internal( + Crttinode.create(Tenumdef(source.left.resultdef),fullrtti,rdt_ord2str) + ), + newparas.right); + {Insert a type conversion from the enumeration to longint.} + source.left:=Ctypeconvnode.create_internal(source.left,s32inttype); + typecheckpass(source.left); + + { if necessary, insert a length para } + if not assigned(lenpara) then + Tcallparanode(Tcallparanode(newparas.right).right).right:= + Ccallparanode.create( + cordconstnode.create(int64(-1),s32inttype,false), + Tcallparanode(Tcallparanode(newparas.right).right).right + ); + end + else + { for a normal parameter, insert a only length parameter if one is missing } + if not assigned(lenpara) then + newparas.right := ccallparanode.create(cordconstnode.create(int64(-1),s32inttype,false), + newparas.right); + + { remove the parameters from the original node so they won't get disposed, } + { since they're reused } + left := nil; + + { create procedure name } + if is_chararray(dest.resultdef) then + procname:='fpc_chararray_' + else + procname := 'fpc_' + tstringdef(dest.resultdef).stringtypname+'_'; + if is_real then + if is_currency(source.resultdef) then + procname := procname + 'currency' + else + procname := procname + 'float' + else if is_enum then + procname:=procname+'enum' + else + case torddef(source.resultdef).ordtype of +{$ifdef cpu64bitaddr} + u64bit: + procname := procname + 'uint'; +{$else} + u32bit: + procname := procname + 'uint'; + u64bit: + procname := procname + 'qword'; + scurrency, + s64bit: + procname := procname + 'int64'; + pasbool8,pasbool16,pasbool32,pasbool64, + bool8bit,bool16bit,bool32bit,bool64bit: + procname := procname + 'bool'; +{$endif} + else + procname := procname + 'sint'; + end; + + { for ansistrings insert the encoding argument } + if is_ansistring(dest.resultdef) then + newparas:=ccallparanode.create(cordconstnode.create( + getparaencoding(dest.resultdef),u16inttype,true),newparas); + + { free the errornode we generated in the beginning } + result.free; + { create the call node, } + result := ccallnode.createintern(procname,newparas); + end; + + + function tinlinenode.handle_reset_rewrite_typed: tnode; + begin + { since this is a "in_xxxx_typedfile" node, we can be sure we have } + { a typed file as argument and we don't have to check it again (JM) } + + { add the recsize parameter } + { note: for some reason, the parameter of intern procedures with only one } + { parameter is gets lifted out of its original tcallparanode (see round } + { line 1306 of ncal.pas), so recreate a tcallparanode here (JM) } + left := ccallparanode.create(cordconstnode.create( + tfiledef(left.resultdef).typedfiledef.size,s32inttype,true), + ccallparanode.create(left,nil)); + { create the correct call } + if m_iso in current_settings.modeswitches then + begin + if inlinenumber=in_reset_typedfile then + result := ccallnode.createintern('fpc_reset_typed_iso',left) + else + result := ccallnode.createintern('fpc_rewrite_typed_iso',left); + end + else + begin + if inlinenumber=in_reset_typedfile then + result := ccallnode.createintern('fpc_reset_typed',left) + else + result := ccallnode.createintern('fpc_rewrite_typed',left); + end; + + { make sure left doesn't get disposed, since we use it in the new call } + left := nil; + end; + + + procedure maybe_convert_to_string(var n: tnode); + begin + { stringconstnodes are arrays of char. It's much more } + { efficient to write a constant string, so convert } + { either to shortstring or ansistring depending on } + { length } + if (n.nodetype=stringconstn) then + if is_chararray(n.resultdef) then + if (tstringconstnode(n).len<=255) then + inserttypeconv(n,cshortstringtype) + else + inserttypeconv(n,getansistringdef) + else if is_widechararray(n.resultdef) then + inserttypeconv(n,cwidestringtype); + end; + + + function Tinlinenode.handle_text_read_write(filepara,params:Ttertiarynode;var newstatement:Tnode):boolean; + + {Read(ln)/write(ln) for text files.} + + const procprefixes:array[boolean] of string[15]=('fpc_write_text_','fpc_read_text_'); + + var error_para,is_real,special_handling,found_error,do_read:boolean; + p1:Tnode; + nextpara, + indexpara, + lenpara, + para, + fracpara:Tcallparanode; + temp:Ttempcreatenode; + readfunctype:Tdef; + name:string[63]; + + begin + para:=Tcallparanode(params); + found_error:=false; + do_read:=inlinenumber in [in_read_x,in_readln_x,in_readstr_x]; + while assigned(para) do + begin + { is this parameter faulty? } + error_para:=false; + { is this parameter a real? } + is_real:=false; + { type used for the read(), this is used to check + whether a temp is needed for range checking } + readfunctype:=nil; + + { can't read/write types } + if (para.left.nodetype=typen) and not(ttypenode(para.left).typedef.typ=undefineddef) then + begin + CGMessagePos(para.fileinfo,type_e_cant_read_write_type); + error_para := true; + end; + + { support writeln(procvar) } + if para.left.resultdef.typ=procvardef then + begin + p1:=ccallnode.create_procvar(nil,para.left); + typecheckpass(p1); + para.left:=p1; + end; + + if inlinenumber in [in_write_x,in_writeln_x] then + { prefer strings to chararrays } + maybe_convert_to_string(para.left); + + case para.left.resultdef.typ of + stringdef : + name:=procprefixes[do_read]+tstringdef(para.left.resultdef).stringtypname; + pointerdef : + begin + if (not is_pchar(para.left.resultdef)) or do_read then + begin + CGMessagePos(para.fileinfo,type_e_cant_read_write_type); + error_para := true; + end + else + name:=procprefixes[do_read]+'pchar_as_pointer'; + end; + floatdef : + begin + is_real:=true; + if Tfloatdef(para.left.resultdef).floattype=s64currency then + name := procprefixes[do_read]+'currency' + else + begin + name := procprefixes[do_read]+'float'; + readfunctype:=pbestrealtype^; + end; + end; + enumdef: + begin + name:=procprefixes[do_read]+'enum'; + readfunctype:=s32inttype; + end; + orddef : + begin + case Torddef(para.left.resultdef).ordtype of +{$ifdef cpu64bitaddr} + s64bit, +{$endif cpu64bitaddr} + s8bit, + s16bit, + s32bit : + begin + name := procprefixes[do_read]+'sint'; + readfunctype:=sinttype; + end; +{$ifdef cpu64bitaddr} + u64bit, +{$endif cpu64bitaddr} + u8bit, + u16bit, + u32bit : + begin + name := procprefixes[do_read]+'uint'; + readfunctype:=uinttype; + end; + uchar : + begin + name := procprefixes[do_read]+'char'; + { iso pascal needs a different handler } + if (m_iso in current_settings.modeswitches) and do_read then + name:=name+'_iso'; + readfunctype:=cchartype; + end; + uwidechar : + begin + name := procprefixes[do_read]+'widechar'; + readfunctype:=cwidechartype; + end; +{$ifndef cpu64bitaddr} + s64bit : + begin + name := procprefixes[do_read]+'int64'; + readfunctype:=s64inttype; + end; + u64bit : + begin + name := procprefixes[do_read]+'qword'; + readfunctype:=u64inttype; + end; +{$endif not cpu64bitaddr} + scurrency: + begin + name := procprefixes[do_read]+'currency'; + readfunctype:=s64currencytype; + is_real:=true; + end; + pasbool8, + pasbool16, + pasbool32, + pasbool64, + bool8bit, + bool16bit, + bool32bit, + bool64bit: + if do_read then + begin + CGMessagePos(para.fileinfo,type_e_cant_read_write_type); + error_para := true; + end + else + begin + name := procprefixes[do_read]+'boolean'; + readfunctype:=pasbool8type; + end + else + begin + CGMessagePos(para.fileinfo,type_e_cant_read_write_type); + error_para := true; + end; + end; + end; + variantdef : + name:=procprefixes[do_read]+'variant'; + arraydef : + begin + if is_chararray(para.left.resultdef) then + name := procprefixes[do_read]+'pchar_as_array' + else + begin + CGMessagePos(para.fileinfo,type_e_cant_read_write_type); + error_para := true; + end + end; + { generic parameter } + undefineddef: + { don't try to generate any code for a writeln on a generic parameter } + error_para:=true; + else + begin + CGMessagePos(para.fileinfo,type_e_cant_read_write_type); + error_para := true; + end; + end; + + { iso pascal needs a different handler } + if (m_iso in current_settings.modeswitches) and not(do_read) then + name:=name+'_iso'; + + { check for length/fractional colon para's } + fracpara:=nil; + lenpara:=nil; + indexpara:=nil; + if assigned(para.right) and + (cpf_is_colon_para in tcallparanode(para.right).callparaflags) then + begin + lenpara := tcallparanode(para.right); + if assigned(lenpara.right) and + (cpf_is_colon_para in tcallparanode(lenpara.right).callparaflags) then + fracpara:=tcallparanode(lenpara.right); + end; + { get the next parameter now already, because we're going } + { to muck around with the pointers } + if assigned(fracpara) then + nextpara := tcallparanode(fracpara.right) + else if assigned(lenpara) then + nextpara := tcallparanode(lenpara.right) + else + nextpara := tcallparanode(para.right); + + { check if a fracpara is allowed } + if assigned(fracpara) and not is_real then + begin + CGMessagePos(fracpara.fileinfo,parser_e_illegal_colon_qualifier); + error_para := true; + end + else if assigned(lenpara) and do_read then + begin + { I think this is already filtered out by parsing, but I'm not sure (JM) } + CGMessagePos(lenpara.fileinfo,parser_e_illegal_colon_qualifier); + error_para := true; + end; + + { adjust found_error } + found_error := found_error or error_para; + + if not error_para then + begin + special_handling:=false; + { create dummy frac/len para's if necessary } + if not do_read then + begin + { difference in default value for floats and the rest :( } + if not is_real then + begin + if not assigned(lenpara) then + begin + if m_iso in current_settings.modeswitches then + lenpara := ccallparanode.create( + cordconstnode.create(-1,s32inttype,false),nil) + else + lenpara := ccallparanode.create( + cordconstnode.create(0,s32inttype,false),nil); + end + else + { make sure we don't pass the successive } + { parameters too. We also already have a } + { reference to the next parameter in } + { nextpara } + lenpara.right := nil; + end + else + begin + if not assigned(lenpara) then + lenpara := ccallparanode.create( + cordconstnode.create(int64(-32767),s32inttype,false),nil); + { also create a default fracpara if necessary } + if not assigned(fracpara) then + fracpara := ccallparanode.create( + cordconstnode.create(int64(-1),s32inttype,false),nil); + { add it to the lenpara } + lenpara.right := fracpara; + if not is_currency(para.left.resultdef) then + begin + { and add the realtype para (this also removes the link } + { to any parameters coming after it) } + fracpara.right := ccallparanode.create( + cordconstnode.create(ord(tfloatdef(para.left.resultdef).floattype), + s32inttype,true),nil); + end + else + fracpara.right:=nil; + end; + if para.left.resultdef.typ=enumdef then + begin + {To write(ln) an enum we need a some extra parameters.} + {Insert a reference to the ord2string index.} + indexpara:=Ccallparanode.create( + Caddrnode.create_internal( + Crttinode.create(Tenumdef(para.left.resultdef),fullrtti,rdt_normal) + ), + nil); + {Insert a reference to the typinfo.} + indexpara:=Ccallparanode.create( + Caddrnode.create_internal( + Crttinode.create(Tenumdef(para.left.resultdef),fullrtti,rdt_ord2str) + ), + indexpara); + {Insert a type conversion to to convert the enum to longint.} + para.left:=Ctypeconvnode.create_internal(para.left,s32inttype); + typecheckpass(para.left); + end; + end + else + begin + {To read(ln) an enum we need a an extra parameter.} + if para.left.resultdef.typ=enumdef then + begin + {Insert a reference to the string2ord index.} + indexpara:=Ccallparanode.create(Caddrnode.create_internal( + Crttinode.create(Tenumdef(para.left.resultdef),fullrtti,rdt_str2ord) + ),nil); + {Insert a type conversion to to convert the enum to longint.} + para.left:=Ctypeconvnode.create_internal(para.left,s32inttype); + typecheckpass(para.left); + end; + { special handling of reading small numbers, because the helpers } + { expect a longint/card/bestreal var parameter. Use a temp. can't } + { use functions because then the call to FPC_IOCHECK destroys } + { their result before we can store it } + if (readfunctype<>nil) and (para.left.resultdef<>readfunctype) then + special_handling:=true; + end; + if special_handling then + begin + { since we're not going to pass the parameter as var-parameter } + { to the read function, manually check whether the parameter } + { can be used as var-parameter (e.g., whether it isn't a } + { property) } + valid_for_var(para.left,true); + + { create the parameter list: the temp ... } + temp := ctempcreatenode.create(readfunctype,readfunctype.size,tt_persistent,false); + addstatement(Tstatementnode(newstatement),temp); + + { ... and the file } + p1 := ccallparanode.create(ctemprefnode.create(temp), + filepara.getcopy); + Tcallparanode(Tcallparanode(p1).right).right:=indexpara; + + { create the call to the helper } + addstatement(Tstatementnode(newstatement), + ccallnode.createintern(name,tcallparanode(p1))); + + { assign the result to the original var (this automatically } + { takes care of range checking) } + addstatement(Tstatementnode(newstatement), + cassignmentnode.create(para.left, + ctemprefnode.create(temp))); + + { release the temp location } + addstatement(Tstatementnode(newstatement),ctempdeletenode.create(temp)); + + { statement of para is used } + para.left := nil; + + { free the enclosing tcallparanode, but not the } + { parameters coming after it } + para.right := nil; + para.free; + end + else + { read of non s/u-8/16bit, or a write } + begin + { add the filepara to the current parameter } + para.right := filepara.getcopy; + {Add the lenpara and the indexpara(s) (fracpara and realtype are + already linked with the lenpara if necessary).} + if indexpara=nil then + Tcallparanode(para.right).right:=lenpara + else + begin + if lenpara=nil then + Tcallparanode(para.right).right:=indexpara + else + begin + Tcallparanode(para.right).right:=lenpara; + lenpara.right:=indexpara; + end; +{ indexpara.right:=lenpara;} + end; + { in case of writing a chararray, add whether it's zero-based } + if para.left.resultdef.typ=arraydef then + para := ccallparanode.create(cordconstnode.create( + ord(tarraydef(para.left.resultdef).lowrange=0),pasbool8type,false),para) + else + { in case of reading an ansistring pass a codepage argument } + if do_read and is_ansistring(para.left.resultdef) then + para:=ccallparanode.create(cordconstnode.create( + getparaencoding(para.left.resultdef),u16inttype,true),para); + { create the call statement } + addstatement(Tstatementnode(newstatement), + ccallnode.createintern(name,para)); + end + end + else + { error_para = true } + begin + { free the parameter, since it isn't referenced anywhere anymore } + para.right := nil; + para.free; + if assigned(lenpara) then + begin + lenpara.right := nil; + lenpara.free; + end; + if assigned(fracpara) then + begin + fracpara.right := nil; + fracpara.free; + end; + end; + + { process next parameter } + para := nextpara; + end; + + { if no error, add the write(ln)/read(ln) end calls } + if not found_error then + begin + case inlinenumber of + in_read_x, + in_readstr_x: + name:='fpc_read_end'; + in_write_x, + in_writestr_x: + name:='fpc_write_end'; + in_readln_x: + begin + name:='fpc_readln_end'; + if m_iso in current_settings.modeswitches then + name:=name+'_iso'; + end; + in_writeln_x: + name:='fpc_writeln_end'; + end; + addstatement(Tstatementnode(newstatement),ccallnode.createintern(name,filepara)); + end; + handle_text_read_write:=found_error; + end; + + function Tinlinenode.handle_typed_read_write(filepara,params:Ttertiarynode;var newstatement:Tnode):boolean; + + {Read/write for typed files.} + + const procprefixes:array[boolean] of string[15]=('fpc_typed_write','fpc_typed_read'); + procnamesdisplay:array[boolean,boolean] of string[8] = (('Write','Read'),('WriteStr','ReadStr')); + + var found_error,do_read,is_rwstr:boolean; + para,nextpara:Tcallparanode; + p1:Tnode; + temp:Ttempcreatenode; + begin + found_error:=false; + para:=Tcallparanode(params); + do_read:=inlinenumber in [in_read_x,in_readln_x,in_readstr_x]; + is_rwstr := inlinenumber in [in_readstr_x,in_writestr_x]; + { add the typesize to the filepara } + if filepara.resultdef.typ=filedef then + filepara.right := ccallparanode.create(cordconstnode.create( + tfiledef(filepara.resultdef).typedfiledef.size,s32inttype,true),nil); + + { check for "no parameters" (you need at least one extra para for typed files) } + if not assigned(para) then + begin + CGMessage1(parser_e_wrong_parameter_size,procnamesdisplay[is_rwstr,do_read]); + found_error := true; + end; + + { process all parameters } + while assigned(para) do + begin + { check if valid parameter } + if para.left.nodetype=typen then + begin + CGMessagePos(para.left.fileinfo,type_e_cant_read_write_type); + found_error := true; + end; + + { support writeln(procvar) } + if (para.left.resultdef.typ=procvardef) then + begin + p1:=ccallnode.create_procvar(nil,para.left); + typecheckpass(p1); + para.left:=p1; + end; + + if filepara.resultdef.typ=filedef then + inserttypeconv(para.left,tfiledef(filepara.resultdef).typedfiledef); + + if assigned(para.right) and + (cpf_is_colon_para in tcallparanode(para.right).callparaflags) then + begin + CGMessagePos(para.right.fileinfo,parser_e_illegal_colon_qualifier); + + { skip all colon para's } + nextpara := tcallparanode(tcallparanode(para.right).right); + while assigned(nextpara) and (cpf_is_colon_para in nextpara.callparaflags) do + nextpara := tcallparanode(nextpara.right); + found_error := true; + end + else + { get next parameter } + nextpara := tcallparanode(para.right); + + { When we have a call, we have a problem: you can't pass the } + { result of a call as a formal const parameter. Solution: } + { assign the result to a temp and pass this temp as parameter } + { This is not very efficient, but write(typedfile,x) is } + { already slow by itself anyway (no buffering) (JM) } + { Actually, thge same goes for every non-simple expression } + { (such as an addition, ...) -> put everything but load nodes } + { into temps (JM) } + { of course, this must only be allowed for writes!!! (JM) } + if not(do_read) and (para.left.nodetype <> loadn) then + begin + { create temp for result } + temp := ctempcreatenode.create(para.left.resultdef, + para.left.resultdef.size,tt_persistent,false); + addstatement(Tstatementnode(newstatement),temp); + { assign result to temp } + addstatement(Tstatementnode(newstatement), + cassignmentnode.create(ctemprefnode.create(temp), + para.left)); + { replace (reused) paranode with temp } + para.left := ctemprefnode.create(temp); + end; + { add fileparameter } + para.right := filepara.getcopy; + + { create call statment } + { since the parameters are in the correct order, we have to insert } + { the statements always at the end of the current block } + addstatement(Tstatementnode(newstatement), + Ccallnode.createintern(procprefixes[do_read],para + )); + + { if we used a temp, free it } + if para.left.nodetype = temprefn then + addstatement(Tstatementnode(newstatement),ctempdeletenode.create(temp)); + + { process next parameter } + para := nextpara; + end; + + { free the file parameter } + filepara.free; + handle_typed_read_write:=found_error; + end; + + function tinlinenode.handle_read_write: tnode; + + var + filepara, + nextpara, + params : tcallparanode; + newstatement : tstatementnode; + newblock : tblocknode; + filetemp : Ttempcreatenode; + name : string[31]; + textsym : ttypesym; + is_typed, + do_read, + is_rwstr, + found_error : boolean; + begin + filepara := nil; + is_typed := false; + filetemp := nil; + do_read := inlinenumber in [in_read_x,in_readln_x,in_readstr_x]; + is_rwstr := inlinenumber in [in_readstr_x,in_writestr_x]; + + { if we fail, we can quickly exit this way. We must generate something } + { instead of the inline node, because firstpass will bomb with an } + { internalerror if it encounters a read/write } + result := cerrornode.create; + + { reverse the parameters (needed to get the colon parameters in the } + { correct order when processing write(ln) } + left := reverseparameters(tcallparanode(left)); + + if is_rwstr then + begin + filepara := tcallparanode(left); + { needs at least two parameters: source/dest string + min. 1 value } + if not(assigned(filepara)) or + not(assigned(filepara.right)) then + begin + CGMessagePos1(fileinfo,parser_e_wrong_parameter_size,'ReadStr/WriteStr'); + exit; + end + else if (filepara.resultdef.typ <> stringdef) then + begin + { convert chararray to string, or give an appropriate error message } + { (if you want to optimize to use shortstring, keep in mind that } + { readstr internally always uses ansistring, and to account for } + { chararrays with > 255 characters) } + inserttypeconv(filepara.left,getansistringdef); + filepara.resultdef:=filepara.left.resultdef; + if codegenerror then + exit; + end + end + else if assigned(left) then + begin + { check if we have a file parameter and if yes, what kind it is } + filepara := tcallparanode(left); + + if (filepara.resultdef.typ=filedef) then + begin + if (tfiledef(filepara.resultdef).filetyp=ft_untyped) then + begin + CGMessagePos(fileinfo,type_e_no_read_write_for_untyped_file); + exit; + end + else + begin + if (tfiledef(filepara.resultdef).filetyp=ft_typed) then + begin + if (inlinenumber in [in_readln_x,in_writeln_x]) then + begin + CGMessagePos(fileinfo,type_e_no_readln_writeln_for_typed_file); + exit; + end; + is_typed := true; + end + end; + end + else + filepara := nil; + end; + + { create a blocknode in which the successive write/read statements will be } + { put, since they belong together. Also create a dummy statement already to } + { make inserting of additional statements easier } + newblock:=internalstatements(newstatement); + + { if we don't have a filepara, create one containing the default } + if not assigned(filepara) or + is_rwstr then + begin + { since the input/output variables are threadvars loading them into + a temp once is faster. Create a temp which will hold a pointer to the file } + filetemp := ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true); + addstatement(newstatement,filetemp); + + { make sure the resultdef of the temp (and as such of the } + { temprefs coming after it) is set (necessary because the } + { temprefs will be part of the filepara, of which we need } + { the resultdef later on and temprefs can only be } + { typecheckpassed if the resultdef of the temp is known) } + typecheckpass(tnode(filetemp)); + + if not is_rwstr then + begin + { assign the address of the file to the temp } + if do_read then + name := 'input' + else + name := 'output'; + addstatement(newstatement, + cassignmentnode.create(ctemprefnode.create(filetemp), + ccallnode.createintern('fpc_get_'+name,nil))); + end + else + begin + if (do_read) then + name := 'fpc_setupreadstr_' + else + name := 'fpc_setupwritestr_'; + name:=name+tstringdef(filepara.resultdef).stringtypname; + { remove the source/destination string parameter from the } + { parameter chain } + left:=filepara.right; + filepara.right:=nil; + { pass the source/destination string to the setup routine, which } + { will store the string's address in the returned textrec } + addstatement(newstatement, + cassignmentnode.create(ctemprefnode.create(filetemp), + ccallnode.createintern(name,filepara))); + end; + + { create a new fileparameter as follows: file_type(temp^) } + { (so that we pass the value and not the address of the temp } + { to the read/write routine) } + textsym:=search_system_type('TEXT'); + filepara := ccallparanode.create(ctypeconvnode.create_internal( + cderefnode.create(ctemprefnode.create(filetemp)),textsym.typedef),nil); + end + else + { remove filepara from the parameter chain } + begin + left := filepara.right; + filepara.right := nil; + { the file para is a var parameter, but it must be valid already } + set_varstate(filepara.left,vs_readwritten,[vsf_must_be_valid]); + { check if we should make a temp to store the result of a complex } + { expression (better heuristics, anyone?) (JM) } + if (filepara.left.nodetype <> loadn) then + begin + { create a temp which will hold a pointer to the file } + filetemp := ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true); + + { add it to the statements } + addstatement(newstatement,filetemp); + + { make sure the resultdef of the temp (and as such of the } + { temprefs coming after it) is set (necessary because the } + { temprefs will be part of the filepara, of which we need } + { the resultdef later on and temprefs can only be } + { typecheckpassed if the resultdef of the temp is known) } + typecheckpass(tnode(filetemp)); + + { assign the address of the file to the temp } + addstatement(newstatement, + cassignmentnode.create(ctemprefnode.create(filetemp), + caddrnode.create_internal(filepara.left))); + typecheckpass(newstatement.left); + { create a new fileparameter as follows: file_type(temp^) } + { (so that we pass the value and not the address of the temp } + { to the read/write routine) } + nextpara := ccallparanode.create(ctypeconvnode.create_internal( + cderefnode.create(ctemprefnode.create(filetemp)),filepara.left.resultdef),nil); + + { replace the old file para with the new one } + filepara.left := nil; + filepara.free; + filepara := nextpara; + end; + end; + + { the resultdef of the filepara must be set since it's } + { used below } + filepara.get_paratype; + + { now, filepara is nowhere referenced anymore, so we can safely dispose it } + { if something goes wrong or at the end of the procedure } + + { we're going to reuse the paranodes, so make sure they don't get freed } + { twice } + params:=Tcallparanode(left); + left := nil; + + if is_typed then + found_error:=handle_typed_read_write(filepara,Ttertiarynode(params),tnode(newstatement)) + else + found_error:=handle_text_read_write(filepara,Ttertiarynode(params),tnode(newstatement)); + + { if we found an error, simply delete the generated blocknode } + if found_error then + newblock.free + else + begin + { deallocate the temp for the file para if we used one } + if assigned(filetemp) then + addstatement(newstatement,ctempdeletenode.create(filetemp)); + { otherwise return the newly generated block of instructions, } + { but first free the errornode we generated at the beginning } + result.free; + result := newblock + end; + end; + + + function tinlinenode.handle_val: tnode; + var + procname, + suffix : string[31]; + sourcepara, + destpara, + codepara, + sizepara, + newparas : tcallparanode; + orgcode,tc : tnode; + newstatement : tstatementnode; + newblock : tblocknode; + tempcode : ttempcreatenode; + begin + { for easy exiting if something goes wrong } + result := cerrornode.create; + + { check the amount of parameters } + if not(assigned(left)) or + not(assigned(tcallparanode(left).right)) then + begin + CGMessage1(parser_e_wrong_parameter_size,'Val'); + exit; + end; + + { in case we are in a generic definition, we cannot + do all checks, the parameters might be type parameters } + if df_generic in current_procinfo.procdef.defoptions then + begin + result.Free; + result:=nil; + resultdef:=voidtype; + exit; + end; + + { reverse parameters for easier processing } + left := reverseparameters(tcallparanode(left)); + + { get the parameters } + tempcode := nil; + orgcode := nil; + sizepara := nil; + sourcepara := tcallparanode(left); + destpara := tcallparanode(sourcepara.right); + codepara := tcallparanode(destpara.right); + + { check if codepara is valid } + if assigned(codepara) and + ( + not is_integer(codepara.resultdef) +{$ifndef cpu64bitaddr} + or is_64bitint(codepara.resultdef) +{$endif not cpu64bitaddr} + ) then + begin + CGMessagePos1(codepara.fileinfo,type_e_integer_expr_expected,codepara.resultdef.typename); + exit; + end; + + { check if dest para is valid } + if not is_integer(destpara.resultdef) and + not is_currency(destpara.resultdef) and + not(destpara.resultdef.typ in [floatdef,enumdef]) then + begin + CGMessagePos(destpara.fileinfo,type_e_integer_or_real_expr_expected); + exit; + end; + + { we're going to reuse the exisiting para's, so make sure they } + { won't be disposed } + left := nil; + + { create the blocknode which will hold the generated statements + } + { an initial dummy statement } + + newblock:=internalstatements(newstatement); + + { do we need a temp for code? Yes, if no code specified, or if } + { code is not a 32bit parameter (we already checked whether the } + { the code para, if specified, was an orddef) } + if not assigned(codepara) or + (codepara.resultdef.size<>sinttype.size) then + begin + tempcode := ctempcreatenode.create(sinttype,sinttype.size,tt_persistent,false); + addstatement(newstatement,tempcode); + { set the resultdef of the temp (needed to be able to get } + { the resultdef of the tempref used in the new code para) } + typecheckpass(tnode(tempcode)); + { create a temp codepara, but save the original code para to } + { assign the result to later on } + if assigned(codepara) then + begin + orgcode := codepara.left; + codepara.left := ctemprefnode.create(tempcode); + end + else + codepara := ccallparanode.create(ctemprefnode.create(tempcode),nil); + { we need its resultdef later on } + codepara.get_paratype; + end + else if (torddef(codepara.resultdef).ordtype = torddef(sinttype).ordtype) then + { because code is a var parameter, it must match types exactly } + { however, since it will return values in [0..255], both longints } + { and cardinals are fine. Since the formal code para type is } + { longint, insert a typecoversion to longint for cardinal para's } + begin + codepara.left := ctypeconvnode.create_internal(codepara.left,sinttype); + { make it explicit, oterwise you may get a nonsense range } + { check error if the cardinal already contained a value } + { > $7fffffff } + codepara.get_paratype; + end; + + { create the procedure name } + procname := 'fpc_val_'; + + case destpara.resultdef.typ of + orddef: + begin + case torddef(destpara.resultdef).ordtype of +{$ifdef cpu64bitaddr} + s64bit, +{$endif cpu64bitaddr} + s8bit, + s16bit, + s32bit: + begin + suffix := 'sint_'; + { we also need a destsize para in this case } + sizepara := ccallparanode.create(cordconstnode.create + (destpara.resultdef.size,s32inttype,true),nil); + end; +{$ifdef cpu64bitaddr} + u64bit, +{$endif cpu64bitaddr} + u8bit, + u16bit, + u32bit: + suffix := 'uint_'; +{$ifndef cpu64bitaddr} + s64bit: suffix := 'int64_'; + u64bit: suffix := 'qword_'; +{$endif not cpu64bitaddr} + scurrency: suffix := 'currency_'; + else + internalerror(200304225); + end; + end; + floatdef: + suffix:='real_'; + enumdef: + begin + suffix:='enum_'; + sizepara:=Ccallparanode.create(Caddrnode.create_internal( + Crttinode.create(Tenumdef(destpara.resultdef),fullrtti,rdt_str2ord) + ),nil); + end; + end; + + procname := procname + suffix; + + { play a trick to have tcallnode handle invalid source parameters: } + { the shortstring-longint val routine by default } + if (sourcepara.resultdef.typ = stringdef) then + procname := procname + tstringdef(sourcepara.resultdef).stringtypname + { zero-based arrays (of char) can be implicitely converted to ansistring } + else if is_zero_based_array(sourcepara.resultdef) then + procname := procname + 'ansistr' + else + procname := procname + 'shortstr'; + + { set up the correct parameters for the call: the code para... } + newparas := codepara; + { and the source para } + codepara.right := sourcepara; + { sizepara either contains nil if none is needed (which is ok, since } + { then the next statement severes any possible links with other paras } + { that sourcepara may have) or it contains the necessary size para and } + { its right field is nil } + sourcepara.right := sizepara; + + { create the call and assign the result to dest (val helpers are functions). + Use a trick to prevent a type size mismatch warning to be generated by the + assignment node. First convert implicitly to the resultdef. This will insert + the range check. The Second conversion is done explicitly to hide the implicit conversion + for the assignment node and therefor preventing the warning (PFV) + + The implicit conversion is avoided for enums because implicit conversion between + longint (which is what fpc_val_enum_shortstr returns) and enumerations is not + possible. (DM). + + The implicit conversion is also avoided for COMP type if it is handled by FPU (x86) + to prevent warning about automatic type conversion. } + if (destpara.resultdef.typ=enumdef) or + ((destpara.resultdef.typ=floatdef) and (tfloatdef(destpara.resultdef).floattype=s64comp)) + then + tc:=ccallnode.createintern(procname,newparas) + else + tc:=ctypeconvnode.create(ccallnode.createintern(procname,newparas),destpara.left.resultdef); + addstatement(newstatement,cassignmentnode.create( + destpara.left,ctypeconvnode.create_internal(tc,destpara.left.resultdef))); + + { dispose of the enclosing paranode of the destination } + destpara.left := nil; + destpara.right := nil; + destpara.free; + + { check if we used a temp for code and whether we have to store } + { it to the real code parameter } + if assigned(orgcode) then + addstatement(newstatement,cassignmentnode.create( + orgcode, + ctypeconvnode.create_internal( + ctemprefnode.create(tempcode),orgcode.resultdef))); + + { release the temp if we allocated one } + if assigned(tempcode) then + addstatement(newstatement,ctempdeletenode.create(tempcode)); + + { free the errornode } + result.free; + { and return it } + result := newblock; + end; + +{$maxfpuregisters 0} + + function getpi : bestreal; + begin + {$ifdef x86} + { x86 has pi in hardware } + result:=pi; + {$else x86} + {$ifdef cpuextended} + result:=MathPiExtended.Value; + {$else cpuextended} + result:=MathPi.Value; + {$endif cpuextended} + {$endif x86} + end; + + + function tinlinenode.simplify(forinline : boolean): tnode; + + function do_lowhigh(def:tdef) : tnode; + var + v : tconstexprint; + enum : tenumsym; + hp : tnode; + i : integer; + begin + case def.typ of + orddef: + begin + set_varstate(left,vs_read,[]); + if inlinenumber=in_low_x then + v:=torddef(def).low + else + v:=torddef(def).high; + hp:=cordconstnode.create(v,def,true); + typecheckpass(hp); + do_lowhigh:=hp; + end; + enumdef: + begin + set_varstate(left,vs_read,[]); + if inlinenumber=in_high_x then + v:=tenumdef(def).maxval + else + v:=tenumdef(def).minval; + enum:=nil; + for i := 0 to tenumdef(def).symtable.SymList.Count - 1 do + if tenumsym(tenumdef(def).symtable.SymList[i]).value=v then + begin + enum:=tenumsym(tenumdef(def).symtable.SymList[i]); + break; + end; + if not assigned(enum) then + internalerror(309993) + else + hp:=genenumnode(enum); + do_lowhigh:=hp; + end; + else + internalerror(87); + end; + end; + + + function getconstrealvalue : bestreal; + begin + case left.nodetype of + ordconstn: + getconstrealvalue:=tordconstnode(left).value; + realconstn: + getconstrealvalue:=trealconstnode(left).value_real; + else + internalerror(309992); + end; + end; + + + procedure setconstrealvalue(r : bestreal); + begin + result:=crealconstnode.create(r,pbestrealtype^); + end; + + + function handle_ln_const(r : bestreal) : tnode; + begin + if r<=0.0 then + if floating_point_range_check_error then + begin + result:=crealconstnode.create(0,pbestrealtype^); + CGMessage(type_e_wrong_math_argument) + end + else + begin + if r=0.0 then + result:=crealconstnode.create(MathQNaN.Value,pbestrealtype^) + else + result:=crealconstnode.create(MathNegInf.Value,pbestrealtype^) + end + else + result:=crealconstnode.create(ln(r),pbestrealtype^) + end; + + + function handle_sqrt_const(r : bestreal) : tnode; + begin + if r<0.0 then + if floating_point_range_check_error then + begin + result:=crealconstnode.create(0,pbestrealtype^); + CGMessage(type_e_wrong_math_argument) + end + else + result:=crealconstnode.create(MathQNaN.Value,pbestrealtype^) + else + result:=crealconstnode.create(sqrt(r),pbestrealtype^) + end; + + + function handle_const_sar : tnode; + var + vl,vl2 : TConstExprInt; + bits,shift: integer; + mask : qword; + def : tdef; + begin + result:=nil; + if (left.nodetype=ordconstn) or ((left.nodetype=callparan) and (tcallparanode(left).left.nodetype=ordconstn)) then + begin + if (left.nodetype=callparan) and + assigned(tcallparanode(left).right) then + begin + if (tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn) then + begin + def:=tcallparanode(tcallparanode(left).right).left.resultdef; + vl:=tordconstnode(tcallparanode(left).left).value; + vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value; + end + else + exit; + end + else + begin + def:=left.resultdef; + vl:=1; + vl2:=tordconstnode(left).value; + end; + + bits:=def.size*8; + shift:=vl.svalue and (bits-1); + case bits of + 8: + mask:=$ff; + 16: + mask:=$ffff; + 32: + mask:=$ffffffff; + 64: + mask:=qword($ffffffffffffffff); + else + mask:=qword(1 shl bits)-1; + end; +{$push} +{$r-,q-} + if shift=0 then + result:=cordconstnode.create(vl2.svalue,def,false) + else if vl2.svalue<0 then + result:=cordconstnode.create(((vl2.svalue shr shift) or (mask shl (bits-shift))) and mask,def,false) + else + result:=cordconstnode.create((vl2.svalue shr shift) and mask,def,false); +{$pop} + end + else + end; + + + function handle_const_rox : tnode; + var + vl,vl2 : TConstExprInt; + bits,shift: integer; + def : tdef; + begin + result:=nil; + if (left.nodetype=ordconstn) or ((left.nodetype=callparan) and (tcallparanode(left).left.nodetype=ordconstn)) then + begin + if (left.nodetype=callparan) and + assigned(tcallparanode(left).right) then + begin + if (tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn) then + begin + def:=tcallparanode(tcallparanode(left).right).left.resultdef; + vl:=tordconstnode(tcallparanode(left).left).value; + vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value; + end + else + exit; + end + else + begin + def:=left.resultdef; + vl:=1; + vl2:=tordconstnode(left).value; + end; + + bits:=def.size*8; + shift:=vl.svalue and (bits-1); +{$push} +{$r-,q-} + if shift=0 then + result:=cordconstnode.create(vl2.svalue,def,false) + else + case inlinenumber of + in_ror_x,in_ror_x_y: + case def.size of + 1: + result:=cordconstnode.create(RorByte(Byte(vl2.svalue),shift),def,false); + 2: + result:=cordconstnode.create(RorWord(Word(vl2.svalue),shift),def,false); + 4: + result:=cordconstnode.create(RorDWord(DWord(vl2.svalue),shift),def,false); + 8: + result:=cordconstnode.create(RorQWord(QWord(vl2.svalue),shift),def,false); + else + internalerror(2011061903); + end; + in_rol_x,in_rol_x_y: + case def.size of + 1: + result:=cordconstnode.create(RolByte(Byte(vl2.svalue),shift),def,false); + 2: + result:=cordconstnode.create(RolWord(Word(vl2.svalue),shift),def,false); + 4: + result:=cordconstnode.create(RolDWord(DWord(vl2.svalue),shift),def,false); + 8: + result:=cordconstnode.create(RolQWord(QWord(vl2.svalue),shift),def,false); + else + internalerror(2011061902); + end; + else + internalerror(2011061901); + end; + end; + end; + + var + hp : tnode; + vl,vl2 : TConstExprInt; + vr : bestreal; + + begin { simplify } + result:=nil; + { handle intern constant functions in separate case } + if nf_inlineconst in flags then + begin + { no parameters? } + if not assigned(left) then + internalerror(200501231) + else + begin + vl:=0; + vl2:=0; { second parameter Ex: ptr(vl,vl2) } + case left.nodetype of + realconstn : + begin + { Real functions are all handled with internproc below } + CGMessage1(type_e_integer_expr_expected,left.resultdef.typename) + end; + ordconstn : + vl:=tordconstnode(left).value; + callparan : + begin + { both exists, else it was not generated } + vl:=tordconstnode(tcallparanode(left).left).value; + vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value; + end; + else + CGMessage(parser_e_illegal_expression); + end; + case inlinenumber of + in_const_abs : + if vl.signed then + hp:=create_simplified_ord_const(abs(vl.svalue),resultdef,forinline) + else + hp:=create_simplified_ord_const(vl.uvalue,resultdef,forinline); + in_const_sqr: + if vl.signed then + hp:=create_simplified_ord_const(sqr(vl.svalue),resultdef,forinline) + else + hp:=create_simplified_ord_const(sqr(vl.uvalue),resultdef,forinline); + in_const_odd : + hp:=cordconstnode.create(qword(odd(int64(vl))),pasbool8type,true); + in_const_swap_word : + hp:=cordconstnode.create((vl and $ff) shl 8+(vl shr 8),left.resultdef,true); + in_const_swap_long : + hp:=cordconstnode.create((vl and $ffff) shl 16+(vl shr 16),left.resultdef,true); + in_const_swap_qword : + hp:=cordconstnode.create((vl and $ffff) shl 32+(vl shr 32),left.resultdef,true); + in_const_ptr: + begin + {Don't construct pointers from negative values.} + if (vl.signed and (vl.svalue<0)) or (vl2.signed and (vl2.svalue<0)) then + cgmessage(parser_e_range_check_error); + hp:=cpointerconstnode.create((vl2.uvalue shl 4)+vl.uvalue,voidfarpointertype); + end + else + internalerror(88); + end; + end; + if hp=nil then + hp:=cerrornode.create; + result:=hp; + end + else + begin + case inlinenumber of + in_lo_long, + in_hi_long, + in_lo_qword, + in_hi_qword, + in_lo_word, + in_hi_word : + begin + if left.nodetype=ordconstn then + begin + case inlinenumber of + in_lo_word : + result:=cordconstnode.create(tordconstnode(left).value and $ff,u8inttype,true); + in_hi_word : + result:=cordconstnode.create(tordconstnode(left).value shr 8,u8inttype,true); + in_lo_long : + result:=cordconstnode.create(tordconstnode(left).value and $ffff,u16inttype,true); + in_hi_long : + result:=cordconstnode.create(tordconstnode(left).value shr 16,u16inttype,true); + in_lo_qword : + result:=cordconstnode.create(tordconstnode(left).value and $ffffffff,u32inttype,true); + in_hi_qword : + result:=cordconstnode.create(tordconstnode(left).value shr 32,u32inttype,true); + end; + end; + end; + in_ord_x: + begin + case left.resultdef.typ of + orddef : + begin + case torddef(left.resultdef).ordtype of + pasbool8, + uchar: + begin + { change to byte() } + result:=ctypeconvnode.create_internal(left,u8inttype); + left:=nil; + end; + pasbool16, + uwidechar : + begin + { change to word() } + result:=ctypeconvnode.create_internal(left,u16inttype); + left:=nil; + end; + pasbool32 : + begin + { change to dword() } + result:=ctypeconvnode.create_internal(left,u32inttype); + left:=nil; + end; + pasbool64 : + begin + { change to qword() } + result:=ctypeconvnode.create_internal(left,u64inttype); + left:=nil; + end; + bool8bit: + begin + { change to shortint() } + result:=ctypeconvnode.create_internal(left,s8inttype); + left:=nil; + end; + bool16bit : + begin + { change to smallint() } + result:=ctypeconvnode.create_internal(left,s16inttype); + left:=nil; + end; + bool32bit : + begin + { change to longint() } + result:=ctypeconvnode.create_internal(left,s32inttype); + left:=nil; + end; + bool64bit : + begin + { change to int64() } + result:=ctypeconvnode.create_internal(left,s64inttype); + left:=nil; + end; + uvoid : + CGMessage1(type_e_ordinal_expr_expected,left.resultdef.typename); + else + begin + { all other orddef need no transformation } + result:=left; + left:=nil; + end; + end; + end; + enumdef : + begin + result:=ctypeconvnode.create_internal(left,s32inttype); + left:=nil; + end; + pointerdef : + begin + if m_mac in current_settings.modeswitches then + begin + result:=ctypeconvnode.create_internal(left,ptruinttype); + left:=nil; + end + end; + end; +(* + if (left.nodetype=ordconstn) then + begin + result:=cordconstnode.create( + tordconstnode(left).value,sinttype,true); + end + else if (m_mac in current_settings.modeswitches) and + (left.ndoetype=pointerconstn) then + result:=cordconstnode.create( + tpointerconstnode(left).value,ptruinttype,true); +*) + end; + in_chr_byte: + begin + { convert to explicit char() } + result:=ctypeconvnode.create_internal(left,cchartype); + left:=nil; + end; + in_length_x: + begin + case left.resultdef.typ of + stringdef : + begin + if (left.nodetype=stringconstn) then + begin + result:=cordconstnode.create( + tstringconstnode(left).len,sinttype,true); + end; + end; + orddef : + begin + { length of char is always one } + if is_char(left.resultdef) or + is_widechar(left.resultdef) then + begin + result:=cordconstnode.create(1,sinttype,false); + end + end; + arraydef : + begin + if (left.nodetype=stringconstn) then + begin + result:=cordconstnode.create( + tstringconstnode(left).len,sinttype,true); + end + else if not is_open_array(left.resultdef) and + not is_array_of_const(left.resultdef) and + not is_dynamic_array(left.resultdef) then + result:=cordconstnode.create(tarraydef(left.resultdef).highrange- + tarraydef(left.resultdef).lowrange+1, + sinttype,true); + end; + end; + end; + in_assigned_x: + begin + if is_constnode(tcallparanode(left).left) or + (tcallparanode(left).left.nodetype = pointerconstn) then + begin + { let an add node figure it out } + result:=caddnode.create(unequaln,tcallparanode(left).left,cnilnode.create); + tcallparanode(left).left := nil; + end; + end; + in_pred_x, + in_succ_x: + begin + if (left.nodetype=ordconstn) then + begin + if (inlinenumber=in_succ_x) then + vl:=tordconstnode(left).value+1 + else + vl:=tordconstnode(left).value-1; + if is_integer(left.resultdef) then + { the type of the original integer constant is irrelevant, + it should be automatically adapted to the new value + (except when inlining) } + result:=create_simplified_ord_const(vl,resultdef,forinline) + else + { check the range for enums, chars, booleans } + result:=cordconstnode.create(vl,left.resultdef,true) + end + end; + in_low_x, + in_high_x: + begin + case left.resultdef.typ of + orddef, + enumdef: + begin + result:=do_lowhigh(left.resultdef); + end; + setdef: + begin + result:=do_lowhigh(tsetdef(left.resultdef).elementdef); + end; + arraydef: + begin + if (inlinenumber=in_low_x) then + begin + result:=cordconstnode.create(int64(tarraydef( + left.resultdef).lowrange),tarraydef(left.resultdef).rangedef,true); + end + else if not is_open_array(left.resultdef) and + not is_array_of_const(left.resultdef) and + not is_dynamic_array(left.resultdef) then + result:=cordconstnode.create(int64(tarraydef(left.resultdef).highrange), + tarraydef(left.resultdef).rangedef,true); + end; + stringdef: + begin + if inlinenumber=in_low_x then + begin + result:=cordconstnode.create(0,u8inttype,false); + end + else if not is_ansistring(left.resultdef) and + not is_wide_or_unicode_string(left.resultdef) then + result:=cordconstnode.create(tstringdef(left.resultdef).len,u8inttype,true) + end; + end; + end; + in_exp_real : + begin + if left.nodetype in [ordconstn,realconstn] then + begin + result:=crealconstnode.create(exp(getconstrealvalue),pbestrealtype^); + if (trealconstnode(result).value_real=MathInf.Value) and + floating_point_range_check_error then + begin + result:=crealconstnode.create(0,pbestrealtype^); + CGMessage(parser_e_range_check_error); + end; + end + end; + in_trunc_real : + begin + if left.nodetype in [ordconstn,realconstn] then + begin + vr:=getconstrealvalue; + if (vr>=9223372036854775807.5) or (vr<=-9223372036854775808.5) then + begin + CGMessage(parser_e_range_check_error); + result:=cordconstnode.create(1,s64inttype,false) + end + else + result:=cordconstnode.create(trunc(vr),s64inttype,true) + end + end; + in_round_real : + begin + { can't evaluate while inlining, may depend on fpu setting } + if (not forinline) and + (left.nodetype in [ordconstn,realconstn]) then + begin + vr:=getconstrealvalue; + if (vr>=9223372036854775807.5) or (vr<=-9223372036854775808.5) then + begin + CGMessage(parser_e_range_check_error); + result:=cordconstnode.create(1,s64inttype,false) + end + else + result:=cordconstnode.create(round(vr),s64inttype,true) + end + end; + in_frac_real : + begin + if left.nodetype in [ordconstn,realconstn] then + setconstrealvalue(frac(getconstrealvalue)) + end; + in_int_real : + begin + if left.nodetype in [ordconstn,realconstn] then + setconstrealvalue(int(getconstrealvalue)); + end; + in_pi_real : + begin + if block_type=bt_const then + setconstrealvalue(getpi) + end; + in_cos_real : + begin + if left.nodetype in [ordconstn,realconstn] then + setconstrealvalue(cos(getconstrealvalue)) + end; + in_sin_real : + begin + if left.nodetype in [ordconstn,realconstn] then + setconstrealvalue(sin(getconstrealvalue)) + end; + in_arctan_real : + begin + if left.nodetype in [ordconstn,realconstn] then + setconstrealvalue(arctan(getconstrealvalue)) + end; + in_abs_real : + begin + if left.nodetype in [ordconstn,realconstn] then + setconstrealvalue(abs(getconstrealvalue)) + end; + in_abs_long: + begin + if left.nodetype=ordconstn then + begin + if tordconstnode(left).value<0 then + result:=cordconstnode.create((-tordconstnode(left).value),s32inttype,false) + else + result:=cordconstnode.create((tordconstnode(left).value),s32inttype,false); + end + end; + in_sqr_real : + begin + if left.nodetype in [ordconstn,realconstn] then + setconstrealvalue(sqr(getconstrealvalue)) + end; + in_sqrt_real : + begin + if left.nodetype in [ordconstn,realconstn] then + begin + vr:=getconstrealvalue; + if vr<0.0 then + result:=handle_sqrt_const(vr) + else + setconstrealvalue(sqrt(vr)); + end + end; + in_ln_real : + begin + if left.nodetype in [ordconstn,realconstn] then + begin + vr:=getconstrealvalue; + if vr<=0.0 then + result:=handle_ln_const(vr) + else + setconstrealvalue(ln(vr)); + end + end; + in_assert_x_y : + begin + if not(cs_do_assertion in current_settings.localswitches) then + { we need a valid node, so insert a nothingn } + result:=cnothingnode.create; + end; + in_sar_x, + in_sar_x_y : + begin + result:=handle_const_sar; + end; + in_rol_x, + in_rol_x_y, + in_ror_x, + in_ror_x_y : + result:=handle_const_rox; + end; + end; + end; + + + + function tinlinenode.pass_typecheck:tnode; + + procedure setfloatresultdef; + begin + if (left.resultdef.typ=floatdef) and + (tfloatdef(left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real]) then + resultdef:=left.resultdef + else + begin + if (left.nodetype <> ordconstn) then + inserttypeconv(left,pbestrealtype^); + resultdef:=pbestrealtype^; + end; + end; + + + procedure handle_pack_unpack; + var + source, target, index: tcallparanode; + unpackedarraydef, packedarraydef: tarraydef; + tempindex: TConstExprInt; + begin + resultdef:=voidtype; + + unpackedarraydef := nil; + packedarraydef := nil; + source := tcallparanode(left); + if (inlinenumber = in_unpack_x_y_z) then + begin + target := tcallparanode(source.right); + index := tcallparanode(target.right); + + { source must be a packed array } + if not is_packed_array(source.left.resultdef) then + CGMessagePos2(source.left.fileinfo,type_e_got_expected_packed_array,'1',source.left.resultdef.typename) + else + packedarraydef := tarraydef(source.left.resultdef); + { target can be any kind of array, as long as it's not packed } + if (target.left.resultdef.typ <> arraydef) or + is_packed_array(target.left.resultdef) then + CGMessagePos2(target.left.fileinfo,type_e_got_expected_unpacked_array,'2',target.left.resultdef.typename) + else + unpackedarraydef := tarraydef(target.left.resultdef); + end + else + begin + index := tcallparanode(source.right); + target := tcallparanode(index.right); + + { source can be any kind of array, as long as it's not packed } + if (source.left.resultdef.typ <> arraydef) or + is_packed_array(source.left.resultdef) then + CGMessagePos2(source.left.fileinfo,type_e_got_expected_unpacked_array,'1',source.left.resultdef.typename) + else + unpackedarraydef := tarraydef(source.left.resultdef); + { target must be a packed array } + if not is_packed_array(target.left.resultdef) then + CGMessagePos2(target.left.fileinfo,type_e_got_expected_packed_array,'3',target.left.resultdef.typename) + else + packedarraydef := tarraydef(target.left.resultdef); + end; + + if assigned(unpackedarraydef) then + begin + { index must be compatible with the unpacked array's indextype } + inserttypeconv(index.left,unpackedarraydef.rangedef); + + { range check at compile time if possible } + if assigned(packedarraydef) and + (index.left.nodetype = ordconstn) and + not is_special_array(unpackedarraydef) then + begin + testrange(unpackedarraydef,tordconstnode(index.left).value,false,false); + tempindex := tordconstnode(index.left).value + packedarraydef.highrange-packedarraydef.lowrange; + testrange(unpackedarraydef,tempindex,false,false); + end; + end; + + { source array is read and must be valid } + set_varstate(source.left,vs_read,[vsf_must_be_valid]); + { target array is written } + valid_for_assignment(target.left,true); + set_varstate(target.left,vs_written,[]); + { index in the unpacked array is read and must be valid } + set_varstate(index.left,vs_read,[vsf_must_be_valid]); + { if the size of the arrays is 0 (array of empty records), } + { do nothing } + if (source.resultdef.size = 0) then + result:=cnothingnode.create; + end; + + + function handle_objc_encode: tnode; + var + encodedtype: ansistring; + errordef: tdef; + begin + encodedtype:=''; + if not objctryencodetype(left.resultdef,encodedtype,errordef) then + Message1(type_e_objc_type_unsupported,errordef.typename); + result:=cstringconstnode.createpchar(ansistring2pchar(encodedtype),length(encodedtype)); + end; + + + var + hightree, + hp : tnode; + begin + result:=nil; + { when handling writeln "left" contains no valid address } + if assigned(left) then + begin + if left.nodetype=callparan then + tcallparanode(left).get_paratype + else + typecheckpass(left); + end; + + if not(nf_inlineconst in flags) then + begin + case inlinenumber of + in_lo_long, + in_hi_long, + in_lo_qword, + in_hi_qword, + in_lo_word, + in_hi_word : + begin + { give warning for incompatibility with tp and delphi } + if (inlinenumber in [in_lo_long,in_hi_long,in_lo_qword,in_hi_qword]) and + ((m_tp7 in current_settings.modeswitches) or + (m_delphi in current_settings.modeswitches)) then + CGMessage(type_w_maybe_wrong_hi_lo); + set_varstate(left,vs_read,[vsf_must_be_valid]); + if not is_integer(left.resultdef) then + CGMessage1(type_e_integer_expr_expected,left.resultdef.typename); + case inlinenumber of + in_lo_word, + in_hi_word : + resultdef:=u8inttype; + in_lo_long, + in_hi_long : + resultdef:=u16inttype; + in_lo_qword, + in_hi_qword : + resultdef:=u32inttype; + end; + end; + + in_sizeof_x: + begin + { the constant evaluation of in_sizeof_x happens in pexpr where possible } + set_varstate(left,vs_read,[]); + if paramanager.push_high_param(vs_value,left.resultdef,current_procinfo.procdef.proccalloption) then + begin + hightree:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry)); + if assigned(hightree) then + begin + hp:=caddnode.create(addn,hightree, + cordconstnode.create(1,sinttype,false)); + if (left.resultdef.typ=arraydef) then + if not is_packed_array(tarraydef(left.resultdef)) then + begin + if (tarraydef(left.resultdef).elesize<>1) then + hp:=caddnode.create(muln,hp,cordconstnode.create(tarraydef( + left.resultdef).elesize,sinttype,true)); + end + else if (tarraydef(left.resultdef).elepackedbitsize <> 8) then + begin + { no packed open array support yet } + if (hp.nodetype <> ordconstn) then + internalerror(2006081511); + hp.free; + hp := cordconstnode.create(left.resultdef.size,sinttype,true); +{ + hp:= + ctypeconvnode.create_explicit(sinttype, + cmoddivnode.create(divn, + caddnode.create(addn, + caddnode.create(muln,hp,cordconstnode.create(tarraydef( + left.resultdef).elepackedbitsize,s64inttype,true)), + cordconstnode.create(a,s64inttype,true)), + cordconstnode.create(8,s64inttype,true)), + sinttype); +} + end; + result:=hp; + end; + end + else + resultdef:=sinttype; + end; + + in_typeof_x: + begin + set_varstate(left,vs_read,[]); + resultdef:=voidpointertype; + end; + + in_ord_x: + begin + set_varstate(left,vs_read,[vsf_must_be_valid]); + case left.resultdef.typ of + orddef, + enumdef : + ; + pointerdef : + begin + if not(m_mac in current_settings.modeswitches) then + CGMessage1(type_e_ordinal_expr_expected,left.resultdef.typename); + end + else + CGMessage1(type_e_ordinal_expr_expected,left.resultdef.typename); + end; + end; + + in_chr_byte: + begin + set_varstate(left,vs_read,[vsf_must_be_valid]); + end; + + in_length_x: + begin + if ((left.resultdef.typ=arraydef) and + (not is_special_array(left.resultdef) or + is_open_array(left.resultdef))) or + (left.resultdef.typ=orddef) then + set_varstate(left,vs_read,[]) + else + set_varstate(left,vs_read,[vsf_must_be_valid]); + + case left.resultdef.typ of + variantdef: + begin + inserttypeconv(left,getansistringdef); + end; + + stringdef : + begin + { we don't need string convertions here, } + { except if from widestring to ansistring } + { and vice versa (that can change the } + { length) } + if (left.nodetype=typeconvn) and + (ttypeconvnode(left).left.resultdef.typ=stringdef) and + not(is_wide_or_unicode_string(left.resultdef) xor + is_wide_or_unicode_string(ttypeconvnode(left).left.resultdef)) then + begin + hp:=ttypeconvnode(left).left; + ttypeconvnode(left).left:=nil; + left.free; + left:=hp; + end; + end; + orddef : + begin + { will be handled in simplify } + if not is_char(left.resultdef) and + not is_widechar(left.resultdef) then + CGMessage(type_e_mismatch); + end; + pointerdef : + begin + if is_pchar(left.resultdef) then + begin + hp := ccallparanode.create(left,nil); + result := ccallnode.createintern('fpc_pchar_length',hp); + { make sure the left node doesn't get disposed, since it's } + { reused in the new node (JM) } + left:=nil; + exit; + end + else if is_pwidechar(left.resultdef) then + begin + hp := ccallparanode.create(left,nil); + result := ccallnode.createintern('fpc_pwidechar_length',hp); + { make sure the left node doesn't get disposed, since it's } + { reused in the new node (JM) } + left:=nil; + exit; + end + else + CGMessage(type_e_mismatch); + end; + arraydef : + begin + if is_open_array(left.resultdef) or + is_array_of_const(left.resultdef) then + begin + hightree:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry)); + if assigned(hightree) then + result:=caddnode.create(addn,hightree, + cordconstnode.create(1,sinttype,false)); + exit; + end + else if is_dynamic_array(left.resultdef) then + begin + hp := ccallparanode.create(ctypeconvnode.create_internal(left,voidpointertype),nil); + result := ccallnode.createintern('fpc_dynarray_length',hp); + { make sure the left node doesn't get disposed, since it's } + { reused in the new node (JM) } + left:=nil; + exit; + end + else + begin + { will be handled in simplify } + end; + end + else + CGMessage(type_e_mismatch); + end; + + { shortstring return an 8 bit value as the length + is the first byte of the string } + if is_shortstring(left.resultdef) then + resultdef:=u8inttype + else + resultdef:=sinttype; + end; + + in_typeinfo_x: + begin + if (left.resultdef.typ=enumdef) and + (tenumdef(left.resultdef).has_jumps) then + CGMessage(type_e_no_type_info); + set_varstate(left,vs_read,[vsf_must_be_valid]); + resultdef:=voidpointertype; + end; + + in_assigned_x: + begin + { the parser has already made sure the expression is valid } + + { in case of a complex procvar, only check the "code" pointer } + if (tcallparanode(left).left.resultdef.typ=procvardef) and + not tprocvardef(tcallparanode(left).left.resultdef).is_addressonly then + begin + inserttypeconv_explicit(tcallparanode(left).left,search_system_type('TMETHOD').typedef); + tcallparanode(left).left:=csubscriptnode.create(tsym(tabstractrecorddef(tcallparanode(left).left.resultdef).symtable.find('CODE')),tcallparanode(left).left); + tcallparanode(left).get_paratype; + end; + + { converting to an add node is tricky because of differences + in procvar handling between FPC and Delphi handling, so + handle specially } + set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]); + resultdef:=pasbool8type; + end; + + in_ofs_x : + internalerror(2000101001); + + in_seg_x : + begin + set_varstate(left,vs_read,[]); + result:=cordconstnode.create(0,s32inttype,false); + end; + + in_pred_x, + in_succ_x: + begin + set_varstate(left,vs_read,[vsf_must_be_valid]); + resultdef:=left.resultdef; + if not is_ordinal(resultdef) then + CGMessage(type_e_ordinal_expr_expected) + else + begin + if (resultdef.typ=enumdef) and + (tenumdef(resultdef).has_jumps) and + not(m_delphi in current_settings.modeswitches) then + CGMessage(type_e_succ_and_pred_enums_with_assign_not_possible); + end; + end; + + in_initialize_x, + in_finalize_x, + in_setlength_x: + begin + { inlined from pinline } + internalerror(200204231); + end; + + in_inc_x, + in_dec_x: + begin + resultdef:=voidtype; + if assigned(left) then + begin + { first param must be var } + valid_for_var(tcallparanode(left).left,true); + set_varstate(tcallparanode(left).left,vs_readwritten,[vsf_must_be_valid]); + + if (left.resultdef.typ in [enumdef,pointerdef]) or + is_ordinal(left.resultdef) or + is_currency(left.resultdef) then + begin + { value of left gets changed -> must be unique } + set_unique(tcallparanode(left).left); + { two paras ? } + if assigned(tcallparanode(left).right) then + begin + if is_integer(tcallparanode(left).right.resultdef) then + begin + set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]); + { when range/overflow checking is on, we + convert this to a regular add, and for proper + checking we need the original type } + if ([cs_check_range,cs_check_overflow]*current_settings.localswitches=[]) then + if (tcallparanode(left).left.resultdef.typ=pointerdef) then + begin + { don't convert values added to pointers into the pointer types themselves, + because that will turn signed values into unsigned ones, which then + goes wrong when they have to be multiplied with the size of the elements + to which the pointer points in ncginl (mantis #17342) } + if is_signed(tcallparanode(tcallparanode(left).right).left.resultdef) then + inserttypeconv(tcallparanode(tcallparanode(left).right).left,ptrsinttype) + else + inserttypeconv(tcallparanode(tcallparanode(left).right).left,ptruinttype) + end + else if is_integer(tcallparanode(left).left.resultdef) then + inserttypeconv(tcallparanode(tcallparanode(left).right).left,tcallparanode(left).left.resultdef) + else + inserttypeconv_internal(tcallparanode(tcallparanode(left).right).left,tcallparanode(left).left.resultdef); + if assigned(tcallparanode(tcallparanode(left).right).right) then + { should be handled in the parser (JM) } + internalerror(2006020901); + end + else + CGMessagePos(tcallparanode(left).right.fileinfo,type_e_ordinal_expr_expected); + end; + end + else + begin + hp:=self; + if isunaryoverloaded(hp) then + begin + { inc(rec) and dec(rec) assigns result value to argument } + result:=cassignmentnode.create(tcallparanode(left).left.getcopy,hp); + exit; + end + else + CGMessagePos(left.fileinfo,type_e_ordinal_expr_expected); + end; + end + else + CGMessagePos(fileinfo,type_e_mismatch); + end; + + in_read_x, + in_readln_x, + in_readstr_x, + in_write_x, + in_writeln_x, + in_writestr_x : + begin + result := handle_read_write; + end; + + in_settextbuf_file_x : + begin + resultdef:=voidtype; + { now we know the type of buffer } + hp:=ccallparanode.create(cordconstnode.create( + tcallparanode(left).left.resultdef.size,s32inttype,true),left); + result:=ccallnode.createintern('SETTEXTBUF',hp); + left:=nil; + end; + + { the firstpass of the arg has been done in firstcalln ? } + in_reset_typedfile, + in_rewrite_typedfile : + begin + result := handle_reset_rewrite_typed; + end; + + in_str_x_string : + begin + result:=handle_str; + end; + + in_val_x : + begin + result:=handle_val; + end; + + in_include_x_y, + in_exclude_x_y: + begin + resultdef:=voidtype; + { the parser already checks whether we have two (and exactly two) } + { parameters (JM) } + { first param must be var } + valid_for_var(tcallparanode(left).left,true); + set_varstate(tcallparanode(left).left,vs_readwritten,[vsf_must_be_valid]); + { check type } + if (left.resultdef.typ=setdef) then + begin + { insert a type conversion } + { to the type of the set elements } + set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]); + inserttypeconv(tcallparanode(tcallparanode(left).right).left, + tsetdef(left.resultdef).elementdef); + end + else + CGMessage(type_e_mismatch); + end; + in_pack_x_y_z, + in_unpack_x_y_z : + begin + handle_pack_unpack; + end; + + in_slice_x: + begin + result:=nil; + resultdef:=tcallparanode(left).left.resultdef; + if (resultdef.typ <> arraydef) then + CGMessagePos(left.fileinfo,type_e_mismatch) + else if is_packed_array(resultdef) then + CGMessagePos2(left.fileinfo,type_e_got_expected_unpacked_array,'1',resultdef.typename); + if not(is_integer(tcallparanode(tcallparanode(left).right).left.resultdef)) then + CGMessagePos1(tcallparanode(left).right.fileinfo, + type_e_integer_expr_expected, + tcallparanode(tcallparanode(left).right).left.resultdef.typename); + end; + + in_low_x, + in_high_x: + begin + case left.resultdef.typ of + orddef, + enumdef, + setdef: + ; + arraydef: + begin + if (inlinenumber=in_low_x) then + set_varstate(left,vs_read,[]) + else + begin + if is_open_array(left.resultdef) or + is_array_of_const(left.resultdef) then + begin + set_varstate(left,vs_read,[]); + result:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry)); + end + else + if is_dynamic_array(left.resultdef) then + begin + set_varstate(left,vs_read,[vsf_must_be_valid]); + { can't use inserttypeconv because we need } + { an explicit type conversion (JM) } + hp := ccallparanode.create(ctypeconvnode.create_internal(left,voidpointertype),nil); + result := ccallnode.createintern('fpc_dynarray_high',hp); + { make sure the left node doesn't get disposed, since it's } + { reused in the new node (JM) } + left:=nil; + end + else + begin + set_varstate(left,vs_read,[]); + end; + end; + end; + stringdef: + begin + if inlinenumber=in_low_x then + begin + set_varstate(left,vs_read,[]); + end + else + begin + if is_open_string(left.resultdef) then + begin + set_varstate(left,vs_read,[]); + result:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry)) + end + else if is_ansistring(left.resultdef) or + is_wide_or_unicode_string(left.resultdef) then + CGMessage(type_e_mismatch) + end; + end; + else + CGMessage(type_e_mismatch); + end; + end; + + in_exp_real, + in_frac_real, + in_int_real, + in_cos_real, + in_sin_real, + in_arctan_real, + in_abs_real, + in_ln_real : + begin + set_varstate(left,vs_read,[vsf_must_be_valid]); + { converting an int64 to double on platforms without } + { extended can cause precision loss } + if not(left.nodetype in [ordconstn,realconstn]) then + inserttypeconv(left,pbestrealtype^); + resultdef:=pbestrealtype^; + end; + + in_trunc_real, + in_round_real : + begin + set_varstate(left,vs_read,[vsf_must_be_valid]); + { for direct float rounding, no best real type cast should be necessary } + if not((left.resultdef.typ=floatdef) and + (tfloatdef(left.resultdef).floattype in [s32real,s64real,s80real,sc80real,s128real])) and + { converting an int64 to double on platforms without } + { extended can cause precision loss } + not(left.nodetype in [ordconstn,realconstn]) then + inserttypeconv(left,pbestrealtype^); + resultdef:=s64inttype; + end; + + in_pi_real : + begin + resultdef:=pbestrealtype^; + end; + + in_abs_long: + begin + set_varstate(left,vs_read,[vsf_must_be_valid]); + inserttypeconv(left,s32inttype); + resultdef:=s32inttype; + end; + + in_sqr_real, + in_sqrt_real : + begin + set_varstate(left,vs_read,[vsf_must_be_valid]); + setfloatresultdef; + end; + +{$ifdef SUPPORT_MMX} + in_mmx_pcmpeqb..in_mmx_pcmpgtw: + begin + end; +{$endif SUPPORT_MMX} + in_unaligned_x: + begin + resultdef:=left.resultdef; + end; + in_assert_x_y : + begin + resultdef:=voidtype; + if assigned(left) then + begin + set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]); + { check type } + if is_boolean(left.resultdef) then + begin + set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]); + { must always be a string } + inserttypeconv(tcallparanode(tcallparanode(left).right).left,cshortstringtype); + end + else + CGMessage1(type_e_boolean_expr_expected,left.resultdef.typename); + end + else + CGMessage(type_e_mismatch); + + if (cs_do_assertion in current_settings.localswitches) then + include(current_procinfo.flags,pi_do_call); + end; + in_prefetch_var: + resultdef:=voidtype; + in_get_frame, + in_get_caller_frame, + in_get_caller_addr: + begin + resultdef:=voidpointertype; + end; + in_rol_x, + in_ror_x, + in_sar_x: + begin + set_varstate(left,vs_read,[vsf_must_be_valid]); + resultdef:=left.resultdef; + end; + in_rol_x_y, + in_ror_x_y, + in_sar_x_y: + begin + set_varstate(tcallparanode(left).left,vs_read,[vsf_must_be_valid]); + set_varstate(tcallparanode(tcallparanode(left).right).left,vs_read,[vsf_must_be_valid]); + resultdef:=tcallparanode(tcallparanode(left).right).left.resultdef; + end; + in_bsf_x, + in_bsr_x: + begin + set_varstate(left,vs_read,[vsf_must_be_valid]); + if not is_integer(left.resultdef) then + CGMessage1(type_e_integer_expr_expected,left.resultdef.typename); + if torddef(left.resultdef).ordtype in [u64bit, s64bit] then + resultdef:=u64inttype + else + resultdef:=u32inttype + end; + + in_objc_selector_x: + begin + result:=cobjcselectornode.create(left); + { reused } + left:=nil; + end; + in_objc_protocol_x: + begin + result:=cobjcprotocolnode.create(left); + { reused } + left:=nil; + end; + in_objc_encode_x: + begin + result:=handle_objc_encode; + end; + else + internalerror(8); + end; + end; + + if not assigned(result) and not + codegenerror then + result:=simplify(false); + end; + + + function tinlinenode.pass_1 : tnode; + var + hp,hpp,resultnode : tnode; + shiftconst: longint; + tempnode: ttempcreatenode; + newstatement: tstatementnode; + newblock: tblocknode; + + begin + result:=nil; + { if we handle writeln; left contains no valid address } + if assigned(left) then + begin + if left.nodetype=callparan then + tcallparanode(left).firstcallparan + else + firstpass(left); + end; + + { intern const should already be handled } + if nf_inlineconst in flags then + internalerror(200104044); + case inlinenumber of + in_lo_qword, + in_hi_qword, + in_lo_long, + in_hi_long, + in_lo_word, + in_hi_word: + begin + shiftconst := 0; + case inlinenumber of + in_hi_qword: + shiftconst := 32; + in_hi_long: + shiftconst := 16; + in_hi_word: + shiftconst := 8; + end; + if shiftconst <> 0 then + result := ctypeconvnode.create_internal(cshlshrnode.create(shrn,left, + cordconstnode.create(shiftconst,u32inttype,false)),resultdef) + else + result := ctypeconvnode.create_internal(left,resultdef); + left := nil; + firstpass(result); + end; + + in_sizeof_x: + begin + expectloc:=LOC_REGISTER; + end; + + in_typeof_x: + begin + expectloc:=LOC_REGISTER; + end; + + in_length_x: + begin + if is_shortstring(left.resultdef) then + expectloc:=left.expectloc + else + begin + { ansi/wide string } + expectloc:=LOC_REGISTER; + end; + end; + + in_typeinfo_x: + begin + expectloc:=LOC_REGISTER; + end; + + in_assigned_x: + begin + expectloc := LOC_JUMP; + end; + + in_pred_x, + in_succ_x: + begin + expectloc:=LOC_REGISTER; + { in case of range/overflow checking, use a regular addnode + because it's too complex to handle correctly otherwise } + if ([cs_check_overflow,cs_check_range]*current_settings.localswitches)<>[] then + begin + { create constant 1 } + hp:=cordconstnode.create(1,left.resultdef,false); + typecheckpass(hp); + if not is_integer(hp.resultdef) then + inserttypeconv_internal(hp,sinttype); + + { avoid type errors from the addn/subn } + if not is_integer(left.resultdef) then + inserttypeconv_internal(left,sinttype); + + { addition/substraction depending on succ/pred } + if inlinenumber=in_succ_x then + hp:=caddnode.create(addn,left,hp) + else + hp:=caddnode.create(subn,left,hp); + { assign result of addition } + if not(is_integer(resultdef)) then + inserttypeconv(hp,torddef.create( +{$ifdef cpu64bitaddr} + s64bit, +{$else cpu64bitaddr} + s32bit, +{$endif cpu64bitaddr} + get_min_value(resultdef), + get_max_value(resultdef))) + else + inserttypeconv(hp,resultdef); + + { avoid any possible errors/warnings } + inserttypeconv_internal(hp,resultdef); + + { firstpass it } + firstpass(hp); + + { left is reused } + left:=nil; + + { return new node } + result:=hp; + end; + end; + + in_setlength_x, + in_initialize_x, + in_finalize_x: + begin + expectloc:=LOC_VOID; + end; + + in_inc_x, + in_dec_x: + begin + expectloc:=LOC_VOID; + + { range/overflow checking doesn't work properly } + { with the inc/dec code that's generated (JM) } + if (current_settings.localswitches * [cs_check_overflow,cs_check_range] <> []) and + { No overflow check for pointer operations, because inc(pointer,-1) will always + trigger an overflow. For uint32 it works because then the operation is done + in 64bit. Range checking is not applicable to pointers either } + (tcallparanode(left).left.resultdef.typ<>pointerdef) then + { convert to simple add (JM) } + begin + newblock := internalstatements(newstatement); + { extra parameter? } + if assigned(tcallparanode(left).right) then + begin + { Yes, use for add node } + hpp := tcallparanode(tcallparanode(left).right).left; + tcallparanode(tcallparanode(left).right).left := nil; + if assigned(tcallparanode(tcallparanode(left).right).right) then + CGMessage(parser_e_illegal_expression); + end + else + begin + { no, create constant 1 } + hpp := cordconstnode.create(1,tcallparanode(left).left.resultdef,false); + end; + typecheckpass(hpp); + + { make sure we don't call functions part of the left node twice (and generally } + { optimize the code generation) } + if node_complexity(tcallparanode(left).left) > 1 then + begin + tempnode := ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true); + addstatement(newstatement,tempnode); + addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(tempnode), + caddrnode.create_internal(tcallparanode(left).left.getcopy))); + hp := cderefnode.create(ctemprefnode.create(tempnode)); + inserttypeconv_internal(hp,tcallparanode(left).left.resultdef); + end + else + begin + hp := tcallparanode(left).left.getcopy; + tempnode := nil; + end; + + resultnode := hp.getcopy; + { avoid type errors from the addn/subn } + if not is_integer(resultnode.resultdef) then + begin + inserttypeconv_internal(hp,sinttype); + inserttypeconv_internal(hpp,sinttype); + end; + + { addition/substraction depending on inc/dec } + if inlinenumber = in_inc_x then + hpp := caddnode.create(addn,hp,hpp) + else + hpp := caddnode.create(subn,hp,hpp); + { assign result of addition } + if not(is_integer(resultnode.resultdef)) then + inserttypeconv(hpp,torddef.create( +{$ifdef cpu64bitaddr} + s64bit, +{$else cpu64bitaddr} + s32bit, +{$endif cpu64bitaddr} + get_min_value(resultnode.resultdef), + get_max_value(resultnode.resultdef))) + else + inserttypeconv(hpp,resultnode.resultdef); + { avoid any possible warnings } + inserttypeconv_internal(hpp,resultnode.resultdef); + + addstatement(newstatement,cassignmentnode.create(resultnode,hpp)); + { deallocate the temp } + if assigned(tempnode) then + addstatement(newstatement,ctempdeletenode.create(tempnode)); + { firstpass it } + firstpass(tnode(newblock)); + { return new node } + result := newblock; + end; + end; + + in_include_x_y, + in_exclude_x_y: + begin + expectloc:=LOC_VOID; + end; + + in_pack_x_y_z, + in_unpack_x_y_z: + begin + result:=first_pack_unpack; + end; + + in_exp_real: + begin + result:= first_exp_real; + end; + + in_round_real: + begin + result:= first_round_real; + end; + + in_trunc_real: + begin + result:= first_trunc_real; + end; + + in_int_real: + begin + result:= first_int_real; + end; + + in_frac_real: + begin + result:= first_frac_real; + end; + + in_cos_real: + begin + result:= first_cos_real; + end; + + in_sin_real: + begin + result := first_sin_real; + end; + + in_arctan_real: + begin + result := first_arctan_real; + end; + + in_pi_real : + begin + result := first_pi; + end; + + in_abs_real: + begin + result := first_abs_real; + end; + + in_abs_long: + begin + result := first_abs_long; + end; + + in_sqr_real: + begin + result := first_sqr_real; + end; + + in_sqrt_real: + begin + result := first_sqrt_real; + end; + + in_ln_real: + begin + result := first_ln_real; + end; + +{$ifdef SUPPORT_MMX} + in_mmx_pcmpeqb..in_mmx_pcmpgtw: + begin + end; +{$endif SUPPORT_MMX} + + in_assert_x_y : + begin + expectloc:=LOC_VOID; + end; + + in_low_x, + in_high_x: + internalerror(200104047); + + in_slice_x: + internalerror(2005101501); + + in_ord_x, + in_chr_byte: + begin + { should not happend as it's converted to typeconv } + internalerror(200104045); + end; + + in_ofs_x : + internalerror(2000101001); + + in_seg_x : + internalerror(200104046); + + in_settextbuf_file_x, + in_reset_typedfile, + in_rewrite_typedfile, + in_str_x_string, + in_val_x, + in_read_x, + in_readln_x, + in_write_x, + in_writeln_x : + begin + { should be handled by pass_typecheck } + internalerror(200108234); + end; + in_get_frame: + begin + include(current_procinfo.flags,pi_needs_stackframe); + expectloc:=LOC_CREGISTER; + end; + in_get_caller_frame: + begin + expectloc:=LOC_REGISTER; + end; + in_get_caller_addr: + begin + expectloc:=LOC_REGISTER; + end; + + in_prefetch_var: + begin + expectloc:=LOC_VOID; + end; + in_unaligned_x: + begin + expectloc:=tcallparanode(left).left.expectloc; + end; + in_rol_x, + in_rol_x_y, + in_ror_x, + in_ror_x_y, + in_sar_x, + in_sar_x_y, + in_bsf_x, + in_bsr_x: + expectloc:=LOC_REGISTER; + else + internalerror(89); + end; + end; +{$maxfpuregisters default} + + function tinlinenode.docompare(p: tnode): boolean; + begin + docompare := + inherited docompare(p) and + (inlinenumber = tinlinenode(p).inlinenumber); + end; + + + function tinlinenode.first_pi : tnode; + begin + result:=crealconstnode.create(getpi,pbestrealtype^); + end; + + + function tinlinenode.first_arctan_real : tnode; + begin + { create the call to the helper } + { on entry left node contains the parameter } + first_arctan_real := ccallnode.createintern('fpc_arctan_real', + ccallparanode.create(left,nil)); + left := nil; + end; + + function tinlinenode.first_abs_real : tnode; + begin + { create the call to the helper } + { on entry left node contains the parameter } + first_abs_real := ccallnode.createintern('fpc_abs_real', + ccallparanode.create(left,nil)); + left := nil; + end; + + function tinlinenode.first_sqr_real : tnode; + begin +{$ifndef cpufpemu} + { this procedure might be only used for cpus definining cpufpemu else + the optimizer might go into an endless loop when doing x*x -> changes } + internalerror(2011092401); +{$endif cpufpemu} + { create the call to the helper } + { on entry left node contains the parameter } + first_sqr_real := ctypeconvnode.create(ccallnode.createintern('fpc_sqr_real', + ccallparanode.create(left,nil)),resultdef); + left := nil; + end; + + function tinlinenode.first_sqrt_real : tnode; + begin + { create the call to the helper } + { on entry left node contains the parameter } + first_sqrt_real := ctypeconvnode.create(ccallnode.createintern('fpc_sqrt_real', + ccallparanode.create(left,nil)),resultdef); + left := nil; + end; + + function tinlinenode.first_ln_real : tnode; + begin + { create the call to the helper } + { on entry left node contains the parameter } + first_ln_real := ccallnode.createintern('fpc_ln_real', + ccallparanode.create(left,nil)); + left := nil; + end; + + function tinlinenode.first_cos_real : tnode; + begin + { create the call to the helper } + { on entry left node contains the parameter } + first_cos_real := ccallnode.createintern('fpc_cos_real', + ccallparanode.create(left,nil)); + left := nil; + end; + + function tinlinenode.first_sin_real : tnode; + begin + { create the call to the helper } + { on entry left node contains the parameter } + first_sin_real := ccallnode.createintern('fpc_sin_real', + ccallparanode.create(left,nil)); + left := nil; + end; + + function tinlinenode.first_exp_real : tnode; + begin + { create the call to the helper } + { on entry left node contains the parameter } + result := ccallnode.createintern('fpc_exp_real',ccallparanode.create(left,nil)); + left := nil; + end; + + function tinlinenode.first_int_real : tnode; + begin + { create the call to the helper } + { on entry left node contains the parameter } + result := ccallnode.createintern('fpc_int_real',ccallparanode.create(left,nil)); + left := nil; + end; + + function tinlinenode.first_frac_real : tnode; + begin + { create the call to the helper } + { on entry left node contains the parameter } + result := ccallnode.createintern('fpc_frac_real',ccallparanode.create(left,nil)); + left := nil; + end; + + function tinlinenode.first_round_real : tnode; + begin + { create the call to the helper } + { on entry left node contains the parameter } + result := ccallnode.createintern('fpc_round_real',ccallparanode.create(left,nil)); + left := nil; + end; + + function tinlinenode.first_trunc_real : tnode; + begin + { create the call to the helper } + { on entry left node contains the parameter } + result := ccallnode.createintern('fpc_trunc_real',ccallparanode.create(left,nil)); + left := nil; + end; + + function tinlinenode.first_abs_long : tnode; + begin + expectloc:=LOC_REGISTER; + result:=nil; + end; + + function tinlinenode.first_pack_unpack: tnode; + var + loopstatement : tstatementnode; + loop : tblocknode; + loopvar : ttempcreatenode; + tempnode, + source, + target, + index, + unpackednode, + packednode, + sourcevecindex, + targetvecindex, + loopbody : tnode; + temprangedef : tdef; + ulorange, + uhirange, + plorange, + phirange : TConstExprInt; + begin + { transform into a for loop which assigns the data of the (un)packed } + { array to the other one } + source := left; + if (inlinenumber = in_unpack_x_y_z) then + begin + target := tcallparanode(source).right; + index := tcallparanode(target).right; + packednode := tcallparanode(source).left; + unpackednode := tcallparanode(target).left; + end + else + begin + index := tcallparanode(source).right; + target := tcallparanode(index).right; + packednode := tcallparanode(target).left; + unpackednode := tcallparanode(source).left; + end; + source := tcallparanode(source).left; + target := tcallparanode(target).left; + index := tcallparanode(index).left; + + loop := internalstatements(loopstatement); + loopvar := ctempcreatenode.create( + tarraydef(packednode.resultdef).rangedef, + tarraydef(packednode.resultdef).rangedef.size, + tt_persistent,true); + addstatement(loopstatement,loopvar); + + { For range checking: we have to convert to an integer type (in case the index type } + { is an enum), add the index and loop variable together, convert the result } + { implicitly to an orddef with range equal to the rangedef to get range checking } + { and finally convert it explicitly back to the actual rangedef to avoid type } + { errors } + temprangedef:=nil; + getrange(unpackednode.resultdef,ulorange,uhirange); + getrange(packednode.resultdef,plorange,phirange); + temprangedef:=torddef.create(torddef(sinttype).ordtype,ulorange,uhirange); + sourcevecindex := ctemprefnode.create(loopvar); + targetvecindex := ctypeconvnode.create_internal(index.getcopy,sinttype); + targetvecindex := caddnode.create(subn,targetvecindex,cordconstnode.create(plorange,sinttype,true)); + targetvecindex := caddnode.create(addn,targetvecindex,ctemprefnode.create(loopvar)); + targetvecindex := ctypeconvnode.create(targetvecindex,temprangedef); + targetvecindex := ctypeconvnode.create_explicit(targetvecindex,tarraydef(unpackednode.resultdef).rangedef); + + if (inlinenumber = in_pack_x_y_z) then + begin + { swap source and target vec indices } + tempnode := sourcevecindex; + sourcevecindex := targetvecindex; + targetvecindex := tempnode; + end; + + { create the assignment in the loop body } + loopbody := + cassignmentnode.create( + cvecnode.create(target.getcopy,targetvecindex), + cvecnode.create(source.getcopy,sourcevecindex) + ); + { create the actual for loop } + tempnode := cfornode.create( + ctemprefnode.create(loopvar), + cinlinenode.create(in_low_x,false,packednode.getcopy), + cinlinenode.create(in_high_x,false,packednode.getcopy), + loopbody, + false); + addstatement(loopstatement,tempnode); + { free the loop counter } + addstatement(loopstatement,ctempdeletenode.create(loopvar)); + result := loop; + end; + +end. diff --git a/closures/compiler/nld.pas b/closures/compiler/nld.pas new file mode 100644 index 0000000000..2f2dc872af --- /dev/null +++ b/closures/compiler/nld.pas @@ -0,0 +1,1269 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + Type checking and register allocation for load/assignment 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 nld; + +{$i fpcdefs.inc} + +interface + + uses + node, + {$ifdef state_tracking} + nstate, + {$endif} + symconst,symbase,symtype,symsym,symdef; + + type + Trttidatatype = (rdt_normal,rdt_ord2str,rdt_str2ord); + + tloadnodeflags = ( + loadnf_is_self, + loadnf_load_self_pointer, + loadnf_inherited, + { the loadnode is generated internally and a varspez=vs_const should be ignore, + this requires that the parameter is actually passed by value + Be really carefull when using this flag! } + loadnf_isinternal_ignoreconst, + + loadnf_only_uninitialized_hint + ); + + tloadnode = class(tunarynode) + protected + fprocdef : tprocdef; + fprocdefderef : tderef; + public + loadnodeflags : set of tloadnodeflags; + symtableentry : tsym; + symtableentryderef : tderef; + symtable : TSymtable; + constructor create(v : tsym;st : TSymtable);virtual; + constructor create_procvar(v : tsym;d:tprocdef;st : TSymtable);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + procedure set_mp(p:tnode); + function is_addr_param_load:boolean; + function dogetcopy : tnode;override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + procedure mark_write;override; + function docompare(p: tnode): boolean; override; + procedure printnodedata(var t:text);override; + procedure setprocdef(p : tprocdef); + property procdef: tprocdef read fprocdef write setprocdef; + end; + tloadnodeclass = class of tloadnode; + + { different assignment types } + tassigntype = (at_normal,at_plus,at_minus,at_star,at_slash); + + tassignmentnode = class(tbinarynode) + assigntype : tassigntype; + constructor create(l,r : tnode);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function dogetcopy : tnode;override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function simplify(forinline : boolean) : tnode;override; + {$ifdef state_tracking} + function track_state_pass(exec_known:boolean):boolean;override; + {$endif state_tracking} + function docompare(p: tnode): boolean; override; + end; + tassignmentnodeclass = class of tassignmentnode; + + tarrayconstructorrangenode = class(tbinarynode) + constructor create(l,r : tnode);virtual; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + end; + tarrayconstructorrangenodeclass = class of tarrayconstructorrangenode; + + tarrayconstructornode = class(tbinarynode) + constructor create(l,r : tnode);virtual; + function dogetcopy : tnode;override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function docompare(p: tnode): boolean; override; + procedure force_type(def:tdef); + procedure insert_typeconvs; + end; + tarrayconstructornodeclass = class of tarrayconstructornode; + + ttypenode = class(tnode) + allowed : boolean; + helperallowed : boolean; + typedef : tdef; + typedefderef : tderef; + typesym : tsym; + typesymderef : tderef; + constructor create(def:tdef);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function dogetcopy : tnode;override; + function docompare(p: tnode): boolean; override; + end; + ttypenodeclass = class of ttypenode; + + trttinode = class(tnode) + l1,l2 : longint; + rttitype : trttitype; + rttidef : tstoreddef; + rttidefderef : tderef; + rttidatatype : Trttidatatype; + constructor create(def:tstoreddef;rt:trttitype;dt:Trttidatatype);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + function dogetcopy : tnode;override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function docompare(p: tnode): boolean; override; + end; + trttinodeclass = class of trttinode; + + var + cloadnode : tloadnodeclass = tloadnode; + cassignmentnode : tassignmentnodeclass = tassignmentnode; + carrayconstructorrangenode : tarrayconstructorrangenodeclass = tarrayconstructorrangenode; + carrayconstructornode : tarrayconstructornodeclass = tarrayconstructornode; + ctypenode : ttypenodeclass = ttypenode; + crttinode : trttinodeclass = trttinode; + + { Current assignment node } + aktassignmentnode : tassignmentnode; + + +implementation + + uses + cutils,verbose,globtype,globals,systems, + symnot,symtable, + defutil,defcmp, + htypechk,pass_1,procinfo,paramgr, + cpuinfo, + ncon,ninl,ncnv,nmem,ncal,nutils,nbas, + cgobj,cgbase + ; + +{***************************************************************************** + TLOADNODE +*****************************************************************************} + + constructor tloadnode.create(v : tsym;st : TSymtable); + begin + inherited create(loadn,nil); + if not assigned(v) then + internalerror(200108121); + symtableentry:=v; + symtable:=st; + fprocdef:=nil; + end; + + + constructor tloadnode.create_procvar(v : tsym;d:tprocdef;st : TSymtable); + begin + inherited create(loadn,nil); + if not assigned(v) then + internalerror(200108122); + symtableentry:=v; + symtable:=st; + fprocdef:=d; + end; + + + constructor tloadnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + ppufile.getderef(symtableentryderef); + symtable:=nil; + ppufile.getderef(fprocdefderef); + ppufile.getsmallset(loadnodeflags); + end; + + + procedure tloadnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(symtableentryderef); + ppufile.putderef(fprocdefderef); + ppufile.putsmallset(loadnodeflags); + end; + + + procedure tloadnode.buildderefimpl; + begin + inherited buildderefimpl; + symtableentryderef.build(symtableentry); + fprocdefderef.build(fprocdef); + end; + + + procedure tloadnode.derefimpl; + begin + inherited derefimpl; + symtableentry:=tsym(symtableentryderef.resolve); + symtable:=symtableentry.owner; + fprocdef:=tprocdef(fprocdefderef.resolve); + end; + + + procedure tloadnode.set_mp(p:tnode); + begin + { typen nodes should not be set } + if p.nodetype=typen then + internalerror(200301042); + left:=p; + end; + + + function tloadnode.dogetcopy : tnode; + var + n : tloadnode; + + begin + n:=tloadnode(inherited dogetcopy); + n.symtable:=symtable; + n.symtableentry:=symtableentry; + n.fprocdef:=fprocdef; + result:=n; + end; + + + function tloadnode.is_addr_param_load:boolean; + begin + result:=(symtable.symtabletype=parasymtable) and + (symtableentry.typ=paravarsym) and + not(vo_has_local_copy in tparavarsym(symtableentry).varoptions) and + not(loadnf_load_self_pointer in loadnodeflags) and + paramanager.push_addr_param(tparavarsym(symtableentry).varspez,tparavarsym(symtableentry).vardef,tprocdef(symtable.defowner).proccalloption); + end; + + + function tloadnode.pass_typecheck:tnode; + begin + result:=nil; + case symtableentry.typ of + absolutevarsym : + resultdef:=tabsolutevarsym(symtableentry).vardef; + constsym: + begin + if tconstsym(symtableentry).consttyp=constresourcestring then + resultdef:=getansistringdef + else + internalerror(22799); + end; + staticvarsym : + begin + tabstractvarsym(symtableentry).IncRefCountBy(1); + { static variables referenced in procedures or from finalization, + variable needs to be in memory. + It is too hard and the benefit is too small to detect whether a + variable is only used in the finalization to add support for it (PFV) } + if assigned(current_procinfo) and + (symtable.symtabletype=staticsymtable) and + ( + (symtable.symtablelevel<>current_procinfo.procdef.localst.symtablelevel) or + (current_procinfo.procdef.proctypeoption=potype_unitfinalize) + ) then + make_not_regable(self,[ra_addr_taken]); + resultdef:=tabstractvarsym(symtableentry).vardef; + end; + paravarsym, + localvarsym : + begin + tabstractvarsym(symtableentry).IncRefCountBy(1); + { Nested variable? The we need to load the framepointer of + the parent procedure } + if assigned(current_procinfo) and + (symtable.symtabletype in [localsymtable,parasymtable]) and + (symtable.symtablelevel<>current_procinfo.procdef.parast.symtablelevel) then + begin + if assigned(left) then + internalerror(200309289); + left:=cloadparentfpnode.create(tprocdef(symtable.defowner)); + { we can't inline the referenced parent procedure } + exclude(tprocdef(symtable.defowner).procoptions,po_inline); + { reference in nested procedures, variable needs to be in memory } + { and behaves as if its address escapes its parent block } + make_not_regable(self,[ra_addr_taken]); + end; + { fix self type which is declared as voidpointer in the + definition } + if vo_is_self in tabstractvarsym(symtableentry).varoptions then + begin + resultdef:=tprocdef(symtableentry.owner.defowner).struct; + if is_objectpascal_helper(resultdef) then + resultdef:=tobjectdef(resultdef).extendeddef; + if (po_classmethod in tprocdef(symtableentry.owner.defowner).procoptions) or + (po_staticmethod in tprocdef(symtableentry.owner.defowner).procoptions) then + resultdef:=tclassrefdef.create(resultdef) + else if (is_object(resultdef) or is_record(resultdef)) and + (loadnf_load_self_pointer in loadnodeflags) then + resultdef:=tpointerdef.create(resultdef); + end + else if vo_is_vmt in tabstractvarsym(symtableentry).varoptions then + begin + resultdef:=tprocdef(symtableentry.owner.defowner).struct; + resultdef:=tclassrefdef.create(resultdef); + end + else + resultdef:=tabstractvarsym(symtableentry).vardef; + end; + procsym : + begin + { Return the first procdef. In case of overloaded + procdefs the matching procdef will be choosen + when the expected procvardef is known, see get_information + in htypechk.pas (PFV) } + if not assigned(fprocdef) then + fprocdef:=tprocdef(tprocsym(symtableentry).ProcdefList[0]) + else if po_kylixlocal in fprocdef.procoptions then + CGMessage(type_e_cant_take_address_of_local_subroutine); + + { the result is a fprocdef, addrn and proc_to_procvar + typeconvn need this as resultdef so they know + that the address needs to be returned } + resultdef:=fprocdef; + + { process methodpointer/framepointer } + if assigned(left) then + typecheckpass(left); + end; + labelsym: + begin + tlabelsym(symtableentry).used:=true; + resultdef:=voidtype; + end; + else + internalerror(200104141); + end; + end; + + procedure Tloadnode.mark_write; + + begin + include(flags,nf_write); + end; + + function tloadnode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_REFERENCE; + if (cs_create_pic in current_settings.moduleswitches) and + not(symtableentry.typ in [paravarsym,localvarsym]) then + include(current_procinfo.flags,pi_needs_got); + + case symtableentry.typ of + absolutevarsym : + ; + constsym: + begin + if tconstsym(symtableentry).consttyp=constresourcestring then + expectloc:=LOC_CREFERENCE; + end; + staticvarsym, + localvarsym, + paravarsym : + begin + if assigned(left) then + firstpass(left); + if not is_addr_param_load and + tabstractvarsym(symtableentry).is_regvar(is_addr_param_load) then + expectloc:=tvarregable2tcgloc[tabstractvarsym(symtableentry).varregable] + else + if (tabstractvarsym(symtableentry).varspez=vs_const) then + expectloc:=LOC_CREFERENCE; + if (target_info.system=system_powerpc_darwin) and + ([vo_is_dll_var,vo_is_external] * tabstractvarsym(symtableentry).varoptions <> []) then + include(current_procinfo.flags,pi_needs_got); + { call to get address of threadvar } + if (vo_is_thread_var in tabstractvarsym(symtableentry).varoptions) then + include(current_procinfo.flags,pi_do_call); + if nf_write in flags then + Tabstractvarsym(symtableentry).trigger_notifications(vn_onwrite) + else + Tabstractvarsym(symtableentry).trigger_notifications(vn_onread); + end; + procsym : + begin + { initialise left for nested procs if necessary } + if (m_nested_procvars in current_settings.modeswitches) then + setprocdef(fprocdef); + { method pointer or nested proc ? } + if assigned(left) then + begin + expectloc:=LOC_CREFERENCE; + firstpass(left); + end; + end; + labelsym : + ; + else + internalerror(200104143); + end; + end; + + + function tloadnode.docompare(p: tnode): boolean; + begin + docompare := + inherited docompare(p) and + (symtableentry = tloadnode(p).symtableentry) and + (fprocdef = tloadnode(p).fprocdef) and + (symtable = tloadnode(p).symtable); + end; + + + procedure tloadnode.printnodedata(var t:text); + begin + inherited printnodedata(t); + write(t,printnodeindention,'symbol = ',symtableentry.name); + if symtableentry.typ=procsym then + write(t,printnodeindention,'procdef = ',fprocdef.mangledname); + writeln(t,''); + end; + + + procedure tloadnode.setprocdef(p : tprocdef); + begin + fprocdef:=p; + resultdef:=p; + { nested procedure? } + if assigned(p) and + is_nested_pd(p) then + begin + if not(m_nested_procvars in current_settings.modeswitches) then + CGMessage(type_e_cant_take_address_of_local_subroutine) + else + begin + { parent frame pointer pointer as "self" } + left.free; + left:=cloadparentfpnode.create(tprocdef(p.owner.defowner)); + end; + end + { we should never go from nested to non-nested } + else if assigned(left) and + (left.nodetype=loadparentfpn) then + internalerror(2010072201); + end; + +{***************************************************************************** + TASSIGNMENTNODE +*****************************************************************************} + + constructor tassignmentnode.create(l,r : tnode); + + begin + inherited create(assignn,l,r); + l.mark_write; + assigntype:=at_normal; + if r.nodetype = typeconvn then + ttypeconvnode(r).warn_pointer_to_signed:=false; + end; + + + constructor tassignmentnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + assigntype:=tassigntype(ppufile.getbyte); + end; + + + procedure tassignmentnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putbyte(byte(assigntype)); + end; + + + function tassignmentnode.dogetcopy : tnode; + + var + n : tassignmentnode; + + begin + n:=tassignmentnode(inherited dogetcopy); + n.assigntype:=assigntype; + result:=n; + end; + + + function tassignmentnode.simplify(forinline : boolean) : tnode; + begin + result:=nil; + { assignment nodes can perform several floating point } + { type conversions directly, so no typeconversions } + { are inserted in those cases. When inlining, a } + { variable may be replaced by a constant which can be } + { converted at compile time, so check for this case } + if is_real(left.resultdef) and + is_real(right.resultdef) and + is_constrealnode(right) and + not equal_defs(right.resultdef,left.resultdef) then + inserttypeconv(right,left.resultdef); + end; + + + function tassignmentnode.pass_typecheck:tnode; + var + hp : tnode; + useshelper : boolean; + oldassignmentnode : tassignmentnode; + begin + result:=nil; + resultdef:=voidtype; + + { must be made unique } + set_unique(left); + + typecheckpass(left); + + { PI. This is needed to return correct resultdef of add nodes for ansistrings + rawbytestring return needs to be replaced by left.resultdef } + oldassignmentnode:=aktassignmentnode; + aktassignmentnode:=self; + typecheckpass(right); + aktassignmentnode:=oldassignmentnode; + + set_varstate(right,vs_read,[vsf_must_be_valid]); + set_varstate(left,vs_written,[]); + if codegenerror then + exit; + + { tp procvar support, when we don't expect a procvar + then we need to call the procvar } + if (left.resultdef.typ<>procvardef) then + maybe_call_procvar(right,true); + + { assignments to formaldefs and open arrays aren't allowed } + if (left.resultdef.typ=formaldef) or + is_open_array(left.resultdef) then + CGMessage(type_e_assignment_not_allowed); + + { test if node can be assigned, properties are allowed } + valid_for_assignment(left,true); + + { assigning nil to a dynamic array clears the array } + if is_dynamic_array(left.resultdef) and + (right.nodetype=niln) then + begin + { remove property flag to avoid errors, see comments for } + { tf_winlikewidestring assignments below } + exclude(left.flags,nf_isproperty); + hp:=ccallparanode.create(caddrnode.create_internal + (crttinode.create(tstoreddef(left.resultdef),initrtti,rdt_normal)), + ccallparanode.create(ctypeconvnode.create_internal(left,voidpointertype),nil)); + result := ccallnode.createintern('fpc_dynarray_clear',hp); + left:=nil; + exit; + end; + + { shortstring helpers can do the conversion directly, + so treat them separatly } + if (is_shortstring(left.resultdef)) then + begin + { insert typeconv, except for chars that are handled in + secondpass and except for ansi/wide string that can + be converted immediatly } + if not(is_char(right.resultdef) or + (right.resultdef.typ=stringdef)) then + inserttypeconv(right,left.resultdef); + if right.resultdef.typ=stringdef then + begin + useshelper:=true; + { convert constant strings to shortstrings. But + skip empty constant strings, that will be handled + in secondpass } + if (right.nodetype=stringconstn) then + begin + { verify if range fits within shortstring } + { just emit a warning, delphi gives an } + { error, only if the type definition of } + { of the string is less < 255 characters } + if not is_open_string(left.resultdef) and + (tstringconstnode(right).len > tstringdef(left.resultdef).len) then + cgmessage(type_w_string_too_long); + inserttypeconv(right,left.resultdef); + if (right.nodetype=stringconstn) and + (tstringconstnode(right).len=0) then + useshelper:=false; + end + else if (tstringdef(right.resultdef).stringtype in [st_unicodestring,st_widestring]) then + Message2(type_w_implicit_string_cast_loss,right.resultdef.typename,left.resultdef.typename); + { rest is done in pass 1 (JM) } + if useshelper then + exit; + end + end + { floating point assignments can also perform the conversion directly } + else if is_real(left.resultdef) and is_real(right.resultdef) and + not is_constrealnode(right) +{$ifdef cpufpemu} + { the emulator can't do this obviously } + and not(current_settings.fputype in [fpu_libgcc,fpu_soft]) +{$endif cpufpemu} + +{$ifdef x86} + { the assignment node code can't convert a double in an } + { sse register to an extended value in memory more } + { efficiently than a type conversion node, so don't } + { bother implementing support for that } + and (use_vectorfpu(left.resultdef) or not(use_vectorfpu(right.resultdef))) +{$endif} + +{$ifdef arm} + { the assignment node code can't convert a single in + an interger register to a double in an mmregister or + vice versa } + and (use_vectorfpu(left.resultdef) and + use_vectorfpu(right.resultdef) and + (tfloatdef(left.resultdef).floattype=tfloatdef(right.resultdef).floattype)) +{$endif} + then + begin + check_ranges(fileinfo,right,left.resultdef); + end + else + begin + { check if the assignment may cause a range check error } + check_ranges(fileinfo,right,left.resultdef); + + { beginners might be confused about an error message like + Incompatible types: got "untyped" expected "LongInt" + when trying to assign the result of a procedure, so give + a better error message, see also #19122 } + if (left.resultdef.typ<>procvardef) and + (right.nodetype=calln) and is_void(right.resultdef) then + CGMessage(type_e_procedures_return_no_value) + else + inserttypeconv(right,left.resultdef); + end; + + { call helpers for interface } + if is_interfacecom_or_dispinterface(left.resultdef) then + begin + { Normal interface assignments are handled by the generic refcount incr/decr } + if not right.resultdef.is_related(left.resultdef) then + begin + { remove property flag to avoid errors, see comments for } + { tf_winlikewidestring assignments below } + exclude(left.flags,nf_isproperty); + hp:= + ccallparanode.create( + cguidconstnode.create(tobjectdef(left.resultdef).iidguid^), + ccallparanode.create( + ctypeconvnode.create_internal(right,voidpointertype), + ccallparanode.create( + ctypeconvnode.create_internal(left,voidpointertype), + nil))); + result:=ccallnode.createintern('fpc_intf_assign_by_iid',hp); + left:=nil; + right:=nil; + exit; + end; + end; + + { check if local proc/func is assigned to procvar } + if right.resultdef.typ=procvardef then + test_local_to_procvar(tprocvardef(right.resultdef),left.resultdef); + end; + + + function tassignmentnode.pass_1 : tnode; + var + hp: tnode; + oldassignmentnode : tassignmentnode; + hdef: tdef; + hs: string; + needrtti: boolean; + begin + result:=nil; + expectloc:=LOC_VOID; + + firstpass(left); + + { Optimize the reuse of the destination of the assingment in left. + Allow the use of the left inside the tree generated on the right. + This is especially useful for string routines where the destination + is pushed as a parameter. Using the final destination of left directly + save a temp allocation and copy of data (PFV) } + oldassignmentnode:=aktassignmentnode; + aktassignmentnode:=self; + firstpass(right); + aktassignmentnode:=oldassignmentnode; + if nf_assign_done_in_right in flags then + begin + result:=right; + right:=nil; + exit; + end; + + if codegenerror then + exit; + + { assignment to refcounted variable -> inc/decref } + if is_managed_type(left.resultdef) then + include(current_procinfo.flags,pi_do_call); + + needrtti:=false; + + if (is_shortstring(left.resultdef)) then + begin + if right.resultdef.typ=stringdef then + begin + if (right.nodetype<>stringconstn) or + (tstringconstnode(right).len<>0) then + begin + { remove property flag to avoid errors, see comments for } + { tf_winlikewidestring assignments below } + exclude(left.flags, nf_isproperty); + hp:=ccallparanode.create + (right, + ccallparanode.create(left,nil)); + result:=ccallnode.createintern('fpc_'+tstringdef(right.resultdef).stringtypname+'_to_shortstr',hp); + firstpass(result); + left:=nil; + right:=nil; + end; + end; + exit; + end + { call helpers for composite types containing automated types } + else if is_managed_type(left.resultdef) and + (left.resultdef.typ in [arraydef,objectdef,recorddef]) and + not is_interfacecom_or_dispinterface(left.resultdef) and + not is_dynamic_array(left.resultdef) then + begin + hp:=ccallparanode.create(caddrnode.create_internal( + crttinode.create(tstoreddef(left.resultdef),initrtti,rdt_normal)), + ccallparanode.create(ctypeconvnode.create_internal( + caddrnode.create_internal(left),voidpointertype), + ccallparanode.create(ctypeconvnode.create_internal( + caddrnode.create_internal(right),voidpointertype), + nil))); + result:=ccallnode.createintern('fpc_copy_proc',hp); + firstpass(result); + left:=nil; + right:=nil; + exit; + end + { call helpers for variant, they can contain non ref. counted types like + vararrays which must be really copied } + else if left.resultdef.typ=variantdef then + begin + { remove property flag to avoid errors, see comments for } + { tf_winlikewidestring assignments below } + exclude(left.flags,nf_isproperty); + hdef:=search_system_type('TVARDATA').typedef; + hp:=ccallparanode.create(ctypeconvnode.create_internal( + right,hdef), + ccallparanode.create(ctypeconvnode.create_internal( + left,hdef), + nil)); + result:=ccallnode.createintern('fpc_variant_copy',hp); + firstpass(result); + left:=nil; + right:=nil; + exit; + end + { call helpers for pointer-sized managed types } + else if is_widestring(left.resultdef) then + hs:='fpc_widestr_assign' + else if is_ansistring(left.resultdef) then + hs:='fpc_ansistr_assign' + else if is_unicodestring(left.resultdef) then + hs:='fpc_unicodestr_assign' + else if is_interfacecom_or_dispinterface(left.resultdef) then + hs:='fpc_intf_assign' + else if is_dynamic_array(left.resultdef) then + begin + hs:='fpc_dynarray_assign'; + needrtti:=true; + end + else + exit; + + { The first argument of these procedures is a var parameter. Properties cannot } + { be passed to var or out parameters, because in that case setters/getters are not } + { used. Further, if we would allow it in case there are no getters or setters, you } + { would need source changes in case these are introduced later on, thus defeating } + { part of the transparency advantages of properties. In this particular case, } + { however: } + { a) if there is a setter, this code will not be used since then the assignment } + { will be converted to a procedure call } + { b) the getter is irrelevant, because fpc_widestr_assign must always decrease } + { the refcount of the field to which we are writing } + { c) source code changes are not required if a setter is added/removed, because } + { this transformation is handled at compile time } + { -> we can remove the nf_isproperty flag (if any) from left, so that in case it } + { is a property which refers to a field without a setter call, we will not get } + { an error about trying to pass a property as a var parameter } + exclude(left.flags,nf_isproperty); + hp:=ccallparanode.create(ctypeconvnode.create_internal(right,voidpointertype), + ccallparanode.create(ctypeconvnode.create_internal(left,voidpointertype), + nil)); + if needrtti then + hp:=ccallparanode.create( + caddrnode.create_internal( + crttinode.create(tstoreddef(left.resultdef),initrtti,rdt_normal)), + hp); + result:=ccallnode.createintern(hs,hp); + firstpass(result); + left:=nil; + right:=nil; + end; + + + function tassignmentnode.docompare(p: tnode): boolean; + begin + docompare := + inherited docompare(p) and + (assigntype = tassignmentnode(p).assigntype); + end; + +{$ifdef state_tracking} + function Tassignmentnode.track_state_pass(exec_known:boolean):boolean; + + var se:Tstate_entry; + + begin + track_state_pass:=false; + if exec_known then + begin + track_state_pass:=right.track_state_pass(exec_known); + {Force a new resultdef pass.} + right.resultdef:=nil; + do_typecheckpass(right); + typecheckpass(right); + aktstate.store_fact(left.getcopy,right.getcopy); + end + else + aktstate.delete_fact(left); + end; +{$endif} + + +{***************************************************************************** + TARRAYCONSTRUCTORRANGENODE +*****************************************************************************} + + constructor tarrayconstructorrangenode.create(l,r : tnode); + + begin + inherited create(arrayconstructorrangen,l,r); + end; + + function tarrayconstructorrangenode.pass_typecheck:tnode; + begin + result:=nil; + typecheckpass(left); + typecheckpass(right); + set_varstate(left,vs_read,[vsf_must_be_valid]); + set_varstate(right,vs_read,[vsf_must_be_valid]); + if codegenerror then + exit; + resultdef:=left.resultdef; + end; + + + function tarrayconstructorrangenode.pass_1 : tnode; + begin + result:=nil; + CGMessage(parser_e_illegal_expression); + end; + + +{**************************************************************************** + TARRAYCONSTRUCTORNODE +*****************************************************************************} + + constructor tarrayconstructornode.create(l,r : tnode); + begin + inherited create(arrayconstructorn,l,r); + end; + + + function tarrayconstructornode.dogetcopy : tnode; + var + n : tarrayconstructornode; + begin + n:=tarrayconstructornode(inherited dogetcopy); + result:=n; + end; + + + function tarrayconstructornode.pass_typecheck:tnode; + var + hdef : tdef; + hp : tarrayconstructornode; + len : longint; + varia : boolean; + eq : tequaltype; + hnodetype : tnodetype; + begin + result:=nil; + + { are we allowing array constructor? Then convert it to a set. + Do this only if we didn't convert the arrayconstructor yet. This + is needed for the cases where the resultdef is forced for a second + run } + if not(allow_array_constructor) then + begin + hp:=tarrayconstructornode(getcopy); + arrayconstructor_to_set(tnode(hp)); + result:=hp; + exit; + end; + + { only pass left tree, right tree contains next construct if any } + hdef:=nil; + hnodetype:=errorn; + len:=0; + varia:=false; + if assigned(left) then + begin + hp:=self; + while assigned(hp) do + begin + typecheckpass(hp.left); + set_varstate(hp.left,vs_read,[vsf_must_be_valid]); + if (hdef=nil) then + begin + hdef:=hp.left.resultdef; + hnodetype:=hp.left.nodetype; + end + else + begin + { If we got a niln we don't know the type yet and need to take the + type of the next array element. + This is to handle things like [nil,tclass,tclass], see also tw8371 (PFV) } + if hnodetype=niln then + begin + eq:=compare_defs(hp.left.resultdef,hdef,hnodetype); + if eq>te_incompatible then + begin + hdef:=hp.left.resultdef; + hnodetype:=hp.left.nodetype; + end; + end + else + eq:=compare_defs(hdef,hp.left.resultdef,hp.left.nodetype); + if (not varia) and (eq<te_equal) then + begin + { If both are integers we need to take the type that can hold both + defs } + if is_integer(hdef) and is_integer(hp.left.resultdef) then + begin + if is_in_limit(hdef,hp.left.resultdef) then + hdef:=hp.left.resultdef; + end + else + if (nf_novariaallowed in flags) then + varia:=true; + end; + end; + inc(len); + hp:=tarrayconstructornode(hp.right); + end; + end; + { Set the type of empty or varia arrays to void. Also + do this if the type is array of const/open array + because those can't be used with setelementdef } + if not assigned(hdef) or + varia or + is_array_of_const(hdef) or + is_open_array(hdef) then + hdef:=voidtype; + resultdef:=tarraydef.create(0,len-1,s32inttype); + tarraydef(resultdef).elementdef:=hdef; + include(tarraydef(resultdef).arrayoptions,ado_IsConstructor); + if varia then + include(tarraydef(resultdef).arrayoptions,ado_IsVariant); + end; + + + procedure tarrayconstructornode.force_type(def:tdef); + var + hp : tarrayconstructornode; + begin + tarraydef(resultdef).elementdef:=def; + include(tarraydef(resultdef).arrayoptions,ado_IsConstructor); + exclude(tarraydef(resultdef).arrayoptions,ado_IsVariant); + if assigned(left) then + begin + hp:=self; + while assigned(hp) do + begin + inserttypeconv(hp.left,def); + hp:=tarrayconstructornode(hp.right); + end; + end; + end; + + + procedure tarrayconstructornode.insert_typeconvs; + var + hp : tarrayconstructornode; + dovariant : boolean; + begin + dovariant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resultdef).arrayoptions); + { only pass left tree, right tree contains next construct if any } + if assigned(left) then + begin + hp:=self; + while assigned(hp) do + begin + typecheckpass(hp.left); + { Insert typeconvs for array of const } + if dovariant then + { at this time C varargs are no longer an arrayconstructornode } + insert_varargstypeconv(hp.left,false); + hp:=tarrayconstructornode(hp.right); + end; + end; + end; + + + function tarrayconstructornode.pass_1 : tnode; + var + hp : tarrayconstructornode; + do_variant:boolean; + begin + do_variant:=(nf_forcevaria in flags) or (ado_isvariant in tarraydef(resultdef).arrayoptions); + result:=nil; + { Insert required type convs, this must be + done in pass 1, because the call must be + typecheckpassed already } + if assigned(left) then + begin + insert_typeconvs; + { call firstpass for all nodes } + hp:=self; + while assigned(hp) do + begin + if hp.left<>nil then + begin + {This check is pessimistic; a call will happen depending + on the location in which the elements will be found in + pass 2.} + if not do_variant then + include(current_procinfo.flags,pi_do_call); + firstpass(hp.left); + end; + hp:=tarrayconstructornode(hp.right); + end; + end; + expectloc:=LOC_CREFERENCE; + end; + + + function tarrayconstructornode.docompare(p: tnode): boolean; + begin + docompare:=inherited docompare(p); + end; + + +{***************************************************************************** + TTYPENODE +*****************************************************************************} + + constructor ttypenode.create(def:tdef); + begin + inherited create(typen); + typedef:=def; + typesym:=def.typesym; + allowed:=false; + helperallowed:=false; + end; + + + constructor ttypenode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + ppufile.getderef(typedefderef); + ppufile.getderef(typesymderef); + allowed:=boolean(ppufile.getbyte); + helperallowed:=boolean(ppufile.getbyte); + end; + + + procedure ttypenode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(typedefderef); + ppufile.putderef(typesymderef); + ppufile.putbyte(byte(allowed)); + ppufile.putbyte(byte(helperallowed)); + end; + + + procedure ttypenode.buildderefimpl; + begin + inherited buildderefimpl; + typedefderef.build(typedef); + typesymderef.build(typesym); + end; + + + procedure ttypenode.derefimpl; + begin + inherited derefimpl; + typedef:=tdef(typedefderef.resolve); + typesym:=tsym(typesymderef.resolve); + end; + + + function ttypenode.pass_typecheck:tnode; + begin + result:=nil; + resultdef:=typedef; + { check if it's valid } + if typedef.typ = errordef then + CGMessage(parser_e_illegal_expression); + end; + + + function ttypenode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_VOID; + { a typenode can't generate code, so we give here + an error. Else it'll be an abstract error in pass_generate_code. + Only when the allowed flag is set we don't generate + an error } + if not allowed then + Message(parser_e_no_type_not_allowed_here); + if not helperallowed and is_objectpascal_helper(typedef) then + Message(parser_e_no_category_as_types); + end; + + + function ttypenode.dogetcopy : tnode; + var + n : ttypenode; + begin + n:=ttypenode(inherited dogetcopy); + n.allowed:=allowed; + n.typedef:=typedef; + n.helperallowed:=helperallowed; + result:=n; + end; + + + function ttypenode.docompare(p: tnode): boolean; + begin + docompare := + inherited docompare(p); + end; + + +{***************************************************************************** + TRTTINODE +*****************************************************************************} + + + constructor trttinode.create(def:tstoreddef;rt:trttitype;dt:Trttidatatype); + begin + inherited create(rttin); + rttidef:=def; + rttitype:=rt; + rttidatatype:=dt; + end; + + + constructor trttinode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + ppufile.getderef(rttidefderef); + rttitype:=trttitype(ppufile.getbyte); + rttidatatype:=trttidatatype(ppufile.getbyte); + end; + + + procedure trttinode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(rttidefderef); + ppufile.putbyte(byte(rttitype)); + ppufile.putbyte(byte(rttidatatype)); + end; + + + procedure trttinode.buildderefimpl; + begin + inherited buildderefimpl; + rttidefderef.build(rttidef); + end; + + + procedure trttinode.derefimpl; + begin + inherited derefimpl; + rttidef:=tstoreddef(rttidefderef.resolve); + end; + + + function trttinode.dogetcopy : tnode; + var + n : trttinode; + begin + n:=trttinode(inherited dogetcopy); + n.rttidef:=rttidef; + n.rttitype:=rttitype; + n.rttidatatype:=rttidatatype; + result:=n; + end; + + + function trttinode.pass_typecheck:tnode; + begin + { rtti information will be returned as a void pointer } + result:=nil; + resultdef:=voidpointertype; + end; + + + function trttinode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_CREFERENCE; + end; + + + function trttinode.docompare(p: tnode): boolean; + begin + docompare := + inherited docompare(p) and + (rttidef = trttinode(p).rttidef) and + (rttitype = trttinode(p).rttitype); + end; + +end. diff --git a/closures/compiler/nmat.pas b/closures/compiler/nmat.pas new file mode 100644 index 0000000000..2286a12598 --- /dev/null +++ b/closures/compiler/nmat.pas @@ -0,0 +1,1131 @@ +{ + Copyright (c) 2000-2005 by Florian Klaempfl + + Type checking and register allocation 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 nmat; + +{$i fpcdefs.inc} + +interface + + uses + node; + + type + tmoddivnode = class(tbinopnode) + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function simplify(forinline : boolean) : tnode;override; + protected +{$ifndef cpu64bitalu} + { override the following if you want to implement } + { parts explicitely in the code generator (JM) } + function first_moddiv64bitint: tnode; virtual; +{$endif not cpu64bitalu} + function firstoptimize: tnode; virtual; + function first_moddivint: tnode; virtual; + end; + tmoddivnodeclass = class of tmoddivnode; + + tshlshrnode = class(tbinopnode) + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function simplify(forinline : boolean) : tnode;override; +{$ifndef cpu64bitalu} + { override the following if you want to implement } + { parts explicitely in the code generator (CEC) + Should return nil, if everything will be handled + in the code generator + } + function first_shlshr64bitint: tnode; virtual; +{$endif not cpu64bitalu} + end; + tshlshrnodeclass = class of tshlshrnode; + + tunaryminusnode = class(tunarynode) + constructor create(expr : tnode);virtual; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function simplify(forinline : boolean) : tnode;override; + end; + tunaryminusnodeclass = class of tunaryminusnode; + + tunaryplusnode = class(tunarynode) + constructor create(expr : tnode);virtual; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + end; + tunaryplusnodeclass = class of tunaryplusnode; + + tnotnode = class(tunarynode) + constructor create(expr : tnode);virtual; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function simplify(forinline : boolean) : tnode;override; + {$ifdef state_tracking} + function track_state_pass(exec_known:boolean):boolean;override; + {$endif} + end; + tnotnodeclass = class of tnotnode; + + var + cmoddivnode : tmoddivnodeclass = tmoddivnode; + cshlshrnode : tshlshrnodeclass = tshlshrnode; + cunaryminusnode : tunaryminusnodeclass = tunaryminusnode; + cunaryplusnode : tunaryplusnodeclass = tunaryplusnode; + cnotnode : tnotnodeclass = tnotnode; + +implementation + + uses + systems, + verbose,globals,cutils, + globtype,constexp, + symconst,symtype,symdef,symtable, + defutil, + htypechk,pass_1, + cgbase, + ncon,ncnv,ncal,nadd,nld,nbas,nflw,ninl, + nutils; + +{**************************************************************************** + TMODDIVNODE + ****************************************************************************} + + function tmoddivnode.simplify(forinline : boolean):tnode; + var + rv,lv : tconstexprint; + begin + result:=nil; + + if is_constintnode(right) then + begin + rv:=tordconstnode(right).value; + if rv = 1 then + begin + case nodetype of + modn: + result := cordconstnode.create(0,left.resultdef,true); + divn: + result := left.getcopy; + end; + exit; + end; + if rv = 0 then + begin + Message(parser_e_division_by_zero); + { recover } + tordconstnode(right).value := 1; + end; + if (nf_isomod in flags) and + (rv<=0) then + begin + Message(cg_e_mod_only_defined_for_pos_quotient); + { recover } + tordconstnode(right).value := 1; + end; + end; + + if is_constintnode(right) and is_constintnode(left) then + begin + rv:=tordconstnode(right).value; + lv:=tordconstnode(left).value; + + case nodetype of + modn: + if nf_isomod in flags then + begin + if lv>=0 then + result:=create_simplified_ord_const(lv mod rv,resultdef,forinline) + else + if ((-lv) mod rv)=0 then + result:=create_simplified_ord_const((-lv) mod rv,resultdef,forinline) + else + result:=create_simplified_ord_const(rv-((-lv) mod rv),resultdef,forinline); + end + else + result:=create_simplified_ord_const(lv mod rv,resultdef,forinline); + divn: + result:=create_simplified_ord_const(lv div rv,resultdef,forinline); + end; + end; + end; + + + function tmoddivnode.pass_typecheck:tnode; + var + else_block, + hp,t : tnode; + rd,ld : torddef; + else_statements, + statements : tstatementnode; + result_data : ttempcreatenode; + begin + result:=nil; + typecheckpass(left); + typecheckpass(right); + set_varstate(left,vs_read,[vsf_must_be_valid]); + set_varstate(right,vs_read,[vsf_must_be_valid]); + if codegenerror then + exit; + + { tp procvar support } + maybe_call_procvar(left,true); + maybe_call_procvar(right,true); + + result:=simplify(false); + if assigned(result) then + exit; + + { allow operator overloading } + t:=self; + if isbinaryoverloaded(t) then + begin + result:=t; + exit; + end; + + { we need 2 orddefs always } + if (left.resultdef.typ<>orddef) then + inserttypeconv(right,sinttype); + if (right.resultdef.typ<>orddef) then + inserttypeconv(right,sinttype); + if codegenerror then + exit; + + rd:=torddef(right.resultdef); + ld:=torddef(left.resultdef); + + { if one operand is a cardinal and the other is a positive constant, convert the } + { constant to a cardinal as well so we don't have to do a 64bit division (JM) } + { Do the same for qwords and positive constants as well, otherwise things like } + { "qword mod 10" are evaluated with int64 as result, which is wrong if the } + { "qword" was > high(int64) (JM) } + { Additionally, do the same for cardinal/qwords and other positive types, but } + { always in a way that a smaller type is converted to a bigger type } + { (webtbs/tw8870) } + if (rd.ordtype in [u32bit,u64bit]) and + ((is_constintnode(left) and + (tordconstnode(left).value >= 0)) or + (not is_signed(ld) and + (rd.size >= ld.size))) then + begin + inserttypeconv(left,right.resultdef); + ld:=torddef(left.resultdef); + end; + if (ld.ordtype in [u32bit,u64bit]) and + ((is_constintnode(right) and + (tordconstnode(right).value >= 0)) or + (not is_signed(rd) and + (ld.size >= rd.size))) then + begin + inserttypeconv(right,left.resultdef); + rd:=torddef(right.resultdef); + end; + + { when there is one currency value, everything is done + using currency } + if (ld.ordtype=scurrency) or + (rd.ordtype=scurrency) then + begin + if (ld.ordtype<>scurrency) then + inserttypeconv(left,s64currencytype); + if (rd.ordtype<>scurrency) then + inserttypeconv(right,s64currencytype); + resultdef:=left.resultdef; + end + else +{$ifndef cpu64bitaddr} + { when there is one 64bit value, everything is done + in 64bit } + if (is_64bitint(left.resultdef) or + is_64bitint(right.resultdef)) then + begin + if is_signed(rd) or is_signed(ld) then + begin + if (ld.ordtype<>s64bit) then + inserttypeconv(left,s64inttype); + if (rd.ordtype<>s64bit) then + inserttypeconv(right,s64inttype); + end + else + begin + if (ld.ordtype<>u64bit) then + inserttypeconv(left,u64inttype); + if (rd.ordtype<>u64bit) then + inserttypeconv(right,u64inttype); + end; + resultdef:=left.resultdef; + end + else + { when mixing cardinals and signed numbers, convert everythign to 64bit (JM) } + if ((rd.ordtype = u32bit) and + is_signed(ld)) or + ((ld.ordtype = u32bit) and + is_signed(rd)) then + begin + CGMessage(type_h_mixed_signed_unsigned); + if (ld.ordtype<>s64bit) then + inserttypeconv(left,s64inttype); + if (rd.ordtype<>s64bit) then + inserttypeconv(right,s64inttype); + resultdef:=left.resultdef; + end + else +{$endif not cpu64bitaddr} + begin + { Make everything always default singed int } + if not(rd.ordtype in [torddef(sinttype).ordtype,torddef(uinttype).ordtype]) then + inserttypeconv(right,sinttype); + if not(ld.ordtype in [torddef(sinttype).ordtype,torddef(uinttype).ordtype]) then + inserttypeconv(left,sinttype); + resultdef:=right.resultdef; + end; + + { when the result is currency we need some extra code for + division. this should not be done when the divn node is + created internally } + if (nodetype=divn) and + not(nf_is_currency in flags) and + is_currency(resultdef) then + begin + hp:=caddnode.create(muln,getcopy,cordconstnode.create(10000,s64currencytype,false)); + include(hp.flags,nf_is_currency); + result:=hp; + end; + + if (nodetype=modn) and (nf_isomod in flags) then + begin + result:=internalstatements(statements); + else_block:=internalstatements(else_statements); + result_data:=ctempcreatenode.create(resultdef,resultdef.size,tt_persistent,true); + + { right <=0? } + addstatement(statements,cifnode.create(caddnode.create(lten,right.getcopy,cordconstnode.create(0,resultdef,false)), + { then: result:=left mod right } + ccallnode.createintern('fpc_divbyzero',nil), + nil + )); + + { prepare else block } + { result:=(-left) mod right } + addstatement(else_statements,cassignmentnode.create(ctemprefnode.create(result_data),cmoddivnode.create(modn,cunaryminusnode.create(left.getcopy),right.getcopy))); + { result<>0? } + addstatement(else_statements,cifnode.create(caddnode.create(unequaln,ctemprefnode.create(result_data),cordconstnode.create(0,resultdef,false)), + { then: result:=right-result } + cassignmentnode.create(ctemprefnode.create(result_data),caddnode.create(subn,right.getcopy,ctemprefnode.create(result_data))), + nil + )); + + addstatement(statements,result_data); + { if left>=0 } + addstatement(statements,cifnode.create(caddnode.create(gten,left.getcopy,cordconstnode.create(0,resultdef,false)), + { then: result:=left mod right } + cassignmentnode.create(ctemprefnode.create(result_data),cmoddivnode.create(modn,left.getcopy,right.getcopy)), + { else block } + else_block + )); + + addstatement(statements,ctempdeletenode.create_normal_temp(result_data)); + addstatement(statements,ctemprefnode.create(result_data)); + end; + end; + + + function tmoddivnode.first_moddivint: tnode; +{$ifdef cpuneedsdiv32helper} + var + procname: string[31]; + begin + result := nil; + + { otherwise create a call to a helper } + if nodetype = divn then + procname := 'fpc_div_' + else + procname := 'fpc_mod_'; + { only qword needs the unsigned code, the + signed code is also used for currency } + if is_signed(resultdef) then + procname := procname + 'longint' + else + procname := procname + 'dword'; + + result := ccallnode.createintern(procname,ccallparanode.create(left, + ccallparanode.create(right,nil))); + left := nil; + right := nil; + firstpass(result); + end; +{$else cpuneedsdiv32helper} + begin + result:=nil; + end; +{$endif cpuneedsdiv32helper} + + +{$ifndef cpu64bitalu} + function tmoddivnode.first_moddiv64bitint: tnode; + var + procname: string[31]; + begin + result := nil; + + { when currency is used set the result of the + parameters to s64bit, so they are not converted } + if is_currency(resultdef) then + begin + left.resultdef:=s64inttype; + right.resultdef:=s64inttype; + end; + + { otherwise create a call to a helper } + if nodetype = divn then + procname := 'fpc_div_' + else + procname := 'fpc_mod_'; + { only qword needs the unsigned code, the + signed code is also used for currency } + if is_signed(resultdef) then + procname := procname + 'int64' + else + procname := procname + 'qword'; + + result := ccallnode.createintern(procname,ccallparanode.create(left, + ccallparanode.create(right,nil))); + left := nil; + right := nil; + firstpass(result); + end; +{$endif not cpu64bitalu} + + + function tmoddivnode.firstoptimize: tnode; + var + power,shiftval : longint; + newtype: tnodetype; + statements : tstatementnode; + temp : ttempcreatenode; + begin + result := nil; + { divide/mod a number by a constant which is a power of 2? } + if (right.nodetype = ordconstn) and +{$ifdef cpu64bitalu} + { for 64 bit, we leave the optimization to the cg } + (not is_signed(resultdef)) and +{$else cpu64bitalu} + ((nodetype=divn) and (is_64bit(resultdef)) or + not is_signed(resultdef)) and +{$endif cpu64bitalu} + ispowerof2(tordconstnode(right).value,power) then + begin + if nodetype=divn then + begin + if is_signed(resultdef) then + begin + if is_64bitint(left.resultdef) then + if not (cs_opt_size in current_settings.optimizerswitches) then + shiftval:=63 + else + { the shift code is a lot bigger than the call to } + { the divide helper } + exit + else + shiftval:=31; + + result:=internalstatements(statements); + temp:=ctempcreatenode.create(left.resultdef,left.resultdef.size,tt_persistent,true); + addstatement(statements,temp); + addstatement(statements,cassignmentnode.create(ctemprefnode.create(temp), + left)); + left:=nil; + + addstatement(statements,ccallnode.createintern('fpc_sarint64', + ccallparanode.create(cordconstnode.create(power,u8inttype,false), + ccallparanode.create(caddnode.create(addn,ctemprefnode.create(temp), + caddnode.create(andn, + ccallnode.createintern('fpc_sarint64', + ccallparanode.create(cordconstnode.create(shiftval,u8inttype,false), + ccallparanode.create(ctemprefnode.create(temp),nil)) + ), + cordconstnode.create(tordconstnode(right).value-1, + right.resultdef,false) + )),nil + ))) + ); + end + else + begin + tordconstnode(right).value:=power; + result:=cshlshrnode.create(shrn,left,right) + end; + end + else + begin + dec(tordconstnode(right).value.uvalue); + result := caddnode.create(andn,left,right); + end; + { left and right are reused } + left := nil; + right := nil; + firstpass(result); + exit; + end; + end; + + + function tmoddivnode.pass_1 : tnode; + begin + result:=nil; + firstpass(left); + firstpass(right); + if codegenerror then + exit; + + { Try to optimize mod/div } + result := firstoptimize; + if assigned(result) then + exit; + +{$ifndef cpu64bitalu} + { 64bit } + if (left.resultdef.typ=orddef) and + (right.resultdef.typ=orddef) and + (is_64bitint(left.resultdef) or is_64bitint(right.resultdef)) then + begin + result := first_moddiv64bitint; + if assigned(result) then + exit; + expectloc:=LOC_REGISTER; + end + else +{$endif not cpu64bitalu} + begin + result := first_moddivint; + if assigned(result) then + exit; + end; + expectloc:=LOC_REGISTER; + end; + + + +{**************************************************************************** + TSHLSHRNODE + ****************************************************************************} + + function tshlshrnode.simplify(forinline : boolean):tnode; + begin + result:=nil; + { constant folding } + if is_constintnode(left) and is_constintnode(right) then + begin + case nodetype of + shrn: + result:=create_simplified_ord_const(tordconstnode(left).value shr tordconstnode(right).value,resultdef,forinline); + shln: + result:=create_simplified_ord_const(tordconstnode(left).value shl tordconstnode(right).value,resultdef,forinline); + end; + end; + + end; + + + function tshlshrnode.pass_typecheck:tnode; + var + t : tnode; +{$ifdef cpunodefaultint} + nd : tdef; +{$endif cpunodefaultint} + begin + result:=nil; + typecheckpass(left); + typecheckpass(right); + set_varstate(right,vs_read,[vsf_must_be_valid]); + set_varstate(left,vs_read,[vsf_must_be_valid]); + if codegenerror then + exit; + + { tp procvar support } + maybe_call_procvar(left,true); + maybe_call_procvar(right,true); + + result:=simplify(false); + if assigned(result) then + exit; + + { allow operator overloading } + t:=self; + if isbinaryoverloaded(t) then + begin + result:=t; + exit; + end; + +{$ifdef cpunodefaultint} + { for small cpus we use the smallest common type } + if (left.resultdef.typ=orddef) and (right.resultdef.typ=orddef) then + nd:=get_common_intdef(torddef(left.resultdef),torddef(right.resultdef),false) + else + nd:=s32inttype; +{$endif cpunodefaultint} + + { calculations for ordinals < 32 bit have to be done in + 32 bit for backwards compatibility. That way 'shl 33' is + the same as 'shl 1'. It's ugly but compatible with delphi/tp/gcc } + if (not is_64bit(left.resultdef)) and + (torddef(left.resultdef).ordtype<>u32bit) then + begin + { keep singness of orignal type } + if is_signed(left.resultdef) then +{$ifdef cpunodefaultint} + inserttypeconv(left,nd) +{$else cpunodefaultint} + inserttypeconv(left,s32inttype) +{$endif cpunodefaultint} + else + begin +{$ifdef cpunodefaultint} + inserttypeconv(left,nd) +{$else cpunodefaultint} + inserttypeconv(left,u32inttype); +{$endif cpunodefaultint} + end + end; + +{$ifdef cpunodefaultint} + inserttypeconv(right,nd); +{$else cpunodefaultint} + inserttypeconv(right,sinttype); +{$endif cpunodefaultint} + + resultdef:=left.resultdef; + end; + + +{$ifndef cpu64bitalu} + function tshlshrnode.first_shlshr64bitint: tnode; + var + procname: string[31]; + begin + result := nil; + { Normally already done below, but called again, + just in case it is called directly } + firstpass(left); + { otherwise create a call to a helper } + if is_signed(left.resultdef) then + procname:='int64' + else + procname:='qword'; + if nodetype = shln then + procname := 'fpc_shl_'+procname + else + procname := 'fpc_shr_'+procname; + { this order of parameters works at least for the arm, + however it should work for any calling conventions (FK) } + result := ccallnode.createintern(procname,ccallparanode.create(right, + ccallparanode.create(left,nil))); + left := nil; + right := nil; + firstpass(result); + end; +{$endif not cpu64bitalu} + + + function tshlshrnode.pass_1 : tnode; + var + regs : longint; + begin + result:=nil; + firstpass(left); + firstpass(right); + if codegenerror then + exit; + +{$ifndef cpu64bitalu} + { 64 bit ints have their own shift handling } + if is_64bit(left.resultdef) then + begin + result := first_shlshr64bitint; + if assigned(result) then + exit; + regs:=2; + end + else +{$endif not cpu64bitalu} + begin + regs:=1 + end; + + if (right.nodetype<>ordconstn) then + inc(regs); + expectloc:=LOC_REGISTER; + end; + + +{**************************************************************************** + TUNARYMINUSNODE + ****************************************************************************} + + constructor tunaryminusnode.create(expr : tnode); + begin + inherited create(unaryminusn,expr); + end; + + + function tunaryminusnode.simplify(forinline : boolean):tnode; + begin + result:=nil; + { constant folding } + if is_constintnode(left) then + begin + result:=create_simplified_ord_const(-tordconstnode(left).value,resultdef,forinline); + exit; + end; + if is_constrealnode(left) then + begin + trealconstnode(left).value_real:=-trealconstnode(left).value_real; + trealconstnode(left).value_currency:=-trealconstnode(left).value_currency; + result:=left; + left:=nil; + exit; + end; + end; + + + function tunaryminusnode.pass_typecheck : tnode; + var + t : tnode; + begin + result:=nil; + typecheckpass(left); + set_varstate(left,vs_read,[vsf_must_be_valid]); + if codegenerror then + exit; + + result:=simplify(false); + if assigned(result) then + exit; + + resultdef:=left.resultdef; + if (left.resultdef.typ=floatdef) or + is_currency(left.resultdef) then + begin + end +{$ifdef SUPPORT_MMX} + else if (cs_mmx in current_settings.localswitches) and + is_mmx_able_array(left.resultdef) then + begin + { if saturation is on, left.resultdef isn't + "mmx able" (FK) + if (cs_mmx_saturation in current_settings.localswitches^) and + (torddef(tarraydef(resultdef).definition).typ in + [s32bit,u32bit]) then + CGMessage(type_e_mismatch); + } + end +{$endif SUPPORT_MMX} +{$ifndef cpu64bitaddr} + else if is_64bit(left.resultdef) then + begin + inserttypeconv(left,s64inttype); + resultdef:=left.resultdef + end +{$endif not cpu64bitaddr} + else if (left.resultdef.typ=orddef) then + begin + inserttypeconv(left,sinttype); + resultdef:=left.resultdef + end + else + begin + { allow operator overloading } + t:=self; + if isunaryoverloaded(t) then + begin + result:=t; + exit; + end; + + CGMessage(type_e_mismatch); + end; + end; + + { generic code } + { overridden by: } + { i386 } + function tunaryminusnode.pass_1 : tnode; + var + procname: string[31]; + fdef : tdef; + begin + result:=nil; + firstpass(left); + if codegenerror then + exit; + + if (cs_fp_emulation in current_settings.moduleswitches) and (left.resultdef.typ=floatdef) then + begin + if not(target_info.system in systems_wince) then + begin + case tfloatdef(resultdef).floattype of + s32real: + begin + procname:='float32_sub'; + fdef:=search_system_type('FLOAT32REC').typedef; + end; + s64real: + begin + procname:='float64_sub'; + fdef:=search_system_type('FLOAT64').typedef; + end; + {!!! not yet implemented + s128real: + } + else + internalerror(2005082801); + end; + result:=ctypeconvnode.create_internal(ccallnode.createintern(procname,ccallparanode.create( + ctypeconvnode.create_internal(left,fDef), + ccallparanode.create(ctypeconvnode.create_internal(crealconstnode.create(0,resultdef),fdef),nil))),resultdef); + end + else + begin + case tfloatdef(resultdef).floattype of + s32real: + procname:='NEGS'; + s64real: + procname:='NEGD'; + {!!! not yet implemented + s128real: + } + else + internalerror(2005082802); + end; + result:=ccallnode.createintern(procname,ccallparanode.create(left,nil)); + end; + + left:=nil; + end + else + begin + if (left.resultdef.typ=floatdef) then + expectloc:=LOC_FPUREGISTER +{$ifdef SUPPORT_MMX} + else if (cs_mmx in current_settings.localswitches) and + is_mmx_able_array(left.resultdef) then + expectloc:=LOC_MMXREGISTER +{$endif SUPPORT_MMX} + else if (left.resultdef.typ=orddef) then + expectloc:=LOC_REGISTER; + end; + end; + +{**************************************************************************** + TUNARYPLUSNODE + ****************************************************************************} + + constructor tunaryplusnode.create(expr: tnode); + begin + inherited create(unaryplusn,expr); + end; + + function tunaryplusnode.pass_1: tnode; + begin + result:=nil; + { can never happen because all the conversions happen + in pass_typecheck } + internalerror(201012250); + end; + + function tunaryplusnode.pass_typecheck: tnode; + var + t:tnode; + begin + result:=nil; + typecheckpass(left); + set_varstate(left,vs_read,[vsf_must_be_valid]); + if codegenerror then + exit; + + if is_constintnode(left) or + is_constrealnode(left) or + (left.resultdef.typ=floatdef) or + is_currency(left.resultdef) +{$ifdef SUPPORT_MMX} + or ((cs_mmx in current_settings.localswitches) and + is_mmx_able_array(left.resultdef)) +{$endif SUPPORT_MMX} + then + begin + result:=left; + left:=nil; + end +{$ifndef cpu64bitaddr} + else if is_64bit(left.resultdef) then + begin + inserttypeconv(left,s64inttype); + result:=left; + left:=nil; + end +{$endif not cpu64bitaddr} + else if (left.resultdef.typ=orddef) then + begin + inserttypeconv(left,sinttype); + result:=left; + left:=nil; + end + else + begin + { allow operator overloading } + t:=self; + if isunaryoverloaded(t) then + begin + result:=t; + exit; + end; + + CGMessage(type_e_mismatch); + end; + end; + + +{**************************************************************************** + TNOTNODE + ****************************************************************************} + + const + boolean_reverse:array[ltn..unequaln] of Tnodetype=( + gten,gtn,lten,ltn,unequaln,equaln + ); + + constructor tnotnode.create(expr : tnode); + begin + inherited create(notn,expr); + end; + + + function tnotnode.simplify(forinline : boolean):tnode; + var + v : tconstexprint; + t : tnode; + def : tdef; + begin + result:=nil; + { Try optmimizing ourself away } + if left.nodetype=notn then + begin + { Double not. Remove both } + result:=Tnotnode(left).left; + tnotnode(left).left:=nil; + exit; + end; + + if (left.nodetype in [ltn,lten,equaln,unequaln,gtn,gten]) then + begin + { Not of boolean expression. Turn around the operator and remove + the not. This is not allowed for sets with the gten/lten, + because there is no ltn/gtn support } + if (taddnode(left).left.resultdef.typ<>setdef) or + (left.nodetype in [equaln,unequaln]) then + begin + result:=left; + left.nodetype:=boolean_reverse[left.nodetype]; + left:=nil; + exit; + end; + end; + + { constant folding } + if (left.nodetype=ordconstn) then + begin + v:=tordconstnode(left).value; + def:=left.resultdef; + case torddef(left.resultdef).ordtype of + pasbool8, + pasbool16, + pasbool32, + pasbool64, + bool8bit, + bool16bit, + bool32bit, + bool64bit: + begin + v:=byte(not(boolean(int64(v)))); + if is_cbool(left.resultdef) then + v:=-v; + end; + uchar, + uwidechar, + u8bit, + s8bit, + u16bit, + s16bit, + s32bit, +{$ifdef cpu64bitaddr} + u32bit, +{$endif cpu64bitaddr} + s64bit: + begin + v:=int64(not int64(v)); + if (torddef(left.resultdef).ordtype<>s64bit) then + def:=sinttype + else + def:=s64inttype; + end; +{$ifndef cpu64bitaddr} + u32bit, +{$endif not cpu64bitaddr} + u64bit : + begin + { Delphi-compatible: not dword = dword (not word = longint) } + { Extension: not qword = qword } + v:=qword(not qword(v)); + { will be truncated by the ordconstnode for u32bit } + end; + else + CGMessage(type_e_mismatch); + end; + { not-nodes are not range checked by the code generator -> also + don't range check while inlining; the resultdef is a bit tricky + though: the node's resultdef gets changed in most cases compared + to left, but the not-operation itself is caried out in the code + generator using the size of left + } + if not(forinline) then + t:=cordconstnode.create(v,def,false) + else + begin + { cut off the value if necessary } + t:=cordconstnode.create(v,left.resultdef,false); + { now convert to node's resultdef } + inserttypeconv_explicit(t,def); + end; + result:=t; + exit; + end; + end; + + + function tnotnode.pass_typecheck : tnode; + var + t : tnode; + begin + result:=nil; + typecheckpass(left); + set_varstate(left,vs_read,[vsf_must_be_valid]); + if codegenerror then + exit; + + { tp procvar support } + maybe_call_procvar(left,true); + + resultdef:=left.resultdef; + + result:=simplify(false); + if assigned(result) then + exit; + + if is_boolean(resultdef) then + begin + end + else +{$ifdef SUPPORT_MMX} + if (cs_mmx in current_settings.localswitches) and + is_mmx_able_array(left.resultdef) then + begin + end + else +{$endif SUPPORT_MMX} +{$ifndef cpu64bitaddr} + if is_64bitint(left.resultdef) then + begin + end + else +{$endif not cpu64bitaddr} + if is_integer(left.resultdef) then + begin + end + else + begin + { allow operator overloading } + t:=self; + if isunaryoverloaded(t) then + begin + result:=t; + exit; + end; + + CGMessage(type_e_mismatch); + end; + end; + + + function tnotnode.pass_1 : tnode; + begin + result:=nil; + firstpass(left); + if codegenerror then + exit; + + expectloc:=left.expectloc; + if is_boolean(resultdef) then + begin + if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then + expectloc:=LOC_REGISTER; + { before loading it into flags we need to load it into + a register thus 1 register is need PM } +{$ifdef cpuflags} + if left.expectloc<>LOC_JUMP then + expectloc:=LOC_FLAGS; +{$endif def cpuflags} + end + else +{$ifdef SUPPORT_MMX} + if (cs_mmx in current_settings.localswitches) and + is_mmx_able_array(left.resultdef) then + expectloc:=LOC_MMXREGISTER + else +{$endif SUPPORT_MMX} +{$ifndef cpu64bitalu} + if is_64bit(left.resultdef) then + begin + if (expectloc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then + expectloc:=LOC_REGISTER; + end + else +{$endif not cpu64bitalu} + if is_integer(left.resultdef) then + expectloc:=LOC_REGISTER; + end; + +{$ifdef state_tracking} + function Tnotnode.track_state_pass(exec_known:boolean):boolean; + begin + track_state_pass:=true; + if left.track_state_pass(exec_known) then + begin + left.resultdef:=nil; + do_typecheckpass(left); + end; + end; +{$endif} + +end. diff --git a/closures/compiler/nmem.pas b/closures/compiler/nmem.pas new file mode 100644 index 0000000000..74a59544f1 --- /dev/null +++ b/closures/compiler/nmem.pas @@ -0,0 +1,1099 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + Type checking and register allocation for memory related 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 nmem; + +{$i fpcdefs.inc} + +interface + + uses + node, + symdef,symsym,symtable,symtype; + + type + tloadvmtaddrnode = class(tunarynode) + { unless this is for a call, we have to send the "class" message to + the objctype because the type information only gets initialized + after the first message has been sent -> crash if you pass an + uninitialized type to e.g. class_getInstanceSize() or so. No need + to save to/restore from ppu. } + forcall: boolean; + constructor create(l : tnode);virtual; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function docompare(p: tnode): boolean; override; + function dogetcopy: tnode; override; + end; + tloadvmtaddrnodeclass = class of tloadvmtaddrnode; + + tloadparentfpnode = class(tunarynode) + parentpd : tprocdef; + parentpdderef : tderef; + constructor create(pd:tprocdef);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + function docompare(p: tnode): boolean; override; + function dogetcopy : tnode;override; + end; + tloadparentfpnodeclass = class of tloadparentfpnode; + + taddrnode = class(tunarynode) + getprocvardef : tprocvardef; + getprocvardefderef : tderef; + constructor create(l : tnode);virtual; + constructor create_internal(l : tnode); virtual; + constructor create_internal_nomark(l : tnode); virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure mark_write;override; + procedure buildderefimpl;override; + procedure derefimpl;override; + function docompare(p: tnode): boolean; override; + function dogetcopy : tnode;override; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + private + mark_read_written: boolean; + end; + taddrnodeclass = class of taddrnode; + + tderefnode = class(tunarynode) + constructor create(l : tnode);virtual; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + procedure mark_write;override; + end; + tderefnodeclass = class of tderefnode; + + tsubscriptnode = class(tunarynode) + vs : tfieldvarsym; + vsderef : tderef; + constructor create(varsym : tsym;l : tnode);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + function dogetcopy : tnode;override; + function pass_1 : tnode;override; + function docompare(p: tnode): boolean; override; + function pass_typecheck:tnode;override; + procedure mark_write;override; + end; + tsubscriptnodeclass = class of tsubscriptnode; + + tvecnode = class(tbinarynode) + constructor create(l,r : tnode);virtual; + function pass_1 : tnode;override; + function pass_typecheck:tnode;override; + procedure mark_write;override; + end; + tvecnodeclass = class of tvecnode; + + twithnode = class(tunarynode) + constructor create(l:tnode); + destructor destroy;override; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function dogetcopy : tnode;override; + function pass_1 : tnode;override; + function docompare(p: tnode): boolean; override; + function pass_typecheck:tnode;override; + end; + twithnodeclass = class of twithnode; + + var + cloadvmtaddrnode : tloadvmtaddrnodeclass= tloadvmtaddrnode; + caddrnode : taddrnodeclass= taddrnode; + cderefnode : tderefnodeclass= tderefnode; + csubscriptnode : tsubscriptnodeclass= tsubscriptnode; + cvecnode : tvecnodeclass= tvecnode; + cwithnode : twithnodeclass= twithnode; + cloadparentfpnode : tloadparentfpnodeclass = tloadparentfpnode; + + function is_big_untyped_addrnode(p: tnode): boolean; + +implementation + + uses + globtype,systems,constexp, + cutils,verbose,globals, + symconst,symbase,defutil,defcmp, + nbas,nutils, + wpobase, + htypechk,pass_1,ncal,nld,ncon,ncnv,cgbase,procinfo + ; + +{***************************************************************************** + TLOADVMTADDRNODE +*****************************************************************************} + + constructor tloadvmtaddrnode.create(l : tnode); + begin + inherited create(loadvmtaddrn,l); + end; + + + function tloadvmtaddrnode.pass_typecheck:tnode; + var + defaultresultdef : boolean; + begin + result:=nil; + typecheckpass(left); + if codegenerror then + exit; + + case left.resultdef.typ of + classrefdef : + resultdef:=left.resultdef; + objectdef, + recorddef: + { access to the classtype while specializing? } + if (df_generic in left.resultdef.defoptions) then + begin + defaultresultdef:=true; + if assigned(current_structdef) then + begin + if assigned(current_structdef.genericdef) then + if current_structdef.genericdef=left.resultdef then + begin + resultdef:=tclassrefdef.create(current_structdef); + defaultresultdef:=false; + end + else + message(parser_e_cant_create_generics_of_this_type); + end + else + message(parser_e_cant_create_generics_of_this_type); + if defaultresultdef then + resultdef:=tclassrefdef.create(left.resultdef); + end + else + resultdef:=tclassrefdef.create(left.resultdef); + else + Message(parser_e_pointer_to_class_expected); + end; + end; + + + function tloadvmtaddrnode.docompare(p: tnode): boolean; + begin + result:=inherited docompare(p); + if result then + result:=forcall=tloadvmtaddrnode(p).forcall; + end; + + + function tloadvmtaddrnode.dogetcopy: tnode; + begin + result:=inherited dogetcopy; + tloadvmtaddrnode(result).forcall:=forcall; + end; + + + function tloadvmtaddrnode.pass_1 : tnode; + var + vs: tsym; + begin + result:=nil; + expectloc:=LOC_REGISTER; + if left.nodetype<>typen then + begin + { make sure that the isa field is loaded correctly in case + of the non-fragile ABI } + if is_objcclass(left.resultdef) and + (left.nodetype<>typen) then + begin + vs:=search_struct_member(tobjectdef(left.resultdef),'ISA'); + if not assigned(vs) or + (tsym(vs).typ<>fieldvarsym) then + internalerror(2009092502); + result:=csubscriptnode.create(tfieldvarsym(vs),left); + inserttypeconv_internal(result,resultdef); + { reused } + left:=nil; + end + else + firstpass(left) + end + else if not is_objcclass(left.resultdef) and + not is_objcclassref(left.resultdef) then + begin + if not(nf_ignore_for_wpo in flags) and + (not assigned(current_procinfo) or + (po_inline in current_procinfo.procdef.procoptions) or + wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname)) then + begin + { keep track of which classes might be instantiated via a classrefdef } + if (left.resultdef.typ=classrefdef) then + tobjectdef(tclassrefdef(left.resultdef).pointeddef).register_maybe_created_object_type + else if (left.resultdef.typ=objectdef) then + tobjectdef(left.resultdef).register_maybe_created_object_type + end + end + else if is_objcclass(left.resultdef) and + not(forcall) then + begin + { call "class" method (= "classclass" in FPC), because otherwise + we may use the class information before it has been + initialized } + vs:=search_struct_member(tobjectdef(left.resultdef),'CLASSCLASS'); + if not assigned(vs) or + (vs.typ<>procsym) then + internalerror(2011080601); + { can't reuse "self", because it will be freed when we return } + result:=ccallnode.create(nil,tprocsym(vs),vs.owner,self.getcopy,[]); + end; + end; + + +{***************************************************************************** + TLOADPARENTFPNODE +*****************************************************************************} + + constructor tloadparentfpnode.create(pd:tprocdef); + begin + inherited create(loadparentfpn,nil); + if not assigned(pd) then + internalerror(200309288); + if (pd.parast.symtablelevel>current_procinfo.procdef.parast.symtablelevel) then + internalerror(200309284); + parentpd:=pd; + end; + + + constructor tloadparentfpnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + ppufile.getderef(parentpdderef); + end; + + + procedure tloadparentfpnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(parentpdderef); + end; + + + procedure tloadparentfpnode.buildderefimpl; + begin + inherited buildderefimpl; + parentpdderef.build(parentpd); + end; + + + procedure tloadparentfpnode.derefimpl; + begin + inherited derefimpl; + parentpd:=tprocdef(parentpdderef.resolve); + end; + + + function tloadparentfpnode.docompare(p: tnode): boolean; + begin + result:= + inherited docompare(p) and + (tloadparentfpnode(p).parentpd=parentpd); + end; + + + function tloadparentfpnode.dogetcopy : tnode; + var + p : tloadparentfpnode; + begin + p:=tloadparentfpnode(inherited dogetcopy); + p.parentpd:=parentpd; + dogetcopy:=p; + end; + + + function tloadparentfpnode.pass_typecheck:tnode; +{$ifdef dummy} + var + currpi : tprocinfo; + hsym : tparavarsym; +{$endif dummy} + begin + result:=nil; + resultdef:=voidpointertype; +{$ifdef dummy} + { currently parentfps are never loaded in registers (FK) } + if (current_procinfo.procdef.parast.symtablelevel<>parentpd.parast.symtablelevel) then + begin + currpi:=current_procinfo; + { walk parents } + while (currpi.procdef.owner.symtablelevel>parentpd.parast.symtablelevel) do + begin + currpi:=currpi.parent; + if not assigned(currpi) then + internalerror(2005040602); + hsym:=tparavarsym(currpi.procdef.parast.Find('parentfp')); + if not assigned(hsym) then + internalerror(2005040601); + hsym.varregable:=vr_none; + end; + end; +{$endif dummy} + end; + + + function tloadparentfpnode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_REGISTER; + end; + + +{***************************************************************************** + TADDRNODE +*****************************************************************************} + + constructor taddrnode.create(l : tnode); + + begin + inherited create(addrn,l); + getprocvardef:=nil; + mark_read_written := true; + end; + + + constructor taddrnode.create_internal(l : tnode); + begin + self.create(l); + include(flags,nf_internal); + end; + + + constructor taddrnode.create_internal_nomark(l : tnode); + begin + self.create_internal(l); + mark_read_written := false; + end; + + + constructor taddrnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + ppufile.getderef(getprocvardefderef); + end; + + + procedure taddrnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(getprocvardefderef); + end; + + procedure Taddrnode.mark_write; + + begin + {@procvar:=nil is legal in Delphi mode.} + left.mark_write; + end; + + procedure taddrnode.buildderefimpl; + begin + inherited buildderefimpl; + getprocvardefderef.build(getprocvardef); + end; + + + procedure taddrnode.derefimpl; + begin + inherited derefimpl; + getprocvardef:=tprocvardef(getprocvardefderef.resolve); + end; + + + function taddrnode.docompare(p: tnode): boolean; + begin + result:= + inherited docompare(p) and + (taddrnode(p).getprocvardef=getprocvardef); + end; + + + function taddrnode.dogetcopy : tnode; + var + p : taddrnode; + begin + p:=taddrnode(inherited dogetcopy); + p.getprocvardef:=getprocvardef; + dogetcopy:=p; + end; + + + function taddrnode.pass_typecheck:tnode; + var + hp : tnode; + hsym : tfieldvarsym; + isprocvar : boolean; + begin + result:=nil; + typecheckpass(left); + if codegenerror then + exit; + + make_not_regable(left,[ra_addr_regable,ra_addr_taken]); + + { don't allow constants, for internal use we also + allow taking the address of strings } + if is_constnode(left) and + not( + (nf_internal in flags) and + (left.nodetype in [stringconstn]) + ) then + begin + CGMessagePos(left.fileinfo,type_e_no_addr_of_constant); + exit; + end; + + { Handle @proc special, also @procvar in tp-mode needs + special handling } + if (left.resultdef.typ=procdef) or + ( + (left.resultdef.typ=procvardef) and + ((m_tp_procvar in current_settings.modeswitches) or + (m_mac_procvar in current_settings.modeswitches)) + ) then + begin + isprocvar:=(left.resultdef.typ=procvardef); + + if not isprocvar then + begin + left:=ctypeconvnode.create_proc_to_procvar(left); + left.fileinfo:=fileinfo; + typecheckpass(left); + end; + + { In tp procvar mode the result is always a voidpointer. Insert + a typeconversion to voidpointer. For methodpointers we need + to load the proc field } + if (m_tp_procvar in current_settings.modeswitches) or + (m_mac_procvar in current_settings.modeswitches) then + begin + if tabstractprocdef(left.resultdef).is_addressonly then + begin + result:=ctypeconvnode.create_internal(left,voidpointertype); + include(result.flags,nf_load_procvar); + left:=nil; + end + else + begin + { For procvars and for nested routines we need to return + the proc field of the methodpointer } + if isprocvar or + is_nested_pd(tabstractprocdef(left.resultdef)) then + begin + { find proc field in methodpointer record } + hsym:=tfieldvarsym(trecorddef(methodpointertype).symtable.Find('proc')); + if not assigned(hsym) then + internalerror(200412041); + { Load tmehodpointer(left).proc } + result:=csubscriptnode.create( + hsym, + ctypeconvnode.create_internal(left,methodpointertype)); + left:=nil; + end + else + CGMessage(type_e_variable_id_expected); + end; + end + else + begin + { Return the typeconvn only } + result:=left; + left:=nil; + end; + end + else + begin + { what are we getting the address from an absolute sym? } + hp:=left; + while assigned(hp) and (hp.nodetype in [typeconvn,vecn,derefn,subscriptn]) do + hp:=tunarynode(hp).left; + if not assigned(hp) then + internalerror(200412042); +{$ifdef i386} + if (hp.nodetype=loadn) and + ((tloadnode(hp).symtableentry.typ=absolutevarsym) and + tabsolutevarsym(tloadnode(hp).symtableentry).absseg) then + begin + if not(nf_typedaddr in flags) then + resultdef:=voidfarpointertype + else + resultdef:=tpointerdef.createfar(left.resultdef); + end + else +{$endif i386} + if (hp.nodetype=loadn) and + (tloadnode(hp).symtableentry.typ=absolutevarsym) and +{$ifdef i386} + not(tabsolutevarsym(tloadnode(hp).symtableentry).absseg) and +{$endif i386} + (tabsolutevarsym(tloadnode(hp).symtableentry).abstyp=toaddr) then + begin + if nf_typedaddr in flags then + result:=cpointerconstnode.create(tabsolutevarsym(tloadnode(hp).symtableentry).addroffset,tpointerdef.create(left.resultdef)) + else + result:=cpointerconstnode.create(tabsolutevarsym(tloadnode(hp).symtableentry).addroffset,voidpointertype); + exit; + end + else if (nf_internal in flags) or + valid_for_addr(left,true) then + begin + if not(nf_typedaddr in flags) then + resultdef:=voidpointertype + else + resultdef:=tpointerdef.create(left.resultdef); + end + else + CGMessage(type_e_variable_id_expected); + end; + + if mark_read_written then + begin + { This is actually only "read", but treat it nevertheless as } + { modified due to the possible use of pointers } + { To avoid false positives regarding "uninitialised" } + { warnings when using arrays, perform it in two steps } + set_varstate(left,vs_written,[]); + { vsf_must_be_valid so it doesn't get changed into } + { vsf_referred_not_inited } + set_varstate(left,vs_read,[vsf_must_be_valid]); + end; + end; + + + function taddrnode.pass_1 : tnode; + begin + result:=nil; + firstpass(left); + if codegenerror then + exit; + + { is this right for object of methods ?? } + expectloc:=LOC_REGISTER; + end; + + +{***************************************************************************** + TDEREFNODE +*****************************************************************************} + + constructor tderefnode.create(l : tnode); + + begin + inherited create(derefn,l); + + end; + + function tderefnode.pass_typecheck:tnode; + begin + result:=nil; + typecheckpass(left); + set_varstate(left,vs_read,[vsf_must_be_valid]); + if codegenerror then + exit; + + { tp procvar support } + maybe_call_procvar(left,true); + + if left.resultdef.typ=pointerdef then + resultdef:=tpointerdef(left.resultdef).pointeddef + else + CGMessage(parser_e_invalid_qualifier); + end; + + procedure Tderefnode.mark_write; + + begin + include(flags,nf_write); + end; + + function tderefnode.pass_1 : tnode; + begin + result:=nil; + firstpass(left); + if codegenerror then + exit; + + expectloc:=LOC_REFERENCE; + end; + + +{***************************************************************************** + TSUBSCRIPTNODE +*****************************************************************************} + + constructor tsubscriptnode.create(varsym : tsym;l : tnode); + + begin + inherited create(subscriptn,l); + { vs should be changed to tsym! } + vs:=tfieldvarsym(varsym); + end; + + constructor tsubscriptnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + ppufile.getderef(vsderef); + end; + + + procedure tsubscriptnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(vsderef); + end; + + + procedure tsubscriptnode.buildderefimpl; + begin + inherited buildderefimpl; + vsderef.build(vs); + end; + + + procedure tsubscriptnode.derefimpl; + begin + inherited derefimpl; + vs:=tfieldvarsym(vsderef.resolve); + end; + + + function tsubscriptnode.dogetcopy : tnode; + var + p : tsubscriptnode; + begin + p:=tsubscriptnode(inherited dogetcopy); + p.vs:=vs; + dogetcopy:=p; + end; + + + function tsubscriptnode.pass_typecheck:tnode; + begin + result:=nil; + typecheckpass(left); + { tp procvar support } + maybe_call_procvar(left,true); + resultdef:=vs.vardef; + + // don't put records from which we load float fields + // in integer registers + if (left.resultdef.typ=recorddef) and + (resultdef.typ=floatdef) then + make_not_regable(left,[ra_addr_regable]); + end; + + procedure Tsubscriptnode.mark_write; + begin + include(flags,nf_write); + end; + + + function tsubscriptnode.pass_1 : tnode; + begin + result:=nil; + firstpass(left); + if codegenerror then + exit; + + { several object types must be dereferenced implicitly } + if is_implicit_pointer_object_type(left.resultdef) then + expectloc:=LOC_REFERENCE + else + begin + case left.expectloc of + LOC_REGISTER, + LOC_SUBSETREG: + // can happen for function results on win32 and darwin/x86 + if (left.resultdef.size > sizeof(pint)) then + expectloc:=LOC_REFERENCE + else + expectloc:=LOC_SUBSETREG; + LOC_CREGISTER, + LOC_CSUBSETREG: + expectloc:=LOC_CSUBSETREG; + LOC_REFERENCE, + LOC_CREFERENCE: + expectloc:=left.expectloc; + else internalerror(20060521); + end; + end; + end; + + function tsubscriptnode.docompare(p: tnode): boolean; + begin + docompare := + inherited docompare(p) and + (vs = tsubscriptnode(p).vs); + end; + + +{***************************************************************************** + TVECNODE +*****************************************************************************} + + constructor tvecnode.create(l,r : tnode); + + begin + inherited create(vecn,l,r); + end; + + + function tvecnode.pass_typecheck:tnode; + var + hightree: tnode; + htype,elementdef : tdef; + newordtyp: tordtype; + valid : boolean; + begin + result:=nil; + typecheckpass(left); + typecheckpass(right); + + { implicitly convert stringconstant to stringdef, + see tbs/tb0476.pp for a test } + if (left.nodetype=stringconstn) and + (tstringconstnode(left).cst_type=cst_conststring) then + begin + if tstringconstnode(left).len>255 then + inserttypeconv(left,getansistringdef) + else + inserttypeconv(left,cshortstringtype); + end; + + { In p[1] p is always valid, it is not possible to + declared a shortstring or normal array that has + undefined number of elements. Dynamic array and + ansi/widestring needs to be valid } + valid:=is_dynamic_array(left.resultdef) or + is_ansistring(left.resultdef) or + is_wide_or_unicode_string(left.resultdef) or + { implicit pointer dereference -> pointer is read } + (left.resultdef.typ = pointerdef); + if valid then + set_varstate(left,vs_read,[vsf_must_be_valid]); +{ + A vecn is, just like a loadn, always part of an expression with its + own read/write and must_be_valid semantics. Therefore we don't have + to do anything else here, just like for loadn's +} + set_varstate(right,vs_read,[vsf_must_be_valid]); + if codegenerror then + exit; + + { maybe type conversion for the index value, but + do not convert range nodes } + if (right.nodetype<>rangen) then + case left.resultdef.typ of + arraydef: + begin + htype:=Tarraydef(left.resultdef).rangedef; + if ado_isvariant in Tarraydef(left.resultdef).arrayoptions then + {Variant arrays are a special array, can have negative indexes and would therefore + need s32bit. However, they should not appear in a vecn, as they are handled in + handle_variantarray in pexpr.pas. Therefore, encountering a variant array is an + internal error... } + internalerror(200707031) + else if is_special_array(left.resultdef) then + {Arrays without a high bound (dynamic arrays, open arrays) are zero based, + convert indexes into these arrays to aword.} + inserttypeconv(right,uinttype) + { note: <> rather than </>, because indexing e.g. an array 0..0 + must not result in truncating the indexing value from 2/4/8 + bytes to 1 byte (with range checking off, the full index + value must be used) } + else if (htype.typ=enumdef) and + (right.resultdef.typ=enumdef) and + (tenumdef(htype).basedef=tenumdef(right.resultdef).basedef) and + ((tarraydef(left.resultdef).lowrange<>tenumdef(htype).min) or + (tarraydef(left.resultdef).highrange<>tenumdef(htype).max)) then + {Convert array indexes to low_bound..high_bound.} + inserttypeconv(right,tenumdef.create_subrange(tenumdef(right.resultdef), + asizeint(Tarraydef(left.resultdef).lowrange), + asizeint(Tarraydef(left.resultdef).highrange) + )) + else if (htype.typ=orddef) and + { don't try to create boolean types with custom ranges } + not is_boolean(right.resultdef) and + { ordtype determines the size of the loaded value -> make + sure we don't truncate } + ((Torddef(right.resultdef).ordtype<>torddef(htype).ordtype) or + (tarraydef(left.resultdef).lowrange<>torddef(htype).low) or + (tarraydef(left.resultdef).highrange<>torddef(htype).high)) then + {Convert array indexes to low_bound..high_bound.} + begin + if right.resultdef.typ=orddef then + newordtyp:=Torddef(right.resultdef).ordtype + else + newordtyp:=torddef(ptrsinttype).ordtype; + inserttypeconv(right,Torddef.create(newordtyp, + int64(Tarraydef(left.resultdef).lowrange), + int64(Tarraydef(left.resultdef).highrange) + )) + end + else + inserttypeconv(right,htype) + end; + stringdef: + if is_open_string(left.resultdef) then + inserttypeconv(right,u8inttype) + else if is_shortstring(left.resultdef) then + {Convert shortstring indexes to 0..length.} + inserttypeconv(right,Torddef.create(u8bit,0,int64(Tstringdef(left.resultdef).len))) + else + {Convert indexes into dynamically allocated strings to aword.} + inserttypeconv(right,uinttype); + else + {Others, i.e. pointer indexes to aint.} + inserttypeconv(right,sinttype); + end; + + { although we never put regular arrays or shortstrings in registers, + it's possible that another type was typecasted to a small record + that has a field of one of these types -> in that case the record + can't be a regvar either } + if ((left.resultdef.typ=arraydef) and + not is_special_array(left.resultdef)) or + ((left.resultdef.typ=stringdef) and + (tstringdef(left.resultdef).stringtype in [st_shortstring,st_longstring])) then + make_not_regable(left,[ra_addr_regable]); + + case left.resultdef.typ of + arraydef : + begin + { check type of the index value } + if (compare_defs(right.resultdef,tarraydef(left.resultdef).rangedef,right.nodetype)=te_incompatible) then + IncompatibleTypes(right.resultdef,tarraydef(left.resultdef).rangedef); + if right.nodetype=rangen then + resultdef:=left.resultdef + else + resultdef:=Tarraydef(left.resultdef).elementdef; + + { if we are range checking an open array or array of const, we } + { need to load the high parameter. If the current procedure is } + { nested inside the procedure to which the open array/of const } + { was passed, then the high parameter must not be a regvar. } + { So create a loadnode for the high parameter here and } + { typecheck it, then the loadnode will make the high parameter } + { not regable. Otherwise this would only happen inside pass_2, } + { which is too late since by then the regvars are already } + { assigned (pass_1 is also already too late, because then the } + { regvars of the parent are also already assigned). } + { webtbs/tw8975 } + if (cs_check_range in current_settings.localswitches) and + (is_open_array(left.resultdef) or + is_array_of_const(left.resultdef)) and + { cdecl functions don't have high() so we can not check the range } + { (can't use current_procdef, since it may be a nested procedure) } + not(tprocdef(tparasymtable(tparavarsym(tloadnode(left).symtableentry).owner).defowner).proccalloption in cdecl_pocalls) then + begin + { load_high_value_node already typechecks } + hightree:=load_high_value_node(tparavarsym(tloadnode(left).symtableentry)); + hightree.free; + end; + + + end; + pointerdef : + begin + { are we accessing a pointer[], then convert the pointer to + an array first, in FPC this is allowed for all pointers + (except voidpointer) in delphi/tp7 it's only allowed for pchars. } + if not is_voidpointer(left.resultdef) and + ( + (cs_pointermath in current_settings.localswitches) or + tpointerdef(left.resultdef).has_pointer_math or + is_pchar(left.resultdef) or + is_pwidechar(left.resultdef) + ) then + begin + { convert pointer to array } + htype:=tarraydef.create_from_pointer(tpointerdef(left.resultdef).pointeddef); + inserttypeconv(left,htype); + if right.nodetype=rangen then + resultdef:=htype + else + resultdef:=tarraydef(htype).elementdef; + end + else + CGMessage(type_e_array_required); + end; + stringdef : + begin + case tstringdef(left.resultdef).stringtype of + st_unicodestring, + st_widestring : + elementdef:=cwidechartype; + st_ansistring : + elementdef:=cchartype; + st_longstring : + elementdef:=cchartype; + st_shortstring : + elementdef:=cchartype; + end; + if right.nodetype=rangen then + begin + htype:=Tarraydef.create_from_pointer(elementdef); + resultdef:=htype; + end + else + begin + { indexed access to 0 element is only allowed for shortstrings } + if (right.nodetype=ordconstn) and + (Tordconstnode(right).value.svalue=0) and + not is_shortstring(left.resultdef) then + CGMessage(cg_e_can_access_element_zero); + resultdef:=elementdef; + end; + end; + variantdef : + resultdef:=cvarianttype; + else + CGMessage(type_e_array_required); + end; + end; + + procedure Tvecnode.mark_write; + + begin + include(flags,nf_write); + end; + + function tvecnode.pass_1 : tnode; + begin + result:=nil; + firstpass(left); + firstpass(right); + if codegenerror then + exit; + + if (nf_callunique in flags) and + (is_ansistring(left.resultdef) or + is_unicodestring(left.resultdef) or + (is_widestring(left.resultdef) and not(tf_winlikewidestring in target_info.flags))) then + begin + left := ctypeconvnode.create_internal(ccallnode.createintern('fpc_'+tstringdef(left.resultdef).stringtypname+'_unique', + ccallparanode.create( + ctypeconvnode.create_internal(left,voidpointertype),nil)), + left.resultdef); + firstpass(left); + { double resultdef passes somwhere else may cause this to be } + { reset though :/ } + exclude(flags,nf_callunique); + end + else if is_widestring(left.resultdef) and (tf_winlikewidestring in target_info.flags) then + exclude(flags,nf_callunique); + + { a range node as array index can only appear in function calls, and + those convert the range node into something else in + tcallnode.gen_high_tree } + if (right.nodetype=rangen) then + CGMessagePos(right.fileinfo,parser_e_illegal_expression) + else if (not is_packed_array(left.resultdef)) or + ((tarraydef(left.resultdef).elepackedbitsize mod 8) = 0) then + if left.expectloc=LOC_CREFERENCE then + expectloc:=LOC_CREFERENCE + else + expectloc:=LOC_REFERENCE + else + if left.expectloc=LOC_CREFERENCE then + expectloc:=LOC_CSUBSETREF + else + expectloc:=LOC_SUBSETREF; + end; + + +{***************************************************************************** + TWITHNODE +*****************************************************************************} + + constructor twithnode.create(l:tnode); + begin + inherited create(withn,l); + fileinfo:=l.fileinfo; + end; + + + destructor twithnode.destroy; + begin + inherited destroy; + end; + + + constructor twithnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + end; + + + procedure twithnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + end; + + + function twithnode.dogetcopy : tnode; + var + p : twithnode; + begin + p:=twithnode(inherited dogetcopy); + result:=p; + end; + + + function twithnode.pass_typecheck:tnode; + begin + result:=nil; + resultdef:=voidtype; + if assigned(left) then + typecheckpass(left); + end; + + + function twithnode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_VOID; + end; + + + function twithnode.docompare(p: tnode): boolean; + begin + docompare := + inherited docompare(p); + end; + + function is_big_untyped_addrnode(p: tnode): boolean; + begin + is_big_untyped_addrnode:=(p.nodetype=addrn) and + not (nf_typedaddr in p.flags) and (taddrnode(p).left.resultdef.size > 1); + end; + +end. diff --git a/closures/compiler/nobj.pas b/closures/compiler/nobj.pas new file mode 100644 index 0000000000..7ce974f2f7 --- /dev/null +++ b/closures/compiler/nobj.pas @@ -0,0 +1,1593 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Routines for the code generation of data structures + like VMT, Messages, VTables, Interfaces descs + + 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 nobj; + +{$i fpcdefs.inc} + +interface + + uses + cutils,cclasses, + globtype, + symdef,symsym, + aasmbase,aasmtai,aasmdata + ; + + type + TVMTBuilder=class + private + _Class : tobjectdef; + handledprotocols: tfpobjectlist; + function is_new_vmt_entry(pd:tprocdef; out overridesclasshelper: boolean):boolean; + procedure add_new_vmt_entry(pd:tprocdef; allowoverridingmethod: boolean); + function check_msg_str(vmtpd, pd: tprocdef):boolean; + function intf_search_procdef_by_name(proc: tprocdef;const name: string): tprocdef; + procedure intf_get_procdefs(ImplIntf:TImplementedInterface;IntfDef:TObjectDef); + procedure intf_get_procdefs_recursive(ImplIntf:TImplementedInterface;IntfDef:TObjectDef); + procedure prot_get_procdefs_recursive(ImplProt:TImplementedInterface;ProtDef:TObjectDef); + procedure intf_optimize_vtbls; + procedure intf_allocate_vtbls; + public + constructor create(c:tobjectdef); + destructor destroy;override; + procedure generate_vmt; + procedure build_interface_mappings; + end; + + type + pprocdeftree = ^tprocdeftree; + tprocdeftree = record + data : tprocdef; + nl : tasmlabel; + l,r : pprocdeftree; + end; + + TVMTWriter=class + private + _Class : tobjectdef; + { message tables } + root : pprocdeftree; + procedure disposeprocdeftree(p : pprocdeftree); + procedure insertmsgint(p:TObject;arg:pointer); + procedure insertmsgstr(p:TObject;arg:pointer); + procedure insertint(p : pprocdeftree;var at : pprocdeftree;var count:longint); + procedure insertstr(p : pprocdeftree;var at : pprocdeftree;var count:longint); + procedure writenames(p : pprocdeftree); + procedure writeintentry(p : pprocdeftree); + procedure writestrentry(p : pprocdeftree); +{$ifdef WITHDMT} + { dmt } + procedure insertdmtentry(p:TObject;arg:pointer); + procedure writedmtindexentry(p : pprocdeftree); + procedure writedmtaddressentry(p : pprocdeftree); +{$endif} + { published methods } + procedure do_count_published_methods(p:TObject;arg:pointer); + procedure do_gen_published_methods(p:TObject;arg:pointer); + { virtual methods } + procedure writevirtualmethods(List:TAsmList); + { interface tables } + function intf_get_vtbl_name(AImplIntf:TImplementedInterface): string; + procedure intf_create_vtbl(rawdata: TAsmList;AImplIntf:TImplementedInterface); + procedure intf_gen_intf_ref(rawdata: TAsmList;AImplIntf:TImplementedInterface); + function intf_write_table:TAsmLabel; + { generates the message tables for a class } + function genstrmsgtab : tasmlabel; + function genintmsgtab : tasmlabel; + function genpublishedmethodstable : tasmlabel; + function generate_field_table : tasmlabel; +{$ifdef WITHDMT} + { generates a DMT for _class } + function gendmt : tasmlabel; +{$endif WITHDMT} + public + constructor create(c:tobjectdef); + destructor destroy;override; + { write the VMT to al_globals } + procedure writevmt; + procedure writeinterfaceids; + end; + +implementation + + uses + SysUtils, + globals,verbose,systems, + node, + symbase,symtable,symconst,symtype,defcmp, + dbgbase, + ncgrtti, + wpobase + ; + + +{***************************************************************************** + TVMTBuilder +*****************************************************************************} + + constructor TVMTBuilder.create(c:tobjectdef); + begin + inherited Create; + _Class:=c; + end; + + + destructor TVMTBuilder.destroy; + begin + end; + + + procedure TVMTBuilder.add_new_vmt_entry(pd:tprocdef; allowoverridingmethod: boolean); + var + i : longint; + vmtentry : pvmtentry; + vmtpd : tprocdef; + begin + { new entry is needed, override was not possible } + { Allowed when overriding a category method for a parent class in a + descendent Objective-C class } + if not allowoverridingmethod and + (po_overridingmethod in pd.procoptions) then + MessagePos1(pd.fileinfo,parser_e_nothing_to_be_overridden,pd.fullprocname(false)); + + { check that all methods have overload directive } + if not(m_fpc in current_settings.modeswitches) then + begin + for i:=0 to _class.vmtentries.count-1 do + begin + vmtentry:=pvmtentry(_class.vmtentries[i]); + vmtpd:=tprocdef(vmtentry^.procdef); + if (vmtpd.procsym=pd.procsym) and + (not(po_overload in pd.procoptions) or + not(po_overload in vmtpd.procoptions)) then + begin + MessagePos1(pd.fileinfo,parser_e_no_overload_for_all_procs,pd.procsym.realname); + { recover } + include(vmtpd.procoptions,po_overload); + include(pd.procoptions,po_overload); + end; + end; + end; + + { Register virtual method and give it a number } + if (po_virtualmethod in pd.procoptions) then + begin + { store vmt entry number in procdef } + if (pd.extnumber<>$ffff) and + (pd.extnumber<>_class.VMTEntries.Count) then + internalerror(200810283); + pd.extnumber:=_class.VMTEntries.Count; + new(vmtentry); + vmtentry^.procdef:=pd; + vmtentry^.procdefderef.reset; + vmtentry^.visibility:=pd.visibility; + _class.VMTEntries.Add(vmtentry); + end; + end; + + + function TVMTBuilder.check_msg_str(vmtpd, pd: tprocdef): boolean; + begin + result:=true; + if not(is_objc_class_or_protocol(_class)) then + begin + { the only requirement for normal methods is that both either + have a message string or not (the value is irrelevant) } + if ((pd.procoptions * [po_msgstr]) <> (vmtpd.procoptions * [po_msgstr])) then + begin + MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,pd.fullprocname(false)); + tprocsym(vmtpd.procsym).write_parameter_lists(pd); + result:=false; + end + end + else + begin + { the compiler should have ensured that the protocol or parent + class method has a message name specified } + if not(po_msgstr in vmtpd.procoptions) then + internalerror(2009070601); + if not(po_msgstr in pd.procoptions) then + begin + { copy the protocol's/parent class' message name to the one in + the class if none has been specified there } + include(pd.procoptions,po_msgstr); + pd.messageinf.str:=stringdup(vmtpd.messageinf.str^); + end + else + begin + { if both have a message name, make sure they are equal } + if (vmtpd.messageinf.str^<>pd.messageinf.str^) then + begin + MessagePos2(pd.fileinfo,parser_e_objc_message_name_changed,vmtpd.messageinf.str^,pd.messageinf.str^); + result:=false; + end; + end; + end; + end; + + + function TVMTBuilder.is_new_vmt_entry(pd:tprocdef; out overridesclasshelper: boolean):boolean; + const + po_comp = [po_classmethod,po_virtualmethod,po_staticmethod,po_interrupt,po_iocheck,po_msgint, + po_exports,po_varargs,po_explicitparaloc,po_nostackframe]; + var + i : longint; + hasequalpara, + hasoverloads, + pdoverload : boolean; + srsym : tsym; + st : tsymtable; + + // returns true if we can stop checking, false if we have to continue + function found_entry(var vmtpd: tprocdef; var vmtentryvis: tvisibility; updatevalues: boolean): boolean; + begin + result:=false; + + { ignore hidden entries (e.g. virtual overridden by a static) that are not visible anymore } + if vmtentryvis=vis_hidden then + exit; + + { ignore different names } + if vmtpd.procsym.name<>pd.procsym.name then + exit; + + { hide private methods that are not visible anymore. For this check we + must override the visibility with the highest value in the override chain. + This is required for case (see tw3292) with protected-private-protected where the + same vmtentry is used (PFV) } + if not is_visible_for_object(vmtpd.owner,vmtentryvis,_class) then + exit; + + { inherit overload } + if (po_overload in vmtpd.procoptions) then + begin + include(pd.procoptions,po_overload); + pdoverload:=true; + end; + + { compare parameter types only, no specifiers yet } + hasequalpara:=(compare_paras(vmtpd.paras,pd.paras,cp_none,[cpo_ignoreuniv,cpo_ignorehidden])>=te_equal); + + { check that we are not trying to override a final method } + if (po_finalmethod in vmtpd.procoptions) and + hasequalpara and (po_overridingmethod in pd.procoptions) and + (is_class(_class) or is_objectpascal_helper(_class)) then + MessagePos1(pd.fileinfo,parser_e_final_can_no_be_overridden,pd.fullprocname(false)) + else + { old definition has virtual + new definition has no virtual or override } + if (po_virtualmethod in vmtpd.procoptions) and + ( + not(po_virtualmethod in pd.procoptions) or + ( + { new one does not have reintroduce in case of an objccategory } + (is_objccategory(_class) and not(po_reintroduce in pd.procoptions)) or + { new one does not have override in case of objpas/objc class/helper/intf/proto } + ( + (is_class_or_interface_or_objc(_class) or is_objectpascal_helper(_class)) and + not is_objccategory(_class) and not(po_overridingmethod in pd.procoptions) + ) + ) + ) then + begin + if ( + not(pdoverload or hasoverloads) or + hasequalpara + ) then + begin + if not(po_reintroduce in pd.procoptions) then + if not(is_objc_class_or_protocol(_class)) then + MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false)) + else + begin + { In Objective-C, you cannot create a new VMT entry to + start a new inheritance tree. We therefore give an + error when the class is implemented in Pascal, to + avoid confusion due to things working differently + with Object Pascal classes. + + In case of external classes, we only give a hint, + because requiring override everywhere may make + automated header translation tools too complex. } + if not(oo_is_external in _class.objectoptions) then + if not is_objccategory(_class) then + MessagePos1(pd.fileinfo,parser_e_must_use_override_objc,FullTypeName(tdef(vmtpd.owner.defowner),nil)) + else + MessagePos1(pd.fileinfo,parser_e_must_use_reintroduce_objc,FullTypeName(tdef(vmtpd.owner.defowner),nil)) + { there may be a lot of these in auto-translated + heaeders, so only calculate the fulltypename if + the hint will be shown } + else if CheckVerbosity(V_Hint) then + if not is_objccategory(_class) then + MessagePos1(pd.fileinfo,parser_h_should_use_override_objc,FullTypeName(tdef(vmtpd.owner.defowner),nil)) + else + MessagePos1(pd.fileinfo,parser_h_should_use_reintroduce_objc,FullTypeName(tdef(vmtpd.owner.defowner),nil)); + { no new entry, but copy the message name if any from + the procdef in the parent class } + check_msg_str(vmtpd,pd); + result:=true; + exit; + end; + { disable/hide old VMT entry } + if updatevalues then + vmtentryvis:=vis_hidden; + end; + end + { both are virtual? } + else if (po_virtualmethod in pd.procoptions) and + (po_virtualmethod in vmtpd.procoptions) then + begin + { same parameter and return types (parameter specifiers will be checked below) } + if hasequalpara and + compatible_childmethod_resultdef(vmtpd.returndef,pd.returndef) then + begin + { inherite calling convention when it was explicit and the + current definition has none explicit set } + if (po_hascallingconvention in vmtpd.procoptions) and + not(po_hascallingconvention in pd.procoptions) then + begin + pd.proccalloption:=vmtpd.proccalloption; + include(pd.procoptions,po_hascallingconvention); + end; + + { All parameter specifiers and some procedure the flags have to match + except abstract and override } + if (compare_paras(vmtpd.paras,pd.paras,cp_all,[cpo_ignoreuniv,cpo_ignorehidden])<te_equal) or + (vmtpd.proccalloption<>pd.proccalloption) or + (vmtpd.proctypeoption<>pd.proctypeoption) or + ((vmtpd.procoptions*po_comp)<>(pd.procoptions*po_comp)) then + begin + MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,pd.fullprocname(false)); + tprocsym(vmtpd.procsym).write_parameter_lists(pd); + end; + + check_msg_str(vmtpd,pd); + + { Give a note if the new visibility is lower. For a higher + visibility update the vmt info } + if vmtentryvis>pd.visibility then + MessagePos4(pd.fileinfo,parser_n_ignore_lower_visibility,pd.fullprocname(false), + visibilityname[pd.visibility],tobjectdef(vmtpd.owner.defowner).objrealname^,visibilityname[vmtentryvis]) + else if pd.visibility>vmtentryvis then + begin + if updatevalues then + vmtentryvis:=pd.visibility; + end; + + { override old virtual method in VMT } + if updatevalues then + begin + if (vmtpd.extnumber<>i) then + internalerror(200611084); + pd.extnumber:=vmtpd.extnumber; + vmtpd:=pd; + end; + result:=true; + exit; + end + { different parameters } + else + begin + { when we got an override directive then can search futher for + the procedure to override. + If we are starting a new virtual tree then hide the old tree } + if not(po_overridingmethod in pd.procoptions) and + not(pdoverload or hasoverloads) then + begin + if not(po_reintroduce in pd.procoptions) then + begin + if not is_object(_class) and + not is_objc_class_or_protocol(_class) then + MessagePos1(pd.fileinfo,parser_w_should_use_override,pd.fullprocname(false)) + else + { objects don't allow starting a new virtual tree + and neither does Objective-C } + MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,vmtpd.fullprocname(false)); + end; + { disable/hide old VMT entry } + if updatevalues then + vmtentryvis:=vis_hidden; + end; + end; + end; + end; + + function found_category_method(st: tsymtable): boolean; + var + entrycount: longint; + cat: tobjectdef; + vmtpd: tprocdef; + vmtvis: tvisibility; + begin + result:=false; + if is_objccategory(tdef(st.defowner)) then + begin + cat:=tobjectdef(st.defowner); + { go through all of the category's methods to find the + vmtentry corresponding to the procdef we are handling } + for entrycount:=0 to cat.vmtentries.Count-1 do + begin + vmtpd:=pvmtentry(cat.vmtentries[entrycount])^.procdef; + vmtvis:=pvmtentry(cat.vmtentries[entrycount])^.visibility; + { don't change the vmtentry of the category } + if found_entry(vmtpd,vmtvis,false) then + begin + result:=true; + exit; + end; + end; + end; + end; + + begin + result:=false; + overridesclasshelper:=false; + { Load other values for easier readability } + hasoverloads:=(tprocsym(pd.procsym).ProcdefList.Count>1); + pdoverload:=(po_overload in pd.procoptions); + + { compare with all stored definitions } + for i:=0 to _class.vmtentries.Count-1 do + begin + if found_entry(pvmtentry(_class.vmtentries[i])^.procdef, pvmtentry(_class.vmtentries[i])^.visibility,true) then + exit; + end; + + { in case of Objective-C, also check the categories that apply to this + class' *parent* for methods to override (don't allow class X to + "override" a method added by a category to class X itself, since in + that case the category method will in fact replace class X' + "overriding" method } + if is_objcclass(_class) and + assigned(_class.childof) and + search_objc_helper(_class.childof,pd.procsym.name,srsym,st) then + begin + overridesclasshelper:=found_category_method(st); + end; + + { No entry found, we need to create a new entry } + result:=true; + end; + + + function TVMTBuilder.intf_search_procdef_by_name(proc: tprocdef;const name: string): tprocdef; + const + po_comp = [po_classmethod,po_staticmethod,po_interrupt,po_iocheck,po_msgint, + po_exports,po_varargs,po_explicitparaloc,po_nostackframe]; + var + implprocdef : Tprocdef; + i: cardinal; + hclass : tobjectdef; + hashedid : THashedIDString; + srsym : tsym; + begin + result:=nil; + hashedid.id:=name; + hclass:=_class; + while assigned(hclass) do + begin + srsym:=tsym(hclass.symtable.FindWithHash(hashedid)); + if assigned(srsym) and + (srsym.typ=procsym) then + begin + for i:=0 to Tprocsym(srsym).ProcdefList.Count-1 do + begin + implprocdef:=tprocdef(tprocsym(srsym).ProcdefList[i]); + if (implprocdef.procsym=tprocsym(srsym)) and + (compare_paras(proc.paras,implprocdef.paras,cp_all,[cpo_ignorehidden,cpo_comparedefaultvalue,cpo_ignoreuniv])>=te_equal) and + (compare_defs(proc.returndef,implprocdef.returndef,nothingn)>=te_equal) and + (proc.proccalloption=implprocdef.proccalloption) and + (proc.proctypeoption=implprocdef.proctypeoption) and + ((proc.procoptions*po_comp)=((implprocdef.procoptions+[po_virtualmethod])*po_comp)) and + check_msg_str(proc,implprocdef) then + begin + result:=implprocdef; + exit; + end; + end; + end; + hclass:=hclass.childof; + end; + end; + + + procedure TVMTBuilder.intf_get_procdefs(ImplIntf:TImplementedInterface;IntfDef:TObjectDef); + var + i : longint; + def : tdef; + hs, + prefix, + mappedname: string; + implprocdef: tprocdef; + begin + prefix:=ImplIntf.IntfDef.symtable.name^+'.'; + for i:=0 to IntfDef.symtable.DefList.Count-1 do + begin + def:=tdef(IntfDef.symtable.DefList[i]); + if assigned(def) and + (def.typ=procdef) then + begin + { Find implementing procdef + 1. Check for mapped name + 2. Use symbol name, but only if there's no mapping, + or we're processing ancestor of interface. + When modifying this code, ensure that webtbs/tw11862, webtbs/tw4950 + and webtbf/tw19591 stay correct. } + implprocdef:=nil; + hs:=prefix+tprocdef(def).procsym.name; + mappedname:=ImplIntf.GetMapping(hs); + if mappedname<>'' then + implprocdef:=intf_search_procdef_by_name(tprocdef(def),mappedname); + if not assigned(implprocdef) then + if (mappedname='') or (ImplIntf.IntfDef<>IntfDef) then + implprocdef:=intf_search_procdef_by_name(tprocdef(def),tprocdef(def).procsym.name); + + { Add procdef to the implemented interface } + if assigned(implprocdef) then + begin + if (tobjectdef(implprocdef.struct).objecttype<>odt_objcclass) then + ImplIntf.AddImplProc(implprocdef) + else + begin + { If no message name has been specified for the method + in the objcclass, copy it from the protocol + definition. } + if not(po_msgstr in tprocdef(def).procoptions) then + begin + include(tprocdef(def).procoptions,po_msgstr); + implprocdef.messageinf.str:=stringdup(tprocdef(def).messageinf.str^); + end + else + begin + { If a message name has been specified in the + objcclass, it has to match the message name in the + protocol definition. } + if (implprocdef.messageinf.str^<>tprocdef(def).messageinf.str^) then + MessagePos2(implprocdef.fileinfo,parser_e_objc_message_name_changed,tprocdef(def).messageinf.str^,implprocdef.messageinf.str^); + end; + end; + end + else + if (ImplIntf.IType=etStandard) and + not(po_optional in tprocdef(def).procoptions) then + MessagePos1(_Class.typesym.fileinfo,sym_e_no_matching_implementation_found,tprocdef(def).fullprocname(false)); + end; + end; + end; + + + procedure TVMTBuilder.intf_get_procdefs_recursive(ImplIntf:TImplementedInterface;IntfDef:TObjectDef); + begin + if assigned(IntfDef.childof) then + intf_get_procdefs_recursive(ImplIntf,IntfDef.childof); + intf_get_procdefs(ImplIntf,IntfDef); + end; + + + procedure TVMTBuilder.prot_get_procdefs_recursive(ImplProt:TImplementedInterface;ProtDef:TObjectDef); + var + i: longint; + begin + { don't check the same protocol twice } + if handledprotocols.IndexOf(ProtDef)<>-1 then + exit; + handledprotocols.add(ProtDef); + for i:=0 to ProtDef.ImplementedInterfaces.count-1 do + prot_get_procdefs_recursive(ImplProt,TImplementedInterface(ProtDef.ImplementedInterfaces[i]).intfdef); + intf_get_procdefs(ImplProt,ProtDef); + end; + + + procedure TVMTBuilder.intf_optimize_vtbls; + type + tcompintfentry = record + weight: longint; + compintf: longint; + end; + { Max 1000 interface in the class header interfaces it's enough imho } + tcompintfs = array[0..1000] of tcompintfentry; + pcompintfs = ^tcompintfs; + tequals = array[0..1000] of longint; + pequals = ^tequals; + timpls = array[0..1000] of longint; + pimpls = ^timpls; + var + aequals: pequals; + compats: pcompintfs; + impls: pimpls; + ImplIntfCount, + w,i,j,k: longint; + ImplIntfI, + ImplIntfJ : TImplementedInterface; + cij: boolean; + cji: boolean; + begin + ImplIntfCount:=_class.ImplementedInterfaces.count; + if ImplIntfCount>=High(tequals) then + Internalerror(200006135); + getmem(compats,sizeof(tcompintfentry)*ImplIntfCount); + getmem(aequals,sizeof(longint)*ImplIntfCount); + getmem(impls,sizeof(longint)*ImplIntfCount); + filldword(compats^,(sizeof(tcompintfentry) div sizeof(dword))*ImplIntfCount,dword(-1)); + filldword(aequals^,ImplIntfCount,dword(-1)); + filldword(impls^,ImplIntfCount,dword(-1)); + { ismergepossible is a containing relation + meaning of ismergepossible(a,b,w) = + if implementorfunction map of a is contained implementorfunction map of b + imp(a,b) and imp(b,c) => imp(a,c) ; imp(a,b) and imp(b,a) => a == b + } + { the order is very important for correct allocation } + for i:=0 to ImplIntfCount-1 do + begin + for j:=i+1 to ImplIntfCount-1 do + begin + ImplIntfI:=TImplementedInterface(_class.ImplementedInterfaces[i]); + ImplIntfJ:=TImplementedInterface(_class.ImplementedInterfaces[j]); + cij:=ImplIntfI.IsImplMergePossible(ImplIntfJ,w); + cji:=ImplIntfJ.IsImplMergePossible(ImplIntfI,w); + if cij and cji then { i equal j } + begin + { get minimum index of equal } + if aequals^[j]=-1 then + aequals^[j]:=i; + end + else if cij then + begin + { get minimum index of maximum weight } + if compats^[i].weight<w then + begin + compats^[i].weight:=w; + compats^[i].compintf:=j; + end; + end + else if cji then + begin + { get minimum index of maximum weight } + if (compats^[j].weight<w) then + begin + compats^[j].weight:=w; + compats^[j].compintf:=i; + end; + end; + end; + end; + { Reset, no replacements by default } + for i:=0 to ImplIntfCount-1 do + impls^[i]:=i; + { Replace vtbls when equal or compat, repeat + until there are no replacements possible anymore. This is + needed for the cases like: + First loop: 2->3, 3->1 + Second loop: 2->1 (because 3 was replaced with 1) + } + repeat + k:=0; + for i:=0 to ImplIntfCount-1 do + begin + if compats^[impls^[i]].compintf<>-1 then + impls^[i]:=compats^[impls^[i]].compintf + else if aequals^[impls^[i]]<>-1 then + impls^[i]:=aequals^[impls^[i]] + else + inc(k); + end; + until k=ImplIntfCount; + { Update the VtblImplIntf } + for i:=0 to ImplIntfCount-1 do + begin + ImplIntfI:=TImplementedInterface(_class.ImplementedInterfaces[i]); + ImplIntfI.VtblImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[impls^[i]]); + end; + freemem(compats); + freemem(aequals); + freemem(impls); + end; + + + procedure TVMTBuilder.intf_allocate_vtbls; + var + i : longint; + ImplIntf : TImplementedInterface; + begin + { Allocation vtbl space } + for i:=0 to _class.ImplementedInterfaces.count-1 do + begin + ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]); + { if it implements itself and if it's not implemented by delegation } + if (ImplIntf.VtblImplIntf=ImplIntf) and (ImplIntf.IType=etStandard) then + begin + { allocate a pointer in the object memory } + with tObjectSymtable(_class.symtable) do + begin + datasize:=align(datasize,sizeof(pint)); + ImplIntf.Ioffset:=datasize; + datasize:=datasize+sizeof(pint); + end; + end; + end; + { Update ioffset of current interface with the ioffset from + the interface that is reused to implements this interface } + for i:=0 to _class.ImplementedInterfaces.count-1 do + begin + ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]); + if ImplIntf.VtblImplIntf<>ImplIntf then + ImplIntf.IOffset:=ImplIntf.VtblImplIntf.IOffset; + end; + end; + + + procedure TVMTBuilder.generate_vmt; + var + i : longint; + def : tdef; + old_current_structdef : tabstractrecorddef; + overridesclasshelper : boolean; + begin + old_current_structdef:=current_structdef; + current_structdef:=_class; + + _class.resetvmtentries; + + { inherit (copy) VMT from parent object } + if assigned(_class.childof) then + begin + if not assigned(_class.childof.vmtentries) then + internalerror(200810281); + _class.copyvmtentries(_class.childof); + end; + + { process all procdefs, we must process the defs to + keep the same order as that is written in the source + to be compatible with the indexes in the interface vtable (PFV) } + for i:=0 to _class.symtable.DefList.Count-1 do + begin + def:=tdef(_class.symtable.DefList[i]); + if def.typ=procdef then + begin + { VMT entry } + if is_new_vmt_entry(tprocdef(def),overridesclasshelper) then + add_new_vmt_entry(tprocdef(def),overridesclasshelper); + end; + end; + build_interface_mappings; + if assigned(_class.ImplementedInterfaces) and + not(is_objc_class_or_protocol(_class)) then + begin + { Optimize interface tables to reuse wrappers } + intf_optimize_vtbls; + { Allocate interface tables } + intf_allocate_vtbls; + end; + + current_structdef:=old_current_structdef; + end; + + + procedure TVMTBuilder.build_interface_mappings; + var + ImplIntf : TImplementedInterface; + i: longint; + begin + { Find Procdefs implementing the interfaces } + if assigned(_class.ImplementedInterfaces) and + (_class.objecttype<>odt_objcprotocol) then + begin + { Collect implementor functions into the tImplementedInterface.procdefs } + case _class.objecttype of + odt_class: + begin + for i:=0 to _class.ImplementedInterfaces.count-1 do + begin + ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]); + intf_get_procdefs_recursive(ImplIntf,ImplIntf.IntfDef) + end; + end; + odt_objcclass: + begin + { Object Pascal interfaces are afterwards optimized via the + intf_optimize_vtbls() method, but we can't do this for + protocols -> check for duplicates here already. } + handledprotocols:=tfpobjectlist.create(false); + for i:=0 to _class.ImplementedInterfaces.count-1 do + begin + ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]); + prot_get_procdefs_recursive(ImplIntf,ImplIntf.IntfDef); + end; + handledprotocols.free; + end + else + internalerror(2009091801); + end + end; + end; + + +{***************************************************************************** + TVMTWriter +*****************************************************************************} + + constructor TVMTWriter.create(c:tobjectdef); + begin + inherited Create; + _Class:=c; + end; + + + destructor TVMTWriter.destroy; + begin + end; + + +{************************************** + Message Tables +**************************************} + + procedure TVMTWriter.disposeprocdeftree(p : pprocdeftree); + begin + if assigned(p^.l) then + disposeprocdeftree(p^.l); + if assigned(p^.r) then + disposeprocdeftree(p^.r); + dispose(p); + end; + + + procedure TVMTWriter.insertint(p : pprocdeftree;var at : pprocdeftree;var count:longint); + begin + if at=nil then + begin + at:=p; + inc(count); + end + else + begin + if p^.data.messageinf.i<at^.data.messageinf.i then + insertint(p,at^.l,count) + else if p^.data.messageinf.i>at^.data.messageinf.i then + insertint(p,at^.r,count) + else + Message1(parser_e_duplicate_message_label,tostr(p^.data.messageinf.i)); + end; + end; + + + procedure TVMTWriter.insertstr(p : pprocdeftree;var at : pprocdeftree;var count:longint); + var + i : integer; + begin + if at=nil then + begin + at:=p; + inc(count); + end + else + begin + i:=CompareStr(p^.data.messageinf.str^,at^.data.messageinf.str^); + if i<0 then + insertstr(p,at^.l,count) + else if i>0 then + insertstr(p,at^.r,count) + else + Message1(parser_e_duplicate_message_label,p^.data.messageinf.str^); + end; + end; + + + procedure TVMTWriter.insertmsgint(p:TObject;arg:pointer); + var + i : longint; + pd : Tprocdef; + pt : pprocdeftree; + begin + if tsym(p).typ<>procsym then + exit; + for i:=0 to Tprocsym(p).ProcdefList.Count-1 do + begin + pd:=tprocdef(Tprocsym(p).ProcdefList[i]); + if po_msgint in pd.procoptions then + begin + new(pt); + pt^.data:=pd; + pt^.l:=nil; + pt^.r:=nil; + insertint(pt,root,plongint(arg)^); + end; + end; + end; + + + procedure TVMTWriter.insertmsgstr(p:TObject;arg:pointer); + var + i : longint; + pd : Tprocdef; + pt : pprocdeftree; + begin + if tsym(p).typ<>procsym then + exit; + for i:=0 to Tprocsym(p).ProcdefList.Count-1 do + begin + pd:=tprocdef(Tprocsym(p).ProcdefList[i]); + if po_msgstr in pd.procoptions then + begin + new(pt); + pt^.data:=pd; + pt^.l:=nil; + pt^.r:=nil; + insertstr(pt,root,plongint(arg)^); + end; + end; + end; + + + procedure TVMTWriter.writenames(p : pprocdeftree); + var + ca : pchar; + len : byte; + begin + current_asmdata.getdatalabel(p^.nl); + if assigned(p^.l) then + writenames(p^.l); + current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint)))); + current_asmdata.asmlists[al_globals].concat(Tai_label.Create(p^.nl)); + len:=length(p^.data.messageinf.str^); + current_asmdata.asmlists[al_globals].concat(tai_const.create_8bit(len)); + getmem(ca,len+1); + move(p^.data.messageinf.str^[1],ca^,len); + ca[len]:=#0; + current_asmdata.asmlists[al_globals].concat(Tai_string.Create_pchar(ca,len)); + if assigned(p^.r) then + writenames(p^.r); + end; + + procedure TVMTWriter.writestrentry(p : pprocdeftree); + + begin + if assigned(p^.l) then + writestrentry(p^.l); + + { write name label } + current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint)))); + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(p^.nl)); + current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint)))); + current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(p^.data.mangledname,0)); + + if assigned(p^.r) then + writestrentry(p^.r); + end; + + + function TVMTWriter.genstrmsgtab : tasmlabel; + var + count : longint; + begin + root:=nil; + count:=0; + { insert all message handlers into a tree, sorted by name } + _class.symtable.SymList.ForEachCall(@insertmsgstr,@count); + + { write all names } + if assigned(root) then + writenames(root); + + { now start writing of the message string table } + current_asmdata.getdatalabel(result); + current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint)))); + current_asmdata.asmlists[al_globals].concat(Tai_label.Create(result)); + current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(longint)))); + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_32bit(count)); + current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint)))); + if assigned(root) then + begin + writestrentry(root); + disposeprocdeftree(root); + end; + end; + + + procedure TVMTWriter.writeintentry(p : pprocdeftree); + begin + if assigned(p^.l) then + writeintentry(p^.l); + + { write name label } + current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(longint)))); + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_32bit(p^.data.messageinf.i)); + current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint)))); + current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(p^.data.mangledname,0)); + + if assigned(p^.r) then + writeintentry(p^.r); + end; + + + function TVMTWriter.genintmsgtab : tasmlabel; + var + r : tasmlabel; + count : longint; + begin + root:=nil; + count:=0; + { insert all message handlers into a tree, sorted by name } + _class.symtable.SymList.ForEachCall(@insertmsgint,@count); + + { now start writing of the message string table } + current_asmdata.getdatalabel(r); + current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint)))); + current_asmdata.asmlists[al_globals].concat(Tai_label.Create(r)); + genintmsgtab:=r; + current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(longint)))); + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_32bit(count)); + current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint)))); + if assigned(root) then + begin + writeintentry(root); + disposeprocdeftree(root); + end; + end; + +{$ifdef WITHDMT} + +{************************************** + DMT +**************************************} + + procedure TVMTWriter.insertdmtentry(p:TObject;arg:pointer); + + var + hp : tprocdef; + pt : pprocdeftree; + + begin + if tsym(p).typ=procsym then + begin + hp:=tprocsym(p).definition; + while assigned(hp) do + begin + if (po_msgint in hp.procoptions) then + begin + new(pt); + pt^.p:=hp; + pt^.l:=nil; + pt^.r:=nil; + insertint(pt,root); + end; + hp:=hp.nextoverloaded; + end; + end; + end; + + procedure TVMTWriter.writedmtindexentry(p : pprocdeftree); + + begin + if assigned(p^.l) then + writedmtindexentry(p^.l); + al_globals.concat(Tai_const.Create_32bit(p^.data.messageinf.i)); + if assigned(p^.r) then + writedmtindexentry(p^.r); + end; + + procedure TVMTWriter.writedmtaddressentry(p : pprocdeftree); + + begin + if assigned(p^.l) then + writedmtaddressentry(p^.l); + al_globals.concat(Tai_const_symbol.Createname(p^.data.mangledname,0)); + if assigned(p^.r) then + writedmtaddressentry(p^.r); + end; + + function TVMTWriter.gendmt : tasmlabel; + + var + r : tasmlabel; + + begin + root:=nil; + count:=0; + gendmt:=nil; + { insert all message handlers into a tree, sorted by number } + _class.symtable.SymList.ForEachCall(insertdmtentry); + + if count>0 then + begin + current_asmdata.getdatalabel(r); + gendmt:=r; + al_globals.concat(cai_align.create(const_align(sizeof(pint)))); + al_globals.concat(Tai_label.Create(r)); + { entries for caching } + al_globals.concat(Tai_const.Create_ptr(0)); + al_globals.concat(Tai_const.Create_ptr(0)); + + al_globals.concat(Tai_const.Create_32bit(count)); + if assigned(root) then + begin + writedmtindexentry(root); + writedmtaddressentry(root); + disposeprocdeftree(root); + end; + end; + end; + +{$endif WITHDMT} + +{************************************** + Published Methods +**************************************} + + procedure TVMTWriter.do_count_published_methods(p:TObject;arg:pointer); + var + i : longint; + pd : tprocdef; + begin + if (tsym(p).typ<>procsym) then + exit; + for i:=0 to Tprocsym(p).ProcdefList.Count-1 do + begin + pd:=tprocdef(Tprocsym(p).ProcdefList[i]); + if (pd.procsym=tsym(p)) and + (pd.visibility=vis_published) then + inc(plongint(arg)^); + end; + end; + + + procedure TVMTWriter.do_gen_published_methods(p:TObject;arg:pointer); + var + i : longint; + l : tasmlabel; + pd : tprocdef; + begin + if (tsym(p).typ<>procsym) then + exit; + for i:=0 to Tprocsym(p).ProcdefList.Count-1 do + begin + pd:=tprocdef(Tprocsym(p).ProcdefList[i]); + if (pd.procsym=tsym(p)) and + (pd.visibility=vis_published) then + begin + current_asmdata.getdatalabel(l); + new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,l.name,const_align(sizeof(pint))); + current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l)); + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_8bit(length(tsym(p).realname))); + current_asmdata.asmlists[al_typedconsts].concat(Tai_string.Create(tsym(p).realname)); + + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(l)); + if po_abstractmethod in pd.procoptions then + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil)) + else + current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(pd.mangledname,0)); + end; + end; + end; + + + function TVMTWriter.genpublishedmethodstable : tasmlabel; + + var + l : tasmlabel; + count : longint; + + begin + count:=0; + _class.symtable.SymList.ForEachCall(@do_count_published_methods,@count); + if count>0 then + begin + current_asmdata.getdatalabel(l); + current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint)))); + current_asmdata.asmlists[al_globals].concat(Tai_label.Create(l)); + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_32bit(count)); + _class.symtable.SymList.ForEachCall(@do_gen_published_methods,nil); + genpublishedmethodstable:=l; + end + else + genpublishedmethodstable:=nil; + end; + + + function TVMTWriter.generate_field_table : tasmlabel; + var + i : longint; + sym : tsym; + fieldtable, + classtable : tasmlabel; + classindex, + fieldcount : longint; + classtablelist : TFPList; + begin + classtablelist:=TFPList.Create; + current_asmdata.getdatalabel(fieldtable); + current_asmdata.getdatalabel(classtable); + maybe_new_object_file(current_asmdata.asmlists[al_rtti]); + new_section(current_asmdata.asmlists[al_rtti],sec_rodata,classtable.name,const_align(sizeof(pint))); + + { retrieve field info fields } + fieldcount:=0; + for i:=0 to _class.symtable.SymList.Count-1 do + begin + sym:=tsym(_class.symtable.SymList[i]); + if (sym.typ=fieldvarsym) and + (sym.visibility=vis_published) then + begin + if tfieldvarsym(sym).vardef.typ<>objectdef then + internalerror(200611032); + classindex:=classtablelist.IndexOf(tfieldvarsym(sym).vardef); + if classindex=-1 then + classtablelist.Add(tfieldvarsym(sym).vardef); + inc(fieldcount); + end; + end; + + { write fields } + current_asmdata.asmlists[al_rtti].concat(Tai_label.Create(fieldtable)); + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(fieldcount)); + if (tf_requires_proper_alignment in target_info.flags) then + current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt))); + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(classtable)); + for i:=0 to _class.symtable.SymList.Count-1 do + begin + sym:=tsym(_class.symtable.SymList[i]); + if (sym.typ=fieldvarsym) and + (sym.visibility=vis_published) then + begin + if (tf_requires_proper_alignment in target_info.flags) then + current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(pint))); + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_pint(tfieldvarsym(sym).fieldoffset)); + classindex:=classtablelist.IndexOf(tfieldvarsym(sym).vardef); + if classindex=-1 then + internalerror(200611033); + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(classindex+1)); + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(length(tfieldvarsym(sym).realname))); + current_asmdata.asmlists[al_rtti].concat(Tai_string.Create(tfieldvarsym(sym).realname)); + end; + end; + + { generate the class table } + current_asmdata.asmlists[al_rtti].concat(cai_align.create(const_align(sizeof(pint)))); + current_asmdata.asmlists[al_rtti].concat(Tai_label.Create(classtable)); + current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(classtablelist.count)); + if (tf_requires_proper_alignment in target_info.flags) then + current_asmdata.asmlists[al_rtti].concat(cai_align.Create(sizeof(TConstPtrUInt))); + for i:=0 to classtablelist.Count-1 do + current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(tobjectdef(classtablelist[i]).vmt_mangledname,0)); + + classtablelist.free; + result:=fieldtable; + end; + + +{************************************** + Interface tables +**************************************} + + function TVMTWriter.intf_get_vtbl_name(AImplIntf:TImplementedInterface): string; + begin + result:=make_mangledname('VTBL',_class.owner,_class.objname^+'_$_'+AImplIntf.IntfDef.objname^); + end; + + + procedure TVMTWriter.intf_create_vtbl(rawdata: TAsmList;AImplIntf:TImplementedInterface); + var + pd : tprocdef; + vtblstr, + hs : string; + i : longint; + begin + vtblstr:=intf_get_vtbl_name(AImplIntf); + section_symbol_start(rawdata,vtblstr,AT_DATA,true,sec_data,const_align(sizeof(pint))); + if assigned(AImplIntf.procdefs) then + begin + for i:=0 to AImplIntf.procdefs.count-1 do + begin + pd:=tprocdef(AImplIntf.procdefs[i]); + hs:=make_mangledname('WRPR',_class.owner,_class.objname^+'_$_'+AImplIntf.IntfDef.objname^+'_$_'+ + tostr(i)+'_$_'+pd.mangledname); + { create reference } + rawdata.concat(Tai_const.Createname(hs,0)); + end; + end; + section_symbol_end(rawdata,vtblstr); + end; + + + procedure TVMTWriter.intf_gen_intf_ref(rawdata: TAsmList;AImplIntf:TImplementedInterface); + var + iidlabel, + guidlabel : tasmlabel; + i: longint; + pd: tprocdef; + begin + { GUID } + if AImplIntf.IntfDef.objecttype in [odt_interfacecom] then + begin + { label for GUID } + current_asmdata.getdatalabel(guidlabel); + rawdata.concat(cai_align.create(const_align(sizeof(pint)))); + rawdata.concat(Tai_label.Create(guidlabel)); + with AImplIntf.IntfDef.iidguid^ do + begin + rawdata.concat(Tai_const.Create_32bit(longint(D1))); + rawdata.concat(Tai_const.Create_16bit(D2)); + rawdata.concat(Tai_const.Create_16bit(D3)); + for i:=Low(D4) to High(D4) do + rawdata.concat(Tai_const.Create_8bit(D4[i])); + end; + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(guidlabel)); + end + else + begin + { nil for Corba interfaces } + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil)); + end; + { VTable } + current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(intf_get_vtbl_name(AImplIntf.VtblImplIntf),0)); + { IOffset field } + case AImplIntf.VtblImplIntf.IType of + etFieldValue, etFieldValueClass, + etStandard: + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_pint(AImplIntf.VtblImplIntf.IOffset)); + etStaticMethodResult, etStaticMethodClass: + current_asmdata.asmlists[al_globals].concat(Tai_const.Createname( + tprocdef(tpropertysym(AImplIntf.ImplementsGetter).propaccesslist[palt_read].procdef).mangledname, + 0 + )); + etVirtualMethodResult, etVirtualMethodClass: + begin + pd := tprocdef(tpropertysym(AImplIntf.ImplementsGetter).propaccesslist[palt_read].procdef); + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_pint(tobjectdef(pd.struct).vmtmethodoffset(pd.extnumber))); + end; + else + internalerror(200802162); + end; + + { IIDStr } + current_asmdata.getdatalabel(iidlabel); + rawdata.concat(cai_align.create(const_align(sizeof(pint)))); + rawdata.concat(Tai_label.Create(iidlabel)); + rawdata.concat(Tai_const.Create_8bit(length(AImplIntf.IntfDef.iidstr^))); + if AImplIntf.IntfDef.objecttype=odt_interfacecom then + rawdata.concat(Tai_string.Create(upper(AImplIntf.IntfDef.iidstr^))) + else + rawdata.concat(Tai_string.Create(AImplIntf.IntfDef.iidstr^)); + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(iidlabel)); + { IType } + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_pint(aint(AImplIntf.VtblImplIntf.IType))); + end; + + + function TVMTWriter.intf_write_table:TAsmLabel; + var + rawdata : TAsmList; + i : longint; + ImplIntf : TImplementedInterface; + intftablelab : tasmlabel; + begin + current_asmdata.getdatalabel(intftablelab); + current_asmdata.asmlists[al_globals].concat(cai_align.create(const_align(sizeof(pint)))); + current_asmdata.asmlists[al_globals].concat(Tai_label.Create(intftablelab)); + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_pint(_class.ImplementedInterfaces.count)); + rawdata:=TAsmList.Create; + { Write vtbls } + for i:=0 to _class.ImplementedInterfaces.count-1 do + begin + ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]); + if ImplIntf.VtblImplIntf=ImplIntf then + intf_create_vtbl(rawdata,ImplIntf); + end; + { Write vtbl references } + for i:=0 to _class.ImplementedInterfaces.count-1 do + begin + ImplIntf:=TImplementedInterface(_class.ImplementedInterfaces[i]); + intf_gen_intf_ref(rawdata,ImplIntf); + end; + { Write interface table } + current_asmdata.asmlists[al_globals].concatlist(rawdata); + rawdata.free; + result:=intftablelab; + end; + + + { Write interface identifiers to the data section } + procedure TVMTWriter.writeinterfaceids; + var + i : longint; + s : string; + begin + if assigned(_class.iidguid) then + begin + s:=make_mangledname('IID',_class.owner,_class.objname^); + maybe_new_object_file(current_asmdata.asmlists[al_globals]); + new_section(current_asmdata.asmlists[al_globals],sec_rodata,s,const_align(sizeof(pint))); + current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0)); + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_32bit(longint(_class.iidguid^.D1))); + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_16bit(_class.iidguid^.D2)); + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_16bit(_class.iidguid^.D3)); + for i:=Low(_class.iidguid^.D4) to High(_class.iidguid^.D4) do + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_8bit(_class.iidguid^.D4[i])); + end; + maybe_new_object_file(current_asmdata.asmlists[al_globals]); + s:=make_mangledname('IIDSTR',_class.owner,_class.objname^); + new_section(current_asmdata.asmlists[al_globals],sec_rodata,s,0); + current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0)); + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_8bit(length(_class.iidstr^))); + current_asmdata.asmlists[al_globals].concat(Tai_string.Create(_class.iidstr^)); + end; + + + procedure TVMTWriter.writevirtualmethods(List:TAsmList); + var + vmtpd : tprocdef; + vmtentry : pvmtentry; + i : longint; + procname : string; +{$ifdef vtentry} + hs : string; +{$endif vtentry} + begin + if not assigned(_class.VMTEntries) then + exit; + for i:=0 to _class.VMTEntries.Count-1 do + begin + vmtentry:=pvmtentry(_class.vmtentries[i]); + vmtpd:=vmtentry^.procdef; + { safety checks } + if not(po_virtualmethod in vmtpd.procoptions) then + internalerror(200611082); + if vmtpd.extnumber<>i then + internalerror(200611083); + if (po_abstractmethod in vmtpd.procoptions) then + procname:='FPC_ABSTRACTERROR' + else if not wpoinfomanager.optimized_name_for_vmt(_class,vmtpd,procname) then + procname:=vmtpd.mangledname; + List.concat(Tai_const.createname(procname,0)); +{$ifdef vtentry} + hs:='VTENTRY'+'_'+_class.vmt_mangledname+'$$'+tostr(_class.vmtmethodoffset(i) div sizeof(pint)); + current_asmdata.asmlists[al_globals].concat(tai_symbol.CreateName(hs,AT_DATA,0)); +{$endif vtentry} + end; + end; + + + procedure TVMTWriter.writevmt; + var + methodnametable,intmessagetable, + strmessagetable,classnamelabel, + fieldtablelabel : tasmlabel; + hs: string; +{$ifdef WITHDMT} + dmtlabel : tasmlabel; +{$endif WITHDMT} + interfacetable : tasmlabel; + begin +{$ifdef WITHDMT} + dmtlabel:=gendmt; +{$endif WITHDMT} + + { write tables for classes, this must be done before the actual + class is written, because we need the labels defined } + if is_class(_class) then + begin + current_asmdata.getdatalabel(classnamelabel); + maybe_new_object_file(current_asmdata.asmlists[al_globals]); + new_section(current_asmdata.asmlists[al_globals],sec_rodata,classnamelabel.name,const_align(sizeof(pint))); + + { interface table } + if _class.ImplementedInterfaces.count>0 then + interfacetable:=intf_write_table; + + methodnametable:=genpublishedmethodstable; + fieldtablelabel:=generate_field_table; + { write class name } + current_asmdata.asmlists[al_globals].concat(Tai_label.Create(classnamelabel)); + hs:=_class.RttiName; + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_8bit(length(hs))); + current_asmdata.asmlists[al_globals].concat(Tai_string.Create(hs)); + + { generate message and dynamic tables } + if (oo_has_msgstr in _class.objectoptions) then + strmessagetable:=genstrmsgtab; + if (oo_has_msgint in _class.objectoptions) then + intmessagetable:=genintmsgtab; + end; + + { write debug info } + maybe_new_object_file(current_asmdata.asmlists[al_globals]); + new_section(current_asmdata.asmlists[al_globals],sec_rodata,_class.vmt_mangledname,const_align(sizeof(pint))); + current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(_class.vmt_mangledname,AT_DATA,0)); + + { determine the size with symtable.datasize, because } + { size gives back 4 for classes } + current_asmdata.asmlists[al_globals].concat(Tai_const.Create(aitconst_ptr,tObjectSymtable(_class.symtable).datasize)); + current_asmdata.asmlists[al_globals].concat(Tai_const.Create(aitconst_ptr,-int64(tObjectSymtable(_class.symtable).datasize))); +{$ifdef WITHDMT} + if _class.classtype=ct_object then + begin + if assigned(dmtlabel) then + current_asmdata.asmlists[al_globals].concat(Tai_const_symbol.Create(dmtlabel))) + else + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_ptr(0)); + end; +{$endif WITHDMT} + { write pointer to parent VMT, this isn't implemented in TP } + { but this is not used in FPC ? (PM) } + { it's not used yet, but the delphi-operators as and is need it (FK) } + { it is not written for parents that don't have any vmt !! } + if assigned(_class.childof) and + (oo_has_vmt in _class.childof.objectoptions) then + current_asmdata.asmlists[al_globals].concat(Tai_const.Createname(_class.childof.vmt_mangledname,0)) + else + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil)); + + { write extended info for classes, for the order see rtl/inc/objpash.inc } + if is_class(_class) then + begin + { pointer to class name string } + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(classnamelabel)); + { pointer to dynamic table or nil } + if (oo_has_msgint in _class.objectoptions) then + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(intmessagetable)) + else + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil)); + { pointer to method table or nil } + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(methodnametable)); + { pointer to field table } + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(fieldtablelabel)); + { pointer to type info of published section } + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(RTTIWriter.get_rtti_label(_class,fullrtti))); + { inittable for con-/destruction } + if _class.members_need_inittable then + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(RTTIWriter.get_rtti_label(_class,initrtti))) + else + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil)); + { auto table } + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil)); + { interface table } + if _class.ImplementedInterfaces.count>0 then + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(interfacetable)) + else if _class.implements_any_interfaces then + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil)) + else + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(current_asmdata.RefAsmSymbol('FPC_EMPTYINTF'))); + { table for string messages } + if (oo_has_msgstr in _class.objectoptions) then + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(strmessagetable)) + else + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil)); + end; + { write virtual methods } + writevirtualmethods(current_asmdata.asmlists[al_globals]); + current_asmdata.asmlists[al_globals].concat(Tai_const.create(aitconst_ptr,0)); + { write the size of the VMT } + current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname(_class.vmt_mangledname)); +{$ifdef vtentry} + { write vtinherit symbol to notify the linker of the class inheritance tree } + hs:='VTINHERIT'+'_'+_class.vmt_mangledname+'$$'; + if assigned(_class.childof) then + hs:=hs+_class.childof.vmt_mangledname + else + hs:=hs+_class.vmt_mangledname; + current_asmdata.asmlists[al_globals].concat(tai_symbol.CreateName(hs,AT_DATA,0)); +{$endif vtentry} + end; + + +end. diff --git a/closures/compiler/nobjc.pas b/closures/compiler/nobjc.pas new file mode 100644 index 0000000000..a10f13a83c --- /dev/null +++ b/closures/compiler/nobjc.pas @@ -0,0 +1,169 @@ +{ + Copyright (c) 2009 by Jonas Maebe + + This unit implements Objective-C 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. + + **************************************************************************** +} +{ @abstract(This unit implements Objective-C nodes) + This unit contains various nodes to implement Objective-Pascal and to + interface with the Objective-C runtime. +} + +unit nobjc; + +{$i fpcdefs.inc} + +interface + +uses + node; + +type + tobjcselectornode = class(tunarynode) + public + constructor create(formethod: tnode); + function pass_typecheck: tnode;override; + function pass_1: tnode;override; + end; + tobjcselectornodeclass = class of tobjcselectornode; + + tobjcprotocolnode = class(tunarynode) + public + constructor create(forprotocol: tnode); + function pass_typecheck: tnode;override; + function pass_1: tnode;override; + end; + tobjcprotocolnodeclass = class of tobjcprotocolnode; + +var + cobjcselectornode : tobjcselectornodeclass; + cobjcprotocolnode : tobjcprotocolnodeclass; + +implementation + +uses + sysutils, + globtype,globals,cclasses,systems, + verbose,pass_1, + defutil, + symtype,symtable,symdef,symconst,symsym, + paramgr, + nutils, + nbas,nld,ncnv,ncon,ncal,nmem, + objcutil, + cgbase; + + +{***************************************************************************** + TOBJCSELECTORNODE +*****************************************************************************} + +constructor tobjcselectornode.create(formethod: tnode); + begin + inherited create(objcselectorn,formethod); + end; + + +function tobjcselectornode.pass_typecheck: tnode; + var + len: longint; + s: shortstring; + begin + if not(m_objectivec1 in current_settings.modeswitches) then + Message(parser_f_modeswitch_objc_required); + result:=nil; + typecheckpass(left); + { argument can be + a) an objc method + b) a pchar, zero-based chararray or ansistring + } + case left.nodetype of + loadn: + begin + if (left.resultdef.typ=procdef) and + (po_objc in tprocdef(left.resultdef).procoptions) then + begin + { ok } + end + else + CGMessage1(type_e_expected_objc_method_but_got,left.resultdef.typename); + end; + stringconstn: + begin + if not objcvalidselectorname(tstringconstnode(left).value_str, + tstringconstnode(left).len) then + begin + len:=tstringconstnode(left).len; + if (len>255) then + len:=255; + setlength(s,len); + move(tstringconstnode(left).value_str^,s[1],len); + CGMessage1(type_e_invalid_objc_selector_name,s); + exit; + end; + end + else + CGMessage(type_e_expected_objc_method); + end; + resultdef:=objc_seltype; + end; + + +function tobjcselectornode.pass_1: tnode; + begin + result:=nil; + expectloc:=LOC_CREFERENCE; + end; + + +{***************************************************************************** + TOBJPROTOCOLNODE +*****************************************************************************} + +constructor tobjcprotocolnode.create(forprotocol: tnode); + begin + inherited create(objcprotocoln,forprotocol); + end; + + +function tobjcprotocolnode.pass_typecheck: tnode; + begin + if not(m_objectivec1 in current_settings.modeswitches) then + Message(parser_f_modeswitch_objc_required); + result:=nil; + typecheckpass(left); + if (left.nodetype<>typen) then + MessagePos(left.fileinfo,type_e_type_id_expected) + else if not is_objcprotocol(left.resultdef) then + MessagePos2(left.fileinfo,type_e_incompatible_types,left.resultdef.typename,'ObjCProtocol'); + resultdef:=objc_protocoltype; + end; + + +function tobjcprotocolnode.pass_1: tnode; + begin + result:=ccallnode.createinternresfromunit('OBJC','OBJC_GETPROTOCOL', + ccallparanode.create(cstringconstnode.createstr(tobjectdef(left.resultdef).objextname^),nil), + resultdef + ); + typecheckpass(result); + end; + + +end. + diff --git a/closures/compiler/node.pas b/closures/compiler/node.pas new file mode 100644 index 0000000000..5b92ee5427 --- /dev/null +++ b/closures/compiler/node.pas @@ -0,0 +1,1301 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + Basic node 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 node; + +{$i fpcdefs.inc} + +interface + + uses + cclasses, + globtype,globals, + cpubase,cgbase,cgutils, + aasmbase, + symtype, + optbase; + + type + tnodetype = ( + emptynode, {No node (returns nil when loading from ppu)} + addn, {Represents the + operator} + muln, {Represents the * operator} + subn, {Represents the - operator} + divn, {Represents the div operator} + symdifn, {Represents the >< operator} + modn, {Represents the mod operator} + assignn, {Represents an assignment} + loadn, {Represents the use of a variabele} + rangen, {Represents a range (i.e. 0..9)} + ltn, {Represents the < operator} + lten, {Represents the <= operator} + gtn, {Represents the > operator} + gten, {Represents the >= operator} + equaln, {Represents the = operator} + unequaln, {Represents the <> operator} + inn, {Represents the in operator} + orn, {Represents the or operator} + xorn, {Represents the xor operator} + shrn, {Represents the shr operator} + shln, {Represents the shl operator} + slashn, {Represents the / operator} + andn, {Represents the and operator} + subscriptn, {Field in a record/object} + derefn, {Dereferences a pointer} + addrn, {Represents the @ operator} + ordconstn, {Represents an ordinal value} + typeconvn, {Represents type-conversion/typecast} + calln, {Represents a call node} + callparan, {Represents a parameter} + realconstn, {Represents a real value} + unaryminusn, {Represents a sign change (i.e. -2)} + unaryplusn, {Represents a check for +Value} + asmn, {Represents an assembler node } + vecn, {Represents array indexing} + pointerconstn, {Represents a pointer constant} + stringconstn, {Represents a string constant} + notn, {Represents the not operator} + inlinen, {Internal procedures (i.e. writeln)} + niln, {Represents the nil pointer} + errorn, {This part of the tree could not be + parsed because of a compiler error} + typen, {A type name. Used for i.e. typeof(obj)} + setelementn, {A set element(s) (i.e. [a,b] and also [a..b])} + setconstn, {A set constant (i.e. [1,2])} + blockn, {A block of statements} + statementn, {One statement in a block of nodes} + ifn, {An if statement} + breakn, {A break statement} + continuen, {A continue statement} + whilerepeatn, {A while or repeat statement} + forn, {A for loop} + exitn, {An exit statement} + withn, {A with statement} + casen, {A case statement} + labeln, {A label} + goton, {A goto statement} + tryexceptn, {A try except block} + raisen, {A raise statement} + tryfinallyn, {A try finally statement} + onn, {For an on statement in exception code} + isn, {Represents the is operator} + asn, {Represents the as typecast} + starstarn, {Represents the ** operator exponentiation } + arrayconstructorn, {Construction node for [...] parsing} + arrayconstructorrangen, {Range element to allow sets in array construction tree} + tempcreaten, { for temps in the result/firstpass } + temprefn, { references to temps } + tempdeleten, { for temps in the result/firstpass } + addoptn, { added for optimizations where we cannot suppress } + nothingn, { NOP, Do nothing} + loadvmtaddrn, { Load the address of the VMT of a class/object} + guidconstn, { A GUID COM Interface constant } + rttin, { Rtti information so they can be accessed in result/firstpass} + loadparentfpn, { Load the framepointer of the parent for nested procedures } + dataconstn, { node storing some binary data } + objcselectorn, { node for an Objective-C message selector } + objcprotocoln { node for an Objective-C @protocol() expression (returns metaclass associated with protocol) } + ); + + tnodetypeset = set of tnodetype; + pnodetypeset = ^tnodetypeset; + + const + nodetype2str : array[tnodetype] of string[24] = ( + '<emptynode>', + 'addn', + 'muln', + 'subn', + 'divn', + 'symdifn', + 'modn', + 'assignn', + 'loadn', + 'rangen', + 'ltn', + 'lten', + 'gtn', + 'gten', + 'equaln', + 'unequaln', + 'inn', + 'orn', + 'xorn', + 'shrn', + 'shln', + 'slashn', + 'andn', + 'subscriptn', + 'derefn', + 'addrn', + 'ordconstn', + 'typeconvn', + 'calln', + 'callparan', + 'realconstn', + 'unaryminusn', + 'unaryplusn', + 'asmn', + 'vecn', + 'pointerconstn', + 'stringconstn', + 'notn', + 'inlinen', + 'niln', + 'errorn', + 'typen', + 'setelementn', + 'setconstn', + 'blockn', + 'statementn', + 'ifn', + 'breakn', + 'continuen', + 'whilerepeatn', + 'forn', + 'exitn', + 'withn', + 'casen', + 'labeln', + 'goton', + 'tryexceptn', + 'raisen', + 'tryfinallyn', + 'onn', + 'isn', + 'asn', + 'starstarn', + 'arrayconstructn', + 'arrayconstructrangen', + 'tempcreaten', + 'temprefn', + 'tempdeleten', + 'addoptn', + 'nothingn', + 'loadvmtaddrn', + 'guidconstn', + 'rttin', + 'loadparentfpn', + 'dataconstn', + 'objcselectorn', + 'objcprotocoln'); + + type + { all boolean field of ttree are now collected in flags } + tnodeflag = ( + nf_swapable, { tbinop operands can be swaped } + nf_swapped, { tbinop operands are swaped } + nf_error, + + { general } + nf_pass1_done, + nf_write, { Node is written to } + nf_modify, { Node is modified } + nf_is_funcret, + nf_isproperty, + nf_processing, + + { taddrnode } + nf_typedaddr, + + { tderefnode } + nf_no_checkpointer, + + { tvecnode } + nf_memindex, + nf_memseg, + nf_callunique, + + { tloadnode/ttypeconvnode } + nf_absolute, + + { taddnode } + nf_is_currency, + nf_has_pointerdiv, + nf_short_bool, + + { tmoddivnode } + nf_isomod, + + { tassignmentnode } + nf_assign_done_in_right, + + { tarrayconstructnode } + nf_forcevaria, + nf_novariaallowed, + + { ttypeconvnode, and the first one also treal/ord/pointerconstn } + { second one also for subtractions of u32-u32 implicitly upcasted to s64 } + nf_explicit, + nf_internal, { no warnings/hints generated } + nf_load_procvar, + + { tinlinenode } + nf_inlineconst, + + { tasmnode } + nf_get_asm_position, + + { tblocknode } + nf_block_with_exit, + + { tloadvmtaddrnode } + nf_ignore_for_wpo { we know that this loadvmtaddrnode cannot be used to construct a class instance } + + { WARNING: there are now 32 elements in this type, and a set of this + type is written to the PPU. So before adding any more elements, + either move some flags to specific nodes, or stream a normalset + to the ppu + } + + ); + + tnodeflags = set of tnodeflag; + + const + { contains the flags which must be equal for the equality } + { of nodes } + flagsequal : tnodeflags = [nf_error]; + + type + tnodelist = class + end; + + pnode = ^tnode; + { basic class for the intermediated representation fpc uses } + tnode = class + private + fppuidx : longint; + function getppuidx:longint; + public + { type of this node } + nodetype : tnodetype; + { type of the current code block, general/const/type } + blocktype : tblock_type; + { expected location of the result of this node (pass1) } + expectloc : tcgloc; + { the location of the result of this node (pass2) } + location : tlocation; + { the parent node of this is node } + { this field is set by concattolist } + parent : tnode; + { next node in control flow on the same block level, i.e. + for loop nodes, this is the next node after the end of the loop, + same for if and case, if this field is nil, the next node is the procedure exit, + for the last node in a loop this is set to the loop header + this field is set only for control flow nodes } + successor : tnode; + { there are some properties about the node stored } + flags : tnodeflags; + resultdef : tdef; + resultdefderef : tderef; + fileinfo : tfileposinfo; + localswitches : tlocalswitches; + verbosity : longint; + optinfo : poptinfo; + constructor create(t:tnodetype); + { this constructor is only for creating copies of class } + { the fields are copied by getcopy } + constructor createforcopy; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);virtual; + destructor destroy;override; + procedure ppuwrite(ppufile:tcompilerppufile);virtual; + procedure buildderefimpl;virtual; + procedure derefimpl;virtual; + procedure resolveppuidx;virtual; + + { toggles the flag } + procedure toggleflag(f : tnodeflag); + + { the 1.1 code generator may override pass_1 } + { and it need not to implement det_* then } + { 1.1: pass_1 returns a value<>0 if the node has been transformed } + { 2.0: runs pass_typecheck and det_temp } + function pass_1 : tnode;virtual;abstract; + { dermines the resultdef of the node } + function pass_typecheck : tnode;virtual;abstract; + + { tries to simplify the node, returns a value <>nil if a simplified + node has been created } + function simplify(forinline : boolean) : tnode;virtual; +{$ifdef state_tracking} + { Does optimizations by keeping track of the variable states + in a procedure } + function track_state_pass(exec_known:boolean):boolean;virtual; +{$endif} + { For a t1:=t2 tree, mark the part of the tree t1 that gets + written to (normally the loadnode) as write access. } + procedure mark_write;virtual; + { dermines the number of necessary temp. locations to evaluate + the node } + procedure det_temp;virtual;abstract; + + procedure pass_generate_code;virtual;abstract; + + { comparing of nodes } + function isequal(p : tnode) : boolean; + { to implement comparisation, override this method } + function docompare(p : tnode) : boolean;virtual; + { wrapper for getcopy } + function getcopy : tnode; + + { does the real copying of a node } + function dogetcopy : tnode;virtual; + + { returns the real loadn/temprefn a node refers to, + skipping (absolute) equal type conversions } + function actualtargetnode: tnode;virtual; + + procedure insertintolist(l : tnodelist);virtual; + { writes a node for debugging purpose, shouldn't be called } + { direct, because there is no test for nil, use printnode } + { to write a complete tree } + procedure printnodeinfo(var t:text);virtual; + procedure printnodedata(var t:text);virtual; + procedure printnodetree(var t:text);virtual; + procedure concattolist(l : tlinkedlist);virtual; + function ischild(p : tnode) : boolean;virtual; + + { ensures that the optimizer info record is allocated } + function allocoptinfo : poptinfo;inline; + property ppuidx:longint read getppuidx; + end; + + tnodeclass = class of tnode; + + tnodeclassarray = array[tnodetype] of tnodeclass; + + { this node is the anchestor for all nodes with at least } + { one child, you have to use it if you want to use } + { true- and current_procinfo.CurrFalseLabel } + //punarynode = ^tunarynode; + tunarynode = class(tnode) + left : tnode; + constructor create(t:tnodetype;l : tnode); + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + destructor destroy;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + procedure concattolist(l : tlinkedlist);override; + function ischild(p : tnode) : boolean;override; + function docompare(p : tnode) : boolean;override; + function dogetcopy : tnode;override; + procedure insertintolist(l : tnodelist);override; + procedure printnodedata(var t:text);override; + end; + + //pbinarynode = ^tbinarynode; + tbinarynode = class(tunarynode) + right : tnode; + constructor create(t:tnodetype;l,r : tnode); + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + destructor destroy;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + procedure concattolist(l : tlinkedlist);override; + function ischild(p : tnode) : boolean;override; + function docompare(p : tnode) : boolean;override; + procedure swapleftright; + function dogetcopy : tnode;override; + procedure insertintolist(l : tnodelist);override; + procedure printnodedata(var t:text);override; + procedure printnodelist(var t:text); + end; + + //ptertiarynode = ^ttertiarynode; + ttertiarynode = class(tbinarynode) + third : tnode; + constructor create(_t:tnodetype;l,r,t : tnode); + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + destructor destroy;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + procedure concattolist(l : tlinkedlist);override; + function ischild(p : tnode) : boolean;override; + function docompare(p : tnode) : boolean;override; + function dogetcopy : tnode;override; + procedure insertintolist(l : tnodelist);override; + procedure printnodedata(var t:text);override; + end; + + tbinopnode = class(tbinarynode) + constructor create(t:tnodetype;l,r : tnode);virtual; + function docompare(p : tnode) : boolean;override; + end; + + var + { array with all class types for tnodes } + nodeclass : tnodeclassarray; + + function nodeppuidxget(i:longint):tnode; + function ppuloadnode(ppufile:tcompilerppufile):tnode; + procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode); + function ppuloadnodetree(ppufile:tcompilerppufile):tnode; + procedure ppuwritenodetree(ppufile:tcompilerppufile;n:tnode); + + const + printnodespacing = ' '; + var + { indention used when writing the tree to the screen } + printnodeindention : string; + + procedure printnodeindent; + procedure printnodeunindent; + procedure printnode(var t:text;n:tnode); + procedure printnode(n:tnode); + + function is_constnode(p : tnode) : boolean; + function is_constintnode(p : tnode) : boolean; + function is_constcharnode(p : tnode) : boolean; + function is_constrealnode(p : tnode) : boolean; + function is_constboolnode(p : tnode) : boolean; + function is_constenumnode(p : tnode) : boolean; + function is_constwidecharnode(p : tnode) : boolean; + function is_constpointernode(p : tnode) : boolean; + function is_conststringnode(p : tnode) : boolean; + function is_constwidestringnode(p : tnode) : boolean; + function is_conststring_or_constcharnode(p : tnode) : boolean; + + +implementation + + uses + cutils,verbose,ppu,comphook, + symconst, + nutils,nflw, + defutil; + + const + ppunodemarker = 255; + + +{**************************************************************************** + Helpers + ****************************************************************************} + + var + nodeppulist : TFPObjectList; + nodeppuidx : longint; + + + procedure nodeppuidxcreate; + begin + nodeppulist:=TFPObjectList.Create(false); + nodeppuidx:=0; + end; + + + procedure nodeppuidxresolve; + var + i : longint; + n : tnode; + begin + for i:=0 to nodeppulist.count-1 do + begin + n:=tnode(nodeppulist[i]); + if assigned(n) then + n.resolveppuidx; + end; + end; + + + procedure nodeppuidxfree; + begin + nodeppulist.free; + nodeppulist:=nil; + nodeppuidx:=0; + end; + + + procedure nodeppuidxadd(n:tnode); + var + i : longint; + begin + i:=n.ppuidx; + if i<=0 then + internalerror(200311072); + if i>=nodeppulist.capacity then + nodeppulist.capacity:=((i div 1024)+1)*1024; + if i>=nodeppulist.count then + nodeppulist.count:=i+1; + nodeppulist[i]:=n; + end; + + + function nodeppuidxget(i:longint):tnode; + begin + if i<=0 then + internalerror(200311073); + result:=tnode(nodeppulist[i]); + end; + + + function ppuloadnode(ppufile:tcompilerppufile):tnode; + var + b : byte; + t : tnodetype; + hppuidx : longint; + begin + { marker } + b:=ppufile.getbyte; + if b<>ppunodemarker then + internalerror(200208151); + { load nodetype } + t:=tnodetype(ppufile.getbyte); + if t>high(tnodetype) then + internalerror(200208152); + if t<>emptynode then + begin + if not assigned(nodeclass[t]) then + internalerror(200208153); + hppuidx:=ppufile.getlongint; + //writeln('load: ',nodetype2str[t]); + { generate node of the correct class } + result:=nodeclass[t].ppuload(t,ppufile); + result.fppuidx:=hppuidx; + nodeppuidxadd(result); + end + else + result:=nil; + end; + + + procedure ppuwritenode(ppufile:tcompilerppufile;n:tnode); + begin + { marker, read by ppuloadnode } + ppufile.putbyte(ppunodemarker); + { type, read by ppuloadnode } + if assigned(n) then + begin + ppufile.putbyte(byte(n.nodetype)); + ppufile.putlongint(n.ppuidx); + //writeln('write: ',nodetype2str[n.nodetype]); + n.ppuwrite(ppufile); + end + else + ppufile.putbyte(byte(emptynode)); + end; + + + function ppuloadnodetree(ppufile:tcompilerppufile):tnode; + begin + if ppufile.readentry<>ibnodetree then + Message(unit_f_ppu_read_error); + nodeppuidxcreate; + result:=ppuloadnode(ppufile); + nodeppuidxresolve; + nodeppuidxfree; + end; + + + procedure ppuwritenodetree(ppufile:tcompilerppufile;n:tnode); + begin + nodeppuidxcreate; + ppuwritenode(ppufile,n); + ppufile.writeentry(ibnodetree); + nodeppuidxfree; + end; + + + procedure printnodeindent; + begin + printnodeindention:=printnodeindention+printnodespacing; + end; + + + procedure printnodeunindent; + begin + delete(printnodeindention,1,length(printnodespacing)); + end; + + + procedure printnode(var t:text;n:tnode); + begin + if assigned(n) then + n.printnodetree(t) + else + writeln(t,printnodeindention,'nil'); + end; + + + procedure printnode(n:tnode); + begin + printnode(output,n); + end; + + + function is_constnode(p : tnode) : boolean; + begin + is_constnode:=(p.nodetype in [niln,ordconstn,realconstn,stringconstn,setconstn,guidconstn]); + end; + + + function is_constintnode(p : tnode) : boolean; + begin + is_constintnode:=(p.nodetype=ordconstn) and is_integer(p.resultdef); + end; + + + function is_constcharnode(p : tnode) : boolean; + begin + is_constcharnode:=(p.nodetype=ordconstn) and is_char(p.resultdef); + end; + + + function is_constwidecharnode(p : tnode) : boolean; + begin + is_constwidecharnode:=(p.nodetype=ordconstn) and is_widechar(p.resultdef); + end; + + + function is_constrealnode(p : tnode) : boolean; + begin + is_constrealnode:=(p.nodetype=realconstn); + end; + + + function is_constboolnode(p : tnode) : boolean; + begin + is_constboolnode:=(p.nodetype=ordconstn) and is_boolean(p.resultdef); + end; + + + function is_constenumnode(p : tnode) : boolean; + begin + is_constenumnode:=(p.nodetype=ordconstn) and (p.resultdef.typ=enumdef); + end; + + + function is_constpointernode(p : tnode) : boolean; + begin + is_constpointernode:=(p.nodetype=pointerconstn); + end; + + function is_conststringnode(p : tnode) : boolean; + begin + is_conststringnode := + (p.nodetype = stringconstn) and is_chararray(p.resultdef); + end; + + function is_constwidestringnode(p : tnode) : boolean; + begin + is_constwidestringnode := + (p.nodetype = stringconstn) and is_widechararray(p.resultdef); + end; + + function is_conststring_or_constcharnode(p : tnode) : boolean; + begin + is_conststring_or_constcharnode := + is_conststringnode(p) or is_constcharnode(p) or + is_constwidestringnode(p) or is_constwidecharnode(p); + end; + + +{**************************************************************************** + TNODE + ****************************************************************************} + + constructor tnode.create(t:tnodetype); + + begin + inherited create; + nodetype:=t; + blocktype:=block_type; + { updated by firstpass } + expectloc:=LOC_INVALID; + { updated by secondpass } + location.loc:=LOC_INVALID; + { save local info } + fileinfo:=current_filepos; + localswitches:=current_settings.localswitches; + verbosity:=status.verbosity; + resultdef:=nil; + flags:=[]; + end; + + constructor tnode.createforcopy; + + begin + end; + + constructor tnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + + begin + nodetype:=t; + { tnode fields } + blocktype:=tblock_type(ppufile.getbyte); + ppufile.getposinfo(fileinfo); + ppufile.getsmallset(localswitches); + verbosity:=ppufile.getlongint; + ppufile.getderef(resultdefderef); + ppufile.getsmallset(flags); + { updated by firstpass } + expectloc:=LOC_INVALID; + { updated by secondpass } + location.loc:=LOC_INVALID; + end; + + + procedure tnode.ppuwrite(ppufile:tcompilerppufile); + begin + ppufile.putbyte(byte(block_type)); + ppufile.putposinfo(fileinfo); + ppufile.putsmallset(localswitches); + ppufile.putlongint(verbosity); + ppufile.putderef(resultdefderef); + ppufile.putsmallset(flags); + end; + + + function tnode.getppuidx:longint; + begin + if fppuidx=0 then + begin + inc(nodeppuidx); + fppuidx:=nodeppuidx; + end; + result:=fppuidx; + end; + + + procedure tnode.resolveppuidx; + begin + end; + + + procedure tnode.buildderefimpl; + begin + resultdefderef.build(resultdef); + end; + + + procedure tnode.derefimpl; + begin + resultdef:=tdef(resultdefderef.resolve); + end; + + + procedure tnode.toggleflag(f : tnodeflag); + begin + if f in flags then + exclude(flags,f) + else + include(flags,f); + end; + + + function tnode.simplify(forinline : boolean) : tnode; + begin + result:=nil; + end; + + + destructor tnode.destroy; + begin + if assigned(optinfo) then + dispose(optinfo); + end; + + + procedure tnode.concattolist(l : tlinkedlist); + begin + end; + + + function tnode.ischild(p : tnode) : boolean; + begin + ischild:=false; + end; + + + procedure tnode.mark_write; + begin +{$ifdef EXTDEBUG} + Comment(V_Warning,'mark_write not implemented for '+nodetype2str[nodetype]); +{$endif EXTDEBUG} + end; + + + procedure tnode.printnodeinfo(var t:text); + begin + write(t,nodetype2str[nodetype]); + if assigned(resultdef) then + write(t,', resultdef = ',resultdef.typesymbolprettyname,' = "',resultdef.GetTypeName,'"') + else + write(t,', resultdef = <nil>'); + write(t,', pos = (',fileinfo.line,',',fileinfo.column,')', + ', loc = ',tcgloc2str[location.loc], + ', expectloc = ',tcgloc2str[expectloc]); + end; + + + procedure tnode.printnodedata(var t:text); + begin + end; + + + procedure tnode.printnodetree(var t:text); + begin + write(t,printnodeindention,'('); + printnodeinfo(t); + writeln(t); + printnodeindent; + printnodedata(t); + printnodeunindent; + writeln(t,printnodeindention,')'); + end; + + + function tnode.isequal(p : tnode) : boolean; + begin + isequal:= + (not assigned(self) and not assigned(p)) or + (assigned(self) and assigned(p) and + { optimized subclasses have the same nodetype as their } + { superclass (for compatibility), so also check the classtype (JM) } + (p.classtype=classtype) and + (p.nodetype=nodetype) and + (flags*flagsequal=p.flags*flagsequal) and + docompare(p)); + end; + +{$ifdef state_tracking} + function Tnode.track_state_pass(exec_known:boolean):boolean; + begin + track_state_pass:=false; + end; +{$endif state_tracking} + + + function tnode.docompare(p : tnode) : boolean; + begin + docompare:=true; + end; + + + function cleanupcopiedto(var n : tnode;arg : pointer) : foreachnoderesult; + begin + result:=fen_true; + if n.nodetype=labeln then + tlabelnode(n).copiedto:=nil; + end; + + + function tnode.getcopy : tnode; + begin + result:=dogetcopy; + foreachnodestatic(pm_postprocess,self,@cleanupcopiedto,nil); + end; + + + function tnode.dogetcopy : tnode; + var + p : tnode; + begin + { this is quite tricky because we need a node of the current } + { node type and not one of tnode! } + p:=tnodeclass(classtype).createforcopy; + p.nodetype:=nodetype; + p.expectloc:=expectloc; + p.location:=location; + p.parent:=parent; + p.flags:=flags; + p.resultdef:=resultdef; + p.fileinfo:=fileinfo; + p.localswitches:=localswitches; + p.verbosity:=verbosity; +{ p.list:=list; } + result:=p; + end; + + + function tnode.actualtargetnode: tnode; + begin + result:=self; + end; + + + procedure tnode.insertintolist(l : tnodelist); + begin + end; + + + { ensures that the optimizer info record is allocated } + function tnode.allocoptinfo : poptinfo;inline; + begin + if not(assigned(optinfo)) then + new(optinfo); + result:=optinfo; + end; + +{**************************************************************************** + TUNARYNODE + ****************************************************************************} + + constructor tunarynode.create(t:tnodetype;l : tnode); + begin + inherited create(t); + left:=l; + end; + + + constructor tunarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + left:=ppuloadnode(ppufile); + end; + + + destructor tunarynode.destroy; + begin + left.free; + inherited destroy; + end; + + + procedure tunarynode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppuwritenode(ppufile,left); + end; + + + procedure tunarynode.buildderefimpl; + begin + inherited buildderefimpl; + if assigned(left) then + left.buildderefimpl; + end; + + + procedure tunarynode.derefimpl; + begin + inherited derefimpl; + if assigned(left) then + left.derefimpl; + end; + + + function tunarynode.docompare(p : tnode) : boolean; + begin + docompare:=(inherited docompare(p) and + ((left=nil) or left.isequal(tunarynode(p).left)) + ); + end; + + + function tunarynode.dogetcopy : tnode; + var + p : tunarynode; + begin + p:=tunarynode(inherited dogetcopy); + if assigned(left) then + p.left:=left.dogetcopy + else + p.left:=nil; + result:=p; + end; + + + procedure tunarynode.insertintolist(l : tnodelist); + begin + end; + + + procedure tunarynode.printnodedata(var t:text); + begin + inherited printnodedata(t); + printnode(t,left); + end; + + + procedure tunarynode.concattolist(l : tlinkedlist); + begin + left.parent:=self; + left.concattolist(l); + inherited concattolist(l); + end; + + + function tunarynode.ischild(p : tnode) : boolean; + begin + ischild:=p=left; + end; + + +{**************************************************************************** + TBINARYNODE + ****************************************************************************} + + constructor tbinarynode.create(t:tnodetype;l,r : tnode); + begin + inherited create(t,l); + right:=r + end; + + + constructor tbinarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + right:=ppuloadnode(ppufile); + end; + + + destructor tbinarynode.destroy; + begin + right.free; + inherited destroy; + end; + + + procedure tbinarynode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppuwritenode(ppufile,right); + end; + + + procedure tbinarynode.buildderefimpl; + begin + inherited buildderefimpl; + if assigned(right) then + right.buildderefimpl; + end; + + + procedure tbinarynode.derefimpl; + begin + inherited derefimpl; + if assigned(right) then + right.derefimpl; + end; + + + procedure tbinarynode.concattolist(l : tlinkedlist); + begin + { we could change that depending on the number of } + { required registers } + left.parent:=self; + left.concattolist(l); + left.parent:=self; + left.concattolist(l); + inherited concattolist(l); + end; + + + function tbinarynode.ischild(p : tnode) : boolean; + begin + ischild:=(p=right); + end; + + + function tbinarynode.docompare(p : tnode) : boolean; + begin + docompare:=(inherited docompare(p) and + ((right=nil) or right.isequal(tbinarynode(p).right)) + ); + end; + + + function tbinarynode.dogetcopy : tnode; + var + p : tbinarynode; + begin + p:=tbinarynode(inherited dogetcopy); + if assigned(right) then + p.right:=right.dogetcopy + else + p.right:=nil; + result:=p; + end; + + + procedure tbinarynode.insertintolist(l : tnodelist); + begin + end; + + + procedure tbinarynode.swapleftright; + var + swapp : tnode; + begin + swapp:=right; + right:=left; + left:=swapp; + if nf_swapped in flags then + exclude(flags,nf_swapped) + else + include(flags,nf_swapped); + end; + + + procedure tbinarynode.printnodedata(var t:text); + begin + inherited printnodedata(t); + printnode(t,right); + end; + + + procedure tbinarynode.printnodelist(var t:text); + var + hp : tbinarynode; + begin + hp:=self; + while assigned(hp) do + begin + write(t,printnodeindention,'('); + printnodeindent; + hp.printnodeinfo(t); + writeln(t); + printnode(t,hp.left); + writeln(t); + printnodeunindent; + writeln(t,printnodeindention,')'); + hp:=tbinarynode(hp.right); + end; + end; + + +{**************************************************************************** + TTERTIARYNODE + ****************************************************************************} + + constructor ttertiarynode.create(_t:tnodetype;l,r,t : tnode); + begin + inherited create(_t,l,r); + third:=t; + end; + + + constructor ttertiarynode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + third:=ppuloadnode(ppufile); + end; + + + destructor ttertiarynode.destroy; + begin + third.free; + inherited destroy; + end; + + + procedure ttertiarynode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppuwritenode(ppufile,third); + end; + + + procedure ttertiarynode.buildderefimpl; + begin + inherited buildderefimpl; + if assigned(third) then + third.buildderefimpl; + end; + + + procedure ttertiarynode.derefimpl; + begin + inherited derefimpl; + if assigned(third) then + third.derefimpl; + end; + + + function ttertiarynode.docompare(p : tnode) : boolean; + begin + docompare:=(inherited docompare(p) and + ((third=nil) or third.isequal(ttertiarynode(p).third)) + ); + end; + + + function ttertiarynode.dogetcopy : tnode; + var + p : ttertiarynode; + begin + p:=ttertiarynode(inherited dogetcopy); + if assigned(third) then + p.third:=third.dogetcopy + else + p.third:=nil; + result:=p; + end; + + + procedure ttertiarynode.insertintolist(l : tnodelist); + begin + end; + + + procedure ttertiarynode.printnodedata(var t:text); + begin + inherited printnodedata(t); + printnode(t,third); + end; + + + procedure ttertiarynode.concattolist(l : tlinkedlist); + begin + third.parent:=self; + third.concattolist(l); + inherited concattolist(l); + end; + + + function ttertiarynode.ischild(p : tnode) : boolean; + begin + ischild:=p=third; + end; + + +{**************************************************************************** + TBINOPNODE + ****************************************************************************} + + constructor tbinopnode.create(t:tnodetype;l,r : tnode); + begin + inherited create(t,l,r); + end; + + + function tbinopnode.docompare(p : tnode) : boolean; + begin + docompare:=(inherited docompare(p)) or + { if that's in the flags, is p then always a tbinopnode (?) (JM) } + ((nf_swapable in flags) and + left.isequal(tbinopnode(p).right) and + right.isequal(tbinopnode(p).left)); + end; + +begin +{$push}{$warnings off} + { taitype should fit into a 4 byte set for speed reasons } + if ord(high(tnodeflags))>31 then + internalerror(201110301); +{$pop} +end. + diff --git a/closures/compiler/nopt.pas b/closures/compiler/nopt.pas new file mode 100644 index 0000000000..cd1eeb0878 --- /dev/null +++ b/closures/compiler/nopt.pas @@ -0,0 +1,394 @@ +{ + Copyright (c) 1998-2002 by Jonas Maebe + + This unit implements optimized 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 nopt; + +{$i fpcdefs.inc} + +interface + +uses node,nbas,nadd,constexp; + +type + tsubnodetype = ( + addsstringcharoptn, { shorstring + char } + addsstringcsstringoptn { shortstring + constant shortstring } + ); + + taddoptnode = class(taddnode) + subnodetype: tsubnodetype; + constructor create(ts: tsubnodetype; l,r : tnode); virtual; reintroduce; + { pass_1 will be overridden by the separate subclasses } + { By default, pass_generate_code is the same as for addnode } + { Only if there's a processor specific implementation, it } + { will be overridden. } + function dogetcopy: tnode; override; + function docompare(p: tnode): boolean; override; + end; + + taddsstringoptnode = class(taddoptnode) + { maximum length of the string until now, allows us to skip a compare } + { sometimes (it's initialized/updated by calling updatecurmaxlen) } + curmaxlen: byte; + { pass_1 must be overridden, otherwise we get an endless loop } + function pass_typecheck: tnode; override; + function pass_1: tnode; override; + function dogetcopy: tnode; override; + function docompare(p: tnode): boolean; override; + protected + procedure updatecurmaxlen; + end; + + { add a char to a shortstring } + taddsstringcharoptnode = class(taddsstringoptnode) + constructor create(l,r : tnode); virtual; reintroduce; + end; + taddsstringcharoptnodeclass = class of taddsstringcharoptnode; + + { add a constant string to a short string } + taddsstringcsstringoptnode = class(taddsstringoptnode) + constructor create(l,r : tnode); virtual; reintroduce; + function pass_1: tnode; override; + end; + taddsstringcsstringoptnodeclass = class of taddsstringcsstringoptnode; + +function canbeaddsstringcharoptnode(p: taddnode): boolean; +function genaddsstringcharoptnode(p: taddnode): tnode; +function canbeaddsstringcsstringoptnode(p: taddnode): boolean; +function genaddsstringcsstringoptnode(p: taddnode): tnode; +function canbemultistringadd(p: taddnode): boolean; +function genmultistringadd(p: taddnode): tnode; + + +function is_addsstringoptnode(p: tnode): boolean; + +var + caddsstringcharoptnode: taddsstringcharoptnodeclass; + caddsstringcsstringoptnode: taddsstringcsstringoptnodeclass; + +implementation + +uses cutils, htypechk, defutil, defcmp, globtype, globals, cpubase, ncnv, ncon,ncal,nld,nmem, + verbose, symconst,symdef, cgbase, procinfo; + + +{***************************************************************************** + TADDOPTNODE +*****************************************************************************} + +constructor taddoptnode.create(ts: tsubnodetype; l,r : tnode); +begin + { we need to keep the addn nodetype, otherwise taddnode.pass_generate_code will be } + { confused. Comparison for equal nodetypes therefore has to be } + { implemented using the classtype() method (JM) } + inherited create(addn,l,r); + subnodetype := ts; +end; + +function taddoptnode.dogetcopy: tnode; +var + hp: taddoptnode; +begin + hp := taddoptnode(inherited dogetcopy); + hp.subnodetype := subnodetype; + dogetcopy := hp; +end; + +function taddoptnode.docompare(p: tnode): boolean; +begin + docompare := + inherited docompare(p) and + (subnodetype = taddoptnode(p).subnodetype); +end; + + +{***************************************************************************** + TADDSSTRINGOPTNODE +*****************************************************************************} + +function taddsstringoptnode.pass_typecheck: tnode; +begin + result := nil; + updatecurmaxlen; + { left and right are already firstpass'ed by taddnode.pass_1 } + if not is_shortstring(left.resultdef) then + inserttypeconv(left,cshortstringtype); + if not is_shortstring(right.resultdef) then + inserttypeconv(right,cshortstringtype); + resultdef := left.resultdef; +end; + +function taddsstringoptnode.pass_1: tnode; +begin + pass_1 := nil; + expectloc:= LOC_REFERENCE; + { here we call STRCONCAT or STRCMP or STRCOPY } + include(current_procinfo.flags,pi_do_call); +end; + +function taddsstringoptnode.dogetcopy: tnode; +var + hp: taddsstringoptnode; +begin + hp := taddsstringoptnode(inherited dogetcopy); + hp.curmaxlen := curmaxlen; + dogetcopy := hp; +end; + +function taddsstringoptnode.docompare(p: tnode): boolean; +begin + docompare := + inherited docompare(p) and + (curmaxlen = taddsstringcharoptnode(p).curmaxlen); +end; + + +function is_addsstringoptnode(p: tnode): boolean; +begin + is_addsstringoptnode := + p.inheritsfrom(taddsstringoptnode); +end; + +procedure taddsstringoptnode.updatecurmaxlen; +begin + if is_addsstringoptnode(left) then + begin + { made it a separate block so no other if's are processed (would be a } + { simple waste of time) (JM) } + if (taddsstringoptnode(left).curmaxlen < 255) then + case subnodetype of + addsstringcharoptn: + curmaxlen := succ(taddsstringoptnode(left).curmaxlen); + addsstringcsstringoptn: + curmaxlen := min(taddsstringoptnode(left).curmaxlen + + tstringconstnode(right).len,255) + else + internalerror(291220001); + end + else curmaxlen := 255; + end + else if (left.nodetype = stringconstn) then + curmaxlen := min(tstringconstnode(left).len,255) + else if is_char(left.resultdef) then + curmaxlen := 1 + else if (left.nodetype = typeconvn) then + begin + case ttypeconvnode(left).convtype of + tc_char_2_string: + curmaxlen := 1; +{ doesn't work yet, don't know why (JM) + tc_chararray_2_string: + curmaxlen := + min(ttypeconvnode(left).left.resultdef.size,255); } + else curmaxlen := 255; + end; + end + else + curmaxlen := 255; +end; + +{***************************************************************************** + TADDSSTRINGCHAROPTNODE +*****************************************************************************} + + +constructor taddsstringcharoptnode.create(l,r : tnode); +begin + inherited create(addsstringcharoptn,l,r); +end; + +{***************************************************************************** + TADDSSTRINGCSSTRINGOPTNODE +*****************************************************************************} + + +constructor taddsstringcsstringoptnode.create(l,r : tnode); +begin + inherited create(addsstringcsstringoptn,l,r); +end; + + +function taddsstringcsstringoptnode.pass_1: tnode; +begin + { create the call to the concat routine both strings as arguments } + result := ccallnode.createintern('fpc_shortstr_append_shortstr', + ccallparanode.create(left,ccallparanode.create(right,nil))); + left:=nil; + right:=nil; +end; + + +{***************************************************************************** + HELPERS +*****************************************************************************} + +function canbeaddsstringcharoptnode(p: taddnode): boolean; +begin + canbeaddsstringcharoptnode := + (cs_opt_level1 in current_settings.optimizerswitches) and + +{ the shortstring will be gotten through conversion if necessary (JM) + is_shortstring(p.left.resultdef) and } + ((p.nodetype = addn) and + is_char(p.right.resultdef)); +end; + +function genaddsstringcharoptnode(p: taddnode): tnode; +var + hp: tnode; +begin + hp := caddsstringcharoptnode.create(p.left.getcopy,p.right.getcopy); + hp.flags := p.flags; + genaddsstringcharoptnode := hp; +end; + + + +function canbeaddsstringcsstringoptnode(p: taddnode): boolean; +begin + canbeaddsstringcsstringoptnode := + (cs_opt_level1 in current_settings.optimizerswitches) and + +{ the shortstring will be gotten through conversion if necessary (JM) + is_shortstring(p.left.resultdef) and } + ((p.nodetype = addn) and + (p.right.nodetype = stringconstn)); +end; + +function genaddsstringcsstringoptnode(p: taddnode): tnode; +var + hp: tnode; +begin + hp := caddsstringcsstringoptnode.create(p.left.getcopy,p.right.getcopy); + hp.flags := p.flags; + genaddsstringcsstringoptnode := hp; +end; + + +function canbemultistringadd(p: taddnode): boolean; +var + hp : tnode; + i : longint; +begin + result:=false; + if p.resultdef.typ<>stringdef then + exit; + i:=0; + hp:=p; + while assigned(hp) and (hp.nodetype=addn) do + begin + inc(i); + hp:=taddnode(hp).left; + end; + result:=(i>1); +end; + + +function genmultistringadd(p: taddnode): tnode; +var + hp,sn : tnode; + arrp : tarrayconstructornode; + newstatement : tstatementnode; + tempnode : ttempcreatenode; + is_shortstr : boolean; + para : tcallparanode; +begin + arrp:=nil; + hp:=p; + is_shortstr:=is_shortstring(p.resultdef); + while assigned(hp) and (hp.nodetype=addn) do + begin + sn:=taddnode(hp).right.getcopy; + inserttypeconv(sn,p.resultdef); + if is_shortstr then + begin + sn:=caddrnode.create(sn); + include(sn.flags,nf_internal); + end; + arrp:=carrayconstructornode.create(sn,arrp); + hp:=taddnode(hp).left; + end; + sn:=hp.getcopy; + inserttypeconv(sn,p.resultdef); + if is_shortstr then + begin + sn:=caddrnode.create(sn); + include(sn.flags,nf_internal); + end; + arrp:=carrayconstructornode.create(sn,arrp); + if assigned(aktassignmentnode) and + (aktassignmentnode.right=p) and + (aktassignmentnode.left.resultdef=p.resultdef) and + valid_for_var(aktassignmentnode.left,false) then + begin + para:=ccallparanode.create( + arrp, + ccallparanode.create(aktassignmentnode.left.getcopy,nil) + ); + if is_ansistring(p.resultdef) then + para:=ccallparanode.create( + cordconstnode.create( + getparaencoding(p.resultdef), + u16inttype, + true + ), + para + ); + result:=ccallnode.createintern( + 'fpc_'+tstringdef(p.resultdef).stringtypname+'_concat_multi', + para + ); + include(aktassignmentnode.flags,nf_assign_done_in_right); + end + else + begin + result:=internalstatements(newstatement); + tempnode:=ctempcreatenode.create(p.resultdef,p.resultdef.size,tt_persistent ,true); + addstatement(newstatement,tempnode); + para:=ccallparanode.create( + arrp, + ccallparanode.create(ctemprefnode.create(tempnode),nil) + ); + if is_ansistring(p.resultdef) then + para:=ccallparanode.create( + cordconstnode.create( + getparaencoding(p.resultdef), + u16inttype, + true + ), + para + ); + addstatement( + newstatement, + ccallnode.createintern( + 'fpc_'+tstringdef(p.resultdef).stringtypname+'_concat_multi', + para + ) + ); + addstatement(newstatement,ctempdeletenode.create_normal_temp(tempnode)); + addstatement(newstatement,ctemprefnode.create(tempnode)); + end; +end; + +begin + caddsstringcharoptnode := taddsstringcharoptnode; + caddsstringcsstringoptnode := taddsstringcsstringoptnode; +end. diff --git a/closures/compiler/nset.pas b/closures/compiler/nset.pas new file mode 100644 index 0000000000..acc1871968 --- /dev/null +++ b/closures/compiler/nset.pas @@ -0,0 +1,1015 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + Type checking and register allocation for set/case 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 nset; + +{$i fpcdefs.inc} + +interface + + uses + cclasses,constexp, + node,globtype,globals, + aasmbase,aasmtai,aasmdata,ncon,nflw,symtype; + + type + TLabelType = (ltOrdinal, ltConstString); + + pcaselabel = ^tcaselabel; + tcaselabel = record + { unique blockid } + blockid : longint; + { left and right tree node } + less, + greater : pcaselabel; + + { range type } + case label_type : TLabelType of + ltOrdinal: + ( + _low, + _high : TConstExprInt; + ); + ltConstString: + ( + _low_str, + _high_str : tstringconstnode; + ); + end; + + pcaseblock = ^tcaseblock; + tcaseblock = record + { label (only used in pass_generate_code) } + blocklabel : tasmlabel; + + statementlabel : tlabelnode; + { instructions } + statement : tnode; + end; + + tsetelementnode = class(tbinarynode) + constructor create(l,r : tnode);virtual; + function pass_typecheck:tnode;override; + function pass_1 : tnode;override; + end; + tsetelementnodeclass = class of tsetelementnode; + + tinnode = class(tbinopnode) + constructor create(l,r : tnode);virtual;reintroduce; + function pass_typecheck:tnode;override; + function simplify(forinline : boolean):tnode;override; + function pass_1 : tnode;override; + end; + tinnodeclass = class of tinnode; + + trangenode = class(tbinarynode) + constructor create(l,r : tnode);virtual; + function pass_typecheck:tnode;override; + function pass_1 : tnode;override; + end; + trangenodeclass = class of trangenode; + + tcasenode = class(tunarynode) + labels : pcaselabel; + blocks : TFPList; + elseblock : tnode; + constructor create(l:tnode);virtual; + destructor destroy;override; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderefimpl;override; + procedure derefimpl;override; + function dogetcopy : tnode;override; + procedure insertintolist(l : tnodelist);override; + function pass_typecheck:tnode;override; + function pass_1 : tnode;override; + function docompare(p: tnode): boolean; override; + procedure addlabel(blockid:longint;l,h : TConstExprInt); overload; + procedure addlabel(blockid:longint;l,h : tstringconstnode); overload; + procedure addblock(blockid:longint;instr:tnode); + procedure addelseblock(instr:tnode); + end; + tcasenodeclass = class of tcasenode; + + var + csetelementnode : tsetelementnodeclass = tsetelementnode; + cinnode : tinnodeclass = tinnode; + crangenode : trangenodeclass = trangenode; + ccasenode : tcasenodeclass = tcasenode; + + { counts the labels } + function case_count_labels(root : pcaselabel) : longint; + { searches the highest label } + function case_get_max(root : pcaselabel) : tconstexprint; + { searches the lowest label } + function case_get_min(root : pcaselabel) : tconstexprint; + + +implementation + + uses + systems, + verbose, + symconst,symdef,symsym,symtable,defutil,defcmp, + htypechk,pass_1, + nadd,nbas,ncnv,nld,cgobj,cgbase, + widestr; + + +{***************************************************************************** + TSETELEMENTNODE +*****************************************************************************} + + constructor tsetelementnode.create(l,r : tnode); + + begin + inherited create(setelementn,l,r); + end; + + + function tsetelementnode.pass_typecheck:tnode; + begin + result:=nil; + typecheckpass(left); + if assigned(right) then + typecheckpass(right); + set_varstate(left,vs_read,[vsf_must_be_valid]); + if codegenerror then + exit; + + resultdef:=left.resultdef; + end; + + + function tsetelementnode.pass_1 : tnode; + + begin + result:=nil; + firstpass(left); + if assigned(right) then + firstpass(right); + if codegenerror then + exit; + + expectloc:=left.expectloc; + end; + + +{***************************************************************************** + TINNODE +*****************************************************************************} + + constructor tinnode.create(l,r : tnode); + begin + inherited create(inn,l,r); + end; + + + function tinnode.pass_typecheck:tnode; + + var + t : tnode; + + function createsetconst(psd : tsetdef) : pconstset; + var + pcs : pconstset; + i : longint; + begin + new(pcs); + case psd.elementdef.typ of + enumdef : + begin + for i := 0 to tenumdef(psd.elementdef).symtable.SymList.Count - 1 do + begin + include(pcs^,tenumsym(tenumdef(psd.elementdef).symtable.SymList[i]).value); + end; + end; + orddef : + begin + for i:=int64(torddef(psd.elementdef).low) to int64(torddef(psd.elementdef).high) do + include(pcs^,i); + end; + end; + createsetconst:=pcs; + end; + + begin + result:=nil; + resultdef:=pasbool8type; + typecheckpass(right); + set_varstate(right,vs_read,[vsf_must_be_valid]); + if codegenerror then + exit; + + { Convert array constructor first to set } + if is_array_constructor(right.resultdef) then + begin + arrayconstructor_to_set(right); + firstpass(right); + if codegenerror then + exit; + end; + + typecheckpass(left); + set_varstate(left,vs_read,[vsf_must_be_valid]); + if codegenerror then + exit; + + if not assigned(left.resultdef) then + internalerror(20021126); + + t:=self; + if isbinaryoverloaded(t) then + begin + result:=t; + exit; + end; + + if right.resultdef.typ<>setdef then + CGMessage(sym_e_set_expected); + + if codegenerror then + exit; + + if (m_tp7 in current_settings.modeswitches) then + begin + { insert a hint that a range check error might occur on non-byte + elements with the in operator. + } + if ( + (left.resultdef.typ = orddef) and not + (torddef(left.resultdef).ordtype in [s8bit,u8bit,uchar,pasbool8,bool8bit]) + ) + or + ( + (left.resultdef.typ = enumdef) and + (tenumdef(left.resultdef).maxval > 255) + ) + then + CGMessage(type_h_in_range_check); + + { type conversion/check } + if assigned(tsetdef(right.resultdef).elementdef) then + inserttypeconv(left,tsetdef(right.resultdef).elementdef); + end + else if not is_ordinal(left.resultdef) or (left.resultdef.size > u32inttype.size) then + begin + CGMessage(type_h_in_range_check); + if is_signed(left.resultdef) then + inserttypeconv(left,s32inttype) + else + inserttypeconv(left,u32inttype); + end + else if assigned(tsetdef(right.resultdef).elementdef) and + not(is_integer(tsetdef(right.resultdef).elementdef) and + is_integer(left.resultdef)) then + { Type conversion to check things like 'char in set_of_byte'. } + { Can't use is_subequal because that will fail for } + { 'widechar in set_of_char' } + { Can't use the type conversion for integers because then } + { "longint in set_of_byte" will give a range check error } + { instead of false } + inserttypeconv(left,tsetdef(right.resultdef).elementdef); + + { empty set then return false } + if not assigned(tsetdef(right.resultdef).elementdef) or + ((right.nodetype = setconstn) and + (tnormalset(tsetconstnode(right).value_set^) = [])) then + begin + t:=cordconstnode.create(0,pasbool8type,false); + typecheckpass(t); + result:=t; + exit; + end; + + result:=simplify(false); + end; + + + function tinnode.simplify(forinline : boolean):tnode; + var + t : tnode; + begin + result:=nil; + { constant evaluation } + if (left.nodetype=ordconstn) then + begin + if (right.nodetype=setconstn) then + begin + { tordconstnode.value is int64 -> signed -> the expression } + { below will be converted to longint on 32 bit systems due } + { to the rule above -> will give range check error if } + { value > high(longint) if we don't take the signedness } + { into account } + if Tordconstnode(left).value.signed then + t:=cordconstnode.create(byte(tordconstnode(left).value.svalue in Tsetconstnode(right).value_set^), + pasbool8type,true) + else + t:=cordconstnode.create(byte(tordconstnode(left).value.uvalue in Tsetconstnode(right).value_set^), + pasbool8type,true); + typecheckpass(t); + result:=t; + exit; + end + else + begin + if (Tordconstnode(left).value<int64(tsetdef(right.resultdef).setbase)) or + (Tordconstnode(left).value>int64(Tsetdef(right.resultdef).setmax)) then + begin + t:=cordconstnode.create(0, pasbool8type, true); + typecheckpass(t); + result:=t; + exit; + end; + end; + end; + end; + + + function tinnode.pass_1 : tnode; + begin + result:=nil; + expectloc:=LOC_REGISTER; + + firstpass(right); + firstpass(left); + if codegenerror then + exit; + end; + + +{***************************************************************************** + TRANGENODE +*****************************************************************************} + + constructor trangenode.create(l,r : tnode); + var + value: string; + + begin + { if right is char and left is string then } + { right should be treated as one-symbol string } + if is_conststringnode(l) and is_constcharnode(r) then + begin + value := char(tordconstnode(r).value.uvalue) + ''#0; + r.free; + r := cstringconstnode.createstr(value); + do_typecheckpass(r); + end; + inherited create(rangen,l,r); + end; + + + function trangenode.pass_typecheck : tnode; + begin + result:=nil; + typecheckpass(left); + typecheckpass(right); + set_varstate(left,vs_read,[vsf_must_be_valid]); + set_varstate(right,vs_read,[vsf_must_be_valid]); + if codegenerror then + exit; + { both types must be compatible } + if compare_defs(left.resultdef,right.resultdef,left.nodetype)=te_incompatible then + IncompatibleTypes(left.resultdef,right.resultdef); + { Check if only when its a constant set } + if (left.nodetype=ordconstn) and (right.nodetype=ordconstn) then + begin + { upper limit must be greater or equal than lower limit } + if (tordconstnode(left).value>tordconstnode(right).value) and + ((tordconstnode(left).value<0) or (tordconstnode(right).value>=0)) then + CGMessage(parser_e_upper_lower_than_lower); + end; + resultdef:=left.resultdef; + end; + + + function trangenode.pass_1 : tnode; + begin + result:=nil; + firstpass(left); + firstpass(right); + if codegenerror then + exit; + expectloc:=left.expectloc; + end; + + +{***************************************************************************** + Case Helpers +*****************************************************************************} + + function case_count_labels(root : pcaselabel) : longint; + var + _l : longint; + + procedure count(p : pcaselabel); + begin + inc(_l); + if assigned(p^.less) then + count(p^.less); + if assigned(p^.greater) then + count(p^.greater); + end; + + begin + _l:=0; + count(root); + case_count_labels:=_l; + end; + + + function case_get_max(root : pcaselabel) : tconstexprint; + var + hp : pcaselabel; + begin + hp:=root; + while assigned(hp^.greater) do + hp:=hp^.greater; + case_get_max:=hp^._high; + end; + + + function case_get_min(root : pcaselabel) : tconstexprint; + var + hp : pcaselabel; + begin + hp:=root; + while assigned(hp^.less) do + hp:=hp^.less; + case_get_min:=hp^._low; + end; + + procedure deletecaselabels(p : pcaselabel); + + begin + if assigned(p^.greater) then + deletecaselabels(p^.greater); + if assigned(p^.less) then + deletecaselabels(p^.less); + if (p^.label_type = ltConstString) then + begin + p^._low_str.Free; + p^._high_str.Free; + end; + dispose(p); + end; + + function copycaselabel(p : pcaselabel) : pcaselabel; + + var + n : pcaselabel; + + begin + new(n); + n^:=p^; + if (p^.label_type = ltConstString) then + begin + n^._low_str := tstringconstnode(p^._low_str.getcopy); + n^._high_str := tstringconstnode(p^._high_str.getcopy); + end; + if assigned(p^.greater) then + n^.greater:=copycaselabel(p^.greater); + if assigned(p^.less) then + n^.less:=copycaselabel(p^.less); + copycaselabel:=n; + end; + + + procedure ppuwritecaselabel(ppufile:tcompilerppufile;p : pcaselabel); + var + b : byte; + begin + ppufile.putbyte(byte(p^.label_type = ltConstString)); + if (p^.label_type = ltConstString) then + begin + p^._low_str.ppuwrite(ppufile); + p^._high_str.ppuwrite(ppufile); + end + else + begin + ppufile.putexprint(p^._low); + ppufile.putexprint(p^._high); + end; + + ppufile.putlongint(p^.blockid); + b:=ord(assigned(p^.greater)) or (ord(assigned(p^.less)) shl 1); + ppufile.putbyte(b); + if assigned(p^.greater) then + ppuwritecaselabel(ppufile,p^.greater); + if assigned(p^.less) then + ppuwritecaselabel(ppufile,p^.less); + end; + + + function ppuloadcaselabel(ppufile:tcompilerppufile):pcaselabel; + var + b : byte; + p : pcaselabel; + begin + new(p); + if boolean(ppufile.getbyte) then + begin + p^.label_type := ltConstString; + p^._low_str := cstringconstnode.ppuload(stringconstn,ppufile); + p^._high_str := cstringconstnode.ppuload(stringconstn,ppufile); + end + else + begin + p^.label_type := ltOrdinal; + + p^._low:=ppufile.getexprint; + p^._high:=ppufile.getexprint; + end; + + p^.blockid:=ppufile.getlongint; + b:=ppufile.getbyte; + if (b and 1)=1 then + p^.greater:=ppuloadcaselabel(ppufile) + else + p^.greater:=nil; + if (b and 2)=2 then + p^.less:=ppuloadcaselabel(ppufile) + else + p^.less:=nil; + ppuloadcaselabel:=p; + end; + + +{***************************************************************************** + TCASENODE +*****************************************************************************} + + constructor tcasenode.create(l:tnode); + begin + inherited create(casen,l); + labels:=nil; + blocks:=TFPList.create; + elseblock:=nil; + end; + + + destructor tcasenode.destroy; + var + i : longint; + hp : pcaseblock; + begin + elseblock.free; + deletecaselabels(labels); + for i:=0 to blocks.count-1 do + begin + pcaseblock(blocks[i])^.statement.free; + hp:=pcaseblock(blocks[i]); + dispose(hp); + end; + blocks.free; + inherited destroy; + end; + + + constructor tcasenode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + var + cnt,i : longint; + begin + inherited ppuload(t,ppufile); + elseblock:=ppuloadnode(ppufile); + cnt:=ppufile.getlongint(); + blocks:=TFPList.create; + for i:=0 to cnt-1 do + addblock(i,ppuloadnode(ppufile)); + labels:=ppuloadcaselabel(ppufile); + end; + + + procedure tcasenode.ppuwrite(ppufile:tcompilerppufile); + var + i : longint; + begin + inherited ppuwrite(ppufile); + ppuwritenode(ppufile,elseblock); + ppufile.putlongint(blocks.count); + for i:=0 to blocks.count-1 do + ppuwritenode(ppufile,pcaseblock(blocks[i])^.statement); + ppuwritecaselabel(ppufile,labels); + end; + + + procedure tcasenode.buildderefimpl; + var + i : integer; + begin + inherited buildderefimpl; + if assigned(elseblock) then + elseblock.buildderefimpl; + for i:=0 to blocks.count-1 do + pcaseblock(blocks[i])^.statement.buildderefimpl; + end; + + + procedure tcasenode.derefimpl; + var + i : integer; + begin + inherited derefimpl; + if assigned(elseblock) then + elseblock.derefimpl; + for i:=0 to blocks.count-1 do + pcaseblock(blocks[i])^.statement.derefimpl; + end; + + + function tcasenode.pass_typecheck : tnode; + begin + result:=nil; + resultdef:=voidtype; + end; + + + function tcasenode.pass_1 : tnode; + var + i : integer; + node_thenblock,node_elseblock,if_node : tnode; + tempcaseexpr : ttempcreatenode; + if_block, init_block,stmt_block : tblocknode; + stmt : tstatementnode; + endlabel : tlabelnode; + + function makeifblock(const labtree : pcaselabel; prevconditblock : tnode): tnode; + var + condit : tnode; + begin + if assigned(labtree^.less) then + result := makeifblock(labtree^.less, prevconditblock) + else + result := prevconditblock; + + condit := caddnode.create(equaln, left.getcopy, labtree^._low_str.getcopy); + + if (labtree^._low_str.fullcompare(labtree^._high_str)<>0) then + begin + condit.nodetype := gten; + condit := caddnode.create( + andn, condit, caddnode.create( + lten, left.getcopy, labtree^._high_str.getcopy)); + end; + + result := + cifnode.create( + condit, cgotonode.create(pcaseblock(blocks[labtree^.blockid])^.statementlabel.labsym), result); + + if assigned(labtree^.greater) then + result := makeifblock(labtree^.greater, result); + + typecheckpass(result); + end; + + begin + result:=nil; + init_block:=nil; + expectloc:=LOC_VOID; + + { evalutes the case expression } + firstpass(left); + set_varstate(left,vs_read,[vsf_must_be_valid]); + if codegenerror then + exit; + + { Load caseexpr into temp var if complex. } + { No need to do this for ordinal, because } + { in that case caseexpr is generated once } + if (labels^.label_type = ltConstString) and (not valid_for_addr(left, false)) and + (blocks.count > 0) then + begin + init_block := internalstatements(stmt); + tempcaseexpr := + ctempcreatenode.create( + left.resultdef, left.resultdef.size, tt_persistent, true); + typecheckpass(tnode(tempcaseexpr)); + + addstatement(stmt, tempcaseexpr); + addstatement( + stmt, cassignmentnode.create( + ctemprefnode.create(tempcaseexpr), left)); + + left := ctemprefnode.create(tempcaseexpr); + typecheckpass(left); + end; + + { first case } + for i:=0 to blocks.count-1 do + firstpass(pcaseblock(blocks[i])^.statement); + + { may be handle else tree } + if assigned(elseblock) then + begin + firstpass(elseblock); + + { kill case? } + if blocks.count=0 then + begin + result:=elseblock; + elseblock:=nil; + exit; + end; + end + else + if blocks.count=0 then + begin + result:=cnothingnode.create; + exit; + end; + + if (labels^.label_type = ltConstString) then + begin + endlabel:=clabelnode.create(cnothingnode.create,tlabelsym.create('$casestrofend')); + stmt_block:=internalstatements(stmt); + for i:=0 to blocks.count-1 do + begin + pcaseblock(blocks[i])^.statementlabel:=clabelnode.create(cnothingnode.create,tlabelsym.create('$casestrof')); + addstatement(stmt,pcaseblock(blocks[i])^.statementlabel); + addstatement(stmt,pcaseblock(blocks[i])^.statement); + pcaseblock(blocks[i])^.statement:=nil; + addstatement(stmt,cgotonode.create(endlabel.labsym)); + end; + + firstpass(tnode(stmt_block)); + + if_node := makeifblock(labels, elseblock); + + if assigned(init_block) then + firstpass(tnode(init_block)); + + if_block := internalstatements(stmt); + + if assigned(init_block) then + addstatement(stmt, init_block); + + addstatement(stmt, if_node); + addstatement(stmt,cgotonode.create(endlabel.labsym)); + addstatement(stmt, stmt_block); + addstatement(stmt, endlabel); + result := if_block; + elseblock := nil; + exit; + end; + + if is_boolean(left.resultdef) then + begin + case blocks.count of + 2: + begin + if boolean(qword(labels^._low))=false then + begin + node_thenblock:=pcaseblock(blocks[labels^.greater^.blockid])^.statement; + node_elseblock:=pcaseblock(blocks[labels^.blockid])^.statement; + pcaseblock(blocks[labels^.greater^.blockid])^.statement:=nil; + end + else + begin + node_thenblock:=pcaseblock(blocks[labels^.blockid])^.statement; + node_elseblock:=pcaseblock(blocks[labels^.less^.blockid])^.statement; + pcaseblock(blocks[labels^.less^.blockid])^.statement:=nil; + end; + pcaseblock(blocks[labels^.blockid])^.statement:=nil; + end; + 1: + begin + if labels^._low=labels^._high then + begin + if boolean(qword(labels^._low))=false then + begin + node_thenblock:=elseblock; + node_elseblock:=pcaseblock(blocks[labels^.blockid])^.statement; + end + else + begin + node_thenblock:=pcaseblock(blocks[labels^.blockid])^.statement; + node_elseblock:=elseblock; + end; + pcaseblock(blocks[labels^.blockid])^.statement:=nil; + elseblock:=nil; + end + else + begin + result:=pcaseblock(blocks[labels^.blockid])^.statement; + pcaseblock(blocks[labels^.blockid])^.statement:=nil; + elseblock:=nil; + exit; + end; + end; + else + internalerror(200805031); + end; + result:=cifnode.create(left,node_thenblock,node_elseblock); + left:=nil; + end; + end; + + + function tcasenode.dogetcopy : tnode; + + var + n : tcasenode; + i : longint; + begin + n:=tcasenode(inherited dogetcopy); + if assigned(elseblock) then + n.elseblock:=elseblock.dogetcopy + else + n.elseblock:=nil; + if assigned(labels) then + n.labels:=copycaselabel(labels) + else + n.labels:=nil; + if assigned(blocks) then + begin + n.blocks:=TFPList.create; + for i:=0 to blocks.count-1 do + begin + if not assigned(blocks[i]) then + internalerror(200411302); + n.addblock(i,pcaseblock(blocks[i])^.statement.dogetcopy); + end; + end + else + n.blocks:=nil; + dogetcopy:=n; + end; + + procedure tcasenode.insertintolist(l : tnodelist); + + begin + end; + + function caselabelsequal(n1,n2: pcaselabel): boolean; + begin + result := + (not assigned(n1) and not assigned(n2)) or + (assigned(n1) and assigned(n2) and + (n1^._low = n2^._low) and + (n1^._high = n2^._high) and + { the rest of the fields don't matter for equality (JM) } + caselabelsequal(n1^.less,n2^.less) and + caselabelsequal(n1^.greater,n2^.greater)) + end; + + + function caseblocksequal(b1,b2:TFPList): boolean; + var + i : longint; + begin + result:=false; + if b1.count<>b2.count then + exit; + for i:=0 to b1.count-1 do + begin + if not pcaseblock(b1[i])^.statement.isequal(pcaseblock(b2[i])^.statement) then + exit; + end; + result:=true; + end; + + + function tcasenode.docompare(p: tnode): boolean; + begin + result := + inherited docompare(p) and + caselabelsequal(labels,tcasenode(p).labels) and + caseblocksequal(blocks,tcasenode(p).blocks) and + elseblock.isequal(tcasenode(p).elseblock); + end; + + + procedure tcasenode.addblock(blockid:longint;instr:tnode); + var + hcaseblock : pcaseblock; + begin + new(hcaseblock); + fillchar(hcaseblock^,sizeof(hcaseblock^),0); + hcaseblock^.statement:=instr; + if blockid>=blocks.count then + blocks.count:=blockid+1; + blocks[blockid]:=hcaseblock; + end; + + + procedure tcasenode.addelseblock(instr:tnode); + begin + elseblock:=instr; + end; + + + procedure tcasenode.addlabel(blockid:longint;l,h : TConstExprInt); + var + hcaselabel : pcaselabel; + + function insertlabel(var p : pcaselabel):pcaselabel; + begin + if p=nil then + begin + p:=hcaselabel; + result:=p; + end + else + if (p^._low>hcaselabel^._low) and + (p^._low>hcaselabel^._high) then + begin + if (hcaselabel^.blockid = p^.blockid) and + (p^._low = hcaselabel^._high + 1) then + begin + p^._low := hcaselabel^._low; + dispose(hcaselabel); + result:=p; + end + else + result:=insertlabel(p^.less) + end + else + if (p^._high<hcaselabel^._low) and + (p^._high<hcaselabel^._high) then + begin + if (hcaselabel^.blockid = p^.blockid) and + (p^._high+1 = hcaselabel^._low) then + begin + p^._high := hcaselabel^._high; + dispose(hcaselabel); + result:=p; + end + else + result:=insertlabel(p^.greater); + end + else + begin + dispose(hcaselabel); + Message(parser_e_double_caselabel); + end + end; + + begin + new(hcaselabel); + fillchar(hcaselabel^,sizeof(tcaselabel),0); + hcaselabel^.blockid:=blockid; + hcaselabel^.label_type:=ltOrdinal; + hcaselabel^._low:=l; + hcaselabel^._high:=h; + insertlabel(labels); + end; + + procedure tcasenode.addlabel(blockid: longint; l, h: tstringconstnode); + + var + hcaselabel : pcaselabel; + + function insertlabel(var p : pcaselabel) : pcaselabel; + begin + if not assigned(p) then + begin + p := hcaselabel; + result := p; + end + else + if (p^._low_str.fullcompare(hcaselabel^._high_str) > 0) then + result := insertlabel(p^.less) + else + if (p^._high_str.fullcompare(hcaselabel^._low_str) < 0) then + result := insertlabel(p^.greater) + else + begin + hcaselabel^._low_str.free; + hcaselabel^._high_str.free; + dispose(hcaselabel); + Message(parser_e_double_caselabel); + end; + end; + + begin + new(hcaselabel); + fillchar(hcaselabel^, sizeof(tcaselabel), 0); + hcaselabel^.blockid := blockid; + hcaselabel^.label_type := ltConstString; + + hcaselabel^._low_str := tstringconstnode(l.getcopy); + hcaselabel^._high_str := tstringconstnode(h.getcopy); + + insertlabel(labels); + end; + +end. diff --git a/closures/compiler/nstate.pas b/closures/compiler/nstate.pas new file mode 100644 index 0000000000..b7cb53235a --- /dev/null +++ b/closures/compiler/nstate.pas @@ -0,0 +1,123 @@ +{ + Copyright (c) 1998-2002 by Daniel Mantione + + This unit contains support routines for the state tracker + + 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 nstate; + +{$i fpcdefs.inc} + +interface + +uses cclasses,node; + +type Tstate_entry=class(Tlinkedlistitem) + what:Tnode; + value:Tnode; + constructor create(w,v:Tnode); + end; + + Tstate_storage=class + storage:Tlinkedlist; + constructor create; + procedure store_fact(w,v:Tnode); + function find_fact(what:Tnode):Tnode; + procedure delete_fact(what:Tnode); + end; + +var aktstate:Tstate_storage; + +implementation + +constructor Tstate_entry.create(w,v:Tnode); + +begin + inherited create; + what:=w; + value:=v; +end; + +constructor Tstate_storage.create; + +begin + storage:=Tlinkedlist.create; +end; + +procedure Tstate_storage.store_fact(w,v:Tnode); + +var se:Tstate_entry; + +begin +{ writeln('fact:'); + writenode(w); + writeln('='); + writenode(v);} + se:=Tstate_entry(storage.first); + while assigned(se) do + begin + if se.what.isequal(w) then + begin + storage.remove(se); + se.destroy; + break; + end; + se:=Tstate_entry(se.next); + end; + se:=Tstate_entry.create(w,v); + storage.concat(se); +end; + +function Tstate_storage.find_fact(what:Tnode):Tnode; + +var se:Tstate_entry; + +begin + find_fact:=nil; + se:=storage.first as Tstate_entry; + while assigned(se) do + begin + if se.what.isequal(what) then + begin + find_fact:=se.value; + break; + end; + se:=se.next as Tstate_entry; + end; +end; + +procedure Tstate_storage.delete_fact(what:Tnode); + +var se:Tstate_entry; + +begin + se:=storage.first as Tstate_entry; + while assigned(se) do + begin + if se.what.isequal(what) then + begin + storage.remove(se); + se.destroy; + break; + end; + se:=se.next as Tstate_entry; + end; +end; + +end. diff --git a/closures/compiler/nutils.pas b/closures/compiler/nutils.pas new file mode 100644 index 0000000000..b80bfff8ec --- /dev/null +++ b/closures/compiler/nutils.pas @@ -0,0 +1,1222 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Type checking and register allocation for 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 nutils; + +{$i fpcdefs.inc} + +interface + + uses + globtype,constexp, + symtype,symsym,symbase,symtable, + node; + + const + NODE_COMPLEXITY_INF = 255; + + type + { resultdef of functions that process on all nodes in a (sub)tree } + foreachnoderesult = ( + { false, continue recursion } + fen_false, + { false, stop recursion } + fen_norecurse_false, + { true, continue recursion } + fen_true, + { true, stop recursion } + fen_norecurse_true + ); + + tforeachprocmethod = (pm_preprocess,pm_postprocess, + pm_postandagain); + + foreachnodefunction = function(var n: tnode; arg: pointer): foreachnoderesult of object; + staticforeachnodefunction = function(var n: tnode; arg: pointer): foreachnoderesult; + + function foreachnode(var n: tnode; f: foreachnodefunction; arg: pointer): boolean; + function foreachnode(procmethod : tforeachprocmethod; var n: tnode; f: foreachnodefunction; arg: pointer): boolean; + function foreachnodestatic(var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean; + function foreachnodestatic(procmethod : tforeachprocmethod; var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean; + + { checks if the given node tree contains only nodes of the given type, + if this isn't the case, an ie is thrown + } + procedure checktreenodetypes(n : tnode;typeset : tnodetypeset); + + procedure load_procvar_from_calln(var p1:tnode); + function maybe_call_procvar(var p1:tnode;tponly:boolean):boolean; + function get_high_value_sym(vs: tparavarsym):tsym; { marking it as inline causes IE 200311075 during loading from ppu file } + function load_high_value_node(vs:tparavarsym):tnode; + function load_self_node:tnode; + function load_result_node:tnode; + function load_self_pointer_node:tnode; + function load_vmt_pointer_node:tnode; + function is_self_node(p:tnode):boolean; + + function call_fail_node:tnode; + function initialize_data_node(p:tnode):tnode; + function finalize_data_node(p:tnode):tnode; + + function node_complexity(p: tnode): cardinal; + function node_resources_fpu(p: tnode): cardinal; + procedure node_tree_set_filepos(var n:tnode;const filepos:tfileposinfo); + + { tries to simplify the given node after inlining } + procedure doinlinesimplify(var n : tnode); + { creates an ordinal constant, optionally based on the result from a + simplify operation: normally the type is the smallest integer type + that can hold the value, but when inlining the "def" will be used instead, + which was determined during an earlier typecheck pass (because the value + may e.g. be a parameter to a call, which needs to be of the declared + parameter type) } + function create_simplified_ord_const(value: tconstexprint; def: tdef; forinline: boolean): tnode; + + + { returns true if n is only a tree of administrative nodes + containing no code } + function has_no_code(n : tnode) : boolean; + + function getpropaccesslist(propsym:tpropertysym; pap:tpropaccesslisttypes;out propaccesslist:tpropaccesslist):boolean; + procedure propaccesslist_to_node(var p1:tnode;st:TSymtable;pl:tpropaccesslist); + function node_to_propaccesslist(p1:tnode):tpropaccesslist; + + { returns true if n is an array element access of a bitpacked array with + elements of the which the vitsize mod 8 <> 0, or if is a field access + with bitsize mod 8 <> 0 or bitoffset mod 8 <> 0 of an element in a + bitpacked structure } + function is_bitpacked_access(n: tnode): boolean; + + { creates a load of field 'fieldname' in the record/class/... + represented by n } + function genloadfield(n: tnode; const fieldname: string): tnode; + + { returns true, if the tree given might have side effects } + function might_have_sideeffects(n : tnode) : boolean; + +implementation + + uses + cutils,verbose,globals, + symconst,symdef, + defutil,defcmp, + nbas,ncon,ncnv,nld,nflw,nset,ncal,nadd,nmem,ninl, + cpubase,cgbase,procinfo, + pass_1; + + function foreachnode(procmethod : tforeachprocmethod;var n: tnode; f: foreachnodefunction; arg: pointer): boolean; + + function process_children(res : boolean) : boolean; + var + i: longint; + begin + result:=res; + case n.nodetype of + asn: + if assigned(tasnode(n).call) then + begin + result := foreachnode(procmethod,tasnode(n).call,f,arg); + exit + end; + calln: + begin + result := foreachnode(procmethod,tnode(tcallnode(n).callinitblock),f,arg) or result; + result := foreachnode(procmethod,tcallnode(n).methodpointer,f,arg) or result; + result := foreachnode(procmethod,tcallnode(n).funcretnode,f,arg) or result; + result := foreachnode(procmethod,tnode(tcallnode(n).callcleanupblock),f,arg) or result; + end; + ifn, whilerepeatn, forn, tryexceptn, tryfinallyn: + begin + { not in one statement, won't work because of b- } + result := foreachnode(procmethod,tloopnode(n).t1,f,arg) or result; + result := foreachnode(procmethod,tloopnode(n).t2,f,arg) or result; + end; + raisen: + { frame tree } + result := foreachnode(traisenode(n).third,f,arg) or result; + tempcreaten: + { temp. initialization code } + if assigned(ttempcreatenode(n).tempinfo^.tempinitcode) then + result := foreachnode(ttempcreatenode(n).tempinfo^.tempinitcode,f,arg) or result; + casen: + begin + for i := 0 to tcasenode(n).blocks.count-1 do + if assigned(tcasenode(n).blocks[i]) then + result := foreachnode(procmethod,pcaseblock(tcasenode(n).blocks[i])^.statement,f,arg) or result; + result := foreachnode(procmethod,tcasenode(n).elseblock,f,arg) or result; + end; + end; + if n.inheritsfrom(tbinarynode) then + begin + { first process the "payload" of statementnodes } + result := foreachnode(procmethod,tbinarynode(n).left,f,arg) or result; + result := foreachnode(procmethod,tbinarynode(n).right,f,arg) or result; + end + else if n.inheritsfrom(tunarynode) then + result := foreachnode(procmethod,tunarynode(n).left,f,arg) or result; + end; + + begin + result := false; + if not assigned(n) then + exit; + if procmethod=pm_preprocess then + result:=process_children(result); + case f(n,arg) of + fen_norecurse_false: + exit; + fen_norecurse_true: + begin + result := true; + exit; + end; + fen_true: + result := true; + { result is already false + fen_false: + result := false; } + end; + if (procmethod=pm_postprocess) or (procmethod=pm_postandagain) then + result:=process_children(result); + if procmethod=pm_postandagain then + begin + case f(n,arg) of + fen_norecurse_false: + exit; + fen_norecurse_true: + begin + result := true; + exit; + end; + fen_true: + result := true; + end; + end; + end; + + + function foreachnode(var n: tnode; f: foreachnodefunction; arg: pointer): boolean; + begin + result:=foreachnode(pm_postprocess,n,f,arg); + end; + + + function foreachnodestatic(procmethod : tforeachprocmethod;var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean; + + function process_children(res : boolean) : boolean; + var + i: longint; + begin + result:=res; + case n.nodetype of + asn: + if assigned(tasnode(n).call) then + begin + result := foreachnodestatic(procmethod,tasnode(n).call,f,arg); + exit + end; + calln: + begin + result := foreachnodestatic(procmethod,tnode(tcallnode(n).callinitblock),f,arg) or result; + result := foreachnodestatic(procmethod,tcallnode(n).methodpointer,f,arg) or result; + result := foreachnodestatic(procmethod,tcallnode(n).funcretnode,f,arg) or result; + result := foreachnodestatic(procmethod,tnode(tcallnode(n).callcleanupblock),f,arg) or result; + end; + ifn, whilerepeatn, forn, tryexceptn, tryfinallyn: + begin + { not in one statement, won't work because of b- } + result := foreachnodestatic(procmethod,tloopnode(n).t1,f,arg) or result; + result := foreachnodestatic(procmethod,tloopnode(n).t2,f,arg) or result; + end; + raisen: + { frame tree } + result := foreachnodestatic(traisenode(n).third,f,arg) or result; + tempcreaten: + { temp. initialization code } + if assigned(ttempcreatenode(n).tempinfo^.tempinitcode) then + result := foreachnodestatic(ttempcreatenode(n).tempinfo^.tempinitcode,f,arg) or result; + casen: + begin + for i := 0 to tcasenode(n).blocks.count-1 do + if assigned(tcasenode(n).blocks[i]) then + result := foreachnodestatic(procmethod,pcaseblock(tcasenode(n).blocks[i])^.statement,f,arg) or result; + result := foreachnodestatic(procmethod,tcasenode(n).elseblock,f,arg) or result; + end; + end; + if n.inheritsfrom(tbinarynode) then + begin + { first process the "payload" of statementnodes } + result := foreachnodestatic(procmethod,tbinarynode(n).left,f,arg) or result; + result := foreachnodestatic(procmethod,tbinarynode(n).right,f,arg) or result; + end + else if n.inheritsfrom(tunarynode) then + result := foreachnodestatic(procmethod,tunarynode(n).left,f,arg) or result; + end; + + begin + result := false; + if not assigned(n) then + exit; + if procmethod=pm_preprocess then + result:=process_children(result); + case f(n,arg) of + fen_norecurse_false: + exit; + fen_norecurse_true: + begin + result := true; + exit; + end; + fen_true: + result := true; + { result is already false + fen_false: + result := false; } + end; + if (procmethod=pm_postprocess) or (procmethod=pm_postandagain) then + result:=process_children(result); + if procmethod=pm_postandagain then + begin + case f(n,arg) of + fen_norecurse_false: + exit; + fen_norecurse_true: + begin + result := true; + exit; + end; + fen_true: + result := true; + end; + end; + end; + + + function foreachnodestatic(var n: tnode; f: staticforeachnodefunction; arg: pointer): boolean; + begin + result:=foreachnodestatic(pm_postprocess,n,f,arg); + end; + + + function do_check(var n: tnode; arg: pointer): foreachnoderesult; + begin + if not(n.nodetype in pnodetypeset(arg)^) then + internalerror(200610141); + result:=fen_true; + end; + + + procedure checktreenodetypes(n : tnode;typeset : tnodetypeset); + begin + foreachnodestatic(n,@do_check,@typeset); + end; + + + procedure load_procvar_from_calln(var p1:tnode); + var + p2 : tnode; + begin + if p1.nodetype<>calln then + internalerror(200212251); + { was it a procvar, then we simply remove the calln and + reuse the right } + if assigned(tcallnode(p1).right) then + begin + p2:=tcallnode(p1).right; + tcallnode(p1).right:=nil; + end + else + begin + p2:=cloadnode.create_procvar(tcallnode(p1).symtableprocentry, + tprocdef(tcallnode(p1).procdefinition),tcallnode(p1).symtableproc); + { when the methodpointer is typen we've something like: + tobject.create. Then only the address is needed of the + method without a self pointer } + if assigned(tcallnode(p1).methodpointer) and + (tcallnode(p1).methodpointer.nodetype<>typen) then + tloadnode(p2).set_mp(tcallnode(p1).methodpointer.getcopy); + end; + typecheckpass(p2); + p1.free; + p1:=p2; + end; + + + function maybe_call_procvar(var p1:tnode;tponly:boolean):boolean; + var + hp : tnode; + begin + result:=false; + if (p1.resultdef.typ<>procvardef) or + (tponly and + not(m_tp_procvar in current_settings.modeswitches)) then + exit; + { ignore vecn,subscriptn } + hp:=p1; + repeat + case hp.nodetype of + vecn, + derefn, + typeconvn, + subscriptn : + hp:=tunarynode(hp).left; + else + break; + end; + until false; + { a tempref is used when it is loaded from a withsymtable } + if (hp.nodetype in [calln,loadn,temprefn]) then + begin + hp:=ccallnode.create_procvar(nil,p1); + typecheckpass(hp); + p1:=hp; + result:=true; + end; + end; + + + function get_high_value_sym(vs: tparavarsym):tsym; + begin + result := tsym(vs.owner.Find('high'+vs.name)); + end; + + + function get_local_or_para_sym(const aname:string):tsym; + var + pd : tprocdef; + begin + result:=nil; + { is not assigned while parsing a property } + if not assigned(current_procinfo) then + exit; + { we can't use searchsym here, because the + symtablestack is not fully setup when pass1 + is run for nested procedures } + pd:=current_procinfo.procdef; + repeat + result := tsym(pd.localst.Find(aname)); + if assigned(result) then + break; + result := tsym(pd.parast.Find(aname)); + if assigned(result) then + break; + { try the parent of a nested function } + if assigned(pd.owner.defowner) and + (pd.owner.defowner.typ=procdef) then + pd:=tprocdef(pd.owner.defowner) + else + break; + until false; + end; + + + function load_high_value_node(vs:tparavarsym):tnode; + var + srsym : tsym; + begin + result:=nil; + srsym:=get_high_value_sym(vs); + if assigned(srsym) then + begin + result:=cloadnode.create(srsym,vs.owner); + typecheckpass(result); + end + else + CGMessage(parser_e_illegal_expression); + end; + + + function load_self_node:tnode; + var + srsym : tsym; + begin + result:=nil; + + srsym:=get_local_or_para_sym('self'); + if assigned(srsym) then + begin + result:=cloadnode.create(srsym,srsym.owner); + include(tloadnode(result).loadnodeflags,loadnf_is_self); + end + else + begin + result:=cerrornode.create; + CGMessage(parser_e_illegal_expression); + end; + typecheckpass(result); + end; + + + function load_result_node:tnode; + var + srsym : tsym; + begin + result:=nil; + srsym:=get_local_or_para_sym('result'); + if assigned(srsym) then + result:=cloadnode.create(srsym,srsym.owner) + else + begin + result:=cerrornode.create; + CGMessage(parser_e_illegal_expression); + end; + typecheckpass(result); + end; + + + function load_self_pointer_node:tnode; + var + srsym : tsym; + begin + result:=nil; + srsym:=get_local_or_para_sym('self'); + if assigned(srsym) then + begin + result:=cloadnode.create(srsym,srsym.owner); + include(tloadnode(result).loadnodeflags,loadnf_load_self_pointer); + end + else + begin + result:=cerrornode.create; + CGMessage(parser_e_illegal_expression); + end; + typecheckpass(result); + end; + + + function load_vmt_pointer_node:tnode; + var + srsym : tsym; + begin + result:=nil; + srsym:=get_local_or_para_sym('vmt'); + if assigned(srsym) then + result:=cloadnode.create(srsym,srsym.owner) + else + begin + result:=cerrornode.create; + CGMessage(parser_e_illegal_expression); + end; + typecheckpass(result); + end; + + + function is_self_node(p:tnode):boolean; + begin + is_self_node:=(p.nodetype=loadn) and + (tloadnode(p).symtableentry.typ=paravarsym) and + (vo_is_self in tparavarsym(tloadnode(p).symtableentry).varoptions); + end; + + + function call_fail_node:tnode; + var + para : tcallparanode; + newstatement : tstatementnode; + srsym : tsym; + begin + result:=internalstatements(newstatement); + + { call fail helper and exit normal } + if is_class(current_structdef) then + begin + srsym:=search_struct_member(current_structdef,'FREEINSTANCE'); + if assigned(srsym) and + (srsym.typ=procsym) then + begin + { if self<>0 and vmt<>0 then freeinstance } + addstatement(newstatement,cifnode.create( + caddnode.create(andn, + caddnode.create(unequaln, + load_self_pointer_node, + cnilnode.create), + caddnode.create(unequaln, + load_vmt_pointer_node, + cnilnode.create)), + ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node,[]), + nil)); + end + else + internalerror(200305108); + end + else + if is_object(current_structdef) then + begin + { parameter 3 : vmt_offset } + { parameter 2 : pointer to vmt } + { parameter 1 : self pointer } + para:=ccallparanode.create( + cordconstnode.create(tobjectdef(current_structdef).vmt_offset,s32inttype,false), + ccallparanode.create( + ctypeconvnode.create_internal( + load_vmt_pointer_node, + voidpointertype), + ccallparanode.create( + ctypeconvnode.create_internal( + load_self_pointer_node, + voidpointertype), + nil))); + addstatement(newstatement, + ccallnode.createintern('fpc_help_fail',para)); + end + else + internalerror(200305132); + { self:=nil } + addstatement(newstatement,cassignmentnode.create( + load_self_pointer_node, + cnilnode.create)); + { exit } + addstatement(newstatement,cexitnode.create(nil)); + end; + + + function initialize_data_node(p:tnode):tnode; + begin + if not assigned(p.resultdef) then + typecheckpass(p); + if is_ansistring(p.resultdef) or + is_wide_or_unicode_string(p.resultdef) or + is_interfacecom_or_dispinterface(p.resultdef) or + is_dynamic_array(p.resultdef) then + begin + result:=cassignmentnode.create( + ctypeconvnode.create_internal(p,voidpointertype), + cnilnode.create + ); + end + else if (p.resultdef.typ=variantdef) then + begin + result:=ccallnode.createintern('fpc_variant_init', + ccallparanode.create( + ctypeconvnode.create_internal(p,search_system_type('TVARDATA').typedef), + nil)); + end + else + begin + result:=ccallnode.createintern('fpc_initialize', + ccallparanode.create( + caddrnode.create_internal( + crttinode.create( + tstoreddef(p.resultdef),initrtti,rdt_normal)), + ccallparanode.create( + caddrnode.create_internal(p), + nil))); + end; + end; + + + function finalize_data_node(p:tnode):tnode; + var + newstatement : tstatementnode; + hs : string; + begin + if not assigned(p.resultdef) then + typecheckpass(p); + { 'decr_ref' suffix is somewhat misleading, all these helpers + set the passed pointer to nil now } + if is_ansistring(p.resultdef) then + hs:='fpc_ansistr_decr_ref' + else if is_widestring(p.resultdef) then + hs:='fpc_widestr_decr_ref' + else if is_unicodestring(p.resultdef) then + hs:='fpc_unicodestr_decr_ref' + else if is_interfacecom_or_dispinterface(p.resultdef) then + hs:='fpc_intf_decr_ref' + else + hs:=''; + if hs<>'' then + result:=ccallnode.createintern(hs, + ccallparanode.create( + ctypeconvnode.create_internal(p,voidpointertype), + nil)) + else if p.resultdef.typ=variantdef then + begin + result:=ccallnode.createintern('fpc_variant_clear', + ccallparanode.create( + ctypeconvnode.create_internal(p,search_system_type('TVARDATA').typedef), + nil)); + end + else + result:=ccallnode.createintern('fpc_finalize', + ccallparanode.create( + caddrnode.create_internal( + crttinode.create( + tstoreddef(p.resultdef),initrtti,rdt_normal)), + ccallparanode.create( + caddrnode.create_internal(p), + nil))); + end; + + + { this function must return a very high value ("infinity") for } + { trees containing a call, the rest can be balanced more or less } + { at will, probably best mainly in terms of required memory } + { accesses } + function node_complexity(p: tnode): cardinal; + var + correction: byte; +{$ifdef ARM} + dummy : byte; +{$endif ARM} + begin + result := 0; + while assigned(p) do + begin + case p.nodetype of + { floating point constants usually need loading from memory } + realconstn, + temprefn, + loadvmtaddrn, + { main reason for the next one: we can't take the address of } + { loadparentfpnode, so replacing it by a temp which is the } + { address of this node's location and then dereferencing } + { doesn't work. If changed, check whether webtbs/tw0935 } + { still works with nodeinlining (JM) } + loadparentfpn: + begin + result := 1; + exit; + end; + loadn: + begin + if assigned(tloadnode(p).left) then + inc(result,node_complexity(tloadnode(p).left)); + { threadvars need a helper call } + if (tloadnode(p).symtableentry.typ=staticvarsym) and + (vo_is_thread_var in tstaticvarsym(tloadnode(p).symtableentry).varoptions) then + inc(result,5) + else + inc(result); + if (result >= NODE_COMPLEXITY_INF) then + result := NODE_COMPLEXITY_INF; + exit; + end; + subscriptn: + begin + if is_implicit_pointer_object_type(tunarynode(p).left.resultdef) then + inc(result,2); + if (result = NODE_COMPLEXITY_INF) then + exit; + p := tunarynode(p).left; + end; + blockn, + callparan: + p := tunarynode(p).left; + notn, + derefn : + begin + inc(result); + if (result = NODE_COMPLEXITY_INF) then + exit; + p := tunarynode(p).left; + end; + typeconvn: + begin + { may be more complex in some cases } + if not(ttypeconvnode(p).convtype in [tc_equal,tc_int_2_int,tc_bool_2_bool,tc_real_2_real,tc_cord_2_pointer]) then + inc(result); + if (result = NODE_COMPLEXITY_INF) then + exit; + p := tunarynode(p).left; + end; + vecn, + statementn: + begin + inc(result,node_complexity(tbinarynode(p).left)); + if (result >= NODE_COMPLEXITY_INF) then + begin + result := NODE_COMPLEXITY_INF; + exit; + end; + p := tbinarynode(p).right; + end; + addn,subn,orn,andn,xorn,muln,divn,modn,symdifn, + shln,shrn, + equaln,unequaln,gtn,gten,ltn,lten, + assignn: + begin +{$ifdef CPU64BITALU} + correction:=1; +{$else CPU64BITALU} + correction:=2; +{$endif CPU64BITALU} + inc(result,node_complexity(tbinarynode(p).left)+1*correction); + if (p.nodetype in [muln,divn,modn]) then + inc(result,5*correction*correction); + if (result >= NODE_COMPLEXITY_INF) then + begin + result := NODE_COMPLEXITY_INF; + exit; + end; + p := tbinarynode(p).right; + end; + ordconstn: + begin +{$ifdef ARM} + if not(is_shifter_const(tordconstnode(p).value.svalue,dummy)) then + result:=2; +{$endif ARM} + exit; + end; + stringconstn, + tempcreaten, + tempdeleten, + pointerconstn, + nothingn, + niln: + exit; + inlinen: + begin + { this code assumes that the inline node has } + { already been firstpassed, and consequently } + { that inline nodes which are transformed into } + { calls already have been transformed } + case tinlinenode(p).inlinenumber of + in_lo_qword, + in_hi_qword, + in_lo_long, + in_hi_long, + in_lo_word, + in_hi_word, + in_length_x, + in_assigned_x, + in_pred_x, + in_succ_x, + in_round_real, + in_trunc_real, + in_int_real, + in_frac_real, + in_cos_real, + in_sin_real, + in_arctan_real, + in_pi_real, + in_abs_real, + in_sqr_real, + in_sqrt_real, + in_ln_real, + in_unaligned_x, + in_prefetch_var: + begin + inc(result); + p:=tunarynode(p).left; + end; + in_abs_long: + begin + inc(result,3); + if (result >= NODE_COMPLEXITY_INF) then + begin + result:=NODE_COMPLEXITY_INF; + exit; + end; + p:=tunarynode(p).left; + end; + in_sizeof_x, + in_typeof_x: + begin + inc(result); + if (tinlinenode(p).left.nodetype<>typen) then + { get instance vmt } + p:=tunarynode(p).left + else + { type vmt = global symbol, result is } + { already increased above } + exit; + end; + {$ifdef SUPPORT_MMX} + in_mmx_pcmpeqb..in_mmx_pcmpgtw, + {$endif SUPPORT_MMX} + { load from global symbol } + in_typeinfo_x, + { load frame pointer } + in_get_frame, + in_get_caller_frame, + in_get_caller_addr: + begin + inc(result); + exit; + end; + + in_inc_x, + in_dec_x, + in_include_x_y, + in_exclude_x_y, + in_assert_x_y : + begin + { operation (add, sub, or, and } + inc(result); + { left expression } + inc(result,node_complexity(tcallparanode(tunarynode(p).left).left)); + if (result >= NODE_COMPLEXITY_INF) then + begin + result := NODE_COMPLEXITY_INF; + exit; + end; + p:=tcallparanode(tunarynode(p).left).right; + if assigned(p) then + p:=tcallparanode(p).left; + end; + else + begin + result := NODE_COMPLEXITY_INF; + exit; + end; + end; + + end; + else + begin + result := NODE_COMPLEXITY_INF; + exit; + end; + end; + end; + end; + + + { this function returns an indication how much fpu registers + will be required. + Note: The algorithms need to be pessimistic to prevent a + fpu stack overflow on i386 } + function node_resources_fpu(p: tnode): cardinal; + var + res1,res2,res3 : cardinal; + begin + result:=0; + res1:=0; + res2:=0; + res3:=0; + if p.inheritsfrom(tunarynode) then + begin + if assigned(tunarynode(p).left) then + res1:=node_resources_fpu(tunarynode(p).left); + if p.inheritsfrom(tbinarynode) then + begin + if assigned(tbinarynode(p).right) then + res2:=node_resources_fpu(tbinarynode(p).right); + if p.inheritsfrom(ttertiarynode) and assigned(ttertiarynode(p).third) then + res3:=node_resources_fpu(ttertiarynode(p).third) + end; + end; + result:=max(max(res1,res2),res3); + case p.nodetype of + calln: + { it could be a recursive call, so we never really know the number of used fpu registers } + result:=maxfpuregs; + realconstn, + typeconvn, + loadn : + begin + if p.expectloc in [LOC_CFPUREGISTER,LOC_FPUREGISTER] then + result:=max(result,1); + end; + assignn, + addn,subn,muln,slashn, + equaln,unequaln,gtn,gten,ltn,lten : + begin + if (tbinarynode(p).left.expectloc in [LOC_CFPUREGISTER,LOC_FPUREGISTER]) or + (tbinarynode(p).right.expectloc in [LOC_CFPUREGISTER,LOC_FPUREGISTER])then + result:=max(result,2); + if(p.expectloc in [LOC_CFPUREGISTER,LOC_FPUREGISTER]) then + inc(result); + end; + end; + end; + + + function setnodefilepos(var n: tnode; arg: pointer): foreachnoderesult; + begin + result:=fen_true; + n.fileinfo:=pfileposinfo(arg)^; + end; + + + procedure node_tree_set_filepos(var n:tnode;const filepos:tfileposinfo); + begin + foreachnodestatic(n,@setnodefilepos,@filepos); + end; + + + function callsimplify(var n: tnode; arg: pointer): foreachnoderesult; + var + hn : tnode; + treechanged : ^boolean; + begin + result:=fen_false; + if n.inheritsfrom(tloopnode) and + not (lnf_simplify_processing in tloopnode(n).loopflags) then + begin + // Try to simplify condition + doinlinesimplify(tloopnode(n).left); + // call directly second part below, + // which might change the loopnode into + // something else if the conditino is a constant node + include(tloopnode(n).loopflags,lnf_simplify_processing); + callsimplify(n,arg); + // Be careful, n might have change node type + if n.inheritsfrom(tloopnode) then + exclude(tloopnode(n).loopflags,lnf_simplify_processing); + end + else + begin + hn:=n.simplify(true); + if assigned(hn) then + begin + treechanged := arg; + if assigned(treechanged) then + treechanged^:=true + else + internalerror (201008181); + n.free; + n:=hn; + typecheckpass(n); + end; + end; + end; + + + { tries to simplify the given node calling the simplify method recursively } + procedure doinlinesimplify(var n : tnode); + var + treechanged : boolean; + begin + // Optimize if code first + repeat + treechanged:=false; + foreachnodestatic(pm_postandagain,n,@callsimplify,@treechanged); + until not(treechanged); + end; + + + function create_simplified_ord_const(value: tconstexprint; def: tdef; forinline: boolean): tnode; + begin + if not forinline then + result:=genintconstnode(value) + else + result:=cordconstnode.create(value,def,cs_check_range in current_settings.localswitches); + end; + + + function getpropaccesslist(propsym:tpropertysym; pap:tpropaccesslisttypes;out propaccesslist:tpropaccesslist):boolean; + var + hpropsym : tpropertysym; + begin + result:=false; + { find property in the overridden list } + hpropsym:=propsym; + repeat + propaccesslist:=hpropsym.propaccesslist[pap]; + if not propaccesslist.empty then + begin + result:=true; + exit; + end; + hpropsym:=hpropsym.overriddenpropsym; + until not assigned(hpropsym); + end; + + + procedure propaccesslist_to_node(var p1:tnode;st:TSymtable;pl:tpropaccesslist); + var + plist : ppropaccesslistitem; + begin + plist:=pl.firstsym; + while assigned(plist) do + begin + case plist^.sltype of + sl_load : + begin + addsymref(plist^.sym); + if not assigned(st) then + st:=plist^.sym.owner; + { p1 can already contain the loadnode of + the class variable. When there is no tree yet we + may need to load it for with or objects } + if not assigned(p1) then + begin + case st.symtabletype of + withsymtable : + p1:=tnode(twithsymtable(st).withrefnode).getcopy; + ObjectSymtable : + p1:=load_self_node; + end; + end; + if assigned(p1) then + p1:=csubscriptnode.create(plist^.sym,p1) + else + p1:=cloadnode.create(plist^.sym,st); + end; + sl_subscript : + begin + addsymref(plist^.sym); + p1:=csubscriptnode.create(plist^.sym,p1); + end; + sl_typeconv : + p1:=ctypeconvnode.create_explicit(p1,plist^.def); + sl_absolutetype : + begin + p1:=ctypeconvnode.create(p1,plist^.def); + include(p1.flags,nf_absolute); + end; + sl_vec : + p1:=cvecnode.create(p1,cordconstnode.create(plist^.value,plist^.valuedef,true)); + else + internalerror(200110205); + end; + plist:=plist^.next; + end; + end; + + + function node_to_propaccesslist(p1:tnode):tpropaccesslist; + var + sl : tpropaccesslist; + + procedure addnode(p:tnode); + begin + case p.nodetype of + subscriptn : + begin + addnode(tsubscriptnode(p).left); + sl.addsym(sl_subscript,tsubscriptnode(p).vs); + end; + typeconvn : + begin + addnode(ttypeconvnode(p).left); + if nf_absolute in ttypeconvnode(p).flags then + sl.addtype(sl_absolutetype,ttypeconvnode(p).totypedef) + else + sl.addtype(sl_typeconv,ttypeconvnode(p).totypedef); + end; + vecn : + begin + addnode(tvecnode(p).left); + if tvecnode(p).right.nodetype=ordconstn then + sl.addconst(sl_vec,tordconstnode(tvecnode(p).right).value,tvecnode(p).right.resultdef) + else + begin + Message(parser_e_illegal_expression); + { recovery } + sl.addconst(sl_vec,0,tvecnode(p).right.resultdef); + end; + end; + loadn : + sl.addsym(sl_load,tloadnode(p).symtableentry); + else + internalerror(200310282); + end; + end; + + begin + sl:=tpropaccesslist.create; + addnode(p1); + result:=sl; + end; + + + function is_bitpacked_access(n: tnode): boolean; + begin + case n.nodetype of + vecn: + result:= + is_packed_array(tvecnode(n).left.resultdef) and + { only orddefs and enumdefs are actually bitpacked. Don't consider + e.g. an access to a 3-byte record as "bitpacked", since it + isn't } + (tvecnode(n).left.resultdef.typ in [orddef,enumdef]) and + not(tarraydef(tvecnode(n).left.resultdef).elepackedbitsize in [8,16,32,64]); + subscriptn: + result:= + is_packed_record_or_object(tsubscriptnode(n).left.resultdef) and + { see above } + (tsubscriptnode(n).vs.vardef.typ in [orddef,enumdef]) and + (not(tsubscriptnode(n).vs.vardef.packedbitsize in [8,16,32,64]) or + (tsubscriptnode(n).vs.fieldoffset mod 8 <> 0)); + else + result:=false; + end; + end; + + + function genloadfield(n: tnode; const fieldname: string): tnode; + var + vs : tsym; + begin + if not assigned(n.resultdef) then + typecheckpass(n); + vs:=tsym(tabstractrecorddef(n.resultdef).symtable.find(fieldname)); + if not assigned(vs) or + (vs.typ<>fieldvarsym) then + internalerror(2010061902); + result:=csubscriptnode.create(vs,n); + end; + + + function has_no_code(n : tnode) : boolean; + begin + if n=nil then + begin + result:=true; + exit; + end; + result:=false; + case n.nodetype of + nothingn: + begin + result:=true; + exit; + end; + blockn: + begin + result:=has_no_code(tblocknode(n).left); + exit; + end; + statementn: + begin + repeat + result:=has_no_code(tstatementnode(n).left); + n:=tstatementnode(n).right; + until not(result) or not assigned(n); + exit; + end; + end; + end; + + + function check_for_sideeffect(var n: tnode; arg: pointer): foreachnoderesult; + begin + result:=fen_false; + if (n.nodetype in [assignn,calln,asmn]) or + ((n.nodetype=inlinen) and + (tinlinenode(n).inlinenumber in [in_write_x,in_writeln_x,in_read_x,in_readln_x,in_str_x_string, + in_val_x,in_reset_x,in_rewrite_x,in_reset_typedfile,in_rewrite_typedfile,in_settextbuf_file_x, + in_inc_x,in_dec_x,in_include_x_y,in_exclude_x_y,in_break,in_continue,in_setlength_x, + in_finalize_x,in_new_x,in_dispose_x,in_exit,in_copy_x,in_initialize_x,in_leave,in_cycle]) + ) then + result:=fen_norecurse_true; + end; + + + function might_have_sideeffects(n : tnode) : boolean; + begin + result:=foreachnodestatic(n,@check_for_sideeffect,nil); + end; + +end. diff --git a/closures/compiler/objcdef.pas b/closures/compiler/objcdef.pas new file mode 100644 index 0000000000..0f49ed2070 --- /dev/null +++ b/closures/compiler/objcdef.pas @@ -0,0 +1,653 @@ +{ + Copyright (c) 2010 by Jonas Maebe + + This unit implements some Objective-C type helper routines (minimal + unit dependencies, usable in symdef). + + 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. + + **************************************************************************** +} + +{$i fpcdefs.inc} + +unit objcdef; + +interface + + uses + node, + symtype; + + { The internals of Objective-C's @encode() functionality: encode a + type into the internal format used by the run time. Returns false + if a type is not representable by the Objective-C run time, and in + that case also the failing definition. } + function objctryencodetype(def: tdef; out encodedtype: ansistring; out founderror: tdef): boolean; + + { Check whether a type can be used in an Objective-C method + signature or field declaration. } + function objcchecktype(def: tdef; out founderror: tdef): boolean; + + { add type info for def at the end of encodedstr. recordinfostate influences + whether a record-style type will be fully encoded, or just using its + type name. bpacked indicates whether a record/array is bitpacked. + On error, founderror contains the type that triggered the error. } + type + trecordinfostate = (ris_initial, ris_afterpointer, ris_dontprint); + + function objcaddencodedtype(def: tdef; recordinfostate: trecordinfostate; bpacked: boolean; var encodedstr: ansistring; out founderror: tdef): boolean; + +implementation + + uses + globtype, + cutils,cclasses, + verbose,systems, + symtable,symconst,symsym,symdef, + defutil,paramgr; + +{****************************************************************** + Type encoding +*******************************************************************} + + function encoderecst(const recname: ansistring; recst: tabstractrecordsymtable; var encodedstr: ansistring; out founderror: tdef): boolean; + var + variantstarts: tfplist; + i, varindex: longint; + field, + firstfield: tfieldvarsym; + firstfieldvariant, + bpacked: boolean; + begin + result:=false; + bpacked:=recst.fieldalignment=bit_alignment; + { Is the first field already the start of a variant? } + firstfield:=nil; + firstfieldvariant:=false; + for i:=0 to recst.symlist.count-1 do + begin + if (tsym(recst.symlist[i]).typ<>fieldvarsym) then + continue; + field:=tfieldvarsym(recst.symlist[i]); + if not assigned(firstfield) then + firstfield:=field + else if (vo_is_first_field in field.varoptions) then + begin + if (field.fieldoffset=firstfield.fieldoffset) then + firstfieldvariant:=true; + end; + end; + variantstarts:=tfplist.create; + encodedstr:=encodedstr+'{'+recname+'='; + for i:=0 to recst.symlist.count-1 do + begin + if (tsym(recst.symlist[i]).typ<>fieldvarsym) then + continue; + + field:=tfieldvarsym(recst.symlist[i]); + { start of a variant part? } + if ((field=firstfield) and + firstfieldvariant) or + ((field<>firstfield) and + (vo_is_first_field in field.varoptions)) then + begin + varindex:=variantstarts.count-1; + if (varindex=-1) or + (tfieldvarsym(variantstarts[varindex]).fieldoffset<field.fieldoffset) then + begin + { new, more deeply nested variant } + encodedstr:=encodedstr+'(?={?='; + variantstarts.add(field); + end + else + begin + { close existing nested variants if any } + while (varindex>=0) and + (tfieldvarsym(variantstarts[varindex]).fieldoffset>field.fieldoffset) do + begin + { close more deeply nested variants } + encodedstr:=encodedstr+'})'; + dec(varindex); + end; + if (varindex<0) then + internalerror(2009081805); + if (tfieldvarsym(variantstarts[varindex]).fieldoffset<>field.fieldoffset) then + internalerror(2009081804); + + { variant at the same level as a previous one } + variantstarts.count:=varindex+1; + { No need to add this field, it has the same offset as the + previous one at this position. } + if tfieldvarsym(variantstarts[varindex]).fieldoffset<>field.fieldoffset then + internalerror(2009081601); + { close previous variant sub-part and start new one } + encodedstr:=encodedstr+'}{?='; + end + end; + if not objcaddencodedtype(field.vardef,ris_afterpointer,bpacked,encodedstr,founderror) then + exit; + end; + for i:=0 to variantstarts.count-1 do + encodedstr:=encodedstr+'})'; + variantstarts.free; + encodedstr:=encodedstr+'}'; + result:=true + end; + + + function objcaddencodedtype(def: tdef; recordinfostate: trecordinfostate; bpacked: boolean; var encodedstr: ansistring; out founderror: tdef): boolean; + var + recname: ansistring; + recdef: trecorddef; + objdef: tobjectdef; + len: aint; + c: char; + newstate: trecordinfostate; + addrpara: boolean; + begin + result:=true; + case def.typ of + stringdef : + begin + case tstringdef(def).stringtype of + st_shortstring: + { include length byte } + encodedstr:=encodedstr+'['+tostr(tstringdef(def).len+1)+'C]'; + else + { While we could handle refcounted Pascal strings correctly + when such methods are called from Pascal code, things would + completely break down if they were called from Objective-C + code/reflection since the necessary refcount helper calls + would be missing on the caller side (unless we'd + automatically generate wrappers). } + result:=false; + end; + end; + enumdef, + orddef : + begin + if bpacked and + not is_void(def) then + encodedstr:=encodedstr+'b'+tostr(def.packedbitsize) + else + begin + if is_void(def) then + c:='v' + { in gcc, sizeof(_Bool) = sizeof(char) } + else if is_boolean(def) and + (def.size=1) then + c:='B' + else + begin + case def.size of + 1: + c:='c'; + 2: + c:='s'; + 4: + c:='i'; + 8: + c:='q'; + else + internalerror(2009081502); + end; + if not is_signed(def) then + c:=upcase(c); + end; + encodedstr:=encodedstr+c; + end; + end; + pointerdef : + begin + if is_pchar(def) then + encodedstr:=encodedstr+'*' + else if (def=objc_idtype) then + encodedstr:=encodedstr+'@' + else if (def=objc_seltype) then + encodedstr:=encodedstr+':' + else if (def=objc_metaclasstype) then + encodedstr:=encodedstr+'#' + else + begin + encodedstr:=encodedstr+'^'; + newstate:=recordinfostate; + if (recordinfostate<ris_dontprint) then + newstate:=succ(newstate); + if not objcaddencodedtype(tpointerdef(def).pointeddef,newstate,false,encodedstr,founderror) then + begin + result:=false; + { report the exact (nested) error defintion } + exit; + end; + end; + end; + floatdef : + begin + case tfloatdef(def).floattype of + s32real: + c:='f'; + s64real: + c:='d'; + else + begin + c:='!'; + result:=false; + end; + end; + encodedstr:=encodedstr+c; + end; + filedef : + result:=false; + recorddef : + begin + if assigned(def.typesym) then + recname:=def.typename + else + recname:='?'; + + if (recordinfostate<>ris_dontprint) then + begin + if not encoderecst(recname,tabstractrecordsymtable(trecorddef(def).symtable),encodedstr,founderror) then + begin + result:=false; + { report the exact (nested) error defintion } + exit; + end + end + else + encodedstr:=encodedstr+'{'+recname+'}' + end; + variantdef : + begin + recdef:=trecorddef(search_system_type('TVARDATA').typedef); + if (recordinfostate<>ris_dontprint) then + begin + if not encoderecst(recdef.typename,tabstractrecordsymtable(recdef.symtable),encodedstr,founderror) then + begin + result:=false; + { report the exact (nested) error defintion } + exit; + end + end + else + encodedstr:=encodedstr+'{'+recdef.typename+'}'; + end; + classrefdef : + begin + encodedstr:=encodedstr+'^'; + newstate:=recordinfostate; + if (recordinfostate<>ris_dontprint) then + newstate:=succ(newstate); + if is_objcclassref(def) then + begin + objdef:=tobjectdef(tclassrefdef(def).pointeddef); + if (newstate<>ris_dontprint) then + { anonymous (objc)class definitions do not exist } + begin + if not encoderecst(objdef.objextname^,tabstractrecordsymtable(objdef.symtable),encodedstr,founderror) then + { The fields of an Objective-C class should always be + encodeable. } + internalerror(2009081702); + end + else + encodedstr:=encodedstr+'{'+objdef.objextname^+'}' + end + { Object Pascal classrefdefs point to a vmt, not really useful + to completely write those here. I'm not even sure what the + Objective-C run time uses this information for, since in C you + can have forward struct definitions so not all structs passed + to functions can be written out here either -> treat + classrefdefs the same as such forward-defined structs. } + else + begin + if assigned(def.typesym) then + recname:=def.typename + else + recname:='?'; + encodedstr:=encodedstr+'{'+recname; + if (newstate<>ris_dontprint) then + encodedstr:=encodedstr+'='; + encodedstr:=encodedstr+'}' + end; + end; + setdef : + begin + addrpara:=paramanager.push_addr_param(vs_value,def,pocall_cdecl); + if not addrpara then + { encode as an record, they are always passed by value in C. } + encodedstr:=encodedstr+'{?='; + { Encode the set itself as an array. Without an encompassing + record, these are always passed by reference in C. } + encodedstr:=encodedstr+'['+tostr(def.size)+'C]'; + if not addrpara then + encodedstr:=encodedstr+'}'; + end; + formaldef : + begin + encodedstr:=encodedstr+'^v'; + end; + arraydef : + begin + if is_array_of_const(def) then + { do nothing, varargs are ignored in signatures } + else if is_special_array(def) then + result:=false + else + begin + len:=tarraydef(def).highrange-tarraydef(def).lowrange+1; + if is_packed_array(def) then + begin + { convert from bits to bytes for bitpacked arrays } + len:=(len+7) div 8; + { and encode as plain array of bytes } + encodedstr:=encodedstr+'['+tostr(len)+'C]'; + end + else + begin + encodedstr:=encodedstr+'['+tostr(len); + { Embedded structured types in the array are printed + in full regardless of the current recordinfostate. } + if not objcaddencodedtype(tarraydef(def).elementdef,ris_initial,false,encodedstr,founderror) then + begin + result:=false; + { report the exact (nested) error defintion } + exit; + end; + encodedstr:=encodedstr+']'; + end; + end; + end; + procvardef : + encodedstr:=encodedstr+'^?'; + objectdef : + case tobjectdef(def).objecttype of + odt_helper, + odt_class, + odt_object, + odt_cppclass: + begin + newstate:=recordinfostate; + { implicit pointer for classes } + if (tobjectdef(def).objecttype in [odt_class,odt_helper]) then + begin + encodedstr:=encodedstr+'^'; + { make all classes opaque, so even if they contain a + reference-counted field there is no problem. Since a + "dereferenced class" object does not exist, this should + not cause problems } + newstate:=ris_dontprint; + end; + if newstate<>ris_dontprint then + begin + if not encoderecst(def.typename,tabstractrecordsymtable(tobjectdef(def).symtable),encodedstr,founderror) then + begin + result:=false; + { report the exact (nested) error defintion } + exit; + end + end + else + encodedstr:=encodedstr+'{'+def.typename+'}' + end; + odt_interfacecom, + odt_interfacecom_property, + odt_interfacecom_function, + odt_dispinterface: + result:=false; + odt_interfacecorba: + encodedstr:=encodedstr+'^{'+def.typename+'=}'; + { In Objective-C, the actual types of class instances are + NSObject* etc, and those are encoded as "@". In FPC, to keep + the similarity with Delphi-style Object Pascal, the type is + NSObject and the pointer is implicit. Objective-C's "NSObject" + has "class of NSObject" as equivalent here. } + odt_objcclass, + odt_objcprotocol: + encodedstr:=encodedstr+'@'; + else + internalerror(2009081509); + end; + undefineddef, + errordef : + result:=false; + procdef : + { must be done via objcencodemethod() } + internalerror(2009081511); + else + internalerror(2009150812); + end; + if not result then + founderror:=def; + end; + + + function objctryencodetype(def: tdef; out encodedtype: ansistring; out founderror: tdef): boolean; + begin + result:=objcaddencodedtype(def,ris_initial,false,encodedtype,founderror); + end; + + +{****************************************************************** + ObjC type validity checking +*******************************************************************} + + function objcdochecktype(def: tdef; recordinfostate: trecordinfostate; out founderror: tdef): boolean; forward; + + function checkrecsttype(recst: tabstractrecordsymtable; recordinfostate: trecordinfostate; out founderror: tdef): boolean; + var + i: longint; + field: tfieldvarsym; + newstate: trecordinfostate; + begin + result:=false; + newstate:=recordinfostate; + { Although we never have to print the type info for nested + records, check them anyway in case we're not after a pointer + since if such records contain refcounted types then they + can cause just as much trouble as if they were a simple + refcounted field. } + if (newstate=ris_afterpointer) then + newstate:=ris_dontprint; + for i:=0 to recst.symlist.count-1 do + begin + if (tsym(recst.symlist[i]).typ<>fieldvarsym) then + continue; + + field:=tfieldvarsym(recst.symlist[i]); + if not objcdochecktype(field.vardef,newstate,founderror) then + exit; + end; + result:=true + end; + + + function objcdochecktype(def: tdef; recordinfostate: trecordinfostate; out founderror: tdef): boolean; + var + recdef: trecorddef; + objdef: tobjectdef; + newstate: trecordinfostate; + begin + result:=true; + case def.typ of + stringdef : + begin + case tstringdef(def).stringtype of + st_shortstring: + ; + else + { While we could handle refcounted Pascal strings correctly + when such methods are called from Pascal code, things would + completely break down if they were called from Objective-C + code/reflection since the necessary refcount helper calls + would be missing on the caller side (unless we'd + automatically generate wrappers). } + result:=false; + end; + end; + enumdef, + orddef : + ; + pointerdef : + begin + newstate:=recordinfostate; + if (recordinfostate<ris_dontprint) then + newstate:=succ(newstate); + if not objcdochecktype(tpointerdef(def).pointeddef,newstate,founderror) then + begin + result:=false; + { report the exact (nested) error defintion } + exit; + end; + end; + floatdef : + begin + case tfloatdef(def).floattype of + s32real, + s64real: + ; + else + result:=false; + end; + end; + filedef : + result:=false; + recorddef : + begin + if (recordinfostate<>ris_dontprint) then + begin + if not checkrecsttype(tabstractrecordsymtable(trecorddef(def).symtable),recordinfostate,founderror) then + begin + result:=false; + { report the exact (nested) error defintion } + exit; + end + end + end; + variantdef : + begin + recdef:=trecorddef(search_system_type('TVARDATA').typedef); + if (recordinfostate<>ris_dontprint) then + begin + if not checkrecsttype(tabstractrecordsymtable(recdef.symtable),recordinfostate,founderror) then + begin + result:=false; + { report the exact (nested) error defintion } + exit; + end + end; + end; + classrefdef: + begin + if is_objcclassref(def) then + begin + objdef:=tobjectdef(tclassrefdef(def).pointeddef); + newstate:=recordinfostate; + if (recordinfostate<ris_dontprint) then + newstate:=succ(newstate); + if (newstate<>ris_dontprint) then + begin + if not checkrecsttype(tabstractrecordsymtable(objdef.symtable),recordinfostate,founderror) then + begin + result:=false; + { report the exact (nested) error defintion } + exit; + end + end + end + end; + setdef, + formaldef : + ; + arraydef : + begin + if is_array_of_const(def) then + { ok, varargs are ignored in signatures } + else if is_special_array(def) then + result:=false + else + begin + if not is_packed_array(def) then + begin + if not objcdochecktype(tarraydef(def).elementdef,ris_initial,founderror) then + begin + result:=false; + { report the exact (nested) error defintion } + exit; + end; + end; + end; + end; + procvardef : + ; + objectdef : + case tobjectdef(def).objecttype of + odt_helper, + odt_class, + odt_object, + odt_cppclass: + begin + newstate:=recordinfostate; + { implicit pointer for classes } + if (tobjectdef(def).objecttype in [odt_class,odt_helper]) then + begin + { make all classes opaque, so even if they contain a + reference-counted field there is no problem. Since a + "dereferenced class" object does not exist, this should + not cause problems } + newstate:=ris_dontprint; + end; + if newstate<>ris_dontprint then + begin + if not checkrecsttype(tabstractrecordsymtable(tobjectdef(def).symtable),newstate,founderror) then + begin + result:=false; + { report the exact (nested) error defintion } + exit; + end + end + end; + odt_interfacecom, + odt_interfacecom_property, + odt_interfacecom_function, + odt_dispinterface: + result:=false; + odt_interfacecorba, + odt_objcclass, + odt_objcprotocol: + ; + else + internalerror(2009081709); + end; + undefineddef, + errordef : + result:=false; + procdef : + result:=false; + else + internalerror(2009170812); + end; + if not result then + founderror:=def; + end; + + + function objcchecktype(def: tdef; out founderror: tdef): boolean; + begin + result:=objcdochecktype(def,ris_initial,founderror); + end; + + +end. diff --git a/closures/compiler/objcgutl.pas b/closures/compiler/objcgutl.pas new file mode 100644 index 0000000000..6a5ce544d8 --- /dev/null +++ b/closures/compiler/objcgutl.pas @@ -0,0 +1,1625 @@ +{ + Copyright (c) 2009 by Jonas Maebe + + This unit implements some Objective-C helper routines at the code generator + level. + + 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. + + **************************************************************************** +} + +{$i fpcdefs.inc} + +unit objcgutl; + +interface + + uses + cclasses, + aasmbase,aasmdata, + symbase,symdef; + + procedure objcfinishstringrefpoolentry(entry: phashsetitem; stringpool: tconstpooltype; refsec, stringsec: tasmsectiontype); + procedure objcfinishclassrefnfpoolentry(entry: phashsetitem; classdef: tobjectdef); + + procedure MaybeGenerateObjectiveCImageInfo(globalst, localst: tsymtable); + + +implementation + + uses + globtype,globals,fmodule, + systems, + aasmtai, + cgbase, + objcdef,objcutil, + symconst,symtype,symsym,symtable, + verbose; + + type + tobjcabi = (oa_fragile, oa_nonfragile); +(* tivarlayouttype = (il_weak,il_strong); *) + + tobjcrttiwriter = class + protected + fabi: tobjcabi; + classdefs, + catdefs: tfpobjectlist; + classsyms, + catsyms: tfpobjectlist; + procedure gen_objc_methods(list: tasmlist; objccls: tobjectdef; out methodslabel: tasmlabel; classmethods, iscategory: Boolean); + procedure gen_objc_protocol_elements(list: tasmlist; protocol: tobjectdef; out reqinstsym, optinstsym, reqclssym, optclssym: TAsmLabel); + procedure gen_objc_protocol_list(list:TAsmList; protolist: TFPObjectList; out protolistsym: TAsmLabel); + procedure gen_objc_cat_methods(list:TAsmList; items: TFPObjectList; section: tasmsectiontype;const sectname: string; out listsym: TAsmLabel); + + procedure gen_objc_protocol(list:TAsmList; protocol: tobjectdef; out protocollabel: TAsmSymbol);virtual;abstract; + procedure gen_objc_category_sections(list:TAsmList; objccat: tobjectdef; out catlabel: TAsmSymbol);virtual;abstract; + procedure gen_objc_classes_sections(list:TAsmList; objclss: tobjectdef; out classlabel: TAsmSymbol);virtual;abstract; + procedure gen_objc_info_sections(list: tasmlist);virtual;abstract; + public + constructor create(_abi: tobjcabi); + destructor destroy;override; + procedure gen_objc_rtti_sections(list:TAsmList; st:TSymtable); + property abi: tobjcabi read fabi; + end; + + + { Used by by PowerPC/32 and i386 } + tobjcrttiwriter_fragile = class(tobjcrttiwriter) + protected + function gen_objc_protocol_ext(list: TAsmList; optinstsym, optclssym: TAsmLabel): TAsmLabel; + procedure gen_objc_ivars(list: TAsmList; objccls: tobjectdef; out ivarslabel: TAsmLabel); + procedure gen_objc_protocol(list:TAsmList; protocol: tobjectdef; out protocollabel: TAsmSymbol);override; + procedure gen_objc_category_sections(list:TAsmList; objccat: tobjectdef; out catlabel: TAsmSymbol);override; + procedure gen_objc_classes_sections(list:TAsmList; objclss: tobjectdef; out classlabel: TAsmSymbol);override; + procedure gen_objc_info_sections(list: tasmlist);override; + public + constructor create; + end; + + + { Used by PowerPC/64, ARM, and x86_64 } + tobjcrttiwriter_nonfragile = class(tobjcrttiwriter) + protected + ObjCEmptyCacheVar, + ObjCEmptyVtableVar: TAsmSymbol; + + procedure gen_objc_class_ro_part(list: TAsmList; objclss: tobjectdef; protolistsym: TAsmSymbol; out classrolabel: TAsmSymbol; metaclass: boolean); + procedure addclasslist(list: tasmlist; section: tasmsectiontype; const symname: string; classes: tfpobjectlist); + + procedure gen_objc_ivars(list: TAsmList; objccls: tobjectdef; out ivarslabel: TAsmLabel); + procedure gen_objc_protocol(list:TAsmList; protocol: tobjectdef; out protocollabel: TAsmSymbol);override; + procedure gen_objc_category_sections(list:TAsmList; objccat: tobjectdef; out catlabel: TAsmSymbol);override; + procedure gen_objc_classes_sections(list:TAsmList; objclss: tobjectdef; out classlabel: TAsmSymbol);override; + procedure gen_objc_info_sections(list: tasmlist);override; + public + constructor create; + end; + + + +{****************************************************************** + Protocol declaration helpers +*******************************************************************} + +function objcfindprotocolentry(const p: shortstring): TAsmSymbol; + var + item : PHashSetItem; + begin + result:=nil; + if not assigned(current_asmdata.ConstPools[sp_objcprotocolrefs]) then + exit; + item:=current_asmdata.constpools[sp_objcprotocolrefs].Find(@p[1], length(p)); + if not assigned(item) then + exit; + result:=TAsmSymbol(item^.Data); + end; + + +function objcaddprotocolentry(const p: shortstring; ref: TAsmSymbol): Boolean; + var + item : PHashSetItem; + begin + item:=current_asmdata.constpools[sp_objcprotocolrefs].FindOrAdd(@p[1], length(p)); + Result:=(item^.Data=nil); + if Result then + item^.Data:=ref; + end; + +{****************************************************************** + Pool section helpers +*******************************************************************} + +function objcreatestringpoolentryintern(p: pchar; len: longint; pooltype: tconstpooltype; stringsec: tasmsectiontype): TAsmSymbol; + var + entry : PHashSetItem; + strlab : tasmlabel; + pc : pchar; + pool : THashSet; + begin + pool := current_asmdata.constpools[pooltype]; + + entry:=pool.FindOrAdd(p,len); + if not assigned(entry^.data) then + begin + { create new entry } + current_asmdata.getlabel(strlab,alt_data); + entry^.Data:=strlab; + getmem(pc,entry^.keylength+1); + move(entry^.key^,pc^,entry^.keylength); + pc[entry^.keylength]:=#0; + + { add the string to the approriate section } + new_section(current_asmdata.asmlists[al_objc_pools],stringsec,strlab.name,0); + current_asmdata.asmlists[al_objc_pools].concat(Tai_label.Create(strlab)); + current_asmdata.asmlists[al_objc_pools].concat(Tai_string.Create_pchar(pc,entry^.keylength+1)); + Result := strlab; + end + else + Result := TAsmLabel(Entry^.Data); + end; + + +procedure objcfinishstringrefpoolentry(entry: phashsetitem; stringpool: tconstpooltype; refsec, stringsec: tasmsectiontype); + var + reflab : tasmlabel; + strlab : tasmsymbol; + classname: string; + begin + { have we already generated a reference for this string entry? } + if not assigned(entry^.Data) then + begin + { no, add the string to the associated strings section } + strlab:=objcreatestringpoolentryintern(pchar(entry^.key),entry^.keylength,stringpool,stringsec); + + { and now finish the reference } + current_asmdata.getlabel(reflab,alt_data); + entry^.Data:=reflab; + + { add a pointer to the string in the string references section } + new_section(current_asmdata.asmlists[al_objc_pools],refsec,reflab.name,sizeof(pint)); + current_asmdata.asmlists[al_objc_pools].concat(Tai_label.Create(reflab)); + current_asmdata.asmlists[al_objc_pools].concat(Tai_const.Create_sym(strlab)); + + { in case of a class reference, also add a lazy symbol reference for + the class (the linker requires this for the fragile ABI). } + if (refsec=sec_objc_cls_refs) and + not(target_info.system in systems_objc_nfabi) then + begin + setlength(classname,entry^.keylength); + move(entry^.key^,classname[1],entry^.keylength); + current_asmdata.asmlists[al_objc_pools].concat(tai_directive.Create(asd_lazy_reference,'.objc_class_name_'+classname)); + end; + end; + end; + + +function objcreatestringpoolentry(const s: string; pooltype: tconstpooltype; stringsec: tasmsectiontype): TAsmSymbol; + begin + result:=objcreatestringpoolentryintern(@s[1],length(s),pooltype,stringsec); + end; + + +procedure objcfinishclassrefnfpoolentry(entry: phashsetitem; classdef: tobjectdef); + var + reflab: TAsmLabel; + classym: TasmSymbol; + begin + { have we already generated a reference for this class ref entry? } + if not assigned(entry^.Data) then + begin + { no, add the classref to the sec_objc_cls_refs section } + current_asmdata.getlabel(reflab,alt_data); + entry^.Data:=reflab; + + { add a pointer to the class } + new_section(current_asmdata.asmlists[al_objc_pools],sec_objc_cls_refs,reflab.name,sizeof(pint)); + current_asmdata.asmlists[al_objc_pools].concat(Tai_label.Create(reflab)); + classym:=current_asmdata.RefAsmSymbol(classdef.rtti_mangledname(objcclassrtti)); + current_asmdata.asmlists[al_objc_pools].concat(Tai_const.Create_sym(classym)); + end; + end; + +{****************************************************************** + RTTI generation -- Helpers +*******************************************************************} + +procedure ConcatSymOrNil(list: tasmlist; sym: TAsmSymbol); inline; +begin + if Assigned(sym) then + list.Concat(tai_const.Create_sym(sym)) + else + list.Concat(tai_const.Create_pint(0)); +end; + + +{****************************************************************** + RTTI generation -- Common +*******************************************************************} + +{ generate a method list, either of class methods or of instance methods, + and both for obj-c classes and categories. } +procedure tobjcrttiwriter.gen_objc_methods(list: tasmlist; objccls: tobjectdef; out methodslabel: tasmlabel; classmethods, iscategory: Boolean); + const + clsSectType : array [Boolean] of tasmsectiontype = (sec_objc_inst_meth, sec_objc_cls_meth); + clsSectName : array [Boolean] of string = ('_OBJC_INST_METH','_OBJC_CLS_METH'); + catSectType : array [Boolean] of tasmsectiontype = (sec_objc_cat_inst_meth, sec_objc_cat_cls_meth); + catSectName : array [Boolean] of string = ('_OBJC_CAT_INST_METH','_OBJC_CAT_CLS_METH'); + type + method_data = record + def : tprocdef; + selsym : TAsmSymbol; + encsym : TAsmSymbol; + end; + var + i : Integer; + def : tprocdef; + defs : array of method_data; + mcnt : integer; + sym : tasmsymbol; + mtype : tdef; + begin + methodslabel:=nil; + mcnt:=0; + { collect all instance/class methods } + SetLength(defs,objccls.vmtentries.count); + for i:=0 to objccls.vmtentries.count-1 do + begin + def:=pvmtentry(objccls.vmtentries[i])^.procdef; + if (def.owner.defowner=objccls) and + (classmethods = (po_classmethod in def.procoptions)) then + begin + defs[mcnt].def:=def; + defs[mcnt].selsym:=objcreatestringpoolentry(def.messageinf.str^,sp_objcvarnames,sec_objc_meth_var_names); + defs[mcnt].encsym:=objcreatestringpoolentry(objcencodemethod(def),sp_objcvartypes,sec_objc_meth_var_types); + inc(mcnt); + end; + end; + if mcnt=0 then + exit; + + if iscategory then + new_section(list,catSectType[classmethods],catSectName[classmethods],sizeof(ptrint)) + else + new_section(list,clsSectType[classmethods],clsSectName[classmethods],sizeof(ptrint)); + + current_asmdata.getlabel(methodslabel,alt_data); + list.Concat(tai_label.Create(methodslabel)); + + if (abi=oa_fragile) then + { not used, always zero } + list.Concat(tai_const.Create_32bit(0)) + else + begin + { size of each entry -- always 32 bit value } + mtype:=search_named_unit_globaltype('OBJC','OBJC_METHOD',true).typedef; + list.Concat(tai_const.Create_32bit(mtype.size)); + end; + { number of objc_method entries in the method_list array -- always 32 bit} + list.Concat(tai_const.Create_32bit(mcnt)); + for i:=0 to mcnt-1 do + begin + { reference to the selector name } + list.Concat(tai_const.Create_sym(defs[i].selsym)); + { reference to the obj-c encoded function parameters (signature) } + list.Concat(tai_const.Create_sym(defs[i].encsym)); + { mangled name of the method } + sym:=current_asmdata.GetAsmSymbol(defs[i].def.mangledname); + if not assigned(sym) then + internalerror(2009091601); + list.Concat(tai_const.Create_sym(sym)); + end; + end; + + +{ generate method (and in the future also property) info for protocols } +procedure tobjcrttiwriter.gen_objc_protocol_elements(list: tasmlist; protocol: tobjectdef; out reqinstsym, optinstsym, reqclssym, optclssym: TAsmLabel); + var + proc : tprocdef; + reqinstmlist, + reqclsmlist, + optinstmlist, + optclsmlist : TFPObjectList; + i : ptrint; + begin + reqinstmlist:=TFPObjectList.Create(false); + reqclsmlist:=TFPObjectList.Create(false); + optinstmlist:=TFPObjectList.Create(false); + optclsmlist:=TFPObjectList.Create(false); + for i:=0 to protocol.vmtentries.Count-1 do + begin + proc:=pvmtentry(protocol.vmtentries[i])^.procdef; + if (po_classmethod in proc.procoptions) then + if not(po_optional in proc.procoptions) then + reqclsmlist.Add(proc) + else + optclsmlist.Add(proc) + else if not(po_optional in proc.procoptions) then + reqinstmlist.Add(proc) + else + optinstmlist.Add(proc); + end; + if reqinstmlist.Count > 0 then + gen_objc_cat_methods(list,reqinstmlist,sec_objc_cat_inst_meth,'_OBJC_CAT_INST_METH',reqinstsym) + else + reqinstsym:=nil; + if optinstmlist.Count > 0 then + gen_objc_cat_methods(list,optinstmlist,sec_objc_cat_inst_meth,'_OBJC_CAT_INST_METH',optinstsym) + else + optinstsym:=nil; + + if reqclsmlist.Count>0 then + gen_objc_cat_methods(list,reqclsmlist,sec_objc_cat_cls_meth,'_OBJC_CAT_CLS_METH',reqclssym) + else + reqclssym:=nil; + if optclsmlist.Count>0 then + gen_objc_cat_methods(list,optclsmlist,sec_objc_cat_cls_meth,'_OBJC_CAT_CLS_METH',optclssym) + else + optclssym:=nil; + + reqinstmlist.Free; + reqclsmlist.Free; + optinstmlist.Free; + optclsmlist.Free; +end; + + +(* +From CLang: + + struct objc_protocol_list + { +#ifdef FRAGILE_ABI + struct objc_protocol_list *next; + int count; +#else + long count; +#endif + Protocol *list[1]; + }; +*) +procedure tobjcrttiwriter.gen_objc_protocol_list(list: tasmlist; protolist: tfpobjectlist; out protolistsym: tasmlabel); + var + i : Integer; + protosym : TAsmSymbol; + protodef : tobjectdef; + begin + if not Assigned(protolist) or + (protolist.Count=0) then + begin + protolistsym:=nil; + Exit; + end; + + for i:=0 to protolist.Count-1 do + begin + protodef:=TImplementedInterface(protolist[i]).IntfDef; + protosym:=objcfindprotocolentry(protodef.objextname^); + if not assigned(protosym) then + begin + gen_objc_protocol(list,protodef,protosym); + objcaddprotocolentry(protodef.objextname^,protosym); + end; + end; + + { protocol lists are stored in .objc_cat_cls_meth section } + new_section(list,sec_objc_cat_cls_meth,'_OBJC_PROTOCOLLIST',sizeof(pint)); + current_asmdata.getlabel(protolistsym, alt_data); + list.Concat(tai_label.Create(protolistsym)); + + if (abi=oa_fragile) then + { From Clang: next, always nil} + list.Concat(tai_const.Create_pint(0)); + { From Clang: protocols count} + list.Concat(Tai_const.Create_pint(protolist.Count)); + for i:=0 to protolist.Count-1 do + begin + protodef:=(protolist[i] as TImplementedInterface).IntfDef; + protosym:=objcfindprotocolentry(protodef.objextname^); + if not Assigned(protosym) then + begin + { For some reason protosym is not declared, though must be! + Probably gen_obcj1_protocol returned wrong protosym + } + InternalError(2009091602); + end; + list.Concat(tai_const.Create_sym(protosym)); + end; + end; + + +{ Generate rtti for an Objective-C methods (methods without implementation) } +{ items : TFPObjectList of Tprocdef } +procedure tobjcrttiwriter.gen_objc_cat_methods(list:TAsmList; items: TFPObjectList; section: tasmsectiontype; + const sectname: string; out listsym: TAsmLabel); +var + i : integer; + m : tprocdef; + mtype : tdef; +begin + if not assigned(items) or + (items.count=0) then + exit; + + new_section(list, section, sectname, sizeof(pint)); + current_asmdata.getlabel(listsym,alt_data); + list.Concat(tai_label.Create(listsym)); + if (abi=oa_nonfragile) then + begin + { size of each entry -- always 32 bit value } + mtype:=search_named_unit_globaltype('OBJC','OBJC_METHOD',true).typedef; + list.Concat(tai_const.Create_32bit(mtype.size)); + end; + list.Concat(Tai_const.Create_32bit(items.count)); + for i:=0 to items.Count-1 do + begin + m:=tprocdef(items[i]); + list.Concat(Tai_const.Create_sym( + objcreatestringpoolentry(m.messageinf.str^,sp_objcvarnames,sec_objc_meth_var_names))); + list.Concat(Tai_const.Create_sym( + objcreatestringpoolentry(objcencodemethod(m),sp_objcvartypes,sec_objc_meth_var_types))); + { placeholder for address of implementation? } + if (abi=oa_nonfragile) then + list.Concat(Tai_const.Create_pint(0)); + end; +end; + + +{ Generate the rtti sections for all obj-c classes defined in st, and return + these classes in the classes list. } +procedure tobjcrttiwriter.gen_objc_rtti_sections(list:TAsmList; st:TSymtable); + var + i: longint; + def: tdef; + sym : TAsmSymbol; + begin + if not Assigned(st) then + exit; + + for i:=0 to st.DefList.Count-1 do + begin + def:=tdef(st.DefList[i]); + { check whether all types used in Objective-C class/protocol/category + declarations can be used with the Objective-C run time (can only be + done now, because at parse-time some of these types can still be + forwarddefs) } + if is_objc_class_or_protocol(def) then + if not tobjectdef(def).check_objc_types then + continue; + if is_objcclass(def) and + not(oo_is_external in tobjectdef(def).objectoptions) then + begin + if not(oo_is_classhelper in tobjectdef(def).objectoptions) then + begin + gen_objc_classes_sections(list,tobjectdef(def),sym); + classsyms.add(sym); + classdefs.add(def); + end + else + begin + gen_objc_category_sections(list,tobjectdef(def),sym); + catsyms.add(sym); + catdefs.add(def); + end + end; + end; + end; + + +constructor tobjcrttiwriter.create(_abi: tobjcabi); + begin + fabi:=_abi; + classdefs:=tfpobjectlist.create(false); + classsyms:=tfpobjectlist.create(false); + catdefs:=tfpobjectlist.create(false); + catsyms:=tfpobjectlist.create(false); + end; + + +destructor tobjcrttiwriter.destroy; + begin + classdefs.free; + classsyms.free; + catdefs.free; + catsyms.free; + inherited destroy; + end; + +{****************************************************************** + RTTI generation -- Fragile ABI +*******************************************************************} + +{ generate an instance variables list for an obj-c class. } +procedure tobjcrttiwriter_fragile.gen_objc_ivars(list: TAsmList; objccls: tobjectdef; out ivarslabel: TAsmLabel); + type + ivar_data = record + vf : tfieldvarsym; + namesym : TAsmSymbol; + typesym : TAsmSymbol; + end; + var + i : integer; + vf : tfieldvarsym; + vars : array of ivar_data; + vcnt : Integer; + enctype : ansistring; + encerr : tdef; + begin + ivarslabel:=nil; + + vcnt:=0; + setLength(vars,objccls.symtable.SymList.Count); + + for i:=0 to objccls.symtable.SymList.Count-1 do + if tsym(objccls.symtable.SymList[i]).typ=fieldvarsym then + begin + vf:=tfieldvarsym(objccls.symtable.SymList[i]); + if objctryencodetype(vf.vardef,enctype,encerr) then + begin + vars[vcnt].vf:=vf; + vars[vcnt].namesym:=objcreatestringpoolentry(vf.RealName,sp_objcvarnames,sec_objc_meth_var_names); + vars[vcnt].typesym:=objcreatestringpoolentry(enctype,sp_objcvartypes,sec_objc_meth_var_types); + inc(vcnt); + end + else + { Should be caught during parsing } + internalerror(2009090601); + end; + if vcnt=0 then + exit; + + new_section(list,sec_objc_instance_vars,'_OBJC_INSTANCE_VARS',sizeof(pint)); + + current_asmdata.getlabel(ivarslabel,alt_data); + list.Concat(tai_label.Create(ivarslabel)); + + { objc_ivar_list: first the number of elements } + list.Concat(tai_const.Create_32bit(vcnt)); + + for i:=0 to vcnt-1 do + begin + { reference to the instance variable name } + list.Concat(tai_const.Create_sym(vars[i].namesym)); + { reference to the encoded type } + list.Concat(tai_const.Create_sym(vars[i].typesym)); + { and the offset of the field } + list.Concat(tai_const.Create_32bit(vars[i].vf.fieldoffset)); + end; + end; + + +(* From GCC: + + struct _objc_protocol_extension + { + uint32_t size; // sizeof (struct _objc_protocol_extension) + struct objc_method_list *optional_instance_methods; + struct objc_method_list *optional_class_methods; + struct objc_prop_list *instance_properties; + } +*) +function tobjcrttiwriter_fragile.gen_objc_protocol_ext(list: TAsmList; optinstsym, optclssym: TAsmLabel): TAsmLabel; + begin + if assigned(optinstsym) or + assigned(optclssym) then + begin + new_section(list, sec_objc_protocol_ext,'_OBJC_PROTOCOLEXT',sizeof(pint)); + current_asmdata.getlabel(Result,alt_data); + list.Concat(tai_label.Create(Result)); + { size of this structure } + list.Concat(Tai_const.Create_32bit(16)); + { optional instance methods } + ConcatSymOrNil(list,optinstsym); + { optional class methods } + ConcatSymOrNil(list,optclssym); + { optional properties (todo) } + ConcatSymOrNil(list,nil); + end + else + Result:=nil; + end; + + +{ Generate rtti for an Objective-C protocol } +procedure tobjcrttiwriter_fragile.gen_objc_protocol(list:TAsmList; protocol: tobjectdef; out protocollabel: TAsmSymbol); + var + namesym : TAsmSymbol; + protolist : TAsmLabel; + reqinstsym, + optinstsym, + reqclssym, + optclssym, + protoext, + lbl : TAsmLabel; + begin + gen_objc_protocol_list(list,protocol.ImplementedInterfaces,protolist); + gen_objc_protocol_elements(list,protocol,reqinstsym,optinstsym,reqclssym,optclssym); + protoext:=gen_objc_protocol_ext(list,optinstsym,optclssym); + + new_section(list, sec_objc_protocol,'_OBJC_PROTOCOL',sizeof(pint)); + current_asmdata.getlabel(lbl,alt_data); + list.Concat(tai_label.Create(lbl)); + protocollabel:=lbl; + + { protocol's isa - points to information about optional methods/properties } + ConcatSymOrNil(list,protoext); + { name } + namesym:=objcreatestringpoolentry(protocol.objextname^,sp_objcclassnames,sec_objc_class_names); + list.Concat(Tai_const.Create_sym(namesym)); + { protocol's list } + ConcatSymOrNil(list,protolist); + { instance methods, in __cat_inst_meth } + ConcatSymOrNil(list,reqinstsym); + { class methods, in __cat_cls_meth } + ConcatSymOrNil(list,reqclssym); + end; + + +(* +From Clang: + + struct _objc_category { + char *category_name; + char *class_name; + struct _objc_method_list *instance_methods; + struct _objc_method_list *class_methods; + struct _objc_protocol_list *protocols; + uint32_t size; // <rdar://4585769> + struct _objc_property_list *instance_properties; + }; +*) + +{ Generate rtti for an Objective-C class and its meta-class. } +procedure tobjcrttiwriter_fragile.gen_objc_category_sections(list:TAsmList; objccat: tobjectdef; out catlabel: TAsmSymbol); + var + instmthdlist, + clsmthdlist, + protolistsym : TAsmLabel; + catstrsym, + clsstrsym, + catsym : TAsmSymbol; + begin + { the category name } + catstrsym:=objcreatestringpoolentry(objccat.objextname^,sp_objcclassnames,sec_objc_class_names); + + { the name of the class it extends } + clsstrsym:=objcreatestringpoolentry(objccat.childof.objextname^,sp_objcclassnames,sec_objc_class_names); + + { generate the methods lists } + gen_objc_methods(list,objccat,instmthdlist,false,true); + gen_objc_methods(list,objccat,clsmthdlist,true,true); + + { generate implemented protocols list } + gen_objc_protocol_list(list,objccat.ImplementedInterfaces,protolistsym); + + { category declaration section } + new_section(list,sec_objc_category,'_OBJC_CATEGORY',sizeof(pint)); + catsym:=current_asmdata.DefineAsmSymbol(objccat.rtti_mangledname(objcclassrtti),AB_LOCAL,AT_DATA); + list.Concat(tai_symbol.Create(catsym,0)); + + list.Concat(Tai_const.Create_sym(catstrsym)); + list.Concat(Tai_const.Create_sym(clsstrsym)); + ConcatSymOrNil(list,instmthdlist); + ConcatSymOrNil(list,clsmthdlist); + ConcatSymOrNil(list,protolistsym); + { size of this structure } + list.Concat(Tai_const.Create_32bit(28)); + { properties, not yet supported } + list.Concat(Tai_const.Create_32bit(0)); + + catlabel:=catsym; + end; + +(* +From Clang: + + struct _objc_class { + Class isa; + Class super_class; + const char *name; + long version; + long info; + long instance_size; + struct _objc_ivar_list *ivars; + struct _objc_method_list *methods; + struct _objc_cache *cache; + struct _objc_protocol_list *protocols; + // Objective-C 1.0 extensions (<rdr://4585769>) -- for garbage collection + const char *ivar_layout; + struct _objc_class_ext *ext; + }; +*) + + + +{ Generate rtti for an Objective-C class and its meta-class. } +procedure tobjcrttiwriter_fragile.gen_objc_classes_sections(list:TAsmList; objclss: tobjectdef; out classlabel: TAsmSymbol); + const + CLS_CLASS = 1; + CLS_META = 2; + CLS_HIDDEN = $20000; + META_INST_SIZE = 40+8; // sizeof(objc_class) + 8 + var + root : tobjectdef; + superStrSym, + classStrSym, + metaisaStrSym, + metasym, + clssym : TAsmSymbol; + mthdlist, + ivarslist, + protolistsym : TAsmLabel; + hiddenflag : cardinal; + begin + { generate the class methods list } + gen_objc_methods(list,objclss,mthdlist,true,false); + + { generate implemented protocols list } + gen_objc_protocol_list(list,objclss.ImplementedInterfaces,protolistsym); + + { register necessary names } + { 1) the superclass } + if assigned(objclss.childof) then + superStrSym:=objcreatestringpoolentry(objclss.childof.objextname^,sp_objcclassnames,sec_objc_class_names) + else + { not empty string, but nil! } + superStrSym:=nil; + + { 2) the current class } + classStrSym:=objcreatestringpoolentry(objclss.objextname^,sp_objcclassnames,sec_objc_class_names); + { 3) the isa } + { From Clang: The isa for the meta-class is the root of the hierarchy. } + root:=objclss; + while assigned(root.childof) do + root:=root.childof; + metaisaStrSym:=objcreatestringpoolentry(root.objextname^,sp_objcclassnames,sec_objc_class_names); + + { 4) the flags } + { consider every class declared in the implementation section of a unit + as "hidden" + } + hiddenflag:=0; + if (objclss.owner.symtabletype=staticsymtable) and + current_module.is_unit then + hiddenflag:=CLS_HIDDEN; + + { class declaration section } + new_section(list,sec_objc_meta_class,'_OBJC_META_CLASS',sizeof(pint)); + + { 1) meta-class declaration } + metasym:=current_asmdata.DefineAsmSymbol(objclss.rtti_mangledname(objcmetartti),AB_LOCAL,AT_DATA); + list.Concat(tai_symbol.Create(metasym,0)); + + list.Concat(Tai_const.Create_sym(metaisaStrSym)); + { pointer to the superclass name if any, otherwise nil } + if assigned(superstrsym) then + list.Concat(Tai_const.Create_sym(superStrSym)) + else + list.concat(tai_const.create_32bit(0)); + { pointer to the class name } + list.Concat(Tai_const.Create_sym(classStrSym)); + + { version is always 0 currently } + list.Concat(Tai_const.Create_32bit(0)); + { CLS_META for meta-classes } + list.Concat(Tai_const.Create_32bit(hiddenflag or CLS_META)); + { size of the meta-class instance: sizeof(objc_class) + 8 bytes } + list.Concat(Tai_const.Create_32bit(META_INST_SIZE) ); + { meta-classes don't have ivars list (=0) } + list.Concat(Tai_const.Create_32bit(0)); + { class methods list (stored in "__cls_meth" section) } + if Assigned(mthdlist) then + list.Concat(Tai_const.Create_sym(mthdlist)) + else + list.Concat(Tai_const.Create_32bit(0)); + { From Clang: cache is always nil } + list.Concat(Tai_const.Create_32bit(0)); + { protocols } + ConcatSymOrNil(list, protolistsym); + { From Clang: ivar_layout for meta-class is always NULL. } + list.Concat(Tai_const.Create_32bit(0)); + { From Clang: The class extension is always unused for meta-classes. } + list.Concat(Tai_const.Create_32bit(0)); + + { 2) regular class declaration } + + { generate the instance methods list } + gen_objc_methods(list,objclss,mthdlist,false,false); + { generate the instance variables list } + gen_objc_ivars(list,objclss,ivarslist); + + new_section(list,sec_objc_class,'_OBJC_CLASS',sizeof(pint)); + + clssym:=current_asmdata.DefineAsmSymbol(objclss.rtti_mangledname(objcclassrtti),AB_LOCAL,AT_DATA); + list.Concat(tai_symbol.Create(clssym,0)); + + { for class declaration: the isa points to the meta-class declaration } + list.Concat(Tai_const.Create_sym(metasym)); + { pointer to the super_class name if any, nil otherwise } + if assigned(superStrSym) then + list.Concat(Tai_const.Create_sym(superStrSym)) + else + list.Concat(Tai_const.Create_32bit(0)); + { pointer to the class name } + list.Concat(Tai_const.Create_sym(classStrSym)); + { version is always 0 currently } + list.Concat(Tai_const.Create_32bit(0)); + { CLS_CLASS for classes } + list.Concat(Tai_const.Create_32bit(hiddenflag or CLS_CLASS)); + { size of instance: total size of instance variables } + list.Concat(Tai_const.Create_32bit(tobjectsymtable(objclss.symtable).datasize)); + { objc_ivar_list (stored in "__instance_vars" section) } + if assigned(ivarslist) then + list.Concat(Tai_const.Create_sym(ivarslist)) + else + list.Concat(tai_const.create_32bit(0)); + { instance methods list (stored in "__inst_meth" section) } + if Assigned(mthdlist) then + list.Concat(Tai_const.Create_sym(mthdlist)) + else + list.Concat(Tai_const.Create_32bit(0)); + { From Clang: cache is always NULL } + list.Concat(Tai_const.Create_32bit(0)); + { protocols, protolistsym has been created for meta-class, no need to create another one} + ConcatSymOrNil(list, protolistsym); + { TODO: From Clang: strong ivar_layout, necessary for garbage collection support } + list.Concat(Tai_const.Create_32bit(0)); + { TODO: From Clang: weak ivar_layout, necessary for garbage collection support } + list.Concat(Tai_const.Create_32bit(0)); + + classlabel:=clssym; + end; + + +{ Generate the global information sections (objc_symbols and objc_module_info) + for this module. } +procedure tobjcrttiwriter_fragile.gen_objc_info_sections(list: tasmlist); + var + i: longint; + sym : TAsmSymbol; + parent: tobjectdef; + superclasses: tfpobjectlist; + begin + if (classsyms.count<>0) or + (catsyms.count<>0) then + begin + new_section(list,sec_objc_symbols,'_OBJC_SYMBOLS',sizeof(pint)); + sym := current_asmdata.DefineAsmSymbol(target_asm.labelprefix+'_OBJC_SYMBOLS_$',AB_LOCAL,AT_DATA); + + { symbol to refer to this information } + list.Concat(tai_symbol.Create(sym,0)); + { ??? (always 0 in Clang) } + list.Concat(Tai_const.Create_pint(0)); + { ??? (From Clang: always 0, pointer to some selector) } + list.Concat(Tai_const.Create_pint(0)); + { From Clang: number of defined classes } + list.Concat(Tai_const.Create_16bit(classsyms.count)); + { From Clang: number of defined categories } + list.Concat(Tai_const.Create_16bit(catsyms.count)); + { first all classes } + for i:=0 to classsyms.count-1 do + list.Concat(Tai_const.Create_sym(tasmsymbol(classsyms[i]))); + { then all categories } + for i:=0 to catsyms.count-1 do + list.Concat(Tai_const.Create_sym(tasmsymbol(catsyms[i]))); + end + else + sym:=nil; + + new_section(list,sec_objc_module_info,'_OBJC_MODULE_INFO',4); + { version number = 7 (always, both for gcc and clang) } + list.Concat(Tai_const.Create_pint(7)); + { sizeof(objc_module): 4 pointer-size entities } + list.Concat(Tai_const.Create_pint(sizeof(pint)*4)); + { used to be file name, now unused (points to empty string) } + list.Concat(Tai_const.Create_sym(objcreatestringpoolentry('',sp_objcclassnames,sec_objc_class_names))); + { pointer to classes/categories list declared in this module } + if assigned(sym) then + list.Concat(Tai_const.Create_sym(sym)) + else + list.concat(tai_const.create_pint(0)); + + { Add lazy references to parent classes of all classes defined in this unit } + superclasses:=tfpobjectlist.create(false); + for i:=0 to classdefs.count-1 do + begin + parent:=tobjectdef(classdefs[i]).childof; + { warning: linear search, performance hazard if large number of subclasses } + if assigned(parent) and + (superclasses.indexof(parent)=-1) then + begin + list.concat(tai_directive.create(asd_lazy_reference,'.objc_class_name_'+parent.objextname^)); + superclasses.add(parent); + end; + end; + for i:=0 to catdefs.count-1 do + begin + parent:=tobjectdef(catdefs[i]).childof; + { warning: linear search, performance hazard if large number of subclasses } + if assigned(parent) and + (superclasses.indexof(parent)=-1) then + begin + list.concat(tai_directive.create(asd_lazy_reference,'.objc_class_name_'+parent.objextname^)); + superclasses.add(parent); + end; + end; + superclasses.free; + { reference symbols for all classes and categories defined in this unit } + for i:=0 to classdefs.count-1 do + list.concat(tai_symbol.Createname_global_value('.objc_class_name_'+tobjectdef(classdefs[i]).objextname^,AT_DATA,0,0)); + for i:=0 to catdefs.count-1 do + list.concat(tai_symbol.Createname_global_value('.objc_category_name_'+ + tobjectdef(catdefs[i]).childof.objextname^+'_'+ + tobjectdef(catdefs[i]).objextname^,AT_DATA,0,0)); + end; + + +constructor tobjcrttiwriter_fragile.create; + begin + inherited create(oa_fragile); + end; + + +{****************************************************************** + RTTI generation -- Non-Fragile ABI +*******************************************************************} + +(* +From Clang: +/// EmitIvarList - Emit the ivar list for the given +/// implementation. The return value has type +/// IvarListnfABIPtrTy. +/// struct _ivar_t { +/// unsigned long int *offset; // pointer to ivar offset location +/// char *name; +/// char *type; +/// uint32_t alignment; +/// uint32_t size; +/// } +/// struct _ivar_list_t { +/// uint32 entsize; // sizeof(struct _ivar_t) +/// uint32 count; +/// struct _iver_t list[count]; +/// } +/// +*) +procedure tobjcrttiwriter_nonfragile.gen_objc_ivars(list: tasmlist; objccls: tobjectdef; out ivarslabel: tasmlabel); + type + ivar_data = record + vf : tfieldvarsym; + namesym : TAsmSymbol; + typesym : TAsmSymbol; + offssym : TAsmSymbol; + end; + var + ivtype: tdef; + vf : tfieldvarsym; + vars : array of ivar_data; + i : integer; + vcnt : integer; + enctype : ansistring; + encerr : tdef; + prefix : shortstring; + vis : TAsmsymbind; + begin + ivarslabel:=nil; + + vcnt:=0; + setLength(vars,objccls.symtable.SymList.Count); + + for i:=0 to objccls.symtable.SymList.Count-1 do + if tsym(objccls.symtable.SymList[i]).typ=fieldvarsym then + begin + vf:=tfieldvarsym(objccls.symtable.SymList[i]); + if objctryencodetype(vf.vardef,enctype,encerr) then + begin + vars[vcnt].vf:=vf; + vars[vcnt].namesym:=objcreatestringpoolentry(vf.RealName,sp_objcvarnames,sec_objc_meth_var_names); + vars[vcnt].typesym:=objcreatestringpoolentry(enctype,sp_objcvartypes,sec_objc_meth_var_types); + if (vcnt=0) then + begin + new_section(list,sec_objc_const,'_OBJC_IVAR_OFFSETS',sizeof(pint)); + prefix:=target_info.cprefix+'OBJC_IVAR_$_'+objccls.objextname^+'.'; + end; + { This matches gcc/Clang, but is strange: I would expect private + fields to be local symbols rather than private_extern (which + is "package-global") (JM) + } + if not(vf.visibility in [vis_public,vis_protected,vis_strictprotected]) then + vis:=AB_PRIVATE_EXTERN + else + vis:=AB_GLOBAL; + vars[vcnt].offssym:=current_asmdata.DefineAsmSymbol(prefix+vf.RealName,vis,AT_DATA); + list.concat(tai_symbol.Create_Global(vars[vcnt].offssym,0)); + list.concat(tai_const.create_pint(vf.fieldoffset)); + inc(vcnt); + end + else + { must be caught during parsing } + internalerror(2009092301); + end; + if vcnt=0 then + exit; + + new_section(list,sec_objc_instance_vars,'_OBJC_INSTANCE_VARS',sizeof(pint)); + + current_asmdata.getlabel(ivarslabel,alt_data); + list.Concat(tai_label.Create(ivarslabel)); + + { size of each entry -- always 32 bit value } + ivtype:=search_named_unit_globaltype('OBJC','OBJC_IVAR',true).typedef; + list.concat(tai_const.Create_32bit(ivtype.size)); + { number of entries -- always 32 bit value } + list.Concat(tai_const.Create_32bit(vcnt)); + + for i:=0 to vcnt-1 do + begin + { reference to the offset } + list.Concat(tai_const.Create_sym(vars[i].offssym)); + { reference to the instance variable name } + list.Concat(tai_const.Create_sym(vars[i].namesym)); + { reference to the encoded type } + list.Concat(tai_const.Create_sym(vars[i].typesym)); + { alignment -- always 32 bit value } + list.Concat(tai_const.create_32bit(vars[i].vf.vardef.alignment)); + { size -- always 32 bit value } + list.Concat(tai_const.Create_32bit(vars[i].vf.vardef.size)); + end; + end; + + +(* +From Clang: +/// GetOrEmitProtocol - Generate the protocol meta-data: +/// @code +/// struct _protocol_t { +/// id isa; // NULL +/// const char * const protocol_name; +/// const struct _protocol_list_t * protocol_list; // super protocols +/// const struct method_list_t * const instance_methods; +/// const struct method_list_t * const class_methods; +/// const struct method_list_t *optionalInstanceMethods; +/// const struct method_list_t *optionalClassMethods; +/// const struct _prop_list_t * properties; +/// const uint32_t size; // sizeof(struct _protocol_t) +/// const uint32_t flags; // = 0 +/// } +/// @endcode +*) +procedure tobjcrttiwriter_nonfragile.gen_objc_protocol(list: tasmlist; protocol: tobjectdef; out protocollabel: tasmsymbol); + var + lbl, + namesym, + listsym : TAsmSymbol; + protolist : TAsmLabel; + reqinstsym, + reqclssym, + optinstsym, + optclssym : TAsmLabel; + prottype : tdef; + begin + gen_objc_protocol_list(list,protocol.ImplementedInterfaces,protolist); + gen_objc_protocol_elements(list,protocol,reqinstsym,optinstsym,reqclssym,optclssym); + + new_section(list, sec_data_coalesced,'_OBJC_PROTOCOL',sizeof(pint)); + { label for the protocol needs to be + a) in a coalesced section (so multiple definitions of the same protocol + can be merged by the linker) + b) private_extern (should only be merged within the same module) + c) weakly defined (so multiple definitions don't cause errors) + } + lbl:=current_asmdata.DefineAsmSymbol(protocol.rtti_mangledname(objcclassrtti),AB_PRIVATE_EXTERN,AT_DATA); + list.Concat(tai_symbol.Create_Global(lbl,0)); + list.Concat(tai_directive.Create(asd_weak_definition,lbl.name)); + protocollabel:=lbl; + + { protocol's isa - always nil } + list.Concat(Tai_const.Create_pint(0)); + { name } + namesym:=objcreatestringpoolentry(protocol.objextname^,sp_objcclassnames,sec_objc_class_names); + list.Concat(Tai_const.Create_sym(namesym)); + { parent protocols list } + ConcatSymOrNil(list,protolist); + { required instance methods } + ConcatSymOrNil(list,reqinstsym); + { required class methods } + ConcatSymOrNil(list,reqclssym); + { optional instance methods } + ConcatSymOrNil(list,optinstsym); + { optional class methods } + ConcatSymOrNil(list,optclssym); + { TODO: properties } + list.Concat(Tai_const.Create_pint(0)); + { size of this type } + prottype:=search_named_unit_globaltype('OBJC','OBJC_PROTOCOL',true).typedef; + list.concat(tai_const.Create_32bit(prottype.size)); + { flags } + list.concat(tai_const.Create_32bit(0)); + + { also add an entry to the __DATA, __objc_protolist section, required to + register the protocol with the runtime } + new_section(list, sec_objc_protolist,'_OBJC_PROTOLIST',sizeof(pint)); + listsym:=current_asmdata.DefineAsmSymbol(protocol.rtti_mangledname(objcmetartti),AB_PRIVATE_EXTERN,AT_DATA); + list.Concat(tai_symbol.Create_Global(listsym,0)); + list.Concat(tai_const.Create_sym(lbl)); + list.Concat(tai_directive.Create(asd_weak_definition,listsym.name)); + end; + +(* +From Clang: +/// struct _category_t { +/// const char * const name; +/// struct _class_t *const cls; +/// const struct _method_list_t * const instance_methods; +/// const struct _method_list_t * const class_methods; +/// const struct _protocol_list_t * const protocols; +/// const struct _prop_list_t * const properties; +/// } +*) +procedure tobjcrttiwriter_nonfragile.gen_objc_category_sections(list:TAsmList; objccat: tobjectdef; out catlabel: TAsmSymbol); + var + instmthdlist, + clsmthdlist, + protolistsym : TAsmLabel; + catstrsym, + clssym, + catsym : TAsmSymbol; + begin + { the category name } + catstrsym:=objcreatestringpoolentry(objccat.objextname^,sp_objcclassnames,sec_objc_class_names); + + { the class it extends } + clssym:=current_asmdata.RefAsmSymbol(objccat.childof.rtti_mangledname(objcclassrtti)); + + { generate the methods lists } + gen_objc_methods(list,objccat,instmthdlist,false,true); + gen_objc_methods(list,objccat,clsmthdlist,true,true); + + { generate implemented protocols list } + gen_objc_protocol_list(list,objccat.ImplementedInterfaces,protolistsym); + + { category declaration section } + new_section(list,sec_objc_const,'_OBJC_CATEGORY',sizeof(pint)); + catsym:=current_asmdata.DefineAsmSymbol(objccat.rtti_mangledname(objcclassrtti),AB_LOCAL,AT_DATA); + list.Concat(tai_symbol.Create(catsym,0)); + + list.Concat(Tai_const.Create_sym(catstrsym)); + list.Concat(Tai_const.Create_sym(clssym)); + ConcatSymOrNil(list,instmthdlist); + ConcatSymOrNil(list,clsmthdlist); + ConcatSymOrNil(list,protolistsym); + { properties, not yet supported } + list.Concat(Tai_const.Create_pint(0)); + + catlabel:=catsym; + end; + + +(* +From Clang: +/// BuildIvarLayout - Builds ivar layout bitmap for the class +/// implementation for the __strong or __weak case. +/// The layout map displays which words in ivar list must be skipped +/// and which must be scanned by GC (see below). String is built of bytes. +/// Each byte is divided up in two nibbles (4-bit each). Left nibble is count +/// of words to skip and right nibble is count of words to scan. So, each +/// nibble represents up to 15 workds to skip or scan. Skipping the rest is +/// represented by a 0x00 byte which also ends the string. +/// 1. when ForStrongLayout is true, following ivars are scanned: +/// - id, Class +/// - object * // note: this "object" means "Objective-C object" (JM) +/// - __strong anything +/// +/// 2. When ForStrongLayout is false, following ivars are scanned: +/// - __weak anything +*) +(* + +Only required when supporting garbage collection + +procedure tobjcrttiwriter_nonfragile.gen_objc_ivargc_recursive(st: tabstractrecordsymtable; ptrbset: tbitset; startoffset: puint; il: tivarlayouttype); +var + i: longint; + fs: tfieldvarsym; + includelen: longint; +begin + for i:=0 to st.SymList.count-1 do + if (tsym(st.symlist[i]).typ=fieldvarsym) then + begin + fs:=tfieldvarsym(st.symlist[i]); + includelen:=0; + case fs.vardef.typ of + pointerdef, + classrefdef: + if (fs.vardef=objc_idtype) or + (fs.vardef=objc_metaclasstype) then + includelen:=1; + recorddef: + TODO: bitpacking -> offset differences + gen_objc_ivargc_recursive(tabstractrecordsymtable(trecorddef(fs.vardef).symtable),ptrbset,startoffset+fs.fieldoffset,il); + arraydef: + begin + if not is_special_ + end; + objectdef : + begin + case tobjectdef(fs.vardef).objecttype of + odt_objcclass, + odt_objcprotocol: + includelen:=1; + odt_object: + gen_objc_ivargc_recursive(tabstractrecordsymtable(tobjectdef(fs.vardef).symtable),ptrbset,startoffset+fs.fieldoffset,il); + end; + end; + end; + end; +end; + + +function tobjcrttiwriter_nonfragile.gen_objc_ivargcstring(objclss: tobjectdef; il: tivarlayouttype): ansistring; + var + ptrbset: tbitset; + parent: tobjectdef; + size, + startoffset: puint; + i: longint; + begin + size:=tObjectSymtable(objclss.symtable).datasize; + if assigned(objclss.childof) then + startoffset:=tObjectSymtable(objclss.childof.symtable).datasize + else + startoffset:=0; + size:=size-startoffset; + ptrbset:=tbitset.create_bytesize((size+sizeof(ptruint)-1) div sizeof(ptruint)); + { has to include info for this class' fields and those of all parent + classes as well + } + parent:=obclss; + repeat + gen_objc_ivargc_recursive(parent.symtable,ptrbset,0,il); + parent:=parent.childof; + until not assigned(parent); + { convert bits set to encoded string } + end; +*) + +(* +From Clang: +/// struct _class_ro_t { +/// uint32_t const flags; +/// uint32_t const instanceStart; +/// uint32_t const instanceSize; +/// uint32_t const reserved; // only when building for 64bit targets +/// const uint8_t * const ivarLayout; +/// const char *const name; +/// const struct _method_list_t * const baseMethods; +/// const struct _protocol_list_t *const baseProtocols; +/// const struct _ivar_list_t *const ivars; +/// const uint8_t * const weakIvarLayout; +/// const struct _prop_list_t * const properties; +/// } +*) + +procedure tobjcrttiwriter_nonfragile.gen_objc_class_ro_part(list: tasmlist; objclss: tobjectdef; protolistsym: TAsmSymbol; out classrolabel: tasmsymbol; metaclass: boolean); + const + CLS_CLASS = 0; + CLS_META = 1; + CLS_ROOT = 2; + OBJC2_CLS_HIDDEN = $10; + CLS_EXCEPTION = $20; + var + classStrSym, + rosym : TAsmSymbol; + methodslab, + ivarslab : TAsmLabel; + class_type : tdef; + start, + size, + flags : cardinal; + rttitype : trttitype; + firstfield : tfieldvarsym; + i : longint; + begin + { consider every class declared in the implementation section of a unit + as "hidden" + } + flags:=0; + if (objclss.owner.symtabletype=staticsymtable) and + current_module.is_unit then + flags:=OBJC2_CLS_HIDDEN; + if metaclass then + begin + flags:=flags or CLS_META; + rttitype:=objcmetarortti; + { metaclass size/start: always size of objc_object } + class_type:=search_named_unit_globaltype('OBJC','OBJC_OBJECT',true).typedef; + start:=class_type.size; + size:=start; + end + else + begin + flags:=flags or CLS_CLASS; + rttitype:=objcclassrortti; + size:=tObjectSymtable(objclss.symtable).datasize; + { can't simply use childof's datasize, because alignment may cause the + first field to skip a couple of bytes after the previous end } + firstfield:=nil; + for i:=0 to objclss.symtable.SymList.Count-1 do + if (tsym(objclss.symtable.SymList[i]).typ=fieldvarsym) then + begin + firstfield:=tfieldvarsym(objclss.symtable.SymList[i]); + break; + end; + if assigned(firstfield) then + start:=firstfield.fieldoffset + else + { no extra fields -> start = size } + start:=size; + end; + if not assigned(objclss.childof) then + flags:=flags or CLS_ROOT; + + classStrSym:=objcreatestringpoolentry(objclss.objextname^,sp_objcclassnames,sec_objc_class_names); + { generate methods list } + gen_objc_methods(list,objclss,methodslab,metaclass,false); + { generate ivars (nil for metaclass) } + if metaclass then + ivarslab:=nil + else + gen_objc_ivars(list,objclss,ivarslab); + + { class declaration section } + new_section(list,sec_objc_const,'_OBJC_META_CLASS',sizeof(pint)); + + rosym:=current_asmdata.DefineAsmSymbol(objclss.rtti_mangledname(rttitype),AB_LOCAL,AT_DATA); + classrolabel:=rosym; + list.Concat(tai_symbol.create(rosym,0)); + list.Concat(tai_const.Create_32bit(longint(flags))); + list.Concat(tai_const.Create_32bit(longint(start))); + list.Concat(tai_const.Create_32bit(longint(size))); +{$ifdef cpu64bitaddr} + { alignment } + list.Concat(tai_const.Create_32bit(0)); +{$endif} + { TODO: strong ivar layout for garbage collection } + list.concat(tai_const.Create_pint(0)); + list.concat(tai_const.Create_sym(classStrSym)); + ConcatSymOrNil(list,methodslab); + ConcatSymOrNil(list,protolistsym); + ConcatSymOrNil(list,ivarslab); + { TODO: weak ivar layout for garbage collection } + list.concat(tai_const.Create_pint(0)); + { TODO: properties } + list.concat(tai_const.Create_pint(0)); + end; + + +(* +From Clang: + +/// struct _class_t { +/// struct _class_t *isa; +/// struct _class_t * const superclass; +/// void *cache; +/// IMP *vtable; +/// struct class_ro_t *ro; +/// } +/// +*) + +{ Generate rtti for an Objective-C class and its meta-class. } +procedure tobjcrttiwriter_nonfragile.gen_objc_classes_sections(list:TAsmList; objclss: tobjectdef; out classlabel: TAsmSymbol); + var + root : tobjectdef; + superSym, + superMetaSym, + metaisaSym, + metasym, + clssym, + metarosym, + rosym : TAsmSymbol; + protolistsym : TAsmLabel; + vis : TAsmsymbind; + begin + { A) Register necessary names } + + { 1) the current class and metaclass } + if (objclss.owner.symtabletype=globalsymtable) then + vis:=AB_GLOBAL + else + vis:=AB_PRIVATE_EXTERN; + clssym:=current_asmdata.DefineAsmSymbol(objclss.rtti_mangledname(objcclassrtti),vis,AT_DATA); + metasym:=current_asmdata.DefineAsmSymbol(objclss.rtti_mangledname(objcmetartti),vis,AT_DATA); + { 2) the superclass and meta superclass } + if assigned(objclss.childof) then + begin + superSym:=current_asmdata.RefAsmSymbol(objclss.childof.rtti_mangledname(objcclassrtti)); + superMetaSym:=current_asmdata.RefAsmSymbol(objclss.childof.rtti_mangledname(objcmetartti)); + end + else + begin + superSym:=nil; + { the class itself } + superMetaSym:=clssym; + end; + + { 3) the isa } + { From Clang: The isa for the meta-class is the root of the hierarchy. } + root:=objclss; + while assigned(root.childof) do + root:=root.childof; + metaisaSym:=current_asmdata.RefAsmSymbol(root.rtti_mangledname(objcmetartti)); + + { 4) the implemented protocols (same for metaclass and regular class) } + gen_objc_protocol_list(list,objclss.ImplementedInterfaces,protolistsym); + + { 5) the read-only parts of the class definitions } + gen_objc_class_ro_part(list,objclss,protolistsym,metarosym,true); + gen_objc_class_ro_part(list,objclss,protolistsym,rosym,false); + + { B) Class declaration section } + { both class and metaclass are in the objc_data section for obj-c 2 } + new_section(list,sec_objc_data,'_OBJC_CLASS',sizeof(pint)); + + { 1) meta-class declaration } + list.Concat(tai_symbol.Create_Global(metasym,0)); + + { the isa } + list.Concat(Tai_const.Create_sym(metaisaSym)); + { the superclass } + list.Concat(Tai_const.Create_sym(superMetaSym)); + { pointer to cache } + if not assigned(ObjCEmptyCacheVar) then + ObjCEmptyCacheVar:=current_asmdata.RefAsmSymbol(target_info.Cprefix+'_objc_empty_cache'); + list.Concat(Tai_const.Create_sym(ObjCEmptyCacheVar)); + { pointer to vtable } + if not assigned(ObjCEmptyVtableVar) then + ObjCEmptyVtableVar:=current_asmdata.RefAsmSymbol(target_info.Cprefix+'_objc_empty_vtable'); + list.Concat(Tai_const.Create_sym(ObjCEmptyVtableVar)); + { the read-only part } + list.Concat(Tai_const.Create_sym(metarosym)); + + { 2) regular class declaration } + list.Concat(tai_symbol.Create_Global(clssym,0)); + + { the isa } + list.Concat(Tai_const.Create_sym(metasym)); + { the superclass } + list.Concat(Tai_const.Create_sym(superSym)); + { pointer to cache } + list.Concat(Tai_const.Create_sym(ObjCEmptyCacheVar)); + { pointer to vtable } + list.Concat(Tai_const.Create_sym(ObjCEmptyVtableVar)); + { the read-only part } + list.Concat(Tai_const.Create_sym(rosym)); + + classlabel:=clssym; + end; + + +procedure tobjcrttiwriter_nonfragile.addclasslist(list: tasmlist; section: tasmsectiontype; const symname: string; classes: tfpobjectlist); + var + i: longint; + sym: TAsmSymbol; + begin + if classes.count=0 then + exit; + new_section(list,section,symname,sizeof(pint)); + sym:=current_asmdata.DefineAsmSymbol(symname,AB_LOCAL,AT_DATA); + list.concat(tai_symbol.Create(sym,0)); + for i:=0 to classes.count-1 do + list.concat(tai_const.Create_sym(current_asmdata.RefAsmSymbol(tobjectdef(classes[i]).rtti_mangledname(objcclassrtti)))); + end; + + +procedure tobjcrttiwriter_nonfragile.gen_objc_info_sections(list: tasmlist); + + function collectnonlazyclasses(classes: tfpobjectlist): tfpobjectlist; + var + symentry : tsym; + procdef : tprocdef; + i,j : longint; + begin + { non-lazy classes are all classes that define a class method with the + selector called "load" (simply inheriting this class method is not enough, + they have to implement it themselves) + + -- TODO: this currently only works if the Pascal identifier is also 'load'! } + result:=tfpobjectlist.create(false); + for i:=0 to classes.count-1 do + begin + symentry:=tsym(tobjectsymtable(tobjectdef(classes[i]).symtable).find('LOAD')); + if assigned(symentry) and + (symentry.typ=procsym) then + begin + for j:=0 to tprocsym(symentry).ProcdefList.count do + begin + procdef:=tprocdef(tprocsym(symentry).ProcdefList[0]); + if ((po_classmethod in procdef.procoptions) and + (procdef.messageinf.str^='load')) then + begin + result.add(classes[i]); + break; + end; + end; + end; + end; + end; + + var + nonlazyclasses, + nonlazycategories : tfpobjectlist; + begin + if (classdefs.count=0) and + (catdefs.count=0) then + exit; + + nonlazyclasses:=collectnonlazyclasses(classdefs); + nonlazycategories:=collectnonlazyclasses(catdefs); + + { this list has to include all classes, also the non-lazy ones } + addclasslist(list,sec_objc_classlist,target_asm.labelprefix+'_OBJC_LABEL_CLASS_$',classdefs); + addclasslist(list,sec_objc_nlclasslist,target_asm.labelprefix+'_OBJC_LABEL_NONLAZY_CLASS_$',nonlazyclasses); + { category and non-lazy category lists } + addclasslist(list,sec_objc_catlist,target_asm.labelprefix+'_OBJC_LABEL_CATEGORY_$',catdefs); + addclasslist(list,sec_objc_nlcatlist,target_asm.labelprefix+'_OBJC_LABEL_NONLAZY_CATEGORY_$',nonlazycategories); + + nonlazyclasses.free; + nonlazycategories.free; + { the non-fragile abi doesn't have any module info, nor lazy references + to used classes or to parent classes } + end; + + +constructor tobjcrttiwriter_nonfragile.create; + begin + inherited create(oa_nonfragile); + end; + + +{****************************************************************** + RTTI generation -- Main function +*******************************************************************} + +procedure MaybeGenerateObjectiveCImageInfo(globalst, localst: tsymtable); + var + objcrttiwriter: tobjcrttiwriter; + begin + if (m_objectivec1 in current_settings.modeswitches) then + begin + { first 4 bytes contain version information about this section (currently version 0), + next 4 bytes contain flags (currently only regarding whether the code in the object + file supports or requires garbage collection) + } + new_section(current_asmdata.asmlists[al_objc_data],sec_objc_image_info,'_OBJC_IMAGE_INFO',sizeof(pint)); + current_asmdata.asmlists[al_objc_data].concat(Tai_symbol.Createname(target_asm.labelprefix+'_OBJC_IMAGE_INFO',AT_LABEL,sizeof(pint))); + current_asmdata.asmlists[al_objc_data].concat(Tai_const.Create_64bit(0)); + + { generate rtti for all obj-c classes, protocols and categories + defined in this module. } + if not(target_info.system in systems_objc_nfabi) then + objcrttiwriter:=tobjcrttiwriter_fragile.create + else + objcrttiwriter:=tobjcrttiwriter_nonfragile.create; + objcrttiwriter.gen_objc_rtti_sections(current_asmdata.asmlists[al_objc_data],globalst); + objcrttiwriter.gen_objc_rtti_sections(current_asmdata.asmlists[al_objc_data],localst); + objcrttiwriter.gen_objc_info_sections(current_asmdata.asmlists[al_objc_data]); + objcrttiwriter.free; + end; + end; + + +end. diff --git a/closures/compiler/objcutil.pas b/closures/compiler/objcutil.pas new file mode 100644 index 0000000000..23b1bfafd6 --- /dev/null +++ b/closures/compiler/objcutil.pas @@ -0,0 +1,291 @@ +{ + Copyright (c) 2009-2010 by Jonas Maebe + + This unit implements some Objective-C helper routines at the node tree + level. + + 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. + + **************************************************************************** +} + +{$i fpcdefs.inc} + +unit objcutil; + +interface + + uses + node, + symtype,symdef; + + { Check whether a string contains a syntactically valid selector name. } + function objcvalidselectorname(value_str: pchar; len: longint): boolean; + + { Generate a node loading the superclass structure necessary to call + an inherited Objective-C method. } + function objcsuperclassnode(def: tdef): tnode; + + { Encode a method's parameters and result type into the format used by the + run time (for generating protocol and class rtti). } + function objcencodemethod(pd: tprocdef): ansistring; + + { Exports all assembler symbols related to the obj-c class } + procedure exportobjcclass(def: tobjectdef); + +implementation + + uses + globtype, + cutils,cclasses, + pass_1, + verbose,systems, + symtable,symconst,symsym, + objcdef, + defutil,paramgr, + nbas,nmem,ncal,nld,ncon,ncnv, + export; + + +{****************************************************************** + validselectorname +*******************************************************************} + +function objcvalidselectorname(value_str: pchar; len: longint): boolean; + var + i : longint; + gotcolon : boolean; +begin + result:=false; + { empty name is not allowed } + if (len=0) then + exit; + + gotcolon:=false; + + { if the first character is a colon, all of them must be colons } + if (value_str[0] = ':') then + begin + for i:=1 to len-1 do + if (value_str[i]<>':') then + exit; + end + else + begin + { no special characters other than ':' + } + for i:=0 to len-1 do + if (value_str[i] = ':') then + gotcolon:=true + else if not(value_str[i] in ['_','A'..'Z','a'..'z','0'..'9',':']) then + exit; + + { if there is at least one colon, the final character must + also be a colon (in case it's only one character that is + a colon, this was already checked before the above loop) + } + if gotcolon and + (value_str[len-1] <> ':') then + exit; + end; + + result:=true; +end; + +{****************************************************************** + objcsuperclassnode +*******************************************************************} + + function objcloadbasefield(n: tnode; const fieldname: string): tnode; + var + vs : tsym; + begin + result:=cderefnode.create(ctypeconvnode.create_internal(n,objc_idtype)); + vs:=tsym(tabstractrecorddef(objc_objecttype).symtable.Find(fieldname)); + if not assigned(vs) or + (vs.typ<>fieldvarsym) then + internalerror(200911301); + result:=csubscriptnode.create(vs,result); + end; + + + function objcsuperclassnode(def: tdef): tnode; + var + para : tcallparanode; + begin + { only valid for Objective-C classes and classrefs } + if not is_objcclass(def) and + not is_objcclassref(def) then + internalerror(2009090901); + { Can be done a lot more efficiently with direct symbol accesses, but + requires extra node types. Maybe later. } + if is_objcclassref(def) then + begin + if (oo_is_classhelper in tobjectdef(tclassrefdef(def).pointeddef).objectoptions) then + begin + { in case we are in a category method, we need the metaclass of the + superclass class extended by this category (= metaclass of superclass of superclass) + for the fragile abi, and the metaclass of the superclass for the non-fragile ABI } +{$if defined(onlymacosx10_6) or defined(arm) } + { NOTE: those send2 methods are only available on Mac OS X 10.6 and later! + (but also on all iPhone SDK revisions we support) } + if (target_info.system in systems_objc_nfabi) then + result:=cloadvmtaddrnode.create(ctypenode.create(tobjectdef(tclassrefdef(def).pointeddef).childof)) + else +{$endif onlymacosx10_6 or arm} + result:=cloadvmtaddrnode.create(ctypenode.create(tobjectdef(tclassrefdef(def).pointeddef).childof.childof)); + result:=objcloadbasefield(result,'ISA'); + typecheckpass(result); + { we're done } + exit; + end + else + begin + { otherwise we need the superclass of the metaclass } + para:=ccallparanode.create(cstringconstnode.createstr(tobjectdef(tclassrefdef(def).pointeddef).objextname^),nil); + result:=ccallnode.createinternfromunit('OBJC','OBJC_GETMETACLASS',para); + end + end + else + begin + if not(oo_is_classhelper in tobjectdef(def).objectoptions) then + result:=cloadvmtaddrnode.create(ctypenode.create(def)) + else + result:=cloadvmtaddrnode.create(ctypenode.create(tobjectdef(def).childof)) + end; + +{$if defined(onlymacosx10_6) or defined(arm) } + { For the non-fragile ABI, the superclass send2 method itself loads the + superclass. For the fragile ABI, we have to do this ourselves. + + NOTE: those send2 methods are only available on Mac OS X 10.6 and later! + (but also on all iPhone SDK revisions we support) } + if not(target_info.system in systems_objc_nfabi) then +{$endif onlymacosx10_6 or arm} + result:=objcloadbasefield(result,'SUPERCLASS'); + typecheckpass(result); + end; + + +{****************************************************************** + Type encoding +*******************************************************************} + + function objcparasize(vs: tparavarsym): ptrint; + begin + result:=vs.paraloc[callerside].intsize; + { In Objective-C, all ordinal types are widened to at least the + size of the C "int" type. Assume __LP64__/4 byte ints for now. } + if is_ordinal(vs.vardef) and + (result<4) then + result:=4; + end; + + + function objcencodemethod(pd: tprocdef): ansistring; + var + parasize, + totalsize: aint; + vs: tparavarsym; + i: longint; + temp: ansistring; + founderror: tdef; + begin + result:=''; + totalsize:=0; + pd.init_paraloc_info(callerside); +{$if defined(powerpc) and defined(dummy)} + { Disabled, because neither Clang nor gcc does this, and the ObjC + runtime contains an explicit fix to detect this error. } + + { On ppc, the callee is responsible for removing the hidden function + result parameter from the stack, so it has to know. On i386, it's + the caller that does this. } + if (pd.returndef<>voidtype) and + paramgr.ret_in_param(pd.returndef,pocall_cdecl) then + inc(totalsize,sizeof(pint)); +{$endif} + for i:=0 to pd.paras.count-1 do + begin + vs:=tparavarsym(pd.paras[i]); + if (vo_is_funcret in vs.varoptions) then + continue; + { objcaddencodedtype always assumes a value parameter, so add + a pointer indirection for var/out parameters. } + if not paramanager.push_addr_param(vs_value,vs.vardef,pocall_cdecl) and + (vs.varspez in [vs_var,vs_out,vs_constref]) then + result:=result+'^'; + { Add the parameter type. } + if not objcaddencodedtype(vs.vardef,ris_initial,false,result,founderror) then + { should be checked earlier on } + internalerror(2009081701); + { And the total size of the parameters coming before this one + (i.e., the "offset" of this parameter). } + result:=result+tostr(totalsize); + { Update the total parameter size } + parasize:=objcparasize(vs); + inc(totalsize,parasize); + end; + { Prepend the total parameter size. } + result:=tostr(totalsize)+result; + { And the type of the function result (void in case of a procedure). } + temp:=''; + if not objcaddencodedtype(pd.returndef,ris_initial,false,temp,founderror) then + internalerror(2009081801); + result:=temp+result; + end; + + +{****************************************************************** + ObjC class exporting +*******************************************************************} + + procedure exportobjcclassfields(objccls: tobjectdef); + var + i: longint; + vf: tfieldvarsym; + prefix: string; + begin + prefix:=target_info.cprefix+'OBJC_IVAR_$_'+objccls.objextname^+'.'; + for i:=0 to objccls.symtable.SymList.Count-1 do + if tsym(objccls.symtable.SymList[i]).typ=fieldvarsym then + begin + vf:=tfieldvarsym(objccls.symtable.SymList[i]); + { TODO: package visibility (private_extern) -- must not be exported + either} + if not(vf.visibility in [vis_private,vis_strictprivate]) then + exportname(prefix+vf.RealName,0); + end; + end; + + + procedure exportobjcclass(def: tobjectdef); + begin + if (target_info.system in systems_objc_nfabi) then + begin + { export class and metaclass symbols } + exportname(def.rtti_mangledname(objcclassrtti),0); + exportname(def.rtti_mangledname(objcmetartti),0); + { export public/protected instance variable offset symbols } + exportobjcclassfields(def); + end + else + begin + { export the class symbol } + exportname('.objc_class_name_'+def.objextname^,0); + end; + end; + +end. diff --git a/closures/compiler/ogbase.pas b/closures/compiler/ogbase.pas new file mode 100644 index 0000000000..2c4417b059 --- /dev/null +++ b/closures/compiler/ogbase.pas @@ -0,0 +1,2862 @@ +{ + Copyright (c) 1998-2006 by Peter Vreman + + Contains the base stuff for binary object file writers + + 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 ogbase; + +{$i fpcdefs.inc} + +interface + + uses + { common } + cutils, + cclasses, + { targets } + systems,globtype, + { outputwriters } + owbase, + { assembler } + aasmbase; + + type + TObjSection = class; + TObjData = class; + + TExeSection = class; + TExeSymbol = class; + + TObjRelocationType = ( + { Relocation to absolute address } + RELOC_ABSOLUTE, +{$ifdef x86_64} + { 32bit Relocation to absolute address } + RELOC_ABSOLUTE32, + { 64 bit coff only } + RELOC_RELATIVE_1, + RELOC_RELATIVE_2, + RELOC_RELATIVE_3, + RELOC_RELATIVE_4, + RELOC_RELATIVE_5, + { PIC } + RELOC_GOTPCREL, + RELOC_PLT32, +{$endif x86_64} +{$ifdef i386} + { PIC } + RELOC_GOTPC, + RELOC_GOT32, + RELOC_PLT32, +{$endif i386} +{$ifdef arm} + RELOC_RELATIVE_24, +{$endif arm} + { Relative relocation } + RELOC_RELATIVE, + { PECoff (Windows) RVA relocation } + RELOC_RVA, + { PECoff (Windows) section relocation, required by DWARF2 debug info } + RELOC_SECREL32, + { Generate a 0 value at the place of the relocation, + this is used to remove unused vtable entries } + RELOC_ZERO, + { No relocation is needed. It is used in ARM object files. + Also internal linker use this reloc to make virtual (not real) + links to some sections } + RELOC_NONE, + { Darwin relocation, using PAIR } + RELOC_PIC_PAIR + ); + +{$ifndef x86_64} + const + RELOC_ABSOLUTE32 = RELOC_ABSOLUTE; +{$endif x86_64} + + const + { stab types } + 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_LBRAC = $C0; + N_EXCL = $C2; + N_RBRAC = $E0; + + { GNU extensions } + debuglinkname='.gnu_debuglink'; + + type + TObjSectionOption = ( + { Has Data available in the file } + oso_Data, + { Is loaded into memory } + oso_load, + { Not loaded into memory } + oso_noload, + { Read only } + oso_readonly, + { Read/Write } + oso_write, + { Contains executable instructions } + oso_executable, + { Never discard section } + oso_keep, + { Special common symbols } + oso_common, + { Contains debug info and can be stripped } + oso_debug, + { Contains only strings } + oso_strings + ); + + TObjSectionOptions = set of TObjSectionOption; + + TObjSymbol = class(TFPHashObject) + public + bind : TAsmsymbind; + typ : TAsmsymtype; + { Current assemble pass, used to detect duplicate labels } + pass : byte; + objsection : TObjSection; + symidx : longint; + offset, + size : aword; + { Used for external and common solving during linking } + exesymbol : TExeSymbol; + + { Darwin asm is using indirect symbols resolving } + indsymbol : TObjSymbol; + + constructor create(AList:TFPHashObjectList;const AName:string); + function address:aword; + procedure SetAddress(apass:byte;aobjsec:TObjSection;abind:TAsmsymbind;atyp:Tasmsymtype); + end; + + { Stabs is common for all targets } + TObjStabEntry=packed record + strpos : longint; + ntype : byte; + nother : byte; + ndesc : word; + nvalue : longint; + end; + PObjStabEntry=^TObjStabEntry; + + TObjRelocation = class + DataOffset, + orgsize : aword; { original size of the symbol to Relocate, required for COFF } + symbol : TObjSymbol; + objsection : TObjSection; { only used if symbol=nil } + typ : TObjRelocationType; + constructor CreateSymbol(ADataOffset:aword;s:TObjSymbol;Atyp:TObjRelocationType); + constructor CreateSymbolSize(ADataOffset:aword;s:TObjSymbol;Aorgsize:aword;Atyp:TObjRelocationType); + constructor CreateSection(ADataOffset:aword;aobjsec:TObjSection;Atyp:TObjRelocationType); + end; + + TObjSection = class(TFPHashObject) + private + FData : TDynamicArray; + FSecOptions : TObjSectionOptions; + FCachedFullName : pshortstring; + procedure SetSecOptions(Aoptions:TObjSectionOptions); + public + ObjData : TObjData; + SecSymIdx : longint; { index for the section in symtab } + SecAlign : shortint; { alignment of the section } + { section Data } + Size, + DataPos, + MemPos : aword; + DataAlignBytes : shortint; + { Relocations (=references) to other sections } + ObjRelocations : TFPObjectList; + { Symbols this defines } + ObjSymbolDefines : TFPObjectList; + { executable linking } + ExeSection : TExeSection; + USed : Boolean; + VTRefList : TFPObjectList; + constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);virtual; + destructor destroy;override; + function write(const d;l:aword):aword; + function writestr(const s:string):aword; + function WriteZeros(l:longword):aword; + function setmempos(mpos:qword):qword; + procedure setDatapos(var dpos:aword); + procedure alloc(l:aword); + procedure addsymReloc(ofs:aword;p:TObjSymbol;Reloctype:TObjRelocationType); + procedure addsectionReloc(ofs:aword;aobjsec:TObjSection;Reloctype:TObjRelocationType); + procedure AddSymbolDefine(p:TObjSymbol); + procedure FixupRelocs;virtual; + procedure ReleaseData; + function FullName:string; + property Data:TDynamicArray read FData; + property SecOptions:TObjSectionOptions read FSecOptions write SetSecOptions; + end; + TObjSectionClass = class of TObjSection; + + TString80 = string[80]; + + TObjData = class(TLinkedListItem) + private + FName : TString80; + FCurrObjSec : TObjSection; + FObjSectionList : TFPHashObjectList; + FCObjSection : TObjSectionClass; + { Symbols that will be defined in this object file } + FObjSymbolList : TFPHashObjectList; + FCachedAsmSymbolList : TFPObjectList; + { Special info sections that are written to during object generation } + FStabsObjSec, + FStabStrObjSec : TObjSection; + procedure section_reset(p:TObject;arg:pointer); + procedure section_afteralloc(p:TObject;arg:pointer); + procedure section_afterwrite(p:TObject;arg:pointer); + protected + property CObjSection:TObjSectionClass read FCObjSection write FCObjSection; + public + CurrPass : byte; + ImageBase : aword; + constructor create(const n:string);virtual; + destructor destroy;override; + { Sections } + function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;virtual; + function sectiontype2options(atype:TAsmSectiontype):TObjSectionOptions;virtual; + function sectiontype2align(atype:TAsmSectiontype):shortint;virtual; + function createsection(atype:TAsmSectionType;const aname:string='';aorder:TAsmSectionOrder=secorder_default):TObjSection; + function createsection(const aname:string;aalign:shortint;aoptions:TObjSectionOptions;DiscardDuplicate:boolean=true):TObjSection;virtual; + procedure CreateDebugSections;virtual; + function findsection(const aname:string):TObjSection; + procedure setsection(asec:TObjSection); + { Symbols } + function createsymbol(const aname:string):TObjSymbol; + function symboldefine(asmsym:TAsmSymbol):TObjSymbol; + function symboldefine(const aname:string;abind:TAsmsymbind;atyp:Tasmsymtype):TObjSymbol; + function symbolref(asmsym:TAsmSymbol):TObjSymbol; + function symbolref(const aname:string):TObjSymbol; + procedure ResetCachedAsmSymbols; + { Allocation } + procedure alloc(len:aword); + procedure allocalign(len:shortint); + procedure writebytes(const Data;len:aword); + procedure writeReloc(Data:aint;len:aword;p:TObjSymbol;Reloctype:TObjRelocationType);virtual;abstract; + procedure beforealloc;virtual; + procedure beforewrite;virtual; + procedure afteralloc;virtual; + procedure afterwrite;virtual; + procedure resetsections; + property Name:TString80 read FName; + property CurrObjSec:TObjSection read FCurrObjSec; + property ObjSymbolList:TFPHashObjectList read FObjSymbolList; + property ObjSectionList:TFPHashObjectList read FObjSectionList; + property StabsSec:TObjSection read FStabsObjSec write FStabsObjSec; + property StabStrSec:TObjSection read FStabStrObjSec write FStabStrObjSec; + end; + TObjDataClass = class of TObjData; + + TObjOutput = class + private + FCObjData : TObjDataClass; + protected + { writer } + FWriter : TObjectwriter; + function writeData(Data:TObjData):boolean;virtual;abstract; + property CObjData : TObjDataClass read FCObjData write FCObjData; + public + constructor create(AWriter:TObjectWriter);virtual; + destructor destroy;override; + function newObjData(const n:string):TObjData; + function startObjectfile(const fn:string):boolean; + function writeobjectfile(Data:TObjData):boolean; + procedure exportsymbol(p:TObjSymbol); + property Writer:TObjectWriter read FWriter; + end; + TObjOutputClass=class of TObjOutput; + + TObjInput = class + private + FCObjData : TObjDataClass; + protected + { reader } + FReader : TObjectReader; + InputFileName : string; + property CObjData : TObjDataClass read FCObjData write FCObjData; + public + constructor create;virtual; + destructor destroy;override; + function newObjData(const n:string):TObjData; + function ReadObjData(AReader:TObjectreader;Data:TObjData):boolean;virtual;abstract; + procedure inputerror(const s : string); + end; + TObjInputClass=class of TObjInput; + + TVTableEntry=record + ObjRelocation : TObjRelocation; + orgreloctype : TObjRelocationType; + Enabled, + Used : Boolean; + end; + PVTableEntry=^TVTableEntry; + + TExeVTable = class + private + procedure CheckIdx(VTableIdx:longint); + public + ExeSymbol : TExeSymbol; + EntryCnt : Longint; + EntryArray : PVTableEntry; + Consolidated : Boolean; + ChildList : TFPObjectList; + constructor Create(AExeSymbol:TExeSymbol); + destructor Destroy;override; + procedure AddChild(vt:TExeVTable); + procedure AddEntry(VTableIdx:Longint); + procedure SetVTableSize(ASize:longint); + function VTableRef(VTableIdx:Longint):TObjRelocation; + end; + + TSymbolState = (symstate_undefined,symstate_defined,symstate_common); + + TExeSymbol = class(TFPHashObject) + ObjSymbol : TObjSymbol; + ExeSection : TExeSection; + State : TSymbolState; + { Used for vmt references optimization } + VTable : TExeVTable; + end; + + TExeSection = class(TFPHashObject) + private + FSecSymIdx : longint; + FObjSectionList : TFPObjectList; + public + Size, + DataPos, + MemPos : aword; + SecAlign : shortint; + SecOptions : TObjSectionOptions; + constructor create(AList:TFPHashObjectList;const AName:string);virtual; + destructor destroy;override; + procedure AddObjSection(objsec:TObjSection); + property ObjSectionList:TFPObjectList read FObjSectionList; + property SecSymIdx:longint read FSecSymIdx write FSecSymIdx; + end; + TExeSectionClass=class of TExeSection; + + TStaticLibrary = class(TFPHashObject) + private + FArReader : TObjectReader; + FObjInputClass : TObjInputClass; + public + constructor create(AList:TFPHashObjectList;const AName:string;AReader:TObjectReader;AObjInputClass:TObjInputClass); + destructor destroy;override; + property ArReader:TObjectReader read FArReader; + property ObjInputClass:TObjInputClass read FObjInputClass; + end; + + TImportLibrary = class(TFPHashObject) + private + FImportSymbolList : TFPHashObjectList; + public + constructor create(AList:TFPHashObjectList;const AName:string); + destructor destroy;override; + property ImportSymbolList:TFPHashObjectList read FImportSymbolList; + end; + + TImportSymbol = class(TFPHashObject) + private + FOrdNr : longint; + FIsVar : boolean; + FMangledName : string; + public + constructor create(AList:TFPHashObjectList;const AName,AMangledName:string;AOrdNr:longint;AIsVar:boolean); + property OrdNr: longint read FOrdNr; + property MangledName: string read FMangledName; + property IsVar: boolean read FIsVar; + end; + + TExeWriteMode = (ewm_exefull,ewm_dbgonly,ewm_exeonly); + + TExeOutput = class + private + { ExeSectionList } + FCObjData : TObjDataClass; + FCExeSection : TExeSectionClass; + FCurrExeSec : TExeSection; + FExeSectionList : TFPHashObjectList; + Fzeronr : longint; + Fvaluesnr : longint; + { Symbols } + FExeSymbolList : TFPHashObjectList; + FUnresolvedExeSymbols : TFPObjectList; + FExternalObjSymbols, + FCommonObjSymbols : TFPObjectList; + FEntryName : string; + FExeVTableList : TFPObjectList; + { Objects } + FObjDataList : TFPObjectList; + { Position calculation } + FImageBase : aword; + FCurrMemPos : qword; + procedure SetCurrMemPos(const AValue: qword); + protected + { writer } + FExeWriteMode : TExeWriteMode; + FWriter : TObjectwriter; + commonObjSection : TObjSection; + internalObjData : TObjData; + EntrySym : TObjSymbol; + SectionDataAlign, + SectionMemAlign : aword; + function writeData:boolean;virtual;abstract; + property CExeSection:TExeSectionClass read FCExeSection write FCExeSection; + property CObjData:TObjDataClass read FCObjData write FCObjData; + procedure Order_ObjSectionList(ObjSectionList : TFPObjectList; const aPattern:string);virtual; + public + CurrDataPos : aword; + MaxMemPos : qword; + IsSharedLibrary : boolean; + constructor create;virtual; + destructor destroy;override; + function FindExeSection(const aname:string):TExeSection; + procedure AddObjData(ObjData:TObjData); + procedure Load_Start;virtual; + procedure Load_EntryName(const aname:string);virtual; + procedure Load_Symbol(const aname:string);virtual; + procedure Load_ProvideSymbol(const aname:string);virtual; + procedure Load_IsSharedLibrary; + procedure Load_ImageBase(const avalue:string); + procedure Order_Start;virtual; + procedure Order_End;virtual; + procedure Order_ExeSection(const aname:string);virtual; + procedure Order_Align(const avalue:string);virtual; + procedure Order_Zeros(const avalue:string);virtual; + procedure Order_Values(bytesize : aword; const avalue:string);virtual; + procedure Order_Symbol(const aname:string);virtual; + procedure Order_ProvideSymbol(const aname:string);virtual; + procedure Order_EndExeSection;virtual; + procedure Order_ObjSection(const aname:string);virtual; + procedure MemPos_Start;virtual; + procedure MemPos_Header;virtual; + procedure MemPos_ExeSection(const aname:string);virtual; + procedure MemPos_EndExeSection;virtual; + procedure DataPos_Start;virtual; + procedure DataPos_Header;virtual; + procedure DataPos_ExeSection(const aname:string);virtual; + procedure DataPos_EndExeSection;virtual; + procedure DataPos_Symbols;virtual; + procedure BuildVTableTree(VTInheritList,VTEntryList:TFPObjectList); + procedure PackUnresolvedExeSymbols(const s:string); + procedure ResolveSymbols(StaticLibraryList:TFPHashObjectList); + procedure PrintMemoryMap; + procedure FixupSymbols; + procedure FixupRelocations; + procedure MergeStabs; + procedure RemoveUnreferencedSections; + procedure RemoveEmptySections; + procedure RemoveDebugInfo; + procedure GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);virtual; + procedure GenerateDebugLink(const dbgname:string;dbgcrc:cardinal); + function WriteExeFile(const fn:string):boolean; + procedure ParseScript (linkscript:TCmdStrList); virtual; + property Writer:TObjectWriter read FWriter; + property ExeSectionList:TFPHashObjectList read FExeSectionList; + property ObjDataList:TFPObjectList read FObjDataList; + property ExeSymbolList:TFPHashObjectList read FExeSymbolList; + property UnresolvedExeSymbols:TFPObjectList read FUnresolvedExeSymbols; + property ExternalObjSymbols:TFPObjectList read FExternalObjSymbols; + property CommonObjSymbols:TFPObjectList read FCommonObjSymbols; + property ExeVTableList:TFPObjectList read FExeVTableList; + property EntryName:string read FEntryName write FEntryName; + property ImageBase:aword read FImageBase write FImageBase; + property CurrExeSec:TExeSection read FCurrExeSec; + property ExeWriteMode:TExeWriteMode read FExeWriteMode write FExeWriteMode; + property CurrMemPos:qword read FCurrMemPos write SetCurrMemPos; + end; + TExeOutputClass=class of TExeOutput; + + var + exeoutput : TExeOutput; + + +implementation + + uses + SysUtils, + globals,verbose,fmodule,ogmap; + + const + SectionDataMaxGrow = 4096; + +{$ifdef MEMDEBUG} + var + memobjsymbols, + memobjsections : TMemDebug; +{$endif MEMDEBUG} + +{***************************************************************************** + TObjSymbol +*****************************************************************************} + + constructor TObjSymbol.create(AList:TFPHashObjectList;const AName:string); + begin; + inherited create(AList,AName); + bind:=AB_EXTERNAL; + typ:=AT_NONE; + symidx:=-1; + size:=0; + offset:=0; + objsection:=nil; + end; + + + function TObjSymbol.address:aword; + begin + if assigned(objsection) then + result:=offset+objsection.mempos + else + result:=0; + end; + + + procedure TObjSymbol.SetAddress(apass:byte;aobjsec:TObjSection;abind:TAsmsymbind;atyp:Tasmsymtype); + begin + if not(abind in [AB_GLOBAL,AB_LOCAL,AB_COMMON,AB_IMPORT]) then + internalerror(200603016); + if not assigned(aobjsec) then + internalerror(200603017); + if (bind in [AB_EXTERNAL,AB_LAZY]) or + { Put all COMMON to GLOBAL in step 3 of + TExeOutput.ResolveSymbols } + ((abind=AB_GLOBAL) and (bind=AB_COMMON)) then + begin + { Do not change the AB_TYPE of common symbols yet } + { This will be done in FixupSymbols } + if (pass<>0) or (bind<>AB_COMMON) then + bind:=abind; + typ:=atyp; + end + else + begin + if pass=apass then + begin + Message1(asmw_e_duplicate_label,name); + exit; + end; + end; + pass:=apass; + { Code can never grow after a pass } + if assigned(objsection) and + (objsection=aobjsec) and + (aobjsec.size>offset) then + internalerror(200603014); + objsection:=aobjsec; + offset:=aobjsec.size; + end; + +{**************************************************************************** + TObjRelocation +****************************************************************************} + + constructor TObjRelocation.CreateSymbol(ADataOffset:aword;s:TObjSymbol;Atyp:TObjRelocationType); + begin + if not assigned(s) then + internalerror(200603034); + DataOffset:=ADataOffset; + Symbol:=s; + OrgSize:=0; + ObjSection:=nil; + Typ:=Atyp; + end; + + + constructor TObjRelocation.CreateSymbolSize(ADataOffset:aword;s:TObjSymbol;Aorgsize:aword;Atyp:TObjRelocationType); + begin + if not assigned(s) then + internalerror(200603035); + DataOffset:=ADataOffset; + Symbol:=s; + OrgSize:=Aorgsize; + ObjSection:=nil; + Typ:=Atyp; + end; + + + constructor TObjRelocation.CreateSection(ADataOffset:aword;aobjsec:TObjSection;Atyp:TObjRelocationType); + begin + if not assigned(aobjsec) then + internalerror(200603036); + DataOffset:=ADataOffset; + Symbol:=nil; + OrgSize:=0; + ObjSection:=aobjsec; + Typ:=Atyp; + end; + + +{**************************************************************************** + TObjSection +****************************************************************************} + + constructor TObjSection.create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions); + begin + inherited Create(AList,Aname); + { Data } + Size:=0; + Datapos:=0; + mempos:=0; + FData:=Nil; + { Setting the secoptions allocates Data if needed } + secoptions:=Aoptions; + secalign:=Aalign; + secsymidx:=0; + { relocation } + ObjRelocations:=TFPObjectList.Create(true); + ObjSymbolDefines:=TFPObjectList.Create(false); + VTRefList:=TFPObjectList.Create(false); + end; + + + destructor TObjSection.destroy; + begin + if assigned(Data) then + Data.Free; + stringdispose(FCachedFullName); + ObjRelocations.Free; + ObjSymbolDefines.Free; + VTRefList.Free; + inherited destroy; + end; + + + procedure TObjSection.SetSecOptions(Aoptions:TObjSectionOptions); + begin + FSecOptions:=FSecOptions+AOptions; + if (oso_Data in secoptions) and + not assigned(FData) then + FData:=TDynamicArray.Create(SectionDataMaxGrow); + end; + + + function TObjSection.write(const d;l:aword):aword; + begin + result:=size; + if assigned(Data) then + begin + if Size<>Data.size then + internalerror(200602281); + Data.write(d,l); + inc(Size,l); + end + else + internalerror(200602289); + end; + + + function TObjSection.writestr(const s:string):aword; + begin + result:=Write(s[1],length(s)); + end; + + + function TObjSection.WriteZeros(l:longword):aword; + var + empty : array[0..1023] of byte; + begin + if l>sizeof(empty) then + internalerror(200404082); + if l>0 then + begin + fillchar(empty,l,0); + result:=Write(empty,l); + end + else + result:=Size; + end; + + + procedure TObjSection.setDatapos(var dpos:aword); + begin + if oso_Data in secoptions then + begin + { get aligned Datapos } + Datapos:=align(dpos,secalign); + Dataalignbytes:=Datapos-dpos; + { return updated Datapos } + dpos:=Datapos+size; + end + else + Datapos:=dpos; + end; + + + function TObjSection.setmempos(mpos:qword):qword; + begin + mempos:=align(mpos,secalign); + { return updated mempos } + result:=mempos+size; + end; + + + procedure TObjSection.alloc(l:aword); + begin + inc(size,l); + end; + + + procedure TObjSection.addsymReloc(ofs:aword;p:TObjSymbol;Reloctype:TObjRelocationType); + begin + ObjRelocations.Add(TObjRelocation.CreateSymbol(ofs,p,reloctype)); + end; + + + procedure TObjSection.addsectionReloc(ofs:aword;aobjsec:TObjSection;Reloctype:TObjRelocationType); + begin + ObjRelocations.Add(TObjRelocation.CreateSection(ofs,aobjsec,reloctype)); + end; + + + procedure TObjSection.AddSymbolDefine(p:TObjSymbol); + begin + if p.bind<>AB_GLOBAL then + exit; + ObjSymbolDefines.Add(p); + end; + + + procedure TObjSection.FixupRelocs; + begin + end; + + + procedure TObjSection.ReleaseData; + begin + if assigned(FData) then + begin + FData.free; + FData:=nil; + end; + ObjRelocations.free; + ObjRelocations:=nil; + ObjSymbolDefines.Free; + ObjSymbolDefines:=nil; + if assigned(FCachedFullName) then + begin + stringdispose(FCachedFullName); + FCachedFullName:=nil; + end; + end; + + + function TObjSection.FullName:string; + begin + if not assigned(FCachedFullName) then + begin + if assigned(ObjData) then + FCachedFullName:=stringdup(ObjData.Name+'('+Name+')') + else + FCachedFullName:=stringdup(Name); + end; + result:=FCachedFullName^; + end; + + +{**************************************************************************** + TObjData +****************************************************************************} + + constructor TObjData.create(const n:string); + begin + inherited create; + FName:=ExtractFileName(n); + FObjSectionList:=TFPHashObjectList.Create(true); + FStabsObjSec:=nil; + FStabStrObjSec:=nil; + { symbols } + FObjSymbolList:=TFPHashObjectList.Create(true); + FCachedAsmSymbolList:=TFPObjectList.Create(false); + { section class type for creating of new sections } + FCObjSection:=TObjSection; + end; + + + destructor TObjData.destroy; + begin + { Symbols } +{$ifdef MEMDEBUG} + MemObjSymbols.Start; +{$endif} + ResetCachedAsmSymbols; + FCachedAsmSymbolList.free; + FObjSymbolList.free; +{$ifdef MEMDEBUG} + MemObjSymbols.Stop; +{$endif} + { Sections } +{$ifdef MEMDEBUG} + MemObjSections.Start; +{$endif} + FObjSectionList.free; +{$ifdef MEMDEBUG} + MemObjSections.Stop; +{$endif} + inherited destroy; + end; + + + function TObjData.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string; + const + secnames : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','', + 'code', + 'Data', + 'Data', + 'roData', + 'bss', + 'threadvar', + 'pdata', + 'stub', + 'data_nonlazy', + 'data_lazy', + 'init_func', + 'term_func', + 'stab','stabstr', + 'iData2','iData4','iData5','iData6','iData7','eData', + 'eh_frame', + 'debug_frame','debug_info','debug_line','debug_abbrev', + 'fpc', + 'toc', + 'init', + 'fini', + 'objc_class', + 'objc_meta_class', + 'objc_cat_cls_meth', + 'objc_cat_inst_meth', + 'objc_protocol', + 'objc_string_object', + 'objc_cls_meth', + 'objc_inst_meth', + 'objc_cls_refs', + 'objc_message_refs', + 'objc_symbols', + 'objc_category', + 'objc_class_vars', + 'objc_instance_vars', + 'objc_module_info', + 'objc_class_names', + 'objc_meth_var_types', + 'objc_meth_var_names', + 'objc_selector_strs', + 'objc_protocol_ext', + 'objc_class_ext', + 'objc_property', + 'objc_image_info', + 'objc_cstring_object', + 'objc_sel_fixup', + '__DATA,__objc_data', + '__DATA,__objc_const', + '.objc_superrefs', + '__DATA, __datacoal_nt,coalesced', + '.objc_classlist', + '.objc_nlclasslist', + '.objc_catlist', + '.obcj_nlcatlist', + '.objc_protolist' + ); + var + sep : string[3]; + begin + if aname<>'' then + begin + case aorder of + secorder_begin : + sep:='.b_'; + secorder_end : + sep:='.z_'; + else + sep:='.n_'; + end; + result:=secnames[atype]+sep+aname + end + else + result:=secnames[atype]; + end; + + + function TObjData.sectiontype2options(atype:TAsmSectiontype):TObjSectionOptions; + const + secoptions : array[TAsmSectiontype] of TObjSectionOptions = ([], + {user} [oso_Data,oso_load,oso_write,oso_keep], + {code} [oso_Data,oso_load,oso_readonly,oso_executable,oso_keep], + {Data} [oso_Data,oso_load,oso_write,oso_keep], +{ TODO: Fix sec_rodata be read-only-with-relocs} + {roData} [oso_Data,oso_load,oso_write,oso_keep], +{ TODO: Fix sec_rodata_norel be read-only/constant} + {roData_norel} [oso_Data,oso_load,oso_write,oso_keep], + {bss} [oso_load,oso_write,oso_keep], + {threadvar} [oso_load,oso_write +{$ifdef FPC_USE_TLS_DIRECTORY} + ,oso_keep +{$endif FPC_USE_TLS_DIRECTORY} + ], + {pdata} [oso_data,oso_load,oso_readonly {$ifndef x86_64},oso_keep{$endif}], + {stub} [oso_Data,oso_load,oso_readonly,oso_executable], + {data_nonlazy} [oso_Data,oso_load,oso_write], + {data_lazy} [oso_Data,oso_load,oso_write], + {init_func} [oso_Data,oso_load], + {term_func} [oso_Data,oso_load], + {stab} [oso_Data,oso_noload,oso_debug], + {stabstr} [oso_Data,oso_noload,oso_strings,oso_debug], + {iData2} [oso_Data,oso_load,oso_write], + {iData4} [oso_Data,oso_load,oso_write], + {iData5} [oso_Data,oso_load,oso_write], + {iData6} [oso_Data,oso_load,oso_write], + {iData7} [oso_Data,oso_load,oso_write], + {eData} [oso_Data,oso_load,oso_readonly], + {eh_frame} [oso_Data,oso_load,oso_readonly], + {debug_frame} [oso_Data,oso_noload,oso_debug], + {debug_info} [oso_Data,oso_noload,oso_debug], + {debug_line} [oso_Data,oso_noload,oso_debug], + {debug_abbrev} [oso_Data,oso_noload,oso_debug], + {fpc} [oso_Data,oso_load,oso_write,oso_keep], + {toc} [oso_Data,oso_load,oso_readonly], + {init} [oso_Data,oso_load,oso_readonly,oso_executable,oso_keep], + {fini} [oso_Data,oso_load,oso_readonly,oso_executable,oso_keep], + {objc_class} [oso_data,oso_load], + {objc_meta_class} [oso_data,oso_load], + {objc_cat_cls_meth} [oso_data,oso_load], + {objc_cat_inst_meth} [oso_data,oso_load], + {objc_protocol} [oso_data,oso_load], + {objc_string_object} [oso_data,oso_load], + {objc_cls_meth} [oso_data,oso_load], + {objc_inst_meth} [oso_data,oso_load], + {objc_cls_refs} [oso_data,oso_load], + {objc_message_refs} [oso_data,oso_load], + {objc_symbols} [oso_data,oso_load], + {objc_category} [oso_data,oso_load], + {objc_class_vars} [oso_data,oso_load], + {objc_instance_vars} [oso_data,oso_load], + {objc_module_info} [oso_data,oso_load], + {objc_class_names} [oso_data,oso_load], + {objc_meth_var_types} [oso_data,oso_load], + {objc_meth_var_names} [oso_data,oso_load], + {objc_selector_strs} [oso_data,oso_load], + {objc_protocol_ext} [oso_data,oso_load], + {objc_class_ext} [oso_data,oso_load], + {objc_property} [oso_data,oso_load], + {objc_image_info} [oso_data,oso_load], + {objc_cstring_object} [oso_data,oso_load], + {objc_sel_fixup} [oso_data,oso_load], + {sec_objc_data} [oso_data,oso_load], + {sec_objc_const} [oso_data,oso_load], + {sec_objc_sup_refs} [oso_data,oso_load], + {sec_data_coalesced} [oso_data,oso_load], + {sec_objc_classlist} [oso_data,oso_load], + {sec_objc_nlclasslist} [oso_data,oso_load], + {sec_objc_catlist} [oso_data,oso_load], + {sec_objc_nlcatlist} [oso_data,oso_load], + {sec_objc_protolist'} [oso_data,oso_load] + ); + begin + result:=secoptions[atype]; + end; + + + function TObjData.sectiontype2align(atype:TAsmSectiontype):shortint; + begin + case atype of + sec_stabstr,sec_debug_info,sec_debug_line,sec_debug_abbrev: + result:=1; + sec_code, + sec_bss, + sec_data: + result:=16; + { For idata (at least idata2) it must be 4 bytes, because + an entry is always (also in win64) 20 bytes and aligning + on 8 bytes will insert 4 bytes between the entries resulting + in a corrupt idata section. + Same story with .pdata, it has 4-byte elements which should + be packed without gaps. } + sec_idata2,sec_idata4,sec_idata5,sec_idata6,sec_idata7,sec_pdata: + result:=4; + else + result:=sizeof(pint); + end; + end; + + + function TObjData.createsection(atype:TAsmSectionType;const aname:string;aorder:TAsmSectionOrder):TObjSection; + begin + result:=createsection(sectionname(atype,aname,aorder),sectiontype2align(atype),sectiontype2options(atype)); + end; + + + function TObjData.createsection(const aname:string;aalign:shortint;aoptions:TObjSectionOptions;DiscardDuplicate:boolean):TObjSection; + begin + if DiscardDuplicate then + result:=TObjSection(FObjSectionList.Find(aname)) + else + result:=nil; + if not assigned(result) then + begin + result:=CObjSection.create(FObjSectionList,aname,aalign,aoptions); + result.ObjData:=self; + end; + FCurrObjSec:=result; + end; + + + procedure TObjData.CreateDebugSections; + begin + end; + + + function TObjData.FindSection(const aname:string):TObjSection; + begin + result:=TObjSection(FObjSectionList.Find(aname)); + end; + + + procedure TObjData.setsection(asec:TObjSection); + begin + if asec.ObjData<>self then + internalerror(200403041); + FCurrObjSec:=asec; + end; + + + function TObjData.createsymbol(const aname:string):TObjSymbol; + begin + result:=TObjSymbol(FObjSymbolList.Find(aname)); + if not assigned(result) then + result:=TObjSymbol.Create(FObjSymbolList,aname); + end; + + + function TObjData.symboldefine(asmsym:TAsmSymbol):TObjSymbol; + begin + if assigned(asmsym) then + begin + if not assigned(asmsym.cachedObjSymbol) then + begin + result:=symboldefine(asmsym.name,asmsym.bind,asmsym.typ); + asmsym.cachedObjSymbol:=result; + FCachedAsmSymbolList.add(asmsym); + end + else + begin + result:=TObjSymbol(asmsym.cachedObjSymbol); + result.SetAddress(CurrPass,CurrObjSec,asmsym.bind,asmsym.typ); + { Register also in TObjSection } + CurrObjSec.AddSymbolDefine(result); + end; + end + else + result:=nil; + end; + + + function TObjData.symboldefine(const aname:string;abind:TAsmsymbind;atyp:Tasmsymtype):TObjSymbol; + begin + if not assigned(CurrObjSec) then + internalerror(200603051); + result:=CreateSymbol(aname); + { Register also in TObjSection } + CurrObjSec.AddSymbolDefine(result); + result.SetAddress(CurrPass,CurrObjSec,abind,atyp); + end; + + + function TObjData.symbolref(asmsym:TAsmSymbol):TObjSymbol; + begin + if assigned(asmsym) then + begin + if not assigned(asmsym.cachedObjSymbol) then + begin + result:=symbolref(asmsym.name); + asmsym.cachedObjSymbol:=result; + FCachedAsmSymbolList.add(asmsym); + end + else + result:=TObjSymbol(asmsym.cachedObjSymbol); + end + else + result:=nil; + end; + + + function TObjData.symbolref(const aname:string):TObjSymbol; + begin + if not assigned(CurrObjSec) then + internalerror(200603052); + result:=CreateSymbol(aname); + end; + + + procedure TObjData.ResetCachedAsmSymbols; + var + i : longint; + begin + for i:=0 to FCachedAsmSymbolList.Count-1 do + tasmsymbol(FCachedAsmSymbolList[i]).cachedObjSymbol:=nil; + FCachedAsmSymbolList.Clear; + end; + + + procedure TObjData.writebytes(const Data;len:aword); + begin + if not assigned(CurrObjSec) then + internalerror(200402251); + CurrObjSec.write(Data,len); + end; + + + procedure TObjData.alloc(len:aword); + begin + if not assigned(CurrObjSec) then + internalerror(200402252); + CurrObjSec.alloc(len); + end; + + + procedure TObjData.allocalign(len:shortint); + begin + if not assigned(CurrObjSec) then + internalerror(200402253); + CurrObjSec.alloc(align(CurrObjSec.size,len)-CurrObjSec.size); + end; + + + procedure TObjData.section_afteralloc(p:TObject;arg:pointer); + begin + with TObjSection(p) do + alloc(align(size,secalign)-size); + end; + + + procedure TObjData.section_afterwrite(p:TObject;arg:pointer); + begin + with TObjSection(p) do + begin + if assigned(Data) then + writezeros(align(size,secalign)-size); + end; + end; + + + procedure TObjData.section_reset(p:TObject;arg:pointer); + begin + with TObjSection(p) do + begin + Size:=0; + Datapos:=0; + mempos:=0; + end; + end; + + + procedure TObjData.beforealloc; + begin + { create stabs sections if debugging } + if assigned(StabsSec) then + begin + StabsSec.Alloc(sizeof(TObjStabEntry)); + StabStrSec.Alloc(1); + end; + end; + + + procedure TObjData.beforewrite; + var + s : string[1]; + hstab : TObjStabEntry; + begin + { create stabs sections if debugging } + if assigned(StabsSec) then + begin + { Create dummy HdrSym stab, it will be overwritten in AfterWrite } + fillchar(hstab,sizeof(hstab),0); + StabsSec.Write(hstab,sizeof(hstab)); + { start of stabstr } + s:=#0; + StabStrSec.write(s[1],length(s)); + end; + end; + + + procedure TObjData.afteralloc; + begin + FObjSectionList.ForEachCall(@section_afteralloc,nil); + end; + + + procedure TObjData.afterwrite; + var + s : string[1]; + hstab : TObjStabEntry; + begin + FObjSectionList.ForEachCall(@section_afterwrite,nil); + { For the stab section we need an HdrSym which can now be + calculated more easily } + if assigned(StabsSec) then + begin + { end of stabstr } + s:=#0; + StabStrSec.write(s[1],length(s)); + { header stab } + hstab.strpos:=1; + hstab.ntype:=0; + hstab.nother:=0; + hstab.ndesc:=(StabsSec.Size div sizeof(TObjStabEntry))-1; + hstab.nvalue:=StabStrSec.Size; + StabsSec.Data.seek(0); + StabsSec.Data.write(hstab,sizeof(hstab)); + end; + end; + + + procedure TObjData.resetsections; + begin + FObjSectionList.ForEachCall(@section_reset,nil); + end; + + +{**************************************************************************** + TObjOutput +****************************************************************************} + + constructor TObjOutput.create(AWriter:TObjectWriter); + begin + FWriter:=AWriter; + CObjData:=TObjData; + end; + + + destructor TObjOutput.destroy; + begin + inherited destroy; + end; + + + function TObjOutput.newObjData(const n:string):TObjData; + begin + result:=CObjData.create(n); + if (cs_use_lineinfo in current_settings.globalswitches) or + (cs_debuginfo in current_settings.moduleswitches) then + result.CreateDebugSections; + end; + + + function TObjOutput.startObjectfile(const fn:string):boolean; + begin + result:=false; + { start the writer already, so the .a generation can initialize + the position of the current objectfile } + if not FWriter.createfile(fn) then + Comment(V_Fatal,'Can''t create object '+fn); + result:=true; + end; + + + function TObjOutput.writeobjectfile(Data:TObjData):boolean; + begin + if errorcount=0 then + result:=writeData(Data) + else + result:=true; + { close the writer } + FWriter.closefile; + end; + + + procedure TObjOutput.exportsymbol(p:TObjSymbol); + begin + { export globals and common symbols, this is needed + for .a files } + if p.bind in [AB_GLOBAL,AB_COMMON] then + FWriter.writesym(p.name); + end; + + +{**************************************************************************** + TExeVTable +****************************************************************************} + + constructor TExeVTable.Create(AExeSymbol:TExeSymbol); + begin + ExeSymbol:=AExeSymbol; + if ExeSymbol.State=symstate_undefined then + internalerror(200604012); + ChildList:=TFPObjectList.Create(false); + end; + + + destructor TExeVTable.Destroy; + begin + ChildList.Free; + if assigned(EntryArray) then + Freemem(EntryArray); + end; + + + procedure TExeVTable.CheckIdx(VTableIdx:longint); + var + OldEntryCnt : longint; + begin + if VTableIdx>=EntryCnt then + begin + OldEntryCnt:=EntryCnt; + EntryCnt:=VTableIdx+1; + ReAllocMem(EntryArray,EntryCnt*sizeof(TVTableEntry)); + FillChar(EntryArray[OldEntryCnt],(EntryCnt-OldEntryCnt)*sizeof(TVTableEntry),0); + end; + end; + + + procedure TExeVTable.AddChild(vt:TExeVTable); + begin + ChildList.Add(vt); + end; + + + procedure TExeVTable.AddEntry(VTableIdx:Longint); + var + i : longint; + objreloc : TObjRelocation; + vtblentryoffset : aword; + begin + CheckIdx(VTableIdx); + vtblentryoffset:=ExeSymbol.ObjSymbol.Offset+longword(VTableIdx)*sizeof(pint); + { Find and disable relocation } + for i:=0 to ExeSymbol.ObjSymbol.ObjSection.ObjRelocations.Count-1 do + begin + objreloc:=TObjRelocation(ExeSymbol.ObjSymbol.ObjSection.ObjRelocations[i]); + if objreloc.dataoffset=vtblentryoffset then + begin + EntryArray[VTableIdx].ObjRelocation:=objreloc; + EntryArray[VTableIdx].OrgRelocType:=objreloc.typ; + objreloc.typ:=RELOC_ZERO; + break; + end; + end; + if not assigned(EntryArray[VTableIdx].ObjRelocation) then + internalerror(200604011); + end; + + + procedure TExeVTable.SetVTableSize(ASize:longint); + begin + if EntryCnt<>0 then + internalerror(200603313); + EntryCnt:=ASize div sizeof(pint); + EntryArray:=AllocMem(EntryCnt*sizeof(TVTableEntry)); + end; + + + function TExeVTable.VTableRef(VTableIdx:Longint):TObjRelocation; + begin + result:=nil; + CheckIdx(VTableIdx); + if EntryArray[VTableIdx].Used then + exit; + { Restore relocation if available } + if assigned(EntryArray[VTableIdx].ObjRelocation) then + begin + EntryArray[VTableIdx].ObjRelocation.typ:=EntryArray[VTableIdx].OrgRelocType; + result:=EntryArray[VTableIdx].ObjRelocation; + end; + EntryArray[VTableIdx].Used:=true; + end; + + +{**************************************************************************** + TExeSection +****************************************************************************} + + constructor TExeSection.create(AList:TFPHashObjectList;const AName:string); + begin + inherited create(AList,AName); + Size:=0; + MemPos:=0; + DataPos:=0; + FSecSymIdx:=0; + FObjSectionList:=TFPObjectList.Create(false); + end; + + + destructor TExeSection.destroy; + begin + ObjSectionList.Free; + inherited destroy; + end; + + + procedure TExeSection.AddObjSection(objsec:TObjSection); + begin + ObjSectionList.Add(objsec); + if (SecOptions<>[]) then + begin + { Only if the section contains (un)initialized data the + data flag must match. This check is not needed if the + section is empty for a symbol allocation } + if (objsec.size>0) and + ((oso_Data in SecOptions)<>(oso_Data in objsec.SecOptions)) then + Comment(V_Error,'Incompatible section options'); + end + else + begin + { inherit section options } + SecAlign:=objsec.SecAlign; + SecOptions:=SecOptions+objsec.SecOptions; + end; + { relate ObjSection to ExeSection, and mark it Used by default } + objsec.ExeSection:=self; + objsec.Used:=true; + end; + + +{**************************************************************************** + TStaticLibrary +****************************************************************************} + + constructor TStaticLibrary.create(AList:TFPHashObjectList;const AName:string;AReader:TObjectReader;AObjInputClass:TObjInputClass); + begin + inherited create(AList,AName); + FArReader:=AReader; + FObjInputClass:=AObjInputClass; + end; + + + destructor TStaticLibrary.destroy; + begin + ArReader.Free; + inherited destroy; + end; + + +{**************************************************************************** + TImportLibrary +****************************************************************************} + + constructor TImportLibrary.create(AList:TFPHashObjectList;const AName:string); + begin + inherited create(AList,AName); + FImportSymbolList:=TFPHashObjectList.Create(true); + end; + + + destructor TImportLibrary.destroy; + begin + ImportSymbolList.Free; + inherited destroy; + end; + + +{**************************************************************************** + TImportSymbol +****************************************************************************} + + constructor TImportSymbol.create(AList:TFPHashObjectList; + const AName,AMangledName:string;AOrdNr:longint;AIsVar:boolean); + begin + inherited Create(AList, AName); + FOrdNr:=AOrdNr; + FIsVar:=AIsVar; + FMangledName:=AMangledName; + { Replace ? and @ in import name, since GNU AS does not allow these characters in symbol names. } + { This allows to import VC++ mangled names from DLLs. } + if target_info.system in systems_all_windows then + begin + Replace(FMangledName,'?','__q$$'); +{$ifdef arm} + { @ symbol is not allowed in ARM assembler only } + Replace(FMangledName,'@','__a$$'); +{$endif arm} + end; + end; + + +{**************************************************************************** + TExeOutput +****************************************************************************} + + constructor TExeOutput.create; + begin + { init writer } + FWriter:=TObjectwriter.create; + FExeWriteMode:=ewm_exefull; + { object files } + FObjDataList:=TFPObjectList.Create(true); + { symbols } + FExeSymbolList:=TFPHashObjectList.Create(true); + FUnresolvedExeSymbols:=TFPObjectList.Create(false); + FExternalObjSymbols:=TFPObjectList.Create(false); + FCommonObjSymbols:=TFPObjectList.Create(false); + FExeVTableList:=TFPObjectList.Create(false); + FEntryName:='start'; + { sections } + FExeSectionList:=TFPHashObjectList.Create(true); + FImageBase:=0; +{$ifdef cpu16bitaddr} + SectionMemAlign:=$10; + SectionDataAlign:=$10; +{$else cpu16bitaddr} + SectionMemAlign:=$1000; + SectionDataAlign:=$200; +{$endif cpu16bitaddr} + FCExeSection:=TExeSection; + FCObjData:=TObjData; + end; + + + destructor TExeOutput.destroy; + begin + FExeSymbolList.free; + UnresolvedExeSymbols.free; + ExternalObjSymbols.free; + CommonObjSymbols.free; + ExeVTableList.free; + FExeSectionList.free; + ObjDatalist.free; + FWriter.free; + inherited destroy; + end; + + + function TExeOutput.WriteExeFile(const fn:string):boolean; + begin + result:=false; + if FWriter.createfile(fn) then + begin + { Only write the .o if there are no errors } + if errorcount=0 then + result:=writedata + else + result:=true; + { close the writer } + FWriter.closefile; + end + else + Comment(V_Fatal,'Can''t create executable '+fn); + end; + + + procedure TExeOutput.ParseScript (linkscript:TCmdStrList); + begin + end; + + + function TExeOutput.FindExeSection(const aname:string):TExeSection; + begin + result:=TExeSection(ExeSectionList.Find(aname)); + end; + + + procedure TExeOutput.AddObjData(ObjData:TObjData); + begin + if ObjData.classtype<>FCObjData then + Comment(V_Error,'Invalid input object format for '+ObjData.name+' got '+ObjData.classname+' expected '+FCObjData.classname); + ObjDataList.Add(ObjData); + end; + + + procedure TExeOutput.Load_Start; + begin + ObjDataList.Clear; + { Globals defined in the linker script } + if not assigned(internalObjData) then + internalObjData:=CObjData.create('*Internal*'); + AddObjData(internalObjData); + { Common Data section } + commonObjSection:=internalObjData.createsection(sec_bss,''); + end; + + + procedure TExeOutput.Load_EntryName(const aname:string); + begin + FEntryName:=aname; + end; + + + procedure TExeOutput.Load_IsSharedLibrary; + begin + IsSharedLibrary:=true; + end; + + + procedure TExeOutput.Load_ImageBase(const avalue:string); + var + code : integer; + objsec : TObjSection; + objsym : TObjSymbol; + exesym : TExeSymbol; + begin + val(avalue,ImageBase,code); + if code<>0 then + Comment(V_Error,'Invalid number '+avalue); + { Create __image_base__ symbol, create the symbol + in a section with adress 0 and at offset 0 } + objsec:=internalObjData.createsection('*__image_base__',0,[]); + internalObjData.setsection(objsec); + objsym:=internalObjData.SymbolDefine('__image_base__',AB_GLOBAL,AT_FUNCTION); + exesym:=texesymbol.Create(FExeSymbolList,objsym.name); + exesym.ObjSymbol:=objsym; + end; + + + procedure TExeOutput.Load_Symbol(const aname:string); + begin + internalObjData.createsection('*'+aname,0,[]); + internalObjData.SymbolDefine(aname,AB_GLOBAL,AT_FUNCTION); + end; + + procedure TExeOutput.Load_ProvideSymbol(const aname:string); + begin + if assigned(ExeSymbolList.Find(aname)) then + exit; + internalObjData.createsection('*'+aname,0,[]); + // Use AB_COMMON to avoid muliple defined complaints + internalObjData.SymbolDefine(aname,AB_COMMON,AT_DATA); + end; + + + procedure TExeOutput.Order_Start; + begin + end; + + + procedure TExeOutput.Order_End; + begin + internalObjData.afterwrite; + end; + + + procedure TExeOutput.Order_ExeSection(const aname:string); + var + sec : TExeSection; + begin + sec:=FindExeSection(aname); + if not assigned(sec) then + sec:=CExeSection.create(ExeSectionList,aname); + { Clear ExeSection contents } + FCurrExeSec:=sec; + end; + + + procedure TExeOutput.Order_EndExeSection; + begin + if not assigned(CurrExeSec) then + internalerror(200602184); + FCurrExeSec:=nil; + end; + + + procedure TExeOutput.Order_ObjSection(const aname:string); + var + i,j : longint; + ObjData : TObjData; + objsec : TObjSection; + TmpObjSectionList : TFPObjectList; + begin + if not assigned(CurrExeSec) then + internalerror(200602181); + TmpObjSectionList:=TFPObjectList.Create(false); + for i:=0 to ObjDataList.Count-1 do + begin + ObjData:=TObjData(ObjDataList[i]); + for j:=0 to ObjData.ObjSectionList.Count-1 do + begin + objsec:=TObjSection(ObjData.ObjSectionList[j]); + if (not objsec.Used) and + MatchPattern(aname,objsec.name) then + TmpObjSectionList.Add(objsec); + end; + end; + { Order list if needed } + Order_ObjSectionList(TmpObjSectionList,aname); + { Add the (ordered) list to the current ExeSection } + for i:=0 to TmpObjSectionList.Count-1 do + begin + objsec:=TObjSection(TmpObjSectionList[i]); + CurrExeSec.AddObjSection(objsec); + end; + TmpObjSectionList.Free; + end; + + + procedure TExeOutput.Order_ObjSectionList(ObjSectionList : TFPObjectList; const aPattern:string); + begin + end; + + + procedure TExeOutput.Order_Symbol(const aname:string); + var + ObjSection : TObjSection; + begin + ObjSection:=internalObjData.findsection('*'+aname); + if not assigned(ObjSection) then + internalerror(200603041); + CurrExeSec.AddObjSection(ObjSection); + end; + + procedure TExeOutput.Order_ProvideSymbol(const aname:string); + var + ObjSection : TObjSection; + begin + ObjSection:=internalObjData.findsection('*'+aname); + if not assigned(ObjSection) then + internalerror(200603041); + { Only include this section if the symbol doesn't + exist otherwisee } + if not assigned(ExeSymbolList.Find(aname)) then + CurrExeSec.AddObjSection(ObjSection); + end; + + + procedure TExeOutput.Order_Align(const avalue:string); + var + code : integer; + alignval : shortint; + objsec : TObjSection; + begin + val(avalue,alignval,code); + if code<>0 then + Comment(V_Error,'Invalid number '+avalue); + if alignval<=0 then + exit; + { Create an empty section with the required aligning } + inc(Fzeronr); + objsec:=internalObjData.createsection('*align'+tostr(Fzeronr),alignval,CurrExeSec.SecOptions+[oso_Data,oso_keep]); + CurrExeSec.AddObjSection(objsec); + end; + + + procedure TExeOutput.Order_Zeros(const avalue:string); + var + zeros : array[0..1023] of byte; + code : integer; + len : longint; + objsec : TObjSection; + begin + val(avalue,len,code); + if code<>0 then + Comment(V_Error,'Invalid number '+avalue); + if len<=0 then + exit; + if len>sizeof(zeros) then + internalerror(200602254); + fillchar(zeros,len,0); + inc(Fzeronr); + objsec:=internalObjData.createsection('*zeros'+tostr(Fzeronr),0,CurrExeSec.SecOptions+[oso_Data,oso_keep]); + internalObjData.writebytes(zeros,len); + CurrExeSec.AddObjSection(objsec); + end; + + procedure TExeOutput.Order_Values(bytesize : aword; const avalue:string); + const + MAXVAL = 128; + var + bytevalues : array[0..MAXVAL-1] of byte; + twobytevalues : array[0..MAXVAL-1] of word; + fourbytevalues : array[0..MAXVAL-1] of dword; + eightbytevalues : array[0..MAXVAL-1] of qword; + allvals, oneval : string; + len, commapos : longint; + indexpos, code : integer; + anumval : qword; + signedval : int64; + objsec : TObjSection; + begin + indexpos:=0; + allvals:=avalue; + repeat + commapos:=pos(',',allvals); + if commapos>0 then + begin + oneval:=trim(copy(allvals,1,commapos-1)); + allvals:=copy(allvals,commapos+1,length(allvals)); + end + else + begin + oneval:=trim(allvals); + allvals:=''; + end; + if oneval<>'' then + begin + if oneval[1]='-' then + begin + val(oneval,signedval,code); + anumval:=qword(signedval); + end + else + val(oneval,anumval,code); + if code<>0 then + Comment(V_Error,'Invalid number '+avalue) + else + begin + if (indexpos<MAXVAL) then + begin + if source_info.endian<>target_info.endian then + swapendian(anumval); + { No range checking here } + + if bytesize=1 then + bytevalues[indexpos]:=byte(anumval) + else if bytesize=2 then + twobytevalues[indexpos]:=word(anumval) + else if bytesize=4 then + fourbytevalues[indexpos]:=dword(anumval) + else if bytesize=8 then + eightbytevalues[indexpos]:=anumval; + inc(indexpos); + end + else + Comment(V_Error,'Buffer overrun in Order_values'); + end; + end; + until allvals=''; + if indexpos=0 then + begin + Comment(V_Error,'Invalid number '+avalue); + exit; + end; + if indexpos=MAXVAL then + begin + Comment(V_Error,'Too many values '+avalue); + internalerror(200602254); + end; + len:=bytesize*indexpos; + inc(Fvaluesnr); + objsec:=internalObjData.createsection('*values'+tostr(Fvaluesnr),0,CurrExeSec.SecOptions+[oso_Data,oso_keep]); + if bytesize=1 then + internalObjData.writebytes(bytevalues,len) + else if bytesize=2 then + internalObjData.writebytes(twobytevalues,len) + else if bytesize=4 then + internalObjData.writebytes(fourbytevalues,len) + else if bytesize=8 then + internalObjData.writebytes(eightbytevalues,len); + CurrExeSec.AddObjSection(objsec); + end; + + + procedure TExeOutput.MemPos_Start; + begin + CurrMemPos:=0; + end; + + + procedure TExeOutput.MemPos_Header; + begin + end; + + + procedure TExeOutput.MemPos_ExeSection(const aname:string); + var + i : longint; + objsec : TObjSection; + begin + { Section can be removed } + FCurrExeSec:=FindExeSection(aname); + if not assigned(CurrExeSec) then + exit; + + { Alignment of ExeSection } + CurrMemPos:=align(CurrMemPos,SectionMemAlign); + CurrExeSec.MemPos:=CurrMemPos; + + { set position of object ObjSections } + for i:=0 to CurrExeSec.ObjSectionList.Count-1 do + begin + objsec:=TObjSection(CurrExeSec.ObjSectionList[i]); + CurrMemPos:=objsec.setmempos(CurrMemPos); + end; + + { calculate size of the section } + CurrExeSec.Size:=CurrMemPos-CurrExeSec.MemPos; + end; + + + procedure TExeOutput.MemPos_EndExeSection; + begin + if not assigned(CurrExeSec) then + exit; + FCurrExeSec:=nil; + end; + + + procedure TExeOutput.DataPos_Start; + begin + end; + + + procedure TExeOutput.DataPos_Header; + begin + end; + + + procedure TExeOutput.DataPos_ExeSection(const aname:string); + var + i : longint; + objsec : TObjSection; + begin + { Section can be removed } + FCurrExeSec:=FindExeSection(aname); + if not assigned(CurrExeSec) then + exit; + + { don't write normal section if writing only debug info } + if (ExeWriteMode=ewm_dbgonly) and + not(oso_debug in CurrExeSec.SecOptions) then + exit; + + if (oso_Data in currexesec.SecOptions) then + begin + CurrDataPos:=align(CurrDataPos,SectionDataAlign); + CurrExeSec.DataPos:=CurrDataPos; + end; + + { set position of object ObjSections } + for i:=0 to CurrExeSec.ObjSectionList.Count-1 do + begin + objsec:=TObjSection(CurrExeSec.ObjSectionList[i]); + if (oso_Data in objsec.SecOptions) then + begin + if not(oso_Data in currexesec.SecOptions) then + internalerror(200603043); + if not assigned(objsec.Data) then + internalerror(200603044); + objsec.setDatapos(CurrDataPos); + end; + end; + end; + + + procedure TExeOutput.DataPos_EndExeSection; + begin + if not assigned(CurrExeSec) then + exit; + FCurrExeSec:=nil; + end; + + + procedure TExeOutput.DataPos_Symbols; + var + i : longint; + sym : TExeSymbol; + begin + { Removing unused symbols } + for i:=0 to ExeSymbolList.Count-1 do + begin + sym:=TExeSymbol(ExeSymbolList[i]); + if not sym.ObjSymbol.objsection.Used then + ExeSymbolList[i]:=nil; + end; + ExeSymbolList.Pack; + end; + + + procedure TExeOutput.BuildVTableTree(VTInheritList,VTEntryList:TFPObjectList); + var + hs : string; + code : integer; + i,k, + vtableidx : longint; + vtableexesym, + childexesym, + parentexesym : TExeSymbol; + objsym : TObjSymbol; + begin + { Build inheritance tree from VTINHERIT } + for i:=0 to VTInheritList.Count-1 do + begin + objsym:=TObjSymbol(VTInheritList[i]); + hs:=objsym.name; + { VTINHERIT_<ChildVMTName>$$<ParentVMTName> } + Delete(hs,1,Pos('_',hs)); + k:=Pos('$$',hs); + if k=0 then + internalerror(200603311); + childexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,1,k-1))); + parentexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,k+2,length(hs)-k-1))); + if not assigned(childexesym) or + not assigned(parentexesym)then + internalerror(200603312); + if not assigned(childexesym.vtable) then + begin + childexesym.vtable:=TExeVTable.Create(childexesym); + ExeVTableList.Add(childexesym.vtable); + end; + if not assigned(parentexesym.vtable) then + begin + parentexesym.vtable:=TExeVTable.Create(parentexesym); + ExeVTableList.Add(parentexesym.vtable); + end; + childexesym.vtable.SetVTableSize(childexesym.ObjSymbol.Size); + if parentexesym<>childexesym then + parentexesym.vtable.AddChild(childexesym.vtable); + end; + + { Find VTable entries from VTENTRY } + for i:=0 to VTEntryList.Count-1 do + begin + objsym:=TObjSymbol(VTEntryList[i]); + hs:=objsym.name; + { VTENTRY_<VTableName>$$<Index> } + Delete(hs,1,Pos('_',hs)); + k:=Pos('$$',hs); + if k=0 then + internalerror(200603319); + vtableexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,1,k-1))); + val(Copy(hs,k+2,length(hs)-k-1),vtableidx,code); + if (code<>0) then + internalerror(200603318); + if not assigned(vtableexesym) then + internalerror(2006033110); + vtableexesym.vtable.AddEntry(vtableidx); + end; + end; + + + procedure TExeOutput.PackUnresolvedExeSymbols(const s:string); + var + i : longint; + exesym : TExeSymbol; + begin + { Generate a list of Unresolved External symbols } + for i:=0 to UnresolvedExeSymbols.count-1 do + begin + exesym:=TExeSymbol(UnresolvedExeSymbols[i]); + if exesym.State<>symstate_undefined then + UnresolvedExeSymbols[i]:=nil; + end; + UnresolvedExeSymbols.Pack; + Comment(V_Debug,'Number of unresolved externals '+s+' '+tostr(UnresolvedExeSymbols.Count)); + end; + + + procedure TExeOutput.ResolveSymbols(StaticLibraryList:TFPHashObjectList); + var + ObjData : TObjData; + exesym : TExeSymbol; + objsym, + commonsym : TObjSymbol; + objinput : TObjInput; + StaticLibrary : TStaticLibrary; + firstarchive, + firstcommon : boolean; + i,j : longint; + VTEntryList, + VTInheritList : TFPObjectList; + + procedure LoadObjDataSymbols(ObjData:TObjData); + var + j : longint; + hs : string; + exesym : TExeSymbol; + objsym : TObjSymbol; + begin + for j:=0 to ObjData.ObjSymbolList.Count-1 do + begin + objsym:=TObjSymbol(ObjData.ObjSymbolList[j]); + { From the local symbols we are only interressed in the + VTENTRY and VTINHERIT symbols } + if objsym.bind=AB_LOCAL then + begin + if cs_link_opt_vtable in current_settings.globalswitches then + begin + hs:=objsym.name; + if (hs[1]='V') then + begin + if Copy(hs,1,5)='VTREF' then + begin + if not assigned(objsym.ObjSection.VTRefList) then + objsym.ObjSection.VTRefList:=TFPObjectList.Create(false); + objsym.ObjSection.VTRefList.Add(objsym); + end + else if Copy(hs,1,7)='VTENTRY' then + VTEntryList.Add(objsym) + else if Copy(hs,1,9)='VTINHERIT' then + VTInheritList.Add(objsym); + end; + end; + continue; + end; + { Search for existing exesymbol } + exesym:=texesymbol(FExeSymbolList.Find(objsym.name)); + if not assigned(exesym) then + begin + exesym:=texesymbol.Create(FExeSymbolList,objsym.name); + exesym.ObjSymbol:=objsym; + end; + objsym.ExeSymbol:=exesym; + case objsym.bind of + AB_GLOBAL : + begin + if exesym.State<>symstate_defined then + begin + exesym.ObjSymbol:=objsym; + exesym.State:=symstate_defined; + end + else + Comment(V_Error,'Multiple defined symbol '+objsym.name); + end; + AB_EXTERNAL : + begin + ExternalObjSymbols.add(objsym); + { Register unresolved symbols only the first time they + are registered } + if exesym.ObjSymbol=objsym then + UnresolvedExeSymbols.Add(exesym); + end; + AB_COMMON : + begin + if exesym.State=symstate_undefined then + begin + exesym.ObjSymbol:=objsym; + exesym.State:=symstate_common; + end; + CommonObjSymbols.add(objsym); + end; + end; + end; + end; + + begin + VTEntryList:=TFPObjectList.Create(false); + VTInheritList:=TFPObjectList.Create(false); + + { + The symbol resolving is done in 3 steps: + 1. Register symbols from objects + 2. Find symbols in static libraries + 3. Define stil undefined common symbols + } + + { Step 1, Register symbols from objects } + for i:=0 to ObjDataList.Count-1 do + begin + ObjData:=TObjData(ObjDataList[i]); + LoadObjDataSymbols(ObjData); + end; + PackUnresolvedExeSymbols('in objects'); + + { Step 2, Find unresolved symbols in the libraries } + firstarchive:=true; + for i:=0 to StaticLibraryList.Count-1 do + begin + StaticLibrary:=TStaticLibrary(StaticLibraryList[i]); + { Process list of Unresolved External symbols, we need + to use a while loop because the list can be extended when + we load members from the library. } + j:=0; + while (j<UnresolvedExeSymbols.count) do + begin + exesym:=TExeSymbol(UnresolvedExeSymbols[j]); + { Check first if the symbol is still undefined } + if exesym.State=symstate_undefined then + begin + if StaticLibrary.ArReader.OpenFile(exesym.name) then + begin + if assigned(exemap) then + begin + if firstarchive then + begin + exemap.Add(''); + exemap.Add('Archive member included because of file (symbol)'); + exemap.Add(''); + firstarchive:=false; + end; + exemap.Add(StaticLibrary.ArReader.FileName+' - '+ + {exesym.ObjSymbol.ObjSection.FullName+} + '('+exesym.Name+')'); + end; + objinput:=StaticLibrary.ObjInputClass.Create; + objdata:=objinput.newObjData(StaticLibrary.ArReader.FileName); + objinput.ReadObjData(StaticLibrary.ArReader,objdata); + objinput.free; + AddObjData(objdata); + LoadObjDataSymbols(objdata); + StaticLibrary.ArReader.CloseFile; + end; + end; + inc(j); + end; + end; + PackUnresolvedExeSymbols('after static libraries'); + + { Step 3, Match common symbols or add to the globals } + firstcommon:=true; + for i:=0 to CommonObjSymbols.count-1 do + begin + objsym:=TObjSymbol(CommonObjSymbols[i]); + if objsym.exesymbol.State=symstate_defined then + begin + if objsym.exesymbol.ObjSymbol.size<>objsym.size then + Comment(V_Debug,'Size of common symbol '+objsym.name+' is different, expected '+tostr(objsym.size)+' got '+tostr(objsym.exesymbol.ObjSymbol.size)); + end + else + begin + { allocate new objsymbol in .bss of *COMMON* and assign + it to the exesymbol } + if firstcommon then + begin + if assigned(exemap) then + exemap.AddCommonSymbolsHeader; + firstcommon:=false; + end; + internalObjData.setsection(commonObjSection); + internalObjData.allocalign(var_align(objsym.size)); + commonsym:=internalObjData.symboldefine(objsym.name,AB_GLOBAL,AT_FUNCTION); + commonsym.size:=objsym.size; + internalObjData.alloc(objsym.size); + if assigned(exemap) then + exemap.AddCommonSymbol(commonsym); + { Assign to the exesymbol } + objsym.exesymbol.objsymbol:=commonsym; + objsym.exesymbol.state:=symstate_defined; + end; + end; + PackUnresolvedExeSymbols('after defining COMMON symbols'); + + { Find entry symbol and print in map } + exesym:=texesymbol(ExeSymbolList.Find(EntryName)); + if assigned(exesym) then + begin + EntrySym:=exesym.ObjSymbol; + if assigned(exemap) then + begin + exemap.Add(''); + exemap.Add('Entry symbol '+EntryName); + end; + end + else + Comment(V_Error,'Entrypoint '+EntryName+' not defined'); + + { Generate VTable tree } + if cs_link_opt_vtable in current_settings.globalswitches then + BuildVTableTree(VTInheritList,VTEntryList); + VTInheritList.Free; + VTEntryList.Free; + end; + + + procedure TExeOutput.GenerateDebugLink(const dbgname:string;dbgcrc:cardinal); + var + debuglink : array[0..1023] of byte; + len : longint; + objsec : TObjSection; + exesec : TExeSection; + begin + { From the gdb manual chapter 15. GDB Files: + + * A filename, with any leading directory components removed, followed by a zero byte, + * zero to three bytes of padding, as needed to reach the next four-byte boundary within the section, and + * a four-byte CRC checksum, stored in the same endianness used for the executable file itself. The checksum is computed + on the debugging information file's full contents by the function given below, passing zero as the crc argument. + } + fillchar(debuglink,sizeof(debuglink),0); + len:=0; + move(dbgname[1],debuglink[len],length(dbgname)); + inc(len,length(dbgname)+1); + len:=align(len,4); + if source_info.endian<>target_info.endian then + SwapEndian(dbgcrc); + move(dbgcrc,debuglink[len],sizeof(cardinal)); + inc(len,4); + { Add section } + exesec:=FindExeSection(debuglinkname); + if not assigned(exesec) then + exesec:=CExeSection.create(ExeSectionList,debuglinkname); + exesec.SecOptions:=[oso_data,oso_keep]; + exesec.SecAlign:=4; + objsec:=internalObjData.createsection(exesec.name,0,exesec.SecOptions); + internalObjData.writebytes(debuglink,len); + exesec.AddObjSection(objsec); + end; + + + procedure TExeOutput.GenerateLibraryImports(ImportLibraryList:TFPHashObjectList); + begin + end; + + + procedure TExeOutput.PrintMemoryMap; + var + exesec : TExeSection; + objsec : TObjSection; + objsym : TObjSymbol; + i,j,k : longint; + begin + if not assigned(exemap) then + exit; + exemap.AddMemoryMapHeader(ImageBase); + for i:=0 to ExeSectionList.Count-1 do + begin + exesec:=TExeSection(ExeSectionList[i]); + exemap.AddMemoryMapExeSection(exesec); + for j:=0 to exesec.ObjSectionList.count-1 do + begin + objsec:=TObjSection(exesec.ObjSectionList[j]); + exemap.AddMemoryMapObjectSection(objsec); + for k:=0 to objsec.ObjSymbolDefines.Count-1 do + begin + objsym:=TObjSymbol(objsec.ObjSymbolDefines[k]); + exemap.AddMemoryMapSymbol(objsym); + end; + end; + end; + end; + + + procedure TExeOutput.FixupSymbols; + + procedure UpdateSymbol(objsym:TObjSymbol); + begin + objsym.bind:=objsym.ExeSymbol.ObjSymbol.bind; + objsym.offset:=objsym.ExeSymbol.ObjSymbol.offset; + objsym.size:=objsym.ExeSymbol.ObjSymbol.size; + objsym.typ:=objsym.ExeSymbol.ObjSymbol.typ; + objsym.ObjSection:=objsym.ExeSymbol.ObjSymbol.ObjSection; + end; + + var + i : longint; + objsym : TObjSymbol; + exesym : TExeSymbol; + begin + { Print list of Unresolved External symbols } + for i:=0 to UnresolvedExeSymbols.count-1 do + begin + exesym:=TExeSymbol(UnresolvedExeSymbols[i]); + if exesym.State<>symstate_defined then + Comment(V_Error,'Undefined symbol: '+exesym.name); + end; + + { Update ImageBase to ObjData so it can access from ObjSymbols } + for i:=0 to ObjDataList.Count-1 do + TObjData(ObjDataList[i]).imagebase:=imagebase; + + { + Fixing up symbols is done in the following steps: + 1. Update common references + 2. Update external references + } + + { Step 1, Update commons } + for i:=0 to CommonObjSymbols.count-1 do + begin + objsym:=TObjSymbol(CommonObjSymbols[i]); + if objsym.bind<>AB_COMMON then + internalerror(200606241); + UpdateSymbol(objsym); + end; + + { Step 2, Update externals } + for i:=0 to ExternalObjSymbols.count-1 do + begin + objsym:=TObjSymbol(ExternalObjSymbols[i]); + if objsym.bind<>AB_EXTERNAL then + internalerror(200606242); + UpdateSymbol(objsym); + end; + end; + + + procedure TExeOutput.MergeStabs; + var + stabexesec, + stabstrexesec : TExeSection; + relocsec, + currstabsec, + currstabstrsec, + mergedstabsec, + mergedstabstrsec : TObjSection; + hstabreloc, + currstabreloc : TObjRelocation; + i,j : longint; + currstabrelocidx, + mergestabcnt, + stabcnt : longword; + skipstab : boolean; + skipfun : boolean; + hstab : TObjStabEntry; + stabrelocofs : longword; + buf : array[0..1023] of byte; + bufend, + bufsize : longint; + begin + stabexesec:=FindExeSection('.stab'); + stabstrexesec:=FindExeSection('.stabstr'); + if (stabexesec=nil) or + (stabstrexesec=nil) or + (stabexesec.ObjSectionlist.count=0) then + exit; + { Create new stabsection } + stabRelocofs:=pbyte(@hstab.nvalue)-pbyte(@hstab); + mergedstabsec:=internalObjData.CreateSection(sec_stab,''); + mergedstabstrsec:=internalObjData.CreateSection(sec_stabstr,''); + + { write stab for hdrsym } + fillchar(hstab,sizeof(TObjStabEntry),0); + mergedstabsec.write(hstab,sizeof(TObjStabEntry)); + mergestabcnt:=1; + + { .stabstr starts with a #0 } + buf[0]:=0; + mergedstabstrsec.write(buf[0],1); + + skipfun:=false; + { Copy stabs and corresponding Relocations } + for i:=0 to stabexesec.ObjSectionList.Count-1 do + begin + currstabsec:=TObjSection(stabexesec.ObjSectionList[i]); + currstabstrsec:=currstabsec.ObjData.findsection('.stabstr'); + if assigned(currstabstrsec) then + begin + stabcnt:=currstabsec.Data.size div sizeof(TObjStabEntry); + currstabsec.Data.seek(0); + currstabrelocidx:=0; + for j:=0 to stabcnt-1 do + begin + hstabreloc:=nil; + skipstab:=false; + currstabsec.Data.read(hstab,sizeof(TObjStabEntry)); + { Only include first hdrsym stab } + if hstab.ntype=0 then + skipstab:=true; + if skipfun then + begin + { Skip all stabs for function body until N_RBRAC } + skipfun:=hstab.ntype<>N_RBRAC; + skipstab:=true; + end; + if not skipstab then + begin + { Find corresponding Relocation } + currstabreloc:=nil; + while (currstabrelocidx<longword(currstabsec.ObjRelocations.Count)) do + begin + currstabreloc:=TObjRelocation(currstabsec.ObjRelocations[currstabrelocidx]); + if assigned(currstabreloc) and + (currstabreloc.dataoffset>=longword(j)*sizeof(TObjStabEntry)+stabrelocofs) then + break; + inc(currstabrelocidx); + end; + if assigned(currstabreloc) and + (currstabreloc.dataoffset=longword(j)*sizeof(TObjStabEntry)+stabrelocofs) then + begin + hstabReloc:=currstabReloc; + inc(currstabrelocidx); + end; + + { Check if the stab is refering to a removed section } + if assigned(hstabreloc) then + begin + if assigned(hstabreloc.Symbol) then + relocsec:=hstabreloc.Symbol.ObjSection + else + relocsec:=hstabreloc.ObjSection; + if not assigned(relocsec) then + internalerror(200603302); + if not relocsec.Used then + begin + skipstab:=true; + if (hstab.ntype=N_Function) and (hstab.strpos<>0) then + begin + currstabstrsec.Data.seek(hstab.strpos); + bufsize:=currstabstrsec.Data.read(buf,sizeof(buf)); + bufend:=indexbyte(buf,bufsize,Ord(':')); + if (bufend<>-1) and (bufend<bufsize-1) and (buf[bufend+1]=Ord('F')) then + skipfun:=true; + end; + end; + end; + end; + if not skipstab then + begin + { Copy string in stabstr } + if hstab.strpos<>0 then + begin + currstabstrsec.Data.seek(hstab.strpos); + hstab.strpos:=mergedstabstrsec.Size; + repeat + bufsize:=currstabstrsec.Data.read(buf,sizeof(buf)); + bufend:=indexbyte(buf,bufsize,0); + if bufend=-1 then + bufend:=bufsize + else + begin + { include the #0 } + inc(bufend); + end; + mergedstabstrsec.write(buf,bufend); + until (buf[bufend-1]=0) or (bufsize<sizeof(buf)); + end; + { Copy and Update the relocation } + if assigned(hstabreloc) then + begin + hstabreloc.Dataoffset:=mergestabcnt*sizeof(TObjStabEntry)+stabRelocofs; + { Remove from List without freeing the object } + currstabsec.ObjRelocations.List[currstabrelocidx-1]:=nil; + mergedstabsec.ObjRelocations.Add(hstabreloc); + end; + { Write updated stab } + mergedstabsec.write(hstab,sizeof(hstab)); + inc(mergestabcnt); + end; + end; + end; + + { Unload stabs } + if assigned(currstabstrsec) then + begin + currstabstrsec.Used:=False; + currstabstrsec.ReleaseData; + end; + currstabsec.Used:=false; + currstabsec.ReleaseData; + end; + + { Generate new HdrSym } + if mergedstabsec.Size>0 then + begin + hstab.strpos:=1; + hstab.ntype:=0; + hstab.nother:=0; + hstab.ndesc:=word(mergestabcnt-1); + hstab.nvalue:=mergedstabstrsec.Size; + mergedstabsec.Data.seek(0); + mergedstabsec.Data.write(hstab,sizeof(hstab)); + end; + + { Replace all sections with our combined stabsec } + stabexesec.ObjSectionList.Clear; + stabstrexesec.ObjSectionList.Clear; + stabexesec.AddObjSection(mergedstabsec); + stabstrexesec.AddObjSection(mergedstabstrsec); + end; + + + procedure TExeOutput.RemoveEmptySections; + var + i, j : longint; + exesec : TExeSection; + doremove : boolean; + begin + for i:=0 to ExeSectionList.Count-1 do + begin + exesec:=TExeSection(ExeSectionList[i]); + + doremove:=not(oso_keep in exesec.SecOptions) and + ( + (exesec.ObjSectionlist.count=0) or + ( + (cs_link_strip in current_settings.globalswitches) and + not(cs_link_separate_dbg_file in current_settings.globalswitches) and + (oso_debug in exesec.SecOptions) + ) + ); + if not doremove then + begin + { Check if section has no actual data } + doremove:=true; + for j:=0 to exesec.ObjSectionList.Count-1 do + if TObjSection(exesec.ObjSectionList[j]).Size<>0 then + begin + doremove:=false; + break; + end; + end; + if doremove and not (RelocSection and (exesec.Name='.reloc')) then + begin + Comment(V_Debug,'Deleting empty section '+exesec.name); + ExeSectionList[i]:=nil; + end; + end; + ExeSectionList.Pack; + end; + + + procedure TExeOutput.RemoveDebugInfo; + var + i : longint; + exesec : TExeSection; + begin + for i:=0 to ExeSectionList.Count-1 do + begin + exesec:=TExeSection(ExeSectionList[i]); + if (oso_debug in exesec.SecOptions) then + ExeSectionList[i]:=nil; + end; + ExeSectionList.Pack; + end; + + + procedure TExeOutput.RemoveUnreferencedSections; + var + ObjSectionWorkList : TFPObjectList; + + procedure AddToObjSectionWorkList(aobjsec:TObjSection); + begin + if not aobjsec.Used then + begin + aobjsec.Used:=true; + ObjSectionWorkList.Add(aobjsec); + end; + end; + + procedure DoReloc(objreloc:TObjRelocation); + var + objsym : TObjSymbol; + refobjsec : TObjSection; + begin + { Disabled Relocation to 0 } + if objreloc.typ=RELOC_ZERO then + exit; + if assigned(objreloc.symbol) then + begin + objsym:=objreloc.symbol; + if objsym.bind<>AB_LOCAL then + begin + if not(assigned(objsym.exesymbol) and + (objsym.exesymbol.State=symstate_defined)) then + internalerror(200603063); + objsym:=objsym.exesymbol.objsymbol; + end; + if not assigned(objsym.objsection) then + internalerror(200603062); + refobjsec:=objsym.objsection; + end + else + if assigned(objreloc.objsection) then + refobjsec:=objreloc.objsection + else + internalerror(200603316); + if assigned(exemap) then + begin + objsym:=objreloc.symbol; + if assigned(objsym) then + exemap.Add(' References '+objsym.name+' in ' + +refobjsec.fullname) + else + exemap.Add(' References '+refobjsec.fullname); + end; + AddToObjSectionWorkList(refobjsec); + end; + + procedure DoVTableRef(vtable:TExeVTable;VTableIdx:longint); + var + i : longint; + objreloc : TObjRelocation; + begin + objreloc:=vtable.VTableRef(VTableIdx); + if assigned(objreloc) then + begin + { Process the relocation now if the ObjSection is + already processed and marked as used. Otherwise we leave it + unprocessed. It'll then be resolved when the ObjSection is + changed to Used } + if vtable.ExeSymbol.ObjSymbol.ObjSection.Used then + DoReloc(objreloc); + end; + { This recursive walking is done here instead of + in TExeVTable.VTableRef because we can now process + all needed relocations } + for i:=0 to vtable.ChildList.Count-1 do + DoVTableRef(TExeVTable(vtable.ChildList[i]),VTableIdx); + end; + + var + hs : string; + i,j,k : longint; + exesec : TExeSection; + objdata : TObjData; + objsec : TObjSection; + objsym : TObjSymbol; + code : integer; + vtableidx : longint; + vtableexesym : TExeSymbol; + begin + ObjSectionWorkList:=TFPObjectList.Create(false); + + if assigned(exemap) then + exemap.AddHeader('Removing unreferenced sections'); + + { Initialize by marking all sections unused and + adding the sections with oso_keep flags to the ObjSectionWorkList } + for i:=0 to ObjDataList.Count-1 do + begin + ObjData:=TObjData(ObjDataList[i]); + for j:=0 to ObjData.ObjSectionList.Count-1 do + begin + objsec:=TObjSection(ObjData.ObjSectionList[j]); + objsec.Used:=false; +{ TODO: remove debug section always keep} + if oso_debug in objsec.secoptions then + objsec.Used:=true; + if (oso_keep in objsec.secoptions) then + begin + AddToObjSectionWorkList(objsec); + if objsec.name='.fpc.n_links' then + objsec.Used:=false; + end; + end; + end; + AddToObjSectionWorkList(entrysym.exesymbol.objsymbol.objsection); + + { Process all sections, add new sections to process based + on the symbol references } + while ObjSectionWorkList.Count>0 do + begin + objsec:=TObjSection(ObjSectionWorkList.Last); + if assigned(exemap) then + exemap.Add('Keeping '+objsec.FullName+' '+ToStr(objsec.ObjRelocations.Count)+' references'); + ObjSectionWorkList.Delete(ObjSectionWorkList.Count-1); + + { Process Relocations } + for i:=0 to objsec.ObjRelocations.count-1 do + DoReloc(TObjRelocation(objsec.ObjRelocations[i])); + + { Process Virtual Entry calls } + if cs_link_opt_vtable in current_settings.globalswitches then + begin + for i:=0 to objsec.VTRefList.count-1 do + begin + objsym:=TObjSymbol(objsec.VTRefList[i]); + hs:=objsym.name; + Delete(hs,1,Pos('_',hs)); + k:=Pos('$$',hs); + if k=0 then + internalerror(200603314); + vtableexesym:=texesymbol(FExeSymbolList.Find(Copy(hs,1,k-1))); + val(Copy(hs,k+2,length(hs)-k-1),vtableidx,code); + if (code<>0) then + internalerror(200603317); + if not assigned(vtableexesym) then + internalerror(200603315); + if not assigned(vtableexesym.vtable) then + internalerror(200603316); + DoVTableRef(vtableexesym.vtable,vtableidx); + end; + end; + end; + ObjSectionWorkList.Free; + ObjSectionWorkList:=nil; + + { Remove unused objsections from ExeSectionList } + for i:=0 to ExeSectionList.Count-1 do + begin + exesec:=TExeSection(ExeSectionList[i]); + for j:=0 to exesec.ObjSectionlist.count-1 do + begin + objsec:=TObjSection(exesec.ObjSectionlist[j]); + if not objsec.used then + begin + if assigned(exemap) then + exemap.Add('Removing '+objsec.FullName); + exesec.ObjSectionlist[j]:=nil; + objsec.ReleaseData; + end; + end; + exesec.ObjSectionlist.Pack; + end; + end; + + + procedure TExeOutput.FixupRelocations; + var + i,j : longint; + exesec : TExeSection; + objsec : TObjSection; + begin + for i:=0 to ExeSectionList.Count-1 do + begin + exesec:=TExeSection(ExeSectionList[i]); + if not assigned(exesec) then + continue; + for j:=0 to exesec.ObjSectionlist.count-1 do + begin + objsec:=TObjSection(exesec.ObjSectionlist[j]); + if not objsec.Used then + internalerror(200603301); + objsec.FixupRelocs; + end; + end; + end; + + + procedure TExeOutput.SetCurrMemPos(const AValue: qword); + begin + if AValue>MaxMemPos then + Message1(link_f_executable_too_big, target_os_string); + FCurrMemPos:=AValue; + end; + + +{**************************************************************************** + TObjInput +****************************************************************************} + + constructor TObjInput.create; + begin + end; + + + destructor TObjInput.destroy; + begin + inherited destroy; + end; + + + function TObjInput.newObjData(const n:string):TObjData; + begin + result:=CObjData.create(n); + end; + + + procedure TObjInput.inputerror(const s : string); + begin + Comment(V_Error,s+' while reading '+InputFileName); + end; + + +{$ifdef MEMDEBUG} +initialization + memobjsymbols:=TMemDebug.create('ObjSymbols'); + memobjsymbols.stop; + memobjsections:=TMemDebug.create('ObjSections'); + memobjsections.stop; + +finalization + memobjsymbols.free; + memobjsections.free; +{$endif MEMDEBUG} +end. diff --git a/closures/compiler/ogcoff.pas b/closures/compiler/ogcoff.pas new file mode 100644 index 0000000000..9e4779a5b3 --- /dev/null +++ b/closures/compiler/ogcoff.pas @@ -0,0 +1,3158 @@ +{ + Copyright (c) 1998-2006 by Peter Vreman + + Contains the binary coff/PE reader and writer + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit ogcoff; + +{$i fpcdefs.inc} + +interface + + uses + { common } + cclasses,globtype, + { target } + systems, + { assembler } + cpuinfo,cpubase,aasmbase,assemble,link, + { output } + ogbase, + owbase; + + const + PE_DATADIR_ENTRIES = 16; + + type + tcoffpedatadir = packed record + vaddr : longword; + size : longword; + end; + tcoffheader = packed record + mach : word; + nsects : word; + time : longword; + sympos : longword; + syms : longword; + opthdr : word; + flag : word; + end; + tcoffpeoptheader = packed record + Magic : word; + MajorLinkerVersion : byte; + MinorLinkerVersion : byte; + tsize : longword; + dsize : longword; + bsize : longword; + entry : longword; + text_start : longword; +{$ifndef cpu64bitaddr} + data_start : longword; +{$endif cpu64bitaddr} + ImageBase : aword; + SectionAlignment : longword; + FileAlignment : longword; + MajorOperatingSystemVersion : word; + MinorOperatingSystemVersion : word; + MajorImageVersion : word; + MinorImageVersion : word; + MajorSubsystemVersion : word; + MinorSubsystemVersion : word; + Win32Version : longword; + SizeOfImage : longword; + SizeOfHeaders : longword; + CheckSum : longword; + Subsystem : word; + DllCharacteristics : word; + SizeOfStackReserve : aword; + SizeOfStackCommit : aword; + SizeOfHeapReserve : aword; + SizeOfHeapCommit : aword; + LoaderFlags : longword; { This field is obsolete } + NumberOfRvaAndSizes : longword; + DataDirectory : array[0..PE_DATADIR_ENTRIES-1] of tcoffpedatadir; + end; + tcoffsechdr = packed record + name : array[0..7] of char; + vsize : longword; + rvaofs : longword; + datasize : longword; + datapos : longword; + relocpos : longword; + lineno1 : longword; + nrelocs : word; + lineno2 : word; + flags : longword; + end; + + TCoffObjSection = class(TObjSection) + private + orgmempos, + coffrelocs, + coffrelocpos : aword; + public + secidx : longword; + flags : longword; + constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);override; + procedure addsymsizereloc(ofs:aword;p:TObjSymbol;symsize:aword;reloctype:TObjRelocationType); + procedure fixuprelocs;override; + end; + + TDJCoffObjSection = class(TCoffObjSection) + constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);override; + end; + + TPECoffObjSection = class(TCoffObjSection) + constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);override; + end; + + TCoffObjData = class(TObjData) + private + win32 : boolean; +{$ifdef arm} + eVCobj : boolean; +{$endif arm} + public + constructor createcoff(const n:string;awin32:boolean;acObjSection:TObjSectionClass); + destructor destroy;override; + procedure CreateDebugSections;override; + function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override; + procedure writereloc(data:aint;len:aword;p:TObjSymbol;reloctype:TObjRelocationType);override; + procedure afteralloc;override; + end; + + TDJCoffObjData = class(TCoffObjData) + constructor create(const n:string);override; + end; + + TPECoffObjData = class(TCoffObjData) + constructor create(const n:string);override; + end; + + TCoffObjOutput = class(tObjOutput) + private + win32 : boolean; + symidx : longint; + FCoffSyms, + FCoffStrs : tdynamicarray; + procedure write_symbol(const name:string;value:aword;section:smallint;typ,aux:byte); + procedure section_write_symbol(p:TObject;arg:pointer); + procedure section_write_relocs(p:TObject;arg:pointer); + procedure create_symbols(data:TObjData); + procedure section_set_datapos(p:TObject;arg:pointer); + procedure section_set_reloc_datapos(p:TObject;arg:pointer); + procedure section_write_header(p:TObject;arg:pointer); + procedure section_write_data(p:TObject;arg:pointer); + protected + function writedata(data:TObjData):boolean;override; + public + constructor createcoff(AWriter:TObjectWriter;awin32:boolean); + destructor destroy;override; + end; + + TDJCoffObjOutput = class(TCoffObjOutput) + constructor create(AWriter:TObjectWriter);override; + end; + + TPECoffObjOutput = class(TCoffObjOutput) + constructor create(AWriter:TObjectWriter);override; + end; + + TCoffObjInput = class(tObjInput) + private + FCoffsyms, + FCoffStrs : tdynamicarray; + { Convert symidx -> TObjSymbol } + FSymTbl : ^TObjSymbolArray; + { Convert secidx -> TObjSection } + FSecCount : smallint; + FSecTbl : ^TObjSectionArray; + win32 : boolean; + function GetSection(secidx:longint):TObjSection; + function Read_str(strpos:longword):string; + procedure read_relocs(s:TCoffObjSection); + procedure read_symbols(objdata:TObjData); + procedure ObjSections_read_data(p:TObject;arg:pointer); + procedure ObjSections_read_relocs(p:TObject;arg:pointer); + public + constructor createcoff(awin32:boolean); + destructor destroy;override; + function ReadObjData(AReader:TObjectreader;objdata:TObjData):boolean;override; + end; + + TDJCoffObjInput = class(TCoffObjInput) + constructor create;override; + end; + + TPECoffObjInput = class(TCoffObjInput) + constructor create;override; + end; + + TCoffExeSection = class(TExeSection) + private + win32 : boolean; + public + constructor createcoff(AList:TFPHashObjectList;const n:string;awin32:boolean); + end; + + TDJCoffExeSection = class(TCoffExeSection) + constructor create(AList:TFPHashObjectList;const n:string);override; + end; + + TPECoffExeSection = class(TCoffExeSection) + constructor create(AList:TFPHashObjectList;const n:string);override; + end; + + TCoffexeoutput = class(texeoutput) + private + FCoffsyms, + FCoffStrs : tdynamicarray; + win32 : boolean; + nsects : word; + nsyms, + sympos : aword; + function totalheadersize:longword; + procedure ExeSectionList_pass2_header(p:TObject;arg:pointer); + procedure write_symbol(const name:string;value:aword;section:smallint;typ,aux:byte); + procedure globalsyms_write_symbol(p:TObject;arg:pointer); + procedure ExeSectionList_write_header(p:TObject;arg:pointer); + procedure ExeSectionList_write_data(p:TObject;arg:pointer); + protected + function writedata:boolean;override; + procedure Order_ObjSectionList(ObjSectionList : TFPObjectList;const aPattern:string);override; + public + constructor createcoff(awin32:boolean); + procedure MemPos_Header;override; + procedure DataPos_Header;override; + procedure DataPos_Symbols;override; + end; + + TDJCoffexeoutput = class(TCoffexeoutput) + constructor create;override; + end; + + TPECoffexeoutput = class(TCoffexeoutput) + private + idatalabnr : longword; + FRelocsGenerated : boolean; + procedure GenerateRelocs; + public + constructor create;override; + procedure GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);override; + procedure Order_End;override; + procedure MemPos_ExeSection(const aname:string);override; + end; + + TObjSymbolrec = record + sym : TObjSymbol; + orgsize : aword; + end; + TObjSymbolArray = array[0..high(word)] of TObjSymbolrec; + TObjSectionArray = array[0..high(smallint)] of TObjSection; + + TDJCoffAssembler = class(tinternalassembler) + constructor create(smart:boolean);override; + end; + + TPECoffassembler = class(tinternalassembler) + constructor create(smart:boolean);override; + end; + + + type + Treaddllproc = procedure(const dllname,funcname:string) of object; + + const +{$ifdef i386} + COFF_MAGIC = $14c; + COFF_OPT_MAGIC = $10b; + TLSDIR_SIZE = $18; +{$endif i386} +{$ifdef arm} + COFF_MAGIC = $1c0; + COFF_OPT_MAGIC = $10b; + TLSDIR_SIZE = $18; +{$endif arm} +{$ifdef x86_64} + COFF_MAGIC = $8664; + COFF_OPT_MAGIC = $20b; + TLSDIR_SIZE = $28; +{$endif x86_64} + function ReadDLLImports(const dllname:string;readdllproc:Treaddllproc):boolean; + +implementation + + uses +{$ifdef win32} + Windows, +{$endif win32} + SysUtils, + cutils,verbose,globals, + fmodule,aasmtai,aasmdata, + ogmap, + version + ; + + const + COFF_FLAG_NORELOCS = $0001; + COFF_FLAG_EXE = $0002; + COFF_FLAG_NOLINES = $0004; + COFF_FLAG_NOLSYMS = $0008; + COFF_FLAG_AR16WR = $0080; { 16bit little endian } + COFF_FLAG_AR32WR = $0100; { 32bit little endian } + COFF_FLAG_AR32W = $0200; { 32bit big endian } + COFF_FLAG_DLL = $2000; + + COFF_SYM_GLOBAL = 2; + COFF_SYM_LOCAL = 3; + COFF_SYM_LABEL = 6; + COFF_SYM_FUNCTION = 101; + COFF_SYM_FILE = 103; + COFF_SYM_SECTION = 104; + + COFF_STYP_REG = $0000; { "regular": allocated, relocated, loaded } + COFF_STYP_DSECT = $0001; { "dummy": relocated only } + COFF_STYP_NOLOAD = $0002; { "noload": allocated, relocated, not loaded } + COFF_STYP_GROUP = $0004; { "grouped": formed of input sections } + COFF_STYP_PAD = $0008; + COFF_STYP_COPY = $0010; + COFF_STYP_TEXT = $0020; + COFF_STYP_DATA = $0040; + COFF_STYP_BSS = $0080; + + PE_SUBSYSTEM_NATIVE = 1; + PE_SUBSYSTEM_WINDOWS_GUI = 2; + PE_SUBSYSTEM_WINDOWS_CUI = 3; + PE_SUBSYSTEM_WINDOWS_CE_GUI = 9; + + PE_FILE_RELOCS_STRIPPED = $0001; + PE_FILE_EXECUTABLE_IMAGE = $0002; + PE_FILE_LINE_NUMS_STRIPPED = $0004; + PE_FILE_LOCAL_SYMS_STRIPPED = $0008; + PE_FILE_AGGRESSIVE_WS_TRIM = $0010; + PE_FILE_LARGE_ADDRESS_AWARE = $0020; + PE_FILE_16BIT_MACHINE = $0040; + PE_FILE_BYTES_REVERSED_LO = $0080; + PE_FILE_32BIT_MACHINE = $0100; + PE_FILE_DEBUG_STRIPPED = $0200; + PE_FILE_REMOVABLE_RUN_FROM_SWAP = $0400; + PE_FILE_NET_RUN_FROM_SWAP = $0800; + PE_FILE_SYSTEM = $1000; + PE_FILE_DLL = $2000; + PE_FILE_UP_SYSTEM_ONLY = $4000; + PE_FILE_BYTES_REVERSED_HI = $8000; + + PE_SCN_CNT_CODE = $00000020; { Section contains code. } + PE_SCN_CNT_INITIALIZED_DATA = $00000040; { Section contains initialized data. } + PE_SCN_CNT_UNINITIALIZED_DATA = $00000080; { Section contains uninitialized data. } + PE_SCN_LNK_OTHER = $00000100; { Reserved. } + PE_SCN_LNK_INFO = $00000200; { Section contains comments or some other type of information. } + PE_SCN_LNK_REMOVE = $00000800; { Section contents will not become part of image. } + PE_SCN_LNK_COMDAT = $00001000; { Section contents comdat. } + PE_SCN_MEM_FARDATA = $00008000; + PE_SCN_MEM_PURGEABLE = $00020000; + PE_SCN_MEM_16BIT = $00020000; + PE_SCN_MEM_LOCKED = $00040000; + PE_SCN_MEM_PRELOAD = $00080000; + PE_SCN_ALIGN_MASK = $00f00000; + PE_SCN_ALIGN_1BYTES = $00100000; + PE_SCN_ALIGN_2BYTES = $00200000; + PE_SCN_ALIGN_4BYTES = $00300000; + PE_SCN_ALIGN_8BYTES = $00400000; + PE_SCN_ALIGN_16BYTES = $00500000; { Default alignment if no others are specified. } + PE_SCN_ALIGN_32BYTES = $00600000; + PE_SCN_ALIGN_64BYTES = $00700000; + PE_SCN_LNK_NRELOC_OVFL = $01000000; { Section contains extended relocations. } + PE_SCN_MEM_NOT_CACHED = $04000000; { Section is not cachable. } + PE_SCN_MEM_NOT_PAGED = $08000000; { Section is not pageable. } + PE_SCN_MEM_SHARED = $10000000; { Section is shareable. } + PE_SCN_MEM_DISCARDABLE = $02000000; + PE_SCN_MEM_EXECUTE = $20000000; + PE_SCN_MEM_READ = $40000000; + PE_SCN_MEM_WRITE = $80000000; + + PE_DATADIR_EDATA = 0; + PE_DATADIR_IDATA = 1; + PE_DATADIR_RSRC = 2; + PE_DATADIR_PDATA = 3; + PE_DATADIR_SECURITY = 4; + PE_DATADIR_RELOC = 5; + PE_DATADIR_DEBUG = 6; + PE_DATADIR_DESCRIPTION = 7; + PE_DATADIR_SPECIAL = 8; + PE_DATADIR_TLS = 9; + PE_DATADIR_LOADCFG = 10; + PE_DATADIR_BOUNDIMPORT = 11; + PE_DATADIR_IMPORTADDRESSTABLE = 12; + PE_DATADIR_DELAYIMPORT = 13; + +{$ifdef x86_64} + IMAGE_REL_AMD64_ABSOLUTE = $0000; { Reference is absolute, no relocation is necessary } + IMAGE_REL_AMD64_ADDR64 = $0001; { 64-bit address (VA). } + IMAGE_REL_AMD64_ADDR32 = $0002; { 32-bit address (VA). } + IMAGE_REL_AMD64_ADDR32NB = $0003; { 32-bit address w/o image base (RVA). } + IMAGE_REL_AMD64_REL32 = $0004; { 32-bit relative address from byte following reloc } + IMAGE_REL_AMD64_REL32_1 = $0005; { 32-bit relative address from byte distance 1 from reloc } + IMAGE_REL_AMD64_REL32_2 = $0006; { 32-bit relative address from byte distance 2 from reloc } + IMAGE_REL_AMD64_REL32_3 = $0007; { 32-bit relative address from byte distance 3 from reloc } + IMAGE_REL_AMD64_REL32_4 = $0008; { 32-bit relative address from byte distance 4 from reloc } + IMAGE_REL_AMD64_REL32_5 = $0009; { 32-bit relative address from byte distance 5 from reloc } + IMAGE_REL_AMD64_SECTION = $000A; { Section index } + IMAGE_REL_AMD64_SECREL = $000B; { 32 bit offset from base of section containing target } + IMAGE_REL_AMD64_SECREL7 = $000C; { 7 bit unsigned offset from base of section containing target } + IMAGE_REL_AMD64_TOKEN = $000D; { 32 bit metadata token } + IMAGE_REL_AMD64_SREL32 = $000E; { 32 bit signed span-dependent value emitted into object } + IMAGE_REL_AMD64_PAIR = $000F; + IMAGE_REL_AMD64_SSPAN32 = $0010; { 32 bit signed span-dependent value applied at link time } + { Direct 32 bit sign extended, + win64 mingw GNU compiler + also generates this type + inside coff objects + We assume they are equivalent to + IMAGE_REL_AMD64_ADDR32 PM 2010-11-27 } + R_X86_64_32S = $11; + +{$endif x86_64} + +{$ifdef arm} + IMAGE_REL_ARM_ABSOLUTE = $0000; { No relocation required } + IMAGE_REL_ARM_ADDR32 = $0001; { 32 bit address } + IMAGE_REL_ARM_ADDR32NB = $0002; { 32 bit address w/o image base } + IMAGE_REL_ARM_BRANCH24 = $0003; { 24 bit offset << 2 & sign ext. } + IMAGE_REL_ARM_BRANCH11 = $0004; { Thumb: 2 11 bit offsets } + IMAGE_REL_ARM_TOKEN = $0005; { clr token } + IMAGE_REL_ARM_GPREL12 = $0006; { GP-relative addressing (ARM) } + IMAGE_REL_ARM_GPREL7 = $0007; { GP-relative addressing (Thumb) } + IMAGE_REL_ARM_BLX24 = $0008; + IMAGE_REL_ARM_BLX11 = $0009; + IMAGE_REL_ARM_SECTION = $000E; { Section table index } + IMAGE_REL_ARM_SECREL = $000F; { Offset within section } +{$endif arm} + +{$ifdef i386} + IMAGE_REL_I386_DIR32 = 6; + IMAGE_REL_I386_IMAGEBASE = 7; + IMAGE_REL_I386_SECREL32 = 11; + IMAGE_REL_I386_PCRLONG = 20; +{$endif i386} + + { .reloc section fixup types } + IMAGE_REL_BASED_HIGHLOW = 3; { Applies the delta to the 32-bit field at Offset. } + IMAGE_REL_BASED_DIR64 = 10; { Applies the delta to the 64-bit field at Offset. } + + type + coffdjoptheader=packed record + magic : word; + vstamp : word; + tsize : longint; + dsize : longint; + bsize : longint; + entry : longint; + text_start : longint; + data_start : longint; + end; + coffsectionrec=packed record + len : longword; + nrelocs : word; + empty : array[0..11] of char; + end; + coffreloc=packed record + address : longword; + sym : longword; + reloctype : word; + end; + coffsymbol=packed record + name : array[0..3] of char; { real is [0..7], which overlaps the strpos ! } + strpos : longword; + value : longword; + section : smallint; + empty : word; + typ : byte; + aux : byte; + end; + + { This is defined in rtl/win/sysos.inc source } + tlsdirectory=packed record + data_start, data_end : PUInt; + index_pointer, callbacks_pointer : PUInt; + zero_fill_size : dword; + flags : dword; + end; + + const + SymbolMaxGrow = 200*sizeof(coffsymbol); + StrsMaxGrow = 8192; + + coffsecnames : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','', + '.text','.data','.data','.data','.bss','.tls', + '.pdata',{pdata} + '.text', {stub} + '.data', + '.data', + '.data', + '.data', + '.stab','.stabstr', + '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata', + '.eh_frame', + '.debug_frame','.debug_info','.debug_line','.debug_abbrev', + '.fpc', + '', + '.init', + '.fini', + '.objc_class', + '.objc_meta_class', + '.objc_cat_cls_meth', + '.objc_cat_inst_meth', + '.objc_protocol', + '.objc_string_object', + '.objc_cls_meth', + '.objc_inst_meth', + '.objc_cls_refs', + '.objc_message_refs', + '.objc_symbols', + '.objc_category', + '.objc_class_vars', + '.objc_instance_vars', + '.objc_module_info', + '.objc_class_names', + '.objc_meth_var_types', + '.objc_meth_var_names', + '.objc_selector_strs', + '.objc_protocol_ext', + '.objc_class_ext', + '.objc_property', + '.objc_image_info', + '.objc_cstring_object', + '.objc_sel_fixup', + '__DATA,__objc_data', + '__DATA,__objc_const', + '.objc_superrefs', + '__DATA, __datacoal_nt,coalesced', + '.objc_classlist', + '.objc_nlclasslist', + '.objc_catlist', + '.obcj_nlcatlist', + '.objc_protolist' + ); + +const go32v2stub : array[0..2047] of byte=( + $4D,$5A,$00,$00,$04,$00,$00,$00,$20,$00,$27,$00,$FF,$FF,$00, + $00,$60,$07,$00,$00,$54,$00,$00,$00,$00,$00,$00,$00,$0D,$0A, + $73,$74,$75,$62,$2E,$68,$20,$67,$65,$6E,$65,$72,$61,$74,$65, + $64,$20,$66,$72,$6F,$6D,$20,$73,$74,$75,$62,$2E,$61,$73,$6D, + $20,$62,$79,$20,$64,$6A,$61,$73,$6D,$2C,$20,$6F,$6E,$20,$54, + $68,$75,$20,$44,$65,$63,$20,$20,$39,$20,$31,$30,$3A,$35,$39, + $3A,$33,$31,$20,$31,$39,$39,$39,$0D,$0A,$54,$68,$65,$20,$53, + $54,$55,$42,$2E,$45,$58,$45,$20,$73,$74,$75,$62,$20,$6C,$6F, + $61,$64,$65,$72,$20,$69,$73,$20,$43,$6F,$70,$79,$72,$69,$67, + $68,$74,$20,$28,$43,$29,$20,$31,$39,$39,$33,$2D,$31,$39,$39, + $35,$20,$44,$4A,$20,$44,$65,$6C,$6F,$72,$69,$65,$2E,$20,$0D, + $0A,$50,$65,$72,$6D,$69,$73,$73,$69,$6F,$6E,$20,$67,$72,$61, + $6E,$74,$65,$64,$20,$74,$6F,$20,$75,$73,$65,$20,$66,$6F,$72, + $20,$61,$6E,$79,$20,$70,$75,$72,$70,$6F,$73,$65,$20,$70,$72, + $6F,$76,$69,$64,$65,$64,$20,$74,$68,$69,$73,$20,$63,$6F,$70, + $79,$72,$69,$67,$68,$74,$20,$0D,$0A,$72,$65,$6D,$61,$69,$6E, + $73,$20,$70,$72,$65,$73,$65,$6E,$74,$20,$61,$6E,$64,$20,$75, + $6E,$6D,$6F,$64,$69,$66,$69,$65,$64,$2E,$20,$0D,$0A,$54,$68, + $69,$73,$20,$6F,$6E,$6C,$79,$20,$61,$70,$70,$6C,$69,$65,$73, + $20,$74,$6F,$20,$74,$68,$65,$20,$73,$74,$75,$62,$2C,$20,$61, + $6E,$64,$20,$6E,$6F,$74,$20,$6E,$65,$63,$65,$73,$73,$61,$72, + $69,$6C,$79,$20,$74,$68,$65,$20,$77,$68,$6F,$6C,$65,$20,$70, + $72,$6F,$67,$72,$61,$6D,$2E,$0A,$0D,$0A,$24,$49,$64,$3A,$20, + $73,$74,$75,$62,$2E,$61,$73,$6D,$20,$62,$75,$69,$6C,$74,$20, + $31,$32,$2F,$30,$39,$2F,$39,$39,$20,$31,$30,$3A,$35,$39,$3A, + $33,$31,$20,$62,$79,$20,$64,$6A,$61,$73,$6D,$20,$24,$0A,$0D, + $0A,$40,$28,$23,$29,$20,$73,$74,$75,$62,$2E,$61,$73,$6D,$20, + $62,$75,$69,$6C,$74,$20,$31,$32,$2F,$30,$39,$2F,$39,$39,$20, + $31,$30,$3A,$35,$39,$3A,$33,$31,$20,$62,$79,$20,$64,$6A,$61, + $73,$6D,$0A,$0D,$0A,$1A,$00,$00,$00,$00,$00,$00,$00,$00,$00, + $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, + $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, + $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, + $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, + $00,$00,$67,$6F,$33,$32,$73,$74,$75,$62,$2C,$20,$76,$20,$32, + $2E,$30,$32,$54,$00,$00,$00,$00,$00,$08,$00,$00,$00,$00,$00, + $00,$00,$00,$00,$00,$40,$00,$00,$00,$00,$00,$00,$00,$00,$00, + $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, + $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$43,$57,$53,$44,$50, + $4D,$49,$2E,$45,$58,$45,$00,$00,$00,$00,$00,$0E,$1F,$8C,$1E, + $24,$00,$8C,$06,$60,$07,$FC,$B4,$30,$CD,$21,$3C,$03,$73,$08, + $B0,$6D,$BA,$A7,$05,$E9,$D4,$03,$A2,$69,$08,$BE,$20,$00,$8B, + $04,$09,$C0,$75,$02,$B4,$FE,$BB,$70,$08,$39,$C3,$73,$02,$89, + $C3,$89,$1C,$FE,$C7,$B9,$04,$FF,$D3,$EB,$B4,$4A,$CD,$21,$73, + $08,$D3,$E3,$FE,$CF,$89,$1C,$EB,$D8,$26,$8E,$06,$2C,$00,$31, + $FF,$30,$C0,$A9,$F2,$AE,$26,$81,$3D,$50,$41,$75,$15,$AF,$26, + $81,$3D,$54,$48,$75,$0D,$AF,$26,$80,$3D,$3D,$75,$06,$47,$89, + $3E,$8C,$04,$4F,$AE,$75,$DF,$AF,$B4,$3E,$BB,$13,$00,$CD,$21, + $B4,$3E,$BB,$12,$00,$CD,$21,$06,$57,$31,$C9,$74,$12,$B0,$6E, + $BA,$7E,$05,$E9,$5E,$03,$09,$C9,$75,$F4,$41,$E8,$A1,$03,$72, + $EE,$B8,$87,$16,$CD,$2F,$09,$C0,$75,$ED,$80,$E3,$01,$74,$E8, + $89,$3E,$00,$06,$8C,$06,$02,$06,$89,$36,$04,$06,$5F,$07,$E8, + $D3,$02,$89,$3E,$2A,$00,$89,$36,$62,$07,$80,$3E,$2C,$00,$00, + $74,$23,$B9,$08,$00,$BF,$2C,$00,$8A,$05,$47,$08,$C0,$74,$05, + $88,$07,$43,$E2,$F4,$66,$C7,$07,$2E,$45,$58,$45,$83,$C3,$04, + $C6,$07,$00,$89,$1E,$62,$07,$B8,$00,$3D,$BA,$64,$07,$CD,$21, + $0F,$82,$B3,$02,$A3,$06,$06,$89,$C3,$B9,$06,$00,$BA,$B5,$07, + $B4,$3F,$CD,$21,$31,$D2,$31,$C9,$A1,$B5,$07,$3D,$4C,$01,$74, + $1B,$3D,$4D,$5A,$0F,$85,$98,$02,$8B,$16,$B9,$07,$C1,$E2,$09, + $8B,$1E,$B7,$07,$09,$DB,$74,$05,$80,$EE,$02,$01,$DA,$89,$16, + $BB,$07,$89,$0E,$BD,$07,$B8,$00,$42,$8B,$1E,$06,$06,$CD,$21, + $B9,$A8,$00,$BA,$BF,$07,$B4,$3F,$CD,$21,$3D,$A8,$00,$75,$06, + $81,$3E,$BF,$07,$4C,$01,$0F,$85,$61,$02,$66,$A1,$E3,$07,$66, + $A3,$10,$06,$66,$8B,$0E,$BB,$07,$66,$A1,$03,$08,$66,$01,$C8, + $66,$A3,$08,$06,$66,$A1,$2B,$08,$66,$01,$C8,$66,$A3,$0C,$06, + $66,$8B,$1E,$4B,$08,$66,$A1,$4F,$08,$66,$01,$C3,$66,$B8,$01, + $00,$01,$00,$66,$39,$C3,$73,$03,$66,$89,$C3,$66,$81,$C3,$FF, + $FF,$00,$00,$31,$DB,$66,$89,$1E,$1C,$00,$E8,$F5,$02,$8B,$1E, + $04,$06,$09,$DB,$74,$0A,$B4,$48,$CD,$21,$0F,$82,$15,$02,$8E, + $C0,$E8,$08,$03,$B8,$01,$00,$FF,$1E,$00,$06,$0F,$82,$0F,$02, + $8C,$06,$26,$00,$8C,$0E,$28,$00,$8C,$D8,$A3,$22,$00,$8E,$C0, + $31,$C0,$B9,$01,$00,$CD,$31,$72,$07,$A3,$14,$06,$31,$C0,$CD, + $31,$0F,$82,$F3,$01,$A3,$16,$06,$66,$8B,$0E,$1C,$00,$B8,$01, + $05,$8B,$1E,$1E,$00,$CD,$31,$0F,$82,$E5,$01,$89,$1E,$1A,$06, + $89,$0E,$18,$06,$89,$36,$1A,$00,$89,$3E,$18,$00,$B8,$07,$00, + $8B,$1E,$14,$06,$8B,$0E,$1A,$06,$8B,$16,$18,$06,$CD,$31,$B8, + $09,$00,$8C,$C9,$83,$E1,$03,$C1,$E1,$05,$51,$81,$C9,$9B,$C0, + $CD,$31,$B8,$08,$00,$8B,$0E,$1E,$00,$49,$BA,$FF,$FF,$CD,$31, + $B8,$07,$00,$8B,$1E,$16,$06,$8B,$0E,$1A,$06,$8B,$16,$18,$06, + $CD,$31,$B8,$09,$00,$59,$81,$C9,$93,$C0,$CD,$31,$B8,$08,$00, + $8B,$0E,$1E,$00,$49,$BA,$FF,$FF,$CD,$31,$B8,$00,$01,$BB,$00, + $0F,$CD,$31,$73,$10,$3D,$08,$00,$0F,$85,$73,$01,$B8,$00,$01, + $CD,$31,$0F,$82,$6A,$01,$A3,$1C,$06,$89,$16,$1E,$06,$C1,$E3, + $04,$89,$1E,$20,$06,$66,$8B,$36,$08,$06,$66,$8B,$3E,$FB,$07, + $66,$8B,$0E,$FF,$07,$E8,$49,$00,$66,$8B,$36,$0C,$06,$66,$8B, + $3E,$23,$08,$66,$8B,$0E,$27,$08,$E8,$37,$00,$8E,$06,$16,$06, + $66,$8B,$3E,$4B,$08,$66,$8B,$0E,$4F,$08,$66,$31,$C0,$66,$C1, + $E9,$02,$67,$F3,$66,$AB,$B4,$3E,$8B,$1E,$06,$06,$CD,$21,$B8, + $01,$01,$8B,$16,$1E,$06,$CD,$31,$1E,$0F,$A1,$8E,$1E,$16,$06, + $66,$64,$FF,$2E,$10,$06,$66,$89,$F0,$66,$25,$FF,$01,$00,$00, + $66,$01,$C1,$29,$C6,$66,$29,$C7,$66,$89,$0E,$26,$06,$66,$89, + $3E,$22,$06,$E8,$0F,$01,$89,$36,$3E,$06,$66,$C1,$EE,$10,$89, + $36,$42,$06,$8B,$1E,$06,$06,$89,$1E,$3A,$06,$C7,$06,$46,$06, + $00,$42,$E8,$03,$01,$A1,$1C,$06,$A3,$4E,$06,$C7,$06,$3E,$06, + $00,$00,$C6,$06,$47,$06,$3F,$A1,$28,$06,$09,$C0,$75,$09,$A1, + $26,$06,$3B,$06,$20,$06,$76,$03,$A1,$20,$06,$A3,$42,$06,$E8, + $D9,$00,$66,$31,$C9,$8B,$0E,$46,$06,$66,$8B,$3E,$22,$06,$66, + $01,$0E,$22,$06,$66,$29,$0E,$26,$06,$66,$31,$F6,$C1,$E9,$02, + $1E,$06,$8E,$06,$16,$06,$8E,$1E,$1E,$06,$67,$F3,$66,$A5,$07, + $1F,$66,$03,$0E,$26,$06,$75,$AF,$C3,$3C,$3A,$74,$06,$3C,$2F, + $74,$02,$3C,$5C,$C3,$BE,$64,$07,$89,$F3,$26,$8A,$05,$47,$88, + $04,$38,$E0,$74,$0E,$08,$C0,$74,$0A,$46,$E8,$DE,$FF,$75,$EC, + $89,$F3,$74,$E8,$C3,$B0,$66,$BA,$48,$05,$EB,$0C,$B0,$67,$BA, + $55,$05,$EB,$05,$B0,$68,$BA,$5F,$05,$52,$8B,$1E,$62,$07,$C6, + $07,$24,$BB,$64,$07,$EB,$28,$E8,$F5,$00,$B0,$69,$BA,$99,$05, + $EB,$1A,$B0,$6A,$BA,$B2,$05,$EB,$13,$B0,$6B,$BA,$C4,$05,$EB, + $0C,$B0,$6C,$BA,$D6,$05,$EB,$05,$B0,$69,$BA,$99,$05,$52,$BB, + $3B,$05,$E8,$15,$00,$5B,$E8,$11,$00,$BB,$67,$04,$E8,$0B,$00, + $B4,$4C,$CD,$21,$43,$50,$B4,$02,$CD,$21,$58,$8A,$17,$80,$FA, + $24,$75,$F2,$C3,$0D,$0A,$24,$50,$51,$57,$31,$C0,$BF,$2A,$06, + $B9,$19,$00,$F3,$AB,$5F,$59,$58,$C3,$B8,$00,$03,$BB,$21,$00, + $31,$C9,$66,$BF,$2A,$06,$00,$00,$CD,$31,$C3,$00,$00,$30,$E4, + $E8,$4E,$FF,$89,$DE,$8B,$3E,$8C,$04,$EB,$17,$B4,$3B,$E8,$41, + $FF,$81,$FE,$64,$07,$74,$12,$8A,$44,$FF,$E8,$2A,$FF,$74,$04, + $C6,$04,$5C,$46,$E8,$03,$00,$72,$E4,$C3,$E8,$34,$00,$BB,$44, + $00,$8A,$07,$88,$04,$43,$46,$08,$C0,$75,$F6,$06,$57,$1E,$07, + $E8,$9B,$FF,$BB,$2A,$06,$8C,$5F,$04,$89,$5F,$02,$BA,$64,$07, + $B8,$00,$4B,$CD,$21,$5F,$07,$72,$09,$B4,$4D,$CD,$21,$2D,$00, + $03,$F7,$D8,$EB,$28,$80,$3E,$69,$08,$05,$72,$20,$B8,$00,$58, + $CD,$21,$A2,$67,$08,$B8,$02,$58,$CD,$21,$A2,$68,$08,$B8,$01, + $58,$BB,$80,$00,$CD,$21,$B8,$03,$58,$BB,$01,$00,$CD,$21,$C3, + $9C,$80,$3E,$69,$08,$05,$72,$1A,$50,$53,$B8,$03,$58,$8A,$1E, + $68,$08,$30,$FF,$CD,$21,$B8,$01,$58,$8A,$1E,$67,$08,$30,$FF, + $CD,$21,$5B,$58,$9D,$C3,$4C,$6F,$61,$64,$20,$65,$72,$72,$6F, + $72,$3A,$20,$24,$3A,$20,$63,$61,$6E,$27,$74,$20,$6F,$70,$65, + $6E,$24,$3A,$20,$6E,$6F,$74,$20,$45,$58,$45,$24,$3A,$20,$6E, + $6F,$74,$20,$43,$4F,$46,$46,$20,$28,$43,$68,$65,$63,$6B,$20, + $66,$6F,$72,$20,$76,$69,$72,$75,$73,$65,$73,$29,$24,$6E,$6F, + $20,$44,$50,$4D,$49,$20,$2D,$20,$47,$65,$74,$20,$63,$73,$64, + $70,$6D,$69,$2A,$62,$2E,$7A,$69,$70,$24,$6E,$6F,$20,$44,$4F, + $53,$20,$6D,$65,$6D,$6F,$72,$79,$24,$6E,$65,$65,$64,$20,$44, + $4F,$53,$20,$33,$24,$63,$61,$6E,$27,$74,$20,$73,$77,$69,$74, + $63,$68,$20,$6D,$6F,$64,$65,$24,$6E,$6F,$20,$44,$50,$4D,$49, + $20,$73,$65,$6C,$65,$63,$74,$6F,$72,$73,$24,$6E,$6F,$20,$44, + $50,$4D,$49,$20,$6D,$65,$6D,$6F,$72,$79,$24,$90,$90,$90,$90, + $90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90,$90, + $90,$90,$90,$90,$90,$90,$90,$90); + +const win32stub : array[0..127] of byte=( + $4D,$5A,$90,$00,$03,$00,$00,$00,$04,$00,$00,$00,$FF,$FF,$00,$00, + $B8,$00,$00,$00,$00,$00,$00,$00,$40,$00,$00,$00,$00,$00,$00,$00, + $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00, + $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$80,$00,$00,$00, + $0E,$1F,$BA,$0E,$00,$B4,$09,$CD,$21,$B8,$01,$4C,$CD,$21,$54,$68, + $69,$73,$20,$70,$72,$6F,$67,$72,$61,$6D,$20,$63,$61,$6E,$6E,$6F, + $74,$20,$62,$65,$20,$72,$75,$6E,$20,$69,$6E,$20,$44,$4F,$53,$20, + $6D,$6F,$64,$65,$2E,$0D,$0D,$0A,$24,$00,$00,$00,$00,$00,$00,$00); + +const pemagic : array[0..3] of byte = ( + $50,$45,$00,$00); + +{**************************************************************************** + Helpers +****************************************************************************} + + function djencodesechdrflags(aoptions:TObjSectionOptions):longword; + begin + if (oso_load in aoptions) then + begin + if oso_executable in aoptions then + result:=COFF_STYP_TEXT + else if not(oso_data in aoptions) then + result:=COFF_STYP_BSS + else + result:=COFF_STYP_DATA; + end + else + result:=COFF_STYP_REG; + end; + + + function djdecodesechdrflags(const aname:string;flags:longword):TObjSectionOptions; + begin + result:=[]; + if flags and COFF_STYP_TEXT<>0 then + result:=[oso_data,oso_load,oso_executable] + else if flags and COFF_STYP_BSS<>0 then + result:=[oso_load] + else if flags and COFF_STYP_DATA<>0 then + result:=[oso_data,oso_load] + else + result:=[oso_data] + end; + + + function peencodesechdrflags(aoptions:TObjSectionOptions;aalign:shortint):longword; + begin + result:=0; + if (oso_load in aoptions) then + begin + if oso_executable in aoptions then + result:=result or PE_SCN_CNT_CODE or PE_SCN_MEM_EXECUTE + else + begin + if (oso_data in aoptions) then + result:=result or PE_SCN_CNT_INITIALIZED_DATA + else + result:=result or PE_SCN_CNT_UNINITIALIZED_DATA; + end; + if oso_write in aoptions then + result:=result or PE_SCN_MEM_WRITE or PE_SCN_MEM_READ + else + result:=result or PE_SCN_MEM_READ; + end + else + result:=result or PE_SCN_MEM_DISCARDABLE; + case aalign of + 1 : result:=result or PE_SCN_ALIGN_1BYTES; + 2 : result:=result or PE_SCN_ALIGN_2BYTES; + 4 : result:=result or PE_SCN_ALIGN_4BYTES; + 8 : result:=result or PE_SCN_ALIGN_8BYTES; + 16 : result:=result or PE_SCN_ALIGN_16BYTES; + 32 : result:=result or PE_SCN_ALIGN_32BYTES; + 64 : result:=result or PE_SCN_ALIGN_64BYTES; + else result:=result or PE_SCN_ALIGN_16BYTES; + end; + end; + + + procedure pedecodesechdrflags(const aname:string;flags:longword;out aoptions:TObjSectionOptions;out aalign:shortint); + var + alignflag : longword; + begin + aoptions:=[]; + if flags and PE_SCN_CNT_CODE<>0 then + include(aoptions,oso_executable); + if flags and PE_SCN_MEM_DISCARDABLE<>0 then + include(aoptions,oso_debug); + if flags and PE_SCN_CNT_UNINITIALIZED_DATA=0 then + include(aoptions,oso_data); + if (flags and PE_SCN_LNK_REMOVE<>0) or + (flags and PE_SCN_MEM_DISCARDABLE<>0) then + include(aoptions,oso_noload) + else + include(aoptions,oso_load); + { read/write } + if flags and PE_SCN_MEM_WRITE<>0 then + include(aoptions,oso_write) + else + include(aoptions,oso_readonly); + { alignment } + alignflag:=flags and PE_SCN_ALIGN_MASK; + if alignflag=PE_SCN_ALIGN_64BYTES then + aalign:=64 + else if alignflag=PE_SCN_ALIGN_32BYTES then + aalign:=32 + else if alignflag=PE_SCN_ALIGN_16BYTES then + aalign:=16 + else if alignflag=PE_SCN_ALIGN_8BYTES then + aalign:=8 + else if alignflag=PE_SCN_ALIGN_4BYTES then + aalign:=4 + else if alignflag=PE_SCN_ALIGN_2BYTES then + aalign:=2 + else if alignflag=PE_SCN_ALIGN_1BYTES then + aalign:=1 + else if alignflag=0 then + aalign:=0 + else + Internalerror(2009050401); + end; + + +{**************************************************************************** + TCoffObjSection +****************************************************************************} + + constructor TCoffObjSection.create(AList:TFPHashObjectList;const aname:string;aalign:shortint;aoptions:TObjSectionOptions); + begin + inherited create(AList,aname,aalign,aoptions); + end; + + + procedure TCoffObjSection.addsymsizereloc(ofs:aword;p:TObjSymbol;symsize:aword;reloctype:TObjRelocationType); + begin + ObjRelocations.Add(TObjRelocation.createsymbolsize(ofs,p,symsize,reloctype)); + end; + + + procedure TCoffObjSection.fixuprelocs; + var + i,zero,address_size : longint; + objreloc : TObjRelocation; + address, + relocval : aint; + relocsec : TObjSection; +{$ifdef cpu64bitaddr} + s : string; +{$endif cpu64bitaddr} + begin + if (ObjRelocations.Count>0) and + not assigned(data) then + internalerror(200205183); + for i:=0 to ObjRelocations.Count-1 do + begin + objreloc:=TObjRelocation(ObjRelocations[i]); + address_size:=4; + case objreloc.typ of + RELOC_NONE: + continue; + RELOC_ZERO: + begin + data.Seek(objreloc.dataoffset); + zero:=0; + data.Write(zero,4); + continue; + end; +{$ifdef cpu64bitaddr} + RELOC_ABSOLUTE: + address_size:=8; +{$endif cpu64bitaddr} + end; + + address:=0; + data.Seek(objreloc.dataoffset); + data.Read(address,address_size); + if assigned(objreloc.symbol) then + begin + relocsec:=objreloc.symbol.objsection; + relocval:=objreloc.symbol.address; + end + else + if assigned(objreloc.objsection) then + begin + relocsec:=objreloc.objsection; + relocval:=objreloc.objsection.mempos + end + else + internalerror(200205183); + { Only debug sections are allowed to have relocs pointing to unused sections } + if not relocsec.used and not (oso_debug in secoptions) then + internalerror(200603061); + + if relocsec.used then + case objreloc.typ of + RELOC_RELATIVE : + begin + address:=address-mempos+relocval; + if TCoffObjData(objdata).win32 then + dec(address,objreloc.dataoffset+4); + end; + RELOC_RVA: + begin + { fixup address when the symbol was known in defined object } + if (relocsec.objdata=objdata) then + dec(address,TCoffObjSection(relocsec).orgmempos); +{$ifdef arm} + if (relocsec.objdata=objdata) and not TCoffObjData(objdata).eVCobj then + inc(address, relocsec.MemPos) + else +{$endif arm} + inc(address,relocval); + end; + RELOC_SECREL32 : + begin + { fixup address when the symbol was known in defined object } + if (relocsec.objdata=objdata) then + dec(address,relocsec.ExeSection.MemPos); + inc(address,relocval); + end; +{$ifdef arm} + RELOC_RELATIVE_24: + begin + relocval:=longint(relocval - mempos - objreloc.dataoffset) shr 2 - 2; + address:=address or (relocval and $ffffff); + relocval:=relocval shr 24; + if (relocval<>$3f) and (relocval<>0) then + internalerror(200606085); { offset overflow } + end; +{$endif arm} +{$ifdef x86_64} + { 64 bit coff only } + RELOC_RELATIVE_1: + begin + address:=address-mempos+relocval; + dec(address,objreloc.dataoffset+1); + end; + RELOC_RELATIVE_2: + begin + address:=address-mempos+relocval; + dec(address,objreloc.dataoffset+2); + end; + RELOC_RELATIVE_3: + begin + address:=address-mempos+relocval; + dec(address,objreloc.dataoffset+3); + end; + RELOC_RELATIVE_4: + begin + address:=address-mempos+relocval; + dec(address,objreloc.dataoffset+4); + end; + RELOC_RELATIVE_5: + begin + address:=address-mempos+relocval; + dec(address,objreloc.dataoffset+5); + end; + RELOC_ABSOLUTE32, +{$endif x86_64} + RELOC_ABSOLUTE : + begin + if oso_common in relocsec.secoptions then + dec(address,objreloc.orgsize) + else + begin + { fixup address when the symbol was known in defined object } + if (relocsec.objdata=objdata) then + dec(address,TCoffObjSection(relocsec).orgmempos); + end; +{$ifdef arm} + if (relocsec.objdata=objdata) and not TCoffObjData(objdata).eVCobj then + inc(address, relocsec.MemPos) + else +{$endif arm} + inc(address,relocval); + inc(address,relocsec.objdata.imagebase); + end; + else + internalerror(200604014); + end + else + address:=0; { Relocation in debug section points to unused section, which is eliminated by linker } + + data.Seek(objreloc.dataoffset); + data.Write(address,address_size); +{$ifdef cpu64bitaddr} + if (objreloc.typ = RELOC_ABSOLUTE32) and (name <> '.stab') then + begin + if assigned(objreloc.symbol) then + s:=objreloc.symbol.Name + else + s:=objreloc.objsection.Name; + Message2(link_w_32bit_absolute_reloc, ObjData.Name, s); + end; +{$endif cpu64bitaddr} + end; + {for size = 0 data is not valid PM } + if assigned(data) and (data.size <> size) then + internalerror(2010092801); + end; + + + +{**************************************************************************** + TDJCoffObjSection +****************************************************************************} + + constructor TDJCoffObjSection.create(AList:TFPHashObjectList;const aname:string;aalign:shortint;aoptions:TObjSectionOptions); + begin + inherited create(alist,aname,aalign,aoptions); + end; + + +{**************************************************************************** + TPECoffObjSection +****************************************************************************} + + constructor TPECoffObjSection.create(AList:TFPHashObjectList;const aname:string;aalign:shortint;aoptions:TObjSectionOptions); + begin + inherited create(alist,aname,aalign,aoptions); + end; + + +{**************************************************************************** + TCoffObjData +****************************************************************************} + + constructor TCoffObjData.createcoff(const n:string;awin32:boolean;acObjSection:TObjSectionClass); + begin + inherited create(n); + CObjSection:=ACObjSection; + win32:=awin32; + { we need at least the following 3 ObjSections } + createsection(sec_code); + createsection(sec_data); + createsection(sec_bss); + if tf_section_threadvars in target_info.flags then + createsection(sec_threadvar); + end; + + + destructor TCoffObjData.destroy; + begin + inherited destroy; + end; + + + function TCoffObjData.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string; + var + sep : string[3]; + secname : string; + begin + { section type user gives the user full controll on the section name } + if atype=sec_user then + result:=aname + else + begin + secname:=coffsecnames[atype]; + if create_smartlink_sections and + (aname<>'') then + begin + case aorder of + secorder_begin : + sep:='.b_'; + secorder_end : + sep:='.z_'; + else + sep:='.n_'; + end; + result:=secname+sep+aname + end + else + result:=secname; + end; + end; + + + procedure TCoffObjData.CreateDebugSections; + begin + if target_dbg.id=dbg_stabs then + begin + stabssec:=createsection(sec_stab); + stabstrsec:=createsection(sec_stabstr); + end; + end; + + + procedure TCoffObjData.writereloc(data:aint;len:aword;p:TObjSymbol;reloctype:TObjRelocationType); + var + curraddr, + symaddr : aword; + begin + if CurrObjSec=nil then + internalerror(200403072); + if assigned(p) then + begin + { current address } + curraddr:=CurrObjSec.mempos+CurrObjSec.Size; + { external/common symbols don't have a fixed memory position yet } + if (p.bind=AB_COMMON) then + begin + { For go32v2 we need to use the size as address } + if not win32 then + symaddr:=p.size + else + symaddr:=0; + end + else + symaddr:=p.address; + { no symbol relocation need inside a section } + if (p.objsection=CurrObjSec) and + (p.bind<>AB_COMMON) then + begin + case reloctype of + RELOC_ABSOLUTE : + begin + CurrObjSec.addsectionreloc(curraddr,CurrObjSec,RELOC_ABSOLUTE); + inc(data,symaddr); + end; +{$ifdef cpu64bitaddr} + RELOC_ABSOLUTE32 : + begin + CurrObjSec.addsectionreloc(curraddr,CurrObjSec,RELOC_ABSOLUTE32); + inc(data,symaddr); + end; +{$endif cpu64bitaddr} + RELOC_RELATIVE : + begin + //inc(data,symaddr-len-CurrObjSec.Size); + data:=data+symaddr-len-CurrObjSec.Size; + end; + RELOC_RVA, + RELOC_SECREL32 : + begin + CurrObjSec.addsectionreloc(curraddr,CurrObjSec,reloctype); + inc(data,symaddr); + end; + else + internalerror(200604013); + end; + end + else + begin + if (p.objsection<>nil) and + (p.bind<>AB_COMMON) and + (reloctype<>RELOC_RELATIVE) then + CurrObjSec.addsectionreloc(curraddr,p.objsection,reloctype) + else + CurrObjSec.addsymreloc(curraddr,p,reloctype); + if (not win32) or + ((reloctype<>RELOC_RELATIVE) and (p.objsection<>nil)) then + inc(data,symaddr); + if reloctype=RELOC_RELATIVE then + begin + if win32 then + dec(data,len-4) + else + dec(data,len+CurrObjSec.Size); + end; + end; + end + else + begin + if reloctype=RELOC_RVA then + internalerror(200603033); + end; + CurrObjSec.write(data,len); + end; + + + procedure TCoffObjData.afteralloc; + var + mempos : qword; + i : longint; + begin + inherited afteralloc; + { DJ Coff requires mempositions } + if not win32 then + begin + mempos:=0; + for i:=0 to ObjSectionList.Count-1 do + mempos:=TObjSection(ObjSectionList[i]).setmempos(mempos); + end; + end; + + +{**************************************************************************** + TDJCoffObjData +****************************************************************************} + + constructor TDJCoffObjData.create(const n:string); + begin + inherited createcoff(n,false,TDJCoffObjSection); + end; + + +{**************************************************************************** + TPECoffObjData +****************************************************************************} + + constructor TPECoffObjData.create(const n:string); + begin + inherited createcoff(n,true,TPECoffObjSection); + end; + + +{**************************************************************************** + TCoffObjOutput +****************************************************************************} + + constructor TCoffObjOutput.createcoff(AWriter:TObjectWriter;awin32:boolean); + begin + inherited create(AWriter); + win32:=awin32; + end; + + + destructor TCoffObjOutput.destroy; + begin + if assigned(FCoffSyms) then + FCoffSyms.free; + if assigned(FCoffStrs) then + FCoffStrs.free; + inherited destroy; + end; + + + procedure TCoffObjOutput.write_symbol(const name:string;value:aword;section:smallint;typ,aux:byte); + var + sym : coffsymbol; + begin + FillChar(sym,sizeof(sym),0); + { symbolname } + if length(name)>8 then + begin + sym.strpos:=FCoffStrs.size+4; + FCoffStrs.writestr(name); + FCoffStrs.writestr(#0); + end + else + move(name[1],sym.name,length(name)); + sym.value:=value; + sym.section:=section; + sym.typ:=typ; + sym.aux:=aux; + inc(symidx); + FCoffSyms.write(sym,sizeof(sym)); + end; + + + procedure TCoffObjOutput.section_write_symbol(p:TObject;arg:pointer); + var + secrec : coffsectionrec; + begin + with TCoffObjSection(p) do + begin + secidx:=symidx div 2; + secsymidx:=symidx; + write_symbol(name,mempos,secidx,COFF_SYM_SECTION,1); + { AUX } + fillchar(secrec,sizeof(secrec),0); + secrec.len:=Size; + secrec.nrelocs:=ObjRelocations.count; + inc(symidx); + FCoffSyms.write(secrec,sizeof(secrec)); + end; + end; + + + procedure TCoffObjOutput.section_write_relocs(p:TObject;arg:pointer); + var + i : longint; + rel : coffreloc; + objreloc : TObjRelocation; + begin + for i:=0 to TObjSection(p).ObjRelocations.Count-1 do + begin + objreloc:=TObjRelocation(TObjSection(p).ObjRelocations[i]); + rel.address:=objreloc.dataoffset; + if assigned(objreloc.symbol) then + begin + if (objreloc.symbol.bind=AB_LOCAL) then + rel.sym:=objreloc.symbol.objsection.secsymidx + else + begin + if objreloc.symbol.symidx=-1 then + internalerror(200602233); + rel.sym:=objreloc.symbol.symidx; + end; + end + else + begin + if objreloc.objsection<>nil then + rel.sym:=objreloc.objsection.secsymidx + else + rel.sym:=0; + end; + case objreloc.typ of +{$ifdef arm} + RELOC_ABSOLUTE : + rel.reloctype:=IMAGE_REL_ARM_ADDR32; + + { I've no idea if this is correct (FK): + RELOC_RELATIVE : + rel.reloctype:=IMAGE_REL_ARM_GPREL12; + } + + RELOC_RVA : + rel.reloctype:=IMAGE_REL_ARM_ADDR32NB; + RELOC_SECREL32 : + rel.reloctype:=IMAGE_REL_ARM_SECREL; +{$endif arm} +{$ifdef i386} + RELOC_RELATIVE : + rel.reloctype:=IMAGE_REL_I386_PCRLONG; + RELOC_ABSOLUTE : + rel.reloctype:=IMAGE_REL_I386_DIR32; + RELOC_RVA : + rel.reloctype:=IMAGE_REL_I386_IMAGEBASE; + RELOC_SECREL32 : + rel.reloctype:=IMAGE_REL_I386_SECREL32; +{$endif i386} +{$ifdef x86_64} + RELOC_NONE : + rel.reloctype:=IMAGE_REL_AMD64_ABSOLUTE; + RELOC_RELATIVE : + rel.reloctype:=IMAGE_REL_AMD64_REL32; + RELOC_ABSOLUTE32 : + rel.reloctype:=IMAGE_REL_AMD64_ADDR32; + RELOC_ABSOLUTE : + rel.reloctype:=IMAGE_REL_AMD64_ADDR64; + RELOC_RVA : + rel.reloctype:=IMAGE_REL_AMD64_ADDR32NB; + RELOC_RELATIVE_1 : + rel.reloctype:=IMAGE_REL_AMD64_REL32_1; + RELOC_RELATIVE_2 : + rel.reloctype:=IMAGE_REL_AMD64_REL32_2; + RELOC_RELATIVE_3 : + rel.reloctype:=IMAGE_REL_AMD64_REL32_3; + RELOC_RELATIVE_4 : + rel.reloctype:=IMAGE_REL_AMD64_REL32_4; + RELOC_RELATIVE_5 : + rel.reloctype:=IMAGE_REL_AMD64_REL32_5; + RELOC_SECREL32 : + rel.reloctype:=IMAGE_REL_AMD64_SECREL; +{$endif x86_64} + else + internalerror(200905071); + end; + FWriter.write(rel,sizeof(rel)); + end; + end; + + + procedure TCoffObjOutput.create_symbols(data:TObjData); + var + filename : string[18]; + sectionval : word; + globalval : byte; + i : longint; + value : aword; + objsym : TObjSymbol; + begin + with TCoffObjData(data) do + begin + symidx:=0; + { The `.file' record, and the file name auxiliary record } + write_symbol('.file', 0, -2, COFF_SYM_FILE, 1); + fillchar(filename,sizeof(filename),0); + filename:=ExtractFileName(current_module.mainsource^); + inc(symidx); + FCoffSyms.write(filename[1],sizeof(filename)-1); + { Sections } + ObjSectionList.ForEachCall(@section_write_symbol,nil); + { ObjSymbols } + for i:=0 to ObjSymbolList.Count-1 do + begin + objsym:=TObjSymbol(ObjSymbolList[i]); + if (objsym.typ=AT_LABEL) and (objsym.bind=AB_LOCAL) then + continue; + case objsym.bind of + AB_GLOBAL : + begin + globalval:=2; + sectionval:=TCoffObjSection(objsym.objsection).secidx; + value:=objsym.address; + end; + AB_LOCAL : + begin + globalval:=3; + sectionval:=TCoffObjSection(objsym.objsection).secidx; + value:=objsym.address; + end; + else + begin + globalval:=2; + sectionval:=0; + value:=objsym.size; + end; + end; + { symbolname } + objsym.symidx:=symidx; + write_symbol(objsym.name,value,sectionval,globalval,0); + end; + end; + end; + + + procedure TCoffObjOutput.section_set_datapos(p:TObject;arg:pointer); + begin + TObjSection(p).setdatapos(paword(arg)^); + end; + + + procedure TCoffObjOutput.section_set_reloc_datapos(p:TObject;arg:pointer); + begin + TCoffObjSection(p).coffrelocpos:=paint(arg)^; + inc(paint(arg)^,sizeof(coffreloc)*TObjSection(p).ObjRelocations.count); + end; + + + procedure TCoffObjOutput.section_write_header(p:TObject;arg:pointer); + var + sechdr : tcoffsechdr; + s : string; + strpos : aword; + begin + with TCoffObjSection(p) do + begin + fillchar(sechdr,sizeof(sechdr),0); + s:=name; + if length(s)>8 then + begin + strpos:=FCoffStrs.size+4; + FCoffStrs.writestr(s); + FCoffStrs.writestr(#0); + s:='/'+ToStr(strpos); + end; + move(s[1],sechdr.name,length(s)); + if not win32 then + begin + sechdr.rvaofs:=mempos; + sechdr.vsize:=mempos; + end + else + begin + if not(oso_data in secoptions) then + sechdr.vsize:=Size; + end; + sechdr.DataSize:=size; + if (Size>0) and + (oso_data in secoptions) then + sechdr.datapos:=datapos; + sechdr.nrelocs:=ObjRelocations.count; + sechdr.relocpos:=coffrelocpos; + if win32 then + sechdr.flags:=peencodesechdrflags(secoptions,secalign) + else + sechdr.flags:=djencodesechdrflags(secoptions); + FWriter.write(sechdr,sizeof(sechdr)); + end; + end; + + + procedure TCoffObjOutput.section_write_data(p:TObject;arg:pointer); + begin + with TObjSection(p) do + begin + if assigned(data) then + begin + FWriter.writezeros(dataalignbytes); + if Datapos<>FWriter.ObjSize then + internalerror(200603052); + FWriter.writearray(data); + end; + end; + end; + + + function TCoffObjOutput.writedata(data:TObjData):boolean; + var + orgdatapos, + datapos, + sympos : aword; + i : longint; + gotreloc : boolean; + header : tcoffheader; + begin + result:=false; + FCoffSyms:=TDynamicArray.Create(SymbolMaxGrow); + FCoffStrs:=TDynamicArray.Create(StrsMaxGrow); + with TCoffObjData(data) do + begin + { Create Symbol Table } + create_symbols(data); + + { Calculate the filepositions } + datapos:=sizeof(tcoffheader)+sizeof(tcoffsechdr)*ObjSectionList.Count; + { Sections first } + ObjSectionList.ForEachCall(@section_set_datapos,@datapos); + { relocs } + orgdatapos:=datapos; + ObjSectionList.ForEachCall(@section_set_reloc_datapos,@datapos); + gotreloc:=(orgdatapos<>datapos); + { Symbols } + sympos:=datapos; + + { Generate COFF header } + fillchar(header,sizeof(tcoffheader),0); + header.mach:=COFF_MAGIC; + header.nsects:=ObjSectionList.Count; + header.sympos:=sympos; + header.syms:=symidx; + if win32 then + begin +{$ifdef arm} + header.flag:=PE_FILE_32BIT_MACHINE or + PE_FILE_LINE_NUMS_STRIPPED or PE_FILE_LOCAL_SYMS_STRIPPED; +{$else arm} + header.flag:=PE_FILE_BYTES_REVERSED_LO or PE_FILE_32BIT_MACHINE or + PE_FILE_LINE_NUMS_STRIPPED or PE_FILE_LOCAL_SYMS_STRIPPED; +{$endif arm} + if not gotreloc then + header.flag:=header.flag or PE_FILE_RELOCS_STRIPPED; + end + else + begin + header.flag:=COFF_FLAG_AR32WR or COFF_FLAG_NOLINES or COFF_FLAG_NOLSYMS; + if not gotreloc then + header.flag:=header.flag or COFF_FLAG_NORELOCS; + end; + FWriter.write(header,sizeof(header)); + { Section headers } + ObjSectionList.ForEachCall(@section_write_header,nil); + { ObjSections } + ObjSectionList.ForEachCall(@section_write_data,nil); + { Relocs } + ObjSectionList.ForEachCall(@section_write_relocs,nil); + { ObjSymbols } + if Sympos<>FWriter.ObjSize then + internalerror(200603051); + FWriter.writearray(FCoffSyms); + { Strings } + i:=FCoffStrs.size+4; + FWriter.write(i,4); + FWriter.writearray(FCoffStrs); + end; + FCoffStrs.Free; + FCoffStrs:=nil; + FCoffSyms.Free; + FCoffSyms:=nil; + end; + + + constructor TDJCoffObjOutput.create(AWriter:TObjectWriter); + begin + inherited createcoff(AWriter,false); + cobjdata:=TDJCoffObjData; + end; + + + constructor TPECoffObjOutput.create(AWriter:TObjectWriter); + begin + inherited createcoff(AWriter,true); + cobjdata:=TPECoffObjData; + end; + + +{**************************************************************************** + TCoffObjInput +****************************************************************************} + + constructor TCoffObjInput.createcoff(awin32:boolean); + begin + inherited create; + win32:=awin32; + FSymTbl:=nil; + end; + + + destructor TCoffObjInput.destroy; + begin + if assigned(FCoffSyms) then + FCoffSyms.free; + if assigned(FCoffStrs) then + FCoffStrs.free; + if assigned(FSymTbl) then + freemem(FSymTbl); + if assigned(FSecTbl) then + freemem(FSecTbl); + inherited destroy; + end; + + + function TCoffObjInput.GetSection(secidx:longint):TObjSection; + begin + result:=nil; + if (secidx<1) or (secidx>FSecCount) then + begin + InputError('Failed reading coff file, invalid section index'); + exit; + end; + result:=FSecTbl^[secidx]; + end; + + + function TCoffObjInput.Read_str(strpos:longword):string; + begin + FCoffStrs.Seek(strpos-4); + FCoffStrs.Read(result[1],255); + result[255]:=#0; + result[0]:=chr(strlen(@result[1])); + if result='' then + Internalerror(200205172); + end; + + + procedure TCoffObjInput.read_relocs(s:TCoffObjSection); + var + rel : coffreloc; + rel_type : TObjRelocationType; + i : longint; + p : TObjSymbol; + begin + for i:=1 to s.coffrelocs do + begin + FReader.read(rel,sizeof(rel)); + case rel.reloctype of +{$ifdef arm} + IMAGE_REL_ARM_ABSOLUTE: + rel_type:=RELOC_NONE; + IMAGE_REL_ARM_ADDR32: + rel_type:=RELOC_ABSOLUTE; + IMAGE_REL_ARM_ADDR32NB: + rel_type:=RELOC_RVA; + IMAGE_REL_ARM_BRANCH24: + rel_type:=RELOC_RELATIVE_24; + IMAGE_REL_ARM_SECREL: + rel_type:=RELOC_SECREL32; +{$endif arm} +{$ifdef i386} + IMAGE_REL_I386_PCRLONG : + rel_type:=RELOC_RELATIVE; + IMAGE_REL_I386_DIR32 : + rel_type:=RELOC_ABSOLUTE; + IMAGE_REL_I386_IMAGEBASE : + rel_type:=RELOC_RVA; + IMAGE_REL_I386_SECREL32 : + rel_type:=RELOC_SECREL32; +{$endif i386} +{$ifdef x86_64} + IMAGE_REL_AMD64_ABSOLUTE: + rel_type:=RELOC_NONE; + IMAGE_REL_AMD64_REL32: + rel_type:=RELOC_RELATIVE; + IMAGE_REL_AMD64_ADDR32, + R_X86_64_32S: + rel_type:=RELOC_ABSOLUTE32; + IMAGE_REL_AMD64_ADDR64: + rel_type:=RELOC_ABSOLUTE; + IMAGE_REL_AMD64_ADDR32NB: + rel_type:=RELOC_RVA; + IMAGE_REL_AMD64_REL32_1: + rel_type:=RELOC_RELATIVE_1; + IMAGE_REL_AMD64_REL32_2: + rel_type:=RELOC_RELATIVE_2; + IMAGE_REL_AMD64_REL32_3: + rel_type:=RELOC_RELATIVE_3; + IMAGE_REL_AMD64_REL32_4: + rel_type:=RELOC_RELATIVE_4; + IMAGE_REL_AMD64_REL32_5: + rel_type:=RELOC_RELATIVE_5; + IMAGE_REL_AMD64_SECREL: + rel_type:=RELOC_SECREL32; +{$endif x86_64} + else + begin + InputError('Failed reading coff file, illegal reloctype $'+system.hexstr(rel.reloctype,4)); + exit; + end; + end; + + p:=FSymTbl^[rel.sym].sym; + if assigned(p) then + s.addsymsizereloc(rel.address-s.mempos,p,FSymTbl^[rel.sym].orgsize,rel_type) + else + begin + InputError('Failed reading coff file, can''t resolve symbol of relocation'); + exit; + end; + end; + end; + + + procedure TCoffObjInput.read_symbols(objdata:TObjData); + var + size, + address, + nsyms, + symidx : aint; + i : longint; + sym : coffsymbol; + objsym : TObjSymbol; + bind : Tasmsymbind; + strname : string; + auxrec : array[0..17] of byte; + objsec : TObjSection; + begin + with TCoffObjData(objdata) do + begin + nsyms:=FCoffSyms.Size div sizeof(CoffSymbol); + { Allocate memory for symidx -> TObjSymbol table } + GetMem(FSymTbl,nsyms*sizeof(TObjSymbolrec)); + FillChar(FSymTbl^,nsyms*sizeof(TObjSymbolrec),0); + { Load the Symbols } + FCoffSyms.Seek(0); + symidx:=0; + while (symidx<nsyms) do + begin + FCoffSyms.Read(sym,sizeof(sym)); + if plongint(@sym.name)^<>0 then + begin + move(sym.name,strname[1],8); + strname[9]:=#0; + strname[0]:=chr(strlen(@strname[1])); + if strname='' then + Internalerror(200205171); + end + else + strname:=Read_str(sym.strpos); + bind:=AB_EXTERNAL; + size:=0; + address:=0; + objsym:=nil; + objsec:=nil; + case sym.typ of + COFF_SYM_GLOBAL : + begin + if sym.section=0 then + begin + if sym.value=0 then + bind:=AB_EXTERNAL + else + begin + bind:=AB_COMMON; + size:=sym.value; + end; + end + else + begin + bind:=AB_GLOBAL; + objsec:=GetSection(sym.section); + if sym.value>=objsec.mempos then + address:=sym.value-objsec.mempos; + end; + objsym:=CreateSymbol(strname); + objsym.bind:=bind; + objsym.typ:=AT_FUNCTION; + objsym.objsection:=objsec; + objsym.offset:=address; + objsym.size:=size; + { Register in ObjSection } + if assigned(objsec) then + objsec.AddSymbolDefine(objsym); + end; + COFF_SYM_LABEL, + COFF_SYM_LOCAL : + begin + { do not add constants (section=-1) } + if sym.section<>-1 then + begin + bind:=AB_LOCAL; + objsec:=GetSection(sym.section); + if sym.value>=objsec.mempos then + address:=sym.value-objsec.mempos; + objsym:=CreateSymbol(strname); + objsym.bind:=bind; + objsym.typ:=AT_FUNCTION; + objsym.objsection:=objsec; + objsym.offset:=address; + objsym.size:=size; + end; + end; + COFF_SYM_SECTION : + begin + if sym.section=0 then + InputError('Failed reading coff file, illegal section'); + objsec:=GetSection(sym.section); + if assigned(objsec) then + begin + if sym.value>=objsec.mempos then + address:=sym.value-objsec.mempos; + objsym:=CreateSymbol(strname); + objsym.bind:=AB_LOCAL; + objsym.typ:=AT_FUNCTION; + objsym.objsection:=objsec; + objsym.offset:=address; + objsym.size:=size; + end; + end; + COFF_SYM_FUNCTION, + COFF_SYM_FILE : + ; + else + internalerror(200602232); + end; + FSymTbl^[symidx].sym:=objsym; + FSymTbl^[symidx].orgsize:=size; + { read aux records } + for i:=1 to sym.aux do + begin + FCoffSyms.Read(auxrec,sizeof(auxrec)); + inc(symidx); + end; + inc(symidx); + end; + end; + end; + + + procedure TCoffObjInput.ObjSections_read_data(p:TObject;arg:pointer); + begin + with TCoffObjSection(p) do + begin + { Skip debug sections } + if (oso_debug in secoptions) and + (cs_link_strip in current_settings.globalswitches) and + not(cs_link_separate_dbg_file in current_settings.globalswitches) then + exit; + + if assigned(data) then + begin + FReader.Seek(datapos); + if not FReader.ReadArray(data,Size) then + begin + Comment(V_Error,'Error reading coff file, can''t read object data'); + exit; + end; + end; + end; + end; + + + procedure TCoffObjInput.ObjSections_read_relocs(p:TObject;arg:pointer); + begin + with TCoffObjSection(p) do + begin + { Skip debug sections } + if (oso_debug in secoptions) and + (cs_link_strip in current_settings.globalswitches) and + not(cs_link_separate_dbg_file in current_settings.globalswitches) then + exit; + + if coffrelocs>0 then + begin + FReader.Seek(coffrelocpos); + read_relocs(TCoffObjSection(p)); + end; + end; + end; + + + function TCoffObjInput.ReadObjData(AReader:TObjectreader;objdata:TObjData):boolean; + var + secalign : shortint; + strsize, + strpos, + i : longint; + code : longint; + objsec : TCoffObjSection; + secoptions : TObjSectionOptions; + header : tcoffheader; + sechdr : tcoffsechdr; + secname : string; + secnamebuf : array[0..15] of char; + begin + FReader:=AReader; + InputFileName:=AReader.FileName; + result:=false; + FCoffSyms:=TDynamicArray.Create(SymbolMaxGrow); + FCoffStrs:=TDynamicArray.Create(StrsMaxGrow); + with TCoffObjData(objdata) do + begin + { Read COFF header } + if not AReader.read(header,sizeof(tcoffheader)) then + begin + InputError('Can''t read COFF Header'); + exit; + end; + if header.mach<>COFF_MAGIC then + begin + InputError('Illegal COFF Magic'); + exit; + end; +{$ifdef arm} + eVCobj:=header.flag=$100; +{$endif arm} + { Strings } + AReader.Seek(header.sympos+header.syms*sizeof(CoffSymbol)); + if not AReader.Read(strsize,4) then + begin + InputError('Error reading COFF Symtable'); + exit; + end; + if (strsize>4) and not AReader.ReadArray(FCoffStrs,Strsize-4) then + begin + InputError('Error reading COFF Symtable'); + exit; + end; + { Section headers } + { Allocate SecIdx -> TObjSection table, secidx is 1-based } + FSecCount:=header.nsects; + GetMem(FSecTbl,(header.nsects+1)*sizeof(TObjSection)); + FillChar(FSecTbl^,(header.nsects+1)*sizeof(TObjSection),0); + AReader.Seek(sizeof(tcoffheader)+header.opthdr); + for i:=1 to header.nsects do + begin + if not AReader.read(sechdr,sizeof(sechdr)) then + begin + InputError('Error reading COFF Section Headers'); + exit; + end; + move(sechdr.name,secnamebuf,8); + secnamebuf[8]:=#0; + secname:=strpas(secnamebuf); + if secname[1]='/' then + begin + Val(Copy(secname,2,8),strpos,code); + if code=0 then + secname:=Read_str(strpos) + else + begin + InputError('Error reading COFF Section Headers'); + secname:='error'; + end; + end; + if win32 then + pedecodesechdrflags(secname,sechdr.flags,secoptions,secalign) + else + begin + djdecodesechdrflags(secname,sechdr.flags); + secalign:=sizeof(pint); + end; + if (Length(secname)>3) and (secname[2] in ['e','f','i','p','r']) then + begin + if (Copy(secname,1,6)='.edata') or + (Copy(secname,1,5)='.rsrc') or +{$ifndef x86_64} + (Copy(secname,1,6)='.pdata') or +{$endif} + (Copy(secname,1,4)='.fpc') then + include(secoptions,oso_keep); + if (Copy(secname,1,6)='.idata') then + begin + { TODO: idata keep can maybe replaced with grouping of text and idata} + include(secoptions,oso_keep); + secname:=secname + '.' + ExtractFileName(InputFileName); + end; + end; + objsec:=TCoffObjSection(createsection(secname,secalign,secoptions,false)); + FSecTbl^[i]:=objsec; + if not win32 then + objsec.mempos:=sechdr.rvaofs; + objsec.orgmempos:=sechdr.rvaofs; + objsec.coffrelocs:=sechdr.nrelocs; + objsec.coffrelocpos:=sechdr.relocpos; + objsec.datapos:=sechdr.datapos; + objsec.Size:=sechdr.dataSize; + end; + { ObjSymbols } + AReader.Seek(header.sympos); + if not AReader.ReadArray(FCoffSyms,header.syms*sizeof(CoffSymbol)) then + begin + Comment(V_Error,'Error reading coff file'); + exit; + end; + { Insert all ObjSymbols } + read_symbols(objdata); + { Section Data } + ObjSectionList.ForEachCall(@objsections_read_data,nil); + { Relocs } + ObjSectionList.ForEachCall(@objsections_read_relocs,nil); + end; + FCoffStrs.Free; + FCoffStrs:=nil; + FCoffSyms.Free; + FCoffSyms:=nil; + result:=true; + end; + + + constructor TDJCoffObjInput.create; + begin + inherited createcoff(false); + cobjdata:=TDJCoffObjData; + end; + + + constructor TPECoffObjInput.create; + begin + inherited createcoff(true); + cobjdata:=TPECoffObjData; + end; + + +{**************************************************************************** + TCoffexesection +****************************************************************************} + + + constructor TCoffExeSection.createcoff(AList:TFPHashObjectList;const n:string;awin32:boolean); + begin + inherited create(AList,n); + win32:=awin32; + end; + + + constructor TDJCoffExeSection.create(AList:TFPHashObjectList;const n:string); + begin + inherited createcoff(AList,n,false); + end; + + + constructor TPECoffExeSection.create(AList:TFPHashObjectList;const n:string); + begin + inherited createcoff(AList,n,false); + end; + + +{**************************************************************************** + TCoffexeoutput +****************************************************************************} + + constructor TCoffexeoutput.createcoff(awin32:boolean); + begin + inherited create; + win32:=awin32; + if target_info.system in [system_x86_64_win64] then + MaxMemPos:=$FFFFFFFF + else + if target_info.system in systems_wince then + MaxMemPos:=$1FFFFFF + else + MaxMemPos:=$7FFFFFFF; + end; + + + procedure TCoffexeoutput.write_symbol(const name:string;value:aword;section:smallint;typ,aux:byte); + var + sym : coffsymbol; + begin + FillChar(sym,sizeof(sym),0); + if length(name)>8 then + begin + sym.strpos:=FCoffStrs.size+4; + FCoffStrs.writestr(name); + FCoffStrs.writestr(#0); + end + else + move(name[1],sym.name,length(name)); + sym.value:=value; + sym.section:=section; + sym.typ:=typ; + sym.aux:=aux; + FWriter.write(sym,sizeof(sym)); + end; + + + procedure TCoffexeoutput.globalsyms_write_symbol(p:TObject;arg:pointer); + var + secval, + value : aint; + globalval : byte; + exesec : TExeSection; + begin + if not assigned(texesymbol(p).objsymbol) then + internalerror(200603053); + with texesymbol(p).objsymbol do + begin + exesec:=TExeSection(objsection.exesection); + { There is no exesection defined for special internal symbols + like __image_base__ } + if assigned(exesec) then + begin + secval:=exesec.secsymidx; + value:=address-exesec.mempos; + end + else + begin + secval:=-1; + value:=address; + end; + if bind=AB_LOCAL then + globalval:=3 + else + globalval:=2; + { reloctype address to the section in the executable } + write_symbol(name,value,secval,globalval,0); + end; + end; + + + procedure TCoffexeoutput.ExeSectionList_write_header(p:TObject;arg:pointer); + var + sechdr : tcoffsechdr; + s : string; + strpos : aword; + begin + with tExeSection(p) do + begin + fillchar(sechdr,sizeof(sechdr),0); + s:=name; + if length(s)>8 then + begin + strpos:=FCoffStrs.size+4; + FCoffStrs.writestr(s); + FCoffStrs.writestr(#0); + s:='/'+ToStr(strpos); + end; + move(s[1],sechdr.name,length(s)); + sechdr.rvaofs:=mempos; + if win32 then + sechdr.vsize:=Size + else + sechdr.vsize:=mempos; + + { sechdr.dataSize is size of initilized data. Must be zero for sections that + do not contain one. In Windows it must be rounded up to FileAlignment + (so it can be greater than VirtualSize) } + if (oso_data in SecOptions) then + begin + if win32 then + sechdr.dataSize:=Align(Size,SectionDataAlign) + else + sechdr.dataSize:=Size; + if (Size>0) then + sechdr.datapos:=datapos; + end; + sechdr.nrelocs:=0; + sechdr.relocpos:=0; + if win32 then + begin + if (target_info.system in systems_nativent) and + (apptype = app_native) then + sechdr.flags:=peencodesechdrflags(SecOptions,SecAlign) or PE_SCN_MEM_NOT_PAGED + else + sechdr.flags:=peencodesechdrflags(SecOptions,SecAlign); + { some flags are invalid in executables, reset them } + sechdr.flags:=sechdr.flags and + not(PE_SCN_LNK_INFO or PE_SCN_LNK_REMOVE or + PE_SCN_LNK_COMDAT or PE_SCN_ALIGN_MASK); + end + else + sechdr.flags:=djencodesechdrflags(SecOptions); + FWriter.write(sechdr,sizeof(sechdr)); + end; + end; + + + procedure TCoffexeoutput.ExeSectionList_pass2_header(p:TObject;arg:pointer); + begin + with TExeSection(p) do + begin + { The debuginfo sections should already be stripped } +{ if (ExeWriteMode=ewm_exeonly) and + (oso_debug in SecOptions) then + internalerror(200801161); } + inc(plongint(arg)^); + secsymidx:=plongint(arg)^; + end; + end; + + + procedure Tcoffexeoutput.ExeSectionList_write_Data(p:TObject;arg:pointer); + var + objsec : TObjSection; + i : longint; + begin + with texesection(p) do + begin + { don't write normal section if writing only debug info } + if (ExeWriteMode=ewm_dbgonly) and + not(oso_debug in SecOptions) then + exit; + + if oso_data in secoptions then + begin + FWriter.Writezeros(Align(FWriter.Size,SectionDataAlign)-FWriter.Size); + for i:=0 to ObjSectionList.Count-1 do + begin + objsec:=TObjSection(ObjSectionList[i]); + if oso_data in objsec.secoptions then + begin + if not assigned(objsec.data) then + internalerror(200603042); + FWriter.writezeros(objsec.dataalignbytes); + if objsec.DataPos<>FWriter.Size then + internalerror(200602251); + FWriter.writearray(objsec.data); + end; + end; + end; + end; + end; + + + function tcoffexeoutput.totalheadersize:longword; + var + stubsize, + optheadersize : longword; + begin + if win32 then + begin + stubsize:=sizeof(win32stub)+sizeof(pemagic); + optheadersize:=sizeof(tcoffpeoptheader); + end + else + begin + stubsize:=sizeof(go32v2stub); + optheadersize:=sizeof(coffdjoptheader); + end; + result:=stubsize+sizeof(tcoffheader)+optheadersize; + end; + + + procedure tcoffexeoutput.MemPos_Header; + begin + { calculate start positions after the headers } + currmempos:=totalheadersize+sizeof(tcoffsechdr)*longword(ExeSectionList.Count-2); + end; + + + procedure tcoffexeoutput.DataPos_Header; + begin + { retrieve amount of sections } + nsects:=0; + ExeSectionList.ForEachCall(@ExeSectionList_pass2_header,@nsects); + { calculate start positions after the headers } + currdatapos:=totalheadersize+longword(nsects)*sizeof(tcoffsechdr); + end; + + + procedure tcoffexeoutput.DataPos_Symbols; + begin + inherited DataPos_Symbols; + { Calculating symbols position and size } + nsyms:=ExeSymbolList.Count; + sympos:=Align(CurrDataPos,SectionDataAlign); + inc(CurrDataPos,sizeof(coffsymbol)*nsyms); + end; + + + function TCoffexeoutput.writedata:boolean; + var + i : longword; + header : tcoffheader; + djoptheader : coffdjoptheader; + peoptheader : tcoffpeoptheader; + textExeSec, + dataExeSec, + bssExeSec, + idataExeSec, + tlsExeSec : TExeSection; + tlsdir : TlsDirectory; + hassymbols, + writeDbgStrings : boolean; + + procedure UpdateDataDir(const secname:string;idx:longint); + var + exesec : TExeSection; + begin + exesec:=FindExeSection(secname); + if assigned(exesec) then + begin + peoptheader.DataDirectory[idx].vaddr:=exesec.mempos; + peoptheader.DataDirectory[idx].size:=exesec.Size; + end; + end; + + procedure UpdateImports; + var + exesec: TExeSection; + objsec, iat_start, iat_end, ilt_start: TObjSection; + i: longint; + begin + exesec:=FindExeSection('.idata'); + if exesec=nil then + exit; + iat_start:=nil; + iat_end:=nil; + ilt_start:=nil; + for i:=0 to exesec.ObjSectionList.Count-1 do + begin + objsec:=TObjSection(exesec.ObjSectionList[i]); + if (ilt_start=nil) and (Pos('.idata$4',objsec.Name)=1) then + ilt_start:=objsec; + if Pos('.idata$5',objsec.Name)=1 then + begin + if iat_start=nil then + iat_start:=objsec; + end + else + if Assigned(iat_start) then + begin + iat_end:=objsec; + Break; + end; + end; + + peoptheader.DataDirectory[PE_DATADIR_IDATA].vaddr:=exesec.mempos; + if Assigned(ilt_start) then + peoptheader.DataDirectory[PE_DATADIR_IDATA].size:=ilt_start.mempos-exesec.mempos + else { should not happen } + peoptheader.DataDirectory[PE_DATADIR_IDATA].size:=exesec.Size; + + if Assigned(iat_start) and Assigned(iat_end) then + begin + peoptheader.DataDirectory[PE_DATADIR_IMPORTADDRESSTABLE].vaddr:=iat_start.mempos; + peoptheader.DataDirectory[PE_DATADIR_IMPORTADDRESSTABLE].size:=iat_end.mempos-iat_start.mempos; + end; + end; + + procedure UpdateTlsDataDir; + var + {callbacksection : TExeSection;} + tlsexesymbol: TExeSymbol; + tlssymbol: TObjSymbol; + callbackexesymbol: TExeSymbol; + callbacksymbol: TObjSymbol; + begin + { according to GNU ld, + the callback routines should be placed into .CRT$XL* + sections, and the thread local variables in .tls + __tls_start__ and __tls_end__ symbols + should be used for the initialized part, + which we do not support yet. } + { For now, we only pass the address of the __tls_used + asm symbol into PE_DATADIR_TLS with the correct + size of this table (different for win32/win64 } + tlsexesymbol:=texesymbol(ExeSymbolList.Find( + target_info.Cprefix+'_tls_used')); + if assigned(tlsexesymbol) then + begin + tlssymbol:=tlsexesymbol.ObjSymbol; + peoptheader.DataDirectory[PE_DATADIR_TLS].vaddr:=tlssymbol.address; + { sizeof(TlsDirectory) is different on host and target when cross-compiling } + peoptheader.DataDirectory[PE_DATADIR_TLS].size:=TLSDIR_SIZE; + if IsSharedLibrary then + begin + { Here we should reset __FPC_tls_callbacks value to nil } + callbackexesymbol:=texesymbol(ExeSymbolList.Find( + '__FPC_tls_callbacks')); + if assigned (callbackexesymbol) then + begin + callbacksymbol:=callbackexesymbol.ObjSymbol; + + end; + end; + + end; + end; + + begin + result:=false; + FCoffSyms:=TDynamicArray.Create(SymbolMaxGrow); + FCoffStrs:=TDynamicArray.Create(StrsMaxGrow); + textExeSec:=FindExeSection('.text'); + dataExeSec:=FindExeSection('.data'); + bssExeSec:=FindExeSection('.bss'); + tlsExeSec:=FindExeSection('.tls'); + if not assigned(TextExeSec) or + not assigned(DataExeSec) then + internalerror(200602231); + { do we need to write symbols? } + hassymbols:=(ExeWriteMode=ewm_dbgonly) or + ( + (ExeWriteMode=ewm_exefull) and + not(cs_link_strip in current_settings.globalswitches) + ); + writeDbgStrings:=hassymbols or ((ExeWriteMode=ewm_exeonly) and (cs_link_separate_dbg_file in current_settings.globalswitches)); + { Stub } + if win32 then + begin + FWriter.write(win32stub,sizeof(win32stub)); + FWriter.write(pemagic,sizeof(pemagic)); + end + else + FWriter.write(go32v2stub,sizeof(go32v2stub)); + { Initial header, will be updated later } + fillchar(header,sizeof(header),0); + header.mach:=COFF_MAGIC; + header.nsects:=nsects; + if writeDbgStrings then + header.sympos:=sympos; + if hassymbols then + header.syms:=nsyms; + if win32 then + header.opthdr:=sizeof(tcoffpeoptheader) + else + header.opthdr:=sizeof(coffdjoptheader); + if win32 then + begin + header.flag:=PE_FILE_EXECUTABLE_IMAGE or PE_FILE_LINE_NUMS_STRIPPED; + if target_info.system in [system_x86_64_win64] then + header.flag:=header.flag or PE_FILE_LARGE_ADDRESS_AWARE + else + header.flag:=header.flag or PE_FILE_32BIT_MACHINE; + if IsSharedLibrary then + header.flag:=header.flag or PE_FILE_DLL; + if FindExeSection('.reloc')=nil then + header.flag:=header.flag or PE_FILE_RELOCS_STRIPPED; + if (FindExeSection('.stab')=nil) and + (FindExeSection('.debug_info')=nil) and + (FindExeSection('.gnu_debuglink')=nil) then + header.flag:=header.flag or PE_FILE_DEBUG_STRIPPED; + if not hassymbols then + header.flag:=header.flag or PE_FILE_LOCAL_SYMS_STRIPPED; + if SetPEFlagsSetExplicity then + header.flag:=header.flag or peflags; + end + else + header.flag:=COFF_FLAG_AR32WR or COFF_FLAG_EXE or COFF_FLAG_NORELOCS or COFF_FLAG_NOLINES; + FWriter.write(header,sizeof(header)); + { Optional COFF Header } + if win32 then + begin + fillchar(peoptheader,sizeof(peoptheader),0); + peoptheader.magic:=COFF_OPT_MAGIC; + peoptheader.MajorLinkerVersion:=ord(version_nr)-ord('0'); + peoptheader.MinorLinkerVersion:=(ord(release_nr)-ord('0'))*10 + (ord(patch_nr)-ord('0')); + peoptheader.tsize:=TextExeSec.Size; + peoptheader.dsize:=DataExeSec.Size; + if assigned(BSSExeSec) then + peoptheader.bsize:=BSSExeSec.Size; + peoptheader.text_start:=TextExeSec.mempos; +{$ifndef cpu64bitaddr} + peoptheader.data_start:=DataExeSec.mempos; +{$endif cpu64bitaddr} + peoptheader.entry:=EntrySym.Address; + peoptheader.ImageBase:=ImageBase; + peoptheader.SectionAlignment:=SectionMemAlign; + peoptheader.FileAlignment:=SectionDataAlign; + peoptheader.MajorOperatingSystemVersion:=4; + peoptheader.MinorOperatingSystemVersion:=0; + peoptheader.MajorImageVersion:=dllmajor; + peoptheader.MinorImageVersion:=dllminor; + if target_info.system in systems_wince then + peoptheader.MajorSubsystemVersion:=3 + else + peoptheader.MajorSubsystemVersion:=4; + peoptheader.MinorSubsystemVersion:=0; + peoptheader.Win32Version:=0; + peoptheader.SizeOfImage:=Align(CurrMemPos,SectionMemAlign); + peoptheader.SizeOfHeaders:=textExeSec.DataPos; + peoptheader.CheckSum:=0; + if (target_info.system in systems_nativent) and (not IsSharedLibrary or (apptype = app_native)) then + { Although I did not really test this, it seems that Subsystem is + not checked in DLLs except for maybe drivers} + peoptheader.Subsystem:=PE_SUBSYSTEM_NATIVE + else + if target_info.system in systems_wince then + peoptheader.Subsystem:=PE_SUBSYSTEM_WINDOWS_CE_GUI + else + if apptype=app_gui then + peoptheader.Subsystem:=PE_SUBSYSTEM_WINDOWS_GUI + else + peoptheader.Subsystem:=PE_SUBSYSTEM_WINDOWS_CUI; + peoptheader.DllCharacteristics:=0; + peoptheader.SizeOfStackReserve:=stacksize; + peoptheader.SizeOfStackCommit:=$1000; + if MinStackSizeSetExplicity then + peoptheader.SizeOfStackCommit:=minstacksize; + if MaxStackSizeSetExplicity then + peoptheader.SizeOfStackReserve:=maxstacksize; + peoptheader.SizeOfHeapReserve:=$100000; + peoptheader.SizeOfHeapCommit:=$1000; + peoptheader.NumberOfRvaAndSizes:=PE_DATADIR_ENTRIES; + UpdateImports; + UpdateTlsDataDir; + UpdateDataDir('.edata',PE_DATADIR_EDATA); + UpdateDataDir('.rsrc',PE_DATADIR_RSRC); + UpdateDataDir('.pdata',PE_DATADIR_PDATA); + UpdateDataDir('.reloc',PE_DATADIR_RELOC); + FWriter.write(peoptheader,sizeof(peoptheader)); + end + else + begin + fillchar(djoptheader,sizeof(djoptheader),0); + djoptheader.magic:=COFF_OPT_MAGIC; + djoptheader.tsize:=TextExeSec.Size; + djoptheader.dsize:=DataExeSec.Size; + if assigned(BSSExeSec) then + djoptheader.bsize:=BSSExeSec.Size; + djoptheader.text_start:=TextExeSec.mempos; + djoptheader.data_start:=DataExeSec.mempos; + djoptheader.entry:=EntrySym.offset; + FWriter.write(djoptheader,sizeof(djoptheader)); + end; + + { For some unknown reason WM 6.1 requires .idata section to be read only. + Otherwise it refuses to load DLLs greater than 64KB. + Earlier versions of WinCE load DLLs regardless of .idata flags. } + if target_info.system in systems_wince then + begin + idataExeSec:=FindExeSection('.idata'); + if idataExeSec<>nil then + idataExeSec.SecOptions:=idataExeSec.SecOptions - [oso_write] + [oso_readonly]; + end; + + { Section headers } + ExeSectionList.ForEachCall(@ExeSectionList_write_header,nil); + { Section data } + ExeSectionList.ForEachCall(@ExeSectionList_write_data,nil); + { Align after the last section } + FWriter.Writezeros(Align(FWriter.Size,SectionDataAlign)-FWriter.Size); + + { Optional Symbols } + if SymPos<>FWriter.Size then + internalerror(200602252); + if hassymbols then + ExeSymbolList.ForEachCall(@globalsyms_write_symbol,nil); + if writeDbgStrings then + begin + { Strings } + i:=FCoffStrs.size+4; + FWriter.write(i,4); + FWriter.writearray(FCoffStrs); + end; + { Release } + FCoffStrs.Free; + FCoffSyms.Free; + result:=true; + end; + + + function IdataObjSectionCompare(Item1, Item2: Pointer): Integer; + var + I1 : TObjSection absolute Item1; + I2 : TObjSection absolute Item2; + begin + Result:=CompareStr(I1.Name,I2.Name); + end; + + procedure TCoffexeoutput.Order_ObjSectionList(ObjSectionList: TFPObjectList;const aPattern:string); + begin + { Sort sections having '$' in the name, that's how PECOFF documentation + tells to handle them. However, look for '$' in the pattern, not in section + names, because the latter often get superfluous '$' due to mangling. } + if Pos('$',aPattern)>0 then + ObjSectionList.Sort(@IdataObjSectionCompare); + end; + + + constructor TDJCoffexeoutput.create; + begin + inherited createcoff(false); + CExeSection:=TDJCoffExeSection; + CObjData:=TPECoffObjData; + end; + + + constructor TPECoffexeoutput.create; + begin + inherited createcoff(true); + CExeSection:=TPECoffExeSection; + CObjData:=TPECoffObjData; + end; + + + procedure TPECoffexeoutput.GenerateLibraryImports(ImportLibraryList:TFPHashObjectList); + var + textobjsection, + idata2objsection, + idata4objsection, + idata5objsection, + idata6objsection, + idata7objsection : TObjSection; + idata2label : TObjSymbol; + basedllname : string; + + procedure StartImport(const dllname:string); + var + idata4label, + idata5label, + idata7label : TObjSymbol; + emptyint : longint; + begin + if assigned(exemap) then + begin + exemap.Add(''); + exemap.Add('Importing from DLL '+dllname); + end; + emptyint:=0; + basedllname:=ExtractFileName(dllname); + idata2objsection:=internalobjdata.createsection(sec_idata2,basedllname); + idata2label:=internalobjdata.SymbolDefine('__imp_dir_'+basedllname,AB_LOCAL,AT_DATA); + idata4objsection:=internalobjdata.createsection(sec_idata4,basedllname); + idata4label:=internalobjdata.SymbolDefine('__imp_names_'+basedllname,AB_LOCAL,AT_DATA); + idata5objsection:=internalobjdata.createsection(sec_idata5,basedllname); + idata5label:=internalobjdata.SymbolDefine('__imp_fixup_'+basedllname,AB_LOCAL,AT_DATA); + idata7objsection:=internalobjdata.createsection(sec_idata7,basedllname); + idata7label:=internalobjdata.SymbolDefine('__imp_dll_'+basedllname,AB_LOCAL,AT_DATA); + { idata2 } + internalobjdata.SetSection(idata2objsection); + { dummy links to imports finalization } + internalobjdata.writereloc(0,0,internalobjdata.SymbolRef('__imp_names_end_'+basedllname),RELOC_NONE); + internalobjdata.writereloc(0,0,internalobjdata.SymbolRef('__imp_fixup_end_'+basedllname),RELOC_NONE); + { section data } + internalobjdata.writereloc(0,sizeof(longint),idata4label,RELOC_RVA); + internalobjdata.writebytes(emptyint,sizeof(emptyint)); + internalobjdata.writebytes(emptyint,sizeof(emptyint)); + internalobjdata.writereloc(0,sizeof(longint),idata7label,RELOC_RVA); + internalobjdata.writereloc(0,sizeof(longint),idata5label,RELOC_RVA); + { idata7 } + internalobjdata.SetSection(idata7objsection); + internalobjdata.writebytes(basedllname[1],length(basedllname)); + internalobjdata.writebytes(emptyint,1); + end; + + procedure EndImport; + var + emptyint : longint; + begin + emptyint:=0; + { These are referenced from idata2, oso_keep is not necessary. } + idata4objsection:=internalobjdata.createsection(sec_idata4, basedllname+'_z_'); + internalobjdata.SymbolDefine('__imp_names_end_'+basedllname,AB_LOCAL,AT_DATA); + idata5objsection:=internalobjdata.createsection(sec_idata5, basedllname+'_z_'); + internalobjdata.SymbolDefine('__imp_fixup_end_'+basedllname,AB_LOCAL,AT_DATA); + { idata4 } + internalobjdata.SetSection(idata4objsection); + internalobjdata.writebytes(emptyint,sizeof(emptyint)); + if target_info.system=system_x86_64_win64 then + internalobjdata.writebytes(emptyint,sizeof(emptyint)); + { idata5 } + internalobjdata.SetSection(idata5objsection); + internalobjdata.writebytes(emptyint,sizeof(emptyint)); + if target_info.system=system_x86_64_win64 then + internalobjdata.writebytes(emptyint,sizeof(emptyint)); + end; + + function AddImport(const afuncname,amangledname:string; AOrdNr:longint;isvar:boolean):TObjSymbol; + const +{$ifdef x86_64} + jmpopcode : array[0..1] of byte = ( + $ff,$25 // jmp qword [rip + offset32] + ); +{$else x86_64} + {$ifdef arm} + jmpopcode : array[0..7] of byte = ( + $00,$c0,$9f,$e5, // ldr ip, [pc, #0] + $00,$f0,$9c,$e5 // ldr pc, [ip] + ); + {$else arm} + jmpopcode : array[0..1] of byte = ( + $ff,$25 + ); + {$endif arm} +{$endif x86_64} + nopopcodes : array[0..1] of byte = ( + $90,$90 + ); + var + idata4label, + idata5label, + idata6label : TObjSymbol; + emptyint : longint; + secname, + num : string; + absordnr: word; + + procedure WriteTableEntry; + var + ordint: dword; + begin + if AOrdNr <= 0 then + begin + { import by name } + internalobjdata.writereloc(0,sizeof(longint),idata6label,RELOC_RVA); + if target_info.system=system_x86_64_win64 then + internalobjdata.writebytes(emptyint,sizeof(emptyint)); + end + else + begin + { import by ordinal } + ordint:=AOrdNr; + if target_info.system=system_x86_64_win64 then + begin + internalobjdata.writebytes(ordint,sizeof(ordint)); + ordint:=$80000000; + internalobjdata.writebytes(ordint,sizeof(ordint)); + end + else + begin + ordint:=ordint or $80000000; + internalobjdata.writebytes(ordint,sizeof(ordint)); + end; + end; + end; + + begin + result:=nil; + emptyint:=0; + if assigned(exemap) then + begin + if AOrdNr <= 0 then + exemap.Add(' Importing Function '+afuncname) + else + exemap.Add(' Importing Function '+afuncname+' (OrdNr='+tostr(AOrdNr)+')'); + end; + + with internalobjdata do + begin + secname:=basedllname+'_i_'+amangledname; + textobjsection:=createsection(sectionname(sec_code,secname,secorder_default),current_settings.alignment.procalign,sectiontype2options(sec_code) - [oso_keep]); + idata4objsection:=createsection(sec_idata4, secname); + idata5objsection:=createsection(sec_idata5, secname); + idata6objsection:=createsection(sec_idata6, secname); + end; + + { idata6, import data (ordnr+name) } + internalobjdata.SetSection(idata6objsection); + inc(idatalabnr); + num:=tostr(idatalabnr); + idata6label:=internalobjdata.SymbolDefine('__imp_'+num,AB_LOCAL,AT_DATA); + absordnr:=Abs(AOrdNr); + { write index hint } + internalobjdata.writebytes(absordnr,2); + if AOrdNr <= 0 then + internalobjdata.writebytes(afuncname[1],length(afuncname)); + internalobjdata.writebytes(emptyint,1); + internalobjdata.writebytes(emptyint,align(internalobjdata.CurrObjSec.size,2)-internalobjdata.CurrObjSec.size); + { idata4, import lookup table } + internalobjdata.SetSection(idata4objsection); + idata4label:=internalobjdata.SymbolDefine('__imp_lookup_'+num,AB_LOCAL,AT_DATA); + WriteTableEntry; + { idata5, import address table } + internalobjdata.SetSection(idata5objsection); + { dummy back links } + internalobjdata.writereloc(0,0,idata4label,RELOC_NONE); + internalobjdata.writereloc(0,0,idata2label,RELOC_NONE); + { section data } + if isvar then + result:=internalobjdata.SymbolDefine(amangledname,AB_GLOBAL,AT_DATA) + else + idata5label:=internalobjdata.SymbolDefine('__imp_'+amangledname,AB_LOCAL,AT_DATA); + WriteTableEntry; + { text, jmp } + if not isvar then + begin + internalobjdata.SetSection(textobjsection); + result:=internalobjdata.SymbolDefine('_'+amangledname,AB_GLOBAL,AT_FUNCTION); + internalobjdata.writebytes(jmpopcode,sizeof(jmpopcode)); +{$ifdef x86_64} + internalobjdata.writereloc(0,4,idata5label,RELOC_RELATIVE); +{$else} + internalobjdata.writereloc(0,4,idata5label,RELOC_ABSOLUTE32); +{$endif x86_64} + + internalobjdata.writebytes(nopopcodes,align(internalobjdata.CurrObjSec.size,sizeof(nopopcodes))-internalobjdata.CurrObjSec.size); + end; + end; + + var + i,j : longint; + ImportLibrary : TImportLibrary; + ImportSymbol : TImportSymbol; + exesym : TExeSymbol; + begin + for i:=0 to ImportLibraryList.Count-1 do + begin + ImportLibrary:=TImportLibrary(ImportLibraryList[i]); + idata2objsection:=nil; + idata4objsection:=nil; + idata5objsection:=nil; + idata6objsection:=nil; + idata7objsection:=nil; + for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do + begin + ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]); + exesym:=TExeSymbol(ExeSymbolList.Find(ImportSymbol.MangledName)); + if assigned(exesym) and + (exesym.State<>symstate_defined) then + begin + if not assigned(idata2objsection) then + StartImport(ImportLibrary.Name); + exesym.objsymbol:=AddImport(ImportSymbol.Name,ImportSymbol.MangledName,ImportSymbol.OrdNr,ImportSymbol.IsVar); + exesym.State:=symstate_defined; + end; + end; + if assigned(idata2objsection) then + EndImport; + end; + PackUnresolvedExeSymbols('after DLL imports'); + end; + + + procedure TPECoffexeoutput.GenerateRelocs; + var + pgaddr, hdrpos : longword; + + procedure FinishBlock; + var + p,len : longint; + begin + if hdrpos = longword(-1) then + exit; + p:=0; + internalobjdata.writebytes(p,align(internalobjdata.CurrObjSec.size,4)-internalobjdata.CurrObjSec.size); + p:=internalObjData.CurrObjSec.Data.Pos; + internalObjData.CurrObjSec.Data.seek(hdrpos+4); + len:=p-hdrpos; + internalObjData.CurrObjSec.Data.write(len,4); + internalObjData.CurrObjSec.Data.seek(p); + hdrpos:=longword(-1); + end; + + var + exesec : TExeSection; + objsec : TObjSection; + objreloc : TObjRelocation; + i,j,k : longint; + offset : longword; + w: word; + begin + if not RelocSection or FRelocsGenerated then + exit; + exesec:=FindExeSection('.reloc'); + if exesec=nil then + exit; + objsec:=internalObjData.createsection('.reloc',0,exesec.SecOptions+[oso_data]); + exesec.AddObjSection(objsec); + pgaddr:=longword(-1); + hdrpos:=longword(-1); + for i:=0 to ExeSectionList.Count-1 do + begin + exesec:=TExeSection(ExeSectionList[i]); + for j:=0 to exesec.ObjSectionList.count-1 do + begin + objsec:=TObjSection(exesec.ObjSectionList[j]); + { create relocs only for sections which are loaded in memory } + if not (oso_load in objsec.SecOptions) then + continue; + for k:=0 to objsec.ObjRelocations.Count-1 do + begin + objreloc:=TObjRelocation(objsec.ObjRelocations[k]); + if not (objreloc.typ in [{$ifdef cpu64bitaddr}RELOC_ABSOLUTE32,{$endif cpu64bitaddr}RELOC_ABSOLUTE]) then + continue; + offset:=objsec.MemPos+objreloc.dataoffset; + if (offset<pgaddr) and (pgaddr<>longword(-1)) then + Internalerror(2007062701); + if (offset-pgaddr>=4096) or (pgaddr=longword(-1)) then + begin + FinishBlock; + pgaddr:=(offset div 4096)*4096; + hdrpos:=internalObjData.CurrObjSec.Data.Pos; + internalObjData.writebytes(pgaddr,4); + { Reserving space for block size. The size will be written later in FinishBlock } + internalObjData.writebytes(k,4); + end; +{$ifdef cpu64bitaddr} + if objreloc.typ = RELOC_ABSOLUTE then + w:=IMAGE_REL_BASED_DIR64 + else +{$endif cpu64bitaddr} + w:=IMAGE_REL_BASED_HIGHLOW; + w:=(w shl 12) or (offset-pgaddr); + internalObjData.writebytes(w,2); + end; + end; + end; + FinishBlock; + FRelocsGenerated:=true; + end; + + + procedure TPECoffexeoutput.Order_End; + var + exesec : TExeSection; + begin + inherited; + if not IsSharedLibrary then + exit; + exesec:=FindExeSection('.reloc'); + if exesec=nil then + exit; + exesec.SecOptions:=exesec.SecOptions + [oso_Data,oso_keep,oso_load]; + end; + + + procedure TPECoffexeoutput.MemPos_ExeSection(const aname:string); + begin + if aname='.reloc' then + GenerateRelocs; + inherited; + end; + + + +{**************************************************************************** + TDJCoffAssembler +****************************************************************************} + + constructor TDJCoffAssembler.Create(smart:boolean); + begin + inherited Create(smart); + CObjOutput:=TDJCoffObjOutput; + end; + + +{**************************************************************************** + TPECoffAssembler +****************************************************************************} + + constructor TPECoffAssembler.Create(smart:boolean); + begin + inherited Create(smart); + CObjOutput:=TPECoffObjOutput; + end; + + +{***************************************************************************** + DLLReader +*****************************************************************************} + +{$ifdef win32} + var + Wow64DisableWow64FsRedirection : function (var OldValue : pointer) : boolean;stdcall; + Wow64RevertWow64FsRedirection : function (OldValue : pointer) : boolean;stdcall; +{$endif win32} + + function ReadDLLImports(const dllname:string;readdllproc:Treaddllproc):boolean; + type + TPECoffExpDir=packed record + flag, + stamp : cardinal; + Major, + Minor : word; + Name, + Base, + NumFuncs, + NumNames, + AddrFuncs, + AddrNames, + AddrOrds : cardinal; + end; + var + DLLReader : TObjectReader; + DosHeader : array[0..$7f] of byte; + PEMagic : array[0..3] of byte; + Header : TCoffHeader; + peheader : tcoffpeoptheader; + NameOfs, + newheaderofs : longword; + FuncName : string; + expdir : TPECoffExpDir; + i : longint; + found : boolean; + sechdr : tCoffSecHdr; +{$ifdef win32} + p : pointer; +{$endif win32} + begin + result:=false; +{$ifdef win32} + if (target_info.system=system_x86_64_win64) and + assigned(Wow64DisableWow64FsRedirection) then + Wow64DisableWow64FsRedirection(p); +{$endif win32} + DLLReader:=TObjectReader.Create; + DLLReader.OpenFile(dllname); +{$ifdef win32} + if (target_info.system=system_x86_64_win64) and + assigned(Wow64RevertWow64FsRedirection) then + Wow64RevertWow64FsRedirection(p); +{$endif win32} + if not DLLReader.Read(DosHeader,sizeof(DosHeader)) or + (DosHeader[0]<>$4d) or (DosHeader[1]<>$5a) then + begin + Comment(V_Error,'Invalid DLL '+dllname+', Dos Header invalid'); + exit; + end; + newheaderofs:=cardinal(DosHeader[$3c]) or (DosHeader[$3d] shl 8) or (DosHeader[$3e] shl 16) or (DosHeader[$3f] shl 24); + DLLReader.Seek(newheaderofs); + if not DLLReader.Read(PEMagic,sizeof(PEMagic)) or + (PEMagic[0]<>$50) or (PEMagic[1]<>$45) or (PEMagic[2]<>$00) or (PEMagic[3]<>$00) then + begin + Comment(V_Error,'Invalid DLL '+dllname+': invalid magic code'); + exit; + end; + if not DLLReader.Read(Header,sizeof(TCoffHeader)) or + (Header.mach<>COFF_MAGIC) or + (Header.opthdr<>sizeof(tcoffpeoptheader)) then + begin + Comment(V_Error,'Invalid DLL '+dllname+', invalid header size'); + exit; + end; + { Read optheader } + DLLreader.Read(peheader,sizeof(tcoffpeoptheader)); + { Section headers } + found:=false; + for i:=1 to header.nsects do + begin + if not DLLreader.read(sechdr,sizeof(sechdr)) then + begin + Comment(V_Error,'Error reading coff file '+DLLName); + exit; + end; + if (sechdr.rvaofs<=peheader.DataDirectory[PE_DATADIR_EDATA].vaddr) and + (peheader.DataDirectory[PE_DATADIR_EDATA].vaddr<sechdr.rvaofs+sechdr.vsize) then + begin + found:=true; + break; + end; + end; + if not found then + begin + Comment(V_Warning,'DLL '+DLLName+' does not contain any exports'); + exit; + end; + { Process edata } + DLLReader.Seek(sechdr.datapos+peheader.DataDirectory[PE_DATADIR_EDATA].vaddr-sechdr.rvaofs); + DLLReader.Read(expdir,sizeof(expdir)); + for i:=0 to expdir.NumNames-1 do + begin + DLLReader.Seek(sechdr.datapos+expdir.AddrNames-sechdr.rvaofs+i*4); + DLLReader.Read(NameOfs,4); + Dec(NameOfs,sechdr.rvaofs); + if {(NameOfs<0) or} + (NameOfs>sechdr.vsize) then + begin + Comment(V_Error,'DLL does contains invalid exports'); + break; + end; + { Read Function name from DLL, prepend _ and terminate with #0 } + DLLReader.Seek(sechdr.datapos+NameOfs); + DLLReader.Read((@FuncName[1])^,sizeof(FuncName)-3); + FuncName[sizeof(FuncName)-1]:=#0; + FuncName[0]:=chr(Strlen(@FuncName[1])); + readdllproc(DLLName,FuncName); + end; + DLLReader.Free; + end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +{$ifdef i386} + const + as_i386_coff_info : tasminfo = + ( + id : as_i386_coff; + idtxt : 'COFF'; + asmbin : ''; + asmcmd : ''; + supported_targets : [system_i386_go32v2]; + flags : [af_outputbinary]; + labelprefix : '.L'; + comment : ''; + ); + + as_i386_pecoff_info : tasminfo = + ( + id : as_i386_pecoff; + idtxt : 'PECOFF'; + asmbin : ''; + asmcmd : ''; + supported_targets : [system_i386_win32,system_i386_nativent]; + flags : [af_outputbinary,af_smartlink_sections]; + labelprefix : '.L'; + comment : ''; + ); + + as_i386_pecoffwdosx_info : tasminfo = + ( + id : as_i386_pecoffwdosx; + idtxt : 'PEWDOSX'; + asmbin : ''; + asmcmd : ''; + supported_targets : [system_i386_wdosx]; + flags : [af_outputbinary]; + labelprefix : '.L'; + comment : ''; + ); + + as_i386_pecoffwince_info : tasminfo = + ( + id : as_i386_pecoffwince; + idtxt : 'PECOFFWINCE'; + asmbin : ''; + asmcmd : ''; + supported_targets : [system_i386_wince]; + flags : [af_outputbinary,af_smartlink_sections]; + labelprefix : '.L'; + comment : ''; + ); +{$endif i386} +{$ifdef x86_64} + const + as_x86_64_pecoff_info : tasminfo = + ( + id : as_x86_64_pecoff; + idtxt : 'PECOFF'; + asmbin : ''; + asmcmd : ''; + supported_targets : [system_x86_64_win64]; + flags : [af_outputbinary,af_smartlink_sections]; + labelprefix : '.L'; + comment : ''; + ); +{$endif x86_64} +{$ifdef arm} + const + as_arm_pecoffwince_info : tasminfo = + ( + id : as_arm_pecoffwince; + idtxt : 'PECOFFWINCE'; + asmbin : ''; + asmcmd : ''; + supported_targets : [system_arm_wince]; + flags : [af_outputbinary]; + labelprefix : '.L'; + comment : ''; + ); +{$endif arm} + + +{$ifdef win32} + procedure SetupProcVars; + var + hinstLib : THandle; + begin + Wow64DisableWow64FsRedirection:=nil; + Wow64RevertWow64FsRedirection:=nil; + hinstLib:=LoadLibrary('kernel32.dll'); + if hinstLib<>0 then + begin + pointer(Wow64DisableWow64FsRedirection):=GetProcAddress(hinstLib,'Wow64DisableWow64FsRedirection'); + pointer(Wow64RevertWow64FsRedirection):=GetProcAddress(hinstLib,'Wow64RevertWow64FsRedirection'); + FreeLibrary(hinstLib); + end; + end; +{$endif win32} + + +initialization +{$ifdef i386} + RegisterAssembler(as_i386_coff_info,TDJCoffAssembler); + RegisterAssembler(as_i386_pecoff_info,TPECoffAssembler); + RegisterAssembler(as_i386_pecoffwdosx_info,TPECoffAssembler); + RegisterAssembler(as_i386_pecoffwince_info,TPECoffAssembler); +{$endif i386} +{$ifdef x86_64} + RegisterAssembler(as_x86_64_pecoff_info,TPECoffAssembler); +{$endif x86_64} +{$ifdef arm} + RegisterAssembler(as_arm_pecoffwince_info,TPECoffAssembler); +{$endif arm} +{$ifdef win32} + SetupProcVars; +{$endif win32} +end. diff --git a/closures/compiler/ogelf.pas b/closures/compiler/ogelf.pas new file mode 100644 index 0000000000..89e53898ad --- /dev/null +++ b/closures/compiler/ogelf.pas @@ -0,0 +1,1318 @@ +{ + Copyright (c) 1998-2006 by Peter Vreman + + Contains the binary elf writer + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit ogelf; + +{$i fpcdefs.inc} + +interface + + uses + { common } + cclasses,globtype, + { target } + systems, + { assembler } + cpuinfo,cpubase,aasmbase,aasmtai,aasmdata,assemble, + { output } + ogbase, + owbase; + + type + TElfObjSection = class(TObjSection) + public + secshidx : longint; { index for the section in symtab } + shstridx, + shtype, + shflags, + shlink, + shinfo, + shentsize : longint; + constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);override; + constructor create_ext(AList:TFPHashObjectList;const Aname:string;Ashtype,Ashflags,Ashlink,Ashinfo:longint;Aalign:shortint;Aentsize:longint); + destructor destroy;override; + end; + + TElfObjData = class(TObjData) + public + constructor create(const n:string);override; + destructor destroy;override; + function sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string;override; + procedure CreateDebugSections;override; + procedure writereloc(data:aint;len:aword;p:TObjSymbol;reltype:TObjRelocationType);override; + end; + + TElfObjectOutput = class(tObjOutput) + private + symtabsect, + strtabsect, + shstrtabsect: TElfObjSection; + {gotpcsect, + gotoffsect, + goTSect, + plTSect, + symsect : TElfObjSection;} + elf32data : TElfObjData; + symidx, + localsyms : longint; + procedure createrelocsection(s:TElfObjSection); + procedure createshstrtab; + procedure createsymtab; + procedure writesectionheader(s:TElfObjSection); + procedure writesectiondata(s:TElfObjSection); + procedure write_internal_symbol(astridx:longint;ainfo:byte;ashndx:word); + procedure section_write_symbol(p:TObject;arg:pointer); + procedure section_write_sh_string(p:TObject;arg:pointer); + procedure section_count_sections(p:TObject;arg:pointer); + procedure section_create_relocsec(p:TObject;arg:pointer); + procedure section_set_datapos(p:TObject;arg:pointer); + procedure section_write_data(p:TObject;arg:pointer); + procedure section_write_sechdr(p:TObject;arg:pointer); + protected + function writedata(data:TObjData):boolean;override; + public + constructor Create(AWriter:TObjectWriter);override; + destructor Destroy;override; + end; + + TElfAssembler = class(tinternalassembler) + constructor create(smart:boolean);override; + end; + + +implementation + + uses + SysUtils, + verbose, + cutils,globals,fmodule; + + const + symbolresize = 200*18; + + const + { Relocation types } +{$ifdef i386} + R_386_32 = 1; { ordinary absolute relocation } + R_386_PC32 = 2; { PC-relative relocation } + R_386_GOT32 = 3; { an offset into GOT } + R_386_PLT32 = 4; { a PC-relative offset into PLT } + R_386_GOTOFF = 9; { an offset from GOT base } + R_386_GOTPC = 10; { a PC-relative offset _to_ GOT } + R_386_GNU_VTINHERIT = 250; + R_386_GNU_VTENTRY = 251; +{$endif i386} +{$ifdef sparc} + R_SPARC_32 = 3; + R_SPARC_WDISP30 = 7; + R_SPARC_HI22 = 9; + R_SPARC_LO10 = 12; + R_SPARC_GNU_VTINHERIT = 250; + R_SPARC_GNU_VTENTRY = 251; +{$endif sparc} +{$ifdef x86_64} + R_X86_64_NONE = 0; + { Direct 64 bit } + R_X86_64_64 = 1; + { PC relative 32 bit signed } + R_X86_64_PC32 = 2; + { 32 bit GOT entry } + R_X86_64_GOT32 = 3; + { 32 bit PLT address } + R_X86_64_PLT32 = 4; + { Copy symbol at runtime } + R_X86_64_COPY = 5; + { Create GOT entry } + R_X86_64_GLOB_DAT = 6; + { Create PLT entry } + R_X86_64_JUMP_SLOT = 7; + { Adjust by program base } + R_X86_64_RELATIVE = 8; + { 32 bit signed PC relative offset to GOT } + R_X86_64_GOTPCREL = 9; + { Direct 32 bit zero extended } + R_X86_64_32 = 10; + { Direct 32 bit sign extended } + R_X86_64_32S = 11; + { Direct 16 bit zero extended } + R_X86_64_16 = 12; + { 16 bit sign extended PC relative } + R_X86_64_PC16 = 13; + { Direct 8 bit sign extended } + R_X86_64_8 = 14; + { 8 bit sign extended PC relative } + R_X86_64_PC8 = 15; + { ID of module containing symbol } + R_X86_64_DTPMOD64 = 16; + { Offset in module's TLS block } + R_X86_64_DTPOFF64 = 17; + { Offset in initial TLS block } + R_X86_64_TPOFF64 = 18; + { 32 bit signed PC relative offset to two GOT entries for GD symbol } + R_X86_64_TLSGD = 19; + { 32 bit signed PC relative offset to two GOT entries for LD symbol } + R_X86_64_TLSLD = 20; + { Offset in TLS block } + R_X86_64_DTPOFF32 = 21; + { 32 bit signed PC relative offset to GOT entry for IE symbol } + R_X86_64_GOTTPOFF = 22; + { Offset in initial TLS block } + R_X86_64_TPOFF32 = 23; + { GNU extension to record C++ vtable hierarchy } + R_X86_64_GNU_VTINHERIT = 24; + { GNU extension to record C++ vtable member usage } + R_X86_64_GNU_VTENTRY = 25; +{$endif x86_64} + + SHN_UNDEF = 0; + SHN_ABS = $fff1; + SHN_COMMON = $fff2; + + SHT_NULL = 0; + SHT_PROGBITS = 1; + SHT_SYMTAB = 2; + SHT_STRTAB = 3; + SHT_RELA = 4; + SHT_HASH = 5; + SHT_DYNAMIC = 6; + SHT_NOTE = 7; + SHT_NOBITS = 8; + SHT_REL = 9; + SHT_SHLIB = 10; + SHT_DYNSYM = 11; + + SHF_WRITE = 1; + SHF_ALLOC = 2; + SHF_EXECINSTR = 4; + + STB_LOCAL = 0; + STB_GLOBAL = 1; + STB_WEAK = 2; + + STT_NOTYPE = 0; + STT_OBJECT = 1; + STT_FUNC = 2; + STT_SECTION = 3; + STT_FILE = 4; + + type + { Structures which are written directly to the output file } + TElf32header=packed record + magic0123 : longint; + file_class : byte; + data_encoding : byte; + file_version : byte; + padding : array[$07..$0f] of byte; + e_type : word; + e_machine : word; + e_version : longint; + e_entry : longint; { entrypoint } + e_phoff : longint; { program header offset } + e_shoff : longint; { sections header offset } + e_flags : longint; + e_ehsize : word; { elf header size in bytes } + e_phentsize : word; { size of an entry in the program header array } + e_phnum : word; { 0..e_phnum-1 of entrys } + e_shentsize : word; { size of an entry in sections header array } + e_shnum : word; { 0..e_shnum-1 of entrys } + e_shstrndx : word; { index of string section header } + end; + TElf32sechdr=packed record + sh_name : longint; + sh_type : longint; + sh_flags : longint; + sh_addr : longint; + sh_offset : longint; + sh_size : longint; + sh_link : longint; + sh_info : longint; + sh_addralign : longint; + sh_entsize : longint; + end; + TElf32reloc=packed record + address : longint; + info : longint; { bit 0-7: type, 8-31: symbol } + end; + TElf32symbol=packed record + st_name : longint; + st_value : longint; + st_size : longint; + st_info : byte; { bit 0-3: type, 4-7: bind } + st_other : byte; + st_shndx : word; + end; + + + telf64header=packed record + magic0123 : longint; + file_class : byte; + data_encoding : byte; + file_version : byte; + padding : array[$07..$0f] of byte; + e_type : word; + e_machine : word; + e_version : longint; + e_entry : qword; { entrypoint } + e_phoff : qword; { program header offset } + e_shoff : qword; { sections header offset } + e_flags : longint; + e_ehsize : word; { elf header size in bytes } + e_phentsize : word; { size of an entry in the program header array } + e_phnum : word; { 0..e_phnum-1 of entrys } + e_shentsize : word; { size of an entry in sections header array } + e_shnum : word; { 0..e_shnum-1 of entrys } + e_shstrndx : word; { index of string section header } + end; + telf64sechdr=packed record + sh_name : longint; + sh_type : longint; + sh_flags : qword; + sh_addr : qword; + sh_offset : qword; + sh_size : qword; + sh_link : longint; + sh_info : longint; + sh_addralign : qword; + sh_entsize : qword; + end; + telf64reloc=packed record + address : qword; + info : qword; { bit 0-31: type, 32-63: symbol } + addend : int64; { signed! } + end; + telf64symbol=packed record + st_name : longint; + st_info : byte; { bit 0-3: type, 4-7: bind } + st_other : byte; + st_shndx : word; + st_value : qword; + st_size : qword; + end; + + +{$ifdef cpu64bitaddr} + telfheader = telf64header; + telfreloc = telf64reloc; + telfsymbol = telf64symbol; + telfsechdr = telf64sechdr; +{$else cpu64bitaddr} + telfheader = telf32header; + telfreloc = telf32reloc; + telfsymbol = telf32symbol; + telfsechdr = telf32sechdr; +{$endif cpu64bitaddr} + + + function MayBeSwapHeader(h : telf32header) : telf32header; + begin + result:=h; + if source_info.endian<>target_info.endian then + with h do + begin + result.e_type:=swapendian(e_type); + result.e_machine:=swapendian(e_machine); + result.e_version:=swapendian(e_version); + result.e_entry:=swapendian(e_entry); + result.e_phoff:=swapendian(e_phoff); + result.e_shoff:=swapendian(e_shoff); + result.e_flags:=swapendian(e_flags); + result.e_ehsize:=swapendian(e_ehsize); + result.e_phentsize:=swapendian(e_phentsize); + result.e_phnum:=swapendian(e_phnum); + result.e_shentsize:=swapendian(e_shentsize); + result.e_shnum:=swapendian(e_shnum); + result.e_shstrndx:=swapendian(e_shstrndx); + end; + end; + + + function MayBeSwapHeader(h : telf64header) : telf64header; + begin + result:=h; + if source_info.endian<>target_info.endian then + with h do + begin + result.e_type:=swapendian(e_type); + result.e_machine:=swapendian(e_machine); + result.e_version:=swapendian(e_version); + result.e_entry:=swapendian(e_entry); + result.e_phoff:=swapendian(e_phoff); + result.e_shoff:=swapendian(e_shoff); + result.e_flags:=swapendian(e_flags); + result.e_ehsize:=swapendian(e_ehsize); + result.e_phentsize:=swapendian(e_phentsize); + result.e_phnum:=swapendian(e_phnum); + result.e_shentsize:=swapendian(e_shentsize); + result.e_shnum:=swapendian(e_shnum); + result.e_shstrndx:=swapendian(e_shstrndx); + end; + end; + + + function MaybeSwapSecHeader(h : telf32sechdr) : telf32sechdr; + begin + result:=h; + if source_info.endian<>target_info.endian then + with h do + begin + result.sh_name:=swapendian(sh_name); + result.sh_type:=swapendian(sh_type); + result.sh_flags:=swapendian(sh_flags); + result.sh_addr:=swapendian(sh_addr); + result.sh_offset:=swapendian(sh_offset); + result.sh_size:=swapendian(sh_size); + result.sh_link:=swapendian(sh_link); + result.sh_info:=swapendian(sh_info); + result.sh_addralign:=swapendian(sh_addralign); + result.sh_entsize:=swapendian(sh_entsize); + end; + end; + + + function MaybeSwapSecHeader(h : telf64sechdr) : telf64sechdr; + begin + result:=h; + if source_info.endian<>target_info.endian then + with h do + begin + result.sh_name:=swapendian(sh_name); + result.sh_type:=swapendian(sh_type); + result.sh_flags:=swapendian(sh_flags); + result.sh_addr:=swapendian(sh_addr); + result.sh_offset:=swapendian(sh_offset); + result.sh_size:=swapendian(sh_size); + result.sh_link:=swapendian(sh_link); + result.sh_info:=swapendian(sh_info); + result.sh_addralign:=swapendian(sh_addralign); + result.sh_entsize:=swapendian(sh_entsize); + end; + end; + + + function MaybeSwapElfSymbol(h : telf32symbol) : telf32symbol; + begin + result:=h; + if source_info.endian<>target_info.endian then + with h do + begin + result.st_name:=swapendian(st_name); + result.st_value:=swapendian(st_value); + result.st_size:=swapendian(st_size); + result.st_shndx:=swapendian(st_shndx); + end; + end; + + + function MaybeSwapElfSymbol(h : telf64symbol) : telf64symbol; + begin + result:=h; + if source_info.endian<>target_info.endian then + with h do + begin + result.st_name:=swapendian(st_name); + result.st_value:=swapendian(st_value); + result.st_size:=swapendian(st_size); + result.st_shndx:=swapendian(st_shndx); + end; + end; + + + function MaybeSwapElfReloc(h : telf32reloc) : telf32reloc; + begin + result:=h; + if source_info.endian<>target_info.endian then + with h do + begin + result.address:=swapendian(address); + result.info:=swapendian(info); + end; + end; + + + function MaybeSwapElfReloc(h : telf64reloc) : telf64reloc; + begin + result:=h; + if source_info.endian<>target_info.endian then + with h do + begin + result.address:=swapendian(address); + result.info:=swapendian(info); + end; + end; + + +{**************************************************************************** + Helpers +****************************************************************************} + + procedure encodesechdrflags(aoptions:TObjSectionOptions;out AshType:longint;out Ashflags:longint); + begin + { Section Type } + AshType:=SHT_PROGBITS; + if oso_strings in aoptions then + AshType:=SHT_STRTAB + else if not(oso_data in aoptions) then + AshType:=SHT_NOBITS; + { Section Flags } + Ashflags:=0; + if oso_load in aoptions then + Ashflags:=Ashflags or SHF_ALLOC; + if oso_executable in aoptions then + Ashflags:=Ashflags or SHF_EXECINSTR; + if oso_write in aoptions then + Ashflags:=Ashflags or SHF_WRITE; + end; + + + procedure decodesechdrflags(AshType:longint;Ashflags:longint;out aoptions:TObjSectionOptions); + begin + aoptions:=[]; + { Section Type } + if AshType<>SHT_NOBITS then + include(aoptions,oso_data); + if AshType=SHT_STRTAB then + include(aoptions,oso_strings); + { Section Flags } + if Ashflags and SHF_ALLOC<>0 then + include(aoptions,oso_load) + else + include(aoptions,oso_noload); + if Ashflags and SHF_WRITE<>0 then + include(aoptions,oso_write) + else + include(aoptions,oso_readonly); + end; + + +{**************************************************************************** + TSection +****************************************************************************} + + constructor TElfObjSection.create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions); + begin + inherited create(AList,Aname,Aalign,aoptions); + secshidx:=0; + shstridx:=0; + encodesechdrflags(aoptions,shtype,shflags); + shlink:=0; + shinfo:=0; + if name='.stab' then + shentsize:=sizeof(TObjStabEntry); + end; + + + constructor TElfObjSection.create_ext(AList:TFPHashObjectList;const Aname:string;Ashtype,Ashflags,Ashlink,Ashinfo:longint;Aalign:shortint;Aentsize:longint); + var + aoptions : TObjSectionOptions; + begin + decodesechdrflags(Ashtype,Ashflags,aoptions); + inherited create(AList,Aname,Aalign,aoptions); + secshidx:=0; + shstridx:=0; + shtype:=AshType; + shflags:=AshFlags; + shlink:=Ashlink; + shinfo:=Ashinfo; + shentsize:=Aentsize; + end; + + + destructor TElfObjSection.destroy; + begin + inherited destroy; + end; + + +{**************************************************************************** + TElfObjData +****************************************************************************} + + constructor TElfObjData.create(const n:string); + var + need_datarel : boolean; + begin + inherited create(n); + CObjSection:=TElfObjSection; + { we need at least the following sections } + createsection(sec_code); + if (cs_create_pic in current_settings.moduleswitches) and + not(target_info.system in systems_darwin) then + begin + { We still need an empty data section } + system.exclude(current_settings.moduleswitches,cs_create_pic); + need_datarel:=true; + end + else + need_datarel:=false; + createsection(sec_data); + if need_datarel then + system.include(current_settings.moduleswitches,cs_create_pic); + createsection(sec_bss); + if need_datarel then + createsection(sec_data); + if tf_section_threadvars in target_info.flags then + createsection(sec_threadvar); + if (tf_needs_dwarf_cfi in target_info.flags) and + (af_supports_dwarf in target_asm.flags) then + createsection(sec_debug_frame); + end; + + + destructor TElfObjData.destroy; + begin + inherited destroy; + end; + + + function TElfObjData.sectionname(atype:TAsmSectiontype;const aname:string;aorder:TAsmSectionOrder):string; + const + secnames : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','', +{$ifdef userodata} + '.text','.data','.data','.rodata','.bss','.threadvar', +{$else userodata} + '.text','.data','.data','.data','.bss','.threadvar', +{$endif userodata} + '.pdata', + '.text', { darwin stubs } + '__DATA,__nl_symbol_ptr', + '__DATA,__la_symbol_ptr', + '__DATA,__mod_init_func', + '__DATA,__mod_term_func', + '.stab','.stabstr', + '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata', + '.eh_frame', + '.debug_frame','.debug_info','.debug_line','.debug_abbrev', + '.fpc', + '.toc', + '.init', + '.fini', + '.objc_class', + '.objc_meta_class', + '.objc_cat_cls_meth', + '.objc_cat_inst_meth', + '.objc_protocol', + '.objc_string_object', + '.objc_cls_meth', + '.objc_inst_meth', + '.objc_cls_refs', + '.objc_message_refs', + '.objc_symbols', + '.objc_category', + '.objc_class_vars', + '.objc_instance_vars', + '.objc_module_info', + '.objc_class_names', + '.objc_meth_var_types', + '.objc_meth_var_names', + '.objc_selector_strs', + '.objc_protocol_ext', + '.objc_class_ext', + '.objc_property', + '.objc_image_info', + '.objc_cstring_object', + '.objc_sel_fixup', + '__DATA,__objc_data', + '__DATA,__objc_const', + '.objc_superrefs', + '__DATA, __datacoal_nt,coalesced', + '.objc_classlist', + '.objc_nlclasslist', + '.objc_catlist', + '.obcj_nlcatlist', + '.objc_protolist' + ); + secnames_pic : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','', + '.text', + '.data.rel', + '.data.rel', + '.data.rel', + '.bss', + '.threadvar', + '.pdata', + '', { stubs } + '__DATA,__nl_symbol_ptr', + '__DATA,__la_symbol_ptr', + '__DATA,__mod_init_func', + '__DATA,__mod_term_func', + '.stab', + '.stabstr', + '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata', + '.eh_frame', + '.debug_frame','.debug_info','.debug_line','.debug_abbrev', + '.fpc', + '.toc', + '.init', + '.fini', + '.objc_class', + '.objc_meta_class', + '.objc_cat_cls_meth', + '.objc_cat_inst_meth', + '.objc_protocol', + '.objc_string_object', + '.objc_cls_meth', + '.objc_inst_meth', + '.objc_cls_refs', + '.objc_message_refs', + '.objc_symbols', + '.objc_category', + '.objc_class_vars', + '.objc_instance_vars', + '.objc_module_info', + '.objc_class_names', + '.objc_meth_var_types', + '.objc_meth_var_names', + '.objc_selector_strs', + '.objc_protocol_ext', + '.objc_class_ext', + '.objc_property', + '.objc_image_info', + '.objc_cstring_object', + '.objc_sel_fixup', + '__DATA,__objc_data', + '__DATA,__objc_const', + '.objc_superrefs', + '__DATA, __datacoal_nt,coalesced', + '.objc_classlist', + '.objc_nlclasslist', + '.objc_catlist', + '.obcj_nlcatlist', + '.objc_protolist' + ); + var + sep : string[3]; + secname : string; + begin + { section type user gives the user full controll on the section name } + if atype=sec_user then + result:=aname + else + begin + if (cs_create_pic in current_settings.moduleswitches) and + not(target_info.system in systems_darwin) then + secname:=secnames_pic[atype] + else + secname:=secnames[atype]; + if (atype=sec_fpc) and (Copy(aname,1,3)='res') then + begin + result:=secname+'.'+aname; + exit; + end; + if create_smartlink_sections and (aname<>'') then + begin + case aorder of + secorder_begin : + sep:='.b_'; + secorder_end : + sep:='.z_'; + else + sep:='.n_'; + end; + result:=secname+sep+aname + end + else + result:=secname; + end; + end; + + + procedure TElfObjData.CreateDebugSections; + begin + if target_dbg.id=dbg_stabs then + begin + stabssec:=createsection(sec_stab); + stabstrsec:=createsection(sec_stabstr); + end; + end; + + + procedure TElfObjData.writereloc(data:aint;len:aword;p:TObjSymbol;reltype:TObjRelocationType); + var + symaddr : aint; + begin + if CurrObjSec=nil then + internalerror(200403292); +{$ifdef userodata} + if CurrObjSec.sectype in [sec_rodata,sec_bss,sec_threadvar] then + internalerror(200408252); +{$endif userodata} + { Using RELOC_RVA to map 32-bit RELOC_ABSOLUTE to R_X86_64_32 + (RELOC_ABSOLUTE maps to R_X86_64_32S) } + if (reltype=RELOC_ABSOLUTE) and (len<>sizeof(pint)) then + reltype:=RELOC_RVA; + if assigned(p) then + begin + { real address of the symbol } + symaddr:=p.address; + { Local ObjSymbols can be resolved already or need a section reloc } + if (p.bind=AB_LOCAL) and + (reltype in [RELOC_RELATIVE,RELOC_ABSOLUTE{$ifdef x86_64},RELOC_ABSOLUTE32,RELOC_RVA{$endif x86_64}]) then + begin + { For a reltype relocation in the same section the + value can be calculated } + if (p.objsection=CurrObjSec) and + (reltype=RELOC_RELATIVE) then + inc(data,symaddr-len-CurrObjSec.Size) + else + begin + CurrObjSec.addsectionreloc(CurrObjSec.Size,p.objsection,reltype); + inc(data,symaddr); + end; + end + else + begin + CurrObjSec.addsymreloc(CurrObjSec.Size,p,reltype); +{$ifndef x86_64} + if (reltype=RELOC_RELATIVE) or (reltype=RELOC_PLT32) then + dec(data,len); +{$endif x86_64} + end; + end; + CurrObjSec.write(data,len); + end; + + +{**************************************************************************** + TElfObjectOutput +****************************************************************************} + + constructor TElfObjectOutput.create(AWriter:TObjectWriter); + begin + inherited Create(AWriter); + CObjData:=TElfObjData; + end; + + + destructor TElfObjectOutput.destroy; + begin + inherited destroy; + end; + + + procedure TElfObjectOutput.createrelocsection(s:TElfObjSection); + var + i : longint; + rel : telfreloc; + objreloc : TObjRelocation; + relsym, + reltyp : longint; + relocsect : TObjSection; +{$ifdef x86_64} + tmp: aint; + asize: longint; +{$endif x86_64} + begin + with elf32data do + begin +{$ifdef userodata} + { rodata can't have relocations } + if s.sectype=sec_rodata then + begin + if assigned(s.relocations.first) then + internalerror(200408251); + exit; + end; +{$endif userodata} + { create the reloc section } +{$ifdef i386} + relocsect:=TElfObjSection.create_ext(ObjSectionList,'.rel'+s.name,SHT_REL,0,symtabsect.secshidx,s.secshidx,4,sizeof(TElfReloc)); +{$else i386} + relocsect:=TElfObjSection.create_ext(ObjSectionList,'.rela'+s.name,SHT_RELA,0,symtabsect.secshidx,s.secshidx,4,sizeof(TElfReloc)); +{$endif i386} + { add the relocations } + for i:=0 to s.Objrelocations.count-1 do + begin + objreloc:=TObjRelocation(s.Objrelocations[i]); + fillchar(rel,sizeof(rel),0); + rel.address:=objreloc.dataoffset; + + { when things settle down, we can create processor specific + derived classes } + case objreloc.typ of +{$ifdef i386} + RELOC_RELATIVE : + reltyp:=R_386_PC32; + RELOC_ABSOLUTE : + reltyp:=R_386_32; + RELOC_GOT32 : + reltyp:=R_386_GOT32; + RELOC_GOTPC : + reltyp:=R_386_GOTPC; + RELOC_PLT32 : + begin + reltyp:=R_386_PLT32; + end; +{$endif i386} +{$ifdef sparc} + RELOC_ABSOLUTE : + reltyp:=R_SPARC_32; +{$endif sparc} +{$ifdef x86_64} + RELOC_RELATIVE : + begin + reltyp:=R_X86_64_PC32; + { length of the relocated location is handled here } + rel.addend:=-4; + end; + RELOC_ABSOLUTE : + reltyp:=R_X86_64_64; + RELOC_ABSOLUTE32 : + reltyp:=R_X86_64_32S; + RELOC_RVA : + reltyp:=R_X86_64_32; + RELOC_GOTPCREL : + begin + reltyp:=R_X86_64_GOTPCREL; + { length of the relocated location is handled here } + rel.addend:=-4; + end; + RELOC_PLT32 : + begin + reltyp:=R_X86_64_PLT32; + { length of the relocated location is handled here } + rel.addend:=-4; + end; +{$endif x86_64} + else + internalerror(200602261); + end; + +{ This handles ELF 'rela'-styled relocations, which are currently used only for x86_64, + but can be used other targets, too. } +{$ifdef x86_64} + s.Data.Seek(objreloc.dataoffset); + if objreloc.typ=RELOC_ABSOLUTE then + begin + asize:=8; + s.Data.Read(tmp,8); + rel.addend:=rel.addend+tmp; + end + else + begin + asize:=4; + s.Data.Read(tmp,4); + rel.addend:=rel.addend+longint(tmp); + end; + + { and zero the data member out } + tmp:=0; + s.Data.Seek(objreloc.dataoffset); + s.Data.Write(tmp,asize); +{$endif} + + { Symbol } + if assigned(objreloc.symbol) then + begin + if objreloc.symbol.symidx=-1 then + begin + writeln(objreloc.symbol.Name); + internalerror(200603012); + end; + relsym:=objreloc.symbol.symidx; + end + else + begin + if objreloc.objsection<>nil then + relsym:=objreloc.objsection.secsymidx + else + relsym:=SHN_UNDEF; + end; +{$ifdef cpu64bitaddr} + rel.info:=(qword(relsym) shl 32) or reltyp; +{$else cpu64bitaddr} + rel.info:=(relsym shl 8) or reltyp; +{$endif cpu64bitaddr} + { write reloc } + relocsect.write(MaybeSwapElfReloc(rel),sizeof(rel)); + end; + end; + end; + + + procedure TElfObjectOutput.write_internal_symbol(astridx:longint;ainfo:byte;ashndx:word); + var + elfsym : telfsymbol; + begin + fillchar(elfsym,sizeof(elfsym),0); + elfsym.st_name:=astridx; + elfsym.st_info:=ainfo; + elfsym.st_shndx:=ashndx; + inc(symidx); + inc(localsyms); + symtabsect.write(MaybeSwapElfSymbol(elfsym),sizeof(elfsym)); + end; + + + procedure TElfObjectOutput.section_write_symbol(p:TObject;arg:pointer); + begin + TObjSection(p).secsymidx:=symidx; + write_internal_symbol(TElfObjSection(p).shstridx,STT_SECTION,TElfObjSection(p).secshidx); + end; + + + procedure TElfObjectOutput.createsymtab; + + procedure WriteSym(objsym:TObjSymbol); + var + elfsym : telfsymbol; + begin + with elf32data do + begin + fillchar(elfsym,sizeof(elfsym),0); + { symbolname, write the #0 separate to overcome 255+1 char not possible } + elfsym.st_name:=strtabsect.Size; + strtabsect.writestr(objsym.name); + strtabsect.writestr(#0); + elfsym.st_size:=objsym.size; + case objsym.bind of + AB_LOCAL : + begin + elfsym.st_value:=objsym.address; + elfsym.st_info:=STB_LOCAL shl 4; + inc(localsyms); + end; + AB_COMMON : + begin + elfsym.st_value:=$10; + elfsym.st_info:=STB_GLOBAL shl 4; + end; + AB_EXTERNAL : + elfsym.st_info:=STB_GLOBAL shl 4; + AB_WEAK_EXTERNAL : + elfsym.st_info:=STB_WEAK shl 4; + AB_GLOBAL : + begin + elfsym.st_value:=objsym.address; + elfsym.st_info:=STB_GLOBAL shl 4; + end; + end; + if (objsym.bind<>AB_EXTERNAL) {and + not(assigned(objsym.objsection) and + not(oso_data in objsym.objsection.secoptions))} then + begin + case objsym.typ of + AT_FUNCTION : + elfsym.st_info:=elfsym.st_info or STT_FUNC; + AT_DATA : + elfsym.st_info:=elfsym.st_info or STT_OBJECT; + end; + end; + if objsym.bind=AB_COMMON then + elfsym.st_shndx:=SHN_COMMON + else + begin + if assigned(objsym.objsection) then + elfsym.st_shndx:=TElfObjSection(objsym.objsection).secshidx + else + elfsym.st_shndx:=SHN_UNDEF; + end; + objsym.symidx:=symidx; + inc(symidx); + symtabsect.write(MaybeSwapElfSymbol(elfsym),sizeof(elfsym)); + end; + end; + + var + i : longint; + objsym : TObjSymbol; + begin + with elf32data do + begin + symidx:=0; + localsyms:=0; + { empty entry } + write_internal_symbol(0,0,0); + { filename entry } + write_internal_symbol(1,STT_FILE,SHN_ABS); + { section } + ObjSectionList.ForEachCall(@section_write_symbol,nil); + { First the Local Symbols, this is required by ELF. The localsyms + count stored in shinfo is used to skip the local symbols + when traversing the symtab } + for i:=0 to ObjSymbolList.Count-1 do + begin + objsym:=TObjSymbol(ObjSymbolList[i]); + if (objsym.bind=AB_LOCAL) and (objsym.typ<>AT_LABEL) then + WriteSym(objsym); + end; + { Global Symbols } + for i:=0 to ObjSymbolList.Count-1 do + begin + objsym:=TObjSymbol(ObjSymbolList[i]); + if (objsym.bind<>AB_LOCAL) then + WriteSym(objsym); + end; + { update the .symtab section header } + symtabsect.shlink:=strtabsect.secshidx; + symtabsect.shinfo:=localsyms; + end; + end; + + + procedure TElfObjectOutput.section_write_sh_string(p:TObject;arg:pointer); + begin + TElfObjSection(p).shstridx:=shstrtabsect.writestr(TObjSection(p).name+#0); + end; + + + procedure TElfObjectOutput.createshstrtab; + begin + with elf32data do + begin + shstrtabsect.writestr(#0); + ObjSectionList.ForEachCall(@section_write_sh_string,nil); + end; + end; + + + procedure TElfObjectOutput.writesectionheader(s:TElfObjSection); + var + sechdr : telfsechdr; + begin + fillchar(sechdr,sizeof(sechdr),0); + sechdr.sh_name:=s.shstridx; + sechdr.sh_type:=s.shtype; + sechdr.sh_flags:=s.shflags; + sechdr.sh_offset:=s.datapos; + sechdr.sh_size:=s.Size; + sechdr.sh_link:=s.shlink; + sechdr.sh_info:=s.shinfo; + sechdr.sh_addralign:=s.secalign; + sechdr.sh_entsize:=s.shentsize; + writer.write(MaybeSwapSecHeader(sechdr),sizeof(sechdr)); + end; + + + procedure TElfObjectOutput.writesectiondata(s:TElfObjSection); + begin + FWriter.writezeros(s.dataalignbytes); + if s.Datapos<>FWriter.ObjSize then + internalerror(200604031); + FWriter.writearray(s.data); + end; + + + procedure TElfObjectOutput.section_count_sections(p:TObject;arg:pointer); + begin + TElfObjSection(p).secshidx:=pword(arg)^; + inc(pword(arg)^); + end; + + + procedure TElfObjectOutput.section_create_relocsec(p:TObject;arg:pointer); + begin + if (TElfObjSection(p).ObjRelocations.count>0) then + createrelocsection(TElfObjSection(p)); + end; + + + procedure TElfObjectOutput.section_set_datapos(p:TObject;arg:pointer); + begin + TObjSection(p).setdatapos(paword(arg)^); + end; + + + procedure TElfObjectOutput.section_write_data(p:TObject;arg:pointer); + begin + if (oso_data in TObjSection(p).secoptions) then + begin + if TObjSection(p).data=nil then + internalerror(200403073); + writesectiondata(TElfObjSection(p)); + end; + end; + + + procedure TElfObjectOutput.section_write_sechdr(p:TObject;arg:pointer); + begin + writesectionheader(TElfObjSection(p)); + end; + + + function TElfObjectOutput.writedata(data:TObjData):boolean; + var + header : telfheader; + shoffset, + datapos : aint; + nsections : word; + begin + result:=false; + elf32data:=TElfObjData(data); + with elf32data do + begin + { default sections } + symtabsect:=TElfObjSection.create_ext(ObjSectionList,'.symtab',SHT_SYMTAB,0,0,0,4,sizeof(telfsymbol)); + strtabsect:=TElfObjSection.create_ext(ObjSectionList,'.strtab',SHT_STRTAB,0,0,0,1,0); + shstrtabsect:=TElfObjSection.create_ext(ObjSectionList,'.shstrtab',SHT_STRTAB,0,0,0,1,0); + { "no executable stack" marker for Linux } + if (target_info.system in systems_linux) and + not(cs_executable_stack in current_settings.moduleswitches) then + TElfObjSection.create_ext(ObjSectionList,'.note.GNU-stack',SHT_PROGBITS,0,0,0,1,0); + { insert the empty and filename as first in strtab } + strtabsect.writestr(#0); + strtabsect.writestr(ExtractFileName(current_module.mainsource^)+#0); + { calc amount of sections we have } + nsections:=1; + { also create the index in the section header table } + ObjSectionList.ForEachCall(@section_count_sections,@nsections); + { create .symtab and .strtab } + createsymtab; + { Create the relocation sections, this needs valid secidx and symidx } + ObjSectionList.ForEachCall(@section_create_relocsec,nil); + { recalc nsections to incude the reloc sections } + nsections:=1; + ObjSectionList.ForEachCall(@section_count_sections,@nsections); + { create .shstrtab } + createshstrtab; + + { Calculate the filepositions } + datapos:=$40; { elfheader + alignment } + { section data } + ObjSectionList.ForEachCall(@section_set_datapos,@datapos); + { section headers } + shoffset:=datapos; + inc(datapos,(nsections+1)*sizeof(telfsechdr)); + + { Write ELF Header } + fillchar(header,sizeof(header),0); + header.magic0123:=$464c457f; { = #127'ELF' } +{$ifdef cpu64bitaddr} + header.file_class:=2; +{$else cpu64bitaddr} + header.file_class:=1; +{$endif cpu64bitaddr} + if target_info.endian=endian_big then + header.data_encoding:=2 + else + header.data_encoding:=1; + + header.file_version:=1; + header.e_type:=1; +{$ifdef sparc} + header.e_machine:=2; +{$endif sparc} +{$ifdef i386} + header.e_machine:=3; +{$endif i386} +{$ifdef m68k} + header.e_machine:=4; +{$endif m68k} +{$ifdef powerpc} + header.e_machine:=20; +{$endif powerpc} +{$ifdef arm} + header.e_machine:=40; + if (current_settings.fputype=cpu_soft) then + header.e_flags:=$600; +{$endif arm} +{$ifdef x86_64} + header.e_machine:=62; +{$endif x86_64} + header.e_version:=1; + header.e_shoff:=shoffset; + header.e_shstrndx:=shstrtabsect.secshidx; + + header.e_shnum:=nsections; + header.e_ehsize:=sizeof(telfheader); + header.e_shentsize:=sizeof(telfsechdr); + writer.write(MaybeSwapHeader(header),sizeof(header)); + writer.writezeros($40-sizeof(header)); { align } + { Sections } + ObjSectionList.ForEachCall(@section_write_data,nil); + { section headers, start with an empty header for sh_undef } + writer.writezeros(sizeof(telfsechdr)); + ObjSectionList.ForEachCall(@section_write_sechdr,nil); + end; + result:=true; + end; + + +{**************************************************************************** + TELFAssembler +****************************************************************************} + + constructor TElfAssembler.Create(smart:boolean); + begin + inherited Create(smart); + CObjOutput:=TElfObjectOutput; + end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +{$ifdef i386} + const + as_i386_elf32_info : tasminfo = + ( + id : as_i386_elf32; + idtxt : 'ELF'; + asmbin : ''; + asmcmd : ''; + supported_targets : [system_i386_linux,system_i386_beos,system_i386_freebsd,system_i386_haiku,system_i386_Netware,system_i386_netwlibc, + system_i386_solaris,system_i386_embedded]; + flags : [af_outputbinary,af_smartlink_sections,af_supports_dwarf]; + labelprefix : '.L'; + comment : ''; + ); +{$endif i386} +{$ifdef x86_64} + const + as_x86_64_elf64_info : tasminfo = + ( + id : as_x86_64_elf64; + idtxt : 'ELF'; + asmbin : ''; + asmcmd : ''; + supported_targets : [system_x86_64_linux,system_x86_64_freebsd]; + flags : [af_outputbinary,af_smartlink_sections,af_supports_dwarf]; + labelprefix : '.L'; + comment : ''; + ); +{$endif x86_64} +{$ifdef sparc} + const + as_sparc_elf32_info : tasminfo = + ( + id : as_sparc_elf32; + idtxt : 'ELF'; + asmbin : ''; + asmcmd : ''; + supported_targets : []; +// flags : [af_outputbinary,af_smartlink_sections]; + flags : [af_outputbinary,af_supports_dwarf]; + labelprefix : '.L'; + comment : ''; + ); +{$endif sparc} + + +initialization +{$ifdef i386} + RegisterAssembler(as_i386_elf32_info,TElfAssembler); +{$endif i386} +{$ifdef sparc} + RegisterAssembler(as_sparc_elf32_info,TElfAssembler); +{$endif sparc} +{$ifdef x86_64} + RegisterAssembler(as_x86_64_elf64_info,TElfAssembler); +{$endif x86_64} +end. diff --git a/closures/compiler/oglx.pas b/closures/compiler/oglx.pas new file mode 100644 index 0000000000..75b9632096 --- /dev/null +++ b/closures/compiler/oglx.pas @@ -0,0 +1,394 @@ +{ + Copyright (c) 2002 by Daniel Mantione, Peter Vreman + + Contains the binary reader and writer for the linear executable + format used by OS/2 + + * This code was inspired by the NASM sources + The Netwide Assembler is copyright (C) 1996 Simon Tatham and + Julian Hall. All rights reserved. + + 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 oglx; + +{$i fpcdefs.inc} + +interface + +uses + { common } + cclasses, + { target } + systems, + { assembler } + cpubase,aasmbase,assemble,link, + { output } + ogbase,ogmap,ogcoff; + +{ An LX executable is called a module; it can be either an executable + or a DLL. + + A module consists of objects. In other executable formats, these + are usually called sections. + + Objects consist of pages. + + The objects are numbered, numbers do not have any special meaning. The + pages of the object are loaded into memory with the access rights specified + the object table entry. (DM)} + + +{ For the operating system the object numbers have no special meaning. + However, for Free Pascal generated executables, I define: (DM)} + +const code_object = 0; + data_object = 1; + bss_object = 2; + stack_object = 3; + heap_object = 4; + +type Tlxheader = packed record + magic:word; {'LX'} + byteorder:byte; {0 = little 1 = big endian.} + wordorder:byte; {0 = little 1 = big endian.} + format_level:cardinal; {Nothing else than LX level + 0 has ever been defined.} + cpu_type:word; {1 = 286, 2 = 386, 3 = 486, + 4 = pentium.} + os_type:word; {1 = OS/2, 2 = Windows, + 3 = Siemens MS-Dos 4.0, + 4 = Windows 386.} + module_version:cardinal; {Version of executable, + defined by user.} + module_flags:cardinal; {Flags.} + module_page_count:cardinal; {Amount of pages in module.} + eip_object,eip:cardinal; {Initial EIP, object nr and + offset within object.} + esp_object,esp:cardinal; {Initial ESP, object nr and + offset within object.} + page_size,page_shift:cardinal; {Page size, in bytes and + 1 << pageshift.} + fixup_sect_size:cardinal; + fixup_sect_checksum:cardinal; + loader_sect_size:cardinal; + loader_sect_chksum:cardinal; + object_table_offset:cardinal; {Location of object table.} + object_count:cardinal; {Amount of objects in module.} + object_pagetable_ofs:cardinal; {Location of object page + table.} + object_iterpages_ofs:cardinal; + resource_table_ofs:cardinal; {Location of resource table.} + resource_count:cardinal; {Amount of resources in + resource table.} + resid_name_tbl_ofs:cardinal; + entry_table_offset:cardinal; + module_dir_offset:cardinal; + module_dir_count:cardinal; + fixup_pagetab_ofs:cardinal; + fixup_recrab_ofs:cardinal; + import_modtab_ofs:cardinal; + import_modtab_count:cardinal; + data_pages_offset:cardinal; + preload_page_count:cardinal; + nonresid_table_ofs:cardinal; + nonresid_table_len:cardinal; + nonresid_tbl_chksum:cardinal; + auto_ds_object_no:cardinal; {Not used by OS/2.} + debug_info_offset:cardinal; + inst_preload_count:cardinal; + inst_demand_count:cardinal; + heapsize:cardinal; {Only used for 16-bit programs.} + end; + + Tlxobject_flags = (ofreadable,ofwriteable,ofexecutable,ofresource, + ofdiscardable,ofshared,ofpreload,ofinvalid, + ofzerofilled); + Tlxobject_flag_set = set of Tlxobject_flags; + + Tlxobject_table_entry = packed record + virtual_size:cardinal; + reloc_base_addr:cardinal; + object_flags:Tlxobject_flag_set; + page_table_index:cardinal; + page_count:cardinal; + reserved:cardinal; + end; + + Tlxexeoutput = class(texeoutput) + private +{ FCoffsyms, + FCoffStrs : tdynamicarray; + win32 : boolean;} + nsects, + nsyms, + sympos : longint; + procedure write_symbol(const name:string;strpos,value,section,typ,aux:longint); + procedure write_symbols; + protected + function writedata:boolean;override; + public + constructor createos2; + function newobjectinput:tobjectinput;override; + procedure CalculateMemoryMap;override; + procedure GenerateExecutable(const fn:string);override; + end; + + Tlxlinker = class(tinternallinker) + constructor create;override; + end; + + +implementation + +uses + strings, + cutils,verbose, + globtype,globals,fmodule; + + +{**************************************************************************** + tcoffexeoutput +****************************************************************************} + + constructor Tlxexeoutput.createos2; + begin + inherited create; + end; + + + function Tlxexeoutput.newobjectinput:tobjectinput; + begin + result:=tcoffobjectinput.createdjgpp; + end; + + + procedure Tlxexeoutput.write_symbol(const name:string;strpos,value,section,typ,aux:longint); +{ var + sym : coffsymbol;} + begin +{ FillChar(sym,sizeof(sym),0); + if strpos=-1 then + move(name[1],sym.name,length(name)) + else + sym.strpos:=strpos; + sym.value:=value; + sym.section:=section; + sym.typ:=typ; + sym.aux:=aux; + FWriter.write(sym,sizeof(sym));} + end; + + + procedure Tlxexeoutput.write_symbols; +{ var + filename : string[18]; + sec : TSection; + namestr : string[8]; + nameidx, + value, + sectionval, + i : longint; + globalval : byte; + secrec : coffsectionrec; + objdata : TObjData; + p : tasmsymbol; + s : string;} + begin +(* objdata:=TObjData(objdatalist.first); + while assigned(objdata) do + begin + with tcoffObjData(objdata) do + begin + { The symbols used } + p:=Tasmsymbol(symbols.First); + while assigned(p) do + begin + if p.section=sec_common then + sectionval:=sections[sec_bss].secsymidx + else + sectionval:=sections[p.section].secsymidx; + if p.currbind=AB_LOCAL then + globalval:=3 + else + globalval:=2; + { if local of global then set the section value to the address + of the symbol } + if p.currbind in [AB_LOCAL,AB_GLOBAL] then + value:=p.address + else + value:=p.size; + { symbolname } + s:=p.name; + if length(s)>8 then + begin + nameidx:=FCoffStrs.size+4; + FCoffStrs.writestr(s); + FCoffStrs.writestr(#0); + end + else + begin + nameidx:=-1; + namestr:=s; + end; + write_symbol(namestr,nameidx,value,sectionval,globalval,0); + p:=tasmsymbol(p.indexnext); + end; + end; + objdata:=TObjData(objdata.next); + end;*) + end; + + + procedure Tlxexeoutput.CalculateMemoryMap; +{ var + objdata : TObjData; + secsymidx, + mempos, + datapos : longint; + sec : TSection; + sym : tasmsymbol; + s : TObjSection;} + begin +(* { retrieve amount of sections } + nsects:=0; + secsymidx:=0; + for sec:=low(TSection) to high(TSection) do + begin + if sections[sec].available then + begin + inc(nsects); + inc(secsymidx); + sections[sec].secsymidx:=secsymidx; + end; + end; + { calculate start positions after the headers } + datapos:=sizeof(coffheader)+sizeof(coffoptheader)+sizeof(coffsechdr)*nsects; + mempos:=sizeof(coffheader)+sizeof(coffoptheader)+sizeof(coffsechdr)*nsects; + if not win32 then + inc(mempos,sizeof(go32v2stub)+$1000); + { add sections } + MapObjData(datapos,mempos); + { end symbol } + AddGlobalSym('_etext',sections[sec_code].mempos+sections[sec_code].memsize); + AddGlobalSym('_edata',sections[sec_data].mempos+sections[sec_data].memsize); + AddGlobalSym('end',mempos); + { symbols } + nsyms:=0; + sympos:=0; + if not(cs_link_strip in current_settings.globalswitches) then + begin + sympos:=datapos; + objdata:=TObjData(objdatalist.first); + while assigned(objdata) do + begin + inc(nsyms,objdata.symbols.count); + objdata:=TObjData(objdata.next); + end; + end;*) + end; + +function gen_section_header(sec:Tsection;obj:cardinal):Tlxobject_table_entry; + virtual_size:cardinal; + reloc_base_addr:cardinal; + object_flags:Tlxobject_flag_set; + page_table_index:cardinal; + page_count:cardinal; + reserved:cardinal; + +begin + gen_section_header.virtual_size:=sections[sec.memsize]; + +end; + +function Tlxexeoutput.writedata:boolean; + +var header:Tlxheader; + hsym:Tasmsymbol; + code_object_header,data_object_header,bss_object_header,stack_object_header, + heap_object_header:Tlxobject_table_entry; + + +begin + result:=false; + fillchar(header,sizeof(header),0); + header.magic:=$584c; {'LX'} + header.cpu_type:=2; {Intel 386} + header.os_type:=1; {OS/2} + {Set the initial EIP.} + header.eip_object:=code_object; + hsym:=tasmsymbol(globalsyms.Find('start')); + if not assigned(hsym) then + begin + comment(V_Error,'Entrypoint "start" not defined'); + exit; + end; + header.eip:=hsym.address-sections[sec_code].mempos; + {Set the initial ESP.} + header.esp_object:=stack_object; + header.esp:=stacksize; + Fwriter.write(header,sizeof(header)); + for sec:=low(Tsection) to high(Tsection) do + if sections[sec].available then + if not(sec in [sec_code,sec_data,sec_bss,sec_stab,sec_stabstr]) then + begin + result:=false; + exit; + end; + code_object_header:=gen_section_header(sec_code,code_object); + data_object_header:=gen_section_header(sec_data,data_object); + bss_object_header:=gen_section_header(sec_bss,bss_object); + result:=true; +end; + + + procedure Tlxexeoutput.GenerateExecutable(const fn:string); + begin +{ AddGlobalSym('_etext',0); + AddGlobalSym('_edata',0); + AddGlobalSym('end',0); + if not CalculateSymbols then + exit; + CalculateMemoryMap; + FixupSymbols; + FixupRelocations; + writeexefile(fn);} + end; + +{**************************************************************************** + TCoffLinker +****************************************************************************} + + constructor Tlxlinker.Create; + begin + inherited Create; + exeoutput:=Tlxexeoutput.createos2; + end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + + +begin +{ RegisterAssembler(as_i386_coff_info,TCoffAssembler); + RegisterAssembler(as_i386_pecoff_info,TPECoffAssembler); + RegisterAssembler(as_i386_pecoffwdosx_info,TPECoffAssembler); + + RegisterLinker(ld_i386_coff,Tlxlinker);} +end. diff --git a/closures/compiler/ogmacho.pas b/closures/compiler/ogmacho.pas new file mode 100644 index 0000000000..963a70c37c --- /dev/null +++ b/closures/compiler/ogmacho.pas @@ -0,0 +1,1223 @@ +{ + Copyright (c) 2009-2010 by Dmitry Boyarintsev + + Contains the binary mach-o writer + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit ogmacho; + +{$i fpcdefs.inc} + +interface + +uses + cclasses, + globals, globtype, verbose, + owbase, ogbase, + aasmbase, assemble, + macho, machoutils, + systems, + { assembler } + cpuinfo,cpubase,aasmtai,aasmdata; {for system constants} + +type + + { TMachoRawWriter } + + TMachoRawWriter=class(TRawWriter) + private + fwriter : tobjectwriter; + public + constructor Create(awriter: tobjectwriter); + procedure WriteRaw(const data; datasize: Integer); override; + end; + + { TmachoObjSection } + + TMachoSectionType=(mst_Normal, mst_ObjC, mst_Stabs, mst_Dwarf); + + TmachoObjSection=class(tObjSection) + public + nmsegment : string; {mach-o segment name} + nmsection : string; {mach-o section name} + + inSegIdx : Integer; {section index inside segment. one-based number} + RelocOfs : aword; {file offset to the first relocation symbol} + IndIndex : Integer; {index in indirect table (see DysymTableCommand) for lazy and non-lazy symbol pointers} + + machoSec : TMachoSectionType; + function GetRelocCount: Integer; + function FileSize: Integer; + constructor create(AList:TFPHashObjectList; const Aname:string; Aalign:shortint; Aoptions:TObjSectionOptions);override; + end; + + { TmachoObjData } + + TmachoObjData=class(TObjData) + public + debugcount: Integer; + constructor create(const n:string); override; + procedure CreateDebugSections; override; + function sectionname(atype:TAsmSectiontype; const aname:string; aorder:TAsmSectionOrder):string;override; + function sectiontype2align(atype:TAsmSectiontype):shortint;override; + function sectiontype2options(atype:TAsmSectiontype):TObjSectionOptions;override; + procedure writereloc(data:aint; len:aword; p:TObjSymbol; reltype:TObjRelocationType);override; + public + end; + + { TMachoObjectOutput } + + TMachoSymbolLocation=(loc_Notused, loc_Local, loc_External, loc_Undef); + + TMachoObjectOutput=class(TObjOutput) + private + machoData : TMachoObjData; + mfile : TMachOWriter; + cputarget : cpu_type_t; + + stabsec : TmachoObjSection; + strsec : TmachoObjSection; + + sectionscnt : integer; + memofs : aword; + fileofs : aword; + + symstrofs : aword; + symlen : aword; + symCount : aint; + + iLocal : Integer; + iExtern : Integer; + iUndef : Integer; + iIndir : Integer; + + symList : TFPObjectList; + IndirIndex : tdynamicarray; + + relcount : integer; + protected + procedure TrailZeros; + + {sections} + procedure FixSectionRelocs(s: TMachoObjSection); + procedure section_count_sections(p:TObject;arg:pointer); + procedure section_set_datamempos(p:TObject;arg:pointer); + procedure section_set_relocpos(p:TObject;arg:pointer); + + procedure section_write_data(p:TObject;arg:pointer); + procedure section_write_relocdata(p:TObject;arg:pointer); + procedure section_prepare_indirect(s: TObjSection); + + {symbols} + procedure symbol_write_nlist(sym:TObjSymbol; symstr: tdynamicarray); + function dysymbol_location(sym: TObjSymbol): TMachoSymbolLocation; + + function symWriteName(s: TObjSymbol): string; + procedure InitSymbolIndexes(var sCount: aint; var symStrLen: aword); + + {mach-o file related} + procedure writeSectionsHeader(s: TMachoObjSection); + procedure writeSymTabCommand; + procedure writeSymbols(symstr: tdynamicarray); + procedure writeDySymTabCommand(IndOffset: aword; IndCount: Integer); + procedure writeDysymbols; + + function writedata(data:TObjData):boolean;override; + public + constructor Create(AWriter:TObjectWriter);override; + end; + + { TMachoAssembler } + + TMachoAssembler=class(TInternalAssembler) + public + constructor create(smart:boolean);override; + end; + + +implementation + + { TmachoObjData } + + constructor TmachoObjData.create(const n: string); + begin + inherited create(n); + CObjSection:=TmachoObjSection; + end; + + + { TmachoObjData.CreateDebugSections. } + { note: mach-o file has specific symbol table command (not sections) to keep symbols and symbol string } + procedure TmachoObjData.CreateDebugSections; + begin + inherited CreateDebugSections; + if target_dbg.id=dbg_stabs then + begin + stabssec:=createsection(sec_stab); + stabstrsec:=createsection(sec_stabstr); + end; + end; + + + function TmachoObjData.sectionname(atype: TAsmSectiontype; const aname: string; aorder: TAsmSectionOrder): string; + const + DwarfSect : array [sec_debug_frame..sec_debug_abbrev] of string + = ('sec_debug_frame','__debug_info','__debug_line','__debug_abbrev'); + begin + case atype of + sec_user: Result:=aname; + sec_bss: Result:=MakeSectionName(seg_DATA, '__common'); + sec_stab: Result:='.stabs'; + sec_stabstr: Result:='.stabsstr'; + sec_fpc: Result:=MakeSectionName(seg_TEXT, '.fpc'); + sec_stub: Result:=MakeSectionName(seg_IMPORT, '__jump_table'); + sec_code: + if (aname='fpc_geteipasebx') or + (aname='fpc_geteipasecx') then + Result:=MakeSectionName(seg_TEXT, '__textcoal_nt') + else + Result:=MakeSectionName(seg_TEXT, '__text'); + sec_rodata_norel: Result:=MakeSectionName(seg_TEXT, '__const'); {.const} + sec_rodata: Result:=MakeSectionName(seg_DATA, '__const'); + sec_data: Result:=MakeSectionName(seg_DATA, '__data'); + sec_data_nonlazy: Result:=MakeSectionName(seg_DATA, '__nl_symbol_ptr'); + sec_data_lazy: Result:=MakeSectionName(seg_DATA, '__la_symbol_ptr'); + sec_init_func: Result:=MakeSectionName(seg_DATA, '__mod_init_func'); + sec_term_func: Result:=MakeSectionName(seg_DATA, '__mod_term_func'); + + + sec_objc_class: Result:='__OBJC __class'; + sec_objc_meta_class: Result:='__OBJC __meta_class'; + sec_objc_cat_cls_meth: Result:='__OBJC __cat_cls_meth'; + sec_objc_cat_inst_meth: Result:='__OBJC __cat_inst_meth'; + sec_objc_protocol: Result:='__OBJC __protocol'; + sec_objc_string_object: Result:='__OBJC __cstring'; + sec_objc_cls_meth: Result:='__OBJC __cls_meth'; + sec_objc_inst_meth: Result:='__OBJC __inst_meth'; + sec_objc_cls_refs: Result:='__OBJC __cls_refs'; + sec_objc_message_refs: Result:='__OBJC __message_refs'; + sec_objc_symbols: Result:='__OBJC __symbols'; + sec_objc_category: Result:='__OBJC __categories'; + sec_objc_class_vars: Result:='__OBJC __cls_vars'; + sec_objc_instance_vars: Result:='__OBJC __inst_vars'; + sec_objc_module_info: Result := '__OBJC __module_info'; + sec_objc_class_names: Result:='__TEXT __cstring'; + sec_objc_meth_var_types: Result:='__OBJC __var_types'; + sec_objc_meth_var_names: Result:='__TEXT __cstring'; + sec_objc_selector_strs: Result:='__TEXT __cstring'; + sec_objc_protocol_ext: Result:='__OBJC __protocol_ext'; + sec_objc_class_ext: Result:='__OBJC __class_ext'; + sec_objc_property: Result:='__OBJC __property'; + sec_objc_image_info: Result:='__OBJC __image_info'; + sec_objc_cstring_object: Result:='__OBJC __cstring_object'; + sec_objc_sel_fixup: Result:='__OBJC __sel_fixup'; + { Objective-C non-fragile ABI } + sec_objc_data: Result:='__OBJC __data'; + sec_objc_const: Result:='__OBJC __const'; + sec_objc_sup_refs: Result:='__OBJC __supc_refs'; + sec_objc_classlist: Result:='__OBJC __classlist'; + sec_objc_nlclasslist: Result:='__OBJC __nlclasslist'; + sec_objc_catlist: Result:='__OBJC __catlist'; + sec_objc_nlcatlist: Result:='__OBJC __nlcatlist'; + sec_objc_protolist: Result:='__OBJC __protolist'; + + sec_debug_frame, + sec_debug_info, + sec_debug_line, + sec_debug_abbrev: + Result:=MakeSectionName(seg_DWARF, DwarfSect[atype]) + + else + Result:=MakeSectionName(seg_DATA, '__data'); + end; + end; + + + procedure TmachoObjData.writereloc(data: aint; len: aword; p: TObjSymbol; reltype: TObjRelocationType); + var + symaddr : longint; + begin + {stabs relocation} + case TMachoObjSection(CurrObjSec).machoSec of + + mst_Stabs: + begin + if Assigned(p) then + begin + data:=p.address; + CurrObjSec.addsymreloc(CurrObjSec.Size,p,reltype); + end; + CurrObjSec.write(data, len); + end; + + mst_Dwarf: + begin + if Assigned(p) then + begin + CurrObjSec.addsectionReloc(CurrObjSec.Size,p.objsection,reltype); + data:=p.address; + end; + CurrObjSec.write(data, len); + end; + + else + if assigned(p) then + begin + { real address of the symbol } + symaddr:=p.address; + { Local ObjSymbols can be resolved already or need a section reloc } + if (p.bind=AB_LOCAL) and + (reltype in [RELOC_RELATIVE,RELOC_ABSOLUTE{$ifdef x86_64},RELOC_ABSOLUTE32{$endif x86_64}]) then + begin + { For a reltype relocation in the same section the value can be calculated } + if (p.objsection=CurrObjSec) and + (reltype=RELOC_RELATIVE) then + inc(data,symaddr-len-CurrObjSec.Size) + else + begin + if (p.typ=AT_NONE) then + begin + {undefined symbol, using section} + CurrObjSec.addsectionreloc(CurrObjSec.Size,p.objsection,reltype); + data:=symaddr-len-CurrObjSec.Size; + end + else + begin + CurrObjSec.addsymreloc(CurrObjSec.Size,p,reltype); + if Assigned(p.objsection) and + (p.objsection.Name='__TEXT __textcoal_nt') then + data:=symaddr-len-CurrObjSec.Size + else + data:=p.objsection.Size; + end; + end; + end + else if (p.bind=AB_GLOBAL) and + not Assigned(p.indsymbol) and + (reltype<>RELOC_PIC_PAIR) then + begin + CurrObjSec.addsectionreloc(CurrObjSec.Size,p.objsection,reltype); + data:=p.address; + end + else + CurrObjSec.addsymreloc(CurrObjSec.Size,p,reltype); + end; {if assigned(p) } + + CurrObjSec.write(data, len); + end; + end; + + + function TmachoObjData.sectiontype2align(atype: TAsmSectiontype): shortint; + begin + case atype of + sec_bss: + Result:=4; + sec_stabstr, sec_stab: + Result:=1; + sec_stub, sec_data_lazy, sec_data_nonlazy: + Result:=4; + else + Result:=inherited sectiontype2align(atype); + end; + end; + + + function TmachoObjData.sectiontype2options(atype: TAsmSectiontype): TObjSectionOptions; + begin + case atype of + sec_objc_meth_var_names, + sec_objc_class_names: Result:=[oso_data, oso_load]; + else + Result:=inherited sectiontype2options(atype); + end + end; + + + { TMachoAssembler } + + constructor TMachoAssembler.create(smart: boolean); + begin + inherited create(smart); + CObjOutput:=TMachoObjectOutput; + end; + + + { TMachoObjectOutput } + + procedure TMachoObjectOutput.FixSectionRelocs(s: TMachoObjSection); + var + i : integer; + ro : TObjRelocation; + dw : aword; + begin + {todo: is it I386 only core} + if not Assigned(s.Data) then + Exit; + + for i:=0 to s.ObjRelocations.Count-1 do + begin + ro:=TObjRelocation(s.ObjRelocations[i]); + + if (Assigned(ro.objsection)) and + (ro.objsection.Name='__TEXT __textcoal_nt') then + Continue; + + if Assigned(ro.objsection) then + begin + s.Data.seek(ro.DataOffset); + s.Data.read(dw, sizeof(aword)); + + dw:=dw+ro.objsection.MemPos; + + s.Data.seek(ro.DataOffset); + s.Data.write(dw, sizeof(aword)); + end + else + begin + if ro.symbol.Name='fpc_geteipasebx' then + Continue; + if Assigned(ro.symbol.indsymbol) or + (ro.typ=RELOC_PIC_PAIR) then + begin + s.Data.seek(ro.DataOffset); + s.Data.read(dw, sizeof(aword)); + dw:=ro.symbol.address-dw; + s.Data.seek(ro.DataOffset); + s.Data.write(dw, sizeof(aword)); + end + else if (ro.symbol.bind=AB_LOCAL) then + begin + dw:=ro.symbol.address; + s.Data.seek(ro.DataOffset); + s.Data.write(dw, sizeof(aword)); + end; + end; + + end; + s.Data.seek(s.Data.Size); + end; + + + procedure TMachoObjectOutput.section_count_sections(p: TObject; arg: pointer); + var + s : TMachoObjSection; + begin + s:=TMachoObjSection(p); + if s.machoSec=mst_Stabs then + Exit; + inc(sectionscnt); + s.inSegIdx:=sectionscnt; + end; + + + procedure TMachoObjectOutput.section_set_datamempos(p: TObject; arg: pointer); + var + s : TMachoObjSection; + begin + s:=TMachoObjSection(p); + if s.machoSec=mst_Stabs then + Exit; + + s.setDataPos(fileofs); + s.setMemPos(memofs); + memofs:=Align(memofs+s.Size, s.SecAlign); + + fileofs:=AlignAddr(cputarget, fileofs); + end; + + + procedure TMachoObjectOutput.section_set_relocpos(p:TObject;arg:pointer); + var + s : TMachoObjSection; + sz : Integer; + begin + s:=TMachoObjSection(p); + if s.machoSec=mst_Stabs then + Exit; + + sz:=s.GetRelocCount * sizeof(relocation_info); + if sz > 0 then + begin + s.relocofs:=fileofs; + inc(fileofs, sz); + fileofs:=AlignAddr(cputarget, fileofs); + end; + end; + + + procedure TMachoObjectOutput.section_write_data(p: TObject; arg: pointer); + var + s : TMachoObjSection; + begin + s:=TMachoObjSection(p); + if s.machoSec=mst_Stabs then + Exit; + + Writer.writezeros(s.DataAlignBytes); + + FixSectionRelocs(s); + + if s.Datapos<>FWriter.ObjSize then + InternalError(200903101); + if Assigned(s.data) then + Writer.writearray(s.data); + TrailZeros; + end; + + + procedure TMachoObjectOutput.section_write_relocdata(p: TObject; arg: pointer); + var + s : TMachoObjSection; + symsec : TMachoObjSection; + i : Integer; + dw : aword; + + r : relocation_info; + sr : scattered_relocation_info; + ro : TObjRelocation; + symnum : Integer; + relpc : Boolean; + relextern : Boolean; + reltype : Integer; + + begin + s:=TMachoObjSection(p); + + {stabs relocation should not present in relocation table} + if s.machoSec=mst_Stabs then + Exit; + {no relocation for the section} + if s.relocofs=0 then + Exit; + {check file alignment} + if s.relocofs<>FWriter.ObjSize then + InternalError(200903102); {file misalignment} + + relcount:=s.ObjRelocations.Count; + {the reversed order, is only to be alike Apple linker} + for i:=s.ObjRelocations.Count-1 downto 0 do + begin + ro:=TObjRelocation(s.ObjRelocations[i]); + + {in-section relocation} + if ro.symbol=nil then + begin + relextern:=false; + relpc:=false; + symnum:=TmachoObjSection(ro.objsection).inSegIdx; + case ro.typ of + RELOC_ABSOLUTE: + begin + RelocInfo(ro.DataOffset, symnum, GENERIC_RELOC_VANILLA, ril_long, relpc, relextern, r); + mfile.WriteRelocation(r); + end; + else + relpc:=ro.typ=RELOC_RELATIVE; + RelocInfo(ro.DataOffset, symnum, GENERIC_RELOC_VANILLA, ril_long, relpc, relextern, r); + mfile.WriteRelocation(r); + end; + + end + else + begin + symsec:=TMachoObjSection(ro.symbol.objsection); + + if Assigned(symsec) and + (symsec.Name='__TEXT __textcoal_nt') then + begin + relextern:=true; + symnum:=ro.symbol.symidx; + end + else if ro.symbol.bind=AB_EXTERNAL then + begin + relextern:=true; + symnum:=ro.symbol.symidx; + end + else if Assigned(ro.symbol.objsection) and + (ro.symbol.bind=AB_LOCAL) and + (ro.symbol.typ=AT_DATA) then + begin + relextern:=false; + symnum:=TMachoObjSection(ro.symbol.objsection).inSegIdx; + end + else if (ro.symbol.bind=AB_LOCAL) or + (ro.symbol.typ=AT_NONE) then + begin + relextern:=false; + symnum:=s.inSegIdx + end + else + begin + relextern:=true; + symnum:=ro.symbol.symidx; + end; + + relpc:=false; + relpc:=(ro.typ=RELOC_RELATIVE); + if (ro.typ=RELOC_PIC_PAIR) then + begin + if ro.symbol.bind=AB_LOCAL then + reltype:=GENERIC_RELOC_LOCAL_SECTDIFF + else + reltype:=GENERIC_RELOC_SECTDIFF; + ScatterRelocInfo(ro.symbol.address, ro.DataOffset, reltype, ril_long, false, sr); + mfile.WriteScatterReloc(sr); + + { the section data is already fixed to: ro.SymbolOffset - Label.Offset } + s.Data.seek(ro.DataOffset); + s.Data.read(dw, sizeof(aword)); + dw:=ro.symbol.address-dw; + ScatterRelocInfo(dw, 0, GENERIC_RELOC_PAIR, ril_long, false, sr); + mfile.WriteScatterReloc(sr); + end + else + begin + RelocInfo(ro.DataOffset, symnum, GENERIC_RELOC_VANILLA, ril_long, relpc, relextern, r); + mfile.WriteRelocation(r); + end + end; + if Assigned(s.Data) then + s.Data.seek(s.Data.size); + end; + TrailZeros; + end; + + + procedure TMachoObjectOutput.section_prepare_indirect(s: TObjSection); + var + t : TObjSymbol; + i : Integer; + anysym : Boolean; + begin + if TmachoObjSection(s).machoSec=mst_Stabs then + Exit; + + anysym:=false; + for i:=0 to machoData.ObjSymbolList.Count-1 do + begin + t:=TObjSymbol(machoData.ObjSymbolList[i]); + if (t.objsection=s) and Assigned(t.indsymbol) then + begin + if not anysym then + begin + {remember the index of the first indirect symbol. Will be used later at section header writting} + TmachoObjSection(s).indIndex:=IndirIndex.size div SizeOf(Integer); + anysym:=true; + end; + IndirIndex.write(t.symidx, sizeof(Integer)); + end; + end; + + end; + + + procedure TMachoObjectOutput.symbol_write_nlist(sym:TObjSymbol; symstr: tdynamicarray); + var + n : nlist_64; + sec : TmachoObjSection; + begin + sec:=TMachoObjSection(sym.objsection); + FillChar(n, sizeof(n), 0); + n.n_un.n_strx:=symstr.size; + symstr.writestr(sym.Name+#0); + + if assigned(sec) and + (sec.machoSec=mst_ObjC) and + (sec.nmsection='__module_info') then + begin + n.n_type:=N_ABS or N_EXT; + mfile.WriteNList(n); + Exit; + end; + + if (sym.typ=AT_NONE) then + begin + n.n_value:=0; + if sym.bind<>AB_EXTERNAL then + n.n_desc:=n.n_desc or REFERENCE_FLAG_UNDEFINED_LAZY; + n.n_type:=n.n_type or N_EXT; + end + else if sym.bind=AB_LAZY then + begin + n.n_value:=0; + n.n_type:=N_ABS or N_EXT; + n.n_sect:=NO_SECT; + end + else + begin + n.n_value:=sym.address; + + if Assigned(sec) then + begin + n.n_sect:=sec.inSegIdx; + n.n_type:=n.n_type or N_SECT; + + if (sym.typ=AT_FUNCTION) and + (sym.bind=AB_LOCAL) then + begin + n.n_type:=N_PEXT or N_EXT or N_SECT; + n.n_desc:=n.n_desc or N_WEAK_DEF; + end; + end; + end; + + if (sym.bind=AB_GLOBAL) and + (n.n_type and N_PEXT=0) then + n.n_type:=n.n_type or N_EXT; + + if (sym.typ=AT_FUNCTION) and + (sym.bind=AB_GLOBAL) then + n.n_desc:=n.n_desc or N_NO_DEAD_STRIP; + + if Assigned(sec) then + begin + if (sec.nmsection='__nl_symbol_ptr') then + n.n_desc:=n.n_desc or REFERENCE_FLAG_UNDEFINED_NON_LAZY; + if (sec.nmsegment=seg_Data) and (sec.nmsection='__const') then + n.n_desc:=n.n_desc or N_NO_DEAD_STRIP; + end; + + mfile.WriteNList(n); + end; + + + function TMachoObjectOutput.dysymbol_location(sym: TObjSymbol): TMachoSymbolLocation; + begin + if Assigned(sym.objsection) and + (TMachoObjSection(sym.objsection).machoSec=mst_Stabs) then + Result:=loc_Local + else + case sym.typ of + AT_NONE: Result:=loc_Undef; + AT_LABEL: Result:=loc_Notused; + else + Result:=loc_External; + end; + end; + + + procedure TMachoObjectOutput.writeSectionsHeader(s: TMachoObjSection); + var + sc : TMachoSection; + begin + section_prepare_indirect(s); + + fillChar(sc, sizeof(sc), 0); + sc.segname:=s.nmsegment; + sc.sectname:=s.nmsection; + sc.size:=s.Size; + if s.FileSize>0 then + sc.offset:=s.DataPos + else + sc.offset:=0; + sc.addr:=s.MemPos; + sc.nreloc:=s.GetRelocCount; + sc.reloff:=s.relocofs; + sc.flags:=GetSectionFlags(s.nmsegment, s.nmsection); + sc.align:=MachoAlign(s.SecAlign); + sc.indirectIndex:=s.indIndex; + + if (sc.flags and SECTION_TYPE)=S_SYMBOL_STUBS then + sc.stubSize:=GetStubSize(cputarget, false); + mfile.WriteSection(sc); + end; + + + procedure TMachoObjectOutput.writeSymTabCommand; + begin + mfile.WriteLoadCommand(LC_SYMTAB, sizeof(symtab_command)); + mfile.WriteUint32(fileofs); {symoff} + mfile.WriteUint32(symCount); {nsyms} + inc(fileofs, symCount*sizeNList(cputarget)); + fileofs:=AlignAddr(cputarget, fileofs); + + symstrofs:=fileofs; + mfile.WriteUint32(fileofs); {stroff} + mfile.WriteUint32(symlen); {strsize} + + inc(fileofs, symlen); + fileofs:=AlignAddr(cputarget, fileofs); + end; + + + function TMachoObjectOutput.symWriteName(s: TObjSymbol): string; + begin + if not Assigned(s.indsymbol) then + Result:=s.Name + else + Result:=s.indsymbol.Name; + end; + + +{ function getSymWriteNameLength(s: TObjSymbol): Integer; inline; + begin + Result:=length(symWriteName(s))+1; + end;} + + + procedure TMachoObjectOutput.InitSymbolIndexes(var sCount: aint; var symStrLen: aword); + var + i : integer; + s : TObjSymbol; + stabcount : Integer; + begin + sCount:=0; + symStrLen:=0; + + iIndir:=0; + for i:=0 to machoData.ObjSymbolList.Count-1 do + begin + s:=TObjSymbol(machoData.ObjSymbolList[i]); + if (s.typ=AT_LABEL) then + Continue; + + if Assigned(s.indsymbol) then + inc(iIndir); + end; + + iLocal:=0; + iExtern:=0; + iUndef:=0; + + for i:=0 to machoData.ObjSymbolList.Count-1 do + begin + s:=TObjSymbol(machoData.ObjSymbolList[i]); + if (s.typ=AT_LABEL) or + Assigned(s.indsymbol) then + Continue; + if (s.bind=AB_LOCAL) and + (s.Name <> 'fpc_geteipasebx') then + Continue; + + case dysymbol_location(s) of + loc_Local: + begin + symList.Insert(iLocal, s); + inc(iLocal); inc(iExtern); inc(iUndef); + end; + loc_External: + begin + symList.Insert(iExtern, s); + inc(iExtern); inc(iUndef); + end; + loc_Undef: + begin + symList.Insert(iUndef, s); + inc(iUndef); + end; + end; + inc(symStrLen, length(s.Name)+1 ); + end; + + if Assigned(stabsec) then + {skipping hdrsym! (added by ogbase) } + stabcount:=stabsec.Size div sizeof(TObjStabEntry) - 1 + else + stabcount:=0; + + for i:=0 to symList.Count-1 do + TObjSymbol(symList[i]).symidx:=i+stabcount; + sCount:=symList.Count+stabcount; + + for i:=0 to machoData.ObjSymbolList.Count-1 do + with TObjSymbol(machoData.ObjSymbolList[i]) do + if Assigned(indsymbol) then + symidx:=indsymbol.symidx; + + if Assigned(strsec) then + // 1 byte of zero name (that stands in the end of table, not at zero pos) + inc(symlen, strsec.Size + 1) + else + inc(symlen); {the first zero byte} + + dec(iUndef, iExtern); { iUndef is count of undefined symbols (for dysymtable command) } + dec(iExtern, iLocal); { iExtern is count of external symbols (for dysymtable command) } + inc(iLocal, stabcount); + end; + + + procedure TMachoObjectOutput.writeSymbols(symstr: tdynamicarray); + var + i : integer; + s : TObjSymbol; + b : byte; + stab : TObjStabEntry; + ro : TObjRelocation; + sym : TObjSymbol; + addr : aword; + text : TmachoObjSection; + funofs : AWord; + begin + if Assigned(stabsec) then + begin + for i:=0 to stabsec.ObjRelocations.Count - 1 do + begin + ro:=TObjRelocation(stabsec.ObjRelocations[i]); + sym:=ro.symbol; + addr:=sym.address; + if Assigned(sym.objsection) then + begin + stabsec.Data.seek(ro.DataOffset-3); + b:=TmachoObjSection(sym.objsection).inSegIdx; + stabsec.Data.write(b, sizeof(b)); + end; + stabsec.Data.seek(ro.DataOffset); + stabsec.Data.write(addr, sizeof(addr)); + end; + + stabsec.Data.seek(sizeof(TObjStabEntry)); + funofs:=0; + text:=TmachoObjSection(machoData.ObjSectionList.Find(MakeSectionName(seg_TEXT, '__text'))); + for i:=1 to stabsec.Data.size div SizeOf(TObjStabEntry) - 1 do + begin + stabsec.Data.read(stab, sizeof(stab)); + case stab.ntype of + N_FUN: + begin + if stab.strpos=0 then + funofs:=0 + else + funofs:=stab.nvalue; + end; + N_SLINE,N_RBRAC,N_LBRAC: + begin + if Assigned(text) then + begin + { SLINE are expected to be in __TEXT __text only } + stab.nother:=text.inSegIdx; + inc(stab.nvalue, funofs); + end; + end; + N_OSO: + begin + { null-terminated string is the first in the list } + { apple-gdb doesn't recognize it as zero-string for N_OSO } + { another zero-string should be added to the list } + if stab.strpos=0 then + stab.strpos:=symstr.Size; + end; + end; + FWriter.write(stab, sizeof(stab)); + end; + end; + + symstr.Seek(symStr.size); + b:=0; + symstr.Write(b,1); + + for i:=0 to symList.Count-1 do + begin + s:=TObjSymbol(symList[i]); + symbol_write_nlist(s, symstr); + end; + end; + + + procedure TMachoObjectOutput.writeDySymTabCommand(IndOffset: aword; IndCount: Integer); + begin + mfile.WriteLoadCommand(LC_DYSYMTAB, sizeof(dysymtab_command)); + + mfile.WriteUint32(0); {ilocalsym} + mfile.WriteUint32(iLocal); {nlocalsym} + + mfile.WriteUint32(iLocal); {iextdefsym} + mfile.WriteUint32(iExtern); {nextdefsym} + + mfile.WriteUint32(iLocal + iExtern); {iundefsym} + mfile.WriteUint32(iUndef); {nundefsym} + + mfile.WriteUint32(0); {tocoff} + mfile.WriteUint32(0); {ntoc} + mfile.WriteUint32(0); {modtaboff} + mfile.WriteUint32(0); {nmodtab} + mfile.WriteUint32(0); {extrefsymoff} + mfile.WriteUint32(0); {nextrefsyms} + mfile.WriteUint32(IndOffset); {indirectsymoff} + mfile.WriteUint32(IndCount); {nindirectsyms} + mfile.WriteUint32(0); {extreloff} + mfile.WriteUint32(0); {nextrel} + mfile.WriteUint32(0); {locreloff} + mfile.WriteUint32(0); {nlocrel} + end; + + + procedure TMachoObjectOutput.writeDysymbols; + var + i : integer; + idx : LongWord; + begin + IndirIndex.seek(0); + for i:=0 to (IndirIndex.size div sizeof(Integer))-1 do + begin + IndirIndex.read(idx, sizeof(idx)); + mfile.WriteUint32(idx); + end; + end; + + + function AddSectionToSegment(var segment: TMachoSegment; section : TMachoObjSection): boolean; + begin + { sections must be attached one-by-one to the segment } + if segment.fileoff=0 then + segment.fileoff:=section.DataPos; + + if (segment.fileoff+segment.filesize)<(section.FileSize+section.DataPos) then + segment.filesize:=section.FileSize+section.DataPos; + + inc(segment.nsects); + inc(segment.vmsize, section.size); + Result:=true; + end; + + + procedure TMachoObjectOutput.TrailZeros; + var + sz : LongWord; + begin + sz:=AlignAddr(cputarget, FWriter.Size); + if sz - FWriter.Size>0 then + FWriter.WriteZeros(sz-FWriter.Size); + end; + + + function TMachoObjectOutput.writedata(data: TObjData): boolean; + var + header : TMachHeader; + seg : TMachoSegment; + secobj : TMachoObjSection; + i : Integer; + + symstr : tdynamicarray; + segSize : integer; {size of a segment command - platform dependant} + sctSize : integer; {size of a single section header - platform dependant} + + indOfs: aword; {indirect symbol offset} + + begin + symList:=TFPObjectList.Create(false); + IndirIndex:=tdynamicarray.Create(1024); + + result:=false; + machoData:=TMachoObjData(data); + + cputarget:=CPU_TYPE_i386; + segSize:=sizeSegment(cputarget); + sctSize:=sizeSection(cputarget); + + sectionscnt:=0; + stabsec:=TMachoObjSection(machoData.ObjSectionList.Find('.stabs')); + strsec:=TMachoObjSection(machoData.ObjSectionList.Find('.stabsstr')); + + {count number of sections} + machoData.ObjSectionList.ForEachCall(@section_count_sections, nil); + + {sections data is written after machheader,load-commands. } + { basic loadcommands for MH_OBJECT are } + { single LC_SEGMENT, containing all sections headers } + { symbol linking information at LC_SYMTAB and LC_DYSYMTAB } + header.cputype:=cputarget; + header.cpusubtype:=CPU_SUBTYPE_i386_ALL; + header.filetype:=MH_OBJECT; + header.ncmds:=3; + header.sizeofcmds:=segSize+sctSize*sectionscnt+sizeof(symtab_command)+sizeof(dysymtab_command); + header.flags:=0; + + {setting sections data and memory pos} + fileofs:=sizeMachHeader(cputarget)+header.sizeofcmds; + fileofs:=AlignAddr(cputarget, fileofs); + memofs:=0; + + machoData.ObjSectionList.ForEachCall(@section_set_datamempos, nil); + fileofs:=AlignAddr(cputarget, fileofs); + + {setting sections relocation offsets} + machoData.ObjSectionList.ForEachCall(@section_set_relocpos, nil); + fileofs:=AlignAddr(cputarget, fileofs); + + {creating actual mach-o file writer} + mfile:=AllocMachoWriter(CPU_TYPE_I386, TMachoRawWriter.Create(writer), true); + {writing macho-o header} + mfile.WriteHeader(header); + + {starting the first segment command} + InitSegment(seg); + + {initialze symbols. some sections (non_lazy, lazy pointers) are effected} + InitSymbolIndexes(symCount, symlen); + + for i:=0 to machoData.ObjSectionList.Count-1 do + begin + secobj:=TmachoObjSection(machoData.ObjSectionList[i]); + if secobj.machoSec=mst_Stabs then + Continue; + AddSectionToSegment(seg, secobj); + end; + + {writting segment command} + {for MH_OBJECT, all sections are stored in the single segment} + mfile.WriteSegmentCmd(seg, segSize+(seg.nsects)*sctSize); + + {section headers are written inside segment command} + for i:=0 to machoData.ObjSectionlist.Count - 1 do + begin + secobj:=TmachoObjSection(machoData.ObjSectionList[i]); + if secobj.machoSec=mst_Stabs then + Continue; + writeSectionsHeader(secobj); + end; + TrailZeros; + + if IndirIndex.size div sizeof(Integer)<>iIndir then + InternalError(2009121001); + if iIndir>0 then + indOfs:=fileOfs + else + indOfs:=0; + inc(fileofs, IndirIndex.size); + + {write symtab command} + {initilize symbos order. local first, extern second, undef last} + writeSymTabCommand; + TrailZeros; + + {write dysymtab command} + writeDySymTabCommand(indofs, iIndir); + TrailZeros; + + {writting sections data, to precalculated offsets} + {if precalculated offsets, doesn't match actual written offsets, internal error is risen} + machoData.ObjSectionList.ForEachCall(@section_write_data, nil); + + {writting relocation offsets} + machoData.ObjSectionList.ForEachCall(@section_write_relocdata, nil); + + {writting dyn symbol tables (indirect symbols arrays)} + writeDysymbols; + + {writting symbol table} + if Assigned(strsec) then + symstr:=strsec.Data + else + symstr:=tdynamicarray.create(1024); + + writeSymbols(symstr); + TrailZeros; + + {writting symbol table strings} + FWriter.writearray(symstr); + // terminating null name + TrailZeros; + + if not Assigned(strsec) then + symstr.Free; + + TrailZeros; + + mfile.Free; + symList.Free; + IndirIndex.Free; + end; + + + constructor TMachoObjectOutput.Create(AWriter: TObjectWriter); + begin + inherited Create(AWriter); + CObjData:=TMachoObjData; + end; + + + { TMachoRawWriter } + + constructor TMachoRawWriter.Create(awriter: tobjectwriter); + begin + inherited Create; + fwriter:=awriter; + end; + + + procedure TMachoRawWriter.WriteRaw(const data; datasize: Integer); + begin + fwriter.Write(data, datasize); + end; + + + { TmachoObjSection } + + function TmachoObjSection.GetRelocCount: Integer; + var + i: integer; + r: TObjRelocation; + begin + Result:=ObjRelocations.Count; + for i:=0 to ObjRelocations.Count-1 do + begin + r:=TObjRelocation(ObjRelocations[i]); + if (r.typ=RELOC_PIC_PAIR) then + inc(Result); + end; + end; + + + function TmachoObjSection.FileSize: Integer; + begin + if Assigned(data) then + Result:=data.size + else + Result:=0; + end; + + + constructor TmachoObjSection.create(AList: TFPHashObjectList; + const Aname: string; Aalign: shortint; Aoptions: TObjSectionOptions); + begin + if Aname = '__TEXT __textcoal_nt' then + Aalign:=4; + + inherited create(AList, Aname, Aalign, Aoptions); + GetSegmentSectionName(aName, nmsegment, nmsection); + if (aname='.stabs') or + (aname='.stabsstr') then + machoSec:=mst_Stabs + else if nmsegment=seg_DWARF then + machoSec:=mst_Dwarf + else if nmsegment=seg_OBJC then + machoSec:=mst_ObjC + else + machoSec:=mst_Normal; + end; + + + const + as_i386_darwin_info : tasminfo = + ( + id : as_i386_macho; + idtxt : 'MACHO'; + asmbin : ''; + asmcmd : ''; + supported_targets : [system_i386_darwin,system_i386_iphonesim]; + flags : [af_outputbinary,af_smartlink_sections,af_supports_dwarf{, af_stabs_use_function_absolute_addresses}]; + labelprefix : '.L'; + comment : '#'; + ); + +initialization + RegisterAssembler(as_i386_darwin_info,TMachoAssembler); + +end. + diff --git a/closures/compiler/ogmap.pas b/closures/compiler/ogmap.pas new file mode 100644 index 0000000000..8b5172510d --- /dev/null +++ b/closures/compiler/ogmap.pas @@ -0,0 +1,162 @@ +{ + Copyright (c) 2001-2002 by Peter Vreman + + Contains the class for generating a map file + + 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 ogmap; + +{$i fpcdefs.inc} + +interface + + uses + { common } + cclasses,globtype,systems, + { object writer } + aasmbase,ogbase + ; + + type + texemap = class + private + t : text; + FImageBase : aword; + public + constructor Create(const s:string); + destructor Destroy;override; + procedure Add(const s:string); + procedure AddHeader(const s:string); + procedure AddCommonSymbolsHeader; + procedure AddCommonSymbol(p:TObjSymbol); + procedure AddMemoryMapHeader(abase:aint); + procedure AddMemoryMapExeSection(p:texesection); + procedure AddMemoryMapObjectSection(p:TObjSection); + procedure AddMemoryMapSymbol(p:TObjSymbol); + end; + + var + exemap : texemap; + + +implementation + + uses + cutils,cfileutl, + globals,verbose; + + +{**************************************************************************** + TExeMap +****************************************************************************} + + constructor TExeMap.Create(const s:string); + begin + Assign(t,FixFileName(s)); + Rewrite(t); + FImageBase:=0; + end; + + + destructor TExeMap.Destroy; + begin + Close(t); + end; + + + procedure TExeMap.Add(const s:string); + begin + writeln(t,s); + end; + + + procedure TExeMap.AddHeader(const s:string); + begin + Add(''); + Add(s); + end; + + + procedure TExeMap.AddCommonSymbolsHeader; + begin + AddHeader('Allocating common symbols'); + Add('Common symbol size file'); + Add(''); + end; + + + procedure TExeMap.AddCommonSymbol(p:TObjSymbol); + var + s : string; + begin + { Common symbol size file } + s:=p.name; + if length(s)>20 then + begin + writeln(t,p.name); + s:=''; + end; + Add(PadSpace(s,20)+'0x'+PadSpace(hexstr(p.size,1),16)+p.objsection.objdata.name); + end; + + + procedure TExeMap.AddMemoryMapHeader(abase:aint); + var + imagebasestr : string; + begin + FImageBase:=abase; + if FImageBase<>0 then + imagebasestr:=' (ImageBase='+HexStr(FImageBase,sizeof(pint)*2)+')' + else + imagebasestr:=''; + AddHeader('Memory map'+imagebasestr); + Add(''); + end; + + + procedure TExeMap.AddMemoryMapExeSection(p:texesection); + begin + { .text 0x000018a8 0xd958 } + Add(PadSpace(p.name,19)+PadSpace(' 0x'+HexStr(p.mempos+Fimagebase,sizeof(pint)*2),12)+ + ' 0x'+HexStr(p.size,sizeof(pint))); + end; + + + procedure TExeMap.AddMemoryMapObjectSection(p:TObjSection); + var + secname : string; + begin + { .text 0x000018a8 0xd958 object.o } + secname:=p.name; + if Length(secname)>18 then + begin + Add(' '+secname); + secname:=''; + end; + Add(' '+PadSpace(secname,18)+PadSpace(' 0x'+HexStr(p.mempos+FImageBase,sizeof(pint)*2),12)+ + ' 0x'+HexStr(p.size,sizeof(pint))+' '+p.objdata.name); + end; + + + procedure TExeMap.AddMemoryMapSymbol(p:TObjSymbol); + begin + { 0x00001e30 setup_screens } + Add(Space(20)+PadSpace('0x'+HexStr(p.address+Fimagebase,sizeof(pint)*2),25)+' '+p.name); + end; + +end. diff --git a/closures/compiler/ognlm.pas b/closures/compiler/ognlm.pas new file mode 100644 index 0000000000..fb0f558a0c --- /dev/null +++ b/closures/compiler/ognlm.pas @@ -0,0 +1,1521 @@ +{ + Copyright (c) 1998-2006 by Peter Vreman + Copyright (c) 2011 by Armin Diehl + + Contains the binary netware nlm executable writer + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit ognlm; + +{$i fpcdefs.inc} + +interface + + uses + { common } + cclasses,globtype, + { target } + systems, + aasmbase,assemble,link, + { output } + ogbase, + owbase, + ogcoff; + +{***************************************************************************** + NLM File structures and constants +*****************************************************************************} + +{ + +LString0 -> 1 byte Length, Text, #0 +LString -> 1 byte length, Text + +Basic NLM File Structure: + +FixedHeader + nlm32_i386_external_fixed_header 130 bytes + +VarHdr1 + NLM Description: LString0 2+n bytes + Stacksize 4 bytes + reserved = 0 4 bytes + ' LONG' 5 bytes + NLM screen name: LString0 2+n bytes + NLM thread name: LString0 2+n bytes + +Optional Headers beginning with stamp (without '') +'VeRsIoN#': nlm32_i386_external_version_header 32 bytes +'CoPyRiGhT=': LString0 2+n bytes +'MeSsAgEs': nlm32_i386_external_extended_header 124 bytes +'CuStHeAd': nlm32_i386_external_custom_header +'CyGnUsEx': nlm32_i386_external_cygnus_ext_header 16 bytes + +.text +.data +.relocs= + addr(32),addr(32),... + addr and $80000000 > 0 -> FixupToSeg=.text else .data + addr and $40000000 > 0 -> FixupInSeg=.text else .data +.importedSymbols + name LString 1+n bytes + number of references r 4 bytes + addresses r*4 bytes +.exportedSymbols + name LString 1+n bytes + addr 4 bytes + addr and $80000000 > 0 -> .text else .data + ... +.modules + +.nlmdebugrecs + type (0=.data,1=.code,2,..=????) 1 byte + addr 4 bytes + name LString 1+n bytes + ... + +} + + +const NLM_MAX_DESCRIPTION_LENGTH = 127; + NLM_MAX_SCREEN_NAME_LENGTH = 71; + NLM_MAX_THREAD_NAME_LENGTH = 71; // some netware docs limit this to 12 ? + NLM_OLD_THREAD_NAME_LENGTH = 5; + NLM_HEADER_VERSION = 4; + NLM_DEFAULT_STACKSIZE = (32 * 1024); + NLM_VERSION_STAMP = 'VeRsIoN#'; + NLM_COPYRIGHT_STAMP = 'CoPyRiGhT='; + NLM_CYGNUS_STAMP = 'CyGnUsEx'; + NLM_MESSAGES_STAMP = 'MeSsAgEs'; + NLM_CUSTOM_STAMP = 'CuStHeAd'; + NLM_SIGNATURE = 'NetWare Loadable Module'#$1A; + NLM_FLAGS_REENTRANT = 1; + NLM_FLAGS_MULTILOAD = 2; + NLM_FLAGS_SYNCHRONIZE = 4; + NLM_FLAGS_PSEUDOPREEMPTION = 8; + NLM_FLAGS_OSDOMAIN = $10; + NLM_FLAGS_AUTOUNLOAD = $40; + + + type + uint32 = longword; + + nlm32_i386_external_fixed_header = packed record + signature : array[0..23] of char; + version : uint32; + (* The name of the module, which must be a DOS name (1-8 characters followed + by a period and a 1-3 character extension). The first byte is the byte + length of the name and the last byte is a null terminator byte. This + field is fixed length, and any unused bytes should be null bytes. The + value is set by the OUTPUT keyword to NLMLINK. *) + moduleName : string[13]; //array[0..13] of byte; + codeImageOffset : uint32; // The byte offset of the code image from the start of the file. + codeImageSize : uint32; // The size of the code image, in bytes. + dataImageOffset : uint32; // The byte offset of the data image from the start of the file. + dataImageSize : uint32; // The size of the data image, in bytes. + uninitializedDataSize : uint32; // The size of the uninitialized data region that the loader has to be + // allocated at load time. Uninitialized data follows the initialized + // data in the NLM address space. + customDataOffset : uint32; // The byte offset of the custom data from the start of the file. The + // custom data is set by the CUSTOM keyword to NLMLINK. It is possible + // for this to be EOF if there is no custom data. + customDataSize : uint32; // The size of the custom data, in bytes. + moduleDependencyOffset : uint32; // The byte offset of the module dependencies from the start of the file. + // The module dependencies are determined by the MODULE keyword in NLMLINK. + numberOfModuleDependencies : uint32; // he number of module dependencies at the moduleDependencyOffset. + relocationFixupOffset : uint32; // The byte offset of the relocation fixup data from the start of the file + numberOfRelocationFixups : uint32; + externalReferencesOffset : uint32; + numberOfExternalReferences : uint32; + publicsOffset : uint32; + numberOfPublics : uint32; + debugInfoOffset : uint32; // The byte offset of the internal debug info from the start of the file. + // It is possible for this to be EOF if there is no debug info. + numberOfDebugRecords : uint32; + codeStartOffset : uint32; + exitProcedureOffset : uint32; + checkUnloadProcedureOffset : uint32; + moduleType : uint32; + flags : uint32; + end; + + + { The version header is one of the optional auxiliary headers and + follows the fixed length and variable length NLM headers. } + { The header is recognized by "VeRsIoN#" in the stamp field. } + + nlm32_i386_external_version_header = packed record + stamp : array[0..7] of char; // VeRsIoN# + majorVersion, + minorVersion, + revision, + year, + month, + day : uint32; + end; + { The header is recognized by "MeSsAgEs" in the stamp field. } + + nlm32_i386_external_extended_header = packed record + stamp : array[0..7] of char; // MeSsAgEs + languageID : uint32; + messageFileOffset : uint32; + messageFileLength : uint32; + messageCount : uint32; + helpFileOffset : uint32; + helpFileLength : uint32; + RPCDataOffset : uint32; + RPCDataLength : uint32; + sharedCodeOffset : uint32; + sharedCodeLength : uint32; + sharedDataOffset : uint32; + sharedDataLength : uint32; + sharedRelocationFixupOffset : uint32; + sharedRelocationFixupCount : uint32; + sharedExternalReferenceOffset: uint32; + sharedExternalReferenceCount : uint32; + sharedPublicsOffset : uint32; + sharedPublicsCount : uint32; + sharedDebugRecordOffset : uint32; + sharedDebugRecordCount : uint32; + SharedInitializationOffset : uint32; + SharedExitProcedureOffset : uint32; + productID : longint; + reserved0 : longint; + reserved1 : longint; + reserved2 : longint; + reserved3 : longint; + reserved4 : longint; + reserved5 : longint; + end; + + nlm32_i386_external_custom_header = packed record + stamp : array[0..7] of char; // CuStHeAd + hdrLength : uint32; + dataOffset : uint32; + dataLength : uint32; + //dataStamp : array[0..7] of char; + //hdr : uint32; + end; + { The internal Cygnus header is written out externally as a custom + header. We don't try to replicate that structure here. } + { The header is recognized by "CyGnUsEx" in the stamp field. } + { File location of debugging information. } + { Length of debugging information. } + + nlm32_i386_external_cygnus_ext_header = packed record + stamp : array[0..7] of char; // CyGnUsEx + offset : uint32; + length : uint32; + end; + + +//------------------ + + + TNLMExeSection = class(TExeSection) + public + constructor createnw(AList:TFPHashObjectList;const n:string); + end; + + TsecType = (Section_text,Section_data,Section_other); + + TNLMexeoutput = class(texeoutput) + private + FRelocsGenerated,FImportsGenerated : boolean; + FNumRelocs : longword; + FNumExternals : longword; + FNumModules : longword; + FNumDebugSymbols : longword; + fSizeWoDebugSyms : longword; + FnumExports : longword; + NlmSymbols : TDynamicArray; + ExeSecsListSize : longint; + nlmImpNames, // name of import. module name as import + nlmImports : TFPHashObjectList; // name of import, list of relocs as object + headerAlignBytes : longint; + FexportFunctionOffsets:TFPList; // offsets in .exports for function addresses, an offset of $80000000 is needed + + nlmHeader : nlm32_i386_external_fixed_header; + nlmVersionHeader : nlm32_i386_external_version_header; + nlmExtHeader : nlm32_i386_external_extended_header; + nlmCustHeader : nlm32_i386_external_custom_header; + //nlmHelpFileName : TCmdStr; + //nlmMessagesFileName: TCmdStr; + //nlmXdcFileName : TCmdStr; + nlmCopyright : string; + nlmThreadname : string; + nlmScreenname : string; + nlmDescription : string; + + function totalheadersize:longword; + procedure createNlm_symbol(const name:shortstring;value:longword;secType:TSecType); + procedure globalsyms_create_symbol(p:TObject;arg:pointer); + procedure ExeSectionList_write_header(p:TObject;arg:pointer); + procedure ExeSectionList_calc_size(p:TObject;arg:pointer); + procedure ExeSectionList_write_data(p:TObject;arg:pointer); + procedure GenerateImports; + procedure GenerateExports; + procedure GenerateRelocs; + procedure ExeSectionList_pass2_header(p:TObject;arg:pointer); + protected + function writedata:boolean;override; + public + constructor create; override; + destructor destroy; override; + procedure MemPos_Header;override; + procedure DataPos_Header;override; + procedure fillNlmVersionHeader; + procedure GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);override; + procedure Order_End;override; + procedure MemPos_ExeSection(const aname:string);override; + procedure DataPos_ExeSection(const aname:string);override; + procedure NLMwriteString (const s : string; terminateWithZero : boolean); + procedure objNLMwriteString (const s : string; terminateWithZero : boolean); + procedure ParseScript (linkscript:TCmdStrList); override; + end; + + var + {for symbols defined in linker script. To generate a fixup we + need to know the segment (.text,.bss or .code) of the symbol + Pointer in list is used as TsecType + Filled by TInternalLinkerNetware.DefaultLinkScript } + nlmSpecialSymbols_Segments : TFPHashList; + + type + + TNLMCoffObjInput = class(TCoffObjInput) + constructor create;override; + end; + + TNLMCoffassembler = class(tinternalassembler) + constructor create(smart:boolean);override; + end; + + TNLMCoffObjData = class(TCoffObjData) + constructor create(const n:string);override; + end; + + TNLMCoffObjOutput = class(TCoffObjOutput) + constructor create(AWriter:TObjectWriter);override; + end; + + TNLMCoffObjSection = class(TCoffObjSection) + constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);override; + end; + +implementation + + uses +{$ifdef win32} + Windows, +{$endif win32} + SysUtils, + cutils,verbose,globals, + fmodule,aasmdata, + ogmap,export + ; + + +{**************************************************************************** + Helpers +****************************************************************************} +type + TStringObj = class (TObject) + fValue : string; + constructor create (value:string); + property value : string read fValue write fValue; + end; + + constructor TStringObj.create(value:string); + begin + inherited create; + fValue := value; + end; + + + +function SectionType (aName : string) : TSecType; +var s : string; + seg: ptruint; +begin + s := copy(aName,1,5); + if s = '.text' then result := Section_text else + if (s = '.data') or (copy(s,1,4)='.bss') then result := Section_data else + if s[1] <> '.' then + begin + seg := ptruint(nlmSpecialSymbols_Segments.Find(aName)); + if seg <> 0 then + result := TSecType(seg) + else + result := Section_other; + end else + result := Section_other; +end; + +{**************************************************************************** + TNLMexesection +****************************************************************************} + + + constructor TNLMExeSection.createnw(AList:TFPHashObjectList;const n:string); + begin + inherited create(AList,n); + end; + + +{**************************************************************************** + TNLMexeoutput +****************************************************************************} + + constructor TNLMexeoutput.create; + begin + inherited create; + CExeSection:=TNLMExeSection; + CObjData:=TNLMCoffObjData; + MaxMemPos:=$7FFFFFFF; + SectionMemAlign:=$0; + SectionDataAlign:=0; + RelocSection := true; // always needed for NLM's + nlmImports := TFPHashObjectList.create(true); + nlmImpNames := TFPHashObjectList.create(false); + NlmSymbols := TDynamicArray.create(4096); + FexportFunctionOffsets := TFPList.Create; + end; + + destructor TNLMexeoutput.destroy; + begin + if assigned(nlmImports) then + nlmImports.Free; + if assigned(nlmImpNames) then + nlmImpNames.Free; + if assigned(nlmSymbols) then + nlmSymbols.Free; + if assigned(FexportFunctionOffsets) then + FexportFunctionOffsets.Free; + inherited destroy; + end; + + procedure TNLMexeoutput.createNlm_symbol(const name:shortstring;value:longword;secType:TSecType); + var + b:byte; + begin + //Comment (V_Debug,'TNLMexeoutput.write_symbol '+name); + { type (0=.data,1=.code,2,..=????) 1 byte + addr 4 bytes + name LString 1+n bytes } + case secType of + Section_Text : b := 1; + Section_Data : b := 0 + else + exit; + end; + nlmSymbols.write(b,sizeof(b)); + assert (sizeof(value)<>4); + nlmSymbols.write(value,sizeof(value)); + nlmSymbols.write(name[0],length(name)+1); + inc(FNumDebugSymbols); + end; + + + procedure TNLMexeoutput.globalsyms_create_symbol(p:TObject;arg:pointer); + var + value : longword; + exesec : TExeSection; + i : integer; + secType : TsecType; + begin + if not assigned(texesymbol(p).objsymbol) then + internalerror(200603053); + with texesymbol(p).objsymbol do + begin + exesec:=TExeSection(objsection.exesection); + { There is no exesection defined for special internal symbols + like __image_base__ } + if assigned(exesec) then + begin + //secval:=exesec.secsymidx; + value:=address-exesec.mempos; + end + else + begin + value:=address; + end; + { reloctype address to the section in the executable } + secType := SectionType(objsection.Name); + if (secType = Section_Text) or (secType = Section_Data) then + begin + i := nlmImports.FindIndexOf(texesymbol(p).name); + if i < 0 then + createNlm_symbol(name,value,secType); + end; + end; + end; + + + +(* +function SecOpts(SecOptions:TObjSectionOptions):string; + begin + result := '['; + if oso_Data in SecOptions then result := result + 'oso_Data '; + { Is loaded into memory } + if oso_load in SecOptions then result := result + 'oso_load '; + { Not loaded into memory } + if oso_noload in SecOptions then result := result + 'oso_noload '; + { Read only } + if oso_readonly in SecOptions then result := result + 'oso_readonly '; + { Read/Write } + if oso_write in SecOptions then result := result + 'oso_write '; + { Contains executable instructions } + if oso_executable in SecOptions then result := result + 'oso_executable '; + { Never discard section } + if oso_keep in SecOptions then result := result + 'oso_keep '; + { Special common symbols } + if oso_common in SecOptions then result := result + 'oso_common '; + { Contains debug info and can be stripped } + if oso_debug in SecOptions then result := result + 'oso_debug '; + { Contains only strings } + if oso_strings in SecOptions then result := result + 'oso_strings '; + result := result + ']'; + end; +*) + + procedure TNLMexeoutput.ExeSectionList_calc_size(p:TObject;arg:pointer); + var + objsec : TObjSection; + i : longint; + begin + with texesection(p) do + begin + { don't write normal section if writing only debug info } + if (ExeWriteMode=ewm_dbgonly) and + not(oso_debug in SecOptions) then + exit; + + if oso_data in secoptions then + begin + inc (fSizeWoDebugSyms,(Align(fSizeWoDebugSyms,SectionDataAlign)-fSizeWoDebugSyms)); + for i:=0 to ObjSectionList.Count-1 do + begin + objsec:=TObjSection(ObjSectionList[i]); + if oso_data in objsec.secoptions then + begin + inc(fSizeWoDebugSyms,objsec.size); + inc(fSizeWoDebugSyms,objsec.dataalignbytes); + end; + end; + end; + end; + end; + + + + procedure TNLMexeoutput.ExeSectionList_write_Data(p:TObject;arg:pointer); + var + objsec : TObjSection; + i,j : longint; + b : byte; + begin + + with texesection(p) do + begin + { don't write normal section if writing only debug info } + if (ExeWriteMode=ewm_dbgonly) and + not(oso_debug in SecOptions) then + exit; + + if oso_data in secoptions then + begin + //if Align(FWriter.Size,SectionDataAlign)-FWriter.Size>0 then + // writeln (name,' align ',Align(FWriter.Size,SectionDataAlign)-FWriter.Size,' SectionDataAlign:',SectionDataAlign); + FWriter.Writezeros(Align(FWriter.Size,SectionDataAlign)-FWriter.Size); + for i:=0 to ObjSectionList.Count-1 do + begin + objsec:=TObjSection(ObjSectionList[i]); + if oso_data in objsec.secoptions then + begin + if assigned(exemap) then + if objsec.data.size > 0 then + exemap.Add(' 0x'+hexstr(objsec.DataPos,8)+': '+objsec.name); + //writeln (' ',objsec.name,' size:',objsec.size,' relocs:',objsec.ObjRelocations.count,' DataPos:',objsec.DataPos,' MemPos:',objsec.MemPos); + {for j := 0 to objsec.ObjRelocations.count-1 do + begin + objreloc := TObjRelocation(objsec.ObjRelocations[j]); + with objreloc do + begin + write(' reloc DataOffset: ',DataOffset,' OrgSize:',OrgSize,' typ:',typ); + if assigned(symbol) then + write(' Name: '#39,symbol.Name,#39' bind:',symbol.bind,' address:',symbol.address,' Size:',symbol.size); + writeln; + end; + end;} + if not assigned(objsec.data) then + internalerror(200603042); + if copy (objsec.Name,1,5) = '.text' then + begin // write NOP's instead of zero's for .text, makes disassemble possible + b := $90; // NOP + if objsec.DataAlignBytes > 0 then + for j := 1 to objsec.DataAlignBytes do + FWriter.write(b,1); + end else + FWriter.writezeros(objsec.dataalignbytes); + //if objsec.dataalignbytes>0 then + // writeln (' ',name,' alignbytes: ',objsec.dataalignbytes); + if objsec.DataPos<>FWriter.Size then + internalerror(200602251); + FWriter.writearray(objsec.data); + end else + begin + if assigned(exemap) then //TExeMap + exemap.Add(' skipping: '+objsec.name); + end; + end; + end; + end; + end; + + + function TNLMexeoutput.totalheadersize:longword; + var + varHdrSize, + optHdrSize, + hdrSize: longword; + begin + optHdrSize := 0; + inc(optHdrSize,2+length(nlmDescription)); + inc(optHdrSize,8); // Stacksize+reserved + inc(optHdrSize,NLM_OLD_THREAD_NAME_LENGTH); + inc(optHdrSize,2+length(nlmScreenname)); + inc(optHdrSize,2+length(nlmThreadname)); + + varHdrSize := 0; + if nwcopyright <> '' then + inc(varHdrSize,sizeof(NLM_COPYRIGHT_STAMP)+2+length(nlmCopyright)); + hdrSize := sizeof(nlm32_i386_external_fixed_header)+ + sizeof(nlm32_i386_external_extended_header)+ + sizeof(nlm32_i386_external_custom_header)+ + sizeof(nlm32_i386_external_version_header)+ // always + sizeof(nlm32_i386_external_cygnus_ext_header)+ // CyGnUsEx + varHdrSize+optHdrSize+ + 8; // empty stamp + result := hdrSize; + end; + + + procedure TNLMexeoutput.MemPos_Header; + begin + { calculate start positions after the headers } + currmempos:=0; + end; + + + procedure TNLMexeoutput.ExeSectionList_write_header(p:TObject;arg:pointer); + var + nam : string; + u32,al : longword; + alignAmount:longint; + begin + with tExeSection(p) do + begin + //comment (v_debug,'ExeSectionList_write_header: '+name); + nam := name; + alignAmount := 4 - ((length (nam) + 1) MOD 4); + FWriter.write(nam[1],length(nam)); + FWriter.WriteZeros(1+alignAmount); + al := 0; + // for .stab we have to ignore leading zeros due to alignment in file + if nam='.stab' then + if assigned(ObjSectionList[0]) then + al := TObjSection(ObjSectionList[0]).dataalignbytes; + u32 := dataPos+al; FWriter.write(u32,sizeof(u32)); + u32 := size-al; FWriter.write(u32,sizeof(u32)); + end; + end; + + + + procedure TNLMexeoutput.ExeSectionList_pass2_header(p:TObject;arg:pointer); + var len,alignAmount:longint; + begin + {list of sections, extension of binutils,CuStHeAd points to this list + The format of the section information is: + null terminated section name + zeroes to adjust to 4 byte boundary + 4 byte section data file pointer + 4 byte section size } + + with TExeSection(p) do + begin + alignAmount := 4 - ((length (Name) + 1) MOD 4); + len := length(name) + 1 + alignAmount + 8; + if ObjSectionList.Count>0 then + inc(len,TObjSection(ObjSectionList[0]).dataalignbytes); + inc(plongint(arg)^,len); + end; + end; + + procedure TNLMexeoutput.DataPos_Header; + begin + ExeSecsListSize:=0; + ExeSectionList.ForEachCall(@ExeSectionList_pass2_header,@ExeSecsListSize); + + headerAlignBytes := align(totalheadersize+ExeSecsListSize,16)-(totalheadersize+ExeSecsListSize); // align as in TObjData.sectiontype2align + currdatapos:=totalheadersize+ExeSecsListSize+headerAlignBytes; + end; + + + procedure TNLMexeoutput.fillNlmVersionHeader; + var + hour,min,sec,hsec,Year,Month,Day : word; + begin + DecodeTime(Time,hour,min,sec,hsec); + DecodeDate(Date,year,month,day); + nlmVersionHeader.stamp := NLM_VERSION_STAMP; + if nlmVersionHeader.year = 0 then + begin + nlmVersionHeader.year := Year; + nlmVersionHeader.month := Month; + nlmVersionHeader.day := Day; + end; + end; + + + + function TNLMexeoutput.writedata:boolean; + var + dummyLong : array[0..4] of char; + textExeSec, + dataExeSec, + bssExeSec, + relocsExeSec, + exportsExeSec, + importsExeSec, + xdcExeSec, + messagesExeSec, + helpExeSec, + customExeSec : TExeSection; + hassymbols : boolean; + nlmCygnusHeader : nlm32_i386_external_cygnus_ext_header; + ModuleName : string; + exesym : TExeSymbol; + expOffset : PtrUInt; + expAddr : longword; + i : integer; + + begin + result:=false; + textExeSec:=FindExeSection('.text'); + dataExeSec:=FindExeSection('.data'); + bssExeSec:=FindExeSection('.bss'); + relocsExeSec:=FindExeSection('.reloc'); + importsExeSec:=FindExeSection('.imports'); + exportsExeSec:=FindExeSection('.exports'); + xdcExeSec:=FindExeSection('.xdc'); + messagesExeSec:=FindExeSection('.messages'); + helpExeSec:=FindExeSection('.help'); + customExeSec:=FindExeSection('.custom'); + + // exported function need the upper bit in the address + // to be set (=CODE), do this here to avoid another + // reloc type. The ExportFunctionOffsets list was + // filled in GenerateExports + if FexportFunctionOffsets.Count>0 then + begin + if not assigned(exportsExeSec) then + internalerror(201103201); // we have to have a .export section + if not assigned(exportsExeSec.ObjSectionList[0]) then + internalerror(201103202); // nothing in the .exports section but we have data in FexportFunctionOffsets + for i := 0 to FexportFunctionOffsets.Count-1 do + begin + expOffset := PtrUint(FexportFunctionOffsets[i]); + if TObjSection(exportsExeSec.ObjSectionList[0]).Data.size < expOffset+3 then + internalerror(201103203); // offset in FexportFunctionOffsets out of range + with TObjSection(exportsExeSec.ObjSectionList[0]) do + begin // set the upper bit of address to indicate .text + Data.seek(expOffset); + Data.read(expAddr,4); + Data.seek(expOffset); + expAddr := expAddr or $80000000; + Data.write(expAddr,4); + end; + end; + end; + + if not assigned(TextExeSec) or + not assigned(RelocsExeSec) or + not assigned(DataExeSec) then + internalerror(200602231); // we have to have .data, .text and .reloc + { do we need to write symbols? } + hassymbols:=(ExeWriteMode=ewm_dbgonly) or + ( + (ExeWriteMode=ewm_exefull) and + not(cs_link_strip in current_settings.globalswitches) + ); + + { Initial header, will be updated later } + nlmHeader.signature := NLM_SIGNATURE; + nlmHeader.version := NLM_HEADER_VERSION; + moduleName := upperCase(current_module.exefilename^); + nlmHeader.moduleName := moduleName; + nlmHeader.codeImageOffset := TextExeSec.DataPos+TObjSection(TextExeSec.ObjSectionList[0]).dataalignbytes; // ??? may be that align has to be moved to fixups/imports + nlmHeader.codeImageSize := TextExeSec.Size; + nlmHeader.dataImageOffset := DataExeSec.DataPos; + nlmHeader.dataImageSize := DataExeSec.Size; + if assigned(BSSExeSec) then + nlmHeader.uninitializedDataSize:=BSSExeSec.Size; + if assigned(customExeSec) then + begin + nlmHeader.customDataOffset := customExeSec.DataPos; + nlmHeader.customDataSize := customExeSec.Size; + end; + if FNumModules > 0 then + begin + nlmHeader.moduleDependencyOffset := FindExeSection('.modules').DataPos+4; // 4 bytes dummy + nlmHeader.numberOfModuleDependencies := FNumModules; + end; + nlmHeader.relocationFixupOffset := relocsExeSec.DataPos; + nlmHeader.numberOfRelocationFixups := FNumRelocs; + nlmHeader.externalReferencesOffset := importsExeSec.DataPos+4; // 4 bytes dummy + nlmHeader.numberOfExternalReferences := FNumExternals; + if assigned(exportsExeSec) then + if exportsExeSec.Size>0 then + begin + nlmHeader.publicsOffset := exportsExeSec.dataPos; + nlmHeader.numberOfPublics := FnumExports; + end; + nlmHeader.codeStartOffset := EntrySym.Address; + + {exit function} + exesym:=texesymbol(ExeSymbolList.Find('_Stop')); + if assigned(exesym) then + nlmHeader.exitProcedureOffset := exesym.ObjSymbol.address; + + {check exit function} + exesym:=texesymbol(ExeSymbolList.Find('FPC_NW_CHECKFUNCTION')); + if assigned(exesym) then + nlmHeader.checkUnloadProcedureOffset := exesym.ObjSymbol.address; + + // calc file pos after all exesections + fSizeWoDebugSyms := totalheadersize + ExeSecsListSize + headerAlignBytes; + ExeSectionList.ForEachCall(@ExeSectionList_calc_size,nil); + + nlmExtHeader.stamp := NLM_MESSAGES_STAMP; + //extHeader.languageID // TODO: where to get this from ? + if assigned(messagesExeSec) then + begin + nlmExtHeader.messageFileOffset := messagesExeSec.DataPos; + nlmExtHeader.messageFileLength := messagesExeSec.Size; + end; + //nlmExtHeader.messageCount // TODO: how is messageCount set ? + if assigned(helpExeSec) then + begin + nlmExtHeader.helpFileOffset := helpExeSec.DataPos; + nlmExtHeader.helpFileLength := helpExeSec.Size; + end; + //nlmExtHeader.productID // TODO: were does this came from ? + if assigned(xdcExeSec) then + begin + nlmExtHeader.RPCDataOffset := xdcExeSec.DataPos; + nlmExtHeader.RPCDataLength := xdcExeSec.Size; + end; + + if hassymbols then + begin + nlmHeader.debugInfoOffset := fSizeWoDebugSyms; + ExeSymbolList.ForEachCall(@globalsyms_create_symbol,nil); + nlmHeader.numberOfDebugRecords := FNumDebugSymbols; + end; + + fillNlmVersionHeader; + FWriter.write(nlmHeader,sizeof(nlmHeader)); + + { variable header } + NLMWriteString(nlmDescription,true); + if stacksize < NLM_DEFAULT_STACKSIZE then stacksize := NLM_DEFAULT_STACKSIZE; + FWriter.Write(stacksize,4); + FWriter.writezeros(4); + dummyLong := ' LONG'; + FWriter.Write(dummyLong,sizeof(dummyLong)); // old thread name + NLMWriteString(nlmScreenname,true); + NLMWriteString(nlmThreadname,true); + + {version} + FWriter.Write(nlmVersionHeader,sizeof(nlmVersionHeader)); + {copyright} + if nlmCopyright <> '' then + begin + FWriter.write(NLM_COPYRIGHT_STAMP,sizeof(NLM_COPYRIGHT_STAMP)); + NLMWriteString(nlmCopyright,true); + end; + {messages} + FWriter.write(nlmExtHeader,sizeof(nlmExtHeader)); + + {custhead} + nlmCustHeader.stamp := NLM_CUSTOM_STAMP; + nlmCustHeader.dataLength := ExeSecsListSize; + nlmCustHeader.dataOffset := totalheadersize; + nlmCustHeader.hdrLength := $10; // why 16 ?, this is what binutils write + FWriter.write(nlmCustHeader,sizeof(nlmCustHeader)); + + {CyGnUsEx} + // bfd has a strange way to read the sections: + // the section directory is written under CuStHeAd + // when bfd finds the neader "CyGnUsEx", it uses the + // offset and size from CuStHeAd to read the section table + + nlmCygnusHeader.stamp := NLM_CYGNUS_STAMP; // CyGnUsEx + // ld writes some unknown values here, bfd irgnores the values at all + // lets write the offset and length of the segment table + nlmCygnusHeader.offset := nlmCustHeader.dataLength; + nlmCygnusHeader.length := nlmCustHeader.dataOffset; + FWriter.write(nlmCygnusHeader,sizeof(nlmCygnusHeader)); + FWriter.WriteZeros(8); // empty stamp + align next to 16 bytes + + if FWriter.Size<>totalheadersize then + internalerror(201103061); // headersize <> header written + + { Section headers, CuStHeAd points to this section, not needed by + netware. Can be used to find the section in the nlm file, binutils + will use this section } + ExeSectionList.ForEachCall(@ExeSectionList_write_header,nil); + FWriter.WriteZeros(headerAlignBytes); + if FWriter.Size<>totalheadersize+ExeSecsListSize+headerAlignBytes then + internalerror(201103062); + { Section data } + if assigned(exemap) then + begin + exemap.Add(''); + exemap.Add('NLM file offsets:'); + end; + ExeSectionList.ForEachCall(@ExeSectionList_write_data,nil); + + if hassymbols then + FWriter.writearray(NlmSymbols); // specific symbols for the internal netware debugger + + result:=true; + end; + + + + procedure TNLMexeoutput.GenerateLibraryImports(ImportLibraryList:TFPHashObjectList); + var + idata5objsection : TObjSection; + basedllname : string; + + function AddImport(const afuncname,amangledname:string; isvar:boolean):TObjSymbol; + var + secname:string; + begin + //Comment (V_Debug,'TNLMexeoutput.GenerateLibraryImports.AddImport '+afuncName); + result:=nil; + if assigned(exemap) then + exemap.Add(' Importing Function '+afuncname); + + if not isvar then + with internalobjdata do + begin + secname:=basedllname+'_i_'+amangledname; + idata5objsection:=createsection(sec_idata5, secname); + internalobjdata.SetSection(idata5objsection); + result:=internalobjdata.SymbolDefine('_'+amangledname,AB_IMPORT,AT_FUNCTION); + end; + end; + + var + i,j : longint; + ImportLibrary : TImportLibrary; + ImportSymbol : TImportSymbol; + exesym : TExeSymbol; + importAddressList : TFPObjectList; + begin + if ImportLibraryList.Count > 0 then + begin + {objsec:=}internalObjData.createsection('.imports',0,[oso_data,oso_keep]); + i := 0; + internalobjdata.writebytes(i,4); // dummy to avoid deletion + {objsec:=}internalObjData.createsection('.modules',0,[oso_data,oso_keep]); + internalobjdata.writebytes(i,4); // dummy to avoid deletion + end; + for i:=0 to ImportLibraryList.Count-1 do + begin + ImportLibrary:=TImportLibrary(ImportLibraryList[i]); + idata5objsection:=nil; + for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do + begin + ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]); + exesym:=TExeSymbol(ExeSymbolList.Find(ImportSymbol.MangledName)); + if assigned(exesym) and + (exesym.State<>symstate_defined) then + begin + basedllname:=ExtractFileName(ImportLibrary.Name); + exesym.objsymbol:=AddImport(ImportSymbol.Name,ImportSymbol.MangledName,ImportSymbol.IsVar); + exesym.State:=symstate_defined; + importAddressList := TFPObjectList.create(false); + nlmImports.Add(ImportSymbol.Name,importAddressList); + if pos('.',basedllname) = 0 then + basedllname := basedllname + '.nlm'; + nlmImpNames.Add(ImportSymbol.Name,TStringObj.create(lower(basedllname))); + end; + end; + end; + + PackUnresolvedExeSymbols('after DLL imports'); + GenerateExports; + end; + + + + procedure TNLMexeoutput.GenerateImports; + var + exesec, + impexesec : TExeSection; + objsec : TObjSection; + objreloc : TObjRelocation; + i,j,k : integer; + importAddressList : TFPObjectList; + name,mName : string; + b : byte; + modules : string; + modName : TStringObj; + begin + if FImportsGenerated then exit; + FImportsGenerated := true; + impexesec:=FindExeSection('.imports'); + if impexesec=nil then exit; + + for i:=0 to ExeSectionList.Count-1 do + begin + exesec:=TExeSection(ExeSectionList[i]); + for j:=0 to exesec.ObjSectionList.count-1 do + begin + objsec:=TObjSection(exesec.ObjSectionList[j]); + if j=0 then + begin + exesec.DataPos:=objSec.DataPos; + exesec.MemPos:=objSec.MemPos; + end; + if (copy(objsec.name,1,5) <> '.text') and (copy(objsec.name,1,4) <> '.bss') and (copy(objsec.name,1,5) <> '.data') then + continue; + for k:=0 to objsec.ObjRelocations.Count-1 do + begin + objreloc := TObjRelocation(objsec.ObjRelocations[k]); + if assigned(objreloc.symbol) then + begin + //writeln (objreloc.symbol.name,' ',objreloc.symbol.bind); + if objreloc.symbol.bind = AB_IMPORT then + begin + importAddressList := TFPObjectList(nlmImports.Find(objreloc.symbol.name)); + if assigned(importAddressList) then + begin + objreloc.objsection := objsec; // points to idata5 + importAddressList.Add(objreloc); + end else + begin + comment(v_error,objreloc.symbol.name+' is external but not defined in nlm imports'); + end; + end; + end + end; + end; + end; + + modules := ''; + for i := 0 to nlmImports.count-1 do + begin + importAddressList := TFPObjectList(nlmImports.Items[i]); + if importAddressList.Count > 0 then + begin + name := nlmImports.NameOfIndex(i); + + // find the module to be imported and add it to the list + // of modules to be auto loaded + modName := TStringObj(nlmImpNames.Find(name)); + if assigned(modName) then + begin + mName := modName.Value; + if mName <> '' then + if copy(mName,1,1) <> '!' then // special, with ! only the imp will be included but no module is autoloaded, needed i.e. for netware.imp + begin + if pos(mName+';',modules) < 1 then + begin + modules := modules + mName + ';'; + inc(FNumModules); + end; + end; + end; + internalobjdata.SetSection(TObjSection(impexesec.ObjSectionList[0])); + objNLMwriteString (name,false); // name of symbol + k := importAddressList.Count; + internalobjdata.writebytes(k,sizeof(k)); // number of references + inc(FNumExternals); + for j := 0 to importAddressList.Count-1 do + begin + objreloc := TObjRelocation(importAddressList[j]); + objsec := objreloc.objsection; + if oso_executable in objreloc.objsection.SecOptions then + begin + if objreloc.typ <> RELOC_RELATIVE then comment(v_error,'reference to external symbols must be RELOC_RELATIVE'); + // TODO: how to check if size is 4 ???? + + k := objsec.MemPos + objreloc.DataOffset; + k := k or $40000000; + // TODO: data|code if we support importing data symbols + // i do not know if this is possible with netware + internalobjdata.writebytes(k,sizeof(k)); // address + + // the netware loader requires an offset at the import address + // for call = E8 this is -4 + // TODO: how can we check the needed offset ?? + if objreloc.DataOffset > 0 then + begin + objsec.Data.seek(objreloc.DataOffset-1); + objsec.data.read(b,1); + if b <> $E8 then + comment(v_error,'no rcall (E8) before imported symbol target address'); + k := -4; + objsec.Data.write(k,sizeof(k)); + end else + begin + objsec.Data.seek(objreloc.DataOffset); + k := 0; + objsec.Data.write(k,sizeof(k)); + end; + objreloc.typ := RELOC_NONE; // to avoid that TCoffObjSection.fixuprelocs changes the address again + end else + comment(v_error,'Importing of symbols only supported for .text'); + end; + end; + end; + + exesec := FindExeSection('.modules'); + if not assigned(exesec) then internalerror(201103272); // exe section .modules does not exist ??? + internalobjdata.SetSection(TObjSection(exesec.ObjSectionList[0])); + for i := 1 to FNumModules do + begin + name := GetToken(modules,';'); + objNLMwriteString (name,false); + end; + end; + + + procedure TNLMexeoutput.GenerateExports; + var + hp : texported_item; { for exports } + len : byte; + addr: longword; + exesym : texesymbol; + begin + internalObjData.createsection('.exports',0,[oso_data,oso_keep]); + {name LString 1+n bytes + addr 4 bytes + addr and $80000000 > 0 -> .text else .data} + hp:=texported_item(current_module._exports.first); + if assigned(hp) then + if assigned(exemap) then + exemap.Add(''); + while assigned(hp) do + begin + { Export the Symbol } + if assigned(exemap) then + exemap.Add(' Exporting Function '+hp.sym.prettyname+' as '+hp.name^); + len := length(hp.name^); + internalobjdata.writebytes(len,1); + internalobjdata.writebytes(hp.name^[1],len); + exesym:=texesymbol(ExeSymbolList.Find(hp.sym.prettyname)); + if not assigned(exesym) then + begin + comment(v_error,'exported symbol '+hp.sym.prettyname+' not found'); + exit; + end; + // for exported functions we have to set the upper bit + // this will be done in .writedata + if not hp.is_var then + FexportFunctionOffsets.Add(pointer(PtrUInt(internalobjdata.CurrObjSec.Size))); + internalobjdata.writereloc(0,4,exesym.ObjSymbol,RELOC_ABSOLUTE32); + + addr := 0; + internalobjdata.writebytes(addr,4); + inc(FnumExports); + hp:=texported_item(hp.next); + end; + end; + + procedure TNLMexeoutput.GenerateRelocs; + + var + exesec : TExeSection; + objsec : TObjSection; + objreloc : TObjRelocation; + i,j,k : longint; + offset : longword; + inSec,toSec : TsecType; + targetSectionName : string; + + begin + if not RelocSection or FRelocsGenerated then + exit; + exesec:=FindExeSection('.reloc'); + if exesec=nil then + exit; + objsec:=internalObjData.createsection('.reloc',0,exesec.SecOptions+[oso_data]); + exesec.AddObjSection(objsec); + for i:=0 to ExeSectionList.Count-1 do + begin + exesec:=TExeSection(ExeSectionList[i]); + for j:=0 to exesec.ObjSectionList.count-1 do + begin + objsec:=TObjSection(exesec.ObjSectionList[j]); + //writeln ('Relocs for ',exesec.name,' - ',objsec.name); + { create relocs only for sections which are loaded in memory } + if not (oso_load in objsec.SecOptions) then + continue; + { create relocs only for .text and .data } + inSec := SectionType (objsec.name); + if (inSec <> Section_Text) and (inSec <> Section_Data) then + continue; + + for k:=0 to objsec.ObjRelocations.Count-1 do + begin + objreloc:=TObjRelocation(objsec.ObjRelocations[k]); + if objreloc.typ <> RELOC_ABSOLUTE then + continue; + offset:=objsec.MemPos+objreloc.dataoffset; + targetSectionName := ''; + if objreloc.symbol <> nil then + begin + // writeln (' MemPos',objsec.MemPos, + // ' dataOfs:',objreloc.dataoffset,' ',objsec.name, + // ' objreloc.symbol: ',objreloc.symbol.name, + // ' objreloc.symbol.objsection.name: ',objreloc.symbol.objsection.name, + // ' ',objreloc.symbol.Typ,' ',objrel + // oc.symbol.bind,' ',objreloc.Typ); + if objreloc.symbol.objsection.name[1] <> '.' then + targetSectionName := objreloc.symbol.name // specials like __bss_start__ + else // dont use objsection.name because it begins with * + targetSectionName := copy(objreloc.symbol.objsection.name,1,5); // all others begin with .segment, we only have to check for .text, .data or .bss + end else + internalerror(2011030603); + + toSec := SectionType(targetSectionName); + + if (toSec = Section_Text) or (toSec = Section_Data) then + begin + if (inSec = Section_text) then offset := offset or $40000000; + if (toSec = Section_text) then offset := offset or $80000000; + internalObjData.writebytes(offset,4); + inc(FNumRelocs); + end; + end; + end; + end; + FRelocsGenerated:=true; + end; + + + procedure TNLMexeoutput.Order_End; + var + exesec : TExeSection; + begin + inherited; + exesec:=FindExeSection('.reloc'); + if exesec=nil then + exit; + exesec.SecOptions:=exesec.SecOptions + [oso_Data,oso_keep,oso_load]; + end; + + + procedure TNLMexeoutput.MemPos_ExeSection(const aname:string); + begin + if aname='.reloc' then + GenerateRelocs; + if aname='.imports' then + GenerateImports; + if aname='.data' then + currMemPos := 0; // both, data and code in the nlm have a start offset of 0 + inherited; + end; + + + procedure TNLMexeoutput.DataPos_ExeSection(const aname:string); + begin + inherited; + end; + + + procedure TNLMexeoutput.NLMwriteString (const s : string; terminateWithZero : boolean); + var len : byte; + begin + if length(s) > 254 then len := 254 else len := length(s); + FWriter.Write(len,1); + if len > 0 then + FWriter.write(s[1],len); + if terminateWithZero then + FWriter.writeZeros(1); + end; + + + procedure TNLMexeoutput.objNLMwriteString (const s : string; terminateWithZero : boolean); + var len : byte; + begin + if length(s) > 254 then len := 254 else len := length(s); + Internalobjdata.writebytes(len,1); + if len > 0 then + Internalobjdata.writebytes(s[1],len); + if terminateWithZero then + begin + len := 0; + Internalobjdata.writebytes(s[1],len); + end; + end; + + { parse netware specific linker options } + procedure TNLMexeoutput.ParseScript (linkscript:TCmdStrList); + var + hp : TCmdStrListItem; + opt,keyword,s : string; + i : integer; + + function toInteger(s:string; min,max:integer; var res:integer):boolean; + var + code:word; + begin + result := false; + val (s,res,code); + if code<>0 then exit; + if (res < min) or (res > max) then exit; + result := true; + end; + + + procedure loadFile (const secName, fileName, Desc : string); + var + fileBuf : array [0..4095] of char; + bytesRead : longint; + fileH : THandle; + fn : TCmdStr; + + begin + fn := fileName; + if not fileExists(fn) then + if not unitsearchpath.FindFile(fileName,true,fn) then + begin + comment(v_error,'can not find '+desc+' file '+fileName); + exit; + end; + fileH := fileOpen (fn,fmOpenRead); + if fileH = THandle(-1) then + begin + comment(v_error,'can not open '+desc+' file '+fn); + exit; + end; + { load file into section } + internalObjData.createsection(secName,0,[oso_data,oso_keep]); + repeat + bytesRead := fileRead(fileH,fileBuf,sizeof(fileBuf)); + if bytesRead > 0 then + internalobjdata.writebytes(fileBuf,bytesRead); + until bytesRead < sizeof(fileBuf); + fileClose(fileH); + end; + + begin + hp:=TCmdStrListItem(linkscript.first); + while assigned(hp) do + begin + opt:=hp.str; + if (opt='') or (opt[1]='#') then + continue; + keyword:=Upper(GetToken(opt,' ')); + if keyword = 'AUTOUNLOAD' then + begin + nlmHeader.flags:=nlmHeader.flags or NLM_FLAGS_AUTOUNLOAD; + end else + if keyword = 'COPYRIGHT' then + begin + nlmCopyright := GetToken(opt,' '); + end else + if keyword = 'CUSTOM' then + begin + loadFile ('.custom',GetToken(opt,' '),'custom data'); + end; + if keyword = 'DATE' then // month day 4-digit-year + begin + if not toInteger(GetToken(opt,' '),1,12,i) then comment(v_error,'DATE: invalid month') + else nlmVersionHeader.month := i; + if not toInteger(GetToken(opt,' '),1,31,i) then comment(v_error,'DATE: invalid day') + else nlmVersionHeader.day := i; + if not toInteger(GetToken(opt,' '),1900,3000,i) then comment(v_error,'DATE: invalid year') + else nlmVersionHeader.year := i; + end else + if keyword = 'DEBUG' then + begin + // ignore + end else + if keyword = 'DESCRIPTION' then + begin + nlmDescription := GetToken(opt,' '); + if length (nlmDescription) > NLM_MAX_DESCRIPTION_LENGTH then + nlmDescription := copy (nlmDescription,1,NLM_MAX_DESCRIPTION_LENGTH); + end else + if keyword = 'FLAG' then + begin + s := upper(GetToken(opt,' ')); + if (not toInteger(GetToken(opt,' '),1,$FFFFFFF,i)) or ((s <> 'ON') and (S <> 'OFF')) then comment(v_error,'FLAG: invalid') else + if (s='ON') then + nlmHeader.flags:=nlmHeader.flags or i else + nlmHeader.flags:=nlmHeader.flags and ($FFFFFFF-i); + end else + if keyword = 'HELP' then + begin + loadFile ('.help',GetToken(opt,' '),'help'); + end else + if keyword = 'MESSAGES' then + begin + loadFile ('.messages',GetToken(opt,' '),'message'); + end else + if keyword = 'MULTIPLE' then + begin + nlmHeader.flags:=nlmHeader.flags or NLM_FLAGS_MULTILOAD; + end else + if keyword = 'OS_DOMAIN' then + begin + nlmHeader.flags:=nlmHeader.flags or NLM_FLAGS_OSDOMAIN; + end else + if keyword = 'PSEUDOPREEMPTION' then + begin + nlmHeader.flags:=nlmHeader.flags or NLM_FLAGS_PSEUDOPREEMPTION; + end else + if keyword = 'REENTRANT' then + begin + nlmHeader.flags:=nlmHeader.flags or NLM_FLAGS_REENTRANT; + end else + if keyword = 'SCREENNAME' then + begin + nlmScreenname := GetToken(opt,' '); + if length(nlmScreenname) > NLM_MAX_SCREEN_NAME_LENGTH then + nlmScreenName := copy (nlmScreenName,1,NLM_MAX_SCREEN_NAME_LENGTH); + end else + if (keyword = 'STACK') or (keyword = 'STACKSIZE') then + begin + if (not toInteger(GetToken(opt,' '),1,$FFFFFFF,i)) then comment(v_error,'invalid stacksize') else + stacksize := i; + end else + if keyword = 'SYNCHRONIZE' then + begin + nlmHeader.flags:=nlmHeader.flags or NLM_FLAGS_SYNCHRONIZE; + end else + if keyword = 'THREADNAME' then + begin + nlmThreadname := GetToken(opt,' '); + if length(nlmThreadname) > NLM_MAX_THREAD_NAME_LENGTH then + nlmThreadname := copy (nlmThreadname,1,NLM_MAX_THREAD_NAME_LENGTH); + end else + if keyword = 'TYPE' then + begin + if (not toInteger(GetToken(opt,' '),1,16,i)) then comment(v_error,'invalid TYPE') else + nlmHeader.moduleType := i; // TODO: set executable extension (.DSK, .LAN, ...) + end else + if keyword = 'VERSION' then + begin + if (not toInteger(GetToken(opt,' '),0,$FFFFFFF,i)) then comment(v_error,'invalid major version') else + nlmVersionHeader.majorVersion := i; + if (not toInteger(GetToken(opt,' '),0,99,i)) then comment(v_error,'invalid minor version') else + nlmVersionHeader.minorVersion := i; + if (not toInteger(GetToken(opt,' '),0,$FFFFFFF,i)) then comment(v_error,'invalid minor version') else + if i > 26 then + nlmVersionHeader.revision := 0 else + nlmVersionHeader.revision := i; + end else + if keyword = 'XDCDATA' then + begin + loadFile ('.xdc',GetToken(opt,' '),'xdc'); + end; + { TODO: check for unknown options. This means all handled option + (also in link.pas) have to be flagged if processed } + hp:=TCmdStrListItem(hp.next); + end; + end; + +{**************************************************************************** + TNLMCoffObjData +****************************************************************************} + + constructor TNLMCoffObjData.create(const n:string); + begin + inherited createcoff(n,true,TNLMCoffObjSection); + end; + + +{**************************************************************************** + TNLMoffObjSection +****************************************************************************} + + constructor TNLMCoffObjSection.create(AList:TFPHashObjectList;const aname:string;aalign:shortint;aoptions:TObjSectionOptions); + begin + inherited create(alist,aname,aalign,aoptions); + end; + + + constructor TNLMCoffObjOutput.create(AWriter:TObjectWriter); + begin + // ?????? + // if win32=false, .stabs and .stabstr will be written without oso_debug + // Without oso_debug the sections will be removed by the linker + inherited createcoff(AWriter,{win32}true); + cobjdata:=TNLMCoffObjData; + end; + +{**************************************************************************** + TDJCoffAssembler +****************************************************************************} + + constructor TNLMCoffAssembler.Create(smart:boolean); + begin + inherited Create(smart); + CObjOutput:=TNLMCoffObjOutput; + end; + + constructor TNLMCoffObjInput.create; + begin + inherited createcoff(true); + cobjdata:=TNLMCoffObjData; + end; + +{***************************************************************************** + Initialize +*****************************************************************************} +const + as_i386_nlmcoff_info : tasminfo = + ( + id : as_i386_nlmcoff; + idtxt : 'NLMCOFF'; + asmbin : ''; + asmcmd : ''; + supported_targets : [system_i386_Netware,system_i386_netwlibc]; + flags : [af_outputbinary,af_smartlink_sections]; + labelprefix : '.L'; + comment : ''; + ); + + + +initialization +{$ifdef i386} + RegisterAssembler(as_i386_nlmcoff_info,TNLMCoffAssembler); +{$endif i386} +end. diff --git a/closures/compiler/optbase.pas b/closures/compiler/optbase.pas new file mode 100644 index 0000000000..c37c5aa974 --- /dev/null +++ b/closures/compiler/optbase.pas @@ -0,0 +1,216 @@ +{ + Basic node optimizer stuff + + Copyright (c) 2007 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 optbase; + +{$i fpcdefs.inc} + + interface + + uses + globtype; + + type + { this should maybe replaced by a spare set, + using a dyn. array makes assignments cheap } + tdfaset = array of byte; + PDFASet = ^TDFASet; + + toptinfo = record + { index of the current node inside the dfa sets, aword(-1) if no entry } + index : aword; + { dfa } + def : tdfaset; + use : tdfaset; + life : tdfaset; + defsum : tdfaset; + avail : tdfaset; + end; + + poptinfo = ^toptinfo; + + { basic set operations for dfa sets } + + { add e to s } + procedure DFASetInclude(var s : tdfaset;e : integer); + + { add s to d } + procedure DFASetIncludeSet(var d : tdfaset;const s : tdfaset); + + { remove e from s } + procedure DFASetExclude(var s : tdfaset;e : integer); + + { test if s contains e } + function DFASetIn(const s : tdfaset;e : integer) : boolean; + + { d:=s1+s2; } + procedure DFASetUnion(var d : tdfaset;const s1,s2 : tdfaset); + + { d:=s1*s2; } + procedure DFASetIntersect(var d : tdfaset;const s1,s2 : tdfaset); + + { d:=s1-s2; } + procedure DFASetDiff(var d : tdfaset;const s1,s2 : tdfaset); + + { s1<>s2; } + function DFASetNotEqual(const s1,s2 : tdfaset) : boolean; + + { output DFA set } + procedure PrintDFASet(var f : text;s : TDFASet); + + implementation + + uses + cutils; + + procedure DFASetInclude(var s : tdfaset;e : integer); + var + e8 : Integer; + begin + e8:=e div 8; + if e8>high(s) then + SetLength(s,e8+1); + s[e8]:=s[e8] or (1 shl (e mod 8)); + end; + + + procedure DFASetIncludeSet(var d : tdfaset;const s : tdfaset); + var + i : integer; + begin + if length(s)>length(d) then + SetLength(d,length(s)); + for i:=0 to high(s) do + d[i]:=d[i] or s[i]; + end; + + + procedure DFASetExclude(var s : tdfaset;e : integer); + var + e8 : Integer; + begin + e8:=e div 8; + if e8<=high(s) then + s[e8]:=s[e8] and not(1 shl (e mod 8)); + end; + + + function DFASetIn(const s : tdfaset;e : integer) : boolean; + var + e8 : Integer; + begin + e8:=e div 8; + if e8<=high(s) then + result:=(s[e8] and (1 shl (e mod 8)))<>0 + else + result:=false; + end; + + + procedure DFASetUnion(var d : tdfaset;const s1,s2 : tdfaset); + var + i : integer; + begin + SetLength(d,max(Length(s1),Length(s2))); + for i:=0 to min(high(s1),high(s2)) do + d[i]:=s1[i] or s2[i]; + if high(s1)<high(s2) then + for i:=high(s1)+1 to high(s2) do + d[i]:=s2[i] + else + for i:=high(s2)+1 to high(s1) do + d[i]:=s1[i]; + end; + + + procedure DFASetIntersect(var d : tdfaset;const s1,s2 : tdfaset); + var + i : integer; + begin + SetLength(d,min(Length(s1),Length(s2))); + for i:=0 to high(d) do + d[i]:=s1[i] and s2[i]; + end; + + + procedure DFASetDiff(var d : tdfaset;const s1,s2 : tdfaset); + var + i : integer; + begin + SetLength(d,length(s1)); + for i:=0 to high(d) do + if i>high(s2) then + d[i]:=s1[i] + else + d[i]:=s1[i] and not(s2[i]); + end; + + + function DFASetNotEqual(const s1,s2 : tdfaset) : boolean; + var + i : integer; + begin + result:=true; + { one set could be larger than the other } + if length(s1)>length(s2) then + begin + for i:=0 to high(s2) do + if s1[i]<>s2[i] then + exit; + { check remaining part being zero } + for i:=length(s2) to high(s1) do + if s1[i]<>0 then + exit; + end + else + begin + for i:=0 to high(s1) do + if s1[i]<>s2[i] then + exit; + { check remaining part being zero } + for i:=length(s1) to high(s2) do + if s2[i]<>0 then + exit; + end; + result:=false; + end; + + + procedure PrintDFASet(var f : text;s : TDFASet); + var + i : integer; + first : boolean; + begin + first:=true; + for i:=0 to Length(s)*8 do + begin + if DFASetIn(s,i) then + begin + if not(first) then + write(f,','); + write(f,i); + first:=false; + end; + end; + end; + + +end. diff --git a/closures/compiler/optcse.pas b/closures/compiler/optcse.pas new file mode 100644 index 0000000000..592c7cd28a --- /dev/null +++ b/closures/compiler/optcse.pas @@ -0,0 +1,335 @@ +{ + Common subexpression elimination on base blocks + + Copyright (c) 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 optcse; + +{$i fpcdefs.inc} + +{ $define csedebug} +{ $define csestats} + + interface + + uses + node; + + { + the function creates non optimal code so far: + - call para nodes are cse barriers because they can be reordered and thus the + temp. creation can be done too late + - cse's in chained expressions are not recognized: the common subexpression + in (a1 and b and c) vs. (a2 and b and c) is not recognized because there is no common + subtree b and c + - the cse knows nothing about register pressure. In case of high register pressure, cse might + have a negative impact + - assignment nodes are currently cse borders: things like a[i,j]:=a[i,j]+1; are not improved + - the list of cseinvariant node types and inline numbers is not complete yet + + Further, it could be done probably in a faster way though the complexity can't probably not reduced + } + function do_optcse(var rootnode : tnode) : tnode; + + implementation + + uses + globtype, + cclasses, + verbose, + nutils, + procinfo, + nbas,nld,ninl,ncal,ncnv,nadd, + pass_1, + symconst,symtype,symdef,symsym, + defutil, + optbase; + + const + cseinvariant : set of tnodetype = [addn,muln,subn,divn,slashn,modn,andn,orn,xorn,notn,vecn, + derefn,equaln,unequaln,ltn,gtn,lten,gten,typeconvn,subscriptn, + inn,symdifn,shrn,shln,ordconstn,realconstn,unaryminusn,pointerconstn,stringconstn,setconstn, + isn,asn,starstarn,nothingn,temprefn,loadparentfpn {,callparan}]; + + function searchsubdomain(var n:tnode; arg: pointer) : foreachnoderesult; + begin + if (n.nodetype in cseinvariant) or + ((n.nodetype=inlinen) and + (tinlinenode(n).inlinenumber in [in_assigned_x]) + ) or + ((n.nodetype=loadn) and + not((tloadnode(n).symtableentry.typ in [staticvarsym,localvarsym,paravarsym]) and + (vo_volatile in tabstractvarsym(tloadnode(n).symtableentry).varoptions)) + ) then + result:=fen_true + else + begin + pboolean(arg)^:=false; + result:=fen_norecurse_true; + end; + end; + + type + tlists = record + nodelist : tfplist; + locationlist : tfplist; + equalto : tfplist; + refs : tfplist; + avail : TDFASet; + end; + + plists = ^tlists; + + { collectnodes needs the address of itself to call foreachnodestatic, + so we need a wrapper because @<func> inside <func doesn't work } + + function collectnodes(var n:tnode; arg: pointer) : foreachnoderesult;forward; + + function collectnodes2(var n:tnode; arg: pointer) : foreachnoderesult; + begin + result:=collectnodes(n,arg); + end; + + function collectnodes(var n:tnode; arg: pointer) : foreachnoderesult; + var + i,j : longint; + begin + result:=fen_false; + { don't add the tree below an untyped const parameter: there is + no information available that this kind of tree actually needs + to be addresable, this could be improved } + if ((n.nodetype=callparan) and + (tcallparanode(n).left.resultdef.typ=formaldef) and + (tcallparanode(n).parasym.varspez=vs_const)) then + begin + result:=fen_norecurse_false; + exit; + end; + { so far, we can handle only nodes being read } + if (n.flags*[nf_write,nf_modify]=[]) and + { node possible to add? } + assigned(n.resultdef) and + (tstoreddef(n.resultdef).is_intregable or tstoreddef(n.resultdef).is_fpuregable) and + { is_int/fpuregable allows arrays and records to be in registers, cse cannot handle this } + not(n.resultdef.typ in [arraydef,recorddef]) and + { same for voiddef } + not(is_void(n.resultdef)) and + { adding tempref nodes is worthless but their complexity is probably <= 1 anyways } + not(n.nodetype in [temprefn]) and + + { node worth to add? + + We consider almost every node because even loading a variables from + a register instead of memory is more beneficial. This behaviour should + not increase register pressure because if a variable is already + in a register, the reg. allocator can merge the nodes. If a variable + is loaded from memory, loading this variable and spilling another register + should not add a speed penalty. + } + { + load nodes are not considered if they load para or local symbols from the + current stack frame, those are in registers anyways if possible + } + (not(n.nodetype=loadn) or + not(tloadnode(n).symtableentry.typ in [paravarsym,localvarsym]) or + (tloadnode(n).symtable.symtablelevel<>current_procinfo.procdef.parast.symtablelevel) + ) and + + { + Const nodes however are only considered if their complexity is >1 + This might be the case for the risc architectures if they need + more than one instruction to load this particular value + } + (not(is_constnode(n)) or (node_complexity(n)>1)) then + begin + plists(arg)^.nodelist.Add(n); + plists(arg)^.locationlist.Add(@n); + plists(arg)^.refs.Add(nil); + plists(arg)^.equalto.Add(pointer(-1)); + + DFASetInclude(plists(arg)^.avail,plists(arg)^.nodelist.count-1); + + for i:=0 to plists(arg)^.nodelist.count-2 do + begin + if tnode(plists(arg)^.nodelist[i]).isequal(n) and DFASetIn(plists(arg)^.avail,i) then + begin + { use always the first occurence } + if plists(arg)^.equalto[i]<>pointer(-1) then + plists(arg)^.equalto[plists(arg)^.nodelist.count-1]:=plists(arg)^.equalto[i] + else + plists(arg)^.equalto[plists(arg)^.nodelist.count-1]:=pointer(ptrint(i)); + plists(arg)^.refs[i]:=pointer(plists(arg)^.refs[i])+1; + break; + end; + end; + + { boolean and/or require a special handling: after evaluating the and/or node, + the expressions of the right side might not be available due to short boolean + evaluation, so after handling the right side, mark those expressions + as unavailable } + if (n.nodetype in [orn,andn]) and is_boolean(taddnode(n).left.resultdef) then + begin + foreachnodestatic(pm_postprocess,taddnode(n).left,@collectnodes2,arg); + j:=plists(arg)^.nodelist.count; + foreachnodestatic(pm_postprocess,taddnode(n).right,@collectnodes2,arg); + for i:=j to plists(arg)^.nodelist.count-1 do + DFASetExclude(plists(arg)^.avail,i); + result:=fen_norecurse_false; + end; + end; + end; + + + function searchcsedomain(var n: tnode; arg: pointer) : foreachnoderesult; + var + csedomain : boolean; + lists : tlists; + templist : tfplist; + i : longint; + def : tstoreddef; + nodes : tblocknode; + creates, + statements : tstatementnode; + hp : ttempcreatenode; + begin + result:=fen_false; + if n.nodetype in cseinvariant then + begin + csedomain:=true; + foreachnodestatic(pm_postprocess,n,@searchsubdomain,@csedomain); + { found a cse domain } + if csedomain then + begin + statements:=nil; + result:=fen_norecurse_true; +{$ifdef csedebug} + writeln('============ cse domain =================='); + printnode(output,n); + writeln('Complexity: ',node_complexity(n)); +{$endif csedebug} + lists.nodelist:=tfplist.create; + lists.locationlist:=tfplist.create; + lists.equalto:=tfplist.create; + lists.refs:=tfplist.create; + foreachnodestatic(pm_postprocess,n,@collectnodes,@lists); + + templist:=tfplist.create; + templist.count:=lists.nodelist.count; + + { check all nodes if one is used more than once } + for i:=0 to lists.nodelist.count-1 do + begin + { current node used more than once? } + if assigned(lists.refs[i]) then + begin + if not(assigned(statements)) then + begin + nodes:=internalstatements(statements); + addstatement(statements,internalstatements(creates)); + end; + + def:=tstoreddef(tnode(lists.nodelist[i]).resultdef); + templist[i]:=ctempcreatenode.create_value(def,def.size,tt_persistent, + def.is_intregable or def.is_fpuregable,tnode(lists.nodelist[i])); + { make debugging easier and set temp. location to the original location } + tnode(templist[i]).fileinfo:=tnode(lists.nodelist[i]).fileinfo; + + addstatement(creates,tnode(templist[i])); + { make debugging easier and set temp. location to the original location } + creates.fileinfo:=tnode(lists.nodelist[i]).fileinfo; + + hp:=ttempcreatenode(templist[i]); + do_firstpass(tnode(hp)); + templist[i]:=hp; + + pnode(lists.locationlist[i])^:=ctemprefnode.create(ttempcreatenode(templist[i])); + { make debugging easier and set temp. location to the original location } + pnode(lists.locationlist[i])^.fileinfo:=tnode(lists.nodelist[i]).fileinfo; + + do_firstpass(pnode(lists.locationlist[i])^); +{$ifdef csedebug} + printnode(output,statements); +{$endif csedebug} + end + { current node reference to another node? } + else if lists.equalto[i]<>pointer(-1) then + begin +{$if defined(csedebug) or defined(csestats)} + printnode(output,tnode(lists.nodelist[i])); + writeln(i,' equals ',ptrint(lists.equalto[i])); + printnode(output,tnode(lists.nodelist[ptrint(lists.equalto[i])])); +{$endif defined(csedebug) or defined(csestats)} + templist[i]:=templist[ptrint(lists.equalto[i])]; + pnode(lists.locationlist[i])^:=ctemprefnode.create(ttempcreatenode(templist[ptrint(lists.equalto[i])])); + + { make debugging easier and set temp. location to the original location } + pnode(lists.locationlist[i])^.fileinfo:=tnode(lists.nodelist[i]).fileinfo; + + do_firstpass(pnode(lists.locationlist[i])^); + end; + end; + { clean up unused trees } + for i:=0 to lists.nodelist.count-1 do + if lists.equalto[i]<>pointer(-1) then + tnode(lists.nodelist[i]).free; +{$ifdef csedebug} + writeln('nodes: ',lists.nodelist.count); + writeln('=========================================='); +{$endif csedebug} + lists.nodelist.free; + lists.locationlist.free; + lists.equalto.free; + lists.refs.free; + templist.free; + + if assigned(statements) then + begin + { call para nodes need a special handling because + they can be only children nodes of call nodes + so the initialization code is inserted below the + call para node + } + if n.nodetype=callparan then + begin + addstatement(statements,tcallparanode(n).left); + tcallparanode(n).left:=nodes; + do_firstpass(tcallparanode(n).left); + end + else + begin + addstatement(statements,n); + n:=nodes; + do_firstpass(n); + end; +{$ifdef csedebug} + printnode(output,nodes); +{$endif csedebug} + end; + end + end; + end; + + + function do_optcse(var rootnode : tnode) : tnode; + begin + foreachnodestatic(pm_postprocess,rootnode,@searchcsedomain,nil); + result:=nil; + end; + +end. diff --git a/closures/compiler/optdead.pas b/closures/compiler/optdead.pas new file mode 100644 index 0000000000..080f7dcc2d --- /dev/null +++ b/closures/compiler/optdead.pas @@ -0,0 +1,424 @@ +{ + Copyright (c) 2008 by Jonas Maebe + + Optimization information related to dead code removal + + 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 optdead; + +{$i fpcdefs.inc} + + interface + + uses + globtype, + cclasses, + symtype, + wpobase; + + type + + { twpodeadcodeinfo } + + twpodeadcodeinfo = class(twpodeadcodehandler) + private + { hashtable of symbols which are live } + fsymbols : tfphashlist; + + procedure documentformat(writer: twposectionwriterintf); + public + constructor create; override; + destructor destroy; override; + + class function getwpotype: twpotype; override; + class function generatesinfoforwposwitches: twpoptimizerswitches; override; + class function performswpoforswitches: twpoptimizerswitches; override; + class function sectionname: shortstring; override; + + class procedure checkoptions; override; + + { information collection } + procedure storewpofilesection(writer: twposectionwriterintf); override; + + { information providing } + procedure loadfromwpofilesection(reader: twposectionreaderintf); override; + function symbolinfinalbinary(const s: shortstring): boolean;override; + + end; + + { tdeadcodeinfofromexternallinker } + + twpodeadcodeinfofromexternallinker = class(twpodeadcodeinfo) + private + + fsymtypepos, + fsymnamepos : longint; + fsymfile : text; + fsymfilename : tcmdstr; + function parselinenm(const line: ansistring): boolean; + function parselineobjdump(const line: ansistring): boolean; + public + class procedure checkoptions; override; + + { information collection } + procedure constructfromcompilerstate; override; + end; + + + implementation + + uses + cutils,cfileutl, + sysutils, + globals,systems,fmodule, + verbose; + + + const + SYMBOL_SECTION_NAME = 'live_symbols'; + + { twpodeadcodeinfo } + + constructor twpodeadcodeinfo.create; + begin + inherited create; + fsymbols:=tfphashlist.create; + end; + + + destructor twpodeadcodeinfo.destroy; + begin + fsymbols.free; + fsymbols:=nil; + inherited destroy; + end; + + + class function twpodeadcodeinfo.getwpotype: twpotype; + begin + result:=wpo_live_symbol_information; + end; + + + class function twpodeadcodeinfo.generatesinfoforwposwitches: twpoptimizerswitches; + begin + result:=[cs_wpo_symbol_liveness]; + end; + + + class function twpodeadcodeinfo.performswpoforswitches: twpoptimizerswitches; + begin + result:=[cs_wpo_symbol_liveness]; + end; + + + class function twpodeadcodeinfo.sectionname: shortstring; + begin + result:=SYMBOL_SECTION_NAME; + end; + + + class procedure twpodeadcodeinfo.checkoptions; + begin + { we don't have access to the symbol info if the linking + hasn't happend + } + if (([cs_link_on_target,cs_link_nolink] * init_settings.globalswitches) <> []) then + begin + cgmessage(wpo_cannot_extract_live_symbol_info_no_link); + exit; + end; + + { without dead code stripping/smart linking, this doesn't make sense } + if not(cs_link_smart in init_settings.globalswitches) then + begin + cgmessage(wpo_symbol_live_info_needs_smart_linking); + exit; + end; + end; + + + procedure twpodeadcodeinfo.documentformat(writer: twposectionwriterintf); + begin + writer.sectionputline('# section format:'); + writer.sectionputline('# symbol1_that_is_live'); + writer.sectionputline('# symbol2_that_is_live'); + writer.sectionputline('# ...'); + writer.sectionputline('#'); + end; + + + procedure twpodeadcodeinfo.storewpofilesection(writer: twposectionwriterintf); + var + i: longint; + begin + writer.startsection(SYMBOL_SECTION_NAME); + documentformat(writer); + for i:=0 to fsymbols.count-1 do + writer.sectionputline(fsymbols.nameofindex(i)); + end; + + + procedure twpodeadcodeinfo.loadfromwpofilesection(reader: twposectionreaderintf); + var + symname: shortstring; + begin + while reader.sectiongetnextline(symname) do + fsymbols.add(symname,pointer(1)); + end; + + + function twpodeadcodeinfo.symbolinfinalbinary(const s: shortstring): boolean; + begin + result:=fsymbols.find(s)<>nil; + end; + + + { twpodeadcodeinfofromexternallinker } + +{$ifdef relaxed_objdump_parsing} +const + objdumpcheckstr='.text'; +{$else} +const + objdumpcheckstr='F .text'; +{$endif} + objdumpsearchstr=' '+objdumpcheckstr; + + class procedure twpodeadcodeinfofromexternallinker.checkoptions; + begin + inherited checkoptions; + + { we need symbol information } + if (cs_link_strip in init_settings.globalswitches) then + begin + cgmessage(wpo_cannot_extract_live_symbol_info_strip); + exit; + end; + end; + + + function twpodeadcodeinfofromexternallinker.parselinenm(const line: ansistring): boolean; + begin + if (length(line) < fsymnamepos) then + begin + cgmessage1(wpo_error_reading_symbol_file,'nm'); + close(fsymfile); + deletefile(fsymfilename); + result:=false; + exit; + end; + if (line[fsymtypepos] in ['T','t']) then + fsymbols.add(copy(line,fsymnamepos,length(line)),pointer(1)); + result:=true; + end; + + + function twpodeadcodeinfofromexternallinker.parselineobjdump(const line: ansistring): boolean; + begin + { there are a couple of empty lines at the end } + if (line='') then + begin + result:=true; + exit; + end; + if (length(line) < fsymtypepos) then + begin + cgmessage1(wpo_error_reading_symbol_file,'objdump'); + close(fsymfile); + deletefile(fsymfilename); + result:=false; + exit; + end; + if (copy(line,fsymtypepos,length(objdumpcheckstr))=objdumpcheckstr) then + fsymbols.add(copy(line,fsymnamepos,length(line)),pointer(1)); + result:=true; + end; + + + procedure twpodeadcodeinfofromexternallinker.constructfromcompilerstate; + + type + tparselineproc = function(const line: ansistring): boolean of object; + + var + nmfullname, + objdumpfullname, + symbolprogfullpath : tcmdstr; + line : ansistring; + parseline : tparselineproc; + exitcode : longint; + symbolprogfound : boolean; + symbolprogisnm : boolean; + + + function findutil(const utilname: string; out fullutilname, fullutilpath: tcmdstr): boolean; + begin + result:=false; + fullutilname:=utilsprefix+changefileext(utilname,source_info.exeext); + if utilsdirectory<>'' then + result:=findfile(fullutilname,utilsdirectory,false,fullutilpath); + if not result then + result:=findexe(fullutilname,false,fullutilpath); + end; + + + function failiferror(error: boolean): boolean; + begin + result:=error; + if not result then + exit; + cgmessage1(wpo_error_reading_symbol_file,symbolprogfullpath); +{$push}{$i-} + close(fsymfile); +{$pop} + if fileexists(fsymfilename) then + deletefile(fsymfilename); + end; + + + function setnminfo: boolean; + begin + { expected format: + 0000bce0 T FPC_ABSTRACTERROR + ... + } + result:=false; + fsymtypepos:=pos(' ',line)+1; + fsymnamepos:=fsymtypepos+2; + { on Linux/ppc64, there is an extra '.' at the start + of public function names + } + if (target_info.system=system_powerpc64_linux) then + inc(fsymnamepos); + if failiferror(fsymtypepos<=0) then + exit; + { make sure there's room for the name } + if failiferror(fsymnamepos>length(line)) then + exit; + { and that we're not in the middle of some other column } + if failiferror(pos(' ',copy(line,fsymnamepos,length(line)))>0) then + exit; + result:=true; + end; + + + function setobjdumpinfo: boolean; + begin + { expected format: + prog: file format elf32-i386 + + SYMBOL TABLE: + 08048080 l d .text 00000000 .text + 00000000 l d .stabstr 00000000 .stabstr + 00000000 l df *ABS* 00000000 nest.pp + 08048160 l F .text 00000068 SYSTEM_INITSYSCALLINTF + ... + } + result:=false; + while (pos(objdumpsearchstr,line)<=0) do + begin + if failiferror(eof(fsymfile)) then + exit; + readln(fsymfile,line) + end; + fsymtypepos:=pos(objdumpsearchstr,line)+1; + { find begin of symbol name } + fsymnamepos:=(pointer(strrscan(pchar(line),' '))-pointer(@line[1]))+2; + { sanity check } + if (fsymnamepos <= fsymtypepos+length(objdumpcheckstr)) then + exit; + result:=true; + end; + + + begin { twpodeadcodeinfofromexternallinker } + { gnu-nm (e.g., on solaris) } + symbolprogfound:=findutil('gnm',nmfullname,symbolprogfullpath); + { regular nm } + if not symbolprogfound then + symbolprogfound:=findutil('nm',nmfullname,symbolprogfullpath); + if not symbolprogfound then + begin + { try objdump } + symbolprogfound:=findutil('objdump',objdumpfullname,symbolprogfullpath); + symbolprogfullpath:=symbolprogfullpath+' -t '; + symbolprogisnm:=false; + end + else + begin + symbolprogfullpath:=symbolprogfullpath+' -p '; + symbolprogisnm:=true; + end; + if not symbolprogfound then + begin + cgmessage2(wpo_cannot_find_symbol_progs,nmfullname,objdumpfullname); + exit; + end; + + { upper case to have the least chance of tripping some long file name + conversion stuff + } + fsymfilename:=outputexedir+'FPCWPO.SYM'; + { -p gives the same kind of output with Solaris nm as + with GNU nm, and for GNU nm it simply means "unsorted" + } + exitcode:=shell(symbolprogfullpath+maybequoted(current_module.exefilename^)+' > '+fsymfilename); + if (exitcode<>0) then + begin + cgmessage2(wpo_error_executing_symbol_prog,symbolprogfullpath,tostr(exitcode)); + if fileexists(fsymfilename) then + deletefile(fsymfilename); + exit; + end; + + assign(fsymfile,fsymfilename); +{$push}{$i-} + reset(fsymfile); +{$pop} + if failiferror((ioresult<>0) or eof(fsymfile)) then + exit; + readln(fsymfile, line); + if (symbolprogisnm) then + begin + if not setnminfo then + exit; + parseline:=@parselinenm + end + else + begin + if not setobjdumpinfo then + exit; + parseline:=@parselineobjdump; + end; + if not parseline(line) then + exit; + while not eof(fsymfile) do + begin + readln(fsymfile,line); + if not parseline(line) then + exit; + end; + close(fsymfile); + deletefile(fsymfilename); + end; + + +end. + diff --git a/closures/compiler/optdfa.pas b/closures/compiler/optdfa.pas new file mode 100644 index 0000000000..28f2f6fd46 --- /dev/null +++ b/closures/compiler/optdfa.pas @@ -0,0 +1,616 @@ +{ + DFA + + Copyright (c) 2007 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. + + **************************************************************************** +} + +{ $define DEBUG_DFA} +{ $define EXTDEBUG_DFA} + +{ this unit implements routines to perform dfa } +unit optdfa; + +{$i fpcdefs.inc} + + interface + + uses + node,optutils; + + type + TDFABuilder = class + protected + procedure CreateLifeInfo(node : tnode;map : TIndexedNodeSet); + public + resultnode : tnode; + nodemap : TIndexedNodeSet; + { reset all dfa info, this is required before creating dfa info + if the tree has been changed without updating dfa } + procedure resetdfainfo(node : tnode); + + procedure createdfainfo(node : tnode); + destructor destroy;override; + end; + + implementation + + uses + globtype,globals, + verbose, + cpuinfo, + symconst,symdef, + defutil, + procinfo, + nutils, + nbas,nflw,ncon,ninl,ncal,nset, + optbase; + + + (* + function initnodes(var n:tnode; arg: pointer) : foreachnoderesult; + begin + { node worth to add? } + if (node_complexity(n)>1) and (tstoreddef(n.resultdef).is_intregable or tstoreddef(n.resultdef).is_fpuregable) then + begin + plists(arg)^.nodelist.Add(n); + plists(arg)^.locationlist.Add(@n); + result:=fen_false; + end + else + result:=fen_norecurse_false; + end; + *) + + { + x:=f; read: [f] + + while x do read: [] + + a:=b; read: [a,b,d] def: [a] life: read*def=[a] + c:=d; read: [a,d] def: [a,c] life: read*def=[a] + e:=a; read: [a] def: [a,c,e] life: read*def=[a] + + + function f(b,d,x : type) : type; + + begin + while x do alive: b,d,x + begin + a:=b; alive: b,d,x + c:=d; alive: a,d,x + e:=a+c; alive: a,c,x + dec(x); alive: c,e,x + end; + result:=c+e; alive: c,e + end; alive: result + + } + + type + tdfainfo = record + use : PDFASet; + def : PDFASet; + map : TIndexedNodeSet + end; + pdfainfo = ^tdfainfo; + + function AddDefUse(var n: tnode; arg: pointer): foreachnoderesult; + begin + case n.nodetype of + loadn: + begin + pdfainfo(arg)^.map.Add(n); + if nf_modify in n.flags then + begin + DFASetInclude(pdfainfo(arg)^.use^,n.optinfo^.index); + DFASetInclude(pdfainfo(arg)^.def^,n.optinfo^.index) + end + else if nf_write in n.flags then + DFASetInclude(pdfainfo(arg)^.def^,n.optinfo^.index) + else + DFASetInclude(pdfainfo(arg)^.use^,n.optinfo^.index); + { + write('Use Set: '); + PrintDFASet(output,pdfainfo(arg)^.use^); + write(' Def Set: '); + PrintDFASet(output,pdfainfo(arg)^.def^); + writeln; + } + end; + end; + result:=fen_false; + end; + + + function ResetProcessing(var n: tnode; arg: pointer): foreachnoderesult; + begin + exclude(n.flags,nf_processing); + result:=fen_false; + end; + + + function ResetDFA(var n: tnode; arg: pointer): foreachnoderesult; + begin + if assigned(n.optinfo) then + begin + with n.optinfo^ do + begin + life:=nil; + def:=nil; + use:=nil; + defsum:=nil; + end; + end; + result:=fen_false; + end; + + + procedure TDFABuilder.CreateLifeInfo(node : tnode;map : TIndexedNodeSet); + + var + changed : boolean; + + procedure CreateInfo(node : tnode); + + { update life entry of a node with l, set changed if this changes + life info for the node + } + procedure updatelifeinfo(n : tnode;l : TDFASet); + var + b : boolean; + begin + b:=DFASetNotEqual(l,n.optinfo^.life); + { + if b then + begin + printnode(output,n); + printdfaset(output,l); + writeln; + printdfaset(output,n.optinfo^.life); + writeln; + end; + } +{$ifdef DEBUG_DFA} + if not(changed) and b then + writeln('Another DFA pass caused by: ',nodetype2str[n.nodetype],'(',n.fileinfo.line,',',n.fileinfo.column,')'); +{$endif DEBUG_DFA} + + changed:=changed or b; + node.optinfo^.life:=l; + end; + + procedure calclife(n : tnode); + var + l : TDFASet; + begin + if assigned(n.successor) then + begin + { + write('Successor Life: '); + printdfaset(output,n.successor.optinfo^.life); + writeln; + write('Def.'); + printdfaset(output,n.optinfo^.def); + writeln; + } + { ensure we can access optinfo } + DFASetDiff(l,n.successor.optinfo^.life,n.optinfo^.def); + { + printdfaset(output,l); + writeln; + } + DFASetIncludeSet(l,n.optinfo^.use); + DFASetIncludeSet(l,n.optinfo^.life); + end + else + begin + { last node, not exit or raise node and function? } + if assigned(resultnode) and + not(node.nodetype in [raisen,exitn]) then + begin + { if yes, result lifes } + DFASetDiff(l,resultnode.optinfo^.life,n.optinfo^.def); + DFASetIncludeSet(l,n.optinfo^.use); + DFASetIncludeSet(l,n.optinfo^.life); + end + else + begin + l:=n.optinfo^.use; + DFASetIncludeSet(l,n.optinfo^.life); + end; + end; + updatelifeinfo(n,l); + end; + + var + dfainfo : tdfainfo; + l : TDFASet; + save: TDFASet; + i : longint; + + begin + if node=nil then + exit; + + { ensure we've already optinfo set } + node.allocoptinfo; + + if nf_processing in node.flags then + exit; + include(node.flags,nf_processing); + + if assigned(node.successor) then + CreateInfo(node.successor); + +{$ifdef EXTDEBUG_DFA} + writeln('Handling: ',nodetype2str[node.nodetype],'(',node.fileinfo.line,',',node.fileinfo.column,')'); +{$endif EXTDEBUG_DFA} + { life:=succesorlive-definition+use } + + case node.nodetype of + whilerepeatn: + begin + { analyze the loop condition } + if not(assigned(node.optinfo^.def)) and + not(assigned(node.optinfo^.use)) then + begin + dfainfo.use:=@node.optinfo^.use; + dfainfo.def:=@node.optinfo^.def; + dfainfo.map:=map; + foreachnodestatic(pm_postprocess,twhilerepeatnode(node).left,@AddDefUse,@dfainfo); + end; + + { NB: this node should typically have empty def set } + if assigned(node.successor) then + DFASetDiff(l,node.successor.optinfo^.life,node.optinfo^.def) + else if assigned(resultnode) then + DFASetDiff(l,resultnode.optinfo^.life,node.optinfo^.def) + else + l:=nil; + + { for repeat..until, node use set in included at the end of loop } + if not (lnf_testatbegin in twhilerepeatnode(node).loopflags) then + DFASetIncludeSet(l,node.optinfo^.use); + + DFASetIncludeSet(l,node.optinfo^.life); + + save:=node.optinfo^.life; + { to process body correctly, we need life info in place (because + whilerepeatnode is successor of its body). } + node.optinfo^.life:=l; + + { now process the body } + CreateInfo(twhilerepeatnode(node).right); + + { restore, to prevent infinite recursion via changed flag } + node.optinfo^.life:=save; + + { for while loops, node use set is included at the beginning of loop } + l:=twhilerepeatnode(node).right.optinfo^.life; + if lnf_testatbegin in twhilerepeatnode(node).loopflags then + DFASetIncludeSet(l,node.optinfo^.use); + + UpdateLifeInfo(node,l); + + { ... and a second iteration for fast convergence } + CreateInfo(twhilerepeatnode(node).right); + end; + + forn: + begin + { + left: loopvar + right: from + t1: to + t2: body + } + { take care of the sucessor if it's possible that we don't have one execution of the body } + if not((tfornode(node).right.nodetype=ordconstn) and (tfornode(node).t1.nodetype=ordconstn)) then + calclife(node); + node.allocoptinfo; + if not(assigned(node.optinfo^.def)) and + not(assigned(node.optinfo^.use)) then + begin + dfainfo.use:=@node.optinfo^.use; + dfainfo.def:=@node.optinfo^.def; + dfainfo.map:=map; + foreachnodestatic(pm_postprocess,tfornode(node).left,@AddDefUse,@dfainfo); + foreachnodestatic(pm_postprocess,tfornode(node).right,@AddDefUse,@dfainfo); + foreachnodestatic(pm_postprocess,tfornode(node).t1,@AddDefUse,@dfainfo); + end; + { take care of the sucessor if it's possible that we don't have one execution of the body } + if not((tfornode(node).right.nodetype=ordconstn) and (tfornode(node).t1.nodetype=ordconstn)) then + calclife(node); + + { create life for the body } + CreateInfo(tfornode(node).t2); + + { update for node } + { life:=life+use+body } + l:=copy(node.optinfo^.life); + DFASetIncludeSet(l,tfornode(node).t2.optinfo^.life); + { the for loop always updates its control variable } + DFASetDiff(l,l,node.optinfo^.def); + + { ... but it could be that left/right use it, so do it after + removing def } + DFASetIncludeSet(l,node.optinfo^.use); + + UpdateLifeInfo(node,l); + + { ... and a second iteration for fast convergence } + CreateInfo(tfornode(node).t2); + end; + + temprefn, + loadn, + typeconvn, + assignn: + begin + if not(assigned(node.optinfo^.def)) and + not(assigned(node.optinfo^.use)) then + begin + dfainfo.use:=@node.optinfo^.use; + dfainfo.def:=@node.optinfo^.def; + dfainfo.map:=map; + foreachnodestatic(pm_postprocess,node,@AddDefUse,@dfainfo); + end; + calclife(node); + end; + + statementn: + begin + { nested statement } + CreateInfo(tstatementnode(node).statement); + { inherit info } + node.optinfo^.life:=tstatementnode(node).statement.optinfo^.life; + end; + + blockn: + begin + CreateInfo(tblocknode(node).statements); + if assigned(tblocknode(node).statements) then + node.optinfo^.life:=tblocknode(node).statements.optinfo^.life; + end; + + ifn: + begin + { get information from cond. expression } + if not(assigned(node.optinfo^.def)) and + not(assigned(node.optinfo^.use)) then + begin + dfainfo.use:=@node.optinfo^.use; + dfainfo.def:=@node.optinfo^.def; + dfainfo.map:=map; + foreachnodestatic(pm_postprocess,tifnode(node).left,@AddDefUse,@dfainfo); + end; + { create life info for then and else node } + CreateInfo(tifnode(node).right); + CreateInfo(tifnode(node).t1); + + { ensure that we don't remove life info } + l:=node.optinfo^.life; + + { get life info from then branch } + if assigned(tifnode(node).right) then + DFASetIncludeSet(l,tifnode(node).right.optinfo^.life); + { get life info from else branch } + if assigned(tifnode(node).t1) then + DFASetIncludeSet(l,tifnode(node).t1.optinfo^.life) + else + if assigned(node.successor) then + DFASetIncludeSet(l,node.successor.optinfo^.life) + { last node and function? } + else + if assigned(resultnode) then + DFASetIncludeSet(l,resultnode.optinfo^.life); + + { add use info from the cond. expression } + DFASetIncludeSet(l,tifnode(node).optinfo^.use); + { finally, update the life info of the node } + UpdateLifeInfo(node,l); + end; + + casen: + begin + { get information from "case" expression } + if not(assigned(node.optinfo^.def)) and + not(assigned(node.optinfo^.use)) then + begin + dfainfo.use:=@node.optinfo^.use; + dfainfo.def:=@node.optinfo^.def; + dfainfo.map:=map; + foreachnodestatic(pm_postprocess,tcasenode(node).left,@AddDefUse,@dfainfo); + end; + + { create life info for block and else nodes } + for i:=0 to tcasenode(node).blocks.count-1 do + CreateInfo(pcaseblock(tcasenode(node).blocks[i])^.statement); + + CreateInfo(tcasenode(node).elseblock); + + { ensure that we don't remove life info } + l:=node.optinfo^.life; + + { get life info from case branches } + for i:=0 to tcasenode(node).blocks.count-1 do + DFASetIncludeSet(l,pcaseblock(tcasenode(node).blocks[i])^.statement.optinfo^.life); + + { get life info from else branch or the succesor } + if assigned(tcasenode(node).elseblock) then + DFASetIncludeSet(l,tcasenode(node).elseblock.optinfo^.life) + else + if assigned(node.successor) then + DFASetIncludeSet(l,node.successor.optinfo^.life) + { last node and function? } + else + if assigned(resultnode) then + DFASetIncludeSet(l,resultnode.optinfo^.life); + + { add use info from the "case" expression } + DFASetIncludeSet(l,tcasenode(node).optinfo^.use); + + { finally, update the life info of the node } + UpdateLifeInfo(node,l); + end; + + exitn: + begin + if not(is_void(current_procinfo.procdef.returndef)) and + not(current_procinfo.procdef.proctypeoption=potype_constructor) then + begin + if not(assigned(node.optinfo^.def)) and + not(assigned(node.optinfo^.use)) then + begin + if assigned(texitnode(node).left) then + begin + node.optinfo^.def:=resultnode.optinfo^.def; + + dfainfo.use:=@node.optinfo^.use; + dfainfo.def:=@node.optinfo^.def; + dfainfo.map:=map; + foreachnodestatic(pm_postprocess,texitnode(node).left,@AddDefUse,@dfainfo); + calclife(node); + end + else + begin + { get info from faked resultnode } + node.optinfo^.use:=resultnode.optinfo^.use; + node.optinfo^.life:=node.optinfo^.use; + changed:=true; + end; + end; + end; + end; + + raisen: + begin + if not(assigned(node.optinfo^.life)) then + begin + dfainfo.use:=@node.optinfo^.use; + dfainfo.def:=@node.optinfo^.def; + dfainfo.map:=map; + foreachnodestatic(pm_postprocess,traisenode(node).left,@AddDefUse,@dfainfo); + foreachnodestatic(pm_postprocess,traisenode(node).right,@AddDefUse,@dfainfo); + foreachnodestatic(pm_postprocess,traisenode(node).third,@AddDefUse,@dfainfo); + { update node } + l:=node.optinfo^.life; + DFASetIncludeSet(l,node.optinfo^.use); + UpdateLifeInfo(node,l); + printdfainfo(output,node); + end; + end; + + calln: + begin + if not(assigned(node.optinfo^.def)) and + not(assigned(node.optinfo^.use)) then + begin + dfainfo.use:=@node.optinfo^.use; + dfainfo.def:=@node.optinfo^.def; + dfainfo.map:=map; + foreachnodestatic(pm_postprocess,node,@AddDefUse,@dfainfo); + end; + calclife(node); + end; + + tempcreaten, + tempdeleten, + inlinen, + nothingn, + continuen, + goton, + breakn, + labeln: + begin + calclife(node); + end; + else + begin + writeln(nodetype2str[node.nodetype]); + internalerror(2007050502); + end; + end; + + // exclude(node.flags,nf_processing); + end; + + var + runs : integer; + dfarec : tdfainfo; + begin + runs:=0; + if not(is_void(current_procinfo.procdef.returndef)) and + not(current_procinfo.procdef.proctypeoption=potype_constructor) then + begin + { create a fake node using the result } + resultnode:=load_result_node; + resultnode.allocoptinfo; + dfarec.use:=@resultnode.optinfo^.use; + dfarec.def:=@resultnode.optinfo^.def; + dfarec.map:=map; + AddDefUse(resultnode,@dfarec); + resultnode.optinfo^.life:=resultnode.optinfo^.use; + end + else + resultnode:=nil; + + repeat + inc(runs); + changed:=false; + CreateInfo(node); + foreachnodestatic(pm_postprocess,node,@ResetProcessing,nil); +{$ifdef DEBUG_DFA} + PrintIndexedNodeSet(output,map); + PrintDFAInfo(output,node); +{$endif DEBUG_DFA} + until not(changed); +{$ifdef DEBUG_DFA} + writeln('DFA solver iterations: ',runs); +{$endif DEBUG_DFA} + end; + + + { reset all dfa info, this is required before creating dfa info + if the tree has been changed without updating dfa } + procedure TDFABuilder.resetdfainfo(node : tnode); + begin + foreachnodestatic(pm_postprocess,node,@ResetDFA,nil); + end; + + + procedure TDFABuilder.createdfainfo(node : tnode); + begin + if not(assigned(nodemap)) then + nodemap:=TIndexedNodeSet.Create; + { add controll flow information } + SetNodeSucessors(node); + { now, collect life information } + CreateLifeInfo(node,nodemap); + end; + + + destructor TDFABuilder.Destroy; + begin + Resultnode.free; + nodemap.free; + inherited destroy; + end; + +end. diff --git a/closures/compiler/options.pas b/closures/compiler/options.pas new file mode 100644 index 0000000000..119ac99cb0 --- /dev/null +++ b/closures/compiler/options.pas @@ -0,0 +1,2958 @@ +{ + Copyright (c) 1998-2008 by Florian Klaempfl and Peter Vreman + + Reads command line options and config files + + 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 options; + +{$i fpcdefs.inc} + +interface + +uses + CClasses,cfileutl, + globtype,globals,verbose,systems,cpuinfo, comprsrc; + +Type + TOption=class + FirstPass, + ParaLogo, + NoPressEnter, + LogoWritten, + FPUSetExplicitly, + CPUSetExplicitly, + OptCPUSetExplicitly: boolean; + FileLevel : longint; + QuickInfo : string; + ParaIncludePath, + ParaUnitPath, + ParaObjectPath, + ParaLibraryPath, + ParaFrameworkPath : TSearchPathList; + ParaAlignment : TAlignmentInfo; + Constructor Create; + Destructor Destroy;override; + procedure WriteLogo; + procedure WriteInfo; + procedure WriteHelpPages; + procedure WriteQuickInfo; + procedure IllegalPara(const opt:TCmdStr); + procedure UnsupportedPara(const opt:TCmdStr); + procedure IgnoredPara(const opt:TCmdStr); + function Unsetbool(var Opts:TCmdStr; Pos: Longint):boolean; + procedure interpret_option(const opt :TCmdStr;ispara:boolean); + procedure Interpret_envvar(const envname : TCmdStr); + procedure Interpret_file(const filename : TPathStr); + procedure Read_Parameters; + procedure parsecmd(cmd:TCmdStr); + procedure TargetOptions(def:boolean); + procedure CheckOptionsCompatibility; + procedure ForceStaticLinking; + end; + + TOptionClass=class of toption; + +var + coption : TOptionClass; + +procedure read_arguments(cmd:TCmdStr); + + +implementation + +uses + widestr, + {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif}, + SysUtils, + version, + cutils,cmsgs, + comphook, + symtable,scanner,rabase, + wpobase, + symconst, + i_bsd; + +const + page_size = 24; + +var + option : toption; + read_configfile, { read config file, set when a cfgfile is found } + disable_configfile : boolean; + fpcdir, + ppccfg, + param_file : string; { file to compile specified on the commandline } + + +{**************************************************************************** + Options not supported on all platforms +****************************************************************************} + +const + { pointer checking (requires special code in FPC_CHECKPOINTER, + and can never work for libc-based targets or any other program + linking to an external library) + } + supported_targets_gc = [system_i386_linux,system_powerpc_linux] + + [system_i386_win32] + + [system_i386_GO32V2] + + [system_i386_os2] + + [system_i386_beos,system_i386_haiku] + + [system_powerpc_morphos]; + + { gprof (requires implementation of g_profilecode in the code generator) } + supported_targets_pg = [system_i386_linux,system_x86_64_linux] + + [system_i386_win32] + + [system_powerpc_darwin,system_x86_64_darwin] + + [system_i386_GO32V2] + + [system_i386_freebsd] + + [system_i386_netbsd] + + [system_i386_wdosx]; + + suppported_targets_x_smallr = systems_linux + systems_solaris + + [system_i386_haiku] + + [system_i386_beos]; + +{**************************************************************************** + Defines +****************************************************************************} + +procedure set_default_link_type; +begin + undef_system_macro('FPC_LINK_SMART'); + def_system_macro('FPC_LINK_STATIC'); + undef_system_macro('FPC_LINK_DYNAMIC'); + init_settings.globalswitches:=init_settings.globalswitches+[cs_link_static]; + init_settings.globalswitches:=init_settings.globalswitches-[cs_link_shared,cs_link_smart]; +end; + +{**************************************************************************** + Toption +****************************************************************************} + +procedure StopOptions(err:longint); +begin + if assigned(Option) then + begin + Option.free; + Option:=nil; + end; + raise ECompilerAbortSilent.Create; +end; + + +procedure Toption.WriteLogo; +var + p : pchar; +begin + if not LogoWritten then + begin + p:=MessagePchar(option_logo); + while assigned(p) do + Comment(V_Normal,GetMsgLine(p)); + LogoWritten:= true; + end; +end; + + +procedure Toption.WriteInfo; +var + p : pchar; + hs,hs1,s : TCmdStr; + target : tsystem; + cpu : tcputype; + fpu : tfputype; + opt : toptimizerswitch; + wpopt: twpoptimizerswitch; + abi : tabi; +{$if defined(arm) or defined(avr)} + controllertype : tcontrollertype; +{$endif defined(arm) or defined(avr)} +begin + p:=MessagePchar(option_info); + while assigned(p) do + begin + s:=GetMsgLine(p); + { list OS Targets } + if pos('$OSTARGETS',s)>0 then + begin + for target:=low(tsystem) to high(tsystem) do + if assigned(targetinfos[target]) then + begin + hs:=s; + hs1:=targetinfos[target]^.name; + if tf_under_development in targetinfos[target]^.flags then + hs1:=hs1+' (under development)'; + Replace(hs,'$OSTARGETS',hs1); + Comment(V_Normal,hs); + end; + end + else if pos('$INSTRUCTIONSETS',s)>0 then + begin + for cpu:=low(tcputype) to high(tcputype) do + begin + hs:=s; + hs1:=cputypestr[cpu]; + if hs1<>'' then + begin + Replace(hs,'$INSTRUCTIONSETS',hs1); + Comment(V_Normal,hs); + end; + end; + end + else if pos('$FPUINSTRUCTIONSETS',s)>0 then + begin + for fpu:=low(tfputype) to high(tfputype) do + begin + hs:=s; + hs1:=fputypestr[fpu]; + if hs1<>'' then + begin + Replace(hs,'$FPUINSTRUCTIONSETS',hs1); + Comment(V_Normal,hs); + end; + end; + end + else if pos('$ABITARGETS',s)>0 then + begin + for abi:=low(abi) to high(abi) do + begin + hs:=s; + hs1:=abi2str[abi]; + if hs1<>'' then + begin + Replace(hs,'$ABITARGETS',hs1); + Comment(V_Normal,hs); + end; + end; + end + else if pos('$OPTIMIZATIONS',s)>0 then + begin + for opt:=low(toptimizerswitch) to high(toptimizerswitch) do + begin + if opt in supported_optimizerswitches then + begin + hs:=s; + hs1:=OptimizerSwitchStr[opt]; + if hs1<>'' then + begin + Replace(hs,'$OPTIMIZATIONS',hs1); + Comment(V_Normal,hs); + end; + end; + end; + end + else if pos('$WPOPTIMIZATIONS',s)>0 then + begin + for wpopt:=low(twpoptimizerswitch) to high(twpoptimizerswitch) do + begin +{ currently all whole program optimizations are platform-independent + if opt in supported_wpoptimizerswitches then +} + begin + hs:=s; + hs1:=WPOptimizerSwitchStr[wpopt]; + if hs1<>'' then + begin + Replace(hs,'$WPOPTIMIZATIONS',hs1); + Comment(V_Normal,hs); + end; + end; + end + end + else if pos('$CONTROLLERTYPES',s)>0 then + begin +{$if defined(arm) or defined(avr)} + for controllertype:=low(tcontrollertype) to high(tcontrollertype) do + begin +{ currently all whole program optimizations are platform-independent + if opt in supported_wpoptimizerswitches then +} + begin + hs:=s; + hs1:=embedded_controllers[controllertype].ControllerTypeStr; + if hs1<>'' then + begin + Replace(hs,'$CONTROLLERTYPES',hs1); + Comment(V_Normal,hs); + end; + end; + end +{$else defined(arm) or defined(avr)} +{$endif defined(arm) or defined(avr)} + end + else + Comment(V_Normal,s); + end; + StopOptions(0); +end; + + +procedure Toption.WriteHelpPages; + + function PadEnd(s:string;i:longint):string; + begin + while (length(s)<i) do + s:=s+' '; + PadEnd:=s; + end; + +var + lastident, + j,outline, + ident, + lines : longint; + show : boolean; + opt : string[32]; + input, + s : string; + p : pchar; +begin + WriteLogo; + Lines:=4; + Message1(option_usage,FixFileName(system.paramstr(0))); + lastident:=0; + p:=MessagePChar(option_help_pages); + while assigned(p) do + begin + { get a line and reset } + s:=GetMsgLine(p); + ident:=0; + show:=false; + { parse options } + case s[1] of +{$ifdef UNITALIASES} + 'a', +{$endif} +{$ifdef EXTDEBUG} + 'e', +{$endif EXTDEBUG} +{$ifdef i386} + '3', +{$endif} +{$ifdef x86_64} + '4', +{$endif} +{$ifdef m68k} + '6', +{$endif} +{$ifdef arm} + 'A', +{$endif} +{$ifdef powerpc} + 'P', +{$endif} +{$ifdef powerpc64} + 'p', +{$endif} +{$ifdef sparc} + 'S', +{$endif} +{$ifdef vis} + 'I', +{$endif} +{$ifdef avr} + 'V', +{$endif} + '*' : show:=true; + end; + if show then + begin + case s[2] of + 'g', +{$ifdef Unix} + 'L', +{$endif} +{$ifdef os2} + 'O', +{$endif} + '*' : show:=true; + else + show:=false; + end; + end; + { now we may show the message or not } + if show then + begin + case s[3] of + '0' : begin + ident:=0; + outline:=0; + end; + '1' : begin + ident:=2; + outline:=7; + end; + '2' : begin + ident:=6; + outline:=11; + end; + '3' : begin + ident:=9; + outline:=11; + end; + end; + j:=pos('_',s); + opt:=Copy(s,4,j-4); + if opt='*' then + opt:='' + else + if opt=' ' then + opt:=PadEnd(opt,outline) + else + opt:=PadEnd('-'+opt,outline); + if (ident=0) and (lastident<>0) then + begin + Comment(V_Normal,''); + inc(Lines); + end; + { page full ? } + if (lines >= page_size - 1) then + begin + if not NoPressEnter then + begin + Message(option_help_press_enter); + readln(input); + if upper(input)='Q' then + StopOptions(0); + end; + lines:=0; + end; + Comment(V_Normal,PadEnd('',ident)+opt+Copy(s,j+1,255)); + LastIdent:=Ident; + inc(Lines); + end; + end; + StopOptions(0); +end; + + +procedure Toption.IllegalPara(const opt:TCmdStr); +begin + Message1(option_illegal_para,opt); + Message(option_help_pages_para); + StopOptions(1); +end; + + +procedure toption.UnsupportedPara(const opt: TCmdStr); +begin + Message1(option_unsupported_target,opt); + StopOptions(1); +end; + + +procedure toption.IgnoredPara(const opt: TCmdStr); +begin + Message1(option_ignored_target,opt); +end; + + +procedure toption.ForceStaticLinking; +begin + def_system_macro('FPC_LINK_STATIC'); + undef_system_macro('FPC_LINK_SMART'); + undef_system_macro('FPC_LINK_DYNAMIC'); + include(init_settings.globalswitches,cs_link_static); + exclude(init_settings.globalswitches,cs_link_smart); + exclude(init_settings.globalswitches,cs_link_shared); + LinkTypeSetExplicitly:=true; +end; + + +function Toption.Unsetbool(var Opts:TCmdStr; Pos: Longint):boolean; +{ checks if the character after pos in Opts is a + or a - and returns resp. + false or true. If it is another character (or none), it also returns false } +begin + UnsetBool := false; + if Length(Opts)>Pos then + begin + inc(Pos); + UnsetBool := Opts[Pos] = '-'; + if Opts[Pos] in ['-','+']then + delete(Opts,Pos,1); + end; +end; + + +procedure TOption.interpret_option(const opt:TCmdStr;ispara:boolean); +var + code : integer; + c : char; + more : TCmdStr; + major,minor : longint; + error : integer; + j,l : longint; + d,s : TCmdStr; + unicodemapping : punicodemap; +begin + if opt='' then + exit; + + { only parse define,undef,target,verbosity,link etc options the firsttime } + if firstpass and + not( + (opt[1]='-') and + ( + ((length(opt)>1) and (opt[2] in ['i','d','v','T','u','n','X','l'])) or + ((length(opt)>3) and (opt[2]='F') and (opt[3]='e')) + ) + ) then + exit; + + Message1(option_handling_option,opt); + case opt[1] of + '-' : + begin + more:=Copy(opt,3,2147483647); + if firstpass then + Message1(option_interpreting_firstpass_option,opt) + else + Message1(option_interpreting_option,opt); + case opt[2] of + '?' : + WriteHelpPages; + + 'a' : + begin + include(init_settings.globalswitches,cs_asm_leave); + j:=1; + while j<=length(more) do + begin + case more[j] of + 'l' : + include(init_settings.globalswitches,cs_asm_source); + 'r' : + include(init_settings.globalswitches,cs_asm_regalloc); + 't' : + include(init_settings.globalswitches,cs_asm_tempalloc); + 'n' : + include(init_settings.globalswitches,cs_asm_nodes); + 'p' : + begin + exclude(init_settings.globalswitches,cs_asm_leave); + if UnsetBool(More, 0) then + exclude(init_settings.globalswitches,cs_asm_pipe) + else + include(init_settings.globalswitches,cs_asm_pipe); + end; + '-' : + init_settings.globalswitches:=init_settings.globalswitches - + [cs_asm_leave, cs_asm_source,cs_asm_regalloc, cs_asm_tempalloc, + cs_asm_nodes, cs_asm_pipe]; + else + IllegalPara(opt); + end; + inc(j); + end; + end; + + 'A' : + begin + paratargetasm:=find_asm_by_string(More); + if paratargetasm=as_none then + IllegalPara(opt); + end; + + 'b' : + begin + // Message1(option_obsolete_switch,'-b'); + if UnsetBool(More,0) then + begin + init_settings.moduleswitches:=init_settings.moduleswitches-[cs_browser]; + init_settings.moduleswitches:=init_settings.moduleswitches-[cs_local_browser]; + end + else + begin + init_settings.moduleswitches:=init_settings.moduleswitches+[cs_browser]; + end; + if More<>'' then + if (More='l') or (More='l+') then + init_settings.moduleswitches:=init_settings.moduleswitches+[cs_local_browser] + else if More='l-' then + init_settings.moduleswitches:=init_settings.moduleswitches-[cs_local_browser] + else + IllegalPara(opt); + end; + + 'B' : + do_build:=not UnSetBool(more,0); + + 'C' : + begin + j:=1; + while j<=length(more) do + begin + case more[j] of + '3' : + If UnsetBool(More, j) then + exclude(init_settings.localswitches,cs_ieee_errors) + Else + include(init_settings.localswitches,cs_ieee_errors); + 'a' : + begin + s:=upper(copy(more,j+1,length(more)-j)); + if not(SetAbiType(s,target_info.abi)) then + IllegalPara(opt); + break; + end; + + 'b' : + begin + if UnsetBool(More, j) then + target_info.endian:=endian_little + else + target_info.endian:=endian_big; + end; + + 'c' : + begin + if not SetAktProcCall(upper(copy(more,j+1,length(more)-j)),init_settings.defproccall) then + IllegalPara(opt); + break; + end; +{$ifdef cpufpemu} + 'e' : + begin + If UnsetBool(More, j) then + exclude(init_settings.moduleswitches,cs_fp_emulation) + Else + include(init_settings.moduleswitches,cs_fp_emulation); + end; +{$endif cpufpemu} + 'f' : + begin + s:=upper(copy(more,j+1,length(more)-j)); + if not(SetFpuType(s,init_settings.fputype)) then + IllegalPara(opt); + FPUSetExplicitly:=True; + break; + end; + 'F' : + begin + if not SetMinFPConstPrec(copy(more,j+1,length(more)-j),init_settings.minfpconstprec) then + IllegalPara(opt); + break; + end; + 'g' : + begin + if tf_no_pic_supported in target_info.flags then + begin + { consume a possible '-' coming after it } + UnsetBool(More, j); + message(scan_w_pic_ignored); + end + else if UnsetBool(More, j) then + exclude(init_settings.moduleswitches,cs_create_pic) + else + include(init_settings.moduleswitches,cs_create_pic); + end; + 'h' : + begin + val(copy(more,j+1,length(more)-j),heapsize,code); + if (code<>0) or (heapsize<1024) then + IllegalPara(opt); + break; + end; + 'i' : + If UnsetBool(More, j) then + exclude(init_settings.localswitches,cs_check_io) + else + include(init_settings.localswitches,cs_check_io); + 'n' : + If UnsetBool(More, j) then + exclude(init_settings.globalswitches,cs_link_nolink) + Else + include(init_settings.globalswitches,cs_link_nolink); + 'o' : + If UnsetBool(More, j) then + exclude(init_settings.localswitches,cs_check_overflow) + Else + include(init_settings.localswitches,cs_check_overflow); + 'O' : + If UnsetBool(More, j) then + exclude(init_settings.localswitches,cs_check_ordinal_size) + Else + include(init_settings.localswitches,cs_check_ordinal_size); + 'p' : + begin + s:=upper(copy(more,j+1,length(more)-j)); + if not(Setcputype(s,init_settings.cputype)) then + IllegalPara(opt); + CPUSetExplicitly:=true; + break; + end; + 'P': + begin + delete(more,1,1); + if upper(copy(more,1,pos('=',more)-1))='PACKSET' then + begin + delete(more,1,pos('=',more)); + if more='0' then + init_settings.setalloc:=0 + else if (more='1') or (more='DEFAULT') or (more='NORMAL') then + init_settings.setalloc:=1 + else if more='2' then + init_settings.setalloc:=2 + else if more='4' then + init_settings.setalloc:=4 + else if more='8' then + init_settings.setalloc:=8 + else + IllegalPara(opt); + end + else + IllegalPara(opt); + end; + 'r' : + If UnsetBool(More, j) then + exclude(init_settings.localswitches,cs_check_range) + Else + include(init_settings.localswitches,cs_check_range); + 'R' : + If UnsetBool(More, j) then + begin + exclude(init_settings.localswitches,cs_check_range); + exclude(init_settings.localswitches,cs_check_object); + end + Else + begin + include(init_settings.localswitches,cs_check_range); + include(init_settings.localswitches,cs_check_object); + end; + 's' : + begin + val(copy(more,j+1,length(more)-j),stacksize,code); + if (code<>0) or (stacksize>=67107840) or (stacksize<1024) then + IllegalPara(opt); + break; + end; + 't' : + If UnsetBool(More, j) then + exclude(init_settings.localswitches,cs_check_stack) + Else + include(init_settings.localswitches,cs_check_stack); + 'D' : + If UnsetBool(More, j) then + exclude(init_settings.moduleswitches,cs_create_dynamic) + Else + include(init_settings.moduleswitches,cs_create_dynamic); + 'X' : + If UnsetBool(More, j) then + exclude(init_settings.moduleswitches,cs_create_smart) + Else + include(init_settings.moduleswitches,cs_create_smart); + else + IllegalPara(opt); + end; + inc(j); + end; + end; + + 'd' : + if more <> '' then + begin + l:=Pos(':=',more); + if l>0 then + set_system_compvar(Copy(more,1,l-1),Copy(more,l+2,255)) + else + def_system_macro(more); + end; + 'D' : + begin + include(init_settings.globalswitches,cs_link_deffile); + j:=1; + while j<=length(more) do + begin + case more[j] of + 'd' : + begin + description:=Copy(more,j+1,255); + break; + end; + 'v' : + begin + dllversion:=Copy(more,j+1,255); + l:=pos('.',dllversion); + dllminor:=0; + error:=0; + if l>0 then + begin + val(copy(dllversion,l+1,255),minor,error); + if (error=0) and + (minor>=0) and (minor<=$ffff) then + dllminor:=minor + else + if error=0 then + error:=1; + end; + if l=0 then + l:=256; + dllmajor:=1; + if error=0 then + val(copy(dllversion,1,l-1),major,error); + if (error=0) and (major>=0) and (major<=$ffff) then + dllmajor:=major + else + if error=0 then + error:=1; + if error<>0 then + Message1(scan_w_wrong_version_ignored,dllversion); + break; + end; + 'w' : + usewindowapi:=true; + '-' : + begin + exclude(init_settings.globalswitches,cs_link_deffile); + usewindowapi:=false; + end; + else + IllegalPara(opt); + end; + inc(j); + end; + end; + + 'e' : + exepath:=FixPath(More,true); + + 'E' : + begin + if UnsetBool(More, 0) then + exclude(init_settings.globalswitches,cs_link_nolink) + else + include(init_settings.globalswitches,cs_link_nolink); + end; + + 'f' : + begin + if more='PIC' then + begin + if tf_no_pic_supported in target_info.flags then + message(scan_w_pic_ignored) + else + include(init_settings.moduleswitches,cs_create_pic) + end + else + IllegalPara(opt); + end; + + 'F' : + begin + if more='' then + IllegalPara(opt); + c:=more[1]; + Delete(more,1,1); + DefaultReplacements(More); + case c of + 'a' : + autoloadunits:=more; + 'c' : + begin + if (upper(more)='UTF8') or (upper(more)='UTF-8') then + init_settings.sourcecodepage:=CP_UTF8 + else if not(cpavailable(more)) then + Message1(option_code_page_not_available,more) + else + init_settings.sourcecodepage:=codepagebyname(more); + include(init_settings.moduleswitches,cs_explicit_codepage); + end; + 'C' : + RCCompiler := More; + 'd' : + if UnsetBool(more, 0) then + init_settings.disabledircache:=false + else + init_settings.disabledircache:=true; + 'D' : + utilsdirectory:=FixPath(More,true); + 'e' : + SetRedirectFile(More); + 'E' : + OutputExeDir:=FixPath(More,true); + 'f' : + if (target_info.system in systems_darwin) then + if ispara then + ParaFrameworkPath.AddPath(More,false) + else + frameworksearchpath.AddPath(More,true) + else + IllegalPara(opt); + 'i' : + begin + if ispara then + ParaIncludePath.AddPath(More,false) + else + includesearchpath.AddPath(More,true); + end; + 'm' : + begin + s:=ExtractFileDir(more); + if TryStrToInt(ExtractFileName(more),j) then + begin + unicodemapping:=loadunicodemapping(More,More+'.txt',j); + if assigned(unicodemapping) then + registermapping(unicodemapping) + else + IllegalPara(opt); + end + else + IllegalPara(opt); + end; + 'g' : + Message2(option_obsolete_switch_use_new,'-Fg','-Fl'); + 'l' : + begin + if ispara then + ParaLibraryPath.AddPath(sysrootpath,More,false) + else + LibrarySearchPath.AddPath(sysrootpath,More,true); + end; + 'L' : + begin + if More<>'' then + ParaDynamicLinker:=More + else + IllegalPara(opt); + end; + 'o' : + begin + if ispara then + ParaObjectPath.AddPath(More,false) + else + ObjectSearchPath.AddPath(More,true); + end; + 'r' : + Msgfilename:=More; + 'R' : + ResCompiler := More; + 'u' : + begin + if ispara then + ParaUnitPath.AddPath(More,false) + else + unitsearchpath.AddPath(More,true); + end; + 'U' : + OutputUnitDir:=FixPath(More,true); + 'W', + 'w': + begin + if More<>'' then + begin + DefaultReplacements(More); + D:=ExtractFilePath(More); + if (D<>'') then + D:=FixPath(D,True); + D:=D+ExtractFileName(More); + if (c='W') then + WpoFeedbackOutput:=D + else + WpoFeedbackInput:=D; + end + else + IllegalPara(opt); + end; + else + IllegalPara(opt); + end; + end; + + 'g' : + begin + if UnsetBool(More, 0) then + begin + exclude(init_settings.moduleswitches,cs_debuginfo); + exclude(init_settings.globalswitches,cs_use_heaptrc); + exclude(init_settings.globalswitches,cs_use_lineinfo); + exclude(init_settings.localswitches,cs_checkpointer); + localvartrashing := -1; + end + else + begin + include(init_settings.moduleswitches,cs_debuginfo); + if paratargetdbg=dbg_none then + paratargetdbg:=target_info.dbg; + end; + if not RelocSectionSetExplicitly then + RelocSection:=false; + j:=1; + while j<=length(more) do + begin + case more[j] of + 'c' : + begin + if UnsetBool(More, j) then + exclude(init_settings.localswitches,cs_checkpointer) + else if (target_info.system in supported_targets_gc) then + include(init_settings.localswitches,cs_checkpointer) + else + UnsupportedPara('-gc'); + end; + 'h' : + begin + if UnsetBool(More, j) then + exclude(init_settings.globalswitches,cs_use_heaptrc) + else + include(init_settings.globalswitches,cs_use_heaptrc); + end; + 'l' : + begin + if UnsetBool(More, j) then + exclude(init_settings.globalswitches,cs_use_lineinfo) + else + include(init_settings.globalswitches,cs_use_lineinfo); + end; + 'o' : + begin + if not UpdateDebugStr(copy(more,j+1,length(more)),init_settings.debugswitches) then + IllegalPara(opt); + break; + end; + 'p' : + begin + if UnsetBool(More, j) then + exclude(init_settings.globalswitches,cs_stabs_preservecase) + else + include(init_settings.globalswitches,cs_stabs_preservecase); + end; + 's' : + begin + paratargetdbg:=dbg_stabs; + end; + 't' : + begin + if UnsetBool(More, j) then + localvartrashing := -1 + else + localvartrashing := (localvartrashing + 1) mod nroftrashvalues; + end; + 'v' : + begin + if UnsetBool(More, j) then + exclude(init_settings.globalswitches,cs_gdb_valgrind) + else + include(init_settings.globalswitches,cs_gdb_valgrind); + end; + 'w' : + begin + if (j<length(more)) and (more[j+1] in ['2','3','4']) then + begin + case more[j+1] of + '2': paratargetdbg:=dbg_dwarf2; + '3': paratargetdbg:=dbg_dwarf3; + '4': paratargetdbg:=dbg_dwarf4; + end; + inc(j); + end + else + paratargetdbg:=dbg_dwarf2; + end; + else + IllegalPara(opt); + end; + inc(j); + end; + end; + + 'h' : + begin + NoPressEnter:=true; + WriteHelpPages; + end; + + 'i' : + begin + if More='' then + WriteInfo + else + QuickInfo:=QuickInfo+More; + end; + + 'I' : + begin + if ispara then + ParaIncludePath.AddPath(More,false) + else + includesearchpath.AddPath(More,false); + end; + + 'k' : + begin + if more<>'' then + ParaLinkOptions:=ParaLinkOptions+' '+More + else + IllegalPara(opt); + end; + + 'l' : + ParaLogo:=not UnSetBool(more,0); + + 'm' : + parapreprocess:=not UnSetBool(more,0); + + 'M' : + begin + more:=Upper(more); + if not SetCompileMode(more, true) then + if not SetCompileModeSwitch(more, true) then + IllegalPara(opt); + end; + + 'n' : + begin + if More='' then + disable_configfile:=true + else + IllegalPara(opt); + end; + + 'o' : + begin + if More<>'' then + begin + DefaultReplacements(More); + D:=ExtractFilePath(More); + if (D<>'') then + OutputExeDir:=FixPath(D,True); + OutputFileName:=ExtractFileName(More); + end + else + IllegalPara(opt); + end; + + 'O' : + begin + j:=1; + while j<=length(more) do + begin + case more[j] of + '1' : + init_settings.optimizerswitches:=init_settings.optimizerswitches+level1optimizerswitches; + '2' : + init_settings.optimizerswitches:=init_settings.optimizerswitches+level2optimizerswitches; + '3' : + init_settings.optimizerswitches:=init_settings.optimizerswitches+level3optimizerswitches; + 'a' : + begin + if not(UpdateAlignmentStr(Copy(Opt,j+3,255),ParaAlignment)) then + IllegalPara(opt); + break; + end; + 's' : + include(init_settings.optimizerswitches,cs_opt_size); + 'p' : + begin + if not Setcputype(copy(more,j+1,length(more)),init_settings.optimizecputype) then + begin + OptCPUSetExplicitly:=true; + { Give warning for old i386 switches } + if (Length(More)-j=1) and + (More[j+1]>='1') and (More[j+1]<='5')then + Message2(option_obsolete_switch_use_new,'-Op<nr>','-Op<name>') + else + IllegalPara(opt); + end; + break; + end; + 'o' : + begin + if not UpdateOptimizerStr(copy(more,j+1,length(more)),init_settings.optimizerswitches) then + IllegalPara(opt); + break; + end; + '-' : + begin + init_settings.optimizerswitches:=[]; + FillChar(ParaAlignment,sizeof(ParaAlignment),0); + end; + { Obsolete switches } + 'g' : + Message2(option_obsolete_switch_use_new,'-Og','-Os'); + 'G' : + Message1(option_obsolete_switch,'-OG'); + 'r' : + Message2(option_obsolete_switch_use_new,'-Or','-O2 or -Ooregvar'); + 'u' : + Message2(option_obsolete_switch_use_new,'-Ou','-Oouncertain'); + 'w' : + begin + if not UpdateWpoStr(copy(more,j+1,length(more)),init_settings.dowpoptimizerswitches) then + IllegalPara(opt); + break; + end; + 'W' : + begin + if not UpdateWpoStr(copy(more,j+1,length(more)),init_settings.genwpoptimizerswitches) then + IllegalPara(opt); + break; + end; + else + IllegalPara(opt); + end; + inc(j); + end; + end; + + 'p' : + begin + if UnsetBool(More, 0) then + begin + init_settings.moduleswitches:=init_settings.moduleswitches-[cs_profile]; + undef_system_macro('FPC_PROFILE'); + end + else + if Length(More)=0 then + IllegalPara(opt) + else + case more[1] of + 'g' : if UnsetBool(more, 1) then + begin + exclude(init_settings.moduleswitches,cs_profile); + undef_system_macro('FPC_PROFILE'); + end + else if (target_info.system in supported_targets_pg) then + begin + include(init_settings.moduleswitches,cs_profile); + def_system_macro('FPC_PROFILE'); + end + else + UnsupportedPara('-pg'); + else + IllegalPara(opt); + end; + end; + + 'P' : ; { Ignore used by fpc.pp } + + 'R' : + begin + if not SetAsmReadMode(More,init_settings.asmmode) then + IllegalPara(opt); + end; + + 's' : + begin + if UnsetBool(More, 0) then + begin + init_settings.globalswitches:=init_settings.globalswitches-[cs_asm_extern,cs_link_extern,cs_link_nolink]; + if more<>'' then + IllegalPara(opt); + end + else + begin + init_settings.globalswitches:=init_settings.globalswitches+[cs_asm_extern,cs_link_extern,cs_link_nolink]; + if more='h' then + init_settings.globalswitches:=init_settings.globalswitches-[cs_link_on_target] + else if more='t' then + init_settings.globalswitches:=init_settings.globalswitches+[cs_link_on_target] + else if more='r' then + init_settings.globalswitches:=init_settings.globalswitches+[cs_asm_leave,cs_no_regalloc] + else if more<>'' then + IllegalPara(opt); + end; + end; + + 'S' : + begin + if more='' then + IllegalPara(opt); + if more[1]='I' then + begin + if upper(more)='ICOM' then + init_settings.interfacetype:=it_interfacecom + else if upper(more)='ICORBA' then + init_settings.interfacetype:=it_interfacecorba + else + IllegalPara(opt); + end + else + begin + j:=1; + while j<=length(more) do + begin + case more[j] of + '2' : //an alternative to -Mobjfpc + SetCompileMode('OBJFPC',true); + 'a' : + If UnsetBool(More, j) then + exclude(init_settings.localswitches,cs_do_assertion) + else + include(init_settings.localswitches,cs_do_assertion); + 'c' : + If UnsetBool(More, j) then + include(init_settings.moduleswitches,cs_support_c_operators) + else + include(init_settings.moduleswitches,cs_support_c_operators); + 'd' : //an alternative to -Mdelphi + SetCompileMode('DELPHI',true); + 'e' : + begin + SetErrorFlags(copy(more,j+1,length(more))); + break; + end; + 'f' : + begin + inc(j); + if more[j]='-' then + begin + features:=[]; + if length(more)>j then + IllegalPara(opt); + end + else + begin + if (IncludeFeature(upper(copy(more,j,length(more)-j+1)))) then + j:=length(more) + else + IllegalPara(opt); + end; + end; + 'g' : + If UnsetBool(More, j) then + exclude(init_settings.moduleswitches,cs_support_goto) + else + include(init_settings.moduleswitches,cs_support_goto); + 'h' : + If UnsetBool(More, j) then + exclude(init_settings.localswitches,cs_ansistrings) + else + include(init_settings.localswitches,cs_ansistrings); + 'i' : + If UnsetBool(More, j) then + exclude(init_settings.localswitches,cs_do_inline) + else + include(init_settings.localswitches,cs_do_inline); + 'k' : + If UnsetBool(More, j) then + exclude(init_settings.globalswitches,cs_load_fpcylix_unit) + else + include(init_settings.globalswitches,cs_load_fpcylix_unit); + 'm' : + If UnsetBool(More, j) then + exclude(init_settings.moduleswitches,cs_support_macro) + else + include(init_settings.moduleswitches,cs_support_macro); + 'o' : //an alternative to -Mtp + SetCompileMode('TP',true); +{$ifdef gpc_mode} + 'p' : //an alternative to -Mgpc + SetCompileMode('GPC',true); +{$endif} + 's' : + If UnsetBool(More, j) then + exclude(init_settings.globalswitches,cs_constructor_name) + else + include(init_settings.globalswitches,cs_constructor_name); + 't' : + Message1(option_obsolete_switch,'-St'); + 'v' : + If UnsetBool(More, j) then + exclude(init_settings.globalswitches,cs_support_vectors) + else + include(init_settings.globalswitches,cs_support_vectors); + 'x' : + If UnsetBool(More, j) then + exclude(init_settings.globalswitches,cs_support_exceptions) + else + include(init_settings.globalswitches,cs_support_exceptions); + 'y' : + If UnsetBool(More, j) then + exclude(init_settings.localswitches,cs_typed_addresses) + else + include(init_settings.localswitches,cs_typed_addresses); + '-' : + begin + init_settings.globalswitches:=init_settings.globalswitches - [cs_constructor_name,cs_support_exceptions, + cs_support_vectors,cs_load_fpcylix_unit]; + + init_settings.localswitches:=init_settings.localswitches - [cs_do_assertion,cs_do_inline, cs_ansistrings, + cs_typed_addresses]; + + init_settings.moduleswitches:=init_settings.moduleswitches - [cs_support_c_operators, cs_support_goto, + cs_support_macro]; + end; + else + IllegalPara(opt); + end; + inc(j); + end; + end; + end; + + 'T' : + begin + more:=Upper(More); + if paratarget=system_none then + begin + { remove old target define } + TargetOptions(false); + { load new target } + paratarget:=find_system_by_string(More); + if paratarget<>system_none then + set_target(paratarget) + else + IllegalPara(opt); + { set new define } + TargetOptions(true); + end + else + if More<>upper(target_info.shortname) then + Message1(option_target_is_already_set,target_info.shortname); + end; + + 'u' : + if more <> '' then + undef_system_macro(more); + 'U' : + begin + j:=1; + while j<=length(more) do + begin + case more[j] of +{$ifdef UNITALIASES} + 'a' : + begin + AddUnitAlias(Copy(More,j+1,255)); + break; + end; +{$endif UNITALIASES} + 'n' : + exclude(init_settings.globalswitches,cs_check_unit_name); + 'p' : + begin + Message2(option_obsolete_switch_use_new,'-Up','-Fu'); + break; + end; + 'r' : + do_release:=true; + 's' : + include(init_settings.moduleswitches,cs_compilesystem); + '-' : + begin + exclude(init_settings.moduleswitches,cs_compilesystem); + exclude(init_settings.globalswitches,cs_check_unit_name); + end; + else + IllegalPara(opt); + end; + inc(j); + end; + end; + + 'v' : + begin + if not setverbosity(More) then + IllegalPara(opt); + end; + + 'V' : ; { Ignore used by fpc } + + 'W' : + begin + j:=1; + while j<=length(More) do + begin + case More[j] of + 'A': + begin + if target_info.system in systems_all_windows then + begin + if UnsetBool(More, j) then + apptype:=app_cui + else + apptype:=app_native; + end + else + IllegalPara(opt); + end; + 'b': + begin + if target_info.system in systems_darwin then + begin + if UnsetBool(More, j) then + apptype:=app_cui + else + apptype:=app_bundle + end + else + IllegalPara(opt); + end; + 'B': + begin + if target_info.system in systems_all_windows+systems_symbian then + begin + { -WB200000 means set trefered base address + to $200000, but does not change relocsection boolean + this way we can create both relocatble and + non relocatable DLL at a specific base address PM } + if (length(More)>j) then + begin + val('$'+Copy(More,j+1,255),imagebase,code); + if code<>0 then + IllegalPara(opt); + ImageBaseSetExplicity:=true; + end + else + begin + RelocSection:=true; + RelocSectionSetExplicitly:=true; + end; + break; + end + else + IllegalPara(opt); + end; + 'C': + begin + if target_info.system in systems_all_windows+systems_os2+systems_macos then + begin + if UnsetBool(More, j) then + apptype:=app_gui + else + apptype:=app_cui; + end + else + IllegalPara(opt); + end; + 'D': + begin + if target_info.system in systems_all_windows then + begin + UseDeffileForExports:=not UnsetBool(More, j); + UseDeffileForExportsSetExplicitly:=true; + end + else + IllegalPara(opt); + end; + 'e': + begin + if (target_info.system in systems_darwin) then + begin + RegisterRes(res_macosx_ext_info,TWinLikeResourceFile); + set_target_res(res_ext); + target_info.resobjext:='.fpcres'; + end + else + IllegalPara(opt); + end; + 'F': + begin + if target_info.system in systems_os2 then + begin + if UnsetBool(More, j) then + apptype:=app_cui + else + apptype:=app_fs; + end + else + IllegalPara(opt); + end; + 'G': + begin + if target_info.system in systems_all_windows+systems_os2+systems_macos then + begin + if UnsetBool(More, j) then + apptype:=app_cui + else + apptype:=app_gui; + end + else + IllegalPara(opt); + end; + 'I': + begin + if target_info.system in systems_all_windows then + begin + GenerateImportSection:=not UnsetBool(More,j); + GenerateImportSectionSetExplicitly:=true; + end + else + IllegalPara(opt); + end; + 'i': + begin + if (target_info.system in systems_darwin) then + begin + set_target_res(res_macho); + target_info.resobjext:= + targetinfos[target_info.system]^.resobjext; + end + else + IllegalPara(opt); + end; + 'N': + begin + if target_info.system in systems_all_windows then + begin + RelocSection:=UnsetBool(More,j); + RelocSectionSetExplicitly:=true; + end + else + IllegalPara(opt); + end; + 'p': + begin +{$if defined(arm) or defined(avr)} + if (target_info.system in systems_embedded) then + begin + s:=upper(copy(more,j+1,length(more)-j)); + if not(SetControllerType(s,init_settings.controllertype)) then + IllegalPara(opt); + break; + end + else +{$endif defined(arm) or defined(avr)} + IllegalPara(opt); + end; + 'R': + begin + if target_info.system in systems_all_windows then + begin + { support -WR+ / -WR- as synonyms to -WR / -WN } + RelocSection:=not UnsetBool(More,j); + RelocSectionSetExplicitly:=true; + end + else + IllegalPara(opt); + end; + 'T': + begin + if target_info.system in systems_macos then + begin + if UnsetBool(More, j) then + apptype:=app_cui + else + apptype:=app_tool; + end + else + IllegalPara(opt); + end; + 'X': + begin + if (target_info.system in systems_linux) then + begin + if UnsetBool(More, j) then + exclude(init_settings.moduleswitches,cs_executable_stack) + else + include(init_settings.moduleswitches,cs_executable_stack) + end + else + IllegalPara(opt); + end + else + IllegalPara(opt); + end; + inc(j); + end; + end; + + 'X' : + begin + j:=1; + while j<=length(more) do + begin + case More[j] of + 'c' : Cshared:=TRUE; + 'd' : Dontlinkstdlibpath:=TRUE; + 'e' : + begin + If UnsetBool(More, j) then + exclude(init_settings.globalswitches,cs_link_extern) + else + include(init_settings.globalswitches,cs_link_extern); + end; + 'f' : + include(init_settings.globalswitches,cs_link_pthread); + 'g' : + begin + If UnsetBool(More, j) then + exclude(init_settings.globalswitches,cs_link_separate_dbg_file) + else + include(init_settings.globalswitches,cs_link_separate_dbg_file); + end; + 'i' : + begin + If UnsetBool(More, j) then + include(init_settings.globalswitches,cs_link_extern) + else + exclude(init_settings.globalswitches,cs_link_extern); + end; + 'n' : + begin + If UnsetBool(More, j) then + exclude(init_settings.globalswitches,cs_link_native) + else + include(init_settings.globalswitches,cs_link_native); + end; + + 'm' : + begin + If UnsetBool(More, j) then + exclude(init_settings.globalswitches,cs_link_map) + else + include(init_settings.globalswitches,cs_link_map); + end; + 'p' : ; { Ignore used by fpc.pp } + 'r' : + begin + if (target_info.system in suppported_targets_x_smallr) then + begin + rlinkpath:=Copy(more,2,length(More)-1); + DefaultReplacements(rlinkpath); + end + else + IgnoredPara('-Xr'); + more:=''; + end; + 'R' : + begin + sysrootpath:=copy(more,2,length(more)-1); + defaultreplacements(sysrootpath); + more:=''; + end; + 's' : + begin + If UnsetBool(More, j) then + exclude(init_settings.globalswitches,cs_link_strip) + else + include(init_settings.globalswitches,cs_link_strip); + end; + 't' : + include(init_settings.globalswitches,cs_link_staticflag); + 'v' : + begin + If UnsetBool(More, j) then + exclude(init_settings.globalswitches,cs_link_opt_vtable) + else + include(init_settings.globalswitches,cs_link_opt_vtable); + end; + 'D' : + begin + def_system_macro('FPC_LINK_DYNAMIC'); + undef_system_macro('FPC_LINK_SMART'); + undef_system_macro('FPC_LINK_STATIC'); + exclude(init_settings.globalswitches,cs_link_static); + exclude(init_settings.globalswitches,cs_link_smart); + include(init_settings.globalswitches,cs_link_shared); + LinkTypeSetExplicitly:=true; + end; + 'M' : + begin + mainaliasname:=Copy(more,2,length(More)-1); + More:=''; + end; + 'P' : + begin + utilsprefix:=Copy(more,2,length(More)-1); + DefaultReplacements(utilsprefix); + More:=''; + end; + 'L' : begin // -XLO is link order -XLA is link alias. -XLD avoids load defaults. + // these are not aggregable. + if (j=length(more)) or not (more[j+1] in ['O','A','D']) then + IllegalPara(opt) + else + begin + case more[j+1] of + 'A' : begin + s:=Copy(more,3,length(More)-2); + if not LinkLibraryAliases.AddDep(s) Then + IllegalPara(opt); + end; + 'O' : begin + s:=Copy(more,3,length(More)-2); + if not LinkLibraryOrder.AddWeight(s) Then + IllegalPara(opt); + end; + 'D' : include(init_settings.globalswitches,cs_link_no_default_lib_order) + else + IllegalPara(opt); + end; {case} + j:=length(more); + end; {else begin} + end; + 'S' : + begin + ForceStaticLinking; + end; + 'X' : + begin + def_system_macro('FPC_LINK_SMART'); + undef_system_macro('FPC_LINK_STATIC'); + undef_system_macro('FPC_LINK_DYNAMIC'); + exclude(init_settings.globalswitches,cs_link_static); + include(init_settings.globalswitches,cs_link_smart); + exclude(init_settings.globalswitches,cs_link_shared); + LinkTypeSetExplicitly:=true; + end; + '-' : + begin + exclude(init_settings.globalswitches,cs_link_staticflag); + exclude(init_settings.globalswitches,cs_link_strip); + exclude(init_settings.globalswitches,cs_link_map); + set_default_link_type; + end; + else + IllegalPara(opt); + end; + inc(j); + end; + end; + else + IllegalPara(opt); + end; + end; + + '@' : + begin + Message(option_no_nested_response_file); + StopOptions(1); + end; + + else + begin + if (length(param_file)<>0) then + Message2(option_only_one_source_support,param_file,opt); + param_file:=opt; + Message1(option_found_file,opt); + end; + end; +end; + + +procedure Toption.Interpret_file(const filename : TPathStr); + + procedure RemoveSep(var fn:TPathStr); + var + i : longint; + begin + i:=0; + while (i<length(fn)) and (fn[i+1] in [',',' ',#9]) do + inc(i); + Delete(fn,1,i); + i:=length(fn); + while (i>0) and (fn[i] in [',',' ',#9]) do + dec(i); + fn:=copy(fn,1,i); + end; + + function GetName(var fn:TPathStr):TPathStr; + var + i : longint; + begin + i:=0; + while (i<length(fn)) and (fn[i+1] in ['a'..'z','A'..'Z','0'..'9','_','-']) do + inc(i); + GetName:=Copy(fn,1,i); + Delete(fn,1,i); + end; + +const + maxlevel = 15; +var + f : text; + s, tmp, + opts : TCmdStr; + skip : array[0..maxlevel] of boolean; + line, + level : longint; + option_read : boolean; +begin +{ avoid infinite loop } + Inc(FileLevel); + Option_read:=false; + If FileLevel>MaxLevel then + Message(option_too_many_cfg_files); +{ Maybe It's Directory ?} //Jaro Change: + if PathExists(filename,false) then + begin + Message1(option_config_is_dir,filename); + exit; + end; +{ open file } + Message1(option_using_file,filename); + assign(f,ExpandFileName(filename)); + {$push}{$I-} + reset(f); + {$pop} + if ioresult<>0 then + begin + Message1(option_unable_open_file,filename); + exit; + end; + Message1(option_start_reading_configfile,filename); + fillchar(skip,sizeof(skip),0); + level:=0; + line:=0; + while not eof(f) do + begin + readln(f,opts); + inc(line); + RemoveSep(opts); + if (opts<>'') and (opts[1]<>';') then + begin + if opts[1]='#' then + begin + Message1(option_interpreting_file_option,opts); + Delete(opts,1,1); + s:=upper(GetName(opts)); + if (s='SECTION') then + begin + RemoveSep(opts); + s:=upper(GetName(opts)); + if level=0 then + skip[level]:=not defined_macro(s) or (s='COMMON'); + end + else + if (s='IFDEF') then + begin + RemoveSep(opts); + if Level>=maxlevel then + begin + Message2(option_too_many_ifdef,filename,tostr(line)); + stopOptions(1); + end; + inc(Level); + skip[level]:=(skip[level-1] or not defined_macro(upper(GetName(opts)))); + end + else + if (s='IFNDEF') then + begin + RemoveSep(opts); + if Level>=maxlevel then + begin + Message2(option_too_many_ifdef,filename,tostr(line)); + stopOptions(1); + end; + inc(Level); + skip[level]:=(skip[level-1] or defined_macro(upper(GetName(opts)))); + end + else + if (s='ELSE') then + begin + if Level=0 then + begin + Message2(option_else_without_if,filename,tostr(line)); + stopOptions(1); + end + else + skip[level]:=skip[level-1] or (not skip[level]) + end + else + if (s='ENDIF') then + begin + skip[level]:=false; + if Level=0 then + begin + Message2(option_too_many_endif,filename,tostr(line)); + stopOptions(1); + end; + dec(level); + end + else + if (not skip[level]) then + begin + if (s='DEFINE') then + begin + RemoveSep(opts); + tmp:= GetName(opts); + if tmp <> '' then + def_system_macro(tmp); + end + else + if (s='UNDEF') then + begin + RemoveSep(opts); + tmp:= GetName(opts); + if tmp <> '' then + undef_system_macro(tmp); + end + else + if (s='WRITE') then + begin + Delete(opts,1,1); + WriteLn(opts); + end + else + if (s='INCLUDE') then + begin + Delete(opts,1,1); + Interpret_file(opts); + end; + end; + end + else + begin + if (opts[1]='-') or (opts[1]='@') then + begin + if (not skip[level]) then + interpret_option(opts,false); + Option_read:=true; + end + else + Message1(option_illegal_para,opts); + end; + end; + end; + if Level>0 then + Message(option_too_less_endif); + if Not Option_read then + Message1(option_no_option_found,filename) + else + Message1(option_end_reading_configfile,filename); + Close(f); + Dec(FileLevel); +end; + + +procedure Toption.Interpret_envvar(const envname : TCmdStr); +var + argstart, + env, + pc : pchar; + arglen : longint; + quote : set of char; + hs : TCmdStr; +begin + Message1(option_using_env,envname); + env:=GetEnvPChar(envname); + pc:=env; + if assigned(pc) then + begin + repeat + { skip leading spaces } + while pc^ in [' ',#9,#13] do + inc(pc); + case pc^ of + #0 : + break; + '"' : + begin + quote:=['"']; + inc(pc); + end; + '''' : + begin + quote:=['''']; + inc(pc); + end; + else + quote:=[' ',#9,#13]; + end; + { scan until the end of the argument } + argstart:=pc; + while (pc^<>#0) and not(pc^ in quote) do + inc(pc); + { create argument } + arglen:=pc-argstart; +{ TODO: FIXME: silent truncation of environment parameters } + if (arglen > 255) then + arglen := 255; + setlength(hs,arglen); + move(argstart^,hs[1],arglen); + interpret_option(hs,true); + { skip quote } + if pc^ in quote then + inc(pc); + until false; + end + else + Message1(option_no_option_found,'(env) '+envname); + FreeEnvPChar(env); +end; + + +procedure toption.read_parameters; +var + opts : TCmdStr; + paramindex : longint; +begin + paramindex:=0; + while paramindex<paramcount do + begin + inc(paramindex); + opts:=objpas.paramstr(paramindex); + if length(opts)>0 then + case opts[1] of + '@' : + if not firstpass then + begin + Delete(opts,1,1); + Message1(option_reading_further_from,opts); + interpret_file(opts); + end; + '!' : + if not firstpass then + begin + Delete(opts,1,1); + Message1(option_reading_further_from,'(env) '+opts); + interpret_envvar(opts); + end; + else + interpret_option(opts,true); + end; + end; +end; + + +procedure toption.parsecmd(cmd:TCmdStr); +var + i,ps : longint; + opts : TCmdStr; +begin + while (cmd<>'') do + begin + while cmd[1]=' ' do + delete(cmd,1,1); + i:=pos(' ',cmd); + if i=0 then + i:=2147483647; + opts:=Copy(cmd,1,i-1); + Delete(cmd,1,i); + case opts[1] of + '@' : + if not firstpass then + begin + Delete(opts,1,1); + Message1(option_reading_further_from,opts); + interpret_file(opts); + end; + '!' : + if not firstpass then + begin + Delete(opts,1,1); + Message1(option_reading_further_from,'(env) '+opts); + interpret_envvar(opts); + end; + '"' : + begin + Delete(opts,1,1); + ps:=pos('"',cmd); + if (i<>256) and (ps>0) then + begin + opts:=opts + ' '+ copy(cmd,1,ps-1); + cmd:=copy(cmd,ps+1,255); + end; + interpret_option(opts,true); + end; + else + interpret_option(opts,true); + end; + end; +end; + + +procedure toption.writequickinfo; +var + s : string; + i : longint; + + procedure addinfo(const hs:string); + begin + if s<>'' then + s:=s+' '+hs + else + s:=hs; + end; + +begin + s:=''; + i:=0; + while (i<length(quickinfo)) do + begin + inc(i); + case quickinfo[i] of + 'S' : + begin + inc(i); + case quickinfo[i] of + 'O' : + addinfo(lower(source_info.shortname)); + 'P' : + addinfo(source_cpu_string); + else + IllegalPara('-i'+QuickInfo); + end; + end; + 'T' : + begin + inc(i); + case quickinfo[i] of + 'O' : + addinfo(lower(target_info.shortname)); + 'P' : + AddInfo(target_cpu_string); + else + IllegalPara('-i'+QuickInfo); + end; + end; + 'V' : + AddInfo(version_string); + 'W' : + AddInfo(full_version_string); + 'D' : + AddInfo(date_string); + '_' : + ; + else + IllegalPara('-i'+QuickInfo); + end; + end; + if s<>'' then + begin + writeln(s); + stopoptions(0); + end; +end; + + +procedure TOption.TargetOptions(def:boolean); +var + s : string; + i : integer; + target_unsup_features : tfeatures; +begin + if def then + def_system_macro(target_info.shortname) + else + undef_system_macro(target_info.shortname); + + s:=target_info.extradefines; + while (s<>'') do + begin + i:=pos(';',s); + if i=0 then + i:=length(s)+1; + if def then + def_system_macro(Copy(s,1,i-1)) + else + undef_system_macro(Copy(s,1,i-1)); + delete(s,1,i); + end; + + if (tf_winlikewidestring in target_info.flags) then + if def then + def_system_macro('FPC_WINLIKEWIDESTRING') + else + undef_system_macro('FPC_WINLIKEWIDESTRING'); + + if (tf_requires_proper_alignment in target_info.flags) then + if def then + def_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT') + else + undef_system_macro('FPC_REQUIRES_PROPER_ALIGNMENT'); + + if source_info.system<>target_info.system then + if def then + def_system_macro('FPC_CROSSCOMPILING') + else + undef_system_macro('FPC_CROSSCOMPILING'); + + if source_info.cpu<>target_info.cpu then + if def then + def_system_macro('FPC_CPUCROSSCOMPILING') + else + def_system_macro('FPC_CPUCROSSCOMPILING'); + + if (tf_no_generic_stackcheck in target_info.flags) then + if def then + def_system_macro('FPC_NO_GENERIC_STACK_CHECK') + else + undef_system_macro('FPC_NO_GENERIC_STACK_CHECK'); + + { Code generation flags } + if def and + (tf_pic_default in target_info.flags) then + include(init_settings.moduleswitches,cs_create_pic) + else + exclude(init_settings.moduleswitches,cs_create_pic); + + { Resources support } + if (tf_has_winlike_resources in target_info.flags) then + if def then + def_system_macro('FPC_HAS_WINLIKERESOURCES') + else + undef_system_macro('FPC_HAS_WINLIKERESOURCES'); + + { Features } + case target_info.system of + system_arm_gba: + target_unsup_features:=[f_dynlibs]; + system_arm_nds: + target_unsup_features:=[f_threading,f_commandargs,f_fileio,f_textio,f_consoleio,f_dynlibs]; + system_i386_nativent: + // until these features are implemented, they are disabled in the compiler + target_unsup_features:=[f_stackcheck]; + else + target_unsup_features:=[]; + end; + if def then + features:=features-target_unsup_features + else + features:=features+target_unsup_features; +end; + +procedure TOption.checkoptionscompatibility; +begin + if (paratargetdbg in [dbg_dwarf2,dbg_dwarf3]) and + not(target_info.system in systems_darwin) then + begin + { smartlink creation does not yet work with DWARF + debug info on most targets, but it works in internal assembler } + if (cs_create_smart in init_settings.moduleswitches) and + not (af_outputbinary in target_asm.flags) then + begin + Message(option_dwarf_smartlink_creation); + exclude(init_settings.moduleswitches,cs_create_smart); + end; + + { smart linking does not yet work with DWARF debug info on most targets } + if (cs_link_smart in init_settings.globalswitches) then + begin + Message(option_dwarf_smart_linking); + ForceStaticLinking; + end; + end; + + { external debug info is only supported for DWARF on darwin } + if (target_info.system in systems_darwin) and + (cs_link_separate_dbg_file in init_settings.globalswitches) and + not(paratargetdbg in [dbg_dwarf2,dbg_dwarf3]) then + begin + Message(option_debug_external_unsupported); + exclude(init_settings.globalswitches,cs_link_separate_dbg_file); + end; +end; + + +constructor TOption.create; +begin + LogoWritten:=false; + NoPressEnter:=false; + FirstPass:=false; + FPUSetExplicitly:=false; + CPUSetExplicitly:=false; + OptCPUSetExplicitly:=false; + FileLevel:=0; + Quickinfo:=''; + ParaIncludePath:=TSearchPathList.Create; + ParaObjectPath:=TSearchPathList.Create; + ParaUnitPath:=TSearchPathList.Create; + ParaLibraryPath:=TSearchPathList.Create; + ParaFrameworkPath:=TSearchPathList.Create; + FillChar(ParaAlignment,sizeof(ParaAlignment),0); +end; + + +destructor TOption.destroy; +begin + ParaIncludePath.Free; + ParaObjectPath.Free; + ParaUnitPath.Free; + ParaLibraryPath.Free; + ParaFrameworkPath.Free; +end; + + +{**************************************************************************** + Callable Routines +****************************************************************************} + +function check_configfile(const fn:string;var foundfn:string):boolean; + + function CfgFileExists(const fn:string):boolean; + begin + Comment(V_Tried,'Configfile search: '+fn); + CfgFileExists:=FileExists(fn); + end; + +var +{$ifdef Unix} + hs, +{$endif Unix} + configpath : string; +begin + foundfn:=fn; + check_configfile:=true; + { retrieve configpath } + configpath:=FixPath(GetEnvironmentVariable('PPC_CONFIG_PATH'),false); +{$ifdef Unix} + if configpath='' then + configpath:=ExpandFileName(FixPath(exepath+'../etc/',false)); +{$endif} + { + Order to read configuration file : + try reading fpc.cfg in : + 1 - current dir + 2 - configpath + 3 - compiler path + } + if not FileExists(fn) then + begin +{$ifdef Unix} + hs:=GetEnvironmentVariable('HOME'); + if (hs<>'') and CfgFileExists(FixPath(hs,false)+'.'+fn) then + foundfn:=FixPath(hs,false)+'.'+fn + else +{$endif} + if CfgFileExists(configpath+fn) then + foundfn:=configpath+fn + else +{$ifdef WINDOWS} + if (GetEnvironmentVariable('USERPROFILE')<>'') and CfgFileExists(FixPath(GetEnvironmentVariable('USERPROFILE'),false)+fn) then + foundfn:=FixPath(GetEnvironmentVariable('USERPROFILE'),false)+fn + else + if (GetEnvironmentVariable('ALLUSERSPROFILE')<>'') and CfgFileExists(FixPath(GetEnvironmentVariable('ALLUSERSPROFILE'),false)+fn) then + foundfn:=FixPath(GetEnvironmentVariable('ALLUSERSPROFILE'),false)+fn + else +{$endif WINDOWS} +{$ifndef Unix} + if CfgFileExists(exepath+fn) then + foundfn:=exepath+fn + else +{$else} + if CfgFileExists('/etc/'+fn) then + foundfn:='/etc/'+fn + else +{$endif} + check_configfile:=false; + end; +end; + + +procedure read_arguments(cmd:TCmdStr); +var + env: ansistring; + i : tfeature; + abi : tabi; +begin + option:=coption.create; + disable_configfile:=false; + + { Non-core target defines } + Option.TargetOptions(true); + +{ get default messagefile } + msgfilename:=GetEnvironmentVariable('PPC_ERROR_FILE'); + +{ default configfile can be specified on the commandline, + remove it first } + if (cmd<>'') and (cmd[1]='[') then + begin + ppccfg:=Copy(cmd,2,pos(']',cmd)-2); + Delete(cmd,1,pos(']',cmd)); + end + else + ppccfg:='fpc.cfg'; + +{ first pass reading of parameters, only -i -v -T etc.} + option.firstpass:=true; + if cmd<>'' then + option.parsecmd(cmd) + else + begin + option.read_parameters; + { Write only quickinfo } + if option.quickinfo<>'' then + option.writequickinfo; + end; + option.firstpass:=false; + + { redefine target options so all defines are written even if no -Txxx is passed on the command line } + Option.TargetOptions(true); + +{ target is set here, for wince the default app type is gui } + if target_info.system in systems_wince then + apptype:=app_gui; + +{ default defines } + def_system_macro(target_info.shortname); + def_system_macro('FPC'); + def_system_macro('VER'+version_nr); + def_system_macro('VER'+version_nr+'_'+release_nr); + def_system_macro('VER'+version_nr+'_'+release_nr+'_'+patch_nr); + +{ Temporary defines, until things settle down } + def_system_macro('RESSTRSECTIONS'); + def_system_macro('FPC_HASFIXED64BITVARIANT'); + def_system_macro('FPC_HASINTERNALOLEVARIANT2VARIANTCAST'); + def_system_macro('FPC_HAS_VARSETS'); + def_system_macro('FPC_HAS_VALGRINDBOOL'); + def_system_macro('FPC_HAS_STR_CURRENCY'); + def_system_macro('FPC_REAL2REAL_FIXED'); + def_system_macro('FPC_STRTOCHARARRAYPROC'); + def_system_macro('FPC_STRTOSHORTSTRINGPROC'); + def_system_macro('FPC_OBJFPC_EXTENDED_IF'); + def_system_macro('FPC_HAS_OPERATOR_ENUMERATOR'); + def_system_macro('FPC_HAS_CONSTREF'); + def_system_macro('FPC_STATICRIPFIXED'); + def_system_macro('FPC_VARIANTCOPY_FIXED'); +{$if defined(x86) or defined(powerpc) or defined(powerpc64)} + def_system_macro('FPC_HAS_INTERNAL_ABS_LONG'); +{$endif} + def_system_macro('FPC_HAS_UNICODESTRING'); + def_system_macro('FPC_RTTI_PACKSET1'); + def_system_macro('FPC_HAS_CPSTRING'); +{$ifdef x86_64} + def_system_macro('FPC_HAS_RIP_RELATIVE'); +{$endif x86_64} + def_system_macro('FPC_HAS_CEXTENDED'); + def_system_macro('FPC_HAS_RESSTRINITS'); + +{ these cpus have an inline rol/ror implementaion } +{$ifdef cpurox} + def_system_macro('FPC_HAS_INTERNAL_ROX'); +{$endif} + +{ these cpus have an inline sar implementaion } +{ currently, all supported CPUs have an internal sar implementation } +{ $if defined(x86) or defined(arm) or defined(powerpc) or defined(powerpc64) or defined(sparc)} + def_system_macro('FPC_HAS_INTERNAL_SAR'); +{ $endif} + +{ inline bsf/bsr implementation } +{$if defined(x86) or defined(x86_64)} + def_system_macro('FPC_HAS_INTERNAL_BSX'); +{$endif} + +{$ifdef powerpc64} + def_system_macro('FPC_HAS_LWSYNC'); +{$endif} + def_system_macro('FPC_HAS_MEMBAR'); + def_system_macro('FPC_SETBASE_USED'); + +{$if defined(x86) or defined(arm)} + def_system_macro('INTERNAL_BACKTRACE'); +{$endif} + def_system_macro('STR_CONCAT_PROCS'); +{$warnings off} + if pocall_default = pocall_register then + def_system_macro('REGCALL'); +{$warnings on} + { don't remove this, it's also for fpdoc necessary (FK) } + def_system_macro('FPC_HAS_FEATURE_SUPPORT'); +{ using a case is pretty useless here (FK) } +{ some stuff for TP compatibility } +{$ifdef i386} + def_system_macro('CPU86'); + def_system_macro('CPU87'); + def_system_macro('CPU386'); +{$endif} + +{ new processor stuff } +{$ifdef i386} + def_system_macro('CPUI386'); + def_system_macro('CPU32'); + def_system_macro('FPC_HAS_TYPE_EXTENDED'); + def_system_macro('FPC_HAS_TYPE_DOUBLE'); + def_system_macro('FPC_HAS_TYPE_SINGLE'); +{$endif} +{$ifdef m68k} + def_system_macro('CPU68'); + def_system_macro('CPU68K'); + def_system_macro('CPUM68K'); + def_system_macro('CPU32'); + def_system_macro('FPC_CURRENCY_IS_INT64'); + def_system_macro('FPC_COMP_IS_INT64'); +{$endif} +{$ifdef ALPHA} + def_system_macro('CPUALPHA'); + def_system_macro('CPU64'); +{$endif} +{$ifdef powerpc} + def_system_macro('CPUPOWERPC'); + def_system_macro('CPUPOWERPC32'); + def_system_macro('CPU32'); + def_system_macro('FPC_CURRENCY_IS_INT64'); + def_system_macro('FPC_COMP_IS_INT64'); +{$endif} +{$ifdef POWERPC64} + def_system_macro('CPUPOWERPC'); + def_system_macro('CPUPOWERPC64'); + def_system_macro('CPU64'); + def_system_macro('FPC_CURRENCY_IS_INT64'); + def_system_macro('FPC_COMP_IS_INT64'); +{$endif} +{$ifdef iA64} + def_system_macro('CPUIA64'); + def_system_macro('CPU64'); +{$endif} +{$ifdef x86_64} + def_system_macro('CPUX86_64'); + def_system_macro('CPUAMD64'); + def_system_macro('CPU64'); + { not supported for now, afaik (FK) + def_system_macro('FPC_HAS_TYPE_FLOAT128'); } + { win64 doesn't support the legacy fpu } + if target_info.system=system_x86_64_win64 then + begin + def_system_macro('FPC_CURRENCY_IS_INT64'); + def_system_macro('FPC_COMP_IS_INT64'); + end; +{$endif} +{$ifdef sparc} + def_system_macro('CPUSPARC'); + def_system_macro('CPUSPARC32'); + def_system_macro('CPU32'); + def_system_macro('FPC_CURRENCY_IS_INT64'); + def_system_macro('FPC_COMP_IS_INT64'); +{$endif} +{$ifdef vis} + def_system_macro('CPUVIS'); + def_system_macro('CPU32'); +{$endif} +{$ifdef arm} + def_system_macro('CPUARM'); + def_system_macro('CPU32'); + def_system_macro('FPC_CURRENCY_IS_INT64'); + def_system_macro('FPC_COMP_IS_INT64'); +{$endif arm} +{$ifdef avr} + def_system_macro('CPUAVR'); + def_system_macro('CPU16'); + def_system_macro('FPC_CURRENCY_IS_INT64'); + def_system_macro('FPC_COMP_IS_INT64'); +{$endif avr} + + { read configuration file } + if (not disable_configfile) and + (ppccfg<>'') then + read_configfile:=check_configfile(ppccfg,ppccfg) + else + read_configfile := false; + +{ Read commandline and configfile } + param_file:=''; + + { read configfile } + if read_configfile then + option.interpret_file(ppccfg); + + { read parameters again to override config file } + if cmd<>'' then + option.parsecmd(cmd) + else + begin + { Write help pages if no parameters are passed } + if (paramcount=0) then + Option.WriteHelpPages; + option.read_parameters; + { Write only quickinfo } + if option.quickinfo<>'' then + option.writequickinfo; + end; + + { check the compatibility of different options and adjust them if necessary + (and print possible errors) + } + option.checkoptionscompatibility; + + { Stop if errors in options } + if ErrorCount>0 then + StopOptions(1); + + { endian define } + case target_info.endian of + endian_little : + begin + def_system_macro('ENDIAN_LITTLE'); + def_system_macro('FPC_LITTLE_ENDIAN'); + end; + endian_big : + begin + def_system_macro('ENDIAN_BIG'); + def_system_macro('FPC_BIG_ENDIAN'); + end; + end; + + { define abi } + for abi:=low(tabi) to high(tabi) do + undef_system_macro('FPC_ABI_'+abi2str[abi]); + def_system_macro('FPC_ABI_'+abi2str[target_info.abi]); + + { Write logo } + if option.ParaLogo then + option.writelogo; + +{ Check file to compile } + if param_file='' then + begin + Message(option_no_source_found); + StopOptions(1); + end; +{$ifndef Unix} + param_file:=FixFileName(param_file); +{$endif not unix} + inputfilepath:=ExtractFilePath(param_file); + inputfilename:=ExtractFileName(param_file); + if ExtractFileExt(inputfilename)='' then + begin + if FileExists(inputfilepath+ChangeFileExt(inputfilename,sourceext)) then + inputfilename:=ChangeFileExt(inputfilename,sourceext) + else if FileExists(inputfilepath+ChangeFileExt(inputfilename,pasext)) then + inputfilename:=ChangeFileExt(inputfilename,pasext) + else if ((m_mac in current_settings.modeswitches) or + (tf_p_ext_support in target_info.flags)) + and FileExists(inputfilepath+ChangeFileExt(inputfilename,pext)) then + inputfilename:=ChangeFileExt(inputfilename,pext); + end; + + { Check output dir } + if (OutputExeDir<>'') and + not PathExists(OutputExeDir,false) then + begin + Message1(general_e_path_does_not_exist,OutputExeDir); + StopOptions(1); + end; + + { Add paths specified with parameters to the searchpaths } + UnitSearchPath.AddList(option.ParaUnitPath,true); + ObjectSearchPath.AddList(option.ParaObjectPath,true); + IncludeSearchPath.AddList(option.ParaIncludePath,true); + LibrarySearchPath.AddList(option.ParaLibraryPath,true); + FrameworkSearchPath.AddList(option.ParaFrameworkPath,true); + + { add unit environment and exepath to the unit search path } + if inputfilepath<>'' then + Unitsearchpath.AddPath(inputfilepath,true); + if not disable_configfile then + begin + env:=GetEnvironmentVariable(target_info.unit_env); + if env<>'' then + UnitSearchPath.AddPath(GetEnvironmentVariable(target_info.unit_env),false); + end; + +{$ifdef Unix} + fpcdir:=FixPath(GetEnvironmentVariable('FPCDIR'),false); + if fpcdir='' then + begin + if PathExists('/usr/local/lib/fpc/'+version_string,true) then + fpcdir:='/usr/local/lib/fpc/'+version_string+'/' + else + fpcdir:='/usr/lib/fpc/'+version_string+'/'; + end; +{$else unix} + fpcdir:=FixPath(GetEnvironmentVariable('FPCDIR'),false); + if fpcdir='' then + begin + fpcdir:=ExePath+'../'; + if not(PathExists(fpcdir+'units',true)) and + not(PathExists(fpcdir+'rtl',true)) then + fpcdir:=fpcdir+'../'; + end; +{$endif unix} + { first try development RTL, else use the default installation path } + if not disable_configfile then + begin + if PathExists(FpcDir+'rtl',true) then + if tf_use_8_3 in Source_Info.Flags then + UnitSearchPath.AddPath(FpcDir+'rtl/'+target_os_string,false) + else + UnitSearchPath.AddPath(FpcDir+'rtl/'+target_full_string,false) + else + if tf_use_8_3 in Source_Info.Flags then + UnitSearchPath.AddPath(FpcDir+'units/'+target_os_string+'/rtl',false) + else + UnitSearchPath.AddPath(FpcDir+'units/'+target_full_string+'/rtl',false); + end; + { Add exepath if the exe is not in the current dir, because that is always searched already. + Do not add it when linking on the target because then we can maybe already find + .o files that are not for the target } + if (ExePath<>GetCurrentDir) and + not(cs_link_on_target in init_settings.globalswitches) then + UnitSearchPath.AddPath(ExePath,false); + { Add unit dir to the object and library path } + objectsearchpath.AddList(unitsearchpath,false); + librarysearchpath.AddList(unitsearchpath,false); + + { maybe override assembler } + if (paratargetasm<>as_none) then + begin + if not set_target_asm(paratargetasm) then + begin + Message2(option_incompatible_asm,asminfos[paratargetasm]^.idtxt,target_info.name); + set_target_asm(target_info.assemextern); + Message1(option_asm_forced,target_asm.idtxt); + end; + if (af_no_debug in asminfos[paratargetasm]^.flags) and + (paratargetdbg<>dbg_none) then + begin + Message1(option_confict_asm_debug, + asminfos[paratargetasm]^.idtxt); + paratargetdbg:=dbg_none; + exclude(init_settings.moduleswitches,cs_debuginfo); + end; + end; + {TOptionheck a second time as we might have changed assembler just above } + option.checkoptionscompatibility; + + { maybe override debug info format } + if (paratargetdbg<>dbg_none) then + set_target_dbg(paratargetdbg); + + { switch assembler if it's binary and we got -a on the cmdline } + if (cs_asm_leave in init_settings.globalswitches) and + (af_outputbinary in target_asm.flags) then + begin + Message(option_switch_bin_to_src_assembler); + set_target_asm(target_info.assemextern); + end; + + { Force use of external linker if there is no + internal linker or the linking is skipped } + if not(cs_link_extern in init_settings.globalswitches) and + (not assigned(target_info.link) or + (cs_link_nolink in init_settings.globalswitches)) then + include(init_settings.globalswitches,cs_link_extern); + + { turn off stripping if compiling with debuginfo or profile } + if ( + (cs_debuginfo in init_settings.moduleswitches) or + (cs_profile in init_settings.moduleswitches) + ) and + not(cs_link_separate_dbg_file in init_settings.globalswitches) then + exclude(init_settings.globalswitches,cs_link_strip); + + { force fpu emulation on arm/wince, arm/gba, arm/embedded, arm/nds and + arm/darwin if fpu type not explicitly set } + if not(option.FPUSetExplicitly) and + ((target_info.system in [system_arm_wince,system_arm_gba,system_m68k_amiga, + system_m68k_linux,system_arm_nds,system_arm_embedded,system_arm_darwin]) +{$ifdef arm} + or (target_info.abi=abi_eabi) +{$endif arm} + ) +{$ifdef arm} + or (init_settings.fputype=fpu_soft) +{$endif arm} + then + begin +{$ifdef cpufpemu} + include(init_settings.moduleswitches,cs_fp_emulation); + { cs_fp_emulation and fpu_soft are equal on arm } + init_settings.fputype:=fpu_soft; +{$endif cpufpemu} + end; + +{$ifdef arm} +{ set default cpu type to ARMv6 for Darwin unless specified otherwise } +if (target_info.system=system_arm_darwin) then + begin + if not option.CPUSetExplicitly then + init_settings.cputype:=cpu_armv6; + if not option.OptCPUSetExplicitly then + init_settings.optimizecputype:=cpu_armv6; + end; +{$endif arm} + + { now we can define cpu and fpu type } + def_system_macro('CPU'+Cputypestr[init_settings.cputype]); + + def_system_macro('FPU'+fputypestr[init_settings.fputype]); + + if init_settings.fputype<>fpu_none then + begin +{$if defined(i386)} + def_system_macro('FPC_HAS_TYPE_EXTENDED'); +{$endif} + def_system_macro('FPC_HAS_TYPE_SINGLE'); + def_system_macro('FPC_HAS_TYPE_DOUBLE'); +{$if not defined(i386) and not defined(x86_64)} + def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE'); +{$endif} +{$ifdef x86_64} + { win64 doesn't support the legacy fpu } + if target_info.system=system_x86_64_win64 then + undef_system_macro('FPC_HAS_TYPE_EXTENDED') + else + def_system_macro('FPC_HAS_TYPE_EXTENDED'); +{$endif} + end; + { Enable now for testing } +{$ifndef DISABLE_TLS_DIRECTORY} + if target_info.system in systems_windows then + def_system_macro('FPC_USE_TLS_DIRECTORY'); +{$endif not DISABLE_TLS_DIRECTORY} + +{$ifdef TEST_WIN64_SEH} + if target_info.system=system_x86_64_win64 then + def_system_macro('FPC_USE_WIN64_SEH'); +{$endif TEST_WIN64_SEH} + +{$ifdef ARM} + { define FPC_DOUBLE_HILO_SWAPPED if needed to properly handle doubles in RTL } + if (init_settings.fputype in [fpu_fpa,fpu_fpa10,fpu_fpa11]) and + not(cs_fp_emulation in init_settings.moduleswitches) then + def_system_macro('FPC_DOUBLE_HILO_SWAPPED'); +{$endif ARM} + + { Section smartlinking conflicts with import sections on Windows } + if GenerateImportSection and + (target_info.system in [system_i386_win32,system_x86_64_win64]) then + exclude(target_info.flags,tf_smartlink_sections); + + if not LinkTypeSetExplicitly then + set_default_link_type; + + { Default alignment settings, + 1. load the defaults for the target + 2. override with generic optimizer setting (little size) + 3. override with the user specified -Oa } + UpdateAlignment(init_settings.alignment,target_info.alignment); + if (cs_opt_size in current_settings.optimizerswitches) then + begin + init_settings.alignment.procalign:=1; + init_settings.alignment.jumpalign:=1; + init_settings.alignment.loopalign:=1; + end; + + UpdateAlignment(init_settings.alignment,option.paraalignment); + + set_system_macro('FPC_VERSION',version_nr); + set_system_macro('FPC_RELEASE',release_nr); + set_system_macro('FPC_PATCH',patch_nr); + set_system_macro('FPC_FULLVERSION',Format('%d%.02d%.02d',[StrToInt(version_nr),StrToInt(release_nr),StrToInt(patch_nr)])); + + if not(target_info.system in systems_windows) then + def_system_macro('FPC_WIDESTRING_EQUAL_UNICODESTRING'); + + for i:=low(tfeature) to high(tfeature) do + if i in features then + def_system_macro('FPC_HAS_FEATURE_'+featurestr[i]); + option.free; + Option:=nil; + + clearstack_pocalls := [pocall_cdecl,pocall_cppdecl,pocall_syscall,pocall_mwpascal]; + cdecl_pocalls := [pocall_cdecl, pocall_cppdecl]; + if (tf_safecall_clearstack in target_info.flags) then + begin + include (cdecl_pocalls, pocall_safecall); + include (clearstack_pocalls, pocall_safecall) + end; +end; + + +initialization + coption:=toption; +finalization + if assigned(option) then + option.free; +end. diff --git a/closures/compiler/optloop.pas b/closures/compiler/optloop.pas new file mode 100644 index 0000000000..5eb0228fb0 --- /dev/null +++ b/closures/compiler/optloop.pas @@ -0,0 +1,487 @@ +{ + Loop optimization + + Copyright (c) 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 optloop; + +{$i fpcdefs.inc} + + interface + + uses + node; + + function unroll_loop(node : tnode) : tnode; + function OptimizeInductionVariables(node : tnode) : boolean; + + implementation + + uses + cutils,cclasses, + globtype,globals,constexp, + symdef,symsym, + defutil, + cpuinfo, + nutils, + nadd,nbas,nflw,ncon,ninl,ncal,nld,nmem,ncnv, + ncgmem, + pass_1, + optbase,optutils, + procinfo; + + var + nodecount : aword; + + function donodecount(var n: tnode; arg: pointer): foreachnoderesult; + begin + inc(nodecount); + result:=fen_false; + end; + + + { rough estimation how large the tree "node" is } + function countnodes(node : tnode) : aword; + begin + nodecount:=0; + foreachnodestatic(node,@donodecount,nil); + result:=nodecount; + end; + + + function number_unrolls(node : tnode) : cardinal; + begin +{$ifdef i386} + { multiply by 2 for CPUs with a long pipeline } + if current_settings.cputype in [cpu_Pentium4] then + number_unrolls:=60 div countnodes(node) + else +{$endif i386} + number_unrolls:=30 div countnodes(node); + + if number_unrolls=0 then + number_unrolls:=1; + end; + + + function unroll_loop(node : tnode) : tnode; + var + unrolls,i : cardinal; + counts : qword; + unrollstatement,newforstatement : tstatementnode; + unrollblock : tblocknode; + begin + result:=nil; + if (cs_opt_size in current_settings.optimizerswitches) then + exit; + if not(node.nodetype in [forn]) then + exit; + unrolls:=number_unrolls(tfornode(node).t2); + if unrolls>1 then + begin + { number of executions known? } + if (tfornode(node).right.nodetype=ordconstn) and (tfornode(node).t1.nodetype=ordconstn) then + begin + if lnf_backward in tfornode(node).loopflags then + counts:=tordconstnode(tfornode(node).right).value-tordconstnode(tfornode(node).t1).value+1 + else + counts:=tordconstnode(tfornode(node).t1).value-tordconstnode(tfornode(node).right).value+1; + + { don't unroll more than we need } + if unrolls>counts then + unrolls:=counts; + + { create block statement } + unrollblock:=internalstatements(unrollstatement); + + { let's unroll (and rock of course) } + for i:=1 to unrolls do + begin + { create and insert copy of the statement block } + addstatement(unrollstatement,tfornode(node).t2.getcopy); + + { set and insert entry label? } + if (counts mod unrolls<>0) and + ((counts mod unrolls)=unrolls-i) then + begin + tfornode(node).entrylabel:=clabelnode.create(cnothingnode.create,tlabelsym.create('$optunrol')); + addstatement(unrollstatement,tfornode(node).entrylabel); + end; + + { for itself increases at the last iteration } + if i<unrolls then + begin + { insert incr/decrementation of counter var } + if lnf_backward in tfornode(node).loopflags then + addstatement(unrollstatement, + geninlinenode(in_dec_x,false,ccallparanode.create(tfornode(node).left.getcopy,nil))) + else + addstatement(unrollstatement, + geninlinenode(in_inc_x,false,ccallparanode.create(tfornode(node).left.getcopy,nil))); + end; + end; + { can we get rid of the for statement? } + if unrolls=counts then + begin + { create block statement } + result:=internalstatements(newforstatement); + { initial assignment } + addstatement(newforstatement,cassignmentnode.create( + tfornode(node).left.getcopy,tfornode(node).right.getcopy)); + addstatement(newforstatement,unrollblock); + end; + end + else + begin + { unrolling is a little bit more tricky if we don't know the + loop count at compile time, but the solution is to use a jump table + which is indexed by "loop count mod unrolls" at run time and which + jumps then at the appropriate place inside the loop. Because + a module division is expensive, we can use only unroll counts dividable + by 2 } + case unrolls of + 1..2: + ; + 3: + unrolls:=2; + 4..7: + unrolls:=4; + { unrolls>4 already make no sense imo, but who knows (FK) } + 8..15: + unrolls:=8; + 16..31: + unrolls:=16; + 32..63: + unrolls:=32; + 64..$7fff: + unrolls:=64; + else + exit; + end; + { we don't handle this yet } + exit; + end; + if not(assigned(result)) then + begin + tfornode(node).t2.free; + tfornode(node).t2:=unrollblock; + end; + end; + end; + + var + initcode, + calccode, + deletecode : tblocknode; + initcodestatements, + calccodestatements, + deletecodestatements: tstatementnode; + templist : tfplist; + inductionexprs : tfplist; + changedforloop, + containsnestedforloop : boolean; + + function is_loop_invariant(loop : tnode;expr : tnode) : boolean; + begin + result:=is_constnode(expr); + case expr.nodetype of + loadn: + begin + if (pi_dfaavailable in current_procinfo.flags) and + assigned(loop.optinfo) and + assigned(expr.optinfo) then + { no aliasing? } + result:=not(tabstractvarsym(tloadnode(expr).symtableentry).addr_taken) and + { no definition in the loop? } + not(DFASetIn(loop.optinfo^.defsum,expr.optinfo^.index)); + end; + vecn: + begin + result:=((tvecnode(expr).left.nodetype=loadn) or is_loop_invariant(loop,tvecnode(expr).left)) and + is_loop_invariant(loop,tvecnode(expr).right); + end; + typeconvn: + result:=is_loop_invariant(loop,ttypeconvnode(expr).left); + end; + end; + + + { checks if the strength of n can be recuded, arg is the tforloop being considered } + function dostrengthreductiontest(var n: tnode; arg: pointer): foreachnoderesult; + + function findpreviousstrengthreduction : boolean; + var + i : longint; + begin + result:=false; + for i:=0 to inductionexprs.count-1 do + begin + { do we already maintain one expression? } + if tnode(inductionexprs[i]).isequal(n) then + begin + n.free; + case n.nodetype of + muln: + n:=ctemprefnode.create(ttempcreatenode(templist[i])); + vecn: + n:=ctypeconvnode.create_internal(cderefnode.create(ctemprefnode.create( + ttempcreatenode(templist[i]))),n.resultdef); + else + internalerror(200809211); + end; + result:=true; + exit; + end; + end; + end; + + + procedure CreateNodes; + begin + if not assigned(initcode) then + begin + initcode:=internalstatements(initcodestatements); + calccode:=internalstatements(calccodestatements); + deletecode:=internalstatements(deletecodestatements); + end; + end; + + var + tempnode : ttempcreatenode; + dummy : longint; + begin + result:=fen_false; + case n.nodetype of + forn: + { inform for loop search routine, that it needs to search more deeply } + containsnestedforloop:=true; + muln: + begin + if (taddnode(n).right.nodetype=loadn) and + taddnode(n).right.isequal(tfornode(arg).left) and + { plain read of the loop variable? } + not(nf_write in taddnode(n).right.flags) and + not(nf_modify in taddnode(n).right.flags) and + is_loop_invariant(tfornode(arg),taddnode(n).left) and + { for now, we can handle only constant lower borders } + is_constnode(tfornode(arg).right) then + taddnode(n).swapleftright; + + if (taddnode(n).left.nodetype=loadn) and + taddnode(n).left.isequal(tfornode(arg).left) and + { plain read of the loop variable? } + not(nf_write in taddnode(n).left.flags) and + not(nf_modify in taddnode(n).left.flags) and + is_loop_invariant(tfornode(arg),taddnode(n).right) and + { for now, we can handle only constant lower borders } + is_constnode(tfornode(arg).right) then + begin + changedforloop:=true; + { did we use the same expression before already? } + if not(findpreviousstrengthreduction) then + begin + tempnode:=ctempcreatenode.create(n.resultdef,n.resultdef.size,tt_persistent, + tstoreddef(n.resultdef).is_intregable or tstoreddef(n.resultdef).is_fpuregable); + + templist.Add(tempnode); + inductionexprs.Add(n); + CreateNodes; + + if lnf_backward in tfornode(arg).loopflags then + addstatement(calccodestatements, + geninlinenode(in_dec_x,false, + ccallparanode.create(ctemprefnode.create(tempnode),ccallparanode.create(taddnode(n).right.getcopy,nil)))) + else + addstatement(calccodestatements, + geninlinenode(in_inc_x,false, + ccallparanode.create(ctemprefnode.create(tempnode),ccallparanode.create(taddnode(n).right.getcopy,nil)))); + + addstatement(initcodestatements,tempnode); + addstatement(initcodestatements,cassignmentnode.create(ctemprefnode.create(tempnode), + caddnode.create(muln, + caddnode.create(subn,tfornode(arg).right.getcopy,cordconstnode.create(1,tfornode(arg).right.resultdef,false)), + taddnode(n).right.getcopy) + ) + ); + + { finally replace the node by a temp. ref } + n:=ctemprefnode.create(tempnode); + + { ... and add a temp. release node } + addstatement(deletecodestatements,ctempdeletenode.create(tempnode)); + end; + { set types } + do_firstpass(n); + result:=fen_norecurse_false; + end; + end; + vecn: + begin + { is the index the counter variable? } + if not(is_special_array(tvecnode(n).left.resultdef)) and + (tvecnode(n).right.isequal(tfornode(arg).left) or + { fpc usually creates a type cast to access an array } + ((tvecnode(n).right.nodetype=typeconvn) and + ttypeconvnode(tvecnode(n).right).left.isequal(tfornode(arg).left) + ) + ) and + { plain read of the loop variable? } + not(nf_write in tvecnode(n).right.flags) and + not(nf_modify in tvecnode(n).right.flags) and + { direct array access? } + ((tvecnode(n).left.nodetype=loadn) or + { ... or loop invariant expression? } + is_loop_invariant(tfornode(arg),tvecnode(n).left)) and + { removing the multiplication is only worth the + effort if it's not a simple shift } + not(ispowerof2(tcgvecnode(n).get_mul_size,dummy)) then + begin + changedforloop:=true; + { did we use the same expression before already? } + if not(findpreviousstrengthreduction) then + begin + tempnode:=ctempcreatenode.create(voidpointertype,voidpointertype.size,tt_persistent,true); + + templist.Add(tempnode); + inductionexprs.Add(n); + CreateNodes; + + if lnf_backward in tfornode(arg).loopflags then + addstatement(calccodestatements, + geninlinenode(in_dec_x,false, + ccallparanode.create(ctemprefnode.create(tempnode),ccallparanode.create( + cordconstnode.create(tcgvecnode(n).get_mul_size,tfornode(arg).right.resultdef,false),nil)))) + else + addstatement(calccodestatements, + geninlinenode(in_inc_x,false, + ccallparanode.create(ctemprefnode.create(tempnode),ccallparanode.create( + cordconstnode.create(tcgvecnode(n).get_mul_size,tfornode(arg).right.resultdef,false),nil)))); + + addstatement(initcodestatements,tempnode); + addstatement(initcodestatements,cassignmentnode.create(ctemprefnode.create(tempnode), + caddrnode.create( + cvecnode.create(tvecnode(n).left.getcopy,tfornode(arg).right.getcopy) + ) + )); + + { finally replace the node by a temp. ref } + n:=ctypeconvnode.create_internal(cderefnode.create(ctemprefnode.create(tempnode)),n.resultdef); + + { ... and add a temp. release node } + addstatement(deletecodestatements,ctempdeletenode.create(tempnode)); + end; + { set types } + do_firstpass(n); + result:=fen_norecurse_false; + end; + end; + end; + end; + + + function OptimizeInductionVariablesSingleForLoop(node : tnode) : tnode; + var + loopcode : tblocknode; + loopcodestatements, + newcodestatements : tstatementnode; + fornode : tfornode; + begin + result:=nil; + if node.nodetype<>forn then + exit; + templist:=TFPList.Create; + inductionexprs:=TFPList.Create; + initcode:=nil; + calccode:=nil; + deletecode:=nil; + initcodestatements:=nil; + calccodestatements:=nil; + deletecodestatements:=nil; + { find all expressions being candidates for strength reduction + and replace them } + foreachnodestatic(pm_postprocess,node,@dostrengthreductiontest,node); + + { clue everything together } + if assigned(initcode) then + begin + do_firstpass(tnode(initcode)); + do_firstpass(tnode(calccode)); + do_firstpass(tnode(deletecode)); + { create a new for node, the old one will be released by the compiler } + with tfornode(node) do + begin + fornode:=cfornode.create(left,right,t1,t2,lnf_backward in loopflags); + left:=nil; + right:=nil; + t1:=nil; + t2:=nil; + end; + node:=fornode; + + loopcode:=internalstatements(loopcodestatements); + addstatement(loopcodestatements,calccode); + addstatement(loopcodestatements,tfornode(node).t2); + tfornode(node).t2:=loopcode; + do_firstpass(node); + + result:=internalstatements(newcodestatements); + addstatement(newcodestatements,initcode); + addstatement(newcodestatements,node); + addstatement(newcodestatements,deletecode); + end; + templist.Free; + inductionexprs.Free; + end; + + + function iterforloops(var n: tnode; arg: pointer): foreachnoderesult; + var + hp : tnode; + begin + Result:=fen_false; + if n.nodetype=forn then + begin + { do we have DFA available? } + if pi_dfaavailable in current_procinfo.flags then + begin + CalcDefSum(n); + end; + + containsnestedforloop:=false; + hp:=OptimizeInductionVariablesSingleForLoop(n); + if assigned(hp) then + begin + n.Free; + n:=hp; + end; + { can we avoid further searching? } + if not(containsnestedforloop) then + Result:=fen_norecurse_false; + end; + end; + + + function OptimizeInductionVariables(node : tnode) : boolean; + begin + changedforloop:=false; + foreachnodestatic(pm_postprocess,node,@iterforloops,nil); + Result:=changedforloop; + end; + +end. diff --git a/closures/compiler/opttail.pas b/closures/compiler/opttail.pas new file mode 100644 index 0000000000..b4adfa72d5 --- /dev/null +++ b/closures/compiler/opttail.pas @@ -0,0 +1,212 @@ +{ + Tail recursion optimization + + Copyright (c) 2006 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 opttail; + +{$i fpcdefs.inc} + + interface + + uses + symdef,node; + + procedure do_opttail(var n : tnode;p : tprocdef); + + implementation + + uses + globtype, + symconst,symsym, + defcmp,defutil, + nutils,nbas,nflw,ncal,nld,ncnv, + pass_1, + paramgr; + + procedure do_opttail(var n : tnode;p : tprocdef); + + var + labelnode : tlabelnode; + + function find_and_replace_tailcalls(var n : tnode) : boolean; + + var + usedcallnode : tcallnode; + + function is_recursivecall(n : tnode) : boolean; + begin + result:=(n.nodetype=calln) and (tcallnode(n).procdefinition=p) and not(assigned(tcallnode(n).methodpointer)); + if result then + usedcallnode:=tcallnode(n) + else + { obsolete type cast? } + result:=((n.nodetype=typeconvn) and (ttypeconvnode(n).convtype=tc_equal) and is_recursivecall(ttypeconvnode(n).left)); + end; + + function is_resultassignment(n : tnode) : boolean; + begin + result:=((n.nodetype=loadn) and (tloadnode(n).symtableentry=p.funcretsym)) or + ((n.nodetype=typeconvn) and (ttypeconvnode(n).convtype=tc_equal) and is_resultassignment(ttypeconvnode(n).left)); + end; + + var + calcnodes, + copynodes, + hp : tnode; + nodes, + calcstatements, + copystatements : tstatementnode; + paranode : tcallparanode; + tempnode : ttempcreatenode; + loadnode : tloadnode; + oldnodetree : tnode; + begin + { no tail call found and replaced so far } + result:=false; + if n=nil then + exit; + case n.nodetype of + statementn: + begin + hp:=n; + { search last node } + while assigned(tstatementnode(hp).right) do + hp:=tstatementnode(hp).right; + result:=find_and_replace_tailcalls(tstatementnode(hp).left); + end; + ifn: + begin + result:=find_and_replace_tailcalls(tifnode(n).right); + { avoid short bool eval here } + result:=find_and_replace_tailcalls(tifnode(n).t1) or result; + end; + assignn: + begin + if is_resultassignment(tbinarynode(n).left) and + is_recursivecall(tbinarynode(n).right) then + begin + { found one! } + { + writeln('tail recursion optimization for ',p.mangledname); + printnode(output,n); + } + { create assignments for all parameters } + + { this is hairy to do because one parameter could be used to calculate another one, so + assign them first to temps and then add them } + + calcnodes:=internalstatements(calcstatements); + copynodes:=internalstatements(copystatements); + paranode:=tcallparanode(usedcallnode.left); + while assigned(paranode) do + begin + tempnode:=ctempcreatenode.create(paranode.left.resultdef,paranode.left.resultdef.size,tt_persistent,true); + addstatement(calcstatements,tempnode); + addstatement(calcstatements, + cassignmentnode.create( + ctemprefnode.create(tempnode), + paranode.left + )); + + { "cast" away const varspezs } + loadnode:=cloadnode.create(paranode.parasym,paranode.parasym.owner); + include(tloadnode(loadnode).loadnodeflags,loadnf_isinternal_ignoreconst); + + addstatement(copystatements, + cassignmentnode.create( + loadnode, + ctemprefnode.create(tempnode) + )); + addstatement(copystatements,ctempdeletenode.create_normal_temp(tempnode)); + + { reused } + paranode.left:=nil; + paranode:=tcallparanode(paranode.right); + end; + + oldnodetree:=n; + n:=internalstatements(nodes); + + if assigned(usedcallnode.callinitblock) then + begin + addstatement(nodes,usedcallnode.callinitblock); + usedcallnode.callinitblock:=nil; + end; + + addstatement(nodes,calcnodes); + addstatement(nodes,copynodes); + + { create goto } + addstatement(nodes,cgotonode.create(labelnode.labsym)); + + if assigned(usedcallnode.callcleanupblock) then + begin + { callcleanupblock should contain only temp. node clean up } + checktreenodetypes(usedcallnode.callcleanupblock, + [tempdeleten,blockn,statementn,temprefn,nothingn]); + addstatement(nodes,usedcallnode.callcleanupblock); + usedcallnode.callcleanupblock:=nil; + end; + + oldnodetree.free; + + do_firstpass(n); + result:=true; + end; + end; + blockn: + result:=find_and_replace_tailcalls(tblocknode(n).left); + end; + end; + + var + s : tstatementnode; + oldnodes : tnode; + i : longint; + labelsym : tlabelsym; + begin + { check if the parameters actually would support tail recursion elimination } + for i:=0 to p.paras.count-1 do + with tparavarsym(p.paras[i]) do + if (varspez in [vs_out,vs_var,vs_constref]) or + ((varspez=vs_const) and + (paramanager.push_addr_param(varspez,vardef,p.proccalloption)) or + { parameters requiring tables are too complicated to handle + and slow down things anyways so a tail recursion call + makes no sense + } + is_managed_type(vardef)) then + exit; + + labelsym:=tlabelsym.create('$opttail'); + labelnode:=clabelnode.create(cnothingnode.create,labelsym); + if find_and_replace_tailcalls(n) then + begin + oldnodes:=n; + n:=internalstatements(s); + addstatement(s,labelnode); + addstatement(s,oldnodes); + end + else + labelnode.free; + end; + +end. + diff --git a/closures/compiler/optutils.pas b/closures/compiler/optutils.pas new file mode 100644 index 0000000000..2cca995efc --- /dev/null +++ b/closures/compiler/optutils.pas @@ -0,0 +1,327 @@ +{ + Helper routines for the optimizer + + Copyright (c) 2007 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 optutils; + +{$i fpcdefs.inc} + + interface + + uses + cclasses, + node; + + type + { this implementation should be really improved, + its purpose is to find equal nodes } + TIndexedNodeSet = class(TFPList) + function Add(node : tnode) : boolean; + function Includes(node : tnode) : tnode; + function Remove(node : tnode) : boolean; + end; + + procedure SetNodeSucessors(p : tnode); + procedure PrintDFAInfo(var f : text;p : tnode); + procedure PrintIndexedNodeSet(var f : text;s : TIndexedNodeSet); + { determines the optinfo.defsum field for the given node + this field contains a sum of all expressions defined by + all child expressions reachable through p + } + procedure CalcDefSum(p : tnode); + + implementation + + uses + verbose, + optbase, + nbas,nflw,nutils,nset; + + function TIndexedNodeSet.Add(node : tnode) : boolean; + var + i : Integer; + p : tnode; + begin + node.allocoptinfo; + p:=Includes(node); + if assigned(p) then + begin + result:=false; + node.optinfo^.index:=p.optinfo^.index; + end + else + begin + i:=inherited Add(node); + node.optinfo^.index:=i; + result:=true; + end + end; + + + function TIndexedNodeSet.Includes(node : tnode) : tnode; + var + i : longint; + begin + for i:=0 to Count-1 do + if tnode(List^[i]).isequal(node) then + begin + result:=tnode(List^[i]); + exit; + end; + result:=nil; + end; + + + function TIndexedNodeSet.Remove(node : tnode) : boolean; + var + p : tnode; + begin + result:=false; + p:=Includes(node); + if assigned(p) then + begin + if inherited Remove(p)<>-1 then + result:=true; + end; + end; + + + procedure PrintIndexedNodeSet(var f : text;s : TIndexedNodeSet); + var + i : integer; + begin + for i:=0 to s.count-1 do + begin + writeln(f,'=============================== Node ',i,' ==============================='); + printnode(f,tnode(s[i])); + writeln(f); + end; + end; + + + function PrintNodeDFA(var n: tnode; arg: pointer): foreachnoderesult; + begin + if assigned(n.optinfo) and ((n.optinfo^.life<>nil) or (n.optinfo^.use<>nil) or (n.optinfo^.def<>nil)) then + begin + write(text(arg^),nodetype2str[n.nodetype],'(',n.fileinfo.line,',',n.fileinfo.column,') Life: '); + PrintDFASet(text(arg^),n.optinfo^.life); + write(text(arg^),' Def: '); + PrintDFASet(text(arg^),n.optinfo^.def); + write(text(arg^),' Use: '); + PrintDFASet(text(arg^),n.optinfo^.use); + writeln(text(arg^)); + end; + result:=fen_false; + end; + + + procedure PrintDFAInfo(var f : text;p : tnode); + begin + foreachnodestatic(pm_postprocess,p,@PrintNodeDFA,@f); + end; + + + procedure SetNodeSucessors(p : tnode); + var + Continuestack : TFPList; + Breakstack : TFPList; + { sets the successor nodes of a node tree block + returns the first node of the tree if it's a controll flow node } + function DoSet(p : tnode;succ : tnode) : tnode; + var + hp1,hp2 : tnode; + i : longint; + begin + result:=nil; + if p=nil then + exit; + case p.nodetype of + statementn: + begin + hp1:=p; + result:=p; + while assigned(hp1) do + begin + { does another statement follow? } + if assigned(tstatementnode(hp1).next) then + begin + hp2:=DoSet(tstatementnode(hp1).statement,tstatementnode(hp1).next); + if assigned(hp2) then + tstatementnode(hp1).successor:=hp2 + else + tstatementnode(hp1).successor:=tstatementnode(hp1).next; + end + else + begin + hp2:=DoSet(tstatementnode(hp1).statement,succ); + if assigned(hp2) then + tstatementnode(hp1).successor:=hp2 + else + tstatementnode(hp1).successor:=succ; + end; + hp1:=tstatementnode(hp1).next; + end; + end; + blockn: + begin + result:=p; + DoSet(tblocknode(p).statements,succ); + p.successor:=succ; + end; + forn: + begin + Breakstack.Add(succ); + Continuestack.Add(p); + result:=p; + { the successor of the last node of the for body is the for node itself } + DoSet(tfornode(p).t2,p); + Breakstack.Delete(Breakstack.Count-1); + Continuestack.Delete(Continuestack.Count-1); + p.successor:=succ; + end; + breakn: + begin + result:=p; + p.successor:=tnode(Breakstack.Last); + end; + continuen: + begin + result:=p; + p.successor:=tnode(Continuestack.Last); + end; + whilerepeatn: + begin + Breakstack.Add(succ); + Continuestack.Add(p); + result:=p; + { the successor of the last node of the while body is the while node itself } + DoSet(twhilerepeatnode(p).right,p); + p.successor:=succ; + Breakstack.Delete(Breakstack.Count-1); + Continuestack.Delete(Continuestack.Count-1); + end; + ifn: + begin + result:=p; + DoSet(tifnode(p).right,succ); + DoSet(tifnode(p).t1,succ); + p.successor:=succ; + end; + labeln: + begin + result:=p; + if assigned(tlabelnode(p).left) then + begin + DoSet(tlabelnode(p).left,succ); + p.successor:=tlabelnode(p).left; + end + else + p.successor:=succ; + end; + assignn: + begin + result:=p; + p.successor:=succ; + end; + goton: + begin + result:=p; + if not(assigned(tgotonode(p).labelnode)) then + internalerror(2007050701); + p.successor:=tgotonode(p).labelnode; + end; + exitn: + begin + result:=p; + p.successor:=nil; + end; + casen: + begin + result:=p; + DoSet(tcasenode(p).elseblock,succ); + for i:=0 to tcasenode(p).blocks.count-1 do + DoSet(pcaseblock(tcasenode(p).blocks[i])^.statement,succ); + p.successor:=succ; + end; + calln: + begin + { not sure if this is enough (FK) } + result:=p; + p.successor:=succ; + end; + inlinen: + begin + { not sure if this is enough (FK) } + result:=p; + p.successor:=succ; + end; + tempcreaten, + tempdeleten, + nothingn: + begin + result:=p; + p.successor:=succ; + end; + raisen: + begin + result:=p; + { raise never returns } + p.successor:=nil; + end; + withn, + tryexceptn, + tryfinallyn, + onn: + internalerror(2007050501); + end; + end; + + begin + Breakstack:=TFPList.Create; + Continuestack:=TFPList.Create; + DoSet(p,nil); + Continuestack.Free; + Breakstack.Free; + end; + + var + sum : TDFASet; + + function adddef(var n: tnode; arg: pointer): foreachnoderesult; + begin + if assigned(n.optinfo) then + DFASetIncludeSet(sum,n.optinfo^.def); + Result:=fen_false; + end; + + + procedure CalcDefSum(p : tnode); + begin + p.allocoptinfo; + if not assigned(p.optinfo^.defsum) then + begin + sum:=nil; + foreachnodestatic(pm_postprocess,p,@adddef,nil); + p.optinfo^.defsum:=sum; + end; + end; + +end. + diff --git a/closures/compiler/optvirt.pas b/closures/compiler/optvirt.pas new file mode 100644 index 0000000000..9646c1b172 --- /dev/null +++ b/closures/compiler/optvirt.pas @@ -0,0 +1,1181 @@ +{ + Copyright (c) 2008 by Jonas Maebe + + Virtual methods optimizations (devirtualization) + + 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 optvirt; + +{$i fpcdefs.inc} + + interface + + uses + globtype, + cclasses, + symtype,symdef, + wpobase; + + type + { node in an inheritance tree, contains a link to the parent type (if any) and to all + child types + } + tinheritancetreenode = class + private + fdef: tobjectdef; + fparent: tinheritancetreenode; + fchilds: tfpobjectlist; + fcalledvmtmethods: tbitset; + finstantiated: boolean; + + function getchild(index: longint): tinheritancetreenode; + public + constructor create(_parent: tinheritancetreenode; _def: tobjectdef; _instantiated: boolean); + { destroys both this node and all of its siblings } + destructor destroy; override; + function childcount: longint; + function haschilds: boolean; + property childs[index: longint]: tinheritancetreenode read getchild; + property parent: tinheritancetreenode read fparent; + property def: tobjectdef read fdef; + property instantiated: boolean read finstantiated write finstantiated; + { if def is not yet a child of this node, add it. In all cases, return node containing + this def (either new or existing one + } + function maybeaddchild(_def: tobjectdef; _instantiated: boolean): tinheritancetreenode; + function findchild(_def: tobjectdef): tinheritancetreenode; + end; + + + tinheritancetreecallback = procedure(node: tinheritancetreenode; arg: pointer) of object; + + tinheritancetree = class + private + { just a regular node with parent = nil } + froots: tinheritancetreenode; + + classrefdefs: tfpobjectlist; + + procedure foreachnodefromroot(root: tinheritancetreenode; proctocall: tinheritancetreecallback; arg: pointer); + function registerinstantiatedobjectdefrecursive(def: tobjectdef; instantiated: boolean): tinheritancetreenode; + procedure markvmethods(node: tinheritancetreenode; p: pointer); + procedure printobjectvmtinfo(node: tinheritancetreenode; arg: pointer); + procedure addcalledvmtentries(node: tinheritancetreenode; arg: pointer); + + function getnodefordef(def: tobjectdef): tinheritancetreenode; + public + constructor create; + destructor destroy; override; + { adds an objectdef (the def itself, and all of its parents that do not yet exist) to + the tree, and returns the leaf node + } + procedure registerinstantiatedobjdef(def: tdef); + procedure registerinstantiatedclassrefdef(def: tdef); + procedure registercalledvmtentries(entries: tcalledvmtentries); + procedure checkforclassrefinheritance(def: tdef); + procedure foreachnode(proctocall: tinheritancetreecallback; arg: pointer); + procedure foreachleafnode(proctocall: tinheritancetreecallback; arg: pointer); + procedure optimizevirtualmethods; + procedure printvmtinfo; + end; + + + { devirtualisation information for a class } + + tclassdevirtinfo = class(tfphashobject) + private + { array (indexed by vmt entry nr) of replacement statically callable method names } + fstaticmethodnames: tfplist; + { is this class instantiated by the program? } + finstantiated: boolean; + function isstaticvmtentry(vmtindex: longint; out replacementname: pshortstring): boolean; + public + constructor create(hashobjectlist:tfphashobjectlist;const n: shortstring; instantiated: boolean); + destructor destroy; override; + + property instantiated: boolean read finstantiated; + + procedure addstaticmethod(vmtindex: longint; const replacementname: shortstring); + end; + + + { devirtualisation information for all classes in a unit } + + tunitdevirtinfo = class(tfphashobject) + private + { hashtable of classes } + fclasses: tfphashobjectlist; + public + constructor create(hashobjectlist:tfphashobjectlist;const n: shortstring);reintroduce; + destructor destroy; override; + + function addclass(const n: shortstring; instantiated: boolean): tclassdevirtinfo; + function findclass(const n: shortstring): tclassdevirtinfo; + end; + + { devirtualisation information for all units in a program } + + { tprogdevirtinfo } + + tprogdevirtinfo = class(twpodevirtualisationhandler) + private + { hashtable of tunitdevirtinfo (which contain tclassdevirtinfo) } + funits: tfphashobjectlist; + + procedure converttreenode(node: tinheritancetreenode; arg: pointer); + function addunitifnew(const n: shortstring): tunitdevirtinfo; + function findunit(const n: shortstring): tunitdevirtinfo; + function getstaticname(forvmtentry: boolean; objdef, procdef: tdef; out staticname: string): boolean; + procedure documentformat(writer: twposectionwriterintf); + public + constructor create; override; + destructor destroy; override; + + class function getwpotype: twpotype; override; + class function generatesinfoforwposwitches: twpoptimizerswitches; override; + class function performswpoforswitches: twpoptimizerswitches; override; + class function sectionname: shortstring; override; + + { information collection } + procedure constructfromcompilerstate; override; + procedure storewpofilesection(writer: twposectionwriterintf); override; + + { information providing } + procedure loadfromwpofilesection(reader: twposectionreaderintf); override; + function staticnameforcallingvirtualmethod(objdef, procdef: tdef; out staticname: string): boolean; override; + function staticnameforvmtentry(objdef, procdef: tdef; out staticname: string): boolean; override; + + end; + + + implementation + + uses + cutils, + fmodule, + symconst, + symbase, + symtable, + nobj, + verbose; + + const + DEVIRT_SECTION_NAME = 'contextinsensitive_devirtualization'; + + { *************************** tinheritancetreenode ************************* } + + constructor tinheritancetreenode.create(_parent: tinheritancetreenode; _def: tobjectdef; _instantiated: boolean); + begin + fparent:=_parent; + fdef:=_def; + finstantiated:=_instantiated; + if assigned(_def) then + fcalledvmtmethods:=tbitset.create(_def.vmtentries.count); + end; + + + destructor tinheritancetreenode.destroy; + begin + { fchilds owns its members, so it will free them too } + fchilds.free; + fcalledvmtmethods.free; + inherited destroy; + end; + + + function tinheritancetreenode.childcount: longint; + begin + if assigned(fchilds) then + result:=fchilds.count + else + result:=0; + end; + + + function tinheritancetreenode.haschilds: boolean; + begin + result:=assigned(fchilds) + end; + + + function tinheritancetreenode.getchild(index: longint): tinheritancetreenode; + begin + result:=tinheritancetreenode(fchilds[index]); + end; + + + function tinheritancetreenode.maybeaddchild(_def: tobjectdef; _instantiated: boolean): tinheritancetreenode; + begin + { sanity check } + if assigned(_def.childof) then + begin + if (_def.childof<>def) then + internalerror(2008092201); + end + else if assigned(fparent) then + internalerror(2008092202); + + if not assigned(fchilds) then + fchilds:=tfpobjectlist.create(true); + { def already a child -> return } + result:=findchild(_def); + if assigned(result) then + result.finstantiated:=result.finstantiated or _instantiated + else + begin + { not found, add new child } + result:=tinheritancetreenode.create(self,_def,_instantiated); + fchilds.add(result); + end; + end; + + + function tinheritancetreenode.findchild(_def: tobjectdef): tinheritancetreenode; + var + i: longint; + begin + result:=nil; + if assigned(fchilds) then + for i := 0 to fchilds.count-1 do + if (tinheritancetreenode(fchilds[i]).def=_def) then + begin + result:=tinheritancetreenode(fchilds[i]); + break; + end; + end; + + { *************************** tinheritancetree ************************* } + + constructor tinheritancetree.create; + begin + froots:=tinheritancetreenode.create(nil,nil,false); + classrefdefs:=tfpobjectlist.create(false); + end; + + + destructor tinheritancetree.destroy; + begin + froots.free; + classrefdefs.free; + inherited destroy; + end; + + + function tinheritancetree.registerinstantiatedobjectdefrecursive(def: tobjectdef; instantiated: boolean): tinheritancetreenode; + begin + if assigned(def.childof) then + begin + { recursively add parent, of which we have no info about whether or not it is + instantiated at this point -> default to false (will be overridden by "true" + if this class is instantioted, since then registerinstantiatedobjdef() will + be called for this class as well) + } + result:=registerinstantiatedobjectdefrecursive(def.childof,false); + { and add ourselves to the parent } + result:=result.maybeaddchild(def,instantiated); + end + else + { add ourselves to the roots } + result:=froots.maybeaddchild(def,instantiated); + end; + + + procedure tinheritancetree.registerinstantiatedobjdef(def: tdef); + begin + { add the def } + if (def.typ=objectdef) then + registerinstantiatedobjectdefrecursive(tobjectdef(def),true) + else + internalerror(2008092401); + end; + + + procedure tinheritancetree.registerinstantiatedclassrefdef(def: tdef); + begin + { queue for later checking (these are the objectdefs + to which the classrefdefs point) } + if (def.typ=objectdef) then + classrefdefs.add(def) + else + internalerror(2008101401); + end; + + + function tinheritancetree.getnodefordef(def: tobjectdef): tinheritancetreenode; + begin + if assigned(def.childof) then + begin + result:=getnodefordef(def.childof); + if assigned(result) then + result:=result.findchild(def); + end + else + result:=froots.findchild(def); + end; + + + procedure tinheritancetree.registercalledvmtentries(entries: tcalledvmtentries); + var + node: tinheritancetreenode; + begin + node:=getnodefordef(tobjectdef(entries.objdef)); + { it's possible that no instance of this class or its descendants are + instantiated + } + if not assigned(node) then + exit; + { now mark these methods as (potentially) called for this type and for + all of its descendants + } + addcalledvmtentries(node,entries.calledentries); + foreachnodefromroot(node,@addcalledvmtentries,entries.calledentries); + end; + + + procedure tinheritancetree.checkforclassrefinheritance(def: tdef); + var + i: longint; + begin + if (def.typ=objectdef) then + begin +{$ifdef debug_devirt} + write(' Checking for classrefdef inheritance of ',def.typename); +{$endif debug_devirt} + for i:=0 to classrefdefs.count-1 do + if tobjectdef(def).is_related(tobjectdef(classrefdefs[i])) then + begin +{$ifdef debug_devirt} + writeln('... Found: inherits from Class Of ',tobjectdef(classrefdefs[i]).typename); +{$endif debug_devirt} + registerinstantiatedobjdef(def); + exit; + end; +{$ifdef debug_devirt} + writeln('... Not found!'); +{$endif debug_devirt} + end; + end; + + + procedure tinheritancetree.foreachnodefromroot(root: tinheritancetreenode; proctocall: tinheritancetreecallback; arg: pointer); + + procedure process(const node: tinheritancetreenode); + var + i: longint; + begin + for i:=0 to node.childcount-1 do + if node.childs[i].haschilds then + begin + proctocall(node.childs[i],arg); + process(node.childs[i]) + end + else + proctocall(node.childs[i],arg); + end; + + begin + process(root); + end; + + + procedure tinheritancetree.foreachnode(proctocall: tinheritancetreecallback; arg: pointer); + begin + foreachnodefromroot(froots,proctocall,arg); + end; + + + procedure tinheritancetree.foreachleafnode(proctocall: tinheritancetreecallback; arg: pointer); + + procedure process(const node: tinheritancetreenode); + var + i: longint; + begin + for i:=0 to node.childcount-1 do + if node.childs[i].haschilds then + process(node.childs[i]) + else + proctocall(node.childs[i],arg); + end; + + begin + process(froots); + end; + + + procedure tinheritancetree.markvmethods(node: tinheritancetreenode; p: pointer); + var + currnode: tinheritancetreenode; + pd: tprocdef; + i: longint; + makeallvirtual: boolean; + begin + {$IFDEF DEBUG_DEVIRT} + writeln('processing leaf node ',node.def.typename); + {$ENDIF} + { todo: also process interfaces (ImplementedInterfaces) } + if (node.def.vmtentries.count=0) then + exit; + { process all vmt entries for this class/object } + for i:=0 to node.def.vmtentries.count-1 do + begin + currnode:=node; + { extra tprocdef(tobject(..)) typecasts so that -CR can catch + errors in case the vmtentries are not properly (re)deref'd } + pd:=tprocdef(tobject(pvmtentry(currnode.def.vmtentries[i])^.procdef)); + { abstract methods cannot be called directly } + if (po_abstractmethod in pd.procoptions) then + continue; + {$IFDEF DEBUG_DEVIRT} + writeln(' method ',pd.typename); + {$ENDIF} + { Now mark all virtual methods static that are the same in parent + classes as in this instantiated child class (only instantiated + classes can be leaf nodes, since only instantiated classes were + added to the tree). + If a first child does not override a parent method while a + a second one does, the first will mark it as statically + callable, but the second will set it to not statically callable. + In the opposite situation, the first will mark it as not + statically callable and the second will leave it alone. + } + makeallvirtual:=false; + repeat + if { stop when this method does not exist in a parent } + (currnode.def.vmtentries.count<=i) then + break; + + if not assigned(currnode.def.vmcallstaticinfo) then + currnode.def.vmcallstaticinfo:=allocmem(currnode.def.vmtentries.count*sizeof(tvmcallstatic)); + { if this method cannot be called, we can just mark it as + unreachable. This will cause its static name to be set to + FPC_ABSTRACTERROR later on. Exception: published methods are + always reachable (via RTTI). + } + if (pd.visibility<>vis_published) and + not(currnode.fcalledvmtmethods.isset(i)) then + begin + currnode.def.vmcallstaticinfo^[i]:=vmcs_unreachable; + currnode:=currnode.parent; + end + { same procdef as in all instantiated childs? (yes or don't know) } + else if (currnode.def.vmcallstaticinfo^[i] in [vmcs_default,vmcs_yes]) then + begin + { methods in uninstantiated classes can be made static if + they are the same in all instantiated derived classes + } + if ((pvmtentry(currnode.def.vmtentries[i])^.procdef=pd) or + (not currnode.instantiated and + (currnode.def.vmcallstaticinfo^[i]=vmcs_default))) and + not makeallvirtual then + begin + {$IFDEF DEBUG_DEVIRT} + writeln(' marking as static for ',currnode.def.typename); + {$ENDIF} + currnode.def.vmcallstaticinfo^[i]:=vmcs_yes; + { this is in case of a non-instantiated parent of an instantiated child: + the method declared in the child will always be called here + } + pvmtentry(currnode.def.vmtentries[i])^.procdef:=pd; + end + else + begin + {$IFDEF DEBUG_DEVIRT} + writeln(' marking as non-static for ',currnode.def.typename); + {$ENDIF} + { this vmt entry must also remain virtual for all parents } + makeallvirtual:=true; + currnode.def.vmcallstaticinfo^[i]:=vmcs_no; + end; + currnode:=currnode.parent; + end + else if (currnode.def.vmcallstaticinfo^[i]=vmcs_no) then + begin + {$IFDEF DEBUG_DEVIRT} + writeln(' not processing parents, already non-static for ',currnode.def.typename); + {$ENDIF} + { parents are already set to vmcs_no, so no need to continue } + currnode:=nil; + end + else + currnode:=currnode.parent; + until not assigned(currnode) or + not assigned(currnode.def); + end; + end; + + + procedure tinheritancetree.optimizevirtualmethods; + begin + foreachleafnode(@markvmethods,nil); + end; + + + procedure tinheritancetree.printobjectvmtinfo(node: tinheritancetreenode; arg: pointer); + var + i, + totaldevirtualised, + totalvirtual, + totalunreachable: ptrint; + begin + totaldevirtualised:=0; + totalvirtual:=0; + totalunreachable:=0; + writeln(node.def.typename); + if (node.def.vmtentries.count=0) then + begin + writeln(' No virtual methods!'); + exit; + end; + for i:=0 to node.def.vmtentries.count-1 do + if (po_virtualmethod in pvmtentry(node.def.vmtentries[i])^.procdef.procoptions) then + begin + inc(totalvirtual); + if (node.def.vmcallstaticinfo^[i]=vmcs_yes) then + begin + inc(totaldevirtualised); + writeln(' Devirtualised: ',pvmtentry(node.def.vmtentries[i])^.procdef.typename); + end + else if (node.def.vmcallstaticinfo^[i]=vmcs_unreachable) then + begin + inc(totalunreachable); + writeln(' Unreachable: ',pvmtentry(node.def.vmtentries[i])^.procdef.typename); + end; + end; + writeln('Total devirtualised/unreachable/all: ',totaldevirtualised,'/',totalunreachable,'/',totalvirtual); + writeln; + end; + + + procedure tinheritancetree.addcalledvmtentries(node: tinheritancetreenode; arg: pointer); + var + vmtentries: tbitset absolute arg; + begin + node.fcalledvmtmethods.addset(vmtentries); + end; + + + procedure tinheritancetree.printvmtinfo; + begin + foreachnode(@printobjectvmtinfo,nil); + end; + + + { helper routines: decompose an object & procdef combo into a unitname, class name and vmtentry number + (unit name where the objectdef is declared, class name of the objectdef, vmtentry number of the + procdef -- procdef does not necessarily belong to objectdef, it may also belong to a descendant + or parent) + } + + procedure defunitclassname(objdef: tobjectdef; out unitname, classname: pshortstring); + const + mainprogname: string[2] = 'P$'; + var + mainsymtab, + objparentsymtab : tsymtable; + begin + objparentsymtab:=objdef.symtable; + mainsymtab:=objparentsymtab.defowner.owner; + { main symtable must be static or global } + if not(mainsymtab.symtabletype in [staticsymtable,globalsymtable]) then + internalerror(200204175); + if (TSymtable(main_module.localsymtable)=mainsymtab) and + (not main_module.is_unit) then + { same convention as for mangled names } + unitname:=@mainprogname + else + unitname:=mainsymtab.name; + classname:=tobjectdef(objparentsymtab.defowner).objname; + end; + + + procedure defsdecompose(objdef: tobjectdef; procdef: tprocdef; out unitname, classname: pshortstring; out vmtentry: longint); + begin + defunitclassname(objdef,unitname,classname); + vmtentry:=procdef.extnumber; + { if it's $ffff, this is not a valid virtual method } + if (vmtentry=$ffff) then + internalerror(2008100509); + end; + + + { tclassdevirtinfo } + + constructor tclassdevirtinfo.create(hashobjectlist:tfphashobjectlist;const n: shortstring; instantiated: boolean); + begin + inherited create(hashobjectlist,n); + finstantiated:=instantiated; + fstaticmethodnames:=tfplist.create; + end; + + destructor tclassdevirtinfo.destroy; + var + i: longint; + begin + for i:=0 to fstaticmethodnames.count-1 do + if assigned(fstaticmethodnames[i]) then + freemem(fstaticmethodnames[i]); + fstaticmethodnames.free; + inherited destroy; + end; + + procedure tclassdevirtinfo.addstaticmethod(vmtindex: longint; + const replacementname: shortstring); + begin + if (vmtindex>=fstaticmethodnames.count) then + fstaticmethodnames.Count:=vmtindex+10; + fstaticmethodnames[vmtindex]:=stringdup(replacementname); + end; + + function tclassdevirtinfo.isstaticvmtentry(vmtindex: longint; out + replacementname: pshortstring): boolean; + begin + result:=false; + if (vmtindex>=fstaticmethodnames.count) then + exit; + + replacementname:=fstaticmethodnames[vmtindex]; + result:=assigned(replacementname); + end; + + { tunitdevirtinfo } + + constructor tunitdevirtinfo.create(hashobjectlist:tfphashobjectlist;const n: shortstring); + begin + inherited create(hashobjectlist,n); + fclasses:=tfphashobjectlist.create(true); + end; + + destructor tunitdevirtinfo.destroy; + begin + fclasses.free; + inherited destroy; + end; + + function tunitdevirtinfo.addclass(const n: shortstring; instantiated: boolean): tclassdevirtinfo; + begin + result:=findclass(n); + { can't have two classes with the same name in a single unit } + if assigned(result) then + internalerror(2008100501); + result:=tclassdevirtinfo.create(fclasses,n,instantiated); + end; + + function tunitdevirtinfo.findclass(const n: shortstring): tclassdevirtinfo; + begin + result:=tclassdevirtinfo(fclasses.find(n)); + end; + + + { tprogdevirtinfo } + + procedure tprogdevirtinfo.converttreenode(node: tinheritancetreenode; arg: pointer); + var + i: longint; + unitid, classid: pshortstring; + unitdevirtinfo: tunitdevirtinfo; + classdevirtinfo: tclassdevirtinfo; + begin + if (not node.instantiated) and + (node.def.vmtentries.count=0) then + exit; + { always add a class entry for an instantiated class, so we can + fill the vmt's of non-instantiated classes with calls to + FPC_ABSTRACTERROR during the optimisation phase + } + defunitclassname(node.def,unitid,classid); + unitdevirtinfo:=addunitifnew(unitid^); + classdevirtinfo:=unitdevirtinfo.addclass(classid^,node.instantiated); + if (node.def.vmtentries.count=0) then + exit; + for i:=0 to node.def.vmtentries.count-1 do + if (po_virtualmethod in pvmtentry(node.def.vmtentries[i])^.procdef.procoptions) then + case node.def.vmcallstaticinfo^[i] of + vmcs_yes: + begin + { add info about devirtualised vmt entry } + classdevirtinfo.addstaticmethod(i,pvmtentry(node.def.vmtentries[i])^.procdef.mangledname); + end; + vmcs_unreachable: + begin + { static reference to FPC_ABSTRACTERROR } + classdevirtinfo.addstaticmethod(i,'FPC_ABSTRACTERROR'); + end; + end; + end; + + + constructor tprogdevirtinfo.create; + begin + inherited create; + end; + + + destructor tprogdevirtinfo.destroy; + begin + funits.free; + inherited destroy; + end; + + + class function tprogdevirtinfo.getwpotype: twpotype; + begin + result:=wpo_devirtualization_context_insensitive; + end; + + + class function tprogdevirtinfo.generatesinfoforwposwitches: twpoptimizerswitches; + begin + result:=[cs_wpo_devirtualize_calls,cs_wpo_optimize_vmts]; + end; + + + class function tprogdevirtinfo.performswpoforswitches: twpoptimizerswitches; + begin + result:=[cs_wpo_devirtualize_calls,cs_wpo_optimize_vmts]; + end; + + + class function tprogdevirtinfo.sectionname: shortstring; + begin + result:=DEVIRT_SECTION_NAME; + end; + + + procedure tprogdevirtinfo.constructfromcompilerstate; + var + hp: tmodule; + i: longint; + inheritancetree: tinheritancetree; + begin + { register all instantiated class/object types } + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + if assigned(hp.wpoinfo.createdobjtypes) then + for i:=0 to hp.wpoinfo.createdobjtypes.count-1 do + tdef(hp.wpoinfo.createdobjtypes[i]).register_created_object_type; + if assigned(hp.wpoinfo.createdclassrefobjtypes) then + for i:=0 to hp.wpoinfo.createdclassrefobjtypes.count-1 do + tobjectdef(hp.wpoinfo.createdclassrefobjtypes[i]).register_created_classref_type; + if assigned(hp.wpoinfo.maybecreatedbyclassrefdeftypes) then + for i:=0 to hp.wpoinfo.maybecreatedbyclassrefdeftypes.count-1 do + tobjectdef(hp.wpoinfo.maybecreatedbyclassrefdeftypes[i]).register_maybe_created_object_type; + hp:=tmodule(hp.next); + end; + inheritancetree:=tinheritancetree.create; + + { add all constructed class/object types to the tree } +{$IFDEF DEBUG_DEVIRT} + writeln('constructed object/class/classreftypes in ',current_module.realmodulename^); +{$ENDIF} + for i := 0 to current_module.wpoinfo.createdobjtypes.count-1 do + begin + inheritancetree.registerinstantiatedobjdef(tdef(current_module.wpoinfo.createdobjtypes[i])); +{$IFDEF DEBUG_DEVIRT} + write(' ',tdef(current_module.wpoinfo.createdobjtypes[i]).GetTypeName); +{$ENDIF} + case tdef(current_module.wpoinfo.createdobjtypes[i]).typ of + objectdef: + case tobjectdef(current_module.wpoinfo.createdobjtypes[i]).objecttype of + odt_object: +{$IFDEF DEBUG_DEVIRT} + writeln(' (object)') +{$ENDIF} + ; + odt_class: +{$IFDEF DEBUG_DEVIRT} + writeln(' (class)') +{$ENDIF} + ; + else + internalerror(2008092101); + end; + else + internalerror(2008092102); + end; + end; + + { register all instantiated classrefdefs with the tree } + for i := 0 to current_module.wpoinfo.createdclassrefobjtypes.count-1 do + begin + inheritancetree.registerinstantiatedclassrefdef(tdef(current_module.wpoinfo.createdclassrefobjtypes[i])); +{$IFDEF DEBUG_DEVIRT} + write(' Class Of ',tdef(current_module.wpoinfo.createdclassrefobjtypes[i]).GetTypeName); +{$ENDIF} + case tdef(current_module.wpoinfo.createdclassrefobjtypes[i]).typ of + objectdef: +{$IFDEF DEBUG_DEVIRT} + writeln(' (classrefdef)') +{$ENDIF} + ; + else + internalerror(2008101101); + end; + end; + + + { now add all objectdefs that are referred somewhere (via a + loadvmtaddr node) and that are derived from an instantiated + classrefdef to the tree (as they can, in theory, all + be instantiated as well) + } + for i := 0 to current_module.wpoinfo.maybecreatedbyclassrefdeftypes.count-1 do + begin + inheritancetree.checkforclassrefinheritance(tdef(current_module.wpoinfo.maybecreatedbyclassrefdeftypes[i])); +{$IFDEF DEBUG_DEVIRT} + write(' Class Of ',tdef(current_module.wpoinfo.maybecreatedbyclassrefdeftypes[i]).GetTypeName); +{$ENDIF} + case tdef(current_module.wpoinfo.maybecreatedbyclassrefdeftypes[i]).typ of + objectdef: +{$IFDEF DEBUG_DEVIRT} + writeln(' (classrefdef)') +{$ENDIF} + ; + else + internalerror(2008101101); + end; + end; + + { add info about called virtual methods } + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + if assigned(hp.wpoinfo.calledvmtentries) then + for i:=0 to hp.wpoinfo.calledvmtentries.count-1 do + inheritancetree.registercalledvmtentries(tcalledvmtentries(hp.wpoinfo.calledvmtentries[i])); + hp:=tmodule(hp.next); + end; + + + inheritancetree.optimizevirtualmethods; +{$ifdef DEBUG_DEVIRT} + inheritancetree.printvmtinfo; +{$endif DEBUG_DEVIRT} + inheritancetree.foreachnode(@converttreenode,nil); + inheritancetree.free; + end; + + + function tprogdevirtinfo.addunitifnew(const n: shortstring): tunitdevirtinfo; + begin + if assigned(funits) then + result:=findunit(n) + else + begin + funits:=tfphashobjectlist.create; + result:=nil; + end; + if not assigned(result) then + begin + result:=tunitdevirtinfo.create(funits,n); + end; + end; + + + function tprogdevirtinfo.findunit(const n: shortstring): tunitdevirtinfo; + begin + result:=tunitdevirtinfo(funits.find(n)); + end; + + + procedure tprogdevirtinfo.loadfromwpofilesection(reader: twposectionreaderintf); + var + unitid, + classid, + vmtentryname: string; + vmttype: string[15]; + vmtentrynrstr: string[7]; + classinstantiated: string[1]; + vmtentry, error: longint; + unitdevirtinfo: tunitdevirtinfo; + classdevirtinfo: tclassdevirtinfo; + instantiated: boolean; + begin + { format: + # unitname^ + unit1^ + # classname& + class1& + # instantiated? + 1 + # vmt type (base or some interface) + basevmt + # vmt entry nr + 0 + # name of routine to call instead + staticvmtentryforslot0 + 5 + staticvmtentryforslot5 + intfvmt1 + 0 + staticvmtentryforslot0 + + # non-instantiated class (but if we encounter a variable of this + # type, we can optimise class to vmtentry 1) + class2& + 0 + basevmt + 1 + staticvmtentryforslot1 + + # instantiated class without optimisable virtual methods + class3& + 1 + + unit2^ + 1 + class3& + ... + + currently, only basevmt is supported (no interfaces yet) + } + { could be empty if no classes or so } + if not reader.sectiongetnextline(unitid) then + exit; + repeat + if (unitid='') or + (unitid[length(unitid)]<>'^') then + internalerror(2008100502); + { cut off the trailing ^ } + setlength(unitid,length(unitid)-1); + unitdevirtinfo:=addunitifnew(unitid); + { now read classes } + if not reader.sectiongetnextline(classid) then + internalerror(2008100505); + repeat + if (classid='') or + (classid[length(classid)]<>'&') then + internalerror(2008100503); + { instantiated? } + if not reader.sectiongetnextline(classinstantiated) then + internalerror(2008101901); + instantiated:=classinstantiated='1'; + { cut off the trailing & } + setlength(classid,length(classid)-1); + classdevirtinfo:=unitdevirtinfo.addclass(classid,instantiated); + { last class could be an instantiated class without any + optimisable methods. } + if not reader.sectiongetnextline(vmttype) then + exit; + { any optimisable virtual methods? } + if (vmttype<>'') then + begin + { interface info is not yet supported } + if (vmttype<>'basevmt') then + internalerror(2008100507); + { read all vmt entries for this class } + while reader.sectiongetnextline(vmtentrynrstr) and + (vmtentrynrstr<>'') do + begin + val(vmtentrynrstr,vmtentry,error); + if (error<>0) then + internalerror(2008100504); + if not reader.sectiongetnextline(vmtentryname) or + (vmtentryname='') then + internalerror(2008100508); + classdevirtinfo.addstaticmethod(vmtentry,vmtentryname); + end; + end; + { end of section -> exit } + if not(reader.sectiongetnextline(classid)) then + exit; + until (classid='') or + (classid[length(classid)]='^'); + { next unit, or error } + unitid:=classid; + until false; + end; + + + procedure tprogdevirtinfo.documentformat(writer: twposectionwriterintf); + begin + writer.sectionputline('# section format:'); + writer.sectionputline('# unit1^'); + writer.sectionputline('# class1& ; classname&'); + writer.sectionputline('# 1 ; instantiated or not'); + writer.sectionputline('# basevmt ; vmt type (base or some interface)'); + writer.sectionputline('# # vmt entry nr'); + writer.sectionputline('# 0 ; vmt entry nr'); + writer.sectionputline('# staticvmtentryforslot0 ; name or routine to call instead'); + writer.sectionputline('# 5'); + writer.sectionputline('# staticvmtentryforslot5'); + writer.sectionputline('# intfvmt1'); + writer.sectionputline('# 0'); + writer.sectionputline('# staticvmtentryforslot0'); + writer.sectionputline('#'); + writer.sectionputline('# class2&'); + writer.sectionputline('# 0 ; non-instantiated class (can be variables of this type, e.g. TObject)'); + writer.sectionputline('# basevmt'); + writer.sectionputline('# 1'); + writer.sectionputline('# staticvmtentryforslot1'); + writer.sectionputline('#'); + writer.sectionputline('# class3& ; instantiated class without optimisable virtual methods'); + writer.sectionputline('# 1'); + writer.sectionputline('#'); + writer.sectionputline('# unit2^'); + writer.sectionputline('# 1'); + writer.sectionputline('# class3&'); + writer.sectionputline('# ...'); + writer.sectionputline('#'); + writer.sectionputline('# currently, only basevmt is supported (no interfaces yet)'); + writer.sectionputline('#'); + end; + + + procedure tprogdevirtinfo.storewpofilesection(writer: twposectionwriterintf); + var + unitcount, + classcount, + vmtentrycount: longint; + unitdevirtinfo: tunitdevirtinfo; + classdevirtinfo: tclassdevirtinfo; + first: boolean; + begin + writer.startsection(DEVIRT_SECTION_NAME); + { if there are no optimised virtual methods, we have stored no info } + if not assigned(funits) then + exit; + documentformat(writer); + for unitcount:=0 to funits.count-1 do + begin + unitdevirtinfo:=tunitdevirtinfo(funits[unitcount]); + writer.sectionputline(unitdevirtinfo.name+'^'); + for classcount:=0 to unitdevirtinfo.fclasses.count-1 do + begin + classdevirtinfo:=tclassdevirtinfo(tunitdevirtinfo(funits[unitcount]).fclasses[classcount]); + writer.sectionputline(classdevirtinfo.name+'&'); + writer.sectionputline(tostr(ord(classdevirtinfo.instantiated))); + first:=true; + for vmtentrycount:=0 to classdevirtinfo.fstaticmethodnames.count-1 do + if assigned(classdevirtinfo.fstaticmethodnames[vmtentrycount]) then + begin + if first then + begin + writer.sectionputline('basevmt'); + first:=false; + end; + writer.sectionputline(tostr(vmtentrycount)); + writer.sectionputline(pshortstring(classdevirtinfo.fstaticmethodnames[vmtentrycount])^); + end; + writer.sectionputline(''); + end; + end; + end; + + + function tprogdevirtinfo.getstaticname(forvmtentry: boolean; objdef, procdef: tdef; out staticname: string): boolean; + var + unitid, + classid, + newname: pshortstring; + unitdevirtinfo: tunitdevirtinfo; + classdevirtinfo: tclassdevirtinfo; + vmtentry: longint; + realobjdef: tobjectdef; + begin + { if we don't have any devirtualisation info, exit } + if not assigned(funits) then + begin + result:=false; + exit + end; + { class methods are in the regular vmt, so we can handle classrefs + the same way as plain objectdefs + } + if (objdef.typ=classrefdef) then + realobjdef:=tobjectdef(tclassrefdef(objdef).pointeddef) + else if (objdef.typ=objectdef) and + (tobjectdef(objdef).objecttype in [odt_class,odt_object]) then + realobjdef:=tobjectdef(objdef) + else + begin + { we don't support interfaces yet } + result:=false; + exit; + end; + + { if it's for a vmtentry of an objdef and the objdef is + not instantiated, then we can fill the vmt with pointers + to FPC_ABSTRACTERROR, except for published methods + (these can be called via rtti, so always have to point + to the original method) + } + if forvmtentry and + (tprocdef(procdef).visibility=vis_published) then + begin + result:=false; + exit; + end; + + { get the component names for the class/procdef combo } + defsdecompose(realobjdef,tprocdef(procdef),unitid,classid,vmtentry); + + { If we don't have information about a particular unit/class/method, + it means that such class cannot be instantiated. So if we are + looking up information for a vmt entry, we can always safely return + FPC_ABSTRACTERROR if we do not find anything, unless it's a + published method (but those are handled already above) or a + class method (can be called even if the class is not instantiated). + } + result:= + forvmtentry and + not(po_classmethod in tprocdef(procdef).procoptions); + staticname:='FPC_ABSTRACTERROR'; + + { do we have any info for this unit? } + unitdevirtinfo:=findunit(unitid^); + if not assigned(unitdevirtinfo) then + exit; + { and for this class? } + classdevirtinfo:=unitdevirtinfo.findclass(classid^); + if not assigned(classdevirtinfo) then + exit; + if forvmtentry and + (objdef.typ=objectdef) and + not classdevirtinfo.instantiated and + { virtual class methods can be called even if the class is not instantiated } + not(po_classmethod in tprocdef(procdef).procoptions) then + begin + { already set above + staticname:='FPC_ABSTRACTERROR'; + } + result:=true; + end + else + begin + { now check whether it can be devirtualised, and if so to what } + result:=classdevirtinfo.isstaticvmtentry(vmtentry,newname); + if result then + staticname:=newname^; + end; + end; + + + + function tprogdevirtinfo.staticnameforcallingvirtualmethod(objdef, procdef: tdef; out staticname: string): boolean; + begin + result:=getstaticname(false,objdef,procdef,staticname); + end; + + + function tprogdevirtinfo.staticnameforvmtentry(objdef, procdef: tdef; out staticname: string): boolean; + begin + result:=getstaticname(true,objdef,procdef,staticname); + end; + +end. diff --git a/closures/compiler/owar.pas b/closures/compiler/owar.pas new file mode 100644 index 0000000000..b714700385 --- /dev/null +++ b/closures/compiler/owar.pas @@ -0,0 +1,522 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + Contains the stuff for writing .a files directly + + 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 owar; + +{$i fpcdefs.inc} + +interface + +uses + cclasses, + owbase; + +type + tarhdr=packed record + name : array[0..15] of char; + date : array[0..11] of char; + uid : array[0..5] of char; + gid : array[0..5] of char; + mode : array[0..7] of char; + size : array[0..9] of char; + fmag : array[0..1] of char; + end; + + tarobjectwriter=class(tobjectwriter) + constructor create(const Aarfn:string); + destructor destroy;override; + function createfile(const fn:string):boolean;override; + procedure closefile;override; + procedure writesym(const sym:string);override; + procedure write(const b;len:longword);override; + private + arfn : string; + arhdr : tarhdr; + symreloc, + symstr, + lfnstr, + ardata : TDynamicArray; + objpos : longint; + objfn : string; + timestamp : string[12]; + procedure createarhdr(fn:string;asize:longint;const gid,uid,mode:string); + procedure writear; + end; + + tarobjectreader=class(tobjectreader) + private + ArSymbols : TFPHashObjectList; + LFNStrs : PChar; + LFNSize : longint; + CurrMemberPos, + CurrMemberSize : longint; + CurrMemberName : string; + function DecodeMemberName(ahdr:TArHdr):string; + function DecodeMemberSize(ahdr:TArHdr):longint; + procedure ReadArchive; + protected + function getfilename:string;override; + public + constructor create(const Aarfn:string); + destructor destroy;override; + function openfile(const fn:string):boolean;override; + procedure closefile;override; + procedure seek(len:longint);override; + end; + + +implementation + + uses + SysUtils, + cstreams, + systems, + globals, + verbose; + + const + symrelocbufsize = 4096; + symstrbufsize = 8192; + lfnstrbufsize = 4096; + arbufsize = 65536; + + armagic:array[1..8] of char='!<arch>'#10; + + type + TArSymbol = class(TFPHashObject) + MemberPos : longint; + end; + + +{***************************************************************************** + Helpers +*****************************************************************************} + + const + C1970=2440588; + D0=1461; + D1=146097; + D2=1721119; + Function Gregorian2Julian(DT:TSystemTime):LongInt; + Var + Century,XYear,Month : LongInt; + Begin + Month:=DT.Month; + If Month<=2 Then + Begin + Dec(DT.Year); + Inc(Month,12); + End; + Dec(Month,3); + Century:=(longint(DT.Year Div 100)*D1) shr 2; + XYear:=(longint(DT.Year Mod 100)*D0) shr 2; + Gregorian2Julian:=((((Month*153)+2) div 5)+DT.Day)+D2+XYear+Century; + End; + + + function DT2Unix(DT:TSystemTime):LongInt; + Begin + DT2Unix:=(Gregorian2Julian(DT)-C1970)*86400+(LongInt(DT.Hour)*3600)+(DT.Minute*60)+DT.Second; + end; + + + function lsb2msb(l:longint):longint; + type + bytearr=array[0..3] of byte; + begin +{$ifndef FPC_BIG_ENDIAN} + bytearr(result)[0]:=bytearr(l)[3]; + bytearr(result)[1]:=bytearr(l)[2]; + bytearr(result)[2]:=bytearr(l)[1]; + bytearr(result)[3]:=bytearr(l)[0]; +{$else} + result:=l; +{$endif} + end; + + +{***************************************************************************** + TArObjectWriter +*****************************************************************************} + + constructor tarobjectwriter.create(const Aarfn:string); + var + time : TSystemTime; + begin + arfn:=Aarfn; + ardata:=TDynamicArray.Create(arbufsize); + symreloc:=TDynamicArray.Create(symrelocbufsize); + symstr:=TDynamicArray.Create(symstrbufsize); + lfnstr:=TDynamicArray.Create(lfnstrbufsize); + { create timestamp } + GetLocalTime(time); + Str(DT2Unix(time),timestamp); + end; + + + destructor tarobjectwriter.destroy; + begin + if Errorcount=0 then + writear; + arData.Free; + symreloc.Free; + symstr.Free; + lfnstr.Free; + end; + + + procedure tarobjectwriter.createarhdr(fn:string;asize:longint;const gid,uid,mode:string); + var + tmp : string[9]; + hfn : string; + begin + { create ar header } + fillchar(arhdr,sizeof(tarhdr),' '); + { win32 will change names starting with .\ to ./ when using lfn, corrupting + the sort order required for the idata sections. To prevent this strip + always the path from the filename. (PFV) } + hfn:=ExtractFileName(fn); + if hfn='' then + hfn:=fn; + fn:=hfn+'/'; + if length(fn)>16 then + begin + arhdr.name[0]:='/'; + str(lfnstr.size,tmp); + move(tmp[1],arhdr.name[1],length(tmp)); + fn:=fn+#10; + lfnstr.write(fn[1],length(fn)); + end + else + move(fn[1],arhdr.name,length(fn)); + { don't write a date if also no gid/uid/mode is specified } + if gid<>'' then + move(timestamp[1],arhdr.date,length(timestamp)); + str(asize,tmp); + move(tmp[1],arhdr.size,length(tmp)); + move(gid[1],arhdr.gid,length(gid)); + move(uid[1],arhdr.uid,length(uid)); + move(mode[1],arhdr.mode,length(mode)); + arhdr.fmag:='`'#10; + end; + + + function tarobjectwriter.createfile(const fn:string):boolean; + begin + objfn:=fn; + objpos:=ardata.size; + ardata.seek(objpos + sizeof(tarhdr)); + createfile:=true; + fobjsize:=0; + end; + + + procedure tarobjectwriter.closefile; + begin + ardata.align(2); + { fix the size in the header } + createarhdr(objfn,ardata.size-objpos-sizeof(tarhdr),'42','42','644'); + { write the header } + ardata.seek(objpos); + ardata.write(arhdr,sizeof(tarhdr)); + fobjsize:=0; + end; + + + procedure tarobjectwriter.writesym(const sym:string); + var + c : char; + begin + c:=#0; + symreloc.write(objpos,4); + symstr.write(sym[1],length(sym)); + symstr.write(c,1); + end; + + + procedure tarobjectwriter.write(const b;len:longword); + begin + inc(fobjsize,len); + inc(fsize,len); + ardata.write(b,len); + end; + + + procedure tarobjectwriter.writear; + var + arf : TCCustomFileStream; + fixup,l, + relocs,i : longint; + begin + arf:=CFileStreamClass.Create(arfn,fmCreate); + if CStreamError<>0 then + begin + Message1(exec_e_cant_create_archivefile,arfn); + exit; + end; + arf.Write(armagic,sizeof(armagic)); + { align first, because we need the size for the fixups of the symbol reloc } + if lfnstr.size>0 then + lfnstr.align(2); + if symreloc.size>0 then + begin + symstr.align(2); + fixup:=12+sizeof(tarhdr)+symreloc.size+symstr.size; + if lfnstr.size>0 then + inc(fixup,lfnstr.size+sizeof(tarhdr)); + relocs:=symreloc.size div 4; + { fixup relocs } + for i:=0to relocs-1 do + begin + symreloc.seek(i*4); + symreloc.read(l,4); + symreloc.seek(i*4); + l:=lsb2msb(l+fixup); + symreloc.write(l,4); + end; + createarhdr('',4+symreloc.size+symstr.size,'0','0','0'); + arf.Write(arhdr,sizeof(tarhdr)); + relocs:=lsb2msb(relocs); + arf.Write(relocs,4); + symreloc.WriteStream(arf); + symstr.WriteStream(arf); + end; + if lfnstr.size>0 then + begin + createarhdr('/',lfnstr.size,'','',''); + arf.Write(arhdr,sizeof(tarhdr)); + lfnstr.WriteStream(arf); + end; + ardata.WriteStream(arf); + Arf.Free; + end; + + +{***************************************************************************** + TArObjectReader +*****************************************************************************} + + + constructor tarobjectreader.create(const Aarfn:string); + begin + inherited Create; + ArSymbols:=TFPHashObjectList.Create(true); + CurrMemberPos:=0; + CurrMemberSize:=0; + CurrMemberName:=''; + if inherited openfile(Aarfn) then + ReadArchive; + end; + + + destructor tarobjectreader.destroy; + begin + inherited closefile; + ArSymbols.destroy; + if assigned(LFNStrs) then + FreeMem(LFNStrs); + inherited Destroy; + end; + + + function tarobjectreader.getfilename : string; + begin + result:=inherited getfilename; + if CurrMemberName<>'' then + result:=result+'('+CurrMemberName+')'; + end; + + + function tarobjectreader.DecodeMemberName(ahdr:TArHdr):string; + var + hs : string; + code : integer; + hsp, + p : pchar; + lfnidx : longint; + begin + result:=''; + p:=@ahdr.name[0]; + hsp:=@hs[1]; + while (p^<>' ') and (hsp-@hs[1]<16) do + begin + hsp^:=p^; + inc(p); + inc(hsp); + end; + hs[0]:=chr(hsp-@hs[1]); + if (hs[1]='/') and (hs[2] in ['0'..'9']) then + begin + Delete(hs,1,1); + val(hs,lfnidx,code); + if (lfnidx<0) or (lfnidx>=LFNSize) then + begin + Comment(V_Error,'Invalid ar member lfn name index in '+filename); + exit; + end; + p:=@LFNStrs[lfnidx]; + hsp:=@result[1]; + while p^<>#10 do + begin + hsp^:=p^; + inc(p); + inc(hsp); + end; + result[0]:=chr(hsp-@result[1]); + end + else + result:=hs; + { Strip ending / } + if result[length(result)]='/' then + dec(result[0]); + end; + + + function tarobjectreader.DecodeMemberSize(ahdr:TArHdr):longint; + var + hs : string; + code : integer; + hsp, + p : pchar; + begin + p:=@ahdr.size[0]; + hsp:=@hs[1]; + while p^<>' ' do + begin + hsp^:=p^; + inc(p); + inc(hsp); + end; + hs[0]:=chr(hsp-@hs[1]); + val(hs,result,code); + if result<=0 then + Comment(V_Error,'Invalid ar member size in '+filename); + end; + + + procedure tarobjectreader.ReadArchive; + var + currarmagic : array[0..sizeof(armagic)-1] of char; + currarhdr : tarhdr; + nrelocs, + relocidx, + currfilesize, + relocsize, + symsize : longint; + arsym : TArSymbol; + s : string; + syms, + currp, + endp, + startp : pchar; + relocs : plongint; + begin + Read(currarmagic,sizeof(armagic)); + if CompareByte(currarmagic,armagic,sizeof(armagic))<>0 then + begin + Comment(V_Error,'Not a ar file, illegal magic: '+filename); + exit; + end; + Read(currarhdr,sizeof(currarhdr)); + { Read number of relocs } + Read(nrelocs,sizeof(nrelocs)); + nrelocs:=lsb2msb(nrelocs); + { Calculate sizes } + currfilesize:=DecodeMemberSize(currarhdr); + relocsize:=nrelocs*4; + symsize:=currfilesize-relocsize-4; + if symsize<0 then + begin + Comment(V_Error,'Illegal symtable in ar file '+filename); + exit; + end; + { Read relocs } + getmem(Relocs,relocsize); + Read(relocs^,relocsize); + { Read symbols, force terminating #0 to prevent overflow } + getmem(syms,symsize+1); + syms[symsize]:=#0; + Read(syms^,symsize); + { Parse symbols } + relocidx:=0; + currp:=syms; + endp:=syms+symsize; + for relocidx:=0 to nrelocs-1 do + begin + startp:=currp; + while (currp^<>#0) do + inc(currp); + s[0]:=chr(currp-startp); + move(startp^,s[1],byte(s[0])); + arsym:=TArSymbol.create(ArSymbols,s); + arsym.MemberPos:=lsb2msb(relocs[relocidx]); + inc(currp); + if currp>endp then + begin + Comment(V_Error,'Illegal symtable in ar file '+filename); + break; + end; + end; + freemem(relocs); + freemem(syms); + { LFN names } + Read(currarhdr,sizeof(currarhdr)); + if DecodeMemberName(currarhdr)='/' then + begin + lfnsize:=DecodeMemberSize(currarhdr); + getmem(lfnstrs,lfnsize); + Read(lfnstrs^,lfnsize); + end; + end; + + + function tarobjectreader.openfile(const fn:string):boolean; + var + arsym : TArSymbol; + arhdr : TArHdr; + begin + result:=false; + arsym:=TArSymbol(ArSymbols.Find(fn)); + if not assigned(arsym) then + exit; + inherited Seek(arsym.MemberPos); + Read(arhdr,sizeof(arhdr)); + CurrMemberName:=DecodeMemberName(arhdr); + CurrMemberSize:=DecodeMemberSize(arhdr); + CurrMemberPos:=arsym.MemberPos+sizeof(arhdr); + result:=true; + end; + + + procedure tarobjectreader.closefile; + begin + CurrMemberPos:=0; + CurrMemberSize:=0; + CurrMemberName:=''; + end; + + + procedure tarobjectreader.seek(len:longint); + begin + inherited Seek(CurrMemberPos+len); + end; + +end. diff --git a/closures/compiler/owbase.pas b/closures/compiler/owbase.pas new file mode 100644 index 0000000000..ac90487825 --- /dev/null +++ b/closures/compiler/owbase.pas @@ -0,0 +1,304 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + Contains the base stuff for writing for object files to disk + + 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 owbase; + +{$i fpcdefs.inc} + +interface +uses + cstreams, + cclasses; + +type + tobjectwriter=class + private + f : TCCustomFileStream; + opened : boolean; + buf : pchar; + bufidx : longword; + procedure writebuf; + protected + fsize, + fobjsize : longword; + public + constructor create; + destructor destroy;override; + function createfile(const fn:string):boolean;virtual; + procedure closefile;virtual; + procedure writesym(const sym:string);virtual; + procedure write(const b;len:longword);virtual; + procedure WriteZeros(l:longword); + procedure writearray(a:TDynamicArray); + property Size:longword read FSize; + property ObjSize:longword read FObjSize; + end; + + tobjectreader=class + private + f : TCCustomFileStream; + opened : boolean; + buf : pchar; + ffilename : string; + bufidx, + bufmax : longint; + function readbuf:boolean; + protected + function getfilename : string;virtual; + public + constructor create; + destructor destroy;override; + function openfile(const fn:string):boolean;virtual; + procedure closefile;virtual; + procedure seek(len:longint);virtual; + function read(out b;len:longint):boolean;virtual; + function readarray(a:TDynamicArray;len:longint):boolean; + property filename : string read getfilename; + end; + +implementation + +uses + SysUtils, + verbose, globals; + +const + bufsize = 32768; + + +{**************************************************************************** + TObjectWriter +****************************************************************************} + +constructor tobjectwriter.create; +begin + getmem(buf,bufsize); + bufidx:=0; + opened:=false; + fsize:=0; +end; + + +destructor tobjectwriter.destroy; +begin + if opened then + closefile; + freemem(buf,bufsize); +end; + + +function tobjectwriter.createfile(const fn:string):boolean; +begin + createfile:=false; + f:=CFileStreamClass.Create(fn,fmCreate); + if CStreamError<>0 then + begin + Message2(exec_e_cant_create_objectfile,fn,IntToStr(CStreamError)); + exit; + end; + bufidx:=0; + fsize:=0; + fobjsize:=0; + opened:=true; + createfile:=true; +end; + + +procedure tobjectwriter.closefile; +var + fn : string; +begin + if bufidx>0 then + writebuf; + fn:=f.filename; + f.free; +{ Remove if size is 0 } + if size=0 then + DeleteFile(fn); + opened:=false; + fsize:=0; + fobjsize:=0; +end; + + +procedure tobjectwriter.writebuf; +begin + f.write(buf^,bufidx); + bufidx:=0; +end; + + +procedure tobjectwriter.writesym(const sym:string); +begin +end; + + +procedure tobjectwriter.write(const b;len:longword); +var + p : pchar; + bufleft, + idx : longword; +begin + inc(fsize,len); + inc(fobjsize,len); + p:=pchar(@b); + idx:=0; + while len>0 do + begin + bufleft:=bufsize-bufidx; + if len>bufleft then + begin + move(p[idx],buf[bufidx],bufleft); + dec(len,bufleft); + inc(idx,bufleft); + inc(bufidx,bufleft); + writebuf; + end + else + begin + move(p[idx],buf[bufidx],len); + inc(bufidx,len); + exit; + end; + end; +end; + + +procedure tobjectwriter.WriteZeros(l:longword); +var + empty : array[0..1023] of byte; +begin + if l>sizeof(empty) then + internalerror(200404081); + if l>0 then + begin + fillchar(empty,l,0); + Write(empty,l); + end; +end; + + +procedure tobjectwriter.writearray(a:TDynamicArray); +var + hp : pdynamicblock; +begin + hp:=a.firstblock; + while assigned(hp) do + begin + write(hp^.data,hp^.used); + hp:=hp^.next; + end; +end; + + +{**************************************************************************** + TObjectReader +****************************************************************************} + +constructor tobjectreader.create; +begin + buf:=nil; + bufidx:=0; + bufmax:=0; + ffilename:=''; + opened:=false; +end; + + +destructor tobjectreader.destroy; +begin + if opened then + closefile; +end; + + +function tobjectreader.openfile(const fn:string):boolean; +begin + openfile:=false; + f:=CFileStreamClass.Create(fn,fmOpenRead); + if CStreamError<>0 then + begin + Comment(V_Error,'Can''t open object file: '+fn); + exit; + end; + ffilename:=fn; + getmem(buf,f.Size); + f.read(buf^,f.Size); + bufmax:=f.Size; + f.free; + bufidx:=0; + opened:=true; + openfile:=true; +end; + + +procedure tobjectreader.closefile; +begin + opened:=false; + bufidx:=0; + bufmax:=0; + freemem(buf); +end; + + +function tobjectreader.readbuf:boolean; +begin + result:=bufidx<bufmax; +end; + + +procedure tobjectreader.seek(len:longint); +begin + bufidx:=len; +end; + + +function tobjectreader.read(out b;len:longint):boolean; +begin + result:=true; + if bufidx+len>bufmax then + begin + result:=false; + len:=bufmax-bufidx; + end; + move(buf[bufidx],b,len); + inc(bufidx,len); +end; + + +function tobjectreader.readarray(a:TDynamicArray;len:longint):boolean; +begin + result:=true; + if bufidx+len>bufmax then + begin + result:=false; + len:=bufmax-bufidx; + end; + a.write(buf[bufidx],len); + inc(bufidx,len); +end; + +function tobjectreader.getfilename : string; + begin + result:=ffilename; + end; + +end. diff --git a/closures/compiler/parabase.pas b/closures/compiler/parabase.pas new file mode 100644 index 0000000000..047f7f1a7e --- /dev/null +++ b/closures/compiler/parabase.pas @@ -0,0 +1,372 @@ +{ + Copyright (c) 2002 by Florian Klaempfl + + Generic calling convention 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 parabase; + +{$i fpcdefs.inc} + + interface + + uses + cclasses,globtype, + cpubase,cgbase,cgutils, + symtype, ppu; + + type + TCGParaReference = record + index : tregister; + offset : aint; + end; + + PCGParaLocation = ^TCGParaLocation; + TCGParaLocation = record + Next : PCGParaLocation; + Size : TCGSize; { size of this location } + Loc : TCGLoc; + case TCGLoc of + LOC_REFERENCE : (reference : TCGParaReference); + LOC_FPUREGISTER, + LOC_CFPUREGISTER, + LOC_MMREGISTER, + LOC_CMMREGISTER, + LOC_REGISTER, + LOC_CREGISTER : ( + { The number of bits the value in the register must be shifted to the left before + it can be stored to memory in the function prolog. + This is used for passing OS_NO memory blocks less than register size and of "odd" + (3, 5, 6, 7) size on big endian machines, so that small memory blocks passed via + registers are properly aligned. + + E.g. the value $5544433 is passed in bits 40-63 of the register (others are zero), + but they should actually be stored in the first bits of the stack location reserved + for this value. So they have to be shifted left by this amount of bits before. } + {$IFDEF POWERPC64}shiftval : byte;{$ENDIF POWERPC64} + register : tregister); + end; + + TCGPara = object + Location : PCGParalocation; + IntSize : tcgint; { size of the total location in bytes } + Alignment : ShortInt; + Size : TCGSize; { Size of the parameter included in all locations } +{$ifdef powerpc} + composite: boolean; { under the AIX abi, how certain parameters are passed depends on whether they are composite or not } +{$endif powerpc} + constructor init; + destructor done; + procedure reset; + function getcopy:tcgpara; + procedure check_simple_location; + function add_location:pcgparalocation; + procedure get_location(var newloc:tlocation); + + procedure ppuwrite(ppufile:tcompilerppufile); + procedure ppuload(ppufile:tcompilerppufile); + end; + + tvarargsinfo = ( + va_uses_float_reg + ); + + tparalist = class(TFPObjectList) + procedure SortParas; + end; + + tvarargsparalist = class(tparalist) + varargsinfo : set of tvarargsinfo; +{$ifdef x86_64} + { x86_64 requires %al to contain the no. SSE regs passed } + mmregsused : longint; +{$endif x86_64} + end; + + + +implementation + + uses + systems,verbose, + symsym; + + +{**************************************************************************** + TCGPara +****************************************************************************} + + constructor tcgpara.init; + begin + alignment:=0; + size:=OS_NO; + intsize:=0; + location:=nil; +{$ifdef powerpc} + composite:=false; +{$endif powerpc} + end; + + + destructor tcgpara.done; + begin + reset; + end; + + + procedure tcgpara.reset; + var + hlocation : pcgparalocation; + begin + while assigned(location) do + begin + hlocation:=location^.next; + dispose(location); + location:=hlocation; + end; + alignment:=0; + size:=OS_NO; + intsize:=0; +{$ifdef powerpc} + composite:=false; +{$endif powerpc} + end; + + + function tcgpara.getcopy:tcgpara; + var + hlocation : pcgparalocation; + begin + result.init; + while assigned(location) do + begin + hlocation:=result.add_location; + hlocation^:=location^; + hlocation^.next:=nil; + location:=location^.next; + end; + result.alignment:=alignment; + result.size:=size; + result.intsize:=intsize; +{$ifdef powerpc} + result.composite:=composite; +{$endif powerpc} + end; + + + function tcgpara.add_location:pcgparalocation; + var + prevlocation, + hlocation : pcgparalocation; + begin + prevlocation:=nil; + hlocation:=location; + while assigned(hlocation) do + begin + prevlocation:=hlocation; + hlocation:=hlocation^.next; + end; + new(hlocation); + Fillchar(hlocation^,sizeof(tcgparalocation),0); + if assigned(prevlocation) then + prevlocation^.next:=hlocation + else + location:=hlocation; + result:=hlocation; + end; + + + procedure tcgpara.check_simple_location; + begin + if not assigned(location) then + internalerror(200408161); + if assigned(location^.next) then + internalerror(200408162); + end; + + + procedure tcgpara.get_location(var newloc:tlocation); + begin + if not assigned(location) then + internalerror(200408205); + fillchar(newloc,sizeof(newloc),0); + newloc.loc:=location^.loc; + newloc.size:=size; + case location^.loc of + LOC_REGISTER : + begin +{$ifndef cpu64bitalu} + if size in [OS_64,OS_S64] then + begin + if not assigned(location^.next) then + internalerror(200408206); + if (location^.next^.loc<>LOC_REGISTER) then + internalerror(200408207); + if (target_info.endian = ENDIAN_BIG) then + begin + newloc.register64.reghi:=location^.register; + newloc.register64.reglo:=location^.next^.register; + end + else + begin + newloc.register64.reglo:=location^.register; + newloc.register64.reghi:=location^.next^.register; + end; + end + else +{$endif} + newloc.register:=location^.register; + end; + LOC_FPUREGISTER, + LOC_MMREGISTER : + newloc.register:=location^.register; + LOC_REFERENCE : + begin + newloc.reference.base:=location^.reference.index; + newloc.reference.offset:=location^.reference.offset; + newloc.reference.alignment:=alignment; + end; + end; + end; + + + procedure TCGPara.ppuwrite(ppufile: tcompilerppufile); + var + hparaloc: PCGParaLocation; + nparaloc: byte; + begin + ppufile.putbyte(byte(Alignment)); + ppufile.putbyte(ord(Size)); + ppufile.putaint(IntSize); +{$ifdef powerpc} + ppufile.putbyte(byte(composite)); +{$endif} + nparaloc:=0; + hparaloc:=location; + while assigned(hparaloc) do + begin + inc(nparaloc); + hparaloc:=hparaloc^.Next; + end; + ppufile.putbyte(nparaloc); + hparaloc:=location; + while assigned(hparaloc) do + begin + ppufile.putbyte(byte(hparaloc^.Size)); + ppufile.putbyte(byte(hparaloc^.loc)); + case hparaloc^.loc of + LOC_REFERENCE: + begin + ppufile.putlongint(longint(hparaloc^.reference.index)); + ppufile.putaint(hparaloc^.reference.offset); + end; + LOC_FPUREGISTER, + LOC_CFPUREGISTER, + LOC_MMREGISTER, + LOC_CMMREGISTER, + LOC_REGISTER, + LOC_CREGISTER : + begin +{$ifdef powerpc64} + ppufile.putbyte(hparaloc^.shiftval); +{$endif} + ppufile.putlongint(longint(hparaloc^.register)); + end; + { This seems to be required for systems using explicitparaloc (eg. MorphOS) + or otherwise it hits the internalerror below. I don't know if this is + the proper way to fix this, someone else with clue might want to take a + look. The compiler cycles on the affected systems with this enabled. (KB) } + LOC_VOID: + begin end + else + internalerror(2010053115); + end; + hparaloc:=hparaloc^.next; + end; + end; + + + procedure TCGPara.ppuload(ppufile: tcompilerppufile); + var + hparaloc: PCGParaLocation; + nparaloc: byte; + begin + reset; + Alignment:=shortint(ppufile.getbyte); + Size:=TCgSize(ppufile.getbyte); + IntSize:=ppufile.getaint; +{$ifdef powerpc} + composite:=boolean(ppufile.getbyte); +{$endif} + nparaloc:=ppufile.getbyte; + while nparaloc>0 do + begin + hparaloc:=add_location; + hparaloc^.size:=TCGSize(ppufile.getbyte); + hparaloc^.loc:=TCGLoc(ppufile.getbyte); + case hparaloc^.loc of + LOC_REFERENCE: + begin + hparaloc^.reference.index:=tregister(ppufile.getlongint); + hparaloc^.reference.offset:=ppufile.getaint; + end; + LOC_FPUREGISTER, + LOC_CFPUREGISTER, + LOC_MMREGISTER, + LOC_CMMREGISTER, + LOC_REGISTER, + LOC_CREGISTER : + begin +{$ifdef powerpc64} + hparaloc^.shiftval:=ppufile.getbyte; +{$endif} + hparaloc^.register:=tregister(ppufile.getlongint); + end; + { This seems to be required for systems using explicitparaloc (eg. MorphOS) + or otherwise it hits the internalerror below. I don't know if this is + the proper way to fix this, someone else with clue might want to take a + look. The compiler cycles on the affected systems with this enabled. (KB) } + LOC_VOID: + begin end + else + internalerror(2010051301); + end; + dec(nparaloc); + end; + end; + + +{**************************************************************************** + TParaList +****************************************************************************} + + function ParaNrCompare(Item1, Item2: Pointer): Integer; + var + I1 : tparavarsym absolute Item1; + I2 : tparavarsym absolute Item2; + begin + Result:=longint(I1.paranr)-longint(I2.paranr); + end; + + + procedure TParaList.SortParas; + begin + Sort(@ParaNrCompare); + end; + + +end. diff --git a/closures/compiler/paramgr.pas b/closures/compiler/paramgr.pas new file mode 100644 index 0000000000..13d149b641 --- /dev/null +++ b/closures/compiler/paramgr.pas @@ -0,0 +1,484 @@ +{ + Copyright (c) 2002 by Florian Klaempfl + + Generic calling convention 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. + **************************************************************************** +} +{# Parameter passing manager. Used to manage how + parameters are passed to routines. +} +unit paramgr; + +{$i fpcdefs.inc} + + interface + + uses + cclasses,globtype, + cpubase,cgbase,cgutils, + parabase, + aasmtai,aasmdata, + symconst,symtype,symsym,symdef; + + type + {# This class defines some methods to take care of routine + parameters. It should be overridden for each new processor + } + + { tparamanager } + + tparamanager = class + { true if the location in paraloc can be reused as localloc } + function param_use_paraloc(const cgpara:tcgpara):boolean;virtual; + {# Returns true if the return value is actually a parameter + pointer. + } + function ret_in_param(def : tdef;calloption : tproccalloption) : boolean;virtual; + + function push_high_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;virtual; + + { Returns true if a parameter is too large to copy and only + the address is pushed + } + function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;virtual;abstract; + { return the size of a push } + function push_size(varspez:tvarspez;def : tdef;calloption : tproccalloption) : longint; + {# Returns a structure giving the information on + the storage of the parameter (which must be + an integer parameter). This is only used when calling + internal routines directly, where all parameters must + be 4-byte values. + + In case the location is a register, this register is allocated. + Call freeintparaloc() after the call to free the locations again. + Default implementation: don't do anything at all (in case you don't + use register parameter passing) + + @param(list Current assembler list) + @param(nr Parameter number of routine, starting from 1) + } + function get_para_align(calloption : tproccalloption):byte;virtual; + function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;virtual; + function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;virtual; + function get_volatile_registers_flags(calloption : tproccalloption):tcpuregisterset;virtual; + function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;virtual; + + procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);virtual;abstract; + + {# allocate an individual pcgparalocation that's part of a tcgpara + + @param(list Current assembler list) + @param(loc Parameter location element) + } + procedure allocparaloc(list: TAsmList; const paraloc: pcgparalocation); + + {# allocate a parameter location created with create_paraloc_info + + @param(list Current assembler list) + @param(loc Parameter location) + } + procedure alloccgpara(list: TAsmList; const cgpara: TCGPara); virtual; + + {# free a parameter location allocated with alloccgpara + + @param(list Current assembler list) + @param(loc Parameter location) + } + procedure freecgpara(list: TAsmList; const cgpara: TCGPara); virtual; + + { This is used to populate the location information on all parameters + for the routine as seen in either the caller or the callee. It returns + the size allocated on the stack + } + function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;virtual;abstract; + + { Returns the location of the function result if p had def as + function result instead of its actual result. Used if the compiler + forces the function result to something different than the real + result. } + function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;virtual;abstract; + + { This is used to populate the location information on all parameters + for the routine when it is being inlined. It returns + the size allocated on the stack + } + function create_inline_paraloc_info(p : tabstractprocdef):longint;virtual; + + { This is used to populate the location information on all parameters + for the routine that are passed as varargs. It returns + the size allocated on the stack (including the normal parameters) + } + function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;virtual;abstract; + + function is_stack_paraloc(paraloc: pcgparalocation): boolean; + procedure createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara);virtual; + procedure duplicatecgparaloc(const orgparaloc: pcgparalocation; intonewparaloc: pcgparalocation); + procedure duplicateparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara); + + function parseparaloc(parasym : tparavarsym;const s : string) : boolean;virtual; + function parsefuncretloc(p : tabstractprocdef; const s : string) : boolean;virtual; + + { allocate room for parameters on the stack in the entry code? } + function use_fixed_stack: boolean; + { whether stack pointer can be changed in the middle of procedure } + function use_stackalloc: boolean; + end; + + + var + paramanager : tparamanager; + + +implementation + + uses + systems, + cgobj,tgobj, + defutil,verbose; + + { true if the location in paraloc can be reused as localloc } + function tparamanager.param_use_paraloc(const cgpara:tcgpara):boolean; + begin + result:=false; + end; + + + { true if uses a parameter as return value } + function tparamanager.ret_in_param(def : tdef;calloption : tproccalloption) : boolean; + begin + ret_in_param:=((def.typ=arraydef) and not(is_dynamic_array(def))) or + (def.typ=recorddef) or + (def.typ=stringdef) or + ((def.typ=procvardef) and not tprocvardef(def).is_addressonly) or + { interfaces are also passed by reference to be compatible with delphi and COM } + ((def.typ=objectdef) and (is_object(def) or is_interface(def) or is_dispinterface(def))) or + (def.typ=variantdef) or + ((def.typ=setdef) and not is_smallset(def)); + end; + + + function tparamanager.push_high_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; + begin + push_high_param:=not(calloption in cdecl_pocalls) and + ( + is_open_array(def) or + is_open_string(def) or + is_array_of_const(def) + ); + end; + + + { return the size of a push } + function tparamanager.push_size(varspez:tvarspez;def : tdef;calloption : tproccalloption) : longint; + begin + push_size:=-1; + case varspez of + vs_constref, + vs_out, + vs_var : + push_size:=sizeof(pint); + vs_value, + vs_const : + begin + if push_addr_param(varspez,def,calloption) then + push_size:=sizeof(pint) + else + begin + { special array are normally pushed by addr, only for + cdecl array of const it comes here and the pushsize + is unknown } + if is_array_of_const(def) then + push_size:=0 + else + push_size:=def.size; + end; + end; + end; + end; + + + function tparamanager.get_para_align(calloption : tproccalloption):byte; + begin + result:=std_param_align; + end; + + + function tparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset; + begin + result:=[]; + end; + + + function tparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset; + begin + result:=[]; + end; + + + function tparamanager.get_volatile_registers_flags(calloption : tproccalloption):tcpuregisterset; + begin + result:=[]; + end; + + + function tparamanager.get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset; + begin + result:=[]; + end; + +{$if first_mm_imreg = 0} + {$WARN 4044 OFF} { Comparison might be always false ... } +{$endif} + + procedure tparamanager.allocparaloc(list: TAsmList; const paraloc: pcgparalocation); + begin + case paraloc^.loc of + LOC_REGISTER, + LOC_CREGISTER: + begin + if getsupreg(paraloc^.register)<first_int_imreg then + cg.getcpuregister(list,paraloc^.register); + end; +{$ifndef x86} +{ don't allocate ST(x), they're not handled by the register allocator } + LOC_FPUREGISTER, + LOC_CFPUREGISTER: + begin + if getsupreg(paraloc^.register)<first_fpu_imreg then + cg.getcpuregister(list,paraloc^.register); + end; +{$endif not x86} + LOC_MMREGISTER, + LOC_CMMREGISTER : + begin + if getsupreg(paraloc^.register)<first_mm_imreg then + cg.getcpuregister(list,paraloc^.register); + end; + end; + end; + + + procedure tparamanager.alloccgpara(list: TAsmList; const cgpara: TCGPara); + var + paraloc : pcgparalocation; + begin + paraloc:=cgpara.location; + while assigned(paraloc) do + begin + allocparaloc(list,paraloc); + paraloc:=paraloc^.next; + end; + end; + + + procedure tparamanager.freecgpara(list: TAsmList; const cgpara: TCGPara); + var + paraloc : Pcgparalocation; + href : treference; + begin + paraloc:=cgpara.location; + while assigned(paraloc) do + begin + case paraloc^.loc of + LOC_VOID: + ; + LOC_REGISTER, + LOC_CREGISTER: + begin + if getsupreg(paraloc^.register)<first_int_imreg then + cg.ungetcpuregister(list,paraloc^.register); + end; + LOC_FPUREGISTER, + LOC_CFPUREGISTER: + begin + if getsupreg(paraloc^.register)<first_fpu_imreg then + cg.ungetcpuregister(list,paraloc^.register); + end; + LOC_MMREGISTER, + LOC_CMMREGISTER : + begin + if getsupreg(paraloc^.register)<first_mm_imreg then + cg.ungetcpuregister(list,paraloc^.register); + end; + LOC_REFERENCE, + LOC_CREFERENCE : + begin + if use_fixed_stack then + begin + { don't use reference_reset_base, because that will depend on cgobj } + fillchar(href,sizeof(href),0); + href.base:=paraloc^.reference.index; + href.offset:=paraloc^.reference.offset; + tg.ungetiftemp(list,href); + end; + end; + else + internalerror(2004110212); + end; + paraloc:=paraloc^.next; + end; + end; + + + function tparamanager.is_stack_paraloc(paraloc: pcgparalocation): boolean; + begin + result:= + assigned(paraloc) and + (paraloc^.loc=LOC_REFERENCE) and + (paraloc^.reference.index=NR_STACK_POINTER_REG); + end; + + + procedure tparamanager.createtempparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;can_use_final_stack_loc : boolean;var cgpara:TCGPara); + var + href : treference; + len : aint; + paraloc, + newparaloc : pcgparalocation; + begin + paraloc:=parasym.paraloc[callerside].location; + cgpara.reset; + cgpara.size:=parasym.paraloc[callerside].size; + cgpara.intsize:=parasym.paraloc[callerside].intsize; + cgpara.alignment:=parasym.paraloc[callerside].alignment; +{$ifdef powerpc} + cgpara.composite:=parasym.paraloc[callerside].composite; +{$endif powerpc} + while assigned(paraloc) do + begin + if paraloc^.size=OS_NO then + len:=push_size(parasym.varspez,parasym.vardef,calloption) + else + len:=tcgsize2size[paraloc^.size]; + newparaloc:=cgpara.add_location; + newparaloc^.size:=paraloc^.size; + { $warning maybe release this optimization for all targets? } + { released for all CPUs: + i386 isn't affected anyways because it uses the stack to push parameters + on arm it reduces executable size of the compiler by 2.1 per cent (FK) } + { Does it fit a register? } + if ((not can_use_final_stack_loc and + use_fixed_stack) or + not is_stack_paraloc(paraloc)) and + (len<=sizeof(pint)) and + (paraloc^.size in [OS_8,OS_16,OS_32,OS_64,OS_128,OS_S8,OS_S16,OS_S32,OS_S64,OS_S128]) then + newparaloc^.loc:=LOC_REGISTER + else + newparaloc^.loc:=paraloc^.loc; + case newparaloc^.loc of + LOC_REGISTER : + newparaloc^.register:=cg.getintregister(list,paraloc^.size); + LOC_FPUREGISTER : + newparaloc^.register:=cg.getfpuregister(list,paraloc^.size); + LOC_MMREGISTER : + newparaloc^.register:=cg.getmmregister(list,paraloc^.size); + LOC_REFERENCE : + begin + if (can_use_final_stack_loc or + not use_fixed_stack) and + is_stack_paraloc(paraloc) then + duplicatecgparaloc(paraloc,newparaloc) + else + begin + tg.gettemp(list,len,cgpara.alignment,tt_persistent,href); + newparaloc^.reference.index:=href.base; + newparaloc^.reference.offset:=href.offset; + end; + end; + end; + paraloc:=paraloc^.next; + end; + end; + + + procedure tparamanager.duplicatecgparaloc(const orgparaloc: pcgparalocation; intonewparaloc: pcgparalocation); + begin + move(orgparaloc^,intonewparaloc^,sizeof(intonewparaloc^)); + intonewparaloc^.next:=nil; + end; + + + procedure tparamanager.duplicateparaloc(list: TAsmList;calloption : tproccalloption;parasym : tparavarsym;var cgpara:TCGPara); + var + paraloc, + newparaloc : pcgparalocation; + begin + cgpara.reset; + cgpara.size:=parasym.paraloc[callerside].size; + cgpara.intsize:=parasym.paraloc[callerside].intsize; + cgpara.alignment:=parasym.paraloc[callerside].alignment; +{$ifdef powerpc} + cgpara.composite:=parasym.paraloc[callerside].composite; +{$endif powerpc} + paraloc:=parasym.paraloc[callerside].location; + while assigned(paraloc) do + begin + newparaloc:=cgpara.add_location; + duplicatecgparaloc(paraloc,newparaloc); + paraloc:=paraloc^.next; + end; + end; + + + function tparamanager.create_inline_paraloc_info(p : tabstractprocdef):longint; + begin + { We need to return the size allocated } + p.init_paraloc_info(callbothsides); + result:=p.calleeargareasize; + end; + + + function tparamanager.parseparaloc(parasym: tparavarsym; const s: string): boolean; + begin + Result:=False; + internalerror(200807235); + end; + + + function tparamanager.parsefuncretloc(p: tabstractprocdef; const s: string): boolean; + begin + Result:=False; + internalerror(200807236); + end; + + + function tparamanager.use_fixed_stack: boolean; + begin +{$ifdef i386} + result := (target_info.system in [system_i386_darwin,system_i386_iphonesim]); +{$else i386} +{$ifdef cputargethasfixedstack} + result := true; +{$else cputargethasfixedstack} + result := false; +{$endif cputargethasfixedstack} +{$endif i386} + end; + + { This is a separate function because at least win64 allows stack allocations + despite of fixed stack semantics (actually supporting it requires generating + a compliant stack frame, not yet possible) } + function tparamanager.use_stackalloc: boolean; + begin + result:=not use_fixed_stack; + end; + +initialization + ; +finalization + paramanager.free; +end. diff --git a/closures/compiler/parser.pas b/closures/compiler/parser.pas new file mode 100644 index 0000000000..56a2a5cfdf --- /dev/null +++ b/closures/compiler/parser.pas @@ -0,0 +1,529 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit does the parsing process + + 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 parser; + +{$i fpcdefs.inc} + +interface + +{$ifdef PREPROCWRITE} + procedure preprocess(const filename:string); +{$endif PREPROCWRITE} + procedure compile(const filename:string); + procedure initparser; + procedure doneparser; + +implementation + + uses +{$IFNDEF USE_FAKE_SYSUTILS} + sysutils, +{$ELSE} + fksysutl, +{$ENDIF} + cutils,cclasses, + globtype,version,tokens,systems,globals,verbose,switches, + symbase,symtable,symdef,symsym, + finput,fmodule,fppu, + aasmbase,aasmtai,aasmdata, + cgbase, + script,gendef, + comphook, + scanner,scandir, + pbase,ptype,psystem,pmodules,psub,ncgrtti,htypechk, + cresstr,cpuinfo,procinfo; + + + procedure initparser; + begin + { Current compiled module/proc } + set_current_module(nil); + current_module:=nil; + current_asmdata:=nil; + current_procinfo:=nil; + current_structdef:=nil; + current_genericdef:=nil; + current_specializedef:=nil; + + loaded_units:=TLinkedList.Create; + + usedunits:=TLinkedList.Create; + + unloaded_units:=TLinkedList.Create; + + { global switches } + current_settings.globalswitches:=init_settings.globalswitches; + + current_settings.sourcecodepage:=init_settings.sourcecodepage; + + { initialize scanner } + InitScanner; + InitScannerDirectives; + + { scanner } + c:=#0; + pattern:=''; + orgpattern:=''; + cstringpattern:=''; + current_scanner:=nil; + switchesstatestackpos:=0; + + { register all nodes and tais } + registernodes; + registertais; + + { memory sizes } + if stacksize=0 then + stacksize:=target_info.stacksize; + + { RTTI writer } + RTTIWriter:=TRTTIWriter.Create; + + { open assembler response } + if cs_link_on_target in current_settings.globalswitches then + GenerateAsmRes(outputexedir+ChangeFileExt(inputfilename,'_ppas')) + else + GenerateAsmRes(outputexedir+'ppas'); + + { open deffile } + DefFile:=TDefFile.Create(outputexedir+ChangeFileExt(inputfilename,target_info.defext)); + + { list of generated .o files, so the linker can remove them } + SmartLinkOFiles:=TCmdStrList.Create; + + { codegen } + if paraprintnodetree<>0 then + printnode_reset; + + { target specific stuff } + case target_info.system of + system_powerpc_amiga: + include(supported_calling_conventions,pocall_syscall); + system_powerpc_morphos: + include(supported_calling_conventions,pocall_syscall); + system_m68k_amiga: + include(supported_calling_conventions,pocall_syscall); + end; + end; + + + procedure doneparser; + begin + { Reset current compiling info, so destroy routines can't + reference the data that might already be destroyed } + set_current_module(nil); + current_module:=nil; + current_procinfo:=nil; + current_asmdata:=nil; + current_structdef:=nil; + current_genericdef:=nil; + current_specializedef:=nil; + + { unload units } + if assigned(loaded_units) then + begin + loaded_units.free; + loaded_units:=nil; + end; + if assigned(usedunits) then + begin + usedunits.free; + usedunits:=nil; + end; + if assigned(unloaded_units) then + begin + unloaded_units.free; + unloaded_units:=nil; + end; + + { if there was an error in the scanner, the scanner is + still assinged } + if assigned(current_scanner) then + begin + current_scanner.free; + current_scanner:=nil; + end; + + { close scanner } + DoneScanner; + + RTTIWriter.free; + + { close ppas,deffile } + asmres.free; + deffile.free; + + { free list of .o files } + SmartLinkOFiles.Free; + end; + + + + +{$ifdef PREPROCWRITE} + procedure preprocess(const filename:string); + var + i : longint; + begin + new(preprocfile,init('pre')); + { initialize a module } + set_current_module(new(pmodule,init(filename,false))); + + macrosymtablestack:= initialmacrosymtable; + current_module.localmacrosymtable:= tmacrosymtable.create(false); + current_module.localmacrosymtable.next:= initialmacrosymtable; + macrosymtablestack:= current_module.localmacrosymtable; + + main_module:=current_module; + { startup scanner, and save in current_module } + current_scanner:=new(pscannerfile,Init(filename)); + current_module.scanner:=current_scanner; + { loop until EOF is found } + repeat + current_scanner^.readtoken(true); + preprocfile^.AddSpace; + case token of + _ID : + begin + preprocfile^.Add(orgpattern); + end; + _REALNUMBER, + _INTCONST : + preprocfile^.Add(pattern); + _CSTRING : + begin + i:=0; + while (i<length(cstringpattern)) do + begin + inc(i); + if cstringpattern[i]='''' then + begin + insert('''',cstringpattern,i); + inc(i); + end; + end; + preprocfile^.Add(''''+cstringpattern+''''); + end; + _CCHAR : + begin + case pattern[1] of + #39 : + pattern:=''''''''; + #0..#31, + #128..#255 : + begin + str(ord(pattern[1]),pattern); + pattern:='#'+pattern; + end; + else + pattern:=''''+pattern[1]+''''; + end; + preprocfile^.Add(pattern); + end; + _EOF : + break; + else + preprocfile^.Add(tokeninfo^[token].str) + end; + until false; + { free scanner } + dispose(current_scanner,done); + current_scanner:=nil; + { close } + dispose(preprocfile,done); + end; +{$endif PREPROCWRITE} + + +{***************************************************************************** + Compile a source file +*****************************************************************************} + + procedure compile(const filename:string); + type + polddata=^tolddata; + tolddata=record + { scanner } + oldidtoken, + oldtoken : ttoken; + oldtokenpos : tfileposinfo; + oldc : char; + oldpattern, + oldorgpattern : string; + old_block_type : tblock_type; + { symtable } + oldsymtablestack, + oldmacrosymtablestack : TSymtablestack; + oldaktprocsym : tprocsym; + { cg } + oldparse_only : boolean; + { akt.. things } + oldcurrent_filepos : tfileposinfo; + old_current_module : tmodule; + oldcurrent_procinfo : tprocinfo; + old_settings : tsettings; + old_switchesstatestack : tswitchesstatestack; + old_switchesstatestackpos : Integer; + end; + + var + olddata : polddata; + hp,hp2 : tmodule; + begin + { parsing a procedure or declaration should be finished } + if assigned(current_procinfo) then + internalerror(200811121); + if assigned(current_structdef) then + internalerror(200811122); + inc(compile_level); + parser_current_file:=filename; + { Uses heap memory instead of placing everything on the + stack. This is needed because compile() can be called + recursively } + new(olddata); + with olddata^ do + begin + old_current_module:=current_module; + + { save symtable state } + oldsymtablestack:=symtablestack; + oldmacrosymtablestack:=macrosymtablestack; + oldcurrent_procinfo:=current_procinfo; + + { save scanner state } + oldc:=c; + oldpattern:=pattern; + oldorgpattern:=orgpattern; + oldtoken:=token; + oldidtoken:=idtoken; + old_block_type:=block_type; + oldtokenpos:=current_tokenpos; + old_switchesstatestack:=switchesstatestack; + old_switchesstatestackpos:=switchesstatestackpos; + + { save cg } + oldparse_only:=parse_only; + + { save akt... state } + { handle the postponed case first } + flushpendingswitchesstate; + oldcurrent_filepos:=current_filepos; + old_settings:=current_settings; + end; + + { reset parser, a previous fatal error could have left these variables in an unreliable state, this is + important for the IDE } + afterassignment:=false; + in_args:=false; + named_args_allowed:=false; + got_addrn:=false; + getprocvardef:=nil; + allow_array_constructor:=false; + + { show info } + Message1(parser_i_compiling,filename); + + { reset symtable } + symtablestack:=tdefawaresymtablestack.create; + macrosymtablestack:=TSymtablestack.create; + systemunit:=nil; + current_settings.defproccall:=init_settings.defproccall; + current_exceptblock:=0; + exceptblockcounter:=0; + current_settings.maxfpuregisters:=-1; + current_settings.pmessage:=nil; + { reset the unit or create a new program } + { a unit compiled at command line must be inside the loaded_unit list } + if (compile_level=1) then + begin + if assigned(current_module) then + internalerror(200501158); + set_current_module(tppumodule.create(nil,'',filename,false)); + addloadedunit(current_module); + main_module:=current_module; + current_module.state:=ms_compile; + end; + if not(assigned(current_module) and + (current_module.state in [ms_compile,ms_second_compile])) then + internalerror(200212281); + + { Load current state from the init values } + current_settings:=init_settings; + + { load current asmdata from current_module } + current_asmdata:=TAsmData(current_module.asmdata); + + { startup scanner and load the first file } + current_scanner:=tscannerfile.Create(filename); + current_scanner.firstfile; + current_module.scanner:=current_scanner; + + { init macros before anything in the file is parsed.} + current_module.localmacrosymtable:= tmacrosymtable.create(false); + macrosymtablestack.push(initialmacrosymtable); + macrosymtablestack.push(current_module.localmacrosymtable); + + { read the first token } + current_scanner.readtoken(false); + + { If the compile level > 1 we get a nice "unit expected" error + message if we are trying to use a program as unit.} + try + try + if (token=_UNIT) or (compile_level>1) then + begin + current_module.is_unit:=true; + proc_unit; + end + else if (token=_ID) and (idtoken=_PACKAGE) then + begin + current_module.IsPackage:=true; + proc_package; + end + else + proc_program(token=_LIBRARY); + except + on ECompilerAbort do + raise; + on Exception do + begin + { Increase errorcounter to prevent some + checks during cleanup } + inc(status.errorcount); + raise; + end; + end; + finally + if assigned(current_module) then + begin + { module is now compiled } + tppumodule(current_module).state:=ms_compiled; + + { free ppu } + if assigned(tppumodule(current_module).ppufile) then + begin + tppumodule(current_module).ppufile.free; + tppumodule(current_module).ppufile:=nil; + end; + + { free asmdata } + if assigned(current_module.asmdata) then + begin + current_module.asmdata.free; + current_module.asmdata:=nil; + end; + + { free scanner } + if assigned(current_module.scanner) then + begin + if current_scanner=tscannerfile(current_module.scanner) then + current_scanner:=nil; + tscannerfile(current_module.scanner).free; + current_module.scanner:=nil; + end; + + { free symtable stack } + if assigned(symtablestack) then + begin + symtablestack.free; + symtablestack:=nil; + end; + if assigned(macrosymtablestack) then + begin + macrosymtablestack.free; + macrosymtablestack:=nil; + end; + end; + + if (compile_level=1) and + (status.errorcount=0) then + { Write Browser Collections } + do_extractsymbolinfo; + + with olddata^ do + begin + { restore scanner } + c:=oldc; + pattern:=oldpattern; + orgpattern:=oldorgpattern; + token:=oldtoken; + idtoken:=oldidtoken; + current_tokenpos:=oldtokenpos; + block_type:=old_block_type; + switchesstatestack:=old_switchesstatestack; + switchesstatestackpos:=old_switchesstatestackpos; + + { restore cg } + parse_only:=oldparse_only; + + { restore symtable state } + symtablestack:=oldsymtablestack; + macrosymtablestack:=oldmacrosymtablestack; + current_procinfo:=oldcurrent_procinfo; + current_filepos:=oldcurrent_filepos; + current_settings:=old_settings; + { Restore all locally modified warning messages } + RestoreLocalVerbosity(current_settings.pmessage); + current_exceptblock:=0; + exceptblockcounter:=0; + end; + { Shut down things when the last file is compiled succesfull } + if (compile_level=1) and + (status.errorcount=0) then + begin + parser_current_file:=''; + { Close script } + if (not AsmRes.Empty) then + begin + Message1(exec_i_closing_script,AsmRes.Fn); + AsmRes.WriteToDisk; + end; + end; + + { free now what we did not free earlier in + proc_program PM } + if (compile_level=1) and needsymbolinfo then + begin + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + hp2:=tmodule(hp.next); + if (hp<>current_module) then + begin + loaded_units.remove(hp); + hp.free; + end; + hp:=hp2; + end; + { free also unneeded units we didn't free before } + unloaded_units.Clear; + end; + dec(compile_level); + set_current_module(olddata^.old_current_module); + + FreeLocalVerbosity(current_settings.pmessage); + + dispose(olddata); + end; + end; + +end. diff --git a/closures/compiler/pass_1.pas b/closures/compiler/pass_1.pas new file mode 100644 index 0000000000..41f5cbcb9c --- /dev/null +++ b/closures/compiler/pass_1.pas @@ -0,0 +1,253 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit handles the pass_typecheck and node conversion pass + + 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 pass_1; + +{$i fpcdefs.inc} + +interface + + uses + node; + + procedure typecheckpass(var p : tnode); + function do_typecheckpass(var p : tnode) : boolean; + function do_typecheckpass_changed(var p : tnode; out nodechanged: boolean) : boolean; + + procedure firstpass(var p : tnode); + function do_firstpass(var p : tnode) : boolean; +{$ifdef state_tracking} + procedure do_track_state_pass(p:Tnode); +{$endif} + + +implementation + + uses + globtype,comphook,systems,cclasses, + cutils,globals, + procinfo, + cgbase,symdef +{$ifdef extdebug} + ,verbose,htypechk +{$endif extdebug} +{$ifdef state_tracking} + ,nstate +{$endif} + ; + +{***************************************************************************** + Global procedures +*****************************************************************************} + + procedure typecheckpass_internal(var p : tnode; out node_changed: boolean); + var + oldcodegenerror : boolean; + oldlocalswitches : tlocalswitches; + oldverbosity : longint; + oldpos : tfileposinfo; + hp : tnode; + begin + node_changed:=false; + if (p.resultdef=nil) then + begin + oldcodegenerror:=codegenerror; + oldpos:=current_filepos; + oldlocalswitches:=current_settings.localswitches; + oldverbosity:=status.verbosity; + codegenerror:=false; + current_filepos:=p.fileinfo; + current_settings.localswitches:=p.localswitches; + status.verbosity:=p.verbosity; + hp:=p.pass_typecheck; + { should the node be replaced? } + if assigned(hp) then + begin + node_changed:=true; + p.free; + { switch to new node } + p:=hp; + { run typecheckpass } + typecheckpass(p); + end; + current_settings.localswitches:=oldlocalswitches; + current_filepos:=oldpos; + status.verbosity:=oldverbosity; + if codegenerror then + begin + include(p.flags,nf_error); + { default to errortype if no type is set yet } + if p.resultdef=nil then + p.resultdef:=generrordef; + end; + codegenerror:=codegenerror or oldcodegenerror; + end + else + begin + { update the codegenerror boolean with the previous result of this node } + if (nf_error in p.flags) then + codegenerror:=true; + end; + end; + + + procedure typecheckpass(var p : tnode); + var + node_changed: boolean; + begin + typecheckpass_internal(p,node_changed); + end; + + + function do_typecheckpass_changed(var p : tnode; out nodechanged: boolean) : boolean; + begin + codegenerror:=false; + typecheckpass_internal(p,nodechanged); + do_typecheckpass_changed:=codegenerror; + end; + + + function do_typecheckpass(var p : tnode) : boolean; + var + nodechanged: boolean; + begin + result:=do_typecheckpass_changed(p,nodechanged); + end; + + + procedure firstpass(var p : tnode); + var + oldcodegenerror : boolean; + oldlocalswitches : tlocalswitches; + oldpos : tfileposinfo; + oldverbosity: longint; + hp : tnode; + begin + if (nf_pass1_done in p.flags) then + exit; + if not(nf_error in p.flags) then + begin + oldcodegenerror:=codegenerror; + oldpos:=current_filepos; + oldlocalswitches:=current_settings.localswitches; + oldverbosity:=status.verbosity; + codegenerror:=false; + current_filepos:=p.fileinfo; + current_settings.localswitches:=p.localswitches; + status.verbosity:=p.verbosity; + { checks make always a call } + if ([cs_check_range,cs_check_overflow,cs_check_stack] * current_settings.localswitches <> []) then + include(current_procinfo.flags,pi_do_call); + { determine the resultdef if not done } + if (p.resultdef=nil) then + begin + hp:=p.pass_typecheck; + { should the node be replaced? } + if assigned(hp) then + begin + p.free; + { switch to new node } + p:=hp; + { run typecheckpass } + typecheckpass(p); + end; + if codegenerror then + begin + include(p.flags,nf_error); + { default to errortype if no type is set yet } + if p.resultdef=nil then + p.resultdef:=generrordef; + end; + codegenerror:=codegenerror or oldcodegenerror; + end; + if not(nf_error in p.flags) then + begin + { first pass } + hp:=p.pass_1; + { should the node be replaced? } + if assigned(hp) then + begin + p.free; + { switch to new node } + p := hp; + { run firstpass } + firstpass(p); + end + else + begin + { inlining happens in pass_1 and can cause new } + { simplify opportunities } + hp:=p.simplify(true); + if assigned(hp) then + begin + p.free; + p := hp; + firstpass(p); + end; + end; + if codegenerror then + include(p.flags,nf_error) + else + begin +{$ifdef EXTDEBUG} + if (p.expectloc=LOC_INVALID) then + Comment(V_Warning,'Expectloc is not set in firstpass: '+nodetype2str[p.nodetype]); +{$endif EXTDEBUG} + end; + end; + include(p.flags,nf_pass1_done); + codegenerror:=codegenerror or oldcodegenerror; + current_settings.localswitches:=oldlocalswitches; + current_filepos:=oldpos; + status.verbosity:=oldverbosity; + end + else + codegenerror:=true; + end; + + + function do_firstpass(var p : tnode) : boolean; + begin + codegenerror:=false; + firstpass(p); +{$ifdef state_tracking} + writeln('TRACKSTART'); + writeln('before'); + writenode(p); + do_track_state_pass(p); + writeln('after'); + writenode(p); + writeln('TRACKDONE'); +{$endif} + do_firstpass:=codegenerror; + end; + +{$ifdef state_tracking} + procedure do_track_state_pass(p:Tnode); + + begin + aktstate:=Tstate_storage.create; + p.track_state_pass(true); + aktstate.destroy; + end; +{$endif} + +end. diff --git a/closures/compiler/pass_2.pas b/closures/compiler/pass_2.pas new file mode 100644 index 0000000000..2aa9879912 --- /dev/null +++ b/closures/compiler/pass_2.pas @@ -0,0 +1,234 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit handles the codegeneration pass + + 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 pass_2; + +{$i fpcdefs.inc} + +interface + +uses + node; + + type + tenumflowcontrol = ( + fc_exit, + fc_break, + fc_continue, + fc_inflowcontrol, + fc_gotolabel, + { in try block of try..finally } + fc_unwind, + { the left side of an expression is already handled, so we are + not allowed to do ssl } + fc_lefthandled); + + tflowcontrol = set of tenumflowcontrol; + + var + flowcontrol : tflowcontrol; + +{ produces the actual code } +function do_secondpass(var p : tnode) : boolean; +procedure secondpass(var p : tnode); + + +implementation + + uses +{$ifdef EXTDEBUG} + cutils, +{$endif} + globtype,systems,verbose, + globals, + paramgr, + aasmtai,aasmdata, + cgbase, + nflw,cgobj; + +{***************************************************************************** + SecondPass +*****************************************************************************} + +{$ifdef EXTDEBUG} + var + secondprefix : string; + + procedure logsecond(ht:tnodetype; entry: boolean); + const + secondnames: array[tnodetype] of string[13] = + ('<emptynode>', + 'add-addn', {addn} + 'add-muln', {muln} + 'add-subn', {subn} + 'moddiv-divn', {divn} + 'add-symdifn', {symdifn} + 'moddiv-modn', {modn} + 'assignment', {assignn} + 'load', {loadn} + 'nothing-range', {range} + 'add-ltn', {ltn} + 'add-lten', {lten} + 'add-gtn', {gtn} + 'add-gten', {gten} + 'add-equaln', {equaln} + 'add-unequaln', {unequaln} + 'in', {inn} + 'add-orn', {orn} + 'add-xorn', {xorn} + 'shlshr-shrn', {shrn} + 'shlshr-shln', {shln} + 'add-slashn', {slashn} + 'add-andn', {andn} + 'subscriptn', {subscriptn} + 'deref', {derefn} + 'addr', {addrn} + 'ordconst', {ordconstn} + 'typeconv', {typeconvn} + 'calln', {calln} + 'noth-callpar',{callparan} + 'realconst', {realconstn} + 'unaryminus', {unaryminusn} + 'unaryplus', {unaryplusn} + 'asm', {asmn} + 'vecn', {vecn} + 'pointerconst',{pointerconstn} + 'stringconst', {stringconstn} + 'not', {notn} + 'inline', {inlinen} + 'niln', {niln} + 'error', {errorn} + 'nothing-typen', {typen} + 'setelement', {setelementn} + 'setconst', {setconstn} + 'blockn', {blockn} + 'statement', {statementn} + 'ifn', {ifn} + 'breakn', {breakn} + 'continuen', {continuen} + 'while_repeat', {whilerepeatn} + 'for', {forn} + 'exitn', {exitn} + 'with', {withn} + 'case', {casen} + 'label', {labeln} + 'goto', {goton} + 'tryexcept', {tryexceptn} + 'raise', {raisen} + 'tryfinally', {tryfinallyn} + 'on', {onn} + 'is', {isn} + 'as', {asn} + 'add-starstar', {starstarn} + 'arrayconstruc', {arrayconstructn} + 'noth-arrcnstr', {arrayconstructrangen} + 'tempcreaten', + 'temprefn', + 'tempdeleten', + 'addoptn', + 'nothing-nothg', {nothingn} + 'loadvmt', {loadvmtn} + 'guidconstn', + 'rttin', + 'loadparentfpn', + 'dataconstn', + 'objselectorn', + 'objcprotocoln' + ); + var + p: pchar; + begin + if entry then + begin + secondprefix:=secondprefix+' '; + p := strpnew(secondprefix+'second '+secondnames[ht]+' (entry)') + end + else + begin + p := strpnew(secondprefix+'second '+secondnames[ht]+' (exit)'); + delete(secondprefix,length(secondprefix),1); + end; + current_asmdata.CurrAsmList.concat(tai_comment.create(p)); + end; +{$endif EXTDEBUG} + + procedure secondpass(var p : tnode); + var + oldcodegenerror : boolean; + oldlocalswitches : tlocalswitches; + oldpos : tfileposinfo; + begin + if not assigned(p) then + internalerror(200208221); + if not(nf_error in p.flags) then + begin + oldcodegenerror:=codegenerror; + oldlocalswitches:=current_settings.localswitches; + oldpos:=current_filepos; + current_filepos:=p.fileinfo; + current_settings.localswitches:=p.localswitches; + codegenerror:=false; +{$ifdef EXTDEBUG} + if (p.expectloc=LOC_INVALID) then + Comment(V_Warning,'ExpectLoc is not set before secondpass: '+nodetype2str[p.nodetype]); + if (p.location.loc<>LOC_INVALID) then + Comment(V_Warning,'Location.Loc is already set before secondpass: '+nodetype2str[p.nodetype]); + if (cs_asm_nodes in current_settings.globalswitches) then + logsecond(p.nodetype,true); +{$endif EXTDEBUG} + p.pass_generate_code; +{$ifdef EXTDEBUG} + if (cs_asm_nodes in current_settings.globalswitches) then + logsecond(p.nodetype,false); + if (not codegenerror) then + begin + if (p.location.loc<>p.expectloc) then + Comment(V_Warning,'Location ('+tcgloc2str[p.location.loc]+') not equal to expectloc ('+tcgloc2str[p.expectloc]+'): '+nodetype2str[p.nodetype]); + if (p.location.loc=LOC_INVALID) then + Comment(V_Warning,'Location not set in secondpass: '+nodetype2str[p.nodetype]); + end; +{$endif EXTDEBUG} + if codegenerror then + include(p.flags,nf_error); + codegenerror:=codegenerror or oldcodegenerror; + current_settings.localswitches:=oldlocalswitches; + current_filepos:=oldpos; + end + else + codegenerror:=true; + end; + + + function do_secondpass(var p : tnode) : boolean; + begin + { current_asmdata.CurrAsmList must be empty } + if not current_asmdata.CurrAsmList.empty then + internalerror(200405201); + + { clear errors before starting } + codegenerror:=false; + if not(nf_error in p.flags) then + secondpass(p); + do_secondpass:=codegenerror; + end; + + +end. diff --git a/closures/compiler/pbase.pas b/closures/compiler/pbase.pas new file mode 100644 index 0000000000..6478711aa6 --- /dev/null +++ b/closures/compiler/pbase.pas @@ -0,0 +1,379 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Contains some helper routines for the parser + + 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 pbase; + +{$i fpcdefs.inc} + +interface + + uses + cutils,cclasses, + tokens,globtype, + symconst,symbase,symtype,symdef,symsym,symtable + ; + + const + { tokens that end a block or statement. And don't require + a ; on the statement before } + endtokens = [_SEMICOLON,_END,_ELSE,_UNTIL,_EXCEPT,_FINALLY]; + + { true, if we are after an assignement } + afterassignment : boolean = false; + + { true, if we are parsing arguments } + in_args : boolean = false; + + { true, if we are parsing arguments allowing named parameters } + named_args_allowed : boolean = false; + + { true, if we got an @ to get the address } + got_addrn : boolean = false; + + { special for handling procedure vars } + getprocvardef : tprocvardef = nil; + + var + { for operators } + optoken : ttoken; + + { true, if only routine headers should be parsed } + parse_only : boolean; + + { true, if we found a name for a named arg } + found_arg_name : boolean; + + { true, if we are parsing generic declaration } + parse_generic : boolean; + + procedure identifier_not_found(const s:string); + +{ function tokenstring(i : ttoken):string;} + + { consumes token i, if the current token is unequal i } + { a syntax error is written } + procedure consume(i : ttoken); + + {Tries to consume the token i, and returns true if it was consumed: + if token=i.} + function try_to_consume(i:Ttoken):boolean; + + { consumes all tokens til atoken (for error recovering } + procedure consume_all_until(atoken : ttoken); + + { consumes tokens while they are semicolons } + procedure consume_emptystats; + + { reads a list of identifiers into a string list } + { consume a symbol, if not found give an error and + and return an errorsym } + function consume_sym(var srsym:tsym;var srsymtable:TSymtable):boolean; + function consume_sym_orgid(var srsym:tsym;var srsymtable:TSymtable;var s : string):boolean; + + function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;consume_id:boolean):boolean; + + function try_consume_hintdirective(var symopt:tsymoptions; var deprecatedmsg:pshortstring):boolean; + + { just for an accurate position of the end of a procedure (PM) } + var + last_endtoken_filepos: tfileposinfo; + + +implementation + + uses + globals,htypechk,scanner,systems,verbose,fmodule; + +{**************************************************************************** + Token Parsing +****************************************************************************} + + procedure identifier_not_found(const s:string); + begin + Message1(sym_e_id_not_found,s); + { show a fatal that you need -S2 or -Sd, but only + if we just parsed the a token that has m_class } + if not(m_class in current_settings.modeswitches) and + (Upper(s)=pattern) and + (tokeninfo^[idtoken].keyword=m_class) then + Message(parser_f_need_objfpc_or_delphi_mode); + end; + + + { consumes token i, write error if token is different } + procedure consume(i : ttoken); + begin + if (token<>i) and (idtoken<>i) then + if token=_id then + Message2(scan_f_syn_expected,tokeninfo^[i].str,'identifier '+pattern) + else + Message2(scan_f_syn_expected,tokeninfo^[i].str,tokeninfo^[token].str) + else + begin + if token=_END then + last_endtoken_filepos:=current_tokenpos; + current_scanner.readtoken(true); + end; + end; + + + function try_to_consume(i:Ttoken):boolean; + begin + try_to_consume:=false; + if (token=i) or (idtoken=i) then + begin + try_to_consume:=true; + if token=_END then + last_endtoken_filepos:=current_tokenpos; + current_scanner.readtoken(true); + end; + end; + + + procedure consume_all_until(atoken : ttoken); + begin + while (token<>atoken) and (idtoken<>atoken) do + begin + Consume(token); + if token=_EOF then + begin + Consume(atoken); + Message(scan_f_end_of_file); + exit; + end; + end; + end; + + + procedure consume_emptystats; + begin + repeat + until not try_to_consume(_SEMICOLON); + end; + + + { check if a symbol contains the hint directive, and if so gives out a hint + if required. + + If this code is changed, it's likly that consume_sym_orgid and factor_read_id + must be changed as well (FK) + } + function consume_sym(var srsym:tsym;var srsymtable:TSymtable):boolean; + var + t : ttoken; + begin + { first check for identifier } + if token<>_ID then + begin + consume(_ID); + srsym:=generrorsym; + srsymtable:=nil; + result:=false; + exit; + end; + searchsym(pattern,srsym,srsymtable); + { handle unit specification like System.Writeln } + try_consume_unitsym(srsym,srsymtable,t,true); + { if nothing found give error and return errorsym } + if assigned(srsym) then + check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg) + else + begin + identifier_not_found(orgpattern); + srsym:=generrorsym; + srsymtable:=nil; + end; + consume(t); + result:=assigned(srsym); + end; + + + { check if a symbol contains the hint directive, and if so gives out a hint + if required and returns the id with it's original casing + } + function consume_sym_orgid(var srsym:tsym;var srsymtable:TSymtable;var s : string):boolean; + var + t : ttoken; + begin + { first check for identifier } + if token<>_ID then + begin + consume(_ID); + srsym:=generrorsym; + srsymtable:=nil; + result:=false; + exit; + end; + searchsym(pattern,srsym,srsymtable); + { handle unit specification like System.Writeln } + try_consume_unitsym(srsym,srsymtable,t,true); + { if nothing found give error and return errorsym } + if assigned(srsym) then + check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg) + else + begin + identifier_not_found(orgpattern); + srsym:=generrorsym; + srsymtable:=nil; + end; + s:=orgpattern; + consume(t); + result:=assigned(srsym); + end; + + + function try_consume_unitsym(var srsym:tsym;var srsymtable:TSymtable;var tokentoconsume:ttoken;consume_id:boolean):boolean; + var + hmodule: tmodule; + ns:ansistring; + nssym:tsym; + begin + result:=false; + tokentoconsume:=_ID; + + if assigned(srsym) and (srsym.typ in [unitsym,namespacesym]) then + begin + if not(srsym.owner.symtabletype in [staticsymtable,globalsymtable]) then + internalerror(200501154); + { only allow unit.symbol access if the name was + found in the current module + we can use iscurrentunit because generic specializations does not + change current_unit variable } + hmodule:=find_module_from_symtable(srsym.Owner); + if not Assigned(hmodule) then + internalerror(201001120); + if hmodule.unit_index=current_filepos.moduleindex then + begin + if consume_id then + consume(_ID); + consume(_POINT); + if srsym.typ=namespacesym then + begin + ns:=srsym.name; + nssym:=srsym; + while assigned(srsym) and (srsym.typ=namespacesym) do + begin + { we have a namespace. the next identifier should be either a namespace or a unit } + searchsym_in_module(hmodule,ns+'.'+pattern,srsym,srsymtable); + if assigned(srsym) and (srsym.typ in [namespacesym,unitsym]) then + begin + ns:=ns+'.'+pattern; + nssym:=srsym; + consume(_ID); + consume(_POINT); + end; + end; + { check if there is a hidden unit with this pattern in the namespace } + if not assigned(srsym) and + assigned(nssym) and (nssym.typ=namespacesym) and assigned(tnamespacesym(nssym).unitsym) then + srsym:=tnamespacesym(nssym).unitsym; + if assigned(srsym) and (srsym.typ<>unitsym) then + internalerror(201108260); + if not assigned(srsym) then + begin + result:=true; + srsymtable:=nil; + exit; + end; + end; + case token of + _ID: + searchsym_in_module(tunitsym(srsym).module,pattern,srsym,srsymtable); + _STRING: + begin + { system.string? } + if tmodule(tunitsym(srsym).module).globalsymtable=systemunit then + begin + if cs_ansistrings in current_settings.localswitches then + searchsym_in_module(tunitsym(srsym).module,'ANSISTRING',srsym,srsymtable) + else + searchsym_in_module(tunitsym(srsym).module,'SHORTSTRING',srsym,srsymtable); + tokentoconsume:=_STRING; + end; + end + end; + end + else + begin + srsym:=nil; + srsymtable:=nil; + end; + result:=true; + end; + end; + + + function try_consume_hintdirective(var symopt:tsymoptions; var deprecatedmsg:pshortstring):boolean; + var + last_is_deprecated:boolean; + begin + try_consume_hintdirective:=false; + if not(m_hintdirective in current_settings.modeswitches) then + exit; + repeat + last_is_deprecated:=false; + case idtoken of + _LIBRARY : + begin + include(symopt,sp_hint_library); + try_consume_hintdirective:=true; + end; + _DEPRECATED : + begin + include(symopt,sp_hint_deprecated); + try_consume_hintdirective:=true; + last_is_deprecated:=true; + end; + _EXPERIMENTAL : + begin + include(symopt,sp_hint_experimental); + try_consume_hintdirective:=true; + end; + _PLATFORM : + begin + include(symopt,sp_hint_platform); + try_consume_hintdirective:=true; + end; + _UNIMPLEMENTED : + begin + include(symopt,sp_hint_unimplemented); + try_consume_hintdirective:=true; + end; + else + break; + end; + consume(Token); + { handle deprecated message } + if ((token=_CSTRING) or (token=_CCHAR)) and last_is_deprecated then + begin + if deprecatedmsg<>nil then + internalerror(200910181); + if token=_CSTRING then + deprecatedmsg:=stringdup(cstringpattern) + else + deprecatedmsg:=stringdup(pattern); + consume(token); + include(symopt,sp_has_deprecated_msg); + end; + until false; + end; + +end. diff --git a/closures/compiler/pdecl.pas b/closures/compiler/pdecl.pas new file mode 100644 index 0000000000..267f978e0a --- /dev/null +++ b/closures/compiler/pdecl.pas @@ -0,0 +1,874 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Does declaration (but not type) parsing for Free Pascal + + 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 pdecl; + +{$i fpcdefs.inc} + +interface + + uses + { common } + cclasses, + { global } + globtype, + { symtable } + symsym,symdef, + { pass_1 } + node; + + function readconstant(const orgname:string;const filepos:tfileposinfo):tconstsym; + + procedure const_dec; + procedure consts_dec(in_structure: boolean); + procedure label_dec; + procedure type_dec; + procedure types_dec(in_structure: boolean); + procedure var_dec; + procedure threadvar_dec; + procedure property_dec(is_classpropery: boolean); + procedure resourcestring_dec; + +implementation + + uses + SysUtils, + { common } + cutils, + { global } + globals,tokens,verbose,widestr,constexp, + systems, + { aasm } + aasmbase,aasmtai,aasmdata,fmodule, + { symtable } + symconst,symbase,symtype,symtable,paramgr,defutil, + { pass 1 } + nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nobj, + { codegen } + ncgutil, + { parser } + scanner, + pbase,pexpr,ptype,ptconst,pdecsub,pdecvar,pdecobj,pgenutil, + { cpu-information } + cpuinfo + ; + + + function readconstant(const orgname:string;const filepos:tfileposinfo):tconstsym; + var + hp : tconstsym; + p : tnode; + ps : pconstset; + pd : pbestreal; + pg : pguid; + sp : pchar; + pw : pcompilerwidestring; + storetokenpos : tfileposinfo; + begin + readconstant:=nil; + if orgname='' then + internalerror(9584582); + hp:=nil; + p:=comp_expr(true,false); + storetokenpos:=current_tokenpos; + current_tokenpos:=filepos; + case p.nodetype of + ordconstn: + begin + if p.resultdef.typ=pointerdef then + hp:=tconstsym.create_ordptr(orgname,constpointer,tordconstnode(p).value.uvalue,p.resultdef) + else + hp:=tconstsym.create_ord(orgname,constord,tordconstnode(p).value,p.resultdef); + end; + stringconstn: + begin + if is_wide_or_unicode_string(p.resultdef) then + begin + initwidestring(pw); + copywidestring(pcompilerwidestring(tstringconstnode(p).value_str),pw); + hp:=tconstsym.create_wstring(orgname,constwstring,pw); + end + else + begin + getmem(sp,tstringconstnode(p).len+1); + move(tstringconstnode(p).value_str^,sp^,tstringconstnode(p).len+1); + hp:=tconstsym.create_string(orgname,conststring,sp,tstringconstnode(p).len); + end; + end; + realconstn : + begin + new(pd); + pd^:=trealconstnode(p).value_real; + hp:=tconstsym.create_ptr(orgname,constreal,pd,p.resultdef); + end; + setconstn : + begin + new(ps); + ps^:=tsetconstnode(p).value_set^; + hp:=tconstsym.create_ptr(orgname,constset,ps,p.resultdef); + end; + pointerconstn : + begin + hp:=tconstsym.create_ordptr(orgname,constpointer,tpointerconstnode(p).value,p.resultdef); + end; + niln : + begin + hp:=tconstsym.create_ord(orgname,constnil,0,p.resultdef); + end; + typen : + begin + if is_interface(p.resultdef) then + begin + if assigned(tobjectdef(p.resultdef).iidguid) then + begin + new(pg); + pg^:=tobjectdef(p.resultdef).iidguid^; + hp:=tconstsym.create_ptr(orgname,constguid,pg,p.resultdef); + end + else + Message1(parser_e_interface_has_no_guid,tobjectdef(p.resultdef).objrealname^); + end + else + Message(parser_e_illegal_expression); + end; + else + Message(parser_e_illegal_expression); + end; + current_tokenpos:=storetokenpos; + p.free; + readconstant:=hp; + end; + + procedure const_dec; + begin + consume(_CONST); + consts_dec(false); + end; + + procedure consts_dec(in_structure: boolean); + var + orgname : TIDString; + hdef : tdef; + sym, tmp : tsym; + dummysymoptions : tsymoptions; + deprecatedmsg : pshortstring; + storetokenpos,filepos : tfileposinfo; + old_block_type : tblock_type; + skipequal : boolean; + tclist : tasmlist; + varspez : tvarspez; + static_name : string; + sl : tpropaccesslist; + begin + old_block_type:=block_type; + block_type:=bt_const; + repeat + orgname:=orgpattern; + filepos:=current_tokenpos; + consume(_ID); + case token of + + _EQ: + begin + consume(_EQ); + sym:=readconstant(orgname,filepos); + { Support hint directives } + dummysymoptions:=[]; + deprecatedmsg:=nil; + try_consume_hintdirective(dummysymoptions,deprecatedmsg); + if assigned(sym) then + begin + sym.symoptions:=sym.symoptions+dummysymoptions; + sym.deprecatedmsg:=deprecatedmsg; + sym.visibility:=symtablestack.top.currentvisibility; + symtablestack.top.insert(sym); + end + else + stringdispose(deprecatedmsg); + consume(_SEMICOLON); + end; + + _COLON: + begin + { set the blocktype first so a consume also supports a + caret, to support const s : ^string = nil } + block_type:=bt_const_type; + consume(_COLON); + read_anon_type(hdef,false); + block_type:=bt_const; + skipequal:=false; + { create symbol } + storetokenpos:=current_tokenpos; + current_tokenpos:=filepos; + if not (cs_typed_const_writable in current_settings.localswitches) then + varspez:=vs_const + else + varspez:=vs_value; + { if we are dealing with structure const then we need to handle it as a + structure static variable: create a symbol in unit symtable and a reference + to it from the structure or linking will fail } + if symtablestack.top.symtabletype in [recordsymtable,ObjectSymtable] then + begin + { generate the symbol which reserves the space } + static_name:=lower(generate_nested_name(symtablestack.top,'_'))+'_'+orgname; + sym:=tstaticvarsym.create('$_static_'+static_name,varspez,hdef,[]); + include(sym.symoptions,sp_internal); + tabstractrecordsymtable(symtablestack.top).get_unit_symtable.insert(sym); + { generate the symbol for the access } + sl:=tpropaccesslist.create; + sl.addsym(sl_load,sym); + tmp:=tabsolutevarsym.create_ref(orgname,hdef,sl); + tmp.visibility:=symtablestack.top.currentvisibility; + symtablestack.top.insert(tmp); + end + else + begin + sym:=tstaticvarsym.create(orgname,varspez,hdef,[]); + sym.visibility:=symtablestack.top.currentvisibility; + symtablestack.top.insert(sym); + end; + current_tokenpos:=storetokenpos; + { procvar can have proc directives, but not type references } + if (hdef.typ=procvardef) and + (hdef.typesym=nil) then + begin + { support p : procedure;stdcall=nil; } + if try_to_consume(_SEMICOLON) then + begin + if check_proc_directive(true) then + parse_var_proc_directives(sym) + else + begin + Message(parser_e_proc_directive_expected); + skipequal:=true; + end; + end + else + { support p : procedure stdcall=nil; } + begin + if check_proc_directive(true) then + parse_var_proc_directives(sym); + end; + { add default calling convention } + handle_calling_convention(tabstractprocdef(hdef)); + end; + if not skipequal then + begin + { get init value } + consume(_EQ); + if (cs_typed_const_writable in current_settings.localswitches) then + tclist:=current_asmdata.asmlists[al_typedconsts] + else + tclist:=current_asmdata.asmlists[al_rotypedconsts]; + read_typed_const(tclist,tstaticvarsym(sym),in_structure); + end; + end; + + else + { generate an error } + consume(_EQ); + end; + until (token<>_ID)or(in_structure and (idtoken in [_PRIVATE,_PROTECTED,_PUBLIC,_PUBLISHED,_STRICT])); + block_type:=old_block_type; + end; + + + procedure label_dec; + var + labelsym : tlabelsym; + begin + consume(_LABEL); + if not(cs_support_goto in current_settings.moduleswitches) then + Message(sym_e_goto_and_label_not_supported); + repeat + if not(token in [_ID,_INTCONST]) then + consume(_ID) + else + begin + if token=_ID then + labelsym:=tlabelsym.create(orgpattern) + else + labelsym:=tlabelsym.create(pattern); + symtablestack.top.insert(labelsym); + if m_non_local_goto in current_settings.modeswitches then + begin + if symtablestack.top.symtabletype=localsymtable then + begin + labelsym.jumpbuf:=tlocalvarsym.create('LABEL$_'+labelsym.name,vs_value,rec_jmp_buf,[]); + symtablestack.top.insert(labelsym.jumpbuf); + end + else + begin + labelsym.jumpbuf:=tstaticvarsym.create('LABEL$_'+labelsym.name,vs_value,rec_jmp_buf,[]); + symtablestack.top.insert(labelsym.jumpbuf); + insertbssdata(tstaticvarsym(labelsym.jumpbuf)); + end; + include(labelsym.jumpbuf.symoptions,sp_internal); + { the buffer will be setup later, but avoid a hint } + tabstractvarsym(labelsym.jumpbuf).varstate:=vs_written; + end; + consume(token); + end; + if token<>_SEMICOLON then consume(_COMMA); + until not(token in [_ID,_INTCONST]); + consume(_SEMICOLON); + end; + + procedure types_dec(in_structure: boolean); + + procedure finalize_objc_class_or_protocol_external_status(od: tobjectdef); + begin + if [oo_is_external,oo_is_forward] <= od.objectoptions then + begin + { formal definition: x = objcclass external; } + exclude(od.objectoptions,oo_is_forward); + include(od.objectoptions,oo_is_formal); + end; + end; + + var + typename,orgtypename, + gentypename,genorgtypename : TIDString; + newtype : ttypesym; + sym : tsym; + hdef : tdef; + defpos,storetokenpos : tfileposinfo; + old_block_type : tblock_type; + old_checkforwarddefs: TFPObjectList; + objecttype : tobjecttyp; + isgeneric, + isunique, + istyperenaming : boolean; + generictypelist : TFPObjectList; + generictokenbuf : tdynamicarray; + vmtbuilder : TVMTBuilder; + p:tnode; + gendef : tstoreddef; + s : shortstring; + pd: tprocdef; + hashedid : thashedidstring; + begin + old_block_type:=block_type; + { save unit container of forward declarations - + we can be inside nested class type block } + old_checkforwarddefs:=current_module.checkforwarddefs; + current_module.checkforwarddefs:=TFPObjectList.Create(false); + block_type:=bt_type; + repeat + defpos:=current_tokenpos; + istyperenaming:=false; + generictypelist:=nil; + generictokenbuf:=nil; + + { fpc generic declaration? } + isgeneric:=not(m_delphi in current_settings.modeswitches) and try_to_consume(_GENERIC); + + typename:=pattern; + orgtypename:=orgpattern; + consume(_ID); + + { delphi generic declaration? } + if (m_delphi in current_settings.modeswitches) then + isgeneric:=token=_LSHARPBRACKET; + + { Generic type declaration? } + if isgeneric then + begin + if assigned(current_genericdef) then + Message(parser_f_no_generic_inside_generic); + + consume(_LSHARPBRACKET); + generictypelist:=parse_generic_parameters; + consume(_RSHARPBRACKET); + + str(generictypelist.Count,s); + gentypename:=typename+'$'+s; + genorgtypename:=orgtypename+'$'+s; + end + else + begin + gentypename:=typename; + genorgtypename:=orgtypename; + end; + + + consume(_EQ); + + { support 'ttype=type word' syntax } + isunique:=try_to_consume(_TYPE); + + { MacPas object model is more like Delphi's than like TP's, but } + { uses the object keyword instead of class } + if (m_mac in current_settings.modeswitches) and + (token = _OBJECT) then + token := _CLASS; + + { Start recording a generic template } + if assigned(generictypelist) then + begin + generictokenbuf:=tdynamicarray.create(256); + current_scanner.startrecordtokens(generictokenbuf); + end; + + { is the type already defined? -- must be in the current symtable, + not in a nested symtable or one higher up the stack -> don't + use searchsym & frinds! } + sym:=tsym(symtablestack.top.find(gentypename)); + newtype:=nil; + { found a symbol with this name? } + if assigned(sym) then + begin + if (sym.typ=typesym) and + { this should not be a symbol that was created by a generic + that was declared earlier } + not ( + (ttypesym(sym).typedef.typ=undefineddef) and + (sp_generic_dummy in sym.symoptions) + ) then + begin + if ((token=_CLASS) or + (token=_INTERFACE) or + (token=_DISPINTERFACE) or + (token=_OBJCCLASS) or + (token=_OBJCPROTOCOL) or + (token=_OBJCCATEGORY)) and + (assigned(ttypesym(sym).typedef)) and + is_implicit_pointer_object_type(ttypesym(sym).typedef) and + (oo_is_forward in tobjectdef(ttypesym(sym).typedef).objectoptions) then + begin + case token of + _CLASS : + objecttype:=odt_class; + _INTERFACE : + if current_settings.interfacetype=it_interfacecom then + objecttype:=odt_interfacecom + else + objecttype:=odt_interfacecorba; + _DISPINTERFACE : + objecttype:=odt_dispinterface; + _OBJCCLASS, + _OBJCCATEGORY : + objecttype:=odt_objcclass; + _OBJCPROTOCOL : + objecttype:=odt_objcprotocol; + else + internalerror(200811072); + end; + consume(token); + { we can ignore the result, the definition is modified } + object_dec(objecttype,genorgtypename,nil,nil,tobjectdef(ttypesym(sym).typedef),ht_none); + newtype:=ttypesym(sym); + hdef:=newtype.typedef; + end + else + message1(parser_h_type_redef,genorgtypename); + end; + end; + { no old type reused ? Then insert this new type } + if not assigned(newtype) then + begin + { insert the new type first with an errordef, so that + referencing the type before it's really set it + will give an error (PFV) } + hdef:=generrordef; + gendef:=nil; + storetokenpos:=current_tokenpos; + if isgeneric then + begin + { for generics we need to check whether a non-generic type + already exists and if not we need to insert a symbol with + the non-generic name (available in (org)typename) that is a + undefineddef, so that inline specializations can be used } + sym:=tsym(symtablestack.top.Find(typename)); + if not assigned(sym) then + begin + sym:=ttypesym.create(orgtypename,tundefineddef.create); + Include(sym.symoptions,sp_generic_dummy); + ttypesym(sym).typedef.typesym:=sym; + sym.visibility:=symtablestack.top.currentvisibility; + symtablestack.top.insert(sym); + ttypesym(sym).typedef.owner:=sym.owner; + end + else + { this is not allowed in non-Delphi modes } + if not (m_delphi in current_settings.modeswitches) then + Message1(sym_e_duplicate_id,genorgtypename) + else + { we need to find this symbol even if it's a variable or + something else when doing an inline specialization } + Include(sym.symoptions,sp_generic_dummy); + end + else + begin + if assigned(sym) and (sym.typ=typesym) and + (ttypesym(sym).typedef.typ=undefineddef) and + (sp_generic_dummy in sym.symoptions) then + begin + { this is a symbol that was added by an earlier generic + declaration, reuse it } + newtype:=ttypesym(sym); + newtype.typedef:=hdef; + sym:=nil; + end; + + { check whether this is a declaration of a type inside a + specialization } + if assigned(current_structdef) and + (df_specialization in current_structdef.defoptions) then + begin + if not assigned(current_structdef.genericdef) or + not (current_structdef.genericdef.typ in [recorddef,objectdef]) then + internalerror(2011052301); + hashedid.id:=gentypename; + { we could be inside a method of the specialization + instead of its declaration, so check that first (as + local nested types aren't allowed we don't need to + walk the symtablestack to find the localsymtable) } + if symtablestack.top.symtabletype=localsymtable then + begin + { we are in a method } + if not assigned(symtablestack.top.defowner) or + (symtablestack.top.defowner.typ<>procdef) then + internalerror(2011120701); + pd:=tprocdef(symtablestack.top.defowner); + if not assigned(pd.genericdef) or (pd.genericdef.typ<>procdef) then + internalerror(2011120702); + sym:=tsym(tprocdef(pd.genericdef).localst.findwithhash(hashedid)); + end + else + sym:=nil; + if not assigned(sym) or not (sym.typ=typesym) then + begin + { now search in the declaration of the generic } + sym:=tsym(tabstractrecorddef(current_structdef.genericdef).symtable.findwithhash(hashedid)); + if not assigned(sym) or not (sym.typ=typesym) then + internalerror(2011052302); + end; + { use the corresponding type in the generic's symtable as + genericdef for the specialized type } + gendef:=tstoreddef(ttypesym(sym).typedef); + end; + end; + { insert a new type if we don't reuse an existing symbol } + if not assigned(newtype) then + begin + newtype:=ttypesym.create(genorgtypename,hdef); + newtype.visibility:=symtablestack.top.currentvisibility; + symtablestack.top.insert(newtype); + end; + current_tokenpos:=defpos; + current_tokenpos:=storetokenpos; + { read the type definition } + read_named_type(hdef,genorgtypename,gendef,generictypelist,false); + { update the definition of the type } + if assigned(hdef) then + begin + if assigned(hdef.typesym) then + istyperenaming:=true; + if isunique then + begin + if is_objc_class_or_protocol(hdef) then + Message(parser_e_no_objc_unique); + + hdef:=tstoreddef(hdef).getcopy; + + { check if it is an ansistirng(codepage) declaration } + if is_ansistring(hdef) and try_to_consume(_LKLAMMER) then + begin + p:=comp_expr(true,false); + consume(_RKLAMMER); + if not is_constintnode(p) then + begin + Message(parser_e_illegal_expression); + { error recovery } + end + else + begin + if (tordconstnode(p).value<0) or (tordconstnode(p).value>65535) then + begin + Message(parser_e_invalid_codepage); + tordconstnode(p).value:=0; + end; + tstringdef(hdef).encoding:=int64(tordconstnode(p).value); + end; + p.free; + end; + + { fix name, it is used e.g. for tables } + if is_class_or_interface_or_dispinterface(hdef) then + with tobjectdef(hdef) do + begin + stringdispose(objname); + stringdispose(objrealname); + objrealname:=stringdup(genorgtypename); + objname:=stringdup(upper(genorgtypename)); + end; + + include(hdef.defoptions,df_unique); + if (hdef.typ in [pointerdef,classrefdef]) and + (tabstractpointerdef(hdef).pointeddef.typ=forwarddef) then + current_module.checkforwarddefs.add(hdef); + end; + if not assigned(hdef.typesym) then + hdef.typesym:=newtype; + end; + { in non-Delphi modes we need a reference to the generic def + without the generic suffix, so it can be found easily when + parsing method implementations } + if isgeneric and assigned(sym) and + not (m_delphi in current_settings.modeswitches) and + (ttypesym(sym).typedef.typ=undefineddef) then + { don't free the undefineddef as the defids rely on the count + of the defs in the def list of the module} + ttypesym(sym).typedef:=hdef; + newtype.typedef:=hdef; + { KAZ: handle TGUID declaration in system unit } + if (cs_compilesystem in current_settings.moduleswitches) and not assigned(rec_tguid) and + (gentypename='TGUID') and { name: TGUID and size=16 bytes that is 128 bits } + assigned(hdef) and (hdef.typ=recorddef) and (hdef.size=16) then + rec_tguid:=trecorddef(hdef); + end; + if assigned(hdef) then + begin + case hdef.typ of + pointerdef : + begin + try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg); + consume(_SEMICOLON); + if try_to_consume(_FAR) then + begin + tpointerdef(hdef).is_far:=true; + consume(_SEMICOLON); + end; + end; + procvardef : + begin + { in case of type renaming, don't parse proc directives } + if istyperenaming then + begin + try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg); + consume(_SEMICOLON); + end + else + begin + if not check_proc_directive(true) then + begin + try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg); + consume(_SEMICOLON); + end; + parse_var_proc_directives(tsym(newtype)); + handle_calling_convention(tprocvardef(hdef)); + if try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg) then + consume(_SEMICOLON); + end; + end; + objectdef : + begin + try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg); + consume(_SEMICOLON); + + { change a forward and external objcclass declaration into + formal external definition, so the compiler does not + expect an real definition later } + if is_objc_class_or_protocol(hdef) then + finalize_objc_class_or_protocol_external_status(tobjectdef(hdef)); + + { Build VMT indexes, skip for type renaming and forward classes } + if (hdef.typesym=newtype) and + not(oo_is_forward in tobjectdef(hdef).objectoptions) and + not(df_generic in hdef.defoptions) then + begin + vmtbuilder:=TVMTBuilder.Create(tobjectdef(hdef)); + vmtbuilder.generate_vmt; + vmtbuilder.free; + end; + + { In case of an objcclass, verify that all methods have a message + name set. We only check this now, because message names can be set + during the protocol (interface) mapping. At the same time, set the + mangled names (these depend on the "external" name of the class), + and mark private fields of external classes as "used" (to avoid + bogus notes about them being unused) + } + { watch out for crashes in case of errors } + if is_objc_class_or_protocol(hdef) and + (not is_objccategory(hdef) or + assigned(tobjectdef(hdef).childof)) then + tobjectdef(hdef).finish_objc_data; + + if is_cppclass(hdef) then + tobjectdef(hdef).finish_cpp_data; + end; + recorddef : + begin + try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg); + consume(_SEMICOLON); + end; + else + begin + try_consume_hintdirective(newtype.symoptions,newtype.deprecatedmsg); + consume(_SEMICOLON); + end; + end; + end; + + if isgeneric and (not(hdef.typ in [objectdef,recorddef,arraydef,procvardef]) + or is_objectpascal_helper(hdef)) then + message(parser_e_cant_create_generics_of_this_type); + + { Stop recording a generic template } + if assigned(generictypelist) then + begin + current_scanner.stoprecordtokens; + tstoreddef(hdef).generictokenbuf:=generictokenbuf; + { Generic is never a type renaming } + hdef.typesym:=newtype; + generictypelist.free; + end; + until (token<>_ID)or(in_structure and (idtoken in [_PRIVATE,_PROTECTED,_PUBLIC,_PUBLISHED,_STRICT])); + { resolve type block forward declarations and restore a unit + container for them } + resolve_forward_types; + current_module.checkforwarddefs.free; + current_module.checkforwarddefs:=old_checkforwarddefs; + block_type:=old_block_type; + end; + + + { reads a type declaration to the symbol table } + procedure type_dec; + begin + consume(_TYPE); + types_dec(false); + end; + + + procedure var_dec; + { parses variable declarations and inserts them in } + { the top symbol table of symtablestack } + begin + consume(_VAR); + read_var_decls([]); + end; + + + procedure property_dec(is_classpropery: boolean); + var + old_block_type : tblock_type; + begin + consume(_PROPERTY); + if not(symtablestack.top.symtabletype in [staticsymtable,globalsymtable]) then + message(parser_e_resourcestring_only_sg); + old_block_type:=block_type; + block_type:=bt_const; + repeat + read_property_dec(is_classpropery, nil); + consume(_SEMICOLON); + until token<>_ID; + block_type:=old_block_type; + end; + + + procedure threadvar_dec; + { parses thread variable declarations and inserts them in } + { the top symbol table of symtablestack } + begin + consume(_THREADVAR); + if not(symtablestack.top.symtabletype in [staticsymtable,globalsymtable]) then + message(parser_e_threadvars_only_sg); + read_var_decls([vd_threadvar]); + end; + + + procedure resourcestring_dec; + var + orgname : TIDString; + p : tnode; + dummysymoptions : tsymoptions; + deprecatedmsg : pshortstring; + storetokenpos,filepos : tfileposinfo; + old_block_type : tblock_type; + sp : pchar; + sym : tsym; + begin + consume(_RESOURCESTRING); + if not(symtablestack.top.symtabletype in [staticsymtable,globalsymtable]) then + message(parser_e_resourcestring_only_sg); + old_block_type:=block_type; + block_type:=bt_const; + repeat + orgname:=orgpattern; + filepos:=current_tokenpos; + consume(_ID); + case token of + _EQ: + begin + consume(_EQ); + p:=comp_expr(true,false); + storetokenpos:=current_tokenpos; + current_tokenpos:=filepos; + sym:=nil; + case p.nodetype of + ordconstn: + begin + if is_constcharnode(p) then + begin + getmem(sp,2); + sp[0]:=chr(tordconstnode(p).value.svalue); + sp[1]:=#0; + sym:=tconstsym.create_string(orgname,constresourcestring,sp,1); + end + else + Message(parser_e_illegal_expression); + end; + stringconstn: + with Tstringconstnode(p) do + begin + getmem(sp,len+1); + move(value_str^,sp^,len+1); + sym:=tconstsym.create_string(orgname,constresourcestring,sp,len); + end; + else + Message(parser_e_illegal_expression); + end; + current_tokenpos:=storetokenpos; + { Support hint directives } + dummysymoptions:=[]; + deprecatedmsg:=nil; + try_consume_hintdirective(dummysymoptions,deprecatedmsg); + if assigned(sym) then + begin + sym.symoptions:=sym.symoptions+dummysymoptions; + sym.deprecatedmsg:=deprecatedmsg; + symtablestack.top.insert(sym); + end + else + stringdispose(deprecatedmsg); + consume(_SEMICOLON); + p.free; + end; + else consume(_EQ); + end; + until token<>_ID; + block_type:=old_block_type; + end; + +end. diff --git a/closures/compiler/pdecobj.pas b/closures/compiler/pdecobj.pas new file mode 100644 index 0000000000..1c29df2437 --- /dev/null +++ b/closures/compiler/pdecobj.pas @@ -0,0 +1,1281 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Does object types for Free Pascal + + 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 pdecobj; + +{$i fpcdefs.inc} + +interface + + uses + cclasses, + globtype,symconst,symtype,symdef; + + { parses a object declaration } + function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef; + + function class_constructor_head:tprocdef; + function class_destructor_head:tprocdef; + function constructor_head:tprocdef; + function destructor_head:tprocdef; + procedure struct_property_dec(is_classproperty:boolean); + +implementation + + uses + sysutils,cutils, + globals,verbose,systems,tokens, + symbase,symsym,symtable, + node,nld,nmem,ncon,ncnv,ncal, + fmodule,scanner, + pbase,pexpr,pdecsub,pdecvar,ptype,pdecl,pgenutil,ppu + ; + + const + { Please leave this here, this module should NOT use + these variables. + Declaring it as string here results in an error when compiling (PFV) } + current_procinfo = 'error'; + + var + current_objectdef : tobjectdef absolute current_structdef; + + function class_constructor_head:tprocdef; + var + pd : tprocdef; + begin + result:=nil; + consume(_CONSTRUCTOR); + { must be at same level as in implementation } + parse_proc_head(current_structdef,potype_class_constructor,pd); + if not assigned(pd) then + begin + consume(_SEMICOLON); + exit; + end; + pd.calcparas; + if (pd.maxparacount>0) then + Message(parser_e_no_paras_for_class_constructor); + consume(_SEMICOLON); + include(current_structdef.objectoptions,oo_has_class_constructor); + current_module.flags:=current_module.flags or uf_classinits; + { no return value } + pd.returndef:=voidtype; + result:=pd; + end; + + function constructor_head:tprocdef; + var + pd : tprocdef; + begin + result:=nil; + consume(_CONSTRUCTOR); + { must be at same level as in implementation } + parse_proc_head(current_structdef,potype_constructor,pd); + if not assigned(pd) then + begin + consume(_SEMICOLON); + exit; + end; + if (cs_constructor_name in current_settings.globalswitches) and + (pd.procsym.name<>'INIT') then + Message(parser_e_constructorname_must_be_init); + consume(_SEMICOLON); + include(current_structdef.objectoptions,oo_has_constructor); + { Set return type, class and record constructors return the + created instance, object constructors return boolean } + if is_class(pd.struct) or is_record(pd.struct) then + pd.returndef:=pd.struct + else +{$ifdef CPU64bitaddr} + pd.returndef:=bool64type; +{$else CPU64bitaddr} + pd.returndef:=bool32type; +{$endif CPU64bitaddr} + result:=pd; + end; + + + procedure struct_property_dec(is_classproperty:boolean); + var + p : tpropertysym; + begin + { check for a class, record or helper } + if not((is_class_or_interface_or_dispinterface(current_structdef) or is_record(current_structdef) or is_objectpascal_helper(current_structdef)) or + (not(m_tp7 in current_settings.modeswitches) and (is_object(current_structdef)))) then + Message(parser_e_syntax_error); + consume(_PROPERTY); + p:=read_property_dec(is_classproperty,current_structdef); + consume(_SEMICOLON); + if try_to_consume(_DEFAULT) then + begin + if oo_has_default_property in current_structdef.objectoptions then + message(parser_e_only_one_default_property); + include(current_structdef.objectoptions,oo_has_default_property); + include(p.propoptions,ppo_defaultproperty); + if not(ppo_hasparameters in p.propoptions) then + message(parser_e_property_need_paras); + if (token=_COLON) then + begin + Message(parser_e_field_not_allowed_here); + consume_all_until(_SEMICOLON); + end; + consume(_SEMICOLON); + end; + { parse possible enumerator modifier } + if try_to_consume(_ENUMERATOR) then + begin + if (token = _ID) then + begin + if pattern='CURRENT' then + begin + if oo_has_enumerator_current in current_structdef.objectoptions then + message(parser_e_only_one_enumerator_current); + if not p.propaccesslist[palt_read].empty then + begin + include(current_structdef.objectoptions,oo_has_enumerator_current); + include(p.propoptions,ppo_enumerator_current); + end + else + Message(parser_e_enumerator_current_is_not_valid) // property has no reader + end + else + Message1(parser_e_invalid_enumerator_identifier, pattern); + consume(token); + end + else + Message(parser_e_enumerator_identifier_required); + consume(_SEMICOLON); + end; + { hint directives, these can be separated by semicolons here, + that needs to be handled here with a loop (PFV) } + while try_consume_hintdirective(p.symoptions,p.deprecatedmsg) do + Consume(_SEMICOLON); + end; + + + function class_destructor_head:tprocdef; + var + pd : tprocdef; + begin + result:=nil; + consume(_DESTRUCTOR); + parse_proc_head(current_structdef,potype_class_destructor,pd); + if not assigned(pd) then + begin + consume(_SEMICOLON); + exit; + end; + pd.calcparas; + if (pd.maxparacount>0) then + Message(parser_e_no_paras_for_class_destructor); + consume(_SEMICOLON); + include(current_structdef.objectoptions,oo_has_class_destructor); + current_module.flags:=current_module.flags or uf_classinits; + { no return value } + pd.returndef:=voidtype; + result:=pd; + end; + + function destructor_head:tprocdef; + var + pd : tprocdef; + begin + result:=nil; + consume(_DESTRUCTOR); + parse_proc_head(current_structdef,potype_destructor,pd); + if not assigned(pd) then + begin + consume(_SEMICOLON); + exit; + end; + if (cs_constructor_name in current_settings.globalswitches) and + (pd.procsym.name<>'DONE') then + Message(parser_e_destructorname_must_be_done); + pd.calcparas; + if not(pd.maxparacount=0) and + (m_fpc in current_settings.modeswitches) then + Message(parser_e_no_paras_for_destructor); + consume(_SEMICOLON); + include(current_structdef.objectoptions,oo_has_destructor); + { no return value } + pd.returndef:=voidtype; + result:=pd; + end; + + + procedure setinterfacemethodoptions; + var + i : longint; + def : tdef; + begin + include(current_structdef.objectoptions,oo_has_virtual); + for i:=0 to current_structdef.symtable.DefList.count-1 do + begin + def:=tdef(current_structdef.symtable.DefList[i]); + if assigned(def) and + (def.typ=procdef) then + begin + include(tprocdef(def).procoptions,po_virtualmethod); + tprocdef(def).forwarddef:=false; + end; + end; + end; + + + procedure setobjcclassmethodoptions; + var + i : longint; + def : tdef; + begin + for i:=0 to current_structdef.symtable.DefList.count-1 do + begin + def:=tdef(current_structdef.symtable.DefList[i]); + if assigned(def) and + (def.typ=procdef) then + begin + include(tprocdef(def).procoptions,po_virtualmethod); + end; + end; + end; + + + procedure handleImplementedInterface(intfdef : tobjectdef); + begin + if not is_interface(intfdef) then + begin + Message1(type_e_interface_type_expected,intfdef.typename); + exit; + end; + if current_objectdef.find_implemented_interface(intfdef)<>nil then + Message1(sym_e_duplicate_id,intfdef.objname^) + else + begin + { allocate and prepare the GUID only if the class + implements some interfaces. } + if current_objectdef.ImplementedInterfaces.count = 0 then + current_objectdef.prepareguid; + current_objectdef.ImplementedInterfaces.Add(TImplementedInterface.Create(intfdef)); + end; + end; + + + procedure handleImplementedProtocol(intfdef : tobjectdef); + begin + intfdef:=find_real_objcclass_definition(intfdef,false); + if not is_objcprotocol(intfdef) then + begin + Message1(type_e_protocol_type_expected,intfdef.typename); + exit; + end; + if ([oo_is_forward,oo_is_formal] * intfdef.objectoptions <> []) then + begin + Message1(parser_e_forward_protocol_declaration_must_be_resolved,intfdef.objrealname^); + exit; + end; + if current_objectdef.find_implemented_interface(intfdef)<>nil then + Message1(sym_e_duplicate_id,intfdef.objname^) + else + begin + current_objectdef.ImplementedInterfaces.Add(TImplementedInterface.Create(intfdef)); + end; + end; + + + procedure readImplementedInterfacesAndProtocols(intf: boolean); + var + hdef : tdef; + begin + while try_to_consume(_COMMA) do + begin + { use single_type instead of id_type for specialize support } + single_type(hdef,[stoAllowSpecialization,stoParseClassParent]); + if (hdef.typ<>objectdef) then + begin + if intf then + Message1(type_e_interface_type_expected,hdef.typename) + else + Message1(type_e_protocol_type_expected,hdef.typename); + continue; + end; + if intf then + handleImplementedInterface(tobjectdef(hdef)) + else + handleImplementedProtocol(tobjectdef(hdef)); + end; + end; + + + procedure readinterfaceiid; + var + p : tnode; + valid : boolean; + begin + p:=comp_expr(true,false); + if p.nodetype=stringconstn then + begin + stringdispose(current_objectdef.iidstr); + current_objectdef.iidstr:=stringdup(strpas(tstringconstnode(p).value_str)); + valid:=string2guid(current_objectdef.iidstr^,current_objectdef.iidguid^); + if (current_objectdef.objecttype in [odt_interfacecom,odt_dispinterface]) and + not valid then + Message(parser_e_improper_guid_syntax); + include(current_structdef.objectoptions,oo_has_valid_guid); + end + else + Message(parser_e_illegal_expression); + p.free; + end; + + procedure get_cpp_class_external_status(od: tobjectdef); + var + hs: string; + begin + { C++ classes can be external -> all methods inside are external + (defined at the class level instead of per method, so that you cannot + define some methods as external and some not) + } + if try_to_consume(_EXTERNAL) then + begin + if token in [_CSTRING,_CWSTRING,_CCHAR,_CWCHAR] then + begin + { Always add library prefix and suffix to create an uniform name } + hs:=get_stringconst; + if ExtractFileExt(hs)='' then + hs:=ChangeFileExt(hs,target_info.sharedlibext); + if Copy(hs,1,length(target_info.sharedlibprefix))<>target_info.sharedlibprefix then + hs:=target_info.sharedlibprefix+hs; + od.import_lib:=stringdup(hs); + end; + include(od.objectoptions, oo_is_external); + { check if we shall use another name for the class } + if try_to_consume(_NAME) then + od.objextname:=stringdup(get_stringconst) + else + od.objextname:=stringdup(od.objrealname^); + include(od.objectoptions,oo_is_external); + end + else + od.objextname:=stringdup(od.objrealname^); + { ToDo: read the namespace of the class (influences the mangled name)} + end; + + procedure get_objc_class_or_protocol_external_status(od: tobjectdef); + begin + { Objective-C classes can be external -> all messages inside are + external (defined at the class level instead of per method, so + that you cannot define some methods as external and some not) + } + if try_to_consume(_EXTERNAL) then + begin + if try_to_consume(_NAME) then + od.objextname:=stringdup(get_stringconst) + else + { the external name doesn't matter for formally declared + classes, and allowing to specify one would mean that we would + have to check it for consistency with the actual definition + later on } + od.objextname:=stringdup(od.objrealname^); + include(od.objectoptions,oo_is_external); + end + else + od.objextname:=stringdup(od.objrealname^); + end; + + + procedure parse_object_options; + begin + case current_objectdef.objecttype of + odt_object,odt_class: + begin + while true do + begin + if try_to_consume(_ABSTRACT) then + include(current_structdef.objectoptions,oo_is_abstract) + else + if try_to_consume(_SEALED) then + include(current_structdef.objectoptions,oo_is_sealed) + else + break; + end; + if [oo_is_abstract, oo_is_sealed] * current_structdef.objectoptions = [oo_is_abstract, oo_is_sealed] then + Message(parser_e_abstract_and_sealed_conflict); + end; + odt_cppclass: + get_cpp_class_external_status(current_objectdef); + odt_objcclass,odt_objcprotocol,odt_objccategory: + get_objc_class_or_protocol_external_status(current_objectdef); + odt_helper: ; // nothing + end; + end; + + procedure parse_parent_classes; + var + intfchildof, + childof : tobjectdef; + hdef : tdef; + hasparentdefined : boolean; + begin + childof:=nil; + intfchildof:=nil; + hasparentdefined:=false; + + { reads the parent class } + if (token=_LKLAMMER) or + is_objccategory(current_structdef) then + begin + consume(_LKLAMMER); + { use single_type instead of id_type for specialize support } + single_type(hdef,[stoAllowSpecialization, stoParseClassParent]); + if (not assigned(hdef)) or + (hdef.typ<>objectdef) then + begin + if assigned(hdef) then + Message1(type_e_class_type_expected,hdef.typename) + else if is_objccategory(current_structdef) then + { a category must specify the class to extend } + Message(type_e_objcclass_type_expected); + end + else + begin + childof:=tobjectdef(hdef); + { a mix of class, interfaces, objects and cppclasses + isn't allowed } + case current_objectdef.objecttype of + odt_class: + if not(is_class(childof)) then + begin + if is_interface(childof) then + begin + { we insert the interface after the child + is set, see below + } + intfchildof:=childof; + childof:=class_tobject; + end + else + Message(parser_e_mix_of_classes_and_objects); + end + else + if oo_is_sealed in childof.objectoptions then + Message1(parser_e_sealed_descendant,childof.typename); + odt_interfacecorba, + odt_interfacecom: + begin + if not(is_interface(childof)) then + Message(parser_e_mix_of_classes_and_objects); + current_objectdef.objecttype:=childof.objecttype; + end; + odt_cppclass: + if not(is_cppclass(childof)) then + Message(parser_e_mix_of_classes_and_objects); + odt_objcclass: + if not(is_objcclass(childof) or + is_objccategory(childof)) then + begin + if is_objcprotocol(childof) then + begin + if not(oo_is_classhelper in current_structdef.objectoptions) then + begin + intfchildof:=childof; + childof:=nil; + CGMessage(parser_h_no_objc_parent); + end + else + { a category must specify the class to extend } + CGMessage(type_e_objcclass_type_expected); + end + else + Message(parser_e_mix_of_classes_and_objects); + end + else + childof:=find_real_objcclass_definition(childof,true); + odt_objcprotocol: + begin + if not(is_objcprotocol(childof)) then + Message(parser_e_mix_of_classes_and_objects); + intfchildof:=childof; + childof:=nil; + end; + odt_object: + if not(is_object(childof)) then + Message(parser_e_mix_of_classes_and_objects) + else + if oo_is_sealed in childof.objectoptions then + Message1(parser_e_sealed_descendant,childof.typename); + odt_dispinterface: + Message(parser_e_dispinterface_cant_have_parent); + odt_helper: + if not is_objectpascal_helper(childof) then + begin + Message(type_e_helper_type_expected); + childof:=nil; + end; + end; + end; + hasparentdefined:=true; + end; + + { if no parent class, then a class get tobject as parent } + if not assigned(childof) then + begin + case current_objectdef.objecttype of + odt_class: + if current_objectdef<>class_tobject then + childof:=class_tobject; + odt_interfacecom: + if current_objectdef<>interface_iunknown then + childof:=interface_iunknown; + odt_dispinterface: + childof:=interface_idispatch; + odt_objcclass: + CGMessage(parser_h_no_objc_parent); + end; + end; + + if assigned(childof) then + begin + { Forbid not completly defined objects to be used as parents. This will + also prevent circular loops of classes, because we set the forward flag + at the start of the new definition and will reset it below after the + parent has been set } + if (oo_is_forward in childof.objectoptions) then + Message1(parser_e_forward_declaration_must_be_resolved,childof.objrealname^) + else if not(oo_is_formal in childof.objectoptions) then + current_objectdef.set_parent(childof) + else + Message1(sym_e_objc_formal_class_not_resolved,childof.objrealname^); + end; + + { remove forward flag, is resolved } + exclude(current_structdef.objectoptions,oo_is_forward); + + if hasparentdefined then + begin + if current_objectdef.objecttype in [odt_class,odt_objcclass,odt_objcprotocol] then + begin + if assigned(intfchildof) then + if current_objectdef.objecttype=odt_class then + handleImplementedInterface(intfchildof) + else + handleImplementedProtocol(intfchildof); + readImplementedInterfacesAndProtocols(current_objectdef.objecttype=odt_class); + end; + consume(_RKLAMMER); + end; + end; + + procedure parse_extended_type(helpertype:thelpertype); + var + hdef: tdef; + begin + if not is_objectpascal_helper(current_structdef) then + Internalerror(2011021103); + if helpertype=ht_none then + Internalerror(2011021001); + + consume(_FOR); + single_type(hdef,[stoParseClassParent]); + if (not assigned(hdef)) or + not (hdef.typ in [objectdef,recorddef]) then + begin + if helpertype=ht_class then + Message1(type_e_class_type_expected,hdef.typename) + else + if helpertype=ht_record then + Message1(type_e_record_type_expected,hdef.typename); + end + else + begin + case helpertype of + ht_class: + begin + if not is_class(hdef) then + Message1(type_e_class_type_expected,hdef.typename); + { a class helper must extend the same class or a subclass + of the class extended by the parent class helper } + if assigned(current_objectdef.childof) then + begin + if not is_class(current_objectdef.childof.extendeddef) then + Internalerror(2011021101); + if not hdef.is_related(current_objectdef.childof.extendeddef) then + Message1(type_e_class_helper_must_extend_subclass,current_objectdef.childof.extendeddef.typename); + end; + end; + ht_record: + begin + if not is_record(hdef) then + Message1(type_e_record_type_expected,hdef.typename); + { a record helper must extend the same record as the + parent helper } + if assigned(current_objectdef.childof) then + begin + if not is_record(current_objectdef.childof.extendeddef) then + Internalerror(2011021102); + if hdef<>current_objectdef.childof.extendeddef then + Message1(type_e_record_helper_must_extend_same_record,current_objectdef.childof.extendeddef.typename); + end; + end; + else + hdef:=nil; + end; + end; + + if assigned(hdef) then + current_objectdef.extendeddef:=hdef + else + current_objectdef.extendeddef:=generrordef; + end; + + procedure parse_guid; + begin + { read GUID } + if (current_objectdef.objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface]) and + try_to_consume(_LECKKLAMMER) then + begin + readinterfaceiid; + consume(_RECKKLAMMER); + end + else if (current_objectdef.objecttype=odt_dispinterface) then + message(parser_e_dispinterface_needs_a_guid); + end; + + procedure parse_object_members; + + procedure chkobjc(pd: tprocdef); + begin + if is_objc_class_or_protocol(pd.struct) then + begin + include(pd.procoptions,po_objc); + end; + end; + + + procedure chkcpp(pd:tprocdef); + begin + { nothing currently } + end; + + procedure maybe_parse_hint_directives(pd:tprocdef); + var + dummysymoptions : tsymoptions; + deprecatedmsg : pshortstring; + begin + dummysymoptions:=[]; + deprecatedmsg:=nil; + while try_consume_hintdirective(dummysymoptions,deprecatedmsg) do + Consume(_SEMICOLON); + if assigned(pd) then + begin + pd.symoptions:=pd.symoptions+dummysymoptions; + pd.deprecatedmsg:=deprecatedmsg; + end + else + stringdispose(deprecatedmsg); + end; + + var + pd : tprocdef; + has_destructor, + oldparse_only: boolean; + object_member_blocktype : tblock_type; + fields_allowed, is_classdef, classfields: boolean; + vdoptions: tvar_dec_options; + begin + { empty class declaration ? } + if (current_objectdef.objecttype in [odt_class,odt_objcclass]) and + (token=_SEMICOLON) then + exit; + + { in "publishable" classes the default access type is published } + if (oo_can_have_published in current_structdef.objectoptions) then + current_structdef.symtable.currentvisibility:=vis_published + else + current_structdef.symtable.currentvisibility:=vis_public; + has_destructor:=false; + fields_allowed:=true; + is_classdef:=false; + classfields:=false; + object_member_blocktype:=bt_general; + repeat + case token of + _TYPE : + begin + if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper]) then + Message(parser_e_type_var_const_only_in_records_and_classes); + consume(_TYPE); + object_member_blocktype:=bt_type; + end; + _VAR : + begin + if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper]) then + Message(parser_e_type_var_const_only_in_records_and_classes); + consume(_VAR); + fields_allowed:=true; + object_member_blocktype:=bt_general; + classfields:=is_classdef; + is_classdef:=false; + end; + _CONST: + begin + if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper]) then + Message(parser_e_type_var_const_only_in_records_and_classes); + consume(_CONST); + object_member_blocktype:=bt_const; + end; + _ID : + begin + if is_objcprotocol(current_structdef) and + ((idtoken=_REQUIRED) or + (idtoken=_OPTIONAL)) then + begin + current_structdef.symtable.currentlyoptional:=(idtoken=_OPTIONAL); + consume(idtoken) + end + else case idtoken of + _PRIVATE : + begin + if is_interface(current_structdef) or + is_objc_protocol_or_category(current_structdef) then + Message(parser_e_no_access_specifier_in_interfaces); + consume(_PRIVATE); + current_structdef.symtable.currentvisibility:=vis_private; + include(current_structdef.objectoptions,oo_has_private); + fields_allowed:=true; + is_classdef:=false; + classfields:=false; + object_member_blocktype:=bt_general; + end; + _PROTECTED : + begin + if is_interface(current_structdef) or + is_objc_protocol_or_category(current_structdef) then + Message(parser_e_no_access_specifier_in_interfaces); + consume(_PROTECTED); + current_structdef.symtable.currentvisibility:=vis_protected; + include(current_structdef.objectoptions,oo_has_protected); + fields_allowed:=true; + is_classdef:=false; + classfields:=false; + object_member_blocktype:=bt_general; + end; + _PUBLIC : + begin + if is_interface(current_structdef) or + is_objc_protocol_or_category(current_structdef) then + Message(parser_e_no_access_specifier_in_interfaces); + consume(_PUBLIC); + current_structdef.symtable.currentvisibility:=vis_public; + fields_allowed:=true; + is_classdef:=false; + classfields:=false; + object_member_blocktype:=bt_general; + end; + _PUBLISHED : + begin + { we've to check for a pushlished section in non- } + { publishable classes later, if a real declaration } + { this is the way, delphi does it } + if is_interface(current_structdef) then + Message(parser_e_no_access_specifier_in_interfaces); + { Objective-C classes do not support "published", + as basically everything is published. } + if is_objc_class_or_protocol(current_structdef) then + Message(parser_e_no_objc_published); + consume(_PUBLISHED); + current_structdef.symtable.currentvisibility:=vis_published; + fields_allowed:=true; + is_classdef:=false; + classfields:=false; + object_member_blocktype:=bt_general; + end; + _STRICT : + begin + if is_interface(current_structdef) or + is_objc_protocol_or_category(current_structdef) then + Message(parser_e_no_access_specifier_in_interfaces); + consume(_STRICT); + if token=_ID then + begin + case idtoken of + _PRIVATE: + begin + consume(_PRIVATE); + current_structdef.symtable.currentvisibility:=vis_strictprivate; + include(current_structdef.objectoptions,oo_has_strictprivate); + end; + _PROTECTED: + begin + consume(_PROTECTED); + current_structdef.symtable.currentvisibility:=vis_strictprotected; + include(current_structdef.objectoptions,oo_has_strictprotected); + end; + else + message(parser_e_protected_or_private_expected); + end; + end + else + message(parser_e_protected_or_private_expected); + fields_allowed:=true; + is_classdef:=false; + classfields:=false; + object_member_blocktype:=bt_general; + end + else + begin + if object_member_blocktype=bt_general then + begin + if is_interface(current_structdef) or + is_objc_protocol_or_category(current_structdef) or + is_objectpascal_helper(current_structdef) then + Message(parser_e_no_vars_in_interfaces); + + if (current_structdef.symtable.currentvisibility=vis_published) and + not(oo_can_have_published in current_structdef.objectoptions) then + Message(parser_e_cant_have_published); + if (not fields_allowed) then + Message(parser_e_field_not_allowed_here); + + vdoptions:=[vd_object]; + if classfields then + include(vdoptions,vd_class); + read_record_fields(vdoptions); + end + else if object_member_blocktype=bt_type then + types_dec(true) + else if object_member_blocktype=bt_const then + consts_dec(true) + else + internalerror(201001110); + end; + end; + end; + _PROPERTY : + begin + struct_property_dec(is_classdef); + fields_allowed:=false; + is_classdef:=false; + end; + _CLASS: + begin + is_classdef:=false; + { read class method/field/property } + consume(_CLASS); + { class modifier is only allowed for procedures, functions, } + { constructors, destructors, fields and properties } + if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR,_CONSTRUCTOR,_DESTRUCTOR]) then + Message(parser_e_procedure_or_function_expected); + + if is_interface(current_structdef) then + Message(parser_e_no_static_method_in_interfaces) + else + { class methods are also allowed for Objective-C protocols } + is_classdef:=true; + end; + _PROCEDURE, + _FUNCTION: + begin + if (current_structdef.symtable.currentvisibility=vis_published) and + not(oo_can_have_published in current_structdef.objectoptions) then + Message(parser_e_cant_have_published); + + oldparse_only:=parse_only; + parse_only:=true; + pd:=parse_proc_dec(is_classdef,current_structdef); + + { this is for error recovery as well as forward } + { interface mappings, i.e. mapping to a method } + { which isn't declared yet } + if assigned(pd) then + begin + parse_object_proc_directives(pd); + + { check if dispid is set } + if is_dispinterface(pd.struct) and not (po_dispid in pd.procoptions) then + begin + pd.dispid:=tobjectdef(pd.struct).get_next_dispid; + include(pd.procoptions, po_dispid); + end; + + { all Macintosh Object Pascal methods are virtual. } + { this can't be a class method, because macpas mode } + { has no m_class } + if (m_mac in current_settings.modeswitches) then + include(pd.procoptions,po_virtualmethod); + + { for record helpers only static class methods are allowed } + if is_objectpascal_helper(current_structdef) and + is_record(current_objectdef.extendeddef) and + is_classdef and not (po_staticmethod in pd.procoptions) then + MessagePos(pd.fileinfo, parser_e_class_methods_only_static_in_records); + + handle_calling_convention(pd); + + { add definition to procsym } + proc_add_definition(pd); + + { add procdef options to objectdef options } + if (po_msgint in pd.procoptions) then + include(current_structdef.objectoptions,oo_has_msgint); + if (po_msgstr in pd.procoptions) then + include(current_structdef.objectoptions,oo_has_msgstr); + if (po_virtualmethod in pd.procoptions) then + include(current_structdef.objectoptions,oo_has_virtual); + + chkcpp(pd); + chkobjc(pd); + end; + + maybe_parse_hint_directives(pd); + + parse_only:=oldparse_only; + fields_allowed:=false; + is_classdef:=false; + end; + _CONSTRUCTOR : + begin + if (current_structdef.symtable.currentvisibility=vis_published) and + not(oo_can_have_published in current_structdef.objectoptions) then + Message(parser_e_cant_have_published); + + if not is_classdef and not(current_structdef.symtable.currentvisibility in [vis_public,vis_published]) then + Message(parser_w_constructor_should_be_public); + + if is_interface(current_structdef) then + Message(parser_e_no_con_des_in_interfaces); + + { Objective-C does not know the concept of a constructor } + if is_objc_class_or_protocol(current_structdef) then + Message(parser_e_objc_no_constructor_destructor); + + if is_objectpascal_helper(current_structdef) then + if is_classdef then + { class constructors are not allowed in class helpers } + Message(parser_e_no_class_constructor_in_helpers) + else + if is_record(current_objectdef.extendeddef) then + { as long as constructors aren't allowed in records they + aren't allowed in helpers either } + Message(parser_e_no_constructor_in_records); + + { only 1 class constructor is allowed } + if is_classdef and (oo_has_class_constructor in current_structdef.objectoptions) then + Message1(parser_e_only_one_class_constructor_allowed, current_structdef.objrealname^); + + oldparse_only:=parse_only; + parse_only:=true; + if is_classdef then + pd:=class_constructor_head + else + pd:=constructor_head; + parse_object_proc_directives(pd); + handle_calling_convention(pd); + + { add definition to procsym } + proc_add_definition(pd); + + { add procdef options to objectdef options } + if (po_virtualmethod in pd.procoptions) then + include(current_structdef.objectoptions,oo_has_virtual); + chkcpp(pd); + maybe_parse_hint_directives(pd); + + parse_only:=oldparse_only; + fields_allowed:=false; + is_classdef:=false; + end; + _DESTRUCTOR : + begin + if (current_structdef.symtable.currentvisibility=vis_published) and + not(oo_can_have_published in current_structdef.objectoptions) then + Message(parser_e_cant_have_published); + + if not is_classdef then + if has_destructor then + Message(parser_n_only_one_destructor) + else + has_destructor:=true; + + if is_interface(current_structdef) then + Message(parser_e_no_con_des_in_interfaces); + + { (class) destructors are not allowed in class helpers } + if is_objectpascal_helper(current_structdef) then + Message(parser_e_no_destructor_in_records); + + if not is_classdef and (current_structdef.symtable.currentvisibility<>vis_public) then + Message(parser_w_destructor_should_be_public); + + { Objective-C does not know the concept of a destructor } + if is_objc_class_or_protocol(current_structdef) then + Message(parser_e_objc_no_constructor_destructor); + + { only 1 class destructor is allowed } + if is_classdef and (oo_has_class_destructor in current_structdef.objectoptions) then + Message1(parser_e_only_one_class_destructor_allowed, current_structdef.objrealname^); + + oldparse_only:=parse_only; + parse_only:=true; + if is_classdef then + pd:=class_destructor_head + else + pd:=destructor_head; + parse_object_proc_directives(pd); + handle_calling_convention(pd); + + { add definition to procsym } + proc_add_definition(pd); + + { add procdef options to objectdef options } + if (po_virtualmethod in pd.procoptions) then + include(current_structdef.objectoptions,oo_has_virtual); + + chkcpp(pd); + maybe_parse_hint_directives(pd); + + parse_only:=oldparse_only; + fields_allowed:=false; + is_classdef:=false; + end; + _END : + begin + consume(_END); + break; + end; + else + consume(_ID); { Give a ident expected message, like tp7 } + end; + until false; + end; + + + function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef; + var + old_current_structdef: tabstractrecorddef; + old_current_genericdef, + old_current_specializedef: tstoreddef; + old_parse_generic: boolean; + list: TFPObjectList; + s: String; + st: TSymtable; + begin + old_current_structdef:=current_structdef; + old_current_genericdef:=current_genericdef; + old_current_specializedef:=current_specializedef; + old_parse_generic:=parse_generic; + + current_structdef:=nil; + current_genericdef:=nil; + current_specializedef:=nil; + + { objects and class types can't be declared local } + if not(symtablestack.top.symtabletype in [globalsymtable,staticsymtable,objectsymtable,recordsymtable]) and + not assigned(genericlist) then + Message(parser_e_no_local_objects); + + { reuse forward objectdef? } + if assigned(fd) then + begin + if fd.objecttype<>objecttype then + begin + Message(parser_e_forward_mismatch); + { recover } + current_structdef:=tobjectdef.create(current_objectdef.objecttype,n,nil); + include(current_structdef.objectoptions,oo_is_forward); + end + else + current_structdef:=fd + end + else + begin + { anonym objects aren't allow (o : object a : longint; end;) } + if n='' then + Message(parser_f_no_anonym_objects); + + { create new class } + current_structdef:=tobjectdef.create(objecttype,n,nil); + + { include always the forward flag, it'll be removed after the parent class have been + added. This is to prevent circular childof loops } + include(current_structdef.objectoptions,oo_is_forward); + + if (cs_compilesystem in current_settings.moduleswitches) then + begin + case current_objectdef.objecttype of + odt_interfacecom : + if (current_structdef.objname^='IUNKNOWN') then + interface_iunknown:=current_objectdef + else + if (current_structdef.objname^='IDISPATCH') then + interface_idispatch:=current_objectdef; + odt_class : + if (current_structdef.objname^='TOBJECT') then + class_tobject:=current_objectdef; + end; + end; + if (current_module.modulename^='OBJCBASE') then + begin + case current_objectdef.objecttype of + odt_objcclass: + if (current_objectdef.objname^='Protocol') then + objc_protocoltype:=current_objectdef; + end; + end; + end; + + { usage of specialized type inside its generic template } + if assigned(genericdef) then + current_specializedef:=current_structdef + { reject declaration of generic class inside generic class } + else if assigned(genericlist) then + current_genericdef:=current_structdef; + + { nested types of specializations are specializations as well } + if assigned(old_current_structdef) and + (df_specialization in old_current_structdef.defoptions) then + include(current_structdef.defoptions,df_specialization); + + { set published flag in $M+ mode, it can also be inherited and will + be added when the parent class set with tobjectdef.set_parent (PFV) } + if (cs_generate_rtti in current_settings.localswitches) and + (current_objectdef.objecttype in [odt_interfacecom,odt_class,odt_helper]) then + include(current_structdef.objectoptions,oo_can_have_published); + + { Objective-C objectdefs can be "formal definitions", in which case + the syntax is "type tc = objcclass external;" -> we have to parse + its object options (external) already here, to make sure that such + definitions are recognised as formal defs } + if objecttype in [odt_objcclass,odt_objcprotocol,odt_objccategory] then + parse_object_options; + + { forward def? } + if not assigned(fd) and + (token=_SEMICOLON) then + begin + { add to the list of definitions to check that the forward + is resolved. this is required for delphi mode } + current_module.checkforwarddefs.add(current_structdef); + end + else + begin + { change objccategories into objcclass helpers } + if (objecttype=odt_objccategory) then + begin + current_objectdef.objecttype:=odt_objcclass; + include(current_structdef.objectoptions,oo_is_classhelper); + end; + + { include the class helper flag for Object Pascal helpers } + if (objecttype=odt_helper) then + include(current_objectdef.objectoptions,oo_is_classhelper); + + { parse list of options (abstract / sealed) } + if not(objecttype in [odt_objcclass,odt_objcprotocol,odt_objccategory]) then + parse_object_options; + + symtablestack.push(current_structdef.symtable); + insert_generic_parameter_types(current_structdef,genericdef,genericlist); + { when we are parsing a generic already then this is a generic as + well } + if old_parse_generic then + include(current_structdef.defoptions, df_generic); + parse_generic:=(df_generic in current_structdef.defoptions); + + { parse list of parent classes } + { for record helpers in mode Delphi this is not allowed } + if not (is_objectpascal_helper(current_objectdef) and + (m_delphi in current_settings.modeswitches) and + (helpertype=ht_record)) then + parse_parent_classes + else + { remove forward flag, is resolved (this is normally done inside + parse_parent_classes) } + exclude(current_structdef.objectoptions,oo_is_forward); + + { parse extended type for helpers } + if is_objectpascal_helper(current_structdef) then + parse_extended_type(helpertype); + + { parse optional GUID for interfaces } + parse_guid; + + { parse and insert object members } + parse_object_members; + symtablestack.pop(current_structdef.symtable); + end; + + { generate vmt space if needed } + if not(oo_has_vmt in current_structdef.objectoptions) and + not(oo_is_forward in current_structdef.objectoptions) and + ( + ([oo_has_virtual,oo_has_constructor,oo_has_destructor]*current_structdef.objectoptions<>[]) or + (current_objectdef.objecttype in [odt_class]) + ) then + current_objectdef.insertvmt; + + { for implemented classes with a vmt check if there is a constructor } + if (oo_has_vmt in current_structdef.objectoptions) and + not(oo_is_forward in current_structdef.objectoptions) and + not(oo_has_constructor in current_structdef.objectoptions) and + not is_objc_class_or_protocol(current_structdef) then + Message1(parser_w_virtual_without_constructor,current_structdef.objrealname^); + + if is_interface(current_structdef) or + is_objcprotocol(current_structdef) then + setinterfacemethodoptions + else if is_objcclass(current_structdef) then + setobjcclassmethodoptions; + + { if this helper is defined in the implementation section of the unit + or inside the main project file, the extendeddefs list of the current + module must be updated (it will be removed when poping the symtable) } + if is_objectpascal_helper(current_structdef) and + (current_objectdef.extendeddef.typ in [recorddef,objectdef]) then + begin + { the topmost symtable must be a static symtable } + st:=current_structdef.owner; + while st.symtabletype in [objectsymtable,recordsymtable] do + st:=st.defowner.owner; + if st.symtabletype=staticsymtable then + begin + s:=make_mangledname('',tabstractrecorddef(current_objectdef.extendeddef).symtable,''); + list:=TFPObjectList(current_module.extendeddefs.Find(s)); + if not assigned(list) then + begin + list:=TFPObjectList.Create(false); + current_module.extendeddefs.Add(s, list); + end; + list.add(current_structdef); + end; + end; + tabstractrecordsymtable(current_objectdef.symtable).addalignmentpadding; + + { return defined objectdef } + result:=current_objectdef; + + { restore old state } + current_structdef:=old_current_structdef; + current_genericdef:=old_current_genericdef; + current_specializedef:=old_current_specializedef; + parse_generic:=old_parse_generic; + end; + +end. diff --git a/closures/compiler/pdecsub.pas b/closures/compiler/pdecsub.pas new file mode 100644 index 0000000000..b73c4b3a3a --- /dev/null +++ b/closures/compiler/pdecsub.pas @@ -0,0 +1,3388 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl, Daniel Mantione + + Does the parsing of the procedures/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. + + **************************************************************************** +} +unit pdecsub; + +{$i fpcdefs.inc} + +interface + + uses + tokens,symconst,symtype,symdef,symsym; + + type + tpdflag=( + pd_body, { directive needs a body } + pd_implemen, { directive can be used in implementation section } + pd_interface, { directive can be used in interface section } + pd_object, { directive can be used with object declaration } + pd_record, { directive can be used with record declaration } + pd_procvar, { directive can be used with procvar declaration } + pd_notobject, { directive can not be used with object declaration } + pd_notrecord, { directive can not be used with record declaration } + pd_notobjintf, { directive can not be used with interface declaration } + pd_notprocvar, { directive can not be used with procvar declaration } + pd_dispinterface,{ directive can be used with dispinterface methods } + pd_cppobject, { directive can be used with cppclass } + pd_objcclass, { directive can be used with objcclass } + pd_objcprot, { directive can be used with objcprotocol } + pd_nothelper { directive can not be used with record/class helper declaration } + ); + tpdflags=set of tpdflag; + + function check_proc_directive(isprocvar:boolean):boolean; + + procedure insert_funcret_local(pd:tprocdef); + + function proc_add_definition(var currpd:tprocdef):boolean; + function proc_get_importname(pd:tprocdef):string; + procedure proc_set_mangledname(pd:tprocdef); + + procedure handle_calling_convention(pd:tabstractprocdef); + + procedure parse_parameter_dec(pd:tabstractprocdef); + procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags); + procedure parse_var_proc_directives(sym:tsym); + procedure parse_object_proc_directives(pd:tabstractprocdef); + procedure parse_record_proc_directives(pd:tabstractprocdef); + function parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;out pd:tprocdef):boolean; + function parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef):tprocdef; + + { helper functions - they insert nested objects hierarcy to the symtablestack + with object hierarchy + } + function push_child_hierarcy(obj:tabstractrecorddef):integer; + function pop_child_hierarchy(obj:tabstractrecorddef):integer; + function push_nested_hierarchy(obj:tabstractrecorddef):integer; + function pop_nested_hierarchy(obj:tabstractrecorddef):integer; + +implementation + + uses + SysUtils, + { common } + cutils,cclasses, + { global } + globtype,globals,verbose,constexp, + systems,fpccrc, + cpuinfo, + { symtable } + symbase,symtable,defutil,defcmp,paramgr,cpupara, + { pass 1 } + fmodule,node,htypechk, + nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw, + objcutil, + { parser } + scanner, + pbase,pexpr,ptype,pdecl + ; + + const + { Please leave this here, this module should NOT use + these variables. + Declaring it as string here results in an error when compiling (PFV) } + current_procinfo = 'error'; + + function push_child_hierarcy(obj:tabstractrecorddef):integer; + var + _class,hp : tobjectdef; + begin + if obj.typ=recorddef then + begin + symtablestack.push(obj.symtable); + result:=1; + exit; + end; + result:=0; + { insert class hierarchy in the reverse order } + hp:=nil; + repeat + _class:=tobjectdef(obj); + while _class.childof<>hp do + _class:=_class.childof; + hp:=_class; + symtablestack.push(_class.symtable); + inc(result); + until hp=obj; + end; + + function push_nested_hierarchy(obj:tabstractrecorddef):integer; + begin + result:=0; + if obj.owner.symtabletype in [ObjectSymtable,recordsymtable] then + inc(result,push_nested_hierarchy(tabstractrecorddef(obj.owner.defowner))); + inc(result,push_child_hierarcy(obj)); + end; + + function pop_child_hierarchy(obj:tabstractrecorddef):integer; + var + _class : tobjectdef; + begin + if obj.typ=recorddef then + begin + symtablestack.pop(obj.symtable); + result:=1; + exit; + end; + result:=0; + _class:=tobjectdef(obj); + while assigned(_class) do + begin + symtablestack.pop(_class.symtable); + _class:=_class.childof; + inc(result); + end; + end; + + function pop_nested_hierarchy(obj:tabstractrecorddef):integer; + begin + result:=pop_child_hierarchy(obj); + if obj.owner.symtabletype in [ObjectSymtable,recordsymtable] then + inc(result,pop_nested_hierarchy(tabstractrecorddef(obj.owner.defowner))); + end; + + procedure insert_funcret_para(pd:tabstractprocdef); + var + storepos : tfileposinfo; + vs : tparavarsym; + paranr : word; + begin + if not(pd.proctypeoption in [potype_constructor,potype_destructor]) and + not is_void(pd.returndef) and + paramanager.ret_in_param(pd.returndef,pd.proccalloption) then + begin + storepos:=current_tokenpos; + if pd.typ=procdef then + current_tokenpos:=tprocdef(pd).fileinfo; + +{$if defined(i386)} + { For left to right add it at the end to be delphi compatible. + In the case of safecalls with safecal-exceptions support the + funcret-para is (from the 'c'-point of view) a normal parameter + which has to be added to the end of the parameter-list } + if (pd.proccalloption in (pushleftright_pocalls)) or + ((tf_safecall_exceptions in target_info.flags) and + (pd.proccalloption=pocall_safecall)) then + paranr:=paranr_result_leftright + else +{$elseif defined(x86) or defined(arm)} + if (tf_safecall_exceptions in target_info.flags) and + (pd.proccalloption = pocall_safecall) then + paranr:=paranr_result_leftright + else +{$endif} + paranr:=paranr_result; + { Generate result variable accessing function result } + vs:=tparavarsym.create('$result',paranr,vs_var,pd.returndef,[vo_is_funcret,vo_is_hidden_para]); + pd.parast.insert(vs); + { Store the this symbol as funcretsym for procedures } + if pd.typ=procdef then + tprocdef(pd).funcretsym:=vs; + + current_tokenpos:=storepos; + end; + end; + + + procedure insert_parentfp_para(pd:tabstractprocdef); + var + storepos : tfileposinfo; + vs : tparavarsym; + paranr : longint; + begin + if pd.parast.symtablelevel>normal_function_level then + begin + storepos:=current_tokenpos; + if pd.typ=procdef then + current_tokenpos:=tprocdef(pd).fileinfo; + + { if no support for nested procvars is activated, use the old + calling convention to pass the parent frame pointer for backwards + compatibility } + if not(m_nested_procvars in current_settings.modeswitches) then + paranr:=paranr_parentfp + { nested procvars require Delphi-style parentfp passing, see + po_delphi_nested_cc declaration for more info } +{$ifdef i386} + else if (pd.proccalloption in pushleftright_pocalls) then + paranr:=paranr_parentfp_delphi_cc_leftright +{$endif i386} + else + paranr:=paranr_parentfp_delphi_cc; + { Generate result variable accessing function result, it + can't be put in a register since it must be accessable + from the framepointer } + vs:=tparavarsym.create('$parentfp',paranr,vs_value + ,voidpointertype,[vo_is_parentfp,vo_is_hidden_para]); + vs.varregable:=vr_none; + pd.parast.insert(vs); + + current_tokenpos:=storepos; + end; + end; + + + procedure insert_self_and_vmt_para(pd:tabstractprocdef); + var + storepos : tfileposinfo; + vs : tparavarsym; + hdef : tdef; + selfdef : tdef; + vsp : tvarspez; + aliasvs : tabsolutevarsym; + sl : tpropaccesslist; + begin + if (pd.typ=procdef) and + is_objc_class_or_protocol(tprocdef(pd).struct) and + (pd.parast.symtablelevel=normal_function_level) then + begin + { insert Objective-C self and selector parameters } + vs:=tparavarsym.create('$_cmd',paranr_objc_cmd,vs_value,objc_seltype,[vo_is_msgsel,vo_is_hidden_para]); + pd.parast.insert(vs); + { make accessible to code } + sl:=tpropaccesslist.create; + sl.addsym(sl_load,vs); + aliasvs:=tabsolutevarsym.create_ref('_CMD',objc_seltype,sl); + include(aliasvs.varoptions,vo_is_msgsel); + tlocalsymtable(tprocdef(pd).localst).insert(aliasvs); + + if (po_classmethod in pd.procoptions) then + { compatible with what gcc does } + hdef:=objc_idtype + else + hdef:=tprocdef(pd).struct; + + vs:=tparavarsym.create('$self',paranr_objc_self,vs_value,hdef,[vo_is_self,vo_is_hidden_para]); + pd.parast.insert(vs); + end + else if (pd.typ=procvardef) and + pd.is_methodpointer then + begin + { Generate self variable } + vs:=tparavarsym.create('$self',paranr_self,vs_value,voidpointertype,[vo_is_self,vo_is_hidden_para]); + pd.parast.insert(vs); + end + else + begin + if (pd.typ=procdef) and + assigned(tprocdef(pd).struct) and + (pd.parast.symtablelevel=normal_function_level) then + begin + { static class methods have no hidden self/vmt pointer } + if pd.no_self_node then + exit; + + storepos:=current_tokenpos; + current_tokenpos:=tprocdef(pd).fileinfo; + + { Generate VMT variable for constructor/destructor } + if (pd.proctypeoption in [potype_constructor,potype_destructor]) and + not(is_cppclass(tprocdef(pd).struct) or is_record(tprocdef(pd).struct)) then + begin + { can't use classrefdef as type because inheriting + will then always file because of a type mismatch } + vs:=tparavarsym.create('$vmt',paranr_vmt,vs_value,voidpointertype,[vo_is_vmt,vo_is_hidden_para]); + pd.parast.insert(vs); + end; + + { for helpers the type of Self is equivalent to the extended + type or equal to an instance of it } + if is_objectpascal_helper(tprocdef(pd).struct) then + selfdef:=tobjectdef(tprocdef(pd).struct).extendeddef + else + selfdef:=tprocdef(pd).struct; + { Generate self variable, for classes we need + to use the generic voidpointer to be compatible with + methodpointers } + vsp:=vs_value; + if (po_staticmethod in pd.procoptions) or + (po_classmethod in pd.procoptions) then + hdef:=tclassrefdef.create(selfdef) + else + begin + if is_object(selfdef) or is_record(selfdef) then + vsp:=vs_var; + hdef:=selfdef; + end; + vs:=tparavarsym.create('$self',paranr_self,vsp,hdef,[vo_is_self,vo_is_hidden_para]); + pd.parast.insert(vs); + + current_tokenpos:=storepos; + end; + end; + end; + + + procedure insert_funcret_local(pd:tprocdef); + var + storepos : tfileposinfo; + vs : tlocalvarsym; + aliasvs : tabsolutevarsym; + sl : tpropaccesslist; + hs : string; + begin + { The result from constructors and destructors can't be accessed directly } + if not(pd.proctypeoption in [potype_constructor,potype_destructor]) and + not is_void(pd.returndef) then + begin + storepos:=current_tokenpos; + current_tokenpos:=pd.fileinfo; + + { We need to insert a varsym for the result in the localst + when it is returning in a register } + if not paramanager.ret_in_param(pd.returndef,pd.proccalloption) then + begin + vs:=tlocalvarsym.create('$result',vs_value,pd.returndef,[vo_is_funcret]); + pd.localst.insert(vs); + pd.funcretsym:=vs; + end; + + { insert the name of the procedure as alias for the function result, + we can't use realname because that will not work for compilerprocs + as the name is lowercase and unreachable from the code } + if assigned(pd.resultname) then + hs:=pd.resultname^ + else + hs:=pd.procsym.name; + sl:=tpropaccesslist.create; + sl.addsym(sl_load,pd.funcretsym); + aliasvs:=tabsolutevarsym.create_ref(hs,pd.returndef,sl); + include(aliasvs.varoptions,vo_is_funcret); + tlocalsymtable(pd.localst).insert(aliasvs); + + { insert result also if support is on } + if (m_result in current_settings.modeswitches) then + begin + sl:=tpropaccesslist.create; + sl.addsym(sl_load,pd.funcretsym); + aliasvs:=tabsolutevarsym.create_ref('RESULT',pd.returndef,sl); + include(aliasvs.varoptions,vo_is_funcret); + include(aliasvs.varoptions,vo_is_result); + tlocalsymtable(pd.localst).insert(aliasvs); + end; + + current_tokenpos:=storepos; + end; + end; + + + procedure insert_hidden_para(p:TObject;arg:pointer); + var + hvs : tparavarsym; + pd : tabstractprocdef absolute arg; + begin + if (tsym(p).typ<>paravarsym) then + exit; + with tparavarsym(p) do + begin + { We need a local copy for a value parameter when only the + address is pushed. Open arrays and Array of Const are + an exception because they are allocated at runtime and the + address that is pushed is patched } + if (varspez=vs_value) and + paramanager.push_addr_param(varspez,vardef,pd.proccalloption) and + not(is_open_array(vardef) or + is_array_of_const(vardef)) then + include(varoptions,vo_has_local_copy); + + { needs high parameter ? } + if paramanager.push_high_param(varspez,vardef,pd.proccalloption) then + begin + hvs:=tparavarsym.create('$high'+name,paranr+1,vs_const,sinttype,[vo_is_high_para,vo_is_hidden_para]); + hvs.symoptions:=[]; + owner.insert(hvs); + { don't place to register if it will be accessed from implicit finally block } + if (varspez=vs_value) and + is_open_array(vardef) and + is_managed_type(vardef) then + hvs.varregable:=vr_none; + end + else + begin + { Give a warning that cdecl routines does not include high() + support } + if (pd.proccalloption in cdecl_pocalls) and + paramanager.push_high_param(varspez,vardef,pocall_default) then + begin + if is_open_string(vardef) then + MessagePos(fileinfo,parser_w_cdecl_no_openstring); + if not(po_external in pd.procoptions) and + (pd.typ<>procvardef) and + not is_objc_class_or_protocol(tprocdef(pd).struct) then + if is_array_of_const(vardef) then + MessagePos(fileinfo,parser_e_varargs_need_cdecl_and_external) + else + MessagePos(fileinfo,parser_w_cdecl_has_no_high); + end; + if (vardef.typ=formaldef) and (Tformaldef(vardef).typed) then + begin + hvs:=tparavarsym.create('$typinfo'+name,paranr+1,vs_const,voidpointertype, + [vo_is_typinfo_para,vo_is_hidden_para]); + owner.insert(hvs); + end; + end; + end; + end; + + + procedure check_c_para(pd:Tabstractprocdef); + var + i, + lastparaidx : longint; + sym : TSym; + begin + lastparaidx:=pd.parast.SymList.Count-1; + for i:=0 to pd.parast.SymList.Count-1 do + begin + sym:=tsym(pd.parast.SymList[i]); + if (sym.typ=paravarsym) and + (tparavarsym(sym).vardef.typ=arraydef) then + begin + if not is_variant_array(tparavarsym(sym).vardef) and + not is_array_of_const(tparavarsym(sym).vardef) and + (tparavarsym(sym).varspez<>vs_var) then + MessagePos(tparavarsym(sym).fileinfo,parser_h_c_arrays_are_references); + if is_array_of_const(tparavarsym(sym).vardef) and + (i<lastparaidx) and + (tsym(pd.parast.SymList[i+1]).typ=paravarsym) and + not(vo_is_high_para in tparavarsym(pd.parast.SymList[i+1]).varoptions) then + MessagePos(tparavarsym(sym).fileinfo,parser_e_C_array_of_const_must_be_last); + end; + end; + end; + + + procedure check_msg_para(p:TObject;arg:pointer); + begin + if (tsym(p).typ<>paravarsym) then + exit; + with tparavarsym(p) do + begin + { Count parameters } + if (paranr>=10) then + inc(plongint(arg)^); + { First parameter must be var } + if (paranr=10) and + (varspez<>vs_var) then + MessagePos(fileinfo,parser_e_ill_msg_param); + end; + end; + + + procedure set_addr_param_regable(p:TObject;arg:pointer); + begin + if (tsym(p).typ<>paravarsym) then + exit; + with tparavarsym(p) do + begin + if (not needs_finalization) and + paramanager.push_addr_param(varspez,vardef,tprocdef(arg).proccalloption) then + varregable:=vr_intreg; + end; + end; + + + procedure parse_parameter_dec(pd:tabstractprocdef); + { + handle_procvar needs the same changes + } + type + tppv = (pv_none,pv_proc,pv_func); + var + sc : TFPObjectList; + hdef : tdef; + arrayelementdef : tdef; + vs : tparavarsym; + i : longint; + srsym : tsym; + pv : tprocvardef; + varspez : Tvarspez; + defaultvalue : tconstsym; + defaultrequired : boolean; + old_block_type : tblock_type; + currparast : tparasymtable; + parseprocvar : tppv; + locationstr : string; + paranr : integer; + dummytype : ttypesym; + explicit_paraloc, + need_array, + is_univ: boolean; + begin + old_block_type:=block_type; + explicit_paraloc:=false; + consume(_LKLAMMER); + { Delphi/Kylix supports nonsense like } + { procedure p(); } + if try_to_consume(_RKLAMMER) and + not(m_tp7 in current_settings.modeswitches) then + exit; + { parsing a proc or procvar ? } + currparast:=tparasymtable(pd.parast); + { reset } + sc:=TFPObjectList.create(false); + defaultrequired:=false; + paranr:=0; + block_type:=bt_var; + is_univ:=false; + repeat + parseprocvar:=pv_none; + if try_to_consume(_VAR) then + varspez:=vs_var + else + if try_to_consume(_CONST) then + varspez:=vs_const + else + if (m_out in current_settings.modeswitches) and + try_to_consume(_OUT) then + varspez:=vs_out + else + if try_to_consume(_CONSTREF) then + varspez:=vs_constref + else + if (m_mac in current_settings.modeswitches) and + try_to_consume(_POINTPOINTPOINT) then + begin + include(pd.procoptions,po_varargs); + break; + end + else + if (m_nested_procvars in current_settings.modeswitches) and + try_to_consume(_PROCEDURE) then + begin + parseprocvar:=pv_proc; + varspez:=vs_const; + end + else + if (m_nested_procvars in current_settings.modeswitches) and + try_to_consume(_FUNCTION) then + begin + parseprocvar:=pv_func; + varspez:=vs_const; + end + else + varspez:=vs_value; + defaultvalue:=nil; + hdef:=nil; + { read identifiers and insert with error type } + sc.clear; + repeat + inc(paranr); + vs:=tparavarsym.create(orgpattern,paranr*10,varspez,generrordef,[]); + currparast.insert(vs); + if assigned(vs.owner) then + sc.add(vs) + else + vs.free; + consume(_ID); + until not try_to_consume(_COMMA); + locationstr:=''; + { macpas anonymous procvar } + if parseprocvar<>pv_none then + begin + { inline procvar definitions are always nested procvars } + pv:=tprocvardef.create(normal_function_level+1); + if token=_LKLAMMER then + parse_parameter_dec(pv); + if parseprocvar=pv_func then + begin + block_type:=bt_var_type; + consume(_COLON); + single_type(pv.returndef,[]); + block_type:=bt_var; + end; + hdef:=pv; + { possible proc directives } + if check_proc_directive(true) then + begin + dummytype:=ttypesym.create('unnamed',hdef); + parse_var_proc_directives(tsym(dummytype)); + dummytype.typedef:=nil; + hdef.typesym:=nil; + dummytype.free; + end; + { Add implicit hidden parameters and function result } + handle_calling_convention(pv); + end + else + { read type declaration, force reading for value paras } + if (token=_COLON) or (varspez=vs_value) then + begin + consume(_COLON); + { check for an open array } + need_array:=false; + { bitpacked open array are not yet supported } + if (token=_PACKED) and + not(cs_bitpacking in current_settings.localswitches) then + begin + consume(_PACKED); + need_array:=true; + end; + if (token=_ARRAY) or + need_array then + begin + consume(_ARRAY); + consume(_OF); + { define range and type of range } + hdef:=tarraydef.create(0,-1,s32inttype); + { array of const ? } + if (token=_CONST) and (m_objpas in current_settings.modeswitches) then + begin + consume(_CONST); + srsym:=search_system_type('TVARREC'); + tarraydef(hdef).elementdef:=ttypesym(srsym).typedef; + include(tarraydef(hdef).arrayoptions,ado_IsArrayOfConst); + end + else + begin + { define field type } + single_type(arrayelementdef,[]); + tarraydef(hdef).elementdef:=arrayelementdef; + end; + end + else + begin + if (m_mac in current_settings.modeswitches) then + is_univ:=try_to_consume(_UNIV); + + if try_to_consume(_TYPE) then + hdef:=ctypedformaltype + else + begin + block_type:=bt_var_type; + single_type(hdef,[stoAllowSpecialization]); + block_type:=bt_var; + end; + + { open string ? } + if is_shortstring(hdef) then + begin + case varspez of + vs_var,vs_out,vs_constref: + begin + { not 100% Delphi-compatible: type xstr=string[255] cannot + become an openstring there, while here it can } + if (cs_openstring in current_settings.moduleswitches) and + (tstringdef(hdef).len=255) then + hdef:=openshortstringtype + end; + vs_value: + begin + { value "openstring" parameters don't make sense (the + original string can never be modified, so there's no + use in passing its original length), so change these + into regular shortstring parameters (seems to be what + Delphi also does) } + if is_open_string(hdef) then + hdef:=cshortstringtype; + end; + end; + end; + if (target_info.system in [system_powerpc_morphos,system_m68k_amiga]) then + begin + if (idtoken=_LOCATION) then + begin + consume(_LOCATION); + locationstr:=cstringpattern; + consume(_CSTRING); + end + else + begin + if explicit_paraloc then + Message(parser_e_paraloc_all_paras); + locationstr:=''; + end; + end + else + locationstr:=''; + + { default parameter } + if (m_default_para in current_settings.modeswitches) then + begin + if try_to_consume(_EQ) then + begin + vs:=tparavarsym(sc[0]); + if sc.count>1 then + Message(parser_e_default_value_only_one_para); + { prefix 'def' to the parameter name } + defaultvalue:=ReadConstant('$def'+vs.name,vs.fileinfo); + if assigned(defaultvalue) then + begin + include(defaultvalue.symoptions,sp_internal); + pd.parast.insert(defaultvalue); + end; + defaultrequired:=true; + end + else + begin + if defaultrequired then + Message1(parser_e_default_value_expected_for_para,vs.name); + end; + end; + end; + end + else + hdef:=cformaltype; + + { File types are only allowed for var and out parameters } + if (hdef.typ=filedef) and + not(varspez in [vs_out,vs_var]) then + CGMessage(cg_e_file_must_call_by_reference); + + { Dispinterfaces are restricted to using only automatable types } + if (pd.typ=procdef) and is_dispinterface(tprocdef(pd).struct) and + not is_automatable(hdef) then + Message1(type_e_not_automatable,hdef.typename); + + { univ cannot be used with types whose size is not known at compile + time } + if is_univ and + not is_valid_univ_para_type(hdef) then + Message1(parser_e_invalid_univ_para,hdef.typename); + + for i:=0 to sc.count-1 do + begin + vs:=tparavarsym(sc[i]); + vs.univpara:=is_univ; + { update varsym } + vs.vardef:=hdef; + vs.defaultconstsym:=defaultvalue; + + if (target_info.system in [system_powerpc_morphos,system_m68k_amiga]) then + begin + if locationstr<>'' then + begin + if sc.count>1 then + Message(parser_e_paraloc_only_one_para); + if (paranr>1) and not(explicit_paraloc) then + Message(parser_e_paraloc_all_paras); + explicit_paraloc:=true; + include(vs.varoptions,vo_has_explicit_paraloc); + if not(paramanager.parseparaloc(vs,upper(locationstr))) then + message(parser_e_illegal_explicit_paraloc); + end + else + if explicit_paraloc then + Message(parser_e_paraloc_all_paras); + end; + end; + until not try_to_consume(_SEMICOLON); + + if explicit_paraloc then + begin + pd.has_paraloc_info:=callerside; + include(pd.procoptions,po_explicitparaloc); + end; + { remove parasymtable from stack } + sc.free; + { reset object options } + block_type:=old_block_type; + consume(_RKLAMMER); + end; + + + function parse_proc_head(astruct:tabstractrecorddef;potype:tproctypeoption;out pd:tprocdef):boolean; + var + hs : string; + orgsp,sp : TIDString; + srsym : tsym; + checkstack : psymtablestackitem; + procstartfilepos : tfileposinfo; + searchagain : boolean; + st, + genericst: TSymtable; + aprocsym : tprocsym; + popclass : integer; + ImplIntf : TImplementedInterface; + old_parse_generic : boolean; + old_current_structdef: tabstractrecorddef; + old_current_genericdef, + old_current_specializedef: tstoreddef; + lasttoken,lastidtoken: ttoken; + + procedure parse_operator_name; + begin + if (lasttoken in [first_overloaded..last_overloaded]) then + begin + optoken:=token; + end + else + begin + case lasttoken of + _CARET: + Message1(parser_e_overload_operator_failed,'**'); + _ID: + case lastidtoken of + _ENUMERATOR:optoken:=_OP_ENUMERATOR; + _EXPLICIT:optoken:=_OP_EXPLICIT; + _INC:optoken:=_OP_INC; + _DEC:optoken:=_OP_DEC; + else + if (m_delphi in current_settings.modeswitches) then + case lastidtoken of + _IMPLICIT:optoken:=_ASSIGNMENT; + _NEGATIVE:optoken:=_MINUS; + _POSITIVE:optoken:=_PLUS; + _LOGICALNOT:optoken:=_OP_NOT; + _IN:optoken:=_OP_IN; + _EQUAL:optoken:=_EQ; + _NOTEQUAL:optoken:=_NE; + _GREATERTHAN:optoken:=_GT; + _GREATERTHANOREQUAL:optoken:=_GTE; + _LESSTHAN:optoken:=_LT; + _LESSTHANOREQUAL:optoken:=_LTE; + _ADD:optoken:=_PLUS; + _SUBTRACT:optoken:=_MINUS; + _MULTIPLY:optoken:=_STAR; + _DIVIDE:optoken:=_SLASH; + _INTDIVIDE:optoken:=_OP_DIV; + _MODULUS:optoken:=_OP_MOD; + _LEFTSHIFT:optoken:=_OP_SHL; + _RIGHTSHIFT:optoken:=_OP_SHR; + _LOGICALAND:optoken:=_OP_AND; + _LOGICALOR:optoken:=_OP_OR; + _LOGICALXOR:optoken:=_OP_XOR; + _BITWISEAND:optoken:=_OP_AND; + _BITWISEOR:optoken:=_OP_OR; + _BITWISEXOR:optoken:=_OP_XOR; + else + Message1(parser_e_overload_operator_failed,''); + end + else + Message1(parser_e_overload_operator_failed,''); + end + else + Message1(parser_e_overload_operator_failed,''); + end; + end; + sp:=overloaded_names[optoken]; + orgsp:=sp; + end; + + procedure consume_proc_name; + begin + lasttoken:=token; + lastidtoken:=idtoken; + if potype=potype_operator then + optoken:=NOTOKEN; + if (potype=potype_operator) and (token<>_ID) then + begin + parse_operator_name; + consume(token); + end + else + begin + sp:=pattern; + orgsp:=orgpattern; + consume(_ID); + end; + end; + + function search_object_name(sp:TIDString;gen_error:boolean):tsym; + var + storepos:tfileposinfo; + srsymtable:TSymtable; + begin + storepos:=current_tokenpos; + current_tokenpos:=procstartfilepos; + searchsym(sp,result,srsymtable); + if not assigned(result) then + begin + if gen_error then + identifier_not_found(orgsp); + result:=generrorsym; + end; + current_tokenpos:=storepos; + end; + + function consume_generic_type_parameter:boolean; + var + idx : integer; + genparalistdecl : TFPHashList; + genname : tidstring; + s : shortstring; + begin + result:=not assigned(astruct)and(m_delphi in current_settings.modeswitches); + if result then + begin + { parse all parameters first so we can check whether we have + the correct generic def available } + genparalistdecl:=TFPHashList.Create; + if try_to_consume(_LT) then + begin + { start with 1, so Find can return Nil (= 0) } + idx:=1; + repeat + if token=_ID then + begin + genparalistdecl.Add(pattern, Pointer(PtrInt(idx))); + consume(_ID); + inc(idx); + end + else + begin + message2(scan_f_syn_expected,arraytokeninfo[_ID].str,arraytokeninfo[token].str); + if token<>_COMMA then + consume(token); + end; + until not try_to_consume(_COMMA); + if not try_to_consume(_GT) then + consume(_RSHARPBRACKET); + end + else + begin + { no generic } + srsym:=nil; + exit; + end; + + s:=''; + str(genparalistdecl.count,s); + genname:=sp+'$'+s; + + genparalistdecl.free; + + srsym:=search_object_name(genname,false); + + if not assigned(srsym) then + begin + { TODO : print a nicer typename that contains the parsed + generic types } + Message1(type_e_generic_declaration_does_not_match,genname); + srsym:=nil; + exit; + end; + end; + end; + + begin + { Save the position where this procedure really starts } + procstartfilepos:=current_tokenpos; + old_parse_generic:=parse_generic; + + result:=false; + pd:=nil; + aprocsym:=nil; + + consume_proc_name; + + { examine interface map: function/procedure iname.functionname=locfuncname } + if assigned(astruct) and + (astruct.typ=objectdef) and + assigned(tobjectdef(astruct).ImplementedInterfaces) and + (tobjectdef(astruct).ImplementedInterfaces.count>0) and + try_to_consume(_POINT) then + begin + srsym:=search_object_name(sp,true); + { qualifier is interface? } + ImplIntf:=nil; + if (srsym.typ=typesym) and + (ttypesym(srsym).typedef.typ=objectdef) then + ImplIntf:=tobjectdef(astruct).find_implemented_interface(tobjectdef(ttypesym(srsym).typedef)); + if ImplIntf=nil then + Message(parser_e_interface_id_expected); + { must be a directly implemented interface } + if Assigned(ImplIntf.ImplementsGetter) then + Message2(parser_e_implements_no_mapping,ImplIntf.IntfDef.typename,astruct.objrealname^); + consume(_ID); + { Create unique name <interface>.<method> } + hs:=sp+'.'+pattern; + consume(_EQ); + if assigned(ImplIntf) and + (token=_ID) then + ImplIntf.AddMapping(hs,pattern); + consume(_ID); + result:=true; + exit; + end; + + { method ? } + srsym:=nil; + if (consume_generic_type_parameter or not assigned(astruct)) and + (symtablestack.top.symtablelevel=main_program_level) and + try_to_consume(_POINT) then + begin + repeat + searchagain:=false; + if not assigned(astruct) and not assigned(srsym) then + srsym:=search_object_name(sp,true); + { consume proc name } + procstartfilepos:=current_tokenpos; + consume_proc_name; + { qualifier is class name ? } + if (srsym.typ=typesym) and + (ttypesym(srsym).typedef.typ in [objectdef,recorddef]) then + begin + astruct:=tabstractrecorddef(ttypesym(srsym).typedef); + if (token<>_POINT) then + if (potype in [potype_class_constructor,potype_class_destructor]) then + sp:=lower(sp) + else + if (potype=potype_operator)and(optoken=NOTOKEN) then + parse_operator_name; + srsym:=tsym(astruct.symtable.Find(sp)); + if assigned(srsym) then + begin + if srsym.typ=procsym then + aprocsym:=tprocsym(srsym) + else + if (srsym.typ=typesym) and + (ttypesym(srsym).typedef.typ in [objectdef,recorddef]) then + begin + searchagain:=true; + consume(_POINT); + end + else + begin + { we use a different error message for tp7 so it looks more compatible } + if (m_fpc in current_settings.modeswitches) then + Message1(parser_e_overloaded_no_procedure,srsym.realname) + else + Message(parser_e_methode_id_expected); + { rename the name to an unique name to avoid an + error when inserting the symbol in the symtable } + orgsp:=orgsp+'$'+tostr(current_filepos.line); + end; + end + else + begin + Message(parser_e_methode_id_expected); + { recover by making it a normal procedure instead of method } + astruct:=nil; + end; + end + else + Message(parser_e_class_id_expected); + until not searchagain; + end + else + begin + { check for constructor/destructor/class operators which are not allowed here } + if (not parse_only) and + ((potype in [potype_constructor,potype_destructor, + potype_class_constructor,potype_class_destructor]) or + ((potype=potype_operator) and (m_delphi in current_settings.modeswitches))) then + Message(parser_e_only_methods_allowed); + + repeat + searchagain:=false; + current_tokenpos:=procstartfilepos; + + if (potype=potype_operator)and(optoken=NOTOKEN) then + parse_operator_name; + + srsym:=tsym(symtablestack.top.Find(sp)); + + { Also look in the globalsymtable if we didn't found + the symbol in the localsymtable } + if not assigned(srsym) and + not(parse_only) and + (symtablestack.top=current_module.localsymtable) and + assigned(current_module.globalsymtable) then + srsym:=tsym(current_module.globalsymtable.Find(sp)); + + { Check if overloaded is a procsym } + if assigned(srsym) then + begin + if srsym.typ=procsym then + aprocsym:=tprocsym(srsym) + else + begin + { when the other symbol is a unit symbol then hide the unit + symbol, this is not supported in tp7 } + if not(m_tp7 in current_settings.modeswitches) and + (srsym.typ=unitsym) then + begin + HideSym(srsym); + searchagain:=true; + end + else + begin + { we use a different error message for tp7 so it looks more compatible } + if (m_fpc in current_settings.modeswitches) then + Message1(parser_e_overloaded_no_procedure,srsym.realname) + else + Message1(sym_e_duplicate_id,srsym.realname); + { rename the name to an unique name to avoid an + error when inserting the symbol in the symtable } + orgsp:=orgsp+'$'+tostr(current_filepos.line); + end; + end; + end; + until not searchagain; + end; + + { test again if assigned, it can be reset to recover } + if not assigned(aprocsym) then + begin + { create a new procsym and set the real filepos } + current_tokenpos:=procstartfilepos; + { for operator we have only one procsym for each overloaded + operation } + if (potype=potype_operator) then + begin + aprocsym:=Tprocsym(symtablestack.top.Find(sp)); + if aprocsym=nil then + aprocsym:=tprocsym.create('$'+sp); + end + else + if (potype in [potype_class_constructor,potype_class_destructor]) then + aprocsym:=tprocsym.create('$'+lower(sp)) + else + aprocsym:=tprocsym.create(orgsp); + symtablestack.top.insert(aprocsym); + end; + + { to get the correct symtablelevel we must ignore ObjectSymtables } + st:=nil; + checkstack:=symtablestack.stack; + while assigned(checkstack) do + begin + st:=checkstack^.symtable; + if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then + break; + checkstack:=checkstack^.next; + end; + pd:=tprocdef.create(st.symtablelevel+1); + pd.struct:=astruct; + pd.procsym:=aprocsym; + pd.proctypeoption:=potype; + + { methods inherit df_generic or df_specialization from the objectdef } + if assigned(pd.struct) and + (pd.parast.symtablelevel=normal_function_level) then + begin + if (df_generic in pd.struct.defoptions) then + begin + include(pd.defoptions,df_generic); + parse_generic:=true; + end; + if (df_specialization in pd.struct.defoptions) then + begin + include(pd.defoptions,df_specialization); + { Find corresponding genericdef, we need it later to + replay the tokens to generate the body } + if not assigned(pd.struct.genericdef) then + internalerror(200512113); + genericst:=pd.struct.genericdef.GetSymtable(gs_record); + if not assigned(genericst) then + internalerror(200512114); + { We are parsing the same objectdef, the def index numbers + are the same } + pd.genericdef:=tstoreddef(genericst.DefList[pd.owner.DefList.IndexOf(pd)]); + if not assigned(pd.genericdef) or + (pd.genericdef.typ<>procdef) then + internalerror(200512115); + end; + end; + + { methods need to be exported } + if assigned(astruct) and + ( + (symtablestack.top.symtabletype in [ObjectSymtable,recordsymtable]) or + (symtablestack.top.symtablelevel=main_program_level) + ) then + include(pd.procoptions,po_global); + + { symbol options that need to be kept per procdef } + pd.fileinfo:=procstartfilepos; + pd.visibility:=symtablestack.top.currentvisibility; + if symtablestack.top.currentlyoptional then + include(pd.procoptions,po_optional); + + { parse parameters } + if token=_LKLAMMER then + begin + { Add ObjectSymtable to be able to find nested type definitions } + popclass:=0; + if assigned(pd.struct) and + (pd.parast.symtablelevel>=normal_function_level) and + not(symtablestack.top.symtabletype in [ObjectSymtable,recordsymtable]) then + begin + popclass:=push_nested_hierarchy(pd.struct); + old_current_structdef:=current_structdef; + old_current_genericdef:=current_genericdef; + old_current_specializedef:=current_specializedef; + current_structdef:=pd.struct; + if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then + current_genericdef:=current_structdef; + if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then + current_specializedef:=current_structdef; + end; + { Add parameter symtable } + if pd.parast.symtabletype<>staticsymtable then + symtablestack.push(pd.parast); + parse_parameter_dec(pd); + if pd.parast.symtabletype<>staticsymtable then + symtablestack.pop(pd.parast); + if popclass>0 then + begin + current_structdef:=old_current_structdef; + current_genericdef:=old_current_genericdef; + current_specializedef:=old_current_specializedef; + dec(popclass,pop_nested_hierarchy(pd.struct)); + if popclass<>0 then + internalerror(201011260); // 11 nov 2010 index 0 + end; + end; + + parse_generic:=old_parse_generic; + result:=true; + end; + + + function parse_proc_dec(isclassmethod:boolean;astruct:tabstractrecorddef):tprocdef; + var + pd: tprocdef; + locationstr: string; + i: integer; + found: boolean; + + procedure read_returndef(pd: tprocdef); + var + popclass: integer; + old_parse_generic: boolean; + old_current_structdef: tabstractrecorddef; + old_current_genericdef, + old_current_specializedef: tstoreddef; + begin + old_parse_generic:=parse_generic; + { Add ObjectSymtable to be able to find generic type definitions } + popclass:=0; + if assigned(pd.struct) and + (pd.parast.symtablelevel>=normal_function_level) and + not (symtablestack.top.symtabletype in [ObjectSymtable,recordsymtable]) then + begin + popclass:=push_nested_hierarchy(pd.struct); + parse_generic:=(df_generic in pd.struct.defoptions); + old_current_structdef:=current_structdef; + old_current_genericdef:=current_genericdef; + old_current_specializedef:=current_specializedef; + current_structdef:=pd.struct; + if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then + current_genericdef:=current_structdef; + if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then + current_specializedef:=current_structdef; + end; + single_type(pd.returndef,[stoAllowSpecialization]); + + if is_dispinterface(pd.struct) and not is_automatable(pd.returndef) then + Message1(type_e_not_automatable,pd.returndef.typename); + + if popclass>0 then + begin + current_structdef:=old_current_structdef; + current_genericdef:=old_current_genericdef; + current_specializedef:=old_current_specializedef; + dec(popclass,pop_nested_hierarchy(pd.struct)); + if popclass<>0 then + internalerror(201012020); + end; + parse_generic:=old_parse_generic; + end; + + begin + locationstr:=''; + pd:=nil; + case token of + _FUNCTION : + begin + consume(_FUNCTION); + if parse_proc_head(astruct,potype_function,pd) then + begin + { pd=nil when it is a interface mapping } + if assigned(pd) then + begin + if try_to_consume(_COLON) then + begin + read_returndef(pd); + if (target_info.system in [system_m68k_amiga]) then + begin + if (idtoken=_LOCATION) then + begin + if po_explicitparaloc in pd.procoptions then + begin + consume(_LOCATION); + locationstr:=cstringpattern; + consume(_CSTRING); + end + else + { I guess this needs a new message... (KB) } + Message(parser_e_paraloc_all_paras); + end + else + begin + if po_explicitparaloc in pd.procoptions then + { assign default locationstr, if none specified } + { and we've arguments with explicit paraloc } + locationstr:='D0'; + end; + end; + + end + else + begin + if ( + parse_only and + not(is_interface(pd.struct)) + ) or + (m_repeat_forward in current_settings.modeswitches) then + begin + consume(_COLON); + consume_all_until(_SEMICOLON); + end; + end; + if isclassmethod then + include(pd.procoptions,po_classmethod); + end; + end + else + begin + { recover } + consume(_COLON); + consume_all_until(_SEMICOLON); + end; + end; + + _PROCEDURE : + begin + consume(_PROCEDURE); + if parse_proc_head(astruct,potype_procedure,pd) then + begin + { pd=nil when it is an interface mapping } + if assigned(pd) then + begin + pd.returndef:=voidtype; + if isclassmethod then + include(pd.procoptions,po_classmethod); + end; + end; + end; + + _CONSTRUCTOR : + begin + consume(_CONSTRUCTOR); + if isclassmethod then + parse_proc_head(astruct,potype_class_constructor,pd) + else + parse_proc_head(astruct,potype_constructor,pd); + if not isclassmethod and + assigned(pd) and + assigned(pd.struct) then + begin + { Set return type, class constructors return the + created instance, object constructors return boolean } + if is_class(pd.struct) or is_record(pd.struct) then + pd.returndef:=pd.struct + else +{$ifdef CPU64bitaddr} + pd.returndef:=bool64type; +{$else CPU64bitaddr} + pd.returndef:=bool32type; +{$endif CPU64bitaddr} + end + else + pd.returndef:=voidtype; + end; + + _DESTRUCTOR : + begin + consume(_DESTRUCTOR); + if isclassmethod then + parse_proc_head(astruct,potype_class_destructor,pd) + else + parse_proc_head(astruct,potype_destructor,pd); + if assigned(pd) then + pd.returndef:=voidtype; + end; + else + if (token=_OPERATOR) or + (isclassmethod and (idtoken=_OPERATOR)) then + begin + consume(_OPERATOR); + parse_proc_head(astruct,potype_operator,pd); + if assigned(pd) then + begin + { operators always need to be searched in all units } + include(pd.procoptions,po_overload); + if pd.parast.symtablelevel>normal_function_level then + Message(parser_e_no_local_operator); + if isclassmethod then + include(pd.procoptions,po_classmethod); + if token<>_ID then + begin + if not(m_result in current_settings.modeswitches) then + consume(_ID); + end + else + begin + pd.resultname:=stringdup(orgpattern); + consume(_ID); + end; + if not try_to_consume(_COLON) then + begin + consume(_COLON); + pd.returndef:=generrordef; + consume_all_until(_SEMICOLON); + end + else + begin + read_returndef(pd); + { check that class operators have either return type of structure or } + { at least one argument of that type } + if (po_classmethod in pd.procoptions) and + (pd.returndef <> pd.struct) then + begin + found:=false; + for i := 0 to pd.parast.SymList.Count - 1 do + if tparavarsym(pd.parast.SymList[i]).vardef=pd.struct then + begin + found:=true; + break; + end; + if not found then + if assigned(pd.struct) then + Message1(parser_e_at_least_one_argument_must_be_of_type,pd.struct.RttiName) + else + MessagePos(pd.fileinfo,type_e_type_id_expected); + end; + if (optoken in [_EQ,_NE,_GT,_LT,_GTE,_LTE,_OP_IN]) and + ((pd.returndef.typ<>orddef) or + (torddef(pd.returndef).ordtype<>pasbool8)) then + Message(parser_e_comparative_operator_return_boolean); + if (optoken in [_ASSIGNMENT,_OP_EXPLICIT]) and + equal_defs(pd.returndef,tparavarsym(pd.parast.SymList[0]).vardef) and + (pd.returndef.typ<>undefineddef) and (tparavarsym(pd.parast.SymList[0]).vardef.typ<>undefineddef) then + message(parser_e_no_such_assignment) + else if not isoperatoracceptable(pd,optoken) then + Message(parser_e_overload_impossible); + end; + end + else + begin + { recover } + try_to_consume(_ID); + consume(_COLON); + consume_all_until(_SEMICOLON); + end; + end; + end; + { file types can't be function results } + if assigned(pd) and + (pd.returndef.typ=filedef) then + message(parser_e_illegal_function_result); + { support procedure proc stdcall export; } + if not(check_proc_directive(false)) then + begin + if (token=_COLON) then + begin + message(parser_e_field_not_allowed_here); + consume_all_until(_SEMICOLON); + end; + consume(_SEMICOLON); + end; + result:=pd; + + if locationstr<>'' then + begin + if not(paramanager.parsefuncretloc(pd,upper(locationstr))) then + { I guess this needs a new message... (KB) } + message(parser_e_illegal_explicit_paraloc); + end; + end; + + +{**************************************************************************** + Procedure directive handlers +****************************************************************************} + +procedure pd_far(pd:tabstractprocdef); +begin + Message1(parser_w_proc_directive_ignored,'FAR'); +end; + +procedure pd_near(pd:tabstractprocdef); +begin + Message1(parser_w_proc_directive_ignored,'NEAR'); +end; + +procedure pd_export(pd:tabstractprocdef); +begin + if pd.typ<>procdef then + internalerror(200304264); + if assigned(tprocdef(pd).struct) then + Message(parser_e_methods_dont_be_export); + if pd.parast.symtablelevel>normal_function_level then + Message(parser_e_dont_nest_export); +end; + +procedure pd_forward(pd:tabstractprocdef); +begin + if pd.typ<>procdef then + internalerror(200304265); + tprocdef(pd).forwarddef:=true; +end; + + +procedure pd_alias(pd:tabstractprocdef); +begin + if pd.typ<>procdef then + internalerror(200304266); + consume(_COLON); + tprocdef(pd).aliasnames.insert(get_stringconst); + include(pd.procoptions,po_has_public_name); +end; + + +procedure pd_public(pd:tabstractprocdef); +begin + if pd.typ<>procdef then + internalerror(200304266); + if try_to_consume(_NAME) then + begin + tprocdef(pd).aliasnames.insert(get_stringconst); + include(pd.procoptions,po_has_public_name); + end; +end; + + +procedure pd_asmname(pd:tabstractprocdef); +begin + if pd.typ<>procdef then + internalerror(200304267); + if token=_CCHAR then + begin + tprocdef(pd).aliasnames.insert(target_info.Cprefix+pattern); + consume(_CCHAR) + end + else + begin + tprocdef(pd).aliasnames.insert(target_info.Cprefix+cstringpattern); + consume(_CSTRING); + end; + { we don't need anything else } + tprocdef(pd).forwarddef:=false; +end; + + +procedure pd_internconst(pd:tabstractprocdef); + +var v:Tconstexprint; + +begin + if pd.typ<>procdef then + internalerror(200304268); + consume(_COLON); + v:=get_intconst; + if (v<int64(low(longint))) or (v>int64(high(longint))) then + message(parser_e_range_check_error) + else + Tprocdef(pd).extnumber:=longint(v.svalue); +end; + + +procedure pd_internproc(pd:tabstractprocdef); + +var v:Tconstexprint; + +begin + if pd.typ<>procdef then + internalerror(200304268); + consume(_COLON); + v:=get_intconst; + if (v<int64(low(longint))) or (v>int64(high(longint))) then + message(parser_e_range_check_error) + else + Tprocdef(pd).extnumber:=longint(v.svalue); + { the proc is defined } + tprocdef(pd).forwarddef:=false; +end; + +procedure pd_interrupt(pd:tabstractprocdef); + +{$ifdef FPC_HAS_SYSTEMS_INTERRUPT_TABLE} +var v: Tconstexprint; +{$endif FPC_HAS_SYSTEMS_INTERRUPT_TABLE} + +begin + if pd.parast.symtablelevel>normal_function_level then + Message(parser_e_dont_nest_interrupt); + +{$ifdef FPC_HAS_SYSTEMS_INTERRUPT_TABLE} + if target_info.system in systems_interrupt_table then + begin + if token<>_SEMICOLON then + begin + pd.proccalloption:=pocall_interrupt; + v:=get_intconst; + Tprocdef(pd).interruptvector:=v.uvalue; + end; + end; +{$endif FPC_HAS_SYSTEMS_INTERRUPT_TABLE} +end; + +procedure pd_abstract(pd:tabstractprocdef); +begin + if pd.typ<>procdef then + internalerror(200304269); + if is_objectpascal_helper(tprocdef(pd).struct) then + Message1(parser_e_not_allowed_in_helper, arraytokeninfo[_ABSTRACT].str); + if assigned(tprocdef(pd).struct) and + (oo_is_sealed in tprocdef(pd).struct.objectoptions) then + Message(parser_e_sealed_class_cannot_have_abstract_methods) + else + if (po_virtualmethod in pd.procoptions) then + include(pd.procoptions,po_abstractmethod) + else + Message(parser_e_only_virtual_methods_abstract); + { the method is defined } + tprocdef(pd).forwarddef:=false; +end; + +procedure pd_final(pd:tabstractprocdef); +begin + if pd.typ<>procdef then + internalerror(200910170); + if is_objectpascal_helper(tprocdef(pd).struct) and + (m_objfpc in current_settings.modeswitches) then + Message1(parser_e_not_allowed_in_helper, arraytokeninfo[_FINAL].str); + if (po_virtualmethod in pd.procoptions) then + include(pd.procoptions,po_finalmethod) + else + Message(parser_e_only_virtual_methods_final); +end; + +procedure pd_enumerator(pd:tabstractprocdef); +begin + if pd.typ<>procdef then + internalerror(200910250); + if (token = _ID) then + begin + if pattern='MOVENEXT' then + begin + if oo_has_enumerator_movenext in tprocdef(pd).struct.objectoptions then + message(parser_e_only_one_enumerator_movenext); + pd.calcparas; + if (pd.proctypeoption = potype_function) and is_boolean(pd.returndef) and + (pd.minparacount = 0) then + begin + include(tprocdef(pd).struct.objectoptions, oo_has_enumerator_movenext); + include(pd.procoptions,po_enumerator_movenext); + end + else + Message(parser_e_enumerator_movenext_is_not_valid) + end + else + Message1(parser_e_invalid_enumerator_identifier, pattern); + consume(token); + end + else + Message(parser_e_enumerator_identifier_required); +end; + +procedure pd_virtual(pd:tabstractprocdef); +{$ifdef WITHDMT} +var + pt : tnode; +{$endif WITHDMT} +begin + if pd.typ<>procdef then + internalerror(2003042610); + if (pd.proctypeoption=potype_constructor) and + is_object(tprocdef(pd).struct) then + Message(parser_e_constructor_cannot_be_not_virtual); + if is_objectpascal_helper(tprocdef(pd).struct) and + (m_objfpc in current_settings.modeswitches) then + Message1(parser_e_not_allowed_in_helper, arraytokeninfo[_VIRTUAL].str); +{$ifdef WITHDMT} + if is_object(tprocdef(pd).struct) and + (token<>_SEMICOLON) then + begin + { any type of parameter is allowed here! } + pt:=comp_expr(true); + if is_constintnode(pt) then + begin + include(pd.procoptions,po_msgint); + pd.messageinf.i:=pt.value; + end + else + Message(parser_e_ill_msg_expr); + disposetree(pt); + end; +{$endif WITHDMT} +end; + + +procedure pd_dispid(pd:tabstractprocdef); + +var pt:Tnode; + +begin + if pd.typ<>procdef then + internalerror(200604301); + pt:=comp_expr(true,false); + if is_constintnode(pt) then + if (Tordconstnode(pt).value<int64(low(longint))) or (Tordconstnode(pt).value>int64(high(longint))) then + message(parser_e_range_check_error) + else + Tprocdef(pd).dispid:=Tordconstnode(pt).value.svalue + else + message(parser_e_dispid_must_be_ord_const); + pt.free; +end; + + +procedure pd_static(pd:tabstractprocdef); +begin + if pd.typ=procdef then + include(tprocdef(pd).procsym.symoptions,sp_static); + include(pd.procoptions,po_staticmethod); +end; + +procedure pd_override(pd:tabstractprocdef); +begin + if pd.typ<>procdef then + internalerror(2003042611); + if is_objectpascal_helper(tprocdef(pd).struct) then + begin + if m_objfpc in current_settings.modeswitches then + Message1(parser_e_not_allowed_in_helper, arraytokeninfo[_OVERRIDE].str) + end + else if not(is_class_or_interface_or_objc(tprocdef(pd).struct)) then + Message(parser_e_no_object_override) + else if is_objccategory(tprocdef(pd).struct) then + Message(parser_e_no_category_override) + else if not is_objc_class_or_protocol(tprocdef(pd).struct) and + not is_cppclass(tprocdef(pd).struct) and + (po_external in pd.procoptions) then + Message1(parser_e_proc_dir_conflict,'OVERRIDE'); +end; + +procedure pd_overload(pd:tabstractprocdef); +begin + if pd.typ<>procdef then + internalerror(2003042612); + include(tprocdef(pd).procsym.symoptions,sp_has_overloaded); +end; + +procedure pd_message(pd:tabstractprocdef); +var + pt : tnode; + paracnt : longint; +begin + if pd.typ<>procdef then + internalerror(2003042613); + if is_objectpascal_helper(tprocdef(pd).struct) then + begin + if m_objfpc in current_settings.modeswitches then + Message1(parser_e_not_allowed_in_helper, arraytokeninfo[_MESSAGE].str); + end + else + if not is_class(tprocdef(pd).struct) and + not is_objc_class_or_protocol(tprocdef(pd).struct) then + Message(parser_e_msg_only_for_classes); + if ([po_msgstr,po_msgint]*pd.procoptions)<>[] then + Message(parser_e_multiple_messages); + { check parameter type } + if not is_objc_class_or_protocol(tprocdef(pd).struct) then + begin + if po_external in pd.procoptions then + Message1(parser_e_proc_dir_conflict,'MESSAGE'); + paracnt:=0; + pd.parast.SymList.ForEachCall(@check_msg_para,@paracnt); + if paracnt<>1 then + Message(parser_e_ill_msg_param); + end; + pt:=comp_expr(true,false); + { message is 1-character long } + if is_constcharnode(pt) then + begin + include(pd.procoptions,po_msgstr); + tprocdef(pd).messageinf.str:=stringdup(chr(byte(tordconstnode(pt).value.uvalue and $FF))); + end + else if pt.nodetype=stringconstn then + begin + include(pd.procoptions,po_msgstr); + if (tstringconstnode(pt).len>255) then + Message(parser_e_message_string_too_long); + tprocdef(pd).messageinf.str:=stringdup(tstringconstnode(pt).value_str); + end + else + if is_constintnode(pt) and + (is_class(tprocdef(pd).struct) or + is_objectpascal_helper(tprocdef(pd).struct)) then + begin + include(pd.procoptions,po_msgint); + if (Tordconstnode(pt).value<int64(low(Tprocdef(pd).messageinf.i))) or + (Tordconstnode(pt).value>int64(high(Tprocdef(pd).messageinf.i))) then + message(parser_e_range_check_error) + else + Tprocdef(pd).messageinf.i:=tordconstnode(pt).value.svalue; + end + else + Message(parser_e_ill_msg_expr); + { check whether the selector name is valid in case of Objective-C } + if (po_msgstr in pd.procoptions) and + is_objc_class_or_protocol(tprocdef(pd).struct) and + not objcvalidselectorname(@tprocdef(pd).messageinf.str^[1],length(tprocdef(pd).messageinf.str^)) then + Message1(type_e_invalid_objc_selector_name,tprocdef(pd).messageinf.str^); + pt.free; +end; + + +procedure pd_reintroduce(pd:tabstractprocdef); +begin + if pd.typ<>procdef then + internalerror(200401211); + if is_objectpascal_helper(tprocdef(pd).struct) then + begin + if m_objfpc in current_settings.modeswitches then + Message1(parser_e_not_allowed_in_helper, arraytokeninfo[_REINTRODUCE].str); + end + else + if not(is_class_or_interface_or_object(tprocdef(pd).struct)) and + not(is_objccategory(tprocdef(pd).struct)) then + Message(parser_e_no_object_reintroduce); +end; + + +procedure pd_syscall(pd:tabstractprocdef); +{$if defined(powerpc) or defined(m68k)} +var + vs : tparavarsym; + sym : tsym; + symtable : TSymtable; + v: Tconstexprint; +{$endif defined(powerpc) or defined(m68k)} +begin + if (pd.typ<>procdef) and (target_info.system <> system_powerpc_amiga) then + internalerror(2003042614); + tprocdef(pd).forwarddef:=false; +{$ifdef m68k} + if target_info.system in [system_m68k_amiga] then + begin + include(pd.procoptions,po_syscall_legacy); + + if consume_sym(sym,symtable) then + begin + if (sym.typ=staticvarsym) and + ( + (tabstractvarsym(sym).vardef.typ=pointerdef) or + is_32bitint(tabstractvarsym(sym).vardef) + ) then + begin + tprocdef(pd).libsym:=sym; + if po_syscall_legacy in tprocdef(pd).procoptions then + begin + vs:=tparavarsym.create('$syscalllib',paranr_syscall_legacy,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para,vo_has_explicit_paraloc]); + paramanager.parseparaloc(vs,'A6'); + pd.parast.insert(vs); + end + end + else + Message(parser_e_32bitint_or_pointer_variable_expected); + end; + (paramanager as tm68kparamanager).create_funcretloc_info(pd,calleeside); + (paramanager as tm68kparamanager).create_funcretloc_info(pd,callerside); + + v:=get_intconst; + if (v<low(Tprocdef(pd).extnumber)) or (v>high(Tprocdef(pd).extnumber)) then + message(parser_e_range_check_error) + else + Tprocdef(pd).extnumber:=v.uvalue; + end; +{$endif m68k} +{$ifdef powerpc} + if target_info.system = system_powerpc_amiga then + begin + include(pd.procoptions,po_syscall_basesysv); + + if consume_sym(sym,symtable) then + begin + if (sym.typ=staticvarsym) and + ( + (tabstractvarsym(sym).vardef.typ=pointerdef) or + is_32bitint(tabstractvarsym(sym).vardef) + ) then + begin + tprocdef(pd).libsym:=sym; + vs:=tparavarsym.create('$syscalllib',paranr_syscall_basesysv,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para]); + pd.parast.insert(vs); + end + else + Message(parser_e_32bitint_or_pointer_variable_expected); + end; + + (paramanager as tppcparamanager).create_funcretloc_info(pd,calleeside); + (paramanager as tppcparamanager).create_funcretloc_info(pd,callerside); + + v:=get_intconst; + if (v<low(Tprocdef(pd).extnumber)) or (v>high(Tprocdef(pd).extnumber)) then + message(parser_e_range_check_error) + else + Tprocdef(pd).extnumber:=v.uvalue; + end else + + if target_info.system = system_powerpc_morphos then + begin + if idtoken=_LEGACY then + begin + consume(_LEGACY); + include(pd.procoptions,po_syscall_legacy); + end + else if idtoken=_SYSV then + begin + consume(_SYSV); + include(pd.procoptions,po_syscall_sysv); + end + else if idtoken=_BASESYSV then + begin + consume(_BASESYSV); + include(pd.procoptions,po_syscall_basesysv); + end + else if idtoken=_SYSVBASE then + begin + consume(_SYSVBASE); + include(pd.procoptions,po_syscall_sysvbase); + end + else if idtoken=_R12BASE then + begin + consume(_R12BASE); + include(pd.procoptions,po_syscall_r12base); + end + else + if syscall_convention='LEGACY' then + include(pd.procoptions,po_syscall_legacy) + else if syscall_convention='SYSV' then + include(pd.procoptions,po_syscall_sysv) + else if syscall_convention='BASESYSV' then + include(pd.procoptions,po_syscall_basesysv) + else if syscall_convention='SYSVBASE' then + include(pd.procoptions,po_syscall_sysvbase) + else if syscall_convention='R12BASE' then + include(pd.procoptions,po_syscall_r12base) + else + internalerror(2005010404); + + if consume_sym(sym,symtable) then + begin + if (sym.typ=staticvarsym) and + ( + (tabstractvarsym(sym).vardef.typ=pointerdef) or + is_32bitint(tabstractvarsym(sym).vardef) + ) then + begin + tprocdef(pd).libsym:=sym; + if po_syscall_legacy in tprocdef(pd).procoptions then + begin + vs:=tparavarsym.create('$syscalllib',paranr_syscall_legacy,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para,vo_has_explicit_paraloc]); + paramanager.parseparaloc(vs,'A6'); + pd.parast.insert(vs); + end + else if po_syscall_sysv in tprocdef(pd).procoptions then + begin + { Nothing to be done for sysv here for now, but this might change } + end + else if po_syscall_basesysv in tprocdef(pd).procoptions then + begin + vs:=tparavarsym.create('$syscalllib',paranr_syscall_basesysv,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para]); + pd.parast.insert(vs); + end + else if po_syscall_sysvbase in tprocdef(pd).procoptions then + begin + vs:=tparavarsym.create('$syscalllib',paranr_syscall_sysvbase,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para]); + pd.parast.insert(vs); + end + else if po_syscall_r12base in tprocdef(pd).procoptions then + begin + vs:=tparavarsym.create('$syscalllib',paranr_syscall_r12base,vs_value,tabstractvarsym(sym).vardef,[vo_is_syscall_lib,vo_is_hidden_para,vo_has_explicit_paraloc]); + paramanager.parseparaloc(vs,'R12'); + pd.parast.insert(vs); + end + else + internalerror(2005010501); + end + else + Message(parser_e_32bitint_or_pointer_variable_expected); + end; + (paramanager as tppcparamanager).create_funcretloc_info(pd,calleeside); + (paramanager as tppcparamanager).create_funcretloc_info(pd,callerside); + + v:=get_intconst; + if (v<low(Tprocdef(pd).extnumber)) or (v>high(Tprocdef(pd).extnumber)) then + message(parser_e_range_check_error) + else + Tprocdef(pd).extnumber:=v.uvalue; + end; +{$endif powerpc} +end; + + +procedure pd_external(pd:tabstractprocdef); +{ + If import_dll=nil the procedure is assumed to be in another + object file. In that object file it should have the name to + which import_name is pointing to. Otherwise, the procedure is + assumed to be in the DLL to which import_dll is pointing to. In + that case either import_nr<>0 or import_name<>nil is true, so + the procedure is either imported by number or by name. (DM) +} +var + hs : string; + v:Tconstexprint; + +begin + if pd.typ<>procdef then + internalerror(2003042615); + with tprocdef(pd) do + begin + forwarddef:=false; + { forbid local external procedures } + if parast.symtablelevel>normal_function_level then + Message(parser_e_no_local_proc_external); + { If the procedure should be imported from a DLL, a constant string follows. + This isn't really correct, an contant string expression follows + so we check if an semicolon follows, else a string constant have to + follow (FK) } + if not(token=_SEMICOLON) and not(idtoken=_NAME) then + begin + { Always add library prefix and suffix to create an uniform name } + hs:=get_stringconst; + if ExtractFileExt(hs)='' then + hs:=ChangeFileExt(hs,target_info.sharedlibext); + if Copy(hs,1,length(target_info.sharedlibprefix))<>target_info.sharedlibprefix then + hs:=target_info.sharedlibprefix+hs; + import_dll:=stringdup(hs); + include(procoptions,po_has_importdll); + if (idtoken=_NAME) then + begin + consume(_NAME); + import_name:=stringdup(get_stringconst); + include(procoptions,po_has_importname); + if import_name^='' then + message(parser_e_empty_import_name); + end; + if (idtoken=_INDEX) then + begin + {After the word index follows the index number in the DLL.} + consume(_INDEX); + v:=get_intconst; + if (v<int64(low(import_nr))) or (v>int64(high(import_nr))) then + message(parser_e_range_check_error) + else + import_nr:=longint(v.svalue); + end; + { default is to used the realname of the procedure } + if (import_nr=0) and not assigned(import_name) then + begin + import_name:=stringdup(procsym.realname); + include(procoptions,po_has_importname); + end; + end + else + begin + if (idtoken=_NAME) then + begin + consume(_NAME); + import_name:=stringdup(get_stringconst); + include(procoptions,po_has_importname); + if import_name^='' then + message(parser_e_empty_import_name); + end; + end; + end; +end; + + +procedure pd_weakexternal(pd:tabstractprocdef); +begin + if not(target_info.system in systems_weak_linking) then + message(parser_e_weak_external_not_supported) + else + pd_external(pd); +end; + + +type + pd_handler=procedure(pd:tabstractprocdef); + proc_dir_rec=record + idtok : ttoken; + pd_flags : tpdflags; + handler : pd_handler; + pocall : tproccalloption; + pooption : tprocoptions; + mutexclpocall : tproccalloptions; + mutexclpotype : tproctypeoptions; + mutexclpo : tprocoptions; + end; +const + {Should contain the number of procedure directives we support.} + num_proc_directives=43; + proc_direcdata:array[1..num_proc_directives] of proc_dir_rec= + ( + ( + idtok:_ABSTRACT; + pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_notrecord]; + handler : @pd_abstract; + pocall : pocall_none; + pooption : [po_abstractmethod]; + mutexclpocall : [pocall_internproc]; + mutexclpotype : []; + mutexclpo : [po_exports,po_interrupt,po_external,po_inline] + ),( + idtok:_ALIAS; + pd_flags : [pd_implemen,pd_body,pd_notobjintf]; + handler : @pd_alias; + pocall : pocall_none; + pooption : []; + mutexclpocall : []; + mutexclpotype : []; + mutexclpo : [po_external,po_inline] + ),( + idtok:_ASMNAME; + pd_flags : [pd_interface,pd_implemen,pd_notobjintf]; + handler : @pd_asmname; + pocall : pocall_cdecl; + pooption : [po_external]; + mutexclpocall : [pocall_internproc]; + mutexclpotype : []; + mutexclpo : [po_external,po_inline] + ),( + idtok:_ASSEMBLER; + pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobjintf]; + handler : nil; + pocall : pocall_none; + pooption : [po_assembler]; + mutexclpocall : []; + mutexclpotype : []; + mutexclpo : [po_external] + ),( + idtok:_C; {same as cdecl for mode mac} + pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar]; + handler : nil; + pocall : pocall_cdecl; + pooption : []; + mutexclpocall : []; + mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_assembler,po_external] + ),( + idtok:_CDECL; + pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar]; + handler : nil; + pocall : pocall_cdecl; + pooption : []; + mutexclpocall : []; + mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_assembler,po_external] + ),( + idtok:_DISPID; + pd_flags : [pd_dispinterface]; + handler : @pd_dispid; + pocall : pocall_none; + pooption : [po_dispid]; + mutexclpocall : [pocall_internproc]; + mutexclpotype : [potype_constructor,potype_destructor,potype_operator,potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_interrupt,po_external,po_inline] + ),( + idtok:_DYNAMIC; + pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_notrecord]; + handler : @pd_virtual; + pocall : pocall_none; + pooption : [po_virtualmethod]; + mutexclpocall : [pocall_internproc]; + mutexclpotype : [potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_exports,po_interrupt,po_external,po_overridingmethod,po_inline] + ),( + idtok:_EXPORT; + pd_flags : [pd_body,pd_interface,pd_implemen,pd_notobjintf,pd_notrecord,pd_nothelper]; + handler : @pd_export; + pocall : pocall_none; + pooption : [po_exports,po_global]; + mutexclpocall : [pocall_internproc]; + mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_external,po_interrupt,po_inline] + ),( + idtok:_EXTERNAL; + pd_flags : [pd_implemen,pd_interface,pd_notobject,pd_notobjintf,pd_cppobject,pd_notrecord,pd_nothelper]; + handler : @pd_external; + pocall : pocall_none; + pooption : [po_external]; + mutexclpocall : [pocall_internproc,pocall_syscall]; + { allowed for external cpp classes } + mutexclpotype : [{potype_constructor,potype_destructor}potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_public,po_exports,po_interrupt,po_assembler,po_inline] + ),( + idtok:_FAR; + pd_flags : [pd_implemen,pd_body,pd_interface,pd_procvar,pd_notobject,pd_notobjintf,pd_notrecord,pd_nothelper]; + handler : @pd_far; + pocall : pocall_none; + pooption : []; + mutexclpocall : [pocall_internproc]; + mutexclpotype : []; + mutexclpo : [po_inline] + ),( + idtok:_FAR16; + pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar,pd_notobject,pd_notrecord,pd_nothelper]; + handler : nil; + pocall : pocall_far16; + pooption : []; + mutexclpocall : []; + mutexclpotype : []; + mutexclpo : [po_external] + ),( + idtok:_FINAL; + pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_notrecord]; + handler : @pd_final; + pocall : pocall_none; + pooption : [po_finalmethod]; + mutexclpocall : [pocall_internproc]; + mutexclpotype : []; + mutexclpo : [po_exports,po_interrupt,po_external,po_inline] + ),( + idtok:_FORWARD; + pd_flags : [pd_implemen,pd_notobject,pd_notobjintf,pd_notrecord,pd_nothelper]; + handler : @pd_forward; + pocall : pocall_none; + pooption : []; + mutexclpocall : [pocall_internproc]; + mutexclpotype : []; + mutexclpo : [po_external,po_inline] + ),( + idtok:_OLDFPCCALL; + pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar]; + handler : nil; + pocall : pocall_oldfpccall; + pooption : []; + mutexclpocall : []; + mutexclpotype : []; + mutexclpo : [] + ),( + idtok:_INLINE; + pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobjintf]; + handler : nil; + pocall : pocall_none; + pooption : [po_inline]; + mutexclpocall : []; + mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_exports,po_external,po_interrupt,po_virtualmethod] + ),( + idtok:_INTERNCONST; + pd_flags : [pd_interface,pd_body,pd_notobject,pd_notobjintf,pd_notrecord,pd_nothelper]; + handler : @pd_internconst; + pocall : pocall_none; + pooption : [po_internconst]; + mutexclpocall : []; + mutexclpotype : [potype_operator]; + mutexclpo : [] + ),( + idtok:_INTERNPROC; + pd_flags : [pd_interface,pd_notobject,pd_notobjintf,pd_notrecord,pd_nothelper]; + handler : @pd_internproc; + pocall : pocall_internproc; + pooption : []; + mutexclpocall : []; + mutexclpotype : [potype_constructor,potype_destructor,potype_operator,potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_exports,po_external,po_interrupt,po_assembler,po_iocheck,po_virtualmethod] + ),( + idtok:_INTERRUPT; + pd_flags : [pd_implemen,pd_body,pd_notobject,pd_notobjintf,pd_notrecord,pd_nothelper]; + handler : @pd_interrupt; + pocall : pocall_oldfpccall; + pooption : [po_interrupt]; + mutexclpocall : [pocall_internproc,pocall_cdecl,pocall_cppdecl,pocall_stdcall, + pocall_pascal,pocall_far16,pocall_oldfpccall]; + mutexclpotype : [potype_constructor,potype_destructor,potype_operator,potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_external,po_inline] + ),( + idtok:_IOCHECK; + pd_flags : [pd_implemen,pd_body,pd_notobjintf]; + handler : nil; + pocall : pocall_none; + pooption : [po_iocheck]; + mutexclpocall : [pocall_internproc]; + mutexclpotype : []; + mutexclpo : [po_external] + ),( + idtok:_LOCAL; + pd_flags : [pd_implemen,pd_body]; + handler : nil; + pocall : pocall_none; + pooption : [po_kylixlocal]; + mutexclpocall : [pocall_internproc,pocall_far16]; + mutexclpotype : []; + mutexclpo : [po_external,po_exports] + ),( + idtok:_MESSAGE; + pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass,pd_objcprot,pd_notrecord]; + handler : @pd_message; + pocall : pocall_none; + pooption : []; { can be po_msgstr or po_msgint } + mutexclpocall : [pocall_internproc]; + mutexclpotype : [potype_constructor,potype_destructor,potype_operator,potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_interrupt,po_inline] + ),( + idtok:_MWPASCAL; + pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar]; + handler : nil; + pocall : pocall_mwpascal; + pooption : []; + mutexclpocall : []; + mutexclpotype : []; + mutexclpo : [] + ),( + idtok:_NEAR; + pd_flags : [pd_implemen,pd_body,pd_procvar,pd_notobjintf,pd_notrecord,pd_nothelper]; + handler : @pd_near; + pocall : pocall_none; + pooption : []; + mutexclpocall : [pocall_internproc]; + mutexclpotype : []; + mutexclpo : [] + ),( + idtok:_NOSTACKFRAME; + pd_flags : [pd_implemen,pd_body,pd_procvar,pd_notobjintf]; + handler : nil; + pocall : pocall_none; + pooption : [po_nostackframe]; + mutexclpocall : [pocall_internproc]; + mutexclpotype : []; + mutexclpo : [] + ),( + idtok:_OVERLOAD; + pd_flags : [pd_implemen,pd_interface,pd_body]; + handler : @pd_overload; + pocall : pocall_none; + pooption : [po_overload]; + mutexclpocall : [pocall_internproc]; + mutexclpotype : []; + mutexclpo : [] + ),( + idtok:_OVERRIDE; + pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass,pd_notrecord]; + handler : @pd_override; + pocall : pocall_none; + pooption : [po_overridingmethod,po_virtualmethod]; + mutexclpocall : [pocall_internproc]; + mutexclpotype : []; + mutexclpo : [po_exports,po_interrupt,po_virtualmethod,po_inline] + ),( + idtok:_PASCAL; + pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar]; + handler : nil; + pocall : pocall_pascal; + pooption : []; + mutexclpocall : []; + mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_external] + ),( + idtok:_PUBLIC; + pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobject,pd_notobjintf,pd_notrecord,pd_nothelper]; + handler : @pd_public; + pocall : pocall_none; + pooption : [po_public,po_global]; + mutexclpocall : [pocall_internproc]; + mutexclpotype : []; + mutexclpo : [po_external,po_inline] + ),( + idtok:_REGISTER; + pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar]; + handler : nil; + pocall : pocall_register; + pooption : []; + mutexclpocall : []; + mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_external] + ),( + idtok:_REINTRODUCE; + pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_objcclass,pd_notrecord]; + handler : @pd_reintroduce; + pocall : pocall_none; + pooption : [po_reintroduce]; + mutexclpocall : [pocall_internproc]; + mutexclpotype : []; + mutexclpo : [po_external,po_interrupt,po_exports,po_overridingmethod,po_inline] + ),( + idtok:_SAFECALL; + pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar]; + handler : nil; + pocall : pocall_safecall; + pooption : []; + mutexclpocall : []; + mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_external] + ),( + idtok:_SOFTFLOAT; + pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar]; + handler : nil; + pocall : pocall_softfloat; + pooption : []; + mutexclpocall : []; + mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor]; + { it's available with po_external because the libgcc floating point routines on the arm + uses this calling convention } + mutexclpo : [] + ),( + idtok:_STATIC; + pd_flags : [pd_interface,pd_implemen,pd_body,pd_object,pd_record,pd_notobjintf]; + handler : @pd_static; + pocall : pocall_none; + pooption : [po_staticmethod]; + mutexclpocall : [pocall_internproc]; + mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_external,po_interrupt,po_exports] + ),( + idtok:_STDCALL; + pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar]; + handler : nil; + pocall : pocall_stdcall; + pooption : []; + mutexclpocall : []; + mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_external] + ),( + idtok:_SYSCALL; + { Different kind of syscalls are valid for AOS68k, AOSPPC and MOS. } + { FIX ME!!! MorphOS/AOS68k pd_flags should be: + pd_interface, pd_implemen, pd_notobject, pd_notobjintf (KB) } + pd_flags : [pd_interface,pd_implemen,pd_procvar]; + handler : @pd_syscall; + pocall : pocall_syscall; + pooption : []; + mutexclpocall : []; + mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_external,po_assembler,po_interrupt,po_exports] + ),( + idtok:_VIRTUAL; + pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_notrecord]; + handler : @pd_virtual; + pocall : pocall_none; + pooption : [po_virtualmethod]; + mutexclpocall : [pocall_internproc]; + mutexclpotype : [potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_external,po_interrupt,po_exports,po_overridingmethod,po_inline] + ),( + idtok:_CPPDECL; + pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar]; + handler : nil; + pocall : pocall_cppdecl; + pooption : []; + mutexclpocall : []; + mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_assembler,po_external,po_virtualmethod] + ),( + idtok:_VARARGS; + pd_flags : [pd_interface,pd_implemen,pd_procvar,pd_objcclass,pd_objcprot]; + handler : nil; + pocall : pocall_none; + pooption : [po_varargs]; + mutexclpocall : [pocall_internproc,pocall_stdcall,pocall_register, + pocall_far16,pocall_oldfpccall,pocall_mwpascal]; + mutexclpotype : []; + mutexclpo : [po_assembler,po_interrupt,po_inline] + ),( + idtok:_COMPILERPROC; + pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobjintf]; + handler : nil; + pocall : pocall_none; + pooption : [po_compilerproc]; + mutexclpocall : []; + mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_interrupt] + ),( + idtok:_WEAKEXTERNAL; + pd_flags : [pd_implemen,pd_interface,pd_notobject,pd_notobjintf,pd_cppobject,pd_notrecord,pd_nothelper]; + handler : @pd_weakexternal; + pocall : pocall_none; + { mark it both external and weak external, so we don't have to + adapt all code for external symbols to also check for weak external + } + pooption : [po_external,po_weakexternal]; + mutexclpocall : [pocall_internproc,pocall_syscall]; + { allowed for external cpp classes } + mutexclpotype : [{potype_constructor,potype_destructor}potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_public,po_exports,po_interrupt,po_assembler,po_inline] + ),( + idtok:_ENUMERATOR; + pd_flags : [pd_interface,pd_object,pd_record]; + handler : @pd_enumerator; + pocall : pocall_none; + pooption : []; + mutexclpocall : [pocall_internproc]; + mutexclpotype : []; + mutexclpo : [po_exports,po_interrupt,po_external,po_inline] + ),( + idtok:_RTLPROC; + pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobjintf]; + handler : nil; + pocall : pocall_none; + pooption : [po_rtlproc]; + mutexclpocall : []; + mutexclpotype : [potype_constructor,potype_destructor,potype_class_constructor,potype_class_destructor]; + mutexclpo : [po_interrupt] + ) + ); + + + function check_proc_directive(isprocvar:boolean):boolean; + var + i : longint; + begin + result:=false; + for i:=1 to num_proc_directives do + if proc_direcdata[i].idtok=idtoken then + begin + if ((not isprocvar) or + (pd_procvar in proc_direcdata[i].pd_flags)) and + { don't eat a public directive in classes } + not((idtoken=_PUBLIC) and (symtablestack.top.symtabletype=ObjectSymtable)) then + result:=true; + exit; + end; + end; + + + function parse_proc_direc(pd:tabstractprocdef;var pdflags:tpdflags):boolean; + { + Parse the procedure directive, returns true if a correct directive is found + } + var + p : longint; + found : boolean; + name : TIDString; + begin + parse_proc_direc:=false; + name:=tokeninfo^[idtoken].str; + found:=false; + + { Hint directive? Then exit immediatly } + if (m_hintdirective in current_settings.modeswitches) then + begin + case idtoken of + _LIBRARY, + _PLATFORM, + _UNIMPLEMENTED, + _EXPERIMENTAL, + _DEPRECATED : + exit; + end; + end; + + { C directive is MacPas only, because it breaks too much existing code + on other platforms (PFV) } + if (idtoken=_C) and + not(m_mac in current_settings.modeswitches) then + exit; + + { retrieve data for directive if found } + for p:=1 to num_proc_directives do + if proc_direcdata[p].idtok=idtoken then + begin + found:=true; + break; + end; + + { Check if the procedure directive is known } + if not found then + begin + { parsing a procvar type the name can be any + next variable !! } + if ((pdflags * [pd_procvar,pd_object,pd_record,pd_objcclass,pd_objcprot])=[]) and + not(idtoken=_PROPERTY) then + Message1(parser_w_unknown_proc_directive_ignored,name); + exit; + end; + + { check if method and directive not for object, like public. + This needs to be checked also for procvars } + if (pd_notobject in proc_direcdata[p].pd_flags) and + (symtablestack.top.symtabletype=ObjectSymtable) and + { directive allowed for cpp classes? } + not(is_cppclass(tdef(symtablestack.top.defowner)) and (pd_cppobject in proc_direcdata[p].pd_flags)) then + exit; + + if (pd_notrecord in proc_direcdata[p].pd_flags) and + (symtablestack.top.symtabletype=recordsymtable) then + exit; + + { Conflicts between directives ? } + if (pd.proctypeoption in proc_direcdata[p].mutexclpotype) or + (pd.proccalloption in proc_direcdata[p].mutexclpocall) or + ((pd.procoptions*proc_direcdata[p].mutexclpo)<>[]) then + begin + Message1(parser_e_proc_dir_conflict,name); + exit; + end; + + { set calling convention } + if proc_direcdata[p].pocall<>pocall_none then + begin + if (po_hascallingconvention in pd.procoptions) then + begin + Message2(parser_w_proc_overriding_calling, + proccalloptionStr[pd.proccalloption], + proccalloptionStr[proc_direcdata[p].pocall]); + end; + { check if the target processor supports this calling convention } + if not(proc_direcdata[p].pocall in supported_calling_conventions) then + begin + Message1(parser_e_illegal_calling_convention,proccalloptionStr[proc_direcdata[p].pocall]); + { recover } + proc_direcdata[p].pocall:=pocall_stdcall; + end; + pd.proccalloption:=proc_direcdata[p].pocall; + include(pd.procoptions,po_hascallingconvention); + end; + + if pd.typ=procdef then + begin + { Check if the directive is only for objects } + if (pd_object in proc_direcdata[p].pd_flags) and + not assigned(tprocdef(pd).struct) then + exit; + + { Check if the directive is only for records } + if (pd_record in proc_direcdata[p].pd_flags) and + not assigned(tprocdef(pd).struct) then + exit; + + { check if method and directive not for interface } + if (pd_notobjintf in proc_direcdata[p].pd_flags) and + is_interface(tprocdef(pd).struct) then + exit; + + { check if method and directive not for interface } + if is_dispinterface(tprocdef(pd).struct) and + not(pd_dispinterface in proc_direcdata[p].pd_flags) then + exit; + + { check if method and directive not for objcclass } + if is_objcclass(tprocdef(pd).struct) and + not(pd_objcclass in proc_direcdata[p].pd_flags) then + exit; + + { check if method and directive not for objcprotocol } + if is_objcprotocol(tprocdef(pd).struct) and + not(pd_objcprot in proc_direcdata[p].pd_flags) then + exit; + + { check if method and directive not for record/class helper } + if is_objectpascal_helper(tprocdef(pd).struct) and + (pd_nothelper in proc_direcdata[p].pd_flags) then + exit; + + end; + + { consume directive, and turn flag on } + consume(token); + parse_proc_direc:=true; + + { Check the pd_flags if the directive should be allowed } + if (pd_interface in pdflags) and + not(pd_interface in proc_direcdata[p].pd_flags) then + begin + Message1(parser_e_proc_dir_not_allowed_in_interface,name); + exit; + end; + if (pd_implemen in pdflags) and + not(pd_implemen in proc_direcdata[p].pd_flags) then + begin + Message1(parser_e_proc_dir_not_allowed_in_implementation,name); + exit; + end; + if (pd_procvar in pdflags) and + not(pd_procvar in proc_direcdata[p].pd_flags) then + begin + Message1(parser_e_proc_dir_not_allowed_in_procvar,name); + exit; + end; + + { Return the new pd_flags } + if not(pd_body in proc_direcdata[p].pd_flags) then + exclude(pdflags,pd_body); + + { Add the correct flag } + pd.procoptions:=pd.procoptions+proc_direcdata[p].pooption; + + { Call the handler } + if pointer(proc_direcdata[p].handler)<>nil then + proc_direcdata[p].handler(pd); + end; + + + + function proc_get_importname(pd:tprocdef):string; + var + dllname, importname : string; + + begin + result:=''; + if not(po_external in pd.procoptions) then + internalerror(200412151); + { external name or number is specified } + if assigned(pd.import_name) or (pd.import_nr<>0) then + begin + if assigned(pd.import_dll) then + dllname:=pd.import_dll^ + else + dllname:=''; + if assigned(pd.import_name) then + importname:=pd.import_name^ + else + importname:=''; + proc_get_importname:=make_dllmangledname(dllname, + importname,pd.import_nr,pd.proccalloption); + end + else + begin + { Default names when importing variables } + case pd.proccalloption of + pocall_cdecl : + begin + if assigned(pd.struct) then + result:=target_info.Cprefix+pd.struct.objrealname^+'_'+pd.procsym.realname + else + result:=target_info.Cprefix+pd.procsym.realname; + end; + pocall_cppdecl : + begin + result:=target_info.Cprefix+pd.cplusplusmangledname; + end; + else + begin + {In MacPas a single "external" has the same effect as "external name 'xxx'" } + { but according to MacPas mode description + Cprefix should still be used PM } + if (m_mac in current_settings.modeswitches) then + result:=target_info.Cprefix+tprocdef(pd).procsym.realname; + end; + end; + end; + end; + + + procedure proc_set_mangledname(pd:tprocdef); + var + s : string; + begin + { When the mangledname is already set we aren't allowed to change + it because it can already be used somewhere (PFV) } + if not(po_has_mangledname in pd.procoptions) then + begin + if (po_external in pd.procoptions) then + begin + { External Procedures are only allowed to change the mangledname + in their first declaration } + if (pd.forwarddef or (not pd.hasforward)) then + begin + s:=proc_get_importname(pd); + if s<>'' then + begin + pd.setmangledname(s); + end; + end; + end + else + { Normal procedures } + begin + if (po_compilerproc in pd.procoptions) then + begin + pd.setmangledname(lower(pd.procsym.name)); + end; + end; + end; + + { Public/exported alias names } + if (([po_public,po_exports]*pd.procoptions)<>[]) and + not(po_has_public_name in pd.procoptions) then + begin + case pd.proccalloption of + pocall_cdecl : + begin + if assigned(pd.struct) then + pd.aliasnames.insert(target_info.Cprefix+pd.struct.objrealname^+'_'+pd.procsym.realname) + else + begin + { Export names are not mangled on Windows and OS/2, see also pexports.pas } + if (target_info.system in (systems_all_windows+[system_i386_emx, system_i386_os2])) and + (po_exports in pd.procoptions) then + pd.aliasnames.insert(pd.procsym.realname) + else + pd.aliasnames.insert(target_info.Cprefix+pd.procsym.realname); + end; + end; + pocall_cppdecl : + begin + pd.aliasnames.insert(target_info.Cprefix+pd.cplusplusmangledname); + end; + end; + { prevent adding the alias a second time } + include(pd.procoptions,po_has_public_name); + end; + end; + + + procedure handle_calling_convention(pd:tabstractprocdef); + begin + { set the default calling convention if none provided } + if (pd.typ=procdef) and + (is_objc_class_or_protocol(tprocdef(pd).struct) or + is_cppclass(tprocdef(pd).struct)) then + begin + { none of the explicit calling conventions should be allowed } + if (po_hascallingconvention in pd.procoptions) then + internalerror(2009032501); + if is_cppclass(tprocdef(pd).struct) then + pd.proccalloption:=pocall_cppdecl + else + pd.proccalloption:=pocall_cdecl; + end + else if not(po_hascallingconvention in pd.procoptions) then + pd.proccalloption:=current_settings.defproccall + else + begin + if pd.proccalloption=pocall_none then + internalerror(200309081); + end; + + { handle proccall specific settings } + case pd.proccalloption of + pocall_cdecl, + pocall_cppdecl : + begin + { check C cdecl para types } + check_c_para(pd); + end; + pocall_far16 : + begin + { Temporary stub, must be rewritten to support OS/2 far16 } + Message1(parser_w_proc_directive_ignored,'FAR16'); + end; + end; + + { Inlining is enabled and supported? } + if (po_inline in pd.procoptions) and + not(cs_do_inline in current_settings.localswitches) then + begin + { Give an error if inline is not supported by the compiler mode, + otherwise only give a warning that this procedure will not be inlined } + if not(m_default_inline in current_settings.modeswitches) then + Message(parser_e_proc_inline_not_supported) + else + Message(parser_w_inlining_disabled); + exclude(pd.procoptions,po_inline); + end; + + { For varargs directive also cdecl and external must be defined } + if (po_varargs in pd.procoptions) then + begin + { check first for external in the interface, if available there + then the cdecl must also be there since there is no implementation + available to contain it } + if parse_only then + begin + { if external is available, then cdecl must also be available, + procvars don't need external } + if not((po_external in pd.procoptions) or + (pd.typ=procvardef) or + { for objcclasses this is checked later, because the entire + class may be external. } + is_objc_class_or_protocol(tprocdef(pd).struct)) and + not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal])) then + Message(parser_e_varargs_need_cdecl_and_external); + end + else + begin + { both must be defined now } + if not((po_external in pd.procoptions) or + (pd.typ=procvardef)) or + not(pd.proccalloption in (cdecl_pocalls + [pocall_mwpascal])) then + Message(parser_e_varargs_need_cdecl_and_external); + end; + end; + + { insert hidden high parameters } + pd.parast.SymList.ForEachCall(@insert_hidden_para,pd); + + { insert hidden self parameter } + insert_self_and_vmt_para(pd); + + { insert funcret parameter if required } + insert_funcret_para(pd); + + { Make var parameters regable, this must be done after the calling + convention is set. } + { this must be done before parentfp is insert, because getting all cases + where parentfp must be in a memory location isn't catched properly so + we put parentfp never in a register } + pd.parast.SymList.ForEachCall(@set_addr_param_regable,pd); + + { insert parentfp parameter if required } + insert_parentfp_para(pd); + + { Calculate parameter tlist } + pd.calcparas; + end; + + + procedure parse_proc_directives(pd:tabstractprocdef;var pdflags:tpdflags); + { + Parse the procedure directives. It does not matter if procedure directives + are written using ;procdir; or ['procdir'] syntax. + } + var + res : boolean; + begin + if (m_mac in current_settings.modeswitches) and (cs_externally_visible in current_settings.localswitches) then + begin + tprocdef(pd).aliasnames.insert(target_info.Cprefix+tprocdef(pd).procsym.realname); + include(pd.procoptions,po_public); + include(pd.procoptions,po_has_public_name); + include(pd.procoptions,po_global); + end; + + { methods from external class definitions are all external themselves } + if (pd.typ=procdef) and + assigned(tprocdef(pd).struct) and + (tprocdef(pd).struct.typ=objectdef) and + (oo_is_external in tobjectdef(tprocdef(pd).struct).objectoptions) then + tprocdef(pd).make_external; + + { Class constructors and destructor are static class methods in real. } + { There are many places in the compiler where either class or static } + { method flag changes the behavior. It is simplier to add them to } + { the class constructors/destructors options than to fix all the } + { occurencies. (Paul) } + if pd.proctypeoption in [potype_class_constructor,potype_class_destructor] then + begin + include(pd.procoptions,po_classmethod); + include(pd.procoptions,po_staticmethod); + end; + + while token in [_ID,_LECKKLAMMER] do + begin + if try_to_consume(_LECKKLAMMER) then + begin + repeat + parse_proc_direc(pd,pdflags); + until not try_to_consume(_COMMA); + consume(_RECKKLAMMER); + { we always expect at least '[];' } + res:=true; + end + else + begin + res:=parse_proc_direc(pd,pdflags); + end; + { A procedure directive normally followed by a semicolon, but in + a const section or reading a type we should stop when _EQ is found, + because a constant/default value follows } + if res then + begin + if (block_type=bt_const_type) and + (token=_EQ) then + break; + { support procedure proc;stdcall export; } + if not(check_proc_directive((pd.typ=procvardef))) then + begin + { support "record p : procedure stdcall end;" and + "var p : procedure stdcall = nil;" } + if (pd_procvar in pdflags) and + (token in [_END,_RKLAMMER,_EQ]) then + break + else + begin + if (token=_COLON) then + begin + Message(parser_e_field_not_allowed_here); + consume_all_until(_SEMICOLON); + end; + consume(_SEMICOLON) + end; + end; + end + else + break; + end; + end; + + + procedure parse_var_proc_directives(sym:tsym); + var + pdflags : tpdflags; + pd : tabstractprocdef; + begin + pdflags:=[pd_procvar]; + pd:=nil; + case sym.typ of + fieldvarsym, + staticvarsym, + localvarsym, + paravarsym : + pd:=tabstractprocdef(tabstractvarsym(sym).vardef); + typesym : + pd:=tabstractprocdef(ttypesym(sym).typedef); + else + internalerror(2003042617); + end; + if pd.typ<>procvardef then + internalerror(2003042618); + { names should never be used anyway } + parse_proc_directives(pd,pdflags); + end; + + + procedure parse_object_proc_directives(pd:tabstractprocdef); + var + pdflags : tpdflags; + begin + pdflags:=[pd_object]; + parse_proc_directives(pd,pdflags); + end; + + procedure parse_record_proc_directives(pd:tabstractprocdef); + var + pdflags : tpdflags; + begin + pdflags:=[pd_record]; + parse_proc_directives(pd,pdflags); + end; + + function proc_add_definition(var currpd:tprocdef):boolean; + { + Add definition aprocdef to the overloaded definitions of aprocsym. If a + forwarddef is found and reused it returns true + } + var + fwpd : tprocdef; + currparasym, + fwparasym : tsym; + currparacnt, + fwparacnt, + curridx, + fwidx, + i : longint; + po_comp : tprocoptions; + paracompopt: tcompare_paras_options; + forwardfound : boolean; + symentry: TSymEntry; + begin + forwardfound:=false; + + { check overloaded functions if the same function already exists } + for i:=0 to tprocsym(currpd.procsym).ProcdefList.Count-1 do + begin + fwpd:=tprocdef(tprocsym(currpd.procsym).ProcdefList[i]); + + { Skip overloaded definitions that are declared in other units } + if fwpd.procsym<>currpd.procsym then + continue; + + { check the parameters, for delphi/tp it is possible to + leave the parameters away in the implementation (forwarddef=false). + But for an overload declared function this is not allowed } + if { check if empty implementation arguments match is allowed } + ( + not(m_repeat_forward in current_settings.modeswitches) and + not(currpd.forwarddef) and + is_bareprocdef(currpd) and + not(po_overload in fwpd.procoptions) + ) or + { check arguments, we need to check only the user visible parameters. The hidden parameters + can be in a different location because of the calling convention, eg. L-R vs. R-L order (PFV) } + ( + (compare_paras(currpd.paras,fwpd.paras,cp_none,[cpo_comparedefaultvalue,cpo_ignorehidden,cpo_openequalisexact,cpo_ignoreuniv])=te_exact) and + (compare_defs(fwpd.returndef,currpd.returndef,nothingn)=te_exact) + ) then + begin + { Check if we've found the forwarddef, if found then + we need to update the forward def with the current + implementation settings } + if fwpd.forwarddef then + begin + forwardfound:=true; + + if not(m_repeat_forward in current_settings.modeswitches) and + (fwpd.proccalloption<>currpd.proccalloption) then + paracompopt:=[cpo_ignorehidden,cpo_comparedefaultvalue,cpo_openequalisexact,cpo_ignoreuniv] + else + paracompopt:=[cpo_comparedefaultvalue,cpo_openequalisexact,cpo_ignoreuniv]; + + { Check calling convention } + if (fwpd.proccalloption<>currpd.proccalloption) then + begin + { In delphi it is possible to specify the calling + convention in the interface or implementation if + there was no convention specified in the other + part } + if (m_delphi in current_settings.modeswitches) then + begin + if not(po_hascallingconvention in currpd.procoptions) then + currpd.proccalloption:=fwpd.proccalloption + else + if not(po_hascallingconvention in fwpd.procoptions) then + fwpd.proccalloption:=currpd.proccalloption + else + begin + MessagePos(currpd.fileinfo,parser_e_call_convention_dont_match_forward); + tprocsym(currpd.procsym).write_parameter_lists(currpd); + { restore interface settings } + currpd.proccalloption:=fwpd.proccalloption; + end; + end + else + begin + MessagePos(currpd.fileinfo,parser_e_call_convention_dont_match_forward); + tprocsym(currpd.procsym).write_parameter_lists(currpd); + { restore interface settings } + currpd.proccalloption:=fwpd.proccalloption; + end; + end; + + { Check static } + if (po_staticmethod in fwpd.procoptions) then + begin + if not (po_staticmethod in currpd.procoptions) then + begin + include(currpd.procoptions, po_staticmethod); + if (po_classmethod in currpd.procoptions) then + begin + { remove self from the hidden paras } + symentry:=currpd.parast.Find('self'); + if symentry<>nil then + begin + currpd.parast.Delete(symentry); + currpd.calcparas; + end; + end; + end; + end; + + { Check if the procedure type and return type are correct, + also the parameters must match also with the type } + if ((m_repeat_forward in current_settings.modeswitches) or + not is_bareprocdef(currpd)) and + ((compare_paras(currpd.paras,fwpd.paras,cp_all,paracompopt)<>te_exact) or + (compare_defs(fwpd.returndef,currpd.returndef,nothingn)<>te_exact)) then + begin + MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward, + fwpd.fullprocname(false)); + tprocsym(currpd.procsym).write_parameter_lists(currpd); + break; + end; + + { Check if both are declared forward } + if fwpd.forwarddef and currpd.forwarddef then + begin + MessagePos1(currpd.fileinfo,parser_e_function_already_declared_public_forward, + currpd.fullprocname(false)); + end; + + { internconst or internproc only need to be defined once } + if (fwpd.proccalloption=pocall_internproc) then + currpd.proccalloption:=fwpd.proccalloption + else + if (currpd.proccalloption=pocall_internproc) then + fwpd.proccalloption:=currpd.proccalloption; + + { Check procedure options, Delphi requires that class is + repeated in the implementation for class methods } + if (m_fpc in current_settings.modeswitches) then + po_comp:=[po_classmethod,po_varargs,po_methodpointer,po_interrupt] + else + po_comp:=[po_classmethod,po_methodpointer]; + + if ((po_comp * fwpd.procoptions)<>(po_comp * currpd.procoptions)) or + (fwpd.proctypeoption <> currpd.proctypeoption) or + { if the implementation version has an "overload" modifier, + the interface version must also have it (otherwise we can + get annoying crashes due to interface crc changes) } + (not(po_overload in fwpd.procoptions) and + (po_overload in currpd.procoptions)) then + begin + MessagePos1(currpd.fileinfo,parser_e_header_dont_match_forward, + fwpd.fullprocname(false)); + tprocsym(fwpd.procsym).write_parameter_lists(fwpd); + { This error is non-fatal, we can recover } + end; + + { Forward declaration is external? } + if (po_external in fwpd.procoptions) then + MessagePos(currpd.fileinfo,parser_e_proc_already_external); + + { Check parameters } + if (m_repeat_forward in current_settings.modeswitches) or + (currpd.minparacount>0) then + begin + { If mangled names are equal then they have the same amount of arguments } + { We can check the names of the arguments } + { both symtables are in the same order from left to right } + curridx:=0; + fwidx:=0; + currparacnt:=currpd.parast.SymList.Count; + fwparacnt:=fwpd.parast.SymList.Count; + repeat + { skip default parameter constsyms } + while (curridx<currparacnt) and + (tsym(currpd.parast.SymList[curridx]).typ<>paravarsym) do + inc(curridx); + while (fwidx<fwparacnt) and + (tsym(fwpd.parast.SymList[fwidx]).typ<>paravarsym) do + inc(fwidx); + { stop when one of the two lists is at the end } + if (fwidx>=fwparacnt) or (curridx>=currparacnt) then + break; + { compare names of parameters, ignore implictly + renamed parameters } + currparasym:=tsym(currpd.parast.SymList[curridx]); + fwparasym:=tsym(fwpd.parast.SymList[fwidx]); + if not(sp_implicitrename in currparasym.symoptions) and + not(sp_implicitrename in fwparasym.symoptions) then + begin + if (currparasym.name<>fwparasym.name) then + begin + MessagePos3(currpd.fileinfo,parser_e_header_different_var_names, + tprocsym(currpd.procsym).realname,fwparasym.realname,currparasym.realname); + break; + end; + end; + { next parameter } + inc(curridx); + inc(fwidx); + until false; + end; + { Everything is checked, now we can update the forward declaration + with the new data from the implementation } + fwpd.forwarddef:=currpd.forwarddef; + fwpd.hasforward:=true; + fwpd.procoptions:=fwpd.procoptions+currpd.procoptions; + + { marked as local but exported from unit? } + if (po_kylixlocal in fwpd.procoptions) and (fwpd.owner.symtabletype=globalsymtable) then + MessagePos(fwpd.fileinfo,type_e_cant_export_local); + + if fwpd.extnumber=$ffff then + fwpd.extnumber:=currpd.extnumber; + while not currpd.aliasnames.empty do + fwpd.aliasnames.insert(currpd.aliasnames.getfirst); + { update fileinfo so position references the implementation, + also update funcretsym if it is already generated } + fwpd.fileinfo:=currpd.fileinfo; + if assigned(fwpd.funcretsym) then + fwpd.funcretsym.fileinfo:=currpd.fileinfo; + if assigned(currpd.deprecatedmsg) then + begin + stringdispose(fwpd.deprecatedmsg); + fwpd.deprecatedmsg:=stringdup(currpd.deprecatedmsg^); + end; + { import names } + if assigned(currpd.import_dll) then + begin + stringdispose(fwpd.import_dll); + fwpd.import_dll:=stringdup(currpd.import_dll^); + end; + if assigned(currpd.import_name) then + begin + stringdispose(fwpd.import_name); + fwpd.import_name:=stringdup(currpd.import_name^); + end; + fwpd.import_nr:=currpd.import_nr; + { for compilerproc defines we need to rename and update the + symbolname to lowercase } + if (po_compilerproc in fwpd.procoptions) then + begin + { rename to lowercase so users can't access it } + fwpd.procsym.realname:='$'+lower(fwpd.procsym.name); + { the mangeled name is already changed by the pd_compilerproc } + { handler. It must be done immediately because if we have a } + { call to a compilerproc before it's implementation is } + { encountered, it must already use the new mangled name (JM) } + end; + + { Release current procdef } + currpd.owner.deletedef(currpd); + currpd:=fwpd; + end + else + begin + { abstract methods aren't forward defined, but this } + { needs another error message } + if (po_abstractmethod in fwpd.procoptions) then + MessagePos(currpd.fileinfo,parser_e_abstract_no_definition) + else + begin + MessagePos(currpd.fileinfo,parser_e_overloaded_have_same_parameters); + tprocsym(currpd.procsym).write_parameter_lists(currpd); + end; + end; + + { we found one proc with the same arguments, there are no others + so we can stop } + break; + end; + + { check for allowing overload directive } + if not(m_fpc in current_settings.modeswitches) then + begin + { overload directive turns on overloading } + if ((po_overload in currpd.procoptions) or + (po_overload in fwpd.procoptions)) then + begin + { check if all procs have overloading, but not if the proc is a method or + already declared forward, then the check is already done } + if not(fwpd.hasforward or + assigned(currpd.struct) or + (currpd.forwarddef<>fwpd.forwarddef) or + ((po_overload in currpd.procoptions) and + (po_overload in fwpd.procoptions))) then + begin + MessagePos1(currpd.fileinfo,parser_e_no_overload_for_all_procs,currpd.procsym.realname); + break; + end + end + else + begin + if not(fwpd.forwarddef) then + begin + if (m_tp7 in current_settings.modeswitches) then + MessagePos(currpd.fileinfo,parser_e_procedure_overloading_is_off) + else + MessagePos1(currpd.fileinfo,parser_e_no_overload_for_all_procs,currpd.procsym.realname); + break; + end; + end; + end; { equal arguments } + end; + + { if we didn't reuse a forwarddef then we add the procdef to the overloaded + list } + if not forwardfound then + begin + { can happen in Delphi mode } + if (currpd.proctypeoption = potype_function) and + is_void(currpd.returndef) then + MessagePos1(currpd.fileinfo,parser_e_no_funcret_specified,currpd.procsym.realname); + tprocsym(currpd.procsym).ProcdefList.Add(currpd); + end; + + proc_add_definition:=forwardfound; + end; + +end. diff --git a/closures/compiler/pdecvar.pas b/closures/compiler/pdecvar.pas new file mode 100644 index 0000000000..e4be488a71 --- /dev/null +++ b/closures/compiler/pdecvar.pas @@ -0,0 +1,1864 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Parses variable declarations. Used for var statement and record + definitions + + 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 pdecvar; + +{$i fpcdefs.inc} + +interface + + uses + symsym,symdef; + + type + tvar_dec_option=(vd_record,vd_object,vd_threadvar,vd_class); + tvar_dec_options=set of tvar_dec_option; + + function read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef):tpropertysym; + + procedure read_var_decls(options:Tvar_dec_options); + + procedure read_record_fields(options:Tvar_dec_options); + + procedure read_public_and_external(vs: tabstractvarsym); + + procedure try_consume_sectiondirective(var asection: ansistring); + +implementation + + uses + SysUtils, + { common } + cutils,cclasses, + { global } + globtype,globals,tokens,verbose,constexp, + systems, + { symtable } + symconst,symbase,symtype,symtable,defutil,defcmp, + fmodule,htypechk, + { pass 1 } + node,pass_1,aasmdata, + nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw,nmem,nutils, + { codegen } + ncgutil, + { parser } + scanner, + pbase,pexpr,ptype,ptconst,pdecsub, + { link } + import + ; + + + function read_property_dec(is_classproperty:boolean;astruct:tabstractrecorddef):tpropertysym; + + { convert a node tree to symlist and return the last + symbol } + function parse_symlist(pl:tpropaccesslist;var def:tdef):boolean; + var + idx : longint; + sym : tsym; + srsymtable : TSymtable; + st : TSymtable; + p : tnode; + begin + result:=true; + def:=nil; + if token=_ID then + begin + if assigned(astruct) then + sym:=search_struct_member(astruct,pattern) + else + searchsym(pattern,sym,srsymtable); + if assigned(sym) then + begin + if assigned(astruct) and + not is_visible_for_object(sym,astruct) then + Message(parser_e_cant_access_private_member); + case sym.typ of + fieldvarsym : + begin + if (symtablestack.top.currentvisibility<>vis_private) then + addsymref(sym); + pl.addsym(sl_load,sym); + def:=tfieldvarsym(sym).vardef; + end; + procsym : + begin + if (symtablestack.top.currentvisibility<>vis_private) then + addsymref(sym); + pl.addsym(sl_call,sym); + end; + else + begin + Message1(parser_e_illegal_field_or_method,orgpattern); + def:=generrordef; + result:=false; + end; + end; + end + else + begin + Message1(parser_e_illegal_field_or_method,orgpattern); + def:=generrordef; + result:=false; + end; + consume(_ID); + repeat + case token of + _ID, + _SEMICOLON : + begin + break; + end; + _POINT : + begin + consume(_POINT); + if assigned(def) then + begin + st:=def.GetSymtable(gs_record); + if assigned(st) then + begin + sym:=tsym(st.Find(pattern)); + if not(assigned(sym)) and is_object(def) then + sym:=search_struct_member(tobjectdef(def),pattern); + if assigned(sym) then + begin + pl.addsym(sl_subscript,sym); + case sym.typ of + fieldvarsym : + def:=tfieldvarsym(sym).vardef; + else + begin + Message1(sym_e_illegal_field,orgpattern); + result:=false; + end; + end; + end + else + begin + Message1(sym_e_illegal_field,orgpattern); + result:=false; + end; + end + else + begin + Message(parser_e_invalid_qualifier); + result:=false; + end; + end + else + begin + Message(parser_e_invalid_qualifier); + result:=false; + end; + consume(_ID); + end; + _LECKKLAMMER : + begin + consume(_LECKKLAMMER); + repeat + if def.typ=arraydef then + begin + idx:=0; + p:=comp_expr(true,false); + if (not codegenerror) then + begin + if (p.nodetype=ordconstn) then + begin + { type/range checking } + inserttypeconv(p,tarraydef(def).rangedef); + if (Tordconstnode(p).value<int64(low(longint))) or + (Tordconstnode(p).value>int64(high(longint))) then + message(parser_e_array_range_out_of_bounds) + else + idx:=Tordconstnode(p).value.svalue + end + else + Message(type_e_ordinal_expr_expected) + end; + pl.addconst(sl_vec,idx,p.resultdef); + p.free; + def:=tarraydef(def).elementdef; + end + else + begin + Message(parser_e_invalid_qualifier); + result:=false; + end; + until not try_to_consume(_COMMA); + consume(_RECKKLAMMER); + end; + else + begin + Message(parser_e_ill_property_access_sym); + result:=false; + break; + end; + end; + until false; + end + else + begin + Message(parser_e_ill_property_access_sym); + result:=false; + end; + end; + + function allow_default_property(p : tpropertysym) : boolean; + + begin + allow_default_property:= + (is_ordinal(p.propdef) or +{$ifndef cpu64bitaddr} + is_64bitint(p.propdef) or +{$endif cpu64bitaddr} + is_class(p.propdef) or + is_single(p.propdef) or + (p.propdef.typ in [classrefdef,pointerdef]) or + is_smallset(p.propdef) + ) and not + ( + (p.propdef.typ=arraydef) and + (ppo_indexed in p.propoptions) + ) and not + (ppo_hasparameters in p.propoptions); + end; + + procedure create_accessor_procsym(p: tpropertysym; pd: tprocdef; const prefix: string; + accesstype: tpropaccesslisttypes); + var + sym: tprocsym; + begin + handle_calling_convention(pd); + sym:=tprocsym.create(prefix+lower(p.realname)); + symtablestack.top.insert(sym); + pd.procsym:=sym; + include(pd.procoptions,po_dispid); + include(pd.procoptions,po_global); + pd.visibility:=vis_private; + proc_add_definition(pd); + p.propaccesslist[accesstype].addsym(sl_call,sym); + p.propaccesslist[accesstype].procdef:=pd; + end; + + procedure parse_dispinterface(p : tpropertysym; readpd,writepd: tprocdef; + var paranr: word); + var + hasread, haswrite: boolean; + pt: tnode; + hdispid: longint; + hparavs: tparavarsym; + begin + p.propaccesslist[palt_read].clear; + p.propaccesslist[palt_write].clear; + + hasread:=true; + haswrite:=true; + + if try_to_consume(_READONLY) then + haswrite:=false + else if try_to_consume(_WRITEONLY) then + hasread:=false; + + if try_to_consume(_DISPID) then + begin + pt:=comp_expr(true,false); + if is_constintnode(pt) then + if (Tordconstnode(pt).value<int64(low(longint))) or (Tordconstnode(pt).value>int64(high(longint))) then + message(parser_e_range_check_error) + else + hdispid:=Tordconstnode(pt).value.svalue + else + Message(parser_e_dispid_must_be_ord_const); + pt.free; + end + else + hdispid:=tobjectdef(astruct).get_next_dispid; + + { COM property is simply a pair of methods, tagged with 'propertyget' + and 'propertyset' flags (or a single method if access is restricted). + Creating these implicit accessor methods also allows the rest of compiler + to handle dispinterface properties the same way as regular ones. } + if hasread then + begin + readpd.returndef:=p.propdef; + readpd.dispid:=hdispid; + readpd.proctypeoption:=potype_propgetter; + create_accessor_procsym(p,readpd,'get$',palt_read); + end; + if haswrite then + begin + { add an extra parameter, a placeholder of the value to set } + inc(paranr); + hparavs:=tparavarsym.create('$value',10*paranr,vs_value,p.propdef,[]); + writepd.parast.insert(hparavs); + + writepd.proctypeoption:=potype_propsetter; + writepd.dispid:=hdispid; + create_accessor_procsym(p,writepd,'put$',palt_write); + end; + end; + + procedure add_parameters(p: tpropertysym; readprocdef, writeprocdef: tprocdef); + var + i: integer; + orig, hparavs: tparavarsym; + begin + for i := 0 to p.parast.SymList.Count - 1 do + begin + orig:=tparavarsym(p.parast.SymList[i]); + hparavs:=tparavarsym.create(orig.RealName,orig.paranr,orig.varspez,orig.vardef,[]); + readprocdef.parast.insert(hparavs); + hparavs:=tparavarsym.create(orig.RealName,orig.paranr,orig.varspez,orig.vardef,[]); + writeprocdef.parast.insert(hparavs); + end; + end; + + procedure add_index_parameter(var paranr: word; p: tpropertysym; readprocdef, writeprocdef: tprocdef); + var + hparavs: tparavarsym; + begin + inc(paranr); + hparavs:=tparavarsym.create('$index',10*paranr,vs_value,p.indexdef,[]); + readprocdef.parast.insert(hparavs); + hparavs:=tparavarsym.create('$index',10*paranr,vs_value,p.indexdef,[]); + writeprocdef.parast.insert(hparavs); + end; + + var + sym : tsym; + srsymtable: tsymtable; + p : tpropertysym; + overridden : tsym; + varspez : tvarspez; + hdef : tdef; + arraytype : tdef; + def : tdef; + pt : tnode; + sc : TFPObjectList; + paranr : word; + i : longint; + ImplIntf : TImplementedInterface; + found : boolean; + hreadparavs, + hparavs : tparavarsym; + storedprocdef: tprocvardef; + readprocdef, + writeprocdef : tprocdef; + begin + { Generate temp procdefs to search for matching read/write + procedures. the readprocdef will store all definitions } + paranr:=0; + readprocdef:=tprocdef.create(normal_function_level); + writeprocdef:=tprocdef.create(normal_function_level); + + readprocdef.struct:=astruct; + writeprocdef.struct:=astruct; + + if assigned(astruct) and is_classproperty then + begin + readprocdef.procoptions:=[po_staticmethod,po_classmethod]; + writeprocdef.procoptions:=[po_staticmethod,po_classmethod]; + end; + + if token<>_ID then + begin + consume(_ID); + consume(_SEMICOLON); + exit; + end; + { Generate propertysym and insert in symtablestack } + p:=tpropertysym.create(orgpattern); + p.visibility:=symtablestack.top.currentvisibility; + p.default:=longint($80000000); + if is_classproperty then + include(p.symoptions, sp_static); + symtablestack.top.insert(p); + consume(_ID); + { property parameters ? } + if try_to_consume(_LECKKLAMMER) then + begin + if (p.visibility=vis_published) and + not (m_delphi in current_settings.modeswitches) then + Message(parser_e_cant_publish_that_property); + { create a list of the parameters } + p.parast:=tparasymtable.create(nil,0); + symtablestack.push(p.parast); + sc:=TFPObjectList.create(false); + repeat + if try_to_consume(_VAR) then + varspez:=vs_var + else if try_to_consume(_CONST) then + varspez:=vs_const + else if try_to_consume(_CONSTREF) then + varspez:=vs_constref + else if (m_out in current_settings.modeswitches) and try_to_consume(_OUT) then + varspez:=vs_out + else + varspez:=vs_value; + sc.clear; + repeat + inc(paranr); + hreadparavs:=tparavarsym.create(orgpattern,10*paranr,varspez,generrordef,[]); + p.parast.insert(hreadparavs); + sc.add(hreadparavs); + consume(_ID); + until not try_to_consume(_COMMA); + if try_to_consume(_COLON) then + begin + if try_to_consume(_ARRAY) then + begin + consume(_OF); + { define range and type of range } + hdef:=tarraydef.create(0,-1,s32inttype); + { define field type } + single_type(arraytype,[]); + tarraydef(hdef).elementdef:=arraytype; + end + else + single_type(hdef,[]); + end + else + hdef:=cformaltype; + for i:=0 to sc.count-1 do + tparavarsym(sc[i]).vardef:=hdef; + until not try_to_consume(_SEMICOLON); + sc.free; + symtablestack.pop(p.parast); + consume(_RECKKLAMMER); + + { the parser need to know if a property has parameters, the + index parameter doesn't count (PFV) } + if paranr>0 then + begin + add_parameters(p,readprocdef,writeprocdef); + include(p.propoptions,ppo_hasparameters); + end; + end; + { overridden property ? } + { force property interface + there is a property parameter + a global property } + if (token=_COLON) or (paranr>0) or (astruct=nil) then + begin + consume(_COLON); + single_type(p.propdef,[stoAllowSpecialization]); + + if is_dispinterface(astruct) and not is_automatable(p.propdef) then + Message1(type_e_not_automatable,p.propdef.typename); + + if (idtoken=_INDEX) then + begin + consume(_INDEX); + pt:=comp_expr(true,false); + { Only allow enum and integer indexes. Convert all integer + values to s32int to be compatible with delphi, because the + procedure matching requires equal parameters } + if is_constnode(pt) and + is_ordinal(pt.resultdef) +{$ifndef cpu64bitaddr} + and (not is_64bitint(pt.resultdef)) +{$endif cpu64bitaddr} + then + begin + if is_integer(pt.resultdef) then + inserttypeconv_internal(pt,s32inttype); + p.index:=tordconstnode(pt).value.svalue; + end + else + begin + Message(parser_e_invalid_property_index_value); + p.index:=0; + end; + p.indexdef:=pt.resultdef; + include(p.propoptions,ppo_indexed); + { concat a longint to the para templates } + add_index_parameter(paranr,p,readprocdef,writeprocdef); + pt.free; + end; + end + else + begin + { do an property override } + if (astruct.typ=objectdef) then + overridden:=search_struct_member(tobjectdef(astruct).childof,p.name) + else + overridden:=nil; + if assigned(overridden) and + (overridden.typ=propertysym) and + not(is_dispinterface(astruct)) then + begin + p.overriddenpropsym:=tpropertysym(overridden); + { inherit all type related entries } + p.indexdef:=tpropertysym(overridden).indexdef; + p.propdef:=tpropertysym(overridden).propdef; + p.index:=tpropertysym(overridden).index; + p.default:=tpropertysym(overridden).default; + p.propoptions:=tpropertysym(overridden).propoptions + [ppo_overrides]; + if ppo_hasparameters in p.propoptions then + begin + p.parast:=tpropertysym(overridden).parast.getcopy; + add_parameters(p,readprocdef,writeprocdef); + paranr:=p.parast.SymList.Count; + end; + if ppo_indexed in p.propoptions then + add_index_parameter(paranr,p,readprocdef,writeprocdef); + end + else + begin + p.propdef:=generrordef; + message(parser_e_no_property_found_to_override); + end; + end; + if ((p.visibility=vis_published) or is_dispinterface(astruct)) and + (not(p.propdef.is_publishable) or (sp_static in p.symoptions)) then + begin + Message(parser_e_cant_publish_that_property); + p.visibility:=vis_public; + end; + + if not(is_dispinterface(astruct)) then + begin + if try_to_consume(_READ) then + begin + p.propaccesslist[palt_read].clear; + if parse_symlist(p.propaccesslist[palt_read],def) then + begin + sym:=p.propaccesslist[palt_read].firstsym^.sym; + case sym.typ of + procsym : + begin + { read is function returning the type of the property } + readprocdef.returndef:=p.propdef; + { Insert hidden parameters } + handle_calling_convention(readprocdef); + { search procdefs matching readprocdef } + { we ignore hidden stuff here because the property access symbol might have + non default calling conventions which might change the hidden stuff; + see tw3216.pp (FK) } + p.propaccesslist[palt_read].procdef:=Tprocsym(sym).Find_procdef_bypara(readprocdef.paras,p.propdef,[cpo_allowdefaults,cpo_ignorehidden]); + if not assigned(p.propaccesslist[palt_read].procdef) or + { because of cpo_ignorehidden we need to compare if it is a static class method and we have a class property } + ((sp_static in p.symoptions) <> tprocdef(p.propaccesslist[palt_read].procdef).no_self_node) then + Message(parser_e_ill_property_access_sym); + end; + fieldvarsym : + begin + if not assigned(def) then + internalerror(200310071); + if compare_defs(def,p.propdef,nothingn)>=te_equal then + begin + { property parameters are allowed if this is + an indexed property, because the index is then + the parameter. + Note: In the help of Kylix it is written + that it isn't allowed, but the compiler accepts it (PFV) } + if (ppo_hasparameters in p.propoptions) or + ((sp_static in p.symoptions) <> (sp_static in sym.symoptions)) then + Message(parser_e_ill_property_access_sym); + end + else + IncompatibleTypes(def,p.propdef); + end; + else + Message(parser_e_ill_property_access_sym); + end; + end; + end; + if try_to_consume(_WRITE) then + begin + p.propaccesslist[palt_write].clear; + if parse_symlist(p.propaccesslist[palt_write],def) then + begin + sym:=p.propaccesslist[palt_write].firstsym^.sym; + case sym.typ of + procsym : + begin + { write is a procedure with an extra value parameter + of the of the property } + writeprocdef.returndef:=voidtype; + inc(paranr); + hparavs:=tparavarsym.create('$value',10*paranr,vs_value,p.propdef,[]); + writeprocdef.parast.insert(hparavs); + { Insert hidden parameters } + handle_calling_convention(writeprocdef); + { search procdefs matching writeprocdef } + if cs_varpropsetter in current_settings.localswitches then + p.propaccesslist[palt_write].procdef:=Tprocsym(sym).Find_procdef_bypara(writeprocdef.paras,writeprocdef.returndef,[cpo_allowdefaults,cpo_ignorevarspez]) + else + p.propaccesslist[palt_write].procdef:=Tprocsym(sym).Find_procdef_bypara(writeprocdef.paras,writeprocdef.returndef,[cpo_allowdefaults]); + if not assigned(p.propaccesslist[palt_write].procdef) then + Message(parser_e_ill_property_access_sym); + end; + fieldvarsym : + begin + if not assigned(def) then + internalerror(200310072); + if compare_defs(def,p.propdef,nothingn)>=te_equal then + begin + { property parameters are allowed if this is + an indexed property, because the index is then + the parameter. + Note: In the help of Kylix it is written + that it isn't allowed, but the compiler accepts it (PFV) } + if (ppo_hasparameters in p.propoptions) or + ((sp_static in p.symoptions) <> (sp_static in sym.symoptions)) then + Message(parser_e_ill_property_access_sym); + end + else + IncompatibleTypes(def,p.propdef); + end; + else + Message(parser_e_ill_property_access_sym); + end; + end; + end; + end + else + parse_dispinterface(p,readprocdef,writeprocdef,paranr); + + { stored is not allowed for dispinterfaces, records or class properties } + if assigned(astruct) and not(is_dispinterface(astruct) or is_record(astruct)) and not is_classproperty then + begin + { ppo_stored is default on for not overridden properties } + if not assigned(p.overriddenpropsym) then + include(p.propoptions,ppo_stored); + if try_to_consume(_STORED) then + begin + include(p.propoptions,ppo_stored); + p.propaccesslist[palt_stored].clear; + case token of + _ID: + begin + { in the case that idtoken=_DEFAULT } + { we have to do nothing except } + { setting ppo_stored, it's the same } + { as stored true } + if idtoken<>_DEFAULT then + begin + { parse_symlist cannot deal with constsyms, and + we also don't want to put constsyms in symlists + since they have to be evaluated immediately rather + than each time the property is accessed + + The proper fix would be to always create a parse tree + and then convert that one, if appropriate, to a symlist. + Currently, we e.g. don't support any constant expressions + yet either here, while Delphi does. + + } + { make sure we don't let constants mask class fields/ + methods + } + if (not assigned(astruct) or + (search_struct_member(astruct,pattern)=nil)) and + searchsym(pattern,sym,srsymtable) and + (sym.typ = constsym) then + begin + addsymref(sym); + if not is_boolean(tconstsym(sym).constdef) then + Message(parser_e_stored_property_must_be_boolean) + else if (tconstsym(sym).value.valueord=0) then + { same as for _FALSE } + exclude(p.propoptions,ppo_stored) + else + { same as for _TRUE } + p.default:=longint($80000000); + consume(_ID); + end + else if parse_symlist(p.propaccesslist[palt_stored],def) then + begin + sym:=p.propaccesslist[palt_stored].firstsym^.sym; + case sym.typ of + procsym : + begin + { Create a temporary procvardef to handle parameters } + storedprocdef:=tprocvardef.create(normal_function_level); + include(storedprocdef.procoptions,po_methodpointer); + { Return type must be boolean } + storedprocdef.returndef:=pasbool8type; + { Add index parameter if needed } + if ppo_indexed in p.propoptions then + begin + hparavs:=tparavarsym.create('$index',10,vs_value,p.indexdef,[]); + storedprocdef.parast.insert(hparavs); + end; + + { Insert hidden parameters } + handle_calling_convention(storedprocdef); + p.propaccesslist[palt_stored].procdef:=Tprocsym(sym).Find_procdef_bypara(storedprocdef.paras,storedprocdef.returndef,[cpo_allowdefaults,cpo_ignorehidden]); + if not assigned(p.propaccesslist[palt_stored].procdef) then + message(parser_e_ill_property_storage_sym); + { Not needed anymore } + storedprocdef.owner.deletedef(storedprocdef); + end; + fieldvarsym : + begin + if not assigned(def) then + internalerror(200310073); + if (ppo_hasparameters in p.propoptions) or + not(is_boolean(def)) then + Message(parser_e_stored_property_must_be_boolean); + end; + else + Message(parser_e_ill_property_access_sym); + end; + end; + end; + end; + _FALSE: + begin + consume(_FALSE); + exclude(p.propoptions,ppo_stored); + end; + _TRUE: + begin + p.default:=longint($80000000); + consume(_TRUE); + end; + end; + end; + end; + if not is_record(astruct) and try_to_consume(_DEFAULT) then + begin + if not allow_default_property(p) then + begin + Message(parser_e_property_cant_have_a_default_value); + { Error recovery } + pt:=comp_expr(true,false); + pt.free; + end + else + begin + { Get the result of the default, the firstpass is + needed to support values like -1 } + pt:=comp_expr(true,false); + if (p.propdef.typ=setdef) and + (pt.nodetype=arrayconstructorn) then + begin + arrayconstructor_to_set(pt); + do_typecheckpass(pt); + end; + inserttypeconv(pt,p.propdef); + if not(is_constnode(pt)) then + Message(parser_e_property_default_value_must_const); + { Set default value } + case pt.nodetype of + setconstn : + p.default:=plongint(tsetconstnode(pt).value_set)^; + ordconstn : + if (Tordconstnode(pt).value<int64(low(longint))) or + (Tordconstnode(pt).value>int64(high(cardinal))) then + message(parser_e_range_check_error) + else + p.default:=longint(tordconstnode(pt).value.svalue); + niln : + p.default:=0; + realconstn: + p.default:=longint(single(trealconstnode(pt).value_real)); + end; + pt.free; + end; + end + else if not is_record(astruct) and try_to_consume(_NODEFAULT) then + begin + p.default:=longint($80000000); + end; +(* + else {if allow_default_property(p) then + begin + p.default:=longint($80000000); + end; +*) + { Parse possible "implements" keyword } + if not is_record(astruct) and try_to_consume(_IMPLEMENTS) then + repeat + single_type(def,[]); + + if not(is_interface(def)) then + message(parser_e_class_implements_must_be_interface); + + if is_interface(p.propdef) then + begin + { an interface type may delegate itself or one of its ancestors } + if not p.propdef.is_related(def) then + begin + message2(parser_e_implements_must_have_correct_type,def.typename,p.propdef.typename); + exit; + end; + end + else if is_class(p.propdef) then + begin + ImplIntf:=tobjectdef(p.propdef).find_implemented_interface(tobjectdef(def)); + if assigned(ImplIntf) then + begin + if compare_defs(ImplIntf.IntfDef,def,nothingn)<te_equal then + begin + message2(parser_e_implements_must_have_correct_type,ImplIntf.IntfDef.typename,def.typename); + exit; + end; + end + else + begin + message2(parser_e_class_doesnt_implement_interface,p.propdef.typename,def.typename); + exit; + end; + end + else + begin + message(parser_e_implements_must_be_class_or_interface); + exit; + end; + + + if not assigned(p.propaccesslist[palt_read].firstsym) then + begin + message(parser_e_implements_must_read_specifier); + exit; + end; + if assigned(p.propaccesslist[palt_read].procdef) and + (tprocdef(p.propaccesslist[palt_read].procdef).proccalloption<>pocall_default) then + message(parser_e_implements_getter_not_default_cc); + if assigned(p.propaccesslist[palt_write].firstsym) then + begin + message(parser_e_implements_must_not_have_write_specifier); + exit; + end; + if assigned(p.propaccesslist[palt_stored].firstsym) then + begin + message(parser_e_implements_must_not_have_stored_specifier); + exit; + end; + found:=false; + for i:=0 to tobjectdef(astruct).ImplementedInterfaces.Count-1 do + begin + ImplIntf:=TImplementedInterface(tobjectdef(astruct).ImplementedInterfaces[i]); + + if compare_defs(def,ImplIntf.IntfDef,nothingn)>=te_equal then + begin + found:=true; + break; + end; + end; + if found then + begin + { An interface may not be delegated by more than one property, + it also may not have method mappings. } + if Assigned(ImplIntf.ImplementsGetter) then + message1(parser_e_duplicate_implements_clause,ImplIntf.IntfDef.typename); + if Assigned(ImplIntf.NameMappings) then + message2(parser_e_mapping_no_implements,ImplIntf.IntfDef.typename,astruct.objrealname^); + + ImplIntf.ImplementsGetter:=p; + ImplIntf.VtblImplIntf:=ImplIntf; + case p.propaccesslist[palt_read].firstsym^.sym.typ of + procsym : + begin + if (po_virtualmethod in tprocdef(p.propaccesslist[palt_read].procdef).procoptions) and + not is_objectpascal_helper(tprocdef(p.propaccesslist[palt_read].procdef).struct) then + ImplIntf.IType:=etVirtualMethodResult + else + ImplIntf.IType:=etStaticMethodResult; + end; + fieldvarsym : + begin + ImplIntf.IType:=etFieldValue; + { this must be done more sophisticated, here is also probably the wrong place } + ImplIntf.IOffset:=tfieldvarsym(p.propaccesslist[palt_read].firstsym^.sym).fieldoffset; + end + else + internalerror(200802161); + end; + if not is_interface(p.propdef) then + case ImplIntf.IType of + etVirtualMethodResult: ImplIntf.IType := etVirtualMethodClass; + etStaticMethodResult: ImplIntf.IType := etStaticMethodClass; + etFieldValue: ImplIntf.IType := etFieldValueClass; + else + internalerror(200912101); + end; + end + else + message1(parser_e_implements_uses_non_implemented_interface,def.typename); + until not try_to_consume(_COMMA); + + { remove unneeded procdefs } + if readprocdef.proctypeoption<>potype_propgetter then + readprocdef.owner.deletedef(readprocdef); + if writeprocdef.proctypeoption<>potype_propsetter then + writeprocdef.owner.deletedef(writeprocdef); + + result:=p; + end; + + + function maybe_parse_proc_directives(def:tdef):boolean; + var + newtype : ttypesym; + begin + result:=false; + { Process procvar directives before = and ; } + if (def.typ=procvardef) and + (def.typesym=nil) and + check_proc_directive(true) then + begin + newtype:=ttypesym.create('unnamed',def); + parse_var_proc_directives(tsym(newtype)); + newtype.typedef:=nil; + def.typesym:=nil; + newtype.free; + result:=true; + end; + end; + + + const + variantrecordlevel : longint = 0; + + + procedure read_public_and_external_sc(sc:TFPObjectList); + var + vs: tabstractvarsym; + begin + { only allowed for one var } + vs:=tabstractvarsym(sc[0]); + if sc.count>1 then + Message(parser_e_absolute_only_one_var); + read_public_and_external(vs); + end; + + + procedure read_public_and_external(vs: tabstractvarsym); + var + is_dll, + is_cdecl, + is_external_var, + is_weak_external, + is_public_var : boolean; + dll_name,section_name, + C_name,mangledname : string; + begin + { only allowed for one var } + { only allow external and public on global symbols } + if vs.typ<>staticvarsym then + begin + Message(parser_e_no_local_var_external); + exit; + end; + { defaults } + is_dll:=false; + is_cdecl:=false; + is_external_var:=false; + is_public_var:=false; + section_name := ''; + C_name:=vs.realname; + + { macpas specific handling due to some switches} + if (m_mac in current_settings.modeswitches) then + begin + if (cs_external_var in current_settings.localswitches) then + begin {The effect of this is the same as if cvar; external; has been given as directives.} + is_cdecl:=true; + is_external_var:=true; + end + else if (cs_externally_visible in current_settings.localswitches) then + begin {The effect of this is the same as if cvar has been given as directives and it's made public.} + is_cdecl:=true; + is_public_var:=true; + end; + end; + + { cdecl } + if try_to_consume(_CVAR) then + begin + consume(_SEMICOLON); + is_cdecl:=true; + end; + + { external } + is_weak_external:=try_to_consume(_WEAKEXTERNAL); + if is_weak_external or + try_to_consume(_EXTERNAL) then + begin + is_external_var:=true; + if (idtoken<>_NAME) and (token<>_SEMICOLON) then + begin + is_dll:=true; + dll_name:=get_stringconst; + if ExtractFileExt(dll_name)='' then + dll_name:=ChangeFileExt(dll_name,target_info.sharedlibext); + end; + if not(is_cdecl) and try_to_consume(_NAME) then + C_name:=get_stringconst; + consume(_SEMICOLON); + end; + + { export or public } + if idtoken in [_EXPORT,_PUBLIC] then + begin + consume(_ID); + if is_external_var then + Message(parser_e_not_external_and_export) + else + is_public_var:=true; + if try_to_consume(_NAME) then + C_name:=get_stringconst; + if (target_info.system in systems_allow_section_no_semicolon) and + (vs.typ=staticvarsym) and + try_to_consume (_SECTION) then + section_name:=get_stringconst; + consume(_SEMICOLON); + end; + + { Windows uses an indirect reference using import tables } + if is_dll and + (target_info.system in systems_all_windows) then + include(vs.varoptions,vo_is_dll_var); + + { This can only happen if vs.typ=staticvarsym } + if section_name<>'' then + begin + tstaticvarsym(vs).section:=section_name; + include(vs.varoptions,vo_has_section); + end; + + + { Add C _ prefix } + if is_cdecl or + ( + is_dll and + (target_info.system in systems_darwin) + ) then + C_Name := target_info.Cprefix+C_Name; + + if is_public_var then + begin + include(vs.varoptions,vo_is_public); + vs.varregable := vr_none; + { mark as referenced } + inc(vs.refs); + end; + + mangledname:=C_name; + { now we can insert it in the import lib if its a dll, or + add it to the externals } + if is_external_var then + begin + if vo_is_typed_const in vs.varoptions then + Message(parser_e_initialized_not_for_external); + include(vs.varoptions,vo_is_external); + if (is_weak_external) then + begin + if not(target_info.system in systems_weak_linking) then + message(parser_e_weak_external_not_supported); + include(vs.varoptions,vo_is_weak_external); + end; + vs.varregable := vr_none; + if is_dll then + begin + if target_info.system in (systems_all_windows + systems_nativent + + [system_i386_emx, system_i386_os2]) then + mangledname:=make_dllmangledname(dll_name,C_name,0,pocall_none); + + current_module.AddExternalImport(dll_name,C_Name,mangledname,0,true,false); + end + else + if tf_has_dllscanner in target_info.flags then + current_module.dllscannerinputlist.Add(vs.mangledname,vs); + end; + + { Set the assembler name } + tstaticvarsym(vs).set_mangledname(mangledname); + end; + + + procedure try_consume_sectiondirective(var asection: ansistring); + begin + if idtoken=_SECTION then + begin + consume(_ID); + asection:=get_stringconst; + consume(_SEMICOLON); + end; + end; + + + procedure read_var_decls(options:Tvar_dec_options); + + procedure read_default_value(sc : TFPObjectList); + var + vs : tabstractnormalvarsym; + tcsym : tstaticvarsym; + begin + vs:=tabstractnormalvarsym(sc[0]); + if sc.count>1 then + Message(parser_e_initialized_only_one_var); + if vo_is_thread_var in vs.varoptions then + Message(parser_e_initialized_not_for_threadvar); + consume(_EQ); + case vs.typ of + localvarsym : + begin + tcsym:=tstaticvarsym.create('$default'+vs.realname,vs_const,vs.vardef,[]); + include(tcsym.symoptions,sp_internal); + vs.defaultconstsym:=tcsym; + symtablestack.top.insert(tcsym); + read_typed_const(current_asmdata.asmlists[al_typedconsts],tcsym,false); + end; + staticvarsym : + begin + read_typed_const(current_asmdata.asmlists[al_typedconsts],tstaticvarsym(vs),false); + end; + else + internalerror(200611051); + end; + vs.varstate:=vs_initialised; + end; + +{$ifdef gpc_mode} + procedure read_gpc_name(sc : TFPObjectList); + var + vs : tabstractnormalvarsym; + C_Name : string; + begin + consume(_ID); + C_Name:=get_stringconst; + vs:=tabstractnormalvarsym(sc[0]); + if sc.count>1 then + Message(parser_e_absolute_only_one_var); + if vs.typ=staticvarsym then + begin + tstaticvarsym(vs).set_mangledname(C_Name); + include(vs.varoptions,vo_is_external); + end + else + Message(parser_e_no_local_var_external); + end; +{$endif} + + procedure read_absolute(sc : TFPObjectList); + var + vs : tabstractvarsym; + abssym : tabsolutevarsym; + pt,hp : tnode; + st : tsymtable; + {$ifdef i386} + tmpaddr : int64; + {$endif} + begin + abssym:=nil; + { only allowed for one var } + vs:=tabstractvarsym(sc[0]); + if sc.count>1 then + Message(parser_e_absolute_only_one_var); + if vo_is_typed_const in vs.varoptions then + Message(parser_e_initialized_not_for_external); + { parse the rest } + pt:=expr(true); + { check allowed absolute types } + if (pt.nodetype=stringconstn) or + (is_constcharnode(pt)) then + begin + abssym:=tabsolutevarsym.create(vs.realname,vs.vardef); + abssym.fileinfo:=vs.fileinfo; + if pt.nodetype=stringconstn then + abssym.asmname:=stringdup(strpas(tstringconstnode(pt).value_str)) + else + abssym.asmname:=stringdup(chr(tordconstnode(pt).value.svalue)); + consume(token); + abssym.abstyp:=toasm; + end + { address } + else if is_constintnode(pt) then + begin + abssym:=tabsolutevarsym.create(vs.realname,vs.vardef); + abssym.fileinfo:=vs.fileinfo; + abssym.abstyp:=toaddr; +{$ifndef cpu64bitaddr} + { on 64 bit systems, abssym.addroffset is a qword and hence this + test is useless (value is a 64 bit entity) and will always fail + for positive values (since int64(high(abssym.addroffset))=-1 + } + if (Tordconstnode(pt).value<int64(low(abssym.addroffset))) or + (Tordconstnode(pt).value>int64(high(abssym.addroffset))) then + message(parser_e_range_check_error) + else +{$endif} + abssym.addroffset:=Tordconstnode(pt).value.svalue; +{$ifdef i386} + abssym.absseg:=false; + if (target_info.system in [system_i386_go32v2,system_i386_watcom]) and + try_to_consume(_COLON) then + begin + pt.free; + pt:=expr(true); + if is_constintnode(pt) then + begin + tmpaddr:=abssym.addroffset shl 4+tordconstnode(pt).value.svalue; + if (tmpaddr<int64(low(abssym.addroffset))) or + (tmpaddr>int64(high(abssym.addroffset))) then + message(parser_e_range_check_error) + else + abssym.addroffset:=tmpaddr; + abssym.absseg:=true; + end + else + Message(type_e_ordinal_expr_expected); + end; +{$endif i386} + end + { variable } + else + begin + { we have to be able to take the address of the absolute + expression + } + valid_for_addr(pt,true); + { remove subscriptn before checking for loadn } + hp:=pt; + while (hp.nodetype in [subscriptn,typeconvn,vecn]) do + begin + { check for implicit dereferencing and reject it } + if (hp.nodetype in [subscriptn,vecn]) then + begin + if (tunarynode(hp).left.resultdef.typ in [pointerdef,classrefdef]) then + break; + { catch, e.g., 'var b: char absolute pchar_var[5];" + (pchar_var[5] is a pchar_2_string typeconv -> + the vecn only sees an array of char) + I don't know if all of these type conversions are + possible, but they're definitely all bad. + } + if (tunarynode(hp).left.nodetype=typeconvn) and + (ttypeconvnode(tunarynode(hp).left).convtype in + [tc_pchar_2_string,tc_pointer_2_array, + tc_intf_2_string,tc_intf_2_guid, + tc_dynarray_2_variant,tc_interface_2_variant, + tc_array_2_dynarray]) then + break; + + if (tunarynode(hp).left.resultdef.typ=stringdef) and + not(tstringdef(tunarynode(hp).left.resultdef).stringtype in [st_shortstring,st_longstring]) then + break; + if (tunarynode(hp).left.resultdef.typ=objectdef) and + (tobjectdef(tunarynode(hp).left.resultdef).objecttype<>odt_object) then + break; + if is_dynamic_array(tunarynode(hp).left.resultdef) then + break; + end; + hp:=tunarynode(hp).left; + end; + if (hp.nodetype=loadn) then + begin + { we should check the result type of loadn } + if not (tloadnode(hp).symtableentry.typ in [fieldvarsym,staticvarsym,localvarsym,paravarsym]) then + Message(parser_e_absolute_only_to_var_or_const); + abssym:=tabsolutevarsym.create(vs.realname,vs.vardef); + abssym.fileinfo:=vs.fileinfo; + abssym.abstyp:=tovar; + abssym.ref:=node_to_propaccesslist(pt); + + { if the sizes are different, can't be a regvar since you } + { can't be "absolute upper 8 bits of a register" (except } + { if its a record field of the same size of a record } + { regvar, but in that case pt.resultdef.size will have } + { the same size since it refers to the field and not to } + { the whole record -- which is why we use pt and not hp) } + + { we can't take the size of an open array } + if is_open_array(pt.resultdef) or + (vs.vardef.size <> pt.resultdef.size) then + make_not_regable(pt,[ra_addr_regable]); + end + else + Message(parser_e_absolute_only_to_var_or_const); + end; + pt.free; + { replace old varsym with the new absolutevarsym } + if assigned(abssym) then + begin + st:=vs.owner; + vs.owner.Delete(vs); + st.insert(abssym); + sc[0]:=abssym; + end; + end; + + var + sc : TFPObjectList; + vs : tabstractvarsym; + hdef : tdef; + i : longint; + semicoloneaten, + allowdefaultvalue, + hasdefaultvalue : boolean; + hintsymoptions : tsymoptions; + deprecatedmsg : pshortstring; + old_block_type : tblock_type; + sectionname : ansistring; + begin + old_block_type:=block_type; + block_type:=bt_var; + { Force an expected ID error message } + if not (token in [_ID,_CASE,_END]) then + consume(_ID); + { read vars } + sc:=TFPObjectList.create(false); + while (token=_ID) do + begin + semicoloneaten:=false; + hasdefaultvalue:=false; + allowdefaultvalue:=true; + sc.clear; + repeat + if (token = _ID) then + begin + case symtablestack.top.symtabletype of + localsymtable : + vs:=tlocalvarsym.create(orgpattern,vs_value,generrordef,[]); + staticsymtable, + globalsymtable : + begin + vs:=tstaticvarsym.create(orgpattern,vs_value,generrordef,[]); + if vd_threadvar in options then + include(vs.varoptions,vo_is_thread_var); + end; + else + internalerror(200411064); + end; + sc.add(vs); + symtablestack.top.insert(vs); + end; + consume(_ID); + until not try_to_consume(_COMMA); + + { read variable type def } + block_type:=bt_var_type; + consume(_COLON); + +{$ifdef gpc_mode} + if (m_gpc in current_settings.modeswitches) and + (token=_ID) and + (orgpattern='__asmname__') then + read_gpc_name(sc); +{$endif} + + read_anon_type(hdef,false); + for i:=0 to sc.count-1 do + begin + vs:=tabstractvarsym(sc[i]); + vs.vardef:=hdef; + end; + block_type:=bt_var; + + { Process procvar directives } + if maybe_parse_proc_directives(hdef) then + semicoloneaten:=true; + + { check for absolute } + if try_to_consume(_ABSOLUTE) then + begin + read_absolute(sc); + allowdefaultvalue:=false; + end; + + { Check for EXTERNAL etc directives before a semicolon } + if (idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) then + begin + read_public_and_external_sc(sc); + allowdefaultvalue:=false; + semicoloneaten:=true; + end; + + { try to parse the hint directives } + hintsymoptions:=[]; + deprecatedmsg:=nil; + try_consume_hintdirective(hintsymoptions,deprecatedmsg); + for i:=0 to sc.count-1 do + begin + vs:=tabstractvarsym(sc[i]); + vs.symoptions := vs.symoptions + hintsymoptions; + if deprecatedmsg<>nil then + vs.deprecatedmsg:=stringdup(deprecatedmsg^); + end; + stringdispose(deprecatedmsg); + + { Handling of Delphi typed const = initialized vars } + if allowdefaultvalue and + (token=_EQ) and + not(m_tp7 in current_settings.modeswitches) and + (symtablestack.top.symtabletype<>parasymtable) then + begin + { Add calling convention for procvar } + if (hdef.typ=procvardef) and + (hdef.typesym=nil) then + handle_calling_convention(tprocvardef(hdef)); + read_default_value(sc); + hasdefaultvalue:=true; + end + else + begin + if not(semicoloneaten) then + consume(_SEMICOLON); + end; + + { Support calling convention for procvars after semicolon } + if not(hasdefaultvalue) and + (hdef.typ=procvardef) and + (hdef.typesym=nil) then + begin + { Parse procvar directives after ; } + maybe_parse_proc_directives(hdef); + { Add calling convention for procvar } + handle_calling_convention(tprocvardef(hdef)); + { Handling of Delphi typed const = initialized vars } + if (token=_EQ) and + not(m_tp7 in current_settings.modeswitches) and + (symtablestack.top.symtabletype<>parasymtable) then + begin + read_default_value(sc); + hasdefaultvalue:=true; + end; + end; + + { Check for EXTERNAL etc directives or, in macpas, if cs_external_var is set} + if ( + ( + (idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) and + (m_cvar_support in current_settings.modeswitches) + ) or + ( + (m_mac in current_settings.modeswitches) and + ( + (cs_external_var in current_settings.localswitches) or + (cs_externally_visible in current_settings.localswitches) + ) + ) + ) then + read_public_and_external_sc(sc); + + { try to parse a section directive } + if (target_info.system in systems_allow_section) and + (symtablestack.top.symtabletype in [staticsymtable,globalsymtable]) and + (idtoken=_SECTION) then + begin + try_consume_sectiondirective(sectionname); + if sectionname<>'' then + begin + for i:=0 to sc.count-1 do + begin + vs:=tabstractvarsym(sc[i]); + if (vs.varoptions *[vo_is_external,vo_is_weak_external])<>[] then + Message(parser_e_externals_no_section); + if vs.typ<>staticvarsym then + Message(parser_e_section_no_locals); + tstaticvarsym(vs).section:=sectionname; + include(vs.varoptions, vo_has_section); + end; + end; + end; + + { allocate normal variable (non-external and non-typed-const) staticvarsyms } + for i:=0 to sc.count-1 do + begin + vs:=tabstractvarsym(sc[i]); + if (vs.typ=staticvarsym) and + not(vo_is_typed_const in vs.varoptions) and + not(vo_is_external in vs.varoptions) then + insertbssdata(tstaticvarsym(vs)); + end; + end; + block_type:=old_block_type; + { free the list } + sc.free; + end; + + + procedure read_record_fields(options:Tvar_dec_options); + var + sc : TFPObjectList; + i : longint; + hs,sorg,static_name : string; + hdef,casetype : tdef; + { maxsize contains the max. size of a variant } + { startvarrec contains the start of the variant part of a record } + maxsize, startvarrecsize : longint; + usedalign, + maxalignment,startvarrecalign, + maxpadalign, startpadalign: shortint; + pt : tnode; + fieldvs : tfieldvarsym; + hstaticvs : tstaticvarsym; + vs : tabstractvarsym; + srsym : tsym; + srsymtable : TSymtable; + visibility : tvisibility; + recst : tabstractrecordsymtable; + recstlist : tfpobjectlist; + unionsymtable : trecordsymtable; + offset : longint; + uniondef : trecorddef; + hintsymoptions : tsymoptions; + deprecatedmsg : pshortstring; + semicoloneaten, + removeclassoption: boolean; +{$if defined(powerpc) or defined(powerpc64)} + tempdef: tdef; + is_first_type: boolean; +{$endif powerpc or powerpc64} + sl: tpropaccesslist; + old_block_type: tblock_type; + begin + old_block_type:=block_type; + block_type:=bt_var; + recst:=tabstractrecordsymtable(symtablestack.top); +{$if defined(powerpc) or defined(powerpc64)} + is_first_type:=true; +{$endif powerpc or powerpc64} + { Force an expected ID error message } + if not (token in [_ID,_CASE,_END]) then + consume(_ID); + { read vars } + sc:=TFPObjectList.create(false); + recstlist:=TFPObjectList.create(false); + removeclassoption:=false; + while (token=_ID) and + not(((vd_object in options) or + ((vd_record in options) and (m_advanced_records in current_settings.modeswitches))) and + (idtoken in [_PUBLIC,_PRIVATE,_PUBLISHED,_PROTECTED,_STRICT])) do + begin + visibility:=symtablestack.top.currentvisibility; + semicoloneaten:=false; + sc.clear; + repeat + sorg:=orgpattern; + if token=_ID then + begin + vs:=tfieldvarsym.create(sorg,vs_value,generrordef,[]); + sc.add(vs); + recst.insert(vs); + end; + consume(_ID); + until not try_to_consume(_COMMA); + if m_delphi in current_settings.modeswitches then + block_type:=bt_var_type + else + block_type:=old_block_type; + consume(_COLON); + + { Don't search for types where they can't be: + types can be only in objects, classes and records. + This just speedup the search a bit. } + recstlist.count:=0; + if not is_class_or_object(tdef(recst.defowner)) and + not is_record(tdef(recst.defowner)) then + begin + recstlist.add(recst); + symtablestack.pop(recst); + end; + read_anon_type(hdef,false); + block_type:=bt_var; + { allow only static fields reference to struct where they are declared } + if not (vd_class in options) and + (is_object(hdef) or is_record(hdef)) and + is_owned_by(tabstractrecorddef(recst.defowner),tabstractrecorddef(hdef)) then + begin + Message1(type_e_type_is_not_completly_defined, tabstractrecorddef(hdef).RttiName); + { for error recovery or compiler will crash later } + hdef:=generrordef; + end; + { restore stack } + for i:=recstlist.count-1 downto 0 do + begin + recst:=tabstractrecordsymtable(recstlist[i]); + symtablestack.push(recst); + end; + + { Process procvar directives } + if maybe_parse_proc_directives(hdef) then + semicoloneaten:=true; + +{$if defined(powerpc) or defined(powerpc64)} + { from gcc/gcc/config/rs6000/rs6000.h: + /* APPLE LOCAL begin Macintosh alignment 2002-1-22 ff */ + /* Return the alignment of a struct based on the Macintosh PowerPC + alignment rules. In general the alignment of a struct is + determined by the greatest alignment of its elements. However, the + PowerPC rules cause the alignment of a struct to peg at word + alignment except when the first field has greater than word + (32-bit) alignment, in which case the alignment is determined by + the alignment of the first field. */ + } + if (target_info.system in [system_powerpc_darwin, system_powerpc_macos, system_powerpc64_darwin]) and + is_first_type and + (symtablestack.top.symtabletype=recordsymtable) and + (trecordsymtable(symtablestack.top).usefieldalignment=C_alignment) then + begin + tempdef:=hdef; + while tempdef.typ=arraydef do + tempdef:=tarraydef(tempdef).elementdef; + if tempdef.typ<>recorddef then + maxpadalign:=tempdef.alignment + else + maxpadalign:=trecorddef(tempdef).padalignment; + + if (maxpadalign>4) and + (maxpadalign>trecordsymtable(symtablestack.top).padalignment) then + trecordsymtable(symtablestack.top).padalignment:=maxpadalign; + is_first_type:=false; + end; +{$endif powerpc or powerpc64} + + { types that use init/final are not allowed in variant parts, but + classes are allowed } + if (variantrecordlevel>0) then + if is_managed_type(hdef) then + Message(parser_e_cant_use_inittable_here) + else + if hdef.typ=undefineddef then + Message(parser_e_cant_use_type_parameters_here); + + { try to parse the hint directives } + hintsymoptions:=[]; + deprecatedmsg:=nil; + try_consume_hintdirective(hintsymoptions,deprecatedmsg); + + { update variable type and hints } + for i:=0 to sc.count-1 do + begin + fieldvs:=tfieldvarsym(sc[i]); + fieldvs.vardef:=hdef; + { insert any additional hint directives } + fieldvs.symoptions := fieldvs.symoptions + hintsymoptions; + if deprecatedmsg<>nil then + fieldvs.deprecatedmsg:=stringdup(deprecatedmsg^); + end; + stringdispose(deprecatedmsg); + + { Records and objects can't have default values } + { for a record there doesn't need to be a ; before the END or ) } + if not(token in [_END,_RKLAMMER]) and + not(semicoloneaten) then + consume(_SEMICOLON); + + { Parse procvar directives after ; } + maybe_parse_proc_directives(hdef); + + { Add calling convention for procvar } + if (hdef.typ=procvardef) and + (hdef.typesym=nil) then + handle_calling_convention(tprocvardef(hdef)); + + { check if it is a class field } + if (vd_object in options) then + begin + { if it is not a class var section and token=STATIC then it is a class field too } + if not (vd_class in options) and try_to_consume(_STATIC) then + begin + consume(_SEMICOLON); + include(options,vd_class); + removeclassoption:=true; + end; + end; + if vd_class in options then + begin + { add static flag and staticvarsyms } + for i:=0 to sc.count-1 do + begin + fieldvs:=tfieldvarsym(sc[i]); + include(fieldvs.symoptions,sp_static); + { generate the symbol which reserves the space } + static_name:=lower(generate_nested_name(recst,'_'))+'_'+fieldvs.name; + hstaticvs:=tstaticvarsym.create('$_static_'+static_name,vs_value,hdef,[]); + include(hstaticvs.symoptions,sp_internal); + recst.get_unit_symtable.insert(hstaticvs); + insertbssdata(hstaticvs); + { generate the symbol for the access } + sl:=tpropaccesslist.create; + sl.addsym(sl_load,hstaticvs); + recst.insert(tabsolutevarsym.create_ref('$'+static_name,hdef,sl)); + end; + if removeclassoption then + begin + exclude(options,vd_class); + removeclassoption:=false; + end; + end; + if (visibility=vis_published) and + not(is_class(hdef)) then + begin + MessagePos(tfieldvarsym(sc[0]).fileinfo,parser_e_cant_publish_that); + visibility:=vis_public; + end; + + if (visibility=vis_published) and + not(oo_can_have_published in tobjectdef(hdef).objectoptions) and + not(m_delphi in current_settings.modeswitches) then + begin + MessagePos(tfieldvarsym(sc[0]).fileinfo,parser_e_only_publishable_classes_can_be_published); + visibility:=vis_public; + end; + + { Generate field in the recordsymtable } + for i:=0 to sc.count-1 do + begin + fieldvs:=tfieldvarsym(sc[i]); + { static data fields are already inserted in the globalsymtable } + if not(sp_static in fieldvs.symoptions) then + recst.addfield(fieldvs,visibility); + end; + end; + recstlist.free; + + if m_delphi in current_settings.modeswitches then + block_type:=bt_var_type + else + block_type:=old_block_type; + { Check for Case } + if (vd_record in options) and + try_to_consume(_CASE) then + begin + maxsize:=0; + maxalignment:=0; + maxpadalign:=0; + { including a field declaration? } + fieldvs:=nil; + sorg:=orgpattern; + hs:=pattern; + searchsym(hs,srsym,srsymtable); + if not(assigned(srsym) and (srsym.typ in [typesym,unitsym])) then + begin + consume(_ID); + consume(_COLON); + fieldvs:=tfieldvarsym.create(sorg,vs_value,generrordef,[]); + symtablestack.top.insert(fieldvs); + end; + read_anon_type(casetype,true); + block_type:=bt_var; + if assigned(fieldvs) then + begin + fieldvs.vardef:=casetype; + recst.addfield(fieldvs,recst.currentvisibility); + end; + if not(is_ordinal(casetype)) +{$ifndef cpu64bitaddr} + or is_64bitint(casetype) +{$endif cpu64bitaddr} + then + Message(type_e_ordinal_expr_expected); + consume(_OF); + + UnionSymtable:=trecordsymtable.create('',current_settings.packrecords); + UnionDef:=trecorddef.create('',unionsymtable); + uniondef.isunion:=true; + startvarrecsize:=UnionSymtable.datasize; + { align the bitpacking to the next byte } + UnionSymtable.datasize:=startvarrecsize; + startvarrecalign:=UnionSymtable.fieldalignment; + startpadalign:=Unionsymtable.padalignment; + symtablestack.push(UnionSymtable); + repeat + repeat + pt:=comp_expr(true,false); + if not(pt.nodetype=ordconstn) then + Message(parser_e_illegal_expression); + if try_to_consume(_POINTPOINT) then + pt:=crangenode.create(pt,comp_expr(true,false)); + pt.free; + if token=_COMMA then + consume(_COMMA) + else + break; + until false; + if m_delphi in current_settings.modeswitches then + block_type:=bt_var_type + else + block_type:=old_block_type; + consume(_COLON); + { read the vars } + consume(_LKLAMMER); + inc(variantrecordlevel); + if token<>_RKLAMMER then + read_record_fields([vd_record]); + dec(variantrecordlevel); + consume(_RKLAMMER); + { calculates maximal variant size } + maxsize:=max(maxsize,unionsymtable.datasize); + maxalignment:=max(maxalignment,unionsymtable.fieldalignment); + maxpadalign:=max(maxpadalign,unionsymtable.padalignment); + { the items of the next variant are overlayed } + unionsymtable.datasize:=startvarrecsize; + unionsymtable.fieldalignment:=startvarrecalign; + unionsymtable.padalignment:=startpadalign; + if (token<>_END) and (token<>_RKLAMMER) then + consume(_SEMICOLON) + else + break; + until (token=_END) or (token=_RKLAMMER); + symtablestack.pop(UnionSymtable); + { at last set the record size to that of the biggest variant } + unionsymtable.datasize:=maxsize; + unionsymtable.fieldalignment:=maxalignment; + unionsymtable.addalignmentpadding; +{$if defined(powerpc) or defined(powerpc64)} + { parent inherits the alignment padding if the variant is the first "field" of the parent record/variant } + if (target_info.system in [system_powerpc_darwin, system_powerpc_macos, system_powerpc64_darwin]) and + is_first_type and + (recst.usefieldalignment=C_alignment) and + (maxpadalign>recst.padalignment) then + recst.padalignment:=maxpadalign; +{$endif powerpc or powerpc64} + { Align the offset where the union symtable is added } + case recst.usefieldalignment of + { allow the unionsymtable to be aligned however it wants } + { (within the global min/max limits) } + 0, { default } + C_alignment: + usedalign:=used_align(unionsymtable.recordalignment,current_settings.alignment.recordalignmin,current_settings.alignment.maxCrecordalign); + { 1 byte alignment if we are bitpacked } + bit_alignment: + usedalign:=1; + mac68k_alignment: + usedalign:=2; + { otherwise alignment at the packrecords alignment of the } + { current record } + else + usedalign:=used_align(recst.fieldalignment,current_settings.alignment.recordalignmin,current_settings.alignment.recordalignmax); + end; + offset:=align(recst.datasize,usedalign); + recst.datasize:=offset+unionsymtable.datasize; + + if unionsymtable.recordalignment>recst.fieldalignment then + recst.fieldalignment:=unionsymtable.recordalignment; + + trecordsymtable(recst).insertunionst(Unionsymtable,offset); + uniondef.owner.deletedef(uniondef); + end; + { free the list } + sc.free; +{$ifdef powerpc} + is_first_type := false; +{$endif powerpc} + block_type:=old_block_type; + end; + +end. diff --git a/closures/compiler/pexports.pas b/closures/compiler/pexports.pas new file mode 100644 index 0000000000..4b6d45eb33 --- /dev/null +++ b/closures/compiler/pexports.pas @@ -0,0 +1,249 @@ +{ + Copyright (c) 1998-2005 by Florian Klaempfl + + This unit handles the exports parsing + + 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 pexports; + +{$i fpcdefs.inc} + +interface + + { reads an exports statement in a library } + procedure read_exports; + +implementation + + uses + { common } + cutils, + { global } + globals,globtype,tokens,verbose,constexp, + systems, + ppu,fmodule, + { symtable } + symconst,symbase,symdef,symtype,symsym, + { pass 1 } + node, + ncon, + { parser } + scanner, + pbase,pexpr, + { obj-c } + objcutil, + { link } + gendef,export + ; + + + procedure read_exports; + var + orgs, + DefString, + InternalProcName : string; + pd : tprocdef; + pt : tnode; + srsym : tsym; + srsymtable : TSymtable; + hpname : shortstring; + index : longint; + options : word; + + function IsGreater(hp1,hp2:texported_item):boolean; + var + i2 : boolean; + begin + i2:=(hp2.options and eo_index)<>0; + if (hp1.options and eo_index)<>0 then + begin + if i2 then + IsGreater:=hp1.index>hp2.index + else + IsGreater:=false; + end + else + IsGreater:=i2; + end; + + begin + current_module.flags:=current_module.flags or uf_has_exports; + DefString:=''; + InternalProcName:=''; + consume(_EXPORTS); + repeat + hpname:=''; + options:=0; + index:=0; + if token=_ID then + begin + consume_sym_orgid(srsym,srsymtable,orgs); + { orgpattern is still valid here } + InternalProcName:=''; + case srsym.typ of + staticvarsym : + InternalProcName:=tstaticvarsym(srsym).mangledname; + procsym : + begin + pd:=tprocdef(tprocsym(srsym).ProcdefList[0]); + if (Tprocsym(srsym).ProcdefList.Count>1) or + (po_kylixlocal in pd.procoptions) or + ((tf_need_export in target_info.flags) and + not(po_exports in pd.procoptions)) then + Message(parser_e_illegal_symbol_exported) + else + InternalProcName:=pd.mangledname; + end; + typesym : + begin + if not is_objcclass(ttypesym(srsym).typedef) then + Message(parser_e_illegal_symbol_exported) + end; + else + Message(parser_e_illegal_symbol_exported) + end; + if (srsym.typ<>typesym) then + begin + if InternalProcName<>'' then + begin + { This is wrong if the first is not + an underline } + if InternalProcName[1]='_' then + delete(InternalProcName,1,1) + else if (target_info.system in [system_i386_win32,system_i386_wdosx,system_arm_wince,system_i386_wince]) and UseDeffileForExports then + begin + Message(parser_e_dlltool_unit_var_problem); + Message(parser_e_dlltool_unit_var_problem2); + end; + if length(InternalProcName)<2 then + Message(parser_e_procname_to_short_for_export); + DefString:=srsym.realname+'='+InternalProcName; + end; + if try_to_consume(_INDEX) then + begin + pt:=comp_expr(true,false); + if pt.nodetype=ordconstn then + if (Tordconstnode(pt).value<int64(low(index))) or + (Tordconstnode(pt).value>int64(high(index))) then + begin + index:=0; + message(parser_e_range_check_error) + end + else + index:=Tordconstnode(pt).value.svalue + else + begin + index:=0; + consume(_INTCONST); + end; + options:=options or eo_index; + pt.free; + if target_info.system in [system_i386_win32,system_i386_wdosx,system_arm_wince,system_i386_wince] then + DefString:=srsym.realname+'='+InternalProcName+' @ '+tostr(index) + else + DefString:=srsym.realname+'='+InternalProcName; {Index ignored!} + end; + if try_to_consume(_NAME) then + begin + pt:=comp_expr(true,false); + if pt.nodetype=stringconstn then + hpname:=strpas(tstringconstnode(pt).value_str) + else + consume(_CSTRING); + options:=options or eo_name; + pt.free; + DefString:=hpname+'='+InternalProcName; + end; + if try_to_consume(_RESIDENT) then + begin + options:=options or eo_resident; + DefString:=srsym.realname+'='+InternalProcName;{Resident ignored!} + end; + if (DefString<>'') and UseDeffileForExports then + DefFile.AddExport(DefString); + end; + case srsym.typ of + procsym: + begin + { if no specific name or index was given, then if } + { the procedure has aliases defined export those, } + { otherwise export the name as it appears in the } + { export section (it doesn't make sense to export } + { the generic mangled name, because the name of } + { the parent unit is used in that) } + if ((options and (eo_name or eo_index))=0) and + (tprocdef(tprocsym(srsym).procdeflist[0]).aliasnames.count>1) then + exportallprocsymnames(tprocsym(srsym),options) + else + begin + { there's a name or an index -> export only one name } + { correct? Or can you export multiple names with the } + { same index? And/or should we also export the aliases } + { if a name is specified? (JM) } + + if ((options and eo_name)=0) then + { Export names are not mangled on Windows and OS/2 } + if (target_info.system in (systems_all_windows+[system_i386_emx, system_i386_os2])) then + hpname:=orgs + { Use set mangled name in case of cdecl/cppdecl/mwpascal } + { and no name specified } + else if (tprocdef(tprocsym(srsym).procdeflist[0]).proccalloption in [pocall_cdecl,pocall_mwpascal]) then + hpname:=target_info.cprefix+tprocsym(srsym).realname + else if (tprocdef(tprocsym(srsym).procdeflist[0]).proccalloption in [pocall_cppdecl]) then + hpname:=target_info.cprefix+tprocdef(tprocsym(srsym).procdeflist[0]).cplusplusmangledname + else + hpname:=orgs; + + exportprocsym(srsym,hpname,index,options); + end + end; + staticvarsym: + begin + if ((options and eo_name)=0) then + { for "cvar" } + if (vo_has_mangledname in tstaticvarsym(srsym).varoptions) then + hpname:=srsym.mangledname + else + hpname:=orgs; + exportvarsym(srsym,hpname,index,options); + end; + typesym: + begin + case ttypesym(srsym).typedef.typ of + objectdef: + case tobjectdef(ttypesym(srsym).typedef).objecttype of + odt_objcclass: + exportobjcclass(tobjectdef(ttypesym(srsym).typedef)); + else + internalerror(2009092601); + end; + else + internalerror(2009092602); + end; + end; + end + end + else + consume(_ID); + until not try_to_consume(_COMMA); + consume(_SEMICOLON); + if not DefFile.empty then + DefFile.writefile; + end; + +end. diff --git a/closures/compiler/pexpr.pas b/closures/compiler/pexpr.pas new file mode 100644 index 0000000000..98002d8b10 --- /dev/null +++ b/closures/compiler/pexpr.pas @@ -0,0 +1,3430 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Does parsing of expression for Free Pascal + + 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 pexpr; + +{$i fpcdefs.inc} + +interface + + uses + symtype,symdef,symbase, + node,ncal, + tokens,globtype,globals,constexp; + + { reads a whole expression } + function expr(dotypecheck:boolean) : tnode; + + { reads an expression without assignements and .. } + function comp_expr(accept_equal,typeonly:boolean):tnode; + + { reads a single factor } + function factor(getaddr,typeonly:boolean) : tnode; + + procedure string_dec(var def: tdef; allowtypedef: boolean); + + function parse_paras(__colon,__namedpara : boolean;end_of_paras : ttoken) : tnode; + + { the ID token has to be consumed before calling this function } + procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags); + + function get_intconst:TConstExprInt; + function get_stringconst:string; + + { Does some postprocessing for a generic type (especially when nested types + of the specialization are used) } + procedure post_comp_expr_gendef(var def: tdef); + +implementation + + uses + { common } + cutils, + { global } + verbose, + systems,widestr, + { symtable } + symconst,symtable,symsym,defutil,defcmp, + { module } + fmodule,ppu, + { pass 1 } + pass_1,htypechk, + nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils, + { parser } + scanner, + pbase,pinline,ptype,pgenutil, + { codegen } + cgbase,procinfo,cpuinfo + ; + + { sub_expr(opmultiply) is need to get -1 ** 4 to be + read as - (1**4) and not (-1)**4 PM } + type + Toperator_precedence=(opcompare,opaddition,opmultiply,oppower); + + const + highest_precedence = oppower; + + function sub_expr(pred_level:Toperator_precedence;accept_equal,typeonly:boolean;factornode:tnode):tnode;forward; + + const + { true, if the inherited call is anonymous } + anon_inherited : boolean = false; + { last def found, only used by anon. inherited calls to insert proper type casts } + srdef : tdef = nil; + + procedure string_dec(var def:tdef; allowtypedef: boolean); + { reads a string type with optional length } + { and returns a pointer to the string } + { definition } + var + p : tnode; + begin + def:=cshortstringtype; + consume(_STRING); + if token=_LECKKLAMMER then + begin + if not(allowtypedef) then + Message(parser_e_no_local_para_def); + consume(_LECKKLAMMER); + p:=comp_expr(true,false); + if not is_constintnode(p) then + begin + Message(parser_e_illegal_expression); + { error recovery } + consume(_RECKKLAMMER); + end + else + begin + if (tordconstnode(p).value<=0) then + begin + Message(parser_e_invalid_string_size); + tordconstnode(p).value:=255; + end; + if tordconstnode(p).value>255 then + begin + { longstring is currently unsupported (CEC)! } +{ t:=tstringdef.createlong(tordconstnode(p).value))} + Message(parser_e_invalid_string_size); + tordconstnode(p).value:=255; + def:=tstringdef.createshort(int64(tordconstnode(p).value)); + end + else + if tordconstnode(p).value<>255 then + def:=tstringdef.createshort(int64(tordconstnode(p).value)); + consume(_RECKKLAMMER); + end; + p.free; + end + else + begin + if cs_ansistrings in current_settings.localswitches then + def:=getansistringdef + else + def:=cshortstringtype; + end; + end; + + + function parse_paras(__colon,__namedpara : boolean;end_of_paras : ttoken) : tnode; + var + p1,p2,argname : tnode; + prev_in_args, + old_named_args_allowed, + old_allow_array_constructor : boolean; + begin + if token=end_of_paras then + begin + parse_paras:=nil; + exit; + end; + { save old values } + prev_in_args:=in_args; + old_allow_array_constructor:=allow_array_constructor; + old_named_args_allowed:=named_args_allowed; + { set para parsing values } + in_args:=true; + named_args_allowed:=false; + allow_array_constructor:=true; + p2:=nil; + repeat + if __namedpara then + begin + if token=_COMMA then + begin + { empty parameter } + p2:=ccallparanode.create(cnothingnode.create,p2); + end + else + begin + named_args_allowed:=true; + p1:=comp_expr(true,false); + named_args_allowed:=false; + if found_arg_name then + begin + argname:=p1; + p1:=comp_expr(true,false); + p2:=ccallparanode.create(p1,p2); + tcallparanode(p2).parametername:=argname; + end + else + p2:=ccallparanode.create(p1,p2); + found_arg_name:=false; + end; + end + else + begin + p1:=comp_expr(true,false); + p2:=ccallparanode.create(p1,p2); + end; + { it's for the str(l:5,s); } + if __colon and (token=_COLON) then + begin + consume(_COLON); + p1:=comp_expr(true,false); + p2:=ccallparanode.create(p1,p2); + include(tcallparanode(p2).callparaflags,cpf_is_colon_para); + if try_to_consume(_COLON) then + begin + p1:=comp_expr(true,false); + p2:=ccallparanode.create(p1,p2); + include(tcallparanode(p2).callparaflags,cpf_is_colon_para); + end + end; + until not try_to_consume(_COMMA); + allow_array_constructor:=old_allow_array_constructor; + in_args:=prev_in_args; + named_args_allowed:=old_named_args_allowed; + parse_paras:=p2; + end; + + + function gen_c_style_operator(ntyp:tnodetype;p1,p2:tnode) : tnode; + var + hp : tnode; + hdef : tdef; + temp : ttempcreatenode; + newstatement : tstatementnode; + begin + { Properties are not allowed, because the write can + be different from the read } + if (nf_isproperty in p1.flags) then + begin + Message(type_e_variable_id_expected); + { We can continue with the loading, + it'll not create errors. Only the expected + result can be wrong } + end; + + hp:=p1; + while assigned(hp) and + (hp.nodetype in [derefn,subscriptn,vecn,typeconvn]) do + hp:=tunarynode(hp).left; + if not assigned(hp) then + internalerror(200410121); + if (hp.nodetype=calln) then + begin + typecheckpass(p1); + result:=internalstatements(newstatement); + hdef:=tpointerdef.create(p1.resultdef); + temp:=ctempcreatenode.create(hdef,sizeof(pint),tt_persistent,false); + addstatement(newstatement,temp); + addstatement(newstatement,cassignmentnode.create(ctemprefnode.create(temp),caddrnode.create_internal(p1))); + addstatement(newstatement,cassignmentnode.create( + cderefnode.create(ctemprefnode.create(temp)), + caddnode.create(ntyp, + cderefnode.create(ctemprefnode.create(temp)), + p2))); + addstatement(newstatement,ctempdeletenode.create(temp)); + end + else + result:=cassignmentnode.create(p1,caddnode.create(ntyp,p1.getcopy,p2)); + end; + + + function statement_syssym(l : byte) : tnode; + var + p1,p2,paras : tnode; + err, + prev_in_args : boolean; + begin + prev_in_args:=in_args; + case l of + + in_new_x : + begin + if afterassignment or in_args then + statement_syssym:=new_function + else + statement_syssym:=new_dispose_statement(true); + end; + + in_dispose_x : + begin + statement_syssym:=new_dispose_statement(false); + end; + + in_ord_x : + begin + consume(_LKLAMMER); + in_args:=true; + p1:=comp_expr(true,false); + consume(_RKLAMMER); + p1:=geninlinenode(in_ord_x,false,p1); + statement_syssym := p1; + end; + + in_exit : + begin + if try_to_consume(_LKLAMMER) then + begin + if not (m_mac in current_settings.modeswitches) then + begin + if not(try_to_consume(_RKLAMMER)) then + begin + p1:=comp_expr(true,false); + consume(_RKLAMMER); + if (not assigned(current_procinfo) or + is_void(current_procinfo.procdef.returndef)) then + begin + Message(parser_e_void_function); + { recovery } + p1.free; + p1:=nil; + end; + end + else + p1:=nil; + end + else + begin + if not (current_procinfo.procdef.procsym.name = pattern) then + Message(parser_e_macpas_exit_wrong_param); + consume(_ID); + consume(_RKLAMMER); + p1:=nil; + end + end + else + p1:=nil; + statement_syssym:=cexitnode.create(p1); + end; + + in_break : + begin + statement_syssym:=cbreaknode.create + end; + + in_continue : + begin + statement_syssym:=ccontinuenode.create + end; + + in_leave : + begin + if m_mac in current_settings.modeswitches then + statement_syssym:=cbreaknode.create + else + begin + Message1(sym_e_id_not_found, orgpattern); + statement_syssym:=cerrornode.create; + end; + end; + + in_cycle : + begin + if m_mac in current_settings.modeswitches then + statement_syssym:=ccontinuenode.create + else + begin + Message1(sym_e_id_not_found, orgpattern); + statement_syssym:=cerrornode.create; + end; + end; + + in_typeof_x : + begin + consume(_LKLAMMER); + in_args:=true; + p1:=comp_expr(true,false); + consume(_RKLAMMER); + if p1.nodetype=typen then + ttypenode(p1).allowed:=true; + { Allow classrefdef, which is required for + Typeof(self) in static class methods } + if not(is_objc_class_or_protocol(p1.resultdef)) and + ((p1.resultdef.typ = objectdef) or + (assigned(current_procinfo) and + ((po_classmethod in current_procinfo.procdef.procoptions) or + (po_staticmethod in current_procinfo.procdef.procoptions)) and + (p1.resultdef.typ=classrefdef))) then + statement_syssym:=geninlinenode(in_typeof_x,false,p1) + else + begin + Message(parser_e_class_id_expected); + p1.destroy; + statement_syssym:=cerrornode.create; + end; + end; + + in_sizeof_x, + in_bitsizeof_x : + begin + consume(_LKLAMMER); + in_args:=true; + p1:=comp_expr(true,false); + consume(_RKLAMMER); + if ((p1.nodetype<>typen) and + + ( + (is_object(p1.resultdef) and + (oo_has_constructor in tobjectdef(p1.resultdef).objectoptions)) or + is_open_array(p1.resultdef) or + is_array_of_const(p1.resultdef) or + is_open_string(p1.resultdef) + )) or + { keep the function call if it is a type parameter to avoid arithmetic errors due to constant folding } + (p1.resultdef.typ=undefineddef) then + begin + statement_syssym:=geninlinenode(in_sizeof_x,false,p1); + { no packed bit support for these things } + if (l = in_bitsizeof_x) then + statement_syssym:=caddnode.create(muln,statement_syssym,cordconstnode.create(8,sinttype,true)); + end + else + begin + { allow helpers for SizeOf and BitSizeOf } + if p1.nodetype=typen then + ttypenode(p1).helperallowed:=true; + if (p1.resultdef.typ=forwarddef) then + Message1(type_e_type_is_not_completly_defined,tforwarddef(p1.resultdef).tosymname^); + if (l = in_sizeof_x) or + (not((p1.nodetype = vecn) and + is_packed_array(tvecnode(p1).left.resultdef)) and + not((p1.nodetype = subscriptn) and + is_packed_record_or_object(tsubscriptnode(p1).left.resultdef))) then + begin + statement_syssym:=cordconstnode.create(p1.resultdef.size,sinttype,true); + if (l = in_bitsizeof_x) then + statement_syssym:=caddnode.create(muln,statement_syssym,cordconstnode.create(8,sinttype,true)); + end + else + statement_syssym:=cordconstnode.create(p1.resultdef.packedbitsize,sinttype,true); + { p1 not needed !} + p1.destroy; + end; + end; + + in_typeinfo_x, + in_objc_encode_x : + begin + if (l=in_typeinfo_x) or + (m_objectivec1 in current_settings.modeswitches) then + begin + consume(_LKLAMMER); + in_args:=true; + p1:=comp_expr(true,false); + { When reading a class type it is parsed as loadvmtaddrn, + typeinfo only needs the type so we remove the loadvmtaddrn } + if p1.nodetype=loadvmtaddrn then + begin + p2:=tloadvmtaddrnode(p1).left; + tloadvmtaddrnode(p1).left:=nil; + p1.free; + p1:=p2; + end; + if p1.nodetype=typen then + begin + ttypenode(p1).allowed:=true; + { allow helpers for TypeInfo } + if l=in_typeinfo_x then + ttypenode(p1).helperallowed:=true; + end; + { else + begin + p1.destroy; + p1:=cerrornode.create; + Message(parser_e_illegal_parameter_list); + end;} + consume(_RKLAMMER); + p2:=geninlinenode(l,false,p1); + statement_syssym:=p2; + end + else + begin + Message1(sym_e_id_not_found, orgpattern); + statement_syssym:=cerrornode.create; + end; + end; + + in_unaligned_x : + begin + err:=false; + consume(_LKLAMMER); + in_args:=true; + p1:=comp_expr(true,false); + p2:=ccallparanode.create(p1,nil); + p2:=geninlinenode(in_unaligned_x,false,p2); + consume(_RKLAMMER); + statement_syssym:=p2; + end; + + in_assigned_x : + begin + err:=false; + consume(_LKLAMMER); + in_args:=true; + p1:=comp_expr(true,false); + { When reading a class type it is parsed as loadvmtaddrn, + typeinfo only needs the type so we remove the loadvmtaddrn } + if p1.nodetype=loadvmtaddrn then + begin + p2:=tloadvmtaddrnode(p1).left; + tloadvmtaddrnode(p1).left:=nil; + p1.free; + p1:=p2; + end; + if not codegenerror then + begin + case p1.resultdef.typ of + procdef, { procvar } + pointerdef, + procvardef, + classrefdef : ; + objectdef : + if not is_implicit_pointer_object_type(p1.resultdef) then + begin + Message(parser_e_illegal_parameter_list); + err:=true; + end; + arraydef : + if not is_dynamic_array(p1.resultdef) then + begin + Message(parser_e_illegal_parameter_list); + err:=true; + end; + else + if p1.resultdef.typ<>undefineddef then + begin + Message(parser_e_illegal_parameter_list); + err:=true; + end; + end; + end + else + err:=true; + if not err then + begin + p2:=ccallparanode.create(p1,nil); + p2:=geninlinenode(in_assigned_x,false,p2); + end + else + begin + p1.free; + p2:=cerrornode.create; + end; + consume(_RKLAMMER); + statement_syssym:=p2; + end; + + in_addr_x : + begin + consume(_LKLAMMER); + in_args:=true; + p1:=comp_expr(true,false); + p1:=caddrnode.create(p1); + consume(_RKLAMMER); + statement_syssym:=p1; + end; + + in_ofs_x : + begin + consume(_LKLAMMER); + in_args:=true; + p1:=comp_expr(true,false); + p1:=caddrnode.create(p1); + do_typecheckpass(p1); + { Ofs() returns a cardinal/qword, not a pointer } + p1.resultdef:=uinttype; + consume(_RKLAMMER); + statement_syssym:=p1; + end; + + in_seg_x : + begin + consume(_LKLAMMER); + in_args:=true; + p1:=comp_expr(true,false); + p1:=geninlinenode(in_seg_x,false,p1); + consume(_RKLAMMER); + statement_syssym:=p1; + end; + + in_high_x, + in_low_x : + begin + consume(_LKLAMMER); + in_args:=true; + p1:=comp_expr(true,false); + p2:=geninlinenode(l,false,p1); + consume(_RKLAMMER); + statement_syssym:=p2; + end; + + in_succ_x, + in_pred_x : + begin + consume(_LKLAMMER); + in_args:=true; + p1:=comp_expr(true,false); + p2:=geninlinenode(l,false,p1); + consume(_RKLAMMER); + statement_syssym:=p2; + end; + + in_inc_x, + in_dec_x : + begin + consume(_LKLAMMER); + in_args:=true; + p1:=comp_expr(true,false); + if try_to_consume(_COMMA) then + p2:=ccallparanode.create(comp_expr(true,false),nil) + else + p2:=nil; + p2:=ccallparanode.create(p1,p2); + statement_syssym:=geninlinenode(l,false,p2); + consume(_RKLAMMER); + end; + + in_slice_x: + begin + if not(in_args) then + begin + message(parser_e_illegal_slice); + consume(_LKLAMMER); + in_args:=true; + comp_expr(true,false).free; + if try_to_consume(_COMMA) then + comp_expr(true,false).free; + statement_syssym:=cerrornode.create; + consume(_RKLAMMER); + end + else + begin + consume(_LKLAMMER); + in_args:=true; + p1:=comp_expr(true,false); + Consume(_COMMA); + if not(codegenerror) then + p2:=ccallparanode.create(comp_expr(true,false),nil) + else + p2:=cerrornode.create; + p2:=ccallparanode.create(p1,p2); + statement_syssym:=geninlinenode(l,false,p2); + consume(_RKLAMMER); + end; + end; + + in_initialize_x: + begin + statement_syssym:=inline_initialize; + end; + + in_finalize_x: + begin + statement_syssym:=inline_finalize; + end; + + in_copy_x: + begin + statement_syssym:=inline_copy; + end; + + in_concat_x : + begin + consume(_LKLAMMER); + in_args:=true; + { Translate to x:=x+y[+z]. The addnode will do the + type checking } + p2:=nil; + repeat + p1:=comp_expr(true,false); + if p2<>nil then + p2:=caddnode.create(addn,p2,p1) + else + begin + { Force string type if it isn't yet } + if not( + (p1.resultdef.typ=stringdef) or + is_chararray(p1.resultdef) or + is_char(p1.resultdef) + ) then + inserttypeconv(p1,cshortstringtype); + p2:=p1; + end; + until not try_to_consume(_COMMA); + consume(_RKLAMMER); + statement_syssym:=p2; + end; + + in_read_x, + in_readln_x, + in_readstr_x: + begin + if try_to_consume(_LKLAMMER) then + begin + paras:=parse_paras(false,false,_RKLAMMER); + consume(_RKLAMMER); + end + else + paras:=nil; + p1:=geninlinenode(l,false,paras); + statement_syssym := p1; + end; + + in_setlength_x: + begin + statement_syssym := inline_setlength; + end; + + in_objc_selector_x: + begin + if (m_objectivec1 in current_settings.modeswitches) then + begin + consume(_LKLAMMER); + in_args:=true; + { don't turn procsyms into calls (getaddr = true) } + p1:=factor(true,false); + p2:=geninlinenode(l,false,p1); + consume(_RKLAMMER); + statement_syssym:=p2; + end + else + begin + Message1(sym_e_id_not_found, orgpattern); + statement_syssym:=cerrornode.create; + end; + end; + in_length_x: + begin + consume(_LKLAMMER); + in_args:=true; + p1:=comp_expr(true,false); + p2:=geninlinenode(l,false,p1); + consume(_RKLAMMER); + statement_syssym:=p2; + end; + + in_write_x, + in_writeln_x, + in_writestr_x : + begin + if try_to_consume(_LKLAMMER) then + begin + paras:=parse_paras(true,false,_RKLAMMER); + consume(_RKLAMMER); + end + else + paras:=nil; + p1 := geninlinenode(l,false,paras); + statement_syssym := p1; + end; + + in_str_x_string : + begin + consume(_LKLAMMER); + paras:=parse_paras(true,false,_RKLAMMER); + consume(_RKLAMMER); + p1 := geninlinenode(l,false,paras); + statement_syssym := p1; + end; + + in_val_x: + Begin + consume(_LKLAMMER); + in_args := true; + p1:= ccallparanode.create(comp_expr(true,false), nil); + consume(_COMMA); + p2 := ccallparanode.create(comp_expr(true,false),p1); + if try_to_consume(_COMMA) then + p2 := ccallparanode.create(comp_expr(true,false),p2); + consume(_RKLAMMER); + p2 := geninlinenode(l,false,p2); + statement_syssym := p2; + End; + + in_include_x_y, + in_exclude_x_y : + begin + consume(_LKLAMMER); + in_args:=true; + p1:=comp_expr(true,false); + consume(_COMMA); + p2:=comp_expr(true,false); + statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil))); + consume(_RKLAMMER); + end; + + in_pack_x_y_z, + in_unpack_x_y_z : + begin + consume(_LKLAMMER); + in_args:=true; + p1:=comp_expr(true,false); + consume(_COMMA); + p2:=comp_expr(true,false); + consume(_COMMA); + paras:=comp_expr(true,false); + statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,ccallparanode.create(paras,nil)))); + consume(_RKLAMMER); + end; + + in_assert_x_y : + begin + consume(_LKLAMMER); + in_args:=true; + p1:=comp_expr(true,false); + if try_to_consume(_COMMA) then + p2:=comp_expr(true,false) + else + begin + { then insert an empty string } + p2:=cstringconstnode.createstr(''); + end; + statement_syssym:=geninlinenode(l,false,ccallparanode.create(p1,ccallparanode.create(p2,nil))); + consume(_RKLAMMER); + end; + in_get_frame: + begin + statement_syssym:=geninlinenode(l,false,nil); + end; +(* + in_get_caller_frame: + begin + if try_to_consume(_LKLAMMER) then + begin + {You used to call get_caller_frame as get_caller_frame(get_frame), + however, as a stack frame may not exist, it does more harm than + good, so ignore it.} + in_args:=true; + p1:=comp_expr(true,false); + p1.destroy; + consume(_RKLAMMER); + end; + statement_syssym:=geninlinenode(l,false,nil); + end; +*) + else + internalerror(15); + + end; + in_args:=prev_in_args; + end; + + + function maybe_load_methodpointer(st:TSymtable;var p1:tnode):boolean; + begin + maybe_load_methodpointer:=false; + if not assigned(p1) then + begin + case st.symtabletype of + withsymtable : + begin + if (st.defowner.typ=objectdef) then + p1:=tnode(twithsymtable(st).withrefnode).getcopy; + end; + ObjectSymtable, + recordsymtable: + begin + { We are calling from the static class method which has no self node } + if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then + p1:=cloadvmtaddrnode.create(ctypenode.create(current_procinfo.procdef.struct)) + else + p1:=load_self_node; + { We are calling a member } + maybe_load_methodpointer:=true; + end; + end; + end; + end; + + + { reads the parameter for a subroutine call } + procedure do_proc_call(sym:tsym;st:TSymtable;obj:tabstractrecorddef;getaddr:boolean;var again : boolean;var p1:tnode;callflags:tcallnodeflags); + var + membercall, + prevafterassn : boolean; + i : integer; + para,p2 : tnode; + currpara : tparavarsym; + aprocdef : tprocdef; + begin + prevafterassn:=afterassignment; + afterassignment:=false; + membercall:=false; + aprocdef:=nil; + + { when it is a call to a member we need to load the + methodpointer first + } + membercall:=maybe_load_methodpointer(st,p1); + + { When we are expecting a procvar we also need + to get the address in some cases } + if assigned(getprocvardef) then + begin + if (block_type=bt_const) or + getaddr then + begin + aprocdef:=Tprocsym(sym).Find_procdef_byprocvardef(getprocvardef); + getaddr:=true; + end + else + if ((m_tp_procvar in current_settings.modeswitches) or + (m_mac_procvar in current_settings.modeswitches)) and + not(token in [_CARET,_POINT,_LKLAMMER]) then + begin + aprocdef:=Tprocsym(sym).Find_procdef_byprocvardef(getprocvardef); + if assigned(aprocdef) then + getaddr:=true; + end; + end; + + { only need to get the address of the procedure? } + if getaddr then + begin + { Retrieve info which procvar to call. For tp_procvar the + aprocdef is already loaded above so we can reuse it } + if not assigned(aprocdef) and + assigned(getprocvardef) then + aprocdef:=Tprocsym(sym).Find_procdef_byprocvardef(getprocvardef); + + { generate a methodcallnode or proccallnode } + { we shouldn't convert things like @tcollection.load } + p2:=cloadnode.create_procvar(sym,aprocdef,st); + if assigned(p1) then + begin + { for loading methodpointer of an inherited function + we use self as instance and load the address of + the function directly and not through the vmt (PFV) } + if (cnf_inherited in callflags) then + begin + include(tloadnode(p2).loadnodeflags,loadnf_inherited); + p1.free; + p1:=load_self_node; + end; + if (p1.nodetype<>typen) then + tloadnode(p2).set_mp(p1) + else + p1.free; + end; + p1:=p2; + + { no postfix operators } + again:=false; + end + else + begin + para:=nil; + if anon_inherited then + begin + if not assigned(current_procinfo) then + internalerror(200305054); + for i:=0 to current_procinfo.procdef.paras.count-1 do + begin + currpara:=tparavarsym(current_procinfo.procdef.paras[i]); + if not(vo_is_hidden_para in currpara.varoptions) then + begin + { inheritance by msgint? } + if assigned(srdef) then + { anonymous inherited via msgid calls only require a var parameter for + both methods, so we need some type casting here } + para:=ccallparanode.create(ctypeconvnode.create_internal(ctypeconvnode.create_internal( + cloadnode.create(currpara,currpara.owner),cformaltype),tparavarsym(tprocdef(srdef).paras[i]).vardef), + para) + else + para:=ccallparanode.create(cloadnode.create(currpara,currpara.owner),para); + end; + end; + end + else + begin + if try_to_consume(_LKLAMMER) then + begin + para:=parse_paras(false,false,_RKLAMMER); + consume(_RKLAMMER); + end; + end; + { indicate if this call was generated by a member and + no explicit self is used, this is needed to determine + how to handle a destructor call (PFV) } + if membercall then + include(callflags,cnf_member_call); + if assigned(obj) then + begin + if not (st.symtabletype in [ObjectSymtable,recordsymtable]) then + internalerror(200310031); + p1:=ccallnode.create(para,tprocsym(sym),obj.symtable,p1,callflags); + end + else + p1:=ccallnode.create(para,tprocsym(sym),st,p1,callflags); + end; + afterassignment:=prevafterassn; + end; + + + procedure handle_procvar(pv : tprocvardef;var p2 : tnode); + var + hp,hp2 : tnode; + hpp : ^tnode; + currprocdef : tprocdef; + begin + if not assigned(pv) then + internalerror(200301121); + if (m_tp_procvar in current_settings.modeswitches) or + (m_mac_procvar in current_settings.modeswitches) then + begin + hp:=p2; + hpp:=@p2; + while assigned(hp) and + (hp.nodetype=typeconvn) do + begin + hp:=ttypeconvnode(hp).left; + { save orignal address of the old tree so we can replace the node } + hpp:=@hp; + end; + if (hp.nodetype=calln) and + { a procvar can't have parameters! } + not assigned(tcallnode(hp).left) then + begin + currprocdef:=tcallnode(hp).symtableprocentry.Find_procdef_byprocvardef(pv); + if assigned(currprocdef) then + begin + hp2:=cloadnode.create_procvar(tprocsym(tcallnode(hp).symtableprocentry),currprocdef,tcallnode(hp).symtableproc); + if (po_methodpointer in pv.procoptions) then + tloadnode(hp2).set_mp(tcallnode(hp).methodpointer.getcopy); + hp.destroy; + { replace the old callnode with the new loadnode } + hpp^:=hp2; + end; + end; + end; + end; + + + { checks whether sym is a static field and if so, translates the access + to the appropriate node tree } + function handle_staticfield_access(sym: tsym; nested: boolean; var p1: tnode): boolean; + var + static_name: shortstring; + srsymtable: tsymtable; + begin + result:=false; + { generate access code } + if (sp_static in sym.symoptions) then + begin + result:=true; + if not nested then + static_name:=lower(sym.owner.name^)+'_'+sym.name + else + static_name:=lower(generate_nested_name(sym.owner,'_'))+'_'+sym.name; + if sym.owner.defowner.typ=objectdef then + searchsym_in_class(tobjectdef(sym.owner.defowner),tobjectdef(sym.owner.defowner),static_name,sym,srsymtable,true) + else + searchsym_in_record(trecorddef(sym.owner.defowner),static_name,sym,srsymtable); + if assigned(sym) then + check_hints(sym,sym.symoptions,sym.deprecatedmsg); + p1.free; + p1:=nil; + { static syms are always stored as absolutevarsym to handle scope and storage properly } + propaccesslist_to_node(p1,nil,tabsolutevarsym(sym).ref); + end; + end; + + + { the following procedure handles the access to a property symbol } + procedure handle_propertysym(propsym : tpropertysym;st : TSymtable;var p1 : tnode); + var + paras : tnode; + p2 : tnode; + membercall : boolean; + callflags : tcallnodeflags; + propaccesslist : tpropaccesslist; + sym: tsym; + begin + { property parameters? read them only if the property really } + { has parameters } + paras:=nil; + if (ppo_hasparameters in propsym.propoptions) then + begin + if try_to_consume(_LECKKLAMMER) then + begin + paras:=parse_paras(false,false,_RECKKLAMMER); + consume(_RECKKLAMMER); + end; + end; + { indexed property } + if (ppo_indexed in propsym.propoptions) then + begin + p2:=cordconstnode.create(propsym.index,propsym.indexdef,true); + paras:=ccallparanode.create(p2,paras); + end; + { we need only a write property if a := follows } + { if not(afterassignment) and not(in_args) then } + if token=_ASSIGNMENT then + begin + if getpropaccesslist(propsym,palt_write,propaccesslist) then + begin + sym:=propaccesslist.firstsym^.sym; + case sym.typ of + procsym : + begin + callflags:=[]; + { generate the method call } + membercall:=maybe_load_methodpointer(st,p1); + if membercall then + include(callflags,cnf_member_call); + p1:=ccallnode.create(paras,tprocsym(sym),st,p1,callflags); + addsymref(sym); + paras:=nil; + consume(_ASSIGNMENT); + { read the expression } + if propsym.propdef.typ=procvardef then + getprocvardef:=tprocvardef(propsym.propdef); + p2:=comp_expr(true,false); + if assigned(getprocvardef) then + handle_procvar(getprocvardef,p2); + tcallnode(p1).left:=ccallparanode.create(p2,tcallnode(p1).left); + { mark as property, both the tcallnode and the real call block } + include(p1.flags,nf_isproperty); + getprocvardef:=nil; + end; + fieldvarsym : + begin + { generate access code } + if not handle_staticfield_access(sym,false,p1) then + propaccesslist_to_node(p1,st,propaccesslist); + include(p1.flags,nf_isproperty); + consume(_ASSIGNMENT); + { read the expression } + p2:=comp_expr(true,false); + p1:=cassignmentnode.create(p1,p2); + end + else + begin + p1:=cerrornode.create; + Message(parser_e_no_procedure_to_access_property); + end; + end; + end + else + begin + p1:=cerrornode.create; + Message(parser_e_no_procedure_to_access_property); + end; + end + else + begin + if getpropaccesslist(propsym,palt_read,propaccesslist) then + begin + sym := propaccesslist.firstsym^.sym; + case sym.typ of + fieldvarsym : + begin + { generate access code } + if not handle_staticfield_access(sym,false,p1) then + propaccesslist_to_node(p1,st,propaccesslist); + include(p1.flags,nf_isproperty); + end; + procsym : + begin + callflags:=[]; + { generate the method call } + membercall:=maybe_load_methodpointer(st,p1); + if membercall then + include(callflags,cnf_member_call); + p1:=ccallnode.create(paras,tprocsym(sym),st,p1,callflags); + paras:=nil; + include(p1.flags,nf_isproperty); + end + else + begin + p1:=cerrornode.create; + Message(type_e_mismatch); + end; + end; + end + else + begin + { error, no function to read property } + p1:=cerrornode.create; + Message(parser_e_no_procedure_to_access_property); + end; + end; + { release paras if not used } + if assigned(paras) then + paras.free; + end; + + + { the ID token has to be consumed before calling this function } + procedure do_member_read(structh:tabstractrecorddef;getaddr:boolean;sym:tsym;var p1:tnode;var again:boolean;callflags:tcallnodeflags); + var + isclassref:boolean; + begin + if sym=nil then + begin + { pattern is still valid unless + there is another ID just after the ID of sym } + Message1(sym_e_id_no_member,orgpattern); + p1.free; + p1:=cerrornode.create; + { try to clean up } + again:=false; + end + else + begin + if assigned(p1) then + begin + if not assigned(p1.resultdef) then + do_typecheckpass(p1); + isclassref:=(p1.resultdef.typ=classrefdef); + end + else + isclassref:=false; + + { we assume, that only procsyms and varsyms are in an object } + { symbol table, for classes, properties are allowed } + case sym.typ of + procsym: + begin + do_proc_call(sym,sym.owner,structh, + (getaddr and not(token in [_CARET,_POINT])), + again,p1,callflags); + { we need to know which procedure is called } + do_typecheckpass(p1); + { calling using classref? } + if isclassref and + (p1.nodetype=calln) and + assigned(tcallnode(p1).procdefinition) and + not(po_classmethod in tcallnode(p1).procdefinition.procoptions) and + not(tcallnode(p1).procdefinition.proctypeoption=potype_constructor) then + Message(parser_e_only_class_members_via_class_ref); + end; + fieldvarsym: + begin + if not handle_staticfield_access(sym,true,p1) then + begin + if isclassref then + if assigned(p1) and + ( + is_self_node(p1) or + (assigned(current_procinfo) and (current_procinfo.procdef.no_self_node) and + (current_procinfo.procdef.struct=structh))) then + Message(parser_e_only_class_members) + else + Message(parser_e_only_class_members_via_class_ref); + p1:=csubscriptnode.create(sym,p1); + end; + end; + propertysym: + begin + if isclassref and not (sp_static in sym.symoptions) then + Message(parser_e_only_class_members_via_class_ref); + handle_propertysym(tpropertysym(sym),sym.owner,p1); + end; + typesym: + begin + p1.free; + if try_to_consume(_LKLAMMER) then + begin + p1:=comp_expr(true,false); + consume(_RKLAMMER); + p1:=ctypeconvnode.create_explicit(p1,ttypesym(sym).typedef); + end + else + begin + p1:=ctypenode.create(ttypesym(sym).typedef); + if (is_class(ttypesym(sym).typedef) or is_objcclass(ttypesym(sym).typedef)) and + not(block_type in [bt_type,bt_const_type,bt_var_type]) then + p1:=cloadvmtaddrnode.create(p1); + end; + end; + constsym: + begin + p1.free; + p1:=genconstsymtree(tconstsym(sym)); + end; + staticvarsym: + begin + { typed constant is a staticvarsym + now they are absolutevarsym } + p1.free; + p1:=cloadnode.create(sym,sym.Owner); + end; + absolutevarsym: + begin + p1.free; + p1:=nil; + { typed constants are absolutebarsyms now to handle storage properly } + propaccesslist_to_node(p1,nil,tabsolutevarsym(sym).ref); + end + else + internalerror(16); + end; + end; + end; + + function handle_factor_typenode(hdef:tdef;getaddr:boolean;var again:boolean;sym:tsym;typeonly:boolean):tnode; + var + srsym : tsym; + srsymtable : tsymtable; + begin + if sym=nil then + sym:=hdef.typesym; + { allow Ordinal(Value) for type declarations since it + can be an enummeration declaration or a set lke: + (OrdinalType(const1)..OrdinalType(const2) } + if (not typeonly or is_ordinal(hdef))and try_to_consume(_LKLAMMER) then + begin + result:=comp_expr(true,false); + consume(_RKLAMMER); + { type casts to class helpers aren't allowed } + if is_objectpascal_helper(hdef) then + Message(parser_e_no_category_as_types) + { recovery by not creating a conversion node } + else + result:=ctypeconvnode.create_explicit(result,hdef); + end + else { not LKLAMMER } + if (token=_POINT) and + (is_object(hdef) or is_record(hdef)) then + begin + consume(_POINT); + { handles calling methods declared in parent objects + using "parentobject.methodname()" } + if assigned(current_structdef) and + not(getaddr) and + current_structdef.is_related(hdef) then + begin + result:=ctypenode.create(hdef); + ttypenode(result).typesym:=sym; + { search also in inherited methods } + searchsym_in_class(tobjectdef(hdef),tobjectdef(current_structdef),pattern,srsym,srsymtable,true); + if assigned(srsym) then + check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); + consume(_ID); + do_member_read(tabstractrecorddef(hdef),false,srsym,result,again,[]); + end + else + begin + { handles: + * @TObject.Load + * static methods and variables } + result:=ctypenode.create(hdef); + ttypenode(result).typesym:=sym; + { TP allows also @TMenu.Load if Load is only } + { defined in an anchestor class } + srsym:=search_struct_member(tabstractrecorddef(hdef),pattern); + if assigned(srsym) then + begin + check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); + consume(_ID); + do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[]); + end + else + Message1(sym_e_id_no_member,orgpattern); + end; + end + else + begin + { Normally here would be the check against the usage + of "TClassHelper.Something", but as that might be + used inside of system symbols like sizeof and + typeinfo this check is put into ttypenode.pass_1 + (for "TClassHelper" alone) and tcallnode.pass_1 + (for "TClassHelper.Something") } + { class reference ? } + if is_class(hdef) or + is_objcclass(hdef) then + begin + if getaddr and (token=_POINT) then + begin + consume(_POINT); + { allows @Object.Method } + { also allows static methods and variables } + result:=ctypenode.create(hdef); + ttypenode(result).typesym:=sym; + { TP allows also @TMenu.Load if Load is only } + { defined in an anchestor class } + srsym:=search_struct_member(tobjectdef(hdef),pattern); + if assigned(srsym) then + begin + check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); + consume(_ID); + do_member_read(tabstractrecorddef(hdef),getaddr,srsym,result,again,[]); + end + else + begin + Message1(sym_e_id_no_member,orgpattern); + consume(_ID); + end; + end + else + begin + result:=ctypenode.create(hdef); + ttypenode(result).typesym:=sym; + { For a type block we simply return only + the type. For all other blocks we return + a loadvmt node } + if not(block_type in [bt_type,bt_const_type,bt_var_type]) then + result:=cloadvmtaddrnode.create(result); + end; + end + else + begin + result:=ctypenode.create(hdef); + ttypenode(result).typesym:=sym; + end; + end; + end; + +{**************************************************************************** + Factor +****************************************************************************} + + +{--------------------------------------------- + PostFixOperators +---------------------------------------------} + + { returns whether or not p1 has been changed } + function postfixoperators(var p1:tnode;var again:boolean;getaddr:boolean): boolean; + + { tries to avoid syntax errors after invalid qualifiers } + procedure recoverconsume_postfixops; + begin + repeat + if not try_to_consume(_CARET) then + if try_to_consume(_POINT) then + try_to_consume(_ID) + else if try_to_consume(_LECKKLAMMER) then + begin + repeat + comp_expr(true,false); + until not try_to_consume(_COMMA); + consume(_RECKKLAMMER); + end + else if try_to_consume(_LKLAMMER) then + begin + repeat + comp_expr(true,false); + until not try_to_consume(_COMMA); + consume(_RKLAMMER); + end + else + break; + until false; + end; + + + procedure handle_variantarray; + var + p4 : tnode; + newstatement : tstatementnode; + tempresultvariant, + temp : ttempcreatenode; + paras : tcallparanode; + newblock : tnode; + countindices : aint; + begin + { create statements with call initialize the arguments and + call fpc_dynarr_setlength } + newblock:=internalstatements(newstatement); + + { get temp for array of indicies, + we set the real size later } + temp:=ctempcreatenode.create(s32inttype,4,tt_persistent,false); + addstatement(newstatement,temp); + + countindices:=0; + repeat + p4:=comp_expr(true,false); + + addstatement(newstatement,cassignmentnode.create( + ctemprefnode.create_offset(temp,countindices*s32inttype.size),p4)); + inc(countindices); + until not try_to_consume(_COMMA); + + { set real size } + temp.size:=countindices*s32inttype.size; + + consume(_RECKKLAMMER); + + { we need only a write access if a := follows } + if token=_ASSIGNMENT then + begin + consume(_ASSIGNMENT); + p4:=comp_expr(true,false); + + { create call to fpc_vararray_put } + paras:=ccallparanode.create(cordconstnode.create + (countindices,s32inttype,true), + ccallparanode.create(caddrnode.create_internal + (ctemprefnode.create(temp)), + ccallparanode.create(ctypeconvnode.create_internal(p4,cvarianttype), + ccallparanode.create(ctypeconvnode.create_internal(p1,cvarianttype) + ,nil)))); + + addstatement(newstatement,ccallnode.createintern('fpc_vararray_put',paras)); + addstatement(newstatement,ctempdeletenode.create(temp)); + end + else + begin + { create temp for result } + tempresultvariant:=ctempcreatenode.create(cvarianttype,cvarianttype.size,tt_persistent,true); + addstatement(newstatement,tempresultvariant); + + { create call to fpc_vararray_get } + paras:=ccallparanode.create(cordconstnode.create + (countindices,s32inttype,true), + ccallparanode.create(caddrnode.create_internal + (ctemprefnode.create(temp)), + ccallparanode.create(p1, + ccallparanode.create( + ctemprefnode.create(tempresultvariant) + ,nil)))); + + addstatement(newstatement,ccallnode.createintern('fpc_vararray_get',paras)); + addstatement(newstatement,ctempdeletenode.create(temp)); + { the last statement should return the value as + location and type, this is done be referencing the + temp and converting it first from a persistent temp to + normal temp } + addstatement(newstatement,ctempdeletenode.create_normal_temp(tempresultvariant)); + addstatement(newstatement,ctemprefnode.create(tempresultvariant)); + end; + p1:=newblock; + end; + + function parse_array_constructor(arrdef:tarraydef): tnode; + var + newstatement,assstatement:tstatementnode; + arrnode:ttempcreatenode; + temp2:ttempcreatenode; + assnode:tnode; + paracount:integer; + begin + result:=internalstatements(newstatement); + { create temp for result } + arrnode:=ctempcreatenode.create(arrdef,arrdef.size,tt_persistent,true); + addstatement(newstatement,arrnode); + + paracount:=0; + { check arguments and create an assignment calls } + if try_to_consume(_LKLAMMER) then + begin + assnode:=internalstatements(assstatement); + repeat + { arr[i] := param_i } + addstatement(assstatement, + cassignmentnode.create( + cvecnode.create( + ctemprefnode.create(arrnode), + cordconstnode.create(paracount,arrdef.rangedef,false)), + comp_expr(true,false))); + inc(paracount); + until not try_to_consume(_COMMA); + consume(_RKLAMMER); + end + else + assnode:=nil; + + { get temp for array of lengths } + temp2:=ctempcreatenode.create(sinttype,sinttype.size,tt_persistent,false); + addstatement(newstatement,temp2); + + { one dimensional } + addstatement(newstatement,cassignmentnode.create( + ctemprefnode.create_offset(temp2,0), + cordconstnode.create + (paracount,s32inttype,true))); + { create call to fpc_dynarr_setlength } + addstatement(newstatement,ccallnode.createintern('fpc_dynarray_setlength', + ccallparanode.create(caddrnode.create_internal + (ctemprefnode.create(temp2)), + ccallparanode.create(cordconstnode.create + (1,s32inttype,true), + ccallparanode.create(caddrnode.create_internal + (crttinode.create(tstoreddef(arrdef),initrtti,rdt_normal)), + ccallparanode.create( + ctypeconvnode.create_internal( + ctemprefnode.create(arrnode),voidpointertype), + nil)))) + + )); + { add assignment statememnts } + addstatement(newstatement,ctempdeletenode.create(temp2)); + if assigned(assnode) then + addstatement(newstatement,assnode); + { the last statement should return the value as + location and type, this is done be referencing the + temp and converting it first from a persistent temp to + normal temp } + addstatement(newstatement,ctempdeletenode.create_normal_temp(arrnode)); + addstatement(newstatement,ctemprefnode.create(arrnode)); + end; + + var + protsym : tpropertysym; + p2,p3 : tnode; + srsym : tsym; + srsymtable : TSymtable; + structh : tabstractrecorddef; + { shouldn't be used that often, so the extra overhead is ok to save + stack space } + dispatchstring : ansistring; + nodechanged : boolean; + calltype: tdispcalltype; + label + skipreckklammercheck; + begin + result:=false; + again:=true; + while again do + begin + { we need the resultdef } + do_typecheckpass_changed(p1,nodechanged); + result:=result or nodechanged; + + if codegenerror then + begin + recoverconsume_postfixops; + exit; + end; + { handle token } + case token of + _CARET: + begin + consume(_CARET); + + { support tp/mac procvar^ if the procvar returns a + pointer type } + if ((m_tp_procvar in current_settings.modeswitches) or + (m_mac_procvar in current_settings.modeswitches)) and + (p1.resultdef.typ=procvardef) and + (tprocvardef(p1.resultdef).returndef.typ=pointerdef) then + begin + p1:=ccallnode.create_procvar(nil,p1); + typecheckpass(p1); + end; + + if (p1.resultdef.typ<>pointerdef) then + begin + { ^ as binary operator is a problem!!!! (FK) } + again:=false; + Message(parser_e_invalid_qualifier); + recoverconsume_postfixops; + p1.destroy; + p1:=cerrornode.create; + end + else + p1:=cderefnode.create(p1); + end; + + _LECKKLAMMER: + begin + if is_class_or_interface_or_object(p1.resultdef) or + is_dispinterface(p1.resultdef) or is_record(p1.resultdef) then + begin + { default property } + protsym:=search_default_property(tabstractrecorddef(p1.resultdef)); + if not(assigned(protsym)) then + begin + p1.destroy; + p1:=cerrornode.create; + again:=false; + message(parser_e_no_default_property_available); + end + else + begin + { The property symbol is referenced indirect } + protsym.IncRefCount; + handle_propertysym(protsym,protsym.owner,p1); + end; + end + else + begin + consume(_LECKKLAMMER); + repeat + { in all of the cases below, p1 is changed } + case p1.resultdef.typ of + pointerdef: + begin + { support delphi autoderef } + if (tpointerdef(p1.resultdef).pointeddef.typ=arraydef) and + (m_autoderef in current_settings.modeswitches) then + p1:=cderefnode.create(p1); + p2:=comp_expr(true,false); + { Support Pbytevar[0..9] which returns array [0..9].} + if try_to_consume(_POINTPOINT) then + p2:=crangenode.create(p2,comp_expr(true,false)); + p1:=cvecnode.create(p1,p2); + end; + variantdef: + begin + handle_variantarray; + { the RECKKLAMMER is already read } + goto skipreckklammercheck; + end; + stringdef : + begin + p2:=comp_expr(true,false); + { Support string[0..9] which returns array [0..9] of char.} + if try_to_consume(_POINTPOINT) then + p2:=crangenode.create(p2,comp_expr(true,false)); + p1:=cvecnode.create(p1,p2); + end; + arraydef: + begin + p2:=comp_expr(true,false); + { support SEG:OFS for go32v2 Mem[] } + if (target_info.system in [system_i386_go32v2,system_i386_watcom]) and + (p1.nodetype=loadn) and + assigned(tloadnode(p1).symtableentry) and + assigned(tloadnode(p1).symtableentry.owner.name) and + (tloadnode(p1).symtableentry.owner.name^='SYSTEM') and + ((tloadnode(p1).symtableentry.name='MEM') or + (tloadnode(p1).symtableentry.name='MEMW') or + (tloadnode(p1).symtableentry.name='MEML')) then + begin + if try_to_consume(_COLON) then + begin + p3:=caddnode.create(muln,cordconstnode.create($10,s32inttype,false),p2); + p2:=comp_expr(true,false); + p2:=caddnode.create(addn,p2,p3); + if try_to_consume(_POINTPOINT) then + { Support mem[$a000:$0000..$07ff] which returns array [0..$7ff] of memtype.} + p2:=crangenode.create(p2,caddnode.create(addn,comp_expr(true,false),p3.getcopy)); + p1:=cvecnode.create(p1,p2); + include(tvecnode(p1).flags,nf_memseg); + include(tvecnode(p1).flags,nf_memindex); + end + else + begin + if try_to_consume(_POINTPOINT) then + { Support mem[$80000000..$80000002] which returns array [0..2] of memtype.} + p2:=crangenode.create(p2,comp_expr(true,false)); + p1:=cvecnode.create(p1,p2); + include(tvecnode(p1).flags,nf_memindex); + end; + end + else + begin + if try_to_consume(_POINTPOINT) then + { Support arrayvar[0..9] which returns array [0..9] of arraytype.} + p2:=crangenode.create(p2,comp_expr(true,false)); + p1:=cvecnode.create(p1,p2); + end; + end; + else + begin + if p1.resultdef.typ<>undefineddef then + Message(parser_e_invalid_qualifier); + p1.destroy; + p1:=cerrornode.create; + comp_expr(true,false); + again:=false; + end; + end; + do_typecheckpass(p1); + until not try_to_consume(_COMMA); + consume(_RECKKLAMMER); + { handle_variantarray eats the RECKKLAMMER and jumps here } + skipreckklammercheck: + end; + end; + + _POINT : + begin + consume(_POINT); + if (p1.resultdef.typ=pointerdef) and + (m_autoderef in current_settings.modeswitches) and + { don't auto-deref objc.id, because then the code + below for supporting id.anyobjcmethod isn't triggered } + (p1.resultdef<>objc_idtype) then + begin + p1:=cderefnode.create(p1); + do_typecheckpass(p1); + end; + { procvar.<something> can never mean anything so always + try to call it in case it returns a record/object/... } + maybe_call_procvar(p1,false); + + case p1.resultdef.typ of + recorddef: + begin + if token=_ID then + begin + structh:=tabstractrecorddef(p1.resultdef); + searchsym_in_record(structh,pattern,srsym,srsymtable); + if assigned(srsym) then + begin + check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); + consume(_ID); + do_member_read(structh,getaddr,srsym,p1,again,[]); + end + else + begin + Message1(sym_e_id_no_member,orgpattern); + p1.destroy; + p1:=cerrornode.create; + { try to clean up } + consume(_ID); + end; + end + else + consume(_ID); + end; + enumdef: + begin + if token=_ID then + begin + srsym:=tsym(tenumdef(p1.resultdef).symtable.Find(pattern)); + p1.destroy; + if assigned(srsym) and (srsym.typ=enumsym) then + begin + check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); + p1:=genenumnode(tenumsym(srsym)); + end + else + begin + Message1(sym_e_id_no_member,orgpattern); + p1:=cerrornode.create; + end; + end; + consume(_ID); + end; + arraydef: + begin + if is_dynamic_array(p1.resultdef) then + begin + if token=_ID then + begin + if pattern='CREATE' then + begin + consume(_ID); + p2:=parse_array_constructor(tarraydef(p1.resultdef)); + p1.destroy; + p1:=p2; + end + else + begin + Message2(scan_f_syn_expected,'CREATE',pattern); + p1.destroy; + p1:=cerrornode.create; + consume(_ID); + end; + end; + end + else + begin + Message(parser_e_invalid_qualifier); + p1.destroy; + p1:=cerrornode.create; + consume(_ID); + end; + end; + variantdef: + begin + { dispatch call? } + { lhs := v.ident[parameters] -> property get + lhs := v.ident(parameters) -> method call + v.ident[parameters] := rhs -> property put + v.ident(parameters) := rhs -> also property put } + if token=_ID then + begin + dispatchstring:=orgpattern; + consume(_ID); + calltype:=dct_method; + if try_to_consume(_LKLAMMER) then + begin + p2:=parse_paras(false,true,_RKLAMMER); + consume(_RKLAMMER); + end + else if try_to_consume(_LECKKLAMMER) then + begin + p2:=parse_paras(false,true,_RECKKLAMMER); + consume(_RECKKLAMMER); + calltype:=dct_propget; + end + else + p2:=nil; + { property setter? } + if (token=_ASSIGNMENT) and not(afterassignment) then + begin + consume(_ASSIGNMENT); + { read the expression } + p3:=comp_expr(true,false); + { concat value parameter too } + p2:=ccallparanode.create(p3,p2); + p1:=translate_disp_call(p1,p2,dct_propput,dispatchstring,0,voidtype); + end + else + { this is only an approximation + setting useresult if not necessary is only a waste of time, no more, no less (FK) } + if afterassignment or in_args or (token<>_SEMICOLON) then + p1:=translate_disp_call(p1,p2,calltype,dispatchstring,0,cvarianttype) + else + p1:=translate_disp_call(p1,p2,calltype,dispatchstring,0,voidtype); + end + else { Error } + Consume(_ID); + end; + classrefdef: + begin + if token=_ID then + begin + structh:=tobjectdef(tclassrefdef(p1.resultdef).pointeddef); + searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,true); + if assigned(srsym) then + begin + check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); + consume(_ID); + do_member_read(structh,getaddr,srsym,p1,again,[]); + end + else + begin + Message1(sym_e_id_no_member,orgpattern); + p1.destroy; + p1:=cerrornode.create; + { try to clean up } + consume(_ID); + end; + end + else { Error } + Consume(_ID); + end; + objectdef: + begin + if token=_ID then + begin + structh:=tobjectdef(p1.resultdef); + searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,true); + if assigned(srsym) then + begin + check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); + consume(_ID); + do_member_read(structh,getaddr,srsym,p1,again,[]); + end + else + begin + Message1(sym_e_id_no_member,orgpattern); + p1.destroy; + p1:=cerrornode.create; + { try to clean up } + consume(_ID); + end; + end + else { Error } + Consume(_ID); + end; + pointerdef: + begin + if (p1.resultdef=objc_idtype) then + begin + { objc's id type can be used to call any + Objective-C method of any Objective-C class + type that's currently in scope } + if search_objc_method(pattern,srsym,srsymtable) then + begin + consume(_ID); + do_proc_call(srsym,srsymtable,nil, + (getaddr and not(token in [_CARET,_POINT])), + again,p1,[cnf_objc_id_call]); + { we need to know which procedure is called } + do_typecheckpass(p1); + end + else + begin + consume(_ID); + Message(parser_e_methode_id_expected); + end; + end + else + begin + Message(parser_e_invalid_qualifier); + if tpointerdef(p1.resultdef).pointeddef.typ in [recorddef,objectdef,classrefdef] then + Message(parser_h_maybe_deref_caret_missing); + end + end; + else + begin + if p1.resultdef.typ<>undefineddef then + Message(parser_e_invalid_qualifier); + p1.destroy; + p1:=cerrornode.create; + { Error } + consume(_ID); + end; + end; + end; + + else + begin + { is this a procedure variable ? } + if assigned(p1.resultdef) and + (p1.resultdef.typ=procvardef) then + begin + { Typenode for typecasting or expecting a procvar } + if (p1.nodetype=typen) or + ( + assigned(getprocvardef) and + equal_defs(p1.resultdef,getprocvardef) + ) then + begin + if try_to_consume(_LKLAMMER) then + begin + p1:=comp_expr(true,false); + consume(_RKLAMMER); + p1:=ctypeconvnode.create_explicit(p1,p1.resultdef); + end + else + again:=false + end + else + begin + if try_to_consume(_LKLAMMER) then + begin + p2:=parse_paras(false,false,_RKLAMMER); + consume(_RKLAMMER); + p1:=ccallnode.create_procvar(p2,p1); + { proc():= is never possible } + if token=_ASSIGNMENT then + begin + Message(parser_e_illegal_expression); + p1.free; + p1:=cerrornode.create; + again:=false; + end; + end + else + again:=false; + end; + end + else + again:=false; + end; + end; + + { we only try again if p1 was changed } + if again or + (p1.nodetype=errorn) then + result:=true; + end; { while again } + end; + + function is_member_read(sym: tsym; st: tsymtable; var p1: tnode; + out memberparentdef: tdef): boolean; + var + hdef : tdef; + begin + result:=true; + memberparentdef:=nil; + + case st.symtabletype of + ObjectSymtable, + recordsymtable: + begin + memberparentdef:=tdef(st.defowner); + exit; + end; + WithSymtable: + begin + if assigned(p1) then + internalerror(2007012002); + + hdef:=tnode(twithsymtable(st).withrefnode).resultdef; + p1:=tnode(twithsymtable(st).withrefnode).getcopy; + + if not(hdef.typ in [objectdef,classrefdef]) then + exit; + + if (hdef.typ=classrefdef) then + hdef:=tclassrefdef(hdef).pointeddef; + memberparentdef:=hdef; + end; + else + result:=false; + end; + end; + + {$maxfpuregisters 0} + + function factor(getaddr,typeonly:boolean) : tnode; + + {--------------------------------------------- + Factor_read_id + ---------------------------------------------} + + procedure factor_read_id(out p1:tnode;var again:boolean); + var + srsym : tsym; + srsymtable : TSymtable; + hdef : tdef; + orgstoredpattern, + storedpattern : string; + callflags: tcallnodeflags; + t : ttoken; + unit_found : boolean; + begin + { allow post fix operators } + again:=true; + + { first check for identifier } + if token<>_ID then + begin + srsym:=generrorsym; + srsymtable:=nil; + consume(_ID); + end + else + begin + if typeonly then + searchsym_type(pattern,srsym,srsymtable) + else + searchsym(pattern,srsym,srsymtable); + + { handle unit specification like System.Writeln } + unit_found:=try_consume_unitsym(srsym,srsymtable,t,true); + storedpattern:=pattern; + orgstoredpattern:=orgpattern; + consume(t); + + { named parameter support } + found_arg_name:=false; + + if not(unit_found) and + named_args_allowed and + (token=_ASSIGNMENT) then + begin + found_arg_name:=true; + p1:=cstringconstnode.createstr(storedpattern); + consume(_ASSIGNMENT); + exit; + end; + + { check hints, but only if it isn't a potential generic symbol; + that is checked in sub_expr if it isn't a generic } + if assigned(srsym) and + not ( + (srsym.typ=typesym) and + (ttypesym(srsym).typedef.typ in [recorddef,objectdef,arraydef,procvardef,undefineddef]) and + not (sp_generic_para in srsym.symoptions) and + (token in [_LT, _LSHARPBRACKET]) + ) then + check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); + + { if nothing found give error and return errorsym } + if not assigned(srsym) or + { is this a generic dummy symbol? } + ((srsym.typ=typesym) and + assigned(ttypesym(srsym).typedef) and + (ttypesym(srsym).typedef.typ=undefineddef) and + not (sp_generic_para in srsym.symoptions) and + not (token in [_LT, _LSHARPBRACKET]) and + not ( + { in non-Delphi modes the generic class' name without a + "specialization" or "<T>" may be used to identify the + current class } + (sp_generic_dummy in srsym.symoptions) and + assigned(current_structdef) and + (df_generic in current_structdef.defoptions) and + not (m_delphi in current_settings.modeswitches) and + (upper(srsym.realname)=copy(current_structdef.objname^,1,pos('$',current_structdef.objname^)-1)) + )) then + begin + identifier_not_found(orgstoredpattern); + srsym:=generrorsym; + srsymtable:=nil; + end; + end; + + { Access to funcret or need to call the function? } + if (srsym.typ in [absolutevarsym,localvarsym,paravarsym]) and + (vo_is_funcret in tabstractvarsym(srsym).varoptions) and + { result(x) is not allowed } + not(vo_is_result in tabstractvarsym(srsym).varoptions) and + ( + (token=_LKLAMMER) or + ( + ( + (m_tp7 in current_settings.modeswitches) or + (m_delphi in current_settings.modeswitches) + ) and + (afterassignment or in_args) + ) + ) then + begin + hdef:=tdef(srsym.owner.defowner); + if assigned(hdef) and + (hdef.typ=procdef) then + srsym:=tprocdef(hdef).procsym + else + begin + Message(parser_e_illegal_expression); + srsym:=generrorsym; + end; + srsymtable:=srsym.owner; + end; + + begin + case srsym.typ of + absolutevarsym : + begin + if (tabsolutevarsym(srsym).abstyp=tovar) then + begin + p1:=nil; + propaccesslist_to_node(p1,nil,tabsolutevarsym(srsym).ref); + p1:=ctypeconvnode.create(p1,tabsolutevarsym(srsym).vardef); + include(p1.flags,nf_absolute); + end + else + p1:=cloadnode.create(srsym,srsymtable); + end; + + staticvarsym, + localvarsym, + paravarsym, + fieldvarsym : + begin + { check if we are reading a field of an object/class/ } + { record. is_member_read() will deal with withsymtables } + { if needed. } + p1:=nil; + if is_member_read(srsym,srsymtable,p1,hdef) then + begin + { if the field was originally found in an } + { objectsymtable, it means it's part of self } + { if only method from which it was called is } + { not class static } + if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then + { if we are accessing a owner procsym from the nested } + { class we need to call it as a class member } + if assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then + p1:=cloadvmtaddrnode.create(ctypenode.create(hdef)) + else + if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then + p1:=cloadvmtaddrnode.create(ctypenode.create(current_procinfo.procdef.struct)) + else + p1:=load_self_node; + { now, if the field itself is part of an objectsymtab } + { (it can be even if it was found in a withsymtable, } + { e.g., "with classinstance do field := 5"), then } + { let do_member_read handle it } + if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then + do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[]) + else + { otherwise it's a regular record subscript } + p1:=csubscriptnode.create(srsym,p1); + end + else + { regular non-field load } + p1:=cloadnode.create(srsym,srsymtable); + end; + + syssym : + begin + p1:=statement_syssym(tsyssym(srsym).number); + end; + + typesym : + begin + hdef:=ttypesym(srsym).typedef; + if not assigned(hdef) then + begin + again:=false; + end + else + begin + { We need to know if this unit uses Variants } + if (hdef=cvarianttype) and + not(cs_compilesystem in current_settings.moduleswitches) then + current_module.flags:=current_module.flags or uf_uses_variants; + p1:=handle_factor_typenode(hdef,getaddr,again,srsym,typeonly); + end; + end; + + enumsym : + begin + p1:=genenumnode(tenumsym(srsym)); + end; + + constsym : + begin + if tconstsym(srsym).consttyp=constresourcestring then + begin + p1:=cloadnode.create(srsym,srsymtable); + do_typecheckpass(p1); + p1.resultdef:=getansistringdef; + end + else + p1:=genconstsymtree(tconstsym(srsym)); + end; + + procsym : + begin + p1:=nil; + { check if it's a method/class method } + if is_member_read(srsym,srsymtable,p1,hdef) then + begin + { if we are accessing a owner procsym from the nested } + { class we need to call it as a class member } + if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) and + assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then + p1:=cloadvmtaddrnode.create(ctypenode.create(hdef)); + { not srsymtable.symtabletype since that can be } + { withsymtable as well } + if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then + do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[]) + else + { no procsyms in records (yet) } + internalerror(2007012006); + end + else + begin + { regular procedure/function call } + if not unit_found then + callflags:=[] + else + callflags:=[cnf_unit_specified]; + do_proc_call(srsym,srsymtable,nil, + (getaddr and not(token in [_CARET,_POINT,_LECKKLAMMER])), + again,p1,callflags); + end; + end; + + propertysym : + begin + p1:=nil; + { property of a class/object? } + if is_member_read(srsym,srsymtable,p1,hdef) then + begin + if (srsymtable.symtabletype in [ObjectSymtable,recordsymtable]) then + { if we are accessing a owner procsym from the nested } + { class we need to call it as a class member } + if assigned(current_structdef) and (current_structdef<>hdef) and is_owned_by(current_structdef,hdef) then + p1:=cloadvmtaddrnode.create(ctypenode.create(hdef)) + else + if assigned(current_procinfo) and current_procinfo.procdef.no_self_node then + { no self node in static class methods } + p1:=cloadvmtaddrnode.create(ctypenode.create(hdef)) + else + p1:=load_self_node; + { not srsymtable.symtabletype since that can be } + { withsymtable as well } + if (srsym.owner.symtabletype in [ObjectSymtable,recordsymtable]) then + do_member_read(tabstractrecorddef(hdef),getaddr,srsym,p1,again,[]) + else + { no propertysyms in records (yet) } + internalerror(2009111510); + end + else + { no method pointer } + begin + handle_propertysym(tpropertysym(srsym),srsymtable,p1); + end; + end; + + labelsym : + begin + { Support @label } + if getaddr then + begin + if srsym.owner<>current_procinfo.procdef.localst then + CGMessage(parser_e_label_outside_proc); + p1:=cloadnode.create(srsym,srsym.owner) + end + else + begin + consume(_COLON); + if tlabelsym(srsym).defined then + Message(sym_e_label_already_defined); + if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then + begin + tlabelsym(srsym).nonlocal:=true; + exclude(current_procinfo.procdef.procoptions,po_inline); + end; + if tlabelsym(srsym).nonlocal and + (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then + Message(sym_e_interprocgoto_into_init_final_code_not_allowed); + tlabelsym(srsym).defined:=true; + p1:=clabelnode.create(nil,tlabelsym(srsym)); + tlabelsym(srsym).code:=p1; + end; + end; + + errorsym : + begin + p1:=cerrornode.create; + if try_to_consume(_LKLAMMER) then + begin + parse_paras(false,false,_RKLAMMER); + consume(_RKLAMMER); + end; + end; + + else + begin + p1:=cerrornode.create; + Message(parser_e_illegal_expression); + end; + end; { end case } + end; + end; + + {--------------------------------------------- + Factor_Read_Set + ---------------------------------------------} + + { Read a set between [] } + function factor_read_set:tnode; + var + p1,p2 : tnode; + lastp, + buildp : tarrayconstructornode; + old_allow_array_constructor : boolean; + begin + buildp:=nil; + { be sure that a least one arrayconstructn is used, also for an + empty [] } + if token=_RECKKLAMMER then + buildp:=carrayconstructornode.create(nil,buildp) + else + repeat + { nested array constructors are not allowed, see also tests/webtbs/tw17213.pp } + old_allow_array_constructor:=allow_array_constructor; + allow_array_constructor:=false; + p1:=comp_expr(true,false); + if try_to_consume(_POINTPOINT) then + begin + p2:=comp_expr(true,false); + p1:=carrayconstructorrangenode.create(p1,p2); + end; + { insert at the end of the tree, to get the correct order } + if not assigned(buildp) then + begin + buildp:=carrayconstructornode.create(p1,nil); + lastp:=buildp; + end + else + begin + lastp.right:=carrayconstructornode.create(p1,nil); + lastp:=tarrayconstructornode(lastp.right); + end; + allow_array_constructor:=old_allow_array_constructor; + { there could be more elements } + until not try_to_consume(_COMMA); + factor_read_set:=buildp; + end; + + + {--------------------------------------------- + Factor (Main) + ---------------------------------------------} + + var + l : longint; + ic : int64; + qc : qword; + p1 : tnode; + code : integer; + srsym : tsym; + srsymtable : TSymtable; + pd : tprocdef; + hclassdef : tobjectdef; + d : bestreal; + cur : currency; + hs,hsorg : string; + hdef : tdef; + filepos : tfileposinfo; + callflags : tcallnodeflags; + again, + updatefpos, + nodechanged : boolean; + begin + { can't keep a copy of p1 and compare pointers afterwards, because + p1 may be freed and reallocated in the same place! } + updatefpos:=false; + p1:=nil; + filepos:=current_tokenpos; + again:=false; + if token=_ID then + begin + again:=true; + { Handle references to self } + if (idtoken=_SELF) and + not(block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) and + assigned(current_structdef) then + begin + p1:=load_self_node; + consume(_ID); + again:=true; + end + else + factor_read_id(p1,again); + + if assigned(p1) then + begin + { factor_read_id will set the filepos to after the id, + and in case of _SELF the filepos will already be the + same as filepos (so setting it again doesn't hurt). } + p1.fileinfo:=filepos; + filepos:=current_tokenpos; + end; + { handle post fix operators } + updatefpos:=postfixoperators(p1,again,getaddr); + end + else + begin + updatefpos:=true; + case token of + _RETURN : + begin + consume(_RETURN); + if not(token in [_SEMICOLON,_ELSE,_END]) then + p1 := cexitnode.create(comp_expr(true,false)) + else + p1 := cexitnode.create(nil); + end; + _INHERITED : + begin + again:=true; + consume(_INHERITED); + if assigned(current_procinfo) and + assigned(current_structdef) and + (current_structdef.typ=objectdef) then + begin + { for record helpers in mode Delphi "inherited" is not + allowed } + if is_objectpascal_helper(current_structdef) and + (m_delphi in current_settings.modeswitches) and + is_record(tobjectdef(current_structdef).extendeddef) then + Message(parser_e_inherited_not_in_record); + hclassdef:=tobjectdef(current_structdef).childof; + { Objective-C categories *replace* methods in the class + they extend, or add methods to it. So calling an + inherited method always calls the method inherited from + the parent of the extended class } + if is_objccategory(current_structdef) then + hclassdef:=hclassdef.childof; + { if inherited; only then we need the method with + the same name } + if token <> _ID then + begin + hs:=current_procinfo.procdef.procsym.name; + hsorg:=current_procinfo.procdef.procsym.realname; + anon_inherited:=true; + { For message methods we need to search using the message + number or string } + pd:=tprocdef(tprocsym(current_procinfo.procdef.procsym).ProcdefList[0]); + srdef:=nil; + if (po_msgint in pd.procoptions) then + searchsym_in_class_by_msgint(hclassdef,pd.messageinf.i,srdef,srsym,srsymtable) + else + if (po_msgstr in pd.procoptions) then + searchsym_in_class_by_msgstr(hclassdef,pd.messageinf.str^,srsym,srsymtable) + else + { helpers have their own ways of dealing with inherited } + if is_objectpascal_helper(current_structdef) then + searchsym_in_helper(tobjectdef(current_structdef),tobjectdef(current_structdef),hs,srsym,srsymtable,true) + else + searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable,true); + end + else + begin + hs:=pattern; + hsorg:=orgpattern; + consume(_ID); + anon_inherited:=false; + { helpers have their own ways of dealing with inherited } + if is_objectpascal_helper(current_structdef) then + searchsym_in_helper(tobjectdef(current_structdef),tobjectdef(current_structdef),hs,srsym,srsymtable,true) + else + searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable,true); + end; + if assigned(srsym) then + begin + check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); + { load the procdef from the inherited class and + not from self } + case srsym.typ of + procsym: + begin + if is_objectpascal_helper(current_structdef) then + begin + { for a helper load the procdef either from the + extended type, from the parent helper or from + the extended type of the parent helper + depending on the def the found symbol belongs + to } + if (srsym.Owner.defowner.typ=objectdef) and + is_objectpascal_helper(tobjectdef(srsym.Owner.defowner)) then + if current_structdef.is_related(tdef(srsym.Owner.defowner)) and + assigned(tobjectdef(current_structdef).childof) then + hdef:=tobjectdef(current_structdef).childof + else + hdef:=tobjectdef(srsym.Owner.defowner).extendeddef + else + hdef:=tdef(srsym.Owner.defowner); + end + else + hdef:=hclassdef; + if (po_classmethod in current_procinfo.procdef.procoptions) or + (po_staticmethod in current_procinfo.procdef.procoptions) then + hdef:=tclassrefdef.create(hdef); + p1:=ctypenode.create(hdef); + { we need to allow helpers here } + ttypenode(p1).helperallowed:=true; + end; + propertysym: + ; + else + begin + Message(parser_e_methode_id_expected); + p1:=cerrornode.create; + end; + end; + callflags:=[cnf_inherited]; + if anon_inherited then + include(callflags,cnf_anon_inherited); + do_member_read(hclassdef,getaddr,srsym,p1,again,callflags); + end + else + begin + if anon_inherited then + begin + { For message methods we need to call DefaultHandler } + if (po_msgint in pd.procoptions) or + (po_msgstr in pd.procoptions) then + begin + searchsym_in_class(hclassdef,hclassdef,'DEFAULTHANDLER',srsym,srsymtable,true); + if not assigned(srsym) or + (srsym.typ<>procsym) then + internalerror(200303171); + p1:=nil; + do_proc_call(srsym,srsym.owner,hclassdef,false,again,p1,[]); + end + else + begin + { we need to ignore the inherited; } + p1:=cnothingnode.create; + end; + end + else + begin + Message1(sym_e_id_no_member,hsorg); + p1:=cerrornode.create; + end; + again:=false; + end; + { turn auto inheriting off } + anon_inherited:=false; + end + else + begin + { in case of records we use a more clear error message } + if assigned(current_structdef) and + (current_structdef.typ=recorddef) then + Message(parser_e_inherited_not_in_record) + else + Message(parser_e_generic_methods_only_in_methods); + again:=false; + p1:=cerrornode.create; + end; + postfixoperators(p1,again,getaddr); + end; + + _INTCONST : + begin + {Try first wether the value fits in an int64.} + val(pattern,ic,code); + if code=0 then + begin + consume(_INTCONST); + int_to_type(ic,hdef); + p1:=cordconstnode.create(ic,hdef,true); + end + else + begin + { try qword next } + val(pattern,qc,code); + if code=0 then + begin + consume(_INTCONST); + int_to_type(qc,hdef); + p1:=cordconstnode.create(qc,hdef,true); + end; + end; + if code<>0 then + begin + { finally float } + val(pattern,d,code); + if code<>0 then + begin + Message(parser_e_invalid_integer); + consume(_INTCONST); + l:=1; + p1:=cordconstnode.create(l,sinttype,true); + end + else + begin + consume(_INTCONST); + p1:=crealconstnode.create(d,pbestrealtype^); + end; + end + else + { the necessary range checking has already been done by val } + tordconstnode(p1).rangecheck:=false; + end; + + _REALNUMBER : + begin + val(pattern,d,code); + if code<>0 then + begin + Message(parser_e_error_in_real); + d:=1.0; + end; + consume(_REALNUMBER); +{$ifdef FPC_REAL2REAL_FIXED} + if current_settings.fputype=fpu_none then + Message(parser_e_unsupported_real); + if (current_settings.minfpconstprec=s32real) and + (d = single(d)) then + p1:=crealconstnode.create(d,s32floattype) + else if (current_settings.minfpconstprec=s64real) and + (d = double(d)) then + p1:=crealconstnode.create(d,s64floattype) + else +{$endif FPC_REAL2REAL_FIXED} + p1:=crealconstnode.create(d,pbestrealtype^); +{$ifdef FPC_HAS_STR_CURRENCY} + val(pattern,cur,code); + if code=0 then + trealconstnode(p1).value_currency:=cur; +{$endif FPC_HAS_STR_CURRENCY} + end; + + _STRING : + begin + string_dec(hdef,true); + { STRING can be also a type cast } + if try_to_consume(_LKLAMMER) then + begin + p1:=comp_expr(true,false); + consume(_RKLAMMER); + p1:=ctypeconvnode.create_explicit(p1,hdef); + { handle postfix operators here e.g. string(a)[10] } + again:=true; + postfixoperators(p1,again,getaddr); + end + else + p1:=ctypenode.create(hdef); + end; + + _FILE : + begin + hdef:=cfiletype; + consume(_FILE); + { FILE can be also a type cast } + if try_to_consume(_LKLAMMER) then + begin + p1:=comp_expr(true,false); + consume(_RKLAMMER); + p1:=ctypeconvnode.create_explicit(p1,hdef); + { handle postfix operators here e.g. string(a)[10] } + again:=true; + postfixoperators(p1,again,getaddr); + end + else + begin + p1:=ctypenode.create(hdef); + end; + end; + + _CSTRING : + begin + p1:=cstringconstnode.createpchar(ansistring2pchar(cstringpattern),length(cstringpattern)); + consume(_CSTRING); + end; + + _CCHAR : + begin + p1:=cordconstnode.create(ord(pattern[1]),cchartype,true); + consume(_CCHAR); + end; + + _CWSTRING: + begin + p1:=cstringconstnode.createwstr(patternw); + consume(_CWSTRING); + end; + + _CWCHAR: + begin + p1:=cordconstnode.create(ord(getcharwidestring(patternw,0)),cwidechartype,true); + consume(_CWCHAR); + end; + + _KLAMMERAFFE : + begin + consume(_KLAMMERAFFE); + got_addrn:=true; + { support both @<x> and @(<x>) } + if try_to_consume(_LKLAMMER) then + begin + p1:=factor(true,false); + if token in [_CARET,_POINT,_LECKKLAMMER] then + begin + again:=true; + postfixoperators(p1,again,getaddr); + end + else + consume(_RKLAMMER); + end + else + p1:=factor(true,false); + if token in [_CARET,_POINT,_LECKKLAMMER] then + begin + again:=true; + postfixoperators(p1,again,getaddr); + end; + got_addrn:=false; + p1:=caddrnode.create(p1); + p1.fileinfo:=filepos; + if cs_typed_addresses in current_settings.localswitches then + include(p1.flags,nf_typedaddr); + { Store the procvar that we are expecting, the + addrn will use the information to find the correct + procdef or it will return an error } + if assigned(getprocvardef) and + (taddrnode(p1).left.nodetype = loadn) then + taddrnode(p1).getprocvardef:=getprocvardef; + end; + + _LKLAMMER : + begin + consume(_LKLAMMER); + p1:=comp_expr(true,false); + consume(_RKLAMMER); + { it's not a good solution } + { but (a+b)^ makes some problems } + if token in [_CARET,_POINT,_LECKKLAMMER] then + begin + again:=true; + postfixoperators(p1,again,getaddr); + end; + end; + + _LECKKLAMMER : + begin + consume(_LECKKLAMMER); + p1:=factor_read_set; + consume(_RECKKLAMMER); + end; + + _PLUS : + begin + consume(_PLUS); + p1:=factor(false,false); + p1:=cunaryplusnode.create(p1); + end; + + _MINUS : + begin + consume(_MINUS); + if (token = _INTCONST) and not(m_isolike_unary_minus in current_settings.modeswitches) then + begin + { ugly hack, but necessary to be able to parse } + { -9223372036854775808 as int64 (JM) } + pattern := '-'+pattern; + p1:=sub_expr(oppower,false,false,nil); + { -1 ** 4 should be - (1 ** 4) and not + (-1) ** 4 + This was the reason of tw0869.pp test failure PM } + if p1.nodetype=starstarn then + begin + if tbinarynode(p1).left.nodetype=ordconstn then + begin + tordconstnode(tbinarynode(p1).left).value:=-tordconstnode(tbinarynode(p1).left).value; + p1:=cunaryminusnode.create(p1); + end + else if tbinarynode(p1).left.nodetype=realconstn then + begin + trealconstnode(tbinarynode(p1).left).value_real:=-trealconstnode(tbinarynode(p1).left).value_real; + trealconstnode(tbinarynode(p1).left).value_currency:=-trealconstnode(tbinarynode(p1).left).value_currency; + p1:=cunaryminusnode.create(p1); + end + else + internalerror(20021029); + end; + end + else + begin + if m_isolike_unary_minus in current_settings.modeswitches then + p1:=sub_expr(opmultiply,false,false,nil) + else + p1:=sub_expr(oppower,false,false,nil); + + p1:=cunaryminusnode.create(p1); + end; + end; + + _OP_NOT : + begin + consume(_OP_NOT); + p1:=factor(false,false); + p1:=cnotnode.create(p1); + end; + + _TRUE : + begin + consume(_TRUE); + p1:=cordconstnode.create(1,pasbool8type,false); + end; + + _FALSE : + begin + consume(_FALSE); + p1:=cordconstnode.create(0,pasbool8type,false); + end; + + _NIL : + begin + consume(_NIL); + p1:=cnilnode.create; + { It's really ugly code nil^, but delphi allows it } + if token in [_CARET] then + begin + again:=true; + postfixoperators(p1,again,getaddr); + end; + end; + _OBJCPROTOCOL: + begin + { The @protocol keyword is used in two ways in Objective-C: + 1) to declare protocols (~ Object Pascal interfaces) + 2) to obtain the metaclass (~ Object Pascal) "class of") + of a declared protocol + This code is for handling the second case. Because of 1), + we cannot simply use a system unit symbol. + } + consume(_OBJCPROTOCOL); + consume(_LKLAMMER); + p1:=factor(false,false); + consume(_RKLAMMER); + p1:=cinlinenode.create(in_objc_protocol_x,false,p1); + end; + + else + begin + Message(parser_e_illegal_expression); + p1:=cerrornode.create; + { recover } + consume(token); + end; + end; + end; + + { generate error node if no node is created } + if not assigned(p1) then + begin +{$ifdef EXTDEBUG} + Comment(V_Warning,'factor: p1=nil'); +{$endif} + p1:=cerrornode.create; + updatefpos:=true; + end; + + { get the resultdef for the node } + if (not assigned(p1.resultdef)) then + begin + do_typecheckpass_changed(p1,nodechanged); + updatefpos:=updatefpos or nodechanged; + end; + + if assigned(p1) and + updatefpos then + p1.fileinfo:=filepos; + factor:=p1; + end; + {$maxfpuregisters default} + + procedure post_comp_expr_gendef(var def: tdef); + var + p1 : tnode; + again : boolean; + begin + if not assigned(def) then + internalerror(2011053001); + again:=false; + { handle potential typecasts, etc } + p1:=handle_factor_typenode(def,false,again,nil,false); + { parse postfix operators } + postfixoperators(p1,again,false); + if assigned(p1) and (p1.nodetype=typen) then + def:=ttypenode(p1).typedef + else + def:=generrordef; + end; + +{**************************************************************************** + Sub_Expr +****************************************************************************} + const + { Warning these stay be ordered !! } + operator_levels:array[Toperator_precedence] of set of NOTOKEN..last_operator= + ([_LT,_LTE,_GT,_GTE,_EQ,_NE,_OP_IN], + [_PLUS,_MINUS,_OP_OR,_PIPE,_OP_XOR], + [_CARET,_SYMDIF,_STARSTAR,_STAR,_SLASH, + _OP_AS,_OP_IS,_OP_AND,_AMPERSAND,_OP_DIV,_OP_MOD,_OP_SHL,_OP_SHR], + [_STARSTAR] ); + + function sub_expr(pred_level:Toperator_precedence;accept_equal,typeonly:boolean;factornode:tnode):tnode; + {Reads a subexpression while the operators are of the current precedence + level, or any higher level. Replaces the old term, simpl_expr and + simpl2_expr.} + + function istypenode(n:tnode):boolean;inline; + { Checks whether the given node is a type node or a VMT node containing a + typenode. This is used in the code for inline specializations in the + _LT branch below } + begin + result:=assigned(n) and + ( + (n.nodetype=typen) or + ( + (n.nodetype=loadvmtaddrn) and + (tloadvmtaddrnode(n).left.nodetype=typen) + ) + ); + end; + + function gettypedef(n:tnode):tdef;inline; + { This returns the typedef that belongs to the given typenode or + loadvmtaddrnode. n must not be Nil! } + begin + if n.nodetype=typen then + result:=ttypenode(n).typedef + else + result:=ttypenode(tloadvmtaddrnode(n).left).typedef; + end; + + function getgenericsym(n:tnode;out srsym:tsym):boolean; + var + srsymtable : tsymtable; + begin + srsym:=nil; + case n.nodetype of + typen: + srsym:=ttypenode(n).typedef.typesym; + loadvmtaddrn: + srsym:=ttypenode(tloadvmtaddrnode(n).left).typedef.typesym; + loadn: + if not searchsym_with_symoption(tloadnode(n).symtableentry.Name,srsym,srsymtable,sp_generic_dummy) then + srsym:=nil; + { TODO : handle const nodes } + end; + result:=assigned(srsym); + end; + + label + SubExprStart; + var + p1,p2 : tnode; + oldt : Ttoken; + filepos : tfileposinfo; + again : boolean; + gendef,parseddef : tdef; + gensym : tsym; + begin + SubExprStart: + if pred_level=highest_precedence then + begin + if factornode=nil then + p1:=factor(false,typeonly) + else + p1:=factornode; + end + else + p1:=sub_expr(succ(pred_level),true,typeonly,factornode); + repeat + if (token in [NOTOKEN..last_operator]) and + (token in operator_levels[pred_level]) and + ((token<>_EQ) or accept_equal) then + begin + oldt:=token; + filepos:=current_tokenpos; + consume(token); + if pred_level=highest_precedence then + p2:=factor(false,false) + else + p2:=sub_expr(succ(pred_level),true,typeonly,nil); + case oldt of + _PLUS : + p1:=caddnode.create(addn,p1,p2); + _MINUS : + p1:=caddnode.create(subn,p1,p2); + _STAR : + p1:=caddnode.create(muln,p1,p2); + _SLASH : + p1:=caddnode.create(slashn,p1,p2); + _EQ: + p1:=caddnode.create(equaln,p1,p2); + _GT : + p1:=caddnode.create(gtn,p1,p2); + _LT : + begin + { we need to decice whether we have an inline specialization + (type nodes to the left and right of "<", mode Delphi and + ">" or "," following) or a normal "<" comparison } + { TODO : p1 could be a non type if e.g. a variable with the + same name is defined in the same unit where the + generic is defined (though "same unit" is not + necessarily needed) } + if getgenericsym(p1,gensym) and + { Attention: when nested specializations are supported + p2 could be a loadn if a "<" follows } + istypenode(p2) and + (m_delphi in current_settings.modeswitches) and + { TODO : add _LT, _LSHARPBRACKET for nested specializations } + (token in [_GT,_RSHARPBRACKET,_COMMA]) then + begin + { this is an inline specialization } + + { retrieve the defs of two nodes } + gendef:=nil; + parseddef:=gettypedef(p2); + + if parseddef.typesym.typ<>typesym then + Internalerror(2011051001); + + { check the hints for parseddef } + check_hints(parseddef.typesym,parseddef.typesym.symoptions,parseddef.typesym.deprecatedmsg); + + { generate the specialization } + generate_specialization(gendef,false,'',parseddef,gensym.RealName); + + { we don't need the old left and right nodes anymore } + p1.Free; + p2.Free; + { in case of a class or a record the specialized generic + is always a classrefdef } + again:=false; + { handle potential typecasts, etc } + p1:=handle_factor_typenode(gendef,false,again,nil,false); + { parse postfix operators } + if postfixoperators(p1,again,false) then + if assigned(p1) then + p1.fileinfo:=filepos + else + p1:=cerrornode.create; + + { with p1 now set we are in reality directly behind the + call to "factor" thus we need to call down to that + again } + { This is disabled until specializations on the right + hand side work as well, because + "not working expressions" is better than "half working + expressions" } + {factornode:=p1; + goto SubExprStart;} + end + else + begin + { this is a normal "<" comparison } + + { potential generic types that are followed by a "<" } + + { a) are not checked whether they are an undefined def, + but not a generic parameter } + if (p1.nodetype=typen) and + (ttypenode(p1).typedef.typ=undefineddef) and + assigned(ttypenode(p1).typedef.typesym) and + not (sp_generic_para in ttypenode(p1).typedef.typesym.symoptions) then + begin + identifier_not_found(ttypenode(p1).typedef.typesym.RealName); + p1.Free; + p1:=cerrornode.create; + end; + + { b) don't have their hints checked } + if istypenode(p1) then + begin + gendef:=gettypedef(p1); + if gendef.typ in [objectdef,recorddef,arraydef,procvardef] then + check_hints(gendef.typesym,gendef.typesym.symoptions,gendef.typesym.deprecatedmsg); + end; + + { Note: the second part of the expression will be needed + for nested specializations } + if istypenode(p2) {and + not (token in [_LT, _LSHARPBRACKET])} then + begin + gendef:=gettypedef(p2); + if gendef.typ in [objectdef,recorddef,arraydef,procvardef] then + check_hints(gendef.typesym,gendef.typesym.symoptions,gendef.typesym.deprecatedmsg); + end; + + { create the comparison node for "<" } + p1:=caddnode.create(ltn,p1,p2) + end; + end; + _GTE : + p1:=caddnode.create(gten,p1,p2); + _LTE : + p1:=caddnode.create(lten,p1,p2); + _SYMDIF : + p1:=caddnode.create(symdifn,p1,p2); + _STARSTAR : + p1:=caddnode.create(starstarn,p1,p2); + _OP_AS, + _OP_IS : + begin + if token in [_LT, _LSHARPBRACKET] then + begin + { for now we're handling this as a generic declaration; + there could be cases though (because of operator + overloading) where this is the wrong decision... } + { TODO : here the same note as in _LT applies as p2 could + point to a variable, etc } + gendef:=gettypedef(p2); + + if gendef.typesym.typ<>typesym then + Internalerror(2011071401); + + { generate the specialization } + generate_specialization(gendef,false,'',nil,''); + + { we don't need the old p2 anymore } + p2.Free; + + again:=false; + { handle potential typecasts, etc } + p2:=handle_factor_typenode(gendef,false,again,nil,false); + { parse postfix operators } + if postfixoperators(p2,again,false) then + if assigned(p2) then + p2.fileinfo:=filepos + else + p2:=cerrornode.create; + + { here we don't need to call back down to "factor", thus + no "goto" } + end; + + { now generate the "is" or "as" node } + case oldt of + _OP_AS: + p1:=casnode.create(p1,p2); + _OP_IS: + p1:=cisnode.create(p1,p2); + end; + end; + _OP_IN : + p1:=cinnode.create(p1,p2); + _OP_OR, + _PIPE {macpas only} : + begin + p1:=caddnode.create(orn,p1,p2); + if (oldt = _PIPE) then + include(p1.flags,nf_short_bool); + end; + _OP_AND, + _AMPERSAND {macpas only} : + begin + p1:=caddnode.create(andn,p1,p2); + if (oldt = _AMPERSAND) then + include(p1.flags,nf_short_bool); + end; + _OP_DIV : + p1:=cmoddivnode.create(divn,p1,p2); + _OP_NOT : + p1:=cnotnode.create(p1); + _OP_MOD : + begin + p1:=cmoddivnode.create(modn,p1,p2); + if m_iso in current_settings.modeswitches then + include(p1.flags,nf_isomod); + end; + _OP_SHL : + p1:=cshlshrnode.create(shln,p1,p2); + _OP_SHR : + p1:=cshlshrnode.create(shrn,p1,p2); + _OP_XOR : + p1:=caddnode.create(xorn,p1,p2); + _ASSIGNMENT : + p1:=cassignmentnode.create(p1,p2); + _NE : + p1:=caddnode.create(unequaln,p1,p2); + end; + p1.fileinfo:=filepos; + end + else + break; + until false; + sub_expr:=p1; + end; + + + function comp_expr(accept_equal,typeonly:boolean):tnode; + var + oldafterassignment : boolean; + p1 : tnode; + begin + oldafterassignment:=afterassignment; + afterassignment:=true; + p1:=sub_expr(opcompare,accept_equal,typeonly,nil); + { get the resultdef for this expression } + if not assigned(p1.resultdef) then + do_typecheckpass(p1); + afterassignment:=oldafterassignment; + comp_expr:=p1; + end; + + + function expr(dotypecheck : boolean) : tnode; + + var + p1,p2 : tnode; + filepos : tfileposinfo; + oldafterassignment, + updatefpos : boolean; + + begin + oldafterassignment:=afterassignment; + p1:=sub_expr(opcompare,true,false,nil); + { get the resultdef for this expression } + if not assigned(p1.resultdef) and + dotypecheck then + do_typecheckpass(p1); + filepos:=current_tokenpos; + if token in [_ASSIGNMENT,_PLUSASN,_MINUSASN,_STARASN,_SLASHASN] then + afterassignment:=true; + updatefpos:=true; + case token of + _POINTPOINT : + begin + consume(_POINTPOINT); + p2:=sub_expr(opcompare,true,false,nil); + p1:=crangenode.create(p1,p2); + end; + _ASSIGNMENT : + begin + consume(_ASSIGNMENT); + if assigned(p1.resultdef) and (p1.resultdef.typ=procvardef) then + getprocvardef:=tprocvardef(p1.resultdef); + p2:=sub_expr(opcompare,true,false,nil); + if assigned(getprocvardef) then + handle_procvar(getprocvardef,p2); + getprocvardef:=nil; + p1:=cassignmentnode.create(p1,p2); + end; + _PLUSASN : + begin + consume(_PLUSASN); + p2:=sub_expr(opcompare,true,false,nil); + p1:=gen_c_style_operator(addn,p1,p2); + end; + _MINUSASN : + begin + consume(_MINUSASN); + p2:=sub_expr(opcompare,true,false,nil); + p1:=gen_c_style_operator(subn,p1,p2); + end; + _STARASN : + begin + consume(_STARASN ); + p2:=sub_expr(opcompare,true,false,nil); + p1:=gen_c_style_operator(muln,p1,p2); + end; + _SLASHASN : + begin + consume(_SLASHASN ); + p2:=sub_expr(opcompare,true,false,nil); + p1:=gen_c_style_operator(slashn,p1,p2); + end; + else + updatefpos:=false; + end; + { get the resultdef for this expression } + if not assigned(p1.resultdef) and + dotypecheck then + do_typecheckpass(p1); + afterassignment:=oldafterassignment; + if updatefpos then + p1.fileinfo:=filepos; + expr:=p1; + end; + + function get_intconst:TConstExprInt; + {Reads an expression, tries to evalute it and check if it is an integer + constant. Then the constant is returned.} + var + p:tnode; + begin + result:=0; + p:=comp_expr(true,false); + if not codegenerror then + begin + if (p.nodetype<>ordconstn) or + not(is_integer(p.resultdef)) then + Message(parser_e_illegal_expression) + else + result:=tordconstnode(p).value; + end; + p.free; + end; + + + function get_stringconst:string; + {Reads an expression, tries to evaluate it and checks if it is a string + constant. Then the constant is returned.} + var + p:tnode; + begin + get_stringconst:=''; + p:=comp_expr(true,false); + if p.nodetype<>stringconstn then + begin + if (p.nodetype=ordconstn) and is_char(p.resultdef) then + get_stringconst:=char(int64(tordconstnode(p).value)) + else + Message(parser_e_illegal_expression); + end + else + get_stringconst:=strpas(tstringconstnode(p).value_str); + p.free; + end; + +end. diff --git a/closures/compiler/pgenutil.pas b/closures/compiler/pgenutil.pas new file mode 100644 index 0000000000..b2bbdf4ab9 --- /dev/null +++ b/closures/compiler/pgenutil.pas @@ -0,0 +1,558 @@ +{ + Copyright (c) 2011 + + Contains different functions that are used in the context of + parsing generics. + + 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 pgenutil; + +{$i fpcdefs.inc} + +interface + +uses + { common } + cclasses, + { symtable } + symtype,symdef; + + procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string;parsedtype:tdef;symname:string); + function parse_generic_parameters:TFPObjectList; + procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:TFPObjectList); + +implementation + +uses + { common } + cutils, + { global } + globals,globtype,tokens,verbose, + { symtable } + symconst,symbase,symsym,symtable, + { modules } + fmodule, + { pass 1 } + htypechk, + node,nobj,nmem, + { parser } + scanner, + pbase,pexpr,pdecsub,ptype; + + + procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string;parsedtype:tdef;symname:string); + var + st : TSymtable; + srsym : tsym; + pt2 : tnode; + found, + first, + err : boolean; + i, + gencount : longint; + genericdef : tstoreddef; + generictype : ttypesym; + genericdeflist : TFPObjectList; + generictypelist : TFPObjectList; + oldsymtablestack : tsymtablestack; + oldextendeddefs : TFPHashObjectList; + hmodule : tmodule; + pu : tused_unit; + prettyname : ansistring; + uspecializename, + countstr,genname,ugenname,specializename : string; + vmtbuilder : TVMTBuilder; + specializest : tsymtable; + item : tobject; + old_current_structdef : tabstractrecorddef; + old_current_genericdef,old_current_specializedef : tstoreddef; + tempst : tglobalsymtable; + old_block_type: tblock_type; + hashedid: thashedidstring; + begin + { retrieve generic def that we are going to replace } + genericdef:=tstoreddef(tt); + tt:=nil; + + { either symname must be given or genericdef needs to be valid } + if (symname='') and + (not assigned(genericdef) or + not assigned(genericdef.typesym) or + (genericdef.typesym.typ<>typesym)) then + internalerror(2011042701); + + { Only parse the parameters for recovery or + for recording in genericbuf } + if parse_generic then + begin + if not try_to_consume(_LT) then + consume(_LSHARPBRACKET); + gencount:=0; + repeat + pt2:=factor(false,true); + pt2.free; + inc(gencount); + until not try_to_consume(_COMMA); + if not try_to_consume(_GT) then + consume(_RSHARPBRACKET); + { we need to return a def that can later pass some checks like + whether it's an interface or not } + if parse_generic and (not assigned(tt) or (tt.typ=undefineddef)) then + begin + if (symname='') and (df_generic in genericdef.defoptions) then + { this happens in non-Delphi modes } + tt:=genericdef + else + begin + { find the corresponding generic symbol so that any checks + done on the returned def will be handled correctly } + str(gencount,countstr); + if symname='' then + genname:=ttypesym(genericdef.typesym).realname + else + genname:=symname; + genname:=genname+'$'+countstr; + ugenname:=upper(genname); + if not searchsym(ugenname,srsym,st) or + (srsym.typ<>typesym) then + begin + identifier_not_found(genname); + exit; + end; + tt:=ttypesym(srsym).typedef; + { this happens in non-Delphi modes if we encounter a + specialization of the generic class or record we're + currently parsing } + if (tt.typ=errordef) and assigned(current_structdef) and + (current_structdef.objname^=ugenname) then + tt:=current_structdef; + end; + end; + exit; + end; + + if not assigned(parsedtype) and not try_to_consume(_LT) then + consume(_LSHARPBRACKET); + + generictypelist:=TFPObjectList.create(false); + genericdeflist:=TFPObjectList.Create(false); + + { Parse type parameters } + err:=false; + { set the block type to type, so that the parsed type are returned as + ttypenode (e.g. classes are in non type-compatible blocks returned as + tloadvmtaddrnode) } + old_block_type:=block_type; + { if parsedtype is set, then the first type identifer was already parsed + (happens in inline specializations) and thus we only need to parse + the remaining types and do as if the first one was already given } + first:=not assigned(parsedtype); + if assigned(parsedtype) then + begin + genericdeflist.Add(parsedtype); + specializename:='$'+parsedtype.typesym.realname; + prettyname:=parsedtype.typesym.prettyname; + end + else + begin + specializename:=''; + prettyname:=''; + end; + while not (token in [_GT,_RSHARPBRACKET]) do + begin + { "first" is set to false at the end of the loop! } + if not first then + consume(_COMMA); + block_type:=bt_type; + pt2:=factor(false,true); + if pt2.nodetype=typen then + begin + if df_generic in pt2.resultdef.defoptions then + Message(parser_e_no_generics_as_params); + genericdeflist.Add(pt2.resultdef); + if not assigned(pt2.resultdef.typesym) then + message(type_e_generics_cannot_reference_itself) + else + begin + specializename:=specializename+'$'+pt2.resultdef.typesym.realname; + if first then + prettyname:=prettyname+pt2.resultdef.typesym.prettyname + else + prettyname:=prettyname+','+pt2.resultdef.typesym.prettyname; + end; + end + else + begin + Message(type_e_type_id_expected); + err:=true; + end; + pt2.free; + first:=false; + end; + block_type:=old_block_type; + + if err then + begin + try_to_consume(_RSHARPBRACKET); + exit; + end; + + { search a generic with the given count of params } + countstr:=''; + str(genericdeflist.Count,countstr); + { use the name of the symbol as procvars return a user friendly version + of the name } + if symname='' then + genname:=ttypesym(genericdef.typesym).realname + else + genname:=symname; + { in case of non-Delphi mode the type name could already be a generic + def (but maybe the wrong one) } + if assigned(genericdef) and (df_generic in genericdef.defoptions) then + begin + { remove the type count suffix from the generic's name } + for i:=Length(genname) downto 1 do + if genname[i]='$' then + begin + genname:=copy(genname,1,i-1); + break; + end; + end; + genname:=genname+'$'+countstr; + ugenname:=upper(genname); + + if assigned(genericdef) and (genericdef.owner.symtabletype in [objectsymtable,recordsymtable]) then + begin + if genericdef.owner.symtabletype = objectsymtable then + found:=searchsym_in_class(tobjectdef(genericdef.owner.defowner),tobjectdef(genericdef.owner.defowner),ugenname,srsym,st,false) + else + found:=searchsym_in_record(tabstractrecorddef(genericdef.owner.defowner),ugenname,srsym,st); + end + else + found:=searchsym(ugenname,srsym,st); + + if not found or (srsym.typ<>typesym) then + begin + identifier_not_found(genname); + genericdeflist.Free; + generictypelist.Free; + exit; + end; + + { we've found the correct def } + genericdef:=tstoreddef(ttypesym(srsym).typedef); + + { build the new type's name } + specializename:=genname+specializename; + uspecializename:=upper(specializename); + prettyname:=genericdef.typesym.prettyname+'<'+prettyname+'>'; + + { select the symtable containing the params } + case genericdef.typ of + procdef: + st:=genericdef.GetSymtable(gs_para); + objectdef, + recorddef: + st:=genericdef.GetSymtable(gs_record); + arraydef: + st:=tarraydef(genericdef).symtable; + procvardef: + st:=genericdef.GetSymtable(gs_para); + else + internalerror(200511182); + end; + + { build the list containing the types for the generic params } + gencount:=0; + for i:=0 to st.SymList.Count-1 do + begin + srsym:=tsym(st.SymList[i]); + if sp_generic_para in srsym.symoptions then + begin + if gencount=genericdeflist.Count then + internalerror(2011042702); + generictype:=ttypesym.create(srsym.realname,tdef(genericdeflist[gencount])); + generictypelist.add(generictype); + inc(gencount); + end; + end; + + + { Special case if we are referencing the current defined object } + if assigned(current_structdef) and + (current_structdef.objname^=uspecializename) then + tt:=current_structdef; + + { decide in which symtable to put the specialization } + if current_module.is_unit and current_module.in_interface then + specializest:=current_module.globalsymtable + else + specializest:=current_module.localsymtable; + + { Can we reuse an already specialized type? } + if not assigned(tt) then + begin + hashedid.id:=uspecializename; + + srsym:=tsym(specializest.findwithhash(hashedid)); + if assigned(srsym) then + begin + if srsym.typ<>typesym then + internalerror(200710171); + tt:=ttypesym(srsym).typedef; + end + else + { the generic could have been specialized in the globalsymtable + already, so search there as well } + if (specializest<>current_module.globalsymtable) and assigned(current_module.globalsymtable) then + begin + srsym:=tsym(current_module.globalsymtable.findwithhash(hashedid)); + if assigned(srsym) then + begin + if srsym.typ<>typesym then + internalerror(2011121101); + tt:=ttypesym(srsym).typedef; + end; + end; + end; + + if not assigned(tt) then + begin + { Setup symtablestack at definition time + to get types right, however this is not perfect, we should probably record + the resolved symbols } + oldsymtablestack:=symtablestack; + oldextendeddefs:=current_module.extendeddefs; + current_module.extendeddefs:=TFPHashObjectList.create(true); + symtablestack:=tdefawaresymtablestack.create; + if not assigned(genericdef) then + internalerror(200705151); + hmodule:=find_module_from_symtable(genericdef.owner); + if hmodule=nil then + internalerror(200705152); + pu:=tused_unit(hmodule.used_units.first); + while assigned(pu) do + begin + if not assigned(pu.u.globalsymtable) then + internalerror(200705153); + symtablestack.push(pu.u.globalsymtable); + pu:=tused_unit(pu.next); + end; + + if assigned(hmodule.globalsymtable) then + symtablestack.push(hmodule.globalsymtable); + + { push the localsymtable if needed } + if (hmodule<>current_module) or not current_module.in_interface then + symtablestack.push(hmodule.localsymtable); + + { push a temporary global symtable so that the specialization is + added to the correct symtable; this symtable does not contain + any other symbols, so that the type resolution can not be + influenced by symbols in the current unit } + tempst:=tspecializesymtable.create(current_module.modulename^,current_module.moduleid); + symtablestack.push(tempst); + + { Reparse the original type definition } + if not err then + begin + if parse_class_parent then + begin + old_current_structdef:=current_structdef; + old_current_genericdef:=current_genericdef; + old_current_specializedef:=current_specializedef; + + if genericdef.owner.symtabletype in [recordsymtable,objectsymtable] then + current_structdef:=tabstractrecorddef(genericdef.owner.defowner) + else + current_structdef:=nil; + current_genericdef:=nil; + current_specializedef:=nil; + end; + + { First a new typesym so we can reuse this specialization and + references to this specialization can be handled } + srsym:=ttypesym.create(specializename,generrordef); + specializest.insert(srsym); + + { specializations are declarations as such it is the wisest to + declare set the blocktype to "type"; otherwise we'll + experience unexpected side effects like the addition of + classrefdefs if we have a generic that's derived from another + generic } + old_block_type:=block_type; + block_type:=bt_type; + + if not assigned(genericdef.generictokenbuf) then + internalerror(200511171); + current_scanner.startreplaytokens(genericdef.generictokenbuf, + genericdef.change_endian); + read_named_type(tt,specializename,genericdef,generictypelist,false); + ttypesym(srsym).typedef:=tt; + tt.typesym:=srsym; + + if _prettyname<>'' then + ttypesym(tt.typesym).fprettyname:=_prettyname + else + ttypesym(tt.typesym).fprettyname:=prettyname; + + { Note regarding hint directives: + There is no need to remove the flags for them from the + specialized generic symbol, because hint directives that + follow the specialization are handled by the code in + pdecl.types_dec and added to the type symbol. + E.g.: TFoo = TBar<Blubb> deprecated; + Here the symbol TBar$1$Blubb will contain the + "sp_hint_deprecated" flag while the TFoo symbol won't.} + + case tt.typ of + { Build VMT indexes for classes and read hint directives } + objectdef: + begin + try_consume_hintdirective(srsym.symoptions,srsym.deprecatedmsg); + consume(_SEMICOLON); + + vmtbuilder:=TVMTBuilder.Create(tobjectdef(tt)); + vmtbuilder.generate_vmt; + vmtbuilder.free; + end; + { handle params, calling convention, etc } + procvardef: + begin + if not check_proc_directive(true) then + begin + try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg); + consume(_SEMICOLON); + end; + parse_var_proc_directives(ttypesym(srsym)); + handle_calling_convention(tprocvardef(tt)); + if try_consume_hintdirective(ttypesym(srsym).symoptions,ttypesym(srsym).deprecatedmsg) then + consume(_SEMICOLON); + end; + else + { parse hint directives for records and arrays } + begin + try_consume_hintdirective(srsym.symoptions,srsym.deprecatedmsg); + consume(_SEMICOLON); + end; + end; + { Consume the semicolon if it is also recorded } + try_to_consume(_SEMICOLON); + + block_type:=old_block_type; + if parse_class_parent then + begin + current_structdef:=old_current_structdef; + current_genericdef:=old_current_genericdef; + current_specializedef:=old_current_specializedef; + end; + end; + + { extract all created symbols and defs from the temporary symtable + and add them to the specializest } + for i:=0 to tempst.SymList.Count-1 do + begin + item:=tempst.SymList.Items[i]; + specializest.SymList.Add(tempst.SymList.NameOfIndex(i),item); + tsym(item).Owner:=specializest; + tempst.SymList.Extract(item); + end; + + for i:=0 to tempst.DefList.Count-1 do + begin + item:=tempst.DefList.Items[i]; + specializest.DefList.Add(item); + tdef(item).owner:=specializest; + tempst.DefList.Extract(item); + end; + + tempst.free; + + { Restore symtablestack } + current_module.extendeddefs.free; + current_module.extendeddefs:=oldextendeddefs; + symtablestack.free; + symtablestack:=oldsymtablestack; + end; + + if not (token in [_GT, _RSHARPBRACKET]) then + begin + consume(_RSHARPBRACKET); + exit; + end + else + consume(token); + + genericdeflist.free; + generictypelist.free; + if assigned(genericdef) then + begin + { check the hints of the found generic symbol } + srsym:=genericdef.typesym; + check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg); + end; + end; + + + function parse_generic_parameters:TFPObjectList; + var + generictype : ttypesym; + begin + result:=TFPObjectList.Create(false); + repeat + if token=_ID then + begin + generictype:=ttypesym.create(orgpattern,cundefinedtype); + include(generictype.symoptions,sp_generic_para); + result.add(generictype); + end; + consume(_ID); + until not try_to_consume(_COMMA) ; + end; + + + procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:TFPObjectList); + var + i: longint; + generictype: ttypesym; + st: tsymtable; + begin + def.genericdef:=genericdef; + if not assigned(genericlist) then + exit; + + case def.typ of + recorddef,objectdef: st:=tabstractrecorddef(def).symtable; + arraydef: st:=tarraydef(def).symtable; + procvardef,procdef: st:=tabstractprocdef(def).parast; + else + internalerror(201101020); + end; + + for i:=0 to genericlist.count-1 do + begin + generictype:=ttypesym(genericlist[i]); + if generictype.typedef.typ=undefineddef then + include(def.defoptions,df_generic) + else + include(def.defoptions,df_specialization); + st.insert(generictype); + end; + end; + +end. diff --git a/closures/compiler/pinline.pas b/closures/compiler/pinline.pas new file mode 100644 index 0000000000..ddb5706291 --- /dev/null +++ b/closures/compiler/pinline.pas @@ -0,0 +1,784 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generates nodes for routines that need compiler support + + 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 pinline; + +{$i fpcdefs.inc} + +interface + + uses + symtype, + node, + globals, + cpuinfo; + + function new_dispose_statement(is_new:boolean) : tnode; + function new_function : tnode; + + function inline_setlength : tnode; + function inline_initialize : tnode; + function inline_finalize : tnode; + function inline_copy : tnode; + + +implementation + + uses + { common } + cutils, + { global } + globtype,tokens,verbose,constexp, + systems, + { symtable } + symbase,symconst,symdef,symsym,symtable,defutil, + { pass 1 } + pass_1,htypechk, + nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils, + { parser } + scanner, + pbase,pexpr, + { codegen } + cgbase,procinfo + ; + + + function new_dispose_statement(is_new:boolean) : tnode; + var + newstatement : tstatementnode; + temp : ttempcreatenode; + para : tcallparanode; + p,p2 : tnode; + again : boolean; { dummy for do_proc_call } + destructorname : TIDString; + sym : tsym; + classh : tobjectdef; + callflag : tcallnodeflag; + destructorpos, + storepos : tfileposinfo; + begin + consume(_LKLAMMER); + p:=comp_expr(true,false); + { calc return type } + if is_new then + begin + set_varstate(p,vs_written,[]); + valid_for_var(p,true); + end + else + set_varstate(p,vs_readwritten,[vsf_must_be_valid]); + if (m_mac in current_settings.modeswitches) and + is_class(p.resultdef) then + begin + classh:=tobjectdef(p.resultdef); + + { make sure we call ObjPas.TObject.Create/Free and not a random } + { create/free method in a macpas descendent object (since those } + { are not supposed to be called automatically when you call } + { new/dispose) } + while assigned(classh.childof) do + classh := classh.childof; + if is_new then + begin + sym:=search_struct_member(classh,'CREATE'); + p2 := cloadvmtaddrnode.create(ctypenode.create(p.resultdef)); + end + else + begin + sym:=search_struct_member(classh,'FREE'); + p2 := p; + end; + + if not(assigned(sym)) then + begin + p.free; + if is_new then + p2.free; + new_dispose_statement := cerrornode.create; + consume_all_until(_RKLAMMER); + consume(_RKLAMMER); + exit; + end; + + do_member_read(classh,false,sym,p2,again,[]); + + { we need the real called method } + do_typecheckpass(p2); + + if (p2.nodetype=calln) and + assigned(tcallnode(p2).procdefinition) then + begin + if is_new then + begin + if (tcallnode(p2).procdefinition.proctypeoption<>potype_constructor) then + Message(parser_e_expr_have_to_be_constructor_call); + p2.resultdef:=p.resultdef; + p2:=cassignmentnode.create(p,p2); + typecheckpass(p2); + end + else + begin + { Free is not a destructor + if (tcallnode(p2).procdefinition.proctypeoption<>potype_destructor) then + Message(parser_e_expr_have_to_be_destructor_call); + } + end + end + else + internalerror(2005061202); + new_dispose_statement := p2; + end + { constructor,destructor specified } + else if not(m_mac in current_settings.modeswitches) and + try_to_consume(_COMMA) then + begin + { extended syntax of new and dispose } + { function styled new is handled in factor } + { destructors have no parameters } + destructorname:=pattern; + destructorpos:=current_tokenpos; + consume(_ID); + + if (p.resultdef.typ<>pointerdef) then + begin + Message1(type_e_pointer_type_expected,p.resultdef.typename); + p.free; + p:=factor(false,false); + p.free; + consume(_RKLAMMER); + new_dispose_statement:=cerrornode.create; + exit; + end; + { first parameter must be an object or class } + if tpointerdef(p.resultdef).pointeddef.typ<>objectdef then + begin + Message(parser_e_pointer_to_class_expected); + p.free; + new_dispose_statement:=factor(false,false); + consume_all_until(_RKLAMMER); + consume(_RKLAMMER); + exit; + end; + { check, if the first parameter is a pointer to a _class_ } + classh:=tobjectdef(tpointerdef(p.resultdef).pointeddef); + if is_class(classh) then + begin + Message(parser_e_no_new_or_dispose_for_classes); + new_dispose_statement:=factor(false,false); + consume_all_until(_RKLAMMER); + consume(_RKLAMMER); + exit; + end; + { search cons-/destructor, also in parent classes } + storepos:=current_tokenpos; + current_tokenpos:=destructorpos; + sym:=search_struct_member(classh,destructorname); + current_tokenpos:=storepos; + + { the second parameter of new/dispose must be a call } + { to a cons-/destructor } + if (not assigned(sym)) or (sym.typ<>procsym) then + begin + if is_new then + Message(parser_e_expr_have_to_be_constructor_call) + else + Message(parser_e_expr_have_to_be_destructor_call); + p.free; + new_dispose_statement:=cerrornode.create; + end + else + begin + { For new(var,constructor) we need to take a copy because + p is also used in the assignmentn below } + if is_new then + begin + p2:=cderefnode.create(p.getcopy); + include(p2.flags,nf_no_checkpointer); + end + else + p2:=cderefnode.create(p); + do_typecheckpass(p2); + if is_new then + callflag:=cnf_new_call + else + callflag:=cnf_dispose_call; + if is_new then + do_member_read(classh,false,sym,p2,again,[callflag]) + else + begin + if not(m_fpc in current_settings.modeswitches) then + do_member_read(classh,false,sym,p2,again,[callflag]) + else + begin + p2:=ccallnode.create(nil,tprocsym(sym),sym.owner,p2,[callflag]); + { support dispose(p,done()); } + if try_to_consume(_LKLAMMER) then + begin + if not try_to_consume(_RKLAMMER) then + begin + Message(parser_e_no_paras_for_destructor); + consume_all_until(_RKLAMMER); + consume(_RKLAMMER); + end; + end; + end; + end; + + { we need the real called method } + do_typecheckpass(p2); + + if (p2.nodetype=calln) and + assigned(tcallnode(p2).procdefinition) then + begin + if is_new then + begin + if (tcallnode(p2).procdefinition.proctypeoption<>potype_constructor) then + Message(parser_e_expr_have_to_be_constructor_call); + p2.resultdef:=p.resultdef; + p2:=cassignmentnode.create(p,p2); + end + else + begin + if (tcallnode(p2).procdefinition.proctypeoption<>potype_destructor) then + Message(parser_e_expr_have_to_be_destructor_call); + end; + end + else + begin + if is_new then + CGMessage(parser_e_expr_have_to_be_constructor_call) + else + CGMessage(parser_e_expr_have_to_be_destructor_call); + end; + + result:=p2; + end; + end + else + begin + if (p.resultdef.typ<>pointerdef) then + Begin + Message1(type_e_pointer_type_expected,p.resultdef.typename); + new_dispose_statement:=cerrornode.create; + end + else + begin + if (tpointerdef(p.resultdef).pointeddef.typ=objectdef) and + (oo_has_vmt in tobjectdef(tpointerdef(p.resultdef).pointeddef).objectoptions) then + Message(parser_w_use_extended_syntax_for_objects); + if (tpointerdef(p.resultdef).pointeddef.typ=orddef) and + (torddef(tpointerdef(p.resultdef).pointeddef).ordtype=uvoid) then + begin + if (m_tp7 in current_settings.modeswitches) or + (m_delphi in current_settings.modeswitches) then + Message(parser_w_no_new_dispose_on_void_pointers) + else + Message(parser_e_no_new_dispose_on_void_pointers); + end; + + { create statements with call to getmem+initialize or + finalize+freemem } + new_dispose_statement:=internalstatements(newstatement); + + if is_new then + begin + { create temp for result } + temp := ctempcreatenode.create(p.resultdef,p.resultdef.size,tt_persistent,true); + addstatement(newstatement,temp); + + { create call to fpc_getmem } + para := ccallparanode.create(cordconstnode.create + (tpointerdef(p.resultdef).pointeddef.size,s32inttype,true),nil); + addstatement(newstatement,cassignmentnode.create( + ctemprefnode.create(temp), + ccallnode.createintern('fpc_getmem',para))); + + { create call to fpc_initialize } + if is_managed_type(tpointerdef(p.resultdef).pointeddef) or + ((m_iso in current_settings.modeswitches) and (tpointerdef(p.resultdef).pointeddef.typ=filedef)) then + addstatement(newstatement,initialize_data_node(cderefnode.create(ctemprefnode.create(temp)))); + + { copy the temp to the destination } + addstatement(newstatement,cassignmentnode.create( + p, + ctemprefnode.create(temp))); + + { release temp } + addstatement(newstatement,ctempdeletenode.create(temp)); + end + else + begin + { create call to fpc_finalize } + if is_managed_type(tpointerdef(p.resultdef).pointeddef) then + addstatement(newstatement,finalize_data_node(cderefnode.create(p.getcopy))); + + { create call to fpc_freemem } + para := ccallparanode.create(p,nil); + addstatement(newstatement,ccallnode.createintern('fpc_freemem',para)); + end; + end; + end; + consume(_RKLAMMER); + end; + + + function new_function : tnode; + var + newstatement : tstatementnode; + newblock : tblocknode; + temp : ttempcreatenode; + para : tcallparanode; + p1,p2 : tnode; + classh : tobjectdef; + srsym : tsym; + srsymtable : TSymtable; + again : boolean; { dummy for do_proc_call } + begin + consume(_LKLAMMER); + p1:=factor(false,false); + if p1.nodetype<>typen then + begin + Message(type_e_type_id_expected); + consume_all_until(_RKLAMMER); + consume(_RKLAMMER); + p1.destroy; + new_function:=cerrornode.create; + exit; + end; + + if (p1.resultdef.typ<>pointerdef) then + begin + Message1(type_e_pointer_type_expected,p1.resultdef.typename); + consume_all_until(_RKLAMMER); + consume(_RKLAMMER); + p1.destroy; + new_function:=cerrornode.create; + exit; + end; + + if try_to_consume(_RKLAMMER) then + begin + if (tpointerdef(p1.resultdef).pointeddef.typ=objectdef) and + (oo_has_vmt in tobjectdef(tpointerdef(p1.resultdef).pointeddef).objectoptions) then + Message(parser_w_use_extended_syntax_for_objects); + + { create statements with call to getmem+initialize } + newblock:=internalstatements(newstatement); + + { create temp for result } + temp := ctempcreatenode.create(p1.resultdef,p1.resultdef.size,tt_persistent,true); + addstatement(newstatement,temp); + + { create call to fpc_getmem } + para := ccallparanode.create(cordconstnode.create + (tpointerdef(p1.resultdef).pointeddef.size,s32inttype,true),nil); + addstatement(newstatement,cassignmentnode.create( + ctemprefnode.create(temp), + ccallnode.createintern('fpc_getmem',para))); + + { create call to fpc_initialize } + if is_managed_type(tpointerdef(p1.resultdef).pointeddef) then + begin + para := ccallparanode.create(caddrnode.create_internal(crttinode.create + (tstoreddef(tpointerdef(p1.resultdef).pointeddef),initrtti,rdt_normal)), + ccallparanode.create(ctemprefnode.create + (temp),nil)); + addstatement(newstatement,ccallnode.createintern('fpc_initialize',para)); + end; + + { the last statement should return the value as + location and type, this is done be referencing the + temp and converting it first from a persistent temp to + normal temp } + addstatement(newstatement,ctempdeletenode.create_normal_temp(temp)); + addstatement(newstatement,ctemprefnode.create(temp)); + + p1.destroy; + p1:=newblock; + end + else + begin + consume(_COMMA); + if tpointerdef(p1.resultdef).pointeddef.typ<>objectdef then + begin + Message(parser_e_pointer_to_class_expected); + consume_all_until(_RKLAMMER); + consume(_RKLAMMER); + p1.destroy; + new_function:=cerrornode.create; + exit; + end; + classh:=tobjectdef(tpointerdef(p1.resultdef).pointeddef); + { use the objectdef for loading the VMT } + p2:=p1; + p1:=ctypenode.create(tpointerdef(p1.resultdef).pointeddef); + do_typecheckpass(p1); + { search the constructor also in the symbol tables of + the parents } + afterassignment:=false; + searchsym_in_class(classh,classh,pattern,srsym,srsymtable,true); + consume(_ID); + do_member_read(classh,false,srsym,p1,again,[cnf_new_call]); + { we need to know which procedure is called } + do_typecheckpass(p1); + if not( + (p1.nodetype=calln) and + assigned(tcallnode(p1).procdefinition) and + (tcallnode(p1).procdefinition.proctypeoption=potype_constructor) + ) then + Message(parser_e_expr_have_to_be_constructor_call); + { constructors return boolean, update resultdef to return + the pointer to the object } + p1.resultdef:=p2.resultdef; + p2.free; + consume(_RKLAMMER); + end; + new_function:=p1; + end; + + + function inline_setlength : tnode; + var + paras : tnode; + npara, + ppn : tcallparanode; + dims, + counter : integer; + isarray : boolean; + def : tdef; + destppn : tnode; + newstatement : tstatementnode; + temp : ttempcreatenode; + newblock : tnode; + begin + { for easy exiting if something goes wrong } + result := cerrornode.create; + + consume(_LKLAMMER); + paras:=parse_paras(false,false,_RKLAMMER); + consume(_RKLAMMER); + if not assigned(paras) then + begin + CGMessage1(parser_e_wrong_parameter_size,'SetLength'); + exit; + end; + + dims:=0; + if assigned(paras) then + begin + { check type of lengths } + ppn:=tcallparanode(paras); + while assigned(ppn.right) do + begin + set_varstate(ppn.left,vs_read,[vsf_must_be_valid]); + inserttypeconv(ppn.left,sinttype); + inc(dims); + ppn:=tcallparanode(ppn.right); + end; + end; + if dims=0 then + begin + CGMessage1(parser_e_wrong_parameter_size,'SetLength'); + paras.free; + exit; + end; + { last param must be var } + destppn:=ppn.left; + valid_for_var(destppn,true); + set_varstate(destppn,vs_written,[]); + { first param must be a string or dynamic array ...} + isarray:=is_dynamic_array(destppn.resultdef); + if not((destppn.resultdef.typ=stringdef) or + isarray) then + begin + { possibly generic involved? } + if df_generic in current_procinfo.procdef.defoptions then + begin + result.free; + result:=internalstatements(newstatement); + paras.free; + exit; + end + else + begin + CGMessage(type_e_mismatch); + paras.free; + exit; + end; + end; + { only dynamic arrays accept more dimensions } + if (dims>1) then + begin + if (not isarray) then + CGMessage(type_e_mismatch) + else + begin + { check if the amount of dimensions is valid } + def := tarraydef(destppn.resultdef).elementdef; + counter:=dims; + while counter > 1 do + begin + if not(is_dynamic_array(def)) then + begin + CGMessage1(parser_e_wrong_parameter_size,'SetLength'); + break; + end; + dec(counter); + def := tarraydef(def).elementdef; + end; + end; + end; + + if isarray then + begin + { create statements with call initialize the arguments and + call fpc_dynarr_setlength } + newblock:=internalstatements(newstatement); + + { get temp for array of lengths } + temp := ctempcreatenode.create(sinttype,dims*sinttype.size,tt_persistent,false); + addstatement(newstatement,temp); + + { load array of lengths } + ppn:=tcallparanode(paras); + counter:=dims-1; + while assigned(ppn.right) do + begin + addstatement(newstatement,cassignmentnode.create( + ctemprefnode.create_offset(temp,counter*sinttype.size), + ppn.left)); + ppn.left:=nil; + dec(counter); + ppn:=tcallparanode(ppn.right); + end; + { destppn is also reused } + ppn.left:=nil; + + { create call to fpc_dynarr_setlength } + npara:=ccallparanode.create(caddrnode.create_internal + (ctemprefnode.create(temp)), + ccallparanode.create(cordconstnode.create + (dims,sinttype,true), + ccallparanode.create(caddrnode.create_internal + (crttinode.create(tstoreddef(destppn.resultdef),initrtti,rdt_normal)), + ccallparanode.create(ctypeconvnode.create_internal(destppn,voidpointertype),nil)))); + addstatement(newstatement,ccallnode.createintern('fpc_dynarray_setlength',npara)); + addstatement(newstatement,ctempdeletenode.create(temp)); + + { we don't need original the callparanodes tree } + paras.free; + end + else if is_ansistring(destppn.resultdef) then + begin + newblock:=ccallnode.createintern( + 'fpc_'+tstringdef(destppn.resultdef).stringtypname+'_setlength', + ccallparanode.create( + cordconstnode.create(getparaencoding(destppn.resultdef),u16inttype,true), + paras + ) + ); + end + else + begin + { we can reuse the supplied parameters } + newblock:=ccallnode.createintern( + 'fpc_'+tstringdef(destppn.resultdef).stringtypname+'_setlength',paras); + end; + + result.free; + result:=newblock; + end; + + + function inline_initfinal(isinit: boolean): tnode; + var + newblock, + paras : tnode; + npara, + destppn, + ppn : tcallparanode; + begin + { for easy exiting if something goes wrong } + result := cerrornode.create; + + consume(_LKLAMMER); + paras:=parse_paras(false,false,_RKLAMMER); + consume(_RKLAMMER); + ppn:=tcallparanode(paras); + + if not assigned(paras) or + (assigned(ppn.right) and + assigned(tcallparanode(ppn.right).right)) then + begin + if isinit then + CGMessage1(parser_e_wrong_parameter_size,'Initialize') + else + CGMessage1(parser_e_wrong_parameter_size,'Finalize'); + exit; + end; + + { 2 arguments? } + if assigned(ppn.right) then + begin + destppn:=tcallparanode(ppn.right); + { create call to fpc_initialize/finalize_array } + npara:=ccallparanode.create(ctypeconvnode.create + (ppn.left,s32inttype), + ccallparanode.create(caddrnode.create_internal + (crttinode.create(tstoreddef(destppn.left.resultdef),initrtti,rdt_normal)), + ccallparanode.create(caddrnode.create_internal + (destppn.left),nil))); + if isinit then + newblock:=ccallnode.createintern('fpc_initialize_array',npara) + else + newblock:=ccallnode.createintern('fpc_finalize_array',npara); + destppn.left:=nil; + end + else + begin + if isinit then + newblock:=initialize_data_node(ppn.left) + else + newblock:=finalize_data_node(ppn.left); + end; + ppn.left:=nil; + paras.free; + result.free; + result:=newblock; + end; + + + function inline_initialize : tnode; + begin + result:=inline_initfinal(true); + end; + + + function inline_finalize : tnode; + begin + result:=inline_initfinal(false); + end; + + + function inline_copy : tnode; + var + copynode, + lowppn, + highppn, + npara, + paras : tnode; + ppn : tcallparanode; + paradef : tdef; + counter : integer; + begin + { for easy exiting if something goes wrong } + result := cerrornode.create; + + consume(_LKLAMMER); + paras:=parse_paras(false,false,_RKLAMMER); + consume(_RKLAMMER); + if not assigned(paras) then + begin + CGMessage1(parser_e_wrong_parameter_size,'Copy'); + exit; + end; + + { determine copy function to use based on the first argument, + also count the number of arguments in this loop } + counter:=1; + ppn:=tcallparanode(paras); + while assigned(ppn.right) do + begin + inc(counter); + ppn:=tcallparanode(ppn.right); + end; + paradef:=ppn.left.resultdef; + if is_ansistring(paradef) or + (is_chararray(paradef) and + (paradef.size>255)) or + ((cs_ansistrings in current_settings.localswitches) and + is_pchar(paradef)) then + copynode:=ccallnode.createintern('fpc_ansistr_copy',paras) + else + if is_widestring(paradef) then + copynode:=ccallnode.createintern('fpc_widestr_copy',paras) + else + if is_unicodestring(paradef) or + is_widechararray(paradef) or + is_pwidechar(paradef) then + copynode:=ccallnode.createintern('fpc_unicodestr_copy',paras) + else + if is_char(paradef) then + copynode:=ccallnode.createintern('fpc_char_copy',paras) + else + if is_dynamic_array(paradef) then + begin + { Only allow 1 or 3 arguments } + if (counter<>1) and (counter<>3) then + begin + CGMessage1(parser_e_wrong_parameter_size,'Copy'); + exit; + end; + + { create statements with call } + + if (counter=3) then + begin + highppn:=tcallparanode(paras).left.getcopy; + lowppn:=tcallparanode(tcallparanode(paras).right).left.getcopy; + end + else + begin + { use special -1,-1 argument to copy the whole array } + highppn:=cordconstnode.create(int64(-1),s32inttype,false); + lowppn:=cordconstnode.create(int64(-1),s32inttype,false); + end; + + { create call to fpc_dynarray_copy } + npara:=ccallparanode.create(highppn, + ccallparanode.create(lowppn, + ccallparanode.create(caddrnode.create_internal + (crttinode.create(tstoreddef(ppn.left.resultdef),initrtti,rdt_normal)), + ccallparanode.create + (ctypeconvnode.create_internal(ppn.left,voidpointertype),nil)))); + copynode:=ccallnode.createinternres('fpc_dynarray_copy',npara,ppn.left.resultdef); + + ppn.left:=nil; + paras.free; + end + else + begin + { generic fallback that will give an error if a wrong + type is passed } + if (counter=3) then + copynode:=ccallnode.createintern('fpc_shortstr_copy',paras) + else + begin + CGMessagePos(ppn.left.fileinfo,type_e_mismatch); + copynode:=cerrornode.create; + end + end; + + result.free; + result:=copynode; + end; + +end. diff --git a/closures/compiler/pmodules.pas b/closures/compiler/pmodules.pas new file mode 100644 index 0000000000..d8c64a1124 --- /dev/null +++ b/closures/compiler/pmodules.pas @@ -0,0 +1,2523 @@ +{ + Copyright (c) 1998-2008 by Florian Klaempfl + + Handles the parsing and loading of the modules (ppufiles) + + 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 pmodules; + +{$i fpcdefs.inc} + +interface + + procedure proc_unit; + procedure proc_package; + procedure proc_program(islibrary : boolean); + +implementation + + uses + SysUtils, + globtype,version,systems,tokens, + cutils,cfileutl,cclasses,comphook, + globals,verbose,fmodule,finput,fppu, + symconst,symbase,symtype,symdef,symsym,symtable, + wpoinfo, + aasmtai,aasmdata,aasmcpu,aasmbase, + cgbase,cgobj, + nbas,nutils,ncgutil, + link,assemble,import,export,gendef,ppu,comprsrc,dbgbase, + cresstr,procinfo, + pexports, + objcgutl, + wpobase, + scanner,pbase,pexpr,psystem,psub,pdecsub,ptype, + cpuinfo; + + + procedure create_objectfile; + var + DLLScanner : TDLLScanner; + s : string; + KeepShared : TCmdStrList; + begin + { try to create import entries from system dlls } + if (tf_has_dllscanner in target_info.flags) and + (not current_module.linkOtherSharedLibs.Empty) then + begin + { Init DLLScanner } + if assigned(CDLLScanner[target_info.system]) then + DLLScanner:=CDLLScanner[target_info.system].Create + else + internalerror(200104121); + KeepShared:=TCmdStrList.Create; + { Walk all shared libs } + While not current_module.linkOtherSharedLibs.Empty do + begin + S:=current_module.linkOtherSharedLibs.Getusemask(link_always); + if not DLLScanner.scan(s) then + KeepShared.Concat(s); + end; + DLLscanner.Free; + { Recreate import section } + if (target_info.system in [system_i386_win32,system_i386_wdosx]) then + begin + if assigned(current_asmdata.asmlists[al_imports]) then + current_asmdata.asmlists[al_imports].clear + else + current_asmdata.asmlists[al_imports]:=TAsmList.Create; + importlib.generatelib; + end; + { Readd the not processed files } + while not KeepShared.Empty do + begin + s:=KeepShared.GetFirst; + current_module.linkOtherSharedLibs.add(s,link_always); + end; + KeepShared.Free; + end; + + { Start and end module debuginfo, at least required for stabs + to insert n_sourcefile lines } + if (cs_debuginfo in current_settings.moduleswitches) or + (cs_use_lineinfo in current_settings.globalswitches) then + current_debuginfo.insertmoduleinfo; + + { create the .s file and assemble it } + GenerateAsm(false); + + { Also create a smartlinked version ? } + if create_smartlink_library then + begin + GenerateAsm(true); + if (af_needar in target_asm.flags) then + Linker.MakeStaticLibrary; + end; + + { resource files } + CompileResourceFiles; + end; + + + procedure insertobjectfile; + { Insert the used object file for this unit in the used list for this unit } + begin + current_module.linkunitofiles.add(current_module.objfilename^,link_static); + current_module.flags:=current_module.flags or uf_static_linked; + + if create_smartlink_library then + begin + current_module.linkunitstaticlibs.add(current_module.staticlibfilename^,link_smart); + current_module.flags:=current_module.flags or uf_smart_linked; + end; + end; + + + procedure create_dwarf_frame; + begin + { Dwarf conflicts with smartlinking in separate .a files } + if create_smartlink_library then + exit; + { Call frame information } + { MWE: we write our own info, so dwarf asm support is not really needed } + { if (af_supports_dwarf in target_asm.flags) and } + { CFI is currently broken for Darwin } + if not(target_info.system in systems_darwin) and + ( + (tf_needs_dwarf_cfi in target_info.flags) or + (paratargetdbg in [dbg_dwarf2, dbg_dwarf3]) + ) then + begin + current_asmdata.asmlists[al_dwarf_frame].Free; + current_asmdata.asmlists[al_dwarf_frame] := TAsmList.create; + current_asmdata.asmcfi.generate_code(current_asmdata.asmlists[al_dwarf_frame]); + end; + end; + + + procedure InsertThreadvarTablesTable; + var + hp : tused_unit; + ltvTables : TAsmList; + count : longint; + begin + if (tf_section_threadvars in target_info.flags) then + exit; + ltvTables:=TAsmList.Create; + count:=0; + hp:=tused_unit(usedunits.first); + while assigned(hp) do + begin + If (hp.u.flags and uf_threadvars)=uf_threadvars then + begin + ltvTables.concat(Tai_const.Createname(make_mangledname('THREADVARLIST',hp.u.globalsymtable,''),0)); + inc(count); + end; + hp:=tused_unit(hp.next); + end; + { Add program threadvars, if any } + If (current_module.flags and uf_threadvars)=uf_threadvars then + begin + ltvTables.concat(Tai_const.Createname(make_mangledname('THREADVARLIST',current_module.localsymtable,''),0)); + inc(count); + end; + { Insert TableCount at start } + ltvTables.insert(Tai_const.Create_32bit(count)); + { insert in data segment } + maybe_new_object_file(current_asmdata.asmlists[al_globals]); + new_section(current_asmdata.asmlists[al_globals],sec_data,'FPC_THREADVARTABLES',sizeof(pint)); + current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('FPC_THREADVARTABLES',AT_DATA,0)); + current_asmdata.asmlists[al_globals].concatlist(ltvTables); + current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname('FPC_THREADVARTABLES')); + ltvTables.free; + end; + + procedure AddToThreadvarList(p:TObject;arg:pointer); + var + ltvTable : TAsmList; + begin + ltvTable:=TAsmList(arg); + if (tsym(p).typ=staticvarsym) and + (vo_is_thread_var in tstaticvarsym(p).varoptions) then + begin + { address of threadvar } + ltvTable.concat(tai_const.Createname(tstaticvarsym(p).mangledname,0)); + { size of threadvar } + ltvTable.concat(tai_const.create_32bit(tstaticvarsym(p).getsize)); + end; + end; + + + procedure InsertThreadvars; + var + s : string; + ltvTable : TAsmList; + begin + if (tf_section_threadvars in target_info.flags) then + exit; + ltvTable:=TAsmList.create; + if assigned(current_module.globalsymtable) then + current_module.globalsymtable.SymList.ForEachCall(@AddToThreadvarList,ltvTable); + current_module.localsymtable.SymList.ForEachCall(@AddToThreadvarList,ltvTable); + if ltvTable.first<>nil then + begin + s:=make_mangledname('THREADVARLIST',current_module.localsymtable,''); + { end of the list marker } + ltvTable.concat(tai_const.create_sym(nil)); + { add to datasegment } + maybe_new_object_file(current_asmdata.asmlists[al_globals]); + new_section(current_asmdata.asmlists[al_globals],sec_data,s,sizeof(pint)); + current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0)); + current_asmdata.asmlists[al_globals].concatlist(ltvTable); + current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname(s)); + current_module.flags:=current_module.flags or uf_threadvars; + end; + ltvTable.Free; + end; + + procedure InsertRuntimeInits(const prefix:string;list:TLinkedList;unitflag:cardinal); + var + s: string; + item: TTCInitItem; + begin + item:=TTCInitItem(list.First); + if item=nil then + exit; + s:=make_mangledname(prefix,current_module.localsymtable,''); + maybe_new_object_file(current_asmdata.asmlists[al_globals]); + new_section(current_asmdata.asmlists[al_globals],sec_data,s,sizeof(pint)); + current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0)); + repeat + { optimize away unused local/static symbols } + if (item.sym.refs>0) or (item.sym.owner.symtabletype=globalsymtable) then + begin + { address to initialize } + current_asmdata.asmlists[al_globals].concat(Tai_const.createname(item.sym.mangledname, item.offset)); + { value with which to initialize } + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(item.datalabel)); + end; + item:=TTCInitItem(item.Next); + until item=nil; + { end-of-list marker } + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_sym(nil)); + current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname(s)); + current_module.flags:=current_module.flags or unitflag; + end; + + procedure InsertRuntimeInitsTablesTable(const prefix,tablename:string;unitflag:cardinal); + var + hp: tused_unit; + hlist: TAsmList; + count: longint; + begin + hlist:=TAsmList.Create; + count:=0; + hp:=tused_unit(usedunits.first); + while assigned(hp) do + begin + if (hp.u.flags and unitflag)=unitflag then + begin + hlist.concat(Tai_const.Createname(make_mangledname(prefix,hp.u.globalsymtable,''),0)); + inc(count); + end; + hp:=tused_unit(hp.next); + end; + { Add items from program, if any } + if (current_module.flags and unitflag)=unitflag then + begin + hlist.concat(Tai_const.Createname(make_mangledname(prefix,current_module.localsymtable,''),0)); + inc(count); + end; + { Insert TableCount at start } + hlist.insert(Tai_const.Create_32bit(count)); + { insert in data segment } + maybe_new_object_file(current_asmdata.asmlists[al_globals]); + new_section(current_asmdata.asmlists[al_globals],sec_data,tablename,sizeof(pint)); + current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(tablename,AT_DATA,0)); + current_asmdata.asmlists[al_globals].concatlist(hlist); + current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname(tablename)); + hlist.free; + end; + + procedure InsertWideInits; + begin + InsertRuntimeInits('WIDEINITS',current_asmdata.WideInits,uf_wideinits); + end; + + procedure InsertResStrInits; + begin + InsertRuntimeInits('RESSTRINITS',current_asmdata.ResStrInits,uf_resstrinits); + end; + + procedure InsertWideInitsTablesTable; + begin + InsertRuntimeInitsTablesTable('WIDEINITS','FPC_WIDEINITTABLES',uf_wideinits); + end; + + procedure InsertResStrTablesTable; + begin + InsertRuntimeInitsTablesTable('RESSTRINITS','FPC_RESSTRINITTABLES',uf_resstrinits); + end; + + Function CheckResourcesUsed : boolean; + var + hp : tused_unit; + found : Boolean; + begin + CheckResourcesUsed:=tf_has_winlike_resources in target_info.flags; + if not CheckResourcesUsed then exit; + + hp:=tused_unit(usedunits.first); + found:=((current_module.flags and uf_has_resourcefiles)=uf_has_resourcefiles); + If not found then + While Assigned(hp) and not found do + begin + Found:=((hp.u.flags and uf_has_resourcefiles)=uf_has_resourcefiles); + hp:=tused_unit(hp.next); + end; + CheckResourcesUsed:=found; + end; + + Procedure InsertResourceInfo(ResourcesUsed : boolean); + + var + ResourceInfo : TAsmList; + + begin + if (target_res.id in [res_elf,res_macho]) then + begin + ResourceInfo:=TAsmList.Create; + + maybe_new_object_file(ResourceInfo); + new_section(ResourceInfo,sec_data,'FPC_RESLOCATION',sizeof(aint)); + ResourceInfo.concat(Tai_symbol.Createname_global('FPC_RESLOCATION',AT_DATA,0)); + if ResourcesUsed then + { Valid pointer to resource information } + ResourceInfo.concat(Tai_const.Createname('FPC_RESSYMBOL',0)) + else + { Nil pointer to resource information } + {$IFNDEF cpu64bitaddr} + ResourceInfo.Concat(Tai_const.Create_32bit(0)); + {$ELSE} + ResourceInfo.Concat(Tai_const.Create_64bit(0)); + {$ENDIF} + maybe_new_object_file(current_asmdata.asmlists[al_globals]); + current_asmdata.asmlists[al_globals].concatlist(ResourceInfo); + ResourceInfo.free; + end; + end; + + + Procedure InsertResourceTablesTable; + var + hp : tmodule; + ResourceStringTables : tasmlist; + count : longint; + begin + ResourceStringTables:=tasmlist.Create; + count:=0; + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + If (hp.flags and uf_has_resourcestrings)=uf_has_resourcestrings then + begin + ResourceStringTables.concat(Tai_const.Createname(make_mangledname('RESSTR',hp.localsymtable,'START'),0)); + ResourceStringTables.concat(Tai_const.Createname(make_mangledname('RESSTR',hp.localsymtable,'END'),0)); + inc(count); + end; + hp:=tmodule(hp.next); + end; + { Insert TableCount at start } + ResourceStringTables.insert(Tai_const.Create_pint(count)); + { Add to data segment } + maybe_new_object_file(current_asmdata.AsmLists[al_globals]); + new_section(current_asmdata.AsmLists[al_globals],sec_data,'FPC_RESOURCESTRINGTABLES',sizeof(pint)); + current_asmdata.AsmLists[al_globals].concat(Tai_symbol.Createname_global('FPC_RESOURCESTRINGTABLES',AT_DATA,0)); + current_asmdata.AsmLists[al_globals].concatlist(ResourceStringTables); + current_asmdata.AsmLists[al_globals].concat(Tai_symbol_end.Createname('FPC_RESOURCESTRINGTABLES')); + ResourceStringTables.free; + end; + + procedure AddToStructInits(p:TObject;arg:pointer); + var + StructList: TFPList absolute arg; + begin + if (tdef(p).typ in [objectdef,recorddef]) and + ([oo_has_class_constructor,oo_has_class_destructor] * tabstractrecorddef(p).objectoptions <> []) then + StructList.Add(p); + end; + + procedure InsertInitFinalTable; + var + hp : tused_unit; + unitinits : TAsmList; + count : longint; + + procedure write_struct_inits(u: tmodule); + var + i: integer; + structlist: TFPList; + pd: tprocdef; + begin + structlist := TFPList.Create; + if assigned(u.globalsymtable) then + u.globalsymtable.DefList.ForEachCall(@AddToStructInits,structlist); + u.localsymtable.DefList.ForEachCall(@AddToStructInits,structlist); + { write structures } + for i := 0 to structlist.Count - 1 do + begin + pd := tabstractrecorddef(structlist[i]).find_procdef_bytype(potype_class_constructor); + if assigned(pd) then + unitinits.concat(Tai_const.Createname(pd.mangledname,0)) + else + unitinits.concat(Tai_const.Create_pint(0)); + pd := tabstractrecorddef(structlist[i]).find_procdef_bytype(potype_class_destructor); + if assigned(pd) then + unitinits.concat(Tai_const.Createname(pd.mangledname,0)) + else + unitinits.concat(Tai_const.Create_pint(0)); + inc(count); + end; + structlist.free; + end; + + begin + unitinits:=TAsmList.Create; + count:=0; + hp:=tused_unit(usedunits.first); + while assigned(hp) do + begin + { insert class constructors/destructors of the unit } + if (hp.u.flags and uf_classinits) <> 0 then + write_struct_inits(hp.u); + { call the unit init code and make it external } + if (hp.u.flags and (uf_init or uf_finalize))<>0 then + begin + if (hp.u.flags and uf_init)<>0 then + unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',hp.u.globalsymtable,''),0)) + else + unitinits.concat(Tai_const.Create_sym(nil)); + if (hp.u.flags and uf_finalize)<>0 then + unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',hp.u.globalsymtable,''),0)) + else + unitinits.concat(Tai_const.Create_sym(nil)); + inc(count); + end; + hp:=tused_unit(hp.next); + end; + { insert class constructors/destructor of the program } + if (current_module.flags and uf_classinits) <> 0 then + write_struct_inits(current_module); + { Insert initialization/finalization of the program } + if (current_module.flags and (uf_init or uf_finalize))<>0 then + begin + if (current_module.flags and uf_init)<>0 then + unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',current_module.localsymtable,''),0)) + else + unitinits.concat(Tai_const.Create_sym(nil)); + if (current_module.flags and uf_finalize)<>0 then + unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',current_module.localsymtable,''),0)) + else + unitinits.concat(Tai_const.Create_sym(nil)); + inc(count); + end; + { Insert TableCount,InitCount at start } + unitinits.insert(Tai_const.Create_32bit(0)); + unitinits.insert(Tai_const.Create_32bit(count)); + { Add to data segment } + maybe_new_object_file(current_asmdata.asmlists[al_globals]); + new_section(current_asmdata.asmlists[al_globals],sec_data,'INITFINAL',sizeof(pint)); + current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('INITFINAL',AT_DATA,0)); + current_asmdata.asmlists[al_globals].concatlist(unitinits); + current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname('INITFINAL')); + unitinits.free; + end; + + + procedure InsertMemorySizes; +{$IFDEF POWERPC} + var + stkcookie: string; +{$ENDIF POWERPC} + begin + maybe_new_object_file(current_asmdata.asmlists[al_globals]); + { Insert Ident of the compiler in the .fpc.version section } + new_section(current_asmdata.asmlists[al_globals],sec_fpc,'version',const_align(32)); + current_asmdata.asmlists[al_globals].concat(Tai_string.Create('FPC '+full_version_string+ + ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname)); + if not(tf_no_generic_stackcheck in target_info.flags) then + begin + { stacksize can be specified and is now simulated } + new_section(current_asmdata.asmlists[al_globals],sec_data,'__stklen', sizeof(pint)); + current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__stklen',AT_DATA,sizeof(pint))); + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_pint(stacksize)); + end; +{$IFDEF POWERPC} + { AmigaOS4 "stack cookie" support } + if ( target_info.system = system_powerpc_amiga ) then + begin + { this symbol is needed to ignite powerpc amigaos' } + { stack allocation magic for us with the given stack size. } + { note: won't work for m68k amigaos or morphos. (KB) } + str(stacksize,stkcookie); + stkcookie:='$STACK: '+stkcookie+#0; + maybe_new_object_file(current_asmdata.asmlists[al_globals]); + new_section(current_asmdata.asmlists[al_globals],sec_data,'__stack_cookie',length(stkcookie)); + current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__stack_cookie',AT_DATA,length(stkcookie))); + current_asmdata.asmlists[al_globals].concat(Tai_string.Create(stkcookie)); + end; +{$ENDIF POWERPC} + { Initial heapsize } + maybe_new_object_file(current_asmdata.asmlists[al_globals]); + new_section(current_asmdata.asmlists[al_globals],sec_data,'__heapsize',sizeof(pint)); + current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__heapsize',AT_DATA,sizeof(pint))); + current_asmdata.asmlists[al_globals].concat(Tai_const.Create_pint(heapsize)); + { Initial heapsize } + maybe_new_object_file(current_asmdata.asmlists[al_globals]); + new_section(current_asmdata.asmlists[al_globals],sec_data,'__fpc_valgrind',sizeof(boolean)); + current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__fpc_valgrind',AT_DATA,sizeof(boolean))); + current_asmdata.asmlists[al_globals].concat(Tai_const.create_8bit(byte(cs_gdb_valgrind in current_settings.globalswitches))); + end; + + + procedure AddUnit(const s:string); + var + hp : tppumodule; + unitsym : tunitsym; + begin + { load unit } + hp:=registerunit(current_module,s,''); + hp.loadppu; + hp.adddependency(current_module); + { add to symtable stack } + symtablestack.push(hp.globalsymtable); + if (m_mac in current_settings.modeswitches) and + assigned(hp.globalmacrosymtable) then + macrosymtablestack.push(hp.globalmacrosymtable); + { insert unitsym } + unitsym:=tunitsym.create(s,hp); + inc(unitsym.refs); + tabstractunitsymtable(current_module.localsymtable).insertunit(unitsym); + { add to used units } + current_module.addusedunit(hp,false,unitsym); + end; + + + procedure maybeloadvariantsunit; + var + hp : tmodule; + begin + { Do we need the variants unit? Skip this + for VarUtils unit for bootstrapping } + if (current_module.flags and uf_uses_variants=0) or + (current_module.modulename^='VARUTILS') then + exit; + { Variants unit already loaded? } + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + if hp.modulename^='VARIANTS' then + exit; + hp:=tmodule(hp.next); + end; + { Variants unit is not loaded yet, load it now } + Message(parser_w_implicit_uses_of_variants_unit); + AddUnit('variants'); + end; + + + function MaybeRemoveResUnit : boolean; + var + resources_used : boolean; + hp : tmodule; + uu : tused_unit; + unitname : shortstring; + begin + { We simply remove the unit from: + - usedunit list, so that things like init/finalization table won't + contain references to this unit + - loaded_units list, so that the unit object file doesn't get linked + with the executable. } + { Note: on windows we always need resources! } + resources_used:=(target_info.system in systems_all_windows) + or CheckResourcesUsed; + if (not resources_used) and (tf_has_winlike_resources in target_info.flags) then + begin + { resources aren't used, so we don't need this unit } + if target_res.id=res_ext then + unitname:='FPEXTRES' + else + unitname:='FPINTRES'; + Message1(unit_u_unload_resunit,unitname); + { find the module } + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + if hp.is_unit and (hp.modulename^=unitname) then break; + hp:=tmodule(hp.next); + end; + if not assigned(hp) then + internalerror(200801071); + { find its tused_unit in the global list } + uu:=tused_unit(usedunits.first); + while assigned(uu) do + begin + if uu.u=hp then break; + uu:=tused_unit(uu.next); + end; + if not assigned(uu) then + internalerror(200801072); + { remove the tused_unit } + usedunits.Remove(uu); + uu.Free; + { remove the module } + loaded_units.Remove(hp); + unloaded_units.Concat(hp); + end; + MaybeRemoveResUnit:=resources_used; + end; + + + procedure loaddefaultunits; + begin + { we are going to rebuild the symtablestack, clear it first } + symtablestack.clear; + macrosymtablestack.clear; + + { macro symtable } + macrosymtablestack.push(initialmacrosymtable); + + { are we compiling the system unit? } + if (cs_compilesystem in current_settings.moduleswitches) then + begin + systemunit:=tglobalsymtable(current_module.localsymtable); + { create system defines } + create_intern_symbols; + create_intern_types; + { Set the owner of errorsym and errortype to symtable to + prevent crashes when accessing .owner } + generrorsym.owner:=systemunit; + generrordef.owner:=systemunit; + exit; + end; + + { insert the system unit, it is allways the first. Load also the + internal types from the system unit } + AddUnit('system'); + systemunit:=tglobalsymtable(symtablestack.top); + load_intern_types; + + { Set the owner of errorsym and errortype to symtable to + prevent crashes when accessing .owner } + generrorsym.owner:=systemunit; + generrordef.owner:=systemunit; + + { Units only required for main module } + if not(current_module.is_unit) then + begin + { Heaptrc unit, load heaptrace before any other units especially objpas } + if (cs_use_heaptrc in current_settings.globalswitches) then + AddUnit('heaptrc'); + { Lineinfo unit } + if (cs_use_lineinfo in current_settings.globalswitches) then begin + if (paratargetdbg = dbg_stabs) then + AddUnit('lineinfo') + else + AddUnit('lnfodwrf'); + end; + { Valgrind requires c memory manager } + if (cs_gdb_valgrind in current_settings.globalswitches) then + AddUnit('cmem'); +{$ifdef cpufpemu} + { Floating point emulation unit? + softfpu must be in the system unit anyways (FK) + if (cs_fp_emulation in current_settings.moduleswitches) and not(target_info.system in system_wince) then + AddUnit('softfpu'); + } +{$endif cpufpemu} + { Which kind of resource support? + Note: if resources aren't used this unit will be removed later, + otherwise we need it here since it must be loaded quite early } + if (tf_has_winlike_resources in target_info.flags) then + if target_res.id=res_ext then + AddUnit('fpextres') + else + AddUnit('fpintres'); + end; + { Objpas unit? } + if m_objpas in current_settings.modeswitches then + AddUnit('objpas'); + + { Macpas unit? } + if m_mac in current_settings.modeswitches then + AddUnit('macpas'); + + if m_iso in current_settings.modeswitches then + AddUnit('iso7185'); + + { Objective-C support unit? } + if (m_objectivec1 in current_settings.modeswitches) then + begin + { interface to Objective-C run time } + AddUnit('objc'); + loadobjctypes; + { NSObject } + if not(current_module.is_unit) or + (current_module.modulename^<>'OBJCBASE') then + AddUnit('objcbase'); + end; + { Profile unit? Needed for go32v2 only } + if (cs_profile in current_settings.moduleswitches) and + (target_info.system in [system_i386_go32v2,system_i386_watcom]) then + AddUnit('profile'); + if (cs_load_fpcylix_unit in current_settings.globalswitches) then + begin + AddUnit('fpcylix'); + AddUnit('dynlibs'); + end; + + { CPU targets with microcontroller support can add a controller specific unit } +{$if defined(ARM) or defined(AVR)} + if (target_info.system in systems_embedded) and (current_settings.controllertype<>ct_none) and + (embedded_controllers[current_settings.controllertype].controllerunitstr<>'') then + AddUnit(embedded_controllers[current_settings.controllertype].controllerunitstr); +{$endif ARM} + end; + + + procedure loadautounits; + var + hs,s : string; + begin + hs:=autoloadunits; + repeat + s:=GetToken(hs,','); + if s='' then + break; + AddUnit(s); + until false; + end; + + + procedure loadunits; + var + s,sorg : ansistring; + fn : string; + pu : tused_unit; + hp2 : tmodule; + unitsym : tunitsym; + begin + consume(_USES); + repeat + s:=pattern; + sorg:=orgpattern; + consume(_ID); + while token=_POINT do + begin + consume(_POINT); + s:=s+'.'+pattern; + sorg:=sorg+'.'+orgpattern; + consume(_ID); + end; + { support "<unit> in '<file>'" construct, but not for tp7 } + fn:=''; + if not(m_tp7 in current_settings.modeswitches) and + try_to_consume(_OP_IN) then + fn:=FixFileName(get_stringconst); + { Give a warning if lineinfo is loaded } + if s='LINEINFO' then begin + Message(parser_w_no_lineinfo_use_switch); + if (paratargetdbg in [dbg_dwarf2, dbg_dwarf3]) then + s := 'LNFODWRF'; + sorg := s; + end; + { Give a warning if objpas is loaded } + if s='OBJPAS' then + Message(parser_w_no_objpas_use_mode); + { Using the unit itself is not possible } + if (s<>current_module.modulename^) then + begin + { check if the unit is already used } + hp2:=nil; + pu:=tused_unit(current_module.used_units.first); + while assigned(pu) do + begin + if (pu.u.modulename^=s) then + begin + hp2:=pu.u; + break; + end; + pu:=tused_unit(pu.next); + end; + if not assigned(hp2) then + hp2:=registerunit(current_module,sorg,fn) + else + Message1(sym_e_duplicate_id,s); + { Create unitsym, we need to use the name as specified, we + can not use the modulename because that can be different + when -Un is used } + unitsym:=tunitsym.create(sorg,nil); + tabstractunitsymtable(current_module.localsymtable).insertunit(unitsym); + { the current module uses the unit hp2 } + current_module.addusedunit(hp2,true,unitsym); + end + else + Message1(sym_e_duplicate_id,s); + if token=_COMMA then + begin + pattern:=''; + consume(_COMMA); + end + else + break; + until false; + + { Load the units } + pu:=tused_unit(current_module.used_units.first); + while assigned(pu) do + begin + { Only load the units that are in the current + (interface/implementation) uses clause } + if pu.in_uses and + (pu.in_interface=current_module.in_interface) then + begin + tppumodule(pu.u).loadppu; + { is our module compiled? then we can stop } + if current_module.state=ms_compiled then + exit; + { add this unit to the dependencies } + pu.u.adddependency(current_module); + { save crc values } + pu.checksum:=pu.u.crc; + pu.interface_checksum:=pu.u.interface_crc; + pu.indirect_checksum:=pu.u.indirect_crc; + { connect unitsym to the module } + pu.unitsym.module:=pu.u; + { add to symtable stack } + symtablestack.push(pu.u.globalsymtable); + if (m_mac in current_settings.modeswitches) and + assigned(pu.u.globalmacrosymtable) then + macrosymtablestack.push(pu.u.globalmacrosymtable); + { check hints } + pu.u.check_hints; + end; + pu:=tused_unit(pu.next); + end; + + consume(_SEMICOLON); + end; + + + procedure reset_all_defs; + begin + if assigned(current_module.wpoinfo) then + current_module.wpoinfo.resetdefs; + end; + + + procedure free_localsymtables(st:TSymtable); + var + i : longint; + def : tstoreddef; + pd : tprocdef; + begin + for i:=0 to st.DefList.Count-1 do + begin + def:=tstoreddef(st.DefList[i]); + if def.typ=procdef then + begin + pd:=tprocdef(def); + if assigned(pd.localst) and + (pd.localst.symtabletype<>staticsymtable) and + not(po_inline in pd.procoptions) then + begin + free_localsymtables(pd.localst); + pd.localst.free; + pd.localst:=nil; + end; + end; + end; + end; + + + procedure parse_implementation_uses; + begin + if token=_USES then + loadunits; + end; + + + procedure setupglobalswitches; + begin + if (cs_create_pic in current_settings.moduleswitches) then + begin + def_system_macro('FPC_PIC'); + def_system_macro('PIC'); + end; + end; + + + function create_main_proc(const name:string;potype:tproctypeoption;st:TSymtable):tcgprocinfo; + var + ps : tprocsym; + pd : tprocdef; + begin + { there should be no current_procinfo available } + if assigned(current_procinfo) then + internalerror(200304275); + {Generate a procsym for main} + ps:=tprocsym.create('$'+name); + { main are allways used } + inc(ps.refs); + st.insert(ps); + pd:=tprocdef.create(main_program_level); + include(pd.procoptions,po_global); + pd.procsym:=ps; + ps.ProcdefList.Add(pd); + { set procdef options } + pd.proctypeoption:=potype; + pd.proccalloption:=pocall_default; + include(pd.procoptions,po_hascallingconvention); + pd.forwarddef:=false; + pd.setmangledname(target_info.cprefix+name); + pd.aliasnames.insert(pd.mangledname); + handle_calling_convention(pd); + { We don't need is a local symtable. Change it into the static + symtable } + pd.localst.free; + pd.localst:=st; + { set procinfo and current_procinfo.procdef } + result:=tcgprocinfo(cprocinfo.create(nil)); + result.procdef:=pd; + { main proc does always a call e.g. to init system unit } + include(result.flags,pi_do_call); + end; + + + procedure release_main_proc(pi:tcgprocinfo); + begin + { remove localst as it was replaced by staticsymtable } + pi.procdef.localst:=nil; + { remove procinfo } + current_module.procinfo:=nil; + pi.free; + pi:=nil; + end; + + + + { Insert _GLOBAL_OFFSET_TABLE_ symbol if system uses it } + + procedure maybe_load_got; +{$ifdef i386} + var + gotvarsym : tstaticvarsym; +{$endif i386} + begin +{$ifdef i386} + if (cs_create_pic in current_settings.moduleswitches) and + (tf_pic_uses_got in target_info.flags) then + begin + { insert symbol for got access in assembler code} + gotvarsym:=tstaticvarsym.create('_GLOBAL_OFFSET_TABLE_', + vs_value,voidpointertype,[vo_is_external]); + gotvarsym.set_mangledname('_GLOBAL_OFFSET_TABLE_'); + current_module.localsymtable.insert(gotvarsym); + { avoid unnecessary warnings } + gotvarsym.varstate:=vs_read; + gotvarsym.refs:=1; + end; +{$endif i386} + end; + + function gen_implicit_initfinal(flag:word;st:TSymtable):tcgprocinfo; + begin + { create procdef } + case flag of + uf_init : + begin + result:=create_main_proc(make_mangledname('',current_module.localsymtable,'init_implicit'),potype_unitinit,st); + result.procdef.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,'')); + end; + uf_finalize : + begin + result:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize_implicit'),potype_unitfinalize,st); + result.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,'')); + if (not current_module.is_unit) then + result.procdef.aliasnames.insert('PASCALFINALIZE'); + end; + else + internalerror(200304253); + end; + result.code:=cnothingnode.create; + end; + + + procedure copy_macro(p:TObject; arg:pointer); + begin + current_module.globalmacrosymtable.insert(tmacro(p).getcopy); + end; + + function try_consume_hintdirective(var moduleopt:tmoduleoptions; var deprecatedmsg:pshortstring):boolean; + var + last_is_deprecated:boolean; + begin + try_consume_hintdirective:=false; + repeat + last_is_deprecated:=false; + case idtoken of + _LIBRARY : + begin + include(moduleopt,mo_hint_library); + try_consume_hintdirective:=true; + end; + _DEPRECATED : + begin + include(moduleopt,mo_hint_deprecated); + try_consume_hintdirective:=true; + last_is_deprecated:=true; + end; + _EXPERIMENTAL : + begin + include(moduleopt,mo_hint_experimental); + try_consume_hintdirective:=true; + end; + _PLATFORM : + begin + include(moduleopt,mo_hint_platform); + try_consume_hintdirective:=true; + end; + _UNIMPLEMENTED : + begin + include(moduleopt,mo_hint_unimplemented); + try_consume_hintdirective:=true; + end; + else + break; + end; + consume(Token); + { handle deprecated message } + if ((token=_CSTRING) or (token=_CCHAR)) and last_is_deprecated then + begin + if deprecatedmsg<>nil then + internalerror(201001221); + if token=_CSTRING then + deprecatedmsg:=stringdup(cstringpattern) + else + deprecatedmsg:=stringdup(pattern); + consume(token); + include(moduleopt,mo_has_deprecated_msg); + end; + until false; + end; + + procedure proc_unit; + + function is_assembler_generated:boolean; + var + hal : tasmlisttype; + begin + result:=false; + if Errorcount=0 then + begin + for hal:=low(TasmlistType) to high(TasmlistType) do + if not current_asmdata.asmlists[hal].empty then + begin + result:=true; + exit; + end; + end; + end; + + var + main_file: tinputfile; +{$ifdef EXTDEBUG} + store_crc, +{$endif EXTDEBUG} + store_interface_crc, + store_indirect_crc: cardinal; + s1,s2 : ^string; {Saves stack space} + force_init_final : boolean; + init_procinfo, + finalize_procinfo : tcgprocinfo; + unitname : ansistring; + unitname8 : string[8]; + ag: boolean; +{$ifdef debug_devirt} + i: longint; +{$endif debug_devirt} + begin + init_procinfo:=nil; + finalize_procinfo:=nil; + + if m_mac in current_settings.modeswitches then + current_module.mode_switch_allowed:= false; + + consume(_UNIT); + if compile_level=1 then + Status.IsExe:=false; + + unitname:=orgpattern; + consume(_ID); + while token=_POINT do + begin + consume(_POINT); + unitname:=unitname+'.'+orgpattern; + consume(_ID); + end; + + { create filenames and unit name } + main_file := current_scanner.inputfile; + while assigned(main_file.next) do + main_file := main_file.next; + + new(s1); + s1^:=current_module.modulename^; + current_module.SetFileName(main_file.path^+main_file.name^,true); + current_module.SetModuleName(unitname); + + { check for system unit } + new(s2); + s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name^),'')); + unitname8:=copy(current_module.modulename^,1,8); + if (cs_check_unit_name in current_settings.globalswitches) and + ( + not( + (current_module.modulename^=s2^) or + ( + (length(current_module.modulename^)>8) and + (unitname8=s2^) + ) + ) + or + ( + (length(s1^)>8) and + (s1^<>current_module.modulename^) + ) + ) then + Message1(unit_e_illegal_unit_name,current_module.realmodulename^); + if (current_module.modulename^='SYSTEM') then + include(current_settings.moduleswitches,cs_compilesystem); + dispose(s2); + dispose(s1); + + if (target_info.system in systems_unit_program_exports) then + exportlib.preparelib(current_module.realmodulename^); + + { parse hint directives } + try_consume_hintdirective(current_module.moduleoptions, current_module.deprecatedmsg); + + consume(_SEMICOLON); + consume(_INTERFACE); + { global switches are read, so further changes aren't allowed } + current_module.in_global:=false; + + { handle the global switches } + setupglobalswitches; + + message1(unit_u_loading_interface_units,current_module.modulename^); + + { update status } + status.currentmodule:=current_module.realmodulename^; + + { maybe turn off m_objpas if we are compiling objpas } + if (current_module.modulename^='OBJPAS') then + exclude(current_settings.modeswitches,m_objpas); + + { maybe turn off m_mac if we are compiling macpas } + if (current_module.modulename^='MACPAS') then + exclude(current_settings.modeswitches,m_mac); + + parse_only:=true; + + { generate now the global symboltable, + define first as local to overcome dependency conflicts } + current_module.localsymtable:=tglobalsymtable.create(current_module.modulename^,current_module.moduleid); + + { insert unitsym of this unit to prevent other units having + the same name } + tabstractunitsymtable(current_module.localsymtable).insertunit(tunitsym.create(current_module.realmodulename^,current_module)); + + { load default units, like the system unit } + loaddefaultunits; + + { insert qualifier for the system unit (allows system.writeln) } + if not(cs_compilesystem in current_settings.moduleswitches) and + (token=_USES) then + begin + loadunits; + { has it been compiled at a higher level ?} + if current_module.state=ms_compiled then + exit; + end; + + { move the global symtable from the temporary local to global } + current_module.globalsymtable:=current_module.localsymtable; + current_module.localsymtable:=nil; + + { number all units, so we know if a unit is used by this unit or + needs to be added implicitly } + current_module.updatemaps; + + { create whole program optimisation information (may already be + updated in the interface, e.g., in case of classrefdef typed + constants } + current_module.wpoinfo:=tunitwpoinfo.create; + + { ... parse the declarations } + Message1(parser_u_parsing_interface,current_module.realmodulename^); + symtablestack.push(current_module.globalsymtable); + read_interface_declarations; + symtablestack.pop(current_module.globalsymtable); + + { Export macros defined in the interface for macpas. The macros + are put in the globalmacrosymtable that will only be used by other + units. The current unit continues to use the localmacrosymtable } + if (m_mac in current_settings.modeswitches) then + begin + current_module.globalmacrosymtable:=tmacrosymtable.create(true); + current_module.localmacrosymtable.SymList.ForEachCall(@copy_macro,nil); + end; + + { leave when we got an error } + if (Errorcount>0) and not status.skip_error then + begin + Message1(unit_f_errors_in_unit,tostr(Errorcount)); + status.skip_error:=true; + exit; + end; + + { Our interface is compiled, generate CRC and switch to implementation } + if not(cs_compilesystem in current_settings.moduleswitches) and + (Errorcount=0) then + tppumodule(current_module).getppucrc; + current_module.in_interface:=false; + current_module.interface_compiled:=true; + + { First reload all units depending on our interface, we need to do this + in the implementation part to prevent erroneous circular references } + tppumodule(current_module).setdefgeneration; + tppumodule(current_module).reload_flagged_units; + + { Parse the implementation section } + if (m_mac in current_settings.modeswitches) and try_to_consume(_END) then + current_module.interface_only:=true + else + current_module.interface_only:=false; + + parse_only:=false; + + { create static symbol table } + current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid); + + { Insert _GLOBAL_OFFSET_TABLE_ symbol if system uses it } + maybe_load_got; + + if not current_module.interface_only then + begin + consume(_IMPLEMENTATION); + Message1(unit_u_loading_implementation_units,current_module.modulename^); + { Read the implementation units } + parse_implementation_uses; + end; + + if current_module.state=ms_compiled then + exit; + + { All units are read, now give them a number } + current_module.updatemaps; + + symtablestack.push(current_module.globalsymtable); + symtablestack.push(current_module.localsymtable); + + if not current_module.interface_only then + begin + Message1(parser_u_parsing_implementation,current_module.modulename^); + if current_module.in_interface then + internalerror(200212285); + + { Compile the unit } + init_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'init'),potype_unitinit,current_module.localsymtable); + init_procinfo.procdef.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,'')); + init_procinfo.parse_body; + { save file pos for debuginfo } + current_module.mainfilepos:=init_procinfo.entrypos; + end; + + { Generate specializations of objectdefs methods } + generate_specialization_procs; + + { if the unit contains ansi/widestrings, initialization and + finalization code must be forced } + force_init_final:=tglobalsymtable(current_module.globalsymtable).needs_init_final or + tstaticsymtable(current_module.localsymtable).needs_init_final; + + { should we force unit initialization? } + { this is a hack, but how can it be done better ? } + { Now the sole purpose of this is to change 'init' to 'init_implicit', is it needed at all? (Sergei) } + if force_init_final and assigned(init_procinfo) and has_no_code(init_procinfo.code) then + begin + { first release the not used init procinfo } + if assigned(init_procinfo) then + release_main_proc(init_procinfo); + init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable); + end; + { finalize? } + if not current_module.interface_only and (token=_FINALIZATION) then + begin + { Compile the finalize } + finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable); + finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,'')); + finalize_procinfo.parse_body; + end + else if force_init_final then + finalize_procinfo:=gen_implicit_initfinal(uf_finalize,current_module.localsymtable); + + { Now both init and finalize bodies are read and it is known + which variables are used in both init and finalize we can now + generate the code. This is required to prevent putting a variable in + a register that is also used in the finalize body (PFV) } + if assigned(init_procinfo) then + begin + if force_init_final or not(has_no_code(init_procinfo.code)) then + begin + init_procinfo.generate_code; + current_module.flags:=current_module.flags or uf_init; + end; + init_procinfo.resetprocdef; + release_main_proc(init_procinfo); + end; + if assigned(finalize_procinfo) then + begin + if force_init_final or not(has_no_code(finalize_procinfo.code)) then + begin + finalize_procinfo.generate_code; + current_module.flags:=current_module.flags or uf_finalize; + end; + finalize_procinfo.resetprocdef; + release_main_proc(finalize_procinfo); + end; + + symtablestack.pop(current_module.localsymtable); + symtablestack.pop(current_module.globalsymtable); + + { the last char should always be a point } + consume(_POINT); + + { reset wpo flags for all defs } + reset_all_defs; + + if (Errorcount=0) then + begin + { tests, if all (interface) forwards are resolved } + tstoredsymtable(current_module.globalsymtable).check_forwards; + { check if all private fields are used } + tstoredsymtable(current_module.globalsymtable).allprivatesused; + + { test static symtable } + tstoredsymtable(current_module.localsymtable).allsymbolsused; + tstoredsymtable(current_module.localsymtable).allprivatesused; + tstoredsymtable(current_module.localsymtable).check_forwards; + tstoredsymtable(current_module.localsymtable).checklabels; + + { used units } + current_module.allunitsused; + end; + + { leave when we got an error } + if (Errorcount>0) and not status.skip_error then + begin + Message1(unit_f_errors_in_unit,tostr(Errorcount)); + status.skip_error:=true; + exit; + end; + + { if an Objective-C module, generate rtti and module info } + MaybeGenerateObjectiveCImageInfo(current_module.globalsymtable,current_module.localsymtable); + + { do we need to add the variants unit? } + maybeloadvariantsunit; + + { generate wrappers for interfaces } + gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.globalsymtable,false); + gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable,false); + + { generate rtti/init tables } + write_persistent_type_info(current_module.globalsymtable); + write_persistent_type_info(current_module.localsymtable); + + { Tables } + InsertThreadvars; + + { Resource strings } + GenerateResourceStrings; + + { Widestring typed constants } + InsertWideInits; + + { Resourcestring references } + InsertResStrInits; + + { generate debuginfo } + if (cs_debuginfo in current_settings.moduleswitches) then + current_debuginfo.inserttypeinfo; + + { generate imports } + if current_module.ImportLibraryList.Count>0 then + importlib.generatelib; + + { insert own objectfile, or say that it's in a library + (no check for an .o when loading) } + ag:=is_assembler_generated; + if ag then + insertobjectfile + else + begin + current_module.flags:=current_module.flags or uf_no_link; + current_module.flags:=current_module.flags and not (uf_has_stabs_debuginfo or uf_has_dwarf_debuginfo); + end; + + if ag then + begin + { create callframe info } + create_dwarf_frame; + { assemble } + create_objectfile; + end; + + { Write out the ppufile after the object file has been created } + store_interface_crc:=current_module.interface_crc; + store_indirect_crc:=current_module.indirect_crc; +{$ifdef EXTDEBUG} + store_crc:=current_module.crc; +{$endif EXTDEBUG} + if (Errorcount=0) then + tppumodule(current_module).writeppu; + + if not(cs_compilesystem in current_settings.moduleswitches) then + begin + if store_interface_crc<>current_module.interface_crc then + Message1(unit_u_interface_crc_changed,current_module.ppufilename^); + if store_indirect_crc<>current_module.indirect_crc then + Message1(unit_u_indirect_crc_changed,current_module.ppufilename^); + end; +{$ifdef EXTDEBUG} + if not(cs_compilesystem in current_settings.moduleswitches) then + if (store_crc<>current_module.crc) and simplify_ppu then + Message1(unit_u_implementation_crc_changed,current_module.ppufilename^); +{$endif EXTDEBUG} + + { release local symtables that are not needed anymore } + free_localsymtables(current_module.globalsymtable); + free_localsymtables(current_module.localsymtable); + + { leave when we got an error } + if (Errorcount>0) and not status.skip_error then + begin + Message1(unit_f_errors_in_unit,tostr(Errorcount)); + status.skip_error:=true; + exit; + end; + +{$ifdef debug_devirt} + { print out all instantiated class/object types } + writeln('constructed object/class/classreftypes in ',current_module.realmodulename^); + for i := 0 to current_module.wpoinfo.createdobjtypes.count-1 do + begin + write(' ',tdef(current_module.wpoinfo.createdobjtypes[i]).GetTypeName); + case tdef(current_module.wpoinfo.createdobjtypes[i]).typ of + objectdef: + case tobjectdef(current_module.wpoinfo.createdobjtypes[i]).objecttype of + odt_object: + writeln(' (object)'); + odt_class: + writeln(' (class)'); + else + internalerror(2008101103); + end; + else + internalerror(2008101104); + end; + end; + + for i := 0 to current_module.wpoinfo.createdclassrefobjtypes.count-1 do + begin + write(' Class Of ',tdef(current_module.wpoinfo.createdclassrefobjtypes[i]).GetTypeName); + case tdef(current_module.wpoinfo.createdclassrefobjtypes[i]).typ of + objectdef: + case tobjectdef(current_module.wpoinfo.createdclassrefobjtypes[i]).objecttype of + odt_class: + writeln(' (classrefdef)'); + else + internalerror(2008101105); + end + else + internalerror(2008101102); + end; + end; +{$endif debug_devirt} + + Message1(unit_u_finished_compiling,current_module.modulename^); + end; + + + procedure procexport(const s : string); + var + hp : texported_item; + begin + hp:=texported_item.create; + hp.name:=stringdup(s); + hp.options:=hp.options or eo_name; + exportlib.exportprocedure(hp); + end; + + + procedure varexport(const s : string); + var + hp : texported_item; + begin + hp:=texported_item.create; + hp.name:=stringdup(s); + hp.options:=hp.options or eo_name; + exportlib.exportvar(hp); + end; + + + procedure insert_export(sym : TObject;arg:pointer); + var + i : longint; + item : TCmdStrListItem; + begin + case TSym(sym).typ of + { ignore: } + unitsym, + syssym, + constsym, + enumsym, + typesym: + ; + procsym: + begin + for i:=0 to tprocsym(sym).ProcdefList.Count-1 do + begin + if not(tprocdef(tprocsym(sym).ProcdefList[i]).proccalloption in [pocall_internproc]) and + ((tprocdef(tprocsym(sym).ProcdefList[i]).procoptions*[po_external])=[]) and + ((tsymtable(arg).symtabletype=globalsymtable) or + ((tsymtable(arg).symtabletype=staticsymtable) and (po_public in tprocdef(tprocsym(sym).ProcdefList[i]).procoptions)) + ) then + begin + procexport(tprocdef(tprocsym(sym).ProcdefList[i]).mangledname); + { walk through all aliases } + item:=TCmdStrListItem(tprocdef(tprocsym(sym).ProcdefList[i]).aliasnames.first); + while assigned(item) do + begin + { avoid duplicate entries, sometimes aliasnames contains the mangledname } + if item.str<>tprocdef(tprocsym(sym).ProcdefList[i]).mangledname then + procexport(item.str); + item:=TCmdStrListItem(item.next); + end; + end; + end; + end; + staticvarsym: + begin + varexport(tsym(sym).mangledname); + end; + else + begin + writeln('unknown: ',ord(TSym(sym).typ)); + end; + end; + end; + + + Function RewritePPU(const PPUFn,PPLFn:String):Boolean; + Var + MakeStatic : Boolean; + Var + buffer : array[0..$1fff] of byte; + inppu, + outppu : tppufile; + b, + untilb : byte; + l,m : longint; + f : file; + ext, + s : string; + ppuversion : dword; + begin + Result:=false; + MakeStatic:=False; + inppu:=tppufile.create(PPUFn); + if not inppu.openfile then + begin + inppu.free; + Comment(V_Error,'Could not open : '+PPUFn); + Exit; + end; + { Check the ppufile } + if not inppu.CheckPPUId then + begin + inppu.free; + Comment(V_Error,'Not a PPU File : '+PPUFn); + Exit; + end; + ppuversion:=inppu.GetPPUVersion; + if ppuversion<CurrentPPUVersion then + begin + inppu.free; + Comment(V_Error,'Wrong PPU Version '+tostr(ppuversion)+' in '+PPUFn); + Exit; + end; + { No .o file generated for this ppu, just skip } + if (inppu.header.flags and uf_no_link)<>0 then + begin + inppu.free; + Result:=true; + Exit; + end; + { Already a lib? } + if (inppu.header.flags and uf_in_library)<>0 then + begin + inppu.free; + Comment(V_Error,'PPU is already in a library : '+PPUFn); + Exit; + end; + { We need a static linked unit } + if (inppu.header.flags and uf_static_linked)=0 then + begin + inppu.free; + Comment(V_Error,'PPU is not static linked : '+PPUFn); + Exit; + end; + { Check if shared is allowed } + if tsystem(inppu.header.target) in [system_i386_go32v2] then + begin + Comment(V_Error,'Shared library not supported for ppu target, switching to static library'); + MakeStatic:=true; + end; + { Create the new ppu } + if PPUFn=PPLFn then + outppu:=tppufile.create('ppumove.$$$') + else + outppu:=tppufile.create(PPLFn); + outppu.createfile; + { Create new header, with the new flags } + outppu.header:=inppu.header; + outppu.header.flags:=outppu.header.flags or uf_in_library; + if MakeStatic then + outppu.header.flags:=outppu.header.flags or uf_static_linked + else + outppu.header.flags:=outppu.header.flags or uf_shared_linked; + { read until the object files are found } + untilb:=iblinkunitofiles; + repeat + b:=inppu.readentry; + if b in [ibendinterface,ibend] then + begin + inppu.free; + outppu.free; + Comment(V_Error,'No files to be linked found : '+PPUFn); + Exit; + end; + if b<>untilb then + begin + repeat + inppu.getdatabuf(buffer,sizeof(buffer),l); + outppu.putdata(buffer,l); + until l<sizeof(buffer); + outppu.writeentry(b); + end; + until (b=untilb); + { we have now reached the section for the files which need to be added, + now add them to the list } + case b of + iblinkunitofiles : + begin + { add all o files, and save the entry when not creating a static + library to keep staticlinking possible } + while not inppu.endofentry do + begin + s:=inppu.getstring; + m:=inppu.getlongint; + if not MakeStatic then + begin + outppu.putstring(s); + outppu.putlongint(m); + end; + current_module.linkotherofiles.add(s,link_always);; + end; + if not MakeStatic then + outppu.writeentry(b); + end; + { iblinkunitstaticlibs : + begin + AddToLinkFiles(ExtractLib(inppu.getstring)); + if not inppu.endofentry then + begin + repeat + inppu.getdatabuf(buffer^,bufsize,l); + outppu.putdata(buffer^,l); + until l<bufsize; + outppu.writeentry(b); + end; + end; } + end; + { just add a new entry with the new lib } + if MakeStatic then + begin + outppu.putstring('imp'+current_module.realmodulename^); + outppu.putlongint(link_static); + outppu.writeentry(iblinkunitstaticlibs) + end + else + begin + outppu.putstring('imp'+current_module.realmodulename^); + outppu.putlongint(link_shared); + outppu.writeentry(iblinkunitsharedlibs); + end; + { read all entries until the end and write them also to the new ppu } + repeat + b:=inppu.readentry; + { don't write ibend, that's written automatically } + if b<>ibend then + begin + if b=iblinkothersharedlibs then + begin + while not inppu.endofentry do + begin + s:=inppu.getstring; + m:=inppu.getlongint; + + outppu.putstring(s); + outppu.putlongint(m); + + { strip lib prefix } + if copy(s,1,3)='lib' then + delete(s,1,3); + ext:=ExtractFileExt(s); + if ext<>'' then + delete(s,length(s)-length(ext)+1,length(ext)); + + current_module.linkOtherSharedLibs.add(s,link_always); + end; + end + else + repeat + inppu.getdatabuf(buffer,sizeof(buffer),l); + outppu.putdata(buffer,l); + until l<sizeof(buffer); + outppu.writeentry(b); + end; + until b=ibend; + { write the last stuff and close } + outppu.flush; + outppu.writeheader; + outppu.free; + inppu.free; + { rename } + if PPUFn=PPLFn then + begin + {$push}{$I-} + assign(f,PPUFn); + erase(f); + assign(f,'ppumove.$$$'); + rename(f,PPUFn); + {$pop} + if ioresult<>0 then; + end; + Result:=True; + end; + + + procedure createimportlibfromexports; + var + hp : texported_item; + begin + hp:=texported_item(current_module._exports.first); + while assigned(hp) do + begin + current_module.AddExternalImport(current_module.realmodulename^,hp.name^,hp.name^,hp.index,hp.is_var,false); + hp:=texported_item(hp.next); + end; + end; + + + procedure proc_package; + var + main_file : tinputfile; + hp,hp2 : tmodule; + {finalize_procinfo, + init_procinfo, + main_procinfo : tcgprocinfo;} + force_init_final : boolean; + uu : tused_unit; + module_name: ansistring; + begin + Status.IsPackage:=true; + Status.IsExe:=true; + parse_only:=false; + {main_procinfo:=nil; + init_procinfo:=nil; + finalize_procinfo:=nil;} + + if not RelocSectionSetExplicitly then + RelocSection:=true; + + { Relocation works only without stabs under Windows when } + { external linker (LD) is used. LD generates relocs for } + { stab sections which is not loaded in memory. It causes } + { AV error when DLL is loaded and relocation is needed. } + { Internal linker does not have this problem. } + if RelocSection and + (target_info.system in systems_all_windows+[system_i386_wdosx]) and + (cs_link_extern in current_settings.globalswitches) then + begin + include(current_settings.globalswitches,cs_link_strip); + { Warning stabs info does not work with reloc section !! } + if (cs_debuginfo in current_settings.moduleswitches) and + (target_dbg.id=dbg_stabs) then + begin + Message1(parser_w_parser_reloc_no_debug,current_module.mainsource^); + Message(parser_w_parser_win32_debug_needs_WN); + exclude(current_settings.moduleswitches,cs_debuginfo); + end; + end; + { get correct output names } + main_file := current_scanner.inputfile; + while assigned(main_file.next) do + main_file := main_file.next; + + current_module.SetFileName(main_file.path^+main_file.name^,true); + + { consume _PACKAGE word } + consume(_ID); + + module_name:=orgpattern; + consume(_ID); + while token=_POINT do + begin + consume(_POINT); + module_name:=module_name+'.'+orgpattern; + consume(_ID); + end; + + current_module.setmodulename(module_name); + current_module.ispackage:=true; + exportlib.preparelib(module_name); + + if tf_library_needs_pic in target_info.flags then + include(current_settings.moduleswitches,cs_create_pic); + + consume(_SEMICOLON); + + { global switches are read, so further changes aren't allowed } + current_module.in_global:=false; + + { setup things using the switches } + setupglobalswitches; + + { set implementation flag } + current_module.in_interface:=false; + current_module.interface_compiled:=true; + + { insert after the unit symbol tables the static symbol table } + { of the program } + current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid); + + {Load the units used by the program we compile.} + if token=_REQUIRES then + begin + end; + + {Load the units used by the program we compile.} + if (token=_ID) and (idtoken=_CONTAINS) then + begin + { consume _CONTAINS word } + consume(_ID); + while true do + begin + if token=_ID then + begin + module_name:=pattern; + consume(_ID); + while token=_POINT do + begin + consume(_POINT); + module_name:=module_name+'.'+orgpattern; + consume(_ID); + end; + AddUnit(module_name); + end + else + consume(_ID); + if token=_COMMA then + consume(_COMMA) + else break; + end; + consume(_SEMICOLON); + end; + + { All units are read, now give them a number } + current_module.updatemaps; + + {Insert the name of the main program into the symbol table.} + if current_module.realmodulename^<>'' then + tabstractunitsymtable(current_module.localsymtable).insertunit(tunitsym.create(current_module.realmodulename^,current_module)); + + Message1(parser_u_parsing_implementation,current_module.mainsource^); + + symtablestack.push(current_module.localsymtable); + + { create whole program optimisation information } + current_module.wpoinfo:=tunitwpoinfo.create; + + { should we force unit initialization? } + force_init_final:=tstaticsymtable(current_module.localsymtable).needs_init_final; + if force_init_final then + {init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable)}; + + { Add symbol to the exports section for win32 so smartlinking a + DLL will include the edata section } + if assigned(exportlib) and + (target_info.system in [system_i386_win32,system_i386_wdosx]) and + ((current_module.flags and uf_has_exports)<>0) then + current_asmdata.asmlists[al_procedures].concat(tai_const.createname(make_mangledname('EDATA',current_module.localsymtable,''),0)); + + { all labels must be defined before generating code } + if Errorcount=0 then + tstoredsymtable(current_module.localsymtable).checklabels; + + symtablestack.pop(current_module.localsymtable); + + { consume the last point } + consume(_END); + consume(_POINT); + + if (Errorcount=0) then + begin + { test static symtable } + tstoredsymtable(current_module.localsymtable).allsymbolsused; + tstoredsymtable(current_module.localsymtable).allprivatesused; + tstoredsymtable(current_module.localsymtable).check_forwards; + + current_module.allunitsused; + end; + + new_section(current_asmdata.asmlists[al_globals],sec_data,'_FPCDummy',4); + current_asmdata.asmlists[al_globals].concat(tai_symbol.createname_global('_FPCDummy',AT_DATA,0)); + current_asmdata.asmlists[al_globals].concat(tai_const.create_32bit(0)); + + new_section(current_asmdata.asmlists[al_procedures],sec_code,'',0); + current_asmdata.asmlists[al_procedures].concat(tai_symbol.createname_global('_DLLMainCRTStartup',AT_FUNCTION,0)); + gen_fpc_dummy(current_asmdata.asmlists[al_procedures]); + current_asmdata.asmlists[al_procedures].concat(tai_const.createname('_FPCDummy',0)); + + { leave when we got an error } + if (Errorcount>0) and not status.skip_error then + begin + Message1(unit_f_errors_in_unit,tostr(Errorcount)); + status.skip_error:=true; + exit; + end; + + { remove all unused units, this happends when units are removed + from the uses clause in the source and the ppu was already being loaded } + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + hp2:=hp; + hp:=tmodule(hp.next); + if hp2.is_unit and + not assigned(hp2.globalsymtable) then + loaded_units.remove(hp2); + end; + + { force exports } + uu:=tused_unit(usedunits.first); + while assigned(uu) do + begin + uu.u.globalsymtable.symlist.ForEachCall(@insert_export,uu.u.globalsymtable); + { check localsymtable for exports too to get public symbols } + uu.u.localsymtable.symlist.ForEachCall(@insert_export,uu.u.localsymtable); + + { create special exports } + if (uu.u.flags and uf_init)<>0 then + procexport(make_mangledname('INIT$',uu.u.globalsymtable,'')); + if (uu.u.flags and uf_finalize)<>0 then + procexport(make_mangledname('FINALIZE$',uu.u.globalsymtable,'')); + if (uu.u.flags and uf_threadvars)=uf_threadvars then + varexport(make_mangledname('THREADVARLIST',uu.u.globalsymtable,'')); + + uu:=tused_unit(uu.next); + end; + +{$ifdef arm} + { Insert .pdata section for arm-wince. + It is needed for exception handling. } + if target_info.system in [system_arm_wince] then + InsertPData; +{$endif arm} + + { generate debuginfo } + if (cs_debuginfo in current_settings.moduleswitches) then + current_debuginfo.inserttypeinfo; + + exportlib.generatelib; + + { write all our exports to the import library, + needs to be done after exportlib.generatelib; } + createimportlibfromexports; + + { generate imports } + if current_module.ImportLibraryList.Count>0 then + importlib.generatelib; + + { Reference all DEBUGINFO sections from the main .fpc section } + if (cs_debuginfo in current_settings.moduleswitches) then + current_debuginfo.referencesections(current_asmdata.asmlists[al_procedures]); + + { insert own objectfile } + insertobjectfile; + + { assemble and link } + create_objectfile; + + { We might need the symbols info if not using + the default do_extractsymbolinfo + which is a dummy function PM } + needsymbolinfo:=do_extractsymbolinfo<>@def_extractsymbolinfo; + { release all local symtables that are not needed anymore } + if (not needsymbolinfo) then + free_localsymtables(current_module.localsymtable); + + { leave when we got an error } + if (Errorcount>0) and not status.skip_error then + begin + Message1(unit_f_errors_in_unit,tostr(Errorcount)); + status.skip_error:=true; + exit; + end; + + if (not current_module.is_unit) then + begin + { finally rewrite all units included into the package } + uu:=tused_unit(usedunits.first); + while assigned(uu) do + begin + RewritePPU(uu.u.ppufilename^,uu.u.ppufilename^); + uu:=tused_unit(uu.next); + end; + + { create the executable when we are at level 1 } + if (compile_level=1) then + begin + { create global resource file by collecting all resource files } + CollectResourceFiles; + { write .def file } + if (cs_link_deffile in current_settings.globalswitches) then + deffile.writefile; + { insert all .o files from all loaded units and + unload the units, we don't need them anymore. + Keep the current_module because that is still needed } + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + { the package itself contains no code so far } + linker.AddModuleFiles(hp); + hp2:=tmodule(hp.next); + if (hp<>current_module) and + (not needsymbolinfo) then + begin + loaded_units.remove(hp); + hp.free; + end; + hp:=hp2; + end; + linker.MakeSharedLibrary + end; + + { Give Fatal with error count for linker errors } + if (Errorcount>0) and not status.skip_error then + begin + Message1(unit_f_errors_in_unit,tostr(Errorcount)); + status.skip_error:=true; + end; + end; + end; + + + procedure proc_program(islibrary : boolean); + var + main_file : tinputfile; + hp,hp2 : tmodule; + finalize_procinfo, + init_procinfo, + main_procinfo : tcgprocinfo; + force_init_final : boolean; + resources_used : boolean; + program_name : ansistring; + begin + DLLsource:=islibrary; + Status.IsLibrary:=IsLibrary; + Status.IsPackage:=false; + Status.IsExe:=true; + parse_only:=false; + main_procinfo:=nil; + init_procinfo:=nil; + finalize_procinfo:=nil; + resources_used:=false; + + { DLL defaults to create reloc info } + if islibrary then + begin + if not RelocSectionSetExplicitly then + RelocSection:=true; + end; + + { Relocation works only without stabs under Windows when } + { external linker (LD) is used. LD generates relocs for } + { stab sections which is not loaded in memory. It causes } + { AV error when DLL is loaded and relocation is needed. } + { Internal linker does not have this problem. } + if RelocSection and + (target_info.system in systems_all_windows+[system_i386_wdosx]) and + (cs_link_extern in current_settings.globalswitches) then + begin + include(current_settings.globalswitches,cs_link_strip); + { Warning stabs info does not work with reloc section !! } + if (cs_debuginfo in current_settings.moduleswitches) and + (target_dbg.id=dbg_stabs) then + begin + Message1(parser_w_parser_reloc_no_debug,current_module.mainsource^); + Message(parser_w_parser_win32_debug_needs_WN); + exclude(current_settings.moduleswitches,cs_debuginfo); + end; + end; + { get correct output names } + main_file := current_scanner.inputfile; + while assigned(main_file.next) do + main_file := main_file.next; + + current_module.SetFileName(main_file.path^+main_file.name^,true); + + if islibrary then + begin + consume(_LIBRARY); + program_name:=orgpattern; + consume(_ID); + while token=_POINT do + begin + consume(_POINT); + program_name:=program_name+'.'+orgpattern; + consume(_ID); + end; + current_module.setmodulename(program_name); + current_module.islibrary:=true; + exportlib.preparelib(program_name); + + if tf_library_needs_pic in target_info.flags then + include(current_settings.moduleswitches,cs_create_pic); + + consume(_SEMICOLON); + end + else + { is there an program head ? } + if token=_PROGRAM then + begin + consume(_PROGRAM); + program_name:=orgpattern; + consume(_ID); + while token=_POINT do + begin + consume(_POINT); + program_name:=program_name+'.'+orgpattern; + consume(_ID); + end; + current_module.setmodulename(program_name); + if (target_info.system in systems_unit_program_exports) then + exportlib.preparelib(program_name); + if token=_LKLAMMER then + begin + consume(_LKLAMMER); + repeat + consume(_ID); + until not try_to_consume(_COMMA); + consume(_RKLAMMER); + end; + consume(_SEMICOLON); + end + else if (target_info.system in systems_unit_program_exports) then + exportlib.preparelib(current_module.realmodulename^); + + { global switches are read, so further changes aren't allowed } + current_module.in_global:=false; + + { setup things using the switches } + setupglobalswitches; + + { set implementation flag } + current_module.in_interface:=false; + current_module.interface_compiled:=true; + + { insert after the unit symbol tables the static symbol table } + { of the program } + current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid); + + { load standard units (system,objpas,profile unit) } + loaddefaultunits; + + { Load units provided on the command line } + loadautounits; + + {Load the units used by the program we compile.} + if token=_USES then + loadunits; + + { All units are read, now give them a number } + current_module.updatemaps; + + {Insert the name of the main program into the symbol table.} + if current_module.realmodulename^<>'' then + tabstractunitsymtable(current_module.localsymtable).insertunit(tunitsym.create(current_module.realmodulename^,current_module)); + + Message1(parser_u_parsing_implementation,current_module.mainsource^); + + symtablestack.push(current_module.localsymtable); + + { Insert _GLOBAL_OFFSET_TABLE_ symbol if system uses it } + maybe_load_got; + + { create whole program optimisation information } + current_module.wpoinfo:=tunitwpoinfo.create; + + { The program intialization needs an alias, so it can be called + from the bootstrap code.} + if islibrary then + begin + main_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,mainaliasname),potype_proginit,current_module.localsymtable); + { Win32 startup code needs a single name } + if not(target_info.system in systems_darwin) then + main_procinfo.procdef.aliasnames.insert('PASCALMAIN') + else + main_procinfo.procdef.aliasnames.insert(target_info.Cprefix+'PASCALMAIN') + end + else if (target_info.system in ([system_i386_netware,system_i386_netwlibc,system_powerpc_macos]+systems_darwin)) then + begin + main_procinfo:=create_main_proc('PASCALMAIN',potype_proginit,current_module.localsymtable); + end + else + begin + main_procinfo:=create_main_proc(mainaliasname,potype_proginit,current_module.localsymtable); + main_procinfo.procdef.aliasnames.insert('PASCALMAIN'); + end; + main_procinfo.parse_body; + { save file pos for debuginfo } + current_module.mainfilepos:=main_procinfo.entrypos; + + { Generate specializations of objectdefs methods } + generate_specialization_procs; + + { should we force unit initialization? } + force_init_final:=tstaticsymtable(current_module.localsymtable).needs_init_final; + if force_init_final then + init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable); + + { Add symbol to the exports section for win32 so smartlinking a + DLL will include the edata section } + if assigned(exportlib) and + (target_info.system in [system_i386_win32,system_i386_wdosx]) and + ((current_module.flags and uf_has_exports)<>0) then + current_asmdata.asmlists[al_procedures].concat(tai_const.createname(make_mangledname('EDATA',current_module.localsymtable,''),0)); + + { finalize? } + if token=_FINALIZATION then + begin + { Parse the finalize } + finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable); + finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,'')); + finalize_procinfo.procdef.aliasnames.insert('PASCALFINALIZE'); + finalize_procinfo.parse_body; + end + else + if force_init_final then + finalize_procinfo:=gen_implicit_initfinal(uf_finalize,current_module.localsymtable); + + { the finalization routine of libraries is generic (and all libraries need to } + { be finalized, so they can finalize any units they use } + if (islibrary) then + exportlib.setfininame(current_asmdata.asmlists[al_procedures],'FPC_LIB_EXIT'); + + { all labels must be defined before generating code } + if Errorcount=0 then + tstoredsymtable(current_module.localsymtable).checklabels; + + { See remark in unit init/final } + main_procinfo.generate_code; + main_procinfo.resetprocdef; + release_main_proc(main_procinfo); + if assigned(init_procinfo) then + begin + { initialization can be implicit only } + current_module.flags:=current_module.flags or uf_init; + init_procinfo.generate_code; + init_procinfo.resetprocdef; + release_main_proc(init_procinfo); + end; + if assigned(finalize_procinfo) then + begin + if force_init_final or not (has_no_code(finalize_procinfo.code)) then + begin + finalize_procinfo.generate_code; + current_module.flags:=current_module.flags or uf_finalize; + end; + finalize_procinfo.resetprocdef; + release_main_proc(finalize_procinfo); + end; + + symtablestack.pop(current_module.localsymtable); + + { consume the last point } + consume(_POINT); + + { reset wpo flags for all defs } + reset_all_defs; + + if (Errorcount=0) then + begin + { test static symtable } + tstoredsymtable(current_module.localsymtable).allsymbolsused; + tstoredsymtable(current_module.localsymtable).allprivatesused; + tstoredsymtable(current_module.localsymtable).check_forwards; + + current_module.allunitsused; + end; + + { leave when we got an error } + if (Errorcount>0) and not status.skip_error then + begin + Message1(unit_f_errors_in_unit,tostr(Errorcount)); + status.skip_error:=true; + exit; + end; + + { remove all unused units, this happens when units are removed + from the uses clause in the source and the ppu was already being loaded } + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + hp2:=hp; + hp:=tmodule(hp.next); + if hp2.is_unit and + not assigned(hp2.globalsymtable) then + begin + loaded_units.remove(hp2); + unloaded_units.concat(hp2); + end; + end; + + { do we need to add the variants unit? } + maybeloadvariantsunit; + + { Now that everything has been compiled we know if we need resource + support. If not, remove the unit. } + resources_used:=MaybeRemoveResUnit; + + linker.initsysinitunitname; + if target_info.system in systems_internal_sysinit then + begin + { add start/halt unit } + AddUnit(linker.sysinitunit); + end; + +{$ifdef arm} + { Insert .pdata section for arm-wince. + It is needed for exception handling. } + if target_info.system in [system_arm_wince] then + InsertPData; +{$endif arm} + + InsertThreadvars; + + { generate rtti/init tables } + write_persistent_type_info(current_module.localsymtable); + + { if an Objective-C module, generate rtti and module info } + MaybeGenerateObjectiveCImageInfo(nil,current_module.localsymtable); + + { generate wrappers for interfaces } + gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable,false); + + { generate imports } + if current_module.ImportLibraryList.Count>0 then + importlib.generatelib; + + { generate debuginfo } + if (cs_debuginfo in current_settings.moduleswitches) then + current_debuginfo.inserttypeinfo; + + if islibrary or (target_info.system in systems_unit_program_exports) then + exportlib.generatelib; + + { Reference all DEBUGINFO sections from the main .fpc section } + if (cs_debuginfo in current_settings.moduleswitches) then + current_debuginfo.referencesections(current_asmdata.asmlists[al_procedures]); + + { Resource strings } + GenerateResourceStrings; + + { Windows widestring needing initialization } + InsertWideInits; + + { Resourcestring references (const foo:string=someresourcestring) } + InsertResStrInits; + + { insert Tables and StackLength } + InsertInitFinalTable; + InsertThreadvarTablesTable; + InsertResourceTablesTable; + InsertWideInitsTablesTable; + InsertResStrTablesTable; + InsertMemorySizes; + +{$ifdef FPC_HAS_SYSTEMS_INTERRUPT_TABLE} + if target_info.system in systems_interrupt_table then + InsertInterruptTable; +{$endif FPC_HAS_SYSTEMS_INTERRUPT_TABLE} + + { Insert symbol to resource info } + InsertResourceInfo(resources_used); + + { create callframe info } + create_dwarf_frame; + + { insert own objectfile } + insertobjectfile; + + { assemble and link } + create_objectfile; + + { We might need the symbols info if not using + the default do_extractsymbolinfo + which is a dummy function PM } + needsymbolinfo:= + (do_extractsymbolinfo<>@def_extractsymbolinfo) or + ((current_settings.genwpoptimizerswitches*WPOptimizationsNeedingAllUnitInfo)<>[]); + + { release all local symtables that are not needed anymore } + if (not needsymbolinfo) then + free_localsymtables(current_module.localsymtable); + + { leave when we got an error } + if (Errorcount>0) and not status.skip_error then + begin + Message1(unit_f_errors_in_unit,tostr(Errorcount)); + status.skip_error:=true; + exit; + end; + + if (not current_module.is_unit) then + begin + { create the executable when we are at level 1 } + if (compile_level=1) then + begin + { create global resource file by collecting all resource files } + CollectResourceFiles; + { write .def file } + if (cs_link_deffile in current_settings.globalswitches) then + deffile.writefile; + { insert all .o files from all loaded units and + unload the units, we don't need them anymore. + Keep the current_module because that is still needed } + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + linker.AddModuleFiles(hp); + hp2:=tmodule(hp.next); + if (hp<>current_module) and + (not needsymbolinfo) then + begin + loaded_units.remove(hp); + hp.free; + end; + hp:=hp2; + end; + { free also unneeded units we didn't free before } + if not needsymbolinfo then + unloaded_units.Clear; + { finally we can create a executable } + if DLLSource then + linker.MakeSharedLibrary + else + linker.MakeExecutable; + + { collect all necessary information for whole-program optimization } + wpoinfomanager.extractwpoinfofromprogram; + end; + + + { Give Fatal with error count for linker errors } + if (Errorcount>0) and not status.skip_error then + begin + Message1(unit_f_errors_in_unit,tostr(Errorcount)); + status.skip_error:=true; + end; + end; + end; + +end. diff --git a/closures/compiler/powerpc/agppcmpw.pas b/closures/compiler/powerpc/agppcmpw.pas new file mode 100644 index 0000000000..2ca3ddcee1 --- /dev/null +++ b/closures/compiler/powerpc/agppcmpw.pas @@ -0,0 +1,1248 @@ +{ + Copyright (c) 2002 by Florian Klaempfl + + This unit implements an asmoutput class for PowerPC with MPW syntax + + 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 asmoutput class for PowerPC with MPW syntax +} +unit agppcmpw; + +{$i fpcdefs.inc} + { We know that use_PR is a const boolean + but we don't care about this warning } + {$WARN 6018 OFF} + +interface + + uses + aasmtai,aasmdata, + globals,aasmbase,aasmcpu,assemble, + cpubase; + + type + TPPCMPWAssembler = class(TExternalAssembler) + procedure WriteTree(p:TAsmList);override; + procedure WriteAsmList;override; + Function DoAssemble:boolean;override; + procedure WriteExternals; + procedure WriteAsmFileHeader; + private + cur_CSECT_name: String; + cur_CSECT_class: String; + + procedure WriteInstruction(hp : tai); + procedure WriteProcedureHeader(var hp:tai); + procedure WriteDataHeader(var s:string; isExported, isConst:boolean); + end; + + + implementation + + uses + cutils,globtype,systems,cclasses, + verbose,finput,fmodule,script,cpuinfo, + cgbase,cgutils, + itcpugas + ; + + const + line_length = 70; + + {Whether internal procedure references should be xxx[PR]: } + use_PR = false; + + const_storage_class = ''; + var_storage_class = ''; + + secnames : array[TAsmSectiontype] of string[10] = ( + '', {none} + '', {user} + 'csect', {code} + 'csect', {data} + 'csect', {read only data} + 'csect', {read only data - no relocations} + 'csect', {bss} 'csect', '', + 'csect','csect','csect','csect','csect', + 'csect','csect','csect', + '','','','','','','','','','','','','','', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '' + ); + + type + t64bitarray = array[0..7] of byte; + t32bitarray = array[0..3] of byte; + + function ReplaceForbiddenChars(var s: string):Boolean; + {Returns wheater a replacement has occured.} + + var + i:Integer; + + {The dollar sign is not allowed in MPW PPCAsm} + + begin + ReplaceForbiddenChars:=false; + for i:=1 to Length(s) do + if s[i]='$' then + begin + s[i]:='s'; + ReplaceForbiddenChars:=true; + end; + end; + + +{*** From here is copyed from agppcgas.pp, except where marked with CHANGED. + Perhaps put in a third common file. ***} + + + function getreferencestring(var ref : treference) : string; + var + s : string; + begin + with ref do + begin + if (refaddr <> addr_no) then + InternalError(2002110301) + else if ((offset < -32768) or (offset > 32767)) then + InternalError(19991); + + + if assigned(symbol) then + begin + s:= symbol.name; + ReplaceForbiddenChars(s); + {if symbol.typ = AT_FUNCTION then + ;} + + s:= s+'[TC]' {ref to TOC entry } + end + else + s:= ''; + + + if offset<0 then + s:=s+tostr(offset) + else + if (offset>0) then + begin + if assigned(symbol) then + s:=s+'+'+tostr(offset) + else + s:=s+tostr(offset); + end; + + if (index=NR_NO) and (base<>NR_NO) then + begin + if offset=0 then + if not assigned(symbol) then + s:=s+'0'; + s:=s+'('+gas_regname(base)+')'; + end + else if (index<>NR_NO) and (base<>NR_NO) and (offset=0) then + begin + if (offset=0) then + s:=s+gas_regname(base)+','+gas_regname(index) + else + internalerror(19992); + end + else if (base=NR_NO) and (offset=0) then + begin + {Temporary fix for inline asm, where a local var is referenced.} + //if assigned(symbol) then + // s:= s+'(rtoc)'; + end; + end; + getreferencestring:=s; + end; + + function getopstr_jmp(const o:toper) : string; + var + hs : string; + begin + case o.typ of + top_reg : + getopstr_jmp:=gas_regname(o.reg); + { no top_ref jumping for powerpc } + top_const : + getopstr_jmp:=tostr(o.val); + top_ref : + begin + if o.ref^.refaddr=addr_full then + begin + hs:=o.ref^.symbol.name; + ReplaceForbiddenChars(hs); + case o.ref^.symbol.typ of + AT_FUNCTION: + begin + if hs[1] <> '@' then {if not local label} + if use_PR then + hs:= '.'+hs+'[PR]' + else + hs:= '.'+hs + end + else + ; + end; + 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_jmp:=hs; + end + else + internalerror(200402263); + end; + top_none: + getopstr_jmp:=''; + else + internalerror(2002070603); + end; + end; + + function getopstr(const o:toper) : string; + var + hs : string; + begin + case o.typ of + top_reg: + getopstr:=gas_regname(o.reg); + top_const: + getopstr:=tostr(longint(o.val)); + top_ref: + if o.ref^.refaddr=addr_no then + getopstr:=getreferencestring(o.ref^) + else + begin + hs:=o.ref^.symbol.name; + ReplaceForbiddenChars(hs); + 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 + internalerror(2002070604); + end; + end; + + type + topstr = string[4]; + + function branchmode(o: tasmop): topstr; + var tempstr: topstr; + begin + tempstr := ''; + case o of + A_BCCTR,A_BCCTRL: tempstr := 'ctr'; + A_BCLR,A_BCLRL: tempstr := 'lr'; + end; + case o of + A_BL,A_BLA,A_BCL,A_BCLA,A_BCCTRL,A_BCLRL: tempstr := tempstr+'l'; + end; + case o of + A_BA,A_BLA,A_BCA,A_BCLA: tempstr:=tempstr+'a'; + end; + branchmode := tempstr; + end; + + function cond2str(op: tasmop; c: tasmcond): string; + { note: no checking is performed whether the given combination of } + { conditions is valid } + var + tempstr: string; + begin + tempstr:=#9; + case c.simple of + false: + begin + cond2str := tempstr+gas_op2str[op]; + case c.dirhint of + DH_None:; + DH_Minus: + cond2str:=cond2str+'-'; + DH_Plus: + cond2str:=cond2str+'+'; + else + internalerror(2003112901); + end; + cond2str:=cond2str+#9+tostr(c.bo)+','+tostr(c.bi)+','; + end; + true: + if (op >= A_B) and (op <= A_BCLRL) then + case c.cond of + { unconditional branch } + C_NONE: + cond2str := tempstr+gas_op2str[op]; + { bdnzt etc } + else + begin + tempstr := tempstr+'b'+asmcondflag2str[c.cond]+ + branchmode(op); + case c.dirhint of + DH_None: + tempstr:=tempstr+#9; + DH_Minus: + tempstr:=tempstr+('-'+#9); + DH_Plus: + tempstr:=tempstr+('+'+#9); + else + internalerror(2003112901); + end; + case c.cond of + C_LT..C_NU: + cond2str := tempstr+gas_regname(newreg(R_SPECIALREGISTER,c.cr,R_SUBWHOLE)); + C_T,C_F,C_DNZT,C_DNZF,C_DZT,C_DZF: + cond2str := tempstr+tostr(c.crbit); + else + cond2str := tempstr; + end; + end; + end + { we have a trap instruction } + else + begin + internalerror(2002070601); + { not yet implemented !!!!!!!!!!!!!!!!!!!!! } + { case tempstr := 'tw';} + end; + end; + end; + + procedure TPPCMPWAssembler.WriteInstruction(hp : tai); + var op: TAsmOp; + s: string; + i: byte; + sep: string[3]; + begin + op:=taicpu(hp).opcode; + if is_calljmp(op) then + begin + { direct BO/BI in op[0] and op[1] not supported, put them in condition! } + case op of + A_B,A_BA: + s:=#9+gas_op2str[op]+#9; + A_BCTR,A_BCTRL,A_BLR,A_BLRL: + s:=#9+gas_op2str[op]; + A_BL,A_BLA: + s:=#9+gas_op2str[op]+#9; + else + begin + s:=cond2str(op,taicpu(hp).condition); + if (s[length(s)] <> #9) and + (taicpu(hp).ops>0) then + s := s + ','; + end; + end; + if (taicpu(hp).ops>0) and (taicpu(hp).oper[0]^.typ<>top_none) then + begin + { first write the current contents of s, because the symbol } + { may be 255 characters } + asmwrite(s); + s:=getopstr_jmp(taicpu(hp).oper[0]^); + end; + end + else + { process operands } + begin + s:=#9+gas_op2str[op]; + if taicpu(hp).ops<>0 then + begin + sep:=#9; + for i:=0 to taicpu(hp).ops-1 do + begin + s:=s+sep+getopstr(taicpu(hp).oper[i]^); + sep:=','; + end; + end; + end; + AsmWriteLn(s); + end; + + {*** Until here is copyed from agppcgas.pp. ***} + + + function single2str(d : single) : string; + var + hs : string; + p : byte; + begin + str(d,hs); + { nasm expects a lowercase e } + p:=pos('E',hs); + if p>0 then + hs[p]:='e'; + p:=pos('+',hs); + if p>0 then + delete(hs,p,1); + single2str:=lower(hs); + end; + + function double2str(d : double) : string; + var + hs : string; + p : byte; + begin + str(d,hs); + { nasm expects a lowercase e } + p:=pos('E',hs); + if p>0 then + hs[p]:='e'; + p:=pos('+',hs); + if p>0 then + delete(hs,p,1); + double2str:=lower(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; + + Function PadTabs(const p:string;addch:char):string; + var + s : string; + i : longint; + begin + i:=length(p); + if addch<>#0 then + begin + inc(i); + s:=p+addch; + end + else + s:=p; + if i<8 then + PadTabs:=s+#9#9 + else + PadTabs:=s+#9; + end; + +{**************************************************************************** + PowerPC MPW Assembler + ****************************************************************************} + procedure TPPCMPWAssembler.WriteProcedureHeader(var hp:tai); + {Returns the current hp where the caller should continue from} + {For multiple entry procedures, only the last is exported as xxx[PR] + (if use_PR is set) } + + procedure WriteExportHeader(hp:tai); + + var + s: string; + replaced: boolean; + + begin + s:= tai_symbol(hp).sym.name; + replaced:= ReplaceForbiddenChars(s); + + if not use_PR then + begin + AsmWrite(#9'export'#9'.'); + AsmWrite(s); + if replaced then + begin + AsmWrite(' => ''.'); + AsmWrite(tai_symbol(hp).sym.name); + AsmWrite(''''); + end; + AsmLn; + end; + + AsmWrite(#9'export'#9); + AsmWrite(s); + AsmWrite('[DS]'); + if replaced then + begin + AsmWrite(' => '''); + AsmWrite(tai_symbol(hp).sym.name); + AsmWrite('[DS]'''); + end; + AsmLn; + + {Entry in transition vector: } + AsmWrite(#9'csect'#9); AsmWrite(s); AsmWriteLn('[DS]'); + + AsmWrite(#9'dc.l'#9'.'); AsmWriteLn(s); + + AsmWriteln(#9'dc.l'#9'TOC[tc0]'); + + {Entry in TOC: } + AsmWriteLn(#9'toc'); + + AsmWrite(#9'tc'#9); + AsmWrite(s); AsmWrite('[TC],'); + AsmWrite(s); AsmWriteln('[DS]'); + end; + + function GetAdjacentTaiSymbol(var hp:tai):Boolean; + + begin + GetAdjacentTaiSymbol:= false; + while assigned(hp.next) do + case tai(hp.next).typ of + ait_symbol: + begin + hp:=tai(hp.next); + GetAdjacentTaiSymbol:= true; + Break; + end; + ait_function_name: + hp:=tai(hp.next); + else + begin + //AsmWriteln(' ;#*#*# ' + tostr(Ord(tai(hp.next).typ))); + Break; + end; + end; + end; + + var + first,last: tai; + s: string; + replaced: boolean; + + + begin + s:= tai_symbol(hp).sym.name; + {Write all headers} + first:= hp; + repeat + WriteExportHeader(hp); + last:= hp; + until not GetAdjacentTaiSymbol(hp); + + {Start the section of the body of the proc: } + s:= tai_symbol(last).sym.name; + replaced:= ReplaceForbiddenChars(s); + + if use_PR then + begin + AsmWrite(#9'export'#9'.'); AsmWrite(s); AsmWrite('[PR]'); + if replaced then + begin + AsmWrite(' => ''.'); + AsmWrite(tai_symbol(last).sym.name); + AsmWrite('[PR]'''); + end; + AsmLn; + end; + + {Starts the section: } + AsmWrite(#9'csect'#9'.'); + AsmWrite(s); + AsmWriteLn('[PR]'); + + {Info for the debugger: } + AsmWrite(#9'function'#9'.'); + AsmWrite(s); + AsmWriteLn('[PR]'); + + {Write all labels: } + hp:= first; + repeat + s:= tai_symbol(hp).sym.name; + ReplaceForbiddenChars(s); + AsmWrite('.'); AsmWrite(s); AsmWriteLn(':'); + until not GetAdjacentTaiSymbol(hp); + end; + + procedure TPPCMPWAssembler.WriteDataHeader(var s:string; isExported, isConst:boolean); + // Returns in s the changed string + var + sym: string; + replaced: boolean; + + begin + sym:= s; + replaced:= ReplaceForbiddenChars(s); + + if isExported then + begin + AsmWrite(#9'export'#9); + AsmWrite(s); + if isConst then + AsmWrite(const_storage_class) + else + AsmWrite(var_storage_class); + if replaced then + begin + AsmWrite(' => '''); + AsmWrite(sym); + AsmWrite(''''); + end; + AsmLn; + end; + + if not macos_direct_globals then + begin + {The actual section is here interrupted, by inserting a "tc" entry} + AsmWriteLn(#9'toc'); + + AsmWrite(#9'tc'#9); + AsmWrite(s); + AsmWrite('[TC], '); + AsmWrite(s); + if isConst then + AsmWrite(const_storage_class) + else + AsmWrite(var_storage_class); + AsmLn; + + {The interrupted section is here continued.} + AsmWrite(#9'csect'#9); + AsmWriteln(cur_CSECT_name+cur_CSECT_class); + AsmWrite(PadTabs(s+':',#0)); + end + else + begin + AsmWrite(#9'csect'#9); + AsmWrite(s); + AsmWrite('[TC]'); + end; + + AsmLn; + end; + + const + ait_const2str:array[aitconst_32bit..aitconst_8bit] of string[8]= + (#9'dc.l'#9,#9'dc.w'#9,#9'dc.b'#9); + + + procedure TPPCMPWAssembler.WriteTree(p:TAsmList); + var + s : string; + hp : tai; + counter, + lines, + InlineLevel : longint; + i,j,l : longint; + consttype : taiconst_type; + do_line,DoNotSplitLine, + quoted : boolean; + sin : single; + d : double; + + begin + if not assigned(p) then + exit; + InlineLevel:=0; + { lineinfo is only needed for al_procedures (PFV) } + do_line:=((cs_asm_source in current_settings.globalswitches) or + (cs_lineinfo in current_settings.moduleswitches)) + and (p=current_asmdata.asmlists[al_procedures]); + DoNotSplitLine:=false; + hp:=tai(p.first); + while assigned(hp) do + begin + prefetch(pointer(hp.next)^); + if not(hp.typ in SkipLineInfo) then + begin + current_filepos:=tailineinfo(hp).fileinfo; + { no line info for inlined code } + if do_line and (inlinelevel=0) and not DoNotSplitLine then + WriteSourceLine(hp as tailineinfo); + end; + + DoNotSplitLine:=false; + + case hp.typ of + ait_comment: + begin + AsmWrite(target_asm.comment); + AsmWritePChar(tai_comment(hp).str); + AsmLn; + end; + ait_regalloc, + ait_tempalloc: + ; + ait_section: + begin + {if LastSecType<>sec_none then + AsmWriteLn('_'+target_asm.secnames[LastSecType]+#9#9'ENDS');} + + if tai_section(hp).sectype<>sec_none then + begin + if tai_section(hp).sectype in [sec_data,sec_rodata,sec_bss] then + cur_CSECT_class:= '[RW]' + else if tai_section(hp).sectype in [sec_code] then + cur_CSECT_class:= '' + else + cur_CSECT_class:= '[RO]'; + + s:= tai_section(hp).name^; + if s = '' then + InternalError(2004101001); {Nameless sections should not occur on MPW} + ReplaceForbiddenChars(s); + cur_CSECT_name:= s; + + AsmLn; + AsmWriteLn(#9+secnames[tai_section(hp).sectype]+' '+cur_CSECT_name+cur_CSECT_class); + end; + LastSecType:=tai_section(hp).sectype; + end; + ait_align: + begin + case tai_align(hp).aligntype of + 1:AsmWriteLn(#9'align 0'); + 2:AsmWriteLn(#9'align 1'); + 4:AsmWriteLn(#9'align 2'); + otherwise internalerror(2002110302); + end; + end; + ait_datablock: {Storage for global variables.} + begin + s:= tai_datablock(hp).sym.name; + + WriteDataHeader(s, tai_datablock(hp).is_global, false); + if not macos_direct_globals then + begin + AsmWriteLn(#9'ds.b '+tostr(tai_datablock(hp).size)); + end + else + begin + AsmWriteLn(PadTabs(s+':',#0)+'ds.b '+tostr(tai_datablock(hp).size)); + {TODO: ? PadTabs(s,#0) } + end; + end; + + ait_const: + begin + consttype:=tai_const(hp).consttype; + case consttype of + aitconst_128bit: + begin + internalerror(200404291); + end; + aitconst_64bit: + begin + if assigned(tai_const(hp).sym) then + internalerror(200404292); + AsmWrite(ait_const2str[aitconst_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; + + aitconst_uleb128bit, + aitconst_sleb128bit, + aitconst_32bit, + aitconst_16bit, + aitconst_8bit, + aitconst_rva_symbol : + begin + AsmWrite(ait_const2str[consttype]); + l:=0; + repeat + if assigned(tai_const(hp).sym) then + begin + if assigned(tai_const(hp).endsym) then + begin + if (tai_const(hp).endsym.typ = AT_FUNCTION) and use_PR then + AsmWrite('.'); + + s:=tai_const(hp).endsym.name; + ReplaceForbiddenChars(s); + AsmWrite(s); + inc(l,length(s)); + + if tai_const(hp).endsym.typ = AT_FUNCTION then + begin + if use_PR then + AsmWrite('[PR]') + else + AsmWrite('[DS]'); + end; + + AsmWrite('-'); + inc(l,5); {Approx 5 extra, no need to be exactly} + end; + + if (tai_const(hp).sym.typ = AT_FUNCTION) and use_PR then + AsmWrite('.'); + + s:= tai_const(hp).sym.name; + ReplaceForbiddenChars(s); + AsmWrite(s); + inc(l,length(s)); + + if tai_const(hp).sym.typ = AT_FUNCTION then + begin + if use_PR then + AsmWrite('[PR]') + else + AsmWrite('[DS]'); + end; + inc(l,5); {Approx 5 extra, no need to be exactly} + + if tai_const(hp).value > 0 then + s:= '+'+tostr(tai_const(hp).value) + else if tai_const(hp).value < 0 then + s:= '-'+tostr(tai_const(hp).value) + else + s:= ''; + if s<>'' then + begin + AsmWrite(s); + inc(l,length(s)); + end; + end + else + begin + s:= tostr(tai_const(hp).value); + AsmWrite(s); + inc(l,length(s)); + end; + + if (l>line_length) or + (hp.next=nil) or + (tai(hp.next).typ<>ait_const) or + (tai_const(hp.next).consttype<>consttype) then + break; + hp:=tai(hp.next); + AsmWrite(','); + until false; + AsmLn; + end; + end; + end; + + ait_real_64bit : + begin + 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'dc.b'#9); + 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 + 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'dc.b'#9); + for i:=0 to 3 do + begin + if i<>0 then + AsmWrite(','); + AsmWrite(tostr(t32bitarray(sin)[i])); + end; + AsmLn; + end; + + ait_string: + begin + {NOTE When a single quote char is encountered, it is + replaced with a numeric ascii value. It could also + have been replaced with the escape seq of double quotes. + Backslash seems to be used as an escape char, although + this is not mentioned in the PPCAsm documentation.} + counter := 0; + lines := tai_string(hp).len div line_length; + { separate lines in different parts } + if tai_string(hp).len > 0 then + begin + for j := 0 to lines-1 do + begin + AsmWrite(#9'dc.b'#9); + quoted:=false; + for i:=counter to counter+line_length-1 do + begin + { it is an ascii character. } + if (ord(tai_string(hp).str[i])>31) and + (ord(tai_string(hp).str[i])<128) and + (tai_string(hp).str[i]<>'''') and + (tai_string(hp).str[i]<>'\') then + begin + if not(quoted) then + begin + if i>counter then + AsmWrite(','); + AsmWrite(''''); + end; + AsmWrite(tai_string(hp).str[i]); + quoted:=true; + end { if > 31 and < 128 and ord('"') } + else + begin + if quoted then + AsmWrite(''''); + if i>counter then + AsmWrite(','); + quoted:=false; + AsmWrite(tostr(ord(tai_string(hp).str[i]))); + end; + end; { end for i:=0 to... } + if quoted then AsmWrite(''''); + AsmLn; + counter := counter+line_length; + end; { end for j:=0 ... } + + { do last line of lines } + if counter < tai_string(hp).len then + AsmWrite(#9'dc.b'#9); + quoted:=false; + for i:=counter to tai_string(hp).len-1 do + begin + { it is an ascii character. } + if (ord(tai_string(hp).str[i])>31) and + (ord(tai_string(hp).str[i])<128) and + (tai_string(hp).str[i]<>'''') and + (tai_string(hp).str[i]<>'\') then + begin + if not(quoted) then + begin + if i>counter then + AsmWrite(','); + AsmWrite(''''); + end; + AsmWrite(tai_string(hp).str[i]); + quoted:=true; + end { if > 31 and < 128 and " } + else + begin + if quoted then + AsmWrite(''''); + if i>counter then + AsmWrite(','); + quoted:=false; + AsmWrite(tostr(ord(tai_string(hp).str[i]))); + end; + end; { end for i:=0 to... } + if quoted then + AsmWrite(''''); + end; + AsmLn; + end; + ait_label: + begin + if tai_label(hp).labsym.is_used then + begin + s:= tai_label(hp).labsym.name; + if s[1] = '@' then + begin + ReplaceForbiddenChars(s); + //Local labels: + AsmWriteLn(s+':') + end + else + begin + //Procedure entry points: + if not macos_direct_globals then + begin + WriteDataHeader(s, tai_label(hp).is_global, true); + end + else + begin + ReplaceForbiddenChars(s); + AsmWrite(#9'csect'#9); AsmWrite(s); + AsmWriteLn('[TC]'); + + AsmWriteLn(PadTabs(s+':',#0)); + end; + end; + end; + end; + ait_symbol: + begin + if tai_symbol(hp).sym.typ=AT_FUNCTION then + WriteProcedureHeader(hp) + else if tai_symbol(hp).sym.typ=AT_DATA then + begin + s:= tai_symbol(hp).sym.name; + WriteDataHeader(s, tai_symbol(hp).is_global, true); + if macos_direct_globals then + begin + AsmWrite(s); + AsmWriteLn(':'); + end; + end + else + InternalError(2003071301); + end; + ait_symbol_end: + ; + ait_instruction: + WriteInstruction(hp); + ait_stab, + ait_force_line, + ait_function_name : ; + ait_cutobject : + begin + InternalError(2004101101); {Smart linking is done transparently by the MPW linker.} + end; + ait_marker : + begin + if tai_marker(hp).kind=mark_NoLineInfoStart then + inc(InlineLevel) + else if tai_marker(hp).kind=mark_NoLineInfoEnd then + dec(InlineLevel); + end; + else + internalerror(2002110303); + end; + hp:=tai(hp.next); + end; + end; + + var + currentasmlist : TExternalAssembler; + + procedure writeexternal(p:tasmsymbol); + + var + s:string; + replaced: boolean; + + begin + if tasmsymbol(p).bind=AB_EXTERNAL then + begin + //Writeln('ZZZ ',p.name,' ',p.classname,' ',Ord(tasmsymbol(p).typ)); + s:= p.name; + replaced:= ReplaceForbiddenChars(s); + + with currentasmlist do + case tasmsymbol(p).typ of + AT_FUNCTION: + begin + AsmWrite(#9'import'#9'.'); + AsmWrite(s); + if use_PR then + AsmWrite('[PR]'); + + if replaced then + begin + AsmWrite(' <= ''.'); + AsmWrite(p.name); + if use_PR then + AsmWrite('[PR]''') + else + AsmWrite(''''); + end; + AsmLn; + + AsmWrite(#9'import'#9); + AsmWrite(s); + AsmWrite('[DS]'); + if replaced then + begin + AsmWrite(' <= '''); + AsmWrite(p.name); + AsmWrite('[DS]'''); + end; + AsmLn; + + AsmWriteLn(#9'toc'); + + AsmWrite(#9'tc'#9); + AsmWrite(s); + AsmWrite('[TC],'); + AsmWrite(s); + AsmWriteLn('[DS]'); + end; + AT_DATA: + begin + AsmWrite(#9'import'#9); + AsmWrite(s); + AsmWrite(var_storage_class); + if replaced then + begin + AsmWrite(' <= '''); + AsmWrite(p.name); + AsmWrite(''''); + end; + AsmLn; + + AsmWriteLn(#9'toc'); + AsmWrite(#9'tc'#9); + AsmWrite(s); + AsmWrite('[TC],'); + AsmWrite(s); + AsmWriteLn(var_storage_class); + end + else + InternalError(2003090901); + end; + end; + end; + + procedure TPPCMPWAssembler.WriteExternals; + var + i : longint; + begin + currentasmlist:=self; +// current_asmdata.asmsymboldict.foreach_static(@writeexternal,nil); + for i:=0 to current_asmdata.AsmSymbolDict.Count-1 do + begin + writeexternal(tasmsymbol(current_asmdata.AsmSymbolDict[i])); + end; + end; + + + function TPPCMPWAssembler.DoAssemble : boolean; + begin + DoAssemble:=Inherited DoAssemble; + end; + + procedure TPPCMPWAssembler.WriteAsmFileHeader; + + begin + AsmWriteLn(#9'string asis'); {Interpret strings just to be the content between the quotes.} + AsmWriteLn(#9'aligning off'); {We do our own aligning.} + AsmLn; + end; + + procedure TPPCMPWAssembler.WriteAsmList; + var + hal : tasmlisttype; + begin +{$ifdef EXTDEBUG} + if assigned(current_module.mainsource) then + comment(v_info,'Start writing MPW-styled assembler output for '+current_module.mainsource^); +{$endif} + + WriteAsmFileHeader; + WriteExternals; + + for hal:=low(TasmlistType) to high(TasmlistType) do + begin + AsmWriteLn(target_asm.comment+'Begin asmlist '+AsmListTypeStr[hal]); + writetree(current_asmdata.asmlists[hal]); + AsmWriteLn(target_asm.comment+'End asmlist '+AsmListTypeStr[hal]); + end; + + AsmWriteLn(#9'end'); + AsmLn; + +{$ifdef EXTDEBUG} + if assigned(current_module.mainsource) then + comment(v_info,'Done writing MPW-styled assembler output for '+current_module.mainsource^); +{$endif EXTDEBUG} + end; + +{***************************************************************************** + Initialize +*****************************************************************************} + + const + as_powerpc_mpw_info : tasminfo = + ( + id : as_powerpc_mpw; + idtxt : 'MPW'; + asmbin : 'PPCAsm'; + asmcmd : '-case on $ASM -o $OBJ'; + supported_targets : [system_powerpc_macos]; + flags : [af_allowdirect,af_needar,af_smartlink_sections,af_labelprefix_only_inside_procedure]; + labelprefix : '@'; + comment : '; '; + ); + +initialization + RegisterAssembler(as_powerpc_mpw_info,TPPCMPWAssembler); +end. diff --git a/closures/compiler/powerpc/agppcvasm.pas b/closures/compiler/powerpc/agppcvasm.pas new file mode 100644 index 0000000000..e24b8fbfd6 --- /dev/null +++ b/closures/compiler/powerpc/agppcvasm.pas @@ -0,0 +1,406 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit is the VASM writer for PowerPC + + 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. + + **************************************************************************** +} + +{****************************************************************************} +{ Helper routines for Instruction Writer } +{****************************************************************************} + +unit agppcvasm; + +{$i fpcdefs.inc} + + interface + + uses + aasmbase, + aasmtai,aasmdata, + aggas, + cpubase,cgutils, + globtype; + + type + TPPCInstrWriter=class(TCPUInstrWriter) + procedure WriteInstruction(hp : tai);override; + end; + + TPPCVASM=class(TGNUassembler) + constructor create(smart: boolean); override; + function MakeCmdLine: TCmdStr; override; + end; + + topstr = string[4]; + + function getreferencestring(var ref : treference) : string; + function getopstr_jmp(const o:toper) : string; + function getopstr(const o:toper) : string; + function branchmode(o: tasmop): topstr; + function cond2str(op: tasmop; c: tasmcond): string; + + implementation + + uses + cutils,cfileutl,globals,verbose, + cgbase,systems, + assemble,script, + itcpugas,cpuinfo, + aasmcpu; + +{$ifdef cpu64bitaddr} + const + refaddr2str: array[trefaddr] of string[9] = ('', '', '', '', '@l', '@h', '@higher', '@highest', '@ha', '@highera', '@highesta'); + verbose_refaddrs = [addr_low, addr_high, addr_higher, addr_highest, addr_higha, addr_highera, addr_highesta]; + refaddr2str_darwin: array[trefaddr] of string[4] = ('','','','','lo16', 'hi16', '@err', '@err', 'ha16', '@err', '@err'); +{$else cpu64bitaddr} + const + refaddr2str: array[trefaddr] of string[3] = ('','','','','@l','@h','@ha'); + refaddr2str_darwin: array[trefaddr] of string[4] = ('','','','','lo16','hi16','ha16'); + verbose_refaddrs = [addr_low,addr_high,addr_higha]; +{$endif cpu64bitaddr} + + + function getreferencestring(var ref : treference) : string; + var + s : string; + begin + with ref do + begin + if ((offset < -32768) or (offset > 32767)) and + (refaddr = addr_no) then + internalerror(2006052501); + if (refaddr = addr_no) then + s := '' + else + begin + if target_info.system in [system_powerpc_darwin,system_powerpc64_darwin] then + s := refaddr2str_darwin[refaddr] + else + s :=''; + s := s+'('; + if assigned(symbol) then + begin + s:=s+symbol.name; + if assigned(relsymbol) then + s:=s+'-'+relsymbol.name; + end; + end; + if offset<0 then + s:=s+tostr(offset) + else + if (offset>0) then + begin + if assigned(symbol) then + s:=s+'+'+tostr(offset) + else + s:=s+tostr(offset); + end; + + if (refaddr in verbose_refaddrs) then + begin + s := s+')'; + if not(target_info.system in [system_powerpc_darwin,system_powerpc64_darwin]) then + s := s+refaddr2str[refaddr]; + end; +{$ifdef cpu64bitaddr} + if (refaddr = addr_pic) then + if (target_info.system <> system_powerpc64_linux) then + s := s + ')' + else + s := s + ')@got'; +{$endif cpu64bitaddr} + + if (index=NR_NO) then + begin + if offset=0 then + begin + if not (assigned(symbol)) then + s:=s+'0'; + end; + if (base<>NR_NO) then + s:=s+'('+gas_regname(base)+')' + else if not assigned(symbol) and + not(refaddr in verbose_refaddrs) then + s:=s+'(0)'; + end + else if (index<>NR_NO) and (base<>NR_NO) then + begin + if (offset=0) then + s:=s+gas_regname(base)+','+gas_regname(index) + else + internalerror(2006052502); + end; + end; + getreferencestring:=s; + end; + + + function getopstr_jmp(const o:toper) : string; + var + hs : string; + begin + case o.typ of + top_reg : + getopstr_jmp:=gas_regname(o.reg); + { no top_ref jumping for powerpc } + top_const : + getopstr_jmp:=tostr(o.val); + top_ref : + begin + if o.ref^.refaddr<>addr_full then + internalerror(200402262); + 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_jmp:=hs; + end; + top_none: + getopstr_jmp:=''; + else + internalerror(2002070603); + end; + end; + + + function getopstr(const o:toper) : string; + var + hs : string; + begin + case o.typ of + top_reg: + getopstr:=gas_regname(o.reg); + top_const: + getopstr:=tostr(longint(o.val)); + 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; + + + function branchmode(o: tasmop): topstr; + var tempstr: topstr; + begin + tempstr := ''; + case o of + A_BCCTR,A_BCCTRL: tempstr := 'ctr'; + A_BCLR,A_BCLRL: tempstr := 'lr'; + end; + case o of + A_BL,A_BLA,A_BCL,A_BCLA,A_BCCTRL,A_BCLRL: tempstr := tempstr+'l'; + end; + case o of + A_BA,A_BLA,A_BCA,A_BCLA: tempstr:=tempstr+'a'; + end; + branchmode := tempstr; + end; + + + function cond2str(op: tasmop; c: tasmcond): string; + { note: no checking is performed whether the given combination of } + { conditions is valid } + var + tempstr: string; + begin + tempstr:=#9; + case c.simple of + false: + begin + cond2str := tempstr+gas_op2str[op]; + case c.dirhint of + DH_None:; + DH_Minus: + cond2str:=cond2str+'-'; + DH_Plus: + cond2str:=cond2str+'+'; + else + internalerror(2003112901); + end; + cond2str:=cond2str+#9+tostr(c.bo)+','+tostr(c.bi); + end; + true: + if (op >= A_B) and (op <= A_BCLRL) then + case c.cond of + { unconditional branch } + C_NONE: + cond2str := tempstr+gas_op2str[op]; + { bdnzt etc } + else + begin + tempstr := tempstr+'b'+asmcondflag2str[c.cond]+ + branchmode(op); + case c.dirhint of + DH_None: + tempstr:=tempstr+#9; + DH_Minus: + tempstr:=tempstr+('-'+#9); + DH_Plus: + tempstr:=tempstr+('+'+#9); + else + internalerror(2003112901); + end; + case c.cond of + C_LT..C_NU: + cond2str := tempstr+gas_regname(newreg(R_SPECIALREGISTER,c.cr,R_SUBWHOLE)); + C_T,C_F,C_DNZT,C_DNZF,C_DZT,C_DZF: + cond2str := tempstr+tostr(c.crbit); + else + cond2str := tempstr; + end; + end; + end + { we have a trap instruction } + else + begin + internalerror(2002070601); + { not yet implemented !!!!!!!!!!!!!!!!!!!!! } + { case tempstr := 'tw';} + end; + end; + end; + + +{****************************************************************************} +{ PowerPC Instruction Writer } +{****************************************************************************} + + Procedure TPPCInstrWriter.WriteInstruction(hp : tai); + var op: TAsmOp; + s: string; + i: byte; + sep: string[3]; + begin + op:=taicpu(hp).opcode; + if is_calljmp(op) then + begin + { direct BO/BI in op[0] and op[1] not supported, put them in condition! } + case op of + A_B,A_BA,A_BL,A_BLA: + s:=#9+gas_op2str[op]+#9; + A_BCTR,A_BCTRL,A_BLR,A_BLRL: + s:=#9+gas_op2str[op] + else + begin + s:=cond2str(op,taicpu(hp).condition); + if (s[length(s)] <> #9) and + (taicpu(hp).ops>0) then + s := s + ','; + end; + end; + + if (taicpu(hp).ops>0) and (taicpu(hp).oper[0]^.typ<>top_none) then + begin + { first write the current contents of s, because the symbol } + { may be 255 characters } + owner.asmwrite(s); + s:=getopstr_jmp(taicpu(hp).oper[0]^); + end; + end + else + { process operands } + begin + s:=#9+gas_op2str[op]; + if taicpu(hp).ops<>0 then + begin + { + if not is_calljmp(op) then + sep:=',' + else + } + sep:=#9; + for i:=0 to taicpu(hp).ops-1 do + begin + // debug code + // writeln(s); + // writeln(taicpu(hp).fileinfo.line); + s:=s+sep+getopstr(taicpu(hp).oper[i]^); + sep:=','; + end; + end; + end; + owner.AsmWriteLn(s); + end; + + +{****************************************************************************} +{ GNU PPC Assembler writer } +{****************************************************************************} + + + constructor TPPCVASM.create(smart: boolean); + begin + inherited create(smart); + InstrWriter := TPPCInstrWriter.create(self); + end; + + function TPPCVASM.MakeCmdLine: TCmdStr; + begin + result:=target_asm.asmcmd; + + if (cs_link_on_target in current_settings.globalswitches) then + begin + Replace(result,'$ASM',maybequoted(ScriptFixFileName(AsmFileName))); + Replace(result,'$OBJ',maybequoted(ScriptFixFileName(ObjFileName))); + end + else + begin + Replace(result,'$ASM',maybequoted(Unix2AmigaPath(AsmFileName))); + Replace(result,'$OBJ',maybequoted(Unix2AmigaPath(ObjFileName))); + end; + end; + + + +{***************************************************************************** + Initialize +*****************************************************************************} + + const + as_powerpc_vasm_info : tasminfo = + ( + id : as_powerpc_vasm; + + idtxt : 'VASM'; + asmbin : 'fpcvasm'; + asmcmd: '-quiet -Felf -o $OBJ $ASM'; + supported_targets : [system_powerpc_morphos]; + flags : [af_allowdirect,af_needar,af_smartlink_sections]; + labelprefix : '.L'; + comment : '# '; + ); + +begin + RegisterAssembler(as_powerpc_vasm_info,TPPCVASM); +end. diff --git a/closures/compiler/powerpc/aoptcpu.pas b/closures/compiler/powerpc/aoptcpu.pas new file mode 100644 index 0000000000..cacde466d2 --- /dev/null +++ b/closures/compiler/powerpc/aoptcpu.pas @@ -0,0 +1,535 @@ +{ + Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal + Development Team + + This unit implements the PowerPC 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 + +{$i fpcdefs.inc} + +uses cpubase, aoptobj, aoptcpub, aopt, aasmtai,aasmdata, aasmcpu; + +Type + TCpuAsmOptimizer = class(TAsmOptimizer) + { uses the same constructor as TAopObj } + function PeepHoleOptPass1Cpu(var p: tai): boolean; override; + + function PostPeepHoleOptsCpu(var p: tai): boolean; override; + + private + function cmpi_mfcr_opt(p, next1, next2: taicpu): boolean; + End; + +Implementation + + uses + cutils, cgbase, cgcpu, cgobj; + +const + calculation_target_op0: array[tasmop] of tasmop = (a_none, + a_add, a_add_, a_addo, a_addo_, a_addc, a_addc_, a_addco, a_addco_, + a_adde, a_adde_, a_addeo, a_addeo_, a_addi, a_addic, a_addic_, a_addis, + a_addme, a_addme_, a_addmeo, a_addmeo_, a_addze, a_addze_, a_addzeo, + a_addzeo_, a_and, a_and_, a_andc, a_andc_, a_andi_, a_andis_, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_cntlzw, a_cntlzw_, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_divw, a_divw_, a_divwo, a_divwo_, + a_divwu, a_divwu_, a_divwuo, a_divwuo_, a_none, a_none, a_none, a_eqv, + a_eqv_, a_extsb, a_extsb_, a_extsh, a_extsh_, a_fabs, a_fabs_, a_fadd, + a_fadd_, a_fadds, a_fadds_, a_none, a_none, + a_fctid, a_fctid_, a_fctidz, a_fctidz_, + a_fctiw, a_fctiw_, a_fctiwz, a_fctiwz_, + a_fdiv, a_fdiv_, a_fdivs, a_fdivs_, a_fmadd, a_fmadd_, a_fmadds, + a_fmadds_, a_none, a_fmsub, a_fmsub_, a_fmsubs, a_fmsubs_, a_fmul, a_fmul_, + a_fmuls, a_fmuls_, a_fnabs, a_fnabs_, a_fneg, a_fneg_, a_fnmadd, + a_fnmadd_, a_fnmadds, a_fnmadds_, a_fnmsub, a_fnmsub_, a_fnmsubs, + a_fnmsubs_, a_fres, a_fres_, a_frsp, a_frsp_, a_frsqrte, a_frsqrte_, + a_none, a_none, a_fsqrt, a_fsqrt_, a_fsqrts, a_fsqrts_, a_fsub, a_fsub_, + a_fsubs, a_fsubs_, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_mulhw, + a_mulhw_, a_mulhwu, a_mulhwu_, a_mulli, a_mullw, a_mullw_, a_mullwo, + a_mullwo_, a_nand, a_nand_, a_neg, a_neg_, a_nego, a_nego_, a_nor, a_nor_, + a_or, a_or_, a_orc, a_orc_, a_ori, a_oris, a_rfi, a_rlwimi, a_rlwimi_, + a_rlwinm, a_rlwinm_, a_rlwnm, a_rlwnm_, a_none, a_slw, a_slw_, a_sraw, a_sraw_, + a_srawi, a_srawi_,a_srw, a_srw_, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_subf, a_subf_, a_subfo, + a_subfo_, a_subfc, a_subfc_, a_subfco, a_subfco_, a_subfe, a_subfe_, + a_subfeo, a_subfeo_, a_subfic, a_subfme, a_subfme_, a_subfmeo, a_subfmeo_, + a_subfze, a_subfze_, a_subfzeo, a_subfzeo_, a_none, a_none, a_none, + a_none, a_none, a_none, a_xor, a_xor_, a_xori, a_xoris, + { simplified mnemonics } + a_subi, a_subis, a_subic, a_subic_, a_sub, a_sub_, a_subo, a_subo_, + a_subc, a_subc_, a_subco, a_subco_, a_none, a_none, a_none, a_none, + a_extlwi, a_extlwi_, a_extrwi, a_extrwi_, a_inslwi, a_inslwi_, a_insrwi, + a_insrwi_, a_rotlwi, a_rotlwi_, a_rotlw, a_rotlw_, a_slwi, a_slwi_, + a_srwi, a_srwi_, a_clrlwi, a_clrlwi_, a_clrrwi, a_clrrwi_, a_clrslwi, + a_clrslwi_, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none {move to special prupose reg}, a_none {move from special purpose reg}, + a_none, a_none, a_none, a_none, a_none, a_none, a_not, a_not_, a_none, a_none, a_none, + a_none, a_none, a_none, a_none); + + function TCpuAsmOptimizer.cmpi_mfcr_opt(p, next1, next2: taicpu): boolean; + var + next3, prev: tai; + inverse, prevrlwinm: boolean; + begin + result := true; + inverse := + getnextinstruction(next2,next3) and + (next3.typ = ait_instruction) and + (taicpu(next3).opcode = A_XORI) and + (taicpu(next3).oper[0]^.reg = taicpu(next3).oper[1]^.reg) and + (taicpu(next3).oper[0]^.reg = taicpu(next2).oper[0]^.reg) and + (taicpu(next3).oper[2]^.val = 1); + case taicpu(next2).oper[2]^.val of + 1: + begin + // less than zero or greater/equal than zero (the xori remains in + // in the latter case). Doesn't make sense for unsigned comparisons. + if (p.opcode = A_CMPWI) then + begin + p.opcode := A_SRWI; + p.ops := 3; + p.loadreg(1,p.oper[0]^.reg); + p.loadreg(0,next1.oper[0]^.reg); + p.loadconst(2,31); + asml.remove(next1); + next1.free; + asml.remove(next2); + next2.free; + end + else + result := false; + end; +{ + needs two registers to work with + 2: + begin + // greater or less/equal to zero + end; +} + 3: + begin + prevrlwinm := + getlastinstruction(p,prev) and + (prev.typ = ait_instruction) and + ((taicpu(prev).opcode = A_RLWINM) or + (taicpu(prev).opcode = A_RLWINM_)) and + (taicpu(prev).oper[0]^.reg = p.oper[0]^.reg) and + (taicpu(prev).oper[3]^.val = taicpu(prev).oper[4]^.val); + + if (prevrlwinm) then + begin + // isolate the bit we need + if (taicpu(prev).oper[3]^.val <> 31) then + begin + p.opcode := A_RLWINM; + p.ops := 5; + p.loadreg(1,p.oper[0]^.reg); + p.loadreg(0,next1.oper[0]^.reg); + p.loadconst(2,taicpu(prev).oper[3]^.val + 1); + p.loadconst(3,31); + p.loadconst(4,31); + end + else { if (taicpu(prev).oper[0]^.reg <> next1.oper[0]^.reg) then } + begin + p.opcode := A_MR; + p.loadreg(1,p.oper[0]^.reg); + p.loadreg(0,next1.oper[0]^.reg); + end; + if not inverse then + begin + next1.ops := 3; + next1.opcode := A_XORI; + next1.loadreg(1,next1.oper[0]^.reg); + next1.loadconst(2,1); + end + else + begin + asml.remove(next1); + next1.free; + asml.remove(next3); + next3.free; + end; + asml.remove(next2); + next2.free; + end + else + begin + // equal/not equal to zero (the xori remains in the latter case; + // there's a more optimal sequence without it, but needs extra + // register) + p.opcode := A_CNTLZW; + p.loadreg(1,p.oper[0]^.reg); + p.loadreg(0,next1.oper[0]^.reg); + next1.ops := 3; + next1.opcode := A_SRWI; + next1.loadreg(1,next1.oper[0]^.reg); + next1.loadconst(2,5); + asml.remove(next2); + next2.free; + end; + end; + else + result := false; + end; + end; + + + function rlwinm2mask(l1,l2: longint): longint; + begin + // 1 shl 32 = 1 instead of 0 on x86 + if (l1 <> 0) then + result := longint(cardinal(1) shl (32 - l1) - 1) xor (cardinal(1) shl (31 - l2) - 1) + else + result := longint(not(cardinal(1) shl (31 - l2) - 1)); + if (l1 > l2) then + result := not(result); + end; + + + function TCpuAsmOptimizer.PeepHoleOptPass1Cpu(var p: tai): boolean; + var + next1, next2: tai; + l1, l2, shlcount: longint; + begin + result := false; + case p.typ of + ait_instruction: + begin + case taicpu(p).opcode of + A_CMPWI, + A_CMPLWI: + begin + if (taicpu(p).oper[1]^.typ = top_const) and + (taicpu(p).oper[1]^.val = 0) and + getnextinstruction(p,next1) and + (next1.typ = ait_instruction) and + (taicpu(next1).opcode = A_MFCR) and + getnextinstruction(next1,next2) and + (taicpu(next2).opcode = A_RLWINM) and + (taicpu(next2).oper[0]^.reg = taicpu(next2).oper[1]^.reg) and + (taicpu(next2).oper[0]^.reg = taicpu(next1).oper[0]^.reg) and + (taicpu(next2).oper[3]^.val = 31) and + (taicpu(next2).oper[4]^.val = 31) and + cmpi_mfcr_opt(taicpu(p),taicpu(next1),taicpu(next2)) then + result := true; + end; +{ seems the register allocator doesn't generate superfluous fmr's } +{ A_FMR, } + A_MR: + begin + if getnextinstruction(p,next1) and + (next1.typ = ait_instruction) and + (calculation_target_op0[taicpu(next1).opcode] <> a_none) and + (taicpu(next1).oper[0]^.reg = taicpu(p).oper[0]^.reg) then + begin + for l1 := 1 to taicpu(next1).ops - 1 do + if (taicpu(next1).oper[l1]^.typ = top_reg) and + (taicpu(next1).oper[l1]^.reg = taicpu(p).oper[0]^.reg) then + taicpu(next1).loadreg(l1,taicpu(p).oper[1]^.reg); + asml.remove(p); + p.free; + p := next1; + result := true; + end; + end; + A_SLWI: + begin + if getnextinstruction(p,next1) and + (next1.typ = ait_instruction) and + ((taicpu(next1).opcode = A_RLWINM) or + (taicpu(next1).opcode = A_SLWI) or + (taicpu(next1).opcode = A_SRWI)) and + (taicpu(next1).oper[0]^.reg = taicpu(p).oper[0]^.reg) and + (taicpu(next1).oper[1]^.reg = taicpu(p).oper[0]^.reg) then + begin + { convert slwi to rlwinm and see if the rlwinm } + { optimization can do something with it } + taicpu(p).opcode := A_RLWINM; + taicpu(p).ops := 5; + taicpu(p).loadconst(2,taicpu(p).oper[2]^.val); + taicpu(p).loadconst(3,0); + taicpu(p).loadconst(4,31-taicpu(p).oper[2]^.val); + result := true; + end; + end; + A_SRWI: + begin + if getnextinstruction(p,next1) and + (next1.typ = ait_instruction) and + ((taicpu(next1).opcode = A_SLWI) or + (taicpu(next1).opcode = A_RLWINM) or + (taicpu(next1).opcode = A_SRWI)) and + (taicpu(next1).oper[0]^.reg = taicpu(p).oper[0]^.reg) and + (taicpu(next1).oper[1]^.reg = taicpu(p).oper[0]^.reg) then + case taicpu(next1).opcode of + A_SLWI: + begin + taicpu(p).opcode := A_RLWINM; + taicpu(p).ops := 5; + taicpu(p).loadconst(2,taicpu(next1).oper[2]^.val-taicpu(p).oper[2]^.val); + if (taicpu(p).oper[2]^.val < 0) then + begin + taicpu(p).loadconst(3,-taicpu(p).oper[2]^.val); + taicpu(p).loadconst(4,31-taicpu(next1).oper[2]^.val); + inc(taicpu(p).oper[2]^.val,32); + end + else + begin + taicpu(p).loadconst(3,0); + taicpu(p).loadconst(4,31-taicpu(next1).oper[2]^.val); + end; + asml.remove(next1); + next1.free; + result := true; + end; + A_RLWINM: + begin + { convert srwi to rlwinm and see if the rlwinm } + { optimization can do something with it } + taicpu(p).opcode := A_RLWINM; + taicpu(p).ops := 5; + taicpu(p).loadconst(3,taicpu(p).oper[2]^.val); + taicpu(p).loadconst(4,31); + taicpu(p).loadconst(2,(32-taicpu(p).oper[2]^.val) and 31); + result := true; + end; + end; + end; + A_RLWINM: + begin + if getnextinstruction(p,next1) and + (next1.typ = ait_instruction) and + ((taicpu(next1).opcode = A_RLWINM) or + (taicpu(next1).opcode = A_SRWI) or + (taicpu(next1).opcode = A_SLWI)) and + (taicpu(next1).oper[0]^.reg = taicpu(p).oper[0]^.reg) and + // both source and target of next1 must equal target of p + (taicpu(next1).oper[1]^.reg = taicpu(p).oper[0]^.reg) then + begin + case taicpu(next1).opcode of + A_RLWINM: + begin + shlcount := taicpu(next1).oper[2]^.val; + l2 := rlwinm2mask(taicpu(next1).oper[3]^.val,taicpu(next1).oper[4]^.val); + end; + A_SLWI: + begin + shlcount := taicpu(next1).oper[2]^.val; + l2 := (-1) shl shlcount; + end; + A_SRWI: + begin + shlcount := 32-taicpu(next1).oper[2]^.val; + l2 := (-1) shr taicpu(next1).oper[2]^.val; + end; + end; + l1 := rlwinm2mask((taicpu(p).oper[3]^.val-shlcount) and 31,(taicpu(p).oper[4]^.val-shlcount) and 31); + l1 := l1 and l2; + case l1 of + -1: + begin + taicpu(p).oper[2]^.val := (taicpu(p).oper[2]^.val + shlcount) and 31; + asml.remove(next1); + next1.free; + if (taicpu(p).oper[2]^.val = 0) then + begin + next1 := tai(p.next); + asml.remove(p); + p.free; + p := next1; + result := true; + end; + end; + 0: + begin + // masks have no bits in common + taicpu(p).opcode := A_LI; + taicpu(p).loadconst(1,0); + taicpu(p).freeop(2); + taicpu(p).freeop(3); + taicpu(p).freeop(4); + taicpu(p).ops := 2; + taicpu(p).opercnt := 2; + asml.remove(next1); + next1.free; + result := true; + end + else if tcgppc(cg).get_rlwi_const(l1,l1,l2) then + begin + taicpu(p).oper[2]^.val := (taicpu(p).oper[2]^.val + shlcount) and 31; + taicpu(p).oper[3]^.val := l1; + taicpu(p).oper[4]^.val := l2; + asml.remove(next1); + next1.free; + result := true; + end; + end; + end; + end; + end; + end; + end; + end; + + + const + modifyflags: array[tasmop] of tasmop = + (a_none, a_add_, a_add_, a_addo_, a_addo_, a_addc_, a_addc_, a_addco_, a_addco_, + a_adde_, a_adde_, a_addeo_, a_addeo_, {a_addi could be addic_ if sure doesn't disturb carry} a_none, a_addic_, a_addic_, a_none, + a_addme_, a_addme_, a_addmeo_, a_addmeo_, a_addze_, a_addze_, a_addzeo_, + a_addzeo_, a_and_, a_and_, a_andc_, a_andc_, a_andi_, a_andis_, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_cntlzw_, a_cntlzw_, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_divw_, a_divw_, a_divwo_, a_divwo_, + a_divwu_, a_divwu_, a_divwuo_, a_divwuo_, a_none, a_none, a_none, a_eqv_, + a_eqv_, a_extsb_, a_extsb_, a_extsh_, a_extsh_, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_mffs, a_mffs_, a_mfmsr, a_mfspr, a_mfsr, + a_mfsrin, a_mftb, a_mtcrf, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_mulhw_, + a_mulhw_, a_mulhwu_, a_mulhwu_, a_none, a_mullw_, a_mullw_, a_mullwo_, + a_mullwo_, a_nand_, a_nand_, a_neg_, a_neg_, a_nego_, a_nego_, a_nor_, a_nor_, + a_or_, a_or_, a_orc_, a_orc_, a_none, a_none, a_none, a_rlwimi_, a_rlwimi_, + a_rlwinm_, a_rlwinm_, a_rlwnm_, a_rlwnm_, a_none, a_slw_, a_slw_, a_sraw_, a_sraw_, + a_srawi_, a_srawi_,a_srw_, a_srw_, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none, a_none, a_none, a_none, a_subf_, a_subf_, a_subfo_, + a_subfo_, a_subfc_, a_subfc_, a_subfco_, a_subfco_, a_subfe_, a_subfe_, + a_subfeo_, a_subfeo_, a_none, a_subfme_, a_subfme_, a_subfmeo_, a_subfmeo_, + a_subfze_, a_subfze_, a_subfzeo_, a_subfzeo_, a_none, a_none, a_none, + a_none, a_none, a_none, a_xor_, a_xor_, a_none, a_none, + { simplified mnemonics } + a_none, a_none, a_subic_, a_subic_, a_sub_, a_sub_, a_subo_, a_subo_, + a_subc_, a_subc_, a_subco_, a_subco_, a_none, a_none, a_none, a_none, + a_extlwi_, a_extlwi_, a_extrwi_, a_extrwi_, a_inslwi_, a_inslwi_, a_insrwi_, + a_insrwi_, a_rotlwi_, a_rotlwi_, a_rotlw_, a_rotlw_, a_slwi_, a_slwi_, + a_srwi_, a_srwi_, a_clrlwi_, a_clrlwi_, a_clrrwi_, a_clrrwi_, a_clrslwi_, + a_clrslwi_, a_none, a_none, a_none, a_none, a_none, a_none, a_none, + a_none, a_none {move to special prupose reg}, a_none {move from special purpose reg}, + a_none, a_none, a_none, a_none, a_mr_, a_mr_, a_not_, a_not_, a_none, a_none, a_none, + a_none, a_none, a_none, a_none); + + function changetomodifyflags(p: taicpu): boolean; + begin + result := false; + if (modifyflags[p.opcode] <> a_none) then + begin + p.opcode := modifyflags[p.opcode]; + result := true; + end; + end; + + function TCpuAsmOptimizer.PostPeepHoleOptsCpu(var p: tai): boolean; + var + next1: tai; + begin + result := false; + case p.typ of + ait_instruction: + begin + case taicpu(p).opcode of + A_RLWINM_: + begin + // rlwinm_ is cracked on the G5, andi_/andis_ aren't + if (taicpu(p).oper[2]^.val = 0) then + if (taicpu(p).oper[3]^.val < 16) and + (taicpu(p).oper[4]^.val < 16) then + begin + taicpu(p).opcode := A_ANDIS_; + taicpu(p).oper[2]^.val := word( + ((1 shl (16-taicpu(p).oper[3]^.val)) - 1) xor + ((1 shl (15-taicpu(p).oper[4]^.val)) - 1)); + taicpu(p).freeop(3); + taicpu(p).freeop(4); + taicpu(p).ops := 3; + taicpu(p).opercnt := 3; + end + else if (taicpu(p).oper[3]^.val >= 16) and + (taicpu(p).oper[4]^.val >= 16) then + begin + taicpu(p).opcode := A_ANDI_; + taicpu(p).oper[2]^.val := word(rlwinm2mask(taicpu(p).oper[3]^.val,taicpu(p).oper[4]^.val)); + taicpu(p).freeop(3); + taicpu(p).freeop(4); + taicpu(p).ops := 3; + taicpu(p).opercnt := 3; + end; + end; + end; + + // change "integer operation with destination reg" followed by a + // comparison to zero of that reg, with a variant of that integer + // operation which sets the flags (if it exists) + if not(result) and + (taicpu(p).ops >= 2) and + (taicpu(p).oper[0]^.typ = top_reg) and + (taicpu(p).oper[1]^.typ = top_reg) and + getnextinstruction(p,next1) and + (next1.typ = ait_instruction) and + (taicpu(next1).opcode = A_CMPWI) and + // make sure it the result goes to cr0 + (((taicpu(next1).ops = 2) and + (taicpu(next1).oper[1]^.val = 0) and + (taicpu(next1).oper[0]^.reg = taicpu(p).oper[0]^.reg)) or + ((taicpu(next1).ops = 3) and + (taicpu(next1).oper[2]^.val = 0) and + (taicpu(next1).oper[0]^.typ = top_reg) and + (getsupreg(taicpu(next1).oper[0]^.reg) = RS_CR0) and + (taicpu(next1).oper[1]^.reg = taicpu(p).oper[0]^.reg))) and + changetomodifyflags(taicpu(p)) then + begin + asml.remove(next1); + next1.free; + result := true; + end; + end; + end; + end; + +begin + casmoptimizer:=TCpuAsmOptimizer; +End. diff --git a/closures/compiler/powerpc/aoptcpub.pas b/closures/compiler/powerpc/aoptcpub.pas new file mode 100644 index 0000000000..26507ec19d --- /dev/null +++ b/closures/compiler/powerpc/aoptcpub.pas @@ -0,0 +1,121 @@ + { + 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 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 } + +{$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 + aasmcpu,AOptBase, cpubase; + +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 = 5; + +{Oper index of operand that contains the source (reference) with a load } +{instruction } + + LoadSrc = 1; + +{Oper index of operand that contains the destination (register) with a load } +{instruction } + + LoadDst = 0; + +{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_BC; + +Implementation + +{ ************************************************************************* } +{ **************************** TCondRegs ********************************** } +{ ************************************************************************* } +Constructor TCondRegs.init; +Begin +End; + +Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl} +Begin +End; + +End. diff --git a/closures/compiler/powerpc/aoptcpuc.pas b/closures/compiler/powerpc/aoptcpuc.pas new file mode 100644 index 0000000000..4b82e87f4a --- /dev/null +++ b/closures/compiler/powerpc/aoptcpuc.pas @@ -0,0 +1,40 @@ + { + 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 + +{$i fpcdefs.inc} + +Uses + AOptCs; + +Type + TRegInfoCpu = Object(TRegInfo) + End; + + +Implementation + +End. diff --git a/closures/compiler/powerpc/aoptcpud.pas b/closures/compiler/powerpc/aoptcpud.pas new file mode 100644 index 0000000000..2df7e2e49e --- /dev/null +++ b/closures/compiler/powerpc/aoptcpud.pas @@ -0,0 +1,40 @@ +{ + 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. diff --git a/closures/compiler/powerpc/cgcpu.pas b/closures/compiler/powerpc/cgcpu.pas new file mode 100644 index 0000000000..fd8fe8976a --- /dev/null +++ b/closures/compiler/powerpc/cgcpu.pas @@ -0,0 +1,1820 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements the code generator for the PowerPC + + 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,cgobj,cgppc, + aasmbase,aasmcpu,aasmtai,aasmdata, + cpubase,cpuinfo,cgutils,cg64f32,rgcpu, + parabase; + + type + tcgppc = class(tcgppcgen) + procedure init_register_allocators;override; + procedure done_register_allocators;override; + + procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override; + procedure a_call_reg(list : TAsmList;reg: tregister); override; + + procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); override; + procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister); override; + + procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg; + size: tcgsize; a: tcgint; src, dst: tregister); override; + procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; + size: tcgsize; src1, src2, dst: tregister); override; + + { move instructions } + procedure a_load_const_reg(list : TAsmList; size: tcgsize; a : tcgint;reg : tregister);override; + procedure a_load_ref_reg(list : TAsmList; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);override; + procedure a_load_reg_reg(list : TAsmList; fromsize, tosize : tcgsize;reg1,reg2 : tregister);override; + + procedure a_load_subsetreg_reg(list : TAsmList; subsetsize: tcgsize; + tosize: tcgsize; const sreg: tsubsetregister; destreg: tregister); override; + procedure a_load_subsetreg_subsetreg(list: TAsmlist; fromsubsetsize, tosubsetsize: tcgsize; const fromsreg, tosreg: tsubsetregister); override; + + { comparison operations } + procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; + l : tasmlabel);override; + procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override; + + procedure a_jmp_name(list : TAsmList;const s : string); override; + procedure a_jmp_always(list : TAsmList;l: tasmlabel); override; + procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); override; + + procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); override; + + procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override; + procedure g_proc_exit(list : TAsmList;parasize : longint;nostackframe:boolean); override; + procedure g_save_registers(list:TAsmList); override; + procedure g_restore_registers(list:TAsmList); override; + + procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);override; + + { find out whether a is of the form 11..00..11b or 00..11...00. If } + { that's the case, we can use rlwinm to do an AND operation } + function get_rlwi_const(a: aint; var l1, l2: longint): boolean; + + protected + procedure a_load_regconst_subsetreg_intern(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt); override; + private + + (* NOT IN USE: *) + procedure g_stackframe_entry_mac(list : TAsmList;localsize : longint); + (* NOT IN USE: *) + procedure g_return_from_proc_mac(list : TAsmList;parasize : tcgint); + + { clear out potential overflow bits from 8 or 16 bit operations } + { the upper 24/16 bits of a register after an operation } + procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister); + + { returns whether a reference can be used immediately in a powerpc } + { instruction } + function issimpleref(const ref: treference): boolean; + + function save_regs(list : TAsmList):longint; + procedure restore_regs(list : TAsmList); + end; + + tcg64fppc = class(tcg64f32) + procedure a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64);override; + procedure a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;reg : tregister64);override; + procedure a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);override; + procedure a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);override; + end; + + procedure create_codegen; + +const + TOpCG2AsmOpConstLo: Array[topcg] of TAsmOp = (A_NONE,A_MR,A_ADDI,A_ANDI_,A_DIVWU, + A_DIVW,A_MULLW, A_MULLW, A_NONE,A_NONE,A_ORI, + A_SRAWI,A_SLWI,A_SRWI,A_SUBI,A_XORI,A_NONE,A_NONE); + TOpCG2AsmOpConstHi: Array[topcg] of TAsmOp = (A_NONE,A_MR,A_ADDIS,A_ANDIS_, + A_DIVWU,A_DIVW, A_MULLW,A_MULLW,A_NONE,A_NONE, + A_ORIS,A_NONE, A_NONE,A_NONE,A_SUBIS,A_XORIS,A_NONE,A_NONE); + + implementation + + uses + globals,verbose,systems,cutils, + symconst,symsym,fmodule, + rgobj,tgobj,cpupi,procinfo,paramgr; + + + procedure tcgppc.init_register_allocators; + begin + inherited init_register_allocators; + if target_info.system=system_powerpc_darwin then + begin +{ + if pi_needs_got in current_procinfo.flags then + begin + current_procinfo.got:=NR_R31; + rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE, + [RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8, + RS_R9,RS_R10,RS_R11,RS_R12,RS_R30,RS_R29, + RS_R28,RS_R27,RS_R26,RS_R25,RS_R24,RS_R23,RS_R22, + RS_R21,RS_R20,RS_R19,RS_R18,RS_R17,RS_R16,RS_R15, + RS_R14,RS_R13],first_int_imreg,[]); + end + else} + rg[R_INTREGISTER]:=trgintcpu.create(R_INTREGISTER,R_SUBWHOLE, + [{$ifdef user0} RS_R0,{$endif} RS_R2,RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8, + RS_R9,RS_R10,RS_R11,RS_R12,RS_R31,RS_R30,RS_R29, + RS_R28,RS_R27,RS_R26,RS_R25,RS_R24,RS_R23,RS_R22, + RS_R21,RS_R20,RS_R19,RS_R18,RS_R17,RS_R16,RS_R15, + RS_R14,RS_R13],first_int_imreg,[]); + end + else + rg[R_INTREGISTER]:=trgintcpu.create(R_INTREGISTER,R_SUBWHOLE, + [{$ifdef user0} RS_R0,{$endif}RS_R3,RS_R4,RS_R5,RS_R6,RS_R7,RS_R8, + RS_R9,RS_R10,RS_R11,RS_R12,RS_R31,RS_R30,RS_R29, + RS_R28,RS_R27,RS_R26,RS_R25,RS_R24,RS_R23,RS_R22, + RS_R21,RS_R20,RS_R19,RS_R18,RS_R17,RS_R16,RS_R15, + RS_R14,RS_R13],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,RS_F8,RS_F9, + RS_F10,RS_F11,RS_F12,RS_F13,RS_F31,RS_F30,RS_F29,RS_F28,RS_F27, + RS_F26,RS_F25,RS_F24,RS_F23,RS_F22,RS_F21,RS_F20,RS_F19,RS_F18, + RS_F17,RS_F16,RS_F15,RS_F14],first_fpu_imreg,[]); + { TODO: FIX ME} + rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE, + [RS_M0,RS_M1,RS_M2],first_mm_imreg,[]); + end; + + + procedure tcgppc.done_register_allocators; + begin + rg[R_INTREGISTER].free; + rg[R_FPUREGISTER].free; + rg[R_MMREGISTER].free; + inherited done_register_allocators; + end; + + { calling a procedure by name } + procedure tcgppc.a_call_name(list : TAsmList;const s : string; weak: boolean); + begin + { MacOS: The linker on MacOS (PPCLink) inserts a call to glue code, + if it is a cross-TOC call. If so, it also replaces the NOP + with some restore code.} + if (target_info.system <> system_powerpc_darwin) then + begin + if not(weak) then + list.concat(taicpu.op_sym(A_BL,current_asmdata.RefAsmSymbol(s))) + else + list.concat(taicpu.op_sym(A_BL,current_asmdata.WeakRefAsmSymbol(s))); + + if target_info.system=system_powerpc_macos then + list.concat(taicpu.op_none(A_NOP)); + end + else + list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s,weak))); +{ + the compiler does not properly set this flag anymore in pass 1, and + for now we only need it after pass 2 (I hope) (JM) + if not(pi_do_call in current_procinfo.flags) then + internalerror(2003060703); +} + include(current_procinfo.flags,pi_do_call); + end; + + { calling a procedure by address } + procedure tcgppc.a_call_reg(list : TAsmList;reg: tregister); + + var + tmpreg : tregister; + tmpref : treference; + + begin + if target_info.system=system_powerpc_macos then + begin + {Generate instruction to load the procedure address from + the transition vector.} + //TODO: Support cross-TOC calls. + tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); + reference_reset(tmpref,4); + tmpref.offset := 0; + //tmpref.symaddr := refs_full; + tmpref.base:= reg; + list.concat(taicpu.op_reg_ref(A_LWZ,tmpreg,tmpref)); + end + else + tmpreg:=reg; + inherited a_call_reg(list,tmpreg); + end; + + +{********************** load instructions ********************} + + procedure tcgppc.a_load_const_reg(list : TAsmList; size: TCGSize; a : tcgint; reg : TRegister); + + begin + if not(size in [OS_8,OS_S8,OS_16,OS_S16,OS_32,OS_S32]) then + internalerror(2002090902); + if (a >= low(smallint)) and + (a <= high(smallint)) then + list.concat(taicpu.op_reg_const(A_LI,reg,smallint(a))) + else if ((a and $ffff) <> 0) then + begin + list.concat(taicpu.op_reg_const(A_LI,reg,smallint(a and $ffff))); + if ((a shr 16) <> 0) or + (smallint(a and $ffff) < 0) then + list.concat(taicpu.op_reg_reg_const(A_ADDIS,reg,reg, + smallint((a shr 16)+ord(smallint(a and $ffff) < 0)))) + end + else + list.concat(taicpu.op_reg_const(A_LIS,reg,smallint(a shr 16))); + end; + + + procedure tcgppc.a_load_ref_reg(list : TAsmList; fromsize,tosize : tcgsize;const ref: treference;reg : tregister); + + const + LoadInstr: Array[OS_8..OS_S32,boolean, boolean] of TAsmOp = + { indexed? updating?} + (((A_LBZ,A_LBZU),(A_LBZX,A_LBZUX)), + ((A_LHZ,A_LHZU),(A_LHZX,A_LHZUX)), + ((A_LWZ,A_LWZU),(A_LWZX,A_LWZUX)), + { 64bit stuff should be handled separately } + ((A_NONE,A_NONE),(A_NONE,A_NONE)), + { 128bit stuff too } + ((A_NONE,A_NONE),(A_NONE,A_NONE)), + { there's no load-byte-with-sign-extend :( } + ((A_LBZ,A_LBZU),(A_LBZX,A_LBZUX)), + ((A_LHA,A_LHAU),(A_LHAX,A_LHAUX)), + ((A_LWZ,A_LWZU),(A_LWZX,A_LWZUX))); + var + op: tasmop; + ref2: treference; + + begin + { TODO: optimize/take into consideration fromsize/tosize. Will } + { probably only matter for OS_S8 loads though } + if not(fromsize in [OS_8,OS_S8,OS_16,OS_S16,OS_32,OS_S32]) then + internalerror(2002090903); + ref2 := ref; + fixref(list,ref2); + { the caller is expected to have adjusted the reference already } + { in this case } + if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then + fromsize := tosize; + op := loadinstr[fromsize,ref2.index<>NR_NO,false]; + a_load_store(list,op,reg,ref2); + { sign extend shortint if necessary (because there is + no load instruction to sign extend an 8 bit value automatically) + and mask out extra sign bits when loading from a smaller signed + to a larger unsigned type } + if fromsize = OS_S8 then + begin + a_load_reg_reg(list, OS_8, OS_S8, reg, reg); + a_load_reg_reg(list, OS_S8, tosize, reg, reg); + end; + end; + + + procedure tcgppc.a_load_reg_reg(list : TAsmList;fromsize, tosize : tcgsize;reg1,reg2 : tregister); + + var + instr: taicpu; + begin + if (tcgsize2size[fromsize] > tcgsize2size[tosize]) or + ((tcgsize2size[fromsize] = tcgsize2size[tosize]) and + (fromsize <> tosize)) or + { needs to mask out the sign in the top 16 bits } + ((fromsize = OS_S8) and + (tosize = OS_16)) then + case tosize of + OS_8: + instr := taicpu.op_reg_reg_const_const_const(A_RLWINM, + reg2,reg1,0,31-8+1,31); + OS_S8: + instr := taicpu.op_reg_reg(A_EXTSB,reg2,reg1); + OS_16: + instr := taicpu.op_reg_reg_const_const_const(A_RLWINM, + reg2,reg1,0,31-16+1,31); + OS_S16: + instr := taicpu.op_reg_reg(A_EXTSH,reg2,reg1); + OS_32,OS_S32: + instr := taicpu.op_reg_reg(A_MR,reg2,reg1); + else internalerror(2002090901); + end + else + instr := taicpu.op_reg_reg(A_MR,reg2,reg1); + + list.concat(instr); + rg[R_INTREGISTER].add_move_instruction(instr); + end; + + + procedure tcgppc.a_load_subsetreg_reg(list : TAsmList; subsetsize, tosize: tcgsize; const sreg: tsubsetregister; destreg: tregister); + + begin + if (sreg.bitlen > 32) then + internalerror(2008020701); + if (sreg.bitlen <> 32) then + begin + list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,destreg, + sreg.subsetreg,(32-sreg.startbit) and 31,32-sreg.bitlen,31)); + { types with a negative lower bound are always a base type (8, 16, 32 bits) } + if (subsetsize in [OS_S8..OS_S128]) then + if ((sreg.bitlen mod 8) = 0) then + begin + a_load_reg_reg(list,tcgsize2unsigned[subsetsize],subsetsize,destreg,destreg); + a_load_reg_reg(list,subsetsize,tosize,destreg,destreg); + end + else + begin + a_op_const_reg(list,OP_SHL,OS_INT,32-sreg.bitlen,destreg); + a_op_const_reg(list,OP_SAR,OS_INT,32-sreg.bitlen,destreg); + end; + end + else + a_load_reg_reg(list,subsetsize,tosize,sreg.subsetreg,destreg); + end; + + + procedure tcgppc.a_load_regconst_subsetreg_intern(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt); + + begin + if (slopt in [SL_SETZERO,SL_SETMAX]) then + inherited a_load_regconst_subsetreg_intern(list,fromsize,subsetsize,fromreg,sreg,slopt) + else if (sreg.bitlen>32) then + internalerror(2008020702) + else if (sreg.bitlen <> 32) then + list.concat(taicpu.op_reg_reg_const_const_const(A_RLWIMI,sreg.subsetreg,fromreg, + sreg.startbit,32-sreg.startbit-sreg.bitlen,31-sreg.startbit)) + else + a_load_reg_reg(list,fromsize,subsetsize,fromreg,sreg.subsetreg); + end; + + + procedure tcgppc.a_load_subsetreg_subsetreg(list: TAsmlist; fromsubsetsize, tosubsetsize: tcgsize; const fromsreg, tosreg: tsubsetregister); + + begin + if (tosreg.bitlen>32) or (tosreg.startbit>31) then + internalerror(2008020703); + if (fromsreg.bitlen >= tosreg.bitlen) then + list.concat(taicpu.op_reg_reg_const_const_const(A_RLWIMI,tosreg.subsetreg, fromsreg.subsetreg, + (tosreg.startbit-fromsreg.startbit) and 31, + 32-tosreg.startbit-tosreg.bitlen,31-tosreg.startbit)) + else + inherited a_load_subsetreg_subsetreg(list,fromsubsetsize,tosubsetsize,fromsreg,tosreg); + end; + + + procedure tcgppc.a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); + + begin + a_op_const_reg_reg(list,op,size,a,reg,reg); + end; + + + procedure tcgppc.a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister); + + begin + a_op_reg_reg_reg(list,op,size,src,dst,dst); + end; + + + procedure tcgppc.maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister); + const + overflowops = [OP_MUL,OP_SHL,OP_ADD,OP_SUB,OP_NOT,OP_NEG]; + begin + if (op in overflowops) and + (size in [OS_8,OS_S8,OS_16,OS_S16]) then + a_load_reg_reg(list,OS_32,size,dst,dst); + end; + + + procedure tcgppc.a_op_const_reg_reg(list: TAsmList; op: TOpCg; + size: tcgsize; a: tcgint; src, dst: tregister); + var + l1,l2: longint; + oplo, ophi: tasmop; + scratchreg: tregister; + useReg, gotrlwi: boolean; + + + procedure do_lo_hi; + begin + list.concat(taicpu.op_reg_reg_const(oplo,dst,src,word(a))); + list.concat(taicpu.op_reg_reg_const(ophi,dst,dst,word(a shr 16))); + end; + + begin + if (op = OP_MOVE) then + internalerror(2006031401); + if op = OP_SUB then + begin + a_op_const_reg_reg(list,OP_ADD,size,-a,src,dst); + exit; + end; + ophi := TOpCG2AsmOpConstHi[op]; + oplo := TOpCG2AsmOpConstLo[op]; + gotrlwi := get_rlwi_const(aint(a),l1,l2); + if (op in [OP_AND,OP_OR,OP_XOR]) then + begin + if (a = 0) then + begin + if op = OP_AND then + list.concat(taicpu.op_reg_const(A_LI,dst,0)) + else + a_load_reg_reg(list,size,size,src,dst); + exit; + end + else if (a = -1) then + begin + case op of + OP_OR: + list.concat(taicpu.op_reg_const(A_LI,dst,-1)); + OP_XOR: + list.concat(taicpu.op_reg_reg(A_NOT,dst,src)); + OP_AND: + a_load_reg_reg(list,size,size,src,dst); + end; + exit; + end + else if (aword(a) <= high(word)) and + ((op <> OP_AND) or + not gotrlwi) then + begin + if ((size = OS_8) and + (byte(a) <> a)) or + ((size = OS_S8) and + (shortint(a) <> a)) then + internalerror(200604142); + list.concat(taicpu.op_reg_reg_const(oplo,dst,src,word(a))); + { and/or/xor -> cannot overflow in high 16 bits } + exit; + end; + { all basic constant instructions also have a shifted form that } + { works only on the highest 16bits, so if lo(a) is 0, we can } + { use that one } + if (word(a) = 0) and + (not(op = OP_AND) or + not gotrlwi) then + begin + if (size in [OS_8,OS_S8,OS_16,OS_S16]) then + internalerror(200604141); + list.concat(taicpu.op_reg_reg_const(ophi,dst,src,word(a shr 16))); + exit; + end; + end + else if (op = OP_ADD) then + if a = 0 then + begin + a_load_reg_reg(list,size,size,src,dst); + exit + end + else if (a >= low(smallint)) and + (a <= high(smallint)) then + begin + list.concat(taicpu.op_reg_reg_const(A_ADDI,dst,src,smallint(a))); + maybeadjustresult(list,op,size,dst); + exit; + end; + + { otherwise, the instructions we can generate depend on the } + { operation } + useReg := false; + case op of + OP_DIV,OP_IDIV: + if (a = 0) then + internalerror(200208103) + else if (a = 1) then + begin + a_load_reg_reg(list,OS_INT,OS_INT,src,dst); + exit + end + else if ispowerof2(a,l1) then + begin + case op of + OP_DIV: + list.concat(taicpu.op_reg_reg_const(A_SRWI,dst,src,l1)); + OP_IDIV: + begin + list.concat(taicpu.op_reg_reg_const(A_SRAWI,dst,src,l1)); + list.concat(taicpu.op_reg_reg(A_ADDZE,dst,dst)); + end; + end; + exit; + end + else + usereg := true; + OP_IMUL, OP_MUL: + if (a = 0) then + begin + list.concat(taicpu.op_reg_const(A_LI,dst,0)); + exit + end + else if (a = 1) then + begin + a_load_reg_reg(list,OS_INT,OS_INT,src,dst); + exit + end + else if ispowerof2(a,l1) then + list.concat(taicpu.op_reg_reg_const(A_SLWI,dst,src,l1)) + else if (longint(a) >= low(smallint)) and + (longint(a) <= high(smallint)) then + list.concat(taicpu.op_reg_reg_const(A_MULLI,dst,src,smallint(a))) + else + usereg := true; + OP_ADD: + begin + list.concat(taicpu.op_reg_reg_const(oplo,dst,src,smallint(a))); + list.concat(taicpu.op_reg_reg_const(ophi,dst,dst, + smallint((a shr 16) + ord(smallint(a) < 0)))); + end; + OP_OR: + { try to use rlwimi } + if gotrlwi and + (src = dst) then + begin + scratchreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); + list.concat(taicpu.op_reg_const(A_LI,scratchreg,-1)); + list.concat(taicpu.op_reg_reg_const_const_const(A_RLWIMI,dst, + scratchreg,0,l1,l2)); + end + else + do_lo_hi; + OP_AND: + { try to use rlwinm } + if gotrlwi then + list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,dst, + src,0,l1,l2)) + else + useReg := true; + OP_XOR: + do_lo_hi; + OP_SHL,OP_SHR,OP_SAR: + begin + if (a and 31) <> 0 Then + list.concat(taicpu.op_reg_reg_const( + TOpCG2AsmOpConstLo[Op],dst,src,a and 31)) + else + a_load_reg_reg(list,size,size,src,dst); + if (a shr 5) <> 0 then + internalError(68991); + end; + OP_ROL: + begin + if (not (size in [OS_32, OS_S32])) then begin + internalerror(2008091307); + end; + list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM, dst, src, a and 31, 0, 31)); + end; + OP_ROR: + begin + if (not (size in [OS_32, OS_S32])) then begin + internalerror(2008091308); + end; + list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM, dst, src, (32 - a) and 31, 0, 31)); + end + else + internalerror(200109091); + end; + { if all else failed, load the constant in a register and then } + { perform the operation } + if useReg then + begin + scratchreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); + a_load_const_reg(list,OS_32,a,scratchreg); + a_op_reg_reg_reg(list,op,OS_32,scratchreg,src,dst); + end; + maybeadjustresult(list,op,size,dst); + end; + + + procedure tcgppc.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; + size: tcgsize; src1, src2, dst: tregister); + + const + op_reg_reg_opcg2asmop: array[TOpCG] of tasmop = + (A_NONE,A_MR,A_ADD,A_AND,A_DIVWU,A_DIVW,A_MULLW,A_MULLW,A_NEG,A_NOT,A_OR, + A_SRAW,A_SLW,A_SRW,A_SUB,A_XOR,A_NONE,A_NONE); + var + tmpreg : TRegister; + + begin + if (op = OP_MOVE) then + internalerror(2006031402); + case op of + OP_NEG,OP_NOT: + begin + list.concat(taicpu.op_reg_reg(op_reg_reg_opcg2asmop[op],dst,src1)); + if (op = OP_NOT) and + not(size in [OS_32,OS_S32]) then + { zero/sign extend result again } + a_load_reg_reg(list,OS_32,size,dst,dst); + end; + OP_ROL: + begin + if (not (size in [OS_32, OS_S32])) then begin + internalerror(2008091305); + end; + list.concat(taicpu.op_reg_reg_reg_const_const(A_RLWNM, dst, src2, src1, 0, 31)); + end; + OP_ROR: + begin + if (not (size in [OS_32, OS_S32])) then begin + internalerror(2008091306); + end; + tmpreg := getintregister(current_asmdata.CurrAsmList, OS_INT); + list.concat(taicpu.op_reg_reg(A_NEG, tmpreg, src1)); + list.concat(taicpu.op_reg_reg_reg_const_const(A_RLWNM, dst, src2, tmpreg, 0, 31)); + end; + else + list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],dst,src2,src1)); + end; + maybeadjustresult(list,op,size,dst); + end; + + +{*************** compare instructructions ****************} + + procedure tcgppc.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; + l : tasmlabel); + + var + scratch_register: TRegister; + signed: boolean; + + begin + signed := cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE,OC_EQ,OC_NE]; + { in the following case, we generate more efficient code when } + { signed is false } + if (cmp_op in [OC_EQ,OC_NE]) and + (aword(a) >= $8000) and + (aword(a) <= $ffff) then + signed := false; + if signed then + if (a >= low(smallint)) and (a <= high(smallint)) Then + list.concat(taicpu.op_reg_reg_const(A_CMPWI,NR_CR0,reg,a)) + else + begin + scratch_register := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); + a_load_const_reg(list,OS_32,a,scratch_register); + list.concat(taicpu.op_reg_reg_reg(A_CMPW,NR_CR0,reg,scratch_register)); + end + else + if (aword(a) <= $ffff) then + list.concat(taicpu.op_reg_reg_const(A_CMPLWI,NR_CR0,reg,aword(a))) + else + begin + scratch_register := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); + a_load_const_reg(list,OS_32,a,scratch_register); + list.concat(taicpu.op_reg_reg_reg(A_CMPLW,NR_CR0,reg,scratch_register)); + end; + a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],0,l); + end; + + + procedure tcgppc.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp; + reg1,reg2 : tregister;l : tasmlabel); + + var + op: tasmop; + + begin + if cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE] then + op := A_CMPW + else + op := A_CMPLW; + list.concat(taicpu.op_reg_reg_reg(op,NR_CR0,reg2,reg1)); + a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],0,l); + end; + + + procedure tcgppc.a_jmp_name(list : TAsmList;const s : string); + var + p : taicpu; + begin + if (target_info.system = system_powerpc_darwin) then + p := taicpu.op_sym(A_B,get_darwin_call_stub(s,false)) + else + p := taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(s)); + p.is_jmp := true; + list.concat(p) + end; + + + procedure tcgppc.a_jmp_always(list : TAsmList;l: tasmlabel); + + begin + a_jmp(list,A_B,C_None,0,l); + end; + + procedure tcgppc.a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); + + var + c: tasmcond; + begin + c := flags_to_cond(f); + a_jmp(list,A_BC,c.cond,c.cr-RS_CR0,l); + end; + + procedure tcgppc.g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; reg: TRegister); + + var + testbit: byte; + bitvalue: boolean; + + begin + { get the bit to extract from the conditional register + its } + { requested value (0 or 1) } + testbit := ((f.cr-RS_CR0) * 4); + case f.flag of + F_EQ,F_NE: + begin + inc(testbit,2); + bitvalue := f.flag = F_EQ; + end; + F_LT,F_GE: + begin + bitvalue := f.flag = F_LT; + end; + F_GT,F_LE: + begin + inc(testbit); + bitvalue := f.flag = F_GT; + end; + else + internalerror(200112261); + end; + { load the conditional register in the destination reg } + list.concat(taicpu.op_reg(A_MFCR,reg)); + { we will move the bit that has to be tested to bit 0 by rotating } + { left } + testbit := (testbit + 1) and 31; + { extract bit } + list.concat(taicpu.op_reg_reg_const_const_const( + A_RLWINM,reg,reg,testbit,31,31)); + { if we need the inverse, xor with 1 } + if not bitvalue then + list.concat(taicpu.op_reg_reg_const(A_XORI,reg,reg,1)); + end; + +(* + procedure tcgppc.g_cond2reg(list: TAsmList; const f: TAsmCond; reg: TRegister); + + var + testbit: byte; + bitvalue: boolean; + + begin + { get the bit to extract from the conditional register + its } + { requested value (0 or 1) } + case f.simple of + false: + begin + { we don't generate this in the compiler } + internalerror(200109062); + end; + true: + case f.cond of + C_None: + internalerror(200109063); + C_LT..C_NU: + begin + testbit := (ord(f.cr) - ord(R_CR0))*4; + inc(testbit,AsmCondFlag2BI[f.cond]); + bitvalue := AsmCondFlagTF[f.cond]; + end; + C_T,C_F,C_DNZT,C_DNZF,C_DZT,C_DZF: + begin + testbit := f.crbit + bitvalue := AsmCondFlagTF[f.cond]; + end; + else + internalerror(200109064); + end; + end; + { load the conditional register in the destination reg } + list.concat(taicpu.op_reg_reg(A_MFCR,reg)); + { we will move the bit that has to be tested to bit 31 -> rotate } + { left by bitpos+1 (remember, this is big-endian!) } + if bitpos <> 31 then + inc(bitpos) + else + bitpos := 0; + { extract bit } + list.concat(taicpu.op_reg_reg_const_const_const( + A_RLWINM,reg,reg,bitpos,31,31)); + { if we need the inverse, xor with 1 } + if not bitvalue then + list.concat(taicpu.op_reg_reg_const(A_XORI,reg,reg,1)); + end; +*) + +{ *********** entry/exit code and address loading ************ } + + procedure tcgppc.g_save_registers(list:TAsmList); + begin + { this work is done in g_proc_entry } + end; + + + procedure tcgppc.g_restore_registers(list:TAsmList); + begin + { this work is done in g_proc_exit } + end; + + + procedure tcgppc.g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); + { generated the entry code of a procedure/function. Note: localsize is the } + { sum of the size necessary for local variables and the maximum possible } + { combined size of ALL the parameters of a procedure called by the current } + { one. } + { This procedure may be called before, as well as after g_return_from_proc } + { is called. NOTE registers are not to be allocated through the register } + { allocator here, because the register colouring has already occured !! } + + + var regcounter,firstregfpu,firstregint: TSuperRegister; + href : treference; + usesfpr,usesgpr : boolean; + + begin + { CR and LR only have to be saved in case they are modified by the current } + { procedure, but currently this isn't checked, so save them always } + { following is the entry code as described in "Altivec Programming } + { Interface Manual", bar the saving of AltiVec registers } + a_reg_alloc(list,NR_STACK_POINTER_REG); + + usesgpr := false; + usesfpr := false; + if not(po_assembler in current_procinfo.procdef.procoptions) then + begin + { save link register? } + if save_lr_in_prologue then + begin + a_reg_alloc(list,NR_R0); + { save return address... } + { warning: if this is no longer done via r0, or if r0 is } + { added to the usable registers, adapt tcgppcgen.g_profilecode } + list.concat(taicpu.op_reg(A_MFLR,NR_R0)); + { ... in caller's frame } + case target_info.abi of + abi_powerpc_aix: + reference_reset_base(href,NR_STACK_POINTER_REG,LA_LR_AIX,4); + abi_powerpc_sysv: + reference_reset_base(href,NR_STACK_POINTER_REG,LA_LR_SYSV,4); + end; + list.concat(taicpu.op_reg_ref(A_STW,NR_R0,href)); + if not(cs_profile in current_settings.moduleswitches) then + a_reg_dealloc(list,NR_R0); + end; + +(* + { save the CR if necessary in callers frame. } + if target_info.abi = abi_powerpc_aix then + if false then { Not needed at the moment. } + begin + a_reg_alloc(list,NR_R0); + list.concat(taicpu.op_reg_reg(A_MFSPR,NR_R0,NR_CR)); + reference_reset_base(href,NR_STACK_POINTER_REG,LA_CR_AIX); + list.concat(taicpu.op_reg_ref(A_STW,NR_R0,href)); + a_reg_dealloc(list,NR_R0); + end; +*) + + firstregfpu := tppcprocinfo(current_procinfo).get_first_save_fpu_reg; + firstregint := tppcprocinfo(current_procinfo).get_first_save_int_reg; + usesgpr := firstregint <> 32; + usesfpr := firstregfpu <> 32; + + if (tppcprocinfo(current_procinfo).needs_frame_pointer) then + begin + a_reg_alloc(list,NR_R12); + list.concat(taicpu.op_reg_reg(A_MR,NR_R12,NR_STACK_POINTER_REG)); + end; + end; + + if usesfpr then + begin + reference_reset_base(href,NR_R1,-8,8); + for regcounter:=firstregfpu to RS_F31 do + begin + a_loadfpu_reg_ref(list,OS_F64,OS_F64,newreg(R_FPUREGISTER,regcounter,R_SUBNONE),href); + dec(href.offset,8); + end; + { compute start of gpr save area } + inc(href.offset,4); + end + else + { compute start of gpr save area } + reference_reset_base(href,NR_R1,-4,4); + + { save gprs and fetch GOT pointer } + if usesgpr then + begin + if (firstregint <= RS_R22) or + ((cs_opt_size in current_settings.optimizerswitches) and + { with RS_R30 it's also already smaller, but too big a speed trade-off to make } + (firstregint <= RS_R29)) then + begin + { TODO: TODO: 64 bit support } + dec(href.offset,(RS_R31-firstregint)*sizeof(pint)); + list.concat(taicpu.op_reg_ref(A_STMW,newreg(R_INTREGISTER,firstregint,R_SUBNONE),href)); + end + else + for regcounter:=firstregint to RS_R31 do + begin + a_load_reg_ref(list,OS_INT,OS_INT,newreg(R_INTREGISTER,regcounter,R_SUBNONE),href); + dec(href.offset,4); + end; + end; + +{ done in ncgutil because it may only be released after the parameters } +{ have been moved to their final resting place } +{ if (tppcprocinfo(current_procinfo).needs_frame_pointer) then } +{ a_reg_dealloc(list,NR_R12); } + + if (not nostackframe) and + tppcprocinfo(current_procinfo).needstackframe and + (localsize <> 0) then + begin + if (localsize <= high(smallint)) then + begin + reference_reset_base(href,NR_STACK_POINTER_REG,-localsize,8); + a_load_store(list,A_STWU,NR_STACK_POINTER_REG,href); + end + else + begin + reference_reset_base(href,NR_STACK_POINTER_REG,0,4); + { can't use getregisterint here, the register colouring } + { is already done when we get here } + { R12 may hold previous stack pointer, R11 may be in } + { use as got => use R0 (but then we can't use } + { a_load_const_reg) } + href.index := NR_R0; + a_reg_alloc(list,href.index); + list.concat(taicpu.op_reg_const(A_LI,NR_R0,smallint((-localsize) and $ffff))); + if (smallint((-localsize) and $ffff) < 0) then + { upper 16 bits are now $ffff -> xor with inverse } + list.concat(taicpu.op_reg_reg_const(A_XORIS,NR_R0,NR_R0,word(not(((-localsize) shr 16) and $ffff)))) + else + list.concat(taicpu.op_reg_reg_const(A_ORIS,NR_R0,NR_R0,word(((-localsize) shr 16) and $ffff))); + a_load_store(list,A_STWUX,NR_STACK_POINTER_REG,href); + a_reg_dealloc(list,href.index); + end; + end; + + { save the CR if necessary ( !!! never done currently ) } +{ still need to find out where this has to be done for SystemV + a_reg_alloc(list,R_0); + list.concat(taicpu.op_reg_reg(A_MFSPR,R_0,R_CR); + list.concat(taicpu.op_reg_ref(A_STW,scratch_register, + new_reference(STACK_POINTER_REG,LA_CR))); + a_reg_dealloc(list,R_0); +} + { now comes the AltiVec context save, not yet implemented !!! } + + end; + + + procedure tcgppc.g_proc_exit(list : TAsmList;parasize : longint;nostackframe:boolean); + { This procedure may be called before, as well as after g_stackframe_entry } + { is called. NOTE registers are not to be allocated through the register } + { allocator here, because the register colouring has already occured !! } + + var + regcounter,firstregfpu,firstregint: TsuperRegister; + href : treference; + usesfpr,usesgpr,genret : boolean; + localsize: tcgint; + begin + { AltiVec context restore, not yet implemented !!! } + + usesfpr:=false; + usesgpr:=false; + if not (po_assembler in current_procinfo.procdef.procoptions) then + begin + firstregfpu := tppcprocinfo(current_procinfo).get_first_save_fpu_reg; + firstregint := tppcprocinfo(current_procinfo).get_first_save_int_reg; + usesgpr := firstregint <> 32; + usesfpr := firstregfpu <> 32; + end; + + localsize:= tppcprocinfo(current_procinfo).calc_stackframe_size; + + { adjust r1 } + { (register allocator is no longer valid at this time and an add of 0 } + { is translated into a move, which is then registered with the register } + { allocator, causing a crash } + if (not nostackframe) and + tppcprocinfo(current_procinfo).needstackframe and + (localsize <> 0) then + a_op_const_reg(list,OP_ADD,OS_ADDR,localsize,NR_R1); + + { no return (blr) generated yet } + genret:=true; + if usesfpr then + begin + reference_reset_base(href,NR_R1,-8,8); + for regcounter := firstregfpu to RS_F31 do + begin + a_loadfpu_ref_reg(list,OS_F64,OS_F64,href,newreg(R_FPUREGISTER,regcounter,R_SUBNONE)); + dec(href.offset,8); + end; + inc(href.offset,4); + end + else + reference_reset_base(href,NR_R1,-4,4); + + if (usesgpr) then + begin + if (firstregint <= RS_R22) or + ((cs_opt_size in current_settings.optimizerswitches) and + { with RS_R30 it's also already smaller, but too big a speed trade-off to make } + (firstregint <= RS_R29)) then + begin + { TODO: TODO: 64 bit support } + dec(href.offset,(RS_R31-firstregint)*sizeof(pint)); + list.concat(taicpu.op_reg_ref(A_LMW,newreg(R_INTREGISTER,firstregint,R_SUBNONE),href)); + end + else + for regcounter:=firstregint to RS_R31 do + begin + a_load_ref_reg(list,OS_INT,OS_INT,href,newreg(R_INTREGISTER,regcounter,R_SUBNONE)); + dec(href.offset,4); + end; + end; + +(* + { restore fprs and return } + if usesfpr then + begin + { address of fpr save area to r11 } + r:=NR_R12; + list.concat(taicpu.op_reg_reg_const(A_ADDI,r,r,(ord(R_F31)-ord(firstregfpu.enum)+1)*8)); + { + if (pi_do_call in current_procinfo.flags) then + a_call_name(current_asmdata.RefAsmSymbol('_restfpr_'+tostr(ord(firstregfpu)-ord(R_F14)+14)+'_x')) + else + { leaf node => lr haven't to be restored } + a_call_name('_restfpr_'+tostr(ord(firstregfpu.enum)-ord(R_F14)+14)+'_l'); + genret:=false; + } + end; +*) + + { if we didn't generate the return code, we've to do it now } + if genret then + begin + { load link register? } + if not (po_assembler in current_procinfo.procdef.procoptions) then + begin + if (pi_do_call in current_procinfo.flags) then + begin + case target_info.abi of + abi_powerpc_aix: + reference_reset_base(href,NR_STACK_POINTER_REG,LA_LR_AIX,4); + abi_powerpc_sysv: + reference_reset_base(href,NR_STACK_POINTER_REG,LA_LR_SYSV,4); + end; + a_reg_alloc(list,NR_R0); + list.concat(taicpu.op_reg_ref(A_LWZ,NR_R0,href)); + list.concat(taicpu.op_reg(A_MTLR,NR_R0)); + a_reg_dealloc(list,NR_R0); + end; + +(* + { restore the CR if necessary from callers frame} + if target_info.abi = abi_powerpc_aix then + if false then { Not needed at the moment. } + begin + reference_reset_base(href,NR_STACK_POINTER_REG,LA_CR_AIX); + list.concat(taicpu.op_reg_ref(A_LWZ,NR_R0,href)); + list.concat(taicpu.op_reg_reg(A_MTSPR,NR_R0,NR_CR)); + a_reg_dealloc(list,NR_R0); + end; +*) + end; + + list.concat(taicpu.op_none(A_BLR)); + end; + end; + + + function tcgppc.save_regs(list : TAsmList):longint; + {Generates code which saves used non-volatile registers in + the save area right below the address the stackpointer point to. + Returns the actual used save area size.} + + var regcounter,firstregfpu,firstreggpr: TSuperRegister; + usesfpr,usesgpr: boolean; + href : treference; + offset: tcgint; + regcounter2, firstfpureg: Tsuperregister; + begin + usesfpr:=false; + if not (po_assembler in current_procinfo.procdef.procoptions) then + begin + { FIXME: has to be R_F14 instad of R_F8 for SYSV-64bit } + case target_info.abi of + abi_powerpc_aix: + firstfpureg := RS_F14; + abi_powerpc_sysv: + firstfpureg := RS_F9; + else + internalerror(2003122903); + end; + for regcounter:=firstfpureg to RS_F31 do + begin + if regcounter in rg[R_FPUREGISTER].used_in_proc then + begin + usesfpr:=true; + firstregfpu:=regcounter; + break; + end; + end; + end; + usesgpr:=false; + if not (po_assembler in current_procinfo.procdef.procoptions) then + for regcounter2:=RS_R13 to RS_R31 do + begin + if regcounter2 in rg[R_INTREGISTER].used_in_proc then + begin + usesgpr:=true; + firstreggpr:=regcounter2; + break; + end; + end; + offset:= 0; + + { save floating-point registers } + if usesfpr then + for regcounter := firstregfpu to RS_F31 do + begin + offset:= offset - 8; + reference_reset_base(href, NR_STACK_POINTER_REG, offset, 8); + list.concat(taicpu.op_reg_ref(A_STFD, tregister(regcounter), href)); + end; + (* Optimiztion in the future: a_call_name(list,'_savefXX'); *) + + { save gprs in gpr save area } + if usesgpr then + if firstreggpr < RS_R30 then + begin + offset:= offset - 4 * (RS_R31 - firstreggpr + 1); + reference_reset_base(href,NR_STACK_POINTER_REG,offset,4); + list.concat(taicpu.op_reg_ref(A_STMW,tregister(firstreggpr),href)); + {STMW stores multiple registers} + end + else + begin + for regcounter := firstreggpr to RS_R31 do + begin + offset:= offset - 4; + reference_reset_base(href, NR_STACK_POINTER_REG, offset, 4); + list.concat(taicpu.op_reg_ref(A_STW, newreg(R_INTREGISTER,regcounter,R_SUBWHOLE), href)); + end; + end; + + { now comes the AltiVec context save, not yet implemented !!! } + + save_regs:= -offset; + end; + + procedure tcgppc.restore_regs(list : TAsmList); + {Generates code which restores used non-volatile registers from + the save area right below the address the stackpointer point to.} + + var regcounter,firstregfpu,firstreggpr: TSuperRegister; + usesfpr,usesgpr: boolean; + href : treference; + offset: integer; + regcounter2, firstfpureg: Tsuperregister; + + begin + usesfpr:=false; + if not (po_assembler in current_procinfo.procdef.procoptions) then + begin + { FIXME: has to be R_F14 instad of R_F8 for SYSV-64bit } + case target_info.abi of + abi_powerpc_aix: + firstfpureg := RS_F14; + abi_powerpc_sysv: + firstfpureg := RS_F9; + else + internalerror(2003122903); + end; + for regcounter:=firstfpureg to RS_F31 do + begin + if regcounter in rg[R_FPUREGISTER].used_in_proc then + begin + usesfpr:=true; + firstregfpu:=regcounter; + break; + end; + end; + end; + + usesgpr:=false; + if not (po_assembler in current_procinfo.procdef.procoptions) then + for regcounter2:=RS_R13 to RS_R31 do + begin + if regcounter2 in rg[R_INTREGISTER].used_in_proc then + begin + usesgpr:=true; + firstreggpr:=regcounter2; + break; + end; + end; + + offset:= 0; + + { restore fp registers } + if usesfpr then + for regcounter := firstregfpu to RS_F31 do + begin + offset:= offset - 8; + reference_reset_base(href, NR_STACK_POINTER_REG, offset, 8); + list.concat(taicpu.op_reg_ref(A_LFD, newreg(R_FPUREGISTER,regcounter,R_SUBWHOLE), href)); + end; + (* Optimiztion in the future: a_call_name(list,'_restfXX'); *) + + { restore gprs } + if usesgpr then + if firstreggpr < RS_R30 then + begin + offset:= offset - 4 * (RS_R31 - firstreggpr + 1); + reference_reset_base(href,NR_STACK_POINTER_REG,offset, 4); //-220 + list.concat(taicpu.op_reg_ref(A_LMW,tregister(firstreggpr),href)); + {LMW loads multiple registers} + end + else + begin + for regcounter := firstreggpr to RS_R31 do + begin + offset:= offset - 4; + reference_reset_base(href, NR_STACK_POINTER_REG, offset, 4); + list.concat(taicpu.op_reg_ref(A_LWZ, newreg(R_INTREGISTER,regcounter,R_SUBWHOLE), href)); + end; + end; + + { now comes the AltiVec context restore, not yet implemented !!! } + end; + + + procedure tcgppc.g_stackframe_entry_mac(list : TAsmList;localsize : longint); + (* NOT IN USE *) + + { generated the entry code of a procedure/function. Note: localsize is the } + { sum of the size necessary for local variables and the maximum possible } + { combined size of ALL the parameters of a procedure called by the current } + { one } + + const + macosLinkageAreaSize = 24; + + var + href : treference; + registerSaveAreaSize : longint; + + begin + if (localsize mod 8) <> 0 then + internalerror(58991); + { CR and LR only have to be saved in case they are modified by the current } + { procedure, but currently this isn't checked, so save them always } + { following is the entry code as described in "Altivec Programming } + { Interface Manual", bar the saving of AltiVec registers } + a_reg_alloc(list,NR_STACK_POINTER_REG); + a_reg_alloc(list,NR_R0); + + { save return address in callers frame} + list.concat(taicpu.op_reg_reg(A_MFSPR,NR_R0,NR_LR)); + { ... in caller's frame } + reference_reset_base(href,NR_STACK_POINTER_REG,8, 8); + list.concat(taicpu.op_reg_ref(A_STW,NR_R0,href)); + a_reg_dealloc(list,NR_R0); + + { save non-volatile registers in callers frame} + registerSaveAreaSize:= save_regs(list); + + { save the CR if necessary in callers frame ( !!! always done currently ) } + a_reg_alloc(list,NR_R0); + list.concat(taicpu.op_reg_reg(A_MFSPR,NR_R0,NR_CR)); + reference_reset_base(href,NR_STACK_POINTER_REG,LA_CR_AIX,4); + list.concat(taicpu.op_reg_ref(A_STW,NR_R0,href)); + a_reg_dealloc(list,NR_R0); + + (* + { save pointer to incoming arguments } + list.concat(taicpu.op_reg_reg_const(A_ORI,R_31,STACK_POINTER_REG,0)); + *) + + (* + a_reg_alloc(list,R_12); + + { 0 or 8 based on SP alignment } + list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM, + R_12,STACK_POINTER_REG,0,28,28)); + { add in stack length } + list.concat(taicpu.op_reg_reg_const(A_SUBFIC,R_12,R_12, + -localsize)); + { establish new alignment } + list.concat(taicpu.op_reg_reg_reg(A_STWUX,STACK_POINTER_REG,STACK_POINTER_REG,R_12)); + + a_reg_dealloc(list,R_12); + *) + + { allocate stack frame } + localsize:= align(localsize + macosLinkageAreaSize + registerSaveAreaSize, 16); + inc(localsize,tg.lasttemp); + localsize:=align(localsize,16); + //tppcprocinfo(current_procinfo).localsize:=localsize; + + if (localsize <> 0) then + begin + if (localsize <= high(smallint)) then + begin + reference_reset_base(href,NR_STACK_POINTER_REG,-localsize,8); + a_load_store(list,A_STWU,NR_STACK_POINTER_REG,href); + end + else + begin + reference_reset_base(href,NR_STACK_POINTER_REG,0,8); + href.index := NR_R11; + a_reg_alloc(list,href.index); + a_load_const_reg(list,OS_S32,-localsize,href.index); + a_load_store(list,A_STWUX,NR_STACK_POINTER_REG,href); + a_reg_dealloc(list,href.index); + end; + end; + end; + + procedure tcgppc.g_return_from_proc_mac(list : TAsmList;parasize : tcgint); + (* NOT IN USE *) + + var + href : treference; + begin + a_reg_alloc(list,NR_R0); + + { restore stack pointer } + reference_reset_base(href,NR_STACK_POINTER_REG,LA_SP,4); + list.concat(taicpu.op_reg_ref(A_LWZ,NR_STACK_POINTER_REG,href)); + (* + list.concat(taicpu.op_reg_reg_const(A_ORI,NR_STACK_POINTER_REG,R_31,0)); + *) + + { restore the CR if necessary from callers frame + ( !!! always done currently ) } + reference_reset_base(href,NR_STACK_POINTER_REG,LA_CR_AIX,4); + list.concat(taicpu.op_reg_ref(A_LWZ,NR_R0,href)); + list.concat(taicpu.op_reg_reg(A_MTSPR,NR_R0,NR_CR)); + a_reg_dealloc(list,NR_R0); + + (* + { restore return address from callers frame } + reference_reset_base(href,STACK_POINTER_REG,8); + list.concat(taicpu.op_reg_ref(A_LWZ,R_0,href)); + *) + + { restore non-volatile registers from callers frame } + restore_regs(list); + + (* + { return to caller } + list.concat(taicpu.op_reg_reg(A_MTSPR,R_0,R_LR)); + list.concat(taicpu.op_none(A_BLR)); + *) + + { restore return address from callers frame } + reference_reset_base(href,NR_STACK_POINTER_REG,8,8); + list.concat(taicpu.op_reg_ref(A_LWZ,NR_R0,href)); + + { return to caller } + list.concat(taicpu.op_reg_reg(A_MTSPR,NR_R0,NR_LR)); + list.concat(taicpu.op_none(A_BLR)); + end; + + +{ ************* concatcopy ************ } + +{$ifdef use8byteconcatcopy} + const + maxmoveunit = 8; +{$else use8byteconcatcopy} + const + maxmoveunit = 4; +{$endif use8byteconcatcopy} + + procedure tcgppc.g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint); + + var + countreg: TRegister; + src, dst: TReference; + lab: tasmlabel; + count, count2: aint; + size: tcgsize; + copyreg: tregister; + + begin +{$ifdef extdebug} + if len > high(longint) then + internalerror(2002072704); +{$endif extdebug} + + if (references_equal(source,dest)) then + exit; + + { make sure short loads are handled as optimally as possible } + if (len <= maxmoveunit) and + (byte(len) in [1,2,4,8]) then + begin + if len < 8 then + begin + size := int_cgsize(len); + a_load_ref_ref(list,size,size,source,dest); + end + else + begin + copyreg := getfpuregister(list,OS_F64); + a_loadfpu_ref_reg(list,OS_F64,OS_F64,source,copyreg); + a_loadfpu_reg_ref(list,OS_F64,OS_F64,copyreg,dest); + end; + exit; + end; + + count := len div maxmoveunit; + + reference_reset(src,source.alignment); + reference_reset(dst,dest.alignment); + { load the address of source into src.base } + if (count > 4) or + not issimpleref(source) or + ((source.index <> NR_NO) and + ((source.offset + longint(len)) > high(smallint))) then + begin + src.base := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); + a_loadaddr_ref_reg(list,source,src.base); + end + else + begin + src := source; + end; + { load the address of dest into dst.base } + if (count > 4) or + not issimpleref(dest) or + ((dest.index <> NR_NO) and + ((dest.offset + longint(len)) > high(smallint))) then + begin + dst.base := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); + a_loadaddr_ref_reg(list,dest,dst.base); + end + else + begin + dst := dest; + end; + +{$ifdef use8byteconcatcopy} + if count > 4 then + { generate a loop } + begin + { the offsets are zero after the a_loadaddress_ref_reg and just } + { have to be set to 8. I put an Inc there so debugging may be } + { easier (should offset be different from zero here, it will be } + { easy to notice in the generated assembler } + inc(dst.offset,8); + inc(src.offset,8); + list.concat(taicpu.op_reg_reg_const(A_SUBI,src.base,src.base,8)); + list.concat(taicpu.op_reg_reg_const(A_SUBI,dst.base,dst.base,8)); + countreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); + a_load_const_reg(list,OS_32,count,countreg); + copyreg := getfpuregister(list,OS_F64); + a_reg_sync(list,copyreg); + current_asmdata.getjumplabel(lab); + a_label(list, lab); + list.concat(taicpu.op_reg_reg_const(A_SUBIC_,countreg,countreg,1)); + list.concat(taicpu.op_reg_ref(A_LFDU,copyreg,src)); + list.concat(taicpu.op_reg_ref(A_STFDU,copyreg,dst)); + a_jmp(list,A_BC,C_NE,0,lab); + a_reg_sync(list,copyreg); + len := len mod 8; + end; + + count := len div 8; + if count > 0 then + { unrolled loop } + begin + copyreg := getfpuregister(list,OS_F64); + for count2 := 1 to count do + begin + a_loadfpu_ref_reg(list,OS_F64,OS_F64,src,copyreg); + a_loadfpu_reg_ref(list,OS_F64,OS_F64,copyreg,dst); + inc(src.offset,8); + inc(dst.offset,8); + end; + len := len mod 8; + end; + + if (len and 4) <> 0 then + begin + a_reg_alloc(list,NR_R0); + a_load_ref_reg(list,OS_32,OS_32,src,NR_R0); + a_load_reg_ref(list,OS_32,OS_32,NR_R0,dst); + inc(src.offset,4); + inc(dst.offset,4); + a_reg_dealloc(list,NR_R0); + end; +{$else use8byteconcatcopy} + if count > 4 then + { generate a loop } + begin + { the offsets are zero after the a_loadaddress_ref_reg and just } + { have to be set to 4. I put an Inc there so debugging may be } + { easier (should offset be different from zero here, it will be } + { easy to notice in the generated assembler } + inc(dst.offset,4); + inc(src.offset,4); + list.concat(taicpu.op_reg_reg_const(A_SUBI,src.base,src.base,4)); + list.concat(taicpu.op_reg_reg_const(A_SUBI,dst.base,dst.base,4)); + countreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); + a_load_const_reg(list,OS_32,count,countreg); + { explicitely allocate R_0 since it can be used safely here } + { (for holding date that's being copied) } + a_reg_alloc(list,NR_R0); + current_asmdata.getjumplabel(lab); + a_label(list, lab); + list.concat(taicpu.op_reg_reg_const(A_SUBIC_,countreg,countreg,1)); + list.concat(taicpu.op_reg_ref(A_LWZU,NR_R0,src)); + list.concat(taicpu.op_reg_ref(A_STWU,NR_R0,dst)); + a_jmp(list,A_BC,C_NE,0,lab); + a_reg_dealloc(list,NR_R0); + len := len mod 4; + end; + + count := len div 4; + if count > 0 then + { unrolled loop } + begin + a_reg_alloc(list,NR_R0); + for count2 := 1 to count do + begin + a_load_ref_reg(list,OS_32,OS_32,src,NR_R0); + a_load_reg_ref(list,OS_32,OS_32,NR_R0,dst); + inc(src.offset,4); + inc(dst.offset,4); + end; + a_reg_dealloc(list,NR_R0); + len := len mod 4; + end; +{$endif use8byteconcatcopy} + { copy the leftovers } + if (len and 2) <> 0 then + begin + a_reg_alloc(list,NR_R0); + a_load_ref_reg(list,OS_16,OS_16,src,NR_R0); + a_load_reg_ref(list,OS_16,OS_16,NR_R0,dst); + inc(src.offset,2); + inc(dst.offset,2); + a_reg_dealloc(list,NR_R0); + end; + if (len and 1) <> 0 then + begin + a_reg_alloc(list,NR_R0); + a_load_ref_reg(list,OS_8,OS_8,src,NR_R0); + a_load_reg_ref(list,OS_8,OS_8,NR_R0,dst); + a_reg_dealloc(list,NR_R0); + end; + end; + + +{***************** This is private property, keep out! :) *****************} + + function tcgppc.issimpleref(const ref: treference): boolean; + + begin + if (ref.base = NR_NO) and + (ref.index <> NR_NO) then + internalerror(200208101); + result := + not(assigned(ref.symbol)) and + (((ref.index = NR_NO) and + (ref.offset >= low(smallint)) and + (ref.offset <= high(smallint))) or + ((ref.index <> NR_NO) and + (ref.offset = 0))); + end; + + + { find out whether a is of the form 11..00..11b or 00..11...00. If } + { that's the case, we can use rlwinm to do an AND operation } + function tcgppc.get_rlwi_const(a: aint; var l1, l2: longint): boolean; + + var + temp : longint; + testbit : aint; + compare: boolean; + + begin + get_rlwi_const := false; + if (a = 0) or (a = -1) then + exit; + { start with the lowest bit } + testbit := 1; + { check its value } + compare := boolean(a and testbit); + { find out how long the run of bits with this value is } + { (it's impossible that all bits are 1 or 0, because in that case } + { this function wouldn't have been called) } + l1 := 31; + while (((a and testbit) <> 0) = compare) do + begin + testbit := testbit shl 1; + dec(l1); + end; + + { check the length of the run of bits that comes next } + compare := not compare; + l2 := l1; + while (((a and testbit) <> 0) = compare) and + (l2 >= 0) do + begin + testbit := testbit shl 1; + dec(l2); + end; + + { and finally the check whether the rest of the bits all have the } + { same value } + compare := not compare; + temp := l2; + if temp >= 0 then + if (a shr (31-temp)) <> ((-ord(compare)) shr (31-temp)) then + exit; + + { we have done "not(not(compare))", so compare is back to its } + { initial value. If the lowest bit was 0, a is of the form } + { 00..11..00 and we need "rlwinm reg,reg,0,l2+1,l1", (+1 } + { because l2 now contains the position of the last zero of the } + { first run instead of that of the first 1) so switch l1 and l2 } + { in that case (we will generate "rlwinm reg,reg,0,l1,l2") } + if not compare then + begin + temp := l1; + l1 := l2+1; + l2 := temp; + end + else + { otherwise, l1 currently contains the position of the last } + { zero instead of that of the first 1 of the second run -> +1 } + inc(l1); + { the following is the same as "if l1 = -1 then l1 := 31;" } + l1 := l1 and 31; + l2 := l2 and 31; + get_rlwi_const := true; + end; + + + procedure tcg64fppc.a_op64_reg_reg(list : TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst : tregister64); + begin + case op of + OP_NOT: + begin + cg.a_op_reg_reg(list,OP_NOT,OS_32,regsrc.reglo,regdst.reglo); + cg.a_op_reg_reg(list,OP_NOT,OS_32,regsrc.reghi,regdst.reghi); + end; + OP_NEG: + begin + list.concat(taicpu.op_reg_reg_const(a_subfic,regdst.reglo,regsrc.reglo,0)); + list.concat(taicpu.op_reg_reg(a_subfze,regdst.reghi,regsrc.reghi)); + end; + else + a_op64_reg_reg_reg(list,op,size,regsrc,regdst,regdst); + end; + end; + + + procedure tcg64fppc.a_op64_const_reg(list : TAsmList;op:TOpCG;size : tcgsize;value : int64;reg : tregister64); + begin + a_op64_const_reg_reg(list,op,size,value,reg,reg); + end; + + + procedure tcg64fppc.a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64); + 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(taicpu.op_reg_reg_reg(A_ADDC,regdst.reglo,regsrc1.reglo,regsrc2.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_ADDE,regdst.reghi,regsrc1.reghi,regsrc2.reghi)); + end; + OP_SUB: + begin + list.concat(taicpu.op_reg_reg_reg(A_SUBC,regdst.reglo,regsrc2.reglo,regsrc1.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_SUBFE,regdst.reghi,regsrc1.reghi,regsrc2.reghi)); + end; + else + internalerror(2002072801); + end; + end; + + + procedure tcg64fppc.a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64); + + const + ops: array[boolean,1..3] of tasmop = ((A_ADDIC,A_ADDC,A_ADDZE), + (A_SUBIC,A_SUBC,A_ADDME)); + var + tmpreg: tregister; + tmpreg64: tregister64; + issub: boolean; + begin + case op of + OP_AND,OP_OR,OP_XOR: + begin + cg.a_op_const_reg_reg(list,op,OS_32,aint(value),regsrc.reglo,regdst.reglo); + cg.a_op_const_reg_reg(list,op,OS_32,aint(value shr 32),regsrc.reghi, + regdst.reghi); + end; + OP_ADD, OP_SUB: + begin + if (value < 0) and + (value <> low(value)) then + begin + if op = OP_ADD then + op := OP_SUB + else + op := OP_ADD; + value := -value; + end; + if (longint(value) <> 0) then + begin + issub := op = OP_SUB; + if (value > 0) and + (value-ord(issub) <= 32767) then + begin + list.concat(taicpu.op_reg_reg_const(ops[issub,1], + regdst.reglo,regsrc.reglo,longint(value))); + list.concat(taicpu.op_reg_reg(ops[issub,3], + regdst.reghi,regsrc.reghi)); + end + else if ((value shr 32) = 0) then + begin + tmpreg := tcgppc(cg).rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); + cg.a_load_const_reg(list,OS_32,aint(value),tmpreg); + list.concat(taicpu.op_reg_reg_reg(ops[issub,2], + regdst.reglo,regsrc.reglo,tmpreg)); + list.concat(taicpu.op_reg_reg(ops[issub,3], + regdst.reghi,regsrc.reghi)); + end + else + begin + tmpreg64.reglo := tcgppc(cg).rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); + tmpreg64.reghi := tcgppc(cg).rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); + a_load64_const_reg(list,value,tmpreg64); + a_op64_reg_reg_reg(list,op,size,tmpreg64,regsrc,regdst); + end + end + else + begin + cg.a_load_reg_reg(list,OS_INT,OS_INT,regsrc.reglo,regdst.reglo); + cg.a_op_const_reg_reg(list,op,OS_32,aint(value shr 32),regsrc.reghi, + regdst.reghi); + end; + end; + else + internalerror(2002072802); + end; + end; + + + procedure create_codegen; + begin + cg := tcgppc.create; + cg64 :=tcg64fppc.create; + end; + +end. diff --git a/closures/compiler/powerpc/cpubase.pas b/closures/compiler/powerpc/cpubase.pas new file mode 100644 index 0000000000..4c14d2449f --- /dev/null +++ b/closures/compiler/powerpc/cpubase.pas @@ -0,0 +1,575 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Contains the base types for the PowerPC + + 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 base types for the PowerPC +} +unit cpubase; + +{$i fpcdefs.inc} + +interface + +uses + strings,globtype, + cutils,cclasses,aasmbase,cpuinfo,cgbase; + + +{***************************************************************************** + Assembler Opcodes +*****************************************************************************} + + type + TAsmOp=(A_None, + { normal opcodes } + a_add, a_add_, a_addo, a_addo_, a_addc, a_addc_, a_addco, a_addco_, + a_adde, a_adde_, a_addeo, a_addeo_, a_addi, a_addic, a_addic_, a_addis, + a_addme, a_addme_, a_addmeo, a_addmeo_, a_addze, a_addze_, a_addzeo, + a_addzeo_, a_and, a_and_, a_andc, a_andc_, a_andi_, a_andis_, a_b, + a_ba, a_bl, a_bla, a_bc, a_bca, a_bcl, a_bcla, a_bcctr, a_bcctrl, a_bclr, + a_bclrl, a_cmp, a_cmpi, a_cmpl, a_cmpli, a_cntlzw, a_cntlzw_, a_crand, + a_crandc, a_creqv, a_crnand, a_crnor, a_cror, a_crorc, a_crxor, a_dcba, + a_dcbf, a_dcbi, a_dcbst, a_dcbt, a_dcbtst, a_dcbz, a_divw, a_divw_, a_divwo, a_divwo_, + a_divwu, a_divwu_, a_divwuo, a_divwuo_, a_eciwx, a_ecowx, a_eieio, a_eqv, + a_eqv_, a_extsb, a_extsb_, a_extsh, a_extsh_, a_fabs, a_fabs_, a_fadd, + a_fadd_, a_fadds, a_fadds_, a_fcmpo, a_fcmpu, a_fctid, a_fctid_, + a_fctidz, a_fctidz_, a_fctiw, a_fctiw_, a_fctiwz, a_fctiwz_, + a_fdiv, a_fdiv_, a_fdivs, a_fdivs_, a_fmadd, a_fmadd_, a_fmadds, + a_fmadds_, a_fmr, a_fmsub, a_fmsub_, a_fmsubs, a_fmsubs_, a_fmul, a_fmul_, + a_fmuls, a_fmuls_, a_fnabs, a_fnabs_, a_fneg, a_fneg_, a_fnmadd, + a_fnmadd_, a_fnmadds, a_fnmadds_, a_fnmsub, a_fnmsub_, a_fnmsubs, + a_fnmsubs_, a_fres, a_fres_, a_frsp, a_frsp_, a_frsqrte, a_frsqrte_, + a_fsel, a_fsel_, a_fsqrt, a_fsqrt_, a_fsqrts, a_fsqrts_, a_fsub, a_fsub_, + a_fsubs, a_fsubs_, a_icbi, a_isync, a_lbz, a_lbzu, a_lbzux, a_lbzx, + a_lfd, a_lfdu, a_lfdux, a_lfdx, a_lfs, a_lfsu, a_lfsux, a_lfsx, a_lha, + a_lhau, a_lhaux, a_lhax, a_lhbrx, a_lhz, a_lhzu, a_lhzux, a_lhzx, a_lmw, + a_lswi, a_lswx, a_lwarx, a_lwbrx, a_lwz, a_lwzu, a_lwzux, a_lwzx, a_mcrf, + a_mcrfs, a_mcrxr, a_mfcr, a_mffs, a_mffs_, a_mfmsr, a_mfspr, a_mfsr, + a_mfsrin, a_mftb, a_mtcrf, a_mtfsb0, a_mtfsb1, a_mtfsf, a_mtfsf_, + a_mtfsfi, a_mtfsfi_, a_mtmsr, a_mtspr, a_mtsr, a_mtsrin, a_mulhw, + a_mulhw_, a_mulhwu, a_mulhwu_, a_mulli, a_mullw, a_mullw_, a_mullwo, + a_mullwo_, a_nand, a_nand_, a_neg, a_neg_, a_nego, a_nego_, a_nor, a_nor_, + a_or, a_or_, a_orc, a_orc_, a_ori, a_oris, a_rfi, a_rlwimi, a_rlwimi_, + a_rlwinm, a_rlwinm_, a_rlwnm, a_rlwnm_, a_sc, a_slw, a_slw_, a_sraw, a_sraw_, + a_srawi, a_srawi_,a_srw, a_srw_, a_stb, a_stbu, a_stbux, a_stbx, a_stfd, + a_stfdu, a_stfdux, a_stfdx, a_stfiwx, a_stfs, a_stfsu, a_stfsux, a_stfsx, + a_sth, a_sthbrx, a_sthu, a_sthux, a_sthx, a_stmw, a_stswi, a_stswx, a_stw, + a_stwbrx, a_stwcx_, a_stwu, a_stwux, a_stwx, a_subf, a_subf_, a_subfo, + a_subfo_, a_subfc, a_subfc_, a_subfco, a_subfco_, a_subfe, a_subfe_, + a_subfeo, a_subfeo_, a_subfic, a_subfme, a_subfme_, a_subfmeo, a_subfmeo_, + a_subfze, a_subfze_, a_subfzeo, a_subfzeo_, a_sync, a_tlbia, a_tlbie, + a_tlbsync, a_tw, a_twi, a_xor, a_xor_, a_xori, a_xoris, + { simplified mnemonics } + a_subi, a_subis, a_subic, a_subic_, a_sub, a_sub_, a_subo, a_subo_, + a_subc, a_subc_, a_subco, a_subco_, a_cmpwi, a_cmpw, a_cmplwi, a_cmplw, + a_extlwi, a_extlwi_, a_extrwi, a_extrwi_, a_inslwi, a_inslwi_, a_insrwi, + a_insrwi_, a_rotlwi, a_rotlwi_, a_rotlw, a_rotlw_, a_slwi, a_slwi_, + a_srwi, a_srwi_, a_clrlwi, a_clrlwi_, a_clrrwi, a_clrrwi_, a_clrslwi, + a_clrslwi_, a_blr, a_bctr, a_blrl, a_bctrl, a_crset, a_crclr, a_crmove, + a_crnot, a_mt {move to special prupose reg}, a_mf {move from special purpose reg}, + a_nop, a_li, a_lis, a_la, a_mr, a_mr_, a_not, a_not_, a_mtcr, a_mtlr, a_mflr, + a_mtctr, a_mfctr, a_mftbu, a_mfxer); + + {# This should define the array of instructions as string } + op2strtable=array[tasmop] of string[8]; + + 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 rppcnor.inc}-1; + totherregisterset = set of tregisterindex; + + const + maxvarregs = 32-6; { 32 int registers - r0 - stackpointer - r2 - 3 scratch registers } + maxfpuvarregs = 28; { 32 fpuregisters - some scratch registers (minimally 2) } + { Available Superregisters } + {$i rppcsup.inc} + + { No Subregisters } + R_SUBWHOLE=R_SUBNONE; + + { Available Registers } + {$i rppccon.inc} + + { Integer Super registers first and last } + first_int_imreg = $20; + + { Float Super register first and last } + first_fpu_imreg = $20; + + { MM Super register first and last } + first_mm_imreg = $20; + +{ TODO: Calculate bsstart} + regnumber_count_bsstart = 64; + + regnumber_table : array[tregisterindex] of tregister = ( + {$i rppcnum.inc} + ); + + regstabs_table : array[tregisterindex] of shortint = ( + {$i rppcstab.inc} + ); + + regdwarf_table : array[tregisterindex] of shortint = ( + {$i rppcdwrf.inc} + ); + +{***************************************************************************** + Conditions +*****************************************************************************} + + type + TAsmCondFlag = (C_None { unconditional jumps }, + { conditions when not using ctr decrement etc } + C_LT,C_LE,C_EQ,C_GE,C_GT,C_NL,C_NE,C_NG,C_SO,C_NS,C_UN,C_NU, + { conditions when using ctr decrement etc } + C_T,C_F,C_DNZ,C_DNZT,C_DNZF,C_DZ,C_DZT,C_DZF); + + TDirHint = (DH_None,DH_Minus,DH_Plus); + + const + { these are in the XER, but when moved to CR_x they correspond with the } + { bits below } + C_OV = C_GT; + C_CA = C_EQ; + C_NO = C_NG; + C_NC = C_NE; + + type + TAsmCond = packed record + dirhint : tdirhint; + case simple: boolean of + false: (BO, BI: byte); + true: ( + cond: TAsmCondFlag; + case byte of + 0: (); + { specifies in which part of the cr the bit has to be } + { tested for blt,bgt,beq,..,bnu } + 1: (cr: RS_CR0..RS_CR7); + { specifies the bit to test for bt,bf,bdz,..,bdzf } + 2: (crbit: byte) + ); + end; + + const + AsmCondFlag2BO: Array[C_T..C_DZF] of Byte = + (12,4,16,8,0,18,10,2); + + AsmCondFlag2BOLT_NU: Array[C_LT..C_NU] of Byte = + (12,4,12,4,12,4,4,4,12,4,12,4); + + AsmCondFlag2BI: Array[C_LT..C_NU] of Byte = + (0,1,2,0,1,0,2,1,3,3,3,3); + + AsmCondFlagTF: Array[TAsmCondFlag] of Boolean = + (false,true,false,true,false,true,false,false,false,true,false,true,false, + true,false,false,true,false,false,true,false); + + AsmCondFlag2Str: Array[TAsmCondFlag] of string[4] = ({cf_none}'', + { conditions when not using ctr decrement etc} + 'lt','le','eq','ge','gt','nl','ne','ng','so','ns','un','nu', + 't','f','dnz','dnzt','dnzf','dz','dzt','dzf'); + + UpperAsmCondFlag2Str: Array[TAsmCondFlag] of string[4] = ({cf_none}'', + { conditions when not using ctr decrement etc} + 'LT','LE','EQ','GE','GT','NL','NE','NG','SO','NS','UN','NU', + 'T','F','DNZ','DNZT','DNZF','DZ','DZT','DZF'); + + + const + CondAsmOps=3; + CondAsmOp:array[0..CondAsmOps-1] of TasmOp=( + A_BC, A_TW, A_TWI + ); + CondAsmOpStr:array[0..CondAsmOps-1] of string[7]=( + 'BC','TW','TWI' + ); + + +{***************************************************************************** + Flags +*****************************************************************************} + + type + TResFlagsEnum = (F_EQ,F_NE,F_LT,F_LE,F_GT,F_GE,F_SO,F_FX,F_FEX,F_VX,F_OX); + TResFlags = record + cr: RS_CR0..RS_CR7; + flag: TResFlagsEnum; + end; + + (* + const + { arrays for boolean location conversions } + + flag_2_cond : array[TResFlags] of TAsmCond = + (C_E,C_NE,C_LT,C_LE,C_GT,C_GE,???????????????); + *) + +{***************************************************************************** + Reference +*****************************************************************************} + + const + { MacOS only. Whether the direct data area (TOC) directly contain + global variables. Otherwise it contains pointers to global variables. } + macos_direct_globals = false; + +{***************************************************************************** + Operand Sizes +*****************************************************************************} + + +{***************************************************************************** + Constants +*****************************************************************************} + + const + max_operands = 5; + + +{***************************************************************************** + 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_M128; + +{***************************************************************************** + GDB Information +*****************************************************************************} + + {# Register indexes for stabs information, when some + parameters or variables are stored in registers. + + Taken from rs6000.h (DBX_REGISTER_NUMBER) + from GCC 3.x source code. PowerPC has 1:1 mapping + according to the order of the registers defined + in GCC + + } + + stab_regindex : array[tregisterindex] of shortint = ( + {$i rppcstab.inc} + ); + + +{***************************************************************************** + Generic Register names +*****************************************************************************} + + {# Stack pointer register } + NR_STACK_POINTER_REG = NR_R1; + RS_STACK_POINTER_REG = RS_R1; + {# Frame pointer register } + NR_FRAME_POINTER_REG = NR_STACK_POINTER_REG; + RS_FRAME_POINTER_REG = RS_STACK_POINTER_REG; + {# 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 + + Taken from GCC rs6000.h + } +{ TODO: As indicated in rs6000.h, but can't find it anywhere else!} + NR_PIC_OFFSET_REG = NR_R30; + { Return address of a function } + NR_RETURN_ADDRESS_REG = NR_R0; + { Results are returned in this register (32-bit values) } + NR_FUNCTION_RETURN_REG = NR_R3; + RS_FUNCTION_RETURN_REG = RS_R3; + { Low part of 64bit return value } + NR_FUNCTION_RETURN64_LOW_REG = NR_R4; + RS_FUNCTION_RETURN64_LOW_REG = RS_R4; + { High part of 64bit return value } + NR_FUNCTION_RETURN64_HIGH_REG = NR_R3; + RS_FUNCTION_RETURN64_HIGH_REG = RS_R3; + { 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_F1; + NR_MM_RESULT_REG = NR_M0; + + +{***************************************************************************** + GCC /ABI linking information +*****************************************************************************} + + {# Registers which must be saved when calling a routine declared as + cppdecl, cdecl, stdcall, safecall, palmossyscall. The registers + saved should be the ones as defined in the target ABI and / or GCC. + + This value can be deduced from CALLED_USED_REGISTERS array in the + GCC source. + } + saved_standard_registers : array[0..18] of tsuperregister = ( + RS_R13,RS_R14,RS_R15,RS_R16,RS_R17,RS_R18,RS_R19, + RS_R20,RS_R21,RS_R22,RS_R23,RS_R24,RS_R25,RS_R26,RS_R27,RS_R28,RS_R29, + RS_R30,RS_R31 + ); + + { this is only for the generic code which is not used for this architecture } + saved_mm_registers : array[0..0] of tsuperregister = (RS_NO); + + {# 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; { for 32-bit version only } + + +{***************************************************************************** + CPU Dependent Constants +*****************************************************************************} + + LinkageAreaSizeAIX = 24; + LinkageAreaSizeSYSV = 8; + { offset in the linkage area for the saved stack pointer } + LA_SP = 0; + { offset in the linkage area for the saved conditional register} + LA_CR_AIX = 4; + { offset in the linkage area for the saved link register} + LA_LR_AIX = 8; + LA_LR_SYSV = 4; + { offset in the linkage area for the saved RTOC register} + LA_RTOC_AIX = 20; + + PARENT_FRAMEPOINTER_OFFSET = 12; + + NR_RTOC = NR_R2; + + maxfpuregs = 8; + +{***************************************************************************** + Helpers +*****************************************************************************} + + function is_calljmp(o:tasmop):boolean; + + procedure inverse_flags(var r : TResFlags); + function flags_to_cond(const f: TResFlags) : TAsmCond; + procedure create_cond_imm(BO,BI:byte;var r : TAsmCond); + procedure create_cond_norm(cond: TAsmCondFlag; cr: byte;var r : TasmCond); + + function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister; + { Returns the tcgsize corresponding with the size of reg.} + function reg_cgsize(const reg: tregister) : tcgsize; + + function findreg_by_number(r:Tregister):tregisterindex; + function std_regnum_search(const s:string):Tregister; + function std_regname(r:Tregister):string; + function is_condreg(r : tregister):boolean; + + function inverse_cond(const c: TAsmCond): Tasmcond; {$ifdef USEINLINE}inline;{$endif USEINLINE} + function conditions_equal(const c1, c2: TAsmCond): boolean; + function dwarf_reg(r:tregister):shortint; + +implementation + + uses + rgbase,verbose; + + const + std_regname_table : array[tregisterindex] of string[7] = ( + {$i rppcstd.inc} + ); + + regnumber_index : array[tregisterindex] of tregisterindex = ( + {$i rppcrni.inc} + ); + + std_regname_index : array[tregisterindex] of tregisterindex = ( + {$i rppcsri.inc} + ); + + +{***************************************************************************** + Helpers +*****************************************************************************} + + function is_calljmp(o:tasmop):boolean; + begin + is_calljmp:=false; + case o of + A_B,A_BA,A_BL,A_BLA,A_BC,A_BCA,A_BCL,A_BCLA,A_BCCTR,A_BCCTRL,A_BCLR, + A_BCLRL,A_TW,A_TWI: is_calljmp:=true; + end; + end; + + + procedure inverse_flags(var r: TResFlags); + const + inv_flags: array[F_EQ..F_GE] of TResFlagsEnum = + (F_NE,F_EQ,F_GE,F_GE,F_LE,F_LT); + begin + r.flag := inv_flags[r.flag]; + end; + + + function inverse_cond(const c: TAsmCond): Tasmcond; {$ifdef USEINLINE}inline;{$endif USEINLINE} + const + inv_condflags:array[TAsmCondFlag] of TAsmCondFlag=(C_None, + C_GE,C_GT,C_NE,C_LT,C_LE,C_LT,C_EQ,C_GT,C_NS,C_SO,C_NU,C_UN, + C_F,C_T,C_DNZ,C_DNZF,C_DNZT,C_DZ,C_DZF,C_DZT); + begin + if (c.cond in [C_DNZ,C_DZ]) then + internalerror(2005022501); + result := c; + result.cond := inv_condflags[c.cond]; + end; + + + function conditions_equal(const c1, c2: TAsmCond): boolean; + begin + result := + (c1.simple and c2.simple) and + (c1.cond = c2.cond) and + ((not(c1.cond in [C_T..C_DZF]) and + (c1.cr = c2.cr)) or + (c1.crbit = c2.crbit)); + end; + + + function flags_to_cond(const f: TResFlags) : TAsmCond; + const + flag_2_cond: array[F_EQ..F_SO] of TAsmCondFlag = + (C_EQ,C_NE,C_LT,C_LE,C_GT,C_GE,C_SO); + begin + if f.flag > high(flag_2_cond) then + internalerror(200112301); + result.simple := true; + result.cr := f.cr; + result.cond := flag_2_cond[f.flag]; + end; + + + procedure create_cond_imm(BO,BI:byte;var r : TAsmCond); + begin + r.simple := false; + r.bo := bo; + r.bi := bi; + end; + + + procedure create_cond_norm(cond: TAsmCondFlag; cr: byte;var r : TasmCond); + begin + r.simple := true; + r.cond := cond; + case cond of + C_NONE:; + C_T..C_DZF: r.crbit := cr + else r.cr := RS_CR0+cr; + end; + end; + + + function is_condreg(r : tregister):boolean; + var + supreg: tsuperregister; + begin + result := false; + if (getregtype(r) = R_SPECIALREGISTER) then + begin + supreg := getsupreg(r); + result := (supreg >= RS_CR0) and (supreg <= RS_CR7); + end; + end; + + + function reg_cgsize(const reg: tregister): tcgsize; + begin + case getregtype(reg) of + R_INTREGISTER : + result:=OS_32; + R_MMREGISTER: + result:=OS_M128; + R_FPUREGISTER: + result:=OS_F64; + else + internalerror(200303181); + end; + end; + + + function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister; + begin + cgsize2subreg:=R_SUBWHOLE; + 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; + + + function dwarf_reg(r:tregister):shortint; + begin + result:=regdwarf_table[findreg_by_number(r)]; + if result=-1 then + internalerror(200603251); + end; + +end. diff --git a/closures/compiler/powerpc/cpuinfo.pas b/closures/compiler/powerpc/cpuinfo.pas new file mode 100644 index 0000000000..1d91423462 --- /dev/null +++ b/closures/compiler/powerpc/cpuinfo.pas @@ -0,0 +1,88 @@ +{ + Copyright (c) 1998-2002 by the Free Pascal development team + + Basic Processor information for the PowerPC + + 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 = extended; + ts128real = extended; + ts64comp = comp; + + pbestreal=^bestreal; + + { possible supported processors for this target } + tcputype = + (cpu_none, + cpu_ppc604, + cpu_ppc750, + cpu_ppc7400, + cpu_ppc970 + ); + + tfputype = + (fpu_none, + fpu_soft, + fpu_standard + ); + + +Const + { calling conventions supported by the code generator } + supported_calling_conventions : tproccalloptions = [ + pocall_internproc, + pocall_stdcall, + { the difference to stdcall is only the name mangling } + pocall_cdecl, + { the difference to stdcall is only the name mangling } + pocall_cppdecl, + { pass all const records by reference } + pocall_mwpascal + ]; + + cputypestr : array[tcputype] of string[10] = ('', + '604', + '750', + '7400', + '970' + ); + + fputypestr : array[tfputype] of string[8] = ( + 'NONE', + 'SOFT', + 'STANDARD' + ); + + { Supported optimizations, only used for information } + supported_optimizerswitches = genericlevel1optimizerswitches+ + genericlevel2optimizerswitches+ + genericlevel3optimizerswitches- + { no need to write info about those } + [cs_opt_level1,cs_opt_level2,cs_opt_level3]+ + [cs_opt_regvar,cs_opt_loopunroll,cs_opt_nodecse,cs_opt_tailrecursion]; + + level1optimizerswitches = genericlevel1optimizerswitches; + level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + [cs_opt_regvar,cs_opt_nodecse,cs_opt_tailrecursion]; + level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches + [{,cs_opt_loopunroll}]; + +Implementation + +end. diff --git a/closures/compiler/powerpc/cpunode.pas b/closures/compiler/powerpc/cpunode.pas new file mode 100644 index 0000000000..4be69d046b --- /dev/null +++ b/closures/compiler/powerpc/cpunode.pas @@ -0,0 +1,51 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + Includes the PowerPC 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. + + **************************************************************************** +} +unit cpunode; + +{$i fpcdefs.inc} + + interface + + implementation + + uses + { generic nodes } + ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,ncgopt, + ncgobjc, + { to be able to only parts of the generic code, + the processor specific nodes must be included + after the generic one (FK) + } + nppcadd, + nppccal, +// nppccon, +// nppcflw, +// nppcmem, + ngppcset, + ngppcinl, +// nppcopt, + nppcmat, + nppccnv +// nppcld + ; + +end. diff --git a/closures/compiler/powerpc/cpupara.pas b/closures/compiler/powerpc/cpupara.pas new file mode 100644 index 0000000000..1ee35eb781 --- /dev/null +++ b/closures/compiler/powerpc/cpupara.pas @@ -0,0 +1,709 @@ +{ + Copyright (c) 2002 by Florian Klaempfl + + PowerPC 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. + **************************************************************************** +} +unit cpupara; + +{$i fpcdefs.inc} + + interface + + uses + globtype, + aasmtai,aasmdata, + cpubase, + symconst,symtype,symdef,symsym, + paramgr,parabase,cgbase,cgutils; + + type + tppcparamanager = 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; + function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override; + procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); + 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; varargsparas: boolean):longint; + function parseparaloc(p : tparavarsym;const s : string) : boolean;override; + end; + + implementation + + uses + verbose,systems, + defutil,symtable, + procinfo,cpupi; + + + function tppcparamanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset; + begin + if (target_info.system = system_powerpc_darwin) then + result := [RS_R0,RS_R2..RS_R12] + else + result := [RS_R0,RS_R3..RS_R12]; + end; + + + function tppcparamanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset; + begin + case target_info.abi of + abi_powerpc_aix, + abi_powerpc_sysv: + result := [RS_F0..RS_F13]; + else + internalerror(2003091401); + end; + end; + + + procedure tppcparamanager.getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara); + var + paraloc : pcgparalocation; + begin + cgpara.reset; + cgpara.size:=OS_ADDR; + cgpara.intsize:=sizeof(pint); + cgpara.alignment:=get_para_align(calloption); + paraloc:=cgpara.add_location; + with paraloc^ do + begin + size:=OS_INT; + if (nr<=8) then + begin + if nr=0 then + internalerror(200309271); + loc:=LOC_REGISTER; + register:=newreg(R_INTREGISTER,RS_R2+nr,R_SUBWHOLE); + end + else + begin + loc:=LOC_REFERENCE; + paraloc^.reference.index:=NR_STACK_POINTER_REG; + if (target_info.abi <> abi_powerpc_aix) then + reference.offset:=sizeof(pint)*(nr-8) + else + reference.offset:=sizeof(pint)*(nr); + end; + end; + end; + + + + function getparaloc(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.typ of + orddef: + result:=LOC_REGISTER; + floatdef: + result:=LOC_FPUREGISTER; + enumdef: + result:=LOC_REGISTER; + pointerdef: + result:=LOC_REGISTER; + formaldef: + result:=LOC_REGISTER; + classrefdef: + result:=LOC_REGISTER; + procvardef: + if (target_info.abi = abi_powerpc_aix) or + (p.size = sizeof(pint)) then + result:=LOC_REGISTER + else + result:=LOC_REFERENCE; + recorddef: + if (target_info.abi<>abi_powerpc_aix) or + ((p.size >= 3) and + ((p.size mod 4) <> 0)) then + result:=LOC_REFERENCE + else + result:=LOC_REGISTER; + objectdef: + if is_object(p) then + result:=LOC_REFERENCE + else + result:=LOC_REGISTER; + stringdef: + if is_shortstring(p) or is_longstring(p) then + result:=LOC_REFERENCE + else + result:=LOC_REGISTER; + filedef: + result:=LOC_REGISTER; + arraydef: + result:=LOC_REFERENCE; + setdef: + if is_smallset(p) then + result:=LOC_REGISTER + else + result:=LOC_REFERENCE; + variantdef: + result:=LOC_REFERENCE; + { avoid problems with errornous definitions } + errordef: + result:=LOC_REGISTER; + else + internalerror(2002071001); + end; + end; + + + function tppcparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; + begin + result:=false; + { var,out,constref always require address } + if varspez in [vs_var,vs_out,vs_constref] then + begin + result:=true; + exit; + end; + case def.typ of + variantdef, + formaldef : + result:=true; + { regular procvars must be passed by value, because you cannot pass + the address of a local stack location when calling e.g. + pthread_create with the address of a function (first of all it + expects the address of the function to execute and not the address + of a memory location containing that address, and secondly if you + first store the address on the stack and then pass the address of + this stack location, then this stack location may no longer be + valid when the newly started thread accesses it. + + However, for "procedure of object" we must use the same calling + convention as for "8 byte record" due to the need for + interchangeability with the TMethod record type. + } + procvardef : + result:= + (target_info.abi <> abi_powerpc_aix) and + (def.size <> sizeof(pint)); + recorddef : + result := + (target_info.abi<>abi_powerpc_aix) or + ((varspez = vs_const) and + ((calloption = pocall_mwpascal) or + (not (calloption in [pocall_cdecl,pocall_cppdecl]) and + (def.size > 8) + ) + ) + ); + 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:=not is_smallset(def); + stringdef : + result:=tstringdef(def).stringtype in [st_shortstring,st_longstring]; + end; + end; + + + procedure tppcparamanager.init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword); + begin + case target_info.abi of + abi_powerpc_aix: + cur_stack_offset:=24; + abi_powerpc_sysv: + cur_stack_offset:=8; + else + internalerror(2003051901); + end; + curintreg:=RS_R3; + curfloatreg:=RS_F1; + curmmreg:=RS_M1; + end; + + + procedure tppcparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); + begin + p.funcretloc[side]:=get_funcretloc(p,side,p.returndef); + end; + + + function tppcparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara; + var + paraloc : pcgparalocation; + retcgsize : tcgsize; + begin + result.init; + result.alignment:=get_para_align(p.proccalloption); + { void has no location } + if is_void(def) then + begin + paraloc:=result.add_location; + result.size:=OS_NO; + result.intsize:=0; + paraloc^.size:=OS_NO; + paraloc^.loc:=LOC_VOID; + exit; + end; + { Constructors return self instead of a boolean } + if (p.proctypeoption=potype_constructor) then + begin + retcgsize:=OS_ADDR; + result.intsize:=sizeof(pint); + end + else + begin + retcgsize:=def_cgsize(def); + result.intsize:=def.size; + end; + result.size:=retcgsize; + { Return is passed as var parameter } + if ret_in_param(def,p.proccalloption) then + begin + paraloc:=result.add_location; + paraloc^.loc:=LOC_REFERENCE; + paraloc^.size:=retcgsize; + exit; + end; + + paraloc:=result.add_location; + { Return in FPU register? } + if def.typ=floatdef then + begin + paraloc^.loc:=LOC_FPUREGISTER; + paraloc^.register:=NR_FPU_RESULT_REG; + paraloc^.size:=retcgsize; + end + else + { Return in register } + begin + if retcgsize in [OS_64,OS_S64] then + begin + { low 32bits } + paraloc^.loc:=LOC_REGISTER; + if side=callerside then + paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG + else + paraloc^.register:=NR_FUNCTION_RETURN64_HIGH_REG; + paraloc^.size:=OS_32; + { high 32bits } + paraloc:=result.add_location; + paraloc^.loc:=LOC_REGISTER; + if side=callerside then + paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG + else + paraloc^.register:=NR_FUNCTION_RETURN64_LOW_REG; + paraloc^.size:=OS_32; + end + else + begin + paraloc^.loc:=LOC_REGISTER; + if side=callerside then + paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize)) + else + paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize)); + paraloc^.size:=retcgsize; + end; + end; + end; + + + function tppcparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):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,side,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset,false); + + create_funcretloc_info(p,side); + end; + + + + function tppcparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras:tparalist; + var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword; varargsparas: boolean):longint; + var + stack_offset: longint; + paralen: aint; + nextintreg,nextfloatreg,nextmmreg, maxfpureg : tsuperregister; + paradef : tdef; + paraloc : pcgparalocation; + i : integer; + hp : tparavarsym; + loc : tcgloc; + paracgsize: tcgsize; + sym: tfieldvarsym; + + begin +{$ifdef extdebug} + if po_explicitparaloc in p.procoptions then + internalerror(200411141); +{$endif extdebug} + + result:=0; + nextintreg := curintreg; + nextfloatreg := curfloatreg; + nextmmreg := curmmreg; + stack_offset := cur_stack_offset; + case target_info.abi of + abi_powerpc_aix: + maxfpureg := RS_F13; + abi_powerpc_sysv: + maxfpureg := RS_F8; + else internalerror(2004070912); + end; + + for i:=0 to paras.count-1 do + begin + hp:=tparavarsym(paras[i]); + paradef := hp.vardef; + { Syscall for Morphos can have already a paraloc set } + if (vo_has_explicit_paraloc in hp.varoptions) then + begin + if not(vo_is_syscall_lib in hp.varoptions) then + internalerror(200412153); + continue; + end; + hp.paraloc[side].reset; + { currently only support C-style array of const } + if (p.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_mwpascal]) and + is_array_of_const(paradef) 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 (hp.varspez in [vs_var,vs_out]) or + push_addr_param(hp.varspez,paradef,p.proccalloption) or + is_open_array(paradef) or + is_array_of_const(paradef) then + begin + paradef:=voidpointertype; + loc:=LOC_REGISTER; + paracgsize := OS_ADDR; + paralen := tcgsize2size[OS_ADDR]; + end + else + begin + if not is_special_array(paradef) then + paralen := paradef.size + else + paralen := tcgsize2size[def_cgsize(paradef)]; + if (target_info.abi = abi_powerpc_aix) and + (paradef.typ = recorddef) and + (hp.varspez in [vs_value,vs_const]) then + begin + { if a record has only one field and that field is } + { non-composite (not array or record), it must be } + { passed according to the rules of that type. } + if tabstractrecordsymtable(tabstractrecorddef(paradef).symtable).has_single_field(sym) and + ((sym.vardef.typ=floatdef) or + ((target_info.system=system_powerpc_darwin) and + (sym.vardef.typ in [orddef,enumdef]))) then + begin + paradef:=sym.vardef; + paracgsize:=def_cgsize(paradef); + end + else + begin + paracgsize := int_cgsize(paralen); + end; + end + else + begin + paracgsize:=def_cgsize(paradef); + { for things like formaldef } + if (paracgsize=OS_NO) then + begin + paracgsize:=OS_ADDR; + paralen := tcgsize2size[OS_ADDR]; + end; + end + end; + + loc := getparaloc(paradef); + if varargsparas and + (target_info.abi = abi_powerpc_aix) and + (paradef.typ = floatdef) then + begin + loc := LOC_REGISTER; + if paracgsize = OS_F64 then + paracgsize := OS_64 + else + paracgsize := OS_32; + end; + + hp.paraloc[side].alignment:=std_param_align; + hp.paraloc[side].size:=paracgsize; + hp.paraloc[side].intsize:=paralen; + if (target_info.abi = abi_powerpc_aix) and + (paradef.typ in [recorddef,arraydef]) then + hp.paraloc[side].composite:=true; +{$ifndef cpu64bitaddr} + if (target_info.abi=abi_powerpc_sysv) and + is_64bit(paradef) and + odd(nextintreg-RS_R3) then + inc(nextintreg); +{$endif not cpu64bitaddr} + if (paralen = 0) then + if (paradef.typ = recorddef) then + begin + paraloc:=hp.paraloc[side].add_location; + paraloc^.loc := LOC_VOID; + end + else + internalerror(2005011310); + { can become < 0 for e.g. 3-byte records } + while (paralen > 0) do + begin + paraloc:=hp.paraloc[side].add_location; + { In case of po_delphi_nested_cc, the parent frame pointer + is always passed on the stack. } + if (loc = LOC_REGISTER) and + (nextintreg <= RS_R10) and + (not(vo_is_parentfp in hp.varoptions) or + not(po_delphi_nested_cc in p.procoptions)) then + begin + paraloc^.loc := loc; + { make sure we don't lose whether or not the type is signed } + if (paradef.typ <> orddef) then + paracgsize := int_cgsize(paralen); + if (paracgsize in [OS_NO,OS_64,OS_S64,OS_128,OS_S128]) then + paraloc^.size := OS_INT + else + paraloc^.size := paracgsize; + paraloc^.register:=newreg(R_INTREGISTER,nextintreg,R_SUBNONE); + inc(nextintreg); + dec(paralen,tcgsize2size[paraloc^.size]); + if target_info.abi=abi_powerpc_aix then + inc(stack_offset,align(tcgsize2size[paraloc^.size],4)); + end + else if (loc = LOC_FPUREGISTER) and + (nextfloatreg <= maxfpureg) then + begin + paraloc^.loc:=loc; + paraloc^.size := paracgsize; + paraloc^.register:=newreg(R_FPUREGISTER,nextfloatreg,R_SUBWHOLE); + inc(nextfloatreg); + dec(paralen,tcgsize2size[paraloc^.size]); + { if nextfpureg > maxfpureg, all intregs are already used, since there } + { are less of those available for parameter passing in the AIX abi } + if target_info.abi=abi_powerpc_aix then +{$ifndef cpu64bitaddr} + if (paracgsize = OS_F32) then + begin + inc(stack_offset,4); + if (nextintreg < RS_R11) then + inc(nextintreg); + end + else + begin + inc(stack_offset,8); + if (nextintreg < RS_R10) then + inc(nextintreg,2) + else + nextintreg := RS_R11; + end; +{$else not cpu64bitaddr} + begin + inc(stack_offset,tcgsize2size[paracgsize]); + if (nextintreg < RS_R11) then + inc(nextintreg); + end; +{$endif not cpu64bitaddr} + end + else { LOC_REFERENCE } + begin + paraloc^.loc:=LOC_REFERENCE; + case loc of + LOC_FPUREGISTER: + paraloc^.size:=int_float_cgsize(paralen); + LOC_REGISTER, + LOC_REFERENCE: + paraloc^.size:=int_cgsize(paralen); + else + internalerror(2006011101); + end; + if (side = callerside) then + paraloc^.reference.index:=NR_STACK_POINTER_REG + else + begin + paraloc^.reference.index:=NR_R12; + tppcprocinfo(current_procinfo).needs_frame_pointer := true; + end; + + if (target_info.abi = abi_powerpc_aix) and + (hp.paraloc[side].intsize < 3) then + paraloc^.reference.offset:=stack_offset+(4-paralen) + else + paraloc^.reference.offset:=stack_offset; + + inc(stack_offset,align(paralen,4)); + while (paralen > 0) and + (nextintreg < RS_R11) do + begin + inc(nextintreg); + dec(paralen,sizeof(pint)); + end; + paralen := 0; + end; + end; + end; + curintreg:=nextintreg; + curfloatreg:=nextfloatreg; + curmmreg:=nextmmreg; + cur_stack_offset:=stack_offset; + result:=stack_offset; + end; + + + function tppcparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint; + var + cur_stack_offset: aword; + parasize, l: longint; + curintreg, firstfloatreg, curfloatreg, curmmreg: tsuperregister; + i : integer; + hp: tparavarsym; + paraloc: pcgparalocation; + begin + init_values(curintreg,curfloatreg,curmmreg,cur_stack_offset); + firstfloatreg:=curfloatreg; + + result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,curmmreg,cur_stack_offset, false); + if (p.proccalloption in [pocall_cdecl,pocall_cppdecl,pocall_mwpascal]) then + { just continue loading the parameters in the registers } + begin + result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,curmmreg,cur_stack_offset,true); + { varargs routines have to reserve at least 32 bytes for the AIX abi } + if (target_info.abi = abi_powerpc_aix) and + (result < 32) then + result := 32; + end + else + begin + parasize:=cur_stack_offset; + for i:=0 to varargspara.count-1 do + begin + hp:=tparavarsym(varargspara[i]); + hp.paraloc[callerside].alignment:=4; + paraloc:=hp.paraloc[callerside].add_location; + paraloc^.loc:=LOC_REFERENCE; + paraloc^.size:=def_cgsize(hp.vardef); + paraloc^.reference.index:=NR_STACK_POINTER_REG; + l:=push_size(hp.varspez,hp.vardef,p.proccalloption); + paraloc^.reference.offset:=parasize; + parasize:=parasize+l; + end; + result:=parasize; + end; + if curfloatreg<>firstfloatreg then + include(varargspara.varargsinfo,va_uses_float_reg); + end; + + + function tppcparamanager.parseparaloc(p : tparavarsym;const s : string) : boolean; + var + paraloc : pcgparalocation; + paracgsize : tcgsize; + begin + result:=false; + case target_info.system of + system_powerpc_morphos: + begin + paracgsize:=def_cgsize(p.vardef); + p.paraloc[callerside].alignment:=4; + p.paraloc[callerside].size:=paracgsize; + p.paraloc[callerside].intsize:=tcgsize2size[paracgsize]; + paraloc:=p.paraloc[callerside].add_location; + paraloc^.loc:=LOC_REFERENCE; + paraloc^.size:=paracgsize; + paraloc^.reference.index:=newreg(R_INTREGISTER,RS_R2,R_SUBWHOLE); + { pattern is always uppercase'd } + if s='D0' then + paraloc^.reference.offset:=0 + else if s='D1' then + paraloc^.reference.offset:=4 + else if s='D2' then + paraloc^.reference.offset:=8 + else if s='D3' then + paraloc^.reference.offset:=12 + else if s='D4' then + paraloc^.reference.offset:=16 + else if s='D5' then + paraloc^.reference.offset:=20 + else if s='D6' then + paraloc^.reference.offset:=24 + else if s='D7' then + paraloc^.reference.offset:=28 + else if s='A0' then + paraloc^.reference.offset:=32 + else if s='A1' then + paraloc^.reference.offset:=36 + else if s='A2' then + paraloc^.reference.offset:=40 + else if s='A3' then + paraloc^.reference.offset:=44 + else if s='A4' then + paraloc^.reference.offset:=48 + else if s='A5' then + paraloc^.reference.offset:=52 + { 'A6' (offset 56) is used by mossyscall as libbase, so API + never passes parameters in it, + Indeed, but this allows to declare libbase either explicitly + or let the compiler insert it } + else if s='A6' then + paraloc^.reference.offset:=56 + { 'A7' is the stack pointer on 68k, can't be overwritten + by API calls, so it has no offset } + { 'R12' is special, used internally to support r12base sysv + calling convention } + else if s='R12' then + begin + paraloc^.loc:=LOC_REGISTER; + paraloc^.size:=OS_ADDR; + paraloc^.register:=NR_R12; + end + else + exit; + + { copy to callee side } + p.paraloc[calleeside].add_location^:=paraloc^; + end; + else + internalerror(200404182); + end; + result:=true; + end; + +begin + paramanager:=tppcparamanager.create; +end. diff --git a/closures/compiler/powerpc/cpupi.pas b/closures/compiler/powerpc/cpupi.pas new file mode 100644 index 0000000000..3efec0189a --- /dev/null +++ b/closures/compiler/powerpc/cpupi.pas @@ -0,0 +1,207 @@ +{ + 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 + cutils,globtype, + cgbase,aasmdata, + procinfo,cpuinfo,psub; + + type + tppcprocinfo = class(tcgprocinfo) + needstackframe: boolean; + + { offset where the frame pointer from the outer procedure is stored. } + parent_framepointer_offset : longint; + constructor create(aparent:tprocinfo);override; + procedure set_first_temp_offset;override; + function calc_stackframe_size:longint;override; + + function uses_stack_temps: boolean; + procedure allocate_got_register(list: TAsmList);override; + private + first_save_int_reg, first_save_fpu_reg: tsuperregister; + public + needs_frame_pointer: boolean; + + property get_first_save_int_reg: tsuperregister read first_save_int_reg; + property get_first_save_fpu_reg: tsuperregister read first_save_fpu_reg; + + end; + + + implementation + + uses + globals,systems, + cpubase, + aasmtai, + tgobj,cgobj, + symconst,symsym,paramgr,symutil,symtable, + verbose; + + constructor tppcprocinfo.create(aparent:tprocinfo); + + begin + inherited create(aparent); + first_save_int_reg:=32; + first_save_fpu_reg:=32; + needs_frame_pointer:=false; + end; + + + procedure tppcprocinfo.set_first_temp_offset; + var + ofs : aword; + begin + if not(po_assembler in procdef.procoptions) then + begin + case target_info.abi of + abi_powerpc_aix: + ofs:=maxpushedparasize+LinkageAreaSizeAIX; + abi_powerpc_sysv: + ofs:=maxpushedparasize+LinkageAreaSizeSYSV; + else + internalerror(200402191); + end; + tg.setfirsttemp(ofs); + end + else + begin + if (current_procinfo.procdef.localst.symtabletype=localsymtable) and + (tabstractlocalsymtable(current_procinfo.procdef.localst).count_locals <> 0) then + begin + { at 0(r1), the previous value of r1 will be stored } + tg.setfirsttemp(4); + end + end; + end; + + +(* + procedure tppcprocinfo.after_pass1; + begin + if not(po_assembler in procdef.procoptions) then + begin + if cs_asm_source in current_settings.globalswitches then + aktproccode.insert(Tai_comment.Create(strpnew('Parameter copies start at: r1+'+tostr(procdef.parast.address_fixup)))); + + if cs_asm_source in current_settings.globalswitches then + aktproccode.insert(Tai_comment.Create(strpnew('Locals start at: r1+'+tostr(procdef.localst.address_fixup)))); + firsttemp_offset:=align(procdef.localst.address_fixup+procdef.localst.datasize,16); + if cs_asm_source in current_settings.globalswitches then + aktproccode.insert(Tai_comment.Create(strpnew('Temp. space start: r1+'+tostr(firsttemp_offset)))); + + //!!!! tg.setfirsttemp(firsttemp_offset); + tg.firsttemp:=firsttemp_offset; + tg.lasttemp:=firsttemp_offset; + inherited after_pass1; + end; + end; +*) + + + function tppcprocinfo.uses_stack_temps: boolean; + begin + result := tg.firsttemp <> tg.lasttemp; + end; + + + function tppcprocinfo.calc_stackframe_size:longint; + var + low_nonvol_fpu_reg, regcounter: tsuperregister; + begin + if not (po_assembler in procdef.procoptions) then + begin + first_save_fpu_reg := 32; + first_save_int_reg := 32; + { FIXME: has to be R_F14 instead of R_F8 for SYSV-64bit } + case target_info.abi of + abi_powerpc_aix: + low_nonvol_fpu_reg := RS_F14; + abi_powerpc_sysv: + low_nonvol_fpu_reg := RS_F14; + else + internalerror(2003122903); + end; + for regcounter := low_nonvol_fpu_reg to RS_F31 do + begin + if regcounter in cg.rg[R_FPUREGISTER].used_in_proc then + begin + first_save_fpu_reg := ord(regcounter) - ord(RS_F0); + break; + end; + end; + for regcounter := RS_R13 to RS_R31 do + begin + if regcounter in cg.rg[R_INTREGISTER].used_in_proc then + begin + first_save_int_reg := ord(regcounter) - ord(RS_R0); + break; + end; + end; + if not(pi_do_call in flags) and + (not uses_stack_temps) and + (((target_info.abi = abi_powerpc_aix) and + ((32-first_save_int_reg)*4+(32-first_save_fpu_reg)*8 <= 220)) or + ((target_info.abi = abi_powerpc_sysv) and + (first_save_int_reg + first_save_fpu_reg = 64))) then + begin + { don't allocate a stack frame } + result := (32-first_save_int_reg)*4+(32-first_save_fpu_reg)*8; + needstackframe := false; + end + else + begin + result := (32-first_save_int_reg)*4+(32-first_save_fpu_reg)*8+tg.lasttemp; + result := align(result,16); + needstackframe := result<>0; + end; + end + else + begin + result := align(tg.lasttemp,16); + needstackframe := result<>0; + end; + end; + + + procedure tppcprocinfo.allocate_got_register(list: TAsmList); + begin + if (target_info.system = system_powerpc_darwin) and + (cs_create_pic in current_settings.moduleswitches) then + begin + got := cg.getaddressregister(list); + end; + end; + + +begin + cprocinfo:=tppcprocinfo; +end. + diff --git a/closures/compiler/powerpc/cputarg.pas b/closures/compiler/powerpc/cputarg.pas new file mode 100644 index 0000000000..d96634fc23 --- /dev/null +++ b/closures/compiler/powerpc/cputarg.pas @@ -0,0 +1,99 @@ +{ + 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} + {$ifndef NOTARGETMACOS} + ,t_macos + {$endif} + {$ifndef NOTARGETDARWIN} + ,t_bsd + {$endif} + {$ifndef NOTARGETMORPHOS} + ,t_morph + {$endif} + {$ifndef NOTARGETAMIGA} + ,t_amiga + {$endif} + {$ifndef NOTARGETWII} + ,t_wii + {$endif} + +{************************************** + Assemblers +**************************************} + + {$ifndef NOAGPPCGAS} + ,agppcgas + {$endif} + {$ifndef NOAGPPPCMPW} + ,agppcmpw + {$endif} + {$ifndef NOAGPPCVASM} + ,agppcvasm + {$endif} + +{************************************** + Assembler Readers +**************************************} + + {$ifndef NoRaPPCGas} + ,rappcgas + {$endif NoRaPPCGas} + +{************************************** + Debuginfo +**************************************} + + {$ifndef NoDbgStabs} + ,dbgstabs + {$endif NoDbgStabs} + {$ifndef NoDbgDwarf} + ,dbgdwarf + {$endif NoDbgDwarf} + +{************************************** + Optimizer +**************************************} + + {$ifndef NOOPT} + , aoptcpu + {$endif NOOPT} + ; + +end. diff --git a/closures/compiler/powerpc/itcpugas.pas b/closures/compiler/powerpc/itcpugas.pas new file mode 100644 index 0000000000..31ff05fdc0 --- /dev/null +++ b/closures/compiler/powerpc/itcpugas.pas @@ -0,0 +1,151 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit contains the PowerPC 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 + gas_op2str : array[tasmop] of string[14] = ('<none>', + 'add','add.','addo','addo.','addc','addc.','addco','addco.', + 'adde','adde.','addeo','addeo.','addi','addic','addic.','addis', + 'addme','addme.','addmeo','addmeo.','addze','addze.','addzeo', + 'addzeo.','and','and.','andc','andc.','andi.','andis.','b', + 'ba','bl','bla','bc','bca','bcl','bcla','bcctr','bcctrl','bclr', + 'bclrl','cmp','cmpi','cmpl','cmpli','cntlzw','cntlzw.','crand', + 'crandc','creqv','crnand','crnor','cror','crorc','crxor','dcba', + 'dcbf','dcbi','dcbst','dcbt','dcbtst','dcbz','divw','divw.','divwo','divwo.', + 'divwu','divwu.','divwuo','divwuo.','eciwx','ecowx','eieio','eqv', + 'eqv.','extsb','extsb.','extsh','extsh.','fabs','fabs.','fadd', + 'fadd.','fadds','fadds.','fcmpo','fcmpu','fctid','fctid.','fctidz', + 'fctidz.','fctiw','fctiw.','fctiwz', + 'fctiwz.','fdiv','fdiv.','fdivs','fdivs.','fmadd','fmadd.','fmadds', + 'fmadds.','fmr','fmsub','fmsub.','fmsubs','fmsubs.','fmul','fmul.', + 'fmuls','fmuls.','fnabs','fnabs.','fneg','fneg.','fnmadd', + 'fnmadd.','fnmadds','fnmadds.','fnmsub','fnmsub.','fnmsubs', + 'fnmsubs.','fres','fres.','frsp','frsp.','frsqrte','frsqrte.', + 'fsel','fsel.','fsqrt','fsqrt.','fsqrts','fsqrts.','fsub','fsub.', + 'fsubs','fsubs.','icbi','isync','lbz','lbzu','lbzux','lbzx', + 'lfd','lfdu','lfdux','lfdx','lfs','lfsu','lfsux','lfsx','lha', + 'lhau','lhaux','lhax','lhbrx','lhz','lhzu','lhzux','lhzx','lmw', + 'lswi','lswx','lwarx','lwbrx','lwz','lwzu','lwzux','lwzx','mcrf', + 'mcrfs','mcrxr','mfcr','mffs','mffs.','mfmsr','mfspr','mfsr', + 'mfsrin','mftb','mtcrf','mtfsb0','mtfsb1','mtfsf','mtfsf.', + 'mtfsfi','mtfsfi.','mtmsr','mtspr','mtsr','mtsrin','mulhw', + 'mulhw.','mulhwu','mulhwu.','mulli','mullw','mullw.','mullwo', + 'mullwo.','nand','nand.','neg','neg.','nego','nego.','nor','nor.', + 'or','or.','orc','orc.','ori','oris', 'rfi', 'rlwimi', 'rlwimi.', + 'rlwinm', 'rlwinm.','rlwnm','rlwnm.','sc','slw', 'slw.', 'sraw', 'sraw.', + 'srawi', 'srawi.','srw', 'srw.', 'stb', 'stbu', 'stbux','stbx','stfd', + 'stfdu', 'stfdux', 'stfdx', 'stfiwx', 'stfs', 'stfsu', 'stfsux', 'stfsx', + 'sth', 'sthbrx', 'sthu', 'sthux', 'sthx', 'stmw', 'stswi', 'stswx', 'stw', + 'stwbrx', 'stwcx.', 'stwu', 'stwux', 'stwx', 'subf', 'subf.', 'subfo', + 'subfo.', 'subfc', 'subc.', 'subfco', 'subfco.', 'subfe', 'subfe.', + 'subfeo', 'subfeo.', 'subfic', 'subfme', 'subfme.', 'subfmeo', 'subfmeo.', + 'subfze', 'subfze.', 'subfzeo', 'subfzeo.', 'sync', 'tlbia', 'tlbie', + 'tlbsync', 'tw', 'twi', 'xor', 'xor.', 'xori', 'xoris', + { some simplified mnemonics } + 'subi', 'subis', 'subic', 'subic.', 'sub', 'sub.', 'subo', 'subo.', + 'subc', 'subc.', 'subco', 'subco.', 'cmpwi', 'cmpw', 'cmplwi', 'cmplw', + 'extlwi', 'extlwi.', 'extrwi', 'extrwi.', 'inslwi', 'inslwi.', 'insrwi', + 'insrwi.', 'rotlwi', 'rotlwi.', 'rotlw', 'rotlw.', 'slwi', 'slwi.', + 'srwi', 'srwi.', 'clrlwi', 'clrlwi.', 'clrrwi', 'clrrwi.', 'clrslwi', + 'clrslwi.', 'blr', 'bctr', 'blrl', 'bctrl', 'crset', 'crclr', 'crmove', + 'crnot', 'mt', 'mf','nop', 'li', 'lis', 'la', 'mr','mr.','not', 'not.', + 'mtcr', 'mtlr', 'mflr','mtctr', 'mfctr', 'mftbu', 'mfxer'); + + function gas_regnum_search(const s:string):Tregister; + function gas_regname(r:Tregister):string; + + +implementation + + uses + globtype,globals,aasmbase, + cutils,verbose, systems; + + const + gas_regname_table : array[tregisterindex] of string[7] = ( + {$i rppcgas.inc} + ); + + gas_regname_short_table : array[tregisterindex] of string[7] = ( + {$i rppcgss.inc} + ); + + gas_regname_index : array[tregisterindex] of tregisterindex = ( + {$i rppcgri.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 : longint; + begin + p:=findreg_by_number(r); + if p<>0 then + {The GNU assembler only accepts numbers and no full register names (at least in older versions). To + make the assembler code more readable, we define macros at the start of all assembler files we write + to redefine r1..r31 and f1..f31 to 1..31, and then use the full register names. + + However, we do not do this for smart linked files since that would cause a lot of (mostly useless) + overhead. In theory, we could also not do it if "-a" is not used. The Mac OS X assembler (which is + based on GNU as) "natively" supports full register names.} + if create_smartlink_library and + (target_info.system <> system_powerpc_darwin) then + result:=gas_regname_short_table[p] + else + result:=gas_regname_table[p] + else + result:=generic_regname(r); + end; + +end. diff --git a/closures/compiler/powerpc/nppcadd.pas b/closures/compiler/powerpc/nppcadd.pas new file mode 100644 index 0000000000..f72f6cf767 --- /dev/null +++ b/closures/compiler/powerpc/nppcadd.pas @@ -0,0 +1,965 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl and Jonas Maebe + + Code generation for add nodes on the PowerPC + + 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 nppcadd; + +{$i fpcdefs.inc} + +interface + + uses + node,nadd,ncgadd,ngppcadd,cpubase; + + type + tppcaddnode = class(tgenppcaddnode) + procedure pass_generate_code;override; + protected + function use_generic_mul32to64: boolean; override; + private + procedure emit_compare(unsigned : boolean); override; +{$ifdef SUPPORT_MMX} + procedure second_addmmx;override; +{$endif SUPPORT_MMX} + procedure second_add64bit;override; + end; + + implementation + + uses + globtype,systems, + cutils,verbose,globals, + symconst,symdef,paramgr, + aasmbase,aasmtai,aasmdata,aasmcpu,defutil,htypechk, + cgbase,cpuinfo,pass_1,pass_2,regvars, + cpupara,cgcpu,cgutils,procinfo, + ncon,nset, + ncgutil,tgobj,rgobj,rgcpu,cgobj,cg64f32; + + +{***************************************************************************** + Pass 1 +*****************************************************************************} + + function tppcaddnode.use_generic_mul32to64: boolean; + begin + result := false; + end; + +{***************************************************************************** + Helpers +*****************************************************************************} + + procedure tppcaddnode.emit_compare(unsigned: boolean); + var + op : tasmop; + tmpreg : tregister; + useconst : boolean; + begin + // get the constant on the right if there is one + if (left.location.loc = LOC_CONSTANT) then + swapleftright; + // can we use an immediate, or do we have to load the + // constant in a register first? + if (right.location.loc = LOC_CONSTANT) then + begin +{$ifdef dummy} + if (right.location.size in [OS_64,OS_S64]) and (hi(right.location.value64)<>0) and ((hi(right.location.value64)<>$ffffffff) or unsigned) then + internalerror(2002080301); +{$endif extdebug} + if (nodetype in [equaln,unequaln]) then + if (unsigned and + (aword(right.location.value) > high(word))) or + (not unsigned and + (aint(right.location.value) < low(smallint)) or + (aint(right.location.value) > high(smallint))) then + { we can then maybe use a constant in the 'othersigned' case + (the sign doesn't matter for // equal/unequal)} + unsigned := not unsigned; + + if (unsigned and + (aword(right.location.value) <= high(word))) or + (not(unsigned) and + (aint(right.location.value) >= low(smallint)) and + (aint(right.location.value) <= high(smallint))) then + useconst := true + else + begin + useconst := false; + tmpreg := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT, + right.location.value,tmpreg); + end + end + else + useconst := false; + location.loc := LOC_FLAGS; + location.resflags := getresflags; + if not unsigned then + if useconst then + op := A_CMPWI + else + op := A_CMPW + else + if useconst then + op := A_CMPLWI + else + op := A_CMPLW; + + if (right.location.loc = LOC_CONSTANT) then + begin + if useconst then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(op,left.location.register,longint(right.location.value))) + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,left.location.register,tmpreg)); + end + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op, + left.location.register,right.location.register)); + end; + + +{***************************************************************************** + Add64bit +*****************************************************************************} + + procedure tppcaddnode.second_add64bit; + var + op : TOpCG; + op1,op2 : TAsmOp; + cmpop, + unsigned : boolean; + + + procedure emit_cmp64_hi; + + var + oldleft, oldright: tlocation; + begin + // put the high part of the location in the low part + location_copy(oldleft,left.location); + location_copy(oldright,right.location); + if left.location.loc = LOC_CONSTANT then + left.location.value64 := left.location.value64 shr 32 + else + left.location.register64.reglo := left.location.register64.reghi; + if right.location.loc = LOC_CONSTANT then + right.location.value64 := right.location.value64 shr 32 + else + right.location.register64.reglo := right.location.register64.reghi; + + // and call the normal emit_compare + emit_compare(unsigned); + location_copy(left.location,oldleft); + location_copy(right.location,oldright); + end; + + + procedure emit_cmp64_lo; + + begin + emit_compare(true); + end; + + + procedure firstjmp64bitcmp; + + var + oldnodetype: tnodetype; + begin +{$ifdef OLDREGVARS} + load_all_regvars(current_asmdata.CurrAsmList); +{$endif OLDREGVARS} + { the jump the sequence is a little bit hairy } + case nodetype of + ltn,gtn: + begin + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags,current_procinfo.CurrTrueLabel); + { cheat a little bit for the negative test } + toggleflag(nf_swapped); + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags,current_procinfo.CurrFalseLabel); + toggleflag(nf_swapped); + end; + lten,gten: + begin + oldnodetype:=nodetype; + if nodetype=lten then + nodetype:=ltn + else + nodetype:=gtn; + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags,current_procinfo.CurrTrueLabel); + { cheat for the negative test } + if nodetype=ltn then + nodetype:=gtn + else + nodetype:=ltn; + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags,current_procinfo.CurrFalseLabel); + nodetype:=oldnodetype; + end; + equaln: + begin + nodetype := unequaln; + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags,current_procinfo.CurrFalseLabel); + nodetype := equaln; + end; + unequaln: + begin + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags,current_procinfo.CurrTrueLabel); + end; + end; + end; + + + procedure secondjmp64bitcmp; + + begin + { the jump the sequence is a little bit hairy } + case nodetype of + ltn,gtn,lten,gten: + begin + { the comparison of the low dword always has } + { to be always unsigned! } + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags,current_procinfo.CurrTrueLabel); + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + end; + equaln: + begin + nodetype := unequaln; + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags,current_procinfo.CurrFalseLabel); + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel); + nodetype := equaln; + end; + unequaln: + begin + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags,current_procinfo.CurrTrueLabel); + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + end; + end; + end; + + + var + tempreg64: tregister64; + + begin + firstcomplex(self); + + pass_left_and_right; + + cmpop:=false; + unsigned:=((left.resultdef.typ=orddef) and + (torddef(left.resultdef).ordtype=u64bit)) or + ((right.resultdef.typ=orddef) and + (torddef(right.resultdef).ordtype=u64bit)); + case nodetype of + addn : + begin + op:=OP_ADD; + end; + subn : + begin + op:=OP_SUB; + if (nf_swapped in flags) then + swapleftright; + end; + ltn,lten, + gtn,gten, + equaln,unequaln: + begin + op:=OP_NONE; + cmpop:=true; + end; + xorn: + op:=OP_XOR; + orn: + op:=OP_OR; + andn: + op:=OP_AND; + muln: + begin + { should be handled in pass_1 (JM) } + if not(torddef(left.resultdef).ordtype in [U32bit,s32bit]) or + (torddef(left.resultdef).typ <> torddef(right.resultdef).typ) then + internalerror(200109051); + { handled separately } + op := OP_NONE; + end; + else + internalerror(2002072705); + end; + + if not cmpop then + location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); + + load_left_right(cmpop,((cs_check_overflow in current_settings.localswitches) and + (nodetype in [addn,subn])) or (nodetype = muln)); + + if (nodetype <> muln) and + (not(cs_check_overflow in current_settings.localswitches) or + not(nodetype in [addn,subn])) then + begin + case nodetype of + ltn,lten, + gtn,gten: + begin + emit_cmp64_hi; + firstjmp64bitcmp; + emit_cmp64_lo; + secondjmp64bitcmp; + end; + equaln,unequaln: + begin + // instead of doing a complicated compare, do + // (left.hi xor right.hi) or (left.lo xor right.lo) + // (somewhate optimized so that no superfluous 'mr's are + // generated) + if (left.location.loc = LOC_CONSTANT) then + swapleftright; + if (right.location.loc = LOC_CONSTANT) then + begin + if left.location.loc = LOC_REGISTER then + begin + tempreg64.reglo := left.location.register64.reglo; + tempreg64.reghi := left.location.register64.reghi; + end + else + begin + if (aint(right.location.value64) <> 0) then + tempreg64.reglo := cg.getintregister(current_asmdata.CurrAsmList,OS_32) + else + tempreg64.reglo := left.location.register64.reglo; + if ((right.location.value64 shr 32) <> 0) then + tempreg64.reghi := cg.getintregister(current_asmdata.CurrAsmList,OS_32) + else + tempreg64.reghi := left.location.register64.reghi; + end; + + if (aint(right.location.value64) <> 0) then + { negative values can be handled using SUB, } + { positive values < 65535 using XOR. } + if (longint(right.location.value64) >= -32767) and + (longint(right.location.value64) < 0) then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT, + aint(right.location.value64), + left.location.register64.reglo,tempreg64.reglo) + else + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_INT, + aint(right.location.value64), + left.location.register64.reglo,tempreg64.reglo); + + if ((right.location.value64 shr 32) <> 0) then + if (longint(right.location.value64 shr 32) >= -32767) and + (longint(right.location.value64 shr 32) < 0) then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT, + aint(right.location.value64 shr 32), + left.location.register64.reghi,tempreg64.reghi) + else + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_INT, + aint(right.location.value64 shr 32), + left.location.register64.reghi,tempreg64.reghi); + end + else + begin + tempreg64.reglo := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + tempreg64.reghi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg64.a_op64_reg_reg_reg(current_asmdata.CurrAsmList,OP_XOR,location.size, + left.location.register64,right.location.register64, + tempreg64); + end; + + cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_R0); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_OR_,NR_R0, + tempreg64.reglo,tempreg64.reghi)); + cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_R0); + + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags := getresflags; + end; + xorn,orn,andn,addn: + begin + location.register64.reglo := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + location.register64.reghi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + + if (left.location.loc = LOC_CONSTANT) then + swapleftright; + if (right.location.loc = LOC_CONSTANT) then + cg64.a_op64_const_reg_reg(current_asmdata.CurrAsmList,op,location.size,right.location.value64, + left.location.register64,location.register64) + else + cg64.a_op64_reg_reg_reg(current_asmdata.CurrAsmList,op,location.size,right.location.register64, + left.location.register64,location.register64); + end; + subn: + begin + location.register64.reglo := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + location.register64.reghi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + if left.location.loc <> LOC_CONSTANT then + begin + if right.location.loc <> LOC_CONSTANT then + // reg64 - reg64 + cg64.a_op64_reg_reg_reg(current_asmdata.CurrAsmList,OP_SUB,location.size, + right.location.register64,left.location.register64, + location.register64) + else + // reg64 - const64 + cg64.a_op64_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,location.size, + right.location.value64,left.location.register64, + location.register64) + end + else if ((left.location.value64 shr 32) = 0) then + begin + if (int64(left.location.value64) >= low(smallint)) and + (int64(left.location.value64) <= high(smallint)) then + begin + // consts16 - reg64 + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBFIC, + location.register64.reglo,right.location.register64.reglo, + left.location.value)); + end + else + begin + // const32 - reg64 + location_force_reg(current_asmdata.CurrAsmList,left.location, + OS_32,true); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBC, + location.register64.reglo,left.location.register64.reglo, + right.location.register64.reglo)); + end; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_SUBFZE, + location.register64.reghi,right.location.register64.reghi)); + end + else if (aint(left.location.value64) = 0) then + begin + // (const32 shl 32) - reg64 + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBFIC, + location.register64.reglo,right.location.register64.reglo,0)); + left.location.value64 := left.location.value64 shr 32; + location_force_reg(current_asmdata.CurrAsmList,left.location,OS_32,true); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBFE, + location.register64.reghi,right.location.register64.reghi, + left.location.register)); + end + else + begin + // const64 - reg64 + location_force_reg(current_asmdata.CurrAsmList,left.location, + def_cgsize(left.resultdef),false); + cg64.a_op64_reg_reg_reg(current_asmdata.CurrAsmList,OP_SUB,location.size, + right.location.register64,left.location.register64, + location.register64); + end; + end; + else + internalerror(2002072803); + end; + end + else + begin + if is_signed(resultdef) then + begin + case nodetype of + addn: + begin + op1 := A_ADDC; + op2 := A_ADDEO; + end; + subn: + begin + op1 := A_SUBC; + op2 := A_SUBFEO; + end; + muln: + begin + op1 := A_MULLW; + op2 := A_MULHW + end; + else + internalerror(2002072806); + end + end + else + begin + case nodetype of + addn: + begin + op1 := A_ADDC; + op2 := A_ADDE; + end; + subn: + begin + op1 := A_SUBC; + op2 := A_SUBFE; + end; + muln: + begin + op1 := A_MULLW; + op2 := A_MULHWU + end; + end; + end; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op1,location.register64.reglo, + left.location.register64.reglo,right.location.register64.reglo)); + + if (nodetype <> muln) then + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op2,location.register64.reghi, + right.location.register64.reghi,left.location.register64.reghi)); + if not(is_signed(resultdef)) then + if nodetype = addn then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMPLW,location.register64.reghi,left.location.register64.reghi)) + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMPLW,left.location.register64.reghi,location.register64.reghi)); + cg.g_overflowcheck(current_asmdata.CurrAsmList,location,resultdef); + end + else + begin + { 32 * 32 -> 64 cannot overflow } + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op2,location.register64.reghi, + left.location.register64.reglo,right.location.register64.reglo)); + end + end; + + { set result location } + { (emit_compare sets it to LOC_FLAGS for compares, so set the } + { real location only now) (JM) } + if cmpop and + not(nodetype in [equaln,unequaln]) then + location_reset(location,LOC_JUMP,OS_NO); + end; + + +{***************************************************************************** + AddMMX +*****************************************************************************} + +{$ifdef SUPPORT_MMX} + procedure ti386addnode.second_addmmx; + var + op : TAsmOp; + cmpop : boolean; + mmxbase : tmmxtype; + hregister : tregister; + begin + pass_left_and_right; + + cmpop:=false; + mmxbase:=mmx_type(left.resultdef); + case nodetype of + addn : + begin + if (cs_mmx_saturation in current_settings.localswitches) then + begin + case mmxbase of + mmxs8bit: + op:=A_PADDSB; + mmxu8bit: + op:=A_PADDUSB; + mmxs16bit,mmxfixed16: + op:=A_PADDSB; + mmxu16bit: + op:=A_PADDUSW; + end; + end + else + begin + case mmxbase of + mmxs8bit,mmxu8bit: + op:=A_PADDB; + mmxs16bit,mmxu16bit,mmxfixed16: + op:=A_PADDW; + mmxs32bit,mmxu32bit: + op:=A_PADDD; + end; + end; + end; + muln : + begin + case mmxbase of + mmxs16bit,mmxu16bit: + op:=A_PMULLW; + mmxfixed16: + op:=A_PMULHW; + end; + end; + subn : + begin + if (cs_mmx_saturation in current_settings.localswitches) then + begin + case mmxbase of + mmxs8bit: + op:=A_PSUBSB; + mmxu8bit: + op:=A_PSUBUSB; + mmxs16bit,mmxfixed16: + op:=A_PSUBSB; + mmxu16bit: + op:=A_PSUBUSW; + end; + end + else + begin + case mmxbase of + mmxs8bit,mmxu8bit: + op:=A_PSUBB; + mmxs16bit,mmxu16bit,mmxfixed16: + op:=A_PSUBW; + mmxs32bit,mmxu32bit: + op:=A_PSUBD; + end; + end; + end; + xorn: + op:=A_PXOR; + orn: + op:=A_POR; + andn: + op:=A_PAND; + else + internalerror(200403183); + end; + + { left and right no register? } + { then one must be demanded } + if (left.location.loc<>LOC_MMXREGISTER) then + begin + if (right.location.loc=LOC_MMXREGISTER) then + begin + location_swap(left.location,right.location); + toggleflag(nf_swapped); + end + else + begin + { register variable ? } + if (left.location.loc=LOC_CMMXREGISTER) then + begin + hregister:=rg.getregistermm(current_asmdata.CurrAsmList); + emit_reg_reg(A_MOVQ,S_NO,left.location.register,hregister); + end + else + begin + if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then + internalerror(200203245); + + location_release(current_asmdata.CurrAsmList,left.location); + + hregister:=rg.getregistermm(current_asmdata.CurrAsmList); + emit_ref_reg(A_MOVQ,S_NO,left.location.reference,hregister); + end; + + location_reset(left.location,LOC_MMXREGISTER,OS_NO); + left.location.register:=hregister; + end; + end; + + { at this point, left.location.loc should be LOC_MMXREGISTER } + if right.location.loc<>LOC_MMXREGISTER then + begin + if (nodetype=subn) and (nf_swapped in flags) then + begin + if right.location.loc=LOC_CMMXREGISTER then + begin + emit_reg_reg(A_MOVQ,S_NO,right.location.register,R_MM7); + emit_reg_reg(op,S_NO,left.location.register,R_MM7); + emit_reg_reg(A_MOVQ,S_NO,R_MM7,left.location.register); + end + else + begin + if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then + internalerror(200203247); + emit_ref_reg(A_MOVQ,S_NO,right.location.reference,R_MM7); + emit_reg_reg(op,S_NO,left.location.register,R_MM7); + emit_reg_reg(A_MOVQ,S_NO,R_MM7,left.location.register); + location_release(current_asmdata.CurrAsmList,right.location); + end; + end + else + begin + if (right.location.loc=LOC_CMMXREGISTER) then + begin + emit_reg_reg(op,S_NO,right.location.register,left.location.register); + end + else + begin + if not(right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then + internalerror(200203246); + emit_ref_reg(op,S_NO,right.location.reference,left.location.register); + location_release(current_asmdata.CurrAsmList,right.location); + end; + end; + end + else + begin + { right.location=LOC_MMXREGISTER } + if (nodetype=subn) and (nf_swapped in flags) then + begin + emit_reg_reg(op,S_NO,left.location.register,right.location.register); + location_swap(left.location,right.location); + toggleflag(nf_swapped); + end + else + begin + emit_reg_reg(op,S_NO,right.location.register,left.location.register); + end; + end; + + location_freetemp(current_asmdata.CurrAsmList,right.location); + location_release(current_asmdata.CurrAsmList,right.location); + if cmpop then + begin + location_freetemp(current_asmdata.CurrAsmList,left.location); + location_release(current_asmdata.CurrAsmList,left.location); + end; + set_result_location(cmpop,true); + end; +{$endif SUPPORT_MMX} + + +{***************************************************************************** + pass_2 +*****************************************************************************} + + procedure tppcaddnode.pass_generate_code; + { is also being used for xor, and "mul", "sub, or and comparative } + { operators } + var + cgop : topcg; + op : tasmop; + tmpreg : tregister; + hl : tasmlabel; + cmpop : boolean; + { true, if unsigned types are compared } + unsigned : boolean; + checkoverflow : boolean; + + begin + { to make it more readable, string and set (not smallset!) have their + own procedures } + case left.resultdef.typ of + orddef : + begin + { handling boolean expressions } + if is_boolean(left.resultdef) and + is_boolean(right.resultdef) then + begin + second_addboolean; + exit; + end + { 64bit operations } + else if is_64bit(resultdef) or + is_64bit(left.resultdef) then + begin + second_add64bit; + exit; + end; + end; + stringdef : + begin + internalerror(2002072402); + exit; + end; + setdef : + begin + { normalsets are already handled in pass1 } + if not is_smallset(left.resultdef) then + internalerror(200109042); + second_addsmallset; + exit; + end; + arraydef : + begin +{$ifdef SUPPORT_MMX} + if is_mmx_able_array(left.resultdef) then + begin + second_addmmx; + exit; + end; +{$endif SUPPORT_MMX} + end; + floatdef : + begin + second_addfloat; + exit; + end; + end; + + { defaults } + cmpop:=nodetype in [ltn,lten,gtn,gten,equaln,unequaln]; + unsigned:=not(is_signed(left.resultdef)) or + not(is_signed(right.resultdef)); + + pass_left_and_right; + + { Convert flags to register first } + { can any of these things be in the flags actually?? (JM) } + + if (left.location.loc = LOC_FLAGS) or + (right.location.loc = LOC_FLAGS) then + internalerror(2002072602); + + { set result location } + if not cmpop then + location_reset(location,LOC_REGISTER,def_cgsize(resultdef)) + else + location_reset(location,LOC_FLAGS,OS_NO); + + checkoverflow:= + (nodetype in [addn,subn,muln]) and + (cs_check_overflow in current_settings.localswitches) and + (left.resultdef.typ<>pointerdef) and + (right.resultdef.typ<>pointerdef); + + load_left_right(cmpop, checkoverflow); + + if not(cmpop) then + location.register := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + + if not(checkoverflow) then + begin + case nodetype of + addn, muln, xorn, orn, andn: + begin + case nodetype of + addn: + cgop := OP_ADD; + muln: + if unsigned then + cgop := OP_MUL + else + cgop := OP_IMUL; + xorn: + cgop := OP_XOR; + orn: + cgop := OP_OR; + andn: + cgop := OP_AND; + end; + if (left.location.loc = LOC_CONSTANT) then + swapleftright; + if (right.location.loc <> LOC_CONSTANT) then + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,cgop,OS_INT, + left.location.register,right.location.register, + location.register) + else + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,cgop,OS_INT, + right.location.value,left.location.register, + location.register); + end; + subn: + begin + if (nf_swapped in flags) then + swapleftright; + if left.location.loc <> LOC_CONSTANT then + if right.location.loc <> LOC_CONSTANT then + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT, + right.location.register,left.location.register, + location.register) + else + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT, + right.location.value,left.location.register, + location.register) + else + if (longint(left.location.value) >= low(smallint)) and + (longint(left.location.value) <= high(smallint)) then + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBFIC, + location.register,right.location.register, + longint(left.location.value))); + end + else + begin + tmpreg := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT, + left.location.value,tmpreg); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT, + right.location.register,tmpreg,location.register); + end; + end; + ltn,lten,gtn,gten,equaln,unequaln : + begin + emit_compare(unsigned); + end; + end; + end + else + // overflow checking is on and we have an addn, subn or muln + begin + if is_signed(resultdef) then + begin + case nodetype of + addn: + op := A_ADDO; + subn: + begin + op := A_SUBO; + if (nf_swapped in flags) then + swapleftright; + end; + muln: + op := A_MULLWO; + else + internalerror(2002072601); + end; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,location.register, + left.location.register,right.location.register)); + cg.g_overflowcheck(current_asmdata.CurrAsmList,location,resultdef); + end + else + begin + case nodetype of + addn: + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ADD,location.register, + left.location.register,right.location.register)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMPLW,location.register,left.location.register)); + cg.g_overflowcheck(current_asmdata.CurrAsmList,location,resultdef); + end; + subn: + begin + if nf_swapped in flags then + swapleftright; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUB,location.register, + left.location.register,right.location.register)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMPLW,left.location.register,location.register)); + cg.g_overflowcheck(current_asmdata.CurrAsmList,location,resultdef); + end; + muln: + begin + { calculate the upper 32 bits of the product, = 0 if no overflow } + cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_R0); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULHWU_,NR_R0, + left.location.register,right.location.register)); + cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_R0); + { calculate the real result } + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULLW,location.register, + left.location.register,right.location.register)); + { g_overflowcheck generates a OC_AE instead of OC_EQ :/ } + current_asmdata.getjumplabel(hl); + tcgppc(cg).a_jmp_cond(current_asmdata.CurrAsmList,OC_EQ,hl); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false); + cg.a_label(current_asmdata.CurrAsmList,hl); + end; + end; + end; + end; + end; + +begin + caddnode:=tppcaddnode; +end. diff --git a/closures/compiler/powerpc/nppccal.pas b/closures/compiler/powerpc/nppccal.pas new file mode 100644 index 0000000000..44b6cebc39 --- /dev/null +++ b/closures/compiler/powerpc/nppccal.pas @@ -0,0 +1,147 @@ +{ + Copyright (c) 2002 by Florian Klaempfl + + Implements the PowerPC 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 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 nppccal; + +{$i fpcdefs.inc} + +interface + + uses + symdef,node,ncal,ncgcal; + + type + tppccallnode = class(tcgcallnode) + procedure extra_call_code;override; + procedure do_syscall;override; + end; + + +implementation + + uses + globtype,systems, + cutils,verbose,globals, + symconst,symbase,symsym,symtable,defutil,paramgr,parabase, + cgbase,pass_2, + cpuinfo,cpubase,aasmbase,aasmtai,aasmdata,aasmcpu, + nmem,nld,ncnv, + ncgutil,cgutils,cgobj,tgobj,regvars,rgobj,rgcpu, + cg64f32,cgcpu,cpupi,procinfo; + + + procedure tppccallnode.extra_call_code; + begin + if assigned(varargsparas) then + begin + if (target_info.abi = abi_powerpc_sysv) then + begin + if va_uses_float_reg in varargsparas.varargsinfo then + current_asmdata.CurrAsmList.concat(taicpu.op_const_const_const(A_CREQV,6,6,6)) + else + current_asmdata.CurrAsmList.concat(taicpu.op_const_const_const(A_CRXOR,6,6,6)); + end; + end; + end; + + + procedure tppccallnode.do_syscall; + var + tmpref: treference; + begin + case target_info.system of + system_powerpc_amiga: + begin + // one syscall convention for Amiga/PowerPC + // which is very similar to basesysv on MorphOS + cg.getcpuregister(current_asmdata.CurrAsmList,NR_R0); + reference_reset_base(tmpref,NR_R3,tprocdef(procdefinition).extnumber,sizeof(pint)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_ref(A_LWZ,NR_R0,tmpref)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_MTCTR,NR_R0)); + current_asmdata.CurrAsmList.concat(taicpu.op_none(A_BCTRL)); + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_R0); + end; + system_powerpc_morphos: + begin + if (po_syscall_sysv in tprocdef(procdefinition).procoptions) or + (po_syscall_sysvbase in tprocdef(procdefinition).procoptions) then + begin + cg.getcpuregister(current_asmdata.CurrAsmList,NR_R0); + cg.getcpuregister(current_asmdata.CurrAsmList,NR_R12); + + reference_reset(tmpref,sizeof(pint)); + tmpref.symbol:=current_asmdata.RefAsmSymbol(tstaticvarsym(tprocdef(procdefinition).libsym).mangledname); + tmpref.refaddr:=addr_higha; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_ref(A_LIS,NR_R12,tmpref)); + tmpref.base:=NR_R12; + tmpref.refaddr:=addr_low; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_ref(A_LWZ,NR_R12,tmpref)); + + reference_reset_base(tmpref,NR_R12,-tprocdef(procdefinition).extnumber,sizeof(pint)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_ref(A_LWZ,NR_R0,tmpref)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_MTCTR,NR_R0)); + current_asmdata.CurrAsmList.concat(taicpu.op_none(A_BCTRL)); + + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_R12); + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_R0); + end + else if (po_syscall_basesysv in tprocdef(procdefinition).procoptions) or + (po_syscall_r12base in tprocdef(procdefinition).procoptions) then + begin + cg.getcpuregister(current_asmdata.CurrAsmList,NR_R0); + if (po_syscall_basesysv in tprocdef(procdefinition).procoptions) then + reference_reset_base(tmpref,NR_R3,-tprocdef(procdefinition).extnumber,sizeof(pint)) + else + reference_reset_base(tmpref,NR_R12,-tprocdef(procdefinition).extnumber,sizeof(pint)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_ref(A_LWZ,NR_R0,tmpref)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_MTCTR,NR_R0)); + current_asmdata.CurrAsmList.concat(taicpu.op_none(A_BCTRL)); + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_R0); + end + else if po_syscall_legacy in tprocdef(procdefinition).procoptions then + begin + cg.getcpuregister(current_asmdata.CurrAsmList,NR_R0); + cg.getcpuregister(current_asmdata.CurrAsmList,NR_R3); + + { store call offset into R3 } + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_LI,NR_R3,-tprocdef(procdefinition).extnumber)); + + { prepare LR, and call function } + reference_reset_base(tmpref,NR_R2,100,4); { 100 ($64) is EmulDirectCallOS offset } + current_asmdata.CurrAsmList.concat(taicpu.op_reg_ref(A_LWZ,NR_R0,tmpref)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_MTLR,NR_R0)); + current_asmdata.CurrAsmList.concat(taicpu.op_none(A_BLRL)); + + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_R3); + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_R0); + end + else + internalerror(2005010403); + end; + else + internalerror(2004042901); + end; + end; + + +begin + ccallnode:=tppccallnode; +end. diff --git a/closures/compiler/powerpc/nppccnv.pas b/closures/compiler/powerpc/nppccnv.pas new file mode 100644 index 0000000000..e9fb33f1b8 --- /dev/null +++ b/closures/compiler/powerpc/nppccnv.pas @@ -0,0 +1,231 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate PowerPC 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 nppccnv; + +{$i fpcdefs.inc} + +interface + + uses + node,ncnv,ncgcnv,ngppccnv; + + type + tppctypeconvnode = class(tgenppctypeconvnode) + protected + { 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_set_to_set;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,aasmdata, + defutil, + cgbase,cgutils,pass_1,pass_2, + ncon,ncal, + ncgutil,procinfo, + cpubase,aasmcpu, + rgobj,tgobj,cgobj; + + +{***************************************************************************** + FirstTypeConv +*****************************************************************************} + + function tppctypeconvnode.first_int_to_real: tnode; + var + fname: string[19]; + begin + { converting a 64bit integer to a float requires a helper } + if is_64bitint(left.resultdef) or + is_currency(left.resultdef) then + begin + { hack to avoid double division by 10000, as it's } + { already done by typecheckpass.resultdef_int_to_real } + if is_currency(left.resultdef) then + left.resultdef := s64inttype; + if is_signed(left.resultdef) 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.resultdef) then + inserttypeconv(left,s32inttype) + else + inserttypeconv(left,u32inttype); + firstpass(left); + end; + result := nil; + expectloc:=LOC_FPUREGISTER; + end; + + +{***************************************************************************** + SecondTypeConv +*****************************************************************************} + + procedure tppctypeconvnode.second_int_to_real; + + type + tdummyarray = packed array[0..7] of byte; + + const + dummy1: int64 = $4330000080000000; + dummy2: int64 = $4330000000000000; + + var + tempconst: tnode; + ref: treference; + valuereg, tempreg, leftreg, tmpfpureg: tregister; + size: tcgsize; + signed : boolean; + begin + location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); + + { the code here comes from the PowerPC Compiler Writer's Guide } + + { * longint to double } + { addis R0,R0,0x4330 # R0 = 0x43300000 } + { stw R0,disp(R1) # store upper half } + { xoris R3,R3,0x8000 # flip sign bit } + { stw R3,disp+4(R1) # store lower half } + { lfd FR1,disp(R1) # float load double of value } + { fsub FR1,FR1,FR2 # subtract 0x4330000080000000 } + + { * cardinal to double } + { addis R0,R0,0x4330 # R0 = 0x43300000 } + { stw R0,disp(R1) # store upper half } + { stw R3,disp+4(R1) # store lower half } + { lfd FR1,disp(R1) # float load double of value } + { fsub FR1,FR1,FR2 # subtract 0x4330000000000000 } + tg.Gettemp(current_asmdata.CurrAsmList,8,8,tt_normal,ref); + + signed := is_signed(left.resultdef); + + { we need a certain constant for the conversion, so create it here } + if signed then + tempconst := + crealconstnode.create(double(tdummyarray(dummy1)), + pbestrealtype^) + else + tempconst := + crealconstnode.create(double(tdummyarray(dummy2)), + pbestrealtype^); + + typecheckpass(tempconst); + firstpass(tempconst); + secondpass(tempconst); + if (tempconst.location.loc <> LOC_CREFERENCE) or + { has to be handled by a helper } + is_64bitint(left.resultdef) then + internalerror(200110011); + + if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_REFERENCE,LOC_CREFERENCE]) then + location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,false); + case left.location.loc of + LOC_REGISTER: + begin + leftreg := left.location.register; + valuereg := leftreg; + end; + LOC_CREGISTER: + begin + leftreg := left.location.register; + if signed then + valuereg := cg.getintregister(current_asmdata.CurrAsmList,OS_INT) + else + valuereg := leftreg; + end; + LOC_REFERENCE,LOC_CREFERENCE: + begin + leftreg := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + valuereg := leftreg; + if signed then + size := OS_S32 + else + size := OS_32; + cg.a_load_ref_reg(current_asmdata.CurrAsmList,def_cgsize(left.resultdef), + size,left.location.reference,leftreg); + end + else + internalerror(200110012); + end; + tempreg := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_LIS,tempreg,$4330)); + cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_32,OS_32,tempreg,ref); + if signed then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_XORIS,valuereg, + { xoris expects a unsigned 16 bit int (FK) } + leftreg,$8000)); + inc(ref.offset,4); + cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_32,OS_32,valuereg,ref); + dec(ref.offset,4); + + tmpfpureg := cg.getfpuregister(current_asmdata.CurrAsmList,OS_F64); + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,OS_F64,OS_F64,tempconst.location.reference, + tmpfpureg); + tempconst.free; + + location.register := cg.getfpuregister(current_asmdata.CurrAsmList,OS_F64); + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,OS_F64,OS_F64,ref,location.register); + + tg.ungetiftemp(current_asmdata.CurrAsmList,ref); + + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_FSUB,location.register, + location.register,tmpfpureg)); + + { make sure the precision is correct } + if (tfloatdef(resultdef).floattype = s32real) then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FRSP,location.register, + location.register)); + end; + +begin + ctypeconvnode:=tppctypeconvnode; +end. diff --git a/closures/compiler/powerpc/nppcmat.pas b/closures/compiler/powerpc/nppcmat.pas new file mode 100644 index 0000000000..767a5abcd6 --- /dev/null +++ b/closures/compiler/powerpc/nppcmat.pas @@ -0,0 +1,721 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate PowerPC 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 nppcmat; + +{$i fpcdefs.inc} + +interface + + uses + node,nmat; + + type + tppcmoddivnode = class(tmoddivnode) + function pass_1: tnode;override; + procedure pass_generate_code;override; + end; + + tppcshlshrnode = class(tshlshrnode) + procedure pass_generate_code;override; + { everything will be handled in pass_2 } + function first_shlshr64bitint: tnode; override; + end; + + tppcunaryminusnode = class(tunaryminusnode) + procedure pass_generate_code;override; + end; + + tppcnotnode = class(tnotnode) + procedure pass_generate_code;override; + end; + +implementation + + uses + globtype,systems,constexp, + cutils,verbose,globals, + symconst, + aasmbase,aasmcpu,aasmtai,aasmdata, + defutil, + cgbase,cgutils,cgobj,pass_2, + ncon,procinfo, + cpubase, + ncgutil,cgcpu; + +{$push} +{$r-} +{$q-} +{ helper functions } +procedure getmagic_unsigned32(d : dword; out magic_m : dword; out magic_add : boolean; out magic_shift : dword); +var + p : longint; + nc, delta, q1, r1, q2, r2 : dword; + +begin + assert(d > 0); + + magic_add := false; + nc := dword(- 1) - dword(-d) mod d; + p := 31; { initialize p } + q1 := $80000000 div nc; { initialize q1 = 2p/nc } + r1 := $80000000 - q1*nc; { initialize r1 = rem(2p,nc) } + q2 := $7FFFFFFF div d; { initialize q2 = (2p-1)/d } + r2 := $7FFFFFFF - q2*d; { initialize r2 = rem((2p-1),d) } + repeat + inc(p); + if (r1 >= (nc - r1)) then begin + q1 := 2 * q1 + 1; { update q1 } + r1 := 2*r1 - nc; { update r1 } + end else begin + q1 := 2*q1; { update q1 } + r1 := 2*r1; { update r1 } + end; + if ((r2 + 1) >= (d - r2)) then begin + if (q2 >= $7FFFFFFF) then + magic_add := true; + q2 := 2*q2 + 1; { update q2 } + r2 := 2*r2 + 1 - d; { update r2 } + end else begin + if (q2 >= $80000000) then + magic_add := true; + q2 := 2*q2; { update q2 } + r2 := 2*r2 + 1; { update r2 } + end; + delta := d - 1 - r2; + until not ((p < 64) and ((q1 < delta) or ((q1 = delta) and (r1 = 0)))); + magic_m := q2 + 1; { resulting magic number } + magic_shift := p - 32; { resulting shift } +end; + +procedure getmagic_signed32(d : longint; out magic_m : longint; out magic_s : longint); +const + two_31 : DWord = high(longint)+1; +var + p : Longint; + ad, anc, delta, q1, r1, q2, r2, t : DWord; + +begin + assert((d < -1) or (d > 1)); + + ad := abs(d); + t := two_31 + (DWord(d) shr 31); + anc := t - 1 - t mod ad; { absolute value of nc } + p := 31; { initialize p } + q1 := two_31 div anc; { initialize q1 = 2p/abs(nc) } + r1 := two_31 - q1*anc; { initialize r1 = rem(2p,abs(nc)) } + q2 := two_31 div ad; { initialize q2 = 2p/abs(d) } + r2 := two_31 - q2*ad; { initialize r2 = rem(2p,abs(d)) } + repeat + inc(p); + q1 := 2*q1; { update q1 = 2p/abs(nc) } + r1 := 2*r1; { update r1 = rem(2p/abs(nc)) } + if (r1 >= anc) then begin { must be unsigned comparison } + inc(q1); + dec(r1, anc); + end; + q2 := 2*q2; { update q2 = 2p/abs(d) } + r2 := 2*r2; { update r2 = rem(2p/abs(d)) } + if (r2 >= ad) then begin { must be unsigned comparison } + inc(q2); + dec(r2, ad); + end; + delta := ad - r2; + until not ((q1 < delta) or ((q1 = delta) and (r1 = 0))); + magic_m := q2 + 1; + if (d < 0) then begin + magic_m := -magic_m; { resulting magic number } + end; + magic_s := p - 32; { resulting shift } +end; + +{$pop} + +{***************************************************************************** + TPPCMODDIVNODE +*****************************************************************************} + + function tppcmoddivnode.pass_1: tnode; + begin + result := inherited pass_1; + if not assigned(result) then + include(current_procinfo.flags,pi_do_call); + end; + + + procedure tppcmoddivnode.pass_generate_code; + const + { signed overflow } + divops: array[boolean, boolean] of tasmop = + ((A_DIVWU,A_DIVWU_),(A_DIVW,A_DIVWO_)); + zerocond: tasmcond = (dirhint: DH_Plus; simple: true; cond:C_NE; cr: RS_CR1); + var + power : longint; + op : tasmop; + numerator, + divider, + resultreg : tregister; + size : Tcgsize; + hl : tasmlabel; + done: boolean; + + procedure genOrdConstNodeDiv; + const + negops : array[boolean] of tasmop = (A_NEG, A_NEGO); + var + magic, shift : longint; + u_magic, u_shift : dword; + u_add : boolean; + + divreg : tregister; + begin + if (tordconstnode(right).value = 0) then begin + internalerror(2005061701); + end else if (tordconstnode(right).value = 1) then begin + cg.a_load_reg_reg(current_asmdata.CurrAsmList, OS_INT, OS_INT, numerator, resultreg); + end else if (tordconstnode(right).value = int64(-1)) then begin + // note: only in the signed case possible..., may overflow + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(negops[cs_check_overflow in current_settings.localswitches], resultreg, numerator)); + end else if (ispowerof2(tordconstnode(right).value, power)) then begin + if (is_signed(right.resultdef)) then begin + { From "The PowerPC Compiler Writer's Guide", pg. 52ff } + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SAR, OS_INT, power, + numerator, resultreg); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_ADDZE, resultreg, resultreg)); + end else begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_INT, power, numerator, resultreg) + end; + end else begin + { replace division by multiplication, both implementations } + { from "The PowerPC Compiler Writer's Guide" pg. 53ff } + divreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + if (is_signed(right.resultdef)) then begin + getmagic_signed32(tordconstnode(right).value.svalue, magic, shift); + // load magic value + cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, magic, divreg); + // multiply + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULHW, resultreg, numerator, divreg)); + // add/subtract numerator + if (tordconstnode(right).value > 0) and (magic < 0) then begin + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_ADD, OS_INT, numerator, resultreg, resultreg); + end else if (tordconstnode(right).value < 0) and (magic > 0) then begin + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_SUB, OS_INT, numerator, resultreg, resultreg); + end; + // shift shift places to the right (arithmetic) + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SAR, OS_INT, shift, resultreg, resultreg); + // extract and add sign bit + if (tordconstnode(right).value >= 0) then begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_INT, 31, numerator, divreg); + end else begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_INT, 31, resultreg, divreg); + end; + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_ADD, OS_INT, resultreg, divreg, resultreg); + end else begin + getmagic_unsigned32(tordconstnode(right).value.uvalue, u_magic, u_add, u_shift); + // load magic in divreg + cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, aint(u_magic), divreg); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULHWU, resultreg, numerator, divreg)); + if (u_add) then begin + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_SUB, OS_INT, resultreg, numerator, divreg); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_INT, 1, divreg, divreg); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_ADD, OS_INT, divreg, resultreg, divreg); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_INT, u_shift-1, divreg, resultreg); + end else begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_INT, u_shift, resultreg, resultreg); + end; + end; + end; + done := true; + end; + + procedure genOrdConstNodeMod; + var + modreg, maskreg, tempreg : tregister; + begin + if (tordconstnode(right).value = 0) then begin + internalerror(2005061702); + end else if (abs(tordconstnode(right).value.svalue) = 1) then begin + // x mod +/-1 is always zero + cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, 0, resultreg); + end else if (ispowerof2(tordconstnode(right).value, power)) then begin + if (is_signed(right.resultdef)) then begin + + tempreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + maskreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + modreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + + cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, abs(tordconstnode(right).value.svalue)-1, modreg); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SAR, OS_INT, 31, numerator, maskreg); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, numerator, modreg, tempreg); + + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ANDC, maskreg, maskreg, modreg)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBFIC, modreg, tempreg, 0)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBFE, modreg, modreg, modreg)); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, modreg, maskreg, maskreg); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_OR, OS_INT, maskreg, tempreg, resultreg); + end else begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, tordconstnode(right).value.svalue-1, numerator, resultreg); + end; + end else begin + genOrdConstNodeDiv(); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_MUL, OS_INT, tordconstnode(right).value.svalue, resultreg, resultreg); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_SUB, OS_INT, resultreg, numerator, resultreg); + end; + end; + + + begin + secondpass(left); + secondpass(right); + location_copy(location,left.location); + + { put numerator in register } + size:=def_cgsize(left.resultdef); + location_force_reg(current_asmdata.CurrAsmList,left.location, + size,true); + location_copy(location,left.location); + numerator := location.register; + resultreg := location.register; + if (location.loc = LOC_CREGISTER) then begin + location.loc := LOC_REGISTER; + location.register := cg.getintregister(current_asmdata.CurrAsmList,size); + resultreg := location.register; + end else if (nodetype = modn) or (right.nodetype = ordconstn) then begin + // for a modulus op, and for const nodes we need the result register + // to be an extra register + resultreg := cg.getintregister(current_asmdata.CurrAsmList,size); + end; + + done := false; + if (right.nodetype = ordconstn) then begin + if (nodetype = divn) then + genOrdConstNodeDiv + else + genOrdConstNodeMod; + done := true; + end; + + if (not done) then begin + { load divider in a register if necessary } + location_force_reg(current_asmdata.CurrAsmList,right.location, + def_cgsize(right.resultdef),true); + if (right.nodetype <> ordconstn) then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_CMPWI,NR_CR1, + right.location.register,0)); + divider := right.location.register; + + { needs overflow checking, (-maxlongint-1) div (-1) overflows! } + op := divops[is_signed(right.resultdef), + cs_check_overflow in current_settings.localswitches]; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,resultreg,numerator, + divider)); + + if (nodetype = modn) then + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULLW,resultreg, + divider,resultreg)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUB,location.register, + numerator,resultreg)); + resultreg := location.register; + end; + end; + { set result location } + location.loc:=LOC_REGISTER; + location.register:=resultreg; + if right.nodetype <> ordconstn then + begin + current_asmdata.getjumplabel(hl); + current_asmdata.CurrAsmList.concat(taicpu.op_cond_sym(A_BC,zerocond,hl)); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DIVBYZERO',false); + cg.a_label(current_asmdata.CurrAsmList,hl); + end; + { unsigned division/module can only overflow in case of division by zero } + { (but checking this overflow flag is more convoluted than performing a } + { simple comparison with 0) } + if is_signed(right.resultdef) then + cg.g_overflowcheck(current_asmdata.CurrAsmList,location,resultdef); + end; + + +{***************************************************************************** + TPPCSHLRSHRNODE +*****************************************************************************} + + function tppcshlshrnode.first_shlshr64bitint: tnode; + begin + result := nil; + end; + + procedure tppcshlshrnode.pass_generate_code; + + var + resultreg, hregister1,hregister2, + hreg64hi,hreg64lo : tregister; + op : topcg; + asmop1, asmop2: tasmop; + shiftval: aint; + + begin + secondpass(left); + secondpass(right); + + if is_64bitint(left.resultdef) then + begin + location_force_reg(current_asmdata.CurrAsmList,left.location, + def_cgsize(left.resultdef),true); + location_copy(location,left.location); + hreg64hi := location.register64.reghi; + hreg64lo := location.register64.reglo; + if (location.loc = LOC_CREGISTER) then + begin + location.loc := LOC_REGISTER; + location.register64.reghi := cg.getintregister(current_asmdata.CurrAsmList,OS_32); + location.register64.reglo := cg.getintregister(current_asmdata.CurrAsmList,OS_32); + end; + if (right.nodetype = ordconstn) then + begin + shiftval := tordconstnode(right).value.svalue; + shiftval := shiftval and 63; +{ + I think the statements below is much more correct instead of the hack above, + but then we fail tshlshr.pp :/ + + if shiftval > 63 then + begin + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reglo); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reglo); + end + else } if shiftval > 31 then + begin + if nodetype = shln then + begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_32, + shiftval and 31,hreg64lo,location.register64.reghi); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reglo); + end + else + begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_32, + shiftval and 31,hreg64hi,location.register64.reglo); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reghi); + end; + end + else + begin + if nodetype = shln then + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const_const_const( + A_RLWINM,location.register64.reghi,hreg64hi,shiftval, + 0,31-shiftval)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const_const_const( + A_RLWIMI,location.register64.reghi,hreg64lo,shiftval, + 32-shiftval,31)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const_const_const( + A_RLWINM,location.register64.reglo,hreg64lo,shiftval, + 0,31-shiftval)); + end + else + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const_const_const( + A_RLWINM,location.register64.reglo,hreg64lo,32-shiftval, + shiftval,31)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const_const_const( + A_RLWIMI,location.register64.reglo,hreg64hi,32-shiftval, + 0,shiftval-1)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const_const_const( + A_RLWINM,location.register64.reghi,hreg64hi,32-shiftval, + shiftval,31)); + end; + end; + end + else + { no constant shiftcount } + begin + location_force_reg(current_asmdata.CurrAsmList,right.location,OS_S32,true); + hregister1 := right.location.register; + if nodetype = shln then + begin + asmop1 := A_SLW; + asmop2 := A_SRW; + end + else + begin + asmop1 := A_SRW; + asmop2 := A_SLW; + resultreg := hreg64hi; + hreg64hi := hreg64lo; + hreg64lo := resultreg; + resultreg := location.register64.reghi; + location.register64.reghi := location.register64.reglo; + location.register64.reglo := resultreg; + end; + + cg.getcpuregister(current_asmdata.CurrAsmList,NR_R0); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBFIC, + NR_R0,hregister1,32)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(asmop1, + location.register64.reghi,hreg64hi,hregister1)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(asmop2, + NR_R0,hreg64lo,NR_R0)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_OR, + location.register64.reghi,location.register64.reghi,NR_R0)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBI, + NR_R0,hregister1,32)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(asmop1, + NR_R0,hreg64lo,NR_R0)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_OR, + location.register64.reghi,location.register64.reghi,NR_R0)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(asmop1, + location.register64.reglo,hreg64lo,hregister1)); + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_R0); + + if nodetype = shrn then + begin + resultreg := location.register64.reghi; + location.register64.reghi := location.register64.reglo; + location.register64.reglo := resultreg; + end; + end + end + else + begin + { load left operators in a register } + location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),true); + location_copy(location,left.location); + resultreg := location.register; + hregister1 := location.register; + location.loc := LOC_REGISTER; + resultreg := cg.getintregister(current_asmdata.CurrAsmList,location.size); + location.register := resultreg; + + { determine operator } + if nodetype=shln then + op:=OP_SHL + else + op:=OP_SHR; + + { shifting by a constant directly coded: } + if (right.nodetype=ordconstn) then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,op,location.size, + tordconstnode(right).value.svalue and 31,hregister1,resultreg) + else + begin + { load shift count in a register if necessary } + location_force_reg(current_asmdata.CurrAsmList,right.location,def_cgsize(right.resultdef),true); + hregister2 := right.location.register; + + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,op,location.size,hregister2, + hregister1,resultreg); + end; + end; + end; + + +{***************************************************************************** + TPPCUNARYMINUSNODE +*****************************************************************************} + + procedure tppcunaryminusnode.pass_generate_code; + + var + src1: tregister; + op: tasmop; + + begin + secondpass(left); + if is_64bit(left.resultdef) then + begin + location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),true); + location_copy(location,left.location); + if (location.loc = LOC_CREGISTER) then + begin + location.register64.reglo := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + location.register64.reghi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + location.loc := LOC_REGISTER; + end; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBFIC, + location.register64.reglo,left.location.register64.reglo,0)); + if not(cs_check_overflow in current_settings.localswitches) then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_SUBFZE, + location.register64.reghi,left.location.register64.reghi)) + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_SUBFZEO_, + location.register64.reghi,left.location.register64.reghi)); + end + else + begin + if left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF] then + location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,true); + location_copy(location,left.location); + location.loc:=LOC_REGISTER; + case left.location.loc of + LOC_FPUREGISTER, LOC_REGISTER: + begin + src1 := left.location.register; + location.register := src1; + end; + LOC_CFPUREGISTER, LOC_CREGISTER: + begin + src1 := left.location.register; + if left.location.loc = LOC_CREGISTER then + location.register := cg.getintregister(current_asmdata.CurrAsmList,OS_INT) + else + location.register := cg.getfpuregister(current_asmdata.CurrAsmList,location.size); + end; + LOC_REFERENCE,LOC_CREFERENCE: + begin + if (left.resultdef.typ=floatdef) then + begin + src1 := cg.getfpuregister(current_asmdata.CurrAsmList,def_cgsize(left.resultdef)); + location.register := src1; + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList, + left.location.size,left.location.size, + left.location.reference,src1); + end + else + begin + src1 := cg.getintregister(current_asmdata.CurrAsmList,OS_32); + location.register:= src1; + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_32,OS_32, + left.location.reference,src1); + end; + end; + end; + { choose appropriate operand } + if left.resultdef.typ <> floatdef then + begin + if not(cs_check_overflow in current_settings.localswitches) then + op := A_NEG + else + op := A_NEGO_; + location.loc := LOC_REGISTER; + end + else + begin + op := A_FNEG; + location.loc := LOC_FPUREGISTER; + end; + { emit operation } + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,location.register,src1)); + end; +{ Here was a problem... } +{ Operand to be negated always } +{ seems to be converted to signed } +{ 32-bit before doing neg!! } +{ So this is useless... } +{ that's not true: -2^31 gives an overflow error if it is negated (FK) } + cg.g_overflowcheck(current_asmdata.CurrAsmList,location,resultdef); + end; + + +{***************************************************************************** + TPPCNOTNODE +*****************************************************************************} + + procedure tppcnotnode.pass_generate_code; + + var + hl : tasmlabel; + tmpreg: tregister; + begin + if is_boolean(resultdef) then + begin + { if the location is LOC_JUMP, we do the secondpass after the + labels are allocated + } + if left.expectloc=LOC_JUMP then + begin + hl:=current_procinfo.CurrTrueLabel; + current_procinfo.CurrTrueLabel:=current_procinfo.CurrFalseLabel; + current_procinfo.CurrFalseLabel:=hl; + secondpass(left); + maketojumpbool(current_asmdata.CurrAsmList,left,lr_load_regvars); + hl:=current_procinfo.CurrTrueLabel; + current_procinfo.CurrTrueLabel:=current_procinfo.CurrFalseLabel; + current_procinfo.CurrFalseLabel:=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, + LOC_SUBSETREG, LOC_CSUBSETREG, + LOC_SUBSETREF, LOC_CSUBSETREF: + begin + location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),true); + tmpreg:=left.location.register; +{$ifndef cpu64bitalu} + { 64 bit pascal booleans have their truth value stored in + the lower 32 bits; with cbools, it can be anywhere } + if (left.location.size in [OS_64,OS_S64]) and + not is_pasbool(left.resultdef) then + begin + tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,left.location.register64.reglo,left.location.register64.reghi,tmpreg); + end; +{$endif not cpu64bitalu} + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CMPWI,tmpreg,0)); + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags.cr:=RS_CR0; + location.resflags.flag:=F_EQ; + end; + else + internalerror(2003042401); + end; + end; + end + else if is_64bitint(left.resultdef) then + begin + secondpass(left); + location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),false); + location_copy(location,left.location); + { perform the NOT operation } + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_NOT,location.register64.reghi, + location.register64.reghi)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_NOT,location.register64.reglo, + location.register64.reglo)); + end + else + begin + secondpass(left); + location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),true); + location_copy(location,left.location); + location.loc := LOC_REGISTER; + location.register := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + { perform the NOT operation } + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NOT,def_cgsize(resultdef),left.location.register, + location.register); + end; + end; + +begin + cmoddivnode:=tppcmoddivnode; + cshlshrnode:=tppcshlshrnode; + cunaryminusnode:=tppcunaryminusnode; + cnotnode:=tppcnotnode; +end. diff --git a/closures/compiler/powerpc/ppcins.dat b/closures/compiler/powerpc/ppcins.dat new file mode 100644 index 0000000000..43ec86b907 --- /dev/null +++ b/closures/compiler/powerpc/ppcins.dat @@ -0,0 +1,68 @@ +;**************************************************************************** +; +; Copyright (c) 2002 by Florian Klaempfl +; +; Instruction template table for the PowerPC +; +; 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. +; +;**************************************************************************** +; +add rD,rA,rB opcode=31,op22=266,oe=0,rc=0 +add_ rD,rA,rB opcode=31,op22=266,oe=0,rc=1 +addo rD,rA,rB opcode=31,op22=266,oe=1,rc=0 +addo_ rD,rA,rB opcode=31,op22=266,oe=1,rc=1 +addc rD,rA,rB opcode=31,op22=10,oe=0,rc=0 +addc_ rD,rA,rB opcode=31,op22=10,oe=0,rc=1 +addco rD,rA,rB opcode=31,op22=10,oe=1,rc=0 +addco_ rD,rA,rB opcode=31,op22=10,oe=1,rc=1 +adde rD,rA,rB opcode=31,op22=138,oe=0,rc=0 +adde_ rD,rA,rB opcode=31,op22=138,oe=0,rc=1 +addeo rD,rA,rB opcode=31,op22=138,oe=1,rc=0 +addeo_ rD,rA,rB opcode=31,op22=138,oe=1,rc=1 +addi rD,rA,SIMM opcode=14 +addic rD,rA,SIMM opcode=12 +addic_ rD,rA,SIMM opcode=13 +addis rD,rA,SIMM opcode=15 +addme rD,rA opcode=31,op22=234,oe=0,rc=0,reserved=$000f0000 +addme_ rD,rA opcode=31,op22=234,oe=0,rc=1,reserved=$000f0000 +addmeo rD,rA opcode=31,op22=234,oe=1,rc=0,reserved=$000f0000 +addmeo_ rD,rA opcode=31,op22=234,oe=1,rc=1,reserved=$000f0000 +addze rD,rA opcode=31,op22=202,oe=0,rc=0,reserved=$000f0000 +addze_ rD,rA opcode=31,op22=202,oe=0,rc=1,reserved=$000f0000 +addzeo rD,rA opcode=31,op22=202,oe=1,rc=0,reserved=$000f0000 +addzeo_ rD,rA opcode=31,op22=202,oe=1,rc=1,reserved=$000f0000 +and rA,rS,rB opcode=31,op21=28,rc=0 +and_ rA,rS,rB opcode=31,op21=28,rc=1 +andc rA,rS,rB opcode=31,op21=60,rc=0 +andc_ rA,rS,rB opcode=31,op21=60,rc=1 +andi_ rA,rS,UIMM opcode=28 +andis_ rA,rS,UIMM opcode=29 +b TA24 opcode=18,aa=0,lk=0 +ba TA24 opcode=18,aa=1,lk=0 +bl TA24 opcode=18,aa=0,lk=1 +bla TA24 opcode=18,aa=1,lk=1 +bc BO,BI,TA14 opcode=16,aa=0,lk=0 +bca BO,BI,TA14 opcode=16,aa=1,lk=0 +bcl BO,BI,TA14 opcode=16,aa=0,lk=1 +bcla BO,BI,TA14 opcode=16,aa=1,lk=1 +bcctr BO,BI opcode=19,op21=528,lk=0,reserved=$000f0000 +bcctrl BO,BI opcode=19,op21=528,lk=1,reserved=$000f0000 +bcltr BO,BI opcode=19,op21=16,lk=0,reserved=$000f0000 +bcltrl BO,BI opcode=19,op21=16,lk=1,reserved=$000f0000 +cmp crfD,L,rA,rB opcode=31,op21=0,reserved=$80000200 +cmpi crfD,L,rA,SIMM opcode=11,reserved=$00000200 +cmpl crfD,L,rA,rB opcode=31,op21=32,reserved=$80000200 +cmpli crfD,L,rA,UIMM opcode=10,reserved=$00000200 diff --git a/closures/compiler/powerpc/ppcreg.dat b/closures/compiler/powerpc/ppcreg.dat new file mode 100644 index 0000000000..92322e30c9 --- /dev/null +++ b/closures/compiler/powerpc/ppcreg.dat @@ -0,0 +1,120 @@ +; +; PowerPC registers +; +; layout +; <name>,<value>,<stdname>,<gasname>,<gasshortname>,<motname>,<stabidx> +; +NO,$00,$00,INVALID,INVALID,INVALID,INVALID,-1,-1 + +R0,$01,$00,r0,r0,0,r0,0,0 +R1,$01,$01,r1,r1,1,r1,1,1 +R2,$01,$02,r2,r2,2,r2,2,2 +R3,$01,$03,r3,r3,3,r3,3,3 +R4,$01,$04,r4,r4,4,r4,4,4 +R5,$01,$05,r5,r5,5,r5,5,5 +R6,$01,$06,r6,r6,6,r6,6,6 +R7,$01,$07,r7,r7,7,r7,7,7 +R8,$01,$08,r8,r8,8,r8,8,8 +R9,$01,$09,r9,r9,9,r9,9,9 +R10,$01,$0a,r10,r10,10,r10,10,10 +R11,$01,$0b,r11,r11,11,r11,11,11 +R12,$01,$0c,r12,r12,12,r12,12,12 +R13,$01,$0d,r13,r13,13,r13,13,13 +R14,$01,$0e,r14,r14,14,r14,14,14 +R15,$01,$0f,r15,r15,15,r15,15,15 +R16,$01,$10,r16,r16,16,r16,16,16 +R17,$01,$11,r17,r17,17,r17,17,17 +R18,$01,$12,r18,r18,18,r18,18,18 +R19,$01,$13,r19,r19,19,r19,19,19 +R20,$01,$14,r20,r20,20,r20,20,20 +R21,$01,$15,r21,r21,21,r21,21,21 +R22,$01,$16,r22,r22,22,r22,22,22 +R23,$01,$17,r23,r23,23,r23,23,23 +R24,$01,$18,r24,r24,24,r24,24,24 +R25,$01,$19,r25,r25,25,r25,25,25 +R26,$01,$1a,r26,r26,26,r26,26,26 +R27,$01,$1b,r27,r27,27,r27,27,27 +R28,$01,$1c,r28,r28,28,r28,28,28 +R29,$01,$1d,r29,r29,29,r29,29,29 +R30,$01,$1e,r30,r30,30,r30,30,30 +R31,$01,$1f,r31,r31,31,r31,31,31 + +F0,$02,$00,F0,f0,0,F0,32,32 +F1,$02,$01,F1,f1,1,F1,33,33 +F2,$02,$02,F2,f2,2,F2,34,34 +F3,$02,$03,F3,f3,3,F3,35,35 +F4,$02,$04,F4,f4,4,F4,36,36 +F5,$02,$05,F5,f5,5,F5,37,37 +F6,$02,$06,F6,f6,6,F6,38,38 +F7,$02,$07,F7,f7,7,F7,39,39 +F8,$02,$08,F8,f8,8,F8,40,40 +F9,$02,$09,F9,f9,9,F9,41,41 +F10,$02,$0a,F10,f10,10,F10,42,42 +F11,$02,$0b,F11,f11,11,F11,43,43 +F12,$02,$0c,F12,f12,12,F12,44,44 +F13,$02,$0d,F13,f13,13,F13,45,45 +F14,$02,$0e,F14,f14,14,F14,46,46 +F15,$02,$0f,F15,f15,15,F15,47,47 +F16,$02,$10,F16,f16,16,F16,48,48 +F17,$02,$11,F17,f17,17,F17,49,49 +F18,$02,$12,F18,f18,18,F18,50,50 +F19,$02,$13,F19,f19,19,F19,51,51 +F20,$02,$14,F20,f20,20,F20,52,52 +F21,$02,$15,F21,f21,21,F21,53,53 +F22,$02,$16,F22,f22,22,F22,54,54 +F23,$02,$17,F23,f23,23,F23,55,55 +F24,$02,$18,F24,f24,24,F24,56,56 +F25,$02,$19,F25,f25,25,F25,57,57 +F26,$02,$1a,F26,f26,26,F26,58,58 +F27,$02,$1b,F27,f27,27,F27,59,59 +F28,$02,$1c,F28,f28,28,F28,60,60 +F29,$02,$1d,F29,f29,29,F29,61,61 +F30,$02,$1e,F30,f30,30,F30,62,62 +F31,$02,$1f,F31,f31,31,F31,63,63 + +M0,$03,$00,M0,v0,0,M0,-1,-1 +M1,$03,$01,M1,v1,1,M1,-1,-1 +M2,$03,$02,M2,v2,2,M2,-1,-1 +M3,$03,$03,M3,v3,3,M3,-1,-1 +M4,$03,$04,M4,v4,4,M4,-1,-1 +M5,$03,$05,M5,v5,5,M5,-1,-1 +M6,$03,$06,M6,v6,6,M6,-1,-1 +M7,$03,$07,M7,v7,7,M7,-1,-1 +M8,$03,$08,M8,v8,8,M8,-1,-1 +M9,$03,$09,M9,v9,9,M9,-1,-1 +M10,$03,$0a,M10,v10,10,M10,-1,-1 +M11,$03,$0b,M11,v11,11,M11,-1,-1 +M12,$03,$0c,M12,v12,12,M12,-1,-1 +M13,$03,$0d,M13,v13,13,M13,-1,-1 +M14,$03,$0e,M14,v14,14,M14,-1,-1 +M15,$03,$0f,M15,v15,15,M15,-1,-1 +M16,$03,$10,M16,v16,16,M16,-1,-1 +M17,$03,$11,M17,v17,17,M17,-1,-1 +M18,$03,$12,M18,v18,18,M18,-1,-1 +M19,$03,$13,M19,v19,19,M19,-1,-1 +M20,$03,$14,M20,v20,20,M20,-1,-1 +M21,$03,$15,M21,v21,21,M21,-1,-1 +M22,$03,$16,M22,v22,22,M22,-1,-1 +M23,$03,$17,M23,v23,23,M23,-1,-1 +M24,$03,$18,M24,v24,24,M24,-1,-1 +M25,$03,$19,M25,v25,25,M25,-1,-1 +M26,$03,$1a,M26,v26,26,M26,-1,-1 +M27,$03,$1b,M27,v27,27,M27,-1,-1 +M28,$03,$1c,M28,v28,28,M28,-1,-1 +M29,$03,$1d,M29,v29,29,M29,-1,-1 +M30,$03,$1e,M30,v30,30,M30,-1,-1 +M31,$03,$1f,M31,v31,31,M31,-1,-1 + +CR,$05,$00,CR,cr,cr,CR,-1,-1 +CR0,$05,$01,CR0,cr0,cr0,CR0,68,68 +CR1,$05,$02,CR1,cr1,cr1,CR1,69,69 +CR2,$05,$03,CR2,cr2,cr2,CR2,70,70 +CR3,$05,$04,CR3,cr3,cr3,CR3,71,71 +CR4,$05,$05,CR4,cr4,cr4,CR4,72,72 +CR5,$05,$06,CR5,cr5,cr5,CR5,73,73 +CR6,$05,$07,CR6,cr6,cr6,CR6,74,74 +CR7,$05,$08,CR7,cr7,cr7,CR7,75,75 +XER,$05,$09,XER,xer,xer,XER,76,76 +LR,$05,$0a,LR,lr,lr,LR,65,65 +CTR,$05,$0b,CTR,ctr,ctr,CTR,66,66 +FPSCR,$05,$0c,FPSCR,fpscr,fpscr,FPSCR,-1,-1 diff --git a/closures/compiler/powerpc/rappc.pas b/closures/compiler/powerpc/rappc.pas new file mode 100644 index 0000000000..4ae4ab8452 --- /dev/null +++ b/closures/compiler/powerpc/rappc.pas @@ -0,0 +1,41 @@ +{ + Copyright (c) 1998-2003 by Carl Eric Codere and Peter Vreman + + Handles the common ppc 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 rappc; + +{$i fpcdefs.inc} + + interface + + uses + aasmbase,aasmtai,aasmdata,aasmcpu, + cpubase,rautils,cclasses; + + type + TPPCOperand=class(TOperand) + end; + + TPPCInstruction=class(TInstruction) + end; + + implementation + +end. diff --git a/closures/compiler/powerpc/rappcgas.pas b/closures/compiler/powerpc/rappcgas.pas new file mode 100644 index 0000000000..1a3ca2a518 --- /dev/null +++ b/closures/compiler/powerpc/rappcgas.pas @@ -0,0 +1,799 @@ +{ + Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman + + Does the parsing for the PowerPC 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 rappcgas; + +{$i fpcdefs.inc} + + Interface + + uses + raatt,rappc; + + type + tppcattreader = class(tattreader) + function is_asmopcode(const s: string):boolean;override; + procedure handleopcode;override; + procedure BuildReference(oper : tppcoperand); + procedure BuildOperand(oper : tppcoperand); + procedure BuildOpCode(instr : tppcinstruction); + procedure ReadAt(oper : tppcoperand); + procedure ReadSym(oper : tppcoperand); + procedure ConvertCalljmp(instr : tppcinstruction); + end; + + + Implementation + + uses + { helpers } + cutils, + { global } + globtype,verbose, + systems, + { aasm } + cpubase,aasmbase,aasmtai,aasmdata,aasmcpu, + { symtable } + symconst,symsym, + { parser } + procinfo, + rabase,rautils, + cgbase,cgobj + ; + + procedure tppcattreader.ReadSym(oper : tppcoperand); + var + tempstr, mangledname : string; + typesize,l,k : aint; + 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,mangledname,false); + if (mangledname<>'') then + Message(asmr_e_invalid_reference_syntax); + inc(oper.opr.ref.offset,l); + end; + end; + + + procedure tppcattreader.ReadAt(oper : tppcoperand); + begin + { check for ...@ } + if actasmtoken=AS_AT then + begin + if (oper.opr.ref.symbol=nil) and + (oper.opr.ref.offset = 0) then + Message(asmr_e_invalid_reference_syntax); + Consume(AS_AT); + if actasmtoken=AS_ID then + begin + if upper(actasmpattern)='L' then + oper.opr.ref.refaddr:=addr_low + else if upper(actasmpattern)='HI' then + oper.opr.ref.refaddr:=addr_high + else if upper(actasmpattern)='HA' then + oper.opr.ref.refaddr:=addr_higha + else + Message(asmr_e_invalid_reference_syntax); + Consume(AS_ID); + end + else + Message(asmr_e_invalid_reference_syntax); + end; + end; + + + Procedure tppcattreader.BuildReference(oper : tppcoperand); + + procedure Consume_RParen; + begin + if actasmtoken <> AS_RPAREN then + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(true); + end + else + begin + Consume(AS_RPAREN); + if not (actasmtoken in [AS_COMMA,AS_SEPARATOR,AS_END]) then + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(true); + end; + end; + end; + + var + l : aint; + relsym: string; + asmsymtyp: tasmsymtype; + + begin + Consume(AS_LPAREN); + Case actasmtoken of + AS_INTNUM, + AS_MINUS, + AS_PLUS: + Begin + { offset(offset) is invalid } + If oper.opr.Ref.Offset <> 0 Then + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(true); + End + Else + Begin + oper.opr.Ref.Offset:=BuildConstExpression(false,true); + Consume(AS_RPAREN); + if actasmtoken=AS_AT then + ReadAt(oper); + end; + exit; + End; + AS_REGISTER: { (reg ... } + Begin + if ((oper.opr.typ=OPR_REFERENCE) and (oper.opr.ref.base<>NR_NO)) or + ((oper.opr.typ=OPR_LOCAL) and (oper.opr.localsym.localloc.loc<>LOC_REGISTER)) then + message(asmr_e_cannot_index_relative_var); + oper.opr.ref.base:=actasmregister; + Consume(AS_REGISTER); + { can either be a register or a right parenthesis } + { (reg) } + if actasmtoken=AS_RPAREN then + Begin + Consume_RParen; + exit; + end; + { (reg,reg .. } + Consume(AS_COMMA); + if (actasmtoken=AS_REGISTER) and + (oper.opr.Ref.Offset = 0) then + Begin + oper.opr.ref.index:=actasmregister; + Consume(AS_REGISTER); + Consume_RParen; + end + else + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end; + end; {end case } + AS_ID: + Begin + ReadSym(oper); + case actasmtoken of + AS_PLUS: + begin + { add a constant expression? } + l:=BuildConstExpression(true,true); + 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; + AS_MINUS: + begin + Consume(AS_MINUS); + BuildConstSymbolExpression(false,true,false,l,relsym,asmsymtyp); + if (relsym<>'') then + begin + if (oper.opr.typ = OPR_REFERENCE) then + oper.opr.ref.relsymbol:=current_asmdata.RefAsmSymbol(relsym) + else + begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end + end + else + begin + case oper.opr.typ of + OPR_CONSTANT : + dec(oper.opr.val,l); + OPR_LOCAL : + dec(oper.opr.localsymofs,l); + OPR_REFERENCE : + dec(oper.opr.ref.offset,l); + else + internalerror(2007092601); + end; + end; + end; + end; + Consume(AS_RPAREN); + if actasmtoken=AS_AT then + ReadAt(oper); + End; + AS_COMMA: { (, ... can either be scaling, or index } + Begin + Consume(AS_COMMA); + { Index } + if (actasmtoken=AS_REGISTER) then + Begin + oper.opr.ref.index:=actasmregister; + Consume(AS_REGISTER); + { check for scaling ... } + Consume_RParen; + end + else + begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end; + end; + else + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end; + end; + end; + + + Procedure tppcattreader.BuildOperand(oper : tppcoperand); + var + expr : string; + typesize,l : aint; + + + 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 + mangledname: string; + hasdot : boolean; + l, + toffset, + tsize : aint; + 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,mangledname,false); + if (oper.opr.typ<>OPR_CONSTANT) and + (mangledname<>'') then + Message(asmr_e_wrong_sym_type); + 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 + (tabstractvarsym(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 : + if (mangledname<>'') then + begin + if (oper.opr.val<>0) then + Message(asmr_e_wrong_sym_type); + oper.opr.typ:=OPR_SYMBOL; + oper.opr.symbol:=current_asmdata.RefAsmSymbol(mangledname); + end + else + inc(oper.opr.val,l); + OPR_REFERENCE : + inc(oper.opr.ref.offset,l); + OPR_SYMBOL: + Message(asmr_e_invalid_symbol_ref); + 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; + hl : tasmlabel; + ofs : aint; + Begin + expr:=''; + case actasmtoken of + AS_LPAREN: { Memory reference or constant expression } + Begin + oper.InitRef; + BuildReference(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 oper.SetupVar(expr,false) then + ReadAt(oper) + else + 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; + + AS_REGISTER: { Register, a variable reference or a constant reference } + Begin + { save the type of register used. } + tempreg:=actasmregister; + Consume(AS_REGISTER); + if (actasmtoken in [AS_END,AS_SEPARATOR,AS_COMMA]) then + if is_condreg(tempreg) and + ((actopcode = A_BC) or + (actopcode = A_BCCTR) or + (actopcode = A_BCLR) or + (actopcode = A_TW) or + (actopcode = A_TWI)) then + begin + { it isn't a real operand, everything is stored in the condition } + oper.opr.typ:=OPR_NONE; + actcondition.cr := getsupreg(tempreg); + end + else + 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 is_condreg(tempreg) then + begin + if not(actcondition.cond in [C_T..C_DZF]) then + Message(asmr_e_syn_operand); + if actasmtoken=AS_STAR then + begin + consume(AS_STAR); + if (actasmtoken=AS_INTNUM) then + begin + consume(AS_INTNUM); + if actasmtoken=AS_PLUS then + begin + consume(AS_PLUS); + if (actasmtoken=AS_ID) then + begin + oper.opr.typ:=OPR_NONE; + if actasmpattern='LT' then + actcondition.crbit:=(getsupreg(tempreg)-(RS_CR0))*4 + else if actasmpattern='GT' then + actcondition.crbit:=(getsupreg(tempreg)-(RS_CR0))*4+1 + else if actasmpattern='EQ' then + actcondition.crbit:=(getsupreg(tempreg)-(RS_CR0))*4+2 + else if actasmpattern='SO' then + actcondition.crbit:=(getsupreg(tempreg)-(RS_CR0))*4+3 + else + Message(asmr_e_syn_operand); + consume(AS_ID); + end + else + Message(asmr_e_syn_operand); + end + else + Message(asmr_e_syn_operand); + end + else + Message(asmr_e_syn_operand); + end + else + Message(asmr_e_syn_operand); + end + else + Message(asmr_e_syn_operand); + end; + AS_END, + AS_SEPARATOR, + AS_COMMA: ; + else + Begin + Message(asmr_e_syn_operand); + Consume(actasmtoken); + end; + end; { end case } + end; + + +{***************************************************************************** + tppcattreader +*****************************************************************************} + + procedure tppcattreader.BuildOpCode(instr : tppcinstruction); + 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; + 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 operandnum>Max_Operands then + Message(asmr_e_too_many_operands) + else + begin + { condition operands doesn't set the operand but write to the + condition field of the instruction + } + if instr.Operands[operandnum].opr.typ<>OPR_NONE then + Inc(operandnum); + end; + Consume(AS_COMMA); + end; + AS_SEPARATOR, + AS_END : { End of asm operands for this opcode } + begin + break; + end; + else + BuildOperand(instr.Operands[operandnum] as tppcoperand); + end; { end case } + until false; + if (operandnum=1) and (instr.Operands[operandnum].opr.typ=OPR_NONE) then + dec(operandnum); + instr.Ops:=operandnum; + end; + + + function tppcattreader.is_asmopcode(const s: string):boolean; + var + cond : tasmcondflag; + hs : string; + + Begin + { making s a value parameter would break other assembler readers } + hs:=s; + is_asmopcode:=false; + + { clear op code } + actopcode:=A_None; + { clear condition } + fillchar(actcondition,sizeof(actcondition),0); + + { check for direction hint } + if hs[length(s)]='-' then + begin + dec(ord(hs[0])); + actcondition.dirhint:=DH_Minus; + end + else if hs[length(s)]='+' then + begin + dec(ord(hs[0])); + actcondition.dirhint:=DH_Plus; + end; + actopcode := tasmop(ptruint(iasmops.find(hs))); + if actopcode <> A_NONE then + begin + if actcondition.dirhint<>DH_None then + message1(asmr_e_unknown_opcode,actasmpattern); + actasmtoken:=AS_OPCODE; + is_asmopcode:=true; + exit; + end; + { not found, check branch instructions } + if hs[1]='B' then + begin + { we can search here without an extra table which is sorted by string length + because we take the whole remaining string without the leading B } + if copy(hs,length(s)-1,2)='LR' then + begin + actopcode := A_BCLR; + setlength(hs,length(hs)-2) + end + else if copy(hs,length(s)-2,3)='CTR' then + begin + actopcode := A_BCCTR; + setlength(hs,length(hs)-3) + end + else + actopcode := A_BC; + for cond:=low(TAsmCondFlag) to high(TAsmCondFlag) do + if copy(hs,2,length(s)-1)=UpperAsmCondFlag2Str[cond] then + begin + actcondition.simple:=true; + actcondition.cond:=cond; + if (cond in [C_LT,C_LE,C_EQ,C_GE,C_GT,C_NL,C_NE,C_NG,C_SO,C_NS,C_UN,C_NU]) then + actcondition.cr := RS_CR0; + actasmtoken:=AS_OPCODE; + is_asmopcode:=true; + exit; + end; + end; + end; + + procedure tppcattreader.ConvertCalljmp(instr : tppcinstruction); + begin + if instr.Operands[1].opr.typ = OPR_CONSTANT then + begin + if (instr.operands[1].opr.val > 31) or + (instr.operands[2].opr.typ <> OPR_CONSTANT) or + (instr.operands[2].opr.val > 31) or + not(instr.operands[3].opr.typ in [OPR_REFERENCE,OPR_SYMBOL]) then + Message(asmr_e_syn_operand); + { BO/BI notation } + instr.condition.simple := false; + instr.condition.bo := instr.operands[1].opr.val; + instr.condition.bi := instr.operands[2].opr.val; + instr.operands[1].free; + instr.operands[2].free; + instr.operands[2] := nil; + instr.operands[1] := instr.operands[3]; + instr.operands[3] := nil; + instr.ops := 1; + end; + if instr.Operands[1].opr.typ = OPR_REFERENCE then + begin + instr.Operands[1].opr.ref.refaddr:=addr_full; + if (instr.Operands[1].opr.ref.base<>NR_NO) or + (instr.Operands[1].opr.ref.index<>NR_NO) then + Message(asmr_e_syn_operand); + end; + end; + + + procedure tppcattreader.handleopcode; + var + instr : tppcinstruction; + begin + instr:=TPPCInstruction.Create(TPPCOperand); + BuildOpcode(instr); + instr.condition := actcondition; + if is_calljmp(instr.opcode) then + ConvertCalljmp(instr); + { + instr.AddReferenceSizes; + instr.SetInstructionOpsize; + instr.CheckOperandSizes; + } + instr.ConcatInstruction(curlist); + instr.Free; + end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +const + asmmode_ppc_att_info : tasmmodeinfo = + ( + id : asmmode_ppc_gas; + idtxt : 'GAS'; + casmreader : tppcattreader; + ); + + asmmode_ppc_standard_info : tasmmodeinfo = + ( + id : asmmode_standard; + idtxt : 'STANDARD'; + casmreader : tppcattreader; + ); + +initialization + RegisterAsmMode(asmmode_ppc_att_info); + RegisterAsmMode(asmmode_ppc_standard_info); +end. diff --git a/closures/compiler/powerpc/rppccon.inc b/closures/compiler/powerpc/rppccon.inc new file mode 100644 index 0000000000..4ff6799228 --- /dev/null +++ b/closures/compiler/powerpc/rppccon.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.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_R16 = tregister($01000010); +NR_R17 = tregister($01000011); +NR_R18 = tregister($01000012); +NR_R19 = tregister($01000013); +NR_R20 = tregister($01000014); +NR_R21 = tregister($01000015); +NR_R22 = tregister($01000016); +NR_R23 = tregister($01000017); +NR_R24 = tregister($01000018); +NR_R25 = tregister($01000019); +NR_R26 = tregister($0100001a); +NR_R27 = tregister($0100001b); +NR_R28 = tregister($0100001c); +NR_R29 = tregister($0100001d); +NR_R30 = tregister($0100001e); +NR_R31 = tregister($0100001f); +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_F8 = tregister($02000008); +NR_F9 = tregister($02000009); +NR_F10 = tregister($0200000a); +NR_F11 = tregister($0200000b); +NR_F12 = tregister($0200000c); +NR_F13 = tregister($0200000d); +NR_F14 = tregister($0200000e); +NR_F15 = tregister($0200000f); +NR_F16 = tregister($02000010); +NR_F17 = tregister($02000011); +NR_F18 = tregister($02000012); +NR_F19 = tregister($02000013); +NR_F20 = tregister($02000014); +NR_F21 = tregister($02000015); +NR_F22 = tregister($02000016); +NR_F23 = tregister($02000017); +NR_F24 = tregister($02000018); +NR_F25 = tregister($02000019); +NR_F26 = tregister($0200001a); +NR_F27 = tregister($0200001b); +NR_F28 = tregister($0200001c); +NR_F29 = tregister($0200001d); +NR_F30 = tregister($0200001e); +NR_F31 = tregister($0200001f); +NR_M0 = tregister($03000000); +NR_M1 = tregister($03000001); +NR_M2 = tregister($03000002); +NR_M3 = tregister($03000003); +NR_M4 = tregister($03000004); +NR_M5 = tregister($03000005); +NR_M6 = tregister($03000006); +NR_M7 = tregister($03000007); +NR_M8 = tregister($03000008); +NR_M9 = tregister($03000009); +NR_M10 = tregister($0300000a); +NR_M11 = tregister($0300000b); +NR_M12 = tregister($0300000c); +NR_M13 = tregister($0300000d); +NR_M14 = tregister($0300000e); +NR_M15 = tregister($0300000f); +NR_M16 = tregister($03000010); +NR_M17 = tregister($03000011); +NR_M18 = tregister($03000012); +NR_M19 = tregister($03000013); +NR_M20 = tregister($03000014); +NR_M21 = tregister($03000015); +NR_M22 = tregister($03000016); +NR_M23 = tregister($03000017); +NR_M24 = tregister($03000018); +NR_M25 = tregister($03000019); +NR_M26 = tregister($0300001a); +NR_M27 = tregister($0300001b); +NR_M28 = tregister($0300001c); +NR_M29 = tregister($0300001d); +NR_M30 = tregister($0300001e); +NR_M31 = tregister($0300001f); +NR_CR = tregister($05000000); +NR_CR0 = tregister($05000001); +NR_CR1 = tregister($05000002); +NR_CR2 = tregister($05000003); +NR_CR3 = tregister($05000004); +NR_CR4 = tregister($05000005); +NR_CR5 = tregister($05000006); +NR_CR6 = tregister($05000007); +NR_CR7 = tregister($05000008); +NR_XER = tregister($05000009); +NR_LR = tregister($0500000a); +NR_CTR = tregister($0500000b); +NR_FPSCR = tregister($0500000c); diff --git a/closures/compiler/powerpc/rppcdwrf.inc b/closures/compiler/powerpc/rppcdwrf.inc new file mode 100644 index 0000000000..2c9c9942a8 --- /dev/null +++ b/closures/compiler/powerpc/rppcdwrf.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.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, +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, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +68, +69, +70, +71, +72, +73, +74, +75, +76, +65, +66, +-1 diff --git a/closures/compiler/powerpc/rppcgas.inc b/closures/compiler/powerpc/rppcgas.inc new file mode 100644 index 0000000000..3c68549ce1 --- /dev/null +++ b/closures/compiler/powerpc/rppcgas.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.dat } +'INVALID', +'r0', +'r1', +'r2', +'r3', +'r4', +'r5', +'r6', +'r7', +'r8', +'r9', +'r10', +'r11', +'r12', +'r13', +'r14', +'r15', +'r16', +'r17', +'r18', +'r19', +'r20', +'r21', +'r22', +'r23', +'r24', +'r25', +'r26', +'r27', +'r28', +'r29', +'r30', +'r31', +'f0', +'f1', +'f2', +'f3', +'f4', +'f5', +'f6', +'f7', +'f8', +'f9', +'f10', +'f11', +'f12', +'f13', +'f14', +'f15', +'f16', +'f17', +'f18', +'f19', +'f20', +'f21', +'f22', +'f23', +'f24', +'f25', +'f26', +'f27', +'f28', +'f29', +'f30', +'f31', +'v0', +'v1', +'v2', +'v3', +'v4', +'v5', +'v6', +'v7', +'v8', +'v9', +'v10', +'v11', +'v12', +'v13', +'v14', +'v15', +'v16', +'v17', +'v18', +'v19', +'v20', +'v21', +'v22', +'v23', +'v24', +'v25', +'v26', +'v27', +'v28', +'v29', +'v30', +'v31', +'cr', +'cr0', +'cr1', +'cr2', +'cr3', +'cr4', +'cr5', +'cr6', +'cr7', +'xer', +'lr', +'ctr', +'fpscr' diff --git a/closures/compiler/powerpc/rppcgri.inc b/closures/compiler/powerpc/rppcgri.inc new file mode 100644 index 0000000000..b26f900caa --- /dev/null +++ b/closures/compiler/powerpc/rppcgri.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.dat } +0, +97, +98, +99, +100, +101, +102, +103, +104, +105, +108, +33, +34, +43, +44, +45, +46, +47, +48, +49, +50, +51, +52, +35, +53, +54, +55, +56, +57, +58, +59, +60, +61, +62, +36, +63, +64, +37, +38, +39, +40, +41, +42, +109, +107, +1, +2, +11, +12, +13, +14, +15, +16, +17, +18, +19, +20, +3, +21, +22, +23, +24, +25, +26, +27, +28, +29, +30, +4, +31, +32, +5, +6, +7, +8, +9, +10, +65, +66, +75, +76, +77, +78, +79, +80, +81, +82, +83, +84, +67, +85, +86, +87, +88, +89, +90, +91, +92, +93, +94, +68, +95, +96, +69, +70, +71, +72, +73, +74, +106 diff --git a/closures/compiler/powerpc/rppcgss.inc b/closures/compiler/powerpc/rppcgss.inc new file mode 100644 index 0000000000..5d5aa809d8 --- /dev/null +++ b/closures/compiler/powerpc/rppcgss.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.dat } +'INVALID', +'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', +'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', +'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', +'cr', +'cr0', +'cr1', +'cr2', +'cr3', +'cr4', +'cr5', +'cr6', +'cr7', +'xer', +'lr', +'ctr', +'fpscr' diff --git a/closures/compiler/powerpc/rppcmot.inc b/closures/compiler/powerpc/rppcmot.inc new file mode 100644 index 0000000000..4fc340afd7 --- /dev/null +++ b/closures/compiler/powerpc/rppcmot.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.dat } +'INVALID', +'r0', +'r1', +'r2', +'r3', +'r4', +'r5', +'r6', +'r7', +'r8', +'r9', +'r10', +'r11', +'r12', +'r13', +'r14', +'r15', +'r16', +'r17', +'r18', +'r19', +'r20', +'r21', +'r22', +'r23', +'r24', +'r25', +'r26', +'r27', +'r28', +'r29', +'r30', +'r31', +'F0', +'F1', +'F2', +'F3', +'F4', +'F5', +'F6', +'F7', +'F8', +'F9', +'F10', +'F11', +'F12', +'F13', +'F14', +'F15', +'F16', +'F17', +'F18', +'F19', +'F20', +'F21', +'F22', +'F23', +'F24', +'F25', +'F26', +'F27', +'F28', +'F29', +'F30', +'F31', +'M0', +'M1', +'M2', +'M3', +'M4', +'M5', +'M6', +'M7', +'M8', +'M9', +'M10', +'M11', +'M12', +'M13', +'M14', +'M15', +'M16', +'M17', +'M18', +'M19', +'M20', +'M21', +'M22', +'M23', +'M24', +'M25', +'M26', +'M27', +'M28', +'M29', +'M30', +'M31', +'CR', +'CR0', +'CR1', +'CR2', +'CR3', +'CR4', +'CR5', +'CR6', +'CR7', +'XER', +'LR', +'CTR', +'FPSCR' diff --git a/closures/compiler/powerpc/rppcmri.inc b/closures/compiler/powerpc/rppcmri.inc new file mode 100644 index 0000000000..9a59178c7d --- /dev/null +++ b/closures/compiler/powerpc/rppcmri.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.dat } +97, +98, +99, +100, +101, +102, +103, +104, +105, +108, +33, +34, +43, +44, +45, +46, +47, +48, +49, +50, +51, +52, +35, +53, +54, +55, +56, +57, +58, +59, +60, +61, +62, +36, +63, +64, +37, +38, +39, +40, +41, +42, +109, +0, +107, +65, +66, +75, +76, +77, +78, +79, +80, +81, +82, +83, +84, +67, +85, +86, +87, +88, +89, +90, +91, +92, +93, +94, +68, +95, +96, +69, +70, +71, +72, +73, +74, +106, +1, +2, +11, +12, +13, +14, +15, +16, +17, +18, +19, +20, +3, +21, +22, +23, +24, +25, +26, +27, +28, +29, +30, +4, +31, +32, +5, +6, +7, +8, +9, +10 diff --git a/closures/compiler/powerpc/rppcnor.inc b/closures/compiler/powerpc/rppcnor.inc new file mode 100644 index 0000000000..387be62acb --- /dev/null +++ b/closures/compiler/powerpc/rppcnor.inc @@ -0,0 +1,2 @@ +{ don't edit, this file is generated from ppcreg.dat } +110 diff --git a/closures/compiler/powerpc/rppcnum.inc b/closures/compiler/powerpc/rppcnum.inc new file mode 100644 index 0000000000..d612e34d8a --- /dev/null +++ b/closures/compiler/powerpc/rppcnum.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.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($01000010), +tregister($01000011), +tregister($01000012), +tregister($01000013), +tregister($01000014), +tregister($01000015), +tregister($01000016), +tregister($01000017), +tregister($01000018), +tregister($01000019), +tregister($0100001a), +tregister($0100001b), +tregister($0100001c), +tregister($0100001d), +tregister($0100001e), +tregister($0100001f), +tregister($02000000), +tregister($02000001), +tregister($02000002), +tregister($02000003), +tregister($02000004), +tregister($02000005), +tregister($02000006), +tregister($02000007), +tregister($02000008), +tregister($02000009), +tregister($0200000a), +tregister($0200000b), +tregister($0200000c), +tregister($0200000d), +tregister($0200000e), +tregister($0200000f), +tregister($02000010), +tregister($02000011), +tregister($02000012), +tregister($02000013), +tregister($02000014), +tregister($02000015), +tregister($02000016), +tregister($02000017), +tregister($02000018), +tregister($02000019), +tregister($0200001a), +tregister($0200001b), +tregister($0200001c), +tregister($0200001d), +tregister($0200001e), +tregister($0200001f), +tregister($03000000), +tregister($03000001), +tregister($03000002), +tregister($03000003), +tregister($03000004), +tregister($03000005), +tregister($03000006), +tregister($03000007), +tregister($03000008), +tregister($03000009), +tregister($0300000a), +tregister($0300000b), +tregister($0300000c), +tregister($0300000d), +tregister($0300000e), +tregister($0300000f), +tregister($03000010), +tregister($03000011), +tregister($03000012), +tregister($03000013), +tregister($03000014), +tregister($03000015), +tregister($03000016), +tregister($03000017), +tregister($03000018), +tregister($03000019), +tregister($0300001a), +tregister($0300001b), +tregister($0300001c), +tregister($0300001d), +tregister($0300001e), +tregister($0300001f), +tregister($05000000), +tregister($05000001), +tregister($05000002), +tregister($05000003), +tregister($05000004), +tregister($05000005), +tregister($05000006), +tregister($05000007), +tregister($05000008), +tregister($05000009), +tregister($0500000a), +tregister($0500000b), +tregister($0500000c) diff --git a/closures/compiler/powerpc/rppcrni.inc b/closures/compiler/powerpc/rppcrni.inc new file mode 100644 index 0000000000..1a49189c1d --- /dev/null +++ b/closures/compiler/powerpc/rppcrni.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.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, +73, +74, +75, +76, +77, +78, +79, +80, +81, +82, +83, +84, +85, +86, +87, +88, +89, +90, +91, +92, +93, +94, +95, +96, +97, +98, +99, +100, +101, +102, +103, +104, +105, +106, +107, +108, +109 diff --git a/closures/compiler/powerpc/rppcsri.inc b/closures/compiler/powerpc/rppcsri.inc new file mode 100644 index 0000000000..9a59178c7d --- /dev/null +++ b/closures/compiler/powerpc/rppcsri.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.dat } +97, +98, +99, +100, +101, +102, +103, +104, +105, +108, +33, +34, +43, +44, +45, +46, +47, +48, +49, +50, +51, +52, +35, +53, +54, +55, +56, +57, +58, +59, +60, +61, +62, +36, +63, +64, +37, +38, +39, +40, +41, +42, +109, +0, +107, +65, +66, +75, +76, +77, +78, +79, +80, +81, +82, +83, +84, +67, +85, +86, +87, +88, +89, +90, +91, +92, +93, +94, +68, +95, +96, +69, +70, +71, +72, +73, +74, +106, +1, +2, +11, +12, +13, +14, +15, +16, +17, +18, +19, +20, +3, +21, +22, +23, +24, +25, +26, +27, +28, +29, +30, +4, +31, +32, +5, +6, +7, +8, +9, +10 diff --git a/closures/compiler/powerpc/rppcstab.inc b/closures/compiler/powerpc/rppcstab.inc new file mode 100644 index 0000000000..2c9c9942a8 --- /dev/null +++ b/closures/compiler/powerpc/rppcstab.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.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, +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, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +68, +69, +70, +71, +72, +73, +74, +75, +76, +65, +66, +-1 diff --git a/closures/compiler/powerpc/rppcstd.inc b/closures/compiler/powerpc/rppcstd.inc new file mode 100644 index 0000000000..4fc340afd7 --- /dev/null +++ b/closures/compiler/powerpc/rppcstd.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.dat } +'INVALID', +'r0', +'r1', +'r2', +'r3', +'r4', +'r5', +'r6', +'r7', +'r8', +'r9', +'r10', +'r11', +'r12', +'r13', +'r14', +'r15', +'r16', +'r17', +'r18', +'r19', +'r20', +'r21', +'r22', +'r23', +'r24', +'r25', +'r26', +'r27', +'r28', +'r29', +'r30', +'r31', +'F0', +'F1', +'F2', +'F3', +'F4', +'F5', +'F6', +'F7', +'F8', +'F9', +'F10', +'F11', +'F12', +'F13', +'F14', +'F15', +'F16', +'F17', +'F18', +'F19', +'F20', +'F21', +'F22', +'F23', +'F24', +'F25', +'F26', +'F27', +'F28', +'F29', +'F30', +'F31', +'M0', +'M1', +'M2', +'M3', +'M4', +'M5', +'M6', +'M7', +'M8', +'M9', +'M10', +'M11', +'M12', +'M13', +'M14', +'M15', +'M16', +'M17', +'M18', +'M19', +'M20', +'M21', +'M22', +'M23', +'M24', +'M25', +'M26', +'M27', +'M28', +'M29', +'M30', +'M31', +'CR', +'CR0', +'CR1', +'CR2', +'CR3', +'CR4', +'CR5', +'CR6', +'CR7', +'XER', +'LR', +'CTR', +'FPSCR' diff --git a/closures/compiler/powerpc/rppcsup.inc b/closures/compiler/powerpc/rppcsup.inc new file mode 100644 index 0000000000..4e6f879355 --- /dev/null +++ b/closures/compiler/powerpc/rppcsup.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.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_R16 = $10; +RS_R17 = $11; +RS_R18 = $12; +RS_R19 = $13; +RS_R20 = $14; +RS_R21 = $15; +RS_R22 = $16; +RS_R23 = $17; +RS_R24 = $18; +RS_R25 = $19; +RS_R26 = $1a; +RS_R27 = $1b; +RS_R28 = $1c; +RS_R29 = $1d; +RS_R30 = $1e; +RS_R31 = $1f; +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_F8 = $08; +RS_F9 = $09; +RS_F10 = $0a; +RS_F11 = $0b; +RS_F12 = $0c; +RS_F13 = $0d; +RS_F14 = $0e; +RS_F15 = $0f; +RS_F16 = $10; +RS_F17 = $11; +RS_F18 = $12; +RS_F19 = $13; +RS_F20 = $14; +RS_F21 = $15; +RS_F22 = $16; +RS_F23 = $17; +RS_F24 = $18; +RS_F25 = $19; +RS_F26 = $1a; +RS_F27 = $1b; +RS_F28 = $1c; +RS_F29 = $1d; +RS_F30 = $1e; +RS_F31 = $1f; +RS_M0 = $00; +RS_M1 = $01; +RS_M2 = $02; +RS_M3 = $03; +RS_M4 = $04; +RS_M5 = $05; +RS_M6 = $06; +RS_M7 = $07; +RS_M8 = $08; +RS_M9 = $09; +RS_M10 = $0a; +RS_M11 = $0b; +RS_M12 = $0c; +RS_M13 = $0d; +RS_M14 = $0e; +RS_M15 = $0f; +RS_M16 = $10; +RS_M17 = $11; +RS_M18 = $12; +RS_M19 = $13; +RS_M20 = $14; +RS_M21 = $15; +RS_M22 = $16; +RS_M23 = $17; +RS_M24 = $18; +RS_M25 = $19; +RS_M26 = $1a; +RS_M27 = $1b; +RS_M28 = $1c; +RS_M29 = $1d; +RS_M30 = $1e; +RS_M31 = $1f; +RS_CR = $00; +RS_CR0 = $01; +RS_CR1 = $02; +RS_CR2 = $03; +RS_CR3 = $04; +RS_CR4 = $05; +RS_CR5 = $06; +RS_CR6 = $07; +RS_CR7 = $08; +RS_XER = $09; +RS_LR = $0a; +RS_CTR = $0b; +RS_FPSCR = $0c; diff --git a/closures/compiler/powerpc64/aoptcpu.pas b/closures/compiler/powerpc64/aoptcpu.pas new file mode 100644 index 0000000000..bd96f25524 --- /dev/null +++ b/closures/compiler/powerpc64/aoptcpu.pas @@ -0,0 +1,41 @@ +{ + Copyright (c) 1998-2002 by Jonas Maebe, member of the Free Pascal + Development Team + + This unit implements the PowerPC 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 + +{$I fpcdefs.inc} + +uses cpubase, aoptobj, aoptcpub, aopt; + +type + TCpuAsmOptimizer = class(TAsmOptimizer) + { uses the same constructor as TAopObj } + end; + +implementation + +begin + casmoptimizer := TCpuAsmOptimizer; +end. diff --git a/closures/compiler/powerpc64/aoptcpub.pas b/closures/compiler/powerpc64/aoptcpub.pas new file mode 100644 index 0000000000..b2e82450c5 --- /dev/null +++ b/closures/compiler/powerpc64/aoptcpub.pas @@ -0,0 +1,123 @@ +{ + 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 PowerPC64 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 + aasmcpu, AOptBase, cpubase; + +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 = 5; + + {Oper index of operand that contains the source (reference) with a load } + {instruction } + + LoadSrc = 1; + + {Oper index of operand that contains the destination (register) with a load } + {instruction } + + LoadDst = 0; + + {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_BC; + +implementation + +{ ************************************************************************* } +{ **************************** TCondRegs ********************************** } +{ ************************************************************************* } + +constructor TCondRegs.init; +begin +end; + +destructor TCondRegs.Done; +{$IFDEF inl}inline; +{$ENDIF inl} +begin +end; + +end. + diff --git a/closures/compiler/powerpc64/aoptcpuc.pas b/closures/compiler/powerpc64/aoptcpuc.pas new file mode 100644 index 0000000000..e002fedb21 --- /dev/null +++ b/closures/compiler/powerpc64/aoptcpuc.pas @@ -0,0 +1,40 @@ +{ + 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 + +{$I fpcdefs.inc} + +uses + AOptCs; + +type + TRegInfoCpu = object(TRegInfo) + end; + +implementation + +end. + diff --git a/closures/compiler/powerpc64/aoptcpud.pas b/closures/compiler/powerpc64/aoptcpud.pas new file mode 100644 index 0000000000..5e6e7fc308 --- /dev/null +++ b/closures/compiler/powerpc64/aoptcpud.pas @@ -0,0 +1,40 @@ +{ + 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. + diff --git a/closures/compiler/powerpc64/cgcpu.pas b/closures/compiler/powerpc64/cgcpu.pas new file mode 100644 index 0000000000..8b6282a7ec --- /dev/null +++ b/closures/compiler/powerpc64/cgcpu.pas @@ -0,0 +1,2199 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements the code generator for the PowerPC + + 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, symsym, + cgbase, cgobj,cgppc, + aasmbase, aasmcpu, aasmtai,aasmdata, + cpubase, cpuinfo, cgutils, rgcpu, + parabase; + +type + tcgppc = class(tcgppcgen) + procedure init_register_allocators; override; + procedure done_register_allocators; override; + + { passing parameters, per default the parameter is pushed } + { nr gives the number of the parameter (enumerated from } + { left to right), this allows to move the parameter to } + { register, if the cpu supports register calling } + { conventions } + procedure a_load_ref_cgpara(list: TAsmList; size: tcgsize; const r: treference; + const paraloc: tcgpara); override; + + procedure a_call_name(list: TAsmList; const s: string; weak: boolean); override; + procedure a_call_reg(list: TAsmList; reg: tregister); override; + + procedure a_op_const_reg(list: TAsmList; Op: TOpCG; size: TCGSize; a: + aint; reg: TRegister); override; + procedure a_op_reg_reg(list: TAsmList; Op: TOpCG; size: TCGSize; src, + dst: TRegister); override; + + procedure a_op_const_reg_reg(list: TAsmList; op: TOpCg; + size: tcgsize; a: aint; src, dst: tregister); override; + procedure a_op_reg_reg_reg(list: TAsmList; op: TOpCg; + size: tcgsize; src1, src2, dst: tregister); override; + + { move instructions } + procedure a_load_const_reg(list: TAsmList; size: tcgsize; a: aint; reg: + tregister); override; + { loads the memory pointed to by ref into register reg } + procedure a_load_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const + Ref: treference; reg: tregister); override; + procedure a_load_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, + reg2: tregister); override; + + procedure a_load_subsetreg_reg(list : TAsmList; subsetsize, tosize: tcgsize; const sreg: tsubsetregister; destreg: tregister); override; + procedure a_load_const_subsetreg(list: TAsmlist; subsetsize: tcgsize; a: aint; const sreg: tsubsetregister); override; + + { comparison operations } + procedure a_cmp_const_reg_label(list: TAsmList; size: tcgsize; cmp_op: + topcmp; a: aint; reg: tregister; + l: tasmlabel); override; + procedure a_cmp_reg_reg_label(list: TAsmList; size: tcgsize; cmp_op: + topcmp; reg1, reg2: tregister; l: tasmlabel); override; + + procedure a_jmp_name(list: TAsmList; const s: string); override; + procedure a_jmp_always(list: TAsmList; l: tasmlabel); override; + procedure a_jmp_flags(list: TAsmList; const f: TResFlags; l: tasmlabel); + override; + + procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: TResFlags; + reg: TRegister); override; + + { need to override this for ppc64 to avoid calling CG methods which allocate + registers during creation of the interface wrappers to subtract ioffset from + the self pointer. But register allocation does not take place for them (which + would probably be the generic fix) so we need to have a specialized method + that uses the R11 scratch register in these cases. + At the same time this allows > 32 bit offsets as well. + } + procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: aint);override; + + procedure g_profilecode(list: TAsmList); override; + procedure g_proc_entry(list: TAsmList; localsize: longint; nostackframe: + boolean); override; + procedure g_proc_exit(list: TAsmList; parasize: longint; nostackframe: + boolean); override; + procedure g_save_registers(list: TAsmList); override; + procedure g_restore_registers(list: TAsmList); override; + + procedure a_loadaddr_ref_reg(list: TAsmList; const ref: treference; r: + tregister); override; + + procedure g_concatcopy(list: TAsmList; const source, dest: treference; + len: aint); override; + + procedure g_external_wrapper(list: TAsmList; pd: TProcDef; const externalname: string); override; + + private + + procedure a_load_regconst_subsetreg_intern(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt); override; + + procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister); + + { returns whether a reference can be used immediately in a powerpc } + { instruction } + function issimpleref(const ref: treference): boolean; + + { contains the common code of a_load_reg_ref and a_load_ref_reg } + procedure a_load_store(list: TAsmList; op: tasmop; reg: tregister; + ref: treference); override; + + { returns the lowest numbered FP register in use, and the number of used FP registers + for the current procedure } + procedure calcFirstUsedFPR(out firstfpr : TSuperRegister; out fprcount : aint); + { returns the lowest numbered GP register in use, and the number of used GP registers + for the current procedure } + procedure calcFirstUsedGPR(out firstgpr : TSuperRegister; out gprcount : aint); + + { generates code to call a method with the given string name. The boolean options + control code generation. If prependDot is true, a single dot character is prepended to + the string, if addNOP is true a single NOP instruction is added after the call, and + if includeCall is true, the method is marked as having a call, not if false. This + option is particularly useful to prevent generation of a larger stack frame for the + register save and restore helper functions. } + procedure a_call_name_direct(list: TAsmList; s: string; weak: boolean; prependDot : boolean; + addNOP : boolean; includeCall : boolean = true); + + procedure a_jmp_name_direct(list : TAsmList; s : string; prependDot : boolean); + + { emits code to store the given value a into the TOC (if not already in there), and load it from there + as well } + procedure loadConstantPIC(list : TAsmList; size : TCGSize; a : aint; reg : TRegister); + + procedure profilecode_savepara(para : tparavarsym; list : TAsmList); + procedure profilecode_restorepara(para : tparavarsym; list : TAsmList); + end; + + procedure create_codegen; + +const + TShiftOpCG2AsmOpConst : array[boolean, OP_SAR..OP_SHR] of TAsmOp = ( + (A_SRAWI, A_SLWI, A_SRWI), (A_SRADI, A_SLDI, A_SRDI) + ); + +implementation + +uses + sysutils, cclasses, + globals, verbose, systems, cutils, + symconst, fmodule, + rgobj, tgobj, cpupi, procinfo, paramgr, cpupara; + +function is_signed_cgsize(const size : TCgSize) : Boolean; +begin + case size of + OS_S8,OS_S16,OS_S32,OS_S64 : result := true; + OS_8,OS_16,OS_32,OS_64 : result := false; + else + internalerror(2006050701); + end; +end; + +{$push} +{$r-} +{$q-} +{ helper function which calculate "magic" values for replacement of unsigned + division by constant operation by multiplication. See the PowerPC compiler + developer manual for more information } +procedure getmagic_unsignedN(const N : byte; const d : aWord; + out magic_m : aWord; out magic_add : boolean; out magic_shift : byte); +var + p : aInt; + nc, delta, q1, r1, q2, r2, two_N_minus_1 : aWord; +begin + assert(d > 0); + + two_N_minus_1 := aWord(1) shl (N-1); + + magic_add := false; +{$push} +{$warnings off } + nc := aWord(-1) - (-d) mod d; +{$pop} + p := N-1; { initialize p } + q1 := two_N_minus_1 div nc; { initialize q1 = 2p/nc } + r1 := two_N_minus_1 - q1*nc; { initialize r1 = rem(2p,nc) } + q2 := (two_N_minus_1-1) div d; { initialize q2 = (2p-1)/d } + r2 := (two_N_minus_1-1) - q2*d; { initialize r2 = rem((2p-1),d) } + repeat + inc(p); + if (r1 >= (nc - r1)) then begin + q1 := 2 * q1 + 1; { update q1 } + r1 := 2*r1 - nc; { update r1 } + end else begin + q1 := 2*q1; { update q1 } + r1 := 2*r1; { update r1 } + end; + if ((r2 + 1) >= (d - r2)) then begin + if (q2 >= (two_N_minus_1-1)) then + magic_add := true; + q2 := 2*q2 + 1; { update q2 } + r2 := 2*r2 + 1 - d; { update r2 } + end else begin + if (q2 >= two_N_minus_1) then + magic_add := true; + q2 := 2*q2; { update q2 } + r2 := 2*r2 + 1; { update r2 } + end; + delta := d - 1 - r2; + until not ((p < (2*N)) and ((q1 < delta) or ((q1 = delta) and (r1 = 0)))); + magic_m := q2 + 1; { resulting magic number } + magic_shift := p - N; { resulting shift } +end; + +{ helper function which calculate "magic" values for replacement of signed + division by constant operation by multiplication. See the PowerPC compiler + developer manual for more information } +procedure getmagic_signedN(const N : byte; const d : aInt; + out magic_m : aInt; out magic_s : aInt); +var + p : aInt; + ad, anc, delta, q1, r1, q2, r2, t : aWord; + two_N_minus_1 : aWord; + +begin + assert((d < -1) or (d > 1)); + + two_N_minus_1 := aWord(1) shl (N-1); + + ad := abs(d); + t := two_N_minus_1 + (aWord(d) shr (N-1)); + anc := t - 1 - t mod ad; { absolute value of nc } + p := (N-1); { initialize p } + q1 := two_N_minus_1 div anc; { initialize q1 = 2p/abs(nc) } + r1 := two_N_minus_1 - q1*anc; { initialize r1 = rem(2p,abs(nc)) } + q2 := two_N_minus_1 div ad; { initialize q2 = 2p/abs(d) } + r2 := two_N_minus_1 - q2*ad; { initialize r2 = rem(2p,abs(d)) } + repeat + inc(p); + q1 := 2*q1; { update q1 = 2p/abs(nc) } + r1 := 2*r1; { update r1 = rem(2p/abs(nc)) } + if (r1 >= anc) then begin { must be unsigned comparison } + inc(q1); + dec(r1, anc); + end; + q2 := 2*q2; { update q2 = 2p/abs(d) } + r2 := 2*r2; { update r2 = rem(2p/abs(d)) } + if (r2 >= ad) then begin { must be unsigned comparison } + inc(q2); + dec(r2, ad); + end; + delta := ad - r2; + until not ((q1 < delta) or ((q1 = delta) and (r1 = 0))); + magic_m := q2 + 1; + if (d < 0) then begin + magic_m := -magic_m; { resulting magic number } + end; + magic_s := p - N; { resulting shift } +end; +{$pop} + +{ finds positive and negative powers of two of the given value, returning the + power and whether it's a negative power or not in addition to the actual result + of the function } +function ispowerof2(value : aInt; out power : byte; out neg : boolean) : boolean; +var + i : longint; + hl : aInt; +begin + neg := false; + { also try to find negative power of two's by negating if the + value is negative. low(aInt) is special because it can not be + negated. Simply return the appropriate values for it } + if (value < 0) then begin + neg := true; + if (value = low(aInt)) then begin + power := sizeof(aInt)*8-1; + result := true; + exit; + end; + value := -value; + end; + + if ((value and (value-1)) <> 0) then begin + result := false; + exit; + end; + hl := 1; + for i := 0 to (sizeof(aInt)*8-1) do begin + if (hl = value) then begin + result := true; + power := i; + exit; + end; + hl := hl shl 1; + end; +end; + +{ returns the number of instruction required to load the given integer into a register. + This is basically a stripped down version of a_load_const_reg, increasing a counter + instead of emitting instructions. } +function getInstructionLength(a : aint) : longint; + + function get32bitlength(a : longint; var length : longint) : boolean; inline; + var + is_half_signed : byte; + begin + { if the lower 16 bits are zero, do a single LIS } + if (smallint(a) = 0) and ((a shr 16) <> 0) then begin + inc(length); + get32bitlength := longint(a) < 0; + end else begin + is_half_signed := ord(smallint(lo(a)) < 0); + inc(length); + if smallint(hi(a) + is_half_signed) <> 0 then + inc(length); + get32bitlength := (smallint(a) < 0) or (a < 0); + end; + end; + +var + extendssign : boolean; + +begin + result := 0; + if (lo(a) = 0) and (hi(a) <> 0) then begin + get32bitlength(hi(a), result); + inc(result); + end else begin + extendssign := get32bitlength(lo(a), result); + if (extendssign) and (hi(a) = 0) then + inc(result) + else if (not + ((extendssign and (longint(hi(a)) = -1)) or + ((not extendssign) and (hi(a)=0))) + ) then begin + get32bitlength(hi(a), result); + inc(result); + end; + end; +end; + +procedure tcgppc.init_register_allocators; +begin + inherited init_register_allocators; + if (target_info.system <> system_powerpc64_darwin) then + // r13 is tls, do not use, r2 is not available + rg[R_INTREGISTER] := trgintcpu.create(R_INTREGISTER, R_SUBWHOLE, + [{$ifdef user0} RS_R0, {$endif} RS_R3, RS_R4, RS_R5, RS_R6, RS_R7, RS_R8, + RS_R9, RS_R10, RS_R11, RS_R12, RS_R31, RS_R30, RS_R29, + RS_R28, RS_R27, RS_R26, RS_R25, RS_R24, RS_R23, RS_R22, + RS_R21, RS_R20, RS_R19, RS_R18, RS_R17, RS_R16, RS_R15, + RS_R14], first_int_imreg, []) + else + { special for darwin/ppc64: r2 available volatile, r13 = tls } + rg[R_INTREGISTER] := trgintcpu.create(R_INTREGISTER, R_SUBWHOLE, + [{$ifdef user0} RS_R0, {$endif} RS_R2, RS_R3, RS_R4, RS_R5, RS_R6, RS_R7, RS_R8, + RS_R9, RS_R10, RS_R11, RS_R12, RS_R31, RS_R30, RS_R29, + RS_R28, RS_R27, RS_R26, RS_R25, RS_R24, RS_R23, RS_R22, + RS_R21, RS_R20, RS_R19, RS_R18, RS_R17, RS_R16, RS_R15, + 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, RS_F8, RS_F9, + RS_F10, RS_F11, RS_F12, RS_F13, RS_F31, RS_F30, RS_F29, RS_F28, RS_F27, + RS_F26, RS_F25, RS_F24, RS_F23, RS_F22, RS_F21, RS_F20, RS_F19, RS_F18, + RS_F17, RS_F16, RS_F15, RS_F14], first_fpu_imreg, []); +{ TODO: FIX ME} + rg[R_MMREGISTER] := trgcpu.create(R_MMREGISTER, R_SUBNONE, + [RS_M0, RS_M1, RS_M2], first_mm_imreg, []); +end; + +procedure tcgppc.done_register_allocators; +begin + rg[R_INTREGISTER].free; + rg[R_FPUREGISTER].free; + rg[R_MMREGISTER].free; + inherited done_register_allocators; +end; + +procedure tcgppc.a_load_ref_cgpara(list: TAsmList; size: tcgsize; const r: + treference; const paraloc: tcgpara); + +var + tmpref, ref: treference; + location: pcgparalocation; + sizeleft: aint; + adjusttail : boolean; + +begin + location := paraloc.location; + tmpref := r; + sizeleft := paraloc.intsize; + adjusttail := false; + while assigned(location) do begin + paramanager.allocparaloc(list,location); + case location^.loc of + LOC_REGISTER, LOC_CREGISTER: + begin + if not(size in [OS_NO,OS_128,OS_S128]) then + a_load_ref_reg(list, size, location^.size, tmpref, + location^.register) + else begin + { load non-integral sized memory location into register. This + memory location be 1-sizeleft byte sized. + Always assume that this memory area is properly aligned, eg. start + loading the larger quantities for "odd" quantities first } + case sizeleft of + 1,2,4,8 : + a_load_ref_reg(list, int_cgsize(sizeleft), location^.size, tmpref, + location^.register); + 3 : begin + a_reg_alloc(list, NR_R12); + a_load_ref_reg(list, OS_16, location^.size, tmpref, + NR_R12); + inc(tmpref.offset, tcgsize2size[OS_16]); + a_load_ref_reg(list, OS_8, location^.size, tmpref, + location^.register); + list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, location^.register, NR_R12, 8, 40)); + a_reg_dealloc(list, NR_R12); + end; + 5 : begin + a_reg_alloc(list, NR_R12); + a_load_ref_reg(list, OS_32, location^.size, tmpref, NR_R12); + inc(tmpref.offset, tcgsize2size[OS_32]); + a_load_ref_reg(list, OS_8, location^.size, tmpref, location^.register); + list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, location^.register, NR_R12, 8, 24)); + a_reg_dealloc(list, NR_R12); + end; + 6 : begin + a_reg_alloc(list, NR_R12); + a_load_ref_reg(list, OS_32, location^.size, tmpref, NR_R12); + inc(tmpref.offset, tcgsize2size[OS_32]); + a_load_ref_reg(list, OS_16, location^.size, tmpref, location^.register); + list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, location^.register, NR_R12, 16, 16)); + a_reg_dealloc(list, NR_R12); + end; + 7 : begin + a_reg_alloc(list, NR_R12); + a_reg_alloc(list, NR_R0); + a_load_ref_reg(list, OS_32, location^.size, tmpref, NR_R12); + inc(tmpref.offset, tcgsize2size[OS_32]); + a_load_ref_reg(list, OS_16, location^.size, tmpref, NR_R0); + inc(tmpref.offset, tcgsize2size[OS_16]); + a_load_ref_reg(list, OS_8, location^.size, tmpref, location^.register); + list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, NR_R0, NR_R12, 16, 16)); + list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, location^.register, NR_R0, 8, 8)); + a_reg_dealloc(list, NR_R0); + a_reg_dealloc(list, NR_R12); + end; + else begin + { still > 8 bytes to load, so load data single register now } + a_load_ref_reg(list, location^.size, location^.size, tmpref, + location^.register); + { the block is > 8 bytes, so we have to store any bytes not + a multiple of the register size beginning with the MSB } + adjusttail := true; + end; + end; + if (adjusttail) and (sizeleft < sizeof(pint)) then + a_op_const_reg(list, OP_SHL, OS_INT, + (sizeof(pint) - sizeleft) * sizeof(pint), + location^.register); + end; + end; + LOC_REFERENCE: + begin + reference_reset_base(ref, location^.reference.index, + location^.reference.offset,paraloc.alignment); + 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, location^.size, tmpref, location^.register); + else + internalerror(2002072801); + end; + LOC_VOID: + { nothing to do } + ; + else + internalerror(2002081103); + end; + inc(tmpref.offset, tcgsize2size[location^.size]); + dec(sizeleft, tcgsize2size[location^.size]); + location := location^.next; + end; +end; + +{ calling a procedure by name } + +procedure tcgppc.a_call_name(list: TAsmList; const s: string; weak: boolean); +begin + if (target_info.system <> system_powerpc64_darwin) then + a_call_name_direct(list, s, weak, false, true) + else + begin + list.concat(taicpu.op_sym(A_BL,get_darwin_call_stub(s,weak))); + include(current_procinfo.flags,pi_do_call); + end; +end; + + +procedure tcgppc.a_call_name_direct(list: TAsmList; s: string; weak: boolean; prependDot : boolean; addNOP : boolean; includeCall : boolean); +begin + if (prependDot) then + s := '.' + s; + if not(weak) then + list.concat(taicpu.op_sym(A_BL, current_asmdata.RefAsmSymbol(s))) + else + list.concat(taicpu.op_sym(A_BL, current_asmdata.WeakRefAsmSymbol(s))); + if (addNOP) then + list.concat(taicpu.op_none(A_NOP)); + + if (includeCall) then + include(current_procinfo.flags, pi_do_call); +end; + + +{ calling a procedure by address } + +procedure tcgppc.a_call_reg(list: TAsmList; reg: tregister); +var + tmpref: treference; + tempreg : TRegister; +begin + if (target_info.system = system_powerpc64_darwin) then + inherited a_call_reg(list,reg) + else if (not (cs_opt_size in current_settings.optimizerswitches)) then begin + tempreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + { load actual function entry (reg contains the reference to the function descriptor) + into tempreg } + reference_reset_base(tmpref, reg, 0, sizeof(pint)); + a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, tempreg); + + { save TOC pointer in stackframe } + reference_reset_base(tmpref, NR_STACK_POINTER_REG, LA_RTOC_ELF, 8); + a_load_reg_ref(list, OS_ADDR, OS_ADDR, NR_RTOC, tmpref); + + { move actual function pointer to CTR register } + list.concat(taicpu.op_reg(A_MTCTR, tempreg)); + + { load new TOC pointer from function descriptor into RTOC register } + reference_reset_base(tmpref, reg, tcgsize2size[OS_ADDR], 8); + a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_RTOC); + + { load new environment pointer from function descriptor into R11 register } + reference_reset_base(tmpref, reg, 2*tcgsize2size[OS_ADDR], 8); + a_reg_alloc(list, NR_R11); + a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_R11); + { call function } + list.concat(taicpu.op_none(A_BCTRL)); + a_reg_dealloc(list, NR_R11); + end else begin + { call ptrgl helper routine which expects the pointer to the function descriptor + in R11 } + a_reg_alloc(list, NR_R11); + a_load_reg_reg(list, OS_ADDR, OS_ADDR, reg, NR_R11); + a_call_name_direct(list, '.ptrgl', false, false, false); + a_reg_dealloc(list, NR_R11); + end; + + { we need to load the old RTOC from stackframe because we changed it} + reference_reset_base(tmpref, NR_STACK_POINTER_REG, LA_RTOC_ELF, 8); + a_load_ref_reg(list, OS_ADDR, OS_ADDR, tmpref, NR_RTOC); + + include(current_procinfo.flags, pi_do_call); +end; + +{********************** load instructions ********************} + +procedure tcgppc.a_load_const_reg(list: TAsmList; size: TCGSize; a: aint; + reg: TRegister); + + { loads a 32 bit constant into the given register, using an optimal instruction sequence. + This is either LIS, LI or LI+ADDIS. + Returns true if during these operations the upper 32 bits were filled with 1 bits (e.g. + sign extension was performed) } + function load32bitconstant(list : TAsmList; size : TCGSize; a : longint; + reg : TRegister) : boolean; + var + is_half_signed : byte; + begin + { if the lower 16 bits are zero, do a single LIS } + if (smallint(a) = 0) and ((a shr 16) <> 0) then begin + list.concat(taicpu.op_reg_const(A_LIS, reg, smallint(hi(a)))); + load32bitconstant := longint(a) < 0; + end else begin + is_half_signed := ord(smallint(lo(a)) < 0); + list.concat(taicpu.op_reg_const(A_LI, reg, smallint(a and $ffff))); + if smallint(hi(a) + is_half_signed) <> 0 then begin + list.concat(taicpu.op_reg_reg_const(A_ADDIS, reg, reg, smallint(hi(a) + is_half_signed))); + end; + load32bitconstant := (smallint(a) < 0) or (a < 0); + end; + end; + + { loads a 32 bit constant into R0, using an optimal instruction sequence. + This is either LIS, LI or LI+ORIS. + Returns true if during these operations the upper 32 bits were filled with 1 bits (e.g. + sign extension was performed) } + function load32bitconstantR0(list : TAsmList; size : TCGSize; a : longint) : boolean; + begin + { if it's a value we can load with a single LI, do it } + if (a >= low(smallint)) and (a <= high(smallint)) then begin + list.concat(taicpu.op_reg_const(A_LI, NR_R0, smallint(a))); + end else begin + { if the lower 16 bits are zero, do a single LIS } + list.concat(taicpu.op_reg_const(A_LIS, NR_R0, smallint(a shr 16))); + if (smallint(a) <> 0) then begin + list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(a))); + end; + end; + load32bitconstantR0 := a < 0; + end; + + + { emits the code to load a constant by emitting various instructions into the output + code} + procedure loadConstantNormal(list: TAsmList; size : TCgSize; a: aint; reg: TRegister); + var + extendssign : boolean; + instr : taicpu; + begin + if (lo(a) = 0) and (hi(a) <> 0) then begin + { load only upper 32 bits, and shift } + load32bitconstant(list, size, longint(hi(a)), reg); + list.concat(taicpu.op_reg_reg_const(A_SLDI, reg, reg, 32)); + end else begin + { load lower 32 bits } + extendssign := load32bitconstant(list, size, longint(lo(a)), reg); + if (extendssign) and (hi(a) = 0) then + { if upper 32 bits are zero, but loading the lower 32 bit resulted in automatic + sign extension, clear those bits } + list.concat(taicpu.op_reg_reg_const_const(A_RLDICL, reg, reg, 0, 32)) + else if (not + ((extendssign and (longint(hi(a)) = -1)) or + ((not extendssign) and (hi(a)=0))) + ) then begin + { only load the upper 32 bits, if the automatic sign extension is not okay, + that is, _not_ if + - loading the lower 32 bits resulted in -1 in the upper 32 bits, and the upper + 32 bits should contain -1 + - loading the lower 32 bits resulted in 0 in the upper 32 bits, and the upper + 32 bits should contain 0 } + a_reg_alloc(list, NR_R0); + load32bitconstantR0(list, size, longint(hi(a))); + { combine both registers } + list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, reg, NR_R0, 32, 0)); + a_reg_dealloc(list, NR_R0); + end; + end; + end; + + {$IFDEF EXTDEBUG} +var + astring : string; + {$ENDIF EXTDEBUG} + +begin + {$IFDEF EXTDEBUG} + astring := 'a_load_const_reg ' + inttostr(hi(a)) + ' ' + inttostr(lo(a)) + ' ' + inttostr(ord(size)) + ' ' + inttostr(tcgsize2size[size]) + ' ' + hexstr(a, 16); + list.concat(tai_comment.create(strpnew(astring))); + {$ENDIF EXTDEBUG} + if not (size in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32, OS_64, OS_S64]) then + internalerror(2002090902); + { if PIC or basic optimizations are enabled, and the number of instructions which would be + required to load the value is greater than 2, store (and later load) the value from there } +// if (((cs_opt_peephole in current_settings.optimizerswitches) or (cs_create_pic in current_settings.moduleswitches)) and +// (getInstructionLength(a) > 2)) then +// loadConstantPIC(list, size, a, reg) +// else + loadConstantNormal(list, size, a, reg); +end; + + +procedure tcgppc.a_load_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; + const ref: treference; reg: tregister); + +const + LoadInstr: array[OS_8..OS_S64, boolean, boolean] of TAsmOp = + { indexed? updating? } + (((A_LBZ, A_LBZU), (A_LBZX, A_LBZUX)), + ((A_LHZ, A_LHZU), (A_LHZX, A_LHZUX)), + ((A_LWZ, A_LWZU), (A_LWZX, A_LWZUX)), + ((A_LD, A_LDU), (A_LDX, A_LDUX)), + { 128bit stuff too } + ((A_NONE, A_NONE), (A_NONE, A_NONE)), + { there's no load-byte-with-sign-extend :( } + ((A_LBZ, A_LBZU), (A_LBZX, A_LBZUX)), + ((A_LHA, A_LHAU), (A_LHAX, A_LHAUX)), + { there's no load-word-arithmetic-indexed with update, simulate it in code :( } + ((A_LWA, A_NOP), (A_LWAX, A_LWAUX)), + ((A_LD, A_LDU), (A_LDX, A_LDUX)) + ); +var + op: tasmop; + ref2: treference; + tmpreg: tregister; +begin + {$IFDEF EXTDEBUG} + list.concat(tai_comment.create(strpnew('a_load_ref_reg ' + ref2string(ref)))); + {$ENDIF EXTDEBUG} + + if not (fromsize in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32, OS_64, OS_S64]) then + internalerror(2002090904); + + { the caller is expected to have adjusted the reference already + in this case } + if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then + fromsize := tosize; + + ref2 := ref; + fixref(list, ref2); + + op := loadinstr[fromsize, ref2.index <> NR_NO, false]; + { there is no LWAU instruction, simulate using ADDI and LWA } + if (op = A_NOP) then begin + list.concat(taicpu.op_reg_reg_const(A_ADDI, reg, reg, ref2.offset)); + ref2.offset := 0; + op := A_LWA; + end; + a_load_store(list, op, reg, ref2); + { sign extend shortint if necessary (because there is + no load instruction to sign extend an 8 bit value automatically) + and mask out extra sign bits when loading from a smaller + signed to a larger unsigned type (where it matters) } + if (fromsize = OS_S8) then begin + a_load_reg_reg(list, OS_8, OS_S8, reg, reg); + a_load_reg_reg(list, OS_S8, tosize, reg, reg); + end else if (fromsize = OS_S16) and (tosize = OS_32) then + a_load_reg_reg(list, fromsize, tosize, reg, reg); +end; + +procedure tcgppc.a_load_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; + reg1, reg2: tregister); +var + instr: TAiCpu; + bytesize : byte; +begin + {$ifdef extdebug} + list.concat(tai_comment.create(strpnew('a_load_reg_reg from : ' + cgsize2string(fromsize) + ' to ' + cgsize2string(tosize)))); + {$endif} + + if (tcgsize2size[fromsize] > tcgsize2size[tosize]) or + ((tcgsize2size[fromsize] = tcgsize2size[tosize]) and (fromsize <> tosize)) or + { do we need to mask out the sign when loading from smaller signed to larger unsigned type? } + ( is_signed_cgsize(fromsize) and (not is_signed_cgsize(tosize)) and + (tcgsize2size[fromsize] < tcgsize2size[tosize]) and (tcgsize2size[tosize] <> sizeof(pint)) ) then begin + case tosize of + OS_S8: + instr := taicpu.op_reg_reg(A_EXTSB,reg2,reg1); + OS_S16: + instr := taicpu.op_reg_reg(A_EXTSH,reg2,reg1); + OS_S32: + instr := taicpu.op_reg_reg(A_EXTSW,reg2,reg1); + OS_8, OS_16, OS_32: + instr := taicpu.op_reg_reg_const_const(A_RLDICL, reg2, reg1, 0, (8-tcgsize2size[tosize])*8); + OS_S64, OS_64: + instr := taicpu.op_reg_reg(A_MR, reg2, reg1); + end; + end else + instr := taicpu.op_reg_reg(A_MR, reg2, reg1); + + list.concat(instr); + rg[R_INTREGISTER].add_move_instruction(instr); +end; + +procedure tcgppc.a_load_subsetreg_reg(list : TAsmList; subsetsize, tosize: tcgsize; const sreg: tsubsetregister; destreg: tregister); +begin + {$ifdef extdebug} + list.concat(tai_comment.create(strpnew('a_load_subsetreg_reg subsetregsize = ' + cgsize2string(sreg.subsetregsize) + ' subsetsize = ' + cgsize2string(subsetsize) + ' startbit = ' + intToStr(sreg.startbit) + ' tosize = ' + cgsize2string(tosize)))); + {$endif} + { do the extraction if required and then extend the sign correctly. (The latter is actually required only for signed subsets + and if that subset is not >= the tosize). } + if (sreg.startbit <> 0) or + (sreg.bitlen <> tcgsize2size[subsetsize]*8) then begin + list.concat(taicpu.op_reg_reg_const_const(A_RLDICL, destreg, sreg.subsetreg, (64 - sreg.startbit) and 63, 64 - sreg.bitlen)); + if (subsetsize in [OS_S8..OS_S128]) then + if ((sreg.bitlen mod 8) = 0) then begin + a_load_reg_reg(list, tcgsize2unsigned[subsetsize], subsetsize, destreg, destreg); + a_load_reg_reg(list, subsetsize, tosize, destreg, destreg); + end else begin + a_op_const_reg(list,OP_SHL,OS_INT,64-sreg.bitlen,destreg); + a_op_const_reg(list,OP_SAR,OS_INT,64-sreg.bitlen,destreg); + end; + end else begin + a_load_reg_reg(list, tcgsize2unsigned[sreg.subsetregsize], subsetsize, sreg.subsetreg, destreg); + a_load_reg_reg(list, subsetsize, tosize, destreg, destreg); + end; +end; + +procedure tcgppc.a_load_regconst_subsetreg_intern(list : TAsmList; fromsize, subsetsize: tcgsize; fromreg: tregister; const sreg: tsubsetregister; slopt: tsubsetloadopt); +begin + {$ifdef extdebug} + list.concat(tai_comment.create(strpnew('a_load_reg_subsetreg fromsize = ' + cgsize2string(fromsize) + ' subsetregsize = ' + cgsize2string(sreg.subsetregsize) + ' subsetsize = ' + cgsize2string(subsetsize) + ' startbit = ' + IntToStr(sreg.startbit)))); + {$endif} + if (slopt in [SL_SETZERO,SL_SETMAX]) then + inherited a_load_regconst_subsetreg_intern(list,fromsize,subsetsize,fromreg,sreg,slopt) + else if (sreg.bitlen <> sizeof(aint)*8) then + { simply use the INSRDI instruction } + list.concat(taicpu.op_reg_reg_const_const(A_INSRDI, sreg.subsetreg, fromreg, sreg.bitlen, (64 - (sreg.startbit + sreg.bitlen)) and 63)) + else + a_load_reg_reg(list, fromsize, subsetsize, fromreg, sreg.subsetreg); +end; + +procedure tcgppc.a_load_const_subsetreg(list: TAsmlist; subsetsize: tcgsize; + a: aint; const sreg: tsubsetregister); +var + tmpreg : TRegister; +begin + {$ifdef extdebug} + list.concat(tai_comment.create(strpnew('a_load_const_subsetreg subsetregsize = ' + cgsize2string(sreg.subsetregsize) + ' subsetsize = ' + cgsize2string(subsetsize) + ' startbit = ' + intToStr(sreg.startbit) + ' a = ' + intToStr(a)))); + {$endif} + { loading the constant into the lowest bits of a temp register and then inserting is + better than loading some usually large constants and do some masking and shifting on ppc64 } + tmpreg := getintregister(list,subsetsize); + a_load_const_reg(list,subsetsize,a,tmpreg); + a_load_reg_subsetreg(list, subsetsize, subsetsize, tmpreg, sreg); +end; + +procedure tcgppc.a_op_const_reg(list: TAsmList; Op: TOpCG; size: TCGSize; a: + aint; reg: TRegister); +begin + a_op_const_reg_reg(list, op, size, a, reg, reg); +end; + +procedure tcgppc.a_op_reg_reg(list: TAsmList; Op: TOpCG; size: TCGSize; src, + dst: TRegister); +begin + a_op_reg_reg_reg(list, op, size, src, dst, dst); +end; + +procedure tcgppc.a_op_const_reg_reg(list: TAsmList; op: TOpCg; + size: tcgsize; a: aint; src, dst: tregister); +var + useReg : boolean; + + procedure do_lo_hi(loOp, hiOp : TAsmOp); + begin + { Optimization for logical ops (excluding AND), trying to do this as efficiently + as possible by only generating code for the affected halfwords. Note that all + the instructions handled here must have "X op 0 = X" for every halfword. } + usereg := false; + if (aword(a) > high(dword)) then begin + usereg := true; + end else begin + if (word(a) <> 0) then begin + list.concat(taicpu.op_reg_reg_const(loOp, dst, src, word(a))); + if (word(a shr 16) <> 0) then + list.concat(taicpu.op_reg_reg_const(hiOp, dst, dst, word(a shr 16))); + end else if (word(a shr 16) <> 0) then + list.concat(taicpu.op_reg_reg_const(hiOp, dst, src, word(a shr 16))); + end; + end; + + procedure do_lo_hi_and; + begin + { optimization logical and with immediate: only use "andi." for 16 bit + ands, otherwise use register method. Doing this for 32 bit constants + would not give any advantage to the register method (via useReg := true), + requiring a scratch register and three instructions. } + usereg := false; + if (aword(a) > high(word)) then + usereg := true + else + list.concat(taicpu.op_reg_reg_const(A_ANDI_, dst, src, word(a))); + end; + + procedure do_constant_div(list : TAsmList; size : TCgSize; a : aint; src, dst : TRegister; + signed : boolean); + const + negops : array[boolean] of tasmop = (A_NEG, A_NEGO); + var + magic, shift : int64; + u_magic : qword; + u_shift : byte; + u_add : boolean; + power : byte; + isNegPower : boolean; + + divreg : tregister; + begin + if (a = 0) then begin + internalerror(2005061701); + end else if (a = 1) then begin + cg.a_load_reg_reg(current_asmdata.CurrAsmList, OS_INT, OS_INT, src, dst); + end else if (a = -1) and (signed) then begin + { note: only in the signed case possible..., may overflow } + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(negops[cs_check_overflow in current_settings.localswitches], dst, src)); + end else if (ispowerof2(a, power, isNegPower)) then begin + if (signed) then begin + { From "The PowerPC Compiler Writer's Guide", pg. 52ff } + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SAR, OS_INT, power, + src, dst); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_ADDZE, dst, dst)); + if (isNegPower) then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_NEG, dst, dst)); + end else begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_INT, power, src, dst) + end; + end else begin + { replace division by multiplication, both implementations } + { from "The PowerPC Compiler Writer's Guide" pg. 53ff } + divreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + if (signed) then begin + getmagic_signedN(sizeof(aInt)*8, a, magic, shift); + { load magic value } + cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, magic, divreg); + { multiply } + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULHD, dst, src, divreg)); + { add/subtract numerator } + if (a > 0) and (magic < 0) then begin + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_ADD, OS_INT, src, dst, dst); + end else if (a < 0) and (magic > 0) then begin + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_SUB, OS_INT, src, dst, dst); + end; + { shift shift places to the right (arithmetic) } + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SAR, OS_INT, shift, dst, dst); + { extract and add sign bit } + if (a >= 0) then begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_INT, 63, src, divreg); + end else begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_INT, 63, dst, divreg); + end; + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_ADD, OS_INT, dst, divreg, dst); + end else begin + getmagic_unsignedN(sizeof(aWord)*8, a, u_magic, u_add, u_shift); + { load magic in divreg } + cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, aint(u_magic), divreg); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULHDU, dst, src, divreg)); + if (u_add) then begin + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_SUB, OS_INT, dst, src, divreg); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_INT, 1, divreg, divreg); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_ADD, OS_INT, divreg, dst, divreg); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_INT, u_shift-1, divreg, dst); + end else begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SHR, OS_INT, u_shift, dst, dst); + end; + end; + end; + end; + +var + scratchreg: tregister; + shift : byte; + shiftmask : longint; + isneg : boolean; + +begin + { subtraction is the same as addition with negative constant } + if op = OP_SUB then begin + a_op_const_reg_reg(list, OP_ADD, size, -a, src, dst); + exit; + end; + {$IFDEF EXTDEBUG} + list.concat(tai_comment.create(strpnew('a_op_const_reg_reg ' + cgop2string(op)))); + {$ENDIF EXTDEBUG} + + { This case includes some peephole optimizations for the various operations, + (e.g. AND, OR, XOR, ..) - can't this be done at some higher level, + independent of architecture? } + + { assume that we do not need a scratch register for the operation } + useReg := false; + case (op) of + OP_DIV, OP_IDIV: + if (cs_opt_level1 in current_settings.optimizerswitches) then + do_constant_div(list, size, a, src, dst, op = OP_IDIV) + else + usereg := true; + OP_IMUL, OP_MUL: + { idea: factorize constant multiplicands and use adds/shifts with few factors; + however, even a 64 bit multiply is already quite fast on PPC64 } + if (a = 0) then + a_load_const_reg(list, size, 0, dst) + else if (a = -1) then + list.concat(taicpu.op_reg_reg(A_NEG, dst, dst)) + else if (a = 1) then + a_load_reg_reg(list, OS_INT, OS_INT, src, dst) + else if ispowerof2(a, shift, isneg) then begin + list.concat(taicpu.op_reg_reg_const(A_SLDI, dst, src, shift)); + if (isneg) then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_NEG, dst, dst)); + end else if (a >= low(smallint)) and (a <= high(smallint)) then + list.concat(taicpu.op_reg_reg_const(A_MULLI, dst, src, + smallint(a))) + else + usereg := true; + OP_ADD: + if (a = 0) then + a_load_reg_reg(list, size, size, src, dst) + else if (a >= low(smallint)) and (a <= high(smallint)) then + list.concat(taicpu.op_reg_reg_const(A_ADDI, dst, src, smallint(a))) + else + useReg := true; + OP_OR: + if (a = 0) then + a_load_reg_reg(list, size, size, src, dst) + else if (a = -1) then + a_load_const_reg(list, size, -1, dst) + else + do_lo_hi(A_ORI, A_ORIS); + OP_AND: + if (a = 0) then + a_load_const_reg(list, size, 0, dst) + else if (a = -1) then + a_load_reg_reg(list, size, size, src, dst) + else + do_lo_hi_and; + OP_XOR: + if (a = 0) then + a_load_reg_reg(list, size, size, src, dst) + else if (a = -1) then + list.concat(taicpu.op_reg_reg(A_NOT, dst, src)) + else + do_lo_hi(A_XORI, A_XORIS); + OP_ROL: + begin + if (size in [OS_64, OS_S64]) then begin + list.concat(taicpu.op_reg_reg_const_const(A_RLDICL, dst, src, a and 63, 0)); + end else if (size in [OS_32, OS_S32]) then begin + list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM, dst, src, a and 31, 0, 31)); + end else begin + internalerror(2008091303); + end; + end; + OP_ROR: + begin + if (size in [OS_64, OS_S64]) then begin + list.concat(taicpu.op_reg_reg_const_const(A_RLDICL, dst, src, ((64 - a) and 63), 0)); + end else if (size in [OS_32, OS_S32]) then begin + list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM, dst, src, (32 - a) and 31, 0, 31)); + end else begin + internalerror(2008091304); + end; + end; + OP_SHL, OP_SHR, OP_SAR: + begin + if (size in [OS_64, OS_S64]) then + shift := 6 + else + shift := 5; + + shiftmask := (1 shl shift)-1; + if (a and shiftmask) <> 0 then begin + list.concat(taicpu.op_reg_reg_const( + TShiftOpCG2AsmOpConst[size in [OS_64, OS_S64], op], dst, src, a and shiftmask)); + end else + a_load_reg_reg(list, size, size, src, dst); + if ((a shr shift) <> 0) then + internalError(68991); + end + else + internalerror(200109091); + end; + { if all else failed, load the constant in a register and then + perform the operation } + if (useReg) then begin + scratchreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); + a_load_const_reg(list, size, a, scratchreg); + a_op_reg_reg_reg(list, op, size, scratchreg, src, dst); + end else + maybeadjustresult(list, op, size, dst); +end; + +procedure tcgppc.a_op_reg_reg_reg(list: TAsmList; op: TOpCg; + size: tcgsize; src1, src2, dst: tregister); +const + op_reg_reg_opcg2asmop32: array[TOpCG] of tasmop = + (A_NONE, A_MR, A_ADD, A_AND, A_DIVWU, A_DIVW, A_MULLW, A_MULLW, A_NEG, A_NOT, A_OR, + A_SRAW, A_SLW, A_SRW, A_SUB, A_XOR, A_NONE, A_NONE); + op_reg_reg_opcg2asmop64: array[TOpCG] of tasmop = + (A_NONE, A_MR, A_ADD, A_AND, A_DIVDU, A_DIVD, A_MULLD, A_MULLD, A_NEG, A_NOT, A_OR, + A_SRAD, A_SLD, A_SRD, A_SUB, A_XOR, A_NONE, A_NONE); +var + tmpreg : TRegister; +begin + case op of + OP_NEG, OP_NOT: + begin + list.concat(taicpu.op_reg_reg(op_reg_reg_opcg2asmop64[op], dst, src1)); + if (op = OP_NOT) and not (size in [OS_64, OS_S64]) then + { zero/sign extend result again, fromsize is not important here } + a_load_reg_reg(list, OS_S64, size, dst, dst) + end; + OP_ROL: + begin + if (size in [OS_64, OS_S64]) then begin + list.concat(taicpu.op_reg_reg_reg_const(A_RLDCL, dst, src2, src1, 0)); + end else if (size in [OS_32, OS_S32]) then begin + list.concat(taicpu.op_reg_reg_reg_const_const(A_RLWNM, dst, src2, src1, 0, 31)); + end else begin + internalerror(2008091301); + end; + end; + OP_ROR: + begin + tmpreg := getintregister(current_asmdata.CurrAsmList, OS_INT); + list.concat(taicpu.op_reg_reg(A_NEG, tmpreg, src1)); + if (size in [OS_64, OS_S64]) then begin + list.concat(taicpu.op_reg_reg_reg_const(A_RLDCL, dst, src2, tmpreg, 0)); + end else if (size in [OS_32, OS_S32]) then begin + list.concat(taicpu.op_reg_reg_reg_const_const(A_RLWNM, dst, src2, tmpreg, 0, 31)); + end else begin + internalerror(2008091302); + end; + end; + else + if (size in [OS_64, OS_S64]) then begin + list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop64[op], dst, src2, + src1)); + end else begin + list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop32[op], dst, src2, + src1)); + maybeadjustresult(list, op, size, dst); + end; + end; +end; + +{*************** compare instructructions ****************} + +procedure tcgppc.a_cmp_const_reg_label(list: TAsmList; size: tcgsize; + cmp_op: topcmp; a: aint; reg: tregister; l: tasmlabel); +const + { unsigned useconst 32bit-op } + cmpop_table : array[boolean, boolean, boolean] of TAsmOp = ( + ((A_CMPD, A_CMPW), (A_CMPDI, A_CMPWI)), + ((A_CMPLD, A_CMPLW), (A_CMPLDI, A_CMPLWI)) + ); + +var + tmpreg : TRegister; + signed, useconst : boolean; + opsize : TCgSize; + op : TAsmOp; +begin + {$IFDEF EXTDEBUG} + list.concat(tai_comment.create(strpnew('a_cmp_const_reg_label ' + cgsize2string(size) + ' ' + booltostr(cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE]) + ' ' + inttostr(a) ))); + {$ENDIF EXTDEBUG} + + signed := cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE]; + { in the following case, we generate more efficient code when + signed is true } + if (cmp_op in [OC_EQ, OC_NE]) and + (aword(a) > $FFFF) then + signed := true; + + opsize := size; + + { do we need to change the operand size because ppc64 only supports 32 and + 64 bit compares? } + if (not (size in [OS_32, OS_S32, OS_64, OS_S64])) then begin + if (signed) then + opsize := OS_S32 + else + opsize := OS_32; + a_load_reg_reg(current_asmdata.CurrAsmList, size, opsize, reg, reg); + end; + + { can we use immediate compares? } + useconst := (signed and ( (a >= low(smallint)) and (a <= high(smallint)))) or + ((not signed) and (aword(a) <= $FFFF)); + + op := cmpop_table[not signed, useconst, opsize in [OS_32, OS_S32]]; + + if (useconst) then begin + list.concat(taicpu.op_reg_reg_const(op, NR_CR0, reg, a)); + end else begin + tmpreg := getintregister(current_asmdata.CurrAsmList, OS_INT); + a_load_const_reg(current_asmdata.CurrAsmList, opsize, a, tmpreg); + list.concat(taicpu.op_reg_reg_reg(op, NR_CR0, reg, tmpreg)); + end; + + a_jmp(list, A_BC, TOpCmp2AsmCond[cmp_op], 0, l); +end; + +procedure tcgppc.a_cmp_reg_reg_label(list: TAsmList; size: tcgsize; + cmp_op: topcmp; reg1, reg2: tregister; l: tasmlabel); +var + op: tasmop; +begin + {$IFDEF extdebug} + list.concat(tai_comment.create(strpnew('a_cmp_reg_reg_label, size ' + cgsize2string(size) + ' op ' + inttostr(ord(cmp_op))))); + {$ENDIF extdebug} + + {$note Commented out below check because of compiler weirdness} + { + if (not (size in [OS_32, OS_S32, OS_64, OS_S64])) then + internalerror(200606041); + } + + if cmp_op in [OC_GT, OC_LT, OC_GTE, OC_LTE] then + if (size in [OS_64, OS_S64]) then + op := A_CMPD + else + op := A_CMPW + else + if (size in [OS_64, OS_S64]) then + op := A_CMPLD + else + op := A_CMPLW; + list.concat(taicpu.op_reg_reg_reg(op, NR_CR0, reg2, reg1)); + a_jmp(list, A_BC, TOpCmp2AsmCond[cmp_op], 0, l); +end; + +procedure tcgppc.a_jmp_name_direct(list : TAsmList; s : string; prependDot : boolean); +var + p: taicpu; +begin + if (prependDot) then + s := '.' + s; + p := taicpu.op_sym(A_B, current_asmdata.RefAsmSymbol(s)); + p.is_jmp := true; + list.concat(p) +end; + +procedure tcgppc.a_jmp_name(list: TAsmList; const s: string); +var + p: taicpu; +begin + if (target_info.system = system_powerpc64_darwin) then + begin + p := taicpu.op_sym(A_B,get_darwin_call_stub(s,false)); + p.is_jmp := true; + list.concat(p) + end + else + a_jmp_name_direct(list, s, true); +end; + +procedure tcgppc.a_jmp_always(list: TAsmList; l: tasmlabel); + +begin + a_jmp(list, A_B, C_None, 0, l); +end; + +procedure tcgppc.a_jmp_flags(list: TAsmList; const f: TResFlags; l: + tasmlabel); + +var + c: tasmcond; +begin + c := flags_to_cond(f); + a_jmp(list, A_BC, c.cond, c.cr - RS_CR0, l); +end; + +procedure tcgppc.g_flags2reg(list: TAsmList; size: TCgSize; const f: + TResFlags; reg: TRegister); +var + testbit: byte; + bitvalue: boolean; +begin + { get the bit to extract from the conditional register + its requested value (0 or 1) } + testbit := ((f.cr - RS_CR0) * 4); + case f.flag of + F_EQ, F_NE: + begin + inc(testbit, 2); + bitvalue := f.flag = F_EQ; + end; + F_LT, F_GE: + begin + bitvalue := f.flag = F_LT; + end; + F_GT, F_LE: + begin + inc(testbit); + bitvalue := f.flag = F_GT; + end; + else + internalerror(200112261); + end; + { load the conditional register in the destination reg } + list.concat(taicpu.op_reg(A_MFCR, reg)); + { we will move the bit that has to be tested to bit 0 by rotating left } + testbit := (testbit + 1) and 31; + { extract bit } + list.concat(taicpu.op_reg_reg_const_const_const( + A_RLWINM,reg,reg,testbit,31,31)); + + { if we need the inverse, xor with 1 } + if not bitvalue then + list.concat(taicpu.op_reg_reg_const(A_XORI, reg, reg, 1)); +end; + +{ *********** entry/exit code and address loading ************ } + +procedure tcgppc.g_save_registers(list: TAsmList); +begin + { this work is done in g_proc_entry; additionally it is not safe + to use it because it is called at some weird time } +end; + +procedure tcgppc.g_restore_registers(list: TAsmList); +begin + { this work is done in g_proc_exit; mainly because it is not safe to + put the register restore code here because it is called at some weird time } +end; + +procedure tcgppc.calcFirstUsedFPR(out firstfpr : TSuperRegister; out fprcount : aint); +var + reg : TSuperRegister; +begin + fprcount := 0; + firstfpr := RS_F31; + if not (po_assembler in current_procinfo.procdef.procoptions) then + for reg := RS_F14 to RS_F31 do + if reg in rg[R_FPUREGISTER].used_in_proc then begin + fprcount := ord(RS_F31)-ord(reg)+1; + firstfpr := reg; + break; + end; +end; + +procedure tcgppc.calcFirstUsedGPR(out firstgpr : TSuperRegister; out gprcount : aint); +var + reg : TSuperRegister; +begin + gprcount := 0; + firstgpr := RS_R31; + if not (po_assembler in current_procinfo.procdef.procoptions) then + for reg := RS_R14 to RS_R31 do + if reg in rg[R_INTREGISTER].used_in_proc then begin + gprcount := ord(RS_R31)-ord(reg)+1; + firstgpr := reg; + break; + end; +end; + +procedure tcgppc.profilecode_savepara(para : tparavarsym; list : TAsmList); +begin + case (para.paraloc[calleeside].location^.loc) of + LOC_REGISTER, LOC_CREGISTER: + a_load_reg_ref(list, OS_INT, para.paraloc[calleeside].Location^.size, + para.paraloc[calleeside].Location^.register, para.localloc.reference); + LOC_FPUREGISTER, LOC_CFPUREGISTER: + a_loadfpu_reg_ref(list, para.paraloc[calleeside].Location^.size, + para.paraloc[calleeside].Location^.size, + para.paraloc[calleeside].Location^.register, para.localloc.reference); + LOC_MMREGISTER, LOC_CMMREGISTER: + { not supported } + internalerror(2006041801); + end; +end; + +procedure tcgppc.profilecode_restorepara(para : tparavarsym; list : TAsmList); +begin + case (para.paraloc[calleeside].Location^.loc) of + LOC_REGISTER, LOC_CREGISTER: + a_load_ref_reg(list, para.paraloc[calleeside].Location^.size, OS_INT, + para.localloc.reference, para.paraloc[calleeside].Location^.register); + LOC_FPUREGISTER, LOC_CFPUREGISTER: + a_loadfpu_ref_reg(list, para.paraloc[calleeside].Location^.size, + para.paraloc[calleeside].Location^.size, + para.localloc.reference, para.paraloc[calleeside].Location^.register); + LOC_MMREGISTER, LOC_CMMREGISTER: + { not supported } + internalerror(2006041802); + end; +end; + +procedure tcgppc.g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: aint); +var + hsym : tsym; + href : treference; + paraloc : Pcgparalocation; +begin + if ((ioffset >= low(smallint)) and (ioffset < high(smallint))) then begin + { the original method can handle this } + inherited g_adjust_self_value(list, procdef, ioffset); + exit; + end; + { calculate the parameter info for the procdef } + procdef.init_paraloc_info(callerside); + hsym:=tsym(procdef.parast.Find('self')); + if not(assigned(hsym) and + (hsym.typ=paravarsym)) then + internalerror(2010103101); + paraloc:=tparavarsym(hsym).paraloc[callerside].location; + while paraloc<>nil do + with paraloc^ do begin + case loc of + LOC_REGISTER: + begin + a_load_const_reg(list, size, ioffset, NR_R11); + a_op_reg_reg(list, OP_SUB, size, NR_R11, register); + end else + internalerror(2010103102); + end; + paraloc:=next; + end; +end; + +procedure tcgppc.g_profilecode(list: TAsmList); +begin + current_procinfo.procdef.paras.ForEachCall(TObjectListCallback(@profilecode_savepara), list); + + a_call_name_direct(list, '_mcount', false, false, true); + + current_procinfo.procdef.paras.ForEachCall(TObjectListCallback(@profilecode_restorepara), list); +end; + +{ Generates the entry code of a procedure/function. + + This procedure may be called before, as well as after g_return_from_proc + is called. localsize is the sum of the size necessary for local variables + and the maximum possible combined size of ALL the parameters of a procedure + called by the current one + + IMPORTANT: registers are not to be allocated through the register + allocator here, because the register colouring has already occured !! +} +procedure tcgppc.g_proc_entry(list: TAsmList; localsize: longint; + nostackframe: boolean); +var + firstregfpu, firstreggpr: TSuperRegister; + needslinkreg: boolean; + + fprcount, gprcount : aint; + + { Save standard registers, both FPR and GPR; does not support VMX/Altivec } + procedure save_standard_registers; + var + regcount : TSuperRegister; + href : TReference; + mayNeedLRStore : boolean; + begin + { there are two ways to do this: manually, by generating a few "std" instructions, + or via the restore helper functions. The latter are selected by the -Og switch, + i.e. "optimize for size" } + if (cs_opt_size in current_settings.optimizerswitches) and + (target_info.system <> system_powerpc64_darwin) then begin + mayNeedLRStore := false; + if ((fprcount > 0) and (gprcount > 0)) then begin + a_op_const_reg_reg(list, OP_SUB, OS_INT, 8 * fprcount, NR_R1, NR_R12); + a_call_name_direct(list, '_savegpr1_' + intToStr(32-gprcount), false, false, false, false); + a_call_name_direct(list, '_savefpr_' + intToStr(32-fprcount), false, false, false, false); + end else if (gprcount > 0) then + a_call_name_direct(list, '_savegpr0_' + intToStr(32-gprcount), false, false, false, false) + else if (fprcount > 0) then + a_call_name_direct(list, '_savefpr_' + intToStr(32-fprcount), false, false, false, false) + else + mayNeedLRStore := true; + end else begin + { save registers, FPU first, then GPR } + reference_reset_base(href, NR_STACK_POINTER_REG, -8, 8); + if (fprcount > 0) then + for regcount := RS_F31 downto firstregfpu do begin + a_loadfpu_reg_ref(list, OS_FLOAT, OS_FLOAT, newreg(R_FPUREGISTER, + regcount, R_SUBNONE), href); + dec(href.offset, tcgsize2size[OS_FLOAT]); + end; + if (gprcount > 0) then + for regcount := RS_R31 downto firstreggpr do begin + a_load_reg_ref(list, OS_INT, OS_INT, newreg(R_INTREGISTER, regcount, + R_SUBNONE), href); + dec(href.offset, sizeof(pint)); + end; + { VMX registers not supported by FPC atm } + + { in this branch we always need to store LR ourselves} + mayNeedLRStore := true; + end; + + { we may need to store R0 (=LR) ourselves } + if ((cs_profile in init_settings.moduleswitches) or (mayNeedLRStore)) and (needslinkreg) then begin + reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_ELF, 8); + list.concat(taicpu.op_reg_ref(A_STD, NR_R0, href)); + end; + end; + +var + href: treference; +begin + calcFirstUsedFPR(firstregfpu, fprcount); + calcFirstUsedGPR(firstreggpr, gprcount); + + { calculate real stack frame size } + localsize := tppcprocinfo(current_procinfo).calc_stackframe_size( + gprcount, fprcount); + + { determine whether we need to save the link register } + needslinkreg := + not(nostackframe) and + (save_lr_in_prologue or + ((cs_opt_size in current_settings.optimizerswitches) and + ((fprcount > 0) or + (gprcount > 0)))); + + a_reg_alloc(list, NR_STACK_POINTER_REG); + a_reg_alloc(list, NR_R0); + + { move link register to r0 } + if (needslinkreg) then + list.concat(taicpu.op_reg(A_MFLR, NR_R0)); + + save_standard_registers; + + { save old stack frame pointer } + if (tppcprocinfo(current_procinfo).needs_frame_pointer) then begin + a_reg_alloc(list, NR_OLD_STACK_POINTER_REG); + list.concat(taicpu.op_reg_reg(A_MR, NR_OLD_STACK_POINTER_REG, NR_STACK_POINTER_REG)); + end; + + { create stack frame } + if (not nostackframe) and (localsize > 0) and + tppcprocinfo(current_procinfo).needstackframe then begin + if (localsize <= high(smallint)) then begin + reference_reset_base(href, NR_STACK_POINTER_REG, -localsize, 8); + a_load_store(list, A_STDU, NR_STACK_POINTER_REG, href); + end else begin + reference_reset_base(href, NR_NO, -localsize, 8); + + { Use R0 for loading the constant (which is definitely > 32k when entering + this branch). + + Inlined at this position because it must not use temp registers because + register allocations have already been done } + { Code template: + lis r0,ofs@highest + ori r0,r0,ofs@higher + sldi r0,r0,32 + oris r0,r0,ofs@h + ori r0,r0,ofs@l + } + list.concat(taicpu.op_reg_const(A_LIS, NR_R0, word(href.offset shr 48))); + list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset shr 32))); + list.concat(taicpu.op_reg_reg_const(A_SLDI, NR_R0, NR_R0, 32)); + list.concat(taicpu.op_reg_reg_const(A_ORIS, NR_R0, NR_R0, word(href.offset shr 16))); + list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset))); + + list.concat(taicpu.op_reg_reg_reg(A_STDUX, NR_R1, NR_R1, NR_R0)); + end; + end; + + { CR register not used by FPC atm } + + { keep R1 allocated??? } + a_reg_dealloc(list, NR_R0); +end; + +{ Generates the exit code for a method. + + This procedure may be called before, as well as after g_stackframe_entry + is called. + + IMPORTANT: registers are not to be allocated through the register + allocator here, because the register colouring has already occured !! +} +procedure tcgppc.g_proc_exit(list: TAsmList; parasize: longint; nostackframe: + boolean); +var + firstregfpu, firstreggpr: TSuperRegister; + needslinkreg : boolean; + fprcount, gprcount: aint; + + { Restore standard registers, both FPR and GPR; does not support VMX/Altivec } + procedure restore_standard_registers; + var + { flag indicating whether we need to manually add the exit code (e.g. blr instruction) + or not } + needsExitCode : Boolean; + href : treference; + regcount : TSuperRegister; + begin + { there are two ways to do this: manually, by generating a few "ld" instructions, + or via the restore helper functions. The latter are selected by the -Og switch, + i.e. "optimize for size" } + if (cs_opt_size in current_settings.optimizerswitches) then begin + needsExitCode := false; + if ((fprcount > 0) and (gprcount > 0)) then begin + a_op_const_reg_reg(list, OP_SUB, OS_INT, 8 * fprcount, NR_R1, NR_R12); + a_call_name_direct(list, '_restgpr1_' + intToStr(32-gprcount), false, false, false, false); + a_jmp_name_direct(list, '_restfpr_' + intToStr(32-fprcount), false); + end else if (gprcount > 0) then + a_jmp_name_direct(list, '_restgpr0_' + intToStr(32-gprcount), false) + else if (fprcount > 0) then + a_jmp_name_direct(list, '_restfpr_' + intToStr(32-fprcount), false) + else + needsExitCode := true; + end else begin + needsExitCode := true; + { restore registers, FPU first, GPR next } + reference_reset_base(href, NR_STACK_POINTER_REG, -tcgsize2size[OS_FLOAT], 8); + if (fprcount > 0) then + for regcount := RS_F31 downto firstregfpu do begin + a_loadfpu_ref_reg(list, OS_FLOAT, OS_FLOAT, href, newreg(R_FPUREGISTER, regcount, + R_SUBNONE)); + dec(href.offset, tcgsize2size[OS_FLOAT]); + end; + if (gprcount > 0) then + for regcount := RS_R31 downto firstreggpr do begin + a_load_ref_reg(list, OS_INT, OS_INT, href, newreg(R_INTREGISTER, regcount, + R_SUBNONE)); + dec(href.offset, sizeof(pint)); + end; + + { VMX not supported by FPC atm } + end; + + if (needsExitCode) then begin + + { restore LR (if needed) } + if (needslinkreg) then begin + reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_ELF, 8); + list.concat(taicpu.op_reg_ref(A_LD, NR_R0, href)); + list.concat(taicpu.op_reg(A_MTLR, NR_R0)); + end; + + { generate return instruction } + list.concat(taicpu.op_none(A_BLR)); + end; + end; + +var + href: treference; + localsize : aint; + +begin + calcFirstUsedFPR(firstregfpu, fprcount); + calcFirstUsedGPR(firstreggpr, gprcount); + + { determine whether we need to restore the link register } + needslinkreg := + not(nostackframe) and + (((not (po_assembler in current_procinfo.procdef.procoptions)) and + ((pi_do_call in current_procinfo.flags) or (cs_profile in init_settings.moduleswitches))) or + ((cs_opt_size in current_settings.optimizerswitches) and ((fprcount > 0) or (gprcount > 0))) or + ([cs_lineinfo, cs_debuginfo] * current_settings.moduleswitches <> [])); + + { calculate stack frame } + localsize := tppcprocinfo(current_procinfo).calc_stackframe_size( + gprcount, fprcount); + { CR register not supported } + + { restore stack pointer } + if (not nostackframe) and (localsize > 0) and + tppcprocinfo(current_procinfo).needstackframe then begin + if (localsize <= high(smallint)) then begin + list.concat(taicpu.op_reg_reg_const(A_ADDI, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, localsize)); + end else begin + reference_reset_base(href, NR_NO, localsize, 8); + + { use R0 for loading the constant (which is definitely > 32k when entering + this branch) + Inlined because it must not use temp registers because register allocations + have already been done + } + { Code template: + lis r0,ofs@highest + ori r0,ofs@higher + sldi r0,r0,32 + oris r0,r0,ofs@h + ori r0,r0,ofs@l + } + list.concat(taicpu.op_reg_const(A_LIS, NR_R0, word(href.offset shr 48))); + list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset shr 32))); + list.concat(taicpu.op_reg_reg_const(A_SLDI, NR_R0, NR_R0, 32)); + list.concat(taicpu.op_reg_reg_const(A_ORIS, NR_R0, NR_R0, word(href.offset shr 16))); + list.concat(taicpu.op_reg_reg_const(A_ORI, NR_R0, NR_R0, word(href.offset))); + + list.concat(taicpu.op_reg_reg_reg(A_ADD, NR_R1, NR_R1, NR_R0)); + end; + end; + + restore_standard_registers; +end; + + +procedure tcgppc.a_loadaddr_ref_reg(list: TAsmList; const ref: treference; r: + tregister); + +var + ref2, tmpref: treference; + { register used to construct address } + tempreg : TRegister; + +begin + if (target_info.system = system_powerpc64_darwin) then + begin + inherited a_loadaddr_ref_reg(list,ref,r); + exit; + end; + + ref2 := ref; + fixref(list, ref2); + { load a symbol } + if (assigned(ref2.symbol) or (hasLargeOffset(ref2))) then begin + { add the symbol's value to the base of the reference, and if the } + { reference doesn't have a base, create one } + reference_reset(tmpref, ref2.alignment); + tmpref.offset := ref2.offset; + tmpref.symbol := ref2.symbol; + tmpref.relsymbol := ref2.relsymbol; + { load 64 bit reference into r. If the reference already has a base register, + first load the 64 bit value into a temp register, then add it to the result + register rD } + if (ref2.base <> NR_NO) then begin + { already have a base register, so allocate a new one } + tempreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); + end else begin + tempreg := r; + end; + + { code for loading a reference from a symbol into a register rD } + (* + lis rX,SYM@highest + ori rX,SYM@higher + sldi rX,rX,32 + oris rX,rX,SYM@h + ori rX,rX,SYM@l + *) + {$IFDEF EXTDEBUG} + list.concat(tai_comment.create(strpnew('loadaddr_ref_reg '))); + {$ENDIF EXTDEBUG} + if (assigned(tmpref.symbol)) then begin + tmpref.refaddr := addr_highest; + list.concat(taicpu.op_reg_ref(A_LIS, tempreg, tmpref)); + tmpref.refaddr := addr_higher; + list.concat(taicpu.op_reg_reg_ref(A_ORI, tempreg, tempreg, tmpref)); + list.concat(taicpu.op_reg_reg_const(A_SLDI, tempreg, tempreg, 32)); + tmpref.refaddr := addr_high; + list.concat(taicpu.op_reg_reg_ref(A_ORIS, tempreg, tempreg, tmpref)); + tmpref.refaddr := addr_low; + list.concat(taicpu.op_reg_reg_ref(A_ORI, tempreg, tempreg, tmpref)); + end else + a_load_const_reg(list, OS_ADDR, tmpref.offset, tempreg); + + { if there's already a base register, add the temp register contents to + the base register } + if (ref2.base <> NR_NO) then begin + list.concat(taicpu.op_reg_reg_reg(A_ADD, r, tempreg, ref2.base)); + end; + end else if (ref2.offset <> 0) then begin + { no symbol, but offset <> 0 } + if (ref2.base <> NR_NO) then begin + a_op_const_reg_reg(list, OP_ADD, OS_64, ref2.offset, ref2.base, r) + { FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never + occurs, so now only ref.offset has to be loaded } + end else begin + a_load_const_reg(list, OS_64, ref2.offset, r); + end; + end else if (ref2.index <> NR_NO) then begin + list.concat(taicpu.op_reg_reg_reg(A_ADD, r, ref2.base, ref2.index)) + end else if (ref2.base <> NR_NO) and + (r <> ref2.base) then begin + a_load_reg_reg(list, OS_ADDR, OS_ADDR, ref2.base, r) + end else begin + list.concat(taicpu.op_reg_const(A_LI, r, 0)); + end; +end; + +{ ************* concatcopy ************ } + +procedure tcgppc.g_concatcopy(list: TAsmList; const source, dest: treference; + len: aint); + +var + countreg, tempreg:TRegister; + src, dst: TReference; + lab: tasmlabel; + count, count2, step: longint; + size: tcgsize; + +begin +{$IFDEF extdebug} + if len > high(aint) then + internalerror(2002072704); + list.concat(tai_comment.create(strpnew('g_concatcopy1 ' + inttostr(len) + ' bytes left '))); +{$ENDIF extdebug} + { if the references are equal, exit, there is no need to copy anything } + if references_equal(source, dest) or + (len=0) then + exit; + + { make sure short loads are handled as optimally as possible; + note that the data here never overlaps, so we can do a forward + copy at all times. + NOTE: maybe use some scratch registers to pair load/store instructions + } + + if (len <= 8) then begin + src := source; dst := dest; + {$IFDEF extdebug} + list.concat(tai_comment.create(strpnew('g_concatcopy3 ' + inttostr(src.offset) + ' ' + inttostr(dst.offset)))); + {$ENDIF extdebug} + while (len <> 0) do begin + if (len = 8) then begin + a_load_ref_ref(list, OS_64, OS_64, src, dst); + dec(len, 8); + end else if (len >= 4) then begin + a_load_ref_ref(list, OS_32, OS_32, src, dst); + inc(src.offset, 4); inc(dst.offset, 4); + dec(len, 4); + end else if (len >= 2) then begin + a_load_ref_ref(list, OS_16, OS_16, src, dst); + inc(src.offset, 2); inc(dst.offset, 2); + dec(len, 2); + end else begin + a_load_ref_ref(list, OS_8, OS_8, src, dst); + inc(src.offset, 1); inc(dst.offset, 1); + dec(len, 1); + end; + end; + exit; + end; +{$IFDEF extdebug} + list.concat(tai_comment.create(strpnew('g_concatcopy2 ' + inttostr(len) + ' bytes left '))); +{$ENDIF extdebug} + + + if not(source.alignment in [1,2]) and + not(dest.alignment in [1,2]) then + begin + count:=len div 8; + step:=8; + size:=OS_64; + end + else + begin + count:=len div 4; + step:=4; + size:=OS_32; + end; + + tempreg:=getintregister(list,size); + reference_reset(src,source.alignment); + reference_reset(dst,dest.alignment); + { load the address of source into src.base } + if (count > 4) or + not issimpleref(source) or + ((source.index <> NR_NO) and + ((source.offset + len) > high(smallint))) then begin + src.base := getaddressregister(list); + a_loadaddr_ref_reg(list, source, src.base); + end else begin + src := source; + end; + { load the address of dest into dst.base } + if (count > 4) or + not issimpleref(dest) or + ((dest.index <> NR_NO) and + ((dest.offset + len) > high(smallint))) then begin + dst.base := getaddressregister(list); + a_loadaddr_ref_reg(list, dest, dst.base); + end else begin + dst := dest; + end; + + { generate a loop } + if count > 4 then begin + { the offsets are zero after the a_loadaddress_ref_reg and just + have to be set to step. I put an Inc there so debugging may be + easier (should offset be different from zero here, it will be + easy to notice in the generated assembler } + inc(dst.offset, step); + inc(src.offset, step); + list.concat(taicpu.op_reg_reg_const(A_SUBI, src.base, src.base, step)); + list.concat(taicpu.op_reg_reg_const(A_SUBI, dst.base, dst.base, step)); + countreg := getintregister(list, OS_INT); + a_load_const_reg(list, OS_INT, count, countreg); + current_asmdata.getjumplabel(lab); + a_label(list, lab); + list.concat(taicpu.op_reg_reg_const(A_SUBIC_, countreg, countreg, 1)); + if (size=OS_64) then + begin + list.concat(taicpu.op_reg_ref(A_LDU, tempreg, src)); + list.concat(taicpu.op_reg_ref(A_STDU, tempreg, dst)); + end + else + begin + list.concat(taicpu.op_reg_ref(A_LWZU, tempreg, src)); + list.concat(taicpu.op_reg_ref(A_STWU, tempreg, dst)); + end; + a_jmp(list, A_BC, C_NE, 0, lab); + a_reg_sync(list,src.base); + a_reg_sync(list,dst.base); + a_reg_sync(list,countreg); + len := len mod step; + count := 0; + end; + + { unrolled loop } + if count > 0 then begin + for count2 := 1 to count do begin + a_load_ref_reg(list, size, size, src, tempreg); + a_load_reg_ref(list, size, size, tempreg, dst); + inc(src.offset, step); + inc(dst.offset, step); + end; + len := len mod step; + end; + + if (len and 4) <> 0 then begin + a_load_ref_reg(list, OS_32, OS_32, src, tempreg); + a_load_reg_ref(list, OS_32, OS_32, tempreg, dst); + inc(src.offset, 4); + inc(dst.offset, 4); + end; + { copy the leftovers } + if (len and 2) <> 0 then begin + a_load_ref_reg(list, OS_16, OS_16, src, tempreg); + a_load_reg_ref(list, OS_16, OS_16, tempreg, dst); + inc(src.offset, 2); + inc(dst.offset, 2); + end; + if (len and 1) <> 0 then begin + a_load_ref_reg(list, OS_8, OS_8, src, tempreg); + a_load_reg_ref(list, OS_8, OS_8, tempreg, dst); + end; + +end; + +procedure tcgppc.g_external_wrapper(list: TAsmList; pd: TProcDef; const externalname: string); +var + href : treference; +begin + if (target_info.system <> system_powerpc64_linux) then begin + inherited; + exit; + end; + + { for ppc64/linux emit correct code which sets up a stack frame and then calls the + external method normally to ensure that the GOT/TOC will be loaded correctly if + required. + + It's not really advantageous to use cg methods here because they are too specialized. + + I.e. the resulting code sequence looks as follows: + + mflr r0 + std r0, 16(r1) + stdu r1, -112(r1) + bl <external_method> + nop + addi r1, r1, 112 + ld r0, 16(r1) + mtlr r0 + blr + + } + list.concat(taicpu.op_reg(A_MFLR, NR_R0)); + reference_reset_base(href, NR_STACK_POINTER_REG, 16, 8); + list.concat(taicpu.op_reg_ref(A_STD, NR_R0, href)); + reference_reset_base(href, NR_STACK_POINTER_REG, -MINIMUM_STACKFRAME_SIZE, 8); + list.concat(taicpu.op_reg_ref(A_STDU, NR_STACK_POINTER_REG, href)); + + list.concat(taicpu.op_sym(A_BL, current_asmdata.RefAsmSymbol(externalname))); + list.concat(taicpu.op_none(A_NOP)); + + list.concat(taicpu.op_reg_reg_const(A_ADDI, NR_STACK_POINTER_REG, NR_STACK_POINTER_REG, MINIMUM_STACKFRAME_SIZE)); + + reference_reset_base(href, NR_STACK_POINTER_REG, LA_LR_ELF, 8); + list.concat(taicpu.op_reg_ref(A_LD, NR_R0, href)); + list.concat(taicpu.op_reg(A_MTLR, NR_R0)); + list.concat(taicpu.op_none(A_BLR)); +end; + +{***************** This is private property, keep out! :) *****************} + +procedure tcgppc.maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister); +const + overflowops = [OP_MUL,OP_SHL,OP_ADD,OP_SUB,OP_NOT,OP_NEG]; +begin + {$IFDEF EXTDEBUG} + list.concat(tai_comment.create(strpnew('maybeadjustresult op = ' + cgop2string(op) + ' size = ' + cgsize2string(size)))); + {$ENDIF EXTDEBUG} + + if (op in overflowops) and (size in [OS_8, OS_S8, OS_16, OS_S16, OS_32, OS_S32]) then + a_load_reg_reg(list, OS_64, size, dst, dst); +end; + +function tcgppc.issimpleref(const ref: treference): boolean; + +begin + if (ref.base = NR_NO) and + (ref.index <> NR_NO) then + internalerror(200208101); + result := + not (assigned(ref.symbol)) and + (((ref.index = NR_NO) and + (ref.offset >= low(smallint)) and + (ref.offset <= high(smallint))) or + ((ref.index <> NR_NO) and + (ref.offset = 0))); +end; + +procedure tcgppc.a_load_store(list: TAsmList; op: tasmop; reg: tregister; + ref: treference); + + procedure maybefixup64bitoffset; + var + tmpreg: tregister; + begin + { for some instructions we need to check that the offset is divisible by at + least four. If not, add the bytes which are "off" to the base register and + adjust the offset accordingly } + case op of + A_LD, A_LDU, A_STD, A_STDU, A_LWA : + if ((ref.offset mod 4) <> 0) then begin + tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); + + if (ref.base <> NR_NO) then begin + a_op_const_reg_reg(list, OP_ADD, OS_ADDR, ref.offset mod 4, ref.base, tmpreg); + ref.base := tmpreg; + end else begin + list.concat(taicpu.op_reg_const(A_LI, tmpreg, ref.offset mod 4)); + ref.base := tmpreg; + end; + ref.offset := (ref.offset div 4) * 4; + end; + end; + end; + +var + tmpreg, tmpreg2: tregister; + tmpref: treference; + largeOffset: Boolean; +begin + if (target_info.system = system_powerpc64_darwin) then + begin + { darwin/ppc64 works with 32 bit relocatable symbol addresses } + maybefixup64bitoffset; + inherited a_load_store(list,op,reg,ref); + exit + end; + + { at this point there must not be a combination of values in the ref treference + which is not possible to directly map to instructions of the PowerPC architecture } + if (ref.index <> NR_NO) and ((ref.offset <> 0) or (assigned(ref.symbol))) then + internalerror(200310131); + + { if this is a PIC'ed address, handle it and exit } + if (ref.refaddr = addr_pic) then begin + if (ref.offset <> 0) then + internalerror(2006010501); + if (ref.index <> NR_NO) then + internalerror(2006010502); + if (not assigned(ref.symbol)) then + internalerror(200601050); + list.concat(taicpu.op_reg_ref(op, reg, ref)); + exit; + end; + + maybefixup64bitoffset; + {$IFDEF EXTDEBUG} + list.concat(tai_comment.create(strpnew('a_load_store1 ' + BoolToStr(ref.refaddr = addr_pic)))); + {$ENDIF EXTDEBUG} + { if we have to load/store from a symbol or large addresses, use a temporary register + containing the address } + if (assigned(ref.symbol) or (hasLargeOffset(ref))) then begin + tmpreg := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); + + if (hasLargeOffset(ref) and (ref.base = NR_NO)) then begin + ref.base := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); + a_load_const_reg(list, OS_ADDR, ref.offset, ref.base); + ref.offset := 0; + end; + + reference_reset(tmpref, ref.alignment); + tmpref.symbol := ref.symbol; + tmpref.relsymbol := ref.relsymbol; + tmpref.offset := ref.offset; + + if (ref.base <> NR_NO) then begin + { As long as the TOC isn't working we try to achieve highest speed (in this + case by allowing instructions execute in parallel) as possible at the cost + of using another temporary register. So the code template when there is + a base register and an offset is the following: + + lis rT1, SYM+offs@highest + ori rT1, rT1, SYM+offs@higher + lis rT2, SYM+offs@hi + ori rT2, SYM+offs@lo + rldimi rT2, rT1, 32 + + <op>X reg, base, rT2 + } + + tmpreg2 := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); + if (assigned(tmpref.symbol)) then begin + tmpref.refaddr := addr_highest; + list.concat(taicpu.op_reg_ref(A_LIS, tmpreg, tmpref)); + tmpref.refaddr := addr_higher; + list.concat(taicpu.op_reg_reg_ref(A_ORI, tmpreg, tmpreg, tmpref)); + + tmpref.refaddr := addr_high; + list.concat(taicpu.op_reg_ref(A_LIS, tmpreg2, tmpref)); + tmpref.refaddr := addr_low; + list.concat(taicpu.op_reg_reg_ref(A_ORI, tmpreg2, tmpreg2, tmpref)); + + list.concat(taicpu.op_reg_reg_const_const(A_RLDIMI, tmpreg2, tmpreg, 32, 0)); + end else + a_load_const_reg(list, OS_ADDR, tmpref.offset, tmpreg2); + + reference_reset(tmpref, ref.alignment); + tmpref.base := ref.base; + tmpref.index := tmpreg2; + case op of + { the code generator doesn't generate update instructions anyway, so + error out on those instructions } + A_LBZ : op := A_LBZX; + A_LHZ : op := A_LHZX; + A_LWZ : op := A_LWZX; + A_LD : op := A_LDX; + A_LHA : op := A_LHAX; + A_LWA : op := A_LWAX; + A_LFS : op := A_LFSX; + A_LFD : op := A_LFDX; + + A_STB : op := A_STBX; + A_STH : op := A_STHX; + A_STW : op := A_STWX; + A_STD : op := A_STDX; + + A_STFS : op := A_STFSX; + A_STFD : op := A_STFDX; + else + { unknown load/store opcode } + internalerror(2005101302); + end; + list.concat(taicpu.op_reg_ref(op, reg, tmpref)); + end else begin + { when accessing value from a reference without a base register, use the + following code template: + + lis rT,SYM+offs@highesta + ori rT,SYM+offs@highera + sldi rT,rT,32 + oris rT,rT,SYM+offs@ha + ld rD,SYM+offs@l(rT) + } + tmpref.refaddr := addr_highesta; + list.concat(taicpu.op_reg_ref(A_LIS, tmpreg, tmpref)); + tmpref.refaddr := addr_highera; + list.concat(taicpu.op_reg_reg_ref(A_ORI, tmpreg, tmpreg, tmpref)); + list.concat(taicpu.op_reg_reg_const(A_SLDI, tmpreg, tmpreg, 32)); + tmpref.refaddr := addr_higha; + list.concat(taicpu.op_reg_reg_ref(A_ORIS, tmpreg, tmpreg, tmpref)); + + tmpref.base := tmpreg; + tmpref.refaddr := addr_low; + list.concat(taicpu.op_reg_ref(op, reg, tmpref)); + end; + end else begin + list.concat(taicpu.op_reg_ref(op, reg, ref)); + end; +end; + +procedure tcgppc.loadConstantPIC(list : TAsmList; size : TCGSize; a : aint; reg : TRegister); +var + l: tasmsymbol; + ref: treference; + symname : string; +begin + maybe_new_object_file(current_asmdata.asmlists[al_picdata]); + symname := '_$' + current_asmdata.name + '$toc$' + hexstr(a, sizeof(a)*2); + l:=current_asmdata.getasmsymbol(symname); + if not(assigned(l)) then begin + l:=current_asmdata.DefineAsmSymbol(symname,AB_GLOBAL, AT_DATA); + new_section(current_asmdata.asmlists[al_picdata],sec_toc, '.toc', 8); + current_asmdata.asmlists[al_picdata].concat(tai_symbol.create_global(l,0)); + current_asmdata.asmlists[al_picdata].concat(tai_directive.create(asd_toc_entry, symname + '[TC], ' + inttostr(a))); + end; + reference_reset_symbol(ref,l,0, 8); + ref.base := NR_R2; + ref.refaddr := addr_no; + + {$IFDEF EXTDEBUG} + list.concat(tai_comment.create(strpnew('loading value from TOC reference for ' + symname))); + {$ENDIF EXTDEBUG} + cg.a_load_ref_reg(list, OS_INT, OS_INT, ref, reg); +end; + + +procedure create_codegen; +begin + cg := tcgppc.create; +end; + +end. diff --git a/closures/compiler/powerpc64/cpubase.pas b/closures/compiler/powerpc64/cpubase.pas new file mode 100644 index 0000000000..ecdeba7398 --- /dev/null +++ b/closures/compiler/powerpc64/cpubase.pas @@ -0,0 +1,572 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Contains the base types for the PowerPC + + 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 base types for the PowerPC64 +} +unit cpubase; + +{$I fpcdefs.inc} + +interface + +uses + strings, globtype, + cutils, cclasses, aasmbase, cpuinfo, cgbase; + +{***************************************************************************** + Assembler Opcodes +*****************************************************************************} + +type + TAsmOp = (A_None, + { normal opcodes } + a_add, a_add_, a_addo, a_addo_, a_addc, a_addc_, a_addco, a_addco_, + a_adde, a_adde_, a_addeo, a_addeo_, a_addi, a_addic, a_addic_, a_addis, + a_addme, a_addme_, a_addmeo, a_addmeo_, a_addze, a_addze_, a_addzeo, + a_addzeo_, a_and, a_and_, a_andc, a_andc_, a_andi_, a_andis_, a_b, + a_ba, a_bl, a_bla, a_bc, a_bca, a_bcl, a_bcla, a_bcctr, a_bcctrl, a_bclr, + a_bclrl, a_cmp, a_cmpi, a_cmpl, a_cmpli, a_cntlzw, a_cntlzw_, a_crand, + a_crandc, a_creqv, a_crnand, a_crnor, a_cror, a_crorc, a_crxor, a_dcba, + a_dcbf, a_dcbi, a_dcbst, a_dcbt, a_dcbtst, a_dcbz, a_divw, a_divw_, a_divwo, + a_divwo_, + a_divwu, a_divwu_, a_divwuo, a_divwuo_, a_eciwx, a_ecowx, a_eieio, a_eqv, + a_eqv_, a_extsb, a_extsb_, a_extsh, a_extsh_, a_fabs, a_fabs_, a_fadd, + a_fadd_, a_fadds, a_fadds_, a_fcmpo, a_fcmpu, a_fctiw, a_fctiw_, a_fctiwz, + a_fctwz_, a_fdiv, a_fdiv_, a_fdivs, a_fdivs_, a_fmadd, a_fmadd_, a_fmadds, + a_fmadds_, a_fmr, a_fmsub, a_fmsub_, a_fmsubs, a_fmsubs_, a_fmul, a_fmul_, + a_fmuls, a_fmuls_, a_fnabs, a_fnabs_, a_fneg, a_fneg_, a_fnmadd, + a_fnmadd_, a_fnmadds, a_fnmadds_, a_fnmsub, a_fnmsub_, a_fnmsubs, + a_fnmsubs_, a_fres, a_fres_, a_frsp, a_frsp_, a_frsqrte, a_frsqrte_, + a_fsel, a_fsel_, a_fsqrt, a_fsqrt_, a_fsqrts, a_fsqrts_, a_fsub, a_fsub_, + a_fsubs, a_fsubs_, a_icbi, a_isync, a_lbz, a_lbzu, a_lbzux, a_lbzx, + a_lfd, a_lfdu, a_lfdux, a_lfdx, a_lfs, a_lfsu, a_lfsux, a_lfsx, a_lha, + a_lhau, a_lhaux, a_lhax, a_lhbrx, a_lhz, a_lhzu, a_lhzux, a_lhzx, a_lmw, + a_lswi, a_lswx, a_lwarx, a_lwbrx, a_lwz, a_lwzu, a_lwzux, a_lwzx, a_mcrf, + a_mcrfs, a_mcrxr, a_mfcr, a_mffs, a_mffs_, a_mfmsr, a_mfspr, a_mfsr, + a_mfsrin, a_mftb, a_mtcrf, a_mtfsb0, a_mtfsb1, a_mtfsf, a_mtfsf_, + a_mtfsfi, a_mtfsfi_, a_mtmsr, a_mtspr, a_mtsr, a_mtsrin, a_mulhw, + a_mulhw_, a_mulhwu, a_mulhwu_, a_mulli, a_mullw, a_mullw_, a_mullwo, + a_mullwo_, a_nand, a_nand_, a_neg, a_neg_, a_nego, a_nego_, a_nor, a_nor_, + a_or, a_or_, a_orc, a_orc_, a_ori, a_oris, a_rfi, a_rlwimi, a_rlwimi_, + a_rlwinm, a_rlwinm_, a_rlwnm, a_sc, a_slw, a_slw_, a_sraw, a_sraw_, + a_srawi, a_srawi_, a_srw, a_srw_, a_stb, a_stbu, a_stbux, a_stbx, a_stfd, + a_stfdu, a_stfdux, a_stfdx, a_stfiwx, a_stfs, a_stfsu, a_stfsux, a_stfsx, + a_sth, a_sthbrx, a_sthu, a_sthux, a_sthx, a_stmw, a_stswi, a_stswx, a_stw, + a_stwbrx, a_stwcx_, a_stwu, a_stwux, a_stwx, a_subf, a_subf_, a_subfo, + a_subfo_, a_subfc, a_subfc_, a_subfco, a_subfco_, a_subfe, a_subfe_, + a_subfeo, a_subfeo_, a_subfic, a_subfme, a_subfme_, a_subfmeo, a_subfmeo_, + a_subfze, a_subfze_, a_subfzeo, a_subfzeo_, a_sync, a_tlbia, a_tlbie, + a_tlbsync, a_tw, a_twi, a_xor, a_xor_, a_xori, a_xoris, + { simplified mnemonics } + a_subi, a_subis, a_subic, a_subic_, a_sub, a_sub_, a_subo, a_subo_, + a_subc, a_subc_, a_subco, a_subco_, a_cmpwi, a_cmpw, a_cmplwi, a_cmplw, + a_extlwi, a_extlwi_, a_extrwi, a_extrwi_, a_inslwi, a_inslwi_, a_insrwi, + a_insrwi_, a_rotlwi, a_rotlwi_, a_rotlw, a_rotlw_, a_slwi, a_slwi_, + a_srwi, a_srwi_, a_clrlwi, a_clrlwi_, a_clrrwi, a_clrrwi_, a_clrslwi, + a_clrslwi_, a_bf, a_bt, a_blr, a_bctr, a_blrl, a_bctrl, a_crset, a_crclr, a_crmove, + a_crnot, a_mt {move to special prupose reg}, a_mf + {move from special purpose reg}, + a_nop, a_li, a_lis, a_la, a_mr, a_mr_, a_not, a_mtcr, a_mtlr, a_mflr, + a_mtctr, a_mfctr, + A_EXTSW, + A_RLDIMI, + A_STD, A_STDU, A_STDX, A_STDUX, + A_LD, A_LDU, A_LDX, A_LDUX, + A_CMPD, A_CMPDI, A_CMPLD, A_CMPLDI, + A_SRDI, A_SRADI, + A_SLDI, + A_RLDCL, A_RLDICL, + A_DIVDU, A_DIVDU_, A_DIVD, A_DIVD_, A_MULLD, A_MULLD_, A_MULHD, A_MULHD_, A_SRAD, A_SLD, A_SRD, + A_DIVDUO_, A_DIVDO_, + A_LWA, A_LWAX, A_LWAUX, + A_FCFID, + A_LDARX, A_STDCX_, A_CNTLZD, + A_LVX, A_STVX, + A_MULLDO, A_MULLDO_, A_MULHDU, A_MULHDU_, + A_MFXER, + A_FCTID, A_FCTID_, A_FCTIDZ, A_FCTIDZ_, + A_EXTRDI, A_EXTRDI_, A_INSRDI, A_INSRDI_, + A_LWSYNC); + + {# This should define the array of instructions as string } + op2strtable = array[tasmop] of string[8]; + +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 rppcnor.inc} - 1; + totherregisterset = set of tregisterindex; + +const + maxvarregs = 32 - 6; + { 32 int registers - r0 - stackpointer - r2 - 3 scratch registers } + maxfpuvarregs = 28; { 32 fpuregisters - some scratch registers (minimally 2) } + { Available Superregisters } +{$I rppcsup.inc} + + { No Subregisters } + R_SUBWHOLE = R_SUBNONE; + + { Available Registers } +{$I rppccon.inc} + + { Integer Super registers first and last } + first_int_imreg = $20; + + { Float Super register first and last } + first_fpu_imreg = $20; + + { MM Super register first and last } + first_mm_imreg = $20; + +{ TODO: Calculate bsstart} + regnumber_count_bsstart = 64; + + regnumber_table: array[tregisterindex] of tregister = ( +{$I rppcnum.inc} + ); + + regstabs_table: array[tregisterindex] of shortint = ( +{$I rppcstab.inc} + ); + + regdwarf_table: array[tregisterindex] of shortint = ( +{$I rppcdwrf.inc} + ); + + {***************************************************************************** + Conditions + *****************************************************************************} + +type + TAsmCondFlag = (C_None { unconditional jumps }, + { conditions when not using ctr decrement etc } + C_LT, C_LE, C_EQ, C_GE, C_GT, C_NL, C_NE, C_NG, C_SO, C_NS, C_UN, C_NU, + { conditions when using ctr decrement etc } + C_T, C_F, C_DNZ, C_DNZT, C_DNZF, C_DZ, C_DZT, C_DZF); + + TDirHint = (DH_None, DH_Minus, DH_Plus); + +const + { these are in the XER, but when moved to CR_x they correspond with the } + { bits below } + C_OV = C_GT; + C_CA = C_EQ; + C_NO = C_NG; + C_NC = C_NE; + +type + TAsmCond = packed record + dirhint: tdirhint; + case simple: boolean of + false: (BO, BI: byte); + true: ( + cond: TAsmCondFlag; + case byte of + 0: (); + { specifies in which part of the cr the bit has to be } + { tested for blt,bgt,beq,..,bnu } + 1: (cr: RS_CR0..RS_CR7); + { specifies the bit to test for bt,bf,bdz,..,bdzf } + 2: (crbit: byte) + ); + end; + +const + AsmCondFlag2BO: array[C_T..C_DZF] of Byte = + (12, 4, 16, 8, 0, 18, 10, 2); + + AsmCondFlag2BOLT_NU: array[C_LT..C_NU] of Byte = + (12, 4, 12, 4, 12, 4, 4, 4, 12, 4, 12, 4); + + AsmCondFlag2BI: array[C_LT..C_NU] of Byte = + (0, 1, 2, 0, 1, 0, 2, 1, 3, 3, 3, 3); + + AsmCondFlagTF: array[TAsmCondFlag] of Boolean = + (false, true, false, true, false, true, false, false, false, true, false, + true, false, + true, false, false, true, false, false, true, false); + + AsmCondFlag2Str : array[TAsmCondFlag] of string[4] = ({cf_none}'', + { conditions when not using ctr decrement etc} + 'lt', 'le', 'eq', 'ge', 'gt', 'nl', 'ne', 'ng', 'so', 'ns', 'un', 'nu', + 't', 'f', 'dnz', 'dnzt', 'dnzf', 'dz', 'dzt', 'dzf'); + + UpperAsmCondFlag2Str: array[TAsmCondFlag] of string[4] = ({cf_none}'', + { conditions when not using ctr decrement etc} + 'LT', 'LE', 'EQ', 'GE', 'GT', 'NL', 'NE', 'NG', 'SO', 'NS', 'UN', 'NU', + 'T', 'F', 'DNZ', 'DNZT', 'DNZF', 'DZ', 'DZT', 'DZF'); + +const + CondAsmOps = 3; + CondAsmOp: array[0..CondAsmOps - 1] of TasmOp = ( + A_BC, A_TW, A_TWI + ); + CondAsmOpStr:array[0..CondAsmOps-1] of string[7]=( + 'B','TW','TWI' + ); + + + {***************************************************************************** + Flags + *****************************************************************************} + +type + TResFlagsEnum = (F_EQ, F_NE, F_LT, F_LE, F_GT, F_GE, F_SO, F_FX, F_FEX, F_VX, + F_OX); + TResFlags = record + cr: RS_CR0..RS_CR7; + flag: TResFlagsEnum; + end; + +{***************************************************************************** + Reference +*****************************************************************************} + +const + { MacOS only. Whether the direct data area (TOC) directly contain + global variables. Otherwise it contains pointers to global variables. } + macos_direct_globals = false; + + {***************************************************************************** + Operand Sizes + *****************************************************************************} + + {***************************************************************************** + Constants + *****************************************************************************} + +const + max_operands = 5; + + {***************************************************************************** + 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; + OS_SINT = OS_S64; + {# the maximum float size for a processor, } + OS_FLOAT = OS_F64; + {# the size of a vector register for a processor } + OS_VECTOR = OS_M128; + + {***************************************************************************** + GDB Information + *****************************************************************************} + + {# Register indexes for stabs information, when some + parameters or variables are stored in registers. + + Taken from rs6000.h (DBX_REGISTER_NUMBER) + from GCC 3.x source code. PowerPC has 1:1 mapping + according to the order of the registers defined + in GCC + + } + + stab_regindex: array[tregisterindex] of shortint = ( +{$I rppcstab.inc} + ); + + {***************************************************************************** + Generic Register names + *****************************************************************************} + + // Stack pointer register + NR_STACK_POINTER_REG = NR_R1; + RS_STACK_POINTER_REG = RS_R1; + // old stack pointer register used during copying variables from the caller + // stack frame + NR_OLD_STACK_POINTER_REG = NR_R12; + // Frame pointer register + NR_FRAME_POINTER_REG = NR_STACK_POINTER_REG; + RS_FRAME_POINTER_REG = RS_STACK_POINTER_REG; + {# 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 + + Taken from GCC rs6000.h + } +{ TODO: As indicated in rs6000.h, but can't find it anywhere else!} + NR_PIC_OFFSET_REG = NR_R30; + { Return address of a function } + NR_RETURN_ADDRESS_REG = NR_R0; + { Results are returned in this register (64-bit values) } + NR_FUNCTION_RETURN_REG = NR_R3; + RS_FUNCTION_RETURN_REG = RS_R3; + { 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; + + NR_FPU_RESULT_REG = NR_F1; + NR_MM_RESULT_REG = NR_M0; + + {***************************************************************************** + GCC /ABI linking information + *****************************************************************************} + + {# Registers which must be saved when calling a routine declared as + cppdecl, cdecl, stdcall, safecall, palmossyscall. The registers + saved should be the ones as defined in the target ABI and / or GCC. + + This value can be deduced from CALLED_USED_REGISTERS array in the + GCC source. + } + saved_standard_registers: array[0..17] of tsuperregister = ( + RS_R14, RS_R15, RS_R16, RS_R17, RS_R18, RS_R19, + RS_R20, RS_R21, RS_R22, RS_R23, RS_R24, RS_R25, + RS_R26, RS_R27, RS_R28, RS_R29, RS_R30, RS_R31 + ); + + { this is only for the generic code which is not used for this architecture } + saved_mm_registers : array[0..0] of tsuperregister = (RS_NO); + + {# 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. + } + std_param_align = 8; + vmx_std_param_align = 16; + + {***************************************************************************** + CPU Dependent Constants + *****************************************************************************} + + LinkageAreaSizeELF = 48; + { offset in the linkage area for the saved stack pointer } + LA_SP = 0; + { offset in the linkage area for the saved conditional register} + LA_CR_ELF = 8; + { offset in the linkage area for the saved link register} + LA_LR_ELF = 16; + { offset in the linkage area for the saved RTOC register} + LA_RTOC_ELF = 40; + + PARENT_FRAMEPOINTER_OFFSET = 24; + + NR_RTOC = NR_R2; + + ELF_STACK_ALIGN = 16; + + { the size of the "red zone" which must not be changed by asynchronous calls + in the stack frame and can be used for storing temps } + RED_ZONE_SIZE = 288; + + { minimum size of the stack frame if one exists } + MINIMUM_STACKFRAME_SIZE = 112; + + maxfpuregs = 8; + + {***************************************************************************** + Helpers + *****************************************************************************} + +function is_calljmp(o: tasmop): boolean; + +procedure inverse_flags(var r: TResFlags); +function flags_to_cond(const f: TResFlags): TAsmCond; +procedure create_cond_imm(BO, BI: byte; var r: TAsmCond); +procedure create_cond_norm(cond: TAsmCondFlag; cr: byte; var r: TasmCond); + +function cgsize2subreg(regtype: tregistertype; s: Tcgsize): Tsubregister; +{ Returns the tcgsize corresponding with the size of reg.} +function reg_cgsize(const reg: tregister): tcgsize; + +function findreg_by_number(r: Tregister): tregisterindex; +function std_regnum_search(const s: string): Tregister; +function std_regname(r: Tregister): string; +function is_condreg(r: tregister): boolean; + +function inverse_cond(const c: TAsmCond): Tasmcond; +{$IFDEF USEINLINE}inline;{$ENDIF USEINLINE} +function conditions_equal(const c1, c2: TAsmCond): boolean; +function dwarf_reg(r:tregister):shortint; + +implementation + +uses + rgBase, verbose, itcpugas; + +const + std_regname_table: array[tregisterindex] of string[7] = ( +{$I rppcstd.inc} + ); + + regnumber_index: array[tregisterindex] of tregisterindex = ( +{$I rppcrni.inc} + ); + + std_regname_index: array[tregisterindex] of tregisterindex = ( +{$I rppcsri.inc} + ); + + {***************************************************************************** + Helpers + ***************** ************************************************************} + +function is_calljmp(o: tasmop): boolean; +begin + is_calljmp := false; + case o of + A_B, A_BA, A_BL, A_BLA, A_BC, A_BCA, A_BCL, A_BCLA, A_BCCTR, A_BCCTRL, + A_BCLR, A_BF, A_BT, + A_BCLRL, A_TW, A_TWI: is_calljmp := true; + end; +end; + +procedure inverse_flags(var r: TResFlags); +const + inv_flags: array[F_EQ..F_GE] of TResFlagsEnum = + (F_NE, F_EQ, F_GE, F_GE, F_LE, F_LT); +begin + r.flag := inv_flags[r.flag]; +end; + +function inverse_cond(const c: TAsmCond): Tasmcond; +{$IFDEF USEINLINE}inline; +{$ENDIF USEINLINE} +const + inv_condflags: array[TAsmCondFlag] of TAsmCondFlag = (C_None, + C_GE, C_GT, C_NE, C_LT, C_LE, C_LT, C_EQ, C_GT, C_NS, C_SO, C_NU, C_UN, + C_F, C_T, C_DNZ, C_DNZF, C_DNZT, C_DZ, C_DZF, C_DZT); +begin + if (c.cond in [C_DNZ, C_DZ]) then + internalerror(2005022501); + result := c; + result.cond := inv_condflags[c.cond]; +end; + +function conditions_equal(const c1, c2: TAsmCond): boolean; +begin + result := + (c1.simple and c2.simple) and + (c1.cond = c2.cond) and + ((not (c1.cond in [C_T..C_DZF]) and + (c1.cr = c2.cr)) or + (c1.crbit = c2.crbit)); +end; + +function flags_to_cond(const f: TResFlags): TAsmCond; +const + flag_2_cond: array[F_EQ..F_SO] of TAsmCondFlag = + (C_EQ, C_NE, C_LT, C_LE, C_GT, C_GE, C_SO); +begin + if f.flag > high(flag_2_cond) then + internalerror(200112301); + result.simple := true; + result.cr := f.cr; + result.cond := flag_2_cond[f.flag]; +end; + +procedure create_cond_imm(BO, BI: byte; var r: TAsmCond); +begin + r.simple := false; + r.bo := bo; + r.bi := bi; +end; + +procedure create_cond_norm(cond: TAsmCondFlag; cr: byte; var r: TasmCond); +begin + r.simple := true; + r.cond := cond; + case cond of + C_NONE: ; + C_T..C_DZF: r.crbit := cr + else + r.cr := RS_CR0 + cr; + end; +end; + +function is_condreg(r: tregister): boolean; +var + supreg: tsuperregister; +begin + result := false; + if (getregtype(r) = R_SPECIALREGISTER) then + begin + supreg := getsupreg(r); + result := (supreg >= RS_CR0) and (supreg <= RS_CR7); + end; +end; + +function reg_cgsize(const reg: tregister): tcgsize; +begin + case getregtype(reg) of + R_INTREGISTER: + result := OS_64; + R_MMREGISTER: + result := OS_M128; + R_FPUREGISTER: + result := OS_F64; + else + internalerror(200303181); + end; +end; + +function cgsize2subreg(regtype: tregistertype; s: Tcgsize): Tsubregister; +begin + cgsize2subreg := R_SUBWHOLE; +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; + +function dwarf_reg(r:tregister):shortint; +begin + result:=regdwarf_table[findreg_by_number(r)]; + if result=-1 then + internalerror(200603251); +end; + + +end. + diff --git a/closures/compiler/powerpc64/cpuinfo.pas b/closures/compiler/powerpc64/cpuinfo.pas new file mode 100644 index 0000000000..7b845cc45d --- /dev/null +++ b/closures/compiler/powerpc64/cpuinfo.pas @@ -0,0 +1,82 @@ +{ + Copyright (c) 1998-2002 by the Free Pascal development team + + Basic Processor information for the PowerPC + + 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 = extended; + ts128real = extended; + ts64comp = comp; + + pbestreal = ^bestreal; + + { possible supported processors for this target } + tcputype = (cpu_none, + cpu_ppc970 + ); + + tfputype = + (fpu_none, + fpu_soft, + fpu_standard + ); + +const + { calling conventions supported by the code generator } + supported_calling_conventions: tproccalloptions = [ + pocall_internproc, + pocall_stdcall, + { the difference to stdcall is only the name mangling } + pocall_cdecl, + { the difference to stdcall is only the name mangling } + pocall_cppdecl, + { the difference with stdcall is that all const record + parameters are passed by reference } + pocall_mwpascal + ]; + + cputypestr: array[tcputype] of string[10] = ('', + '970' + ); + + fputypestr: array[tfputype] of string[8] = ('', + 'SOFT', + 'STANDARD' + ); + + { Supported optimizations, only used for information } + supported_optimizerswitches = genericlevel1optimizerswitches+ + genericlevel2optimizerswitches+ + genericlevel3optimizerswitches- + { no need to write info about those } + [cs_opt_level1,cs_opt_level2,cs_opt_level3]+ + [cs_opt_regvar,cs_opt_loopunroll,cs_opt_nodecse,cs_opt_tailrecursion]; + + level1optimizerswitches = genericlevel1optimizerswitches; + level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + + [cs_opt_regvar,cs_opt_stackframe,cs_opt_nodecse,cs_opt_tailrecursion]; + level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches + [{,cs_opt_loopunroll}]; + +implementation + +end. + diff --git a/closures/compiler/powerpc64/cpunode.pas b/closures/compiler/powerpc64/cpunode.pas new file mode 100644 index 0000000000..0d4780e8ee --- /dev/null +++ b/closures/compiler/powerpc64/cpunode.pas @@ -0,0 +1,52 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + Includes the PowerPC64 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. + + **************************************************************************** +} +unit cpunode; + +{$I fpcdefs.inc} + +interface + +implementation + +uses + { generic nodes } + ncgbas, ncgld, ncgflw, ncgcnv, ncgmem, ncgcon, ncgcal, ncgset, ncginl, ncgopt, + ncgobjc, + { to be able to only parts of the generic code, + the processor specific nodes must be included + after the generic one (FK) + } + nppcadd, + nppccal, + // nppccon, + // nppcflw, + // nppcmem, + ngppcset, + ngppcinl, + // nppcopt, + nppcmat, + nppccnv, + nppcld + ; + +end. + diff --git a/closures/compiler/powerpc64/cpupara.pas b/closures/compiler/powerpc64/cpupara.pas new file mode 100644 index 0000000000..f856eac6a2 --- /dev/null +++ b/closures/compiler/powerpc64/cpupara.pas @@ -0,0 +1,526 @@ +{ + Copyright (c) 2002 by Florian Klaempfl + + PowerPC64 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. + **************************************************************************** +} +unit cpupara; + +{$I fpcdefs.inc} + +interface + +uses + globtype, + aasmtai,aasmdata, + cpubase, + symconst, symtype, symdef, symsym, + paramgr, parabase, cgbase, cgutils; + +type + tppcparamanager = 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; + function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override; + procedure create_funcretloc_info(p: tabstractprocdef; side: tcallercallee); + + 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; isVararg : boolean): longint; + function parseparaloc(p: tparavarsym; const s: string): boolean; override; + end; + +implementation + +uses + verbose, systems, + defutil, + procinfo, cpupi; + +function tppcparamanager.get_volatile_registers_int(calloption: + tproccalloption): tcpuregisterset; +begin + result := [RS_R0,RS_R3..RS_R12]; + if (target_info.system = system_powerpc64_darwin) then + include(result,RS_R2); +end; + +function tppcparamanager.get_volatile_registers_fpu(calloption: + tproccalloption): tcpuregisterset; +begin + result := [RS_F0..RS_F13]; +end; + +procedure tppcparamanager.getintparaloc(calloption: tproccalloption; nr: + longint; var cgpara: TCGPara); +var + paraloc: pcgparalocation; +begin + cgpara.reset; + cgpara.size := OS_ADDR; + cgpara.intsize := sizeof(pint); + cgpara.alignment := get_para_align(calloption); + paraloc := cgpara.add_location; + with paraloc^ do begin + size := OS_INT; + if (nr <= 8) then begin + if (nr = 0) then + internalerror(200309271); + loc := LOC_REGISTER; + register := newreg(R_INTREGISTER, RS_R2 + nr, R_SUBWHOLE); + end else begin + loc := LOC_REFERENCE; + paraloc^.reference.index := NR_STACK_POINTER_REG; + reference.offset := sizeof(aint) * (nr - 8); + end; + end; +end; + +function getparaloc(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.typ of + orddef: + result := LOC_REGISTER; + floatdef: + result := LOC_FPUREGISTER; + enumdef: + result := LOC_REGISTER; + pointerdef: + result := LOC_REGISTER; + formaldef: + result := LOC_REGISTER; + classrefdef: + result := LOC_REGISTER; + procvardef, + recorddef: + result := LOC_REGISTER; + objectdef: + if is_object(p) then + result := LOC_REFERENCE + else + result := LOC_REGISTER; + stringdef: + if is_shortstring(p) or is_longstring(p) then + result := LOC_REFERENCE + else + result := LOC_REGISTER; + filedef: + result := LOC_REGISTER; + arraydef: + result := LOC_REFERENCE; + setdef: + if is_smallset(p) then + result := LOC_REGISTER + else + result := LOC_REFERENCE; + variantdef: + result := LOC_REFERENCE; + { avoid problems with errornous definitions } + errordef: + result := LOC_REGISTER; + else + internalerror(2002071001); + end; +end; + +function tppcparamanager.push_addr_param(varspez: tvarspez; def: tdef; + calloption: tproccalloption): boolean; +begin + result := false; + { var,out,constref always require address } + if varspez in [vs_var, vs_out, vs_constref] then + begin + result := true; + exit; + end; + case def.typ of + variantdef, + formaldef: + result := true; + procvardef, + recorddef: + result := + ((varspez = vs_const) and + ( + (not (calloption in [pocall_cdecl, pocall_cppdecl]) and + (def.size > 8)) + ) or + (calloption = pocall_mwpascal) + ); + 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 := not is_smallset(def); + stringdef: + result := tstringdef(def).stringtype in [st_shortstring, st_longstring]; + end; +end; + +procedure tppcparamanager.init_values(var curintreg, curfloatreg, curmmreg: + tsuperregister; var cur_stack_offset: aword); +begin + { register parameter save area begins at 48(r2) } + cur_stack_offset := 48; + curintreg := RS_R3; + curfloatreg := RS_F1; + curmmreg := RS_M2; +end; + +procedure tppcparamanager.create_funcretloc_info(p: tabstractprocdef; side: + tcallercallee); +begin + p.funcretloc[side]:=get_funcretloc(p,side,p.returndef); +end; + +function tppcparamanager.get_funcretloc(p : tabstractprocdef; side: + tcallercallee; def: tdef): tcgpara; +var + paraloc : pcgparalocation; + retcgsize : tcgsize; +begin + result.init; + result.alignment:=get_para_align(p.proccalloption); + { void has no location } + if is_void(def) then + begin + paraloc:=result.add_location; + result.size:=OS_NO; + result.intsize:=0; + paraloc^.size:=OS_NO; + paraloc^.loc:=LOC_VOID; + exit; + end; + { Constructors return self instead of a boolean } + if (p.proctypeoption=potype_constructor) then + begin + retcgsize:=OS_ADDR; + result.intsize:=sizeof(pint); + end + else + begin + retcgsize:=def_cgsize(def); + result.intsize:=def.size; + end; + result.size:=retcgsize; + { Return is passed as var parameter } + if ret_in_param(def,p.proccalloption) then + begin + paraloc:=result.add_location; + paraloc^.loc:=LOC_REFERENCE; + paraloc^.size:=retcgsize; + exit; + end; + + paraloc:=result.add_location; + { Return in FPU register? } + if def.typ=floatdef then + begin + paraloc^.loc:=LOC_FPUREGISTER; + paraloc^.register:=NR_FPU_RESULT_REG; + paraloc^.size:=retcgsize; + end + else + { Return in register } + begin + paraloc^.loc:=LOC_REGISTER; + if side=callerside then + paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize)) + else + paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize)); + paraloc^.size:=retcgsize; + end; +end; + +function tppcparamanager.create_paraloc_info(p: tabstractprocdef; side: + tcallercallee): 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, side, p.paras, curintreg, curfloatreg, + curmmreg, cur_stack_offset, false); + + create_funcretloc_info(p, side); +end; + +function tppcparamanager.create_paraloc_info_intern(p: tabstractprocdef; side: + tcallercallee; paras: tparalist; + var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: + aword; isVararg : boolean): longint; +var + stack_offset: longint; + paralen: aint; + nextintreg, nextfloatreg, nextmmreg : tsuperregister; + paradef: tdef; + paraloc: pcgparalocation; + i: integer; + hp: tparavarsym; + loc: tcgloc; + paracgsize: tcgsize; + + parashift : byte; + +begin +{$IFDEF extdebug} + if po_explicitparaloc in p.procoptions then + internalerror(200411141); +{$ENDIF extdebug} + + result := 0; + nextintreg := curintreg; + nextfloatreg := curfloatreg; + nextmmreg := curmmreg; + stack_offset := cur_stack_offset; + + for i := 0 to paras.count - 1 do begin + parashift := 0; + hp := tparavarsym(paras[i]); + + paradef := hp.vardef; + { Syscall for Morphos can have already a paraloc set; not supported on ppc64 } + if (vo_has_explicit_paraloc in hp.varoptions) then begin + internalerror(200412153); + end; + hp.paraloc[side].reset; + { currently only support C-style array of const } + if (p.proccalloption in [pocall_cdecl, pocall_cppdecl]) and + is_array_of_const(paradef) 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 (hp.varspez in [vs_var, vs_out]) or + push_addr_param(hp.varspez, paradef, p.proccalloption) or + is_open_array(paradef) or + is_array_of_const(paradef) then begin + paradef := voidpointertype; + loc := LOC_REGISTER; + paracgsize := OS_ADDR; + paralen := tcgsize2size[OS_ADDR]; + end else begin + if not is_special_array(paradef) then + paralen := paradef.size + else + paralen := tcgsize2size[def_cgsize(paradef)]; + if (paradef.typ = recorddef) and + (hp.varspez in [vs_value, vs_const]) then begin + { if a record has only one field and that field is } + { non-composite (not array or record), it must be } + { passed according to the rules of that type. } + if (trecorddef(hp.vardef).symtable.SymList.count = 1) and + (not trecorddef(hp.vardef).isunion) and + (tabstractvarsym(trecorddef(hp.vardef).symtable.SymList[0]).vardef.typ in [orddef, enumdef, floatdef]) then begin + paradef := + tabstractvarsym(trecorddef(hp.vardef).symtable.SymList[0]).vardef; + loc := getparaloc(paradef); + paracgsize := def_cgsize(paradef); + end else begin + loc := LOC_REGISTER; + paracgsize := int_cgsize(paralen); + if (paralen in [3,5,6,7]) then + parashift := (8-paralen) * 8; + end; + end else begin + loc := getparaloc(paradef); + paracgsize := def_cgsize(paradef); + { for things like formaldef } + if (paracgsize = OS_NO) then begin + paracgsize := OS_ADDR; + paralen := tcgsize2size[OS_ADDR]; + end; + end + end; + + { patch FPU values into integer registers if we currently have + to pass them as vararg parameters + } + if (isVararg) and (paradef.typ = floatdef) then begin + loc := LOC_REGISTER; + if paracgsize = OS_F64 then + paracgsize := OS_64 + else + paracgsize := OS_32; + end; + + hp.paraloc[side].alignment := std_param_align; + hp.paraloc[side].size := paracgsize; + hp.paraloc[side].intsize := paralen; + if (paralen = 0) then + if (paradef.typ = recorddef) then begin + paraloc := hp.paraloc[side].add_location; + paraloc^.loc := LOC_VOID; + end else + internalerror(2005011310); + { can become < 0 for e.g. 3-byte records } + + while (paralen > 0) do begin + paraloc := hp.paraloc[side].add_location; + { In case of po_delphi_nested_cc, the parent frame pointer + is always passed on the stack. } + if (loc = LOC_REGISTER) and + (nextintreg <= RS_R10) and + (not(vo_is_parentfp in hp.varoptions) or + not(po_delphi_nested_cc in p.procoptions)) then begin + paraloc^.loc := loc; + paraloc^.shiftval := parashift; + + { make sure we don't lose whether or not the type is signed } + if (paracgsize <> OS_NO) and (paradef.typ <> orddef) then + paracgsize := int_cgsize(paralen); + if (paracgsize in [OS_NO,OS_128,OS_S128]) then + paraloc^.size := OS_INT + else + paraloc^.size := paracgsize; + + paraloc^.register := newreg(R_INTREGISTER, nextintreg, R_SUBNONE); + inc(nextintreg); + dec(paralen, tcgsize2size[paraloc^.size]); + + inc(stack_offset, sizeof(pint)); + end else if (loc = LOC_FPUREGISTER) and + (nextfloatreg <= RS_F13) then begin + paraloc^.loc := loc; + paraloc^.size := paracgsize; + paraloc^.register := newreg(R_FPUREGISTER, nextfloatreg, R_SUBWHOLE); + { the PPC64 ABI says that the GPR index is increased for every parameter, no matter + which type it is stored in } + inc(nextintreg); + inc(nextfloatreg); + dec(paralen, tcgsize2size[paraloc^.size]); + + inc(stack_offset, tcgsize2size[OS_FLOAT]); + end else if (loc = LOC_MMREGISTER) then begin + { Altivec not supported } + internalerror(200510192); + end else begin + { either LOC_REFERENCE, or one of the above which must be passed on the + stack because of insufficient registers } + paraloc^.loc := LOC_REFERENCE; + case loc of + LOC_FPUREGISTER: + paraloc^.size:=int_float_cgsize(paralen); + LOC_REGISTER, + LOC_REFERENCE: + paraloc^.size:=int_cgsize(paralen); + else + internalerror(2006011101); + end; + if (side = callerside) then + paraloc^.reference.index := NR_STACK_POINTER_REG + else begin + { during procedure entry, NR_OLD_STACK_POINTER_REG contains the old stack pointer } + paraloc^.reference.index := NR_OLD_STACK_POINTER_REG; + tppcprocinfo(current_procinfo).needs_frame_pointer := true; + end; + paraloc^.reference.offset := stack_offset; + + { align temp contents to next register size } + inc(stack_offset, align(paralen, 8)); + paralen := 0; + end; + end; + end; + + curintreg := nextintreg; + curfloatreg := nextfloatreg; + curmmreg := nextmmreg; + cur_stack_offset := stack_offset; + result := stack_offset; +end; + +function tppcparamanager.create_varargs_paraloc_info(p: tabstractprocdef; + varargspara: tvarargsparalist): longint; +var + cur_stack_offset: aword; + parasize, l: longint; + curintreg, firstfloatreg, curfloatreg, curmmreg: tsuperregister; + i: integer; + hp: tparavarsym; + paraloc: pcgparalocation; +begin + init_values(curintreg, curfloatreg, curmmreg, cur_stack_offset); + firstfloatreg := curfloatreg; + + result := create_paraloc_info_intern(p, callerside, p.paras, curintreg, + curfloatreg, curmmreg, cur_stack_offset, false); + if (p.proccalloption in [pocall_cdecl, pocall_cppdecl]) then begin + { just continue loading the parameters in the registers } + result := create_paraloc_info_intern(p, callerside, varargspara, curintreg, + curfloatreg, curmmreg, cur_stack_offset, true); + { varargs routines have to reserve at least 64 bytes for the PPC64 ABI } + if (result < 64) then + result := 64; + end else begin + parasize := cur_stack_offset; + for i := 0 to varargspara.count - 1 do begin + hp := tparavarsym(varargspara[i]); + hp.paraloc[callerside].alignment := 8; + paraloc := hp.paraloc[callerside].add_location; + paraloc^.loc := LOC_REFERENCE; + paraloc^.size := def_cgsize(hp.vardef); + paraloc^.reference.index := NR_STACK_POINTER_REG; + l := push_size(hp.varspez, hp.vardef, p.proccalloption); + paraloc^.reference.offset := parasize; + parasize := parasize + l; + end; + result := parasize; + end; + if curfloatreg <> firstfloatreg then + include(varargspara.varargsinfo, va_uses_float_reg); +end; + +function tppcparamanager.parseparaloc(p: tparavarsym; const s: string): boolean; +begin + { not supported/required for PowerPC64-linux target } + internalerror(200404182); + result := true; +end; + + +begin + paramanager := tppcparamanager.create; +end. + diff --git a/closures/compiler/powerpc64/cpupi.pas b/closures/compiler/powerpc64/cpupi.pas new file mode 100644 index 0000000000..b5be0df730 --- /dev/null +++ b/closures/compiler/powerpc64/cpupi.pas @@ -0,0 +1,130 @@ +{ + 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 + cutils,aasmdata, + procinfo, cpuinfo, psub; + +type + tppcprocinfo = class(tcgprocinfo) + needstackframe: boolean; + + { offset where the frame pointer from the outer procedure is stored. } + parent_framepointer_offset: longint; + + needs_frame_pointer : boolean; + + constructor create(aparent: tprocinfo); override; + procedure set_first_temp_offset; override; + function calc_stackframe_size: longint; override; + function calc_stackframe_size(numgpr, numfpr : longint): longint; + + procedure allocate_got_register(list: TAsmList); override; + end; + +implementation + +uses + globtype, globals, systems, + cpubase, cgbase, + aasmtai, + tgobj,cgobj, + symconst, symsym, paramgr, symutil, symtable, + verbose; + +constructor tppcprocinfo.create(aparent: tprocinfo); + +begin + inherited create(aparent); + maxpushedparasize := 0; + needs_frame_pointer := false; +end; + +procedure tppcprocinfo.set_first_temp_offset; +var + ofs: aword; +begin + if not (po_assembler in procdef.procoptions) then begin + { align the stack properly } + ofs := align(maxpushedparasize + LinkageAreaSizeELF, ELF_STACK_ALIGN); + + { the ABI specification says that it is required to always allocate space for 8 * 8 bytes + for registers R3-R10 and stack header if there's a stack frame, but GCC doesn't do that, + so we don't that too. Uncomment the next three lines if this is required } + if (cs_profile in init_settings.moduleswitches) and (ofs < MINIMUM_STACKFRAME_SIZE) then begin + ofs := MINIMUM_STACKFRAME_SIZE; + end; + tg.setfirsttemp(ofs); + end else begin + if (current_procinfo.procdef.localst.symtabletype=localsymtable) and + (tabstractlocalsymtable(current_procinfo.procdef.localst).count_locals <> 0) then + { at 0(r1), the previous value of r1 will be stored } + tg.setfirsttemp(8); + end; +end; + +function tppcprocinfo.calc_stackframe_size: longint; +begin + result := calc_stackframe_size(18, 18); +end; + +function tppcprocinfo.calc_stackframe_size(numgpr, numfpr : longint) : longint; +begin + { more or less copied from cgcpu.pas/g_stackframe_entry } + if not (po_assembler in procdef.procoptions) then begin + // no VMX support + result := align(numgpr * sizeof(pint) + + numfpr * tcgsize2size[OS_FLOAT], ELF_STACK_ALIGN); + + if (pi_do_call in flags) or (tg.lasttemp <> tg.firsttemp) or + (result > RED_ZONE_SIZE) {or (cs_profile in init_settings.moduleswitches)} then begin + result := align(result + tg.lasttemp, ELF_STACK_ALIGN); + needstackframe:=true; + end else + needstackframe:=false; + end else begin + result := align(tg.lasttemp, ELF_STACK_ALIGN); + needstackframe:=result<>0; + end; +end; + + +procedure tppcprocinfo.allocate_got_register(list: TAsmList); + begin + if (target_info.system = system_powerpc64_darwin) and + (cs_create_pic in current_settings.moduleswitches) then + begin + got := cg.getaddressregister(list); + end; + end; + +begin + cprocinfo := tppcprocinfo; +end. + diff --git a/closures/compiler/powerpc64/cputarg.pas b/closures/compiler/powerpc64/cputarg.pas new file mode 100644 index 0000000000..1f2436889d --- /dev/null +++ b/closures/compiler/powerpc64/cputarg.pas @@ -0,0 +1,83 @@ +{ + Copyright (c) 2001-2002 by Peter Vreman + + Includes the powerpc64 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 NOTARGETBSD} + ,t_bsd + {$endif} + +{************************************** + Assemblers +**************************************} + + {$ifndef NOAGPPCGAS} + ,agppcgas + {$endif} + +{************************************** + Assembler Readers +**************************************} + + {$ifndef NoRaPPCGas} + ,rappcgas + {$endif NoRaPPCGas} + +{************************************** + Debuginfo +**************************************} + +{ stabs debug info are not supported, so do not include them here} +{ they are supported on darwin/ppc64 } + {$ifndef NoDbgDwarf} + ,dbgstabs + {$endif NoDbgDwarf} + {$ifndef NoDbgDwarf} + ,dbgdwarf + {$endif NoDbgDwarf} + +{************************************** + Optimizer +**************************************} + + {$ifndef NOOPT} + , aoptcpu + {$endif NOOPT} + ; + +end. diff --git a/closures/compiler/powerpc64/itcpugas.pas b/closures/compiler/powerpc64/itcpugas.pas new file mode 100644 index 0000000000..bc39c065fd --- /dev/null +++ b/closures/compiler/powerpc64/itcpugas.pas @@ -0,0 +1,160 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit contains the PowerPC 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 + gas_op2str: array[tasmop] of string[14] = ('<none>', + 'add', 'add.', 'addo', 'addo.', 'addc', 'addc.', 'addco', 'addco.', + 'adde', 'adde.', 'addeo', 'addeo.', 'addi', 'addic', 'addic.', 'addis', + 'addme', 'addme.', 'addmeo', 'addmeo.', 'addze', 'addze.', 'addzeo', + 'addzeo.', 'and', 'and.', 'andc', 'andc.', 'andi.', 'andis.', 'b', + 'ba', 'bl', 'bla', 'bc', 'bca', 'bcl', 'bcla', 'bcctr', 'bcctrl', 'bclr', + 'bclrl', 'cmp', 'cmpi', 'cmpl', 'cmpli', 'cntlzw', 'cntlzw.', 'crand', + 'crandc', 'creqv', 'crnand', 'crnor', 'cror', 'crorc', 'crxor', 'dcba', + 'dcbf', 'dcbi', 'dcbst', 'dcbt', 'dcbtst', 'dcbz', 'divw', 'divw.', 'divwo', + 'divwo.', + 'divwu', 'divwu.', 'divwuo', 'divwuo.', 'eciwx', 'ecowx', 'eieio', 'eqv', + 'eqv.', 'extsb', 'extsb.', 'extsh', 'extsh.', 'fabs', 'fabs.', 'fadd', + 'fadd.', 'fadds', 'fadds.', 'fcmpo', 'fcmpu', 'fctiw', 'fctiw.', 'fctiwz', + 'fctiwz.', 'fdiv', 'fdiv.', 'fdivs', 'fdivs.', 'fmadd', 'fmadd.', 'fmadds', + 'fmadds.', 'fmr', 'fmsub', 'fmsub.', 'fmsubs', 'fmsubs.', 'fmul', 'fmul.', + 'fmuls', 'fmuls.', 'fnabs', 'fnabs.', 'fneg', 'fneg.', 'fnmadd', + 'fnmadd.', 'fnmadds', 'fnmadds.', 'fnmsub', 'fnmsub.', 'fnmsubs', + 'fnmsubs.', 'fres', 'fres.', 'frsp', 'frsp.', 'frsqrte', 'frsqrte.', + 'fsel', 'fsel.', 'fsqrt', 'fsqrt.', 'fsqrts', 'fsqrts.', 'fsub', 'fsub.', + 'fsubs', 'fsubs.', 'icbi', 'isync', 'lbz', 'lbzu', 'lbzux', 'lbzx', + 'lfd', 'lfdu', 'lfdux', 'lfdx', 'lfs', 'lfsu', 'lfsux', 'lfsx', 'lha', + 'lhau', 'lhaux', 'lhax', 'lhbrx', 'lhz', 'lhzu', 'lhzux', 'lhzx', 'lmw', + 'lswi', 'lswx', 'lwarx', 'lwbrx', 'lwz', 'lwzu', 'lwzux', 'lwzx', 'mcrf', + 'mcrfs', 'mcrxr', 'mfcr', 'mffs', 'mffs.', 'mfmsr', 'mfspr', 'mfsr', + 'mfsrin', 'mftb', 'mtcrf', 'mtfsb0', 'mtfsb1', 'mtfsf', 'mtfsf.', + 'mtfsfi', 'mtfsfi.', 'mtmsr', 'mtspr', 'mtsr', 'mtsrin', 'mulhw', + 'mulhw.', 'mulhwu', 'mulhwu.', 'mulli', 'mullw', 'mullw.', 'mullwo', + 'mullwo.', 'nand', 'nand.', 'neg', 'neg.', 'nego', 'nego.', 'nor', 'nor.', + 'or', 'or.', 'orc', 'orc.', 'ori', 'oris', 'rfi', 'rlwimi', 'rlwimi.', + 'rlwinm', 'rlwinm.', 'rlwnm', 'sc', 'slw', 'slw.', 'sraw', 'sraw.', + 'srawi', 'srawi.', 'srw', 'srw.', 'stb', 'stbu', 'stbux', 'stbx', 'stfd', + 'stfdu', 'stfdux', 'stfdx', 'stfiwx', 'stfs', 'stfsu', 'stfsux', 'stfsx', + 'sth', 'sthbrx', 'sthu', 'sthux', 'sthx', 'stmw', 'stswi', 'stswx', 'stw', + 'stwbrx', 'stwcx.', 'stwu', 'stwux', 'stwx', 'subf', 'subf.', 'subfo', + 'subfo.', 'subfc', 'subc.', 'subfco', 'subfco.', 'subfe', 'subfe.', + 'subfeo', 'subfeo.', 'subfic', 'subfme', 'subfme.', 'subfmeo', 'subfmeo.', + 'subfze', 'subfze.', 'subfzeo', 'subfzeo.', 'sync', 'tlbia', 'tlbie', + 'tlbsync', 'tw', 'twi', 'xor', 'xor.', 'xori', 'xoris', + { some simplified mnemonics } + 'subi', 'subis', 'subic', 'subic.', 'sub', 'sub.', 'subo', 'subo.', + 'subc', 'subc.', 'subco', 'subco.', 'cmpwi', 'cmpw', 'cmplwi', 'cmplw', + 'extlwi', 'extlwi.', 'extrwi', 'extrwi.', 'inslwi', 'inslwi.', 'insrwi', + 'insrwi.', 'rotlwi', 'rotlwi.', 'rotlw', 'rotlw.', 'slwi', 'slwi.', + 'srwi', 'srwi.', 'clrlwi', 'clrlwi.', 'clrrwi', 'clrrwi.', 'clrslwi', + 'clrslwi.', 'bf', 'bt', 'blr', 'bctr', 'blrl', 'bctrl', 'crset', 'crclr', 'crmove', + 'crnot', 'mt', 'mf', 'nop', 'li', 'lis', 'la', 'mr', 'mr.', 'not', 'mtcr', + 'mtlr', 'mflr', + 'mtctr', 'mfctr', + 'extsw', 'rldimi', + 'std', 'stdu', 'stdx', 'stdux', + 'ld', 'ldu', 'ldx', 'ldux', + 'cmpd', 'cmpdi', 'cmpld', 'cmpldi', + 'srdi', 'sradi', + 'sldi', + 'rldcl', 'rldicl', + 'divdu', 'divdu.', 'divd', 'divd.', 'mulld', 'mulld.', 'mulhd', 'mulhd.', 'srad', 'sld', 'srd', + 'divduo.', 'divdo.', + 'lwa', 'lwax', 'lwaux', + 'fcfid', + 'ldarx', 'stdcx.', 'cntlzd', + 'lvx', 'stvx', + 'mulldo', 'mulldo.', 'mulhdu', 'mulhdu.', + 'mfxer', + 'fctid', 'fctid.', 'fctidz', 'fctidz.', + 'extrdi', 'extrdi.', 'insrdi', 'insrdi.', + 'lwsync'); + +function gas_regnum_search(const s: string): Tregister; +function gas_regname(r: Tregister): string; + +implementation + +uses + globtype, globals,aasmbase, + cutils, verbose, systems; + +const + gas_regname_table: array[tregisterindex] of string[7] = ( +{$I rppcgas.inc} + ); + + gas_regname_short_table: array[tregisterindex] of string[7] = ( +{$I rppcgss.inc} + ); + + gas_regname_index: array[tregisterindex] of tregisterindex = ( +{$I rppcgri.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: longint; +begin + p := findreg_by_number(r); + if p <> 0 then + if create_smartlink_library and + not(target_info.system = system_powerpc64_darwin) then + result := gas_regname_short_table[p] + else + result := gas_regname_table[p] + else + result := generic_regname(r); +end; + +end. + diff --git a/closures/compiler/powerpc64/nppcadd.pas b/closures/compiler/powerpc64/nppcadd.pas new file mode 100644 index 0000000000..7d11a78a6e --- /dev/null +++ b/closures/compiler/powerpc64/nppcadd.pas @@ -0,0 +1,360 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl and Jonas Maebe + + Code generation for add nodes on the PowerPC64 + + 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 nppcadd; + +{$I fpcdefs.inc} + +interface + +uses + node, nadd, ncgadd, ngppcadd, cpubase; + +type + tppcaddnode = class(tgenppcaddnode) + procedure pass_generate_code override; + private + procedure emit_compare(unsigned: boolean); override; + end; + +implementation + +uses + sysutils, + + globtype, systems, + cutils, verbose, globals, + symconst, symdef, paramgr, + aasmbase, aasmtai,aasmdata, aasmcpu, defutil, htypechk, + cgbase, cpuinfo, pass_1, pass_2, regvars, + cpupara, cgcpu, cgutils,procinfo, + ncon, nset, + ncgutil, tgobj, rgobj, rgcpu, cgobj; + +{***************************************************************************** + Helpers +*****************************************************************************} + +procedure tppcaddnode.emit_compare(unsigned: boolean); +const + { unsigned useconst 32bit-op } + cmpop_table : array[boolean, boolean, boolean] of TAsmOp = ( + ((A_CMPD, A_CMPW), (A_CMPDI, A_CMPWI)), + ((A_CMPLD, A_CMPLW), (A_CMPLDI, A_CMPLWI)) + ); + +var + op: TAsmOp; + tmpreg: TRegister; + useconst: boolean; + + opsize : TCgSize; +begin + { get the constant on the right if there is one } + if (left.location.loc = LOC_CONSTANT) then + swapleftright; + + opsize := def_cgsize(left.resultdef); + + {$IFDEF EXTDEBUG} + current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('tppcaddnode.emit_compare ' + inttostr(ord(opsize)) + ' ' + inttostr(tcgsize2size[opsize])))); + {$ENDIF EXTDEBUG} + + { can we use a signed comparison or not? In case of equal/unequal comparison + we can check whether this is possible because it does not matter. } + if (right.location.loc = LOC_CONSTANT) then + if (nodetype in [equaln,unequaln]) then + if (unsigned and (aword(right.location.value) > high(word))) or + (not unsigned and (aint(right.location.value) < low(smallint)) or + (aint(right.location.value) > high(smallint))) then + { we can then maybe use a constant in the 'othersigned' case + (the sign doesn't matter for equal/unequal) } + unsigned := not unsigned; + + { calculate the size of the comparison because ppc64 only has 32 and 64 + bit comparison opcodes; prefer 32 bits } + if (not (opsize in [OS_32, OS_S32, OS_64, OS_S64])) then begin + if (unsigned) then + opsize := OS_32 + else + opsize := OS_S32; + cg.a_load_reg_reg(current_asmdata.CurrAsmList, def_cgsize(left.resultdef), opsize, + left.location.register, left.location.register); + end; + + { can we use an immediate, or do we have to load the + constant in a register first? } + if (right.location.loc = LOC_CONSTANT) then begin + if (unsigned and + (aword(right.location.value) <= high(word))) or + (not (unsigned) and + (aint(right.location.value) >= low(smallint)) and (aint(right.location.value) <= high(smallint))) then + useconst := true + else begin + useconst := false; + tmpreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + cg.a_load_const_reg(current_asmdata.CurrAsmList, opsize, right.location.value, tmpreg); + end + end else + useconst := false; + + location.loc := LOC_FLAGS; + location.resflags := getresflags; + + op := cmpop_table[unsigned, useconst, opsize in [OS_S32, OS_32]]; + + { actually do the operation } + if (right.location.loc = LOC_CONSTANT) then begin + if useconst then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(op, left.location.register, + longint(right.location.value))) + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op, left.location.register, tmpreg)); + end else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op, left.location.register, + right.location.register)); +end; + +{***************************************************************************** + pass_2 +*****************************************************************************} + +procedure tppcaddnode.pass_generate_code; +{ is also being used for xor, and "mul", "sub, or and comparative } +{ operators } +var + cgop: topcg; + op: tasmop; + tmpreg: tregister; + hl: tasmlabel; + cmpop: boolean; + checkoverflow: boolean; + + { true, if unsigned types are compared } + unsigned: boolean; + +begin + { to make it more readable, string and set (not smallset!) have their + own procedures } + case left.resultdef.typ of + orddef: + begin + { handling boolean expressions } + if is_boolean(left.resultdef) and + is_boolean(right.resultdef) then + begin + second_addboolean; + exit; + end; + end; + stringdef: + begin + internalerror(2002072402); + exit; + end; + setdef: + begin + { normalsets are already handled in pass1 } + if not is_smallset(left.resultdef) then + internalerror(200109041); + second_addsmallset; + exit; + end; + arraydef: + begin +{$IFDEF SUPPORT_MMX} + if is_mmx_able_array(left.resultdef) then + begin + second_addmmx; + exit; + end; +{$ENDIF SUPPORT_MMX} + end; + floatdef: + begin + second_addfloat; + exit; + end; + end; + + { defaults } + cmpop := nodetype in [ltn, lten, gtn, gten, equaln, unequaln]; + unsigned := not (is_signed(left.resultdef)) or + not (is_signed(right.resultdef)); + + pass_left_and_right; + + { Convert flags to register first } + { can any of these things be in the flags actually?? (JM) } + + if (left.location.loc = LOC_FLAGS) or + (right.location.loc = LOC_FLAGS) then + internalerror(2002072602); + + { set result location } + if not cmpop then + location_reset(location, LOC_REGISTER, def_cgsize(resultdef)) + else + location_reset(location, LOC_FLAGS, OS_NO); + + checkoverflow:= + (nodetype in [addn,subn,muln]) and + (cs_check_overflow in current_settings.localswitches) and + (left.resultdef.typ<>pointerdef) and + (right.resultdef.typ<>pointerdef); + + load_left_right(cmpop, checkoverflow); + + if not (cmpop) then + location.register := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + + if not (checkoverflow) then begin + case nodetype of + addn, muln, xorn, orn, andn: + begin + case nodetype of + addn: + cgop := OP_ADD; + muln: + if unsigned then + cgop := OP_MUL + else + cgop := OP_IMUL; + xorn: + cgop := OP_XOR; + orn: + cgop := OP_OR; + andn: + cgop := OP_AND; + end; + if (left.location.loc = LOC_CONSTANT) then + swapleftright; + if (right.location.loc <> LOC_CONSTANT) then + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, cgop, OS_INT, + left.location.register, right.location.register, + location.register) + else + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, cgop, OS_INT, + right.location.value, left.location.register, + location.register); + end; + subn: + begin + if (nf_swapped in flags) then + swapleftright; + if left.location.loc <> LOC_CONSTANT then + if right.location.loc <> LOC_CONSTANT then begin + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_SUB, OS_INT, + right.location.register, left.location.register, + location.register); + end else begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SUB, OS_INT, + right.location.value, left.location.register, + location.register); + end + else + begin + tmpreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, + left.location.value, tmpreg); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_SUB, OS_INT, + right.location.register, tmpreg, location.register); + end; + end; + ltn, lten, gtn, gten, equaln, unequaln: + begin + {$ifdef extdebug} + current_asmdata.CurrAsmList.concat(tai_comment.create('tppcaddnode.pass2')); + {$endif extdebug} + + emit_compare(unsigned); + end; + end; + end + else + // overflow checking is on and we have an addn, subn or muln + begin + if is_signed(resultdef) then + begin + case nodetype of + addn: + op := A_ADDO; + subn: + begin + op := A_SUBO; + if (nf_swapped in flags) then + swapleftright; + end; + muln: + op := A_MULLDO; + else + internalerror(2002072601); + end; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op, location.register, + left.location.register, right.location.register)); + cg.g_overflowcheck(current_asmdata.CurrAsmList, location, resultdef); + end + else + begin + case nodetype of + addn: + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ADD, location.register, + left.location.register, right.location.register)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMPLD, location.register, + left.location.register)); + cg.g_overflowcheck(current_asmdata.CurrAsmList, location, resultdef); + end; + subn: + begin + if (nf_swapped in flags) then + swapleftright; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUB, location.register, + left.location.register, right.location.register)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMPLD, + left.location.register, location.register)); + cg.g_overflowcheck(current_asmdata.CurrAsmList, location, resultdef); + end; + muln: + begin + { calculate the upper 64 bits of the product, = 0 if no overflow } + cg.a_reg_alloc(current_asmdata.CurrAsmList, NR_R0); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULHDU_, NR_R0, + left.location.register, right.location.register)); + cg.a_reg_dealloc(current_asmdata.CurrAsmList, NR_R0); + { calculate the real result } + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULLD, location.register, + left.location.register, right.location.register)); + { g_overflowcheck generates a OC_AE instead of OC_EQ :/ } + current_asmdata.getjumplabel(hl); + tcgppc(cg).a_jmp_cond(current_asmdata.CurrAsmList, OC_EQ, hl); + cg.a_call_name(current_asmdata.CurrAsmList, 'FPC_OVERFLOW',false); + cg.a_label(current_asmdata.CurrAsmList, hl); + end; + end; + end; + end; +end; + +begin + caddnode := tppcaddnode; +end. + diff --git a/closures/compiler/powerpc64/nppccal.pas b/closures/compiler/powerpc64/nppccal.pas new file mode 100644 index 0000000000..8588fe43cd --- /dev/null +++ b/closures/compiler/powerpc64/nppccal.pas @@ -0,0 +1,63 @@ +{ + Copyright (c) 2002 by Florian Klaempfl + + Implements the PowerPC 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 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 nppccal; + +{$I fpcdefs.inc} + +interface + +uses + symdef, node, ncal, ncgcal; + +type + + tppccallparanode = class(tcgcallparanode) + end; + + tppccallnode = class(tcgcallnode) + procedure do_syscall; override; + end; + +implementation + +uses + globtype, systems, + cutils, verbose, globals, + symconst, symbase, symsym, symtable, defutil, paramgr, parabase, + cgbase, pass_2, + cpuinfo, cpubase, aasmbase, aasmtai,aasmdata, aasmcpu, + nmem, nld, ncnv, + ncgutil, cgutils, cgobj, tgobj, regvars, rgobj, rgcpu, + cgcpu, cpupi, procinfo; + +procedure tppccallnode.do_syscall; +begin + { no MorphOS style syscalls supported. Only implemented to avoid abstract + method not implemented compiler warning. } + internalerror(2005120401); +end; + +begin + ccallparanode:=tppccallparanode; + ccallnode := tppccallnode; +end. + diff --git a/closures/compiler/powerpc64/nppccnv.pas b/closures/compiler/powerpc64/nppccnv.pas new file mode 100644 index 0000000000..02dd630010 --- /dev/null +++ b/closures/compiler/powerpc64/nppccnv.pas @@ -0,0 +1,235 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate PowerPC 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 nppccnv; + +{$I fpcdefs.inc} + +interface + +uses + node, ncnv, ncgcnv, ngppccnv; + +type + tppctypeconvnode = class(tgenppctypeconvnode) + protected + { 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,aasmdata, + defutil, + cgbase, cgutils, pass_1, pass_2, + ncon, ncal,procinfo, + ncgutil, + cpubase, aasmcpu, + rgobj, tgobj, cgobj; + +{***************************************************************************** + FirstTypeConv +*****************************************************************************} + +function tppctypeconvnode.first_int_to_real: tnode; +begin + if (is_currency(left.resultdef)) then begin + // hack to avoid double division by 10000, as it's + // already done by typecheckpass.resultdef_int_to_real + left.resultdef := s64inttype; + end else begin + // everything that is less than 64 bits is converted to a 64 bit signed + // integer - because the int_to_real conversion is faster for 64 bit + // signed ints compared to 64 bit unsigned ints. + if (not (torddef(left.resultdef).ordtype in [s64bit, u64bit, scurrency])) then begin + inserttypeconv(left, s64inttype); + end; + end; + firstpass(left); + result := nil; + expectloc := LOC_FPUREGISTER; +end; + +{***************************************************************************** + SecondTypeConv +*****************************************************************************} + +procedure tppctypeconvnode.second_int_to_real; +const + convconst : double = $100000000; +var + tempconst : tnode; + disp, disp2: treference; + // temp registers for converting signed ints + valuereg, leftreg, + // additional temp registers for converting unsigned 64 bit ints + tmpintreg1, tmpintreg2, tmpfpureg, tmpfpuconst : tregister; + size: tcgsize; + signed: boolean; +begin + + location_reset(location, LOC_FPUREGISTER, def_cgsize(resultdef)); + + { the code here comes from the PowerPC Compiler Writer's Guide } + { * longint to double (works for all rounding modes) } + { std R3,disp(R1) # store doubleword } + { lfd FR1,disp(R1) # load float double } + { fcfid FR1,FR1 # convert to floating-point integer } + + { * unsigned 64 bit int to fp value (works for all rounding modes) } + { rldicl rT1,rS,32,32 # isolate high half } + { rldicl rT2,rS,0,32 # isolate low half } + { std rT1,disp(R1) # store high half } + { std rT2,disp+8(R1) # store low half } + { lfd frT1,disp(R1) # load high half } + { lfd frD,disp+8(R1) # load low half } + { fcfid frT1,frT1 # convert each half to floating } + { fcfid frD,frD # point integer (no round) } + { fmadd frD,frC,frT1,frD # (2^32)*high + low } + { # (only add can round) } + tg.Gettemp(current_asmdata.CurrAsmList, 8, 8, tt_normal, disp); + + { do the signed case for everything but 64 bit unsigned integers } + signed := (left.location.size <> OS_64); + + { we need a certain constant for the conversion of unsigned 64 bit integers, + so create them here. Additonally another temporary location is neeted } + if (not signed) then begin + // allocate temp for constant value used for unsigned 64 bit ints + tempconst := + crealconstnode.create(convconst, pbestrealtype^); + typecheckpass(tempconst); + firstpass(tempconst); + secondpass(tempconst); + if (tempconst.location.loc <> LOC_CREFERENCE) then + internalerror(200110011); + + // allocate second temp memory + tg.Gettemp(current_asmdata.CurrAsmList, 8, 8, tt_normal, disp2); + end; + + if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_REFERENCE,LOC_CREFERENCE]) then + location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,false); + case left.location.loc of + // the conversion algorithm does not modify the input register, so it can + // be used for both LOC_REGISTER and LOC_CREGISTER + LOC_REGISTER, LOC_CREGISTER: + begin + leftreg := left.location.register; + valuereg := leftreg; + end; + LOC_REFERENCE, LOC_CREFERENCE: + begin + leftreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + valuereg := leftreg; + if signed then + size := OS_S64 + else + size := OS_64; + cg.a_load_ref_reg(current_asmdata.CurrAsmList, def_cgsize(left.resultdef), + size, left.location.reference, leftreg); + end + else + internalerror(200110012); + end; + + if (signed) then begin + // std rS, disp(r1) + cg.a_load_reg_ref(current_asmdata.CurrAsmList, OS_S64, OS_S64, valuereg, disp); + // lfd frD, disp(r1) + location.register := cg.getfpuregister(current_asmdata.CurrAsmList,OS_F64); + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,OS_F64, OS_F64, disp, location.register); + // fcfid frD, frD + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FCFID, location.register, + location.register)); + end else begin + { ts:todo use TOC for this constant or at least schedule better } + // lfd frC, const + tmpfpuconst := cg.getfpuregister(current_asmdata.CurrAsmList,OS_F64); + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,OS_F64,OS_F64,tempconst.location.reference, + tmpfpuconst); + tempconst.free; + + tmpintreg1 := cg.getintregister(current_asmdata.CurrAsmList, OS_64); + // rldicl rT1, rS, 32, 32 + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const_const(A_RLDICL, tmpintreg1, valuereg, 32, 32)); + // rldicl rT2, rS, 0, 32 + tmpintreg2 := cg.getintregister(current_asmdata.CurrAsmList, OS_64); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const_const(A_RLDICL, tmpintreg2, valuereg, 0, 32)); + + // std rT1, disp(r1) + cg.a_load_reg_ref(current_asmdata.CurrAsmList, OS_S64, OS_S64, tmpintreg1, disp); + // std rT2, disp2(r1) + cg.a_load_reg_ref(current_asmdata.CurrAsmList, OS_S64, OS_S64, tmpintreg2, disp2); + + // lfd frT1, disp(R1) + tmpfpureg := cg.getfpuregister(current_asmdata.CurrAsmList,OS_F64); + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,OS_F64, OS_F64, disp, tmpfpureg); + // lfd frD, disp+8(R1) + location.register := cg.getfpuregister(current_asmdata.CurrAsmList,OS_F64); + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,OS_F64, OS_F64, disp2, location.register); + + // fcfid frT1, frT1 + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FCFID, tmpfpureg, + tmpfpureg)); + // fcfid frD, frD + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FCFID, location.register, + location.register)); + // fmadd frD,frC,frT1,frD # (2^32)*high + low } + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg_reg(A_FMADD, location.register, tmpfpuconst, + tmpfpureg, location.register)); + + // free used temps + tg.ungetiftemp(current_asmdata.CurrAsmList, disp2); + end; + // free reference + tg.ungetiftemp(current_asmdata.CurrAsmList, disp); + + // make sure the precision is correct + if (tfloatdef(resultdef).floattype = s32real) then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FRSP,location.register, + location.register)); +end; + +begin + ctypeconvnode := tppctypeconvnode; +end. + diff --git a/closures/compiler/powerpc64/nppcld.pas b/closures/compiler/powerpc64/nppcld.pas new file mode 100644 index 0000000000..3c1324c686 --- /dev/null +++ b/closures/compiler/powerpc64/nppcld.pas @@ -0,0 +1,62 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate ppc assembler for nodes that handle loads and assignments + + 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 nppcld; + +{$I fpcdefs.inc} + +interface + +uses + node, ncgld; + +type + tppcloadnode = class(tcgloadnode) + procedure pass_generate_code override; + procedure generate_picvaraccess; override; + end; + +implementation + +uses + verbose, + systems, + cpubase, + cgutils, cgobj, + aasmbase, aasmtai,aasmdata, + symconst, symsym, + procinfo, + nld; + +procedure tppcloadnode.pass_generate_code; +begin + inherited pass_generate_code; +end; + +procedure tppcloadnode.generate_picvaraccess; +begin + internalerror(200402291); +end; + +begin + cloadnode := tppcloadnode; +end. + diff --git a/closures/compiler/powerpc64/nppcmat.pas b/closures/compiler/powerpc64/nppcmat.pas new file mode 100644 index 0000000000..b1a008188c --- /dev/null +++ b/closures/compiler/powerpc64/nppcmat.pas @@ -0,0 +1,446 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate PowerPC 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 nppcmat; + +{$I fpcdefs.inc} + +interface + +uses + node, nmat; + +type + tppcmoddivnode = class(tmoddivnode) + function pass_1: tnode; override; + procedure pass_generate_code override; + end; + + tppcshlshrnode = class(tshlshrnode) + procedure pass_generate_code override; + end; + + tppcunaryminusnode = class(tunaryminusnode) + procedure pass_generate_code override; + end; + + tppcnotnode = class(tnotnode) + procedure pass_generate_code override; + end; + +implementation + +uses + sysutils, + globtype, systems,constexp, + cutils, verbose, globals, + symconst, symdef, + aasmbase, aasmcpu, aasmtai,aasmdata, + defutil, + cgbase, cgutils, cgobj, pass_1, pass_2, + ncon, procinfo, nbas, nld, nadd, + cpubase, cpuinfo, + ncgutil, cgcpu, rgobj; + +{***************************************************************************** + TPPCMODDIVNODE +*****************************************************************************} + +function tppcmoddivnode.pass_1: tnode; +var + statementnode : tstatementnode; + temp_left, temp_right : ttempcreatenode; + left_copy, right_copy : tnode; + block : tblocknode; +begin + result := nil; + (* + // this code replaces all mod nodes by the equivalent div/mul/sub sequence + // on node level, which might be advantageous when doing CSE on that level + // However, optimal modulo code for some cases (in particular a 'x mod 2^n-1' + // operation) can not be expressed using nodes, so this is commented out for now + if (nodetype = modn) then begin + block := internalstatements(statementnode); + + temp_left := ctempcreatenode.create(left.resultdef, left.resultdef.size, tt_persistent, true); + addstatement(statementnode, temp_left); + addstatement(statementnode, cassignmentnode.create(ctemprefnode.create(temp_left), left.getcopy)); + + if (right.nodetype <> ordconstn) then begin + // implementated optimization: use temps to store the right value, otherwise + // it is calculated twice when simply copying it which might result in side + // effects + temp_right := ctempcreatenode.create(right.resultdef, right.resultdef.size, tt_persistent, true); + addstatement(statementnode, temp_right); + addstatement(statementnode, cassignmentnode.create(ctemprefnode.create(temp_right), right.getcopy)); + + addstatement(statementnode, cassignmentnode.create(ctemprefnode.create(temp_left), + caddnode.create(subn, ctemprefnode.create(temp_left), + caddnode.create(muln, cmoddivnode.create(divn, ctemprefnode.create(temp_left), ctemprefnode.create(temp_right)), + ctemprefnode.create(temp_right))))); + + addstatement(statementnode, ctempdeletenode.create(temp_right)); + end else begin + // in case this is a modulo by a constant operation, do not use a temp for the + // right hand side, because otherwise the div optimization will not recognize this + // fact (and there is no constant propagator/recognizer in the compiler), + // resulting in suboptimal code. + addstatement(statementnode, cassignmentnode.create(ctemprefnode.create(temp_left), + caddnode.create(subn, ctemprefnode.create(temp_left), + caddnode.create(muln, cmoddivnode.create(divn, ctemprefnode.create(temp_left), right.getcopy), + right.getcopy)))); + end; + addstatement(statementnode, ctempdeletenode.create_normal_temp(temp_left)); + addstatement(statementnode, ctemprefnode.create(temp_left)); + result := block; + end; + *) + if (not assigned(result)) then + result := inherited pass_1; + if not assigned(result) then + include(current_procinfo.flags, pi_do_call); +end; + +procedure tppcmoddivnode.pass_generate_code; +const { signed overflow } + divops: array[boolean, boolean] of tasmop = + ((A_DIVDU, A_DIVDU_),(A_DIVD, A_DIVDO_)); + divcgops : array[boolean] of TOpCG = (OP_DIV, OP_IDIV); + zerocond: tasmcond = (dirhint: DH_Plus; simple: true; cond:C_NE; cr: RS_CR7); + tcgsize2native : array[OS_8..OS_S128] of tcgsize = ( + OS_64, OS_64, OS_64, OS_64, OS_NO, + OS_S64, OS_S64, OS_S64, OS_S64, OS_NO + ); +var + power : longint; + op : tasmop; + numerator, divider, + resultreg : tregister; + size : TCgSize; + hl : tasmlabel; + done: boolean; + + procedure genOrdConstNodeMod; + var + modreg, maskreg, tempreg : tregister; + isNegPower : boolean; + begin + if (tordconstnode(right).value = 0) then begin + internalerror(2005061702); + end else if (abs(tordconstnode(right).value.svalue) = 1) then begin + { x mod +/-1 is always zero } + cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, 0, resultreg); + end else if (ispowerof2(tordconstnode(right).value, power)) then begin + if (is_signed(right.resultdef)) then begin + tempreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + maskreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + modreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + + cg.a_load_const_reg(current_asmdata.CurrAsmList, OS_INT, abs(tordconstnode(right).value.svalue)-1, modreg); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_SAR, OS_INT, 63, numerator, maskreg); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, numerator, modreg, tempreg); + + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ANDC, maskreg, maskreg, modreg)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBFIC, modreg, tempreg, 0)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBFE, modreg, modreg, modreg)); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, modreg, maskreg, maskreg); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_OR, OS_INT, maskreg, tempreg, resultreg); + end else begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_AND, OS_INT, tordconstnode(right).value-1, numerator, + resultreg); + end; + end else begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, divCgOps[is_signed(right.resultdef)], OS_INT, + tordconstnode(right).value, numerator, resultreg); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, OP_MUL, OS_INT, tordconstnode(right).value.svalue, resultreg, + resultreg); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, OP_SUB, OS_INT, resultreg, numerator, resultreg); + end; + end; + + +begin + secondpass(left); + secondpass(right); + location_copy(location,left.location); + + { put numerator in register } + size:=def_cgsize(left.resultdef); + location_force_reg(current_asmdata.CurrAsmList,left.location, + size,true); + location_copy(location,left.location); + numerator := location.register; + resultreg := location.register; + if (location.loc = LOC_CREGISTER) then begin + location.loc := LOC_REGISTER; + location.register := cg.getintregister(current_asmdata.CurrAsmList,size); + resultreg := location.register; + end else if (nodetype = modn) or (right.nodetype = ordconstn) then begin + { for a modulus op, and for const nodes we need the result register + to be an extra register } + resultreg := cg.getintregister(current_asmdata.CurrAsmList,size); + end; + done := false; + if (cs_opt_level1 in current_settings.optimizerswitches) and (right.nodetype = ordconstn) then begin + if (nodetype = divn) then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, divCgOps[is_signed(right.resultdef)], + size, tordconstnode(right).value, numerator, resultreg) + else + genOrdConstNodeMod; + done := true; + end; + + if (not done) then begin + { load divider in a register if necessary } + location_force_reg(current_asmdata.CurrAsmList,right.location,def_cgsize(right.resultdef),true); + if (right.nodetype <> ordconstn) then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_CMPDI, NR_CR7, + right.location.register, 0)) + else begin + if (tordconstnode(right).value = 0) then + internalerror(2005100301); + end; + divider := right.location.register; + + { select the correct opcode according to the sign of the result, whether we need + overflow checking } + op := divops[is_signed(right.resultdef), cs_check_overflow in current_settings.localswitches]; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op, resultreg, numerator, + divider)); + + if (nodetype = modn) then begin + { multiply with the divisor again, taking care of the correct size } + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_MULLD,resultreg, + divider,resultreg)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUB,location.register, + numerator,resultreg)); + resultreg := location.register; + end; + end; + { set result location } + location.loc:=LOC_REGISTER; + location.register:=resultreg; + if right.nodetype <> ordconstn then begin + current_asmdata.getjumplabel(hl); + current_asmdata.CurrAsmList.concat(taicpu.op_cond_sym(A_BC,zerocond,hl)); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_DIVBYZERO',false); + cg.a_label(current_asmdata.CurrAsmList,hl); + end; + { unsigned division/module can only overflow in case of division by zero + (but checking this overflow flag is more convoluted than performing a + simple comparison with 0) } + if is_signed(right.resultdef) then + cg.g_overflowcheck(current_asmdata.CurrAsmList,location,resultdef); +end; + +{***************************************************************************** + TPPCSHLRSHRNODE +*****************************************************************************} + +procedure tppcshlshrnode.pass_generate_code; + +var + resultreg, hregister1, hregister2 : tregister; + + op: topcg; + asmop1, asmop2: tasmop; + shiftval: aint; + +begin + secondpass(left); + secondpass(right); + + { load left operators in a register } + location_force_reg(current_asmdata.CurrAsmList, left.location, + def_cgsize(left.resultdef), true); + location_copy(location, left.location); + resultreg := location.register; + hregister1 := location.register; + if (location.loc = LOC_CREGISTER) then begin + location.loc := LOC_REGISTER; + resultreg := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + location.register := resultreg; + end; + + { determine operator } + if nodetype = shln then + op := OP_SHL + else + op := OP_SHR; + + { shifting by a constant directly coded: } + if (right.nodetype = ordconstn) then begin + // result types with size < 32 bits have their shift values masked + // differently... :/ + shiftval := tordconstnode(right).value and (tcgsize2size[def_cgsize(resultdef)] * 8 -1); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList, op, def_cgsize(resultdef), + shiftval, hregister1, resultreg) + end else begin + { load shift count in a register if necessary } + location_force_reg(current_asmdata.CurrAsmList, right.location, + def_cgsize(right.resultdef), true); + hregister2 := right.location.register; + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList, op, def_cgsize(resultdef), hregister2, + hregister1, resultreg); + end; +end; + +{***************************************************************************** + TPPCUNARYMINUSNODE +*****************************************************************************} + +procedure tppcunaryminusnode.pass_generate_code; + +var + src1: tregister; + op: tasmop; + +begin + secondpass(left); + begin + if left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF] then + location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,true); + location_copy(location, left.location); + location.loc := LOC_REGISTER; + case left.location.loc of + LOC_FPUREGISTER, LOC_REGISTER: + begin + src1 := left.location.register; + location.register := src1; + end; + LOC_CFPUREGISTER, LOC_CREGISTER: + begin + src1 := left.location.register; + if left.location.loc = LOC_CREGISTER then + location.register := cg.getintregister(current_asmdata.CurrAsmList, OS_INT) + else + location.register := cg.getfpuregister(current_asmdata.CurrAsmList, location.size); + end; + LOC_REFERENCE, LOC_CREFERENCE: + begin + if (left.resultdef.typ = floatdef) then begin + src1 := cg.getfpuregister(current_asmdata.CurrAsmList, + left.location.size); + location.register := src1; + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList, + left.location.size,left.location.size, + left.location.reference, src1); + end else begin + src1 := cg.getintregister(current_asmdata.CurrAsmList, OS_64); + location.register := src1; + cg.a_load_ref_reg(current_asmdata.CurrAsmList, OS_64, OS_64, + left.location.reference, src1); + end; + end; + end; + { choose appropriate operand } + if left.resultdef.typ <> floatdef then begin + if not (cs_check_overflow in current_settings.localswitches) then + op := A_NEG + else + op := A_NEGO_; + location.loc := LOC_REGISTER; + end else begin + op := A_FNEG; + location.loc := LOC_FPUREGISTER; + end; + { emit operation } + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op, location.register, src1)); + end; + cg.g_overflowcheck(current_asmdata.CurrAsmList, location, resultdef); +end; + +{***************************************************************************** + TPPCNOTNODE +*****************************************************************************} + +procedure tppcnotnode.pass_generate_code; + +var + hl: tasmlabel; + +begin + if is_boolean(resultdef) then + begin + { if the location is LOC_JUMP, we do the secondpass after the + labels are allocated + } + if left.expectloc = LOC_JUMP then + begin + hl := current_procinfo.CurrTrueLabel; + current_procinfo.CurrTrueLabel := current_procinfo.CurrFalseLabel; + current_procinfo.CurrFalseLabel := hl; + secondpass(left); + maketojumpbool(current_asmdata.CurrAsmList, left, lr_load_regvars); + hl := current_procinfo.CurrTrueLabel; + current_procinfo.CurrTrueLabel := current_procinfo.CurrFalseLabel; + current_procinfo.CurrFalseLabel := 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, + LOC_SUBSETREG, LOC_CSUBSETREG, + LOC_SUBSETREF, LOC_CSUBSETREF: + begin + location_force_reg(current_asmdata.CurrAsmList, left.location, + def_cgsize(left.resultdef), true); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CMPDI, + left.location.register, 0)); + location_reset(location, LOC_FLAGS, OS_NO); + location.resflags.cr := RS_CR0; + location.resflags.flag := F_EQ; + end; + else + internalerror(2003042401); + end; + end; + end + else + begin + secondpass(left); + location_force_reg(current_asmdata.CurrAsmList, left.location, + def_cgsize(left.resultdef), true); + location_copy(location, left.location); + location.loc := LOC_REGISTER; + location.register := cg.getintregister(current_asmdata.CurrAsmList, OS_INT); + { perform the NOT operation } + cg.a_op_reg_reg(current_asmdata.CurrAsmList, OP_NOT, def_cgsize(resultdef), + left.location.register, + location.register); + end; +end; + +begin + cmoddivnode := tppcmoddivnode; + cshlshrnode := tppcshlshrnode; + cunaryminusnode := tppcunaryminusnode; + cnotnode := tppcnotnode; +end. + diff --git a/closures/compiler/powerpc64/ppcins.dat b/closures/compiler/powerpc64/ppcins.dat new file mode 100644 index 0000000000..708b1f8c0d --- /dev/null +++ b/closures/compiler/powerpc64/ppcins.dat @@ -0,0 +1,75 @@ +;**************************************************************************** +; +; Copyright (c) 2002 by Florian Klaempfl +; +; Instruction template table for the PowerPC +; +; 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. +; +;**************************************************************************** +; +add rD,rA,rB opcode=31,op22=266,oe=0,rc=0 +add_ rD,rA,rB opcode=31,op22=266,oe=0,rc=1 +addo rD,rA,rB opcode=31,op22=266,oe=1,rc=0 +addo_ rD,rA,rB opcode=31,op22=266,oe=1,rc=1 +addc rD,rA,rB opcode=31,op22=10,oe=0,rc=0 +addc_ rD,rA,rB opcode=31,op22=10,oe=0,rc=1 +addco rD,rA,rB opcode=31,op22=10,oe=1,rc=0 +addco_ rD,rA,rB opcode=31,op22=10,oe=1,rc=1 +adde rD,rA,rB opcode=31,op22=138,oe=0,rc=0 +adde_ rD,rA,rB opcode=31,op22=138,oe=0,rc=1 +addeo rD,rA,rB opcode=31,op22=138,oe=1,rc=0 +addeo_ rD,rA,rB opcode=31,op22=138,oe=1,rc=1 +addi rD,rA,SIMM opcode=14 +addic rD,rA,SIMM opcode=12 +addic_ rD,rA,SIMM opcode=13 +addis rD,rA,SIMM opcode=15 +addme rD,rA opcode=31,op22=234,oe=0,rc=0,reserved=$000f0000 +addme_ rD,rA opcode=31,op22=234,oe=0,rc=1,reserved=$000f0000 +addmeo rD,rA opcode=31,op22=234,oe=1,rc=0,reserved=$000f0000 +addmeo_ rD,rA opcode=31,op22=234,oe=1,rc=1,reserved=$000f0000 +addze rD,rA opcode=31,op22=202,oe=0,rc=0,reserved=$000f0000 +addze_ rD,rA opcode=31,op22=202,oe=0,rc=1,reserved=$000f0000 +addzeo rD,rA opcode=31,op22=202,oe=1,rc=0,reserved=$000f0000 +addzeo_ rD,rA opcode=31,op22=202,oe=1,rc=1,reserved=$000f0000 +and rA,rS,rB opcode=31,op21=28,rc=0 +and_ rA,rS,rB opcode=31,op21=28,rc=1 +andc rA,rS,rB opcode=31,op21=60,rc=0 +andc_ rA,rS,rB opcode=31,op21=60,rc=1 +andi_ rA,rS,UIMM opcode=28 +andis_ rA,rS,UIMM opcode=29 +b TA24 opcode=18,aa=0,lk=0 +ba TA24 opcode=18,aa=1,lk=0 +bl TA24 opcode=18,aa=0,lk=1 +bla TA24 opcode=18,aa=1,lk=1 +bc BO,BI,TA14 opcode=16,aa=0,lk=0 +bca BO,BI,TA14 opcode=16,aa=1,lk=0 +bcl BO,BI,TA14 opcode=16,aa=0,lk=1 +bcla BO,BI,TA14 opcode=16,aa=1,lk=1 +bcctr BO,BI opcode=19,op21=528,lk=0,reserved=$000f0000 +bcctrl BO,BI opcode=19,op21=528,lk=1,reserved=$000f0000 +bcltr BO,BI opcode=19,op21=16,lk=0,reserved=$000f0000 +bcltrl BO,BI opcode=19,op21=16,lk=1,reserved=$000f0000 +cmp crfD,L,rA,rB opcode=31,op21=0,reserved=$80000200 +cmpi crfD,L,rA,SIMM opcode=11,reserved=$00000200 +cmpl crfD,L,rA,rB opcode=31,op21=32,reserved=$80000200 +cmpli crfD,L,rA,UIMM opcode=10,reserved=$00000200 + +; + +; Revision 1.1 2002/07/13 21:50:34 florian +; + initial version, a lot of instructions need to be added +; +; diff --git a/closures/compiler/powerpc64/ppcreg.dat b/closures/compiler/powerpc64/ppcreg.dat new file mode 100644 index 0000000000..325143e679 --- /dev/null +++ b/closures/compiler/powerpc64/ppcreg.dat @@ -0,0 +1,143 @@ +; +; +; PowerPC registers +; +; layout +; <name>,<value>,<stdname>,<gasname>,<gasshortname>,<motname>,<stabidx> +; +NO,$00,$00,INVALID,INVALID,INVALID,INVALID,-1,-1 + +R0,$01,$00,r0,r0,0,r0,0,0 +R1,$01,$01,r1,r1,1,r1,1,1 +R2,$01,$02,r2,r2,2,r2,2,2 +R3,$01,$03,r3,r3,3,r3,3,3 +R4,$01,$04,r4,r4,4,r4,4,4 +R5,$01,$05,r5,r5,5,r5,5,5 +R6,$01,$06,r6,r6,6,r6,6,6 +R7,$01,$07,r7,r7,7,r7,7,7 +R8,$01,$08,r8,r8,8,r8,8,8 +R9,$01,$09,r9,r9,9,r9,9,9 +R10,$01,$0a,r10,r10,10,r10,10,10 +R11,$01,$0b,r11,r11,11,r11,11,11 +R12,$01,$0c,r12,r12,12,r12,12,12 +R13,$01,$0d,r13,r13,13,r13,13,13 +R14,$01,$0e,r14,r14,14,r14,14,14 +R15,$01,$0f,r15,r15,15,r15,15,15 +R16,$01,$10,r16,r16,16,r16,16,16 +R17,$01,$11,r17,r17,17,r17,17,17 +R18,$01,$12,r18,r18,18,r18,18,18 +R19,$01,$13,r19,r19,19,r19,19,19 +R20,$01,$14,r20,r20,20,r20,20,20 +R21,$01,$15,r21,r21,21,r21,21,21 +R22,$01,$16,r22,r22,22,r22,22,22 +R23,$01,$17,r23,r23,23,r23,23,23 +R24,$01,$18,r24,r24,24,r24,24,24 +R25,$01,$19,r25,r25,25,r25,25,25 +R26,$01,$1a,r26,r26,26,r26,26,26 +R27,$01,$1b,r27,r27,27,r27,27,27 +R28,$01,$1c,r28,r28,28,r28,28,28 +R29,$01,$1d,r29,r29,29,r29,29,29 +R30,$01,$1e,r30,r30,30,r30,30,30 +R31,$01,$1f,r31,r31,31,r31,31,31 + +F0,$02,$00,F0,f0,0,F0,32,32 +F1,$02,$01,F1,f1,1,F1,33,33 +F2,$02,$02,F2,f2,2,F2,34,34 +F3,$02,$03,F3,f3,3,F3,35,35 +F4,$02,$04,F4,f4,4,F4,36,36 +F5,$02,$05,F5,f5,5,F5,37,37 +F6,$02,$06,F6,f6,6,F6,38,38 +F7,$02,$07,F7,f7,7,F7,39,39 +F8,$02,$08,F8,f8,8,F8,40,40 +F9,$02,$09,F9,f9,9,F9,41,41 +F10,$02,$0a,F10,f10,10,F10,42,42 +F11,$02,$0b,F11,f11,11,F11,43,43 +F12,$02,$0c,F12,f12,12,F12,44,44 +F13,$02,$0d,F13,f13,13,F13,45,45 +F14,$02,$0e,F14,f14,14,F14,46,46 +F15,$02,$0f,F15,f15,15,F15,47,47 +F16,$02,$10,F16,f16,16,F16,48,48 +F17,$02,$11,F17,f17,17,F17,49,49 +F18,$02,$12,F18,f18,18,F18,50,50 +F19,$02,$13,F19,f19,19,F19,51,51 +F20,$02,$14,F20,f20,20,F20,52,52 +F21,$02,$15,F21,f21,21,F21,53,53 +F22,$02,$16,F22,f22,22,F22,54,54 +F23,$02,$17,F23,f23,23,F23,55,55 +F24,$02,$18,F24,f24,24,F24,56,56 +F25,$02,$19,F25,f25,25,F25,57,57 +F26,$02,$1a,F26,f26,26,F26,58,58 +F27,$02,$1b,F27,f27,27,F27,59,59 +F28,$02,$1c,F28,f28,28,F28,60,60 +F29,$02,$1d,F29,f29,29,F29,61,61 +F30,$02,$1e,F30,f30,30,F30,62,62 +F31,$02,$1f,F31,f31,31,F31,63,63 + +M0,$03,$00,M0,v0,0,M0,-1,-1 +M1,$03,$01,M1,v1,1,M1,-1,-1 +M2,$03,$02,M2,v2,2,M2,-1,-1 +M3,$03,$03,M3,v3,3,M3,-1,-1 +M4,$03,$04,M4,v4,4,M4,-1,-1 +M5,$03,$05,M5,v5,5,M5,-1,-1 +M6,$03,$06,M6,v6,6,M6,-1,-1 +M7,$03,$07,M7,v7,7,M7,-1,-1 +M8,$03,$08,M8,v8,8,M8,-1,-1 +M9,$03,$09,M9,v9,9,M9,-1,-1 +M10,$03,$0a,M10,v10,10,M10,-1,-1 +M11,$03,$0b,M11,v11,11,M11,-1,-1 +M12,$03,$0c,M12,v12,12,M12,-1,-1 +M13,$03,$0d,M13,v13,13,M13,-1,-1 +M14,$03,$0e,M14,v14,14,M14,-1,-1 +M15,$03,$0f,M15,v15,15,M15,-1,-1 +M16,$03,$10,M16,v16,16,M16,-1,-1 +M17,$03,$11,M17,v17,17,M17,-1,-1 +M18,$03,$12,M18,v18,18,M18,-1,-1 +M19,$03,$13,M19,v19,19,M19,-1,-1 +M20,$03,$14,M20,v20,20,M20,-1,-1 +M21,$03,$15,M21,v21,21,M21,-1,-1 +M22,$03,$16,M22,v22,22,M22,-1,-1 +M23,$03,$17,M23,v23,23,M23,-1,-1 +M24,$03,$18,M24,v24,24,M24,-1,-1 +M25,$03,$19,M25,v25,25,M25,-1,-1 +M26,$03,$1a,M26,v26,26,M26,-1,-1 +M27,$03,$1b,M27,v27,27,M27,-1,-1 +M28,$03,$1c,M28,v28,28,M28,-1,-1 +M29,$03,$1d,M29,v29,29,M29,-1,-1 +M30,$03,$1e,M30,v30,30,M30,-1,-1 +M31,$03,$1f,M31,v31,31,M31,-1,-1 + +CR,$05,$00,CR,cr,cr,CR,-1,-1 +CR0,$05,$01,CR0,cr0,cr0,CR0,68,68 +CR1,$05,$02,CR1,cr1,cr1,CR1,69,69 +CR2,$05,$03,CR2,cr2,cr2,CR2,70,70 +CR3,$05,$04,CR3,cr3,cr3,CR3,71,71 +CR4,$05,$05,CR4,cr4,cr4,CR4,72,72 +CR5,$05,$06,CR5,cr5,cr5,CR5,73,73 +CR6,$05,$07,CR6,cr6,cr6,CR6,74,74 +CR7,$05,$08,CR7,cr7,cr7,CR7,75,75 +XER,$05,$09,XER,xer,xer,XER,76,76 +LR,$05,$0a,LR,lr,lr,LR,65,65 +CTR,$05,$0b,CTR,ctr,ctr,CTR,66,66 +FPSCR,$05,$0c,FPSCR,fpscr,fpscr,FPSCR,-1,-1 + +; + +; Revision 1.6 2004/06/17 16:55:46 peter +; * powerpc compiles again +; +; Revision 1.5 2003/12/10 22:19:27 florian +; + short gas register names for smartlinking added +; +; Revision 1.4 2003/09/04 21:07:03 florian +; * ARM compiler compiles again +; +; Revision 1.3 2003/09/03 19:35:24 peter +; * powerpc compiles again +; +; Revision 1.2 2003/09/03 15:55:01 peter +; * NEWRA branch merged +; +; Revision 1.1.2.1 2003/09/02 20:48:22 peter +; * powerpc registers +; +; diff --git a/closures/compiler/powerpc64/rappc.pas b/closures/compiler/powerpc64/rappc.pas new file mode 100644 index 0000000000..b52553e9af --- /dev/null +++ b/closures/compiler/powerpc64/rappc.pas @@ -0,0 +1,42 @@ +{ + Copyright (c) 1998-2003 by Carl Eric Codere and Peter Vreman + + Handles the common ppc 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 rappc; + +{$I fpcdefs.inc} + +interface + +uses + aasmbase, aasmtai,aasmdata, aasmcpu, + cpubase, rautils, cclasses; + +type + TPPCOperand = class(TOperand) + end; + + TPPCInstruction = class(TInstruction) + end; + +implementation + +end. + diff --git a/closures/compiler/powerpc64/rappcgas.pas b/closures/compiler/powerpc64/rappcgas.pas new file mode 100644 index 0000000000..cc69533689 --- /dev/null +++ b/closures/compiler/powerpc64/rappcgas.pas @@ -0,0 +1,799 @@ +{ + $Id: rappcgas.pas,v 1.19 2005/02/14 17:13:10 peter Exp $ + Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman + + Does the parsing for the PowerPC 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 rappcgas; + +{$I fpcdefs.inc} + +interface + +uses + raatt, rappc; + +type + tppcattreader = class(tattreader) + function is_asmopcode(const s: string): boolean; override; + procedure handleopcode; override; + procedure BuildReference(oper: tppcoperand); + procedure BuildOperand(oper: tppcoperand); + procedure BuildOpCode(instr: tppcinstruction); + procedure ReadAt(oper: tppcoperand); + procedure ReadSym(oper: tppcoperand); + procedure ConvertCalljmp(instr: tppcinstruction); + end; + +implementation + +uses + { helpers } + cutils, + { global } + globtype, verbose, + systems, + { aasm } + cpubase, aasmbase, aasmtai,aasmdata, aasmcpu, + { symtable } + symconst, symsym, + { parser } + procinfo, + rabase, rautils, + cgbase, cgobj + ; + +procedure tppcattreader.ReadSym(oper: tppcoperand); +var + tempstr, mangledname: string; + typesize, l, k: aint; +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, mangledname, false); + if (mangledname<>'') then + Message(asmr_e_invalid_reference_syntax); + inc(oper.opr.ref.offset, l); + end; +end; + +procedure tppcattreader.ReadAt(oper: tppcoperand); +begin + { check for ...@ } + if actasmtoken = AS_AT then + begin + if (oper.opr.ref.symbol = nil) and + (oper.opr.ref.offset = 0) then + Message(asmr_e_invalid_reference_syntax); + Consume(AS_AT); + if actasmtoken = AS_ID then + begin + if upper(actasmpattern) = 'L' then + oper.opr.ref.refaddr := addr_low + else if upper(actasmpattern) = 'HA' then + oper.opr.ref.refaddr := addr_higha + else if upper(actasmpattern) = 'H' then + oper.opr.ref.refaddr := addr_high + else if upper(actasmpattern) = 'HIGHERA' then + oper.opr.ref.refaddr := addr_highera + else if upper(actasmpattern) = 'HIGHESTA' then + oper.opr.ref.refaddr := addr_highesta + else if upper(actasmpattern) = 'HIGHER' then + oper.opr.ref.refaddr := addr_higher + else if upper(actasmpattern) = 'HIGHEST' then + oper.opr.ref.refaddr := addr_highest + else + Message(asmr_e_invalid_reference_syntax); + + { darwin/ppc64's relocation symbols are 32 bits } + if (target_info.system = system_powerpc64_darwin) and + (not (oper.opr.ref.refaddr in [addr_no, addr_low, addr_higha])) then + Message(asmr_e_invalid_reference_syntax); + + Consume(AS_ID); + end + else + Message(asmr_e_invalid_reference_syntax); + end; +end; + +procedure tppcattreader.BuildReference(oper: tppcoperand); + + procedure Consume_RParen; + begin + if actasmtoken <> AS_RPAREN then + begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(true); + end + else + begin + Consume(AS_RPAREN); + if not (actasmtoken in [AS_COMMA, AS_SEPARATOR, AS_END]) then + begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(true); + end; + end; + end; + +var + l: aint; + relsym: string; + asmsymtyp: tasmsymtype; + +begin + Consume(AS_LPAREN); + case actasmtoken of + AS_INTNUM, + AS_MINUS, + AS_PLUS: + begin + { offset(offset) is invalid } + if oper.opr.Ref.Offset <> 0 then + begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(true); + end + else + begin + oper.opr.Ref.Offset := BuildConstExpression(false, true); + Consume(AS_RPAREN); + if actasmtoken = AS_AT then + ReadAt(oper); + end; + exit; + end; + AS_REGISTER: { (reg ... } + begin + if ((oper.opr.typ = OPR_REFERENCE) and (oper.opr.ref.base <> NR_NO)) or + ((oper.opr.typ = OPR_LOCAL) and (oper.opr.localsym.localloc.loc <> + LOC_REGISTER)) then + message(asmr_e_cannot_index_relative_var); + oper.opr.ref.base := actasmregister; + Consume(AS_REGISTER); + { can either be a register or a right parenthesis } + { (reg) } + if actasmtoken = AS_RPAREN then + begin + Consume_RParen; + exit; + end; + { (reg,reg .. } + Consume(AS_COMMA); + if (actasmtoken = AS_REGISTER) and + (oper.opr.Ref.Offset = 0) then + begin + oper.opr.ref.index := actasmregister; + Consume(AS_REGISTER); + Consume_RParen; + end + else + begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end; + end; {end case } + AS_ID: + begin + ReadSym(oper); + case actasmtoken of + AS_PLUS: + begin + { add a constant expression? } + l:=BuildConstExpression(true,true); + 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; + AS_MINUS: + begin + Consume(AS_MINUS); + BuildConstSymbolExpression(false,true,false,l,relsym,asmsymtyp); + if (relsym<>'') then + begin + if (oper.opr.typ = OPR_REFERENCE) then + oper.opr.ref.relsymbol:=current_asmdata.RefAsmSymbol(relsym) + else + begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end + end + else + begin + case oper.opr.typ of + OPR_CONSTANT : + dec(oper.opr.val,l); + OPR_LOCAL : + dec(oper.opr.localsymofs,l); + OPR_REFERENCE : + dec(oper.opr.ref.offset,l); + else + internalerror(2007092601); + end; + end; + end; + end; + Consume(AS_RPAREN); + if actasmtoken = AS_AT then + ReadAt(oper); + end; + AS_COMMA: { (, ... can either be scaling, or index } + begin + Consume(AS_COMMA); + { Index } + if (actasmtoken = AS_REGISTER) then + begin + oper.opr.ref.index := actasmregister; + Consume(AS_REGISTER); + { check for scaling ... } + Consume_RParen; + end + else + begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end; + end; + else + begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end; + end; +end; + +procedure tppcattreader.BuildOperand(oper: tppcoperand); +var + expr: string; + typesize, l: aint; + + 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 + mangledname : string; + hasdot: boolean; + l, + toffset, + tsize: aint; + 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, mangledname, false); + if (oper.opr.typ<>OPR_CONSTANT) and + (mangledname<>'') then + Message(asmr_e_wrong_sym_type); + 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 + (tabstractvarsym(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: + if (mangledname<>'') then + begin + if (oper.opr.val<>0) then + Message(asmr_e_wrong_sym_type); + oper.opr.typ:=OPR_SYMBOL; + oper.opr.symbol:=current_asmdata.RefAsmSymbol(mangledname); + end + else + inc(oper.opr.val,l); + OPR_REFERENCE: + inc(oper.opr.ref.offset, l); + OPR_SYMBOL: + Message(asmr_e_invalid_symbol_ref); + 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; + hl: tasmlabel; + ofs: aint; +begin + expr := ''; + case actasmtoken of + AS_LPAREN: { Memory reference or constant expression } + begin + oper.InitRef; + BuildReference(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 oper.SetupVar(expr, false) then + ReadAt(oper) + else + 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; + + AS_REGISTER: { Register, a variable reference or a constant reference } + begin + { save the type of register used. } + tempreg := actasmregister; + Consume(AS_REGISTER); + if (actasmtoken in [AS_END, AS_SEPARATOR, AS_COMMA]) then + if is_condreg(tempreg) and + ((actopcode = A_BC) or + (actopcode = A_BCCTR) or + (actopcode = A_BCLR) or + (actopcode = A_TW) or + (actopcode = A_TWI)) then + begin + { it isn't a real operand, everything is stored in the condition } + oper.opr.typ := OPR_NONE; + actcondition.cr := getsupreg(tempreg); + end + else + 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 is_condreg(tempreg) then + begin + if not (actcondition.cond in [C_T..C_DZF]) then + Message(asmr_e_syn_operand); + if actasmtoken = AS_STAR then + begin + consume(AS_STAR); + if (actasmtoken = AS_INTNUM) then + begin + consume(AS_INTNUM); + if actasmtoken = AS_PLUS then + begin + consume(AS_PLUS); + if (actasmtoken = AS_ID) then + begin + oper.opr.typ := OPR_NONE; + if actasmpattern = 'LT' then + actcondition.crbit := (getsupreg(tempreg) - (RS_CR0)) * 4 + else if actasmpattern = 'GT' then + actcondition.crbit := (getsupreg(tempreg) - (RS_CR0)) * 4 + 1 + else if actasmpattern = 'EQ' then + actcondition.crbit := (getsupreg(tempreg) - (RS_CR0)) * 4 + 2 + else if actasmpattern = 'SO' then + actcondition.crbit := (getsupreg(tempreg) - (RS_CR0)) * 4 + 3 + else + Message(asmr_e_syn_operand); + consume(AS_ID); + end + else + Message(asmr_e_syn_operand); + end + else + Message(asmr_e_syn_operand); + end + else + Message(asmr_e_syn_operand); + end + else + Message(asmr_e_syn_operand); + end + else + Message(asmr_e_syn_operand); + end; + AS_END, + AS_SEPARATOR, + AS_COMMA: ; + else + begin + Message(asmr_e_syn_operand); + Consume(actasmtoken); + end; + end; { end case } +end; + +{***************************************************************************** + tppcattreader +*****************************************************************************} + +procedure tppcattreader.BuildOpCode(instr: tppcinstruction); +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; + 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 operandnum > Max_Operands then + Message(asmr_e_too_many_operands) + else + begin + { condition operands doesn't set the operand but write to the + condition field of the instruction + } + if instr.Operands[operandnum].opr.typ <> OPR_NONE then + Inc(operandnum); + end; + Consume(AS_COMMA); + end; + AS_SEPARATOR, + AS_END: { End of asm operands for this opcode } + begin + break; + end; + else + BuildOperand(instr.Operands[operandnum] as tppcoperand); + end; { end case } + until false; + if (operandnum = 1) and (instr.Operands[operandnum].opr.typ = OPR_NONE) then + dec(operandnum); + instr.Ops := operandnum; +end; + +function tppcattreader.is_asmopcode(const s: string): boolean; +var + cond: tasmcondflag; + hs: string; + +begin + { making s a value parameter would break other assembler readers } + hs := s; + is_asmopcode := false; + + { clear op code } + actopcode := A_None; + { clear condition } + fillchar(actcondition, sizeof(actcondition), 0); + + { check for direction hint } + if hs[length(s)] = '-' then + begin + dec(ord(hs[0])); + actcondition.dirhint := DH_Minus; + end + else if hs[length(s)] = '+' then + begin + dec(ord(hs[0])); + actcondition.dirhint := DH_Plus; + end; + actopcode := tasmop(ptruint(iasmops.Find(hs))); + if actopcode <> A_NONE then + begin + if actcondition.dirhint <> DH_None then + message1(asmr_e_unknown_opcode, actasmpattern); + actasmtoken := AS_OPCODE; + is_asmopcode := true; + exit; + end; + { not found, check branch instructions } + if hs[1] = 'B' then + begin + { we can search here without an extra table which is sorted by string length + because we take the whole remaining string without the leading B } + if copy(hs, length(s) - 1, 2) = 'LR' then + begin + actopcode := A_BCLR; + setlength(hs, length(hs) - 2) + end + else if copy(hs, length(s) - 2, 3) = 'CTR' then + begin + actopcode := A_BCCTR; + setlength(hs, length(hs) - 3) + end + else + actopcode := A_BC; + for cond := low(TAsmCondFlag) to high(TAsmCondFlag) do + if copy(hs, 2, length(s) - 1) = UpperAsmCondFlag2Str[cond] then + begin + actcondition.simple := true; + actcondition.cond := cond; + if (cond in [C_LT, C_LE, C_EQ, C_GE, C_GT, C_NL, C_NE, C_NG, C_SO, C_NS, + C_UN, C_NU]) then + actcondition.cr := RS_CR0; + actasmtoken := AS_OPCODE; + is_asmopcode := true; + exit; + end; + end; +end; + +procedure tppcattreader.ConvertCalljmp(instr: tppcinstruction); +begin + if instr.Operands[1].opr.typ = OPR_CONSTANT then begin + if (instr.operands[1].opr.val > 31) or + (instr.operands[2].opr.typ <> OPR_CONSTANT) or + (instr.operands[2].opr.val > 31) or + not(instr.operands[3].opr.typ in [OPR_REFERENCE,OPR_SYMBOL]) then + Message(asmr_e_syn_operand); + { BO/BI notation } + instr.condition.simple := false; + instr.condition.bo := instr.operands[1].opr.val; + instr.condition.bi := instr.operands[2].opr.val; + instr.operands[1].free; + instr.operands[2].free; + instr.operands[2] := nil; + instr.operands[1] := instr.operands[3]; + instr.operands[3] := nil; + instr.ops := 1; + end; + if instr.Operands[1].opr.typ = OPR_REFERENCE then begin + instr.Operands[1].opr.ref.refaddr:=addr_full; + if (instr.Operands[1].opr.ref.base<>NR_NO) or + (instr.Operands[1].opr.ref.index<>NR_NO) then + Message(asmr_e_syn_operand); + end; +end; + +procedure tppcattreader.handleopcode; +var + instr: tppcinstruction; +begin + instr := TPPCInstruction.Create(TPPCOperand); + BuildOpcode(instr); + instr.condition := actcondition; + if is_calljmp(instr.opcode) then + ConvertCalljmp(instr); + { + instr.AddReferenceSizes; + instr.SetInstructionOpsize; + instr.CheckOperandSizes; + } + instr.ConcatInstruction(curlist); + instr.Free; +end; + +{***************************************************************************** + Initialize +*****************************************************************************} + +const + asmmode_ppc_att_info: tasmmodeinfo = + ( + id: asmmode_ppc_gas; + idtxt: 'GAS'; + casmreader: tppcattreader; + ); + + asmmode_ppc_standard_info: tasmmodeinfo = + ( + id: asmmode_standard; + idtxt: 'STANDARD'; + casmreader: tppcattreader; + ); + +initialization + RegisterAsmMode(asmmode_ppc_att_info); + RegisterAsmMode(asmmode_ppc_standard_info); +end. + diff --git a/closures/compiler/powerpc64/rppccon.inc b/closures/compiler/powerpc64/rppccon.inc new file mode 100644 index 0000000000..4ff6799228 --- /dev/null +++ b/closures/compiler/powerpc64/rppccon.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.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_R16 = tregister($01000010); +NR_R17 = tregister($01000011); +NR_R18 = tregister($01000012); +NR_R19 = tregister($01000013); +NR_R20 = tregister($01000014); +NR_R21 = tregister($01000015); +NR_R22 = tregister($01000016); +NR_R23 = tregister($01000017); +NR_R24 = tregister($01000018); +NR_R25 = tregister($01000019); +NR_R26 = tregister($0100001a); +NR_R27 = tregister($0100001b); +NR_R28 = tregister($0100001c); +NR_R29 = tregister($0100001d); +NR_R30 = tregister($0100001e); +NR_R31 = tregister($0100001f); +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_F8 = tregister($02000008); +NR_F9 = tregister($02000009); +NR_F10 = tregister($0200000a); +NR_F11 = tregister($0200000b); +NR_F12 = tregister($0200000c); +NR_F13 = tregister($0200000d); +NR_F14 = tregister($0200000e); +NR_F15 = tregister($0200000f); +NR_F16 = tregister($02000010); +NR_F17 = tregister($02000011); +NR_F18 = tregister($02000012); +NR_F19 = tregister($02000013); +NR_F20 = tregister($02000014); +NR_F21 = tregister($02000015); +NR_F22 = tregister($02000016); +NR_F23 = tregister($02000017); +NR_F24 = tregister($02000018); +NR_F25 = tregister($02000019); +NR_F26 = tregister($0200001a); +NR_F27 = tregister($0200001b); +NR_F28 = tregister($0200001c); +NR_F29 = tregister($0200001d); +NR_F30 = tregister($0200001e); +NR_F31 = tregister($0200001f); +NR_M0 = tregister($03000000); +NR_M1 = tregister($03000001); +NR_M2 = tregister($03000002); +NR_M3 = tregister($03000003); +NR_M4 = tregister($03000004); +NR_M5 = tregister($03000005); +NR_M6 = tregister($03000006); +NR_M7 = tregister($03000007); +NR_M8 = tregister($03000008); +NR_M9 = tregister($03000009); +NR_M10 = tregister($0300000a); +NR_M11 = tregister($0300000b); +NR_M12 = tregister($0300000c); +NR_M13 = tregister($0300000d); +NR_M14 = tregister($0300000e); +NR_M15 = tregister($0300000f); +NR_M16 = tregister($03000010); +NR_M17 = tregister($03000011); +NR_M18 = tregister($03000012); +NR_M19 = tregister($03000013); +NR_M20 = tregister($03000014); +NR_M21 = tregister($03000015); +NR_M22 = tregister($03000016); +NR_M23 = tregister($03000017); +NR_M24 = tregister($03000018); +NR_M25 = tregister($03000019); +NR_M26 = tregister($0300001a); +NR_M27 = tregister($0300001b); +NR_M28 = tregister($0300001c); +NR_M29 = tregister($0300001d); +NR_M30 = tregister($0300001e); +NR_M31 = tregister($0300001f); +NR_CR = tregister($05000000); +NR_CR0 = tregister($05000001); +NR_CR1 = tregister($05000002); +NR_CR2 = tregister($05000003); +NR_CR3 = tregister($05000004); +NR_CR4 = tregister($05000005); +NR_CR5 = tregister($05000006); +NR_CR6 = tregister($05000007); +NR_CR7 = tregister($05000008); +NR_XER = tregister($05000009); +NR_LR = tregister($0500000a); +NR_CTR = tregister($0500000b); +NR_FPSCR = tregister($0500000c); diff --git a/closures/compiler/powerpc64/rppcdwrf.inc b/closures/compiler/powerpc64/rppcdwrf.inc new file mode 100644 index 0000000000..2c9c9942a8 --- /dev/null +++ b/closures/compiler/powerpc64/rppcdwrf.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.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, +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, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +68, +69, +70, +71, +72, +73, +74, +75, +76, +65, +66, +-1 diff --git a/closures/compiler/powerpc64/rppcgas.inc b/closures/compiler/powerpc64/rppcgas.inc new file mode 100644 index 0000000000..3c68549ce1 --- /dev/null +++ b/closures/compiler/powerpc64/rppcgas.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.dat } +'INVALID', +'r0', +'r1', +'r2', +'r3', +'r4', +'r5', +'r6', +'r7', +'r8', +'r9', +'r10', +'r11', +'r12', +'r13', +'r14', +'r15', +'r16', +'r17', +'r18', +'r19', +'r20', +'r21', +'r22', +'r23', +'r24', +'r25', +'r26', +'r27', +'r28', +'r29', +'r30', +'r31', +'f0', +'f1', +'f2', +'f3', +'f4', +'f5', +'f6', +'f7', +'f8', +'f9', +'f10', +'f11', +'f12', +'f13', +'f14', +'f15', +'f16', +'f17', +'f18', +'f19', +'f20', +'f21', +'f22', +'f23', +'f24', +'f25', +'f26', +'f27', +'f28', +'f29', +'f30', +'f31', +'v0', +'v1', +'v2', +'v3', +'v4', +'v5', +'v6', +'v7', +'v8', +'v9', +'v10', +'v11', +'v12', +'v13', +'v14', +'v15', +'v16', +'v17', +'v18', +'v19', +'v20', +'v21', +'v22', +'v23', +'v24', +'v25', +'v26', +'v27', +'v28', +'v29', +'v30', +'v31', +'cr', +'cr0', +'cr1', +'cr2', +'cr3', +'cr4', +'cr5', +'cr6', +'cr7', +'xer', +'lr', +'ctr', +'fpscr' diff --git a/closures/compiler/powerpc64/rppcgri.inc b/closures/compiler/powerpc64/rppcgri.inc new file mode 100644 index 0000000000..b26f900caa --- /dev/null +++ b/closures/compiler/powerpc64/rppcgri.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.dat } +0, +97, +98, +99, +100, +101, +102, +103, +104, +105, +108, +33, +34, +43, +44, +45, +46, +47, +48, +49, +50, +51, +52, +35, +53, +54, +55, +56, +57, +58, +59, +60, +61, +62, +36, +63, +64, +37, +38, +39, +40, +41, +42, +109, +107, +1, +2, +11, +12, +13, +14, +15, +16, +17, +18, +19, +20, +3, +21, +22, +23, +24, +25, +26, +27, +28, +29, +30, +4, +31, +32, +5, +6, +7, +8, +9, +10, +65, +66, +75, +76, +77, +78, +79, +80, +81, +82, +83, +84, +67, +85, +86, +87, +88, +89, +90, +91, +92, +93, +94, +68, +95, +96, +69, +70, +71, +72, +73, +74, +106 diff --git a/closures/compiler/powerpc64/rppcgss.inc b/closures/compiler/powerpc64/rppcgss.inc new file mode 100644 index 0000000000..5d5aa809d8 --- /dev/null +++ b/closures/compiler/powerpc64/rppcgss.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.dat } +'INVALID', +'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', +'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', +'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', +'cr', +'cr0', +'cr1', +'cr2', +'cr3', +'cr4', +'cr5', +'cr6', +'cr7', +'xer', +'lr', +'ctr', +'fpscr' diff --git a/closures/compiler/powerpc64/rppcmot.inc b/closures/compiler/powerpc64/rppcmot.inc new file mode 100644 index 0000000000..4fc340afd7 --- /dev/null +++ b/closures/compiler/powerpc64/rppcmot.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.dat } +'INVALID', +'r0', +'r1', +'r2', +'r3', +'r4', +'r5', +'r6', +'r7', +'r8', +'r9', +'r10', +'r11', +'r12', +'r13', +'r14', +'r15', +'r16', +'r17', +'r18', +'r19', +'r20', +'r21', +'r22', +'r23', +'r24', +'r25', +'r26', +'r27', +'r28', +'r29', +'r30', +'r31', +'F0', +'F1', +'F2', +'F3', +'F4', +'F5', +'F6', +'F7', +'F8', +'F9', +'F10', +'F11', +'F12', +'F13', +'F14', +'F15', +'F16', +'F17', +'F18', +'F19', +'F20', +'F21', +'F22', +'F23', +'F24', +'F25', +'F26', +'F27', +'F28', +'F29', +'F30', +'F31', +'M0', +'M1', +'M2', +'M3', +'M4', +'M5', +'M6', +'M7', +'M8', +'M9', +'M10', +'M11', +'M12', +'M13', +'M14', +'M15', +'M16', +'M17', +'M18', +'M19', +'M20', +'M21', +'M22', +'M23', +'M24', +'M25', +'M26', +'M27', +'M28', +'M29', +'M30', +'M31', +'CR', +'CR0', +'CR1', +'CR2', +'CR3', +'CR4', +'CR5', +'CR6', +'CR7', +'XER', +'LR', +'CTR', +'FPSCR' diff --git a/closures/compiler/powerpc64/rppcmri.inc b/closures/compiler/powerpc64/rppcmri.inc new file mode 100644 index 0000000000..9a59178c7d --- /dev/null +++ b/closures/compiler/powerpc64/rppcmri.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.dat } +97, +98, +99, +100, +101, +102, +103, +104, +105, +108, +33, +34, +43, +44, +45, +46, +47, +48, +49, +50, +51, +52, +35, +53, +54, +55, +56, +57, +58, +59, +60, +61, +62, +36, +63, +64, +37, +38, +39, +40, +41, +42, +109, +0, +107, +65, +66, +75, +76, +77, +78, +79, +80, +81, +82, +83, +84, +67, +85, +86, +87, +88, +89, +90, +91, +92, +93, +94, +68, +95, +96, +69, +70, +71, +72, +73, +74, +106, +1, +2, +11, +12, +13, +14, +15, +16, +17, +18, +19, +20, +3, +21, +22, +23, +24, +25, +26, +27, +28, +29, +30, +4, +31, +32, +5, +6, +7, +8, +9, +10 diff --git a/closures/compiler/powerpc64/rppcnor.inc b/closures/compiler/powerpc64/rppcnor.inc new file mode 100644 index 0000000000..387be62acb --- /dev/null +++ b/closures/compiler/powerpc64/rppcnor.inc @@ -0,0 +1,2 @@ +{ don't edit, this file is generated from ppcreg.dat } +110 diff --git a/closures/compiler/powerpc64/rppcnum.inc b/closures/compiler/powerpc64/rppcnum.inc new file mode 100644 index 0000000000..d612e34d8a --- /dev/null +++ b/closures/compiler/powerpc64/rppcnum.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.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($01000010), +tregister($01000011), +tregister($01000012), +tregister($01000013), +tregister($01000014), +tregister($01000015), +tregister($01000016), +tregister($01000017), +tregister($01000018), +tregister($01000019), +tregister($0100001a), +tregister($0100001b), +tregister($0100001c), +tregister($0100001d), +tregister($0100001e), +tregister($0100001f), +tregister($02000000), +tregister($02000001), +tregister($02000002), +tregister($02000003), +tregister($02000004), +tregister($02000005), +tregister($02000006), +tregister($02000007), +tregister($02000008), +tregister($02000009), +tregister($0200000a), +tregister($0200000b), +tregister($0200000c), +tregister($0200000d), +tregister($0200000e), +tregister($0200000f), +tregister($02000010), +tregister($02000011), +tregister($02000012), +tregister($02000013), +tregister($02000014), +tregister($02000015), +tregister($02000016), +tregister($02000017), +tregister($02000018), +tregister($02000019), +tregister($0200001a), +tregister($0200001b), +tregister($0200001c), +tregister($0200001d), +tregister($0200001e), +tregister($0200001f), +tregister($03000000), +tregister($03000001), +tregister($03000002), +tregister($03000003), +tregister($03000004), +tregister($03000005), +tregister($03000006), +tregister($03000007), +tregister($03000008), +tregister($03000009), +tregister($0300000a), +tregister($0300000b), +tregister($0300000c), +tregister($0300000d), +tregister($0300000e), +tregister($0300000f), +tregister($03000010), +tregister($03000011), +tregister($03000012), +tregister($03000013), +tregister($03000014), +tregister($03000015), +tregister($03000016), +tregister($03000017), +tregister($03000018), +tregister($03000019), +tregister($0300001a), +tregister($0300001b), +tregister($0300001c), +tregister($0300001d), +tregister($0300001e), +tregister($0300001f), +tregister($05000000), +tregister($05000001), +tregister($05000002), +tregister($05000003), +tregister($05000004), +tregister($05000005), +tregister($05000006), +tregister($05000007), +tregister($05000008), +tregister($05000009), +tregister($0500000a), +tregister($0500000b), +tregister($0500000c) diff --git a/closures/compiler/powerpc64/rppcrni.inc b/closures/compiler/powerpc64/rppcrni.inc new file mode 100644 index 0000000000..1a49189c1d --- /dev/null +++ b/closures/compiler/powerpc64/rppcrni.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.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, +73, +74, +75, +76, +77, +78, +79, +80, +81, +82, +83, +84, +85, +86, +87, +88, +89, +90, +91, +92, +93, +94, +95, +96, +97, +98, +99, +100, +101, +102, +103, +104, +105, +106, +107, +108, +109 diff --git a/closures/compiler/powerpc64/rppcsri.inc b/closures/compiler/powerpc64/rppcsri.inc new file mode 100644 index 0000000000..9a59178c7d --- /dev/null +++ b/closures/compiler/powerpc64/rppcsri.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.dat } +97, +98, +99, +100, +101, +102, +103, +104, +105, +108, +33, +34, +43, +44, +45, +46, +47, +48, +49, +50, +51, +52, +35, +53, +54, +55, +56, +57, +58, +59, +60, +61, +62, +36, +63, +64, +37, +38, +39, +40, +41, +42, +109, +0, +107, +65, +66, +75, +76, +77, +78, +79, +80, +81, +82, +83, +84, +67, +85, +86, +87, +88, +89, +90, +91, +92, +93, +94, +68, +95, +96, +69, +70, +71, +72, +73, +74, +106, +1, +2, +11, +12, +13, +14, +15, +16, +17, +18, +19, +20, +3, +21, +22, +23, +24, +25, +26, +27, +28, +29, +30, +4, +31, +32, +5, +6, +7, +8, +9, +10 diff --git a/closures/compiler/powerpc64/rppcstab.inc b/closures/compiler/powerpc64/rppcstab.inc new file mode 100644 index 0000000000..2c9c9942a8 --- /dev/null +++ b/closures/compiler/powerpc64/rppcstab.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.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, +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, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +68, +69, +70, +71, +72, +73, +74, +75, +76, +65, +66, +-1 diff --git a/closures/compiler/powerpc64/rppcstd.inc b/closures/compiler/powerpc64/rppcstd.inc new file mode 100644 index 0000000000..4fc340afd7 --- /dev/null +++ b/closures/compiler/powerpc64/rppcstd.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.dat } +'INVALID', +'r0', +'r1', +'r2', +'r3', +'r4', +'r5', +'r6', +'r7', +'r8', +'r9', +'r10', +'r11', +'r12', +'r13', +'r14', +'r15', +'r16', +'r17', +'r18', +'r19', +'r20', +'r21', +'r22', +'r23', +'r24', +'r25', +'r26', +'r27', +'r28', +'r29', +'r30', +'r31', +'F0', +'F1', +'F2', +'F3', +'F4', +'F5', +'F6', +'F7', +'F8', +'F9', +'F10', +'F11', +'F12', +'F13', +'F14', +'F15', +'F16', +'F17', +'F18', +'F19', +'F20', +'F21', +'F22', +'F23', +'F24', +'F25', +'F26', +'F27', +'F28', +'F29', +'F30', +'F31', +'M0', +'M1', +'M2', +'M3', +'M4', +'M5', +'M6', +'M7', +'M8', +'M9', +'M10', +'M11', +'M12', +'M13', +'M14', +'M15', +'M16', +'M17', +'M18', +'M19', +'M20', +'M21', +'M22', +'M23', +'M24', +'M25', +'M26', +'M27', +'M28', +'M29', +'M30', +'M31', +'CR', +'CR0', +'CR1', +'CR2', +'CR3', +'CR4', +'CR5', +'CR6', +'CR7', +'XER', +'LR', +'CTR', +'FPSCR' diff --git a/closures/compiler/powerpc64/rppcsup.inc b/closures/compiler/powerpc64/rppcsup.inc new file mode 100644 index 0000000000..4e6f879355 --- /dev/null +++ b/closures/compiler/powerpc64/rppcsup.inc @@ -0,0 +1,111 @@ +{ don't edit, this file is generated from ppcreg.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_R16 = $10; +RS_R17 = $11; +RS_R18 = $12; +RS_R19 = $13; +RS_R20 = $14; +RS_R21 = $15; +RS_R22 = $16; +RS_R23 = $17; +RS_R24 = $18; +RS_R25 = $19; +RS_R26 = $1a; +RS_R27 = $1b; +RS_R28 = $1c; +RS_R29 = $1d; +RS_R30 = $1e; +RS_R31 = $1f; +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_F8 = $08; +RS_F9 = $09; +RS_F10 = $0a; +RS_F11 = $0b; +RS_F12 = $0c; +RS_F13 = $0d; +RS_F14 = $0e; +RS_F15 = $0f; +RS_F16 = $10; +RS_F17 = $11; +RS_F18 = $12; +RS_F19 = $13; +RS_F20 = $14; +RS_F21 = $15; +RS_F22 = $16; +RS_F23 = $17; +RS_F24 = $18; +RS_F25 = $19; +RS_F26 = $1a; +RS_F27 = $1b; +RS_F28 = $1c; +RS_F29 = $1d; +RS_F30 = $1e; +RS_F31 = $1f; +RS_M0 = $00; +RS_M1 = $01; +RS_M2 = $02; +RS_M3 = $03; +RS_M4 = $04; +RS_M5 = $05; +RS_M6 = $06; +RS_M7 = $07; +RS_M8 = $08; +RS_M9 = $09; +RS_M10 = $0a; +RS_M11 = $0b; +RS_M12 = $0c; +RS_M13 = $0d; +RS_M14 = $0e; +RS_M15 = $0f; +RS_M16 = $10; +RS_M17 = $11; +RS_M18 = $12; +RS_M19 = $13; +RS_M20 = $14; +RS_M21 = $15; +RS_M22 = $16; +RS_M23 = $17; +RS_M24 = $18; +RS_M25 = $19; +RS_M26 = $1a; +RS_M27 = $1b; +RS_M28 = $1c; +RS_M29 = $1d; +RS_M30 = $1e; +RS_M31 = $1f; +RS_CR = $00; +RS_CR0 = $01; +RS_CR1 = $02; +RS_CR2 = $03; +RS_CR3 = $04; +RS_CR4 = $05; +RS_CR5 = $06; +RS_CR6 = $07; +RS_CR7 = $08; +RS_XER = $09; +RS_LR = $0a; +RS_CTR = $0b; +RS_FPSCR = $0c; diff --git a/closures/compiler/pp.lpi b/closures/compiler/pp.lpi new file mode 100644 index 0000000000..8485cb2a9b --- /dev/null +++ b/closures/compiler/pp.lpi @@ -0,0 +1,86 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <Version Value="9"/> + <PathDelim Value="\"/> + <General> + <Flags> + <MainUnitHasUsesSectionForAllUnits Value="False"/> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + <LRSInOutputDirectory Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="pp"/> + </General> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <CommandLineParams Value="-MObjFPC -Scgi -O1 -gl -vewnhi -l -FiD:\programming\laz_svn\fpc_features\cpstr\lib\i386-win32\ -FuD:\programming\laz_svn\cpstr\cpstrnew\ -Fu. -FUD:\programming\laz_svn\fpc_features\cpstr\lib\i386-win32\ -oproject1.exe D:\programming\laz_svn\fpc_features\cpstr\project1.lpr"/> + <LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <Units Count="2"> + <Unit0> + <Filename Value="pp.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="pp"/> + </Unit0> + <Unit1> + <Filename Value="x86\aasmcpu.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="aasmcpu"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="10"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="i386\pp"/> + </Target> + <SearchPaths> + <IncludeFiles Value="i386"/> + <OtherUnitFiles Value="i386;x86;systems"/> + <UnitOutputDirectory Value="i386\lazbuild"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <CStyleOperator Value="False"/> + <AllowLabel Value="False"/> + <CPPInline Value="False"/> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> + <Linking> + <Debugging> + <GenerateDebugInfo Value="True"/> + <DebugInfoType Value="dsStabs"/> + </Debugging> + </Linking> + <Other> + <Verbosity> + <ShowWarn Value="False"/> + <ShowNotes Value="False"/> + <ShowHints Value="False"/> + </Verbosity> + <ConfigFile> + <StopAfterErrCount Value="50"/> + </ConfigFile> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> + <CustomOptions Value="-di386"/> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/closures/compiler/pp.pas b/closures/compiler/pp.pas new file mode 100644 index 0000000000..e3f613f726 --- /dev/null +++ b/closures/compiler/pp.pas @@ -0,0 +1,229 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Commandline compiler for Free Pascal + + 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. + + **************************************************************************** +} +program pp; + +{ + possible compiler switches: + ----------------------------------------------------------------- + CMEM use cmem unit for better memory debugging + 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 + POWERPC64 generate a compiler for the PowerPC64 architecture + 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 + FPC_ARMEL create an arm eabi compiler + FPC_ARMEB create an arm big endian compiler + FPC_OARM create an arm oabi compiler, only needed when the host + compiler is ARMEL or ARMEB + ----------------------------------------------------------------- + cpuflags The target processor has status flags (on by default) + cpufpemu The target compiler will also support emitting software + floating point operations + cpu64bitaddr Generate code for a 64-bit address space + cpu64bitalu The target cpu has 64-bit registers and a 64 bit alu + (required for cpu64bitaddr; optional with 32 bit addr space) + ----------------------------------------------------------------- +} + +{$i fpcdefs.inc} + +{ Require at least 2.0.2 } +{$ifdef VER2_0} + {$if FPC_PATCH<2} + {$fatal At least FPC 2.0.2 is required to compile the compiler} + {$endif} +{$endif VER2_0} + +{ exactly one target CPU must be defined } +{$ifdef I386} + {$ifdef CPUDEFINED} + {$fatal ONLY one of the switches for the CPU type must be defined} + {$endif CPUDEFINED} + {$define CPUDEFINED} +{$endif I386} +{$ifdef x86_64} + {$ifdef CPUDEFINED} + {$fatal ONLY one of the switches for the CPU type must be defined} + {$endif CPUDEFINED} + {$define CPUDEFINED} +{$endif x86_64} +{$ifdef M68K} + {$ifdef CPUDEFINED} + {$fatal ONLY one of the switches for the CPU type must be defined} + {$endif CPUDEFINED} + {$define CPUDEFINED} +{$endif M68K} +{$ifdef vis} + {$ifdef CPUDEFINED} + {$fatal ONLY one of the switches for the CPU type must be defined} + {$endif CPUDEFINED} + {$define CPUDEFINED} +{$endif} +{$ifdef iA64} + {$ifdef CPUDEFINED} + {$fatal ONLY one of the switches for the CPU type must be defined} + {$endif CPUDEFINED} + {$define CPUDEFINED} +{$endif iA64} +{$ifdef POWERPC} + {$ifdef CPUDEFINED} + {$fatal ONLY one of the switches for the CPU type must be defined} + {$endif CPUDEFINED} + {$define CPUDEFINED} +{$endif POWERPC} +{$ifdef POWERPC64} + {$ifdef CPUDEFINED} + {$fatal ONLY one of the switches for the CPU type must be defined} + {$endif CPUDEFINED} + {$define CPUDEFINED} +{$endif POWERPC64} +{$ifdef ALPHA} + {$ifdef CPUDEFINED} + {$fatal ONLY one of the switches for the CPU type must be defined} + {$endif CPUDEFINED} + {$define CPUDEFINED} +{$endif ALPHA} +{$ifdef SPARC} + {$ifdef CPUDEFINED} + {$fatal ONLY one of the switches for the CPU type must be defined} + {$endif CPUDEFINED} + {$define CPUDEFINED} +{$endif SPARC} +{$ifdef ARM} + {$ifdef CPUDEFINED} + {$fatal ONLY one of the switches for the CPU type must be defined} + {$endif CPUDEFINED} + {$define CPUDEFINED} +{$endif ARM} +{$ifdef MIPS} + {$ifdef CPUDEFINED} + {$fatal ONLY one of the switches for the CPU type must be defined} + {$endif CPUDEFINED} + {$define CPUDEFINED} +{$endif MIPS} +{$ifdef AVR} + {$ifdef CPUDEFINED} + {$fatal ONLY one of the switches for the CPU type must be defined} + {$endif CPUDEFINED} + {$define CPUDEFINED} +{$endif AVR} +{$ifndef CPUDEFINED} + {$fatal A CPU type switch must be defined} +{$endif CPUDEFINED} +{$ifdef support_mmx} + {$ifndef i386} + {$fatal I386 switch must be on for MMX support} + {$endif i386} +{$endif support_mmx} + + +{ Don't care about minstacksize or maxstacksize not beeing supported by current OS } +{$WARN 2077 OFF} +{$WARN 2078 OFF} + +{$ifdef win32} + { 256 MB stack } + { under windows the stack can't grow } + {$MAXSTACKSIZE 256000000} +{$else win32} + {$ifdef win64} + { 512 MB stack } + { under windows the stack can't grow } + {$MAXSTACKSIZE 512000000} + {$else win64} + { 1 MB stack } + {$MINSTACKSIZE 1000000} + {$endif win64} +{$endif win32} + +uses +{$ifdef cmem} + cmem, +{$endif cmem} +{$ifdef profile} + profile, +{$endif profile} +{$ifndef NOCATCH} + {$if defined(Unix) or defined(Go32v2) or defined(Watcom)} + catch, + {$endif} +{$endif NOCATCH} + globals,compiler; + +var + oldexit : pointer; +procedure myexit; +begin + exitproc:=oldexit; +{$ifdef nocatch} + exit; +{$endif nocatch} +{ Show Runtime error if there was an error } + if (erroraddr<>nil) then + begin + case exitcode of + 100: + begin + erroraddr:=nil; + writeln('Error while reading file'); + end; + 101: + begin + erroraddr:=nil; + writeln('Error while writing file'); + end; + 202: + begin + erroraddr:=nil; + writeln('Error: Stack Overflow'); + end; + 203: + begin + erroraddr:=nil; + writeln('Error: Out of memory'); + end; + end; + { we cannot use current_filepos.file because all memory might have been + freed already ! + But we can use global parser_current_file var } + Writeln('Compilation aborted ',parser_current_file,':',current_filepos.line); + end; +end; + +begin + oldexit:=exitproc; + exitproc:=@myexit; +{$ifdef extheaptrc} + keepreleased:=true; +{$endif extheaptrc} +{ Call the compiler with empty command, so it will take the parameters } + Halt(compiler.Compile('')); +end. diff --git a/closures/compiler/ppc.cfg b/closures/compiler/ppc.cfg new file mode 100644 index 0000000000..ff4473a418 --- /dev/null +++ b/closures/compiler/ppc.cfg @@ -0,0 +1,40 @@ +-$A8 +-$B- +-$C- +-$D+ +-$E- +-$F- +-$G+ +-$H- +-$I+ +-$J+ +-$K- +-$L+ +-$M- +-$N+ +-$O- +-$P+ +-$Q+ +-$R+ +-$S- +-$T- +-$U- +-$V- +-$W+ +-$X+ +-$YD +-$Z1 +-cc +-AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-LE"e:\program files\borland\delphi6\Projects\Bpl" +-LN"e:\program files\borland\delphi6\Projects\Bpl" +-U"i386;x86;systems" +-O"i386;x86;systems" +-I"i386;x86;systems" +-R"i386;x86;systems" +-Ddelphi i386 gdb support_mmx cpu86 noopt diff --git a/closures/compiler/ppc.conf b/closures/compiler/ppc.conf new file mode 100644 index 0000000000..7d716c1679 --- /dev/null +++ b/closures/compiler/ppc.conf @@ -0,0 +1,39 @@ +-$A8 +-$B- +-$C+ +-$D+ +-$E- +-$F- +-$G+ +-$H+ +-$I+ +-$J- +-$K- +-$L+ +-$M- +-$N+ +-$O+ +-$P+ +-$Q- +-$R- +-$S- +-$T- +-$U- +-$V+ +-$W- +-$X+ +-$YD +-$Z1 +-cg +-H+ +-W+ +-M +-$M16384,1048576 +-K$00400000 +-E"." +-N"." +-U"i386:targets" +-O"i386:targets" +-I"i386:targets" +-R"i386:targets" +-DDELPHI;i386 diff --git a/closures/compiler/ppc.dof b/closures/compiler/ppc.dof new file mode 100644 index 0000000000..3c3966031f --- /dev/null +++ b/closures/compiler/ppc.dof @@ -0,0 +1,95 @@ +[FileVersion] +Version=6.0 +[Compiler] +A=8 +B=0 +C=0 +D=1 +E=0 +F=0 +G=1 +H=0 +I=1 +J=1 +K=0 +L=1 +M=0 +N=1 +O=0 +P=1 +Q=1 +R=1 +S=0 +T=0 +U=0 +V=0 +W=1 +X=1 +Y=1 +Z=1 +ShowHints=1 +ShowWarnings=1 +UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[Linker] +MapFile=0 +OutputObjs=0 +ConsoleApp=0 +DebugInfo=0 +RemoteSymbols=0 +MinStackSize=16384 +MaxStackSize=1048576 +ImageBase=4194304 +ExeDescription= +[Directories] +OutputDir= +UnitOutputDir= +PackageDLLOutputDir= +PackageDCPOutputDir= +SearchPath=i386;x86;systems +Packages=VCL50;VCLX50;VCLSMP50;VCLDB50;VCLADO50;ibevnt50;VCLBDE50;VCLDBX50;QRPT50;TEEUI50;TEEDB50;TEE50;DSS50;TEEQR50;VCLIB50;VCLMID50;VCLIE50;INETDB50;INET50;NMFAST50;WEBMID50;dclocx50;dclaxserver50 +Conditionals=delphi i386 gdb support_mmx cpu86 noopt +DebugSourceDirs= +UsePackages=0 +[Parameters] +RunParams= +HostApplication= +Launcher= +UseLauncher=0 +DebugCWD= +[Version Info] +IncludeVerInfo=0 +AutoIncBuild=0 +MajorVer=1 +MinorVer=0 +Release=0 +Build=0 +Debug=0 +PreRelease=0 +Special=0 +Private=0 +DLL=0 +Locale=1043 +CodePage=1252 +[Version Info Keys] +CompanyName= +FileDescription= +FileVersion=1.0.0.0 +InternalName= +LegalCopyright= +LegalTrademarks= +OriginalFilename= +ProductName= +ProductVersion=1.0.0.0 +Comments= +[HistoryLists\hlConditionals] +Count=2 +Item0=delphi i386 gdb support_mmx cpu86 noopt +Item1=delphi i386 gdb support_mmx cpu86 +[HistoryLists\hlUnitAliases] +Count=1 +Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; +[HistoryLists\hlSearchPath] +Count=3 +Item0=i386;x86;systems +Item1=i386;x86 +Item2=i386 x86 diff --git a/closures/compiler/ppc68k.lpi b/closures/compiler/ppc68k.lpi new file mode 100644 index 0000000000..999a94a0cc --- /dev/null +++ b/closures/compiler/ppc68k.lpi @@ -0,0 +1,79 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <PathDelim Value="\"/> + <Version Value="7"/> + <General> + <Flags> + <MainUnitHasUsesSectionForAllUnits Value="False"/> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + <LRSInOutputDirectory Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <TargetFileExt Value=".exe"/> + <Title Value="pp"/> + </General> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <Units Count="2"> + <Unit0> + <Filename Value="pp.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="pp"/> + </Unit0> + <Unit1> + <Filename Value="m68k\aasmcpu.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="aasmcpu"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="8"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="m68k\pp"/> + </Target> + <SearchPaths> + <IncludeFiles Value="m68k\"/> + <OtherUnitFiles Value="m68k\;systems\"/> + <UnitOutputDirectory Value="m68k\lazbuild"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <CStyleOperator Value="False"/> + <AllowLabel Value="False"/> + <CPPInline Value="False"/> + </SyntaxOptions> + </Parsing> + <Linking> + <Debugging> + <GenerateDebugInfo Value="True"/> + </Debugging> + </Linking> + <Other> + <Verbosity> + <ShowWarn Value="False"/> + <ShowNotes Value="False"/> + <ShowHints Value="False"/> + </Verbosity> + <ConfigFile> + <StopAfterErrCount Value="50"/> + </ConfigFile> + <CustomOptions Value="-dm68k +"/> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/closures/compiler/ppcarm.lpi b/closures/compiler/ppcarm.lpi new file mode 100644 index 0000000000..aa78c5fafb --- /dev/null +++ b/closures/compiler/ppcarm.lpi @@ -0,0 +1,93 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <Version Value="9"/> + <PathDelim Value="\"/> + <General> + <Flags> + <MainUnitHasUsesSectionForAllUnits Value="False"/> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + <LRSInOutputDirectory Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="ppcarm"/> + </General> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <Units Count="4"> + <Unit0> + <Filename Value="pp.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="pp"/> + </Unit0> + <Unit1> + <Filename Value="arm\aasmcpu.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="aasmcpu"/> + </Unit1> + <Unit2> + <Filename Value="arm\aoptcpu.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="aoptcpu"/> + </Unit2> + <Unit3> + <Filename Value="aopt.pas"/> + <IsPartOfProject Value="True"/> + </Unit3> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="10"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="arm\pp"/> + </Target> + <SearchPaths> + <IncludeFiles Value="arm"/> + <OtherUnitFiles Value="arm;systems"/> + <UnitOutputDirectory Value="arm\lazbuild"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <CStyleOperator Value="False"/> + <AllowLabel Value="False"/> + <CPPInline Value="False"/> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> + <Linking> + <Debugging> + <GenerateDebugInfo Value="True"/> + </Debugging> + </Linking> + <Other> + <Verbosity> + <ShowWarn Value="False"/> + <ShowNotes Value="False"/> + <ShowHints Value="False"/> + </Verbosity> + <ConfigFile> + <StopAfterErrCount Value="50"/> + </ConfigFile> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> + <CustomOptions Value="-darm"/> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/closures/compiler/ppcavr.lpi b/closures/compiler/ppcavr.lpi new file mode 100644 index 0000000000..cc0cda1e1d --- /dev/null +++ b/closures/compiler/ppcavr.lpi @@ -0,0 +1,84 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <Version Value="9"/> + <PathDelim Value="\"/> + <General> + <Flags> + <MainUnitHasUsesSectionForAllUnits Value="False"/> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + <LRSInOutputDirectory Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="ppavr"/> + </General> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <Units Count="2"> + <Unit0> + <Filename Value="pp.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="pp"/> + </Unit0> + <Unit1> + <Filename Value="avr\aasmcpu.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="aasmcpu"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="10"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="avr\pp"/> + </Target> + <SearchPaths> + <IncludeFiles Value="avr"/> + <OtherUnitFiles Value="avr;systems"/> + <UnitOutputDirectory Value="avr\lazbuild"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <CStyleOperator Value="False"/> + <AllowLabel Value="False"/> + <CPPInline Value="False"/> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> + <Linking> + <Debugging> + <GenerateDebugInfo Value="True"/> + </Debugging> + </Linking> + <Other> + <Verbosity> + <ShowWarn Value="False"/> + <ShowNotes Value="False"/> + <ShowHints Value="False"/> + </Verbosity> + <ConfigFile> + <StopAfterErrCount Value="50"/> + </ConfigFile> + <CompilerMessages> + <UseMsgFile Value="True"/> + </CompilerMessages> + <CustomOptions Value="-davr"/> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/closures/compiler/ppcgen/aasmcpu.pas b/closures/compiler/ppcgen/aasmcpu.pas new file mode 100644 index 0000000000..5cf5b62355 --- /dev/null +++ b/closures/compiler/ppcgen/aasmcpu.pas @@ -0,0 +1,602 @@ +{ + Copyright (c) 1999-2002 by Jonas Maebe and Thomas Schatzl + + Contains the assembler object for the PowerPC 32 and PowerPC 64 + + 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 + globtype,verbose, + aasmbase,aasmtai,aasmdata,aasmsym, + cpubase,cgbase,cgutils; + + const + { "mov reg,reg" source operand number } + O_MOV_SOURCE = 1; + { "mov reg,reg" source operand number } + O_MOV_DEST = 0; + + + type + taicpu = class(tai_cpu_abstract_sym) + constructor op_none(op : tasmop); + + constructor op_reg(op : tasmop;_op1 : tregister); + constructor op_const(op : tasmop;_op1 : aint); + + 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_const_reg(op:tasmop; _op1: aint; _op2: tregister); + + constructor op_const_const(op : tasmop;_op1,_op2 : aint); + + constructor op_reg_reg_const_const(op: tasmop; _op1, _op2: tregister; _op3, _op4: aint); + + 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: aint); + constructor op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister; const _op3: treference); + constructor op_const_reg_reg(op : tasmop;_op1 : aint;_op2, _op3 : tregister); + constructor op_const_reg_const(op : tasmop;_op1 : aint;_op2 : tregister;_op3 : aint); + constructor op_const_const_const(op : tasmop;_op1 : aint;_op2 : aint;_op3 : aint); + + constructor op_reg_reg_reg_reg(op : tasmop;_op1,_op2,_op3,_op4 : tregister); + constructor op_reg_bool_reg_reg(op : tasmop;_op1: tregister;_op2:boolean;_op3,_op4:tregister); + constructor op_reg_bool_reg_const(op : tasmop;_op1: tregister;_op2:boolean;_op3:tregister;_op4: aint); + + constructor op_reg_reg_reg_const(op : tasmop; _op1, _op2, _op3 : tregister; _op4 : aint); + constructor op_reg_reg_reg_const_const(op : tasmop;_op1,_op2,_op3 : tregister;_op4,_op5 : aint); + constructor op_reg_reg_const_const_const(op : tasmop;_op1,_op2 : tregister;_op3,_op4,_op5 : aint); + + + { this is for Jmp instructions } + constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol); + constructor op_const_const_sym(op : tasmop;_op1,_op2 : aint;_op3: tasmsymbol); + + + constructor op_sym(op : tasmop;_op1 : tasmsymbol); + constructor op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:aint); + constructor op_reg_sym_ofs(op : tasmop;_op1 : tregister;_op2:tasmsymbol;_op2ofs : aint); + constructor op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:aint;const _op2 : treference); + + procedure loadbool(opidx:aint;_b:boolean); + + function is_same_reg_move(regtype: Tregistertype):boolean; override; + + { register spilling code } + function spilling_get_operation_type(opnr: longint): topertype;override; + function spilling_get_operation_type_ref(opnr: longint; reg: tregister): topertype;override; + end; + + tai_align = class(tai_align_abstract) + { nothing to add } + end; + + procedure InitAsm; + procedure DoneAsm; + + + function spilling_create_load(const ref:treference;r:tregister):Taicpu; + function spilling_create_store(r:tregister; const ref:treference):Taicpu; + + procedure fixup_jmps(list: TAsmList); + +implementation + +uses cutils, cclasses; + +{***************************************************************************** + taicpu Constructors +*****************************************************************************} + + procedure taicpu.loadbool(opidx:aint;_b:boolean); + begin + if opidx>=ops then + ops:=opidx+1; + with oper[opidx]^ do + begin + if typ=top_ref then + dispose(ref); + b:=_b; + typ:=top_bool; + end; + end; + + + 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 : aint); + begin + inherited create(op); + ops:=1; + loadconst(0,_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,_op2); + end; + + constructor taicpu.op_const_reg(op:tasmop; _op1: aint; _op2: tregister); + begin + inherited create(op); + ops:=2; + loadconst(0,_op1); + loadreg(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_const_const(op : tasmop;_op1,_op2 : aint); + begin + inherited create(op); + ops:=2; + loadconst(0,_op1); + loadconst(1,_op2); + end; + + + constructor taicpu.op_reg_reg_const_const(op: tasmop; _op1, _op2: tregister; _op3, _op4: aint); + begin + inherited create(op); + ops := 4; + loadreg(0, _op1); + loadreg(1, _op2); + loadconst(2, _op3); + loadconst(3, _op4); + 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_const(op : tasmop;_op1,_op2 : tregister; _op3: aint); + begin + inherited create(op); + ops:=3; + loadreg(0,_op1); + loadreg(1,_op2); + loadconst(2,_op3); + end; + + constructor taicpu.op_reg_reg_sym_ofs(op : tasmop;_op1,_op2 : tregister; _op3: tasmsymbol;_op3ofs: aint); + 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_const_reg_reg(op : tasmop;_op1 : aint;_op2, _op3 : tregister); + begin + inherited create(op); + ops:=3; + loadconst(0,_op1); + loadreg(1,_op2); + loadreg(2,_op3); + end; + + constructor taicpu.op_const_reg_const(op : tasmop;_op1 : aint;_op2 : tregister;_op3 : aint); + begin + inherited create(op); + ops:=3; + loadconst(0,_op1); + loadreg(1,_op2); + loadconst(2,_op3); + end; + + + constructor taicpu.op_const_const_const(op : tasmop;_op1 : aint;_op2 : aint;_op3 : aint); + begin + inherited create(op); + ops:=3; + loadconst(0,_op1); + loadconst(1,_op2); + loadconst(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_bool_reg_reg(op : tasmop;_op1: tregister;_op2:boolean;_op3,_op4:tregister); + begin + inherited create(op); + ops:=4; + loadreg(0,_op1); + loadbool(1,_op2); + loadreg(2,_op3); + loadreg(3,_op4); + end; + + constructor taicpu.op_reg_bool_reg_const(op : tasmop;_op1: tregister;_op2:boolean;_op3:tregister;_op4: aint); + begin + inherited create(op); + ops:=4; + loadreg(0,_op1); + loadbool(0,_op2); + loadreg(0,_op3); + loadconst(0,cardinal(_op4)); + end; + + constructor taicpu.op_reg_reg_reg_const(op : tasmop; _op1, _op2, _op3 : tregister; _op4 : aint); + begin + inherited create(op); + ops := 4; + loadreg(0, _op1); + loadreg(1, _op2); + loadreg(2, _op3); + loadconst(3, cardinal(_op4)); + end; + + constructor taicpu.op_reg_reg_reg_const_const(op : tasmop;_op1,_op2,_op3 : tregister;_op4,_op5 : aint); + begin + inherited create(op); + ops:=5; + loadreg(0,_op1); + loadreg(1,_op2); + loadreg(2,_op3); + loadconst(3,cardinal(_op4)); + loadconst(4,cardinal(_op5)); + end; + + constructor taicpu.op_reg_reg_const_const_const(op : tasmop;_op1,_op2 : tregister;_op3,_op4,_op5 : aint); + begin + inherited create(op); + ops:=5; + loadreg(0,_op1); + loadreg(1,_op2); + loadconst(2,_op3); + loadconst(3,_op4); + loadconst(4,_op5); + 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_const_const_sym(op : tasmop;_op1,_op2 : aint; _op3: tasmsymbol); + begin + inherited create(op); + ops:=3; + loadconst(0,_op1); + loadconst(1,_op2); + loadsymbol(2,_op3,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:aint); + begin + inherited create(op); + ops:=1; + loadsymbol(0,_op1,_op1ofs); + end; + + + constructor taicpu.op_reg_sym_ofs(op : tasmop;_op1 : tregister;_op2:tasmsymbol;_op2ofs : aint); + 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:aint;const _op2 : treference); + begin + inherited create(op); + ops:=2; + loadsymbol(0,_op1,_op1ofs); + loadref(1,_op2); + end; + + +{ ****************************** newra stuff *************************** } + + function taicpu.is_same_reg_move(regtype: Tregistertype):boolean; + begin + result := + (((opcode=A_MR) and + (regtype = R_INTREGISTER)) or + ((opcode = A_FMR) and + (regtype = R_FPUREGISTER))) and + { these opcodes can only have registers as operands } + (oper[0]^.reg=oper[1]^.reg); + end; + + + function taicpu.spilling_get_operation_type(opnr: longint): topertype; + begin + result := operand_read; + case opcode of + A_STMW,A_LMW: + internalerror(2005021805); + A_STBU, A_STBUX, A_STHU, A_STHUX, + A_STWU, A_STWUX, + A_STFSU, A_STFSUX, A_STFDU, A_STFDUX, + A_STB, A_STBX, A_STH, A_STHX, + A_STW, A_STWX, + A_STFS, A_STFSX, A_STFD, A_STFDX, A_STFIWX, A_STHBRX, A_STWBRX, A_STWCX_, + A_CMP, A_CMPI, A_CMPL, A_CMPLI, + A_DCBA, A_DCBI, A_DCBST, A_DCBT, A_DCBTST, A_DCBZ, A_DCBF, A_ICBI, + A_ECOWX, A_FCMPO, A_FCMPU, A_MTMSR, A_TLBIE, A_TW, A_TWI, + A_CMPWI, A_CMPW, A_CMPLWI, A_CMPLW, A_MT, A_MTLR, A_MTCTR +{$ifdef cpu64bitalu} + , A_STDU, A_STDUX, + A_STD, A_STDX, + A_STDCX_, + A_CMPD, A_CMPDI, A_CMPLD, A_CMPLDI, + A_MFXER +{$endif cpu64bitalu} + : ; + A_RLWIMI, A_RLWIMI_ +{$ifdef cpu64bitalu} + , A_INSRDI, A_INSRDI_, A_RLDIMI +{$endif not cpu64bitalu} + : + if opnr = 0 then + result := operand_readwrite; + else + if opnr = 0 then + result := operand_write; + end; + end; + + + function taicpu.spilling_get_operation_type_ref(opnr: longint; reg: tregister): topertype; + begin + result := operand_read; + case opcode of + A_STBU, A_STBUX, A_STHU, A_STHUX, A_STWU, A_STWUX, +{$ifdef cpu64bitalu} + A_STDU, A_STDUX, +{$endif cpu64bitalu} + A_STFSU, A_STFSUX, A_STFDU, A_STFDUX: + if (oper[opnr]^.ref^.base = reg) then + result := operand_readwrite; + end; + end; + + + function spilling_create_load(const ref:treference;r:tregister):Taicpu; + begin + case getregtype(r) of + R_INTREGISTER: +{$ifdef cpu64bitalu} + result:=taicpu.op_reg_ref(A_LD,r,ref); +{$else cpu64bitalu} + result:=taicpu.op_reg_ref(A_LWZ,r,ref); +{$endif cpu64bitalu} + R_FPUREGISTER: + result:=taicpu.op_reg_ref(A_LFD,r,ref); + else + internalerror(2005123101); + end; + end; + + + function spilling_create_store(r:tregister; const ref:treference):Taicpu; + begin + case getregtype(r) of + R_INTREGISTER: +{$ifdef cpu64bitalu} + result:=taicpu.op_reg_ref(A_STD,r,ref); +{$else cpu64bitalu} + result:=taicpu.op_reg_ref(A_STW,r,ref); +{$endif cpu64bitalu} + R_FPUREGISTER: + result:=taicpu.op_reg_ref(A_STFD,r,ref); + else + internalerror(2005123102); + end; + end; + + + procedure InitAsm; + begin + end; + + + procedure DoneAsm; + begin + end; + + + procedure fixup_jmps(list: TAsmList); + var + p: tai; + newjmp: taicpu; + labelpositions: TFPList; + instrpos: ptrint; + l: tasmlabel; + inserted_something: boolean; + begin + // if certainly not enough instructions to cause an overflow, don't bother + if (list.count <= (high(smallint) div 4)) then + exit; + labelpositions := TFPList.create; + p := tai(list.first); + instrpos := 1; + // record label positions + while assigned(p) do + begin + if p.typ = ait_label then + begin + if (tai_label(p).labsym.labelnr >= labelpositions.count) then + labelpositions.count := tai_label(p).labsym.labelnr * 2; + labelpositions[tai_label(p).labsym.labelnr] := pointer(instrpos); + end; + { ait_const is for jump tables } + case p.typ of + ait_instruction: + inc(instrpos); + ait_const: + begin + if (tai_const(p).consttype<>aitconst_32bit) then + internalerror(2008052101); + inc(instrpos); + end; + end; + p := tai(p.next); + end; + + // check and fix distances + repeat + inserted_something := false; + p := tai(list.first); + instrpos := 1; + while assigned(p) do + begin + case p.typ of + ait_label: + // update labelposition in case it changed due to insertion + // of jumps + begin + // can happen because of newly inserted labels + if (tai_label(p).labsym.labelnr > labelpositions.count) then + labelpositions.count := tai_label(p).labsym.labelnr * 2; + labelpositions[tai_label(p).labsym.labelnr] := pointer(instrpos); + end; + ait_instruction: + begin + inc(instrpos); + case taicpu(p).opcode of + A_BC: + if (taicpu(p).oper[0]^.typ = top_ref) and + assigned(taicpu(p).oper[0]^.ref^.symbol) and + (taicpu(p).oper[0]^.ref^.symbol is tasmlabel) and + (labelpositions[tasmlabel(taicpu(p).oper[0]^.ref^.symbol).labelnr] <> NIL) and +{$push} +{$q-} + (ptruint(abs(ptrint(labelpositions[tasmlabel(taicpu(p).oper[0]^.ref^.symbol).labelnr]-instrpos)) - (low(smallint) div 4)) > ptruint((high(smallint) - low(smallint)) div 4)) then +{$pop} + begin + // add a new label after this jump + current_asmdata.getjumplabel(l); + { new label -> may have to increase array size } + if (l.labelnr >= labelpositions.count) then + labelpositions.count := l.labelnr + 10; + { newjmp will be inserted before the label, and it's inserted after } + { the current jump -> instrpos+2 } + labelpositions[l.labelnr] := pointer(instrpos+2); + list.insertafter(tai_label.create(l),p); + // add a new unconditional jump between this jump and the label + newjmp := taicpu.op_sym(A_B,taicpu(p).oper[0]^.ref^.symbol); + newjmp.is_jmp := true; + newjmp.fileinfo := taicpu(p).fileinfo; + list.insertafter(newjmp,p); + inc(instrpos); + // change the conditional jump to point to the newly inserted label + tasmlabel(taicpu(p).oper[0]^.ref^.symbol).decrefs; + taicpu(p).oper[0]^.ref^.symbol := l; + l.increfs; + // and invert its condition code + taicpu(p).condition := inverse_cond(taicpu(p).condition); + // we inserted an instruction, so will have to check everything again + inserted_something := true; + end; + end; + end; + ait_const: + inc(instrpos); + end; + p := tai(p.next); + end; + until not inserted_something; + labelpositions.free; + end; + + +begin + cai_align:=tai_align; + cai_cpu:=taicpu; +end. + diff --git a/closures/compiler/ppcgen/agppcgas.pas b/closures/compiler/ppcgen/agppcgas.pas new file mode 100644 index 0000000000..079d84edfc --- /dev/null +++ b/closures/compiler/ppcgen/agppcgas.pas @@ -0,0 +1,456 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit the GAS asm writers for PowerPC/PowerPC64 + + 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. + + **************************************************************************** +} + +{****************************************************************************} +{ Helper routines for Instruction Writer } +{****************************************************************************} + +unit agppcgas; + +{$i fpcdefs.inc} + + interface + + uses + aasmbase, + aasmtai,aasmdata, + aggas, + cpubase,cgutils, + globtype; + + type + TPPCInstrWriter=class(TCPUInstrWriter) + procedure WriteInstruction(hp : tai);override; + end; + + TPPCGNUAssembler=class(TGNUassembler) + constructor create(smart: boolean); override; + procedure WriteExtraHeader; override; + end; + + TPPCAppleGNUAssembler=class(TAppleGNUassembler) + constructor create(smart: boolean); override; + function MakeCmdLine: TCmdStr; override; + end; + + topstr = string[4]; + + function getreferencestring(var ref : treference) : string; + function getopstr_jmp(const o:toper) : string; + function getopstr(const o:toper) : string; + function branchmode(o: tasmop): topstr; + function cond2str(op: tasmop; c: tasmcond): string; + + implementation + + uses + cutils,globals,verbose, + cgbase,systems, + assemble, + itcpugas,cpuinfo, + aasmcpu; + +{$ifdef cpu64bitaddr} + const + refaddr2str: array[trefaddr] of string[9] = ('', '', '', '', '@l', '@h', '@higher', '@highest', '@ha', '@highera', '@highesta'); + verbose_refaddrs = [addr_low, addr_high, addr_higher, addr_highest, addr_higha, addr_highera, addr_highesta]; + refaddr2str_darwin: array[trefaddr] of string[4] = ('','','','','lo16', 'hi16', '@err', '@err', 'ha16', '@err', '@err'); +{$else cpu64bitaddr} + const + refaddr2str: array[trefaddr] of string[3] = ('','','','','@l','@h','@ha'); + refaddr2str_darwin: array[trefaddr] of string[4] = ('','','','','lo16','hi16','ha16'); + verbose_refaddrs = [addr_low,addr_high,addr_higha]; +{$endif cpu64bitaddr} + + + function getreferencestring(var ref : treference) : string; + var + s : string; + begin + with ref do + begin + if ((offset < -32768) or (offset > 32767)) and + (refaddr = addr_no) then + internalerror(2006052501); + if (refaddr = addr_no) then + s := '' + else + begin + if target_info.system in [system_powerpc_darwin,system_powerpc64_darwin] then + s := refaddr2str_darwin[refaddr] + else + s :=''; + s := s+'('; + if assigned(symbol) then + begin + s:=s+symbol.name; + if assigned(relsymbol) then + s:=s+'-'+relsymbol.name; + end; + end; + if offset<0 then + s:=s+tostr(offset) + else + if (offset>0) then + begin + if assigned(symbol) then + s:=s+'+'+tostr(offset) + else + s:=s+tostr(offset); + end; + + if (refaddr in verbose_refaddrs) then + begin + s := s+')'; + if not(target_info.system in [system_powerpc_darwin,system_powerpc64_darwin]) then + s := s+refaddr2str[refaddr]; + end; +{$ifdef cpu64bitaddr} + if (refaddr = addr_pic) then + if (target_info.system <> system_powerpc64_linux) then + s := s + ')' + else + s := s + ')@got'; +{$endif cpu64bitaddr} + + if (index=NR_NO) then + begin + if offset=0 then + begin + if not (assigned(symbol)) then + s:=s+'0'; + end; + if (base<>NR_NO) then + s:=s+'('+gas_regname(base)+')' + else if not assigned(symbol) and + not(refaddr in verbose_refaddrs) then + s:=s+'(0)'; + end + else if (index<>NR_NO) and (base<>NR_NO) then + begin + if (offset=0) then + s:=s+gas_regname(base)+','+gas_regname(index) + else + internalerror(2006052502); + end; + end; + getreferencestring:=s; + end; + + + function getopstr_jmp(const o:toper) : string; + var + hs : string; + begin + case o.typ of + top_reg : + getopstr_jmp:=gas_regname(o.reg); + { no top_ref jumping for powerpc } + top_const : + getopstr_jmp:=tostr(o.val); + top_ref : + begin + if o.ref^.refaddr<>addr_full then + internalerror(200402262); + 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_jmp:=hs; + end; + top_none: + getopstr_jmp:=''; + else + internalerror(2002070603); + end; + end; + + + function getopstr(const o:toper) : string; + var + hs : string; + begin + case o.typ of + top_reg: + getopstr:=gas_regname(o.reg); + top_const: + getopstr:=tostr(longint(o.val)); + 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; + + + function branchmode(o: tasmop): topstr; + var tempstr: topstr; + begin + tempstr := ''; + case o of + A_BCCTR,A_BCCTRL: tempstr := 'ctr'; + A_BCLR,A_BCLRL: tempstr := 'lr'; + end; + case o of + A_BL,A_BLA,A_BCL,A_BCLA,A_BCCTRL,A_BCLRL: tempstr := tempstr+'l'; + end; + case o of + A_BA,A_BLA,A_BCA,A_BCLA: tempstr:=tempstr+'a'; + end; + branchmode := tempstr; + end; + + + function cond2str(op: tasmop; c: tasmcond): string; + { note: no checking is performed whether the given combination of } + { conditions is valid } + var + tempstr: string; + begin + tempstr:=#9; + case c.simple of + false: + begin + cond2str := tempstr+gas_op2str[op]; + case c.dirhint of + DH_None:; + DH_Minus: + cond2str:=cond2str+'-'; + DH_Plus: + cond2str:=cond2str+'+'; + else + internalerror(2003112901); + end; + cond2str:=cond2str+#9+tostr(c.bo)+','+tostr(c.bi); + end; + true: + if (op >= A_B) and (op <= A_BCLRL) then + case c.cond of + { unconditional branch } + C_NONE: + cond2str := tempstr+gas_op2str[op]; + { bdnzt etc } + else + begin + tempstr := tempstr+'b'+asmcondflag2str[c.cond]+ + branchmode(op); + case c.dirhint of + DH_None: + tempstr:=tempstr+#9; + DH_Minus: + tempstr:=tempstr+('-'+#9); + DH_Plus: + tempstr:=tempstr+('+'+#9); + else + internalerror(2003112901); + end; + case c.cond of + C_LT..C_NU: + cond2str := tempstr+gas_regname(newreg(R_SPECIALREGISTER,c.cr,R_SUBWHOLE)); + C_T,C_F,C_DNZT,C_DNZF,C_DZT,C_DZF: + cond2str := tempstr+tostr(c.crbit); + else + cond2str := tempstr; + end; + end; + end + { we have a trap instruction } + else + begin + internalerror(2002070601); + { not yet implemented !!!!!!!!!!!!!!!!!!!!! } + { case tempstr := 'tw';} + end; + end; + end; + + +{****************************************************************************} +{ PowerPC Instruction Writer } +{****************************************************************************} + + Procedure TPPCInstrWriter.WriteInstruction(hp : tai); + var op: TAsmOp; + s: string; + i: byte; + sep: string[3]; + begin + op:=taicpu(hp).opcode; + if is_calljmp(op) then + begin + { direct BO/BI in op[0] and op[1] not supported, put them in condition! } + case op of + A_B,A_BA,A_BL,A_BLA: + s:=#9+gas_op2str[op]+#9; + A_BCTR,A_BCTRL,A_BLR,A_BLRL: + s:=#9+gas_op2str[op] + else + begin + s:=cond2str(op,taicpu(hp).condition); + if (s[length(s)] <> #9) and + (taicpu(hp).ops>0) then + s := s + ','; + end; + end; + + if (taicpu(hp).ops>0) and (taicpu(hp).oper[0]^.typ<>top_none) then + begin + { first write the current contents of s, because the symbol } + { may be 255 characters } + owner.asmwrite(s); + s:=getopstr_jmp(taicpu(hp).oper[0]^); + end; + end + else + { process operands } + begin + s:=#9+gas_op2str[op]; + if taicpu(hp).ops<>0 then + begin + { + if not is_calljmp(op) then + sep:=',' + else + } + sep:=#9; + for i:=0 to taicpu(hp).ops-1 do + begin + // debug code + // writeln(s); + // writeln(taicpu(hp).fileinfo.line); + s:=s+sep+getopstr(taicpu(hp).oper[i]^); + sep:=','; + end; + end; + end; + owner.AsmWriteLn(s); + end; + + +{****************************************************************************} +{ GNU PPC Assembler writer } +{****************************************************************************} + + constructor TPPCGNUAssembler.create(smart: boolean); + begin + inherited create(smart); + InstrWriter := TPPCInstrWriter.create(self); + end; + + + procedure TPPCGNUAssembler.WriteExtraHeader; + var + i : longint; + begin + for i:=0 to 31 do + AsmWriteln(#9'.set'#9'r'+tostr(i)+','+tostr(i)); + for i:=0 to 31 do + AsmWriteln(#9'.set'#9'f'+tostr(i)+','+tostr(i)); + end; + + +{****************************************************************************} +{ GNU/Apple PPC Assembler writer } +{****************************************************************************} + + constructor TPPCAppleGNUAssembler.create(smart: boolean); + begin + inherited create(smart); + InstrWriter := TPPCInstrWriter.create(self); + end; + + + function TPPCAppleGNUAssembler.MakeCmdLine: TCmdStr; + begin + result := inherited MakeCmdLine; +{$ifdef cpu64bitaddr} + Replace(result,'$ARCH','ppc64') +{$else cpu64bitaddr} + case current_settings.cputype of + cpu_PPC7400: + Replace(result,'$ARCH','ppc7400'); + cpu_PPC970: + Replace(result,'$ARCH','ppc970'); + else + Replace(result,'$ARCH','ppc') + end; +{$endif cpu64bitaddr} + end; + + + + + +{***************************************************************************** + Initialize +*****************************************************************************} + + const + as_ppc_gas_info : tasminfo = + ( + id : as_gas; + + idtxt : 'AS'; + asmbin : 'as'; +{$ifdef cpu64bitaddr} + asmcmd : '-a64 -o $OBJ $ASM'; +{$else cpu64bitaddr} + asmcmd: '-o $OBJ $ASM'; +{$endif cpu64bitaddr} + supported_targets : [system_powerpc_linux,system_powerpc_netbsd,system_powerpc_openbsd,system_powerpc_MorphOS,system_powerpc_Amiga,system_powerpc64_linux,system_powerpc_embedded,system_powerpc64_embedded]; + flags : [af_allowdirect,af_needar,af_smartlink_sections]; + labelprefix : '.L'; + comment : '# '; + ); + + + as_ppc_gas_darwin_powerpc_info : tasminfo = + ( + id : as_darwin; + + idtxt : 'AS-Darwin'; + asmbin : 'as'; + asmcmd : '-o $OBJ $ASM -arch $ARCH'; + supported_targets : [system_powerpc_darwin,system_powerpc64_darwin]; + flags : [af_allowdirect,af_needar,af_smartlink_sections,af_supports_dwarf,af_stabs_use_function_absolute_addresses]; + labelprefix : 'L'; + comment : '# '; + ); + + +begin + RegisterAssembler(as_ppc_gas_info,TPPCGNUAssembler); + RegisterAssembler(as_ppc_gas_darwin_powerpc_info,TPPCAppleGNUAssembler); +end. diff --git a/closures/compiler/ppcgen/cgppc.pas b/closures/compiler/ppcgen/cgppc.pas new file mode 100644 index 0000000000..4836b4d06c --- /dev/null +++ b/closures/compiler/ppcgen/cgppc.pas @@ -0,0 +1,962 @@ +{ + Copyright (c) 2006 by Florian Klaempfl + + This unit implements the common part of the code generator for the PowerPC + + 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 cgppc; + +{$i fpcdefs.inc} + interface + + uses + globtype,symtype,symdef, + cgbase,cgobj, + aasmbase,aasmcpu,aasmtai,aasmdata, + cpubase,cpuinfo,cgutils,rgcpu, + parabase; + + type + tcgppcgen = class(tcg) + procedure a_load_const_cgpara(list: TAsmList; size: tcgsize; a: tcgint; const paraloc : tcgpara); override; + procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara); override; + + procedure a_call_reg(list : TAsmList;reg: tregister); override; + + { stores the contents of register reg to the memory location described by + ref } + procedure a_load_reg_ref(list: TAsmList; fromsize, tosize: TCGSize; + reg: tregister; const ref: treference); override; + + procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override; + + { fpu move instructions } + procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override; + procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override; + procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override; + + { overflow checking } + procedure g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef);override; + + { entry code } + procedure g_profilecode(list: TAsmList); override; + + procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel); + + procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override; + + procedure g_maybe_got_init(list: TAsmList); override; + { Transform unsupported methods into Internal errors } + procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override; + procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override; + protected + function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol; + procedure a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); override; + { Make sure ref is a valid reference for the PowerPC and sets the } + { base to the value of the index if (base = R_NO). } + { Returns true if the reference contained a base, index and an } + { offset or symbol, in which case the base will have been changed } + { to a tempreg (which has to be freed by the caller) containing } + { the sum of part of the original reference } + function fixref(list: TAsmList; var ref: treference): boolean; + { contains the common code of a_load_reg_ref and a_load_ref_reg } + procedure a_load_store(list:TAsmList;op: tasmop;reg:tregister;ref: treference);virtual; + + { creates the correct branch instruction for a given combination } + { of asmcondflags and destination addressing mode } + procedure a_jmp(list: TAsmList; op: tasmop; + c: tasmcondflag; crval: longint; l: tasmlabel); + + { returns true if the offset of the given reference can not be } + { represented by a 16 bit immediate as required by some PowerPC } + { instructions } + function hasLargeOffset(const ref : TReference) : Boolean; inline; + + function save_lr_in_prologue: boolean; + + function load_got_symbol(list : TAsmList; symbol : string) : tregister; + end; + + const + TOpCmp2AsmCond: Array[topcmp] of TAsmCondFlag = (C_NONE,C_EQ,C_GT, + C_LT,C_GE,C_LE,C_NE,C_LE,C_LT,C_GE,C_GT); + + +{$ifdef extdebug} + function ref2string(const ref : treference) : string; + function cgsize2string(const size : TCgSize) : string; + function cgop2string(const op : TOpCg) : String; +{$endif extdebug} + + implementation + + uses + {$ifdef extdebug}sysutils,{$endif} + globals,verbose,systems,cutils, + symconst,symsym,fmodule, + rgobj,tgobj,cpupi,procinfo,paramgr; + +{ We know that macos_direct_globals is a const boolean + but we don't care about this warning } +{$NOTE Is macos_direct_globals still useful?} +{$WARN 6018 OFF} + +{$ifdef extdebug} + function ref2string(const ref : treference) : string; + begin + result := 'base : ' + inttostr(ord(ref.base)) + ' index : ' + inttostr(ord(ref.index)) + ' refaddr : ' + inttostr(ord(ref.refaddr)) + ' offset : ' + inttostr(ref.offset) + ' symbol : '; + if (assigned(ref.symbol)) then + result := result + ref.symbol.name; + end; + + function cgsize2string(const size : TCgSize) : string; + const + cgsize_strings : array[TCgSize] of string[8] = ( + 'OS_NO', 'OS_8', 'OS_16', 'OS_32', 'OS_64', 'OS_128', 'OS_S8', 'OS_S16', 'OS_S32', + 'OS_S64', 'OS_S128', 'OS_F32', 'OS_F64', 'OS_F80', 'OS_C64', 'OS_F128', + 'OS_M8', 'OS_M16', 'OS_M32', 'OS_M64', 'OS_M128', 'OS_MS8', 'OS_MS16', 'OS_MS32', + 'OS_MS64', 'OS_MS128'); + begin + result := cgsize_strings[size]; + end; + + function cgop2string(const op : TOpCg) : String; + const + opcg_strings : array[TOpCg] of string[6] = ( + 'None', 'Move', 'Add', 'And', 'Div', 'IDiv', 'IMul', 'Mul', + 'Neg', 'Not', 'Or', 'Sar', 'Shl', 'Shr', 'Sub', 'Xor', 'Rol', 'Ror' + ); + begin + result := opcg_strings[op]; + end; +{$endif extdebug} + + + function tcgppcgen.hasLargeOffset(const ref : TReference) : Boolean; + begin + result := aword(ref.offset-low(smallint)) > high(smallint)-low(smallint); + end; + + + function tcgppcgen.save_lr_in_prologue: boolean; + begin + result:= + (not (po_assembler in current_procinfo.procdef.procoptions) and + ((pi_do_call in current_procinfo.flags) or + (cs_profile in init_settings.moduleswitches))) or + ([cs_lineinfo,cs_debuginfo] * current_settings.moduleswitches <> []); + end; + + + procedure tcgppcgen.a_load_const_cgpara(list: TAsmList; size: tcgsize; a: tcgint; const + paraloc: tcgpara); + var + ref: treference; + begin + paraloc.check_simple_location; + paramanager.allocparaloc(list,paraloc.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,paraloc.alignment); + 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 tcgppcgen.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara); + var + ref: treference; + tmpreg: tregister; + + begin + paraloc.check_simple_location; + paramanager.allocparaloc(list,paraloc.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,paraloc.alignment); + ref.base := paraloc.location^.reference.index; + ref.offset := paraloc.location^.reference.offset; + tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); + 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 tcgppcgen.g_maybe_got_init(list: TAsmList); + var + instr: taicpu; + cond: tasmcond; + savedlr: boolean; + begin + if not(po_assembler in current_procinfo.procdef.procoptions) then + begin + if (cs_create_pic in current_settings.moduleswitches) and + (pi_needs_got in current_procinfo.flags) then + case target_info.system of + system_powerpc_darwin, + system_powerpc64_darwin: + begin + savedlr:=save_lr_in_prologue; + if not savedlr then + list.concat(taicpu.op_reg_reg(A_MFSPR,NR_R0,NR_LR)); + fillchar(cond,sizeof(cond),0); + cond.simple:=false; + cond.bo:=20; + cond.bi:=31; + instr:=taicpu.op_sym(A_BCL,current_procinfo.CurrGOTLabel); + instr.setcondition(cond); + list.concat(instr); + a_label(list,current_procinfo.CurrGOTLabel); + a_reg_alloc(list,current_procinfo.got); + list.concat(taicpu.op_reg_reg(A_MFSPR,current_procinfo.got,NR_LR)); + if not savedlr or + { in the following case lr is saved, but not restored } + { (happens e.g. when generating debug info for leaf } + { procedures) } + not(pi_do_call in current_procinfo.flags) then + list.concat(taicpu.op_reg_reg(A_MTSPR,NR_LR,NR_R0)); + end; + end; + end; + end; + + + function tcgppcgen.get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol; + var + stubname: string; + instr: taicpu; + href: treference; + l1: tasmsymbol; + localgotlab: tasmlabel; + cond: tasmcond; + stubalign: byte; + begin + { function declared in the current unit? } + { doesn't work correctly, because this will also return a hit if we } + { previously took the address of an external procedure. It doesn't } + { really matter, the linker will remove all unnecessary stubs. } + stubname := 'L'+s+'$stub'; + result := current_asmdata.getasmsymbol(stubname); + if assigned(result) then + exit; + + if current_asmdata.asmlists[al_imports]=nil then + current_asmdata.asmlists[al_imports]:=TAsmList.create; + + if (cs_create_pic in current_settings.moduleswitches) then + stubalign:=32 + else + stubalign:=16; + new_section(current_asmdata.asmlists[al_imports],sec_stub,'',stubalign); + result := current_asmdata.RefAsmSymbol(stubname); + current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0)); + { register as a weak symbol if necessary } + if weak then + current_asmdata.weakrefasmsymbol(s); + current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s)); + l1 := current_asmdata.RefAsmSymbol('L'+s+'$lazy_ptr'); + reference_reset_symbol(href,l1,0,sizeof(pint)); + href.refaddr := addr_higha; + if (cs_create_pic in current_settings.moduleswitches) then + begin + current_asmdata.getjumplabel(localgotlab); + href.relsymbol:=localgotlab; + fillchar(cond,sizeof(cond),0); + cond.simple:=false; + cond.bo:=20; + cond.bi:=31; + current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MFLR,NR_R0)); + instr:=taicpu.op_sym(A_BCL,localgotlab); + instr.setcondition(cond); + current_asmdata.asmlists[al_imports].concat(instr); + a_label(current_asmdata.asmlists[al_imports],localgotlab); + current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MFLR,NR_R11)); + current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_reg_ref(A_ADDIS,NR_R11,NR_R11,href)); + current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MTLR,NR_R0)); + end + else + current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LIS,NR_R11,href)); + href.refaddr := addr_low; + href.base := NR_R11; +{$ifndef cpu64bitaddr} + current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LWZU,NR_R12,href)); +{$else cpu64bitaddr} + { darwin/ppc64 uses a 32 bit absolute address here, strange... } + current_asmdata.asmlists[al_imports].concat(taicpu.op_reg_ref(A_LDU,NR_R12,href)); +{$endif cpu64bitaddr} + current_asmdata.asmlists[al_imports].concat(taicpu.op_reg(A_MTCTR,NR_R12)); + current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_BCTR)); + new_section(current_asmdata.asmlists[al_imports],sec_data_lazy,'',sizeof(pint)); + current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(l1,0)); + current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s)); + current_asmdata.asmlists[al_imports].concat(tai_const.createname('dyld_stub_binding_helper',0)); + end; + + + procedure tcgppcgen.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister); + + var + ref2, tmpref: treference; + + begin + ref2 := ref; + fixref(list,ref2); + if assigned(ref2.symbol) then + begin + if target_info.system = system_powerpc_macos then + begin + if macos_direct_globals then + begin + reference_reset(tmpref,ref2.alignment); + tmpref.offset := ref2.offset; + tmpref.symbol := ref2.symbol; + tmpref.base := NR_NO; + list.concat(taicpu.op_reg_reg_ref(A_ADDI,r,NR_RTOC,tmpref)); + end + else + begin + reference_reset(tmpref,ref2.alignment); + tmpref.symbol := ref2.symbol; + tmpref.offset := 0; + tmpref.base := NR_RTOC; + list.concat(taicpu.op_reg_ref(A_LWZ,r,tmpref)); + + if ref2.offset <> 0 then + begin + reference_reset(tmpref,ref2.alignment); + tmpref.offset := ref2.offset; + tmpref.base:= r; + list.concat(taicpu.op_reg_ref(A_LA,r,tmpref)); + end; + end; + + if ref2.base <> NR_NO then + list.concat(taicpu.op_reg_reg_reg(A_ADD,r,r,ref2.base)); + + //list.concat(tai_comment.create(strpnew('*** a_loadaddr_ref_reg'))); + end + else + begin + + { add the symbol's value to the base of the reference, and if the } + { reference doesn't have a base, create one } + reference_reset(tmpref,ref2.alignment); + tmpref.offset := ref2.offset; + tmpref.symbol := ref2.symbol; + tmpref.relsymbol := ref2.relsymbol; + tmpref.refaddr := addr_higha; + if ref2.base<> NR_NO then + begin + list.concat(taicpu.op_reg_reg_ref(A_ADDIS,r, + ref2.base,tmpref)); + end + else + list.concat(taicpu.op_reg_ref(A_LIS,r,tmpref)); + tmpref.base := NR_NO; + tmpref.refaddr := addr_low; + { can be folded with one of the next instructions by the } + { optimizer probably } + list.concat(taicpu.op_reg_reg_ref(A_ADDI,r,r,tmpref)); + end + end + else if ref2.offset <> 0 Then + if ref2.base <> NR_NO then + a_op_const_reg_reg(list,OP_ADD,OS_ADDR,ref2.offset,ref2.base,r) + { FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never} + { occurs, so now only ref.offset has to be loaded } + else + a_load_const_reg(list,OS_ADDR,ref2.offset,r) + else if ref2.index <> NR_NO Then + list.concat(taicpu.op_reg_reg_reg(A_ADD,r,ref2.base,ref2.index)) + else if (ref2.base <> NR_NO) and + (r <> ref2.base) then + a_load_reg_reg(list,OS_ADDR,OS_ADDR,ref2.base,r) + else + list.concat(taicpu.op_reg_const(A_LI,r,0)); + end; + + + + { calling a procedure by address } + procedure tcgppcgen.a_call_reg(list : TAsmList;reg: tregister); + begin + list.concat(taicpu.op_reg(A_MTCTR,reg)); + list.concat(taicpu.op_none(A_BCTRL)); + include(current_procinfo.flags,pi_do_call); + end; + + + procedure tcgppcgen.a_load_reg_ref(list: TAsmList; fromsize, tosize: TCGSize; + reg: tregister; const ref: treference); + + const + StoreInstr: array[OS_8..OS_INT, boolean, boolean] of TAsmOp = + { indexed? updating?} + (((A_STB, A_STBU), (A_STBX, A_STBUX)), + ((A_STH, A_STHU), (A_STHX, A_STHUX)), + ((A_STW, A_STWU), (A_STWX, A_STWUX)) +{$ifdef cpu64bitalu} + , + ((A_STD, A_STDU), (A_STDX, A_STDUX)) +{$endif cpu64bitalu} + ); + var + ref2: TReference; + tmpreg: tregister; + op: TAsmOp; + begin + if not (fromsize in [OS_8..OS_INT,OS_S8..OS_SINT]) then + internalerror(2002090904); + if not (tosize in [OS_8..OS_INT,OS_S8..OS_SINT]) then + internalerror(2002090905); + + if tosize in [OS_S8..OS_SINT] then + { storing is the same for signed and unsigned values } + tosize := tcgsize(ord(tosize) - (ord(OS_S8) - ord(OS_8))); + + ref2 := ref; + fixref(list, ref2); + + op := storeinstr[tcgsize2unsigned[tosize], ref2.index <> NR_NO, false]; + a_load_store(list, op, reg, ref2); + end; + + + + procedure tcgppcgen.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); + + var + op: tasmop; + instr: taicpu; + begin + if not(fromsize in [OS_F32,OS_F64]) or + not(tosize in [OS_F32,OS_F64]) then + internalerror(2006123110); + if (tosize < fromsize) then + op:=A_FRSP + else + op:=A_FMR; + instr := taicpu.op_reg_reg(op,reg2,reg1); + list.concat(instr); + if (op = A_FMR) then + rg[R_FPUREGISTER].add_move_instruction(instr); + end; + + + procedure tcgppcgen.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); + + const + FpuLoadInstr: Array[OS_F32..OS_F64,boolean, boolean] of TAsmOp = + { indexed? updating?} + (((A_LFS,A_LFSU),(A_LFSX,A_LFSUX)), + ((A_LFD,A_LFDU),(A_LFDX,A_LFDUX))); + var + op: tasmop; + ref2: treference; + + begin + if not(fromsize in [OS_F32,OS_F64]) or + not(tosize in [OS_F32,OS_F64]) then + internalerror(200201121); + ref2 := ref; + fixref(list,ref2); + op := fpuloadinstr[fromsize,ref2.index <> NR_NO,false]; + a_load_store(list,op,reg,ref2); + if (fromsize > tosize) then + a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg); + end; + + + procedure tcgppcgen.a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); + + const + FpuStoreInstr: Array[OS_F32..OS_F64,boolean, boolean] of TAsmOp = + { indexed? updating?} + (((A_STFS,A_STFSU),(A_STFSX,A_STFSUX)), + ((A_STFD,A_STFDU),(A_STFDX,A_STFDUX))); + var + op: tasmop; + ref2: treference; + reg2: tregister; + + begin + if not(fromsize in [OS_F32,OS_F64]) or + not(tosize in [OS_F32,OS_F64]) then + internalerror(200201122); + ref2 := ref; + fixref(list,ref2); + op := fpustoreinstr[tosize,ref2.index <> NR_NO,false]; + + { some PPCs have a bug whereby storing a double to memory } + { as single corrupts the value -> convert double to single } + { first (bug confirmed on some G4s, but not on G5s) } + if (tosize < fromsize) and + (current_settings.cputype < cpu_PPC970) then + begin + reg2:=getfpuregister(list,tosize); + a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg2); + reg:=reg2; + end; + a_load_store(list,op,reg,ref2); + end; + + + procedure tcgppcgen.g_stackpointer_alloc(list : TAsmList;localsize : longint); + begin + Comment(V_Error,'tcgppcgen.g_stackpointer_alloc method not implemented'); + end; + + procedure tcgppcgen.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); + begin + Comment(V_Error,'tcgppcgen.a_bit_scan_reg_reg method not implemented'); + end; + + procedure tcgppcgen.a_load_subsetref_regs_noindex(list: TAsmList; subsetsize: tcgsize; loadbitsize: byte; const sref: tsubsetreference; valuereg, extra_value_reg: tregister); + var + fromsreg, tosreg: tsubsetregister; + restbits: byte; + begin + restbits := (sref.bitlen - (loadbitsize - sref.startbit)); + if (subsetsize in [OS_S8..OS_S128]) then + begin + { sign extend } + a_op_const_reg(list,OP_SHL,OS_INT,AIntBits-loadbitsize+sref.startbit,valuereg); + a_op_const_reg(list,OP_SAR,OS_INT,AIntBits-sref.bitlen,valuereg); + end + else + begin + a_op_const_reg(list,OP_SHL,OS_INT,restbits,valuereg); + { mask other bits } + if (sref.bitlen <> AIntBits) then + a_op_const_reg(list,OP_AND,OS_INT,(aword(1) shl sref.bitlen)-1,valuereg); + end; + { use subsetreg routine, it may have been overridden with an optimized version } + fromsreg.subsetreg := extra_value_reg; + fromsreg.subsetregsize := OS_INT; + { subsetregs always count bits from right to left } + fromsreg.startbit := loadbitsize-restbits; + fromsreg.bitlen := restbits; + + tosreg.subsetreg := valuereg; + tosreg.subsetregsize := OS_INT; + tosreg.startbit := 0; + tosreg.bitlen := restbits; + + a_load_subsetreg_subsetreg(list,subsetsize,subsetsize,fromsreg,tosreg); + end; + + + procedure tcgppcgen.g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef); + var + hl : tasmlabel; + flags : TResFlags; + begin + if not(cs_check_overflow in current_settings.localswitches) then + exit; + current_asmdata.getjumplabel(hl); + if not ((def.typ=pointerdef) or + ((def.typ=orddef) and + (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar, + pasbool8,pasbool16,pasbool32,pasbool64]))) then + begin + if (current_settings.optimizecputype >= cpu_ppc970) or + (current_settings.cputype >= cpu_ppc970) then + begin + { ... instructions setting overflow flag ... + mfxerf R0 + mtcrf 128, R0 + ble cr0, label } + list.concat(taicpu.op_reg(A_MFXER, NR_R0)); + list.concat(taicpu.op_const_reg(A_MTCRF, 128, NR_R0)); + flags.cr := RS_CR0; + flags.flag := F_LE; + a_jmp_flags(list, flags, hl); + end + else + begin + list.concat(taicpu.op_reg(A_MCRXR,NR_CR7)); + a_jmp(list,A_BC,C_NO,7,hl) + end; + end + else + a_jmp_cond(list,OC_AE,hl); + a_call_name(list,'FPC_OVERFLOW',false); + a_label(list,hl); + end; + + + procedure tcgppcgen.g_profilecode(list: TAsmList); + var + paraloc1 : tcgpara; + begin + if (target_info.system in [system_powerpc_darwin]) then + begin + paraloc1.init; + paramanager.getintparaloc(pocall_cdecl,1,paraloc1); + a_load_reg_cgpara(list,OS_ADDR,NR_R0,paraloc1); + paramanager.freecgpara(list,paraloc1); + paraloc1.done; + allocallcpuregisters(list); + a_call_name(list,'mcount',false); + deallocallcpuregisters(list); + a_reg_dealloc(list,NR_R0); + end; + end; + + + procedure tcgppcgen.a_jmp_cond(list : TAsmList;cond : TOpCmp; l: tasmlabel); + begin + a_jmp(list,A_BC,TOpCmp2AsmCond[cond],0,l); + end; + + + procedure tcgppcgen.a_jmp(list: TAsmList; op: tasmop; c: tasmcondflag; + crval: longint; l: tasmlabel); + var + p: taicpu; + + begin + p := taicpu.op_sym(op,l); + if op <> A_B then + create_cond_norm(c,crval,p.condition); + p.is_jmp := true; + list.concat(p) + end; + + + + procedure tcgppcgen.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); + + procedure loadvmttor11; + var + href : treference; + begin + reference_reset_base(href,NR_R3,0,sizeof(pint)); + cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11); + end; + + + procedure op_onr11methodaddr; + var + href : treference; + begin + if (procdef.extnumber=$ffff) then + Internalerror(200006139); + { call/jmp vmtoffs(%eax) ; method offs } + reference_reset_base(href,NR_R11,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint)); + if hasLargeOffset(href) then + begin +{$ifdef cpu64} + if (longint(href.offset) <> href.offset) then + { add support for offsets > 32 bit } + internalerror(200510201); +{$endif cpu64} + list.concat(taicpu.op_reg_reg_const(A_ADDIS,NR_R11,NR_R11, + smallint((href.offset shr 16)+ord(smallint(href.offset and $ffff) < 0)))); + href.offset := smallint(href.offset and $ffff); + end; + a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11); + if (target_info.system = system_powerpc64_linux) then + begin + reference_reset_base(href, NR_R11, 0, sizeof(pint)); + a_load_ref_reg(list, OS_ADDR, OS_ADDR, href, NR_R11); + end; + list.concat(taicpu.op_reg(A_MTCTR,NR_R11)); + list.concat(taicpu.op_none(A_BCTR)); + if (target_info.system = system_powerpc64_linux) then + list.concat(taicpu.op_none(A_NOP)); + end; + + + var + make_global : boolean; + begin + if not(procdef.proctypeoption in [potype_function,potype_procedure]) then + Internalerror(200006137); + if not assigned(procdef.struct) 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 + create_smartlink 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) and + not is_objectpascal_helper(procdef.struct) then + begin + loadvmttor11; + op_onr11methodaddr; + end + { case 0 } + else + case target_info.system of + system_powerpc_darwin, + system_powerpc64_darwin: + list.concat(taicpu.op_sym(A_B,get_darwin_call_stub(procdef.mangledname,false))); + system_powerpc64_linux: + {$note ts:todo add GOT change?? - think not needed :) } + list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol('.' + procdef.mangledname))); + else + list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname))) + end; + List.concat(Tai_symbol_end.Createname(labelname)); + end; + + + function tcgppcgen.load_got_symbol(list: TAsmList; symbol : string) : tregister; + var + l: tasmsymbol; + ref: treference; + begin + if (target_info.system <> system_powerpc64_linux) then + internalerror(2007102010); + l:=current_asmdata.getasmsymbol(symbol); + reference_reset_symbol(ref,l,0,sizeof(pint)); + ref.base := NR_R2; + ref.refaddr := addr_pic; + + result := rg[R_INTREGISTER].getregister(list, R_SUBWHOLE); + {$IFDEF EXTDEBUG} + list.concat(tai_comment.create(strpnew('loading got reference for ' + symbol))); + {$ENDIF EXTDEBUG} + // cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,result); + +{$ifdef cpu64bitaddr} + list.concat(taicpu.op_reg_ref(A_LD, result, ref)); +{$else cpu64bitaddr} + list.concat(taicpu.op_reg_ref(A_LWZ, result, ref)); +{$endif cpu64bitaddr} + end; + + + function tcgppcgen.fixref(list: TAsmList; var ref: treference): boolean; + var + tmpreg: tregister; + begin + result := false; + + { Avoid recursion. } + if (ref.refaddr = addr_pic) then + exit; + + {$IFDEF EXTDEBUG} + list.concat(tai_comment.create(strpnew('fixref0 ' + ref2string(ref)))); + {$ENDIF EXTDEBUG} + if (target_info.system in [system_powerpc_darwin,system_powerpc64_darwin]) and + assigned(ref.symbol) and + not assigned(ref.relsymbol) and + ((ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or + (cs_create_pic in current_settings.moduleswitches))then + begin + if (ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or + ((cs_create_pic in current_settings.moduleswitches) and + (ref.symbol.bind in [AB_COMMON,AB_GLOBAL,AB_PRIVATE_EXTERN])) then + begin + tmpreg := g_indirect_sym_load(list,ref.symbol.name,ref.symbol.bind=AB_WEAK_EXTERNAL); + ref.symbol:=nil; + end + else + begin + include(current_procinfo.flags,pi_needs_got); + tmpreg := current_procinfo.got; + if assigned(ref.relsymbol) then + internalerror(2007093501); + ref.relsymbol := current_procinfo.CurrGOTLabel; + end; + if (ref.base = NR_NO) then + ref.base := tmpreg + else if (ref.index = NR_NO) then + ref.index := tmpreg + else + begin + list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.base,tmpreg)); + ref.base := tmpreg; + end; + end; + + { if we have to create PIC, add the symbol to the TOC/GOT } + if (target_info.system = system_powerpc64_linux) and + (cs_create_pic in current_settings.moduleswitches) and + (assigned(ref.symbol)) then + begin + tmpreg := load_got_symbol(list, ref.symbol.name); + if (ref.base = NR_NO) then + ref.base := tmpreg + else if (ref.index = NR_NO) then + ref.index := tmpreg + else begin + a_op_reg_reg_reg(list, OP_ADD, OS_ADDR, ref.base, tmpreg, tmpreg); + ref.base := tmpreg; + end; + ref.symbol := nil; + {$IFDEF EXTDEBUG} + list.concat(tai_comment.create(strpnew('fixref-pic ' + ref2string(ref)))); + {$ENDIF EXTDEBUG} + end; + + if (ref.base = NR_NO) then + begin + ref.base := ref.index; + ref.index := NR_NO; + end; + if (ref.base <> NR_NO) then + begin + if (ref.index <> NR_NO) and + ((ref.offset <> 0) or assigned(ref.symbol)) then + begin + result := true; + tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); + list.concat(taicpu.op_reg_reg_reg( + A_ADD,tmpreg,ref.base,ref.index)); + ref.index := NR_NO; + ref.base := tmpreg; + end + end; + if (ref.index <> NR_NO) and + (assigned(ref.symbol) or + (ref.offset <> 0)) then + internalerror(200208102); + {$IFDEF EXTDEBUG} + list.concat(tai_comment.create(strpnew('fixref1 ' + ref2string(ref)))); + {$ENDIF EXTDEBUG} + end; + + + procedure tcgppcgen.a_load_store(list:TAsmList;op: tasmop;reg:tregister; + ref: treference); + + var + tmpreg: tregister; + tmpref: treference; + largeOffset: Boolean; + + begin + tmpreg := NR_NO; + largeOffset:= hasLargeOffset(ref); + + if target_info.system = system_powerpc_macos then + begin + + if assigned(ref.symbol) then + begin {Load symbol's value} + tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); + + reference_reset(tmpref,sizeof(pint)); + tmpref.symbol := ref.symbol; + tmpref.base := NR_RTOC; + + if macos_direct_globals then + list.concat(taicpu.op_reg_ref(A_LA,tmpreg,tmpref)) + else + list.concat(taicpu.op_reg_ref(A_LWZ,tmpreg,tmpref)); + end; + + if largeOffset then + begin {Add hi part of offset} + reference_reset(tmpref,ref.alignment); + + if Smallint(Lo(ref.offset)) < 0 then + tmpref.offset := Hi(ref.offset) + 1 {Compensate when lo part is negative} + else + tmpref.offset := Hi(ref.offset); + + if (tmpreg <> NR_NO) then + list.concat(taicpu.op_reg_reg_ref(A_ADDIS,tmpreg, tmpreg,tmpref)) + else + begin + tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); + list.concat(taicpu.op_reg_ref(A_LIS,tmpreg,tmpref)); + end; + end; + + if (tmpreg <> NR_NO) then + begin + {Add content of base register} + if ref.base <> NR_NO then + list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg, + ref.base,tmpreg)); + + {Make ref ready to be used by op} + ref.symbol:= nil; + ref.base:= tmpreg; + if largeOffset then + ref.offset := Smallint(Lo(ref.offset)); + + list.concat(taicpu.op_reg_ref(op,reg,ref)); + //list.concat(tai_comment.create(strpnew('*** a_load_store indirect global'))); + end + else + list.concat(taicpu.op_reg_ref(op,reg,ref)); + end + else {if target_info.system <> system_powerpc_macos} + begin + if assigned(ref.symbol) or + largeOffset then + begin + tmpreg := rg[R_INTREGISTER].getregister(list,R_SUBWHOLE); + reference_reset(tmpref,ref.alignment); + tmpref.symbol := ref.symbol; + tmpref.relsymbol := ref.relsymbol; + tmpref.offset := ref.offset; + tmpref.refaddr := addr_higha; + if ref.base <> NR_NO then + list.concat(taicpu.op_reg_reg_ref(A_ADDIS,tmpreg, + ref.base,tmpref)) + else + list.concat(taicpu.op_reg_ref(A_LIS,tmpreg,tmpref)); + ref.base := tmpreg; + ref.refaddr := addr_low; + list.concat(taicpu.op_reg_ref(op,reg,ref)); + end + else + list.concat(taicpu.op_reg_ref(op,reg,ref)); + end; + end; + + +end. + diff --git a/closures/compiler/ppcgen/ngppcadd.pas b/closures/compiler/ppcgen/ngppcadd.pas new file mode 100644 index 0000000000..97895c59c3 --- /dev/null +++ b/closures/compiler/ppcgen/ngppcadd.pas @@ -0,0 +1,543 @@ +{ + Copyright (c) 2000-2006 by Florian Klaempfl and Jonas Maebe + + Code generation for add nodes on the PowerPC (32 and 64 bit generic) + + 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 ngppcadd; + + +{$i fpcdefs.inc} + +interface + + uses + node,nadd,ncgadd,cpubase; + + type + tgenppcaddnode = class(tcgaddnode) + function pass_1: tnode; override; + protected + procedure pass_left_and_right; + procedure load_left_right(cmpop, load_constants: boolean); + function getresflags : tresflags; + procedure emit_compare(unsigned: boolean); virtual; abstract; + procedure second_addfloat;override; + procedure second_addboolean;override; + procedure second_addsmallset;override; + end; + + +implementation + +{***************************************************************************** + Pass 1 +*****************************************************************************} + + uses + globtype,systems, + cutils,verbose,globals, + symconst,symdef,paramgr, + aasmbase,aasmtai,aasmdata,aasmcpu,defutil,htypechk, + cgbase,cpuinfo,pass_1,pass_2,regvars, + cpupara,cgcpu,cgutils,procinfo, + ncon,nset, + ncgutil,tgobj,rgobj,rgcpu,cgobj; + + +{***************************************************************************** + Pass 1 +*****************************************************************************} + + function tgenppcaddnode.pass_1: tnode; + begin + typecheckpass(left); + if (nodetype in [equaln,unequaln]) and + (left.resultdef.typ = orddef) and + is_64bit(left.resultdef) then + begin + result := nil; + firstpass(left); + firstpass(right); + expectloc := LOC_FLAGS; + exit; + end; + result := inherited pass_1; + end; + +{***************************************************************************** + Helpers +*****************************************************************************} + + procedure tgenppcaddnode.pass_left_and_right; + begin + { calculate the operator which is more difficult } + firstcomplex(self); + + { in case of constant put it to the left } + if (left.nodetype=ordconstn) then + swapleftright; + + secondpass(left); + secondpass(right); + end; + + + procedure tgenppcaddnode.load_left_right(cmpop, load_constants: boolean); + + procedure load_node(var n: tnode); + begin + case n.location.loc of + LOC_REGISTER, + LOC_CREGISTER: + ; + LOC_REFERENCE,LOC_CREFERENCE: + location_force_reg(current_asmdata.CurrAsmList,n.location,def_cgsize(n.resultdef),false); + LOC_CONSTANT: + begin + if load_constants then + location_force_reg(current_asmdata.CurrAsmList,n.location,def_cgsize(n.resultdef),false); + end; + else + location_force_reg(current_asmdata.CurrAsmList,n.location,def_cgsize(n.resultdef),false); + end; + end; + + begin + load_node(left); + load_node(right); + if not(cmpop) then + begin + location.register := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); +{$ifndef cpu64bitalu} + if is_64bit(resultdef) then + location.register64.reghi := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); +{$endif not cpu64bitalu} + end; + end; + + + function tgenppcaddnode.getresflags : tresflags; + begin + if (left.resultdef.typ <> floatdef) then + result.cr := RS_CR0 + else + result.cr := RS_CR1; + case nodetype of + equaln : result.flag:=F_EQ; + unequaln : result.flag:=F_NE; + else + if nf_swapped in flags then + case nodetype of + ltn : result.flag:=F_GT; + lten : result.flag:=F_GE; + gtn : result.flag:=F_LT; + gten : result.flag:=F_LE; + end + else + case nodetype of + ltn : result.flag:=F_LT; + lten : result.flag:=F_LE; + gtn : result.flag:=F_GT; + gten : result.flag:=F_GE; + end; + end + end; + + +{***************************************************************************** + AddBoolean +*****************************************************************************} + + procedure tgenppcaddnode.second_addboolean; + var + cgop : TOpCg; + cgsize : TCgSize; + cmpop, + isjump : boolean; + otl,ofl : tasmlabel; + begin + { calculate the operator which is more difficult } + firstcomplex(self); + + cmpop:=false; + if (torddef(left.resultdef).ordtype in [pasbool8,bool8bit]) or + (torddef(right.resultdef).ordtype in [pasbool8,bool8bit]) then + cgsize:=OS_8 + else + if (torddef(left.resultdef).ordtype in [pasbool16,bool16bit]) or + (torddef(right.resultdef).ordtype in [pasbool16,bool16bit]) then + cgsize:=OS_16 + else + cgsize:=OS_32; + + if ((cs_full_boolean_eval in current_settings.localswitches) and + not(nf_short_bool in flags)) or + (nodetype in [unequaln,ltn,lten,gtn,gten,equaln,xorn]) then + begin + if left.nodetype in [ordconstn,realconstn] then + swapleftright; + + isjump:=(left.expectloc=LOC_JUMP); + if isjump then + begin + otl:=current_procinfo.CurrTrueLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + ofl:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + end; + secondpass(left); + if left.location.loc in [LOC_FLAGS,LOC_JUMP] then + location_force_reg(current_asmdata.CurrAsmList,left.location,cgsize,false); + if isjump then + begin + current_procinfo.CurrTrueLabel:=otl; + current_procinfo.CurrFalseLabel:=ofl; + end + else if left.location.loc=LOC_JUMP then + internalerror(2003122901); + + isjump:=(right.expectloc=LOC_JUMP); + if isjump then + begin + otl:=current_procinfo.CurrTrueLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + ofl:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + end; + secondpass(right); + if right.location.loc in [LOC_FLAGS,LOC_JUMP] then + location_force_reg(current_asmdata.CurrAsmList,right.location,cgsize,false); + if isjump then + begin + current_procinfo.CurrTrueLabel:=otl; + current_procinfo.CurrFalseLabel:=ofl; + end + else if right.location.loc=LOC_JUMP then + internalerror(200312292); + + cmpop := nodetype in [ltn,lten,gtn,gten,equaln,unequaln]; + + { set result location } + if not cmpop then + location_reset(location,LOC_REGISTER,def_cgsize(resultdef)) + else + location_reset(location,LOC_FLAGS,OS_NO); + + load_left_right(cmpop,false); + + if (left.location.loc = LOC_CONSTANT) then + swapleftright; + + { compare the } + case nodetype of + ltn,lten,gtn,gten, + equaln,unequaln : + begin + if (right.location.loc <> LOC_CONSTANT) then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMPLW, + left.location.register,right.location.register)) + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CMPLWI, + left.location.register,longint(right.location.value))); + location.resflags := getresflags; + end; + else + begin + case nodetype of + xorn : + cgop:=OP_XOR; + orn : + cgop:=OP_OR; + andn : + cgop:=OP_AND; + else + internalerror(200203247); + end; + + if right.location.loc <> LOC_CONSTANT then + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,cgop,OS_INT, + left.location.register,right.location.register, + location.register) + else + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,cgop,OS_INT, + right.location.value,left.location.register, + location.register); + end; + end; + end + else + inherited second_addboolean; + end; + + +{***************************************************************************** + AddFloat +*****************************************************************************} + + procedure tgenppcaddnode.second_addfloat; + var + op : TAsmOp; + cmpop, + singleprec : boolean; + begin + pass_left_and_right; + + cmpop:=false; + singleprec:=tfloatdef(left.resultdef).floattype=s32real; + case nodetype of + addn : + if singleprec then + op:=A_FADDS + else + op:=A_FADD; + muln : + if singleprec then + op:=A_FMULS + else + op:=A_FMUL; + subn : + if singleprec then + op:=A_FSUBS + else + op:=A_FSUB; + slashn : + if singleprec then + op:=A_FDIVS + else + op:=A_FDIV; + ltn,lten,gtn,gten, + equaln,unequaln : + begin + op:=A_FCMPO; + cmpop:=true; + end; + else + internalerror(200403182); + end; + + // get the operands in the correct order, there are no special cases + // here, everything is register-based + if nf_swapped in flags then + swapleftright; + + // put both operands in a register + location_force_fpureg(current_asmdata.CurrAsmList,right.location,true); + location_force_fpureg(current_asmdata.CurrAsmList,left.location,true); + + // initialize de result + if not cmpop then + begin + location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); + location.register := cg.getfpuregister(current_asmdata.CurrAsmList,location.size); + end + else + begin + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags := getresflags; + end; + + // emit the actual operation + if not cmpop then + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op, + location.register,left.location.register, + right.location.register)) + end + else + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op, + newreg(R_SPECIALREGISTER,location.resflags.cr,R_SUBNONE),left.location.register,right.location.register)) + end; + end; + + +{***************************************************************************** + AddSmallSet +*****************************************************************************} + + procedure tgenppcaddnode.second_addsmallset; + var + cgop : TOpCg; + setbase: aint; + tmpreg : tregister; + opdone, + cmpop : boolean; + begin + pass_left_and_right; + + { when a setdef is passed, it has to be a smallset } + if (not(nf_swapped in flags) and + not is_smallset(left.resultdef) or + (not is_smallset(right.resultdef) and + (right.nodetype<>setelementn))) or + ((nf_swapped in flags) and + not is_smallset(right.resultdef) or + (not is_smallset(left.resultdef) and + (left.nodetype<>setelementn))) then + internalerror(200203359); + + opdone := false; + cmpop:=nodetype in [equaln,unequaln,lten,gten]; + + { set result location } + if not cmpop then + location_reset(location,LOC_REGISTER,def_cgsize(resultdef)) + else + location_reset(location,LOC_FLAGS,OS_NO); + + load_left_right(cmpop,false); + + if not(cmpop) then + location.register := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + + if (left.resultdef.typ=setdef) then + setbase:=tsetdef(left.resultdef).setbase + else + setbase:=tsetdef(right.resultdef).setbase; + case nodetype of + addn : + begin + if (nf_swapped in flags) and (left.nodetype=setelementn) then + swapleftright; + { are we adding set elements ? } + if right.nodetype=setelementn then + begin + { no range support for smallsets! } + if assigned(tsetelementnode(right).right) then + internalerror(43244); + if (right.location.loc = LOC_CONSTANT) then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_INT, + aint((aword(1) shl (resultdef.size*8-1)) shr aword(right.location.value-setbase)), + left.location.register,location.register) + else + begin + tmpreg := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,aint((aword(1) shl (resultdef.size*8-1))),tmpreg); + register_maybe_adjust_setbase(current_asmdata.CurrAsmList,right.location,setbase); + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_INT, + right.location.register,tmpreg); + if left.location.loc <> LOC_CONSTANT then + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_INT,tmpreg, + left.location.register,location.register) + else + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_INT, + left.location.value,tmpreg,location.register); + end; + opdone := true; + end + else + cgop := OP_OR; + end; + symdifn : + cgop:=OP_XOR; + muln : + cgop:=OP_AND; + subn : + begin + cgop:=OP_AND; + if (not(nf_swapped in flags)) then + if (right.location.loc=LOC_CONSTANT) then + right.location.value := not(right.location.value) + else + opdone := true + else if (left.location.loc=LOC_CONSTANT) then + left.location.value := not(left.location.value) + else + begin + swapleftright; + opdone := true; + end; + if opdone then + begin + if left.location.loc = LOC_CONSTANT then + begin + tmpreg := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT, + left.location.value,tmpreg); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ANDC, + location.register,tmpreg,right.location.register)); + end + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ANDC, + location.register,left.location.register, + right.location.register)); + end; + end; + equaln, + unequaln : + begin + emit_compare(true); + opdone := true; + end; + lten,gten: + begin + If (not(nf_swapped in flags) and + (nodetype = lten)) or + ((nf_swapped in flags) and + (nodetype = gten)) then + swapleftright; + // now we have to check whether left >= right + tmpreg := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + if left.location.loc = LOC_CONSTANT then + begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_AND,OS_INT, + not(left.location.value),right.location.register,tmpreg); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_CMPWI,tmpreg,0)); + // the two instructions above should be folded together by + // the peepholeoptimizer + end + else + begin + if right.location.loc = LOC_CONSTANT then + begin + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT, + right.location.value,tmpreg); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ANDC_,tmpreg, + tmpreg,left.location.register)); + end + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ANDC_,tmpreg, + right.location.register,left.location.register)); + end; + location.resflags.cr := RS_CR0; + location.resflags.flag := F_EQ; + opdone := true; + end; + else + internalerror(2002072701); + end; + + if not opdone then + begin + // these are all commutative operations + if (left.location.loc = LOC_CONSTANT) then + swapleftright; + if (right.location.loc = LOC_CONSTANT) then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,cgop,OS_INT, + right.location.value,left.location.register, + location.register) + else + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,cgop,OS_INT, + right.location.register,left.location.register, + location.register); + end; + end; + +end. diff --git a/closures/compiler/ppcgen/ngppccnv.pas b/closures/compiler/ppcgen/ngppccnv.pas new file mode 100644 index 0000000000..f08031efb3 --- /dev/null +++ b/closures/compiler/ppcgen/ngppccnv.pas @@ -0,0 +1,208 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate PowerPC 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 ngppccnv; + +{$i fpcdefs.inc} + +interface + + uses + node,ncnv,ncgcnv; + + type + tgenppctypeconvnode = class(tcgtypeconvnode) + protected + { 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,aasmdata, + defutil, + cgbase,cgutils,pass_1,pass_2, + ncgutil,procinfo, + cpubase,aasmcpu, + rgobj,tgobj,cgobj; + + + procedure tgenppctypeconvnode.second_int_to_bool; + var + hreg1, + hreg2 : tregister; +{$ifndef cpu64bitalu} + href : treference; +{$endif not cpu64bitalu} + resflags : tresflags; + opsize : tcgsize; + hlabel, oldTrueLabel, oldFalseLabel : tasmlabel; + newsize : tcgsize; + begin + oldTrueLabel:=current_procinfo.CurrTrueLabel; + oldFalseLabel:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + secondpass(left); + if codegenerror then + exit; + + { Explicit typecasts from any ordinal type to a boolean type } + { must not change the ordinal value } + if (nf_explicit in flags) and + not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then + begin + location_copy(location,left.location); + newsize:=def_cgsize(resultdef); + { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend } + if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or + ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then + location_force_reg(current_asmdata.CurrAsmList,location,newsize,true) + else + location.size:=newsize; + current_procinfo.CurrTrueLabel:=oldTrueLabel; + current_procinfo.CurrFalseLabel:=oldFalseLabel; + exit; + end; + + location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); + opsize := def_cgsize(left.resultdef); +{$ifndef cpu64bitalu} + if (opsize in [OS_64,OS_S64]) then + opsize:=OS_32; +{$endif not cpu64bitalu} + case left.location.loc of + LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER : + begin + if left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then + begin + hreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); +{$ifndef cpu64bitalu} + if left.location.size in [OS_64,OS_S64] then + begin + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,left.location.reference,hreg1); + hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + href:=left.location.reference; + inc(href.offset,4); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,href,hreg2); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,hreg1,hreg2,hreg1); + end + else +{$endif not cpu64bitalu} + cg.a_load_ref_reg(current_asmdata.CurrAsmList,opsize,opsize,left.location.reference,hreg1); + end + else + begin + hreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); +{$ifndef cpu64bitalu} + if left.location.size in [OS_64,OS_S64] then + begin + hreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,left.location.register64.reghi,left.location.register64.reglo,hreg1); + end + else +{$endif not cpu64bitalu} + cg.a_load_reg_reg(current_asmdata.CurrAsmList,opsize,opsize,left.location.register,hreg1); + end; + hreg2 := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + + if not(is_cbool(resultdef)) then + begin + { hreg2:=hreg1-1; carry:=hreg1=0 } + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBIC,hreg2,hreg1,1)); + { hreg1:=hreg1-hreg2+carry (= hreg1-(hreg1-1)-carry) } + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBFE,hreg1,hreg2,hreg1)); + end + else + begin + { carry:=hreg1<>0 } + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_SUBFIC,hreg2,hreg1,0)); + { hreg1:=hreg1-hreg1-carry } + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBFE,hreg1,hreg1,hreg1)); + end; + end; + LOC_FLAGS : + begin + hreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + resflags:=left.location.resflags; + cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,hreg1); + if (is_cbool(resultdef)) then + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,hreg1,hreg1); + end; + LOC_JUMP : + begin + hreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + current_asmdata.getjumplabel(hlabel); + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel); + if not(is_cbool(resultdef)) then + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hreg1) + else + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,-1,hreg1); + cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel); + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hreg1); + cg.a_label(current_asmdata.CurrAsmList,hlabel); + end; + else + internalerror(10062); + end; +{$ifndef cpu64bitalu} + if (location.size in [OS_64,OS_S64]) then + begin + location.register64.reglo:=hreg1; + location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + if (is_cbool(resultdef)) then + { reglo is either 0 or -1 -> reghi has to become the same } + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,location.register64.reglo,location.register64.reghi) + else + { unsigned } + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reghi); + end + else +{$endif cpu64bitalu} + location.register:=hreg1; + + current_procinfo.CurrTrueLabel:=oldTrueLabel; + current_procinfo.CurrFalseLabel:=oldFalseLabel; + end; + +end. diff --git a/closures/compiler/ppcgen/ngppcinl.pas b/closures/compiler/ppcgen/ngppcinl.pas new file mode 100644 index 0000000000..78b06e5708 --- /dev/null +++ b/closures/compiler/ppcgen/ngppcinl.pas @@ -0,0 +1,237 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate PowerPC32/64 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 ngppcinl; + +{$i fpcdefs.inc} + +interface + + uses + cpubase, + node,ninl,ncginl; + + type + tgppcinlinenode = class(tcginlinenode) + { first pass override + so that the code generator will actually generate + these nodes. + } + function first_sqrt_real: tnode; override; + function first_abs_real: tnode; override; + function first_sqr_real: tnode; override; + function first_trunc_real: tnode; override; + function first_round_real: tnode; override; + procedure second_sqrt_real; override; + procedure second_abs_real; override; + procedure second_sqr_real; override; + procedure second_trunc_real; override; + procedure second_round_real; override; + procedure second_prefetch;override; + protected + procedure load_fpu_location; + procedure second_trunc_round_real(op: tasmop); + end; + +implementation + + uses + cutils,globals,verbose,globtype, + aasmtai,aasmdata,aasmcpu, + symconst,symdef, + defutil, + cgbase,pass_2, + cpuinfo,ncgutil, + cgutils,cgobj,rgobj,tgobj; + + +{***************************************************************************** + tgppcinlinenode +*****************************************************************************} + + function tgppcinlinenode.first_sqrt_real : tnode; + begin + if (current_settings.cputype >= cpu_PPC970) then + begin + expectloc:=LOC_FPUREGISTER; + first_sqrt_real := nil; + end + else + result:=inherited first_sqrt_real; + end; + + + function tgppcinlinenode.first_abs_real : tnode; + begin + expectloc:=LOC_FPUREGISTER; + first_abs_real := nil; + end; + + + function tgppcinlinenode.first_sqr_real : tnode; + begin + expectloc:=LOC_FPUREGISTER; + first_sqr_real := nil; + end; + + + function tgppcinlinenode.first_trunc_real : tnode; + begin + if (current_settings.cputype >= cpu_PPC970) then + begin + expectloc:=LOC_REFERENCE; + first_trunc_real := nil; + end + else + result:=inherited first_trunc_real; + end; + + + function tgppcinlinenode.first_round_real : tnode; + begin + if (current_settings.cputype >= cpu_PPC970) then + begin + expectloc:=LOC_REFERENCE; + first_round_real := nil; + end + else + result:=inherited first_round_real; + end; + + + { load the FPU into the an fpu register } + procedure tgppcinlinenode.load_fpu_location; + begin + location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); + secondpass(left); + location_force_fpureg(current_asmdata.CurrAsmList,left.location,true); + location.loc := LOC_FPUREGISTER; + location.register := cg.getfpuregister(current_asmdata.CurrAsmList,OS_F64); + end; + + + procedure tgppcinlinenode.second_sqrt_real; + begin + if (current_settings.cputype < cpu_PPC970) then + internalerror(2007020910); + location.loc:=LOC_FPUREGISTER; + load_fpu_location; + case left.location.size of + OS_F32: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FSQRTS,location.register, + left.location.register)); + OS_F64: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FSQRT,location.register, + left.location.register)); + else + inherited; + end; + end; + + + procedure tgppcinlinenode.second_abs_real; + begin + location.loc:=LOC_FPUREGISTER; + load_fpu_location; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FABS,location.register, + left.location.register)); + end; + + + procedure tgppcinlinenode.second_sqr_real; + var + op: tasmop; + begin + location.loc:=LOC_FPUREGISTER; + load_fpu_location; + if (left.location.size = OS_F32) then + op := A_FMULS + else + op := A_FMUL; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,location.register, + left.location.register,left.location.register)); + end; + + + procedure tgppcinlinenode.second_trunc_round_real(op: tasmop); + var + tmpreg: tregister; + begin + if (current_settings.cputype < cpu_PPC970) then + internalerror(2007020910); + secondpass(left); + location_force_fpureg(current_asmdata.CurrAsmList,left.location,true); + tmpreg:=cg.getfpuregister(current_asmdata.CurrAsmList,OS_F64); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,tmpreg, + left.location.register)); + location_reset_ref(location,LOC_REFERENCE,def_cgsize(resultdef),0); + tg.gettemptyped(current_asmdata.CurrAsmList,resultdef,tt_normal, + location.reference); + cg.a_loadfpu_reg_ref(current_asmdata.CurrAsmList,OS_F64,OS_F64,tmpreg, + location.reference); + end; + + + procedure tgppcinlinenode.second_trunc_real; + begin + second_trunc_round_real(A_FCTIDZ); + end; + + + procedure tgppcinlinenode.second_round_real; + begin + second_trunc_round_real(A_FCTID); + end; + + + procedure tgppcinlinenode.second_prefetch; + var + r: tregister; + begin + secondpass(left); + case left.location.loc of + LOC_CREFERENCE, + LOC_REFERENCE: + begin + r:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR); + if (left.location.reference.offset = 0) and + not assigned(left.location.reference.symbol) then + begin + if (left.location.reference.index = NR_NO) then + current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_DCBT,0,left.location.reference.base)) + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_DCBT,left.location.reference.base,left.location.reference.index)); + end + else + begin + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,r); + current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_DCBT,0,r)); + end; + end; + else + internalerror(200402021); + end; + end; + + +begin + cinlinenode:=tgppcinlinenode; +end. diff --git a/closures/compiler/ppcgen/ngppcset.pas b/closures/compiler/ppcgen/ngppcset.pas new file mode 100644 index 0000000000..0a846f6531 --- /dev/null +++ b/closures/compiler/ppcgen/ngppcset.pas @@ -0,0 +1,243 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl and Carl Eric Codere + + Generate PowerPC32/64 assembler for in set/case 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 ngppcset; + +{$i fpcdefs.inc} + +interface + + uses + node,nset,ncgset,cpubase,cgbase,cgobj,aasmbase,aasmtai,aasmdata,globtype; + + type + tgppccasenode = class(tcgcasenode) + protected + procedure optimizevalues(var max_linear_list : aint; var max_dist : aword);override; + function has_jumptable : boolean;override; + procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override; + procedure genlinearlist(hp : pcaselabel); override; + end; + + +implementation + + uses + systems, + verbose,globals,constexp, + symconst,symdef,defutil, + paramgr, + cpuinfo, + pass_2,cgcpu, + ncon, + tgobj,ncgutil,regvars,rgobj,aasmcpu, + procinfo, + cgutils; + +{***************************************************************************** + TCGCASENODE +*****************************************************************************} + + + procedure tgppccasenode.optimizevalues(var max_linear_list : aint; var max_dist : aword); + begin + max_linear_list := 10; + end; + + + function tgppccasenode.has_jumptable : boolean; + begin + has_jumptable:=true; + end; + + + procedure tgppccasenode.genjumptable(hp : pcaselabel;min_,max_ : aint); + var + table : tasmlabel; + last : TConstExprInt; + indexreg : tregister; + href : treference; + mulfactor: longint; + + procedure genitem(list:TAsmList;t : pcaselabel); + var + i : TConstExprInt; + begin + if assigned(t^.less) then + genitem(list,t^.less); + { fill possible hole } + i:=last+1; + while i<=t^._low-1 do + begin + list.concat(Tai_const.Create_rel_sym(aitconst_32bit,table,elselabel)); + i:=i+1; + end; + i:=t^._low; + while i<=t^._high do + begin + list.concat(Tai_const.Create_rel_sym(aitconst_32bit,table,blocklabel(t^.blockid))); + i:=i+1; + end; + last:=t^._high; + if assigned(t^.greater) then + genitem(list,t^.greater); + end; + + begin + last:=min_; + { make it a 32bit register } + // allocate base and index registers register + indexreg:= cg.makeregsize(current_asmdata.CurrAsmList, hregister, OS_INT); + { indexreg := hregister; } + cg.a_load_reg_reg(current_asmdata.CurrAsmList, opsize, OS_INT, hregister, indexreg); + if not(jumptable_no_range) then + begin + { use aword(value-min)<aword(max-min) instead of two comparisons } + { case expr outside min_ .. max_ => goto elselabel } + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,aint(min_),indexreg); + { this trick requires an unsigned comparison in all cases } + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_A,aint(max_)-aint(min_),indexreg,elselabel); + { already taken into account now } + min_:=0; + end; + current_asmdata.getjumplabel(table); + { create reference, indexreg := indexreg * sizeof(jtentry) (= 4) } + mulfactor:=4; + cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_MUL, OS_INT, mulfactor, indexreg); + reference_reset_symbol(href, table, (-aint(min_)) * mulfactor, 4); + + hregister:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,href,hregister); + reference_reset_base(href,hregister,0,4); + href.index:=indexreg; + indexreg:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_S32,OS_ADDR,href,indexreg); + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_ADD,OS_ADDR,hregister,indexreg); + + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_MTCTR, indexreg)); + current_asmdata.CurrAsmList.concat(taicpu.op_none(A_BCTR)); + + { generate jump table } + current_asmdata.CurrAsmList.concat(Tai_label.Create(table)); + genitem(current_asmdata.CurrAsmList,hp); + end; + + + procedure tgppccasenode.genlinearlist(hp : pcaselabel); + + var + first, lastrange : boolean; + last : TConstExprInt; + + procedure genitem(t : pcaselabel); + + procedure gensub(value:longint); + var + tmpreg: tregister; + begin + value := -value; + if (value >= low(smallint)) and + (value <= high(smallint)) then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_const(A_ADDIC_,hregister, + hregister,value)) + else + begin + tmpreg := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,value,tmpreg); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ADD_,hregister, + hregister,tmpreg)); + end; + end; + + begin + if (get_min_value(left.resultdef) >= int64(low(smallint))) and + (get_max_value(left.resultdef) <= int64(high(word))) then + begin + genlinearcmplist(hp); + exit; + end; + if assigned(t^.less) then + genitem(t^.less); + { need we to test the first value } + if first and (t^._low>get_min_value(left.resultdef)) then + begin + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,jmp_lt,aword(t^._low.svalue),hregister,elselabel); + end; + if t^._low=t^._high then + begin + if t^._low-last=0 then + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,OS_INT,OC_EQ,0,hregister,blocklabel(t^.blockid)) + else + gensub(longint(int64(t^._low-last))); + tcgppc(cg).a_jmp_cond(current_asmdata.CurrAsmList,OC_EQ,blocklabel(t^.blockid)); + last:=t^._low; + lastrange := false; + end + else + begin + { it begins with the smallest label, if the value } + { is even smaller then jump immediately to the } + { ELSE-label } + if first then + begin + { have we to ajust the first value ? } + if (t^._low>get_min_value(left.resultdef)) or (get_min_value(left.resultdef)<>0) then + gensub(longint(int64(t^._low))); + end + else + begin + { if there is no unused label between the last and the } + { present label then the lower limit can be checked } + { immediately. else check the range in between: } + gensub(longint(int64(t^._low-last))); + if ((t^._low-last) <> 1) or + (not lastrange) then + tcgppc(cg).a_jmp_cond(current_asmdata.CurrAsmList,jmp_lt,elselabel); + end; + gensub(longint(int64(t^._high-t^._low))); + tcgppc(cg).a_jmp_cond(current_asmdata.CurrAsmList,jmp_le,blocklabel(t^.blockid)); + last:=t^._high; + lastrange := true; + end; + first:=false; + if assigned(t^.greater) then + genitem(t^.greater); + end; + + begin + { do we need to generate cmps? } + if (with_sign and (min_label<0)) or + (opsize in [OS_32,OS_64,OS_S64]) then + genlinearcmplist(hp) + else + begin + last:=0; + lastrange:=false; + first:=true; + genitem(hp); + cg.a_jmp_always(current_asmdata.CurrAsmList,elselabel); + end; + end; + + +begin + ccasenode:=tgppccasenode; +end. diff --git a/closures/compiler/ppcgen/rgcpu.pas b/closures/compiler/ppcgen/rgcpu.pas new file mode 100644 index 0000000000..64b84bdd82 --- /dev/null +++ b/closures/compiler/ppcgen/rgcpu.pas @@ -0,0 +1,200 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements the powerpc specific class for the register + allocator + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} + +unit rgcpu; + +{$i fpcdefs.inc} + + interface + + uses + aasmbase,aasmtai,aasmdata,aasmcpu, + cgbase,cgutils, + cpubase, + rgobj; + + type + trgcpu = class(trgobj) + procedure do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override; + procedure do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override; + end; + + trgintcpu = class(trgcpu) +{$ifdef user0} + procedure add_cpu_interferences(p : tai);override; +{$endif user0} + end; + + implementation + + uses + verbose, cutils,globtype, + cgobj, + procinfo; + + + procedure trgcpu.do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister); + var + tmpref : treference; + helplist : TAsmList; + hreg : tregister; + ins : Taicpu; + begin + if (spilltemp.offset<low(smallint)) or + (spilltemp.offset>high(smallint)) then + begin + helplist:=TAsmList.create; + + if (spilltemp.index<>NR_NO) then + internalerror(200704201); + + if getregtype(tempreg)=R_INTREGISTER then + begin + hreg:=getregisterinline(helplist,[R_SUBWHOLE]); + {Done by add_cpu_interferences now. + add_edge(getsupreg(hreg),RS_R0);} + end + else + hreg:=cg.getintregister(helplist,OS_ADDR); + + reference_reset(tmpref,sizeof(aint)); + tmpref.offset:=spilltemp.offset; + tmpref.refaddr := addr_higha; + ins:=taicpu.op_reg_reg_ref(A_ADDIS,hreg,spilltemp.base,tmpref); + add_cpu_interferences(ins); + helplist.concat(ins); + tmpref:=spilltemp; + tmpref.refaddr := addr_low; + tmpref.base:=hreg; + + ins:=spilling_create_load(tmpref,tempreg); + add_cpu_interferences(ins); + + + helplist.concat(ins); + + if getregtype(tempreg)=R_INTREGISTER then + ungetregisterinline(helplist,hreg); + + list.insertlistafter(pos,helplist); + helplist.free; + end + else + inherited do_spill_read(list,pos,spilltemp,tempreg); + end; + + + procedure trgcpu.do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister); + var + tmpref : treference; + helplist : TAsmList; + hreg : tregister; + ins : Taicpu; + begin + if (spilltemp.offset<low(smallint)) or + (spilltemp.offset>high(smallint)) then + begin + helplist:=TAsmList.create; + + if (spilltemp.index<>NR_NO) then + internalerror(200704201); + + if getregtype(tempreg)=R_INTREGISTER then + begin + hreg:=getregisterinline(helplist,[R_SUBWHOLE]); + {Done by add_cpu_interferences now. + add_edge(getsupreg(hreg),RS_R0);} + end + else + hreg:=cg.getintregister(helplist,OS_ADDR); + reference_reset(tmpref,sizeof(aint)); + tmpref.offset:=spilltemp.offset; + tmpref.refaddr := addr_higha; + ins:=taicpu.op_reg_reg_ref(A_ADDIS,hreg,spilltemp.base,tmpref); + add_cpu_interferences(ins); + helplist.concat(ins); + tmpref:=spilltemp; + tmpref.refaddr := addr_low; + tmpref.base:=hreg; + ins:=spilling_create_store(tempreg,tmpref); + add_cpu_interferences(ins); + helplist.concat(ins); + + if getregtype(tempreg)=R_INTREGISTER then + ungetregisterinline(helplist,hreg); + + list.insertlistafter(pos,helplist); + helplist.free; + end + else + inherited do_spill_written(list,pos,spilltemp,tempreg); + end; + +{$ifdef user0} + procedure trgintcpu.add_cpu_interferences(p : tai); + var + r : tregister; + begin + if p.typ=ait_instruction then + begin + case taicpu(p).opcode of + A_ADDI, A_ADDIS, + A_STB, A_LBZ, A_STBX, A_LBZX, A_STH, A_LHZ, A_STHX, A_LHZX, A_LHA, A_LHAX, + A_STW, A_LWZ, A_STWX, A_LWZX, + A_STFS, A_LFS, A_STFSX, A_LFSX, A_STFD, A_LFD, A_STFDX, A_LFDX, A_STFIWX, + A_STHBRX, A_LHBRX, A_STWBRX, A_LWBRX, A_STWCX_, A_LWARX, + A_ECIWX, A_ECOWX, + A_LMW, A_STMW,A_LSWI,A_LSWX,A_STSWI,A_STSWX +{$ifdef cpu64bitalu} + , A_STD, A_STDX, + A_LD, A_LDX, + A_LWA, A_LWAX, + A_STDCX_,A_LDARX +{$endif cpu64bitalu} + : + begin + case taicpu(p).oper[1]^.typ of + top_reg: + add_edge(getsupreg(taicpu(p).oper[1]^.reg),RS_R0); + top_ref: + if (taicpu(p).oper[1]^.ref^.base <> NR_NO) then + add_edge(getsupreg(taicpu(p).oper[1]^.ref^.base),RS_R0); + end; + end; + A_DCBA, A_DCBI, A_DCBST, A_DCBT, A_DCBTST, A_DCBZ, A_DCBF, A_ICBI: + begin + case taicpu(p).oper[0]^.typ of + top_reg: + add_edge(getsupreg(taicpu(p).oper[0]^.reg),RS_R0); + top_ref: + if (taicpu(p).oper[0]^.ref^.base <> NR_NO) then + add_edge(getsupreg(taicpu(p).oper[1]^.ref^.base),RS_R0); + end; + end; + end; + end; + end; +{$endif user0} + + +end. diff --git a/closures/compiler/ppcmipsel.lpi b/closures/compiler/ppcmipsel.lpi new file mode 100644 index 0000000000..997493cb76 --- /dev/null +++ b/closures/compiler/ppcmipsel.lpi @@ -0,0 +1,95 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <PathDelim Value="\"/> + <Version Value="7"/> + <General> + <Flags> + <MainUnitHasUsesSectionForAllUnits Value="False"/> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + <AlwaysBuild Value="False"/> + <LRSInOutputDirectory Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <TargetFileExt Value=".exe"/> + <Title Value="pp"/> + </General> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <RequiredPackages Count="1"> + <Item1> + <PackageName Value="LCL"/> + <MinVersion Major="1" Valid="True"/> + </Item1> + </RequiredPackages> + <Units Count="4"> + <Unit0> + <Filename Value="pp.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="pp"/> + </Unit0> + <Unit1> + <Filename Value="mips\aasmcpu.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="aasmcpu"/> + </Unit1> + <Unit2> + <Filename Value="mips\aoptcpu.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="aoptcpu"/> + </Unit2> + <Unit3> + <Filename Value="aopt.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="aopt"/> + </Unit3> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="8"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="mips\pp"/> + </Target> + <SearchPaths> + <IncludeFiles Value="mips\"/> + <OtherUnitFiles Value="mips\;systems\"/> + <UnitOutputDirectory Value="mips\lazbuild"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <CStyleOperator Value="False"/> + <AllowLabel Value="False"/> + <CPPInline Value="False"/> + </SyntaxOptions> + </Parsing> + <Linking> + <Debugging> + <GenerateDebugInfo Value="True"/> + </Debugging> + </Linking> + <Other> + <Verbosity> + <ShowWarn Value="False"/> + <ShowNotes Value="False"/> + <ShowHints Value="False"/> + </Verbosity> + <ConfigFile> + <StopAfterErrCount Value="50"/> + </ConfigFile> + <CustomOptions Value="-dmipsel"/> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/closures/compiler/ppcppc.lpi b/closures/compiler/ppcppc.lpi new file mode 100644 index 0000000000..d9a0855dfe --- /dev/null +++ b/closures/compiler/ppcppc.lpi @@ -0,0 +1,79 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <PathDelim Value="\"/> + <Version Value="7"/> + <General> + <Flags> + <MainUnitHasUsesSectionForAllUnits Value="False"/> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + <LRSInOutputDirectory Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <TargetFileExt Value=".exe"/> + <Title Value="pp"/> + </General> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <Units Count="2"> + <Unit0> + <Filename Value="pp.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="pp"/> + </Unit0> + <Unit1> + <Filename Value="powerpc\cgcpu.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="cgcpu"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="8"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="powerpc\pp"/> + </Target> + <SearchPaths> + <IncludeFiles Value="powerpc\"/> + <OtherUnitFiles Value="powerpc\;ppcgen\;systems\"/> + <UnitOutputDirectory Value="powerpc\lazbuild"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <CStyleOperator Value="False"/> + <AllowLabel Value="False"/> + <CPPInline Value="False"/> + </SyntaxOptions> + </Parsing> + <Linking> + <Debugging> + <GenerateDebugInfo Value="True"/> + </Debugging> + </Linking> + <Other> + <Verbosity> + <ShowWarn Value="False"/> + <ShowNotes Value="False"/> + <ShowHints Value="False"/> + </Verbosity> + <ConfigFile> + <StopAfterErrCount Value="50"/> + </ConfigFile> + <CustomOptions Value="-dpowerpc +"/> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/closures/compiler/ppcsparc.lpi b/closures/compiler/ppcsparc.lpi new file mode 100644 index 0000000000..8dc8d7357c --- /dev/null +++ b/closures/compiler/ppcsparc.lpi @@ -0,0 +1,79 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <PathDelim Value="\"/> + <Version Value="7"/> + <General> + <Flags> + <MainUnitHasUsesSectionForAllUnits Value="False"/> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + <LRSInOutputDirectory Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <TargetFileExt Value=".exe"/> + <Title Value="pp"/> + </General> + <PublishOptions> + <Version Value="2"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <Units Count="2"> + <Unit0> + <Filename Value="pp.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="pp"/> + </Unit0> + <Unit1> + <Filename Value="sparc\aasmcpu.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="aasmcpu"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="8"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="sparc\pp"/> + </Target> + <SearchPaths> + <IncludeFiles Value="sparc\"/> + <OtherUnitFiles Value="sparc\;systems\"/> + <UnitOutputDirectory Value="sparc\lazbuild"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <CStyleOperator Value="False"/> + <AllowLabel Value="False"/> + <CPPInline Value="False"/> + </SyntaxOptions> + </Parsing> + <Linking> + <Debugging> + <GenerateDebugInfo Value="True"/> + </Debugging> + </Linking> + <Other> + <Verbosity> + <ShowWarn Value="False"/> + <ShowNotes Value="False"/> + <ShowHints Value="False"/> + </Verbosity> + <ConfigFile> + <StopAfterErrCount Value="50"/> + </ConfigFile> + <CustomOptions Value="-dsparc +"/> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/closures/compiler/ppheap.pas b/closures/compiler/ppheap.pas new file mode 100644 index 0000000000..6dfe60066c --- /dev/null +++ b/closures/compiler/ppheap.pas @@ -0,0 +1,147 @@ +{ + Copyright (c) 1998-2002 by Pierre Muller + + Simple unit to add source line and column to each + memory allocation made with heaptrc unit + + 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 ppheap; + +{$i fpcdefs.inc} + +interface + + uses heaptrc; + + { call this function before any memory allocation + in a unit initialization code (PM) } + + procedure pp_heap_init; + + procedure ppheap_register_file(name : string;index : longint); + + +implementation + + uses + cutils,globtype,globals,fmodule; + +{***************************************************************************** + Filename registration +*****************************************************************************} + + const + MaxFiles = 1024; + MaxNameLength = 39; + + type + theapfileinfo = record + name : string[MaxNameLength]; + index : longint; + end; + + tfileinfoarray = array [1..MaxFiles] of theapfileinfo; + + var + fileinfoarray : tfileinfoarray; + last_index : longint; + + + procedure ppheap_register_file(name : string;index : longint); + begin + inc(last_index); + if last_index <= MaxFiles then + begin + fileinfoarray[last_index].name:=copy(name,1,MaxNameLength); + fileinfoarray[last_index].index:=index; + end + else + writeln(stderr,'file',name,' has index ',index); + end; + + + function getfilename(index : longint) : string; + var + i : longint; + begin + for i:=1 to last_index do + begin + if fileinfoarray[i].index=index then + begin + getfilename:=fileinfoarray[i].name; + exit; + end; + end; + getfilename:=tostr(index); + end; + + +{***************************************************************************** + Heaptrc callbacks +*****************************************************************************} + + type + pextra_info = ^textra_info; + textra_info = record + line, + col, + fileindex : longint; + end; + + procedure set_extra_info(p : pointer); + begin + with pextra_info(p)^ do + begin + line:=current_filepos.line; + col:=current_filepos.column; + if assigned(current_module) then + fileindex:=current_module.unit_index*100000+current_filepos.fileindex + else + fileindex:=current_filepos.fileindex; + end; + end; + + + procedure show_extra_info(var t : text;p : pointer); + begin + with pextra_info(p)^ do + begin + writeln(t,getfilename(fileindex)+'('+tostr(line)+','+tostr(col)+') '); + end; + end; + + + const + pp_heap_inited : boolean = false; + + procedure pp_heap_init; + begin + if not pp_heap_inited then + begin + keepreleased:=true; + SetHeapTraceOutput('heap.log'); + SetHeapExtraInfo(sizeof(textra_info), + @set_extra_info, + @show_extra_info); + end; + pp_heap_inited:=true; + end; + + +begin + pp_heap_init; +end. diff --git a/closures/compiler/ppu.pas b/closures/compiler/ppu.pas new file mode 100644 index 0000000000..96d42a9296 --- /dev/null +++ b/closures/compiler/ppu.pas @@ -0,0 +1,1373 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Routines to read/write ppu files + + 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 ppu; + +{$i fpcdefs.inc} + +interface + + uses + systems,globtype,constexp,cstreams; + +{ Also write the ppu if only crc if done, this can be used with ppudump to + see the differences between the intf and implementation } +{ define INTFPPU} + +{$ifdef Test_Double_checksum} +var + CRCFile : text; +const + CRC_array_Size = 200000; +type + tcrc_array = array[0..crc_array_size] of longint; + pcrc_array = ^tcrc_array; +{$endif Test_Double_checksum} + +const + CurrentPPUVersion = 141; + +{ buffer sizes } + maxentrysize = 1024; + ppubufsize = 16384; + +{ppu entries} + mainentryid = 1; + subentryid = 2; + {special} + iberror = 0; + ibstartdefs = 248; + ibenddefs = 249; + ibstartsyms = 250; + ibendsyms = 251; + ibendinterface = 252; + ibendimplementation = 253; +// ibendbrowser = 254; + ibend = 255; + {general} + ibmodulename = 1; + ibsourcefiles = 2; + ibloadunit = 3; + ibinitunit = 4; + iblinkunitofiles = 5; + iblinkunitstaticlibs = 6; + iblinkunitsharedlibs = 7; + iblinkotherofiles = 8; + iblinkotherstaticlibs = 9; + iblinkothersharedlibs = 10; + ibImportSymbols = 11; + ibsymref = 12; + ibdefref = 13; +// ibendsymtablebrowser = 14; +// ibbeginsymtablebrowser = 15; +{$IFDEF MACRO_DIFF_HINT} + ibusedmacros = 16; +{$ENDIF} + ibderefdata = 17; + ibexportedmacros = 18; + ibderefmap = 19; + {syms} + ibtypesym = 20; + ibprocsym = 21; + ibstaticvarsym = 22; + ibconstsym = 23; + ibenumsym = 24; +// ibtypedconstsym = 25; + ibabsolutevarsym = 26; + ibpropertysym = 27; + ibfieldvarsym = 28; + ibunitsym = 29; + iblabelsym = 30; + ibsyssym = 31; + ibnamespacesym = 32; + iblocalvarsym = 33; + ibparavarsym = 34; + ibmacrosym = 35; + {definitions} + iborddef = 40; + ibpointerdef = 41; + ibarraydef = 42; + ibprocdef = 43; + ibshortstringdef = 44; + ibrecorddef = 45; + ibfiledef = 46; + ibformaldef = 47; + ibobjectdef = 48; + ibenumdef = 49; + ibsetdef = 50; + ibprocvardef = 51; + ibfloatdef = 52; + ibclassrefdef = 53; + iblongstringdef = 54; + ibansistringdef = 55; + ibwidestringdef = 56; + ibvariantdef = 57; + ibundefineddef = 58; + ibunicodestringdef = 59; + {implementation/ObjData} + ibnodetree = 80; + ibasmsymbols = 81; + ibresources = 82; + ibcreatedobjtypes = 83; + ibwpofile = 84; + ibmoduleoptions = 85; + + ibmainname = 90; + ibsymtableoptions = 91; + ibrecsymtableoptions = 91; + { target-specific things } + iblinkotherframeworks = 100; + +{ unit flags } + uf_init = $000001; { unit has initialization section } + uf_finalize = $000002; { unit has finalization section } + uf_big_endian = $000004; +//uf_has_browser = $000010; + uf_in_library = $000020; { is the file in another file than <ppufile>.* ? } + uf_smart_linked = $000040; { the ppu can be smartlinked } + uf_static_linked = $000080; { the ppu can be linked static } + uf_shared_linked = $000100; { the ppu can be linked shared } +//uf_local_browser = $000200; + uf_no_link = $000400; { unit has no .o generated, but can still have external linking! } + uf_has_resourcestrings = $000800; { unit has resource string section } + uf_little_endian = $001000; + uf_release = $002000; { unit was compiled with -Ur option } + uf_threadvars = $004000; { unit has threadvars } + uf_fpu_emulation = $008000; { this unit was compiled with fpu emulation on } + uf_has_stabs_debuginfo = $010000; { this unit has stabs debuginfo generated } + uf_local_symtable = $020000; { this unit has a local symtable stored } + uf_uses_variants = $040000; { this unit uses variants } + uf_has_resourcefiles = $080000; { this unit has external resources (using $R directive)} + uf_has_exports = $100000; { this module or a used unit has exports } + uf_has_dwarf_debuginfo = $200000; { this unit has dwarf debuginfo generated } + uf_wideinits = $400000; { this unit has winlike widestring typed constants } + uf_classinits = $800000; { this unit has class constructors/destructors } + uf_resstrinits = $1000000; { this unit has string consts referencing resourcestrings } + +{$ifdef generic_cpu} +{ We need to use the correct size of aint and pint for + the target CPU } +const + CpuAddrBitSize : array[tsystemcpu] of longint = + ( + { 0 } 32 {'none'}, + { 1 } 32 {'i386'}, + { 2 } 32 {'m68k'}, + { 3 } 32 {'alpha'}, + { 4 } 32 {'powerpc'}, + { 5 } 32 {'sparc'}, + { 6 } 32 {'vis'}, + { 7 } 64 {'ia64'}, + { 8 } 64 {'x86_64'}, + { 9 } 32 {'mips'}, + { 10 } 32 {'arm'}, + { 11 } 64 {'powerpc64'}, + { 12 } 16 {'avr'}, + { 13 } 32 {'mipsel'} + ); + CpuAluBitSize : array[tsystemcpu] of longint = + ( + { 0 } 32 {'none'}, + { 1 } 32 {'i386'}, + { 2 } 32 {'m68k'}, + { 3 } 32 {'alpha'}, + { 4 } 32 {'powerpc'}, + { 5 } 32 {'sparc'}, + { 6 } 32 {'vis'}, + { 7 } 64 {'ia64'}, + { 8 } 64 {'x86_64'}, + { 9 } 32 {'mips'}, + { 10 } 32 {'arm'}, + { 11 } 64 {'powerpc64'}, + { 12 } 8 {'avr'}, + { 13 } 32 {'mipsel'} + ); +{$endif generic_cpu} + +type + { bestreal is defined based on the target architecture } + ppureal=bestreal; + + tppuerror=(ppuentrytoobig,ppuentryerror); + + tppuheader=record + id : array[1..3] of char; { = 'PPU' } + ver : array[1..3] of char; + compiler : word; + cpu : word; + target : word; + flags : longint; + size : longint; { size of the ppufile without header } + checksum : cardinal; { checksum for this ppufile } + interface_checksum : cardinal; + deflistsize, + symlistsize : longint; + indirect_checksum: cardinal; + end; + + tppuentry=packed record + size : longint; + id : byte; + nr : byte; + end; + + { tppufile } + + tppufile=class + private + f : TCCustomFileStream; + mode : byte; {0 - Closed, 1 - Reading, 2 - Writing} + fname : string; + fsize : integer; +{$ifdef Test_Double_checksum} + public + crcindex, + crc_index, + crcindex2, + crc_index2 : cardinal; + crc_test, + crc_test2 : pcrc_array; + private +{$endif def Test_Double_checksum} + buf : pchar; + bufstart, + bufsize, + bufidx : integer; + entrybufstart, + entrystart, + entryidx : integer; + entry : tppuentry; + closed, + tempclosed : boolean; + closepos : integer; + public + entrytyp : byte; + header : tppuheader; + size : integer; + change_endian : boolean; { Used in ppudump util } + { crc for the entire unit } + crc, + { crc for the interface definitions in this unit } + interface_crc, + { crc of all object/class definitions in the interface of this unit, xor'ed + by the crc's of all object/class definitions in the interfaces of units + used by this unit. Reason: see mantis #13840 } + indirect_crc : cardinal; + error, +{$ifdef generic_cpu} + has_more, +{$endif not generic_cpu} + do_crc, + do_interface_crc, + do_indirect_crc : boolean; + crc_only : boolean; { used to calculate interface_crc before implementation } + constructor Create(const fn:string); + destructor Destroy;override; + procedure flush; + procedure closefile; + function CheckPPUId:boolean; + function GetPPUVersion:integer; + procedure NewHeader; + procedure NewEntry; + {read} + function openfile:boolean; + procedure reloadbuf; + procedure readdata(out b;len:integer); + procedure skipdata(len:integer); + function readentry:byte; + function EndOfEntry:boolean; + function entrysize:longint; + function entryleft:longint; + procedure getdatabuf(out b;len:integer;out res:integer); + procedure getdata(out b;len:integer); + function getbyte:byte; + function getword:word; + function getdword:dword; + function getlongint:longint; + function getint64:int64; + function getqword:qword; + function getaint:aint; + function getasizeint:asizeint; + function getaword:aword; + function getreal:ppureal; + function getrealsize(sizeofreal : longint):ppureal; + function getstring:string; + function getansistring:ansistring; + procedure getnormalset(out b); + procedure getsmallset(out b); + function skipuntilentry(untilb:byte):boolean; + {write} + function createfile:boolean; + procedure writeheader; + procedure writebuf; + procedure writedata(const b;len:integer); + procedure writeentry(ibnr:byte); + procedure putdata(const b;len:integer); + procedure putbyte(b:byte); + procedure putword(w:word); + procedure putdword(w:dword); + procedure putlongint(l:longint); + procedure putint64(i:int64); + procedure putqword(q:qword); + procedure putaint(i:aint); + procedure putasizeint(i:asizeint); + procedure putaword(i:aword); + procedure putreal(d:ppureal); + procedure putstring(const s:string); + procedure putansistring(const s:ansistring); + procedure putnormalset(const b); + procedure putsmallset(const b); + procedure tempclose; // MG: not used, obsolete? + function tempopen:boolean; // MG: not used, obsolete? + end; + +implementation + + uses +{$ifdef Test_Double_checksum} + comphook, +{$endif def Test_Double_checksum} + fpccrc, + cutils; + + + +function swapendian_ppureal(d:ppureal):ppureal; + +type ppureal_bytes=array[0..sizeof(d)-1] of byte; + +var i:0..sizeof(d)-1; + +begin + for i:=low(ppureal_bytes) to high(ppureal_bytes) do + ppureal_bytes(swapendian_ppureal)[i]:=ppureal_bytes(d)[high(ppureal_bytes)-i]; +end; + + +{***************************************************************************** + TPPUFile +*****************************************************************************} + +constructor tppufile.Create(const fn:string); +begin + fname:=fn; + change_endian:=false; + crc_only:=false; + Mode:=0; + NewHeader; + Error:=false; + closed:=true; + tempclosed:=false; + getmem(buf,ppubufsize); +end; + + +destructor tppufile.destroy; +begin + closefile; + if assigned(buf) then + freemem(buf,ppubufsize); +end; + + +procedure tppufile.flush; +begin + if Mode=2 then + writebuf; +end; + + +procedure tppufile.closefile; +begin +{$ifdef Test_Double_checksum} + if mode=2 then + begin + if assigned(crc_test) then + dispose(crc_test); + if assigned(crc_test2) then + dispose(crc_test2); + end; +{$endif Test_Double_checksum} + if Mode<>0 then + begin + Flush; + f.Free; + Mode:=0; + closed:=true; + end; +end; + + +function tppufile.CheckPPUId:boolean; +begin + CheckPPUId:=((Header.Id[1]='P') and (Header.Id[2]='P') and (Header.Id[3]='U')); +end; + + +function tppufile.GetPPUVersion:integer; +var + l : integer; + code : integer; +begin + Val(header.ver[1]+header.ver[2]+header.ver[3],l,code); + if code=0 then + GetPPUVersion:=l + else + GetPPUVersion:=0; +end; + + +procedure tppufile.NewHeader; +var + s : string; +begin + fillchar(header,sizeof(tppuheader),0); + str(currentppuversion,s); + while length(s)<3 do + s:='0'+s; + with header do + begin + Id[1]:='P'; + Id[2]:='P'; + Id[3]:='U'; + Ver[1]:=s[1]; + Ver[2]:=s[2]; + Ver[3]:=s[3]; + end; +end; + + +{***************************************************************************** + TPPUFile Reading +*****************************************************************************} + +function tppufile.openfile:boolean; +var + i : integer; +begin + openfile:=false; + try + f:=CFileStreamClass.Create(fname,fmOpenRead) + except + exit; + end; + closed:=false; +{read ppuheader} + fsize:=f.Size; + if fsize<sizeof(tppuheader) then + exit; + i:=f.Read(header,sizeof(tppuheader)); + { The header is always stored in little endian order } + { therefore swap if on a big endian machine } +{$IFDEF ENDIAN_BIG} + header.compiler := swapendian(header.compiler); + header.cpu := swapendian(header.cpu); + header.target := swapendian(header.target); + header.flags := swapendian(header.flags); + header.size := swapendian(header.size); + header.checksum := swapendian(header.checksum); + header.interface_checksum := swapendian(header.interface_checksum); + header.indirect_checksum := swapendian(header.indirect_checksum); + header.deflistsize:=swapendian(header.deflistsize); + header.symlistsize:=swapendian(header.symlistsize); +{$ENDIF} + { the PPU DATA is stored in native order } + if (header.flags and uf_big_endian) = uf_big_endian then + Begin +{$IFDEF ENDIAN_LITTLE} + change_endian := TRUE; +{$ELSE} + change_endian := FALSE; +{$ENDIF} + End + else if (header.flags and uf_little_endian) = uf_little_endian then + Begin +{$IFDEF ENDIAN_BIG} + change_endian := TRUE; +{$ELSE} + change_endian := FALSE; +{$ENDIF} + End; +{reset buffer} + bufstart:=i; + bufsize:=0; + bufidx:=0; + Mode:=1; + FillChar(entry,sizeof(tppuentry),0); + entryidx:=0; + entrystart:=0; + entrybufstart:=0; + Error:=false; + openfile:=true; +end; + + +procedure tppufile.reloadbuf; +begin + inc(bufstart,bufsize); + bufsize:=f.Read(buf^,ppubufsize); + bufidx:=0; +end; + + +procedure tppufile.readdata(out b;len:integer); +var + p,pbuf : pchar; + left : integer; +begin + p:=pchar(@b); + pbuf:=@buf[bufidx]; + repeat + left:=bufsize-bufidx; + if len<left then + break; + move(pbuf^,p^,left); + dec(len,left); + inc(p,left); + reloadbuf; + pbuf:=@buf[bufidx]; + if bufsize=0 then + exit; + until false; + move(pbuf^,p^,len); + inc(bufidx,len); +end; + + +procedure tppufile.skipdata(len:integer); +var + left : integer; +begin + while len>0 do + begin + left:=bufsize-bufidx; + if len>left then + begin + dec(len,left); + reloadbuf; + if bufsize=0 then + exit; + end + else + begin + inc(bufidx,len); + exit; + end; + end; +end; + + +function tppufile.readentry:byte; +begin + if entryidx<entry.size then + begin +{$ifdef generic_cpu} + has_more:=true; +{$endif not generic_cpu} + skipdata(entry.size-entryidx); + end; + readdata(entry,sizeof(tppuentry)); + if change_endian then + entry.size:=swapendian(entry.size); + entrystart:=bufstart+bufidx; + entryidx:=0; +{$ifdef generic_cpu} + has_more:=false; +{$endif not generic_cpu} + if not(entry.id in [mainentryid,subentryid]) then + begin + readentry:=iberror; + error:=true; + exit; + end; + readentry:=entry.nr; +end; + + +function tppufile.endofentry:boolean; +begin +{$ifdef generic_cpu} + endofentry:=(entryidx=entry.size); +{$else not generic_cpu} + endofentry:=(entryidx>=entry.size); +{$endif not generic_cpu} +end; + + +function tppufile.entrysize:longint; +begin + entrysize:=entry.size; +end; + +function tppufile.entryleft:longint; +begin + entryleft:=entry.size-entryidx; +end; + + +procedure tppufile.getdatabuf(out b;len:integer;out res:integer); +begin + if entryidx+len>entry.size then + res:=entry.size-entryidx + else + res:=len; + readdata(b,res); + inc(entryidx,res); +end; + + +procedure tppufile.getdata(out b;len:integer); +begin + if entryidx+len>entry.size then + begin + error:=true; + exit; + end; + readdata(b,len); + inc(entryidx,len); +end; + + +function tppufile.getbyte:byte; +begin + if entryidx+1>entry.size then + begin + error:=true; + result:=0; + exit; + end; + if bufsize-bufidx>=1 then + begin + result:=pbyte(@buf[bufidx])^; + inc(bufidx); + end + else + readdata(result,1); + inc(entryidx); +end; + + +function tppufile.getword:word; +begin + if entryidx+2>entry.size then + begin + error:=true; + result:=0; + exit; + end; + if bufsize-bufidx>=sizeof(word) then + begin + result:=Unaligned(pword(@buf[bufidx])^); + inc(bufidx,sizeof(word)); + end + else + readdata(result,sizeof(word)); + if change_endian then + result:=swapendian(result); + inc(entryidx,2); +end; + + +function tppufile.getlongint:longint; +begin + if entryidx+4>entry.size then + begin + error:=true; + result:=0; + exit; + end; + if bufsize-bufidx>=sizeof(longint) then + begin + result:=Unaligned(plongint(@buf[bufidx])^); + inc(bufidx,sizeof(longint)); + end + else + readdata(result,sizeof(longint)); + if change_endian then + result:=swapendian(result); + inc(entryidx,4); +end; + + +function tppufile.getdword:dword; +begin + if entryidx+4>entry.size then + begin + error:=true; + result:=0; + exit; + end; + if bufsize-bufidx>=sizeof(dword) then + begin + result:=Unaligned(plongint(@buf[bufidx])^); + inc(bufidx,sizeof(longint)); + end + else + readdata(result,sizeof(dword)); + if change_endian then + result:=swapendian(result); + inc(entryidx,4); +end; + + +function tppufile.getint64:int64; +begin + if entryidx+8>entry.size then + begin + error:=true; + result:=0; + exit; + end; + if bufsize-bufidx>=sizeof(int64) then + begin + result:=Unaligned(pint64(@buf[bufidx])^); + inc(bufidx,sizeof(int64)); + end + else + readdata(result,sizeof(int64)); + if change_endian then + result:=swapendian(result); + inc(entryidx,8); +end; + + +function tppufile.getqword:qword; +begin + if entryidx+8>entry.size then + begin + error:=true; + result:=0; + exit; + end; + if bufsize-bufidx>=sizeof(qword) then + begin + result:=Unaligned(pqword(@buf[bufidx])^); + inc(bufidx,sizeof(qword)); + end + else + readdata(result,sizeof(qword)); + if change_endian then + result:=swapendian(result); + inc(entryidx,8); +end; + + +function tppufile.getaint:aint; +begin +{$ifdef generic_cpu} + if CpuAluBitSize[tsystemcpu(header.cpu)]=64 then + result:=getint64 + else if CpuAluBitSize[tsystemcpu(header.cpu)]=32 then + result:=getlongint + else if CpuAluBitSize[tsystemcpu(header.cpu)]=16 then + result:=smallint(getword) + else if CpuAluBitSize[tsystemcpu(header.cpu)]=8 then + result:=shortint(getbyte) + else + begin + error:=true; + result:=0; + end; +{$else not generic_cpu} +{$ifdef cpu64bitalu} + result:=getint64; +{$else cpu64bitalu} + result:=getlongint; +{$endif cpu64bitalu} +{$endif not generic_cpu} +end; + + +function tppufile.getasizeint:asizeint; +begin +{$ifdef generic_cpu} + if CpuAddrBitSize[tsystemcpu(header.cpu)]=64 then + result:=getint64 + else if CpuAddrBitSize[tsystemcpu(header.cpu)]=32 then + result:=getlongint + else if CpuAddrBitSize[tsystemcpu(header.cpu)]=16 then + result:=smallint(getword) + else + begin + error:=true; + result:=0; + end; +{$else not generic_cpu} +{$ifdef cpu64bitaddr} + result:=getint64; +{$else cpu64bitaddr} + result:=getlongint; +{$endif cpu32bitaddr} +{$endif not generic_cpu} +end; + + +function tppufile.getaword:aword; +begin +{$ifdef generic_cpu} + if CpuAluBitSize[tsystemcpu(header.cpu)]=64 then + result:=getqword + else if CpuAluBitSize[tsystemcpu(header.cpu)]=32 then + result:=getdword + else if CpuAluBitSize[tsystemcpu(header.cpu)]=16 then + result:=getword + else if CpuAluBitSize[tsystemcpu(header.cpu)]=8 then + result:=getbyte + else + begin + error:=true; + result:=0; + end; +{$else not generic_cpu} +{$ifdef cpu64bitalu} + result:=getqword; +{$else cpu64bitalu} + result:=getdword; +{$endif cpu64bitalu} +{$endif not generic_cpu} +end; + +function tppufile.getrealsize(sizeofreal : longint):ppureal; +var + e : ppureal; + d : double; + s : single; +begin + if sizeofreal=sizeof(e) then + begin + if entryidx+sizeof(e)>entry.size then + begin + error:=true; + result:=0; + exit; + end; + readdata(e,sizeof(e)); + if change_endian then + result:=swapendian_ppureal(e) + else + result:=e; + inc(entryidx,sizeof(e)); + exit; + end; + if sizeofreal=sizeof(d) then + begin + if entryidx+sizeof(d)>entry.size then + begin + error:=true; + result:=0; + exit; + end; + readdata(d,sizeof(d)); + if change_endian then + result:=swapendian(pqword(@d)^) + else + result:=d; + inc(entryidx,sizeof(d)); + result:=d; + exit; + end; + if sizeofreal=sizeof(s) then + begin + if entryidx+sizeof(s)>entry.size then + begin + error:=true; + result:=0; + exit; + end; + readdata(s,sizeof(s)); + if change_endian then + result:=swapendian(pdword(@s)^) + else + result:=s; + inc(entryidx,sizeof(s)); + result:=s; + exit; + end; + error:=true; + result:=0.0; +end; + +function tppufile.getreal:ppureal; +var + d : ppureal; + hd : double; +begin + if target_info.system=system_x86_64_win64 then + begin + hd:=getrealsize(sizeof(hd)); + getreal:=hd; + end + else + begin + d:=getrealsize(sizeof(d)); + getreal:=d; + end; +end; + + +function tppufile.getstring:string; +begin + result[0]:=chr(getbyte); + if entryidx+length(result)>entry.size then + begin + error:=true; + exit; + end; + ReadData(result[1],length(result)); + inc(entryidx,length(result)); +end; + + +function tppufile.getansistring: ansistring; +var + l : longint; +begin + l:=getlongint; + if entryidx+l>entry.size then + begin + error:=true; + exit; + end; + if l>0 then + begin + SetLength(Result,l); + ReadData(result[1],l); + end + else + Result:=''; + inc(entryidx,l); +end; + + +procedure tppufile.getsmallset(out b); +var + i : longint; +begin + getdata(b,4); + if change_endian then + for i:=0 to 3 do + Pbyte(@b)[i]:=reverse_byte(Pbyte(@b)[i]); +end; + + +procedure tppufile.getnormalset(out b); +var + i : longint; +begin + getdata(b,32); + if change_endian then + for i:=0 to 31 do + Pbyte(@b)[i]:=reverse_byte(Pbyte(@b)[i]); +end; + + +function tppufile.skipuntilentry(untilb:byte):boolean; +var + b : byte; +begin + repeat + b:=readentry; + until (b in [ibend,iberror]) or ((b=untilb) and (entry.id=mainentryid)); + skipuntilentry:=(b=untilb); +end; + + +{***************************************************************************** + TPPUFile Writing +*****************************************************************************} + +function tppufile.createfile:boolean; +var + ok: boolean; +begin + createfile:=false; +{$ifdef INTFPPU} + if crc_only then + begin + fname:=fname+'.intf'; + crc_only:=false; + end; +{$endif} + if not crc_only then + begin + {$ifdef MACOS} + {FPas is FreePascal's creator code on MacOS. See systems/mac_crea.txt} + SetDefaultMacOSCreator('FPas'); + SetDefaultMacOSFiletype('FPPU'); + {$endif} + ok:=false; + try + f:=CFileStreamClass.Create(fname,fmCreate); + ok:=true; + except + end; + {$ifdef MACOS} + SetDefaultMacOSCreator('MPS '); + SetDefaultMacOSFiletype('TEXT'); + {$endif} + if not ok then + exit; + Mode:=2; + {write header for sure} + f.Write(header,sizeof(tppuheader)); + end; + bufsize:=ppubufsize; + bufstart:=sizeof(tppuheader); + bufidx:=0; +{reset} + crc:=0; + interface_crc:=0; + indirect_crc:=0; + do_interface_crc:=true; + do_indirect_crc:=false; + Error:=false; + do_crc:=true; + size:=0; + entrytyp:=mainentryid; +{start} + NewEntry; + createfile:=true; +end; + + +procedure tppufile.writeheader; +var + opos : integer; +begin + if crc_only then + exit; + { flush buffer } + writebuf; + { update size (w/o header!) in the header } + header.size:=bufstart-sizeof(tppuheader); + { set the endian flag } +{$ifndef FPC_BIG_ENDIAN} + header.flags := header.flags or uf_little_endian; +{$else not FPC_BIG_ENDIAN} + header.flags := header.flags or uf_big_endian; + { Now swap the header in the correct endian (always little endian) } + header.compiler := swapendian(header.compiler); + header.cpu := swapendian(header.cpu); + header.target := swapendian(header.target); + header.flags := swapendian(header.flags); + header.size := swapendian(header.size); + header.checksum := swapendian(header.checksum); + header.interface_checksum := swapendian(header.interface_checksum); + header.indirect_checksum := swapendian(header.indirect_checksum); + header.deflistsize:=swapendian(header.deflistsize); + header.symlistsize:=swapendian(header.symlistsize); +{$endif not FPC_BIG_ENDIAN} +{ write header and restore filepos after it } + opos:=f.Position; + f.Position:=0; + f.Write(header,sizeof(tppuheader)); + f.Position:=opos; +end; + + +procedure tppufile.writebuf; +begin + if not crc_only and + (bufidx <> 0) then + f.Write(buf^,bufidx); + inc(bufstart,bufidx); + bufidx:=0; +end; + + +procedure tppufile.writedata(const b;len:integer); +var + p : pchar; + left, + idx : integer; +begin + if crc_only then + exit; + p:=pchar(@b); + idx:=0; + while len>0 do + begin + left:=bufsize-bufidx; + if len>left then + begin + move(p[idx],buf[bufidx],left); + dec(len,left); + inc(idx,left); + inc(bufidx,left); + writebuf; + end + else + begin + move(p[idx],buf[bufidx],len); + inc(bufidx,len); + exit; + end; + end; +end; + + +procedure tppufile.NewEntry; +begin + with entry do + begin + id:=entrytyp; + nr:=ibend; + size:=0; + end; +{Reset Entry State} + entryidx:=0; + entrybufstart:=bufstart; + entrystart:=bufstart+bufidx; +{Alloc in buffer} + writedata(entry,sizeof(tppuentry)); +end; + + +procedure tppufile.writeentry(ibnr:byte); +var + opos : integer; +begin +{create entry} + entry.id:=entrytyp; + entry.nr:=ibnr; + entry.size:=entryidx; +{it's already been sent to disk ?} + if entrybufstart<>bufstart then + begin + if not crc_only then + begin + {flush to be sure} + WriteBuf; + {write entry} + opos:=f.Position; + f.Position:=entrystart; + f.write(entry,sizeof(tppuentry)); + f.Position:=opos; + end; + entrybufstart:=bufstart; + end + else + move(entry,buf[entrystart-bufstart],sizeof(entry)); +{Add New Entry, which is ibend by default} + entrystart:=bufstart+bufidx; {next entry position} + NewEntry; +end; + + +procedure tppufile.putdata(const b;len:integer); +begin + if do_crc then + begin + crc:=UpdateCrc32(crc,b,len); +{$ifdef Test_Double_checksum} + if crc_only then + begin + crc_test2^[crc_index2]:=crc; +{$ifdef Test_Double_checksum_write} + Writeln(CRCFile,crc); +{$endif Test_Double_checksum_write} + if crc_index2<crc_array_size then + inc(crc_index2); + end + else + begin + if (crcindex2<crc_array_size) and (crcindex2<crc_index2) and + (crc_test2^[crcindex2]<>crc) then + Do_comment(V_Note,'impl CRC changed'); +{$ifdef Test_Double_checksum_write} + Writeln(CRCFile,crc); +{$endif Test_Double_checksum_write} + inc(crcindex2); + end; +{$endif def Test_Double_checksum} + if do_interface_crc then + begin + interface_crc:=UpdateCrc32(interface_crc,b,len); +{$ifdef Test_Double_checksum} + if crc_only then + begin + crc_test^[crc_index]:=interface_crc; +{$ifdef Test_Double_checksum_write} + Writeln(CRCFile,interface_crc); +{$endif Test_Double_checksum_write} + if crc_index<crc_array_size then + inc(crc_index); + end + else + begin + if (crcindex<crc_array_size) and (crcindex<crc_index) and + (crc_test^[crcindex]<>interface_crc) then + Do_comment(V_Warning,'CRC changed'); +{$ifdef Test_Double_checksum_write} + Writeln(CRCFile,interface_crc); +{$endif Test_Double_checksum_write} + inc(crcindex); + end; +{$endif def Test_Double_checksum} + { indirect crc must only be calculated for the interface; changes + to a class in the implementation cannot require another unit to + be recompiled } + if do_indirect_crc then + indirect_crc:=UpdateCrc32(indirect_crc,b,len); + end; + end; + if not crc_only then + writedata(b,len); + inc(entryidx,len); +end; + + +procedure tppufile.putbyte(b:byte); +begin + putdata(b,1); +end; + + +procedure tppufile.putword(w:word); +begin + putdata(w,2); +end; + + +procedure tppufile.putdword(w:dword); +begin + putdata(w,4); +end; + + +procedure tppufile.putlongint(l:longint); +begin + putdata(l,4); +end; + + +procedure tppufile.putint64(i:int64); +begin + putdata(i,8); +end; + + +procedure tppufile.putqword(q:qword); +begin + putdata(q,sizeof(qword)); +end; + + +procedure tppufile.putaint(i:aint); +begin + putdata(i,sizeof(aint)); +end; + + +procedure tppufile.putasizeint(i: asizeint); +begin + putdata(i,sizeof(asizeint)); +end; + + +procedure tppufile.putaword(i:aword); +begin + putdata(i,sizeof(aword)); +end; + + +procedure tppufile.putreal(d:ppureal); +var + hd : double; +begin + if target_info.system=system_x86_64_win64 then + begin + hd:=d; + putdata(hd,sizeof(hd)); + end + else + putdata(d,sizeof(ppureal)); +end; + + +procedure tppufile.putstring(const s:string); + begin + putdata(s,length(s)+1); + end; + + +procedure tppufile.putansistring(const s: ansistring); + var + l : longint; + begin + l:=length(s); + putdata(l,4); + if l>0 then + putdata(s[1],l); + end; + + +procedure tppufile.putsmallset(const b); + var + l : longint; + begin + l:=longint(b); + putlongint(l); + end; + + +procedure tppufile.putnormalset(const b); + begin + putdata(b,32); + end; + + +procedure tppufile.tempclose; + begin + if not closed then + begin + closepos:=f.Position; + f.Free; + f:=nil; + closed:=true; + tempclosed:=true; + end; + end; + + +function tppufile.tempopen:boolean; + begin + tempopen:=false; + if not closed or not tempclosed then + exit; + { MG: not sure, if this is correct + f.position:=0; + No, f was freed in tempclose above, we need to + recreate it. PM 2011/06/06 } + try + f:=CFileStreamClass.Create(fname,fmOpenRead); + except + exit; + end; + closed:=false; + tempclosed:=false; + + { restore state } + f.Position:=closepos; + tempopen:=true; + end; + +end. diff --git a/closures/compiler/ppx86_64.lpi b/closures/compiler/ppx86_64.lpi new file mode 100644 index 0000000000..7a64f54df6 --- /dev/null +++ b/closures/compiler/ppx86_64.lpi @@ -0,0 +1,82 @@ +<?xml version="1.0"?> +<CONFIG> + <ProjectOptions> + <Version Value="9"/> + <PathDelim Value="\"/> + <General> + <Flags> + <MainUnitHasUsesSectionForAllUnits Value="False"/> + <MainUnitHasCreateFormStatements Value="False"/> + <MainUnitHasTitleStatement Value="False"/> + <LRSInOutputDirectory Value="False"/> + </Flags> + <SessionStorage Value="InProjectDir"/> + <MainUnit Value="0"/> + <Title Value="pp"/> + </General> + <BuildModes Count="1"> + <Item1 Name="default" Default="True"/> + </BuildModes> + <PublishOptions> + <Version Value="2"/> + <DestinationDirectory Value="$(TestDir)\publishedproject\"/> + <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/> + <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/> + </PublishOptions> + <RunParams> + <local> + <FormatVersion Value="1"/> + <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> + </local> + </RunParams> + <Units Count="2"> + <Unit0> + <Filename Value="pp.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="pp"/> + </Unit0> + <Unit1> + <Filename Value="x86\aasmcpu.pas"/> + <IsPartOfProject Value="True"/> + <UnitName Value="aasmcpu"/> + </Unit1> + </Units> + </ProjectOptions> + <CompilerOptions> + <Version Value="10"/> + <PathDelim Value="\"/> + <Target> + <Filename Value="x86_64\pp"/> + </Target> + <SearchPaths> + <IncludeFiles Value="x86_64"/> + <OtherUnitFiles Value="x86_64;x86;systems"/> + <UnitOutputDirectory Value="x86_64\lazbuild"/> + </SearchPaths> + <Parsing> + <SyntaxOptions> + <CStyleOperator Value="False"/> + <AllowLabel Value="False"/> + <CPPInline Value="False"/> + <UseAnsiStrings Value="False"/> + </SyntaxOptions> + </Parsing> + <Linking> + <Debugging> + <GenerateDebugInfo Value="True"/> + </Debugging> + </Linking> + <Other> + <Verbosity> + <ShowWarn Value="False"/> + <ShowNotes Value="False"/> + <ShowHints Value="False"/> + </Verbosity> + <ConfigFile> + <StopAfterErrCount Value="50"/> + </ConfigFile> + <CustomOptions Value="-dx86_64"/> + <CompilerPath Value="$(CompPath)"/> + </Other> + </CompilerOptions> +</CONFIG> diff --git a/closures/compiler/procinfo.pas b/closures/compiler/procinfo.pas new file mode 100644 index 0000000000..e494b2d59d --- /dev/null +++ b/closures/compiler/procinfo.pas @@ -0,0 +1,292 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Information about the current procedure that is being compiled + + 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 procinfo; + +{$i fpcdefs.inc} + + interface + + uses + { common } + cclasses, + { global } + globtype,globals,verbose, + { symtable } + symconst,symtype,symdef,symsym, + { aasm } + cpubase,cpuinfo,cgbase,cgutils, + aasmbase,aasmtai,aasmdata, + optutils + ; + + const + inherited_inlining_flags : tprocinfoflags = + [pi_do_call, + { the stack frame can't be removed in this case } + pi_has_assembler_block, + pi_uses_exceptions]; + + + type + tsavedlabels = array[Boolean] of TAsmLabel; + + {# This object gives information on the current routine being + compiled. + } + tprocinfo = class(tlinkedlistitem) + private + { list to store the procinfo's of the nested procedures } + nestedprocs : tlinkedlist; + procedure addnestedproc(child: tprocinfo); + public + { pointer to parent in nested procedures } + parent : tprocinfo; + {# the definition of the routine itself } + procdef : tprocdef; + { procinfo of the main procedure that is inlining + the current function, only used in tcgcallnode.inlined_pass2 } + inlining_procinfo : tprocinfo; + { nested implicit finalzation procedure, used for platform-specific + exception handling } + finalize_procinfo : tprocinfo; + { file location of begin of procedure } + entrypos : tfileposinfo; + { file location of end of procedure } + exitpos : tfileposinfo; + { local switches at begin of procedure } + entryswitches : tlocalswitches; + { local switches at end of procedure } + exitswitches : tlocalswitches; + + { Size of the parameters on the stack } + para_stack_size : pint; + + { Offset of temp after para/local are allocated } + tempstart : longint; + + {# some collected informations about the procedure + see pi_xxxx constants above + } + flags : tprocinfoflags; + + { register used as frame pointer } + framepointer : tregister; + + { register containing currently the got } + got : tregister; + CurrGOTLabel : tasmlabel; + + { Holds the reference used to store all saved registers. } + save_regs_ref : treference; + + { Last assembler instruction of procedure prologue } + endprologue_ai : tlinkedlistitem; + + { Amount of stack adjustment after all alignments } + final_localsize : longint; + + { Labels for TRUE/FALSE condition, BREAK and CONTINUE } + CurrBreakLabel, + CurrContinueLabel, + CurrTrueLabel, + CurrFalseLabel : tasmlabel; + + { label to leave the sub routine } + CurrExitLabel : tasmlabel; + + {# The code for the routine itself, excluding entry and + exit code. This is a linked list of tai classes. + } + aktproccode : TAsmList; + { Data (like jump tables) that belongs to this routine } + aktlocaldata : TAsmList; + + { max. of space need for parameters } + maxpushedparasize : aint; + + constructor create(aparent:tprocinfo);virtual; + destructor destroy;override; + + procedure allocate_push_parasize(size:longint); + + function calc_stackframe_size:longint;virtual; + + { Set the address of the first temp, can be used to allocate + space for pushing parameters } + procedure set_first_temp_offset;virtual; + + { Generate parameter information } + procedure generate_parameter_info;virtual; + + { Allocate got register } + procedure allocate_got_register(list: TAsmList);virtual; + + { Destroy the entire procinfo tree, starting from the outermost parent } + procedure destroy_tree; + + { Store CurrTrueLabel and CurrFalseLabel to saved and generate new ones } + procedure save_jump_labels(out saved: tsavedlabels); + + { Restore CurrTrueLabel and CurrFalseLabel from saved } + procedure restore_jump_labels(const saved: tsavedlabels); + + function get_first_nestedproc: tprocinfo; + function has_nestedprocs: boolean; + + { Add to parent's list of nested procedures even if parent is a 'main' procedure } + procedure force_nested; + end; + tcprocinfo = class of tprocinfo; + + var + cprocinfo : tcprocinfo; + { information about the current sub routine being parsed (@var(pprocinfo))} + current_procinfo : tprocinfo; + + +implementation + + uses + cutils,systems, + tgobj,cgobj, + paramgr + ; + + +{**************************************************************************** + TProcInfo +****************************************************************************} + + constructor tprocinfo.create(aparent:tprocinfo); + begin + parent:=aparent; + procdef:=nil; + para_stack_size:=0; + flags:=[]; + framepointer:=NR_FRAME_POINTER_REG; + maxpushedparasize:=0; + { asmlists } + aktproccode:=TAsmList.Create; + aktlocaldata:=TAsmList.Create; + reference_reset(save_regs_ref,sizeof(aint)); + { labels } + current_asmdata.getjumplabel(CurrExitLabel); + current_asmdata.getjumplabel(CurrGOTLabel); + CurrBreakLabel:=nil; + CurrContinueLabel:=nil; + CurrTrueLabel:=nil; + CurrFalseLabel:=nil; + if Assigned(parent) and (parent.procdef.parast.symtablelevel>=normal_function_level) then + parent.addnestedproc(Self); + end; + + procedure tprocinfo.force_nested; + begin + if Assigned(parent) and (parent.procdef.parast.symtablelevel<normal_function_level) then + parent.addnestedproc(Self); + end; + + destructor tprocinfo.destroy; + begin + nestedprocs.free; + aktproccode.free; + aktlocaldata.free; + end; + + procedure tprocinfo.destroy_tree; + var + hp: tprocinfo; + begin + hp:=Self; + while Assigned(hp.parent) do + hp:=hp.parent; + hp.Free; + end; + + procedure tprocinfo.addnestedproc(child: tprocinfo); + begin + if nestedprocs=nil then + nestedprocs:=TLinkedList.Create; + nestedprocs.insert(child); + end; + + function tprocinfo.get_first_nestedproc: tprocinfo; + begin + if assigned(nestedprocs) then + result:=tprocinfo(nestedprocs.first) + else + result:=nil; + end; + + function tprocinfo.has_nestedprocs: boolean; + begin + result:=assigned(nestedprocs) and (nestedprocs.count>0); + end; + + procedure tprocinfo.save_jump_labels(out saved: tsavedlabels); + begin + saved[false]:=CurrFalseLabel; + saved[true]:=CurrTrueLabel; + current_asmdata.getjumplabel(CurrTrueLabel); + current_asmdata.getjumplabel(CurrFalseLabel); + end; + + procedure tprocinfo.restore_jump_labels(const saved: tsavedlabels); + begin + CurrFalseLabel:=saved[false]; + CurrTrueLabel:=saved[true]; + end; + + procedure tprocinfo.allocate_push_parasize(size:longint); + begin + if size>maxpushedparasize then + maxpushedparasize:=size; + end; + + + function tprocinfo.calc_stackframe_size:longint; + begin + result:=Align(tg.direction*tg.lasttemp,current_settings.alignment.localalignmin); + end; + + + procedure tprocinfo.set_first_temp_offset; + begin + end; + + + procedure tprocinfo.generate_parameter_info; + begin + { generate callee paraloc register info, it initialises the size that + is allocated on the stack } + procdef.init_paraloc_info(calleeside); + para_stack_size:=procdef.calleeargareasize; + end; + + + procedure tprocinfo.allocate_got_register(list: TAsmList); + begin + { most os/cpu combo's don't use this yet, so not yet abstract } + end; + + +end. diff --git a/closures/compiler/pstatmnt.pas b/closures/compiler/pstatmnt.pas new file mode 100644 index 0000000000..78eb251908 --- /dev/null +++ b/closures/compiler/pstatmnt.pas @@ -0,0 +1,1397 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Does the parsing of the statements + + 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 pstatmnt; + +{$i fpcdefs.inc} + +interface + + uses + tokens,node; + + + function statement_block(starttoken : ttoken) : tnode; + + { reads an assembler block } + function assembler_block : tnode; + + +implementation + + uses + { common } + cutils,cclasses, + { global } + globtype,globals,verbose,constexp, + systems, + { aasm } + cpubase,aasmbase,aasmtai,aasmdata, + { symtable } + symconst,symbase,symtype,symdef,symsym,symtable,defutil,defcmp, + paramgr,symutil, + { pass 1 } + pass_1,htypechk, + nutils,nbas,nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw, + { parser } + scanner, + pbase,pexpr, + { codegen } + procinfo,cgbase, + { assembler reader } + rabase, + { wide- and unicodestrings} + widestr + ; + + + function statement : tnode;forward; + + + function if_statement : tnode; + var + ex,if_a,else_a : tnode; + begin + consume(_IF); + ex:=comp_expr(true,false); + consume(_THEN); + if token<>_ELSE then + if_a:=statement + else + if_a:=nil; + + if try_to_consume(_ELSE) then + else_a:=statement + else + else_a:=nil; + result:=cifnode.create(ex,if_a,else_a); + end; + + { creates a block (list) of statements, til the next END token } + function statements_til_end : tnode; + + var + first,last : tstatementnode; + + begin + first:=nil; + while token<>_END do + begin + if first=nil then + begin + last:=cstatementnode.create(statement,nil); + first:=last; + end + else + begin + last.right:=cstatementnode.create(statement,nil); + last:=tstatementnode(last.right); + end; + if not try_to_consume(_SEMICOLON) then + break; + consume_emptystats; + end; + consume(_END); + statements_til_end:=cblocknode.create(first); + end; + + + function case_statement : tnode; + var + casedef : tdef; + caseexpr,p : tnode; + blockid : longint; + hl1,hl2 : TConstExprInt; + sl1,sl2 : tstringconstnode; + casedeferror, caseofstring : boolean; + casenode : tcasenode; + begin + consume(_CASE); + caseexpr:=comp_expr(true,false); + { determines result type } + do_typecheckpass(caseexpr); + { variants must be accepted, but first they must be converted to integer } + if caseexpr.resultdef.typ=variantdef then + begin + caseexpr:=ctypeconvnode.create_internal(caseexpr,sinttype); + do_typecheckpass(caseexpr); + end; + set_varstate(caseexpr,vs_read,[vsf_must_be_valid]); + casedeferror:=false; + casedef:=caseexpr.resultdef; + { case of string must be rejected in delphi-, } + { tp7/bp7-, mac-compatibility modes. } + caseofstring := + ([m_delphi, m_mac, m_tp7] * current_settings.modeswitches = []) and + is_string(casedef); + + if (not assigned(casedef)) or + ( not(is_ordinal(casedef)) and (not caseofstring) ) then + begin + CGMessage(type_e_ordinal_or_string_expr_expected); + { create a correct tree } + caseexpr.free; + caseexpr:=cordconstnode.create(0,u32inttype,false); + { set error flag so no rangechecks are done } + casedeferror:=true; + end; + { Create casenode } + casenode:=ccasenode.create(caseexpr); + consume(_OF); + { Parse all case blocks } + blockid:=0; + repeat + { maybe an instruction has more case labels } + repeat + p:=expr(true); + if is_widechar(casedef) then + begin + if (p.nodetype=rangen) then + begin + trangenode(p).left:=ctypeconvnode.create(trangenode(p).left,cwidechartype); + trangenode(p).right:=ctypeconvnode.create(trangenode(p).right,cwidechartype); + do_typecheckpass(trangenode(p).left); + do_typecheckpass(trangenode(p).right); + end + else + begin + p:=ctypeconvnode.create(p,cwidechartype); + do_typecheckpass(p); + end; + end + else + begin + if is_char(casedef) and is_widechar(p.resultdef) then + begin + if (p.nodetype=ordconstn) then + begin + p:=ctypeconvnode.create(p,cchartype); + do_typecheckpass(p); + end + else if (p.nodetype=rangen) then + begin + trangenode(p).left:=ctypeconvnode.create(trangenode(p).left,cchartype); + trangenode(p).right:=ctypeconvnode.create(trangenode(p).right,cchartype); + do_typecheckpass(trangenode(p).left); + do_typecheckpass(trangenode(p).right); + end; + end; + end; + hl1:=0; + hl2:=0; + sl1:=nil; + sl2:=nil; + if (p.nodetype=rangen) then + begin + { type check for string case statements } + if caseofstring and + is_conststring_or_constcharnode(trangenode(p).left) and + is_conststring_or_constcharnode(trangenode(p).right) then + begin + { we need stringconstnodes, even if expression contains single chars } + sl1 := get_string_value(trangenode(p).left, tstringdef(casedef)); + sl2 := get_string_value(trangenode(p).right, tstringdef(casedef)); + if sl1.fullcompare(sl2) > 0 then + CGMessage(parser_e_case_lower_less_than_upper_bound); + end + { type checking for ordinal case statements } + else if (not caseofstring) and + is_subequal(casedef, trangenode(p).left.resultdef) and + is_subequal(casedef, trangenode(p).right.resultdef) then + begin + hl1:=get_ordinal_value(trangenode(p).left); + hl2:=get_ordinal_value(trangenode(p).right); + if hl1>hl2 then + CGMessage(parser_e_case_lower_less_than_upper_bound); + if not casedeferror then + begin + testrange(casedef,hl1,false,false); + testrange(casedef,hl2,false,false); + end; + end + else + CGMessage(parser_e_case_mismatch); + + if caseofstring then + casenode.addlabel(blockid,sl1,sl2) + else + casenode.addlabel(blockid,hl1,hl2); + end + else + begin + { type check for string case statements } + if (caseofstring and (not is_conststring_or_constcharnode(p))) or + { type checking for ordinal case statements } + ((not caseofstring) and (not is_subequal(casedef, p.resultdef))) then + CGMessage(parser_e_case_mismatch); + + if caseofstring then + begin + sl1:=get_string_value(p, tstringdef(casedef)); + casenode.addlabel(blockid,sl1,sl1); + end + else + begin + hl1:=get_ordinal_value(p); + if not casedeferror then + testrange(casedef,hl1,false,false); + casenode.addlabel(blockid,hl1,hl1); + end; + end; + p.free; + sl1.free; + sl2.free; + + if token=_COMMA then + consume(_COMMA) + else + break; + until false; + consume(_COLON); + + { add instruction block } + casenode.addblock(blockid,statement); + + { next block } + inc(blockid); + + if not(token in [_ELSE,_OTHERWISE,_END]) then + consume(_SEMICOLON); + until (token in [_ELSE,_OTHERWISE,_END]); + + if (token in [_ELSE,_OTHERWISE]) then + begin + if not try_to_consume(_ELSE) then + consume(_OTHERWISE); + casenode.addelseblock(statements_til_end); + end + else + consume(_END); + + result:=casenode; + end; + + + function repeat_statement : tnode; + + var + first,last,p_e : tnode; + + begin + consume(_REPEAT); + first:=nil; + + while token<>_UNTIL do + begin + if first=nil then + begin + last:=cstatementnode.create(statement,nil); + first:=last; + end + else + begin + tstatementnode(last).right:=cstatementnode.create(statement,nil); + last:=tstatementnode(last).right; + end; + if not try_to_consume(_SEMICOLON) then + break; + consume_emptystats; + end; + consume(_UNTIL); + + first:=cblocknode.create(first); + p_e:=comp_expr(true,false); + result:=cwhilerepeatnode.create(p_e,first,false,true); + end; + + + function while_statement : tnode; + + var + p_e,p_a : tnode; + + begin + consume(_WHILE); + p_e:=comp_expr(true,false); + consume(_DO); + p_a:=statement; + result:=cwhilerepeatnode.create(p_e,p_a,true,false); + end; + + + function for_statement : tnode; + + procedure check_range(hp:tnode; fordef: tdef); + begin + if (hp.nodetype=ordconstn) and + (fordef.typ<>errordef) then + testrange(fordef,tordconstnode(hp).value,false,true); + end; + + function for_loop_create(hloopvar: tnode): tnode; + var + hp, + hblock, + hto,hfrom : tnode; + backward : boolean; + loopvarsym : tabstractvarsym; + begin + { Check loop variable } + loopvarsym:=nil; + + { variable must be an ordinal, int64 is not allowed for 32bit targets } + if not(is_ordinal(hloopvar.resultdef)) + {$ifndef cpu64bitaddr} + or is_64bitint(hloopvar.resultdef) + {$endif not cpu64bitaddr} + then + MessagePos(hloopvar.fileinfo,type_e_ordinal_expr_expected); + + hp:=hloopvar; + while assigned(hp) and + ( + { record/object fields and array elements are allowed } + { in tp7 mode only } + ( + (m_tp7 in current_settings.modeswitches) and + ( + ((hp.nodetype=subscriptn) and + ((tsubscriptnode(hp).left.resultdef.typ=recorddef) or + is_object(tsubscriptnode(hp).left.resultdef)) + ) or + { constant array index } + ( + (hp.nodetype=vecn) and + is_constintnode(tvecnode(hp).right) + ) + ) + ) or + { equal typeconversions } + ( + (hp.nodetype=typeconvn) and + (ttypeconvnode(hp).convtype=tc_equal) + ) + ) do + begin + { Use the recordfield for loopvarsym } + if not assigned(loopvarsym) and + (hp.nodetype=subscriptn) then + loopvarsym:=tsubscriptnode(hp).vs; + hp:=tunarynode(hp).left; + end; + + if assigned(hp) and + (hp.nodetype=loadn) then + begin + case tloadnode(hp).symtableentry.typ of + staticvarsym, + localvarsym, + paravarsym : + begin + { we need a simple loadn: + 1. The load must be in a global symtable or + in the same level as the para of the current proc. + 2. value variables (no const,out or var) + 3. No threadvar, readonly or typedconst + } + if ( + (tloadnode(hp).symtable.symtablelevel=main_program_level) or + (tloadnode(hp).symtable.symtablelevel=current_procinfo.procdef.parast.symtablelevel) + ) and + (tabstractvarsym(tloadnode(hp).symtableentry).varspez=vs_value) and + ([vo_is_thread_var,vo_is_typed_const] * tabstractvarsym(tloadnode(hp).symtableentry).varoptions=[]) then + begin + { Assigning for-loop variable is only allowed in tp7 and macpas } + if ([m_tp7,m_mac] * current_settings.modeswitches = []) then + begin + if not assigned(loopvarsym) then + loopvarsym:=tabstractvarsym(tloadnode(hp).symtableentry); + include(loopvarsym.varoptions,vo_is_loop_counter); + end; + end + else + begin + { Typed const is allowed in tp7 } + if not(m_tp7 in current_settings.modeswitches) or + not(vo_is_typed_const in tabstractvarsym(tloadnode(hp).symtableentry).varoptions) then + MessagePos(hp.fileinfo,type_e_illegal_count_var); + end; + end; + else + MessagePos(hp.fileinfo,type_e_illegal_count_var); + end; + end + else + MessagePos(hloopvar.fileinfo,type_e_illegal_count_var); + + hfrom:=comp_expr(true,false); + + if try_to_consume(_DOWNTO) then + backward:=true + else + begin + consume(_TO); + backward:=false; + end; + + hto:=comp_expr(true,false); + consume(_DO); + + { Check if the constants fit in the range } + check_range(hfrom,hloopvar.resultdef); + check_range(hto,hloopvar.resultdef); + + { first set the varstate for from and to, so + uses of loopvar in those expressions will also + trigger a warning when it is not used yet. This + needs to be done before the instruction block is + parsed to have a valid hloopvar } + typecheckpass(hfrom); + set_varstate(hfrom,vs_read,[vsf_must_be_valid]); + typecheckpass(hto); + set_varstate(hto,vs_read,[vsf_must_be_valid]); + typecheckpass(hloopvar); + { in two steps, because vs_readwritten may turn on vsf_must_be_valid } + { for some subnodes } + set_varstate(hloopvar,vs_written,[]); + set_varstate(hloopvar,vs_read,[vsf_must_be_valid]); + + { ... now the instruction block } + hblock:=statement; + + { variable is not used for loop counter anymore } + if assigned(loopvarsym) then + exclude(loopvarsym.varoptions,vo_is_loop_counter); + + result:=cfornode.create(hloopvar,hfrom,hto,hblock,backward); + end; + + + function for_in_loop_create(hloopvar: tnode): tnode; + var + expr: tnode; + begin + expr:=comp_expr(true,false); + + consume(_DO); + + set_varstate(hloopvar,vs_written,[]); + set_varstate(hloopvar,vs_read,[vsf_must_be_valid]); + + result:=create_for_in_loop(hloopvar,statement,expr); + + expr.free; + end; + + + var + hloopvar: tnode; + begin + { parse loop header } + consume(_FOR); + + hloopvar:=factor(false,false); + valid_for_loopvar(hloopvar,true); + + if try_to_consume(_ASSIGNMENT) then + result:=for_loop_create(hloopvar) + else if try_to_consume(_IN) then + result:=for_in_loop_create(hloopvar) + else + consume(_ASSIGNMENT); // fail + end; + + + function _with_statement : tnode; + + var + p : tnode; + i : longint; + st : TSymtable; + newblock : tblocknode; + newstatement : tstatementnode; + calltempnode, + tempnode : ttempcreatenode; + valuenode, + hp, + refnode : tnode; + hdef : tdef; + extendeddef : tabstractrecorddef; + helperdef : tobjectdef; + hasimplicitderef : boolean; + withsymtablelist : TFPObjectList; + + procedure pushobjchild(withdef,obj:tobjectdef); + var + parenthelperdef : tobjectdef; + begin + if not assigned(obj) then + exit; + pushobjchild(withdef,obj.childof); + { we need to look for helpers that were defined for the parent + class as well } + search_last_objectpascal_helper(obj,current_structdef,parenthelperdef); + { push the symtables of the helper's parents in reverse order } + if assigned(parenthelperdef) then + pushobjchild(withdef,parenthelperdef.childof); + { keep the original tobjectdef as owner, because that is used for + visibility of the symtable } + st:=twithsymtable.create(withdef,obj.symtable.SymList,refnode.getcopy); + symtablestack.push(st); + withsymtablelist.add(st); + { push the symtable of the helper } + if assigned(parenthelperdef) then + begin + st:=twithsymtable.create(withdef,parenthelperdef.symtable.SymList,refnode.getcopy); + symtablestack.push(st); + withsymtablelist.add(st); + end; + end; + + + begin + p:=comp_expr(true,false); + do_typecheckpass(p); + + if (p.nodetype=vecn) and + (nf_memseg in p.flags) then + CGMessage(parser_e_no_with_for_variable_in_other_segments); + + { "with procvar" can never mean anything, so always try + to call it in case it returns a record/object/... } + maybe_call_procvar(p,false); + + if (p.resultdef.typ in [objectdef,recorddef,classrefdef]) then + begin + newblock:=nil; + valuenode:=nil; + tempnode:=nil; + + { ignore nodes that don't add instructions in the tree } + hp:=p; + while { equal type conversions } + ( + (hp.nodetype=typeconvn) and + (ttypeconvnode(hp).convtype=tc_equal) + ) or + { constant array index } + ( + (hp.nodetype=vecn) and + (tvecnode(hp).right.nodetype=ordconstn) + ) do + hp:=tunarynode(hp).left; + if (hp.nodetype=loadn) and + ( + (tloadnode(hp).symtable=current_procinfo.procdef.localst) or + (tloadnode(hp).symtable=current_procinfo.procdef.parast) or + (tloadnode(hp).symtable.symtabletype in [staticsymtable,globalsymtable]) + ) and + { MacPas objects are mapped to classes, and the MacPas compilers + interpret with-statements with MacPas objects the same way + as records (the object referenced by the with-statement + must remain constant) + } + not(is_class(hp.resultdef) and + (m_mac in current_settings.modeswitches)) then + begin + { simple load, we can reference direct } + refnode:=p; + end + else + begin + calltempnode:=nil; + { complex load, load in temp first } + newblock:=internalstatements(newstatement); + { when we can't take the address of p, load it in a temp } + { since we may need its address later on } + if not valid_for_addr(p,false) then + begin + calltempnode:=ctempcreatenode.create(p.resultdef,p.resultdef.size,tt_persistent,true); + addstatement(newstatement,calltempnode); + addstatement(newstatement,cassignmentnode.create( + ctemprefnode.create(calltempnode), + p)); + p:=ctemprefnode.create(calltempnode); + typecheckpass(p); + end; + { several object types have implicit dereferencing } + hasimplicitderef:=is_implicit_pointer_object_type(p.resultdef) or + (p.resultdef.typ = classrefdef); + if hasimplicitderef then + hdef:=p.resultdef + else + hdef:=tpointerdef.create(p.resultdef); + { load address of the value in a temp } + tempnode:=ctempcreatenode.create_withnode(hdef,sizeof(pint),tt_persistent,true,p); + typecheckpass(tnode(tempnode)); + valuenode:=p; + refnode:=ctemprefnode.create(tempnode); + fillchar(refnode.fileinfo,sizeof(tfileposinfo),0); + { add address call for valuenode and deref for refnode if this + is not done implicitly } + if not hasimplicitderef then + begin + valuenode:=caddrnode.create_internal_nomark(valuenode); + refnode:=cderefnode.create(refnode); + fillchar(refnode.fileinfo,sizeof(tfileposinfo),0); + end; + addstatement(newstatement,tempnode); + addstatement(newstatement,cassignmentnode.create( + ctemprefnode.create(tempnode), + valuenode)); + typecheckpass(refnode); + end; + + { do we have a helper for this type? } + if p.resultdef.typ=classrefdef then + extendeddef:=tobjectdef(tclassrefdef(p.resultdef).pointeddef) + else + extendeddef:=tabstractrecorddef(p.resultdef); + search_last_objectpascal_helper(extendeddef,current_structdef,helperdef); + { Note: the symtable of the helper is pushed after the following + "case", the symtables of the helper's parents are passed in + the "case" branches } + + withsymtablelist:=TFPObjectList.create(true); + case p.resultdef.typ of + objectdef : + begin + { push symtables of all parents in reverse order } + pushobjchild(tobjectdef(p.resultdef),tobjectdef(p.resultdef).childof); + { push symtables of all parents of the helper in reverse order } + if assigned(helperdef) then + pushobjchild(helperdef,helperdef.childof); + { push object symtable } + st:=twithsymtable.Create(tobjectdef(p.resultdef),tobjectdef(p.resultdef).symtable.SymList,refnode); + symtablestack.push(st); + withsymtablelist.add(st); + end; + classrefdef : + begin + { push symtables of all parents in reverse order } + pushobjchild(tobjectdef(tclassrefdef(p.resultdef).pointeddef),tobjectdef(tclassrefdef(p.resultdef).pointeddef).childof); + { push symtables of all parents of the helper in reverse order } + if assigned(helperdef) then + pushobjchild(helperdef,helperdef.childof); + { push object symtable } + st:=twithsymtable.Create(tobjectdef(tclassrefdef(p.resultdef).pointeddef),tobjectdef(tclassrefdef(p.resultdef).pointeddef).symtable.SymList,refnode); + symtablestack.push(st); + withsymtablelist.add(st); + end; + recorddef : + begin + { push symtables of all parents of the helper in reverse order } + if assigned(helperdef) then + pushobjchild(helperdef,helperdef.childof); + { push record symtable } + st:=twithsymtable.create(trecorddef(p.resultdef),trecorddef(p.resultdef).symtable.SymList,refnode); + symtablestack.push(st); + withsymtablelist.add(st); + end; + else + internalerror(200601271); + end; + + { push helper symtable } + if assigned(helperdef) then + begin + st:=twithsymtable.Create(helperdef,helperdef.symtable.SymList,refnode.getcopy); + symtablestack.push(st); + withsymtablelist.add(st); + end; + + if try_to_consume(_COMMA) then + p:=_with_statement() + else + begin + consume(_DO); + if token<>_SEMICOLON then + p:=statement + else + p:=cnothingnode.create; + end; + + { remove symtables in reverse order from the stack } + for i:=withsymtablelist.count-1 downto 0 do + symtablestack.pop(TSymtable(withsymtablelist[i])); + withsymtablelist.free; + +// p:=cwithnode.create(right,twithsymtable(withsymtable),levelcount,refnode); + + { Finalize complex withnode with destroy of temp } + if assigned(newblock) then + begin + addstatement(newstatement,p); + if assigned(tempnode) then + addstatement(newstatement,ctempdeletenode.create(tempnode)); + if assigned(calltempnode) then + addstatement(newstatement,ctempdeletenode.create(calltempnode)); + p:=newblock; + end; + result:=p; + end + else + begin + p.free; + Message(parser_e_false_with_expr); + { try to recover from error } + if try_to_consume(_COMMA) then + begin + hp:=_with_statement(); + if (hp=nil) then; { remove warning about unused } + end + else + begin + consume(_DO); + { ignore all } + if token<>_SEMICOLON then + statement; + end; + result:=nil; + end; + end; + + + function with_statement : tnode; + begin + consume(_WITH); + with_statement:=_with_statement(); + end; + + + function raise_statement : tnode; + var + p,pobj,paddr,pframe : tnode; + begin + pobj:=nil; + paddr:=nil; + pframe:=nil; + consume(_RAISE); + if not(token in endtokens) then + begin + { object } + pobj:=comp_expr(true,false); + if try_to_consume(_AT) then + begin + paddr:=comp_expr(true,false); + if try_to_consume(_COMMA) then + pframe:=comp_expr(true,false); + end; + end + else + begin + if (block_type<>bt_except) then + Message(parser_e_no_reraise_possible); + end; + p:=craisenode.create(pobj,paddr,pframe); + raise_statement:=p; + end; + + + function try_statement : tnode; + var + p_try_block,p_finally_block,first,last, + p_default,p_specific,hp : tnode; + ot : tDef; + sym : tlocalvarsym; + old_block_type : tblock_type; + excepTSymtable : TSymtable; + objname,objrealname : TIDString; + srsym : tsym; + srsymtable : TSymtable; + t:ttoken; + unit_found:boolean; + oldcurrent_exceptblock: integer; + begin + p_default:=nil; + p_specific:=nil; + + { read statements to try } + consume(_TRY); + first:=nil; + inc(exceptblockcounter); + oldcurrent_exceptblock := current_exceptblock; + current_exceptblock := exceptblockcounter; + + while (token<>_FINALLY) and (token<>_EXCEPT) do + begin + if first=nil then + begin + last:=cstatementnode.create(statement,nil); + first:=last; + end + else + begin + tstatementnode(last).right:=cstatementnode.create(statement,nil); + last:=tstatementnode(last).right; + end; + if not try_to_consume(_SEMICOLON) then + break; + consume_emptystats; + end; + p_try_block:=cblocknode.create(first); + + if try_to_consume(_FINALLY) then + begin + inc(exceptblockcounter); + current_exceptblock := exceptblockcounter; + p_finally_block:=statements_til_end; + try_statement:=ctryfinallynode.create(p_try_block,p_finally_block); + end + else + begin + consume(_EXCEPT); + old_block_type:=block_type; + block_type:=bt_except; + inc(exceptblockcounter); + current_exceptblock := exceptblockcounter; + ot:=generrordef; + p_specific:=nil; + if (idtoken=_ON) then + { catch specific exceptions } + begin + repeat + consume(_ON); + if token=_ID then + begin + objname:=pattern; + objrealname:=orgpattern; + { can't use consume_sym here, because we need already + to check for the colon } + searchsym(objname,srsym,srsymtable); + consume(_ID); + { is a explicit name for the exception given ? } + if try_to_consume(_COLON) then + begin + consume_sym(srsym,srsymtable); + if (srsym.typ=typesym) and + is_class(ttypesym(srsym).typedef) then + begin + ot:=ttypesym(srsym).typedef; + sym:=tlocalvarsym.create(objrealname,vs_value,ot,[]); + end + else + begin + sym:=tlocalvarsym.create(objrealname,vs_value,generrordef,[]); + if (srsym.typ=typesym) then + Message1(type_e_class_type_expected,ttypesym(srsym).typedef.typename) + else + Message1(type_e_class_type_expected,ot.typename); + end; + excepTSymtable:=tstt_excepTSymtable.create; + excepTSymtable.insert(sym); + symtablestack.push(excepTSymtable); + end + else + begin + { check if type is valid, must be done here because + with "e: Exception" the e is not necessary } + + { support unit.identifier } + unit_found:=try_consume_unitsym(srsym,srsymtable,t,false); + if srsym=nil then + begin + identifier_not_found(orgpattern); + srsym:=generrorsym; + end; + if unit_found then + consume(t); + { check if type is valid, must be done here because + with "e: Exception" the e is not necessary } + if (srsym.typ=typesym) and + is_class(ttypesym(srsym).typedef) then + ot:=ttypesym(srsym).typedef + else + begin + ot:=generrordef; + if (srsym.typ=typesym) then + Message1(type_e_class_type_expected,ttypesym(srsym).typedef.typename) + else + Message1(type_e_class_type_expected,ot.typename); + end; + excepTSymtable:=nil; + end; + end + else + consume(_ID); + consume(_DO); + hp:=connode.create(nil,statement); + if ot.typ=errordef then + begin + hp.free; + hp:=cerrornode.create; + end; + if p_specific=nil then + begin + last:=hp; + p_specific:=last; + end + else + begin + tonnode(last).left:=hp; + last:=tonnode(last).left; + end; + { set the informations } + { only if the creation of the onnode was succesful, it's possible } + { that last and hp are errornodes (JM) } + if last.nodetype = onn then + begin + tonnode(last).excepttype:=tobjectdef(ot); + tonnode(last).excepTSymtable:=excepTSymtable; + end; + { remove exception symtable } + if assigned(excepTSymtable) then + begin + symtablestack.pop(excepTSymtable); + if last.nodetype <> onn then + excepTSymtable.free; + end; + if not try_to_consume(_SEMICOLON) then + break; + consume_emptystats; + until (token in [_END,_ELSE]); + if try_to_consume(_ELSE) then + begin + { catch the other exceptions } + p_default:=statements_til_end; + end + else + consume(_END); + end + else + begin + { catch all exceptions } + p_default:=statements_til_end; + end; + + block_type:=old_block_type; + try_statement:=ctryexceptnode.create(p_try_block,p_specific,p_default); + end; + current_exceptblock := oldcurrent_exceptblock; + end; + + + function _asm_statement : tnode; + var + asmstat : tasmnode; + Marker : tai; + reg : tregister; + asmreader : tbaseasmreader; + begin + Inside_asm_statement:=true; + if assigned(asmmodeinfos[current_settings.asmmode]) then + begin + asmreader:=asmmodeinfos[current_settings.asmmode]^.casmreader.create; + asmstat:=casmnode.create(asmreader.assemble as TAsmList); + asmreader.free; + end + else + Message(parser_f_assembler_reader_not_supported); + + { Mark procedure that it has assembler blocks } + include(current_procinfo.flags,pi_has_assembler_block); + + { Read first the _ASM statement } + consume(_ASM); + + { END is read, got a list of changed registers? } + if try_to_consume(_LECKKLAMMER) then + begin +{$ifdef cpunofpu} + asmstat.used_regs_fpu:=[0..first_int_imreg-1]; +{$else cpunofpu} + asmstat.used_regs_fpu:=[0..first_fpu_imreg-1]; +{$endif cpunofpu} + if token<>_RECKKLAMMER then + begin + if po_assembler in current_procinfo.procdef.procoptions then + Message(parser_w_register_list_ignored); + repeat + { it's possible to specify the modified registers } + reg:=std_regnum_search(lower(cstringpattern)); + if reg<>NR_NO then + begin + if (getregtype(reg)=R_INTREGISTER) and not(po_assembler in current_procinfo.procdef.procoptions) then + include(asmstat.used_regs_int,getsupreg(reg)); + end + else + Message(asmr_e_invalid_register); + consume(_CSTRING); + if not try_to_consume(_COMMA) then + break; + until false; + end; + consume(_RECKKLAMMER); + end + else + begin + asmstat.used_regs_int:=paramanager.get_volatile_registers_int(current_procinfo.procdef.proccalloption); + asmstat.used_regs_fpu:=paramanager.get_volatile_registers_fpu(current_procinfo.procdef.proccalloption); + end; + + { mark the start and the end of the assembler block + this is needed for the optimizer } + If Assigned(AsmStat.p_asm) Then + Begin + Marker := Tai_Marker.Create(mark_AsmBlockStart); + AsmStat.p_asm.Insert(Marker); + Marker := Tai_Marker.Create(mark_AsmBlockEnd); + AsmStat.p_asm.Concat(Marker); + End; + Inside_asm_statement:=false; + _asm_statement:=asmstat; + end; + + + function statement : tnode; + var + p, + code : tnode; + filepos : tfileposinfo; + srsym : tsym; + srsymtable : TSymtable; + s : TIDString; + begin + filepos:=current_tokenpos; + case token of + _GOTO : + begin + if not(cs_support_goto in current_settings.moduleswitches) then + Message(sym_e_goto_and_label_not_supported); + consume(_GOTO); + if (token<>_INTCONST) and (token<>_ID) then + begin + Message(sym_e_label_not_found); + code:=cerrornode.create; + end + else + begin + if token=_ID then + consume_sym(srsym,srsymtable) + else + begin + if token<>_INTCONST then + internalerror(201008021); + + { strip leading 0's in iso mode } + if m_iso in current_settings.modeswitches then + while pattern[1]='0' do + delete(pattern,1,1); + + searchsym(pattern,srsym,srsymtable); + if srsym=nil then + begin + identifier_not_found(pattern); + srsym:=generrorsym; + srsymtable:=nil; + end; + consume(token); + end; + + if srsym.typ<>labelsym then + begin + Message(sym_e_id_is_no_label_id); + code:=cerrornode.create; + end + else + begin + { goto outside the current scope? } + if srsym.owner<>current_procinfo.procdef.localst then + begin + { allowed? } + if not(m_non_local_goto in current_settings.modeswitches) then + Message(parser_e_goto_outside_proc); + end; + code:=cgotonode.create(tlabelsym(srsym)); + tgotonode(code).labelsym:=tlabelsym(srsym); + { set flag that this label is used } + tlabelsym(srsym).used:=true; + end; + end; + end; + _BEGIN : + code:=statement_block(_BEGIN); + _IF : + code:=if_statement; + _CASE : + code:=case_statement; + _REPEAT : + code:=repeat_statement; + _WHILE : + code:=while_statement; + _FOR : + code:=for_statement; + _WITH : + code:=with_statement; + _TRY : + code:=try_statement; + _RAISE : + code:=raise_statement; + { semicolons,else until and end are ignored } + _SEMICOLON, + _ELSE, + _UNTIL, + _END: + code:=cnothingnode.create; + _FAIL : + begin + if (current_procinfo.procdef.proctypeoption<>potype_constructor) then + Message(parser_e_fail_only_in_constructor); + consume(_FAIL); + code:=call_fail_node; + end; + _ASM : + code:=_asm_statement; + _EOF : + Message(scan_f_end_of_file); + else + begin + { don't typecheck yet, because that will also simplify, which may + result in not detecting certain kinds of syntax errors -- + see mantis #15594 } + p:=expr(false); + { save the pattern here for latter usage, the label could be "000", + even if we read an expression, the pattern is still valid if it's really + a label (FK) + if you want to mess here, take care of + tests/webtbs/tw3546.pp + } + s:=pattern; + + { When a colon follows a intconst then transform it into a label } + if (p.nodetype=ordconstn) and + try_to_consume(_COLON) then + begin + { in iso mode, 0003: is equal to 3: } + if m_iso in current_settings.modeswitches then + searchsym(tostr(tordconstnode(p).value),srsym,srsymtable) + else + searchsym(s,srsym,srsymtable); + p.free; + + if assigned(srsym) and + (srsym.typ=labelsym) then + begin + if tlabelsym(srsym).defined then + Message(sym_e_label_already_defined); + if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then + begin + tlabelsym(srsym).nonlocal:=true; + exclude(current_procinfo.procdef.procoptions,po_inline); + end; + if tlabelsym(srsym).nonlocal and + (current_procinfo.procdef.proctypeoption in [potype_unitinit,potype_unitfinalize]) then + Message(sym_e_interprocgoto_into_init_final_code_not_allowed); + + tlabelsym(srsym).defined:=true; + p:=clabelnode.create(nil,tlabelsym(srsym)); + tlabelsym(srsym).code:=p; + end + else + begin + Message1(sym_e_label_used_and_not_defined,s); + p:=cnothingnode.create; + end; + end; + + if p.nodetype=labeln then + begin + { the pointer to the following instruction } + { isn't a very clean way } + if token in endtokens then + tlabelnode(p).left:=cnothingnode.create + else + tlabelnode(p).left:=statement(); + { be sure to have left also typecheckpass } + typecheckpass(tlabelnode(p).left); + end + else + + { change a load of a procvar to a call. this is also + supported in fpc mode } + if p.nodetype in [vecn,derefn,typeconvn,subscriptn,loadn] then + maybe_call_procvar(p,false); + + { blockn support because a read/write is changed into a blocknode } + { with a separate statement for each read/write operation (JM) } + { the same is true for val() if the third parameter is not 32 bit } + if not(p.nodetype in [nothingn,errorn,calln,ifn,assignn,breakn,inlinen, + continuen,labeln,blockn,exitn]) or + ((p.nodetype=inlinen) and + not is_void(p.resultdef)) or + ((p.nodetype=calln) and + (assigned(tcallnode(p).procdefinition)) and + (tcallnode(p).procdefinition.proctypeoption=potype_operator)) then + Message(parser_e_illegal_expression); + + if not assigned(p.resultdef) then + do_typecheckpass(p); + + { Specify that we don't use the value returned by the call. + This is used for : + - dispose of temp stack space + - dispose on FPU stack + - extended syntax checking } + if (p.nodetype=calln) then + begin + exclude(tcallnode(p).callnodeflags,cnf_return_value_used); + + { in $x- state, the function result must not be ignored } + if not(cs_extsyntax in current_settings.moduleswitches) and + not(is_void(p.resultdef)) and + { can be nil in case there was an error in the expression } + assigned(tcallnode(p).procdefinition) and + not((tcallnode(p).procdefinition.proctypeoption=potype_constructor) and + is_object(tprocdef(tcallnode(p).procdefinition).struct)) then + Message(parser_e_illegal_expression); + end; + code:=p; + end; + end; + if assigned(code) then + begin + typecheckpass(code); + code.fileinfo:=filepos; + end; + statement:=code; + end; + + + function statement_block(starttoken : ttoken) : tnode; + + var + first,last : tnode; + filepos : tfileposinfo; + + begin + first:=nil; + filepos:=current_tokenpos; + consume(starttoken); + + while not(token in [_END,_FINALIZATION]) do + begin + if first=nil then + begin + last:=cstatementnode.create(statement,nil); + first:=last; + end + else + begin + tstatementnode(last).right:=cstatementnode.create(statement,nil); + last:=tstatementnode(last).right; + end; + if (token in [_END,_FINALIZATION]) then + break + else + begin + { if no semicolon, then error and go on } + if token<>_SEMICOLON then + begin + consume(_SEMICOLON); + consume_all_until(_SEMICOLON); + end; + consume(_SEMICOLON); + end; + consume_emptystats; + end; + + { don't consume the finalization token, it is consumed when + reading the finalization block, but allow it only after + an initalization ! } + if (starttoken<>_INITIALIZATION) or (token<>_FINALIZATION) then + consume(_END); + + last:=cblocknode.create(first); + last.fileinfo:=filepos; + statement_block:=last; + end; + + + function assembler_block : tnode; + var + p : tnode; +{$ifndef arm} + locals : longint; +{$endif arm} + srsym : tsym; + begin + { Rename the funcret so that recursive calls are possible } + if not is_void(current_procinfo.procdef.returndef) then + begin + srsym:=TSym(current_procinfo.procdef.localst.Find(current_procinfo.procdef.procsym.name)); + if assigned(srsym) then + srsym.realname:='$hiddenresult'; + end; + + { delphi uses register calling for assembler methods } + if (m_delphi in current_settings.modeswitches) and + (po_assembler in current_procinfo.procdef.procoptions) and + not(po_hascallingconvention in current_procinfo.procdef.procoptions) then + current_procinfo.procdef.proccalloption:=pocall_register; + + { force the asm statement } + if token<>_ASM then + consume(_ASM); + include(current_procinfo.flags,pi_is_assembler); + p:=_asm_statement; + +{$if not(defined(sparc)) and not(defined(arm)) and not(defined(avr))} + if (po_assembler in current_procinfo.procdef.procoptions) then + begin + { set the framepointer to esp for assembler functions when the + following conditions are met: + - if the are no local variables and parameters (except the allocated result) + - no reference to the result variable (refcount<=1) + - result is not stored as parameter + - target processor has optional frame pointer save + (vm, i386, vm only currently) + } + locals:=tabstractlocalsymtable(current_procinfo.procdef.parast).count_locals; + if (current_procinfo.procdef.localst.symtabletype=localsymtable) then + inc(locals,tabstractlocalsymtable(current_procinfo.procdef.localst).count_locals); + if (locals=0) and + not (current_procinfo.procdef.owner.symtabletype in [ObjectSymtable,recordsymtable]) and + (not assigned(current_procinfo.procdef.funcretsym) or + (tabstractvarsym(current_procinfo.procdef.funcretsym).refs<=1)) and + not(paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef.proccalloption)) then + begin + { Only need to set the framepointer, the locals will + be inserted with the correct reference in tcgasmnode.pass_generate_code } + current_procinfo.framepointer:=NR_STACK_POINTER_REG; + end; + end; +{$endif not(defined(sparc)) and not(defined(arm)) and not(defined(avr))} + + { Flag the result as assigned when it is returned in a + register. + } + if assigned(current_procinfo.procdef.funcretsym) and + (not paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef.proccalloption)) then + tabstractvarsym(current_procinfo.procdef.funcretsym).varstate:=vs_initialised; + + { because the END is already read we need to get the + last_endtoken_filepos here (PFV) } + last_endtoken_filepos:=current_tokenpos; + + assembler_block:=p; + end; + +end. diff --git a/closures/compiler/psub.pas b/closures/compiler/psub.pas new file mode 100644 index 0000000000..f3d681889e --- /dev/null +++ b/closures/compiler/psub.pas @@ -0,0 +1,2073 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl, Daniel Mantione + + Does the parsing and codegeneration at subroutine level + + 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 psub; + +{$i fpcdefs.inc} + +interface + + uses + cclasses,globals, + node,nbas, + symdef,procinfo,optdfa; + + type + tcgprocinfo = class(tprocinfo) + private + procedure maybe_add_constructor_wrapper(var tocode: tnode; withexceptblock: boolean); + procedure add_entry_exit_code; + procedure setup_tempgen; + public + { code for the subroutine as tree } + code : tnode; + { positions in the tree for init/final } + entry_asmnode, + loadpara_asmnode, + exitlabel_asmnode, + stackcheck_asmnode, + init_asmnode, + final_asmnode : tasmnode; + dfabuilder : TDFABuilder; + destructor destroy;override; + procedure printproc(pass:string); + procedure generate_code; + procedure generate_code_tree; + procedure generate_exceptfilter(nestedpi: tcgprocinfo); + procedure resetprocdef; + procedure add_to_symtablestack; + procedure remove_from_symtablestack; + procedure parse_body; + + function has_assembler_child : boolean; + end; + + + procedure printnode_reset; + + { reads the declaration blocks } + procedure read_declarations(islibrary : boolean); + + { reads declarations in the interface part of a unit } + procedure read_interface_declarations; + + procedure generate_specialization_procs; + + +implementation + + uses + sysutils, + { common } + cutils, + { global } + globtype,tokens,verbose,comphook,constexp, + systems, + { aasm } + cpuinfo,cpubase,aasmbase,aasmtai,aasmdata, + { symtable } + symconst,symbase,symsym,symtype,symtable,defutil, + paramgr, + ppu,fmodule, + { pass 1 } + nutils,nld,ncal,ncon,nflw,nadd,ncnv,nmem, + pass_1, + {$ifdef state_tracking} + nstate, + {$endif state_tracking} + { pass 2 } +{$ifndef NOPASS2} + pass_2, +{$endif} + { parser } + scanner,import,gendef, + pbase,pstatmnt,pdecl,pdecsub,pexports, + { codegen } + tgobj,cgbase,cgobj,cgcpu,dbgbase, + ncgutil,regvars, + optbase, + opttail, + optcse,optloop, + optutils +{$if defined(arm) or defined(powerpc) or defined(powerpc64) or defined(avr)} + ,aasmcpu +{$endif arm} + {$ifndef NOOPT} + {$ifdef i386} + ,aopt386 + {$else i386} + ,aopt + {$endif i386} + {$endif} + ; + +{**************************************************************************** + PROCEDURE/FUNCTION BODY PARSING +****************************************************************************} + + procedure initializevars(p:TObject;arg:pointer); + var + b : tblocknode; + begin + if not (tsym(p).typ in [localvarsym,staticvarsym]) then + exit; + with tabstractnormalvarsym(p) do + begin + if assigned(defaultconstsym) then + begin + b:=tblocknode(arg); + b.left:=cstatementnode.create( + cassignmentnode.create( + cloadnode.create(tsym(p),tsym(p).owner), + cloadnode.create(defaultconstsym,defaultconstsym.owner)), + b.left); + end; + end; + end; + + + procedure check_finalize_paras(p:TObject;arg:pointer); + begin + if (tsym(p).typ=paravarsym) and + tparavarsym(p).needs_finalization then + include(current_procinfo.flags,pi_needs_implicit_finally); + end; + + + procedure check_finalize_locals(p:TObject;arg:pointer); + begin + { include the result: it needs to be finalized in case an exception } + { occurs } + if (tsym(p).typ=localvarsym) and + (tlocalvarsym(p).refs>0) and + is_managed_type(tlocalvarsym(p).vardef) then + include(current_procinfo.flags,pi_needs_implicit_finally); + end; + + + function block(islibrary : boolean) : tnode; + var + oldfilepos: tfileposinfo; + begin + { parse const,types and vars } + read_declarations(islibrary); + + { do we have an assembler block without the po_assembler? + we should allow this for Delphi compatibility (PFV) } + if (token=_ASM) and (m_delphi in current_settings.modeswitches) then + include(current_procinfo.procdef.procoptions,po_assembler); + + { Handle assembler block different } + if (po_assembler in current_procinfo.procdef.procoptions) then + begin + block:=assembler_block; + exit; + end; + + {Unit initialization?.} + if ( + assigned(current_procinfo.procdef.localst) and + (current_procinfo.procdef.localst.symtablelevel=main_program_level) and + (current_module.is_unit or islibrary) + ) then + begin + if (token=_END) then + begin + consume(_END); + { We need at least a node, else the entry/exit code is not + generated and thus no PASCALMAIN symbol which we need (PFV) } + if islibrary then + block:=cnothingnode.create + else + block:=nil; + end + else + begin + if token=_INITIALIZATION then + begin + { The library init code is already called and does not + need to be in the initfinal table (PFV) } + block:=statement_block(_INITIALIZATION); + end + else if token=_FINALIZATION then + begin + { when a unit has only a finalization section, we can come to this + point when we try to read the nonh existing initalization section + so we've to check if we are really try to parse the finalization } + if current_procinfo.procdef.proctypeoption=potype_unitfinalize then + block:=statement_block(_FINALIZATION) + else + block:=nil; + end + else + block:=statement_block(_BEGIN); + end; + end + else + begin + block:=statement_block(_BEGIN); + if current_procinfo.procdef.localst.symtabletype=localsymtable then + begin + { initialization of local variables with their initial + values: part of function entry } + oldfilepos:=current_filepos; + current_filepos:=current_procinfo.entrypos; + current_procinfo.procdef.localst.SymList.ForEachCall(@initializevars,block); + current_filepos:=oldfilepos; + end; + end; + end; + + +{**************************************************************************** + PROCEDURE/FUNCTION COMPILING +****************************************************************************} + + procedure printnode_reset; + begin + assign(printnodefile,treelogfilename); + {$push}{$I-} + rewrite(printnodefile); + {$pop} + if ioresult<>0 then + begin + Comment(V_Error,'Error creating '+treelogfilename); + exit; + end; + close(printnodefile); + end; + + + procedure add_label_init(p:TObject;arg:pointer); + begin + if tstoredsym(p).typ=labelsym then + begin + addstatement(tstatementnode(arg^), + cifnode.create(caddnode.create(equaln, + ccallnode.createintern('fpc_setjmp', + ccallparanode.create(cloadnode.create(tlabelsym(p).jumpbuf,tlabelsym(p).jumpbuf.owner),nil)), + cordconstnode.create(1,sinttype,true)) + ,cgotonode.create(tlabelsym(p)),nil) + ); + end; + end; + + + function generate_bodyentry_block:tnode; + var + srsym : tsym; + para : tcallparanode; + newstatement : tstatementnode; + begin + result:=internalstatements(newstatement); + + if assigned(current_structdef) then + begin + { a constructor needs a help procedure } + if (current_procinfo.procdef.proctypeoption=potype_constructor) then + begin + if is_class(current_structdef) then + begin + srsym:=search_struct_member(current_structdef,'NEWINSTANCE'); + if assigned(srsym) and + (srsym.typ=procsym) then + begin + { if vmt>1 then newinstance } + addstatement(newstatement,cifnode.create( + caddnode.create(gtn, + ctypeconvnode.create_internal( + load_vmt_pointer_node, + voidpointertype), + cpointerconstnode.create(1,voidpointertype)), + cassignmentnode.create( + ctypeconvnode.create_internal( + load_self_pointer_node, + voidpointertype), + ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_vmt_pointer_node,[])), + nil)); + end + else + internalerror(200305108); + end + else + if is_object(current_structdef) then + begin + { parameter 3 : vmt_offset } + { parameter 2 : address of pointer to vmt, + this is required to allow setting the vmt to -1 to indicate + that memory was allocated } + { parameter 1 : self pointer } + para:=ccallparanode.create( + cordconstnode.create(tobjectdef(current_structdef).vmt_offset,s32inttype,false), + ccallparanode.create( + ctypeconvnode.create_internal( + load_vmt_pointer_node, + voidpointertype), + ccallparanode.create( + ctypeconvnode.create_internal( + load_self_pointer_node, + voidpointertype), + nil))); + addstatement(newstatement,cassignmentnode.create( + ctypeconvnode.create_internal( + load_self_pointer_node, + voidpointertype), + ccallnode.createintern('fpc_help_constructor',para))); + end + else + if not is_record(current_structdef) then + internalerror(200305103); + { if self=nil then exit + calling fail instead of exit is useless because + there is nothing to dispose (PFV) } + if is_class_or_object(current_structdef) then + addstatement(newstatement,cifnode.create( + caddnode.create(equaln, + load_self_pointer_node, + cnilnode.create), + cexitnode.create(nil), + nil)); + end; + + { maybe call BeforeDestruction for classes } + if (current_procinfo.procdef.proctypeoption=potype_destructor) and + is_class(current_structdef) then + begin + srsym:=search_struct_member(current_structdef,'BEFOREDESTRUCTION'); + if assigned(srsym) and + (srsym.typ=procsym) then + begin + { if vmt>0 then beforedestruction } + addstatement(newstatement,cifnode.create( + caddnode.create(gtn, + ctypeconvnode.create_internal( + load_vmt_pointer_node,ptrsinttype), + ctypeconvnode.create_internal( + cnilnode.create,ptrsinttype)), + ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node,[]), + nil)); + end + else + internalerror(200305104); + end; + end; + if m_non_local_goto in current_settings.modeswitches then + tsymtable(current_procinfo.procdef.localst).SymList.ForEachCall(@add_label_init,@newstatement); + end; + + + function generate_bodyexit_block:tnode; + var + srsym : tsym; + para : tcallparanode; + newstatement : tstatementnode; + oldlocalswitches: tlocalswitches; + begin + result:=internalstatements(newstatement); + + if assigned(current_structdef) then + begin + { Don't test self and the vmt here. The reason is that } + { a constructor already checks whether these are valid } + { before. Further, in case of TThread the thread may } + { free the class instance right after AfterConstruction } + { has been called, so it may no longer be valid (JM) } + oldlocalswitches:=current_settings.localswitches; + current_settings.localswitches:=oldlocalswitches-[cs_check_object,cs_check_range]; + + { a destructor needs a help procedure } + if (current_procinfo.procdef.proctypeoption=potype_destructor) then + begin + if is_class(current_structdef) then + begin + srsym:=search_struct_member(current_structdef,'FREEINSTANCE'); + if assigned(srsym) and + (srsym.typ=procsym) then + begin + { if self<>0 and vmt<>0 then freeinstance } + addstatement(newstatement,cifnode.create( + caddnode.create(andn, + caddnode.create(unequaln, + load_self_pointer_node, + cnilnode.create), + caddnode.create(unequaln, + ctypeconvnode.create( + load_vmt_pointer_node, + voidpointertype), + cpointerconstnode.create(0,voidpointertype))), + ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node,[]), + nil)); + end + else + internalerror(200305108); + end + else + if is_object(current_structdef) then + begin + { finalize object data, but only if not in inherited call } + if is_managed_type(current_structdef) then + begin + addstatement(newstatement,cifnode.create( + caddnode.create(unequaln, + ctypeconvnode.create_internal(load_vmt_pointer_node,voidpointertype), + cnilnode.create), + finalize_data_node(load_self_node), + nil)); + end; + { parameter 3 : vmt_offset } + { parameter 2 : pointer to vmt } + { parameter 1 : self pointer } + para:=ccallparanode.create( + cordconstnode.create(tobjectdef(current_structdef).vmt_offset,s32inttype,false), + ccallparanode.create( + ctypeconvnode.create_internal( + load_vmt_pointer_node, + voidpointertype), + ccallparanode.create( + ctypeconvnode.create_internal( + load_self_pointer_node, + voidpointertype), + nil))); + addstatement(newstatement, + ccallnode.createintern('fpc_help_destructor',para)); + end + else + internalerror(200305105); + end; + current_settings.localswitches:=oldlocalswitches; + end; + end; + + + function generate_except_block:tnode; + var + newstatement : tstatementnode; + begin + generate_except_block:=internalstatements(newstatement); + + { a constructor needs call destructor (if available) when it + is not inherited } + if not assigned(current_structdef) or + (current_procinfo.procdef.proctypeoption<>potype_constructor) then + begin + { no constructor } + { must be the return value finalized before reraising the exception? } + if (not is_void(current_procinfo.procdef.returndef)) and + is_managed_type(current_procinfo.procdef.returndef) and + (not paramanager.ret_in_param(current_procinfo.procdef.returndef, current_procinfo.procdef.proccalloption)) and + (not is_class(current_procinfo.procdef.returndef)) then + addstatement(newstatement,finalize_data_node(load_result_node)); + end; + end; + + +{**************************************************************************** + TCGProcInfo +****************************************************************************} + + destructor tcgprocinfo.destroy; + begin + if assigned(code) then + code.free; + inherited destroy; + end; + + + procedure tcgprocinfo.printproc(pass:string); + begin + assign(printnodefile,treelogfilename); + {$push}{$I-} + append(printnodefile); + if ioresult<>0 then + rewrite(printnodefile); + {$pop} + if ioresult<>0 then + begin + Comment(V_Error,'Error creating '+treelogfilename); + exit; + end; + writeln(printnodefile); + writeln(printnodefile,'*******************************************************************************'); + writeln(printnodefile, pass); + writeln(printnodefile,procdef.fullprocname(false)); + writeln(printnodefile,'*******************************************************************************'); + printnode(printnodefile,code); + close(printnodefile); + end; + + + procedure tcgprocinfo.maybe_add_constructor_wrapper(var tocode: tnode; withexceptblock: boolean); + var + oldlocalswitches: tlocalswitches; + srsym: tsym; + afterconstructionblock, + exceptblock, + newblock: tblocknode; + newstatement: tstatementnode; + pd: tprocdef; + begin + if assigned(procdef.struct) and + (procdef.proctypeoption=potype_constructor) then + begin + { Don't test self and the vmt here. See generate_bodyexit_block } + { why (JM) } + oldlocalswitches:=current_settings.localswitches; + current_settings.localswitches:=oldlocalswitches-[cs_check_object,cs_check_range]; + + { call AfterConstruction for classes } + if is_class(procdef.struct) then + begin + srsym:=search_struct_member(procdef.struct,'AFTERCONSTRUCTION'); + if assigned(srsym) and + (srsym.typ=procsym) then + begin + current_filepos:=exitpos; + afterconstructionblock:=internalstatements(newstatement); + { first execute all constructor code. If no exception + occurred then we will execute afterconstruction, + otherwise we won't (the exception will jump over us) } + addstatement(newstatement,tocode); + { if implicit finally node wasn't created, then exit label and + finalization code must be handled here and placed before + afterconstruction } + if not ((pi_needs_implicit_finally in flags) and + (cs_implicit_exceptions in current_settings.moduleswitches)) then + begin + include(tocode.flags,nf_block_with_exit); + addstatement(newstatement,final_asmnode); + end; + + { Self can be nil when fail is called } + { if self<>nil and vmt<>nil then afterconstruction } + addstatement(newstatement,cifnode.create( + caddnode.create(andn, + caddnode.create(unequaln, + load_self_node, + cnilnode.create), + caddnode.create(unequaln, + load_vmt_pointer_node, + cnilnode.create)), + ccallnode.create(nil,tprocsym(srsym),srsym.owner,load_self_node,[]), + nil)); + tocode:=afterconstructionblock; + end + else + internalerror(200305106); + end; + + if withexceptblock and (procdef.struct.typ=objectdef) then + begin + { Generate the implicit "fail" code for a constructor (destroy + in case an exception happened) } + pd:=tobjectdef(procdef.struct).find_destructor; + { this will always be the case for classes, since tobject has + a destructor } + if assigned(pd) then + begin + current_filepos:=exitpos; + exceptblock:=internalstatements(newstatement); + { first free the instance if non-nil } + { if vmt<>0 then call destructor } + addstatement(newstatement,cifnode.create( + caddnode.create(unequaln, + load_vmt_pointer_node, + cnilnode.create), + { cnf_create_failed -> don't call BeforeDestruction } + ccallnode.create(nil,tprocsym(pd.procsym),pd.procsym.owner,load_self_node,[cnf_create_failed]), + nil)); + { then re-raise the exception } + addstatement(newstatement,craisenode.create(nil,nil,nil)); + current_filepos:=entrypos; + newblock:=internalstatements(newstatement); + { try + tocode + except + exceptblock + end + } + addstatement(newstatement,ctryexceptnode.create( + tocode, + nil, + exceptblock)); + tocode:=newblock; + end; + end; + current_settings.localswitches:=oldlocalswitches; + end; + end; + + + procedure tcgprocinfo.add_entry_exit_code; + var + finalcode, + bodyentrycode, + bodyexitcode, + exceptcode, + wrappedbody: tnode; + newblock : tblocknode; + codestatement, + newstatement : tstatementnode; + oldfilepos : tfileposinfo; + is_constructor: boolean; + begin + is_constructor:=assigned(procdef.struct) and + (procdef.proctypeoption=potype_constructor); + + oldfilepos:=current_filepos; + { Generate code/locations used at start of proc } + current_filepos:=entrypos; + entry_asmnode:=casmnode.create_get_position; + loadpara_asmnode:=casmnode.create_get_position; + stackcheck_asmnode:=casmnode.create_get_position; + init_asmnode:=casmnode.create_get_position; + bodyentrycode:=generate_bodyentry_block; + { Generate code/locations used at end of proc } + current_filepos:=exitpos; + exitlabel_asmnode:=casmnode.create_get_position; + final_asmnode:=casmnode.create_get_position; + bodyexitcode:=generate_bodyexit_block; + + { Generate procedure by combining init+body+final, + depending on the implicit finally we need to add + an try...finally...end wrapper } + newblock:=internalstatements(newstatement); + { initialization is common for all cases } + addstatement(newstatement,loadpara_asmnode); + addstatement(newstatement,stackcheck_asmnode); + addstatement(newstatement,entry_asmnode); + addstatement(newstatement,init_asmnode); + addstatement(newstatement,bodyentrycode); + + if (cs_implicit_exceptions in current_settings.moduleswitches) and + (pi_needs_implicit_finally in flags) and + { but it's useless in init/final code of units } + not(procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) and + not(po_assembler in procdef.procoptions) then + begin + { Generate special exception block only needed when + implicit finaly is used } + current_filepos:=exitpos; + exceptcode:=generate_except_block; + { Generate code that will be in the try...finally } + finalcode:=internalstatements(codestatement); + addstatement(codestatement,final_asmnode); + + current_filepos:=entrypos; + wrappedbody:=ctryfinallynode.create_implicit( + code, + finalcode, + exceptcode); + { afterconstruction must be called after final_asmnode, because it + has to execute after the temps have been finalised in case of a + refcounted class (afterconstruction decreases the refcount + without freeing the instance if the count becomes nil, while + the finalising of the temps can free the instance) } + maybe_add_constructor_wrapper(wrappedbody,true); + addstatement(newstatement,wrappedbody); + addstatement(newstatement,exitlabel_asmnode); + addstatement(newstatement,bodyexitcode); + { set flag the implicit finally has been generated } + include(flags,pi_has_implicit_finally); + end + else + begin + { constructors need destroy-on-exception code even if they don't + have managed variables/temps } + maybe_add_constructor_wrapper(code, + cs_implicit_exceptions in current_settings.moduleswitches); + addstatement(newstatement,code); + addstatement(newstatement,exitlabel_asmnode); + addstatement(newstatement,bodyexitcode); + if not is_constructor then + addstatement(newstatement,final_asmnode); + end; + do_firstpass(tnode(newblock)); + code:=newblock; + current_filepos:=oldfilepos; + end; + + + procedure clearrefs(p:TObject;arg:pointer); + begin + if (tsym(p).typ in [localvarsym,paravarsym,staticvarsym]) then + if tabstractvarsym(p).refs>1 then + tabstractvarsym(p).refs:=1; + end; + + + procedure translate_registers(p:TObject;list:pointer); + begin + if (tsym(p).typ in [localvarsym,paravarsym,staticvarsym]) and + (tabstractnormalvarsym(p).localloc.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_MMREGISTER, + LOC_CMMREGISTER,LOC_FPUREGISTER,LOC_CFPUREGISTER]) then + begin + if not(cs_no_regalloc in current_settings.globalswitches) then + cg.translate_register(tabstractnormalvarsym(p).localloc.register); + if cs_asm_source in current_settings.globalswitches then + TAsmList(list).concat(Tai_comment.Create(strpnew('Var '+tabstractnormalvarsym(p).realname+' located in register '+ + std_regname(tabstractnormalvarsym(p).localloc.register)))) + end; + end; + + procedure tcgprocinfo.setup_tempgen; + begin + tg:=ttgobj.create; + +{$if defined(x86) or defined(arm)} + { try to strip the stack frame } + { set the framepointer to esp if: + - no assembler directive, those are handled in assembler_block + in pstatment.pas (for cases not caught by the Delphi + exception below) + - no exceptions are used + - no pushes are used/esp modifications, could be: + * outgoing parameters on the stack + * incoming parameters on the stack + * open arrays + - no inline assembler + or + - Delphi mode + - assembler directive + - no pushes are used/esp modifications, could be: + * outgoing parameters on the stack + * incoming parameters on the stack + * open arrays + - no local variables + } + if ((po_assembler in procdef.procoptions) and + (m_delphi in current_settings.modeswitches) and + { localst at main_program_level is a staticsymtable } + (procdef.localst.symtablelevel<>main_program_level) and + (tabstractlocalsymtable(procdef.localst).count_locals = 0)) or + ((cs_opt_stackframe in current_settings.optimizerswitches) and + not(cs_generate_stackframes in current_settings.localswitches) and + not(po_assembler in procdef.procoptions) and + ((flags*[pi_has_assembler_block,pi_uses_exceptions,pi_is_assembler, + pi_needs_implicit_finally,pi_has_implicit_finally,pi_has_stackparameter, + pi_needs_stackframe])=[]) + ) + then + begin + { we need the parameter info here to determine if the procedure gets + parameters on the stack + + calling generate_parameter_info doesn't hurt but it costs time + (necessary to init para_stack_size) + } + generate_parameter_info; + if not(procdef.stack_tainting_parameter(calleeside)) and + not(has_assembler_child) and (para_stack_size=0) then + begin + { Only need to set the framepointer } + framepointer:=NR_STACK_POINTER_REG; + tg.direction:=1; + end; + end; + +{$endif} + { set the start offset to the start of the temp area in the stack } + set_first_temp_offset; + end; + + function tcgprocinfo.has_assembler_child : boolean; + var + hp : tprocinfo; + begin + result:=false; + hp:=get_first_nestedproc; + while assigned(hp) do + begin + if (hp.flags*[pi_has_assembler_block,pi_is_assembler])<>[] then + begin + result:=true; + exit; + end; + hp:=tprocinfo(hp.next); + end; + end; + + procedure tcgprocinfo.generate_code_tree; + var + hpi : tcgprocinfo; + begin + { generate code for this procedure } + generate_code; + { process nested procedures } + hpi:=tcgprocinfo(get_first_nestedproc); + while assigned(hpi) do + begin + hpi.generate_code_tree; + hpi:=tcgprocinfo(hpi.next); + end; + resetprocdef; + end; + + procedure tcgprocinfo.generate_exceptfilter(nestedpi: tcgprocinfo); + var + saved_cg: tcg; + begin + if nestedpi.procdef.proctypeoption<>potype_exceptfilter then + InternalError(201201141); + { flush code generated this far } + aktproccode.concatlist(current_asmdata.CurrAsmList); + { save the codegen } + saved_cg:=cg; + cg:=nil; + nestedpi.generate_code; + { prevents generating code the second time when processing nested procedures } + nestedpi.resetprocdef; + cg:=saved_cg; + add_reg_instruction_hook:=@cg.add_reg_instruction; + end; + + procedure tcgprocinfo.generate_code; + var + old_current_procinfo : tprocinfo; + oldmaxfpuregisters : longint; + oldfilepos : tfileposinfo; + old_current_structdef : tabstractrecorddef; + templist : TAsmList; + headertai : tai; + i : integer; + varsym : tabstractnormalvarsym; + {RedoDFA : boolean;} + begin + { the initialization procedure can be empty, then we + don't need to generate anything. When it was an empty + procedure there would be at least a blocknode } + if not assigned(code) then + exit; + + { We need valid code } + if Errorcount<>0 then + exit; + + { No code can be generated for generic template } + if (df_generic in procdef.defoptions) then + internalerror(200511152); + + { For regular procedures the RA and Tempgen shall not be available yet, + but exception filters reuse Tempgen of parent } + if assigned(tg)<>(procdef.proctypeoption=potype_exceptfilter) then + internalerror(200309201); + + old_current_procinfo:=current_procinfo; + oldfilepos:=current_filepos; + old_current_structdef:=current_structdef; + oldmaxfpuregisters:=current_settings.maxfpuregisters; + + current_procinfo:=self; + current_filepos:=entrypos; + current_structdef:=procdef.struct; + + templist:=TAsmList.create; + + { add parast/localst to symtablestack } + add_to_symtablestack; + + { clear register count } + procdef.localst.SymList.ForEachCall(@clearrefs,nil); + procdef.parast.SymList.ForEachCall(@clearrefs,nil); + + { there's always a call to FPC_INITIALIZEUNITS/FPC_DO_EXIT in the main program } + if (procdef.localst.symtablelevel=main_program_level) and + (not current_module.is_unit) then + include(flags,pi_do_call); + + { set implicit_finally flag when there are locals/paras to be finalized } + procdef.parast.SymList.ForEachCall(@check_finalize_paras,nil); + procdef.localst.SymList.ForEachCall(@check_finalize_locals,nil); + +{$if defined(x86) or defined(arm)} + { set implicit_finally flag for if procedure is safecall } + if (tf_safecall_exceptions in target_info.flags) and + (procdef.proccalloption=pocall_safecall) then + include(flags, pi_needs_implicit_finally); +{$endif} + { firstpass everything } + flowcontrol:=[]; + do_firstpass(code); +{$ifdef i386} + procdef.fpu_used:=node_resources_fpu(code); + if procdef.fpu_used>0 then + include(flags,pi_uses_fpu); +{$endif i386} + + { Print the node to tree.log } + if paraprintnodetree=1 then + printproc( 'after the firstpass'); + + { do this before adding the entry code else the tail recursion recognition won't work, + if this causes troubles, it must be if'ed + } + if (cs_opt_tailrecursion in current_settings.optimizerswitches) and + (pi_is_recursive in flags) then + do_opttail(code,procdef); + + if (cs_opt_nodedfa in current_settings.optimizerswitches) and + { creating dfa is not always possible } + ((flags*[pi_has_assembler_block,pi_uses_exceptions,pi_is_assembler, + pi_needs_implicit_finally,pi_has_implicit_finally])=[]) then + begin + dfabuilder:=TDFABuilder.Create; + dfabuilder.createdfainfo(code); + { when life info is available, we can give more sophisticated warning about unintialized + variables } + + { iterate through life info of the first node } + for i:=0 to dfabuilder.nodemap.count-1 do + begin + if DFASetIn(code.optinfo^.life,i) then + case tnode(dfabuilder.nodemap[i]).nodetype of + loadn: + begin + varsym:=tabstractnormalvarsym(tloadnode(dfabuilder.nodemap[i]).symtableentry); + + { Give warning/note for living locals } + if assigned(varsym.owner) and + not(vo_is_external in varsym.varoptions) then + begin + if (vo_is_funcret in varsym.varoptions) then + CGMessage(sym_w_function_result_uninitialized) + else + begin + if (varsym.owner=procdef.localst) and not (vo_is_typed_const in varsym.varoptions) then + CGMessage1(sym_w_uninitialized_local_variable,varsym.realname); + end; + end; + end; + end; + end; + include(flags,pi_dfaavailable); + end; + + if (cs_opt_loopstrength in current_settings.optimizerswitches) + { our induction variable strength reduction doesn't like + for loops with more than one entry } + and not(pi_has_label in flags) then + begin + {RedoDFA:=}OptimizeInductionVariables(code); + end; + + if cs_opt_nodecse in current_settings.optimizerswitches then + do_optcse(code); + + { add implicit entry and exit code } + add_entry_exit_code; + + { only do secondpass if there are no errors } + if (ErrorCount=0) then + begin + create_codegen; + + if (procdef.proctypeoption<>potype_exceptfilter) then + setup_tempgen; + + { Create register allocator, must come after framepointer is known } + cg.init_register_allocators; + + generate_parameter_info; + + { allocate got register if needed } + allocate_got_register(aktproccode); + + { Allocate space in temp/registers for parast and localst } + current_filepos:=entrypos; + gen_alloc_symtable(aktproccode,procdef.parast); + gen_alloc_symtable(aktproccode,procdef.localst); + + { Store temp offset for information about 'real' temps } + tempstart:=tg.lasttemp; + + { Generate code to load register parameters in temps and insert local + copies for values parameters. This must be done before the code for the + body is generated because the localloc is updated. + Note: The generated code will be inserted after the code generation of + the body is finished, because only then the position is known } +{$ifdef oldregvars} + assign_regvars(code); +{$endif oldreg} + current_filepos:=entrypos; + + gen_load_para_value(templist); + + { caller paraloc info is also necessary in the stackframe_entry + code of the ppc (and possibly other processors) } + procdef.init_paraloc_info(callerside); + + { generate code for the node tree } + do_secondpass(code); + aktproccode.concatlist(current_asmdata.CurrAsmList); + + { The position of the loadpara_asmnode is now known } + aktproccode.insertlistafter(loadpara_asmnode.currenttai,templist); + + { first generate entry and initialize code with the correct + position and switches } + current_filepos:=entrypos; + current_settings.localswitches:=entryswitches; + + cg.set_regalloc_live_range_direction(rad_backwards); + + gen_entry_code(templist); + aktproccode.insertlistafter(entry_asmnode.currenttai,templist); + gen_initialize_code(templist); + aktproccode.insertlistafter(init_asmnode.currenttai,templist); + + { now generate finalize and exit code with the correct position + and switches } + current_filepos:=exitpos; + current_settings.localswitches:=exitswitches; + + cg.set_regalloc_live_range_direction(rad_forward); + + if assigned(finalize_procinfo) then + generate_exceptfilter(tcgprocinfo(finalize_procinfo)) + else + begin + gen_finalize_code(templist); + { the finalcode must be concated if there was no position available, + using insertlistafter will result in an insert at the start + when currentai=nil } + if assigned(final_asmnode) and assigned(final_asmnode.currenttai) then + aktproccode.insertlistafter(final_asmnode.currenttai,templist) + else + aktproccode.concatlist(templist); + end; + { insert exit label at the correct position } + cg.a_label(templist,CurrExitLabel); + if assigned(exitlabel_asmnode.currenttai) then + aktproccode.insertlistafter(exitlabel_asmnode.currenttai,templist) + else + aktproccode.concatlist(templist); + { exit code } + gen_exit_code(templist); + aktproccode.concatlist(templist); + +{$ifdef OLDREGVARS} + { note: this must be done only after as much code as possible has } + { been generated. The result is that when you ungetregister() a } + { regvar, it will actually free the regvar (and alse free the } + { the regvars at the same time). Doing this too early will } + { confuse the register allocator, as the regvars will still be } + { used. It should be done before loading the result regs (so } + { they don't conflict with the regvars) and before } + { gen_entry_code (that one has to be able to allocate the } + { regvars again) (JM) } + free_regvars(aktproccode); +{$endif OLDREGVARS} + + { generate symbol and save end of header position } + current_filepos:=entrypos; + gen_proc_symbol(templist); + headertai:=tai(templist.last); + { insert symbol } + aktproccode.insertlist(templist); + + { Free space in temp/registers for parast and localst, must be + done after gen_entry_code } + current_filepos:=exitpos; + + { make sure the got/pic register doesn't get freed in the } + { middle of a loop } + if (cs_create_pic in current_settings.moduleswitches) and + (pi_needs_got in flags) and + (got<>NR_NO) then + cg.a_reg_sync(aktproccode,got); + + gen_free_symtable(aktproccode,procdef.localst); + gen_free_symtable(aktproccode,procdef.parast); + + { add code that will load the return value, this is not done + for assembler routines when they didn't reference the result + variable } + gen_load_return_value(templist); + aktproccode.concatlist(templist); + + { Already reserve all registers for stack checking code and + generate the call to the helper function } + if not(tf_no_generic_stackcheck in target_info.flags) and + (cs_check_stack in entryswitches) and + not(po_assembler in procdef.procoptions) and + (procdef.proctypeoption<>potype_proginit) then + begin + current_filepos:=entrypos; + gen_stack_check_call(templist); + aktproccode.insertlistafter(stackcheck_asmnode.currenttai,templist) + end; + + { this code (got loading) comes before everything which has } + { already been generated, so reset the info about already } + { backwards extended registers (so their live range can be } + { extended backwards even further if needed) } + { This code must be } + { a) generated after do_secondpass has been called } + { (because pi_needs_got may be set there) } + { b) generated before register allocation, because the } + { got/pic register can be a virtual one } + { c) inserted before the entry code, because the entry } + { code may need global symbols such as init rtti } + { d) inserted after the stackframe allocation, because } + { this register may have to be spilled } + cg.set_regalloc_live_range_direction(rad_backwards_reinit); + current_filepos:=entrypos; + { load got if necessary } + cg.g_maybe_got_init(templist); + + aktproccode.insertlistafter(headertai,templist); + + { re-enable if more code at the end is ever generated here + cg.set_regalloc_live_range_direction(rad_forward); + } + + { The procedure body is finished, we can now + allocate the registers } + cg.do_register_allocation(aktproccode,headertai); + + { translate imag. register to their real counter parts + this is necessary for debuginfo and verbose assembler output + when SSA will be implented, this will be more complicated because we've to + maintain location lists } + procdef.parast.SymList.ForEachCall(@translate_registers,templist); + procdef.localst.SymList.ForEachCall(@translate_registers,templist); + if (cs_create_pic in current_settings.moduleswitches) and + (pi_needs_got in flags) and + not(cs_no_regalloc in current_settings.globalswitches) and + (got<>NR_NO) then + cg.translate_register(got); + + { Add save and restore of used registers } + current_filepos:=entrypos; + gen_save_used_regs(templist); + { Remember the last instruction of register saving block + (may be =nil for e.g. assembler procedures) } + endprologue_ai:=templist.last; + aktproccode.insertlistafter(headertai,templist); + current_filepos:=exitpos; + gen_restore_used_regs(aktproccode); + { We know the size of the stack, now we can generate the + parameter that is passed to the stack checking code } + if not(tf_no_generic_stackcheck in target_info.flags) and + (cs_check_stack in entryswitches) and + not(po_assembler in procdef.procoptions) and + (procdef.proctypeoption<>potype_proginit) then + begin + current_filepos:=entrypos; + gen_stack_check_size_para(templist); + aktproccode.insertlistafter(stackcheck_asmnode.currenttai,templist) + end; + { Add entry code (stack allocation) after header } + current_filepos:=entrypos; + gen_proc_entry_code(templist); + aktproccode.insertlistafter(headertai,templist); +{$if defined(x86) or defined(arm)} + { Set return value of safecall procedure if implicit try/finally blocks are disabled } + if not (cs_implicit_exceptions in current_settings.moduleswitches) and + (tf_safecall_exceptions in target_info.flags) and + (procdef.proccalloption=pocall_safecall) then + cg.a_load_const_reg(aktproccode,OS_ADDR,0,NR_FUNCTION_RETURN_REG); +{$endif} + { Add exit code at the end } + current_filepos:=exitpos; + gen_proc_exit_code(templist); + aktproccode.concatlist(templist); + + { check if the implicit finally has been generated. The flag + should already be set in pass1 } + if (cs_implicit_exceptions in current_settings.moduleswitches) and + not(procdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) and + (pi_needs_implicit_finally in flags) and + not(po_assembler in procdef.procoptions) and + not(pi_has_implicit_finally in flags) then + internalerror(200405231); + +{$ifndef NoOpt} + if not(cs_no_regalloc in current_settings.globalswitches) then + begin + if (cs_opt_level1 in current_settings.optimizerswitches) and + { do not optimize pure assembler procedures } + not(pi_is_assembler in flags) then + optimize(aktproccode); + end; +{$endif NoOpt} + + +{$ifdef ARM} + { because of the limited constant size of the arm, all data access is done pc relative } + finalizearmcode(aktproccode,aktlocaldata); +{$endif ARM} + +{$ifdef AVR} + { because of the limited branch distance of cond. branches, they must be replaced + somtimes by normal jmps and an inverse branch } + finalizeavrcode(aktproccode); +{$endif AVR} + + { Add end symbol and debug info } + { this must be done after the pcrelativedata is appended else the distance calculation of + insertpcrelativedata will be wrong, further the pc indirect data is part of the procedure + so it should be inserted before the end symbol (FK) + } + current_filepos:=exitpos; + gen_proc_symbol_end(templist); + aktproccode.concatlist(templist); +{$if defined(POWERPC) or defined(POWERPC64)} + fixup_jmps(aktproccode); +{$endif} + { insert line debuginfo } + if (cs_debuginfo in current_settings.moduleswitches) or + (cs_use_lineinfo in current_settings.globalswitches) then + current_debuginfo.insertlineinfo(aktproccode); + + { add the procedure to the al_procedures } + maybe_new_object_file(current_asmdata.asmlists[al_procedures]); + new_section(current_asmdata.asmlists[al_procedures],sec_code,lower(procdef.mangledname),getprocalign); + current_asmdata.asmlists[al_procedures].concatlist(aktproccode); + { save local data (casetable) also in the same file } + if assigned(aktlocaldata) and + (not aktlocaldata.empty) then + current_asmdata.asmlists[al_procedures].concatlist(aktlocaldata); + + { only now we can remove the temps } + if (procdef.proctypeoption<>potype_exceptfilter) then + begin + tg.resettempgen; + tg.free; + tg:=nil; + end; + { stop tempgen and ra } + cg.done_register_allocators; + destroy_codegen; + end; + + dfabuilder.free; + + { restore symtablestack } + remove_from_symtablestack; + + { restore } + templist.free; + current_settings.maxfpuregisters:=oldmaxfpuregisters; + current_filepos:=oldfilepos; + current_structdef:=old_current_structdef; + current_procinfo:=old_current_procinfo; + end; + + + procedure tcgprocinfo.add_to_symtablestack; + begin + { insert symtables for the class, but only if it is no nested function } + if assigned(procdef.struct) and + not(assigned(parent) and + assigned(parent.procdef) and + assigned(parent.procdef.struct)) then + push_nested_hierarchy(procdef.struct); + + { insert parasymtable in symtablestack when parsing + a function } + if procdef.parast.symtablelevel>=normal_function_level then + symtablestack.push(procdef.parast); + + { insert localsymtable, except for the main procedure + (in that case the localst is the unit's static symtable, + which is already on the stack) } + if procdef.localst.symtablelevel>=normal_function_level then + symtablestack.push(procdef.localst); + end; + + + procedure tcgprocinfo.remove_from_symtablestack; + begin + { remove localsymtable } + if procdef.localst.symtablelevel>=normal_function_level then + symtablestack.pop(procdef.localst); + + { remove parasymtable } + if procdef.parast.symtablelevel>=normal_function_level then + symtablestack.pop(procdef.parast); + + { remove symtables for the class, but only if it is no nested function } + if assigned(procdef.struct) and + not(assigned(parent) and + assigned(parent.procdef) and + assigned(parent.procdef.struct)) then + pop_nested_hierarchy(procdef.struct); + end; + + + procedure tcgprocinfo.resetprocdef; + begin + { remove code tree, if not inline procedure } + if assigned(code) then + begin + { the inline procedure has already got a copy of the tree + stored in procdef.inlininginfo } + code.free; + code:=nil; + end; + end; + + + function checknodeinlining(procdef: tprocdef): boolean; + var + i : integer; + currpara : tparavarsym; + begin + result := false; + if (pi_has_assembler_block in current_procinfo.flags) then + begin + Message1(parser_w_not_supported_for_inline,'assembler'); + Message(parser_w_inlining_disabled); + exit; + end; + for i:=0 to procdef.paras.count-1 do + begin + currpara:=tparavarsym(procdef.paras[i]); + case currpara.vardef.typ of + formaldef : + begin + if (currpara.varspez in [vs_out,vs_var,vs_const,vs_constref]) then + begin + Message1(parser_w_not_supported_for_inline,'formal parameter'); + Message(parser_w_inlining_disabled); + exit; + end; + end; + arraydef : + begin + if is_array_of_const(currpara.vardef) or + is_variant_array(currpara.vardef) then + begin + Message1(parser_w_not_supported_for_inline,'array of const'); + Message(parser_w_inlining_disabled); + exit; + end; + { open arrays might need re-basing of the index, i.e. if you pass + an array[1..10] as open array, you have to add 1 to all index operations + if you directly inline it } + if is_open_array(currpara.vardef) then + begin + Message1(parser_w_not_supported_for_inline,'open array'); + Message(parser_w_inlining_disabled); + exit; + end; + end; + end; + end; + result:=true; + end; + + + procedure tcgprocinfo.parse_body; + var + old_current_procinfo : tprocinfo; + old_block_type : tblock_type; + st : TSymtable; + old_current_structdef: tabstractrecorddef; + old_current_genericdef, + old_current_specializedef: tstoreddef; + old_parse_generic: boolean; + begin + old_current_procinfo:=current_procinfo; + old_block_type:=block_type; + old_current_structdef:=current_structdef; + old_current_genericdef:=current_genericdef; + old_current_specializedef:=current_specializedef; + old_parse_generic:=parse_generic; + + current_procinfo:=self; + current_structdef:=procdef.struct; + if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then + begin + current_genericdef:=current_structdef; + parse_generic:=true; + end; + if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then + current_specializedef:=current_structdef; + + { calculate the lexical level } + if procdef.parast.symtablelevel>maxnesting then + Message(parser_e_too_much_lexlevel); + block_type:=bt_body; + + {$ifdef state_tracking} +{ aktstate:=Tstate_storage.create;} + {$endif state_tracking} + + { allocate the symbol for this procedure } + alloc_proc_symbol(procdef); + + { add parast/localst to symtablestack } + add_to_symtablestack; + + { save entry info } + entrypos:=current_filepos; + entryswitches:=current_settings.localswitches; + + if (df_generic in procdef.defoptions) then + begin + { start token recorder for generic template } + procdef.initgeneric; + current_scanner.startrecordtokens(procdef.generictokenbuf); + end; + + { parse the code ... } + code:=block(current_module.islibrary); + + if (df_generic in procdef.defoptions) then + begin + { stop token recorder for generic template } + current_scanner.stoprecordtokens; + + { Give an error for accesses in the static symtable that aren't visible + outside the current unit } + st:=procdef.owner; + while (st.symtabletype=ObjectSymtable) do + st:=st.defowner.owner; + if (pi_uses_static_symtable in flags) and + (st.symtabletype<>staticsymtable) then + Comment(V_Error,'Global Generic template references static symtable'); + end; + + { save exit info } + exitswitches:=current_settings.localswitches; + exitpos:=last_endtoken_filepos; + + { the procedure is now defined } + procdef.forwarddef:=false; + + if assigned(code) then + begin + { get a better entry point } + entrypos:=code.fileinfo; + + { Finish type checking pass } + do_typecheckpass(code); + end; + + { Check for unused labels, forwards, symbols for procedures. Static + symtable is checked in pmodules. + The check must be done after the typecheckpass } + if (Errorcount=0) and + (tstoredsymtable(procdef.localst).symtabletype<>staticsymtable) then + begin + { check if forwards are resolved } + tstoredsymtable(procdef.localst).check_forwards; + { check if all labels are used } + tstoredsymtable(procdef.localst).checklabels; + { check for unused symbols, but only if there is no asm block } + if not(pi_has_assembler_block in flags) then + begin + tstoredsymtable(procdef.localst).allsymbolsused; + tstoredsymtable(procdef.parast).allsymbolsused; + end; + end; + + if (po_inline in procdef.procoptions) then + begin + { Can we inline this procedure? } + if checknodeinlining(procdef) then + begin + new(procdef.inlininginfo); + include(procdef.procoptions,po_has_inlininginfo); + procdef.inlininginfo^.code:=code.getcopy; + procdef.inlininginfo^.flags:=flags; + { The blocknode needs to set an exit label } + if procdef.inlininginfo^.code.nodetype=blockn then + include(procdef.inlininginfo^.code.flags,nf_block_with_exit); + end; + end; + + { Print the node to tree.log } + if paraprintnodetree=1 then + printproc( 'after parsing'); + + { ... remove symbol tables } + remove_from_symtablestack; + + {$ifdef state_tracking} +{ aktstate.destroy;} + {$endif state_tracking} + + current_structdef:=old_current_structdef; + current_genericdef:=old_current_genericdef; + current_specializedef:=old_current_specializedef; + current_procinfo:=old_current_procinfo; + parse_generic:=old_parse_generic; + + { Restore old state } + block_type:=old_block_type; + end; + + +{**************************************************************************** + PROCEDURE/FUNCTION PARSING +****************************************************************************} + + + procedure check_init_paras(p:TObject;arg:pointer); + begin + if tsym(p).typ<>paravarsym then + exit; + with tparavarsym(p) do + if is_managed_type(vardef) and + (varspez in [vs_value,vs_out]) then + include(current_procinfo.flags,pi_do_call); + end; + + + + procedure read_proc_body(old_current_procinfo:tprocinfo;pd:tprocdef); + { + Parses the procedure directives, then parses the procedure body, then + generates the code for it + } + + var + oldfailtokenmode : tmodeswitch; + isnestedproc : boolean; + begin + Message1(parser_d_procedure_start,pd.fullprocname(false)); + + { create a new procedure } + current_procinfo:=cprocinfo.create(old_current_procinfo); + current_module.procinfo:=current_procinfo; + current_procinfo.procdef:=pd; + isnestedproc:=(current_procinfo.procdef.parast.symtablelevel>normal_function_level); + + { Insert mangledname } + pd.aliasnames.insert(pd.mangledname); + + { Handle Export of this procedure } + if (po_exports in pd.procoptions) and + (target_info.system in [system_i386_os2,system_i386_emx]) then + begin + pd.aliasnames.insert(pd.procsym.realname); + if cs_link_deffile in current_settings.globalswitches then + deffile.AddExport(pd.mangledname); + end; + + { Insert result variables in the localst } + insert_funcret_local(pd); + + { check if there are para's which require initing -> set } + { pi_do_call (if not yet set) } + if not(pi_do_call in current_procinfo.flags) then + pd.parast.SymList.ForEachCall(@check_init_paras,nil); + + { set _FAIL as keyword if constructor } + if (pd.proctypeoption=potype_constructor) then + begin + oldfailtokenmode:=tokeninfo^[_FAIL].keyword; + tokeninfo^[_FAIL].keyword:=m_all; + end; + + tcgprocinfo(current_procinfo).parse_body; + + { We can't support inlining for procedures that have nested + procedures because the nested procedures use a fixed offset + for accessing locals in the parent procedure (PFV) } + if current_procinfo.has_nestedprocs then + begin + if (df_generic in current_procinfo.procdef.defoptions) then + Comment(V_Error,'Generic methods cannot have nested procedures') + else + if (po_inline in current_procinfo.procdef.procoptions) then + begin + Message1(parser_w_not_supported_for_inline,'nested procedures'); + Message(parser_w_inlining_disabled); + exclude(current_procinfo.procdef.procoptions,po_inline); + end; + end; + + { When it's a nested procedure then defer the code generation, + when back at normal function level then generate the code + for all defered nested procedures and the current procedure } + if not isnestedproc then + begin + if not(df_generic in current_procinfo.procdef.defoptions) then + tcgprocinfo(current_procinfo).generate_code_tree; + end; + + { reset _FAIL as _SELF normal } + if (pd.proctypeoption=potype_constructor) then + tokeninfo^[_FAIL].keyword:=oldfailtokenmode; + + { release procinfo } + if tprocinfo(current_module.procinfo)<>current_procinfo then + internalerror(200304274); + current_module.procinfo:=current_procinfo.parent; + + { For specialization we didn't record the last semicolon. Moving this parsing + into the parse_body routine is not done because of having better file position + information available } + if not(df_specialization in current_procinfo.procdef.defoptions) then + consume(_SEMICOLON); + + if not isnestedproc then + { current_procinfo is checked for nil later on } + freeandnil(current_procinfo); + end; + + + procedure read_proc(isclassmethod:boolean); + { + Parses the procedure directives, then parses the procedure body, then + generates the code for it + } + + var + old_current_procinfo : tprocinfo; + old_current_structdef: tabstractrecorddef; + old_current_genericdef, + old_current_specializedef: tstoreddef; + pdflags : tpdflags; + pd,firstpd : tprocdef; + s : string; + begin + { save old state } + old_current_procinfo:=current_procinfo; + old_current_structdef:=current_structdef; + old_current_genericdef:=current_genericdef; + old_current_specializedef:=current_specializedef; + + { reset current_procinfo.procdef to nil to be sure that nothing is writing + to another procdef } + current_procinfo:=nil; + current_structdef:=nil; + current_genericdef:=nil; + current_specializedef:=nil; + + { parse procedure declaration } + pd:=parse_proc_dec(isclassmethod,old_current_structdef); + + { set the default function options } + if parse_only then + begin + pd.forwarddef:=true; + { set also the interface flag, for better error message when the + implementation doesn't much this header } + pd.interfacedef:=true; + include(pd.procoptions,po_global); + pdflags:=[pd_interface]; + end + else + begin + pdflags:=[pd_body]; + if (not current_module.in_interface) then + include(pdflags,pd_implemen); + if (not current_module.is_unit) or + create_smartlink or + { + taking addresses of static procedures goes wrong + if they aren't global when pic is used (FK) + } + (cs_create_pic in current_settings.moduleswitches) then + include(pd.procoptions,po_global); + pd.forwarddef:=false; + end; + + { parse the directives that may follow } + parse_proc_directives(pd,pdflags); + + { hint directives, these can be separated by semicolons here, + that needs to be handled here with a loop (PFV) } + while try_consume_hintdirective(pd.symoptions,pd.deprecatedmsg) do + Consume(_SEMICOLON); + + { Set calling convention } + handle_calling_convention(pd); + + { search for forward declarations } + if not proc_add_definition(pd) then + begin + { A method must be forward defined (in the object declaration) } + if assigned(pd.struct) and + (not assigned(old_current_structdef)) then + begin + MessagePos1(pd.fileinfo,parser_e_header_dont_match_any_member,pd.fullprocname(false)); + tprocsym(pd.procsym).write_parameter_lists(pd); + end + else + begin + { Give a better error if there is a forward def in the interface and only + a single implementation } + firstpd:=tprocdef(tprocsym(pd.procsym).ProcdefList[0]); + if (not pd.forwarddef) and + (not pd.interfacedef) and + (tprocsym(pd.procsym).ProcdefList.Count>1) and + firstpd.forwarddef and + firstpd.interfacedef and + not(tprocsym(pd.procsym).ProcdefList.Count>2) and + { don't give an error if it may be an overload } + not(m_fpc in current_settings.modeswitches) and + (not(po_overload in pd.procoptions) or + not(po_overload in firstpd.procoptions)) then + begin + MessagePos1(pd.fileinfo,parser_e_header_dont_match_forward,pd.fullprocname(false)); + tprocsym(pd.procsym).write_parameter_lists(pd); + end; + end; + end; + + { Set mangled name } + proc_set_mangledname(pd); + + { compile procedure when a body is needed } + if (pd_body in pdflags) then + begin + read_proc_body(old_current_procinfo,pd); + end + else + begin + { Handle imports } + if (po_external in pd.procoptions) then + begin + { External declared in implementation, and there was already a + forward (or interface) declaration then we need to generate + a stub that calls the external routine } + if (not pd.forwarddef) and + (pd.hasforward) + { it is unclear to me what's the use of the following condition, + so commented out, see also issue #18371 (FK) + and + not( + assigned(pd.import_dll) and + (target_info.system in [system_i386_wdosx, + system_arm_wince,system_i386_wince]) + ) } then + begin + s:=proc_get_importname(pd); + if s<>'' then + gen_external_stub(current_asmdata.asmlists[al_procedures],pd,s); + end; + + { Import DLL specified? } + if assigned(pd.import_dll) then + begin + if assigned (pd.import_name) then + current_module.AddExternalImport(pd.import_dll^, + pd.import_name^,proc_get_importname(pd), + pd.import_nr,false,false) + else + current_module.AddExternalImport(pd.import_dll^, + proc_get_importname(pd),proc_get_importname(pd), + pd.import_nr,false,true); + end + else + begin + { add import name to external list for DLL scanning } + if tf_has_dllscanner in target_info.flags then + current_module.dllscannerinputlist.Add(proc_get_importname(pd),pd); + end; + end; + end; + + { make sure that references to forward-declared functions are not } + { treated as references to external symbols, needed for darwin. } + + { make sure we don't change the binding of real external symbols } + if not(po_external in pd.procoptions) then + begin + if (po_global in pd.procoptions) or + (cs_profile in current_settings.moduleswitches) then + current_asmdata.DefineAsmSymbol(pd.mangledname,AB_GLOBAL,AT_FUNCTION) + else + current_asmdata.DefineAsmSymbol(pd.mangledname,AB_LOCAL,AT_FUNCTION); + end; + + current_structdef:=old_current_structdef; + current_genericdef:=old_current_genericdef; + current_specializedef:=old_current_specializedef; + current_procinfo:=old_current_procinfo; + end; + + +{**************************************************************************** + DECLARATION PARSING +****************************************************************************} + + { search in symtablestack for not complete classes } + procedure check_forward_class(p:TObject;arg:pointer); + begin + if (tsym(p).typ=typesym) and + (ttypesym(p).typedef.typ=objectdef) and + (oo_is_forward in tobjectdef(ttypesym(p).typedef).objectoptions) then + MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname); + end; + + + procedure read_declarations(islibrary : boolean); + var + is_classdef:boolean; + begin + is_classdef:=false; + repeat + if not assigned(current_procinfo) then + internalerror(200304251); + case token of + _LABEL: + label_dec; + _CONST: + const_dec; + _TYPE: + type_dec; + _VAR: + var_dec; + _THREADVAR: + threadvar_dec; + _CLASS: + begin + is_classdef:=false; + if try_to_consume(_CLASS) then + begin + { class modifier is only allowed for procedures, functions, } + { constructors, destructors, fields and properties } + if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR,_CONSTRUCTOR,_DESTRUCTOR,_OPERATOR]) and + not((token=_ID) and (idtoken=_OPERATOR)) then + Message(parser_e_procedure_or_function_expected); + + if is_interface(current_structdef) then + Message(parser_e_no_static_method_in_interfaces) + else + { class methods are also allowed for Objective-C protocols } + is_classdef:=true; + end; + end; + _CONSTRUCTOR, + _DESTRUCTOR, + _FUNCTION, + _PROCEDURE, + _OPERATOR: + begin + read_proc(is_classdef); + is_classdef:=false; + end; + _EXPORTS: + begin + if (current_procinfo.procdef.localst.symtablelevel>main_program_level) then + begin + Message(parser_e_syntax_error); + consume_all_until(_SEMICOLON); + end + else if islibrary or + (target_info.system in systems_unit_program_exports) then + read_exports + else + begin + Message(parser_w_unsupported_feature); + consume(_BEGIN); + end; + end + else + begin + case idtoken of + _RESOURCESTRING: + begin + { m_class is needed, because the resourcestring + loading is in the ObjPas unit } +{ if (m_class in current_settings.modeswitches) then} + resourcestring_dec +{ else + break;} + end; + _OPERATOR: + begin + if is_classdef then + begin + read_proc(is_classdef); + is_classdef:=false; + end + else + break; + end; + _PROPERTY: + begin + if (m_fpc in current_settings.modeswitches) then + begin + property_dec(is_classdef); + is_classdef:=false; + end + else + break; + end; + else + break; + end; + end; + end; + until false; + + { check for incomplete class definitions, this is only required + for fpc modes } + if (m_fpc in current_settings.modeswitches) then + current_procinfo.procdef.localst.SymList.ForEachCall(@check_forward_class,nil); + end; + + + procedure read_interface_declarations; + begin + repeat + case token of + _CONST : + const_dec; + _TYPE : + type_dec; + _VAR : + var_dec; + _THREADVAR : + threadvar_dec; + _FUNCTION, + _PROCEDURE, + _OPERATOR : + read_proc(false); + else + begin + case idtoken of + _RESOURCESTRING : + resourcestring_dec; + _PROPERTY: + begin + if (m_fpc in current_settings.modeswitches) then + property_dec(false) + else + break; + end; + else + break; + end; + end; + end; + until false; + { check for incomplete class definitions, this is only required + for fpc modes } + if (m_fpc in current_settings.modeswitches) then + symtablestack.top.SymList.ForEachCall(@check_forward_class,nil); + end; + + +{**************************************************************************** + SPECIALIZATION BODY GENERATION +****************************************************************************} + + + procedure specialize_objectdefs(p:TObject;arg:pointer); + var + oldcurrent_filepos : tfileposinfo; + oldsymtablestack : tsymtablestack; + oldextendeddefs : TFPHashObjectList; + pu : tused_unit; + hmodule : tmodule; + specobj : tabstractrecorddef; + + procedure process_abstractrecorddef(def:tabstractrecorddef); + var + i : longint; + hp : tdef; + begin + for i:=0 to def.symtable.DefList.Count-1 do + begin + hp:=tdef(def.symtable.DefList[i]); + if hp.typ=procdef then + begin + { only generate the code if we need a body } + if assigned(tprocdef(hp).struct) and not tprocdef(hp).forwarddef then + continue; + if assigned(tprocdef(hp).genericdef) and + (tprocdef(hp).genericdef.typ=procdef) and + assigned(tprocdef(tprocdef(hp).genericdef).generictokenbuf) then + begin + oldcurrent_filepos:=current_filepos; + current_filepos:=tprocdef(tprocdef(hp).genericdef).fileinfo; + { use the index the module got from the current compilation process } + current_filepos.moduleindex:=hmodule.unit_index; + current_tokenpos:=current_filepos; + current_scanner.startreplaytokens(tprocdef(tprocdef(hp).genericdef).generictokenbuf, + tprocdef(tprocdef(hp).genericdef).change_endian); + read_proc_body(nil,tprocdef(hp)); + current_filepos:=oldcurrent_filepos; + end + else + MessagePos1(tprocdef(hp).fileinfo,sym_e_forward_not_resolved,tprocdef(hp).fullprocname(false)); + end + else + if hp.typ in [objectdef,recorddef] then + { generate code for subtypes as well } + process_abstractrecorddef(tabstractrecorddef(hp)); + end; + end; + + begin + if not((tsym(p).typ=typesym) and + (ttypesym(p).typedef.typesym=tsym(p)) and + (ttypesym(p).typedef.typ in [objectdef,recorddef]) and + (df_specialization in ttypesym(p).typedef.defoptions) + ) then + exit; + + { Setup symtablestack a definition time } + specobj:=tabstractrecorddef(ttypesym(p).typedef); + + if not (is_class_or_object(specobj) or is_record(specobj)) then + exit; + + oldsymtablestack:=symtablestack; + oldextendeddefs:=current_module.extendeddefs; + current_module.extendeddefs:=TFPHashObjectList.create(true); + symtablestack:=tdefawaresymtablestack.create; + if not assigned(specobj.genericdef) then + internalerror(200705151); + hmodule:=find_module_from_symtable(specobj.genericdef.owner); + if hmodule=nil then + internalerror(200705152); + pu:=tused_unit(hmodule.used_units.first); + while assigned(pu) do + begin + if not assigned(pu.u.globalsymtable) then + internalerror(200705153); + symtablestack.push(pu.u.globalsymtable); + pu:=tused_unit(pu.next); + end; + if assigned(hmodule.globalsymtable) then + symtablestack.push(hmodule.globalsymtable); + if assigned(hmodule.localsymtable) then + symtablestack.push(hmodule.localsymtable); + + { procedure definitions for classes or objects } + process_abstractrecorddef(specobj); + + { Restore symtablestack } + current_module.extendeddefs.free; + current_module.extendeddefs:=oldextendeddefs; + symtablestack.free; + symtablestack:=oldsymtablestack; + end; + + + procedure generate_specialization_procs; + begin + if assigned(current_module.globalsymtable) then + current_module.globalsymtable.SymList.ForEachCall(@specialize_objectdefs,nil); + if assigned(current_module.localsymtable) then + current_module.localsymtable.SymList.ForEachCall(@specialize_objectdefs,nil); + end; + +end. diff --git a/closures/compiler/psystem.pas b/closures/compiler/psystem.pas new file mode 100644 index 0000000000..393af3cb55 --- /dev/null +++ b/closures/compiler/psystem.pas @@ -0,0 +1,625 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Load the system unit, create required defs for systemunit + + 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 psystem; + +{$i fpcdefs.inc} + +interface + + uses + symbase; + + procedure create_intern_symbols; + procedure create_intern_types; + + procedure load_intern_types; + + procedure registernodes; + procedure registertais; + + +implementation + + uses + globals,globtype,verbose,constexp,cpuinfo, + systems, + symconst,symtype,symsym,symdef,symtable, + aasmtai,aasmdata,aasmcpu, + ncgutil,ncgrtti,fmodule, + node,nbas,nflw,nset,ncon,ncnv,nld,nmem,ncal,nmat,nadd,ninl,nopt + ; + + + procedure create_intern_symbols; + { + all intern procedures for the system unit + } + begin + systemunit.insert(tsyssym.create('Concat',in_concat_x)); + systemunit.insert(tsyssym.create('Write',in_write_x)); + systemunit.insert(tsyssym.create('WriteLn',in_writeln_x)); + systemunit.insert(tsyssym.create('WriteStr',in_writestr_x)); + systemunit.insert(tsyssym.create('Assigned',in_assigned_x)); + systemunit.insert(tsyssym.create('Read',in_read_x)); + systemunit.insert(tsyssym.create('ReadLn',in_readln_x)); + systemunit.insert(tsyssym.create('ReadStr',in_readstr_x)); + systemunit.insert(tsyssym.create('Ofs',in_ofs_x)); + systemunit.insert(tsyssym.create('SizeOf',in_sizeof_x)); + systemunit.insert(tsyssym.create('BitSizeOf',in_bitsizeof_x)); + systemunit.insert(tsyssym.create('TypeOf',in_typeof_x)); + systemunit.insert(tsyssym.create('Low',in_low_x)); + systemunit.insert(tsyssym.create('High',in_high_x)); + systemunit.insert(tsyssym.create('Slice',in_slice_x)); + systemunit.insert(tsyssym.create('Seg',in_seg_x)); + systemunit.insert(tsyssym.create('Ord',in_ord_x)); + systemunit.insert(tsyssym.create('Pred',in_pred_x)); + systemunit.insert(tsyssym.create('Succ',in_succ_x)); + systemunit.insert(tsyssym.create('Exclude',in_exclude_x_y)); + systemunit.insert(tsyssym.create('Include',in_include_x_y)); + systemunit.insert(tsyssym.create('Pack',in_pack_x_y_z)); + systemunit.insert(tsyssym.create('Unpack',in_unpack_x_y_z)); + systemunit.insert(tsyssym.create('Break',in_break)); + systemunit.insert(tsyssym.create('Exit',in_exit)); + systemunit.insert(tsyssym.create('Continue',in_continue)); + systemunit.insert(tsyssym.create('Leave',in_leave)); {macpas only} + systemunit.insert(tsyssym.create('Cycle',in_cycle)); {macpas only} + systemunit.insert(tsyssym.create('Dec',in_dec_x)); + systemunit.insert(tsyssym.create('Inc',in_inc_x)); + systemunit.insert(tsyssym.create('Str',in_str_x_string)); + systemunit.insert(tsyssym.create('Assert',in_assert_x_y)); + systemunit.insert(tsyssym.create('Val',in_val_x)); + systemunit.insert(tsyssym.create('Addr',in_addr_x)); + systemunit.insert(tsyssym.create('TypeInfo',in_typeinfo_x)); + systemunit.insert(tsyssym.create('SetLength',in_setlength_x)); + systemunit.insert(tsyssym.create('Copy',in_copy_x)); + systemunit.insert(tsyssym.create('Initialize',in_initialize_x)); + systemunit.insert(tsyssym.create('Finalize',in_finalize_x)); + systemunit.insert(tsyssym.create('Length',in_length_x)); + systemunit.insert(tsyssym.create('New',in_new_x)); + systemunit.insert(tsyssym.create('Dispose',in_dispose_x)); +{$if defined(x86) or defined(arm)} + systemunit.insert(tsyssym.create('Get_Frame',in_get_frame)); +{$endif defined(x86) or defined(arm)} + systemunit.insert(tsyssym.create('Unaligned',in_unaligned_x)); + systemunit.insert(tsyssym.create('ObjCSelector',in_objc_selector_x)); { objc only } + systemunit.insert(tsyssym.create('ObjCEncode',in_objc_encode_x)); { objc only } + end; + + + procedure create_intern_types; + { + all the types inserted into the system unit + } + + function addtype(const s:string;def:tdef):ttypesym; + begin + result:=ttypesym.create(s,def); + systemunit.insert(result); + end; + + procedure addfield(recst:tabstractrecordsymtable;sym:tfieldvarsym); + begin + recst.insert(sym); + recst.addfield(sym,vis_hidden); + end; + + procedure create_fpu_types; + begin + if init_settings.fputype<>fpu_none then + begin + s32floattype:=tfloatdef.create(s32real); + s64floattype:=tfloatdef.create(s64real); + s80floattype:=tfloatdef.create(s80real); + sc80floattype:=tfloatdef.create(sc80real); + end else begin + s32floattype:=nil; + s64floattype:=nil; + s80floattype:=nil; + sc80floattype:=nil; + end; + end; + + var + hrecst : trecordsymtable; + begin + symtablestack.push(systemunit); + cundefinedtype:=tundefineddef.create; + cformaltype:=tformaldef.create(false); + ctypedformaltype:=tformaldef.create(true); + voidtype:=torddef.create(uvoid,0,0); + u8inttype:=torddef.create(u8bit,0,255); + s8inttype:=torddef.create(s8bit,int64(-128),127); + u16inttype:=torddef.create(u16bit,0,65535); + s16inttype:=torddef.create(s16bit,int64(-32768),32767); + u32inttype:=torddef.create(u32bit,0,high(longword)); + s32inttype:=torddef.create(s32bit,int64(low(longint)),int64(high(longint))); + u64inttype:=torddef.create(u64bit,low(qword),high(qword)); + s64inttype:=torddef.create(s64bit,low(int64),high(int64)); + pasbool8type:=torddef.create(pasbool8,0,1); + pasbool16type:=torddef.create(pasbool16,0,1); + pasbool32type:=torddef.create(pasbool32,0,1); + pasbool64type:=torddef.create(pasbool64,0,1); + bool8type:=torddef.create(bool8bit,low(int64),high(int64)); + bool16type:=torddef.create(bool16bit,low(int64),high(int64)); + bool32type:=torddef.create(bool32bit,low(int64),high(int64)); + bool64type:=torddef.create(bool64bit,low(int64),high(int64)); + cchartype:=torddef.create(uchar,0,255); + cwidechartype:=torddef.create(uwidechar,0,65535); + cshortstringtype:=tstringdef.createshort(255); + { should we give a length to the default long and ansi string definition ?? } + clongstringtype:=tstringdef.createlong(-1); + cansistringtype:=tstringdef.createansi(0); + if target_info.system in systems_windows then + cwidestringtype:=tstringdef.createwide + else + cwidestringtype:=tstringdef.createunicode; + cunicodestringtype:=tstringdef.createunicode; + { length=0 for shortstring is open string (needed for readln(string) } + openshortstringtype:=tstringdef.createshort(0); + openchararraytype:=tarraydef.create(0,-1,s32inttype); + tarraydef(openchararraytype).elementdef:=cchartype; +{$ifdef x86} + create_fpu_types; + if target_info.system<>system_x86_64_win64 then + s64currencytype:=tfloatdef.create(s64currency) + else + begin + s64currencytype:=torddef.create(scurrency,low(int64),high(int64)); + pbestrealtype:=@s64floattype; + end; +{$endif x86} +{$ifdef powerpc} + create_fpu_types; + s64currencytype:=torddef.create(scurrency,low(int64),high(int64)); +{$endif powerpc} +{$ifdef POWERPC64} + create_fpu_types; + s64currencytype:=torddef.create(scurrency,low(int64),high(int64)); +{$endif POWERPC64} +{$ifdef sparc} + create_fpu_types; + s64currencytype:=torddef.create(scurrency,low(int64),high(int64)); +{$endif sparc} +{$ifdef m68k} + create_fpu_types; + s64currencytype:=torddef.create(scurrency,low(int64),high(int64)); +{$endif} +{$ifdef arm} + create_fpu_types; + s64currencytype:=torddef.create(scurrency,low(int64),high(int64)); +{$endif arm} +{$ifdef avr} + s32floattype:=tfloatdef.create(s32real); + s64floattype:=tfloatdef.create(s64real); + s80floattype:=tfloatdef.create(s80real); + sc80floattype:=tfloatdef.create(sc80real); + s64currencytype:=torddef.create(scurrency,low(int64),high(int64)); +{$endif avr} +{$ifdef cpu64bitaddr} + uinttype:=u64inttype; + sinttype:=s64inttype; + ptruinttype:=u64inttype; + ptrsinttype:=s64inttype; +{$endif cpu64bitaddr} +{$ifdef cpu32bitaddr} + ptruinttype:=u32inttype; + ptrsinttype:=s32inttype; +{$endif cpu32bitaddr} +{$ifdef cpu32bitalu} + uinttype:=u32inttype; + sinttype:=s32inttype; +{$endif cpu32bitalu} +{$ifdef cpu16bitaddr} + ptruinttype:=u16inttype; + ptrsinttype:=s16inttype; +{$endif cpu16bitaddr} +{$ifdef cpu16bitalu} + uinttype:=u16inttype; + sinttype:=s16inttype; +{$endif cpu16bitalu} +{$ifdef cpu8bitalu} + uinttype:=u8inttype; + sinttype:=s8inttype; +{$endif cpu8bitalu} + { some other definitions } + voidpointertype:=tpointerdef.create(voidtype); + charpointertype:=tpointerdef.create(cchartype); + widecharpointertype:=tpointerdef.create(cwidechartype); + voidfarpointertype:=tpointerdef.createfar(voidtype); + cfiletype:=tfiledef.createuntyped; + cvarianttype:=tvariantdef.create(vt_normalvariant); + colevarianttype:=tvariantdef.create(vt_olevariant); + +{$ifdef cpufpemu} + { Normal types } + (* we use the same types as without emulator, the only + difference is that direct calls to the emulator are generated + if (cs_fp_emulation in current_settings.moduleswitches) then + begin + addtype('Single',s32floattype); + { extended size is the best real type for the target } + addtype('Real',s32floattype); + pbestrealtype:=@s32floattype; + { extended size is the best real type for the target } + addtype('Extended',pbestrealtype^); + end + else + *) +{$endif cpufpemu} + if init_settings.fputype <> fpu_none then + begin + addtype('Single',s32floattype); + addtype('Double',s64floattype); + { extended size is the best real type for the target } + addtype('Extended',pbestrealtype^); + { CExtended corresponds to the C version of the Extended type + (either "long double" or "double") } + if tfloatdef(pbestrealtype^).floattype=s80real then + addtype('CExtended',sc80floattype) + else + addtype('CExtended',pbestrealtype^); + end; +{$ifdef x86} + if target_info.system<>system_x86_64_win64 then + addtype('Comp',tfloatdef.create(s64comp)); +{$endif x86} + addtype('Currency',s64currencytype); + addtype('Pointer',voidpointertype); +{$ifdef x86} + addtype('FarPointer',voidfarpointertype); +{$endif x86} + addtype('ShortString',cshortstringtype); +{$ifdef support_longstring} + addtype('LongString',clongstringtype); +{$endif support_longstring} + addtype('AnsiString',cansistringtype); + addtype('WideString',cwidestringtype); + addtype('UnicodeString',cunicodestringtype); + + addtype('OpenString',openshortstringtype); + addtype('Boolean',pasbool8type); + addtype('Boolean16',pasbool16type); + addtype('Boolean32',pasbool32type); + addtype('Boolean64',pasbool64type); + addtype('ByteBool',bool8type); + addtype('WordBool',bool16type); + addtype('LongBool',bool32type); + addtype('QWordBool',bool64type); + addtype('Byte',u8inttype); + addtype('ShortInt',s8inttype); + addtype('Word',u16inttype); + addtype('SmallInt',s16inttype); + addtype('LongWord',u32inttype); + addtype('LongInt',s32inttype); + addtype('QWord',u64inttype); + addtype('Int64',s64inttype); + addtype('Char',cchartype); + addtype('WideChar',cwidechartype); + addtype('Text',tfiledef.createtext); + addtype('TypedFile',tfiledef.createtyped(voidtype)); + addtype('Variant',cvarianttype); + addtype('OleVariant',colevarianttype); + { Internal types } + addtype('$undefined',cundefinedtype); + addtype('$formal',cformaltype); + addtype('$typedformal',ctypedformaltype); + addtype('$void',voidtype); + addtype('$byte',u8inttype); + addtype('$shortint',s8inttype); + addtype('$word',u16inttype); + addtype('$smallint',s16inttype); + addtype('$ulong',u32inttype); + addtype('$longint',s32inttype); + addtype('$qword',u64inttype); + addtype('$int64',s64inttype); + addtype('$char',cchartype); + addtype('$widechar',cwidechartype); + addtype('$shortstring',cshortstringtype); + addtype('$longstring',clongstringtype); + addtype('$ansistring',cansistringtype); + addtype('$widestring',cwidestringtype); + addtype('$unicodestring',cunicodestringtype); + addtype('$openshortstring',openshortstringtype); + addtype('$boolean',pasbool8type); + addtype('$boolean16',pasbool16type); + addtype('$boolean32',pasbool32type); + addtype('$boolean64',pasbool64type); + addtype('$bytebool',bool8type); + addtype('$wordbool',bool16type); + addtype('$longbool',bool32type); + addtype('$qwordbool',bool64type); + addtype('$void_pointer',voidpointertype); + addtype('$char_pointer',charpointertype); + addtype('$widechar_pointer',widecharpointertype); + addtype('$void_farpointer',voidfarpointertype); + addtype('$openchararray',openchararraytype); + addtype('$file',cfiletype); + addtype('$variant',cvarianttype); + addtype('$olevariant',cvarianttype); + if init_settings.fputype<>fpu_none then + begin + addtype('$s32real',s32floattype); + addtype('$s64real',s64floattype); + addtype('$s80real',s80floattype); + addtype('$sc80real',sc80floattype); + end; + addtype('$s64currency',s64currencytype); + { Add a type for virtual method tables } + hrecst:=trecordsymtable.create('',current_settings.packrecords); + vmttype:=trecorddef.create('',hrecst); + pvmttype:=tpointerdef.create(vmttype); + { can't use addtype for pvmt because the rtti of the pointed + type is not available. The rtti for pvmt will be written implicitly + by thev tblarray below } + systemunit.insert(ttypesym.create('$pvmt',pvmttype)); + addfield(hrecst,tfieldvarsym.create('$length',vs_value,ptrsinttype,[])); + addfield(hrecst,tfieldvarsym.create('$mlength',vs_value,ptrsinttype,[])); + addfield(hrecst,tfieldvarsym.create('$parent',vs_value,pvmttype,[])); + { it seems vmttype is used both for TP objects and Delphi classes, + so the next entry could either be the first virtual method (vm1) + (object) or the class name (class). We can't easily create separate + vtable formats for both, as gdb is hard coded to search for + __vtbl_ptr_type in all cases (JM) } + addfield(hrecst,tfieldvarsym.create('$vm1_or_classname',vs_value,tpointerdef.create(cshortstringtype),[])); + vmtarraytype:=tarraydef.create(0,0,s32inttype); + tarraydef(vmtarraytype).elementdef:=voidpointertype; + addfield(hrecst,tfieldvarsym.create('$__pfn',vs_value,vmtarraytype,[])); + addtype('$__vtbl_ptr_type',vmttype); + vmtarraytype:=tarraydef.create(0,1,s32inttype); + tarraydef(vmtarraytype).elementdef:=pvmttype; + addtype('$vtblarray',vmtarraytype); + { Add a type for methodpointers } + hrecst:=trecordsymtable.create('',1); + addfield(hrecst,tfieldvarsym.create('$proc',vs_value,voidpointertype,[])); + addfield(hrecst,tfieldvarsym.create('$self',vs_value,voidpointertype,[])); + methodpointertype:=trecorddef.create('',hrecst); + addtype('$methodpointer',methodpointertype); + symtablestack.pop(systemunit); + end; + + + procedure load_intern_types; + { + Load all default definitions for consts from the system unit + } + + procedure loadtype(const s:string;var def:tdef); + var + srsym : ttypesym; + begin + srsym:=search_system_type(s); + def:=srsym.typedef; + end; + + var + oldcurrentmodule : tmodule; + begin + if target_info.system=system_x86_64_win64 then + pbestrealtype:=@s64floattype; + + oldcurrentmodule:=current_module; + set_current_module(nil); + loadtype('byte',u8inttype); + loadtype('shortint',s8inttype); + loadtype('word',u16inttype); + loadtype('smallint',s16inttype); + loadtype('ulong',u32inttype); + loadtype('longint',s32inttype); + loadtype('qword',u64inttype); + loadtype('int64',s64inttype); + loadtype('undefined',cundefinedtype); + loadtype('formal',cformaltype); + loadtype('typedformal',ctypedformaltype); + loadtype('void',voidtype); + loadtype('char',cchartype); + loadtype('widechar',cwidechartype); + loadtype('shortstring',cshortstringtype); + loadtype('longstring',clongstringtype); + loadtype('ansistring',cansistringtype); + loadtype('widestring',cwidestringtype); + loadtype('unicodestring',cunicodestringtype); + loadtype('openshortstring',openshortstringtype); + loadtype('openchararray',openchararraytype); + if init_settings.fputype <> fpu_none then + begin + loadtype('s32real',s32floattype); + loadtype('s64real',s64floattype); + loadtype('s80real',s80floattype); + loadtype('sc80real',sc80floattype); + end; + loadtype('s64currency',s64currencytype); + loadtype('boolean',pasbool8type); + loadtype('boolean16',pasbool16type); + loadtype('boolean32',pasbool32type); + loadtype('boolean64',pasbool64type); + loadtype('bytebool',bool8type); + loadtype('wordbool',bool16type); + loadtype('longbool',bool32type); + loadtype('qwordbool',bool64type); + loadtype('void_pointer',voidpointertype); + loadtype('char_pointer',charpointertype); + loadtype('widechar_pointer',widecharpointertype); + loadtype('void_farpointer',voidfarpointertype); + loadtype('file',cfiletype); + loadtype('pvmt',pvmttype); + loadtype('vtblarray',vmtarraytype); + loadtype('__vtbl_ptr_type',vmttype); + loadtype('variant',cvarianttype); + loadtype('olevariant',colevarianttype); + loadtype('methodpointer',methodpointertype); + loadtype('HRESULT',hresultdef); +{$ifdef cpu64bitaddr} + uinttype:=u64inttype; + sinttype:=s64inttype; + ptruinttype:=u64inttype; + ptrsinttype:=s64inttype; +{$endif cpu64bitaddr} +{$ifdef cpu32bit} + uinttype:=u32inttype; + sinttype:=s32inttype; + ptruinttype:=u32inttype; + ptrsinttype:=s32inttype; +{$endif cpu32bit} +{$ifdef cpu16bit} + uinttype:=u16inttype; + sinttype:=s16inttype; + ptruinttype:=u16inttype; + ptrsinttype:=s16inttype; +{$endif cpu16bit} + set_current_module(oldcurrentmodule); + end; + + + procedure registernodes; + { + Register all possible nodes in the nodeclass array that + will be used for loading the nodes from a ppu + } + begin + nodeclass[addn]:=caddnode; + nodeclass[muln]:=caddnode; + nodeclass[subn]:=caddnode; + nodeclass[divn]:=cmoddivnode; + nodeclass[symdifn]:=caddnode; + nodeclass[modn]:=cmoddivnode; + nodeclass[assignn]:=cassignmentnode; + nodeclass[loadn]:=cloadnode; + nodeclass[rangen]:=crangenode; + nodeclass[ltn]:=caddnode; + nodeclass[lten]:=caddnode; + nodeclass[gtn]:=caddnode; + nodeclass[gten]:=caddnode; + nodeclass[equaln]:=caddnode; + nodeclass[unequaln]:=caddnode; + nodeclass[inn]:=cinnode; + nodeclass[orn]:=caddnode; + nodeclass[xorn]:=caddnode; + nodeclass[shrn]:=cshlshrnode; + nodeclass[shln]:=cshlshrnode; + nodeclass[slashn]:=caddnode; + nodeclass[andn]:=caddnode; + nodeclass[subscriptn]:=csubscriptnode; + nodeclass[derefn]:=cderefnode; + nodeclass[addrn]:=caddrnode; + nodeclass[ordconstn]:=cordconstnode; + nodeclass[typeconvn]:=ctypeconvnode; + nodeclass[calln]:=ccallnode; + nodeclass[callparan]:=ccallparanode; + nodeclass[realconstn]:=crealconstnode; + nodeclass[unaryminusn]:=cunaryminusnode; + nodeclass[unaryplusn]:=cunaryplusnode; + nodeclass[asmn]:=casmnode; + nodeclass[vecn]:=cvecnode; + nodeclass[pointerconstn]:=cpointerconstnode; + nodeclass[stringconstn]:=cstringconstnode; + nodeclass[notn]:=cnotnode; + nodeclass[inlinen]:=cinlinenode; + nodeclass[niln]:=cnilnode; + nodeclass[errorn]:=cerrornode; + nodeclass[typen]:=ctypenode; + nodeclass[setelementn]:=csetelementnode; + nodeclass[setconstn]:=csetconstnode; + nodeclass[blockn]:=cblocknode; + nodeclass[statementn]:=cstatementnode; + nodeclass[ifn]:=cifnode; + nodeclass[breakn]:=cbreaknode; + nodeclass[continuen]:=ccontinuenode; + nodeclass[whilerepeatn]:=cwhilerepeatnode; + nodeclass[forn]:=cfornode; + nodeclass[exitn]:=cexitnode; + nodeclass[withn]:=cwithnode; + nodeclass[casen]:=ccasenode; + nodeclass[labeln]:=clabelnode; + nodeclass[goton]:=cgotonode; + nodeclass[tryexceptn]:=ctryexceptnode; + nodeclass[raisen]:=craisenode; + nodeclass[tryfinallyn]:=ctryfinallynode; + nodeclass[onn]:=connode; + nodeclass[isn]:=cisnode; + nodeclass[asn]:=casnode; + nodeclass[starstarn]:=caddnode; + nodeclass[arrayconstructorn]:=carrayconstructornode; + nodeclass[arrayconstructorrangen]:=carrayconstructorrangenode; + nodeclass[tempcreaten]:=ctempcreatenode; + nodeclass[temprefn]:=ctemprefnode; + nodeclass[tempdeleten]:=ctempdeletenode; + nodeclass[addoptn]:=caddnode; + nodeclass[nothingn]:=cnothingnode; + nodeclass[loadvmtaddrn]:=cloadvmtaddrnode; + nodeclass[guidconstn]:=cguidconstnode; + nodeclass[rttin]:=crttinode; + nodeclass[loadparentfpn]:=cloadparentfpnode; + end; + + + procedure registertais; + { + Register all possible tais in the taiclass array that + will be used for loading the tais from a ppu + } + begin + aiclass[ait_none]:=nil; + aiclass[ait_align]:=tai_align; + aiclass[ait_section]:=tai_section; + aiclass[ait_comment]:=tai_comment; + aiclass[ait_string]:=tai_string; + aiclass[ait_instruction]:=taicpu; + aiclass[ait_datablock]:=tai_datablock; + aiclass[ait_symbol]:=tai_symbol; + aiclass[ait_symbol_end]:=tai_symbol_end; + aiclass[ait_directive]:=tai_directive; + aiclass[ait_label]:=tai_label; + aiclass[ait_const]:=tai_const; + aiclass[ait_real_32bit]:=tai_real_32bit; + aiclass[ait_real_64bit]:=tai_real_64bit; + aiclass[ait_real_80bit]:=tai_real_80bit; + aiclass[ait_comp_64bit]:=tai_comp_64bit; + aiclass[ait_stab]:=tai_stab; + aiclass[ait_force_line]:=tai_force_line; + aiclass[ait_function_name]:=tai_function_name; +{$ifdef alpha} + { the follow is for the DEC Alpha } + aiclass[ait_frame]:=tai_frame; + aiclass[ait_ent]:=tai_ent; +{$endif alpha} +{$ifdef m68k} +{ TODO: FIXME: tai_labeled_instruction doesn't exists} +// aiclass[ait_labeled_instruction]:=tai_labeled_instruction; +{$endif m68k} +{$ifdef ia64} + aiclass[ait_bundle]:=tai_bundle; + aiclass[ait_stop]:=tai_stop; +{$endif ia64} +{$ifdef SPARC} +// aiclass[ait_labeled_instruction]:=tai_labeled_instruction; +{$endif SPARC} +{$ifdef arm} + aiclass[ait_thumb_func]:=tai_thumb_func; +{$endif arm} + aiclass[ait_cutobject]:=tai_cutobject; + aiclass[ait_regalloc]:=tai_regalloc; + aiclass[ait_tempalloc]:=tai_tempalloc; + aiclass[ait_marker]:=tai_marker; + aiclass[ait_seh_directive]:=tai_seh_directive; + end; + +end. diff --git a/closures/compiler/ptconst.pas b/closures/compiler/ptconst.pas new file mode 100644 index 0000000000..51d0126472 --- /dev/null +++ b/closures/compiler/ptconst.pas @@ -0,0 +1,1570 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Reads typed constants + + 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 ptconst; + +{$i fpcdefs.inc} + +interface + + uses symtype,symsym,aasmdata; + + procedure read_typed_const(list:tasmlist;sym:tstaticvarsym;in_structure:boolean); + + +implementation + + uses + SysUtils, + globtype,systems,tokens,verbose,constexp, + cclasses,cutils,globals,widestr,scanner, + symconst,symbase,symdef,symtable, + aasmbase,aasmtai,aasmcpu,defutil,defcmp, + { pass 1 } + node,htypechk,procinfo, + nmat,nadd,ncal,nmem,nset,ncnv,ninl,ncon,nld,nflw, + { parser specific stuff } + pbase,pexpr,pdecvar, + { codegen } + cpuinfo,cgbase,dbgbase, + wpobase,asmutils + ; + +{$maxfpuregisters 0} + +{***************************************************************************** + Bitpacked value helpers +*****************************************************************************} + + type + tbitpackedval = record + curval, nextval: aword; + curbitoffset: smallint; + loadbitsize,packedbitsize: byte; + end; + + + procedure initbitpackval(out bp: tbitpackedval; packedbitsize: byte); + begin + bp.curval:=0; + bp.nextval:=0; + bp.curbitoffset:=0; + bp.packedbitsize:=packedbitsize; + bp.loadbitsize:=packedbitsloadsize(bp.packedbitsize)*8; + end; + + +{$push} +{$r-} +{$q-} + { (values between quotes below refer to fields of bp; fields not } + { mentioned are unused by this routine) } + { bitpacks "value" as bitpacked value of bitsize "packedbitsize" into } + { "curval", which has already been filled up to "curbitoffset", and } + { stores the spillover if any into "nextval". It also updates } + { curbitoffset to reflect how many bits of currval are now used (can be } + { > AIntBits in case of spillover) } + procedure bitpackval(value: aword; var bp: tbitpackedval); + var + shiftcount: longint; + begin + if (target_info.endian=endian_big) then + begin + { bitpacked format: left-aligned (i.e., "big endian bitness") } + bp.curval:=bp.curval or ((value shl (AIntBits-bp.packedbitsize)) shr bp.curbitoffset); + shiftcount:=((AIntBits-bp.packedbitsize)-bp.curbitoffset); + { carry-over to the next element? } + if (shiftcount<0) then + bp.nextval:=(value and ((aword(1) shl (-shiftcount))-1)) shl + (AIntBits+shiftcount) + end + else + begin + { bitpacked format: right aligned (i.e., "little endian bitness") } + bp.curval:=bp.curval or (value shl bp.curbitoffset); + { carry-over to the next element? } + if (bp.curbitoffset+bp.packedbitsize>AIntBits) then + bp.nextval:=value shr (AIntBits-bp.curbitoffset) + end; + inc(bp.curbitoffset,bp.packedbitsize); + end; + +{$pop} + + procedure flush_packed_value(list: tasmlist; var bp: tbitpackedval); + var + bitstowrite: longint; + writeval : byte; + begin + if (bp.curbitoffset < AIntBits) then + begin + { forced flush -> write multiple of loadsize } + bitstowrite:=align(bp.curbitoffset,bp.loadbitsize); + bp.curbitoffset:=0; + end + else + begin + bitstowrite:=AIntBits; + dec(bp.curbitoffset,AIntBits); + end; + while (bitstowrite>=8) do + begin + if (target_info.endian=endian_little) then + begin + { write lowest byte } + writeval:=byte(bp.curval); + bp.curval:=bp.curval shr 8; + end + else + begin + { write highest byte } + writeval:=bp.curval shr (AIntBits-8); + bp.curval:=(bp.curval and (not($ff shl (AIntBits-8)))) shl 8; + end; + list.concat(tai_const.create_8bit(writeval)); + dec(bitstowrite,8); + end; + bp.curval:=bp.nextval; + bp.nextval:=0; + end; + + +{***************************************************************************** + read typed const +*****************************************************************************} + + type + { context used for parsing complex types (arrays/records/objects) } + threc = record + list : tasmlist; + origsym: tstaticvarsym; + offset: asizeint; + origblock: tblock_type; + end; + + { this procedure reads typed constants } + procedure read_typed_const_data(var hr:threc;def:tdef); forward; + + procedure parse_orddef(list:tasmlist;def:torddef); + var + n : tnode; + intvalue : tconstexprint; + + procedure do_error; + begin + if is_constnode(n) then + IncompatibleTypes(n.resultdef, def) + else + Message(parser_e_illegal_expression); + end; + + begin + n:=comp_expr(true,false); + { for C-style booleans, true=-1 and false=0) } + if is_cbool(def) then + inserttypeconv(n,def); + case def.ordtype of + pasbool8, + bool8bit : + begin + if is_constboolnode(n) then + list.concat(Tai_const.Create_8bit(byte(tordconstnode(n).value.svalue))) + else + do_error; + end; + pasbool16, + bool16bit : + begin + if is_constboolnode(n) then + list.concat(Tai_const.Create_16bit(word(tordconstnode(n).value.svalue))) + else + do_error; + end; + pasbool32, + bool32bit : + begin + if is_constboolnode(n) then + list.concat(Tai_const.Create_32bit(longint(tordconstnode(n).value.svalue))) + else + do_error; + end; + pasbool64, + bool64bit : + begin + if is_constboolnode(n) then + list.concat(Tai_const.Create_64bit(int64(tordconstnode(n).value.svalue))) + else + do_error; + end; + uchar : + begin + if is_constwidecharnode(n) then + inserttypeconv(n,cchartype); + if is_constcharnode(n) or + ((m_delphi in current_settings.modeswitches) and + is_constwidecharnode(n) and + (tordconstnode(n).value <= 255)) then + list.concat(Tai_const.Create_8bit(byte(tordconstnode(n).value.svalue))) + else + do_error; + end; + uwidechar : + begin + if is_constcharnode(n) then + inserttypeconv(n,cwidechartype); + if is_constwidecharnode(n) then + list.concat(Tai_const.Create_16bit(word(tordconstnode(n).value.svalue))) + else + do_error; + end; + s8bit,u8bit, + u16bit,s16bit, + s32bit,u32bit, + s64bit,u64bit : + begin + if is_constintnode(n) then + begin + testrange(def,tordconstnode(n).value,false,false); + case def.size of + 1 : + list.concat(Tai_const.Create_8bit(byte(tordconstnode(n).value.svalue))); + 2 : + list.concat(Tai_const.Create_16bit(word(tordconstnode(n).value.svalue))); + 4 : + list.concat(Tai_const.Create_32bit(longint(tordconstnode(n).value.svalue))); + 8 : + list.concat(Tai_const.Create_64bit(tordconstnode(n).value.svalue)); + end; + end + else + do_error; + end; + scurrency: + begin + if is_constintnode(n) then + intvalue := tordconstnode(n).value + { allow bootstrapping } + else if is_constrealnode(n) then + intvalue:=PInt64(@trealconstnode(n).value_currency)^ + else + begin + intvalue:=0; + IncompatibleTypes(n.resultdef, def); + end; + list.concat(Tai_const.Create_64bit(intvalue)); + end; + else + internalerror(200611052); + end; + n.free; + end; + + procedure parse_floatdef(list:tasmlist;def:tfloatdef); + var + n : tnode; + value : bestreal; + begin + n:=comp_expr(true,false); + if is_constrealnode(n) then + value:=trealconstnode(n).value_real + else if is_constintnode(n) then + value:=tordconstnode(n).value + else if is_constnode(n) then + IncompatibleTypes(n.resultdef, def) + else + Message(parser_e_illegal_expression); + + case def.floattype of + s32real : + list.concat(Tai_real_32bit.Create(ts32real(value))); + s64real : +{$ifdef ARM} + if is_double_hilo_swapped then + list.concat(Tai_real_64bit.Create_hiloswapped(ts64real(value))) + else +{$endif ARM} + list.concat(Tai_real_64bit.Create(ts64real(value))); + s80real : + list.concat(Tai_real_80bit.Create(value,s80floattype.size)); + sc80real : + list.concat(Tai_real_80bit.Create(value,sc80floattype.size)); + s64comp : + { the round is necessary for native compilers where comp isn't a float } + list.concat(Tai_comp_64bit.Create(round(value))); + s64currency: + list.concat(Tai_comp_64bit.Create(round(value*10000))); + s128real: + list.concat(Tai_real_128bit.Create(value)); + else + internalerror(200611053); + end; + n.free; + end; + + procedure parse_classrefdef(list:tasmlist;def:tclassrefdef); + var + n : tnode; + begin + n:=comp_expr(true,false); + case n.nodetype of + loadvmtaddrn: + begin + if not Tobjectdef(tclassrefdef(n.resultdef).pointeddef).is_related(tobjectdef(def.pointeddef)) then + IncompatibleTypes(n.resultdef, def); + list.concat(Tai_const.Create_sym(current_asmdata.RefAsmSymbol(Tobjectdef(tclassrefdef(n.resultdef).pointeddef).vmt_mangledname))); + { update wpo info } + if not assigned(current_procinfo) or + (po_inline in current_procinfo.procdef.procoptions) or + wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname) then + tobjectdef(tclassrefdef(n.resultdef).pointeddef).register_maybe_created_object_type; + end; + niln: + list.concat(Tai_const.Create_sym(nil)); + else if is_constnode(n) then + IncompatibleTypes(n.resultdef, def) + else + Message(parser_e_illegal_expression); + end; + n.free; + end; + + procedure parse_pointerdef(list:tasmlist;def:tpointerdef); + var + hp,p : tnode; + srsym : tsym; + pd : tprocdef; + ca : pchar; + pw : pcompilerwidestring; + i,len : longint; + base, + offset : aint; + v : Tconstexprint; + ll : tasmlabel; + varalign : shortint; + begin + p:=comp_expr(true,false); + { remove equal typecasts for pointer/nil addresses } + if (p.nodetype=typeconvn) then + with Ttypeconvnode(p) do + if (left.nodetype in [addrn,niln]) and equal_defs(def,p.resultdef) then + begin + hp:=left; + left:=nil; + p.free; + p:=hp; + end; + { allows horrible ofs(typeof(TButton)^) code !! } + if (p.nodetype=addrn) then + with Taddrnode(p) do + if left.nodetype=derefn then + begin + hp:=tderefnode(left).left; + tderefnode(left).left:=nil; + p.free; + p:=hp; + end; + { const pointer ? } + if (p.nodetype = pointerconstn) then + begin + {$if sizeof(TConstPtrUInt)=8} + list.concat(Tai_const.Create_64bit(int64(tpointerconstnode(p).value))); + {$else} + {$if sizeof(TConstPtrUInt)=4} + list.concat(Tai_const.Create_32bit(longint(tpointerconstnode(p).value))); + {$else} + internalerror(200404122); + {$endif} {$endif} + end + { nil pointer ? } + else if p.nodetype=niln then + list.concat(Tai_const.Create_sym(nil)) + { maybe pchar ? } + else + if is_char(def.pointeddef) and + (p.nodetype<>addrn) then + begin + current_asmdata.getdatalabel(ll); + list.concat(Tai_const.Create_sym(ll)); + if p.nodetype=stringconstn then + varalign:=size_2_align(tstringconstnode(p).len) + else + varalign:=0; + varalign:=const_align(varalign); + new_section(current_asmdata.asmlists[al_const], sec_rodata, ll.name, varalign); + current_asmdata.asmlists[al_const].concat(Tai_label.Create(ll)); + if p.nodetype=stringconstn then + begin + len:=tstringconstnode(p).len; + { For tp7 the maximum lentgh can be 255 } + if (m_tp7 in current_settings.modeswitches) and + (len>255) then + len:=255; + getmem(ca,len+2); + move(tstringconstnode(p).value_str^,ca^,len+1); + current_asmdata.asmlists[al_const].concat(Tai_string.Create_pchar(ca,len+1)); + end + else + if is_constcharnode(p) then + current_asmdata.asmlists[al_const].concat(Tai_string.Create(char(byte(tordconstnode(p).value.svalue))+#0)) + else + IncompatibleTypes(p.resultdef, def); + end + { maybe pwidechar ? } + else + if is_widechar(def.pointeddef) and + (p.nodetype<>addrn) then + begin + current_asmdata.getdatalabel(ll); + list.concat(Tai_const.Create_sym(ll)); + current_asmdata.asmlists[al_typedconsts].concat(tai_align.create(const_align(sizeof(pint)))); + current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(ll)); + if (p.nodetype in [stringconstn,ordconstn]) then + begin + { convert to widestring stringconstn } + inserttypeconv(p,cwidestringtype); + if (p.nodetype=stringconstn) and + (tstringconstnode(p).cst_type in [cst_widestring,cst_unicodestring]) then + begin + pw:=pcompilerwidestring(tstringconstnode(p).value_str); + for i:=0 to tstringconstnode(p).len-1 do + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_16bit(pw^.data[i])); + { ending #0 } + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_16bit(0)) + end; + end + else + IncompatibleTypes(p.resultdef, def); + end + else + if (p.nodetype=addrn) or + is_proc2procvar_load(p,pd) then + begin + { insert typeconv } + inserttypeconv(p,def); + hp:=p; + while assigned(hp) and (hp.nodetype in [addrn,typeconvn,subscriptn,vecn]) do + hp:=tunarynode(hp).left; + if (hp.nodetype=loadn) then + begin + hp:=p; + offset:=0; + while assigned(hp) and (hp.nodetype<>loadn) do + begin + case hp.nodetype of + vecn : + begin + case tvecnode(hp).left.resultdef.typ of + stringdef : + begin + { this seems OK for shortstring and ansistrings PM } + { it is wrong for widestrings !! } + len:=1; + base:=0; + end; + arraydef : + begin + if not is_packed_array(tvecnode(hp).left.resultdef) then + begin + len:=tarraydef(tvecnode(hp).left.resultdef).elesize; + base:=tarraydef(tvecnode(hp).left.resultdef).lowrange; + end + else + begin + Message(parser_e_packed_dynamic_open_array); + len:=1; + base:=0; + end; + end + else + Message(parser_e_illegal_expression); + end; + if is_constintnode(tvecnode(hp).right) then + begin + {Prevent overflow.} + v:=get_ordinal_value(tvecnode(hp).right)-base; + if (v<int64(low(offset))) or (v>int64(high(offset))) then + message(parser_e_range_check_error); + if high(offset)-offset div len>v then + inc(offset,len*v.svalue) + else + message(parser_e_range_check_error); + end + else + Message(parser_e_illegal_expression); + end; + subscriptn : + inc(offset,tsubscriptnode(hp).vs.fieldoffset); + typeconvn : + begin + if not(ttypeconvnode(hp).convtype in [tc_equal,tc_proc_2_procvar]) then + Message(parser_e_illegal_expression); + end; + addrn : + ; + else + Message(parser_e_illegal_expression); + end; + hp:=tunarynode(hp).left; + end; + srsym:=tloadnode(hp).symtableentry; + case srsym.typ of + procsym : + begin + pd:=tprocdef(tprocsym(srsym).ProcdefList[0]); + if Tprocsym(srsym).ProcdefList.Count>1 then + Message(parser_e_no_overloaded_procvars); + if po_abstractmethod in pd.procoptions then + Message(type_e_cant_take_address_of_abstract_method) + else + list.concat(Tai_const.Createname(pd.mangledname,offset)); + end; + staticvarsym : + list.concat(Tai_const.Createname(tstaticvarsym(srsym).mangledname,offset)); + labelsym : + list.concat(Tai_const.Createname(tlabelsym(srsym).mangledname,offset)); + constsym : + if tconstsym(srsym).consttyp=constresourcestring then + list.concat(Tai_const.Createname(make_mangledname('RESSTR',tconstsym(srsym).owner,tconstsym(srsym).name),sizeof(pint))) + else + Message(type_e_variable_id_expected); + else + Message(type_e_variable_id_expected); + end; + end + else + Message(parser_e_illegal_expression); + end + else + { allow typeof(Object type)} + if (p.nodetype=inlinen) and + (tinlinenode(p).inlinenumber=in_typeof_x) then + begin + if (tinlinenode(p).left.nodetype=typen) then + begin + list.concat(Tai_const.createname( + tobjectdef(tinlinenode(p).left.resultdef).vmt_mangledname,0)); + end + else + Message(parser_e_illegal_expression); + end + else + Message(parser_e_illegal_expression); + p.free; + end; + + procedure parse_setdef(list:tasmlist;def:tsetdef); + type + setbytes = array[0..31] of byte; + Psetbytes = ^setbytes; + var + p : tnode; + i : longint; + begin + p:=comp_expr(true,false); + if p.nodetype=setconstn then + begin + { be sure to convert to the correct result, else + it can generate smallset data instead of normalset (PFV) } + inserttypeconv(p,def); + { we only allow const sets } + if (p.nodetype<>setconstn) or + assigned(tsetconstnode(p).left) then + Message(parser_e_illegal_expression) + else + begin + tsetconstnode(p).adjustforsetbase; + { this writing is endian-dependant } + if source_info.endian = target_info.endian then + begin + for i:=0 to p.resultdef.size-1 do + list.concat(tai_const.create_8bit(Psetbytes(tsetconstnode(p).value_set)^[i])); + end + else + begin + for i:=0 to p.resultdef.size-1 do + list.concat(tai_const.create_8bit(reverse_byte(Psetbytes(tsetconstnode(p).value_set)^[i]))); + end; + end; + end + else + Message(parser_e_illegal_expression); + p.free; + end; + + procedure parse_enumdef(list:tasmlist;def:tenumdef); + var + p : tnode; + begin + p:=comp_expr(true,false); + if p.nodetype=ordconstn then + begin + if equal_defs(p.resultdef,def) or + is_subequal(p.resultdef,def) then + begin + case longint(p.resultdef.size) of + 1 : list.concat(Tai_const.Create_8bit(Byte(tordconstnode(p).value.svalue))); + 2 : list.concat(Tai_const.Create_16bit(Word(tordconstnode(p).value.svalue))); + 4 : list.concat(Tai_const.Create_32bit(Longint(tordconstnode(p).value.svalue))); + end; + end + else + IncompatibleTypes(p.resultdef,def); + end + else + Message(parser_e_illegal_expression); + p.free; + end; + + + procedure parse_stringdef(const hr:threc;def:tstringdef); + var + n : tnode; + strlength : aint; + strval : pchar; + strch : char; + ll : tasmlabel; + ca : pchar; + winlike : boolean; + hsym : tconstsym; + begin + n:=comp_expr(true,false); + { load strval and strlength of the constant tree } + if (n.nodetype=stringconstn) or is_wide_or_unicode_string(def) or is_constwidecharnode(n) or + ((n.nodetype=typen) and is_interfacecorba(ttypenode(n).typedef)) then + begin + { convert to the expected string type so that + for widestrings strval is a pcompilerwidestring } + inserttypeconv(n,def); + if (not codegenerror) and + (n.nodetype=stringconstn) then + begin + strlength:=tstringconstnode(n).len; + strval:=tstringconstnode(n).value_str; + end + else + begin + { an error occurred trying to convert the result to a string } + strlength:=-1; + { it's possible that the type conversion could not be + evaluated at compile-time } + if not codegenerror then + CGMessage(parser_e_widestring_to_ansi_compile_time); + end; + end + else if is_constcharnode(n) then + begin + { strval:=pchar(@tordconstnode(n).value); + THIS FAIL on BIG_ENDIAN MACHINES PM } + strch:=chr(tordconstnode(n).value.svalue and $ff); + strval:=@strch; + strlength:=1 + end + else if is_constresourcestringnode(n) then + begin + hsym:=tconstsym(tloadnode(n).symtableentry); + strval:=pchar(hsym.value.valueptr); + strlength:=hsym.value.len; + { Delphi-compatible (mis)feature: + Link AnsiString constants to their initializing resourcestring, + enabling them to be (re)translated at runtime. + Wide/UnicodeString are currently rejected above (with incorrect error message). + ShortStrings cannot be handled unless another table is built for them; + considering this acceptable, because Delphi rejects them altogether. + } + if (not is_shortstring(def)) and + ((hr.origsym.owner.symtablelevel<=main_program_level) or + (hr.origblock=bt_const)) then + begin + current_asmdata.ResStrInits.Concat( + TTCInitItem.Create(hr.origsym,hr.offset, + current_asmdata.RefAsmSymbol(make_mangledname('RESSTR',hsym.owner,hsym.name))) + ); + Include(hr.origsym.varoptions,vo_force_finalize); + end; + end + else + begin + Message(parser_e_illegal_expression); + strlength:=-1; + end; + if strlength>=0 then + begin + case def.stringtype of + st_shortstring: + begin + if strlength>=def.size then + begin + message2(parser_w_string_too_long,strpas(strval),tostr(def.size-1)); + strlength:=def.size-1; + end; + hr.list.concat(Tai_const.Create_8bit(strlength)); + { this can also handle longer strings } + getmem(ca,strlength+1); + move(strval^,ca^,strlength); + ca[strlength]:=#0; + hr.list.concat(Tai_string.Create_pchar(ca,strlength)); + { fillup with spaces if size is shorter } + if def.size>strlength then + begin + getmem(ca,def.size-strlength); + { def.size contains also the leading length, so we } + { we have to subtract one } + fillchar(ca[0],def.size-strlength-1,' '); + ca[def.size-strlength-1]:=#0; + { this can also handle longer strings } + hr.list.concat(Tai_string.Create_pchar(ca,def.size-strlength-1)); + end; + end; + st_ansistring: + begin + { an empty ansi string is nil! } + if (strlength=0) then + ll := nil + else + ll := emit_ansistring_const(current_asmdata.asmlists[al_const],strval,strlength,def.encoding); + hr.list.concat(Tai_const.Create_sym(ll)); + end; + st_unicodestring, + st_widestring: + begin + { an empty wide/unicode string is nil! } + if (strlength=0) then + ll := nil + else + begin + winlike := (def.stringtype=st_widestring) and (tf_winlikewidestring in target_info.flags); + ll := emit_unicodestring_const(current_asmdata.asmlists[al_const], + strval, + def.encoding, + winlike); + + { Collect Windows widestrings that need initialization at startup. + Local initialized vars are excluded because they are initialized + at function entry instead. } + if winlike and ((hr.origsym.owner.symtablelevel <= main_program_level) or + (hr.origblock=bt_const)) then + begin + current_asmdata.WideInits.Concat( + TTCInitItem.Create(hr.origsym, hr.offset, ll) + ); + ll := nil; + Include(hr.origsym.varoptions, vo_force_finalize); + end; + end; + hr.list.concat(Tai_const.Create_sym(ll)); + end; + else + internalerror(200107081); + end; + end; + n.free; + end; + + + { parse a single constant and add it to the packed const info } + { represented by curval etc (see explanation of bitpackval for } + { what the different parameters mean) } + function parse_single_packed_const(list: tasmlist; def: tdef; var bp: tbitpackedval): boolean; + var + n : tnode; + begin + result:=true; + n:=comp_expr(true,false); + if (n.nodetype <> ordconstn) or + (not equal_defs(n.resultdef,def) and + not is_subequal(n.resultdef,def)) then + begin + n.free; + incompatibletypes(n.resultdef,def); + consume_all_until(_SEMICOLON); + result:=false; + exit; + end; + if (Tordconstnode(n).value<qword(low(Aword))) or (Tordconstnode(n).value>qword(high(Aword))) then + message(parser_e_range_check_error) + else + bitpackval(Tordconstnode(n).value.uvalue,bp); + if (bp.curbitoffset>=AIntBits) then + flush_packed_value(list,bp); + n.free; + end; + + + { parses a packed array constant } + procedure parse_packed_array_def(list: tasmlist; def: tarraydef); + var + i : aint; + bp : tbitpackedval; + begin + if not(def.elementdef.typ in [orddef,enumdef]) then + internalerror(2007022010); + { begin of the array } + consume(_LKLAMMER); + initbitpackval(bp,def.elepackedbitsize); + i:=def.lowrange; + { can't use for-loop, fails when cross-compiling from } + { 32 to 64 bit because i is then 64 bit } + while (i<def.highrange) do + begin + { get next item of the packed array } + if not parse_single_packed_const(list,def.elementdef,bp) then + exit; + consume(_COMMA); + inc(i); + end; + { final item } + if not parse_single_packed_const(list,def.elementdef,bp) then + exit; + { flush final incomplete value if necessary } + if (bp.curbitoffset <> 0) then + flush_packed_value(list,bp); + consume(_RKLAMMER); + end; + + + procedure parse_arraydef(hr:threc;def:tarraydef); + var + n : tnode; + i : longint; + len : asizeint; + ch : array[0..1] of char; + ca : pbyte; + int_const: tai_const; + char_size: integer; + begin + { dynamic array nil } + if is_dynamic_array(def) then + begin + { Only allow nil initialization } + consume(_NIL); + hr.list.concat(Tai_const.Create_sym(nil)); + end + { packed array constant } + else if is_packed_array(def) and + ((def.elepackedbitsize mod 8 <> 0) or + not ispowerof2(def.elepackedbitsize div 8,i)) then + begin + parse_packed_array_def(hr.list,def); + end + { normal array const between brackets } + else if try_to_consume(_LKLAMMER) then + begin + hr.offset:=0; + for i:=def.lowrange to def.highrange-1 do + begin + read_typed_const_data(hr,def.elementdef); + Inc(hr.offset,def.elementdef.size); + if token=_RKLAMMER then + begin + Message1(parser_e_more_array_elements_expected,tostr(def.highrange-i)); + consume(_RKLAMMER); + exit; + end + else + consume(_COMMA); + end; + read_typed_const_data(hr,def.elementdef); + consume(_RKLAMMER); + end + { if array of char then we allow also a string } + else if is_anychar(def.elementdef) then + begin + char_size:=def.elementdef.size; + n:=comp_expr(true,false); + if n.nodetype=stringconstn then + begin + len:=tstringconstnode(n).len; + case char_size of + 1: + begin + if (tstringconstnode(n).cst_type in [cst_unicodestring,cst_widestring]) then + inserttypeconv(n,getansistringdef); + if n.nodetype<>stringconstn then + internalerror(2010033003); + ca:=pointer(tstringconstnode(n).value_str); + end; + 2: + begin + inserttypeconv(n,cwidestringtype); + if n.nodetype<>stringconstn then + internalerror(2010033003); + ca:=pointer(pcompilerwidestring(tstringconstnode(n).value_str)^.data) + end; + else + internalerror(2010033005); + end; + { For tp7 the maximum lentgh can be 255 } + if (m_tp7 in current_settings.modeswitches) and + (len>255) then + len:=255; + end + else if is_constcharnode(n) then + begin + case char_size of + 1: + ch[0]:=chr(tordconstnode(n).value.uvalue and $ff); + 2: + begin + inserttypeconv(n,cwidechartype); + if not is_constwidecharnode(n) then + internalerror(2010033001); + widechar(ch):=widechar(tordconstnode(n).value.uvalue and $ffff); + end; + else + internalerror(2010033002); + end; + ca:=@ch; + len:=1; + end + else if is_constwidecharnode(n) and (current_settings.sourcecodepage<>CP_UTF8) then + begin + case char_size of + 1: + begin + inserttypeconv(n,cchartype); + if not is_constcharnode(n) then + internalerror(2010033001); + ch[0]:=chr(tordconstnode(n).value.uvalue and $ff); + end; + 2: + widechar(ch):=widechar(tordconstnode(n).value.uvalue and $ffff); + else + internalerror(2010033002); + end; + ca:=@ch; + len:=1; + end + else + begin + Message(parser_e_illegal_expression); + len:=0; + end; + if len>(def.highrange-def.lowrange+1) then + Message(parser_e_string_larger_array); + for i:=0 to def.highrange-def.lowrange do + begin + if i<len then + begin + case char_size of + 1: + int_const:=Tai_const.Create_char(char_size,pbyte(ca)^); + 2: + int_const:=Tai_const.Create_char(char_size,pword(ca)^); + else + internalerror(2010033004); + end; + inc(ca, char_size); + end + else + {Fill the remaining positions with #0.} + int_const:=Tai_const.Create_char(char_size,0); + hr.list.concat(int_const) + end; + n.free; + end + else + begin + { we want the ( } + consume(_LKLAMMER); + end; + end; + + procedure parse_procvardef(list:tasmlist;def:tprocvardef); + var + tmpn,n : tnode; + pd : tprocdef; + begin + { Procvars and pointers are no longer compatible. } + { under tp: =nil or =var under fpc: =nil or =@var } + if try_to_consume(_NIL) then + begin + list.concat(Tai_const.Create_sym(nil)); + if not def.is_addressonly then + list.concat(Tai_const.Create_sym(nil)); + exit; + end; + { you can't assign a value other than NIL to a typed constant } + { which is a "procedure of object", because this also requires } + { address of an object/class instance, which is not known at } + { compile time (JM) } + if (po_methodpointer in def.procoptions) then + Message(parser_e_no_procvarobj_const); + { parse the rest too, so we can continue with error checking } + getprocvardef:=def; + n:=comp_expr(true,false); + getprocvardef:=nil; + if codegenerror then + begin + n.free; + exit; + end; + { let type conversion check everything needed } + inserttypeconv(n,def); + if codegenerror then + begin + n.free; + exit; + end; + { remove typeconvs, that will normally insert a lea + instruction which is not necessary for us } + while n.nodetype=typeconvn do + begin + tmpn:=ttypeconvnode(n).left; + ttypeconvnode(n).left:=nil; + n.free; + n:=tmpn; + end; + { remove addrn which we also don't need here } + if n.nodetype=addrn then + begin + tmpn:=taddrnode(n).left; + taddrnode(n).left:=nil; + n.free; + n:=tmpn; + end; + { we now need to have a loadn with a procsym } + if (n.nodetype=loadn) and + (tloadnode(n).symtableentry.typ=procsym) then + begin + pd:=tloadnode(n).procdef; + list.concat(Tai_const.createname(pd.mangledname,0)); + { nested procvar typed consts can only be initialised with nil + (checked above) or with a global procedure (checked here), + because in other cases we need a valid frame pointer } + if is_nested_pd(def) then + begin + if is_nested_pd(pd) then + Message(parser_e_no_procvarnested_const); + list.concat(Tai_const.Create_sym(nil)); + end + end + else + Message(parser_e_illegal_expression); + n.free; + end; + + procedure parse_recorddef(hr:threc;def:trecorddef); + var + n : tnode; + symidx : longint; + recsym, + srsym : tsym; + hs : string; + sorg,s : TIDString; + tmpguid : tguid; + curroffset, + fillbytes : aint; + bp : tbitpackedval; + error, + is_packed: boolean; + startoffset: aint; + + procedure handle_stringconstn; + var + i : longint; + begin + hs:=strpas(tstringconstnode(n).value_str); + if string2guid(hs,tmpguid) then + begin + hr.list.concat(Tai_const.Create_32bit(longint(tmpguid.D1))); + hr.list.concat(Tai_const.Create_16bit(tmpguid.D2)); + hr.list.concat(Tai_const.Create_16bit(tmpguid.D3)); + for i:=Low(tmpguid.D4) to High(tmpguid.D4) do + hr.list.concat(Tai_const.Create_8bit(tmpguid.D4[i])); + end + else + Message(parser_e_improper_guid_syntax); + end; + + function get_next_varsym(const SymList:TFPHashObjectList; var symidx:longint):tsym;inline; + begin + while symidx<SymList.Count do + begin + result:=tsym(def.symtable.SymList[symidx]); + inc(symidx); + if result.typ=fieldvarsym then + exit; + end; + result:=nil; + end; + + var + i : longint; + SymList:TFPHashObjectList; + begin + { GUID } + if (def=rec_tguid) and (token=_ID) then + begin + n:=comp_expr(true,false); + if n.nodetype=stringconstn then + handle_stringconstn + else + begin + inserttypeconv(n,rec_tguid); + if n.nodetype=guidconstn then + begin + tmpguid:=tguidconstnode(n).value; + hr.list.concat(Tai_const.Create_32bit(longint(tmpguid.D1))); + hr.list.concat(Tai_const.Create_16bit(tmpguid.D2)); + hr.list.concat(Tai_const.Create_16bit(tmpguid.D3)); + for i:=Low(tmpguid.D4) to High(tmpguid.D4) do + hr.list.concat(Tai_const.Create_8bit(tmpguid.D4[i])); + end + else + Message(parser_e_illegal_expression); + end; + n.free; + exit; + end; + if (def=rec_tguid) and ((token=_CSTRING) or (token=_CCHAR)) then + begin + n:=comp_expr(true,false); + inserttypeconv(n,cshortstringtype); + if n.nodetype=stringconstn then + handle_stringconstn + else + Message(parser_e_illegal_expression); + n.free; + exit; + end; + { bitpacked record? } + is_packed:=is_packed_record_or_object(def); + if (is_packed) then + begin + { loadbitsize = 8, bitpacked records are always padded to } + { a multiple of a byte. packedbitsize will be set separately } + { for each field } + initbitpackval(bp,0); + bp.loadbitsize:=8; + end; + { normal record } + consume(_LKLAMMER); + curroffset:=0; + sorg:=''; + symidx:=0; + symlist:=def.symtable.SymList; + srsym:=get_next_varsym(symlist,symidx); + recsym := nil; + startoffset:=hr.offset; + while token<>_RKLAMMER do + begin + s:=pattern; + sorg:=orgpattern; + consume(_ID); + consume(_COLON); + error := false; + recsym := tsym(def.symtable.Find(s)); + if not assigned(recsym) then + begin + Message1(sym_e_illegal_field,sorg); + error := true; + end; + if (not error) and + (not assigned(srsym) or + (s <> srsym.name)) then + { possible variant record (JM) } + begin + { All parts of a variant start at the same offset } + { Also allow jumping from one variant part to another, } + { as long as the offsets match } + if (assigned(srsym) and + (tfieldvarsym(recsym).fieldoffset = tfieldvarsym(srsym).fieldoffset)) or + { srsym is not assigned after parsing w2 in the } + { typed const in the next example: } + { type tr = record case byte of } + { 1: (l1,l2: dword); } + { 2: (w1,w2: word); } + { end; } + { const r: tr = (w1:1;w2:1;l2:5); } + (tfieldvarsym(recsym).fieldoffset = curroffset) then + begin + srsym:=recsym; + { symidx should contain the next symbol id to search } + symidx:=SymList.indexof(srsym)+1; + end + { going backwards isn't allowed in any mode } + else if (tfieldvarsym(recsym).fieldoffset<curroffset) then + begin + Message(parser_e_invalid_record_const); + error := true; + end + { Delphi allows you to skip fields } + else if (m_delphi in current_settings.modeswitches) then + begin + Message1(parser_w_skipped_fields_before,sorg); + srsym := recsym; + end + { FPC and TP don't } + else + begin + Message1(parser_e_skipped_fields_before,sorg); + error := true; + end; + end; + if error then + consume_all_until(_SEMICOLON) + else + begin + { if needed fill (alignment) } + if tfieldvarsym(srsym).fieldoffset>curroffset then + begin + if not(is_packed) then + fillbytes:=tfieldvarsym(srsym).fieldoffset-curroffset + else + begin + flush_packed_value(hr.list,bp); + { curoffset is now aligned to the next byte } + curroffset:=align(curroffset,8); + { offsets are in bits in this case } + fillbytes:=(tfieldvarsym(srsym).fieldoffset-curroffset) div 8; + end; + for i:=1 to fillbytes do + hr.list.concat(Tai_const.Create_8bit(0)) + end; + + { new position } + curroffset:=tfieldvarsym(srsym).fieldoffset; + if not(is_packed) then + inc(curroffset,tfieldvarsym(srsym).vardef.size) + else + inc(curroffset,tfieldvarsym(srsym).vardef.packedbitsize); + + { read the data } + if not(is_packed) or + { only orddefs and enumdefs are bitpacked, as in gcc/gpc } + not(tfieldvarsym(srsym).vardef.typ in [orddef,enumdef]) then + begin + if is_packed then + begin + flush_packed_value(hr.list,bp); + curroffset:=align(curroffset,8); + end; + hr.offset:=startoffset+tfieldvarsym(srsym).fieldoffset; + read_typed_const_data(hr,tfieldvarsym(srsym).vardef); + end + else + begin + bp.packedbitsize:=tfieldvarsym(srsym).vardef.packedbitsize; + parse_single_packed_const(hr.list,tfieldvarsym(srsym).vardef,bp); + end; + + { keep previous field for checking whether whole } + { record was initialized (JM) } + recsym := srsym; + { goto next field } + srsym:=get_next_varsym(SymList,symidx); + if token=_SEMICOLON then + consume(_SEMICOLON) + else if (token=_COMMA) and (m_mac in current_settings.modeswitches) then + consume(_COMMA) + else + break; + end; + end; + + { are there any fields left, but don't complain if there only + come other variant parts after the last initialized field } + if assigned(srsym) and + ( + (recsym=nil) or + (tfieldvarsym(srsym).fieldoffset > tfieldvarsym(recsym).fieldoffset) + ) then + Message1(parser_w_skipped_fields_after,sorg); + + if not(is_packed) then + fillbytes:=def.size-curroffset + else + begin + flush_packed_value(hr.list,bp); + curroffset:=align(curroffset,8); + fillbytes:=def.size-(curroffset div 8); + end; + for i:=1 to fillbytes do + hr.list.concat(Tai_const.Create_8bit(0)); + + consume(_RKLAMMER); + end; + + { note: hr is passed by value } + procedure parse_objectdef(hr:threc;def:tobjectdef); + var + n : tnode; + i : longint; + obj : tobjectdef; + srsym : tsym; + st : tsymtable; + curroffset : aint; + s,sorg : TIDString; + vmtwritten : boolean; + startoffset:aint; + begin + { no support for packed object } + if is_packed_record_or_object(def) then + begin + Message(type_e_no_const_packed_record); + exit; + end; + + { only allow nil for implicit pointer object types } + if is_implicit_pointer_object_type(def) then + begin + n:=comp_expr(true,false); + if n.nodetype<>niln then + begin + Message(parser_e_type_const_not_possible); + consume_all_until(_SEMICOLON); + end + else + hr.list.concat(Tai_const.Create_sym(nil)); + n.free; + exit; + end; + + { for objects we allow it only if it doesn't contain a vmt } + if (oo_has_vmt in def.objectoptions) and + (m_fpc in current_settings.modeswitches) then + begin + Message(parser_e_type_object_constants); + exit; + end; + + consume(_LKLAMMER); + startoffset:=hr.offset; + curroffset:=0; + vmtwritten:=false; + while token<>_RKLAMMER do + begin + s:=pattern; + sorg:=orgpattern; + consume(_ID); + consume(_COLON); + srsym:=nil; + obj:=tobjectdef(def); + st:=obj.symtable; + while (srsym=nil) and assigned(st) do + begin + srsym:=tsym(st.Find(s)); + if assigned(obj) then + obj:=obj.childof; + if assigned(obj) then + st:=obj.symtable + else + st:=nil; + end; + + if (srsym=nil) or + (srsym.typ<>fieldvarsym) then + begin + if (srsym=nil) then + Message1(sym_e_id_not_found,sorg) + else + Message1(sym_e_illegal_field,sorg); + consume_all_until(_RKLAMMER); + break; + end + else + with tfieldvarsym(srsym) do + begin + { check position } + if fieldoffset<curroffset then + message(parser_e_invalid_record_const); + + { check in VMT needs to be added for TP mode } + if not(vmtwritten) and + not(m_fpc in current_settings.modeswitches) and + (oo_has_vmt in def.objectoptions) and + (def.vmt_offset<fieldoffset) then + begin + for i:=1 to def.vmt_offset-curroffset do + hr.list.concat(tai_const.create_8bit(0)); + hr.list.concat(tai_const.createname(def.vmt_mangledname,0)); + { this is more general } + curroffset:=def.vmt_offset + sizeof(pint); + vmtwritten:=true; + end; + + { if needed fill } + if fieldoffset>curroffset then + for i:=1 to fieldoffset-curroffset do + hr.list.concat(Tai_const.Create_8bit(0)); + + { new position } + curroffset:=fieldoffset+vardef.size; + + { read the data } + hr.offset:=startoffset+fieldoffset; + read_typed_const_data(hr,vardef); + + if not try_to_consume(_SEMICOLON) then + break; + end; + end; + if not(m_fpc in current_settings.modeswitches) and + (oo_has_vmt in def.objectoptions) and + (def.vmt_offset>=curroffset) then + begin + for i:=1 to def.vmt_offset-curroffset do + hr.list.concat(tai_const.create_8bit(0)); + hr.list.concat(tai_const.createname(def.vmt_mangledname,0)); + { this is more general } + curroffset:=def.vmt_offset + sizeof(pint); + end; + for i:=1 to def.size-curroffset do + hr.list.concat(Tai_const.Create_8bit(0)); + consume(_RKLAMMER); + end; + + procedure read_typed_const_data(var hr:threc;def:tdef); + var + old_block_type : tblock_type; + begin + old_block_type:=block_type; + block_type:=bt_const; + case def.typ of + orddef : + parse_orddef(hr.list,torddef(def)); + floatdef : + parse_floatdef(hr.list,tfloatdef(def)); + classrefdef : + parse_classrefdef(hr.list,tclassrefdef(def)); + pointerdef : + parse_pointerdef(hr.list,tpointerdef(def)); + setdef : + parse_setdef(hr.list,tsetdef(def)); + enumdef : + parse_enumdef(hr.list,tenumdef(def)); + stringdef : + parse_stringdef(hr,tstringdef(def)); + arraydef : + parse_arraydef(hr,tarraydef(def)); + procvardef: + parse_procvardef(hr.list,tprocvardef(def)); + recorddef: + parse_recorddef(hr,trecorddef(def)); + objectdef: + parse_objectdef(hr,tobjectdef(def)); + errordef: + begin + { try to consume something useful } + if token=_LKLAMMER then + consume_all_until(_RKLAMMER) + else + consume_all_until(_SEMICOLON); + end; + else + Message(parser_e_type_const_not_possible); + end; + block_type:=old_block_type; + end; + +{$maxfpuregisters default} + + procedure read_typed_const(list:tasmlist;sym:tstaticvarsym;in_structure:boolean); + var + storefilepos : tfileposinfo; + cursectype : TAsmSectionType; + hrec : threc; + section : ansistring; + begin + { mark the staticvarsym as typedconst } + include(sym.varoptions,vo_is_typed_const); + { The variable has a value assigned } + sym.varstate:=vs_initialised; + { the variable can't be placed in a register } + sym.varregable:=vr_none; + + { generate data for typed const } + storefilepos:=current_filepos; + current_filepos:=sym.fileinfo; + if sym.varspez=vs_const then + cursectype:=sec_rodata + else + cursectype:=sec_data; + maybe_new_object_file(list); + hrec.list:=tasmlist.create; + hrec.origsym:=sym; + hrec.offset:=0; + hrec.origblock:=block_type; + read_typed_const_data(hrec,sym.vardef); + + { Parse hints } + try_consume_hintdirective(sym.symoptions,sym.deprecatedmsg); + + consume(_SEMICOLON); + + { parse public/external/export/... } + if not in_structure and + ( + ( + (token = _ID) and + (idtoken in [_EXPORT,_EXTERNAL,_WEAKEXTERNAL,_PUBLIC,_CVAR]) and + (m_cvar_support in current_settings.modeswitches) + ) or + ( + (m_mac in current_settings.modeswitches) and + ( + (cs_external_var in current_settings.localswitches) or + (cs_externally_visible in current_settings.localswitches) + ) + ) + ) then + read_public_and_external(sym); + + { try to parse a section directive } + if not in_structure and (target_info.system in systems_allow_section) and + (symtablestack.top.symtabletype in [staticsymtable,globalsymtable]) and + (idtoken=_SECTION) then + begin + try_consume_sectiondirective(section); + if section<>'' then + begin + if (sym.varoptions *[vo_is_external,vo_is_weak_external])<>[] then + Message(parser_e_externals_no_section); + if sym.typ<>staticvarsym then + Message(parser_e_section_no_locals); + tstaticvarsym(sym).section:=section; + include(sym.varoptions, vo_has_section); + end; + end; + + { only now add items based on the symbolname, because it may } + { have been modified by the directives parsed above } + if vo_has_section in sym.varoptions then + new_section(list,sec_user,sym.section,const_align(sym.vardef.alignment)) + else + new_section(list,cursectype,lower(sym.mangledname),const_align(sym.vardef.alignment)); + if (sym.owner.symtabletype=globalsymtable) or + create_smartlink or + (assigned(current_procinfo) and + (po_inline in current_procinfo.procdef.procoptions)) or + DLLSource then + list.concat(Tai_symbol.Createname_global(sym.mangledname,AT_DATA,0)) + else + list.concat(Tai_symbol.Createname(sym.mangledname,AT_DATA,0)); + + { add the parsed value } + list.concatlist(hrec.list); + hrec.list.free; + list.concat(tai_symbol_end.Createname(sym.mangledname)); + current_filepos:=storefilepos; + end; + +end. diff --git a/closures/compiler/ptype.pas b/closures/compiler/ptype.pas new file mode 100644 index 0000000000..ab5fc03d2e --- /dev/null +++ b/closures/compiler/ptype.pas @@ -0,0 +1,1590 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Does parsing types for Free Pascal + + 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 ptype; + +{$i fpcdefs.inc} + +interface + + uses + globtype,cclasses, + symtype,symdef,symbase; + + type + TSingleTypeOption=( + stoIsForwardDef, { foward declaration } + stoAllowTypeDef, { allow type definitions } + stoAllowSpecialization, { allow type specialization } + stoParseClassParent { parse of parent class type } + ); + TSingleTypeOptions=set of TSingleTypeOption; + + procedure resolve_forward_types; + + { reads a string, file type or a type identifier } + procedure single_type(var def:tdef;options:TSingleTypeOptions); + + { reads any type declaration, where the resulting type will get name as type identifier } + procedure read_named_type(var def:tdef;const name : TIDString;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean); + + { reads any type declaration } + procedure read_anon_type(var def : tdef;parseprocvardir:boolean); + + { generate persistent type information like VMT, RTTI and inittables } + procedure write_persistent_type_info(st:tsymtable); + +implementation + + uses + { common } + cutils, + { global } + globals,tokens,verbose,constexp, + systems, + { target } + paramgr,procinfo, + { symtable } + symconst,symsym,symtable, + defutil,defcmp, + { modules } + fmodule, + { pass 1 } + node,ncgrtti,nobj, + nmat,nadd,ncal,nset,ncnv,ninl,ncon,nld,nflw, + { parser } + scanner, + pbase,pexpr,pdecsub,pdecvar,pdecobj,pdecl,pgenutil; + + + procedure resolve_forward_types; + var + i: longint; + hpd, + def : tdef; + srsym : tsym; + srsymtable : TSymtable; + hs : string; + begin + for i:=0 to current_module.checkforwarddefs.Count-1 do + begin + def:=tdef(current_module.checkforwarddefs[i]); + case def.typ of + pointerdef, + classrefdef : + begin + { classrefdef inherits from pointerdef } + hpd:=tabstractpointerdef(def).pointeddef; + { still a forward def ? } + if hpd.typ=forwarddef then + begin + { try to resolve the forward } + if not assigned(tforwarddef(hpd).tosymname) then + internalerror(200211201); + hs:=tforwarddef(hpd).tosymname^; + searchsym(upper(hs),srsym,srsymtable); + { we don't need the forwarddef anymore, dispose it } + hpd.free; + tabstractpointerdef(def).pointeddef:=nil; { if error occurs } + { was a type sym found ? } + if assigned(srsym) and + (srsym.typ=typesym) then + begin + tabstractpointerdef(def).pointeddef:=ttypesym(srsym).typedef; + { avoid wrong unused warnings web bug 801 PM } + inc(ttypesym(srsym).refs); + { we need a class type for classrefdef } + if (def.typ=classrefdef) and + not(is_class(ttypesym(srsym).typedef)) and + not(is_objcclass(ttypesym(srsym).typedef)) then + MessagePos1(def.typesym.fileinfo,type_e_class_type_expected,ttypesym(srsym).typedef.typename); + end + else + begin + Message1(sym_e_forward_type_not_resolved,hs); + { try to recover } + tabstractpointerdef(def).pointeddef:=generrordef; + end; + end; + end; + objectdef : + begin + { give an error as the implementation may follow in an + other type block which is allowed by FPC modes } + if not(m_fpc in current_settings.modeswitches) and + (oo_is_forward in tobjectdef(def).objectoptions) then + MessagePos1(def.typesym.fileinfo,type_e_type_is_not_completly_defined,def.typename); + end; + else + internalerror(200811071); + end; + end; + current_module.checkforwarddefs.clear; + end; + + + procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms:boolean;out srsym:tsym;out srsymtable:tsymtable); forward; + + + { def is the outermost type in which other types have to be searched + + isforward indicates whether the current definition can be a forward definition + + if assigned, currentstructstack is a list of tabstractrecorddefs that, from + last to first, are child types of def that are not yet visible via the + normal symtable searching routines because they are types that are currently + being parsed (so using id_type on them after pushing def on the + symtablestack would result in errors because they'd come back as errordef) + } + procedure parse_nested_types(var def: tdef; isforwarddef: boolean; currentstructstack: tfpobjectlist); + var + t2: tdef; + structstackindex: longint; + srsym: tsym; + srsymtable: tsymtable; + begin + if assigned(currentstructstack) then + structstackindex:=currentstructstack.count-1 + else + structstackindex:=-1; + { handle types inside classes, e.g. TNode.TLongint } + while (token=_POINT) do + begin + if is_class_or_object(def) or is_record(def) then + begin + consume(_POINT); + if (structstackindex>=0) and + (tabstractrecorddef(currentstructstack[structstackindex]).objname^=pattern) then + begin + def:=tdef(currentstructstack[structstackindex]); + dec(structstackindex); + consume(_ID); + end + else + begin + structstackindex:=-1; + symtablestack.push(tabstractrecorddef(def).symtable); + t2:=generrordef; + id_type(t2,isforwarddef,false,false,srsym,srsymtable); + symtablestack.pop(tabstractrecorddef(def).symtable); + def:=t2; + end; + end + else + break; + end; + end; + + + function try_parse_structdef_nested_type(out def: tdef; basedef: tabstractrecorddef; isfowarddef: boolean): boolean; + var + structdef : tdef; + structdefstack : tfpobjectlist; + begin + def:=nil; + { use of current parsed object: + classes, objects, records can be used also in themself } + structdef:=basedef; + structdefstack:=nil; + while assigned(structdef) and (structdef.typ in [objectdef,recorddef]) do + begin + if (tabstractrecorddef(structdef).objname^=pattern) then + begin + consume(_ID); + def:=structdef; + { we found the top-most match, now check how far down we can + follow } + structdefstack:=tfpobjectlist.create(false); + structdef:=basedef; + while (structdef<>def) do + begin + structdefstack.add(structdef); + structdef:=tabstractrecorddef(structdef.owner.defowner); + end; + parse_nested_types(def,isfowarddef,structdefstack); + structdefstack.free; + result:=true; + exit; + end; + structdef:=tdef(tabstractrecorddef(structdef).owner.defowner); + end; + result:=false; + end; + + procedure id_type(var def : tdef;isforwarddef,checkcurrentrecdef,allowgenericsyms:boolean;out srsym:tsym;out srsymtable:tsymtable); + { reads a type definition } + { to a appropriating tdef, s gets the name of } + { the type to allow name mangling } + var + is_unit_specific : boolean; + pos : tfileposinfo; + s,sorg : TIDString; + t : ttoken; + begin + srsym:=nil; + srsymtable:=nil; + s:=pattern; + sorg:=orgpattern; + pos:=current_tokenpos; + { use of current parsed object: + classes, objects, records can be used also in themself } + if checkcurrentrecdef and + try_parse_structdef_nested_type(def,current_structdef,isforwarddef) then + exit; + { Use the special searchsym_type that search only types } + searchsym_type(s,srsym,srsymtable); + { handle unit specification like System.Writeln } + is_unit_specific:=try_consume_unitsym(srsym,srsymtable,t,true); + consume(t); + { Types are first defined with an error def before assigning + the real type so check if it's an errordef. if so then + give an error. Only check for typesyms in the current symbol + table as forwarddef are not resolved directly } + if assigned(srsym) and + (srsym.typ=typesym) and + ((ttypesym(srsym).typedef.typ=errordef) or + (not allowgenericsyms and + (ttypesym(srsym).typedef.typ=undefineddef) and + not (sp_generic_para in srsym.symoptions))) then + begin + Message1(type_e_type_is_not_completly_defined,ttypesym(srsym).realname); + def:=generrordef; + exit; + end; + { are we parsing a possible forward def ? } + if isforwarddef and + not(is_unit_specific) then + begin + def:=tforwarddef.create(sorg,pos); + exit; + end; + { unknown sym ? } + if not assigned(srsym) then + begin + Message1(sym_e_id_not_found,sorg); + def:=generrordef; + exit; + end; + { type sym ? } + if (srsym.typ<>typesym) then + begin + Message(type_e_type_id_expected); + def:=generrordef; + exit; + end; + { Give an error when referring to an errordef } + if (ttypesym(srsym).typedef.typ=errordef) then + begin + Message(sym_e_error_in_type_def); + def:=generrordef; + exit; + end; + def:=ttypesym(srsym).typedef; + end; + + + procedure single_type(var def:tdef;options:TSingleTypeOptions); + var + t2 : tdef; + dospecialize, + again : boolean; + srsym : tsym; + srsymtable : tsymtable; + begin + dospecialize:=false; + repeat + again:=false; + case token of + _STRING: + string_dec(def,stoAllowTypeDef in options); + + _FILE: + begin + consume(_FILE); + if (token=_OF) then + begin + if not(stoAllowTypeDef in options) then + Message(parser_e_no_local_para_def); + consume(_OF); + single_type(t2,[stoAllowTypeDef]); + if is_managed_type(t2) then + Message(parser_e_no_refcounted_typed_file); + def:=tfiledef.createtyped(t2); + end + else + def:=cfiletype; + end; + + _ID: + begin + if try_to_consume(_SPECIALIZE) then + begin + if ([stoAllowSpecialization,stoAllowTypeDef] * options = []) then + begin + Message(parser_e_no_local_para_def); + + { try to recover } + while token<>_SEMICOLON do + consume(token); + def:=generrordef; + end + else + begin + dospecialize:=true; + again:=true; + end; + end + else + begin + id_type(def,stoIsForwardDef in options,true,true,srsym,srsymtable); + parse_nested_types(def,stoIsForwardDef in options,nil); + end; + end; + + else + begin + message(type_e_type_id_expected); + def:=generrordef; + end; + end; + until not again; + if ([stoAllowSpecialization,stoAllowTypeDef] * options <> []) and + (m_delphi in current_settings.modeswitches) then + dospecialize:=token in [_LSHARPBRACKET,_LT]; + if dospecialize then + generate_specialization(def,stoParseClassParent in options,'',nil,'') + else + begin + if assigned(current_specializedef) and (def=current_specializedef.genericdef) then + begin + def:=current_specializedef + end + else if (def=current_genericdef) then + begin + def:=current_genericdef + end + else if (df_generic in def.defoptions) and + not + ( + parse_generic and + (current_genericdef.typ in [recorddef,objectdef]) and + sym_is_owned_by(srsym,tabstractrecorddef(current_genericdef).symtable) + ) + then + begin + Message(parser_e_no_generics_as_types); + def:=generrordef; + end + else if is_classhelper(def) and + not (stoParseClassParent in options) then + begin + Message(parser_e_no_category_as_types); + def:=generrordef + end + end; + end; + + procedure parse_record_members; + + procedure maybe_parse_hint_directives(pd:tprocdef); + var + dummysymoptions : tsymoptions; + deprecatedmsg : pshortstring; + begin + dummysymoptions:=[]; + deprecatedmsg:=nil; + while try_consume_hintdirective(dummysymoptions,deprecatedmsg) do + Consume(_SEMICOLON); + if assigned(pd) then + begin + pd.symoptions:=pd.symoptions+dummysymoptions; + pd.deprecatedmsg:=deprecatedmsg; + end + else + stringdispose(deprecatedmsg); + end; + + var + pd : tprocdef; + oldparse_only: boolean; + member_blocktype : tblock_type; + fields_allowed, is_classdef, classfields: boolean; + vdoptions: tvar_dec_options; + begin + { empty record declaration ? } + if (token=_SEMICOLON) then + Exit; + + current_structdef.symtable.currentvisibility:=vis_public; + fields_allowed:=true; + is_classdef:=false; + classfields:=false; + member_blocktype:=bt_general; + repeat + case token of + _TYPE : + begin + consume(_TYPE); + member_blocktype:=bt_type; + + { local and anonymous records can not have inner types. skip top record symtable } + if (current_structdef.objname^='') or + not(symtablestack.stack^.next^.symtable.symtabletype in [globalsymtable,staticsymtable,objectsymtable,recordsymtable]) then + Message(parser_e_no_types_in_local_anonymous_records); + end; + _VAR : + begin + consume(_VAR); + fields_allowed:=true; + member_blocktype:=bt_general; + classfields:=is_classdef; + is_classdef:=false; + end; + _CONST: + begin + consume(_CONST); + member_blocktype:=bt_const; + end; + _ID, _CASE, _OPERATOR : + begin + case idtoken of + _PRIVATE : + begin + consume(_PRIVATE); + current_structdef.symtable.currentvisibility:=vis_private; + include(current_structdef.objectoptions,oo_has_private); + fields_allowed:=true; + is_classdef:=false; + classfields:=false; + member_blocktype:=bt_general; + end; + _PROTECTED : + begin + consume(_PROTECTED); + current_structdef.symtable.currentvisibility:=vis_protected; + include(current_structdef.objectoptions,oo_has_protected); + fields_allowed:=true; + is_classdef:=false; + classfields:=false; + member_blocktype:=bt_general; + end; + _PUBLIC : + begin + consume(_PUBLIC); + current_structdef.symtable.currentvisibility:=vis_public; + fields_allowed:=true; + is_classdef:=false; + classfields:=false; + member_blocktype:=bt_general; + end; + _PUBLISHED : + begin + Message(parser_e_no_record_published); + consume(_PUBLISHED); + current_structdef.symtable.currentvisibility:=vis_published; + fields_allowed:=true; + is_classdef:=false; + classfields:=false; + member_blocktype:=bt_general; + end; + _STRICT : + begin + consume(_STRICT); + if token=_ID then + begin + case idtoken of + _PRIVATE: + begin + consume(_PRIVATE); + current_structdef.symtable.currentvisibility:=vis_strictprivate; + include(current_structdef.objectoptions,oo_has_strictprivate); + end; + _PROTECTED: + begin + consume(_PROTECTED); + current_structdef.symtable.currentvisibility:=vis_strictprotected; + include(current_structdef.objectoptions,oo_has_strictprotected); + end; + else + message(parser_e_protected_or_private_expected); + end; + end + else + message(parser_e_protected_or_private_expected); + fields_allowed:=true; + is_classdef:=false; + classfields:=false; + member_blocktype:=bt_general; + end + else + if is_classdef and (idtoken=_OPERATOR) then + begin + oldparse_only:=parse_only; + parse_only:=true; + pd:=parse_proc_dec(is_classdef,current_structdef); + + { this is for error recovery as well as forward } + { interface mappings, i.e. mapping to a method } + { which isn't declared yet } + if assigned(pd) then + begin + parse_record_proc_directives(pd); + + handle_calling_convention(pd); + + { add definition to procsym } + proc_add_definition(pd); + end; + + maybe_parse_hint_directives(pd); + + parse_only:=oldparse_only; + fields_allowed:=false; + is_classdef:=false; + end + else + begin + if member_blocktype=bt_general then + begin + if (not fields_allowed)and(idtoken<>_CASE) then + Message(parser_e_field_not_allowed_here); + vdoptions:=[vd_record]; + if classfields then + include(vdoptions,vd_class); + read_record_fields(vdoptions); + end + else if member_blocktype=bt_type then + types_dec(true) + else if member_blocktype=bt_const then + consts_dec(true) + else + internalerror(201001110); + end; + end; + end; + _PROPERTY : + begin + struct_property_dec(is_classdef); + fields_allowed:=false; + is_classdef:=false; + end; + _CLASS: + begin + is_classdef:=false; + { read class method/field/property } + consume(_CLASS); + { class modifier is only allowed for procedures, functions, } + { constructors, destructors, fields and properties } + if not(token in [_FUNCTION,_PROCEDURE,_PROPERTY,_VAR,_CONSTRUCTOR,_DESTRUCTOR,_OPERATOR]) and + not((token=_ID) and (idtoken=_OPERATOR)) then + Message(parser_e_procedure_or_function_expected); + + is_classdef:=true; + end; + _PROCEDURE, + _FUNCTION: + begin + oldparse_only:=parse_only; + parse_only:=true; + pd:=parse_proc_dec(is_classdef,current_structdef); + + { this is for error recovery as well as forward } + { interface mappings, i.e. mapping to a method } + { which isn't declared yet } + if assigned(pd) then + begin + parse_record_proc_directives(pd); + + { since records have no inheritance don't allow non static + class methods. delphi do so. } + if is_classdef and not (po_staticmethod in pd.procoptions) then + MessagePos(pd.fileinfo, parser_e_class_methods_only_static_in_records); + + handle_calling_convention(pd); + + { add definition to procsym } + proc_add_definition(pd); + end; + + maybe_parse_hint_directives(pd); + + parse_only:=oldparse_only; + fields_allowed:=false; + is_classdef:=false; + end; + _CONSTRUCTOR : + begin + if not is_classdef then + Message(parser_e_no_constructor_in_records); + if not is_classdef and (current_structdef.symtable.currentvisibility <> vis_public) then + Message(parser_w_constructor_should_be_public); + + { only 1 class constructor is allowed } + if is_classdef and (oo_has_class_constructor in current_structdef.objectoptions) then + Message1(parser_e_only_one_class_constructor_allowed, current_structdef.objrealname^); + + oldparse_only:=parse_only; + parse_only:=true; + if is_classdef then + pd:=class_constructor_head + else + pd:=constructor_head; + parse_record_proc_directives(pd); + handle_calling_convention(pd); + + { add definition to procsym } + proc_add_definition(pd); + + maybe_parse_hint_directives(pd); + + parse_only:=oldparse_only; + fields_allowed:=false; + is_classdef:=false; + end; + _DESTRUCTOR : + begin + if not is_classdef then + Message(parser_e_no_destructor_in_records); + + { only 1 class destructor is allowed } + if is_classdef and (oo_has_class_destructor in current_structdef.objectoptions) then + Message1(parser_e_only_one_class_destructor_allowed, current_structdef.objrealname^); + + oldparse_only:=parse_only; + parse_only:=true; + if is_classdef then + pd:=class_destructor_head + else + pd:=destructor_head; + parse_record_proc_directives(pd); + handle_calling_convention(pd); + + { add definition to procsym } + proc_add_definition(pd); + + maybe_parse_hint_directives(pd); + + parse_only:=oldparse_only; + fields_allowed:=false; + is_classdef:=false; + end; + _END : + begin + consume(_END); + break; + end; + else + consume(_ID); { Give a ident expected message, like tp7 } + end; + until false; + end; + + { reads a record declaration } + function record_dec(const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList):tdef; + var + old_current_structdef: tabstractrecorddef; + old_current_genericdef, + old_current_specializedef: tstoreddef; + old_parse_generic: boolean; + recst: trecordsymtable; + begin + old_current_structdef:=current_structdef; + old_current_genericdef:=current_genericdef; + old_current_specializedef:=current_specializedef; + old_parse_generic:=parse_generic; + + current_genericdef:=nil; + current_specializedef:=nil; + { create recdef } + recst:=trecordsymtable.create(n,current_settings.packrecords); + current_structdef:=trecorddef.create(n,recst); + result:=current_structdef; + { insert in symtablestack } + symtablestack.push(recst); + + { usage of specialized type inside its generic template } + if assigned(genericdef) then + current_specializedef:=current_structdef + { reject declaration of generic class inside generic class } + else if assigned(genericlist) then + current_genericdef:=current_structdef; + + { nested types of specializations are specializations as well } + if assigned(old_current_structdef) and + (df_specialization in old_current_structdef.defoptions) then + include(current_structdef.defoptions,df_specialization); + + insert_generic_parameter_types(current_structdef,genericdef,genericlist); + { when we are parsing a generic already then this is a generic as + well } + if old_parse_generic then + include(current_structdef.defoptions, df_generic); + parse_generic:=(df_generic in current_structdef.defoptions); + if m_advanced_records in current_settings.modeswitches then + parse_record_members + else + begin + read_record_fields([vd_record]); + consume(_END); + end; + { make the record size aligned } + recst.addalignmentpadding; + { restore symtable stack } + symtablestack.pop(recst); + if trecorddef(current_structdef).is_packed and is_managed_type(current_structdef) then + Message(type_e_no_packed_inittable); + { restore old state } + parse_generic:=old_parse_generic; + current_structdef:=old_current_structdef; + current_genericdef:=old_current_genericdef; + current_specializedef:=old_current_specializedef; + end; + + + { reads a type definition and returns a pointer to it } + procedure read_named_type(var def : tdef;const name : TIDString;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean); + var + pt : tnode; + tt2 : tdef; + aktenumdef : tenumdef; + s : TIDString; + l,v : TConstExprInt; + oldpackrecords : longint; + defpos,storepos : tfileposinfo; + + procedure expr_type; + var + pt1,pt2 : tnode; + lv,hv : TConstExprInt; + old_block_type : tblock_type; + dospecialize : boolean; + begin + old_block_type:=block_type; + dospecialize:=false; + { use of current parsed object: + classes, objects, records can be used also in themself } + if (token=_ID) then + if try_parse_structdef_nested_type(def,current_structdef,false) then + exit; + { Generate a specialization in FPC mode? } + dospecialize:=not(m_delphi in current_settings.modeswitches) and try_to_consume(_SPECIALIZE); + { we can't accept a equal in type } + pt1:=comp_expr(false,true); + if not dospecialize and + try_to_consume(_POINTPOINT) then + begin + { get high value of range } + pt2:=comp_expr(false,false); + { make both the same type or give an error. This is not + done when both are integer values, because typecasting + between -3200..3200 will result in a signed-unsigned + conflict and give a range check error (PFV) } + if not(is_integer(pt1.resultdef) and is_integer(pt2.resultdef)) then + inserttypeconv(pt1,pt2.resultdef); + { both must be evaluated to constants now } + if (pt1.nodetype=ordconstn) and + (pt2.nodetype=ordconstn) then + begin + lv:=tordconstnode(pt1).value; + hv:=tordconstnode(pt2).value; + { Check bounds } + if hv<lv then + message(parser_e_upper_lower_than_lower) + else if (lv.signed and (lv.svalue<0)) and (not hv.signed and (hv.uvalue>qword(high(int64)))) then + message(type_e_cant_eval_constant_expr) + else + begin + { All checks passed, create the new def } + case pt1.resultdef.typ of + enumdef : + def:=tenumdef.create_subrange(tenumdef(pt1.resultdef),lv.svalue,hv.svalue); + orddef : + begin + if is_char(pt1.resultdef) then + def:=torddef.create(uchar,lv,hv) + else + if is_boolean(pt1.resultdef) then + def:=torddef.create(pasbool8,lv,hv) + else if is_signed(pt1.resultdef) then + def:=torddef.create(range_to_basetype(lv,hv),lv,hv) + else + def:=torddef.create(range_to_basetype(lv,hv),lv,hv); + end; + end; + end; + end + else + Message(sym_e_error_in_type_def); + pt2.free; + end + else + begin + { a simple type renaming or generic specialization } + if (pt1.nodetype=typen) then + begin + def:=ttypenode(pt1).resultdef; + { Delphi mode specialization? } + if (m_delphi in current_settings.modeswitches) then + dospecialize:=token=_LSHARPBRACKET + else + { in non-Delphi modes we might get a inline specialization + without "specialize" or "<T>" of the same type we're + currently parsing, so we need to handle that special } + if not dospecialize and + assigned(ttypenode(pt1).typesym) and + (ttypenode(pt1).typesym.typ=typesym) and + (sp_generic_dummy in ttypenode(pt1).typesym.symoptions) and + assigned(current_structdef) and + ( + ( + not (m_delphi in current_settings.modeswitches) and + (ttypesym(ttypenode(pt1).typesym).typedef.typ=undefineddef) and + (df_generic in current_structdef.defoptions) and + (ttypesym(ttypenode(pt1).typesym).typedef.owner=current_structdef.owner) and + (upper(ttypenode(pt1).typesym.realname)=copy(current_structdef.objname^,1,pos('$',current_structdef.objname^)-1)) + ) or ( + (df_specialization in current_structdef.defoptions) and + (ttypesym(ttypenode(pt1).typesym).typedef=current_structdef.genericdef) + ) + ) + then + begin + def:=current_structdef; + { handle nested types } + post_comp_expr_gendef(def); + end; + if dospecialize then + begin + generate_specialization(def,false,name,nil,''); + { handle nested types } + post_comp_expr_gendef(def); + end + else + begin + if assigned(current_specializedef) and (def=current_specializedef.genericdef) then + begin + def:=current_specializedef + end + else if (def=current_genericdef) then + begin + def:=current_genericdef + end + else if (df_generic in def.defoptions) and + { TODO : check once nested generics are allowed } + not + ( + parse_generic and + (current_genericdef.typ in [recorddef,objectdef]) and + (def.typ in [recorddef,objectdef]) and + (ttypenode(pt1).typesym<>nil) and + sym_is_owned_by(ttypenode(pt1).typesym,tabstractrecorddef(current_genericdef).symtable) + ) + then + begin + Message(parser_e_no_generics_as_types); + def:=generrordef; + end + else if is_classhelper(def) then + begin + Message(parser_e_no_category_as_types); + def:=generrordef + end + end; + end + else + Message(sym_e_error_in_type_def); + end; + pt1.free; + block_type:=old_block_type; + end; + + + procedure set_dec; + begin + consume(_SET); + consume(_OF); + read_anon_type(tt2,true); + if assigned(tt2) then + begin + case tt2.typ of + { don't forget that min can be negativ PM } + enumdef : + if (tenumdef(tt2).min>=0) and + (tenumdef(tt2).max<=255) then + // !! def:=tsetdef.create(tt2,tenumdef(tt2.def).min,tenumdef(tt2.def).max)) + def:=tsetdef.create(tt2,tenumdef(tt2).min,tenumdef(tt2).max) + else + Message(sym_e_ill_type_decl_set); + orddef : + begin + if (torddef(tt2).ordtype<>uvoid) and + (torddef(tt2).ordtype<>uwidechar) and + (torddef(tt2).low>=0) then + // !! def:=tsetdef.create(tt2,torddef(tt2.def).low,torddef(tt2.def).high)) + if Torddef(tt2).high>int64(high(byte)) then + message(sym_e_ill_type_decl_set) + else + def:=tsetdef.create(tt2,torddef(tt2).low.svalue,torddef(tt2).high.svalue) + else + Message(sym_e_ill_type_decl_set); + end; + else + Message(sym_e_ill_type_decl_set); + end; + end + else + def:=generrordef; + end; + + + procedure array_dec(is_packed:boolean;genericdef:tstoreddef;genericlist:TFPObjectList); + var + lowval, + highval : TConstExprInt; + indexdef : tdef; + hdef : tdef; + arrdef : tarraydef; + + procedure setdefdecl(def:tdef); + begin + case def.typ of + enumdef : + begin + lowval:=tenumdef(def).min; + highval:=tenumdef(def).max; + if (m_fpc in current_settings.modeswitches) and + (tenumdef(def).has_jumps) then + Message(type_e_array_index_enums_with_assign_not_possible); + indexdef:=def; + end; + orddef : + begin + if torddef(def).ordtype in [uchar, + u8bit,u16bit, + s8bit,s16bit,s32bit, +{$ifdef cpu64bitaddr} + u32bit,s64bit, +{$endif cpu64bitaddr} + pasbool8,pasbool16,pasbool32,pasbool64, + bool8bit,bool16bit,bool32bit,bool64bit, + uwidechar] then + begin + lowval:=torddef(def).low; + highval:=torddef(def).high; + indexdef:=def; + end + else + Message1(parser_e_type_cant_be_used_in_array_index,def.typename); + end; + else + Message(sym_e_error_in_type_def); + end; + end; + + var + old_current_genericdef, + old_current_specializedef: tstoreddef; + old_parse_generic: boolean; + begin + old_current_genericdef:=current_genericdef; + old_current_specializedef:=current_specializedef; + old_parse_generic:=parse_generic; + + current_genericdef:=nil; + current_specializedef:=nil; + arrdef:=nil; + consume(_ARRAY); + { open array? } + if try_to_consume(_LECKKLAMMER) then + begin + { defaults } + indexdef:=generrordef; + { use defaults which don't overflow the compiler } + lowval:=0; + highval:=0; + repeat + { read the expression and check it, check apart if the + declaration is an enum declaration because that needs to + be parsed by readtype (PFV) } + if token=_LKLAMMER then + begin + read_anon_type(hdef,true); + setdefdecl(hdef); + end + else + begin + pt:=expr(true); + if pt.nodetype=typen then + setdefdecl(pt.resultdef) + else + begin + if pt.nodetype=rangen then + begin + { check the expression only if we are not in a generic declaration } + if not(parse_generic) then + begin + if (trangenode(pt).left.nodetype=ordconstn) and + (trangenode(pt).right.nodetype=ordconstn) then + begin + { make both the same type or give an error. This is not + done when both are integer values, because typecasting + between -3200..3200 will result in a signed-unsigned + conflict and give a range check error (PFV) } + if not(is_integer(trangenode(pt).left.resultdef) and is_integer(trangenode(pt).left.resultdef)) then + inserttypeconv(trangenode(pt).left,trangenode(pt).right.resultdef); + lowval:=tordconstnode(trangenode(pt).left).value; + highval:=tordconstnode(trangenode(pt).right).value; + if highval<lowval then + begin + Message(parser_e_array_lower_less_than_upper_bound); + highval:=lowval; + end + else if (lowval<int64(low(asizeint))) or + (highval>high(asizeint)) then + begin + Message(parser_e_array_range_out_of_bounds); + lowval :=0; + highval:=0; + end; + if is_integer(trangenode(pt).left.resultdef) then + range_to_type(lowval,highval,indexdef) + else + indexdef:=trangenode(pt).left.resultdef; + end + else + Message(type_e_cant_eval_constant_expr); + end; + end + else + Message(sym_e_error_in_type_def) + end; + pt.free; + end; + + { if the array is already created add the new arrray + as element of the existing array, otherwise create a new array } + if assigned(arrdef) then + begin + arrdef.elementdef:=tarraydef.create(lowval.svalue,highval.svalue,indexdef); + arrdef:=tarraydef(arrdef.elementdef); + end + else + begin + arrdef:=tarraydef.create(lowval.svalue,highval.svalue,indexdef); + def:=arrdef; + end; + if is_packed then + include(arrdef.arrayoptions,ado_IsBitPacked); + + if token=_COMMA then + consume(_COMMA) + else + break; + until false; + consume(_RECKKLAMMER); + end + else + begin + if is_packed then + Message(parser_e_packed_dynamic_open_array); + arrdef:=tarraydef.create(0,-1,s32inttype); + include(arrdef.arrayoptions,ado_IsDynamicArray); + def:=arrdef; + end; + if assigned(arrdef) then + begin + { usage of specialized type inside its generic template } + if assigned(genericdef) then + current_specializedef:=arrdef + { reject declaration of generic class inside generic class } + else if assigned(genericlist) then + current_genericdef:=arrdef; + symtablestack.push(arrdef.symtable); + insert_generic_parameter_types(arrdef,genericdef,genericlist); + { there are two possibilties for the following to be true: + * the array declaration itself is generic + * the array is declared inside a generic + in both cases we need "parse_generic" and "current_genericdef" + so that e.g. specializations of another generic inside the + current generic can be used (either inline ones or "type" ones) } + parse_generic:=(df_generic in arrdef.defoptions) or old_parse_generic; + if parse_generic and not assigned(current_genericdef) then + current_genericdef:=old_current_genericdef; + end; + consume(_OF); + read_anon_type(tt2,true); + { set element type of the last array definition } + if assigned(arrdef) then + begin + symtablestack.pop(arrdef.symtable); + arrdef.elementdef:=tt2; + if is_packed and + is_managed_type(tt2) then + Message(type_e_no_packed_inittable); + end; + { restore old state } + parse_generic:=old_parse_generic; + current_genericdef:=old_current_genericdef; + current_specializedef:=old_current_specializedef; + end; + + function procvar_dec(genericdef:tstoreddef;genericlist:TFPObjectList):tdef; + var + is_func:boolean; + pd:tabstractprocdef; + newtype:ttypesym; + old_current_genericdef, + old_current_specializedef: tstoreddef; + old_parse_generic: boolean; + begin + old_current_genericdef:=current_genericdef; + old_current_specializedef:=current_specializedef; + old_parse_generic:=parse_generic; + + current_genericdef:=nil; + current_specializedef:=nil; + + is_func:=(token=_FUNCTION); + consume(token); + pd:=tprocvardef.create(normal_function_level); + + { usage of specialized type inside its generic template } + if assigned(genericdef) then + current_specializedef:=pd + { reject declaration of generic class inside generic class } + else if assigned(genericlist) then + current_genericdef:=pd; + symtablestack.push(pd.parast); + insert_generic_parameter_types(pd,genericdef,genericlist); + { there are two possibilties for the following to be true: + * the procvar declaration itself is generic + * the procvar is declared inside a generic + in both cases we need "parse_generic" and "current_genericdef" + so that e.g. specializations of another generic inside the + current generic can be used (either inline ones or "type" ones) } + parse_generic:=(df_generic in pd.defoptions) or old_parse_generic; + if parse_generic and not assigned(current_genericdef) then + current_genericdef:=old_current_genericdef; + { don't allow to add defs to the symtable - use it for type param search only } + tparasymtable(pd.parast).readonly:=true; + + if token=_LKLAMMER then + parse_parameter_dec(pd); + if is_func then + begin + consume(_COLON); + single_type(pd.returndef,[]); + end; + if try_to_consume(_OF) then + begin + consume(_OBJECT); + include(pd.procoptions,po_methodpointer); + end + else if (m_nested_procvars in current_settings.modeswitches) and + try_to_consume(_IS) then + begin + consume(_NESTED); + pd.parast.symtablelevel:=normal_function_level+1; + pd.check_mark_as_nested; + end; + symtablestack.pop(pd.parast); + tparasymtable(pd.parast).readonly:=false; + result:=pd; + { possible proc directives } + if parseprocvardir then + begin + if check_proc_directive(true) then + begin + newtype:=ttypesym.create('unnamed',result); + parse_var_proc_directives(tsym(newtype)); + newtype.typedef:=nil; + result.typesym:=nil; + newtype.free; + end; + { Add implicit hidden parameters and function result } + handle_calling_convention(pd); + end; + { restore old state } + parse_generic:=old_parse_generic; + current_genericdef:=old_current_genericdef; + current_specializedef:=old_current_specializedef; + end; + + const + SingleTypeOptionsInTypeBlock:array[Boolean] of TSingleTypeOptions = ([],[stoIsForwardDef]); + var + p : tnode; + hdef : tdef; + enumdupmsg, first, is_specialize : boolean; + oldlocalswitches : tlocalswitches; + bitpacking: boolean; + stitem: psymtablestackitem; + sym: tsym; + st: tsymtable; + begin + def:=nil; + case token of + _STRING,_FILE: + begin + single_type(def,[stoAllowTypeDef]); + end; + _LKLAMMER: + begin + consume(_LKLAMMER); + first:=true; + { allow negativ value_str } + l:=int64(-1); + enumdupmsg:=false; + { check that we are not adding an enum from specialization + we can't just use current_specializedef because of inner types + like specialize array of record } + is_specialize:=false; + stitem:=symtablestack.stack; + while assigned(stitem) do + begin + { check records, classes and arrays because they can be specialized } + if stitem^.symtable.symtabletype in [recordsymtable,ObjectSymtable,arraysymtable] then + begin + is_specialize:=is_specialize or (df_specialization in tstoreddef(stitem^.symtable.defowner).defoptions); + stitem:=stitem^.next; + end + else + break; + end; + if not is_specialize then + aktenumdef:=tenumdef.create + else + aktenumdef:=nil; + repeat + { if it is a specialization then search the first enum member + and get the member owner instead of just created enumdef } + if not assigned(aktenumdef) then + begin + searchsym(pattern,sym,st); + if sym.typ=enumsym then + aktenumdef:=tenumsym(sym).definition + else + internalerror(201101021); + end; + s:=orgpattern; + defpos:=current_tokenpos; + consume(_ID); + { only allow assigning of specific numbers under fpc mode } + if not(m_tp7 in current_settings.modeswitches) and + ( + { in fpc mode also allow := to be compatible + with previous 1.0.x versions } + ((m_fpc in current_settings.modeswitches) and + try_to_consume(_ASSIGNMENT)) or + try_to_consume(_EQ) + ) then + begin + oldlocalswitches:=current_settings.localswitches; + include(current_settings.localswitches,cs_allow_enum_calc); + p:=comp_expr(true,false); + current_settings.localswitches:=oldlocalswitches; + if (p.nodetype=ordconstn) then + begin + { we expect an integer or an enum of the + same type } + if is_integer(p.resultdef) or + is_char(p.resultdef) or + equal_defs(p.resultdef,aktenumdef) then + v:=tordconstnode(p).value + else + IncompatibleTypes(p.resultdef,s32inttype); + end + else + Message(parser_e_illegal_expression); + p.free; + { please leave that a note, allows type save } + { declarations in the win32 units ! } + if (not first) and (v<=l) and (not enumdupmsg) then + begin + Message(parser_n_duplicate_enum); + enumdupmsg:=true; + end; + l:=v; + end + else + inc(l.svalue); + first:=false; + { don't generate enum members is this is a specialization because aktenumdef is copied from the generic type } + if not is_specialize then + begin + storepos:=current_tokenpos; + current_tokenpos:=defpos; + tenumsymtable(aktenumdef.symtable).insert(tenumsym.create(s,aktenumdef,longint(l.svalue))); + if not (cs_scopedenums in current_settings.localswitches) then + tstoredsymtable(aktenumdef.owner).insert(tenumsym.create(s,aktenumdef,longint(l.svalue))); + current_tokenpos:=storepos; + end; + until not try_to_consume(_COMMA); + def:=aktenumdef; + consume(_RKLAMMER); + end; + _ARRAY: + begin + array_dec(false,genericdef,genericlist); + end; + _SET: + begin + set_dec; + end; + _CARET: + begin + consume(_CARET); + single_type(tt2,SingleTypeOptionsInTypeBlock[block_type=bt_type]); + def:=tpointerdef.create(tt2); + if tt2.typ=forwarddef then + current_module.checkforwarddefs.add(def); + end; + _RECORD: + begin + consume(token); + if (idtoken=_HELPER) and (m_advanced_records in current_settings.modeswitches) then + begin + consume(_HELPER); + def:=object_dec(odt_helper,name,genericdef,genericlist,nil,ht_record); + end + else + def:=record_dec(name,genericdef,genericlist); + end; + _PACKED, + _BITPACKED: + begin + bitpacking := + (cs_bitpacking in current_settings.localswitches) or + (token = _BITPACKED); + consume(token); + if token=_ARRAY then + array_dec(bitpacking,genericdef,genericlist) + else if token=_SET then + set_dec + else if token=_FILE then + single_type(def,[stoAllowTypeDef]) + else + begin + oldpackrecords:=current_settings.packrecords; + if (not bitpacking) or + (token in [_CLASS,_OBJECT]) then + current_settings.packrecords:=1 + else + current_settings.packrecords:=bit_alignment; + case token of + _CLASS : + begin + consume(_CLASS); + def:=object_dec(odt_class,name,genericdef,genericlist,nil,ht_none); + end; + _OBJECT : + begin + consume(_OBJECT); + def:=object_dec(odt_object,name,genericdef,genericlist,nil,ht_none); + end; + else begin + consume(_RECORD); + def:=record_dec(name,genericdef,genericlist); + end; + end; + current_settings.packrecords:=oldpackrecords; + end; + end; + _DISPINTERFACE : + begin + { need extra check here since interface is a keyword + in all pascal modes } + if not(m_class in current_settings.modeswitches) then + Message(parser_f_need_objfpc_or_delphi_mode); + consume(token); + def:=object_dec(odt_dispinterface,name,genericdef,genericlist,nil,ht_none); + end; + _CLASS : + begin + consume(token); + { Delphi only allows class of in type blocks } + if (token=_OF) and + ( + not(m_delphi in current_settings.modeswitches) or + (block_type=bt_type) + ) then + begin + consume(_OF); + single_type(hdef,SingleTypeOptionsInTypeBlock[block_type=bt_type]); + if is_class(hdef) or + is_objcclass(hdef) then + def:=tclassrefdef.create(hdef) + else + if hdef.typ=forwarddef then + begin + def:=tclassrefdef.create(hdef); + current_module.checkforwarddefs.add(def); + end + else + Message1(type_e_class_or_objcclass_type_expected,hdef.typename); + end + else + if (idtoken=_HELPER) then + begin + consume(_HELPER); + def:=object_dec(odt_helper,name,genericdef,genericlist,nil,ht_class); + end + else + def:=object_dec(odt_class,name,genericdef,genericlist,nil,ht_none); + end; + _CPPCLASS : + begin + consume(token); + def:=object_dec(odt_cppclass,name,genericdef,genericlist,nil,ht_none); + end; + _OBJCCLASS : + begin + if not(m_objectivec1 in current_settings.modeswitches) then + Message(parser_f_need_objc); + + consume(token); + def:=object_dec(odt_objcclass,name,genericdef,genericlist,nil,ht_none); + end; + _INTERFACE : + begin + { need extra check here since interface is a keyword + in all pascal modes } + if not(m_class in current_settings.modeswitches) then + Message(parser_f_need_objfpc_or_delphi_mode); + consume(token); + if current_settings.interfacetype=it_interfacecom then + def:=object_dec(odt_interfacecom,name,genericdef,genericlist,nil,ht_none) + else {it_interfacecorba} + def:=object_dec(odt_interfacecorba,name,genericdef,genericlist,nil,ht_none); + end; + _OBJCPROTOCOL : + begin + if not(m_objectivec1 in current_settings.modeswitches) then + Message(parser_f_need_objc); + + consume(token); + def:=object_dec(odt_objcprotocol,name,genericdef,genericlist,nil,ht_none); + end; + _OBJCCATEGORY : + begin + if not(m_objectivec1 in current_settings.modeswitches) then + Message(parser_f_need_objc); + + consume(token); + def:=object_dec(odt_objccategory,name,genericdef,genericlist,nil,ht_none); + end; + _OBJECT : + begin + consume(token); + def:=object_dec(odt_object,name,genericdef,genericlist,nil,ht_none); + end; + _PROCEDURE, + _FUNCTION: + begin + def:=procvar_dec(genericdef,genericlist); + end; + else + if (token=_KLAMMERAFFE) and (m_iso in current_settings.modeswitches) then + begin + consume(_KLAMMERAFFE); + single_type(tt2,SingleTypeOptionsInTypeBlock[block_type=bt_type]); + def:=tpointerdef.create(tt2); + if tt2.typ=forwarddef then + current_module.checkforwarddefs.add(def); + end + else + expr_type; + end; + + if def=nil then + def:=generrordef; + end; + + + procedure read_anon_type(var def : tdef;parseprocvardir:boolean); + begin + read_named_type(def,'',nil,nil,parseprocvardir); + end; + + + procedure write_persistent_type_info(st:tsymtable); + var + i : longint; + def : tdef; + vmtwriter : TVMTWriter; + begin + for i:=0 to st.DefList.Count-1 do + begin + def:=tdef(st.DefList[i]); + case def.typ of + recorddef : + write_persistent_type_info(trecorddef(def).symtable); + objectdef : + begin + { Skip generics and forward defs } + if (df_generic in def.defoptions) or + (oo_is_forward in tobjectdef(def).objectoptions) then + continue; + write_persistent_type_info(tobjectdef(def).symtable); + { Write also VMT if not done yet } + if not(ds_vmt_written in def.defstates) then + begin + vmtwriter:=TVMTWriter.create(tobjectdef(def)); + if is_interface(tobjectdef(def)) then + vmtwriter.writeinterfaceids; + if (oo_has_vmt in tobjectdef(def).objectoptions) then + vmtwriter.writevmt; + vmtwriter.free; + include(def.defstates,ds_vmt_written); + end; + end; + procdef : + begin + if assigned(tprocdef(def).localst) and + (tprocdef(def).localst.symtabletype=localsymtable) then + write_persistent_type_info(tprocdef(def).localst); + if assigned(tprocdef(def).parast) then + write_persistent_type_info(tprocdef(def).parast); + end; + end; + { generate always persistent tables for types in the interface so it can + be reused in other units and give always the same pointer location. } + { Init } + if ( + assigned(def.typesym) and + (st.symtabletype=globalsymtable) and + not is_objc_class_or_protocol(def) + ) or + is_managed_type(def) or + (ds_init_table_used in def.defstates) then + RTTIWriter.write_rtti(def,initrtti); + { RTTI } + if ( + assigned(def.typesym) and + (st.symtabletype=globalsymtable) and + not is_objc_class_or_protocol(def) + ) or + (ds_rtti_table_used in def.defstates) then + RTTIWriter.write_rtti(def,fullrtti); + end; + end; + +end. diff --git a/closures/compiler/raatt.pas b/closures/compiler/raatt.pas new file mode 100644 index 0000000000..346d202db0 --- /dev/null +++ b/closures/compiler/raatt.pas @@ -0,0 +1,1645 @@ +{ + Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman + + Does the parsing for the GAS 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 raatt; + +{$i fpcdefs.inc} + + interface + + uses + { common } + cutils,cclasses, + { global } + globtype, + { aasm } + cpubase,cpuinfo,aasmbase,aasmtai,aasmdata,aasmcpu, + { assembler reader } + rabase, + rasm, + rautils, + { symtable } + symconst, + { cg } + cgbase; + + type + tasmtoken = ( + AS_NONE,AS_LABEL,AS_LLABEL,AS_STRING,AS_INTNUM, + AS_REALNUM,AS_COMMA,AS_LPAREN, + AS_RPAREN,AS_COLON,AS_DOT,AS_PLUS,AS_MINUS,AS_STAR, + AS_SEPARATOR,AS_ID,AS_REGISTER,AS_OPCODE,AS_SLASH,AS_DOLLAR, + AS_HASH,AS_LSBRACKET,AS_RSBRACKET,AS_LBRACKET,AS_RBRACKET, + {------------------ Assembler directives --------------------} + AS_DB,AS_DW,AS_DD,AS_DQ,AS_GLOBAL, + AS_ALIGN,AS_BALIGN,AS_P2ALIGN,AS_ASCII, + AS_ASCIIZ,AS_LCOMM,AS_COMM,AS_SINGLE,AS_DOUBLE,AS_EXTENDED,AS_CEXTENDED, + AS_DATA,AS_TEXT,AS_INIT,AS_FINI,AS_RVA,AS_END, + {------------------ Assembler Operators --------------------} + AS_TYPE,AS_SIZEOF,AS_VMTOFFSET,AS_MOD,AS_SHL,AS_SHR,AS_NOT,AS_AND,AS_OR,AS_XOR,AS_NOR,AS_AT, + AS_LO,AS_HI, + {------------------ Target-specific directive ---------------} + AS_TARGET_DIRECTIVE + ); + + tasmkeyword = string[10]; + + const + { These tokens should be modified accordingly to the modifications } + { in the different enumerations. } + firstdirective = AS_DB; + lastdirective = AS_END; + + token2str : array[tasmtoken] of tasmkeyword=( + '','Label','LLabel','string','integer', + 'float',',','(', + ')',':','.','+','-','*', + ';','identifier','register','opcode','/','$', + '#','{','}','[',']', + '.byte','.word','.long','.quad','.globl', + '.align','.balign','.p2align','.ascii', + '.asciz','.lcomm','.comm','.single','.double','.tfloat','.tcfloat', + '.data','.text','.init','.fini','.rva','END', + 'TYPE','SIZEOF','VMTOFFSET','%','<<','>>','!','&','|','^','~','@','lo','hi', + 'directive'); + + type + tattreader = class(tasmreader) + actasmtoken : tasmtoken; + prevasmtoken : tasmtoken; + procedure SetupTables; + procedure BuildConstant(constsize: byte); + procedure BuildConstantOperand(oper : toperand); + procedure BuildRealConstant(typ : tfloattype); + procedure BuildStringConstant(asciiz: boolean); + procedure BuildRva; + procedure BuildRecordOffsetSize(const expr: string;var offset:aint;var size:aint; var mangledname: string; needvmtofs: boolean); + procedure BuildConstSymbolExpression(allowref,betweenbracket,needofs:boolean;var value:aint;var asmsym:string;var asmsymtyp:TAsmsymtype); + function BuildConstExpression(allowref,betweenbracket:boolean): aint; + function Assemble: tlinkedlist;override; + procedure handleopcode;virtual;abstract; + function is_asmopcode(const s: string) : boolean;virtual;abstract; + Function is_asmdirective(const s: string):boolean; + function is_register(const s:string):boolean;virtual; + function is_locallabel(const s: string):boolean; + function is_targetdirective(const s: string): boolean;virtual; + procedure GetToken; + function consume(t : tasmtoken):boolean; + procedure RecoverConsume(allowcomma:boolean); + procedure handlepercent;virtual; + procedure HandleTargetDirective;virtual; + end; + tcattreader = class of tattreader; + + var + cattreader : tcattreader; + + implementation + + uses + { globals } + verbose,systems, + { input } + scanner, + { symtable } + symbase,symtype,symsym,symdef,symtable, +{$ifdef x86} + rax86, +{$endif x86} + itcpugas, + procinfo; + + + procedure tattreader.SetupTables; + var + i : tasmop; + Begin + iasmops:=TFPHashList.create; + for i:=firstop to lastop do + iasmops.Add(upper(gas_op2str[i]),Pointer(PtrInt(i))); + end; + + + function tattreader.is_asmdirective(const s: string):boolean; + var + i : tasmtoken; + hs : string; + Begin + { GNU as is also not casesensitive with this } + hs:=lower(s); + for i:=firstdirective to lastdirective do + if hs=token2str[i] then + begin + actasmtoken:=i; + is_asmdirective:=true; + exit; + end; + is_asmdirective:=false; + end; + + + function tattreader.is_register(const s:string):boolean; + begin + is_register:=false; + actasmregister:=gas_regnum_search(lower(s)); + if actasmregister<>NR_NO then + begin + is_register:=true; + actasmtoken:=AS_REGISTER; + end; + end; + + + function tattreader.is_locallabel(const s: string):boolean; + begin + is_locallabel:=(length(s)>=2) and (s[1]='.') and (s[2]='L'); + end; + + + procedure tattreader.handlepercent; + begin + c:=current_scanner.asmgetchar; + actasmtoken:=AS_MOD; + end; + + function tattreader.is_targetdirective(const s: string): boolean; + begin + result:=false; + end; + + procedure tattreader.handletargetdirective; + begin + end; + + procedure tattreader.GetToken; + var + len : longint; + srsym : tsym; + srsymtable : TSymtable; + begin + { save old token and reset new token } + prevasmtoken:=actasmtoken; + actasmtoken:=AS_NONE; + { reset } + actasmpattern:=''; + { while space and tab , continue scan... } + while c in [' ',#9] do + c:=current_scanner.asmgetchar; + { get token pos } + if not (c in [#10,#13,'{',';']) then + current_scanner.gettokenpos; + { Local Label, Label, Directive, Prefix or Opcode } + if firsttoken and not(c in [#10,#13,'{',';']) then + begin + firsttoken:=FALSE; + len:=0; + { directive or local label } + if c = '.' then + begin + inc(len); + actasmpattern[len]:=c; + { Let us point to the next character } + c:=current_scanner.asmgetchar; + while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do + begin + inc(len); + actasmpattern[len]:=c; + c:=current_scanner.asmgetchar; + end; + actasmpattern[0]:=chr(len); + { this is a local label... } + if (c=':') and is_locallabel(actasmpattern) then + Begin + { local variables are case sensitive } + actasmtoken:=AS_LLABEL; + c:=current_scanner.asmgetchar; + firsttoken:=true; + exit; + end + { must be a directive } + else + Begin + { directives are case sensitive!! } + if is_asmdirective(actasmpattern) then + exit; + if is_targetdirective(actasmpattern) then + begin + actasmtoken:=AS_TARGET_DIRECTIVE; + exit; + end; + Message1(asmr_e_not_directive_or_local_symbol,actasmpattern); + end; + end; + { only opcodes and global labels are allowed now. } + while c in ['A'..'Z','a'..'z','0'..'9','_'] do + begin + inc(len); + actasmpattern[len]:=c; + c:=current_scanner.asmgetchar; + end; + actasmpattern[0]:=chr(len); + { Label ? } + if c = ':' then + begin + actasmtoken:=AS_LABEL; + { let us point to the next character } + c:=current_scanner.asmgetchar; + firsttoken:=true; + exit; + end; +{$if defined(POWERPC) or defined(POWERPC64)} + { some PowerPC instructions can have the postfix -, + or . + this code could be moved to is_asmopcode but I think + it's better to ifdef it here (FK) + } + case c of + '.', '-', '+': + begin + actasmpattern:=actasmpattern+c; + c:=current_scanner.asmgetchar; + end + end; +{$endif POWERPC} +{$if defined(ARM)} + { Thumb-2 instructions can have a .W postfix to indicate 32bit instructions + } + case c of + '.': + begin + actasmpattern:=actasmpattern+c; + c:=current_scanner.asmgetchar; + + if upcase(c) = 'W' then + begin + actasmpattern:=actasmpattern+c; + c:=current_scanner.asmgetchar; + end + else + internalerror(2010122301); + end + end; +{$endif ARM} + { Opcode ? } + If is_asmopcode(upper(actasmpattern)) then + Begin + uppervar(actasmpattern); + exit; + end; + { End of assemblerblock ? } + if upper(actasmpattern) = 'END' then + begin + actasmtoken:=AS_END; + exit; + end; + message1(asmr_e_unknown_opcode,actasmpattern); + actasmtoken:=AS_NONE; + end + else { else firsttoken } + { Here we must handle all possible cases } + begin + case c of + '.' : { possiblities : - local label reference , such as in jmp @local1 } + { - field of object/record } + { - directive. } + begin + if (prevasmtoken in [AS_ID,AS_RPAREN]) then + begin + c:=current_scanner.asmgetchar; + actasmtoken:=AS_DOT; + exit; + end; + actasmpattern:=c; + c:=current_scanner.asmgetchar; + while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do + begin + actasmpattern:=actasmpattern + c; + c:=current_scanner.asmgetchar; + end; + if is_asmdirective(actasmpattern) then + exit; + if is_targetdirective(actasmpattern) then + begin + actasmtoken:=AS_TARGET_DIRECTIVE; + exit; + end; + { local label references and directives } + { are case sensitive } + actasmtoken:=AS_ID; + exit; + end; + + { identifier, register, prefix or directive } + '_','A'..'Z','a'..'z': + begin + len:=0; + while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do + begin + inc(len); + actasmpattern[len]:=c; + c:=current_scanner.asmgetchar; + end; + actasmpattern[0]:=chr(len); + uppervar(actasmpattern); +{$ifdef x86} + { only x86 architectures have instruction prefixes } + + { Opcode, can only be when the previous was a prefix } + If is_prefix(actopcode) and is_asmopcode(actasmpattern) then + Begin + uppervar(actasmpattern); + exit; + end; +{$endif x86} + { check for end which is a reserved word unlike the opcodes } + if actasmpattern = 'END' then + Begin + actasmtoken:=AS_END; + exit; + end; + if actasmpattern = 'TYPE' then + Begin + actasmtoken:=AS_TYPE; + exit; + end; + if actasmpattern = 'SIZEOF' then + Begin + actasmtoken:=AS_SIZEOF; + exit; + end; + if actasmpattern = 'VMTOFFSET' then + Begin + actasmtoken:=AS_VMTOFFSET; + exit; + end; + if is_register(actasmpattern) then + begin + actasmtoken:=AS_REGISTER; + exit; + end; + { if next is a '.' and this is a unitsym then we also need to + parse the identifier } + if (c='.') then + begin + searchsym(actasmpattern,srsym,srsymtable); + if assigned(srsym) and + (srsym.typ=unitsym) and + (srsym.owner.symtabletype in [staticsymtable,globalsymtable]) and + srsym.owner.iscurrentunit then + begin + actasmpattern:=actasmpattern+c; + c:=current_scanner.asmgetchar; + while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do + begin + actasmpattern:=actasmpattern + upcase(c); + c:=current_scanner.asmgetchar; + end; + end; + end; + actasmtoken:=AS_ID; + exit; + end; + + '%' : { register or modulo } + handlepercent; + + '1'..'9': { integer number } + begin + len:=0; + while c in ['0'..'9'] do + Begin + inc(len); + actasmpattern[len]:=c; + c:=current_scanner.asmgetchar; + end; + actasmpattern[0]:=chr(len); + actasmpattern:=tostr(ParseVal(actasmpattern,10)); + actasmtoken:=AS_INTNUM; + exit; + end; + '0' : { octal,hexa,real or binary number. } + begin + actasmpattern:=c; + c:=current_scanner.asmgetchar; + case upcase(c) of + 'B': { binary } + Begin + c:=current_scanner.asmgetchar; + while c in ['0','1'] do + Begin + actasmpattern:=actasmpattern + c; + c:=current_scanner.asmgetchar; + end; + actasmpattern:=tostr(ParseVal(actasmpattern,2)); + actasmtoken:=AS_INTNUM; + exit; + end; + 'D': { real } + Begin + c:=current_scanner.asmgetchar; + { get ridd of the 0d } + if (c in ['+','-']) then + begin + actasmpattern:=c; + c:=current_scanner.asmgetchar; + end + else + actasmpattern:=''; + while c in ['0'..'9'] do + Begin + actasmpattern:=actasmpattern + c; + c:=current_scanner.asmgetchar; + end; + if c='.' then + begin + actasmpattern:=actasmpattern + c; + c:=current_scanner.asmgetchar; + while c in ['0'..'9'] do + Begin + actasmpattern:=actasmpattern + c; + c:=current_scanner.asmgetchar; + end; + if upcase(c) = 'E' then + begin + actasmpattern:=actasmpattern + c; + c:=current_scanner.asmgetchar; + if (c in ['+','-']) then + begin + actasmpattern:=actasmpattern + c; + c:=current_scanner.asmgetchar; + end; + while c in ['0'..'9'] do + Begin + actasmpattern:=actasmpattern + c; + c:=current_scanner.asmgetchar; + end; + end; + actasmtoken:=AS_REALNUM; + exit; + end + else + begin + Message1(asmr_e_invalid_float_const,actasmpattern+c); + actasmtoken:=AS_NONE; + end; + end; + 'X': { hexadecimal } + Begin + c:=current_scanner.asmgetchar; + while c in ['0'..'9','a'..'f','A'..'F'] do + Begin + actasmpattern:=actasmpattern + c; + c:=current_scanner.asmgetchar; + end; + actasmpattern:=tostr(ParseVal(actasmpattern,16)); + actasmtoken:=AS_INTNUM; + exit; + end; + '1'..'7': { octal } + begin + actasmpattern:=actasmpattern + c; + while c in ['0'..'7'] do + Begin + actasmpattern:=actasmpattern + c; + c:=current_scanner.asmgetchar; + end; + actasmpattern:=tostr(ParseVal(actasmpattern,8)); + actasmtoken:=AS_INTNUM; + exit; + end; + else { octal number zero value...} + Begin + actasmpattern:=tostr(ParseVal(actasmpattern,8)); + actasmtoken:=AS_INTNUM; + exit; + end; + end; { end case } + end; + + '&' : + begin + c:=current_scanner.asmgetchar; + actasmtoken:=AS_AND; + end; + + '''' : { char } + begin + current_scanner.in_asm_string:=true; + actasmpattern:=''; + repeat + c:=current_scanner.asmgetchar; + case c of + '\' : + begin + { copy also the next char so \" is parsed correctly } + actasmpattern:=actasmpattern+c; + c:=current_scanner.asmgetchar; + actasmpattern:=actasmpattern+c; + end; + '''' : + begin + c:=current_scanner.asmgetchar; + break; + end; + #10,#13: + Message(scan_f_string_exceeds_line); + else + actasmpattern:=actasmpattern+c; + end; + until false; + actasmpattern:=EscapeToPascal(actasmpattern); + actasmtoken:=AS_STRING; + current_scanner.in_asm_string:=false; + exit; + end; + + '"' : { string } + begin + current_scanner.in_asm_string:=true; + actasmpattern:=''; + repeat + c:=current_scanner.asmgetchar; + case c of + '\' : + begin + { copy also the next char so \" is parsed correctly } + actasmpattern:=actasmpattern+c; + c:=current_scanner.asmgetchar; + actasmpattern:=actasmpattern+c; + end; + '"' : + begin + c:=current_scanner.asmgetchar; + break; + end; + #10,#13: + Message(scan_f_string_exceeds_line); + else + actasmpattern:=actasmpattern+c; + end; + until false; + actasmpattern:=EscapeToPascal(actasmpattern); + actasmtoken:=AS_STRING; + current_scanner.in_asm_string:=false; + exit; + end; + + '$' : + begin + actasmtoken:=AS_DOLLAR; + c:=current_scanner.asmgetchar; + exit; + end; + + '#' : + begin + actasmtoken:=AS_HASH; + c:=current_scanner.asmgetchar; + exit; + end; + + '[' : + begin + actasmtoken:=AS_LBRACKET; + c:=current_scanner.asmgetchar; + exit; + end; + + ']' : + begin + actasmtoken:=AS_RBRACKET; + c:=current_scanner.asmgetchar; + exit; + end; +{$ifdef arm} + // the arm assembler uses { ... } for register sets + '{' : + begin + actasmtoken:=AS_LSBRACKET; + c:=current_scanner.asmgetchar; + exit; + end; + + '}' : + begin + actasmtoken:=AS_RSBRACKET; + c:=current_scanner.asmgetchar; + exit; + end; +{$endif arm} + + ',' : + begin + actasmtoken:=AS_COMMA; + c:=current_scanner.asmgetchar; + exit; + end; + + '<' : + begin + actasmtoken:=AS_SHL; + c:=current_scanner.asmgetchar; + if c = '<' then + c:=current_scanner.asmgetchar; + exit; + end; + + '>' : + begin + actasmtoken:=AS_SHL; + c:=current_scanner.asmgetchar; + if c = '>' then + c:=current_scanner.asmgetchar; + exit; + end; + + '|' : + begin + actasmtoken:=AS_OR; + c:=current_scanner.asmgetchar; + exit; + end; + + '^' : + begin + actasmtoken:=AS_XOR; + c:=current_scanner.asmgetchar; + exit; + end; + + + '(' : + begin + actasmtoken:=AS_LPAREN; + c:=current_scanner.asmgetchar; + exit; + end; + + ')' : + begin + actasmtoken:=AS_RPAREN; + c:=current_scanner.asmgetchar; + exit; + end; + + ':' : + begin + actasmtoken:=AS_COLON; + c:=current_scanner.asmgetchar; + exit; + end; + + '+' : + begin + actasmtoken:=AS_PLUS; + c:=current_scanner.asmgetchar; + exit; + end; + + '-' : + begin + actasmtoken:=AS_MINUS; + c:=current_scanner.asmgetchar; + exit; + end; + + '*' : + begin + actasmtoken:=AS_STAR; + c:=current_scanner.asmgetchar; + exit; + end; + + '/' : + begin + actasmtoken:=AS_SLASH; + c:=current_scanner.asmgetchar; + exit; + end; + + '!' : + begin + actasmtoken:=AS_NOT; + c:=current_scanner.asmgetchar; + exit; + end; + + '@' : + begin + actasmtoken:=AS_AT; + c:=current_scanner.asmgetchar; + exit; + end; + +{$ifndef arm} + '{', +{$endif arm} + #13,#10,';' : + begin + { the comment is read by asmgetchar } + c:=current_scanner.asmgetchar; + firsttoken:=TRUE; + actasmtoken:=AS_SEPARATOR; + exit; + end; + + else + current_scanner.illegal_char(c); + end; + end; + end; + + + function tattreader.consume(t : tasmtoken):boolean; + begin + Consume:=true; + if t<>actasmtoken then + begin + Message2(scan_f_syn_expected,token2str[t],token2str[actasmtoken]); + Consume:=false; + end; + repeat + gettoken; + until actasmtoken<>AS_NONE; + end; + + + procedure tattreader.RecoverConsume(allowcomma:boolean); + begin + While not (actasmtoken in [AS_SEPARATOR,AS_END]) do + begin + if allowcomma and (actasmtoken=AS_COMMA) then + break; + Consume(actasmtoken); + end; + end; + + + Procedure tattreader.BuildConstant(constsize: byte); + var + asmsymtyp : TAsmSymType; + asmsym, + expr: string; + value : aint; + Begin + Repeat + Case actasmtoken of + AS_STRING: + Begin + expr:=actasmpattern; + if length(expr) > 1 then + Message(asmr_e_string_not_allowed_as_const); + Consume(AS_STRING); + Case actasmtoken of + AS_COMMA: Consume(AS_COMMA); + AS_END, + AS_SEPARATOR: ; + else + Message(asmr_e_invalid_string_expression); + end; { end case } + ConcatString(curlist,expr); + end; + AS_INTNUM, + AS_PLUS, + AS_MINUS, + AS_LPAREN, + AS_TYPE, + AS_SIZEOF, + AS_NOT, + AS_VMTOFFSET, + AS_ID : + Begin + BuildConstSymbolExpression(false,false,false,value,asmsym,asmsymtyp); + if asmsym<>'' then + begin + if constsize<>sizeof(pint) then + Message(asmr_w_32bit_const_for_address); + ConcatConstSymbol(curlist,asmsym,asmsymtyp,value) + end + else + ConcatConstant(curlist,value,constsize); + end; + AS_COMMA: + Consume(AS_COMMA); + AS_END, + AS_SEPARATOR: + break; + else + begin + Message(asmr_e_syn_constant); + RecoverConsume(false); + end + end; { end case } + Until false; + end; + + + Procedure tattreader.BuildRealConstant(typ : tfloattype); + var + expr : string; + r : bestreal; + code : integer; + negativ : boolean; + errorflag: boolean; + Begin + errorflag:=FALSE; + Repeat + negativ:=false; + expr:=''; + if actasmtoken=AS_PLUS then + Consume(AS_PLUS) + else + if actasmtoken=AS_MINUS then + begin + negativ:=true; + consume(AS_MINUS); + end; + Case actasmtoken of + AS_INTNUM: + Begin + expr:=actasmpattern; + Consume(AS_INTNUM); + if negativ then + expr:='-'+expr; + val(expr,r,code); + if code<>0 then + Begin + r:=0; + Message(asmr_e_invalid_float_expr); + End; + ConcatRealConstant(curlist,r,typ); + end; + AS_REALNUM: + Begin + expr:=actasmpattern; + Consume(AS_REALNUM); + { in ATT syntax you have 0d in front of the real } + { should this be forced ? yes i think so, as to } + { conform to gas as much as possible. } + if (expr[1]='0') and (upper(expr[2])='D') then + Delete(expr,1,2); + if negativ then + expr:='-'+expr; + val(expr,r,code); + if code<>0 then + Begin + r:=0; + Message(asmr_e_invalid_float_expr); + End; + ConcatRealConstant(curlist,r,typ); + end; + AS_COMMA: + begin + Consume(AS_COMMA); + end; + AS_END, + AS_SEPARATOR: + begin + break; + end; + else + Begin + Consume(actasmtoken); + if not errorflag then + Message(asmr_e_invalid_float_expr); + errorflag:=TRUE; + end; + end; + Until false; + end; + + + Procedure tattreader.BuildStringConstant(asciiz: boolean); + var + expr: string; + errorflag : boolean; + Begin + errorflag:=FALSE; + Repeat + Case actasmtoken of + AS_STRING: + Begin + expr:=actasmpattern; + if asciiz then + expr:=expr+#0; + ConcatPasString(curlist,expr); + Consume(AS_STRING); + end; + AS_COMMA: + begin + Consume(AS_COMMA); + end; + AS_END, + AS_SEPARATOR: + begin + break; + end; + else + Begin + Consume(actasmtoken); + if not errorflag then + Message(asmr_e_invalid_string_expression); + errorflag:=TRUE; + end; + end; + Until false; + end; + + + Function tattreader.Assemble: tlinkedlist; + Var + hl : tasmlabel; + commname : string; + lasTSec : TAsmSectiontype; + l1,l2 : longint; + Begin + Message1(asmr_d_start_reading,'GNU AS'); + firsttoken:=TRUE; + { sets up all opcode and register tables in uppercase } + if not _asmsorted then + Begin + SetupTables; + _asmsorted:=TRUE; + end; + curlist:=TAsmList.Create; + lasTSec:=sec_code; + { setup label linked list } + LocalLabelList:=TLocalLabelList.Create; + { start tokenizer } + c:=current_scanner.asmgetcharstart; + gettoken; + { main loop } + repeat + case actasmtoken of + AS_LLABEL: + Begin + if CreateLocalLabel(actasmpattern,hl,true) then + ConcatLabel(curlist,hl); + Consume(AS_LLABEL); + end; + + AS_LABEL: + Begin + if SearchLabel(upper(actasmpattern),hl,true) then + ConcatLabel(curlist,hl) + else + Message1(asmr_e_unknown_label_identifier,actasmpattern); + Consume(AS_LABEL); + end; + + AS_DW: + Begin + Consume(AS_DW); + BuildConstant(2); + end; + + AS_DATA: + Begin + new_section(curList,sec_data,lower(current_procinfo.procdef.mangledname),0); + lasTSec:=sec_data; + Consume(AS_DATA); + end; + + AS_TEXT: + Begin + new_section(curList,sec_code,lower(current_procinfo.procdef.mangledname),0); + lasTSec:=sec_code; + Consume(AS_TEXT); + end; + + AS_INIT: + Begin + new_section(curList,sec_init,lower(current_procinfo.procdef.mangledname),0); + lasTSec:=sec_init; + Consume(AS_INIT); + end; + + AS_FINI: + Begin + new_section(curList,sec_fini,lower(current_procinfo.procdef.mangledname),0); + lasTSec:=sec_fini; + Consume(AS_FINI); + end; + + AS_DB: + Begin + Consume(AS_DB); + BuildConstant(1); + end; + + AS_DD: + Begin + Consume(AS_DD); + BuildConstant(4); + end; + + AS_DQ: + Begin + Consume(AS_DQ); +{$ifdef cpu64bitaddr} + BuildConstant(8); +{$else cpu64bitaddr} + BuildRealConstant(s64comp); +{$endif cpu64bitaddr} + end; + + AS_SINGLE: + Begin + Consume(AS_SINGLE); + BuildRealConstant(s32real); + end; + + AS_DOUBLE: + Begin + Consume(AS_DOUBLE); + BuildRealConstant(s64real); + end; + + AS_EXTENDED: + Begin + Consume(AS_EXTENDED); + BuildRealConstant(s80real); + end; + + AS_CEXTENDED: + Begin + Consume(AS_CEXTENDED); + BuildRealConstant(sc80real); + end; + + AS_GLOBAL: + Begin + Consume(AS_GLOBAL); + if actasmtoken=AS_ID then + ConcatPublic(curlist,actasmpattern); + Consume(AS_ID); + if actasmtoken<>AS_SEPARATOR then + Consume(AS_SEPARATOR); + end; + + AS_ALIGN: + Begin + Consume(AS_ALIGN); + l1:=BuildConstExpression(false,false); + if (target_info.system in [system_i386_GO32V2]) then + begin + l2:=1; + if (l1>=0) and (l1<=16) then + while (l1>0) do + begin + l2:=2*l2; + dec(l1); + end; + l1:=l2; + end; + ConcatAlign(curlist,l1); + Message(asmr_n_align_is_target_specific); + if actasmtoken<>AS_SEPARATOR then + Consume(AS_SEPARATOR); + end; + + AS_BALIGN: + Begin + Consume(AS_BALIGN); + ConcatAlign(curlist,BuildConstExpression(false,false)); + if actasmtoken<>AS_SEPARATOR then + Consume(AS_SEPARATOR); + end; + + AS_P2ALIGN: + Begin + Consume(AS_P2ALIGN); + l1:=BuildConstExpression(false,false); + l2:=1; + if (l1>=0) and (l1<=16) then + while (l1>0) do + begin + l2:=2*l2; + dec(l1); + end; + l1:=l2; + ConcatAlign(curlist,l1); + if actasmtoken<>AS_SEPARATOR then + Consume(AS_SEPARATOR); + end; + + AS_ASCIIZ: + Begin + Consume(AS_ASCIIZ); + BuildStringConstant(TRUE); + end; + + AS_ASCII: + Begin + Consume(AS_ASCII); + BuildStringConstant(FALSE); + end; + + AS_LCOMM: + Begin + Consume(AS_LCOMM); + commname:=actasmpattern; + Consume(AS_ID); + Consume(AS_COMMA); + curList.concat(Tai_datablock.Create(commname,BuildConstExpression(false,false))); + if actasmtoken<>AS_SEPARATOR then + Consume(AS_SEPARATOR); + end; + + AS_COMM: + Begin + Consume(AS_COMM); + commname:=actasmpattern; + Consume(AS_ID); + Consume(AS_COMMA); + curList.concat(Tai_datablock.Create_global(commname,BuildConstExpression(false,false))); + if actasmtoken<>AS_SEPARATOR then + Consume(AS_SEPARATOR); + end; + + AS_OPCODE: + Begin + HandleOpCode; + end; + + AS_SEPARATOR: + Begin + Consume(AS_SEPARATOR); + end; + + AS_RVA: + begin + { .rva generally applies to systems with COFF output format, + not just Windows. } + if not (target_info.system in systems_all_windows) then + Message1(asmr_e_unsupported_directive,token2str[AS_RVA]); + Consume(AS_RVA); + BuildRva; + end; + + AS_TARGET_DIRECTIVE: + HandleTargetDirective; + + AS_END: + begin + break; { end assembly block } + end; + + else + Begin + Message(asmr_e_syntax_error); + RecoverConsume(false); + end; + end; + until false; + { Check LocalLabelList } + LocalLabelList.CheckEmitted; + LocalLabelList.Free; + { are we back in the code section? } + if lasTSec<>sec_code then + begin + Message(asmr_w_assembler_code_not_returned_to_text); + new_section(curList,sec_code,lower(current_procinfo.procdef.mangledname),0); + end; + { Return the list in an asmnode } + assemble:=curlist; + Message1(asmr_d_finish_reading,'GNU AS'); + end; + + +{***************************************************************************** + Parsing Helpers +*****************************************************************************} + + Procedure tattreader.BuildRecordOffsetSize(const expr: string;var offset:aint;var size:aint; var mangledname: string; needvmtofs: boolean); + { Description: This routine builds up a record offset after a AS_DOT } + { token is encountered. } + { On entry actasmtoken should be equal to AS_DOT } + var + s : string; + Begin + offset:=0; + size:=0; + s:=expr; + while (actasmtoken=AS_DOT) do + begin + Consume(AS_DOT); + if actasmtoken=AS_ID then + s:=s+'.'+actasmpattern; + if not Consume(AS_ID) then + begin + RecoverConsume(true); + break; + end; + end; + if not GetRecordOffsetSize(s,offset,size,mangledname,needvmtofs) then + Message(asmr_e_building_record_offset); + end; + + + procedure tattreader.BuildConstSymbolExpression(allowref,betweenbracket,needofs:boolean;var value:aint;var asmsym:string;var asmsymtyp:TAsmsymtype); + var + hssymtyp : TAsmSymType; + hs,tempstr,expr,mangledname : string; + parenlevel : longint; + l,k : aint; + errorflag : boolean; + prevtok : tasmtoken; + sym : tsym; + srsymtable : TSymtable; + hl : tasmlabel; + Begin + asmsym:=''; + asmsymtyp:=AT_DATA; + value:=0; + errorflag:=FALSE; + tempstr:=''; + expr:=''; + parenlevel:=0; + Repeat + Case actasmtoken of + AS_LPAREN: + Begin + { Exit if ref? } + if allowref and (prevasmtoken in [AS_INTNUM,AS_ID]) then + break; + Consume(AS_LPAREN); + expr:=expr + '('; + inc(parenlevel); + end; + AS_RBRACKET: + begin + if betweenbracket then + break; + { write error only once. } + if not errorflag then + Message(asmr_e_invalid_constant_expression); + { consume tokens until we find COMMA or SEPARATOR } + Consume(actasmtoken); + errorflag:=TRUE; + end; + AS_RPAREN: + Begin + { end of ref ? } + if (parenlevel=0) and betweenbracket then + break; + Consume(AS_RPAREN); + expr:=expr + ')'; + dec(parenlevel); + end; + AS_SHL: + Begin + Consume(AS_SHL); + expr:=expr + '<'; + end; + AS_SHR: + Begin + Consume(AS_SHR); + expr:=expr + '>'; + end; + AS_SLASH: + Begin + Consume(AS_SLASH); + expr:=expr + '/'; + end; + AS_MOD: + Begin + Consume(AS_MOD); + expr:=expr + '%'; + end; + AS_STAR: + Begin + Consume(AS_STAR); + expr:=expr + '*'; + end; + AS_PLUS: + Begin + Consume(AS_PLUS); + expr:=expr + '+'; + end; + AS_MINUS: + Begin + Consume(AS_MINUS); + expr:=expr + '-'; + end; + AS_AND: + Begin + Consume(AS_AND); + expr:=expr + '&'; + end; + AS_NOT: + Begin + Consume(AS_NOT); + expr:=expr + '~'; + end; + AS_XOR: + Begin + Consume(AS_XOR); + expr:=expr + '^'; + end; + AS_OR: + Begin + Consume(AS_OR); + expr:=expr + '|'; + end; + AS_INTNUM: + Begin + expr:=expr + actasmpattern; + Consume(AS_INTNUM); + end; + AS_DOLLAR: + begin + Consume(AS_DOLLAR); + if actasmtoken<>AS_ID then + Message(asmr_e_dollar_without_identifier); + end; + AS_STRING: + Begin + l:=0; + case Length(actasmpattern) of + 1 : + l:=ord(actasmpattern[1]); + 2 : + l:=ord(actasmpattern[2]) + ord(actasmpattern[1]) shl 8; + 3 : + l:=ord(actasmpattern[3]) + + Ord(actasmpattern[2]) shl 8 + ord(actasmpattern[1]) shl 16; + 4 : + l:=ord(actasmpattern[4]) + ord(actasmpattern[3]) shl 8 + + Ord(actasmpattern[2]) shl 16 + ord(actasmpattern[1]) shl 24; + else + Message1(asmr_e_invalid_string_as_opcode_operand,actasmpattern); + end; + str(l, tempstr); + expr:=expr + tempstr; + Consume(AS_STRING); + end; + AS_SIZEOF, + AS_TYPE: + begin + l:=0; + Consume(actasmtoken); + if actasmtoken<>AS_ID then + Message(asmr_e_type_without_identifier) + else + begin + tempstr:=actasmpattern; + Consume(AS_ID); + if actasmtoken=AS_DOT then + begin + BuildRecordOffsetSize(tempstr,k,l,mangledname,false); + if mangledname<>'' then + Message(asmr_e_wrong_sym_type); + end + else + begin + searchsym(tempstr,sym,srsymtable); + if assigned(sym) then + begin + case sym.typ of + staticvarsym, + localvarsym, + paravarsym : + l:=tabstractvarsym(sym).getsize; + typesym : + l:=ttypesym(sym).typedef.size; + else + Message(asmr_e_wrong_sym_type); + end; + end + else + Message1(sym_e_unknown_id,tempstr); + end; + end; + str(l, tempstr); + expr:=expr + tempstr; + end; + AS_VMTOFFSET: + begin + Consume(actasmtoken); + if actasmtoken<>AS_ID then + Message(asmr_e_type_without_identifier) + else + begin + tempstr:=actasmpattern; + consume(AS_ID); + BuildRecordOffsetSize(tempstr,k,l,mangledname,true); + if (mangledname <> '') then + Message(asmr_e_wrong_sym_type); + str(k,tempstr); + expr := expr + tempstr; + end + end; + AS_ID: + Begin + hs:=''; + hssymtyp:=AT_DATA; + tempstr:=actasmpattern; + prevtok:=prevasmtoken; + consume(AS_ID); + if SearchIConstant(tempstr,l) then + begin + str(l, tempstr); + expr:=expr + tempstr; + end + else + begin + if is_locallabel(tempstr) then + begin + CreateLocalLabel(tempstr,hl,false); + hs:=hl.name; + hssymtyp:=AT_LABEL; + end + else + if SearchLabel(tempstr,hl,false) then + begin + hs:=hl.name; + hssymtyp:=AT_FUNCTION; + end + else + begin + searchsym(tempstr,sym,srsymtable); + if assigned(sym) then + begin + case sym.typ of + staticvarsym : + hs:=tstaticvarsym(sym).mangledname; + localvarsym, + paravarsym : + Message(asmr_e_no_local_or_para_allowed); + procsym : + begin + if Tprocsym(sym).ProcdefList.Count>1 then + Message(asmr_w_calling_overload_func); + hs:=tprocdef(tprocsym(sym).ProcdefList[0]).mangledname; + hssymtyp:=AT_FUNCTION; + end; + typesym : + begin + if not(ttypesym(sym).typedef.typ in [recorddef,objectdef]) then + Message(asmr_e_wrong_sym_type); + end; + else + Message(asmr_e_wrong_sym_type); + end; + end + else + Message1(sym_e_unknown_id,tempstr); + end; + { symbol found? } + if hs<>'' then + begin + if needofs and (prevtok<>AS_DOLLAR) then + Message(asmr_e_need_dollar); + if asmsym='' then + begin + asmsym:=hs; + asmsymtyp:=hssymtyp; + end + else + Message(asmr_e_cant_have_multiple_relocatable_symbols); + if (expr='') or (expr[length(expr)]='+') then + begin + { don't remove the + if there could be a record field } + if actasmtoken<>AS_DOT then + delete(expr,length(expr),1); + end + else + Message(asmr_e_only_add_relocatable_symbol); + end; + if actasmtoken=AS_DOT then + begin + BuildRecordOffsetSize(tempstr,l,k,hs,false); + if (hs<>'') then + hssymtyp:=AT_FUNCTION + else + begin + str(l, tempstr); + expr:=expr + tempstr; + end + end + else + begin + if (expr='') or (expr[length(expr)] in ['+','-','/','*']) then + delete(expr,length(expr),1); + end; + end; + { check if there are wrong operator used like / or mod etc. } + if (hs<>'') and + not(actasmtoken in [AS_MINUS,AS_PLUS,AS_COMMA,AS_SEPARATOR, + AS_LPAREN,AS_RPAREN,AS_RBRACKET,AS_END]) then + Message(asmr_e_only_add_relocatable_symbol); + end; + AS_END, + AS_SEPARATOR, + AS_COMMA: + break; + else + Begin + { write error only once. } + if not errorflag then + Message(asmr_e_invalid_constant_expression); + { consume tokens until we find COMMA or SEPARATOR } + Consume(actasmtoken); + errorflag:=TRUE; + end; + end; + Until false; + { calculate expression } + if not ErrorFlag then + value:=CalculateExpression(expr) + else + value:=0; + end; + + + function tattreader.BuildConstExpression(allowref,betweenbracket:boolean): aint; + var + l : aint; + hs : string; + hssymtyp : TAsmSymType; + begin + BuildConstSymbolExpression(allowref,betweenbracket,false,l,hs,hssymtyp); + if hs<>'' then + Message(asmr_e_relocatable_symbol_not_allowed); + BuildConstExpression:=l; + end; + + + Procedure tattreader.BuildConstantOperand(oper : toperand); + var + l : aint; + tempstr : string; + tempsymtyp : TAsmSymType; + begin + BuildConstSymbolExpression(false,false,true,l,tempstr,tempsymtyp); + if tempstr<>'' then + begin + oper.opr.typ:=OPR_SYMBOL; + oper.opr.symofs:=l; + oper.opr.symbol:=current_asmdata.RefAsmSymbol(tempstr); + end + else + begin + oper.opr.typ:=OPR_CONSTANT; + oper.opr.val:=l; + end; + end; + + procedure tattreader.BuildRva; + var + asmsymtyp : TAsmSymType; + asmsym: string; + value : aint; + ai:tai_const; + begin + repeat + case actasmtoken of + AS_INTNUM, + AS_PLUS, + AS_MINUS, + AS_LPAREN, + AS_ID : + Begin + BuildConstSymbolExpression(false,false,false,value,asmsym,asmsymtyp); + if asmsym<>'' then + begin + ai:=tai_const.create_type_sym(aitconst_rva_symbol,current_asmdata.RefAsmSymbol(asmsym)); + ai.value:=value; + curlist.concat(ai); + end + else + Message(asmr_e_invalid_symbol_ref); + end; + AS_COMMA: + Consume(AS_COMMA); + AS_END, + AS_SEPARATOR: + break; + else + begin + Message(asmr_e_syn_constant); + RecoverConsume(false); + end + end; { end case } + until false; + end; + +end. diff --git a/closures/compiler/rabase.pas b/closures/compiler/rabase.pas new file mode 100644 index 0000000000..0c7d8de2c9 --- /dev/null +++ b/closures/compiler/rabase.pas @@ -0,0 +1,107 @@ +{ + Copyright (c) 1998-2003 by Peter Vreman, Florian Klaempfl and Carl Eric Codere + + Basic stuff for assembler readers + + 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 rabase; + +{$i fpcdefs.inc} + + interface + + uses + cclasses, + systems; + + type + tbaseasmreader = class + constructor create;virtual; + { the real return type is TAsmList, but this would introduce too much unit circles } + function Assemble: tlinkedlist;virtual;abstract; + end; + tcbaseasmreader = class of tbaseasmreader; + + pasmmodeinfo = ^tasmmodeinfo; + tasmmodeinfo = record + id : tasmmode; + idtxt : string[12]; + casmreader : tcbaseasmreader; + end; + + var + asmmodeinfos : array[tasmmode] of pasmmodeinfo; + + function SetAsmReadMode(const s:string;var t:tasmmode):boolean; + procedure RegisterAsmMode(const r:tasmmodeinfo); + + implementation + + uses + cutils; + + + procedure RegisterAsmmode(const r:tasmmodeinfo); + var + t : tasmmode; + begin + t:=r.id; + if assigned(asmmodeinfos[t]) then + writeln('Warning: Asmmode is already registered!') + else + Getmem(asmmodeinfos[t],sizeof(tasmmodeinfo)); + asmmodeinfos[t]^:=r; + end; + + + function SetAsmReadMode(const s:string;var t:tasmmode):boolean; + var + hs : string; + ht : tasmmode; + begin + result:=false; + hs:=upper(s); + { Support Default as an alias for Standard } + if hs='DEFAULT' then + hs:='STANDARD'; + for ht:=low(tasmmode) to high(tasmmode) do + if assigned(asmmodeinfos[ht]) and + (asmmodeinfos[ht]^.idtxt=hs) then + begin + t:=asmmodeinfos[ht]^.id; + result:=true; + end; + end; + + + constructor tbaseasmreader.create; + begin + inherited create; + end; + +var + asmmode : tasmmode; + +finalization + for asmmode:=low(tasmmode) to high(tasmmode) do + if assigned(asmmodeinfos[asmmode]) then + begin + freemem(asmmodeinfos[asmmode],sizeof(tasmmodeinfo)); + asmmodeinfos[asmmode]:=nil; + end; +end. diff --git a/closures/compiler/rasm.pas b/closures/compiler/rasm.pas new file mode 100644 index 0000000000..aab54005cb --- /dev/null +++ b/closures/compiler/rasm.pas @@ -0,0 +1,68 @@ +{ + Copyright (c) 1998-2003 by Peter Vreman, Florian Klaempfl and Carl Eric Codere + + Basic stuff for assembler readers + + 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 rasm; + +{$i fpcdefs.inc} + + interface + + uses + cclasses, + rabase, + aasmtai,aasmdata, + systems, + cpubase, + cgbase; + + type + tasmreader = class(tbaseasmreader) + firsttoken : boolean; + _asmsorted : boolean; + curlist : TAsmList; + c : char; + actasmpattern : string; + actopcode : tasmop; + actasmregister : tregister; + actcondition : tasmcond; + iasmops : TFPHashList; + constructor create;override; + destructor destroy;override; + end; + + implementation + + constructor tasmreader.create; + begin + inherited create; + firsttoken:=true; + end; + + + destructor tasmreader.destroy; + begin + if assigned(iasmops) then + iasmops.Free; + inherited destroy; + end; + + +end. diff --git a/closures/compiler/rautils.pas b/closures/compiler/rautils.pas new file mode 100644 index 0000000000..d7c0999097 --- /dev/null +++ b/closures/compiler/rautils.pas @@ -0,0 +1,1640 @@ +{ + Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman + + This unit implements some support routines for assembler parsing + independent of the processor + + 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 RAUtils; + +{$i fpcdefs.inc} + +Interface + +Uses + cutils,cclasses, + globtype,aasmbase,aasmtai,aasmdata,cpubase,cpuinfo,cgbase,cgutils, + symconst,symbase,symtype,symdef,symsym; + +Const + RPNMax = 10; { I think you only need 4, but just to be safe } + OpMax = 25; + +{$if max_operands = 2} + {$define MAX_OPER_2} +{$endif} +{$if max_operands = 3} + {$define MAX_OPER_3} +{$endif} + +{--------------------------------------------------------------------- + Local Label Management +---------------------------------------------------------------------} + +Type + { Each local label has this structure associated with it } + TLocalLabel = class(TFPHashObject) + Emitted : boolean; + constructor Create(AList:TFPHashObjectList;const n:string); + function Gettasmlabel:tasmlabel; + private + lab : tasmlabel; + end; + + TLocalLabelList = class(TFPHashObjectList) + procedure CheckEmitted; + end; + +var + LocalLabelList : TLocalLabelList; + +function CreateLocalLabel(const s: string; var hl: tasmlabel; emit:boolean):boolean; +Function SearchLabel(const s: string; var hl: tasmlabel;emit:boolean): boolean; + + +{--------------------------------------------------------------------- + Instruction management +---------------------------------------------------------------------} + +type + TOprType=(OPR_NONE,OPR_CONSTANT,OPR_SYMBOL,OPR_LOCAL, + OPR_REFERENCE,OPR_REGISTER,OPR_REGLIST,OPR_COND,OPR_REGSET,OPR_SHIFTEROP,OPR_MODEFLAGS); + + TOprRec = record + case typ:TOprType of + OPR_NONE : (); + OPR_CONSTANT : (val:aint); + OPR_SYMBOL : (symbol:tasmsymbol;symofs:aint); + OPR_REFERENCE : (ref:treference); + OPR_LOCAL : (localsym:tabstractnormalvarsym;localsymofs:aint;localindexreg:tregister;localscale:byte;localgetoffset,localforceref:boolean); + OPR_REGISTER : (reg:tregister); +{$ifdef m68k} + OPR_REGLIST : (regset : tcpuregisterset); +{$endif m68k} +{$ifdef powerpc} + OPR_COND : (cond : tasmcond); +{$endif powerpc} +{$ifdef POWERPC64} + OPR_COND : (cond : tasmcond); +{$endif POWERPC64} +{$ifdef arm} + OPR_REGSET : (regset : tcpuregisterset; regtype: tregistertype; subreg: tsubregister); + OPR_SHIFTEROP : (shifterop : tshifterop); + OPR_COND : (cc : tasmcond); + OPR_MODEFLAGS : (flags : tcpumodeflags); +{$endif arm} + end; + + TOperand = class + opr : TOprRec; + typesize : byte; + hastype, { if the operand has typecasted variable } + hasvar : boolean; { if the operand is loaded with a variable } + size : TCGSize; + constructor create;virtual; + destructor destroy;override; + Procedure SetSize(_size:longint;force:boolean);virtual; + Procedure SetCorrectSize(opcode:tasmop);virtual; + Function SetupResult:boolean;virtual; + Function SetupSelf:boolean; + Function SetupOldEBP:boolean; + Function SetupVar(const s:string;GetOffset : boolean): Boolean; + Function CheckOperand: boolean; virtual; + Procedure InitRef; + end; + TCOperand = class of TOperand; + + TInstruction = class + operands : array[1..max_operands] of toperand; + opcode : tasmop; + condition : tasmcond; + ops : byte; + labeled : boolean; + constructor create(optype : tcoperand);virtual; + destructor destroy;override; + { converts the instruction to an instruction how it's used by the assembler writer + and concats it to the passed list. The newly created item is returned if the + instruction was valid, otherwise nil is returned } + function ConcatInstruction(p:TAsmList) : tai;virtual; + Procedure Swapoperands; + end; + + {---------------------------------------------------------------------} + { Expression parser types } + {---------------------------------------------------------------------} + + TExprOperator = record + ch: char; { operator } + is_prefix: boolean; { was it a prefix, possible prefixes are +,- and not } + end; + + {**********************************************************************} + { The following operators are supported: } + { '+' : addition } + { '-' : subtraction } + { '*' : multiplication } + { '/' : modulo division } + { '^' : exclusive or } + { '<' : shift left } + { '>' : shift right } + { '&' : bitwise and } + { '|' : bitwise or } + { '~' : bitwise complement } + { '%' : modulo division } + { nnn: longint numbers } + { ( and ) parenthesis } + {**********************************************************************} + + TExprParse = class + public + Constructor create; + Destructor Destroy;override; + Function Evaluate(Expr: String): aint; + Function Priority(_Operator: Char): aint; + private + RPNStack : Array[1..RPNMax] of aint; { Stack For RPN calculator } + RPNTop : aint; + OpStack : Array[1..OpMax] of TExprOperator; { Operator stack For conversion } + OpTop : aint; + Procedure RPNPush(Num: aint); + Function RPNPop: aint; + Procedure RPNCalc(const token: String; prefix: boolean); + Procedure OpPush(_Operator: char; prefix: boolean); + { In reality returns TExprOperaotr } + Procedure OpPop(var _Operator:TExprOperator); + end; + + { Evaluate an expression string to a aint } + Function CalculateExpression(const expression: string): aint; + + {---------------------------------------------------------------------} + { String routines } + {---------------------------------------------------------------------} + +Function ParseVal(const S:String;base:byte):aint; +Function PadZero(Var s: String; n: byte): Boolean; +Function EscapeToPascal(const s:string): string; + +{--------------------------------------------------------------------- + Symbol helper routines +---------------------------------------------------------------------} + +procedure AsmSearchSym(const s:string;var srsym:tsym;var srsymtable:TSymtable); +Function GetRecordOffsetSize(s:string;Var Offset: aint;var Size:aint; var mangledname: string; needvmtofs: boolean):boolean; +Function SearchType(const hs:string;var size:aint): Boolean; +Function SearchRecordType(const s:string): boolean; +Function SearchIConstant(const s:string; var l:aint): boolean; + + +{--------------------------------------------------------------------- + Instruction generation routines +---------------------------------------------------------------------} + + Procedure ConcatPasString(p : TAsmList;s:string); + Procedure ConcatLabel(p: TAsmList;var l : tasmlabel); + Procedure ConcatConstant(p : TAsmList;value: aint; constsize:byte); + Procedure ConcatConstSymbol(p : TAsmList;const sym:string;symtyp:tasmsymtype;l:aint); + Procedure ConcatRealConstant(p : TAsmList;value: bestreal; real_typ : tfloattype); + Procedure ConcatString(p : TAsmList;s:string); + procedure ConcatAlign(p:TAsmList;l:aint); + Procedure ConcatPublic(p:TAsmList;const s : string); + Procedure ConcatLocal(p:TAsmList;const s : string); + + +Implementation + +uses + SysUtils, + defutil,systems,verbose,globals, + symtable,paramgr, + aasmcpu, + procinfo; + +{************************************************************************* + TExprParse +*************************************************************************} + +Constructor TExprParse.create; +Begin +end; + + +Procedure TExprParse.RPNPush(Num : aint); +{ Add an operand to the top of the RPN stack } +begin + if RPNTop < RPNMax then + begin + Inc(RPNTop); + RPNStack[RPNTop]:=Num; + end + else + Message(asmr_e_expr_illegal); +end; + + +Function TExprParse.RPNPop : aint; +{ Get the operand at the top of the RPN stack } +begin + if RPNTop > 0 then + begin + RPNPop:=RPNStack[RPNTop]; + Dec(RPNTop); + end + else + Message(asmr_e_expr_illegal); +end; + + +Procedure TExprParse.RPNCalc(const Token : String; prefix:boolean); { RPN Calculator } +Var + Temp : aint; + n1,n2 : aint; + LocalError : Integer; +begin + { Handle operators } + if (Length(Token) = 1) and (Token[1] in ['+', '-', '*', '/','&','|','%','^','~','<','>']) then + Case Token[1] of + '+' : + Begin + if not prefix then + RPNPush(RPNPop + RPNPop); + end; + '-' : + Begin + if prefix then + RPNPush(-(RPNPop)) + else + begin + n1:=RPNPop; + n2:=RPNPop; + RPNPush(n2 - n1); + end; + end; + '*' : RPNPush(RPNPop * RPNPop); + '&' : + begin + n1:=RPNPop; + n2:=RPNPop; + RPNPush(n2 and n1); + end; + '|' : + begin + n1:=RPNPop; + n2:=RPNPop; + RPNPush(n2 or n1); + end; + '~' : RPNPush(NOT RPNPop); + '<' : + begin + n1:=RPNPop; + n2:=RPNPop; + RPNPush(n2 SHL n1); + end; + '>' : + begin + n1:=RPNPop; + n2:=RPNPop; + RPNPush(n2 SHR n1); + end; + '%' : + begin + Temp:=RPNPop; + if Temp <> 0 then + RPNPush(RPNPop mod Temp) + else + begin + Message(asmr_e_expr_zero_divide); + { push 1 for error recovery } + RPNPush(1); + end; + end; + '^' : RPNPush(RPNPop XOR RPNPop); + '/' : + begin + Temp:=RPNPop; + if Temp <> 0 then + RPNPush(RPNPop div Temp) + else + begin + Message(asmr_e_expr_zero_divide); + { push 1 for error recovery } + RPNPush(1); + end; + end; + end + else + begin + { Convert String to number and add to stack } + Val(Token, Temp, LocalError); + if LocalError = 0 then + RPNPush(Temp) + else + begin + Message(asmr_e_expr_illegal); + { push 1 for error recovery } + RPNPush(1); + end; + end; +end; + + +Procedure TExprParse.OpPush(_Operator : char;prefix: boolean); +{ Add an operator onto top of the stack } +begin + if OpTop < OpMax then + begin + Inc(OpTop); + OpStack[OpTop].ch:=_Operator; + OpStack[OpTop].is_prefix:=prefix; + end + else + Message(asmr_e_expr_illegal); +end; + + +Procedure TExprParse.OpPop(var _Operator:TExprOperator); +{ Get operator at the top of the stack } +begin + if OpTop > 0 then + begin + _Operator:=OpStack[OpTop]; + Dec(OpTop); + end + else + Message(asmr_e_expr_illegal); +end; + + +Function TExprParse.Priority(_Operator : Char) : aint; +{ Return priority of operator } +{ The greater the priority, the higher the precedence } +begin + Case _Operator OF + '(' : + Priority:=0; + '|','^','~' : // the lowest priority: OR, XOR, NOT + Priority:=0; + '&' : // bigger priority: AND + Priority:=1; + '+', '-' : // bigger priority: +, - + Priority:=2; + '*', '/','%','<','>' : // the highest priority: *, /, MOD, SHL, SHR + Priority:=3; + else + Message(asmr_e_expr_illegal); + end; +end; + + +Function TExprParse.Evaluate(Expr : String):aint; +Var + I : longint; + Token : String; + opr : TExprOperator; +begin + Evaluate:=0; + { Reset stacks } + OpTop :=0; + RPNTop:=0; + Token :=''; + { nothing to do ? } + if Expr='' then + exit; + For I:=1 to Length(Expr) DO + begin + if Expr[I] in ['0'..'9'] then + begin { Build multi-digit numbers } + Token:=Token + Expr[I]; + if I = Length(Expr) then { Send last one to calculator } + RPNCalc(Token,false); + end + else + if Expr[I] in ['+', '-', '*', '/', '(', ')','^','&','|','%','~','<','>'] then + begin + if Token <> '' then + begin { Send last built number to calc. } + RPNCalc(Token,false); + Token:=''; + end; + + Case Expr[I] OF + '(' : OpPush('(',false); + ')' : begin + While (OpTop>0) and (OpStack[OpTop].ch <> '(') DO + Begin + OpPop(opr); + RPNCalc(opr.ch,opr.is_prefix); + end; + OpPop(opr); { Pop off and ignore the '(' } + end; + '+','-','~' : Begin + { workaround for -2147483648 } + if (expr[I]='-') and (expr[i+1] in ['0'..'9']) then + begin + token:='-'; + expr[i]:='+'; + end; + { if start of expression then surely a prefix } + { or if previous char was also an operator } + if (I = 1) or (not (Expr[I-1] in ['0'..'9',')'])) then + OpPush(Expr[I],true) + else + Begin + { Evaluate all higher priority operators } + While (OpTop > 0) AND (Priority(Expr[I]) <= Priority(OpStack[OpTop].ch)) DO + Begin + OpPop(opr); + RPNCalc(opr.ch,opr.is_prefix); + end; + OpPush(Expr[I],false); + End; + end; + '*', '/', + '^','|','&', + '%','<','>' : begin + While (OpTop > 0) and (Priority(Expr[I]) <= Priority(OpStack[OpTop].ch)) DO + Begin + OpPop(opr); + RPNCalc(opr.ch,opr.is_prefix); + end; + OpPush(Expr[I],false); + end; + end; { Case } + end + else + Message(asmr_e_expr_illegal); { Handle bad input error } + end; + +{ Pop off the remaining operators } + While OpTop > 0 do + Begin + OpPop(opr); + RPNCalc(opr.ch,opr.is_prefix); + end; + +{ The result is stored on the top of the stack } + Evaluate:=RPNPop; +end; + + +Destructor TExprParse.Destroy; +Begin +end; + + +Function CalculateExpression(const expression: string): aint; +var + expr: TExprParse; +Begin + expr:=TExprParse.create; + CalculateExpression:=expr.Evaluate(expression); + expr.Free; +end; + + +{*************************************************************************} +{ String conversions/utils } +{*************************************************************************} + +Function EscapeToPascal(const s:string): string; +{ converts a C styled string - which contains escape } +{ characters to a pascal style string. } +var + i,len : aint; + hs : string; + temp : string; + c : char; +Begin + hs:=''; + len:=0; + i:=0; + while (i<length(s)) and (len<255) do + begin + Inc(i); + if (s[i]='\') and (i<length(s)) then + Begin + inc(i); + case s[i] of + '\' : + c:='\'; + 'b': + c:=#8; + 'f': + c:=#12; + 'n': + c:=#10; + 'r': + c:=#13; + 't': + c:=#9; + '"': + c:='"'; + '0'..'7': + Begin + temp:=s[i]; + temp:=temp+s[i+1]; + temp:=temp+s[i+2]; + inc(i,2); + c:=chr(ParseVal(temp,8)); + end; + 'x': + Begin + temp:=s[i+1]; + temp:=temp+s[i+2]; + inc(i,2); + c:=chr(ParseVal(temp,16)); + end; + else + Begin + Message1(asmr_e_escape_seq_ignored,s[i]); + c:=s[i]; + end; + end; + end + else + c:=s[i]; + inc(len); + hs[len]:=c; + end; + hs[0]:=chr(len); + EscapeToPascal:=hs; +end; + + +Function ParseVal(const S:String;base:byte):aint; +{ Converts a decimal string to aint } +var + code : integer; + errmsg : word; + prefix : string[2]; +Begin + case base of + 2 : + begin + errmsg:=asmr_e_error_converting_binary; + prefix:='%'; + end; + 8 : + begin + errmsg:=asmr_e_error_converting_octal; + prefix:='&'; + end; + 10 : + begin + errmsg:=asmr_e_error_converting_decimal; + prefix:=''; + end; + 16 : + begin + errmsg:=asmr_e_error_converting_hexadecimal; + prefix:='$'; + end; + else + internalerror(200501202); + end; + val(prefix+s,result,code); + if code<>0 then + begin + val(prefix+s,aword(result),code); + if code<>0 then + begin + Message1(errmsg,s); + result:=0; + end; + end; +end; + + +Function PadZero(Var s: String; n: byte): Boolean; +Begin + PadZero:=TRUE; + { Do some error checking first } + if Length(s) = n then + exit + else + if Length(s) > n then + Begin + PadZero:=FALSE; + delete(s,n+1,length(s)); + exit; + end + else + PadZero:=TRUE; + { Fill it up with the specified character } + fillchar(s[length(s)+1],n-1,#0); + s[0]:=chr(n); +end; + + +{**************************************************************************** + TOperand +****************************************************************************} + +constructor TOperand.Create; +begin + size:=OS_NO; + hastype:=false; + hasvar:=false; + FillChar(Opr,sizeof(Opr),0); +end; + + +destructor TOperand.destroy; +begin +end; + + +Procedure TOperand.SetSize(_size:longint;force:boolean); +begin + if force or + ((size = OS_NO) and (_size<=16)) then + Begin + case _size of + 1 : size:=OS_8; + 2 : size:=OS_16{ could be S_IS}; + 4 : size:=OS_32{ could be S_IL or S_FS}; + 8 : size:=OS_64{ could be S_D or S_FL}; + 10 : size:=OS_F80; + 16 : size:=OS_128; + end; + end; +end; + + +Procedure TOperand.SetCorrectSize(opcode:tasmop); +begin +end; + + +function TOperand.SetupResult:boolean; + +begin + SetupResult:=false; + { replace by correct offset. } + with current_procinfo.procdef do + if (not is_void(returndef)) then + begin + if (m_tp7 in current_settings.modeswitches) and + (not paramanager.ret_in_param(returndef,proccalloption)) then + begin + message(asmr_e_cannot_use_RESULT_here); + exit; + end; + SetupResult:=setupvar('result',false) + end + else + message(asmr_e_void_function); +end; + + +Function TOperand.SetupSelf:boolean; +Begin + SetupSelf:=false; + if assigned(current_structdef) then + SetupSelf:=setupvar('self',false) + else + Message(asmr_e_cannot_use_SELF_outside_a_method); +end; + + +Function TOperand.SetupOldEBP:boolean; +Begin + SetupOldEBP:=false; + if current_procinfo.procdef.parast.symtablelevel>normal_function_level then + SetupOldEBP:=setupvar('parentframe',false) + else + Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure); +end; + + +Function TOperand.SetupVar(const s:string;GetOffset : boolean): Boolean; + + function symtable_has_localvarsyms(st:TSymtable):boolean; + var + sym : tsym; + i : longint; + begin + result:=false; + for i:=0 to st.SymList.Count-1 do + begin + sym:=tsym(st.SymList[i]); + if sym.typ=localvarsym then + begin + result:=true; + exit; + end; + end; + end; + + procedure setconst(l:aint); + begin + { We return the address of the field, just like Delphi/TP } + case opr.typ of + OPR_NONE : + begin + opr.typ:=OPR_CONSTANT; + opr.val:=l; + end; + OPR_CONSTANT : + inc(opr.val,l); + OPR_REFERENCE : + inc(opr.ref.offset,l); + OPR_LOCAL : + inc(opr.localsymofs,l); + else + Message(asmr_e_invalid_operand_type); + end; + end; + + +{ search and sets up the correct fields in the Instr record } +{ for the NON-constant identifier passed to the routine. } +{ if not found returns FALSE. } +var + sym : tsym; + srsymtable : TSymtable; + harrdef : tarraydef; + indexreg : tregister; + l : aint; + plist : ppropaccesslistitem; +Begin + SetupVar:=false; + asmsearchsym(s,sym,srsymtable); + if sym = nil then + exit; + if sym.typ=absolutevarsym then + begin + if (tabsolutevarsym(sym).abstyp=tovar) then + begin + { Only support simple loads } + plist:=tabsolutevarsym(sym).ref.firstsym; + if assigned(plist) and + (plist^.sltype=sl_load) then + sym:=plist^.sym + else + begin + Message(asmr_e_unsupported_symbol_type); + exit; + end; + end + else + begin + Message(asmr_e_unsupported_symbol_type); + exit; + end; + end; + case sym.typ of + fieldvarsym : + begin + if not tabstractrecordsymtable(sym.owner).is_packed then + setconst(tfieldvarsym(sym).fieldoffset) + else if tfieldvarsym(sym).fieldoffset mod 8 = 0 then + setconst(tfieldvarsym(sym).fieldoffset div 8) + else + Message(asmr_e_packed_element); + hasvar:=true; + SetupVar:=true; + end; + staticvarsym, + localvarsym, + paravarsym : + begin + { we always assume in asm statements that } + { that the variable is valid. } + tabstractvarsym(sym).varstate:=vs_readwritten; + inc(tabstractvarsym(sym).refs); + { variable can't be placed in a register } + tabstractvarsym(sym).varregable:=vr_none; + { and anything may happen with its address } + tabstractvarsym(sym).addr_taken:=true; + case sym.typ of + staticvarsym : + begin + initref; + opr.ref.symbol:=current_asmdata.RefAsmSymbol(tstaticvarsym(sym).mangledname); + end; + paravarsym, + localvarsym : + begin + if opr.typ=OPR_REFERENCE then + begin + indexreg:=opr.ref.base; + if opr.ref.index<>NR_NO then + begin + if indexreg=NR_NO then + indexreg:=opr.ref.index + else + Message(asmr_e_multiple_index); + end; + end + else + indexreg:=NR_NO; + opr.typ:=OPR_LOCAL; + if assigned(current_procinfo.parent) and + not(po_inline in current_procinfo.procdef.procoptions) and + (sym.owner<>current_procinfo.procdef.localst) and + (sym.owner<>current_procinfo.procdef.parast) and + (current_procinfo.procdef.localst.symtablelevel>normal_function_level) and + symtable_has_localvarsyms(current_procinfo.procdef.localst) then + message1(asmr_e_local_para_unreachable,s); + opr.localsym:=tabstractnormalvarsym(sym); + opr.localsymofs:=0; + opr.localindexreg:=indexreg; + opr.localscale:=0; + opr.localgetoffset:=GetOffset; + if paramanager.push_addr_param(tabstractvarsym(sym).varspez,tabstractvarsym(sym).vardef,current_procinfo.procdef.proccalloption) then + SetSize(sizeof(pint),false); + end; + end; + case tabstractvarsym(sym).vardef.typ of + orddef, + enumdef, + pointerdef, + floatdef : + SetSize(tabstractvarsym(sym).getsize,false); + arraydef : + begin + { for arrays try to get the element size, take care of + multiple indexes } + harrdef:=tarraydef(tabstractvarsym(sym).vardef); + while assigned(harrdef.elementdef) and + (harrdef.elementdef.typ=arraydef) do + harrdef:=tarraydef(harrdef.elementdef); + if not is_packed_array(harrdef) then + SetSize(harrdef.elesize,false) + else + begin + if (harrdef.elepackedbitsize mod 8) = 0 then + SetSize(harrdef.elepackedbitsize div 8,false) + end; + end; + end; + hasvar:=true; + SetupVar:=true; + Exit; + end; + constsym : + begin + if tconstsym(sym).consttyp=constord then + begin + setconst(tconstsym(sym).value.valueord.svalue); + SetupVar:=true; + Exit; + end; + end; + typesym : + begin + if ttypesym(sym).typedef.typ in [recorddef,objectdef] then + begin + setconst(0); + SetupVar:=TRUE; + Exit; + end; + end; + procsym : + begin + if opr.typ<>OPR_NONE then + Message(asmr_e_invalid_operand_type); + if Tprocsym(sym).ProcdefList.Count>1 then + Message(asmr_w_calling_overload_func); + l:=opr.ref.offset; + opr.typ:=OPR_SYMBOL; + opr.symbol:=current_asmdata.RefAsmSymbol(tprocdef(tprocsym(sym).ProcdefList[0]).mangledname); + opr.symofs:=l; + hasvar:=true; + SetupVar:=TRUE; + Exit; + end; + else + begin + Message(asmr_e_unsupported_symbol_type); + exit; + end; + end; +end; + + +procedure TOperand.InitRef; +{*********************************************************************} +{ Description: This routine first check if the opcode is of } +{ type OPR_NONE, or OPR_REFERENCE , if not it gives out an error. } +{ If the operandtype = OPR_NONE or <> OPR_REFERENCE then it sets up } +{ the operand type to OPR_REFERENCE, as well as setting up the ref } +{ to point to the default segment. } +{*********************************************************************} +var + l : aint; + hsymofs : aint; + hsymbol : tasmsymbol; + reg : tregister; +Begin + case opr.typ of + OPR_REFERENCE : + exit; + OPR_CONSTANT : + begin + l:=opr.val; + opr.typ:=OPR_REFERENCE; + Fillchar(opr.ref,sizeof(treference),0); + opr.Ref.Offset:=l; + end; + OPR_NONE : + begin + opr.typ:=OPR_REFERENCE; + Fillchar(opr.ref,sizeof(treference),0); + end; + OPR_REGISTER : + begin + reg:=opr.reg; + opr.typ:=OPR_REFERENCE; + Fillchar(opr.ref,sizeof(treference),0); + opr.Ref.base:=reg; + end; + OPR_SYMBOL : + begin + hsymbol:=opr.symbol; + hsymofs:=opr.symofs; + opr.typ:=OPR_REFERENCE; + Fillchar(opr.ref,sizeof(treference),0); + opr.ref.symbol:=hsymbol; + opr.ref.offset:=hsymofs; + end; + else + begin + Message(asmr_e_invalid_operand_type); + { Recover } + opr.typ:=OPR_REFERENCE; + Fillchar(opr.ref,sizeof(treference),0); + end; + end; +end; + +Function TOperand.CheckOperand: boolean; +{*********************************************************************} +{ Description: This routine checks if the operand is of } +{ valid, and returns false if it isn't. Does nothing by default. } +{*********************************************************************} +begin + result:=true; +end; + + +{**************************************************************************** + TInstruction +****************************************************************************} + +constructor TInstruction.create(optype : tcoperand); + var + i : longint; + Begin + { these field are set to 0 anyways by the constructor helper (FK) + Opcode:=A_NONE; + Condition:=C_NONE; + Ops:=0; + } + for i:=1 to max_operands do + Operands[i]:=optype.create; + Labeled:=false; + end; + + +destructor TInstruction.destroy; +var + i : longint; +Begin + for i:=1 to max_operands do + Operands[i].free; +end; + + + Procedure TInstruction.Swapoperands; + Var + p : toperand; + Begin + case ops of + 0,1: + ; + 2 : begin + { 0,1 -> 1,0 } + p:=Operands[1]; + Operands[1]:=Operands[2]; + Operands[2]:=p; + end; +{$ifndef MAX_OPER_2} + 3 : begin + { 0,1,2 -> 2,1,0 } + p:=Operands[1]; + Operands[1]:=Operands[3]; + Operands[3]:=p; + end; +{$ifndef MAX_OPER_3} + 4 : begin + { 0,1,2,3 -> 3,2,1,0 } + p:=Operands[1]; + Operands[1]:=Operands[4]; + Operands[4]:=p; + p:=Operands[2]; + Operands[2]:=Operands[3]; + Operands[3]:=p; + end; +{$endif} +{$endif} + else + internalerror(201108142); + end; + end; + + + function TInstruction.ConcatInstruction(p:TAsmList) : tai; + var + ai : taicpu; + i : longint; + begin + for i:=1 to Ops do + operands[i].CheckOperand; + + ai:=taicpu.op_none(opcode); + ai.Ops:=Ops; + ai.Allocate_oper(Ops); + for i:=1 to Ops do + with operands[i].opr do + begin + case typ of + OPR_CONSTANT : + ai.loadconst(i-1,val); + OPR_REGISTER: + ai.loadreg(i-1,reg); + OPR_SYMBOL: + ai.loadsymbol(i-1,symbol,symofs); + OPR_LOCAL : + ai.loadlocal(i-1,localsym,localsymofs,localindexreg, + localscale,localgetoffset,localforceref); + OPR_REFERENCE: + ai.loadref(i-1,ref); +{$ifdef ARM} + OPR_REGSET: + ai.loadregset(i-1,regtype,subreg,regset); + OPR_SHIFTEROP: + ai.loadshifterop(i-1,shifterop); + OPR_COND: + ai.loadconditioncode(i-1,cc); + OPR_MODEFLAGS: + ai.loadmodeflags(i-1,flags); +{$endif ARM} + { ignore wrong operand } + OPR_NONE: + ; + else + internalerror(200501051); + end; + end; + ai.SetCondition(condition); + { Concat the opcode or give an error } + if assigned(ai) then + p.concat(ai) + else + Message(asmr_e_invalid_opcode_and_operand); + result:=ai; + end; + + +{*************************************************************************** + TLocalLabel +***************************************************************************} + +constructor TLocalLabel.create(AList:TFPHashObjectList;const n:string); +begin + inherited Create(AList,n); + lab:=nil; + emitted:=false; +end; + + +function TLocalLabel.Gettasmlabel:tasmlabel; +begin + if not assigned(lab) then + begin + current_asmdata.getjumplabel(lab); + { this label is forced to be used so it's always written } + lab.increfs; + end; + Gettasmlabel:=lab; +end; + + +{*************************************************************************** + TLocalLabelList +***************************************************************************} + +procedure TLocalLabelList.CheckEmitted; +var + i : longint; + lab : TLocalLabel; +begin + for i:=0 to LocalLabelList.Count-1 do + begin + lab:=TLocalLabel(LocalLabelList[i]); + if not lab.emitted then + Message1(asmr_e_unknown_label_identifier,lab.name); + end; +end; + + +function CreateLocalLabel(const s: string; var hl: tasmlabel; emit:boolean):boolean; +var + lab : TLocalLabel; +Begin + CreateLocalLabel:=true; +{ Check if it already is defined } + lab:=TLocalLabel(LocalLabellist.Find(s)); + if not assigned(lab) then + lab:=TLocalLabel.Create(LocalLabellist,s); +{ set emitted flag and check for dup syms } + if emit then + begin + if lab.Emitted then + begin + Message1(asmr_e_dup_local_sym,lab.Name); + CreateLocalLabel:=false; + end; + lab.Emitted:=true; + end; + hl:=lab.Gettasmlabel; +end; + + +{**************************************************************************** + Symbol table helper routines +****************************************************************************} + +procedure AsmSearchSym(const s:string;var srsym:tsym;var srsymtable:TSymtable); +var + i : integer; +begin + i:=pos('.',s); + { allow unit.identifier } + if i>0 then + begin + searchsym(Copy(s,1,i-1),srsym,srsymtable); + if assigned(srsym) then + begin + if (srsym.typ=unitsym) and + (srsym.owner.symtabletype in [staticsymtable,globalsymtable]) and + srsym.owner.iscurrentunit then + searchsym_in_module(tunitsym(srsym).module,Copy(s,i+1,255),srsym,srsymtable) + else + begin + srsym:=nil; + srsymtable:=nil; + end; + end; + end + else + searchsym(s,srsym,srsymtable); +end; + + +Function SearchType(const hs:string;var size:aint): Boolean; +var + srsym : tsym; + srsymtable : TSymtable; +begin + result:=false; + size:=0; + asmsearchsym(hs,srsym,srsymtable); + if assigned(srsym) and + (srsym.typ=typesym) then + begin + size:=ttypesym(srsym).typedef.size; + result:=true; + end; +end; + + + +Function SearchRecordType(const s:string): boolean; +var + srsym : tsym; + srsymtable : TSymtable; +Begin + SearchRecordType:=false; +{ Check the constants in symtable } + asmsearchsym(s,srsym,srsymtable); + if srsym <> nil then + Begin + case srsym.typ of + typesym : + begin + if ttypesym(srsym).typedef.typ in [recorddef,objectdef] then + begin + SearchRecordType:=true; + exit; + end; + end; + fieldvarsym : + begin + if (tfieldvarsym(srsym).vardef.typ in [recorddef,objectdef]) then + begin + SearchRecordType:=true; + exit; + end; + end; + end; + end; +end; + + +Function SearchIConstant(const s:string; var l:aint): boolean; +{**********************************************************************} +{ Description: Searches for a CONSTANT of name s in either the local } +{ symbol list, then in the global symbol list, and returns the value } +{ of that constant in l. Returns TRUE if successfull, if not found, } +{ or if the constant is not of correct type, then returns FALSE } +{ Remarks: Also handle TRUE and FALSE returning in those cases 1 and 0 } +{ respectively. } +{**********************************************************************} +var + srsym : tsym; + srsymtable : TSymtable; +Begin + SearchIConstant:=false; +{ check for TRUE or FALSE reserved words first } + if s = 'TRUE' then + Begin + SearchIConstant:=TRUE; + l:=1; + exit; + end; + if s = 'FALSE' then + Begin + SearchIConstant:=TRUE; + l:=0; + exit; + end; +{ Check the constants in symtable } + asmsearchsym(s,srsym,srsymtable); + if srsym <> nil then + Begin + case srsym.typ of + constsym : + begin + if tconstsym(srsym).consttyp=constord then + Begin + l:=tconstsym(srsym).value.valueord.svalue; + SearchIConstant:=TRUE; + exit; + end; + end; + enumsym: + Begin + l:=tenumsym(srsym).value; + SearchIConstant:=TRUE; + exit; + end; + end; + end; +end; + + +Function GetRecordOffsetSize(s:string;Var Offset: aint;var Size:aint; var mangledname: string; needvmtofs: boolean):boolean; +{ search and returns the offset and size of records/objects of the base } +{ with field name setup in field. } +{ returns FALSE if not found. } +{ used when base is a variable or a typed constant name. } +var + st : TSymtable; + harrdef : tarraydef; + sym : tsym; + srsymtable : TSymtable; + i : longint; + base : string; + procdef: tprocdef; +Begin + GetRecordOffsetSize:=FALSE; + Offset:=0; + Size:=0; + mangledname:=''; + i:=pos('.',s); + if i=0 then + i:=255; + base:=Copy(s,1,i-1); + delete(s,1,i); + if base='SELF' then + st:=current_structdef.symtable + else + begin + asmsearchsym(base,sym,srsymtable); + st:=nil; + { we can start with a var,type,typedconst } + if assigned(sym) then + case sym.typ of + staticvarsym, + localvarsym, + paravarsym : + st:=Tabstractvarsym(sym).vardef.GetSymtable(gs_record); + typesym : + st:=Ttypesym(sym).typedef.GetSymtable(gs_record); + end + else + s:=''; + end; + { now walk all recordsymtables } + while assigned(st) and (s<>'') do + begin + { load next field in base } + i:=pos('.',s); + if i=0 then + i:=255; + base:=Copy(s,1,i-1); + delete(s,1,i); + sym:=search_struct_member(tabstractrecorddef(st.defowner),base); + if not assigned(sym) then + begin + GetRecordOffsetSize:=false; + exit; + end; + st:=nil; + case sym.typ of + fieldvarsym : + with Tfieldvarsym(sym) do + begin + if not tabstractrecordsymtable(sym.owner).is_packed then + inc(Offset,fieldoffset) + else if tfieldvarsym(sym).fieldoffset mod 8 = 0 then + inc(Offset,fieldoffset div 8) + else + Message(asmr_e_packed_element); + size:=getsize; + case vardef.typ of + arraydef : + begin + { for arrays try to get the element size, take care of + multiple indexes } + harrdef:=tarraydef(vardef); + while assigned(harrdef.elementdef) and + (harrdef.elementdef.typ=arraydef) do + harrdef:=tarraydef(harrdef.elementdef); + if not is_packed_array(harrdef) then + size:=harrdef.elesize + else + begin + if (harrdef.elepackedbitsize mod 8) <> 0 then + Message(asmr_e_packed_element); + size := (harrdef.elepackedbitsize + 7) div 8; + end; + end; + recorddef : + st:=trecorddef(vardef).symtable; + objectdef : + st:=tobjectdef(vardef).symtable; + end; + end; + procsym: + begin + st:=nil; + if Tprocsym(sym).ProcdefList.Count>1 then + Message(asmr_w_calling_overload_func); + procdef:=tprocdef(tprocsym(sym).ProcdefList[0]); + if (not needvmtofs) then + begin + mangledname:=procdef.mangledname; + end + else + begin + { can only get the vmtoffset of virtual methods } + if not(po_virtualmethod in procdef.procoptions) or + is_objectpascal_helper(procdef.struct) then + Message1(asmr_e_no_vmtoffset_possible,FullTypeName(procdef,nil)) + else + begin + { size = sizeof(target_system_pointer) } + size:=sizeof(pint); + offset:=tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber) + end; + end; + { if something comes after the procsym, it's invalid assembler syntax } + GetRecordOffsetSize:=(s=''); + exit; + end; + end; + end; + { Support Field.Type as typecasting } + if (st=nil) and (s<>'') then + begin + asmsearchsym(s,sym,srsymtable); + if assigned(sym) and (sym.typ=typesym) then + begin + size:=ttypesym(sym).typedef.size; + s:='' + end; + end; + GetRecordOffsetSize:=(s=''); +end; + + +Function SearchLabel(const s: string; var hl: tasmlabel;emit:boolean): boolean; +var + sym : tsym; + srsymtable : TSymtable; + hs : string; +Begin + hl:=nil; + SearchLabel:=false; +{ Check for pascal labels, which are case insensetive } + hs:=upper(s); + asmsearchsym(hs,sym,srsymtable); + if sym=nil then + exit; + case sym.typ of + labelsym : + begin + if symtablestack.top.symtablelevel<>srsymtable.symtablelevel then + begin + Tlabelsym(sym).nonlocal:=true; + if emit then + exclude(current_procinfo.procdef.procoptions,po_inline); + end; + if not(assigned(tlabelsym(sym).asmblocklabel)) then + if Tlabelsym(sym).nonlocal then + current_asmdata.getglobaljumplabel(tlabelsym(sym).asmblocklabel) + else + current_asmdata.getjumplabel(tlabelsym(sym).asmblocklabel); + hl:=tlabelsym(sym).asmblocklabel; + if emit then + tlabelsym(sym).defined:=true + else + tlabelsym(sym).used:=true; + SearchLabel:=true; + end; + end; +end; + + + {*************************************************************************} + { Instruction Generation Utilities } + {*************************************************************************} + + + Procedure ConcatString(p : TAsmList;s:string); + {*********************************************************************} + { PROCEDURE ConcatString(s:string); } + { Description: This routine adds the character chain pointed to in } + { s to the instruction linked list. } + {*********************************************************************} + Var + pc: PChar; + Begin + getmem(pc,length(s)+1); + p.concat(Tai_string.Create_pchar(strpcopy(pc,s),length(s))); + end; + + Procedure ConcatPasString(p : TAsmList;s:string); + {*********************************************************************} + { PROCEDURE ConcatPasString(s:string); } + { Description: This routine adds the character chain pointed to in } + { s to the instruction linked list, contrary to ConcatString it } + { uses a pascal style string, so it conserves null characters. } + {*********************************************************************} + Begin + p.concat(Tai_string.Create(s)); + end; + + +Procedure ConcatConstant(p: TAsmList; value: aint; constsize:byte); +{*********************************************************************} +{ PROCEDURE ConcatConstant(value: aint; maxvalue: aint); } +{ Description: This routine adds the value constant to the current } +{ instruction linked list. } +{ maxvalue -> indicates the size of the data to initialize: } +{ $ff -> create a byte node. } +{ $ffff -> create a word node. } +{ $ffffffff -> create a dword node. } +{*********************************************************************} +var + rangelo,rangehi : int64; +Begin + case constsize of + 1 : + begin + p.concat(Tai_const.Create_8bit(byte(value))); + rangelo:=low(shortint); + rangehi:=high(byte); + end; + 2 : + begin + p.concat(Tai_const.Create_16bit(word(value))); + rangelo:=low(smallint); + rangehi:=high(word); + end; + 4 : + begin + p.concat(Tai_const.Create_32bit(longint(value))); + rangelo:=low(longint); + rangehi:=high(cardinal); + end; + 8 : + begin + p.concat(Tai_const.Create_64bit(int64(value))); + rangelo:=0; + rangehi:=0; + end; + else + internalerror(200405011); + end; + { check for out of bounds } + if (rangelo<>0) and + ((value>rangehi) or (value<rangelo)) then + Message(asmr_e_constant_out_of_bounds); +end; + + + Procedure ConcatConstSymbol(p : TAsmList;const sym:string;symtyp:tasmsymtype;l:aint); + begin + p.concat(Tai_const.Createname(sym,l)); + end; + + + Procedure ConcatRealConstant(p : TAsmList;value: bestreal; real_typ : tfloattype); + {***********************************************************************} + { PROCEDURE ConcatRealConstant(value: bestreal; real_typ : tfloattype); } + { Description: This routine adds the value constant to the current } + { instruction linked list. } + { real_typ -> indicates the type of the real data to initialize: } + { s32real -> create a single node. } + { s64real -> create a double node. } + { s80real -> create an extended node. } + { s64bit -> create a comp node. } + { f32bit -> create a fixed node. (not used normally) } + {***********************************************************************} + Begin + case real_typ of + s32real : p.concat(Tai_real_32bit.Create(value)); + s64real : +{$ifdef ARM} + if is_double_hilo_swapped then + p.concat(Tai_real_64bit.Create_hiloswapped(value)) + else +{$endif ARM} + p.concat(Tai_real_64bit.Create(value)); + s80real : p.concat(Tai_real_80bit.Create(value,s80floattype.size)); + sc80real : p.concat(Tai_real_80bit.Create(value,sc80floattype.size)); + s64comp : p.concat(Tai_comp_64bit.Create(trunc(value))); + end; + end; + + Procedure ConcatLabel(p: TAsmList;var l : tasmlabel); + {*********************************************************************} + { PROCEDURE ConcatLabel } + { Description: This routine either emits a label or a labeled } + { instruction to the linked list of instructions. } + {*********************************************************************} + begin + p.concat(Tai_label.Create(l)); + end; + + procedure ConcatAlign(p:TAsmList;l:aint); + {*********************************************************************} + { PROCEDURE ConcatPublic } + { Description: This routine emits an global definition to the } + { linked list of instructions.(used by AT&T styled asm) } + {*********************************************************************} + begin + p.concat(Tai_align.Create(l)); + end; + + procedure ConcatPublic(p:TAsmList;const s : string); + {*********************************************************************} + { PROCEDURE ConcatPublic } + { Description: This routine emits an global definition to the } + { linked list of instructions.(used by AT&T styled asm) } + {*********************************************************************} + begin + p.concat(Tai_symbol.Createname_global(s,AT_LABEL,0)); + end; + + procedure ConcatLocal(p:TAsmList;const s : string); + {*********************************************************************} + { PROCEDURE ConcatLocal } + { Description: This routine emits an local definition to the } + { linked list of instructions. } + {*********************************************************************} + begin + p.concat(Tai_symbol.Createname(s,AT_LABEL,0)); + end; + + +end. diff --git a/closures/compiler/regvars.pas b/closures/compiler/regvars.pas new file mode 100644 index 0000000000..1576d25536 --- /dev/null +++ b/closures/compiler/regvars.pas @@ -0,0 +1,666 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl and Jonas Maebe + + This unit handles register variable allocation + + 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 regvars; + +{$i fpcdefs.inc} + +interface + + uses + aasmbase,aasmtai,aasmdata,aasmcpu, + node, + symsym, + cpubase, cgbase, tgobj; + +{$ifdef OLDREGVARS} + procedure assign_regvars(p: tnode); + procedure load_regvars(asml: TAsmList; p: tnode); + procedure cleanup_regvars(asml: TAsmList); + procedure store_regvar(asml: TAsmList; reg: tregister); + procedure load_regvar(asml: TAsmList; vsym: tvarsym); + procedure load_regvar_reg(asml: TAsmList; reg: tregister); + procedure load_all_regvars(asml: TAsmList); + procedure free_regvars(list: TAsmList); +{ procedure translate_regvars(list: TAsmList); } +{$endif OLDREGVARS} + +{$ifdef i386} +(* + procedure sync_regvars_other(list1, list2: TAsmList; const regvarsloaded1, + regvarsloaded2: regvarother_booleanarray); + procedure sync_regvars_int(list1, list2: TAsmList; const regvarsloaded1, + regvarsloaded2: Tsuperregisterset); +*) +{$endif i386} + +implementation + + uses + globtype,systems,comphook, + cutils,cclasses,verbose,globals, + psub, + symconst,symbase,symtype,symdef,paramgr,defutil, + cpuinfo,cgobj,procinfo; + +{$ifdef OLDREGVARS} + procedure searchregvars(p : tnamedindexitem;arg:pointer); + var + i,j,k : longint; + parasym : boolean; + begin + parasym:=pboolean(arg)^; + if (tsym(p).typ=varsym) and ((tvarsym(p).varregable <> vr_none) or + ((tvarsym(p).varspez in [vs_var,vs_const,vs_out,vs_constref]) and + paramanager.push_addr_param(tvarsym(p).varspez,tvarsym(p).vardef,current_procinfo.procdef.proccalloption))) and + not tvarsym(p).vardef.needs_inittable then + begin + j:=tvarsym(p).refs; + { walk through all momentary register variables } + for i:=1 to maxvarregs do + begin + with pregvarinfo(current_procinfo.procdef.regvarinfo)^ do + if ((regvars[i]=nil) or (j>regvars_refs[i])) and (j>0) then + begin + for k:=maxvarregs-1 downto i do + begin + regvars[k+1]:=regvars[k]; + regvars_para[k+1]:=regvars_para[k]; + regvars_refs[k+1]:=regvars_refs[k]; + end; + { calc the new refs + tvarsym(p).refs:=j; } + regvars[i]:=tsym(p); + regvars_para[i]:=parasym; + regvars_refs[i]:=j; + break; + end; + end; + end; + end; + + + procedure searchfpuregvars(p : tnamedindexitem;arg:pointer); + var + i,j,k : longint; + parasym : boolean; + begin + parasym:=pboolean(arg)^; + if (tsym(p).typ=varsym) and (tvarsym(p).varregable <> vr_none) then + begin + j:=tvarsym(p).refs; + { parameter get a less value } + { walk through all momentary register variables } + for i:=1 to maxfpuvarregs do + begin + with pregvarinfo(current_procinfo.procdef.regvarinfo)^ do + if ((fpuregvars[i]=nil) or (j>fpuregvars_refs[i])) and (j>0) then + begin + for k:=maxfpuvarregs-1 downto i do + begin + fpuregvars[k+1]:=fpuregvars[k]; + fpuregvars_para[k+1]:=fpuregvars_para[k]; + fpuregvars_refs[k+1]:=fpuregvars_refs[k]; + end; + { calc the new refs + tvarsym(p).refs:=j; } + fpuregvars[i]:=tsym(p); + fpuregvars_para[i]:=parasym; + fpuregvars_refs[i]:=j; + break; + end; + end; + end; + end; + + procedure assign_regvars(p: tnode); + { register variables } + var +{$ifndef i386} + hp: tparaitem; +{$endif i386} + regvarinfo: pregvarinfo; + i: longint; + parasym : boolean; + siz : tcgsize; + begin + { max. optimizations } + { only if no asm is used } + { and no try statement } + if (cs_opt_regvar in current_settings.optimizerswitches) and + { we have to store regvars back to memory in this case (the nested } + { procedures can access the variables of the parent) } + (not current_procinfo.has_nestedprocs) and + not(pi_has_assembler_block in current_procinfo.flags) and + not(pi_uses_exceptions in current_procinfo.flags) then + begin + new(regvarinfo); + fillchar(regvarinfo^,sizeof(regvarinfo^),0); + current_procinfo.procdef.regvarinfo := regvarinfo; + if (p.registersint<maxvarregs) then + begin + parasym:=false; + symtablestack.foreach_static(searchregvars,@parasym); + { copy parameter into a register ? } + parasym:=true; + symtablestack.next.foreach_static(searchregvars,@parasym); + { hold needed registers free } + for i:=maxvarregs downto maxvarregs-p.registersint+1 do + begin + regvarinfo^.regvars[i]:=nil; + regvarinfo^.regvars_para[i] := false; + end; + { now assign register } + for i:=1 to maxvarregs-p.registersint do + begin + if assigned(regvarinfo^.regvars[i]) and + { currently we assume we can use registers for all } + { regvars if procedure does no call } + (not(pi_do_call in current_procinfo.flags) or + { otherwise, demand some (arbitrary) minimum usage } + (tvarsym(regvarinfo^.regvars[i]).refs > 100)) then + begin + { register is no longer available for } + { expressions } + { search the register which is the most } + { unused } + + { call by reference/const ? } + if paramanager.push_addr_param(tvarsym(regvarinfo^.regvars[i]).varspez,tvarsym(regvarinfo^.regvars[i]).vardef,current_procinfo.procdef.proccalloption) then + siz:=OS_32 + else + if (tvarsym(regvarinfo^.regvars[i]).vardef.typ in [orddef,enumdef]) and + (tvarsym(regvarinfo^.regvars[i]).vardef.size=1) then + siz:=OS_8 + else + if (tvarsym(regvarinfo^.regvars[i]).vardef.typ in [orddef,enumdef]) and + (tvarsym(regvarinfo^.regvars[i]).vardef.size=2) then + siz:=OS_16 + else + siz:=OS_32; + + { allocate a register for this regvar } + tvarsym(regvarinfo^.regvars[i]).localloc.register:=cg.getintregister(current_asmdata.CurrAsmList,siz); + tvarsym(regvarinfo^.regvars[i]).localloc.loc:=LOC_REGISTER; + { and make sure it can't be freed } +{ rg.makeregvarint(getsupreg(regvarinfo^.regvars[i].localloc.register));} + end + else + begin + regvarinfo^.regvars[i] := nil; + regvarinfo^.regvars_para[i] := false; + end; + end; + end; + if ((p.registersfpu+1)<maxfpuvarregs) then + begin + parasym:=false; + symtablestack.foreach_static(searchfpuregvars,@parasym); +{$ifndef i386} + { this code should be never enabled because } + { 1. the caller loads parameters into registers } + { 2. (later) the CSE loads a parameter into a } + { register, if necessary } + { (FK) } + { copy parameter into a register ? } + parasym:=true; + symtablestack.next.foreach_static(searchregvars,@parasym); +{$endif i386} + { hold needed registers free } + + { in non leaf procedures we must be very careful } + { with assigning registers } +{$ifdef i386} + if current_settings.maxfpuregisters=-1 then + begin + if (pi_do_call in current_procinfo.flags) then + begin + for i:=maxfpuvarregs downto 2 do + regvarinfo^.fpuregvars[i]:=nil; + end + else +{$endif i386} + begin + for i:=maxfpuvarregs downto maxfpuvarregs-p.registersfpu do + regvarinfo^.fpuregvars[i]:=nil; + end; +{$ifdef i386} + end + else + begin + for i:=current_settings.maxfpuregisters+1 to maxfpuvarregs do + regvarinfo^.fpuregvars[i]:=nil; + end; +{$endif i386} + { now assign register } + for i:=1 to maxfpuvarregs do + begin + if assigned(regvarinfo^.fpuregvars[i]) then + begin +{$ifdef i386} + { reserve place on the FPU stack } + {$error fixme x86 fpuregvars} +{ regvarinfo^.fpuregvars[i].localloc.register:=trgcpu(rg).correct_fpuregister(NR_ST0,i);} +{$else i386} +{$ifdef x86_64} +{$endif x86_64} + begin + tvarsym(regvarinfo^.fpuregvars[i]).localloc.register:=cg.getfpuregister(current_asmdata.CurrAsmList,OS_F64); + tvarsym(regvarinfo^.fpuregvars[i]).localloc.loc:=LOC_FPUREGISTER; +{ rg.makeregvarother(regvarinfo^.fpuregvars[i].localloc.register);} + end; +{$endif i386} + end; + end; + end; + end; + end; + + + + procedure store_regvar(asml: TAsmList; reg: tregister); + var + i: longint; + cgsize : tcgsize; + r : tregister; + hr: treference; + regvarinfo: pregvarinfo; + vsym: tvarsym; + regidx : tregisterindex; + supreg : tsuperregister; + begin +{$ifdef i386} + regvarinfo := pregvarinfo(current_procinfo.procdef.regvarinfo); + if not assigned(regvarinfo) then + exit; + if getregtype(reg)=R_INTREGISTER then + begin + supreg:=getsupreg(reg); + for i := 1 to maxvarregs do + if assigned(regvarinfo^.regvars[i]) and + (getsupreg(tvarsym(regvarinfo^.regvars[i]).localloc.register)=supreg) then + begin + { TODO: fixme regvar_loaded_int} +(* if supreg in rg.regvar_loaded_int then + begin + vsym := tvarsym(regvarinfo^.regvars[i]); + { we only have to store the regvar back to memory if it's } + { possible that it's been modified (JM) } + if not(vsym.varspez in [vs_const,vs_var,vs_out]) then + begin +{ TODO: FIXME Check vsym.localloc for regvars} +// reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address); + cgsize:=def_cgsize(vsym.vardef); + cg.a_load_reg_ref(asml,cgsize,cgsize,vsym.localloc.register,hr); + end; + asml.concat(tai_regalloc.dealloc(vsym.localloc.register)); + exclude(rg.regvar_loaded_int,supreg); + end; +*) + break; + end; + end + else + begin + for i := 1 to maxvarregs do + if assigned(regvarinfo^.regvars[i]) then + begin + { TODO: fixme regvars} +(* + r:=rg.makeregsize(regvarinfo^.regvars[i].localloc.register,OS_INT); + if (r = reg) then + begin + regidx:=findreg_by_number(r); + if rg.regvar_loaded_other[regidx] then + begin + vsym := tvarsym(regvarinfo^.regvars[i]); + { we only have to store the regvar back to memory if it's } + { possible that it's been modified (JM) } + if not(vsym.varspez in [vs_const,vs_var,vs_out]) then + begin +{ TODO: FIXME Check vsym.localloc for regvars} +// reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address); + cgsize:=def_cgsize(vsym.vardef); + cg.a_load_reg_ref(asml,cgsize,cgsize,vsym.localloc.register,hr); + end; + asml.concat(tai_regalloc.dealloc(vsym.localloc.register)); + rg.regvar_loaded_other[regidx] := false; + end; + break; + end; +*) + end; + end; +{$endif i386} + end; + + procedure load_regvar(asml: TAsmList; vsym: tvarsym); + var + hr: treference; + opsize: tcgsize; + r, + reg : tregister; + regidx : tregisterindex; + begin +{$ifndef i386} + exit; +{$endif i386} + reg:=vsym.localloc.register; + { TODO: fixme regvars} +(* + if getregtype(reg)=R_INTREGISTER then + begin + + if not(getsupreg(reg) in rg.regvar_loaded_int) then + begin + asml.concat(tai_regalloc.alloc(reg)); +{ TODO: FIXME Check vsym.localloc for regvars} +// reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address); + if paramanager.push_addr_param(vsym.varspez,vsym.vardef,current_procinfo.procdef.proccalloption) then + opsize := OS_ADDR + else + opsize := def_cgsize(vsym.vardef); + cg.a_load_ref_reg(asml,opsize,opsize,hr,reg); + include(rg.regvar_loaded_int,getsupreg(reg)); + end; + end + else + begin + r:=rg.makeregsize(reg,OS_INT); + regidx:=findreg_by_number(r); + if not rg.regvar_loaded_other[regidx] then + begin + asml.concat(tai_regalloc.alloc(reg)); +{ TODO: FIXME Check vsym.localloc for regvars} +// reference_reset_base(hr,current_procinfo.framepointer,vsym.adjusted_address); + if paramanager.push_addr_param(vsym.varspez,vsym.vardef,current_procinfo.procdef.proccalloption) then + opsize := OS_ADDR + else + opsize := def_cgsize(vsym.vardef); + cg.a_load_ref_reg(asml,opsize,opsize,hr,reg); + rg.regvar_loaded_other[regidx] := true; + end; + end; +*) + end; + + procedure load_regvar_reg(asml: TAsmList; reg: tregister); + var + i: longint; + regvarinfo: pregvarinfo; + reg_spare : tregister; + supreg : tsuperregister; + begin +{ + regvarinfo := pregvarinfo(current_procinfo.procdef.regvarinfo); + if not assigned(regvarinfo) then + exit; + if getregtype(reg)=R_INTREGISTER then + begin + supreg:=getsupreg(reg); + for i := 1 to maxvarregs do + if assigned(regvarinfo^.regvars[i]) and + (getsupreg(regvarinfo^.regvars[i].localloc.register) = supreg) then + load_regvar(asml,tvarsym(regvarinfo^.regvars[i])) + end + else + begin + reg_spare := cg.makeregsize(reg,OS_INT); + for i := 1 to maxvarregs do + if assigned(regvarinfo^.regvars[i]) and + (cg.makeregsize(regvarinfo^.regvars[i].localloc.register,OS_INT) = reg_spare) then + load_regvar(asml,tvarsym(regvarinfo^.regvars[i])) + end; +} + end; + + procedure load_all_regvars(asml: TAsmList); +{ + var + i: longint; + regvarinfo: pregvarinfo; +} + begin +{ + regvarinfo := pregvarinfo(current_procinfo.procdef.regvarinfo); + if not assigned(regvarinfo) then + exit; + for i := 1 to maxvarregs do + if assigned(regvarinfo^.regvars[i]) then + load_regvar(asml,tvarsym(regvarinfo^.regvars[i])) +} + end; + + + procedure load_regvars(asml: TAsmList; p: tnode); + var + i: longint; + regvarinfo: pregvarinfo; + begin + if (cs_opt_regvar in current_settings.optimizerswitches) and + not(pi_has_assembler_block in current_procinfo.flags) and + not(pi_uses_exceptions in current_procinfo.flags) then + begin + regvarinfo := pregvarinfo(current_procinfo.procdef.regvarinfo); + { can happen when inlining assembler procedures (JM) } + if not assigned(regvarinfo) then + exit; + for i:=1 to maxfpuvarregs do + begin + if assigned(regvarinfo^.fpuregvars[i]) then + begin +{$ifdef i386} + { reserve place on the FPU stack } + { TODO: fixme fpustack} +(* + regvarinfo^.fpuregvars[i].localloc.register:=trgcpu(rg).correct_fpuregister(NR_ST0,i-1); +*) + asml.concat(Taicpu.op_none(A_FLDZ,S_NO)); +{$endif i386} + end; + end; +{$ifdef i386} + if assigned(p) then + if cs_asm_source in current_settings.globalswitches then + asml.insert(tai_comment.Create(strpnew(tostr(p.registersfpu)+ + ' registers on FPU stack used by temp. expressions'))); +{$endif i386} +{ + for i:=1 to maxfpuvarregs do + begin + if assigned(regvarinfo^.fpuregvars[i]) then + begin + if cs_asm_source in current_settings.globalswitches then + asml.insert(tai_comment.Create(strpnew(regvarinfo^.fpuregvars[i].name+ + ' with weight '+tostr(regvarinfo^.fpuregvars[i].refs)+' assigned to register '+ + std_regname(regvarinfo^.fpuregvars[i].localloc.register)))); + if (status.verbosity and v_debug)=v_debug then + Message3(cg_d_register_weight,std_regname(regvarinfo^.fpuregvars[i].localloc.register), + tostr(regvarinfo^.fpuregvars[i].refs),regvarinfo^.fpuregvars[i].name); + end; + end; + if cs_asm_source in current_settings.globalswitches then + asml.insert(tai_comment.Create(strpnew('Register variable assignment:'))); +} + end; + end; + +{$ifdef i386} +(* + procedure sync_regvars_other(list1, list2: TAsmList; const regvarsloaded1, + regvarsloaded2: regvarother_booleanarray); + var + counter: tregisterindex; + begin + for counter := low(rg.regvar_loaded_other) to high(rg.regvar_loaded_other) do + begin + rg.regvar_loaded_other[counter] := regvarsloaded1[counter] and + regvarsloaded2[counter]; + if regvarsloaded1[counter] xor regvarsloaded2[counter] then + if regvarsloaded1[counter] then + load_regvar_reg(list2,counter) + else + load_regvar_reg(list1,counter); + end; + end; + + + procedure sync_regvars_int(list1, list2: TAsmList; const regvarsloaded1, + regvarsloaded2: Tsuperregisterset); + var + i : longint; + r : tregister; + begin + for i:=1 to maxvarregs do + begin + r:=newreg(R_INTREGISTER,varregs[i],R_SUBWHOLE); + if (varregs[i] in regvarsloaded1) and + not(varregs[i] in regvarsloaded2) then + load_regvar_reg(list2,r) + else + if (varregs[i] in regvarsloaded2) and + not(varregs[i] in regvarsloaded1) then + load_regvar_reg(list1,r); + end; + end; +*) +{$endif i386} + + + procedure cleanup_regvars(asml: TAsmList); + var + i: longint; + reg : tregister; + regidx : tregisterindex; + begin + { can happen when inlining assembler procedures (JM) } + if not assigned(current_procinfo.procdef.regvarinfo) then + exit; + if (cs_opt_regvar in current_settings.optimizerswitches) and + not(pi_has_assembler_block in current_procinfo.flags) and + not(pi_uses_exceptions in current_procinfo.flags) then + with pregvarinfo(current_procinfo.procdef.regvarinfo)^ do + begin +{$ifdef i386} + for i:=1 to maxfpuvarregs do + if assigned(fpuregvars[i]) then + { ... and clean it up } + asml.concat(Taicpu.op_reg(A_FSTP,S_NO,NR_ST0)); +{$endif i386} +(* + for i := 1 to maxvarregs do + begin + if assigned(regvars[i]) then + begin + reg:=regvars[i].localloc.register; + if getregtype(reg)=R_INTREGISTER then + begin + end + else + begin + reg:=cg.makeregsize(reg,OS_INT); + regidx:=findreg_by_number(reg); + { TODO: fixme regvar dealloc} +{ + if (rg.regvar_loaded_other[regidx]) then + asml.concat(tai_regalloc.dealloc(reg)); +} + end; + end; + end; +*) + end; + end; + +{ + + Note: this one can't really be "fixed": register colouring happens after + stabs generation. It could still be useful to generate the "var X is + assigned to register Y with weight ZZZ" messages though + + procedure translate_regvars(list: TAsmList); + var + i: longint; + r: tregister; + begin + if not assigned(current_procinfo.procdef.regvarinfo) then + exit; + with pregvarinfo(current_procinfo.procdef.regvarinfo)^ do + begin + for i := 1 to maxvarregs do + if assigned(regvars[i]) then + begin + cg.rg[R_INTREGISTER].translate_register(tvarsym(regvars[i]).localloc.register); + r:=tvarsym(regvars[i]).localloc.register; + if cs_asm_source in current_settings.globalswitches then + list.insert(tai_comment.Create(strpnew(tvarsym(regvars[i]).name+ + ' with weight '+tostr(tvarsym(regvars[i]).refs)+' assigned to register '+ + std_regname(r)))); + Message3(cg_d_register_weight,std_regname(r), + tostr(tvarsym(regvars[i]).refs),tvarsym(regvars[i]).name); + end; + for i := 1 to maxfpuvarregs do + if assigned(fpuregvars[i]) then + begin + cg.rg[R_FPUREGISTER].translate_register(tvarsym(regvars[i]).localloc.register); + r:=tvarsym(fpuregvars[i]).localloc.register; + if cs_asm_source in current_settings.globalswitches then + list.insert(tai_comment.Create(strpnew(tvarsym(fpuregvars[i]).name+ + ' with weight '+tostr(tvarsym(fpuregvars[i]).refs)+' assigned to register '+ + std_regname(r)))); + Message3(cg_d_register_weight,std_regname(r), + tostr(tvarsym(fpuregvars[i]).refs),tvarsym(fpuregvars[i]).name); + end; + end; + end; +} + + procedure free_regvars(list: TAsmList); + var + i: longint; + reg: tregister; + size: tcgsize; + begin + if not assigned(current_procinfo.procdef.regvarinfo) then + exit; + with pregvarinfo(current_procinfo.procdef.regvarinfo)^ do + begin + for i := 1 to maxvarregs do + if assigned(regvars[i]) then + begin + reg:=cg.makeregsize(list,tvarsym(regvars[i]).localloc.register,OS_INT); + cg.a_load_reg_reg(list,OS_INT,OS_INT,reg,reg); + end; + for i := 1 to maxfpuvarregs do + if assigned(fpuregvars[i]) then + begin + reg:=tvarsym(fpuregvars[i]).localloc.register; + size:=reg_cgsize(reg); + cg.a_loadfpu_reg_reg(list,size,reg,reg); + end; + end; + end; + + +{$endif OLDREGVARS} + + +end. diff --git a/closures/compiler/rescmn.pas b/closures/compiler/rescmn.pas new file mode 100644 index 0000000000..eee102d902 --- /dev/null +++ b/closures/compiler/rescmn.pas @@ -0,0 +1,59 @@ +{ + Copyright (c) 2008 by Giulio Bernardi + + Common resource target infos + + 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 rescmn; + +{$i fpcdefs.inc} + +interface + +uses + Systems; + + const + res_elf_info : tresinfo = + ( + id : res_elf; + resbin : 'fpcres'; + rescmd : '-o $OBJ -a $ARCH -of elf $DBG'; + { cross compiled windres can be used to compile .rc files on linux } + rcbin : 'windres'; + rccmd : '--include $INC -O res -o $RES $RC'; + resourcefileclass : nil; + resflags : []; + ); + + res_ext_info : tresinfo = + ( + id : res_ext; + resbin : 'fpcres'; + rescmd : '-o $OBJ -a $ENDIAN -of external $DBG'; + rcbin : 'windres'; + rccmd : '--include $INC -O res -o $RES $RC'; + resourcefileclass : nil; + resflags : [res_external_file]; + ); + + +implementation + +end. diff --git a/closures/compiler/rgbase.pas b/closures/compiler/rgbase.pas new file mode 100644 index 0000000000..a3224781ce --- /dev/null +++ b/closures/compiler/rgbase.pas @@ -0,0 +1,80 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Helper routines for 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 rgbase; + +{$i fpcdefs.inc} + +interface + + uses + cpuBase,cgBase; + + type + TRegNameTable = array[tregisterindex] of string[7]; + TRegisterIndexTable = array[tregisterindex] of tregisterindex; + + function findreg_by_number_table(r:Tregister;const regnumber_index:TRegisterIndexTable):tregisterindex; + function findreg_by_name_table(const s:string;const regname_table:TRegNameTable;const regname_index:TRegisterIndexTable):byte; + + +implementation + + function findreg_by_name_table(const s:string;const regname_table:TRegNameTable;const regname_index:TRegisterIndexTable):byte; + var + i,p,q : tregisterindex; + begin + p:=Low(tregisterindex); + q:=high(tregisterindex); + repeat + i:=(p+q) shr 1; + if s>regname_table[regname_index[i]] then + p:=i+1 + else + q:=i; + until p=q; + if regname_table[regname_index[p]]=s then + result:=regname_index[p] + else + result:=0; + end; + + + function findreg_by_number_table(r:Tregister;const regnumber_index:TRegisterIndexTable):tregisterindex; + var + i,p,q : longint; + begin + p:=Low(tregisterindex); + q:=high(tregisterindex); + repeat + i:=(p+q) shr 1; + if r>regnumber_table[regnumber_index[i]] then + p:=i+1 + else + q:=i; + until p=q; + if regnumber_table[regnumber_index[p]]=r then + result:=regnumber_index[p] + else + result:=0; + end; + +end. diff --git a/closures/compiler/rgobj.pas b/closures/compiler/rgobj.pas new file mode 100644 index 0000000000..72612ff495 --- /dev/null +++ b/closures/compiler/rgobj.pas @@ -0,0 +1,2162 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements the base 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. + **************************************************************************** +} + +{$i fpcdefs.inc} + +{ Allow duplicate allocations, can be used to get the .s file written } +{ $define ALLOWDUPREG} + + +unit rgobj; + + interface + + uses + cutils, cpubase, + aasmbase,aasmtai,aasmdata,aasmcpu, + cclasses,globtype,cgbase,cgutils, + cpuinfo + ; + + type + { + The interference bitmap contains of 2 layers: + layer 1 - 256*256 blocks with pointers to layer 2 blocks + layer 2 - blocks of 32*256 (32 bytes = 256 bits) + } + Tinterferencebitmap2 = array[byte] of set of byte; + Pinterferencebitmap2 = ^Tinterferencebitmap2; + Tinterferencebitmap1 = array[byte] of Pinterferencebitmap2; + pinterferencebitmap1 = ^tinterferencebitmap1; + + Tinterferencebitmap=class + private + maxx1, + maxy1 : byte; + fbitmap : pinterferencebitmap1; + function getbitmap(x,y:tsuperregister):boolean; + procedure setbitmap(x,y:tsuperregister;b:boolean); + public + constructor create; + destructor destroy;override; + property bitmap[x,y:tsuperregister]:boolean read getbitmap write setbitmap;default; + end; + + Tmovelistheader=record + count, + maxcount, + sorted_until : cardinal; + end; + + Tmovelist=record + header : Tmovelistheader; + data : array[tsuperregister] of Tlinkedlistitem; + end; + Pmovelist=^Tmovelist; + + {In the register allocator we keep track of move instructions. + These instructions are moved between five linked lists. There + is also a linked list per register to keep track about the moves + it is associated with. Because we need to determine quickly in + which of the five lists it is we add anu enumeradtion to each + move instruction.} + + Tmoveset=(ms_coalesced_moves,ms_constrained_moves,ms_frozen_moves, + ms_worklist_moves,ms_active_moves); + Tmoveins=class(Tlinkedlistitem) + moveset:Tmoveset; + x,y:Tsuperregister; + end; + + Treginfoflag=(ri_coalesced,ri_selected); + Treginfoflagset=set of Treginfoflag; + + Treginfo=record + live_start, + live_end : Tai; + subreg : tsubregister; + alias : Tsuperregister; + { The register allocator assigns each register a colour } + colour : Tsuperregister; + movelist : Pmovelist; + adjlist : Psuperregisterworklist; + degree : TSuperregister; + flags : Treginfoflagset; + weight : longint; + end; + Preginfo=^TReginfo; + + tspillreginfo = record + { a single register may appear more than once in an instruction, + but with different subregister types -> store all subregister types + that occur, so we can add the necessary constraints for the inline + register that will have to replace it } + spillregconstraints : set of TSubRegister; + orgreg : tsuperregister; + tempreg : tregister; + regread,regwritten, mustbespilled: boolean; + end; + tspillregsinfo = array[0..3] of tspillreginfo; + + Tspill_temp_list=array[tsuperregister] of Treference; + + {#------------------------------------------------------------------ + + This class implements the default register allocator. It is used by the + code generator to allocate and free registers which might be valid + across nodes. It also contains utility routines related to registers. + + Some of the methods in this class should be overridden + by cpu-specific implementations. + + --------------------------------------------------------------------} + trgobj=class + preserved_by_proc : tcpuregisterset; + used_in_proc : tcpuregisterset; + + constructor create(Aregtype:Tregistertype; + Adefaultsub:Tsubregister; + const Ausable:array of tsuperregister; + Afirst_imaginary:Tsuperregister; + Apreserved_by_proc:Tcpuregisterset); + destructor destroy;override; + + {# Allocate a register. An internalerror will be generated if there is + no more free registers which can be allocated.} + function getregister(list:TAsmList;subreg:Tsubregister):Tregister;virtual; + {# Get the register specified.} + procedure getcpuregister(list:TAsmList;r:Tregister);virtual; + procedure ungetcpuregister(list:TAsmList;r:Tregister);virtual; + {# Get multiple registers specified.} + procedure alloccpuregisters(list:TAsmList;const r:Tcpuregisterset);virtual; + {# Free multiple registers specified.} + procedure dealloccpuregisters(list:TAsmList;const r:Tcpuregisterset);virtual; + function uses_registers:boolean;virtual; + procedure add_reg_instruction(instr:Tai;r:tregister;aweight:longint); + procedure add_move_instruction(instr:Taicpu); + {# Do the register allocation.} + procedure do_register_allocation(list:TAsmList;headertai:tai);virtual; + { Adds an interference edge. + don't move this to the protected section, the arm cg requires to access this (FK) } + procedure add_edge(u,v:Tsuperregister); + { translates a single given imaginary register to it's real register } + procedure translate_register(var reg : tregister); + protected + regtype : Tregistertype; + { default subregister used } + defaultsub : tsubregister; + live_registers:Tsuperregisterworklist; + { can be overridden to add cpu specific interferences } + procedure add_cpu_interferences(p : tai);virtual; + procedure add_constraints(reg:Tregister);virtual; + function get_alias(n:Tsuperregister):Tsuperregister; + function getregisterinline(list:TAsmList;const subregconstraints:Tsubregisterset):Tregister; + procedure ungetregisterinline(list:TAsmList;r:Tregister); + function get_spill_subreg(r : tregister) : tsubregister;virtual; + function do_spill_replace(list:TAsmList;instr:taicpu;orgreg:tsuperregister;const spilltemp:treference):boolean;virtual; + procedure do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);virtual; + procedure do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);virtual; + + function instr_spill_register(list:TAsmList; + instr:taicpu; + const r:Tsuperregisterset; + const spilltemplist:Tspill_temp_list): boolean;virtual; + private + int_live_range_direction: TRADirection; + {# First imaginary register.} + first_imaginary : Tsuperregister; + {# Highest register allocated until now.} + reginfo : PReginfo; + maxreginfo, + maxreginfoinc, + maxreg : Tsuperregister; + usable_registers_cnt : word; + usable_registers : array[0..maxcpuregister-1] of tsuperregister; + ibitmap : Tinterferencebitmap; + spillednodes, + simplifyworklist, + freezeworklist, + spillworklist, + coalescednodes, + selectstack : tsuperregisterworklist; + worklist_moves, + active_moves, + frozen_moves, + coalesced_moves, + constrained_moves : Tlinkedlist; + extended_backwards, + backwards_was_first : tbitset; + +{$ifdef EXTDEBUG} + procedure writegraph(loopidx:longint); +{$endif EXTDEBUG} + {# Disposes of the reginfo array.} + procedure dispose_reginfo; + {# Prepare the register colouring.} + procedure prepare_colouring; + {# Clean up after register colouring.} + procedure epilogue_colouring; + {# Colour the registers; that is do the register allocation.} + procedure colour_registers; + procedure insert_regalloc_info(list:TAsmList;u:tsuperregister); + procedure insert_regalloc_info_all(list:TAsmList); + procedure generate_interference_graph(list:TAsmList;headertai:tai); + { translates the registers in the given assembler list } + procedure translate_registers(list:TAsmList); + function spill_registers(list:TAsmList;headertai:tai):boolean;virtual; + function getnewreg(subreg:tsubregister):tsuperregister; + procedure add_edges_used(u:Tsuperregister); + procedure add_to_movelist(u:Tsuperregister;data:Tlinkedlistitem); + function move_related(n:Tsuperregister):boolean; + procedure make_work_list; + procedure sort_simplify_worklist; + procedure enable_moves(n:Tsuperregister); + procedure decrement_degree(m:Tsuperregister); + procedure simplify; + procedure add_worklist(u:Tsuperregister); + function adjacent_ok(u,v:Tsuperregister):boolean; + function conservative(u,v:Tsuperregister):boolean; + procedure combine(u,v:Tsuperregister); + procedure coalesce; + procedure freeze_moves(u:Tsuperregister); + procedure freeze; + procedure select_spill; + procedure assign_colours; + procedure clear_interferences(u:Tsuperregister); + procedure set_live_range_direction(dir: TRADirection); + public + property live_range_direction: TRADirection read int_live_range_direction write set_live_range_direction; + end; + + const + first_reg = 0; + last_reg = high(tsuperregister)-1; + maxspillingcounter = 20; + + + implementation + + uses + systems,fmodule,globals, + verbose,tgobj,procinfo; + + + procedure sort_movelist(ml:Pmovelist); + + {Ok, sorting pointers is silly, but it does the job to make Trgobj.combine + faster.} + + var h,i,p:longword; + t:Tlinkedlistitem; + + begin + with ml^ do + begin + if header.count<2 then + exit; + p:=1; + while 2*cardinal(p)<header.count do + p:=2*p; + while p<>0 do + begin + for h:=p to header.count-1 do + begin + i:=h; + t:=data[i]; + repeat + if ptruint(data[i-p])<=ptruint(t) then + break; + data[i]:=data[i-p]; + dec(i,p); + until i<p; + data[i]:=t; + end; + p:=p shr 1; + end; + header.sorted_until:=header.count-1; + end; + end; + +{****************************************************************************** + tinterferencebitmap +******************************************************************************} + + constructor tinterferencebitmap.create; + begin + inherited create; + maxx1:=1; + getmem(fbitmap,sizeof(tinterferencebitmap1)*2); + fillchar(fbitmap^,sizeof(tinterferencebitmap1)*2,0); + end; + + + destructor tinterferencebitmap.destroy; + + var i,j:byte; + + begin + for i:=0 to maxx1 do + for j:=0 to maxy1 do + if assigned(fbitmap[i,j]) then + dispose(fbitmap[i,j]); + freemem(fbitmap); + end; + + + function tinterferencebitmap.getbitmap(x,y:tsuperregister):boolean; + var + page : pinterferencebitmap2; + begin + result:=false; + if (x shr 8>maxx1) then + exit; + page:=fbitmap[x shr 8,y shr 8]; + result:=assigned(page) and + ((x and $ff) in page^[y and $ff]); + end; + + + procedure tinterferencebitmap.setbitmap(x,y:tsuperregister;b:boolean); + var + x1,y1 : byte; + begin + x1:=x shr 8; + y1:=y shr 8; + if x1>maxx1 then + begin + reallocmem(fbitmap,sizeof(tinterferencebitmap1)*(x1+1)); + fillchar(fbitmap[maxx1+1],sizeof(tinterferencebitmap1)*(x1-maxx1),0); + maxx1:=x1; + end; + if not assigned(fbitmap[x1,y1]) then + begin + if y1>maxy1 then + maxy1:=y1; + new(fbitmap[x1,y1]); + fillchar(fbitmap[x1,y1]^,sizeof(tinterferencebitmap2),0); + end; + if b then + include(fbitmap[x1,y1]^[y and $ff],(x and $ff)) + else + exclude(fbitmap[x1,y1]^[y and $ff],(x and $ff)); + end; + + +{****************************************************************************** + trgobj +******************************************************************************} + + constructor trgobj.create(Aregtype:Tregistertype; + Adefaultsub:Tsubregister; + const Ausable:array of tsuperregister; + Afirst_imaginary:Tsuperregister; + Apreserved_by_proc:Tcpuregisterset); + var + i : cardinal; + begin + { empty super register sets can cause very strange problems } + if high(Ausable)=-1 then + internalerror(200210181); + live_range_direction:=rad_forward; + first_imaginary:=Afirst_imaginary; + maxreg:=Afirst_imaginary; + regtype:=Aregtype; + defaultsub:=Adefaultsub; + preserved_by_proc:=Apreserved_by_proc; + // default value set by newinstance + // used_in_proc:=[]; + live_registers.init; + { Get reginfo for CPU registers } + maxreginfo:=first_imaginary; + maxreginfoinc:=16; + worklist_moves:=Tlinkedlist.create; + reginfo:=allocmem(first_imaginary*sizeof(treginfo)); + for i:=0 to first_imaginary-1 do + begin + reginfo[i].degree:=high(tsuperregister); + reginfo[i].alias:=RS_INVALID; + end; + { Usable registers } + // default value set by constructor + // fillchar(usable_registers,sizeof(usable_registers),0); + for i:=low(Ausable) to high(Ausable) do + usable_registers[i]:=Ausable[i]; + usable_registers_cnt:=high(Ausable)+1; + { Initialize Worklists } + spillednodes.init; + simplifyworklist.init; + freezeworklist.init; + spillworklist.init; + coalescednodes.init; + selectstack.init; + end; + + destructor trgobj.destroy; + + begin + spillednodes.done; + simplifyworklist.done; + freezeworklist.done; + spillworklist.done; + coalescednodes.done; + selectstack.done; + live_registers.done; + worklist_moves.free; + dispose_reginfo; + extended_backwards.free; + backwards_was_first.free; + end; + + procedure Trgobj.dispose_reginfo; + + var i:cardinal; + + begin + if reginfo<>nil then + begin + for i:=0 to maxreg-1 do + with reginfo[i] do + begin + if adjlist<>nil then + dispose(adjlist,done); + if movelist<>nil then + dispose(movelist); + end; + freemem(reginfo); + reginfo:=nil; + end; + end; + + function trgobj.getnewreg(subreg:tsubregister):tsuperregister; + var + oldmaxreginfo : tsuperregister; + begin + result:=maxreg; + inc(maxreg); + if maxreg>=last_reg then + Message(parser_f_too_complex_proc); + if maxreg>=maxreginfo then + begin + oldmaxreginfo:=maxreginfo; + { Prevent overflow } + if maxreginfoinc>last_reg-maxreginfo then + maxreginfo:=last_reg + else + begin + inc(maxreginfo,maxreginfoinc); + if maxreginfoinc<256 then + maxreginfoinc:=maxreginfoinc*2; + end; + reallocmem(reginfo,maxreginfo*sizeof(treginfo)); + { Do we really need it to clear it ? At least for 1.0.x (PFV) } + fillchar(reginfo[oldmaxreginfo],(maxreginfo-oldmaxreginfo)*sizeof(treginfo),0); + end; + reginfo[result].subreg:=subreg; + end; + + + function trgobj.getregister(list:TAsmList;subreg:Tsubregister):Tregister; + begin + {$ifdef EXTDEBUG} + if reginfo=nil then + InternalError(2004020901); + {$endif EXTDEBUG} + if defaultsub=R_SUBNONE then + result:=newreg(regtype,getnewreg(R_SUBNONE),R_SUBNONE) + else + result:=newreg(regtype,getnewreg(subreg),subreg); + end; + + + function trgobj.uses_registers:boolean; + begin + result:=(maxreg>first_imaginary); + end; + + + procedure trgobj.ungetcpuregister(list:TAsmList;r:Tregister); + begin + if (getsupreg(r)>=first_imaginary) then + InternalError(2004020901); + list.concat(Tai_regalloc.dealloc(r,nil)); + end; + + + procedure trgobj.getcpuregister(list:TAsmList;r:Tregister); + var + supreg:Tsuperregister; + begin + supreg:=getsupreg(r); + if supreg>=first_imaginary then + internalerror(2003121503); + include(used_in_proc,supreg); + list.concat(Tai_regalloc.alloc(r,nil)); + end; + + + procedure trgobj.alloccpuregisters(list:TAsmList;const r:Tcpuregisterset); + + var i:cardinal; + + begin + for i:=0 to first_imaginary-1 do + if i in r then + getcpuregister(list,newreg(regtype,i,defaultsub)); + end; + + + procedure trgobj.dealloccpuregisters(list:TAsmList;const r:Tcpuregisterset); + + var i:cardinal; + + begin + for i:=0 to first_imaginary-1 do + if i in r then + ungetcpuregister(list,newreg(regtype,i,defaultsub)); + end; + + + procedure trgobj.do_register_allocation(list:TAsmList;headertai:tai); + var + spillingcounter:byte; + endspill:boolean; + begin + { Insert regalloc info for imaginary registers } + insert_regalloc_info_all(list); + ibitmap:=tinterferencebitmap.create; + generate_interference_graph(list,headertai); + { Don't do the real allocation when -sr is passed } + if (cs_no_regalloc in current_settings.globalswitches) then + exit; + {Do register allocation.} + spillingcounter:=0; + repeat + prepare_colouring; + colour_registers; + epilogue_colouring; + endspill:=true; + if spillednodes.length<>0 then + begin + inc(spillingcounter); + if spillingcounter>maxspillingcounter then + begin +{$ifdef EXTDEBUG} + { Only exit here so the .s file is still generated. Assembling + the file will still trigger an error } + exit; +{$else} + internalerror(200309041); +{$endif} + end; + endspill:=not spill_registers(list,headertai); + end; + until endspill; + ibitmap.free; + translate_registers(list); + { we need the translation table for debugging info and verbose assembler output (FK) + dispose_reginfo; + } + end; + + + procedure trgobj.add_constraints(reg:Tregister); + + begin + end; + + + procedure trgobj.add_edge(u,v:Tsuperregister); + + {This procedure will add an edge to the virtual interference graph.} + + procedure addadj(u,v:Tsuperregister); + + begin + with reginfo[u] do + begin + if adjlist=nil then + new(adjlist,init); + adjlist^.add(v); + end; + end; + + begin + if (u<>v) and not(ibitmap[v,u]) then + begin + ibitmap[v,u]:=true; + ibitmap[u,v]:=true; + {Precoloured nodes are not stored in the interference graph.} + if (u>=first_imaginary) then + addadj(u,v); + if (v>=first_imaginary) then + addadj(v,u); + end; + end; + + + procedure trgobj.add_edges_used(u:Tsuperregister); + + var i:cardinal; + + begin + with live_registers do + if length>0 then + for i:=0 to length-1 do + add_edge(u,get_alias(buf^[i])); + end; + +{$ifdef EXTDEBUG} + procedure trgobj.writegraph(loopidx:longint); + + {This procedure writes out the current interference graph in the + register allocator.} + + + var f:text; + i,j:cardinal; + + begin + assign(f,'igraph'+tostr(loopidx)); + rewrite(f); + writeln(f,'Interference graph'); + writeln(f); + write(f,' '); + for i:=0 to 15 do + for j:=0 to 15 do + write(f,hexstr(i,1)); + writeln(f); + write(f,' '); + for i:=0 to 15 do + write(f,'0123456789ABCDEF'); + writeln(f); + for i:=0 to maxreg-1 do + begin + write(f,hexstr(i,2):4); + for j:=0 to maxreg-1 do + if ibitmap[i,j] then + write(f,'*') + else + write(f,'-'); + writeln(f); + end; + close(f); + end; +{$endif EXTDEBUG} + + procedure trgobj.add_to_movelist(u:Tsuperregister;data:Tlinkedlistitem); + begin + with reginfo[u] do + begin + if movelist=nil then + begin + { don't use sizeof(tmovelistheader), because that ignores alignment } + getmem(movelist,ptruint(@movelist^.data)-ptruint(movelist)+60*sizeof(pointer)); + movelist^.header.maxcount:=60; + movelist^.header.count:=0; + movelist^.header.sorted_until:=0; + end + else + begin + if movelist^.header.count>=movelist^.header.maxcount then + begin + movelist^.header.maxcount:=movelist^.header.maxcount*2; + { don't use sizeof(tmovelistheader), because that ignores alignment } + reallocmem(movelist,ptruint(@movelist^.data)-ptruint(movelist)+movelist^.header.maxcount*sizeof(pointer)); + end; + end; + movelist^.data[movelist^.header.count]:=data; + inc(movelist^.header.count); + end; + end; + + + procedure trgobj.set_live_range_direction(dir: TRADirection); + begin + if (dir in [rad_backwards,rad_backwards_reinit]) then + begin + if not assigned(extended_backwards) then + begin + { create expects a "size", not a "max bit" parameter -> +1 } + backwards_was_first:=tbitset.create(maxreg+1); + extended_backwards:=tbitset.create(maxreg+1); + end + else + begin + if (dir=rad_backwards_reinit) then + extended_backwards.clear; + backwards_was_first.clear; + end; + int_live_range_direction:=rad_backwards; + end + else + int_live_range_direction:=rad_forward; + end; + + + procedure trgobj.add_reg_instruction(instr:Tai;r:tregister;aweight:longint); + var + supreg : tsuperregister; + begin + supreg:=getsupreg(r); +{$ifdef extdebug} + if not (cs_no_regalloc in current_settings.globalswitches) and + (supreg>=maxreginfo) then + internalerror(200411061); +{$endif extdebug} + if supreg>=first_imaginary then + with reginfo[supreg] do + begin + if aweight>weight then + weight:=aweight; + if (live_range_direction=rad_forward) then + begin + if not assigned(live_start) then + live_start:=instr; + live_end:=instr; + end + else + begin + if not extended_backwards.isset(supreg) then + begin + extended_backwards.include(supreg); + live_start := instr; + if not assigned(live_end) then + begin + backwards_was_first.include(supreg); + live_end := instr; + end; + end + else + begin + if backwards_was_first.isset(supreg) then + live_end := instr; + end + end + end; + end; + + + procedure trgobj.add_move_instruction(instr:Taicpu); + + {This procedure notifies a certain as a move instruction so the + register allocator can try to eliminate it.} + + var i:Tmoveins; + ssupreg,dsupreg:Tsuperregister; + + begin + {$ifdef extdebug} + if (instr.oper[O_MOV_SOURCE]^.typ<>top_reg) or + (instr.oper[O_MOV_DEST]^.typ<>top_reg) then + internalerror(200311291); + {$endif} + i:=Tmoveins.create; + i.moveset:=ms_worklist_moves; + worklist_moves.insert(i); + ssupreg:=getsupreg(instr.oper[O_MOV_SOURCE]^.reg); + add_to_movelist(ssupreg,i); + dsupreg:=getsupreg(instr.oper[O_MOV_DEST]^.reg); + if ssupreg<>dsupreg then + {Avoid adding the same move instruction twice to a single register.} + add_to_movelist(dsupreg,i); + i.x:=ssupreg; + i.y:=dsupreg; + end; + + function trgobj.move_related(n:Tsuperregister):boolean; + + var i:cardinal; + + begin + move_related:=false; + with reginfo[n] do + if movelist<>nil then + with movelist^ do + for i:=0 to header.count-1 do + if Tmoveins(data[i]).moveset in [ms_worklist_moves,ms_active_moves] then + begin + move_related:=true; + break; + end; + end; + + procedure Trgobj.sort_simplify_worklist; + + {Sorts the simplifyworklist by the number of interferences the + registers in it cause. This allows simplify to execute in + constant time.} + + var p,h,i,leni,lent:longword; + t:Tsuperregister; + adji,adjt:Psuperregisterworklist; + + begin + with simplifyworklist do + begin + if length<2 then + exit; + p:=1; + while 2*p<length do + p:=2*p; + while p<>0 do + begin + for h:=p to length-1 do + begin + i:=h; + t:=buf^[i]; + adjt:=reginfo[buf^[i]].adjlist; + lent:=0; + if adjt<>nil then + lent:=adjt^.length; + repeat + adji:=reginfo[buf^[i-p]].adjlist; + leni:=0; + if adji<>nil then + leni:=adji^.length; + if leni<=lent then + break; + buf^[i]:=buf^[i-p]; + dec(i,p) + until i<p; + buf^[i]:=t; + end; + p:=p shr 1; + end; + end; + end; + + procedure trgobj.make_work_list; + + var n:cardinal; + + begin + {If we have 7 cpu registers, and the degree of a node is 7, we cannot + assign it to any of the registers, thus it is significant.} + for n:=first_imaginary to maxreg-1 do + with reginfo[n] do + begin + if adjlist=nil then + degree:=0 + else + degree:=adjlist^.length; + if degree>=usable_registers_cnt then + spillworklist.add(n) + else if move_related(n) then + freezeworklist.add(n) + else + simplifyworklist.add(n); + end; + sort_simplify_worklist; + end; + + + procedure trgobj.prepare_colouring; + begin + make_work_list; + active_moves:=Tlinkedlist.create; + frozen_moves:=Tlinkedlist.create; + coalesced_moves:=Tlinkedlist.create; + constrained_moves:=Tlinkedlist.create; + selectstack.clear; + end; + + procedure trgobj.enable_moves(n:Tsuperregister); + + var m:Tlinkedlistitem; + i:cardinal; + + begin + with reginfo[n] do + if movelist<>nil then + for i:=0 to movelist^.header.count-1 do + begin + m:=movelist^.data[i]; + if Tmoveins(m).moveset in [ms_worklist_moves,ms_active_moves] then + if Tmoveins(m).moveset=ms_active_moves then + begin + {Move m from the set active_moves to the set worklist_moves.} + active_moves.remove(m); + Tmoveins(m).moveset:=ms_worklist_moves; + worklist_moves.concat(m); + end; + end; + end; + + procedure Trgobj.decrement_degree(m:Tsuperregister); + + var adj : Psuperregisterworklist; + n : tsuperregister; + d,i : cardinal; + + begin + with reginfo[m] do + begin + d:=degree; + if d=0 then + internalerror(200312151); + dec(degree); + if d=usable_registers_cnt then + begin + {Enable moves for m.} + enable_moves(m); + {Enable moves for adjacent.} + adj:=adjlist; + if adj<>nil then + for i:=1 to adj^.length do + begin + n:=adj^.buf^[i-1]; + if reginfo[n].flags*[ri_selected,ri_coalesced]<>[] then + enable_moves(n); + end; + {Remove the node from the spillworklist.} + if not spillworklist.delete(m) then + internalerror(200310145); + + if move_related(m) then + freezeworklist.add(m) + else + simplifyworklist.add(m); + end; + end; + end; + + procedure trgobj.simplify; + + var adj : Psuperregisterworklist; + m,n : Tsuperregister; + i : cardinal; + begin + {We take the element with the least interferences out of the + simplifyworklist. Since the simplifyworklist is now sorted, we + no longer need to search, but we can simply take the first element.} + m:=simplifyworklist.get; + + {Push it on the selectstack.} + selectstack.add(m); + with reginfo[m] do + begin + include(flags,ri_selected); + adj:=adjlist; + end; + if adj<>nil then + for i:=1 to adj^.length do + begin + n:=adj^.buf^[i-1]; + if (n>=first_imaginary) and + (reginfo[n].flags*[ri_selected,ri_coalesced]=[]) then + decrement_degree(n); + end; + end; + + function trgobj.get_alias(n:Tsuperregister):Tsuperregister; + + begin + while ri_coalesced in reginfo[n].flags do + n:=reginfo[n].alias; + get_alias:=n; + end; + + procedure trgobj.add_worklist(u:Tsuperregister); + begin + if (u>=first_imaginary) and + (not move_related(u)) and + (reginfo[u].degree<usable_registers_cnt) then + begin + if not freezeworklist.delete(u) then + internalerror(200308161); {must be found} + simplifyworklist.add(u); + end; + end; + + + function trgobj.adjacent_ok(u,v:Tsuperregister):boolean; + + {Check wether u and v should be coalesced. u is precoloured.} + + function ok(t,r:Tsuperregister):boolean; + + begin + ok:=(t<first_imaginary) or + (reginfo[t].degree<usable_registers_cnt) or + ibitmap[r,t]; + end; + + var adj : Psuperregisterworklist; + i : cardinal; + n : tsuperregister; + + begin + with reginfo[v] do + begin + adjacent_ok:=true; + adj:=adjlist; + if adj<>nil then + for i:=1 to adj^.length do + begin + n:=adj^.buf^[i-1]; + if (flags*[ri_coalesced,ri_selected]=[]) and not ok(n,u) then + begin + adjacent_ok:=false; + break; + end; + end; + end; + end; + + function trgobj.conservative(u,v:Tsuperregister):boolean; + + var adj : Psuperregisterworklist; + done : Tsuperregisterset; {To prevent that we count nodes twice.} + i,k:cardinal; + n : tsuperregister; + + begin + k:=0; + supregset_reset(done,false,maxreg); + with reginfo[u] do + begin + adj:=adjlist; + if adj<>nil then + for i:=1 to adj^.length do + begin + n:=adj^.buf^[i-1]; + if flags*[ri_coalesced,ri_selected]=[] then + begin + supregset_include(done,n); + if reginfo[n].degree>=usable_registers_cnt then + inc(k); + end; + end; + end; + adj:=reginfo[v].adjlist; + if adj<>nil then + for i:=1 to adj^.length do + begin + n:=adj^.buf^[i-1]; + if not supregset_in(done,n) and + (reginfo[n].degree>=usable_registers_cnt) and + (reginfo[u].flags*[ri_coalesced,ri_selected]=[]) then + inc(k); + end; + conservative:=(k<usable_registers_cnt); + end; + + + procedure trgobj.combine(u,v:Tsuperregister); + + var adj : Psuperregisterworklist; + i,n,p,q:cardinal; + t : tsuperregister; + searched:Tlinkedlistitem; + found : boolean; + + begin + if not freezeworklist.delete(v) then + spillworklist.delete(v); + coalescednodes.add(v); + include(reginfo[v].flags,ri_coalesced); + reginfo[v].alias:=u; + + {Combine both movelists. Since the movelists are sets, only add + elements that are not already present. The movelists cannot be + empty by definition; nodes are only coalesced if there is a move + between them. To prevent quadratic time blowup (movelists of + especially machine registers can get very large because of moves + generated during calls) we need to go into disgusting complexity. + + (See webtbs/tw2242 for an example that stresses this.) + + We want to sort the movelist to be able to search logarithmically. + Unfortunately, sorting the movelist every time before searching + is counter-productive, since the movelist usually grows with a few + items at a time. Therefore, we split the movelist into a sorted + and an unsorted part and search through both. If the unsorted part + becomes too large, we sort.} + if assigned(reginfo[u].movelist) then + begin + {We have to weigh the cost of sorting the list against searching + the cost of the unsorted part. I use factor of 8 here; if the + number of items is less than 8 times the numer of unsorted items, + we'll sort the list.} + with reginfo[u].movelist^ do + if header.count<8*(header.count-header.sorted_until) then + sort_movelist(reginfo[u].movelist); + if assigned(reginfo[v].movelist) then + begin + for n:=0 to reginfo[v].movelist^.header.count-1 do + begin + {Binary search the sorted part of the list.} + searched:=reginfo[v].movelist^.data[n]; + p:=0; + q:=reginfo[u].movelist^.header.sorted_until; + i:=0; + if q<>0 then + repeat + i:=(p+q) shr 1; + if ptruint(searched)>ptruint(reginfo[u].movelist^.data[i]) then + p:=i+1 + else + q:=i; + until p=q; + with reginfo[u].movelist^ do + if searched<>data[i] then + begin + {Linear search the unsorted part of the list.} + found:=false; + for i:=header.sorted_until+1 to header.count-1 do + if searched=data[i] then + begin + found:=true; + break; + end; + if not found then + add_to_movelist(u,searched); + end; + end; + end; + end; + + enable_moves(v); + + adj:=reginfo[v].adjlist; + if adj<>nil then + for i:=1 to adj^.length do + begin + t:=adj^.buf^[i-1]; + with reginfo[t] do + if not(ri_coalesced in flags) then + begin + {t has a connection to v. Since we are adding v to u, we + need to connect t to u. However, beware if t was already + connected to u...} + if (ibitmap[t,u]) and not (ri_selected in flags) then + {... because in that case, we are actually removing an edge + and the degree of t decreases.} + decrement_degree(t) + else + begin + add_edge(t,u); + {We have added an edge to t and u. So their degree increases. + However, v is added to u. That means its neighbours will + no longer point to v, but to u instead. Therefore, only the + degree of u increases.} + if (u>=first_imaginary) and not (ri_selected in flags) then + inc(reginfo[u].degree); + end; + end; + end; + if (reginfo[u].degree>=usable_registers_cnt) and freezeworklist.delete(u) then + spillworklist.add(u); + end; + + + procedure trgobj.coalesce; + + var m:Tmoveins; + x,y,u,v:cardinal; + + begin + m:=Tmoveins(worklist_moves.getfirst); + x:=get_alias(m.x); + y:=get_alias(m.y); + if (y<first_imaginary) then + begin + u:=y; + v:=x; + end + else + begin + u:=x; + v:=y; + end; + if (u=v) then + begin + m.moveset:=ms_coalesced_moves; {Already coalesced.} + coalesced_moves.insert(m); + add_worklist(u); + end + {Do u and v interfere? In that case the move is constrained. Two + precoloured nodes interfere allways. If v is precoloured, by the above + code u is precoloured, thus interference...} + else if (v<first_imaginary) or ibitmap[u,v] then + begin + m.moveset:=ms_constrained_moves; {Cannot coalesce yet...} + constrained_moves.insert(m); + add_worklist(u); + add_worklist(v); + end + {Next test: is it possible and a good idea to coalesce??} + else if ((u<first_imaginary) and adjacent_ok(u,v)) or + ((u>=first_imaginary) and conservative(u,v)) then + begin + m.moveset:=ms_coalesced_moves; {Move coalesced!} + coalesced_moves.insert(m); + combine(u,v); + add_worklist(u); + end + else + begin + m.moveset:=ms_active_moves; + active_moves.insert(m); + end; + end; + + procedure trgobj.freeze_moves(u:Tsuperregister); + + var i:cardinal; + m:Tlinkedlistitem; + v,x,y:Tsuperregister; + + begin + if reginfo[u].movelist<>nil then + for i:=0 to reginfo[u].movelist^.header.count-1 do + begin + m:=reginfo[u].movelist^.data[i]; + if Tmoveins(m).moveset in [ms_worklist_moves,ms_active_moves] then + begin + x:=Tmoveins(m).x; + y:=Tmoveins(m).y; + if get_alias(y)=get_alias(u) then + v:=get_alias(x) + else + v:=get_alias(y); + {Move m from active_moves/worklist_moves to frozen_moves.} + if Tmoveins(m).moveset=ms_active_moves then + active_moves.remove(m) + else + worklist_moves.remove(m); + Tmoveins(m).moveset:=ms_frozen_moves; + frozen_moves.insert(m); + + if (v>=first_imaginary) and not(move_related(v)) and + (reginfo[v].degree<usable_registers_cnt) then + begin + freezeworklist.delete(v); + simplifyworklist.add(v); + end; + end; + end; + end; + + procedure trgobj.freeze; + + var n:Tsuperregister; + + begin + { We need to take a random element out of the freezeworklist. We take + the last element. Dirty code! } + n:=freezeworklist.get; + {Add it to the simplifyworklist.} + simplifyworklist.add(n); + freeze_moves(n); + end; + + procedure trgobj.select_spill; + var + n : tsuperregister; + adj : psuperregisterworklist; + max,p,i:word; + minweight: longint; + begin + { We must look for the element with the most interferences in the + spillworklist. This is required because those registers are creating + the most conflicts and keeping them in a register will not reduce the + complexity and even can cause the help registers for the spilling code + to get too much conflicts with the result that the spilling code + will never converge (PFV) } + max:=0; + minweight:=high(longint); + p:=0; + with spillworklist do + begin + {Safe: This procedure is only called if length<>0} + for i:=0 to length-1 do + begin + adj:=reginfo[buf^[i]].adjlist; + if assigned(adj) and + ( + (adj^.length>max) or + ((adj^.length=max) and (reginfo[buf^[i]].weight<minweight)) + ) then + begin + p:=i; + max:=adj^.length; + minweight:=reginfo[buf^[i]].weight; + end; + end; + n:=buf^[p]; + deleteidx(p); + end; + + simplifyworklist.add(n); + freeze_moves(n); + end; + + procedure trgobj.assign_colours; + + {Assign_colours assigns the actual colours to the registers.} + + var adj : Psuperregisterworklist; + i,j,k : cardinal; + n,a,c : Tsuperregister; + colourednodes : Tsuperregisterset; + adj_colours:set of 0..255; + found : boolean; + + begin + spillednodes.clear; + {Reset colours} + for n:=0 to maxreg-1 do + reginfo[n].colour:=n; + {Colour the cpu registers...} + supregset_reset(colourednodes,false,maxreg); + for n:=0 to first_imaginary-1 do + supregset_include(colourednodes,n); + {Now colour the imaginary registers on the select-stack.} + for i:=selectstack.length downto 1 do + begin + n:=selectstack.buf^[i-1]; + {Create a list of colours that we cannot assign to n.} + adj_colours:=[]; + adj:=reginfo[n].adjlist; + if adj<>nil then + for j:=0 to adj^.length-1 do + begin + a:=get_alias(adj^.buf^[j]); + if supregset_in(colourednodes,a) and (reginfo[a].colour<=255) then + include(adj_colours,reginfo[a].colour); + end; + if regtype=R_INTREGISTER then + include(adj_colours,RS_STACK_POINTER_REG); + {Assume a spill by default...} + found:=false; + {Search for a colour not in this list.} + for k:=0 to usable_registers_cnt-1 do + begin + c:=usable_registers[k]; + if not(c in adj_colours) then + begin + reginfo[n].colour:=c; + found:=true; + supregset_include(colourednodes,n); + include(used_in_proc,c); + break; + end; + end; + if not found then + spillednodes.add(n); + end; + {Finally colour the nodes that were coalesced.} + for i:=1 to coalescednodes.length do + begin + n:=coalescednodes.buf^[i-1]; + k:=get_alias(n); + reginfo[n].colour:=reginfo[k].colour; + if reginfo[k].colour<maxcpuregister then + include(used_in_proc,reginfo[k].colour); + end; + end; + + procedure trgobj.colour_registers; + + begin + repeat + if simplifyworklist.length<>0 then + simplify + else if not(worklist_moves.empty) then + coalesce + else if freezeworklist.length<>0 then + freeze + else if spillworklist.length<>0 then + select_spill; + until (simplifyworklist.length=0) and + worklist_moves.empty and + (freezeworklist.length=0) and + (spillworklist.length=0); + assign_colours; + end; + + procedure trgobj.epilogue_colouring; + var + i : cardinal; + begin + worklist_moves.clear; + active_moves.destroy; + active_moves:=nil; + frozen_moves.destroy; + frozen_moves:=nil; + coalesced_moves.destroy; + coalesced_moves:=nil; + constrained_moves.destroy; + constrained_moves:=nil; + for i:=0 to maxreg-1 do + with reginfo[i] do + if movelist<>nil then + begin + dispose(movelist); + movelist:=nil; + end; + end; + + + procedure trgobj.clear_interferences(u:Tsuperregister); + + {Remove node u from the interference graph and remove all collected + move instructions it is associated with.} + + var i : word; + v : Tsuperregister; + adj,adj2 : Psuperregisterworklist; + + begin + adj:=reginfo[u].adjlist; + if adj<>nil then + begin + for i:=1 to adj^.length do + begin + v:=adj^.buf^[i-1]; + {Remove (u,v) and (v,u) from bitmap.} + ibitmap[u,v]:=false; + ibitmap[v,u]:=false; + {Remove (v,u) from adjacency list.} + adj2:=reginfo[v].adjlist; + if adj2<>nil then + begin + adj2^.delete(u); + if adj2^.length=0 then + begin + dispose(adj2,done); + reginfo[v].adjlist:=nil; + end; + end; + end; + {Remove ( u,* ) from adjacency list.} + dispose(adj,done); + reginfo[u].adjlist:=nil; + end; + end; + + + function trgobj.getregisterinline(list:TAsmList;const subregconstraints:Tsubregisterset):Tregister; + var + p : Tsuperregister; + subreg: tsubregister; + begin + for subreg:=high(tsubregister) downto low(tsubregister) do + if subreg in subregconstraints then + break; + p:=getnewreg(subreg); + live_registers.add(p); + result:=newreg(regtype,p,subreg); + add_edges_used(p); + add_constraints(result); + { also add constraints for other sizes used for this register } + if subreg<>low(tsubregister) then + for subreg:=pred(subreg) downto low(tsubregister) do + if subreg in subregconstraints then + add_constraints(newreg(regtype,getsupreg(result),subreg)); + end; + + + procedure trgobj.ungetregisterinline(list:TAsmList;r:Tregister); + var + supreg:Tsuperregister; + begin + supreg:=getsupreg(r); + live_registers.delete(supreg); + insert_regalloc_info(list,supreg); + end; + + + procedure trgobj.insert_regalloc_info(list:TAsmList;u:tsuperregister); + var + p : tai; + r : tregister; + palloc, + pdealloc : tai_regalloc; + begin + { Insert regallocs for all imaginary registers } + with reginfo[u] do + begin + r:=newreg(regtype,u,subreg); + if assigned(live_start) then + begin + { Generate regalloc and bind it to an instruction, this + is needed to find all live registers belonging to an + instruction during the spilling } + if live_start.typ=ait_instruction then + palloc:=tai_regalloc.alloc(r,live_start) + else + palloc:=tai_regalloc.alloc(r,nil); + if live_end.typ=ait_instruction then + pdealloc:=tai_regalloc.dealloc(r,live_end) + else + pdealloc:=tai_regalloc.dealloc(r,nil); + { Insert live start allocation before the instruction/reg_a_sync } + list.insertbefore(palloc,live_start); + { Insert live end deallocation before reg allocations + to reduce conflicts } + p:=live_end; + while assigned(p) and + assigned(p.previous) and + (tai(p.previous).typ=ait_regalloc) and + (tai_regalloc(p.previous).ratype=ra_alloc) and + (tai_regalloc(p.previous).reg<>r) do + p:=tai(p.previous); + { , but add release after a reg_a_sync } + if assigned(p) and + (p.typ=ait_regalloc) and + (tai_regalloc(p).ratype=ra_sync) then + p:=tai(p.next); + if assigned(p) then + list.insertbefore(pdealloc,p) + else + list.concat(pdealloc); + end; + end; + end; + + + procedure trgobj.insert_regalloc_info_all(list:TAsmList); + var + supreg : tsuperregister; + begin + { Insert regallocs for all imaginary registers } + for supreg:=first_imaginary to maxreg-1 do + insert_regalloc_info(list,supreg); + end; + + + procedure trgobj.add_cpu_interferences(p : tai); + begin + end; + + + procedure trgobj.generate_interference_graph(list:TAsmList;headertai:tai); + var + p : tai; +{$ifdef EXTDEBUG} + i : integer; +{$endif EXTDEBUG} + supreg : tsuperregister; + begin + { All allocations are available. Now we can generate the + interference graph. Walk through all instructions, we can + start with the headertai, because before the header tai is + only symbols. } + live_registers.clear; + p:=headertai; + while assigned(p) do + begin + if p.typ=ait_regalloc then + with Tai_regalloc(p) do + begin + if (getregtype(reg)=regtype) then + begin + supreg:=getsupreg(reg); + case ratype of + ra_alloc : + begin + live_registers.add(supreg); + add_edges_used(supreg); + end; + ra_dealloc : + begin + live_registers.delete(supreg); + add_edges_used(supreg); + end; + end; + { constraints needs always to be updated } + add_constraints(reg); + end; + end; + add_cpu_interferences(p); + p:=Tai(p.next); + end; + +{$ifdef EXTDEBUG} + if live_registers.length>0 then + begin + for i:=0 to live_registers.length-1 do + begin + { Only report for imaginary registers } + if live_registers.buf^[i]>=first_imaginary then + Comment(V_Warning,'Register '+std_regname(newreg(R_INTREGISTER,live_registers.buf^[i],defaultsub))+' not released'); + end; + end; +{$endif} + end; + + + procedure trgobj.translate_register(var reg : tregister); + begin + if (getregtype(reg)=regtype) then + setsupreg(reg,reginfo[getsupreg(reg)].colour) + else + internalerror(200602021); + end; + + + procedure Trgobj.translate_registers(list:TAsmList); + var + hp,p,q:Tai; + i:shortint; +{$ifdef arm} + so:pshifterop; +{$endif arm} + + + begin + { Leave when no imaginary registers are used } + if maxreg<=first_imaginary then + exit; + p:=Tai(list.first); + while assigned(p) do + begin + case p.typ of + ait_regalloc: + with Tai_regalloc(p) do + begin + if (getregtype(reg)=regtype) then + begin + { Only alloc/dealloc is needed for the optimizer, remove + other regalloc } + if not(ratype in [ra_alloc,ra_dealloc]) then + begin + q:=Tai(next); + list.remove(p); + p.free; + p:=q; + continue; + end + else + begin + setsupreg(reg,reginfo[getsupreg(reg)].colour); + { + Remove sequences of release and + allocation of the same register like. Other combinations + of release/allocate need to stay in the list. + + # Register X released + # Register X allocated + } + if assigned(previous) and + (ratype=ra_alloc) and + (Tai(previous).typ=ait_regalloc) and + (Tai_regalloc(previous).reg=reg) and + (Tai_regalloc(previous).ratype=ra_dealloc) then + begin + q:=Tai(next); + hp:=tai(previous); + list.remove(hp); + hp.free; + list.remove(p); + p.free; + p:=q; + continue; + end; + end; + end; + end; + ait_varloc: + begin + if (getregtype(tai_varloc(p).newlocation)=regtype) then + begin + if (cs_asm_source in current_settings.globalswitches) then + begin + setsupreg(tai_varloc(p).newlocation,reginfo[getsupreg(tai_varloc(p).newlocation)].colour); + if tai_varloc(p).newlocationhi<>NR_NO then + begin + setsupreg(tai_varloc(p).newlocationhi,reginfo[getsupreg(tai_varloc(p).newlocationhi)].colour); + hp:=Tai_comment.Create(strpnew('Var '+tai_varloc(p).varsym.realname+' located in register '+ + std_regname(tai_varloc(p).newlocationhi)+':'+std_regname(tai_varloc(p).newlocation))); + end + else + hp:=Tai_comment.Create(strpnew('Var '+tai_varloc(p).varsym.realname+' located in register '+ + std_regname(tai_varloc(p).newlocation))); + list.insertafter(hp,p); + end; + q:=tai(p.next); + list.remove(p); + p.free; + p:=q; + continue; + end; + end; + + ait_instruction: + with Taicpu(p) do + begin + current_filepos:=fileinfo; + for i:=0 to ops-1 do + with oper[i]^ do + case typ of + Top_reg: + if (getregtype(reg)=regtype) then + setsupreg(reg,reginfo[getsupreg(reg)].colour); + Top_ref: + begin + if regtype in [R_INTREGISTER,R_ADDRESSREGISTER] then + with ref^ do + begin + if (base<>NR_NO) and + (getregtype(base)=regtype) then + setsupreg(base,reginfo[getsupreg(base)].colour); + if (index<>NR_NO) and + (getregtype(index)=regtype) then + setsupreg(index,reginfo[getsupreg(index)].colour); + end; + end; +{$ifdef arm} + Top_shifterop: + begin + if regtype=R_INTREGISTER then + begin + so:=shifterop; + if (so^.rs<>NR_NO) and + (getregtype(so^.rs)=regtype) then + setsupreg(so^.rs,reginfo[getsupreg(so^.rs)].colour); + end; + end; +{$endif arm} + end; + + { Maybe the operation can be removed when + it is a move and both arguments are the same } + if is_same_reg_move(regtype) then + begin + q:=Tai(p.next); + list.remove(p); + p.free; + p:=q; + continue; + end; + end; + end; + p:=Tai(p.next); + end; + current_filepos:=current_procinfo.exitpos; + end; + + + function trgobj.spill_registers(list:TAsmList;headertai:tai):boolean; + { Returns true if any help registers have been used } + var + i : cardinal; + t : tsuperregister; + p,q : Tai; + regs_to_spill_set:Tsuperregisterset; + spill_temps : ^Tspill_temp_list; + supreg : tsuperregister; + templist : TAsmList; + size: ptrint; + begin + spill_registers:=false; + live_registers.clear; + for i:=first_imaginary to maxreg-1 do + exclude(reginfo[i].flags,ri_selected); + spill_temps:=allocmem(sizeof(treference)*maxreg); + supregset_reset(regs_to_spill_set,false,$ffff); + { Allocate temps and insert in front of the list } + templist:=TAsmList.create; + {Safe: this procedure is only called if there are spilled nodes.} + with spillednodes do + for i:=0 to length-1 do + begin + t:=buf^[i]; + {Alternative representation.} + supregset_include(regs_to_spill_set,t); + {Clear all interferences of the spilled register.} + clear_interferences(t); + {Get a temp for the spilled register, the size must at least equal a complete register, + take also care of the fact that subreg can be larger than a single register like doubles + that occupy 2 registers } + { only force the whole register in case of integers. Storing a register that contains + a single precision value as a double can cause conversion errors on e.g. ARM VFP } + if (regtype=R_INTREGISTER) then + size:=max(tcgsize2size[reg_cgsize(newreg(regtype,t,R_SUBWHOLE))], + tcgsize2size[reg_cgsize(newreg(regtype,t,reginfo[t].subreg))]) + else + size:=tcgsize2size[reg_cgsize(newreg(regtype,t,reginfo[t].subreg))]; + tg.gettemp(templist, + size,size, + tt_noreuse,spill_temps^[t]); + end; + list.insertlistafter(headertai,templist); + templist.free; + { Walk through all instructions, we can start with the headertai, + because before the header tai is only symbols } + p:=headertai; + while assigned(p) do + begin + case p.typ of + ait_regalloc: + with Tai_regalloc(p) do + begin + if (getregtype(reg)=regtype) then + begin + {A register allocation of a spilled register can be removed.} + supreg:=getsupreg(reg); + if supregset_in(regs_to_spill_set,supreg) then + begin + q:=Tai(p.next); + list.remove(p); + p.free; + p:=q; + continue; + end + else + begin + case ratype of + ra_alloc : + live_registers.add(supreg); + ra_dealloc : + live_registers.delete(supreg); + end; + end; + end; + end; + ait_instruction: + with Taicpu(p) do + begin + current_filepos:=fileinfo; + if instr_spill_register(list,taicpu(p),regs_to_spill_set,spill_temps^) then + spill_registers:=true; + end; + end; + p:=Tai(p.next); + end; + current_filepos:=current_procinfo.exitpos; + {Safe: this procedure is only called if there are spilled nodes.} + with spillednodes do + for i:=0 to length-1 do + tg.ungettemp(list,spill_temps^[buf^[i]]); + freemem(spill_temps); + end; + + + function trgobj.do_spill_replace(list:TAsmList;instr:taicpu;orgreg:tsuperregister;const spilltemp:treference):boolean; + begin + result:=false; + end; + + + procedure trgobj.do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister); + var + ins:Taicpu; + begin + ins:=spilling_create_load(spilltemp,tempreg); + add_cpu_interferences(ins); + list.insertafter(ins,pos); + end; + + + procedure Trgobj.do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister); + var + ins:Taicpu; + begin + ins:=spilling_create_store(tempreg,spilltemp); + add_cpu_interferences(ins); + list.insertafter(ins,pos); + end; + + + function trgobj.get_spill_subreg(r : tregister) : tsubregister; + begin + result:=defaultsub; + end; + + + function trgobj.instr_spill_register(list:TAsmList; + instr:taicpu; + const r:Tsuperregisterset; + const spilltemplist:Tspill_temp_list): boolean; + var + counter, regindex: longint; + regs: tspillregsinfo; + spilled: boolean; + + procedure addreginfo(reg: tregister; operation: topertype); + var + i, tmpindex: longint; + supreg : tsuperregister; + begin + tmpindex := regindex; + supreg:=get_alias(getsupreg(reg)); + { did we already encounter this register? } + for i := 0 to pred(regindex) do + if (regs[i].orgreg = supreg) then + begin + tmpindex := i; + break; + end; + if tmpindex > high(regs) then + internalerror(2003120301); + regs[tmpindex].orgreg := supreg; + include(regs[tmpindex].spillregconstraints,get_spill_subreg(reg)); + if supregset_in(r,supreg) then + begin + { add/update info on this register } + regs[tmpindex].mustbespilled := true; + case operation of + operand_read: + regs[tmpindex].regread := true; + operand_write: + regs[tmpindex].regwritten := true; + operand_readwrite: + begin + regs[tmpindex].regread := true; + regs[tmpindex].regwritten := true; + end; + end; + spilled := true; + end; + inc(regindex,ord(regindex=tmpindex)); + end; + + + procedure tryreplacereg(var reg: tregister); + var + i: longint; + supreg: tsuperregister; + begin + supreg:=get_alias(getsupreg(reg)); + for i:=0 to pred(regindex) do + if (regs[i].mustbespilled) and + (regs[i].orgreg=supreg) then + begin + { Only replace supreg } + setsupreg(reg,getsupreg(regs[i].tempreg)); + break; + end; + end; + + + var + loadpos, + storepos : tai; + oldlive_registers : tsuperregisterworklist; + begin + result := false; + fillchar(regs,sizeof(regs),0); + for counter := low(regs) to high(regs) do + regs[counter].orgreg := RS_INVALID; + spilled := false; + regindex := 0; + + { check whether and if so which and how (read/written) this instructions contains + registers that must be spilled } + for counter := 0 to instr.ops-1 do + with instr.oper[counter]^ do + begin + case typ of + top_reg: + begin + if (getregtype(reg) = regtype) then + addreginfo(reg,instr.spilling_get_operation_type(counter)); + end; + top_ref: + begin + if regtype in [R_INTREGISTER,R_ADDRESSREGISTER] then + with ref^ do + begin + if (base <> NR_NO) then + addreginfo(base,instr.spilling_get_operation_type_ref(counter,base)); + if (index <> NR_NO) then + addreginfo(index,instr.spilling_get_operation_type_ref(counter,index)); + end; + end; +{$ifdef ARM} + top_shifterop: + begin + if regtype in [R_INTREGISTER,R_ADDRESSREGISTER] then + if shifterop^.rs<>NR_NO then + addreginfo(shifterop^.rs,operand_read); + end; +{$endif ARM} + end; + end; + + { if no spilling for this instruction we can leave } + if not spilled then + exit; + +{$ifdef x86} + { Try replacing the register with the spilltemp. This is useful only + for the i386,x86_64 that support memory locations for several instructions } + for counter := 0 to pred(regindex) do + with regs[counter] do + begin + if mustbespilled then + begin + if do_spill_replace(list,instr,orgreg,spilltemplist[orgreg]) then + mustbespilled:=false; + end; + end; +{$endif x86} + + { + There are registers that need are spilled. We generate the + following code for it. The used positions where code need + to be inserted are marked using #. Note that code is always inserted + before the positions using pos.previous. This way the position is always + the same since pos doesn't change, but pos.previous is modified everytime + new code is inserted. + + [ + - reg_allocs load spills + - load spills + ] + [#loadpos + - reg_deallocs + - reg_allocs + ] + [ + - reg_deallocs for load-only spills + - reg_allocs for store-only spills + ] + [#instr + - original instruction + ] + [ + - store spills + - reg_deallocs store spills + ] + [#storepos + ] + } + + result := true; + oldlive_registers.copyfrom(live_registers); + + { Process all tai_regallocs belonging to this instruction, ignore explicit + inserted regallocs. These can happend for example in i386: + mov ref,ireg26 + <regdealloc ireg26, instr=taicpu of lea> + <regalloc edi, insrt=nil> + lea [ireg26+ireg17],edi + All released registers are also added to the live_registers because + they can't be used during the spilling } + loadpos:=tai(instr.previous); + while assigned(loadpos) and + (loadpos.typ=ait_regalloc) and + ((tai_regalloc(loadpos).instr=nil) or + (tai_regalloc(loadpos).instr=instr)) do + begin + { Only add deallocs belonging to the instruction. Explicit inserted deallocs + belong to the previous instruction and not the current instruction } + if (tai_regalloc(loadpos).instr=instr) and + (tai_regalloc(loadpos).ratype=ra_dealloc) then + live_registers.add(getsupreg(tai_regalloc(loadpos).reg)); + loadpos:=tai(loadpos.previous); + end; + loadpos:=tai(loadpos.next); + + { Load the spilled registers } + for counter := 0 to pred(regindex) do + with regs[counter] do + begin + if mustbespilled and regread then + begin + tempreg:=getregisterinline(list,regs[counter].spillregconstraints); + do_spill_read(list,tai(loadpos.previous),spilltemplist[orgreg],tempreg); + end; + end; + + { Release temp registers of read-only registers, and add reference of the instruction + to the reginfo } + for counter := 0 to pred(regindex) do + with regs[counter] do + begin + if mustbespilled and regread and (not regwritten) then + begin + { The original instruction will be the next that uses this register } + add_reg_instruction(instr,tempreg,1); + ungetregisterinline(list,tempreg); + end; + end; + + { Allocate temp registers of write-only registers, and add reference of the instruction + to the reginfo } + for counter := 0 to pred(regindex) do + with regs[counter] do + begin + if mustbespilled and regwritten then + begin + { When the register is also loaded there is already a register assigned } + if (not regread) then + tempreg:=getregisterinline(list,regs[counter].spillregconstraints); + { The original instruction will be the next that uses this register, this + also needs to be done for read-write registers } + add_reg_instruction(instr,tempreg,1); + end; + end; + + { store the spilled registers } + storepos:=tai(instr.next); + for counter := 0 to pred(regindex) do + with regs[counter] do + begin + if mustbespilled and regwritten then + begin + do_spill_written(list,tai(storepos.previous),spilltemplist[orgreg],tempreg); + ungetregisterinline(list,tempreg); + end; + end; + + { now all spilling code is generated we can restore the live registers. This + must be done after the store because the store can need an extra register + that also needs to conflict with the registers of the instruction } + live_registers.done; + live_registers:=oldlive_registers; + + { substitute registers } + for counter:=0 to instr.ops-1 do + with instr.oper[counter]^ do + case typ of + top_reg: + begin + if (getregtype(reg) = regtype) then + tryreplacereg(reg); + end; + top_ref: + begin + if regtype in [R_INTREGISTER,R_ADDRESSREGISTER] then + begin + tryreplacereg(ref^.base); + tryreplacereg(ref^.index); + end; + end; +{$ifdef ARM} + top_shifterop: + begin + if regtype in [R_INTREGISTER,R_ADDRESSREGISTER] then + tryreplacereg(shifterop^.rs); + end; +{$endif ARM} + end; + {We have modified the instruction; perhaps the new instruction has + certain constraints regarding which imaginary registers interfere + with certain physical registers.} + add_cpu_interferences(instr); + end; + +end. diff --git a/closures/compiler/scandir.pas b/closures/compiler/scandir.pas new file mode 100644 index 0000000000..980e786f14 --- /dev/null +++ b/closures/compiler/scandir.pas @@ -0,0 +1,1542 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements directive parsing for the scanner + + 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 scandir; + +{$i fpcdefs.inc} + + interface + + uses + globtype; + + const + switchesstatestackmax = 20; + + type + tsavedswitchesstate = record + localsw: tlocalswitches; + verbosity: longint; + pmessage : pmessagestaterecord; + end; + + type + tswitchesstatestack = array[0..switchesstatestackmax] of tsavedswitchesstate; + + var + switchesstatestack:tswitchesstatestack; + switchesstatestackpos: Integer; + + procedure InitScannerDirectives; + + implementation + + uses + SysUtils, + cutils,cfileutl, + globals,systems,widestr,cpuinfo, + verbose,comphook,ppu, + scanner,switches, + fmodule, + symconst,symtable, + rabase; + +{***************************************************************************** + Helpers +*****************************************************************************} + + procedure do_delphiswitch(sw:char); + var + state : char; + begin + { c contains the next char, a + or - would be fine } + state:=current_scanner.readstate; + if state in ['-','+'] then + HandleSwitch(sw,state); + end; + + + procedure do_setverbose(flag:char); + var + state : char; + begin + { support ON/OFF } + state:=current_scanner.ReadState; + recordpendingverbosityswitch(flag,state); + end; + + + procedure do_moduleswitch(sw:tmoduleswitch); + var + state : char; + begin + state:=current_scanner.readstate; + if (sw<>cs_modulenone) and (state in ['-','+']) then + begin + if state='-' then + exclude(current_settings.moduleswitches,sw) + else + include(current_settings.moduleswitches,sw); + end; + end; + + + procedure do_localswitch(sw:tlocalswitch); + var + state : char; + begin + state:=current_scanner.readstate; + if (sw<>cs_localnone) and (state in ['-','+']) then + recordpendinglocalswitch(sw,state); + end; + + procedure do_localswitchdefault(sw:tlocalswitch); + var + state : char; + begin + state:=current_scanner.readstatedefault; + if (sw<>cs_localnone) and (state in ['-','+','*']) then + recordpendinglocalswitch(sw,state); + end; + + + procedure do_message(w:integer); + begin + current_scanner.skipspace; + Message1(w,current_scanner.readcomment); + end; + +{***************************************************************************** + Directive Callbacks +*****************************************************************************} + + procedure dir_align; + var + hs : string; + begin + current_scanner.skipspace; + if not(c in ['0'..'9']) then + begin + { Support also the ON and OFF as switch } + hs:=current_scanner.readid; + if (hs='ON') then + current_settings.packrecords:=4 + else if (hs='OFF') then + current_settings.packrecords:=1 + else if m_mac in current_settings.modeswitches then + begin + { Support switches used in Apples Universal Interfaces} + if (hs='MAC68K') then + current_settings.packrecords:=mac68k_alignment + { "power" alignment is the default C packrecords setting on + Mac OS X } + else if (hs='POWER') or (hs='POWERPC') then + current_settings.packrecords:=C_alignment + else if (hs='RESET') then + current_settings.packrecords:=0 + else + Message1(scan_e_illegal_pack_records,hs); + end + else + Message1(scan_e_illegal_pack_records,hs); + end + else + begin + case current_scanner.readval of + 1 : current_settings.packrecords:=1; + 2 : current_settings.packrecords:=2; + 4 : current_settings.packrecords:=4; + 8 : current_settings.packrecords:=8; + 16 : current_settings.packrecords:=16; + 32 : current_settings.packrecords:=32; + else + Message1(scan_e_illegal_pack_records,hs); + end; + end; + end; + + procedure dir_a1; + begin + current_settings.packrecords:=1; + end; + + procedure dir_a2; + begin + current_settings.packrecords:=2; + end; + + procedure dir_a4; + begin + current_settings.packrecords:=4; + end; + + procedure dir_a8; + begin + current_settings.packrecords:=8; + end; + + procedure dir_asmmode; + var + s : string; + begin + current_scanner.skipspace; + s:=current_scanner.readid; + If Inside_asm_statement then + Message1(scan_w_no_asm_reader_switch_inside_asm,s); + if s='DEFAULT' then + current_settings.asmmode:=init_settings.asmmode + else + if not SetAsmReadMode(s,current_settings.asmmode) then + Message1(scan_e_illegal_asmmode_specifier,s); + end; + +{$if defined(m68k) or defined(arm)} + procedure dir_appid; + begin + if target_info.system<>system_m68k_palmos then + Message(scan_w_appid_not_support); + { change description global var in all cases } + { it not used but in win32 and os2 } + current_scanner.skipspace; + palmos_applicationid:=current_scanner.readcomment; + end; + + procedure dir_appname; + begin + if target_info.system<>system_m68k_palmos then + Message(scan_w_appname_not_support); + { change description global var in all cases } + { it not used but in win32 and os2 } + current_scanner.skipspace; + palmos_applicationname:=current_scanner.readcomment; + end; +{$endif defined(m68k) or defined(arm)} + + procedure dir_apptype; + var + hs : string; + begin + if not (target_info.system in systems_all_windows + [system_i386_os2, + system_i386_emx, system_powerpc_macos, + system_arm_nds] + systems_nativent) then + begin + if m_delphi in current_settings.modeswitches then + Message(scan_n_app_type_not_support) + else + Message(scan_w_app_type_not_support); + end + else + begin + if not current_module.in_global then + Message(scan_w_switch_is_global) + else + begin + current_scanner.skipspace; + hs:=current_scanner.readid; + if hs='GUI' then + apptype:=app_gui + else if hs='CONSOLE' then + apptype:=app_cui + else if (hs='NATIVE') and (target_info.system in systems_windows + systems_nativent) then + apptype:=app_native + else if (hs='FS') and (target_info.system in [system_i386_os2, + system_i386_emx]) then + apptype:=app_fs + else if (hs='TOOL') and (target_info.system in [system_powerpc_macos]) then + apptype:=app_tool + else if (hs='ARM9') and (target_info.system in [system_arm_nds]) then + apptype:=app_arm9 + else if (hs='ARM7') and (target_info.system in [system_arm_nds]) then + apptype:=app_arm7 + else + Message1(scan_w_unsupported_app_type,hs); + end; + end; + end; + + + procedure dir_calling; + var + hs : string; + begin + current_scanner.skipspace; + hs:=current_scanner.readid; + if (hs='') then + Message(parser_e_proc_directive_expected) + else + recordpendingcallingswitch(hs); + end; + + + procedure dir_checkpointer; + begin + do_localswitchdefault(cs_checkpointer); + end; + + + procedure dir_objectchecks; + begin + do_localswitch(cs_check_object); + end; + + + procedure dir_ieeeerrors; + begin + do_localswitch(cs_ieee_errors); + end; + + + procedure dir_assertions; + begin + do_delphiswitch('C'); + end; + + + procedure dir_booleval; + begin + do_delphiswitch('B'); + end; + + procedure dir_debuginfo; + begin + do_delphiswitch('D'); + end; + + procedure dir_description; + begin + if not (target_info.system in systems_all_windows+[system_i386_os2,system_i386_emx, + system_i386_netware,system_i386_wdosx,system_i386_netwlibc]) then + Message(scan_w_description_not_support); + { change description global var in all cases } + { it not used but in win32, os2 and netware } + current_scanner.skipspace; + description:=current_scanner.readcomment; + DescriptionSetExplicity:=true; + end; + + procedure dir_screenname; {ad} + begin + if not (target_info.system in [system_i386_netware,system_i386_netwlibc]) then + {Message(scan_w_decription_not_support);} + comment (V_Warning,'Screenname only supported for target netware'); + current_scanner.skipspace; + nwscreenname:=current_scanner.readcomment; + end; + + procedure dir_threadname; {ad} + begin + if not (target_info.system in [system_i386_netware,system_i386_netwlibc]) then + {Message(scan_w_decription_not_support);} + comment (V_Warning,'Threadname only supported for target netware'); + current_scanner.skipspace; + nwthreadname:=current_scanner.readcomment; + end; + + procedure dir_copyright; {ad} + begin + if not (target_info.system in [system_i386_netware,system_i386_netwlibc]) then + {Message(scan_w_decription_not_support);} + comment (V_Warning,'Copyright only supported for target netware'); + current_scanner.skipspace; + nwcopyright:=current_scanner.readcomment; + end; + + procedure dir_error; + begin + do_message(scan_e_user_defined); + end; + + procedure dir_extendedsyntax; + begin + do_delphiswitch('X'); + end; + + procedure dir_fatal; + begin + do_message(scan_f_user_defined); + end; + + procedure dir_fputype; + begin + current_scanner.skipspace; + undef_system_macro('FPU'+fputypestr[current_settings.fputype]); + if not(SetFPUType(upper(current_scanner.readcomment),current_settings.fputype)) then + comment(V_Error,'Illegal FPU type'); + def_system_macro('FPU'+fputypestr[current_settings.fputype]); + end; + + procedure dir_frameworkpath; + begin + if not current_module.in_global then + Message(scan_w_switch_is_global) + else if not(target_info.system in systems_darwin) then + begin + Message(scan_w_frameworks_darwin_only); + current_scanner.skipspace; + current_scanner.readcomment + end + else + begin + current_scanner.skipspace; + current_module.localframeworksearchpath.AddPath(current_scanner.readcomment,false); + end; + end; + + procedure dir_goto; + begin + do_moduleswitch(cs_support_goto); + end; + + procedure dir_hint; + begin + do_message(scan_h_user_defined); + end; + + procedure dir_hints; + begin + do_setverbose('H'); + end; + + procedure dir_imagebase; + begin + if not (target_info.system in (systems_windows+systems_wince)) then + Message(scan_w_imagebase_not_support); + current_scanner.skipspace; + imagebase:=current_scanner.readval; + ImageBaseSetExplicity:=true + end; + + procedure dir_implicitexceptions; + begin + do_moduleswitch(cs_implicit_exceptions); + end; + + procedure dir_includepath; + begin + if not current_module.in_global then + Message(scan_w_switch_is_global) + else + begin + current_scanner.skipspace; + current_module.localincludesearchpath.AddPath(current_scanner.readcomment,false); + end; + end; + + procedure dir_info; + begin + do_message(scan_i_user_defined); + end; + + procedure dir_inline; + begin + do_localswitch(cs_do_inline); + end; + + procedure dir_interfaces; + var + hs : string; + begin + {corba/com/default} + current_scanner.skipspace; + hs:=current_scanner.readid; + if (hs='CORBA') then + current_settings.interfacetype:=it_interfacecorba + else if (hs='COM') then + current_settings.interfacetype:=it_interfacecom + else if (hs='DEFAULT') then + current_settings.interfacetype:=init_settings.interfacetype + else + Message(scan_e_invalid_interface_type); + end; + + procedure dir_iochecks; + begin + do_delphiswitch('I'); + end; + + procedure dir_libexport; + begin + {not implemented} + end; + + procedure dir_librarypath; + begin + if not current_module.in_global then + Message(scan_w_switch_is_global) + else + begin + current_scanner.skipspace; + current_module.locallibrarysearchpath.AddPath(current_scanner.readcomment,false); + end; + end; + + procedure dir_link; + var + s : string; + begin + current_scanner.skipspace; + if scanner.c = '''' then + begin + s:= current_scanner.readquotedstring; + current_scanner.readcomment + end + else + s:= trimspace(current_scanner.readcomment); + s:=FixFileName(s); + if ExtractFileExt(s)='' then + s:=ChangeFileExt(s,target_info.objext); + current_module.linkotherofiles.add(s,link_always); + end; + + procedure dir_linkframework; + var + s : string; + begin + current_scanner.skipspace; + if scanner.c = '''' then + begin + s:= current_scanner.readquotedstring; + current_scanner.readcomment + end + else + s:= trimspace(current_scanner.readcomment); + s:=FixFileName(s); + if (target_info.system in systems_darwin) then + current_module.linkotherframeworks.add(s,link_always) + else + Message(scan_w_frameworks_darwin_only); + end; + + procedure dir_linklib; + type + tLinkMode=(lm_shared,lm_static); + var + s : string; + quote : char; + libext, + libname, + linkmodestr : string; + p : longint; + linkMode : tLinkMode; + begin + current_scanner.skipspace; + if scanner.c = '''' then + begin + libname:= current_scanner.readquotedstring; + s:= current_scanner.readcomment; + p:=pos(',',s); + end + else + begin + s:= current_scanner.readcomment; + p:=pos(',',s); + if p=0 then + libname:=TrimSpace(s) + else + libname:=TrimSpace(copy(s,1,p-1)); + end; + if p=0 then + linkmodeStr:='' + else + linkmodeStr:=Upper(TrimSpace(copy(s,p+1,255))); + + + if (libname='') or (libname='''''') or (libname='""') then + exit; + { create library name } + if libname[1] in ['''','"'] then + begin + quote:=libname[1]; + Delete(libname,1,1); + p:=pos(quote,libname); + if p>0 then + Delete(libname,p,1); + end; + libname:=FixFileName(libname); + + { get linkmode, default is to check the extension for + the static library, otherwise shared linking is assumed } + linkmode:=lm_shared; + if linkModeStr='' then + begin + libext:=ExtractFileExt(libname); + if libext=target_info.staticClibext then + linkMode:=lm_static; + end + else if linkModeStr='STATIC' then + linkmode:=lm_static + else if (LinkModeStr='SHARED') or (LinkModeStr='') then + linkmode:=lm_shared + else + Comment(V_Error,'Wrong link mode specified: "'+Linkmodestr+'"'); + + { add to the list of other libraries } + if linkMode=lm_static then + current_module.linkOtherStaticLibs.add(libname,link_always) + else + current_module.linkOtherSharedLibs.add(libname,link_always); + end; + + procedure dir_localsymbols; + begin + do_delphiswitch('L'); + end; + + procedure dir_longstrings; + begin + do_delphiswitch('H'); + end; + + procedure dir_macro; + begin + do_moduleswitch(cs_support_macro); + end; + + procedure dir_pascalmainname; + var + s: string; + begin + current_scanner.skipspace; + s:=trimspace(current_scanner.readcomment); + if assigned(current_module.mainname) and + (s<>current_module.mainname^) then + begin + Message1(scan_w_multiple_main_name_overrides,current_module.mainname^); + stringdispose(current_module.mainname) + end + else if (mainaliasname<>defaultmainaliasname) and + (mainaliasname<>s) then + Message1(scan_w_multiple_main_name_overrides,mainaliasname); + mainaliasname:=s; + if (mainaliasname<>defaultmainaliasname) then + current_module.mainname:=stringdup(mainaliasname); + end; + + procedure dir_maxfpuregisters; + var + l : integer; + hs : string; + begin + current_scanner.skipspace; + if not(c in ['0'..'9']) then + begin + hs:=current_scanner.readid; + if (hs='NORMAL') or (hs='DEFAULT') then + current_settings.maxfpuregisters:=-1 + else + Message(scan_e_invalid_maxfpureg_value); + end + else + begin + l:=current_scanner.readval; + case l of + 0..8: + current_settings.maxfpuregisters:=l; + else + Message(scan_e_invalid_maxfpureg_value); + end; + end; + end; + + procedure dir_maxstacksize; + begin + if not (target_info.system in (systems_windows+systems_wince)) then + Message(scan_w_maxstacksize_not_support); + current_scanner.skipspace; + maxstacksize:=current_scanner.readval; + MaxStackSizeSetExplicity:=true; + end; + + procedure dir_memory; + var + l : longint; + begin + current_scanner.skipspace; + l:=current_scanner.readval; + if l>1024 then + stacksize:=l; + if c=',' then + begin + current_scanner.readchar; + current_scanner.skipspace; + l:=current_scanner.readval; + if l>1024 then + heapsize:=l; + end; + end; + + + procedure dir_message; + var + hs : string; + w : longint; + begin + w:=0; + current_scanner.skipspace; + { Message level specified? } + if c='''' then + w:=scan_n_user_defined + else + begin + hs:=current_scanner.readid; + if (hs='WARN') or (hs='WARNING') then + w:=scan_w_user_defined + else + if (hs='ERROR') then + w:=scan_e_user_defined + else + if (hs='FATAL') then + w:=scan_f_user_defined + else + if (hs='HINT') then + w:=scan_h_user_defined + else + if (hs='NOTE') then + w:=scan_n_user_defined + else + Message1(scan_w_illegal_directive,hs); + end; + { Only print message when there was no error } + if w<>0 then + begin + current_scanner.skipspace; + if c='''' then + hs:=current_scanner.readquotedstring + else + hs:=current_scanner.readcomment; + Message1(w,hs); + end + else + current_scanner.readcomment; + end; + + + procedure dir_minstacksize; + begin + if not (target_info.system in (systems_windows+systems_wince)) then + Message(scan_w_minstacksize_not_support); + current_scanner.skipspace; + minstacksize:=current_scanner.readval; + MinStackSizeSetExplicity:=true; + end; + + + procedure dir_mode; + + begin + if not current_module.in_global then + Message(scan_w_switch_is_global) + else + begin + current_scanner.skipspace; + current_scanner.readstring; + if not current_module.mode_switch_allowed and + not ((m_mac in current_settings.modeswitches) and (pattern='MACPAS')) then + Message1(scan_e_mode_switch_not_allowed,pattern) + else if not SetCompileMode(pattern,false) then + Message1(scan_w_illegal_switch,pattern) + end; + current_module.mode_switch_allowed:= false; + end; + + + procedure dir_modeswitch; + var + s : string; + begin + if not current_module.in_global then + Message(scan_w_switch_is_global) + else + begin + current_scanner.skipspace; + current_scanner.readstring; + s:=pattern; + if c in ['+','-'] then + s:=s+current_scanner.readstate; + if not SetCompileModeSwitch(s,false) then + Message1(scan_w_illegal_switch,s) + end; + end; + + + procedure dir_mmx; + begin + do_localswitch(cs_mmx); + end; + + procedure dir_note; + begin + do_message(scan_n_user_defined); + end; + + procedure dir_notes; + begin + do_setverbose('N'); + end; + + procedure dir_objectpath; + begin + if not current_module.in_global then + Message(scan_w_switch_is_global) + else + begin + current_scanner.skipspace; + current_module.localobjectsearchpath.AddPath(current_scanner.readcomment,false); + end; + end; + + procedure dir_openstrings; + begin + do_delphiswitch('P'); + end; + + procedure dir_optimization; + var + hs : string; + begin + current_scanner.skipspace; + { Support also the ON and OFF as switch } + hs:=current_scanner.readid; + if (hs='ON') then + current_settings.optimizerswitches:=level2optimizerswitches + else if (hs='OFF') then + current_settings.optimizerswitches:=[] + else if (hs='DEFAULT') then + current_settings.optimizerswitches:=init_settings.optimizerswitches + else + begin + if not UpdateOptimizerStr(hs,current_settings.optimizerswitches) then + Message1(scan_e_illegal_optimization_specifier,hs); + end; + end; + + procedure dir_overflowchecks; + begin + do_delphiswitch('Q'); + end; + + procedure dir_packenum; + var + hs : string; + begin + current_scanner.skipspace; + if not(c in ['0'..'9']) then + begin + hs:=current_scanner.readid; + if (hs='NORMAL') or (hs='DEFAULT') then + current_settings.packenum:=4 + else + Message1(scan_e_illegal_pack_enum, hs); + end + else + begin + case current_scanner.readval of + 1 : current_settings.packenum:=1; + 2 : current_settings.packenum:=2; + 4 : current_settings.packenum:=4; + else + Message1(scan_e_illegal_pack_enum, pattern); + end; + end; + end; + + + procedure dir_minfpconstprec; + begin + current_scanner.skipspace; + if not SetMinFPConstPrec(current_scanner.readid,current_settings.minfpconstprec) then + Message1(scan_e_illegal_minfpconstprec, pattern); + end; + + + procedure dir_packrecords; + var + hs : string; + begin + current_scanner.skipspace; + if not(c in ['0'..'9']) then + begin + hs:=current_scanner.readid; + { C has the special recordalignmax of C_alignment } + if (hs='C') then + current_settings.packrecords:=C_alignment + else + if (hs='NORMAL') or (hs='DEFAULT') then + current_settings.packrecords:=0 + else + Message1(scan_e_illegal_pack_records,hs); + end + else + begin + case current_scanner.readval of + 1 : current_settings.packrecords:=1; + 2 : current_settings.packrecords:=2; + 4 : current_settings.packrecords:=4; + 8 : current_settings.packrecords:=8; + 16 : current_settings.packrecords:=16; + 32 : current_settings.packrecords:=32; + else + Message1(scan_e_illegal_pack_records,pattern); + end; + end; + end; + + + procedure dir_packset; + var + hs : string; + begin + current_scanner.skipspace; + if not(c in ['1','2','4','8']) then + begin + hs:=current_scanner.readid; + if (hs='FIXED') or ((hs='DEFAULT') OR (hs='NORMAL')) then + current_settings.setalloc:=0 {Fixed mode, sets are 4 or 32 bytes} + else + Message(scan_e_only_packset); + end + else + begin + case current_scanner.readval of + 1 : current_settings.setalloc:=1; + 2 : current_settings.setalloc:=2; + 4 : current_settings.setalloc:=4; + 8 : current_settings.setalloc:=8; + else + Message(scan_e_only_packset); + end; + end; + end; + + + procedure dir_pic; + begin + { windows doesn't need/support pic } + if tf_no_pic_supported in target_info.flags then + message(scan_w_pic_ignored) + else + do_moduleswitch(cs_create_pic); + end; + + procedure dir_pop; + + begin + if switchesstatestackpos < 1 then + Message(scan_e_too_many_pop); + + Dec(switchesstatestackpos); + recordpendinglocalfullswitch(switchesstatestack[switchesstatestackpos].localsw); + recordpendingverbosityfullswitch(switchesstatestack[switchesstatestackpos].verbosity); + pendingstate.nextmessagerecord:=switchesstatestack[switchesstatestackpos].pmessage; + { Reset verbosity and forget previous pmeesage } + RestoreLocalVerbosity(nil); + current_settings.pmessage:=nil; + flushpendingswitchesstate; + end; + + procedure dir_pointermath; + begin + do_localswitch(cs_pointermath); + end; + + procedure dir_profile; + begin + do_moduleswitch(cs_profile); + { defined/undefine FPC_PROFILE } + if cs_profile in current_settings.moduleswitches then + def_system_macro('FPC_PROFILE') + else + undef_system_macro('FPC_PROFILE'); + end; + + procedure dir_push; + + begin + if switchesstatestackpos > switchesstatestackmax then + Message(scan_e_too_many_push); + + flushpendingswitchesstate; + + switchesstatestack[switchesstatestackpos].localsw:= current_settings.localswitches; + switchesstatestack[switchesstatestackpos].pmessage:= current_settings.pmessage; + switchesstatestack[switchesstatestackpos].verbosity:=status.verbosity; + Inc(switchesstatestackpos); + end; + + procedure dir_rangechecks; + begin + do_delphiswitch('R'); + end; + + procedure dir_referenceinfo; + begin + do_delphiswitch('Y'); + end; + + procedure dir_resource; + var + s : string; + begin + current_scanner.skipspace; + if scanner.c = '''' then + begin + s:= current_scanner.readquotedstring; + current_scanner.readcomment + end + else + s:= trimspace(current_scanner.readcomment); + + { replace * with the name of the main source. + This should always be defined. } + if s[1]='*' then + if Assigned(Current_Module) then + begin + delete(S,1,1); + insert(ChangeFileExt(ExtractFileName(current_module.mainsource^),''),S,1 ); + end; + s:=FixFileName(s); + if ExtractFileExt(s)='' then + s:=ChangeFileExt(s,target_info.resext); + if target_info.res<>res_none then + begin + current_module.flags:=current_module.flags or uf_has_resourcefiles; + if (res_single_file in target_res.resflags) and + not (Current_module.ResourceFiles.Empty) then + Message(scan_w_only_one_resourcefile_supported) + else + current_module.resourcefiles.insert(FixFileName(s)); + end + else + Message(scan_e_resourcefiles_not_supported); + end; + + procedure dir_saturation; + begin + do_localswitch(cs_mmx_saturation); + end; + + procedure dir_safefpuexceptions; + begin + do_localswitch(cs_fpu_fwait); + end; + + procedure dir_scopedenums; + begin + do_localswitch(cs_scopedenums); + end; + + procedure dir_setpeflags; + begin + if not (target_info.system in (systems_all_windows)) then + Message(scan_w_setpeflags_not_support); + current_scanner.skipspace; + peflags:=current_scanner.readval; + SetPEFlagsSetExplicity:=true; + end; + + procedure dir_smartlink; + begin + do_moduleswitch(cs_create_smart); + if (paratargetdbg in [dbg_dwarf2,dbg_dwarf3]) and + not(target_info.system in systems_darwin) and + { smart linking does not yet work with DWARF debug info on most targets } + (cs_create_smart in current_settings.moduleswitches) and + not (af_outputbinary in target_asm.flags) then + begin + Message(option_dwarf_smart_linking); + Exclude(current_settings.moduleswitches,cs_create_smart); + end; + end; + + procedure dir_stackframes; + begin + do_delphiswitch('W'); + end; + + procedure dir_stop; + begin + do_message(scan_f_user_defined); + end; + + procedure dir_stringchecks; + begin + // Delphi adds checks that ansistring and unicodestring are correct in + // different places. Skip it for now. + end; + +{$ifdef powerpc} + procedure dir_syscall; + var + sctype : string; + begin + { not needed on amiga/m68k for now, because there's only one } + { syscall convention (legacy) (KB) } + { not needed on amiga/powerpc because there's only one } + { syscall convention (sysv) (KB) } + if not (target_info.system in [system_powerpc_morphos]) then + comment (V_Warning,'Syscall directive is useless on this target.'); + current_scanner.skipspace; + + sctype:=current_scanner.readid; + if (sctype='LEGACY') or (sctype='SYSV') or (sctype='SYSVBASE') or + (sctype='BASESYSV') or (sctype='R12BASE') then + syscall_convention:=sctype + else + comment (V_Warning,'Invalid Syscall directive ignored.'); + end; +{$endif} + + procedure dir_typedaddress; + begin + do_delphiswitch('T'); + end; + + procedure dir_typeinfo; + begin + do_delphiswitch('M'); + end; + + procedure dir_unitpath; + begin + if not current_module.in_global then + Message(scan_w_switch_is_global) + else + with current_scanner,current_module,localunitsearchpath do + begin + skipspace; + AddPath(path^,readcomment,false); + end; + end; + + procedure dir_varpropsetter; + begin + do_localswitch(cs_varpropsetter); + end; + + procedure dir_varstringchecks; + begin + do_delphiswitch('V'); + end; + + procedure dir_version; + var + major, minor, revision : longint; + error : integer; + begin + if not (target_info.system in systems_all_windows+[system_i386_os2,system_i386_emx, + system_i386_netware,system_i386_wdosx, + system_i386_netwlibc]) then + begin + Message(scan_n_version_not_support); + exit; + end; + if (compile_level<>1) then + Message(scan_n_only_exe_version) + else + begin + { change description global var in all cases } + { it not used but in win32, os2 and netware } + current_scanner.skipspace; + { we should only accept Major.Minor format for win32 and os2 } + current_scanner.readnumber; + major:=0; + minor:=0; + revision:=0; + val(pattern,major,error); + if (error<>0) or (major > high(word)) or (major < 0) then + begin + Message1(scan_w_wrong_version_ignored,pattern); + exit; + end; + if c='.' then + begin + current_scanner.readchar; + current_scanner.readnumber; + val(pattern,minor,error); + if (error<>0) or (minor > high(word)) or (minor < 0) then + begin + Message1(scan_w_wrong_version_ignored,tostr(major)+'.'+pattern); + exit; + end; + if (c='.') and + (target_info.system in [system_i386_netware,system_i386_netwlibc]) then + begin + current_scanner.readchar; + current_scanner.readnumber; + val(pattern,revision,error); + if (error<>0) or (revision > high(word)) or (revision < 0) then + begin + Message1(scan_w_wrong_version_ignored,tostr(revision)+'.'+pattern); + exit; + end; + dllmajor:=word(major); + dllminor:=word(minor); + dllrevision:=word(revision); + dllversion:=tostr(major)+','+tostr(minor)+','+tostr(revision); + end + else + begin + dllmajor:=word(major); + dllminor:=word(minor); + dllversion:=tostr(major)+'.'+tostr(minor); + end; + end + else + dllversion:=tostr(major); + end; + end; + + procedure dir_wait; + var + had_info : boolean; + begin + had_info:=(status.verbosity and V_Info)<>0; + { this message should allways appear !! } + status.verbosity:=status.verbosity or V_Info; + Message(scan_i_press_enter); + readln; + If not(had_info) then + status.verbosity:=status.verbosity and (not V_Info); + end; + + { delphi compatible warn directive: + $warn <identifier> on + $warn <identifier> off + $warn <identifier> error + not implemented yet + } + procedure dir_warn; + var + ident : string; + state : string; + msgstate : tmsgstate; + i : integer; + begin + current_scanner.skipspace; + ident:=current_scanner.readid; + current_scanner.skipspace; + state:=current_scanner.readid; + + { support both delphi and fpc switches } + { use local ms_on/off/error tmsgstate values } + if (state='ON') or (state='+') then + msgstate:=ms_on + else + if (state='OFF') or (state='-') then + msgstate:=ms_off + else + if (state='ERROR') then + msgstate:=ms_error + else + begin + Message1(scanner_e_illegal_warn_state,state); + exit; + end; + + if ident='CONSTRUCTING_ABSTRACT' then + recordpendingmessagestate(type_w_instance_with_abstract, msgstate) + else + if ident='IMPLICIT_VARIANTS' then + recordpendingmessagestate(parser_w_implicit_uses_of_variants_unit, msgstate) + else + if ident='NO_RETVAL' then + recordpendingmessagestate(sym_w_function_result_not_set, msgstate) + else + if ident='SYMBOL_DEPRECATED' then + begin + recordpendingmessagestate(sym_w_deprecated_symbol, msgstate); + recordpendingmessagestate(sym_w_deprecated_symbol_with_msg, msgstate); + end + else + if ident='SYMBOL_EXPERIMENTAL' then + recordpendingmessagestate(sym_w_experimental_symbol, msgstate) + else + if ident='SYMBOL_LIBRARY' then + recordpendingmessagestate(sym_w_library_symbol, msgstate) + else + if ident='SYMBOL_PLATFORM' then + recordpendingmessagestate(sym_w_non_portable_symbol, msgstate) + else + if ident='SYMBOL_UNIMPLEMENTED' then + recordpendingmessagestate(sym_w_non_implemented_symbol, msgstate) + else + if ident='UNIT_DEPRECATED' then + begin + recordpendingmessagestate(sym_w_deprecated_unit, msgstate); + recordpendingmessagestate(sym_w_deprecated_unit_with_msg, msgstate); + end + else + if ident='UNIT_EXPERIMENTAL' then + recordpendingmessagestate(sym_w_experimental_unit, msgstate) + else + if ident='UNIT_LIBRARY' then + recordpendingmessagestate(sym_w_library_unit, msgstate) + else + if ident='UNIT_PLATFORM' then + recordpendingmessagestate(sym_w_non_portable_unit, msgstate) + else + if ident='UNIT_UNIMPLEMENTED' then + recordpendingmessagestate(sym_w_non_implemented_unit, msgstate) + else + if ident='ZERO_NIL_COMPAT' then + recordpendingmessagestate(type_w_zero_to_nil, msgstate) + else + if ident='IMPLICIT_STRING_CAST' then + recordpendingmessagestate(type_w_implicit_string_cast, msgstate) + else + if ident='IMPLICIT_STRING_CAST_LOSS' then + recordpendingmessagestate(type_w_implicit_string_cast_loss, msgstate) + else + if ident='EXPLICIT_STRING_CAST' then + recordpendingmessagestate(type_w_explicit_string_cast, msgstate) + else + if ident='EXPLICIT_STRING_CAST_LOSS' then + recordpendingmessagestate(type_w_explicit_string_cast_loss, msgstate) + else + if ident='CVT_NARROWING_STRING_LOST' then + recordpendingmessagestate(type_w_unicode_data_loss, msgstate) + else + begin + i:=0; + if not ChangeMessageVerbosity(ident,i,msgstate) then + Message1(scanner_w_illegal_warn_identifier,ident); + end; + end; + + procedure dir_warning; + begin + do_message(scan_w_user_defined); + end; + + procedure dir_warnings; + begin + do_setverbose('W'); + end; + + procedure dir_writeableconst; + begin + do_delphiswitch('J'); + end; + + procedure dir_z1; + begin + current_settings.packenum:=1; + end; + + procedure dir_z2; + begin + current_settings.packenum:=2; + end; + + procedure dir_z4; + begin + current_settings.packenum:=4; + end; + + procedure dir_externalsym; + begin + end; + + procedure dir_nodefine; + begin + end; + + procedure dir_hppemit; + begin + end; + + procedure dir_weakpackageunit; + begin + end; + + procedure dir_codealign; + var + s : string; + begin + current_scanner.skipspace; + s:=current_scanner.readcomment; + if not(UpdateAlignmentStr(s,current_settings.alignment)) then + message(scanner_e_illegal_alignment_directive); + end; + + procedure dir_codepage; + var + s : string; + begin + if not current_module.in_global then + Message(scan_w_switch_is_global) + else + begin + current_scanner.skipspace; + s:=current_scanner.readcomment; + if (upper(s)='UTF8') or (upper(s)='UTF-8') then + current_settings.sourcecodepage:=CP_UTF8 + else if not(cpavailable(s)) then + Message1(option_code_page_not_available,s) + else + current_settings.sourcecodepage:=codepagebyname(s); + include(current_settings.moduleswitches,cs_explicit_codepage); + end; + end; + + procedure dir_coperators; + begin + do_moduleswitch(cs_support_c_operators); + end; + + + procedure dir_bitpacking; + begin + do_localswitch(cs_bitpacking); + end; + + procedure dir_region; + begin + end; + + procedure dir_endregion; + begin + end; + + +{**************************************************************************** + Initialize Directives +****************************************************************************} + + procedure InitScannerDirectives; + begin + AddDirective('A1',directive_all, @dir_a1); + AddDirective('A2',directive_all, @dir_a2); + AddDirective('A4',directive_all, @dir_a4); + AddDirective('A8',directive_all, @dir_a8); + AddDirective('ALIGN',directive_all, @dir_align); +{$ifdef m68k} + AddDirective('APPID',directive_all, @dir_appid); + AddDirective('APPNAME',directive_all, @dir_appname); +{$endif m68k} + AddDirective('APPTYPE',directive_all, @dir_apptype); + AddDirective('ASMMODE',directive_all, @dir_asmmode); + AddDirective('ASSERTIONS',directive_all, @dir_assertions); + AddDirective('BOOLEVAL',directive_all, @dir_booleval); + AddDirective('BITPACKING',directive_all, @dir_bitpacking); + AddDirective('CALLING',directive_all, @dir_calling); + AddDirective('CHECKPOINTER',directive_all, @dir_checkpointer); + AddDirective('CODEALIGN',directive_all, @dir_codealign); + AddDirective('CODEPAGE',directive_all, @dir_codepage); + AddDirective('COPERATORS',directive_all, @dir_coperators); + AddDirective('COPYRIGHT',directive_all, @dir_copyright); + AddDirective('D',directive_all, @dir_description); + AddDirective('DEBUGINFO',directive_all, @dir_debuginfo); + AddDirective('DESCRIPTION',directive_all, @dir_description); + AddDirective('ENDREGION',directive_all, @dir_endregion); + AddDirective('ERROR',directive_all, @dir_error); + AddDirective('ERRORC',directive_mac, @dir_error); + AddDirective('EXTENDEDSYNTAX',directive_all, @dir_extendedsyntax); + AddDirective('EXTERNALSYM',directive_all, @dir_externalsym); + AddDirective('FATAL',directive_all, @dir_fatal); + AddDirective('FPUTYPE',directive_all, @dir_fputype); + AddDirective('FRAMEWORKPATH',directive_all, @dir_frameworkpath); + AddDirective('GOTO',directive_all, @dir_goto); + AddDirective('HINT',directive_all, @dir_hint); + AddDirective('HINTS',directive_all, @dir_hints); + AddDirective('HPPEMIT',directive_all, @dir_hppemit); + AddDirective('IEEEERRORS',directive_all,@dir_ieeeerrors); + AddDirective('IOCHECKS',directive_all, @dir_iochecks); + AddDirective('IMAGEBASE',directive_all, @dir_imagebase); + AddDirective('IMPLICITEXCEPTIONS',directive_all, @dir_implicitexceptions); + AddDirective('INCLUDEPATH',directive_all, @dir_includepath); + AddDirective('INFO',directive_all, @dir_info); + AddDirective('INLINE',directive_all, @dir_inline); + AddDirective('INTERFACES',directive_all, @dir_interfaces); + AddDirective('L',directive_all, @dir_link); + AddDirective('LIBEXPORT',directive_mac, @dir_libexport); + AddDirective('LIBRARYPATH',directive_all, @dir_librarypath); + AddDirective('LINK',directive_all, @dir_link); + AddDirective('LINKFRAMEWORK',directive_all, @dir_linkframework); + AddDirective('LINKLIB',directive_all, @dir_linklib); + AddDirective('LOCALSYMBOLS',directive_all, @dir_localsymbols); + AddDirective('LONGSTRINGS',directive_all, @dir_longstrings); + AddDirective('M',directive_all, @dir_memory); + AddDirective('MACRO',directive_all, @dir_macro); + AddDirective('MAXFPUREGISTERS',directive_all, @dir_maxfpuregisters); + AddDirective('MAXSTACKSIZE',directive_all, @dir_maxstacksize); + AddDirective('MEMORY',directive_all, @dir_memory); + AddDirective('MESSAGE',directive_all, @dir_message); + AddDirective('MINENUMSIZE',directive_all, @dir_packenum); + AddDirective('MINFPCONSTPREC',directive_all, @dir_minfpconstprec); + AddDirective('MINSTACKSIZE',directive_all, @dir_minstacksize); + AddDirective('MMX',directive_all, @dir_mmx); + AddDirective('MODE',directive_all, @dir_mode); + AddDirective('MODESWITCH',directive_all, @dir_modeswitch); + AddDirective('NODEFINE',directive_all, @dir_nodefine); + AddDirective('NOTE',directive_all, @dir_note); + AddDirective('NOTES',directive_all, @dir_notes); + AddDirective('OBJECTCHECKS',directive_all, @dir_objectchecks); + AddDirective('OBJECTPATH',directive_all, @dir_objectpath); + AddDirective('OPENSTRINGS',directive_all, @dir_openstrings); + AddDirective('OPTIMIZATION',directive_all, @dir_optimization); + AddDirective('OV',directive_mac, @dir_overflowchecks); + AddDirective('OVERFLOWCHECKS',directive_all, @dir_overflowchecks); + AddDirective('PACKENUM',directive_all, @dir_packenum); + AddDirective('PACKRECORDS',directive_all, @dir_packrecords); + AddDirective('PACKSET',directive_all, @dir_packset); + AddDirective('PASCALMAINNAME',directive_all, @dir_pascalmainname); + AddDirective('PIC',directive_all, @dir_pic); + AddDirective('POINTERMATH',directive_all, @dir_pointermath); + AddDirective('POP',directive_all, @dir_pop); + AddDirective('PROFILE',directive_all, @dir_profile); + AddDirective('PUSH',directive_all, @dir_push); + AddDirective('R',directive_all, @dir_resource); + AddDirective('RANGECHECKS',directive_all, @dir_rangechecks); + AddDirective('REFERENCEINFO',directive_all, @dir_referenceinfo); + AddDirective('REGION',directive_all, @dir_region); + AddDirective('RESOURCE',directive_all, @dir_resource); + AddDirective('SATURATION',directive_all, @dir_saturation); + AddDirective('SAFEFPUEXCEPTIONS',directive_all, @dir_safefpuexceptions); + AddDirective('SCOPEDENUMS',directive_all, @dir_scopedenums); + AddDirective('SETPEFLAGS', directive_all, @dir_setpeflags); + AddDirective('SCREENNAME',directive_all, @dir_screenname); + AddDirective('SMARTLINK',directive_all, @dir_smartlink); + AddDirective('STACKFRAMES',directive_all, @dir_stackframes); + AddDirective('STOP',directive_all, @dir_stop); + AddDirective('STRINGCHECKS', directive_all, @dir_stringchecks); +{$ifdef powerpc} + AddDirective('SYSCALL',directive_all, @dir_syscall); +{$endif powerpc} + AddDirective('THREADNAME',directive_all, @dir_threadname); + AddDirective('TYPEDADDRESS',directive_all, @dir_typedaddress); + AddDirective('TYPEINFO',directive_all, @dir_typeinfo); + AddDirective('UNITPATH',directive_all, @dir_unitpath); + AddDirective('VARPROPSETTER',directive_all, @dir_varpropsetter); + AddDirective('VARSTRINGCHECKS',directive_all, @dir_varstringchecks); + AddDirective('VERSION',directive_all, @dir_version); + AddDirective('WAIT',directive_all, @dir_wait); + AddDirective('WARN',directive_all, @dir_warn); + AddDirective('WARNING',directive_all, @dir_warning); + AddDirective('WARNINGS',directive_all, @dir_warnings); + AddDirective('WEAKPACKAGEUNIT',directive_all, @dir_weakpackageunit); + AddDirective('WRITEABLECONST',directive_all, @dir_writeableconst); + AddDirective('Z1',directive_all, @dir_z1); + AddDirective('Z2',directive_all, @dir_z2); + AddDirective('Z4',directive_all, @dir_z4); + end; + +end. diff --git a/closures/compiler/scanner.pas b/closures/compiler/scanner.pas new file mode 100644 index 0000000000..0eea92b0a7 --- /dev/null +++ b/closures/compiler/scanner.pas @@ -0,0 +1,4734 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements the scanner part and handling of the switches + + 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 scanner; + +{$i fpcdefs.inc} + +interface + + uses + cclasses, + globtype,globals,constexp,version,tokens, + verbose,comphook, + finput, + widestr; + + const + max_include_nesting=32; + max_macro_nesting=16; + preprocbufsize=32*1024; + + + type + tcommentstyle = (comment_none,comment_tp,comment_oldtp,comment_delphi,comment_c); + + tscannerfile = class; + + preproctyp = (pp_ifdef,pp_ifndef,pp_if,pp_ifopt,pp_else,pp_elseif); + + tpreprocstack = class + typ : preproctyp; + accept : boolean; + next : tpreprocstack; + name : TIDString; + line_nb : longint; + owner : tscannerfile; + constructor Create(atyp:preproctyp;a:boolean;n:tpreprocstack); + end; + + tdirectiveproc=procedure; + + tdirectiveitem = class(TFPHashObject) + public + is_conditional : boolean; + proc : tdirectiveproc; + constructor Create(AList:TFPHashObjectList;const n:string;p:tdirectiveproc); + constructor CreateCond(AList:TFPHashObjectList;const n:string;p:tdirectiveproc); + end; + + // stack for replay buffers + treplaystack = class + token : ttoken; + settings : tsettings; + tokenbuf : tdynamicarray; + next : treplaystack; + change_endian : boolean; + constructor Create(atoken: ttoken;asettings:tsettings; + atokenbuf:tdynamicarray;anext:treplaystack; achange_endian : boolean); + end; + + tcompile_time_predicate = function(var valuedescr: String) : Boolean; + + tspecialgenerictoken = + (ST_LOADSETTINGS, + ST_LINE, + ST_COLUMN, + ST_FILEINDEX, + ST_LOADMESSAGES); + + { tscannerfile } + + tscannerfile = class + private + procedure do_gettokenpos(out tokenpos: longint; out filepos: tfileposinfo); + procedure cachenexttokenpos; + procedure setnexttoken; + procedure savetokenpos; + procedure restoretokenpos; + procedure writetoken(t: ttoken); + function readtoken : ttoken; + public + inputfile : tinputfile; { current inputfile list } + inputfilecount : longint; + + inputbuffer, { input buffer } + inputpointer : pchar; + inputstart : longint; + + line_no, { line } + lastlinepos : longint; + + lasttokenpos, + nexttokenpos : longint; { token } + lasttoken, + nexttoken : ttoken; + + oldlasttokenpos : longint; { temporary saving/restoring tokenpos } + oldcurrent_filepos, + oldcurrent_tokenpos : tfileposinfo; + + + replaytokenbuf, + recordtokenbuf : tdynamicarray; + tokenbuf_change_endian : boolean; + + { last settings we stored } + last_settings : tsettings; + last_message : pmessagestaterecord; + { last filepos we stored } + last_filepos, + { if nexttoken<>NOTOKEN, then nexttokenpos holds its filepos } + next_filepos : tfileposinfo; + + comment_level, + yylexcount : longint; + lastasmgetchar : char; + ignoredirectives : TFPHashList; { ignore directives, used to give warnings only once } + preprocstack : tpreprocstack; + replaystack : treplaystack; + in_asm_string : boolean; + + preproc_pattern : string; + preproc_token : ttoken; + + constructor Create(const fn:string); + destructor Destroy;override; + { File buffer things } + function openinputfile:boolean; + procedure closeinputfile; + function tempopeninputfile:boolean; + procedure tempcloseinputfile; + procedure saveinputfile; + procedure restoreinputfile; + procedure firstfile; + procedure nextfile; + procedure addfile(hp:tinputfile); + procedure reload; + procedure insertmacro(const macname:string;p:pchar;len,line,fileindex:longint); + { Scanner things } + procedure gettokenpos; + procedure inc_comment_level; + procedure dec_comment_level; + procedure illegal_char(c:char); + procedure end_of_file; + procedure checkpreprocstack; + procedure poppreprocstack; + procedure ifpreprocstack(atyp : preproctyp;compile_time_predicate:tcompile_time_predicate;messid:longint); + procedure elseifpreprocstack(compile_time_predicate:tcompile_time_predicate); + procedure elsepreprocstack; + procedure popreplaystack; + procedure handleconditional(p:tdirectiveitem); + procedure handledirectives; + procedure linebreak; + procedure recordtoken; + procedure startrecordtokens(buf:tdynamicarray); + procedure stoprecordtokens; + procedure replaytoken; + procedure startreplaytokens(buf:tdynamicarray; achange_endian : boolean); + { bit length sizeint is target depend } + procedure tokenwritesizeint(val : sizeint); + function tokenreadsizeint : sizeint; + { longword/longint are 32 bits on all targets } + { word/smallint are 16-bits on all targest } + function tokenreadlongword : longword; + function tokenreadword : word; + function tokenreadlongint : longint; + function tokenreadsmallint : smallint; + { short int is one a signed byte } + function tokenreadshortint : shortint; + function tokenreadbyte : byte; + { This one takes the set size as an parameter } + procedure tokenreadset(var b;size : longint); + function tokenreadenum(size : longint) : longword; + + procedure tokenreadsettings(var asettings : tsettings; expected_size : longint); + procedure readchar; + procedure readstring; + procedure readnumber; + function readid:string; + function readval:longint; + function readval_asstring:string; + function readcomment:string; + function readquotedstring:string; + function readstate:char; + function readstatedefault:char; + procedure skipspace; + procedure skipuntildirective; + procedure skipcomment; + procedure skipdelphicomment; + procedure skipoldtpcomment; + procedure readtoken(allowrecordtoken:boolean); + function readpreproc:ttoken; + function asmgetcharstart : char; + function asmgetchar:char; + end; + +{$ifdef PREPROCWRITE} + tpreprocfile=class + f : text; + buf : pointer; + spacefound, + eolfound : boolean; + constructor create(const fn:string); + destructor destroy; + procedure Add(const s:string); + procedure AddSpace; + end; +{$endif PREPROCWRITE} + + var + { read strings } + c : char; + orgpattern, + pattern : string; + cstringpattern : ansistring; + patternw : pcompilerwidestring; + + { token } + token, { current token being parsed } + idtoken : ttoken; { holds the token if the pattern is a known word } + + current_scanner : tscannerfile; { current scanner in use } + + aktcommentstyle : tcommentstyle; { needed to use read_comment from directives } +{$ifdef PREPROCWRITE} + preprocfile : tpreprocfile; { used with only preprocessing } +{$endif PREPROCWRITE} + + type + tdirectivemode = (directive_all, directive_turbo, directive_mac); + + procedure AddDirective(const s:string; dm: tdirectivemode; p:tdirectiveproc); + procedure AddConditional(const s:string; dm: tdirectivemode; p:tdirectiveproc); + + procedure InitScanner; + procedure DoneScanner; + + { To be called when the language mode is finally determined } + Function SetCompileMode(const s:string; changeInit: boolean):boolean; + Function SetCompileModeSwitch(s:string; changeInit: boolean):boolean; + + +implementation + + uses + SysUtils, + cutils,cfileutl, + systems, + switches, + symbase,symtable,symtype,symsym,symconst,symdef,defutil, + { This is needed for tcputype } + cpuinfo, + fmodule +{$if FPC_FULLVERSION<20700} + ,ccharset +{$endif} + ; + + var + { dictionaries with the supported directives } + turbo_scannerdirectives : TFPHashObjectList; { for other modes } + mac_scannerdirectives : TFPHashObjectList; { for mode mac } + + +{***************************************************************************** + Helper routines +*****************************************************************************} + + const + { use any special name that is an invalid file name to avoid problems } + preprocstring : array [preproctyp] of string[7] + = ('$IFDEF','$IFNDEF','$IF','$IFOPT','$ELSE','$ELSEIF'); + + function is_keyword(const s:string):boolean; + var + low,high,mid : longint; + begin + if not (length(s) in [tokenlenmin..tokenlenmax]) or + not (s[1] in ['a'..'z','A'..'Z']) then + begin + is_keyword:=false; + exit; + end; + low:=ord(tokenidx^[length(s),s[1]].first); + high:=ord(tokenidx^[length(s),s[1]].last); + while low<high do + begin + mid:=(high+low+1) shr 1; + if pattern<tokeninfo^[ttoken(mid)].str then + high:=mid-1 + else + low:=mid; + end; + is_keyword:=(pattern=tokeninfo^[ttoken(high)].str) and + (tokeninfo^[ttoken(high)].keyword in current_settings.modeswitches); + end; + + + Procedure HandleModeSwitches(changeInit: boolean); + begin + { turn ansistrings on by default ? } + if (m_default_ansistring in current_settings.modeswitches) then + begin + include(current_settings.localswitches,cs_ansistrings); + if changeinit then + include(init_settings.localswitches,cs_ansistrings); + end + else + begin + exclude(current_settings.localswitches,cs_ansistrings); + if changeinit then + exclude(init_settings.localswitches,cs_ansistrings); + end; + + { turn inline on by default ? } + if (m_default_inline in current_settings.modeswitches) then + begin + include(current_settings.localswitches,cs_do_inline); + if changeinit then + include(init_settings.localswitches,cs_do_inline); + end + else + begin + exclude(current_settings.localswitches,cs_do_inline); + if changeinit then + exclude(init_settings.localswitches,cs_do_inline); + end; + + { turn system codepage by default } + if m_systemcodepage in current_settings.modeswitches then + begin + current_settings.sourcecodepage:=DefaultSystemCodePage; + include(current_settings.moduleswitches,cs_explicit_codepage); + if changeinit then + begin + init_settings.sourcecodepage:=DefaultSystemCodePage; + include(init_settings.moduleswitches,cs_explicit_codepage); + end; + end + else + begin + exclude(current_settings.moduleswitches,cs_explicit_codepage); + if changeinit then + exclude(init_settings.moduleswitches,cs_explicit_codepage); + end; + end; + + + Function SetCompileMode(const s:string; changeInit: boolean):boolean; + var + b : boolean; + oldmodeswitches : tmodeswitches; + begin + oldmodeswitches:=current_settings.modeswitches; + + b:=true; + if s='DEFAULT' then + current_settings.modeswitches:=fpcmodeswitches + else + if s='DELPHI' then + current_settings.modeswitches:=delphimodeswitches + else + if s='DELPHIUNICODE' then + current_settings.modeswitches:=delphiunicodemodeswitches + else + if s='TP' then + current_settings.modeswitches:=tpmodeswitches + else + if s='FPC' then begin + current_settings.modeswitches:=fpcmodeswitches; + { TODO: enable this for 2.3/2.9 } + // include(current_settings.localswitches, cs_typed_addresses); + end else + if s='OBJFPC' then begin + current_settings.modeswitches:=objfpcmodeswitches; + { TODO: enable this for 2.3/2.9 } + // include(current_settings.localswitches, cs_typed_addresses); + end +{$ifdef gpc_mode} + else if s='GPC' then + current_settings.modeswitches:=gpcmodeswitches +{$endif} + else + if s='MACPAS' then + current_settings.modeswitches:=macmodeswitches + else + if s='ISO' then + current_settings.modeswitches:=isomodeswitches + else + b:=false; + + if b and changeInit then + init_settings.modeswitches := current_settings.modeswitches; + + if b then + begin + { resolve all postponed switch changes } + flushpendingswitchesstate; + + HandleModeSwitches(changeinit); + + { turn on bitpacking for mode macpas and iso pascal } + if ([m_mac,m_iso] * current_settings.modeswitches <> []) then + begin + include(current_settings.localswitches,cs_bitpacking); + if changeinit then + include(init_settings.localswitches,cs_bitpacking); + end; + + { support goto/label by default in delphi/tp7/mac modes } + if ([m_delphi,m_tp7,m_mac,m_iso] * current_settings.modeswitches <> []) then + begin + include(current_settings.moduleswitches,cs_support_goto); + if changeinit then + include(init_settings.moduleswitches,cs_support_goto); + end; + + { support pointer math by default in fpc/objfpc modes } + if ([m_fpc,m_objfpc] * current_settings.modeswitches <> []) then + begin + include(current_settings.localswitches,cs_pointermath); + if changeinit then + include(init_settings.localswitches,cs_pointermath); + end + else + begin + exclude(current_settings.localswitches,cs_pointermath); + if changeinit then + exclude(init_settings.localswitches,cs_pointermath); + end; + + { Default enum and set packing for delphi/tp7 } + if (m_tp7 in current_settings.modeswitches) or + (m_delphi in current_settings.modeswitches) then + begin + current_settings.packenum:=1; + current_settings.setalloc:=1; + end + else if (m_mac in current_settings.modeswitches) then + { compatible with Metrowerks Pascal } + current_settings.packenum:=2 + else + current_settings.packenum:=4; + if changeinit then + init_settings.packenum:=current_settings.packenum; +{$ifdef i386} + { Default to intel assembler for delphi/tp7 on i386 } + if (m_delphi in current_settings.modeswitches) or + (m_tp7 in current_settings.modeswitches) then + current_settings.asmmode:=asmmode_i386_intel; + if changeinit then + init_settings.asmmode:=current_settings.asmmode; +{$endif i386} + + { Exception support explicitly turned on (mainly for macpas, to } + { compensate for lack of interprocedural goto support) } + if (cs_support_exceptions in current_settings.globalswitches) then + include(current_settings.modeswitches,m_except); + + { Default strict string var checking in TP/Delphi modes } + if ([m_delphi,m_tp7] * current_settings.modeswitches <> []) then + begin + include(current_settings.localswitches,cs_strict_var_strings); + if changeinit then + include(init_settings.localswitches,cs_strict_var_strings); + end; + + { Undefine old symbol } + if (m_delphi in oldmodeswitches) then + undef_system_macro('FPC_DELPHI') + else if (m_tp7 in oldmodeswitches) then + undef_system_macro('FPC_TP') + else if (m_objfpc in oldmodeswitches) then + undef_system_macro('FPC_OBJFPC') +{$ifdef gpc_mode} + else if (m_gpc in oldmodeswitches) then + undef_system_macro('FPC_GPC') +{$endif} + else if (m_mac in oldmodeswitches) then + undef_system_macro('FPC_MACPAS'); + + { define new symbol in delphi,objfpc,tp,gpc,macpas mode } + if (m_delphi in current_settings.modeswitches) then + def_system_macro('FPC_DELPHI') + else if (m_tp7 in current_settings.modeswitches) then + def_system_macro('FPC_TP') + else if (m_objfpc in current_settings.modeswitches) then + def_system_macro('FPC_OBJFPC') +{$ifdef gpc_mode} + else if (m_gpc in current_settings.modeswitches) then + def_system_macro('FPC_GPC') +{$endif} + else if (m_mac in current_settings.modeswitches) then + def_system_macro('FPC_MACPAS'); + end; + + SetCompileMode:=b; + end; + + + Function SetCompileModeSwitch(s:string; changeInit: boolean):boolean; + var + i : tmodeswitch; + doinclude : boolean; + begin + s:=upper(s); + + { on/off? } + doinclude:=true; + case s[length(s)] of + '+': + s:=copy(s,1,length(s)-1); + '-': + begin + s:=copy(s,1,length(s)-1); + doinclude:=false; + end; + end; + + Result:=false; + for i:=m_class to high(tmodeswitch) do + if s=modeswitchstr[i] then + begin + { Objective-C is currently only supported for Darwin targets } + if doinclude and + (i in [m_objectivec1,m_objectivec2]) and + not(target_info.system in systems_objc_supported) then + begin + Message1(option_unsupported_target_for_feature,'Objective-C'); + break; + end; + + if changeInit then + current_settings.modeswitches:=init_settings.modeswitches; + Result:=true; + if doinclude then + begin + include(current_settings.modeswitches,i); + { Objective-C 2.0 support implies 1.0 support } + if (i=m_objectivec2) then + include(current_settings.modeswitches,m_objectivec1); + if (i in [m_objectivec1,m_objectivec2]) then + include(current_settings.modeswitches,m_class); + end + else + begin + exclude(current_settings.modeswitches,i); + { Objective-C 2.0 support implies 1.0 support } + if (i=m_objectivec2) then + exclude(current_settings.modeswitches,m_objectivec1); + if (i in [m_objectivec1,m_objectivec2]) and + ([m_delphi,m_objfpc]*current_settings.modeswitches=[]) then + exclude(current_settings.modeswitches,m_class); + end; + + { set other switches depending on changed mode switch } + HandleModeSwitches(changeinit); + + if changeInit then + init_settings.modeswitches:=current_settings.modeswitches; + + break; + end; + end; + +{***************************************************************************** + Conditional Directives +*****************************************************************************} + + procedure dir_else; + begin + current_scanner.elsepreprocstack; + end; + + + procedure dir_endif; + begin + current_scanner.poppreprocstack; + end; + + function isdef(var valuedescr: String): Boolean; + var + hs : string; + begin + current_scanner.skipspace; + hs:=current_scanner.readid; + valuedescr:= hs; + if hs='' then + Message(scan_e_error_in_preproc_expr); + isdef:=defined_macro(hs); + end; + + procedure dir_ifdef; + begin + current_scanner.ifpreprocstack(pp_ifdef,@isdef,scan_c_ifdef_found); + end; + + function isnotdef(var valuedescr: String): Boolean; + var + hs : string; + begin + current_scanner.skipspace; + hs:=current_scanner.readid; + valuedescr:= hs; + if hs='' then + Message(scan_e_error_in_preproc_expr); + isnotdef:=not defined_macro(hs); + end; + + procedure dir_ifndef; + begin + current_scanner.ifpreprocstack(pp_ifndef,@isnotdef,scan_c_ifndef_found); + end; + + function opt_check(var valuedescr: String): Boolean; + var + hs : string; + state : char; + begin + opt_check:= false; + current_scanner.skipspace; + hs:=current_scanner.readid; + valuedescr:= hs; + if (length(hs)>1) then + Message1(scan_w_illegal_switch,hs) + else + begin + state:=current_scanner.ReadState; + if state in ['-','+'] then + opt_check:=CheckSwitch(hs[1],state) + else + Message(scan_e_error_in_preproc_expr); + end; + end; + + procedure dir_ifopt; + begin + flushpendingswitchesstate; + current_scanner.ifpreprocstack(pp_ifopt,@opt_check,scan_c_ifopt_found); + end; + + procedure dir_libprefix; + var + s : string; + begin + current_scanner.skipspace; + if c <> '''' then + Message2(scan_f_syn_expected, '''', c); + s := current_scanner.readquotedstring; + stringdispose(outputprefix); + outputprefix := stringdup(s); + with current_module do + setfilename(paramfn^, paramallowoutput); + end; + + procedure dir_libsuffix; + var + s : string; + begin + current_scanner.skipspace; + if c <> '''' then + Message2(scan_f_syn_expected, '''', c); + s := current_scanner.readquotedstring; + stringdispose(outputsuffix); + outputsuffix := stringdup(s); + with current_module do + setfilename(paramfn^, paramallowoutput); + end; + + procedure dir_extension; + var + s : string; + begin + current_scanner.skipspace; + if c <> '''' then + Message2(scan_f_syn_expected, '''', c); + s := current_scanner.readquotedstring; + if OutputFileName='' then + OutputFileName:=InputFileName; + OutputFileName:=ChangeFileExt(OutputFileName,'.'+s); + with current_module do + setfilename(paramfn^, paramallowoutput); + end; + +{ +Compile time expression type check +---------------------------------- +Each subexpression returns its type to the caller, which then can +do type check. Since data types of compile time expressions is +not well defined, the type system does a best effort. The drawback is +that some errors might not be detected. + +Instead of returning a particular data type, a set of possible data types +are returned. This way ambigouos types can be handled. For instance a +value of 1 can be both a boolean and and integer. + +Booleans +-------- + +The following forms of boolean values are supported: +* C coded, that is 0 is false, non-zero is true. +* TRUE/FALSE for mac style compile time variables + +Thus boolean mac compile time variables are always stored as TRUE/FALSE. +When a compile time expression is evaluated, they are then translated +to C coded booleans (0/1), to simplify for the expression evaluator. + +Note that this scheme then also of support mac compile time variables which +are 0/1 but with a boolean meaning. + +The TRUE/FALSE format is new from 22 august 2005, but the above scheme +means that units which is not recompiled, and thus stores +compile time variables as the old format (0/1), continue to work. + +Short circuit evaluation +------------------------ +For this to work, the part of a compile time expression which is short +circuited, should not be evaluated, while it still should be parsed. +Therefor there is a parameter eval, telling whether evaluation is needed. +In case not, the value returned can be arbitrary. +} + + type + {Compile time expression types} + TCTEType = (ctetBoolean, ctetInteger, ctetString, ctetSet); + TCTETypeSet = set of TCTEType; + + const + cteTypeNames : array[TCTEType] of string[10] = ( + 'BOOLEAN','INTEGER','STRING','SET'); + + {Subset of types which can be elements in sets.} + setelementdefs = [ctetBoolean, ctetInteger, ctetString]; + + + function GetCTETypeName(t: TCTETypeSet): String; + var + i: TCTEType; + begin + result:= ''; + for i:= Low(TCTEType) to High(TCTEType) do + if i in t then + if result = '' then + result:= cteTypeNames[i] + else + result:= result + ' or ' + cteTypeNames[i]; + end; + + procedure CTEError(actType, desiredExprType: TCTETypeSet; place: String); + + begin + Message3(scan_e_compile_time_typeerror, + GetCTETypeName(desiredExprType), + GetCTETypeName(actType), + place + ); + end; + + function parse_compiler_expr(var compileExprType: TCTETypeSet):string; + + function read_expr(var exprType: TCTETypeSet; eval : Boolean) : string; forward; + + procedure preproc_consume(t : ttoken); + begin + if t<>current_scanner.preproc_token then + Message(scan_e_preproc_syntax_error); + current_scanner.preproc_token:=current_scanner.readpreproc; + end; + + function preproc_substitutedtoken(var macroType: TCTETypeSet; eval : Boolean): string; + { Currently this parses identifiers as well as numbers. + The result from this procedure can either be that the token + itself is a value, or that it is a compile time variable/macro, + which then is substituted for another value (for macros + recursivelly substituted).} + + var + hs: string; + mac : tmacro; + macrocount, + len : integer; + numres : longint; + w: word; + begin + result := current_scanner.preproc_pattern; + if not eval then + exit; + + mac:= nil; + { Substitue macros and compiler variables with their content/value. + For real macros also do recursive substitution. } + macrocount:=0; + repeat + mac:=tmacro(search_macro(result)); + + inc(macrocount); + if macrocount>max_macro_nesting then + begin + Message(scan_w_macro_too_deep); + break; + end; + + if assigned(mac) and mac.defined then + if assigned(mac.buftext) then + begin + if mac.buflen>255 then + begin + len:=255; + Message(scan_w_macro_cut_after_255_chars); + end + else + len:=mac.buflen; + hs[0]:=char(len); + move(mac.buftext^,hs[1],len); + result:=upcase(hs); + mac.is_used:=true; + end + else + begin + Message1(scan_e_error_macro_lacks_value, result); + break; + end + else + begin + break; + end; + + if mac.is_compiler_var then + break; + until false; + + { At this point, result do contain the value. Do some decoding and + determine the type.} + val(result,numres,w); + if (w=0) then {It is an integer} + begin + if (numres = 0) or (numres = 1) then + macroType := [ctetInteger, ctetBoolean] + else + macroType := [ctetInteger]; + end + else if assigned(mac) and (m_mac in current_settings.modeswitches) and (result='FALSE') then + begin + result:= '0'; + macroType:= [ctetBoolean]; + end + else if assigned(mac) and (m_mac in current_settings.modeswitches) and (result='TRUE') then + begin + result:= '1'; + macroType:= [ctetBoolean]; + end + else if (m_mac in current_settings.modeswitches) and + (not assigned(mac) or not mac.defined) and + (macrocount = 1) then + begin + {Errors in mode mac is issued here. For non macpas modes there is + more liberty, but the error will eventually be caught at a later stage.} + Message1(scan_e_error_macro_undefined, result); + macroType:= [ctetString]; {Just to have something} + end + else + macroType:= [ctetString]; + end; + + function read_factor(var factorType: TCTETypeSet; eval : Boolean) : string; + var + hs : string; + mac: tmacro; + srsym : tsym; + srsymtable : TSymtable; + hdef : TDef; + l : longint; + w : integer; + hasKlammer: Boolean; + setElemType : TCTETypeSet; + + begin + if current_scanner.preproc_token=_ID then + begin + if current_scanner.preproc_pattern='DEFINED' then + begin + factorType:= [ctetBoolean]; + preproc_consume(_ID); + current_scanner.skipspace; + if current_scanner.preproc_token =_LKLAMMER then + begin + preproc_consume(_LKLAMMER); + current_scanner.skipspace; + hasKlammer:= true; + end + else if (m_mac in current_settings.modeswitches) then + hasKlammer:= false + else + Message(scan_e_error_in_preproc_expr); + + if current_scanner.preproc_token =_ID then + begin + hs := current_scanner.preproc_pattern; + mac := tmacro(search_macro(hs)); + if assigned(mac) and mac.defined then + begin + hs := '1'; + mac.is_used:=true; + end + else + hs := '0'; + read_factor := hs; + preproc_consume(_ID); + current_scanner.skipspace; + end + else + Message(scan_e_error_in_preproc_expr); + + if hasKlammer then + if current_scanner.preproc_token =_RKLAMMER then + preproc_consume(_RKLAMMER) + else + Message(scan_e_error_in_preproc_expr); + end + else + if (m_mac in current_settings.modeswitches) and (current_scanner.preproc_pattern='UNDEFINED') then + begin + factorType:= [ctetBoolean]; + preproc_consume(_ID); + current_scanner.skipspace; + if current_scanner.preproc_token =_ID then + begin + hs := current_scanner.preproc_pattern; + mac := tmacro(search_macro(hs)); + if assigned(mac) then + begin + hs := '0'; + mac.is_used:=true; + end + else + hs := '1'; + read_factor := hs; + preproc_consume(_ID); + current_scanner.skipspace; + end + else + Message(scan_e_error_in_preproc_expr); + end + else + if (m_mac in current_settings.modeswitches) and (current_scanner.preproc_pattern='OPTION') then + begin + factorType:= [ctetBoolean]; + preproc_consume(_ID); + current_scanner.skipspace; + if current_scanner.preproc_token =_LKLAMMER then + begin + preproc_consume(_LKLAMMER); + current_scanner.skipspace; + end + else + Message(scan_e_error_in_preproc_expr); + + if not (current_scanner.preproc_token = _ID) then + Message(scan_e_error_in_preproc_expr); + + hs:=current_scanner.preproc_pattern; + if (length(hs) > 1) then + {This is allowed in Metrowerks Pascal} + Message(scan_e_error_in_preproc_expr) + else + begin + if CheckSwitch(hs[1],'+') then + read_factor := '1' + else + read_factor := '0'; + end; + + preproc_consume(_ID); + current_scanner.skipspace; + if current_scanner.preproc_token =_RKLAMMER then + preproc_consume(_RKLAMMER) + else + Message(scan_e_error_in_preproc_expr); + end + else + if current_scanner.preproc_pattern='SIZEOF' then + begin + factorType:= [ctetInteger]; + preproc_consume(_ID); + current_scanner.skipspace; + if current_scanner.preproc_token =_LKLAMMER then + begin + preproc_consume(_LKLAMMER); + current_scanner.skipspace; + end + else + Message(scan_e_preproc_syntax_error); + + if eval then + if searchsym(current_scanner.preproc_pattern,srsym,srsymtable) then + begin + l:=0; + case srsym.typ of + staticvarsym, + localvarsym, + paravarsym : + l:=tabstractvarsym(srsym).getsize; + typesym: + l:=ttypesym(srsym).typedef.size; + else + Message(scan_e_error_in_preproc_expr); + end; + str(l,read_factor); + end + else + Message1(sym_e_id_not_found,current_scanner.preproc_pattern); + + preproc_consume(_ID); + current_scanner.skipspace; + + if current_scanner.preproc_token =_RKLAMMER then + preproc_consume(_RKLAMMER) + else + Message(scan_e_preproc_syntax_error); + end + else + if current_scanner.preproc_pattern='HIGH' then + begin + factorType:= [ctetInteger]; + preproc_consume(_ID); + current_scanner.skipspace; + if current_scanner.preproc_token =_LKLAMMER then + begin + preproc_consume(_LKLAMMER); + current_scanner.skipspace; + end + else + Message(scan_e_preproc_syntax_error); + + if eval then + if searchsym(current_scanner.preproc_pattern,srsym,srsymtable) then + begin + hdef:=nil; + hs:=''; + l:=0; + case srsym.typ of + staticvarsym, + localvarsym, + paravarsym : + hdef:=tabstractvarsym(srsym).vardef; + typesym: + hdef:=ttypesym(srsym).typedef; + else + Message(scan_e_error_in_preproc_expr); + end; + if hdef<>nil then + begin + if hdef.typ=setdef then + hdef:=tsetdef(hdef).elementdef; + case hdef.typ of + orddef: + with torddef(hdef).high do + if signed then + str(svalue,hs) + else + str(uvalue,hs); + enumdef: + l:=tenumdef(hdef).maxval; + arraydef: + if is_open_array(hdef) or is_array_of_const(hdef) or is_dynamic_array(hdef) then + Message(type_e_mismatch) + else + l:=tarraydef(hdef).highrange; + stringdef: + if is_open_string(hdef) or is_ansistring(hdef) or is_wide_or_unicode_string(hdef) then + Message(type_e_mismatch) + else + l:=tstringdef(hdef).len; + else + Message(type_e_mismatch); + end; + end; + if hs='' then + str(l,read_factor) + else + read_factor:=hs; + end + else + Message1(sym_e_id_not_found,current_scanner.preproc_pattern); + + preproc_consume(_ID); + current_scanner.skipspace; + + if current_scanner.preproc_token =_RKLAMMER then + preproc_consume(_RKLAMMER) + else + Message(scan_e_preproc_syntax_error); + end + else + if current_scanner.preproc_pattern='DECLARED' then + begin + factorType:= [ctetBoolean]; + preproc_consume(_ID); + current_scanner.skipspace; + if current_scanner.preproc_token =_LKLAMMER then + begin + preproc_consume(_LKLAMMER); + current_scanner.skipspace; + end + else + Message(scan_e_error_in_preproc_expr); + if current_scanner.preproc_token =_ID then + begin + hs := upper(current_scanner.preproc_pattern); + if searchsym(hs,srsym,srsymtable) then + hs := '1' + else + hs := '0'; + read_factor := hs; + preproc_consume(_ID); + current_scanner.skipspace; + end + else + Message(scan_e_error_in_preproc_expr); + if current_scanner.preproc_token =_RKLAMMER then + preproc_consume(_RKLAMMER) + else + Message(scan_e_error_in_preproc_expr); + end + else + if current_scanner.preproc_pattern='NOT' then + begin + factorType:= [ctetBoolean]; + preproc_consume(_ID); + hs:=read_factor(factorType, eval); + if eval then + begin + if not (ctetBoolean in factorType) then + CTEError(factorType, [ctetBoolean], 'NOT'); + val(hs,l,w); + if l<>0 then + read_factor:='0' + else + read_factor:='1'; + end + else + read_factor:='0'; {Just to have something} + end + else + if (m_mac in current_settings.modeswitches) and (current_scanner.preproc_pattern='TRUE') then + begin + factorType:= [ctetBoolean]; + preproc_consume(_ID); + read_factor:='1'; + end + else + if (m_mac in current_settings.modeswitches) and (current_scanner.preproc_pattern='FALSE') then + begin + factorType:= [ctetBoolean]; + preproc_consume(_ID); + read_factor:='0'; + end + else + begin + hs:=preproc_substitutedtoken(factorType, eval); + + { Default is to return the original symbol } + read_factor:=hs; + if eval and ([m_delphi,m_objfpc]*current_settings.modeswitches<>[]) and (ctetString in factorType) then + if searchsym(current_scanner.preproc_pattern,srsym,srsymtable) then + begin + case srsym.typ of + constsym : + begin + with tconstsym(srsym) do + begin + case consttyp of + constord : + begin + case constdef.typ of + orddef: + begin + if is_integer(constdef) then + begin + read_factor:=tostr(value.valueord); + factorType:= [ctetInteger]; + end + else if is_boolean(constdef) then + begin + read_factor:=tostr(value.valueord); + factorType:= [ctetBoolean]; + end + else if is_char(constdef) then + begin + read_factor:=char(qword(value.valueord)); + factorType:= [ctetString]; + end + end; + enumdef: + begin + read_factor:=tostr(value.valueord); + factorType:= [ctetInteger]; + end; + end; + end; + conststring : + begin + read_factor := upper(pchar(value.valueptr)); + factorType:= [ctetString]; + end; + constset : + begin + hs:=','; + for l:=0 to 255 do + if l in pconstset(tconstsym(srsym).value.valueptr)^ then + hs:=hs+tostr(l)+','; + read_factor := hs; + factorType:= [ctetSet]; + end; + end; + end; + end; + enumsym : + begin + read_factor:=tostr(tenumsym(srsym).value); + factorType:= [ctetInteger]; + end; + end; + end; + preproc_consume(_ID); + current_scanner.skipspace; + end + end + else if current_scanner.preproc_token =_LKLAMMER then + begin + preproc_consume(_LKLAMMER); + read_factor:=read_expr(factorType, eval); + preproc_consume(_RKLAMMER); + end + else if current_scanner.preproc_token = _LECKKLAMMER then + begin + preproc_consume(_LECKKLAMMER); + read_factor := ','; + while current_scanner.preproc_token = _ID do + begin + read_factor := read_factor+read_factor(setElemType, eval)+','; + if current_scanner.preproc_token = _COMMA then + preproc_consume(_COMMA); + end; + // TODO Add check of setElemType + preproc_consume(_RECKKLAMMER); + factorType:= [ctetSet]; + end + else + Message(scan_e_error_in_preproc_expr); + end; + + function read_term(var termType: TCTETypeSet; eval : Boolean) : string; + var + hs1,hs2 : string; + l1,l2 : longint; + w : integer; + termType2: TCTETypeSet; + begin + hs1:=read_factor(termType, eval); + repeat + if (current_scanner.preproc_token<>_ID) then + break; + if current_scanner.preproc_pattern<>'AND' then + break; + + val(hs1,l1,w); + if l1=0 then + eval:= false; {Short circuit evaluation of OR} + + if eval then + begin + {Check if first expr is boolean. Must be done here, after we know + it is an AND expression.} + if not (ctetBoolean in termType) then + CTEError(termType, [ctetBoolean], 'AND'); + termType:= [ctetBoolean]; + end; + + preproc_consume(_ID); + hs2:=read_factor(termType2, eval); + + if eval then + begin + if not (ctetBoolean in termType2) then + CTEError(termType2, [ctetBoolean], 'AND'); + + val(hs2,l2,w); + if (l1<>0) and (l2<>0) then + hs1:='1' + else + hs1:='0'; + end; + until false; + read_term:=hs1; + end; + + + function read_simple_expr(var simpleExprType: TCTETypeSet; eval : Boolean) : string; + var + hs1,hs2 : string; + l1,l2 : longint; + w : integer; + simpleExprType2: TCTETypeSet; + begin + hs1:=read_term(simpleExprType, eval); + repeat + if (current_scanner.preproc_token<>_ID) then + break; + if current_scanner.preproc_pattern<>'OR' then + break; + + val(hs1,l1,w); + if l1<>0 then + eval:= false; {Short circuit evaluation of OR} + + if eval then + begin + {Check if first expr is boolean. Must be done here, after we know + it is an OR expression.} + if not (ctetBoolean in simpleExprType) then + CTEError(simpleExprType, [ctetBoolean], 'OR'); + simpleExprType:= [ctetBoolean]; + end; + + preproc_consume(_ID); + hs2:=read_term(simpleExprType2, eval); + + if eval then + begin + if not (ctetBoolean in simpleExprType2) then + CTEError(simpleExprType2, [ctetBoolean], 'OR'); + + val(hs2,l2,w); + if (l1<>0) or (l2<>0) then + hs1:='1' + else + hs1:='0'; + end; + until false; + read_simple_expr:=hs1; + end; + + function read_expr(var exprType: TCTETypeSet; eval : Boolean) : string; + var + hs1,hs2 : string; + b : boolean; + op : ttoken; + w : integer; + l1,l2 : longint; + exprType2: TCTETypeSet; + begin + hs1:=read_simple_expr(exprType, eval); + op:=current_scanner.preproc_token; + if (op = _ID) and (current_scanner.preproc_pattern = 'IN') then + op := _IN; + if not (op in [_IN,_EQ,_NE,_LT,_GT,_LTE,_GTE]) then + begin + read_expr:=hs1; + exit; + end; + + if (op = _IN) then + preproc_consume(_ID) + else + preproc_consume(op); + hs2:=read_simple_expr(exprType2, eval); + + if eval then + begin + if op = _IN then + begin + if exprType2 <> [ctetSet] then + CTEError(exprType2, [ctetSet], 'IN'); + if exprType = [ctetSet] then + CTEError(exprType, setelementdefs, 'IN'); + + if is_number(hs1) and is_number(hs2) then + Message(scan_e_preproc_syntax_error) + else if hs2[1] = ',' then + b:=pos(','+hs1+',', hs2) > 0 { TODO For integer sets, perhaps check for numeric equivalence so that 0 = 00 } + else + Message(scan_e_preproc_syntax_error); + end + else + begin + if (exprType * exprType2) = [] then + CTEError(exprType2, exprType, '"'+hs1+' '+tokeninfo^[op].str+' '+hs2+'"'); + + if is_number(hs1) and is_number(hs2) then + begin + val(hs1,l1,w); + val(hs2,l2,w); + case op of + _EQ : + b:=l1=l2; + _NE : + b:=l1<>l2; + _LT : + b:=l1<l2; + _GT : + b:=l1>l2; + _GTE : + b:=l1>=l2; + _LTE : + b:=l1<=l2; + end; + end + else + begin + case op of + _EQ: + b:=hs1=hs2; + _NE : + b:=hs1<>hs2; + _LT : + b:=hs1<hs2; + _GT : + b:=hs1>hs2; + _GTE : + b:=hs1>=hs2; + _LTE : + b:=hs1<=hs2; + end; + end; + end; + end + else + b:= false; {Just to have something} + + if b then + read_expr:='1' + else + read_expr:='0'; + exprType:= [ctetBoolean]; + end; + + begin + current_scanner.skipspace; + { start preproc expression scanner } + current_scanner.preproc_token:=current_scanner.readpreproc; + parse_compiler_expr:=read_expr(compileExprType, true); + end; + + function boolean_compile_time_expr(var valuedescr: String): Boolean; + var + hs : string; + exprType: TCTETypeSet; + begin + hs:=parse_compiler_expr(exprType); + if (exprType * [ctetBoolean]) = [] then + CTEError(exprType, [ctetBoolean], 'IF or ELSEIF'); + boolean_compile_time_expr:= hs <> '0'; + valuedescr:= hs; + end; + + procedure dir_if; + begin + current_scanner.ifpreprocstack(pp_if,@boolean_compile_time_expr, scan_c_if_found); + end; + + procedure dir_elseif; + begin + current_scanner.elseifpreprocstack(@boolean_compile_time_expr); + end; + + procedure dir_define_impl(macstyle: boolean); + var + hs : string; + bracketcount : longint; + mac : tmacro; + macropos : longint; + macrobuffer : pmacrobuffer; + begin + current_scanner.skipspace; + hs:=current_scanner.readid; + mac:=tmacro(search_macro(hs)); + if not assigned(mac) or (mac.owner <> current_module.localmacrosymtable) then + begin + mac:=tmacro.create(hs); + mac.defined:=true; + current_module.localmacrosymtable.insert(mac); + end + else + begin + mac.defined:=true; + mac.is_compiler_var:=false; + { delete old definition } + if assigned(mac.buftext) then + begin + freemem(mac.buftext,mac.buflen); + mac.buftext:=nil; + end; + end; + Message1(parser_c_macro_defined,mac.name); + mac.is_used:=true; + if (cs_support_macro in current_settings.moduleswitches) then + begin + current_scanner.skipspace; + + if not macstyle then + begin + { may be a macro? } + if c <> ':' then + exit; + current_scanner.readchar; + if c <> '=' then + exit; + current_scanner.readchar; + current_scanner.skipspace; + end; + + { key words are never substituted } + if is_keyword(hs) then + Message(scan_e_keyword_cant_be_a_macro); + + new(macrobuffer); + macropos:=0; + { parse macro, brackets are counted so it's possible + to have a $ifdef etc. in the macro } + bracketcount:=0; + repeat + case c of + '}' : + if (bracketcount=0) then + break + else + dec(bracketcount); + '{' : + inc(bracketcount); + #10,#13 : + current_scanner.linebreak; + #26 : + current_scanner.end_of_file; + end; + macrobuffer^[macropos]:=c; + inc(macropos); + if macropos>=maxmacrolen then + Message(scan_f_macro_buffer_overflow); + current_scanner.readchar; + until false; + + { free buffer of macro ?} + if assigned(mac.buftext) then + freemem(mac.buftext,mac.buflen); + { get new mem } + getmem(mac.buftext,macropos); + mac.buflen:=macropos; + { copy the text } + move(macrobuffer^,mac.buftext^,macropos); + dispose(macrobuffer); + end + else + begin + { check if there is an assignment, then we need to give a + warning } + current_scanner.skipspace; + if c=':' then + begin + current_scanner.readchar; + if c='=' then + Message(scan_w_macro_support_turned_off); + end; + end; + end; + + procedure dir_define; + begin + dir_define_impl(false); + end; + + procedure dir_definec; + begin + dir_define_impl(true); + end; + + procedure dir_setc; + var + hs : string; + mac : tmacro; + exprType: TCTETypeSet; + l : longint; + w : integer; + begin + current_scanner.skipspace; + hs:=current_scanner.readid; + mac:=tmacro(search_macro(hs)); + if not assigned(mac) or + (mac.owner <> current_module.localmacrosymtable) then + begin + mac:=tmacro.create(hs); + mac.defined:=true; + mac.is_compiler_var:=true; + current_module.localmacrosymtable.insert(mac); + end + else + begin + mac.defined:=true; + mac.is_compiler_var:=true; + { delete old definition } + if assigned(mac.buftext) then + begin + freemem(mac.buftext,mac.buflen); + mac.buftext:=nil; + end; + end; + Message1(parser_c_macro_defined,mac.name); + mac.is_used:=true; + + { key words are never substituted } + if is_keyword(hs) then + Message(scan_e_keyword_cant_be_a_macro); + + { macro assignment can be both := and = } + current_scanner.skipspace; + if c=':' then + current_scanner.readchar; + if c='=' then + begin + current_scanner.readchar; + hs:= parse_compiler_expr(exprType); + if (exprType * [ctetBoolean, ctetInteger]) = [] then + CTEError(exprType, [ctetBoolean, ctetInteger], 'SETC'); + + if length(hs) <> 0 then + begin + {If we are absolutely shure it is boolean, translate + to TRUE/FALSE to increase possibility to do future type check} + if exprType = [ctetBoolean] then + begin + val(hs,l,w); + if l<>0 then + hs:='TRUE' + else + hs:='FALSE'; + end; + Message2(parser_c_macro_set_to,mac.name,hs); + { free buffer of macro ?} + if assigned(mac.buftext) then + freemem(mac.buftext,mac.buflen); + { get new mem } + getmem(mac.buftext,length(hs)); + mac.buflen:=length(hs); + { copy the text } + move(hs[1],mac.buftext^,mac.buflen); + end + else + Message(scan_e_preproc_syntax_error); + end + else + Message(scan_e_preproc_syntax_error); + end; + + + procedure dir_undef; + var + hs : string; + mac : tmacro; + begin + current_scanner.skipspace; + hs:=current_scanner.readid; + mac:=tmacro(search_macro(hs)); + if not assigned(mac) or + (mac.owner <> current_module.localmacrosymtable) then + begin + mac:=tmacro.create(hs); + mac.defined:=false; + current_module.localmacrosymtable.insert(mac); + end + else + begin + mac.defined:=false; + mac.is_compiler_var:=false; + { delete old definition } + if assigned(mac.buftext) then + begin + freemem(mac.buftext,mac.buflen); + mac.buftext:=nil; + end; + end; + Message1(parser_c_macro_undefined,mac.name); + mac.is_used:=true; + end; + + procedure dir_include; + + function findincludefile(const path,name:TCmdStr;var foundfile:TCmdStr):boolean; + var + found : boolean; + hpath : TCmdStr; + begin + (* look for the include file + If path was absolute and specified as part of {$I } then + 1. specified path + else + 1. path of current inputfile,current dir + 2. local includepath + 3. global includepath + + -- Check mantis #13461 before changing this *) + found:=false; + foundfile:=''; + hpath:=''; + if path_absolute(path) then + begin + found:=FindFile(name,path,true,foundfile); + end + else + begin + hpath:=current_scanner.inputfile.path^+';'+CurDirRelPath(source_info); + found:=FindFile(path+name, hpath,true,foundfile); + if not found then + found:=current_module.localincludesearchpath.FindFile(path+name,true,foundfile); + if not found then + found:=includesearchpath.FindFile(path+name,true,foundfile); + end; + result:=found; + end; + + var + foundfile : TCmdStr; + path, + name, + hs : tpathstr; + args : string; + hp : tinputfile; + found : boolean; + begin + current_scanner.skipspace; + args:=current_scanner.readcomment; + hs:=GetToken(args,' '); + if hs='' then + exit; + if (hs[1]='%') then + begin + { case insensitive } + hs:=upper(hs); + { remove %'s } + Delete(hs,1,1); + if hs[length(hs)]='%' then + Delete(hs,length(hs),1); + { save old } + path:=hs; + { first check for internal macros } + if hs='TIME' then + hs:=gettimestr + else + if hs='DATE' then + hs:=getdatestr + else + if hs='FILE' then + hs:=current_module.sourcefiles.get_file_name(current_filepos.fileindex) + else + if hs='LINE' then + hs:=tostr(current_filepos.line) + else + if hs='FPCVERSION' then + hs:=version_string + else + if hs='FPCDATE' then + hs:=date_string + else + if hs='FPCTARGET' then + hs:=target_cpu_string + else + if hs='FPCTARGETCPU' then + hs:=target_cpu_string + else + if hs='FPCTARGETOS' then + hs:=target_info.shortname + else + hs:=GetEnvironmentVariable(hs); + if hs='' then + Message1(scan_w_include_env_not_found,path); + { make it a stringconst } + hs:=''''+hs+''''; + current_scanner.insertmacro(path,@hs[1],length(hs), + current_scanner.line_no,current_scanner.inputfile.ref_index); + end + else + begin + hs:=FixFileName(hs); + path:=ExtractFilePath(hs); + name:=ExtractFileName(hs); + { Special case for Delphi compatibility: '*' has to be replaced + by the file name of the current source file. } + if (length(name)>=1) and + (name[1]='*') then + name:=ChangeFileExt(current_module.sourcefiles.get_file_name(current_filepos.fileindex),'')+ExtractFileExt(name); + + { try to find the file } + found:=findincludefile(path,name,foundfile); + if (ExtractFileExt(name)='') then + begin + { try default extensions .inc , .pp and .pas } + if (not found) then + found:=findincludefile(path,ChangeFileExt(name,'.inc'),foundfile); + if (not found) then + found:=findincludefile(path,ChangeFileExt(name,sourceext),foundfile); + if (not found) then + found:=findincludefile(path,ChangeFileExt(name,pasext),foundfile); + end; + if current_scanner.inputfilecount<max_include_nesting then + begin + inc(current_scanner.inputfilecount); + { we need to reread the current char } + dec(current_scanner.inputpointer); + { shutdown current file } + current_scanner.tempcloseinputfile; + { load new file } + hp:=do_openinputfile(foundfile); + current_scanner.addfile(hp); + current_module.sourcefiles.register_file(hp); + if (not found) then + Message1(scan_f_cannot_open_includefile,hs); + if (not current_scanner.openinputfile) then + Message1(scan_f_cannot_open_includefile,hs); + Message1(scan_t_start_include_file,current_scanner.inputfile.path^+current_scanner.inputfile.name^); + current_scanner.reload; + end + else + Message(scan_f_include_deep_ten); + end; + end; + + +{***************************************************************************** + Preprocessor writing +*****************************************************************************} + +{$ifdef PREPROCWRITE} + constructor tpreprocfile.create(const fn:string); + begin + { open outputfile } + assign(f,fn); + {$push}{$I-} + rewrite(f); + {$pop} + if ioresult<>0 then + Comment(V_Fatal,'can''t create file '+fn); + getmem(buf,preprocbufsize); + settextbuf(f,buf^,preprocbufsize); + { reset } + eolfound:=false; + spacefound:=false; + end; + + + destructor tpreprocfile.destroy; + begin + close(f); + freemem(buf,preprocbufsize); + end; + + + procedure tpreprocfile.add(const s:string); + begin + write(f,s); + end; + + procedure tpreprocfile.addspace; + begin + if eolfound then + begin + writeln(f,''); + eolfound:=false; + spacefound:=false; + end + else + if spacefound then + begin + write(f,' '); + spacefound:=false; + end; + end; +{$endif PREPROCWRITE} + + +{***************************************************************************** + TPreProcStack +*****************************************************************************} + + constructor tpreprocstack.create(atyp : preproctyp;a:boolean;n:tpreprocstack); + begin + accept:=a; + typ:=atyp; + next:=n; + end; + +{***************************************************************************** + TReplayStack +*****************************************************************************} + constructor treplaystack.Create(atoken:ttoken;asettings:tsettings; + atokenbuf:tdynamicarray;anext:treplaystack;achange_endian : boolean); + begin + token:=atoken; + settings:=asettings; + tokenbuf:=atokenbuf; + change_endian:=achange_endian; + next:=anext; + end; + +{***************************************************************************** + TDirectiveItem +*****************************************************************************} + + constructor TDirectiveItem.Create(AList:TFPHashObjectList;const n:string;p:tdirectiveproc); + begin + inherited Create(AList,n); + is_conditional:=false; + proc:=p; + end; + + + constructor TDirectiveItem.CreateCond(AList:TFPHashObjectList;const n:string;p:tdirectiveproc); + begin + inherited Create(AList,n); + is_conditional:=true; + proc:=p; + end; + +{**************************************************************************** + TSCANNERFILE + ****************************************************************************} + + constructor tscannerfile.create(const fn:string); + begin + inputfile:=do_openinputfile(fn); + if assigned(current_module) then + current_module.sourcefiles.register_file(inputfile); + { reset localinput } + c:=#0; + inputbuffer:=nil; + inputpointer:=nil; + inputstart:=0; + { reset scanner } + preprocstack:=nil; + replaystack:=nil; + tokenbuf_change_endian:=false; + comment_level:=0; + yylexcount:=0; + block_type:=bt_general; + line_no:=0; + lastlinepos:=0; + lasttokenpos:=0; + nexttokenpos:=0; + lasttoken:=NOTOKEN; + nexttoken:=NOTOKEN; + lastasmgetchar:=#0; + ignoredirectives:=TFPHashList.Create; + in_asm_string:=false; + end; + + + procedure tscannerfile.firstfile; + begin + { load block } + if not openinputfile then + Message1(scan_f_cannot_open_input,inputfile.name^); + reload; + end; + + + destructor tscannerfile.destroy; + begin + if assigned(current_module) and + (current_module.state=ms_compiled) and + (status.errorcount=0) then + checkpreprocstack + else + begin + while assigned(preprocstack) do + poppreprocstack; + end; + while assigned(replaystack) do + popreplaystack; + if not inputfile.closed then + closeinputfile; + ignoredirectives.free; + end; + + + function tscannerfile.openinputfile:boolean; + begin + openinputfile:=inputfile.open; + { load buffer } + inputbuffer:=inputfile.buf; + inputpointer:=inputfile.buf; + inputstart:=inputfile.bufstart; + { line } + line_no:=0; + lastlinepos:=0; + lasttokenpos:=0; + nexttokenpos:=0; + end; + + + procedure tscannerfile.closeinputfile; + begin + inputfile.close; + { reset buffer } + inputbuffer:=nil; + inputpointer:=nil; + inputstart:=0; + { reset line } + line_no:=0; + lastlinepos:=0; + lasttokenpos:=0; + nexttokenpos:=0; + end; + + + function tscannerfile.tempopeninputfile:boolean; + begin + if inputfile.is_macro then + exit; + tempopeninputfile:=inputfile.tempopen; + { reload buffer } + inputbuffer:=inputfile.buf; + inputpointer:=inputfile.buf; + inputstart:=inputfile.bufstart; + end; + + + procedure tscannerfile.tempcloseinputfile; + begin + if inputfile.closed or inputfile.is_macro then + exit; + inputfile.setpos(inputstart+(inputpointer-inputbuffer)); + inputfile.tempclose; + { reset buffer } + inputbuffer:=nil; + inputpointer:=nil; + inputstart:=0; + end; + + + procedure tscannerfile.saveinputfile; + begin + inputfile.saveinputpointer:=inputpointer; + inputfile.savelastlinepos:=lastlinepos; + inputfile.saveline_no:=line_no; + end; + + + procedure tscannerfile.restoreinputfile; + begin + inputbuffer:=inputfile.buf; + inputpointer:=inputfile.saveinputpointer; + lastlinepos:=inputfile.savelastlinepos; + line_no:=inputfile.saveline_no; + if not inputfile.is_macro then + parser_current_file:=inputfile.name^; + end; + + + procedure tscannerfile.nextfile; + var + to_dispose : tinputfile; + begin + if assigned(inputfile.next) then + begin + if inputfile.is_macro then + to_dispose:=inputfile + else + begin + to_dispose:=nil; + dec(inputfilecount); + end; + { we can allways close the file, no ? } + inputfile.close; + inputfile:=inputfile.next; + if assigned(to_dispose) then + to_dispose.free; + restoreinputfile; + end; + end; + + + procedure tscannerfile.startrecordtokens(buf:tdynamicarray); + begin + if not assigned(buf) then + internalerror(200511172); + if assigned(recordtokenbuf) then + internalerror(200511173); + recordtokenbuf:=buf; + fillchar(last_settings,sizeof(last_settings),0); + last_message:=nil; + fillchar(last_filepos,sizeof(last_filepos),0); + end; + + + procedure tscannerfile.stoprecordtokens; + begin + if not assigned(recordtokenbuf) then + internalerror(200511174); + recordtokenbuf:=nil; + end; + + + procedure tscannerfile.writetoken(t : ttoken); + var + b : byte; + begin + if ord(t)>$7f then + begin + b:=(ord(t) shr 8) or $80; + recordtokenbuf.write(b,1); + end; + b:=ord(t) and $ff; + recordtokenbuf.write(b,1); + end; + + procedure tscannerfile.tokenwritesizeint(val : sizeint); + begin + recordtokenbuf.write(val,sizeof(sizeint)); + end; + + function tscannerfile.tokenreadsizeint : sizeint; + var + val : sizeint; + begin + replaytokenbuf.read(val,sizeof(sizeint)); + if tokenbuf_change_endian then + val:=swapendian(val); + result:=val; + end; + + function tscannerfile.tokenreadlongword : longword; + var + val : longword; + begin + replaytokenbuf.read(val,sizeof(longword)); + if tokenbuf_change_endian then + val:=swapendian(val); + result:=val; + end; + + function tscannerfile.tokenreadlongint : longint; + var + val : longint; + begin + replaytokenbuf.read(val,sizeof(longint)); + if tokenbuf_change_endian then + val:=swapendian(val); + result:=val; + end; + + function tscannerfile.tokenreadshortint : shortint; + var + val : shortint; + begin + replaytokenbuf.read(val,sizeof(shortint)); + result:=val; + end; + + function tscannerfile.tokenreadbyte : byte; + var + val : byte; + begin + replaytokenbuf.read(val,sizeof(byte)); + result:=val; + end; + + function tscannerfile.tokenreadsmallint : smallint; + var + val : smallint; + begin + replaytokenbuf.read(val,sizeof(smallint)); + if tokenbuf_change_endian then + val:=swapendian(val); + result:=val; + end; + + function tscannerfile.tokenreadword : word; + var + val : word; + begin + replaytokenbuf.read(val,sizeof(word)); + if tokenbuf_change_endian then + val:=swapendian(val); + result:=val; + end; + + function tscannerfile.tokenreadenum(size : longint) : longword; + begin + if size=1 then + result:=tokenreadbyte + else if size=2 then + result:=tokenreadword + else if size=4 then + result:=tokenreadlongword; + end; + + procedure tscannerfile.tokenreadset(var b;size : longint); + var + i : longint; + begin + replaytokenbuf.read(b,size); + if tokenbuf_change_endian then + for i:=0 to size-1 do + Pbyte(@b)[i]:=reverse_byte(Pbyte(@b)[i]); + end; + + + procedure tscannerfile.tokenreadsettings(var asettings : tsettings; expected_size : longint); + + { This procedure + needs to be changed whenever + globals.tsettings type is changed, + the problem is that no error will appear + before tests with generics are tested. PM } + + var + startpos, endpos : longword; + begin + { WARNING all those fields need to be in the correct + order otherwise cross_endian PPU reading will fail } + startpos:=replaytokenbuf.pos; + with asettings do + begin + alignment.procalign:=tokenreadlongint; + alignment.loopalign:=tokenreadlongint; + alignment.jumpalign:=tokenreadlongint; + alignment.constalignmin:=tokenreadlongint; + alignment.constalignmax:=tokenreadlongint; + alignment.varalignmin:=tokenreadlongint; + alignment.varalignmax:=tokenreadlongint; + alignment.localalignmin:=tokenreadlongint; + alignment.localalignmax:=tokenreadlongint; + alignment.recordalignmin:=tokenreadlongint; + alignment.recordalignmax:=tokenreadlongint; + alignment.maxCrecordalign:=tokenreadlongint; + tokenreadset(globalswitches,sizeof(globalswitches)); + tokenreadset(moduleswitches,sizeof(moduleswitches)); + tokenreadset(localswitches,sizeof(localswitches)); + tokenreadset(modeswitches,sizeof(modeswitches)); + tokenreadset(optimizerswitches,sizeof(optimizerswitches)); + tokenreadset(genwpoptimizerswitches,sizeof(genwpoptimizerswitches)); + tokenreadset(dowpoptimizerswitches,sizeof(dowpoptimizerswitches)); + tokenreadset(debugswitches,sizeof(debugswitches)); + { 0: old behaviour for sets <=256 elements + >0: round to this size } + setalloc:=tokenreadshortint; + packenum:=tokenreadshortint; + + packrecords:=tokenreadshortint; + maxfpuregisters:=tokenreadshortint; + + + cputype:=tcputype(tokenreadenum(sizeof(tcputype))); + optimizecputype:=tcputype(tokenreadenum(sizeof(tcputype))); + fputype:=tfputype(tokenreadenum(sizeof(tfputype))); + asmmode:=tasmmode(tokenreadenum(sizeof(tasmmode))); + interfacetype:=tinterfacetypes(tokenreadenum(sizeof(tinterfacetypes))); + defproccall:=tproccalloption(tokenreadenum(sizeof(tproccalloption))); + { tstringencoding is word type, + thus this should be OK here } + sourcecodepage:=tstringEncoding(tokenreadword); + + minfpconstprec:=tfloattype(tokenreadenum(sizeof(tfloattype))); + + disabledircache:=boolean(tokenreadbyte); +{$if defined(ARM) or defined(AVR)} + controllertype:=tcontrollertype(tokenreadenum(sizeof(tcontrollertype))); +{$endif defined(ARM) or defined(AVR)} + endpos:=replaytokenbuf.pos; + if endpos-startpos<>expected_size then + Comment(V_Error,'Wrong size of Settings read-in'); + end; + end; + + + procedure tscannerfile.recordtoken; + var + t : ttoken; + s : tspecialgenerictoken; + len,val,msgnb,copy_size : sizeint; + b : byte; + pmsg : pmessagestaterecord; + begin + if not assigned(recordtokenbuf) then + internalerror(200511176); + t:=_GENERICSPECIALTOKEN; + { settings changed? } + { last field pmessage is handled separately below in + ST_LOADMESSAGES } + if CompareByte(current_settings,last_settings, + sizeof(current_settings)-sizeof(pointer))<>0 then + begin + { use a special token to record it } + s:=ST_LOADSETTINGS; + writetoken(t); + recordtokenbuf.write(s,1); + copy_size:=sizeof(current_settings)-sizeof(pointer); + tokenwritesizeint(copy_size); + recordtokenbuf.write(current_settings,copy_size); + last_settings:=current_settings; + end; + + if current_settings.pmessage<>last_message then + begin + { use a special token to record it } + s:=ST_LOADMESSAGES; + writetoken(t); + recordtokenbuf.write(s,1); + msgnb:=0; + pmsg:=current_settings.pmessage; + while assigned(pmsg) do + begin + if msgnb=high(sizeint) then + { Too many messages } + internalerror(2011090401); + inc(msgnb); + pmsg:=pmsg^.next; + end; + tokenwritesizeint(msgnb); + pmsg:=current_settings.pmessage; + while assigned(pmsg) do + begin + { What about endianess here? } + val:=pmsg^.value; + tokenwritesizeint(val); + val:=ord(pmsg^.state); + tokenwritesizeint(val); + pmsg:=pmsg^.next; + end; + last_message:=current_settings.pmessage; + end; + + { file pos changes? } + if current_tokenpos.line<>last_filepos.line then + begin + s:=ST_LINE; + writetoken(t); + recordtokenbuf.write(s,1); + recordtokenbuf.write(current_tokenpos.line,sizeof(current_tokenpos.line)); + last_filepos.line:=current_tokenpos.line; + end; + if current_tokenpos.column<>last_filepos.column then + begin + s:=ST_COLUMN; + writetoken(t); + { can the column be written packed? } + if current_tokenpos.column<$80 then + begin + b:=$80 or current_tokenpos.column; + recordtokenbuf.write(b,1); + end + else + begin + recordtokenbuf.write(s,1); + recordtokenbuf.write(current_tokenpos.column,sizeof(current_tokenpos.column)); + end; + last_filepos.column:=current_tokenpos.column; + end; + if current_tokenpos.fileindex<>last_filepos.fileindex then + begin + s:=ST_FILEINDEX; + writetoken(t); + recordtokenbuf.write(s,1); + recordtokenbuf.write(current_tokenpos.fileindex,sizeof(current_tokenpos.fileindex)); + last_filepos.fileindex:=current_tokenpos.fileindex; + end; + + writetoken(token); + if token<>_GENERICSPECIALTOKEN then + writetoken(idtoken); + case token of + _CWCHAR, + _CWSTRING : + begin + tokenwritesizeint(patternw^.len); + recordtokenbuf.write(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar)); + end; + _CSTRING: + begin + len:=length(cstringpattern); + tokenwritesizeint(len); + recordtokenbuf.write(cstringpattern[1],length(cstringpattern)); + end; + _CCHAR, + _INTCONST, + _REALNUMBER : + begin + { pexpr.pas messes with pattern in case of negative integer consts, + see around line 2562 the comment of JM; remove the - before recording it + (FK) + } + if (token=_INTCONST) and (pattern[1]='-') then + delete(pattern,1,1); + recordtokenbuf.write(pattern[0],1); + recordtokenbuf.write(pattern[1],length(pattern)); + end; + _ID : + begin + recordtokenbuf.write(orgpattern[0],1); + recordtokenbuf.write(orgpattern[1],length(orgpattern)); + end; + end; + end; + + + procedure tscannerfile.startreplaytokens(buf:tdynamicarray; achange_endian : boolean); + begin + if not assigned(buf) then + internalerror(200511175); + { save current token } + if token in [_CWCHAR,_CWSTRING,_CCHAR,_CSTRING,_INTCONST,_REALNUMBER,_ID] then + internalerror(200511178); + replaystack:=treplaystack.create(token,current_settings, + replaytokenbuf,replaystack,tokenbuf_change_endian); + if assigned(inputpointer) then + dec(inputpointer); + { install buffer } + replaytokenbuf:=buf; + tokenbuf_change_endian:=achange_endian; + + { reload next token } + replaytokenbuf.seek(0); + replaytoken; + end; + + + function tscannerfile.readtoken: ttoken; + var + b,b2 : byte; + begin + replaytokenbuf.read(b,1); + if (b and $80)<>0 then + begin + replaytokenbuf.read(b2,1); + result:=ttoken(((b and $7f) shl 8) or b2); + end + else + result:=ttoken(b); + end; + + + procedure tscannerfile.replaytoken; + var + wlen,mesgnb,copy_size : sizeint; + specialtoken : tspecialgenerictoken; + i : byte; + pmsg,prevmsg : pmessagestaterecord; + begin + if not assigned(replaytokenbuf) then + internalerror(200511177); + { End of replay buffer? Then load the next char from the file again } + if replaytokenbuf.pos>=replaytokenbuf.size then + begin + token:=replaystack.token; + replaytokenbuf:=replaystack.tokenbuf; + { restore compiler settings } + current_settings:=replaystack.settings; + popreplaystack; + if assigned(inputpointer) then + begin + c:=inputpointer^; + inc(inputpointer); + end; + exit; + end; + repeat + { load token from the buffer } + token:=readtoken; + if token<>_GENERICSPECIALTOKEN then + idtoken:=readtoken + else + idtoken:=_NOID; + case token of + _CWCHAR, + _CWSTRING : + begin + wlen:=tokenreadsizeint; + setlengthwidestring(patternw,wlen); + replaytokenbuf.read(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar)); + orgpattern:=''; + pattern:=''; + cstringpattern:=''; + end; + _CSTRING: + begin + wlen:=tokenreadsizeint; + setlength(cstringpattern,wlen); + replaytokenbuf.read(cstringpattern[1],wlen); + orgpattern:=''; + pattern:=''; + end; + _CCHAR, + _INTCONST, + _REALNUMBER : + begin + replaytokenbuf.read(pattern[0],1); + replaytokenbuf.read(pattern[1],length(pattern)); + orgpattern:=''; + end; + _ID : + begin + replaytokenbuf.read(orgpattern[0],1); + replaytokenbuf.read(orgpattern[1],length(orgpattern)); + pattern:=upper(orgpattern); + end; + _GENERICSPECIALTOKEN: + begin + replaytokenbuf.read(specialtoken,1); + { packed column? } + if (ord(specialtoken) and $80)<>0 then + begin + current_tokenpos.column:=ord(specialtoken) and $7f; + + { don't generate invalid line info if no sources are available for the current module } + if not(get_module(current_filepos.moduleindex).sources_avail) then + current_tokenpos.column:=0; + + current_filepos:=current_tokenpos; + end + else + case specialtoken of + ST_LOADSETTINGS: + begin + copy_size:=tokenreadsizeint; + if copy_size <> sizeof(current_settings)-sizeof(pointer) then + internalerror(2011090501); + { + replaytokenbuf.read(current_settings,copy_size); + } + tokenreadsettings(current_settings,copy_size); + end; + ST_LOADMESSAGES: + begin + current_settings.pmessage:=nil; + mesgnb:=tokenreadsizeint; + if mesgnb>0 then + Comment(V_Error,'Message recordind not yet supported'); + for i:=1 to mesgnb do + begin + new(pmsg); + if i=1 then + begin + current_settings.pmessage:=pmsg; + prevmsg:=nil; + end + else + prevmsg^.next:=pmsg; + replaytokenbuf.read(pmsg^.value,sizeof(longint)); + replaytokenbuf.read(pmsg^.state,sizeof(tmsgstate)); + pmsg^.next:=nil; + prevmsg:=pmsg; + end; + end; + ST_LINE: + begin + current_tokenpos.line:=tokenreadlongint; + + { don't generate invalid line info if no sources are available for the current module } + if not(get_module(current_filepos.moduleindex).sources_avail) then + current_tokenpos.line:=0; + + current_filepos:=current_tokenpos; + end; + ST_COLUMN: + begin + current_tokenpos.column:=tokenreadword; + { don't generate invalid line info if no sources are available for the current module } + if not(get_module(current_filepos.moduleindex).sources_avail) then + current_tokenpos.column:=0; + + current_filepos:=current_tokenpos; + end; + ST_FILEINDEX: + begin + current_tokenpos.fileindex:=tokenreadword; + { don't generate invalid line info if no sources are available for the current module } + if not(get_module(current_filepos.moduleindex).sources_avail) then + begin + current_tokenpos.column:=0; + current_tokenpos.line:=0; + end; + + current_filepos:=current_tokenpos; + end; + else + internalerror(2006103010); + end; + continue; + end; + end; + break; + until false; + end; + + + procedure tscannerfile.addfile(hp:tinputfile); + begin + saveinputfile; + { add to list } + hp.next:=inputfile; + inputfile:=hp; + { load new inputfile } + restoreinputfile; + end; + + + procedure tscannerfile.reload; + begin + with inputfile do + begin + { when nothing more to read then leave immediatly, so we + don't change the current_filepos and leave it point to the last + char } + if (c=#26) and (not assigned(next)) then + exit; + repeat + { still more to read?, then change the #0 to a space so its seen + as a seperator, this can't be used for macro's which can change + the place of the #0 in the buffer with tempopen } + if (c=#0) and (bufsize>0) and + not(inputfile.is_macro) and + (inputpointer-inputbuffer<bufsize) then + begin + c:=' '; + inc(inputpointer); + exit; + end; + { can we read more from this file ? } + if (c<>#26) and (not endoffile) then + begin + readbuf; + inputpointer:=buf; + inputbuffer:=buf; + inputstart:=bufstart; + { first line? } + if line_no=0 then + begin + c:=inputpointer^; + { eat utf-8 signature? } + if (ord(inputpointer^)=$ef) and + (ord((inputpointer+1)^)=$bb) and + (ord((inputpointer+2)^)=$bf) then + begin + inc(inputpointer,3); + message(scan_c_switching_to_utf8); + current_settings.sourcecodepage:=CP_UTF8; + include(current_settings.moduleswitches,cs_explicit_codepage); + end; + + line_no:=1; + if cs_asm_source in current_settings.globalswitches then + inputfile.setline(line_no,inputstart+inputpointer-inputbuffer); + end; + end + else + begin + { load eof position in tokenpos/current_filepos } + gettokenpos; + { close file } + closeinputfile; + { no next module, than EOF } + if not assigned(inputfile.next) then + begin + c:=#26; + exit; + end; + { load next file and reopen it } + nextfile; + tempopeninputfile; + { status } + Message1(scan_t_back_in,inputfile.name^); + end; + { load next char } + c:=inputpointer^; + inc(inputpointer); + until c<>#0; { if also end, then reload again } + end; + end; + + + procedure tscannerfile.insertmacro(const macname:string;p:pchar;len,line,fileindex:longint); + var + hp : tinputfile; + begin + { save old postion } + dec(inputpointer); + tempcloseinputfile; + { create macro 'file' } + { use special name to dispose after !! } + hp:=do_openinputfile('_Macro_.'+macname); + addfile(hp); + with inputfile do + begin + setmacro(p,len); + { local buffer } + inputbuffer:=buf; + inputpointer:=buf; + inputstart:=bufstart; + ref_index:=fileindex; + end; + { reset line } + line_no:=line; + lastlinepos:=0; + lasttokenpos:=0; + nexttokenpos:=0; + { load new c } + c:=inputpointer^; + inc(inputpointer); + end; + + + procedure tscannerfile.do_gettokenpos(out tokenpos: longint; out filepos: tfileposinfo); + begin + tokenpos:=inputstart+(inputpointer-inputbuffer); + filepos.line:=line_no; + filepos.column:=tokenpos-lastlinepos; + filepos.fileindex:=inputfile.ref_index; + filepos.moduleindex:=current_module.unit_index; + end; + + + procedure tscannerfile.gettokenpos; + { load the values of tokenpos and lasttokenpos } + begin + do_gettokenpos(lasttokenpos,current_tokenpos); + current_filepos:=current_tokenpos; + end; + + + procedure tscannerfile.cachenexttokenpos; + begin + do_gettokenpos(nexttokenpos,next_filepos); + end; + + + procedure tscannerfile.setnexttoken; + begin + token:=nexttoken; + nexttoken:=NOTOKEN; + lasttokenpos:=nexttokenpos; + current_tokenpos:=next_filepos; + current_filepos:=current_tokenpos; + nexttokenpos:=0; + end; + + + procedure tscannerfile.savetokenpos; + begin + oldlasttokenpos:=lasttokenpos; + oldcurrent_filepos:=current_filepos; + oldcurrent_tokenpos:=current_tokenpos; + end; + + + procedure tscannerfile.restoretokenpos; + begin + lasttokenpos:=oldlasttokenpos; + current_filepos:=oldcurrent_filepos; + current_tokenpos:=oldcurrent_tokenpos; + end; + + + procedure tscannerfile.inc_comment_level; + begin + if (m_nested_comment in current_settings.modeswitches) then + inc(comment_level) + else + comment_level:=1; + if (comment_level>1) then + begin + savetokenpos; + gettokenpos; { update for warning } + Message1(scan_w_comment_level,tostr(comment_level)); + restoretokenpos; + end; + end; + + + procedure tscannerfile.dec_comment_level; + begin + if (m_nested_comment in current_settings.modeswitches) then + dec(comment_level) + else + comment_level:=0; + end; + + + procedure tscannerfile.linebreak; + var + cur : char; + begin + with inputfile do + begin + if (byte(inputpointer^)=0) and not(endoffile) then + begin + cur:=c; + reload; + if byte(cur)+byte(c)<>23 then + dec(inputpointer); + end + else + begin + { Support all combination of #10 and #13 as line break } + if (byte(inputpointer^)+byte(c)=23) then + inc(inputpointer); + end; + { Always return #10 as line break } + c:=#10; + { increase line counters } + lastlinepos:=inputstart+(inputpointer-inputbuffer); + inc(line_no); + { update linebuffer } + if cs_asm_source in current_settings.globalswitches then + inputfile.setline(line_no,lastlinepos); + { update for status and call the show status routine, + but don't touch current_filepos ! } + savetokenpos; + gettokenpos; { update for v_status } + inc(status.compiledlines); + ShowStatus; + restoretokenpos; + end; + end; + + + procedure tscannerfile.illegal_char(c:char); + var + s : string; + begin + if c in [#32..#255] then + s:=''''+c+'''' + else + s:='#'+tostr(ord(c)); + Message2(scan_f_illegal_char,s,'$'+hexstr(ord(c),2)); + end; + + + procedure tscannerfile.end_of_file; + begin + checkpreprocstack; + Message(scan_f_end_of_file); + end; + + {------------------------------------------- + IF Conditional Handling + -------------------------------------------} + + procedure tscannerfile.checkpreprocstack; + begin + { check for missing ifdefs } + while assigned(preprocstack) do + begin + Message4(scan_e_endif_expected,preprocstring[preprocstack.typ],preprocstack.name, + preprocstack.owner.inputfile.name^,tostr(preprocstack.line_nb)); + poppreprocstack; + end; + end; + + + procedure tscannerfile.poppreprocstack; + var + hp : tpreprocstack; + begin + if assigned(preprocstack) then + begin + Message1(scan_c_endif_found,preprocstack.name); + hp:=preprocstack.next; + preprocstack.free; + preprocstack:=hp; + end + else + Message(scan_e_endif_without_if); + end; + + + procedure tscannerfile.ifpreprocstack(atyp : preproctyp;compile_time_predicate:tcompile_time_predicate;messid:longint); + var + condition: Boolean; + valuedescr: String; + begin + if (preprocstack=nil) or preprocstack.accept then + condition:= compile_time_predicate(valuedescr) + else + begin + condition:= false; + valuedescr:= ''; + end; + preprocstack:=tpreprocstack.create(atyp, condition, preprocstack); + preprocstack.name:=valuedescr; + preprocstack.line_nb:=line_no; + preprocstack.owner:=self; + if preprocstack.accept then + Message2(messid,preprocstack.name,'accepted') + else + Message2(messid,preprocstack.name,'rejected'); + end; + + procedure tscannerfile.elsepreprocstack; + begin + if assigned(preprocstack) and + (preprocstack.typ<>pp_else) then + begin + if (preprocstack.typ=pp_elseif) then + preprocstack.accept:=false + else + if (not(assigned(preprocstack.next)) or (preprocstack.next.accept)) then + preprocstack.accept:=not preprocstack.accept; + preprocstack.typ:=pp_else; + preprocstack.line_nb:=line_no; + if preprocstack.accept then + Message2(scan_c_else_found,preprocstack.name,'accepted') + else + Message2(scan_c_else_found,preprocstack.name,'rejected'); + end + else + Message(scan_e_endif_without_if); + end; + + procedure tscannerfile.elseifpreprocstack(compile_time_predicate:tcompile_time_predicate); + var + valuedescr: String; + begin + if assigned(preprocstack) and + (preprocstack.typ in [pp_if,pp_elseif]) then + begin + { when the branch is accepted we use pp_elseif so we know that + all the next branches need to be rejected. when this branch is still + not accepted then leave it at pp_if } + if (preprocstack.typ=pp_elseif) then + preprocstack.accept:=false + else if (preprocstack.typ=pp_if) and preprocstack.accept then + begin + preprocstack.accept:=false; + preprocstack.typ:=pp_elseif; + end + else if (not(assigned(preprocstack.next)) or (preprocstack.next.accept)) + and compile_time_predicate(valuedescr) then + begin + preprocstack.name:=valuedescr; + preprocstack.accept:=true; + preprocstack.typ:=pp_elseif; + end; + + preprocstack.line_nb:=line_no; + if preprocstack.accept then + Message2(scan_c_else_found,preprocstack.name,'accepted') + else + Message2(scan_c_else_found,preprocstack.name,'rejected'); + end + else + Message(scan_e_endif_without_if); + end; + + + procedure tscannerfile.popreplaystack; + var + hp : treplaystack; + begin + if assigned(replaystack) then + begin + hp:=replaystack.next; + replaystack.free; + replaystack:=hp; + if assigned (replaystack) then + tokenbuf_change_endian:=replaystack.change_endian + else + tokenbuf_change_endian:=false; + end; + end; + + procedure tscannerfile.handleconditional(p:tdirectiveitem); + begin + savetokenpos; + repeat + current_scanner.gettokenpos; + p.proc(); + { accept the text ? } + if (current_scanner.preprocstack=nil) or current_scanner.preprocstack.accept then + break + else + begin + current_scanner.gettokenpos; + Message(scan_c_skipping_until); + repeat + current_scanner.skipuntildirective; + if not (m_mac in current_settings.modeswitches) then + p:=tdirectiveitem(turbo_scannerdirectives.Find(current_scanner.readid)) + else + p:=tdirectiveitem(mac_scannerdirectives.Find(current_scanner.readid)); + until assigned(p) and (p.is_conditional); + current_scanner.gettokenpos; + Message1(scan_d_handling_switch,'$'+p.name); + end; + until false; + restoretokenpos; + end; + + + procedure tscannerfile.handledirectives; + var + t : tdirectiveitem; + hs : string; + begin + gettokenpos; + readchar; {Remove the $} + hs:=readid; + { handle empty directive } + if hs='' then + begin + Message1(scan_w_illegal_switch,'$'); + exit; + end; +{$ifdef PREPROCWRITE} + if parapreprocess then + begin + t:=Get_Directive(hs); + if not(is_conditional(t) or (t=_DIR_DEFINE) or (t=_DIR_UNDEF)) then + begin + preprocfile^.AddSpace; + preprocfile^.Add('{$'+hs+current_scanner.readcomment+'}'); + exit; + end; + end; +{$endif PREPROCWRITE} + { skip this directive? } + if (ignoredirectives.find(hs)<>nil) then + begin + if (comment_level>0) then + readcomment; + { we've read the whole comment } + aktcommentstyle:=comment_none; + exit; + end; + { Check for compiler switches } + while (length(hs)=1) and (c in ['-','+']) do + begin + HandleSwitch(hs[1],c); + current_scanner.readchar; {Remove + or -} + if c=',' then + begin + current_scanner.readchar; {Remove , } + { read next switch, support $v+,$+} + hs:=current_scanner.readid; + if (hs='') then + begin + if (c='$') and (m_fpc in current_settings.modeswitches) then + begin + current_scanner.readchar; { skip $ } + hs:=current_scanner.readid; + end; + if (hs='') then + Message1(scan_w_illegal_directive,'$'+c); + end + else + Message1(scan_d_handling_switch,'$'+hs); + end + else + hs:=''; + end; + { directives may follow switches after a , } + if hs<>'' then + begin + if not (m_mac in current_settings.modeswitches) then + t:=tdirectiveitem(turbo_scannerdirectives.Find(hs)) + else + t:=tdirectiveitem(mac_scannerdirectives.Find(hs)); + + if assigned(t) then + begin + if t.is_conditional then + handleconditional(t) + else + begin + Message1(scan_d_handling_switch,'$'+hs); + t.proc(); + end; + end + else + begin + current_scanner.ignoredirectives.Add(hs,nil); + Message1(scan_w_illegal_directive,'$'+hs); + end; + { conditionals already read the comment } + if (current_scanner.comment_level>0) then + current_scanner.readcomment; + { we've read the whole comment } + aktcommentstyle:=comment_none; + end; + end; + + + procedure tscannerfile.readchar; + begin + c:=inputpointer^; + if c=#0 then + reload + else + inc(inputpointer); + end; + + + procedure tscannerfile.readstring; + var + i : longint; + err : boolean; + begin + err:=false; + i:=0; + repeat + case c of + '_', + '0'..'9', + 'A'..'Z' : + begin + if i<255 then + begin + inc(i); + orgpattern[i]:=c; + pattern[i]:=c; + end + else + begin + if not err then + begin + Message(scan_e_string_exceeds_255_chars); + err:=true; + end; + end; + c:=inputpointer^; + inc(inputpointer); + end; + 'a'..'z' : + begin + if i<255 then + begin + inc(i); + orgpattern[i]:=c; + pattern[i]:=chr(ord(c)-32) + end + else + begin + if not err then + begin + Message(scan_e_string_exceeds_255_chars); + err:=true; + end; + end; + c:=inputpointer^; + inc(inputpointer); + end; + #0 : + reload; + else + break; + end; + until false; + orgpattern[0]:=chr(i); + pattern[0]:=chr(i); + end; + + + procedure tscannerfile.readnumber; + var + base, + i : longint; + begin + case c of + '%' : + begin + readchar; + base:=2; + pattern[1]:='%'; + i:=1; + end; + '&' : + begin + readchar; + base:=8; + pattern[1]:='&'; + i:=1; + end; + '$' : + begin + readchar; + base:=16; + pattern[1]:='$'; + i:=1; + end; + else + begin + base:=10; + i:=0; + end; + end; + while ((base>=10) and (c in ['0'..'9'])) or + ((base=16) and (c in ['A'..'F','a'..'f'])) or + ((base=8) and (c in ['0'..'7'])) or + ((base=2) and (c in ['0'..'1'])) do + begin + if i<255 then + begin + inc(i); + pattern[i]:=c; + end; + readchar; + end; + pattern[0]:=chr(i); + end; + + + function tscannerfile.readid:string; + begin + readstring; + readid:=pattern; + end; + + + function tscannerfile.readval:longint; + var + l : longint; + w : integer; + begin + readnumber; + val(pattern,l,w); + readval:=l; + end; + + + function tscannerfile.readval_asstring:string; + begin + readnumber; + readval_asstring:=pattern; + end; + + + function tscannerfile.readcomment:string; + var + i : longint; + begin + i:=0; + repeat + case c of + '{' : + begin + if aktcommentstyle=comment_tp then + inc_comment_level; + end; + '}' : + begin + if aktcommentstyle=comment_tp then + begin + readchar; + dec_comment_level; + if comment_level=0 then + break + else + continue; + end; + end; + '*' : + begin + if aktcommentstyle=comment_oldtp then + begin + readchar; + if c=')' then + begin + readchar; + dec_comment_level; + break; + end + else + { Add both characters !!} + if (i<255) then + begin + inc(i); + readcomment[i]:='*'; + if (i<255) then + begin + inc(i); + readcomment[i]:=c; + end; + end; + end + else + { Not old TP comment, so add...} + begin + if (i<255) then + begin + inc(i); + readcomment[i]:='*'; + end; + end; + end; + #10,#13 : + linebreak; + #26 : + end_of_file; + else + begin + if (i<255) then + begin + inc(i); + readcomment[i]:=c; + end; + end; + end; + readchar; + until false; + readcomment[0]:=chr(i); + end; + + + function tscannerfile.readquotedstring:string; + var + i : longint; + msgwritten : boolean; + begin + i:=0; + msgwritten:=false; + if (c='''') then + begin + repeat + readchar; + case c of + #26 : + end_of_file; + #10,#13 : + Message(scan_f_string_exceeds_line); + '''' : + begin + readchar; + if c<>'''' then + break; + end; + end; + if i<255 then + begin + inc(i); + result[i]:=c; + end + else + begin + if not msgwritten then + begin + Message(scan_e_string_exceeds_255_chars); + msgwritten:=true; + end; + end; + until false; + end; + result[0]:=chr(i); + end; + + + function tscannerfile.readstate:char; + var + state : char; + begin + state:=' '; + if c=' ' then + begin + current_scanner.skipspace; + current_scanner.readid; + if pattern='ON' then + state:='+' + else + if pattern='OFF' then + state:='-'; + end + else + state:=c; + if not (state in ['+','-']) then + Message(scan_e_wrong_switch_toggle); + readstate:=state; + end; + + + function tscannerfile.readstatedefault:char; + var + state : char; + begin + state:=' '; + if c=' ' then + begin + current_scanner.skipspace; + current_scanner.readid; + if pattern='ON' then + state:='+' + else + if pattern='OFF' then + state:='-' + else + if pattern='DEFAULT' then + state:='*'; + end + else + state:=c; + if not (state in ['+','-','*']) then + Message(scan_e_wrong_switch_toggle_default); + readstatedefault:=state; + end; + + + procedure tscannerfile.skipspace; + begin + repeat + case c of + #26 : + begin + reload; + if (c=#26) and not assigned(inputfile.next) then + break; + continue; + end; + #10, + #13 : + linebreak; + #9,#11,#12,' ' : + ; + else + break; + end; + readchar; + until false; + end; + + + procedure tscannerfile.skipuntildirective; + var + found : longint; + next_char_loaded : boolean; + begin + found:=0; + next_char_loaded:=false; + repeat + case c of + #10, + #13 : + linebreak; + #26 : + begin + reload; + if (c=#26) and not assigned(inputfile.next) then + end_of_file; + continue; + end; + '{' : + begin + if (aktcommentstyle in [comment_tp,comment_none]) then + begin + aktcommentstyle:=comment_tp; + if (comment_level=0) then + found:=1; + inc_comment_level; + end; + end; + '*' : + begin + if (aktcommentstyle=comment_oldtp) then + begin + readchar; + if c=')' then + begin + dec_comment_level; + found:=0; + aktcommentstyle:=comment_none; + end + else + next_char_loaded:=true; + end + else + found := 0; + end; + '}' : + begin + if (aktcommentstyle=comment_tp) then + begin + dec_comment_level; + if (comment_level=0) then + aktcommentstyle:=comment_none; + found:=0; + end; + end; + '$' : + begin + if found=1 then + found:=2; + end; + '''' : + if (aktcommentstyle=comment_none) then + begin + repeat + readchar; + case c of + #26 : + end_of_file; + #10,#13 : + break; + '''' : + begin + readchar; + if c<>'''' then + begin + next_char_loaded:=true; + break; + end; + end; + end; + until false; + end; + '(' : + begin + if (aktcommentstyle=comment_none) then + begin + readchar; + if c='*' then + begin + readchar; + if c='$' then + begin + found:=2; + inc_comment_level; + aktcommentstyle:=comment_oldtp; + end + else + begin + skipoldtpcomment; + next_char_loaded:=true; + end; + end + else + next_char_loaded:=true; + end + else + found:=0; + end; + '/' : + begin + if (aktcommentstyle=comment_none) then + begin + readchar; + if c='/' then + skipdelphicomment; + next_char_loaded:=true; + end + else + found:=0; + end; + else + found:=0; + end; + if next_char_loaded then + next_char_loaded:=false + else + readchar; + until (found=2); + end; + + +{**************************************************************************** + Comment Handling +****************************************************************************} + + procedure tscannerfile.skipcomment; + begin + aktcommentstyle:=comment_tp; + readchar; + inc_comment_level; + { handle compiler switches } + if (c='$') then + handledirectives; + { handle_switches can dec comment_level, } + while (comment_level>0) do + begin + case c of + '{' : + inc_comment_level; + '}' : + dec_comment_level; + #10,#13 : + linebreak; + #26 : + begin + reload; + if (c=#26) and not assigned(inputfile.next) then + end_of_file; + continue; + end; + end; + readchar; + end; + aktcommentstyle:=comment_none; + end; + + + procedure tscannerfile.skipdelphicomment; + begin + aktcommentstyle:=comment_delphi; + inc_comment_level; + readchar; + { this is not supported } + if c='$' then + Message(scan_w_wrong_styled_switch); + { skip comment } + while not (c in [#10,#13,#26]) do + readchar; + dec_comment_level; + aktcommentstyle:=comment_none; + end; + + + procedure tscannerfile.skipoldtpcomment; + var + found : longint; + begin + aktcommentstyle:=comment_oldtp; + inc_comment_level; + { only load a char if last already processed, + was cause of bug1634 PM } + if c=#0 then + readchar; + { this is now supported } + if (c='$') then + handledirectives; + { skip comment } + while (comment_level>0) do + begin + found:=0; + repeat + case c of + #26 : + begin + reload; + if (c=#26) and not assigned(inputfile.next) then + end_of_file; + continue; + end; + #10,#13 : + begin + if found=4 then + inc_comment_level; + linebreak; + found:=0; + end; + '*' : + begin + if found=3 then + found:=4 + else + found:=1; + end; + ')' : + begin + if found in [1,4] then + begin + dec_comment_level; + if comment_level=0 then + found:=2 + else + found:=0; + end + else + found:=0; + end; + '(' : + begin + if found=4 then + inc_comment_level; + found:=3; + end; + else + begin + if found=4 then + inc_comment_level; + found:=0; + end; + end; + readchar; + until (found=2); + end; + aktcommentstyle:=comment_none; + end; + + + +{**************************************************************************** + Token Scanner +****************************************************************************} + + procedure tscannerfile.readtoken(allowrecordtoken:boolean); + var + code : integer; + len, + low,high,mid : longint; + w : word; + m : longint; + mac : tmacro; + asciinr : string[33]; + iswidestring : boolean; + label + exit_label; + begin + flushpendingswitchesstate; + + { record tokens? } + if allowrecordtoken and + assigned(recordtokenbuf) then + recordtoken; + + { replay tokens? } + if assigned(replaytokenbuf) then + begin + replaytoken; + goto exit_label; + end; + + { was there already a token read, then return that token } + if nexttoken<>NOTOKEN then + begin + setnexttoken; + goto exit_label; + end; + + { Skip all spaces and comments } + repeat + case c of + '{' : + skipcomment; + #26 : + begin + reload; + if (c=#26) and not assigned(inputfile.next) then + break; + end; + ' ',#9..#13 : + begin +{$ifdef PREPROCWRITE} + if parapreprocess then + begin + if c=#10 then + preprocfile.eolfound:=true + else + preprocfile.spacefound:=true; + end; +{$endif PREPROCWRITE} + skipspace; + end + else + break; + end; + until false; + + { Save current token position, for EOF its already loaded } + if c<>#26 then + gettokenpos; + + { Check first for a identifier/keyword, this is 20+% faster (PFV) } + if c in ['A'..'Z','a'..'z','_'] then + begin + readstring; + token:=_ID; + idtoken:=_ID; + { keyword or any other known token, + pattern is always uppercased } + if (pattern[1]<>'_') and (length(pattern) in [tokenlenmin..tokenlenmax]) then + begin + low:=ord(tokenidx^[length(pattern),pattern[1]].first); + high:=ord(tokenidx^[length(pattern),pattern[1]].last); + while low<high do + begin + mid:=(high+low+1) shr 1; + if pattern<tokeninfo^[ttoken(mid)].str then + high:=mid-1 + else + low:=mid; + end; + with tokeninfo^[ttoken(high)] do + if pattern=str then + begin + if keyword in current_settings.modeswitches then + if op=NOTOKEN then + token:=ttoken(high) + else + token:=op; + idtoken:=ttoken(high); + end; + end; + { Only process identifiers and not keywords } + if token=_ID then + begin + { this takes some time ... } + if (cs_support_macro in current_settings.moduleswitches) then + begin + mac:=tmacro(search_macro(pattern)); + if assigned(mac) and (not mac.is_compiler_var) and (assigned(mac.buftext)) then + begin + if yylexcount<max_macro_nesting then + begin + mac.is_used:=true; + inc(yylexcount); + insertmacro(pattern,mac.buftext,mac.buflen, + mac.fileinfo.line,mac.fileinfo.fileindex); + { handle empty macros } + if c=#0 then + reload; + readtoken(false); + { that's all folks } + dec(yylexcount); + exit; + end + else + Message(scan_w_macro_too_deep); + end; + end; + end; + { return token } + goto exit_label; + end + else + begin + idtoken:=_NOID; + case c of + + '$' : + begin + readnumber; + token:=_INTCONST; + goto exit_label; + end; + + '%' : + begin + if not(m_fpc in current_settings.modeswitches) then + Illegal_Char(c) + else + begin + readnumber; + token:=_INTCONST; + goto exit_label; + end; + end; + + '&' : + begin + if [m_fpc,m_delphi] * current_settings.modeswitches <> [] then + begin + readnumber; + if length(pattern)=1 then + begin + readstring; + token:=_ID; + idtoken:=_ID; + end + else + token:=_INTCONST; + goto exit_label; + end + else if m_mac in current_settings.modeswitches then + begin + readchar; + token:=_AMPERSAND; + goto exit_label; + end + else + Illegal_Char(c); + end; + + '0'..'9' : + begin + readnumber; + if (c in ['.','e','E']) then + begin + { first check for a . } + if c='.' then + begin + cachenexttokenpos; + readchar; + { is it a .. from a range? } + case c of + '.' : + begin + readchar; + token:=_INTCONST; + nexttoken:=_POINTPOINT; + goto exit_label; + end; + ')' : + begin + readchar; + token:=_INTCONST; + nexttoken:=_RECKKLAMMER; + goto exit_label; + end; + end; + { insert the number after the . } + pattern:=pattern+'.'; + while c in ['0'..'9'] do + begin + pattern:=pattern+c; + readchar; + end; + end; + { E can also follow after a point is scanned } + if c in ['e','E'] then + begin + pattern:=pattern+'E'; + readchar; + if c in ['-','+'] then + begin + pattern:=pattern+c; + readchar; + end; + if not(c in ['0'..'9']) then + Illegal_Char(c); + while c in ['0'..'9'] do + begin + pattern:=pattern+c; + readchar; + end; + end; + token:=_REALNUMBER; + goto exit_label; + end; + token:=_INTCONST; + goto exit_label; + end; + + ';' : + begin + readchar; + token:=_SEMICOLON; + goto exit_label; + end; + + '[' : + begin + readchar; + token:=_LECKKLAMMER; + goto exit_label; + end; + + ']' : + begin + readchar; + token:=_RECKKLAMMER; + goto exit_label; + end; + + '(' : + begin + readchar; + case c of + '*' : + begin + c:=#0;{Signal skipoldtpcomment to reload a char } + skipoldtpcomment; + readtoken(false); + exit; + end; + '.' : + begin + readchar; + token:=_LECKKLAMMER; + goto exit_label; + end; + end; + token:=_LKLAMMER; + goto exit_label; + end; + + ')' : + begin + readchar; + token:=_RKLAMMER; + goto exit_label; + end; + + '+' : + begin + readchar; + if (c='=') and (cs_support_c_operators in current_settings.moduleswitches) then + begin + readchar; + token:=_PLUSASN; + goto exit_label; + end; + token:=_PLUS; + goto exit_label; + end; + + '-' : + begin + readchar; + if (c='=') and (cs_support_c_operators in current_settings.moduleswitches) then + begin + readchar; + token:=_MINUSASN; + goto exit_label; + end; + token:=_MINUS; + goto exit_label; + end; + + ':' : + begin + readchar; + if c='=' then + begin + readchar; + token:=_ASSIGNMENT; + goto exit_label; + end; + token:=_COLON; + goto exit_label; + end; + + '*' : + begin + readchar; + if (c='=') and (cs_support_c_operators in current_settings.moduleswitches) then + begin + readchar; + token:=_STARASN; + end + else + if c='*' then + begin + readchar; + token:=_STARSTAR; + end + else + token:=_STAR; + goto exit_label; + end; + + '/' : + begin + readchar; + case c of + '=' : + begin + if (cs_support_c_operators in current_settings.moduleswitches) then + begin + readchar; + token:=_SLASHASN; + goto exit_label; + end; + end; + '/' : + begin + skipdelphicomment; + readtoken(false); + exit; + end; + end; + token:=_SLASH; + goto exit_label; + end; + + '|' : + if m_mac in current_settings.modeswitches then + begin + readchar; + token:=_PIPE; + goto exit_label; + end + else + Illegal_Char(c); + + '=' : + begin + readchar; + token:=_EQ; + goto exit_label; + end; + + '.' : + begin + readchar; + case c of + '.' : + begin + readchar; + case c of + '.' : + begin + readchar; + token:=_POINTPOINTPOINT; + goto exit_label; + end; + else + begin + token:=_POINTPOINT; + goto exit_label; + end; + end; + end; + ')' : + begin + readchar; + token:=_RECKKLAMMER; + goto exit_label; + end; + end; + token:=_POINT; + goto exit_label; + end; + + '@' : + begin + readchar; + token:=_KLAMMERAFFE; + goto exit_label; + end; + + ',' : + begin + readchar; + token:=_COMMA; + goto exit_label; + end; + + '''','#','^' : + begin + len:=0; + cstringpattern:=''; + iswidestring:=false; + if c='^' then + begin + readchar; + c:=upcase(c); + if (block_type in [bt_type,bt_const_type,bt_var_type]) or + (lasttoken=_ID) or (lasttoken=_NIL) or (lasttoken=_OPERATOR) or + (lasttoken=_RKLAMMER) or (lasttoken=_RECKKLAMMER) or (lasttoken=_CARET) then + begin + token:=_CARET; + goto exit_label; + end + else + begin + inc(len); + setlength(cstringpattern,256); + if c<#64 then + cstringpattern[len]:=chr(ord(c)+64) + else + cstringpattern[len]:=chr(ord(c)-64); + readchar; + end; + end; + repeat + case c of + '#' : + begin + readchar; { read # } + case c of + '$': + begin + readchar; { read leading $ } + asciinr:='$'; + while (upcase(c) in ['A'..'F','0'..'9']) and (length(asciinr)<=5) do + begin + asciinr:=asciinr+c; + readchar; + end; + end; + '&': + begin + readchar; { read leading $ } + asciinr:='&'; + while (upcase(c) in ['0'..'7']) and (length(asciinr)<=7) do + begin + asciinr:=asciinr+c; + readchar; + end; + end; + '%': + begin + readchar; { read leading $ } + asciinr:='%'; + while (upcase(c) in ['0','1']) and (length(asciinr)<=17) do + begin + asciinr:=asciinr+c; + readchar; + end; + end; + else + begin + asciinr:=''; + while (c in ['0'..'9']) and (length(asciinr)<=5) do + begin + asciinr:=asciinr+c; + readchar; + end; + end; + end; + val(asciinr,m,code); + if (asciinr='') or (code<>0) then + Message(scan_e_illegal_char_const) + else if (m<0) or (m>255) or (length(asciinr)>3) then + begin + if (m>=0) and (m<=65535) then + begin + if not iswidestring then + begin + if len>0 then + ascii2unicode(@cstringpattern[1],len,current_settings.sourcecodepage,patternw) + else + ascii2unicode(nil,len,current_settings.sourcecodepage,patternw); + iswidestring:=true; + len:=0; + end; + concatwidestringchar(patternw,tcompilerwidechar(m)); + end + else + Message(scan_e_illegal_char_const) + end + else if iswidestring then + concatwidestringchar(patternw,asciichar2unicode(char(m))) + else + begin + if len>=length(cstringpattern) then + setlength(cstringpattern,length(cstringpattern)+256); + inc(len); + cstringpattern[len]:=chr(m); + end; + end; + '''' : + begin + repeat + readchar; + case c of + #26 : + end_of_file; + #10,#13 : + Message(scan_f_string_exceeds_line); + '''' : + begin + readchar; + if c<>'''' then + break; + end; + end; + { interpret as utf-8 string? } + if (ord(c)>=$80) and (current_settings.sourcecodepage=CP_UTF8) then + begin + { convert existing string to an utf-8 string } + if not iswidestring then + begin + if len>0 then + ascii2unicode(@cstringpattern[1],len,current_settings.sourcecodepage,patternw) + else + ascii2unicode(nil,len,current_settings.sourcecodepage,patternw); + iswidestring:=true; + len:=0; + end; + { four or more chars aren't handled } + if (ord(c) and $f0)=$f0 then + message(scan_e_utf8_bigger_than_65535) + { three chars } + else if (ord(c) and $e0)=$e0 then + begin + w:=ord(c) and $f; + readchar; + if (ord(c) and $c0)<>$80 then + message(scan_e_utf8_malformed); + w:=(w shl 6) or (ord(c) and $3f); + readchar; + if (ord(c) and $c0)<>$80 then + message(scan_e_utf8_malformed); + w:=(w shl 6) or (ord(c) and $3f); + concatwidestringchar(patternw,w); + end + { two chars } + else if (ord(c) and $c0)<>0 then + begin + w:=ord(c) and $1f; + readchar; + if (ord(c) and $c0)<>$80 then + message(scan_e_utf8_malformed); + w:=(w shl 6) or (ord(c) and $3f); + concatwidestringchar(patternw,w); + end + { illegal } + else if (ord(c) and $80)<>0 then + message(scan_e_utf8_malformed) + else + concatwidestringchar(patternw,tcompilerwidechar(c)) + end + else if iswidestring then + begin + if current_settings.sourcecodepage=CP_UTF8 then + concatwidestringchar(patternw,ord(c)) + else + concatwidestringchar(patternw,asciichar2unicode(c)) + end + else + begin + if len>=length(cstringpattern) then + setlength(cstringpattern,length(cstringpattern)+256); + inc(len); + cstringpattern[len]:=c; + end; + until false; + end; + '^' : + begin + readchar; + c:=upcase(c); + if c<#64 then + c:=chr(ord(c)+64) + else + c:=chr(ord(c)-64); + + if iswidestring then + concatwidestringchar(patternw,asciichar2unicode(c)) + else + begin + if len>=length(cstringpattern) then + setlength(cstringpattern,length(cstringpattern)+256); + inc(len); + cstringpattern[len]:=c; + end; + + readchar; + end; + else + break; + end; + until false; + { strings with length 1 become const chars } + if iswidestring then + begin + if patternw^.len=1 then + token:=_CWCHAR + else + token:=_CWSTRING; + end + else + begin + setlength(cstringpattern,len); + if length(cstringpattern)=1 then + begin + token:=_CCHAR; + pattern:=cstringpattern; + end + else + token:=_CSTRING; + end; + goto exit_label; + end; + + '>' : + begin + readchar; + if (block_type in [bt_type,bt_var_type,bt_const_type]) then + token:=_RSHARPBRACKET + else + begin + case c of + '=' : + begin + readchar; + token:=_GTE; + goto exit_label; + end; + '>' : + begin + readchar; + token:=_OP_SHR; + goto exit_label; + end; + '<' : + begin { >< is for a symetric diff for sets } + readchar; + token:=_SYMDIF; + goto exit_label; + end; + end; + token:=_GT; + end; + goto exit_label; + end; + + '<' : + begin + readchar; + if (block_type in [bt_type,bt_var_type,bt_const_type]) then + token:=_LSHARPBRACKET + else + begin + case c of + '>' : + begin + readchar; + token:=_NE; + goto exit_label; + end; + '=' : + begin + readchar; + token:=_LTE; + goto exit_label; + end; + '<' : + begin + readchar; + token:=_OP_SHL; + goto exit_label; + end; + end; + token:=_LT; + end; + goto exit_label; + end; + + #26 : + begin + token:=_EOF; + checkpreprocstack; + goto exit_label; + end; + else + Illegal_Char(c); + end; + end; +exit_label: + lasttoken:=token; + end; + + + function tscannerfile.readpreproc:ttoken; + begin + skipspace; + case c of + '_', + 'A'..'Z', + 'a'..'z' : + begin + current_scanner.preproc_pattern:=readid; + readpreproc:=_ID; + end; + '0'..'9' : + begin + current_scanner.preproc_pattern:=readval_asstring; + { realnumber? } + if c='.' then + begin + readchar; + while c in ['0'..'9'] do + begin + current_scanner.preproc_pattern:=current_scanner.preproc_pattern+c; + readchar; + end; + end; + readpreproc:=_ID; + end; + '$','%','&' : + begin + current_scanner.preproc_pattern:=readval_asstring; + readpreproc:=_ID; + end; + ',' : + begin + readchar; + readpreproc:=_COMMA; + end; + '}' : + begin + readpreproc:=_END; + end; + '(' : + begin + readchar; + readpreproc:=_LKLAMMER; + end; + ')' : + begin + readchar; + readpreproc:=_RKLAMMER; + end; + '[' : + begin + readchar; + readpreproc:=_LECKKLAMMER; + end; + ']' : + begin + readchar; + readpreproc:=_RECKKLAMMER; + end; + '+' : + begin + readchar; + readpreproc:=_PLUS; + end; + '-' : + begin + readchar; + readpreproc:=_MINUS; + end; + '*' : + begin + readchar; + readpreproc:=_STAR; + end; + '/' : + begin + readchar; + readpreproc:=_SLASH; + end; + '=' : + begin + readchar; + readpreproc:=_EQ; + end; + '>' : + begin + readchar; + if c='=' then + begin + readchar; + readpreproc:=_GTE; + end + else + readpreproc:=_GT; + end; + '<' : + begin + readchar; + case c of + '>' : + begin + readchar; + readpreproc:=_NE; + end; + '=' : + begin + readchar; + readpreproc:=_LTE; + end; + else + readpreproc:=_LT; + end; + end; + #26 : + begin + readpreproc:=_EOF; + checkpreprocstack; + end; + else + Illegal_Char(c); + end; + end; + + + function tscannerfile.asmgetcharstart : char; + begin + { return first the character already + available in c } + lastasmgetchar:=c; + result:=asmgetchar; + end; + + + function tscannerfile.asmgetchar : char; + begin + if lastasmgetchar<>#0 then + begin + c:=lastasmgetchar; + lastasmgetchar:=#0; + end + else + readchar; + if in_asm_string then + begin + asmgetchar:=c; + exit; + end; + repeat + case c of + // the { ... } is used in ARM assembler to define register sets, so we can't used + // it as comment, either (* ... *), /* ... */ or // ... should be used instead. + // But compiler directives {$...} are allowed in ARM assembler. + '{' : + begin +{$ifdef arm} + readchar; + dec(inputpointer); + if c<>'$' then + begin + asmgetchar:='{'; + exit; + end + else +{$endif arm} + skipcomment; + end; + #10,#13 : + begin + linebreak; + asmgetchar:=c; + exit; + end; + #26 : + begin + reload; + if (c=#26) and not assigned(inputfile.next) then + end_of_file; + continue; + end; + '/' : + begin + readchar; + if c='/' then + skipdelphicomment + else + begin + asmgetchar:='/'; + lastasmgetchar:=c; + exit; + end; + end; + '(' : + begin + readchar; + if c='*' then + begin + c:=#0;{Signal skipoldtpcomment to reload a char } + skipoldtpcomment; + end + else + begin + asmgetchar:='('; + lastasmgetchar:=c; + exit; + end; + end; + else + begin + asmgetchar:=c; + exit; + end; + end; + until false; + end; + + +{***************************************************************************** + Helpers +*****************************************************************************} + + procedure AddDirective(const s:string; dm: tdirectivemode; p:tdirectiveproc); + begin + if dm in [directive_all, directive_turbo] then + tdirectiveitem.create(turbo_scannerdirectives,s,p); + if dm in [directive_all, directive_mac] then + tdirectiveitem.create(mac_scannerdirectives,s,p); + end; + + procedure AddConditional(const s:string; dm: tdirectivemode; p:tdirectiveproc); + begin + if dm in [directive_all, directive_turbo] then + tdirectiveitem.createcond(turbo_scannerdirectives,s,p); + if dm in [directive_all, directive_mac] then + tdirectiveitem.createcond(mac_scannerdirectives,s,p); + end; + +{***************************************************************************** + Initialization +*****************************************************************************} + + procedure InitScanner; + begin + InitWideString(patternw); + turbo_scannerdirectives:=TFPHashObjectList.Create; + mac_scannerdirectives:=TFPHashObjectList.Create; + + { Common directives and conditionals } + AddDirective('I',directive_all, @dir_include); + AddDirective('DEFINE',directive_all, @dir_define); + AddDirective('UNDEF',directive_all, @dir_undef); + + AddConditional('IF',directive_all, @dir_if); + AddConditional('IFDEF',directive_all, @dir_ifdef); + AddConditional('IFNDEF',directive_all, @dir_ifndef); + AddConditional('ELSE',directive_all, @dir_else); + AddConditional('ELSEIF',directive_all, @dir_elseif); + AddConditional('ENDIF',directive_all, @dir_endif); + + { Directives and conditionals for all modes except mode macpas} + AddDirective('INCLUDE',directive_turbo, @dir_include); + AddDirective('LIBPREFIX',directive_turbo, @dir_libprefix); + AddDirective('LIBSUFFIX',directive_turbo, @dir_libsuffix); + AddDirective('EXTENSION',directive_turbo, @dir_extension); + + AddConditional('IFEND',directive_turbo, @dir_endif); + AddConditional('IFOPT',directive_turbo, @dir_ifopt); + + { Directives and conditionals for mode macpas: } + AddDirective('SETC',directive_mac, @dir_setc); + AddDirective('DEFINEC',directive_mac, @dir_definec); + AddDirective('UNDEFC',directive_mac, @dir_undef); + + AddConditional('IFC',directive_mac, @dir_if); + AddConditional('ELSEC',directive_mac, @dir_else); + AddConditional('ELIFC',directive_mac, @dir_elseif); + AddConditional('ENDC',directive_mac, @dir_endif); + end; + + + procedure DoneScanner; + begin + turbo_scannerdirectives.Free; + mac_scannerdirectives.Free; + DoneWideString(patternw); + end; + +end. diff --git a/closures/compiler/script.pas b/closures/compiler/script.pas new file mode 100644 index 0000000000..eaeed314f0 --- /dev/null +++ b/closures/compiler/script.pas @@ -0,0 +1,526 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit handles the writing of script files + + 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 script; + +{$i fpcdefs.inc} + +interface +{$H+} +uses + sysutils, + globtype, + cclasses; + +type + TScript=class + fn : TCmdStr; + data : TCmdStrList; + executable : boolean; + constructor Create(const s:TCmdStr); + constructor CreateExec(const s:TCmdStr); + destructor Destroy;override; + procedure AddStart(const s:TCmdStr); + procedure Add(const s:TCmdStr); + Function Empty:boolean; + procedure WriteToDisk;virtual; + end; + + TAsmScript = class (TScript) + Constructor Create(Const ScriptName : TCmdStr); virtual; + Procedure AddAsmCommand (Const Command, Options,FileName : TCmdStr);virtual;abstract; + Procedure AddLinkCommand (Const Command, Options, FileName : TCmdStr);virtual;abstract; + Procedure AddDeleteCommand (Const FileName : TCmdStr);virtual;abstract; + Procedure AddDeleteDirCommand (Const FileName : TCmdStr);virtual;abstract; + end; + + TAsmScriptDos = class (TAsmScript) + Constructor Create (Const ScriptName : TCmdStr); override; + Procedure AddAsmCommand (Const Command, Options,FileName : TCmdStr);override; + Procedure AddLinkCommand (Const Command, Options, FileName : TCmdStr);override; + Procedure AddDeleteCommand (Const FileName : TCmdStr);override; + Procedure AddDeleteDirCommand (Const FileName : TCmdStr);override; + Procedure WriteToDisk;override; + end; + + TAsmScriptAmiga = class (TAsmScript) + Constructor Create (Const ScriptName : TCmdStr); override; + Procedure AddAsmCommand (Const Command, Options,FileName : TCmdStr);override; + Procedure AddLinkCommand (Const Command, Options, FileName : TCmdStr);override; + Procedure AddDeleteCommand (Const FileName : TCmdStr);override; + Procedure AddDeleteDirCommand (Const FileName : TCmdStr);override; + Procedure WriteToDisk;override; + end; + + TAsmScriptUnix = class (TAsmScript) + Constructor Create (Const ScriptName : TCmdStr);override; + Procedure AddAsmCommand (Const Command, Options,FileName : TCmdStr);override; + Procedure AddLinkCommand (Const Command, Options, FileName : TCmdStr);override; + Procedure AddDeleteCommand (Const FileName : TCmdStr);override; + Procedure AddDeleteDirCommand (Const FileName : TCmdStr);override; + Procedure WriteToDisk;override; + end; + + TAsmScriptMPW = class (TAsmScript) + Constructor Create (Const ScriptName : TCmdStr); override; + Procedure AddAsmCommand (Const Command, Options,FileName : TCmdStr);override; + Procedure AddLinkCommand (Const Command, Options, FileName : TCmdStr);override; + Procedure AddDeleteCommand (Const FileName : TCmdStr);override; + Procedure AddDeleteDirCommand (Const FileName : TCmdStr);override; + Procedure WriteToDisk;override; + end; + + TLinkRes = Class (TScript) + section: string[30]; + procedure Add(const s:TCmdStr); + procedure AddFileName(const s:TCmdStr); + procedure EndSection(const s:TCmdStr); + procedure StartSection(const s:TCmdStr); + end; + +var + AsmRes : TAsmScript; + +Function ScriptFixFileName(const s:TCmdStr):TCmdStr; +Procedure GenerateAsmRes(const st : TCmdStr); + + +implementation + +uses +{$ifdef hasUnix} + BaseUnix, +{$endif} + cutils,cfileutl, + globals,systems,verbose; + + +{**************************************************************************** + Helpers +****************************************************************************} + + Function ScriptFixFileName(const s:TCmdStr):TCmdStr; + begin + if cs_link_on_target in current_settings.globalswitches then + ScriptFixFileName:=TargetFixFileName(s) + else + ScriptFixFileName:=FixFileName(s); + end; + +{**************************************************************************** + TScript +****************************************************************************} + +constructor TScript.Create(const s: TCmdStr); +begin + fn:=FixFileName(s); + executable:=false; + data:=TCmdStrList.Create; +end; + + +constructor TScript.CreateExec(const s:TCmdStr); +begin + fn:=FixFileName(s); + if cs_link_on_target in current_settings.globalswitches then + fn:=ChangeFileExt(fn,target_info.scriptext) + else + fn:=ChangeFileExt(fn,source_info.scriptext); + executable:=true; + data:=TCmdStrList.Create; +end; + + +destructor TScript.Destroy; +begin + data.Free; +end; + + +procedure TScript.AddStart(const s:TCmdStr); +begin + data.Insert(s); +end; + + +procedure TScript.Add(const s:TCmdStr); +begin + data.Concat(s); +end; + + +Function TScript.Empty:boolean; +begin + Empty:=Data.Empty; +end; + +procedure TScript.WriteToDisk; +var + t : file; + i : longint; + s : TCmdStr; + le: string[2]; + +begin + Assign(t,fn); + if cs_link_on_target in current_settings.globalswitches then + le:= target_info.newline + else + le:= source_info.newline; + + {$push}{$I-} + Rewrite(t,1); + if ioresult<>0 then + exit; + while not data.Empty do + begin + s:=data.GetFirst; + Blockwrite(t,s[1],length(s),i); + Blockwrite(t,le[1],length(le),i); + end; + Close(t); + {$pop} + i:=ioresult; +{$ifdef hasUnix} + if executable then + fpchmod(fn,493); +{$endif} +end; + +{**************************************************************************** + Asm Response +****************************************************************************} + +Constructor TAsmScript.Create (Const ScriptName : TCmdStr); +begin + Inherited CreateExec(ScriptName); +end; + + +{**************************************************************************** + DOS Asm Response +****************************************************************************} + +Constructor TAsmScriptDos.Create (Const ScriptName : TCmdStr); +begin + Inherited Create(ScriptName); +end; + + +Procedure TAsmScriptDos.AddAsmCommand (Const Command, Options,FileName : TCmdStr); +begin + if FileName<>'' then + begin + Add('SET THEFILE='+ScriptFixFileName(FileName)); + Add('echo Assembling %THEFILE%'); + end; + Add(maybequoted(command)+' '+Options); + Add('if errorlevel 1 goto asmend'); +end; + + +Procedure TAsmScriptDos.AddLinkCommand (Const Command, Options, FileName : TCmdStr); +begin + if FileName<>'' then + begin + Add('SET THEFILE='+ScriptFixFileName(FileName)); + Add('echo Linking %THEFILE%'); + end; + Add(maybequoted(command)+' '+Options); + Add('if errorlevel 1 goto linkend'); +end; + + +Procedure TAsmScriptDos.AddDeleteCommand (Const FileName : TCmdStr); +begin + Add('Del ' + MaybeQuoted (ScriptFixFileName (FileName))); +end; + + +Procedure TAsmScriptDos.AddDeleteDirCommand (Const FileName : TCmdStr); +begin + Add('Rmdir ' + MaybeQuoted (ScriptFixFileName (FileName))); +end; + + +Procedure TAsmScriptDos.WriteToDisk; +Begin + AddStart('@echo off'); + Add('goto end'); + Add(':asmend'); + Add('echo An error occured while assembling %THEFILE%'); + Add('goto end'); + Add(':linkend'); + Add('echo An error occured while linking %THEFILE%'); + Add(':end'); + inherited WriteToDisk; +end; + +{**************************************************************************** + Amiga Asm Response +****************************************************************************} + + +Constructor TAsmScriptAmiga.Create (Const ScriptName : TCmdStr); +begin + Inherited Create(ScriptName); +end; + + +Procedure TAsmScriptAmiga.AddAsmCommand (Const Command, Options,FileName : TCmdStr); +begin + if FileName<>'' then + begin + Add('SET THEFILE '+ScriptFixFileName(FileName)); + Add('echo Assembling $THEFILE'); + end; + Add(maybequoted(command)+' '+Options); + { There is a problem here, + as always return with a non zero error value PM } + Add('if error'); + Add('why'); + Add('skip asmend'); + Add('endif'); +end; + + +Procedure TAsmScriptAmiga.AddLinkCommand (Const Command, Options, FileName : TCmdStr); +begin + if FileName<>'' then + begin + Add('SET THEFILE '+ScriptFixFileName(FileName)); + Add('echo Linking $THEFILE'); + end; + Add(maybequoted(command)+' '+Options); + Add('if error'); + Add('skip linkend'); + Add('endif'); +end; + + +Procedure TAsmScriptAmiga.AddDeleteCommand (Const FileName : TCmdStr); +begin + Add('Delete ' + Unix2AmigaPath(MaybeQuoted(ScriptFixFileName(FileName))) + ' Quiet'); +end; + + +Procedure TAsmScriptAmiga.AddDeleteDirCommand (Const FileName : TCmdStr); +begin + Add('Delete ' + Unix2AmigaPath(MaybeQuoted(ScriptFixFileName(FileName))) + ' All Quiet'); +end; + + +Procedure TAsmScriptAmiga.WriteToDisk; +Begin + Add('skip end'); + Add('lab asmend'); + Add('why'); + Add('echo An error occured while assembling $THEFILE'); + Add('skip end'); + Add('lab linkend'); + Add('why'); + Add('echo An error occured while linking $THEFILE'); + Add('lab end'); + inherited WriteToDisk; +end; + + +{**************************************************************************** + Unix Asm Response +****************************************************************************} + +Constructor TAsmScriptUnix.Create (Const ScriptName : TCmdStr); +begin + Inherited Create(ScriptName); +end; + + +Procedure TAsmScriptUnix.AddAsmCommand (Const Command, Options,FileName : TCmdStr); +begin + if FileName<>'' then + Add('echo Assembling '+ScriptFixFileName(FileName)); + Add(maybequoted(command)+' '+Options); + Add('if [ $? != 0 ]; then DoExitAsm '+ScriptFixFileName(FileName)+'; fi'); +end; + + +Procedure TAsmScriptUnix.AddLinkCommand (Const Command, Options, FileName : TCmdStr); +begin + if FileName<>'' then + Add('echo Linking '+ScriptFixFileName(FileName)); + Add('OFS=$IFS'); + Add('IFS="'); + Add('"'); + Add(maybequoted(command)+' '+Options); + Add('if [ $? != 0 ]; then DoExitLink '+ScriptFixFileName(FileName)+'; fi'); + Add('IFS=$OFS'); +end; + + +Procedure TAsmScriptUnix.AddDeleteCommand (Const FileName : TCmdStr); +begin + Add('rm ' + MaybeQuoted (ScriptFixFileName(FileName))); +end; + + +Procedure TAsmScriptUnix.AddDeleteDirCommand (Const FileName : TCmdStr); +begin + Add('rmdir ' + MaybeQuoted (ScriptFixFileName(FileName))); +end; + + +Procedure TAsmScriptUnix.WriteToDisk; +Begin + AddStart('{ echo "An error occurred while linking $1"; exit 1; }'); + AddStart('DoExitLink ()'); + AddStart('{ echo "An error occurred while assembling $1"; exit 1; }'); + AddStart('DoExitAsm ()'); + {$ifdef BEOS} + AddStart('#!/boot/beos/bin/sh'); + {$else} + AddStart('#!/bin/sh'); + {$endif} + inherited WriteToDisk; +end; + + +{**************************************************************************** + MPW (MacOS) Asm Response +****************************************************************************} + +Constructor TAsmScriptMPW.Create (Const ScriptName : TCmdStr); +begin + Inherited Create(ScriptName); +end; + + +Procedure TAsmScriptMPW.AddAsmCommand (Const Command, Options,FileName : TCmdStr); +begin + if FileName<>'' then + Add('Echo Assembling '+ScriptFixFileName(FileName)); + Add(maybequoted(command)+' '+Options); + Add('Exit If "{Status}" != 0'); +end; + + +Procedure TAsmScriptMPW.AddLinkCommand (Const Command, Options, FileName : TCmdStr); +begin + if FileName<>'' then + Add('Echo Linking '+ScriptFixFileName(FileName)); + Add(maybequoted(command)+' '+Options); + Add('Exit If "{Status}" != 0'); + + {Add resources} + if apptype = app_cui then {If SIOW} + begin + Add('Rez -append "{RIncludes}"SIOW.r -o '+ ScriptFixFileName(FileName)); + Add('Exit If "{Status}" != 0'); + end; +end; + + +Procedure TAsmScriptMPW.AddDeleteCommand (Const FileName : TCmdStr); +begin + Add('Delete ' + MaybeQuoted (ScriptFixFileName(FileName))); +end; + + +Procedure TAsmScriptMPW.AddDeleteDirCommand (Const FileName : TCmdStr); +begin + Add('Delete ' + MaybeQuoted (ScriptFixFileName (FileName))); +end; + + +Procedure TAsmScriptMPW.WriteToDisk; +Begin + AddStart('# Script for assembling and linking a FreePascal program on MPW (MacOS)'); + Add('Echo Done'); + inherited WriteToDisk; +end; + + + +Procedure GenerateAsmRes(const st : TCmdStr); +var + scripttyp : tscripttype; +begin + if cs_link_on_target in current_settings.globalswitches then + scripttyp := target_info.script + else + scripttyp := source_info.script; + case scripttyp of + script_unix : + AsmRes:=TAsmScriptUnix.Create(st); + script_dos : + AsmRes:=TAsmScriptDos.Create(st); + script_amiga : + AsmRes:=TAsmScriptAmiga.Create(st); + script_mpw : + AsmRes:=TAsmScriptMPW.Create(st); + end; +end; + + +{**************************************************************************** + Link Response +****************************************************************************} + +procedure TLinkRes.Add(const s:TCmdStr); +begin + if s<>'' then + inherited Add(s); +end; + +procedure TLinkRes.AddFileName(const s:TCmdStr); +begin + if section<>'' then + begin + inherited Add(section); + section:=''; + end; + if s<>'' then + begin + if not(s[1] in ['a'..'z','A'..'Z','/','\','.','"']) then + begin + if cs_link_on_target in current_settings.globalswitches then + inherited Add('.'+target_info.DirSep+s) + else + inherited Add('.'+source_info.DirSep+s); + end + else + inherited Add(s); + end; +end; + +procedure TLinkRes.EndSection(const s:TCmdStr); +begin + { only terminate if we started the section } + if section='' then + inherited Add(s); + section:=''; +end; + +procedure TLinkRes.StartSection(const s:TCmdStr); +begin + section:=s; +end; + +end. diff --git a/closures/compiler/sparc/aasmcpu.pas b/closures/compiler/sparc/aasmcpu.pas new file mode 100644 index 0000000000..6583b3d377 --- /dev/null +++ b/closures/compiler/sparc/aasmcpu.pas @@ -0,0 +1,318 @@ +{ + Copyright (c) 1999-2002 by Mazen Neifer + + Contains the assembler object for the SPARC + + 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,aasmdata,aasmsym, + cgbase,cgutils,cpubase,cpuinfo; + + const + { "mov reg,reg" source operand number } + O_MOV_SOURCE = 0; + { "mov reg,reg" source operand number } + O_MOV_DEST = 1; + + type + taicpu = class(tai_cpu_abstract_sym) + delayslot_annulled : boolean; { conditinal opcode with ,a } + constructor op_none(op : tasmop); + + constructor op_reg(op : tasmop;_op1 : tregister); + constructor op_const(op : tasmop;_op1 : LongInt); + constructor op_ref(op : tasmop;const _op1 : treference); + + 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: LongInt); + constructor op_const_reg(op:tasmop; _op1: LongInt; _op2: tregister); + constructor op_ref_reg(op : tasmop;const _op1 : treference;_op2 : tregister); + + constructor op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister); + constructor op_reg_ref_reg(op:tasmop;_op1:TRegister;_op2:TReference;_op3:tregister); + constructor op_reg_const_reg(op:tasmop;_op1:TRegister;_op2:aint;_op3: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); + procedure loadbool(opidx:longint;_b:boolean); + { register allocation } + function is_same_reg_move(regtype: Tregistertype):boolean; override; + + { register spilling code } + function spilling_get_operation_type(opnr: longint): topertype;override; + end; + + tai_align = class(tai_align_abstract) + { nothing to add } + end; + + procedure InitAsm; + procedure DoneAsm; + + function spilling_create_load(const ref:treference;r:tregister):Taicpu; + function spilling_create_store(r:tregister; const ref:treference):Taicpu; + +implementation + +{***************************************************************************** + taicpu Constructors +*****************************************************************************} + + procedure taicpu.loadbool(opidx:longint;_b:boolean); + begin + if opidx>=ops then + ops:=opidx+1; + with oper[opidx]^ do + begin + if typ=top_ref then + dispose(ref); + b:=_b; + typ:=top_bool; + end; + end; + + + 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_ref(op : tasmop;const _op1 : treference); + begin + inherited create(op); + ops:=1; + loadref(0,_op1); + end; + + + constructor taicpu.op_const(op : tasmop;_op1 : LongInt); + begin + inherited create(op); + ops:=1; + loadconst(0,_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: LongInt); + begin + inherited create(op); + ops:=2; + loadreg(0,_op1); + loadconst(1,_op2); + end; + + constructor taicpu.op_const_reg(op:tasmop; _op1: LongInt; _op2: tregister); + begin + inherited create(op); + ops:=2; + loadconst(0,_op1); + loadreg(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_ref_reg(op : tasmop;const _op1 : treference;_op2 : tregister); + begin + inherited create(op); + ops:=2; + loadref(0,_op1); + loadreg(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_ref_reg(op:tasmop;_op1:TRegister;_op2:TReference;_op3:tregister); + begin + inherited create(op); + { only allowed to load the address } + if not(_op2.refaddr in [addr_low,addr_high]) then + internalerror(200305311); + ops:=3; + loadreg(0,_op1); + loadref(1,_op2); + loadreg(2,_op3); + end; + + + constructor taicpu.op_reg_const_reg(op:tasmop;_op1:TRegister;_op2:aint;_op3:tregister); + begin + inherited create(op); + ops:=3; + loadreg(0,_op1); + loadconst(1,_op2); + loadreg(2,_op3); + end; + + + constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol); + begin + inherited create(op); + is_jmp:=op in [A_BA,A_Bxx]; + condition:=cond; + ops:=1; + loadsymbol(0,_op1,0); + end; + + + constructor taicpu.op_sym(op : tasmop;_op1 : tasmsymbol); + begin + inherited create(op); + is_jmp:=op in [A_BA,A_Bxx]; + 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; + + + function taicpu.is_same_reg_move(regtype: Tregistertype):boolean; + begin + result:=( + ((opcode=A_MOV) and (regtype = R_INTREGISTER)) or + ((regtype = R_FPUREGISTER) and (opcode in [A_FMOVS,A_FMOVD])) + ) and + (ops=2) and + (oper[0]^.typ=top_reg) and + (oper[1]^.typ=top_reg) and + (oper[0]^.reg=oper[1]^.reg); + end; + + + function taicpu.spilling_get_operation_type(opnr: longint): topertype; + begin + result := operand_read; + case opcode of + A_FCMPs,A_FCMPd,A_FCMPq : + ; + else + begin + if opnr=ops-1 then + result := operand_write; + end; + end; + end; + + + function spilling_create_load(const ref:treference;r:tregister):Taicpu; + begin + case getregtype(r) of + R_INTREGISTER : + result:=taicpu.op_ref_reg(A_LD,ref,r); + R_FPUREGISTER : + begin + case getsubreg(r) of + R_SUBFS : + result:=taicpu.op_ref_reg(A_LDF,ref,r); + R_SUBFD : + result:=taicpu.op_ref_reg(A_LDD,ref,r); + else + internalerror(200401042); + end; + end + else + internalerror(200401041); + end; + end; + + + function spilling_create_store(r:tregister; const ref:treference):Taicpu; + begin + case getregtype(r) of + R_INTREGISTER : + result:=taicpu.op_reg_ref(A_ST,r,ref); + R_FPUREGISTER : + begin + case getsubreg(r) of + R_SUBFS : + result:=taicpu.op_reg_ref(A_STF,r,ref); + R_SUBFD : + result:=taicpu.op_reg_ref(A_STD,r,ref); + else + internalerror(200401042); + end; + end + else + internalerror(200401041); + end; + end; + + + procedure InitAsm; + begin + end; + + + procedure DoneAsm; + begin + end; + +begin + cai_cpu:=taicpu; + cai_align:=tai_align; +end. diff --git a/closures/compiler/sparc/aoptcpu.pas b/closures/compiler/sparc/aoptcpu.pas new file mode 100644 index 0000000000..cb656af36e --- /dev/null +++ b/closures/compiler/sparc/aoptcpu.pas @@ -0,0 +1,41 @@ +{ + Copyright (c) 1998-2004 by Jonas Maebe + + This unit calls the optimization procedures to optimize the assembler + code for sparc + + 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, aoptobj, aoptcpub, aopt; + + Type + TCpuAsmOptimizer = class(TAsmOptimizer) + End; + + Implementation + +begin + casmoptimizer:=TCpuAsmOptimizer; +end. diff --git a/closures/compiler/sparc/aoptcpub.pas b/closures/compiler/sparc/aoptcpub.pas new file mode 100644 index 0000000000..b6954875a2 --- /dev/null +++ b/closures/compiler/sparc/aoptcpub.pas @@ -0,0 +1,120 @@ + { + Copyright (c) 1998-2004 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 sparc 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_BA; + aopt_condjmp = A_Bxx; + +Implementation + +{ ************************************************************************* } +{ **************************** TCondRegs ********************************** } +{ ************************************************************************* } +Constructor TCondRegs.init; +Begin +End; + +Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl} +Begin +End; + +End. diff --git a/closures/compiler/sparc/aoptcpud.pas b/closures/compiler/sparc/aoptcpud.pas new file mode 100644 index 0000000000..cb8c5d319f --- /dev/null +++ b/closures/compiler/sparc/aoptcpud.pas @@ -0,0 +1,36 @@ +{ + Copyright (c) 1998-2004 by Jonas Maebe, member of the Free Pascal + Development Team + + 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. diff --git a/closures/compiler/sparc/cgcpu.pas b/closures/compiler/sparc/cgcpu.pas new file mode 100644 index 0000000000..4da36945d7 --- /dev/null +++ b/closures/compiler/sparc/cgcpu.pas @@ -0,0 +1,1598 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements the code generator for the SPARC + + 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,parabase, + cgbase,cgutils,cgobj,cg64f32, + aasmbase,aasmtai,aasmdata,aasmcpu, + cpubase,cpuinfo, + node,symconst,SymType,symdef, + rgcpu; + + type + TCgSparc=class(tcg) + protected + function IsSimpleRef(const ref:treference):boolean; + public + procedure init_register_allocators;override; + procedure done_register_allocators;override; + function getfpuregister(list:TAsmList;size:Tcgsize):Tregister;override; + { sparc special, needed by cg64 } + procedure make_simple_ref(list:TAsmList;var ref: treference); + procedure handle_load_store(list:TAsmList;isstore:boolean;op: tasmop;reg:tregister;ref: treference); + procedure handle_reg_const_reg(list:TAsmList;op:Tasmop;src:tregister;a:tcgint;dst:tregister); + { parameter } + procedure a_load_const_cgpara(list:TAsmList;size:tcgsize;a:tcgint;const paraloc:TCGPara);override; + procedure a_load_ref_cgpara(list:TAsmList;sz:tcgsize;const r:TReference;const paraloc:TCGPara);override; + procedure a_loadaddr_ref_cgpara(list:TAsmList;const r:TReference;const paraloc:TCGPara);override; + procedure a_loadfpu_reg_cgpara(list : TAsmList;size : tcgsize;const r : tregister;const paraloc : TCGPara);override; + procedure a_loadfpu_ref_cgpara(list : TAsmList;size : tcgsize;const ref : treference;const paraloc : TCGPara);override; + procedure a_call_name(list:TAsmList;const s:string; weak: boolean);override; + procedure a_call_reg(list:TAsmList;Reg:TRegister);override; + { General purpose instructions } + procedure maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister); + procedure a_op_const_reg(list:TAsmList;Op:TOpCG;size:tcgsize;a:tcgint;reg:TRegister);override; + procedure a_op_reg_reg(list:TAsmList;Op:TOpCG;size:TCGSize;src, dst:TRegister);override; + procedure a_op_const_reg_reg(list:TAsmList;op:TOpCg;size:tcgsize;a:tcgint;src, dst:tregister);override; + procedure a_op_reg_reg_reg(list:TAsmList;op:TOpCg;size:tcgsize;src1, src2, dst:tregister);override; + procedure a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation);override; + procedure a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation);override; + { move instructions } + procedure a_load_const_reg(list:TAsmList;size:tcgsize;a:tcgint;reg:tregister);override; + procedure a_load_const_ref(list:TAsmList;size:tcgsize;a:tcgint;const ref:TReference);override; + procedure a_load_reg_ref(list:TAsmList;FromSize,ToSize:TCgSize;reg:TRegister;const ref:TReference);override; + procedure a_load_ref_reg(list:TAsmList;FromSize,ToSize:TCgSize;const ref:TReference;reg:tregister);override; + procedure a_load_reg_reg(list:TAsmList;FromSize,ToSize:TCgSize;reg1,reg2:tregister);override; + procedure a_loadaddr_ref_reg(list:TAsmList;const ref:TReference;r:tregister);override; + { fpu move instructions } + procedure a_loadfpu_reg_reg(list:TAsmList;fromsize,tosize:tcgsize;reg1, reg2:tregister);override; + procedure a_loadfpu_ref_reg(list:TAsmList;fromsize,tosize:tcgsize;const ref:TReference;reg:tregister);override; + procedure a_loadfpu_reg_ref(list:TAsmList;fromsize,tosize:tcgsize;reg:tregister;const ref:TReference);override; + { comparison operations } + procedure a_cmp_const_reg_label(list:TAsmList;size:tcgsize;cmp_op:topcmp;a:tcgint;reg:tregister;l:tasmlabel);override; + procedure a_cmp_reg_reg_label(list:TAsmList;size:tcgsize;cmp_op:topcmp;reg1,reg2:tregister;l:tasmlabel);override; + procedure a_jmp_always(List:TAsmList;l:TAsmLabel);override; + procedure a_jmp_name(list : TAsmList;const s : string);override; + procedure a_jmp_cond(list:TAsmList;cond:TOpCmp;l:tasmlabel);{ override;} + procedure a_jmp_flags(list:TAsmList;const f:TResFlags;l:tasmlabel);override; + procedure g_flags2reg(list:TAsmList;Size:TCgSize;const f:tresflags;reg:TRegister);override; + procedure g_overflowCheck(List:TAsmList;const Loc:TLocation;def:TDef);override; + procedure g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation);override; + procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override; + procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override; + procedure g_restore_registers(list:TAsmList);override; + procedure g_save_registers(list : TAsmList);override; + procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);override; + procedure g_concatcopy_unaligned(list : TAsmList;const source,dest : treference;len : tcgint);override; + procedure g_concatcopy_move(list : TAsmList;const source,dest : treference;len : tcgint); + procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override; + { Transform unsupported methods into Internal errors } + procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override; + procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override; + private + g1_used : boolean; + end; + + TCg64Sparc=class(tcg64f32) + private + procedure get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp;checkoverflow : boolean); + public + procedure a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference);override; + procedure a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64);override; + procedure a_load64_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara);override; + procedure a_op64_reg_reg(list:TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst:TRegister64);override; + procedure a_op64_const_reg(list:TAsmList;op:TOpCG;size : tcgsize;value:int64;regdst:TRegister64);override; + procedure a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);override; + procedure a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);override; + procedure a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override; + procedure a_op64_reg_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override; + end; + + procedure create_codegen; + + const + TOpCG2AsmOp : array[topcg] of TAsmOp=( + A_NONE,A_MOV,A_ADD,A_AND,A_UDIV,A_SDIV,A_SMUL,A_UMUL,A_NEG,A_NOT,A_OR,A_SRA,A_SLL,A_SRL,A_SUB,A_XOR,A_NONE,A_NONE + ); + TOpCG2AsmOpWithFlags : array[topcg] of TAsmOp=( + A_NONE,A_MOV,A_ADDcc,A_ANDcc,A_UDIVcc,A_SDIVcc,A_SMULcc,A_UMULcc,A_NEG,A_NOT,A_ORcc,A_SRA,A_SLL,A_SRL,A_SUBcc,A_XORcc,A_NONE,A_NONE + ); + TOpCmp2AsmCond : array[topcmp] of TAsmCond=(C_NONE, + C_E,C_G,C_L,C_GE,C_LE,C_NE,C_BE,C_B,C_AE,C_A + ); + + +implementation + + uses + globals,verbose,systems,cutils, + paramgr,fmodule, + tgobj, + procinfo,cpupi; + + + function TCgSparc.IsSimpleRef(const ref:treference):boolean; + begin + if (ref.base=NR_NO) and (ref.index<>NR_NO) then + InternalError(2002100804); + result :=not(assigned(ref.symbol))and + (((ref.index = NR_NO) and + (ref.offset >= simm13lo) and + (ref.offset <= simm13hi)) or + ((ref.index <> NR_NO) and + (ref.offset = 0))); + end; + + + procedure tcgsparc.make_simple_ref(list:TAsmList;var ref: treference); + var + tmpreg : tregister; + tmpref : treference; + begin + tmpreg:=NR_NO; + { Be sure to have a base register } + if (ref.base=NR_NO) then + begin + ref.base:=ref.index; + ref.index:=NR_NO; + end; + if (cs_create_pic in current_settings.moduleswitches) and + assigned(ref.symbol) then + begin + tmpreg:=GetIntRegister(list,OS_INT); + reference_reset(tmpref,ref.alignment); + tmpref.symbol:=ref.symbol; + tmpref.refaddr:=addr_pic; + if not(pi_needs_got in current_procinfo.flags) then + internalerror(200501161); + tmpref.index:=current_procinfo.got; + list.concat(taicpu.op_ref_reg(A_LD,tmpref,tmpreg)); + ref.symbol:=nil; + if (ref.index<>NR_NO) then + begin + list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.index,tmpreg)); + ref.index:=tmpreg; + end + else + begin + if ref.base<>NR_NO then + ref.index:=tmpreg + else + ref.base:=tmpreg; + end; + end; + { When need to use SETHI, do it first } + if assigned(ref.symbol) or + (ref.offset<simm13lo) or + (ref.offset>simm13hi) then + begin + tmpreg:=GetIntRegister(list,OS_INT); + reference_reset(tmpref,ref.alignment); + tmpref.symbol:=ref.symbol; + tmpref.offset:=ref.offset; + tmpref.refaddr:=addr_high; + list.concat(taicpu.op_ref_reg(A_SETHI,tmpref,tmpreg)); + if (ref.offset=0) and (ref.index=NR_NO) and + (ref.base=NR_NO) then + begin + ref.refaddr:=addr_low; + end + else + begin + { Load the low part is left } + tmpref.refaddr:=addr_low; + list.concat(taicpu.op_reg_ref_reg(A_OR,tmpreg,tmpref,tmpreg)); + ref.offset:=0; + { symbol is loaded } + ref.symbol:=nil; + end; + if (ref.index<>NR_NO) then + begin + list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,ref.index,tmpreg)); + ref.index:=tmpreg; + end + else + begin + if ref.base<>NR_NO then + ref.index:=tmpreg + else + ref.base:=tmpreg; + end; + end; + if (ref.base<>NR_NO) then + begin + if (ref.index<>NR_NO) and + ((ref.offset<>0) or assigned(ref.symbol)) then + begin + if tmpreg=NR_NO then + tmpreg:=GetIntRegister(list,OS_INT); + list.concat(taicpu.op_reg_reg_reg(A_ADD,ref.base,ref.index,tmpreg)); + ref.base:=tmpreg; + ref.index:=NR_NO; + end; + end; + end; + + + procedure tcgsparc.handle_load_store(list:TAsmList;isstore:boolean;op: tasmop;reg:tregister;ref: treference); + begin + make_simple_ref(list,ref); + if isstore then + list.concat(taicpu.op_reg_ref(op,reg,ref)) + else + list.concat(taicpu.op_ref_reg(op,ref,reg)); + end; + + + procedure tcgsparc.handle_reg_const_reg(list:TAsmList;op:Tasmop;src:tregister;a:tcgint;dst:tregister); + var + tmpreg : tregister; + begin + if (a<simm13lo) or + (a>simm13hi) then + begin + if g1_used then + GetIntRegister(list,OS_INT) + else + begin + tmpreg:=NR_G1; + g1_used:=true; + end; + a_load_const_reg(list,OS_INT,a,tmpreg); + list.concat(taicpu.op_reg_reg_reg(op,src,tmpreg,dst)); + if tmpreg=NR_G1 then + g1_used:=false; + end + else + list.concat(taicpu.op_reg_const_reg(op,src,a,dst)); + end; + + +{**************************************************************************** + Assembler code +****************************************************************************} + + procedure Tcgsparc.init_register_allocators; + begin + inherited init_register_allocators; + + if (cs_create_pic in current_settings.moduleswitches) and + (pi_needs_got in current_procinfo.flags) then + begin + current_procinfo.got:=NR_L7; + rg[R_INTREGISTER]:=Trgcpu.create(R_INTREGISTER,R_SUBD, + [RS_O0,RS_O1,RS_O2,RS_O3,RS_O4,RS_O5, + RS_L0,RS_L1,RS_L2,RS_L3,RS_L4,RS_L5,RS_L6], + first_int_imreg,[]); + end + else + rg[R_INTREGISTER]:=Trgcpu.create(R_INTREGISTER,R_SUBD, + [RS_O0,RS_O1,RS_O2,RS_O3,RS_O4,RS_O5, + RS_L0,RS_L1,RS_L2,RS_L3,RS_L4,RS_L5,RS_L6,RS_L7], + first_int_imreg,[]); + + rg[R_FPUREGISTER]:=trgcpu.create(R_FPUREGISTER,R_SUBFS, + [RS_F0,RS_F1,RS_F2,RS_F3,RS_F4,RS_F5,RS_F6,RS_F7, + RS_F8,RS_F9,RS_F10,RS_F11,RS_F12,RS_F13,RS_F14,RS_F15, + RS_F16,RS_F17,RS_F18,RS_F19,RS_F20,RS_F21,RS_F22,RS_F23, + RS_F24,RS_F25,RS_F26,RS_F27,RS_F28,RS_F29,RS_F30,RS_F31], + first_fpu_imreg,[]); + { needs at least one element for rgobj not to crash } + rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBNONE, + [RS_L0],first_mm_imreg,[]); + end; + + + procedure Tcgsparc.done_register_allocators; + begin + rg[R_INTREGISTER].free; + rg[R_FPUREGISTER].free; + rg[R_MMREGISTER].free; + inherited done_register_allocators; + end; + + + function tcgsparc.getfpuregister(list:TAsmList;size:Tcgsize):Tregister; + begin + if size=OS_F64 then + result:=rg[R_FPUREGISTER].getregister(list,R_SUBFD) + else + result:=rg[R_FPUREGISTER].getregister(list,R_SUBFS); + end; + + + procedure TCgSparc.a_load_const_cgpara(list:TAsmList;size:tcgsize;a:tcgint;const paraloc:TCGPara); + var + Ref:TReference; + begin + paraloc.check_simple_location; + paramanager.alloccgpara(list,paraloc); + case paraloc.location^.loc of + LOC_REGISTER,LOC_CREGISTER: + a_load_const_reg(list,size,a,paraloc.location^.register); + LOC_REFERENCE: + begin + { Code conventions need the parameters being allocated in %o6+92 } + with paraloc.location^.Reference do + begin + if (Index=NR_SP) and (Offset<Target_info.first_parm_offset) then + InternalError(2002081104); + reference_reset_base(ref,index,offset,paraloc.alignment); + end; + a_load_const_ref(list,size,a,ref); + end; + else + InternalError(2002122200); + end; + end; + + + procedure TCgSparc.a_load_ref_cgpara(list:TAsmList;sz:TCgSize;const r:TReference;const paraloc:TCGPara); + var + ref: treference; + tmpreg:TRegister; + begin + paraloc.check_simple_location; + paramanager.alloccgpara(list,paraloc); + with paraloc.location^ do + begin + case loc of + LOC_REGISTER,LOC_CREGISTER : + a_load_ref_reg(list,sz,paraloc.location^.size,r,Register); + LOC_REFERENCE: + begin + { Code conventions need the parameters being allocated in %o6+92 } + with Reference do + begin + if (Index=NR_SP) and (Offset<Target_info.first_parm_offset) then + InternalError(2002081104); + reference_reset_base(ref,index,offset,paraloc.alignment); + end; + if g1_used then + GetIntRegister(list,OS_INT) + else + begin + tmpreg:=NR_G1; + g1_used:=true; + end; + a_load_ref_reg(list,sz,sz,r,tmpreg); + a_load_reg_ref(list,sz,sz,tmpreg,ref); + if tmpreg=NR_G1 then + g1_used:=false; + end; + else + internalerror(2002081103); + end; + end; + end; + + + procedure TCgSparc.a_loadaddr_ref_cgpara(list:TAsmList;const r:TReference;const paraloc:TCGPara); + var + Ref:TReference; + TmpReg:TRegister; + begin + paraloc.check_simple_location; + paramanager.alloccgpara(list,paraloc); + with paraloc.location^ do + begin + case loc of + LOC_REGISTER,LOC_CREGISTER: + a_loadaddr_ref_reg(list,r,register); + LOC_REFERENCE: + begin + reference_reset(ref,paraloc.alignment); + ref.base := reference.index; + ref.offset := reference.offset; + tmpreg:=GetAddressRegister(list); + a_loadaddr_ref_reg(list,r,tmpreg); + a_load_reg_ref(list,OS_ADDR,OS_ADDR,tmpreg,ref); + end; + else + internalerror(2002080701); + end; + end; + end; + + + procedure tcgsparc.a_loadfpu_ref_cgpara(list : TAsmList;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 + paramanager.allocparaloc(list,hloc); + case hloc^.loc of + LOC_REGISTER,LOC_CREGISTER : + 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,paraloc.alignment); + a_load_ref_ref(list,hloc^.size,hloc^.size,href,href2); + end; + LOC_FPUREGISTER,LOC_CFPUREGISTER : + a_loadfpu_ref_reg(list,hloc^.size,hloc^.size,href,hloc^.register); + else + internalerror(200408241); + end; + inc(href.offset,tcgsize2size[hloc^.size]); + hloc:=hloc^.next; + end; + end; + + + procedure tcgsparc.a_loadfpu_reg_cgpara(list : TAsmList;size : tcgsize;const r : tregister;const paraloc : TCGPara); + var + href : treference; + begin + { happens for function result loc } + if paraloc.location^.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER] then + begin + paraloc.check_simple_location; + paramanager.allocparaloc(list,paraloc.location); + a_loadfpu_reg_reg(list,size,paraloc.location^.size,r,paraloc.location^.register); + end + else + begin + tg.GetTemp(list,TCGSize2Size[size],TCGSize2Size[size],tt_normal,href); + a_loadfpu_reg_ref(list,size,size,r,href); + a_loadfpu_ref_cgpara(list,size,href,paraloc); + tg.Ungettemp(list,href); + end; + end; + + + procedure TCgSparc.a_call_name(list:TAsmList;const s:string; weak: boolean); + begin + if not weak then + list.concat(taicpu.op_sym(A_CALL,current_asmdata.RefAsmSymbol(s))) + else + list.concat(taicpu.op_sym(A_CALL,current_asmdata.WeakRefAsmSymbol(s))); + { Delay slot } + list.concat(taicpu.op_none(A_NOP)); + end; + + + procedure TCgSparc.a_call_reg(list:TAsmList;Reg:TRegister); + begin + list.concat(taicpu.op_reg(A_CALL,reg)); + { Delay slot } + list.concat(taicpu.op_none(A_NOP)); + end; + + + {********************** load instructions ********************} + + procedure TCgSparc.a_load_const_reg(list : TAsmList;size : TCGSize;a : tcgint;reg : TRegister); + begin + { we don't use the set instruction here because it could be evalutated to two + instructions which would cause problems with the delay slot (FK) } + if (a=0) then + list.concat(taicpu.op_reg(A_CLR,reg)) + { sethi allows to set the upper 22 bit, so we'll take full advantage of it } + else if (aint(a) and aint($1fff))=0 then + list.concat(taicpu.op_const_reg(A_SETHI,aint(a) shr 10,reg)) + else if (a>=simm13lo) and (a<=simm13hi) then + list.concat(taicpu.op_const_reg(A_MOV,a,reg)) + else + begin + list.concat(taicpu.op_const_reg(A_SETHI,aint(a) shr 10,reg)); + list.concat(taicpu.op_reg_const_reg(A_OR,reg,aint(a) and aint($3ff),reg)); + end; + end; + + + procedure TCgSparc.a_load_const_ref(list : TAsmList;size : tcgsize;a : tcgint;const ref : TReference); + begin + if a=0 then + a_load_reg_ref(list,size,size,NR_G0,ref) + else + inherited a_load_const_ref(list,size,a,ref); + end; + + + procedure TCgSparc.a_load_reg_ref(list:TAsmList;FromSize,ToSize:TCGSize;reg:tregister;const Ref:TReference); + var + op : tasmop; + begin + if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then + fromsize := tosize; + if (ref.alignment<>0) and + (ref.alignment<tcgsize2size[tosize]) then + begin + a_load_reg_ref_unaligned(list,FromSize,ToSize,reg,ref); + end + else + begin + case tosize of + { signed integer registers } + OS_8, + OS_S8: + Op:=A_STB; + OS_16, + OS_S16: + Op:=A_STH; + OS_32, + OS_S32: + Op:=A_ST; + else + InternalError(2002122100); + end; + handle_load_store(list,true,op,reg,ref); + end; + end; + + + procedure TCgSparc.a_load_ref_reg(list:TAsmList;FromSize,ToSize:TCgSize;const ref:TReference;reg:tregister); + var + op : tasmop; + begin + if (TCGSize2Size[fromsize] >= TCGSize2Size[tosize]) then + fromsize := tosize; + if (ref.alignment<>0) and + (ref.alignment<tcgsize2size[fromsize]) then + begin + a_load_ref_reg_unaligned(list,FromSize,ToSize,ref,reg); + end + else + begin + case fromsize of + OS_S8: + Op:=A_LDSB;{Load Signed Byte} + OS_8: + Op:=A_LDUB;{Load Unsigned Byte} + OS_S16: + Op:=A_LDSH;{Load Signed Halfword} + OS_16: + Op:=A_LDUH;{Load Unsigned Halfword} + OS_S32, + OS_32: + Op:=A_LD;{Load Word} + OS_S64, + OS_64: + Op:=A_LDD;{Load a Long Word} + else + InternalError(2002122101); + end; + handle_load_store(list,false,op,reg,ref); + if (fromsize=OS_S8) and + (tosize=OS_16) then + a_load_reg_reg(list,fromsize,tosize,reg,reg); + end; + end; + + + procedure TCgSparc.a_load_reg_reg(list:TAsmList;fromsize,tosize:tcgsize;reg1,reg2:tregister); + var + instr : taicpu; + begin + if (tcgsize2size[fromsize] > tcgsize2size[tosize]) or + ((tcgsize2size[fromsize] = tcgsize2size[tosize]) and + (fromsize <> tosize)) or + { needs to mask out the sign in the top 16 bits } + ((fromsize = OS_S8) and + (tosize = OS_16)) then + case tosize of + OS_8 : + a_op_const_reg_reg(list,OP_AND,tosize,$ff,reg1,reg2); + OS_16 : + a_op_const_reg_reg(list,OP_AND,tosize,$ffff,reg1,reg2); + OS_32, + OS_S32 : + begin + instr:=taicpu.op_reg_reg(A_MOV,reg1,reg2); + 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; + OS_S8 : + begin + list.concat(taicpu.op_reg_const_reg(A_SLL,reg1,24,reg2)); + list.concat(taicpu.op_reg_const_reg(A_SRA,reg2,24,reg2)); + end; + OS_S16 : + begin + list.concat(taicpu.op_reg_const_reg(A_SLL,reg1,16,reg2)); + list.concat(taicpu.op_reg_const_reg(A_SRA,reg2,16,reg2)); + end; + else + internalerror(2002090901); + end + else + begin + instr:=taicpu.op_reg_reg(A_MOV,reg1,reg2); + 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; + + + procedure TCgSparc.a_loadaddr_ref_reg(list : TAsmList;const ref : TReference;r : tregister); + var + tmpref,href : treference; + hreg,tmpreg : tregister; + begin + href:=ref; + if (href.base=NR_NO) and (href.index<>NR_NO) then + internalerror(200306171); + + if (cs_create_pic in current_settings.moduleswitches) and + assigned(href.symbol) then + begin + tmpreg:=GetIntRegister(list,OS_ADDR); + reference_reset(tmpref,href.alignment); + tmpref.symbol:=href.symbol; + tmpref.refaddr:=addr_pic; + if not(pi_needs_got in current_procinfo.flags) then + internalerror(200501161); + tmpref.base:=current_procinfo.got; + list.concat(taicpu.op_ref_reg(A_LD,tmpref,tmpreg)); + href.symbol:=nil; + if (href.index<>NR_NO) then + begin + list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,href.index,tmpreg)); + href.index:=tmpreg; + end + else + begin + if href.base<>NR_NO then + href.index:=tmpreg + else + href.base:=tmpreg; + end; + end; + + { At least big offset (need SETHI), maybe base and maybe index } + if assigned(href.symbol) or + (href.offset<simm13lo) or + (href.offset>simm13hi) then + begin + hreg:=GetAddressRegister(list); + reference_reset(tmpref,href.alignment); + tmpref.symbol := href.symbol; + tmpref.offset := href.offset; + tmpref.refaddr := addr_high; + list.concat(taicpu.op_ref_reg(A_SETHI,tmpref,hreg)); + { Only the low part is left } + tmpref.refaddr:=addr_low; + list.concat(taicpu.op_reg_ref_reg(A_OR,hreg,tmpref,hreg)); + if href.base<>NR_NO then + begin + if href.index<>NR_NO then + begin + list.concat(taicpu.op_reg_reg_reg(A_ADD,hreg,href.base,hreg)); + list.concat(taicpu.op_reg_reg_reg(A_ADD,hreg,href.index,r)); + end + else + list.concat(taicpu.op_reg_reg_reg(A_ADD,hreg,href.base,r)); + end + else + begin + if hreg<>r then + a_load_reg_reg(list,OS_ADDR,OS_ADDR,hreg,r); + end; + end + else + { At least small offset, maybe base and maybe index } + if href.offset<>0 then + begin + if href.base<>NR_NO then + begin + if href.index<>NR_NO then + begin + hreg:=GetAddressRegister(list); + list.concat(taicpu.op_reg_const_reg(A_ADD,href.base,href.offset,hreg)); + list.concat(taicpu.op_reg_reg_reg(A_ADD,hreg,href.index,r)); + end + else + list.concat(taicpu.op_reg_const_reg(A_ADD,href.base,href.offset,r)); + end + else + list.concat(taicpu.op_const_reg(A_MOV,href.offset,r)); + end + else + { Both base and index } + if href.index<>NR_NO then + list.concat(taicpu.op_reg_reg_reg(A_ADD,href.base,href.index,r)) + else + { Only base } + if href.base<>NR_NO then + a_load_reg_reg(list,OS_ADDR,OS_ADDR,href.base,r) + else + { only offset, can be generated by absolute } + a_load_const_reg(list,OS_ADDR,href.offset,r); + end; + + + procedure TCgSparc.a_loadfpu_reg_reg(list:TAsmList;fromsize,tosize:tcgsize;reg1, reg2:tregister); + const + FpuMovInstr : Array[OS_F32..OS_F64,OS_F32..OS_F64] of TAsmOp = + ((A_FMOVS,A_FSTOD),(A_FDTOS,A_FMOVD)); + var + op: TAsmOp; + instr : taicpu; + begin + op:=fpumovinstr[fromsize,tosize]; + instr:=taicpu.op_reg_reg(op,reg1,reg2); + list.Concat(instr); + { Notify the register allocator that we have written a move instruction so + it can try to eliminate it. } + if (op = A_FMOVS) or + (op = A_FMOVD) then + add_move_instruction(instr); + end; + + + procedure TCgSparc.a_loadfpu_ref_reg(list:TAsmList;fromsize,tosize:tcgsize;const ref:TReference;reg:tregister); + const + FpuLoadInstr : Array[OS_F32..OS_F64] of TAsmOp = + (A_LDF,A_LDDF); + var + tmpreg: tregister; + begin + if (fromsize<>tosize) then + begin + tmpreg:=reg; + reg:=getfpuregister(list,fromsize); + end; + handle_load_store(list,false,fpuloadinstr[fromsize],reg,ref); + if (fromsize<>tosize) then + a_loadfpu_reg_reg(list,fromsize,tosize,reg,tmpreg); + end; + + + procedure TCgSparc.a_loadfpu_reg_ref(list:TAsmList;fromsize,tosize:tcgsize;reg:tregister;const ref:TReference); + const + FpuLoadInstr : Array[OS_F32..OS_F64] of TAsmOp = + (A_STF,A_STDF); + var + tmpreg: tregister; + begin + if (fromsize<>tosize) then + begin + tmpreg:=getfpuregister(list,tosize); + a_loadfpu_reg_reg(list,fromsize,tosize,reg,tmpreg); + reg:=tmpreg; + end; + handle_load_store(list,true,fpuloadinstr[tosize],reg,ref); + end; + + + procedure tcgsparc.maybeadjustresult(list: TAsmList; op: TOpCg; size: tcgsize; dst: tregister); + const + overflowops = [OP_MUL,OP_SHL,OP_ADD,OP_SUB,OP_NOT,OP_NEG]; + begin + if (op in overflowops) and + (size in [OS_8,OS_S8,OS_16,OS_S16]) then + a_load_reg_reg(list,OS_32,size,dst,dst); + end; + + + procedure TCgSparc.a_op_const_reg(list:TAsmList;Op:TOpCG;size:tcgsize;a:tcgint;reg:TRegister); + begin + if Op in [OP_NEG,OP_NOT] then + internalerror(200306011); + if (a=0) then + list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op],reg,NR_G0,reg)) + else + handle_reg_const_reg(list,TOpCG2AsmOp[op],reg,a,reg); + maybeadjustresult(list,op,size,reg); + end; + + + procedure TCgSparc.a_op_reg_reg(list:TAsmList;Op:TOpCG;size:TCGSize;src, dst:TRegister); + var + a : aint; + begin + Case Op of + OP_NEG : + list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],src,dst)); + OP_NOT : + begin + case size of + OS_8 : + a:=aint($ffffff00); + OS_16 : + a:=aint($ffff0000); + else + a:=0; + end; + handle_reg_const_reg(list,A_XNOR,src,a,dst); + end; + else + list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op],dst,src,dst)); + end; + maybeadjustresult(list,op,size,dst); + end; + + + procedure TCgSparc.a_op_const_reg_reg(list:TAsmList;op:TOpCg;size:tcgsize;a:tcgint;src, dst:tregister); + var + power : longInt; + begin + case op of + OP_MUL, + OP_IMUL: + begin + if ispowerof2(a,power) then + begin + { can be done with a shift } + inherited a_op_const_reg_reg(list,op,size,a,src,dst); + exit; + end; + end; + OP_SUB, + OP_ADD : + begin + if (a=0) then + begin + a_load_reg_reg(list,size,size,src,dst); + exit; + end; + end; + end; + handle_reg_const_reg(list,TOpCG2AsmOp[op],src,a,dst); + maybeadjustresult(list,op,size,dst); + end; + + + procedure TCgSparc.a_op_reg_reg_reg(list:TAsmList;op:TOpCg;size:tcgsize;src1, src2, dst:tregister); + begin + list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op],src2,src1,dst)); + maybeadjustresult(list,op,size,dst); + end; + + + procedure tcgsparc.a_op_const_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; a: tcgint; src, dst: tregister;setflags : boolean;var ovloc : tlocation); + var + power : longInt; + tmpreg1,tmpreg2 : tregister; + begin + ovloc.loc:=LOC_VOID; + case op of + OP_SUB, + OP_ADD : + begin + if (a=0) then + begin + a_load_reg_reg(list,size,size,src,dst); + exit; + end; + end; + end; + if setflags then + begin + handle_reg_const_reg(list,TOpCG2AsmOpWithFlags[op],src,a,dst); + case op of + OP_MUL: + begin + tmpreg1:=GetIntRegister(list,OS_INT); + list.concat(taicpu.op_reg_reg(A_MOV,NR_Y,tmpreg1)); + list.concat(taicpu.op_reg_reg(A_CMP,NR_G0,tmpreg1)); + ovloc.loc:=LOC_FLAGS; + ovloc.resflags:=F_NE; + end; + OP_IMUL: + begin + tmpreg1:=GetIntRegister(list,OS_INT); + tmpreg2:=GetIntRegister(list,OS_INT); + list.concat(taicpu.op_reg_reg(A_MOV,NR_Y,tmpreg1)); + list.concat(taicpu.op_reg_const_reg(A_SRA,dst,31,tmpreg2)); + list.concat(taicpu.op_reg_reg(A_CMP,tmpreg1,tmpreg2)); + ovloc.loc:=LOC_FLAGS; + ovloc.resflags:=F_NE; + end; + end; + end + else + handle_reg_const_reg(list,TOpCG2AsmOp[op],src,a,dst); + maybeadjustresult(list,op,size,dst); + end; + + + procedure tcgsparc.a_op_reg_reg_reg_checkoverflow(list: TAsmList; op: TOpCg; size: tcgsize; src1, src2, dst: tregister;setflags : boolean;var ovloc : tlocation); + var + tmpreg1,tmpreg2 : tregister; + begin + ovloc.loc:=LOC_VOID; + if setflags then + begin + list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOpWithFlags[op],src2,src1,dst)); + case op of + OP_MUL: + begin + tmpreg1:=GetIntRegister(list,OS_INT); + list.concat(taicpu.op_reg_reg(A_MOV,NR_Y,tmpreg1)); + list.concat(taicpu.op_reg_reg(A_CMP,NR_G0,tmpreg1)); + ovloc.loc:=LOC_FLAGS; + ovloc.resflags:=F_NE; + end; + OP_IMUL: + begin + tmpreg1:=GetIntRegister(list,OS_INT); + tmpreg2:=GetIntRegister(list,OS_INT); + list.concat(taicpu.op_reg_reg(A_MOV,NR_Y,tmpreg1)); + list.concat(taicpu.op_reg_const_reg(A_SRL,dst,31,tmpreg2)); + list.concat(taicpu.op_reg_reg(A_CMP,tmpreg1,tmpreg2)); + ovloc.loc:=LOC_FLAGS; + ovloc.resflags:=F_NE; + end; + end; + end + else + list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOp[op],src2,src1,dst)); + maybeadjustresult(list,op,size,dst); + end; + + + + {*************** compare instructructions ****************} + + procedure TCgSparc.a_cmp_const_reg_label(list:TAsmList;size:tcgsize;cmp_op:topcmp;a:tcgint;reg:tregister;l:tasmlabel); + begin + if (a=0) then + list.concat(taicpu.op_reg_reg_reg(A_SUBcc,reg,NR_G0,NR_G0)) + else + handle_reg_const_reg(list,A_SUBcc,reg,a,NR_G0); + a_jmp_cond(list,cmp_op,l); + end; + + + procedure TCgSparc.a_cmp_reg_reg_label(list:TAsmList;size:tcgsize;cmp_op:topcmp;reg1,reg2:tregister;l:tasmlabel); + begin + list.concat(taicpu.op_reg_reg_reg(A_SUBcc,reg2,reg1,NR_G0)); + a_jmp_cond(list,cmp_op,l); + end; + + + procedure TCgSparc.a_jmp_always(List:TAsmList;l:TAsmLabel); + begin + List.Concat(TAiCpu.op_sym(A_BA,current_asmdata.RefAsmSymbol(l.name))); + { Delay slot } + list.Concat(TAiCpu.Op_none(A_NOP)); + end; + + + procedure tcgsparc.a_jmp_name(list : TAsmList;const s : string); + begin + List.Concat(TAiCpu.op_sym(A_BA,current_asmdata.RefAsmSymbol(s))); + { Delay slot } + list.Concat(TAiCpu.Op_none(A_NOP)); + end; + + + procedure TCgSparc.a_jmp_cond(list:TAsmList;cond:TOpCmp;l:TAsmLabel); + var + ai:TAiCpu; + begin + ai:=TAiCpu.Op_sym(A_Bxx,l); + ai.SetCondition(TOpCmp2AsmCond[cond]); + list.Concat(ai); + { Delay slot } + list.Concat(TAiCpu.Op_none(A_NOP)); + end; + + + procedure TCgSparc.a_jmp_flags(list:TAsmList;const f:TResFlags;l:tasmlabel); + var + ai : taicpu; + op : tasmop; + begin + if f in [F_FE,F_FNE,F_FG,F_FL,F_FGE,F_FLE] then + op:=A_FBxx + else + op:=A_Bxx; + ai := Taicpu.op_sym(op,l); + ai.SetCondition(flags_to_cond(f)); + list.Concat(ai); + { Delay slot } + list.Concat(TAiCpu.Op_none(A_NOP)); + end; + + + procedure TCgSparc.g_flags2reg(list:TAsmList;Size:TCgSize;const f:tresflags;reg:TRegister); + var + hl : tasmlabel; + begin + current_asmdata.getjumplabel(hl); + a_load_const_reg(list,size,1,reg); + a_jmp_flags(list,f,hl); + a_load_const_reg(list,size,0,reg); + a_label(list,hl); + end; + + + procedure tcgsparc.g_overflowCheck(List:TAsmList;const Loc:TLocation;def:TDef); + var + l : tlocation; + begin + l.loc:=LOC_VOID; + g_overflowCheck_loc(list,loc,def,l); + end; + + + procedure TCgSparc.g_overflowCheck_loc(List:TAsmList;const Loc:TLocation;def:TDef;ovloc : tlocation); + var + hl : tasmlabel; + ai:TAiCpu; + hflags : tresflags; + begin + if not(cs_check_overflow in current_settings.localswitches) then + exit; + current_asmdata.getjumplabel(hl); + case ovloc.loc of + LOC_VOID: + begin + if not((def.typ=pointerdef) or + ((def.typ=orddef) and + (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar, + pasbool8,pasbool16,pasbool32,pasbool64]))) then + begin + ai:=TAiCpu.Op_sym(A_Bxx,hl); + ai.SetCondition(C_NO); + list.Concat(ai); + { Delay slot } + list.Concat(TAiCpu.Op_none(A_NOP)); + end + else + a_jmp_cond(list,OC_AE,hl); + 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',false); + a_label(list,hl); + end; + + { *********** entry/exit code and address loading ************ } + + procedure TCgSparc.g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); + begin + if nostackframe then + exit; + { Althogh the SPARC architecture require only word alignment, software + convention and the operating system require every stack frame to be double word + aligned } + LocalSize:=align(LocalSize,8); + { Execute the SAVE instruction to get a new register window and create a new + stack frame. In the "SAVE %i6,size,%i6" the first %i6 is related to the state + before execution of the SAVE instrucion so it is the caller %i6, when the %i6 + after execution of that instruction is the called function stack pointer} + { constant can be 13 bit signed, since it's negative, size can be max. 4096 } + if LocalSize>4096 then + begin + a_load_const_reg(list,OS_ADDR,-LocalSize,NR_G1); + g1_used:=true; + list.concat(Taicpu.Op_reg_reg_reg(A_SAVE,NR_STACK_POINTER_REG,NR_G1,NR_STACK_POINTER_REG)); + g1_used:=false; + end + else + list.concat(Taicpu.Op_reg_const_reg(A_SAVE,NR_STACK_POINTER_REG,-LocalSize,NR_STACK_POINTER_REG)); + if (cs_create_pic in current_settings.moduleswitches) and + (pi_needs_got in current_procinfo.flags) then + begin + current_procinfo.got:=NR_L7; + end; + end; + + + procedure TCgSparc.g_restore_registers(list:TAsmList); + begin + { The sparc port uses the sparc standard calling convetions so this function has no used } + end; + + + procedure TCgSparc.g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); + var + hr : treference; + begin + if paramanager.ret_in_param(current_procinfo.procdef.returndef,current_procinfo.procdef.proccalloption) then + begin + reference_reset(hr,sizeof(pint)); + hr.offset:=12; + hr.refaddr:=addr_full; + if nostackframe then + begin + hr.base:=NR_O7; + list.concat(taicpu.op_ref_reg(A_JMPL,hr,NR_G0)); + list.concat(Taicpu.op_none(A_NOP)) + end + else + begin + { We use trivial restore in the delay slot of the JMPL instruction, as we + already set result onto %i0 } + hr.base:=NR_I7; + list.concat(taicpu.op_ref_reg(A_JMPL,hr,NR_G0)); + list.concat(Taicpu.op_none(A_RESTORE)); + end; + end + else + begin + if nostackframe then + begin + { Here we need to use RETL instead of RET so it uses %o7 } + list.concat(Taicpu.op_none(A_RETL)); + list.concat(Taicpu.op_none(A_NOP)) + end + else + begin + { We use trivial restore in the delay slot of the JMPL instruction, as we + already set result onto %i0 } + list.concat(Taicpu.op_none(A_RET)); + list.concat(Taicpu.op_none(A_RESTORE)); + end; + end; + end; + + + procedure TCgSparc.g_save_registers(list : TAsmList); + begin + { The sparc port uses the sparc standard calling convetions so this function has no used } + end; + + + { ************* concatcopy ************ } + + procedure tcgsparc.g_concatcopy_move(list : TAsmList;const source,dest : treference;len : tcgint); + 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); + a_load_const_cgpara(list,OS_INT,len,paraloc3); + a_loadaddr_ref_cgpara(list,dest,paraloc2); + a_loadaddr_ref_cgpara(list,source,paraloc1); + paramanager.freecgpara(list,paraloc3); + paramanager.freecgpara(list,paraloc2); + paramanager.freecgpara(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',false); + dealloccpuregisters(list,R_FPUREGISTER,paramanager.get_volatile_registers_fpu(pocall_default)); + dealloccpuregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default)); + paraloc3.done; + paraloc2.done; + paraloc1.done; + end; + + + procedure TCgSparc.g_concatcopy(list:TAsmList;const source,dest:treference;len:tcgint); + var + tmpreg1, + hreg, + countreg: TRegister; + src, dst: TReference; + lab: tasmlabel; + count, count2: aint; + begin + if len>high(longint) then + internalerror(2002072704); + { anybody wants to determine a good value here :)? } + if len>100 then + g_concatcopy_move(list,source,dest,len) + else + begin + reference_reset(src,source.alignment); + reference_reset(dst,dest.alignment); + { load the address of source into src.base } + src.base:=GetAddressRegister(list); + a_loadaddr_ref_reg(list,source,src.base); + { load the address of dest into dst.base } + dst.base:=GetAddressRegister(list); + a_loadaddr_ref_reg(list,dest,dst.base); + { generate a loop } + count:=len div 4; + if count>4 then + begin + { the offsets are zero after the a_loadaddress_ref_reg and just } + { have to be set to 8. I put an Inc there so debugging may be } + { easier (should offset be different from zero here, it will be } + { easy to notice in the generated assembler } + countreg:=GetIntRegister(list,OS_INT); + tmpreg1:=GetIntRegister(list,OS_INT); + a_load_const_reg(list,OS_INT,count,countreg); + { explicitely allocate R_O0 since it can be used safely here } + { (for holding date that's being copied) } + current_asmdata.getjumplabel(lab); + a_label(list, lab); + list.concat(taicpu.op_ref_reg(A_LD,src,tmpreg1)); + list.concat(taicpu.op_reg_ref(A_ST,tmpreg1,dst)); + list.concat(taicpu.op_reg_const_reg(A_ADD,src.base,4,src.base)); + list.concat(taicpu.op_reg_const_reg(A_ADD,dst.base,4,dst.base)); + list.concat(taicpu.op_reg_const_reg(A_SUBcc,countreg,1,countreg)); + a_jmp_cond(list,OC_NE,lab); + list.concat(taicpu.op_none(A_NOP)); + { keep the registers alive } + list.concat(taicpu.op_reg_reg(A_MOV,countreg,countreg)); + list.concat(taicpu.op_reg_reg(A_MOV,src.base,src.base)); + list.concat(taicpu.op_reg_reg(A_MOV,dst.base,dst.base)); + len := len mod 4; + end; + { unrolled loop } + count:=len div 4; + if count>0 then + begin + tmpreg1:=GetIntRegister(list,OS_INT); + for count2 := 1 to count do + begin + list.concat(taicpu.op_ref_reg(A_LD,src,tmpreg1)); + list.concat(taicpu.op_reg_ref(A_ST,tmpreg1,dst)); + inc(src.offset,4); + inc(dst.offset,4); + end; + len := len mod 4; + end; + if (len and 4) <> 0 then + begin + hreg:=GetIntRegister(list,OS_INT); + a_load_ref_reg(list,OS_32,OS_32,src,hreg); + a_load_reg_ref(list,OS_32,OS_32,hreg,dst); + inc(src.offset,4); + inc(dst.offset,4); + end; + { copy the leftovers } + if (len and 2) <> 0 then + begin + hreg:=GetIntRegister(list,OS_INT); + a_load_ref_reg(list,OS_16,OS_16,src,hreg); + a_load_reg_ref(list,OS_16,OS_16,hreg,dst); + inc(src.offset,2); + inc(dst.offset,2); + end; + if (len and 1) <> 0 then + begin + hreg:=GetIntRegister(list,OS_INT); + a_load_ref_reg(list,OS_8,OS_8,src,hreg); + a_load_reg_ref(list,OS_8,OS_8,hreg,dst); + end; + end; + end; + + + procedure tcgsparc.g_concatcopy_unaligned(list : TAsmList;const source,dest : treference;len : tcgint); + var + src, dst: TReference; + tmpreg1, + countreg: TRegister; + i : aint; + lab: tasmlabel; + begin + if len>31 then + g_concatcopy_move(list,source,dest,len) + else + begin + reference_reset(src,source.alignment); + reference_reset(dst,dest.alignment); + { load the address of source into src.base } + src.base:=GetAddressRegister(list); + a_loadaddr_ref_reg(list,source,src.base); + { load the address of dest into dst.base } + dst.base:=GetAddressRegister(list); + a_loadaddr_ref_reg(list,dest,dst.base); + { generate a loop } + if len>4 then + begin + { the offsets are zero after the a_loadaddress_ref_reg and just } + { have to be set to 8. I put an Inc there so debugging may be } + { easier (should offset be different from zero here, it will be } + { easy to notice in the generated assembler } + countreg:=GetIntRegister(list,OS_INT); + tmpreg1:=GetIntRegister(list,OS_INT); + a_load_const_reg(list,OS_INT,len,countreg); + { explicitely allocate R_O0 since it can be used safely here } + { (for holding date that's being copied) } + current_asmdata.getjumplabel(lab); + a_label(list, lab); + list.concat(taicpu.op_ref_reg(A_LDUB,src,tmpreg1)); + list.concat(taicpu.op_reg_ref(A_STB,tmpreg1,dst)); + list.concat(taicpu.op_reg_const_reg(A_ADD,src.base,1,src.base)); + list.concat(taicpu.op_reg_const_reg(A_ADD,dst.base,1,dst.base)); + list.concat(taicpu.op_reg_const_reg(A_SUBcc,countreg,1,countreg)); + a_jmp_cond(list,OC_NE,lab); + list.concat(taicpu.op_none(A_NOP)); + { keep the registers alive } + list.concat(taicpu.op_reg_reg(A_MOV,countreg,countreg)); + list.concat(taicpu.op_reg_reg(A_MOV,src.base,src.base)); + list.concat(taicpu.op_reg_reg(A_MOV,dst.base,dst.base)); + end + else + begin + { unrolled loop } + tmpreg1:=GetIntRegister(list,OS_INT); + for i:=1 to len do + begin + list.concat(taicpu.op_ref_reg(A_LDUB,src,tmpreg1)); + list.concat(taicpu.op_reg_ref(A_STB,tmpreg1,dst)); + inc(src.offset); + inc(dst.offset); + end; + end; + end; + end; + + + procedure tcgsparc.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); + var + make_global : boolean; + href : treference; + begin + if not(procdef.proctypeoption in [potype_function,potype_procedure]) then + Internalerror(200006137); + if not assigned(procdef.struct) 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 create_smartlink 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); + + if (po_virtualmethod in procdef.procoptions) and + not is_objectpascal_helper(procdef.struct) then + begin + if (procdef.extnumber=$ffff) then + Internalerror(200006139); + { mov 0(%rdi),%rax ; load vmt} + reference_reset_base(href,NR_O0,0,sizeof(pint)); + cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_G1); + g1_used:=true; + { jmp *vmtoffs(%eax) ; method offs } + reference_reset_base(href,NR_G1,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint)); + list.concat(taicpu.op_ref_reg(A_LD,href,NR_G1)); + list.concat(taicpu.op_reg(A_JMP,NR_G1)); + g1_used:=false; + end + else + begin + reference_reset_symbol(href,current_asmdata.RefAsmSymbol(procdef.mangledname),0,sizeof(pint)); + href.refaddr := addr_high; + list.concat(taicpu.op_ref_reg(A_SETHI,href,NR_G1)); + g1_used:=true; + href.refaddr := addr_low; + list.concat(taicpu.op_reg_ref_reg(A_OR,NR_G1,href,NR_G1)); + list.concat(taicpu.op_reg(A_JMP,NR_G1)); + g1_used:=false; + end; + { Delay slot } + list.Concat(TAiCpu.Op_none(A_NOP)); + + List.concat(Tai_symbol_end.Createname(labelname)); + end; + + procedure tcgsparc.g_stackpointer_alloc(list : TAsmList;localsize : longint); + begin + Comment(V_Error,'tcgsparc.g_stackpointer_alloc method not implemented'); + end; + + procedure tcgsparc.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); + begin + Comment(V_Error,'tcgsparc.a_bit_scan_reg_reg method not implemented'); + end; + +{**************************************************************************** + TCG64Sparc +****************************************************************************} + + + procedure tcg64sparc.a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference); + var + tmpref: treference; + begin + { Override this function to prevent loading the reference twice } + tmpref:=ref; + cg.a_load_reg_ref(list,OS_32,OS_32,reg.reghi,tmpref); + inc(tmpref.offset,4); + cg.a_load_reg_ref(list,OS_32,OS_32,reg.reglo,tmpref); + end; + + + procedure tcg64sparc.a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64); + var + tmpref: treference; + begin + { Override this function to prevent loading the reference twice } + tmpref:=ref; + cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reghi); + inc(tmpref.offset,4); + cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reglo); + end; + + + procedure tcg64sparc.a_load64_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara); + var + hreg64 : tregister64; + begin + { Override this function to prevent loading the reference twice. + Use here some extra registers, but those are optimized away by the RA } + hreg64.reglo:=cg.GetIntRegister(list,OS_32); + hreg64.reghi:=cg.GetIntRegister(list,OS_32); + a_load64_ref_reg(list,r,hreg64); + a_load64_reg_cgpara(list,hreg64,paraloc); + end; + + + procedure TCg64Sparc.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp;checkoverflow : boolean); + begin + case op of + OP_ADD : + begin + op1:=A_ADDCC; + if checkoverflow then + op2:=A_ADDXCC + else + op2:=A_ADDX; + end; + OP_SUB : + begin + op1:=A_SUBCC; + if checkoverflow then + op2:=A_SUBXCC + else + op2:=A_SUBX; + end; + OP_XOR : + begin + op1:=A_XOR; + op2:=A_XOR; + end; + OP_OR : + begin + op1:=A_OR; + op2:=A_OR; + end; + OP_AND : + begin + op1:=A_AND; + op2:=A_AND; + end; + else + internalerror(200203241); + end; + end; + + + procedure TCg64Sparc.a_op64_reg_reg(list:TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst:TRegister64); + var + op1,op2 : TAsmOp; + begin + case op of + OP_NEG : + begin + { Use the simple code: y=0-z } + list.concat(taicpu.op_reg_reg_reg(A_SUBcc,NR_G0,regsrc.reglo,regdst.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_SUBX,NR_G0,regsrc.reghi,regdst.reghi)); + exit; + end; + OP_NOT : + begin + list.concat(taicpu.op_reg_reg_reg(A_XNOR,regsrc.reglo,NR_G0,regdst.reglo)); + list.concat(taicpu.op_reg_reg_reg(A_XNOR,regsrc.reghi,NR_G0,regdst.reghi)); + exit; + end; + end; + get_64bit_ops(op,op1,op2,false); + list.concat(taicpu.op_reg_reg_reg(op1,regdst.reglo,regsrc.reglo,regdst.reglo)); + list.concat(taicpu.op_reg_reg_reg(op2,regdst.reghi,regsrc.reghi,regdst.reghi)); + end; + + + procedure TCg64Sparc.a_op64_const_reg(list:TAsmList;op:TOpCG;size : tcgsize;value:int64;regdst:TRegister64); + var + op1,op2:TAsmOp; + begin + case op of + OP_NEG, + OP_NOT : + internalerror(200306017); + end; + get_64bit_ops(op,op1,op2,false); + tcgsparc(cg).handle_reg_const_reg(list,op1,regdst.reglo,tcgint(lo(value)),regdst.reglo); + tcgsparc(cg).handle_reg_const_reg(list,op2,regdst.reghi,tcgint(hi(value)),regdst.reghi); + end; + + + procedure tcg64sparc.a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64; regsrc,regdst : tregister64); + var + l : tlocation; + begin + a_op64_const_reg_reg_checkoverflow(list,op,size,value,regsrc,regdst,false,l); + end; + + + procedure tcg64sparc.a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64); + var + l : tlocation; + begin + a_op64_reg_reg_reg_checkoverflow(list,op,size,regsrc1,regsrc2,regdst,false,l); + end; + + + procedure tcg64sparc.a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation); + var + op1,op2:TAsmOp; + begin + case op of + OP_NEG, + OP_NOT : + internalerror(200306017); + end; + get_64bit_ops(op,op1,op2,setflags); + tcgsparc(cg).handle_reg_const_reg(list,op1,regsrc.reglo,tcgint(lo(value)),regdst.reglo); + tcgsparc(cg).handle_reg_const_reg(list,op2,regsrc.reghi,tcgint(hi(value)),regdst.reghi); + end; + + + procedure tcg64sparc.a_op64_reg_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation); + var + op1,op2:TAsmOp; + begin + case op of + OP_NEG, + OP_NOT : + internalerror(200306017); + end; + get_64bit_ops(op,op1,op2,setflags); + list.concat(taicpu.op_reg_reg_reg(op1,regsrc2.reglo,regsrc1.reglo,regdst.reglo)); + list.concat(taicpu.op_reg_reg_reg(op2,regsrc2.reghi,regsrc1.reghi,regdst.reghi)); + end; + + + procedure create_codegen; + begin + cg:=TCgSparc.Create; + cg64:=TCg64Sparc.Create; + end; + +end. diff --git a/closures/compiler/sparc/cpubase.pas b/closures/compiler/sparc/cpubase.pas new file mode 100644 index 0000000000..0e658ed74b --- /dev/null +++ b/closures/compiler/sparc/cpubase.pas @@ -0,0 +1,455 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Contains the base types for the SPARC + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit cpubase; + +{$i fpcdefs.inc} + +interface + +uses + globtype,strings,cutils,cclasses,aasmbase,cpuinfo,cgbase; + + +{***************************************************************************** + Assembler Opcodes +*****************************************************************************} + + type +{ TODO: CPU32 opcodes do not fully include the Ultra SPRAC instruction set.} + { don't change the order of these opcodes! } + TAsmOp=({$i opcode.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); + + std_op2str:op2strtable=({$i strinst.inc}); + +{***************************************************************************** + Registers +*****************************************************************************} + + type + { Number of registers used for indexing in tables } + tregisterindex=0..{$i rspnor.inc}-1; + totherregisterset = set of tregisterindex; + + const + { Available Superregisters } + {$i rspsup.inc} + + { No Subregisters } + R_SUBWHOLE = R_SUBD; + + { Available Registers } + {$i rspcon.inc} + + first_int_imreg = $20; + first_fpu_imreg = $20; + + { MM Super register first and last } + first_mm_supreg = 0; + first_mm_imreg = 1; + +{ TODO: Calculate bsstart} + regnumber_count_bsstart = 128; + + regnumber_table : array[tregisterindex] of tregister = ( + {$i rspnum.inc} + ); + + regstabs_table : array[tregisterindex] of ShortInt = ( + {$i rspstab.inc} + ); + + regdwarf_table : array[tregisterindex] of ShortInt = ( + {$i rspdwrf.inc} + ); + + +{***************************************************************************** + Conditions +*****************************************************************************} + + 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, + C_FE,C_FG,C_FL,C_FGE,C_FLE,C_FNE + ); + + const + cond2str:array[TAsmCond] of string[3]=('', + 'gu','cc','cs','leu','cs','e','g','ge','l','le','leu','cs', + 'cc','gu','cc','ne','le','l','ge','g','vc','XX', + 'pos','ne','vs','XX','XX','XX','vs','e', + 'e','g','l','ge','le','ne' + ); + + const + CondAsmOps=2; + CondAsmOp:array[0..CondAsmOps-1] of TAsmOp=( + A_Bxx,A_FBxx + ); + CondAsmOpStr:array[0..CondAsmOps-1] of string[7]=( + 'B','FB' + ); + + +{***************************************************************************** + Flags +*****************************************************************************} + + type + TResFlags=( + { Integer results } + F_E, {Equal} + F_NE, {Not Equal} + F_G, {Greater} + F_L, {Less} + F_GE, {Greater or Equal} + F_LE, {Less or Equal} + F_A, {Above} + F_AE, {Above or Equal} + F_B, {Below} + F_BE, {Below or Equal} + F_C, {Carry} + F_NC, {Not Carry} + { Floating point results } + F_FE, {Equal} + F_FNE, {Not Equal} + F_FG, {Greater} + F_FL, {Less} + F_FGE, {Greater or Equal} + F_FLE {Less or Equal} + ); + +{***************************************************************************** + Operand Sizes +*****************************************************************************} + + +{***************************************************************************** + Constants +*****************************************************************************} + + const + max_operands = 3; + + maxintregs = 8; + maxfpuregs = 8; + maxaddrregs = 0; + + maxvarregs = 8; + varregs : Array [1..maxvarregs] of Tsuperregister = + (RS_L0,RS_L1,RS_L2,RS_L3,RS_L4,RS_L5,RS_L6,RS_L7); + + maxfpuvarregs = 1; + fpuvarregs : Array [1..maxfpuvarregs] of TsuperRegister = + (RS_F2); + + + +{***************************************************************************** + 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_M64; + +{***************************************************************************** + Generic Register names +*****************************************************************************} + + {# Stack pointer register } + NR_STACK_POINTER_REG = NR_O6; + RS_STACK_POINTER_REG = RS_O6; + {# Frame pointer register } + NR_FRAME_POINTER_REG = NR_I6; + RS_FRAME_POINTER_REG = RS_I6; + {# 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 + + Taken from GCC rs6000.h + } +{ TODO: As indicated in rs6000.h, but can't find it anywhere else!} + {PIC_OFFSET_REG = R_30;} + { Return address for DWARF } + NR_RETURN_ADDRESS_REG = NR_I7; + { 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 } + { Results are returned in this register (32-bit values) } + NR_FUNCTION_RETURN_REG = NR_I0; + RS_FUNCTION_RETURN_REG = RS_I0; + { Low part of 64bit return value } + NR_FUNCTION_RETURN64_LOW_REG = NR_I1; + RS_FUNCTION_RETURN64_LOW_REG = RS_I1; + { High part of 64bit return value } + NR_FUNCTION_RETURN64_HIGH_REG = NR_I0; + RS_FUNCTION_RETURN64_HIGH_REG = RS_I0; + { The value returned from a function is available in this register } + NR_FUNCTION_RESULT_REG = NR_O0; + RS_FUNCTION_RESULT_REG = RS_O0; + { The lowh part of 64bit value returned from a function } + NR_FUNCTION_RESULT64_LOW_REG = NR_O1; + RS_FUNCTION_RESULT64_LOW_REG = RS_O1; + { The high part of 64bit value returned from a function } + NR_FUNCTION_RESULT64_HIGH_REG = NR_O0; + RS_FUNCTION_RESULT64_HIGH_REG = RS_O0; + + NR_FPU_RESULT_REG = NR_F0; + NR_MM_RESULT_REG = NR_NO; + + PARENT_FRAMEPOINTER_OFFSET = 68; { o0 } + + +{***************************************************************************** + GCC /ABI linking information +*****************************************************************************} + + {# Registers which must be saved when calling a routine declared as + cppdecl, cdecl, stdcall, safecall, palmossyscall. The registers + saved should be the ones as defined in the target ABI and / or GCC. + + This value can be deduced from CALLED_USED_REGISTERS array in the + GCC source. + } + saved_standard_registers : array[0..0] of tsuperregister = (RS_NO); + + { this is only for the generic code which is not used for this architecture } + saved_mm_registers : array[0..0] of tsuperregister = (RS_NO); + + {# 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; { for 32-bit version only } + + +{***************************************************************************** + CPU Dependent Constants +*****************************************************************************} + + const + simm13lo=-4096; + simm13hi=4095; + +{***************************************************************************** + Helpers +*****************************************************************************} + + function is_calljmp(o:tasmop):boolean; + + procedure inverse_flags(var f: TResFlags); + function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE} + function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE} + + function flags_to_cond(const f: TResFlags) : TAsmCond; + function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister; + function reg_cgsize(const reg: tregister): tcgsize; + function std_regname(r:Tregister):string; + function std_regnum_search(const s:string):Tregister; + function findreg_by_number(r:Tregister):tregisterindex; + function dwarf_reg(r:tregister):shortint; + + +implementation + + uses + rgBase,verbose; + + const + std_regname_table : TRegNameTAble = ( + {$i rspstd.inc} + ); + + regnumber_index : TRegisterIndexTable = ( + {$i rsprni.inc} + ); + + std_regname_index : TRegisterIndexTable = ( + {$i rspsri.inc} + ); + + +{***************************************************************************** + Helpers +*****************************************************************************} + + function is_calljmp(o:tasmop):boolean; + const + CallJmpOp=[A_JMPL..A_CBccc]; + begin + is_calljmp:=(o in CallJmpOp); + end; + + + procedure inverse_flags(var f: TResFlags); + const + inv_flags: array[TResFlags] of TResFlags = + (F_NE,F_E,F_LE,F_GE,F_L,F_G,F_BE,F_B,F_AE,F_A,F_NC,F_C, + F_FNE,F_FE,F_FLE,F_FGE,F_FL,F_FG); + begin + f:=inv_flags[f]; + end; + + + function flags_to_cond(const f:TResFlags):TAsmCond; + const + flags_2_cond:array[TResFlags] of TAsmCond= + (C_E,C_NE,C_G,C_L,C_GE,C_LE,C_A,C_AE,C_B,C_BE,C_C,C_NC, + C_FE,C_FNE,C_FG,C_FL,C_FGE,C_FLE); + begin + result:=flags_2_cond[f]; + end; + + + function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister; + begin + case regtype of + R_FPUREGISTER: + case s of + OS_F32: + cgsize2subreg:=R_SUBFS; + OS_F64: + cgsize2subreg:=R_SUBFD; + OS_F128: + cgsize2subreg:=R_SUBFQ; + else + internalerror(2009071903); + end; + else + begin + if s in [OS_64,OS_S64] then + cgsize2subreg:=R_SUBQ + else + cgsize2subreg:=R_SUBWHOLE; + end; + end; + end; + + + function reg_cgsize(const reg: tregister): tcgsize; + begin + case getregtype(reg) of + R_INTREGISTER : + result:=OS_32; + R_FPUREGISTER : + begin + if getsubreg(reg)=R_SUBFD then + result:=OS_F64 + else + result:=OS_F32; + end; + else + internalerror(200303181); + end; + end; + + + function findreg_by_number(r:Tregister):tregisterindex; + begin + result:=findreg_by_number_table(r,regnumber_index); + end; + + + function std_regname(r:Tregister):string; + var + p : tregisterindex; + begin + { For double floats show a pair like %f0:%f1 } + if (getsubreg(r)=R_SUBFD) and + (getsupreg(r)<first_fpu_imreg) then + begin + setsubreg(r,R_SUBFS); + p:=findreg_by_number(r); + if p<>0 then + result:=std_regname_table[p] + else + result:=generic_regname(r); + setsupreg(r,getsupreg(r)+1); + p:=findreg_by_number(r); + if p<>0 then + result:=result+':'+std_regname_table[p] + else + result:=result+':'+generic_regname(r); + end + else + begin + p:=findreg_by_number(r); + if p<>0 then + result:=std_regname_table[p] + else + result:=generic_regname(r); + end; + 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 inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE} + const + inverse: array[TAsmCond] of TAsmCond=(C_None, + C_NA,C_NAE,C_NB,C_NBE,C_NC,C_NE,C_NG,C_NGE,C_NL,C_NLE,C_A,C_AE, + C_B,C_BE,C_C,C_E,C_G,C_GE,C_L,C_LE,C_O,C_P, + C_S,C_Z,C_NO,C_NP,C_NP,C_P,C_NS,C_NZ, + C_FNE,C_FLE,C_FGE,C_FL,C_FG,C_FE + ); + begin + result := inverse[c]; + end; + + function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE} + begin + result := c1 = c2; + end; + + function dwarf_reg(r:tregister):shortint; + begin + result:=regdwarf_table[findreg_by_number(r)]; + if result=-1 then + internalerror(200603251); + end; + +end. diff --git a/closures/compiler/sparc/cpugas.pas b/closures/compiler/sparc/cpugas.pas new file mode 100644 index 0000000000..a5ce410b42 --- /dev/null +++ b/closures/compiler/sparc/cpugas.pas @@ -0,0 +1,237 @@ +{ + Copyright (c) 1999-2003 by Florian Klaempfl + + This unit implements an asmoutput class for SPARC AT&T syntax + + 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 cpugas; + +{$i fpcdefs.inc} + +interface + + uses + cpubase, + aasmtai,aasmdata,aasmcpu,assemble,aggas; + + type + TGasSPARC=class(TGnuAssembler) + constructor create(smart: boolean); override; + end; + + TSPARCInstrWriter=class(TCPUInstrWriter) + procedure WriteInstruction(hp:Tai);override; + end; + +implementation + + uses + cutils,systems, + verbose,itcpugas,cgbase,cgutils; + + +{****************************************************************************} +{ GNU PPC Assembler writer } +{****************************************************************************} + + constructor TGasSPARC.create(smart: boolean); + begin + inherited create(smart); + InstrWriter := TSPARCInstrWriter.create(self); + end; + + + function GetReferenceString(var ref:TReference):string; + begin + GetReferenceString:=''; + with ref do + begin + if (base=NR_NO) and (index=NR_NO) then + begin + if assigned(symbol) then + GetReferenceString:=symbol.name; + if offset>0 then + GetReferenceString:=GetReferenceString+'+'+ToStr(offset) + else if offset<0 then + GetReferenceString:=GetReferenceString+ToStr(offset); + case refaddr of + addr_high: + GetReferenceString:='%hi('+GetReferenceString+')'; + addr_low: + GetReferenceString:='%lo('+GetReferenceString+')'; + end; + end + else + begin +{$ifdef extdebug} + if assigned(symbol) and + not(refaddr in [addr_pic,addr_low]) then + internalerror(2003052601); +{$endif extdebug} + if base<>NR_NO then + GetReferenceString:=GetReferenceString+gas_regname(base); + if index=NR_NO then + begin + { if (Offset<simm13lo) or (Offset>simm13hi) then + internalerror(2003053008); } + if offset>0 then + GetReferenceString:=GetReferenceString+'+'+ToStr(offset) + else if offset<0 then + GetReferenceString:=GetReferenceString+ToStr(offset); + { + else if (offset=0) and not(assigned(symbol)) then + GetReferenceString:=GetReferenceString+ToStr(offset); + } + if assigned(symbol) then + begin + if refaddr=addr_low then + GetReferenceString:='%lo('+symbol.name+')+'+GetReferenceString + else + GetReferenceString:=symbol.name+'+'+GetReferenceString; + end; + end + else + begin +{$ifdef extdebug} + if (Offset<>0) or assigned(symbol) then + internalerror(2003052603); +{$endif extdebug} + GetReferenceString:=GetReferenceString+'+'+gas_regname(index); + end; + end; + end; + end; + + + function getopstr(const Oper:TOper):string; + begin + with Oper do + case typ of + top_reg: + getopstr:=gas_regname(reg); + top_const: + getopstr:=tostr(longint(val)); + top_ref: + if (oper.ref^.refaddr in [addr_no,addr_pic]) or ((oper.ref^.refaddr=addr_low) and ((oper.ref^.base<>NR_NO) or + (oper.ref^.index<>NR_NO))) then + getopstr:='['+getreferencestring(ref^)+']' + else + getopstr:=getreferencestring(ref^); + else + internalerror(10001); + end; + end; + + + procedure TSPARCInstrWriter.WriteInstruction(hp:Tai); + var + Op:TAsmOp; + s:String; + i:Integer; + begin + if hp.typ<>ait_instruction then + exit; + op:=taicpu(hp).opcode; + { translate pseudoops, this should be move to a separate pass later, so it's done before + peephole optimization } + case op of + A_FABSd: + begin + if (taicpu(hp).ops<>2) or + (taicpu(hp).oper[0]^.typ<>top_reg) or + (taicpu(hp).oper[1]^.typ<>top_reg) then + internalerror(200401045); + { FABSs %f<even>,%f<even> } + s:=#9+std_op2str[A_FABSs]+#9+getopstr(taicpu(hp).oper[0]^)+','+getopstr(taicpu(hp).oper[1]^); + owner.AsmWriteLn(s); + { FMOVs %f<odd>,%f<odd> } + inc(taicpu(hp).oper[0]^.reg); + inc(taicpu(hp).oper[1]^.reg); + s:=#9+std_op2str[A_FMOVs]+#9+getopstr(taicpu(hp).oper[0]^)+','+getopstr(taicpu(hp).oper[1]^); + dec(taicpu(hp).oper[0]^.reg); + dec(taicpu(hp).oper[1]^.reg); + owner.AsmWriteLn(s); + end; + A_FMOVd: + begin + if (taicpu(hp).ops<>2) or + (taicpu(hp).oper[0]^.typ<>top_reg) or + (taicpu(hp).oper[1]^.typ<>top_reg) then + internalerror(200401045); + { FMOVs %f<even>,%f<even> } + s:=#9+std_op2str[A_FMOVs]+#9+getopstr(taicpu(hp).oper[0]^)+','+getopstr(taicpu(hp).oper[1]^); + owner.AsmWriteLn(s); + { FMOVs %f<odd>,%f<odd> } + inc(taicpu(hp).oper[0]^.reg); + inc(taicpu(hp).oper[1]^.reg); + s:=#9+std_op2str[A_FMOVs]+#9+getopstr(taicpu(hp).oper[0]^)+','+getopstr(taicpu(hp).oper[1]^); + dec(taicpu(hp).oper[0]^.reg); + dec(taicpu(hp).oper[1]^.reg); + owner.AsmWriteLn(s); + end + else + begin + { call maybe not translated to call } + s:=#9+std_op2str[op]+cond2str[taicpu(hp).condition]; + if taicpu(hp).delayslot_annulled then + s:=s+',a'; + if taicpu(hp).ops>0 then + begin + s:=s+#9+getopstr(taicpu(hp).oper[0]^); + for i:=1 to taicpu(hp).ops-1 do + s:=s+','+getopstr(taicpu(hp).oper[i]^); + end; + owner.AsmWriteLn(s); + end; + end; + end; + + + const + as_sparc_as_info : tasminfo = + ( + id : as_gas; + idtxt : 'AS'; + asmbin : 'as'; +{$ifdef FPC_SPARC_V8_ONLY} + asmcmd : '-o $OBJ $ASM'; +{$else} + asmcmd : '-Av9 -o $OBJ $ASM'; +{$endif} + supported_targets : [system_sparc_solaris,system_sparc_linux,system_sparc_embedded]; + flags : [af_allowdirect,af_needar,af_smartlink_sections]; + labelprefix : '.L'; + comment : '# '; + ); + + as_sparc_gas_info : tasminfo = + ( + id : as_ggas; + idtxt : 'GAS'; + asmbin : 'gas'; + asmcmd : '-Av9 -o $OBJ $ASM'; + supported_targets : [system_sparc_solaris,system_sparc_linux,system_sparc_embedded]; + flags : [af_allowdirect,af_needar,af_smartlink_sections]; + labelprefix : '.L'; + comment : '# '; + ); + +begin + RegisterAssembler(as_SPARC_as_info,TGasSPARC); + RegisterAssembler(as_SPARC_gas_info,TGasSPARC); +end. diff --git a/closures/compiler/sparc/cpuinfo.pas b/closures/compiler/sparc/cpuinfo.pas new file mode 100644 index 0000000000..41fb3d8608 --- /dev/null +++ b/closures/compiler/sparc/cpuinfo.pas @@ -0,0 +1,89 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Basic Processor information for the SPARC + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit cpuinfo; + +{$i fpcdefs.inc} + +interface + +uses + globtype; + +type + bestreal = double; + ts32real = single; + ts64real = double; + ts80real = extended; + ts128real = type extended; + ts64comp = type extended; + pbestreal=^bestreal; + + { possible supported processors for this target } + tcputype=(cpu_none, + cpu_SPARC_V7, + cpu_SPARC_V8, + cpu_SPARC_V9 + ); + + tfputype =(fpu_none, + fpu_soft, + fpu_hard + ); + + +const + { calling conventions supported by the code generator } + supported_calling_conventions : tproccalloptions = [ + pocall_internproc, + pocall_stdcall, + pocall_cdecl, + pocall_cppdecl + ]; + + cputypestr : array[tcputype] of string[10] = ('', + 'SPARC V7', + 'SPARC V8', + 'SPARC V9' + ); + + fputypestr : array[tfputype] of string[6] = ('', + 'SOFT', + 'HARD' + ); + + { Supported optimizations, only used for information } + supported_optimizerswitches = genericlevel1optimizerswitches+ + genericlevel2optimizerswitches+ + genericlevel3optimizerswitches- + { no need to write info about those } + [cs_opt_level1,cs_opt_level2,cs_opt_level3]+ + [cs_opt_regvar,cs_opt_loopunroll, + cs_opt_tailrecursion,cs_opt_nodecse]; + + level1optimizerswitches = genericlevel1optimizerswitches; + level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + + [cs_opt_regvar,cs_opt_tailrecursion,cs_opt_nodecse]; + level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches + [{,cs_opt_loopunroll}]; + +implementation + +end. diff --git a/closures/compiler/sparc/cpunode.pas b/closures/compiler/sparc/cpunode.pas new file mode 100644 index 0000000000..63fdb77d6f --- /dev/null +++ b/closures/compiler/sparc/cpunode.pas @@ -0,0 +1,38 @@ +{****************************************************************************** + Copyright (c) 2000 by Florian Klaempfl + + Includes the iSPARC 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. + + *****************************************************************************} +unit CpuNode; + +{$I fpcdefs.inc} + +interface +{ This unit is used to define the specific CPU implementations. All needed +actions are included in the INITALIZATION part of these units. This explains +the behaviour of such a unit having just a USES clause! } + +implementation + + uses + ncgbas,ncgflw,ncgcnv,ncgld,ncgmem,ncgcon,ncgset, + ncpuadd,ncpucall,ncpumat,ncpuinln,ncpucnv,ncpuset, + { this not really a node } + rgcpu; + +end. diff --git a/closures/compiler/sparc/cpupara.pas b/closures/compiler/sparc/cpupara.pas new file mode 100644 index 0000000000..aca3bec939 --- /dev/null +++ b/closures/compiler/sparc/cpupara.pas @@ -0,0 +1,357 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Calling conventions for the SPARC + + 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 cpupara; + +{$i fpcdefs.inc} + +interface + + uses + globtype, + cclasses, + aasmtai,aasmdata, + cpubase,cpuinfo, + symconst,symbase,symsym,symtype,symdef,paramgr,parabase,cgbase,cgutils; + + type + TSparcParaManager=class(TParaManager) + function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override; + function get_volatile_registers_int(calloption : tproccalloption):TCpuRegisterSet;override; + function get_volatile_registers_fpu(calloption : tproccalloption):TCpuRegisterSet;override; + {Returns a structure giving the information on the storage of the parameter + (which must be an integer parameter) + @param(nr Parameter number of routine, starting from 1)} + 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; + function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override; + private + procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); + procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist; + var intparareg,parasize:longint); + end; + +implementation + + uses + cutils,verbose,systems, + defutil, + cgobj; + + type + tparasupregs = array[0..5] of tsuperregister; + pparasupregs = ^tparasupregs; + const + paraoutsupregs : tparasupregs = (RS_O0,RS_O1,RS_O2,RS_O3,RS_O4,RS_O5); + parainsupregs : tparasupregs = (RS_I0,RS_I1,RS_I2,RS_I3,RS_I4,RS_I5); + + + function TSparcParaManager.get_volatile_registers_int(calloption : tproccalloption):TCpuRegisterSet; + begin + result:=[RS_G1,RS_O0,RS_O1,RS_O2,RS_O3,RS_O4,RS_O5,RS_O6,RS_O7]; + end; + + + function tsparcparamanager.get_volatile_registers_fpu(calloption : tproccalloption):TCpuRegisterSet; + begin + result:=[RS_F0..RS_F31]; + end; + + + procedure TSparcParaManager.GetIntParaLoc(calloption : tproccalloption; nr : longint;var cgpara : tcgpara); + var + paraloc : pcgparalocation; + begin + if nr<1 then + InternalError(2002100806); + cgpara.reset; + cgpara.size:=OS_ADDR; + cgpara.intsize:=sizeof(pint); + cgpara.alignment:=std_param_align; + paraloc:=cgpara.add_location; + with paraloc^ do + begin + { The six first parameters are passed into registers } + dec(nr); + if nr<6 then + begin + loc:=LOC_REGISTER; + register:=newreg(R_INTREGISTER,(RS_O0+nr),R_SUBWHOLE); + end + else + begin + { The other parameters are passed on the stack } + loc:=LOC_REFERENCE; + reference.index:=NR_STACK_POINTER_REG; + reference.offset:=92+(nr-6)*4; + end; + size:=OS_INT; + end; + end; + + + { true if a parameter is too large to copy and only the address is pushed } + function tsparcparamanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; + begin + result:=false; + { var,out,constref always require address } + if varspez in [vs_var,vs_out,vs_constref] then + begin + result:=true; + exit; + end; + case def.typ of + arraydef: + result:=(tarraydef(def).highrange>=tarraydef(def).lowrange) or + is_open_array(def) or + is_array_of_const(def) or + is_array_constructor(def); + recorddef, + variantdef, + formaldef : + result:=true; + objectdef : + result:=is_object(def); + stringdef : + result:=(tstringdef(def).stringtype in [st_shortstring,st_longstring]); + procvardef : + result:=not tprocvardef(def).is_addressonly; + setdef : + result:=not is_smallset(def); + end; + end; + + + procedure tsparcparamanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); + begin + p.funcretloc[side]:=get_funcretloc(p,side,p.returndef); + end; + + + function tsparcparamanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara; + var + paraloc : pcgparalocation; + retcgsize : tcgsize; + begin + result.init; + result.alignment:=get_para_align(p.proccalloption); + { void has no location } + if is_void(def) then + begin + paraloc:=result.add_location; + result.size:=OS_NO; + result.intsize:=0; + paraloc^.size:=OS_NO; + paraloc^.loc:=LOC_VOID; + exit; + end; + { Constructors return self instead of a boolean } + if (p.proctypeoption=potype_constructor) then + begin + retcgsize:=OS_ADDR; + result.intsize:=sizeof(pint); + end + else + begin + retcgsize:=def_cgsize(def); + result.intsize:=def.size; + end; + result.size:=retcgsize; + { Return is passed as var parameter } + if ret_in_param(def,p.proccalloption) then + begin + paraloc:=result.add_location; + paraloc^.loc:=LOC_REFERENCE; + paraloc^.size:=retcgsize; + exit; + end; + + paraloc:=result.add_location; + { Return in FPU register? } + if def.typ=floatdef then + begin + paraloc^.loc:=LOC_FPUREGISTER; + paraloc^.register:=NR_FPU_RESULT_REG; + if retcgsize=OS_F64 then + setsubreg(paraloc^.register,R_SUBFD); + paraloc^.size:=retcgsize; + end + else + { Return in register } + begin +{$ifndef cpu64bitaddr} + if retcgsize in [OS_64,OS_S64] then + begin + paraloc^.loc:=LOC_REGISTER; + { high } + if side=callerside then + paraloc^.register:=NR_FUNCTION_RESULT64_HIGH_REG + else + paraloc^.register:=NR_FUNCTION_RETURN64_HIGH_REG; + paraloc^.size:=OS_32; + { low } + paraloc:=result.add_location; + paraloc^.loc:=LOC_REGISTER; + if side=callerside then + paraloc^.register:=NR_FUNCTION_RESULT64_LOW_REG + else + paraloc^.register:=NR_FUNCTION_RETURN64_LOW_REG; + paraloc^.size:=OS_32; + end + else +{$endif not cpu64bitaddr} + begin + paraloc^.loc:=LOC_REGISTER; + paraloc^.size:=retcgsize; + if (side=callerside) then + paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RESULT_REG,cgsize2subreg(R_INTREGISTER,retcgsize)) + else + paraloc^.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(R_INTREGISTER,retcgsize)); + end; + end; + end; + + + procedure tsparcparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;paras:tparalist; + var intparareg,parasize:longint); + var + paraloc : pcgparalocation; + i : integer; + hp : tparavarsym; + paracgsize : tcgsize; + hparasupregs : pparasupregs; + paralen : longint; + begin + if side=callerside then + hparasupregs:=@paraoutsupregs + else + hparasupregs:=@parainsupregs; + 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.vardef) 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_G0; + paraloc^.size:=OS_ADDR; + break; + end; + + if push_addr_param(hp.varspez,hp.vardef,p.proccalloption) then + paracgsize:=OS_ADDR + else + begin + paracgsize:=def_cgSize(hp.vardef); + if paracgsize=OS_NO then + paracgsize:=OS_ADDR; + end; + hp.paraloc[side].reset; + hp.paraloc[side].size:=paracgsize; + if (side = callerside) then + hp.paraloc[side].Alignment:=std_param_align + else + hp.paraloc[side].Alignment:=hp.vardef.alignment; + paralen:=tcgsize2size[paracgsize]; + hp.paraloc[side].intsize:=paralen; + while paralen>0 do + begin + paraloc:=hp.paraloc[side].add_location; + { Floats are passed in int registers, + We can allocate at maximum 32 bits per register } + if paracgsize in [OS_64,OS_S64,OS_F32,OS_F64] then + paraloc^.size:=OS_32 + else + paraloc^.size:=paracgsize; + { ret in param? } + if vo_is_funcret in hp.varoptions then + begin + paraloc^.loc:=LOC_REFERENCE; + if side=callerside then + paraloc^.reference.index:=NR_STACK_POINTER_REG + else + paraloc^.reference.index:=NR_FRAME_POINTER_REG; + paraloc^.reference.offset:=64; + end + { In case of po_delphi_nested_cc, the parent frame pointer + is always passed on the stack. } + else if (intparareg<=high(tparasupregs)) and + (not(vo_is_parentfp in hp.varoptions) or + not(po_delphi_nested_cc in p.procoptions)) then + begin + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=newreg(R_INTREGISTER,hparasupregs^[intparareg],R_SUBWHOLE); + inc(intparareg); + end + else + begin + paraloc^.loc:=LOC_REFERENCE; + if side=callerside then + paraloc^.reference.index:=NR_STACK_POINTER_REG + else + paraloc^.reference.index:=NR_FRAME_POINTER_REG; + paraloc^.reference.offset:=target_info.first_parm_offset+parasize; + { Parameters are aligned at 4 bytes } + inc(parasize,align(tcgsize2size[paraloc^.size],sizeof(pint))); + end; + dec(paralen,tcgsize2size[paraloc^.size]); + end; + end; + end; + + + function TSparcParaManager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint; + var + intparareg, + parasize : longint; + begin + intparareg:=0; + parasize:=0; + { calculate the registers for the normal parameters } + create_paraloc_info_intern(p,callerside,p.paras,intparareg,parasize); + { append the varargs } + create_paraloc_info_intern(p,callerside,varargspara,intparareg,parasize); + result:=parasize; + end; + + + + function tsparcparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint; + var + intparareg, + parasize : longint; + begin + intparareg:=0; + parasize:=0; + create_paraloc_info_intern(p,side,p.paras,intparareg,parasize); + { Create Function result paraloc } + create_funcretloc_info(p,side); + { We need to return the size allocated on the stack } + result:=parasize; + end; + + +begin + ParaManager:=TSparcParaManager.create; +end. diff --git a/closures/compiler/sparc/cpupi.pas b/closures/compiler/sparc/cpupi.pas new file mode 100644 index 0000000000..489e7cb62c --- /dev/null +++ b/closures/compiler/sparc/cpupi.pas @@ -0,0 +1,76 @@ +{ + 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. + + **************************************************************************** +} +unit cpupi; + +{$i fpcdefs.inc} + +interface + + uses + cutils, + procinfo,cpuinfo, + psub; + + type + TSparcProcInfo=class(tcgprocinfo) + public + constructor create(aparent:tprocinfo);override; + function calc_stackframe_size:longint;override; + end; + +implementation + + uses + systems,globals, + tgobj,paramgr,symconst; + + constructor tsparcprocinfo.create(aparent:tprocinfo); + begin + inherited create(aparent); + maxpushedparasize:=0; + end; + + + function TSparcProcInfo.calc_stackframe_size:longint; + begin + { + Stackframe layout: + %fp + <locals> + <temp> + <arguments 6-n for calling> + %sp+92 + <space for arguments 0-5> \ + <return pointer for calling> | included in first_parm_offset + <register window save area for calling> / + %sp + + Alignment must be the max available, as doubles require + 8 byte alignment + } + result:=Align(tg.direction*tg.lasttemp+maxpushedparasize+target_info.first_parm_offset,current_settings.alignment.localalignmax); + end; + + +begin + cprocinfo:=TSparcProcInfo; +end. diff --git a/closures/compiler/sparc/cputarg.pas b/closures/compiler/sparc/cputarg.pas new file mode 100644 index 0000000000..a7b77c8467 --- /dev/null +++ b/closures/compiler/sparc/cputarg.pas @@ -0,0 +1,76 @@ +{ + Copyright (c) 2001 by Peter Vreman + + Includes the i386 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 } + +{$ifndef NOOPT} + ,aoptcpu +{$endif NOOPT} + +{************************************** + Targets +**************************************} + + {$ifndef NOTARGETLINUX} + ,t_linux + {$endif} + {$ifndef NOTARGETSUNOS} + ,t_sunos + {$endif} + +{************************************** + Assemblers +**************************************} + + ,CpuGas + +{************************************** + Assembler Readers +**************************************} + + {$ifndef NoSparcgas} + ,racpugas + {$endif NoSparcgas} + +{************************************** + Debuginfo +**************************************} + + {$ifndef NoDbgStabs} + ,dbgstabs + {$endif NoDbgStabs} + {$ifndef NoDbgDwarf} + ,dbgdwarf + {$endif NoDbgDwarf} + + ; + +end. diff --git a/closures/compiler/sparc/itcpugas.pas b/closures/compiler/sparc/itcpugas.pas new file mode 100644 index 0000000000..c3a1ae4599 --- /dev/null +++ b/closures/compiler/sparc/itcpugas.pas @@ -0,0 +1,98 @@ +{ + Copyright (c) 1998-2002 by Mazen NEIFER + + This unit contains the SPARC 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 + gas_op2str : array[tasmop] of string[14] = ({$INCLUDE strinst.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 rspstd.inc} + ); + + gas_regname_index : array[tregisterindex] of tregisterindex = ( + {$i rspsri.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 + hr : tregister; + p : longint; + begin + { Double uses the same table as single } + hr:=r; + case getsubreg(hr) of + R_SUBFD: + setsubreg(hr,R_SUBFS); + R_SUBL,R_SUBW,R_SUBD,R_SUBQ: + setsubreg(hr,R_SUBD); + end; + p:=findreg_by_number(hr); + if p<>0 then + result:=gas_regname_table[p] + else + result:=generic_regname(r); + end; + +end. diff --git a/closures/compiler/sparc/ncpuadd.pas b/closures/compiler/sparc/ncpuadd.pas new file mode 100644 index 0000000000..09e26444cd --- /dev/null +++ b/closures/compiler/sparc/ncpuadd.pas @@ -0,0 +1,376 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + Code generation for add nodes on the SPARC + + 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 ncpuadd; + +{$i fpcdefs.inc} + +interface + + uses + node,ncgadd,cpubase; + + type + tsparcaddnode = class(tcgaddnode) + private + function GetResFlags(unsigned:Boolean):TResFlags; + function GetFPUResFlags:TResFlags; + protected + procedure second_addfloat;override; + procedure second_cmpfloat;override; + procedure second_cmpboolean;override; + procedure second_cmpsmallset;override; + procedure second_cmp64bit;override; + procedure second_cmpordinal;override; + end; + + implementation + + uses + systems, + cutils,verbose, + paramgr,procinfo, + aasmtai,aasmdata,aasmcpu,defutil, + cgbase,cgcpu,cgutils, + cpupara, + ncon,nset,nadd, + ncgutil,cgobj; + +{***************************************************************************** + TSparcAddNode +*****************************************************************************} + + function TSparcAddNode.GetResFlags(unsigned:Boolean):TResFlags; + begin + case NodeType of + equaln: + GetResFlags:=F_E; + unequaln: + GetResFlags:=F_NE; + else + if not(unsigned) then + begin + if nf_swapped in flags then + case NodeType of + ltn: + GetResFlags:=F_G; + lten: + GetResFlags:=F_GE; + gtn: + GetResFlags:=F_L; + gten: + GetResFlags:=F_LE; + end + else + case NodeType of + ltn: + GetResFlags:=F_L; + lten: + GetResFlags:=F_LE; + gtn: + GetResFlags:=F_G; + gten: + GetResFlags:=F_GE; + end; + end + else + begin + if nf_swapped in Flags then + case NodeType of + ltn: + GetResFlags:=F_A; + lten: + GetResFlags:=F_AE; + gtn: + GetResFlags:=F_B; + gten: + GetResFlags:=F_BE; + end + else + case NodeType of + ltn: + GetResFlags:=F_B; + lten: + GetResFlags:=F_BE; + gtn: + GetResFlags:=F_A; + gten: + GetResFlags:=F_AE; + end; + end; + end; + end; + + + function TSparcAddNode.GetFPUResFlags:TResFlags; + begin + case NodeType of + equaln: + result:=F_FE; + unequaln: + result:=F_FNE; + else + begin + if nf_swapped in Flags then + case NodeType of + ltn: + result:=F_FG; + lten: + result:=F_FGE; + gtn: + result:=F_FL; + gten: + result:=F_FLE; + end + else + case NodeType of + ltn: + result:=F_FL; + lten: + result:=F_FLE; + gtn: + result:=F_FG; + gten: + result:=F_FGE; + end; + end; + end; + end; + + + procedure tsparcaddnode.second_addfloat; + var + op : TAsmOp; + begin + pass_left_right; + if (nf_swapped in flags) then + swapleftright; + + { force fpureg as location, left right doesn't matter + as both will be in a fpureg } + location_force_fpureg(current_asmdata.CurrAsmList,left.location,true); + location_force_fpureg(current_asmdata.CurrAsmList,right.location,(left.location.loc<>LOC_CFPUREGISTER)); + + location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); + if left.location.loc<>LOC_CFPUREGISTER then + location.register:=left.location.register + else + location.register:=right.location.register; + + case nodetype of + addn : + begin + if location.size=OS_F64 then + op:=A_FADDd + else + op:=A_FADDs; + end; + muln : + begin + if location.size=OS_F64 then + op:=A_FMULd + else + op:=A_FMULs; + end; + subn : + begin + if location.size=OS_F64 then + op:=A_FSUBd + else + op:=A_FSUBs; + end; + slashn : + begin + if location.size=OS_F64 then + op:=A_FDIVd + else + op:=A_FDIVs; + end; + else + internalerror(200306014); + end; + + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op, + left.location.register,right.location.register,location.register)); + end; + + + procedure tsparcaddnode.second_cmpfloat; + var + op : tasmop; + begin + pass_left_right; + if (nf_swapped in flags) then + swapleftright; + + { force fpureg as location, left right doesn't matter + as both will be in a fpureg } + location_force_fpureg(current_asmdata.CurrAsmList,left.location,true); + location_force_fpureg(current_asmdata.CurrAsmList,right.location,true); + + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=getfpuresflags; + + if left.location.size=OS_F64 then + op:=A_FCMPd + else + op:=A_FCMPs; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op, + left.location.register,right.location.register)); + { Delay slot (can only contain integer operation) } + current_asmdata.CurrAsmList.concat(taicpu.op_none(A_NOP)); + end; + + + procedure tsparcaddnode.second_cmpboolean; + begin + pass_left_right; + force_reg_left_right(true,true); + + if right.location.loc = LOC_CONSTANT then + tcgsparc(cg).handle_reg_const_reg(current_asmdata.CurrAsmList,A_SUBcc,left.location.register,right.location.value,NR_G0) + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBcc,left.location.register,right.location.register,NR_G0)); + + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=getresflags(true); + end; + + + procedure tsparcaddnode.second_cmpsmallset; + begin + pass_left_right; + force_reg_left_right(true,true); + + if right.location.loc = LOC_CONSTANT then + tcgsparc(cg).handle_reg_const_reg(current_asmdata.CurrAsmList,A_SUBcc,left.location.register,right.location.value,NR_G0) + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBcc,left.location.register,right.location.register,NR_G0)); + + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=getresflags(true); + end; + + + procedure tsparcaddnode.second_cmp64bit; + var + unsigned : boolean; + + procedure firstjmp64bitcmp; + var + oldnodetype : tnodetype; + begin + { the jump the sequence is a little bit hairy } + case nodetype of + ltn,gtn: + begin + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrTrueLabel); + { cheat a little bit for the negative test } + toggleflag(nf_swapped); + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrFalseLabel); + toggleflag(nf_swapped); + end; + lten,gten: + begin + oldnodetype:=nodetype; + if nodetype=lten then + nodetype:=ltn + else + nodetype:=gtn; + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrTrueLabel); + { cheat for the negative test } + if nodetype=ltn then + nodetype:=gtn + else + nodetype:=ltn; + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrFalseLabel); + nodetype:=oldnodetype; + end; + equaln: + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,current_procinfo.CurrFalseLabel); + unequaln: + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,current_procinfo.CurrTrueLabel); + end; + end; + + procedure secondjmp64bitcmp; + + begin + { the jump the sequence is a little bit hairy } + case nodetype of + ltn,gtn,lten,gten: + begin + { the comparisaion of the low dword have to be } + { always unsigned! } + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(true),current_procinfo.CurrTrueLabel); + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + end; + equaln: + begin + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,current_procinfo.CurrFalseLabel); + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel); + end; + unequaln: + begin + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,current_procinfo.CurrTrueLabel); + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + end; + end; + end; + + begin + pass_left_right; + force_reg_left_right(false,false); + + unsigned:=not(is_signed(left.resultdef)) or + not(is_signed(right.resultdef)); + + location_reset(location,LOC_JUMP,OS_NO); + + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reghi,right.location.register64.reghi)); + firstjmp64bitcmp; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,left.location.register64.reglo,right.location.register64.reglo)); + secondjmp64bitcmp; + end; + + + procedure tsparcaddnode.second_cmpordinal; + var + unsigned : boolean; + begin + pass_left_right; + force_reg_left_right(true,true); + + unsigned:=not(is_signed(left.resultdef)) or + not(is_signed(right.resultdef)); + + if right.location.loc = LOC_CONSTANT then + tcgsparc(cg).handle_reg_const_reg(current_asmdata.CurrAsmList,A_SUBcc,left.location.register,right.location.value,NR_G0) + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBcc,left.location.register,right.location.register,NR_G0)); + + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=getresflags(unsigned); + end; + +begin + caddnode:=tsparcaddnode; +end. diff --git a/closures/compiler/sparc/ncpucall.pas b/closures/compiler/sparc/ncpucall.pas new file mode 100644 index 0000000000..53ef3f8250 --- /dev/null +++ b/closures/compiler/sparc/ncpucall.pas @@ -0,0 +1,56 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate sparc assembler for in 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 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 ncpucall; + +{$i fpcdefs.inc} + +interface + + uses + ncgcal; + + type + tsparccallnode = class(tcgcallnode) + procedure extra_post_call_code;override; + end; + + +implementation + + uses + cpubase, + aasmtai,aasmdata, + aasmcpu, + paramgr, + ncal; + + + procedure tsparccallnode.extra_post_call_code; + begin + if paramanager.ret_in_param(procdefinition.returndef,procdefinition.proccalloption) then + current_asmdata.CurrAsmList.concat(taicpu.op_const(A_UNIMP,procdefinition.returndef.size and $fff)); + end; + + +begin + ccallnode:=TSparcCallNode; +end. diff --git a/closures/compiler/sparc/ncpucnv.pas b/closures/compiler/sparc/ncpucnv.pas new file mode 100644 index 0000000000..d39bf89ea7 --- /dev/null +++ b/closures/compiler/sparc/ncpucnv.pas @@ -0,0 +1,336 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate SPARC 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 ncpucnv; + +{$i fpcdefs.inc} + +interface + + uses + node,ncnv,ncgcnv,defcmp; + + type + tsparctypeconvnode = class(TCgTypeConvNode) + protected + { 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,globals,systems,globtype, + symconst,symdef,aasmbase,aasmtai,aasmdata, + defutil, + cgbase,cgutils,pass_1,pass_2, + ncon,ncal,procinfo, + ncgutil, + cpubase,aasmcpu, + tgobj,cgobj; + + +{***************************************************************************** + FirstTypeConv +*****************************************************************************} + + function tsparctypeconvnode.first_int_to_real: tnode; + var + fname: string[19]; + begin + { converting a 64bit integer to a float requires a helper } + if is_64bitint(left.resultdef) or + is_currency(left.resultdef) then + begin + result:=inherited first_int_to_real; + exit; + end + else + { other integers are supposed to be 32 bit } + begin + if is_signed(left.resultdef) then + inserttypeconv(left,s32inttype) + else + inserttypeconv(left,u32inttype); + firstpass(left); + end; + result := nil; + expectloc:=LOC_FPUREGISTER; + end; + + +{***************************************************************************** + SecondTypeConv +*****************************************************************************} + + procedure tsparctypeconvnode.second_int_to_real; + + procedure loadsigned; + begin + location_force_mem(current_asmdata.CurrAsmList,left.location); + { Load memory in fpu register } + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,OS_F32,OS_F32,left.location.reference,location.register); + tg.ungetiftemp(current_asmdata.CurrAsmList,left.location.reference); + { Convert value in fpu register from integer to float } + case tfloatdef(resultdef).floattype of + s32real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FiTOs,location.register,location.register)); + s64real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FiTOd,location.register,location.register)); + s128real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FiTOq,location.register,location.register)); + else + internalerror(200408011); + end; + end; + + var + href : treference; + hregister : tregister; + l1,l2 : tasmlabel; + + begin + location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); + if is_signed(left.resultdef) then + begin + location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size); + loadsigned; + end + else + begin + current_asmdata.getdatalabel(l1); + current_asmdata.getjumplabel(l2); + reference_reset_symbol(href,l1,0,8); + hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_32,left.location,hregister); + + { here we need always an 64 bit register } + location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,OS_F64); + location_force_mem(current_asmdata.CurrAsmList,left.location); + { Load memory in fpu register } + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,OS_F32,OS_F32,left.location.reference,location.register); + tg.ungetiftemp(current_asmdata.CurrAsmList,left.location.reference); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FiTOd,location.register,location.register)); + + current_asmdata.CurrAsmList.concat(Taicpu.op_reg_reg(A_CMP,hregister,NR_G0)); + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_GE,l2); + + case tfloatdef(resultdef).floattype of + { converting dword to s64real first and cut off at the end avoids precision loss } + s32real, + s64real: + begin + hregister:=cg.getfpuregister(current_asmdata.CurrAsmList,OS_F64); + new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,l1.name,const_align(8)); + current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l1)); + { I got this constant from a test program (FK) } + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit($41f00000)); + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit(0)); + + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList,OS_F64,OS_F64,href,hregister); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_FADDD,location.register,hregister,location.register)); + cg.a_label(current_asmdata.CurrAsmList,l2); + + { cut off if we should convert to single } + if tfloatdef(resultdef).floattype=s32real then + begin + hregister:=location.register; + location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FDTOS,hregister,location.register)); + end; + end; + else + internalerror(200410031); + end; + end; + end; + + +(* + procedure tsparctypeconvnode.second_real_to_real; + const + conv_op : array[tfloattype,tfloattype] of tasmop = ( + { from: s32 s64 s80 sc80 c64 cur f128 } + { s32 } ( A_FMOVS,A_FDTOS,A_NONE, A_NONE, A_NONE, A_NONE, A_NONE ), + { s64 } ( A_FSTOD,A_FMOVD,A_NONE, A_NONE, A_NONE, A_NONE, A_NONE ), + { s80 } ( A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE ), + { sc80 } ( A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE ), + { c64 } ( A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE ), + { cur } ( A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE ), + { f128 } ( A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE, A_NONE ) + ); + var + op : tasmop; + begin + location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); + location_force_fpureg(current_asmdata.CurrAsmList,left.location,false); + { Convert value in fpu register from integer to float } + op:=conv_op[tfloatdef(resultdef).floattype,tfloatdef(left.resultdef).floattype]; + if op=A_NONE then + internalerror(200401121); + location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,left.location.register,location.register)); + end; +*) + + procedure tsparctypeconvnode.second_int_to_bool; + var + href: treference; + hreg1,hreg2 : tregister; + resflags : tresflags; + opsize : tcgsize; + hlabel,oldTrueLabel,oldFalseLabel : tasmlabel; + newsize : tcgsize; + begin + oldTrueLabel:=current_procinfo.CurrTrueLabel; + oldFalseLabel:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + secondpass(left); + if codegenerror then + exit; + + { Explicit typecasts from any ordinal type to a boolean type } + { must not change the ordinal value } + if (nf_explicit in flags) and + not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then + begin + location_copy(location,left.location); + newsize:=def_cgsize(resultdef); + { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend } + if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or + ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then + location_force_reg(current_asmdata.CurrAsmList,location,newsize,true) + else + location.size:=newsize; + current_procinfo.CurrTrueLabel:=oldTrueLabel; + current_procinfo.CurrFalseLabel:=oldFalseLabel; + exit; + end; + + location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); + opsize:=def_cgsize(left.resultdef); + case left.location.loc of + LOC_CREFERENCE,LOC_REFERENCE,LOC_REGISTER,LOC_CREGISTER: + begin + if left.location.loc in [LOC_CREFERENCE,LOC_REFERENCE] then + begin + hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); +{$ifndef cpu64bitalu} + if left.location.size in [OS_64,OS_S64] then + begin + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,left.location.reference,hreg2); + hreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + href:=left.location.reference; + inc(href.offset,4); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,href,hreg1); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,hreg1,hreg2,hreg2); + end + else +{$endif not cpu64bitalu} + cg.a_load_ref_reg(current_asmdata.CurrAsmList,opsize,opsize,left.location.reference,hreg2); + end + else + begin + hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); +{$ifndef cpu64bitalu} + if left.location.size in [OS_64,OS_S64] then + begin + hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,left.location.register64.reghi,left.location.register64.reglo,hreg2); + end + else +{$endif not cpu64bitalu} + cg.a_load_reg_reg(current_asmdata.CurrAsmList,opsize,opsize,left.location.register,hreg2); + end; + hreg1:=cg.getintregister(current_asmdata.CurrAsmList,opsize); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBCC,NR_G0,hreg2,NR_G0)); + if is_pasbool(resultdef) then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_ADDX,NR_G0,NR_G0,hreg1)) + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUBX,NR_G0,NR_G0,hreg1)); + end; + LOC_FLAGS : + begin + hreg1:=cg.GetIntRegister(current_asmdata.CurrAsmList,location.size); + resflags:=left.location.resflags; + cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,hreg1); + if (is_cbool(resultdef)) then + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,hreg1,hreg1); + end; + LOC_JUMP : + begin + hreg1:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + current_asmdata.getjumplabel(hlabel); + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel); + if not(is_cbool(resultdef)) then + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,1,hreg1) + else + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,-1,hreg1); + cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel); + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,hreg1); + cg.a_label(current_asmdata.CurrAsmList,hlabel); + end; + else + internalerror(10062); + end; +{$ifndef cpu64bitalu} + if (location.size in [OS_64,OS_S64]) then + begin + location.register64.reglo:=hreg1; + location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + if (is_cbool(resultdef)) then + { reglo is either 0 or -1 -> reghi has to become the same } + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,location.register64.reglo,location.register64.reghi) + else + { unsigned } + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reghi); + end + else +{$endif not cpu64bitalu} + location.register:=hreg1; + + current_procinfo.CurrTrueLabel:=oldTrueLabel; + current_procinfo.CurrFalseLabel:=oldFalseLabel; + end; + + +begin + ctypeconvnode:=tsparctypeconvnode; +end. diff --git a/closures/compiler/sparc/ncpuinln.pas b/closures/compiler/sparc/ncpuinln.pas new file mode 100644 index 0000000000..2d81e05da8 --- /dev/null +++ b/closures/compiler/sparc/ncpuinln.pas @@ -0,0 +1,143 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate SPARC 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 ncpuinln; + +{$i fpcdefs.inc} + +interface + + uses + node,ninl,ncginl; + + type + tsparcinlinenode = class(tcgInlineNode) + function first_abs_real: tnode; override; + function first_sqr_real: tnode; override; + function first_sqrt_real: tnode; override; + procedure second_abs_real; override; + procedure second_sqr_real; override; + procedure second_sqrt_real; override; + private + procedure load_fpu_location; + end; + + +implementation + + uses + systems,globtype, + cutils,verbose, + symconst,symdef, + aasmtai,aasmdata,aasmcpu, + cgbase,pass_2, + cpubase,paramgr, + nbas,ncon,ncal,ncnv,nld, + ncgutil,cgobj,cgutils; + +{***************************************************************************** + tsparcinlinenode +*****************************************************************************} + + procedure tsparcinlinenode.load_fpu_location; + begin + secondpass(left); + location_force_fpureg(current_asmdata.CurrAsmList,left.location,true); + location_copy(location,left.location); + if left.location.loc=LOC_CFPUREGISTER then + begin + location.register:=cg.getfpuregister(current_asmdata.CurrAsmList,location.size); + location.loc := LOC_FPUREGISTER; + end; + end; + + + function tsparcinlinenode.first_abs_real : tnode; + begin + expectloc:=LOC_FPUREGISTER; + first_abs_real := nil; + end; + + + function tsparcinlinenode.first_sqr_real : tnode; + begin + expectloc:=LOC_FPUREGISTER; + first_sqr_real:=nil; + end; + + + function tsparcinlinenode.first_sqrt_real : tnode; + begin + expectloc:=LOC_FPUREGISTER; + first_sqrt_real := nil; + end; + + + procedure tsparcinlinenode.second_abs_real; + begin + load_fpu_location; + case tfloatdef(left.resultdef).floattype of + s32real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FABSs,left.location.register,location.register)); + s64real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FABSd,left.location.register,location.register)); + s128real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FABSq,left.location.register,location.register)); + else + internalerror(200410031); + end; + end; + + + procedure tsparcinlinenode.second_sqr_real; + begin + load_fpu_location; + case tfloatdef(left.resultdef).floattype of + s32real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_FMULs,left.location.register,left.location.register,location.register)); + s64real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_FMULd,left.location.register,left.location.register,location.register)); + s128real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_FMULq,left.location.register,left.location.register,location.register)); + else + internalerror(200410032); + end; + end; + + + procedure tsparcinlinenode.second_sqrt_real; + begin + load_fpu_location; + case tfloatdef(left.resultdef).floattype of + s32real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FSQRTs,left.location.register,location.register)); + s64real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FSQRTd,left.location.register,location.register)); + s128real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FSQRTq,left.location.register,location.register)); + else + internalerror(200410033); + end; + end; + +begin + cInlineNode:=tsparcinlinenode; +end. diff --git a/closures/compiler/sparc/ncpumat.pas b/closures/compiler/sparc/ncpumat.pas new file mode 100644 index 0000000000..3793c968d4 --- /dev/null +++ b/closures/compiler/sparc/ncpumat.pas @@ -0,0 +1,332 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate SPARC 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 ncpumat; + +{$i fpcdefs.inc} + +interface + + uses + node,nmat,ncgmat; + + type + tSparcmoddivnode = class(tmoddivnode) + procedure pass_generate_code;override; + end; + + tSparcshlshrnode = class(tshlshrnode) + procedure pass_generate_code;override; + { everything will be handled in pass_2 } + function first_shlshr64bitint: tnode; override; + end; + + tSparcnotnode = class(tcgnotnode) + procedure second_boolean;override; + end; + +implementation + + uses + globtype,systems,constexp, + cutils,verbose,globals, + symconst, + aasmbase,aasmcpu,aasmtai,aasmdata, + defutil, + cgbase,cgobj,pass_2,procinfo, + ncon, + cpubase, + ncgutil,cgcpu,cgutils; + +{***************************************************************************** + TSparcMODDIVNODE +*****************************************************************************} + + procedure tSparcmoddivnode.pass_generate_code; + const + { signed overflow } + divops: array[boolean, boolean] of tasmop = + ((A_UDIV,A_UDIVcc),(A_SDIV,A_SDIVcc)); + var + power : longint; + op : tasmop; + tmpreg, + numerator, + divider, + resultreg : tregister; + overflowlabel : tasmlabel; + ai : taicpu; + begin + secondpass(left); + secondpass(right); + location_copy(location,left.location); + + { put numerator in register } + location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),true); + location_copy(location,left.location); + numerator := location.register; + + if (nodetype = modn) then + resultreg := cg.GetIntRegister(current_asmdata.CurrAsmList,OS_INT) + else + begin + if (location.loc = LOC_CREGISTER) then + begin + location.loc := LOC_REGISTER; + location.register := cg.GetIntRegister(current_asmdata.CurrAsmList,OS_INT); + end; + resultreg := location.register; + end; + + if (nodetype = divn) and + (right.nodetype = ordconstn) and + ispowerof2(tordconstnode(right).value.svalue,power) then + begin + if is_signed(left.resultdef) Then + begin + tmpreg:=cg.GetIntRegister(current_asmdata.CurrAsmList,OS_INT); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SAR,OS_INT,31,numerator,tmpreg); + { if signed, tmpreg=right value-1, otherwise 0 } + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_AND,OS_INT,tordconstnode(right).value.svalue-1,tmpreg); + { add to the left value } + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_ADD,OS_INT,numerator,tmpreg); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SAR,OS_INT,aword(power),tmpreg,resultreg); + end + else + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_INT,aword(power),numerator,resultreg); + end + else + begin + { load divider in a register if necessary } + location_force_reg(current_asmdata.CurrAsmList,right.location, + def_cgsize(right.resultdef),true); + divider := right.location.register; + + { needs overflow checking, (-maxlongint-1) div (-1) overflows! } + { And on Sparc, the only way to catch a div-by-0 is by checking } + { the overflow flag (JM) } + + { Fill %y with the -1 or 0 depending on the highest bit } + if is_signed(left.resultdef) then + begin + tmpreg:=cg.GetIntRegister(current_asmdata.CurrAsmList,OS_INT); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const_reg(A_SRA,numerator,31,tmpreg)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_MOV,tmpreg,NR_Y)); + end + else + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_MOV,NR_G0,NR_Y)); + { wait 3 instructions slots before we can read %y } + current_asmdata.CurrAsmList.concat(taicpu.op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(taicpu.op_none(A_NOP)); + current_asmdata.CurrAsmList.concat(taicpu.op_none(A_NOP)); + + op := divops[is_signed(right.resultdef), + cs_check_overflow in current_settings.localswitches]; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,numerator,divider,resultreg)); + + if (nodetype = modn) then + begin + current_asmdata.getjumplabel(overflowlabel); + ai:=taicpu.op_cond_sym(A_Bxx,C_O,overflowlabel); + ai.delayslot_annulled:=true; + current_asmdata.CurrAsmList.concat(ai); + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_NOT,resultreg)); + cg.a_label(current_asmdata.CurrAsmList,overflowlabel); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SMUL,resultreg,divider,resultreg)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_SUB,numerator,resultreg,resultreg)); + end; + end; + { set result location } + location.loc:=LOC_REGISTER; + location.register:=resultreg; + cg.g_overflowcheck(current_asmdata.CurrAsmList,Location,resultdef); + end; + + +{***************************************************************************** + TSparcSHLRSHRNODE +*****************************************************************************} + + function TSparcShlShrNode.first_shlshr64bitint:TNode; + begin + { 64bit without constants need a helper } + if is_64bit(left.resultdef) and + (right.nodetype<>ordconstn) then + begin + result:=inherited first_shlshr64bitint; + exit; + end; + + result := nil; + end; + + + procedure tSparcshlshrnode.pass_generate_code; + var + hregister,resultreg,hregister1, + hreg64hi,hreg64lo : tregister; + op : topcg; + shiftval: aword; + begin + { 64bit without constants need a helper, and is + already replaced in pass1 } + if is_64bit(left.resultdef) and + (right.nodetype<>ordconstn) then + internalerror(200405301); + + secondpass(left); + secondpass(right); + if is_64bit(left.resultdef) then + begin + location_reset(location,LOC_REGISTER,OS_64); + + { load left operator in a register } + location_force_reg(current_asmdata.CurrAsmList,left.location,OS_64,false); + hreg64hi:=left.location.register64.reghi; + hreg64lo:=left.location.register64.reglo; + + shiftval := tordconstnode(right).value.svalue and 63; + if shiftval > 31 then + begin + if nodetype = shln then + begin + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,hreg64hi); + if (shiftval and 31) <> 0 then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_32,shiftval and 31,hreg64lo,hreg64lo); + end + else + begin + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,hreg64lo); + if (shiftval and 31) <> 0 then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_32,shiftval and 31,hreg64hi,hreg64hi); + end; + location.register64.reglo:=hreg64hi; + location.register64.reghi:=hreg64lo; + end + else + begin + hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + if nodetype = shln then + begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_32,32-shiftval,hreg64lo,hregister); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_32,shiftval,hreg64hi,hreg64hi); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,hregister,hreg64hi,hreg64hi); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_32,shiftval,hreg64lo,hreg64lo); + end + else + begin + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_32,32-shiftval,hreg64hi,hregister); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_32,shiftval,hreg64lo,hreg64lo); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,hregister,hreg64lo,hreg64lo); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHR,OS_32,shiftval,hreg64hi,hreg64hi); + end; + location.register64.reghi:=hreg64hi; + location.register64.reglo:=hreg64lo; + end; + end + else + begin + { load left operators in a register } + location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),true); + location_copy(location,left.location); + resultreg := location.register; + hregister1 := location.register; + if (location.loc = LOC_CREGISTER) then + begin + location.loc := LOC_REGISTER; + resultreg := cg.GetIntRegister(current_asmdata.CurrAsmList,OS_INT); + location.register := resultreg; + end; + { determine operator } + if nodetype=shln then + op:=OP_SHL + else + op:=OP_SHR; + { shifting by a constant directly coded: } + if (right.nodetype=ordconstn) then + begin + if tordconstnode(right).value and 31<>0 then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,op,OS_32,tordconstnode(right).value.svalue and 31,hregister1,resultreg) + end + else + begin + { load shift count in a register if necessary } + location_force_reg(current_asmdata.CurrAsmList,right.location,def_cgsize(right.resultdef),true); + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,op,OS_32,right.location.register,hregister1,resultreg); + end; + end; + end; + + +{***************************************************************************** + TSPARCNOTNODE +*****************************************************************************} + + procedure tsparcnotnode.second_boolean; + var + hl : tasmlabel; + begin + { if the location is LOC_JUMP, we do the secondpass after the + labels are allocated + } + if left.expectloc=LOC_JUMP then + begin + hl:=current_procinfo.CurrTrueLabel; + current_procinfo.CurrTrueLabel:=current_procinfo.CurrFalseLabel; + current_procinfo.CurrFalseLabel:=hl; + secondpass(left); + maketojumpbool(current_asmdata.CurrAsmList,left,lr_load_regvars); + hl:=current_procinfo.CurrTrueLabel; + current_procinfo.CurrTrueLabel:=current_procinfo.CurrFalseLabel; + current_procinfo.CurrFalseLabel:=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, + LOC_SUBSETREG, LOC_CSUBSETREG, + LOC_SUBSETREF, LOC_CSUBSETREF: + begin + location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resultdef),true); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const_reg(A_SUBcc,left.location.register,0,NR_G0)); + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=F_E; + end; + else + internalerror(2003042401); + end; + end; + end; + + +begin + cmoddivnode:=tSparcmoddivnode; + cshlshrnode:=tSparcshlshrnode; + cnotnode:=tSparcnotnode; +end. diff --git a/closures/compiler/sparc/ncpuset.pas b/closures/compiler/sparc/ncpuset.pas new file mode 100644 index 0000000000..ef562c62c1 --- /dev/null +++ b/closures/compiler/sparc/ncpuset.pas @@ -0,0 +1,126 @@ +{ + Copyright (c) 1998-2004 by Florian Klaempfl + + Generate sparc assembler for in set/case 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 ncpuset; + +{$i fpcdefs.inc} + + interface + + uses + globtype, + nset, + ncgset; + + type + tcpucasenode = class(tcgcasenode) + protected + procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);override; + function has_jumptable : boolean;override; + procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override; + end; + + + implementation + + uses + globals,constexp, + systems, + cpubase, + aasmbase,aasmtai,aasmdata,aasmcpu, + cgbase,cgutils,cgobj, + procinfo; + + procedure tcpucasenode.optimizevalues(var max_linear_list:aint;var max_dist:aword); + begin + { give the jump table a higher priority } + max_dist:=(max_dist*3) div 2; + end; + + + function tcpucasenode.has_jumptable : boolean; + begin + has_jumptable:=true; + end; + + + procedure tcpucasenode.genjumptable(hp : pcaselabel;min_,max_ : aint); + var + table : tasmlabel; + last : TConstExprInt; + indexreg,jmpreg,basereg : tregister; + href : treference; + + procedure genitem(list:TAsmList;t : pcaselabel); + var + i : aint; + begin + if assigned(t^.less) then + genitem(list,t^.less); + { fill possible hole } + for i:=last.svalue+1 to t^._low.svalue-1 do + list.concat(Tai_const.Create_sym(elselabel)); + for i:=t^._low.svalue to t^._high.svalue do + list.concat(Tai_const.Create_sym(blocklabel(t^.blockid))); + last:=t^._high; + if assigned(t^.greater) then + genitem(list,t^.greater); + end; + + begin + if not(jumptable_no_range) then + begin + { case expr less than min_ => goto elselabel } + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,jmp_lt,aint(min_),hregister,elselabel); + { case expr greater than max_ => goto elselabel } + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,jmp_gt,aint(max_),hregister,elselabel); + end; + current_asmdata.getjumplabel(table); + indexreg:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_ADDR,2,hregister,indexreg); + { create reference } + reference_reset_symbol(href,table,0,sizeof(pint)); + href.offset:=(-aint(min_))*4; + basereg:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,href,basereg); + + jmpreg:=cg.getaddressregister(current_asmdata.CurrAsmList); + + reference_reset(href,sizeof(pint)); + href.index:=indexreg; + href.base:=basereg; + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,href,jmpreg); + + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_JMP,jmpreg)); + { Delay slot } + current_asmdata.CurrAsmList.concat(taicpu.op_none(A_NOP)); + { generate jump table } + new_section(current_procinfo.aktlocaldata,sec_data,current_procinfo.procdef.mangledname,sizeof(pint)); + current_procinfo.aktlocaldata.concat(Tai_label.Create(table)); + last:=min_; + genitem(current_procinfo.aktlocaldata,hp); + end; + + + +begin + ccasenode:=tcpucasenode; +end. diff --git a/closures/compiler/sparc/opcode.inc b/closures/compiler/sparc/opcode.inc new file mode 100644 index 0000000000..d0d29b24f5 --- /dev/null +++ b/closures/compiler/sparc/opcode.inc @@ -0,0 +1,75 @@ +{****************************************************************************** + *****************************************************************************} +A_NONE, +A_ABCD, +A_ADD,A_ADDcc,A_ADDX,A_ADDXcc, +A_AND,A_ANDcc,A_ANDN,A_ANDNcc, +{Branching instructions} +A_JMP, +A_JMPL, +A_CALL, +A_BA,A_Bxx,A_FBA,A_FBxx, +A_CBccc, +A_FLUSH, +{Load instructions} +A_LDSB,A_LDSH,A_LDSTUB, +A_LDUB,A_LDUH,A_LD,A_LDD,A_LDF,A_LDFSR,A_LDDF,A_LDC,A_LDCSR,A_LDDC, +A_LDSBA,A_LDSHA,A_LDUBA,A_LDUHA,A_LDA,A_LDDA, +A_LDSTUBA, +A_MULScc, +A_NOP, +A_OR,A_ORcc,A_ORN,A_ORNcc, +A_RDASR,A_RDY,A_RDPSR,A_RDWIM,A_RDTBR, +A_RESTORE, +A_RET,A_RETL, +A_SAVE, +A_SDIV,A_SDIVcc, +A_SMUL,A_SMULcc, +A_SETHI, +A_SLL,A_SRL,A_SRA, +A_STB,A_STH,A_ST,A_STD,A_STF,A_STDF,A_STFSR,A_STDFQ, +A_STC,A_STDC,A_STCSR,A_STDCQ, +A_STBA,A_STHA,A_STA,A_STDA, +A_SUB,A_SUBcc,A_SUBX,A_SUBXcc, +A_SWAP,A_SWAPA,A_Ticc,A_TADDcc,A_TSUBcc,A_TADDccTV,A_TSUBccTV, +A_TA,A_Txx, +A_UDIV,A_UDIVcc, +A_UMUL,A_UMULcc, +A_UNIMP, +A_WRASR,A_WRY,A_WRPSR,A_WRWIM,A_WRTBR, +A_XNOR,A_XNORcc, +A_XOR,A_XORcc, + {Floating-point instructions} +A_FiTOs,A_FiTOd,A_FiTOq, +A_FsTOi,A_FdTOi,A_FqTOi, +A_FsTOd,A_FsTOq, +A_FdTOs,A_FdTOq, +A_FqTOd,A_FqTOs, +A_FMOVs,A_FNEGs,A_FABSs, +A_FSQRTs,A_FSQRTd,A_FSQRTq, +A_FADDs,A_FADDd,A_FADDq, +A_FSUBs,A_FSUBd,A_FSUBq, +A_FMULs,A_FMULd,A_FMULQ, +A_FdMULq,A_FsMULd, +A_FDIVs,A_FDIVd,A_FDIVq, +A_FCMPs,A_FCMPd,A_FCMPq, +A_FCPop1,A_CPop2, + {Synthetic instructions} +A_btst,A_bset,A_bclr,A_btog, +A_clr,A_clrb,A_clrh, +A_cmp, +A_dec,A_deccc, +A_inc,A_inccc, +A_MOV, +A_NEG, +A_not, +A_set, +A_skipz,A_skipnz, +A_tst, +{ Internal instructions } +A_FMOVd, +A_FABSd, +A_FABSq, +{ Memory barrier instructions } +A_STBAR, +A_MEMBAR diff --git a/closures/compiler/sparc/racpu.pas b/closures/compiler/sparc/racpu.pas new file mode 100644 index 0000000000..aa56288442 --- /dev/null +++ b/closures/compiler/sparc/racpu.pas @@ -0,0 +1,54 @@ +{ + Copyright (c) 1998-2003 by Mazen NEIFER + + Handles the common Sparc 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 racpu; + +{$i fpcdefs.inc} + +interface + + uses + aasmbase,aasmtai,aasmdata,aasmcpu, + cpubase,rautils,cclasses; + + type + TSparcOperand=class(TOperand) + end; + + TSparcInstruction=class(TInstruction) + delayslot_annulled : boolean; + { opcode adding } + function ConcatInstruction(p : TAsmList) : tai;override; + end; + +implementation + + function TSparcInstruction.ConcatInstruction(p : TAsmList) : tai; + begin + result:=inherited ConcatInstruction(p); + { delay slot annulled support } + if assigned(result) and + (result.typ=ait_instruction) and + delayslot_annulled then + taicpu(result).delayslot_annulled:=true; + end; + +end. diff --git a/closures/compiler/sparc/racpugas.pas b/closures/compiler/sparc/racpugas.pas new file mode 100644 index 0000000000..4bf644893e --- /dev/null +++ b/closures/compiler/sparc/racpugas.pas @@ -0,0 +1,688 @@ +{ + Copyright (c) 1998-2002 by Mazen NEIFER + + Does the parsing for the i386 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 racpugas; + +{$i fpcdefs.inc} + +Interface + + uses + raatt,racpu; + + type + tSparcReader = class(tattreader) + function is_asmopcode(const s: string):boolean;override; + procedure handleopcode;override; + procedure BuildReference(oper : tSparcoperand); + procedure BuildOperand(oper : tSparcoperand); + procedure BuildOpCode(instr : tSparcinstruction); + procedure ReadPercent(oper : tSparcoperand); + procedure ReadSym(oper : tSparcoperand); + procedure ConvertCalljmp(instr : tSparcinstruction); + procedure handlepercent;override; + end; + + + Implementation + + uses + { helpers } + cutils, + { global } + globtype,verbose, + systems, + { aasm } + cpubase,aasmbase,aasmtai,aasmdata,aasmcpu, + { symtable } + symconst,symsym, + { parser } + scanner, + procinfo, + rabase,rautils, + cgbase,cgobj + ; + + procedure TSparcReader.ReadSym(oper : tSparcoperand); + var + tempstr, mangledname : string; + typesize,l,k : aint; + 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,mangledname,false); + if (mangledname<>'') then + Message(asmr_e_invalid_reference_syntax); + inc(oper.opr.ref.offset,l); + end; + end; + + + procedure TSparcReader.ReadPercent(oper : tSparcoperand); + begin + { check for ...@ } + if actasmtoken=AS_AT then + begin + if (oper.opr.ref.symbol=nil) and + (oper.opr.ref.offset = 0) then + Message(asmr_e_invalid_reference_syntax); + Consume(AS_AT); + if actasmtoken=AS_ID then + begin + if upper(actasmpattern)='LO' then + oper.opr.ref.refaddr:=addr_low + else if upper(actasmpattern)='HI' then + oper.opr.ref.refaddr:=addr_high + else + Message(asmr_e_invalid_reference_syntax); + Consume(AS_ID); + end + else + Message(asmr_e_invalid_reference_syntax); + end; + end; + + + Procedure TSparcReader.BuildReference(oper : tSparcoperand); + var + l : aint; + regs : byte; + hasimm : boolean; + begin + oper.initref; + regs:=0; + hasimm:=false; + Consume(AS_LBRACKET); + repeat + Case actasmtoken of + AS_INTNUM, + AS_MINUS, + AS_PLUS: + Begin + if hasimm or (regs>1) then + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(true); + break; + End; + oper.opr.Ref.Offset:=BuildConstExpression(false,true); + hasimm:=true; + End; + + AS_REGISTER: + Begin + if regs<2 then + begin + if regs=0 then + oper.opr.ref.base:=actasmregister + else + oper.opr.ref.index:=actasmregister; + inc(regs); + end + else + begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(true); + break; + end; + Consume(AS_REGISTER); + end; + + AS_ID: + Begin + l:=BuildConstExpression(true,true); + inc(oper.opr.ref.offset,l); + End; + + AS_RBRACKET: + begin + if (regs=0) and (not hasimm) then + Message(asmr_e_invalid_reference_syntax); + Consume(AS_RBRACKET); + break; + end; + + else + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + break; + end; + end; + until false; + end; + + + procedure TSparcReader.handlepercent; + var + len : longint; + begin + len:=1; + actasmpattern[len]:='%'; + c:=current_scanner.asmgetchar; + { to be a register there must be a letter and not a number } + while c in ['a'..'z','A'..'Z','0'..'9'] do + Begin + inc(len); + actasmpattern[len]:=c; + c:=current_scanner.asmgetchar; + end; + actasmpattern[0]:=chr(len); + uppervar(actasmpattern); + if is_register(actasmpattern) then + exit; + if (actasmpattern='%HI') then + actasmtoken:=AS_HI + else if (actasmpattern='%LO')then + actasmtoken:=AS_LO + else + Message(asmr_e_invalid_register); + end; + + + Procedure TSparcReader.BuildOperand(oper : tSparcoperand); + var + expr : string; + typesize,l : aint; + + 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 + mangledname: string; + hasdot : boolean; + l, + toffset, + tsize : aint; + 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,mangledname,false); + if (oper.opr.typ<>OPR_CONSTANT) and + (mangledname<>'') then + Message(asmr_e_wrong_sym_type); + 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 : + if (mangledname<>'') then + begin + if (oper.opr.val<>0) then + Message(asmr_e_wrong_sym_type); + oper.opr.typ:=OPR_SYMBOL; + oper.opr.symbol:=current_asmdata.RefAsmSymbol(mangledname); + end + else + inc(oper.opr.val,l); + OPR_REFERENCE : + inc(oper.opr.ref.offset,l); + OPR_SYMBOL: + Message(asmr_e_invalid_symbol_ref); + else + internalerror(200309221); + end; + end; + + var + tempreg : tregister; + tempstr : string; + tempsymtyp : TAsmSymType; + hl : tasmlabel; + gotplus, + negative : boolean; + Begin + expr:=''; + gotplus:=true; + negative:=false; + repeat + case actasmtoken of + AS_MINUS : + begin + consume(AS_MINUS); + negative:=true; + gotplus:=true; + end; + + AS_PLUS : + begin + consume(AS_PLUS); + negative:=false; + gotplus:=true; + end; + + AS_INTNUM, + AS_MOD: + Begin + if not gotplus then + Message(asmr_e_invalid_reference_syntax); + l:=BuildConstExpression(True,False); + if negative then + l:=-l; + { Constant memory offset } + oper.InitRef; + oper.opr.ref.refaddr:=addr_full; + oper.opr.ref.offset:=l; + GotPlus:=(prevasmtoken=AS_PLUS) or + (prevasmtoken=AS_MINUS); + if GotPlus then + negative:=(prevasmtoken=AS_MINUS); + end; + + AS_LBRACKET : + begin + { memory reference } + BuildReference(oper); + gotplus:=false; + end; + + AS_HI, + AS_LO: + begin + { Low or High part of a constant (or constant + memory location) } + oper.InitRef; + if actasmtoken=AS_LO then + oper.opr.ref.refaddr:=addr_low + else + oper.opr.ref.refaddr:=addr_high; + Consume(actasmtoken); + Consume(AS_LPAREN); + BuildConstSymbolExpression(false, true,false,l,tempstr,tempsymtyp); + if not assigned(oper.opr.ref.symbol) then + oper.opr.ref.symbol:=current_asmdata.RefAsmSymbol(tempstr) + else + Message(asmr_e_cant_have_multiple_relocatable_symbols); + 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; + Consume(AS_RPAREN); + gotplus:=false; + 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 oper.SetupVar(expr,false) then + ReadPercent(oper) + else + 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; + gotplus:=false; + end; + + AS_REGISTER: { Register, a variable reference or a constant reference } + Begin + { save the type of register used. } + tempreg:=actasmregister; + Consume(AS_REGISTER); + if (oper.opr.typ in [OPR_REGISTER,OPR_REFERENCE]) and gotplus then + begin + oper.initref; + oper.opr.ref.refaddr:=addr_full; + if oper.opr.ref.base<>NR_NO then + oper.opr.ref.base:=tempreg + else + if oper.opr.ref.index<>NR_NO then + oper.opr.ref.index:=tempreg + else + Message(asmr_e_multiple_index); + end + else + begin + if (oper.opr.typ<>OPR_NONE) then + Message(asmr_e_invalid_operand_type); + oper.opr.typ:=OPR_REGISTER; + oper.opr.reg:=tempreg; + end; + gotplus:=false; + end; + + AS_END, + AS_SEPARATOR, + AS_COMMA: + break; + else + Begin + Message(asmr_e_syn_operand); + Consume(actasmtoken); + end; + end; { end case } + until false; + end; + + +{***************************************************************************** + TSparcReader +*****************************************************************************} + + procedure TSparcReader.BuildOpCode(instr : tSparcinstruction); + 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; + 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; + + { delayslot annulled? } + if (actasmtoken=AS_COMMA) then + begin + consume(AS_COMMA); + if actasmpattern='A' then + instr.delayslot_annulled:=true; + { force reading of AS_COMMA instead of AS_ID, otherwise + a label .L0 will first read a AS_DOT instead of AS_ID } + actasmtoken:=AS_COMMA; + consume(AS_COMMA); + end; + + { Read the operands } + repeat + case actasmtoken of + AS_COMMA: { Operand delimiter } + Begin + if operandnum>Max_Operands then + Message(asmr_e_too_many_operands) + else + begin + { condition operands doesn't set the operand but write to the + condition field of the instruction + } + if instr.Operands[operandnum].opr.typ<>OPR_NONE then + Inc(operandnum); + end; + Consume(AS_COMMA); + end; + AS_SEPARATOR, + AS_END : { End of asm operands for this opcode } + begin + break; + end; + else + BuildOperand(instr.Operands[operandnum] as tSparcoperand); + end; { end case } + until false; + if (operandnum=1) and (instr.Operands[operandnum].opr.typ=OPR_NONE) then + dec(operandnum); + instr.Ops:=operandnum; + end; + + + function TSparcReader.is_asmopcode(const s: string):boolean; + var + cond:TAsmCond; + Begin + { making s a value parameter would break other assembler readers } + is_asmopcode:=false; + + { clear op code } + actopcode:=A_None; + { clear condition } + fillchar(actcondition,sizeof(actcondition),0); + + { Search opcodes } + actopcode:=tasmop(PtrUInt(iasmops.Find(s))); + if actopcode<>A_NONE then + begin + actasmtoken:=AS_OPCODE; + result:=TRUE; + exit; + end; + + { not found, check branch instructions } + if (Upcase(s[1])='B') or + ((Upcase(s[1])='F') and (Upcase(s[2])='B')) then + begin + { we can search here without an extra table which is sorted by string length + because we take the whole remaining string without the leading B } + if (Upcase(s[1])='F') then + actopcode := A_FBxx + else + actopcode := A_Bxx; + for cond:=low(TAsmCond) to high(TAsmCond) do + if (Upper(copy(s,2,length(s)-1))=Upper(Cond2Str[cond])) then + begin + actasmtoken:=AS_OPCODE; + actcondition:=cond; + is_asmopcode:=true; + end; + end; + end; + + + procedure TSparcReader.ConvertCalljmp(instr : tSparcinstruction); + var + newopr : toprrec; + begin + if instr.Operands[1].opr.typ=OPR_REFERENCE then + with newopr do + begin + typ:=OPR_SYMBOL; + symbol:=instr.Operands[1].opr.ref.symbol; + 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) or + (instr.Operands[1].opr.ref.refaddr<>addr_full) then + Message(asmr_e_syn_operand); + instr.Operands[1].opr:=newopr; + end; + end; + + + procedure TSparcReader.handleopcode; + var + instr : tSparcinstruction; + begin + instr:=TSparcInstruction.Create(TSparcOperand); + BuildOpcode(instr); + with instr do + begin + condition := actcondition; + if is_calljmp(opcode) then + ConvertCalljmp(instr); + ConcatInstruction(curlist); + Free; + end; + end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +const + asmmode_Sparc_att_info : tasmmodeinfo = + ( + id : asmmode_Sparc_gas; + idtxt : 'GAS'; + casmreader : TSparcReader; + ); + + asmmode_Sparc_standard_info : tasmmodeinfo = + ( + id : asmmode_standard; + idtxt : 'STANDARD'; + casmreader : TSparcReader; + ); + +initialization + RegisterAsmMode(asmmode_Sparc_att_info); + RegisterAsmMode(asmmode_Sparc_standard_info); +end. diff --git a/closures/compiler/sparc/rgcpu.pas b/closures/compiler/sparc/rgcpu.pas new file mode 100644 index 0000000000..5297337ecf --- /dev/null +++ b/closures/compiler/sparc/rgcpu.pas @@ -0,0 +1,164 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements the SPARC 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,aasmcpu,aasmtai,aasmdata, + cgbase,cgutils, + cpubase, + rgobj; + + type + trgcpu=class(trgobj) + procedure add_constraints(reg:tregister);override; + function get_spill_subreg(r : tregister) : tsubregister;override; + procedure do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override; + procedure do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister);override; + end; + + +implementation + + uses + verbose,cutils, + globtype, + cgobj; + + procedure trgcpu.add_constraints(reg:tregister); + var + supreg,i : Tsuperregister; + begin + case getsubreg(reg) of + { Let 64bit floats conflict with all odd float regs } + R_SUBFD: + begin + supreg:=getsupreg(reg); + i:=RS_F1; + while (i<=RS_F31) do + begin + add_edge(supreg,i); + inc(i,2); + end; + end; + { Let 64bit ints conflict with all odd int regs } + R_SUBQ: + begin + supreg:=getsupreg(reg); + i:=RS_G1; + while (i<=RS_I7) do + begin + add_edge(supreg,i); + inc(i,2); + end; + end; + end; + end; + + + function trgcpu.get_spill_subreg(r : tregister) : tsubregister; + begin + if getregtype(r)=R_FPUREGISTER then + result:=getsubreg(r) + else + result:=defaultsub; + end; + + + procedure trgcpu.do_spill_read(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister); + var + helpins : tai; + tmpref : treference; + helplist : TAsmList; + hreg : tregister; + begin + if abs(spilltemp.offset)>4095 then + begin + helplist:=TAsmList.create; + + if getregtype(tempreg)=R_INTREGISTER then + hreg:=tempreg + else + hreg:=cg.getintregister(helplist,OS_ADDR); + + reference_reset(tmpref,sizeof(pint)); + tmpref.offset:=spilltemp.offset; + tmpref.refaddr:=addr_high; + helplist.concat(taicpu.op_ref_reg(A_SETHI,tmpref,hreg)); + + tmpref.refaddr:=addr_low; + helplist.concat(taicpu.op_reg_ref_reg(A_OR,hreg,tmpref,hreg)); + + reference_reset_base(tmpref,hreg,0,sizeof(aint)); + tmpref.index:=spilltemp.base; + + helpins:=spilling_create_load(tmpref,tempreg); + helplist.concat(helpins); + list.insertlistafter(pos,helplist); + helplist.free; + end + else + inherited do_spill_read(list,pos,spilltemp,tempreg); + end; + + + procedure trgcpu.do_spill_written(list:TAsmList;pos:tai;const spilltemp:treference;tempreg:tregister); + var + tmpref : treference; + helplist : TAsmList; + hreg : tregister; + begin + if abs(spilltemp.offset)>4095 then + begin + helplist:=TAsmList.create; + + if getregtype(tempreg)=R_INTREGISTER then + hreg:=getregisterinline(helplist,[R_SUBWHOLE]) + else + hreg:=cg.getintregister(helplist,OS_ADDR); + + reference_reset(tmpref,sizeof(aint)); + tmpref.offset:=spilltemp.offset; + tmpref.refaddr:=addr_high; + helplist.concat(taicpu.op_ref_reg(A_SETHI,tmpref,hreg)); + + tmpref.refaddr:=addr_low; + helplist.concat(taicpu.op_reg_ref_reg(A_OR,hreg,tmpref,hreg)); + + reference_reset_base(tmpref,hreg,0,sizeof(aint)); + tmpref.index:=spilltemp.base; + + helplist.concat(spilling_create_store(tempreg,tmpref)); + if getregtype(tempreg)=R_INTREGISTER then + ungetregisterinline(helplist,hreg); + + list.insertlistafter(pos,helplist); + helplist.free; + end + else + inherited do_spill_written(list,pos,spilltemp,tempreg); + end; + +end. diff --git a/closures/compiler/sparc/rspcon.inc b/closures/compiler/sparc/rspcon.inc new file mode 100644 index 0000000000..5a84a0ba4e --- /dev/null +++ b/closures/compiler/sparc/rspcon.inc @@ -0,0 +1,140 @@ +{ don't edit, this file is generated from spreg.dat } +NR_NO = tregister($00000000); +NR_G0 = tregister($01040000); +NR_G1 = tregister($01040001); +NR_G2 = tregister($01040002); +NR_G3 = tregister($01040003); +NR_G4 = tregister($01040004); +NR_G5 = tregister($01040005); +NR_G6 = tregister($01040006); +NR_G7 = tregister($01040007); +NR_O0 = tregister($01040008); +NR_O1 = tregister($01040009); +NR_O2 = tregister($0104000a); +NR_O3 = tregister($0104000b); +NR_O4 = tregister($0104000c); +NR_O5 = tregister($0104000d); +NR_O6 = tregister($0104000e); +NR_O7 = tregister($0104000f); +NR_L0 = tregister($01040010); +NR_L1 = tregister($01040011); +NR_L2 = tregister($01040012); +NR_L3 = tregister($01040013); +NR_L4 = tregister($01040014); +NR_L5 = tregister($01040015); +NR_L6 = tregister($01040016); +NR_L7 = tregister($01040017); +NR_I0 = tregister($01040018); +NR_I1 = tregister($01040019); +NR_I2 = tregister($0104001a); +NR_I3 = tregister($0104001b); +NR_I4 = tregister($0104001c); +NR_I5 = tregister($0104001d); +NR_I6 = tregister($0104001e); +NR_I7 = tregister($0104001f); +NR_FP = tregister($0104001e); +NR_SP = tregister($0104000e); +NR_F0 = tregister($02060000); +NR_F1 = tregister($02060001); +NR_F2 = tregister($02060002); +NR_F3 = tregister($02060003); +NR_F4 = tregister($02060004); +NR_F5 = tregister($02060005); +NR_F6 = tregister($02060006); +NR_F7 = tregister($02060007); +NR_F8 = tregister($02060008); +NR_F9 = tregister($02060009); +NR_F10 = tregister($0206000a); +NR_F11 = tregister($0206000b); +NR_F12 = tregister($0206000c); +NR_F13 = tregister($0206000d); +NR_F14 = tregister($0206000e); +NR_F15 = tregister($0206000f); +NR_F16 = tregister($02060010); +NR_F17 = tregister($02060011); +NR_F18 = tregister($02060012); +NR_F19 = tregister($02060013); +NR_F20 = tregister($02060014); +NR_F21 = tregister($02060015); +NR_F22 = tregister($02060016); +NR_F23 = tregister($02060017); +NR_F24 = tregister($02060018); +NR_F25 = tregister($02060019); +NR_F26 = tregister($0206001a); +NR_F27 = tregister($0206001b); +NR_F28 = tregister($0206001c); +NR_F29 = tregister($0206001d); +NR_F30 = tregister($0206001e); +NR_F31 = tregister($0206001f); +NR_C0 = tregister($03000000); +NR_C1 = tregister($03000001); +NR_C2 = tregister($03000002); +NR_C3 = tregister($03000003); +NR_C4 = tregister($03000004); +NR_C5 = tregister($03000005); +NR_C6 = tregister($03000006); +NR_C7 = tregister($03000007); +NR_C8 = tregister($03000008); +NR_C9 = tregister($03000009); +NR_C10 = tregister($0300000a); +NR_C11 = tregister($0300000b); +NR_C12 = tregister($0300000c); +NR_C13 = tregister($0300000d); +NR_C14 = tregister($0300000e); +NR_C15 = tregister($0300000f); +NR_C16 = tregister($03000010); +NR_C17 = tregister($03000011); +NR_C18 = tregister($03000012); +NR_C19 = tregister($03000013); +NR_C20 = tregister($03000014); +NR_C21 = tregister($03000015); +NR_C22 = tregister($03000016); +NR_C23 = tregister($03000017); +NR_C24 = tregister($03000018); +NR_C25 = tregister($03000019); +NR_C26 = tregister($0300001a); +NR_C27 = tregister($0300001b); +NR_C28 = tregister($0300001c); +NR_C29 = tregister($0300001d); +NR_C30 = tregister($0300001e); +NR_C31 = tregister($0300001f); +NR_FSR = tregister($05000000); +NR_FQ = tregister($05000001); +NR_CSR = tregister($05000002); +NR_CQ = tregister($05000003); +NR_PSR = tregister($05000004); +NR_TBR = tregister($05000005); +NR_WIM = tregister($05000006); +NR_Y = tregister($05000007); +NR_ASR0 = tregister($04000000); +NR_ASR1 = tregister($04000001); +NR_ASR2 = tregister($04000002); +NR_ASR3 = tregister($04000003); +NR_ASR4 = tregister($04000004); +NR_ASR5 = tregister($04000005); +NR_ASR6 = tregister($04000006); +NR_ASR7 = tregister($04000007); +NR_ASR8 = tregister($04000008); +NR_ASR9 = tregister($04000009); +NR_ASR10 = tregister($0400000a); +NR_ASR11 = tregister($0400000b); +NR_ASR12 = tregister($0400000c); +NR_ASR13 = tregister($0400000d); +NR_ASR14 = tregister($0400000e); +NR_ASR15 = tregister($0400000f); +NR_ASR16 = tregister($04000010); +NR_ASR17 = tregister($04000011); +NR_ASR18 = tregister($04000012); +NR_ASR19 = tregister($04000013); +NR_ASR20 = tregister($04000014); +NR_ASR21 = tregister($04000015); +NR_ASR22 = tregister($04000016); +NR_ASR23 = tregister($04000017); +NR_ASR24 = tregister($04000018); +NR_ASR25 = tregister($04000019); +NR_ASR26 = tregister($0400001a); +NR_ASR27 = tregister($0400001b); +NR_ASR28 = tregister($0400001c); +NR_ASR29 = tregister($0400001d); +NR_ASR30 = tregister($0400001e); +NR_ASR31 = tregister($0400001f); diff --git a/closures/compiler/sparc/rspdwrf.inc b/closures/compiler/sparc/rspdwrf.inc new file mode 100644 index 0000000000..8bee9c4af9 --- /dev/null +++ b/closures/compiler/sparc/rspdwrf.inc @@ -0,0 +1,140 @@ +{ don't edit, this file is generated from spreg.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, +24, +25, +26, +27, +28, +29, +30, +31, +30, +14, +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, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +70, +65, +71, +65, +65, +67, +66, +64, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32 diff --git a/closures/compiler/sparc/rspnor.inc b/closures/compiler/sparc/rspnor.inc new file mode 100644 index 0000000000..b6f96d936f --- /dev/null +++ b/closures/compiler/sparc/rspnor.inc @@ -0,0 +1,2 @@ +{ don't edit, this file is generated from spreg.dat } +139 diff --git a/closures/compiler/sparc/rspnum.inc b/closures/compiler/sparc/rspnum.inc new file mode 100644 index 0000000000..b268537c8b --- /dev/null +++ b/closures/compiler/sparc/rspnum.inc @@ -0,0 +1,140 @@ +{ don't edit, this file is generated from spreg.dat } +NR_NO, +NR_G0, +NR_G1, +NR_G2, +NR_G3, +NR_G4, +NR_G5, +NR_G6, +NR_G7, +NR_O0, +NR_O1, +NR_O2, +NR_O3, +NR_O4, +NR_O5, +NR_O6, +NR_O7, +NR_L0, +NR_L1, +NR_L2, +NR_L3, +NR_L4, +NR_L5, +NR_L6, +NR_L7, +NR_I0, +NR_I1, +NR_I2, +NR_I3, +NR_I4, +NR_I5, +NR_I6, +NR_I7, +NR_FP, +NR_SP, +NR_F0, +NR_F1, +NR_F2, +NR_F3, +NR_F4, +NR_F5, +NR_F6, +NR_F7, +NR_F8, +NR_F9, +NR_F10, +NR_F11, +NR_F12, +NR_F13, +NR_F14, +NR_F15, +NR_F16, +NR_F17, +NR_F18, +NR_F19, +NR_F20, +NR_F21, +NR_F22, +NR_F23, +NR_F24, +NR_F25, +NR_F26, +NR_F27, +NR_F28, +NR_F29, +NR_F30, +NR_F31, +NR_C0, +NR_C1, +NR_C2, +NR_C3, +NR_C4, +NR_C5, +NR_C6, +NR_C7, +NR_C8, +NR_C9, +NR_C10, +NR_C11, +NR_C12, +NR_C13, +NR_C14, +NR_C15, +NR_C16, +NR_C17, +NR_C18, +NR_C19, +NR_C20, +NR_C21, +NR_C22, +NR_C23, +NR_C24, +NR_C25, +NR_C26, +NR_C27, +NR_C28, +NR_C29, +NR_C30, +NR_C31, +NR_FSR, +NR_FQ, +NR_CSR, +NR_CQ, +NR_PSR, +NR_TBR, +NR_WIM, +NR_Y, +NR_ASR0, +NR_ASR1, +NR_ASR2, +NR_ASR3, +NR_ASR4, +NR_ASR5, +NR_ASR6, +NR_ASR7, +NR_ASR8, +NR_ASR9, +NR_ASR10, +NR_ASR11, +NR_ASR12, +NR_ASR13, +NR_ASR14, +NR_ASR15, +NR_ASR16, +NR_ASR17, +NR_ASR18, +NR_ASR19, +NR_ASR20, +NR_ASR21, +NR_ASR22, +NR_ASR23, +NR_ASR24, +NR_ASR25, +NR_ASR26, +NR_ASR27, +NR_ASR28, +NR_ASR29, +NR_ASR30, +NR_ASR31 diff --git a/closures/compiler/sparc/rsprni.inc b/closures/compiler/sparc/rsprni.inc new file mode 100644 index 0000000000..578709e2a8 --- /dev/null +++ b/closures/compiler/sparc/rsprni.inc @@ -0,0 +1,140 @@ +{ don't edit, this file is generated from spreg.dat } +0, +1, +2, +3, +4, +5, +6, +7, +8, +9, +10, +11, +12, +13, +14, +15, +34, +16, +17, +18, +19, +20, +21, +22, +23, +24, +25, +26, +27, +28, +29, +30, +31, +33, +32, +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, +73, +74, +75, +76, +77, +78, +79, +80, +81, +82, +83, +84, +85, +86, +87, +88, +89, +90, +91, +92, +93, +94, +95, +96, +97, +98, +107, +108, +109, +110, +111, +112, +113, +114, +115, +116, +117, +118, +119, +120, +121, +122, +123, +124, +125, +126, +127, +128, +129, +130, +131, +132, +133, +134, +135, +136, +137, +138, +99, +100, +101, +102, +103, +104, +105, +106 diff --git a/closures/compiler/sparc/rspsri.inc b/closures/compiler/sparc/rspsri.inc new file mode 100644 index 0000000000..da5ec0a078 --- /dev/null +++ b/closures/compiler/sparc/rspsri.inc @@ -0,0 +1,140 @@ +{ don't edit, this file is generated from spreg.dat } +107, +108, +117, +118, +119, +120, +121, +122, +123, +124, +125, +126, +109, +127, +128, +129, +130, +131, +132, +133, +134, +135, +136, +110, +137, +138, +111, +112, +113, +114, +115, +116, +67, +68, +77, +78, +79, +80, +81, +82, +83, +84, +85, +86, +69, +87, +88, +89, +90, +91, +92, +93, +94, +95, +96, +70, +97, +98, +71, +72, +73, +74, +75, +76, +102, +101, +35, +36, +45, +46, +47, +48, +49, +50, +51, +52, +53, +54, +37, +55, +56, +57, +58, +59, +60, +61, +62, +63, +64, +38, +65, +66, +39, +40, +41, +42, +43, +44, +33, +100, +99, +1, +2, +3, +4, +5, +6, +7, +8, +25, +26, +27, +28, +29, +30, +31, +32, +17, +18, +19, +20, +21, +22, +23, +24, +9, +10, +11, +12, +13, +14, +15, +16, +103, +34, +104, +105, +106, +0 diff --git a/closures/compiler/sparc/rspstab.inc b/closures/compiler/sparc/rspstab.inc new file mode 100644 index 0000000000..8bee9c4af9 --- /dev/null +++ b/closures/compiler/sparc/rspstab.inc @@ -0,0 +1,140 @@ +{ don't edit, this file is generated from spreg.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, +24, +25, +26, +27, +28, +29, +30, +31, +30, +14, +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, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +70, +65, +71, +65, +65, +67, +66, +64, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32, +32 diff --git a/closures/compiler/sparc/rspstd.inc b/closures/compiler/sparc/rspstd.inc new file mode 100644 index 0000000000..189ed36a2f --- /dev/null +++ b/closures/compiler/sparc/rspstd.inc @@ -0,0 +1,140 @@ +{ don't edit, this file is generated from spreg.dat } +'INVALID', +'%g0', +'%g1', +'%g2', +'%g3', +'%g4', +'%g5', +'%g6', +'%g7', +'%o0', +'%o1', +'%o2', +'%o3', +'%o4', +'%o5', +'%o6', +'%o7', +'%l0', +'%l1', +'%l2', +'%l3', +'%l4', +'%l5', +'%l6', +'%l7', +'%i0', +'%i1', +'%i2', +'%i3', +'%i4', +'%i5', +'%i6', +'%i7', +'%fp', +'%sp', +'%f0', +'%f1', +'%f2', +'%f3', +'%f4', +'%f5', +'%f6', +'%f7', +'%f8', +'%f9', +'%f10', +'%f11', +'%f12', +'%f13', +'%f14', +'%f15', +'%f16', +'%f17', +'%f18', +'%f19', +'%f20', +'%f21', +'%f22', +'%f23', +'%f24', +'%f25', +'%f26', +'%f27', +'%f28', +'%f29', +'%f30', +'%f31', +'%c0', +'%c1', +'%c2', +'%c3', +'%c4', +'%c5', +'%c6', +'%c7', +'%c8', +'%c9', +'%c10', +'%c11', +'%c12', +'%c13', +'%c14', +'%c15', +'%c16', +'%c17', +'%c18', +'%c19', +'%c20', +'%c21', +'%c22', +'%c23', +'%c24', +'%c25', +'%c26', +'%c27', +'%c28', +'%c29', +'%c30', +'%c31', +'%fsr', +'%fq', +'%csr', +'%cq', +'%psr', +'%tbr', +'%wim', +'%y', +'%asr0', +'%asr1', +'%asr2', +'%asr3', +'%asr4', +'%asr5', +'%asr6', +'%asr7', +'%asr8', +'%asr9', +'%asr10', +'%asr11', +'%asr12', +'%asr13', +'%asr14', +'%asr15', +'%asr16', +'%asr17', +'%asr18', +'%asr19', +'%asr20', +'%asr21', +'%asr22', +'%asr23', +'%asr24', +'%asr25', +'%asr26', +'%asr27', +'%asr28', +'%asr29', +'%asr30', +'%asr31' diff --git a/closures/compiler/sparc/rspsup.inc b/closures/compiler/sparc/rspsup.inc new file mode 100644 index 0000000000..68600f52a6 --- /dev/null +++ b/closures/compiler/sparc/rspsup.inc @@ -0,0 +1,140 @@ +{ don't edit, this file is generated from spreg.dat } +RS_NO = $00; +RS_G0 = $00; +RS_G1 = $01; +RS_G2 = $02; +RS_G3 = $03; +RS_G4 = $04; +RS_G5 = $05; +RS_G6 = $06; +RS_G7 = $07; +RS_O0 = $08; +RS_O1 = $09; +RS_O2 = $0a; +RS_O3 = $0b; +RS_O4 = $0c; +RS_O5 = $0d; +RS_O6 = $0e; +RS_O7 = $0f; +RS_L0 = $10; +RS_L1 = $11; +RS_L2 = $12; +RS_L3 = $13; +RS_L4 = $14; +RS_L5 = $15; +RS_L6 = $16; +RS_L7 = $17; +RS_I0 = $18; +RS_I1 = $19; +RS_I2 = $1a; +RS_I3 = $1b; +RS_I4 = $1c; +RS_I5 = $1d; +RS_I6 = $1e; +RS_I7 = $1f; +RS_FP = $1e; +RS_SP = $0e; +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_F8 = $08; +RS_F9 = $09; +RS_F10 = $0a; +RS_F11 = $0b; +RS_F12 = $0c; +RS_F13 = $0d; +RS_F14 = $0e; +RS_F15 = $0f; +RS_F16 = $10; +RS_F17 = $11; +RS_F18 = $12; +RS_F19 = $13; +RS_F20 = $14; +RS_F21 = $15; +RS_F22 = $16; +RS_F23 = $17; +RS_F24 = $18; +RS_F25 = $19; +RS_F26 = $1a; +RS_F27 = $1b; +RS_F28 = $1c; +RS_F29 = $1d; +RS_F30 = $1e; +RS_F31 = $1f; +RS_C0 = $00; +RS_C1 = $01; +RS_C2 = $02; +RS_C3 = $03; +RS_C4 = $04; +RS_C5 = $05; +RS_C6 = $06; +RS_C7 = $07; +RS_C8 = $08; +RS_C9 = $09; +RS_C10 = $0a; +RS_C11 = $0b; +RS_C12 = $0c; +RS_C13 = $0d; +RS_C14 = $0e; +RS_C15 = $0f; +RS_C16 = $10; +RS_C17 = $11; +RS_C18 = $12; +RS_C19 = $13; +RS_C20 = $14; +RS_C21 = $15; +RS_C22 = $16; +RS_C23 = $17; +RS_C24 = $18; +RS_C25 = $19; +RS_C26 = $1a; +RS_C27 = $1b; +RS_C28 = $1c; +RS_C29 = $1d; +RS_C30 = $1e; +RS_C31 = $1f; +RS_FSR = $00; +RS_FQ = $01; +RS_CSR = $02; +RS_CQ = $03; +RS_PSR = $04; +RS_TBR = $05; +RS_WIM = $06; +RS_Y = $07; +RS_ASR0 = $00; +RS_ASR1 = $01; +RS_ASR2 = $02; +RS_ASR3 = $03; +RS_ASR4 = $04; +RS_ASR5 = $05; +RS_ASR6 = $06; +RS_ASR7 = $07; +RS_ASR8 = $08; +RS_ASR9 = $09; +RS_ASR10 = $0a; +RS_ASR11 = $0b; +RS_ASR12 = $0c; +RS_ASR13 = $0d; +RS_ASR14 = $0e; +RS_ASR15 = $0f; +RS_ASR16 = $10; +RS_ASR17 = $11; +RS_ASR18 = $12; +RS_ASR19 = $13; +RS_ASR20 = $14; +RS_ASR21 = $15; +RS_ASR22 = $16; +RS_ASR23 = $17; +RS_ASR24 = $18; +RS_ASR25 = $19; +RS_ASR26 = $1a; +RS_ASR27 = $1b; +RS_ASR28 = $1c; +RS_ASR29 = $1d; +RS_ASR30 = $1e; +RS_ASR31 = $1f; diff --git a/closures/compiler/sparc/spreg.dat b/closures/compiler/sparc/spreg.dat new file mode 100644 index 0000000000..45b03fb046 --- /dev/null +++ b/closures/compiler/sparc/spreg.dat @@ -0,0 +1,173 @@ +; +; Sparc registers +; +; layout +; <name>,<regtype>,<regnum>,<stdname>,<stabidx>,<dwarfidx> +; +NO,$00,$00,$00,INVALID,-1,-1 +; Integer registers +G0,$01,$04,$00,%g0,0,0 +G1,$01,$04,$01,%g1,1,1 +G2,$01,$04,$02,%g2,2,2 +G3,$01,$04,$03,%g3,3,3 +G4,$01,$04,$04,%g4,4,4 +G5,$01,$04,$05,%g5,5,5 +G6,$01,$04,$06,%g6,6,6 +G7,$01,$04,$07,%g7,7,7 +O0,$01,$04,$08,%o0,8,8 +O1,$01,$04,$09,%o1,9,9 +O2,$01,$04,$0a,%o2,10,10 +O3,$01,$04,$0b,%o3,11,11 +O4,$01,$04,$0c,%o4,12,12 +O5,$01,$04,$0d,%o5,13,13 +O6,$01,$04,$0e,%o6,14,14 +O7,$01,$04,$0f,%o7,15,15 +L0,$01,$04,$10,%l0,16,16 +L1,$01,$04,$11,%l1,17,17 +L2,$01,$04,$12,%l2,18,18 +L3,$01,$04,$13,%l3,19,19 +L4,$01,$04,$14,%l4,20,20 +L5,$01,$04,$15,%l5,21,21 +L6,$01,$04,$16,%l6,22,22 +L7,$01,$04,$17,%l7,23,23 +I0,$01,$04,$18,%i0,24,24 +I1,$01,$04,$19,%i1,25,25 +I2,$01,$04,$1a,%i2,26,26 +I3,$01,$04,$1b,%i3,27,27 +I4,$01,$04,$1c,%i4,28,28 +I5,$01,$04,$1d,%i5,29,29 +I6,$01,$04,$1e,%i6,30,30 +I7,$01,$04,$1f,%i7,31,31 +; Aliases for stackpointer (%o6) and framepointer (%i6) +FP,$01,$04,$1e,%fp,30,30 +SP,$01,$04,$0e,%sp,14,14 +; Float registers, single use +F0,$02,$06,$00,%f0,32,32 +F1,$02,$06,$01,%f1,33,33 +F2,$02,$06,$02,%f2,34,34 +F3,$02,$06,$03,%f3,35,35 +F4,$02,$06,$04,%f4,36,36 +F5,$02,$06,$05,%f5,37,37 +F6,$02,$06,$06,%f6,38,38 +F7,$02,$06,$07,%f7,39,39 +F8,$02,$06,$08,%f8,40,40 +F9,$02,$06,$09,%f9,41,41 +F10,$02,$06,$0a,%f10,42,42 +F11,$02,$06,$0b,%f11,43,43 +F12,$02,$06,$0c,%f12,44,44 +F13,$02,$06,$0d,%f13,45,45 +F14,$02,$06,$0e,%f14,46,46 +F15,$02,$06,$0f,%f15,47,47 +F16,$02,$06,$10,%f16,48,48 +F17,$02,$06,$11,%f17,49,49 +F18,$02,$06,$12,%f18,50,50 +F19,$02,$06,$13,%f19,51,51 +F20,$02,$06,$14,%f20,52,52 +F21,$02,$06,$15,%f21,53,53 +F22,$02,$06,$16,%f22,54,54 +F23,$02,$06,$17,%f23,55,55 +F24,$02,$06,$18,%f24,56,56 +F25,$02,$06,$19,%f25,57,57 +F26,$02,$06,$1a,%f26,58,58 +F27,$02,$06,$1b,%f27,59,59 +F28,$02,$06,$1c,%f28,60,60 +F29,$02,$06,$1d,%f29,61,61 +F30,$02,$06,$1e,%f30,62,62 +F31,$02,$06,$1f,%f31,63,63 +; Float registers, double use +; Not enabled for now Pierre +; D0,$02,$07,$00,%d0,72,72 +; D2,$02,$07,$02,%d2,73,73 +; D4,$02,$07,$04,%d4,74,74 +; D6,$02,$07,$06,%d6,75,75 +; D8,$02,$07,$08,%d8,76,76 +; D10,$02,$07,$0a,%d10,77,77 +; D12,$02,$07,$0c,%d12,78,78 +; D14,$02,$07,$0e,%d14,79,79 +; D16,$02,$07,$10,%d16,80,80 +; D18,$02,$07,$12,%d18,81,81 +; D20,$02,$07,$14,%d20,82,82 +; D22,$02,$07,$16,%d22,83,83 +; D24,$02,$07,$18,%d24,84,84 +; D26,$02,$07,$1a,%d26,85,85 +; D28,$02,$07,$1c,%d28,86,86 +; D30,$02,$07,$1e,%d30,87,87 + + +; Coprocessor registers +C0,$03,$00,$00,%c0,32,32 +C1,$03,$00,$01,%c1,32,32 +C2,$03,$00,$02,%c2,32,32 +C3,$03,$00,$03,%c3,32,32 +C4,$03,$00,$04,%c4,32,32 +C5,$03,$00,$05,%c5,32,32 +C6,$03,$00,$06,%c6,32,32 +C7,$03,$00,$07,%c7,32,32 +C8,$03,$00,$08,%c8,32,32 +C9,$03,$00,$09,%c9,32,32 +C10,$03,$00,$0a,%c10,32,32 +C11,$03,$00,$0b,%c11,32,32 +C12,$03,$00,$0c,%c12,32,32 +C13,$03,$00,$0d,%c13,32,32 +C14,$03,$00,$0e,%c14,32,32 +C15,$03,$00,$0f,%c15,32,32 +C16,$03,$00,$10,%c16,32,32 +C17,$03,$00,$11,%c17,32,32 +C18,$03,$00,$12,%c18,32,32 +C19,$03,$00,$13,%c19,32,32 +C20,$03,$00,$14,%c20,32,32 +C21,$03,$00,$15,%c21,32,32 +C22,$03,$00,$16,%c22,32,32 +C23,$03,$00,$17,%c23,32,32 +C24,$03,$00,$18,%c24,32,32 +C25,$03,$00,$19,%c25,32,32 +C26,$03,$00,$1a,%c26,32,32 +C27,$03,$00,$1b,%c27,32,32 +C28,$03,$00,$1c,%c28,32,32 +C29,$03,$00,$1d,%c29,32,32 +C30,$03,$00,$1e,%c30,32,32 +C31,$03,$00,$1f,%c31,32,32 + +; Special registers +FSR,$05,$00,$00,%fsr,70,70 +FQ,$05,$00,$01,%fq,65,65 +CSR,$05,$00,$02,%csr,71,71 +CQ,$05,$00,$03,%cq,65,65 +PSR,$05,$00,$04,%psr,65,65 +TBR,$05,$00,$05,%tbr,67,67 +WIM,$05,$00,$06,%wim,66,66 +Y,$05,$00,$07,%y,64,64 + +; Ancillary State Registers +ASR0,$04,$00,$00,%asr0,32,32 +ASR1,$04,$00,$01,%asr1,32,32 +ASR2,$04,$00,$02,%asr2,32,32 +ASR3,$04,$00,$03,%asr3,32,32 +ASR4,$04,$00,$04,%asr4,32,32 +ASR5,$04,$00,$05,%asr5,32,32 +ASR6,$04,$00,$06,%asr6,32,32 +ASR7,$04,$00,$07,%asr7,32,32 +ASR8,$04,$00,$08,%asr8,32,32 +ASR9,$04,$00,$09,%asr9,32,32 +ASR10,$04,$00,$0a,%asr10,32,32 +ASR11,$04,$00,$0b,%asr11,32,32 +ASR12,$04,$00,$0c,%asr12,32,32 +ASR13,$04,$00,$0d,%asr13,32,32 +ASR14,$04,$00,$0e,%asr14,32,32 +ASR15,$04,$00,$0f,%asr15,32,32 +ASR16,$04,$00,$10,%asr16,32,32 +ASR17,$04,$00,$11,%asr17,32,32 +ASR18,$04,$00,$12,%asr18,32,32 +ASR19,$04,$00,$13,%asr19,32,32 +ASR20,$04,$00,$14,%asr20,32,32 +ASR21,$04,$00,$15,%asr21,32,32 +ASR22,$04,$00,$16,%asr22,32,32 +ASR23,$04,$00,$17,%asr23,32,32 +ASR24,$04,$00,$18,%asr24,32,32 +ASR25,$04,$00,$19,%asr25,32,32 +ASR26,$04,$00,$1a,%asr26,32,32 +ASR27,$04,$00,$1b,%asr27,32,32 +ASR28,$04,$00,$1c,%asr28,32,32 +ASR29,$04,$00,$1d,%asr29,32,32 +ASR30,$04,$00,$1e,%asr30,32,32 +ASR31,$04,$00,$1f,%asr31,32,32 diff --git a/closures/compiler/sparc/strinst.inc b/closures/compiler/sparc/strinst.inc new file mode 100644 index 0000000000..2728e33b0a --- /dev/null +++ b/closures/compiler/sparc/strinst.inc @@ -0,0 +1,72 @@ +{****************************************************************************** + *****************************************************************************} + 'none', + 'abcd', + 'add','addcc','addx','addxcc', + 'and','andcc','andn','andncc', + 'jmp', + 'jmpl', + 'call', + 'ba','b','fba','fb', + 'cbccc', + 'flush', + 'ldsb','ldsh','ldstub', + 'ldub','lduh','ld','ldd','ld','ldfsr','ldd','ldc','ldcsr','lddc', + 'ldsba','ldsha','lduba','lduha','lda','ldda', + 'ldstuba', + 'mulscc', + 'nop', + 'or','orcc','orn','orncc', + 'rd','rd','rd','rd','rd', + 'restore', + 'ret','retl', + 'save', + 'sdiv','sdivcc', + 'smul','smulcc', + 'sethi', + 'sll','srl','sra', + 'stb','sth','st','std','st','std','stfsr','stdfq', + 'stc','stdc','stcsr','stdcq', + 'stba','stha','sta','stda', + 'sub','subcc','subx','subxcc', + 'swap','swapa','ticc','taddcc','tsubcc','taddcctv','tsubcctv', + 'ta','t', + 'udiv','udivcc', + 'umul','umulcc', + 'unimp', + 'wrasr','wry','wrpsr','wrwim','wrtbr', + 'xnor','xnorcc', + 'xor','xorcc', + {floating-point instructions} + 'fitos','fitod','fitoq', + 'fstoi','fdtoi','fqtoi', + 'fstod','fstoq', + 'fdtos','fdtoq', + 'fqtod','fqtos', + 'fmovs','fnegs','fabss', + 'fsqrts','fsqrtd','fsqrtq', + 'fadds','faddd','faddq', + 'fsubs','fsubd','fsubq', + 'fmuls','fmuld','fmulq', + 'fdmulq','fsmuld', + 'fdivs','fdivd','fdivq', + 'fcmps','fcmpd','fcmpq', + 'fcpop1','cpop2', + {synthetic instructions} + 'btst','bset','bclr','btog', + 'clr','clrb','clrh', + 'cmp', + 'dec','deccc', + 'inc','inccc', + 'mov', + 'neg', + 'not', + 'set', + 'skipz','skipnz', + 'tst', + { internal instructions } + 'fmovd', + 'fabsd','fabsq', + { memory barrier instructions } + 'stbar', + 'membar' diff --git a/closures/compiler/switches.pas b/closures/compiler/switches.pas new file mode 100644 index 0000000000..5dc58c8ce2 --- /dev/null +++ b/closures/compiler/switches.pas @@ -0,0 +1,369 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements the parsing of the switches like $I- + + 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 switches; + +{$i fpcdefs.inc} + +interface + +uses + globtype; + +procedure HandleSwitch(switch,state:char); +function CheckSwitch(switch,state:char):boolean; + +procedure recordpendingverbosityswitch(sw: char; state: char); +procedure recordpendingmessagestate(msg: longint; state: tmsgstate); +procedure recordpendinglocalswitch(sw: tlocalswitch; state: char); +procedure recordpendinglocalfullswitch(const switches: tlocalswitches); +procedure recordpendingverbosityfullswitch(verbosity: longint); +procedure recordpendingcallingswitch(const str: shortstring); +procedure flushpendingswitchesstate; + +implementation +uses + systems,cpuinfo, + globals,verbose,comphook, + fmodule; + +{**************************************************************************** + Main Switches Parsing +****************************************************************************} + +type + TSwitchType=(ignoredsw,localsw,modulesw,globalsw,illegalsw,unsupportedsw,alignsw,optimizersw,packenumsw,pentiumfdivsw); + SwitchRec=record + typesw : TSwitchType; + setsw : byte; + end; + SwitchRecTable = array['A'..'Z'] of SwitchRec; + +const + turboSwitchTable: SwitchRecTable =( + {A} (typesw:alignsw; setsw:ord(cs_localnone)), + {B} (typesw:localsw; setsw:ord(cs_full_boolean_eval)), + {C} (typesw:localsw; setsw:ord(cs_do_assertion)), + {D} (typesw:modulesw; setsw:ord(cs_debuginfo)), + {E} (typesw:modulesw; setsw:ord(cs_fp_emulation)), + {F} (typesw:ignoredsw; setsw:ord(cs_localnone)), + {G} (typesw:ignoredsw; setsw:ord(cs_localnone)), + {H} (typesw:localsw; setsw:ord(cs_ansistrings)), + {I} (typesw:localsw; setsw:ord(cs_check_io)), + {J} (typesw:localsw; setsw:ord(cs_typed_const_writable)), + {K} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {L} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {M} (typesw:localsw; setsw:ord(cs_generate_rtti)), + {N} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {O} (typesw:optimizersw; setsw:ord(cs_opt_none)), + {P} (typesw:modulesw; setsw:ord(cs_openstring)), + {Q} (typesw:localsw; setsw:ord(cs_check_overflow)), + {R} (typesw:localsw; setsw:ord(cs_check_range)), + {S} (typesw:localsw; setsw:ord(cs_check_stack)), + {T} (typesw:localsw; setsw:ord(cs_typed_addresses)), + {U} (typesw:pentiumfdivsw; setsw:ord(cs_localnone)), + {V} (typesw:localsw; setsw:ord(cs_strict_var_strings)), + {W} (typesw:localsw; setsw:ord(cs_generate_stackframes)), + {X} (typesw:modulesw; setsw:ord(cs_extsyntax)), + {Y} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {Z} (typesw:packenumsw; setsw:ord(cs_localnone)) + ); + + + macSwitchTable: SwitchRecTable =( + {A} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {B} (typesw:localsw; setsw:ord(cs_full_boolean_eval)), + {C} (typesw:localsw; setsw:ord(cs_do_assertion)), + {D} (typesw:modulesw; setsw:ord(cs_debuginfo)), + {E} (typesw:modulesw; setsw:ord(cs_fp_emulation)), + {F} (typesw:ignoredsw; setsw:ord(cs_localnone)), + {G} (typesw:ignoredsw; setsw:ord(cs_localnone)), + {H} (typesw:localsw; setsw:ord(cs_ansistrings)), + {I} (typesw:localsw; setsw:ord(cs_check_io)), + {J} (typesw:localsw; setsw:ord(cs_external_var)), + {K} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {L} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {M} (typesw:localsw; setsw:ord(cs_generate_rtti)), + {N} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {O} (typesw:optimizersw; setsw:ord(cs_opt_none)), + {P} (typesw:modulesw; setsw:ord(cs_openstring)), + {Q} (typesw:localsw; setsw:ord(cs_check_overflow)), + {R} (typesw:localsw; setsw:ord(cs_check_range)), + {S} (typesw:localsw; setsw:ord(cs_check_stack)), + {T} (typesw:localsw; setsw:ord(cs_typed_addresses)), + {U} (typesw:illegalsw; setsw:ord(cs_localnone)), + {V} (typesw:localsw; setsw:ord(cs_strict_var_strings)), + {W} (typesw:localsw; setsw:ord(cs_generate_stackframes)), + {X} (typesw:modulesw; setsw:ord(cs_extsyntax)), + {Y} (typesw:unsupportedsw; setsw:ord(cs_localnone)), + {Z} (typesw:localsw; setsw:ord(cs_externally_visible)) + ); + +procedure HandleSwitch(switch,state:char); + +var + switchTablePtr: ^SwitchRecTable; + +begin + switch:=upcase(switch); +{ Is the Switch in the letters ? } + if not ((switch in ['A'..'Z']) and (state in ['-','+'])) then + begin + Message(scan_w_illegal_switch); + exit; + end; + +{ Select switch table } + if m_mac in current_settings.modeswitches then + switchTablePtr:= @macSwitchTable + else + switchTablePtr:= @turboSwitchTable; + +{ Handle the switch } + with switchTablePtr^[switch] do + begin + case typesw of + alignsw: + if state='+' then + current_settings.packrecords:=4 + else + current_settings.packrecords:=1; + optimizersw : + begin + if state='+' then + current_settings.optimizerswitches:=level2optimizerswitches + else + current_settings.optimizerswitches:=[]; + end; + ignoredsw : + Message1(scan_n_ignored_switch,'$'+switch); + illegalsw : + Message1(scan_w_illegal_switch,'$'+switch); + unsupportedsw : + Message1(scan_w_unsupported_switch,'$'+switch); + localsw : + recordpendinglocalswitch(tlocalswitch(setsw),state); + modulesw : + begin + if current_module.in_global then + begin +{$ifndef cpufpemu} + if tmoduleswitch(setsw)=cs_fp_emulation then + begin + Message1(scan_w_unsupported_switch_by_target,'$'+switch); + end + else +{$endif cpufpemu} + begin + if state='+' then + include(current_settings.moduleswitches,tmoduleswitch(setsw)) + else + begin + { Turning off debuginfo when lineinfo is requested + is not possible } + if not((cs_use_lineinfo in current_settings.globalswitches) and + (tmoduleswitch(setsw)=cs_debuginfo)) then + exclude(current_settings.moduleswitches,tmoduleswitch(setsw)); + end; + end; + end + else + Message(scan_w_switch_is_global); + end; + globalsw : + begin + if current_module.in_global and (current_module=main_module) then + begin + if state='+' then + include(current_settings.globalswitches,tglobalswitch(setsw)) + else + exclude(current_settings.globalswitches,tglobalswitch(setsw)); + end + else + Message(scan_w_switch_is_global); + end; + packenumsw: + begin + if state='-' then + current_settings.packenum:=1 + else + current_settings.packenum:=4; + end; + pentiumfdivsw: + begin + { Switch u- means pentium-safe fdiv off -> fpc default. We don't } + { support u+ } + if state='+' then + Message1(scan_w_unsupported_switch,'$'+switch); + end; + end; + end; +end; + + +function CheckSwitch(switch,state:char):boolean; + +var + found : boolean; + switchTablePtr: ^SwitchRecTable; + +begin + switch:=upcase(switch); +{ Is the Switch in the letters ? } + if not ((switch in ['A'..'Z']) and (state in ['-','+'])) then + begin + Message(scan_w_illegal_switch); + CheckSwitch:=false; + exit; + end; + +{ Select switch table } + if m_mac in current_settings.modeswitches then + switchTablePtr:= @macSwitchTable + else + switchTablePtr:= @turboSwitchTable; + +{ Check the switch } + with switchTablePtr^[switch] do + begin + case typesw of + localsw : found:=(tlocalswitch(setsw) in current_settings.localswitches); + modulesw : found:=(tmoduleswitch(setsw) in current_settings.moduleswitches); + globalsw : found:=(tglobalswitch(setsw) in current_settings.globalswitches); + packenumsw : found := (current_settings.packenum = 4); + else + found:=false; + end; + if state='-' then + found:=not found; + CheckSwitch:=found; + end; +end; + + +procedure recordpendingverbosityswitch(sw: char; state: char); + begin + pendingstate.nextverbositystr:=pendingstate.nextverbositystr+sw+state; + end; + +procedure recordpendingmessagestate(msg: longint; state: tmsgstate); + var + pstate : pmessagestaterecord; + begin + new(pstate); + pstate^.next:=pendingstate.nextmessagerecord; + pstate^.value:=msg; + pstate^.state:=state; + pendingstate.nextmessagerecord:=pstate; + end; + +procedure recordpendinglocalswitch(sw: tlocalswitch; state: char); + begin + if not pendingstate.localswitcheschanged then + pendingstate.nextlocalswitches:=current_settings.localswitches; + if state='-' then + exclude(pendingstate.nextlocalswitches,sw) + else if state='+' then + include(pendingstate.nextlocalswitches,sw) + else { state = '*' } + begin + if sw in init_settings.localswitches then + include(pendingstate.nextlocalswitches,sw) + else + exclude(pendingstate.nextlocalswitches,sw); + end; + pendingstate.localswitcheschanged:=true; + end; + + +procedure recordpendinglocalfullswitch(const switches: tlocalswitches); + begin + pendingstate.nextlocalswitches:=switches; + pendingstate.localswitcheschanged:=true; + end; + + +procedure recordpendingverbosityfullswitch(verbosity: longint); + begin + pendingstate.nextverbositystr:=''; + pendingstate.nextverbosityfullswitch:=verbosity; + pendingstate.verbosityfullswitched:=true; + end; + +procedure recordpendingcallingswitch(const str: shortstring); + begin + pendingstate.nextcallingstr:=str; + end; + + +procedure flushpendingswitchesstate; + var + tmpproccal: tproccalloption; + fstate, pstate : pmessagestaterecord; + begin + { process pending localswitches (range checking, etc) } + if pendingstate.localswitcheschanged then + begin + current_settings.localswitches:=pendingstate.nextlocalswitches; + pendingstate.localswitcheschanged:=false; + end; + { process pending verbosity changes (warnings on, etc) } + if pendingstate.verbosityfullswitched then + begin + status.verbosity:=pendingstate.nextverbosityfullswitch; + pendingstate.verbosityfullswitched:=false; + end; + if pendingstate.nextverbositystr<>'' then + begin + setverbosity(pendingstate.nextverbositystr); + pendingstate.nextverbositystr:=''; + end; + fstate:=pendingstate.nextmessagerecord; + pstate:=pendingstate.nextmessagerecord; + while assigned(pstate) do + begin + pendingstate.nextmessagerecord:=pstate^.next; + SetMessageVerbosity(pstate^.value,pstate^.state); + if not assigned(pstate^.next) then + begin + pstate^.next:=current_settings.pmessage; + current_settings.pmessage:=fstate; + pstate:=nil; + end + else + pstate:=pstate^.next; + pendingstate.nextmessagerecord:=nil; + end; + { process pending calling convention changes (calling x) } + if pendingstate.nextcallingstr<>'' then + begin + if not SetAktProcCall(pendingstate.nextcallingstr,tmpproccal) then + Message1(parser_w_unknown_proc_directive_ignored,pendingstate.nextcallingstr) + else if not(tmpproccal in supported_calling_conventions) then + Message1(parser_e_illegal_calling_convention,pendingstate.nextcallingstr) + else + current_settings.defproccall:=tmpproccal; + pendingstate.nextcallingstr:=''; + end; + end; + + +end. diff --git a/closures/compiler/symbase.pas b/closures/compiler/symbase.pas new file mode 100644 index 0000000000..bb984dc350 --- /dev/null +++ b/closures/compiler/symbase.pas @@ -0,0 +1,441 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller + + This unit handles the symbol 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 symbase; + +{$i fpcdefs.inc} + +interface + + uses + { common } + cutils,cclasses, + { global } + globtype,globals, + { symtable } + symconst + ; + +{************************************************ + Needed forward pointers +************************************************} + + type + TSymtable = class; + + { THashedIDString } + + THashedIDString=object + private + FId : TIDString; + FHash : Longword; + procedure SetId(const s:TIDString); + public + property Id:TIDString read FId write SetId; + property Hash:longword read FHash; + end; + + +{************************************************ + TDefEntry +************************************************} + + TDefEntry = class + typ : tdeftyp; + defid : longint; + owner : TSymtable; + end; + + +{************************************************ + TSymEntry +************************************************} + + { this object is the base for all symbol objects } + TSymEntry = class(TFPHashObject) + private + FRealName : pshortstring; + function GetRealname:shortstring; + procedure SetRealname(const ANewName:shortstring); + public + typ : tsymtyp; + SymId : longint; + Owner : TSymtable; + destructor destroy;override; + property RealName:shortstring read GetRealName write SetRealName; + end; + +{************************************************ + TSymtable +************************************************} + + TSymtable = class + public + name : pshortstring; + realname : pshortstring; + DefList : TFPObjectList; + SymList : TFPHashObjectList; + defowner : TDefEntry; { for records and objects } + moduleid : longint; + refcount : smallint; + currentvisibility : tvisibility; + currentlyoptional : boolean; + tableoptions : tsymtableoptions; + { level of symtable, used for nested procedures } + symtablelevel : byte; + symtabletype : TSymtabletype; + constructor Create(const s:string); + destructor destroy;override; + procedure freeinstance;override; + function getcopy:TSymtable; + procedure clear;virtual; + function checkduplicate(var s:THashedIDString;sym:TSymEntry):boolean;virtual; + procedure insert(sym:TSymEntry;checkdup:boolean=true);virtual; + procedure Delete(sym:TSymEntry);virtual; + function Find(const s:TIDString) : TSymEntry; + function FindWithHash(const s:THashedIDString) : TSymEntry;virtual; + procedure insertdef(def:TDefEntry);virtual; + procedure deletedef(def:TDefEntry); + function iscurrentunit:boolean;virtual; + { includes the flag in this symtable and all parent symtables; if + it's already set the flag is not set again } + procedure includeoption(option:tsymtableoption); + end; + + psymtablestackitem = ^TSymtablestackitem; + TSymtablestackitem = record + symtable : TSymtable; + next : psymtablestackitem; + end; + + TSymtablestack = class + stack : psymtablestackitem; + constructor create; + destructor destroy;override; + procedure clear; + procedure push(st:TSymtable); virtual; + procedure pop(st:TSymtable); virtual; + function top:TSymtable; + end; + + + var + initialmacrosymtable: TSymtable; { macros initially defined by the compiler or + given on the command line. Is common + for all files compiled and do not change. } + macrosymtablestack, + symtablestack : TSymtablestack; + +{$ifdef MEMDEBUG} + var + memrealnames : tmemdebug; +{$endif MEMDEBUG} + + +implementation + + uses + verbose; + +{**************************************************************************** + THashedIDString +****************************************************************************} + + procedure THashedIDString.SetId(const s:TIDString); + begin + FId:=s; + FHash:=FPHash(s); + end; + + +{**************************************************************************** + TSymEntry +****************************************************************************} + + destructor TSymEntry.destroy; + begin +{$ifdef MEMDEBUG} + memrealnames.start; +{$endif MEMDEBUG} + stringdispose(Frealname); +{$ifdef MEMDEBUG} + memrealnames.stop; +{$endif MEMDEBUG} + inherited destroy; + end; + + + function TSymEntry.GetRealname:shortstring; + begin + if not assigned(FRealname) then + internalerror(200611011); + result:=FRealname^; + end; + + + procedure TSymEntry.SetRealname(const ANewName:shortstring); + begin + stringdispose(FRealname); + FRealname:=stringdup(ANewName); + if Hash<>$ffffffff then + begin + if FRealname^[1]='$' then + Rename(Copy(FRealname^,2,255)) + else + Rename(Upper(FRealname^)); + end; + end; + + +{**************************************************************************** + TSymtable +****************************************************************************} + + constructor TSymtable.Create(const s:string); + begin + if s<>'' then + begin + name:=stringdup(upper(s)); + realname:=stringdup(s); + end + else + begin + name:=nil; + realname:=nil; + end; + symtabletype:=abstractsymtable; + symtablelevel:=0; + defowner:=nil; + DefList:=TFPObjectList.Create(true); + SymList:=TFPHashObjectList.Create(true); + refcount:=1; + currentvisibility:=vis_public; + currentlyoptional:=false; + end; + + + destructor TSymtable.destroy; + begin + { freeinstance decreases refcount } + if refcount>1 then + exit; + Clear; + DefList.Free; + { SymList can already be disposed or set to nil for withsymtable, } + { but in that case Free does nothing } + SymList.Free; + stringdispose(name); + stringdispose(realname); + end; + + + procedure TSymtable.freeinstance; + begin + dec(refcount); + if refcount=0 then + inherited freeinstance; + end; + + + function TSymtable.getcopy:TSymtable; + begin + inc(refcount); + result:=self; + end; + + + function TSymtable.iscurrentunit:boolean; + begin + result:=false; + end; + + procedure TSymtable.includeoption(option: tsymtableoption); + var + st: tsymtable; + begin + if option in tableoptions then + exit; + include(tableoptions,option); + { iterative approach should be faster than recursion based on calls } + st:=self; + while assigned(st.defowner) do + begin + st:=st.defowner.owner; + { the flag is already set, so by definition it is set in the + owning symtables as well } + if option in st.tableoptions then + break; + include(st.tableoptions,option); + end; + end; + + + procedure TSymtable.clear; + var + i : integer; + begin + SymList.Clear; + { Prevent recursive calls between TDef.destroy and TSymtable.Remove } + if DefList.OwnsObjects then + begin + for i := 0 to DefList.Count-1 do + TDefEntry(DefList[i]).Owner:=nil; + end; + DefList.Clear; + end; + + + function TSymtable.checkduplicate(var s:THashedIDString;sym:TSymEntry):boolean; + begin + result:=(FindWithHash(s)<>nil); + end; + + + procedure TSymtable.insert(sym:TSymEntry;checkdup:boolean=true); + var + hashedid : THashedIDString; + begin + if checkdup then + begin + if sym.realname[1]='$' then + hashedid.id:=Copy(sym.realname,2,255) + else + hashedid.id:=Upper(sym.realname); + { First check for duplicates, this can change the symbol name + in case of a duplicate entry } + checkduplicate(hashedid,sym); + end; + { Now we can insert the symbol, any duplicate entries + are renamed to an unique (and for users unaccessible) name } + if sym.realname[1]='$' then + sym.ChangeOwnerAndName(SymList,Copy(sym.realname,2,255)) + else + sym.ChangeOwnerAndName(SymList,Upper(sym.realname)); + sym.Owner:=self; + end; + + + procedure TSymtable.Delete(sym:TSymEntry); + begin + if sym.Owner<>self then + internalerror(200611121); + SymList.Remove(sym); + end; + + + procedure TSymtable.insertdef(def:TDefEntry); + begin + DefList.Add(def); + def.owner:=self; + end; + + + procedure TSymtable.deletedef(def:TDefEntry); + begin + if def.Owner<>self then + internalerror(200611122); + def.Owner:=nil; + DefList.Remove(def); + end; + + + function TSymtable.Find(const s : TIDString) : TSymEntry; + begin + result:=TSymEntry(SymList.Find(s)); + end; + + + function TSymtable.FindWithHash(const s:THashedIDString) : TSymEntry; + begin + result:=TSymEntry(SymList.FindWithHash(s.id,s.hash)); + end; + + +{**************************************************************************** + Symtable Stack +****************************************************************************} + + constructor TSymtablestack.create; + begin + stack:=nil; + end; + + + destructor TSymtablestack.destroy; + begin + clear; + end; + + + procedure TSymtablestack.clear; + var + hp : psymtablestackitem; + begin + while assigned(stack) do + begin + hp:=stack; + stack:=hp^.next; + dispose(hp); + end; + end; + + + procedure TSymtablestack.push(st:TSymtable); + var + hp : psymtablestackitem; + begin + new(hp); + hp^.symtable:=st; + hp^.next:=stack; + stack:=hp; + end; + + + procedure TSymtablestack.pop(st:TSymtable); + var + hp : psymtablestackitem; + begin + if not assigned(stack) then + internalerror(200601231); + if stack^.symtable<>st then + internalerror(200601232); + hp:=stack; + stack:=hp^.next; + dispose(hp); + end; + + + function TSymtablestack.top:TSymtable; + begin + if not assigned(stack) then + internalerror(200601233); + result:=stack^.symtable; + end; + + +{$ifdef MEMDEBUG} +initialization + memrealnames:=TMemDebug.create('Realnames'); + memrealnames.stop; + +finalization + memrealnames.free; +{$endif MEMDEBUG} +end. diff --git a/closures/compiler/symconst.pas b/closures/compiler/symconst.pas new file mode 100644 index 0000000000..3c40411871 --- /dev/null +++ b/closures/compiler/symconst.pas @@ -0,0 +1,660 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller + + Symbol table constants + + 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 symconst; + +{$i fpcdefs.inc} + +interface + +uses + globtype; + +const + def_alignment = 4; + + C_alignment = -1; + bit_alignment = -2; + mac68k_alignment = -3; + + { if you change one of the following contants, } + { you have also to change the typinfo unit} + { and the rtl/i386,template/rttip.inc files } + tkUnknown = 0; + tkInteger = 1; + tkChar = 2; + tkEnumeration = 3; + tkFloat = 4; + tkSet = 5; + tkMethod = 6; + tkSString = 7; + tkString = tkSString; + tkLString = 8; + tkAString = 9; + tkWString = 10; + tkVariant = 11; + tkArray = 12; + tkRecord = 13; + tkInterface= 14; + tkClass = 15; + tkObject = 16; + tkWChar = 17; + tkBool = 18; + tkInt64 = 19; + tkQWord = 20; + tkDynArray = 21; + tkInterfaceCorba = 22; + tkProcVar = 23; + tkUString = 24; + tkUChar = 25; + tkHelper = 26; + tkFile = 27; + + otSByte = 0; + otUByte = 1; + otSWord = 2; + otUWord = 3; + otSLong = 4; + otULong = 5; + otSLongLong = 6; + otULongLong = 7; + + ftSingle = 0; + ftDouble = 1; + ftExtended = 2; + ftComp = 3; + ftCurr = 4; + ftFloat128 = 5; + + mkProcedure = 0; + mkFunction = 1; + mkConstructor = 2; + mkDestructor = 3; + mkClassProcedure = 4; + mkClassFunction = 5; + mkClassConstructor = 6; + mkClassDestructor = 7; + mkOperatorOverload = 8; +// delphi has the next too: +//mkSafeProcedure = 9; +//mkSafeFunction = 10; + + pfvar = 1; + pfConst = 2; + pfArray = 4; + pfAddress = 8; + pfReference= 16; + pfOut = 32; + pfConstRef = 64; + + unknown_level = 0; + main_program_level = 1; + normal_function_level = 2; + + { implicit parameter positions, normal parameters start at 10 + and will increase with 10 for each parameter. The high parameters + will be inserted with n+1 } + paranr_parentfp = 1; + paranr_parentfp_delphi_cc_leftright = 1; + paranr_self = 2; + paranr_result = 3; + paranr_vmt = 4; + + { the implicit parameters for Objective-C methods need to come + after the hidden result parameter } + paranr_objc_self = 4; + paranr_objc_cmd = 5; + { Required to support variations of syscalls on MorphOS } + paranr_syscall_basesysv = 9; + paranr_syscall_sysvbase = high(word)-5; + paranr_syscall_r12base = high(word)-4; + paranr_syscall_legacy = high(word)-3; + paranr_result_leftright = high(word)-2; + paranr_parentfp_delphi_cc = high(word)-1; + + { prefix for names of class helper procsyms added to regular symtables } + class_helper_prefix = 'CH$'; + + +type + { keep this in sync with TIntfFlag in rtl/objpas/typinfo.pp } + TCompilerIntfFlag = (ifHasGuid,ifDispInterface,ifDispatch,ifHasStrGUID); + + { Deref entry options } + tdereftype = (deref_nil, + deref_unit, + deref_symid, + deref_defid + ); + + { symbol visibility } + tvisibility=( + vis_hidden, + vis_strictprivate, + vis_private, + vis_strictprotected, + vis_protected, + vis_public, + vis_published + ); + + { symbol options } + tsymoption=(sp_none, + sp_static, { static symbol in class/object/record } + sp_hint_deprecated, + sp_hint_platform, + sp_hint_library, + sp_hint_unimplemented, + sp_has_overloaded, + sp_internal, { internal symbol, not reported as unused } + sp_implicitrename, + sp_hint_experimental, + sp_generic_para, + sp_has_deprecated_msg, + sp_generic_dummy { this is used for symbols that are generated when a + generic is encountered to ease inline + specializations, etc; those symbols can be + "overridden" with a completely different symbol } + ); + tsymoptions=set of tsymoption; + + { flags for a definition } + tdefoption=(df_none, + { type is unique, i.e. declared with type = type <tdef>; } + df_unique, + { type is a generic } + df_generic, + { type is a specialization of a generic type } + df_specialization, + { def has been copied from another def so symtable is not owned } + df_copied_def + ); + tdefoptions=set of tdefoption; + + tdefstate=(ds_none, + ds_vmt_written, + ds_rtti_table_used, + ds_init_table_used, + ds_rtti_table_written, + ds_init_table_written, + ds_dwarf_dbg_info_used, + ds_dwarf_dbg_info_written + ); + tdefstates=set of tdefstate; + + { tsymlist entry types } + tsltype = (sl_none, + sl_load, + sl_call, + sl_subscript, + sl_vec, + sl_typeconv, + sl_absolutetype + ); + + { base types for orddef } + tordtype = ( + uvoid, + u8bit,u16bit,u32bit,u64bit, + s8bit,s16bit,s32bit,s64bit, + pasbool8,pasbool16,pasbool32,pasbool64, + bool8bit,bool16bit,bool32bit,bool64bit, + uchar,uwidechar,scurrency + ); + + { string types } + tstringtype = ( + st_shortstring, + st_longstring, + st_ansistring, + st_widestring, + st_unicodestring + ); + + tvarianttype = ( + vt_normalvariant,vt_olevariant + ); + + tcallercallee = (callnoside,callerside,calleeside,callbothsides); + + { basic type for tprocdef and tprocvardef } + tproctypeoption=(potype_none, + potype_proginit, { Program initialization } + potype_unitinit, { unit initialization } + potype_unitfinalize, { unit finalization } + potype_constructor, { Procedure is a constructor } + potype_destructor, { Procedure is a destructor } + potype_operator, { Procedure defines an operator } + potype_procedure, + potype_function, + potype_class_constructor, { class constructor } + potype_class_destructor, { class destructor } + potype_propgetter, { Dispinterface property accessors } + potype_propsetter, + potype_exceptfilter { SEH exception filter or termination handler } + ); + tproctypeoptions=set of tproctypeoption; + + { other options for tprocdef and tprocvardef } + tprocoption=(po_none, + po_classmethod, { class method } + po_virtualmethod, { Procedure is a virtual method } + po_abstractmethod, { Procedure is an abstract method } + po_finalmethod, { Procedure is a final method } + po_staticmethod, { static method } + po_overridingmethod, { method with override directive } + po_methodpointer, { method pointer, only in procvardef, also used for 'with object do' } + po_interrupt, { Procedure is an interrupt handler } + po_iocheck, { IO checking should be done after a call to the procedure } + po_assembler, { Procedure is written in assembler } + po_msgstr, { method for string message handling } + po_msgint, { method for int message handling } + po_exports, { Procedure has export directive (needed for OS/2) } + po_external, { Procedure is external (in other object or lib)} + po_overload, { procedure is declared with overload directive } + po_varargs, { printf like arguments } + po_internconst, { procedure has constant evaluator intern } + { flag that only the address of a method is returned and not a full methodpointer } + po_addressonly, + { procedure is exported } + po_public, + { calling convention is specified explicitly } + po_hascallingconvention, + { reintroduce flag } + po_reintroduce, + { location of parameters is given explicitly as it is necessary for some syscall + conventions like that one of MorphOS } + po_explicitparaloc, + { no stackframe will be generated, used by lowlevel assembler like get_frame } + po_nostackframe, + po_has_mangledname, + po_has_public_name, + po_forward, + po_global, + po_has_inlininginfo, + { The different kind of syscalls on MorphOS } + po_syscall_legacy, + po_syscall_sysv, + po_syscall_basesysv, + po_syscall_sysvbase, + po_syscall_r12base, + { Procedure can be inlined } + po_inline, + { Procedure is used for internal compiler calls } + po_compilerproc, + { importing } + po_has_importdll, + po_has_importname, + po_kylixlocal, + po_dispid, + { weakly linked (i.e., may or may not exist at run time) } + po_weakexternal, + { Objective-C method } + po_objc, + { enumerator support } + po_enumerator_movenext, + { optional Objective-C protocol method } + po_optional, + { nested procedure that uses Delphi-style calling convention for passing + the frame pointer (pushed on the stack, always the last parameter, + removed by the caller). Required for nested procvar compatibility, + because such procvars can hold both regular and nested procedures + (when calling a regular procedure using the above convention, it will + simply not see the frame pointer parameter, and since the caller cleans + up the stack will also remain balanced) } + po_delphi_nested_cc, + po_rtlproc + ); + tprocoptions=set of tprocoption; + + { options for objects and classes } + tobjecttyp = (odt_none, + odt_class, + odt_object, + odt_interfacecom, + odt_interfacecom_property, + odt_interfacecom_function, + odt_interfacecorba, + odt_cppclass, + odt_dispinterface, + odt_objcclass, + odt_objcprotocol, + odt_objccategory, { note that these are changed into odt_class afterwards } + odt_helper + ); + + { defines the type of the extended "structure"; only used for parsing } + thelpertype=(ht_none, + ht_class, + ht_record + ); + + { Variations in interfaces implementation } + { Beware, this data is duplicated in the compiler and rtl. } + { Do not change the order of the fields. } + tinterfaceentrytype = (etStandard, + etVirtualMethodResult, + etStaticMethodResult, + etFieldValue, + etVirtualMethodClass, + etStaticMethodClass, + etFieldValueClass + ); + + { options for objects and classes } + tobjectoption=(oo_none, + oo_is_forward, { the class is only a forward declared yet } + oo_is_abstract, { the class is abstract - only descendants can be used } + oo_is_sealed, { the class is sealed - can't have descendants } + oo_has_virtual, { the object/class has virtual methods } + oo_has_private, + oo_has_protected, + oo_has_strictprivate, + oo_has_strictprotected, + oo_has_constructor, { the object/class has a constructor } + oo_has_destructor, { the object/class has a destructor } + oo_has_vmt, { the object/class has a vmt } + oo_has_msgstr, + oo_has_msgint, + oo_can_have_published,{ the class has rtti, i.e. you can publish properties } + oo_has_default_property, + oo_has_valid_guid, + oo_has_enumerator_movenext, + oo_has_enumerator_current, + oo_is_external, { the class is externally implemented (objcclass, cppclass) } + oo_is_formal, { the class is only formally defined in this module (x = objcclass; external [name 'x'];) } + oo_is_classhelper, { objcclasses that represent categories, and Delpi-style class helpers, are marked like this } + oo_has_class_constructor, { the object/class has a class constructor } + oo_has_class_destructor { the object/class has a class destructor } + ); + tobjectoptions=set of tobjectoption; + + tarraydefoption=(ado_none, + ado_IsConvertedPointer, + ado_IsDynamicArray, + ado_IsVariant, + ado_IsConstructor, + ado_IsArrayOfConst, + ado_IsConstString, + ado_IsBitPacked + ); + tarraydefoptions=set of tarraydefoption; + + { options for properties } + tpropertyoption=(ppo_none, + ppo_indexed, { delcared wwith "index" keyword } + ppo_defaultproperty, + ppo_stored, + ppo_hasparameters, { has parameters: prop[param1, param2: type] } + ppo_implements, + ppo_enumerator_current, { implements current property for enumerator } + ppo_overrides, { overrides ancestor property } + ppo_dispid_write { no longer used } + ); + tpropertyoptions=set of tpropertyoption; + + { options for variables } + tvaroption=(vo_none, + vo_is_external, + vo_is_dll_var, + vo_is_thread_var, + vo_has_local_copy, + vo_is_const, { variable is declared as const (parameter) and can't be written to } + vo_is_public, + vo_is_high_para, + vo_is_funcret, + vo_is_self, + vo_is_vmt, + vo_is_result, { special result variable } + vo_is_parentfp, + vo_is_loop_counter, { used to detect assignments to loop counter } + vo_is_hidden_para, + vo_has_explicit_paraloc, + vo_is_syscall_lib, + vo_has_mangledname, + vo_is_typed_const, + vo_is_range_check, + vo_is_overflow_check, + vo_is_typinfo_para, + vo_is_weak_external, + { Objective-C message selector parameter } + vo_is_msgsel, + { first field of variant part of a record } + vo_is_first_field, + vo_volatile, + vo_has_section, + { variable contains a winlike WideString which should be finalized + even in $J- state } + vo_force_finalize + ); + tvaroptions=set of tvaroption; + + { register variable } + tvarregable=(vr_none, + vr_intreg, + vr_fpureg, + vr_mmreg, + { does not mean "needs address register", but "if it's a parameter which is } + { passed by reference, then its address can be put in a register } + vr_addr + ); + + { types of the symtables } + TSymtabletype = ( + abstractsymtable, { not a real symtable } + globalsymtable, { unit interface symtable } + staticsymtable, { unit implementation symtable } + ObjectSymtable, { object symtable } + recordsymtable, { record symtable } + localsymtable, { subroutine symtable } + parasymtable, { arguments symtable } + withsymtable, { with operator symtable } + stt_excepTSymtable, { try/except symtable } + exportedmacrosymtable, { } + localmacrosymtable, { } + enumsymtable, { symtable for enum members } + arraysymtable { used to store parameterised type + in array } + ); + + { options for symtables } + tsymtableoption = ( + sto_has_helper { contains at least one helper symbol } + ); + tsymtableoptions = set of tsymtableoption; + + { definition contains the informations about a type } + tdeftyp = (abstractdef, + arraydef,recorddef,pointerdef,orddef, + stringdef,enumdef,procdef,objectdef,errordef, + filedef,formaldef,setdef,procvardef,floatdef, + classrefdef,forwarddef,variantdef,undefineddef + ); + + { possible types for symtable entries } + tsymtyp = (abstractsym, + staticvarsym,localvarsym,paravarsym,fieldvarsym, + typesym,procsym,unitsym,constsym,enumsym, + errorsym,syssym,labelsym,absolutevarsym,propertysym, + macrosym,namespacesym + ); + + { State of the variable: + vs_declared: variable has been declared, not initialised + (e.g. normal variable, out parameter) + vs_initialised: variable has been declared and is valid + (e.g. typed constant, var/const parameter) + vs_read: variable has been read and the read was checked for validity + (so a warning has been given if necessary) + vs_read_not_warned: variable has been read, but we didn't warn about + whether or not the variable was valid + (e.g. read of global variable -> warn at end of compilation unit if + the state is vs_read_not_warned, since that means it's only read and + never written) + vs_referred_not_inited: variable has been used in length/low/high/@/... + expression, was not yet initialised and needn't be at that time + (e.g. length() of a statically allocated array, or sizeof(variable)) + vs_written: variable has been assigned/written to, but not yet read + (e.g. assigning something to a variable/parameter) + vs_readwritten: variable has been written to and read from } + tvarstate=(vs_none, + vs_declared,vs_initialised,vs_read,vs_read_not_warned, + vs_referred_not_inited,vs_written,vs_readwritten + ); + + tvarspez = (vs_value,vs_const,vs_var,vs_out,vs_constref); + + absolutetyp = (tovar,toasm,toaddr); + + tconsttyp = (constnone, + constord,conststring,constreal, + constset,constpointer,constnil, + constresourcestring,constwstring,constguid + ); + + { RTTI information to store } + trttitype = ( + fullrtti,initrtti, + { Objective-C } + objcmetartti,objcmetarortti, + objcclassrtti,objcclassrortti + ); + + { The order is from low priority to high priority, + Note: the operators > and < are used on this list } + tequaltype = ( + te_incompatible, + te_convert_operator, + te_convert_l5, { ad infinitum... } + te_convert_l4, { and yet even less preferred conversion } + te_convert_l3, { even less preferred conversion (possibly with loss of data) } + te_convert_l2, { compatible less preferred conversion } + te_convert_l1, { compatible conversion } + te_equal, { the definitions are equal } + te_exact + ); + + tvariantequaltype = ( + tve_incompatible, + tve_chari64, + tve_ustring, + tve_wstring, + tve_astring, + tve_sstring, + tve_boolformal, + tve_extended, + tve_dblcurrency, + tve_single, + tve_cardinal, + tve_longint, + tve_smallint, + tve_word, + tve_shortint, + tve_byte + ); + tvariantequaltypes = set of tvariantequaltype; + + tdefdbgstatus = ( + dbg_state_unused, + dbg_state_used, + dbg_state_writing, + dbg_state_written, + dbg_state_queued + ); + +var + clearstack_pocalls : tproccalloptions; + cdecl_pocalls : tproccalloptions; + +const + inherited_objectoptions : tobjectoptions = [oo_has_virtual,oo_has_private,oo_has_protected, + oo_has_strictprotected,oo_has_strictprivate,oo_has_constructor,oo_has_destructor, + oo_can_have_published]; + +{$ifdef i386} + { we only take this into account on i386, on other platforms we always + push in the same order + } + pushleftright_pocalls : tproccalloptions = [pocall_register,pocall_pascal]; +{$endif} + + SymTypeName : array[tsymtyp] of string[12] = ( + 'abstractsym','globalvar','localvar','paravar','fieldvar', + 'type','proc','unit','const','enum', + 'errorsym','system sym','label','absolutevar','property', + 'macrosym','namespace' + ); + + typName : array[tdeftyp] of string[12] = ( + 'abstractdef','arraydef','recorddef','pointerdef','orddef', + 'stringdef','enumdef','procdef','objectdef','errordef', + 'filedef','formaldef','setdef','procvardef','floatdef', + 'classrefdef','forwarddef','variantdef','undefineddef' + ); + + EqualTypeName : array[tequaltype] of string[16] = ( + 'incompatible','convert_operator','convert_l5','convert_l4','convert_l3','convert_l2', + 'convert_l1','equal','exact' + ); + + visibilityName : array[tvisibility] of string[16] = ( + 'hidden','strict private','private','strict protected','protected', + 'public','published' + ); + + +{ !! Be sure to keep these in sync with ones in rtl/inc/varianth.inc } + varempty = 0; + varnull = 1; + varsmallint = 2; + varinteger = 3; + varsingle = 4; + vardouble = 5; + varcurrency = 6; + vardate = 7; + varolestr = 8; + vardispatch = 9; + varerror = 10; + varboolean = 11; + varvariant = 12; + varunknown = 13; + vardecimal = 14; + varshortint = 16; + varbyte = 17; + varword = 18; + varlongword = 19; + varint64 = 20; + varqword = 21; + + varUndefined = -1; + + varstrarg = $48; + varustrarg = $49; + + varstring = $100; + varany = $101; + varustring = $102; + vardefmask = $fff; + vararray = $2000; + varbyref = $4000; + +implementation + +end. diff --git a/closures/compiler/symdef.pas b/closures/compiler/symdef.pas new file mode 100644 index 0000000000..6b9852fc52 --- /dev/null +++ b/closures/compiler/symdef.pas @@ -0,0 +1,5947 @@ +{ + Symbol table implementation for the definitions + + Copyright (c) 1998-2005 by Florian Klaempfl, Pierre Muller + + 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 symdef; + +{$i fpcdefs.inc} + +interface + + uses + { common } + cclasses, + { global } + globtype,globals,tokens,constexp, + { symtable } + symconst,symbase,symtype, + { ppu } + ppu, + { node } + node, + { aasm } + aasmbase,aasmtai,aasmdata, + cpubase,cpuinfo, + cgbase,cgutils, + parabase + ; + + + type +{************************************************ + TDef +************************************************} + + { tstoreddef } + + tstoreddef = class(tdef) + protected + typesymderef : tderef; + public +{$ifdef EXTDEBUG} + fileinfo : tfileposinfo; +{$endif} + { generic support } + genericdef : tstoreddef; + genericdefderef : tderef; + generictokenbuf : tdynamicarray; + { Set if PPU was generated with another + endianess as current compiler or ppudump utils } + change_endian : boolean; + constructor create(dt:tdeftyp); + constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile); + destructor destroy;override; + function getcopy : tstoreddef;virtual; + procedure ppuwrite(ppufile:tcompilerppufile);virtual; + procedure buildderef;override; + procedure buildderefimpl;override; + procedure deref;override; + procedure derefimpl;override; + function size:asizeint;override; + function getvardef:longint;override; + function alignment:shortint;override; + function is_publishable : boolean;override; + function needs_inittable : boolean;override; + function rtti_mangledname(rt:trttitype):string;override; + function OwnerHierarchyName: string; override; + function in_currentunit: boolean; + { regvars } + function is_intregable : boolean; + function is_fpuregable : boolean; + { generics } + procedure initgeneric; + private + savesize : asizeuint; + end; + + tfiletyp = (ft_text,ft_typed,ft_untyped); + + tfiledef = class(tstoreddef) + filetyp : tfiletyp; + typedfiledef : tdef; + typedfiledefderef : tderef; + constructor createtext; + constructor createuntyped; + constructor createtyped(def : tdef); + constructor ppuload(ppufile:tcompilerppufile); + function getcopy : tstoreddef;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderef;override; + procedure deref;override; + function GetTypeName:string;override; + function getmangledparaname:string;override; + procedure setsize; + end; + + tvariantdef = class(tstoreddef) + varianttype : tvarianttype; + constructor create(v : tvarianttype); + constructor ppuload(ppufile:tcompilerppufile); + function getcopy : tstoreddef;override; + function GetTypeName:string;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function getvardef:longint;override; + procedure setsize; + function is_publishable : boolean;override; + function needs_inittable : boolean;override; + end; + + tformaldef = class(tstoreddef) + typed:boolean; + constructor create(Atyped:boolean); + constructor ppuload(ppufile:tcompilerppufile); + procedure ppuwrite(ppufile:tcompilerppufile);override; + function GetTypeName:string;override; + end; + + tforwarddef = class(tstoreddef) + tosymname : pshortstring; + forwardpos : tfileposinfo; + constructor create(const s:string;const pos:tfileposinfo); + destructor destroy;override; + function getcopy:tstoreddef;override; + function GetTypeName:string;override; + end; + + tundefineddef = class(tstoreddef) + constructor create; + constructor ppuload(ppufile:tcompilerppufile); + procedure ppuwrite(ppufile:tcompilerppufile);override; + function GetTypeName:string;override; + end; + + terrordef = class(tstoreddef) + constructor create; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function GetTypeName:string;override; + function getmangledparaname : string;override; + end; + + tabstractpointerdef = class(tstoreddef) + pointeddef : tdef; + pointeddefderef : tderef; + constructor create(dt:tdeftyp;def:tdef); + constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile); + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderef;override; + procedure deref;override; + end; + + tpointerdef = class(tabstractpointerdef) + is_far : boolean; + has_pointer_math : boolean; + constructor create(def:tdef); + constructor createfar(def:tdef); + function getcopy:tstoreddef;override; + constructor ppuload(ppufile:tcompilerppufile); + procedure ppuwrite(ppufile:tcompilerppufile);override; + function GetTypeName:string;override; + end; + + tprocdef = class; + { tabstractrecorddef } + + tabstractrecorddef= class(tstoreddef) + objname, + objrealname : PShortString; + symtable : TSymtable; + cloneddef : tabstractrecorddef; + cloneddefderef : tderef; + objectoptions : tobjectoptions; + constructor create(const n:string; dt:tdeftyp); + constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile); + procedure ppuwrite(ppufile:tcompilerppufile);override; + destructor destroy; override; + procedure check_forwards; virtual; + function find_procdef_bytype(pt:tproctypeoption): tprocdef; + function GetSymtable(t:tGetSymtable):TSymtable;override; + function is_packed:boolean; + function RttiName: string; + { enumerator support } + function search_enumerator_get: tprocdef; virtual; + function search_enumerator_move: tprocdef; virtual; + function search_enumerator_current: tsym; virtual; + end; + + trecorddef = class(tabstractrecorddef) + public + isunion : boolean; + constructor create(const n:string; p:TSymtable); + constructor ppuload(ppufile:tcompilerppufile); + destructor destroy;override; + function getcopy : tstoreddef;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderef;override; + procedure deref;override; + function size:asizeint;override; + function alignment : shortint;override; + function padalignment: shortint; + function GetTypeName:string;override; + { debug } + function needs_inittable : boolean;override; + end; + + tobjectdef = class; + + { TImplementedInterface } + + TImplementedInterface = class + IntfDef : tobjectdef; + IntfDefDeref : tderef; + IType : tinterfaceentrytype; + IOffset : longint; + VtblImplIntf : TImplementedInterface; + NameMappings : TFPHashList; + ProcDefs : TFPObjectList; + ImplementsGetter : tsym; + constructor create(aintf: tobjectdef); + constructor create_deref(d:tderef); + destructor destroy; override; + function getcopy:TImplementedInterface; + procedure buildderef; + procedure deref; + procedure AddMapping(const origname, newname: string); + function GetMapping(const origname: string):string; + procedure AddImplProc(pd:tprocdef); + function IsImplMergePossible(MergingIntf:TImplementedInterface;out weight: longint): boolean; + end; + + { tvmtentry } + tvmtentry = record + procdef : tprocdef; + procdefderef : tderef; + visibility : tvisibility; + end; + pvmtentry = ^tvmtentry; + + { tobjectdef } + + tvmcallstatic = (vmcs_default, vmcs_yes, vmcs_no, vmcs_unreachable); + pmvcallstaticinfo = ^tmvcallstaticinfo; + tmvcallstaticinfo = array[0..1024*1024-1] of tvmcallstatic; + tobjectdef = class(tabstractrecorddef) + private + fcurrent_dispid: longint; + public + dwarf_struct_lab : tasmsymbol; + childof : tobjectdef; + childofderef : tderef; + + { for Object Pascal helpers } + extendeddef : tdef; + extendeddefderef: tderef; + { for C++ classes: name of the library this class is imported from } + import_lib, + { for Objective-C: protocols and classes can have the same name there } + objextname : pshortstring; + { to be able to have a variable vmt position } + { and no vmt field for objects without virtuals } + vmtentries : TFPList; + vmcallstaticinfo : pmvcallstaticinfo; + vmt_offset : longint; + iidguid : pguid; + iidstr : pshortstring; + { store implemented interfaces defs and name mappings } + ImplementedInterfaces : TFPObjectList; + writing_class_record_dbginfo, + { a class of this type has been created in this module } + created_in_current_module, + { a loadvmtnode for this class has been created in this + module, so if a classrefdef variable of this or a parent + class is used somewhere to instantiate a class, then this + class may be instantiated + } + maybe_created_in_current_module, + { a "class of" this particular class has been created in + this module + } + classref_created_in_current_module : boolean; + objecttype : tobjecttyp; + constructor create(ot:tobjecttyp;const n:string;c:tobjectdef); + constructor ppuload(ppufile:tcompilerppufile); + destructor destroy;override; + function getcopy : tstoreddef;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function GetTypeName:string;override; + procedure buildderef;override; + procedure deref;override; + procedure buildderefimpl;override; + procedure derefimpl;override; + procedure resetvmtentries; + procedure copyvmtentries(objdef:tobjectdef); + function getparentdef:tdef;override; + function size : asizeint;override; + function alignment:shortint;override; + function vmtmethodoffset(index:longint):longint; + function members_need_inittable : boolean; + function find_implemented_interface(aintfdef:tobjectdef):TImplementedInterface; + { this should be called when this class implements an interface } + procedure prepareguid; + function is_publishable : boolean;override; + function is_related(d : tdef) : boolean;override; + function needs_inittable : boolean;override; + function rtti_mangledname(rt:trttitype):string;override; + function vmt_mangledname : string; + procedure check_forwards; override; + procedure insertvmt; + procedure set_parent(c : tobjectdef); + function find_destructor: tprocdef; + function implements_any_interfaces: boolean; + { dispinterface support } + function get_next_dispid: longint; + { enumerator support } + function search_enumerator_get: tprocdef; override; + function search_enumerator_move: tprocdef; override; + function search_enumerator_current: tsym; override; + { WPO } + procedure register_created_object_type;override; + procedure register_maybe_created_object_type; + procedure register_created_classref_type; + procedure register_vmt_call(index:longint); + { ObjC } + procedure finish_objc_data; + function check_objc_types: boolean; + { C++ } + procedure finish_cpp_data; + end; + + tclassrefdef = class(tabstractpointerdef) + constructor create(def:tdef); + constructor ppuload(ppufile:tcompilerppufile); + procedure ppuwrite(ppufile:tcompilerppufile);override; + function getcopy:tstoreddef;override; + function GetTypeName:string;override; + function is_publishable : boolean;override; + function rtti_mangledname(rt:trttitype):string;override; + procedure register_created_object_type;override; + end; + + tarraydef = class(tstoreddef) + lowrange, + highrange : asizeint; + rangedef : tdef; + rangedefderef : tderef; + arrayoptions : tarraydefoptions; + symtable : TSymtable; + protected + _elementdef : tdef; + _elementdefderef : tderef; + procedure setelementdef(def:tdef); + public + function elesize : asizeint; + function elepackedbitsize : asizeint; + function elecount : asizeuint; + constructor create_from_pointer(def:tdef); + constructor create(l,h:asizeint;def:tdef); + constructor ppuload(ppufile:tcompilerppufile); + destructor destroy; override; + function getcopy : tstoreddef;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function GetTypeName:string;override; + function getmangledparaname : string;override; + procedure buildderef;override; + procedure deref;override; + function size : asizeint;override; + function alignment : shortint;override; + { returns the label of the range check string } + function needs_inittable : boolean;override; + property elementdef : tdef read _elementdef write setelementdef; + function is_publishable : boolean;override; + end; + + torddef = class(tstoreddef) + low,high : TConstExprInt; + ordtype : tordtype; + constructor create(t : tordtype;v,b : TConstExprInt); + constructor ppuload(ppufile:tcompilerppufile); + function getcopy : tstoreddef;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function is_publishable : boolean;override; + function GetTypeName:string;override; + function alignment:shortint;override; + procedure setsize; + function packedbitsize: asizeint; override; + function getvardef : longint;override; + end; + + tfloatdef = class(tstoreddef) + floattype : tfloattype; + constructor create(t : tfloattype); + constructor ppuload(ppufile:tcompilerppufile); + function getcopy : tstoreddef;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function GetTypeName:string;override; + function is_publishable : boolean;override; + function alignment:shortint;override; + procedure setsize; + function getvardef:longint;override; + end; + + { tabstractprocdef } + + tabstractprocdef = class(tstoreddef) + { saves a definition to the return type } + returndef : tdef; + returndefderef : tderef; + parast : TSymtable; + paras : tparalist; + proctypeoption : tproctypeoption; + proccalloption : tproccalloption; + procoptions : tprocoptions; + callerargareasize, + calleeargareasize: pint; +{$ifdef m68k} + exp_funcretloc : tregister; { explicit funcretloc for AmigaOS } +{$endif} + funcretloc : array[tcallercallee] of TCGPara; + has_paraloc_info : tcallercallee; { paraloc info is available } + { number of user visible parameters } + maxparacount, + minparacount : byte; + constructor create(dt:tdeftyp;level:byte); + constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile); + destructor destroy;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderef;override; + procedure deref;override; + procedure calcparas; + function typename_paras(showhidden:boolean): string; + function is_methodpointer:boolean;virtual; + function is_addressonly:boolean;virtual; + function no_self_node:boolean; + procedure check_mark_as_nested; + procedure init_paraloc_info(side: tcallercallee); + function stack_tainting_parameter(side: tcallercallee): boolean; + private + procedure count_para(p:TObject;arg:pointer); + procedure insert_para(p:TObject;arg:pointer); + end; + + tprocvardef = class(tabstractprocdef) + constructor create(level:byte); + constructor ppuload(ppufile:tcompilerppufile); + function getcopy : tstoreddef;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function GetSymtable(t:tGetSymtable):TSymtable;override; + function size : asizeint;override; + function GetTypeName:string;override; + function is_publishable : boolean;override; + function is_methodpointer:boolean;override; + function is_addressonly:boolean;override; + function getmangledparaname:string;override; + end; + + tmessageinf = record + case integer of + 0 : (str : pshortstring); + 1 : (i : longint); + end; + + tinlininginfo = record + { node tree } + code : tnode; + flags : tprocinfoflags; + end; + pinlininginfo = ^tinlininginfo; + + +{$ifdef oldregvars} + { register variables } + pregvarinfo = ^tregvarinfo; + tregvarinfo = record + regvars : array[1..maxvarregs] of tsym; + regvars_para : array[1..maxvarregs] of boolean; + regvars_refs : array[1..maxvarregs] of longint; + + fpuregvars : array[1..maxfpuvarregs] of tsym; + fpuregvars_para : array[1..maxfpuvarregs] of boolean; + fpuregvars_refs : array[1..maxfpuvarregs] of longint; + end; +{$endif oldregvars} + + { tprocdef } + + tprocdef = class(tabstractprocdef) + private + _mangledname : pshortstring; + public + messageinf : tmessageinf; + dispid : longint; +{$ifndef EXTDEBUG} + { where is this function defined and what were the symbol + flags, needed here because there + is only one symbol for all overloaded functions + EXTDEBUG has fileinfo in tdef (PFV) } + fileinfo : tfileposinfo; +{$endif} + symoptions : tsymoptions; + deprecatedmsg : pshortstring; + { symbol owning this definition } + procsym : tsym; + procsymderef : tderef; + { alias names } + aliasnames : TCmdStrList; + { symtables } + localst : TSymtable; + funcretsym : tsym; + funcretsymderef : tderef; + struct : tabstractrecorddef; + structderef : tderef; +{$if defined(powerpc) or defined(m68k)} + { library symbol for AmigaOS/MorphOS } + libsym : tsym; + libsymderef : tderef; +{$endif powerpc or m68k} + { name of the result variable to insert in the localsymtable } + resultname : pshortstring; + { import info } + import_dll, + import_name : pshortstring; + { info for inlining the subroutine, if this pointer is nil, + the procedure can't be inlined } + inlininginfo : pinlininginfo; +{$ifdef oldregvars} + regvarinfo: pregvarinfo; +{$endif oldregvars} + { interrupt vector } + interruptvector : longint; + { First/last assembler symbol/instruction in aasmoutput list. + Note: initialised after compiling the code for the procdef, but + not saved to/restored from ppu. Used when inserting debug info } + procstarttai, + procendtai : tai; + import_nr : word; + extnumber : word; +{$ifdef i386} + fpu_used : byte; +{$endif i386} + visibility : tvisibility; + { true, if the procedure is only declared + (forward procedure) } + forwarddef, + { true if the procedure is declared in the interface } + interfacedef : boolean; + { true if the procedure has a forward declaration } + hasforward : boolean; + constructor create(level:byte); + constructor ppuload(ppufile:tcompilerppufile); + destructor destroy;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderef;override; + procedure buildderefimpl;override; + procedure deref;override; + procedure derefimpl;override; + function GetSymtable(t:tGetSymtable):TSymtable;override; + function GetTypeName : string;override; + function mangledname : string; + procedure setmangledname(const s : string); + function fullprocname(showhidden:boolean):string; + function cplusplusmangledname : string; + function objcmangledname : string; + function is_methodpointer:boolean;override; + function is_addressonly:boolean;override; + procedure make_external; + end; + + { single linked list of overloaded procs } + pprocdeflist = ^tprocdeflist; + tprocdeflist = record + def : tprocdef; + defderef : tderef; + next : pprocdeflist; + end; + + tstringdef = class(tstoreddef) + encoding : tstringencoding; + stringtype : tstringtype; + len : asizeint; + constructor createshort(l : byte); + constructor loadshort(ppufile:tcompilerppufile); + constructor createlong(l : asizeint); + constructor loadlong(ppufile:tcompilerppufile); + constructor createansi(aencoding:tstringencoding); + constructor loadansi(ppufile:tcompilerppufile); + constructor createwide; + constructor loadwide(ppufile:tcompilerppufile); + constructor createunicode; + constructor loadunicode(ppufile:tcompilerppufile); + function getcopy : tstoreddef;override; + function stringtypname:string; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function GetTypeName:string;override; + function getmangledparaname:string;override; + function is_publishable : boolean;override; + function alignment : shortint;override; + function needs_inittable : boolean;override; + function getvardef:longint;override; + end; + + { tenumdef } + + tenumdef = class(tstoreddef) + minval, + maxval : asizeint; + basedef : tenumdef; + basedefderef : tderef; + symtable : TSymtable; + has_jumps : boolean; + constructor create; + constructor create_subrange(_basedef:tenumdef;_min,_max:asizeint); + constructor ppuload(ppufile:tcompilerppufile); + destructor destroy;override; + function getcopy : tstoreddef;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderef;override; + procedure deref;override; + function GetTypeName:string;override; + function is_publishable : boolean;override; + procedure calcsavesize; + function packedbitsize: asizeint; override; + procedure setmax(_max:asizeint); + procedure setmin(_min:asizeint); + function min:asizeint; + function max:asizeint; + function getfirstsym:tsym; + end; + + tsetdef = class(tstoreddef) + elementdef : tdef; + elementdefderef : tderef; + setbase, + setmax : aword; + constructor create(def:tdef;low, high : asizeint); + constructor ppuload(ppufile:tcompilerppufile); + function getcopy : tstoreddef;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderef;override; + procedure deref;override; + function GetTypeName:string;override; + function is_publishable : boolean;override; + end; + + tdefawaresymtablestack = class(TSymtablestack) + private + procedure addhelpers(st: TSymtable); + procedure removehelpers(st: TSymtable); + public + procedure push(st: TSymtable); override; + procedure pop(st: TSymtable); override; + end; + + var + current_structdef: tabstractrecorddef; { used for private functions check !! } + current_genericdef: tstoreddef; { used to reject declaration of generic class inside generic class } + current_specializedef: tstoreddef; { used to implement usage of generic class in itself } + + { default types } + generrordef, { error in definition } + voidpointertype, { pointer for Void-pointeddef } + charpointertype, { pointer for Char-pointeddef } + widecharpointertype, { pointer for WideChar-pointeddef } + voidfarpointertype, + cundefinedtype, + cformaltype, { unique formal definition } + ctypedformaltype, { unique typed formal definition } + voidtype, { Void (procedure) } + cchartype, { Char } + cwidechartype, { WideChar } + pasbool8type, { boolean type } + pasbool16type, + pasbool32type, + pasbool64type, + bool8type, + bool16type, + bool32type, + bool64type, { implement me } + u8inttype, { 8-Bit unsigned integer } + s8inttype, { 8-Bit signed integer } + u16inttype, { 16-Bit unsigned integer } + s16inttype, { 16-Bit signed integer } + u32inttype, { 32-Bit unsigned integer } + s32inttype, { 32-Bit signed integer } + u64inttype, { 64-bit unsigned integer } + s64inttype, { 64-bit signed integer } + s32floattype, { 32 bit floating point number } + s64floattype, { 64 bit floating point number } + s80floattype, { 80 bit floating point number } + sc80floattype, { 80 bit floating point number but stored like in C } + s64currencytype, { pointer to a currency type } + cshortstringtype, { pointer to type of short string const } + clongstringtype, { pointer to type of long string const } + cansistringtype, { pointer to type of ansi string const } + cwidestringtype, { pointer to type of wide string const } + cunicodestringtype, + openshortstringtype, { pointer to type of an open shortstring, + needed for readln() } + openchararraytype, { pointer to type of an open array of char, + needed for readln() } + cfiletype, { get the same definition for all file } + { used for stabs } + methodpointertype, { typecasting of methodpointers to extract self } + hresultdef, + { we use only one variant def for every variant class } + cvarianttype, + colevarianttype, + { default integer type s32inttype on 32 bit systems, s64bittype on 64 bit systems } + sinttype, + uinttype, + { unsigned and signed ord type with the same size as a pointer } + ptruinttype, + ptrsinttype, + { several types to simulate more or less C++ objects for GDB } + vmttype, + vmtarraytype, + pvmttype : tdef; { type of classrefs, used for stabs } + + { pointer to the anchestor of all classes } + class_tobject : tobjectdef; + { pointer to the ancestor of all COM interfaces } + interface_iunknown : tobjectdef; + { pointer to the ancestor of all dispinterfaces } + interface_idispatch : tobjectdef; + { pointer to the TGUID type + of all interfaces } + rec_tguid : trecorddef; + + { pointer to jump buffer } + rec_jmp_buf : trecorddef; + + { Objective-C base types } + objc_metaclasstype, + objc_superclasstype, + objc_idtype, + objc_seltype : tpointerdef; + objc_objecttype : trecorddef; + { base type of @protocol(protocolname) Objective-C statements } + objc_protocoltype : tobjectdef; + { helper types for for-in "fast enumeration" support in Objective-C 2.0 } + objc_fastenumeration : tobjectdef; + objc_fastenumerationstate : trecorddef; + + const +{$ifdef i386} + pbestrealtype : ^tdef = @s80floattype; +{$endif} +{$ifdef x86_64} + pbestrealtype : ^tdef = @s80floattype; +{$endif} +{$ifdef m68k} + pbestrealtype : ^tdef = @s64floattype; +{$endif} +{$ifdef alpha} + pbestrealtype : ^tdef = @s64floattype; +{$endif} +{$ifdef powerpc} + pbestrealtype : ^tdef = @s64floattype; +{$endif} +{$ifdef POWERPC64} + pbestrealtype : ^tdef = @s64floattype; +{$endif} +{$ifdef ia64} + pbestrealtype : ^tdef = @s64floattype; +{$endif} +{$ifdef SPARC} + pbestrealtype : ^tdef = @s64floattype; +{$endif SPARC} +{$ifdef vis} + pbestrealtype : ^tdef = @s64floattype; +{$endif vis} +{$ifdef ARM} + pbestrealtype : ^tdef = @s64floattype; +{$endif ARM} +{$ifdef MIPS} + pbestrealtype : ^tdef = @s64floattype; +{$endif MIPS} +{$ifdef AVR} + pbestrealtype : ^tdef = @s64floattype; +{$endif AVR} + + function make_mangledname(const typeprefix:string;st:TSymtable;const suffix:string):string; + function make_dllmangledname(const dllname,importname:string; + import_nr : word; pco : tproccalloption):string; + + { should be in the types unit, but the types unit uses the node stuff :( } + function is_interfacecom(def: tdef): boolean; + function is_interfacecom_or_dispinterface(def: tdef): boolean; + function is_interfacecorba(def: tdef): boolean; + function is_interface(def: tdef): boolean; + function is_dispinterface(def: tdef): boolean; + function is_object(def: tdef): boolean; + function is_class(def: tdef): boolean; + function is_cppclass(def: tdef): boolean; + function is_objectpascal_helper(def: tdef): boolean; + function is_objcclass(def: tdef): boolean; + function is_objcclassref(def: tdef): boolean; + function is_objcprotocol(def: tdef): boolean; + function is_objccategory(def: tdef): boolean; + function is_objc_class_or_protocol(def: tdef): boolean; + function is_objc_protocol_or_category(def: tdef): boolean; + function is_classhelper(def: tdef): boolean; + function is_class_or_interface(def: tdef): boolean; + function is_class_or_interface_or_objc(def: tdef): boolean; + function is_class_or_interface_or_object(def: tdef): boolean; + function is_class_or_interface_or_dispinterface(def: tdef): boolean; + function is_implicit_pointer_object_type(def: tdef): boolean; + function is_class_or_object(def: tdef): boolean; + function is_record(def: tdef): boolean; + + procedure loadobjctypes; + procedure maybeloadcocoatypes; + + function use_vectorfpu(def : tdef) : boolean; + + function getansistringcodepage:tstringencoding; inline; + function getansistringdef:tstringdef; inline; + function getparaencoding(def:tdef):tstringencoding; inline; + +implementation + + uses + SysUtils, + cutils, + { global } + verbose, + { target } + systems,aasmcpu,paramgr, + { symtable } + symsym,symtable,symutil,defutil,objcdef, + { module } + fmodule, + { other } + gendef, + fpccrc + ; + +{**************************************************************************** + Helpers +****************************************************************************} + + function getansistringcodepage:tstringencoding; inline; + begin + if cs_explicit_codepage in current_settings.moduleswitches then + result:=current_settings.sourcecodepage + else + result:=0; + end; + + function getansistringdef:tstringdef; inline; + var + symtable:tsymtable; + begin + { if codepage is explicitly defined in this mudule we need to return + a replacement for ansistring def } + if cs_explicit_codepage in current_settings.moduleswitches then + begin + if not assigned(current_module) then + internalerror(2011101301); + { codepage can be redeclared only once per unit so we don't need a list of + redefined ansistring but only one pointer } + if not assigned(current_module.ansistrdef) then + begin + { if we did not create it yet we need to do this now } + if current_module.is_unit then + symtable:=current_module.globalsymtable + else + symtable:=current_module.localsymtable; + symtablestack.push(symtable); + current_module.ansistrdef:=tstringdef.createansi(current_settings.sourcecodepage); + symtablestack.pop(symtable); + end; + result:=tstringdef(current_module.ansistrdef); + end + else + result:=tstringdef(cansistringtype); + end; + + function getparaencoding(def:tdef):tstringencoding; inline; + begin + { don't pass CP_NONE encoding to internal functions + they expect 0 encoding instead } + result:=tstringdef(def).encoding; + if result=CP_NONE then + result:=0 + end; + + function make_mangledname(const typeprefix:string;st:TSymtable;const suffix:string):string; + var + s,hs, + prefix : string; + oldlen, + newlen, + i : longint; + crc : dword; + hp : tparavarsym; + begin + prefix:=''; + if not assigned(st) then + internalerror(200204212); + { sub procedures } + while (st.symtabletype=localsymtable) do + begin + if st.defowner.typ<>procdef then + internalerror(200204173); + { Add the full mangledname of procedure to prevent + conflicts with 2 overloads having both a nested procedure + with the same name, see tb0314 (PFV) } + s:=tprocdef(st.defowner).procsym.name; + oldlen:=length(s); + for i:=0 to tprocdef(st.defowner).paras.count-1 do + begin + hp:=tparavarsym(tprocdef(st.defowner).paras[i]); + if not(vo_is_hidden_para in hp.varoptions) then + s:=s+'$'+hp.vardef.mangledparaname; + end; + if not is_void(tprocdef(st.defowner).returndef) then + s:=s+'$$'+tprocdef(st.defowner).returndef.mangledparaname; + newlen:=length(s); + { Replace with CRC if the parameter line is very long } + if (newlen-oldlen>12) and + ((newlen+length(prefix)>100) or (newlen-oldlen>32)) then + begin + crc:=0; + for i:=0 to tprocdef(st.defowner).paras.count-1 do + begin + hp:=tparavarsym(tprocdef(st.defowner).paras[i]); + if not(vo_is_hidden_para in hp.varoptions) then + begin + hs:=hp.vardef.mangledparaname; + crc:=UpdateCrc32(crc,hs[1],length(hs)); + end; + end; + hs:=hp.vardef.mangledparaname; + crc:=UpdateCrc32(crc,hs[1],length(hs)); + s:=Copy(s,1,oldlen)+'$crc'+hexstr(crc,8); + end; + if prefix<>'' then + prefix:=s+'_'+prefix + else + prefix:=s; + if length(prefix)>100 then + begin + crc:=0; + crc:=UpdateCrc32(crc,prefix[1],length(prefix)); + prefix:='$CRC'+hexstr(crc,8); + end; + st:=st.defowner.owner; + end; + { object/classes symtable, nested type definitions in classes require the while loop } + while st.symtabletype in [ObjectSymtable,recordsymtable] do + begin + if not (st.defowner.typ in [objectdef,recorddef]) then + internalerror(200204174); + prefix:=tabstractrecorddef(st.defowner).objname^+'_$_'+prefix; + st:=st.defowner.owner; + end; + { symtable must now be static or global } + if not(st.symtabletype in [staticsymtable,globalsymtable]) then + internalerror(200204175); + + { The mangled name is made out of at most 4 parts: + 1) Optional typeprefix given as first parameter + with '_$' appended if not empty + 2) Unit name or 'P$'+program name (never empty) + 3) optional prefix variable that contains a unique + name for the local symbol table (prepended with '$_$' + if not empty) + 4) suffix as given as third parameter, + also optional (i.e. can be empty) + prepended by '_$$_' if not empty } + result:=''; + if typeprefix<>'' then + result:=result+typeprefix+'_$'; + { Add P$ for program, which can have the same name as + a unit } + if (TSymtable(main_module.localsymtable)=st) and + (not main_module.is_unit) then + result:=result+'P$'+st.name^ + else + result:=result+st.name^; + if prefix<>'' then + result:=result+'$_$'+prefix; + if suffix<>'' then + result:=result+'_$$_'+suffix; + { the Darwin assembler assumes that all symbols starting with 'L' are local } + { Further, the Mac OS X 10.5 linker does not consider symbols which do not } + { start with '_' as regular symbols (it does not generate N_GSYM entries } + { those in the debug map, leading to troubles with dsymutil). So always } + { add an underscore on darwin. } + if (target_info.system in systems_darwin) then + result := '_' + result; + end; + + function make_dllmangledname(const dllname,importname:string;import_nr : word; pco : tproccalloption):string; + var + crc : cardinal; + i : longint; + use_crc : boolean; + dllprefix : string; + begin + if (target_info.system in (systems_all_windows + systems_nativent + + [system_i386_emx, system_i386_os2])) + and (dllname <> '') then + begin + dllprefix:=lower(ExtractFileName(dllname)); + { Remove .dll suffix if present } + if copy(dllprefix,length(dllprefix)-3,length(dllprefix))='.dll' then + dllprefix:=copy(dllprefix,1,length(dllprefix)-4); + use_crc:=false; + for i:=1 to length(dllprefix) do + if not (dllprefix[i] in ['a'..'z','A'..'Z','_','0'..'9']) then + begin + use_crc:=true; + break; + end; + if use_crc then + begin + crc:=0; + crc:=UpdateCrc32(crc,dllprefix[1],length(dllprefix)); + dllprefix:='_$dll$crc$'+hexstr(crc,8)+'$'; + end + else + dllprefix:='_$dll$'+dllprefix+'$'; + + if importname<>'' then + result:=dllprefix+importname + else + result:=dllprefix+'_index_'+tostr(import_nr); + { Replace ? and @ in import name, since GNU AS does not allow these characters in symbol names. } + { This allows to import VC++ mangled names from DLLs. } + { Do not perform replacement, if external symbol is not imported from DLL. } + if (dllname<>'') then + begin + Replace(result,'?','__q$$'); + {$ifdef arm} + { @ symbol is not allowed in ARM assembler only } + Replace(result,'@','__a$$'); + {$endif arm} + end; + end + else + begin + if importname<>'' then + begin + if not(pco in [pocall_cdecl,pocall_cppdecl]) then + result:=importname + else + result:=target_info.Cprefix+importname; + end + else + result:='_index_'+tostr(import_nr); + end; + + end; + +{**************************************************************************** + TDEFAWARESYMTABLESTACK + (symtablestack descendant that does some special actions on + the pushed/popped symtables) +****************************************************************************} + + procedure tdefawaresymtablestack.addhelpers(st: TSymtable); + var + i: integer; + s: string; + list: TFPObjectList; + def: tdef; + begin + { search the symtable from first to last; the helper to use will be the + last one in the list } + for i:=0 to st.symlist.count-1 do + begin + if not (st.symlist[i] is ttypesym) then + continue; + def:=ttypesym(st.SymList[i]).typedef; + if is_objectpascal_helper(def) and + (tobjectdef(def).extendeddef.typ in [recorddef,objectdef]) then + begin + s:=make_mangledname('',tabstractrecorddef(tobjectdef(def).extendeddef).symtable,''); + list:=TFPObjectList(current_module.extendeddefs.Find(s)); + if not assigned(list) then + begin + list:=TFPObjectList.Create(false); + current_module.extendeddefs.Add(s,list); + end; + list.Add(def); + end + else + { add nested helpers as well } + if def.typ in [recorddef,objectdef] then + addhelpers(tabstractrecorddef(def).symtable); + end; + end; + + procedure tdefawaresymtablestack.removehelpers(st: TSymtable); + var + i, j: integer; + tmpst: TSymtable; + list: TFPObjectList; + begin + for i:=current_module.extendeddefs.count-1 downto 0 do + begin + list:=TFPObjectList(current_module.extendeddefs[i]); + for j:=list.count-1 downto 0 do + begin + if not (list[j] is tobjectdef) then + Internalerror(2011031501); + tmpst:=tobjectdef(list[j]).owner; + repeat + if tmpst=st then + begin + list.delete(j); + break; + end + else + begin + if assigned(tmpst.defowner) then + tmpst:=tmpst.defowner.owner + else + tmpst:=nil; + end; + until not assigned(tmpst) or (tmpst.symtabletype in [globalsymtable,staticsymtable]); + end; + if list.count=0 then + current_module.extendeddefs.delete(i); + end; + end; + + procedure tdefawaresymtablestack.push(st: TSymtable); + begin + { nested helpers will be added as well } + if (st.symtabletype in [globalsymtable,staticsymtable]) and + (sto_has_helper in st.tableoptions) then + addhelpers(st); + inherited push(st); + end; + + procedure tdefawaresymtablestack.pop(st: TSymtable); + begin + inherited pop(st); + { nested helpers will be removed as well } + if (st.symtabletype in [globalsymtable,staticsymtable]) and + (sto_has_helper in st.tableoptions) then + removehelpers(st); + end; + + +{**************************************************************************** + TDEF (base class for definitions) +****************************************************************************} + + constructor tstoreddef.create(dt:tdeftyp); + var + insertstack : psymtablestackitem; + begin + inherited create(dt); + savesize := 0; +{$ifdef EXTDEBUG} + fileinfo := current_filepos; +{$endif} + generictokenbuf:=nil; + genericdef:=nil; + change_endian:=false; + + { Don't register forwarddefs, they are disposed at the + end of an type block } + if (dt=forwarddef) then + exit; + { Register in current_module } + if assigned(current_module) then + begin + current_module.deflist.Add(self); + DefId:=current_module.deflist.Count-1; + end; + { Register in symtable stack } + if assigned(symtablestack) then + begin + insertstack:=symtablestack.stack; + while assigned(insertstack) and + (insertstack^.symtable.symtabletype=withsymtable) do + insertstack:=insertstack^.next; + if not assigned(insertstack) then + internalerror(200602044); + insertstack^.symtable.insertdef(self); + end; + end; + + + destructor tstoreddef.destroy; + begin + { Direct calls are not allowed, use symtable.deletedef() } + if assigned(owner) then + internalerror(200612311); + if assigned(generictokenbuf) then + begin + generictokenbuf.free; + generictokenbuf:=nil; + end; + inherited destroy; + end; + + + constructor tstoreddef.ppuload(dt:tdeftyp;ppufile:tcompilerppufile); + var + sizeleft,i : longint; + buf : array[0..255] of byte; + begin + inherited create(dt); + DefId:=ppufile.getlongint; + current_module.deflist[DefId]:=self; +{$ifdef EXTDEBUG} + fillchar(fileinfo,sizeof(fileinfo),0); +{$endif} + { load } + ppufile.getderef(typesymderef); + ppufile.getsmallset(defoptions); + ppufile.getsmallset(defstates); + if df_generic in defoptions then + begin + sizeleft:=ppufile.getlongint; + change_endian:=ppufile.change_endian; + initgeneric; + while sizeleft>0 do + begin + if sizeleft>sizeof(buf) then + i:=sizeof(buf) + else + i:=sizeleft; + ppufile.getdata(buf,i); + generictokenbuf.write(buf,i); + dec(sizeleft,i); + end; + end; + if df_specialization in defoptions then + ppufile.getderef(genericdefderef); + end; + + + function Tstoreddef.rtti_mangledname(rt:trttitype):string; + var + prefix : string[4]; + begin + if rt=fullrtti then + begin + prefix:='RTTI'; + include(defstates,ds_rtti_table_used); + end + else + begin + prefix:='INIT'; + include(defstates,ds_init_table_used); + end; + if assigned(typesym) and + (owner.symtabletype in [staticsymtable,globalsymtable]) then + result:=make_mangledname(prefix,owner,typesym.name) + else + result:=make_mangledname(prefix,findunitsymtable(owner),'DEF'+tostr(DefId)) + end; + + + function tstoreddef.OwnerHierarchyName: string; + var + tmp: tdef; + begin + tmp:=self; + result:=''; + repeat + if tmp.owner.symtabletype in [ObjectSymtable,recordsymtable] then + tmp:=tdef(tmp.owner.defowner) + else + break; + result:=tabstractrecorddef(tmp).objrealname^+'.'+result; + until tmp=nil; + end; + + + function tstoreddef.in_currentunit: boolean; + var + st: tsymtable; + begin + st:=owner; + while not(st.symtabletype in [globalsymtable,staticsymtable]) do + st:=st.defowner.owner; + result:=st.iscurrentunit; + end; + + + function tstoreddef.getcopy : tstoreddef; + begin + Message(sym_e_cant_create_unique_type); + getcopy:=terrordef.create; + end; + + + procedure tstoreddef.ppuwrite(ppufile:tcompilerppufile); + var + sizeleft,i : longint; + buf : array[0..255] of byte; + oldintfcrc : boolean; + begin + ppufile.putlongint(DefId); + ppufile.putderef(typesymderef); + ppufile.putsmallset(defoptions); + oldintfcrc:=ppufile.do_crc; + ppufile.do_crc:=false; + ppufile.putsmallset(defstates); + if df_generic in defoptions then + begin + if assigned(generictokenbuf) then + begin + sizeleft:=generictokenbuf.size; + generictokenbuf.seek(0); + end + else + sizeleft:=0; + ppufile.putlongint(sizeleft); + while sizeleft>0 do + begin + if sizeleft>sizeof(buf) then + i:=sizeof(buf) + else + i:=sizeleft; + generictokenbuf.read(buf,i); + ppufile.putdata(buf,i); + dec(sizeleft,i); + end; + end; + ppufile.do_crc:=oldintfcrc; + if df_specialization in defoptions then + ppufile.putderef(genericdefderef); + end; + + + procedure tstoreddef.buildderef; + begin + typesymderef.build(typesym); + genericdefderef.build(genericdef); + end; + + + procedure tstoreddef.buildderefimpl; + begin + end; + + + procedure tstoreddef.deref; + begin + typesym:=ttypesym(typesymderef.resolve); + if df_specialization in defoptions then + genericdef:=tstoreddef(genericdefderef.resolve); + end; + + + procedure tstoreddef.derefimpl; + begin + end; + + + function tstoreddef.size : asizeint; + begin + size:=savesize; + end; + + + function tstoreddef.getvardef:longint; + begin + result:=varUndefined; + end; + + + function tstoreddef.alignment : shortint; + begin + { natural alignment by default } + alignment:=size_2_align(savesize); + { can happen if savesize = 0, e.g. for voiddef or + an empty record + } + if (alignment=0) then + alignment:=1; + end; + + + { returns true, if the definition can be published } + function tstoreddef.is_publishable : boolean; + begin + is_publishable:=false; + end; + + + { needs an init table } + function tstoreddef.needs_inittable : boolean; + begin + needs_inittable:=false; + end; + + + function tstoreddef.is_intregable : boolean; + var + recsize,temp: longint; + begin + is_intregable:=false; + case typ of + orddef, + pointerdef, + enumdef, + classrefdef: + is_intregable:=true; + procvardef : + is_intregable:=tprocvardef(self).is_addressonly; + objectdef: + is_intregable:=(is_implicit_pointer_object_type(self)) and not needs_inittable; + setdef: + is_intregable:=is_smallset(self); + recorddef: + begin + recsize:=size; + is_intregable:= + ispowerof2(recsize,temp) and + (recsize <= sizeof(asizeint)); + end; + end; + end; + + + function tstoreddef.is_fpuregable : boolean; + begin +{$ifdef x86} + result:=use_vectorfpu(self); +{$else x86} + result:=(typ=floatdef) and not(cs_fp_emulation in current_settings.moduleswitches); +{$endif x86} + end; + + + procedure tstoreddef.initgeneric; + begin + if assigned(generictokenbuf) then + internalerror(200512131); + generictokenbuf:=tdynamicarray.create(256); + end; + + +{**************************************************************************** + Tstringdef +****************************************************************************} + + constructor tstringdef.createshort(l : byte); + begin + inherited create(stringdef); + stringtype:=st_shortstring; + encoding:=0; + len:=l; + savesize:=len+1; + end; + + + constructor tstringdef.loadshort(ppufile:tcompilerppufile); + begin + inherited ppuload(stringdef,ppufile); + stringtype:=st_shortstring; + encoding:=0; + len:=ppufile.getbyte; + savesize:=len+1; + end; + + + constructor tstringdef.createlong(l : asizeint); + begin + inherited create(stringdef); + stringtype:=st_longstring; + encoding:=0; + len:=l; + savesize:=sizeof(pint); + end; + + + constructor tstringdef.loadlong(ppufile:tcompilerppufile); + begin + inherited ppuload(stringdef,ppufile); + stringtype:=st_longstring; + encoding:=0; + len:=ppufile.getasizeint; + savesize:=sizeof(pint); + end; + + + constructor tstringdef.createansi(aencoding:tstringencoding); + begin + inherited create(stringdef); + stringtype:=st_ansistring; + encoding:=aencoding; + len:=-1; + savesize:=sizeof(pint); + end; + + + constructor tstringdef.loadansi(ppufile:tcompilerppufile); + begin + inherited ppuload(stringdef,ppufile); + stringtype:=st_ansistring; + len:=ppufile.getaint; + encoding:=ppufile.getword; + savesize:=sizeof(pint); + end; + + + constructor tstringdef.createwide; + begin + inherited create(stringdef); + stringtype:=st_widestring; + encoding:=CP_UTF16; + len:=-1; + savesize:=sizeof(pint); + end; + + + constructor tstringdef.loadwide(ppufile:tcompilerppufile); + begin + inherited ppuload(stringdef,ppufile); + stringtype:=st_widestring; + encoding:=CP_UTF16; + len:=ppufile.getaint; + savesize:=sizeof(pint); + end; + + + constructor tstringdef.createunicode; + begin + inherited create(stringdef); + stringtype:=st_unicodestring; + encoding:=CP_UTF16; + len:=-1; + savesize:=sizeof(pint); + end; + + + constructor tstringdef.loadunicode(ppufile:tcompilerppufile); + begin + inherited ppuload(stringdef,ppufile); + stringtype:=st_unicodestring; + len:=ppufile.getaint; + encoding:=ppufile.getword; + savesize:=sizeof(pint); + end; + + + function tstringdef.getcopy : tstoreddef; + begin + result:=tstringdef.create(typ); + result.typ:=stringdef; + tstringdef(result).stringtype:=stringtype; + tstringdef(result).encoding:=encoding; + tstringdef(result).len:=len; + tstringdef(result).savesize:=savesize; + end; + + + function tstringdef.stringtypname:string; + const + typname:array[tstringtype] of string[10]=( + 'shortstr','longstr','ansistr','widestr','unicodestr' + ); + begin + stringtypname:=typname[stringtype]; + end; + + + procedure tstringdef.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + if stringtype=st_shortstring then + begin +{$ifdef extdebug} + if len > 255 then internalerror(12122002); +{$endif} + ppufile.putbyte(byte(len)) + end + else + ppufile.putaint(len); + if stringtype in [st_ansistring,st_unicodestring] then + ppufile.putword(encoding); + case stringtype of + st_shortstring : ppufile.writeentry(ibshortstringdef); + st_longstring : ppufile.writeentry(iblongstringdef); + st_ansistring : ppufile.writeentry(ibansistringdef); + st_widestring : ppufile.writeentry(ibwidestringdef); + st_unicodestring : ppufile.writeentry(ibunicodestringdef); + end; + end; + + + function tstringdef.needs_inittable : boolean; + begin + needs_inittable:=stringtype in [st_ansistring,st_widestring,st_unicodestring]; + end; + + + function tstringdef.GetTypeName : string; + const + names : array[tstringtype] of string[15] = ( + 'ShortString','LongString','AnsiString','WideString','UnicodeString'); + begin + GetTypeName:=names[stringtype]; + end; + + + function tstringdef.getvardef : longint; + const + vardef : array[tstringtype] of longint = ( + varUndefined,varUndefined,varString,varOleStr,varUString); + begin + result:=vardef[stringtype]; + end; + + + function tstringdef.alignment : shortint; + begin + case stringtype of + st_unicodestring, + st_widestring, + st_ansistring: + alignment:=size_2_align(savesize); + st_longstring, + st_shortstring: + { char to string accesses byte 0 and 1 with one word access } + if (tf_requires_proper_alignment in target_info.flags) or + { macpas needs an alignment of 2 (MetroWerks compatible) } + (m_mac in current_settings.modeswitches) then + alignment:=size_2_align(2) + else + alignment:=size_2_align(1); + else + internalerror(200412301); + end; + end; + + + function tstringdef.getmangledparaname : string; + begin + getmangledparaname:='STRING'; + end; + + + function tstringdef.is_publishable : boolean; + begin + is_publishable:=true; + end; + + +{**************************************************************************** + TENUMDEF +****************************************************************************} + + constructor tenumdef.create; + begin + inherited create(enumdef); + minval:=0; + maxval:=0; + calcsavesize; + has_jumps:=false; + basedef:=nil; + symtable:=tenumsymtable.create(self); + end; + + + constructor tenumdef.create_subrange(_basedef:tenumdef;_min,_max:asizeint); + begin + inherited create(enumdef); + minval:=_min; + maxval:=_max; + basedef:=_basedef; + calcsavesize; + has_jumps:=false; + symtable:=basedef.symtable.getcopy; + include(defoptions, df_copied_def); + end; + + + constructor tenumdef.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(enumdef,ppufile); + minval:=ppufile.getaint; + maxval:=ppufile.getaint; + savesize:=ppufile.getaint; + has_jumps:=false; + if df_copied_def in defoptions then + begin + symtable:=nil; + ppufile.getderef(basedefderef); + end + else + begin + // create with nil defowner first to prevent values changes on insert + symtable:=tenumsymtable.create(nil); + tenumsymtable(symtable).ppuload(ppufile); + symtable.defowner:=self; + end; + end; + + destructor tenumdef.destroy; + begin + symtable.free; + symtable:=nil; + inherited destroy; + end; + + + function tenumdef.getcopy : tstoreddef; + begin + if assigned(basedef) then + result:=tenumdef.create_subrange(basedef,minval,maxval) + else + begin + result:=tenumdef.create; + tenumdef(result).minval:=minval; + tenumdef(result).maxval:=maxval; + tenumdef(result).symtable.free; + tenumdef(result).symtable:=symtable.getcopy; + tenumdef(result).basedef:=self; + end; + tenumdef(result).has_jumps:=has_jumps; + tenumdef(result).basedefderef:=basedefderef; + include(tenumdef(result).defoptions,df_copied_def); + end; + + + procedure tenumdef.calcsavesize; + begin +{$IFNDEF cpu64bitaddr} {$push}{$warnings off} {$ENDIF} //comparison always false warning + if (current_settings.packenum=8) or (min<low(longint)) or (int64(max)>high(cardinal)) then + savesize:=8 +{$IFDEF not cpu64bitaddr} {$pop} {$ENDIF} + else + if (current_settings.packenum=4) or (min<low(smallint)) or (max>high(word)) then + savesize:=4 + else + if (current_settings.packenum=2) or (min<low(shortint)) or (max>high(byte)) then + savesize:=2 + else + savesize:=1; + end; + + + function tenumdef.packedbitsize: asizeint; + var + sizeval: tconstexprint; + power: longint; + begin + result := 0; + if (minval >= 0) and + (maxval <= 1) then + result := 1 + else + begin + if (minval>=0) then + sizeval:=maxval + else + { don't count 0 twice } + sizeval:=(cutils.max(-minval,maxval)*2)-1; + { 256 must become 512 etc. } + nextpowerof2(sizeval+1,power); + result := power; + end; + end; + + + procedure tenumdef.setmax(_max:asizeint); + begin + maxval:=_max; + calcsavesize; + end; + + + procedure tenumdef.setmin(_min:asizeint); + begin + minval:=_min; + calcsavesize; + end; + + + function tenumdef.min:asizeint; + begin + min:=minval; + end; + + + function tenumdef.max:asizeint; + begin + max:=maxval; + end; + + function tenumdef.getfirstsym: tsym; + var + i:integer; + begin + for i := 0 to symtable.SymList.Count - 1 do + begin + result:=tsym(symtable.SymList[i]); + if tenumsym(result).value=minval then + exit; + end; + result:=nil; + end; + + + procedure tenumdef.buildderef; + begin + inherited buildderef; + if df_copied_def in defoptions then + basedefderef.build(basedef) + else + tenumsymtable(symtable).buildderef; + end; + + + procedure tenumdef.deref; + begin + inherited deref; + if df_copied_def in defoptions then + begin + basedef:=tenumdef(basedefderef.resolve); + symtable:=basedef.symtable.getcopy; + end + else + tenumsymtable(symtable).deref; + end; + + + procedure tenumdef.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putaint(min); + ppufile.putaint(max); + ppufile.putaint(savesize); + if df_copied_def in defoptions then + ppufile.putderef(basedefderef); + ppufile.writeentry(ibenumdef); + if not (df_copied_def in defoptions) then + tenumsymtable(symtable).ppuwrite(ppufile); + end; + + + function tenumdef.is_publishable : boolean; + begin + is_publishable:=true; + end; + + + function tenumdef.GetTypeName : string; + begin + GetTypeName:='<enumeration type>'; + end; + + +{**************************************************************************** + TORDDEF +****************************************************************************} + + constructor torddef.create(t : tordtype;v,b : TConstExprInt); + begin + inherited create(orddef); + low:=v; + high:=b; + ordtype:=t; + setsize; + end; + + + constructor torddef.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(orddef,ppufile); + ordtype:=tordtype(ppufile.getbyte); + low:=ppufile.getexprint; + high:=ppufile.getexprint; + setsize; + end; + + + function torddef.getcopy : tstoreddef; + begin + result:=torddef.create(ordtype,low,high); + result.typ:=orddef; + torddef(result).low:=low; + torddef(result).high:=high; + torddef(result).ordtype:=ordtype; + torddef(result).savesize:=savesize; + end; + + + function torddef.alignment:shortint; + begin + if (target_info.system in [system_i386_darwin,system_i386_iphonesim,system_arm_darwin]) and + (ordtype in [s64bit,u64bit]) then + result := 4 + else + result := inherited alignment; + end; + + + procedure torddef.setsize; + const + sizetbl : array[tordtype] of longint = ( + 0, + 1,2,4,8, + 1,2,4,8, + 1,2,4,8, + 1,2,4,8, + 1,2,8 + ); + begin + savesize:=sizetbl[ordtype]; + end; + + + function torddef.packedbitsize: asizeint; + var + sizeval: tconstexprint; + power: longint; + begin + result := 0; + if ordtype = uvoid then + exit; + +{$ifndef cpu64bitalu} + if (ordtype in [s64bit,u64bit]) then +{$else not cpu64bitalu} + if (ordtype = u64bit) or + ((ordtype = s64bit) and + ((low <= (system.low(int64) div 2)) or + (high > (system.high(int64) div 2)))) then +{$endif cpu64bitalu} + result := 64 + else if (low >= 0) and + (high <= 1) then + result := 1 + else + begin + if (low>=0) then + sizeval:=high + else + { don't count 0 twice } + sizeval:=(cutils.max(-low,high)*2)-1; + { 256 must become 512 etc. } + nextpowerof2(sizeval+1,power); + result := power; + end; + end; + + + function torddef.getvardef : longint; + const + basetype2vardef : array[tordtype] of longint = ( + varUndefined, + varbyte,varword,varlongword,varqword, + varshortint,varsmallint,varinteger,varint64, + varboolean,varboolean,varboolean,varboolean, + varboolean,varboolean,varUndefined,varUndefined, + varUndefined,varUndefined,varCurrency); + begin + result:=basetype2vardef[ordtype]; + end; + + + procedure torddef.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putbyte(byte(ordtype)); + ppufile.putexprint(low); + ppufile.putexprint(high); + ppufile.writeentry(iborddef); + end; + + + function torddef.is_publishable : boolean; + begin + is_publishable:=(ordtype<>uvoid); + end; + + + function torddef.GetTypeName : string; + const + names : array[tordtype] of string[20] = ( + 'untyped', + 'Byte','Word','DWord','QWord', + 'ShortInt','SmallInt','LongInt','Int64', + 'Boolean','Boolean16','Boolean32','Boolean64', + 'ByteBool','WordBool','LongBool','QWordBool', + 'Char','WideChar','Currency'); + + begin + GetTypeName:=names[ordtype]; + end; + + +{**************************************************************************** + TFLOATDEF +****************************************************************************} + + constructor tfloatdef.create(t : tfloattype); + begin + inherited create(floatdef); + floattype:=t; + setsize; + end; + + + constructor tfloatdef.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(floatdef,ppufile); + floattype:=tfloattype(ppufile.getbyte); + setsize; + end; + + + function tfloatdef.getcopy : tstoreddef; + begin + result:=tfloatdef.create(floattype); + result.typ:=floatdef; + tfloatdef(result).savesize:=savesize; + end; + + + function tfloatdef.alignment:shortint; + begin + if (target_info.system in [system_i386_darwin,system_i386_iphonesim,system_arm_darwin]) then + case floattype of + sc80real, + s80real: result:=16; + s64real, + s64currency, + s64comp : result:=4; + else + result := inherited alignment; + end + else + result := inherited alignment; + end; + + + procedure tfloatdef.setsize; + begin + case floattype of + s32real : savesize:=4; + s80real : savesize:=10; + sc80real: + if target_info.system in [system_i386_darwin,system_i386_iphonesim,system_x86_64_darwin, + system_x86_64_linux,system_x86_64_freebsd, + system_x86_64_solaris,system_x86_64_embedded] then + savesize:=16 + else + savesize:=12; + s64real, + s64currency, + s64comp : savesize:=8; + else + savesize:=0; + end; + end; + + + function tfloatdef.getvardef : longint; + const + floattype2vardef : array[tfloattype] of longint = ( + varSingle,varDouble,varUndefined,varUndefined, + varUndefined,varCurrency,varUndefined); + begin + if (upper(typename)='TDATETIME') and + assigned(owner) and + assigned(owner.name) and + (owner.name^='SYSTEM') then + result:=varDate + else + result:=floattype2vardef[floattype]; + end; + + + procedure tfloatdef.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putbyte(byte(floattype)); + ppufile.writeentry(ibfloatdef); + end; + + + function tfloatdef.is_publishable : boolean; + begin + is_publishable:=true; + end; + + + function tfloatdef.GetTypeName : string; + const + names : array[tfloattype] of string[20] = ( + 'Single','Double','Extended','CExtended','Comp','Currency','Float128'); + begin + GetTypeName:=names[floattype]; + end; + + +{**************************************************************************** + TFILEDEF +****************************************************************************} + + constructor tfiledef.createtext; + begin + inherited create(filedef); + filetyp:=ft_text; + typedfiledef:=nil; + setsize; + end; + + + constructor tfiledef.createuntyped; + begin + inherited create(filedef); + filetyp:=ft_untyped; + typedfiledef:=nil; + setsize; + end; + + + constructor tfiledef.createtyped(def:tdef); + begin + inherited create(filedef); + filetyp:=ft_typed; + typedfiledef:=def; + setsize; + end; + + + constructor tfiledef.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(filedef,ppufile); + filetyp:=tfiletyp(ppufile.getbyte); + if filetyp=ft_typed then + ppufile.getderef(typedfiledefderef) + else + typedfiledef:=nil; + setsize; + end; + + + function tfiledef.getcopy : tstoreddef; + begin + case filetyp of + ft_typed: + result:=tfiledef.createtyped(typedfiledef); + ft_untyped: + result:=tfiledef.createuntyped; + ft_text: + result:=tfiledef.createtext; + else + internalerror(2004121201); + end; + end; + + + procedure tfiledef.buildderef; + begin + inherited buildderef; + if filetyp=ft_typed then + typedfiledefderef.build(typedfiledef); + end; + + + procedure tfiledef.deref; + begin + inherited deref; + if filetyp=ft_typed then + typedfiledef:=tdef(typedfiledefderef.resolve); + end; + + + procedure tfiledef.setsize; + begin +{$ifdef cpu64bitaddr} + case filetyp of + ft_text : + if target_info.system in [system_x86_64_win64,system_ia64_win64] then + savesize:=634{+8} + else + savesize:=630{+8}; + ft_typed, + ft_untyped : + if target_info.system in [system_x86_64_win64,system_ia64_win64] then + savesize:=372 + else + savesize:=368; + end; +{$endif cpu64bitaddr} +{$ifdef cpu32bitaddr} + case filetyp of + ft_text : + savesize:=594{+4}; + ft_typed, + ft_untyped : + savesize:=332; + end; +{$endif cpu32bitaddr} +{$ifdef cpu8bitaddr} + case filetyp of + ft_text : + savesize:=127; + ft_typed, + ft_untyped : + savesize:=127; + end; +{$endif cpu8bitaddr} + end; + + + procedure tfiledef.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putbyte(byte(filetyp)); + if filetyp=ft_typed then + ppufile.putderef(typedfiledefderef); + ppufile.writeentry(ibfiledef); + end; + + + function tfiledef.GetTypeName : string; + begin + case filetyp of + ft_untyped: + GetTypeName:='File'; + ft_typed: + GetTypeName:='File Of '+typedfiledef.typename; + ft_text: + GetTypeName:='Text' + end; + end; + + + function tfiledef.getmangledparaname : string; + begin + case filetyp of + ft_untyped: + getmangledparaname:='FILE'; + ft_typed: + getmangledparaname:='FILE$OF$'+typedfiledef.mangledparaname; + ft_text: + getmangledparaname:='TEXT' + end; + end; + + +{**************************************************************************** + TVARIANTDEF +****************************************************************************} + + constructor tvariantdef.create(v : tvarianttype); + begin + inherited create(variantdef); + varianttype:=v; + setsize; + end; + + + constructor tvariantdef.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(variantdef,ppufile); + varianttype:=tvarianttype(ppufile.getbyte); + setsize; + end; + + + function tvariantdef.getcopy : tstoreddef; + begin + result:=tvariantdef.create(varianttype); + end; + + + procedure tvariantdef.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putbyte(byte(varianttype)); + ppufile.writeentry(ibvariantdef); + end; + + + function tvariantdef.getvardef : longint; + begin + Result:=varVariant; + end; + + + procedure tvariantdef.setsize; + begin +{$ifdef cpu64bitaddr} + savesize:=24; +{$else cpu64bitaddr} + savesize:=16; +{$endif cpu64bitaddr} + end; + + + function tvariantdef.GetTypeName : string; + begin + case varianttype of + vt_normalvariant: + GetTypeName:='Variant'; + vt_olevariant: + GetTypeName:='OleVariant'; + end; + end; + + + function tvariantdef.needs_inittable : boolean; + begin + needs_inittable:=true; + end; + + + function tvariantdef.is_publishable : boolean; + begin + is_publishable:=true; + end; + + +{**************************************************************************** + TABSTRACtpointerdef +****************************************************************************} + + constructor tabstractpointerdef.create(dt:tdeftyp;def:tdef); + begin + inherited create(dt); + pointeddef:=def; + savesize:=sizeof(pint); + end; + + + constructor tabstractpointerdef.ppuload(dt:tdeftyp;ppufile:tcompilerppufile); + begin + inherited ppuload(dt,ppufile); + ppufile.getderef(pointeddefderef); + savesize:=sizeof(pint); + end; + + + procedure tabstractpointerdef.buildderef; + begin + inherited buildderef; + pointeddefderef.build(pointeddef); + end; + + + procedure tabstractpointerdef.deref; + begin + inherited deref; + pointeddef:=tdef(pointeddefderef.resolve); + end; + + + procedure tabstractpointerdef.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(pointeddefderef); + end; + + +{**************************************************************************** + tpointerdef +****************************************************************************} + + constructor tpointerdef.create(def:tdef); + begin + inherited create(pointerdef,def); + is_far:=false; + has_pointer_math:=cs_pointermath in current_settings.localswitches; + end; + + + constructor tpointerdef.createfar(def:tdef); + begin + inherited create(pointerdef,def); + is_far:=true; + has_pointer_math:=cs_pointermath in current_settings.localswitches; + end; + + + constructor tpointerdef.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(pointerdef,ppufile); + is_far:=(ppufile.getbyte<>0); + has_pointer_math:=(ppufile.getbyte<>0); + end; + + + function tpointerdef.getcopy : tstoreddef; + begin + { don't use direct pointeddef if it is a forwarddef because in other case + one of them will be destroyed on forward type resolve and the second will + point to garbage } + if pointeddef.typ=forwarddef then + result:=tpointerdef.create(tforwarddef(pointeddef).getcopy) + else + result:=tpointerdef.create(pointeddef); + tpointerdef(result).is_far:=is_far; + tpointerdef(result).has_pointer_math:=has_pointer_math; + tpointerdef(result).savesize:=savesize; + end; + + + procedure tpointerdef.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putbyte(byte(is_far)); + ppufile.putbyte(byte(has_pointer_math)); + ppufile.writeentry(ibpointerdef); + end; + + + function tpointerdef.GetTypeName : string; + begin + if is_far then + GetTypeName:='^'+pointeddef.typename+';far' + else + GetTypeName:='^'+pointeddef.typename; + end; + + +{**************************************************************************** + TCLASSREFDEF +****************************************************************************} + + constructor tclassrefdef.create(def:tdef); + begin + inherited create(classrefdef,def); + end; + + + constructor tclassrefdef.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(classrefdef,ppufile); + end; + + + procedure tclassrefdef.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.writeentry(ibclassrefdef); + end; + + + function tclassrefdef.getcopy:tstoreddef; + begin + if pointeddef.typ=forwarddef then + result:=tclassrefdef.create(tforwarddef(pointeddef).getcopy) + else + result:=tclassrefdef.create(pointeddef); + tclassrefdef(result).savesize:=savesize; + end; + + + function tclassrefdef.GetTypeName : string; + begin + GetTypeName:='Class Of '+pointeddef.typename; + end; + + + function tclassrefdef.is_publishable : boolean; + begin + result:=true; + end; + + + function tclassrefdef.rtti_mangledname(rt: trttitype): string; + begin + if (tobjectdef(pointeddef).objecttype<>odt_objcclass) then + result:=inherited rtti_mangledname(rt) + else + result:=tobjectdef(pointeddef).rtti_mangledname(objcmetartti); + end; + + + procedure tclassrefdef.register_created_object_type; + begin + tobjectdef(pointeddef).register_created_classref_type; + end; + +{*************************************************************************** + TSETDEF +***************************************************************************} + + constructor tsetdef.create(def:tdef;low, high : asizeint); + var + setallocbits: aint; + packedsavesize: aint; + begin + inherited create(setdef); + elementdef:=def; + setmax:=high; + if (current_settings.setalloc=0) then + begin + setbase:=0; + if (high<32) then + savesize:=Sizeof(longint) + else if (high<256) then + savesize:=32 + else + savesize:=(high+7) div 8 + end + else + begin + setallocbits:=current_settings.setalloc*8; + setbase:=low and not(setallocbits-1); + packedsavesize:=current_settings.setalloc*((((high+setallocbits)-setbase)) DIV setallocbits); + savesize:=packedsavesize; + if savesize=3 then + savesize:=4; + end; + end; + + + constructor tsetdef.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(setdef,ppufile); + ppufile.getderef(elementdefderef); + savesize:=ppufile.getaint; + setbase:=ppufile.getaint; + setmax:=ppufile.getaint; + end; + + + function tsetdef.getcopy : tstoreddef; + begin + result:=tsetdef.create(elementdef,setbase,setmax); + { the copy might have been created with a different setalloc setting } + tsetdef(result).savesize:=savesize; + end; + + + procedure tsetdef.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(elementdefderef); + ppufile.putaint(savesize); + ppufile.putaint(setbase); + ppufile.putaint(setmax); + ppufile.writeentry(ibsetdef); + end; + + + procedure tsetdef.buildderef; + begin + inherited buildderef; + elementdefderef.build(elementdef); + end; + + + procedure tsetdef.deref; + begin + inherited deref; + elementdef:=tdef(elementdefderef.resolve); + end; + + + function tsetdef.is_publishable : boolean; + begin + is_publishable:=savesize in [1,2,4]; + end; + + + function tsetdef.GetTypeName : string; + begin + if assigned(elementdef) then + GetTypeName:='Set Of '+elementdef.typename + else + GetTypeName:='Empty Set'; + end; + + +{*************************************************************************** + TFORMALDEF +***************************************************************************} + + constructor tformaldef.create(Atyped:boolean); + begin + inherited create(formaldef); + typed:=Atyped; + savesize:=0; + end; + + + constructor tformaldef.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(formaldef,ppufile); + typed:=boolean(ppufile.getbyte); + savesize:=0; + end; + + + procedure tformaldef.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putbyte(byte(typed)); + ppufile.writeentry(ibformaldef); + end; + + + function tformaldef.GetTypeName : string; + begin + if typed then + GetTypeName:='<Typed formal type>' + else + GetTypeName:='<Formal type>'; + end; + + +{*************************************************************************** + TARRAYDEF +***************************************************************************} + + constructor tarraydef.create(l,h:asizeint;def:tdef); + begin + inherited create(arraydef); + lowrange:=l; + highrange:=h; + rangedef:=def; + _elementdef:=nil; + arrayoptions:=[]; + symtable:=tarraysymtable.create(self); + end; + + destructor tarraydef.destroy; + begin + symtable.free; + symtable:=nil; + inherited; + end; + + constructor tarraydef.create_from_pointer(def:tdef); + begin + { use -1 so that the elecount will not overflow } + self.create(0,high(aint)-1,ptrsinttype); + arrayoptions:=[ado_IsConvertedPointer]; + setelementdef(def); + end; + + + constructor tarraydef.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(arraydef,ppufile); + { the addresses are calculated later } + ppufile.getderef(_elementdefderef); + ppufile.getderef(rangedefderef); + lowrange:=ppufile.getaint; + highrange:=ppufile.getaint; + ppufile.getsmallset(arrayoptions); + symtable:=tarraysymtable.create(self); + tarraysymtable(symtable).ppuload(ppufile) + end; + + + function tarraydef.getcopy : tstoreddef; + begin + result:=tarraydef.create(lowrange,highrange,rangedef); + tarraydef(result).arrayoptions:=arrayoptions; + tarraydef(result)._elementdef:=_elementdef; + end; + + + procedure tarraydef.buildderef; + begin + inherited buildderef; + tarraysymtable(symtable).buildderef; + _elementdefderef.build(_elementdef); + rangedefderef.build(rangedef); + end; + + + procedure tarraydef.deref; + begin + inherited deref; + tarraysymtable(symtable).deref; + _elementdef:=tdef(_elementdefderef.resolve); + rangedef:=tdef(rangedefderef.resolve); + end; + + + procedure tarraydef.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(_elementdefderef); + ppufile.putderef(rangedefderef); + ppufile.putaint(lowrange); + ppufile.putaint(highrange); + ppufile.putsmallset(arrayoptions); + ppufile.writeentry(ibarraydef); + tarraysymtable(symtable).ppuwrite(ppufile); + end; + + + function tarraydef.elesize : asizeint; + begin + if (ado_IsBitPacked in arrayoptions) then + internalerror(2006080101); + if assigned(_elementdef) then + result:=_elementdef.size + else + result:=0; + end; + + + function tarraydef.elepackedbitsize : asizeint; + begin + if not(ado_IsBitPacked in arrayoptions) then + internalerror(2006080102); + if assigned(_elementdef) then + result:=_elementdef.packedbitsize + else + result:=0; + end; + + + function tarraydef.elecount : asizeuint; + var + qhigh,qlow : qword; + begin + if ado_IsDynamicArray in arrayoptions then + begin + result:=0; + exit; + end; + if (highrange>0) and (lowrange<0) then + begin + qhigh:=highrange; + qlow:=qword(-lowrange); + { prevent overflow, return 0 to indicate overflow } + if qhigh+qlow>qword(high(asizeint)-1) then + result:=0 + else + result:=qhigh+qlow+1; + end + else + result:=int64(highrange)-lowrange+1; + end; + + + function tarraydef.size : asizeint; + var + cachedelecount : asizeuint; + cachedelesize : asizeint; + begin + if ado_IsDynamicArray in arrayoptions then + begin + size:=sizeof(pint); + exit; + end; + + { Tarraydef.size may never be called for an open array! } + if highrange<lowrange then + internalerror(99080501); + if not (ado_IsBitPacked in arrayoptions) then + cachedelesize:=elesize + else + cachedelesize := elepackedbitsize; + cachedelecount:=elecount; + + if (cachedelesize = 0) then + begin + size := 0; + exit; + end; + + if (cachedelecount = 0) then + begin + size := -1; + exit; + end; + + { prevent overflow, return -1 to indicate overflow } + { also make sure we don't need 64/128 bit arithmetic to calculate offsets } + if (cachedelecount > asizeuint(high(asizeint))) or + ((high(asizeint) div cachedelesize) < asizeint(cachedelecount)) or + { also lowrange*elesize must be < high(asizeint) to prevent overflow when + accessing the array, see ncgmem (PFV) } + ((high(asizeint) div cachedelesize) < abs(lowrange)) then + begin + result:=-1; + exit; + end; + + result:=cachedelesize*asizeint(cachedelecount); + if (ado_IsBitPacked in arrayoptions) then + { can't just add 7 and divide by 8, because that may overflow } + result:=result div 8 + ord((result mod 8)<>0); + end; + + + procedure tarraydef.setelementdef(def:tdef); + begin + _elementdef:=def; + if not( + (ado_IsDynamicArray in arrayoptions) or + (ado_IsConvertedPointer in arrayoptions) or + (highrange<lowrange) + ) and + (size=-1) then + Message(sym_e_segment_too_large); + end; + + + function tarraydef.alignment : shortint; + begin + { alignment of dyn. arrays doesn't depend on the element size } + if (ado_IsDynamicArray in arrayoptions) then + alignment:=size_2_align(sizeof(pint)) + { alignment is the alignment of the elements } + else if (elementdef.typ in [arraydef,recorddef,orddef,enumdef,floatdef]) or + ((elementdef.typ=objectdef) and + is_object(elementdef)) then + alignment:=elementdef.alignment + { alignment is the size of the elements } + else if not (ado_IsBitPacked in arrayoptions) then + alignment:=size_2_align(elesize) + else + alignment:=packedbitsloadsize(elepackedbitsize); + end; + + + function tarraydef.needs_inittable : boolean; + begin + needs_inittable:=(ado_IsDynamicArray in arrayoptions) or elementdef.needs_inittable; + end; + + + function tarraydef.GetTypeName : string; + begin + if (ado_IsConstString in arrayoptions) then + result:='Constant String' + else if (ado_isarrayofconst in arrayoptions) or + (ado_isConstructor in arrayoptions) then + begin + if (ado_isvariant in arrayoptions) or ((highrange=-1) and (lowrange=0)) then + GetTypeName:='Array Of Const' + else + GetTypeName:='Array Of Const/Constant Open Array of '+elementdef.typename; + end + else if (ado_IsDynamicArray in arrayoptions) then + GetTypeName:='Dynamic Array Of '+elementdef.typename + else if ((highrange=-1) and (lowrange=0)) then + GetTypeName:='Open Array Of '+elementdef.typename + else + begin + result := ''; + if (ado_IsBitPacked in arrayoptions) then + result:='Packed '; + if rangedef.typ=enumdef then + result:=result+'Array['+rangedef.typename+'] Of '+elementdef.typename + else + result:=result+'Array['+tostr(lowrange)+'..'+ + tostr(highrange)+'] Of '+elementdef.typename + end; + end; + + + function tarraydef.getmangledparaname : string; + begin + if ado_isarrayofconst in arrayoptions then + getmangledparaname:='array_of_const' + else + if ((highrange=-1) and (lowrange=0)) then + getmangledparaname:='array_of_'+elementdef.mangledparaname + else + internalerror(200204176); + end; + + + function tarraydef.is_publishable : boolean; + begin + Result:=ado_IsDynamicArray in arrayoptions; + end; + +{*************************************************************************** + tabstractrecorddef +***************************************************************************} + + constructor tabstractrecorddef.create(const n:string; dt:tdeftyp); + begin + inherited create(dt); + objname:=stringdup(upper(n)); + objrealname:=stringdup(n); + objectoptions:=[]; + end; + + constructor tabstractrecorddef.ppuload(dt:tdeftyp;ppufile:tcompilerppufile); + begin + inherited ppuload(dt,ppufile); + objrealname:=stringdup(ppufile.getstring); + objname:=stringdup(upper(objrealname^)); + ppufile.getsmallset(objectoptions); + end; + + procedure tabstractrecorddef.ppuwrite(ppufile: tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putstring(objrealname^); + ppufile.putsmallset(objectoptions); + end; + + destructor tabstractrecorddef.destroy; + begin + stringdispose(objname); + stringdispose(objrealname); + inherited destroy; + end; + + procedure tabstractrecorddef.check_forwards; + begin + tstoredsymtable(symtable).check_forwards; + end; + + function tabstractrecorddef.find_procdef_bytype(pt:tproctypeoption): tprocdef; + var + i: longint; + sym: tsym; + begin + for i:=0 to symtable.SymList.Count-1 do + begin + sym:=tsym(symtable.SymList[i]); + if sym.typ=procsym then + begin + result:=tprocsym(sym).find_procdef_bytype(pt); + if assigned(result) then + exit; + end; + end; + result:=nil; + end; + + function tabstractrecorddef.GetSymtable(t:tGetSymtable):TSymtable; + begin + if t=gs_record then + GetSymtable:=symtable + else + GetSymtable:=nil; + end; + + + function tabstractrecorddef.is_packed:boolean; + begin + result:=tabstractrecordsymtable(symtable).is_packed; + end; + + function tabstractrecorddef.RttiName: string; + begin + Result:=OwnerHierarchyName+objrealname^; + end; + + function tabstractrecorddef.search_enumerator_get: tprocdef; + var + sym : tsym; + i : integer; + pd : tprocdef; + hashedid : THashedIDString; + begin + result:=nil; + hashedid.id:='GETENUMERATOR'; + sym:=tsym(symtable.FindWithHash(hashedid)); + if assigned(sym) and (sym.typ=procsym) then + begin + for i := 0 to Tprocsym(sym).ProcdefList.Count - 1 do + begin + pd := tprocdef(Tprocsym(sym).ProcdefList[i]); + if (pd.proctypeoption = potype_function) and + (is_class_or_interface_or_object(pd.returndef) or is_record(pd.returndef)) and + (pd.visibility >= vis_public) then + begin + result:=pd; + exit; + end; + end; + end; + end; + + function tabstractrecorddef.search_enumerator_move: tprocdef; + var + sym : tsym; + i : integer; + pd : tprocdef; + hashedid : THashedIDString; + begin + result:=nil; + // first search for po_enumerator_movenext method modifier + // then search for public function MoveNext: Boolean + for i:=0 to symtable.SymList.Count-1 do + begin + sym:=TSym(symtable.SymList[i]); + if (sym.typ=procsym) then + begin + pd:=Tprocsym(sym).find_procdef_byoptions([po_enumerator_movenext]); + if assigned(pd) then + begin + result:=pd; + exit; + end; + end; + end; + hashedid.id:='MOVENEXT'; + sym:=tsym(symtable.FindWithHash(hashedid)); + if assigned(sym) and (sym.typ=procsym) then + begin + for i:=0 to Tprocsym(sym).ProcdefList.Count-1 do + begin + pd := tprocdef(Tprocsym(sym).ProcdefList[i]); + if (pd.proctypeoption = potype_function) and + is_boolean(pd.returndef) and + (pd.minparacount = 0) and + (pd.visibility >= vis_public) then + begin + result:=pd; + exit; + end; + end; + end; + end; + + function tabstractrecorddef.search_enumerator_current: tsym; + var + sym: tsym; + i: integer; + hashedid : THashedIDString; + begin + result:=nil; + // first search for ppo_enumerator_current property modifier + // then search for public property Current + for i:=0 to symtable.SymList.Count-1 do + begin + sym:=TSym(symtable.SymList[i]); + if (sym.typ=propertysym) and (ppo_enumerator_current in tpropertysym(sym).propoptions) then + begin + result:=sym; + exit; + end; + end; + hashedid.id:='CURRENT'; + sym:=tsym(symtable.FindWithHash(hashedid)); + if assigned(sym) and (sym.typ=propertysym) and + (sym.visibility >= vis_public) and not tpropertysym(sym).propaccesslist[palt_read].empty then + begin + result:=sym; + exit; + end; + end; + +{*************************************************************************** + trecorddef +***************************************************************************} + + constructor trecorddef.create(const n:string; p:TSymtable); + begin + inherited create(n,recorddef); + symtable:=p; + { we can own the symtable only if nobody else owns a copy so far } + if symtable.refcount=1 then + symtable.defowner:=self; + isunion:=false; + end; + + + constructor trecorddef.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(recorddef,ppufile); + if df_copied_def in defoptions then + ppufile.getderef(cloneddefderef) + else + begin + symtable:=trecordsymtable.create(objrealname^,0); + trecordsymtable(symtable).fieldalignment:=shortint(ppufile.getbyte); + trecordsymtable(symtable).recordalignment:=shortint(ppufile.getbyte); + trecordsymtable(symtable).padalignment:=shortint(ppufile.getbyte); + trecordsymtable(symtable).usefieldalignment:=shortint(ppufile.getbyte); + trecordsymtable(symtable).datasize:=ppufile.getasizeint; + trecordsymtable(symtable).paddingsize:=ppufile.getword; + trecordsymtable(symtable).ppuload(ppufile); + { requires usefieldalignment to be set } + symtable.defowner:=self; + end; + isunion:=false; + end; + + + destructor trecorddef.destroy; + begin + if assigned(symtable) then + begin + symtable.free; + symtable:=nil; + end; + inherited destroy; + end; + + + function trecorddef.getcopy : tstoreddef; + begin + result:=trecorddef.create(objrealname^,symtable.getcopy); + trecorddef(result).isunion:=isunion; + include(trecorddef(result).defoptions,df_copied_def); + end; + + + function trecorddef.needs_inittable : boolean; + begin + needs_inittable:=trecordsymtable(symtable).needs_init_final + end; + + + procedure trecorddef.buildderef; + begin + inherited buildderef; + if df_copied_def in defoptions then + cloneddefderef.build(symtable.defowner) + else + tstoredsymtable(symtable).buildderef; + end; + + + procedure trecorddef.deref; + begin + inherited deref; + { now dereference the definitions } + if df_copied_def in defoptions then + begin + cloneddef:=trecorddef(cloneddefderef.resolve); + symtable:=cloneddef.symtable.getcopy; + end + else + tstoredsymtable(symtable).deref; + + { assign TGUID? load only from system unit } + if not(assigned(rec_tguid)) and + (upper(typename)='TGUID') and + assigned(owner) and + assigned(owner.name) and + (owner.name^='SYSTEM') then + rec_tguid:=self; + + { assign JMP_BUF? load only from system unit } + if not(assigned(rec_jmp_buf)) and + (upper(typename)='JMP_BUF') and + assigned(owner) and + assigned(owner.name) and + (owner.name^='SYSTEM') then + rec_jmp_buf:=self; + end; + + + procedure trecorddef.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + if df_copied_def in defoptions then + ppufile.putderef(cloneddefderef) + else + begin + ppufile.putbyte(byte(trecordsymtable(symtable).fieldalignment)); + ppufile.putbyte(byte(trecordsymtable(symtable).recordalignment)); + ppufile.putbyte(byte(trecordsymtable(symtable).padalignment)); + ppufile.putbyte(byte(trecordsymtable(symtable).usefieldalignment)); + ppufile.putasizeint(trecordsymtable(symtable).datasize); + ppufile.putword(trecordsymtable(symtable).paddingsize); + end; + + ppufile.writeentry(ibrecorddef); + + if not(df_copied_def in defoptions) then + trecordsymtable(symtable).ppuwrite(ppufile); + end; + + + function trecorddef.size:asizeint; + begin + result:=trecordsymtable(symtable).datasize; + end; + + + function trecorddef.alignment:shortint; + begin + alignment:=trecordsymtable(symtable).recordalignment; + end; + + + function trecorddef.padalignment:shortint; + begin + padalignment := trecordsymtable(symtable).padalignment; + end; + + + function trecorddef.GetTypeName : string; + begin + GetTypeName:='<record type>' + end; + + +{*************************************************************************** + TABSTRACTPROCDEF +***************************************************************************} + + constructor tabstractprocdef.create(dt:tdeftyp;level:byte); + begin + inherited create(dt); + parast:=tparasymtable.create(self,level); + paras:=nil; + minparacount:=0; + maxparacount:=0; + proctypeoption:=potype_none; + proccalloption:=pocall_none; + procoptions:=[]; + returndef:=voidtype; + savesize:=sizeof(pint); + callerargareasize:=0; + calleeargareasize:=0; + has_paraloc_info:=callnoside; + funcretloc[callerside].init; + funcretloc[calleeside].init; + check_mark_as_nested; + end; + + + destructor tabstractprocdef.destroy; + begin + if assigned(paras) then + begin +{$ifdef MEMDEBUG} + memprocpara.start; +{$endif MEMDEBUG} + paras.free; + paras:=nil; +{$ifdef MEMDEBUG} + memprocpara.stop; +{$endif MEMDEBUG} + end; + if assigned(parast) then + begin +{$ifdef MEMDEBUG} + memprocparast.start; +{$endif MEMDEBUG} + parast.free; + parast:=nil; +{$ifdef MEMDEBUG} + memprocparast.stop; +{$endif MEMDEBUG} + end; + funcretloc[callerside].done; + funcretloc[calleeside].done; + inherited destroy; + end; + + + procedure tabstractprocdef.count_para(p:TObject;arg:pointer); + begin + if (tsym(p).typ<>paravarsym) then + exit; + inc(plongint(arg)^); + if not(vo_is_hidden_para in tparavarsym(p).varoptions) then + begin + if not assigned(tparavarsym(p).defaultconstsym) then + inc(minparacount); + inc(maxparacount); + end; + end; + + + procedure tabstractprocdef.insert_para(p:TObject;arg:pointer); + begin + if (tsym(p).typ<>paravarsym) then + exit; + paras.add(p); + end; + + + procedure tabstractprocdef.calcparas; + var + paracount : longint; + begin + { This can already be assigned when + we need to reresolve this unit (PFV) } + if assigned(paras) then + paras.free; + paras:=tparalist.create(false); + paracount:=0; + minparacount:=0; + maxparacount:=0; + parast.SymList.ForEachCall(@count_para,@paracount); + paras.capacity:=paracount; + { Insert parameters in table } + parast.SymList.ForEachCall(@insert_para,nil); + { Order parameters } + paras.sortparas; + end; + + + procedure tabstractprocdef.buildderef; + begin + { released procdef? } + if not assigned(parast) then + exit; + inherited buildderef; + returndefderef.build(returndef); + { parast } + tparasymtable(parast).buildderef; + end; + + + procedure tabstractprocdef.deref; + begin + inherited deref; + returndef:=tdef(returndefderef.resolve); + { parast } + tparasymtable(parast).deref; + { recalculated parameters } + calcparas; + end; + + + constructor tabstractprocdef.ppuload(dt:tdeftyp;ppufile:tcompilerppufile); + begin + inherited ppuload(dt,ppufile); + parast:=nil; + Paras:=nil; + minparacount:=0; + maxparacount:=0; + ppufile.getderef(returndefderef); +{ TODO: remove fpu_used loading} + ppufile.getbyte; + proctypeoption:=tproctypeoption(ppufile.getbyte); + proccalloption:=tproccalloption(ppufile.getbyte); + ppufile.getnormalset(procoptions); + + funcretloc[callerside].init; + if po_explicitparaloc in procoptions then + funcretloc[callerside].ppuload(ppufile); + + savesize:=sizeof(pint); + if (po_explicitparaloc in procoptions) then + has_paraloc_info:=callerside; + end; + + + procedure tabstractprocdef.ppuwrite(ppufile:tcompilerppufile); + var + oldintfcrc : boolean; + begin + { released procdef? } + if not assigned(parast) then + exit; + inherited ppuwrite(ppufile); + ppufile.putderef(returndefderef); + oldintfcrc:=ppufile.do_interface_crc; + ppufile.do_interface_crc:=false; + ppufile.putbyte(0); + ppufile.putbyte(ord(proctypeoption)); + ppufile.putbyte(ord(proccalloption)); + ppufile.putnormalset(procoptions); + ppufile.do_interface_crc:=oldintfcrc; + + if (po_explicitparaloc in procoptions) then + funcretloc[callerside].ppuwrite(ppufile); + end; + + + function tabstractprocdef.typename_paras(showhidden:boolean) : string; + var + hs,s : string; + hp : TParavarsym; + hpc : tconstsym; + first : boolean; + i : integer; + begin + s:=''; + first:=true; + for i:=0 to paras.count-1 do + begin + hp:=tparavarsym(paras[i]); + if not(vo_is_hidden_para in hp.varoptions) or + (showhidden) then + begin + if first then + begin + s:=s+'('; + first:=false; + end + else + s:=s+','; + if vo_is_hidden_para in hp.varoptions then + s:=s+'<'; + case hp.varspez of + vs_var : + s:=s+'var '; + vs_const : + s:=s+'const '; + vs_out : + s:=s+'out '; + vs_constref : + s:=s+'constref '; + end; + if hp.univpara then + s:=s+'univ '; + if assigned(hp.vardef.typesym) then + begin + hs:=hp.vardef.typesym.realname; + if hs[1]<>'$' then + s:=s+hs + else + s:=s+hp.vardef.GetTypeName; + end + else + s:=s+hp.vardef.GetTypeName; + { default value } + if assigned(hp.defaultconstsym) then + begin + hpc:=tconstsym(hp.defaultconstsym); + hs:=''; + case hpc.consttyp of + conststring, + constresourcestring : + begin + If hpc.value.len>0 then + begin + setLength(hs,hpc.value.len); + { don't write past the end of hs if the constant + is > 255 chars } + move(hpc.value.valueptr^,hs[1],length(hs)); + { make sure that constant strings with newline chars + don't create a linebreak in the assembler code, + since comments are line-based. Also remove nulls + because the comments are written as a pchar. } + ReplaceCase(hs,#0,'.'); + ReplaceCase(hs,#10,'.'); + ReplaceCase(hs,#13,'.'); + end; + end; + constreal : + str(pbestreal(hpc.value.valueptr)^,hs); + constpointer : + hs:=tostr(hpc.value.valueordptr); + constord : + begin + if is_boolean(hpc.constdef) then + begin + if hpc.value.valueord<>0 then + hs:='TRUE' + else + hs:='FALSE'; + end + else + hs:=tostr(hpc.value.valueord); + end; + constnil : + hs:='nil'; + constset : + hs:='<set>'; + end; + if hs<>'' then + s:=s+'="'+hs+'"'; + end; + if vo_is_hidden_para in hp.varoptions then + s:=s+'>'; + end; + end; + if not first then + s:=s+')'; + if (po_varargs in procoptions) then + s:=s+';VarArgs'; + typename_paras:=s; + end; + + + function tabstractprocdef.is_methodpointer:boolean; + begin + result:=false; + end; + + + function tabstractprocdef.is_addressonly:boolean; + begin + result:=true; + end; + + function tabstractprocdef.no_self_node: boolean; + begin + Result:=([po_staticmethod,po_classmethod]<=procoptions)or + (proctypeoption in [potype_class_constructor,potype_class_destructor,potype_operator]); + end; + + + procedure tabstractprocdef.check_mark_as_nested; + begin + { nested procvars require that nested functions use the Delphi-style + nested procedure calling convention } + if (parast.symtablelevel>normal_function_level) and + (m_nested_procvars in current_settings.modeswitches) then + include(procoptions,po_delphi_nested_cc); + end; + + + procedure tabstractprocdef.init_paraloc_info(side: tcallercallee); + begin + if (side in [callerside,callbothsides]) and + not(has_paraloc_info in [callerside,callbothsides]) then + begin + callerargareasize:=paramanager.create_paraloc_info(self,callerside); + if has_paraloc_info in [calleeside,callbothsides] then + has_paraloc_info:=callbothsides + else + has_paraloc_info:=callerside; + end; + if (side in [calleeside,callbothsides]) and + not(has_paraloc_info in [calleeside,callbothsides]) then + begin + calleeargareasize:=paramanager.create_paraloc_info(self,calleeside); + if has_paraloc_info in [callerside,callbothsides] then + has_paraloc_info:=callbothsides + else + has_paraloc_info:=calleeside; + end; + end; + + + function tabstractprocdef.stack_tainting_parameter(side: tcallercallee): boolean; + var + p: tparavarsym; + ploc: PCGParalocation; + i: longint; + begin + result:=false; + init_paraloc_info(side); + for i:=0 to parast.SymList.Count-1 do + if tsym(parast.SymList[i]).typ=paravarsym then + begin + p:=tparavarsym(parast.SymList[i]); + { check if no parameter is located on the stack } + if is_open_array(p.vardef) or + is_array_of_const(p.vardef) then + begin + result:=true; + exit; + end; + ploc:=p.paraloc[side].location; + while assigned(ploc) do + begin + if (ploc^.loc=LOC_REFERENCE) then + begin + result:=true; + exit + end; + ploc:=ploc^.next; + end; + end; + end; + + + + +{*************************************************************************** + TPROCDEF +***************************************************************************} + + constructor tprocdef.create(level:byte); + begin + inherited create(procdef,level); + localst:=tlocalsymtable.create(self,parast.symtablelevel); + _mangledname:=nil; + fileinfo:=current_filepos; + extnumber:=$ffff; + aliasnames:=TCmdStrList.create; + funcretsym:=nil; + forwarddef:=true; + interfacedef:=false; + hasforward:=false; + struct := nil; + import_dll:=nil; + import_name:=nil; + import_nr:=0; + inlininginfo:=nil; + deprecatedmsg:=nil; +{$ifdef i386} + fpu_used:=maxfpuregs; +{$endif i386} + interruptvector:=-1; + end; + + + constructor tprocdef.ppuload(ppufile:tcompilerppufile); + var + i,aliasnamescount : longint; + level : byte; + begin + inherited ppuload(procdef,ppufile); + if po_has_mangledname in procoptions then + _mangledname:=stringdup(ppufile.getstring) + else + _mangledname:=nil; + extnumber:=ppufile.getword; + level:=ppufile.getbyte; + ppufile.getderef(structderef); + ppufile.getderef(procsymderef); + ppufile.getposinfo(fileinfo); + visibility:=tvisibility(ppufile.getbyte); + ppufile.getsmallset(symoptions); + if sp_has_deprecated_msg in symoptions then + deprecatedmsg:=stringdup(ppufile.getstring) + else + deprecatedmsg:=nil; +{$ifdef powerpc} + { library symbol for AmigaOS/MorphOS } + ppufile.getderef(libsymderef); +{$endif powerpc} + { import stuff } + if po_has_importdll in procoptions then + import_dll:=stringdup(ppufile.getstring) + else + import_dll:=nil; + if po_has_importname in procoptions then + import_name:=stringdup(ppufile.getstring) + else + import_name:=nil; + import_nr:=ppufile.getword; +{$ifdef FPC_HAS_SYSTEMS_INTERRUPT_TABLE} + if target_info.system in systems_interrupt_table then + interruptvector:=ppufile.getlongint; +{$endif FPC_HAS_SYSTEMS_INTERRUPT_TABLE} + if (po_msgint in procoptions) then + messageinf.i:=ppufile.getlongint; + if (po_msgstr in procoptions) then + messageinf.str:=stringdup(ppufile.getstring); + if (po_dispid in procoptions) then + dispid:=ppufile.getlongint; + { inline stuff } + if (po_has_inlininginfo in procoptions) then + begin + ppufile.getderef(funcretsymderef); + new(inlininginfo); + ppufile.getsmallset(inlininginfo^.flags); + end + else + begin + inlininginfo:=nil; + funcretsym:=nil; + end; + + aliasnames:=TCmdStrList.create; + { count alias names } + aliasnamescount:=ppufile.getbyte; + for i:=1 to aliasnamescount do + aliasnames.insert(ppufile.getstring); + + { load para symtable } + parast:=tparasymtable.create(self,level); + tparasymtable(parast).ppuload(ppufile); + { load local symtable } + if (po_has_inlininginfo in procoptions) then + begin + localst:=tlocalsymtable.create(self,level); + tlocalsymtable(localst).ppuload(ppufile); + end + else + localst:=nil; + { inline stuff } + if (po_has_inlininginfo in procoptions) then + inlininginfo^.code:=ppuloadnodetree(ppufile); + { default values for no persistent data } + if (cs_link_deffile in current_settings.globalswitches) and + (tf_need_export in target_info.flags) and + (po_exports in procoptions) then + deffile.AddExport(mangledname); + forwarddef:=false; + interfacedef:=false; + hasforward:=false; + { Disable po_has_inlining until the derefimpl is done } + exclude(procoptions,po_has_inlininginfo); +{$ifdef i386} + fpu_used:=maxfpuregs; +{$endif i386} + end; + + + destructor tprocdef.destroy; + begin + aliasnames.free; + aliasnames:=nil; + if assigned(localst) and + (localst.symtabletype<>staticsymtable) then + begin +{$ifdef MEMDEBUG} + memproclocalst.start; +{$endif MEMDEBUG} + localst.free; + localst:=nil; +{$ifdef MEMDEBUG} + memproclocalst.start; +{$endif MEMDEBUG} + end; + if assigned(inlininginfo) then + begin +{$ifdef MEMDEBUG} + memprocnodetree.start; +{$endif MEMDEBUG} + tnode(inlininginfo^.code).free; +{$ifdef MEMDEBUG} + memprocnodetree.start; +{$endif MEMDEBUG} + dispose(inlininginfo); + inlininginfo:=nil; + end; + stringdispose(resultname); + stringdispose(import_dll); + stringdispose(import_name); + stringdispose(deprecatedmsg); + if (po_msgstr in procoptions) then + stringdispose(messageinf.str); + if assigned(_mangledname) then + begin +{$ifdef MEMDEBUG} + memmanglednames.start; +{$endif MEMDEBUG} + stringdispose(_mangledname); +{$ifdef MEMDEBUG} + memmanglednames.stop; +{$endif MEMDEBUG} + end; + inherited destroy; + end; + + + procedure tprocdef.ppuwrite(ppufile:tcompilerppufile); + var + oldintfcrc : boolean; + aliasnamescount : longint; + item : TCmdStrListItem; + begin + { released procdef? } + if not assigned(parast) then + exit; + + inherited ppuwrite(ppufile); + if po_has_mangledname in procoptions then + ppufile.putstring(_mangledname^); + + ppufile.putword(extnumber); + ppufile.putbyte(parast.symtablelevel); + ppufile.putderef(structderef); + ppufile.putderef(procsymderef); + ppufile.putposinfo(fileinfo); + ppufile.putbyte(byte(visibility)); + ppufile.putsmallset(symoptions); + if sp_has_deprecated_msg in symoptions then + ppufile.putstring(deprecatedmsg^); +{$ifdef powerpc} + { library symbol for AmigaOS/MorphOS } + ppufile.putderef(libsymderef); +{$endif powerpc} + { import } + if po_has_importdll in procoptions then + ppufile.putstring(import_dll^); + if po_has_importname in procoptions then + ppufile.putstring(import_name^); + ppufile.putword(import_nr); +{$ifdef FPC_HAS_SYSTEMS_INTERRUPT_TABLE} + if target_info.system in systems_interrupt_table then + ppufile.putlongint(interruptvector); +{$endif FPC_HAS_SYSTEMS_INTERRUPT_TABLE} + if (po_msgint in procoptions) then + ppufile.putlongint(messageinf.i); + if (po_msgstr in procoptions) then + ppufile.putstring(messageinf.str^); + if (po_dispid in procoptions) then + ppufile.putlongint(dispid); + { inline stuff } + oldintfcrc:=ppufile.do_crc; + ppufile.do_crc:=false; + if (po_has_inlininginfo in procoptions) then + begin + ppufile.putderef(funcretsymderef); + ppufile.putsmallset(inlininginfo^.flags); + end; + + { count alias names } + aliasnamescount:=0; + item:=TCmdStrListItem(aliasnames.first); + while assigned(item) do + begin + inc(aliasnamescount); + item:=TCmdStrListItem(item.next); + end; + if aliasnamescount>255 then + internalerror(200711021); + ppufile.putbyte(aliasnamescount); + item:=TCmdStrListItem(aliasnames.first); + while assigned(item) do + begin + ppufile.putstring(item.str); + item:=TCmdStrListItem(item.next); + end; + + ppufile.do_crc:=oldintfcrc; + + { write this entry } + ppufile.writeentry(ibprocdef); + + { Save the para symtable, this is taken from the interface } + tparasymtable(parast).ppuwrite(ppufile); + + { save localsymtable for inline procedures or when local + browser info is requested, this has no influence on the crc } + if (po_has_inlininginfo in procoptions) then + begin + oldintfcrc:=ppufile.do_crc; + ppufile.do_crc:=false; + tlocalsymtable(localst).ppuwrite(ppufile); + ppufile.do_crc:=oldintfcrc; + end; + + { node tree for inlining } + oldintfcrc:=ppufile.do_crc; + ppufile.do_crc:=false; + if (po_has_inlininginfo in procoptions) then + ppuwritenodetree(ppufile,inlininginfo^.code); + ppufile.do_crc:=oldintfcrc; + end; + + + function tprocdef.fullprocname(showhidden:boolean):string; + var + s : string; + t : ttoken; + begin +{$ifdef EXTDEBUG} + showhidden:=true; +{$endif EXTDEBUG} + s:=''; + if assigned(struct) then + begin + s:=struct.RttiName+'.'; + if (po_classmethod in procoptions) and + not (proctypeoption in [potype_class_constructor,potype_class_destructor]) then + s:='class ' + s; + end; + if proctypeoption=potype_operator then + begin + for t:=NOTOKEN to last_overloaded do + if procsym.realname='$'+overloaded_names[t] then + begin + s:='operator '+arraytokeninfo[t].str+typename_paras(showhidden); + break; + end; + end + else + s:=s+procsym.realname+typename_paras(showhidden); + case proctypeoption of + potype_constructor: + s:='constructor '+s; + potype_destructor: + s:='destructor '+s; + potype_class_constructor: + s:='class constructor '+s; + potype_class_destructor: + s:='class destructor '+s; + else + if assigned(returndef) and + not(is_void(returndef)) then + s:=s+':'+returndef.GetTypeName; + end; + if owner.symtabletype=localsymtable then + s:=s+' is nested'; + s:=s+';'; + { forced calling convention? } + if (po_hascallingconvention in procoptions) then + s:=s+' '+ProcCallOptionStr[proccalloption]+';'; + if (po_staticmethod in procoptions) and + not (proctypeoption in [potype_class_constructor,potype_class_destructor]) then + s:=s+' Static;'; + fullprocname:=s; + end; + + + function tprocdef.is_methodpointer:boolean; + begin + { don't check assigned(_class), that's also the case for nested + procedures inside methods } + result:=owner.symtabletype=ObjectSymtable; + end; + + + function tprocdef.is_addressonly:boolean; + begin + result:=assigned(owner) and + (owner.symtabletype<>ObjectSymtable) and + (not(m_nested_procvars in current_settings.modeswitches) or + not is_nested_pd(self)); + end; + + + procedure tprocdef.make_external; + begin + include(procoptions,po_external); + forwarddef:=false; + end; + + + function tprocdef.GetSymtable(t:tGetSymtable):TSymtable; + begin + case t of + gs_local : + GetSymtable:=localst; + gs_para : + GetSymtable:=parast; + else + GetSymtable:=nil; + end; + end; + + + procedure tprocdef.buildderef; + begin + inherited buildderef; + structderef.build(struct); + { procsym that originaly defined this definition, should be in the + same symtable } + procsymderef.build(procsym); +{$ifdef powerpc} + { library symbol for AmigaOS/MorphOS } + libsymderef.build(libsym); +{$endif powerpc} + end; + + + procedure tprocdef.buildderefimpl; + begin + inherited buildderefimpl; + + { Localst is not available for main/unit init } + if assigned(localst) then + begin + tlocalsymtable(localst).buildderef; + tlocalsymtable(localst).buildderefimpl; + end; + + { inline tree } + if (po_has_inlininginfo in procoptions) then + begin + funcretsymderef.build(funcretsym); + inlininginfo^.code.buildderefimpl; + end; + end; + + + procedure tprocdef.deref; + begin + inherited deref; + struct:=tabstractrecorddef(structderef.resolve); + { procsym that originaly defined this definition, should be in the + same symtable } + procsym:=tprocsym(procsymderef.resolve); +{$ifdef powerpc} + { library symbol for AmigaOS/MorphOS } + libsym:=tsym(libsymderef.resolve); +{$endif powerpc} + end; + + + procedure tprocdef.derefimpl; + begin + { Enable has_inlininginfo when the inlininginfo + structure is available. The has_inlininginfo was disabled + after the load, since the data was invalid } + if assigned(inlininginfo) then + include(procoptions,po_has_inlininginfo); + + { Locals } + if assigned(localst) then + begin + tlocalsymtable(localst).deref; + tlocalsymtable(localst).derefimpl; + end; + + { Inline } + if (po_has_inlininginfo in procoptions) then + begin + inlininginfo^.code.derefimpl; + { funcretsym, this is always located in the localst } + funcretsym:=tsym(funcretsymderef.resolve); + end + else + begin + { safety } + { Not safe! A unit may be reresolved after its interface has been + parsed but before its implementation has been parsed, and in that + case the funcretsym is still required! + funcretsym:=nil; } + end; + end; + + + function tprocdef.GetTypeName : string; + begin + GetTypeName := FullProcName(false); + end; + + + function tprocdef.mangledname : string; + var + hp : TParavarsym; + hs : string; + crc : dword; + newlen, + oldlen, + i : integer; + begin + if assigned(_mangledname) then + begin + {$ifdef compress} + mangledname:=minilzw_decode(_mangledname^); + {$else} + mangledname:=_mangledname^; + {$endif} + exit; + end; + { we need to use the symtable where the procsym is inserted, + because that is visible to the world } + mangledname:=make_mangledname('',procsym.owner,procsym.name); + oldlen:=length(mangledname); + { add parameter types } + for i:=0 to paras.count-1 do + begin + hp:=tparavarsym(paras[i]); + if not(vo_is_hidden_para in hp.varoptions) then + mangledname:=mangledname+'$'+hp.vardef.mangledparaname; + end; + { add resultdef, add $$ as separator to make it unique from a + parameter separator } + if not is_void(returndef) then + mangledname:=mangledname+'$$'+returndef.mangledparaname; + newlen:=length(mangledname); + { Replace with CRC if the parameter line is very long } + if (newlen-oldlen>12) and + ((newlen>100) or (newlen-oldlen>64)) then + begin + crc:=0; + for i:=0 to paras.count-1 do + begin + hp:=tparavarsym(paras[i]); + if not(vo_is_hidden_para in hp.varoptions) then + begin + hs:=hp.vardef.mangledparaname; + crc:=UpdateCrc32(crc,hs[1],length(hs)); + end; + end; + hs:=hp.vardef.mangledparaname; + crc:=UpdateCrc32(crc,hs[1],length(hs)); + mangledname:=Copy(mangledname,1,oldlen)+'$crc'+hexstr(crc,8); + end; + {$ifdef compress} + _mangledname:=stringdup(minilzw_encode(mangledname)); + {$else} + _mangledname:=stringdup(mangledname); + {$endif} + end; + + + function tprocdef.cplusplusmangledname : string; + + function getcppparaname(p : tdef) : string; + + const +{$ifdef NAMEMANGLING_GCC2} + ordtype2str : array[tordtype] of string[2] = ( + '', + 'Uc','Us','Ui','Us', + 'Sc','s','i','x', + 'b','b','b','b','b', + 'c','w','x'); +{$else NAMEMANGLING_GCC2} + ordtype2str : array[tordtype] of string[1] = ( + 'v', + 'h','t','j','y', + 'a','s','i','x', + 'b','b','b','b', + 'b','b','b','b', + 'c','w','x'); + + floattype2str : array[tfloattype] of string[1] = ( + 'f','d','e','e', + 'd','d','g'); +{$endif NAMEMANGLING_GCC2} + + var + s : string; + + begin + case p.typ of + orddef: + s:=ordtype2str[torddef(p).ordtype]; + pointerdef: + s:='P'+getcppparaname(tpointerdef(p).pointeddef); +{$ifndef NAMEMANGLING_GCC2} + floatdef: + s:=floattype2str[tfloatdef(p).floattype]; +{$endif NAMEMANGLING_GCC2} + else + internalerror(2103001); + end; + getcppparaname:=s; + end; + + var + s,s2 : string; + hp : TParavarsym; + i : integer; + + begin +{$ifdef NAMEMANGLING_GCC2} + + { outdated gcc 2.x name mangling scheme } + s := procsym.realname; + if procsym.owner.symtabletype=ObjectSymtable then + begin + s2:=upper(tobjectdef(procsym.owner.defowner).objrealname^); + case proctypeoption of + potype_destructor: + s:='_$_'+tostr(length(s2))+s2; + potype_constructor: + s:='___'+tostr(length(s2))+s2; + else + s:='_'+s+'__'+tostr(length(s2))+s2; + end; + + end + else s:=s+'__'; + + s:=s+'F'; + + { concat modifiers } + { !!!!! } + + { now we handle the parameters } + if maxparacount>0 then + begin + for i:=0 to paras.count-1 do + begin + hp:=tparavarsym(paras[i]); + { no hidden parameters form part of a C++ mangled name: + a) self is not included + b) there are no "high" or other hidden parameters + } + if vo_is_hidden_para in hp.varoptions then + continue; + s2:=getcppparaname(hp.vardef); + if hp.varspez in [vs_var,vs_out] then + s2:='R'+s2; + s:=s+s2; + end; + end + else + s:=s+'v'; + cplusplusmangledname:=s; +{$else NAMEMANGLING_GCC2} + + { gcc 3.x and 4.x name mangling scheme } + { see http://www.codesourcery.com/public/cxx-abi/abi.html#mangling } + if procsym.owner.symtabletype=ObjectSymtable then + begin + s:='_ZN'; + + s2:=tobjectdef(procsym.owner.defowner).objextname^; + s:=s+tostr(length(s2))+s2; + case proctypeoption of + potype_constructor: + s:=s+'C1'; + potype_destructor: + s:=s+'D1'; + else + s:=s+tostr(length(procsym.realname))+procsym.realname; + end; + + s:=s+'E'; + end + else + s:=procsym.realname; + + { now we handle the parameters } + if maxparacount>0 then + begin + for i:=0 to paras.count-1 do + begin + hp:=tparavarsym(paras[i]); + { no hidden parameters form part of a C++ mangled name: + a) self is not included + b) there are no "high" or other hidden parameters + } + if vo_is_hidden_para in hp.varoptions then + continue; + s2:=getcppparaname(hp.vardef); + if hp.varspez in [vs_var,vs_out] then + s2:='R'+s2; + s:=s+s2; + end; + end + else + s:=s+'v'; + cplusplusmangledname:=s; +{$endif NAMEMANGLING_GCC2} + end; + + + function tprocdef.objcmangledname : string; + var + manglednamelen: longint; + iscatmethod : boolean; + begin + if not (po_msgstr in procoptions) then + internalerror(2009030901); + { we may very well need longer strings to handle these... } + manglednamelen:=length(tobjectdef(procsym.owner.defowner).objextname^)+ + length('+"[ ]"')+length(messageinf.str^); + iscatmethod:=oo_is_classhelper in tobjectdef(procsym.owner.defowner).objectoptions; + if (iscatmethod) then + inc(manglednamelen,length(tobjectdef(procsym.owner.defowner).childof.objextname^)+length('()')); + if manglednamelen>255 then + Message1(parser_e_objc_message_name_too_long,messageinf.str^); + if not(po_classmethod in procoptions) then + result:='"-[' + else + result:='"+['; + { quotes are necessary because the +/- otherwise confuse the assembler + into expecting a number + } + if iscatmethod then + result:=result+tobjectdef(procsym.owner.defowner).childof.objextname^+'('; + result:=result+tobjectdef(procsym.owner.defowner).objextname^; + if iscatmethod then + result:=result+')'; + result:=result+' '+messageinf.str^+']"'; + end; + + + procedure tprocdef.setmangledname(const s : string); + begin + { This is not allowed anymore, the forward declaration + already needs to create the correct mangledname, no changes + afterwards are allowed (PFV) } + { Exception: interface definitions in mode macpas, since in that } + { case no reference to the old name can exist yet (JM) } + if assigned(_mangledname) then + if ((m_mac in current_settings.modeswitches) and + (interfacedef)) then + stringdispose(_mangledname) + else + internalerror(200411171); + {$ifdef compress} + _mangledname:=stringdup(minilzw_encode(s)); + {$else} + _mangledname:=stringdup(s); + {$endif} + include(procoptions,po_has_mangledname); + end; + + +{*************************************************************************** + TPROCVARDEF +***************************************************************************} + + constructor tprocvardef.create(level:byte); + begin + inherited create(procvardef,level); + end; + + + constructor tprocvardef.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(procvardef,ppufile); + { load para symtable } + parast:=tparasymtable.create(self,ppufile.getbyte); + tparasymtable(parast).ppuload(ppufile); + end; + + + function tprocvardef.getcopy : tstoreddef; + var + i : tcallercallee; + j : longint; + begin + result:=tprocvardef.create(parast.symtablelevel); + tprocvardef(result).returndef:=returndef; + tprocvardef(result).returndefderef:=returndefderef; + tprocvardef(result).parast:=parast.getcopy; + tprocvardef(result).savesize:=savesize; + + { create paralist copy } + tprocvardef(result).paras:=tparalist.create(false); + tprocvardef(result).paras.count:=paras.count; + for j:=0 to paras.count-1 do + tprocvardef(result).paras[j]:=paras[j]; + + tprocvardef(result).proctypeoption:=proctypeoption; + tprocvardef(result).proccalloption:=proccalloption; + tprocvardef(result).procoptions:=procoptions; + tprocvardef(result).callerargareasize:=callerargareasize; + tprocvardef(result).calleeargareasize:=calleeargareasize; + tprocvardef(result).maxparacount:=maxparacount; + tprocvardef(result).minparacount:=minparacount; + for i:=low(tcallercallee) to high(tcallercallee) do + tprocvardef(result).funcretloc[i]:=funcretloc[i].getcopy; + tprocvardef(result).has_paraloc_info:=has_paraloc_info; +{$ifdef m68k} + tprocvardef(result).exp_funcretloc:=exp_funcretloc; +{$endif} + end; + + + procedure tprocvardef.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + + { Save the para symtable level (necessary to distinguish nested + procvars) } + ppufile.putbyte(parast.symtablelevel); + + { Write this entry } + ppufile.writeentry(ibprocvardef); + + { Save the para symtable, this is taken from the interface } + tparasymtable(parast).ppuwrite(ppufile); + end; + + + function tprocvardef.GetSymtable(t:tGetSymtable):TSymtable; + begin + case t of + gs_para : + GetSymtable:=parast; + else + GetSymtable:=nil; + end; + end; + + + function tprocvardef.size : asizeint; + begin + if ((po_methodpointer in procoptions) or + is_nested_pd(self)) and + not(po_addressonly in procoptions) then + size:=2*sizeof(pint) + else + size:=sizeof(pint); + end; + + + function tprocvardef.is_methodpointer:boolean; + begin + result:=(po_methodpointer in procoptions); + end; + + + function tprocvardef.is_addressonly:boolean; + begin + result:=(not(po_methodpointer in procoptions) and + not is_nested_pd(self)) or + (po_addressonly in procoptions); + end; + + + function tprocvardef.getmangledparaname:string; + begin + if not(po_methodpointer in procoptions) then + if not is_nested_pd(self) then + result:='procvar' + else + result:='nestedprovar' + else + result:='procvarofobj' + end; + + + function tprocvardef.is_publishable : boolean; + begin + is_publishable:=(po_methodpointer in procoptions); + end; + + + function tprocvardef.GetTypeName : string; + var + s: string; + showhidden : boolean; + begin +{$ifdef EXTDEBUG} + showhidden:=true; +{$else EXTDEBUG} + showhidden:=false; +{$endif EXTDEBUG} + s:='<'; + if po_classmethod in procoptions then + s := s+'class method type of' + else + if po_addressonly in procoptions then + s := s+'address of' + else + s := s+'procedure variable type of'; + if assigned(returndef) and + (returndef<>voidtype) then + s:=s+' function'+typename_paras(showhidden)+':'+returndef.GetTypeName + else + s:=s+' procedure'+typename_paras(showhidden); + if po_methodpointer in procoptions then + s := s+' of object'; + if is_nested_pd(self) then + s := s+' is nested'; + GetTypeName := s+';'+ProcCallOptionStr[proccalloption]+'>'; + end; + + +{*************************************************************************** + TOBJECTDEF +***************************************************************************} + + constructor tobjectdef.create(ot:tobjecttyp;const n:string;c:tobjectdef); + begin + inherited create(n,objectdef); + fcurrent_dispid:=0; + objecttype:=ot; + childof:=nil; + if objecttype=odt_helper then + owner.includeoption(sto_has_helper); + symtable:=tObjectSymtable.create(self,n,current_settings.packrecords); + { create space for vmt !! } + vmtentries:=TFPList.Create; + vmt_offset:=0; + set_parent(c); + if objecttype in [odt_interfacecorba,odt_interfacecom,odt_dispinterface] then + prepareguid; + { setup implemented interfaces } + if objecttype in [odt_class,odt_objcclass,odt_objcprotocol] then + ImplementedInterfaces:=TFPObjectList.Create(true) + else + ImplementedInterfaces:=nil; + writing_class_record_dbginfo:=false; + end; + + + constructor tobjectdef.ppuload(ppufile:tcompilerppufile); + var + i, + implintfcount : longint; + d : tderef; + ImplIntf : TImplementedInterface; + vmtentry : pvmtentry; + begin + inherited ppuload(objectdef,ppufile); + objecttype:=tobjecttyp(ppufile.getbyte); + objextname:=stringdup(ppufile.getstring); + { only used for external Objective-C classes/protocols } + if (objextname^='') then + stringdispose(objextname); + import_lib:=stringdup(ppufile.getstring); + { only used for external C++ classes } + if (import_lib^='') then + stringdispose(import_lib); + symtable:=tObjectSymtable.create(self,objrealname^,0); + tObjectSymtable(symtable).datasize:=ppufile.getasizeint; + tObjectSymtable(symtable).paddingsize:=ppufile.getword; + tObjectSymtable(symtable).fieldalignment:=shortint(ppufile.getbyte); + tObjectSymtable(symtable).recordalignment:=shortint(ppufile.getbyte); + vmt_offset:=ppufile.getlongint; + ppufile.getderef(childofderef); + + { load guid } + iidstr:=nil; + if objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface] then + begin + new(iidguid); + ppufile.getguid(iidguid^); + iidstr:=stringdup(ppufile.getstring); + end; + + if objecttype=odt_helper then + ppufile.getderef(extendeddefderef); + + vmtentries:=TFPList.Create; + vmtentries.count:=ppufile.getlongint; + for i:=0 to vmtentries.count-1 do + begin + ppufile.getderef(d); + new(vmtentry); + vmtentry^.procdef:=nil; + vmtentry^.procdefderef:=d; + vmtentry^.visibility:=tvisibility(ppufile.getbyte); + vmtentries[i]:=vmtentry; + end; + + { load implemented interfaces } + if objecttype in [odt_class,odt_objcclass,odt_objcprotocol] then + begin + ImplementedInterfaces:=TFPObjectList.Create(true); + implintfcount:=ppufile.getlongint; + for i:=0 to implintfcount-1 do + begin + ppufile.getderef(d); + ImplIntf:=TImplementedInterface.Create_deref(d); + ImplIntf.IOffset:=ppufile.getlongint; + ImplementedInterfaces.Add(ImplIntf); + end; + end + else + ImplementedInterfaces:=nil; + + if df_copied_def in defoptions then + ppufile.getderef(cloneddefderef) + else + tObjectSymtable(symtable).ppuload(ppufile); + + { handles the predefined class tobject } + { the last TOBJECT which is loaded gets } + { it ! } + if (childof=nil) and + (objecttype=odt_class) and + (objname^='TOBJECT') then + class_tobject:=self; + if (childof=nil) and + (objecttype=odt_interfacecom) then + if (objname^='IUNKNOWN') then + interface_iunknown:=self + else + if (objname^='IDISPATCH') then + interface_idispatch:=self; + if (childof=nil) and + (objecttype=odt_objcclass) and + (objname^='PROTOCOL') then + objc_protocoltype:=self; + writing_class_record_dbginfo:=false; + end; + + + destructor tobjectdef.destroy; + begin + if assigned(symtable) then + begin + symtable.free; + symtable:=nil; + end; + stringdispose(objextname); + stringdispose(import_lib); + stringdispose(iidstr); + if assigned(ImplementedInterfaces) then + begin + ImplementedInterfaces.free; + ImplementedInterfaces:=nil; + end; + if assigned(iidguid) then + begin + dispose(iidguid); + iidguid:=nil; + end; + if assigned(vmtentries) then + begin + resetvmtentries; + vmtentries.free; + vmtentries:=nil; + end; + if assigned(vmcallstaticinfo) then + begin + freemem(vmcallstaticinfo); + vmcallstaticinfo:=nil; + end; + inherited destroy; + end; + + + function tobjectdef.getcopy : tstoreddef; + var + i : longint; + begin + result:=tobjectdef.create(objecttype,objrealname^,childof); + { the constructor allocates a symtable which we release to avoid memory leaks } + tobjectdef(result).symtable.free; + tobjectdef(result).symtable:=symtable.getcopy; + if assigned(objextname) then + tobjectdef(result).objextname:=stringdup(objextname^); + if assigned(import_lib) then + tobjectdef(result).import_lib:=stringdup(import_lib^); + tobjectdef(result).objectoptions:=objectoptions; + include(tobjectdef(result).defoptions,df_copied_def); + tobjectdef(result).extendeddef:=extendeddef; + tobjectdef(result).vmt_offset:=vmt_offset; + if assigned(iidguid) then + begin + new(tobjectdef(result).iidguid); + move(iidguid^,tobjectdef(result).iidguid^,sizeof(iidguid^)); + end; + if assigned(iidstr) then + tobjectdef(result).iidstr:=stringdup(iidstr^); + if assigned(ImplementedInterfaces) then + begin + for i:=0 to ImplementedInterfaces.count-1 do + tobjectdef(result).ImplementedInterfaces.Add(TImplementedInterface(ImplementedInterfaces[i]).Getcopy); + end; + if assigned(vmtentries) then + begin + tobjectdef(result).vmtentries:=TFPList.Create; + tobjectdef(result).copyvmtentries(self); + end; + end; + + + procedure tobjectdef.ppuwrite(ppufile:tcompilerppufile); + var + i : longint; + vmtentry : pvmtentry; + ImplIntf : TImplementedInterface; + old_do_indirect_crc: boolean; + begin + { if class1 in unit A changes, and class2 in unit B inherits from it + (so unit B uses unit A), then unit B with class2 will be recompiled. + However, if there is also a class3 in unit C that only depends on + unit B, then unit C will not be recompiled because nothing changed + to the interface of unit B. Nevertheless, unit C can indirectly + depend on unit A via derefs, and these must be updated -> the + indirect crc keeps track of such changes. } + old_do_indirect_crc:=ppufile.do_indirect_crc; + ppufile.do_indirect_crc:=true; + inherited ppuwrite(ppufile); + ppufile.putbyte(byte(objecttype)); + if assigned(objextname) then + ppufile.putstring(objextname^) + else + ppufile.putstring(''); + if assigned(import_lib) then + ppufile.putstring(import_lib^) + else + ppufile.putstring(''); + ppufile.putasizeint(tObjectSymtable(symtable).datasize); + ppufile.putword(tObjectSymtable(symtable).paddingsize); + ppufile.putbyte(byte(tObjectSymtable(symtable).fieldalignment)); + ppufile.putbyte(byte(tObjectSymtable(symtable).recordalignment)); + ppufile.putlongint(vmt_offset); + ppufile.putderef(childofderef); + if objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface] then + begin + ppufile.putguid(iidguid^); + ppufile.putstring(iidstr^); + end; + if objecttype=odt_helper then + ppufile.putderef(extendeddefderef); + + ppufile.putlongint(vmtentries.count); + for i:=0 to vmtentries.count-1 do + begin + vmtentry:=pvmtentry(vmtentries[i]); + ppufile.putderef(vmtentry^.procdefderef); + ppufile.putbyte(byte(vmtentry^.visibility)); + end; + + + if assigned(ImplementedInterfaces) then + begin + ppufile.putlongint(ImplementedInterfaces.Count); + for i:=0 to ImplementedInterfaces.Count-1 do + begin + ImplIntf:=TImplementedInterface(ImplementedInterfaces[i]); + ppufile.putderef(ImplIntf.intfdefderef); + ppufile.putlongint(ImplIntf.Ioffset); + end; + end; + + if df_copied_def in defoptions then + ppufile.putderef(cloneddefderef); + + ppufile.writeentry(ibobjectdef); + + if not(df_copied_def in defoptions) then + tObjectSymtable(symtable).ppuwrite(ppufile); + + ppufile.do_indirect_crc:=old_do_indirect_crc; + end; + + + function tobjectdef.GetTypeName:string; + begin + { in this case we will go in endless recursion, because then } + { there is no tsym associated yet with the def. It can occur } + { (tests/webtbf/tw4757.pp), so for now give a generic name } + { instead of the actual type name } + if not assigned(typesym) then + result:='<Currently Parsed Class>' + else + result:=typesymbolprettyname; + end; + + + procedure tobjectdef.buildderef; + var + i : longint; + vmtentry : pvmtentry; + begin + inherited buildderef; + childofderef.build(childof); + if df_copied_def in defoptions then + cloneddefderef.build(symtable.defowner) + else + tstoredsymtable(symtable).buildderef; + + if objecttype=odt_helper then + extendeddefderef.build(extendeddef); + + for i:=0 to vmtentries.count-1 do + begin + vmtentry:=pvmtentry(vmtentries[i]); + vmtentry^.procdefderef.build(vmtentry^.procdef); + end; + + if assigned(ImplementedInterfaces) then + begin + for i:=0 to ImplementedInterfaces.count-1 do + TImplementedInterface(ImplementedInterfaces[i]).buildderef; + end; + end; + + + procedure tobjectdef.deref; + var + i : longint; + vmtentry : pvmtentry; + begin + inherited deref; + childof:=tobjectdef(childofderef.resolve); + if df_copied_def in defoptions then + begin + cloneddef:=tobjectdef(cloneddefderef.resolve); + symtable:=cloneddef.symtable.getcopy; + end + else + tstoredsymtable(symtable).deref; + if objecttype=odt_helper then + extendeddef:=tdef(extendeddefderef.resolve); + for i:=0 to vmtentries.count-1 do + begin + vmtentry:=pvmtentry(vmtentries[i]); + vmtentry^.procdef:=tprocdef(vmtentry^.procdefderef.resolve); + end; + if assigned(ImplementedInterfaces) then + begin + for i:=0 to ImplementedInterfaces.count-1 do + TImplementedInterface(ImplementedInterfaces[i]).deref; + end; + end; + + + procedure create_class_helper_for_procdef(def: tobject; arg: pointer); + var + pd: tprocdef absolute def; + st: tsymtable; + psym: tsym; + nname: TIDString; + begin + if (tdef(def).typ<>procdef) then + exit; + { pd.owner = objcclass symtable -> defowner = objcclassdef -> + owner = symtable in which objcclassdef is defined + } + st:=pd.owner.defowner.owner; + nname:=class_helper_prefix+tprocsym(pd.procsym).name; + { check for an existing procsym with our special name } + psym:=tsym(st.find(nname)); + if not assigned(psym) then + begin + psym:=tprocsym.create(nname); + { avoid warning about this symbol being unused } + psym.IncRefCount; + { don't check for duplicates: + a) we checked above + b) in case we are in the implementation section of a unit, this + will also check for this symbol in the interface section + (since you normally cannot have symbols with the same name + both interface and implementation), and it's possible to + have class helpers for the same class in the interface and + in the implementation, and they cannot be merged since only + the once in the interface must be saved to the ppu/visible + from other units } + st.insert(psym,false); + end + else if (psym.typ<>procsym) then + internalerror(2009111501); + { add ourselves to this special procsym } + tprocsym(psym).procdeflist.add(def); + end; + + + procedure tobjectdef.buildderefimpl; + begin + inherited buildderefimpl; + if not (df_copied_def in defoptions) then + tstoredsymtable(symtable).buildderefimpl; + end; + + + procedure tobjectdef.derefimpl; + begin + inherited derefimpl; + if not (df_copied_def in defoptions) then + tstoredsymtable(symtable).derefimpl; + { the procdefs are not owned by the class helper procsyms, so they + are not stored/restored either -> re-add them here } + if (objecttype=odt_objcclass) or + (oo_is_classhelper in objectoptions) then + symtable.DefList.ForEachCall(@create_class_helper_for_procdef,nil); + end; + + + procedure tobjectdef.resetvmtentries; + var + i : longint; + begin + for i:=0 to vmtentries.Count-1 do + Dispose(pvmtentry(vmtentries[i])); + vmtentries.clear; + end; + + + procedure tobjectdef.copyvmtentries(objdef:tobjectdef); + var + i : longint; + vmtentry : pvmtentry; + begin + resetvmtentries; + vmtentries.count:=objdef.vmtentries.count; + for i:=0 to objdef.vmtentries.count-1 do + begin + new(vmtentry); + vmtentry^:=pvmtentry(objdef.vmtentries[i])^; + vmtentries[i]:=vmtentry; + end; + end; + + + function tobjectdef.getparentdef:tdef; + begin +{ TODO: Remove getparentdef hack} + { With 2 forward declared classes with the child class before the + parent class the child class is written earlier to the ppu. Leaving it + possible to have a reference to the parent class for property overriding, + but the parent class still has the childof not resolved yet (PFV) } + if childof=nil then + childof:=tobjectdef(childofderef.resolve); + result:=childof; + end; + + + procedure tobjectdef.prepareguid; + begin + { set up guid } + if not assigned(iidguid) then + begin + new(iidguid); + fillchar(iidguid^,sizeof(iidguid^),0); { default null guid } + end; + { setup iidstring } + if not assigned(iidstr) then + iidstr:=stringdup(''); { default is empty string } + end; + + + procedure tobjectdef.set_parent( c : tobjectdef); + begin + if assigned(childof) then + exit; + childof:=c; + if not assigned(c) then + exit; + { inherit options and status } + objectoptions:=objectoptions+(c.objectoptions*inherited_objectoptions); + { add the data of the anchestor class/object } + if (objecttype in [odt_class,odt_object,odt_objcclass]) then + begin + tObjectSymtable(symtable).datasize:=tObjectSymtable(symtable).datasize+tObjectSymtable(c.symtable).datasize; + { inherit recordalignment } + tObjectSymtable(symtable).recordalignment:=tObjectSymtable(c.symtable).recordalignment; + { if both the parent and this record use C-alignment, also inherit + the current field alignment } + if (tObjectSymtable(c.symtable).usefieldalignment=C_alignment) and + (tObjectSymtable(symtable).usefieldalignment=C_alignment) then + tObjectSymtable(symtable).fieldalignment:=tObjectSymtable(c.symtable).fieldalignment; + { the padding is not inherited for Objective-C classes (maybe not + for cppclass either?) } + if objecttype=odt_objcclass then + tObjectSymtable(symtable).datasize:=tObjectSymtable(symtable).datasize-tObjectSymtable(c.symtable).paddingsize; + if (oo_has_vmt in objectoptions) and + (oo_has_vmt in c.objectoptions) then + tObjectSymtable(symtable).datasize:=tObjectSymtable(symtable).datasize-sizeof(pint); + { if parent has a vmt field then the offset is the same for the child PM } + if (oo_has_vmt in c.objectoptions) or is_class(self) then + begin + vmt_offset:=c.vmt_offset; + include(objectoptions,oo_has_vmt); + end; + end; + end; + + + procedure tobjectdef.insertvmt; + var + vs: tfieldvarsym; + begin + if objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol] then + exit; + if (oo_has_vmt in objectoptions) then + internalerror(12345) + else + begin + tObjectSymtable(symtable).datasize:=align(tObjectSymtable(symtable).datasize, + tObjectSymtable(symtable).fieldalignment); + + if (tf_requires_proper_alignment in target_info.flags) then + begin + { Align VMT pointer and whole object instance if target CPU requires alignment. } + tObjectSymtable(symtable).datasize:=align(tObjectSymtable(symtable).datasize,sizeof(pint)); + tObjectSymtable(symtable).alignrecord(tObjectSymtable(symtable).datasize,sizeof(pint)); + end; + vs:=tfieldvarsym.create('_vptr$'+objname^,vs_value,voidpointertype,[]); + hidesym(vs); + tObjectSymtable(symtable).insert(vs); + tObjectSymtable(symtable).addfield(vs,vis_hidden); + if (tObjectSymtable(symtable).usefieldalignment<>bit_alignment) then + vmt_offset:=vs.fieldoffset + else + vmt_offset:=vs.fieldoffset div 8; + include(objectoptions,oo_has_vmt); + end; + end; + + + + procedure tobjectdef.check_forwards; + begin + if not(objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcprotocol]) then + inherited; + if (oo_is_forward in objectoptions) then + begin + { ok, in future, the forward can be resolved } + Message1(sym_e_class_forward_not_resolved,objrealname^); + exclude(objectoptions,oo_is_forward); + end; + end; + + + { true if prot implements d (or if they are equal) } + function is_related_protocol(prot: tobjectdef; d : tdef) : boolean; + var + i : longint; + begin + { objcprotocols have multiple inheritance, all protocols from which + the current protocol inherits are stored in implementedinterfaces } + result:=prot=d; + if result then + exit; + + for i:=0 to prot.ImplementedInterfaces.count-1 do + begin + result:=is_related_protocol(TImplementedInterface(prot.ImplementedInterfaces[i]).intfdef,d); + if result then + exit; + end; + end; + + + { true, if self inherits from d (or if they are equal) } + function tobjectdef.is_related(d : tdef) : boolean; + var + hp : tobjectdef; + begin + if self=d then + begin + is_related:=true; + exit; + end; + + if (d.typ<>objectdef) then + begin + is_related:=false; + exit; + end; + + { Objective-C protocols can use multiple inheritance } + if (objecttype=odt_objcprotocol) then + begin + is_related:=is_related_protocol(self,d); + exit + end; + + { formally declared Objective-C classes match Objective-C classes with + the same name } + if (objecttype=odt_objcclass) and + (tobjectdef(d).objecttype=odt_objcclass) and + ((oo_is_formal in objectoptions) or + (oo_is_formal in tobjectdef(d).objectoptions)) and + (objrealname^=tobjectdef(d).objrealname^) then + begin + is_related:=true; + exit; + end; + + hp:=childof; + while assigned(hp) do + begin + if hp=d then + begin + is_related:=true; + exit; + end; + hp:=hp.childof; + end; + is_related:=false; + end; + + function tobjectdef.find_destructor: tprocdef; + var + objdef: tobjectdef; + begin + objdef:=self; + while assigned(objdef) do + begin + result:=objdef.find_procdef_bytype(potype_destructor); + if assigned(result) then + exit; + objdef:=objdef.childof; + end; + result:=nil; + end; + + function tobjectdef.implements_any_interfaces: boolean; + begin + result := (ImplementedInterfaces.Count > 0) or + (assigned(childof) and childof.implements_any_interfaces); + end; + + function tobjectdef.size : asizeint; + begin + if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper] then + result:=sizeof(pint) + else + result:=tObjectSymtable(symtable).datasize; + end; + + + function tobjectdef.alignment:shortint; + begin + if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper] then + alignment:=sizeof(pint) + else + alignment:=tObjectSymtable(symtable).recordalignment; + end; + + + function tobjectdef.vmtmethodoffset(index:longint):longint; + begin + { for offset of methods for classes, see rtl/inc/objpash.inc } + case objecttype of + odt_class: + { the +2*sizeof(pint) is size and -size } + vmtmethodoffset:=(index+10)*sizeof(pint)+2*sizeof(pint); + odt_helper, + odt_objcclass, + odt_objcprotocol: + vmtmethodoffset:=0; + odt_interfacecom,odt_interfacecorba,odt_dispinterface: + vmtmethodoffset:=index*sizeof(pint); + else +{$ifdef WITHDMT} + vmtmethodoffset:=(index+4)*sizeof(pint); +{$else WITHDMT} + vmtmethodoffset:=(index+3)*sizeof(pint); +{$endif WITHDMT} + end; + end; + + + function tobjectdef.vmt_mangledname : string; + begin + if not(oo_has_vmt in objectoptions) then + Message1(parser_n_object_has_no_vmt,objrealname^); + vmt_mangledname:=make_mangledname('VMT',owner,objname^); + end; + + + function tobjectdef.needs_inittable : boolean; + begin + case objecttype of + odt_helper, + odt_class : + needs_inittable:=false; + odt_dispinterface, + odt_interfacecom: + needs_inittable:=true; + odt_interfacecorba: + needs_inittable:=is_related(interface_iunknown); + odt_object: + needs_inittable:=tObjectSymtable(symtable).needs_init_final; + odt_cppclass, + odt_objcclass, + odt_objcprotocol: + needs_inittable:=false; + else + internalerror(200108267); + end; + end; + + + function tobjectdef.rtti_mangledname(rt: trttitype): string; + begin + if not(objecttype in [odt_objcclass,odt_objcprotocol]) then + result:=inherited rtti_mangledname(rt) + else + begin + { necessary in case of a dynamic array of nsobject, or + if an nsobject field appears in a record that needs + init/finalisation } + if rt=initrtti then + begin + result:=voidpointertype.rtti_mangledname(rt); + exit; + end; + + if not(target_info.system in systems_objc_nfabi) then + begin + result:=target_asm.labelprefix; + case objecttype of + odt_objcclass: + begin + case rt of + objcclassrtti: + if not(oo_is_classhelper in objectoptions) then + result:=result+'_OBJC_CLASS_' + else + result:=result+'_OBJC_CATEGORY_'; + objcmetartti: + if not(oo_is_classhelper in objectoptions) then + result:=result+'_OBJC_METACLASS_' + else + internalerror(2009111511); + else + internalerror(2009092302); + end; + end; + odt_objcprotocol: + result:=result+'_OBJC_PROTOCOL_'; + end; + end + else + begin + case objecttype of + odt_objcclass: + begin + if (oo_is_classhelper in objectoptions) and + (rt<>objcclassrtti) then + internalerror(2009111512); + case rt of + objcclassrtti: + if not(oo_is_classhelper in objectoptions) then + result:='_OBJC_CLASS_$_' + else + result:='_OBJC_$_CATEGORY_'; + objcmetartti: + result:='_OBJC_METACLASS_$_'; + objcclassrortti: + result:=lower(target_asm.labelprefix)+'_OBJC_CLASS_RO_$_'; + objcmetarortti: + result:=lower(target_asm.labelprefix)+'_OBJC_METACLASS_RO_$_'; + else + internalerror(2009092303); + end; + end; + odt_objcprotocol: + begin + result:=lower(target_asm.labelprefix); + case rt of + objcclassrtti: + result:=result+'_OBJC_PROTOCOL_$_'; + objcmetartti: + result:=result+'_OBJC_LABEL_PROTOCOL_$_'; + else + internalerror(2009092501); + end; + end; + end; + end; + result:=result+objextname^; + end; + end; + + + function tobjectdef.members_need_inittable : boolean; + begin + members_need_inittable:=tObjectSymtable(symtable).needs_init_final; + end; + + + function tobjectdef.find_implemented_interface(aintfdef:tobjectdef):TImplementedInterface; + var + ImplIntf : TImplementedInterface; + i : longint; + begin + result:=nil; + if not assigned(ImplementedInterfaces) then + exit; + for i:=0 to ImplementedInterfaces.Count-1 do + begin + ImplIntf:=TImplementedInterface(ImplementedInterfaces[i]); + if ImplIntf.intfdef=aintfdef then + begin + result:=ImplIntf; + exit; + end; + end; + end; + + + function tobjectdef.is_publishable : boolean; + begin + is_publishable:=objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface]; + end; + + + function tobjectdef.get_next_dispid: longint; + begin + inc(fcurrent_dispid); + result:=fcurrent_dispid; + end; + + function tobjectdef.search_enumerator_get: tprocdef; + begin + result:=inherited; + if not assigned(result) and assigned(childof) then + result:=childof.search_enumerator_get; + end; + + function tobjectdef.search_enumerator_move: tprocdef; + begin + result:=inherited; + if not assigned(result) and assigned(childof) then + result:=childof.search_enumerator_move; + end; + + function tobjectdef.search_enumerator_current: tsym; + begin + result:=inherited; + if not assigned(result) and assigned(childof) then + result:=childof.search_enumerator_current; + end; + + procedure tobjectdef.register_created_classref_type; + begin + if not classref_created_in_current_module then + begin + classref_created_in_current_module:=true; + current_module.wpoinfo.addcreatedobjtypeforclassref(self); + end; + end; + + + procedure tobjectdef.register_created_object_type; + begin + if not created_in_current_module then + begin + created_in_current_module:=true; + current_module.wpoinfo.addcreatedobjtype(self); + end; + end; + + + procedure tobjectdef.register_maybe_created_object_type; + begin + { if we know it has been created for sure, no need + to also record that it maybe can be created in + this module + } + if not (created_in_current_module) and + not (maybe_created_in_current_module) then + begin + maybe_created_in_current_module:=true; + current_module.wpoinfo.addmaybecreatedbyclassref(self); + end; + end; + + + procedure tobjectdef.register_vmt_call(index: longint); + begin + if (is_object(self) or is_class(self)) then + current_module.wpoinfo.addcalledvmtentry(self,index); + end; + + + procedure check_and_finish_msg(data: tobject; arg: pointer); + var + def: tdef absolute data; + pd: tprocdef absolute data; + i, + paracount: longint; + begin + if (def.typ=procdef) then + begin + { add all messages also under a dummy name to the symtable in + which the objcclass/protocol/category is declared, so they can + be called via id.<name> + } + create_class_helper_for_procdef(pd,nil); + + { we have to wait until now to set the mangled name because it + depends on the (possibly external) class name, which is defined + at the very end. } + if not(po_msgstr in pd.procoptions) then + begin + CGMessagePos(pd.fileinfo,parser_e_objc_requires_msgstr); + { recover to avoid internalerror later on } + include(pd.procoptions,po_msgstr); + pd.messageinf.str:=stringdup('MissingDeclaration'); + end; + { Mangled name is already set in case this is a copy of + another type. } + if not(po_has_mangledname in pd.procoptions) then + begin + { check whether the number of formal parameters is correct, + and whether they have valid Objective-C types } + paracount:=0; + for i:=1 to length(pd.messageinf.str^) do + if pd.messageinf.str^[i]=':' then + inc(paracount); + for i:=0 to pd.paras.count-1 do + if not(vo_is_hidden_para in tparavarsym(pd.paras[i]).varoptions) and + not is_array_of_const(tparavarsym(pd.paras[i]).vardef) then + dec(paracount); + if (paracount<>0) then + MessagePos(pd.fileinfo,sym_e_objc_para_mismatch); + + pd.setmangledname(pd.objcmangledname); + end + else + { all checks already done } + exit; + if not(oo_is_external in pd.struct.objectoptions) then + begin + if (po_varargs in pd.procoptions) then + MessagePos(pd.fileinfo,parser_e_varargs_need_cdecl_and_external) + else + begin + { check for "array of const" parameters } + for i:=0 to pd.parast.symlist.count-1 do + begin + if (tsym(pd.parast.symlist[i]).typ=paravarsym) and + is_array_of_const(tparavarsym(pd.parast.symlist[i]).vardef) then + MessagePos(pd.fileinfo,parser_e_varargs_need_cdecl_and_external); + end; + end; + end; + end; + end; + + + procedure mark_private_fields_used(data: tobject; arg: pointer); + var + sym: tsym absolute data; + begin + if (sym.typ=fieldvarsym) and + (tfieldvarsym(sym).visibility in [vis_private,vis_strictprivate]) then + sym.IncRefCount; + end; + + + procedure tobjectdef.finish_objc_data; + begin + self.symtable.DefList.foreachcall(@check_and_finish_msg,nil); + if (oo_is_external in objectoptions) then + self.symtable.SymList.ForEachCall(@mark_private_fields_used,nil); + end; + + + procedure verify_objc_vardef(data: tobject; arg: pointer); + var + sym: tabstractvarsym absolute data; + res: pboolean absolute arg; + founderrordef: tdef; + begin + if not(tsym(data).typ in [paravarsym,fieldvarsym]) then + exit; + if (sym.typ=paravarsym) and + ((vo_is_hidden_para in tparavarsym(sym).varoptions) or + is_array_of_const(tparavarsym(sym).vardef)) then + exit; + if not objcchecktype(sym.vardef,founderrordef) then + begin + MessagePos1(sym.fileinfo,type_e_objc_type_unsupported,founderrordef.typename); + res^:=false; + end; + end; + + + procedure verify_objc_procdef_paras(data: tobject; arg: pointer); + var + def: tdef absolute data; + res: pboolean absolute arg; + founderrordef: tdef; + begin + if (def.typ<>procdef) then + exit; + { check parameter types for validity } + tprocdef(def).paras.foreachcall(@verify_objc_vardef,arg); + { check the result type for validity } + if not objcchecktype(tprocdef(def).returndef,founderrordef) then + begin + MessagePos1(tprocdef(def).funcretsym.fileinfo,type_e_objc_type_unsupported,founderrordef.typename); + res^:=false; + end; + end; + + + function tobjectdef.check_objc_types: boolean; + begin + { done in separate step from finish_objc_data, because when + finish_objc_data is called, not all forwarddefs have been resolved + yet and we need to know all types here } + result:=true; + self.symtable.symlist.foreachcall(@verify_objc_vardef,@result); + self.symtable.deflist.foreachcall(@verify_objc_procdef_paras,@result); + end; + + + procedure do_cpp_import_info(data: tobject; arg: pointer); + var + def: tdef absolute data; + pd: tprocdef absolute data; + begin + if (def.typ=procdef) then + begin + pd.setmangledname(target_info.Cprefix+pd.cplusplusmangledname); + if (oo_is_external in pd.struct.objectoptions) then + begin + { copied from psub.read_proc } + if assigned(tobjectdef(pd.struct).import_lib) then + current_module.AddExternalImport(tobjectdef(pd.struct).import_lib^,pd.mangledname,pd.mangledname,0,false,false) + else + begin + { add import name to external list for DLL scanning } + if tf_has_dllscanner in target_info.flags then + current_module.dllscannerinputlist.Add(pd.mangledname,pd); + end; + + end; + end; + end; + + + procedure tobjectdef.finish_cpp_data; + begin + self.symtable.DefList.ForEachCall(@do_cpp_import_info,nil); + end; + +{**************************************************************************** + TImplementedInterface +****************************************************************************} + + constructor TImplementedInterface.create(aintf: tobjectdef); + begin + inherited create; + intfdef:=aintf; + IOffset:=-1; + IType:=etStandard; + NameMappings:=nil; + procdefs:=nil; + end; + + + constructor TImplementedInterface.create_deref(d:tderef); + begin + inherited create; + intfdef:=nil; + intfdefderef:=d; + IOffset:=-1; + IType:=etStandard; + NameMappings:=nil; + procdefs:=nil; + end; + + + destructor TImplementedInterface.destroy; + var + i : longint; + mappedname : pshortstring; + begin + if assigned(NameMappings) then + begin + for i:=0 to NameMappings.Count-1 do + begin + mappedname:=pshortstring(NameMappings[i]); + stringdispose(mappedname); + end; + NameMappings.free; + NameMappings:=nil; + end; + if assigned(procdefs) then + begin + procdefs.free; + procdefs:=nil; + end; + inherited destroy; + end; + + + procedure TImplementedInterface.buildderef; + begin + intfdefderef.build(intfdef); + end; + + + procedure TImplementedInterface.deref; + begin + intfdef:=tobjectdef(intfdefderef.resolve); + end; + + + procedure TImplementedInterface.AddMapping(const origname,newname: string); + begin + if not assigned(NameMappings) then + NameMappings:=TFPHashList.Create; + NameMappings.Add(origname,stringdup(newname)); + end; + + + function TImplementedInterface.GetMapping(const origname: string):string; + var + mappedname : pshortstring; + begin + result:=''; + if not assigned(NameMappings) then + exit; + mappedname:=PShortstring(NameMappings.Find(origname)); + if assigned(mappedname) then + result:=mappedname^; + end; + + + procedure TImplementedInterface.AddImplProc(pd:tprocdef); + begin + if not assigned(procdefs) then + procdefs:=TFPObjectList.Create(false); + { duplicate entries must be stored, because multiple } + { interfaces can declare methods with the same name } + { and all of these get their own VMT entry } + procdefs.Add(pd); + end; + + + function TImplementedInterface.IsImplMergePossible(MergingIntf:TImplementedInterface;out weight: longint): boolean; + var + i : longint; + begin + result:=false; + { interfaces being implemented through delegation are not mergable (FK) } + if (IType<>etStandard) or (MergingIntf.IType<>etStandard) or not(assigned(ProcDefs)) or not(assigned(MergingIntf.ProcDefs)) then + exit; + weight:=0; + { empty interface is mergeable } + if ProcDefs.Count=0 then + begin + result:=true; + exit; + end; + { The interface to merge must at least the number of + procedures of this interface } + if MergingIntf.ProcDefs.Count<ProcDefs.Count then + exit; + for i:=0 to ProcDefs.Count-1 do + begin + if MergingIntf.ProcDefs[i]<>ProcDefs[i] then + exit; + end; + weight:=ProcDefs.Count; + result:=true; + end; + + + function TImplementedInterface.getcopy:TImplementedInterface; + begin + Result:=TImplementedInterface.Create(nil); + { 1) the procdefs list will be freed once for each copy + 2) since the procdefs list owns its elements, those will also be freed for each copy + 3) idem for the name mappings + } + { warning: this is completely wrong on so many levels... + Move(pointer(self)^,pointer(result)^,InstanceSize); + We need to make clean copies of the different fields + this is not implemented yet, and thus we generate an internal + error instead PM 2011-06-14 } + internalerror(2011061401); + end; + +{**************************************************************************** + TFORWARDDEF +****************************************************************************} + + constructor tforwarddef.create(const s:string;const pos:tfileposinfo); + begin + inherited create(forwarddef); + tosymname:=stringdup(s); + forwardpos:=pos; + end; + + + function tforwarddef.GetTypeName:string; + begin + GetTypeName:='unresolved forward to '+tosymname^; + end; + + + destructor tforwarddef.destroy; + begin + stringdispose(tosymname); + inherited destroy; + end; + + function tforwarddef.getcopy:tstoreddef; + begin + result:=tforwarddef.create(tosymname^, forwardpos); + end; + +{**************************************************************************** + TUNDEFINEDDEF +****************************************************************************} + + constructor tundefineddef.create; + begin + inherited create(undefineddef); + end; + + + constructor tundefineddef.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(undefineddef,ppufile); + end; + + function tundefineddef.GetTypeName:string; + begin + GetTypeName:='<undefined type>'; + end; + + + procedure tundefineddef.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.writeentry(ibundefineddef); + end; + + +{**************************************************************************** + TERRORDEF +****************************************************************************} + + constructor terrordef.create; + begin + inherited create(errordef); + { prevent consecutive faults } + savesize:=1; + end; + + + procedure terrordef.ppuwrite(ppufile:tcompilerppufile); + begin + { Can't write errordefs to ppu } + internalerror(200411063); + end; + + + function terrordef.GetTypeName:string; + begin + GetTypeName:='<erroneous type>'; + end; + + + function terrordef.getmangledparaname:string; + begin + getmangledparaname:='error'; + end; + + +{**************************************************************************** + Definition Helpers +****************************************************************************} + + function is_interfacecom(def: tdef): boolean; + begin + is_interfacecom:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype=odt_interfacecom); + end; + + function is_interfacecom_or_dispinterface(def: tdef): boolean; + begin + is_interfacecom_or_dispinterface:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype in [odt_interfacecom,odt_dispinterface]); + end; + + function is_interfacecorba(def: tdef): boolean; + begin + is_interfacecorba:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype=odt_interfacecorba); + end; + + function is_interface(def: tdef): boolean; + begin + is_interface:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype in [odt_interfacecom,odt_interfacecorba]); + end; + + + function is_dispinterface(def: tdef): boolean; + begin + result:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype=odt_dispinterface); + end; + + + function is_class(def: tdef): boolean; + begin + is_class:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype=odt_class); + end; + + + function is_object(def: tdef): boolean; + begin + is_object:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype=odt_object); + end; + + + function is_cppclass(def: tdef): boolean; + begin + is_cppclass:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype=odt_cppclass); + end; + + + function is_objcclass(def: tdef): boolean; + begin + is_objcclass:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype=odt_objcclass); + end; + + + function is_objectpascal_helper(def: tdef): boolean; + begin + result:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype=odt_helper); + end; + + + function is_objcclassref(def: tdef): boolean; + begin + is_objcclassref:= + assigned(def) and + (def.typ=classrefdef) and + is_objcclass(tclassrefdef(def).pointeddef); + end; + + + function is_objcprotocol(def: tdef): boolean; + begin + result:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype=odt_objcprotocol); + end; + + + function is_objccategory(def: tdef): boolean; + begin + result:= + assigned(def) and + (def.typ=objectdef) and + { if used as a forward type } + ((tobjectdef(def).objecttype=odt_objccategory) or + { if used as after it has been resolved } + ((tobjectdef(def).objecttype=odt_objcclass) and + (oo_is_classhelper in tobjectdef(def).objectoptions))); + end; + + function is_objc_class_or_protocol(def: tdef): boolean; + begin + result:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype in [odt_objcclass,odt_objcprotocol]); + end; + + + function is_objc_protocol_or_category(def: tdef): boolean; + begin + result:= + assigned(def) and + (def.typ=objectdef) and + ((tobjectdef(def).objecttype = odt_objcprotocol) or + ((tobjectdef(def).objecttype = odt_objcclass) and + (oo_is_classhelper in tobjectdef(def).objectoptions))); + end; + + function is_classhelper(def: tdef): boolean; + begin + result:= + is_objectpascal_helper(def) or + is_objccategory(def); + end; + + function is_class_or_interface(def: tdef): boolean; + begin + result:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba]); + end; + + + function is_class_or_interface_or_objc(def: tdef): boolean; + begin + result:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_objcclass,odt_objcprotocol]); + end; + + + function is_class_or_interface_or_object(def: tdef): boolean; + begin + result:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_object]); + end; + + + function is_class_or_interface_or_dispinterface(def: tdef): boolean; + begin + result:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface]); + end; + + + function is_implicit_pointer_object_type(def: tdef): boolean; + begin + result:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper]); + end; + + function is_class_or_object(def: tdef): boolean; + begin + result:= + assigned(def) and + (def.typ=objectdef) and + (tobjectdef(def).objecttype in [odt_class,odt_object]); + end; + + function is_record(def: tdef): boolean; + begin + result:= + assigned(def) and + (def.typ=recorddef); + end; + + procedure loadobjctypes; + begin + objc_metaclasstype:=tpointerdef(search_named_unit_globaltype('OBJC','POBJC_CLASS',true).typedef); + objc_superclasstype:=tpointerdef(search_named_unit_globaltype('OBJC','POBJC_SUPER',true).typedef); + objc_idtype:=tpointerdef(search_named_unit_globaltype('OBJC','ID',true).typedef); + objc_seltype:=tpointerdef(search_named_unit_globaltype('OBJC','SEL',true).typedef); + objc_objecttype:=trecorddef(search_named_unit_globaltype('OBJC','OBJC_OBJECT',true).typedef); + end; + + + procedure maybeloadcocoatypes; + var + tsym: ttypesym; + begin + if assigned(objc_fastenumeration) then + exit; + tsym:=search_named_unit_globaltype('COCOAALL','NSFASTENUMERATIONPROTOCOL',false); + if assigned(tsym) then + objc_fastenumeration:=tobjectdef(tsym.typedef) + else + objc_fastenumeration:=nil; + tsym:=search_named_unit_globaltype('COCOAALL','NSFASTENUMERATIONSTATE',false); + if assigned(tsym) then + objc_fastenumerationstate:=trecorddef(tsym.typedef) + else + objc_fastenumerationstate:=nil; + end; + + + function use_vectorfpu(def : tdef) : boolean; + begin +{$ifdef x86} +{$define use_vectorfpuimplemented} + use_vectorfpu:=(is_single(def) and (current_settings.fputype in sse_singlescalar)) or + (is_double(def) and (current_settings.fputype in sse_doublescalar)); +{$endif x86} +{$ifdef arm} +{$define use_vectorfpuimplemented} + use_vectorfpu:=(current_settings.fputype in vfp_scalar); +{$endif arm} +{$ifndef use_vectorfpuimplemented} + use_vectorfpu:=false; +{$endif} + end; + +end. diff --git a/closures/compiler/symnot.pas b/closures/compiler/symnot.pas new file mode 100644 index 0000000000..198bc43063 --- /dev/null +++ b/closures/compiler/symnot.pas @@ -0,0 +1,63 @@ +{ + Copyright (c) 2002 by Daniel Mantione + + This unit contains support routines for the variable access + notifier. + + 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 symnot; + +{$i fpcdefs.inc} + +interface + +uses cclasses,symtype; + +type Tnotification_flag=(vn_onread,vn_onwrite,vn_unknown); + Tnotification_flags=set of Tnotification_flag; + + Tnotification_callback=procedure(not_type:Tnotification_flag; + symbol:Tsym) of object; + + Tnotification=class(Tlinkedlistitem) + flags:Tnotification_flags; + callback:Tnotification_callback; + id:cardinal; + constructor create(Aflags:Tnotification_flags; + Acallback:Tnotification_callback); + end; + +implementation + +var notification_counter:cardinal; + +constructor Tnotification.create(Aflags:Tnotification_flags; + Acallback:Tnotification_callback); + +begin + inherited create; + flags:=Aflags; + callback:=Acallback; + id:=notification_counter; + inc(notification_counter); +end; + +begin + notification_counter:=0; +end. diff --git a/closures/compiler/symsym.pas b/closures/compiler/symsym.pas new file mode 100644 index 0000000000..c91d3e5d80 --- /dev/null +++ b/closures/compiler/symsym.pas @@ -0,0 +1,2109 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller + + Implementation for the symbols types of the symtable + + 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 symsym; + +{$i fpcdefs.inc} + +interface + + uses + { common } + cutils, + { target } + globtype,globals,widestr,constexp, + { symtable } + symconst,symbase,symtype,symdef,defcmp, + { ppu } + ppu,finput, + cclasses,symnot, + { aasm } + aasmbase, + cpuinfo,cpubase,cgbase,cgutils,parabase + ; + + type + { this class is the base for all symbol objects } + tstoredsym = class(tsym) + public + constructor create(st:tsymtyp;const n : string); + constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile); + destructor destroy;override; + procedure ppuwrite(ppufile:tcompilerppufile);virtual; + end; + + tlabelsym = class(tstoredsym) + used, + defined, + nonlocal : boolean; + { points to the matching node, only valid resultdef pass is run and + the goto<->label relation in the node tree is created, should + be a tnode } + code : pointer; + + { points to the jump buffer } + jumpbuf : tstoredsym; + + { when the label is defined in an asm block, this points to the + generated asmlabel } + asmblocklabel : tasmlabel; + constructor create(const n : string); + constructor ppuload(ppufile:tcompilerppufile); + procedure ppuwrite(ppufile:tcompilerppufile);override; + function mangledname:string;override; + end; + + tunitsym = class(Tstoredsym) + module : tobject; { tmodule } + constructor create(const n : string;amodule : tobject); + constructor ppuload(ppufile:tcompilerppufile); + destructor destroy;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + end; + + tnamespacesym = class(Tstoredsym) + unitsym:tsym; + unitsymderef:tderef; + constructor create(const n : string); + constructor ppuload(ppufile:tcompilerppufile); + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderef;override; + procedure deref;override; + end; + + terrorsym = class(Tsym) + constructor create; + end; + + { tprocsym } + + tprocsym = class(tstoredsym) + protected + FProcdefList : TFPObjectList; + FProcdefDerefList : TFPList; + public + constructor create(const n : string); + constructor ppuload(ppufile:tcompilerppufile); + destructor destroy;override; + { writes all declarations except the specified one } + procedure write_parameter_lists(skipdef:tprocdef); + { tests, if all procedures definitions are defined and not } + { only forward } + procedure check_forward; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderef;override; + procedure deref;override; + function find_procdef_bytype(pt:Tproctypeoption):Tprocdef; + function find_procdef_bypara(para:TFPObjectList;retdef:tdef;cpoptions:tcompare_paras_options):Tprocdef; + function find_procdef_byoptions(ops:tprocoptions): Tprocdef; + function find_procdef_byprocvardef(d:Tprocvardef):Tprocdef; + function find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef; + function find_procdef_enumerator_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef; + property ProcdefList:TFPObjectList read FProcdefList; + end; + + ttypesym = class(Tstoredsym) + public + typedef : tdef; + typedefderef : tderef; + fprettyname : ansistring; + constructor create(const n : string;def:tdef); + constructor ppuload(ppufile:tcompilerppufile); + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderef;override; + procedure deref;override; + function prettyname : string;override; + end; + + tabstractvarsym = class(tstoredsym) + varoptions : tvaroptions; + notifications : Tlinkedlist; + varspez : tvarspez; { sets the type of access } + varregable : tvarregable; + varstate : tvarstate; + { Has the address of this variable potentially escaped the } + { block in which is was declared? } + { could also be part of tabstractnormalvarsym, but there's } + { one byte left here till the next 4 byte alignment } + addr_taken : boolean; + constructor create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions); + constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile); + destructor destroy;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderef;override; + procedure deref;override; + function getsize : asizeint; + function getpackedbitsize : longint; + function is_regvar(refpara: boolean):boolean; + procedure trigger_notifications(what:Tnotification_flag); + function register_notification(flags:Tnotification_flags; + callback:Tnotification_callback):cardinal; + procedure unregister_notification(id:cardinal); + private + _vardef : tdef; + vardefderef : tderef; + + procedure setvardef(def:tdef); + public + property vardef: tdef read _vardef write setvardef; + end; + + tfieldvarsym = class(tabstractvarsym) + fieldoffset : asizeint; { offset in record/object } + objcoffsetmangledname: pshortstring; { mangled name of offset, calculated as needed } + constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions); + constructor ppuload(ppufile:tcompilerppufile); + procedure ppuwrite(ppufile:tcompilerppufile);override; + function mangledname:string;override; + destructor destroy;override; + end; + + tabstractnormalvarsym = class(tabstractvarsym) + defaultconstsym : tsym; + defaultconstsymderef : tderef; + localloc : TLocation; { register/reference for local var } + initialloc : TLocation; { initial location so it can still be initialized later after the location was changed by SSA } + constructor create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions); + constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile); + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderef;override; + procedure deref;override; + end; + + tlocalvarsym = class(tabstractnormalvarsym) + constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions); + constructor ppuload(ppufile:tcompilerppufile); + procedure ppuwrite(ppufile:tcompilerppufile);override; + end; + + tparavarsym = class(tabstractnormalvarsym) + paraloc : array[tcallercallee] of TCGPara; + paranr : word; { position of this parameter } + { in MacPas mode, "univ" parameters mean that type checking should + be disabled, except that the size of the passed parameter must + match the size of the formal parameter } + univpara : boolean; +{$ifdef EXTDEBUG} + eqval : tequaltype; +{$endif EXTDEBUG} + constructor create(const n : string;nr:word;vsp:tvarspez;def:tdef;vopts:tvaroptions); + constructor ppuload(ppufile:tcompilerppufile); + destructor destroy;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function needs_finalization: boolean; + end; + + tstaticvarsym = class(tabstractnormalvarsym) + private + _mangledname : pshortstring; + public + section : ansistring; + constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions); + constructor create_dll(const n : string;vsp:tvarspez;def:tdef); + constructor create_C(const n,mangled : string;vsp:tvarspez;def:tdef); + constructor ppuload(ppufile:tcompilerppufile); + destructor destroy;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function mangledname:string;override; + procedure set_mangledname(const s:string); + end; + + tabsolutevarsym = class(tabstractvarsym) + public + abstyp : absolutetyp; +{$ifdef i386} + absseg : boolean; +{$endif i386} + asmname : pshortstring; + addroffset : aword; + ref : tpropaccesslist; + constructor create(const n : string;def:tdef); + constructor create_ref(const n : string;def:tdef;_ref:tpropaccesslist); + destructor destroy;override; + constructor ppuload(ppufile:tcompilerppufile); + procedure buildderef;override; + procedure deref;override; + function mangledname : string;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + end; + + tpropaccesslisttypes=(palt_none,palt_read,palt_write,palt_stored); + + tpropertysym = class(Tstoredsym) + propoptions : tpropertyoptions; + overriddenpropsym : tpropertysym; + overriddenpropsymderef : tderef; + propdef : tdef; + propdefderef : tderef; + indexdef : tdef; + indexdefderef : tderef; + index, + default : longint; + dispid : longint; + propaccesslist: array[tpropaccesslisttypes] of tpropaccesslist; + parast : tsymtable; + constructor create(const n : string); + destructor destroy;override; + constructor ppuload(ppufile:tcompilerppufile); + function getsize : asizeint; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderef;override; + procedure deref;override; + end; + + tconstvalue = record + case integer of + 0: (valueord : tconstexprint); + 1: (valueordptr : tconstptruint); + 2: (valueptr : pointer; len : longint); + end; + + tconstsym = class(tstoredsym) + constdef : tdef; + constdefderef : tderef; + consttyp : tconsttyp; + value : tconstvalue; + constructor create_ord(const n : string;t : tconsttyp;v : tconstexprint;def:tdef); + constructor create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;def:tdef); + constructor create_ptr(const n : string;t : tconsttyp;v : pointer;def:tdef); + constructor create_string(const n : string;t : tconsttyp;str:pchar;l:longint); + constructor create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring); + constructor ppuload(ppufile:tcompilerppufile); + destructor destroy;override; + procedure buildderef;override; + procedure deref;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + end; + + tenumsym = class(Tstoredsym) + value : longint; + definition : tenumdef; + definitionderef : tderef; + constructor create(const n : string;def : tenumdef;v : longint); + constructor ppuload(ppufile:tcompilerppufile); + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure buildderef;override; + procedure deref;override; + end; + + tsyssym = class(Tstoredsym) + number : longint; + constructor create(const n : string;l : longint); + constructor ppuload(ppufile:tcompilerppufile); + destructor destroy;override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + end; + + const + maxmacrolen=16*1024; + + type + pmacrobuffer = ^tmacrobuffer; + tmacrobuffer = array[0..maxmacrolen-1] of char; + + tmacro = class(tstoredsym) + {Normally true, but false when a previously defined macro is undef-ed} + defined : boolean; + {True if this is a mac style compiler variable, in which case no macro + substitutions shall be done.} + is_compiler_var : boolean; + {Whether the macro was used. NOTE: A use of a macro which was never defined} + {e. g. an IFDEF which returns false, will not be registered as used,} + {since there is no place to register its use. } + is_used : boolean; + buftext : pchar; + buflen : longint; + constructor create(const n : string); + constructor ppuload(ppufile:tcompilerppufile); + procedure ppuwrite(ppufile:tcompilerppufile);override; + destructor destroy;override; + function GetCopy:tmacro; + end; + + var + generrorsym : tsym; + +implementation + + uses + { global } + verbose, + { target } + systems, + { symtable } + defutil,symtable, + fmodule, + { tree } + node, + { aasm } + aasmtai,aasmdata, + { codegen } + paramgr, + procinfo + ; + +{**************************************************************************** + Helpers +****************************************************************************} + +{**************************************************************************** + TSYM (base for all symtypes) +****************************************************************************} + + constructor tstoredsym.create(st:tsymtyp;const n : string); + begin + inherited create(st,n); + { Register in current_module } + if assigned(current_module) then + begin + current_module.symlist.Add(self); + SymId:=current_module.symlist.Count-1; + end; + end; + + + constructor tstoredsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile); + begin + SymId:=ppufile.getlongint; + inherited Create(st,ppufile.getstring); + { Register symbol } + current_module.symlist[SymId]:=self; + ppufile.getposinfo(fileinfo); + visibility:=tvisibility(ppufile.getbyte); + ppufile.getsmallset(symoptions); + if sp_has_deprecated_msg in symoptions then + deprecatedmsg:=stringdup(ppufile.getstring) + else + deprecatedmsg:=nil; + end; + + + procedure tstoredsym.ppuwrite(ppufile:tcompilerppufile); + var + oldintfcrc : boolean; + begin + ppufile.putlongint(SymId); + ppufile.putstring(realname); + ppufile.putposinfo(fileinfo); + ppufile.putbyte(byte(visibility)); + { symoptions can differ between interface and implementation, except + for overload (this is checked in pdecsub.proc_add_definition() ) + + These differences can lead to compiler crashes, so ignore them. + This does mean that changing e.g. the "deprecated" state of a symbol + by itself will not trigger a recompilation of dependent units. + } + oldintfcrc:=ppufile.do_interface_crc; + ppufile.do_interface_crc:=false; + ppufile.putsmallset(symoptions); + if sp_has_deprecated_msg in symoptions then + ppufile.putstring(deprecatedmsg^); + ppufile.do_interface_crc:=oldintfcrc; + end; + + + destructor tstoredsym.destroy; + begin + inherited destroy; + end; + + +{**************************************************************************** + TLABELSYM +****************************************************************************} + + constructor tlabelsym.create(const n : string); + begin + inherited create(labelsym,n); + used:=false; + defined:=false; + nonlocal:=false; + code:=nil; + end; + + + constructor tlabelsym.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(labelsym,ppufile); + code:=nil; + used:=false; + nonlocal:=false; + defined:=true; + end; + + + procedure tlabelsym.ppuwrite(ppufile:tcompilerppufile); + begin + if owner.symtabletype=globalsymtable then + Message(sym_e_ill_label_decl) + else + begin + inherited ppuwrite(ppufile); + ppufile.writeentry(iblabelsym); + end; + end; + + + function tlabelsym.mangledname:string; + begin + if not(defined) then + begin + defined:=true; + if nonlocal then + current_asmdata.getglobaljumplabel(asmblocklabel) + else + current_asmdata.getjumplabel(asmblocklabel); + end; + result:=asmblocklabel.name; + end; + +{**************************************************************************** + TUNITSYM +****************************************************************************} + + constructor tunitsym.create(const n : string;amodule : tobject); + begin + inherited create(unitsym,n); + module:=amodule; + end; + + constructor tunitsym.ppuload(ppufile:tcompilerppufile); + + begin + inherited ppuload(unitsym,ppufile); + module:=nil; + end; + + destructor tunitsym.destroy; + begin + inherited destroy; + end; + + procedure tunitsym.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.writeentry(ibunitsym); + end; + +{**************************************************************************** + TNAMESPACESYM +****************************************************************************} + + constructor tnamespacesym.create(const n : string); + begin + inherited create(namespacesym,n); + unitsym:=nil; + end; + + constructor tnamespacesym.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(namespacesym,ppufile); + ppufile.getderef(unitsymderef); + end; + + procedure tnamespacesym.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(unitsymderef); + ppufile.writeentry(ibnamespacesym); + end; + + procedure tnamespacesym.buildderef; + begin + inherited buildderef; + unitsymderef.build(unitsym); + end; + + procedure tnamespacesym.deref; + begin + inherited deref; + unitsym:=tsym(unitsymderef.resolve); + end; + + +{**************************************************************************** + TPROCSYM +****************************************************************************} + + constructor tprocsym.create(const n : string); + begin + inherited create(procsym,n); + FProcdefList:=TFPObjectList.Create(false); + FProcdefderefList:=nil; + { the tprocdef have their own symoptions, make the procsym + always visible } + visibility:=vis_public; + end; + + + constructor tprocsym.ppuload(ppufile:tcompilerppufile); + var + pdderef : tderef; + i, + pdcnt : longint; + begin + inherited ppuload(procsym,ppufile); + FProcdefList:=TFPObjectList.Create(false); + FProcdefDerefList:=TFPList.Create; + pdcnt:=ppufile.getword; + for i:=1 to pdcnt do + begin + ppufile.getderef(pdderef); + FProcdefDerefList.Add(Pointer(PtrInt(pdderef.dataidx))); + end; + end; + + + destructor tprocsym.destroy; + begin + FProcdefList.Free; + if assigned(FProcdefDerefList) then + FProcdefDerefList.Free; + inherited destroy; + end; + + + procedure tprocsym.ppuwrite(ppufile:tcompilerppufile); + var + i : longint; + d : tderef; + begin + inherited ppuwrite(ppufile); + ppufile.putword(FProcdefDerefList.Count); + for i:=0 to FProcdefDerefList.Count-1 do + begin + d.dataidx:=PtrInt(FProcdefDerefList[i]); + ppufile.putderef(d); + end; + ppufile.writeentry(ibprocsym); + end; + + + procedure tprocsym.write_parameter_lists(skipdef:tprocdef); + var + i : longint; + pd : tprocdef; + begin + for i:=0 to ProcdefList.Count-1 do + begin + pd:=tprocdef(ProcdefList[i]); + if pd<>skipdef then + MessagePos1(pd.fileinfo,sym_h_param_list,pd.fullprocname(false)); + end; + end; + + + procedure tprocsym.check_forward; + var + i : longint; + pd : tprocdef; + begin + for i:=0 to ProcdefList.Count-1 do + begin + pd:=tprocdef(ProcdefList[i]); + if (pd.owner=owner) and (pd.forwarddef) then + begin + { For mode macpas. Make implicit externals (procedures declared in the interface + section which do not have a counterpart in the implementation) + to be an imported procedure } + if (m_mac in current_settings.modeswitches) and + (pd.interfacedef) then + begin + pd.setmangledname(target_info.CPrefix+tprocdef(pd).procsym.realname); + if (not current_module.interface_only) then + MessagePos1(pd.fileinfo,sym_w_forward_not_resolved,pd.fullprocname(false)); + end + else + begin + MessagePos1(pd.fileinfo,sym_e_forward_not_resolved,pd.fullprocname(false)); + end; + { Turn further error messages off } + pd.forwarddef:=false; + end; + end; + end; + + + procedure tprocsym.buildderef; + var + i : longint; + pd : tprocdef; + d : tderef; + begin + if not assigned(FProcdefDerefList) then + FProcdefDerefList:=TFPList.Create + else + FProcdefDerefList.Clear; + for i:=0 to ProcdefList.Count-1 do + begin + pd:=tprocdef(ProcdefList[i]); + { only write the proc definitions that belong + to this procsym and are in the global symtable } + if pd.owner=owner then + begin + d.build(pd); + FProcdefDerefList.Add(Pointer(PtrInt(d.dataidx))); + end; + end; + end; + + + procedure tprocsym.deref; + var + i : longint; + pd : tprocdef; + d : tderef; + begin + { Clear all procdefs } + ProcdefList.Clear; + if not assigned(FProcdefDerefList) then + internalerror(200611031); + for i:=0 to FProcdefDerefList.Count-1 do + begin + d.dataidx:=PtrInt(FProcdefDerefList[i]); + pd:=tprocdef(d.resolve); + ProcdefList.Add(pd); + end; + end; + + + function Tprocsym.Find_procdef_bytype(pt:Tproctypeoption):Tprocdef; + var + i : longint; + pd : tprocdef; + begin + result:=nil; + for i:=0 to ProcdefList.Count-1 do + begin + pd:=tprocdef(ProcdefList[i]); + if pd.proctypeoption=pt then + begin + result:=pd; + exit; + end; + end; + end; + + + function Tprocsym.Find_procdef_bypara(para:TFPObjectList;retdef:tdef; + cpoptions:tcompare_paras_options):Tprocdef; + var + i : longint; + pd : tprocdef; + eq : tequaltype; + begin + result:=nil; + for i:=0 to ProcdefList.Count-1 do + begin + pd:=tprocdef(ProcdefList[i]); + if assigned(retdef) then + eq:=compare_defs(retdef,pd.returndef,nothingn) + else + eq:=te_equal; + if (eq>=te_equal) or + ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then + begin + eq:=compare_paras(para,pd.paras,cp_value_equal_const,cpoptions); + if (eq>=te_equal) or + ((cpo_allowconvert in cpoptions) and (eq>te_incompatible)) then + begin + result:=pd; + exit; + end; + end; + end; + end; + + function tprocsym.find_procdef_byoptions(ops: tprocoptions): Tprocdef; + var + i : longint; + pd : tprocdef; + begin + result:=nil; + for i:=0 to ProcdefList.Count-1 do + begin + pd:=tprocdef(ProcdefList[i]); + if ops * pd.procoptions = ops then + begin + result:=pd; + exit; + end; + end; + end; + + function Tprocsym.Find_procdef_byprocvardef(d:Tprocvardef):Tprocdef; + var + i : longint; + bestpd, + pd : tprocdef; + eq,besteq : tequaltype; + sym: tsym; + ps: tprocsym; + begin + { This function will return the pprocdef of pprocsym that + is the best match for procvardef. When there are multiple + matches it returns nil.} + result:=nil; + bestpd:=nil; + besteq:=te_incompatible; + ps:=self; + repeat + for i:=0 to ps.ProcdefList.Count-1 do + begin + pd:=tprocdef(ps.ProcdefList[i]); + eq:=proc_to_procvar_equal(pd,d,false); + if eq>=te_convert_l1 then + begin + { multiple procvars with the same equal level } + if assigned(bestpd) and + (besteq=eq) then + exit; + if eq>besteq then + begin + besteq:=eq; + bestpd:=pd; + end; + end; + end; + { maybe TODO: also search class helpers? -- this code is similar to + what happens in htypechk in + tcallcandidates.collect_overloads_in_struct: keep searching in + parent types in case the currently found procdef is marked as + "overload" and we haven't found a proper match yet } + if assigned(ps.owner.defowner) and + (ps.owner.defowner.typ=objectdef) and + assigned(tobjectdef(ps.owner.defowner).childof) and + (not assigned(bestpd) or + (po_overload in bestpd.procoptions)) then + begin + sym:=tsym(tobjectdef(ps.owner.defowner).childof.symtable.find(ps.name)); + if assigned(sym) and + (sym.typ=procsym) then + ps:=tprocsym(sym) + else + ps:=nil; + end + else + ps:=nil; + until (besteq>=te_equal) or + not assigned(ps); + result:=bestpd; + end; + + + function Tprocsym.Find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef; + var + paraidx, realparamcount, + i, j : longint; + bestpd, + hpd, + pd : tprocdef; + convtyp : tconverttype; + eq : tequaltype; + begin + { This function will return the pprocdef of pprocsym that + is the best match for fromdef and todef. } + result:=nil; + bestpd:=nil; + besteq:=te_incompatible; + for i:=0 to ProcdefList.Count-1 do + begin + pd:=tprocdef(ProcdefList[i]); + if (pd.owner.symtabletype=staticsymtable) and not pd.owner.iscurrentunit then + continue; + if (equal_defs(todef,pd.returndef) or + { shortstrings of different lengths are ok as result } + (is_shortstring(todef) and is_shortstring(pd.returndef))) and + { the result type must be always really equal and not an alias, + if you mess with this code, check tw4093 } + ((todef=pd.returndef) or + ( + not(df_unique in todef.defoptions) and + not(df_unique in pd.returndef.defoptions) + ) + ) then + begin + paraidx:=0; + { ignore vs_hidden parameters } + while (paraidx<pd.paras.count) and + assigned(pd.paras[paraidx]) and + (vo_is_hidden_para in tparavarsym(pd.paras[paraidx]).varoptions) do + inc(paraidx); + realparamcount:=0; + for j := 0 to pd.paras.Count-1 do + if assigned(pd.paras[j]) and not (vo_is_hidden_para in tparavarsym(pd.paras[j]).varoptions) then + inc(realparamcount); + if (paraidx<pd.paras.count) and + assigned(pd.paras[paraidx]) and + (realparamcount = 1) then + begin + eq:=compare_defs_ext(fromdef,tparavarsym(pd.paras[paraidx]).vardef,nothingn,convtyp,hpd,[]); + + { alias? if yes, only l1 choice, + if you mess with this code, check tw4093 } + if (eq=te_exact) and + (fromdef<>tparavarsym(pd.paras[paraidx]).vardef) and + ((df_unique in fromdef.defoptions) or + (df_unique in tparavarsym(pd.paras[paraidx]).vardef.defoptions)) then + eq:=te_convert_l1; + + if eq=te_exact then + begin + besteq:=eq; + result:=pd; + exit; + end; + if eq>besteq then + begin + bestpd:=pd; + besteq:=eq; + end; + end; + end; + end; + result:=bestpd; + end; + + function Tprocsym.find_procdef_enumerator_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef; + var + paraidx, realparamcount, + i, j : longint; + bestpd, + hpd, + pd : tprocdef; + current : tpropertysym; + convtyp : tconverttype; + eq : tequaltype; + begin + { This function will return the pprocdef of pprocsym that + is the best match for fromdef and todef. } + result:=nil; + bestpd:=nil; + besteq:=te_incompatible; + for i:=0 to ProcdefList.Count-1 do + begin + pd:=tprocdef(ProcdefList[i]); + if (pd.owner.symtabletype=staticsymtable) and not pd.owner.iscurrentunit then + continue; + if not (is_class_or_interface_or_object(pd.returndef) or is_record(pd.returndef)) then + continue; + current := tpropertysym(tabstractrecorddef(pd.returndef).search_enumerator_current); + if (current = nil) then + continue; + // compare current result def with the todef + if (equal_defs(todef, current.propdef) or + { shortstrings of different lengths are ok as result } + (is_shortstring(todef) and is_shortstring(current.propdef))) and + { the result type must be always really equal and not an alias, + if you mess with this code, check tw4093 } + ((todef=current.propdef) or + ( + not(df_unique in todef.defoptions) and + not(df_unique in current.propdef.defoptions) + ) + ) then + begin + paraidx:=0; + { ignore vs_hidden parameters } + while (paraidx<pd.paras.count) and + assigned(pd.paras[paraidx]) and + (vo_is_hidden_para in tparavarsym(pd.paras[paraidx]).varoptions) do + inc(paraidx); + realparamcount:=0; + for j := 0 to pd.paras.Count-1 do + if assigned(pd.paras[j]) and not (vo_is_hidden_para in tparavarsym(pd.paras[j]).varoptions) then + inc(realparamcount); + if (paraidx<pd.paras.count) and + assigned(pd.paras[paraidx]) and + (realparamcount = 1) then + begin + eq:=compare_defs_ext(fromdef,tparavarsym(pd.paras[paraidx]).vardef,nothingn,convtyp,hpd,[]); + + { alias? if yes, only l1 choice, + if you mess with this code, check tw4093 } + if (eq=te_exact) and + (fromdef<>tparavarsym(pd.paras[paraidx]).vardef) and + ((df_unique in fromdef.defoptions) or + (df_unique in tparavarsym(pd.paras[paraidx]).vardef.defoptions)) then + eq:=te_convert_l1; + + if eq=te_exact then + begin + besteq:=eq; + result:=pd; + exit; + end; + if eq>besteq then + begin + bestpd:=pd; + besteq:=eq; + end; + end; + end; + end; + result:=bestpd; + end; + + +{**************************************************************************** + TERRORSYM +****************************************************************************} + + constructor terrorsym.create; + begin + inherited create(errorsym,''); + end; + +{**************************************************************************** + TPROPERTYSYM +****************************************************************************} + + constructor tpropertysym.create(const n : string); + var + pap : tpropaccesslisttypes; + begin + inherited create(propertysym,n); + propoptions:=[]; + index:=0; + default:=0; + propdef:=nil; + indexdef:=nil; + parast:=nil; + for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do + propaccesslist[pap]:=tpropaccesslist.create; + end; + + + constructor tpropertysym.ppuload(ppufile:tcompilerppufile); + var + pap : tpropaccesslisttypes; + begin + inherited ppuload(propertysym,ppufile); + ppufile.getsmallset(propoptions); + if ppo_overrides in propoptions then + ppufile.getderef(overriddenpropsymderef); + ppufile.getderef(propdefderef); + index:=ppufile.getlongint; + default:=ppufile.getlongint; + ppufile.getderef(indexdefderef); + for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do + propaccesslist[pap]:=ppufile.getpropaccesslist; + if [ppo_hasparameters,ppo_overrides]*propoptions=[ppo_hasparameters] then + begin + parast:=tparasymtable.create(nil,0); + tparasymtable(parast).ppuload(ppufile); + end + else + parast:=nil; + end; + + + destructor tpropertysym.destroy; + var + pap : tpropaccesslisttypes; + begin + for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do + propaccesslist[pap].free; + parast.free; + inherited destroy; + end; + + + procedure tpropertysym.buildderef; + var + pap : tpropaccesslisttypes; + begin + propdefderef.build(propdef); + indexdefderef.build(indexdef); + for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do + propaccesslist[pap].buildderef; + if ppo_overrides in propoptions then + overriddenpropsymderef.build(overriddenpropsym) + else + if ppo_hasparameters in propoptions then + tparasymtable(parast).buildderef; + end; + + + procedure tpropertysym.deref; + var + pap : tpropaccesslisttypes; + begin + indexdef:=tdef(indexdefderef.resolve); + propdef:=tdef(propdefderef.resolve); + for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do + propaccesslist[pap].resolve; + + if ppo_overrides in propoptions then + begin + overriddenpropsym:=tpropertysym(overriddenpropsymderef.resolve); + if ppo_hasparameters in propoptions then + parast:=overriddenpropsym.parast.getcopy; + end + else + if ppo_hasparameters in propoptions then + tparasymtable(parast).deref + end; + + + function tpropertysym.getsize : asizeint; + begin + getsize:=0; + end; + + + procedure tpropertysym.ppuwrite(ppufile:tcompilerppufile); + var + pap : tpropaccesslisttypes; + begin + inherited ppuwrite(ppufile); + ppufile.putsmallset(propoptions); + if ppo_overrides in propoptions then + ppufile.putderef(overriddenpropsymderef); + ppufile.putderef(propdefderef); + ppufile.putlongint(index); + ppufile.putlongint(default); + ppufile.putderef(indexdefderef); + for pap:=low(tpropaccesslisttypes) to high(tpropaccesslisttypes) do + ppufile.putpropaccesslist(propaccesslist[pap]); + ppufile.writeentry(ibpropertysym); + if [ppo_hasparameters,ppo_overrides]*propoptions=[ppo_hasparameters] then + tparasymtable(parast).ppuwrite(ppufile); + end; + + +{**************************************************************************** + TABSTRACTVARSYM +****************************************************************************} + + constructor tabstractvarsym.create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions); + begin + inherited create(st,n); + vardef:=def; + varspez:=vsp; + varstate:=vs_declared; + varoptions:=vopts; + end; + + + constructor tabstractvarsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile); + begin + inherited ppuload(st,ppufile); + varstate:=vs_readwritten; + varspez:=tvarspez(ppufile.getbyte); + varregable:=tvarregable(ppufile.getbyte); + addr_taken:=boolean(ppufile.getbyte); + ppufile.getderef(vardefderef); + ppufile.getsmallset(varoptions); + end; + + + destructor tabstractvarsym.destroy; + begin + if assigned(notifications) then + notifications.destroy; + inherited destroy; + end; + + + procedure tabstractvarsym.buildderef; + begin + vardefderef.build(vardef); + end; + + + procedure tabstractvarsym.deref; + var + oldvarregable: tvarregable; + begin + { setting the vardef also updates varregable. We just loaded this } + { value from a ppu, so it must not be changed (e.g. tw7817a.pp/ } + { tw7817b.pp: the address is taken of a local variable in an } + { inlined procedure -> must remain non-regable when inlining) } + oldvarregable:=varregable; + vardef:=tdef(vardefderef.resolve); + varregable:=oldvarregable; + end; + + + procedure tabstractvarsym.ppuwrite(ppufile:tcompilerppufile); + var + oldintfcrc : boolean; + begin + inherited ppuwrite(ppufile); + ppufile.putbyte(byte(varspez)); + oldintfcrc:=ppufile.do_crc; + ppufile.do_crc:=false; + ppufile.putbyte(byte(varregable)); + ppufile.putbyte(byte(addr_taken)); + ppufile.do_crc:=oldintfcrc; + ppufile.putderef(vardefderef); + ppufile.putsmallset(varoptions); + end; + + + function tabstractvarsym.getsize : asizeint; + begin + if assigned(vardef) and + ((vardef.typ<>arraydef) or + is_dynamic_array(vardef) or + (tarraydef(vardef).highrange>=tarraydef(vardef).lowrange)) then + result:=vardef.size + else + result:=0; + end; + + + function tabstractvarsym.getpackedbitsize : longint; + begin + { bitpacking is only done for ordinals } + if not is_ordinal(vardef) then + internalerror(2006082010); + result:=vardef.packedbitsize; + end; + + + function tabstractvarsym.is_regvar(refpara: boolean):boolean; + begin + { Register variables are not allowed in the following cases: + - regvars are disabled + - exceptions are used (after an exception is raised the contents of the + registers is not valid anymore) + - it has a local copy + - the value needs to be in memory (i.e. reference counted) } + result:=(cs_opt_regvar in current_settings.optimizerswitches) and + not(pi_has_assembler_block in current_procinfo.flags) and + not(pi_uses_exceptions in current_procinfo.flags) and + not(pi_has_interproclabel in current_procinfo.flags) and + not(vo_has_local_copy in varoptions) and + ((refpara and + (varregable <> vr_none)) or + (not refpara and + not(varregable in [vr_none,vr_addr]))) +{$if not defined(powerpc) and not defined(powerpc64)} + and ((vardef.typ <> recorddef) or + (varregable = vr_addr) or + not(varstate in [vs_written,vs_readwritten])); +{$endif} + end; + + + procedure tabstractvarsym.trigger_notifications(what:Tnotification_flag); + + var n:Tnotification; + + begin + if assigned(notifications) then + begin + n:=Tnotification(notifications.first); + while assigned(n) do + begin + if what in n.flags then + n.callback(what,self); + n:=Tnotification(n.next); + end; + end; + end; + + function Tabstractvarsym.register_notification(flags:Tnotification_flags;callback: + Tnotification_callback):cardinal; + + var n:Tnotification; + + begin + if not assigned(notifications) then + notifications:=Tlinkedlist.create; + n:=Tnotification.create(flags,callback); + register_notification:=n.id; + notifications.concat(n); + end; + + procedure Tabstractvarsym.unregister_notification(id:cardinal); + + var n:Tnotification; + + begin + if not assigned(notifications) then + internalerror(200212311) + else + begin + n:=Tnotification(notifications.first); + while assigned(n) do + begin + if n.id=id then + begin + notifications.remove(n); + n.destroy; + exit; + end; + n:=Tnotification(n.next); + end; + internalerror(200212311) + end; + end; + + procedure tabstractvarsym.setvardef(def:tdef); + begin + _vardef := def; + { can we load the value into a register ? } + if not assigned(owner) or + (owner.symtabletype in [localsymtable,parasymtable]) or + ( + (owner.symtabletype=staticsymtable) and + not(cs_create_pic in current_settings.moduleswitches) + ) then + begin + if tstoreddef(vardef).is_intregable then + varregable:=vr_intreg + else +{ $warning TODO: no fpu regvar in staticsymtable yet, need initialization with 0 } + if {( + not assigned(owner) or + (owner.symtabletype<>staticsymtable) + ) and } + tstoreddef(vardef).is_fpuregable then + begin + if use_vectorfpu(vardef) then + varregable:=vr_mmreg + else + varregable:=vr_fpureg; + end; + end; + end; + + +{**************************************************************************** + TFIELDVARSYM +****************************************************************************} + + constructor tfieldvarsym.create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions); + begin + inherited create(fieldvarsym,n,vsp,def,vopts); + fieldoffset:=-1; + end; + + + constructor tfieldvarsym.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(fieldvarsym,ppufile); + fieldoffset:=ppufile.getaint; + end; + + + procedure tfieldvarsym.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putaint(fieldoffset); + ppufile.writeentry(ibfieldvarsym); + end; + + + function tfieldvarsym.mangledname:string; + var + srsym : tsym; + srsymtable : tsymtable; + begin + if sp_static in symoptions then + begin + if searchsym(lower(owner.name^)+'_'+name,srsym,srsymtable) then + result:=srsym.mangledname + { when generating the debug info for the module in which the } + { symbol is defined, the localsymtable of that module is } + { already popped from the symtablestack } + else if searchsym_in_module(current_module,lower(owner.name^)+'_'+name,srsym,srsymtable) then + result:=srsym.mangledname + else + internalerror(2007012501); + end + else if is_objcclass(tdef(owner.defowner)) then + begin + if assigned(objcoffsetmangledname) then + result:=objcoffsetmangledname^ + else + begin + result:=target_info.cprefix+'OBJC_IVAR_$_'+tobjectdef(owner.defowner).objextname^+'.'+RealName; + objcoffsetmangledname:=stringdup(result); + end; + end + else + result:=inherited mangledname; + end; + + + destructor tfieldvarsym.destroy; + begin + stringdispose(objcoffsetmangledname); + inherited destroy; + end; + + +{**************************************************************************** + TABSTRACTNORMALVARSYM +****************************************************************************} + + constructor tabstractnormalvarsym.create(st:tsymtyp;const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions); + begin + inherited create(st,n,vsp,def,vopts); + fillchar(localloc,sizeof(localloc),0); + fillchar(initialloc,sizeof(initialloc),0); + defaultconstsym:=nil; + end; + + + constructor tabstractnormalvarsym.ppuload(st:tsymtyp;ppufile:tcompilerppufile); + begin + inherited ppuload(st,ppufile); + fillchar(localloc,sizeof(localloc),0); + fillchar(initialloc,sizeof(initialloc),0); + ppufile.getderef(defaultconstsymderef); + end; + + + procedure tabstractnormalvarsym.buildderef; + begin + inherited buildderef; + defaultconstsymderef.build(defaultconstsym); + end; + + + procedure tabstractnormalvarsym.deref; + begin + inherited deref; + defaultconstsym:=tsym(defaultconstsymderef.resolve); + end; + + + procedure tabstractnormalvarsym.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(defaultconstsymderef); + end; + + +{**************************************************************************** + Tstaticvarsym +****************************************************************************} + + constructor tstaticvarsym.create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions); + begin + inherited create(staticvarsym,n,vsp,def,vopts); + _mangledname:=nil; + end; + + + constructor tstaticvarsym.create_dll(const n : string;vsp:tvarspez;def:tdef); + begin + tstaticvarsym(self).create(n,vsp,def,[vo_is_dll_var]); + end; + + + constructor tstaticvarsym.create_C(const n,mangled : string;vsp:tvarspez;def:tdef); + begin + tstaticvarsym(self).create(n,vsp,def,[]); + set_mangledname(mangled); + end; + + + constructor tstaticvarsym.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(staticvarsym,ppufile); + if vo_has_mangledname in varoptions then + _mangledname:=stringdup(ppufile.getstring) + else + _mangledname:=nil; + if vo_has_section in varoptions then + section:=ppufile.getansistring; + end; + + + destructor tstaticvarsym.destroy; + begin + if assigned(_mangledname) then + begin +{$ifdef MEMDEBUG} + memmanglednames.start; +{$endif MEMDEBUG} + stringdispose(_mangledname); +{$ifdef MEMDEBUG} + memmanglednames.stop; +{$endif MEMDEBUG} + end; + inherited destroy; + end; + + + procedure tstaticvarsym.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + if vo_has_mangledname in varoptions then + ppufile.putstring(_mangledname^); + if vo_has_section in varoptions then + ppufile.putansistring(section); + ppufile.writeentry(ibstaticvarsym); + end; + + + function tstaticvarsym.mangledname:string; + var + prefix : string[2]; + begin + if not assigned(_mangledname) then + begin + if (vo_is_typed_const in varoptions) then + prefix:='TC' + else + prefix:='U'; + {$ifdef compress} + _mangledname:=stringdup(minilzw_encode(make_mangledname(prefix,owner,name))); + {$else} + _mangledname:=stringdup(make_mangledname(prefix,owner,name)); + {$endif} + end; + result:=_mangledname^; + end; + + + procedure tstaticvarsym.set_mangledname(const s:string); + begin + stringdispose(_mangledname); + {$ifdef compress} + _mangledname:=stringdup(minilzw_encode(s)); + {$else} + _mangledname:=stringdup(s); + {$endif} + include(varoptions,vo_has_mangledname); + end; + + +{**************************************************************************** + TLOCALVARSYM +****************************************************************************} + + constructor tlocalvarsym.create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions); + begin + inherited create(localvarsym,n,vsp,def,vopts); + end; + + + constructor tlocalvarsym.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(localvarsym,ppufile); + end; + + + procedure tlocalvarsym.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.writeentry(iblocalvarsym); + end; + + +{**************************************************************************** + TPARAVARSYM +****************************************************************************} + + constructor tparavarsym.create(const n : string;nr:word;vsp:tvarspez;def:tdef;vopts:tvaroptions); + begin + inherited create(paravarsym,n,vsp,def,vopts); + if (vsp in [vs_var,vs_value,vs_const,vs_constref]) then + varstate := vs_initialised; + paranr:=nr; + paraloc[calleeside].init; + paraloc[callerside].init; + end; + + + destructor tparavarsym.destroy; + begin + paraloc[calleeside].done; + paraloc[callerside].done; + inherited destroy; + end; + + + constructor tparavarsym.ppuload(ppufile:tcompilerppufile); + var + b : byte; + begin + inherited ppuload(paravarsym,ppufile); + paranr:=ppufile.getword; + univpara:=boolean(ppufile.getbyte); + + { The var state of parameter symbols is fixed after writing them so + we write them to the unit file. + This enables constant folding for inline procedures loaded from units + } + varstate:=tvarstate(ppufile.getbyte); + + paraloc[calleeside].init; + paraloc[callerside].init; + if vo_has_explicit_paraloc in varoptions then + begin + paraloc[callerside].alignment:=ppufile.getbyte; + b:=ppufile.getbyte; + if b<>sizeof(paraloc[callerside].location^) then + internalerror(200411154); + ppufile.getdata(paraloc[callerside].add_location^,sizeof(paraloc[callerside].location^)); + paraloc[callerside].size:=paraloc[callerside].location^.size; + paraloc[callerside].intsize:=tcgsize2size[paraloc[callerside].size]; + end; + end; + + + procedure tparavarsym.ppuwrite(ppufile:tcompilerppufile); + var + oldintfcrc : boolean; + begin + inherited ppuwrite(ppufile); + ppufile.putword(paranr); + ppufile.putbyte(byte(univpara)); + + { The var state of parameter symbols is fixed after writing them so + we write them to the unit file. + This enables constant folding for inline procedures loaded from units + } + oldintfcrc:=ppufile.do_crc; + ppufile.do_crc:=false; + ppufile.putbyte(ord(varstate)); + ppufile.do_crc:=oldintfcrc; + + if vo_has_explicit_paraloc in varoptions then + begin + paraloc[callerside].check_simple_location; + ppufile.putbyte(sizeof(paraloc[callerside].alignment)); + ppufile.putbyte(sizeof(paraloc[callerside].location^)); + ppufile.putdata(paraloc[callerside].location^,sizeof(paraloc[callerside].location^)); + end; + ppufile.writeentry(ibparavarsym); + end; + + function tparavarsym.needs_finalization:boolean; + begin + result:=(varspez=vs_value) and + (is_managed_type(vardef) or + ( + (not (tabstractprocdef(owner.defowner).proccalloption in cdecl_pocalls)) and + (not paramanager.use_stackalloc) and + (is_open_array(vardef) or is_array_of_const(vardef)) + ) + ); + end; + +{**************************************************************************** + TABSOLUTEVARSYM +****************************************************************************} + + constructor tabsolutevarsym.create(const n : string;def:tdef); + begin + inherited create(absolutevarsym,n,vs_value,def,[]); + ref:=nil; + end; + + + constructor tabsolutevarsym.create_ref(const n : string;def:tdef;_ref:tpropaccesslist); + begin + inherited create(absolutevarsym,n,vs_value,def,[]); + ref:=_ref; + end; + + + destructor tabsolutevarsym.destroy; + begin + if assigned(ref) then + ref.free; + inherited destroy; + end; + + + constructor tabsolutevarsym.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(absolutevarsym,ppufile); + ref:=nil; + asmname:=nil; + abstyp:=absolutetyp(ppufile.getbyte); +{$ifdef i386} + absseg:=false; +{$endif i386} + case abstyp of + tovar : + ref:=ppufile.getpropaccesslist; + toasm : + asmname:=stringdup(ppufile.getstring); + toaddr : + begin + addroffset:=ppufile.getaword; +{$ifdef i386} + absseg:=boolean(ppufile.getbyte); +{$endif i386} + end; + end; + end; + + + procedure tabsolutevarsym.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putbyte(byte(abstyp)); + case abstyp of + tovar : + ppufile.putpropaccesslist(ref); + toasm : + ppufile.putstring(asmname^); + toaddr : + begin + ppufile.putaword(addroffset); +{$ifdef i386} + ppufile.putbyte(byte(absseg)); +{$endif i386} + end; + end; + ppufile.writeentry(ibabsolutevarsym); + end; + + + procedure tabsolutevarsym.buildderef; + begin + inherited buildderef; + if (abstyp=tovar) then + ref.buildderef; + end; + + + procedure tabsolutevarsym.deref; + begin + inherited deref; + { own absolute deref } + if (abstyp=tovar) then + ref.resolve; + end; + + + function tabsolutevarsym.mangledname : string; + begin + case abstyp of + toasm : + mangledname:=asmname^; + toaddr : + mangledname:='$'+tostr(addroffset); + else + internalerror(200411062); + end; + end; + + +{**************************************************************************** + TCONSTSYM +****************************************************************************} + + constructor tconstsym.create_ord(const n : string;t : tconsttyp;v : tconstexprint;def:tdef); + begin + inherited create(constsym,n); + fillchar(value, sizeof(value), #0); + consttyp:=t; + value.valueord:=v; + constdef:=def; + end; + + + constructor tconstsym.create_ordptr(const n : string;t : tconsttyp;v : tconstptruint;def:tdef); + begin + inherited create(constsym,n); + fillchar(value, sizeof(value), #0); + consttyp:=t; + value.valueordptr:=v; + constdef:=def; + end; + + + constructor tconstsym.create_ptr(const n : string;t : tconsttyp;v : pointer;def:tdef); + begin + inherited create(constsym,n); + fillchar(value, sizeof(value), #0); + consttyp:=t; + value.valueptr:=v; + constdef:=def; + end; + + + constructor tconstsym.create_string(const n : string;t : tconsttyp;str:pchar;l:longint); + begin + inherited create(constsym,n); + fillchar(value, sizeof(value), #0); + consttyp:=t; + value.valueptr:=str; + constdef:=nil; + value.len:=l; + end; + + + constructor tconstsym.create_wstring(const n : string;t : tconsttyp;pw:pcompilerwidestring); + begin + inherited create(constsym,n); + fillchar(value, sizeof(value), #0); + consttyp:=t; + pcompilerwidestring(value.valueptr):=pw; + constdef:=nil; + value.len:=getlengthwidestring(pw); + end; + + + constructor tconstsym.ppuload(ppufile:tcompilerppufile); + var + pd : pbestreal; + ps : pnormalset; + pc : pchar; + pw : pcompilerwidestring; + i : longint; + begin + inherited ppuload(constsym,ppufile); + constdef:=nil; + consttyp:=tconsttyp(ppufile.getbyte); + fillchar(value, sizeof(value), #0); + case consttyp of + constord : + begin + ppufile.getderef(constdefderef); + value.valueord:=ppufile.getexprint; + end; + constpointer : + begin + ppufile.getderef(constdefderef); + value.valueordptr:=ppufile.getptruint; + end; + constwstring : + begin + initwidestring(pw); + setlengthwidestring(pw,ppufile.getlongint); + { don't use getdata, because the compilerwidechars may have to + be byteswapped + } +{$if sizeof(tcompilerwidechar) = 2} + for i:=0 to pw^.len-1 do + pw^.data[i]:=ppufile.getword; +{$elseif sizeof(tcompilerwidechar) = 4} + for i:=0 to pw^.len-1 do + pw^.data[i]:=cardinal(ppufile.getlongint); +{$else} + {$error Unsupported tcompilerwidechar size} +{$endif} + pcompilerwidestring(value.valueptr):=pw; + end; + conststring, + constresourcestring : + begin + value.len:=ppufile.getlongint; + getmem(pc,value.len+1); + ppufile.getdata(pc^,value.len); + pc[value.len]:=#0; + value.valueptr:=pc; + end; + constreal : + begin + new(pd); + pd^:=ppufile.getreal; + value.valueptr:=pd; + end; + constset : + begin + ppufile.getderef(constdefderef); + new(ps); + ppufile.getnormalset(ps^); + value.valueptr:=ps; + end; + constguid : + begin + new(pguid(value.valueptr)); + ppufile.getdata(value.valueptr^,sizeof(tguid)); + end; + constnil : ; + else + Message1(unit_f_ppu_invalid_entry,tostr(ord(consttyp))); + end; + end; + + + destructor tconstsym.destroy; + begin + case consttyp of + conststring, + constresourcestring : + freemem(pchar(value.valueptr),value.len+1); + constwstring : + donewidestring(pcompilerwidestring(value.valueptr)); + constreal : + dispose(pbestreal(value.valueptr)); + constset : + dispose(pnormalset(value.valueptr)); + constguid : + dispose(pguid(value.valueptr)); + end; + inherited destroy; + end; + + + procedure tconstsym.buildderef; + begin + if consttyp in [constord,constpointer,constset] then + constdefderef.build(constdef); + end; + + + procedure tconstsym.deref; + begin + if consttyp in [constord,constpointer,constset] then + constdef:=tdef(constdefderef.resolve); + end; + + + procedure tconstsym.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putbyte(byte(consttyp)); + case consttyp of + constnil : ; + constord : + begin + ppufile.putderef(constdefderef); + ppufile.putexprint(value.valueord); + end; + constpointer : + begin + ppufile.putderef(constdefderef); + ppufile.putptruint(value.valueordptr); + end; + constwstring : + begin + ppufile.putlongint(getlengthwidestring(pcompilerwidestring(value.valueptr))); + ppufile.putdata(pcompilerwidestring(value.valueptr)^.data^,pcompilerwidestring(value.valueptr)^.len*sizeof(tcompilerwidechar)); + end; + conststring, + constresourcestring : + begin + ppufile.putlongint(value.len); + ppufile.putdata(pchar(value.valueptr)^,value.len); + end; + constreal : + ppufile.putreal(pbestreal(value.valueptr)^); + constset : + begin + ppufile.putderef(constdefderef); + ppufile.putnormalset(value.valueptr^); + end; + constguid : + ppufile.putdata(value.valueptr^,sizeof(tguid)); + else + internalerror(13); + end; + ppufile.writeentry(ibconstsym); + end; + + +{**************************************************************************** + TENUMSYM +****************************************************************************} + + constructor tenumsym.create(const n : string;def : tenumdef;v : longint); + begin + inherited create(enumsym,n); + definition:=def; + value:=v; + end; + + + constructor tenumsym.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(enumsym,ppufile); + ppufile.getderef(definitionderef); + value:=ppufile.getlongint; + end; + + + procedure tenumsym.buildderef; + begin + definitionderef.build(definition); + end; + + + procedure tenumsym.deref; + begin + definition:=tenumdef(definitionderef.resolve); + end; + + procedure tenumsym.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(definitionderef); + ppufile.putlongint(value); + ppufile.writeentry(ibenumsym); + end; + + +{**************************************************************************** + TTYPESYM +****************************************************************************} + + constructor ttypesym.create(const n : string;def:tdef); + + begin + inherited create(typesym,n); + typedef:=def; + { register the typesym for the definition } + if assigned(typedef) and + (typedef.typ<>errordef) and + not(assigned(typedef.typesym)) then + typedef.typesym:=self; + end; + + + constructor ttypesym.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(typesym,ppufile); + ppufile.getderef(typedefderef); + fprettyname:=ppufile.getansistring; + end; + + + procedure ttypesym.buildderef; + begin + typedefderef.build(typedef); + end; + + + procedure ttypesym.deref; + begin + typedef:=tdef(typedefderef.resolve); + end; + + + procedure ttypesym.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(typedefderef); + ppufile.putansistring(fprettyname); + ppufile.writeentry(ibtypesym); + end; + + + function ttypesym.prettyname : string; + begin + if fprettyname<>'' then + result:=fprettyname + else + result:=inherited prettyname; + end; + + +{**************************************************************************** + TSYSSYM +****************************************************************************} + + constructor tsyssym.create(const n : string;l : longint); + begin + inherited create(syssym,n); + number:=l; + end; + + constructor tsyssym.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(syssym,ppufile); + number:=ppufile.getlongint; + end; + + destructor tsyssym.destroy; + begin + inherited destroy; + end; + + procedure tsyssym.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putlongint(number); + ppufile.writeentry(ibsyssym); + end; + + +{***************************************************************************** + TMacro +*****************************************************************************} + + constructor tmacro.create(const n : string); + begin + inherited create(macrosym,n); + owner:=nil; + defined:=false; + is_used:=false; + is_compiler_var:=false; + buftext:=nil; + buflen:=0; + end; + + constructor tmacro.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(macrosym,ppufile); + defined:=boolean(ppufile.getbyte); + is_compiler_var:=boolean(ppufile.getbyte); + is_used:=false; + buflen:= ppufile.getlongint; + if buflen > 0 then + begin + getmem(buftext, buflen); + ppufile.getdata(buftext^, buflen) + end + else + buftext:=nil; + end; + + destructor tmacro.destroy; + begin + if assigned(buftext) then + freemem(buftext); + inherited destroy; + end; + + procedure tmacro.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putbyte(byte(defined)); + ppufile.putbyte(byte(is_compiler_var)); + ppufile.putlongint(buflen); + if buflen > 0 then + ppufile.putdata(buftext^,buflen); + ppufile.writeentry(ibmacrosym); + end; + + + function tmacro.GetCopy:tmacro; + var + p : tmacro; + begin + p:=tmacro.create(realname); + p.defined:=defined; + p.is_used:=is_used; + p.is_compiler_var:=is_compiler_var; + p.buflen:=buflen; + if assigned(buftext) then + begin + getmem(p.buftext,buflen); + move(buftext^,p.buftext^,buflen); + end; + Result:=p; + end; + +end. diff --git a/closures/compiler/symtable.pas b/closures/compiler/symtable.pas new file mode 100644 index 0000000000..9f382ae279 --- /dev/null +++ b/closures/compiler/symtable.pas @@ -0,0 +1,3217 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller + + This unit handles the symbol 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 symtable; + +{$i fpcdefs.inc} + +interface + + uses + { common } + cutils,cclasses, + { global } + cpuinfo,globtype,tokens, + { symtable } + symconst,symbase,symtype,symdef,symsym, + { ppu } + ppu, + { assembler } + aasmtai,aasmdata + ; + + +{**************************************************************************** + Symtable types +****************************************************************************} + + type + tstoredsymtable = class(TSymtable) + private + b_needs_init_final : boolean; + procedure _needs_init_final(sym:TObject;arg:pointer); + procedure check_forward(sym:TObject;arg:pointer); + procedure labeldefined(sym:TObject;arg:pointer); + procedure varsymbolused(sym:TObject;arg:pointer); + procedure TestPrivate(sym:TObject;arg:pointer); + procedure objectprivatesymbolused(sym:TObject;arg:pointer); + procedure loaddefs(ppufile:tcompilerppufile); + procedure loadsyms(ppufile:tcompilerppufile); + procedure writedefs(ppufile:tcompilerppufile); + procedure writesyms(ppufile:tcompilerppufile); + public + procedure insert(sym:TSymEntry;checkdup:boolean=true);override; + procedure delete(sym:TSymEntry);override; + { load/write } + procedure ppuload(ppufile:tcompilerppufile);virtual; + procedure ppuwrite(ppufile:tcompilerppufile);virtual; + procedure buildderef;virtual; + procedure buildderefimpl;virtual; + procedure deref;virtual; + procedure derefimpl;virtual; + function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override; + procedure allsymbolsused; + procedure allprivatesused; + procedure check_forwards; + procedure checklabels; + function needs_init_final : boolean; + procedure testfordefaultproperty(sym:TObject;arg:pointer); + end; + + tabstractrecordsymtable = class(tstoredsymtable) + public + usefieldalignment, { alignment to use for fields (PACKRECORDS value), C_alignment is C style } + recordalignment, { alignment desired when inserting this record } + fieldalignment, { alignment current alignment used when fields are inserted } + padalignment : shortint; { size to a multiple of which the symtable has to be rounded up } + constructor create(const n:string;usealign:shortint); + procedure ppuload(ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure alignrecord(fieldoffset:asizeint;varalign:shortint); + procedure addfield(sym:tfieldvarsym;vis:tvisibility); + procedure addalignmentpadding; + procedure insertdef(def:TDefEntry);override; + function is_packed: boolean; + function has_single_field(out sym:tfieldvarsym): boolean; + function get_unit_symtable: tsymtable; + protected + { size in bytes including padding } + _datasize : asizeint; + { size in bits of the data in case of bitpacked record. Only important during construction, } + { no need to save in/restore from ppu file. datasize is always (databitsize+7) div 8. } + databitsize : asizeint; + { size in bytes of padding } + _paddingsize : word; + procedure setdatasize(val: asizeint); + public + function iscurrentunit: boolean; override; + property datasize : asizeint read _datasize write setdatasize; + property paddingsize: word read _paddingsize write _paddingsize; + end; + + trecordsymtable = class(tabstractrecordsymtable) + public + constructor create(const n:string;usealign:shortint); + procedure insertunionst(unionst : trecordsymtable;offset : longint); + end; + + tObjectSymtable = class(tabstractrecordsymtable) + public + constructor create(adefowner:tdef;const n:string;usealign:shortint); + function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override; + end; + + { tabstractlocalsymtable } + + tabstractlocalsymtable = class(tstoredsymtable) + public + procedure ppuwrite(ppufile:tcompilerppufile);override; + function count_locals:longint; + end; + + tlocalsymtable = class(tabstractlocalsymtable) + public + constructor create(adefowner:tdef;level:byte); + function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override; + end; + + { tparasymtable } + + tparasymtable = class(tabstractlocalsymtable) + public + readonly: boolean; + constructor create(adefowner:tdef;level:byte); + function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override; + procedure insertdef(def:TDefEntry);override; + end; + + tabstractuniTSymtable = class(tstoredsymtable) + public + constructor create(const n : string;id:word); + function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override; + function iscurrentunit:boolean;override; + procedure insertunit(sym:TSymEntry); + end; + + tglobalsymtable = class(tabstractuniTSymtable) + public + unittypecount : word; + constructor create(const n : string;id:word); + procedure ppuload(ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + end; + + tstaticsymtable = class(tabstractuniTSymtable) + public + constructor create(const n : string;id:word); + procedure ppuload(ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + function checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean;override; + end; + + tspecializesymtable = class(tglobalsymtable) + public + function iscurrentunit:boolean;override; + end; + + twithsymtable = class(TSymtable) + withrefnode : tobject; { tnode } + constructor create(aowner:tdef;ASymList:TFPHashObjectList;refnode:tobject{tnode}); + destructor destroy;override; + procedure clear;override; + procedure insertdef(def:TDefEntry);override; + end; + + tstt_excepTSymtable = class(TSymtable) + public + constructor create; + end; + + tmacrosymtable = class(tstoredsymtable) + public + constructor create(exported: boolean); + end; + + { tenumsymtable } + + tenumsymtable = class(tstoredsymtable) + public + procedure insert(sym: TSymEntry; checkdup: boolean = true); override; + constructor create(adefowner:tdef); + end; + + { tarraysymtable } + + tarraysymtable = class(tstoredsymtable) + public + procedure insertdef(def:TDefEntry);override; + constructor create(adefowner:tdef); + end; + + var + systemunit : tglobalsymtable; { pointer to the system unit } + + +{**************************************************************************** + Functions +****************************************************************************} + +{*** Misc ***} + function FullTypeName(def,otherdef:tdef):string; + function generate_nested_name(symtable:tsymtable;delimiter:string):string; + procedure incompatibletypes(def1,def2:tdef); + procedure hidesym(sym:TSymEntry); + procedure duplicatesym(var hashedid:THashedIDString;dupsym,origsym:TSymEntry); + function handle_generic_dummysym(sym:TSymEntry;var symoptions:tsymoptions):boolean; + +{*** Search ***} + procedure addsymref(sym:tsym); + function is_owned_by(childdef,ownerdef:tdef):boolean; + function sym_is_owned_by(childsym:tsym;symtable:tsymtable):boolean; + function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tabstractrecorddef):boolean; + function is_visible_for_object(pd:tprocdef;contextobjdef:tabstractrecorddef):boolean; + function is_visible_for_object(sym:tsym;contextobjdef:tabstractrecorddef):boolean; + function searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean; + function searchsym_maybe_with_symoption(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;searchoption:boolean;option:tsymoption):boolean; + { searches for a symbol with the given name that has the given option in + symoptions set } + function searchsym_with_symoption(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;option:tsymoption):boolean; + function searchsym_type(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean; + function searchsym_in_module(pm:pointer;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean; + function searchsym_in_named_module(const unitname, symname: TIDString; out srsym: tsym; out srsymtable: tsymtable): boolean; + function searchsym_in_class(classh,contextclassh:tobjectdef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;searchhelper:boolean):boolean; + function searchsym_in_record(recordh:tabstractrecorddef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean; + function searchsym_in_class_by_msgint(classh:tobjectdef;msgid:longint;out srdef : tdef;out srsym:tsym;out srsymtable:TSymtable):boolean; + function searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string;out srsym:tsym;out srsymtable:TSymtable):boolean; + { searches symbols inside of a helper's implementation } + function searchsym_in_helper(classh,contextclassh:tobjectdef;const s: TIDString;out srsym:tsym;out srsymtable:TSymtable;aHasInherited:boolean):boolean; + function search_system_type(const s: TIDString): ttypesym; + function try_search_system_type(const s: TIDString): ttypesym; + function search_named_unit_globaltype(const unitname, typename: TIDString; throwerror: boolean): ttypesym; + function search_struct_member(pd : tabstractrecorddef;const s : string):tsym; + function search_assignment_operator(from_def,to_def:Tdef;explicit:boolean):Tprocdef; + function search_enumerator_operator(from_def,to_def:Tdef):Tprocdef; + { searches for the helper definition that's currently active for pd } + function search_last_objectpascal_helper(pd,contextclassh : tabstractrecorddef;out odef : tobjectdef):boolean; + { searches whether the symbol s is available in the currently active } + { helper for pd } + function search_objectpascal_helper(pd,contextclassh : tabstractrecorddef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean; + function search_objc_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean; + function search_objc_method(const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean; + {Looks for macro s (must be given in upper case) in the macrosymbolstack, } + {and returns it if found. Returns nil otherwise.} + function search_macro(const s : string):tsym; + { Additionally to searching for a macro, also checks whether it's still } + { actually defined (could be disable using "undef") } + function defined_macro(const s : string):boolean; + +{*** Object Helpers ***} + function search_default_property(pd : tabstractrecorddef) : tpropertysym; + function find_real_objcclass_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef; + +{*** Macro Helpers ***} + {If called initially, the following procedures manipulate macros in } + {initialmacrotable, otherwise they manipulate system macros local to a module.} + {Name can be given in any case (it will be converted to upper case).} + procedure def_system_macro(const name : string); + procedure set_system_macro(const name, value : string); + procedure set_system_compvar(const name, value : string); + procedure undef_system_macro(const name : string); + +{*** symtable stack ***} +{ $ifdef DEBUG + procedure test_symtablestack; + procedure list_symtablestack; + $endif DEBUG} + +{$ifdef UNITALIASES} + type + punit_alias = ^tunit_alias; + tunit_alias = object(TNamedIndexItem) + newname : pshortstring; + constructor init(const n:string); + destructor done;virtual; + end; + var + unitaliases : pdictionary; + + procedure addunitalias(const n:string); + function getunitalias(const n:string):string; +{$endif UNITALIASES} + +{*** Init / Done ***} + procedure IniTSymtable; + procedure DoneSymtable; + + const + overloaded_names : array [NOTOKEN..last_overloaded] of string[16] = ( + { NOTOKEN } 'error', + { _PLUS } 'plus', + { _MINUS } 'minus', + { _STAR } 'star', + { _SLASH } 'slash', + { _EQ } 'equal', + { _GT } 'greater', + { _LT } 'lower', + { _GTE } 'greater_or_equal', + { _LTE } 'lower_or_equal', + { _NE } 'not_equal', + { _SYMDIF } 'sym_diff', + { _STARSTAR } 'starstar', + { _OP_AS } 'as', + { _OP_IN } 'in', + { _OP_IS } 'is', + { _OP_OR } 'or', + { _OP_AND } 'and', + { _OP_DIV } 'div', + { _OP_MOD } 'mod', + { _OP_NOT } 'not', + { _OP_SHL } 'shl', + { _OP_SHR } 'shr', + { _OP_XOR } 'xor', + { _ASSIGNMENT } 'assign', + { _OP_EXPLICIT } 'explicit', + { _OP_ENUMERATOR } 'enumerator', + { _OP_INC } 'inc', + { _OP_DEC } 'dec'); + + + +implementation + + uses + { global } + verbose,globals, + { target } + systems, + { symtable } + symutil,defcmp,defutil, + { module } + fmodule, + { codegen } + procinfo + ; + + + var + dupnr : longint; { unique number for duplicate symbols } + +{***************************************************************************** + TStoredSymtable +*****************************************************************************} + + procedure tstoredsymtable.insert(sym:TSymEntry;checkdup:boolean=true); + begin + inherited insert(sym,checkdup); + end; + + + procedure tstoredsymtable.delete(sym:TSymEntry); + begin + inherited delete(sym); + end; + + + procedure tstoredsymtable.ppuload(ppufile:tcompilerppufile); + begin + { load the table's flags } + if ppufile.readentry<>ibsymtableoptions then + Message(unit_f_ppu_read_error); + ppufile.getsmallset(tableoptions); + + { load definitions } + loaddefs(ppufile); + + { load symbols } + loadsyms(ppufile); + end; + + + procedure tstoredsymtable.ppuwrite(ppufile:tcompilerppufile); + begin + { write the table's flags } + ppufile.putsmallset(tableoptions); + ppufile.writeentry(ibsymtableoptions); + + { write definitions } + writedefs(ppufile); + + { write symbols } + writesyms(ppufile); + end; + + + procedure tstoredsymtable.loaddefs(ppufile:tcompilerppufile); + var + def : tdef; + b : byte; + begin + { load start of definition section, which holds the amount of defs } + if ppufile.readentry<>ibstartdefs then + Message(unit_f_ppu_read_error); + { read definitions } + repeat + b:=ppufile.readentry; + case b of + ibpointerdef : def:=tpointerdef.ppuload(ppufile); + ibarraydef : def:=tarraydef.ppuload(ppufile); + iborddef : def:=torddef.ppuload(ppufile); + ibfloatdef : def:=tfloatdef.ppuload(ppufile); + ibprocdef : def:=tprocdef.ppuload(ppufile); + ibshortstringdef : def:=tstringdef.loadshort(ppufile); + iblongstringdef : def:=tstringdef.loadlong(ppufile); + ibansistringdef : def:=tstringdef.loadansi(ppufile); + ibwidestringdef : def:=tstringdef.loadwide(ppufile); + ibunicodestringdef : def:=tstringdef.loadunicode(ppufile); + ibrecorddef : def:=trecorddef.ppuload(ppufile); + ibobjectdef : def:=tobjectdef.ppuload(ppufile); + ibenumdef : def:=tenumdef.ppuload(ppufile); + ibsetdef : def:=tsetdef.ppuload(ppufile); + ibprocvardef : def:=tprocvardef.ppuload(ppufile); + ibfiledef : def:=tfiledef.ppuload(ppufile); + ibclassrefdef : def:=tclassrefdef.ppuload(ppufile); + ibformaldef : def:=tformaldef.ppuload(ppufile); + ibvariantdef : def:=tvariantdef.ppuload(ppufile); + ibundefineddef : def:=tundefineddef.ppuload(ppufile); + ibenddefs : break; + ibend : Message(unit_f_ppu_read_error); + else + Message1(unit_f_ppu_invalid_entry,tostr(b)); + end; + InsertDef(def); + until false; + end; + + + procedure tstoredsymtable.loadsyms(ppufile:tcompilerppufile); + var + b : byte; + sym : tsym; + begin + { load start of definition section, which holds the amount of defs } + if ppufile.readentry<>ibstartsyms then + Message(unit_f_ppu_read_error); + { now read the symbols } + repeat + b:=ppufile.readentry; + case b of + ibtypesym : sym:=ttypesym.ppuload(ppufile); + ibprocsym : sym:=tprocsym.ppuload(ppufile); + ibconstsym : sym:=tconstsym.ppuload(ppufile); + ibstaticvarsym : sym:=tstaticvarsym.ppuload(ppufile); + iblocalvarsym : sym:=tlocalvarsym.ppuload(ppufile); + ibparavarsym : sym:=tparavarsym.ppuload(ppufile); + ibfieldvarsym : sym:=tfieldvarsym.ppuload(ppufile); + ibabsolutevarsym : sym:=tabsolutevarsym.ppuload(ppufile); + ibenumsym : sym:=tenumsym.ppuload(ppufile); + ibpropertysym : sym:=tpropertysym.ppuload(ppufile); + ibunitsym : sym:=tunitsym.ppuload(ppufile); + iblabelsym : sym:=tlabelsym.ppuload(ppufile); + ibsyssym : sym:=tsyssym.ppuload(ppufile); + ibmacrosym : sym:=tmacro.ppuload(ppufile); + ibnamespacesym : sym:=tnamespacesym.ppuload(ppufile); + ibendsyms : break; + ibend : Message(unit_f_ppu_read_error); + else + Message1(unit_f_ppu_invalid_entry,tostr(b)); + end; + Insert(sym,false); + until false; + end; + + + procedure tstoredsymtable.writedefs(ppufile:tcompilerppufile); + var + i : longint; + def : tstoreddef; + begin + { each definition get a number, write then the amount of defs to the + ibstartdef entry } + ppufile.putlongint(DefList.count); + ppufile.writeentry(ibstartdefs); + { now write the definition } + for i:=0 to DefList.Count-1 do + begin + def:=tstoreddef(DefList[i]); + def.ppuwrite(ppufile); + end; + { write end of definitions } + ppufile.writeentry(ibenddefs); + end; + + + procedure tstoredsymtable.writesyms(ppufile:tcompilerppufile); + var + i : longint; + sym : Tstoredsym; + begin + { each definition get a number, write then the amount of syms and the + datasize to the ibsymdef entry } + ppufile.putlongint(SymList.count); + ppufile.writeentry(ibstartsyms); + { foreach is used to write all symbols } + for i:=0 to SymList.Count-1 do + begin + sym:=tstoredsym(SymList[i]); + sym.ppuwrite(ppufile); + end; + { end of symbols } + ppufile.writeentry(ibendsyms); + end; + + + procedure tstoredsymtable.buildderef; + var + i : longint; + def : tstoreddef; + sym : tstoredsym; + begin + { interface definitions } + for i:=0 to DefList.Count-1 do + begin + def:=tstoreddef(DefList[i]); + def.buildderef; + end; + { interface symbols } + for i:=0 to SymList.Count-1 do + begin + sym:=tstoredsym(SymList[i]); + sym.buildderef; + end; + end; + + + procedure tstoredsymtable.buildderefimpl; + var + i : longint; + def : tstoreddef; + begin + { implementation definitions } + for i:=0 to DefList.Count-1 do + begin + def:=tstoreddef(DefList[i]); + def.buildderefimpl; + end; + end; + + + procedure tstoredsymtable.deref; + var + i : longint; + def : tstoreddef; + sym : tstoredsym; + begin + { first deref the interface ttype symbols. This is needs + to be done before the interface defs are derefed, because + the interface defs can contain references to the type symbols + which then already need to contain a resolved typedef field (PFV) } + for i:=0 to SymList.Count-1 do + begin + sym:=tstoredsym(SymList[i]); + if sym.typ=typesym then + sym.deref; + end; + { interface definitions } + for i:=0 to DefList.Count-1 do + begin + def:=tstoreddef(DefList[i]); + def.deref; + end; + { interface symbols } + for i:=0 to SymList.Count-1 do + begin + sym:=tstoredsym(SymList[i]); + if sym.typ<>typesym then + sym.deref; + end; + end; + + + procedure tstoredsymtable.derefimpl; + var + i : longint; + def : tstoreddef; + begin + { implementation definitions } + for i:=0 to DefList.Count-1 do + begin + def:=tstoreddef(DefList[i]); + def.derefimpl; + end; + end; + + + function tstoredsymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean; + var + hsym : tsym; + begin + hsym:=tsym(FindWithHash(hashedid)); + if assigned(hsym) then + DuplicateSym(hashedid,sym,hsym); + result:=assigned(hsym); + end; + + +{************************************** + Callbacks +**************************************} + + procedure TStoredSymtable.check_forward(sym:TObject;arg:pointer); + begin + if tsym(sym).typ=procsym then + tprocsym(sym).check_forward + { check also object method table } + { we needn't to test the def list } + { because each object has to have a type sym, + only test objects declarations, not type renamings } + else + if (tsym(sym).typ=typesym) and + assigned(ttypesym(sym).typedef) and + (ttypesym(sym).typedef.typesym=ttypesym(sym)) and + (ttypesym(sym).typedef.typ in [objectdef,recorddef]) then + tabstractrecorddef(ttypesym(sym).typedef).check_forwards; + end; + + + procedure TStoredSymtable.labeldefined(sym:TObject;arg:pointer); + begin + if (tsym(sym).typ=labelsym) and + not(tlabelsym(sym).defined) then + begin + if tlabelsym(sym).used then + Message1(sym_e_label_used_and_not_defined,tlabelsym(sym).realname) + else + Message1(sym_w_label_not_defined,tlabelsym(sym).realname); + end; + end; + + + procedure TStoredSymtable.varsymbolused(sym:TObject;arg:pointer); + begin + if (tsym(sym).typ in [staticvarsym,localvarsym,paravarsym,fieldvarsym]) and + ((tsym(sym).owner.symtabletype in + [parasymtable,localsymtable,ObjectSymtable,recordsymtable,staticsymtable])) then + begin + { unused symbol should be reported only if no } + { error is reported } + { if the symbol is in a register it is used } + { also don't count the value parameters which have local copies } + { also don't claim for high param of open parameters (PM) } + { also don't complain about unused symbols in generic procedures } + { and methods } + if (Errorcount<>0) or + ([vo_is_hidden_para,vo_is_funcret] * tabstractvarsym(sym).varoptions = [vo_is_hidden_para]) or + (sp_internal in tsym(sym).symoptions) or + ((assigned(tsym(sym).owner.defowner) and + (tsym(sym).owner.defowner.typ=procdef) and + (df_generic in tprocdef(tsym(sym).owner.defowner).defoptions))) then + exit; + if (tstoredsym(sym).refs=0) then + begin + if (vo_is_funcret in tabstractvarsym(sym).varoptions) then + begin + { don't warn about the result of constructors } + if ((tsym(sym).owner.symtabletype<>localsymtable) or + (tprocdef(tsym(sym).owner.defowner).proctypeoption<>potype_constructor)) and + not(cs_opt_nodedfa in current_settings.optimizerswitches) then + MessagePos(tsym(sym).fileinfo,sym_w_function_result_not_set) + end + else if (tsym(sym).owner.symtabletype=parasymtable) then + MessagePos1(tsym(sym).fileinfo,sym_h_para_identifier_not_used,tsym(sym).prettyname) + else if (tsym(sym).owner.symtabletype in [ObjectSymtable,recordsymtable]) then + MessagePos2(tsym(sym).fileinfo,sym_n_private_identifier_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname) + else + MessagePos1(tsym(sym).fileinfo,sym_n_local_identifier_not_used,tsym(sym).prettyname); + end + else if tabstractvarsym(sym).varstate in [vs_written,vs_initialised] then + begin + if (tsym(sym).owner.symtabletype=parasymtable) then + begin + if not(tabstractvarsym(sym).varspez in [vs_var,vs_out,vs_constref]) and + not(vo_is_funcret in tabstractvarsym(sym).varoptions) then + MessagePos1(tsym(sym).fileinfo,sym_h_para_identifier_only_set,tsym(sym).prettyname) + end + else if (tsym(sym).owner.symtabletype in [ObjectSymtable,recordsymtable]) then + MessagePos2(tsym(sym).fileinfo,sym_n_private_identifier_only_set,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname) + else if tabstractvarsym(sym).varoptions*[vo_is_funcret,vo_is_public,vo_is_external]=[] then + MessagePos1(tsym(sym).fileinfo,sym_n_local_identifier_only_set,tsym(sym).prettyname); + end + else if (tabstractvarsym(sym).varstate = vs_read_not_warned) and + ([vo_is_public,vo_is_external] * tabstractvarsym(sym).varoptions = []) then + MessagePos1(tsym(sym).fileinfo,sym_w_identifier_only_read,tsym(sym).prettyname) + end + else if ((tsym(sym).owner.symtabletype in + [ObjectSymtable,parasymtable,localsymtable,staticsymtable,recordsymtable])) then + begin + if (Errorcount<>0) or + (sp_internal in tsym(sym).symoptions) then + exit; + { do not claim for inherited private fields !! } + if (tsym(sym).refs=0) and (tsym(sym).owner.symtabletype in [ObjectSymtable,recordsymtable]) then + case tsym(sym).typ of + typesym: + MessagePos2(tsym(sym).fileinfo,sym_n_private_type_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname); + constsym: + MessagePos2(tsym(sym).fileinfo,sym_n_private_const_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname); + propertysym: + MessagePos2(tsym(sym).fileinfo,sym_n_private_property_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname); + else + MessagePos2(tsym(sym).fileinfo,sym_n_private_method_not_used,tabstractrecorddef(tsym(sym).owner.defowner).GetTypeName,tsym(sym).prettyname); + end + { units references are problematic } + else + begin + if (tsym(sym).refs=0) and + not(tsym(sym).typ in [enumsym,unitsym,namespacesym]) and + not(is_funcret_sym(tsym(sym))) and + { don't complain about compiler generated syms for specializations, see also #13405 } + not((tsym(sym).typ=typesym) and (df_specialization in ttypesym(sym).typedef.defoptions) and + (pos('$',ttypesym(sym).Realname)<>0)) and + ( + (tsym(sym).typ<>procsym) or + ((tsym(sym).owner.symtabletype=staticsymtable) and + not current_module.is_unit) + ) and + { don't complain about alias for hidden _cmd parameter to + obj-c methods } + not((tsym(sym).typ in [localvarsym,paravarsym,absolutevarsym]) and + (vo_is_msgsel in tabstractvarsym(sym).varoptions)) then + MessagePos2(tsym(sym).fileinfo,sym_h_local_symbol_not_used,SymTypeName[tsym(sym).typ],tsym(sym).prettyname); + end; + end; + end; + + + procedure TStoredSymtable.TestPrivate(sym:TObject;arg:pointer); + begin + if tsym(sym).visibility in [vis_private,vis_strictprivate] then + varsymbolused(sym,arg); + end; + + + procedure TStoredSymtable.objectprivatesymbolused(sym:TObject;arg:pointer); + begin + { + Don't test simple object aliases PM + } + if (tsym(sym).typ=typesym) and + (ttypesym(sym).typedef.typ in [objectdef,recorddef]) and + (ttypesym(sym).typedef.typesym=tsym(sym)) then + tabstractrecorddef(ttypesym(sym).typedef).symtable.SymList.ForEachCall(@TestPrivate,nil); + end; + + + procedure tstoredsymtable.testfordefaultproperty(sym:TObject;arg:pointer); + begin + if (tsym(sym).typ=propertysym) and + (ppo_defaultproperty in tpropertysym(sym).propoptions) then + ppointer(arg)^:=sym; + end; + + +{*********************************************** + Process all entries +***********************************************} + + { checks, if all procsyms and methods are defined } + procedure tstoredsymtable.check_forwards; + begin + SymList.ForEachCall(@check_forward,nil); + end; + + + procedure tstoredsymtable.checklabels; + begin + SymList.ForEachCall(@labeldefined,nil); + end; + + + procedure tstoredsymtable.allsymbolsused; + begin + SymList.ForEachCall(@varsymbolused,nil); + end; + + + procedure tstoredsymtable.allprivatesused; + begin + SymList.ForEachCall(@objectprivatesymbolused,nil); + end; + + + procedure TStoredSymtable._needs_init_final(sym:TObject;arg:pointer); + begin + if b_needs_init_final then + exit; + { don't check static symbols - they can be present in structures only and + always have a reference to a symbol defined on unit level } + if sp_static in tsym(sym).symoptions then + exit; + case tsym(sym).typ of + fieldvarsym, + staticvarsym, + localvarsym, + paravarsym : + begin + if is_managed_type(tabstractvarsym(sym).vardef) then + b_needs_init_final:=true; + end; + end; + end; + + + { returns true, if p contains data which needs init/final code } + function tstoredsymtable.needs_init_final : boolean; + begin + b_needs_init_final:=false; + SymList.ForEachCall(@_needs_init_final,nil); + needs_init_final:=b_needs_init_final; + end; + + +{**************************************************************************** + TAbstractRecordSymtable +****************************************************************************} + + constructor tabstractrecordsymtable.create(const n:string;usealign:shortint); + begin + inherited create(n); + moduleid:=current_module.moduleid; + _datasize:=0; + databitsize:=0; + recordalignment:=1; + usefieldalignment:=usealign; + padalignment:=1; + { recordalign C_alignment means C record packing, that starts + with an alignment of 1 } + case usealign of + C_alignment, + bit_alignment: + fieldalignment:=1; + mac68k_alignment: + fieldalignment:=2; + else + fieldalignment:=usealign; + end; + end; + + + procedure tabstractrecordsymtable.ppuload(ppufile:tcompilerppufile); + begin + if ppufile.readentry<>ibrecsymtableoptions then + Message(unit_f_ppu_read_error); + recordalignment:=shortint(ppufile.getbyte); + usefieldalignment:=shortint(ppufile.getbyte); + if (usefieldalignment=C_alignment) then + fieldalignment:=shortint(ppufile.getbyte); + inherited ppuload(ppufile); + end; + + + procedure tabstractrecordsymtable.ppuwrite(ppufile:tcompilerppufile); + var + oldtyp : byte; + begin + oldtyp:=ppufile.entrytyp; + ppufile.entrytyp:=subentryid; + { in case of classes using C alignment, the alignment of the parent + affects the alignment of fields of the childs } + ppufile.putbyte(byte(recordalignment)); + ppufile.putbyte(byte(usefieldalignment)); + if (usefieldalignment=C_alignment) then + ppufile.putbyte(byte(fieldalignment)); + ppufile.writeentry(ibrecsymtableoptions); + + inherited ppuwrite(ppufile); + + ppufile.entrytyp:=oldtyp; + end; + + + function field2recordalignment(fieldoffs, fieldalign: asizeint): asizeint; + begin + { optimal alignment of the record when declaring a variable of this } + { type is independent of the packrecords setting } + if (fieldoffs mod fieldalign) = 0 then + result:=fieldalign + else if (fieldalign >= 16) and + ((fieldoffs mod 16) = 0) and + ((fieldalign mod 16) = 0) then + result:=16 + else if (fieldalign >= 8) and + ((fieldoffs mod 8) = 0) and + ((fieldalign mod 8) = 0) then + result:=8 + else if (fieldalign >= 4) and + ((fieldoffs mod 4) = 0) and + ((fieldalign mod 4) = 0) then + result:=4 + else if (fieldalign >= 2) and + ((fieldoffs mod 2) = 0) and + ((fieldalign mod 2) = 0) then + result:=2 + else + result:=1; + end; + + procedure tabstractrecordsymtable.alignrecord(fieldoffset:asizeint;varalign:shortint); + var + varalignrecord: shortint; + begin + case usefieldalignment of + C_alignment: + varalignrecord:=used_align(varalign,current_settings.alignment.recordalignmin,current_settings.alignment.maxCrecordalign); + mac68k_alignment: + varalignrecord:=2; + else + varalignrecord:=field2recordalignment(fieldoffset,varalign); + end; + recordalignment:=max(recordalignment,varalignrecord); + end; + + procedure tabstractrecordsymtable.addfield(sym:tfieldvarsym;vis:tvisibility); + var + l : asizeint; + varalignfield, + varalign : shortint; + vardef : tdef; + begin + if (sym.owner<>self) then + internalerror(200602031); + if sym.fieldoffset<>-1 then + internalerror(200602032); + { set visibility for the symbol } + sym.visibility:=vis; + { this symbol can't be loaded to a register } + sym.varregable:=vr_none; + { Calculate field offset } + l:=sym.getsize; + vardef:=sym.vardef; + varalign:=vardef.alignment; + + case usefieldalignment of + bit_alignment: + begin + { bitpacking only happens for ordinals, the rest is aligned at } + { 1 byte (compatible with GPC/GCC) } + if is_ordinal(vardef) then + begin + sym.fieldoffset:=databitsize; + l:=sym.getpackedbitsize; + end + else + begin + databitsize:=_datasize*8; + sym.fieldoffset:=databitsize; + if (l>high(asizeint) div 8) then + Message(sym_e_segment_too_large); + l:=l*8; + end; + if varalign=0 then + varalign:=size_2_align(l); + recordalignment:=max(recordalignment,field2recordalignment(databitsize mod 8,varalign)); + { bit packed records are limited to high(aint) bits } + { instead of bytes to avoid double precision } + { arithmetic in offset calculations } + if int64(l)>high(asizeint)-sym.fieldoffset then + begin + Message(sym_e_segment_too_large); + _datasize:=high(asizeint); + databitsize:=high(asizeint); + end + else + begin + databitsize:=sym.fieldoffset+l; + _datasize:=(databitsize+7) div 8; + end; + { rest is not applicable } + exit; + end; + { Calc the alignment size for C style records } + C_alignment: + begin + if (varalign>4) and + ((varalign mod 4)<>0) and + (vardef.typ=arraydef) then + Message1(sym_w_wrong_C_pack,vardef.typename); + if varalign=0 then + varalign:=l; + if (fieldalignment<current_settings.alignment.maxCrecordalign) then + begin + if (varalign>16) and (fieldalignment<32) then + fieldalignment:=32 + else if (varalign>12) and (fieldalignment<16) then + fieldalignment:=16 + { 12 is needed for long double } + else if (varalign>8) and (fieldalignment<12) then + fieldalignment:=12 + else if (varalign>4) and (fieldalignment<8) then + fieldalignment:=8 + else if (varalign>2) and (fieldalignment<4) then + fieldalignment:=4 + else if (varalign>1) and (fieldalignment<2) then + fieldalignment:=2; + end; + fieldalignment:=min(fieldalignment,current_settings.alignment.maxCrecordalign); + end; + mac68k_alignment: + begin + { mac68k alignment (C description): + * char is aligned to 1 byte + * everything else (except vector) is aligned to 2 bytes + * vector is aligned to 16 bytes + } + if l>1 then + fieldalignment:=2 + else + fieldalignment:=1; + varalign:=2; + end; + end; + if varalign=0 then + varalign:=size_2_align(l); + varalignfield:=used_align(varalign,current_settings.alignment.recordalignmin,fieldalignment); + + sym.fieldoffset:=align(_datasize,varalignfield); + if l>high(asizeint)-sym.fieldoffset then + begin + Message(sym_e_segment_too_large); + _datasize:=high(aint); + end + else + _datasize:=sym.fieldoffset+l; + { Calc alignment needed for this record } + alignrecord(sym.fieldoffset,varalign); + end; + + + procedure tabstractrecordsymtable.addalignmentpadding; + var + padded_datasize: asizeint; + begin + { make the record size aligned correctly so it can be + used as elements in an array. For C records we + use the fieldalignment, because that is updated with the + used alignment. } + if (padalignment = 1) then + case usefieldalignment of + C_alignment: + padalignment:=fieldalignment; + { bitpacked } + bit_alignment: + padalignment:=1; + { mac68k: always round to multiple of 2 } + mac68k_alignment: + padalignment:=2; + { default/no packrecords specified } + 0: + padalignment:=recordalignment + { specific packrecords setting -> use as upper limit } + else + padalignment:=min(recordalignment,usefieldalignment); + end; + padded_datasize:=align(_datasize,padalignment); + _paddingsize:=padded_datasize-_datasize; + _datasize:=padded_datasize; + end; + + + procedure tabstractrecordsymtable.insertdef(def:TDefEntry); + begin + { Enums must also be available outside the record scope, + insert in the owner of this symtable } + if def.typ=enumdef then + defowner.owner.insertdef(def) + else + inherited insertdef(def); + end; + + + function tabstractrecordsymtable.is_packed: boolean; + begin + result:=usefieldalignment=bit_alignment; + end; + + + function tabstractrecordsymtable.has_single_field(out sym: tfieldvarsym): boolean; + var + i: longint; + begin + result:=false; + { If a record contains a union, it does not contain a "single + non-composite field" in the context of certain ABIs requiring + special treatment for such records } + if (defowner.typ=recorddef) and + trecorddef(defowner).isunion then + exit; + { a record/object can contain other things than fields } + for i:=0 to SymList.Count-1 do + begin + if tsym(symlist[i]).typ=fieldvarsym then + begin + if result then + begin + result:=false; + exit; + end; + result:=true; + sym:=tfieldvarsym(symlist[i]) + end; + end; + end; + + function tabstractrecordsymtable.get_unit_symtable: tsymtable; + begin + result:=defowner.owner; + while assigned(result) and (result.symtabletype in [ObjectSymtable,recordsymtable]) do + result:=result.defowner.owner; + end; + + procedure tabstractrecordsymtable.setdatasize(val: asizeint); + begin + _datasize:=val; + if (usefieldalignment=bit_alignment) then + { can overflow in non bitpacked records } + databitsize:=val*8; + end; + + function tabstractrecordsymtable.iscurrentunit: boolean; + begin + Result := Assigned(current_module) and (current_module.moduleid=moduleid); + end; + +{**************************************************************************** + TRecordSymtable +****************************************************************************} + + constructor trecordsymtable.create(const n:string;usealign:shortint); + begin + inherited create(n,usealign); + symtabletype:=recordsymtable; + end; + + + { this procedure is reserved for inserting case variant into + a record symtable } + { the offset is the location of the start of the variant + and datasize and dataalignment corresponds to + the complete size (see code in pdecl unit) PM } + procedure trecordsymtable.insertunionst(unionst : trecordsymtable;offset : longint); + var + sym : tsym; + def : tdef; + i : integer; + varalignrecord,varalign, + storesize,storealign : aint; + bitsize: tcgint; + begin + storesize:=_datasize; + storealign:=fieldalignment; + _datasize:=offset; + if (usefieldalignment=bit_alignment) then + databitsize:=offset*8; + + { We move the ownership of the defs and symbols to the new recordsymtable. + The old unionsymtable keeps the references, but doesn't own the + objects anymore } + unionst.DefList.OwnsObjects:=false; + unionst.SymList.OwnsObjects:=false; + + { copy symbols } + for i:=0 to unionst.SymList.Count-1 do + begin + sym:=TSym(unionst.SymList[i]); + if sym.typ<>fieldvarsym then + internalerror(200601272); + if tfieldvarsym(sym).fieldoffset=0 then + include(tfieldvarsym(sym).varoptions,vo_is_first_field); + + { add to this record symtable } +// unionst.SymList.List.List^[i].Data:=nil; + sym.ChangeOwner(self); + varalign:=tfieldvarsym(sym).vardef.alignment; + if varalign=0 then + varalign:=size_2_align(tfieldvarsym(sym).getsize); + { retrieve size } + if (usefieldalignment=bit_alignment) then + begin + { bit packed records are limited to high(aint) bits } + { instead of bytes to avoid double precision } + { arithmetic in offset calculations } + if is_ordinal(tfieldvarsym(sym).vardef) then + bitsize:=tfieldvarsym(sym).getpackedbitsize + else + begin + bitsize:=tfieldvarsym(sym).getsize; + if (bitsize>high(asizeint) div 8) then + Message(sym_e_segment_too_large); + bitsize:=bitsize*8; + end; + if bitsize>high(asizeint)-databitsize then + begin + Message(sym_e_segment_too_large); + _datasize:=high(aint); + databitsize:=high(aint); + end + else + begin + databitsize:=tfieldvarsym(sym).fieldoffset+offset*8; + _datasize:=(databitsize+7) div 8; + end; + tfieldvarsym(sym).fieldoffset:=databitsize; + varalignrecord:=field2recordalignment(tfieldvarsym(sym).fieldoffset div 8,varalign); + end + else + begin + if tfieldvarsym(sym).getsize>high(asizeint)-_datasize then + begin + Message(sym_e_segment_too_large); + _datasize:=high(aint); + end + else + _datasize:=tfieldvarsym(sym).fieldoffset+offset; + { update address } + tfieldvarsym(sym).fieldoffset:=_datasize; + varalignrecord:=field2recordalignment(tfieldvarsym(sym).fieldoffset,varalign); + end; + { update alignment of this record } + if (usefieldalignment<>C_alignment) and + (usefieldalignment<>mac68k_alignment) then + recordalignment:=max(recordalignment,varalignrecord); + end; + { update alignment for C records } + if (usefieldalignment=C_alignment) and + (usefieldalignment<>mac68k_alignment) then + recordalignment:=max(recordalignment,unionst.recordalignment); + { Register defs in the new record symtable } + for i:=0 to unionst.DefList.Count-1 do + begin + def:=TDef(unionst.DefList[i]); + def.ChangeOwner(self); + end; + _datasize:=storesize; + fieldalignment:=storealign; + { If a record contains a union, it does not contain a "single + non-composite field" in the context of certain ABIs requiring + special treatment for such records } + if defowner.typ=recorddef then + trecorddef(defowner).isunion:=true; + end; + + +{**************************************************************************** + TObjectSymtable +****************************************************************************} + + constructor tObjectSymtable.create(adefowner:tdef;const n:string;usealign:shortint); + begin + inherited create(n,usealign); + symtabletype:=ObjectSymtable; + defowner:=adefowner; + end; + + + function tObjectSymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean; + var + hsym : tsym; + begin + result:=false; + if not assigned(defowner) then + internalerror(200602061); + + { procsym and propertysym have special code + to override values in inherited classes. For other + symbols check for duplicates } + if not(sym.typ in [procsym,propertysym]) then + begin + { but private ids can be reused } + hsym:=search_struct_member(tobjectdef(defowner),hashedid.id); + if assigned(hsym) and + ( + ( + not(m_delphi in current_settings.modeswitches) and + is_visible_for_object(hsym,tobjectdef(defowner)) + ) or + ( + { In Delphi, you can repeat members of a parent class. You can't } + { do this for objects however, and you (obviouly) can't } + { declare two fields with the same name in a single class } + (m_delphi in current_settings.modeswitches) and + ( + is_object(tdef(defowner)) or + (hsym.owner = self) + ) + ) + ) then + begin + DuplicateSym(hashedid,sym,hsym); + result:=true; + end; + end + else + result:=inherited checkduplicate(hashedid,sym); + end; + + +{**************************************************************************** + TAbstractLocalSymtable +****************************************************************************} + + procedure tabstractlocalsymtable.ppuwrite(ppufile:tcompilerppufile); + var + oldtyp : byte; + begin + oldtyp:=ppufile.entrytyp; + ppufile.entrytyp:=subentryid; + + inherited ppuwrite(ppufile); + + ppufile.entrytyp:=oldtyp; + end; + + + function tabstractlocalsymtable.count_locals:longint; + var + i : longint; + sym : tsym; + begin + result:=0; + for i:=0 to SymList.Count-1 do + begin + sym:=tsym(SymList[i]); + { Count only varsyms, but ignore the funcretsym } + if (tsym(sym).typ in [localvarsym,paravarsym]) and + (tsym(sym)<>current_procinfo.procdef.funcretsym) and + (not(vo_is_parentfp in tabstractvarsym(sym).varoptions) or + (tstoredsym(sym).refs>0)) then + inc(result); + end; + end; + + +{**************************************************************************** + TLocalSymtable +****************************************************************************} + + constructor tlocalsymtable.create(adefowner:tdef;level:byte); + begin + inherited create(''); + defowner:=adefowner; + symtabletype:=localsymtable; + symtablelevel:=level; + end; + + + function tlocalsymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean; + var + hsym : tsym; + begin + if not assigned(defowner) or + (defowner.typ<>procdef) then + internalerror(200602042); + + result:=false; + hsym:=tsym(FindWithHash(hashedid)); + if assigned(hsym) then + begin + { a local and the function can have the same + name in TP and Delphi, but RESULT not } + if (m_duplicate_names in current_settings.modeswitches) and + (hsym.typ in [absolutevarsym,localvarsym]) and + (vo_is_funcret in tabstractvarsym(hsym).varoptions) and + not((m_result in current_settings.modeswitches) and + (vo_is_result in tabstractvarsym(hsym).varoptions)) then + HideSym(hsym) + else + DuplicateSym(hashedid,sym,hsym); + result:=true; + exit; + end; + + { check also parasymtable, this needs to be done here because + of the special situation with the funcret sym that needs to be + hidden for tp and delphi modes } + hsym:=tsym(tabstractprocdef(defowner).parast.FindWithHash(hashedid)); + if assigned(hsym) then + begin + { a local and the function can have the same + name in TP and Delphi, but RESULT not } + if (m_duplicate_names in current_settings.modeswitches) and + (sym.typ in [absolutevarsym,localvarsym]) and + (vo_is_funcret in tabstractvarsym(sym).varoptions) and + not((m_result in current_settings.modeswitches) and + (vo_is_result in tabstractvarsym(sym).varoptions)) then + Hidesym(sym) + else + DuplicateSym(hashedid,sym,hsym); + result:=true; + exit; + end; + + { check ObjectSymtable, skip this for funcret sym because + that will always be positive because it has the same name + as the procsym } + if not is_funcret_sym(sym) and + (defowner.typ=procdef) and + assigned(tprocdef(defowner).struct) and + (tprocdef(defowner).owner.defowner=tprocdef(defowner).struct) and + ( + not(m_delphi in current_settings.modeswitches) or + is_object(tprocdef(defowner).struct) + ) then + result:=tprocdef(defowner).struct.symtable.checkduplicate(hashedid,sym); + end; + + +{**************************************************************************** + TParaSymtable +****************************************************************************} + + constructor tparasymtable.create(adefowner:tdef;level:byte); + begin + inherited create(''); + readonly:=false; + defowner:=adefowner; + symtabletype:=parasymtable; + symtablelevel:=level; + end; + + + function tparasymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean; + begin + result:=inherited checkduplicate(hashedid,sym); + if result then + exit; + if not(m_duplicate_names in current_settings.modeswitches) and + assigned(defowner) and (defowner.typ=procdef) and + assigned(tprocdef(defowner).struct) and + (tprocdef(defowner).owner.defowner=tprocdef(defowner).struct) and + ( + not(m_delphi in current_settings.modeswitches) or + is_object(tprocdef(defowner).struct) + ) then + result:=tprocdef(defowner).struct.symtable.checkduplicate(hashedid,sym); + end; + + procedure tparasymtable.insertdef(def: TDefEntry); + begin + if readonly then + defowner.owner.insertdef(def) + else + inherited insertdef(def); + end; + + +{**************************************************************************** + TAbstractUniTSymtable +****************************************************************************} + + constructor tabstractuniTSymtable.create(const n : string;id:word); + begin + inherited create(n); + moduleid:=id; + end; + + + function tabstractuniTSymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean; + var + hsym : tsym; + begin + result:=false; + hsym:=tsym(FindWithHash(hashedid)); + if assigned(hsym) then + begin + if (sym is tstoredsym) and handle_generic_dummysym(hsym,tstoredsym(sym).symoptions) then + exit; + if hsym.typ=symconst.namespacesym then + begin + case sym.typ of + symconst.namespacesym:; + symconst.unitsym: + begin + HideSym(sym); { if we add a unit and there is a namespace with the same name then hide the unit name and not the namespace } + tnamespacesym(hsym).unitsym:=tsym(sym); + end + else + HideSym(hsym); + end; + end + else + { In delphi (contrary to TP) you can have a symbol with the same name as the + unit, the unit can then not be accessed anymore using + <unit>.<id>, so we can hide the symbol. + Do the same if we add a namespace and there is a unit with the same name } + if (hsym.typ=symconst.unitsym) and + ((m_delphi in current_settings.modeswitches) or (sym.typ=symconst.namespacesym)) then + begin + HideSym(hsym); + if sym.typ=symconst.namespacesym then + tnamespacesym(sym).unitsym:=tsym(hsym); + end + else + DuplicateSym(hashedid,sym,hsym); + result:=true; + exit; + end; + end; + + function tabstractuniTSymtable.iscurrentunit:boolean; + begin + result:=assigned(current_module) and + ( + (current_module.globalsymtable=self) or + (current_module.localsymtable=self) + ); + end; + + procedure tabstractuniTSymtable.insertunit(sym:TSymEntry); + var + p:integer; + n,ns:string; + oldsym:TSymEntry; + begin + insert(sym); + n:=sym.realname; + p:=pos('.',n); + ns:=''; + while p>0 do + begin + if ns='' then + ns:=copy(n,1,p-1) + else + ns:=ns+'.'+copy(n,1,p-1); + system.delete(n,1,p); + oldsym:=Find(upper(ns)); + if not Assigned(oldsym) or (oldsym.typ<>namespacesym) then + insert(tnamespacesym.create(ns)); + p:=pos('.',n); + end; + end; + +{**************************************************************************** + TStaticSymtable +****************************************************************************} + + constructor tstaticsymtable.create(const n : string;id:word); + begin + inherited create(n,id); + symtabletype:=staticsymtable; + symtablelevel:=main_program_level; + end; + + + procedure tstaticsymtable.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(ppufile); + + { now we can deref the syms and defs } + deref; + end; + + + procedure tstaticsymtable.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + end; + + + function tstaticsymtable.checkduplicate(var hashedid:THashedIDString;sym:TSymEntry):boolean; + begin + result:=inherited checkduplicate(hashedid,sym); + + if not result and + (current_module.localsymtable=self) and + assigned(current_module.globalsymtable) then + result:=tglobalsymtable(current_module.globalsymtable).checkduplicate(hashedid,sym); + end; + + +{**************************************************************************** + TGlobalSymtable +****************************************************************************} + + constructor tglobalsymtable.create(const n : string;id:word); + begin + inherited create(n,id); + symtabletype:=globalsymtable; + symtablelevel:=main_program_level; + end; + + + procedure tglobalsymtable.ppuload(ppufile:tcompilerppufile); + begin + inherited ppuload(ppufile); + + { now we can deref the syms and defs } + deref; + end; + + + procedure tglobalsymtable.ppuwrite(ppufile:tcompilerppufile); + begin + { write the symtable entries } + inherited ppuwrite(ppufile); + end; + + +{***************************************************************************** + tspecializesymtable +*****************************************************************************} + + function tspecializesymtable.iscurrentunit: boolean; + begin + Result := true; + end; + + +{**************************************************************************** + TWITHSYMTABLE +****************************************************************************} + + constructor twithsymtable.create(aowner:tdef;ASymList:TFPHashObjectList;refnode:tobject{tnode}); + begin + inherited create(''); + symtabletype:=withsymtable; + withrefnode:=refnode; + { Replace SymList with the passed symlist } + SymList.free; + SymList:=ASymList; + defowner:=aowner; + end; + + + destructor twithsymtable.destroy; + begin + withrefnode.free; + { Disable SymList because we don't Own it } + SymList:=nil; + inherited destroy; + end; + + + procedure twithsymtable.clear; + begin + { remove no entry from a withsymtable as it is only a pointer to the + recorddef or objectdef symtable } + end; + + + procedure twithsymtable.insertdef(def:TDefEntry); + begin + { Definitions can't be registered in the withsymtable + because the withsymtable is removed after the with block. + We can't easily solve it here because the next symtable in the + stack is not known. } + internalerror(200602046); + end; + +{**************************************************************************** + TSTT_ExceptionSymtable +****************************************************************************} + + constructor tstt_excepTSymtable.create; + begin + inherited create(''); + symtabletype:=stt_excepTSymtable; + end; + + +{**************************************************************************** + TMacroSymtable +****************************************************************************} + + constructor tmacrosymtable.create(exported: boolean); + begin + inherited create(''); + if exported then + symtabletype:=exportedmacrosymtable + else + symtabletype:=localmacrosymtable; + symtablelevel:=main_program_level; + end; + +{**************************************************************************** + TEnumSymtable +****************************************************************************} + + procedure tenumsymtable.insert(sym: TSymEntry; checkdup: boolean); + var + value: longint; + def: tenumdef; + begin + // defowner = nil only when we are loading from ppu + if defowner<>nil then + begin + { First entry? Then we need to set the minval } + value:=tenumsym(sym).value; + def:=tenumdef(defowner); + if SymList.count=0 then + begin + if value>0 then + def.has_jumps:=true; + def.setmin(value); + def.setmax(value); + end + else + begin + { check for jumps } + if value>def.max+1 then + def.has_jumps:=true; + { update low and high } + if def.min>value then + def.setmin(value); + if def.max<value then + def.setmax(value); + end; + end; + inherited insert(sym, checkdup); + end; + + constructor tenumsymtable.create(adefowner: tdef); + begin + inherited Create(''); + symtabletype:=enumsymtable; + defowner:=adefowner; + end; + +{**************************************************************************** + TArraySymtable +****************************************************************************} + + procedure tarraysymtable.insertdef(def: TDefEntry); + begin + { Enums must also be available outside the record scope, + insert in the owner of this symtable } + if def.typ=enumdef then + defowner.owner.insertdef(def) + else + inherited insertdef(def); + end; + + constructor tarraysymtable.create(adefowner: tdef); + begin + inherited Create(''); + symtabletype:=arraysymtable; + defowner:=adefowner; + end; + +{***************************************************************************** + Helper Routines +*****************************************************************************} + + function FullTypeName(def,otherdef:tdef):string; + var + s1,s2 : string; + begin + if def.typ in [objectdef,recorddef] then + s1:=tabstractrecorddef(def).RttiName + else + s1:=def.typename; + { When the names are the same try to include the unit name } + if assigned(otherdef) and + (def.owner.symtabletype in [globalsymtable,staticsymtable]) then + begin + s2:=otherdef.typename; + if upper(s1)=upper(s2) then + s1:=def.owner.realname^+'.'+s1; + end; + FullTypeName:=s1; + end; + + function generate_nested_name(symtable:tsymtable;delimiter:string):string; + begin + result:=''; + while assigned(symtable) and (symtable.symtabletype in [ObjectSymtable,recordsymtable]) do + begin + if (result='') then + result:=symtable.name^ + else + result:=symtable.name^+delimiter+result; + symtable:=symtable.defowner.owner; + end; + end; + + procedure incompatibletypes(def1,def2:tdef); + begin + { When there is an errordef there is already an error message show } + if (def2.typ=errordef) or + (def1.typ=errordef) then + exit; + CGMessage2(type_e_incompatible_types,FullTypeName(def1,def2),FullTypeName(def2,def1)); + end; + + + procedure hidesym(sym:TSymEntry); + begin + sym.realname:='$hidden'+sym.realname; + tsym(sym).visibility:=vis_hidden; + end; + + + procedure duplicatesym(var hashedid:THashedIDString;dupsym,origsym:TSymEntry); + var + st : TSymtable; + begin + Message1(sym_e_duplicate_id,tsym(origsym).realname); + { Write hint where the original symbol was found } + st:=finduniTSymtable(origsym.owner); + with tsym(origsym).fileinfo do + begin + if assigned(st) and + (st.symtabletype=globalsymtable) and + st.iscurrentunit then + Message2(sym_h_duplicate_id_where,current_module.sourcefiles.get_file_name(fileindex),tostr(line)) + else if assigned(st.name) then + Message2(sym_h_duplicate_id_where,'unit '+st.name^,tostr(line)); + end; + { Rename duplicate sym to an unreachable name, but it can be + inserted in the symtable without errors } + inc(dupnr); + hashedid.id:='dup'+tostr(dupnr)+hashedid.id; + if assigned(dupsym) then + include(tsym(dupsym).symoptions,sp_implicitrename); + end; + + function handle_generic_dummysym(sym:TSymEntry;var symoptions:tsymoptions):boolean; + begin + result:=false; + if not assigned(sym) or not (sym is tstoredsym) then + Internalerror(2011081101); + { For generics a dummy symbol without the parameter count is created + if such a symbol not yet exists so that different parts of the + parser can find that symbol. If that symbol is still a + undefineddef we replace the generic dummy symbol's + name with a "dup" name and use the new symbol as the generic dummy + symbol } + if (sp_generic_dummy in tstoredsym(sym).symoptions) and + (sym.typ=typesym) and (ttypesym(sym).typedef.typ=undefineddef) and + (m_delphi in current_settings.modeswitches) then + begin + inc(dupnr); + sym.Owner.SymList.Rename(upper(sym.realname),'dup_'+tostr(dupnr)+sym.realname); + include(tsym(sym).symoptions,sp_implicitrename); + { we need to find the new symbol now if checking for a dummy } + include(symoptions,sp_generic_dummy); + result:=true; + end; + end; + +{***************************************************************************** + Search +*****************************************************************************} + + procedure addsymref(sym:tsym); + begin + { symbol uses count } + sym.IncRefCount; + { unit uses count } + if assigned(current_module) and + (sym.owner.symtabletype=globalsymtable) then + begin + if tglobalsymtable(sym.owner).moduleid>=current_module.unitmapsize then + internalerror(200501152); + inc(current_module.unitmap[tglobalsymtable(sym.owner).moduleid].refs); + end; + end; + + + function is_owned_by(childdef,ownerdef:tdef):boolean; + begin + result:=childdef=ownerdef; + if not result and assigned(childdef.owner.defowner) then + result:=is_owned_by(tdef(childdef.owner.defowner),ownerdef); + end; + + function sym_is_owned_by(childsym:tsym;symtable:tsymtable):boolean; + begin + result:=childsym.owner=symtable; + if not result and (childsym.owner.symtabletype in [objectsymtable,recordsymtable]) then + result:=sym_is_owned_by(tabstractrecorddef(childsym.owner.defowner).typesym,symtable); + end; + + function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tabstractrecorddef):boolean; + var + symownerdef : tabstractrecorddef; + begin + result:=false; + + { Get objdectdef owner of the symtable for the is_related checks } + if not assigned(symst) or + not (symst.symtabletype in [objectsymtable,recordsymtable]) then + internalerror(200810285); + symownerdef:=tabstractrecorddef(symst.defowner); + case symvisibility of + vis_private : + begin + { private symbols are allowed when we are in the same + module as they are defined } + result:=( + (symownerdef.owner.symtabletype in [globalsymtable,staticsymtable]) and + (symownerdef.owner.iscurrentunit) + ) or + ( // the case of specialize inside the generic declaration and nested types + (symownerdef.owner.symtabletype in [objectsymtable,recordsymtable]) and + ( + assigned(current_structdef) and + ( + (current_structdef=symownerdef) or + (current_structdef.owner.iscurrentunit) + ) + ) or + ( + not assigned(current_structdef) and + (symownerdef.owner.iscurrentunit) + ) + ); + end; + vis_strictprivate : + begin + result:=assigned(current_structdef) and + is_owned_by(current_structdef,symownerdef); + end; + vis_strictprotected : + begin + result:=( + assigned(current_structdef) and + (current_structdef.is_related(symownerdef) or + is_owned_by(current_structdef,symownerdef)) + ) or + ( + { helpers can access strict protected symbols } + is_objectpascal_helper(contextobjdef) and + tobjectdef(contextobjdef).extendeddef.is_related(symownerdef) + ); + end; + vis_protected : + begin + { protected symbols are visible in the module that defines them and + also visible to related objects. The related object must be defined + in the current module } + result:=( + ( + (symownerdef.owner.symtabletype in [globalsymtable,staticsymtable]) and + (symownerdef.owner.iscurrentunit) + ) or + ( + assigned(contextobjdef) and + (contextobjdef.owner.symtabletype in [globalsymtable,staticsymtable,ObjectSymtable]) and + (contextobjdef.owner.iscurrentunit) and + contextobjdef.is_related(symownerdef) + ) or + ( // the case of specialize inside the generic declaration and nested types + (symownerdef.owner.symtabletype in [objectsymtable,recordsymtable]) and + ( + assigned(current_structdef) and + ( + (current_structdef=symownerdef) or + (current_structdef.owner.iscurrentunit) + ) + ) or + ( + not assigned(current_structdef) and + (symownerdef.owner.iscurrentunit) + ) or + ( + { helpers can access protected symbols } + is_objectpascal_helper(contextobjdef) and + tobjectdef(contextobjdef).extendeddef.is_related(symownerdef) + ) + ) + ); + end; + vis_public, + vis_published : + result:=true; + end; + end; + + + function is_visible_for_object(pd:tprocdef;contextobjdef:tabstractrecorddef):boolean; + begin + result:=is_visible_for_object(pd.owner,pd.visibility,contextobjdef); + end; + + + function is_visible_for_object(sym:tsym;contextobjdef:tabstractrecorddef):boolean; + var + i : longint; + pd : tprocdef; + begin + if sym.typ=procsym then + begin + { A procsym is visible, when there is at least one of the procdefs visible } + result:=false; + for i:=0 to tprocsym(sym).ProcdefList.Count-1 do + begin + pd:=tprocdef(tprocsym(sym).ProcdefList[i]); + if (pd.owner=sym.owner) and + is_visible_for_object(pd,contextobjdef) then + begin + result:=true; + exit; + end; + end; + end + else + result:=is_visible_for_object(sym.owner,sym.visibility,contextobjdef); + end; + + + function searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean; + begin + result:=searchsym_maybe_with_symoption(s,srsym,srsymtable,false,sp_none); + end; + + function searchsym_maybe_with_symoption(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;searchoption:boolean;option:tsymoption):boolean; + var + hashedid : THashedIDString; + contextstructdef : tabstractrecorddef; + stackitem : psymtablestackitem; + begin + result:=false; + hashedid.id:=s; + stackitem:=symtablestack.stack; + while assigned(stackitem) do + begin + srsymtable:=stackitem^.symtable; + if (srsymtable.symtabletype=objectsymtable) then + begin + { TODO : implement the search for an option in classes as well } + if searchoption then + begin + result:=false; + exit; + end; + if searchsym_in_class(tobjectdef(srsymtable.defowner),tobjectdef(srsymtable.defowner),s,srsym,srsymtable,true) then + begin + result:=true; + exit; + end; + end + else + begin + srsym:=tsym(srsymtable.FindWithHash(hashedid)); + if assigned(srsym) then + begin + { use the class from withsymtable only when it is + defined in this unit } + if (srsymtable.symtabletype=withsymtable) and + assigned(srsymtable.defowner) and + (srsymtable.defowner.typ in [recorddef,objectdef]) and + (srsymtable.defowner.owner.symtabletype in [globalsymtable,staticsymtable,objectsymtable,recordsymtable]) and + (srsymtable.defowner.owner.iscurrentunit) then + contextstructdef:=tabstractrecorddef(srsymtable.defowner) + else + contextstructdef:=current_structdef; + if not (srsym.owner.symtabletype in [objectsymtable,recordsymtable]) or + is_visible_for_object(srsym,contextstructdef) and + (not searchoption or (option in srsym.symoptions)) then + begin + { we need to know if a procedure references symbols + in the static symtable, because then it can't be + inlined from outside this unit } + if assigned(current_procinfo) and + (srsym.owner.symtabletype=staticsymtable) then + include(current_procinfo.flags,pi_uses_static_symtable); + addsymref(srsym); + result:=true; + exit; + end; + end; + end; + stackitem:=stackitem^.next; + end; + srsym:=nil; + srsymtable:=nil; + end; + + function searchsym_with_symoption(const s: TIDString;out srsym:tsym;out + srsymtable:TSymtable;option:tsymoption):boolean; + begin + result:=searchsym_maybe_with_symoption(s,srsym,srsymtable,true,option); + end; + + function searchsym_type(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean; + var + hashedid : THashedIDString; + stackitem : psymtablestackitem; + classh : tobjectdef; + begin + result:=false; + hashedid.id:=s; + stackitem:=symtablestack.stack; + while assigned(stackitem) do + begin + { + It is not possible to have type symbols in: + parameters + Exception are classes, objects, records, generic definitions and specializations + that have the parameterized types inserted in the symtable. + } + srsymtable:=stackitem^.symtable; + if (srsymtable.symtabletype=ObjectSymtable) then + begin + classh:=tobjectdef(srsymtable.defowner); + while assigned(classh) do + begin + srsymtable:=classh.symtable; + srsym:=tsym(srsymtable.FindWithHash(hashedid)); + if assigned(srsym) and + not(srsym.typ in [fieldvarsym,paravarsym,propertysym,procsym,labelsym]) and + is_visible_for_object(srsym,current_structdef) then + begin + addsymref(srsym); + result:=true; + exit; + end; + classh:=classh.childof; + end; + end + else + begin + srsym:=tsym(srsymtable.FindWithHash(hashedid)); + if assigned(srsym) and + not(srsym.typ in [fieldvarsym,paravarsym,propertysym,procsym,labelsym]) and + (not (srsym.owner.symtabletype in [objectsymtable,recordsymtable]) or is_visible_for_object(srsym,current_structdef)) then + begin + { we need to know if a procedure references symbols + in the static symtable, because then it can't be + inlined from outside this unit } + if assigned(current_procinfo) and + (srsym.owner.symtabletype=staticsymtable) then + include(current_procinfo.flags,pi_uses_static_symtable); + addsymref(srsym); + result:=true; + exit; + end; + end; + stackitem:=stackitem^.next; + end; + result:=false; + srsym:=nil; + srsymtable:=nil; + end; + + + function searchsym_in_module(pm:pointer;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean; + var + pmod : tmodule; + begin + pmod:=tmodule(pm); + result:=false; + if assigned(pmod.globalsymtable) then + begin + srsym:=tsym(pmod.globalsymtable.Find(s)); + if assigned(srsym) then + begin + srsymtable:=pmod.globalsymtable; + addsymref(srsym); + result:=true; + exit; + end; + end; + { If the module is the current unit we also need + to search the local symtable } + if (pmod=current_module) and + assigned(pmod.localsymtable) then + begin + srsym:=tsym(pmod.localsymtable.Find(s)); + if assigned(srsym) then + begin + srsymtable:=pmod.localsymtable; + addsymref(srsym); + result:=true; + exit; + end; + end; + srsym:=nil; + srsymtable:=nil; + end; + + + function searchsym_in_named_module(const unitname, symname: TIDString; out srsym: tsym; out srsymtable: tsymtable): boolean; + var + stackitem : psymtablestackitem; + begin + result:=false; + stackitem:=symtablestack.stack; + while assigned(stackitem) do + begin + srsymtable:=stackitem^.symtable; + if (srsymtable.symtabletype=globalsymtable) and + (srsymtable.name^=unitname) then + begin + srsym:=tsym(srsymtable.find(symname)); + if not assigned(srsym) then + break; + result:=true; + exit; + end; + stackitem:=stackitem^.next; + end; + + { If the module is the current unit we also need + to search the local symtable } + if (current_module.globalsymtable=srsymtable) and + assigned(current_module.localsymtable) then + begin + srsymtable:=current_module.localsymtable; + srsym:=tsym(srsymtable.find(symname)); + if assigned(srsym) then + begin + result:=true; + exit; + end; + end; + end; + + + function find_real_objcclass_definition(pd: tobjectdef; erroronfailure: boolean): tobjectdef; + var + hashedid : THashedIDString; + stackitem : psymtablestackitem; + srsymtable : tsymtable; + srsym : tsym; + begin + { not a formal definition -> return it } + if not(oo_is_formal in pd.objectoptions) then + begin + result:=pd; + exit; + end; + hashedid.id:=pd.typesym.name; + stackitem:=symtablestack.stack; + while assigned(stackitem) do + begin + srsymtable:=stackitem^.symtable; + { ObjC classes can't appear in generics or as nested class + definitions } + if not(srsymtable.symtabletype in [recordsymtable,ObjectSymtable,parasymtable]) then + begin + srsym:=tsym(srsymtable.FindWithHash(hashedid)); + if assigned(srsym) and + (srsym.typ=typesym) and + is_objcclass(ttypesym(srsym).typedef) and + not(oo_is_formal in tobjectdef(ttypesym(srsym).typedef).objectoptions) then + begin + { the external name for the formal and the real definition must match } + if tobjectdef(ttypesym(srsym).typedef).objextname^<>pd.objextname^ then + begin + Message2(sym_e_external_class_name_mismatch1,pd.objextname^,pd.typename); + MessagePos1(srsym.fileinfo,sym_e_external_class_name_mismatch2,tobjectdef(ttypesym(srsym).typedef).objextname^); + end; + result:=tobjectdef(ttypesym(srsym).typedef); + if assigned(current_procinfo) and + (srsym.owner.symtabletype=staticsymtable) then + include(current_procinfo.flags,pi_uses_static_symtable); + addsymref(srsym); + exit; + end; + end; + stackitem:=stackitem^.next; + end; + { nothing found: optionally give an error and return the original + (empty) one } + if erroronfailure then + Message1(sym_e_objc_formal_class_not_resolved,pd.objrealname^); + result:=pd; + end; + + + function searchsym_in_class(classh,contextclassh:tobjectdef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;searchhelper:boolean):boolean; + var + hashedid : THashedIDString; + orgclass : tobjectdef; + i : longint; + begin + orgclass:=classh; + { in case this is a formal objcclass, first find the real definition } + if assigned(classh) then + begin + if (oo_is_formal in classh.objectoptions) then + classh:=find_real_objcclass_definition(classh,true); + { The contextclassh is used for visibility. The classh must be equal to + or be a parent of contextclassh. E.g. for inherited searches the classh is the + parent or a class helper. } + if not (contextclassh.is_related(classh) or + (assigned(contextclassh.extendeddef) and + (contextclassh.extendeddef.typ=objectdef) and + contextclassh.extendeddef.is_related(classh))) then + internalerror(200811161); + end; + result:=false; + hashedid.id:=s; + { an Objective-C protocol can inherit from multiple other protocols + -> uses ImplementedInterfaces instead } + if is_objcprotocol(classh) then + begin + srsymtable:=classh.symtable; + srsym:=tsym(srsymtable.FindWithHash(hashedid)); + if assigned(srsym) and + is_visible_for_object(srsym,contextclassh) then + begin + addsymref(srsym); + result:=true; + exit; + end; + for i:=0 to classh.ImplementedInterfaces.count-1 do + begin + if searchsym_in_class(TImplementedInterface(classh.ImplementedInterfaces[i]).intfdef,contextclassh,s,srsym,srsymtable,false) then + begin + result:=true; + exit; + end; + end; + end + else + if is_objectpascal_helper(classh) then + begin + { helpers have their own obscure search logic... } + result:=searchsym_in_helper(classh,contextclassh,s,srsym,srsymtable,false); + if result then + exit; + end + else + begin + while assigned(classh) do + begin + { search for a class helper method first if this is an Object + Pascal class } + if is_class(classh) and searchhelper then + begin + result:=search_objectpascal_helper(classh,contextclassh,s,srsym,srsymtable); + if result then + { if the procsym is overloaded we need to use the + "original" symbol; the helper symbol will be found when + searching for overloads } + if (srsym.typ<>procsym) or + not (sp_has_overloaded in tprocsym(srsym).symoptions) then + exit; + end; + srsymtable:=classh.symtable; + srsym:=tsym(srsymtable.FindWithHash(hashedid)); + if assigned(srsym) and + is_visible_for_object(srsym,contextclassh) then + begin + addsymref(srsym); + result:=true; + exit; + end; + classh:=classh.childof; + end; + end; + if is_objcclass(orgclass) then + result:=search_objc_helper(orgclass,s,srsym,srsymtable) + else + begin + srsym:=nil; + srsymtable:=nil; + end; + end; + + function searchsym_in_record(recordh:tabstractrecorddef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean; + var + hashedid : THashedIDString; + begin + result:=false; + hashedid.id:=s; + { search for a record helper method first } + result:=search_objectpascal_helper(recordh,recordh,s,srsym,srsymtable); + if result then + { if the procsym is overloaded we need to use the + "original" symbol; the helper symbol will be found when + searching for overloads } + if (srsym.typ<>procsym) or + not (sp_has_overloaded in tprocsym(srsym).symoptions) then + exit; + srsymtable:=recordh.symtable; + srsym:=tsym(srsymtable.FindWithHash(hashedid)); + if assigned(srsym) and is_visible_for_object(srsym,recordh) then + begin + addsymref(srsym); + result:=true; + exit; + end; + srsym:=nil; + srsymtable:=nil; + end; + + function searchsym_in_class_by_msgint(classh:tobjectdef;msgid:longint;out srdef : tdef;out srsym:tsym;out srsymtable:TSymtable):boolean; + var + def : tdef; + i : longint; + begin + { in case this is a formal objcclass, first find the real definition } + if assigned(classh) and + (oo_is_formal in classh.objectoptions) then + classh:=find_real_objcclass_definition(classh,true); + result:=false; + def:=nil; + while assigned(classh) do + begin + for i:=0 to classh.symtable.DefList.Count-1 do + begin + def:=tstoreddef(classh.symtable.DefList[i]); + { Find also all hidden private methods to + be compatible with delphi, see tw6203 (PFV) } + if (def.typ=procdef) and + (po_msgint in tprocdef(def).procoptions) and + (tprocdef(def).messageinf.i=msgid) then + begin + srdef:=def; + srsym:=tprocdef(def).procsym; + srsymtable:=classh.symtable; + addsymref(srsym); + result:=true; + exit; + end; + end; + classh:=classh.childof; + end; + srdef:=nil; + srsym:=nil; + srsymtable:=nil; + end; + + + function searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string;out srsym:tsym;out srsymtable:TSymtable):boolean; + var + def : tdef; + i : longint; + begin + { in case this is a formal objcclass, first find the real definition } + if assigned(classh) and + (oo_is_formal in classh.objectoptions) then + classh:=find_real_objcclass_definition(classh,true); + result:=false; + def:=nil; + while assigned(classh) do + begin + for i:=0 to classh.symtable.DefList.Count-1 do + begin + def:=tstoreddef(classh.symtable.DefList[i]); + { Find also all hidden private methods to + be compatible with delphi, see tw6203 (PFV) } + if (def.typ=procdef) and + (po_msgstr in tprocdef(def).procoptions) and + (tprocdef(def).messageinf.str^=s) then + begin + srsym:=tprocdef(def).procsym; + srsymtable:=classh.symtable; + addsymref(srsym); + result:=true; + exit; + end; + end; + classh:=classh.childof; + end; + srsym:=nil; + srsymtable:=nil; + end; + + function searchsym_in_helper(classh,contextclassh:tobjectdef;const s: TIDString;out srsym:tsym;out srsymtable:TSymtable;aHasInherited:boolean):boolean; + var + hashedid : THashedIDString; + parentclassh : tobjectdef; + begin + result:=false; + if not is_objectpascal_helper(classh) then + Internalerror(2011030101); + hashedid.id:=s; + { in a helper things are a bit more complex: + 1. search the symbol in the helper (if not "inherited") + 2. search the symbol in the extended type + 3. search the symbol in the parent helpers + 4. only classes: search the symbol in the parents of the extended type + } + if not aHasInherited then + begin + { search in the helper itself } + srsymtable:=classh.symtable; + srsym:=tsym(srsymtable.FindWithHash(hashedid)); + if assigned(srsym) and + is_visible_for_object(srsym,contextclassh) then + begin + addsymref(srsym); + result:=true; + exit; + end; + end; + { now search in the extended type itself } + if classh.extendeddef.typ in [recorddef,objectdef] then + begin + srsymtable:=tabstractrecorddef(classh.extendeddef).symtable; + srsym:=tsym(srsymtable.FindWithHash(hashedid)); + if assigned(srsym) and + is_visible_for_object(srsym,contextclassh) then + begin + addsymref(srsym); + result:=true; + exit; + end; + end; + { now search in the parent helpers } + parentclassh:=classh.childof; + while assigned(parentclassh) do + begin + srsymtable:=parentclassh.symtable; + srsym:=tsym(srsymtable.FindWithHash(hashedid)); + if assigned(srsym) and + is_visible_for_object(srsym,contextclassh) then + begin + addsymref(srsym); + result:=true; + exit; + end; + parentclassh:=parentclassh.childof; + end; + if is_class(classh.extendeddef) then + { now search in the parents of the extended class (with helpers!) } + result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,true); + { addsymref is already called by searchsym_in_class } + end; + + function search_specific_assignment_operator(assignment_type:ttoken;from_def,to_def:Tdef):Tprocdef; + var + sym : Tprocsym; + hashedid : THashedIDString; + curreq, + besteq : tequaltype; + currpd, + bestpd : tprocdef; + stackitem : psymtablestackitem; + begin + hashedid.id:=overloaded_names[assignment_type]; + besteq:=te_incompatible; + bestpd:=nil; + stackitem:=symtablestack.stack; + while assigned(stackitem) do + begin + sym:=Tprocsym(stackitem^.symtable.FindWithHash(hashedid)); + if sym<>nil then + begin + if sym.typ<>procsym then + internalerror(200402031); + { if the source type is an alias then this is only the second choice, + if you mess with this code, check tw4093 } + currpd:=sym.find_procdef_assignment_operator(from_def,to_def,curreq); + if curreq>besteq then + begin + besteq:=curreq; + bestpd:=currpd; + if (besteq=te_exact) then + break; + end; + end; + stackitem:=stackitem^.next; + end; + result:=bestpd; + end; + + + function search_assignment_operator(from_def,to_def:Tdef;explicit:boolean):Tprocdef; + begin + { search record/object symtable first for a suitable operator } + if from_def.typ in [recorddef,objectdef] then + symtablestack.push(tabstractrecorddef(from_def).symtable); + if to_def.typ in [recorddef,objectdef] then + symtablestack.push(tabstractrecorddef(to_def).symtable); + + { if type conversion is explicit then search first for explicit + operator overload and if not found then use implicit operator } + if explicit then + result:=search_specific_assignment_operator(_OP_EXPLICIT,from_def,to_def) + else + result:=nil; + if result=nil then + result:=search_specific_assignment_operator(_ASSIGNMENT,from_def,to_def); + + { restore symtable stack } + if to_def.typ in [recorddef,objectdef] then + symtablestack.pop(tabstractrecorddef(to_def).symtable); + if from_def.typ in [recorddef,objectdef] then + symtablestack.pop(tabstractrecorddef(from_def).symtable); + end; + + + function search_enumerator_operator(from_def,to_def:Tdef): Tprocdef; + var + sym : Tprocsym; + hashedid : THashedIDString; + curreq, + besteq : tequaltype; + currpd, + bestpd : tprocdef; + stackitem : psymtablestackitem; + begin + hashedid.id:='enumerator'; + besteq:=te_incompatible; + bestpd:=nil; + stackitem:=symtablestack.stack; + while assigned(stackitem) do + begin + sym:=Tprocsym(stackitem^.symtable.FindWithHash(hashedid)); + if sym<>nil then + begin + if sym.typ<>procsym then + internalerror(200910241); + { if the source type is an alias then this is only the second choice, + if you mess with this code, check tw4093 } + currpd:=sym.find_procdef_enumerator_operator(from_def,to_def,curreq); + if curreq>besteq then + begin + besteq:=curreq; + bestpd:=currpd; + if (besteq=te_exact) then + break; + end; + end; + stackitem:=stackitem^.next; + end; + result:=bestpd; + end; + + + function search_system_type(const s: TIDString): ttypesym; + var + sym : tsym; + begin + sym:=tsym(systemunit.Find(s)); + if not assigned(sym) or + (sym.typ<>typesym) then + cgmessage1(cg_f_unknown_system_type,s); + result:=ttypesym(sym); + end; + + + function try_search_system_type(const s: TIDString): ttypesym; + var + sym : tsym; + begin + sym:=tsym(systemunit.Find(s)); + if not assigned(sym) then + result:=nil + else + begin + if sym.typ<>typesym then + cgmessage1(cg_f_unknown_system_type,s); + result:=ttypesym(sym); + end; + end; + + + function search_named_unit_globaltype(const unitname, typename: TIDString; throwerror: boolean): ttypesym; + var + srsymtable: tsymtable; + sym: tsym; + begin + if searchsym_in_named_module(unitname,typename,sym,srsymtable) and + (sym.typ=typesym) then + begin + result:=ttypesym(sym); + exit; + end + else + begin + if throwerror then + cgmessage2(cg_f_unknown_type_in_unit,typename,unitname); + result:=nil; + end; + end; + + function search_last_objectpascal_helper(pd,contextclassh : tabstractrecorddef;out odef : tobjectdef):boolean; + var + s: string; + list: TFPObjectList; + i: integer; + st: tsymtable; + begin + result:=false; + odef:=nil; + { when there are no helpers active currently then we don't need to do + anything } + if current_module.extendeddefs.count=0 then + exit; + { no helpers for anonymous types } + if not assigned(pd.objrealname) or (pd.objrealname^='') then + exit; + { if pd is defined inside a procedure we must not use make_mangledname + (as a helper may not be defined in a procedure this is no problem...)} + st:=pd.owner; + while st.symtabletype in [objectsymtable,recordsymtable] do + st:=st.defowner.owner; + if st.symtabletype=localsymtable then + exit; + { the mangled name is used as the key for tmodule.extendeddefs } + s:=make_mangledname('',pd.symtable,''); + list:=TFPObjectList(current_module.extendeddefs.Find(s)); + if assigned(list) and (list.count>0) then + begin + i:=list.count-1; + repeat + odef:=tobjectdef(list[list.count-1]); + result:=(odef.owner.symtabletype in [staticsymtable,globalsymtable]) or + is_visible_for_object(tobjectdef(list[i]).typesym,contextclassh); + dec(i); + until result or (i<0); + if not result then + { just to be sure that noone uses odef } + odef:=nil; + end; + end; + + function search_objectpascal_helper(pd,contextclassh : tabstractrecorddef;const s: string; out srsym: tsym; out srsymtable: tsymtable):boolean; + + var + hashedid : THashedIDString; + classh : tobjectdef; + i : integer; + pdef : tprocdef; + begin + result:=false; + + { if there is no class helper for the class then there is no need to + search further } + if not search_last_objectpascal_helper(pd,contextclassh,classh) then + exit; + + hashedid.id:=s; + + repeat + srsymtable:=classh.symtable; + srsym:=tsym(srsymtable.FindWithHash(hashedid)); + + if srsym<>nil then + begin + if srsym.typ=propertysym then + begin + result:=true; + exit; + end; + for i:=0 to tprocsym(srsym).procdeflist.count-1 do + begin + pdef:=tprocdef(tprocsym(srsym).procdeflist[i]); + if not is_visible_for_object(pdef.owner,pdef.visibility,contextclassh) then + continue; + { we need to know if a procedure references symbols + in the static symtable, because then it can't be + inlined from outside this unit } + if assigned(current_procinfo) and + (srsym.owner.symtabletype=staticsymtable) then + include(current_procinfo.flags,pi_uses_static_symtable); + { the first found method wins } + srsym:=tprocdef(tprocsym(srsym).procdeflist[i]).procsym; + srsymtable:=srsym.owner; + addsymref(srsym); + result:=true; + exit; + end; + end; + + { try the helper parent if available } + classh:=classh.childof; + until classh=nil; + + srsym:=nil; + srsymtable:=nil; + end; + + function search_objc_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean; + var + hashedid : THashedIDString; + stackitem : psymtablestackitem; + i : longint; + defowner : tobjectdef; + begin + hashedid.id:=class_helper_prefix+s; + stackitem:=symtablestack.stack; + while assigned(stackitem) do + begin + srsymtable:=stackitem^.symtable; + srsym:=tsym(srsymtable.FindWithHash(hashedid)); + if assigned(srsym) then + begin + if not(srsymtable.symtabletype in [globalsymtable,staticsymtable]) or + not(srsym.owner.symtabletype in [globalsymtable,staticsymtable]) or + (srsym.typ<>procsym) then + internalerror(2009111505); + { check whether this procsym includes a helper for this particular class } + for i:=0 to tprocsym(srsym).procdeflist.count-1 do + begin + { does pd inherit from (or is the same as) the class + that this method's category extended? + + Warning: this list contains both category and objcclass methods + (for id.randommethod), so only check category methods here + } + defowner:=tobjectdef(tprocdef(tprocsym(srsym).procdeflist[i]).owner.defowner); + if (oo_is_classhelper in defowner.objectoptions) and + pd.is_related(defowner.childof) then + begin + { we need to know if a procedure references symbols + in the static symtable, because then it can't be + inlined from outside this unit } + if assigned(current_procinfo) and + (srsym.owner.symtabletype=staticsymtable) then + include(current_procinfo.flags,pi_uses_static_symtable); + { no need to keep looking. There might be other + categories that extend this, a parent or child + class with a method with the same name (either + overriding this one, or overridden by this one), + but that doesn't matter as far as the basic + procsym is concerned. + } + srsym:=tprocdef(tprocsym(srsym).procdeflist[i]).procsym; + srsymtable:=srsym.owner; + addsymref(srsym); + result:=true; + exit; + end; + end; + end; + stackitem:=stackitem^.next; + end; + srsym:=nil; + srsymtable:=nil; + result:=false; + end; + + + function search_objc_method(const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean; + var + hashedid : THashedIDString; + stackitem : psymtablestackitem; + i : longint; + begin + hashedid.id:=class_helper_prefix+s; + stackitem:=symtablestack.stack; + while assigned(stackitem) do + begin + srsymtable:=stackitem^.symtable; + srsym:=tsym(srsymtable.FindWithHash(hashedid)); + if assigned(srsym) then + begin + if not(srsymtable.symtabletype in [globalsymtable,staticsymtable]) or + not(srsym.owner.symtabletype in [globalsymtable,staticsymtable]) or + (srsym.typ<>procsym) then + internalerror(2009112005); + { check whether this procsym includes a helper for this particular class } + for i:=0 to tprocsym(srsym).procdeflist.count-1 do + begin + { we need to know if a procedure references symbols + in the static symtable, because then it can't be + inlined from outside this unit } + if assigned(current_procinfo) and + (srsym.owner.symtabletype=staticsymtable) then + include(current_procinfo.flags,pi_uses_static_symtable); + { no need to keep looking. There might be other + methods with the same name, but that doesn't matter + as far as the basic procsym is concerned. + } + srsym:=tprocdef(tprocsym(srsym).procdeflist[i]).procsym; + { We need the symtable in which the classhelper-like sym + is located, not the objectdef. The reason is that the + callnode will climb the symtablestack until it encounters + this symtable to start looking for overloads (and it won't + find the objectsymtable in which this method sym is + located + + srsymtable:=srsym.owner; + } + addsymref(srsym); + result:=true; + exit; + end; + end; + stackitem:=stackitem^.next; + end; + srsym:=nil; + srsymtable:=nil; + result:=false; + end; + + + function search_struct_member(pd : tabstractrecorddef;const s : string):tsym; + { searches n in symtable of pd and all anchestors } + var + hashedid : THashedIDString; + srsym : tsym; + orgpd : tabstractrecorddef; + srsymtable : tsymtable; + begin + { in case this is a formal objcclass, first find the real definition } + if (oo_is_formal in pd.objectoptions) then + pd:=find_real_objcclass_definition(tobjectdef(pd),true); + if search_objectpascal_helper(pd, pd, s, result, srsymtable) then + exit; + hashedid.id:=s; + orgpd:=pd; + while assigned(pd) do + begin + srsym:=tsym(pd.symtable.FindWithHash(hashedid)); + if assigned(srsym) then + begin + search_struct_member:=srsym; + exit; + end; + if pd.typ=objectdef then + pd:=tobjectdef(pd).childof + else + pd:=nil; + end; + + { not found, now look for class helpers } + if is_objcclass(pd) then + search_objc_helper(tobjectdef(orgpd),s,result,srsymtable) + else + result:=nil; + end; + + + function search_macro(const s : string):tsym; + var + stackitem : psymtablestackitem; + hashedid : THashedIDString; + srsym : tsym; + begin + hashedid.id:=s; + + { First search the localmacrosymtable before searching the + global macrosymtables from the units } + if assigned(current_module) then + begin + srsym:=tsym(current_module.localmacrosymtable.FindWithHash(hashedid)); + if assigned(srsym) then + begin + result:= srsym; + exit; + end; + end; + + stackitem:=macrosymtablestack.stack; + while assigned(stackitem) do + begin + srsym:=tsym(stackitem^.symtable.FindWithHash(hashedid)); + if assigned(srsym) then + begin + result:= srsym; + exit; + end; + stackitem:=stackitem^.next; + end; + result:= nil; + end; + + + function defined_macro(const s : string):boolean; + var + mac: tmacro; + begin + mac:=tmacro(search_macro(s)); + if assigned(mac) then + begin + mac.is_used:=true; + defined_macro:=mac.defined; + end + else + defined_macro:=false; + end; + + +{**************************************************************************** + Object Helpers +****************************************************************************} + + function search_default_property(pd : tabstractrecorddef) : tpropertysym; + { returns the default property of a class, searches also anchestors } + var + _defaultprop : tpropertysym; + helperpd : tobjectdef; + begin + _defaultprop:=nil; + { first search in helper's hierarchy } + if search_last_objectpascal_helper(pd,nil,helperpd) then + while assigned(helperpd) do + begin + helperpd.symtable.SymList.ForEachCall(@tstoredsymtable(helperpd.symtable).testfordefaultproperty,@_defaultprop); + if assigned(_defaultprop) then + break; + helperpd:=helperpd.childof; + end; + if assigned(_defaultprop) then + begin + search_default_property:=_defaultprop; + exit; + end; + { now search in the type's hierarchy itself } + while assigned(pd) do + begin + pd.symtable.SymList.ForEachCall(@tstoredsymtable(pd.symtable).testfordefaultproperty,@_defaultprop); + if assigned(_defaultprop) then + break; + if (pd.typ=objectdef) then + pd:=tobjectdef(pd).childof + else + break; + end; + search_default_property:=_defaultprop; + end; + + +{**************************************************************************** + Macro Helpers +****************************************************************************} + + procedure def_system_macro(const name : string); + var + mac : tmacro; + s: string; + begin + if name = '' then + internalerror(2004121202); + s:= upper(name); + mac:=tmacro(search_macro(s)); + if not assigned(mac) then + begin + mac:=tmacro.create(s); + if assigned(current_module) then + current_module.localmacrosymtable.insert(mac) + else + initialmacrosymtable.insert(mac); + end; + Message1(parser_c_macro_defined,mac.name); + mac.defined:=true; + end; + + + procedure set_system_macro(const name, value : string); + var + mac : tmacro; + s: string; + begin + if name = '' then + internalerror(2004121203); + s:= upper(name); + mac:=tmacro(search_macro(s)); + if not assigned(mac) then + begin + mac:=tmacro.create(s); + if assigned(current_module) then + current_module.localmacrosymtable.insert(mac) + else + initialmacrosymtable.insert(mac); + end + else + begin + mac.is_compiler_var:=false; + if assigned(mac.buftext) then + freemem(mac.buftext,mac.buflen); + end; + Message2(parser_c_macro_set_to,mac.name,value); + mac.buflen:=length(value); + getmem(mac.buftext,mac.buflen); + move(value[1],mac.buftext^,mac.buflen); + mac.defined:=true; + end; + + + procedure set_system_compvar(const name, value : string); + var + mac : tmacro; + s: string; + begin + if name = '' then + internalerror(2004121204); + s:= upper(name); + mac:=tmacro(search_macro(s)); + if not assigned(mac) then + begin + mac:=tmacro.create(s); + mac.is_compiler_var:=true; + if assigned(current_module) then + current_module.localmacrosymtable.insert(mac) + else + initialmacrosymtable.insert(mac); + end + else + begin + mac.is_compiler_var:=true; + if assigned(mac.buftext) then + freemem(mac.buftext,mac.buflen); + end; + Message2(parser_c_macro_set_to,mac.name,value); + mac.buflen:=length(value); + getmem(mac.buftext,mac.buflen); + move(value[1],mac.buftext^,mac.buflen); + mac.defined:=true; + end; + + + procedure undef_system_macro(const name : string); + var + mac : tmacro; + s: string; + begin + if name = '' then + internalerror(2004121205); + s:= upper(name); + mac:=tmacro(search_macro(s)); + if not assigned(mac) then + {If not found, then it's already undefined.} + else + begin + Message1(parser_c_macro_undefined,mac.name); + mac.defined:=false; + mac.is_compiler_var:=false; + { delete old definition } + if assigned(mac.buftext) then + begin + freemem(mac.buftext,mac.buflen); + mac.buftext:=nil; + end; + end; + end; + + +{$ifdef UNITALIASES} +{**************************************************************************** + TUNIT_ALIAS + ****************************************************************************} + + constructor tunit_alias.create(const n:string); + var + i : longint; + begin + i:=pos('=',n); + if i=0 then + fail; + inherited createname(Copy(n,1,i-1)); + newname:=stringdup(Copy(n,i+1,255)); + end; + + + destructor tunit_alias.destroy; + begin + stringdispose(newname); + inherited destroy; + end; + + + procedure addunitalias(const n:string); + begin + unitaliases^.insert(tunit_alias,init(Upper(n)))); + end; + + + function getunitalias(const n:string):string; + var + p : punit_alias; + begin + p:=punit_alias(unitaliases^.Find(Upper(n))); + if assigned(p) then + getunitalias:=punit_alias(p).newname^ + else + getunitalias:=n; + end; +{$endif UNITALIASES} + + +{**************************************************************************** + Init/Done Symtable +****************************************************************************} + + procedure InitSymtable; + begin + { Reset symbolstack } + symtablestack:=nil; + systemunit:=nil; + { create error syms and def } + generrorsym:=terrorsym.create; + generrordef:=terrordef.create; + { macros } + initialmacrosymtable:=tmacrosymtable.create(false); + macrosymtablestack:=TSymtablestack.create; + macrosymtablestack.push(initialmacrosymtable); +{$ifdef UNITALIASES} + { unit aliases } + unitaliases:=TFPHashObjectList.create; +{$endif} + { set some global vars to nil, might be important for the ide } + class_tobject:=nil; + interface_iunknown:=nil; + interface_idispatch:=nil; + rec_tguid:=nil; + dupnr:=0; + end; + + + procedure DoneSymtable; + begin + generrorsym.owner:=nil; + generrorsym.free; + generrordef.owner:=nil; + generrordef.free; + initialmacrosymtable.free; + macrosymtablestack.free; +{$ifdef UNITALIASES} + unitaliases.free; +{$endif} + end; + +end. diff --git a/closures/compiler/symtype.pas b/closures/compiler/symtype.pas new file mode 100644 index 0000000000..9b0a70beb1 --- /dev/null +++ b/closures/compiler/symtype.pas @@ -0,0 +1,1034 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller + + This unit handles the symbol 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 symtype; + +{$i fpcdefs.inc} + +interface + + uses + { common } + cutils, + cclasses, + { global } + globtype,globals,constexp, + { symtable } + symconst,symbase, + { aasm } + aasmbase,ppu,cpuinfo + ; + + type +{************************************************ + Required Forwards +************************************************} + + tsym = class; + Tcompilerppufile=class; + + +{************************************************ + TDef +************************************************} + + tgeTSymtable = (gs_none,gs_record,gs_local,gs_para); + + tdef = class(TDefEntry) + typesym : tsym; { which type the definition was generated this def } + { maybe it's useful to merge the dwarf and stabs debugging info with some hacking } + { dwarf debugging } + dwarf_lab : tasmsymbol; + dwarf_ref_lab : tasmsymbol; + { stabs debugging } + stab_number : word; + dbg_state : tdefdbgstatus; + defoptions : tdefoptions; + defstates : tdefstates; + constructor create(dt:tdeftyp); + procedure buildderef;virtual;abstract; + procedure buildderefimpl;virtual;abstract; + procedure deref;virtual;abstract; + procedure derefimpl;virtual;abstract; + function typename:string; + function GetTypeName:string;virtual; + function typesymbolprettyname:string;virtual; + function mangledparaname:string; + function getmangledparaname:string;virtual; + function rtti_mangledname(rt:trttitype):string;virtual;abstract; + function OwnerHierarchyName: string; virtual; abstract; + function size:asizeint;virtual;abstract; + function packedbitsize:asizeint;virtual; + function alignment:shortint;virtual;abstract; + function getvardef:longint;virtual;abstract; + function getparentdef:tdef;virtual; + function geTSymtable(t:tgeTSymtable):TSymtable;virtual; + function is_publishable:boolean;virtual;abstract; + function needs_inittable:boolean;virtual;abstract; + function is_related(def:tdef):boolean;virtual; + procedure ChangeOwner(st:TSymtable); + procedure register_created_object_type;virtual; + end; + +{************************************************ + TSym +************************************************} + + { this object is the base for all symbol objects } + + { tsym } + + tsym = class(TSymEntry) + protected + public + fileinfo : tfileposinfo; + { size of fileinfo is 10 bytes, so if a >word aligned type would follow, + two bytes of memory would be wasted, so we put two one byte fields over here } + visibility : tvisibility; + isdbgwritten : boolean; + symoptions : tsymoptions; + refs : longint; + reflist : TLinkedList; + { deprecated optionally can have a message } + deprecatedmsg: pshortstring; + constructor create(st:tsymtyp;const aname:string); + destructor destroy;override; + function mangledname:string; virtual; + function prettyname:string; virtual; + procedure buildderef;virtual; + procedure deref;virtual; + procedure ChangeOwner(st:TSymtable); + procedure IncRefCount; + procedure IncRefCountBy(AValue : longint); + procedure MaybeCreateRefList; + procedure AddRef; + end; + + tsymarr = array[0..maxlongint div sizeof(pointer)-1] of tsym; + psymarr = ^tsymarr; + +{************************************************ + TDeref +************************************************} + + tderef = object + dataidx : longint; + procedure reset; + procedure build(s:TObject); + function resolve:TObject; + end; + +{************************************************ + tpropaccesslist +************************************************} + + ppropaccesslistitem = ^tpropaccesslistitem; + tpropaccesslistitem = record + sltype : tsltype; + next : ppropaccesslistitem; + case byte of + 0 : (sym : tsym; symderef : tderef); + 1 : (value : TConstExprInt; valuedef: tdef; valuedefderef:tderef); + 2 : (def: tdef; defderef:tderef); + end; + + tpropaccesslist = class + procdef : tdef; + procdefderef : tderef; + firstsym, + lastsym : ppropaccesslistitem; + constructor create; + destructor destroy;override; + function empty:boolean; + procedure addsym(slt:tsltype;p:tsym); + procedure addconst(slt:tsltype;v:TConstExprInt;d:tdef); + procedure addtype(slt:tsltype;d:tdef); + procedure addsymderef(slt:tsltype;d:tderef); + procedure addconstderef(slt:tsltype;v:TConstExprInt;d:tderef); + procedure addtypederef(slt:tsltype;d:tderef); + procedure clear; + procedure resolve; + procedure buildderef; + end; + +{************************************************ + Tcompilerppufile +************************************************} + tcompilerppufile=class(tppufile) + public + procedure checkerror; + procedure getguid(var g: tguid); + function getexprint:Tconstexprint; + function getptruint:TConstPtrUInt; + procedure getposinfo(var p:tfileposinfo); + procedure getderef(var d:tderef); + function getpropaccesslist:tpropaccesslist; + function getasmsymbol:tasmsymbol; + procedure putguid(const g: tguid); + procedure putexprint(const v:tconstexprint); + procedure PutPtrUInt(v:TConstPtrUInt); + procedure putposinfo(const p:tfileposinfo); + procedure putderef(const d:tderef); + procedure putpropaccesslist(p:tpropaccesslist); + procedure putasmsymbol(s:tasmsymbol); + end; + +{$ifdef MEMDEBUG} + var + memmanglednames, + memprocpara, + memprocparast, + memproclocalst, + memprocnodetree : tmemdebug; +{$endif MEMDEBUG} + + function FindUnitSymtable(st:TSymtable):TSymtable; + + +implementation + + uses + crefs, + verbose, + fmodule + ; + +{**************************************************************************** + Utils +****************************************************************************} + + function FindUnitSymtable(st:TSymtable):TSymtable; + begin + result:=nil; + repeat + if not assigned(st) then + internalerror(200602034); + case st.symtabletype of + localmacrosymtable, + exportedmacrosymtable, + staticsymtable, + globalsymtable : + begin + result:=st; + exit; + end; + recordsymtable, + enumsymtable, + arraysymtable, + localsymtable, + parasymtable, + ObjectSymtable : + st:=st.defowner.owner; + else + internalerror(200602035); + end; + until false; + end; + + +{**************************************************************************** + Tdef +****************************************************************************} + + constructor tdef.create(dt:tdeftyp); + begin + inherited create; + typ:=dt; + owner := nil; + typesym := nil; + defoptions:=[]; + dbg_state:=dbg_state_unused; + stab_number:=0; + end; + + + function tdef.typename:string; + begin + result:=OwnerHierarchyName; + if assigned(typesym) and + not(typ in [procvardef,procdef]) and + (typesym.realname[1]<>'$') then + result:=result+typesym.realname + else + result:=result+GetTypeName; + end; + + + function tdef.GetTypeName : string; + begin + GetTypeName:='<unknown type>' + end; + + + function tdef.typesymbolprettyname:string; + begin + result:=OwnerHierarchyName; + if assigned(typesym) then + result:=result+typesym.prettyname + else + result:=result+'<no type symbol>' + end; + + + function tdef.mangledparaname:string; + begin + if assigned(typesym) then + mangledparaname:=typesym.name + else + mangledparaname:=getmangledparaname; + end; + + + function tdef.getmangledparaname:string; + begin + result:='<unknown type>'; + end; + + + function tdef.getparentdef:tdef; + begin + result:=nil; + end; + + + function tdef.geTSymtable(t:tgeTSymtable):TSymtable; + begin + result:=nil; + end; + + + function tdef.is_related(def:tdef):boolean; + begin + result:=false; + end; + + + function tdef.packedbitsize:asizeint; + begin + result:=size * 8; + end; + + + procedure tdef.ChangeOwner(st:TSymtable); + begin +// if assigned(Owner) then +// Owner.DefList.List[i]:=nil; + Owner:=st; + Owner.DefList.Add(self); + end; + + + procedure tdef.register_created_object_type; + begin + end; + +{**************************************************************************** + TSYM (base for all symtypes) +****************************************************************************} + + constructor tsym.create(st:tsymtyp;const aname:string); + begin + inherited CreateNotOwned; + realname:=aname; + typ:=st; + RefList:=nil; + symoptions:=[]; + fileinfo:=current_tokenpos; + isdbgwritten := false; + visibility:=vis_public; + deprecatedmsg:=nil; + end; + + destructor Tsym.destroy; + begin + stringdispose(deprecatedmsg); + if assigned(RefList) then + RefList.Free; + inherited Destroy; + end; + + procedure Tsym.IncRefCount; + begin + inc(refs); + if cs_browser in current_settings.moduleswitches then + begin + MaybeCreateRefList; + AddRef; + end; + end; + + procedure Tsym.IncRefCountBy(AValue : longint); + begin + inc(refs,AValue); + end; + + procedure Tsym.MaybeCreateRefList; + begin + if not assigned(reflist) then + reflist:=TRefLinkedList.create; + end; + + procedure Tsym.AddRef; + var + RefItem: TRefItem; + begin + RefItem:=TRefItem.Create(current_tokenpos); + RefList.Concat(RefItem); + end; + + procedure Tsym.buildderef; + begin + end; + + + procedure Tsym.deref; + begin + end; + + + function tsym.mangledname : string; + begin + internalerror(200204171); + result:=''; + end; + + + function tsym.prettyname : string; + begin + result:=realname; + end; + + + procedure tsym.ChangeOwner(st:TSymtable); + begin + Owner:=st; + inherited ChangeOwner(Owner.SymList); + end; + + +{**************************************************************************** + tpropaccesslist +****************************************************************************} + + constructor tpropaccesslist.create; + begin + procdef:=nil; { needed for procedures } + firstsym:=nil; + lastsym:=nil; + end; + + + destructor tpropaccesslist.destroy; + begin + clear; + end; + + + function tpropaccesslist.empty:boolean; + begin + empty:=(firstsym=nil); + end; + + + procedure tpropaccesslist.clear; + var + hp : ppropaccesslistitem; + begin + while assigned(firstsym) do + begin + hp:=firstsym; + firstsym:=firstsym^.next; + dispose(hp); + end; + firstsym:=nil; + lastsym:=nil; + procdef:=nil; + end; + + + procedure tpropaccesslist.addsym(slt:tsltype;p:tsym); + var + hp : ppropaccesslistitem; + begin + new(hp); + fillchar(hp^,sizeof(tpropaccesslistitem),0); + hp^.sltype:=slt; + hp^.sym:=p; + hp^.symderef.reset; + if assigned(lastsym) then + lastsym^.next:=hp + else + firstsym:=hp; + lastsym:=hp; + end; + + + procedure tpropaccesslist.addconst(slt:tsltype;v:TConstExprInt;d:tdef); + var + hp : ppropaccesslistitem; + begin + new(hp); + fillchar(hp^,sizeof(tpropaccesslistitem),0); + hp^.sltype:=slt; + hp^.value:=v; + hp^.valuedef:=d; + hp^.valuedefderef.reset; + if assigned(lastsym) then + lastsym^.next:=hp + else + firstsym:=hp; + lastsym:=hp; + end; + + + procedure tpropaccesslist.addtype(slt:tsltype;d:tdef); + var + hp : ppropaccesslistitem; + begin + new(hp); + fillchar(hp^,sizeof(tpropaccesslistitem),0); + hp^.sltype:=slt; + hp^.def:=d; + hp^.defderef.reset; + if assigned(lastsym) then + lastsym^.next:=hp + else + firstsym:=hp; + lastsym:=hp; + end; + + + procedure tpropaccesslist.addsymderef(slt:tsltype;d:tderef); + begin + addsym(slt,nil); + lastsym^.symderef:=d; + end; + + + procedure tpropaccesslist.addconstderef(slt:tsltype;v:TConstExprInt;d:tderef); + begin + addconst(slt,v,nil); + lastsym^.valuedefderef:=d; + end; + + + procedure tpropaccesslist.addtypederef(slt:tsltype;d:tderef); + begin + addtype(slt,nil); + lastsym^.defderef:=d; + end; + + + procedure tpropaccesslist.resolve; + var + hp : ppropaccesslistitem; + begin + procdef:=tdef(procdefderef.resolve); + hp:=firstsym; + while assigned(hp) do + begin + case hp^.sltype of + sl_call, + sl_load, + sl_subscript : + hp^.sym:=tsym(hp^.symderef.resolve); + sl_absolutetype, + sl_typeconv : + hp^.def:=tdef(hp^.defderef.resolve); + sl_vec: + hp^.valuedef:=tdef(hp^.valuedefderef.resolve); + else + internalerror(200110205); + end; + hp:=hp^.next; + end; + end; + + + procedure tpropaccesslist.buildderef; + var + hp : ppropaccesslistitem; + begin + procdefderef.build(procdef); + hp:=firstsym; + while assigned(hp) do + begin + case hp^.sltype of + sl_call, + sl_load, + sl_subscript : + hp^.symderef.build(hp^.sym); + sl_absolutetype, + sl_typeconv : + hp^.defderef.build(hp^.def); + sl_vec: + hp^.valuedefderef.build(hp^.valuedef); + else + internalerror(200110205); + end; + hp:=hp^.next; + end; + end; + + +{**************************************************************************** + Tderef +****************************************************************************} + + + procedure tderef.reset; + begin + dataidx:=-1; + end; + + + procedure tderef.build(s:TObject); + var + len : byte; + st : TSymtable; + data : array[0..255] of byte; + idx : word; + begin + { skip length byte } + len:=1; + + if assigned(s) then + begin +{ TODO: ugly hack} + if s is tsym then + st:=FindUnitSymtable(tsym(s).owner) + else + st:=FindUnitSymtable(tdef(s).owner); + if not st.iscurrentunit then + begin + { register that the unit is needed for resolving } + data[len]:=ord(deref_unit); + idx:=current_module.derefidx_unit(st.moduleid); + data[len+1]:=idx shr 8 and $ff; + data[len+2]:=idx and $ff; + inc(len,3); + end; + if s is tsym then + begin + data[len]:=ord(deref_symid); + data[len+1]:=tsym(s).symid shr 24 and $ff; + data[len+2]:=tsym(s).symid shr 16 and $ff; + data[len+3]:=tsym(s).symid shr 8 and $ff; + data[len+4]:=tsym(s).symid and $ff; + inc(len,5); + end + else + begin + data[len]:=ord(deref_defid); + data[len+1]:=tdef(s).defid shr 24 and $ff; + data[len+2]:=tdef(s).defid shr 16 and $ff; + data[len+3]:=tdef(s).defid shr 8 and $ff; + data[len+4]:=tdef(s).defid and $ff; + inc(len,5); + end; + end + else + begin + { nil pointer } + data[len]:=ord(deref_nil); + inc(len); + end; + + { store data length in first byte } + data[0]:=len-1; + + { store index and write to derefdata } + dataidx:=current_module.derefdata.size; + current_module.derefdata.write(data,len); + end; + + + function tderef.resolve:TObject; + var + pm : tmodule; + typ : tdereftype; + idx : longint; + i : aint; + len : byte; + data : array[0..255] of byte; + begin + result:=nil; + { not initialized or error } + if dataidx<0 then + internalerror(200306067); + { read data } + current_module.derefdata.seek(dataidx); + if current_module.derefdata.read(len,1)<>1 then + internalerror(200310221); + if len>0 then + begin + if current_module.derefdata.read(data,len)<>len then + internalerror(200310222); + end; + { process data } + pm:=current_module; + i:=0; + while (i<len) do + begin + typ:=tdereftype(data[i]); + inc(i); + case typ of + deref_unit : + begin + idx:=(data[i] shl 8) or data[i+1]; + inc(i,2); + pm:=current_module.resolve_unit(idx); + end; + deref_defid : + begin + idx:=longint((data[i] shl 24) or (data[i+1] shl 16) or (data[i+2] shl 8) or data[i+3]); + inc(i,4); + result:=tdef(pm.deflist[idx]); + end; + deref_symid : + begin + idx:=longint((data[i] shl 24) or (data[i+1] shl 16) or (data[i+2] shl 8) or data[i+3]); + inc(i,4); + result:=tsym(pm.symlist[idx]); + end; + deref_nil : + begin + result:=nil; + { Only allowed when no other deref is available } + if len<>1 then + internalerror(200306232); + end; + else + internalerror(200212277); + end; + end; + end; + + +{***************************************************************************** + TCompilerPPUFile +*****************************************************************************} + + procedure tcompilerppufile.checkerror; + begin + if error then + Message(unit_f_ppu_read_error); + end; + + + procedure tcompilerppufile.getguid(var g: tguid); + begin + longint(g.d1):=getlongint; + g.d2:=getword; + g.d3:=getword; + getdata(g.d4,sizeof(g.d4)); + end; + + + function tcompilerppufile.getexprint:Tconstexprint; + + begin + getexprint.overflow:=false; + getexprint.signed:=boolean(getbyte); + getexprint.svalue:=getint64; + end; + + + function tcompilerppufile.getPtrUInt:TConstPtrUInt; + begin + {$if sizeof(TConstPtrUInt)=8} + result:=tconstptruint(getint64); + {$else} + result:=TConstPtrUInt(getlongint); + {$endif} + end; + + + procedure tcompilerppufile.getposinfo(var p:tfileposinfo); + var + info : byte; + begin + { + info byte layout in bits: + 0-1 - amount of bytes for fileindex + 2-3 - amount of bytes for line + 4-5 - amount of bytes for column + } + info:=getbyte; + case (info and $03) of + 0 : p.fileindex:=getbyte; + 1 : p.fileindex:=getword; + 2 : p.fileindex:=(getbyte shl 16) or getword; + 3 : p.fileindex:=getlongint; + end; + case ((info shr 2) and $03) of + 0 : p.line:=getbyte; + 1 : p.line:=getword; + 2 : p.line:=(getbyte shl 16) or getword; + 3 : p.line:=getlongint; + end; + case ((info shr 4) and $03) of + 0 : p.column:=getbyte; + 1 : p.column:=getword; + 2 : p.column:=(getbyte shl 16) or getword; + 3 : p.column:=getlongint; + end; + p.moduleindex:=current_module.unit_index; + end; + + + procedure tcompilerppufile.getderef(var d:tderef); + begin + d.dataidx:=getlongint; + end; + + + function tcompilerppufile.getpropaccesslist:tpropaccesslist; + var + hderef : tderef; + slt : tsltype; + idx : longint; + p : tpropaccesslist; + begin + p:=tpropaccesslist.create; + getderef(p.procdefderef); + repeat + slt:=tsltype(getbyte); + case slt of + sl_none : + break; + sl_call, + sl_load, + sl_subscript : + begin + getderef(hderef); + p.addsymderef(slt,hderef); + end; + sl_absolutetype, + sl_typeconv : + begin + getderef(hderef); + p.addtypederef(slt,hderef); + end; + sl_vec : + begin + idx:=getlongint; + getderef(hderef); + p.addconstderef(slt,idx,hderef); + end; + else + internalerror(200110204); + end; + until false; + getpropaccesslist:=tpropaccesslist(p); + end; + + + function tcompilerppufile.getasmsymbol:tasmsymbol; + begin + getlongint; + getasmsymbol:=nil; + end; + + + procedure tcompilerppufile.putposinfo(const p:tfileposinfo); + var + oldcrc : boolean; + info : byte; + begin + { posinfo is not relevant for changes in PPU } + oldcrc:=do_crc; + do_crc:=false; + { + info byte layout in bits: + 0-1 - amount of bytes for fileindex + 2-3 - amount of bytes for line + 4-5 - amount of bytes for column + } + info:=0; + { calculate info byte } + if (p.fileindex>$ff) then + begin + info:=info or $1; + { uncomment this code if tfileposinfo.fileindex type was changed + if (p.fileindex<=$ffff) then + info:=info or $1 + else + if (p.fileindex<=$ffffff) then + info:=info or $2 + else + info:=info or $3; + } + end; + if (p.line>$ff) then + begin + if (p.line<=$ffff) then + info:=info or $4 + else + if (p.line<=$ffffff) then + info:=info or $8 + else + info:=info or $c; + end; + if (p.column>$ff) then + begin + info:=info or $10; + { uncomment this code if tfileposinfo.column type was changed + if (p.column<=$ffff) then + info:=info or $10 + else + if (p.column<=$ffffff) then + info:=info or $20 + else + info:=info or $30; + } + end; + { write data } + putbyte(info); + case (info and $03) of + 0 : putbyte(p.fileindex); + 1 : putword(p.fileindex); + 2 : begin + putbyte(p.fileindex shr 16); + putword(p.fileindex and $ffff); + end; + 3 : putlongint(p.fileindex); + end; + case ((info shr 2) and $03) of + 0 : putbyte(p.line); + 1 : putword(p.line); + 2 : begin + putbyte(p.line shr 16); + putword(p.line and $ffff); + end; + 3 : putlongint(p.line); + end; + case ((info shr 4) and $03) of + 0 : putbyte(p.column); + 1 : putword(p.column); + 2 : begin + putbyte(p.column shr 16); + putword(p.column and $ffff); + end; + 3 : putlongint(p.column); + end; + do_crc:=oldcrc; + end; + + + procedure tcompilerppufile.putguid(const g: tguid); + begin + putlongint(longint(g.d1)); + putword(g.d2); + putword(g.d3); + putdata(g.d4,sizeof(g.d4)); + end; + + + procedure Tcompilerppufile.putexprint(const v:Tconstexprint); + + begin + if v.overflow then + internalerror(200706102); + putbyte(byte(v.signed)); + putint64(v.svalue); + end; + + + procedure tcompilerppufile.PutPtrUInt(v:TConstPtrUInt); + begin + {$if sizeof(TConstPtrUInt)=8} + putint64(int64(v)); + {$else} + putlongint(longint(v)); + {$endif} + end; + + + procedure tcompilerppufile.putderef(const d:tderef); + var + oldcrc : boolean; + begin + oldcrc:=do_crc; + do_crc:=false; + putlongint(d.dataidx); + do_crc:=oldcrc; + end; + + + procedure tcompilerppufile.putpropaccesslist(p:tpropaccesslist); + var + hp : ppropaccesslistitem; + begin + putderef(p.procdefderef); + hp:=p.firstsym; + while assigned(hp) do + begin + putbyte(byte(hp^.sltype)); + case hp^.sltype of + sl_call, + sl_load, + sl_subscript : + putderef(hp^.symderef); + sl_absolutetype, + sl_typeconv : + putderef(hp^.defderef); + sl_vec : + begin + putlongint(int64(hp^.value)); + putderef(hp^.valuedefderef); + end; + else + internalerror(200110205); + end; + hp:=hp^.next; + end; + putbyte(byte(sl_none)); + end; + + + procedure tcompilerppufile.putasmsymbol(s:tasmsymbol); + begin + putlongint(0); + end; + +{$ifdef MEMDEBUG} +initialization + memmanglednames:=TMemDebug.create('Manglednames'); + memmanglednames.stop; + memprocpara:=TMemDebug.create('ProcPara'); + memprocpara.stop; + memprocparast:=TMemDebug.create('ProcParaSt'); + memprocparast.stop; + memproclocalst:=TMemDebug.create('ProcLocalSt'); + memproclocalst.stop; + memprocnodetree:=TMemDebug.create('ProcNodeTree'); + memprocnodetree.stop; + +finalization + memmanglednames.free; + memprocpara.free; + memprocparast.free; + memproclocalst.free; + memprocnodetree.free; +{$endif MEMDEBUG} + +end. + diff --git a/closures/compiler/symutil.pas b/closures/compiler/symutil.pas new file mode 100644 index 0000000000..ec560824e8 --- /dev/null +++ b/closures/compiler/symutil.pas @@ -0,0 +1,97 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit provides some help routines for symbol 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 symutil; + +{$i fpcdefs.inc} + +interface + + uses + symbase,symtype,symsym; + + function is_funcret_sym(p:TSymEntry):boolean; + + function equal_constsym(sym1,sym2:tconstsym):boolean; + + +implementation + + uses + cclasses, + globtype,cpuinfo,procinfo,constexp, + symconst,widestr; + + + function is_funcret_sym(p:TSymEntry):boolean; + begin + is_funcret_sym:=(p.typ in [absolutevarsym,localvarsym,paravarsym]) and + (vo_is_funcret in tabstractvarsym(p).varoptions); + end; + + + function equal_constsym(sym1,sym2:tconstsym):boolean; + var + p1,p2,pend : pchar; + begin + equal_constsym:=false; + if sym1.consttyp<>sym2.consttyp then + exit; + case sym1.consttyp of + constord : + equal_constsym:=(sym1.value.valueord=sym2.value.valueord); + constpointer : + equal_constsym:=(sym1.value.valueordptr=sym2.value.valueordptr); + conststring,constresourcestring : + begin + if sym1.value.len=sym2.value.len then + begin + p1:=pchar(sym1.value.valueptr); + p2:=pchar(sym2.value.valueptr); + pend:=p1+sym1.value.len; + while (p1<pend) do + begin + if p1^<>p2^ then + break; + inc(p1); + inc(p2); + end; + if (p1=pend) then + equal_constsym:=true; + end; + end; + constwstring : + begin + if (sym1.value.len=sym2.value.len) and + (comparewidestrings(sym1.value.valueptr,sym2.value.valueptr)=0) then + equal_constsym:=true; + end; + constreal : + equal_constsym:=(pbestreal(sym1.value.valueptr)^=pbestreal(sym2.value.valueptr)^); + constset : + equal_constsym:=(pnormalset(sym1.value.valueptr)^=pnormalset(sym2.value.valueptr)^); + constnil : + equal_constsym:=true; + end; + end; + +end. + diff --git a/closures/compiler/systems.inc b/closures/compiler/systems.inc new file mode 100644 index 0000000000..6bcbfff07f --- /dev/null +++ b/closures/compiler/systems.inc @@ -0,0 +1,216 @@ +{ + Copyright (c) 1998-2008 by Florian Klaempfl + + This include contains the enumeration + information about the target systems supported + (these are not processor specific) + + This program is free software; you can redistribute it and/or modify + iu 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. + + **************************************************************************** +} + type + tendian = (endian_little,endian_big); + + (* + IMPORTANT NOTE: + The value of this enumeration is stored in PPU files. + Therefore adding new CPU targets should not change the + values of the pre-existing targets. (CEC) + FURTHERMORE : Make sure that this branch values, are + consistant with the main branch version always. + *) + tsystemcpu= + ( + cpu_no, { 0 } + cpu_i386, { 1 } + cpu_m68k, { 2 } + cpu_alpha, { 3 } + cpu_powerpc, { 4 } + cpu_sparc, { 5 } + cpu_vm, { 6 } + cpu_iA64, { 7 } + cpu_x86_64, { 8 } + cpu_mips, { 9 } + cpu_arm, { 10 } + cpu_powerpc64, { 11 } + cpu_avr, { 12 } + cpu_mipsel { 13 } + ); + + tasmmode= (asmmode_none + { standard assembler (cpu dependant) with full parsing } + ,asmmode_standard + ,asmmode_i386_att + ,asmmode_i386_intel + ,asmmode_ppc_gas + ,asmmode_ppc_motorola + ,asmmode_arm_gas + ,asmmode_sparc_gas + ,asmmode_x86_64_gas + ,asmmode_m68k_mot + ,asmmode_x86_64_intel + ,asmmode_x86_64_att + ,asmmode_avr_gas + ); + + (* IMPORTANT NOTE: + the integer value of this enum is stored in PPU + files to recognize the target, so if you add new targets + allways add them at end PM + FURTHERMORE : Make sure that this branch values are + consistant with the main branch version always. (CEC) + *) + type + tsystem = + ( + system_none, { 0 } + obsolete_system_i386_GO32V1,{ 1 } + system_i386_GO32V2, { 2 } + system_i386_linux, { 3 } + system_i386_OS2, { 4 } + system_i386_Win32, { 5 } + system_i386_freebsd, { 6 } + system_m68k_Amiga, { 7 } + system_m68k_Atari, { 8 } + system_m68k_Mac, { 9 } + system_m68k_linux, { 10 } + system_m68k_PalmOS, { 11 } + system_alpha_linux, { 12 } + system_powerpc_linux, { 13 } + system_powerpc_macos, { 14 } + system_i386_solaris, { 15 } + system_i386_beos, { 16 } + system_i386_netbsd, { 17 } + system_m68k_netbsd, { 18 } + system_i386_Netware, { 19 } + system_i386_qnx, { 20 } + system_i386_wdosx, { 21 } + system_sparc_solaris, { 22 } + system_sparc_linux, { 23 } + system_i386_openbsd, { 24 } + system_m68k_openbsd, { 25 } + system_x86_64_linux, { 26 } + system_powerpc_darwin, { 27 } + system_i386_EMX, { 28 } + system_powerpc_netbsd, { 29 } + system_powerpc_openbsd, { 30 } + system_arm_linux, { 31 } + system_i386_watcom, { 32 } + system_powerpc_MorphOS, { 33 } + system_x86_64_freebsd, { 34 } + system_i386_netwlibc, { 35 } + system_powerpc_Amiga, { 36 } + system_x86_64_win64, { 37 } + system_arm_wince, { 38 } + system_ia64_win64, { 39 } + system_i386_wince, { 40 } + system_x86_6432_linux, { 41 } + system_arm_gba, { 42 } + system_powerpc64_linux, { 43 } + system_i386_darwin, { 44 } + system_arm_palmos, { 45 } + system_powerpc64_darwin, { 46 } + system_arm_nds, { 47 } + system_i386_embedded, { 48 } + system_m68k_embedded, { 49 } + system_alpha_embedded, { 50 } + system_powerpc_embedded, { 51 } + system_sparc_embedded, { 52 } + system_vm_embedded, { 53 } + system_iA64_embedded, { 54 } + system_x86_64_embedded, { 55 } + system_mips_embedded, { 56 } + system_arm_embedded, { 57 } + system_powerpc64_embedded, { 58 } + system_i386_symbian, { 59 } + system_arm_symbian, { 60 } + system_x86_64_darwin, { 61 } + system_avr_embedded, { 62 } + system_i386_haiku, { 63 } + system_arm_darwin, { 64 } + system_x86_64_solaris, { 65 } + system_mips_linux, { 66 } + system_mipsel_linux, { 67 } + system_i386_nativent, { 68 } + system_i386_iphonesim, { 69 } + system_powerpc_wii { 70 } + ); + + type + tasm = (as_none + ,as_gas { standard gnu assembler } + ,as_i386_as_aout + ,as_i386_nasmcoff + ,as_i386_nasmwin32 + ,as_i386_nasmwdosx + ,as_i386_nasmelf + ,as_i386_nasmobj + ,as_i386_nasmbeos + ,as_i386_tasm + ,as_i386_masm + ,as_i386_wasm + ,as_i386_coff + ,as_i386_pecoff + ,as_i386_elf32 + ,as_i386_pecoffwdosx + ,as_m68k_mit + ,as_powerpc_mpw + ,as_darwin + ,as_i386_macho + ,as_x86_64_masm + ,as_x86_64_pecoff + ,as_i386_pecoffwince + ,as_arm_pecoffwince + ,as_x86_64_elf64 + ,as_sparc_elf32 + ,as_ggas { gnu assembler called "gas" instead of "as" } + ,as_i386_nasmhaiku + ,as_powerpc_vasm + ,as_i386_nlmcoff + ); + + tar = (ar_none + ,ar_gnu_ar + ,ar_mpw_ar + ,ar_gnu_ar_scripted + ,ar_gnu_gar + ); + + tres = (res_none + ,res_gnu_windres,res_watcom_wrc_os2 + ,res_m68k_palmos,res_m68k_mpw + ,res_powerpc_mpw,res_elf + ,res_win64_gorc, res_macho, res_ext + ); + + tresinfoflags = (res_external_file,res_arch_in_file_name + ,res_single_file); + + tdbg = (dbg_none + ,dbg_stabs,dbg_dwarf2,dbg_dwarf3,dbg_dwarf4 + ); + + tscripttype = (script_none + ,script_dos,script_unix,script_amiga, + script_mpw + ); + + tabi = (abi_default + ,abi_powerpc_sysv,abi_powerpc_aix + ,abi_eabi,abi_armeb + ); + + diff --git a/closures/compiler/systems.pas b/closures/compiler/systems.pas new file mode 100644 index 0000000000..63aaa9cab2 --- /dev/null +++ b/closures/compiler/systems.pas @@ -0,0 +1,872 @@ +{ + Copyright (c) 1998-2008 by Florian Klaempfl + + This unit contains information about the target systems supported + (these are not processor specific) + + This program is free software; you can redistribute it and/or modify + iu 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 systems; + +{$i fpcdefs.inc} + +interface + +{$i systems.inc} + +{***************************************************************************** + Structures +*****************************************************************************} + + type + { Abstract linker class which is implemented in link module } + TAbstractLinker = class + end; + + TAbstractLinkerClass = class of TAbstractLinker; + + + { Abstract assembler class which is implemented in assemble module } + TAbstractAssembler = class + end; + + TAbstractAssemblerClass = class of TAbstractAssembler; + + + TAbstractResourceFile = class + constructor create(const fn : ansistring);virtual;abstract; + end; + TAbstractResourceFileClass = class of TAbstractResourceFile; + + + palignmentinfo = ^talignmentinfo; + { this is written to ppus during token recording for generics so it must be packed } + talignmentinfo = packed record + procalign, + loopalign, + jumpalign, + constalignmin, + constalignmax, + varalignmin, + varalignmax, + localalignmin, + localalignmax, + recordalignmin, + recordalignmax, + maxCrecordalign : longint; + end; + + tasmflags = (af_none, + af_outputbinary,af_allowdirect, + af_needar,af_smartlink_sections, + af_labelprefix_only_inside_procedure, + af_supports_dwarf, + af_no_debug, + af_stabs_use_function_absolute_addresses + ); + + pasminfo = ^tasminfo; + tasminfo = record + id : tasm; + idtxt : string[12]; + asmbin : string[8]; + asmcmd : string[50]; + supported_targets : set of tsystem; + flags : set of tasmflags; + labelprefix : string[3]; + comment : string[3]; + end; + + parinfo = ^tarinfo; + tarinfo = record + id : tar; + arcmd : string[50]; + arfinishcmd : string[10]; + end; + + presinfo = ^tresinfo; + tresinfo = record + id : tres; + { Compiler for resource (.rc or .res) to obj } + resbin : string[10]; + rescmd : string[50]; + { Optional compiler for resource script (.rc) to binary resource (.res). } + { If it is not provided resbin and rescmd will be used. } + rcbin : string[10]; + rccmd : string[50]; + resourcefileclass : TAbstractResourceFileClass; + resflags : set of tresinfoflags; + end; + + pdbginfo = ^tdbginfo; + tdbginfo = record + id : tdbg; + idtxt : string[12]; + end; + + tsystemflags = (tf_none, + tf_under_development, + tf_need_export, + tf_needs_isconsole, + tf_code_small, + tf_static_reg_based, + tf_needs_symbol_size, + tf_smartlink_sections, + tf_smartlink_library, + tf_needs_dwarf_cfi, + tf_use_8_3, + tf_pic_uses_got, + tf_library_needs_pic, + tf_needs_symbol_type, + tf_section_threadvars, + tf_files_case_sensitive, + tf_files_case_aware, + tf_p_ext_support, + tf_has_dllscanner, + tf_use_function_relative_addresses, + tf_winlikewidestring, + tf_dwarf_relative_addresses, // use offsets where the Dwarf spec requires this instead of absolute addresses (the latter is needed by Linux binutils) + tf_dwarf_only_local_labels, // only use local labels inside the Dwarf debug_info section (needed for e.g. Darwin) + tf_requires_proper_alignment, + tf_no_pic_supported, + tf_pic_default, + { the os does some kind of stack checking and it can be converted into a rte 202 } + tf_no_generic_stackcheck, + tf_has_winlike_resources, + tf_safecall_clearstack, // With this flag set, after safecall calls the caller cleans up the stack + tf_safecall_exceptions, // Exceptions in safecall calls are not raised, but passed to the caller as an ordinal (hresult) in the function result. + // The original result (if it exists) is passed as an extra parameter + tf_no_backquote_support + ); + + psysteminfo = ^tsysteminfo; + { using packed causes bus errors on processors which require alignment } + tsysteminfo = record + system : tsystem; + name : string[34]; + shortname : string[9]; + flags : set of tsystemflags; + cpu : tsystemcpu; + unit_env : string[16]; + extradefines : string[40]; + exeext, + defext, + scriptext, + smartext, + unitext, + unitlibext, + asmext, + objext, + resext : string[4]; + resobjext : string[7]; + sharedlibext : string[10]; + staticlibext, + staticlibprefix : string[4]; + sharedlibprefix : string[4]; + sharedClibext : string[10]; + staticClibext, + staticClibprefix : string[4]; + sharedClibprefix : string[4]; + importlibprefix : string[10]; + importlibext : string[4]; + Cprefix : string[2]; + newline : string[2]; + dirsep : char; + assem : tasm; + assemextern : tasm; { external assembler, used by -a } + link : tabstractlinkerclass; + linkextern : tabstractlinkerclass; { external linker, used by -s } + ar : tar; + res : tres; + dbg : tdbg; + script : tscripttype; + endian : tendian; + alignment : talignmentinfo; + { + Offset from the argument pointer register to the first + argument's address. On some machines it may depend on + the data type of the function. + (see also FIRST_PARM_OFFSET in GCC source) + } + first_parm_offset : longint; + stacksize : longint; + abi : tabi; + end; + + const + { alias for supported_target field in tasminfo } + system_any = system_none; + + systems_wince = [system_arm_wince,system_i386_wince]; + systems_linux = [system_i386_linux,system_x86_64_linux,system_powerpc_linux,system_powerpc64_linux, + system_arm_linux,system_sparc_linux,system_alpha_linux,system_m68k_linux, + system_x86_6432_linux,system_mips_linux,system_mipsel_linux]; + systems_freebsd = [system_i386_freebsd, + system_x86_64_freebsd]; + systems_netbsd = [system_i386_netbsd, + system_m68k_netbsd, + system_powerpc_netbsd]; + systems_openbsd = [system_i386_openbsd]; + + systems_bsd = systems_freebsd + systems_netbsd + systems_openbsd; + + { all real windows systems, no cripple ones like wince, wdosx et. al. } + systems_windows = [system_i386_win32,system_x86_64_win64,system_ia64_win64]; + + { all windows systems } + systems_all_windows = [system_i386_win32,system_x86_64_win64,system_ia64_win64, + system_arm_wince,system_i386_wince]; + + { all darwin systems } + systems_darwin = [system_powerpc_darwin,system_i386_darwin, + system_powerpc64_darwin,system_x86_64_darwin, + system_arm_darwin,system_i386_iphonesim]; + + {all solaris systems } + systems_solaris = [system_sparc_solaris, system_i386_solaris, + system_x86_64_solaris]; + + { all embedded systems } + systems_embedded = [system_i386_embedded,system_m68k_embedded, + system_alpha_embedded,system_powerpc_embedded, + system_sparc_embedded,system_vm_embedded, + system_iA64_embedded,system_x86_64_embedded, + system_mips_embedded,system_arm_embedded, + system_powerpc64_embedded,system_avr_embedded]; + + { all systems that allow section directive } + systems_allow_section = systems_embedded; + + systems_allow_section_no_semicolon = systems_allow_section +{$ifndef DISABLE_TLS_DIRECTORY} + + systems_windows +{$endif not DISABLE_TLS_DIRECTORY} + ; + + { all symbian systems } + systems_symbian = [system_i386_symbian,system_arm_symbian]; + + { all classic Mac OS targets } + systems_macos = [system_m68k_Mac,system_powerpc_Macos]; + + { all OS/2 targets } + systems_os2 = [system_i386_OS2,system_i386_emx]; + + { all native nt systems } + systems_nativent = [system_i386_nativent]; + + { systems supporting Objective-C } + systems_objc_supported = systems_darwin; + + { systems using the non-fragile Objective-C ABI } + systems_objc_nfabi = [system_powerpc64_darwin,system_x86_64_darwin,system_arm_darwin,system_i386_iphonesim]; + + { all systems supporting exports from programs or units } + systems_unit_program_exports = [system_i386_win32, + system_i386_wdosx, + system_i386_Netware, + system_i386_netwlibc, + system_arm_wince, + system_x86_64_win64, + system_ia64_win64]+systems_linux; + + { all systems for which weak linking has been tested/is supported } + systems_weak_linking = systems_darwin + systems_solaris; + + systems_internal_sysinit = [system_i386_linux,system_i386_win32]; + + {$ifdef FPC_HAS_SYSTEMS_INTERRUPT_TABLE} + { If anyone wants to use interrupt for + a specific target, add a + $define FPC_HAS_SYSTEMS_INTERRUPT_TABLE + to fpcdefs.inc to reactivate + the corresponding code } + systems_interrupt_table = [{system_arm_embedded}]; + {$endif FPC_HAS_SYSTEMS_INTERRUPT_TABLE} + + { all systems for which istack must be at a 16 byte boundary + when calling a function } + systems_need_16_byte_stack_alignment = [ + system_i386_darwin, + system_i386_iphonesim, + system_x86_64_darwin, + system_x86_64_win64, + system_x86_64_linux, + system_x86_64_freebsd, + system_x86_64_solaris]; + + cpu2str : array[TSystemCpu] of string[10] = + ('','i386','m68k','alpha','powerpc','sparc','vm','ia64','x86_64', + 'mips','arm', 'powerpc64', 'avr', 'mipsel'); + + abi2str : array[tabi] of string[10] = + ('DEFAULT','SYSV','AIX','EABI','ARMEB'); + + var + targetinfos : array[tsystem] of psysteminfo; + arinfos : array[tar] of parinfo; + resinfos : array[tres] of presinfo; + asminfos : array[tasm] of pasminfo; + dbginfos : array[tdbg] of pdbginfo; + + source_info : tsysteminfo; + target_cpu : tsystemcpu; + target_info : tsysteminfo; + target_asm : tasminfo; + target_ar : tarinfo; + target_res : tresinfo; + target_dbg : tdbginfo; + target_cpu_string, + target_os_string : string[12]; { for rtl/<X>/,fcl/<X>/, etc. } + target_full_string : string[24]; + + function set_target(t:tsystem):boolean; + function set_target_asm(t:tasm):boolean; + function set_target_ar(t:tar):boolean; + function set_target_res(t:tres):boolean; + function set_target_dbg(t:tdbg):boolean; + + function find_system_by_string(const s : string) : tsystem; + function find_asm_by_string(const s : string) : tasm; + function find_dbg_by_string(const s : string) : tdbg; + + procedure set_source_info(const ti : tsysteminfo); + + function UpdateAlignment(var d:talignmentinfo;const s:talignmentinfo) : boolean; + + procedure RegisterTarget(const r:tsysteminfo); + procedure RegisterRes(const r:tresinfo; rcf : TAbstractResourceFileClass); + procedure RegisterAr(const r:tarinfo); + { Register the external linker. This routine is called to setup the + class to use for the linker. It returns the tsysteminfo structure + updated with the correct linker class for external linking. + } + procedure RegisterExternalLinker(var system_info: tsysteminfo; c:TAbstractLinkerClass); + { Register the internal linker. This routine is called to setup the + class to use for the linker. It returns the tsysteminfo structure + updated with the correct linker class for internal linking. + + If internal linking is not supported, this class can be set + to nil. + } + procedure RegisterInternalLinker(var system_info : tsysteminfo; c:TAbstractLinkerClass); + + procedure InitSystems; + + {$ifdef FreeBSD} + function GetOSRelDate:Longint; + {$endif} + +implementation + + uses + cutils{$ifdef FreeBSD},SysCtl,BaseUnix{$endif}; + +{**************************************************************************** + OS runtime version detection utility routine +****************************************************************************} + +{$ifdef FreeBSD} +function GetOSRelDate:Longint; + +var + mib : array[0..1] of cint; + rval : cint; + len : size_t; + i : longint; + v : longint; + oerrno : cint; + S : AnsiString; + +Begin + s:='ab'; + SetLength(S,50); + mib[0] := CTL_KERN; + mib[1] := KERN_OSRELDATE; + len := 4; + oerrno:= fpgeterrno; + if (FPsysctl(pChar(@mib), 2, pchar(@v), @len, NIL, 0) = -1) Then + Begin + if (fpgeterrno = ESysENOMEM) Then + fpseterrno(oerrno); + GetOSRelDate:=0; + End + else + GetOSRelDate:=v; +End; +{$endif} + + +{**************************************************************************** + Target setting +****************************************************************************} + +function set_target(t:tsystem):boolean; +begin + set_target:=false; + if assigned(targetinfos[t]) then + begin + target_info:=targetinfos[t]^; + set_target_asm(target_info.assem); + set_target_ar(target_info.ar); + set_target_res(target_info.res); + set_target_dbg(target_info.dbg); + target_cpu:=target_info.cpu; + target_os_string:=lower(target_info.shortname); + target_cpu_string:=cpu2str[target_cpu]; + target_full_string:=target_cpu_string+'-'+target_os_string; + set_target:=true; + exit; + end; +end; + + +function set_target_asm(t:tasm):boolean; +begin + set_target_asm:=false; + if assigned(asminfos[t]) and + ((target_info.system in asminfos[t]^.supported_targets) or + (system_any in asminfos[t]^.supported_targets)) then + begin + target_asm:=asminfos[t]^; + set_target_asm:=true; + exit; + end; +end; + + +function set_target_ar(t:tar):boolean; +begin + result:=false; + if assigned(arinfos[t]) then + begin + target_ar:=arinfos[t]^; + result:=true; + exit; + end; +end; + + +function set_target_res(t:tres):boolean; +begin + result:=false; + if assigned(resinfos[t]) then + begin + target_res:=resinfos[t]^; + result:=true; + exit; + end + else + FillByte(target_res,sizeof(target_res),0); +end; + + +function set_target_dbg(t:tdbg):boolean; +begin + result:=false; + if assigned(dbginfos[t]) then + begin + target_dbg:=dbginfos[t]^; + result:=true; + exit; + end; +end; + + +function find_system_by_string(const s : string) : tsystem; +var + hs : string; + t : tsystem; +begin + result:=system_none; + hs:=upper(s); + for t:=low(tsystem) to high(tsystem) do + if assigned(targetinfos[t]) and + (upper(targetinfos[t]^.shortname)=hs) then + begin + result:=t; + exit; + end; +end; + + +function find_asm_by_string(const s : string) : tasm; +var + hs : string; + t : tasm; +begin + result:=as_none; + hs:=upper(s); + for t:=low(tasm) to high(tasm) do + if assigned(asminfos[t]) and + (asminfos[t]^.idtxt=hs) then + begin + result:=t; + exit; + end; +end; + + +function find_dbg_by_string(const s : string) : tdbg; +var + hs : string; + t : tdbg; +begin + result:=dbg_none; + hs:=upper(s); + for t:=low(tdbg) to high(tdbg) do + if assigned(dbginfos[t]) and + (dbginfos[t]^.idtxt=hs) then + begin + result:=t; + exit; + end; +end; + + +function UpdateAlignment(var d:talignmentinfo;const s:talignmentinfo) : boolean; +begin + result:=true; + with d do + begin + if (s.procalign in [1,2,4,8,16,32,64,128]) or (s.procalign=256) then + procalign:=s.procalign + else if s.procalign<>0 then + result:=false; + if (s.loopalign in [1,2,4,8,16,32,64,128]) or (s.loopalign=256) then + loopalign:=s.loopalign + else if s.loopalign<>0 then + result:=false; + if (s.jumpalign in [1,2,4,8,16,32,64,128]) or (s.jumpalign=256) then + jumpalign:=s.jumpalign + else if s.jumpalign<>0 then + result:=false; + { general update rules: + minimum: if higher then update + maximum: if lower then update or if undefined then update } + if s.constalignmin>constalignmin then + constalignmin:=s.constalignmin; + if (constalignmax=0) or + ((s.constalignmax>0) and (s.constalignmax<constalignmax)) then + constalignmax:=s.constalignmax; + if s.varalignmin>varalignmin then + varalignmin:=s.varalignmin; + if (varalignmax=0) or + ((s.varalignmax>0) and (s.varalignmax<varalignmax)) then + varalignmax:=s.varalignmax; + if s.localalignmin>localalignmin then + localalignmin:=s.localalignmin; + if (localalignmax=0) or + ((s.localalignmax>0) and (s.localalignmax<localalignmax)) then + localalignmax:=s.localalignmax; + if s.recordalignmin>recordalignmin then + recordalignmin:=s.recordalignmin; + if (recordalignmax=0) or + ((s.recordalignmax>0) and (s.recordalignmax<recordalignmax)) then + recordalignmax:=s.recordalignmax; + if (maxCrecordalign=0) or + ((s.maxCrecordalign>0) and (s.maxCrecordalign<maxCrecordalign)) then + maxCrecordalign:=s.maxCrecordalign; + end; +end; + + +{**************************************************************************** + Target registration +****************************************************************************} + +procedure RegisterTarget(const r:tsysteminfo); +var + t : tsystem; +begin + t:=r.system; + if assigned(targetinfos[t]) then + writeln('Warning: Target is already registered!') + else + Getmem(targetinfos[t],sizeof(tsysteminfo)); + targetinfos[t]^:=r; +end; + + +procedure RegisterRes(const r:tresinfo; rcf : TAbstractResourceFileClass); +var + t : tres; +begin + t:=r.id; + if not assigned(resinfos[t]) then + Getmem(resinfos[t],sizeof(tresinfo)); + resinfos[t]^:=r; + resinfos[t]^.resourcefileclass:=rcf; +end; + + +procedure RegisterAr(const r:tarinfo); +var + t : tar; +begin + t:=r.id; + if assigned(arinfos[t]) then + writeln('Warning: ar is already registered!') + else + Getmem(arinfos[t],sizeof(tarinfo)); + arinfos[t]^:=r; +end; + +procedure RegisterExternalLinker(var system_info: tsysteminfo; c:TAbstractLinkerClass); +begin + system_info.linkextern := c; +end; + +procedure RegisterInternalLinker(var system_info : tsysteminfo; c:TAbstractLinkerClass); +begin + system_info.link := c; +end; + + + +procedure DeregisterInfos; +var + assem : tasm; + target : tsystem; + ar : tar; + res : tres; + dbg : tdbg; +begin + for target:=low(tsystem) to high(tsystem) do + if assigned(targetinfos[target]) then + begin + freemem(targetinfos[target],sizeof(tsysteminfo)); + targetinfos[target]:=nil; + end; + for assem:=low(tasm) to high(tasm) do + if assigned(asminfos[assem]) then + begin + freemem(asminfos[assem],sizeof(tasminfo)); + asminfos[assem]:=nil; + end; + for ar:=low(tar) to high(tar) do + if assigned(arinfos[ar]) then + begin + freemem(arinfos[ar],sizeof(tarinfo)); + arinfos[ar]:=nil; + end; + for res:=low(tres) to high(tres) do + if assigned(resinfos[res]) then + begin + freemem(resinfos[res],sizeof(tresinfo)); + resinfos[res]:=nil; + end; + for dbg:=low(tdbg) to high(tdbg) do + if assigned(dbginfos[dbg]) then + begin + freemem(dbginfos[dbg],sizeof(tdbginfo)); + dbginfos[dbg]:=nil; + end; +end; + + +{**************************************************************************** + Initialization of default target +****************************************************************************} + +procedure default_target(t:tsystem); +begin + set_target(t); + if source_info.name='' then + source_info:=target_info; +end; + + +procedure set_source_info(const ti : tsysteminfo); +begin +{ can't use message() here (PFV) } + if source_info.name<>'' then + Writeln('Warning: Source OS Redefined!'); + source_info:=ti; +end; + + +procedure InitSystems; +begin +{ Now default target, this is dependent on the target cpu define, + when the define is the same as the source cpu then we use the source + os, else we pick a default } +{$ifdef i386} + {$ifdef cpu86} + default_target(source_info.system); + {$define default_target_set} + {$else cpu86} + {$ifdef linux} + default_target(system_i386_linux); + {$define default_target_set} + {$endif} + {$ifdef freebsd} + default_target(system_i386_freebsd); + {$define default_target_set} + {$endif} + {$ifdef openbsd} + default_target(system_i386_openbsd); + {$define default_target_set} + {$endif} + {$ifdef darwin} + default_target(system_i386_darwin); + {$define default_target_set} + {$endif} + {$endif cpu86} + { default is linux } + {$ifndef default_target_set} + default_target(system_i386_linux); + {$endif default_target_set} +{$endif i386} + +{$ifdef x86_64} + {$ifdef cpux86_64} + default_target(source_info.system); + {$define default_target_set} + {$else cpux86_64} + {$ifdef MSWindows} + default_target(system_x86_64_win64); + {$define default_target_set} + {$endif} + {$ifdef linux} + default_target(system_x86_64_linux); + {$define default_target_set} + {$endif} + {$ifdef freebsd} + default_target(system_x86_64_freebsd); + {$define default_target_set} + {$endif} + {$ifdef solaris} + default_target(system_x86_64_solaris); + {$define default_target_set} + {$endif} + {$ifdef darwin} + default_target(system_x86_64_darwin); + {$define default_target_set} + {$endif} + {$endif cpux86_64} + { default is linux } + {$ifndef default_target_set} + default_target(system_x86_64_linux); + {$endif default_target_set} +{$endif x86_64} + +{$ifdef m68k} + {$ifdef cpu68} + default_target(source_info.target); + {$else cpu68} + default_target(system_m68k_linux); + {$endif cpu68} +{$endif m68k} + +{$ifdef alpha} + {$ifdef cpualpha} + default_target(source_info.system); + {$else cpualpha} + default_target(system_alpha_linux); + {$endif cpualpha} +{$endif alpha} + +{$ifdef powerpc} + {$ifdef cpupowerpc} + default_target(source_info.system); + {$define default_target_set} + {$else cpupowerpc} + {$ifdef linux} + default_target(system_powerpc_linux); + {$define default_target_set} + {$endif} + {$ifdef darwin} + default_target(system_powerpc_darwin); + {$define default_target_set} + {$endif} + {$endif cpupowerpc} + {$ifndef default_target_set} + default_target(system_powerpc_linux); + {$endif default_target_set} +{$endif powerpc} + +{$ifdef POWERPC64} + {$ifdef cpupowerpc64} + default_target(source_info.system); + {$define default_target_set} + {$else cpupowerpc64} + {$ifdef darwin} + default_target(system_powerpc64_darwin); + {$define default_target_set} + {$endif} + {$ifdef linux} + default_target(system_powerpc64_linux); + {$define default_target_set} + {$endif} + {$endif cpupowerpc64} + {$ifndef default_target_set} + default_target(system_powerpc64_linux); + {$define default_target_set} + {$endif} +{$endif POWERPC64} + +{$ifdef sparc} + {$ifdef cpusparc} + default_target(source_info.system); + {$else cpusparc} + default_target(system_sparc_linux); + {$endif cpusparc} +{$endif sparc} + +{$ifdef arm} + {$ifdef cpuarm} + default_target(source_info.system); + {$else cpuarm} + {$ifdef WINDOWS} + {$define default_target_set} + default_target(system_arm_wince); + {$endif} + {$ifdef linux} + {$define default_target_set} + default_target(system_arm_linux); + {$endif} + {$ifdef darwin} + {$define default_target_set} + default_target(system_arm_darwin); + {$endif} + {$ifndef default_target_set} + default_target(system_arm_linux); + {$define default_target_set} + {$endif} + {$endif cpuarm} +{$endif arm} + +{$ifdef avr} + default_target(system_avr_embedded); +{$endif avr} + +{$ifdef mips} +{$ifdef mipsel} + default_target(system_mipsel_linux); +{$else mipsel} + default_target(system_mips_linux); +{$endif mipsel} +{$endif mips} +end; + + +initialization + source_info.name:=''; +finalization + DeregisterInfos; +end. diff --git a/closures/compiler/systems/i_amiga.pas b/closures/compiler/systems/i_amiga.pas new file mode 100644 index 0000000000..4a1c58ae1f --- /dev/null +++ b/closures/compiler/systems/i_amiga.pas @@ -0,0 +1,167 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for AmigaOS + + 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 support information structures for the AmigaOS. } +unit i_amiga; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_m68k_amiga_info : tsysteminfo = + ( + system : system_m68k_Amiga; + name : 'Commodore Amiga'; + shortname : 'amiga'; + flags : [tf_files_case_aware]; + cpu : cpu_m68k; + unit_env : ''; + extradefines : ''; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.library'; + staticlibext : '.a'; + staticlibprefix : 'lib'; + sharedlibprefix : ''; + sharedClibext : '.library'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_amiga; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + abi : abi_default; + ); + + system_powerpc_amiga_info : tsysteminfo = + ( + system : system_powerpc_Amiga; + name : 'AmigaOS for PowerPC'; + shortname : 'amiga'; + flags : [tf_files_case_aware]; + cpu : cpu_powerpc; + unit_env : ''; + extradefines : 'PPC603'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.library'; + staticlibext : '.a'; + staticlibprefix : 'lib'; + sharedlibprefix : ''; + sharedClibext : '.library'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_amiga; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + abi : abi_powerpc_sysv; + ); + + implementation + +initialization +{$ifdef CPU68} + {$ifdef AMIGA} + set_source_info(system_m68k_Amiga_info); + {$endif AMIGA} +{$endif CPU68} +{$ifdef CPUPOWERPC} + {$ifdef AMIGA} + set_source_info(system_powerpc_Amiga_info); + {$endif AMIGA} +{$endif CPUPOWERPC} +end. diff --git a/closures/compiler/systems/i_atari.pas b/closures/compiler/systems/i_atari.pas new file mode 100644 index 0000000000..2c9fe60665 --- /dev/null +++ b/closures/compiler/systems/i_atari.pas @@ -0,0 +1,91 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for atari + + 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 support information structures for atari. } +unit i_atari; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_m68k_atari_info : tsysteminfo = + ( + system : target_m68k_Atari; + name : 'Atari ST/STE'; + shortname : 'atari'; + flags : [tf_use_8_3]; + cpu : cpu_m68k; + short_name : 'ATARI'; + unit_env : ''; + extradefines : ''; + exeext : '.tpp'; + defext : ''; + scriptext : ''; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : ''; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + importlibprefix : 'libimp'; + importlibext : '.a'; + p_ext_support : false; + Cprefix : '_'; + newline : #10; + dirsep : '/'; + files_case_relevent : true; + assem : as_gas; + assemextern : as_gas; + link : ld_m68k_atari; + linkextern : ld_m68k_atari; + ar : ar_m68k_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + stackalignment : 2; + maxCrecordalignment : 4; + stacksize : 8192; + DllScanSupported:false; + use_function_relative_addresses : false + ); + + implementation + +initialization +{$ifdef cpu68} + {$ifdef atari} + set_source_info(system_m68k_atari_info); + {$endif atari} +{$endif cpu68} +end. diff --git a/closures/compiler/systems/i_beos.pas b/closures/compiler/systems/i_beos.pas new file mode 100644 index 0000000000..53933b1900 --- /dev/null +++ b/closures/compiler/systems/i_beos.pas @@ -0,0 +1,114 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for BeOS + + 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 support information structures for BeOS. } +unit i_beos; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_i386_beos_info : tsysteminfo = + ( + system : system_i386_BeOS; + name : 'Beos for i386'; + shortname : 'Beos'; + flags : [tf_under_development,tf_needs_symbol_size,tf_files_case_sensitive, + tf_smartlink_sections, tf_smartlink_library]; + cpu : cpu_i386; + unit_env : 'BEOSUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_i386_elf32; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + { Stack size used to be 256 K under BeOS. So, it was the value + used in previous version of FPC for BeOS (but lost in the road + to 2.* ;-). + According to buildtools/gcc/gcc/config/i386/beos-elf.h in the + Haiku's repository, this value was increased to 1Mb since r4.1b3. + Under R5, this value is even greater. listarea report a default + size of 16 Mb for the user stack of the main thread. + People who still use BeOS nowadays should use R5 (or Haiku), + so i use this new value. + } + stacksize : 16 * 1024 * 1024; + abi : abi_default + ); + + implementation + +initialization +{$ifdef cpu86} + {$ifdef beos} + {$ifndef haiku} + set_source_info(system_i386_beos_info); + {$endif haiku} + {$endif beos} +{$endif cpu86} +end. diff --git a/closures/compiler/systems/i_bsd.pas b/closures/compiler/systems/i_bsd.pas new file mode 100644 index 0000000000..9d8fbf239f --- /dev/null +++ b/closures/compiler/systems/i_bsd.pas @@ -0,0 +1,858 @@ +{ + Copyright (c) 1998-2008 by Peter Vreman + + This unit implements support information structures for FreeBSD/NetBSD, + OpenBSD and Darwin (Mac OS X) + + 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 support information structures for FreeBSD/NetBSD. + OpenBSD is only added for i386 for now, though it exists for most + other common CPU's too} + +unit i_bsd; + +{$i fpcdefs.inc} + + interface + + uses + systems, rescmn; + + const + res_macho_info : tresinfo = + ( + id : res_macho; + resbin : 'fpcres'; + rescmd : '-o $OBJ -a $ARCH -s $SUBARCH -of mach-o $DBG'; + rcbin : 'windres'; + rccmd : '--include $INC -O res -o $RES $RC'; + resourcefileclass : nil; + resflags : []; + ); + res_macosx_ext_info : tresinfo = + ( + id : res_ext; + resbin : 'fpcres'; + rescmd : '-o $OBJ -a $ENDIAN -of external $DBG'; + rcbin : 'windres'; + rccmd : '--include $INC -O res -o $RES $RC'; + resourcefileclass : nil; + resflags : [res_external_file,res_arch_in_file_name]; + ); + + system_i386_freebsd_info : tsysteminfo = + ( + system : system_i386_FreeBSD; + name : 'FreeBSD/ELF for i386'; + shortname : 'FreeBSD'; + flags : [tf_pic_uses_got,tf_files_case_sensitive, +{$ifdef segment_threadvars} + tf_section_threadvars, +{$endif segment_threadvars} + tf_needs_symbol_type,tf_needs_symbol_size,tf_smartlink_library + {,tf_smartlink_sections},tf_has_winlike_resources]; + cpu : cpu_i386; + unit_env : 'BSDUNITS'; + extradefines : 'UNIX;BSD;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_i386_elf32; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + abi : abi_default; + ); + + + system_x86_64_freebsd_info : tsysteminfo = + ( + system : system_x86_64_freebsd; + name : 'FreeBSD for x86-64'; + shortname : 'FreeBSD'; + flags : [tf_needs_symbol_size,tf_needs_dwarf_cfi,tf_library_needs_pic,tf_needs_symbol_type, + tf_files_case_sensitive,tf_smartlink_library, + tf_dwarf_only_local_labels + { tf_pic_uses_got,tf_smartlink_sections},tf_has_winlike_resources]; + cpu : cpu_x86_64; + unit_env : 'BSDUNITS'; + extradefines : 'UNIX;HASUNIX;BSD'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_x86_64_elf64; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_dwarf2; //dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 8; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 16; + localalignmin : 4; + localalignmax : 16; + recordalignmin : 0; + recordalignmax : 16; + maxCrecordalign : 16 + ); + first_parm_offset : 16; + stacksize : 256*1024; + abi : abi_default; + ); + + + system_i386_netbsd_info : tsysteminfo = + ( + system : system_i386_NetBSD; + name : 'NetBSD for i386'; + shortname : 'NetBSD'; + flags : [tf_under_development,tf_files_case_sensitive,tf_smartlink_library,tf_has_winlike_resources]; + cpu : cpu_i386; + unit_env : 'BSDUNITS'; + extradefines : 'UNIX;BSD;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : '_'; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 1; + varalignmin : 0; + varalignmax : 1; + localalignmin : 0; + localalignmax : 1; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + abi : abi_default; + ); + + system_i386_openbsd_info : tsysteminfo = + ( + system : system_i386_OpenBSD; + name : 'OpenBSD for i386'; + shortname : 'OpenBSD'; + flags : [tf_pic_uses_got,tf_under_development,tf_files_case_sensitive,tf_smartlink_library,tf_has_winlike_resources]; + cpu : cpu_i386; + unit_env : 'BSDUNITS'; + extradefines : 'UNIX;BSD;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 1; + varalignmin : 0; + varalignmax : 1; + localalignmin : 0; + localalignmax : 1; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + abi : abi_default; + ); + + system_m68k_netbsd_info : tsysteminfo = + ( + system : system_m68k_NetBSD; + name : 'NetBSD for m68k'; + shortname : 'NetBSD'; + flags : [tf_under_development,tf_files_case_sensitive,tf_smartlink_library,tf_has_winlike_resources]; + cpu : cpu_m68k; + unit_env : 'BSDUNITS'; + extradefines : 'UNIX;BSD;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 1; + varalignmin : 0; + varalignmax : 1; + localalignmin : 0; + localalignmax : 1; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + abi : abi_default; + ); + + system_powerpc_netbsd_info : tsysteminfo = + ( + system : system_powerpc_netbsd; + name : 'NetBSD for PowerPC'; + shortname : 'NetBSD'; + flags : [tf_under_development,tf_files_case_sensitive,tf_smartlink_library,tf_has_winlike_resources]; + cpu : cpu_powerpc; + unit_env : ''; + extradefines : 'UNIX;BSD;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.s'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 // should be 8 probably + ); + first_parm_offset : 8; + stacksize : 32*1024*1024; + { abi_powerpc_sysv doesn't work yet } + abi : abi_powerpc_aix; + ); + + + system_powerpc_darwin_info : tsysteminfo = + ( + system : system_powerpc_darwin; + name : 'Darwin for PowerPC'; + shortname : 'Darwin'; + flags : [tf_p_ext_support,tf_files_case_sensitive,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels,tf_pic_default,tf_has_winlike_resources]; + cpu : cpu_powerpc; + unit_env : 'BSDUNITS'; + extradefines : 'UNIX;BSD;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dylib'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.dylib'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : '_'; + newline : #10; + dirsep : '/'; + assem : as_darwin; + assemextern : as_darwin; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_macho; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 16; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 24; + stacksize : 262144; + abi : abi_powerpc_aix; + ); + + + + system_i386_darwin_info : tsysteminfo = + ( + system : system_i386_darwin; + name : 'Darwin for i386'; + shortname : 'Darwin'; + flags : [tf_p_ext_support,tf_files_case_sensitive,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels,tf_pic_uses_got,tf_pic_default,tf_has_winlike_resources]; + cpu : cpu_i386; + unit_env : 'BSDUNITS'; + extradefines : 'UNIX;BSD;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dylib'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.dylib'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : '_'; + newline : #10; + dirsep : '/'; + assem : as_darwin; + assemextern : as_darwin; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_macho; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 16; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 16; + localalignmin : 0; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 16; + maxCrecordalign : 16 + ); + first_parm_offset : 8; + stacksize : 262144; + abi : abi_default; + ); + + + + system_i386_iphonesim_info : tsysteminfo = + ( + system : system_i386_iphonesim; + name : 'Darwin/iPhoneSim for i386'; + shortname : 'iPhoneSim'; + flags : [tf_p_ext_support,tf_files_case_sensitive,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels,tf_pic_uses_got,tf_pic_default,tf_has_winlike_resources]; + cpu : cpu_i386; + unit_env : 'BSDUNITS'; + extradefines : 'UNIX;BSD;HASUNIX;DARWIN'; // also define darwin for code compatibility + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dylib'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.dylib'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : '_'; + newline : #10; + dirsep : '/'; + assem : as_darwin; + assemextern : as_darwin; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_macho; + dbg : dbg_dwarf2; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 16; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 16; + localalignmin : 0; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 16; + maxCrecordalign : 16 + ); + first_parm_offset : 8; + stacksize : 262144; + abi : abi_default; + ); + + + + system_powerpc64_darwin_info : tsysteminfo = + ( + system : system_powerpc64_darwin; + name : 'Darwin for PowerPC64'; + shortname : 'Darwin'; + flags : [tf_p_ext_support,tf_files_case_sensitive,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels,tf_pic_default,tf_has_winlike_resources]; + cpu : cpu_powerpc64; + unit_env : 'BSDUNITS'; + extradefines : 'UNIX;BSD;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dylib'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.dylib'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : '_'; + newline : #10; + dirsep : '/'; + assem : as_darwin; + assemextern : as_darwin; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_macho; + dbg : dbg_dwarf2; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 16; + loopalign : 4; + jumpalign : 0; + constalignmin : 4; + constalignmax : 8; + varalignmin : 4; + varalignmax : 8; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 8; + maxCrecordalign : 4 + ); + first_parm_offset : 48; + stacksize : 262144; + abi : abi_powerpc_aix; + ); + + + + system_x86_64_darwin_info : tsysteminfo = + ( + system : system_x86_64_darwin; + name : 'Darwin for x86_64'; + shortname : 'Darwin'; + flags : [tf_p_ext_support,tf_files_case_sensitive,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels,tf_pic_default,tf_has_winlike_resources]; + cpu : cpu_x86_64; + unit_env : 'BSDUNITS'; + extradefines : 'UNIX;BSD;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dylib'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.dylib'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : '_'; + newline : #10; + dirsep : '/'; + assem : as_darwin; + assemextern : as_darwin; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_macho; + dbg : dbg_dwarf2; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 8; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 16; + localalignmin : 4; + localalignmax : 16; + recordalignmin : 0; + recordalignmax : 16; + maxCrecordalign : 16 + ); + first_parm_offset : 16; + stacksize : 262144; + abi : abi_default; + ); + + + system_arm_darwin_info : tsysteminfo = + ( + system : system_arm_darwin; + name : 'Darwin for ARM'; + shortname : 'Darwin'; + flags : [tf_p_ext_support,tf_requires_proper_alignment,tf_files_case_sensitive,tf_smartlink_sections,tf_dwarf_relative_addresses,tf_dwarf_only_local_labels,tf_has_winlike_resources]; + cpu : cpu_arm; + unit_env : 'BSDUNITS'; + extradefines : 'UNIX;BSD;HASUNIX;CPUARMEL'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dylib'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.dylib'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : '_'; + newline : #10; + dirsep : '/'; + assem : as_darwin; + assemextern : as_darwin; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_macho; + dbg : dbg_dwarf2; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 8; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 8; + maxCrecordalign : 8 + ); + first_parm_offset : 8; + stacksize : 262144; + abi : abi_default + ); + + implementation + +initialization +{$ifdef cpu86} + {$ifdef FreeBSD} + set_source_info(system_i386_FreeBSD_info); + {$endif} + {$ifdef NetBSD} + set_source_info(system_i386_NetBSD_info); + {$endif} + {$ifdef OpenBSD} + set_source_info(system_i386_OpenBSD_info); + {$endif} + {$ifdef Darwin} + set_source_info(system_i386_Darwin_info); + {$endif Darwin} +{$endif cpu86} +{$ifdef cpux86_64} + {$ifdef FreeBSD} + set_source_info(system_x86_64_FreeBSD_info); + {$endif} + {$ifdef Darwin} + set_source_info(system_x86_64_darwin_info); + {$endif} +{$endif} +{$ifdef cpu68} + {$ifdef NetBSD} + set_source_info(system_m68k_NetBSD_info); + {$endif NetBSD} +{$endif cpu68} +{$ifdef cpupowerpc32} + {$ifdef Darwin} + set_source_info(system_powerpc_darwin_info); + {$endif Darwin} + {$ifdef NetBSD} + set_source_info(system_powerpc_netbsd_info); + {$endif} +{$endif cpupowerpc32} +{$ifdef cpupowerpc64} + {$ifdef Darwin} + set_source_info(system_powerpc64_darwin_info); + {$endif Darwin} +{$ifdef cpuarm} + {$ifdef Darwin} + set_source_info(system_arm_darwin_info); + {$endif Darwin} +{$endif cpuarm} +{$endif powerpc64} +end. diff --git a/closures/compiler/systems/i_embed.pas b/closures/compiler/systems/i_embed.pas new file mode 100644 index 0000000000..da9a39b011 --- /dev/null +++ b/closures/compiler/systems/i_embed.pas @@ -0,0 +1,235 @@ +{ + This unit implements support information structures for the FPC Embedded target + + Copyright (c) 1998-2006 by Peter Vreman + + 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 i_embed; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_arm_embedded_info : tsysteminfo = + ( + system : system_arm_embedded; + name : 'Embedded'; + shortname : 'embedded'; + flags : [tf_needs_symbol_size,tf_files_case_sensitive, + tf_smartlink_sections]; + cpu : cpu_arm; + unit_env : ''; + extradefines : ''; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + abi : abi_default + ); + + system_avr_embedded_info : tsysteminfo = + ( + system : system_avr_embedded; + name : 'Embedded'; + shortname : 'embedded'; + flags : [tf_needs_symbol_size,tf_files_case_sensitive + ,tf_smartlink_sections]; + cpu : cpu_avr; + unit_env : ''; + extradefines : ''; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_dwarf2; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 0; + stacksize : 1024; + abi : abi_default + ); + + system_i386_embedded_info : tsysteminfo = + ( + system : system_i386_embedded; + name : 'Embedded'; + shortname : 'embedded'; + flags : [tf_needs_symbol_size,tf_files_case_sensitive + ,tf_smartlink_sections]; + cpu : cpu_i386; + unit_env : ''; + extradefines : ''; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_i386_elf32; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 16; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 16; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 16; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 4096; + abi : abi_default + ); + + implementation + +initialization +{$ifdef CPUARM} + {$ifdef embedded} + set_source_info(system_arm_embedded_info); + {$endif embedded} +{$endif CPUARM} +{$ifdef CPUAVR} + {$ifdef embedded} + set_source_info(system_avr_embedded_info); + {$endif embedded} +{$endif CPUAVR} +{$ifdef CPUI386} + {$ifdef embedded} + set_source_info(system_i386_embedded_info); + {$endif embedded} +{$endif CPUI386} +end. diff --git a/closures/compiler/systems/i_emx.pas b/closures/compiler/systems/i_emx.pas new file mode 100644 index 0000000000..f192ec09d5 --- /dev/null +++ b/closures/compiler/systems/i_emx.pas @@ -0,0 +1,118 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for OS/2 via EMX + + 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 support information structures for OS/2 via EMX. } +unit i_emx; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + res_wrc_os2_info : tresinfo = + ( + id : res_watcom_wrc_os2; + resbin : ''; + rescmd : ''; + rcbin : 'wrc'; + rccmd : '-r -zm -q -bt=os2 -fo=$RES $RC'; + resourcefileclass : nil; + resflags : [res_single_file]; + ); + + system_i386_emx_info : tsysteminfo = + ( + system : system_i386_EMX; + name : 'OS/2 via EMX'; + shortname : 'EMX'; + flags : [tf_need_export,tf_use_8_3]; + cpu : cpu_i386; + unit_env : 'EMXUNITS'; + extradefines : 'OS2'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.cmd'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : ''; + sharedClibprefix : ''; + importlibprefix : ''; + importlibext : '.a'; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + assem : as_i386_as_aout; + assemextern : as_i386_as_aout; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_watcom_wrc_os2; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 256*1024; + abi : abi_default; + ); + + + implementation + +initialization +{$ifdef CPU86} + {$ifdef EMX} + {$IFNDEF VER1_0} + set_source_info(system_i386_emx_info); + { OS/2 via EMX can be run under DOS as well } + if (OS_Mode=osDOS) or (OS_Mode=osDPMI) then + source_info.scriptext := '.bat'; + {$ENDIF VER1_0} + {$endif EMX} +{$endif CPU86} +end. diff --git a/closures/compiler/systems/i_gba.pas b/closures/compiler/systems/i_gba.pas new file mode 100644 index 0000000000..aa4480d933 --- /dev/null +++ b/closures/compiler/systems/i_gba.pas @@ -0,0 +1,102 @@ +{ + This unit implements support information structures for GameBoy Advance + + Copyright (c) 1998-2002 by Peter Vreman + + 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 support information structures for gba. } +unit i_gba; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_arm_gba_info : tsysteminfo = + ( + system : system_arm_gba; + name : 'GameBoy Advance'; + shortname : 'gba'; + flags : [tf_needs_symbol_size,tf_files_case_sensitive, + tf_requires_proper_alignment,tf_smartlink_sections]; + cpu : cpu_arm; + unit_env : ''; + extradefines : ''; + exeext : '.gba'; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 8; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 8; + maxCrecordalign : 8 + ); + first_parm_offset : 8; + stacksize : 16384; + abi : abi_eabi + ); + + implementation + +initialization +{$ifdef arm} + {$ifdef gba} + set_source_info(system_arm_gba_info); + {$endif gba} +{$endif arm} +end. diff --git a/closures/compiler/systems/i_go32v2.pas b/closures/compiler/systems/i_go32v2.pas new file mode 100644 index 0000000000..8b0121e804 --- /dev/null +++ b/closures/compiler/systems/i_go32v2.pas @@ -0,0 +1,101 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for 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. + **************************************************************************** +} +{ This unit implements support information structures for go32v2. } +unit i_go32v2; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_i386_go32v2_info : tsysteminfo = + ( + system : system_i386_GO32V2; + name : 'GO32 V2 DOS extender'; + shortname : 'Go32v2'; + flags : [tf_use_8_3,tf_smartlink_library]; + cpu : cpu_i386; + unit_env : 'GO32V2UNITS'; + extradefines : 'DPMI'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.bat'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : ''; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : ''; + sharedClibprefix : ''; + importlibprefix : ''; + importlibext : '.al'; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + assem : as_i386_coff; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + abi : abi_default; + ); + + implementation + +initialization +{$ifdef cpu86} + {$ifdef go32v2} + set_source_info(system_i386_go32v2_info); + {$endif go32v2} +{$endif cpu86} +end. diff --git a/closures/compiler/systems/i_haiku.pas b/closures/compiler/systems/i_haiku.pas new file mode 100644 index 0000000000..daf303acf6 --- /dev/null +++ b/closures/compiler/systems/i_haiku.pas @@ -0,0 +1,113 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + Copyright (c) 2008-2008 by Olivier Coursière + + This unit implements support information structures for Haiku + + 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 support information structures for Haiku. } +unit i_haiku; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_i386_haiku_info : tsysteminfo = + ( + system : system_i386_Haiku; + name : 'Haiku for i386'; + shortname : 'Haiku'; + flags : [tf_under_development,tf_needs_symbol_size,tf_files_case_sensitive, + tf_smartlink_sections, tf_smartlink_library, tf_has_winlike_resources]; + cpu : cpu_i386; + unit_env : 'HAIKUUNITS'; + extradefines : 'BEOS;UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_i386_elf32; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + { Stack size used to be 256 K under BeOS. So, it was the value + used in previous version of FPC for BeOS (but lost in the road + to 2.* ;-). + According to buildtools/gcc/gcc/config/i386/beos-elf.h in the + Haiku's repository, this value was increased to 1Mb since r4.1b3. + Under R5, this value is even greater. listarea report a default + size of 16 Mb for the user stack of the main thread. + People who still use BeOS nowadays should use R5 (or Haiku), + so i use this new value. + } + stacksize : 16 * 1024 * 1024; + abi : abi_default + ); + + implementation + +initialization +{$ifdef cpu86} + {$ifdef haiku} + set_source_info(system_i386_haiku_info); + {$endif haiku} +{$endif cpu86} +end. diff --git a/closures/compiler/systems/i_linux.pas b/closures/compiler/systems/i_linux.pas new file mode 100644 index 0000000000..703ddcaf93 --- /dev/null +++ b/closures/compiler/systems/i_linux.pas @@ -0,0 +1,909 @@ +{ + Copyright (c) 1998-2008 by Peter Vreman + + This unit implements support information structures for linux + + 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 support information structures for linux. } +unit i_linux; + +{$i fpcdefs.inc} + + interface + + uses + systems, rescmn; + + const + system_i386_linux_info : tsysteminfo = + ( + system : system_i386_LINUX; + name : 'Linux for i386'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_pic_uses_got{,tf_smartlink_sections}{,tf_winlikewidestring}, +{$ifdef segment_threadvars} + tf_section_threadvars, +{$endif segment_threadvars} + tf_needs_symbol_type,tf_files_case_sensitive, + tf_smartlink_library,tf_needs_dwarf_cfi,tf_has_winlike_resources, + tf_safecall_exceptions, tf_safecall_clearstack]; + cpu : cpu_i386; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_i386_elf32; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 16; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 16; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 16; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 8*1024*1024; + abi : abi_default + ); + + system_x86_6432_linux_info : tsysteminfo = + ( + system : system_x86_6432_LINUX; + name : 'Linux for x64_6432'; + shortname : 'Linux6432'; + flags : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive, + tf_pic_uses_got{,tf_smartlink_sections}, + tf_smartlink_library,tf_has_winlike_resources]; + cpu : cpu_x86_64; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_i386_elf32; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 16; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 16; + varalignmin : 0; + varalignmax : 16; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 16; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 8*1024*1024; + abi : abi_default + ); + + system_m68k_linux_info : tsysteminfo = + ( + system : system_m68k_linux; + name : 'Linux for m68k'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive, + tf_smartlink_library,tf_has_winlike_resources]; + cpu : cpu_m68k; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : ''; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 32*1024*1024; + abi : abi_default + ); + + system_powerpc_linux_info : tsysteminfo = + ( + system : system_powerpc_LINUX; + name : 'Linux for PowerPC'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive, + tf_smartlink_library,tf_has_winlike_resources]; + cpu : cpu_powerpc; + unit_env : ''; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 8 + ); + first_parm_offset : 8; + stacksize : 32*1024*1024; + abi : abi_powerpc_sysv; + ); + + system_powerpc64_linux_info : tsysteminfo = + ( + system : system_powerpc64_LINUX; + name : 'Linux for PowerPC64'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive, + tf_requires_proper_alignment,tf_smartlink_sections,tf_has_winlike_resources]; + cpu : cpu_powerpc64; + unit_env : ''; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_dwarf2; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 8; + loopalign : 4; + jumpalign : 0; + constalignmin : 4; + constalignmax : 16; + varalignmin : 4; + varalignmax : 16; + localalignmin : 0; + localalignmax : 16; + recordalignmin : 0; + recordalignmax : 16; + maxCrecordalign : 16 + ); + first_parm_offset : 8; + stacksize : 10*1024*1024; + abi : abi_powerpc_sysv + ); + + system_alpha_linux_info : tsysteminfo = + ( + system : system_alpha_LINUX; + name : 'Linux for Alpha'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive, + tf_smartlink_library,tf_has_winlike_resources]; + cpu : cpu_alpha; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 32*1024*1024; + abi : abi_default + ); + + system_x86_64_linux_info : tsysteminfo = + ( + system : system_x86_64_LINUX; + name : 'Linux for x86-64'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_needs_dwarf_cfi,tf_smartlink_library, + tf_library_needs_pic,tf_needs_symbol_type,tf_files_case_sensitive, + tf_has_winlike_resources,tf_safecall_exceptions,tf_safecall_clearstack]; + cpu : cpu_x86_64; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_x86_64_elf64; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_dwarf2; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 8; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 16; + localalignmin : 4; + localalignmax : 16; + recordalignmin : 0; + recordalignmax : 16; + maxCrecordalign : 16 + ); + first_parm_offset : 16; + stacksize : 8*1024*1024; + abi : abi_default + ); + + system_sparc_linux_info : tsysteminfo = + ( + system : system_SPARC_Linux; + name : 'Linux for SPARC'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_library_needs_pic,tf_smartlink_sections, + tf_needs_symbol_type,tf_files_case_sensitive,tf_smartlink_library, + tf_requires_proper_alignment, + tf_has_winlike_resources]; + cpu : cpu_SPARC; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 4; + constalignmax : 8; + varalignmin : 4; + varalignmax : 8; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 8; + maxCrecordalign : 8 + ); + first_parm_offset : 92; + stacksize : 8*1024*1024; + abi : abi_default + ); + +{$ifdef FPC_ARMEL} + system_arm_linux_info : tsysteminfo = + ( + system : system_arm_Linux; + name : 'Linux for ARMEL'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive, + tf_requires_proper_alignment, + tf_smartlink_sections,tf_smartlink_library,tf_has_winlike_resources]; + cpu : cpu_arm; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX;CPUARMEL'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 8; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 8; + maxCrecordalign : 8 + ); + first_parm_offset : 8; + stacksize : 8*1024*1024; + abi : abi_eabi + ); +{$else FPC_ARMEL} +{$ifdef FPC_ARMEB} + system_arm_linux_info : tsysteminfo = + ( + system : system_arm_Linux; + name : 'Linux for ARMEB'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive, + tf_requires_proper_alignment, + tf_smartlink_sections,tf_smartlink_library,tf_has_winlike_resources]; + cpu : cpu_arm; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX;CPUARMEB'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 8*1024*1024; + abi : abi_default + ); +{$else FPC_ARMEB} + system_arm_linux_info : tsysteminfo = + ( + system : system_arm_Linux; + name : 'Linux for ARM'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive, + tf_requires_proper_alignment, + tf_smartlink_sections,tf_smartlink_library,tf_has_winlike_resources]; + cpu : cpu_arm; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 8*1024*1024; + abi : abi_default + ); +{$endif FPC_ARMEB} +{$endif FPC_ARMEL} + + system_mips_linux_info : tsysteminfo = + ( + system : system_mips_LINUX; + name : 'Linux for MIPS'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive, + tf_requires_proper_alignment, + tf_smartlink_sections,tf_smartlink_library,tf_has_winlike_resources]; + cpu : cpu_mips; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; +// p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 8; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 32*1024*1024; + abi : abi_default + ); + + system_mipsel_linux_info : tsysteminfo = + ( + system : system_mipsel_LINUX; + name : 'Linux for MIPSEL'; + shortname : 'Linux'; + flags : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive, + tf_requires_proper_alignment, + tf_smartlink_sections,tf_smartlink_library,tf_has_winlike_resources]; + cpu : cpu_mipsel; + unit_env : 'LINUXUNITS'; + extradefines : 'UNIX;HASUNIX;MIPSEL'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; +// p_ext_support : false; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 8; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 32*1024*1024; + abi : abi_default + ); + + implementation + +initialization +{$ifdef CPU86} + {$ifdef linux} + { some FreeBSD versions define linux as well } + {$ifndef FreeBSD} + set_source_info(system_i386_linux_info); + {$endif FreeBSD} + {$endif} +{$endif CPU86} +{$ifdef CPU68} + {$ifdef linux} + set_source_info(system_m68k_linux_info); + {$endif linux} +{$endif CPU68} +{$ifdef CPUX86_64} + {$ifdef linux} + set_source_info(system_x86_64_linux_info); + {$endif linux} +{$endif CPUX86_64} +{$ifdef CPUALPHA} + {$ifdef linux} + set_source_info(system_alpha_linux_info); + {$endif linux} +{$endif CPUALPHA} +{$ifdef CPUSPARC} + {$ifdef linux} + set_source_info(system_sparc_linux_info); + {$endif linux} +{$endif CPUSPARC} +{$ifdef CPUPOWERPC32} + {$ifdef linux} + set_source_info(system_powerpc_linux_info); + {$endif linux} +{$endif CPUPOWERPC32} +{$ifdef CPUPOWERPC64} + {$ifdef linux} + set_source_info(system_powerpc64_linux_info); + {$endif linux} +{$endif CPUPOWERPC64} +{$ifdef CPUARM} + {$ifdef linux} + set_source_info(system_arm_linux_info); + {$endif linux} +{$endif CPUARM} +{$ifdef CPUMIPS} + {$ifdef linux} + set_source_info(system_mipsel_linux_info); + {$endif linux} +{$endif CPUMIPS} +end. diff --git a/closures/compiler/systems/i_macos.pas b/closures/compiler/systems/i_macos.pas new file mode 100644 index 0000000000..4ab18d0c07 --- /dev/null +++ b/closures/compiler/systems/i_macos.pas @@ -0,0 +1,100 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for MacOS + + 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 support information structures for MacOS. } +unit i_macos; + +{$i fpcdefs.inc} + + interface + + uses + systems; + const + system_powerpc_macos_info : tsysteminfo = + ( + system : system_powerpc_MACOS; + name : 'Mac OS for PowerPC'; + shortname : 'MacOS'; + flags : [tf_p_ext_support,tf_files_case_aware]; + cpu : cpu_powerpc; + unit_env : ''; + extradefines : ''; + exeext : ''; + defext : ''; + scriptext : ''; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : 'Lib'; + staticlibext : 'Lib'; + staticlibprefix : ''; + sharedlibprefix : ''; + sharedClibext : 'Lib'; + staticClibext : 'Lib'; + staticClibprefix : ''; + sharedClibprefix : ''; + importlibprefix : 'imp'; + importlibext : 'Lib'; + Cprefix : ''; + newline : #13; + dirsep : ':'; + assem : as_powerpc_mpw; + assemextern : as_powerpc_mpw; + link : nil; + linkextern : nil; + ar : ar_mpw_ar; + res : res_powerpc_mpw; + dbg : dbg_stabs; + script : script_mpw; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 8; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 16 + ); + first_parm_offset : 8; + stacksize : 262144; + abi : abi_powerpc_aix; + ); + + implementation + +initialization +{$ifdef cpupowerpc} + {$ifdef macos} + set_source_info(system_powerpc_macos_info); + {$endif macos} +{$endif cpupowerpc} +end. diff --git a/closures/compiler/systems/i_morph.pas b/closures/compiler/systems/i_morph.pas new file mode 100644 index 0000000000..f6de90967b --- /dev/null +++ b/closures/compiler/systems/i_morph.pas @@ -0,0 +1,101 @@ +{ + Copyright (c) 2004 by Free Pascal Development Team + + This unit implements support information structures for MorphOS + + 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 support information structures for the MorphOS. } +unit i_morph; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_powerpc_MorphOS_info : tsysteminfo = + ( + system : system_powerpc_MorphOS; + name : 'MorphOS'; + shortname : 'MorphOS'; + flags : [tf_files_case_aware,tf_smartlink_library]; + cpu : cpu_powerpc; + unit_env : ''; + extradefines : ''; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.library'; + staticlibext : '.a'; + staticlibprefix : 'lib'; + sharedlibprefix : ''; + sharedClibext : '.library'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_amiga; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + abi : abi_powerpc_sysv; + ); + + implementation + +initialization +{$ifdef CPUPOWERPC} + {$ifdef MORPHOS} + set_source_info(system_powerpc_MorphOS_info); + {$endif MORPHOS} +{$endif CPUPOWERPC} +end. diff --git a/closures/compiler/systems/i_nativent.pas b/closures/compiler/systems/i_nativent.pas new file mode 100644 index 0000000000..a9bf61b0eb --- /dev/null +++ b/closures/compiler/systems/i_nativent.pas @@ -0,0 +1,106 @@ +{ + Copyright (c) 2009 by Sven Barth + + This unit implements support information structures for nativent + Based on Peter Vreman's i_win + + 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 support information structures for nativent. } +unit i_nativent; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_i386_nativent_info : tsysteminfo = + ( + system : system_i386_NATIVENT; + name : 'Native NT for i386'; + shortname : 'NativeNT'; + flags : [tf_files_case_aware,tf_use_function_relative_addresses,tf_smartlink_library + ,tf_smartlink_sections{,tf_section_threadvars}{,tf_needs_dwarf_cfi}, + tf_no_pic_supported, + tf_no_generic_stackcheck{,tf_has_winlike_resources},tf_under_development, + tf_dwarf_only_local_labels]; + cpu : cpu_i386; + unit_env : 'NTUNITS'; + extradefines : 'NATIVENT,UNICODE'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.bat'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + assem : as_i386_pecoff; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_gnu_windres; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 16; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 16; + varalignmin : 0; + varalignmax : 16; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 16 + ); + first_parm_offset : 8; + stacksize : 16*1024*1024; + abi : abi_default; + ); + + implementation + +initialization +{$ifdef CPU86} + {$ifdef NATIVENT} + set_source_info(system_i386_nativent_info); + {$endif NATIVENT} +{$endif CPU86} +end. diff --git a/closures/compiler/systems/i_nds.pas b/closures/compiler/systems/i_nds.pas new file mode 100644 index 0000000000..245fe7b6c9 --- /dev/null +++ b/closures/compiler/systems/i_nds.pas @@ -0,0 +1,102 @@ +{ + This unit implements support information structures for Nintendo DS + + Copyright (c) 1998-2002 by Peter Vreman + + 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 support information structures for nds. } +unit i_nds; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_arm_nds_info : tsysteminfo = + ( + system : system_arm_nds; + name : 'Nintendo DS'; + shortname : 'nds'; + flags : [tf_needs_symbol_size,tf_files_case_sensitive, + tf_requires_proper_alignment,tf_smartlink_sections]; + cpu : cpu_arm; + unit_env : ''; + extradefines : ''; + exeext : '.bin'; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8;//4; + varalignmin : 0; + varalignmax : 8;//4; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 8;//4; + maxCrecordalign : 8//4 + ); + first_parm_offset : 8; + stacksize : $3CFF; //15615? or 16384?; + abi : abi_eabi + ); + + implementation + +initialization +{$ifdef arm} + {$ifdef nds} + set_source_info(system_arm_nds_info); + {$endif nds} +{$endif arm} +end. diff --git a/closures/compiler/systems/i_nwl.pas b/closures/compiler/systems/i_nwl.pas new file mode 100644 index 0000000000..b2c47219c0 --- /dev/null +++ b/closures/compiler/systems/i_nwl.pas @@ -0,0 +1,101 @@ +{ + Copyright (c) 1998-2004 by Peter Vreman + + This unit implements support information structures for Netware (libc) modules + + 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 support information structures for Netware libc modules. } +unit i_nwl; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_i386_netwlibc_info : tsysteminfo = + ( + system : system_i386_netwlibc; + name : 'Netware for i386(libc)'; + shortname : 'Netwlibc'; + flags : [tf_smartlink_library]; + cpu : cpu_i386; + unit_env : 'NETWLIBCUNITS'; + extradefines : 'NETWARE;NETWARE_LIBC'; + exeext : '.nlm'; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.nlm'; + staticlibext : '.a'; + staticlibprefix : ''; + sharedlibprefix : ''; + sharedClibext : '.nlm'; + staticClibext : '.a'; + staticClibprefix : ''; + sharedClibprefix : ''; + importlibprefix : 'imp'; + importlibext : '.a'; + Cprefix : ''; + newline : #13#10; + dirsep : '/'; + assem : as_i386_elf32; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 16384; + abi : abi_default + ); + + implementation + +initialization +{$ifdef CPU86} + {$ifdef netwlibc} + set_source_info(system_i386_netwlibc_info); + {$endif netwlibc} +{$endif CPU86} +end. diff --git a/closures/compiler/systems/i_nwm.pas b/closures/compiler/systems/i_nwm.pas new file mode 100644 index 0000000000..307f2fee8f --- /dev/null +++ b/closures/compiler/systems/i_nwm.pas @@ -0,0 +1,101 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for Netware modules + + 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 support information structures for Netware modules. } +unit i_nwm; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_i386_netware_info : tsysteminfo = + ( + system : system_i386_netware; + name : 'Netware for i386(clib)'; + shortname : 'Netware'; + flags : [tf_smartlink_library,tf_smartlink_sections,tf_dwarf_only_local_labels]; + cpu : cpu_i386; + unit_env : 'NETWAREUNITS'; + extradefines : 'NETWARE_CLIB'; + exeext : '.nlm'; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.nlm'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : ''; + sharedClibext : '.nlm'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #13#10; + dirsep : '/'; + assem : as_i386_nlmcoff; // as_i386_elf32; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 16384; + abi : abi_default + ); + + implementation + +initialization +{$ifdef CPU86} + {$ifdef netware} + set_source_info(system_i386_netware_info); + {$endif netware} +{$endif CPU86} +end. diff --git a/closures/compiler/systems/i_os2.pas b/closures/compiler/systems/i_os2.pas new file mode 100644 index 0000000000..83a0a1445a --- /dev/null +++ b/closures/compiler/systems/i_os2.pas @@ -0,0 +1,118 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for OS/2 + + 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 support information structures for OS/2. } +unit i_os2; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + res_wrc_os2_info : tresinfo = + ( + id : res_watcom_wrc_os2; + resbin : ''; + rescmd : ''; + rcbin : 'wrc'; + rccmd : '-r -zm -q -bt=os2 -fo=$RES $RC'; + resourcefileclass : nil; + resflags : [res_single_file]; + ); + + system_i386_os2_info : tsysteminfo = + ( + system : system_i386_OS2; + name : 'OS/2'; + shortname : 'OS2'; + flags : [tf_need_export,tf_files_case_aware,tf_use_8_3]; + cpu : cpu_i386; + unit_env : 'OS2UNITS'; + extradefines : ''; + exeext : '.exe'; + defext : '.def'; + scriptext : '.cmd'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : ''; + sharedClibprefix : ''; + importlibprefix : ''; + importlibext : '.a'; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + assem : as_i386_as_aout; + assemextern : as_i386_as_aout; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_watcom_wrc_os2; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 256*1024; + abi : abi_default; + ); + + + implementation + +initialization +{$ifdef CPU86} + {$ifdef os2} + {$IFNDEF EMX} + set_source_info(system_i386_os2_info); + {$ENDIF EMX} + {$IFDEF VER1_0} + set_source_info(system_i386_os2_info); + {$ENDIF VER1_0} + {$endif os2} +{$endif CPU86} +end. diff --git a/closures/compiler/systems/i_palmos.pas b/closures/compiler/systems/i_palmos.pas new file mode 100644 index 0000000000..fd819e2fb6 --- /dev/null +++ b/closures/compiler/systems/i_palmos.pas @@ -0,0 +1,189 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for PalmOS + + 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 support information structures for PalmOS. } +unit i_palmos; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_m68k_palmos_info : tsysteminfo = + ( + system : system_m68k_PalmOS; + name : 'PalmOS'; + shortname : 'PalmOS'; + flags : [tf_code_small,tf_static_reg_based,tf_smartlink_sections]; + cpu : cpu_m68k; + unit_env : 'PALMUNITS'; + extradefines : ''; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : '_'; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 8192; + abi : abi_default; + ); + + res_m68k_palmos_info : tresinfo = + ( + id : res_m68k_palmos; + resbin : 'pilrc'; + rescmd : '-I $INC $RES'; + rcbin : ''; + rccmd : ''; + resourcefileclass : nil; + resflags : []; + ); + + system_arm_palmos_info : tsysteminfo = + ( + system : system_arm_PalmOS; + name : 'PalmOS'; + shortname : 'PalmOS'; + flags : [tf_code_small,tf_static_reg_based,tf_smartlink_sections,tf_requires_proper_alignment]; + cpu : cpu_arm; + unit_env : 'PALMUNITS'; + extradefines : ''; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : '_'; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 8192; + abi : abi_default; + ); + + res_arm_palmos_info : tresinfo = + ( + id : res_m68k_palmos; + resbin : 'pilrc'; + rescmd : '-I $INC $RES'; + rcbin : ''; + rccmd : ''; + resourcefileclass : nil; + resflags : []; + ); + +implementation + +initialization +{$ifdef cpu68} + {$ifdef palmos} + set_source_info(system_m68k_palmos_info); + {$endif palmos} +{$endif cpu68} +{$ifdef cpuarm} + {$ifdef palmos} + set_source_info(system_arm_palmos_info); + {$endif palmos} +{$endif cpuarm} +end. diff --git a/closures/compiler/systems/i_sunos.pas b/closures/compiler/systems/i_sunos.pas new file mode 100644 index 0000000000..4e84ee8f79 --- /dev/null +++ b/closures/compiler/systems/i_sunos.pas @@ -0,0 +1,245 @@ +{ + Copyright (c) 1998-2008 by Peter Vreman + + This unit implements support information structures for solaris + + 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 support information structures for solaris. } +unit i_sunos; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_i386_solaris_info : tsysteminfo = + ( + system : system_i386_solaris; + name : 'Solaris for i386'; + shortname : 'solaris'; + flags : [tf_under_development,tf_needs_symbol_size, + tf_files_case_sensitive,tf_requires_proper_alignment, + tf_smartlink_library,tf_has_winlike_resources]; + cpu : cpu_i386; + unit_env : 'SOLARISUNITS'; + extradefines : 'UNIX;LIBC;SUNOS;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_i386_elf32; + assemextern : as_ggas; + link : nil; + linkextern : nil; + ar : ar_gnu_gar; + res : res_elf; + dbg : dbg_stabs; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 16; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 16; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 16; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + abi : abi_default; + ); + + + system_x86_64_solaris_info : tsysteminfo = + ( + system : system_x86_64_solaris; + name : 'Solaris for x86-64'; + shortname : 'solaris'; + flags : [tf_needs_symbol_size,tf_needs_symbol_type, + tf_under_development, + tf_files_case_sensitive, + tf_requires_proper_alignment,tf_smartlink_library,tf_library_needs_pic, + tf_has_winlike_resources]; + cpu : cpu_x86_64; + unit_env : 'SOLARISUNITS'; + extradefines : 'UNIX;LIBC;SUNOS;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_ggas{as_x86_64_elf64}; + assemextern : as_ggas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_elf; + dbg : dbg_dwarf2; + script : script_unix; + endian : endian_little; + alignment : + ( + procalign : 8; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 8; + varalignmin : 0; + varalignmax : 16; + localalignmin : 4; + localalignmax : 16; + recordalignmin : 0; + recordalignmax : 16; + maxCrecordalign : 16 + ); + first_parm_offset : 16; + stacksize : 8*1024*1024; + abi : abi_default + ); + + + system_sparc_solaris_info : tsysteminfo = + ( + system : system_sparc_solaris; + name : 'Solaris for SPARC'; + shortname : 'solaris'; + flags : [tf_needs_symbol_size,tf_under_development, + tf_files_case_sensitive, + tf_requires_proper_alignment,tf_smartlink_library, + tf_has_winlike_resources]; + cpu : cpu_SPARC; + unit_env : 'SOLARISUNITS'; + extradefines : 'UNIX;LIBC;SUNOS;HASUNIX'; + exeext : ''; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_ggas; + assemextern : as_ggas; + link : nil; + linkextern : nil; + ar : ar_gnu_gar; + res : res_elf; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 4; + constalignmax : 8; + varalignmin : 4; + varalignmax : 8; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 8; + maxCrecordalign : 8 + ); + first_parm_offset : 92; + stacksize : 262144; + abi : abi_default; + ); + + implementation + +initialization +{$ifdef CPU86} + {$ifdef solaris} + set_source_info(system_i386_solaris_info); + {$endif solaris} +{$endif CPU86} +{$ifdef CPUX86_64} + {$ifdef solaris} + set_source_info(system_x86_64_solaris_info); + {$endif solaris} +{$endif CPUX86_64} +{$ifdef CPUSparc} + {$ifdef solaris} + set_source_info(system_sparc_solaris_info); + {$endif solaris} +{$endif CPUSparc} + +end. diff --git a/closures/compiler/systems/i_symbian.pas b/closures/compiler/systems/i_symbian.pas new file mode 100644 index 0000000000..f2cf1bf585 --- /dev/null +++ b/closures/compiler/systems/i_symbian.pas @@ -0,0 +1,174 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2007 by contributors of the Free Pascal Compiler + + This unit implements support information structures for symbian os + + 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 support information structures for win32. } +unit i_symbian; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_i386_symbian_info : tsysteminfo = + ( + system : system_i386_symbian; + name : 'Symbian OS for i386'; + shortname : 'Symbian'; + flags : [tf_files_case_aware, tf_has_dllscanner, + tf_smartlink_library]; + cpu : cpu_i386; + unit_env : 'SYMBIANUNITS'; + extradefines : 'SYMBIAN'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.bat'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_gnu_windres; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 16; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 16; + varalignmin : 0; + varalignmax : 16; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 16 + ); + first_parm_offset : 8; + stacksize : 262144; + abi : abi_default; + ); + + system_arm_symbian_info : tsysteminfo = + ( + system : system_arm_symbian; + name : 'Symbian OS for ARM'; + shortname : 'Symbian'; + flags : [tf_files_case_aware, tf_has_dllscanner, + tf_requires_proper_alignment,tf_no_pic_supported]; + cpu : cpu_arm; + unit_env : 'SYMBIANUNITS'; + extradefines : 'SYMBIAN'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.bat'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + abi : abi_default; + ); + + +implementation + +initialization + +{$ifdef CPU86} + {$ifdef Symbian} + set_source_info(system_i386_symbian_info); + {$endif Symbian} +{$endif CPU86} + +{$ifdef CPUARM} + {$ifdef Symbian} + set_source_info(system_arm_symbian_info); + {$endif Symbian} +{$endif CPUARM} + +end. diff --git a/closures/compiler/systems/i_watcom.pas b/closures/compiler/systems/i_watcom.pas new file mode 100644 index 0000000000..8ca9087033 --- /dev/null +++ b/closures/compiler/systems/i_watcom.pas @@ -0,0 +1,101 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for Watcom + + 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 support information structures for Watcom. } +unit i_watcom; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_i386_watcom_info : tsysteminfo = + ( + system : system_i386_Watcom; + name : 'Watcom compatible DOS extenders'; + shortname : 'WATCOM'; + flags : [tf_use_8_3]; + cpu : cpu_i386; + unit_env : 'WATCOMUNITS'; + extradefines : 'DPMI'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.bat'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.asm'; + objext : '.obj'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : ''; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : ''; + sharedClibprefix : ''; + importlibprefix : 'imp'; + importlibext : '.a'; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + assem : as_i386_wasm; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 16384; + abi : abi_default; + ); + + implementation + +initialization +{$ifdef cpu86} + {$ifdef watcom} + set_source_info(system_i386_watcom_info); + {$endif watcom} +{$endif cpu86} +end. diff --git a/closures/compiler/systems/i_wdosx.pas b/closures/compiler/systems/i_wdosx.pas new file mode 100644 index 0000000000..1ff54bddf0 --- /dev/null +++ b/closures/compiler/systems/i_wdosx.pas @@ -0,0 +1,103 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support information structures for win32 + + 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 support information structures for wdosx. } +unit i_wdosx; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_i386_wdosx_info : tsysteminfo = + ( + system : system_i386_wdosx; + name : 'WDOSX DOS extender'; + shortname : 'WDOSX'; + flags : [tf_use_8_3,tf_has_dllscanner]; + cpu : cpu_i386; + unit_env : 'WDOSXUNITS'; + extradefines : 'MSWINDOWS'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.bat'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.rc'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : ''; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + assem : as_i386_pecoffwdosx; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_gnu_windres; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 2; + maxCrecordalign : 16 + ); + first_parm_offset : 8; + stacksize : 32*1024*1024; + abi : abi_default; + ); + + implementation + +initialization +{$ifdef CPU86} + {$ifdef WIN32} + {$ifdef WDOSX} + set_source_info(system_i386_wdosx_info); + {$endif WDOSX} + {$endif WIN32} +{$endif CPU86} +end. diff --git a/closures/compiler/systems/i_wii.pas b/closures/compiler/systems/i_wii.pas new file mode 100644 index 0000000000..c9c7a8c1cd --- /dev/null +++ b/closures/compiler/systems/i_wii.pas @@ -0,0 +1,101 @@ +{ + Copyright (c) 2011 by Francesco Lombardi + + This unit implements support information structures for Wii + + 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 support information structures for the Nintendo Wii. } +unit i_wii; + + interface + + uses + systems; + + const + system_powerpc_wii_info : tsysteminfo = + ( + system : system_powerpc_wii; + name : 'Wii'; + shortname : 'Wii'; + flags : [tf_under_development,tf_needs_symbol_size,tf_files_case_aware, + tf_use_function_relative_addresses,tf_needs_symbol_type, + tf_smartlink_library]; + cpu : cpu_powerpc; + unit_env : ''; + extradefines : ''; + exeext : '.dol'; + defext : '.def'; + scriptext : '.sh'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.so'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : 'lib'; + sharedClibext : '.so'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : 'lib'; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #10; + dirsep : '/'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_none; + dbg : dbg_stabs; + script : script_unix; + endian : endian_big; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 8 + ); + first_parm_offset : 8; + stacksize : 131072; // 128 kb + abi : abi_powerpc_sysv; + ); + + implementation + +initialization +{$ifdef CPUPOWERPC} + {$ifdef WII} + set_source_info(system_powerpc_wii_info); + {$endif WII} +{$endif CPUPOWERPC} +end. diff --git a/closures/compiler/systems/i_win.pas b/closures/compiler/systems/i_win.pas new file mode 100644 index 0000000000..8fc96d2bc8 --- /dev/null +++ b/closures/compiler/systems/i_win.pas @@ -0,0 +1,320 @@ +{ + Copyright (c) 1998-2008 by Peter Vreman + + This unit implements support information structures for win32 + + 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 support information structures for win32. } +unit i_win; + +{$i fpcdefs.inc} + + interface + + uses + systems; + + const + system_i386_win32_info : tsysteminfo = + ( + system : system_i386_WIN32; + name : 'Win32 for i386'; + shortname : 'Win32'; + flags : [tf_files_case_aware,tf_has_dllscanner,tf_smartlink_library + ,tf_smartlink_sections{,tf_section_threadvars}{,tf_needs_dwarf_cfi}, + tf_winlikewidestring,tf_no_pic_supported, + tf_no_generic_stackcheck,tf_has_winlike_resources, + tf_dwarf_only_local_labels, + tf_safecall_exceptions,tf_no_backquote_support]; + cpu : cpu_i386; + unit_env : 'WIN32UNITS'; + extradefines : 'MSWINDOWS;WINDOWS'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.bat'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + assem : as_i386_pecoff; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_gnu_windres; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 16; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 16; + varalignmin : 0; + varalignmax : 16; + localalignmin : 4; + localalignmax : 8; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 16 + ); + first_parm_offset : 8; + stacksize : 16*1024*1024; + abi : abi_default; + ); + + system_x64_win64_info : tsysteminfo = + ( + system : system_x86_64_win64; + name : 'Win64 for x64'; + shortname : 'Win64'; + flags : [tf_files_case_aware,tf_has_dllscanner, + tf_smartlink_sections,tf_smartlink_library, + tf_winlikewidestring,tf_no_pic_supported, + tf_dwarf_only_local_labels, + tf_no_generic_stackcheck,tf_has_winlike_resources, + tf_safecall_exceptions,tf_no_backquote_support]; + cpu : cpu_x86_64; + unit_env : 'WIN64UNITS'; + extradefines : 'MSWINDOWS;WINDOWS'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.bat'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.obj'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #13#10; + dirsep : '\'; + assem : as_x86_64_pecoff; + assemextern : as_x86_64_masm; + link : nil; + linkextern : nil; + ar : ar_gnu_ar; + res : res_win64_gorc; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 16; + loopalign : 8; + jumpalign : 0; + constalignmin : 0; + constalignmax : 16; + varalignmin : 0; + varalignmax : 16; + localalignmin : 8; + localalignmax : 16; + recordalignmin : 0; + recordalignmax : 8; + maxCrecordalign : 16 + ); + first_parm_offset : 16; + stacksize : 16*1024*1024; + abi : abi_default; + ); + + system_arm_wince_info : tsysteminfo = + ( + system : system_arm_wince; + name : 'WinCE for ARM'; + shortname : 'WinCE'; + flags : [tf_files_case_aware{,tf_winlikewidestring}, + tf_smartlink_sections,tf_requires_proper_alignment,tf_no_pic_supported, + tf_has_winlike_resources, + tf_safecall_exceptions,tf_no_backquote_support]; + cpu : cpu_arm; + unit_env : ''; + extradefines : 'UNDER_CE;WINDOWS;UNICODE'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.bat'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : ''; + newline : #13#10; + dirsep : '\'; + assem : as_gas; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar_scripted; + res : res_gnu_windres; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 0; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 4 + ); + first_parm_offset : 8; + stacksize : 262144; + abi : abi_default; + ); + + system_i386_wince_info : tsysteminfo = + ( + system : system_i386_wince; + name : 'WinCE for i386'; + shortname : 'WinCE'; + flags : [tf_files_case_aware + {,tf_winlikewidestring},tf_smartlink_sections,tf_no_pic_supported, + tf_has_winlike_resources, + tf_safecall_exceptions,tf_no_backquote_support]; + cpu : cpu_i386; + unit_env : ''; + extradefines : 'UNDER_CE;WINDOWS;UNICODE'; + exeext : '.exe'; + defext : '.def'; + scriptext : '.bat'; + smartext : '.sl'; + unitext : '.ppu'; + unitlibext : '.ppl'; + asmext : '.s'; + objext : '.o'; + resext : '.res'; + resobjext : '.or'; + sharedlibext : '.dll'; + staticlibext : '.a'; + staticlibprefix : 'libp'; + sharedlibprefix : ''; + sharedClibext : '.dll'; + staticClibext : '.a'; + staticClibprefix : 'lib'; + sharedClibprefix : ''; + importlibprefix : 'libimp'; + importlibext : '.a'; + Cprefix : '_'; + newline : #13#10; + dirsep : '\'; + assem : as_i386_pecoffwince; + assemextern : as_gas; + link : nil; + linkextern : nil; + ar : ar_gnu_ar_scripted; + res : res_gnu_windres; + dbg : dbg_stabs; + script : script_dos; + endian : endian_little; + alignment : + ( + procalign : 4; + loopalign : 4; + jumpalign : 0; + constalignmin : 0; + constalignmax : 4; + varalignmin : 0; + varalignmax : 4; + localalignmin : 4; + localalignmax : 4; + recordalignmin : 0; + recordalignmax : 4; + maxCrecordalign : 16 + ); + first_parm_offset : 8; + stacksize : 262144; + abi : abi_default; + ); + + + implementation + +initialization +{$ifdef CPU86} + {$ifdef WIN32} + {$ifndef WDOSX} + set_source_info(system_i386_win32_info); + {$endif WDOSX} + {$endif WIN32} + {$ifdef WINCE} + set_source_info(system_i386_wince_info); + {$endif WINCE} +{$endif CPU86} + +{$ifdef CPUX86_64} + {$ifdef WIN64} + {$ifndef WDOSX} + set_source_info(system_x64_win64_info); + {$endif WDOSX} + {$endif WIN64} +{$endif CPUX86_64} + +{$ifdef CPUARM} + {$ifdef WINCE} + set_source_info(system_arm_wince_info); + {$endif WINCE} +{$endif CPUARM} +end. diff --git a/closures/compiler/systems/mac_crea.txt b/closures/compiler/systems/mac_crea.txt new file mode 100644 index 0000000000..5372652cbc --- /dev/null +++ b/closures/compiler/systems/mac_crea.txt @@ -0,0 +1,71 @@ +FrŒn: devprograms@apple.com +Till: <olle.raab@freepascal.org> +Datum: mŒndag 10 januari 2005 22.33 +€mne: Re: Creator Registration Request + +Please include the line below in follow-up emails for this request. + +Follow-up: 6855616 + +Re: Creator Registration Request + +Dear Olle Raab, + +Thank you for registering your application creator information. We appreciate your continued product development and support of Apple Computer! The following product information has been registered: + +Company: Free Pascal Team +Contact: Olle Raab +Address: VikingavŠgen 28 A +S-224 77 Lund +Sweden + + +Application: Free Pascal Compiler +Phone: +46-46-120053 +EMail Address: olle.raab@freepascal.org + +Application Signatures: +FPas (Hex) 46506173 + +This letter serves as your confirmation. Please keep it on file. Additionally, you should review the information for accuracy. If you locate discrepancies, please contact Developer Support at devprograms@apple.com with your corrections. + +Thanks for supporting Apple! + +Best regards, + +Elisa Molson +Apple Developer Connection +----------------------------------- +Spotlight, 64-bit Support, Dashboard, Automator, and more. +Start developing today with the powerful new technologies in Mac OS X Tiger. + +REQUEST ------------------------------------------------------------------------ + +WEB CREATOR/FILE TYPE Registration Request +========================================== +%UNIQUE REGISTRATION%: +%NAME%: Olle Raab +%COMPANY%: Free Pascal Team +%ADDRESS%: VikingavŠgen 28 A +S-224 77 Lund +Sweden +%TELEPHONE%: +46-46-120053 +%E-MAIL%: olle.raab@freepascal.org +%PRODUCT NAME%: Free Pascal Compiler +%DEVICE DRIVER%: +%SIGNATURE (HEX)%: 46506173 +%END + + +DB REFERENCE ------------------------------------------------------------------- + +TIME IN: 10-Jan-2005 10:45 PST +TIME OUT: 10-Jan-2005 13:16 PST + +Copyright 2005, Apple Computer, Inc. + +SECURITY: NON-DISCLOSURE USE ONLY + + + + diff --git a/closures/compiler/systems/t_amiga.pas b/closures/compiler/systems/t_amiga.pas new file mode 100644 index 0000000000..14eb3cba4e --- /dev/null +++ b/closures/compiler/systems/t_amiga.pas @@ -0,0 +1,273 @@ +{ + Copyright (c) 2004-2006 by Free Pascal Development Team + + This unit implements support import, export, link routines + for the Amiga targets (AmigaOS/m68k, AmigaOS/PPC) + + 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 t_amiga; + +{$i fpcdefs.inc} + +interface + + uses + link; + + +type + PLinkerAmiga = ^TLinkerAmiga; + TLinkerAmiga = class(texternallinker) + private + function WriteResponseFile(isdll: boolean): boolean; + procedure SetAmiga68kInfo; + procedure SetAmigaPPCInfo; + function MakeAmiga68kExe: boolean; + function MakeAmigaPPCExe: boolean; + public + constructor Create; override; + procedure SetDefaultInfo; override; + function MakeExecutable: boolean; override; + end; + + +implementation + + uses + SysUtils, + cutils,cfileutl,cclasses, + globtype,globals,systems,verbose,script,fmodule,i_amiga; + + + +{**************************************************************************** + TLinkerAmiga +****************************************************************************} + +constructor TLinkerAmiga.Create; +begin + Inherited Create; + { allow duplicated libs (PM) } + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; +end; + +procedure TLinkerAmiga.SetAmiga68kInfo; +begin + with Info do begin + ExeCmd[1]:='m68k-amiga-ld $OPT -d -n -o $EXE $RES'; + end; +end; + +procedure TLinkerAmiga.SetAmigaPPCInfo; +begin + with Info do begin + ExeCmd[1]:='ld $OPT -defsym=__amigaos4__=1 -d -q -n -o $EXE $RES'; + end; +end; + +procedure TLinkerAmiga.SetDefaultInfo; +begin + case (target_info.system) of + system_m68k_amiga: SetAmiga68kInfo; + system_powerpc_amiga: SetAmigaPPCInfo; + end; +end; + + +function TLinkerAmiga.WriteResponseFile(isdll: boolean): boolean; +var + linkres : TLinkRes; + i : longint; + HPath : TCmdStrListItem; + s : string; + linklibc : boolean; +begin + WriteResponseFile:=False; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + s:=HPath.Str; + if (cs_link_on_target in current_settings.globalswitches) then + s:=ScriptFixFileName(s); + LinkRes.Add('-L'+s); + HPath:=TCmdStrListItem(HPath.Next); + end; + HPath:=TCmdStrListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + s:=HPath.Str; + if s<>'' then + LinkRes.Add('SEARCH_DIR('+Unix2AmigaPath(maybequoted(s))+')'); + HPath:=TCmdStrListItem(HPath.Next); + end; + + LinkRes.Add('INPUT ('); + { add objectfiles, start with prt0 always } + s:=FindObjectFile('prt0','',false); + LinkRes.AddFileName(s); + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + begin + LinkRes.AddFileName(Unix2AmigaPath(maybequoted(s))); + end; + end; + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + LinkRes.Add(')'); + LinkRes.Add('GROUP('); + while not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(Unix2AmigaPath(maybequoted(s))); + end; + end; + + if (cs_link_on_target in current_settings.globalswitches) then + begin + LinkRes.Add(')'); + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + linklibc:=false; + while not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + begin + LinkRes.Add('-l'+s); + linklibc:=true; + end; + end; + { be sure that libc&libgcc is the last lib } + if linklibc then + begin + LinkRes.Add('-lc'); + LinkRes.Add('-lgcc'); + end; + end + else + begin + while not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + LinkRes.Add('lib'+s+target_info.staticlibext); + end; + LinkRes.Add(')'); + end; + +{ Write and Close response } + linkres.writetodisk; + linkres.free; + + WriteResponseFile:=True; +end; + + +function TLinkerAmiga.MakeAmiga68kExe: boolean; +var + BinStr, + CmdStr : TCmdStr; + StripStr: string[40]; +begin + StripStr:=''; + if (cs_link_strip in current_settings.globalswitches) then StripStr:='-s'; + + { Call linker } + SplitBinCmd(Info.ExeCmd[1],BinStr,CmdStr); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$EXE',Unix2AmigaPath(maybequoted(ScriptFixFileName(current_module.exefilename^)))); + Replace(cmdstr,'$RES',Unix2AmigaPath(maybequoted(ScriptFixFileName(outputexedir+Info.ResName)))); + Replace(cmdstr,'$STRIP',StripStr); + MakeAmiga68kExe:=DoExec(FindUtil(BinStr),CmdStr,true,false); +end; + + +function TLinkerAmiga.MakeAmigaPPCExe: boolean; +var + BinStr, + CmdStr : TCmdStr; + StripStr: string[40]; +begin + StripStr:=''; + if (cs_link_strip in current_settings.globalswitches) then StripStr:='-s'; + + { Call linker } + SplitBinCmd(Info.ExeCmd[1],BinStr,CmdStr); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$EXE',Unix2AmigaPath(maybequoted(ScriptFixFileName(current_module.exefilename^)))); + Replace(cmdstr,'$RES',Unix2AmigaPath(maybequoted(ScriptFixFileName(outputexedir+Info.ResName)))); + Replace(cmdstr,'$STRIP',StripStr); + MakeAmigaPPCExe:=DoExec(FindUtil(BinStr),CmdStr,true,false); +end; + + +function TLinkerAmiga.MakeExecutable:boolean; +var + success : boolean; +begin + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + + { Write used files and libraries } + WriteResponseFile(false); + + case (target_info.system) of + system_m68k_amiga: success:=MakeAmiga68kExe; + system_powerpc_amiga: success:=MakeAmigaPPCExe; + end; + + { Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef m68k} +{ TODO: No executable creation support for m68k yet!} + RegisterExternalLinker(system_m68k_Amiga_info,TLinkerAmiga); + RegisterTarget(system_m68k_Amiga_info); +{$endif m68k} +{$ifdef powerpc} + RegisterExternalLinker(system_powerpc_Amiga_info,TLinkerAmiga); + RegisterTarget(system_powerpc_Amiga_info); +{$endif powerpc} +end. diff --git a/closures/compiler/systems/t_atari.pas b/closures/compiler/systems/t_atari.pas new file mode 100644 index 0000000000..5833ac8129 --- /dev/null +++ b/closures/compiler/systems/t_atari.pas @@ -0,0 +1,43 @@ +{ + Copyright (c) 2001-2002 by Peter Vreman + + This unit implements support import,export,link routines + for the (i386) Amiga target + + 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 t_atari; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + link, + cutils,cclasses, + globtype,globals,systems,verbose,script,fmodule,i_atari; + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterTarget(system_m68k_atari_info); +end. diff --git a/closures/compiler/systems/t_beos.pas b/closures/compiler/systems/t_beos.pas new file mode 100644 index 0000000000..ebcb3e6136 --- /dev/null +++ b/closures/compiler/systems/t_beos.pas @@ -0,0 +1,500 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support import,export,link routines + for the (i386) BeOS target. + + 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 t_beos; + +{$i fpcdefs.inc} + +interface + + uses + symsym,symdef, + import,export,link; + + type + timportlibbeos=class(timportlib) + procedure generatelib;override; + end; + + texportlibbeos=class(texportlib) + procedure preparelib(const s : string);override; + procedure exportprocedure(hp : texported_item);override; + procedure exportvar(hp : texported_item);override; + procedure generatelib;override; + end; + + tlinkerbeos=class(texternallinker) + private + Function WriteResponseFile(isdll:boolean;makelib:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + function MakeSharedLibrary:boolean;override; + end; + + +implementation + + uses + SysUtils, + cutils,cfileutl,cclasses, + verbose,systems,globtype,globals, + symconst,script, + fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,i_beos,ogbase; + +{***************************************************************************** + TIMPORTLIBBEOS +*****************************************************************************} + + procedure timportlibbeos.generatelib; + var + i : longint; + ImportLibrary : TImportLibrary; + begin + for i:=0 to current_module.ImportLibraryList.Count-1 do + begin + ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]); + current_module.linkothersharedlibs.add(ImportLibrary.Name,link_always); + end; + end; + + +{***************************************************************************** + TEXPORTLIBBEOS +*****************************************************************************} + +procedure texportlibbeos.preparelib(const s:string); +begin +end; + + +procedure texportlibbeos.exportprocedure(hp : texported_item); +var + hp2 : texported_item; +begin + { first test the index value } + if (hp.options and eo_index)<>0 then + begin + Message1(parser_e_no_export_with_index_for_target,'beos'); + exit; + end; + { now place in correct order } + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) and + (hp.name^>hp2.name^) do + hp2:=texported_item(hp2.next); + { insert hp there !! } + if assigned(hp2) and (hp2.name^=hp.name^) then + begin + { this is not allowed !! } + Message1(parser_e_export_name_double,hp.name^); + exit; + end; + if hp2=texported_item(current_module._exports.first) then + current_module._exports.concat(hp) + else if assigned(hp2) then + begin + hp.next:=hp2; + hp.previous:=hp2.previous; + if assigned(hp2.previous) then + hp2.previous.next:=hp; + hp2.previous:=hp; + end + else + current_module._exports.concat(hp); +end; + + +procedure texportlibbeos.exportvar(hp : texported_item); +begin + hp.is_var:=true; + exportprocedure(hp); +end; + + +procedure texportlibbeos.generatelib; +var + hp2 : texported_item; + pd : tprocdef; +begin + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) do + begin + if (not hp2.is_var) and + (hp2.sym.typ=procsym) then + begin + { the manglednames can already be the same when the procedure + is declared with cdecl } + pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]); + if pd.mangledname<>hp2.name^ then + begin +{$ifdef i386} + { place jump in al_procedures } + current_asmdata.asmlists[al_procedures].concat(Tai_align.Create_op(4,$90)); + current_asmdata.asmlists[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + current_asmdata.asmlists[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(pd.mangledname))); + current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); +{$endif i386} + end; + end + else + Message1(parser_e_no_export_of_variables_for_target,'beos'); + hp2:=texported_item(hp2.next); + end; +end; + + +{***************************************************************************** + TLINKERBEOS +*****************************************************************************} + +Constructor TLinkerBeos.Create; +var + s : string; + i : integer; +begin + Inherited Create; + s:=GetEnvironmentVariable('BELIBRARIES'); + { convert to correct format in case under unix system } + for i:=1 to length(s) do + if s[i] = ':' then + s[i] := ';'; + { just in case we have a single path : add the ending ; } + { since that is what the compiler expects. } + if pos(';',s) = 0 then + s:=s+';'; + LibrarySearchPath.AddPath(sysrootpath,s,true); {format:'path1;path2;...'} +end; + + +procedure TLinkerBeOS.SetDefaultInfo; +begin + with Info do + begin + ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE $CATRES'; + DllCmd[1]:='ld $OPT $INIT $FINI $SONAME -shared -L. -o $EXE $CATRES'; + DllCmd[2]:='strip --strip-unneeded $EXE'; +(* + ExeCmd[1]:='sh $RES $EXE $OPT $STATIC $STRIP -L.'; +{ ExeCmd[1]:='sh $RES $EXE $OPT $DYNLINK $STATIC $STRIP -L.';} + DllCmd[1]:='sh $RES $EXE $OPT -L.'; + +{ DllCmd[1]:='sh $RES $EXE $OPT -L. -g -nostart -soname=$EXE'; + } DllCmd[2]:='strip --strip-unneeded $EXE'; +{ DynamicLinker:='/lib/ld-beos.so.2';} +*) + end; +end; + + +function TLinkerBeOS.WriteResponseFile(isdll:boolean;makelib:boolean) : Boolean; +Var + linkres : TLinkRes; + i : integer; + cprtobj, + prtobj : string[80]; + HPath : TCmdStrListItem; + s : TCmdStr; + linklibc : boolean; +begin + WriteResponseFile:=False; +{ set special options for some targets } + linklibc:=(SharedLibFiles.Find('root')<>nil); + + prtobj:='prt0'; + cprtobj:='cprt0'; + if (cs_profile in current_settings.moduleswitches) or + (not SharedLibFiles.Empty) then + begin + AddSharedLibrary('root'); + linklibc:=true; + end; + + if (not linklibc) and makelib then + begin + linklibc:=true; + cprtobj:='dllprt.o'; + end; + + if linklibc then + prtobj:=cprtobj; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + { + if not isdll then + LinkRes.Add('ld -o $1 $2 $3 $4 $5 $6 $7 $8 $9 \') + else + LinkRes.Add('ld -o $1 -e 0 $2 $3 $4 $5 $6 $7 $8 $9\'); + } + LinkRes.Add('-m'); +// LinkRes.Add('elf_i386_be'); + LinkRes.Add('elf_i386_haiku'); + LinkRes.Add('-shared'); + LinkRes.Add('-Bsymbolic'); + + { Write path to search libraries } + HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + LinkRes.Add('-L'+HPath.Str); + HPath:=TCmdStrListItem(HPath.Next); + end; + HPath:=TCmdStrListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + LinkRes.Add('-L'+HPath.Str); + HPath:=TCmdStrListItem(HPath.Next); + end; + + { try to add crti and crtbegin if linking to C } + if linklibc then + begin + if librarysearchpath.FindFile('crti.o',false,s) then + LinkRes.AddFileName(s); + if librarysearchpath.FindFile('crtbegin.o',false,s) then + LinkRes.AddFileName(s); +{ s:=librarysearchpath.FindFile('start_dyn.o',found)+'start_dyn.o'; + if found then LinkRes.AddFileName(s+' \');} + + if prtobj<>'' then + LinkRes.AddFileName(FindObjectFile(prtobj,'',false)); + +// if isdll then +// LinkRes.AddFileName(FindObjectFile('func.o','',false)); + + if librarysearchpath.FindFile('init_term_dyn.o',false,s) then + LinkRes.AddFileName(s); + end + else + begin + if prtobj<>'' then + LinkRes.AddFileName(FindObjectFile(prtobj,'',false)); + end; + + { main objectfiles } + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + LinkRes.AddFileName(s); + end; + +{ LinkRes.Add('-lroot \'); + LinkRes.Add('/boot/develop/tools/gnupro/lib/gcc-lib/i586-beos/2.9-beos-991026/crtend.o \'); + LinkRes.Add('/boot/develop/lib/x86/crtn.o \');} + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(s) + end; + end; + + { Write sharedlibraries like -l<lib> } + if not SharedLibFiles.Empty then + begin + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + begin + linklibc:=true; + end; + end; + { be sure that libc is the last lib } +{ if linklibc then + LinkRes.Add('-lroot');} +{ if linkdynamic and (Info.DynamicLinker<>'') then + LinkRes.AddFileName(Info.DynamicLinker);} + end; + if isdll then + LinkRes.Add('-lroot'); + + { objects which must be at the end } + if linklibc then + begin + if librarysearchpath.FindFile('crtend.o',false,s) then + LinkRes.AddFileName(s); + if librarysearchpath.FindFile('crtn.o',false,s) then + LinkRes.AddFileName(s); + end; + +{ Write and Close response } + linkres.writetodisk; + linkres.free; + + WriteResponseFile:=True; +end; + + +function TLinkerBeOS.MakeExecutable:boolean; +var + binstr, + cmdstr : TCmdStr; + success, + useshell : boolean; + DynLinkStr : string[60]; + GCSectionsStr, + StaticStr, + StripStr : string[40]; +begin + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + StaticStr:=''; + StripStr:=''; + DynLinkStr:=''; + GCSectionsStr:=''; + if (cs_link_staticflag in current_settings.globalswitches) then + StaticStr:='-static'; + if (cs_link_strip in current_settings.globalswitches) then + StripStr:='-s'; + + if (cs_link_smart in current_settings.globalswitches) and + (tf_smartlink_sections in target_info.flags) then + GCSectionsStr:='--gc-sections'; + + If (cs_profile in current_settings.moduleswitches) or + ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then + begin + DynLinkStr:='-dynamic-linker='+Info.DynamicLinker; + if cshared Then + DynLinkStr:='--shared ' + DynLinkStr; + if rlinkpath<>'' Then + DynLinkStr:='--rpath-link '+rlinkpath + ' '+ DynLinkStr; + End; + +{ Write used files and libraries } + WriteResponseFile(false,false); + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$CATRES',CatFileContent(outputexedir+Info.ResName)); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$GCSECTIONS',GCSectionsStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + useshell:=not (tf_no_backquote_support in source_info.flags); + success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,useshell); + +{ Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +Function TLinkerBeOS.MakeSharedLibrary:boolean; +var + binstr, + cmdstr, + SoNameStr : TCmdStr; + success : boolean; + DynLinkStr : string[60]; + StaticStr, + StripStr : string[40]; + + begin + MakeSharedLibrary:=false; + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.sharedlibfilename^); + +{ Create some replacements } + StaticStr:=''; + StripStr:=''; + DynLinkStr:=''; + if (cs_link_staticflag in current_settings.globalswitches) then + StaticStr:='-static'; + if (cs_link_strip in current_settings.globalswitches) then + StripStr:='-s'; + If (cs_profile in current_settings.moduleswitches) or + ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then + begin + DynLinkStr:='-dynamic-linker='+Info.DynamicLinker; + if cshared Then + DynLinkStr:='--shared ' + DynLinkStr; + if rlinkpath<>'' Then + DynLinkStr:='--rpath-link '+rlinkpath + ' '+ DynLinkStr; + End; +{ Write used files and libraries } + WriteResponseFile(true,true); + + SoNameStr:='-soname '+ExtractFileName(current_module.sharedlibfilename^); + +{ Call linker } + SplitBinCmd(Info.DllCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$CATRES',CatFileContent(outputexedir+Info.ResName)); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + Replace(cmdstr,'$SONAME',SoNameStr); + + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,true); + +{ Strip the library ? } + if success and (cs_link_strip in current_settings.globalswitches) then + begin + SplitBinCmd(Info.DllCmd[2],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^)); + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,false); + end; + +{ Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + + MakeSharedLibrary:=success; { otherwise a recursive call to link method } +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef i386} + RegisterExternalLinker(system_i386_beos_info,TLinkerbeos); + RegisterImport(system_i386_beos,timportlibbeos); + RegisterExport(system_i386_beos,texportlibbeos); + RegisterTarget(system_i386_beos_info); +{$endif i386} +end. diff --git a/closures/compiler/systems/t_bsd.pas b/closures/compiler/systems/t_bsd.pas new file mode 100644 index 0000000000..8011dadeff --- /dev/null +++ b/closures/compiler/systems/t_bsd.pas @@ -0,0 +1,855 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman (original Linux) + (c) 2000 by Marco van de Voort (FreeBSD mods) + + This unit implements support import,export,link routines + for the (i386)FreeBSD target + + 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 t_bsd; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + sysutils, + cutils,cfileutl,cclasses, + verbose,systems,globtype,globals, + symconst,script, + fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,symsym,symdef, + import,export,link,comprsrc,rescmn,i_bsd,expunix, + cgutils,cgbase,cgobj,cpuinfo,ogbase; + + type + timportlibdarwin=class(timportlib) + procedure generatelib;override; + end; + + timportlibbsd=class(timportlib) + procedure generatelib;override; + end; + + texportlibbsd=class(texportlibunix) + end; + + texportlibdarwin=class(texportlibbsd) + procedure setinitname(list: TAsmList; const s: string); override; + procedure setfininame(list: TAsmList; const s: string); override; + end; + + tlinkerbsd=class(texternallinker) + private + LdSupportsNoResponseFile : boolean; + LibrarySuffix : Char; + Function WriteResponseFile(isdll:boolean) : Boolean; + Function GetDarwinPrtobjName(isdll: boolean): TCmdStr; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + function MakeSharedLibrary:boolean;override; + procedure LoadPredefinedLibraryOrder; override; + end; + + + +{***************************************************************************** + TIMPORTLIBDARWIN +*****************************************************************************} + + procedure timportlibdarwin.generatelib; + begin + end; + + +{***************************************************************************** + TEXPORTLIBDARWIN +*****************************************************************************} + + procedure texportlibdarwin.setinitname(list: TAsmList; const s: string); + begin + new_section(list,sec_init_func,'',sizeof(pint)); + list.concat(Tai_const.Createname(s,0)); + end; + + + procedure texportlibdarwin.setfininame(list: TAsmList; const s: string); + begin + new_section(list,sec_term_func,'',sizeof(pint)); + list.concat(Tai_const.Createname(s,0)); + end; + + +{***************************************************************************** + TIMPORTLIBBSD +*****************************************************************************} + + procedure timportlibbsd.generatelib; + var + i : longint; + ImportLibrary : TImportLibrary; + begin + for i:=0 to current_module.ImportLibraryList.Count-1 do + begin + ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]); + current_module.linkothersharedlibs.add(ImportLibrary.Name,link_always); + end; + end; + + +{***************************************************************************** + TLINKERBSD +*****************************************************************************} + +Constructor TLinkerBSD.Create; +begin + Inherited Create; + if not Dontlinkstdlibpath Then + if not(target_info.system in systems_darwin) then + LibrarySearchPath.AddPath(sysrootpath,'/lib;/usr/lib;/usr/X11R6/lib',true) + else + { Mac OS X doesn't have a /lib } + LibrarySearchPath.AddPath(sysrootpath,'/usr/lib',true) +end; + + +procedure TLinkerBSD.SetDefaultInfo; +{ + This will also detect which libc version will be used +} +begin + LibrarySuffix:=' '; + LdSupportsNoResponseFile := (target_info.system in ([system_m68k_netbsd]+systems_darwin)); + with Info do + begin + if LdSupportsNoResponseFile then + begin + if not(target_info.system in systems_darwin) then + begin + ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE $CATRES'; + DllCmd[1]:='ld $OPT -shared -L. -o $EXE $CATRES' + end + else + begin +{$ifndef cpu64bitaddr} + { Set the size of the page at address zero to 64kb, so nothing + is loaded below that address. This avoids problems with the + strange Windows-compatible resource handling that assumes + that addresses below 64kb do not exist. + + On 64bit systems, page zero is 4GB by default, so no problems + there. + } + { In case of valgrind, don't do that, because it cannot deal with + a custom pagezero size -- in general, this should not cause any + problems because the resources are added at the end and most + programs with problems that require Valgrind will have more + than 60KB of data (first 4KB of address space is always invalid) + } + ExeCmd[1]:='ld $PRTOBJ $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -multiply_defined suppress -L. -o $EXE $CATRES'; + if not(cs_gdb_valgrind in current_settings.globalswitches) then + ExeCmd[1]:=ExeCmd[1]+' -pagezero_size 0x10000'; +{$else ndef cpu64bitaddr} + ExeCmd[1]:='ld $PRTOBJ $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -multiply_defined suppress -L. -o $EXE $CATRES'; +{$endif ndef cpu64bitaddr} + if (apptype<>app_bundle) then + DllCmd[1]:='ld $PRTOBJ $OPT $GCSECTIONS -dynamic -dylib -multiply_defined suppress -L. -o $EXE $CATRES' + else + DllCmd[1]:='ld $PRTOBJ $OPT $GCSECTIONS -dynamic -bundle -multiply_defined suppress -L. -o $EXE $CATRES' + end + end + else + begin + ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE $RES'; + DllCmd[1]:='ld $OPT $INIT $FINI $SONAME -shared -L. -o $EXE $RES'; + end; + if not(target_info.system in systems_darwin) then + DllCmd[2]:='strip --strip-unneeded $EXE' + else + DllCmd[2]:='strip -x $EXE'; + { OpenBSD seems to use a wrong dynamic linker by default } + if target_info.system = system_i386_openbsd then + DynamicLinker:='/usr/libexec/ld.so' + else + DynamicLinker:=''; + end; +end; + +procedure TLinkerBSD.LoadPredefinedLibraryOrder; +// put your linkorder/linkalias overrides here. +// Note: assumes only called when reordering/aliasing is used. +Begin + if not(target_info.system in systems_darwin) then + begin + if (target_info.system =system_i386_freebsd) and + not (cs_link_no_default_lib_order in current_settings.globalswitches) Then + Begin + LinkLibraryOrder.add('gcc','',15); + LinkLibraryOrder.add('c','',50); // c and c_p mutual. excl? + LinkLibraryOrder.add('c_p','',55); + LinkLibraryOrder.add('pthread','',75); // pthread and c_r should be mutually exclusive + LinkLibraryOrder.add('c_r','',76); + LinkLibraryOrder.add('kvm','',80); // must be before ncurses + if (cs_link_pthread in current_settings.globalswitches) Then // convert libpthread to libc_r. + LinkLibraryAliases.add('pthread','c_r'); + end; + end +else + begin + LinkLibraryOrder.add('gcc','',15); + LinkLibraryOrder.add('c','',50); + end; +End; + + +Function TLinkerBSD.GetDarwinPrtobjName(isdll: boolean): TCmdStr; +begin + if not(isdll) then + if not(cs_profile in current_settings.moduleswitches) then + begin + if not librarysearchpath.FindFile('crt1.o',false,result) then + result:='/usr/lib/crt1.o'; + end + else + begin + if not librarysearchpath.FindFile('gcrt1.o',false,result) then + result:='/usr/lib/gcrt1.o'; + end + else + begin + if (apptype=app_bundle) then + begin + if not librarysearchpath.FindFile('bundle1.o',false,result) then + result:='/usr/lib/bundle1.o' + end + else + begin + if not librarysearchpath.FindFile('dylib1.o',false,result) then + result:='/usr/lib/dylib1.o' + end; + end; + result:=maybequoted(result); +end; + + +Function TLinkerBSD.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + i : longint; + cprtobj, + gprtobj, + prtobj : string[80]; + HPath : TCmdStrListItem; + s,s1,s2 : TCmdStr; + linkdynamic, + linklibc : boolean; + Fl1,Fl2 : Boolean; + IsDarwin : Boolean; + ReOrder : Boolean; + +begin + WriteResponseFile:=False; + ReOrder:=False; + IsDarwin:=target_info.system in systems_darwin; +{ set special options for some targets } + if not IsDarwin Then + begin + if isdll and (target_info.system in systems_freebsd) then + begin + prtobj:='dllprt0'; + cprtobj:='dllprt0'; + gprtobj:='dllprt0'; + end + else + begin + prtobj:='prt0'; + cprtobj:='cprt0'; + gprtobj:='gprt0'; + end; + linkdynamic:=not(SharedLibFiles.empty); + linklibc:=(SharedLibFiles.Find('c')<>nil); + // this one is a bit complex. + // Only reorder for now if -XL or -XO params are given + // or when -Xf. + reorder:= linklibc and + ( + ReorderEntries + or + (cs_link_pthread in current_settings.globalswitches)); + if cs_profile in current_settings.moduleswitches then + begin + prtobj:=gprtobj; + AddSharedLibrary('c'); + LibrarySuffix:='p'; + linklibc:=true; + end + else + begin + if linklibc then + prtobj:=cprtobj; + end; + // after this point addition of shared libs not allowed. + end + else + begin + { for darwin: always link dynamically against libc } + linklibc := true; +{$ifdef MACOSX104ORHIGHER} + { not sure what this is for, but gcc always links against it } + if not(cs_profile in current_settings.moduleswitches) then + AddSharedLibrary('SystemStubs') + else + AddSharedLibrary('SystemStubs_profile'); +{$endif MACOSX104ORHIGHER} + reorder:=reorderentries; + prtobj:=''; + end; + + if reorder Then + ExpandAndApplyOrder(SharedLibFiles); + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + if (target_info.system in systems_darwin) and + (sysrootpath<>'') then + begin + LinkRes.Add('-syslibroot'); + LinkRes.Add(sysrootpath); + end; + + if (not isdll) or + (apptype=app_bundle) then + begin + if (target_info.system in systems_darwin) then + begin + LinkRes.Add('-arch'); + case target_info.system of + system_powerpc_darwin: + LinkRes.Add('ppc'); + system_i386_darwin, + system_i386_iphonesim: + LinkRes.Add('i386'); + system_powerpc64_darwin: + LinkRes.Add('ppc64'); + system_x86_64_darwin: + LinkRes.Add('x86_64'); + system_arm_darwin: + { current versions of the linker require the sub-architecture type + to be specified } + LinkRes.Add(lower(cputypestr[current_settings.cputype])); + end; + end; + end; + { Write path to search libraries } + HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + if LdSupportsNoResponseFile then + LinkRes.Add('-L'+HPath.Str) + else + LinkRes.Add('SEARCH_DIR('+maybequoted(HPath.Str)+')'); + HPath:=TCmdStrListItem(HPath.Next); + end; + HPath:=TCmdStrListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + if LdSupportsNoResponseFile then + LinkRes.Add('-L'+HPath.Str) + else + LinkRes.Add('SEARCH_DIR('+maybequoted(HPath.Str)+')'); + HPath:=TCmdStrListItem(HPath.Next); + end; + + if (target_info.system in systems_darwin) then + begin + HPath:=TCmdStrListItem(current_module.localframeworksearchpath.First); + while assigned(HPath) do + begin + LinkRes.Add('-F'+HPath.Str); + HPath:=TCmdStrListItem(HPath.Next); + end; + HPath:=TCmdStrListItem(FrameworkSearchPath.First); + while assigned(HPath) do + begin + LinkRes.Add('-F'+HPath.Str); + HPath:=TCmdStrListItem(HPath.Next); + end; + end; + { force local symbol resolution (i.e., inside the shared } + { library itself) for all non-exorted symbols, otherwise } + { several RTL symbols of FPC-compiled shared libraries } + { will be bound to those of a single shared library or } + { to the main program } + if (isdll) and (target_info.system in systems_freebsd) then + begin + LinkRes.add('VERSION'); + LinkRes.add('{'); + LinkRes.add(' {'); + if not texportlibunix(exportlib).exportedsymnames.empty then + begin + LinkRes.add(' global:'); + repeat + LinkRes.add(' '+texportlibunix(exportlib).exportedsymnames.getfirst+';'); + until texportlibunix(exportlib).exportedsymnames.empty; + end; + LinkRes.add(' local:'); + LinkRes.add(' *;'); + LinkRes.add(' };'); + LinkRes.add('}'); + end; + + if not LdSupportsNoResponseFile then + LinkRes.Add('INPUT('); + { add objectfiles, start with prt0 always } + if prtobj<>'' then + LinkRes.AddFileName(FindObjectFile(prtobj,'',false)); + { try to add crti and crtbegin if linking to C } + if linklibc and + not IsDarwin Then + begin + if librarysearchpath.FindFile('crtbegin.o',false,s) then + LinkRes.AddFileName(s); + if librarysearchpath.FindFile('crti.o',false,s) then + LinkRes.AddFileName(s); + end; + { main objectfiles } + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + if LdSupportsNoResponseFile then + LinkRes.AddFileName(s) + else + LinkRes.AddFileName(maybequoted(s)); + end; + if not LdSupportsNoResponseFile then + LinkRes.Add(')'); + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + if not LdSupportsNoResponseFile then + LinkRes.Add('GROUP('); + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + if LdSupportsNoResponseFile then + LinkRes.AddFileName(s) + else + LinkRes.AddFileName(maybequoted(s)) + end; + if not LdSupportsNoResponseFile then + LinkRes.Add(')'); + end; + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + if not SharedLibFiles.Empty then + begin + if not LdSupportsNoResponseFile then + LinkRes.Add('INPUT('); + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if (s<>'c') or reorder then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + begin + linklibc:=true; + linkdynamic:=false; { libc will include the ld-* for us } + end; + end; + { be sure that libc is the last lib } + if linklibc and not reorder then + Begin + If LibrarySuffix=' ' Then + LinkRes.Add('-lc') + else + LinkRes.Add('-lc_'+LibrarySuffix); + If LibrarySuffix='r' Then + LinkRes.Add('-lc'); + end; + { when we have -static for the linker the we also need libgcc } + if (cs_link_staticflag in current_settings.globalswitches) then + LinkRes.Add('-lgcc'); + if linkdynamic and (Info.DynamicLinker<>'') then + LinkRes.AddFileName(Info.DynamicLinker); + if not LdSupportsNoResponseFile then + LinkRes.Add(')'); + end; + + { frameworks for Darwin } + if IsDarwin then + while not FrameworkFiles.empty do + begin + LinkRes.Add('-framework'); + LinkRes.Add(FrameworkFiles.GetFirst); + end; + + { objects which must be at the end } + if linklibc and + not IsDarwin Then + begin + Fl1:=librarysearchpath.FindFile('crtend.o',false,s1); + Fl2:=librarysearchpath.FindFile('crtn.o',false,s2); + if Fl1 or Fl2 then + begin + LinkRes.Add('INPUT('); + If Fl1 Then + LinkRes.AddFileName(s1); + If Fl2 Then + LinkRes.AddFileName(s2); + LinkRes.Add(')'); + end; + end; +{ Write and Close response } + linkres.writetodisk; + linkres.Free; + + WriteResponseFile:=True; +end; + + +function TLinkerBSD.MakeExecutable:boolean; +var + binstr, + cmdstr, + extdbgbinstr, + extdbgcmdstr: TCmdStr; + linkscript: TAsmScript; + DynLinkStr : string[60]; + GCSectionsStr, + StaticStr, + StripStr : string[63]; + success, + useshell : boolean; +begin + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + StaticStr:=''; + StripStr:=''; + DynLinkStr:=''; + GCSectionsStr:=''; + if (cs_link_staticflag in current_settings.globalswitches) then + begin + if (target_info.system=system_m68k_netbsd) and + ((cs_link_on_target in current_settings.globalswitches) or + (target_info.system=source_info.system)) then + StaticStr:='-Bstatic' + else + StaticStr:='-static'; + end; + if (cs_link_strip in current_settings.globalswitches) then + if (target_info.system in systems_darwin) then + StripStr:='-x' + else + StripStr:='-s'; + + if (cs_link_smart in current_settings.globalswitches) and + (tf_smartlink_sections in target_info.flags) then + if not(target_info.system in systems_darwin) then + GCSectionsStr:='--gc-sections' + else + GCSectionsStr:='-dead_strip -no_dead_strip_inits_and_terms'; + + if(not(target_info.system in systems_darwin) and + (cs_profile in current_settings.moduleswitches)) or + ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then + DynLinkStr:='-dynamic-linker='+Info.DynamicLinker; + + if CShared Then + begin + if not(target_info.system in systems_darwin) then + DynLinKStr:=DynLinkStr+' --shared' + else + DynLinKStr:=DynLinkStr+' -dynamic'; // one dash! + end; +{ Write used files and libraries } + WriteResponseFile(false); + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$CATRES',CatFileContent(outputexedir+Info.ResName)); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$GCSECTIONS',GCSectionsStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + if (target_info.system in systems_darwin) then + Replace(cmdstr,'$PRTOBJ',GetDarwinPrtobjName(false)); + BinStr:=FindUtil(utilsprefix+BinStr); + + { create dsym file? } + extdbgbinstr:=''; + extdbgcmdstr:=''; + if (target_info.system in systems_darwin) and + (target_dbg.id in [dbg_dwarf2,dbg_dwarf3]) and + (cs_link_separate_dbg_file in current_settings.globalswitches) then + begin + extdbgbinstr:=FindUtil(utilsprefix+'dsymutil'); + extdbgcmdstr:=maybequoted(current_module.exefilename^); + end; + + if (LdSupportsNoResponseFile) and + not(cs_link_nolink in current_settings.globalswitches) then + begin + { we have to use a script to use the IFS hack } + linkscript:=TAsmScriptUnix.create(outputexedir+'ppaslink'); + linkscript.AddLinkCommand(BinStr,CmdStr,''); + if (extdbgcmdstr<>'') then + linkscript.AddLinkCommand(extdbgbinstr,extdbgcmdstr,''); + linkscript.WriteToDisk; + BinStr:=linkscript.fn; + if not path_absolute(BinStr) then + BinStr:='./'+BinStr; + CmdStr:=''; + end; + + useshell:=not (tf_no_backquote_support in source_info.flags); + success:=DoExec(BinStr,CmdStr,true,LdSupportsNoResponseFile or useshell); + if (success and + (extdbgbinstr<>'') and + (cs_link_nolink in current_settings.globalswitches)) then + success:=DoExec(extdbgbinstr,extdbgcmdstr,false,LdSupportsNoResponseFile); + +{ Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + begin + DeleteFile(outputexedir+Info.ResName); + if LdSupportsNoResponseFile Then + begin + DeleteFile(linkscript.fn); + linkscript.free + end; + end; + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +Function TLinkerBSD.MakeSharedLibrary:boolean; +var + InitStr, + FiniStr, + SoNameStr : string[80]; + linkscript: TAsmScript; + binstr, + cmdstr, + extdbgbinstr, + extdbgcmdstr : TCmdStr; + GCSectionsStr : string[63]; + exportedsyms: text; + success : boolean; +begin + MakeSharedLibrary:=false; + GCSectionsStr:=''; + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.sharedlibfilename^); + +{ Write used files and libraries } + WriteResponseFile(true); + + if (cs_link_smart in current_settings.globalswitches) and + (tf_smartlink_sections in target_info.flags) then + if not(target_info.system in systems_darwin) then + { disabled because not tested + GCSectionsStr:='--gc-sections' } + else + GCSectionsStr:='-dead_strip -no_dead_strip_inits_and_terms'; + + InitStr:='-init FPC_LIB_START'; + FiniStr:='-fini FPC_LIB_EXIT'; + SoNameStr:='-soname '+ExtractFileName(current_module.sharedlibfilename^); + +{ Call linker } + SplitBinCmd(Info.DllCmd[1],binstr,cmdstr); +{$ifndef darwin} + Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^)); +{$else darwin} + Replace(cmdstr,'$EXE',maybequoted(ExpandFileName(current_module.sharedlibfilename^))); +{$endif darwin} + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$CATRES',CatFileContent(outputexedir+Info.ResName)); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$INIT',InitStr); + Replace(cmdstr,'$FINI',FiniStr); + Replace(cmdstr,'$GCSECTIONS',GCSectionsStr); + Replace(cmdstr,'$SONAME',SoNameStr); + if (target_info.system in systems_darwin) then + Replace(cmdstr,'$PRTOBJ',GetDarwinPrtobjName(true)); + BinStr:=FindUtil(utilsprefix+BinStr); + + { create dsym file? } + extdbgbinstr:=''; + extdbgcmdstr:=''; + if (target_info.system in systems_darwin) and + (target_dbg.id in [dbg_dwarf2,dbg_dwarf3]) and + (cs_link_separate_dbg_file in current_settings.globalswitches) then + begin + extdbgbinstr:=FindUtil(utilsprefix+'dsymutil'); + extdbgcmdstr:=maybequoted(current_module.sharedlibfilename^); + end; + + if (target_info.system in systems_darwin) then + begin + { exported symbols for darwin } + if not texportlibunix(exportlib).exportedsymnames.empty then + begin + assign(exportedsyms,outputexedir+'linksyms.fpc'); + rewrite(exportedsyms); + repeat + writeln(exportedsyms,texportlibunix(exportlib).exportedsymnames.getfirst); + until texportlibunix(exportlib).exportedsymnames.empty; + close(exportedsyms); + cmdstr:=cmdstr+' -exported_symbols_list '+maybequoted(outputexedir)+'linksyms.fpc'; + end; + end; + + if (LdSupportsNoResponseFile) and + not(cs_link_nolink in current_settings.globalswitches) then + begin + { we have to use a script to use the IFS hack } + linkscript:=TAsmScriptUnix.create(outputexedir+'ppaslink'); + linkscript.AddLinkCommand(BinStr,CmdStr,''); + if (extdbgbinstr<>'') then + linkscript.AddLinkCommand(extdbgbinstr,extdbgcmdstr,''); + linkscript.WriteToDisk; + BinStr:=linkscript.fn; + if not path_absolute(BinStr) then + BinStr:='./'+BinStr; + CmdStr:=''; + end; + + success:=DoExec(BinStr,cmdstr,true,LdSupportsNoResponseFile); + if (success and + (extdbgbinstr<>'') and + (cs_link_nolink in current_settings.globalswitches)) then + success:=DoExec(extdbgbinstr,extdbgcmdstr,false,LdSupportsNoResponseFile); + +{ Strip the library ? } + if success and (cs_link_strip in current_settings.globalswitches) then + begin + SplitBinCmd(Info.DllCmd[2],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^)); + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,false,false); + end; + +{ Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + begin + DeleteFile(outputexedir+Info.ResName); + if LdSupportsNoResponseFile Then + begin + DeleteFile(linkscript.fn); + linkscript.free + end; + if (target_info.system in systems_darwin) then + DeleteFile(outputexedir+'linksyms.fpc'); + end; + + MakeSharedLibrary:=success; { otherwise a recursive call to link method } +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef x86_64} + RegisterExternalLinker(system_x86_64_FreeBSD_info,TLinkerBSD); + RegisterImport(system_x86_64_freebsd,timportlibbsd); + RegisterExport(system_x86_64_freebsd,texportlibbsd); + RegisterTarget(system_x86_64_freebsd_info); + + RegisterExternalLinker(system_x86_64_darwin_info,TLinkerBSD); + RegisterImport(system_x86_64_darwin,timportlibdarwin); + RegisterExport(system_x86_64_darwin,texportlibdarwin); + RegisterTarget(system_x86_64_darwin_info); +{$endif} +{$ifdef i386} + RegisterExternalLinker(system_i386_FreeBSD_info,TLinkerBSD); + RegisterExternalLinker(system_i386_NetBSD_info,TLinkerBSD); + RegisterExternalLinker(system_i386_OpenBSD_info,TLinkerBSD); + RegisterImport(system_i386_freebsd,timportlibbsd); + RegisterExport(system_i386_freebsd,texportlibbsd); + RegisterTarget(system_i386_freebsd_info); + RegisterImport(system_i386_netbsd,timportlibbsd); + RegisterExport(system_i386_netbsd,texportlibbsd); + RegisterTarget(system_i386_netbsd_info); + RegisterImport(system_i386_openbsd,timportlibbsd); + RegisterExport(system_i386_openbsd,texportlibbsd); + RegisterTarget(system_i386_openbsd_info); + RegisterExternalLinker(system_i386_darwin_info,TLinkerBSD); + RegisterImport(system_i386_darwin,timportlibdarwin); + RegisterExport(system_i386_darwin,texportlibdarwin); + RegisterTarget(system_i386_darwin_info); + RegisterExternalLinker(system_i386_iphonesim_info,TLinkerBSD); + RegisterImport(system_i386_iphonesim,timportlibdarwin); + RegisterExport(system_i386_iphonesim,texportlibdarwin); + RegisterTarget(system_i386_iphonesim_info); +{$endif i386} +{$ifdef m68k} +// RegisterExternalLinker(system_m68k_FreeBSD_info,TLinkerBSD); + RegisterExternalLinker(system_m68k_NetBSD_info,TLinkerBSD); + RegisterImport(system_m68k_netbsd,timportlibbsd); + RegisterExport(system_m68k_netbsd,texportlibbsd); + RegisterTarget(system_m68k_netbsd_info); +{$endif m68k} +{$ifdef powerpc} +// RegisterExternalLinker(system_m68k_FreeBSD_info,TLinkerBSD); + RegisterExternalLinker(system_powerpc_darwin_info,TLinkerBSD); + RegisterImport(system_powerpc_darwin,timportlibdarwin); + RegisterExport(system_powerpc_darwin,texportlibdarwin); + RegisterTarget(system_powerpc_darwin_info); + + RegisterExternalLinker(system_powerpc_netbsd_info,TLinkerBSD); + RegisterImport(system_powerpc_netbsd,timportlibbsd); + RegisterExport(system_powerpc_netbsd,texportlibbsd); + RegisterTarget(system_powerpc_netbsd_info); +{$endif powerpc} +{$ifdef powerpc64} + RegisterExternalLinker(system_powerpc64_darwin_info,TLinkerBSD); + RegisterImport(system_powerpc64_darwin,timportlibdarwin); + RegisterExport(system_powerpc64_darwin,texportlibdarwin); + RegisterTarget(system_powerpc64_darwin_info); +{$endif powerpc64} +{$ifdef arm} + RegisterExternalLinker(system_arm_darwin_info,TLinkerBSD); + RegisterImport(system_arm_darwin,timportlibdarwin); + RegisterExport(system_arm_darwin,texportlibdarwin); + RegisterTarget(system_arm_darwin_info); +{$endif arm} + + RegisterRes(res_elf_info,TWinLikeResourceFile); + RegisterRes(res_macho_info,TWinLikeResourceFile); +end. diff --git a/closures/compiler/systems/t_embed.pas b/closures/compiler/systems/t_embed.pas new file mode 100644 index 0000000000..30c79df7ad --- /dev/null +++ b/closures/compiler/systems/t_embed.pas @@ -0,0 +1,910 @@ +{ + This unit implements support import,export,link routines + for the (arm) GameBoy Advance target + + Copyright (c) 2001-2002 by Peter Vreman + + 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 t_embed; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + SysUtils, + cutils,cfileutl,cclasses, + globtype,globals,systems,verbose,comphook,script,fmodule,i_embed,link, + cpuinfo; + + type + TlinkerEmbedded=class(texternallinker) + private + Function WriteResponseFile: Boolean; + public + constructor Create; override; + procedure SetDefaultInfo; override; + function MakeExecutable:boolean; override; + function postprocessexecutable(const fn : string;isdll:boolean):boolean; + end; + + + +{***************************************************************************** + TlinkerEmbedded +*****************************************************************************} + +Constructor TlinkerEmbedded.Create; +begin + Inherited Create; + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; +end; + + +procedure TlinkerEmbedded.SetDefaultInfo; +begin + with Info do + begin + ExeCmd[1]:='ld -g $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE -T $RES'; + end; +end; + + +Function TlinkerEmbedded.WriteResponseFile: Boolean; +Var + linkres : TLinkRes; + i : longint; + HPath : TCmdStrListItem; + s,s1,s2 : TCmdStr; + prtobj, + cprtobj : string[80]; + linklibc : boolean; + found1, + found2 : boolean; +{$ifdef ARM} + LinkStr : string; +{$endif} +begin + WriteResponseFile:=False; + linklibc:=(SharedLibFiles.Find('c')<>nil); +{$if defined(ARM) or defined(i386) or defined(AVR)} + prtobj:=''; +{$else} + prtobj:='prt0'; +{$endif} + cprtobj:='cprt0'; + if linklibc then + prtobj:=cprtobj; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + s:=HPath.Str; + if (cs_link_on_target in current_settings.globalswitches) then + s:=ScriptFixFileName(s); + LinkRes.Add('-L'+s); + HPath:=TCmdStrListItem(HPath.Next); + end; + HPath:=TCmdStrListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + s:=HPath.Str; + if s<>'' then + LinkRes.Add('SEARCH_DIR('+(maybequoted(s))+')'); + HPath:=TCmdStrListItem(HPath.Next); + end; + + LinkRes.Add('INPUT ('); + { add objectfiles, start with prt0 always } + //s:=FindObjectFile('prt0','',false); + if prtobj<>'' then + begin + s:=FindObjectFile(prtobj,'',false); + LinkRes.AddFileName(s); + end; + { try to add crti and crtbegin if linking to C } + if linklibc then + begin + if librarysearchpath.FindFile('crtbegin.o',false,s) then + LinkRes.AddFileName(s); + if librarysearchpath.FindFile('crti.o',false,s) then + LinkRes.AddFileName(s); + end; + + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + begin + { vlink doesn't use SEARCH_DIR for object files } + if not(cs_link_on_target in current_settings.globalswitches) then + s:=FindObjectFile(s,'',false); + LinkRes.AddFileName((maybequoted(s))); + end; + end; + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + { vlink doesn't need, and doesn't support GROUP } + if (cs_link_on_target in current_settings.globalswitches) then + begin + LinkRes.Add(')'); + LinkRes.Add('GROUP('); + end; + while not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName((maybequoted(s))); + end; + end; + + if (cs_link_on_target in current_settings.globalswitches) then + begin + LinkRes.Add(')'); + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + linklibc:=false; + while not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + begin + LinkRes.Add('-l'+s); + linklibc:=true; + end; + end; + { be sure that libc&libgcc is the last lib } + if linklibc then + begin + LinkRes.Add('-lc'); + LinkRes.Add('-lgcc'); + end; + end + else + begin + while not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + LinkRes.Add('lib'+s+target_info.staticlibext); + end; + LinkRes.Add(')'); + end; + + { objects which must be at the end } + if linklibc then + begin + found1:=librarysearchpath.FindFile('crtend.o',false,s1); + found2:=librarysearchpath.FindFile('crtn.o',false,s2); + if found1 or found2 then + begin + LinkRes.Add('INPUT('); + if found1 then + LinkRes.AddFileName(s1); + if found2 then + LinkRes.AddFileName(s2); + LinkRes.Add(')'); + end; + end; + +{$ifdef ARM} + case current_settings.controllertype of + ct_none: + begin + end; + ct_lpc2114, + ct_lpc2124, + ct_lpc2194, + ct_lpc1768, + ct_at91sam7s256, + ct_at91sam7se256, + ct_at91sam7x256, + ct_at91sam7xc256, + + ct_stm32f103rb, + ct_stm32f103re, + ct_stm32f103c4t, + + { TI - 64 K Flash, 16 K SRAM Devices } + ct_lm3s1110, + ct_lm3s1133, + ct_lm3s1138, + ct_lm3s1150, + ct_lm3s1162, + ct_lm3s1165, + ct_lm3s1166, + ct_lm3s2110, + ct_lm3s2139, + ct_lm3s6100, + ct_lm3s6110, + + { TI 128 K Flash, 32 K SRAM devices - Fury Class } + ct_lm3s1601, + ct_lm3s1608, + ct_lm3s1620, + ct_lm3s1635, + ct_lm3s1636, + ct_lm3s1637, + ct_lm3s1651, + ct_lm3s2601, + ct_lm3s2608, + ct_lm3s2620, + ct_lm3s2637, + ct_lm3s2651, + ct_lm3s6610, + ct_lm3s6611, + ct_lm3s6618, + ct_lm3s6633, + ct_lm3s6637, + ct_lm3s8630, + + { TI 256 K Flase, 32 K SRAM devices - Fury Class } + ct_lm3s1911, + ct_lm3s1918, + ct_lm3s1937, + ct_lm3s1958, + ct_lm3s1960, + ct_lm3s1968, + ct_lm3s1969, + ct_lm3s2911, + ct_lm3s2918, + ct_lm3s2919, + ct_lm3s2939, + ct_lm3s2948, + ct_lm3s2950, + ct_lm3s2965, + ct_lm3s6911, + ct_lm3s6918, + ct_lm3s6938, + ct_lm3s6950, + ct_lm3s6952, + ct_lm3s6965, + ct_lm3s8930, + ct_lm3s8933, + ct_lm3s8938, + ct_lm3s8962, + ct_lm3s8970, + ct_lm3s8971, + + { TI - Tempest Tempest - 256 K Flash, 64 K SRAM } + ct_lm3s5951, + ct_lm3s5956, + ct_lm3s1b21, + ct_lm3s2b93, + ct_lm3s5b91, + ct_lm3s9b81, + ct_lm3s9b90, + ct_lm3s9b92, + ct_lm3s9b95, + ct_lm3s9b96, + ct_sc32442b, + ct_thumb2bare: + begin + with embedded_controllers[current_settings.controllertype] do + with linkres do + begin + Add('ENTRY(_START)'); + Add('MEMORY'); + Add('{'); + if flashsize<>0 then + begin + LinkStr := ' flash : ORIGIN = 0x' + IntToHex(flashbase,8) + + ', LENGTH = 0x' + IntToHex(flashsize,8); + Add(LinkStr); + end; + + LinkStr := ' ram : ORIGIN = 0x' + IntToHex(srambase,8) + + ', LENGTH = 0x' + IntToHex(sramsize,8); + Add(LinkStr); + + Add('}'); + Add('_stack_top = 0x' + IntToHex(sramsize+srambase,8) + ';'); + end; + end + else + if not (cs_link_nolink in current_settings.globalswitches) then + internalerror(200902011); + end; + + with linkres do + begin + Add('SECTIONS'); + Add('{'); + Add(' .text :'); + Add(' {'); + Add(' KEEP(*(.init, .init.*))'); + Add(' *(.text, .text.*)'); + Add(' *(.strings)'); + Add(' *(.rodata, .rodata.*)'); + Add(' *(.comment)'); + Add(' _etext = .;'); + if embedded_controllers[current_settings.controllertype].flashsize<>0 then + begin + Add(' } >flash'); + end + else + begin + Add(' } >ram'); + end; + Add(' .data :'); + Add(' {'); + Add(' _data = .;'); + Add(' *(.data, .data.*)'); + Add(' KEEP (*(.fpc .fpc.n_version .fpc.n_links))'); + Add(' _edata = .;'); + if embedded_controllers[current_settings.controllertype].flashsize<>0 then + begin + Add(' } >ram AT >flash'); + end + else + begin + Add(' } >ram'); + end; + Add(' .bss :'); + Add(' {'); + Add(' _bss_start = .;'); + Add(' *(.bss, .bss.*)'); + Add(' *(COMMON)'); + Add(' } >ram'); + Add('. = ALIGN(4);'); + Add('_bss_end = . ;'); + Add('}'); + Add('_end = .;'); + end; +{$endif ARM} + +{$ifdef i386} + with linkres do + begin + Add('ENTRY(_START)'); + Add('SECTIONS'); + Add('{'); + Add(' . = 0x100000;'); + Add(' .text ALIGN (0x1000) :'); + Add(' {'); + Add(' KEEP(*(.init, .init.*))'); + Add(' *(.text, .text.*)'); + Add(' *(.strings)'); + Add(' *(.rodata, .rodata.*)'); + Add(' *(.comment)'); + Add(' _etext = .;'); + Add(' }'); + Add(' .data ALIGN (0x1000) :'); + Add(' {'); + Add(' _data = .;'); + Add(' *(.data, .data.*)'); + Add(' KEEP (*(.fpc .fpc.n_version .fpc.n_links))'); + Add(' _edata = .;'); + Add(' }'); + Add(' . = ALIGN(4);'); + Add(' .bss :'); + Add(' {'); + Add(' _bss_start = .;'); + Add(' *(.bss, .bss.*)'); + Add(' *(COMMON)'); + Add(' }'); + Add('_bss_end = . ;'); + Add('}'); + Add('_end = .;'); + end; +{$endif i386} + +{$ifdef AVR} + with linkres do + begin + { linker script from ld 2.19 } + Add('ENTRY(_START)'); + Add('OUTPUT_FORMAT("elf32-avr","elf32-avr","elf32-avr")'); + Add('OUTPUT_ARCH(avr:2)'); + Add('MEMORY'); + Add('{'); + Add(' text (rx) : ORIGIN = 0, LENGTH = 8K'); + Add(' data (rw!x) : ORIGIN = 0x800060, LENGTH = 0xffa0'); + Add(' eeprom (rw!x) : ORIGIN = 0x810000, LENGTH = 64K'); + Add(' fuse (rw!x) : ORIGIN = 0x820000, LENGTH = 1K'); + Add(' lock (rw!x) : ORIGIN = 0x830000, LENGTH = 1K'); + Add(' signature (rw!x) : ORIGIN = 0x840000, LENGTH = 1K'); + Add('}'); + Add('SECTIONS'); + Add('{'); + Add(' /* Read-only sections, merged into text segment: */'); + Add(' .hash : { *(.hash) }'); + Add(' .dynsym : { *(.dynsym) }'); + Add(' .dynstr : { *(.dynstr) }'); + Add(' .gnu.version : { *(.gnu.version) }'); + Add(' .gnu.version_d : { *(.gnu.version_d) }'); + Add(' .gnu.version_r : { *(.gnu.version_r) }'); + Add(' .rel.init : { *(.rel.init) }'); + Add(' .rela.init : { *(.rela.init) }'); + Add(' .rel.text :'); + Add(' {'); + Add(' *(.rel.text)'); + Add(' *(.rel.text.*)'); + Add(' *(.rel.gnu.linkonce.t*)'); + Add(' }'); + Add(' .rela.text :'); + Add(' {'); + Add(' *(.rela.text)'); + Add(' *(.rela.text.*)'); + Add(' *(.rela.gnu.linkonce.t*)'); + Add(' }'); + Add(' .rel.fini : { *(.rel.fini) }'); + Add(' .rela.fini : { *(.rela.fini) }'); + Add(' .rel.rodata :'); + Add(' {'); + Add(' *(.rel.rodata)'); + Add(' *(.rel.rodata.*)'); + Add(' *(.rel.gnu.linkonce.r*)'); + Add(' }'); + Add(' .rela.rodata :'); + Add(' {'); + Add(' *(.rela.rodata)'); + Add(' *(.rela.rodata.*)'); + Add(' *(.rela.gnu.linkonce.r*)'); + Add(' }'); + Add(' .rel.data :'); + Add(' {'); + Add(' *(.rel.data)'); + Add(' *(.rel.data.*)'); + Add(' *(.rel.gnu.linkonce.d*)'); + Add(' }'); + Add(' .rela.data :'); + Add(' {'); + Add(' *(.rela.data)'); + Add(' *(.rela.data.*)'); + Add(' *(.rela.gnu.linkonce.d*)'); + Add(' }'); + Add(' .rel.ctors : { *(.rel.ctors) }'); + Add(' .rela.ctors : { *(.rela.ctors) }'); + Add(' .rel.dtors : { *(.rel.dtors) }'); + Add(' .rela.dtors : { *(.rela.dtors) }'); + Add(' .rel.got : { *(.rel.got) }'); + Add(' .rela.got : { *(.rela.got) }'); + Add(' .rel.bss : { *(.rel.bss) }'); + Add(' .rela.bss : { *(.rela.bss) }'); + Add(' .rel.plt : { *(.rel.plt) }'); + Add(' .rela.plt : { *(.rela.plt) }'); + Add(' /* Internal text space or external memory. */'); + Add(' .text :'); + Add(' {'); + Add(' *(.vectors)'); + Add(' KEEP(*(.vectors))'); + Add(' /* For data that needs to reside in the lower 64k of progmem. */'); + Add(' *(.progmem.gcc*)'); + Add(' *(.progmem*)'); + Add(' . = ALIGN(2);'); + Add(' __trampolines_start = . ;'); + Add(' /* The jump trampolines for the 16-bit limited relocs will reside here. */'); + Add(' *(.trampolines)'); + Add(' *(.trampolines*)'); + Add(' __trampolines_end = . ;'); + Add(' /* For future tablejump instruction arrays for 3 byte pc devices.'); + Add(' We don''t relax jump/call instructions within these sections. */'); + Add(' *(.jumptables)'); + Add(' *(.jumptables*)'); + Add(' /* For code that needs to reside in the lower 128k progmem. */'); + Add(' *(.lowtext)'); + Add(' *(.lowtext*)'); + Add(' __ctors_start = . ;'); + Add(' *(.ctors)'); + Add(' __ctors_end = . ;'); + Add(' __dtors_start = . ;'); + Add(' *(.dtors)'); + Add(' __dtors_end = . ;'); + Add(' KEEP(SORT(*)(.ctors))'); + Add(' KEEP(SORT(*)(.dtors))'); + Add(' /* From this point on, we don''t bother about wether the insns are'); + Add(' below or above the 16 bits boundary. */'); + Add(' *(.init0) /* Start here after reset. */'); + Add(' KEEP (*(.init0))'); + Add(' *(.init1)'); + Add(' KEEP (*(.init1))'); + Add(' *(.init2) /* Clear __zero_reg__, set up stack pointer. */'); + Add(' KEEP (*(.init2))'); + Add(' *(.init3)'); + Add(' KEEP (*(.init3))'); + Add(' *(.init4) /* Initialize data and BSS. */'); + Add(' KEEP (*(.init4))'); + Add(' *(.init5)'); + Add(' KEEP (*(.init5))'); + Add(' *(.init6) /* C++ constructors. */'); + Add(' KEEP (*(.init6))'); + Add(' *(.init7)'); + Add(' KEEP (*(.init7))'); + Add(' *(.init8)'); + Add(' KEEP (*(.init8))'); + Add(' *(.init9) /* Call main(). */'); + Add(' KEEP (*(.init9))'); + Add(' *(.text)'); + Add(' . = ALIGN(2);'); + Add(' *(.text.*)'); + Add(' . = ALIGN(2);'); + Add(' *(.fini9) /* _exit() starts here. */'); + Add(' KEEP (*(.fini9))'); + Add(' *(.fini8)'); + Add(' KEEP (*(.fini8))'); + Add(' *(.fini7)'); + Add(' KEEP (*(.fini7))'); + Add(' *(.fini6) /* C++ destructors. */'); + Add(' KEEP (*(.fini6))'); + Add(' *(.fini5)'); + Add(' KEEP (*(.fini5))'); + Add(' *(.fini4)'); + Add(' KEEP (*(.fini4))'); + Add(' *(.fini3)'); + Add(' KEEP (*(.fini3))'); + Add(' *(.fini2)'); + Add(' KEEP (*(.fini2))'); + Add(' *(.fini1)'); + Add(' KEEP (*(.fini1))'); + Add(' *(.fini0) /* Infinite loop after program termination. */'); + Add(' KEEP (*(.fini0))'); + Add(' _etext = . ;'); + Add(' } > text'); + Add(' .data : AT (ADDR (.text) + SIZEOF (.text))'); + Add(' {'); + Add(' PROVIDE (__data_start = .) ;'); + Add(' *(.data)'); + Add(' *(.data*)'); + Add(' *(.rodata) /* We need to include .rodata here if gcc is used */'); + Add(' *(.rodata*) /* with -fdata-sections. */'); + Add(' *(.gnu.linkonce.d*)'); + Add(' . = ALIGN(2);'); + Add(' _edata = . ;'); + Add(' PROVIDE (__data_end = .) ;'); + Add(' } > data'); + Add(' .bss : AT (ADDR (.bss))'); + Add(' {'); + Add(' PROVIDE (__bss_start = .) ;'); + Add(' *(.bss)'); + Add(' *(.bss*)'); + Add(' *(COMMON)'); + Add(' PROVIDE (__bss_end = .) ;'); + Add(' } > data'); + Add(' __data_load_start = LOADADDR(.data);'); + Add(' __data_load_end = __data_load_start + SIZEOF(.data);'); + Add(' /* Global data not cleared after reset. */'); + Add(' .noinit :'); + Add(' {'); + Add(' PROVIDE (__noinit_start = .) ;'); + Add(' *(.noinit*)'); + Add(' PROVIDE (__noinit_end = .) ;'); + Add(' _end = . ;'); + Add(' PROVIDE (__heap_start = .) ;'); + Add(' } > data'); + Add(' .eeprom :'); + Add(' {'); + Add(' *(.eeprom*)'); + Add(' __eeprom_end = . ;'); + Add(' } > eeprom'); + Add(' .fuse :'); + Add(' {'); + Add(' KEEP(*(.fuse))'); + Add(' KEEP(*(.lfuse))'); + Add(' KEEP(*(.hfuse))'); + Add(' KEEP(*(.efuse))'); + Add(' } > fuse'); + Add(' .lock :'); + Add(' {'); + Add(' KEEP(*(.lock*))'); + Add(' } > lock'); + Add(' .signature :'); + Add(' {'); + Add(' KEEP(*(.signature*))'); + Add(' } > signature'); + Add(' /* Stabs debugging sections. */'); + Add(' .stab 0 : { *(.stab) }'); + Add(' .stabstr 0 : { *(.stabstr) }'); + Add(' .stab.excl 0 : { *(.stab.excl) }'); + Add(' .stab.exclstr 0 : { *(.stab.exclstr) }'); + Add(' .stab.index 0 : { *(.stab.index) }'); + Add(' .stab.indexstr 0 : { *(.stab.indexstr) }'); + Add(' .comment 0 : { *(.comment) }'); + Add(' /* DWARF debug sections.'); + Add(' Symbols in the DWARF debugging sections are relative to the beginning'); + Add(' of the section so we begin them at 0. */'); + Add(' /* DWARF 1 */'); + Add(' .debug 0 : { *(.debug) }'); + Add(' .line 0 : { *(.line) }'); + Add(' /* GNU DWARF 1 extensions */'); + Add(' .debug_srcinfo 0 : { *(.debug_srcinfo) }'); + Add(' .debug_sfnames 0 : { *(.debug_sfnames) }'); + Add(' /* DWARF 1.1 and DWARF 2 */'); + Add(' .debug_aranges 0 : { *(.debug_aranges) }'); + Add(' .debug_pubnames 0 : { *(.debug_pubnames) }'); + Add(' /* DWARF 2 */'); + Add(' .debug_info 0 : { *(.debug_info) *(.gnu.linkonce.wi.*) }'); + Add(' .debug_abbrev 0 : { *(.debug_abbrev) }'); + Add(' .debug_line 0 : { *(.debug_line) }'); + Add(' .debug_frame 0 : { *(.debug_frame) }'); + Add(' .debug_str 0 : { *(.debug_str) }'); + Add(' .debug_loc 0 : { *(.debug_loc) }'); + Add(' .debug_macinfo 0 : { *(.debug_macinfo) }'); + Add('}'); + { last address of ram on an atmega128 } + Add('_stack_top = 0x0fff;'); + end; +{$endif AVR} + + { Write and Close response } + linkres.writetodisk; + linkres.free; + + WriteResponseFile:=True; + +end; + + +function TlinkerEmbedded.MakeExecutable:boolean; +var + binstr, + cmdstr : TCmdStr; + success : boolean; + StaticStr, + GCSectionsStr, + DynLinkStr, + StripStr: string; +begin + { for future use } + StaticStr:=''; + StripStr:=''; + DynLinkStr:=''; + + GCSectionsStr:='--gc-sections'; + //if not(cs_link_extern in current_settings.globalswitches) then + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Write used files and libraries } + WriteResponseFile(); + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + if not(cs_link_on_target in current_settings.globalswitches) then + begin + Replace(cmdstr,'$EXE',(maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename^,'.elf'))))); + Replace(cmdstr,'$RES',(maybequoted(ScriptFixFileName(outputexedir+Info.ResName)))); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$GCSECTIONS',GCSectionsStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + end + else + begin + Replace(cmdstr,'$EXE',maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename^,'.elf')))); + Replace(cmdstr,'$RES',maybequoted(ScriptFixFileName(outputexedir+Info.ResName))); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$GCSECTIONS',GCSectionsStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + end; + success:=DoExec(FindUtil(utilsprefix+BinStr),cmdstr,true,false); + +{ Remove ReponseFile } + if success and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + +{ Post process } + if success then + success:=PostProcessExecutable(current_module.exefilename^+'.elf',false); + + if success and (target_info.system in [system_arm_embedded,system_avr_embedded]) then + begin + success:=DoExec(FindUtil(utilsprefix+'objcopy'),'-O ihex '+ + ChangeFileExt(current_module.exefilename^,'.elf')+' '+ + ChangeFileExt(current_module.exefilename^,'.hex'),true,false); + end; + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +function TLinkerEmbedded.postprocessexecutable(const fn : string;isdll:boolean):boolean; + type + TElf32header=packed record + magic0123 : longint; + file_class : byte; + data_encoding : byte; + file_version : byte; + padding : array[$07..$0f] of byte; + + e_type : word; + e_machine : word; + e_version : longint; + e_entry : longint; { entrypoint } + e_phoff : longint; { program header offset } + + e_shoff : longint; { sections header offset } + e_flags : longint; + e_ehsize : word; { elf header size in bytes } + e_phentsize : word; { size of an entry in the program header array } + e_phnum : word; { 0..e_phnum-1 of entrys } + e_shentsize : word; { size of an entry in sections header array } + e_shnum : word; { 0..e_shnum-1 of entrys } + e_shstrndx : word; { index of string section header } + end; + TElf32sechdr=packed record + sh_name : longint; + sh_type : longint; + sh_flags : longint; + sh_addr : longint; + + sh_offset : longint; + sh_size : longint; + sh_link : longint; + sh_info : longint; + + sh_addralign : longint; + sh_entsize : longint; + end; + + function MayBeSwapHeader(h : telf32header) : telf32header; + begin + result:=h; + if source_info.endian<>target_info.endian then + with h do + begin + result.e_type:=swapendian(e_type); + result.e_machine:=swapendian(e_machine); + result.e_version:=swapendian(e_version); + result.e_entry:=swapendian(e_entry); + result.e_phoff:=swapendian(e_phoff); + result.e_shoff:=swapendian(e_shoff); + result.e_flags:=swapendian(e_flags); + result.e_ehsize:=swapendian(e_ehsize); + result.e_phentsize:=swapendian(e_phentsize); + result.e_phnum:=swapendian(e_phnum); + result.e_shentsize:=swapendian(e_shentsize); + result.e_shnum:=swapendian(e_shnum); + result.e_shstrndx:=swapendian(e_shstrndx); + end; + end; + + function MaybeSwapSecHeader(h : telf32sechdr) : telf32sechdr; + begin + result:=h; + if source_info.endian<>target_info.endian then + with h do + begin + result.sh_name:=swapendian(sh_name); + result.sh_type:=swapendian(sh_type); + result.sh_flags:=swapendian(sh_flags); + result.sh_addr:=swapendian(sh_addr); + result.sh_offset:=swapendian(sh_offset); + result.sh_size:=swapendian(sh_size); + result.sh_link:=swapendian(sh_link); + result.sh_info:=swapendian(sh_info); + result.sh_addralign:=swapendian(sh_addralign); + result.sh_entsize:=swapendian(sh_entsize); + end; + end; + + var + f : file; + + function ReadSectionName(pos : longint) : String; + var + oldpos : longint; + c : char; + begin + oldpos:=filepos(f); + seek(f,pos); + Result:=''; + while true do + begin + blockread(f,c,1); + if c=#0 then + break; + Result:=Result+c; + end; + seek(f,oldpos); + end; + + var + elfheader : TElf32header; + secheader : TElf32sechdr; + i : longint; + stringoffset : longint; + secname : string; + begin + postprocessexecutable:=false; + { open file } + assign(f,fn); + {$push}{$I-} + reset(f,1); + if ioresult<>0 then + Message1(execinfo_f_cant_open_executable,fn); + { read header } + blockread(f,elfheader,sizeof(tElf32header)); + elfheader:=MayBeSwapHeader(elfheader); + seek(f,elfheader.e_shoff); + { read string section header } + seek(f,elfheader.e_shoff+sizeof(TElf32sechdr)*elfheader.e_shstrndx); + blockread(f,secheader,sizeof(secheader)); + secheader:=MaybeSwapSecHeader(secheader); + stringoffset:=secheader.sh_offset; + + seek(f,elfheader.e_shoff); + status.datasize:=0; + for i:=0 to elfheader.e_shnum-1 do + begin + blockread(f,secheader,sizeof(secheader)); + secheader:=MaybeSwapSecHeader(secheader); + secname:=ReadSectionName(stringoffset+secheader.sh_name); + if secname='.text' then + begin + Message1(execinfo_x_codesize,tostr(secheader.sh_size)); + status.codesize:=secheader.sh_size; + end + else if secname='.data' then + begin + Message1(execinfo_x_initdatasize,tostr(secheader.sh_size)); + inc(status.datasize,secheader.sh_size); + end + else if secname='.bss' then + begin + Message1(execinfo_x_uninitdatasize,tostr(secheader.sh_size)); + inc(status.datasize,secheader.sh_size); + end; + + end; + close(f); + {$pop} + if ioresult<>0 then + ; + postprocessexecutable:=true; + end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef arm} + RegisterExternalLinker(system_arm_embedded_info,TlinkerEmbedded); + RegisterTarget(system_arm_embedded_info); +{$endif arm} + +{$ifdef avr} + RegisterExternalLinker(system_avr_embedded_info,TlinkerEmbedded); + RegisterTarget(system_avr_embedded_info); +{$endif avr} + +{$ifdef i386} + RegisterExternalLinker(system_i386_embedded_info,TlinkerEmbedded); + RegisterTarget(system_i386_embedded_info); +{$endif i386} +end. diff --git a/closures/compiler/systems/t_emx.pas b/closures/compiler/systems/t_emx.pas new file mode 100644 index 0000000000..3ea0c134b9 --- /dev/null +++ b/closures/compiler/systems/t_emx.pas @@ -0,0 +1,531 @@ +{ + Copyright (c) 1998-2002 by Daniel Mantione + Portions Copyright (c) 1998-2002 Eberhard Mattes + + Unit to write out import libraries and def files for OS/2 via EMX + + 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. + + **************************************************************************** +} +{ + A lot of code in this unit has been ported from C to Pascal from the + emximp utility, part of the EMX development system. Emximp is copyrighted + by Eberhard Mattes. Note: Eberhard doesn't know much about the Pascal + port, please send questions to Tomas Hajny <hajny@freepascal.org> or + Daniel Mantione <daniel@freepascal.org>. +} +unit t_emx; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + sysutils, + cutils,cfileutl,cclasses, + globtype,comphook,systems,symconst,symsym,symdef, + globals,verbose,fmodule,script,ogbase, + comprsrc,import,link,i_emx,ppu; + + type + TImportLibEMX=class(timportlib) + + procedure generatelib;override; + end; + + TLinkerEMX=class(texternallinker) + private + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + end; + + +const profile_flag:boolean=false; + +const n_ext = 1; + n_abs = 2; + n_text = 4; + n_data = 6; + n_bss = 8; + n_imp1 = $68; + n_imp2 = $6a; + +type reloc=packed record {This is the layout of a relocation table + entry.} + address:longint; {Fixup location} + remaining:longint; + {Meaning of bits for remaining: + 0..23: Symbol number or segment + 24: Self-relative fixup if non-zero + 25..26: Fixup size (0: 1 byte, 1: 2, 2: 4 bytes) + 27: Reference to symbol or segment + 28..31 Not used} + end; + + nlist=packed record {This is the layout of a symbol table entry.} + strofs:longint; {Offset in string table} + typ:byte; {Type of the symbol} + other:byte; {Other information} + desc:word; {More information} + value:longint; {Value (address)} + end; + + a_out_header=packed record + magic:word; {Magic word, must be $0107} + machtype:byte; {Machine type} + flags:byte; {Flags} + text_size:longint; {Length of text, in bytes} + data_size:longint; {Length of initialized data, in bytes} + bss_size:longint; {Length of uninitialized data, in bytes} + sym_size:longint; {Length of symbol table, in bytes} + entry:longint; {Start address (entry point)} + trsize:longint; {Length of relocation info for text, bytes} + drsize:longint; {Length of relocation info for data, bytes} + end; + + ar_hdr=packed record + ar_name:array[0..15] of char; + ar_date:array[0..11] of char; + ar_uid:array[0..5] of char; + ar_gid:array[0..5] of char; + ar_mode:array[0..7] of char; + ar_size:array[0..9] of char; + ar_fmag:array[0..1] of char; + end; + +var aout_str_size:longint; + aout_str_tab:array[0..2047] of char; + aout_sym_count:longint; + aout_sym_tab:array[0..5] of nlist; + + aout_text:array[0..63] of byte; + aout_text_size:longint; + + aout_treloc_tab:array[0..1] of reloc; + aout_treloc_count:longint; + + aout_size:longint; + seq_no:longint; + + ar_member_size:longint; + + out_file:file; + + +procedure PackTime (var T: TSystemTime; var P: longint); + +var zs:longint; + +begin + p:=-1980; + p:=p+t.year and 127; + p:=p shl 4; + p:=p+t.month; + p:=p shl 5; + p:=p+t.day; + p:=p shl 16; + zs:=t.hour; + zs:=zs shl 6; + zs:=zs+t.minute; + zs:=zs shl 5; + zs:=zs+t.second div 2; + p:=p+(zs and $ffff); +end; + + +procedure write_ar(const name:string;size:longint); + +var ar:ar_hdr; {PackTime is platform independent} + time:TSystemTime; + numtime:longint; + tmp:string[19]; +begin + ar_member_size:=size; + fillchar(ar.ar_name,sizeof(ar.ar_name),' '); + move(name[1],ar.ar_name,length(name)); + GetLocalTime(time); + packtime(time,numtime); + str(numtime,tmp); + fillchar(ar.ar_date,sizeof(ar.ar_date),' '); + move(tmp[1],ar.ar_date,length(tmp)); + ar.ar_uid:='0 '; + ar.ar_gid:='0 '; + ar.ar_mode:='100666'#0#0; + str(size,tmp); + fillchar(ar.ar_size,sizeof(ar.ar_size),' '); + move(tmp[1],ar.ar_size,length(tmp)); + ar.ar_fmag:='`'#10; + blockwrite(out_file,ar,sizeof(ar)); +end; + +procedure finish_ar; + +var a:byte; + +begin + a:=0; + if odd(ar_member_size) then + blockwrite(out_file,a,1); +end; + +procedure aout_init; + +begin + aout_str_size:=sizeof(longint); + aout_sym_count:=0; + aout_text_size:=0; + aout_treloc_count:=0; +end; + +function aout_sym(const name:string;typ,other:byte;desc:word; + value:longint):longint; + +begin + if aout_str_size+length(name)+1>sizeof(aout_str_tab) then + internalerror(200504241); + if aout_sym_count>=sizeof(aout_sym_tab) div sizeof(aout_sym_tab[0]) then + internalerror(200504242); + aout_sym_tab[aout_sym_count].strofs:=aout_str_size; + aout_sym_tab[aout_sym_count].typ:=typ; + aout_sym_tab[aout_sym_count].other:=other; + aout_sym_tab[aout_sym_count].desc:=desc; + aout_sym_tab[aout_sym_count].value:=value; + strPcopy(@aout_str_tab[aout_str_size],name); + aout_str_size:=aout_str_size+length(name)+1; + aout_sym:=aout_sym_count; + inc(aout_sym_count); +end; + +procedure aout_text_byte(b:byte); + +begin + if aout_text_size>=sizeof(aout_text) then + internalerror(200504243); + aout_text[aout_text_size]:=b; + inc(aout_text_size); +end; + +procedure aout_text_dword(d:longint); + +type li_ar=array[0..3] of byte; + +begin + aout_text_byte(li_ar(d)[0]); + aout_text_byte(li_ar(d)[1]); + aout_text_byte(li_ar(d)[2]); + aout_text_byte(li_ar(d)[3]); +end; + +procedure aout_treloc(address,symbolnum,pcrel,len,ext:longint); + +begin + if aout_treloc_count>=sizeof(aout_treloc_tab) div sizeof(reloc) then + internalerror(200504244); + aout_treloc_tab[aout_treloc_count].address:=address; + aout_treloc_tab[aout_treloc_count].remaining:=symbolnum+pcrel shl 24+ + len shl 25+ext shl 27; + inc(aout_treloc_count); +end; + +procedure aout_finish; + +begin + while (aout_text_size and 3)<>0 do + aout_text_byte ($90); + aout_size:=sizeof(a_out_header)+aout_text_size+aout_treloc_count* + sizeof(reloc)+aout_sym_count*sizeof(aout_sym_tab[0])+aout_str_size; +end; + +procedure aout_write; + +var ao:a_out_header; + +begin + ao.magic:=$0107; + ao.machtype:=0; + ao.flags:=0; + ao.text_size:=aout_text_size; + ao.data_size:=0; + ao.bss_size:=0; + ao.sym_size:=aout_sym_count*sizeof(aout_sym_tab[0]); + ao.entry:=0; + ao.trsize:=aout_treloc_count*sizeof(reloc); + ao.drsize:=0; + blockwrite(out_file,ao,sizeof(ao)); + blockwrite(out_file,aout_text,aout_text_size); + blockwrite(out_file,aout_treloc_tab,sizeof(reloc)*aout_treloc_count); + blockwrite(out_file,aout_sym_tab,sizeof(aout_sym_tab[0])*aout_sym_count); + plongint(@aout_str_tab)^:=aout_str_size; + blockwrite(out_file,aout_str_tab,aout_str_size); +end; + + +procedure AddImport(const module:string;index:longint;const name,mangledname:string); +{func = Name of function to import. + module = Name of DLL to import from. + index = Index of function in DLL. Use 0 to import by name. + name = Name of function in DLL. Ignored when index=0;} +var tmp1,tmp2,tmp3:string; + sym_mcount,sym_import:longint; + fixup_mcount,fixup_import:longint; + func : string; +begin + aout_init; + func:=mangledname; + tmp2:=func; + if profile_flag and not (copy(func,1,4)='_16_') then + begin + {sym_entry:=aout_sym(func,n_text+n_ext,0,0,aout_text_size);} + sym_mcount:=aout_sym('__mcount',n_ext,0,0,0); + {Use, say, "_$U_DosRead" for "DosRead" to import the + non-profiled function.} + tmp2:='__$U_'+func; + sym_import:=aout_sym(tmp2,n_ext,0,0,0); + aout_text_byte($55); {push ebp} + aout_text_byte($89); {mov ebp, esp} + aout_text_byte($e5); + aout_text_byte($e8); {call _mcount} + fixup_mcount:=aout_text_size; + aout_text_dword(0-(aout_text_size+4)); + aout_text_byte($5d); {pop ebp} + aout_text_byte($e9); {jmp _$U_DosRead} + fixup_import:=aout_text_size; + aout_text_dword(0-(aout_text_size+4)); + + aout_treloc(fixup_mcount,sym_mcount,1,2,1); + aout_treloc (fixup_import, sym_import,1,2,1); + end; + str(seq_no,tmp1); + tmp1:='IMPORT#'+tmp1; + if name='' then + begin + str(index,tmp3); + tmp3:=func+'='+module+'.'+tmp3; + end + else + tmp3:=func+'='+module+'.'+name; + aout_sym(tmp2,n_imp1+n_ext,0,0,0); + aout_sym(tmp3,n_imp2+n_ext,0,0,0); + aout_finish; + write_ar(tmp1,aout_size); + aout_write; + finish_ar; + inc(seq_no); +end; + + procedure TImportLibEMX.GenerateLib; + const + ar_magic:array[1..8] of char='!<arch>'#10; + var + libname : string; + i,j : longint; + ImportLibrary : TImportLibrary; + ImportSymbol : TImportSymbol; + begin + for i:=0 to current_module.ImportLibraryList.Count-1 do + begin + ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]); + LibName:=FixFileName(ImportLibrary.Name + Target_Info.StaticCLibExt); + seq_no:=1; + current_module.linkotherstaticlibs.add(libname,link_always); + assign(out_file,current_module.outputpath^+libname); + rewrite(out_file,1); + blockwrite(out_file,ar_magic,sizeof(ar_magic)); + for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do + begin + ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]); + AddImport(ImportLibrary.Name,ImportSymbol.OrdNr, + ImportSymbol.Name,ImportSymbol.MangledName); + end; + close(out_file); + end; + end; + + +{**************************************************************************** + TLinkerEMX +****************************************************************************} + +Constructor TLinkerEMX.Create; +begin + Inherited Create; + { allow duplicated libs (PM) } + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; +end; + + +procedure TLinkerEMX.SetDefaultInfo; +begin + with Info do + begin + ExeCmd[1]:='ld $OPT -o $OUT @$RES'; + ExeCmd[2]:='emxbind -b $STRIP $APPTYPE $RSRC -k$STACKKB -h$HEAPMB -o $EXE $OUT -aim -s$DOSHEAPKB'; + if source_info.script = script_dos then + ExeCmd[3]:='del $OUT'; + end; +end; + + +Function TLinkerEMX.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + i : longint; + HPath : TCmdStrListItem; + s : string; +begin + WriteResponseFile:=False; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + LinkRes.Add('-L'+HPath.Str); + HPath:=TCmdStrListItem(HPath.Next); + end; + HPath:=TCmdStrListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + LinkRes.Add('-L'+HPath.Str); + HPath:=TCmdStrListItem(HPath.Next); + end; + + { add objectfiles, start with prt0 always } + LinkRes.AddFileName(FindObjectFile('prt0','',false)); + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + LinkRes.AddFileName(s); + end; + + { Write staticlibraries } + { No group !! This will not work correctly PM } + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(s) + end; + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end; + +{ Write and Close response } + linkres.writetodisk; + LinkRes.Free; + + WriteResponseFile:=True; +end; + + +function TLinkerEMX.MakeExecutable:boolean; +var + binstr, + cmdstr : TCmdStr; + success : boolean; + i : longint; + AppTypeStr, + StripStr: string[40]; + RsrcStr : string; + OutName: string; +begin + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + OutName := ChangeFileExt(current_module.exefilename^,'.out'); + if (cs_link_strip in current_settings.globalswitches) then + StripStr := '-s' + else + StripStr := ''; + if (usewindowapi) or (AppType = app_gui) then + AppTypeStr := '-p' + else if AppType = app_fs then + AppTypeStr := '-f' + else AppTypeStr := '-w'; + if not (Current_module.ResourceFiles.Empty) then + RsrcStr := '-r ' + Current_module.ResourceFiles.GetFirst + else + RsrcStr := ''; +(* Only one resource file supported, discard everything else + (should be already empty anyway, though). *) + Current_module.ResourceFiles.Clear; +{ Write used files and libraries } + WriteResponseFile(false); + +{ Call linker } + success:=false; + for i:=1 to 3 do + begin + SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr); + if binstr<>'' then + begin + { Is this really required? Not anymore according to my EMX docs } + Replace(cmdstr,'$HEAPMB',tostr((1048575) shr 20)); + {Size of the stack when an EMX program runs in OS/2.} + Replace(cmdstr,'$STACKKB',tostr((stacksize+1023) shr 10)); + {When an EMX program runs in DOS, the heap and stack share the + same memory pool. The heap grows upwards, the stack grows downwards.} + Replace(cmdstr,'$DOSHEAPKB',tostr((stacksize+1023) shr 10)); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$APPTYPE',AppTypeStr); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RSRC',RsrcStr); + Replace(cmdstr,'$OUT',maybequoted(OutName)); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + if i<>3 then + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,(i=1),false) + else + success:=DoExec(binstr,cmdstr,(i=1),true); + end; + end; + +{ Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterExternalLinker(system_i386_emx_info,TLinkerEMX); + RegisterImport(system_i386_emx,TImportLibEMX); + RegisterRes(res_wrc_os2_info,TResourceFile); + RegisterTarget(system_i386_emx_info); +end. diff --git a/closures/compiler/systems/t_gba.pas b/closures/compiler/systems/t_gba.pas new file mode 100644 index 0000000000..390a8ecab4 --- /dev/null +++ b/closures/compiler/systems/t_gba.pas @@ -0,0 +1,632 @@ +{ + This unit implements support import,export,link routines + for the (arm) GameBoy Advance target + + Copyright (c) 2001-2002 by Peter Vreman + + 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 t_gba; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + aasmbase, + SysUtils, + cutils,cfileutl,cclasses, + globtype,globals,systems,verbose,script,fmodule,i_gba,link; + + type + TlinkerGBA=class(texternallinker) + private + Function WriteResponseFile: Boolean; + public + constructor Create; override; + procedure SetDefaultInfo; override; + function MakeExecutable:boolean; override; + end; + + + +{***************************************************************************** + TLINKERGBA +*****************************************************************************} + +Constructor TLinkerGba.Create; +begin + Inherited Create; + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; +end; + + +procedure TLinkerGba.SetDefaultInfo; +begin + with Info do + begin + ExeCmd[1]:='ld -g $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE -T $RES'; + end; +end; + + +Function TLinkerGba.WriteResponseFile: Boolean; +Var + linkres : TLinkRes; + i : longint; + HPath : TCmdStrListItem; + s,s1,s2 : TCmdStr; + prtobj, + cprtobj : string[80]; + linklibc, + linklibgcc : boolean; + found1, + found2 : boolean; +begin + WriteResponseFile:=False; + linklibc:=(SharedLibFiles.Find('c')<>nil); + linklibgcc:=(SharedLibFiles.Find('gcc')<>nil); + prtobj:='prt0'; + cprtobj:='cprt0'; + if (linklibc or linklibgcc) then + prtobj:=cprtobj; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + s:=HPath.Str; + if (cs_link_on_target in current_settings.globalswitches) then + s:=ScriptFixFileName(s); + LinkRes.Add('-L'+s); + HPath:=TCmdStrListItem(HPath.Next); + end; + HPath:=TCmdStrListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + s:=HPath.Str; + if s<>'' then + LinkRes.Add('SEARCH_DIR('+(maybequoted(s))+')'); + HPath:=TCmdStrListItem(HPath.Next); + end; + + LinkRes.Add('INPUT ('); + { add objectfiles, start with prt0 always } + //s:=FindObjectFile('prt0','',false); + if prtobj<>'' then + s:=FindObjectFile(prtobj,'',false); + LinkRes.AddFileName(s); + { try to add crti and crtbegin if linking to C } + if linklibc then + begin + if librarysearchpath.FindFile('crti.o',false,s) then + LinkRes.AddFileName(s); + end; + if linklibgcc then + begin + if librarysearchpath.FindFile('crtbegin.o',false,s) then + LinkRes.AddFileName(s); + end; + + + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + begin + { vlink doesn't use SEARCH_DIR for object files } + if not(cs_link_on_target in current_settings.globalswitches) then + s:=FindObjectFile(s,'',false); + LinkRes.AddFileName((maybequoted(s))); + end; + end; + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + { vlink doesn't need, and doesn't support GROUP } + if (cs_link_on_target in current_settings.globalswitches) then + begin + LinkRes.Add(')'); + LinkRes.Add('GROUP('); + end; + while not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName((maybequoted(s))); + end; + end; + + if (cs_link_on_target in current_settings.globalswitches) then + begin + LinkRes.Add(')'); + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + linklibc:=false; + linklibgcc:=false; + while not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + begin + LinkRes.Add('-l'+s); + linklibc:=true; + linklibgcc:=true; + end; + end; + { be sure that libc&libgcc is the last lib } + if linklibgcc then + begin + LinkRes.Add('-lgcc'); + end; + if linklibc then + begin + LinkRes.Add('-lc'); + end; + + end + else + begin + while not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + LinkRes.Add('lib'+s+target_info.staticlibext); + end; + LinkRes.Add(')'); + end; + + { objects which must be at the end } + if linklibgcc then + begin + found1:=librarysearchpath.FindFile('crtend.o',false,s1); + if found1 then + begin + LinkRes.Add('INPUT('); + if found1 then + LinkRes.AddFileName(s1); + LinkRes.Add(')'); + end; + end; + if linklibc then + begin + found2:=librarysearchpath.FindFile('crtn.o',false,s2); + if found2 then + begin + LinkRes.Add('INPUT('); + if found2 then + LinkRes.AddFileName(s2); + LinkRes.Add(')'); + end; + end; + + with linkres do + begin + add('/* Linker Script Original v1.3 by Jeff Frohwein */'); + add('/* v1.0 - Original release */'); + add('/* v1.1 - Added proper .data section support */'); + add('/* v1.2 - Added support for c++ & iwram overlays */'); + add('/* - Major contributions by Jason Wilkins. */'); + add('/* v1.3 - .ewram section now can be used when */'); + add('/* compiling for MULTIBOOT mode. This fixes */'); + add('/* malloc() in DevKitAdvance which depends */'); + add('/* on __eheap_start instead of end to define*/'); + add('/* the starting location of heap space. */'); + add('/* External global variable __gba_iwram_heap*/'); + add('/* support added to allow labels end, _end, */'); + add('/* & __end__ to point to end of iwram or */'); + add('/* the end of ewram. */'); + add('/* Additions by WinterMute */'); + add('/* v1.4 - .sbss section added for unitialised */'); + add('/* data in ewram */'); + add('/* v1.5 - padding section added to stop EZF */'); + add('/* stripping important data */'); + add(''); + add('/* This file is released into the public domain */'); + add('/* for commercial or non-commercial use with no */'); + add('/* restrictions placed upon it. */'); + add(''); + add('/* NOTE!!!: This linker script defines the RAM & */'); + add('/* ROM start addresses. In order for it to work */'); + add('/* properly, remove -Ttext and -Tbss linker */'); + add('/* options from your makefile if they are */'); + add('/* present. */'); + add(''); + add('/* You can use the following to view section */'); + add('/* addresses in your .elf file: */'); + add('/* objdump -h file.elf */'); + add('/* Please note that empty sections may incorrectly*/'); + add('/* list the lma address as the vma address for */'); + add('/* some versions of objdump. */'); + add(''); + add('OUTPUT_FORMAT("elf32-littlearm", "elf32-bigarm", "elf32-littlearm")'); + add('OUTPUT_ARCH(arm)'); + add('ENTRY(_start)'); + add('/* SEARCH_DIR(/bin/arm); */'); + add(''); + add('/* The linker script function "var1 += var2;" sometimes */'); + add('/* reports incorrect values in the *.map file but the */'); + add('/* actual value it calculates is usually, if not always, */'); + add('/* correct. If you leave out the ". = ALIGN(4);" at the */'); + add('/* end of each section then the return value of SIZEOF() */'); + add('/* is sometimes incorrect and "var1 += var2;" appears to */'); + add('/* not work as well. "var1 += var2" style functions are */'); + add('/* avoided below as a result. */'); + add(''); + add('MEMORY {'); + add(''); + add(' rom : ORIGIN = 0x08000000, LENGTH = 32M'); + add(' iwram : ORIGIN = 0x03000000, LENGTH = 32K'); + add(' ewram : ORIGIN = 0x02000000, LENGTH = 256K'); + add('}'); + add(''); + add('__text_start = ORIGIN(rom);'); + add('__eheap_end = ORIGIN(ewram) + LENGTH(ewram);'); + add('__iwram_start = ORIGIN(iwram);'); + add('__iwram_top = ORIGIN(iwram) + LENGTH(iwram);;'); + add('__sp_irq = __iwram_top - 0x060;'); + add('__sp_usr = __sp_irq - 0x0a0;'); + add('__irq_flags = 0x03007ff8;'); + add(''); + add('SECTIONS'); + add('{'); + add(' . = __text_start;'); + add(' .init :'); + add(' {'); + add(' KEEP (*(.init))'); + add(' . = ALIGN(4);'); + add(' } >rom =0xff'); + add(''); + add(' .plt :'); + add(' {'); + add(' *(.plt)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >rom'); + add(''); + add(' .text : /* ALIGN (4): */'); + add(' {'); + add(' *(EXCLUDE_FILE (*.iwram*) .text)'); + add(' *(.text .stub .text.* .gnu.linkonce.t.*)'); + add(' KEEP (*(.text.*personality*))'); + add(' /* .gnu.warning sections are handled specially by elf32.em. */'); + add(' *(.gnu.warning)'); + add(' *(.glue_7t) *(.glue_7) *(.vfp11_veneer)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >rom = 0xff'); + add(''); + add(' __text_end = .;'); + add(' .fini :'); + add(' {'); + add(' KEEP (*(.fini))'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >rom =0'); + add(''); + add(' .rodata :'); + add(' {'); + add(' *(.rodata)'); + add(' *all.rodata*(*)'); + add(' *(.roda)'); + add(' *(.rodata.*)'); + add(' *(.gnu.linkonce.r*)'); + add(' SORT(CONSTRUCTORS)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >rom = 0xff'); + add(' .ARM.extab : { *(.ARM.extab* .gnu.linkonce.armextab.*) } >rom'); + add(' __exidx_start = .;'); + add(' .ARM.exidx : { *(.ARM.exidx* .gnu.linkonce.armexidx.*) } >rom'); + add(' __exidx_end = .;'); + add(''); + add(' .ctors :'); + add(' {'); + add(' /* gcc uses crtbegin.o to find the start of the constructors, so'); + add(' we make sure it is first. Because this is a wildcard, it'); + add(' doesn''t matter if the user does not actually link against'); + add(' crtbegin.o; the linker won''t look for a file to match a'); + add(' wildcard. The wildcard also means that it doesn''t matter which'); + add(' directory crtbegin.o is in. */'); + add(' KEEP (*crtbegin.o(.ctors))'); + add(' KEEP (*(EXCLUDE_FILE (*crtend.o) .ctors))'); + add(' KEEP (*(SORT(.ctors.*)))'); + add(' KEEP (*(.ctors))'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >rom = 0'); + add(''); + add(' .dtors :'); + add(' {'); + add(' KEEP (*crtbegin.o(.dtors))'); + add(' KEEP (*(EXCLUDE_FILE (*crtend.o) .dtors))'); + add(' KEEP (*(SORT(.dtors.*)))'); + add(' KEEP (*(.dtors))'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >rom = 0'); + add(''); + add(''); + add(' .eh_frame :'); + add(' {'); + add(' KEEP (*(.eh_frame))'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >rom = 0'); + add(''); + add(' .gcc_except_table :'); + add(' {'); + add(' *(.gcc_except_table)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >rom = 0'); + add(''); + add(' __iwram_lma = .;'); + add(''); + add(' .iwram __iwram_start : AT (__iwram_lma)'); + add(' {'); + add(' __iwram_start = ABSOLUTE(.) ;'); + add(' *(.iwram)'); + add(' *iwram.*(.text)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' __iwram_end = ABSOLUTE(.) ;'); + add(' } >iwram = 0xff'); + add(''); + add(' __data_lma = __iwram_lma + SIZEOF(.iwram) ;'); + add(''); + add(' .bss ALIGN(4) (NOLOAD) :'); + add(' {'); + add(' __bss_start = ABSOLUTE(.);'); + add(' __bss_start__ = ABSOLUTE(.);'); + add(' *(.dynbss)'); + add(' *(.gnu.linkonce.b*)'); + add(' *(.bss*)'); + add(' *(COMMON)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' __bss_end = ABSOLUTE(.) ;'); + add(''); + add(' } AT>iwram'); + add(''); + add(' __bss_end__ = __bss_end ;'); + add(''); + add(' .data ALIGN(4) : AT (__data_lma)'); + add(' {'); + add(' __data_start = ABSOLUTE(.);'); + add(' *(.data)'); + add(' *(.data.*)'); + add(' *(.gnu.linkonce.d*)'); + add(' *(.fpc*)'); + add(' CONSTRUCTORS'); + add(' . = ALIGN(4);'); + add(' } >iwram = 0xff'); + add(''); + add(' __preinit_lma = __data_lma + SIZEOF(.data);'); + add(''); + add(' PROVIDE (__preinit_array_start = .);'); + add(' .preinit_array : AT (__preinit_lma) { KEEP (*(.preinit_array)) } >iwram'); + add(' PROVIDE (__preinit_array_end = .);'); + add(''); + add(' __init_lma = __preinit_lma + SIZEOF(.preinit_array);'); + add(''); + add(' PROVIDE (__init_array_start = .);'); + add(' .init_array : AT (__init_lma)'); + add(' {'); + add(' KEEP (*(SORT(.init_array.*)))'); + add(' KEEP (*(.init_array))'); + add(' } >iwram'); + add(' PROVIDE (__init_array_end = .);'); + add(' PROVIDE (__fini_array_start = .);'); + add(''); + add(' __fini_lma = __init_lma + SIZEOF(.init_array);'); + add(''); + add(' .fini_array : AT (__fini_lma)'); + add(' {'); + add(' KEEP (*(SORT(.fini_array.*)))'); + add(' KEEP (*(.fini_array))'); + add(' } >iwram'); + add(' PROVIDE (__fini_array_end = .);'); + add(''); + add(' __jcr_lma = __fini_lma + SIZEOF(.fini_array);'); + add(' .jcr : AT (__jcr_lma) { KEEP (*(.jcr)) } >iwram'); + add(''); + add(' __data_end = ABSOLUTE(.);'); + add(' __iwram_overlay_lma = __jcr_lma + SIZEOF(.jcr);'); + add(''); + add(' __iwram_overlay_start = . ;'); + add(''); + add(' OVERLAY ALIGN(4) : NOCROSSREFS AT (__iwram_overlay_lma)'); + add(' {'); + add(' .iwram0 { *(.iwram0) . = ALIGN(4);}'); + add(' .iwram1 { *(.iwram1) . = ALIGN(4);}'); + add(' .iwram2 { *(.iwram2) . = ALIGN(4);}'); + add(' .iwram3 { *(.iwram3) . = ALIGN(4);}'); + add(' .iwram4 { *(.iwram4) . = ALIGN(4);}'); + add(' .iwram5 { *(.iwram5) . = ALIGN(4);}'); + add(' .iwram6 { *(.iwram6) . = ALIGN(4);}'); + add(' .iwram7 { *(.iwram7) . = ALIGN(4);}'); + add(' .iwram8 { *(.iwram8) . = ALIGN(4);}'); + add(' .iwram9 { *(.iwram9) . = ALIGN(4);}'); + add(' }>iwram = 0xff'); + add(''); + add(' __iwram_overlay_end = . ;'); + add(' __ewram_lma = __iwram_overlay_lma + (__iwram_overlay_end - __iwram_overlay_start) ;'); + add(''); + add(' __iheap_start = . ;'); + add(''); + add(' __ewram_start = ORIGIN(ewram);'); + add(' .ewram __ewram_start : AT (__ewram_lma)'); + add(' {'); + add(' *(.ewram)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' }>ewram = 0xff'); + add(''); + add(' __pad_lma = __ewram_lma + SIZEOF(.ewram);'); + add(''); + add(' .sbss ALIGN(4)(NOLOAD):'); + add(' {'); + add(' __sbss_start = ABSOLUTE(.);'); + add(' *(.sbss)'); + add(' . = ALIGN(4);'); + add(' __sbss_end = ABSOLUTE(.);'); + add(' } AT>ewram'); + add(''); + add(''); + add(' __ewram_end = __sbss_end ;'); + add(' __eheap_start = __sbss_end;'); + add(' __end__ = __sbss_end;'); + add(''); + add(' /* EZF Advance strips trailing 0xff bytes, add a pad section so nothing important is removed */'); + add(' .pad ALIGN(4) : AT (__pad_lma)'); + add(' {'); + add(' LONG(0x52416b64)'); + add(' LONG(0x4d)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } = 0xff'); + add(' __rom_end__ = __pad_lma + SIZEOF(.pad);'); + add(''); + add(''); + add(' /* Stabs debugging sections. */'); + add(' .stab 0 : { *(.stab) }'); + add(' .stabstr 0 : { *(.stabstr) }'); + add(' .stab.excl 0 : { *(.stab.excl) }'); + add(' .stab.exclstr 0 : { *(.stab.exclstr) }'); + add(' .stab.index 0 : { *(.stab.index) }'); + add(' .stab.indexstr 0 : { *(.stab.indexstr) }'); + add(' .comment 0 : { *(.comment) }'); + add(' /* DWARF debug sections.'); + add(' Symbols in the DWARF debugging sections are relative to the beginning'); + add(' of the section so we begin them at 0. */'); + add(' /* DWARF 1 */'); + add(' .debug 0 : { *(.debug) }'); + add(' .line 0 : { *(.line) }'); + add(' /* GNU DWARF 1 extensions */'); + add(' .debug_srcinfo 0 : { *(.debug_srcinfo) }'); + add(' .debug_sfnames 0 : { *(.debug_sfnames) }'); + add(' /* DWARF 1.1 and DWARF 2 */'); + add(' .debug_aranges 0 : { *(.debug_aranges) }'); + add(' .debug_pubnames 0 : { *(.debug_pubnames) }'); + add(' /* DWARF 2 */'); + add(' .debug_info 0 : { *(.debug_info) }'); + add(' .debug_abbrev 0 : { *(.debug_abbrev) }'); + add(' .debug_line 0 : { *(.debug_line) }'); + add(' .debug_frame 0 : { *(.debug_frame) }'); + add(' .debug_str 0 : { *(.debug_str) }'); + add(' .debug_loc 0 : { *(.debug_loc) }'); + add(' .debug_macinfo 0 : { *(.debug_macinfo) }'); + add(' /* SGI/MIPS DWARF 2 extensions */'); + add(' .debug_weaknames 0 : { *(.debug_weaknames) }'); + add(' .debug_funcnames 0 : { *(.debug_funcnames) }'); + add(' .debug_typenames 0 : { *(.debug_typenames) }'); + add(' .debug_varnames 0 : { *(.debug_varnames) }'); + add(' .stack 0x80000 : { _stack = .; *(.stack) }'); + add(' /* These must appear regardless of . */'); + add(' .note.gnu.arm.ident 0 : { KEEP (*(.note.gnu.arm.ident)) }'); + add(' .ARM.attributes 0 : { KEEP (*(.ARM.attributes)) }'); + add(' /DISCARD/ : { *(.note.GNU-stack) }'); + add('}'); + end; + +{ Write and Close response } + linkres.writetodisk; + linkres.free; + + WriteResponseFile:=True; + +end; + + +function TLinkerGba.MakeExecutable:boolean; +var + binstr, + cmdstr : TCmdStr; + success : boolean; + StaticStr, + GCSectionsStr, + DynLinkStr, + MapStr, + StripStr: string; +begin + { for future use } + StaticStr:=''; + StripStr:=''; + DynLinkStr:=''; + MapStr:=''; + + if (cs_link_strip in current_settings.globalswitches) and + not(cs_link_separate_dbg_file in current_settings.globalswitches) then + StripStr:='-s'; + if (cs_link_map in current_settings.globalswitches) then + StripStr:='-Map '+maybequoted(ChangeFileExt(current_module.exefilename^,'.map')); + if create_smartlink_sections then + GCSectionsStr:='--gc-sections'; + //if not(cs_link_extern in current_settings.globalswitches) then + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Write used files and libraries } + WriteResponseFile(); + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + + Replace(cmdstr,'$EXE',(maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename^,'.elf'))))); + Replace(cmdstr,'$RES',(maybequoted(ScriptFixFileName(outputexedir+Info.ResName)))); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$GCSECTIONS',GCSectionsStr); + Replace(cmdstr,'$MAP',MapStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + + success:=DoExec(FindUtil(utilsprefix+BinStr),cmdstr,true,false); + +{ Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + +{ Post process } + if success then + begin + success:=DoExec(FindUtil(utilsprefix+'objcopy'),'-O binary '+ + ChangeFileExt(current_module.exefilename^,'.elf')+' '+ + current_module.exefilename^,true,false); + end; + + if success then + begin + success:=DoExec(FindUtil('gbafix'), current_module.exefilename^,true,false); + end; + + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterExternalLinker(system_arm_gba_info,TLinkerGba); + RegisterTarget(system_arm_gba_info); +end. diff --git a/closures/compiler/systems/t_go32v2.pas b/closures/compiler/systems/t_go32v2.pas new file mode 100644 index 0000000000..f6c4adc496 --- /dev/null +++ b/closures/compiler/systems/t_go32v2.pas @@ -0,0 +1,407 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support import,export,link routines + for the (i386) Go32v2 target + + 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 t_go32v2; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + SysUtils, + cutils,cfileutl,cclasses, + globtype,globals,systems,verbose,script, + fmodule,i_go32v2, + link,ogcoff; + + type + TInternalLinkerGo32v2=class(TInternallinker) + constructor create;override; + procedure DefaultLinkScript;override; + end; + + TExternalLinkerGo32v2=class(texternallinker) + private + Function WriteResponseFile(isdll:boolean) : Boolean; + Function WriteScript(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + end; + + +{**************************************************************************** + TCoffLinker +****************************************************************************} + + constructor TInternalLinkerGo32v2.Create; + begin + inherited Create; + CExeoutput:=TDJCoffexeoutput; + CObjInput:=TDJCoffObjInput; + end; + + + procedure TInternalLinkerGo32v2.DefaultLinkScript; + begin + end; + + +{**************************************************************************** + TExternalLinkerGo32v2 +****************************************************************************} + +Constructor TExternalLinkerGo32v2.Create; +begin + Inherited Create; + { allow duplicated libs (PM) } + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; +end; + + +procedure TExternalLinkerGo32v2.SetDefaultInfo; +begin + with Info do + begin + ExeCmd[1]:='ld $RES'; + end; +end; + + +Function TExternalLinkerGo32v2.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + i : longint; + s : string; + linklibc : boolean; +begin + WriteResponseFile:=False; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Add all options to link.res instead of passing them via command line: + DOS command line is limited to 126 characters! } + LinkRes.Add('--script='+maybequoted(outputexedir+Info.ScriptName)); + if info.ExtraOptions<>'' then + LinkRes.Add(Info.ExtraOptions); +(* Potential issues with older ld version??? *) + if (cs_link_strip in current_settings.globalswitches) then + LinkRes.Add('-s'); + LinkRes.Add('-o '+maybequoted(current_module.exefilename^)); + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + LinkRes.Add('-('); + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(GetShortName(s)) + end; + LinkRes.Add('-)'); + end; + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + linklibc:=false; + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + begin + LinkRes.Add('-l'+s); + linklibc:=true; + end; + end; + { be sure that libc&libgcc is the last lib } + if linklibc then + begin + LinkRes.Add('-lc'); + LinkRes.Add('-lgcc'); + end; + +{ Write and Close response } + linkres.writetodisk; + LinkRes.Free; + + WriteResponseFile:=True; +end; + + +Function TExternalLinkerGo32v2.WriteScript(isdll:boolean) : Boolean; +Var + scriptres : TLinkRes; + HPath : TCmdStrListItem; + s : string; +begin + WriteScript:=False; + + { Open link.res file } + ScriptRes:=TLinkRes.Create(outputexedir+Info.ScriptName); + ScriptRes.Add('OUTPUT_FORMAT("coff-go32-exe")'); + ScriptRes.Add('ENTRY(start)'); + + ScriptRes.Add('SECTIONS'); + ScriptRes.Add('{'); + ScriptRes.Add(' .text 0x1000+SIZEOF_HEADERS : {'); + ScriptRes.Add(' . = ALIGN(16);'); + { add objectfiles, start with prt0 always } + ScriptRes.Add(' '+GetShortName(FindObjectFile('prt0','',false))+'(.text)'); + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + begin + ScriptRes.Add(' . = ALIGN(16);'); + ScriptRes.Add(' '+GetShortName(s)+'(.text)'); + end; + end; + ScriptRes.Add(' *(.text)'); + ScriptRes.Add(' etext = . ;'); + ScriptRes.Add(' PROVIDE(_etext = .);'); + ScriptRes.Add(' . = ALIGN(0x200);'); + ScriptRes.Add(' }'); + ScriptRes.Add(' .data ALIGN(0x200) : {'); + ScriptRes.Add(' djgpp_first_ctor = . ;'); + ScriptRes.Add(' *(SORT(.ctors.*))'); + ScriptRes.Add(' *(.ctor)'); + ScriptRes.Add(' *(.ctors)'); + ScriptRes.Add(' djgpp_last_ctor = . ;'); + ScriptRes.Add(' djgpp_first_dtor = . ;'); + ScriptRes.Add(' *(SORT(.dtors.*))'); + ScriptRes.Add(' *(.dtor)'); + ScriptRes.Add(' *(.dtors)'); + ScriptRes.Add(' djgpp_last_dtor = . ;'); + ScriptRes.Add(' __environ = . ;'); + ScriptRes.Add(' PROVIDE(_environ = .);'); + ScriptRes.Add(' LONG(0)'); + ScriptRes.Add(' *(.data)'); + ScriptRes.Add(' *(.fpc*)'); + ScriptRes.Add(' *(.gcc_exc)'); + ScriptRes.Add(' ___EH_FRAME_BEGIN__ = . ;'); + ScriptRes.Add(' *(.eh_fram*)'); + ScriptRes.Add(' ___EH_FRAME_END__ = . ;'); + ScriptRes.Add(' LONG(0)'); + ScriptRes.Add(' edata = . ; _edata = .;'); + ScriptRes.Add(' . = ALIGN(0x200);'); + ScriptRes.Add(' }'); + ScriptRes.Add(' .bss SIZEOF(.data) + ADDR(.data) :'); + ScriptRes.Add(' {'); + ScriptRes.Add(' _object.2 = . ;'); + ScriptRes.Add(' . += 32 ;'); + ScriptRes.Add(' *(.bss)'); + ScriptRes.Add(' *(COMMON)'); + ScriptRes.Add(' end = . ; _end = .;'); + ScriptRes.Add(' . = ALIGN(0x200);'); + ScriptRes.Add(' }'); + ScriptRes.Add(' /* Stabs debugging sections. */'); + ScriptRes.Add(' .stab 0 : { *(.stab) }'); + ScriptRes.Add(' .stabstr 0 : { *(.stabstr) }'); + ScriptRes.Add(' /* DWARF 2 */'); + ScriptRes.Add(' .debug_aranges 0 : { *(.debug_aranges) }'); + ScriptRes.Add(' .debug_pubnames 0 : { *(.debug_pubnames) }'); + ScriptRes.Add(' .debug_info 0 : { *(.debug_info) *(.gnu.linkonce.wi.*) }'); + ScriptRes.Add(' .debug_abbrev 0 : { *(.debug_abbrev) }'); + ScriptRes.Add(' .debug_line 0 : { *(.debug_line) }'); + ScriptRes.Add(' .debug_frame 0 : { *(.debug_frame) }'); + ScriptRes.Add(' .debug_str 0 : { *(.debug_str) }'); + ScriptRes.Add(' .debug_loc 0 : { *(.debug_loc) }'); + ScriptRes.Add(' .debug_macinfo 0 : { *(.debug_macinfo) }'); + ScriptRes.Add(' }'); + + { Write path to search libraries } + HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + ScriptRes.Add('SEARCH_DIR("'+GetShortName(HPath.Str)+'")'); + HPath:=TCmdStrListItem(HPath.Next); + end; + HPath:=TCmdStrListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + ScriptRes.Add('SEARCH_DIR("'+GetShortName(HPath.Str)+'")'); + HPath:=TCmdStrListItem(HPath.Next); + end; + +{ Write and Close response } + ScriptRes.WriteToDisk; + ScriptRes.Free; + + WriteScript:=True; +end; + + + +function TExternalLinkerGo32v2.MakeExecutable:boolean; +var + binstr, + cmdstr : TCmdStr; + success : boolean; +begin + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + + { Write used files and libraries and our own ld script } + WriteScript(false); + WriteResponsefile(false); + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$RES','@'+maybequoted(outputexedir+Info.ResName)); + success:=DoExec(FindUtil(utilsprefix+BinStr),cmdstr,true,false); + +{ Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + begin + DeleteFile(outputexedir+Info.ResName); + DeleteFile(outputexedir+Info.ScriptName); + end; + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +{$ifdef notnecessary} +procedure TExternalLinkerGo32v2.postprocessexecutable(const n : string); +type + tcoffheader=packed record + mach : word; + nsects : word; + time : longint; + sympos : longint; + syms : longint; + opthdr : word; + flag : word; + end; + tcoffsechdr=packed record + name : array[0..7] of char; + vsize : longint; + rvaofs : longint; + datalen : longint; + datapos : longint; + relocpos : longint; + lineno1 : longint; + nrelocs : word; + lineno2 : word; + flags : longint; + end; + psecfill=^TSecfill; + TSecfill=record + fillpos, + fillsize : longint; + next : psecfill; + end; +var + f : file; + coffheader : tcoffheader; + firstsecpos, + maxfillsize, + l : longint; + coffsec : tcoffsechdr; + secroot,hsecroot : psecfill; + zerobuf : pointer; +begin + { when -s is used quit, because there is no .exe } + if cs_link_nolink in current_settings.globalswitches then + exit; + { open file } + assign(f,n); + {$push}{$I-} + reset(f,1); + if ioresult<>0 then + Message1(execinfo_f_cant_open_executable,n); + { read headers } + seek(f,2048); + blockread(f,coffheader,sizeof(tcoffheader)); + { read section info } + maxfillsize:=0; + firstsecpos:=0; + secroot:=nil; + for l:=1to coffheader.nSects do + begin + blockread(f,coffsec,sizeof(tcoffsechdr)); + if coffsec.datapos>0 then + begin + if secroot=nil then + firstsecpos:=coffsec.datapos; + new(hsecroot); + hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize; + hsecroot^.fillsize:=coffsec.datalen-coffsec.vsize; + hsecroot^.next:=secroot; + secroot:=hsecroot; + if secroot^.fillsize>maxfillsize then + maxfillsize:=secroot^.fillsize; + end; + end; + if firstsecpos>0 then + begin + l:=firstsecpos-filepos(f); + if l>maxfillsize then + maxfillsize:=l; + end + else + l:=0; + { get zero buffer } + getmem(zerobuf,maxfillsize); + fillchar(zerobuf^,maxfillsize,0); + { zero from sectioninfo until first section } + blockwrite(f,zerobuf^,l); + { zero section alignments } + while assigned(secroot) do + begin + seek(f,secroot^.fillpos); + blockwrite(f,zerobuf^,secroot^.fillsize); + hsecroot:=secroot; + secroot:=secroot^.next; + dispose(hsecroot); + end; + freemem(zerobuf,maxfillsize); + close(f); + {$pop} + i:=ioresult; + postprocessexecutable:=true; +end; +{$endif} + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterExternalLinker(system_i386_go32v2_info,TExternalLinkerGo32v2); +// RegisterInternalLinker(system_i386_go32v2_info,TInternalLinkerGo32v2); + RegisterTarget(system_i386_go32v2_info); +end. diff --git a/closures/compiler/systems/t_haiku.pas b/closures/compiler/systems/t_haiku.pas new file mode 100644 index 0000000000..dae060e5ae --- /dev/null +++ b/closures/compiler/systems/t_haiku.pas @@ -0,0 +1,500 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + Copyright (c) 2008-2008 by Olivier Coursiere + + This unit implements support import,export,link routines + for the (i386) Haiku target. + + 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 t_haiku; + +{$i fpcdefs.inc} + +interface + + uses + symsym,symdef, + import,export,link; + + type + timportlibhaiku=class(timportlib) + procedure generatelib;override; + end; + + texportlibhaiku=class(texportlib) + procedure preparelib(const s : string);override; + procedure exportprocedure(hp : texported_item);override; + procedure exportvar(hp : texported_item);override; + procedure generatelib;override; + end; + + tlinkerhaiku=class(texternallinker) + private + Function WriteResponseFile(isdll:boolean;makelib:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + function MakeSharedLibrary:boolean;override; + end; + + +implementation + + uses + SysUtils, + cutils,cfileutl,cclasses, + verbose,systems,globtype,globals, + symconst,script, + fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,i_haiku,ogbase; + +{***************************************************************************** + TIMPORTLIBHAIKU +*****************************************************************************} + + procedure timportlibhaiku.generatelib; + var + i : longint; + ImportLibrary : TImportLibrary; + begin + for i:=0 to current_module.ImportLibraryList.Count-1 do + begin + ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]); + current_module.linkothersharedlibs.add(ImportLibrary.Name,link_always); + end; + end; + + +{***************************************************************************** + TEXPORTLIBHAIKU +*****************************************************************************} + +procedure texportlibhaiku.preparelib(const s:string); +begin +end; + + +procedure texportlibhaiku.exportprocedure(hp : texported_item); +var + hp2 : texported_item; +begin + { first test the index value } + if (hp.options and eo_index)<>0 then + begin + Message1(parser_e_no_export_with_index_for_target,'haiku'); + exit; + end; + { now place in correct order } + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) and + (hp.name^>hp2.name^) do + hp2:=texported_item(hp2.next); + { insert hp there !! } + if assigned(hp2) and (hp2.name^=hp.name^) then + begin + { this is not allowed !! } + Message1(parser_e_export_name_double,hp.name^); + exit; + end; + if hp2=texported_item(current_module._exports.first) then + current_module._exports.concat(hp) + else if assigned(hp2) then + begin + hp.next:=hp2; + hp.previous:=hp2.previous; + if assigned(hp2.previous) then + hp2.previous.next:=hp; + hp2.previous:=hp; + end + else + current_module._exports.concat(hp); +end; + + +procedure texportlibhaiku.exportvar(hp : texported_item); +begin + hp.is_var:=true; + exportprocedure(hp); +end; + + +procedure texportlibhaiku.generatelib; +var + hp2 : texported_item; + pd : tprocdef; +begin + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) do + begin + if (not hp2.is_var) and + (hp2.sym.typ=procsym) then + begin + { the manglednames can already be the same when the procedure + is declared with cdecl } + pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]); + if pd.mangledname<>hp2.name^ then + begin +{$ifdef i386} + { place jump in al_procedures } + current_asmdata.asmlists[al_procedures].concat(Tai_align.Create_op(4,$90)); + current_asmdata.asmlists[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + current_asmdata.asmlists[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(pd.mangledname))); + current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); +{$endif i386} + end; + end + else + Message1(parser_e_no_export_of_variables_for_target,'haiku'); + hp2:=texported_item(hp2.next); + end; +end; + + +{***************************************************************************** + TLINKERHAIKU +*****************************************************************************} + +Constructor TLinkerHaiku.Create; +var + s : string; + i : integer; +begin + Inherited Create; + s:=GetEnvironmentVariable('BELIBRARIES'); + { convert to correct format in case under unix system } + for i:=1 to length(s) do + if s[i] = ':' then + s[i] := ';'; + { just in case we have a single path : add the ending ; } + { since that is what the compiler expects. } + if pos(';',s) = 0 then + s:=s+';'; + LibrarySearchPath.AddPath(sysrootpath,s,true); {format:'path1;path2;...'} +end; + + +procedure TLinkerHaiku.SetDefaultInfo; +begin + with Info do + begin + ExeCmd[1]:='ld $OPT $DYNLINK $STATIC $STRIP -L. -o $EXE $CATRES'; + DllCmd[1]:='ld $OPT $INIT $FINI $SONAME -shared -L. -o $EXE $CATRES'; + DllCmd[2]:='strip --strip-unneeded $EXE'; +(* + ExeCmd[1]:='sh $RES $EXE $OPT $STATIC $STRIP -L.'; +{ ExeCmd[1]:='sh $RES $EXE $OPT $DYNLINK $STATIC $STRIP -L.';} + DllCmd[1]:='sh $RES $EXE $OPT -L.'; + +{ DllCmd[1]:='sh $RES $EXE $OPT -L. -g -nostart -soname=$EXE'; + } DllCmd[2]:='strip --strip-unneeded $EXE'; +{ DynamicLinker:='/lib/ld-beos.so.2';} +*) + end; +end; + + +function TLinkerHaiku.WriteResponseFile(isdll:boolean;makelib:boolean) : Boolean; +Var + linkres : TLinkRes; + i : integer; + cprtobj, + prtobj : string[80]; + HPath : TCmdStrListItem; + s : TCmdStr; + linklibc : boolean; +begin + WriteResponseFile:=False; +{ set special options for some targets } + linklibc:=(SharedLibFiles.Find('root')<>nil); + + prtobj:='prt0'; + cprtobj:='cprt0'; + if (cs_profile in current_settings.moduleswitches) or + (not SharedLibFiles.Empty) then + begin + AddSharedLibrary('root'); + linklibc:=true; + end; + + if (not linklibc) and makelib then + begin + linklibc:=true; + cprtobj:='dllprt.o'; + end; + + if linklibc then + prtobj:=cprtobj; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + { + if not isdll then + LinkRes.Add('ld -o $1 $2 $3 $4 $5 $6 $7 $8 $9 \') + else + LinkRes.Add('ld -o $1 -e 0 $2 $3 $4 $5 $6 $7 $8 $9\'); + } + LinkRes.Add('-m'); + LinkRes.Add('elf_i386_haiku'); + LinkRes.Add('-shared'); + LinkRes.Add('-Bsymbolic'); + + { Write path to search libraries } + HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + LinkRes.Add('-L'+HPath.Str); + HPath:=TCmdStrListItem(HPath.Next); + end; + HPath:=TCmdStrListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + LinkRes.Add('-L'+HPath.Str); + HPath:=TCmdStrListItem(HPath.Next); + end; + + { try to add crti and crtbegin if linking to C } + if linklibc then + begin + if librarysearchpath.FindFile('crti.o',false,s) then + LinkRes.AddFileName(s); + if librarysearchpath.FindFile('crtbegin.o',false,s) then + LinkRes.AddFileName(s); +{ s:=librarysearchpath.FindFile('start_dyn.o',found)+'start_dyn.o'; + if found then LinkRes.AddFileName(s+' \');} + + if prtobj<>'' then + LinkRes.AddFileName(FindObjectFile(prtobj,'',false)); + +// if isdll then +// LinkRes.AddFileName(FindObjectFile('func.o','',false)); + + if librarysearchpath.FindFile('init_term_dyn.o',false,s) then + LinkRes.AddFileName(s); + end + else + begin + if prtobj<>'' then + LinkRes.AddFileName(FindObjectFile(prtobj,'',false)); + end; + + { main objectfiles } + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + LinkRes.AddFileName(s); + end; + +{ LinkRes.Add('-lroot \'); + LinkRes.Add('/boot/develop/tools/gnupro/lib/gcc-lib/i586-beos/2.9-beos-991026/crtend.o \'); + LinkRes.Add('/boot/develop/lib/x86/crtn.o \');} + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(s) + end; + end; + + { Write sharedlibraries like -l<lib> } + if not SharedLibFiles.Empty then + begin + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + begin + linklibc:=true; + end; + end; + { be sure that libc is the last lib } +{ if linklibc then + LinkRes.Add('-lroot');} +{ if linkdynamic and (Info.DynamicLinker<>'') then + LinkRes.AddFileName(Info.DynamicLinker);} + end; + if isdll then + LinkRes.Add('-lroot'); + + { objects which must be at the end } + if linklibc then + begin + if librarysearchpath.FindFile('crtend.o',false,s) then + LinkRes.AddFileName(s); + if librarysearchpath.FindFile('crtn.o',false,s) then + LinkRes.AddFileName(s); + end; + +{ Write and Close response } + linkres.writetodisk; + linkres.free; + + WriteResponseFile:=True; +end; + + +function TLinkerHaiku.MakeExecutable:boolean; +var + binstr, + cmdstr : TCmdStr; + success, + useshell : boolean; + DynLinkStr : string[60]; + GCSectionsStr, + StaticStr, + StripStr : string[40]; +begin + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + StaticStr:=''; + StripStr:=''; + DynLinkStr:=''; + GCSectionsStr:=''; + if (cs_link_staticflag in current_settings.globalswitches) then + StaticStr:='-static'; + if (cs_link_strip in current_settings.globalswitches) then + StripStr:='-s'; + + if (cs_link_smart in current_settings.globalswitches) and + (tf_smartlink_sections in target_info.flags) then + GCSectionsStr:='--gc-sections'; + + If (cs_profile in current_settings.moduleswitches) or + ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then + begin + DynLinkStr:='-dynamic-linker='+Info.DynamicLinker; + if cshared Then + DynLinkStr:='--shared ' + DynLinkStr; + if rlinkpath<>'' Then + DynLinkStr:='--rpath-link '+rlinkpath + ' '+ DynLinkStr; + End; + +{ Write used files and libraries } + WriteResponseFile(false,false); + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$CATRES',CatFileContent(outputexedir+Info.ResName)); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$GCSECTIONS',GCSectionsStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + useshell:=not (tf_no_backquote_support in source_info.flags); + success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,useshell); + +{ Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +Function TLinkerHaiku.MakeSharedLibrary:boolean; +var + binstr, + cmdstr, + SoNameStr : TCmdStr; + success : boolean; + DynLinkStr : string[60]; + StaticStr, + StripStr : string[40]; + + begin + MakeSharedLibrary:=false; + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.sharedlibfilename^); + +{ Create some replacements } + StaticStr:=''; + StripStr:=''; + DynLinkStr:=''; + if (cs_link_staticflag in current_settings.globalswitches) then + StaticStr:='-static'; + if (cs_link_strip in current_settings.globalswitches) then + StripStr:='-s'; + If (cs_profile in current_settings.moduleswitches) or + ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then + begin + DynLinkStr:='-dynamic-linker='+Info.DynamicLinker; + if cshared Then + DynLinkStr:='--shared ' + DynLinkStr; + if rlinkpath<>'' Then + DynLinkStr:='--rpath-link '+rlinkpath + ' '+ DynLinkStr; + End; +{ Write used files and libraries } + WriteResponseFile(true,true); + + SoNameStr:='-soname '+ExtractFileName(current_module.sharedlibfilename^); + +{ Call linker } + SplitBinCmd(Info.DllCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$CATRES',CatFileContent(outputexedir+Info.ResName)); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + Replace(cmdstr,'$SONAME',SoNameStr); + + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,true); + +{ Strip the library ? } + if success and (cs_link_strip in current_settings.globalswitches) then + begin + SplitBinCmd(Info.DllCmd[2],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^)); + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,false); + end; + +{ Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + + MakeSharedLibrary:=success; { otherwise a recursive call to link method } +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef i386} + RegisterExternalLinker(system_i386_haiku_info,TLinkerhaiku); + RegisterImport(system_i386_haiku,timportlibhaiku); + RegisterExport(system_i386_haiku,texportlibhaiku); + RegisterTarget(system_i386_haiku_info); +{$endif i386} +end. diff --git a/closures/compiler/systems/t_linux.pas b/closures/compiler/systems/t_linux.pas new file mode 100644 index 0000000000..4977a116a0 --- /dev/null +++ b/closures/compiler/systems/t_linux.pas @@ -0,0 +1,1188 @@ +{ + Copyright (c) 1998-2008 by Peter Vreman + + This unit implements support import,export,link routines + for the (i386) Linux target + + 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 t_linux; + +{$i fpcdefs.inc} + +interface + + uses + aasmdata, + symsym,symdef,ppu, + import,export,expunix,link; + + type + timportliblinux=class(timportlib) + procedure generatelib;override; + end; + + texportliblinux=class(texportlibunix) + procedure setfininame(list: TAsmList; const s: string); override; + end; + + tlinkerlinux=class(texternallinker) + private + libctype:(libc5,glibc2,glibc21,uclibc); + cprtobj, + gprtobj, + prtobj : string[80]; + reorder : boolean; + linklibc: boolean; + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + procedure InitSysInitUnitName;override; + function MakeExecutable:boolean;override; + function MakeSharedLibrary:boolean;override; + procedure LoadPredefinedLibraryOrder; override; + end; + + +implementation + + uses + SysUtils, + cutils,cfileutl,cclasses, + verbose,systems,globtype,globals, + symconst,script, + fmodule, + aasmbase,aasmtai,aasmcpu,cpubase, + cgbase,cgobj,cgutils,ogbase,ncgutil, + comprsrc, + rescmn, i_linux + ; + +{***************************************************************************** + TIMPORTLIBLINUX +*****************************************************************************} + + procedure timportliblinux.generatelib; + var + i : longint; + ImportLibrary : TImportLibrary; + begin + for i:=0 to current_module.ImportLibraryList.Count-1 do + begin + ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]); + current_module.linkothersharedlibs.add(ImportLibrary.Name,link_always); + end; + end; + + +{***************************************************************************** + TEXPORTLIBLINUX +*****************************************************************************} + + procedure texportliblinux.setfininame(list: TAsmList; const s: string); + begin + { the problem with not having a .fini section is that a finalization + routine in regular code can get "smart" linked away -> reference it + just like the debug info } + new_section(list,sec_fpc,'links',0); + list.concat(Tai_const.Createname(s,0)); + inherited setfininame(list,s); + end; + +{***************************************************************************** + TLINKERLINUX +*****************************************************************************} + +Constructor TLinkerLinux.Create; +begin + Inherited Create; + if not Dontlinkstdlibpath Then +{$ifdef x86_64} + LibrarySearchPath.AddPath(sysrootpath,'/lib64;/usr/lib64;/usr/X11R6/lib64',true); +{$else} +{$ifdef powerpc64} + LibrarySearchPath.AddPath(sysrootpath,'/lib64;/usr/lib64;/usr/X11R6/lib64',true); +{$else powerpc64} + LibrarySearchPath.AddPath(sysrootpath,'/lib;/usr/lib;/usr/X11R6/lib',true); +{$endif powerpc64} +{$endif x86_64} +end; + + +procedure TLinkerLinux.SetDefaultInfo; +{ + This will also detect which libc version will be used +} + +const +{$ifdef i386} platform_select='-b elf32-i386 -m elf_i386';{$endif} +{$ifdef x86_64} platform_select='-b elf64-x86-64 -m elf_x86_64';{$endif} +{$ifdef powerpc} platform_select='-b elf32-powerpc -m elf32ppclinux';{$endif} +{$ifdef POWERPC64} platform_select='-b elf64-powerpc -m elf64ppc';{$endif} +{$ifdef sparc} platform_select='-b elf32-sparc -m elf32_sparc';{$endif} +{$ifdef arm} platform_select='';{$endif} {unknown :( } +{$ifdef m68k} platform_select='';{$endif} {unknown :( } +{$ifdef mips} + {$ifdef mipsel} platform_select='-EL';{$else} + platform_select='-EB';{$endif} +{$endif} + + +var + defdynlinker: string; +begin + with Info do + begin + ExeCmd[1]:='ld '+platform_select+' $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE'; + { when we want to cross-link we need to override default library paths } + if length(sysrootpath) > 0 then + ExeCmd[1]:=ExeCmd[1]+' -T'; + ExeCmd[1]:=ExeCmd[1]+' $RES'; + DllCmd[1]:='ld '+platform_select+' $OPT $INIT $FINI $SONAME -shared -L. -o $EXE $RES'; + DllCmd[2]:='strip --strip-unneeded $EXE'; + ExtDbgCmd[1]:='objcopy --only-keep-debug $EXE $DBG'; + ExtDbgCmd[2]:='objcopy --add-gnu-debuglink=$DBG $EXE'; + ExtDbgCmd[3]:='strip --strip-unneeded $EXE'; + +{$ifdef m68k} + { experimental, is this correct? } + defdynlinker:='/lib/ld-linux.so.2'; +{$endif m68k} + +{$ifdef i386} + defdynlinker:='/lib/ld-linux.so.2'; +{$endif} + +{$ifdef x86_64} + defdynlinker:='/lib64/ld-linux-x86-64.so.2'; +{$endif x86_64} + +{$ifdef sparc} + defdynlinker:='/lib/ld-linux.so.2'; +{$endif sparc} + +{$ifdef powerpc} + defdynlinker:='/lib/ld.so.1'; +{$endif powerpc} + +{$ifdef powerpc64} + defdynlinker:='/lib64/ld64.so.1'; +{$endif powerpc64} + +{$ifdef arm} +{$ifdef FPC_ARMEL} + defdynlinker:='/lib/ld-linux.so.3'; +{$else FPC_ARMEL} + defdynlinker:='/lib/ld-linux.so.2'; +{$endif FPC_ARMEL} +{$endif arm} + +{$ifdef mips} + defdynlinker:='/lib/ld.so.1'; +{$endif mips} + { + Search order: + glibc 2.1+ + uclibc + glibc 2.0 + If none is found (e.g. when cross compiling) glibc21 is assumed + } + if fileexists(sysrootpath+defdynlinker,false) then + begin + DynamicLinker:=defdynlinker; +{$ifdef i386} + libctype:=glibc21; +{$else i386} + libctype:=glibc2; +{$endif i386} + end + else if fileexists(sysrootpath+'/lib/ld-uClibc.so.0',false) then + begin + dynamiclinker:='/lib/ld-uClibc.so.0'; + libctype:=uclibc; + end +{$ifdef i386} + else if FileExists(sysrootpath+'/lib/ld-linux.so.1',false) then + begin + DynamicLinker:='/lib/ld-linux.so.1'; + libctype:=glibc2; + end +{$endif i386} + else + begin + { when no dyn. linker is found, we are probably + cross compiling, so use the default dyn. linker } + DynamicLinker:=defdynlinker; + { + the default c startup script is gcrt0.as on all platforms + except i386 + } +{$ifdef i386} + libctype:=glibc21; +{$else i386} + libctype:=glibc2; +{$endif i386} + end; + end; +end; + + +procedure TLinkerLinux.LoadPredefinedLibraryOrder; +// put your linkorder/linkalias overrides here. +// Note: assumes only called when reordering/aliasing is used. +Begin + if not (cs_link_no_default_lib_order in current_settings.globalswitches) Then + Begin + LinkLibraryOrder.add('gcc','',15); + LinkLibraryOrder.add('c','',100); + LinkLibraryOrder.add('gmon','',120); + LinkLibraryOrder.add('dl','',140); + LinkLibraryOrder.add('pthread','',160); + end; +End; + +Procedure TLinkerLinux.InitSysInitUnitName; +var + csysinitunit, + gsysinitunit : string[20]; + hp : tmodule; +begin + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + linklibc := hp.linkothersharedlibs.find('c'); + if linklibc then break; + hp:=tmodule(hp.next); + end; + reorder := linklibc and ReOrderEntries; + if current_module.islibrary then + begin + sysinitunit:='dll'; + csysinitunit:='dll'; + gsysinitunit:='dll'; + prtobj:='dllprt0'; + cprtobj:='dllprt0'; + gprtobj:='dllprt0'; + end + else + begin + prtobj:='prt0'; + sysinitunit:='prc'; + case libctype of + glibc21: + begin + cprtobj:='cprt21'; + gprtobj:='gprt21'; + csysinitunit:='c21'; + gsysinitunit:='c21g'; + end; + uclibc: + begin + cprtobj:='ucprt0'; + gprtobj:='ugprt0'; + csysinitunit:='uc'; + gsysinitunit:='ucg'; + end + else + cprtobj:='cprt0'; + gprtobj:='gprt0'; + csysinitunit:='c'; + gsysinitunit:='g'; + end; + end; + if cs_profile in current_settings.moduleswitches then + begin + prtobj:=gprtobj; + sysinitunit:=gsysinitunit; + linklibc:=true; + end + else + begin + if linklibc then + begin + prtobj:=cprtobj; + sysinitunit:=csysinitunit; + end; + end; + sysinitunit:='si_'+sysinitunit; +end; + +Function TLinkerLinux.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + i : longint; + HPath : TCmdStrListItem; + s,s1,s2 : TCmdStr; + found1, + found2 : boolean; + linksToSharedLibFiles : boolean; +begin + result:=False; +{ set special options for some targets } + if cs_profile in current_settings.moduleswitches then + begin + if not(libctype in [glibc2,glibc21]) then + AddSharedLibrary('gmon'); + AddSharedLibrary('c'); + end; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + with linkres do + begin + { Write path to search libraries } + HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + Add('SEARCH_DIR('+maybequoted(HPath.Str)+')'); + HPath:=TCmdStrListItem(HPath.Next); + end; + HPath:=TCmdStrListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + Add('SEARCH_DIR('+maybequoted(HPath.Str)+')'); + HPath:=TCmdStrListItem(HPath.Next); + end; + + { force local symbol resolution (i.e., inside the shared } + { library itself) for all non-exorted symbols, otherwise } + { several RTL symbols of FPC-compiled shared libraries } + { will be bound to those of a single shared library or } + { to the main program } + if (isdll) then + begin + add('VERSION'); + add('{'); + add(' {'); + if not texportlibunix(exportlib).exportedsymnames.empty then + begin + add(' global:'); + repeat + add(' '+texportlibunix(exportlib).exportedsymnames.getfirst+';'); + until texportlibunix(exportlib).exportedsymnames.empty; + end; + add(' local:'); + add(' *;'); + add(' };'); + add('}'); + end; + + StartSection('INPUT('); + { add objectfiles, start with prt0 always } + if not (target_info.system in systems_internal_sysinit) and (prtobj<>'') then + AddFileName(maybequoted(FindObjectFile(prtobj,'',false))); + { try to add crti and crtbegin if linking to C } + if linklibc and (libctype<>uclibc) then + begin + { crti.o must come first } + if librarysearchpath.FindFile('crti.o',false,s) then + AddFileName(s); + { then the crtbegin* } + if cs_create_pic in current_settings.moduleswitches then + begin + if librarysearchpath.FindFile('crtbeginS.o',false,s) then + AddFileName(s); + end + else + if (cs_link_staticflag in current_settings.globalswitches) and + librarysearchpath.FindFile('crtbeginT.o',false,s) then + AddFileName(s) + else if librarysearchpath.FindFile('crtbegin.o',false,s) then + AddFileName(s); + end; + { main objectfiles } + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + AddFileName(maybequoted(s)); + end; + EndSection(')'); + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + Add('GROUP('); + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + AddFileName(maybequoted(s)) + end; + Add(')'); + end; + + // we must reorder here because the result could empty sharedlibfiles + if reorder Then + ExpandAndApplyOrder(SharedLibFiles); + // after this point addition of shared libs not allowed. + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + if (isdll) then + begin + Add('INPUT('); + Add(info.DynamicLinker); + Add(')'); + end; + linksToSharedLibFiles := not SharedLibFiles.Empty; + + if not SharedLibFiles.Empty then + begin + + if (SharedLibFiles.Count<>1) or + (TCmdStrListItem(SharedLibFiles.First).Str<>'c') or + reorder then + begin + Add('INPUT('); + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if (s<>'c') or reorder then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + Add('-l'+s); + end + else + begin + linklibc:=true; + end; + end; + Add(')'); + end + else + linklibc:=true; + if (cs_link_staticflag in current_settings.globalswitches) or + (linklibc and not reorder) then + begin + Add('GROUP('); + { when we have -static for the linker the we also need libgcc } + if (cs_link_staticflag in current_settings.globalswitches) then + begin + Add('-lgcc'); + if librarysearchpath.FindFile('libgcc_eh.a',false,s1) then + Add('-lgcc_eh'); + end; + { be sure that libc is the last lib } + if linklibc and not reorder then + Add('-lc'); + Add(')'); + end; + end; + + { objects which must be at the end } + if linklibc and (libctype<>uclibc) then + begin + if cs_create_pic in current_settings.moduleswitches then + found1:=librarysearchpath.FindFile('crtendS.o',false,s1) + else + found1:=librarysearchpath.FindFile('crtend.o',false,s1); + found2:=librarysearchpath.FindFile('crtn.o',false,s2); + if found1 or found2 then + begin + Add('INPUT('); + if found1 then + AddFileName(s1); + if found2 then + AddFileName(s2); + Add(')'); + end; + end; + + {Entry point. Only needed for executables, set on the linker command line for + shared libraries. } + if (not isdll) then + if (linksToSharedLibFiles and not linklibc) then + add('ENTRY(_dynamic_start)') + else + add('ENTRY(_start)'); + +{$ifdef x86_64} +{$define LINKERSCRIPT_INCLUDED} + add('SECTIONS'); + add('{'); + {Read-only sections, merged into text segment:} + if current_module.islibrary then + add(' . = 0 + SIZEOF_HEADERS;') + else + add(' PROVIDE (__executable_start = 0x0400000); . = 0x0400000 + SIZEOF_HEADERS;'); + add(' . = 0 + SIZEOF_HEADERS;'); + add(' .interp : { *(.interp) }'); + add(' .hash : { *(.hash) }'); + add(' .dynsym : { *(.dynsym) }'); + add(' .dynstr : { *(.dynstr) }'); + add(' .gnu.version : { *(.gnu.version) }'); + add(' .gnu.version_d : { *(.gnu.version_d) }'); + add(' .gnu.version_r : { *(.gnu.version_r) }'); + add(' .rel.dyn :'); + add(' {'); + add(' *(.rel.init)'); + add(' *(.rel.text .rel.text.* .rel.gnu.linkonce.t.*)'); + add(' *(.rel.fini)'); + add(' *(.rel.rodata .rel.rodata.* .rel.gnu.linkonce.r.*)'); + add(' *(.rel.data.rel.ro*)'); + add(' *(.rel.data .rel.data.* .rel.gnu.linkonce.d.*)'); + add(' *(.rel.tdata .rel.tdata.* .rel.gnu.linkonce.td.*)'); + add(' *(.rel.tbss .rel.tbss.* .rel.gnu.linkonce.tb.*)'); + add(' *(.rel.got)'); + add(' *(.rel.bss .rel.bss.* .rel.gnu.linkonce.b.*)'); + add(' }'); + add(' .rela.dyn :'); + add(' {'); + add(' *(.rela.init)'); + add(' *(.rela.text .rela.text.* .rela.gnu.linkonce.t.*)'); + add(' *(.rela.fini)'); + add(' *(.rela.rodata .rela.rodata.* .rela.gnu.linkonce.r.*)'); + add(' *(.rela.data .rela.data.* .rela.gnu.linkonce.d.*)'); + add(' *(.rela.tdata .rela.tdata.* .rela.gnu.linkonce.td.*)'); + add(' *(.rela.tbss .rela.tbss.* .rela.gnu.linkonce.tb.*)'); + add(' *(.rela.got)'); + add(' *(.rela.bss .rela.bss.* .rela.gnu.linkonce.b.*)'); + add(' }'); + add(' .rel.plt : { *(.rel.plt) }'); + add(' .rela.plt : { *(.rela.plt) }'); + add(' .init :'); + add(' {'); + add(' KEEP (*(.init))'); + add(' } =0x90909090'); + add(' .plt : { *(.plt) }'); + add(' .text :'); + add(' {'); + add(' *(.text .stub .text.* .gnu.linkonce.t.*)'); + add(' KEEP (*(.text.*personality*))'); + {.gnu.warning sections are handled specially by elf32.em.} + add(' *(.gnu.warning)'); + add(' } =0x90909090'); + add(' .fini :'); + add(' {'); + add(' KEEP (*(.fini))'); + add(' } =0x90909090'); + add(' PROVIDE (_etext = .);'); + add(' .rodata :'); + add(' {'); + add(' *(.rodata .rodata.* .gnu.linkonce.r.*)'); + add(' }'); + {Adjust the address for the data segment. We want to adjust up to + the same address within the page on the next page up.} + add(' . = ALIGN (0x1000) - ((0x1000 - .) & (0x1000 - 1));'); + add(' .dynamic : { *(.dynamic) }'); + add(' .got : { *(.got .toc) }'); + add(' .got.plt : { *(.got.plt .toc.plt) }'); + add(' .data :'); + add(' {'); + add(' *(.data .data.* .gnu.linkonce.d.*)'); + add(' KEEP (*(.fpc .fpc.n_version .fpc.n_links))'); + add(' KEEP (*(.gnu.linkonce.d.*personality*))'); + add(' }'); + add(' PROVIDE (_edata = .);'); + add(' PROVIDE (edata = .);'); + {$ifdef zsegment_threadvars} + add(' _z = .;'); + add(' .threadvar 0 : AT (_z) { *(.threadvar .threadvar.* .gnu.linkonce.tv.*) }'); + add(' PROVIDE (_threadvar_size = SIZEOF(.threadvar));'); + add(' . = _z + SIZEOF (.threadvar);'); + {$else} + add(' .threadvar : { *(.threadvar .threadvar.* .gnu.linkonce.tv.*) }'); + {$endif} + add(' __bss_start = .;'); + add(' .bss :'); + add(' {'); + add(' *(.dynbss)'); + add(' *(.bss .bss.* .gnu.linkonce.b.*)'); + add(' *(COMMON)'); + {Align here to ensure that the .bss section occupies space up to + _end. Align after .bss to ensure correct alignment even if the + .bss section disappears because there are no input sections.} + add(' . = ALIGN(32 / 8);'); + add(' }'); + add(' . = ALIGN(32 / 8);'); + add(' PROVIDE (_end = .);'); + add(' PROVIDE (end = .);'); + {Stabs debugging sections.} + add(' .stab 0 : { *(.stab) }'); + add(' .stabstr 0 : { *(.stabstr) }'); + add(' /* DWARF debug sections.'); + add(' Symbols in the DWARF debugging sections are relative to the beginning'); + add(' of the section so we begin them at 0. */'); + add(' /* DWARF 1 */'); + add(' .debug 0 : { *(.debug) }'); + add(' .line 0 : { *(.line) }'); + add(' /* GNU DWARF 1 extensions */'); + add(' .debug_srcinfo 0 : { *(.debug_srcinfo) }'); + add(' .debug_sfnames 0 : { *(.debug_sfnames) }'); + add(' /* DWARF 1.1 and DWARF 2 */'); + add(' .debug_aranges 0 : { *(.debug_aranges) }'); + add(' .debug_pubnames 0 : { *(.debug_pubnames) }'); + add(' /* DWARF 2 */'); + add(' .debug_info 0 : { *(.debug_info .gnu.linkonce.wi.*) }'); + add(' .debug_abbrev 0 : { *(.debug_abbrev) }'); + add(' .debug_line 0 : { *(.debug_line) }'); + add(' .debug_frame 0 : { *(.debug_frame) }'); + add(' .debug_str 0 : { *(.debug_str) }'); + add(' .debug_loc 0 : { *(.debug_loc) }'); + add(' .debug_macinfo 0 : { *(.debug_macinfo) }'); + add(' /* SGI/MIPS DWARF 2 extensions */'); + add(' .debug_weaknames 0 : { *(.debug_weaknames) }'); + add(' .debug_funcnames 0 : { *(.debug_funcnames) }'); + add(' .debug_typenames 0 : { *(.debug_typenames) }'); + add(' .debug_varnames 0 : { *(.debug_varnames) }'); + add(' /DISCARD/ : { *(.note.GNU-stack) }'); + add('}'); +{$endif x86_64} + +{$ifdef ARM} + if target_info.abi=abi_eabi then + begin + { from GNU ld (CodeSourcery Sourcery G++ Lite 2007q3-53) 2.18.50.20070820 } + add('/* Script for -z combreloc: combine and sort reloc sections */'); + add('OUTPUT_FORMAT("elf32-littlearm", "elf32-bigarm",'); + add(' "elf32-littlearm")'); + add('OUTPUT_ARCH(arm)'); + add('SEARCH_DIR("=/usr/local/lib"); SEARCH_DIR("=/lib"); SEARCH_DIR("=/usr/lib");'); + add('SECTIONS'); + add('{'); + add(' /* Read-only sections, merged into text segment: */'); + add(' PROVIDE (__executable_start = 0x8000); . = 0x8000 + SIZEOF_HEADERS;'); + add(' .interp : { *(.interp) }'); + add(' .note.gnu.build-id : { *(.note.gnu.build-id) }'); + add(' .hash : { *(.hash) }'); + add(' .gnu.hash : { *(.gnu.hash) }'); + add(' .dynsym : { *(.dynsym) }'); + add(' .dynstr : { *(.dynstr) }'); + add(' .gnu.version : { *(.gnu.version) }'); + add(' .gnu.version_d : { *(.gnu.version_d) }'); + add(' .gnu.version_r : { *(.gnu.version_r) }'); + add(' .rel.dyn :'); + add(' {'); + add(' *(.rel.init)'); + add(' *(.rel.text .rel.text.* .rel.gnu.linkonce.t.*)'); + add(' *(.rel.fini)'); + add(' *(.rel.rodata .rel.rodata.* .rel.gnu.linkonce.r.*)'); + add(' *(.rel.data.rel.ro* .rel.gnu.linkonce.d.rel.ro.*)'); + add(' *(.rel.data .rel.data.* .rel.gnu.linkonce.d.*)'); + add(' *(.rel.tdata .rel.tdata.* .rel.gnu.linkonce.td.*)'); + add(' *(.rel.tbss .rel.tbss.* .rel.gnu.linkonce.tb.*)'); + add(' *(.rel.ctors)'); + add(' *(.rel.dtors)'); + add(' *(.rel.got)'); + add(' *(.rel.bss .rel.bss.* .rel.gnu.linkonce.b.*)'); + add(' }'); + add(' .rela.dyn :'); + add(' {'); + add(' *(.rela.init)'); + add(' *(.rela.text .rela.text.* .rela.gnu.linkonce.t.*)'); + add(' *(.rela.fini)'); + add(' *(.rela.rodata .rela.rodata.* .rela.gnu.linkonce.r.*)'); + add(' *(.rela.data .rela.data.* .rela.gnu.linkonce.d.*)'); + add(' *(.rela.tdata .rela.tdata.* .rela.gnu.linkonce.td.*)'); + add(' *(.rela.tbss .rela.tbss.* .rela.gnu.linkonce.tb.*)'); + add(' *(.rela.ctors)'); + add(' *(.rela.dtors)'); + add(' *(.rela.got)'); + add(' *(.rela.bss .rela.bss.* .rela.gnu.linkonce.b.*)'); + add(' }'); + add(' .rel.plt : { *(.rel.plt) }'); + add(' .rela.plt : { *(.rela.plt) }'); + add(' .init :'); + add(' {'); + add(' KEEP (*(.init))'); + add(' } =0'); + add(' .plt : { *(.plt) }'); + add(' .text :'); + add(' {'); + add(' *(.text .stub .text.* .gnu.linkonce.t.*)'); + add(' KEEP (*(.text.*personality*))'); + add(' /* .gnu.warning sections are handled specially by elf32.em. */'); + add(' *(.gnu.warning)'); + add(' *(.glue_7t) *(.glue_7) *(.vfp11_veneer)'); + add(' } =0'); + add(' .fini :'); + add(' {'); + add(' KEEP (*(.fini))'); + add(' } =0'); + add(' PROVIDE (__etext = .);'); + add(' PROVIDE (_etext = .);'); + add(' PROVIDE (etext = .);'); + add(' .rodata : { *(.rodata .rodata.* .gnu.linkonce.r.*) }'); + add(' .rodata1 : { *(.rodata1) }'); + add(' .ARM.extab : { *(.ARM.extab* .gnu.linkonce.armextab.*) }'); + add(' __exidx_start = .;'); + add(' .ARM.exidx : { *(.ARM.exidx* .gnu.linkonce.armexidx.*) }'); + add(' __exidx_end = .;'); + add(' .eh_frame_hdr : { *(.eh_frame_hdr) }'); + add(' .eh_frame : ONLY_IF_RO { KEEP (*(.eh_frame)) }'); + add(' .gcc_except_table : ONLY_IF_RO { *(.gcc_except_table .gcc_except_table.*) }'); + add(' /* Adjust the address for the data segment. We want to adjust up to'); + add(' the same address within the page on the next page up. */'); + add(' . = ALIGN(CONSTANT (MAXPAGESIZE)) + (. & (CONSTANT (MAXPAGESIZE) - 1));'); + add(' /* Exception handling */'); + add(' .eh_frame : ONLY_IF_RW { KEEP (*(.eh_frame)) }'); + add(' .gcc_except_table : ONLY_IF_RW { *(.gcc_except_table .gcc_except_table.*) }'); + add(' /* Thread Local Storage sections */'); + add(' .tdata : { *(.tdata .tdata.* .gnu.linkonce.td.*) }'); + add(' .tbss : { *(.tbss .tbss.* .gnu.linkonce.tb.*) *(.tcommon) }'); + add(' .preinit_array :'); + add(' {'); + add(' PROVIDE_HIDDEN (__preinit_array_start = .);'); + add(' KEEP (*(.preinit_array))'); + add(' PROVIDE_HIDDEN (__preinit_array_end = .);'); + add(' }'); + add(' .init_array :'); + add(' {'); + add(' PROVIDE_HIDDEN (__init_array_start = .);'); + add(' KEEP (*(SORT(.init_array.*)))'); + add(' KEEP (*(.init_array))'); + add(' PROVIDE_HIDDEN (__init_array_end = .);'); + add(' }'); + add(' .fini_array :'); + add(' {'); + add(' PROVIDE_HIDDEN (__fini_array_start = .);'); + add(' KEEP (*(.fini_array))'); + add(' KEEP (*(SORT(.fini_array.*)))'); + add(' PROVIDE_HIDDEN (__fini_array_end = .);'); + add(' }'); + add(' .ctors :'); + add(' {'); + add(' /* gcc uses crtbegin.o to find the start of'); + add(' the constructors, so we make sure it is'); + add(' first. Because this is a wildcard, it'); + add(' doesn''t matter if the user does not'); + add(' actually link against crtbegin.o; the'); + add(' linker won''t look for a file to match a'); + add(' wildcard. The wildcard also means that it'); + add(' doesn''t matter which directory crtbegin.o'); + add(' is in. */'); + add(' KEEP (*crtbegin.o(.ctors))'); + add(' KEEP (*crtbegin?.o(.ctors))'); + add(' /* We don''t want to include the .ctor section from'); + add(' the crtend.o file until after the sorted ctors.'); + add(' The .ctor section from the crtend file contains the'); + add(' end of ctors marker and it must be last */'); + add(' KEEP (*(EXCLUDE_FILE (*crtend.o *crtend?.o ) .ctors))'); + add(' KEEP (*(SORT(.ctors.*)))'); + add(' KEEP (*(.ctors))'); + add(' }'); + add(' .dtors :'); + add(' {'); + add(' KEEP (*crtbegin.o(.dtors))'); + add(' KEEP (*crtbegin?.o(.dtors))'); + add(' KEEP (*(EXCLUDE_FILE (*crtend.o *crtend?.o ) .dtors))'); + add(' KEEP (*(SORT(.dtors.*)))'); + add(' KEEP (*(.dtors))'); + add(' }'); + add(' .jcr : { KEEP (*(.jcr)) }'); + add(' .data.rel.ro : { *(.data.rel.ro.local* .gnu.linkonce.d.rel.ro.local.*) *(.data.rel.ro* .gnu.linkonce.d.rel.ro.*) }'); + add(' .dynamic : { *(.dynamic) }'); + add(' .got : { *(.got.plt) *(.got) }'); + add(' .data :'); + add(' {'); + add(' __data_start = . ;'); + add(' *(.data .data.* .gnu.linkonce.d.*)'); + + { extra by FPC } + add(' KEEP (*(.fpc .fpc.n_version .fpc.n_links))'); + + add(' KEEP (*(.gnu.linkonce.d.*personality*))'); + add(' SORT(CONSTRUCTORS)'); + add(' }'); + add(' .data1 : { *(.data1) }'); + add(' _edata = .; PROVIDE (edata = .);'); + add(' __bss_start = .;'); + add(' __bss_start__ = .;'); + add(' .bss :'); + add(' {'); + add(' *(.dynbss)'); + add(' *(.bss .bss.* .gnu.linkonce.b.*)'); + add(' *(COMMON)'); + add(' /* Align here to ensure that the .bss section occupies space up to'); + add(' _end. Align after .bss to ensure correct alignment even if the'); + add(' .bss section disappears because there are no input sections.'); + add(' FIXME: Why do we need it? When there is no .bss section, we don''t'); + add(' pad the .data section. */'); + add(' . = ALIGN(. != 0 ? 32 / 8 : 1);'); + add(' }'); + add(' _bss_end__ = . ; __bss_end__ = . ;'); + add(' . = ALIGN(32 / 8);'); + add(' . = ALIGN(32 / 8);'); + add(' __end__ = . ;'); + add(' _end = .; PROVIDE (end = .);'); + add(' /* Stabs debugging sections. */'); + add(' .stab 0 : { *(.stab) }'); + add(' .stabstr 0 : { *(.stabstr) }'); + add(' .stab.excl 0 : { *(.stab.excl) }'); + add(' .stab.exclstr 0 : { *(.stab.exclstr) }'); + add(' .stab.index 0 : { *(.stab.index) }'); + add(' .stab.indexstr 0 : { *(.stab.indexstr) }'); + add(' .comment 0 : { *(.comment) }'); + add(' /* DWARF debug sections.'); + add(' Symbols in the DWARF debugging sections are relative to the beginning'); + add(' of the section so we begin them at 0. */'); + add(' /* DWARF 1 */'); + add(' .debug 0 : { *(.debug) }'); + add(' .line 0 : { *(.line) }'); + add(' /* GNU DWARF 1 extensions */'); + add(' .debug_srcinfo 0 : { *(.debug_srcinfo) }'); + add(' .debug_sfnames 0 : { *(.debug_sfnames) }'); + add(' /* DWARF 1.1 and DWARF 2 */'); + add(' .debug_aranges 0 : { *(.debug_aranges) }'); + add(' .debug_pubnames 0 : { *(.debug_pubnames) }'); + add(' /* DWARF 2 */'); + add(' .debug_info 0 : { *(.debug_info .gnu.linkonce.wi.*) }'); + add(' .debug_abbrev 0 : { *(.debug_abbrev) }'); + add(' .debug_line 0 : { *(.debug_line) }'); + add(' .debug_frame 0 : { *(.debug_frame) }'); + add(' .debug_str 0 : { *(.debug_str) }'); + add(' .debug_loc 0 : { *(.debug_loc) }'); + add(' .debug_macinfo 0 : { *(.debug_macinfo) }'); + add(' /* SGI/MIPS DWARF 2 extensions */'); + add(' .debug_weaknames 0 : { *(.debug_weaknames) }'); + add(' .debug_funcnames 0 : { *(.debug_funcnames) }'); + add(' .debug_typenames 0 : { *(.debug_typenames) }'); + add(' .debug_varnames 0 : { *(.debug_varnames) }'); + add(' /* DWARF 3 */'); + add(' .debug_pubtypes 0 : { *(.debug_pubtypes) }'); + add(' .debug_ranges 0 : { *(.debug_ranges) }'); + add(' .stack 0x80000 :'); + add(' {'); + add(' _stack = .;'); + add(' *(.stack)'); + add(' }'); + add(' .ARM.attributes 0 : { KEEP (*(.ARM.attributes)) KEEP (*(.gnu.attributes)) }'); + add(' .note.gnu.arm.ident 0 : { KEEP (*(.note.gnu.arm.ident)) }'); + add(' /DISCARD/ : { *(.note.GNU-stack) *(.gnu_debuglink) }'); + add('}'); + end + else +{$endif ARM} + +{$ifndef LINKERSCRIPT_INCLUDED} + begin + {Sections.} + add('SECTIONS'); + add('{'); + {Read-only sections, merged into text segment:} + add(' PROVIDE (__executable_start = 0x010000); . = 0x010000 + SIZEOF_HEADERS;'); + add(' .interp : { *(.interp) }'); + add(' .hash : { *(.hash) }'); + add(' .dynsym : { *(.dynsym) }'); + add(' .dynstr : { *(.dynstr) }'); + add(' .gnu.version : { *(.gnu.version) }'); + add(' .gnu.version_d : { *(.gnu.version_d) }'); + add(' .gnu.version_r : { *(.gnu.version_r) }'); + add(' .rel.dyn :'); + add(' {'); + add(' *(.rel.init)'); + add(' *(.rel.text .rel.text.* .rel.gnu.linkonce.t.*)'); + add(' *(.rel.fini)'); + add(' *(.rel.rodata .rel.rodata.* .rel.gnu.linkonce.r.*)'); + add(' *(.rel.data.rel.ro*)'); + add(' *(.rel.data .rel.data.* .rel.gnu.linkonce.d.*)'); + add(' *(.rel.tdata .rel.tdata.* .rel.gnu.linkonce.td.*)'); + add(' *(.rel.tbss .rel.tbss.* .rel.gnu.linkonce.tb.*)'); + add(' *(.rel.got)'); + add(' *(.rel.bss .rel.bss.* .rel.gnu.linkonce.b.*)'); + add(' }'); + add(' .rela.dyn :'); + add(' {'); + add(' *(.rela.init)'); + add(' *(.rela.text .rela.text.* .rela.gnu.linkonce.t.*)'); + add(' *(.rela.fini)'); + add(' *(.rela.rodata .rela.rodata.* .rela.gnu.linkonce.r.*)'); + add(' *(.rela.data .rela.data.* .rela.gnu.linkonce.d.*)'); + add(' *(.rela.tdata .rela.tdata.* .rela.gnu.linkonce.td.*)'); + add(' *(.rela.tbss .rela.tbss.* .rela.gnu.linkonce.tb.*)'); + add(' *(.rela.got)'); + add(' *(.rela.bss .rela.bss.* .rela.gnu.linkonce.b.*)'); + add(' }'); + add(' .rel.plt : { *(.rel.plt) }'); + add(' .rela.plt : { *(.rela.plt) }'); + add(' .init :'); + add(' {'); + add(' KEEP (*(.init))'); + add(' } =0x90909090'); + add(' .plt : { *(.plt) }'); + add(' .text :'); + add(' {'); + add(' *(.text .stub .text.* .gnu.linkonce.t.*)'); + add(' KEEP (*(.text.*personality*))'); + {.gnu.warning sections are handled specially by elf32.em.} + add(' *(.gnu.warning)'); + add(' } =0x90909090'); + add(' .fini :'); + add(' {'); + add(' KEEP (*(.fini))'); + add(' } =0x90909090'); + add(' PROVIDE (_etext = .);'); + add(' .rodata :'); + add(' {'); + add(' *(.rodata .rodata.* .gnu.linkonce.r.*)'); + add(' }'); + {Adjust the address for the data segment. We want to adjust up to + the same address within the page on the next page up.} + add(' . = ALIGN (0x1000) - ((0x1000 - .) & (0x1000 - 1));'); + add(' .dynamic : { *(.dynamic) }'); + add(' .got : { *(.got) }'); + add(' .got.plt : { *(.got.plt) }'); + add(' .data :'); + add(' {'); + add(' *(.data .data.* .gnu.linkonce.d.*)'); + add(' KEEP (*(.fpc .fpc.n_version .fpc.n_links))'); + add(' KEEP (*(.gnu.linkonce.d.*personality*))'); + add(' }'); + add(' PROVIDE (_edata = .);'); + add(' PROVIDE (edata = .);'); + {$ifdef zsegment_threadvars} + add(' _z = .;'); + add(' .threadvar 0 : AT (_z) { *(.threadvar .threadvar.* .gnu.linkonce.tv.*) }'); + add(' PROVIDE (_threadvar_size = SIZEOF(.threadvar));'); + add(' . = _z + SIZEOF (.threadvar);'); + {$else} + add(' .threadvar : { *(.threadvar .threadvar.* .gnu.linkonce.tv.*) }'); + {$endif} + add(' __bss_start = .;'); + add(' .bss :'); + add(' {'); + add(' *(.dynbss)'); + add(' *(.bss .bss.* .gnu.linkonce.b.*)'); + add(' *(COMMON)'); + {Align here to ensure that the .bss section occupies space up to + _end. Align after .bss to ensure correct alignment even if the + .bss section disappears because there are no input sections.} + add(' . = ALIGN(32 / 8);'); + add(' }'); + add(' . = ALIGN(32 / 8);'); + add(' PROVIDE (_end = .);'); + add(' PROVIDE (end = .);'); + {Stabs debugging sections.} + add(' .stab 0 : { *(.stab) }'); + add(' .stabstr 0 : { *(.stabstr) }'); + add('}'); + end; +{$endif LINKERSCRIPT_INCLUDED} + { Write and Close response } + writetodisk; + Free; + end; + + WriteResponseFile:=True; +end; + + +function TLinkerLinux.MakeExecutable:boolean; +var + i : longint; + binstr, + cmdstr : TCmdStr; + success : boolean; + DynLinkStr : string; + GCSectionsStr, + StaticStr, + StripStr : string[40]; +begin + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + StaticStr:=''; + StripStr:=''; + GCSectionsStr:=''; + DynLinkStr:=''; + if (cs_link_staticflag in current_settings.globalswitches) then + StaticStr:='-static'; + if (cs_link_strip in current_settings.globalswitches) and + not(cs_link_separate_dbg_file in current_settings.globalswitches) then + StripStr:='-s'; + if (cs_link_map in current_settings.globalswitches) then + StripStr:='-Map '+maybequoted(ChangeFileExt(current_module.exefilename^,'.map')); + if create_smartlink_sections then + GCSectionsStr:='--gc-sections'; + If (cs_profile in current_settings.moduleswitches) or + ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then + begin + DynLinkStr:='--dynamic-linker='+Info.DynamicLinker; + if cshared then + DynLinkStr:=DynLinkStr+' --shared '; + if rlinkpath<>'' then + DynLinkStr:=DynLinkStr+' --rpath-link '+rlinkpath; + End; + +{ Write used files and libraries } + WriteResponseFile(false); + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$GCSECTIONS',GCSectionsStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + + { create dynamic symbol table? } + if HasExports then + cmdstr:=cmdstr+' -E'; + + success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,false); + + { Create external .dbg file with debuginfo } + if success and (cs_link_separate_dbg_file in current_settings.globalswitches) then + begin + for i:=1 to 3 do + begin + SplitBinCmd(Info.ExtDbgCmd[i],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$DBGFN',maybequoted(extractfilename(current_module.dbgfilename^))); + Replace(cmdstr,'$DBG',maybequoted(current_module.dbgfilename^)); + success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,false); + if not success then + break; + end; + end; + + { Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +Function TLinkerLinux.MakeSharedLibrary:boolean; +var + InitStr, + FiniStr, + SoNameStr : string[80]; + binstr, + cmdstr : TCmdStr; + success : boolean; +begin + MakeSharedLibrary:=false; + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.sharedlibfilename^); + +{ Write used files and libraries } + WriteResponseFile(true); + + { Create some replacements } + { note: linux does not use exportlib.initname/fininame due to the custom startup code } + InitStr:='-init FPC_SHARED_LIB_START'; + FiniStr:='-fini FPC_LIB_EXIT'; + SoNameStr:='-soname '+ExtractFileName(current_module.sharedlibfilename^); + +{ Call linker } + SplitBinCmd(Info.DllCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$INIT',InitStr); + Replace(cmdstr,'$FINI',FiniStr); + Replace(cmdstr,'$SONAME',SoNameStr); + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,false); + +{ Strip the library ? } + if success and (cs_link_strip in current_settings.globalswitches) then + begin + { only remove non global symbols and debugging info for a library } + Info.DllCmd[2]:='strip --discard-all --strip-debug $EXE'; + SplitBinCmd(Info.DllCmd[2],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^)); + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,false); + end; + +{ Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + + MakeSharedLibrary:=success; { otherwise a recursive call to link method } +end; + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef i386} + RegisterExternalLinker(system_i386_linux_info,TLinkerLinux); + RegisterImport(system_i386_linux,timportliblinux); + RegisterExport(system_i386_linux,texportliblinux); + RegisterTarget(system_i386_linux_info); + + RegisterExternalLinker(system_x86_6432_linux_info,TLinkerLinux); + RegisterImport(system_x86_6432_linux,timportliblinux); + RegisterExport(system_x86_6432_linux,texportliblinux); + RegisterTarget(system_x86_6432_linux_info); +{$endif i386} +{$ifdef m68k} + RegisterExternalLinker(system_m68k_linux_info,TLinkerLinux); + RegisterImport(system_m68k_linux,timportliblinux); + RegisterExport(system_m68k_linux,texportliblinux); + RegisterTarget(system_m68k_linux_info); +{$endif m68k} +{$ifdef powerpc} + RegisterExternalLinker(system_powerpc_linux_info,TLinkerLinux); + RegisterImport(system_powerpc_linux,timportliblinux); + RegisterExport(system_powerpc_linux,texportliblinux); + RegisterTarget(system_powerpc_linux_info); +{$endif powerpc} +{$ifdef powerpc64} + RegisterExternalLinker(system_powerpc64_linux_info,TLinkerLinux); + RegisterImport(system_powerpc64_linux,timportliblinux); + RegisterExport(system_powerpc64_linux,texportliblinux); + RegisterTarget(system_powerpc64_linux_info); +{$endif powerpc64} +{$ifdef alpha} + RegisterExternalLinker(system_alpha_linux_info,TLinkerLinux); + RegisterImport(system_alpha_linux,timportliblinux); + RegisterExport(system_alpha_linux,texportliblinux); + RegisterTarget(system_alpha_linux_info); +{$endif alpha} +{$ifdef x86_64} + RegisterExternalLinker(system_x86_64_linux_info,TLinkerLinux); + RegisterImport(system_x86_64_linux,timportliblinux); + RegisterExport(system_x86_64_linux,texportliblinux); + RegisterTarget(system_x86_64_linux_info); +{$endif x86_64} +{$ifdef SPARC} + RegisterExternalLinker(system_sparc_linux_info,TLinkerLinux); + RegisterImport(system_SPARC_linux,timportliblinux); + RegisterExport(system_SPARC_linux,texportliblinux); + RegisterTarget(system_SPARC_linux_info); +{$endif SPARC} +{$ifdef ARM} + RegisterExternalLinker(system_arm_linux_info,TLinkerLinux); + RegisterImport(system_arm_linux,timportliblinux); + RegisterExport(system_arm_linux,texportliblinux); + RegisterTarget(system_arm_linux_info); +{$endif ARM} +{$ifdef MIPS} +{$ifdef MIPSEL} + RegisterExternalLinker(system_mipsel_linux_info,TLinkerLinux); + RegisterImport(system_mipsel_linux,timportliblinux); + RegisterExport(system_mipsel_linux,texportliblinux); + RegisterTarget(system_mipsel_linux_info); +{$else MIPS} + RegisterExternalLinker(system_mips_linux_info,TLinkerLinux); + RegisterImport(system_mips_linux,timportliblinux); + RegisterExport(system_mips_linux,texportliblinux); + RegisterTarget(system_mips_linux_info); +{$endif MIPSEL} +{$endif MIPS} + RegisterRes(res_elf_info,TWinLikeResourceFile); +end. diff --git a/closures/compiler/systems/t_macos.pas b/closures/compiler/systems/t_macos.pas new file mode 100644 index 0000000000..1e195b4c42 --- /dev/null +++ b/closures/compiler/systems/t_macos.pas @@ -0,0 +1,255 @@ +{ + Copyright (c) 2001-2002 by Peter Vreman + + This unit implements support import,export,link routines for MacOS. + + 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 t_macos; + +{$i fpcdefs.inc} + +interface + + uses + import,symsym,symdef,link; + + type + timportlibmacos=class(timportlib) + procedure generatelib;override; + end; + + tlinkermpw=class(texternallinker) + private + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + end; + +implementation + + uses + SysUtils, + cutils,cfileutl,cclasses, + globtype,globals,systems,verbose,script,fmodule,i_macos, + ogbase, + symconst; + +{***************************************************************************** + TIMPORTLIBMACOS +*****************************************************************************} + + procedure timportlibmacos.generatelib; + var + i : longint; + ImportLibrary : TImportLibrary; + begin + for i:=0 to current_module.ImportLibraryList.Count-1 do + begin + ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]); + current_module.linkothersharedlibs.add(ImportLibrary.Name,link_always); + end; + end; + +{***************************************************************************** + TLINKERMPW +*****************************************************************************} + +Constructor TLinkerMPW.Create; +begin + Inherited Create; + //LibrarySearchPath.AddPath(sysrootpath,'/lib;/usr/lib;/usr/X11R6/lib',true); +end; + + +procedure TLinkerMPW.SetDefaultInfo; + +begin + with Info do + begin + ExeCmd[1]:='Execute $RES'; {The link.res file contains the whole link command.} + //ExeCmd[1]:='PPCLink $OPT $DYNLINK $STATIC $STRIP -tocdataref off -dead on -o $EXE -@filelist $RES'; + //DllCmd[1]:='PPCLink $OPT $INIT $FINI $SONAME -shared -o $EXE -@filelist $RES'; + end; +end; + + +Function TLinkerMPW.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + s,heapsizestr: string; + +begin + WriteResponseFile:=False; + { Open link.res file } + linkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + with linkRes do + begin + {#182 is escape char in MPW (analog to backslash in unix). The space} + {ensures there is whitespace separating items.} + Add('PPCLink '#182); + + { Add MPW standard libraries} + if apptype = app_cui then + Add('"{PPCLibraries}PPCSIOW.o" '#182); + + {Even GUI apps must link to PPCToolLibs, because of the System unit + which can be used by MPW tools as well as by GUI apps.} + Add('"{PPCLibraries}PPCToolLibs.o" '#182); + Add('"{SharedLibraries}InterfaceLib" '#182); + Add('"{SharedLibraries}StdCLib" '#182); + Add('"{SharedLibraries}MathLib" '#182); + Add('"{PPCLibraries}StdCRuntime.o" '#182); + Add('"{PPCLibraries}PPCCRuntime.o" '#182); + + {Add main objectfiles} + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + Add(s+' '#182); + end; + + {Add last lines of the link command} + if apptype = app_tool then + Add('-t "MPST" -c "MPS " '#182); + + if apptype = app_cui then {If SIOW, to avoid some warnings.} + Add('-ignoredups __start -ignoredups .__start -ignoredups main -ignoredups .main -ignoredups qd '#182); + + Add('-tocdataref off -sym on -dead on -o '+ ScriptFixFileName(current_module.exefilename^)); + + Add('Exit If "{Status}" != 0'); + + if heapsize = 0 then + heapsizestr:= HexStr(384000, 8) + else + heapsizestr:= HexStr(heapsize, 8); + + {Add a SIZE resource on the fly. It controls: + * backgrounding is enabled, to facilitate debuging with Power Mac Debugger + * it is signaled it is a 32 bit app. (perhaps not nessecary on PowerPC) + * heapsize } + if apptype <> app_tool then + begin + Add('Echo "data ''SIZE'' (-1) '#182'{ $'#182'"1080 ' + heapsizestr + ' ' + heapsizestr + + #182'" '#182'};" | Rez -a -o ' + ScriptFixFileName(current_module.exefilename^)); + Add('Exit If "{Status}" != 0'); + end; + + {Add mac resources} + if apptype = app_cui then + begin + Add('Rez -a "{RIncludes}"SIOW.r -o ' + ScriptFixFileName(current_module.exefilename^)); + Add('Exit If "{Status}" != 0'); + end; + + while not (current_module.ResourceFiles.Empty) do + begin + s := Current_module.ResourceFiles.GetFirst; + if Copy(s,Length(s)-1,Length(s)) = '.r' then + Add('Rez -a ' + s + ' -o ' + ScriptFixFileName(current_module.exefilename^)) + else + Add('DeRez ' + s + ' | Rez -a -o ' + ScriptFixFileName(current_module.exefilename^)); + Add('Exit If "{Status}" != 0'); + end; + + end; + + { Write and Close response } + linkres.writetodisk; + linkres.Free; + + WriteResponseFile:=True; +end; + + +function TLinkerMPW.MakeExecutable:boolean; +var + binstr, + cmdstr : TCmdStr; + success : boolean; + DynLinkStr : string[60]; + StaticStr, + StripStr : string[40]; +begin + //TODO Only external link in MPW is possible, otherwise yell. + + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + StripStr:=''; + StaticStr:=''; + DynLinkStr:=''; +(* + if (cs_link_staticflag in current_settings.globalswitches) then + StaticStr:='-static'; + if (cs_link_strip in current_settings.globalswitches) then + StripStr:='-s'; + If (cs_profile in current_settings.moduleswitches) or + ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then + DynLinkStr:='-dynamic-linker='+Info.DynamicLinker; +*) + +{ Prepare linking } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(ScriptFixFileName(current_module.exefilename^))); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(ScriptFixFileName(outputexedir+Info.ResName))); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + + WriteResponseFile(false); + + success:= true; + if cs_link_on_target in current_settings.globalswitches then + success:=DoExec('SetFile', ' -c ''MPS '' -t ''TEXT'' ' + + ScriptFixFileName(outputexedir+Info.ResName),true,false); + +{ Call linker } + if success then + success:=DoExec('Execute',CmdStr,true,false); + +{ Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef m68k} + RegisterTarget(system_m68k_macos_info); + RegisterImport(system_m68k_macos,timportlibmacos); +{$endif m68k} +{$ifdef powerpc} + RegisterExternalLinker(system_powerpc_macos_info,TLinkerMPW); + RegisterTarget(system_powerpc_macos_info); + RegisterImport(system_powerpc_macos,timportlibmacos); +{$endif powerpc} +end. diff --git a/closures/compiler/systems/t_morph.pas b/closures/compiler/systems/t_morph.pas new file mode 100644 index 0000000000..8409ba1eeb --- /dev/null +++ b/closures/compiler/systems/t_morph.pas @@ -0,0 +1,260 @@ +{ + Copyright (c) 2004 by Free Pascal Development Team + + This unit implements support import, export, link routines + for the MorphOS (PowerPC) target + + 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 t_morph; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + SysUtils, + cutils,cfileutl,cclasses, + globtype,globals,systems,verbose,script,fmodule,i_morph,link; + + type + PlinkerMorphOS=^TlinkerMorphOS; + TlinkerMorphOS=class(texternallinker) + private + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create; override; + procedure SetDefaultInfo; override; + function MakeExecutable:boolean; override; + end; + + +{**************************************************************************** + TLinkerMorphOS +****************************************************************************} + +Constructor TLinkerMorphOS.Create; +begin + Inherited Create; + { allow duplicated libs (PM) } + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; +end; + + +procedure TLinkerMorphOS.SetDefaultInfo; +begin + with Info do + begin + if (cs_link_on_target in current_settings.globalswitches) then + begin + ExeCmd[1]:='ld $OPT -o $EXE $RES'; + ExeCmd[2]:='strip --strip-unneeded --remove-section .comment $EXE'; + end + else + begin + ExeCmd[1]:='fpcvlink -b elf32amiga $OPT $STRIP -o $EXE -T $RES'; + end; + end; +end; + + +Function TLinkerMorphOS.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + i : longint; + HPath : TCmdStrListItem; + s : string; + linklibc : boolean; +begin + WriteResponseFile:=False; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + s:=HPath.Str; + if (cs_link_on_target in current_settings.globalswitches) then + s:=ScriptFixFileName(s); + LinkRes.Add('-L'+s); + HPath:=TCmdStrListItem(HPath.Next); + end; + HPath:=TCmdStrListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + s:=HPath.Str; + if s<>'' then + LinkRes.Add('SEARCH_DIR('+Unix2AmigaPath(maybequoted(s))+')'); + HPath:=TCmdStrListItem(HPath.Next); + end; + + LinkRes.Add('INPUT ('); + { add objectfiles, start with prt0 always } + s:=FindObjectFile('prt0','',false); + LinkRes.AddFileName(s); + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + begin + { vlink doesn't use SEARCH_DIR for object files } + if not(cs_link_on_target in current_settings.globalswitches) then + s:=FindObjectFile(s,'',false); + LinkRes.AddFileName(Unix2AmigaPath(maybequoted(s))); + end; + end; + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + { vlink doesn't need, and doesn't support GROUP } + if (cs_link_on_target in current_settings.globalswitches) then + begin + LinkRes.Add(')'); + LinkRes.Add('GROUP('); + end; + while not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(Unix2AmigaPath(maybequoted(s))); + end; + end; + + if (cs_link_on_target in current_settings.globalswitches) then + begin + LinkRes.Add(')'); + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + linklibc:=false; + while not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + begin + LinkRes.Add('-l'+s); + linklibc:=true; + end; + end; + { be sure that libc&libgcc is the last lib } + if linklibc then + begin + LinkRes.Add('-lc'); + LinkRes.Add('-lgcc'); + end; + end + else + begin + while not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + LinkRes.Add('lib'+s+target_info.staticlibext); + end; + LinkRes.Add(')'); + end; + + +{ Write and Close response } + linkres.writetodisk; + linkres.free; + + WriteResponseFile:=True; + +end; + + +function TLinkerMorphOS.MakeExecutable:boolean; +var + binstr, + cmdstr : TCmdStr; + success : boolean; + StripStr: string[40]; +begin + + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + + if not (cs_link_on_target in current_settings.globalswitches) then + begin + StripStr:=''; + if (cs_link_strip in current_settings.globalswitches) then + StripStr:='-s -P __abox__'; + end; + +{ Write used files and libraries } + WriteResponseFile(false); + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + if not(cs_link_on_target in current_settings.globalswitches) then + begin + Replace(cmdstr,'$EXE',Unix2AmigaPath(maybequoted(ScriptFixFileName(current_module.exefilename^)))); + Replace(cmdstr,'$RES',Unix2AmigaPath(maybequoted(ScriptFixFileName(outputexedir+Info.ResName)))); + Replace(cmdstr,'$STRIP',StripStr); + end + else + begin + Replace(cmdstr,'$EXE',maybequoted(ScriptFixFileName(current_module.exefilename^))); + Replace(cmdstr,'$RES',maybequoted(ScriptFixFileName(outputexedir+Info.ResName))); + end; + success:=DoExec(FindUtil(BinStr),cmdstr,true,false); + +{ Stripping Enabled? } + { For MorphOS a separate strip command is needed, to avoid stripping } + { __abox__ symbol, which is required to be present in current MorphOS } + { executables. } + if (cs_link_on_target in current_settings.globalswitches) then + begin + if success and (cs_link_strip in current_settings.globalswitches) then + begin + SplitBinCmd(Info.ExeCmd[2],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,true,false); + end; + end; + +{ Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } + +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterExternalLinker(system_powerpc_morphos_info,TLinkerMorphOS); + RegisterTarget(system_powerpc_morphos_info); +end. diff --git a/closures/compiler/systems/t_nativent.pas b/closures/compiler/systems/t_nativent.pas new file mode 100644 index 0000000000..e4b8fc1329 --- /dev/null +++ b/closures/compiler/systems/t_nativent.pas @@ -0,0 +1,94 @@ +{ + Copyright (c) 2009 by Sven Barth + + This unit implements support import,export,link routines + for the Native NT Target + + 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 t_nativent; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + SysUtils, + cutils, + ogbase,ogcoff, + globtype,globals,systems,verbose, + import,export,link,t_win,i_nativent; + + + type + TImportLibNativeNT=class(TImportLibWin) + end; + + TExportLibNativeNT=class(TExportLibWin) + end; + + TInternalLinkerNativeNT = class(TInternalLinkerWin) + constructor create;override; + procedure ConcatEntryName; override; + end; + +{**************************************************************************** + TInternalLinkerNativeNT +****************************************************************************} + + constructor TInternalLinkerNativeNT.create; + begin + inherited create; + CExeoutput:=TPECoffexeoutput; + CObjInput:=TPECoffObjInput; + end; + + procedure TInternalLinkerNativeNT.ConcatEntryName; + begin + with LinkScript do + begin + if IsSharedLibrary then + begin + // for now we use {$apptype native} for kernel mode code + if apptype=app_native then + Concat('ENTRYNAME _NtDriverEntry') + else + Concat('ENTRYNAME _DLLMainStartup') + end + else + Concat('ENTRYNAME _NtProcessStartup'); + end; + end; + + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef i386} + { NativeNT } + RegisterInternalLinker(system_i386_nativent_info,TInternalLinkerNativeNT); + RegisterImport(system_i386_nativent,TImportLibNativeNT); + RegisterExport(system_i386_nativent,TExportLibNativeNT); +// RegisterRes(res_gnu_windres_info,TWinLikeResourceFile); + RegisterTarget(system_i386_nativent_info); +{$endif i386} +end. diff --git a/closures/compiler/systems/t_nds.pas b/closures/compiler/systems/t_nds.pas new file mode 100644 index 0000000000..93350dd8b4 --- /dev/null +++ b/closures/compiler/systems/t_nds.pas @@ -0,0 +1,780 @@ +{ + This unit implements support import,export,link routines + for the (arm) Nintendo DS target + + Copyright (c) 2001-2002 by Peter Vreman + + 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 t_nds; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + aasmbase, + SysUtils, + cutils,cfileutl,cclasses, + globtype,globals,systems,verbose,script,fmodule,i_nds,link; + + type + TlinkerNDS=class(texternallinker) + private + Function WriteResponseFile: Boolean; + public + constructor Create; override; + procedure SetDefaultInfo; override; + function MakeExecutable:boolean; override; + end; + + + +{***************************************************************************** + TLINKERNDS +*****************************************************************************} + +Constructor TLinkerNDS.Create; +begin + Inherited Create; + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; + // set arm9 as default apptype + if (apptype <> app_arm9) or (apptype <> app_arm7) then + apptype := app_arm9; +end; + + +procedure TLinkerNDS.SetDefaultInfo; +begin + with Info do + begin + ExeCmd[1]:='ld -g $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE -T $RES'; + end; +end; + + +Function TLinkerNDS.WriteResponseFile: Boolean; +Var + linkres : TLinkRes; + i : longint; + HPath : TCmdStrListItem; + s,s1,s2 : TCmdStr; + prtobj, + cprtobj : string[80]; + linklibc, + linklibgcc : boolean; + found1, + found2 : boolean; +begin + WriteResponseFile:=False; + linklibc:=(SharedLibFiles.Find('c')<>nil); + linklibgcc:=(SharedLibFiles.Find('gcc')<>nil); + + case apptype of + app_arm9: + begin + prtobj:='prt09'; + cprtobj:='cprt09'; + end; + app_arm7: + begin + prtobj:='prt07'; + cprtobj:='cprt07'; + end; + end; + + if (linklibc or linklibgcc) then + prtobj:=cprtobj; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + s:=HPath.Str; + if (cs_link_on_target in current_settings.globalswitches) then + s:=ScriptFixFileName(s); + LinkRes.Add('-L'+s); + HPath:=TCmdStrListItem(HPath.Next); + end; + HPath:=TCmdStrListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + s:=HPath.Str; + if s<>'' then + LinkRes.Add('SEARCH_DIR('+(maybequoted(s))+')'); + HPath:=TCmdStrListItem(HPath.Next); + end; + + LinkRes.Add('INPUT ('); + { add objectfiles, start with prt0 always } + if prtobj<>'' then + s:=FindObjectFile(prtobj,'',false); + LinkRes.AddFileName(s); + { try to add crti and crtbegin if linking to C } + if linklibc then + begin + if librarysearchpath.FindFile('crti.o',false,s) then + LinkRes.AddFileName(s); + end; + if linklibgcc then + begin + if librarysearchpath.FindFile('crtbegin.o',false,s) then + LinkRes.AddFileName(s); + end; + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + begin + { vlink doesn't use SEARCH_DIR for object files } + if not(cs_link_on_target in current_settings.globalswitches) then + s:=FindObjectFile(s,'',false); + LinkRes.AddFileName((maybequoted(s))); + end; + end; + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + { vlink doesn't need, and doesn't support GROUP } + if (cs_link_on_target in current_settings.globalswitches) then + begin + LinkRes.Add(')'); + LinkRes.Add('GROUP('); + end; + while not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName((maybequoted(s))); + end; + end; + + if (cs_link_on_target in current_settings.globalswitches) then + begin + LinkRes.Add(')'); + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + linklibc:=false; + linklibgcc:=false; + while not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + begin + LinkRes.Add('-l'+s); + linklibc:=true; + linklibgcc:=true; + end; + end; + { be sure that libc&libgcc is the last lib } + if linklibgcc then + begin + LinkRes.Add('-lgcc'); + end; + if linklibc then + begin + LinkRes.Add('-lc'); + end; + end + else + begin + while not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + LinkRes.Add('lib'+s+target_info.staticlibext); + end; + LinkRes.Add(')'); + end; + + { objects which must be at the end } + if linklibgcc then + begin + found1:=librarysearchpath.FindFile('crtend.o',false,s1); + if found1 then + begin + LinkRes.Add('INPUT('); + if found1 then + LinkRes.AddFileName(s1); + LinkRes.Add(')'); + end; + end; + if linklibc then + begin + found2:=librarysearchpath.FindFile('crtn.o',false,s2); + if found2 then + begin + LinkRes.Add('INPUT('); + if found2 then + LinkRes.AddFileName(s2); + LinkRes.Add(')'); + end; + end; + + with linkres do + begin + if apptype=app_arm9 then //ARM9 + begin + add('OUTPUT_FORMAT("elf32-littlearm", "elf32-bigarm", "elf32-littlearm")'); + add('OUTPUT_ARCH(arm)'); + add('ENTRY(_start)'); + add(''); + add('MEMORY {'); + add(''); + add(' rom : ORIGIN = 0x08000000, LENGTH = 32M'); + add(' ewram : ORIGIN = 0x02000000, LENGTH = 4M - 4k'); + add(' dtcm : ORIGIN = 0x0b000000, LENGTH = 16K'); + add(' vectors : ORIGIN = 0x01000000, LENGTH = 256'); + add(' itcm : ORIGIN = 0x01000100, LENGTH = 32K - 256'); + add('}'); + add(''); + add('__vectors_start = ORIGIN(vectors);'); + add('__itcm_start = ORIGIN(itcm);'); + add('__ewram_end = ORIGIN(ewram) + LENGTH(ewram);'); + add('__eheap_end = ORIGIN(ewram) + LENGTH(ewram);'); + add('__dtcm_start = ORIGIN(dtcm);'); + add('__dtcm_top = ORIGIN(dtcm) + LENGTH(dtcm);'); + add('__irq_flags = __dtcm_top - 0x08;'); + add('__irq_vector = __dtcm_top - 0x04;'); + add(''); + add('__sp_svc = __dtcm_top - 0x100;'); + add('__sp_irq = __sp_svc - 0x100;'); + add('__sp_usr = __sp_irq - 0x100;'); + add(''); + add('SECTIONS'); + add('{'); + add(' .init :'); + add(' {'); + add(' __text_start = . ;'); + add(' KEEP (*(.init))'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >ewram = 0xff'); + add(''); + add(' .plt : { *(.plt) } >ewram = 0xff'); + add(''); + add(' .text : /* ALIGN (4): */'); + add(' {'); + add(' *(EXCLUDE_FILE (*.itcm*) .text)'); + add(''); + add(' *(.text.*)'); + add(' *(.stub)'); + add(' /* .gnu.warning sections are handled specially by elf32.em. */'); + add(' *(.gnu.warning)'); + add(' *(.gnu.linkonce.t*)'); + add(' *(.glue_7)'); + add(' *(.glue_7t)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >ewram = 0xff'); + add(''); + add(' .fini :'); + add(' {'); + add(' KEEP (*(.fini))'); + add(' } >ewram =0xff'); + add(''); + add(' __text_end = . ;'); + add(''); + add(' .rodata :'); + add(' {'); + add(' *(.rodata)'); + add(' *all.rodata*(*)'); + add(' *(.roda)'); + add(' *(.rodata.*)'); + add(' *(.gnu.linkonce.r*)'); + add(' SORT(CONSTRUCTORS)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >ewram = 0xff'); + add(''); + add(' .ARM.extab : { *(.ARM.extab* .gnu.linkonce.armextab.*) } >ewram'); + add(' __exidx_start = .;'); + add(' .ARM.exidx : { *(.ARM.exidx* .gnu.linkonce.armexidx.*) } >ewram'); + add(' __exidx_end = .;'); + add(' /* Ensure the __preinit_array_start label is properly aligned. We'); + add(' could instead move the label definition inside the section, but'); + add(' the linker would then create the section even if it turns out to'); + add(' be empty, which isn''t pretty. */'); + add(' . = ALIGN(32 / 8);'); + add(' PROVIDE (__preinit_array_start = .);'); + add(' .preinit_array : { KEEP (*(.preinit_array)) } >ewram = 0xff'); + add(' PROVIDE (__preinit_array_end = .);'); + add(' PROVIDE (__init_array_start = .);'); + add(' .init_array :'); + add(' {'); + add(' KEEP (*(SORT(.init_array.*)))'); + add(' KEEP (*(.init_array))'); + add(' } >ewram = 0xff'); + add(' PROVIDE (__init_array_end = .);'); + add(' PROVIDE (__fini_array_start = .);'); + add(' .fini_array :'); + add(' {'); + add(' KEEP (*(.fini_array))'); + add(' KEEP (*(SORT(.fini_array.*)))'); + add(' } >ewram = 0xff'); + add(' PROVIDE (__fini_array_end = .);'); + add(''); + add(' .ctors :'); + add(' {'); + add(' /* gcc uses crtbegin.o to find the start of the constructors, so'); + add(' we make sure it is first. Because this is a wildcard, it'); + add(' doesn''t matter if the user does not actually link against'); + add(' crtbegin.o; the linker won''t look for a file to match a'); + add(' wildcard. The wildcard also means that it doesn''t matter which'); + add(' directory crtbegin.o is in. */'); + add(' KEEP (*crtbegin.o(.ctors))'); + add(' KEEP (*(EXCLUDE_FILE (*crtend.o) .ctors))'); + add(' KEEP (*(SORT(.ctors.*)))'); + add(' KEEP (*(.ctors))'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >ewram = 0xff'); + add(''); + add(' .dtors :'); + add(' {'); + add(' KEEP (*crtbegin.o(.dtors))'); + add(' KEEP (*(EXCLUDE_FILE (*crtend.o) .dtors))'); + add(' KEEP (*(SORT(.dtors.*)))'); + add(' KEEP (*(.dtors))'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >ewram = 0xff'); + add(''); + add(' .eh_frame :'); + add(' {'); + add(' KEEP (*(.eh_frame))'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >ewram = 0xff'); + add(''); + add(' .gcc_except_table :'); + add(' {'); + add(' *(.gcc_except_table)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >ewram = 0xff'); + add(' .jcr : { KEEP (*(.jcr)) } >ewram = 0'); + add(' .got : { *(.got.plt) *(.got) *(.rel.got) } >ewram = 0'); + add(''); + add(' .ewram ALIGN(4) : '); + add(' {'); + add(' __ewram_start = ABSOLUTE(.) ;'); + add(' *(.ewram)'); + add(' *ewram.*(.text)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >ewram = 0xff'); + add(''); + add(''); + add(' .data ALIGN(4) :'); + add(' {'); + add(' __data_start = ABSOLUTE(.);'); + add(' *(.data)'); + add(' *(.data.*)'); + add(' *(.gnu.linkonce.d*)'); + add(' *(.fpc*)'); + add(' CONSTRUCTORS'); + add(' . = ALIGN(4);'); + add(' __data_end = ABSOLUTE(.) ;'); + add(' } >ewram = 0xff'); + add(''); + add(''); + add(' __dtcm_lma = . ;'); + add(' __bss_vma = . ;'); + add(''); + add(' .dtcm __dtcm_start : AT (__dtcm_lma)'); + add(' {'); + add(' *(.dtcm)'); + add(' *(.dtcm.*)'); + add(' . = ALIGN(4);'); + add(' __dtcm_end = ABSOLUTE(.);'); + add(' } >dtcm = 0xff'); + add(''); + add(''); + add(' __itcm_lma = __dtcm_lma + SIZEOF(.dtcm);'); + add(''); + add(' .itcm __itcm_start : AT (__itcm_lma)'); + add(' {'); + add(' *(.itcm)'); + add(' *itcm.*(.text)'); + add(' . = ALIGN(4);'); + add(' __itcm_end = ABSOLUTE(.);'); + add(' } >itcm = 0xff'); + add(''); + + add(' __vectors_lma = __itcm_lma + SIZEOF(.itcm);'); + add(' .vectors __vectors_start : AT (__vectors_lma)'); + add(' {'); + add(' *(.vectors)'); + add(' *vectors.*(.text)'); + add(' . = ALIGN(4);'); + add(' __vectors_end = ABSOLUTE(.);'); + add(' } >vectors = 0xff'); + add(''); + add(' .sbss __dtcm_end (NOLOAD):'); + add(' {'); + add(' __sbss_start = ABSOLUTE(.);'); + add(' __sbss_start__ = ABSOLUTE(.);'); + add(' *(.sbss)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' __sbss_end = ABSOLUTE(.);'); + add(' } >dtcm'); + add(''); + add(''); + add(''); + add(' .bss __bss_vma (NOLOAD):'); + add(' {'); + add(' __bss_start = ABSOLUTE(.);'); + add(' __bss_start__ = ABSOLUTE(.);'); + add(' *(.dynbss)'); + add(' *(.gnu.linkonce.b*)'); + add(' *(.bss*)'); + add(' *(COMMON)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' __bss_end__ = ABSOLUTE(.) ;'); + add(' __end__ = ABSOLUTE(.) ;'); + add(' } AT>ewram'); + add(''); + add(''); + add(' /* Stabs debugging sections. */'); + add(' .stab 0 : { *(.stab) }'); + add(' .stabstr 0 : { *(.stabstr) }'); + add(' .stab.excl 0 : { *(.stab.excl) }'); + add(' .stab.exclstr 0 : { *(.stab.exclstr) }'); + add(' .stab.index 0 : { *(.stab.index) }'); + add(' .stab.indexstr 0 : { *(.stab.indexstr) }'); + add(' .comment 0 : { *(.comment) }'); + add(' /* DWARF debug sections.'); + add(' Symbols in the DWARF debugging sections are relative to the beginning'); + add(' of the section so we begin them at 0. */'); + add(' /* DWARF 1 */'); + add(' .debug 0 : { *(.debug) }'); + add(' .line 0 : { *(.line) }'); + add(' /* GNU DWARF 1 extensions */'); + add(' .debug_srcinfo 0 : { *(.debug_srcinfo) }'); + add(' .debug_sfnames 0 : { *(.debug_sfnames) }'); + add(' /* DWARF 1.1 and DWARF 2 */'); + add(' .debug_aranges 0 : { *(.debug_aranges) }'); + add(' .debug_pubnames 0 : { *(.debug_pubnames) }'); + add(' /* DWARF 2 */'); + add(' .debug_info 0 : { *(.debug_info) }'); + add(' .debug_abbrev 0 : { *(.debug_abbrev) }'); + add(' .debug_line 0 : { *(.debug_line) }'); + add(' .debug_frame 0 : { *(.debug_frame) }'); + add(' .debug_str 0 : { *(.debug_str) }'); + add(' .debug_loc 0 : { *(.debug_loc) }'); + add(' .debug_macinfo 0 : { *(.debug_macinfo) }'); + add(' /* SGI/MIPS DWARF 2 extensions */'); + add(' .debug_weaknames 0 : { *(.debug_weaknames) }'); + add(' .debug_funcnames 0 : { *(.debug_funcnames) }'); + add(' .debug_typenames 0 : { *(.debug_typenames) }'); + add(' .debug_varnames 0 : { *(.debug_varnames) }'); + add(' .stack 0x80000 : { _stack = .; *(.stack) }'); + add(' /* These must appear regardless of . */'); + add('}'); + end; + if apptype=app_arm7 then + begin + add('OUTPUT_FORMAT("elf32-littlearm", "elf32-bigarm", "elf32-littlearm")'); + add('OUTPUT_ARCH(arm)'); + add('ENTRY(_start)'); + add(''); + add('MEMORY {'); + add(''); + add(' rom : ORIGIN = 0x08000000, LENGTH = 32M'); + add(' iwram : ORIGIN = 0x037f8000, LENGTH = 96K'); + add('}'); + add(''); + add('__iwram_start = ORIGIN(iwram);'); + add('__iwram_top = ORIGIN(iwram)+ LENGTH(iwram);'); + add('__sp_irq = __iwram_top - 0x100;'); + add('__sp_svc = __sp_irq - 0x100;'); + add('__sp_usr = __sp_svc - 0x100;'); + add(''); + add('__irq_flags = 0x04000000 - 8;'); + add('__irq_flagsaux = 0x04000000 - 0x40;'); + add('__irq_vector = 0x04000000 - 4;'); + add(''); + add('SECTIONS'); + add('{'); + add(' .init :'); + add(' {'); + add(' __text_start = . ;'); + add(' KEEP (*(.init))'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >iwram = 0xff'); + add(' .plt : { *(.plt) } >iwram = 0xff'); + add(''); + add(' .text : /* ALIGN (4): */'); + add(' {'); + add(''); + add(' *(.text .stub .text.* .gnu.linkonce.t.*)'); + add(' KEEP (*(.text.*personality*))'); + add(' /* .gnu.warning sections are handled specially by elf32.em. */'); + add(' *(.gnu.warning)'); + add(' *(.glue_7t) *(.glue_7) *(.vfp11_veneer)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >iwram = 0xff'); + add(''); + add(' .fini :'); + add(' {'); + add(' KEEP (*(.fini))'); + add(' } >iwram =0xff'); + add(''); + add(' __text_end = . ;'); + add(''); + add(' .rodata :'); + add(' {'); + add(' *(.rodata)'); + add(' *all.rodata*(*)'); + add(' *(.roda)'); + add(' *(.rodata.*)'); + add(' *(.gnu.linkonce.r*)'); + add(' SORT(CONSTRUCTORS)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >iwram = 0xff'); + add(''); + add(' .ARM.extab : { *(.ARM.extab* .gnu.linkonce.armextab.*) } >iwram'); + add(' __exidx_start = .;'); + add(' .ARM.exidx : { *(.ARM.exidx* .gnu.linkonce.armexidx.*) } >iwram'); + add(' __exidx_end = .;'); + add(''); + add('/* Ensure the __preinit_array_start label is properly aligned. We'); + add(' could instead move the label definition inside the section, but'); + add(' the linker would then create the section even if it turns out to'); + add(' be empty, which isn''t pretty. */'); + add(' . = ALIGN(32 / 8);'); + add(' PROVIDE (__preinit_array_start = .);'); + add(' .preinit_array : { KEEP (*(.preinit_array)) } >iwram = 0xff'); + add(' PROVIDE (__preinit_array_end = .);'); + add(' PROVIDE (__init_array_start = .);'); + add(' .init_array : { KEEP (*(.init_array)) } >iwram = 0xff'); + add(' PROVIDE (__init_array_end = .);'); + add(' PROVIDE (__fini_array_start = .);'); + add(' .fini_array : { KEEP (*(.fini_array)) } >iwram = 0xff'); + add(' PROVIDE (__fini_array_end = .);'); + add(''); + add(' .ctors :'); + add(' {'); + add(' /* gcc uses crtbegin.o to find the start of the constructors, so'); + add(' we make sure it is first. Because this is a wildcard, it'); + add(' doesn''t matter if the user does not actually link against'); + add(' crtbegin.o; the linker won''t look for a file to match a'); + add(' wildcard. The wildcard also means that it doesn''t matter which'); + add(' directory crtbegin.o is in. */'); + add(' KEEP (*crtbegin.o(.ctors))'); + add(' KEEP (*(EXCLUDE_FILE (*crtend.o) .ctors))'); + add(' KEEP (*(SORT(.ctors.*)))'); + add(' KEEP (*(.ctors))'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >iwram = 0xff'); + add(''); + add(' .dtors :'); + add(' {'); + add(' KEEP (*crtbegin.o(.dtors))'); + add(' KEEP (*(EXCLUDE_FILE (*crtend.o) .dtors))'); + add(' KEEP (*(SORT(.dtors.*)))'); + add(' KEEP (*(.dtors))'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >iwram = 0xff'); + add(''); + add(' .eh_frame :'); + add(' {'); + add(' KEEP (*(.eh_frame))'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >iwram = 0xff'); + add(''); + add(' .gcc_except_table :'); + add(' {'); + add(' *(.gcc_except_table)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' } >iwram = 0xff'); + add(' .jcr : { KEEP (*(.jcr)) } >iwram = 0'); + add(' .got : { *(.got.plt) *(.got) } >iwram = 0'); + add(''); + add(''); + add(' .iwram ALIGN(4) :'); + add(' {'); + add(' __iwram_start = ABSOLUTE(.) ;'); + add(' *(.iwram)'); + add(' *iwram.*(.text)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' __iwram_end = ABSOLUTE(.) ;'); + add(' } >iwram = 0xff'); + add(''); + add(''); + add(' .data ALIGN(4) : {'); + add(' __data_start = ABSOLUTE(.);'); + add(' *(.data)'); + add(' *(.data.*)'); + add(' *(.gnu.linkonce.d*)'); + add(' *(.fpc*)'); + add(' CONSTRUCTORS'); + add(' . = ALIGN(4);'); + add(' __data_end = ABSOLUTE(.) ;'); + add(' } >iwram = 0xff'); + add(''); + add(''); + add(''); + add(' .bss ALIGN(4) :'); + add(' {'); + add(' __bss_start = ABSOLUTE(.);'); + add(' __bss_start__ = ABSOLUTE(.);'); + add(' *(.dynbss)'); + add(' *(.gnu.linkonce.b*)'); + add(' *(.bss*)'); + add(' *(COMMON)'); + add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); + add(' __bss_end__ = ABSOLUTE(.);'); + add(' __end__ = ABSOLUTE(.);'); + add(' } >iwram'); + add(''); + add(' /* Stabs debugging sections. */'); + add(' .stab 0 : { *(.stab) }'); + add(' .stabstr 0 : { *(.stabstr) }'); + add(' .stab.excl 0 : { *(.stab.excl) }'); + add(' .stab.exclstr 0 : { *(.stab.exclstr) }'); + add(' .stab.index 0 : { *(.stab.index) }'); + add(' .stab.indexstr 0 : { *(.stab.indexstr) }'); + add(' .comment 0 : { *(.comment) }'); + add(' /* DWARF debug sections.'); + add(' Symbols in the DWARF debugging sections are relative to the beginning'); + add(' of the section so we begin them at 0. */'); + add(' /* DWARF 1 */'); + add(' .debug 0 : { *(.debug) }'); + add(' .line 0 : { *(.line) }'); + add(' /* GNU DWARF 1 extensions */'); + add(' .debug_srcinfo 0 : { *(.debug_srcinfo) }'); + add(' .debug_sfnames 0 : { *(.debug_sfnames) }'); + add(' /* DWARF 1.1 and DWARF 2 */'); + add(' .debug_aranges 0 : { *(.debug_aranges) }'); + add(' .debug_pubnames 0 : { *(.debug_pubnames) }'); + add(' /* DWARF 2 */'); + add(' .debug_info 0 : { *(.debug_info) }'); + add(' .debug_abbrev 0 : { *(.debug_abbrev) }'); + add(' .debug_line 0 : { *(.debug_line) }'); + add(' .debug_frame 0 : { *(.debug_frame) }'); + add(' .debug_str 0 : { *(.debug_str) }'); + add(' .debug_loc 0 : { *(.debug_loc) }'); + add(' .debug_macinfo 0 : { *(.debug_macinfo) }'); + add(' /* SGI/MIPS DWARF 2 extensions */'); + add(' .debug_weaknames 0 : { *(.debug_weaknames) }'); + add(' .debug_funcnames 0 : { *(.debug_funcnames) }'); + add(' .debug_typenames 0 : { *(.debug_typenames) }'); + add(' .debug_varnames 0 : { *(.debug_varnames) }'); + add(' .stack 0x80000 : { _stack = .; *(.stack) }'); + add(' /* These must appear regardless of . */'); + add('}'); + end; + end; + +{ Write and Close response } + linkres.writetodisk; + linkres.free; + + WriteResponseFile:=True; + +end; + + +function TLinkerNDS.MakeExecutable:boolean; +var + binstr, + cmdstr : TCmdStr; + success : boolean; + StaticStr, + GCSectionsStr, + DynLinkStr, + MapStr, + StripStr: string; + preName: string; +begin + { for future use } + StaticStr:=''; + StripStr:=''; + MapStr:=''; + DynLinkStr:=''; + case apptype of + app_arm9: preName:='.nef'; + app_arm7: preName:='.nlf'; + end; + + if (cs_link_strip in current_settings.globalswitches) and + not(cs_link_separate_dbg_file in current_settings.globalswitches) then + StripStr:='-s'; + if (cs_link_map in current_settings.globalswitches) then + StripStr:='-Map '+maybequoted(ChangeFileExt(current_module.exefilename^,'.map')); + if create_smartlink_sections then + GCSectionsStr:='--gc-sections'; + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Write used files and libraries } + WriteResponseFile(); + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + + Replace(cmdstr,'$EXE',(maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename^,preName))))); + Replace(cmdstr,'$RES',(maybequoted(ScriptFixFileName(outputexedir+Info.ResName)))); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$GCSECTIONS',GCSectionsStr); + Replace(cmdstr,'$MAP',MapStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + + success:=DoExec(FindUtil(utilsprefix+BinStr),cmdstr,true,false); + +{ Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + +{ Post process } + if success then + begin + success:=DoExec(FindUtil(utilsprefix + 'objcopy'), '-O binary '+ + ChangeFileExt(current_module.exefilename^, preName) + ' ' + + ChangeFileExt(current_module.exefilename^, preName+target_info.exeext), + true,false); + end; + + if success and (apptype=app_arm9) then + begin + success:=DoExec(FindUtil('ndstool'), '-c ' + + ChangeFileExt(current_module.exefilename^, '.nds') + ' -9 ' + + ChangeFileExt(current_module.exefilename^, preName+target_info.exeext), + true,false); + end; + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterExternalLinker(system_arm_nds_info,TLinkerNDS); + RegisterTarget(system_arm_nds_info); +end. diff --git a/closures/compiler/systems/t_nwl.pas b/closures/compiler/systems/t_nwl.pas new file mode 100644 index 0000000000..0cc59bf5ac --- /dev/null +++ b/closures/compiler/systems/t_nwl.pas @@ -0,0 +1,631 @@ +{ + Copyright (c) 1998-2004 by Peter Vreman + + This unit implements support import,export,link routines + for the (i386) Netware libc target + + 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. + + Currently generating NetWare-NLM's only work under Linux and win32. + (see http://home.arcor.de/armin.diehl/fpcnw for binutils working + with win32) while not included in fpc-releases. + + The following compiler-swiches are supported for NetWare: + $DESCRIPTION : NLM-Description, will be displayed at load-time + $M : For Stack-Size, Heap-Size will be ignored + 32K is the accepted minimum + $VERSION x.x.x : Sets Major, Minor and Revision + $SCREENNAME : Sets the ScreenName + $THREADNAME : Sets current threadname + + Additional parameters for the nlmvonv-inputfile can be passed with + -k, i.e. -kREENTRANT will add the option REENTRANT to the nlmconv + inputfile. A ; will be converted into a newline + + Exports will be handled like in win32: + procedure bla; cdecl; + begin + end; + + exports foo name 'Bar'; + + The path to the import-Files must be specified by the library-path. + All external modules are defined as autoload. (Note: the import-files have + to be in unix-format for exe2nlm) + By default, the most import files are included in freepascal. + + e.g. function getgrnam(name:Pchar):Pgroup;cdecl;external 'libc' 'getgrnam'; + sets IMPORT @libc.imp and MODULE libc. + To avoid setting the autoload, use ! in the name, e.g. + procedure EnterDebugger;cdecl;external '!netware' name 'EnterDebugger'; + + Function simply defined as external work without generating autoload and + IMPORT but you will get a warning from nlmconv. + + If you dont have nlmconv, compile gnu-binutils with + ./configure --enable-targets=i386-netware + make all + + Debugging is possible with gdb and a converter from gdb to ndi available + at http://home.arcor.de/armin.diehl/gdbnw + + A sample program: + + Program Hello; + (*$DESCRIPTION HelloWorldNlm*) + (*$VERSION 1.2.3*) + (*$ScreenName Hello*) + (*$M 60000,60000*) + begin + writeLn ('hello world'); + end. + + compile with: + ppc386 -Tnetwlibc hello + + Libraries are supported but this needs at least netware 5.1 sp6, + 6.0 sp3 or netware 6.5 + + In case there is a xdc file with the same name as the nlm name, + this file will be used for nlmconv. Otherwise a temp xdc will + be created and used. + +**************************************************************************** +} +unit t_nwl; + +{$i fpcdefs.inc} + +interface + + +implementation + +{$ifdef netwlibc} +{$define netware} +{$endif} + + uses + SysUtils, + cutils,cfileutl, + verbose,systems,globtype,globals, + symconst,script, + fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,symsym,symdef, + import,export,link,i_nwl,ogbase + {$ifdef netware} ,dos {$endif} + ; + + type + timportlibnetwlibc=class(timportlib) + procedure generatelib;override; + end; + + texportlibnetwlibc=class(texportlib) + procedure preparelib(const s : string);override; + procedure exportprocedure(hp : texported_item);override; + procedure exportvar(hp : texported_item);override; + procedure generatelib;override; + end; + + tlinkernetwlibc=class(texternallinker) + private + NLMConvLinkFile: TLinkRes; {for second pass, fist pass is ld} + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeNetwareLoadableModule (isLib : boolean):boolean; + function MakeExecutable:boolean;override; + function MakeSharedLibrary:boolean;override; + end; + +Const tmpLinkFileName = '~link~tmp.o'; + minStackSize = 32768; + +{***************************************************************************** + TIMPORTLIBNETWARE +*****************************************************************************} + + procedure timportlibnetwlibc.generatelib; + var + i : longint; + ImportLibrary : TImportLibrary; + begin + for i:=0 to current_module.ImportLibraryList.Count-1 do + begin + ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]); + current_module.linkothersharedlibs.add(ImportLibrary.Name,link_always); + end; + end; + + +{***************************************************************************** + TEXPORTLIBNETWARE +*****************************************************************************} + +procedure texportlibnetwlibc.preparelib(const s:string); +begin +end; + + +procedure texportlibnetwlibc.exportprocedure(hp : texported_item); +var + hp2 : texported_item; +begin + { first test the index value } + if (hp.options and eo_index)<>0 then + begin + Comment(V_Error,'can''t export with index under netware'); + exit; + end; + { use pascal name is none specified } + if (hp.options and eo_name)=0 then + begin + hp.name:=stringdup(hp.sym.name); + hp.options:=hp.options or eo_name; + end; + { now place in correct order } + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) and + (hp.name^>hp2.name^) do + hp2:=texported_item(hp2.next); + { insert hp there !! } + if assigned(hp2) and (hp2.name^=hp.name^) then + begin + { this is not allowed !! } + Message1(parser_e_export_name_double,hp.name^); + exit; + end; + if hp2=texported_item(current_module._exports.first) then + current_module._exports.insert(hp) + else if assigned(hp2) then + begin + hp.next:=hp2; + hp.previous:=hp2.previous; + if assigned(hp2.previous) then + hp2.previous.next:=hp; + hp2.previous:=hp; + end + else + current_module._exports.concat(hp); +end; + + +procedure texportlibnetwlibc.exportvar(hp : texported_item); +begin + hp.is_var:=true; + exportprocedure(hp); +end; + + +procedure texportlibnetwlibc.generatelib; +var + hp2 : texported_item; + pd : tprocdef; +begin + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) do + begin + if (not hp2.is_var) and + (hp2.sym.typ=procsym) then + begin + { the manglednames can already be the same when the procedure + is declared with cdecl } + pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]); + if pd.mangledname<>hp2.name^ then + begin +{$ifdef i386} + { place jump in al_procedures } + current_asmdata.asmlists[al_procedures].concat(Tai_align.Create_op(4,$90)); + current_asmdata.asmlists[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + current_asmdata.asmlists[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(pd.mangledname))); + current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); +{$endif i386} + end; + end + else + //Comment(V_Error,'Exporting of variables is not supported under netware'); + Message1(parser_e_no_export_of_variables_for_target,'netware'); + hp2:=texported_item(hp2.next); + end; +end; + + +{***************************************************************************** + TLINKERNETWARE +*****************************************************************************} + +Constructor TLinkerNetwlibc.Create; +begin + Inherited Create; +end; + + +procedure TLinkerNetwlibc.SetDefaultInfo; +begin + with Info do + begin + {$ifndef netware} + ExeCmd[1]:= FindUtil(utilsprefix+'ld') + ' -Ur -T $RES $STRIP -o $TMPOBJ'; + ExeCmd[2]:= FindUtil(utilsprefix+'nlmconv') + ' -T$RES'; + {$else} + {for running on netware we need absolute pathes since ld has another working directory} + ExeCmd[1]:= FindUtil(utilsprefix+'ld') + ' -Ur -T '+FExpand(outputexedir+Info.ResName)+' $STRIP -o '+Fexpand(outputexedir+tmpLinkFileName); + ExeCmd[2]:= FindUtil(utilsprefix+'nlmconv') + ' -T'+FExpand(outputexedir+'n'+Info.ResName); + {$endif} + end; +end; + + +Function TLinkerNetwlibc.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + i : longint; + s,s2,s3 : TCmdStr; + ProgNam : string [80]; + NlmNam : string [80]; + hp2 : texported_item; { for exports } + p : byte; +begin + WriteResponseFile:=False; + + ProgNam := current_module.exefilename^; + i:=Pos(target_info.exeext,ProgNam); + if i>0 then + Delete(ProgNam,i,255); + NlmNam := ProgNam + target_info.exeext; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); {for ld} + NLMConvLinkFile:=TLinkRes.Create(outputexedir+'n'+Info.ResName); {for nlmconv, written in CreateExeFile} + + p := Pos ('"', Description); + while (p > 0) do + begin + delete (Description,p,1); + p := Pos ('"', Description); + end; + if Description <> '' then + NLMConvLinkFile.Add('DESCRIPTION "' + Description + '"'); + NLMConvLinkFile.Add('VERSION '+tostr(dllmajor)+','+tostr(dllminor)+','+tostr(dllrevision)); + + p := Pos ('"', nwscreenname); + while (p > 0) do + begin + delete (nwscreenname,p,1); + p := Pos ('"', nwscreenname); + end; + p := Pos ('"', nwthreadname); + while (p > 0) do + begin + delete (nwthreadname,p,1); + p := Pos ('"', nwthreadname); + end; + p := Pos ('"', nwcopyright); + while (p > 0) do + begin + delete (nwcopyright,p,1); + p := Pos ('"', nwcopyright); + end; + + if nwscreenname <> '' then + NLMConvLinkFile.Add('SCREENNAME "' + nwscreenname + '"'); + if nwthreadname <> '' then + NLMConvLinkFile.Add('THREADNAME "' + nwthreadname + '"'); + if nwcopyright <> '' then + NLMConvLinkFile.Add('COPYRIGHT "' + nwcopyright + '"'); + + if stacksize < minStackSize then stacksize := minStackSize; + str (stacksize, s); + NLMConvLinkFile.Add ('STACKSIZE '+s); + {$ifndef netware} + NLMConvLinkFile.Add ('INPUT '+outputexedir+tmpLinkFileName); + {$else} + NLMConvLinkFile.Add ('INPUT '+FExpand(outputexedir+tmpLinkFileName)); + {$endif} + + { add objectfiles, start with nwpre always } + LinkRes.Add ('INPUT('); + s2 := FindObjectFile('nwplibc','',false); + if s2 = '' then + s2 := FindObjectFile('libcpre.gcc','',false); + Comment (V_Debug,'adding Object File '+s2); + {$ifndef netware} LinkRes.Add (s2); {$else} LinkRes.Add (FExpand(s2)); {$endif} + + if isDll then {needed to provide main} + s2 := FindObjectFile('nwl_dlle','',false) + else + s2 := FindObjectFile('nwl_main','',false); + Comment (V_Debug,'adding Object File '+s2); + {$ifndef netware} LinkRes.Add (s2); {$else} LinkRes.Add (FExpand(s2)); {$endif} + + { main objectfiles, add to linker input } + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + begin + s2 := FindObjectFile (s,'',false); + Comment (V_Debug,'adding Object File '+s2); + {$ifndef netware} LinkRes.Add (s2); {$else} LinkRes.Add (FExpand(s2)); {$endif} + end; + end; + LinkRes.Add (')'); + + { output file (nlm), add to nlmconv } + {$ifndef netware} + NLMConvLinkFile.Add ('OUTPUT ' + NlmNam); + {$else} + NLMConvLinkFile.Add ('OUTPUT ' + FExpand(NlmNam)); + {$endif} + + { start and stop-procedures } + NLMConvLinkFile.Add ('START _LibCPrelude'); + NLMConvLinkFile.Add ('EXIT _LibCPostlude'); + NLMConvLinkFile.Add ('CHECK _LibCCheckUnload'); + NLMConvLinkFile.Add ('REENTRANT'); { needed by older libc versions } + + if not (cs_link_strip in current_settings.globalswitches) then + begin + NLMConvLinkFile.Add ('DEBUG'); + Comment(V_Debug,'DEBUG'); + end; + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + LinkRes.Add ('GROUP('); + While not StaticLibFiles.Empty do + begin + S:=lower (StaticLibFiles.GetFirst); + if s<>'' then + begin + {ad: that's a hack ! + whith -XX we get the .a files as static libs (in addition to the + imported libraries} + if (pos ('.a',s) <> 0) OR (pos ('.A', s) <> 0) then + begin + S2 := FindObjectFile(s,'',false); + {$ifndef netware} LinkRes.Add (s2); {$else} LinkRes.Add (FExpand(s2)); {$endif} + Comment(V_Debug,'adding Object File (StaticLibFiles) '+S2); + end else + begin + i:=Pos(target_info.staticlibext,S); + if i>0 then + Delete(S,i,255); + S := S + '.imp'; S2 := ''; + librarysearchpath.FindFile(S,false,S2); + {$ifdef netware} + Comment(V_Debug,'IMPORT @'+s2); + s2 := FExpand (S2); + {$endif} + NLMConvLinkFile.Add('IMPORT @'+S2); + Comment(V_Debug,'IMPORT @'+s2); + end; + end + end; + LinkRes.Add (')'); + end; + + if not SharedLibFiles.Empty then + begin + While not SharedLibFiles.Empty do + begin + {because of upper/lower case mix, we may get duplicate + names but nlmconv ignores that. + Here we are setting the import-files for nlmconv. I.e. for + the module libc or libc.nlm we add IMPORT @libc.imp and also + the module libc.nlm (autoload) + If a lib name begins with !, only the IMPORT will be generated + ? may it be better to set autoload's via StaticLibFiles ? } + S:=lower (SharedLibFiles.GetFirst); + if s<>'' then + begin + s2:=s; + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + if s[1] = '!' then + begin // special, with ! only the imp will be included but no module is autoloaded, needed i.e. for netware.imp inlcuded in libc ndk + delete (s,1,1); + S := S + '.imp'; + librarysearchpath.FindFile(S,false,S3); + {$ifdef netware} + Comment(V_Debug,'IMPORT @'+S3); + S3 := FExpand (S3); + {$endif} + NLMConvLinkFile.Add('IMPORT @'+S3); + Comment(V_Debug,'IMPORT @'+S3); + end else + begin + S := S + '.imp'; + librarysearchpath.FindFile(S,false,S3); + {$ifdef netware} + Comment(V_Debug,'IMPORT @'+S3); + S3 := FExpand (S3); + {$endif} + NLMConvLinkFile.Add('IMPORT @'+S3); + NLMConvLinkFile.Add('MODULE '+s2); + Comment(V_Debug,'MODULE '+S2); + Comment(V_Debug,'IMPORT @'+S3); + end; + end + end; + end; + + { write exports } + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) do + begin + if not hp2.is_var then + begin + { Export the Symbol } + Comment(V_Debug,'EXPORT '+hp2.name^); + NLMConvLinkFile.Add ('EXPORT '+hp2.name^); + end + else + { really, i think it is possible } + {Comment(V_Error,'Exporting of variables is not supported under netware');} + Message1(parser_e_no_export_of_variables_for_target,'netware'); + hp2:=texported_item(hp2.next); + end; + +{ Write and Close response for ld, response for nlmconv is in NLMConvLinkFile(not written) } + linkres.writetodisk; + LinkRes.Free; + +{ pass options from -k to nlmconv, ; is interpreted as newline } + s := ParaLinkOptions; + while(Length(s) > 0) and (s[1] = ' ') do + delete (s,1,1); + p := pos ('"',s); + while p > 0 do + begin + delete (s,p,1); + p := pos ('"',s); + end; + + p := pos (';',s); + while p > 0 do + begin + s2 := copy(s,1,p-1); + comment (V_Debug,'adding "'+s2+'" to nlmvonv input'); + NLMConvLinkFile.Add(s2); + delete (s,1,p); + p := pos (';',s); + end; + if s <> '' then + begin + comment (V_Debug,'adding "'+s+'" to nlmvonv input'); + NLMConvLinkFile.Add(s); + end; + + WriteResponseFile:=True; +end; + +Const + xdc : Array[0..127] of char = ( + 'B','A','G','F',#2,#0,#0,#0,#1,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0, + #0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#2,#0,#0,#0,#0,#0,#0,#0,#16,#0,#0, + #0,#7,'M','P','K','_','B','a','g',#0,#0,#0,#0,#0,#0,#0,#0,#11,'M','T', + ' ','S','a','f','e',' ','N','L','M',#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,#1,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0,#0); + + +function TLinkerNetwlibc.MakeNetwareLoadableModule (isLib : boolean):boolean; +var + binstr, + cmdstr : TCmdStr; + xdcname : string; + success : boolean; + StripStr : string[2]; + xdcpresent,usexdc : boolean; + f : file; +begin + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + StripStr:=''; + + if (cs_link_strip in current_settings.globalswitches) then + StripStr:='-s'; + +{ Write used files and libraries and create Headerfile for + nlmconv in NLMConvLinkFile } + WriteResponseFile(isLib); + if isLib then + NLMConvLinkFile.Add('FLAG_ON 1024'); {0x400 Specifies whether the NLM is a shared library.} + +{ if we have a xdc file, dont touch it, otherwise create a new + one and remove it after nlmconv } + xdcname := ChangeFileExt(current_module.exefilename^,'.xdc'); + xdcpresent := FileExists (xdcname,false); + if not xdcpresent then + begin + assign (f,xdcname); + rewrite(f,1); + if ioresult = 0 then + begin + blockwrite (f,xdc,sizeof(xdc)); + close(f); + usexdc := (IOResult = 0); + end else + usexdc := false; + end else + usexdc := true; + + if usexdc then + NLMConvLinkFile.Add('XDCDATA '+xdcname); + +{ Call linker, this will generate a new object file that will be passed + to nlmconv. Otherwise we could not create nlms without debug info } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$TMPOBJ',maybequoted(outputexedir+tmpLinkFileName)); + Comment (v_debug,'Executing '+BinStr+' '+cmdstr); + success:=DoExec(BinStr,CmdStr,true,false); + + { Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + +{ Call nlmconv } + if success then + begin + NLMConvLinkFile.writetodisk; + NLMConvLinkFile.Free; + SplitBinCmd(Info.ExeCmd[2],binstr,cmdstr); + Replace(cmdstr,'$RES',maybequoted(outputexedir+'n'+Info.ResName)); + Comment (v_debug,'Executing '+BinStr+' '+cmdstr); + success:=DoExec(BinStr,CmdStr,true,false); + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + begin + DeleteFile(outputexedir+'n'+Info.ResName); + DeleteFile(outputexedir+tmpLinkFileName); + if not xdcpresent then + if usexdc then + DeleteFile (xdcname); + end; + end; + + MakeNetwareLoadableModule:=success; { otherwise a recursive call to link method } +end; + +function TLinkerNetwlibc.MakeExecutable:boolean; +begin + MakeExecutable := MakeNetwareLoadableModule (false); +end; + + +function TLinkerNetwlibc.MakeSharedLibrary:boolean; +begin + MakeSharedLibrary := MakeNetwareLoadableModule (true); +end; + +{***************************************************************************** + Initialize +*****************************************************************************} + + +initialization + RegisterExternalLinker(system_i386_netwlibc_info,TLinkerNetwlibc); + RegisterImport(system_i386_netwlibc,TImportLibNetwlibc); + RegisterExport(system_i386_netwlibc,TExportLibNetwlibc); + RegisterTarget(system_i386_netwlibc_info); +end. diff --git a/closures/compiler/systems/t_nwm.pas b/closures/compiler/systems/t_nwm.pas new file mode 100644 index 0000000000..e8fdbf62bc --- /dev/null +++ b/closures/compiler/systems/t_nwm.pas @@ -0,0 +1,988 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit implements support import,export,link routines + for the (i386) Netware target + + 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. + + Currently generating NetWare-NLM's only work under Linux and win32. + (see http://home.arcor.de/armin.diehl/fpcnw for binutils working + with win32) while not included in fpc-releases. + + The following compiler-swiches are supported for NetWare: + $DESCRIPTION : NLM-Description, will be displayed at load-time + $M : For Stack-Size, Heap-Size will be ignored + 32K is the accepted minimum + $VERSION x.x.x : Sets Major, Minor and Revision + $SCREENNAME : Sets the ScreenName + $THREADNAME : Sets current threadname + + Displaying copyright does not work with nlmconv from gnu bunutils + version less that 2.13 + + Additional parameters for the nlmvonv-inputfile can be passed with + -k, i.e. -kREENTRANT will add the option REENTRANT to the nlmconv + inputfile. A ; will be converted into a newline + + Exports will be handled like in win32: + procedure bla; + begin + end; + + exports foo name 'Bar'; + + The path to the import-Files must be specified by the library-path. + All external modules are defined as autoload. (Note: the import-files have + to be in unix-format for exe2nlm) + By default, the most import files are included in freepascal. + + i.e. Procedure ConsolePrintf (p:pchar); cdecl; external 'clib.nlm'; + sets IMPORT @clib.imp and MODULE clib. + + Function simply defined as external work without generating autoload but + you will get a warnung from nlmconv. + + If you dont have nlmconv, compile gnu-binutils with + ./configure --enable-targets=i386-linux,i386-netware + make all + + Debugging is possible with gdb and a converter from gdb to ndi available + at http://home.arcor.de/armin.diehl/gdbnw + + A sample program: + + Program Hello; + (*$DESCRIPTION HelloWorldNlm*) + (*$VERSION 1.2.3*) + (*$ScreenName Hello*) + (*$M 60000,60000*) + begin + writeLn ('hello world'); + end. + + compile with: + ppc386 -Tnetware hello + + ToDo: + - No duplicate imports and autoloads + - libc support (needs new target) + +**************************************************************************** +} +unit t_nwm; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + SysUtils, + cutils,cfileutl, + verbose,systems,globtype,globals, + symconst,script, + fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,symsym,symdef, + import,export,link,i_nwm,ogbase, ogcoff, ognlm, cclasses + {$ifdef netware} ,dos {$endif} + ; + + type + timportlibnetware=class(timportlib) + procedure generatelib;override; + end; + + texportlibnetware=class(texportlib) + procedure preparelib(const s : string);override; + procedure exportprocedure(hp : texported_item);override; + procedure exportvar(hp : texported_item);override; + procedure generatelib;override; + end; + + tlinkernetware=class(texternallinker) + private + NLMConvLinkFile: TLinkRes; {for second pass, fist pass is ld} + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + end; + + TInternalLinkerNetware = class(TInternalLinker) + prelude : string; + constructor create;override; + destructor destroy;override; + procedure DefaultLinkScript;override; + procedure InitSysInitUnitName;override; + procedure ConcatEntryName; virtual; + Function MakeSharedLibrary:boolean;override; + end; + +Const tmpLinkFileName = 'link~tmp._o_'; + minStackSize = 32768; + +{***************************************************************************** + TIMPORTLIBNETWARE +*****************************************************************************} + + procedure timportlibnetware.generatelib; + var + i : longint; + ImportLibrary : TImportLibrary; + begin + for i:=0 to current_module.ImportLibraryList.Count-1 do + begin + ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]); + current_module.linkothersharedlibs.add(ImportLibrary.Name,link_always); + end; + end; + + +{***************************************************************************** + TEXPORTLIBNETWARE +*****************************************************************************} + +procedure texportlibnetware.preparelib(const s:string); +begin +end; + + +procedure texportlibnetware.exportprocedure(hp : texported_item); +var + hp2 : texported_item; +begin + { first test the index value } + if (hp.options and eo_index)<>0 then + begin + Comment(V_Error,'can''t export with index under netware'); + exit; + end; + { use pascal name is none specified } + if (hp.options and eo_name)=0 then + begin + hp.name:=stringdup(hp.sym.name); + hp.options:=hp.options or eo_name; + end; + { now place in correct order } + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) and + (hp.name^>hp2.name^) do + hp2:=texported_item(hp2.next); + { insert hp there !! } + if assigned(hp2) and (hp2.name^=hp.name^) then + begin + { this is not allowed !! } + Message1(parser_e_export_name_double,hp.name^); + exit; + end; + if hp2=texported_item(current_module._exports.first) then + current_module._exports.insert(hp) + else if assigned(hp2) then + begin + hp.next:=hp2; + hp.previous:=hp2.previous; + if assigned(hp2.previous) then + hp2.previous.next:=hp; + hp2.previous:=hp; + end + else + current_module._exports.concat(hp); +end; + + +procedure texportlibnetware.exportvar(hp : texported_item); +begin + hp.is_var:=true; + exportprocedure(hp); +end; + + +procedure texportlibnetware.generatelib; +var + hp2 : texported_item; + pd : tprocdef; +begin + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) do + begin + if (not hp2.is_var) and + (hp2.sym.typ=procsym) then + begin + { the manglednames can already be the same when the procedure + is declared with cdecl } + pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]); + if pd.mangledname<>hp2.name^ then + begin +{$ifdef i386} + { place jump in al_procedures } + current_asmdata.asmlists[al_procedures].concat(Tai_align.Create_op(4,$90)); + current_asmdata.asmlists[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0)); + current_asmdata.asmlists[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(pd.mangledname))); + current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^)); +{$endif i386} + end; + end + else + //Comment(V_Error,'Exporting of variables is not supported under netware'); + Message1(parser_e_no_export_of_variables_for_target,'netware'); + hp2:=texported_item(hp2.next); + end; +end; + + +{***************************************************************************** + TLINKERNETWARE +*****************************************************************************} + +Constructor TLinkerNetware.Create; +begin + Inherited Create; +end; + + +procedure TLinkerNetware.SetDefaultInfo; +begin + with Info do + begin + {$ifndef netware} + ExeCmd[1]:= FindUtil(utilsprefix+'ld') + ' -Ur -T $RES $STRIP -o $TMPOBJ'; + ExeCmd[2]:= FindUtil(utilsprefix+'nlmconv') + ' -T$RES'; + {$else} + {for running on netware we need absolute pathes since ld has another working directory} + ExeCmd[1]:= FindUtil(utilsprefix+'ld') + ' -Ur -T '+FExpand(outputexedir+Info.ResName)+' $STRIP -o '+Fexpand(outputexedir+tmpLinkFileName); + ExeCmd[2]:= FindUtil(utilsprefix+'nlmconv') + ' -T'+FExpand(outputexedir+'n'+Info.ResName); + {$endif} + end; +end; + + +Function TLinkerNetware.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + i : longint; + s,s2,s3 : TCmdStr; + ProgNam : string [80]; + NlmNam : string [80]; + hp2 : texported_item; { for exports } + p : byte; +begin + WriteResponseFile:=False; + + ProgNam := current_module.exefilename^; + i:=Pos(target_info.exeext,ProgNam); + if i>0 then + Delete(ProgNam,i,255); + NlmNam := ProgNam + target_info.exeext; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); {for ld} + NLMConvLinkFile:=TLinkRes.Create(outputexedir+'n'+Info.ResName); {for nlmconv, written in CreateExeFile} + + p := Pos ('"', Description); + while (p > 0) do + begin + delete (Description,p,1); + p := Pos ('"', Description); + end; + if Description <> '' then + NLMConvLinkFile.Add('DESCRIPTION "' + Description + '"'); + NLMConvLinkFile.Add('VERSION '+tostr(dllmajor)+','+tostr(dllminor)+','+tostr(dllrevision)); + + p := Pos ('"', nwscreenname); + while (p > 0) do + begin + delete (nwscreenname,p,1); + p := Pos ('"', nwscreenname); + end; + p := Pos ('"', nwthreadname); + while (p > 0) do + begin + delete (nwthreadname,p,1); + p := Pos ('"', nwthreadname); + end; + p := Pos ('"', nwcopyright); + while (p > 0) do + begin + delete (nwcopyright,p,1); + p := Pos ('"', nwcopyright); + end; + + if nwscreenname <> '' then + NLMConvLinkFile.Add('SCREENNAME "' + nwscreenname + '"'); + if nwthreadname <> '' then + NLMConvLinkFile.Add('THREADNAME "' + nwthreadname + '"'); + if nwcopyright <> '' then + NLMConvLinkFile.Add('COPYRIGHT "' + nwcopyright + '"'); + + if stacksize < minStackSize then stacksize := minStackSize; + str (stacksize, s); + NLMConvLinkFile.Add ('STACKSIZE '+s); + {$ifndef netware} + NLMConvLinkFile.Add ('INPUT '+outputexedir+tmpLinkFileName); + {$else} + NLMConvLinkFile.Add ('INPUT '+FExpand(outputexedir+tmpLinkFileName)); + {$endif} + + { add objectfiles, start with nwpre always } + LinkRes.Add ('INPUT('); + if target_info.system = system_i386_netwlibc then + begin + s2 := FindObjectFile('nwplibc','',false); + if s2 = '' then + s2 := FindObjectFile('libcpre.gcc','',false); + end else + s2 := FindObjectFile('nwpre','',false); + Comment (V_Debug,'adding Object File '+s2); + {$ifndef netware} LinkRes.Add (s2); {$else} LinkRes.Add (FExpand(s2)); {$endif} + + if target_info.system = system_i386_netwlibc then + begin + if isDll then {needed to provide main} + s2 := FindObjectFile('nwl_dlle','',false) + else + s2 := FindObjectFile('nwl_main','',false); + Comment (V_Debug,'adding Object File '+s2); + {$ifndef netware} LinkRes.Add (s2); {$else} LinkRes.Add (FExpand(s2)); {$endif} + end; + + { main objectfiles, add to linker input } + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + begin + s2 := FindObjectFile (s,'',false); + Comment (V_Debug,'adding Object File '+s2); + {$ifndef netware} LinkRes.Add (s2); {$else} LinkRes.Add (FExpand(s2)); {$endif} + end; + end; + LinkRes.Add (')'); + + { output file (nlm), add to nlmconv } + {$ifndef netware} + NLMConvLinkFile.Add ('OUTPUT ' + NlmNam); + {$else} + NLMConvLinkFile.Add ('OUTPUT ' + FExpand(NlmNam)); + {$endif} + + { start and stop-procedures } + + if target_info.system = system_i386_netwlibc then + begin + NLMConvLinkFile.Add ('START _LibCPrelude'); + NLMConvLinkFile.Add ('EXIT _LibCPostlude'); + NLMConvLinkFile.Add ('CHECK _LibCCheckUnload'); + NLMConvLinkFile.Add ('REENTRANT'); { needed by older libc versions } + end else + begin + NLMConvLinkFile.Add ('START _Prelude'); { defined in rtl/netware/nwpre.as } + NLMConvLinkFile.Add ('EXIT _Stop'); { nwpre.as } + NLMConvLinkFile.Add ('CHECK FPC_NW_CHECKFUNCTION'); { system.pp } + end; + + + if not (cs_link_strip in current_settings.globalswitches) then + begin + NLMConvLinkFile.Add ('DEBUG'); + Comment(V_Debug,'DEBUG'); + end; + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + LinkRes.Add ('GROUP('); + While not StaticLibFiles.Empty do + begin + S:=lower (StaticLibFiles.GetFirst); + if s<>'' then + begin + {ad: that's a hack ! + whith -XX we get the .a files as static libs (in addition to the + imported libraries} + if (pos ('.a',s) <> 0) OR (pos ('.A', s) <> 0) then + begin + S2 := FindObjectFile(s,'',false); + {$ifndef netware} LinkRes.Add (s2); {$else} LinkRes.Add (FExpand(s2)); {$endif} + Comment(V_Debug,'adding Object File (StaticLibFiles) '+S2); + end else + begin + i:=Pos(target_info.staticlibext,S); + if i>0 then + Delete(S,i,255); + S := S + '.imp'; S2 := ''; + librarysearchpath.FindFile(S,false,S2); + {$ifdef netware} + Comment(V_Debug,'IMPORT @'+s2); + s2 := FExpand (S2); + {$endif} + NLMConvLinkFile.Add('IMPORT @'+S2); + Comment(V_Debug,'IMPORT @'+s2); + end; + end + end; + LinkRes.Add (')'); + end; + + if not SharedLibFiles.Empty then + begin + While not SharedLibFiles.Empty do + begin + {because of upper/lower case mix, we may get duplicate + names but nlmconv ignores that. + Here we are setting the import-files for nlmconv. I.e. for + the module clib or clib.nlm we add IMPORT @clib.imp and also + the module clib.nlm (autoload) + ? may it be better to set autoload's via StaticLibFiles ? } + S:=lower (SharedLibFiles.GetFirst); + if s<>'' then + begin + s2:=s; + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + if s[1] = '!' then + begin // special, with ! only the imp will be included but no module is autoloaded, needed i.e. for netware.imp + S := copy(S,2,255) + '.imp'; + librarysearchpath.FindFile(S,false,S3); + {$ifdef netware} + Comment(V_Debug,'IMPORT @'+S3); + S3 := FExpand (S3); + {$endif} + NLMConvLinkFile.Add('IMPORT @'+S3); + Comment(V_Debug,'IMPORT @'+S3); + end else + begin + S := S + '.imp'; + librarysearchpath.FindFile(S,false,S3); + {$ifdef netware} + Comment(V_Debug,'IMPORT @'+S3); + S3 := FExpand (S3); + {$endif} + NLMConvLinkFile.Add('IMPORT @'+S3); + NLMConvLinkFile.Add('MODULE '+s2); + Comment(V_Debug,'MODULE '+S2); + Comment(V_Debug,'IMPORT @'+S3); + end; + end; + end; + end; + + { write exports } + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) do + begin + if not hp2.is_var then + begin + { Export the Symbol } + Comment(V_Debug,'EXPORT '+hp2.name^); + NLMConvLinkFile.Add ('EXPORT '+hp2.name^); + end + else + { really, i think it is possible } + Message1(parser_e_no_export_of_variables_for_target,'netware'); + hp2:=texported_item(hp2.next); + end; + +{ Write and Close response for ld, response for nlmconv is in NLMConvLinkFile(not written) } + linkres.writetodisk; + LinkRes.Free; + +{ pass options from -k to nlmconv, ; is interpreted as newline } + s := ParaLinkOptions; + while(Length(s) > 0) and (s[1] = ' ') do + delete (s,1,1); + p := pos ('"',s); + while p > 0 do + begin + delete (s,p,1); + p := pos ('"',s); + end; + + p := pos (';',s); + while p > 0 do + begin + s2 := copy(s,1,p-1); + comment (V_Debug,'adding "'+s2+'" to nlmvonv input'); + NLMConvLinkFile.Add(s2); + delete (s,1,p); + p := pos (';',s); + end; + if s <> '' then + begin + comment (V_Debug,'adding "'+s+'" to nlmvonv input'); + NLMConvLinkFile.Add(s); + end; + + WriteResponseFile:=True; +end; + + +function TLinkerNetware.MakeExecutable:boolean; +var + binstr, + cmdstr : TCmdStr; + success : boolean; + StripStr : string[2]; +begin + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + StripStr:=''; + + if (cs_link_strip in current_settings.globalswitches) then + StripStr:='-s'; + +{ Write used files and libraries and create Headerfile for + nlmconv in NLMConvLinkFile } + WriteResponseFile(false); + +{ Call linker, this will generate a new object file that will be passed + to nlmconv. Otherwise we could not create nlms without debug info } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$TMPOBJ',maybequoted(outputexedir+tmpLinkFileName)); + Comment (v_debug,'Executing '+BinStr+' '+cmdstr); + success:=DoExec(BinStr,CmdStr,true,false); + + { Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + +{ Call nlmconv } + if success then + begin + NLMConvLinkFile.writetodisk; + NLMConvLinkFile.Free; + SplitBinCmd(Info.ExeCmd[2],binstr,cmdstr); + Replace(cmdstr,'$RES',maybequoted(outputexedir+'n'+Info.ResName)); + Comment (v_debug,'Executing '+BinStr+' '+cmdstr); + success:=DoExec(BinStr,CmdStr,true,false); + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + begin + DeleteFile(outputexedir+'n'+Info.ResName); + DeleteFile(outputexedir+tmpLinkFileName); + end; + end; + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +{**************************************************************************** + TInternalLinkerNetware +****************************************************************************} + + constructor TInternalLinkerNetware.Create; + begin + inherited Create; + CExeoutput:=TNLMexeoutput; + CObjInput:=TNLMCoffObjInput; + nlmSpecialSymbols_Segments := TFPHashList.create; + end; + + destructor TInternalLinkerNetware.destroy; + begin + if assigned(nlmSpecialSymbols_Segments) then + begin + nlmSpecialSymbols_Segments.Free; + nlmSpecialSymbols_Segments := nil; + end; + inherited destroy; + end; + + procedure TInternalLinkerNetware.DefaultLinkScript; + var + s,s2 : TCmdStr; + secname, + secnames : string; + hasCopyright, + hasScreenname, + hasThreadname, + hasVersion, + hasDescription, + hasStacksize: boolean; + t : text; + + + + procedure addLinkerOption(s : string); + var op : string; + begin + if s = '' then exit; + if s[1] = '#' then exit; + LinkScript.Concat(s); + op := upper(GetToken(s,' ')); + {check for options via -k that can also be specified vie + compiler directives in source, -k options will override + options in source} + if op = 'COPYRIGHT' then hasCopyright := true else + if op = 'SCREENNAME' then hasScreenname := true else + if op = 'THREADNAME' then hasThreadname := true else + if op = 'VERSION' then hasVersion := true else + if op = 'DESCRIPTION' then hasDescription := true else + if (op = 'STACK') or (op = 'STACKSIZE') then hasStacksize := true; + end; + + { add linker scropt specified by -k@FileName } + procedure addLinkerOptionsFile (fileName : string); + var + t : text; + option : string; + fn : TCmdStr; + begin + fn := fileName; + if not sysutils.fileExists(fn) then + if not includesearchpath.FindFile(fileName,true,fn) then + begin + comment(v_error,'linker options file "'+fileName+'" not found'); + exit; + end; + assign(t,fn); reset(t); + while not eof(t) do + begin + readln(t,option); + addLinkerOption(option); + end; + close(t); + end; + + { add linker options specified by command line parameter -k } + procedure addLinkerOptions; + var + s,option : string; + begin + s := ParaLinkOptions; + option := GetToken(s,';'); + while option <> '' do + begin + if copy(option,1,1)='@' then + begin + delete(option,1,1); + addLinkerOptionsFile(option); + end else + addLinkerOption(option); + option := GetToken(s,';'); + end; + end; + + { default: nwpre but can be specified via linker options + bacuse this has to be the first object, we have to scan + linker options before adding other options } + + function findPreludeInFile (fileName : string):string; + var + t : text; + option,s : string; + fn : TCmdStr; + begin + result := ''; + fn := fileName; + if not sysutils.fileExists(fn) then + if not includesearchpath.FindFile(fileName,true,fn) then + begin + comment(v_error,'linker options file "'+fileName+'" not found'); + exit; + end; + assign(t,fn); reset(t); + while not eof(t) do + begin + readln(t,option); + option := upper(GetToken(s,' ')); + if option='PRELUDE' then + begin + result := getToken(s,' '); + close(t); + exit; + end; + end; + close(t); + end; + + function findPrelude : string; + var + s,option,keyword : string; + begin + s := ParaLinkOptions; + option := GetToken(s,';'); + while option <> '' do + begin + if copy(option,1,1)='@' then + begin + delete(option,1,1); + result := findPreludeInFile(option); + if result <> '' then exit; + end else + begin + keyword := GetToken(option,' '); + if keyword = 'PRELUDE' then + begin + result := GetToken(option,' '); + exit; + end; + end; + option := GetToken(s,';'); + end; + if target_info.system = system_i386_netwlibc then + result := 'libcpre' + else + result := 'nwpre'; + end; + + begin + with LinkScript do + begin + prelude := findPrelude; // needs to be first object, can be specified by -k"PRELUDE ObjFileName" + if prelude = '' then internalerror(201103271); + if pos ('.',prelude) = 0 then prelude := prelude + '.o'; + s2 := FindObjectFile(prelude,'',false); + Comment (V_Debug,'adding init Object File '+s2); + Concat('READOBJECT '+MaybeQuoted(s2)); + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + begin + Concat('READOBJECT '+MaybeQuoted(s)); + Comment (V_Debug,'adding Object File '+s); + end; + end; + while not StaticLibFiles.Empty do + begin + s:=StaticLibFiles.GetFirst; + if s<>'' then + begin + Comment (V_Debug,'adding StaticLibFile '+s); + Concat('READSTATICLIBRARY '+MaybeQuoted(s)); + end; + end; + { While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if FindLibraryFile(s,target_info.staticClibprefix,target_info.importlibext,s2) then + begin + Comment (V_Debug,'adding LibraryFile '+s); + Concat('READSTATICLIBRARY '+MaybeQuoted(s2)); + end else + Comment(V_Error,'Import library not found for '+S); + end;} + if IsSharedLibrary then + Concat('ISSHAREDLIBRARY'); + ConcatEntryName; + Concat('IMAGEBASE $' + hexStr(0, SizeOf(imagebase)*2)); + Concat('HEADER'); + Concat('EXESECTION .text'); + Concat(' SYMBOL __text_start__'); nlmSpecialSymbols_Segments.Add('__text_start__',pointer(ptruint(Section_text))); + Concat(' OBJSECTION .text*'); + Concat(' SYMBOL ___CTOR_LIST__'); nlmSpecialSymbols_Segments.Add('___CTOR_LIST__',pointer(ptruint(Section_text))); + Concat(' SYMBOL __CTOR_LIST__'); nlmSpecialSymbols_Segments.Add('__CTOR_LIST__',pointer(ptruint(Section_text))); + Concat(' LONG -1'); + Concat(' OBJSECTION .ctor*'); + Concat(' LONG 0'); + Concat(' SYMBOL ___DTOR_LIST__'); nlmSpecialSymbols_Segments.Add('___DTOR_LIST__',pointer(ptruint(Section_text))); + Concat(' SYMBOL __DTOR_LIST__'); nlmSpecialSymbols_Segments.Add('__DTOR_LIST__',pointer(ptruint(Section_text))); + Concat(' LONG -1'); + Concat(' OBJSECTION .dtor*'); + Concat(' LONG 0'); + Concat(' SYMBOL etext'); nlmSpecialSymbols_Segments.Add('etext',pointer(ptruint(Section_text))); + Concat('ENDEXESECTION'); + + Concat('EXESECTION .data'); + Concat(' SYMBOL __data_start__'); nlmSpecialSymbols_Segments.Add('__data_start__',pointer(ptruint(Section_data))); + Concat(' OBJSECTION .data*'); + Concat(' OBJSECTION .fpc*'); + Concat(' SYMBOL edata'); nlmSpecialSymbols_Segments.Add('edata',pointer(ptruint(Section_data))); + Concat(' SYMBOL __data_end__'); nlmSpecialSymbols_Segments.Add('__data_end__',pointer(ptruint(Section_data))); + Concat('ENDEXESECTION'); + + Concat('EXESECTION .bss'); + Concat(' SYMBOL __bss_start__'); nlmSpecialSymbols_Segments.Add('__bss_start__',pointer(ptruint(Section_data))); + Concat(' OBJSECTION .bss*'); + Concat(' SYMBOL __bss_end__'); nlmSpecialSymbols_Segments.Add('__bss_end__',pointer(ptruint(Section_data))); + Concat('ENDEXESECTION'); + + Concat('EXESECTION .imports'); + Concat(' SYMBOL __imports_start__'); + Concat(' OBJSECTION .imports*'); + Concat(' SYMBOL __imports_end__'); + Concat('ENDEXESECTION'); + + Concat('EXESECTION .modules'); + Concat(' SYMBOL __modules_start__'); + Concat(' OBJSECTION .modules*'); + Concat(' SYMBOL __modules_end__'); + Concat('ENDEXESECTION'); + + Concat('EXESECTION .exports'); + Concat(' SYMBOL __exports_start__'); + Concat(' OBJSECTION .exports*'); + Concat(' SYMBOL __exports_end__'); + Concat('ENDEXESECTION'); + + Concat('EXESECTION .reloc'); + Concat(' SYMBOL __reloc_start__'); + Concat(' OBJSECTION .reloc*'); + Concat(' SYMBOL __reloc_end__'); + Concat('ENDEXESECTION'); + + Concat('EXESECTION .xdc'); + Concat(' OBJSECTION .xdc*'); + Concat('ENDEXESECTION'); + + Concat('EXESECTION .custom'); + Concat(' OBJSECTION .custom*'); + Concat('ENDEXESECTION'); + + Concat('EXESECTION .messages'); + Concat(' OBJSECTION .messages*'); + Concat('ENDEXESECTION'); + + Concat('EXESECTION .help'); + Concat(' OBJSECTION .help*'); + Concat('ENDEXESECTION'); + + Concat('EXESECTION .rdata'); + Concat(' SYMBOL ___RUNTIME_PSEUDO_RELOC_LIST__'); + Concat(' SYMBOL __RUNTIME_PSEUDO_RELOC_LIST__'); + Concat(' OBJSECTION .rdata_runtime_pseudo_reloc'); + Concat(' SYMBOL ___RUNTIME_PSEUDO_RELOC_LIST_END__'); + Concat(' SYMBOL __RUNTIME_PSEUDO_RELOC_LIST_END__'); + Concat(' OBJSECTION .rdata*'); + Concat(' OBJSECTION .rodata*'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .pdata'); + Concat(' OBJSECTION .pdata'); + Concat('ENDEXESECTION'); + secnames:='.edata,.rsrc,.gnu_debuglink,'+ + '.debug_aranges,.debug_pubnames,.debug_info,.debug_abbrev,.debug_line,.debug_frame,.debug_str,.debug_loc,'+ + '.debug_macinfo,.debug_weaknames,.debug_funcnames,.debug_typenames,.debug_varnames,.debug_ranges'; + repeat + secname:=gettoken(secnames,','); + if secname='' then + break; + Concat('EXESECTION '+secname); + Concat(' OBJSECTION '+secname+'*'); + Concat('ENDEXESECTION'); + until false; + { Can't use the generic rules, because that will add also .stabstr to .stab } + Concat('EXESECTION .stab'); + Concat(' OBJSECTION .stab'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .stabstr'); + Concat(' OBJSECTION .stabstr'); + Concat('ENDEXESECTION'); + Concat('STABS'); + Concat('SYMBOLS'); + Concat(''); + + hasCopyright := false; + hasScreenname := false; + hasThreadname := false; + hasVersion := false; + hasDescription := false; + hasStacksize := false; + addLinkerOptions; + if not hasCopyright then + if nwcopyright <> '' then + Concat('COPYRIGHT "'+nwCopyright+'"'); + if not hasScreenname then + if nwscreenname <> '' then + Concat('SCREENNAME "'+nwscreenname+'"'); + if not hasThreadname then + if nwthreadname <> '' then + Concat('THREADNAME "'+nwthreadname+'"'); + if not hasVersion then + Concat('VERSION '+tostr(dllmajor)+' '+tostr(dllminor)+' '+tostr(dllrevision)); + if not hasDescription then + if description <> '' then + Concat ('DESCRIPTION "'+description+'"'); + if not hasStacksize then + if MaxStackSizeSetExplicity then + begin + if stacksize < minStackSize then stacksize := minStackSize; + Concat ('STACKSIZE '+tostr(stacksize)); + end else + Concat ('STACKSIZE '+tostr(minStackSize)); + if target_info.system = system_i386_netwlibc then + Concat ('REENTRANT'); { needed by older libc versions } + end; + + // add symbols needed by nwpre. We have not loaded the ppu, + // therefore we do not know the externals so read it from nwpre.imp + s := ChangeFileExt(prelude,'.imp'); // nwpre.imp + if not librarysearchpath.FindFile(s,true,s2) then + begin + comment(v_error,s+' not found'); + exit; + end; + assign(t,s2); reset(t); + while not eof(t) do + begin + readln(t,s); + s := trimspace(s); + if (length(s) > 0) then + if copy(s,1,1) <> '#' then + AddImportSymbol('!clib',s,s,0,false); + end; + close(t); + end; + + + procedure TInternalLinkerNetware.InitSysInitUnitName; + begin + //if target_info.system=system_i386_netware then + // GlobalInitSysInitUnitName(self); + end; + + procedure TInternalLinkerNetware.ConcatEntryName; + begin + with LinkScript do + begin + if IsSharedLibrary then + begin + Concat('ISSHAREDLIBRARY'); + Concat('ENTRYNAME _Prelude') + end + else + begin + Concat('ENTRYNAME _Prelude') + end; + end; + end; + + + Function TInternalLinkerNetware.MakeSharedLibrary:boolean; + begin + Comment(V_Error,'Make shared library not supported for netware'); + MakeSharedLibrary := false; + end; + +{***************************************************************************** + Initialize +*****************************************************************************} + + +initialization + RegisterExternalLinker(system_i386_netware_info,TLinkerNetware); + RegisterInternalLinker(system_i386_netware_info,TInternalLinkerNetware); + RegisterImport(system_i386_netware,TImportLibNetware); + RegisterExport(system_i386_netware,TExportLibNetware); + RegisterTarget(system_i386_netware_info); +end. diff --git a/closures/compiler/systems/t_os2.pas b/closures/compiler/systems/t_os2.pas new file mode 100644 index 0000000000..ff0ca20106 --- /dev/null +++ b/closures/compiler/systems/t_os2.pas @@ -0,0 +1,556 @@ +{ + Copyright (c) 1998-2002 by Daniel Mantione + Portions Copyright (c) 1998-2002 Eberhard Mattes + + Unit to write out import libraries and def files for OS/2 + + 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. + + **************************************************************************** +} +{ + A lot of code in this unit has been ported from C to Pascal from the + emximp utility, part of the EMX development system. Emximp is copyrighted + by Eberhard Mattes. Note: Eberhard doesn't know much about the Pascal + port, please send questions to Tomas Hajny <hajny@freepascal.org> or + Daniel Mantione <daniel@freepascal.org>. +} +unit t_os2; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + SysUtils, + cutils,cfileutl,cclasses, + globtype,systems,symconst,symdef, + globals,verbose,fmodule,script, + import,link,i_os2,ogbase; + + type + timportlibos2=class(timportlib) + procedure generatelib;override; + end; + + tlinkeros2=class(texternallinker) + private + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + end; + + +const profile_flag:boolean=false; + +const n_ext = 1; + n_abs = 2; + n_text = 4; + n_data = 6; + n_bss = 8; + n_imp1 = $68; + n_imp2 = $6a; + +type reloc=packed record {This is the layout of a relocation table + entry.} + address:longint; {Fixup location} + remaining:longint; + {Meaning of bits for remaining: + 0..23: Symbol number or segment + 24: Self-relative fixup if non-zero + 25..26: Fixup size (0: 1 byte, 1: 2, 2: 4 bytes) + 27: Reference to symbol or segment + 28..31 Not used} + end; + + nlist=packed record {This is the layout of a symbol table entry.} + strofs:longint; {Offset in string table} + typ:byte; {Type of the symbol} + other:byte; {Other information} + desc:word; {More information} + value:longint; {Value (address)} + end; + + a_out_header=packed record + magic:word; {Magic word, must be $0107} + machtype:byte; {Machine type} + flags:byte; {Flags} + text_size:longint; {Length of text, in bytes} + data_size:longint; {Length of initialized data, in bytes} + bss_size:longint; {Length of uninitialized data, in bytes} + sym_size:longint; {Length of symbol table, in bytes} + entry:longint; {Start address (entry point)} + trsize:longint; {Length of relocation info for text, bytes} + drsize:longint; {Length of relocation info for data, bytes} + end; + + ar_hdr=packed record + ar_name:array[0..15] of char; + ar_date:array[0..11] of char; + ar_uid:array[0..5] of char; + ar_gid:array[0..5] of char; + ar_mode:array[0..7] of char; + ar_size:array[0..9] of char; + ar_fmag:array[0..1] of char; + end; + +var aout_str_size:longint; + aout_str_tab:array[0..2047] of char; + aout_sym_count:longint; + aout_sym_tab:array[0..5] of nlist; + + aout_text:array[0..63] of byte; + aout_text_size:longint; + + aout_treloc_tab:array[0..1] of reloc; + aout_treloc_count:longint; + + aout_size:longint; + seq_no:longint; + + ar_member_size:longint; + + out_file:file; + +procedure PackTime (var T: TSystemTime; var P: longint); + +var zs:longint; + +begin + p:=-1980; + p:=p+t.year and 127; + p:=p shl 4; + p:=p+t.month; + p:=p shl 5; + p:=p+t.day; + p:=p shl 16; + zs:=t.hour; + zs:=zs shl 6; + zs:=zs+t.minute; + zs:=zs shl 5; + zs:=zs+t.second div 2; + p:=p+(zs and $ffff); +end; + + +procedure write_ar(const name:string;size:longint); + +var ar:ar_hdr; + time:TSystemTime; + numtime:longint; + tmp:string[19]; + + +begin + ar_member_size:=size; + fillchar(ar.ar_name,sizeof(ar.ar_name),' '); + move(name[1],ar.ar_name,length(name)); + GetLocalTime(time); + packtime(time,numtime); + str(numtime,tmp); + fillchar(ar.ar_date,sizeof(ar.ar_date),' '); + move(tmp[1],ar.ar_date,length(tmp)); + ar.ar_uid:='0 '; + ar.ar_gid:='0 '; + ar.ar_mode:='100666'#0#0; + str(size,tmp); + fillchar(ar.ar_size,sizeof(ar.ar_size),' '); + move(tmp[1],ar.ar_size,length(tmp)); + ar.ar_fmag:='`'#10; + blockwrite(out_file,ar,sizeof(ar)); +end; + +procedure finish_ar; + +var a:byte; + +begin + a:=0; + if odd(ar_member_size) then + blockwrite(out_file,a,1); +end; + +procedure aout_init; + +begin + aout_str_size:=sizeof(longint); + aout_sym_count:=0; + aout_text_size:=0; + aout_treloc_count:=0; +end; + +function aout_sym(const name:string;typ,other:byte;desc:word; + value:longint):longint; + +begin + if aout_str_size+length(name)+1>sizeof(aout_str_tab) then + internalerror(200504245); + if aout_sym_count>=sizeof(aout_sym_tab) div sizeof(aout_sym_tab[0]) then + internalerror(200504246); + aout_sym_tab[aout_sym_count].strofs:=aout_str_size; + aout_sym_tab[aout_sym_count].typ:=typ; + aout_sym_tab[aout_sym_count].other:=other; + aout_sym_tab[aout_sym_count].desc:=desc; + aout_sym_tab[aout_sym_count].value:=value; + strPcopy(@aout_str_tab[aout_str_size],name); + aout_str_size:=aout_str_size+length(name)+1; + aout_sym:=aout_sym_count; + inc(aout_sym_count); +end; + +procedure aout_text_byte(b:byte); + +begin + if aout_text_size>=sizeof(aout_text) then + internalerror(200504247); + aout_text[aout_text_size]:=b; + inc(aout_text_size); +end; + +procedure aout_text_dword(d:longint); + +type li_ar=array[0..3] of byte; + +begin + aout_text_byte(li_ar(d)[0]); + aout_text_byte(li_ar(d)[1]); + aout_text_byte(li_ar(d)[2]); + aout_text_byte(li_ar(d)[3]); +end; + +procedure aout_treloc(address,symbolnum,pcrel,len,ext:longint); + +begin + if aout_treloc_count>=sizeof(aout_treloc_tab) div sizeof(reloc) then + internalerror(200504248); + aout_treloc_tab[aout_treloc_count].address:=address; + aout_treloc_tab[aout_treloc_count].remaining:=symbolnum+pcrel shl 24+ + len shl 25+ext shl 27; + inc(aout_treloc_count); +end; + +procedure aout_finish; + +begin + while (aout_text_size and 3)<>0 do + aout_text_byte ($90); + aout_size:=sizeof(a_out_header)+aout_text_size+aout_treloc_count* + sizeof(reloc)+aout_sym_count*sizeof(aout_sym_tab[0])+aout_str_size; +end; + +procedure aout_write; + +var ao:a_out_header; + +begin + ao.magic:=$0107; + ao.machtype:=0; + ao.flags:=0; + ao.text_size:=aout_text_size; + ao.data_size:=0; + ao.bss_size:=0; + ao.sym_size:=aout_sym_count*sizeof(aout_sym_tab[0]); + ao.entry:=0; + ao.trsize:=aout_treloc_count*sizeof(reloc); + ao.drsize:=0; + blockwrite(out_file,ao,sizeof(ao)); + blockwrite(out_file,aout_text,aout_text_size); + blockwrite(out_file,aout_treloc_tab,sizeof(reloc)*aout_treloc_count); + blockwrite(out_file,aout_sym_tab,sizeof(aout_sym_tab[0])*aout_sym_count); + plongint(@aout_str_tab)^:=aout_str_size; + blockwrite(out_file,aout_str_tab,aout_str_size); +end; + + +procedure AddImport(const module:string;index:longint;const name,mangledname:string); +{mangledname= Assembler label of the function to import. + module = Name of DLL to import from. + index = Index of function in DLL. Use 0 to import by name. + name = Name of function in DLL. Ignored when index=0;} +(* +var tmp1,tmp2,tmp3:string; +*) +var tmp1,tmp2,tmp3:string; + sym_mcount,sym_import:longint; + fixup_mcount,fixup_import:longint; +begin + aout_init; + tmp2:=mangledname; +(* + tmp2:=func; + if profile_flag and not (copy(func,1,4)='_16_') then +*) + if profile_flag and not (copy(tmp2,1,4)='_16_') then + begin + {sym_entry:=aout_sym(func,n_text+n_ext,0,0,aout_text_size);} + sym_mcount:=aout_sym('__mcount',n_ext,0,0,0); + {Use, say, "_$U_DosRead" for "DosRead" to import the + non-profiled function.} +(* + tmp2:='__$U_'+func; + sym_import:=aout_sym(tmp2,n_ext,0,0,0); +*) + sym_import:=aout_sym(tmp2,n_ext,0,0,0); + aout_text_byte($55); {push ebp} + aout_text_byte($89); {mov ebp, esp} + aout_text_byte($e5); + aout_text_byte($e8); {call _mcount} + fixup_mcount:=aout_text_size; + aout_text_dword(0-(aout_text_size+4)); + aout_text_byte($5d); {pop ebp} + aout_text_byte($e9); {jmp _$U_DosRead} + fixup_import:=aout_text_size; + aout_text_dword(0-(aout_text_size+4)); + + aout_treloc(fixup_mcount,sym_mcount,1,2,1); + aout_treloc (fixup_import, sym_import,1,2,1); + end; + str(seq_no,tmp1); + tmp1:='IMPORT#'+tmp1; +(* + if name='' then +*) + if index<>0 then + begin + str(index,tmp3); +(* + tmp3:=func+'='+module+'.'+tmp3; +*) + tmp3:=Name+'='+module+'.'+tmp3; + end + else + tmp3:=Name+'='+module+'.'+name; +(* + tmp3:=func+'='+module+'.'+name; + aout_sym(tmp2,n_imp1+n_ext,0,0,0); +*) + aout_sym(tmp2,n_imp1+n_ext,0,0,0); + aout_sym(tmp3,n_imp2+n_ext,0,0,0); + aout_finish; + write_ar(tmp1,aout_size); + aout_write; + finish_ar; + inc(seq_no); +end; + + procedure timportlibos2.generatelib; + const + ar_magic:array[1..8] of char='!<arch>'#10; + var + i,j : longint; + ImportLibrary : TImportLibrary; + ImportSymbol : TImportSymbol; + begin + seq_no:=1; + current_module.linkotherstaticlibs.add(Current_Module.ImportLibFilename^,link_always); + assign(out_file,Current_Module.ImportLibFilename^); + rewrite(out_file,1); + blockwrite(out_file,ar_magic,sizeof(ar_magic)); + + for i:=0 to current_module.ImportLibraryList.Count-1 do + begin + ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]); + for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do + begin + ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]); + AddImport(ChangeFileExt(ExtractFileName(ImportLibrary.Name),''), + ImportSymbol.OrdNr,ImportSymbol.Name,ImportSymbol.MangledName); + end; + end; + close(out_file); + end; + + +{**************************************************************************** + TLinkeros2 +****************************************************************************} + +Constructor TLinkeros2.Create; +begin + Inherited Create; + { allow duplicated libs (PM) } + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; +end; + + +procedure TLinkeros2.SetDefaultInfo; +begin + with Info do + begin + ExeCmd[1]:='ld $OPT -o $OUT @$RES'; + ExeCmd[2]:='emxbind -b $STRIP $APPTYPE $RSRC -k$STACKKB -h1 -o $EXE $OUT -ai -s8'; + if Source_Info.Script = script_dos then + ExeCmd[3]:='del $OUT'; + end; +end; + + +Function TLinkeros2.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + i : longint; + HPath : TCmdStrListItem; + s : string; +begin + WriteResponseFile:=False; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + LinkRes.Add('-L'+HPath.Str); + HPath:=TCmdStrListItem(HPath.Next); + end; + HPath:=TCmdStrListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + LinkRes.Add('-L'+HPath.Str); + HPath:=TCmdStrListItem(HPath.Next); + end; + + { add objectfiles, start with prt0 always } + LinkRes.AddFileName(FindObjectFile('prt0','',false)); + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + LinkRes.AddFileName(s); + end; + + { Write staticlibraries } + { No group !! This will not work correctly PM } + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(s) + end; + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end; + +{ Write and Close response } + linkres.writetodisk; + LinkRes.Free; + + WriteResponseFile:=True; +end; + + +function TLinkeros2.MakeExecutable:boolean; +var + binstr, + cmdstr : TCmdStr; + success : boolean; + i : longint; + AppTypeStr, + StripStr: string[40]; + RsrcStr : string; + OutName: TPathStr; +begin + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + OutName := ChangeFileExt(current_module.exefilename^,'.out'); + if (cs_link_strip in current_settings.globalswitches) then + StripStr := '-s' + else + StripStr := ''; + if (usewindowapi) or (AppType = app_gui) then + AppTypeStr := '-p' + else if AppType = app_fs then + AppTypeStr := '-f' + else AppTypeStr := '-w'; + if not (Current_module.ResourceFiles.Empty) then + RsrcStr := '-r ' + Current_module.ResourceFiles.GetFirst + else + RsrcStr := ''; +(* Only one resource file supported, discard everything else + (should be already empty anyway, though). *) + Current_module.ResourceFiles.Clear; +{ Write used files and libraries } + WriteResponseFile(false); + +{ Call linker } + success:=false; + for i:=1 to 3 do + begin + SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr); + if binstr<>'' then + begin + { Is this really required? Not anymore according to my EMX docs } + Replace(cmdstr,'$HEAPMB',tostr((1048575) shr 20)); + {Size of the stack when an EMX program runs in OS/2.} + Replace(cmdstr,'$STACKKB',tostr((stacksize+1023) shr 10)); + {When an EMX program runs in DOS, the heap and stack share the + same memory pool. The heap grows upwards, the stack grows downwards.} + Replace(cmdstr,'$DOSHEAPKB',tostr((stacksize+1023) shr 10)); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$APPTYPE',AppTypeStr); +(* + Arrgh!!! The ancient EMX LD.EXE simply dies without saying anything + if the full pathname to link.res is quoted!!!!! @#$@@^%@#$^@#$^@^#$ + This means that name of the output directory cannot contain spaces, + but at least it works otherwise... + + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); +*) + Replace(cmdstr,'$RES',outputexedir+Info.ResName); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RSRC',RsrcStr); + Replace(cmdstr,'$OUT',maybequoted(OutName)); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + if i<>3 then + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,(i=1),false) + else + success:=DoExec(binstr,cmdstr,(i=1),true); + end; + end; + +{ Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterExternalLinker(system_i386_os2_info,TLinkerOS2); + RegisterImport(system_i386_os2,TImportLibOS2); +{ RegisterRes(res_wrc_os2_info,TResourceFile);} + RegisterTarget(system_i386_os2_info); +end. diff --git a/closures/compiler/systems/t_palmos.pas b/closures/compiler/systems/t_palmos.pas new file mode 100644 index 0000000000..2d112851c4 --- /dev/null +++ b/closures/compiler/systems/t_palmos.pas @@ -0,0 +1,218 @@ +{ + Copyright (c) 2001-2002 by Peter Vreman + + This unit implements support import,export,link routines + for the (i386) Amiga target + + 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 t_palmos; + +{$i fpcdefs.inc} + +interface + + uses + link; + + type + tlinkerPalmOS=class(texternallinker) + private + Function WriteResponseFile : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + end; + + +implementation + + uses + SysUtils, + cutils,cfileutl,cclasses, + globtype,globals,systems,verbose,script,fmodule,i_palmos, + comprsrc; + +{**************************************************************************** + TLinkerPalmOS +****************************************************************************} + +Constructor TLinkerPalmOS.Create; +begin + Inherited Create; + { allow duplicated libs (PM) } + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; +end; + + +procedure TLinkerPalmOS.SetDefaultInfo; +begin + with Info do + begin + ExeCmd[1]:='ldpalm $OPT $STRIP -N -dy -T $SCRIPT -o $EXE @$RES'; + ExeCmd[2]:='build-prc $EXE.prc "$APPNAME" $APPID $EXE *.bin'; + end; +end; + + +Function TLinkerPalmOS.WriteResponseFile : Boolean; +Var + linkres : TLinkRes; + i : longint; + HPath : TCmdStrListItem; + s : string; + linklibc : boolean; +begin + WriteResponseFile:=False; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + LinkRes.Add('-L'+HPath.Str); + HPath:=TCmdStrListItem(HPath.Next); + end; + HPath:=TCmdStrListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + LinkRes.Add('-L'+HPath.Str); + HPath:=TCmdStrListItem(HPath.Next); + end; + + { add objectfiles, start with crt0 always } + { using crt0, we should stick C compatible } + LinkRes.AddFileName(FindObjectFile('crt0','',false)); + + { main objectfiles } + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + LinkRes.AddFileName(s); + end; + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + LinkRes.Add('-('); + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(s) + end; + LinkRes.Add('-)'); + end; + + { currently the PalmOS target must be linked always against the C lib } + LinkRes.Add('-lcrt'); + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + linklibc:=false; + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + linklibc:=true; + end; + { be sure that libc is the last lib } + if linklibc then + begin + LinkRes.Add('-lc'); + LinkRes.Add('-lgcc'); + end; + +{ Write and Close response } + linkres.writetodisk; + linkres.Free; + + WriteResponseFile:=True; +end; + + +function TLinkerPalmOS.MakeExecutable:boolean; +var + binstr, + cmdstr : TCmdStr; + success : boolean; + StripStr : string[40]; + i : longint; +begin + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + + { Create some replacements } + StripStr:=''; + if (cs_link_strip in current_settings.globalswitches) then + StripStr:='-s'; + + { Write used files and libraries } + WriteResponseFile; + +{ Call linker } + success:=false; + for i:=1 to 2 do + begin + SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr); + if binstr<>'' then + begin + Replace(cmdstr,'$EXE',MaybeQuoted(current_module.exefilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',MaybeQuoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$SCRIPT',FindUtil('palm.ld')); + Replace(cmdstr,'$APPNAME',palmos_applicationname); + Replace(cmdstr,'$APPID',palmos_applicationid); + success:=DoExec(FindUtil(binstr),cmdstr,(i=1),false); + if not success then + break; + end; + end; + + { Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef m68k} + RegisterTarget(system_m68k_palmos_info); + RegisterRes(res_m68k_palmos_info,TResourceFile); +{$endif m68k} +{$ifdef arm} + RegisterTarget(system_arm_palmos_info); + RegisterRes(res_arm_palmos_info,TResourceFile); +{$endif arm} +end. diff --git a/closures/compiler/systems/t_sunos.pas b/closures/compiler/systems/t_sunos.pas new file mode 100644 index 0000000000..77632e43ea --- /dev/null +++ b/closures/compiler/systems/t_sunos.pas @@ -0,0 +1,666 @@ +{ + Copyright (c) 1998-2008 by Peter Vreman + + This unit implements support import,export,link routines + for the (i386) solaris target + + 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 t_sunos; + +{$i fpcdefs.inc} + +interface + +{ copy from t_linux +// Up to now we use gld since the solaris ld seems not support .res-files} +{-$DEFINE LinkTest} { DON't del link.res and write Info } +{$DEFINE GnuLd}{The other is not implemented } + +implementation + + uses + sysutils, + cutils,cfileutl,cclasses, + verbose,systems,globtype,globals, + symconst,script, + fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,symsym,symdef, + cgobj, + import,export,expunix,link,comprsrc,rescmn,i_sunos,ogbase; + + type + timportlibsolaris=class(timportlib) + procedure generatelib;override; + end; + + texportlibsolaris=class(texportlibunix) +(* + procedure setinitname(list: TAsmList; const s: string); override; + procedure setfininame(list: TAsmList; const s: string); override; +*) + end; + + tlinkersolaris=class(texternallinker) + private + Glibc2, + Glibc21 : boolean; + use_gnu_ld : boolean; + linkres : TLinkRes; + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + function MakeSharedLibrary:boolean;override; + end; + + +{***************************************************************************** + TIMPORTLIBsolaris +*****************************************************************************} + + procedure timportlibsolaris.generatelib; + var + i : longint; + ImportLibrary : TImportLibrary; + begin + for i:=0 to current_module.ImportLibraryList.Count-1 do + begin + ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]); + current_module.linkothersharedlibs.add(ImportLibrary.Name,link_always); + end; + end; + + +{***************************************************************************** + TEXPORTLIBsolaris +*****************************************************************************} +(* + procedure texportlibsolaris.setinitname(list: TAsmList; const s: string); + begin + inherited setinitname(list,s); +{$ifdef sparc} + new_section(list,sec_init,'',4); + list.concat(tai_symbol.createname_global('_init',AT_FUNCTION,0)); + list.concat(taicpu.op_reg_const_reg(A_SAVE,NR_STACK_POINTER_REG,-96,NR_STACK_POINTER_REG)); +{$endif sparc} + end; + + + procedure texportlibsolaris.setfininame(list: TAsmList; const s: string); + begin + inherited setfininame(list,s); +{$ifdef sparc} + new_section(list,sec_fini,'',4); + list.concat(tai_symbol.createname_global('_fini',AT_FUNCTION,0)); + list.concat(taicpu.op_reg_const_reg(A_SAVE,NR_STACK_POINTER_REG,-96,NR_STACK_POINTER_REG)); +{$endif sparc} + end; +*) +{***************************************************************************** + TLINKERsolaris +*****************************************************************************} + +Constructor TLinkersolaris.Create; +begin + Inherited Create; + + if cs_link_native in init_settings.globalswitches then + use_gnu_ld:=false + else + use_gnu_ld:=true; + if NOT Dontlinkstdlibpath Then +{$ifdef x86_64} + LibrarySearchPath.AddPath(sysrootpath,'/lib/64;/usr/lib/64;/usr/X11R6/lib/64;/opt/sfw/lib/64',true); +{$else not x86_64} + LibrarySearchPath.AddPath(sysrootpath,'/lib;/usr/lib;/usr/X11R6/lib;/opt/sfw/lib',true); +{$endif not x86_64} +{$ifdef LinkTest} + if (cs_link_staticflag in current_settings.globalswitches) then WriteLN('ForceLinkStaticFlag'); + if (cs_link_static in current_settings.globalswitches) then WriteLN('LinkStatic-Flag'); + if (cs_link_shared in current_settings.globalswitches) then WriteLN('LinkSynamicFlag'); +{$EndIf} +end; + + +procedure TLinkersolaris.SetDefaultInfo; +{ + This will also detect which libc version will be used +} +{$ifdef x86_64} +const + gld = 'gld -m elf_x86_64 '; + solaris_ld = '/usr/bin/ld -64 '; +{$endif} +{$ifdef i386} +const + gld = 'gld '; + solaris_ld = '/usr/bin/ld '; +{$endif } +{$ifdef sparc} +const + gld = 'gld '; + solaris_ld = 'ld '; +{$endif} +begin + Glibc2:=false; + Glibc21:=false; + with Info do + begin +{$IFDEF GnuLd} + ExeCmd[1]:=gld + '$OPT $DYNLINK $STATIC $STRIP -L. -o $EXE $RES'; + ExeCmd[2]:=solaris_ld + '$OPT $DYNLINK $STATIC $STRIP -L . -o $EXE $RESDATA'; + DllCmd[1]:=gld + '$OPT $INITFINI -shared -L. -o $EXE $RES'; + DllCmd[2]:='gstrip --strip-unneeded $EXE'; + DllCmd[3]:=solaris_ld + '$OPT $INITFINI -M $VERSIONFILE -G -Bdynamic -L. -o $EXE $RESDATA'; + DynamicLinker:=''; { Gnu uses the default } + Glibc21:=false; +{$ELSE} + Not Implememted +{$ENDIF} + end; + +end; + + +Function TLinkersolaris.WriteResponseFile(isdll:boolean) : Boolean; +Var + i : longint; +{ cprtobj, + gprtobj, + prtobj : string[80];} + HPath : TCmdStrListItem; + s,s2 : TCmdStr; + linkdynamic, + linklibc : boolean; + LinkRes2 : TLinkRes; +begin + WriteResponseFile:=False; +{ set special options for some targets } + linkdynamic:=not(SharedLibFiles.empty); +{ linkdynamic:=false; // da nicht getestet } + linklibc:=(SharedLibFiles.Find('c')<>nil); +{ prtobj:='prt0'; + cprtobj:='cprt0'; + gprtobj:='gprt0';} + if cs_profile in current_settings.moduleswitches then + begin +{ prtobj:=gprtobj;} + if not glibc2 then + AddSharedLibrary('gmon'); + AddSharedLibrary('c'); + linklibc:=true; + end + else + begin + if linklibc then + begin +{ prtobj:=cprtobj;} + end + else + AddSharedLibrary('c'); { quick hack: this solaris implementation needs alwys libc } + end; + + if use_gnu_ld then + begin + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + LinkRes.Add('SEARCH_DIR('+maybequoted(HPath.Str)+')'); + HPath:=TCmdStrListItem(HPath.Next); + end; + HPath:=TCmdStrListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + LinkRes.Add('SEARCH_DIR('+maybequoted(HPath.Str)+')'); + HPath:=TCmdStrListItem(HPath.Next); + end; + + { force local symbol resolution (i.e., inside the shared } + { library itself) for all non-exorted symbols, otherwise } + { several RTL symbols of FPC-compiled shared libraries } + { will be bound to those of a single shared library or } + { to the main program } + if (isdll) then + begin + LinkRes.add('VERSION'); + LinkRes.add('{'); + LinkRes.add(' {'); + if not texportlibunix(exportlib).exportedsymnames.empty then + begin + LinkRes.add(' global:'); + repeat + LinkRes.add(' '+texportlibunix(exportlib).exportedsymnames.getfirst+';'); + until texportlibunix(exportlib).exportedsymnames.empty; + end; + LinkRes.add(' local:'); + LinkRes.add(' *;'); + LinkRes.add(' };'); + LinkRes.add('}'); + end; + + LinkRes.Add('INPUT('); + { add objectfiles, start with prt0 always } + { solaris port contains _start inside the system unit, it + needs only one entry because it is linked always against libc + if prtobj<>'' then + LinkRes.AddFileName(FindObjectFile(prtobj,'',false)); + } + { try to add crti and crtbegin if linking to C } + if linklibc then { Needed in solaris? } + begin +{ if librarysearchpath.FindFile('crtbegin.o',s) then + LinkRes.AddFileName(s);} + if librarysearchpath.FindFile('crti.o',false,s) then + LinkRes.AddFileName(s); + end; + { main objectfiles } + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + LinkRes.AddFileName(maybequoted(s)); + end; + LinkRes.Add(')'); + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + LinkRes.Add('GROUP('); + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(maybequoted(s)) + end; + LinkRes.Add(')'); + end; + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + if not SharedLibFiles.Empty then + begin + LinkRes.Add('INPUT('); + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + begin + linklibc:=true; + linkdynamic:=false; { libc will include the ld-solaris (war ld-linux) for us } + end; + end; + { be sure that libc is the last lib } + if linklibc then + LinkRes.Add('-lc'); + { when we have -static for the linker the we also need libgcc } + if (cs_link_staticflag in current_settings.globalswitches) then begin + LinkRes.Add('-lgcc'); + end; + if linkdynamic and (Info.DynamicLinker<>'') then { gld has a default, DynamicLinker is not set in solaris } + LinkRes.AddFileName(Info.DynamicLinker); + LinkRes.Add(')'); + end; + { objects which must be at the end } + if linklibc then {needed in solaris ? } + begin + if {librarysearchpath.FindFile('crtend.o',s1) or} + librarysearchpath.FindFile('crtn.o',false,s2) then + begin + LinkRes.Add('INPUT('); +{ LinkRes.AddFileName(s1);} + LinkRes.AddFileName(s2); + LinkRes.Add(')'); + end; + end; +{ Write and Close response } + linkres.writetodisk; + LinkRes.Free; + end + else { not use_gnu_ld } + begin + { Open TlinkRes, will not be written to disk } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName+'2'); + + { Write path to search libraries } + HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + LinkRes.Add('-L '+maybequoted(HPath.Str)); + HPath:=TCmdStrListItem(HPath.Next); + end; + HPath:=TCmdStrListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + LinkRes.Add('-L '+maybequoted(HPath.Str)); + HPath:=TCmdStrListItem(HPath.Next); + end; + { force local symbol resolution (i.e., inside the shared } + { library itself) for all non-exorted symbols, otherwise } + { several RTL symbols of FPC-compiled shared libraries } + { will be bound to those of a single shared library or } + { to the main program } + if (isdll) then + begin + LinkRes2:=TLinkRes.Create(outputexedir+Info.ResName); + // LinkRes2.add('VERSION'); not needed for now + LinkRes2.add(' {'); + if not texportlibunix(exportlib).exportedsymnames.empty then + begin + LinkRes2.add(' global:'); + repeat + LinkRes2.add(' '+texportlibunix(exportlib).exportedsymnames.getfirst+';'); + until texportlibunix(exportlib).exportedsymnames.empty; + end; + LinkRes2.add(' local:'); + LinkRes2.add(' *;'); + LinkRes2.add(' };'); + LinkRes2.writetodisk; + LinkRes2.Free; + end; + + + { add objectfiles, start with prt0 always } + { solaris port contains _start inside the system unit, it + needs only one entry because it is linked always against libc + if prtobj<>'' then + LinkRes.AddFileName(FindObjectFile(prtobj,'',false)); + } + { try to add crti and crtbegin if linking to C } + if linklibc then { Needed in solaris? } + begin +{ if librarysearchpath.FindFile('crtbegin.o',s) then + LinkRes.AddFileName(s);} + if librarysearchpath.FindFile('crti.o',false,s) then + LinkRes.AddFileName(s); + end; + { main objectfiles } + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + LinkRes.AddFileName(maybequoted(s)); + end; + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + linkres.add('-('); + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName(maybequoted(s)) + end; + linkres.add('-)'); + end; + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + if not SharedLibFiles.Empty then + begin + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + begin + linklibc:=true; + linkdynamic:=false; { libc will include the ld-solaris (war ld-linux) for us } + end; + end; + { be sure that libc is the last lib } + if linklibc then + LinkRes.Add('-lc'); + { when we have -static for the linker the we also need libgcc } + if (cs_link_staticflag in current_settings.globalswitches) then begin + LinkRes.Add('-lgcc'); + end; + if linkdynamic and (Info.DynamicLinker<>'') then { gld has a default, DynamicLinker is not set in solaris } + LinkRes.AddFileName(Info.DynamicLinker); + end; + { objects which must be at the end } + if linklibc then {needed in solaris ? } + begin + if {librarysearchpath.FindFile('crtend.o',s1) or} + librarysearchpath.FindFile('crtn.o',false,s2) then + begin +{ LinkRes.AddFileName(s1);} + LinkRes.AddFileName(s2); + end; + end; +{ Write and Close response } + //linkres.writetodisk; + //LinkRes.Free; + + end; + WriteResponseFile:=True; +end; + + +function TLinkersolaris.MakeExecutable:boolean; +var + binstr, + s, linkstr, + cmdstr : TCmdStr; + success : boolean; + DynLinkStr : string[60]; + StaticStr, + StripStr : string[40]; +begin + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + StaticStr:=''; + StripStr:=''; + DynLinkStr:=''; + if (cs_link_staticflag in current_settings.globalswitches) then + StaticStr:='-Bstatic'; + if (cs_link_strip in current_settings.globalswitches) then + StripStr:='-s'; + If (cs_profile in current_settings.moduleswitches) or + ((Info.DynamicLinker<>'') and (not SharedLibFiles.Empty)) then + DynLinkStr:='-dynamic-linker='+Info.DynamicLinker; + if rlinkpath<>'' then + if use_gnu_ld then + DynLinkStr:=DynLinkStr+' --rpath-link '+rlinkpath + else + DynLinkStr:=DynLinkStr+' -R '+rlinkpath; + + { solaris sets DynamicLinker, but gld will (hopefully) defaults to -Bdynamic and add the default-linker } +{ Write used files and libraries } + WriteResponseFile(false); + +{ Call linker } + if use_gnu_ld then + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr) + else + SplitBinCmd(Info.ExeCmd[2],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + if use_gnu_ld then + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)) + else + begin + linkstr:=''; + while not linkres.data.Empty do + begin + s:=linkres.data.GetFirst; + if s<>'' then + linkstr:=linkstr+' '+s; + end; + linkres.free; + Replace(cmdstr,'$RESDATA',linkstr); + end; + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + if BinStr[1]<>'/' then + success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,false) + else { Using utilsprefix has no sense on /usr/bin/ld } + success:=DoExec(BinStr,Trim(CmdStr),true,false); + +{ Remove ReponseFile } +{$IFNDEF LinkTest} + if (success) and use_gnu_ld and + not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); +{$ENDIF} + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +Function TLinkersolaris.MakeSharedLibrary:boolean; +var + InitFiniStr : string; + binstr, + s, linkstr, + cmdstr : TCmdStr; + success : boolean; +begin + MakeSharedLibrary:=false; + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.sharedlibfilename^); + +{ Write used files and libraries } + WriteResponseFile(true); + +{ Create some replacements } +{ initname and fininame may contain $, which can be wrongly interpreted + in a link script, thus we surround them with single quotes + in cs_link_nolink is in globalswitches } + if use_gnu_ld then + begin + InitFiniStr:='-init '; + if cs_link_nolink in current_settings.globalswitches then + InitFiniStr:=InitFiniStr+''''+exportlib.initname+'''' + else + InitFiniStr:=InitFiniStr+exportlib.initname; + if (exportlib.fininame<>'') then + begin + if cs_link_nolink in current_settings.globalswitches then + InitFiniStr:=InitFiniStr+' -fini '''+exportlib.initname+'''' + else + InitFiniStr:=InitFiniStr+' -fini '+exportlib.fininame; + end; + end + else + begin + InitFiniStr:='-z initarray='; + if cs_link_nolink in current_settings.globalswitches then + InitFiniStr:=InitFiniStr+''''+exportlib.initname+'''' + else + InitFiniStr:=InitFiniStr+exportlib.initname; + if (exportlib.fininame<>'') then + begin + if cs_link_nolink in current_settings.globalswitches then + InitFiniStr:=InitFiniStr+' -z finiarray='''+exportlib.initname+'''' + else + InitFiniStr:=InitFiniStr+' -z finiarray='+exportlib.fininame; + end; + end; + +{ Call linker } + if use_gnu_ld then + SplitBinCmd(Info.DllCmd[1],binstr,cmdstr) + else + SplitBinCmd(Info.DllCmd[3],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$INITFINI',InitFiniStr); + if use_gnu_ld then + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)) + else + begin + Replace(cmdstr,'$VERSIONFILE',maybequoted(outputexedir+Info.ResName)); + linkstr:=''; + while not linkres.data.Empty do + begin + s:=linkres.data.GetFirst; + if s<>'' then + linkstr:=linkstr+' '+s; + end; + linkres.free; + Replace(cmdstr,'$RESDATA',linkstr); + end; + if BinStr[1]<>'/' then + success:=DoExec(FindUtil(utilsprefix+BinStr),CmdStr,true,false) + else { Using utilsprefix has no sense on /usr/bin/ld } + success:=DoExec(BinStr,Trim(CmdStr),true,false); + + +{ Strip the library ? } + if success and (cs_link_strip in current_settings.globalswitches) then + begin + SplitBinCmd(Info.DllCmd[2],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^)); + success:=DoExec(utilsprefix+FindUtil(binstr),cmdstr,true,false); + end; + +{ Remove ReponseFile } +{$IFNDEF LinkTest} + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); +{$ENDIF} + MakeSharedLibrary:=success; { otherwise a recursive call to link method } +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef i386} + RegisterExternalLinker(system_i386_solaris_info,TLinkersolaris); + RegisterImport(system_i386_solaris,TImportLibsolaris); + RegisterExport(system_i386_solaris,TExportLibsolaris); + RegisterTarget(system_i386_solaris_info); +{$endif i386} + +{$ifdef x86_64} + RegisterExternalLinker(system_x86_64_solaris_info,TLinkersolaris); + RegisterImport(system_x86_64_solaris,TImportLibsolaris); + RegisterExport(system_x86_64_solaris,TExportLibsolaris); + RegisterTarget(system_x86_64_solaris_info); +{$endif x86_64} + +{$ifdef sparc} + RegisterExternalLinker(system_sparc_solaris_info,TLinkersolaris); + RegisterImport(system_sparc_solaris,TImportLibsolaris); + RegisterExport(system_sparc_solaris,TExportLibsolaris); + RegisterTarget(system_sparc_solaris_info); +{$endif sparc} + + RegisterRes(res_elf_info,TWinLikeResourceFile); +end. diff --git a/closures/compiler/systems/t_symbian.pas b/closures/compiler/systems/t_symbian.pas new file mode 100644 index 0000000000..a11ba00eda --- /dev/null +++ b/closures/compiler/systems/t_symbian.pas @@ -0,0 +1,199 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2007 by contributors of the Free Pascal Compiler + + This unit implements support import,export,link routines + for the Symbian OS target + + 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 t_symbian; + +{$i fpcdefs.inc} + +interface + + uses + cutils,cclasses, + aasmbase,aasmtai,aasmdata,aasmcpu,fmodule,globtype,globals,systems,verbose, + symconst,symdef,symsym, + script,gendef, + cpubase, + import,export,link,cgobj, i_symbian; + + type + TInternalLinkerSymbian = class(TInternalLinker) + constructor create; override; + procedure DefaultLinkScript; override; + procedure InitSysInitUnitName; override; + end; + +implementation + + uses + SysUtils, + cfileutl, + cpuinfo,cgutils,dbgbase, + owar,ogbase,ogcoff, t_win; + +{**************************************************************************** + TInternalLinkerSymbian +****************************************************************************} + + constructor TInternalLinkerSymbian.Create; + begin + inherited Create; + CExeoutput:=TPECoffexeoutput; + CObjInput:=TPECoffObjInput; + end; + + + procedure TInternalLinkerSymbian.DefaultLinkScript; + var + s,s2, + ibase : TCmdStr; + begin + with LinkScript do + begin + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + Concat('READOBJECT '+MaybeQuoted(s)); + end; + while not StaticLibFiles.Empty do + begin + s:=StaticLibFiles.GetFirst; + if s<>'' then + Concat('READSTATICLIBRARY '+MaybeQuoted(s)); + end; + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if FindLibraryFile(s,target_info.staticClibprefix,target_info.staticClibext,s2) then + Concat('READSTATICLIBRARY '+MaybeQuoted(s2)) + else + Comment(V_Error,'Import library not found for '+S); + end; + if IsSharedLibrary then + begin + Concat('ISSHAREDLIBRARY'); + Concat('ENTRYNAME _E32DLL'); + end + else + begin + Concat('ENTRYNAME _E32Startup') + end; + if IsSharedLibrary then + ibase:='10000000' + else + ibase:='400000'; + Concat('IMAGEBASE $' + ibase); + Concat('HEADER'); + Concat('EXESECTION .text'); + Concat(' OBJSECTION .text*'); + Concat(' SYMBOL ___CTOR_LIST__'); + Concat(' SYMBOL __CTOR_LIST__'); + Concat(' LONG -1'); + Concat(' OBJSECTION .ctor*'); + Concat(' LONG 0'); + Concat(' SYMBOL ___DTOR_LIST__'); + Concat(' SYMBOL __DTOR_LIST__'); + Concat(' LONG -1'); + Concat(' OBJSECTION .dtor*'); + Concat(' LONG 0'); + Concat(' SYMBOL etext'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .data'); + Concat(' SYMBOL __data_start__'); + Concat(' OBJSECTION .data*'); + Concat(' OBJSECTION .fpc*'); + Concat(' SYMBOL edata'); + Concat(' SYMBOL __data_end__'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .rdata'); + Concat(' SYMBOL ___RUNTIME_PSEUDO_RELOC_LIST__'); + Concat(' SYMBOL __RUNTIME_PSEUDO_RELOC_LIST__'); + Concat(' OBJSECTION .rdata_runtime_pseudo_reloc'); + Concat(' SYMBOL ___RUNTIME_PSEUDO_RELOC_LIST_END__'); + Concat(' SYMBOL __RUNTIME_PSEUDO_RELOC_LIST_END__'); + Concat(' OBJSECTION .rdata*'); + Concat(' OBJSECTION .rodata*'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .pdata'); + Concat(' OBJSECTION .pdata'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .bss'); + Concat(' SYMBOL __bss_start__'); + Concat(' OBJSECTION .bss*'); + Concat(' SYMBOL __bss_end__'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .idata'); + Concat(' OBJSECTION .idata$2*'); + Concat(' OBJSECTION .idata$3*'); + Concat(' ZEROS 20'); + Concat(' OBJSECTION .idata$4*'); + Concat(' OBJSECTION .idata$5*'); + Concat(' OBJSECTION .idata$6*'); + Concat(' OBJSECTION .idata$7*'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .edata'); + Concat(' OBJSECTION .edata*'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .rsrc'); + Concat(' OBJSECTION .rsrc*'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .reloc'); + Concat(' OBJSECTION .reloc'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .stab'); + Concat(' OBJSECTION .stab'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .stabstr'); + Concat(' OBJSECTION .stabstr'); + Concat('ENDEXESECTION'); + Concat('STABS'); + Concat('SYMBOLS'); + end; + end; + + + procedure TInternalLinkerSymbian.InitSysInitUnitName; + begin + sysinitunit := 'sysinitpas'; + end; + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef i386} + RegisterInternalLinker(system_i386_symbian_info,TExternalLinkerWin); + RegisterImport(system_i386_symbian,TImportLibWin); + RegisterExport(system_i386_symbian,TExportLibWin); + RegisterDLLScanner(system_i386_symbian,TDLLScannerWin); +// RegisterRes(res_gnu_windres_info); + RegisterTarget(system_i386_symbian_info); +{$endif i386} +{$ifdef arm} +// RegisterExternalLinker(system_arm_symbian_info,TExternalLinkerWin); + RegisterInternalLinker(system_arm_symbian_info,TInternalLinkerWin); + RegisterImport(system_arm_symbian,TImportLibWin); + RegisterExport(system_arm_symbian,TExportLibWin); + RegisterTarget(system_arm_symbian_info); +{$endif arm} +end. diff --git a/closures/compiler/systems/t_watcom.pas b/closures/compiler/systems/t_watcom.pas new file mode 100644 index 0000000000..bcf92d24fc --- /dev/null +++ b/closures/compiler/systems/t_watcom.pas @@ -0,0 +1,179 @@ +{ + Copyright (c) 2003 by Wiktor Sywula + + This unit implements support import, export, link routines + for the (i386) Watcom target + + 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 t_watcom; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + link, + SysUtils, + cclasses,cutils,cfileutl,globtype,globals, + systems,verbose,script,fmodule,i_watcom; + + + type + tlinkerwatcom=class(texternallinker) + private + Function WriteResponseFile(isdll:boolean) : Boolean; + public + constructor Create;override; + procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; +{ function MakeSharedLibrary:boolean;override;} + end; + + +{**************************************************************************** + TLinkerWatcom +****************************************************************************} + +Constructor TLinkerWatcom.Create; +begin + Inherited Create; + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; +end; + + +procedure TLinkerWatcom.SetDefaultInfo; +begin + with Info do + ExeCmd[1]:='wlink system causeway option quiet option nocaseexact $OPT $STRIP name $EXE @$RES'; +end; + +Function TLinkerWatcom.WriteResponseFile(isdll:boolean) : Boolean; +Var + linkres : TLinkRes; + {i : longint;} + s : string; + {linklibc : boolean;} +begin + WriteResponseFile:=False; + + { Open link.res file } + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write object files, start with prt0 } + LinkRes.Add('file '+GetShortName(FindObjectFile('prt0','',false))); + if not ObjectFiles.Empty then + While not ObjectFiles.Empty do + begin + S:=ObjectFiles.GetFirst; + LinkRes.AddFileName('file '+GetShortName(s)); + end; + + { Write staticlibraries } + if not StaticLibFiles.Empty then + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName('file '+GetShortName(s)); + end; + +(* + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + linklibc:=false; + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.Get; + if s<>'c' then + begin + i:=Pos(target_os.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + begin + LinkRes.Add('-l'+s); + linklibc:=true; + end; + end; + { be sure that libc&libgcc is the last lib } + if linklibc then + begin + LinkRes.Add('-lc'); + LinkRes.Add('-lgcc'); + end; +*) +{ Write and Close response } + linkres.writetodisk; + linkres.free; + + WriteResponseFile:=True; +end; + + +function TLinkerWatcom.MakeExecutable:boolean; +var + binstr, + cmdstr : TCmdStr; + success : boolean; + StripStr : string[40]; +begin + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + +{ Create some replacements } + StripStr:='debug dwarf all'; + if (cs_link_strip in current_settings.globalswitches) then + StripStr:=''; + +{ Write used files and libraries } + WriteResponseFile(false); + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$STRIP',StripStr); + success:=DoExec(FindUtil(utilsprefix+BinStr),cmdstr,true,false); + +{ Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + +{function TLinkerWatcom.MakeSharedLibrary:boolean; +begin + MakeSharedLibrary:=false; +end;} + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterExternalLinker(system_i386_watcom_info,TLinkerWatcom); + RegisterTarget(system_i386_watcom_info); +end. diff --git a/closures/compiler/systems/t_wdosx.pas b/closures/compiler/systems/t_wdosx.pas new file mode 100644 index 0000000000..f350e10b36 --- /dev/null +++ b/closures/compiler/systems/t_wdosx.pas @@ -0,0 +1,84 @@ +{ + Copyright (c) 2001-2002 Pavel ?????? + + This unit implements support import,export,link routines + for the (i386) WDOSX target + + 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 t_wdosx; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + cutils, + fmodule,globals,systems, + import,export,link,t_win,i_wdosx; + + type + timportlibwdosx=class(TImportLibWin) + end; + + texportlibwdosx=TExportLibWin; + + TExternalLinkerwdosx=class(TExternalLinkerWin) + public + function MakeExecutable:boolean;override; + end; + + tDLLScannerWdosx=class(TDLLScannerWin) + end; + + +{***************************************************************************** + TIMPORTLIBWDOSX +*****************************************************************************} + +{***************************************************************************** + TExternalLinkerWDOSX +*****************************************************************************} +function TExternalLinkerWdosx.MakeExecutable:boolean; +var + b: boolean; +begin + b := Inherited MakeExecutable; + if b then + DoExec(FindUtil('stubit'),current_module.exefilename^,false,false); + Result := b; +end; + +{**************************************************************************** + TDLLScannerWdosx +****************************************************************************} + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterExternalLinker(system_i386_wdosx_info,TExternalLinkerWdosx); + RegisterImport(system_i386_wdosx,TImportLibWdosx); + RegisterExport(system_i386_wdosx,TExportLibWdosx); + RegisterDLLScanner(system_i386_wdosx,TDLLScannerWdosx); + {RegisterAr(ar_gnu_arw_info);} + {RegisterRes(res_gnu_windres_info);} + RegisterTarget(system_i386_wdosx_info); +end. diff --git a/closures/compiler/systems/t_wii.pas b/closures/compiler/systems/t_wii.pas new file mode 100644 index 0000000000..485eb5bc89 --- /dev/null +++ b/closures/compiler/systems/t_wii.pas @@ -0,0 +1,597 @@ +{ + Copyright (c) 2011 by Francesco Lombardi + + This unit implements support import, export, link routines + for the Wii (PowerPC) target + + 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 t_wii; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + aasmbase, + SysUtils, + cutils,cfileutl,cclasses, + globtype,globals,systems,verbose,script,fmodule,i_wii,link; + + type + TlinkerWii=class(texternallinker) + private + Function WriteResponseFile: Boolean; + public + constructor Create; override; + procedure SetDefaultInfo; override; + function MakeExecutable:boolean; override; + end; + + + +{**************************************************************************** + TLinkerWii +****************************************************************************} + +Constructor TLinkerWii.Create; +begin + Inherited Create; + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; +end; + + +procedure TLinkerWii.SetDefaultInfo; +begin + with Info do + begin + ExeCmd[1]:='ld -g $OPT $DYNLINK $STATIC $GCSECTIONS $STRIP -L. -o $EXE -T $RES'; + end; +end; + + +Function TLinkerWii.WriteResponseFile : Boolean; +Var + linkres : TLinkRes; + i : longint; + HPath : TCmdStrListItem; + s,s1,s2 : TCmdStr; + linklibc, + linklibgcc : boolean; + found1, + found2 : boolean; +begin + WriteResponseFile:=False; + linklibc:=(SharedLibFiles.Find('c')<>nil); + linklibgcc:=(SharedLibFiles.Find('gcc')<>nil); + LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); + + { Write path to search libraries } + HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + s:=HPath.Str; + if (cs_link_on_target in current_settings.globalswitches) then + s:=ScriptFixFileName(s); + LinkRes.Add('-L'+s); + HPath:=TCmdStrListItem(HPath.Next); + end; + HPath:=TCmdStrListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + s:=HPath.Str; + if s<>'' then + LinkRes.Add('SEARCH_DIR('+(maybequoted(s))+')'); + HPath:=TCmdStrListItem(HPath.Next); + end; + + LinkRes.Add('INPUT ('); + { add objectfiles, start with prt0 always } +// s:=FindObjectFile('prt0','',false); +// LinkRes.AddFileName(s); + { try to add crti and crtbegin if linking to C } + if linklibc then + begin + if librarysearchpath.FindFile('ecrti.o',false,s) then + LinkRes.AddFileName(s); + end; + if linklibgcc then + begin + if librarysearchpath.FindFile('crtbegin.o',false,s) then + LinkRes.AddFileName(s); + end; + if linklibc or linklibgcc then + begin + if librarysearchpath.FindFile('crtmain.o',false,s) then + LinkRes.AddFileName(s); + end; + + + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + begin + { vlink doesn't use SEARCH_DIR for object files } + if not(cs_link_on_target in current_settings.globalswitches) then + s:=FindObjectFile(s,'',false); + LinkRes.AddFileName((maybequoted(s))); + end; + end; + + { Write staticlibraries } + if not StaticLibFiles.Empty then + begin + { vlink doesn't need, and doesn't support GROUP } + if (cs_link_on_target in current_settings.globalswitches) then + begin + LinkRes.Add(')'); + LinkRes.Add('GROUP('); + end; + while not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + LinkRes.AddFileName((maybequoted(s))); + end; + end; + + if (cs_link_on_target in current_settings.globalswitches) then + begin + LinkRes.Add(')'); + + { Write sharedlibraries like -l<lib>, also add the needed dynamic linker + here to be sure that it gets linked this is needed for glibc2 systems (PFV) } + linklibc:=false; + linklibgcc:=false; + while not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if s<>'c' then + begin + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + LinkRes.Add('-l'+s); + end + else + begin + LinkRes.Add('-l'+s); + linklibc:=true; + linklibgcc:=true; + end; + end; + { be sure that libc&libgcc is the last lib } + if linklibgcc then + begin + LinkRes.Add('-lgcc'); + end; + if linklibc then + begin + LinkRes.Add('-lc'); + end; + + end + else + begin + while not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + LinkRes.Add('lib'+s+target_info.staticlibext); + end; + LinkRes.Add(')'); + end; + + { objects which must be at the end } + if linklibgcc then + begin + found1:=librarysearchpath.FindFile('crtend.o',false,s1); + if found1 then + begin + LinkRes.Add('INPUT('); + if found1 then + LinkRes.AddFileName(s1); + LinkRes.Add(')'); + end; + end; + if linklibc then + begin + found2:=librarysearchpath.FindFile('ecrtn.o',false,s2); + if found2 then + begin + LinkRes.Add('INPUT('); + if found2 then + LinkRes.AddFileName(s2); + LinkRes.Add(')'); + end; + end; + with linkres do + begin + Add('/*'); + Add(' * Linkscript for Wii'); + Add(' */'); + Add(''); + Add('OUTPUT_FORMAT("elf32-powerpc", "elf32-powerpc", "elf32-powerpc");'); + Add('OUTPUT_ARCH(powerpc:common);'); + Add('EXTERN(_start);'); + Add('ENTRY(_start);'); + Add(''); + Add('PHDRS'); + Add('{'); + Add(' stub PT_LOAD FLAGS(5);'); + Add(' text PT_LOAD FLAGS(5);'); + Add(' data PT_LOAD FLAGS(6);'); + Add('}'); + Add(''); + Add('SECTIONS'); + Add('{'); + Add(' /* stub is loaded at physical address 0x00003400 (though both 0x80003400 and 0x00003400 are equivalent for IOS) */'); + Add(' /* This can also be used to load an arbitrary standalone stub at an arbitrary address in memory, for any purpose */'); + Add(' /* Use -Wl,--section-start,.stub=0xADDRESS to change */'); + Add(' . = 0x00003400;'); + Add(''); + Add(' .stub :'); + Add(' {'); + Add(' KEEP(*(.stub))'); + Add(' } :stub = 0'); + Add(''); + Add(' /* default base address */'); + Add(' /* use -Wl,--section-start,.init=0xADDRESS to change */'); + Add(' . = 0x80004000;'); + Add(''); + Add(' /* Program */'); + Add(' .init :'); + Add(' {'); + Add(' KEEP (*crt0.o(*.init))'); + Add(' KEEP (*(.init))'); + Add(' } :text = 0'); + Add(' .plt : { *(.plt) }'); + Add(' .interp : { *(.interp) }'); + Add(' .hash : { *(.hash) }'); + Add(' .dynsym : { *(.dynsym) }'); + Add(' .dynstr : { *(.dynstr) }'); + Add(' .gnu.version : { *(.gnu.version) }'); + Add(' .gnu.version_d : { *(.gnu.version_d) }'); + Add(' .gnu.version_r : { *(.gnu.version_r) }'); + Add(' .rel.init : { *(.rel.init) }'); + Add(' .rela.init : { *(.rela.init) }'); + Add(' .rel.text : { *(.rel.text .rel.text.* .rel.gnu.linkonce.t.*) }'); + Add(' .rela.text : { *(.rela.text .rela.text.* .rela.gnu.linkonce.t.*) }'); + Add(' .rel.fini : { *(.rel.fini) }'); + Add(' .rela.fini : { *(.rela.fini) }'); + Add(' .rel.rodata : { *(.rel.rodata .rel.rodata.* .rel.gnu.linkonce.r.*) }'); + Add(' .rela.rodata : { *(.rela.rodata .rela.rodata.* .rela.gnu.linkonce.r.*) }'); + Add(' .rel.data : { *(.rel.data .rel.data.* .rel.gnu.linkonce.d.*) }'); + Add(' .rela.data : { *(.rela.data .rela.data.* .rela.gnu.linkonce.d.*) }'); + Add(' .rel.tdata : { *(.rel.tdata .rel.tdata.* .rel.gnu.linkonce.td.*) }'); + Add(' .rela.tdata : { *(.rela.tdata .rela.tdata.* .rela.gnu.linkonce.td.*) }'); + Add(' .rel.tbss : { *(.rel.tbss .rel.tbss.* .rel.gnu.linkonce.tb.*) }'); + Add(' .rela.tbss : { *(.rela.tbss .rela.tbss.* .rela.gnu.linkonce.tb.*) }'); + Add(' .rel.ctors : { *(.rel.ctors) }'); + Add(' .rela.ctors : { *(.rela.ctors) }'); + Add(' .rel.dtors : { *(.rel.dtors) }'); + Add(' .rela.dtors : { *(.rela.dtors) }'); + Add(' .rel.got : { *(.rel.got) }'); + Add(' .rela.got : { *(.rela.got) }'); + Add(' .rela.got1 : { *(.rela.got1) }'); + Add(' .rela.got2 : { *(.rela.got2) }'); + Add(' .rel.sdata : { *(.rel.sdata .rel.sdata.* .rel.gnu.linkonce.s.*) }'); + Add(' .rela.sdata : { *(.rela.sdata .rela.sdata.* .rela.gnu.linkonce.s.*) }'); + Add(' .rel.sbss : { *(.rel.sbss .rel.sbss.* .rel.gnu.linkonce.sb.*) }'); + Add(' .rela.sbss : { *(.rela.sbss .rela.sbss.* .rel.gnu.linkonce.sb.*) }'); + Add(' .rel.sdata2 : { *(.rel.sdata2 .rel.sdata2.* .rel.gnu.linkonce.s2.*) }'); + Add(' .rela.sdata2 : { *(.rela.sdata2 .rela.sdata2.* .rela.gnu.linkonce.s2.*) }'); + Add(' .rel.sbss2 : { *(.rel.sbss2 .rel.sbss2.* .rel.gnu.linkonce.sb2.*) }'); + Add(' .rela.sbss2 : { *(.rela.sbss2 .rela.sbss2.* .rela.gnu.linkonce.sb2.*) }'); + Add(' .rel.bss : { *(.rel.bss .rel.bss.* .rel.gnu.linkonce.b.*) }'); + Add(' .rela.bss : { *(.rela.bss .rela.bss.* .rela.gnu.linkonce.b.*) }'); + Add(' .rel.plt : { *(.rel.plt) }'); + Add(' .rela.plt : { *(.rela.plt) }'); + Add(''); + Add(' .text :'); + Add(' {'); + Add(' *(.text)'); + Add(' *(.text.*)'); + Add(' /* .gnu.warning sections are handled specially by elf32.em. */'); + Add(' *(.gnu.warning)'); + Add(' *(.gnu.linkonce.t.*)'); + Add(' . = ALIGN(32); /* REQUIRED. LD is flaky without it. */'); + Add(' } = 0'); + Add(''); + Add(' .fini :'); + Add(' {'); + Add(' KEEP (*(.fini))'); + Add(' . = ALIGN(32); /* REQUIRED. LD is flaky without it. */'); + Add(' } = 0'); + Add(' '); + Add(' PROVIDE (__etext = .);'); + Add(' PROVIDE (_etext = .);'); + Add(' PROVIDE (etext = .);'); + Add(''); + Add(' .rodata : { *(.rodata) *(.rodata.*) *(.gnu.linkonce.r.*) } :data'); + Add(' .rodata1 : { *(.rodata1) }'); + Add(' .sdata2 : { *(.sdata2) *(.sdata2.*) *(.gnu.linkonce.s2.*) }'); + Add(' .sbss2 : { *(.sbss2) *(.sbss2.*) *(.gnu.linkonce.sb2.*) }'); + Add(' /* Adjust the address for the data segment. We want to adjust up to'); + Add(' the same address within the page on the next page up. */'); + Add(' /* Ensure the __preinit_array_start label is properly aligned. We'); + Add(' could instead move the label definition inside the section, but'); + Add(' the linker would then create the section even if it turns out to'); + Add(' be empty, which isn''t pretty. */'); + Add(' . = ALIGN(32 / 8);'); + Add(' PROVIDE (__preinit_array_start = .);'); + Add(' .preinit_array : { *(.preinit_array) }'); + Add(' PROVIDE (__preinit_array_end = .);'); + Add(' PROVIDE (__init_array_start = .);'); + Add(' .init_array : { *(.init_array) }'); + Add(' PROVIDE (__init_array_end = .);'); + Add(' PROVIDE (__fini_array_start = .);'); + Add(' .fini_array : { *(.fini_array) }'); + Add(' PROVIDE (__fini_array_end = .);'); + Add(' .data :'); + Add(' {'); + Add(' *(.data)'); + Add(' *(.data.*)'); + Add(' *(.gnu.linkonce.d.*)'); + Add(' SORT(CONSTRUCTORS)'); + Add(' . = ALIGN(32); /* REQUIRED. LD is flaky without it. */'); + Add(' }'); + Add(''); + Add(' .data1 : { *(.data1) }'); + Add(' .tdata : { *(.tdata .tdata.* .gnu.linkonce.td.*) }'); + Add(' .tbss : { *(.tbss .tbss.* .gnu.linkonce.tb.*) *(.tcommon) }'); + Add(' .eh_frame : { KEEP (*(.eh_frame)) }'); + Add(' .gcc_except_table : { *(.gcc_except_table) }'); + Add(' .fixup : { *(.fixup) }'); + Add(' .got1 : { *(.got1) }'); + Add(' .got2 : { *(.got2) }'); + Add(' .dynamic : { *(.dynamic) }'); + Add(''); + Add(' .ctors :'); + Add(' {'); + Add(' /* gcc uses crtbegin.o to find the start of'); + Add(' the constructors, so we make sure it is'); + Add(' first. Because this is a wildcard, it'); + Add(' doesn''t matter if the user does not'); + Add(' actually link against crtbegin.o; the'); + Add(' linker won''t look for a file to match a'); + Add(' wildcard. The wildcard also means that it'); + Add(' doesn''t matter which directory crtbegin.o'); + Add(' is in. */'); + Add(''); + Add(' KEEP (*crtbegin.o(.ctors))'); + Add(''); + Add(' /* We don''t want to include the .ctor section from'); + Add(' from the crtend.o file until after the sorted ctors.'); + Add(' The .ctor section from the crtend file contains the'); + Add(' end of ctors marker and it must be last */'); + Add(''); + Add(' KEEP (*(EXCLUDE_FILE (*crtend.o ) .ctors))'); + Add(' KEEP (*(SORT(.ctors.*)))'); + Add(' KEEP (*(.ctors))'); + Add(' . = ALIGN(32); /* REQUIRED. LD is flaky without it. */'); + Add(' }'); + Add(''); + Add(' .dtors :'); + Add(' {'); + Add(' KEEP (*crtbegin.o(.dtors))'); + Add(' KEEP (*(EXCLUDE_FILE (*crtend.o ) .dtors))'); + Add(' KEEP (*(SORT(.dtors.*)))'); + Add(' KEEP (*(.dtors))'); + Add(' . = ALIGN(32); /* REQUIRED. LD is flaky without it. */'); + Add(' }'); + Add(''); + Add(' .jcr : { KEEP (*(.jcr)) }'); + Add(' .got : { *(.got.plt) *(.got) }'); + Add(''); + Add(''); + Add(' /* We want the small data sections together, so single-instruction offsets'); + Add(' can access them all, and initialized data all before uninitialized, so'); + Add(' we can shorten the on-disk segment size. */'); + Add(''); + Add(' .sdata :'); + Add(' {'); + Add(' *(.sdata)'); + Add(' *(.sdata.*)'); + Add(' *(.gnu.linkonce.s.*)'); + Add(' . = ALIGN(32); /* REQUIRED. LD is flaky without it. */'); + Add(' }'); + Add(''); + Add(' _edata = .;'); + Add(' PROVIDE (edata = .);'); + Add(' '); + Add(' .sbss :'); + Add(' {'); + Add(' __sbss_start = .;'); + Add(' PROVIDE (__sbss_start = .);'); + Add(' PROVIDE (___sbss_start = .);'); + Add(' *(.dynsbss)'); + Add(' *(.sbss)'); + Add(' *(.sbss.*)'); + Add(' *(.gnu.linkonce.sb.*)'); + Add(' *(.scommon)'); + Add(' PROVIDE (__sbss_end = .);'); + Add(' PROVIDE (___sbss_end = .);'); + Add(' . = ALIGN(32); /* REQUIRED. LD is flaky without it. */'); + Add(' __sbss_end = .;'); + Add(' }'); + Add(''); + Add(' .bss :'); + Add(' {'); + Add(' __bss_start = .;'); + Add(' PROVIDE (__bss_start = .);'); + Add(' *(.dynbss)'); + Add(' *(.bss)'); + Add(' *(.bss.*)'); + Add(' *(.gnu.linkonce.b.*)'); + Add(' *(COMMON)'); + Add(' /* Align here to ensure that the .bss section occupies space up to'); + Add(' _end. Align after .bss to ensure correct alignment even if the'); + Add(' .bss section disappears because there are no input sections. */'); + Add(''); + Add(' . = ALIGN(32);'); + Add(''); + Add(' PROVIDE (__bss_end = .);'); + Add(' __bss_end = .;'); + Add(' }'); + Add(''); + Add(' _end = .;'); + Add(' PROVIDE(end = .);'); + Add(' /* Stabs debugging sections. */'); + Add(' .stab 0 : { *(.stab) }'); + Add(' .stabstr 0 : { *(.stabstr) }'); + Add(' .stab.excl 0 : { *(.stab.excl) }'); + Add(' .stab.exclstr 0 : { *(.stab.exclstr) }'); + Add(' .stab.index 0 : { *(.stab.index) }'); + Add(' .stab.indexstr 0 : { *(.stab.indexstr) }'); + Add(' .comment 0 : { *(.comment) }'); + Add(' /* DWARF debug sections.'); + Add(' Symbols in the DWARF debugging sections are relative to the beginning'); + Add(' of the section so we begin them at 0. */'); + Add(' /* DWARF 1 */'); + Add(' .debug 0 : { *(.debug) }'); + Add(' .line 0 : { *(.line) }'); + Add(' /* GNU DWARF 1 extensions */'); + Add(' .debug_srcinfo 0 : { *(.debug_srcinfo) }'); + Add(' .debug_sfnames 0 : { *(.debug_sfnames) }'); + Add(' /* DWARF 1.1 and DWARF 2 */'); + Add(' .debug_aranges 0 : { *(.debug_aranges) }'); + Add(' .debug_pubnames 0 : { *(.debug_pubnames) }'); + Add(' /* DWARF 2 */'); + Add(' .debug_info 0 : { *(.debug_info) }'); + Add(' .debug_abbrev 0 : { *(.debug_abbrev) }'); + Add(' .debug_line 0 : { *(.debug_line) }'); + Add(' .debug_frame 0 : { *(.debug_frame) }'); + Add(' .debug_str 0 : { *(.debug_str) }'); + Add(' .debug_loc 0 : { *(.debug_loc) }'); + Add(' .debug_macinfo 0 : { *(.debug_macinfo) }'); + Add(' /* SGI/MIPS DWARF 2 extensions */'); + Add(' .debug_weaknames 0 : { *(.debug_weaknames) }'); + Add(' .debug_funcnames 0 : { *(.debug_funcnames) }'); + Add(' .debug_typenames 0 : { *(.debug_typenames) }'); + Add(' .debug_varnames 0 : { *(.debug_varnames) }'); + Add(' /* These must appear regardless of . */'); + Add('}'); + Add(''); + Add('__isIPL = 0;'); + Add('__stack_addr = (__bss_start + SIZEOF(.bss) + 0x20000 + 7) & (-8);'); + Add('__stack_end = (__bss_start + SIZEOF(.bss));'); + Add('__intrstack_addr = (__stack_addr + 0x4000);'); + Add('__intrstack_end = (__stack_addr);'); + Add('__Arena1Lo = (__intrstack_addr + 31) & (-32);'); + Add('__Arena1Hi = (0x817FEFF0);'); + Add('__Arena2Lo = (0x90002000);'); + Add('__Arena2Hi = (0x933E0000);'); + Add(''); + Add('__gxregs = (__Arena1Hi + 31) & (-32);'); + Add('__ipcbufferLo = (0x933e0000);'); + Add('__ipcbufferHi = (0x93400000);'); + Add(''); + Add('/* for backward compatibility with old crt0 */'); + Add('PROVIDE (__stack = (0x817FEFF0));'); + Add(''); + Add('PROVIDE(__isIPL = __isIPL);'); + Add('PROVIDE(__stack_addr = __stack_addr);'); + Add('PROVIDE(__stack_end = __stack_end);'); + Add('PROVIDE(__intrstack_addr = __intrstack_addr);'); + Add('PROVIDE(__intrstack_end = __intrstack_end);'); + Add('PROVIDE(__Arena1Lo = __Arena1Lo);'); + Add('PROVIDE(__Arena1Hi = __Arena1Hi);'); + Add('PROVIDE(__Arena2Lo = __Arena2Lo);'); + Add('PROVIDE(__Arena2Hi = __Arena2Hi);'); + Add('PROVIDE(__ipcbufferLo = __ipcbufferLo);'); + Add('PROVIDE(__ipcbufferHi = __ipcbufferHi);'); + Add('PROVIDE(__gxregs = __gxregs);'); + end; + + +{ Write and Close response } + linkres.writetodisk; + linkres.free; + + WriteResponseFile:=True; + +end; + + +function TLinkerWii.MakeExecutable:boolean; +var + binstr, + cmdstr : TCmdStr; + success : boolean; + StaticStr, + GCSectionsStr, + DynLinkStr, + StripStr: string; +begin + StaticStr:=''; + StripStr:=''; + GCSectionsStr:=''; + DynLinkStr:=''; + + if (cs_link_strip in current_settings.globalswitches) and + not(cs_link_separate_dbg_file in current_settings.globalswitches) then + StripStr:='-s'; + if (cs_link_map in current_settings.globalswitches) then + StripStr:='-Map '+maybequoted(ChangeFileExt(current_module.exefilename^,'.map')); + if create_smartlink_sections then + GCSectionsStr:='--gc-sections'; + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + + +{ Write used files and libraries } + WriteResponseFile(); + +{ Call linker } + SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr); + Replace(cmdstr,'$EXE',(maybequoted(ScriptFixFileName(ChangeFileExt(current_module.exefilename^,'.elf'))))); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',(maybequoted(ScriptFixFileName(outputexedir+Info.ResName)))); + Replace(cmdstr,'$STATIC',StaticStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$GCSECTIONS',GCSectionsStr); + Replace(cmdstr,'$DYNLINK',DynLinkStr); + + success:=DoExec(FindUtil(utilsprefix+BinStr),cmdstr,true,false); + +{ Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + DeleteFile(outputexedir+Info.ResName); + +{ Post process } + + if success then + begin + success:=DoExec(FindUtil('elf2dol'),ChangeFileExt(current_module.exefilename^,'.elf')+' '+ + current_module.exefilename^,true,false); + end; + MakeExecutable:=success; { otherwise a recursive call to link method } +end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization + RegisterExternalLinker(system_powerpc_wii_info,TLinkerWii); + RegisterTarget(system_powerpc_wii_info); +end. diff --git a/closures/compiler/systems/t_win.pas b/closures/compiler/systems/t_win.pas new file mode 100644 index 0000000000..f0ed350df2 --- /dev/null +++ b/closures/compiler/systems/t_win.pas @@ -0,0 +1,1882 @@ +{ + Copyright (c) 1998-2008 by Peter Vreman + + This unit implements support import,export,link routines + for the (i386) Win32 target + + 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 t_win; + +{$i fpcdefs.inc} + +interface + + uses + cutils,cclasses, + aasmbase,aasmtai,aasmdata,aasmcpu,fmodule,globtype,globals,systems,verbose, + symconst,symdef,symsym, + script,gendef, + cpubase, + import,export,link,comprsrc,cgobj,i_win; + + + const + MAX_DEFAULT_EXTENSIONS = 3; + + type + tStr4=array[1..MAX_DEFAULT_EXTENSIONS] of string[4]; + pStr4=^tStr4; + + TImportLibWin=class(timportlib) + private + procedure generateimportlib; + procedure generateidatasection; + public + procedure generatelib;override; + end; + + TExportLibWin=class(texportlib) + private + st : string; + EList_indexed:TFPList; + EList_nonindexed:TFPList; + public + destructor Destroy;override; + procedure preparelib(const s:string);override; + procedure exportprocedure(hp : texported_item);override; + procedure exportvar(hp : texported_item);override; + procedure exportfromlist(hp : texported_item); + procedure generatelib;override; + procedure generatenasmlib;virtual; + end; + + TInternalLinkerWin = class(tinternallinker) + constructor create;override; + procedure DefaultLinkScript;override; + procedure InitSysInitUnitName;override; + procedure ConcatEntryName; virtual; + end; + + TExternalLinkerWin=class(texternallinker) + private + Function WriteResponseFile(isdll:boolean) : Boolean; + Function PostProcessExecutable(const fn:string;isdll:boolean) : Boolean; + public + Constructor Create;override; + Procedure SetDefaultInfo;override; + function MakeExecutable:boolean;override; + function MakeSharedLibrary:boolean;override; + procedure InitSysInitUnitName;override; + end; + + TDLLScannerWin=class(tDLLScanner) + private + importfound : boolean; + procedure CheckDLLFunc(const dllname,funcname:string); + public + function Scan(const binname:string):boolean;override; + end; + +implementation + + uses + SysUtils, + cfileutl, + cpuinfo,cgutils,dbgbase, + owar,ogbase,ogcoff; + + + const +{$ifndef x86_64} + res_gnu_windres_info : tresinfo = + ( + id : res_gnu_windres; + resbin : 'fpcres'; + rescmd : '-o $OBJ -a $ARCH -of coff $DBG'; + rcbin : 'windres'; + rccmd : '--include $INC -O res -o $RES $RC'; + resourcefileclass : nil; + resflags : []; + ); +{$else x86_64} + res_win64_gorc_info : tresinfo = + ( + id : res_win64_gorc; + resbin : 'fpcres'; + rescmd : '-o $OBJ -a $ARCH -of coff $DBG'; + rcbin : 'gorc'; + rccmd : '/machine x64 /nw /ni /r /fo $RES $RC'; + resourcefileclass : nil; + resflags : []; + ); +{$endif x86_64} + + + Procedure GlobalInitSysInitUnitName(Linker : TLinker); + var + hp : tmodule; + linkcygwin : boolean; + begin + hp:=tmodule(loaded_units.first); + while assigned(hp) do + begin + linkcygwin := hp.linkothersharedlibs.find('cygwin') or hp.linkotherstaticlibs.find('cygwin'); + if linkcygwin then + break; + hp:=tmodule(hp.next); + end; + if cs_profile in current_settings.moduleswitches then + linker.sysinitunit:='sysinitgprof' + else if linkcygwin or (Linker.SharedLibFiles.Find('cygwin')<>nil) or (Linker.StaticLibFiles.Find('cygwin')<>nil) then + linker.sysinitunit:='sysinitcyg' + else + linker.sysinitunit:='sysinitpas'; + end; + + +{***************************************************************************** + TImportLibWin +*****************************************************************************} + + procedure TImportLibWin.generateimportlib; + var + ObjWriter : tarobjectwriter; + ObjOutput : TPECoffObjOutput; + basedllname : string; + AsmPrefix : string; + idatalabnr, + SmartFilesCount, + SmartHeaderCount : longint; + + function CreateObjData(place:tcutplace):TObjData; + var + s : string; + begin + s:=''; + 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; + inc(SmartFilesCount); + result:=ObjOutput.NewObjData(FixFileName(s+tostr(SmartFilesCount)+target_info.objext)); + ObjOutput.startobjectfile(Result.Name); + end; + + procedure WriteObjData(objdata:TObjData); + begin + ObjOutput.writeobjectfile(ObjData); + end; + + procedure StartImport(const dllname:string); + var + headlabel, + idata4label, + idata5label, + idata7label : TObjSymbol; + emptyint : longint; + objdata : TObjData; + idata2objsection, + idata4objsection, + idata5objsection : TObjSection; + begin + objdata:=CreateObjData(cut_begin); + idata2objsection:=objdata.createsection(sec_idata2,''); + idata4objsection:=objdata.createsection(sec_idata4,''); + idata5objsection:=objdata.createsection(sec_idata5,''); + emptyint:=0; + basedllname:=ExtractFileName(dllname); + { idata4 } + objdata.SetSection(idata4objsection); + idata4label:=objdata.SymbolDefine(asmprefix+'_names_'+basedllname,AB_GLOBAL,AT_DATA); + { idata5 } + objdata.SetSection(idata5objsection); + idata5label:=objdata.SymbolDefine(asmprefix+'_fixup_'+basedllname,AB_GLOBAL,AT_DATA); + { idata2 } + objdata.SetSection(idata2objsection); + headlabel:=objdata.SymbolDefine(asmprefix+'_head_'+basedllname,AB_GLOBAL,AT_DATA); + ObjOutput.exportsymbol(headlabel); + objdata.writereloc(0,sizeof(longint),idata4label,RELOC_RVA); + objdata.writebytes(emptyint,sizeof(emptyint)); + objdata.writebytes(emptyint,sizeof(emptyint)); + idata7label:=objdata.SymbolRef(asmprefix+'_dll_'+basedllname); + objdata.writereloc(0,sizeof(longint),idata7label,RELOC_RVA); + objdata.writereloc(0,sizeof(longint),idata5label,RELOC_RVA); + WriteObjData(objdata); + objdata.free; + end; + + procedure EndImport; + var + idata7label : TObjSymbol; + emptyint : longint; + objdata : TObjData; + idata4objsection, + idata5objsection, + idata7objsection : TObjSection; + begin + objdata:=CreateObjData(cut_end); + idata4objsection:=objdata.createsection(sec_idata4,''); + idata5objsection:=objdata.createsection(sec_idata5,''); + idata7objsection:=objdata.createsection(sec_idata7,''); + emptyint:=0; + { idata4 } + objdata.SetSection(idata4objsection); + objdata.writebytes(emptyint,sizeof(emptyint)); + if target_info.system=system_x86_64_win64 then + objdata.writebytes(emptyint,sizeof(emptyint)); + { idata5 } + objdata.SetSection(idata5objsection); + objdata.writebytes(emptyint,sizeof(emptyint)); + if target_info.system=system_x86_64_win64 then + objdata.writebytes(emptyint,sizeof(emptyint)); + { idata7 } + objdata.SetSection(idata7objsection); + idata7label:=objdata.SymbolDefine(asmprefix+'_dll_'+basedllname,AB_GLOBAL,AT_DATA); + objoutput.exportsymbol(idata7label); + objdata.writebytes(basedllname[1],length(basedllname)); + objdata.writebytes(emptyint,1); + WriteObjData(objdata); + objdata.free; + end; + + procedure AddImport(const afuncname,mangledname:string;ordnr:longint;isvar:boolean); + const +{$ifdef x86_64} + jmpopcode : array[0..1] of byte = ( + $ff,$25 // jmp qword [rip + offset32] + ); +{$else x86_64} + {$ifdef arm} + jmpopcode : array[0..7] of byte = ( + $00,$c0,$9f,$e5, // ldr ip, [pc, #0] + $00,$f0,$9c,$e5 // ldr pc, [ip] + ); + {$else arm} + jmpopcode : array[0..1] of byte = ( + $ff,$25 + ); + {$endif arm} +{$endif x86_64} + nopopcodes : array[0..1] of byte = ( + $90,$90 + ); + var + implabel, + idata2label, + idata5label, + idata6label : TObjSymbol; + emptyint : longint; + objdata : TObjData; + textobjsection, + idata4objsection, + idata5objsection, + idata6objsection, + idata7objsection : TObjSection; + absordnr: word; + + procedure WriteTableEntry; + var + ordint: dword; + begin + if ordnr <= 0 then + begin + { import by name } + objdata.writereloc(0,sizeof(longint),idata6label,RELOC_RVA); + if target_info.system=system_x86_64_win64 then + objdata.writebytes(emptyint,sizeof(emptyint)); + end + else + begin + { import by ordinal } + ordint:=ordnr; + if target_info.system=system_x86_64_win64 then + begin + objdata.writebytes(ordint,sizeof(ordint)); + ordint:=$80000000; + objdata.writebytes(ordint,sizeof(ordint)); + end + else + begin + ordint:=ordint or $80000000; + objdata.writebytes(ordint,sizeof(ordint)); + end; + end; + end; + + begin + objdata:=CreateObjData(cut_normal); + if not isvar then + textobjsection:=objdata.createsection(sec_code,''); + idata4objsection:=objdata.createsection(sec_idata4,''); + idata5objsection:=objdata.createsection(sec_idata5,''); + idata6objsection:=objdata.createsection(sec_idata6,''); + idata7objsection:=objdata.createsection(sec_idata7,''); + emptyint:=0; + { idata7, link to head } + objdata.SetSection(idata7objsection); + idata2label:=objdata.SymbolRef(asmprefix+'_head_'+basedllname); + objdata.writereloc(0,sizeof(longint),idata2label,RELOC_RVA); + { idata6, import data (ordnr+name) } + objdata.SetSection(idata6objsection); + inc(idatalabnr); + idata6label:=objdata.SymbolDefine(asmprefix+'_'+tostr(idatalabnr),AB_LOCAL,AT_DATA); + absordnr:=Abs(ordnr); + { write index hint } + objdata.writebytes(absordnr,2); + if ordnr <= 0 then + objdata.writebytes(afuncname[1],length(afuncname)); + objdata.writebytes(emptyint,1); + objdata.writebytes(emptyint,align(objdata.CurrObjSec.size,2)-objdata.CurrObjSec.size); + { idata4, import lookup table } + objdata.SetSection(idata4objsection); + WriteTableEntry; + { idata5, import address table } + objdata.SetSection(idata5objsection); + if isvar then + implabel:=objdata.SymbolDefine(mangledname,AB_GLOBAL,AT_DATA) + else + idata5label:=objdata.SymbolDefine(asmprefix+'_'+mangledname,AB_LOCAL,AT_DATA); + WriteTableEntry; + { text, jmp } + if not isvar then + begin + objdata.SetSection(textobjsection); + if mangledname <> '' then + implabel:=objdata.SymbolDefine(mangledname,AB_GLOBAL,AT_FUNCTION) + else + implabel:=objdata.SymbolDefine(basedllname+'_index_'+tostr(ordnr),AB_GLOBAL,AT_FUNCTION); + objdata.writebytes(jmpopcode,sizeof(jmpopcode)); +{$ifdef x86_64} + objdata.writereloc(0,sizeof(longint),idata5label,RELOC_RELATIVE); +{$else} + objdata.writereloc(0,sizeof(longint),idata5label,RELOC_ABSOLUTE32); +{$endif x86_64} + objdata.writebytes(nopopcodes,align(objdata.CurrObjSec.size,sizeof(nopopcodes))-objdata.CurrObjSec.size); + end; + ObjOutput.exportsymbol(implabel); + WriteObjData(objdata); + objdata.free; + end; + + var + i,j : longint; + ImportLibrary : TImportLibrary; + ImportSymbol : TImportSymbol; + begin + AsmPrefix:='imp'+Lower(current_module.modulename^); + idatalabnr:=0; + SmartFilesCount:=0; + SmartHeaderCount:=0; + current_module.linkotherstaticlibs.add(current_module.importlibfilename^,link_always); + ObjWriter:=TARObjectWriter.create(current_module.importlibfilename^); + ObjOutput:=TPECoffObjOutput.Create(ObjWriter); + for i:=0 to current_module.ImportLibraryList.Count-1 do + begin + ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]); + StartImport(ImportLibrary.Name); + for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do + begin + ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]); + AddImport(ImportSymbol.Name,ImportSymbol.MangledName,ImportSymbol.OrdNr,ImportSymbol.IsVar); + end; + EndImport; + end; + ObjOutput.Free; + ObjWriter.Free; + end; + + + procedure TImportLibWin.generateidatasection; + var + templab, + l1,l2,l3,l4 {$ifdef ARM} ,l5 {$endif ARM} : tasmlabel; + importname : string; + suffix : integer; + href : treference; + i,j : longint; + ImportLibrary : TImportLibrary; + ImportSymbol : TImportSymbol; + ImportLabels : TFPList; + begin + if current_asmdata.asmlists[al_imports]=nil then + current_asmdata.asmlists[al_imports]:=TAsmList.create; + + if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then + begin + new_section(current_asmdata.asmlists[al_imports],sec_code,'',0); + for i:=0 to current_module.ImportLibraryList.Count-1 do + begin + ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]); + for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do + begin + ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]); + current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_extern,ImportSymbol.Name)); + current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_nasm_import,ImportSymbol.Name+' '+ImportLibrary.Name+' '+ImportSymbol.Name)); + end; + end; + exit; + end; + + for i:=0 to current_module.ImportLibraryList.Count-1 do + begin + ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]); + { align al_procedures for the jumps } + new_section(current_asmdata.asmlists[al_imports],sec_code,'',sizeof(aint)); + { Get labels for the sections } + current_asmdata.getjumplabel(l1); + current_asmdata.getjumplabel(l2); + current_asmdata.getjumplabel(l3); + new_section(current_asmdata.asmlists[al_imports],sec_idata2,'',0); + { pointer to procedure names } + current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(l2)); + { two empty entries follow } + current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0)); + current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0)); + { pointer to dll name } + current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(l1)); + { pointer to fixups } + current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(l3)); + + { only create one section for each else it will + create a lot of idata* } + + { first write the name references } + new_section(current_asmdata.asmlists[al_imports],sec_idata4,'',0); + current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l2)); + + ImportLabels:=TFPList.Create; + ImportLabels.Count:=ImportLibrary.ImportSymbolList.Count; + for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do + begin + ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]); + + current_asmdata.getjumplabel(templab); + ImportLabels[j]:=templab; + if ImportSymbol.Name<>'' then + begin + current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(TAsmLabel(ImportLabels[j]))); + if target_info.system=system_x86_64_win64 then + current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0)); + end + else + begin + if target_info.system=system_x86_64_win64 then + current_asmdata.asmlists[al_imports].concat(Tai_const.Create_64bit(int64($8000000000000000) or ImportSymbol.ordnr)) + else + current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(longint($80000000) or ImportSymbol.ordnr)); + end; + end; + { finalize the names ... } + current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0)); + if target_info.system=system_x86_64_win64 then + current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0)); + + { then the addresses and create also the indirect jump } + new_section(current_asmdata.asmlists[al_imports],sec_idata5,'',0); + current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l3)); + + for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do + begin + ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]); + if not ImportSymbol.IsVar then + begin + current_asmdata.getjumplabel(l4); + {$ifdef ARM} + current_asmdata.getjumplabel(l5); + {$endif ARM} + { create indirect jump and } + { place jump in al_procedures } + new_section(current_asmdata.asmlists[al_imports],sec_code,'',0); + if ImportSymbol.Name <> '' then + current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(ImportSymbol.MangledName,AT_FUNCTION,0)) + else + current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(ExtractFileName(ImportLibrary.Name)+'_index_'+tostr(ImportSymbol.ordnr),AT_FUNCTION,0)); + current_asmdata.asmlists[al_imports].concat(tai_function_name.create('')); + {$ifdef ARM} + reference_reset_symbol(href,l5,0,sizeof(pint)); + current_asmdata.asmlists[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R12,href)); + reference_reset_base(href,NR_R12,0,sizeof(pint)); + current_asmdata.asmlists[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R15,href)); + current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l5)); + reference_reset_symbol(href,l4,0,sizeof(pint)); + current_asmdata.asmlists[al_imports].concat(tai_const.create_sym_offset(href.symbol,href.offset)); + {$else ARM} + reference_reset_symbol(href,l4,0,sizeof(pint)); +{$ifdef X86_64} + href.base:=NR_RIP; +{$endif X86_64} + + current_asmdata.asmlists[al_imports].concat(Taicpu.Op_ref(A_JMP,S_NO,href)); + current_asmdata.asmlists[al_imports].concat(Tai_align.Create_op(4,$90)); + {$endif ARM} + { add jump field to al_imports } + new_section(current_asmdata.asmlists[al_imports],sec_idata5,'',0); + if (cs_debuginfo in current_settings.moduleswitches) then + begin + if ImportSymbol.MangledName<>'' then + begin + importname:='__imp_'+ImportSymbol.MangledName; + suffix:=0; + while assigned(current_asmdata.getasmsymbol(importname)) do + begin + inc(suffix); + importname:='__imp_'+ImportSymbol.MangledName+'_'+tostr(suffix); + end; + current_asmdata.asmlists[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4)); + end + else + begin + importname:='__imp_by_ordinal'+tostr(ImportSymbol.ordnr); + suffix:=0; + while assigned(current_asmdata.getasmsymbol(importname)) do + begin + inc(suffix); + importname:='__imp_by_ordinal'+tostr(ImportSymbol.ordnr)+'_'+tostr(suffix); + end; + current_asmdata.asmlists[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4)); + end; + end; + current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l4)); + end + else + current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(ImportSymbol.MangledName,AT_DATA,0)); + current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(TAsmLabel(Importlabels[j]))); + if target_info.system=system_x86_64_win64 then + current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0)); + end; + { finalize the addresses } + current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0)); + if target_info.system=system_x86_64_win64 then + current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0)); + + { finally the import information } + new_section(current_asmdata.asmlists[al_imports],sec_idata6,'',0); + for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do + begin + ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]); + current_asmdata.asmlists[al_imports].concat(Tai_label.Create(TAsmLabel(ImportLabels[j]))); + { the ordinal number } + current_asmdata.asmlists[al_imports].concat(Tai_const.Create_16bit(ImportSymbol.ordnr)); + current_asmdata.asmlists[al_imports].concat(Tai_string.Create(ImportSymbol.Name+#0)); + current_asmdata.asmlists[al_imports].concat(Tai_align.Create_op(2,0)); + end; + { create import dll name } + new_section(current_asmdata.asmlists[al_imports],sec_idata7,'',0); + current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l1)); + current_asmdata.asmlists[al_imports].concat(Tai_string.Create(ImportLibrary.Name+#0)); + ImportLabels.Free; + ImportLabels:=nil; + end; + end; + + + procedure TImportLibWin.generatelib; + begin + if GenerateImportSection then + generateidatasection + else + generateimportlib; + end; + + +{***************************************************************************** + TExportLibWin +*****************************************************************************} + + destructor TExportLibWin.Destroy; + begin + EList_indexed.Free; + EList_nonindexed.Free; + inherited; + end; + + + procedure TExportLibWin.preparelib(const s:string); + begin + if current_asmdata.asmlists[al_exports]=nil then + current_asmdata.asmlists[al_exports]:=TAsmList.create; + if EList_indexed=nil then + EList_indexed:=tFPList.Create; + if EList_nonindexed=nil then + EList_nonindexed:=tFPList.Create; + end; + + + procedure TExportLibWin.exportvar(hp : texported_item); + begin + { same code used !! PM } + exportprocedure(hp); + end; + + var + Gl_DoubleIndex:boolean; + Gl_DoubleIndexValue:longint; + + function IdxCompare(Item1, Item2: Pointer): Integer; + var + I1:texported_item absolute Item1; + I2:texported_item absolute Item2; + begin + Result:=I1.index-I2.index; + if(Result=0)and(Item1<>Item2)then + begin + Gl_DoubleIndex:=true; + Gl_DoubleIndexValue:=I1.index; + end; + end; + + + procedure TExportLibWin.exportprocedure(hp : texported_item); + begin + if ((hp.options and eo_index)<>0) and ((hp.index<=0) or (hp.index>$ffff)) then + begin + message1(parser_e_export_invalid_index,tostr(hp.index)); + exit; + end; + if hp.options and eo_index=eo_index then + EList_indexed.Add(hp) + else + EList_nonindexed.Add(hp); + end; + + + procedure TExportLibWin.exportfromlist(hp : texported_item); + //formerly TExportLibWin.exportprocedure + { must be ordered at least for win32 !! } + var + hp2 : texported_item; + begin + hp2:=texported_item(current_module._exports.first); + while assigned(hp2) and + (hp.name^>hp2.name^) do + hp2:=texported_item(hp2.next); + { insert hp there !! } + if hp2=nil then + current_module._exports.concat(hp) + else + begin + if hp2.name^=hp.name^ then + begin + { this is not allowed !! } + message1(parser_e_export_name_double,hp.name^); + exit; + end; + current_module._exports.insertbefore(hp,hp2); + end; + end; + + + procedure TExportLibWin.generatelib; + var + ordinal_base,ordinal_max,ordinal_min : longint; + current_index : longint; + entries,named_entries : longint; + name_label,dll_name_label,export_address_table : tasmlabel; + export_name_table_pointers,export_ordinal_table : tasmlabel; + hp,hp2 : texported_item; + temtexport : TLinkedList; + address_table,name_table_pointers, + name_table,ordinal_table : TAsmList; + i,autoindex,ni_high : longint; + hole : boolean; + asmsym : TAsmSymbol; + begin + Gl_DoubleIndex:=false; + ELIst_indexed.Sort(@IdxCompare); + + if Gl_DoubleIndex then + begin + message1(parser_e_export_ordinal_double,tostr(Gl_DoubleIndexValue)); + FreeAndNil(EList_indexed); + FreeAndNil(EList_nonindexed); + exit; + end; + + autoindex:=1; + while EList_nonindexed.Count>0 do + begin + hole:=(EList_indexed.Count>0) and (texported_item(EList_indexed.Items[0]).index>1); + if not hole then + for i:=autoindex to pred(EList_indexed.Count) do + if texported_item(EList_indexed.Items[i]).index-texported_item(EList_indexed.Items[pred(i)]).index>1 then + begin + autoindex:=succ(texported_item(EList_indexed.Items[pred(i)]).index); + hole:=true; + break; + end; + ni_high:=pred(EList_nonindexed.Count); + if not hole then + begin + autoindex:=succ(EList_indexed.Count); + EList_indexed.Add(EList_nonindexed.Items[ni_high]); + end + else + EList_indexed.Insert(pred(AutoIndex),EList_nonindexed.Items[ni_high]); + EList_nonindexed.Delete(ni_high); + texported_item(EList_indexed.Items[pred(AutoIndex)]).index:=autoindex; + end; + FreeAndNil(EList_nonindexed); + for i:=0 to pred(EList_indexed.Count) do + exportfromlist(texported_item(EList_indexed.Items[i])); + FreeAndNil(EList_indexed); + + if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then + begin + generatenasmlib; + exit; + end; + + hp:=texported_item(current_module._exports.first); + if not assigned(hp) then + exit; + + ordinal_max:=0; + ordinal_min:=$7FFFFFFF; + entries:=0; + named_entries:=0; + current_asmdata.getjumplabel(dll_name_label); + current_asmdata.getjumplabel(export_address_table); + current_asmdata.getjumplabel(export_name_table_pointers); + current_asmdata.getjumplabel(export_ordinal_table); + + { count entries } + while assigned(hp) do + begin + inc(entries); + if (hp.index>ordinal_max) then + ordinal_max:=hp.index; + if (hp.index>0) and (hp.index<ordinal_min) then + ordinal_min:=hp.index; + if assigned(hp.name) then + inc(named_entries); + hp:=texported_item(hp.next); + end; + + { no support for higher ordinal base yet !! } + ordinal_base:=1; + current_index:=ordinal_base; + { we must also count the holes !! } + entries:=ordinal_max-ordinal_base+1; + + new_section(current_asmdata.asmlists[al_exports],sec_edata,'',0); + { create label to reference from main so smartlink will include + the .edata section } + current_asmdata.asmlists[al_exports].concat(Tai_symbol.Createname_global(make_mangledname('EDATA',current_module.localsymtable,''),AT_DATA,0)); + { export flags } + current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(0)); + { date/time stamp } + current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(0)); + { major version } + current_asmdata.asmlists[al_exports].concat(Tai_const.Create_16bit(0)); + { minor version } + current_asmdata.asmlists[al_exports].concat(Tai_const.Create_16bit(0)); + { pointer to dll name } + current_asmdata.asmlists[al_exports].concat(Tai_const.Create_rva_sym(dll_name_label)); + { ordinal base normally set to 1 } + current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(ordinal_base)); + { number of entries } + current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(entries)); + { number of named entries } + current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(named_entries)); + { address of export address table } + current_asmdata.asmlists[al_exports].concat(Tai_const.Create_rva_sym(export_address_table)); + { address of name pointer pointers } + current_asmdata.asmlists[al_exports].concat(Tai_const.Create_rva_sym(export_name_table_pointers)); + { address of ordinal number pointers } + current_asmdata.asmlists[al_exports].concat(Tai_const.Create_rva_sym(export_ordinal_table)); + { the name } + current_asmdata.asmlists[al_exports].concat(Tai_label.Create(dll_name_label)); + if st='' then + current_asmdata.asmlists[al_exports].concat(Tai_string.Create(current_module.modulename^+target_info.sharedlibext+#0)) + else + current_asmdata.asmlists[al_exports].concat(Tai_string.Create(st+target_info.sharedlibext+#0)); + + { export address table } + address_table:=TAsmList.create; + address_table.concat(Tai_align.Create_op(4,0)); + address_table.concat(Tai_label.Create(export_address_table)); + name_table_pointers:=TAsmList.create; + name_table_pointers.concat(Tai_align.Create_op(4,0)); + name_table_pointers.concat(Tai_label.Create(export_name_table_pointers)); + ordinal_table:=TAsmList.create; + ordinal_table.concat(Tai_align.Create_op(4,0)); + ordinal_table.concat(Tai_label.Create(export_ordinal_table)); + name_table:=TAsmList.Create; + name_table.concat(Tai_align.Create_op(4,0)); + { write each address } + hp:=texported_item(current_module._exports.first); + while assigned(hp) do + begin + if (hp.options and eo_name)<>0 then + begin + current_asmdata.getjumplabel(name_label); + name_table_pointers.concat(Tai_const.Create_rva_sym(name_label)); + ordinal_table.concat(Tai_const.Create_16bit(hp.index-ordinal_base)); + name_table.concat(Tai_align.Create_op(2,0)); + name_table.concat(Tai_label.Create(name_label)); + name_table.concat(Tai_string.Create(hp.name^+#0)); + end; + hp:=texported_item(hp.next); + end; + { order in increasing ordinal values } + { into temtexport list } + temtexport:=TLinkedList.Create; + hp:=texported_item(current_module._exports.first); + while assigned(hp) do + begin + current_module._exports.remove(hp); + hp2:=texported_item(temtexport.first); + while assigned(hp2) and (hp.index>hp2.index) do + hp2:=texported_item(hp2.next); + if hp2=nil then + temtexport.concat(hp) + else + temtexport.insertbefore(hp,hp2); + hp:=texported_item(current_module._exports.first); + end; + + { write the export adress table } + current_index:=ordinal_base; + hp:=texported_item(temtexport.first); + while assigned(hp) do + begin + { fill missing values } + while current_index<hp.index do + begin + address_table.concat(Tai_const.Create_32bit(0)); + inc(current_index); + end; + + { symbol known? then get a new name } + if assigned(hp.sym) then + case hp.sym.typ of + staticvarsym : + asmsym:=current_asmdata.RefAsmSymbol(tstaticvarsym(hp.sym).mangledname); + procsym : + asmsym:=current_asmdata.RefAsmSymbol(tprocdef(tprocsym(hp.sym).ProcdefList[0]).mangledname) + else + internalerror(200709272); + end + else + asmsym:=current_asmdata.RefAsmSymbol(hp.name^); + address_table.concat(Tai_const.Create_rva_sym(asmsym)); + inc(current_index); + hp:=texported_item(hp.next); + end; + + current_asmdata.asmlists[al_exports].concatlist(address_table); + current_asmdata.asmlists[al_exports].concatlist(name_table_pointers); + current_asmdata.asmlists[al_exports].concatlist(ordinal_table); + current_asmdata.asmlists[al_exports].concatlist(name_table); + address_table.Free; + name_table_pointers.free; + ordinal_table.free; + name_table.free; + + { the package support needs this data later on + to create the import library } + current_module._exports.concatlist(temtexport); + temtexport.free; + end; + + + procedure TExportLibWin.generatenasmlib; + var + hp : texported_item; + {p : pchar; + s : string;} + begin + new_section(current_asmdata.asmlists[al_exports],sec_code,'',0); + hp:=texported_item(current_module._exports.first); + while assigned(hp) do + begin +{ case hp.sym.typ of + staticvarsym : + s:=tstaticvarsym(hp.sym).mangledname; + procsym : + s:=tprocdef(tprocsym(hp.sym).ProcdefList[0]).mangledname; + else + s:=''; + end; + p:=strpnew(#9+'export '+s+' '+hp.Name^+' '+tostr(hp.index)); + current_asmdata.asmlists[al_exports].concat(tai_direct.create(p));} + hp:=texported_item(hp.next); + end; + end; + + +{**************************************************************************** + TInternalLinkerWin +****************************************************************************} + + constructor TInternalLinkerWin.Create; + begin + inherited Create; + CExeoutput:=TPECoffexeoutput; + CObjInput:=TPECoffObjInput; + end; + + + procedure TInternalLinkerWin.DefaultLinkScript; + var + s,s2 : TCmdStr; + secname, + secnames : string; + begin + with LinkScript do + begin + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + Concat('READOBJECT '+MaybeQuoted(s)); + end; + while not StaticLibFiles.Empty do + begin + s:=StaticLibFiles.GetFirst; + if s<>'' then + Concat('READSTATICLIBRARY '+MaybeQuoted(s)); + end; + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if FindLibraryFile(s,target_info.staticClibprefix,target_info.staticClibext,s2) then + Concat('READSTATICLIBRARY '+MaybeQuoted(s2)) + else + Comment(V_Error,'Import library not found for '+S); + end; + if IsSharedLibrary then + Concat('ISSHAREDLIBRARY'); + ConcatEntryName; + if not ImageBaseSetExplicity then + begin + if IsSharedLibrary then + imagebase:={$ifdef cpu64bitaddr} $110000000 {$else} $10000000 {$endif} + else + if target_info.system in systems_wince then + imagebase:=$10000 + else +{$ifdef cpu64bitaddr} + if (paratargetdbg = dbg_stabs) then + imagebase:=$400000 + else + imagebase:= $100000000; +{$else} + imagebase:=$400000; +{$endif} + end; + Concat('IMAGEBASE $' + hexStr(imagebase, SizeOf(imagebase)*2)); + Concat('HEADER'); + Concat('EXESECTION .text'); + Concat(' SYMBOL __text_start__'); + Concat(' OBJSECTION .text*'); + Concat(' SYMBOL ___CTOR_LIST__'); + Concat(' SYMBOL __CTOR_LIST__'); + Concat(' LONG -1'); +{$ifdef x86_64} + Concat(' LONG -1'); +{$endif x86_64} + Concat(' OBJSECTION .ctor*'); + Concat(' LONG 0'); +{$ifdef x86_64} + Concat(' LONG 0'); +{$endif x86_64} + Concat(' SYMBOL ___DTOR_LIST__'); + Concat(' SYMBOL __DTOR_LIST__'); + Concat(' LONG -1'); +{$ifdef x86_64} + Concat(' LONG -1'); +{$endif x86_64} + Concat(' OBJSECTION .dtor*'); + Concat(' LONG 0'); +{$ifdef x86_64} + Concat(' LONG 0'); +{$endif x86_64} + Concat(' SYMBOL etext'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .data'); + Concat(' SYMBOL __data_start__'); + Concat(' OBJSECTION .data*'); + Concat(' OBJSECTION .fpc*'); + Concat(' PROVIDE '+target_info.Cprefix+'_tls_index'); + Concat(' LONG 0'); + Concat(' SYMBOL edata'); + Concat(' SYMBOL __data_end__'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .rdata'); + Concat(' SYMBOL ___RUNTIME_PSEUDO_RELOC_LIST__'); + Concat(' SYMBOL __RUNTIME_PSEUDO_RELOC_LIST__'); + Concat(' OBJSECTION .rdata_runtime_pseudo_reloc'); + Concat(' SYMBOL ___RUNTIME_PSEUDO_RELOC_LIST_END__'); + Concat(' SYMBOL __RUNTIME_PSEUDO_RELOC_LIST_END__'); + Concat(' OBJSECTION .rdata*'); + Concat(' OBJSECTION .rodata*'); + Concat(' OBJSECTION .xdata*'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .pdata'); + Concat(' OBJSECTION .pdata*'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .bss'); + Concat(' SYMBOL __bss_start__'); + Concat(' OBJSECTION .bss*'); + Concat(' SYMBOL __bss_end__'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .tls'); + Concat(' SYMBOL ___tls_start__'); + Concat(' OBJSECTION .tls*'); + Concat(' SYMBOL ___tls_end__'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .CRT'); + Concat(' SYMBOL ___crt_xc_start__'); + Concat(' OBJSECTION .CRT$XC*');{ /* C initialization */');} + Concat(' SYMBOL ___crt_xc_end__'); + Concat(' SYMBOL ___crt_xi_start__'); + Concat(' OBJSECTION .CRT$XI*');{ /* C++ initialization */');} + Concat(' SYMBOL ___crt_xi_end__'); + Concat(' SYMBOL ___crt_xl_start__'); + Concat(' OBJSECTION .CRT$XL*'); { /* TLS callbacks */'); } + { In GNU ld, this is defined in the TLS Directory support code } + Concat(' PROVIDE ___crt_xl_end__'); + { Add a nil pointer as last element } + Concat(' LONG 0'); +{$ifdef x86_64} + Concat(' LONG 0'); +{$endif x86_64} + Concat(' SYMBOL ___crt_xp_start__'); + Concat(' OBJSECTION .CRT$XP*'); { /* Pre-termination */');} + Concat(' SYMBOL ___crt_xp_end__'); + Concat(' SYMBOL ___crt_xt_start__'); + Concat(' OBJSECTION .CRT$XT*');{ /* Termination */');} + Concat(' SYMBOL ___crt_xt_end__'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .idata'); + Concat(' OBJSECTION .idata$2*'); + Concat(' OBJSECTION .idata$3*'); + Concat(' ZEROS 20'); + Concat(' OBJSECTION .idata$4*'); + Concat(' SYMBOL __IAT_start__'); + Concat(' OBJSECTION .idata$5*'); + Concat(' SYMBOL __IAT_end__'); + Concat(' OBJSECTION .idata$6*'); + Concat(' OBJSECTION .idata$7*'); + Concat('ENDEXESECTION'); + secnames:='.edata,.rsrc,.reloc,.gnu_debuglink,'+ + '.debug_aranges,.debug_pubnames,.debug_info,.debug_abbrev,.debug_line,.debug_frame,.debug_str,.debug_loc,'+ + '.debug_macinfo,.debug_weaknames,.debug_funcnames,.debug_typenames,.debug_varnames,.debug_ranges'; + repeat + secname:=gettoken(secnames,','); + if secname='' then + break; + Concat('EXESECTION '+secname); + Concat(' OBJSECTION '+secname+'*'); + Concat('ENDEXESECTION'); + until false; + { Can't use the generic rules, because that will add also .stabstr to .stab } + Concat('EXESECTION .stab'); + Concat(' OBJSECTION .stab'); + Concat('ENDEXESECTION'); + Concat('EXESECTION .stabstr'); + Concat(' OBJSECTION .stabstr'); + Concat('ENDEXESECTION'); + Concat('STABS'); + Concat('SYMBOLS'); + end; + end; + + + procedure TInternalLinkerWin.InitSysInitUnitName; + begin + if target_info.system=system_i386_win32 then + GlobalInitSysInitUnitName(self); + end; + + procedure TInternalLinkerWin.ConcatEntryName; + begin + with LinkScript do + begin + if IsSharedLibrary then + begin + Concat('ISSHAREDLIBRARY'); + if apptype=app_gui then + Concat('ENTRYNAME _DLLWinMainCRTStartup') + else + Concat('ENTRYNAME _DLLMainCRTStartup'); + end + else + begin + if apptype=app_gui then + Concat('ENTRYNAME _WinMainCRTStartup') + else + Concat('ENTRYNAME _mainCRTStartup'); + end; + end; + end; + + +{**************************************************************************** + TExternalLinkerWin +****************************************************************************} + + Constructor TExternalLinkerWin.Create; + begin + Inherited Create; + { allow duplicated libs (PM) } + SharedLibFiles.doubles:=true; + StaticLibFiles.doubles:=true; + end; + + + Procedure TExternalLinkerWin.SetDefaultInfo; + var + targetopts: string; + begin + with Info do + begin +{$ifdef x86_64} + targetopts:='-b pei-x86-64'; +{$else x86_64} + if target_info.system=system_arm_wince then + targetopts:='-m arm_wince_pe' + else + targetopts:='-b pei-i386 -m i386pe'; +{$endif not x86_64} + ExeCmd[1]:='ld '+targetopts+' $OPT $GCSECTIONS $MAP $STRIP $APPTYPE $ENTRY $IMAGEBASE $RELOC -o $EXE $RES'; + DllCmd[1]:='ld '+targetopts+' $OPT $GCSECTIONS $MAP $STRIP --dll $APPTYPE $ENTRY $IMAGEBASE $RELOC -o $EXE $RES'; + { ExeCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF'; + use short forms to avoid 128 char limitation problem } + ExeCmd[2]:='dlltool -S $ASBIN -D $EXE -e exp.$$$ $RELOC $DEF'; + ExeCmd[3]:='ld '+targetopts+' $OPT $STRIP $APPTYPE $ENTRY $IMAGEBASE -o $EXE $RES exp.$$$'; + { DllCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF'; } + DllCmd[2]:='dlltool -S $ASBIN -D $EXE -e exp.$$$ $RELOC $DEF'; + DllCmd[3]:='ld '+targetopts+' $OPT $STRIP --dll $APPTYPE $ENTRY $IMAGEBASE -o $EXE $RES exp.$$$'; + end; + end; + + + + Function TExternalLinkerWin.WriteResponseFile(isdll:boolean) : Boolean; + Var + linkres : TLinkRes; + HPath : TCmdStrListItem; + s,s2 : TCmdStr; + i : integer; + begin + WriteResponseFile:=False; + + if (cs_profile in current_settings.moduleswitches) then + begin + SharedLibFiles.Concat('gmon'); + SharedLibFiles.Concat('c'); + SharedLibFiles.Concat('gcc'); + SharedLibFiles.Concat('kernel32'); + end; + + { Open link.res file } + LinkRes:=TLinkres.Create(outputexedir+Info.ResName); + with linkres do + begin + { Write path to search libraries } + HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First); + while assigned(HPath) do + begin + Add('SEARCH_DIR('+MaybeQuoted(HPath.Str)+')'); + HPath:=TCmdStrListItem(HPath.Next); + end; + HPath:=TCmdStrListItem(LibrarySearchPath.First); + while assigned(HPath) do + begin + Add('SEARCH_DIR('+MaybeQuoted(HPath.Str)+')'); + HPath:=TCmdStrListItem(HPath.Next); + end; + + { add objectfiles, start with prt0 always } + { profiling of shared libraries is currently not supported } + if not ObjectFiles.Empty then + begin + Add('INPUT('); + while not ObjectFiles.Empty do + begin + s:=ObjectFiles.GetFirst; + if s<>'' then + AddFileName(MaybeQuoted(s)); + end; + Add(')'); + end; + + { Write staticlibraries } + if (not StaticLibFiles.Empty) then + begin + Add('GROUP('); + While not StaticLibFiles.Empty do + begin + S:=StaticLibFiles.GetFirst; + AddFileName(MaybeQuoted(s)); + end; + Add(')'); + end; + + { Write sharedlibraries (=import libraries) } + if not SharedLibFiles.Empty then + begin + Add('INPUT(') ; + While not SharedLibFiles.Empty do + begin + S:=SharedLibFiles.GetFirst; + if FindLibraryFile(s,target_info.staticClibprefix,target_info.staticClibext,s2) then + begin + Add(MaybeQuoted(s2)); + continue; + end; + if pos(target_info.sharedlibprefix,s)=1 then + s:=copy(s,length(target_info.sharedlibprefix)+1,255); + i:=Pos(target_info.sharedlibext,S); + if i>0 then + Delete(S,i,255); + Add('-l'+s); + end; + Add(')'); + end; + + Add('SEARCH_DIR("/usr/i686-pc-cygwin/lib"); SEARCH_DIR("/usr/lib"); SEARCH_DIR("/usr/lib/w32api");'); +{$ifdef x86_64} + Add('OUTPUT_FORMAT(pei-x86-64)'); +{$else not 86_64} + Add('OUTPUT_FORMAT(pei-i386)'); +{$endif not x86_64} + Add('ENTRY(_mainCRTStartup)'); + Add('SECTIONS'); + Add('{'); + Add(' . = SIZEOF_HEADERS;'); + Add(' . = ALIGN(__section_alignment__);'); + Add(' .text __image_base__ + ( __section_alignment__ < 0x1000 ? . : __section_alignment__ ) :'); + Add(' {'); + Add(' *(.init)'); + add(' *(.text .stub .text.* .gnu.linkonce.t.*)'); + Add(' *(SORT(.text$*))'); + Add(' *(.glue_7t)'); + Add(' *(.glue_7)'); + Add(' . = ALIGN(8);'); + Add(' ___CTOR_LIST__ = .; __CTOR_LIST__ = . ;'); + Add(' LONG (-1);'); +{$ifdef x86_64} + Add(' LONG (-1);'); +{$endif x86_64} + Add(' *(.ctors); *(.ctor); *(SORT(.ctors.*)); LONG (0);'); +{$ifdef x86_64} + Add(' LONG (0);'); +{$endif x86_64} + Add(' ___DTOR_LIST__ = .; __DTOR_LIST__ = . ;'); + Add(' LONG (-1);'); +{$ifdef x86_64} + Add(' LONG (-1);'); +{$endif x86_64} + Add(' *(.dtors); *(.dtor); *(SORT(.dtors.*)); LONG (0);'); +{$ifdef x86_64} + Add(' LONG (0);'); +{$endif x86_64} + Add(' *(.fini)'); + Add(' PROVIDE (etext = .);'); + Add(' *(.gcc_except_table)'); + Add(' }'); + Add(' .data BLOCK(__section_alignment__) :'); + Add(' {'); + Add(' __data_start__ = . ;'); + add(' *(.data .data.* .gnu.linkonce.d.* .fpc*)'); + Add(' *(.data2)'); + Add(' *(SORT(.data$*))'); + Add(' *(.jcr)'); + Add(' PROVIDE ('+target_info.Cprefix+'_tls_index = .);'); + Add(' LONG (0);'); + Add(' __data_end__ = . ;'); + Add(' *(.data_cygwin_nocopy)'); + Add(' }'); + Add(' .rdata BLOCK(__section_alignment__) :'); + Add(' {'); + Add(' *(.rdata)'); + add(' *(.rodata .rodata.* .gnu.linkonce.r.*)'); + Add(' *(SORT(.rdata$*))'); + Add(' *(.eh_frame)'); + Add(' ___RUNTIME_PSEUDO_RELOC_LIST__ = .;'); + Add(' __RUNTIME_PSEUDO_RELOC_LIST__ = .;'); + Add(' *(.rdata_runtime_pseudo_reloc)'); + Add(' ___RUNTIME_PSEUDO_RELOC_LIST_END__ = .;'); + Add(' __RUNTIME_PSEUDO_RELOC_LIST_END__ = .;'); + Add(' }'); + Add(' .pdata BLOCK(__section_alignment__) : { *(.pdata) }'); + Add(' .bss BLOCK(__section_alignment__) :'); + Add(' {'); + Add(' __bss_start__ = . ;'); + Add(' *(.bss .bss.* .gnu.linkonce.b.*)'); + Add(' *(SORT(.bss$*))'); + Add(' *(COMMON)'); + Add(' __bss_end__ = . ;'); + Add(' }'); + Add(' .edata BLOCK(__section_alignment__) : { *(.edata) }'); + Add(' .idata BLOCK(__section_alignment__) :'); + Add(' {'); + Add(' SORT(*)(.idata$2)'); + Add(' SORT(*)(.idata$3)'); + Add(' /* These zeroes mark the end of the import list. */'); + Add(' LONG (0); LONG (0); LONG (0); LONG (0); LONG (0);'); + Add(' SORT(*)(.idata$4)'); + Add(' SORT(*)(.idata$5)'); + Add(' SORT(*)(.idata$6)'); + Add(' SORT(*)(.idata$7)'); + Add(' }'); + Add(' .CRT BLOCK(__section_alignment__) :'); + Add(' {'); + Add(' ___crt_xc_start__ = . ;'); + Add(' *(SORT(.CRT$XC*)) /* C initialization */'); + Add(' ___crt_xc_end__ = . ;'); + Add(' ___crt_xi_start__ = . ;'); + Add(' *(SORT(.CRT$XI*)) /* C++ initialization */'); + Add(' ___crt_xi_end__ = . ;'); + Add(' ___crt_xl_start__ = . ;'); + Add(' *(SORT(.CRT$XL*)) /* TLS callbacks */'); + Add(' /* ___crt_xl_end__ is defined in the TLS Directory support code */'); + Add(' PROVIDE (___crt_xl_end__ = .);'); + Add(' ___crt_xp_start__ = . ;'); + Add(' *(SORT(.CRT$XP*)) /* Pre-termination */'); + Add(' ___crt_xp_end__ = . ;'); + Add(' ___crt_xt_start__ = . ;'); + Add(' *(SORT(.CRT$XT*)) /* Termination */'); + Add(' ___crt_xt_end__ = . ;'); + Add(' }'); + Add(' .tls BLOCK(__section_alignment__) :'); + Add(' {'); + Add(' ___tls_start__ = . ;'); + Add(' *(.tls .tls.*)'); + Add(' *(.tls$)'); + Add(' *(SORT(.tls$*))'); + Add(' ___tls_end__ = . ;'); + Add(' }'); + Add(' .rsrc BLOCK(__section_alignment__) :'); + Add(' {'); + Add(' *(.rsrc)'); + Add(' *(SORT(.rsrc$*))'); + Add(' }'); + Add(' .reloc BLOCK(__section_alignment__) : { *(.reloc) }'); + Add(' .stab BLOCK(__section_alignment__) (NOLOAD) : { *(.stab) }'); + Add(' .stabstr BLOCK(__section_alignment__) (NOLOAD) : { *(.stabstr) }'); + Add(' .debug_aranges BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_aranges) }'); + Add(' .debug_pubnames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_pubnames) }'); + Add(' .debug_info BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_info) *(.gnu.linkonce.wi.*) }'); + Add(' .debug_abbrev BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_abbrev) }'); + Add(' .debug_line BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_line) }'); + Add(' .debug_frame BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_frame) }'); + Add(' .debug_str BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_str) }'); + Add(' .debug_loc BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_loc) }'); + Add(' .debug_macinfo BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_macinfo) }'); + Add(' .debug_weaknames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_weaknames) }'); + Add(' .debug_funcnames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_funcnames) }'); + Add(' .debug_typenames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_typenames) }'); + Add(' .debug_varnames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_varnames) }'); + Add(' .debug_ranges BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_ranges) }'); + Add('}'); + + { Write and Close response } + writetodisk; + Free; + end; + + WriteResponseFile:=True; + end; + + + function TExternalLinkerWin.MakeExecutable:boolean; + var + MapStr, + binstr, + cmdstr : TCmdStr; + success : boolean; + cmds,i : longint; + AsBinStr : string[80]; + GCSectionsStr, + StripStr, + RelocStr, + AppTypeStr, + EntryStr, + ImageBaseStr : string[40]; + begin + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.exefilename^); + + { Create some replacements } + RelocStr:=''; + AppTypeStr:=''; + EntryStr:=''; + ImageBaseStr:=''; + StripStr:=''; + MapStr:=''; + GCSectionsStr:=''; + AsBinStr:=FindUtil(utilsprefix+'as'); + if RelocSection then + RelocStr:='--base-file base.$$$'; + if create_smartlink_sections then + GCSectionsStr:='--gc-sections'; + if target_info.system in systems_wince then + AppTypeStr:='--subsystem wince' + else + begin + if apptype=app_gui then + AppTypeStr:='--subsystem windows'; + end; + if apptype=app_gui then + EntryStr:='--entry=_WinMainCRTStartup' + else + EntryStr:='--entry=_mainCRTStartup'; + if ImageBaseSetExplicity then + ImageBaseStr:='--image-base=0x'+hexStr(imagebase, SizeOf(imagebase)*2); + if (cs_link_strip in current_settings.globalswitches) then + StripStr:='-s'; + if (cs_link_map in current_settings.globalswitches) then + MapStr:='-Map '+maybequoted(ChangeFileExt(current_module.exefilename^,'.map')); + + { Write used files and libraries } + WriteResponseFile(false); + + { Call linker } + success:=false; + if RelocSection or (not Deffile.empty) then + cmds:=3 + else + cmds:=1; + for i:=1 to cmds do + begin + SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr); + if binstr<>'' then + begin + Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$APPTYPE',AppTypeStr); + Replace(cmdstr,'$ENTRY',EntryStr); + Replace(cmdstr,'$ASBIN',AsbinStr); + Replace(cmdstr,'$RELOC',RelocStr); + Replace(cmdstr,'$IMAGEBASE',ImageBaseStr); + Replace(cmdstr,'$GCSECTIONS',GCSectionsStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$MAP',MapStr); + if not DefFile.Empty then + begin + DefFile.WriteFile; + Replace(cmdstr,'$DEF','-d '+maybequoted(deffile.fname)); + end + else + Replace(cmdstr,'$DEF',''); + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,(i=1),false); + if not success then + break; + end; + end; + + { Post process } + if success then + success:=PostProcessExecutable(current_module.exefilename^,false); + + { Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + begin + DeleteFile(outputexedir+Info.ResName); + DeleteFile('base.$$$'); + DeleteFile('exp.$$$'); + DeleteFile('deffile.$$$'); + end; + + MakeExecutable:=success; { otherwise a recursive call to link method } + end; + + + Function TExternalLinkerWin.MakeSharedLibrary:boolean; + var + MapStr, + binstr, + cmdstr : TCmdStr; + success : boolean; + cmds, + i : longint; + AsBinStr : string[80]; + StripStr, + GCSectionsStr, + RelocStr, + AppTypeStr, + EntryStr, + ImageBaseStr : string[40]; + begin + MakeSharedLibrary:=false; + if not(cs_link_nolink in current_settings.globalswitches) then + Message1(exec_i_linking,current_module.sharedlibfilename^); + + { Create some replacements } + RelocStr:=''; + AppTypeStr:=''; + EntryStr:=''; + ImageBaseStr:=''; + StripStr:=''; + MapStr:=''; + GCSectionsStr:=''; + AsBinStr:=FindUtil(utilsprefix+'as'); + if RelocSection then + RelocStr:='--base-file base.$$$'; + if create_smartlink_sections then + GCSectionsStr:='--gc-sections'; + if apptype=app_gui then + begin + AppTypeStr:='--subsystem windows'; + EntryStr:='--entry _DLLWinMainCRTStartup' + end + else + EntryStr:='--entry _DLLMainCRTStartup'; + if ImageBaseSetExplicity then + ImageBaseStr:='--image-base=0x'+hexStr(imagebase, SizeOf(imagebase)*2); + if (cs_link_strip in current_settings.globalswitches) then + StripStr:='-s'; + if (cs_link_map in current_settings.globalswitches) then + MapStr:='-Map '+maybequoted(ChangeFileExt(current_module.exefilename^,'.map')); + + { Write used files and libraries } + WriteResponseFile(true); + + { Call linker } + success:=false; + if RelocSection or (not Deffile.empty) then + cmds:=3 + else + cmds:=1; + for i:=1 to cmds do + begin + SplitBinCmd(Info.DllCmd[i],binstr,cmdstr); + if binstr<>'' then + begin + Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^)); + Replace(cmdstr,'$OPT',Info.ExtraOptions); + Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); + Replace(cmdstr,'$APPTYPE',AppTypeStr); + Replace(cmdstr,'$ENTRY',EntryStr); + Replace(cmdstr,'$ASBIN',AsbinStr); + Replace(cmdstr,'$RELOC',RelocStr); + Replace(cmdstr,'$IMAGEBASE',ImageBaseStr); + Replace(cmdstr,'$STRIP',StripStr); + Replace(cmdstr,'$GCSECTIONS',GCSectionsStr); + Replace(cmdstr,'$MAP',MapStr); + if not DefFile.Empty then + begin + DefFile.WriteFile; + Replace(cmdstr,'$DEF','-d '+maybequoted(deffile.fname)); + end + else + Replace(cmdstr,'$DEF',''); + success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,(i=1),false); + if not success then + break; + end; + end; + + { Post process } + if success then + success:=PostProcessExecutable(current_module.sharedlibfilename^,true); + + { Remove ReponseFile } + if (success) and not(cs_link_nolink in current_settings.globalswitches) then + begin + DeleteFile(outputexedir+Info.ResName); + DeleteFile('base.$$$'); + DeleteFile('exp.$$$'); + DeleteFile('deffile.$$$'); + end; + MakeSharedLibrary:=success; { otherwise a recursive call to link method } + end; + + + function TExternalLinkerWin.postprocessexecutable(const fn : string;isdll:boolean):boolean; + type + tdosheader = packed record + e_magic : word; + e_cblp : word; + e_cp : word; + e_crlc : word; + e_cparhdr : word; + e_minalloc : word; + e_maxalloc : word; + e_ss : word; + e_sp : word; + e_csum : word; + e_ip : word; + e_cs : word; + e_lfarlc : word; + e_ovno : word; + e_res : array[0..3] of word; + e_oemid : word; + e_oeminfo : word; + e_res2 : array[0..9] of word; + e_lfanew : longint; + end; + psecfill=^TSecfill; + TSecfill=record + fillpos, + fillsize : longint; + next : psecfill; + end; + var + f : file; + cmdstr : string; + dosheader : tdosheader; + peheader : tcoffheader; + peoptheader : tcoffpeoptheader; + firstsecpos, + maxfillsize, + l,peheaderpos : longint; + coffsec : tcoffsechdr; + secroot,hsecroot : psecfill; + zerobuf : pointer; + begin + postprocessexecutable:=false; + { when -s is used or it's a dll then quit } + if (cs_link_nolink in current_settings.globalswitches) then + begin + case apptype of + app_native : + cmdstr:='--subsystem native'; + app_gui : + cmdstr:='--subsystem gui'; + app_cui : + cmdstr:='--subsystem console'; + end; + if dllversion<>'' then + cmdstr:=cmdstr+' --version '+dllversion; + cmdstr:=cmdstr+' --input '+maybequoted(fn); + cmdstr:=cmdstr+' --stack '+tostr(stacksize); + if target_info.system in [system_i386_win32, system_i386_wdosx] then + DoExec(FindUtil(utilsprefix+'postw32'),cmdstr,false,false); + postprocessexecutable:=true; + exit; + end; + { open file } + assign(f,fn); + {$push}{$I-} + reset(f,1); + if ioresult<>0 then + Message1(execinfo_f_cant_open_executable,fn); + { read headers } + blockread(f,dosheader,sizeof(tdosheader)); + peheaderpos:=dosheader.e_lfanew; + { skip to headerpos and skip pe magic } + seek(f,peheaderpos+4); + blockread(f,peheader,sizeof(tcoffheader)); + blockread(f,peoptheader,sizeof(tcoffpeoptheader)); + { write info } + Message1(execinfo_x_codesize,tostr(peoptheader.tsize)); + Message1(execinfo_x_initdatasize,tostr(peoptheader.dsize)); + Message1(execinfo_x_uninitdatasize,tostr(peoptheader.bsize)); + { change stack size (PM) } + { I am not sure that the default value is adequate !! } + peoptheader.SizeOfStackReserve:=stacksize; + if SetPEFlagsSetExplicity then + peoptheader.LoaderFlags:=peflags; + if ImageBaseSetExplicity then + peoptheader.ImageBase:=imagebase; + if MinStackSizeSetExplicity then + peoptheader.SizeOfStackCommit:=minstacksize; + if MaxStackSizeSetExplicity then + peoptheader.SizeOfStackReserve:=maxstacksize; + { change the header } + { sub system } + { gui=2 } + { cui=3 } + { wincegui=9 } + if target_info.system in systems_wince then + peoptheader.Subsystem:=9 + else + case apptype of + app_native : + peoptheader.Subsystem:=1; + app_gui : + peoptheader.Subsystem:=2; + app_cui : + peoptheader.Subsystem:=3; + end; + if dllversion<>'' then + begin + peoptheader.MajorImageVersion:=dllmajor; + peoptheader.MinorImageVersion:=dllminor; + end; + { reset timestamp } + peheader.time:=0; + { write header back, skip pe magic } + seek(f,peheaderpos+4); + blockwrite(f,peheader,sizeof(tcoffheader)); + if ioresult<>0 then + Message1(execinfo_f_cant_process_executable,fn); + blockwrite(f,peoptheader,sizeof(tcoffpeoptheader)); + if ioresult<>0 then + Message1(execinfo_f_cant_process_executable,fn); + { skip to headerpos and skip pe magic } + seek(f,peheaderpos+4); + blockread(f,peheader,sizeof(tcoffheader)); + blockread(f,peoptheader,sizeof(tcoffpeoptheader)); + { write the value after the change } + Message1(execinfo_x_stackreserve,tostr(peoptheader.SizeOfStackReserve)); + Message1(execinfo_x_stackcommit,tostr(peoptheader.SizeOfStackCommit)); + { read section info } + maxfillsize:=0; + firstsecpos:=0; + secroot:=nil; + for l:=1 to peheader.nsects do + begin + blockread(f,coffsec,sizeof(tcoffsechdr)); + if coffsec.datapos>0 then + begin + if secroot=nil then + firstsecpos:=coffsec.datapos; + new(hsecroot); + hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize; + hsecroot^.fillsize:=coffsec.datasize-coffsec.vsize; + hsecroot^.next:=secroot; + secroot:=hsecroot; + if secroot^.fillsize>maxfillsize then + maxfillsize:=secroot^.fillsize; + end; + end; + if firstsecpos>0 then + begin + l:=firstsecpos-filepos(f); + if l>maxfillsize then + maxfillsize:=l; + end + else + l:=0; + { get zero buffer } + getmem(zerobuf,maxfillsize); + fillchar(zerobuf^,maxfillsize,0); + { zero from sectioninfo until first section } + blockwrite(f,zerobuf^,l); + { zero section alignments } + while assigned(secroot) do + begin + seek(f,secroot^.fillpos); + blockwrite(f,zerobuf^,secroot^.fillsize); + hsecroot:=secroot; + secroot:=secroot^.next; + dispose(hsecroot); + end; + freemem(zerobuf,maxfillsize); + close(f); + {$pop} + if ioresult<>0 then; + postprocessexecutable:=true; + end; + + + procedure TExternalLinkerWin.InitSysInitUnitName; + begin + if target_info.system=system_i386_win32 then + GlobalInitSysInitUnitName(self); + end; + + +{**************************************************************************** + TDLLScannerWin +****************************************************************************} + + procedure TDLLScannerWin.CheckDLLFunc(const dllname,funcname:string); + var + i : longint; + ExtName : string; + begin + for i:=0 to current_module.dllscannerinputlist.count-1 do + begin + ExtName:=current_module.dllscannerinputlist.NameOfIndex(i); + if (ExtName=funcname) then + begin + current_module.AddExternalImport(dllname,funcname,funcname,0,false,false); + importfound:=true; + current_module.dllscannerinputlist.Delete(i); + exit; + end; + end; + end; + + + function TDLLScannerWin.scan(const binname:string):boolean; + var + hs, + dllname : TCmdStr; + begin + result:=false; + { is there already an import library the we will use that one } + if FindLibraryFile(binname,target_info.staticClibprefix,target_info.staticClibext,hs) then + exit; + { check if we can find the dll } + hs:=binname; + if ExtractFileExt(hs)='' then + hs:=ChangeFileExt(hs,target_info.sharedlibext); + if not FindDll(hs,dllname) then + exit; + importfound:=false; + ReadDLLImports(dllname,@CheckDLLFunc); + if importfound then + current_module.dllscannerinputlist.Pack; + result:=importfound; + end; + +{***************************************************************************** + Initialize +*****************************************************************************} + +initialization +{$ifdef i386} + { Win32 } + RegisterExternalLinker(system_i386_win32_info,TExternalLinkerWin); + RegisterInternalLinker(system_i386_win32_info,TInternalLinkerWin); + RegisterImport(system_i386_win32,TImportLibWin); + RegisterExport(system_i386_win32,TExportLibWin); + RegisterDLLScanner(system_i386_win32,TDLLScannerWin); + RegisterRes(res_gnu_windres_info,TWinLikeResourceFile); + RegisterTarget(system_i386_win32_info); + { WinCE } + RegisterExternalLinker(system_i386_wince_info,TExternalLinkerWin); + RegisterInternalLinker(system_i386_wince_info,TInternalLinkerWin); + RegisterImport(system_i386_wince,TImportLibWin); + RegisterExport(system_i386_wince,TExportLibWin); + RegisterDLLScanner(system_i386_wince,TDLLScannerWin); + RegisterTarget(system_i386_wince_info); +{$endif i386} +{$ifdef x86_64} + RegisterExternalLinker(system_x64_win64_info,TExternalLinkerWin); + RegisterInternalLinker(system_x64_win64_info,TInternalLinkerWin); + RegisterImport(system_x86_64_win64,TImportLibWin); + RegisterExport(system_x86_64_win64,TExportLibWin); + RegisterDLLScanner(system_x86_64_win64,TDLLScannerWin); + RegisterRes(res_win64_gorc_info,TWinLikeResourceFile); + RegisterTarget(system_x64_win64_info); +{$endif x86_64} +{$ifdef arm} + RegisterExternalLinker(system_arm_wince_info,TExternalLinkerWin); + RegisterInternalLinker(system_arm_wince_info,TInternalLinkerWin); + RegisterImport(system_arm_wince,TImportLibWin); + RegisterExport(system_arm_wince,TExportLibWin); + RegisterRes(res_gnu_windres_info,TWinLikeResourceFile); + RegisterTarget(system_arm_wince_info); +{$endif arm} +end. diff --git a/closures/compiler/tgobj.pas b/closures/compiler/tgobj.pas new file mode 100644 index 0000000000..761d4f20c1 --- /dev/null +++ b/closures/compiler/tgobj.pas @@ -0,0 +1,663 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements the base object for temp. 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. + + **************************************************************************** +} +{#@abstract(Temporary reference allocator unit) + Temporary reference allocator unit. This unit contains + all which is related to allocating temporary memory + space on the stack, as required, by the code generator. +} + +unit tgobj; + +{$i fpcdefs.inc} + + interface + + uses + cclasses, + globals,globtype, + symtype, + cpubase,cpuinfo,cgbase,cgutils, + aasmbase,aasmtai,aasmdata; + + type + ptemprecord = ^ttemprecord; + ttemprecord = record + temptype : ttemptype; + pos : longint; + size : longint; + def : tdef; + next : ptemprecord; + nextfree : ptemprecord; { for faster freeblock checking } +{$ifdef EXTDEBUG} + posinfo, + releaseposinfo : tfileposinfo; +{$endif} + end; + + + {# Generates temporary variables } + ttgobj = class + private + { contains all free temps using nextfree links } + tempfreelist : ptemprecord; + function alloctemp(list: TAsmList; size,alignment : longint; temptype : ttemptype; def:tdef) : longint; + procedure freetemp(list: TAsmList; pos:longint;temptypes:ttemptypeset); + public + { contains all temps } + templist : ptemprecord; + { Offsets of the first/last temp } + firsttemp, + lasttemp : longint; + direction : shortint; + constructor create; + {# Clear and free the complete linked list of temporary memory + locations. The list is set to nil.} + procedure resettempgen; + {# Sets the first offset from the frame pointer or stack pointer where + the temporary references will be allocated. It is to note that this + value should always be negative. + + @param(l start offset where temps will start in stack) + } + procedure setfirsttemp(l : longint); + + procedure gettemp(list: TAsmList; size, alignment : longint;temptype:ttemptype;out ref : treference); + procedure gettemptyped(list: TAsmList; def:tdef;temptype:ttemptype;out ref : treference); + procedure ungettemp(list: TAsmList; const ref : treference); + + function sizeoftemp(list: TAsmList; const ref: treference): longint; + function changetemptype(list: TAsmList; const ref:treference;temptype:ttemptype):boolean; + function gettypeoftemp(const ref:treference): ttemptype; + + {# Returns TRUE if the reference ref is allocated in temporary volatile memory space, + otherwise returns FALSE. + + @param(ref reference to verify) + } + function istemp(const ref : treference) : boolean; + {# Frees a reference @var(ref) which was allocated in the volatile temporary memory space. + The freed space can later be reallocated and reused. If this reference + is not in the temporary memory, it is simply not freed. + } + procedure ungetiftemp(list: TAsmList; const ref : treference); + + { Allocate space for a local } + procedure getlocal(list: TAsmList; size : longint;def:tdef;var ref : treference); + procedure getlocal(list: TAsmList; size : longint; alignment : shortint; def:tdef;var ref : treference); + procedure UnGetLocal(list: TAsmList; const ref : treference); + end; + + var + tg: ttgobj; + + procedure location_freetemp(list:TAsmList; const l : tlocation); + + +implementation + + uses + cutils, + systems,verbose, + procinfo, + symconst + ; + + + const + FreeTempTypes = [tt_free,tt_freenoreuse]; + +{$ifdef EXTDEBUG} + TempTypeStr : array[ttemptype] of string[18] = ( + '<none>', + 'free','normal','persistant', + 'noreuse','freenoreuse' + ); +{$endif EXTDEBUG} + + Used2Free : array[ttemptype] of ttemptype = ( + tt_none, + tt_none,tt_free,tt_free, + tt_freenoreuse,tt_none + ); + + +{***************************************************************************** + Helpers +*****************************************************************************} + + procedure location_freetemp(list:TAsmList; const l : tlocation); + begin + if (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then + tg.ungetiftemp(list,l.reference); + end; + + +{***************************************************************************** + TTGOBJ +*****************************************************************************} + + constructor ttgobj.create; + + begin + tempfreelist:=nil; + templist:=nil; + { we could create a new child class for this but I don't if it is worth the effort (FK) } +{$if defined(powerpc) or defined(powerpc64) or defined(avr)} + direction:=1; +{$else} + direction:=-1; +{$endif} + end; + + + procedure ttgobj.resettempgen; + var + hp : ptemprecord; + begin + { Clear the old templist } + while assigned(templist) do + begin +{$ifdef EXTDEBUG} + if not(templist^.temptype in FreeTempTypes) then + begin + Comment(V_Warning,'tgobj: (ResetTempgen) temp at pos '+tostr(templist^.pos)+ + ' with size '+tostr(templist^.size)+' and type '+TempTypeStr[templist^.temptype]+ + ' from pos '+tostr(templist^.posinfo.line)+':'+tostr(templist^.posinfo.column)+ + ' not freed at the end of the procedure'); + end; +{$endif EXTDEBUG} + hp:=templist; + templist:=hp^.next; + dispose(hp); + end; + templist:=nil; + tempfreelist:=nil; + firsttemp:=0; + lasttemp:=0; + end; + + + procedure ttgobj.setfirsttemp(l : longint); + begin + { this is a negative value normally } + if l*direction>=0 then + begin + if odd(l) then + inc(l,direction); + end + else + internalerror(200204221); + firsttemp:=l; + lasttemp:=l; + end; + + + function ttgobj.AllocTemp(list: TAsmList; size,alignment : longint; temptype : ttemptype;def : tdef) : longint; + var + tl,htl, + bestslot,bestprev, + hprev,hp : ptemprecord; + freetype : ttemptype; + bestatend, + fitatbegin, + fitatend : boolean; + begin + AllocTemp:=0; + bestprev:=nil; + bestslot:=nil; + tl:=nil; + bestatend:=false; + + if size=0 then + begin +{$ifdef EXTDEBUG} + Comment(V_Warning,'tgobj: (AllocTemp) temp of size 0 requested, allocating 4 bytes'); +{$endif} + size:=4; + end; + + freetype:=Used2Free[temptype]; + if freetype=tt_none then + internalerror(200208201); + size:=align(size,alignment); + { First check the tmpfreelist, but not when + we don't want to reuse an already allocated block } + if assigned(tempfreelist) and + (temptype<>tt_noreuse) then + begin + hprev:=nil; + hp:=tempfreelist; + while assigned(hp) do + begin +{$ifdef EXTDEBUG} + if not(hp^.temptype in FreeTempTypes) then + Comment(V_Warning,'tgobj: (AllocTemp) temp at pos '+tostr(hp^.pos)+ ' in freelist is not set to tt_free !'); +{$endif} + { Check only slots that are + - free + - share the same type + - contain enough space + - has a correct alignment } + if (hp^.temptype=freetype) and + (hp^.def=def) and + (hp^.size>=size) and + ((hp^.pos=align(hp^.pos,alignment)) or + (hp^.pos+hp^.size-size = align(hp^.pos+hp^.size-size,alignment))) then + begin + { Slot is the same size then leave immediatly } + if (hp^.size=size) then + begin + bestprev:=hprev; + bestslot:=hp; + break; + end + else + begin + { we can fit a smaller block either at the begin or at } + { the end of a block. For direction=-1 we prefer the } + { end, for direction=1 we prefer the begin (i.e., } + { always closest to the source). We also try to use } + { the block with the worst possible alignment that } + { still suffices. And we pick the block which will } + { have the best alignmenment after this new block is } + { substracted from it. } + fitatend:=(hp^.pos+hp^.size-size)=align(hp^.pos+hp^.size-size,alignment); + fitatbegin:=hp^.pos=align(hp^.pos,alignment); + if assigned(bestslot) then + begin + fitatend:=fitatend and + ((not bestatend and + (direction=-1)) or + (bestatend and + isbetteralignedthan(abs(bestslot^.pos+hp^.size-size),abs(hp^.pos+hp^.size-size),current_settings.alignment.localalignmax))); + fitatbegin:=fitatbegin and + (not bestatend or + (direction=1)) and + isbetteralignedthan(abs(hp^.pos+size),abs(bestslot^.pos+size),current_settings.alignment.localalignmax); + end; + if fitatend and + fitatbegin then + if isbetteralignedthan(abs(hp^.pos+hp^.size-size),abs(hp^.pos+size),current_settings.alignment.localalignmax) then + fitatbegin:=false + else if isbetteralignedthan(abs(hp^.pos+size),abs(hp^.pos+hp^.size-size),current_settings.alignment.localalignmax) then + fitatend:=false + else if (direction=1) then + fitatend:=false + else + fitatbegin:=false; + if fitatend or + fitatbegin then + begin + bestprev:=hprev; + bestslot:=hp; + bestatend:=fitatend; + end; + end; + end; + hprev:=hp; + hp:=hp^.nextfree; + end; + end; + { Reuse an old temp ? } + if assigned(bestslot) then + begin + if bestslot^.size=size then + begin + tl:=bestslot; + { Remove from the tempfreelist } + if assigned(bestprev) then + bestprev^.nextfree:=tl^.nextfree + else + tempfreelist:=tl^.nextfree; + end + else + begin + { Duplicate bestlost and the block in the list } + new(tl); + move(bestslot^,tl^,sizeof(ttemprecord)); + tl^.next:=bestslot^.next; + bestslot^.next:=tl; + { Now we split the block in 2 parts. Depending on the direction + we need to resize the newly inserted block or the old reused block. + For direction=1 we can use tl for the new block. For direction=-1 we + will be reusing bestslot and resize the new block, that means we need + to swap the pointers } + if (direction=-1) xor + bestatend then + begin + htl:=tl; + tl:=bestslot; + bestslot:=htl; + { Update the tempfreelist to point to the new block } + if assigned(bestprev) then + bestprev^.nextfree:=bestslot + else + tempfreelist:=bestslot; + end; + + if not bestatend then + inc(bestslot^.pos,size) + else + inc(tl^.pos,tl^.size-size); + + { Create new block and resize the old block } + tl^.size:=size; + tl^.nextfree:=nil; + { Resize the old block } + dec(bestslot^.size,size); + end; + tl^.temptype:=temptype; + tl^.def:=def; + tl^.nextfree:=nil; + end + else + begin + { now we can create the templist entry } + new(tl); + tl^.temptype:=temptype; + tl^.def:=def; + + { Extend the temp } + if direction=-1 then + begin + lasttemp:=(-align(-lasttemp,alignment))-size; + tl^.pos:=lasttemp; + end + else + begin + tl^.pos:=align(lasttemp,alignment); + lasttemp:=tl^.pos+size; + end; + + tl^.size:=size; + tl^.next:=templist; + tl^.nextfree:=nil; + templist:=tl; + end; +{$ifdef EXTDEBUG} + tl^.posinfo:=current_filepos; + if assigned(tl^.def) then + list.concat(tai_tempalloc.allocinfo(tl^.pos,tl^.size,'allocated with type '+TempTypeStr[tl^.temptype]+' for def '+tl^.def.typename)) + else + list.concat(tai_tempalloc.allocinfo(tl^.pos,tl^.size,'allocated with type '+TempTypeStr[tl^.temptype])); +{$else} + list.concat(tai_tempalloc.alloc(tl^.pos,tl^.size)); +{$endif} + AllocTemp:=tl^.pos; + end; + + + procedure ttgobj.FreeTemp(list: TAsmList; pos:longint;temptypes:ttemptypeset); + var + hp,hnext,hprev,hprevfree : ptemprecord; + begin + hp:=templist; + hprev:=nil; + hprevfree:=nil; + while assigned(hp) do + begin + if (hp^.pos=pos) then + begin + { check if already freed } + if hp^.temptype in FreeTempTypes then + begin +{$ifdef EXTDEBUG} + Comment(V_Warning,'tgobj: (FreeTemp) temp at pos '+tostr(pos)+ ' is already free !'); + list.concat(tai_tempalloc.allocinfo(hp^.pos,hp^.size,'temp is already freed')); +{$endif} + exit; + end; + { check type that are allowed to be released } + if not(hp^.temptype in temptypes) then + begin +{$ifdef EXTDEBUG} + Comment(V_Debug,'tgobj: (Freetemp) temp at pos '+tostr(pos)+ ' has different type ('+TempTypeStr[hp^.temptype]+'), not releasing'); + list.concat(tai_tempalloc.allocinfo(hp^.pos,hp^.size,'temp has wrong type ('+TempTypeStr[hp^.temptype]+') not releasing')); +{$endif} + exit; + end; + list.concat(tai_tempalloc.dealloc(hp^.pos,hp^.size)); + { set this block to free } + hp^.temptype:=Used2Free[hp^.temptype]; + { Update tempfreelist } + if assigned(hprevfree) then + begin + { Concat blocks when the previous block is free and + there is no block assigned for a tdef } + if assigned(hprev) and + (hp^.temptype=tt_free) and + not assigned(hp^.def) and + (hprev^.temptype=tt_free) and + not assigned(hprev^.def) then + begin + inc(hprev^.size,hp^.size); + if direction=1 then + hprev^.pos:=hp^.pos; + hprev^.next:=hp^.next; + dispose(hp); + hp:=hprev; + end + else + hprevfree^.nextfree:=hp; + end + else + begin + hp^.nextfree:=tempfreelist; + tempfreelist:=hp; + end; + { Concat blocks when the next block is free and + there is no block assigned for a tdef } + hnext:=hp^.next; + if assigned(hnext) and + (hp^.temptype=tt_free) and + not assigned(hp^.def) and + (hnext^.temptype=tt_free) and + not assigned(hnext^.def) then + begin + inc(hp^.size,hnext^.size); + if direction=1 then + hp^.pos:=hnext^.pos; + hp^.nextfree:=hnext^.nextfree; + hp^.next:=hnext^.next; + dispose(hnext); + end; + { Stop } + exit; + end; + if (hp^.temptype=tt_free) then + hprevfree:=hp; + hprev:=hp; + hp:=hp^.next; + end; + end; + + + procedure ttgobj.gettemp(list: TAsmList; size, alignment : longint;temptype:ttemptype;out ref : treference); + var + varalign : shortint; + begin + varalign:=used_align(alignment,current_settings.alignment.localalignmin,current_settings.alignment.localalignmax); + { can't use reference_reset_base, because that will let tgobj depend + on cgobj (PFV) } + fillchar(ref,sizeof(ref),0); + ref.base:=current_procinfo.framepointer; + ref.offset:=alloctemp(list,size,varalign,temptype,nil); + ref.alignment:=varalign; + end; + + + procedure ttgobj.gettemptyped(list: TAsmList; def:tdef;temptype:ttemptype;out ref : treference); + var + varalign : shortint; + begin + varalign:=def.alignment; + varalign:=used_align(varalign,current_settings.alignment.localalignmin,current_settings.alignment.localalignmax); + { can't use reference_reset_base, because that will let tgobj depend + on cgobj (PFV) } + fillchar(ref,sizeof(ref),0); + ref.base:=current_procinfo.framepointer; + ref.offset:=alloctemp(list,def.size,varalign,temptype,def); + ref.alignment:=varalign; + end; + + + function ttgobj.istemp(const ref : treference) : boolean; + begin + { ref.index = R_NO was missing + led to problems with local arrays + with lower bound > 0 (PM) } + if direction = 1 then + begin + istemp:=(ref.base=current_procinfo.framepointer) and + (ref.index=NR_NO) and + (ref.offset>=firsttemp); + end + else + begin + istemp:=(ref.base=current_procinfo.framepointer) and + (ref.index=NR_NO) and + (ref.offset<firsttemp); + end; + end; + + + function ttgobj.sizeoftemp(list: TAsmList; const ref: treference): longint; + var + hp : ptemprecord; + begin + SizeOfTemp := -1; + hp:=templist; + while assigned(hp) do + begin + if (hp^.pos=ref.offset) then + begin + sizeoftemp := hp^.size; + exit; + end; + hp := hp^.next; + end; +{$ifdef EXTDEBUG} + comment(v_debug,'tgobj: (SizeOfTemp) temp at pos '+tostr(ref.offset)+' not found !'); + list.concat(tai_tempalloc.allocinfo(ref.offset,0,'temp not found')); +{$endif} + end; + + + function ttgobj.changetemptype(list: tasmList; const ref:treference; temptype:ttemptype):boolean; + var + hp : ptemprecord; + begin + ChangeTempType:=false; + hp:=templist; + while assigned(hp) do + begin + if (hp^.pos=ref.offset) then + begin + if hp^.temptype<>tt_free then + begin +{$ifdef EXTDEBUG} + if hp^.temptype=temptype then + Comment(V_Warning,'tgobj: (ChangeTempType) temp'+ + ' at pos '+tostr(ref.offset)+ ' is already of the correct type !'); + list.concat(tai_tempalloc.allocinfo(hp^.pos,hp^.size,'type changed to '+TempTypeStr[temptype])); +{$endif} + ChangeTempType:=true; + hp^.temptype:=temptype; + end + else + begin +{$ifdef EXTDEBUG} + Comment(V_Warning,'tgobj: (ChangeTempType) temp'+ + ' at pos '+tostr(ref.offset)+ ' is already freed !'); + list.concat(tai_tempalloc.allocinfo(hp^.pos,hp^.size,'temp is already freed')); +{$endif} + end; + exit; + end; + hp:=hp^.next; + end; +{$ifdef EXTDEBUG} + Comment(V_Warning,'tgobj: (ChangeTempType) temp'+ + ' at pos '+tostr(ref.offset)+ ' not found !'); + list.concat(tai_tempalloc.allocinfo(ref.offset,0,'temp not found')); +{$endif} + end; + + + function ttgobj.gettypeoftemp(const ref:treference): ttemptype; + var + hp : ptemprecord; + begin + hp:=templist; + while assigned(hp) do + begin + if (hp^.pos=ref.offset) then + begin + if hp^.temptype<>tt_free then + result:=hp^.temptype + else + internalerror(2007020810); + exit; + end; + hp:=hp^.next; + end; + result:=tt_none; + end; + + + procedure ttgobj.UnGetTemp(list: TAsmList; const ref : treference); + begin + FreeTemp(list,ref.offset,[tt_normal,tt_noreuse,tt_persistent]); + end; + + + procedure ttgobj.UnGetIfTemp(list: TAsmList; const ref : treference); + begin + if istemp(ref) then + FreeTemp(list,ref.offset,[tt_normal]); + end; + + + procedure ttgobj.getlocal(list: TAsmList; size : longint;def:tdef;var ref : treference); + begin + getlocal(list, size, def.alignment, def, ref); + end; + + + procedure ttgobj.getlocal(list: TAsmList; size : longint; alignment : shortint; def:tdef;var ref : treference); + begin + alignment:=used_align(alignment,current_settings.alignment.localalignmin,current_settings.alignment.localalignmax); + { can't use reference_reset_base, because that will let tgobj depend + on cgobj (PFV) } + fillchar(ref,sizeof(ref),0); + ref.base:=current_procinfo.framepointer; + ref.offset:=alloctemp(list,size,alignment,tt_persistent,nil); + ref.alignment:=alignment; + end; + + + procedure ttgobj.UnGetLocal(list: TAsmList; const ref : treference); + begin + FreeTemp(list,ref.offset,[tt_persistent]); + end; + +end. diff --git a/closures/compiler/tokens.pas b/closures/compiler/tokens.pas new file mode 100644 index 0000000000..404e20602d --- /dev/null +++ b/closures/compiler/tokens.pas @@ -0,0 +1,651 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller + + Tokens used by 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 tokens; + +{$i fpcdefs.inc} + +interface + +uses + globtype; + +type + ttoken=(NOTOKEN, + { operators, which can also be overloaded } + _PLUS, + _MINUS, + _STAR, + _SLASH, + _EQ, + _GT, + _LT, + _GTE, + _LTE, + _NE, + _SYMDIF, + _STARSTAR, + _OP_AS, + _OP_IN, + _OP_IS, + _OP_OR, + _OP_AND, + _OP_DIV, + _OP_MOD, + _OP_NOT, + _OP_SHL, + _OP_SHR, + _OP_XOR, + _ASSIGNMENT, + _OP_EXPLICIT, + _OP_ENUMERATOR, + _OP_INC, + _OP_DEC, + { special chars } + _CARET, + _LECKKLAMMER, + _RECKKLAMMER, + _POINT, + _COMMA, + _LKLAMMER, + _RKLAMMER, + _COLON, + _SEMICOLON, + _KLAMMERAFFE, + _POINTPOINT, + _POINTPOINTPOINT, + _PIPE, + _AMPERSAND, + _EOF, + _ID, + _NOID, + _REALNUMBER, + _INTCONST, + _CSTRING, + _CCHAR, + _CWSTRING, + _CWCHAR, + _LSHARPBRACKET, + _RSHARPBRACKET, + { C like operators } + _PLUSASN, + _MINUSASN, + _ANDASN, + _ORASN, + _STARASN, + _SLASHASN, + _MODASN, + _DIVASN, + _NOTASN, + _XORASN, + _GENERICSPECIALTOKEN, + { Normal words -- ATTENTION: These words must be sorted: } + { first in length order, then in alphabetical order. } + _C, + _AS, + _AT, + _DO, + _IF, + _IN, + _IS, + _OF, + _ON, + _OR, + _TO, + _ADD, + _AND, + _ASM, + _DEC, + _DIV, + _END, + _FAR, + _FOR, + _INC, + _MOD, + _NIL, + _NOT, + _OUT, + _SET, + _SHL, + _SHR, + _TRY, + _VAR, + _XOR, + _CASE, + _CVAR, + _ELSE, + _EXIT, + _FAIL, + _FILE, + _GOTO, + _NAME, + _NEAR, + _READ, + _SELF, + _SYSV, + _THEN, + _TRUE, + _TYPE, + _UNIT, + _UNIV, + _USES, + _WITH, + _ALIAS, + _ARRAY, + _BEGIN, + _BREAK, + _CDECL, + _CLASS, + _CONST, + _EQUAL, + _FALSE, + _FAR16, + _FINAL, + _INDEX, + _LABEL, + _LOCAL, + _RAISE, + _UNTIL, + _WHILE, + _WRITE, + _DISPID, + _DIVIDE, + _DOWNTO, + _EXCEPT, + _EXPORT, + _HELPER, + _INLINE, + _LEGACY, + _NESTED, + _OBJECT, + _PACKED, + _PASCAL, + _PUBLIC, + _RECORD, + _REPEAT, + _RESULT, + _RETURN, + _SEALED, + _STATIC, + _STORED, + _STRICT, + _STRING, + _SYSTEM, + _ASMNAME, + _CPPDECL, + _DEFAULT, + _DYNAMIC, + _EXPORTS, + _FINALLY, + _FORWARD, + _GENERIC, + _IOCHECK, + _LIBRARY, + _MESSAGE, + _MODULUS, + _PACKAGE, + _PRIVATE, + _PROGRAM, + _R12BASE, + _RTLPROC, + _SECTION, + _STDCALL, + _SYSCALL, + _VARARGS, + _VIRTUAL, + _ABSOLUTE, + _ABSTRACT, + _BASESYSV, + _CONSTREF, + _CONTAINS, + _CONTINUE, + _CPPCLASS, + _EXPLICIT, + _EXTERNAL, + _FUNCTION, + _IMPLICIT, + _LESSTHAN, + _LOCATION, + _MULTIPLY, + _MWPASCAL, + _NEGATIVE, + _NOTEQUAL, + _OPERATOR, + _OPTIONAL, + _OVERLOAD, + _OVERRIDE, + _PLATFORM, + _POSITIVE, + _PROPERTY, + _READONLY, + _REGISTER, + _REQUIRED, + _REQUIRES, + _RESIDENT, + _SAFECALL, + _SUBTRACT, + _SYSVBASE, + _ASSEMBLER, + _BITPACKED, + _BITWISEOR, + _INHERITED, + _INTDIVIDE, + _INTERFACE, + _INTERRUPT, + _LEFTSHIFT, + _LOGICALOR, + _NODEFAULT, + _OBJCCLASS, + _OTHERWISE, + _PROCEDURE, + _PROTECTED, + _PUBLISHED, + _SOFTFLOAT, + _THREADVAR, + _WRITEONLY, + _BITWISEAND, + _BITWISEXOR, + _DEPRECATED, + _DESTRUCTOR, + _ENUMERATOR, + _IMPLEMENTS, + _INTERNPROC, + _LOGICALAND, + _LOGICALNOT, + _LOGICALXOR, + _OLDFPCCALL, + _OPENSTRING, + _RIGHTSHIFT, + _SPECIALIZE, + _CONSTRUCTOR, + _GREATERTHAN, + _INTERNCONST, + _REINTRODUCE, + _SHORTSTRING, + _COMPILERPROC, + _EXPERIMENTAL, + _FINALIZATION, + _NOSTACKFRAME, + _OBJCCATEGORY, + _OBJCPROTOCOL, + _WEAKEXTERNAL, + _DISPINTERFACE, + _UNIMPLEMENTED, + _IMPLEMENTATION, + _INITIALIZATION, + _RESOURCESTRING, + _LESSTHANOREQUAL, + _GREATERTHANOREQUAL + ); + +const + tokenlenmin = 1; + tokenlenmax = 18; + + { last operator which can be overloaded, the first_overloaded should + be declared directly after NOTOKEN } + first_overloaded = succ(NOTOKEN); + last_overloaded = _OP_DEC; + last_operator = _GENERICSPECIALTOKEN; + +type + tokenrec=record + str : string[tokenlenmax]; + special : boolean; + keyword : tmodeswitch; + op : ttoken; + end; + + ttokenarray=array[ttoken] of tokenrec; + ptokenarray=^ttokenarray; + + tokenidxrec=record + first,last : ttoken; + end; + + ptokenidx=^ttokenidx; + ttokenidx=array[tokenlenmin..tokenlenmax,'A'..'Z'] of tokenidxrec; + +const + arraytokeninfo : ttokenarray =( + (str:'' ;special:true ;keyword:m_none;op:NOTOKEN), + { Operators which can be overloaded } + (str:'+' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'-' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'*' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'/' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'=' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'>' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'<' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'>=' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'<=' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'<>' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'><' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'**' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'as' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'in' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'is' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'or' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'and' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'div' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'mod' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'not' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'shl' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'shr' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'xor' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:':=' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'explicit' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'enumerator' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'inc' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'dec' ;special:true ;keyword:m_none;op:NOTOKEN), + { Special chars } + (str:'^' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'[' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:']' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'.' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:',' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'(' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:')' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:':' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:';' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'@' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'..' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'...' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'|' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'&' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'end of file' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'identifier' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'non identifier';special:true ;keyword:m_none;op:NOTOKEN), + (str:'const real' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'ordinal const' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'const string' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'const char' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'const wstring' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'const wchar' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'<' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'>' ;special:true ;keyword:m_none;op:NOTOKEN), + { C like operators } + (str:'+=' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'-=' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'&=' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'|=' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'*=' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'/=' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'' ;special:true ;keyword:m_none;op:NOTOKEN), + (str:'gen. spec.' ;special:true ;keyword:m_none;op:NOTOKEN), + { Normal words -- ATTENTION: These words must be sorted: } + { first in length order, then in alphabetical order. } + (str:'C' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'AS' ;special:false;keyword:m_class;op:_OP_AS), + (str:'AT' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'DO' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'IF' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'IN' ;special:false;keyword:m_all;op:_OP_IN), + (str:'IS' ;special:false;keyword:m_class;op:_OP_IS), + (str:'OF' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'ON' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'OR' ;special:false;keyword:m_all;op:_OP_OR), + (str:'TO' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'ADD' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'AND' ;special:false;keyword:m_all;op:_OP_AND), + (str:'ASM' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'DEC' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'DIV' ;special:false;keyword:m_all;op:_OP_DIV), + (str:'END' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'FAR' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'FOR' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'INC' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'MOD' ;special:false;keyword:m_all;op:_OP_MOD), + (str:'NIL' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'NOT' ;special:false;keyword:m_all;op:_OP_NOT), + (str:'OUT' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'SET' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'SHL' ;special:false;keyword:m_all;op:_OP_SHL), + (str:'SHR' ;special:false;keyword:m_all;op:_OP_SHR), + (str:'TRY' ;special:false;keyword:m_except;op:NOTOKEN), + (str:'VAR' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'XOR' ;special:false;keyword:m_all;op:_OP_XOR), + (str:'CASE' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'CVAR' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'ELSE' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'EXIT' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'FAIL' ;special:false;keyword:m_none;op:NOTOKEN), { only set within constructors PM } + (str:'FILE' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'GOTO' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'NAME' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'NEAR' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'READ' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'SELF' ;special:false;keyword:m_none;op:NOTOKEN), {set inside methods only PM } + (str:'SYSV' ;special:false;keyword:m_none;op:NOTOKEN), { Syscall variation on MorphOS } + (str:'THEN' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'TRUE' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'TYPE' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'UNIT' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'UNIV' ;special:false;keyword:m_mac;op:NOTOKEN), + (str:'USES' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'WITH' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'ALIAS' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'ARRAY' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'BEGIN' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'BREAK' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'CDECL' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'CLASS' ;special:false;keyword:m_class;op:NOTOKEN), + (str:'CONST' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'EQUAL' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'FALSE' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'FAR16' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'FINAL' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'INDEX' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'LABEL' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'LOCAL' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'RAISE' ;special:false;keyword:m_except;op:NOTOKEN), + (str:'UNTIL' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'WHILE' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'WRITE' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'DISPID' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'DIVIDE' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'DOWNTO' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'EXCEPT' ;special:false;keyword:m_except;op:NOTOKEN), + (str:'EXPORT' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'HELPER' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'INLINE' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'LEGACY' ;special:false;keyword:m_none;op:NOTOKEN), { Syscall variation on MorphOS } + (str:'NESTED' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'OBJECT' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'PACKED' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'PASCAL' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'PUBLIC' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'RECORD' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'REPEAT' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'RESULT' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'RETURN' ;special:false;keyword:m_mac;op:NOTOKEN), + (str:'SEALED' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'STATIC' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'STORED' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'STRICT' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'STRING' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'SYSTEM' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'ASMNAME' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'CPPDECL' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'DEFAULT' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'DYNAMIC' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'EXPORTS' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'FINALLY' ;special:false;keyword:m_except;op:NOTOKEN), + (str:'FORWARD' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'GENERIC' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'IOCHECK' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'LIBRARY' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'MESSAGE' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'MODULUS' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'PACKAGE' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'PRIVATE' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'PROGRAM' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'R12BASE' ;special:false;keyword:m_none;op:NOTOKEN), { Syscall variation on MorphOS } + (str:'RTLPROC' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'SECTION' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'STDCALL' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'SYSCALL' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'VARARGS' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'VIRTUAL' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'ABSOLUTE' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'ABSTRACT' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'BASESYSV' ;special:false;keyword:m_none;op:NOTOKEN), { Syscall variation on MorphOS } + (str:'CONSTREF' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'CONTAINS' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'CONTINUE' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'CPPCLASS' ;special:false;keyword:m_fpc;op:NOTOKEN), + (str:'EXPLICIT' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'EXTERNAL' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'FUNCTION' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'IMPLICIT' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'LESSTHAN' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'LOCATION' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'MULTIPLY' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'MWPASCAL' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'NEGATIVE' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'NOTEQUAL' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'OPERATOR' ;special:false;keyword:m_fpc;op:NOTOKEN), + (str:'OPTIONAL' ;special:false;keyword:m_none;op:NOTOKEN), { optional methods in an Objective-C protocol } + (str:'OVERLOAD' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'OVERRIDE' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'PLATFORM' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'POSITIVE' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'PROPERTY' ;special:false;keyword:m_property;op:NOTOKEN), + (str:'READONLY' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'REGISTER' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'REQUIRED' ;special:false;keyword:m_none;op:NOTOKEN), { required methods in an Objective-C protocol } + (str:'REQUIRES' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'RESIDENT' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'SAFECALL' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'SUBTRACT' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'SYSVBASE' ;special:false;keyword:m_none;op:NOTOKEN), { Syscall variation on MorphOS } + (str:'ASSEMBLER' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'BITPACKED' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'BITWISEOR' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'INHERITED' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'INTDIVIDE' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'INTERFACE' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'INTERRUPT' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'LEFTSHIFT' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'LOGICALOR' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'NODEFAULT' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'OBJCCLASS' ;special:false;keyword:m_objectivec1;op:NOTOKEN), + (str:'OTHERWISE' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'PROCEDURE' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'PROTECTED' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'PUBLISHED' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'SOFTFLOAT' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'THREADVAR' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'WRITEONLY' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'BITWISEAND' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'BITWISEXOR' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'DEPRECATED' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'DESTRUCTOR' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'ENUMERATOR' ;special:false;keyword:m_none;op:_OP_ENUMERATOR), + (str:'IMPLEMENTS' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'INTERNPROC' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'LOGICALAND' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'LOGICALNOT' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'LOGICALXOR' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'OLDFPCCALL' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'OPENSTRING' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'RIGHTSHIFT' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'SPECIALIZE' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'CONSTRUCTOR' ;special:false;keyword:m_all;op:NOTOKEN), + (str:'GREATERTHAN' ;special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'INTERNCONST' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'REINTRODUCE' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'SHORTSTRING' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'COMPILERPROC' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'EXPERIMENTAL' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'FINALIZATION' ;special:false;keyword:m_initfinal;op:NOTOKEN), + (str:'NOSTACKFRAME' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'OBJCCATEGORY' ;special:false;keyword:m_objectivec1;op:NOTOKEN), { Objective-C category } + (str:'OBJCPROTOCOL' ;special:false;keyword:m_objectivec1;op:NOTOKEN), { Objective-C protocol } + (str:'WEAKEXTERNAL' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'DISPINTERFACE' ;special:false;keyword:m_class;op:NOTOKEN), + (str:'UNIMPLEMENTED' ;special:false;keyword:m_none;op:NOTOKEN), + (str:'IMPLEMENTATION';special:false;keyword:m_all;op:NOTOKEN), + (str:'INITIALIZATION';special:false;keyword:m_initfinal;op:NOTOKEN), + (str:'RESOURCESTRING';special:false;keyword:m_all;op:NOTOKEN), + (str:'LESSTHANOREQUAL';special:false;keyword:m_none;op:NOTOKEN), { delphi operator name } + (str:'GREATERTHANOREQUAL';special:false;keyword:m_none;op:NOTOKEN) { delphi operator name } + ); + + +var + tokeninfo:ptokenarray; + tokenidx:ptokenidx; + +procedure inittokens; +procedure donetokens; +procedure create_tokenidx; + + +implementation + +procedure create_tokenidx; +{ create an index with the first and last token for every possible token + length, so a search only will be done in that small part } +var + t : ttoken; + i : longint; + c : char; +begin + fillchar(tokenidx^,sizeof(tokenidx^),0); + for t:=low(ttoken) to high(ttoken) do + begin + if not arraytokeninfo[t].special then + begin + i:=length(arraytokeninfo[t].str); + c:=arraytokeninfo[t].str[1]; + if ord(tokenidx^[i,c].first)=0 then + tokenidx^[i,c].first:=t; + tokenidx^[i,c].last:=t; + end; + end; +end; + + +procedure inittokens; +begin + if tokenidx = nil then + begin + tokeninfo:=@arraytokeninfo; + new(tokenidx); + create_tokenidx; + end; +end; + + +procedure donetokens; +begin + if tokenidx <> nil then + begin + tokeninfo:=nil; + dispose(tokenidx); + tokenidx:=nil; + end; +end; + +end. diff --git a/closures/compiler/utils/Makefile b/closures/compiler/utils/Makefile new file mode 100644 index 0000000000..68e846c595 --- /dev/null +++ b/closures/compiler/utils/Makefile @@ -0,0 +1,2469 @@ +# +# Don't edit, this file is generated by FPCMake Version 2.0.0 [2011/12/04] +# +default: all +MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-solaris x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded avr-embedded armeb-linux armeb-embedded mipsel-linux +BSDs = freebsd netbsd openbsd darwin +UNIXs = linux $(BSDs) solaris qnx haiku +LIMIT83fs = go32v2 os2 emx watcom +OSNeedsComspecToRunBatch = go32v2 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 COMSPEC +ifneq ($(findstring $(OS_SOURCE),$(OSNeedsComspecToRunBatch)),) +ifndef RUNBATCH +RUNBATCH=$(COMSPEC) /C +endif +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)) +ifneq ($(CPU_TARGET),) +FPC:=$(shell $(FPCPROG) -P$(CPU_TARGET) -PB) +else +FPC:=$(shell $(FPCPROG) -PB) +endif +ifneq ($(findstring Error,$(FPC)),) +override FPC=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) +else +ifeq ($(strip $(wildcard $(FPC))),) +FPC:=$(firstword $(FPCPROG)) +endif +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 +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) +ifeq ($(CPU_TARGET),armeb) +ARCH=arm +override FPCOPT+=-Cb +else +ifeq ($(CPU_TARGET),armel) +ARCH=arm +override FPCOPT+=-CaEABI +else +ARCH=$(CPU_TARGET) +endif +endif +ifeq ($(FULL_TARGET),arm-embedded) +ifeq ($(SUBARCH),) +$(error When compiling for arm-embedded, a sub-architecture (e.g. SUBARCH=armv4t or SUBARCH=armv7m) must be defined) +endif +override FPCOPT+=-Cp$(SUBARCH) +endif +ifneq ($(findstring $(OS_SOURCE),$(LIMIT83fs)),) +TARGETSUFFIX=$(OS_TARGET) +SOURCESUFFIX=$(OS_SOURCE) +else +ifneq ($(findstring $(OS_TARGET),$(LIMIT83fs)),) +TARGETSUFFIX=$(OS_TARGET) +else +TARGETSUFFIX=$(FULL_TARGET) +endif +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 ARCH 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 +ifneq ($(findstring $(OS_TARGET),darwin iphonesim),) +ifeq ($(OS_SOURCE),darwin) +DARWIN2DARWIN=1 +endif +endif +ifndef BINUTILSPREFIX +ifndef CROSSBINDIR +ifdef CROSSCOMPILE +ifndef DARWIN2DARWIN +BINUTILSPREFIX=$(CPU_TARGET)-$(OS_TARGET)- +endif +endif +endif +endif +UNITSDIR:=$(wildcard $(FPCDIR)/units/$(TARGETSUFFIX)) +ifeq ($(UNITSDIR),) +UNITSDIR:=$(wildcard $(FPCDIR)/units/$(OS_TARGET)) +endif +PACKAGESDIR:=$(wildcard $(FPCDIR) $(FPCDIR)/packages $(FPCDIR)/packages/base $(FPCDIR)/packages/extra) +ifndef FPCFPMAKE +ifdef CROSSCOMPILE +ifeq ($(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR)))),) +FPCPROG:=$(strip $(wildcard $(addsuffix /fpc$(SRCEXEEXT),$(SEARCHPATH)))) +ifneq ($(FPCPROG),) +FPCPROG:=$(firstword $(FPCPROG)) +FPCFPMAKE:=$(shell $(FPCPROG) -PB) +ifeq ($(strip $(wildcard $(FPCFPMAKE))),) +FPCFPMAKE:=$(firstword $(FPCPROG)) +endif +else +override FPCFPMAKE=$(firstword $(strip $(wildcard $(addsuffix /ppc386$(SRCEXEEXT),$(SEARCHPATH))))) +endif +else +FPCFPMAKE=$(strip $(wildcard $(addsuffix /compiler/ppc$(SRCEXEEXT),$(FPCDIR)))) +FPMAKE_SKIP_CONFIG=-n +export FPCFPMAKE +export FPMAKE_SKIP_CONFIG +endif +else +FPMAKE_SKIP_CONFIG=-n +FPCFPMAKE=$(FPC) +endif +endif +ifeq ($(FULL_TARGET),i386-linux) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-win32) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-os2) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-beos) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-haiku) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-solaris) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-qnx) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-netware) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-darwin) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-emx) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-watcom) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-wince) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-embedded) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-symbian) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-nativent) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-iphonesim) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),m68k-linux) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),m68k-atari) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),m68k-embedded) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),powerpc-wii) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),sparc-linux) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),sparc-embedded) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),x86_64-solaris) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),arm-linux) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),arm-palmos) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),arm-darwin) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),arm-wince) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),arm-gba) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),arm-nds) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),arm-embedded) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),arm-symbian) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),avr-embedded) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),armeb-linux) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),armeb-embedded) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),mipsel-linux) +override TARGET_PROGRAMS+=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +endif +ifeq ($(FULL_TARGET),i386-linux) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-win32) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-os2) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-beos) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-haiku) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-solaris) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-qnx) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-netware) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-darwin) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-emx) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-watcom) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-wince) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-embedded) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-symbian) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-nativent) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),i386-iphonesim) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),m68k-linux) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),m68k-atari) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),m68k-embedded) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),powerpc-wii) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),sparc-linux) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),sparc-embedded) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),x86_64-solaris) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),arm-linux) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),arm-palmos) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),arm-darwin) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),arm-wince) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),arm-gba) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),arm-nds) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),arm-embedded) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),arm-symbian) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),avr-embedded) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),armeb-linux) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),armeb-embedded) +override CLEAN_UNITS+=ppu crc usubst +endif +ifeq ($(FULL_TARGET),mipsel-linux) +override CLEAN_UNITS+=ppu crc usubst +endif +override INSTALL_FPCPACKAGE=y +ifeq ($(FULL_TARGET),i386-linux) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-win32) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-os2) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-beos) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-haiku) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-solaris) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-qnx) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-netware) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-darwin) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-emx) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-watcom) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-wince) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-embedded) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-symbian) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-nativent) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-iphonesim) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-linux) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-atari) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-embedded) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-wii) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),sparc-linux) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),sparc-embedded) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),x86_64-solaris) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-linux) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-palmos) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-darwin) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-wince) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-gba) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-nds) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-embedded) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-symbian) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),avr-embedded) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),armeb-linux) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),armeb-embedded) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),mipsel-linux) +override COMPILER_UNITDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-linux) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-go32v2) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-win32) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-os2) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-freebsd) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-beos) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-haiku) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-netbsd) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-solaris) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-qnx) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-netware) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-openbsd) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-wdosx) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-darwin) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-emx) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-watcom) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-netwlibc) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-wince) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-embedded) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-symbian) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-nativent) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),i386-iphonesim) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-linux) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-freebsd) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-netbsd) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-amiga) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-atari) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-openbsd) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-palmos) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),m68k-embedded) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-linux) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-netbsd) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-amiga) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-macos) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-darwin) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-morphos) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-embedded) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc-wii) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),sparc-linux) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),sparc-netbsd) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),sparc-solaris) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),sparc-embedded) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),x86_64-linux) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),x86_64-freebsd) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),x86_64-solaris) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),x86_64-win64) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-linux) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-palmos) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-darwin) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-wince) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-gba) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-nds) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-embedded) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),arm-symbian) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),avr-embedded) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),armeb-linux) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),armeb-embedded) +override COMPILER_SOURCEDIR+=.. +endif +ifeq ($(FULL_TARGET),mipsel-linux) +override COMPILER_SOURCEDIR+=.. +endif +override SHARED_BUILD=n +override SHARED_BUILD=n +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 +ifndef INSTALL_SHAREDDIR +INSTALL_SHAREDDIR=$(INSTALL_PREFIX)/lib +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 +SHAREDLIBPREFIX=libfp +STATICLIBPREFIX=libp +IMPORTLIBPREFIX=libimp +RSTEXT=.rst +EXEDBGEXT=.dbg +ifeq ($(OS_TARGET),go32v1) +STATICLIBPREFIX= +SHORTSUFFIX=v1 +endif +ifeq ($(OS_TARGET),go32v2) +STATICLIBPREFIX= +SHORTSUFFIX=dos +IMPORTLIBPREFIX= +endif +ifeq ($(OS_TARGET),watcom) +STATICLIBPREFIX= +OEXT=.obj +ASMEXT=.asm +SHAREDLIBEXT=.dll +SHORTSUFFIX=wat +IMPORTLIBPREFIX= +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 +IMPORTLIBPREFIX= +endif +ifeq ($(OS_TARGET),emx) +BATCHEXT=.cmd +AOUTEXT=.out +STATICLIBPREFIX= +SHAREDLIBEXT=.dll +SHORTSUFFIX=emx +ECHO=echo +IMPORTLIBPREFIX= +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),haiku) +BATCHEXT=.sh +EXEEXT= +SHORTSUFFIX=hai +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 +IMPORTLIBPREFIX=imp +endif +ifeq ($(OS_TARGET),netwlibc) +EXEEXT=.nlm +STATICLIBPREFIX= +SHORTSUFFIX=nwl +IMPORTLIBPREFIX=imp +endif +ifeq ($(OS_TARGET),macos) +BATCHEXT= +EXEEXT= +DEBUGSYMEXT=.xcoff +SHORTSUFFIX=mac +IMPORTLIBPREFIX=imp +endif +ifneq ($(findstring $(OS_TARGET),darwin iphonesim),) +BATCHEXT=.sh +EXEEXT= +HASSHAREDLIB=1 +SHORTSUFFIX=dwn +EXEDBGEXT=.dSYM +endif +ifeq ($(OS_TARGET),gba) +EXEEXT=.gba +SHAREDLIBEXT=.so +SHORTSUFFIX=gba +endif +ifeq ($(OS_TARGET),symbian) +SHAREDLIBEXT=.dll +SHORTSUFFIX=symbian +endif +ifeq ($(OS_TARGET),NativeNT) +SHAREDLIBEXT=.dll +SHORTSUFFIX=nativent +endif +ifeq ($(OS_TARGET),wii) +EXEEXT=.dol +SHAREDLIBEXT=.so +SHORTSUFFIX=wii +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 /gtar$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(TARPROG),) +TARPROG:=$(strip $(wildcard $(addsuffix /tar$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(TARPROG),) +TARPROG= __missing_command_TARPROG +else +TARPROG:=$(firstword $(TARPROG)) +endif +else +TARPROG:=$(firstword $(TARPROG)) +endif +endif +export TARPROG +ASNAME=$(BINUTILSPREFIX)as +LDNAME=$(BINUTILSPREFIX)ld +ARNAME=$(BINUTILSPREFIX)ar +RCNAME=$(BINUTILSPREFIX)rc +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:= +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 +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-haiku) +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-darwin) +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),i386-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-symbian) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-nativent) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),i386-iphonesim) +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),m68k-embedded) +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-amiga) +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),powerpc-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc-wii) +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),sparc-embedded) +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-solaris) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),x86_64-darwin) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),x86_64-win64) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),x86_64-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-palmos) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-darwin) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-wince) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-gba) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-nds) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),arm-symbian) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc64-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc64-darwin) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),powerpc64-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),avr-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),armeb-linux) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),armeb-embedded) +REQUIRE_PACKAGES_RTL=1 +endif +ifeq ($(FULL_TARGET),mipsel-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 +ifneq ($(wildcard $(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX)),) +UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units/$(SOURCESUFFIX) +else +ifneq ($(wildcard $(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX)),) +UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL)/units_bs/$(SOURCESUFFIX) +else +UNITDIR_FPMAKE_RTL=$(PACKAGEDIR_RTL) +endif +endif +ifdef CHECKDEPEND +$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(FPCMADE): + $(MAKE) -C $(PACKAGEDIR_RTL)/$(OS_TARGET) $(FPCMADE) +override ALLDEPENDENCIES+=$(PACKAGEDIR_RTL)/$(OS_TARGET)/$(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 +ifdef UNITDIR_FPMAKE_RTL +override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_RTL) +endif +endif +ifndef NOCPUDEF +override FPCOPTDEF=$(ARCH) +endif +ifneq ($(OS_TARGET),$(OS_SOURCE)) +override FPCOPT+=-T$(OS_TARGET) +endif +ifneq ($(CPU_TARGET),$(CPU_SOURCE)) +override FPCOPT+=-P$(ARCH) +endif +ifeq ($(OS_SOURCE),openbsd) +override FPCOPT+=-FD$(NEW_BINUTILS_PATH) +override FPCMAKEOPT+=-FD$(NEW_BINUTILS_PATH) +endif +ifndef CROSSBOOTSTRAP +ifneq ($(BINUTILSPREFIX),) +override FPCOPT+=-XP$(BINUTILSPREFIX) +override FPCMAKEOPT+=-XP$(BINUTILSPREFIX) +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 +ifneq ($(findstring 2.0.,$(FPC_VERSION)),) +ifeq ($(CPU_TARGET),i386) +FPCCPUOPT:=-OG2p3 +endif +ifeq ($(CPU_TARGET),powerpc) +FPCCPUOPT:=-O1r +endif +else +FPCCPUOPT:=-O2 +endif +override FPCOPT+=-Ur -Xs $(FPCCPUOPT) -n +override FPCOPTDEF+=RELEASE +endif +ifdef STRIP +override FPCOPT+=-Xs +endif +ifdef OPTIMIZE +override FPCOPT+=-O2 +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 +ifdef CREATESHARED +override FPCOPT+=-Cg +ifeq ($(CPU_TARGET),i386) +override FPCOPT+=-Aas +endif +endif +ifeq ($(findstring 2.0.,$(FPC_VERSION)),) +ifneq ($(findstring $(OS_TARGET),freebsd openbsd netbsd linux solaris),) +ifeq ($(CPU_TARGET),x86_64) +override FPCOPT+=-Cg +endif +endif +endif +ifdef LINKSHARED +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 AFULL_TARGET=$(CPU_TARGET)-$(OS_TARGET) +override AFULL_SOURCE=$(CPU_SOURCE)-$(OS_SOURCE) +ifneq ($(AFULL_TARGET),$(AFULL_SOURCE)) +override ACROSSCOMPILE=1 +endif +ifdef ACROSSCOMPILE +override FPCOPT+=$(CROSSOPT) +endif +override COMPILER:=$(FPC) $(FPCOPT) +ifeq (,$(findstring -s ,$(COMPILER))) +EXECPPAS= +else +ifeq ($(FULL_SOURCE),$(FULL_TARGET)) +ifdef RUNBATCH +EXECPPAS:=@$(RUNBATCH) $(PPAS) +else +EXECPPAS:=@$(PPAS) +endif +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))) $(addprefix $(IMPORTLIBPREFIX),$(addsuffix $(STATICLIBEXT),$(TARGET_PROGRAMS))) +override EXEDBGFILES:=$(addsuffix $(EXEDBGEXT),$(TARGET_PROGRAMS)) +override ALLTARGET+=fpc_exes +override INSTALLEXEFILES+=$(EXEFILES) +override CLEANEXEFILES+=$(EXEFILES) $(EXEOFILES) +override CLEANEXEDBGFILES+=$(EXEDBGFILES) +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 fpc_shared +$(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 %.inc $(COMPILER_INCLUDEDIR) +vpath %$(OEXT) $(COMPILER_UNITTARGETDIR) +vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR) +.PHONY: fpc_shared +override INSTALLTARGET+=fpc_shared_install +ifndef SHARED_LIBVERSION +SHARED_LIBVERSION=$(FPC_VERSION) +endif +ifndef SHARED_LIBNAME +SHARED_LIBNAME=$(PACKAGE_NAME) +endif +ifndef SHARED_FULLNAME +SHARED_FULLNAME=$(SHAREDLIBPREFIX)$(SHARED_LIBNAME)-$(SHARED_LIBVERSION)$(SHAREDLIBEXT) +endif +ifndef SHARED_LIBUNITS +SHARED_LIBUNITS:=$(TARGET_UNITS) $(TARGET_IMPLICITUNITS) +override SHARED_LIBUNITS:=$(filter-out $(INSTALL_BUILDUNIT),$(SHARED_LIBUNITS)) +endif +fpc_shared: +ifdef HASSHAREDLIB + $(MAKE) all CREATESHARED=1 LINKSHARED=1 CREATESMART=1 +ifneq ($(SHARED_BUILD),n) + $(PPUMOVE) -q $(SHARED_LIBUNITS) -i$(COMPILER_UNITTARGETDIR) -o$(SHARED_FULLNAME) -d$(COMPILER_UNITTARGETDIR) +endif +else + @$(ECHO) Shared Libraries not supported +endif +fpc_shared_install: +ifneq ($(SHARED_BUILD),n) +ifneq ($(SHARED_LIBUNITS),) +ifneq ($(wildcard $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME)),) + $(INSTALL) $(COMPILER_UNITTARGETDIR)/$(SHARED_FULLNAME) $(INSTALL_SHAREDDIR) +endif +endif +endif +.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))) $(addprefix $(IMPORTLIBPREFIX),$(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_clean fpc_cleanall fpc_distclean +ifdef EXEFILES +override CLEANEXEFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEFILES)) +override CLEANEXEDBGFILES:=$(addprefix $(TARGETDIRPREFIX),$(CLEANEXEDBGFILES)) +endif +ifdef CLEAN_PROGRAMS +override CLEANEXEFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEEXT), $(CLEAN_PROGRAMS))) +override CLEANEXEDBGFILES+=$(addprefix $(TARGETDIRPREFIX),$(addsuffix $(EXEDBGEXT), $(CLEAN_PROGRAMS))) +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))) $(addprefix $(IMPORTLIBPREFIX),$(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 CLEANEXEDBGFILES + -$(DELTREE) $(CLEANEXEDBGFILES) +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 +ifdef CLEAN_FILES + -$(DEL) $(CLEAN_FILES) +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) FPC fpmake... $(FPCFPMAKE) + @$(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 +ifndef DATA2INC +DATA2INC:=$(strip $(wildcard $(addsuffix /data2inc$(SRCEXEEXT),$(SEARCHPATH)))) +ifeq ($(DATA2INC),) +DATA2INC= __missing_command_DATA2INC +else +DATA2INC:=$(firstword $(DATA2INC)) +endif +endif +export DATA2INC +all: fpc_all +debug: fpc_debug +smart: fpc_smart +release: fpc_release +units: fpc_units +examples: +shared: fpc_shared +install: fpc_install +sourceinstall: fpc_sourceinstall +exampleinstall: fpc_exampleinstall +distinstall: +zipinstall: +zipsourceinstall: +zipexampleinstall: +zipdistinstall: +clean: fpc_clean +distclean: fpc_distclean +cleanall: fpc_cleanall +info: fpc_info +makefiles: fpc_makefiles +.PHONY: all debug smart release units examples shared install sourceinstall exampleinstall distinstall zipinstall zipsourceinstall zipexampleinstall zipdistinstall clean distclean cleanall info makefiles +ifneq ($(wildcard fpcmake.loc),) +include fpcmake.loc +endif +.NOTPARALLEL: +REG_SOURCES=$(wildcard *reg.pp) +REG_EXES=$(subst .pp,$(EXEEXT),$(REG_SOURCES)) +ifndef NOCPUDEF +ppu$(PPUEXT): ../ppu.pas + $(MAKE) ppu$(PPUEXT) NOCPUDEF=1 +ppudump$(EXEEXT): ppudump.pp ppu$(PPUEXT) + $(MAKE) ppudump$(EXEEXT) NOCPUDEF=1 +ppufiles$(EXEEXT): ppufiles.pp ppu$(PPUEXT) + $(MAKE) ppufiles$(EXEEXT) NOCPUDEF=1 +ppumove$(EXEEXT): ppumove.pp ppu$(PPUEXT) + $(MAKE) ppumove$(EXEEXT) NOCPUDEF=1 +else +ppu$(PPUEXT): ../ppu.pas + $(COMPILER) ../ppu.pas -Fu../generic -dGENERIC_CPU -Fi.. +ppudump$(EXEEXT): ppudump.pp ppu$(PPUEXT) + $(COMPILER) ppudump.pp -Fu../generic -dGENERIC_CPU -Fi.. +ppufiles$(EXEEXT): ppufiles.pp ppu$(PPUEXT) + $(COMPILER) ppufiles.pp -Fu../generic -dGENERIC_CPU -Fi.. +ppumove$(EXEEXT): ppumove.pp ppu$(PPUEXT) + $(COMPILER) ppumove.pp -Fu../generic -dGENERIC_CPU -Fi.. +endif +msg2inc$(EXEEXT): $(COMPILER_UNITTARGETDIR) msg2inc.pp +fpcsubst$(EXEEXT): fpcsubst.pp usubst.pp +fpcmkcfg$(EXEEXT): fpcmkcfg.pp usubst.pp fpccfg.inc fpcfg.inc fpini.inc +ifneq ($(DATA2INC),) +fpccfg.inc: fpc.cft + $(DATA2INC) -b -s fpc.cft fpccfg.inc DefaultConfig +fpcfg.inc : fpinc.cfg + $(DATA2INC) -b -s fpinc.cfg fpcfg.inc fpcfg +fpini.inc : fpinc.ini + $(DATA2INC) -b -s fpinc.ini fpini.inc fpini +endif +reg_exes: $(COMPILER_UNITTARGETDIR) + $(MAKE) $(REG_EXES) +unexport PPUFILES PPUMOVE diff --git a/closures/compiler/utils/Makefile.fpc b/closures/compiler/utils/Makefile.fpc new file mode 100644 index 0000000000..4073cc61f1 --- /dev/null +++ b/closures/compiler/utils/Makefile.fpc @@ -0,0 +1,93 @@ +# +# Makefile.fpc for Free Pascal Compiler Utils +# + +[target] +programs=fpc ppufiles ppudump ppumove fpcsubst mkarmins mkx86ins +rst=fpcsubst + +[clean] +units=ppu crc usubst + +[compiler] +unitdir=.. +sourcedir=.. + +[install] +fpcpackage=y + +[require] +tools=data2inc + +[default] +fpcdir=../.. + +[shared] +build=n + +[rules] +# +# PPU Tools +# + +# not parallel because systems using an external linker will get conflicts +# due to overwriting each other's link.res file +.NOTPARALLEL: + +REG_SOURCES=$(wildcard *reg.pp) +REG_EXES=$(subst .pp,$(EXEEXT),$(REG_SOURCES)) + +ifndef NOCPUDEF +ppu$(PPUEXT): ../ppu.pas + $(MAKE) ppu$(PPUEXT) NOCPUDEF=1 + +ppudump$(EXEEXT): ppudump.pp ppu$(PPUEXT) + $(MAKE) ppudump$(EXEEXT) NOCPUDEF=1 + +ppufiles$(EXEEXT): ppufiles.pp ppu$(PPUEXT) + $(MAKE) ppufiles$(EXEEXT) NOCPUDEF=1 + +ppumove$(EXEEXT): ppumove.pp ppu$(PPUEXT) + $(MAKE) ppumove$(EXEEXT) NOCPUDEF=1 + +else +ppu$(PPUEXT): ../ppu.pas + $(COMPILER) ../ppu.pas -Fu../generic -dGENERIC_CPU -Fi.. + +ppudump$(EXEEXT): ppudump.pp ppu$(PPUEXT) + $(COMPILER) ppudump.pp -Fu../generic -dGENERIC_CPU -Fi.. + +ppufiles$(EXEEXT): ppufiles.pp ppu$(PPUEXT) + $(COMPILER) ppufiles.pp -Fu../generic -dGENERIC_CPU -Fi.. + +ppumove$(EXEEXT): ppumove.pp ppu$(PPUEXT) + $(COMPILER) ppumove.pp -Fu../generic -dGENERIC_CPU -Fi.. + +endif + +msg2inc$(EXEEXT): $(COMPILER_UNITTARGETDIR) msg2inc.pp + +fpcsubst$(EXEEXT): fpcsubst.pp usubst.pp + +fpcmkcfg$(EXEEXT): fpcmkcfg.pp usubst.pp fpccfg.inc fpcfg.inc fpini.inc + +ifneq ($(DATA2INC),) +fpccfg.inc: fpc.cft + $(DATA2INC) -b -s fpc.cft fpccfg.inc DefaultConfig + +fpcfg.inc : fpinc.cfg + $(DATA2INC) -b -s fpinc.cfg fpcfg.inc fpcfg + +fpini.inc : fpinc.ini + $(DATA2INC) -b -s fpinc.ini fpini.inc fpini +endif + +reg_exes: $(COMPILER_UNITTARGETDIR) + $(MAKE) $(REG_EXES) + +# +# Don't export some tools, which are found in the current dir if it's in +# the path, so are not valid for the subdirs +# + +unexport PPUFILES PPUMOVE diff --git a/closures/compiler/utils/README.txt b/closures/compiler/utils/README.txt new file mode 100644 index 0000000000..4c9cc52948 --- /dev/null +++ b/closures/compiler/utils/README.txt @@ -0,0 +1,20 @@ +This directory contains some utilities that are used during the +development of the Free Pascal Compiler. + +msg2inc : Convert a compiler message file (errorX.msg) to .inc files to + include it as the default language in the compiler. It can + also convert the .msg to .tex for inclusion the documentation + +nasmconv : Convert a Nasm insns.dat to i386tab.inc so it can be used with + the compiler + +makecfg : This script will make the samplecfg for linux installations + +msgdif : analyzes the differences between two msg files + msgdif errore.msg errord.msg + will print out new error msg, removed old ones + and will create a new file new.msg that will + contain the new error messages (supposing TeX comment is after + the message line itself) + removed messages are prepended by "%%% " + (they can be useful in case on error enum renaming !) diff --git a/closures/compiler/utils/dummyas.pp b/closures/compiler/utils/dummyas.pp new file mode 100644 index 0000000000..922acc3091 --- /dev/null +++ b/closures/compiler/utils/dummyas.pp @@ -0,0 +1,112 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2007 by Pierre Muller + member of the Free Pascal development team. + + Dummy assembler program to be able to easily test + all FPC targets even without cross tools. + + 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. + + **********************************************************************} + +program dummyas; + +var + assembler_name : string; + object_name : string; + ofile : text; + +function RemoveSuffix(const st : string) : string; +var + i,last : longint; +begin + last:=length(st); + for i:=length(st) downto 1 do + begin + if st[i]='.' then + begin + last:=i-1; + break; + end; + end; + RemoveSuffix:=Copy(st,1,last); +end; + +var + i : longint; + param : string; + skipnext : boolean; +begin + object_name:=''; + skipnext:=false; + for i:=1 to ParamCount do + begin + param:=Paramstr(i); + if skipnext or (length(Param)=0) then + begin + skipnext:=false; + continue; + end; + if Param='-o' then + begin + skipnext:=true; + object_name:=ParamStr(i+1); + end + else if (Param[1]='-') then + begin + { option Param not handled } + { Shouldn't be a real problem } + end + else + begin + if assembler_name='' then + assembler_name:=ParamStr(i) + else + begin + Writeln(stderr,'two non option param found!'); + Writeln(stderr,'first non option param =',assembler_name); + Writeln(stderr,'second non option param =',Param); + Writeln(stderr,'Don''t know how to handle this!'); + halt(1); + end; + end; + end; + + if assembler_name='' then + begin + Writeln(stderr,'Dummyas, no source file specified'); + halt(1); + end; + Assign(ofile,assembler_name); +{$push}{$I-} + Reset(ofile); + if IOResult<>0 then + begin + Writeln(stderr,'Dummyas, source file not found ',assembler_name); + halt(1); + end; + Close(ofile); + if object_name='' then + object_name:=RemoveSuffix(assembler_name)+'.o'; + Assign(ofile,object_name); + Rewrite(ofile); + if IOResult<>0 then + begin + Writeln(stderr,'Dummyas, object file not writable ',object_name); + halt(1); + end; + Writeln(ofile,'Dummy as called'); + for i:=0 to Paramcount do + Write(ofile,ParamStr(i),' '); + Writeln(ofile); + Writeln(ofile,'assembler file=',assembler_name); + Writeln(ofile,'object file=',object_name); + Close(ofile); +{$pop} +end. diff --git a/closures/compiler/utils/fixlog.pp b/closures/compiler/utils/fixlog.pp new file mode 100644 index 0000000000..750b628878 --- /dev/null +++ b/closures/compiler/utils/fixlog.pp @@ -0,0 +1,174 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + Remove all revision logs from source files after X revisions or + older than date X + + 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. + + **********************************************************************} +program fixlog; + +{$mode objfpc} +{$H+} + +uses + sysutils; + +const + bufsize = 32*1024; + +var + maxrevs,myear,mmonth,mday : integer; + +procedure Date2Int(const date:string;var year,month,day:integer); +begin + year:=StrToInt(Copy(date,1,4)); + month:=StrToInt(Copy(date,6,2)); + day:=StrToInt(Copy(date,9,2)); + if (year=0) or (month=0) or (day=0) then + begin + writeln('wrong date "',date,'", use yyyy/mm/dd'); + halt(2); + end; +end; + + +procedure dofile(const fn:string); +var + t,f : text; + s : string; + skip, truncated : boolean; + year,month,day, + found,revs,i : integer; + fbuf,tbuf : pointer; +begin + getmem(fbuf,bufsize); + getmem(tbuf,bufsize); + write('processing ',fn,': '); + assign(t,fn); + assign(f,'fixlog.tmp'); + {$push}{$I-} + reset(t); + {$pop} + if ioresult<>0 then + begin + writeln('error!'); + exit; + end; + rewrite(f); + settextbuf(t,tbuf^,bufsize); + settextbuf(f,fbuf^,bufsize); + found:=0; + revs:=0; + skip:=false; + truncated:=false; + while not eof(t) do + begin + readln(t,s); + case found of + 0 : + begin + if pos('$Log: ',s)>0 then + found:=1; + skip:=false; + writeln(f,s); + end; + 1 : + begin + i:=pos('Revision',s); + if i>0 then + begin + inc(revs); + if revs>maxrevs then + begin + skip:=true; + truncated:=true; + found:=2; + end + else + begin + inc(i,10); + while (i<length(s)) and (s[i]<>' ') do + inc(i); + while (i<length(s)) and (s[i]=' ') do + inc(i); + if (i<length(s)) and (s[i] in ['0'..'9']) then + begin + Date2Int(Copy(s,i,10),year,month,day); + if (year<Myear) or + ((year=MYear) and (month<Mmonth)) or + ((year=MYear) and (month=Mmonth) and (day<Mday)) then + begin + skip:=true; + truncated:=true; + found:=2; +// write(year,'/',month,'/',day,' date'); + end; + end; + end; + end + else + if pos('}',s)>0 then + begin + skip:=false; + found:=0; + end; + if not skip then + writeln(f,s); + end; + 2 : + begin + if pos('}',s)>0 then + begin + skip:=false; + found:=0; + end; + if not skip then + writeln(f,s); + end; + end; + end; + close(t); + close(f); + if revs=0 then + writeln(' no log found') + else + if truncated then + writeln(revs-1,' revisions') + else + writeln(revs,' revisions'); + erase(t); + rename(f,fn); + freemem(tbuf); + freemem(fbuf); +end; + +var + dir : tsearchrec; + i : integer; + path : string; +begin + writeln('fixlog v1.01 (C) 1999-2002 Peter Vreman'); + if paramcount<3 then + begin + writeln('usage: fixlog <revisions> <yyyy-mm-dd> <files> [files]'); + halt(1); + end; + MaxRevs:=StrToInt(ParamStr(1)); + Date2Int(ParamStr(2),MYear,MMonth,MDay); + for i:=3 to paramcount do + begin + path:=ExtractFilePath(paramstr(i)); + if findfirst(paramstr(i),faAnyFile,dir)=0 then + repeat + dofile(path+dir.name); + until findnext(dir)<>0; + findclose(dir); + end; +end. diff --git a/closures/compiler/utils/fixmsg.pp b/closures/compiler/utils/fixmsg.pp new file mode 100644 index 0000000000..6bd1cfbe2c --- /dev/null +++ b/closures/compiler/utils/fixmsg.pp @@ -0,0 +1,66 @@ +type + trtabrec=record + name : string[12]; + idx : longint; + end; + +const + trtab : array[0..10] of trtabrec=( + (name:'general';idx:1000), + (name:'scan';idx:2000), + (name:'parser';idx:3000), + (name:'type';idx:4000), + (name:'sym';idx:5000), + (name:'cg';idx:6000), + (name:'asmr';idx:7000), + (name:'asmw';idx:8000), + (name:'exec';idx:9000), + (name:'unit';idx:10000), + (name:'option';idx:11000) + ); + +var + t,f : text; + s,hs : string; + i,j,k : longint; +begin + assign(t,paramstr(1)); + reset(t); + assign(f,'New.msg'); + rewrite(f); + while not eof(t) do + begin + readln(t,s); + if (s<>'') and not(s[1] in ['#','%']) then + begin + for i:=0 to 10 do + if Copy(s,1,length(trtab[i].name))=trtab[i].name then + begin + j:=pos('=',s); + if j>0 then + begin + inc(j); + if s[j] in ['0'..'9'] then + begin + k:=j; + while (s[k] in ['0'..'9']) do + inc(k); + if s[k]='_' then + inc(k); + delete(s,j,k-j); + end; + str(trtab[i].idx,hs); + while length(hs)<5 do + hs:='0'+hs; + hs:=hs+'_'; + inc(trtab[i].idx); + insert(hs,s,j); + end; + break; + end; + end; + writeln(f,s); + end; + close(f); + close(t); +end. diff --git a/closures/compiler/utils/fixnasm.pp b/closures/compiler/utils/fixnasm.pp new file mode 100644 index 0000000000..4dfe67f815 --- /dev/null +++ b/closures/compiler/utils/fixnasm.pp @@ -0,0 +1,76 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + Convert insns.dat from Nasm to an i386ins.dat for usage with + the Free pascal compiler + + 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. + + **********************************************************************} +program fixnasm; + +const + spaces=' '; +var + t,f : text; + para,bytes,flags, + opcode,lastop, + s : string; + i,j : longint; +begin + writeln('Fixing insns.dat -> i386ins.dat'); + assign(t,'insns.dat'); + reset(t); + assign(f,'insns.new'); + rewrite(f); + lastop:=''; + while not eof(t) do + begin + readln(t,s); + if (s<>'') and (s[1]<>';') then + begin + i:=pos(' ',s); + j:=pos(',',s); + if (j>0) and (j<i) then + opcode:=Copy(s,1,j-1) + else + opcode:=Copy(s,1,i-1); + if opcode<>lastop then + begin + writeln(f,''); + writeln(f,'[',Copy(s,1,i-1),']'); + writeln(f,'(Ch_All, Ch_None, Ch_None)'); + lastop:=opcode; + end; + while (i<length(s)) and (s[i+1]=' ') do + inc(i); + Delete(s,1,i); + i:=pos(' ',s); + para:=Copy(s,1,i-1); + para:=para+Copy(spaces,1,22-length(para)); + while (i<length(s)) and (s[i+1]=' ') do + inc(i); + Delete(s,1,i); + i:=pos(' ',s); + bytes:=Copy(s,1,i-1); + bytes:=bytes+Copy(spaces,1,32-length(bytes)); + while (i<length(s)) and (s[i+1]=' ') do + inc(i); + Delete(s,1,i); + i:=pos(' ',s); + if i=0 then + i:=255; + flags:=Copy(s,1,i-1); + writeln(f,para,bytes,flags); + end + else + writeln(f,s); + end; + close(f); + close(t); +end. diff --git a/closures/compiler/utils/fixtab.pp b/closures/compiler/utils/fixtab.pp new file mode 100644 index 0000000000..4e6c14f27c --- /dev/null +++ b/closures/compiler/utils/fixtab.pp @@ -0,0 +1,367 @@ +program FixTab; +uses Dos; + +const + {Files} + InputExt=''; + OutputExt='*'; + + +var +{General} + InFile, + OutFile : string[80]; + ParaFile : word; +{Specific} +const + TabSize : longint=8; + DosEol : boolean=false; + Verbose : boolean=false; + +{**************************************************************************** + Routines +****************************************************************************} + +const +{$IFDEF LINUX} + PathCh='/'; +{$ELSE} + PathCh='\'; +{$ENDIF} + +Function SplitPath(Const HStr:String):String; +var + i : byte; +begin + i:=Length(Hstr); + while (i>0) and (Hstr[i]<>PathCh) do + dec(i); + SplitPath:=Copy(Hstr,1,i); +end; + + + +Function SplitFileName(Const HStr:String):String; +var + i : byte; +begin + i:=Length(Hstr); + while (i>0) and (Hstr[i]<>PathCh) do + dec(i); + SplitFileName:=Copy(Hstr,i+1,255); +end; + + + +Function SplitName(Const HStr:String):String; +var + i,j : byte; +begin + i:=Length(Hstr); + j:=i; + while (i>0) and (Hstr[i]<>PathCh) do + dec(i); + while (j>0) and (Hstr[j]<>'.') do + dec(j); + if j<=i then + j:=255; + SplitName:=Copy(Hstr,i+1,j-(i+1)); +end; + + + +Function SplitExtension(Const HStr:String):String; +var + j,i : byte; +begin + i:=Length(Hstr); + j:=i; + while (i>0) and (Hstr[i]<>PathCh) do + dec(i); + while (j>0) and (Hstr[j]<>'.') do + dec(j); + if j<=i then + j:=254; + SplitExtension:=Copy(Hstr,j+1,255); +end; + + + +Function ChangeFileExt(Const HStr,ext:String):String; +begin + if (Ext<>'') and (SplitExtension(HStr)='') then + ChangeFileExt:=Hstr+'.'+Ext + else + ChangeFileExt:=Hstr; +end; + + + +Function ForceExtension(Const HStr,ext:String):String; +var + j : byte; +begin + j:=length(Hstr); + while (j>0) and (Hstr[j]<>'.') do + dec(j); + if j=0 then + j:=255; + ForceExtension:=Copy(Hstr,1,j-1)+'.'+Ext; +end; + + +function UCase(Const Hstr:string):string; +var + i : byte; +begin + for i:=1to Length(Hstr) do + UCase[i]:=Upcase(Hstr[i]); + UCase[0]:=chr(Length(Hstr)); +end; + + + +Function ESpace(HStr:String;len:byte):String; +begin + while length(Hstr)<Len do + begin + inc(byte(Hstr[0])); + Hstr[Length(Hstr)]:=' '; + end; + ESpace:=Hstr; +end; + +{**************************************************************************** + Main Stuff +****************************************************************************} + +var + Done : array[0..1023] of string[32]; + Total : word; +Function FileDone(const fn:string):boolean; +var + i : word; +begin + i:=0; + while (i<Total) and (Done[i]<>fn) do + inc(i); + if Done[i]=fn then + FileDone:=true + else + begin + Done[Total]:=fn; + inc(Total); + FileDone:=false; + end; +end; + + + +procedure Convert(fn,nfn:string); +type + inbuftype=array[0..31999] of char; + outbuftype=array[0..63999] of char; +var + f,g : file; + inbuf : ^inbuftype; + outbuf : ^outbuftype; + Curr, + TabCol, + col, + i,last, + innum, + outnum : longint; + + procedure WriteBuf; + begin + if i>last then + begin + move(InBuf^[last],OutBuf^[OutNum],i-last); + inc(OutNum,(i-last)); + end; + Last:=i+1; + end; + +begin +{Create New FileName} + if SplitExtension(nfn)='*' then + nfn:=ChangeFileExt(SplitPath(nfn)+SplitName(nfn),SplitExtension(fn)); + if SplitName(nfn)='*' then + begin + if SplitPath(nfn)='' then + nfn:=ChangeFileExt(SplitPath(fn)+SplitName(fn),SplitExtension(nfn)) + else + nfn:=ChangeFileExt(SplitPath(nfn)+SplitName(fn),SplitExtension(nfn)); + end; +{Done?} + if FileDone(nfn) then + exit; +{Open Files} + Write('Converting '+ESpace(fn,30)+' '); + if fn=nfn then + assign(g,ForceExtension(fn,'$T$')) + else + begin + Write('-> '+ESpace(nfn,30)+' '); + assign(g,nfn); + end; + new(inbuf); + new(outbuf); + assign(f,fn); + {$push}{$I-} + reset(f,1); + {$pop} + if ioresult<>0 then + exit; + {$push}{$I-} + rewrite(g,1); + {$pop} + if ioresult<>0 then + begin + close(f); + exit; + end; + Curr:=0; + col:=1; + last:=0; + repeat + blockread(f,InBuf^,sizeof(InBufType),innum); + outnum:=0; + if innum>0 then + begin + i:=0; + while (i<innum) do + begin + case InBuf^[i] of + #9 : begin + WriteBuf; + OutBuf^[OutNum]:=' '; + inc(OutNum); + inc(Col); + TabCol:=(((Col-1) div TabSize)+1)*TabSize; + while (Col<TabCol) do + begin + OutBuf^[OutNum]:=' '; + inc(OutNum); + inc(Col); + end; + end; + #13 : begin + WriteBuf; + while (outnum>0) and (outbuf^[outnum-1] in [' ',#9]) do + dec(outnum); + end; + #10 : begin + WriteBuf; + while (outnum>0) and (outbuf^[outnum-1] in [' ',#9]) do + dec(outnum); + if DosEol then + begin + OutBuf^[OutNum]:=#13; + inc(OutNum); + end; + OutBuf^[OutNum]:=#10; + inc(OutNum); + col:=0; + inc(Curr); + if (curr and 31)=0 then + Write(Curr:5,#8#8#8#8#8); + end; + else + inc(col); + end; + inc(i); + end; + WriteBuf; + last:=0; + end; + blockwrite(g,OutBuf^,outnum); + until innum=0; + WriteLn(Curr,' Lines'); + close(g); + close(f); + if fn=nfn then + begin + erase(f); + rename(g,fn); + end; + dispose(outbuf); + dispose(inbuf); +end; + + +{**************************************************************************** + General Stuff +****************************************************************************} + +procedure getpara; +var + ch : char; + para : string[128]; + i,j : word; + + procedure helpscreen; + begin + writeln('Usage : '+SplitName(ParamStr(0))+' [Options] <InFile(s)>'#10); + writeln('<Options> can be : -O<OutFile> Specify OutFile Mask'); + WriteLn(' -D Use MsDos #13#10 Eols'); + writeln(' -T<size> Set Size of Tabs'); + writeln(' -V be more verbose'); + writeln(' -? or -H This HelpScreen'); + halt(1); + end; + +begin + for i:=1to paramcount do + begin + para:=ucase(paramstr(i)); + if (para[1]='-') then + begin + ch:=para[2]; + delete(para,1,2); + case ch of + 'O' : OutFile:=ChangeFileExt(Para,OutputExt); + 'D' : DosEol:=true; + 'T' : Val(Para,TabSize,j); + 'V' : verbose:=true; + '?','H' : helpscreen; + end; + end + else + begin + if ParaFile=0 then + ParaFile:=i; + end; + end; + if (ParaFile=0) then + HelpScreen; + if OutFile='' then + OutFile:=ForceExtension('*',OutPutExt); +end; + + + +var + Dir : SearchRec; + i : word; +begin + GetPara; +{Main} + if Verbose then + begin + Writeln('fixtab v1.01 (C) 1999-2002 Peter Vreman'); + Writeln('TabSize ',TabSize); + if DosEol then + WriteLn('Using MsDos Eols'); + end; + for i:=ParaFile to ParamCount do + begin + InFile:=ChangeFileExt(ParamStr(i),InputExt); + FindFirst(InFile,$20,Dir); + while (DosError=0) do + begin + Convert(SplitPath(InFile)+Dir.Name,OutFile); + FindNext(Dir); + end; + end; +end. diff --git a/closures/compiler/utils/fpc.mpw b/closures/compiler/utils/fpc.mpw new file mode 100644 index 0000000000..8ae99a7ee6 --- /dev/null +++ b/closures/compiler/utils/fpc.mpw @@ -0,0 +1,2 @@ +# MPW script which mimics the fpc wrapper application +ppcppc {Parameters} diff --git a/closures/compiler/utils/fpc.pp b/closures/compiler/utils/fpc.pp new file mode 100644 index 0000000000..c214262f10 --- /dev/null +++ b/closures/compiler/utils/fpc.pp @@ -0,0 +1,267 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + This file is the "loader" for the Free Pascal 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. + + ****************************************************************************} +program fpc; + +{$mode objfpc}{$H+} + + uses + Sysutils; + + const +{$ifdef UNIX} + exeext=''; +{$else UNIX} + {$ifdef AMIGA} + exeext=''; + {$else} + {$ifdef MORPHOS} + exeext=''; + {$else} + {$ifdef NETWARE} + exeext='.nlm'; + {$else} + exeext='.exe'; + {$endif NETWARE} + {$endif MORPHOS} + {$endif AMIGA} +{$endif UNIX} + + + procedure error(const s : string); + begin + writeln('Error: ',s); + halt(1); + end; + + + function SplitPath(Const HStr:String):String; + var + i : longint; + begin + i:=Length(Hstr); + while (i>0) and not(Hstr[i] in ['\','/']) do + dec(i); + SplitPath:=Copy(Hstr,1,i); + end; + + + function FileExists ( Const F : String) : Boolean; + var + Info : TSearchRec; + begin + FileExists:= findfirst(F,fareadonly+faarchive+fahidden,info)=0; + findclose(Info); + end; + + var + extrapath : ansistring; + + function findexe(var ppcbin:string): boolean; + var + path : string; + begin + { add .exe extension } + findexe:=false; + ppcbin:=ppcbin+exeext; + + if (extrapath<>'') and (extrapath[length(extrapath)]<>DirectorySeparator) then + extrapath:=extrapath+DirectorySeparator; + { get path of fpc.exe } + path:=splitpath(paramstr(0)); + { don't try with an empty extra patch, this might have strange results + if the current directory contains a compiler + } + if (extrapath<>'') and FileExists(extrapath+ppcbin) then + begin + ppcbin:=extrapath+ppcbin; + findexe:=true; + end + else if FileExists(path+ppcbin) then + begin + ppcbin:=path+ppcbin; + findexe:=true; + end + else + begin + path:=ExeSearch(ppcbin,getenvironmentvariable('PATH')); + if path<>'' then + begin + ppcbin:=path; + findexe:=true; + end + end; + end; + + var + s : ansistring; + cpusuffix, + processorname, + ppcbin, + versionStr, + processorstr : string; + ppccommandline : array of ansistring; + ppccommandlinelen : longint; + i : longint; + errorvalue : Longint; + begin + setlength(ppccommandline,paramcount); + ppccommandlinelen:=0; + cpusuffix :=''; // if not empty, signals attempt at cross + // compiler. + extrapath :=''; +{$ifdef i386} + ppcbin:='ppc386'; + processorname:='i386'; +{$endif i386} +{$ifdef m68k} + ppcbin:='ppc68k'; + processorname:='m68k'; +{$endif m68k} +{$ifdef alpha} + ppcbin:='ppcapx'; + processorname:='alpha'; +{$endif alpha} +{$ifdef powerpc} + ppcbin:='ppcppc'; + processorname:='powerpc'; +{$endif powerpc} +{$ifdef powerpc64} + ppcbin:='ppcppc64'; + processorname:='powerpc64'; +{$endif powerpc64} +{$ifdef arm} + ppcbin:='ppcarm'; + processorname:='arm'; +{$endif arm} +{$ifdef sparc} + ppcbin:='ppcsparc'; + processorname:='sparc'; +{$endif sparc} +{$ifdef x86_64} + ppcbin:='ppcx64'; + processorname:='x86_64'; +{$endif x86_64} +{$ifdef ia64} + ppcbin:='ppcia64'; + processorname:='ia64'; +{$endif ia64} + versionstr:=''; { Default is just the name } + for i:=1 to paramcount do + begin + s:=paramstr(i); + if pos('-V',s)=1 then + versionstr:=copy(s,3,length(s)-2) + else + begin + if pos('-P',s)=1 then + begin + processorstr:=copy(s,3,length(s)-2); + { -PB is a special code that will show the + default compiler and exit immediatly. It's + main usage is for Makefile } + if processorstr='B' then + begin + { report the full name of the ppcbin } + findexe(ppcbin); + writeln(ppcbin); + halt(0); + end + { -PP is a special code that will show the + processor and exit immediatly. It's + main usage is for Makefile } + else if processorstr='P' then + begin + { report the processor } + writeln(processorname); + halt(0); + end + else + if processorstr <> processorname then + begin + if processorstr='i386' then + cpusuffix:='386' + else if processorstr='m68k' then + cpusuffix:='68k' + else if processorstr='alpha' then + cpusuffix:='apx' + else if processorstr='powerpc' then + cpusuffix:='ppc' + else if processorstr='powerpc64' then + cpusuffix:='ppc64' + else if processorstr='arm' then + cpusuffix:='arm' + else if processorstr='sparc' then + cpusuffix:='sparc' + else if processorstr='ia64' then + cpusuffix:='ia64' + else if processorstr='x86_64' then + cpusuffix:='x64' + else + error('Illegal processor type "'+processorstr+'"'); + +{$ifndef darwin} + ppcbin:='ppcross'+cpusuffix; +{$else not darwin} + { the mach-o format supports "fat" binaries whereby } + { a single executable contains machine code for } + { several architectures -> it is counter-intuitive } + { and non-standard to use different binary names } + { for cross-compilers vs. native compilers } + ppcbin:='ppc'+cpusuffix; +{$endif not darwin} + end; + end + else if pos('-Xp',s)=1 then + extrapath:=copy(s,4,length(s)-3) + else + begin + ppccommandline[ppccommandlinelen]:=s; + inc(ppccommandlinelen); + end; + end; + end; + SetLength(ppccommandline,ppccommandlinelen); + + if versionstr<>'' then + ppcbin:=ppcbin+'-'+versionstr; + { find the full path to the specified exe } + if not findexe(ppcbin) then + begin + if cpusuffix<>'' Then + begin + ppcbin:='ppc'+cpusuffix; + if versionstr<>'' then + ppcbin:=ppcbin+'-'+versionstr; + findexe(ppcbin); + end; + end; + + { call ppcXXX } + try + errorvalue:=ExecuteProcess(ppcbin,ppccommandline); + except + on e : exception do + error(ppcbin+' can''t be executed, error message: '+e.message); + end; + if errorvalue<>0 then + error(ppcbin+' returned an error exitcode (normal if you did not specify a source file to be compiled)'); + halt(errorvalue); + end. diff --git a/closures/compiler/utils/fpcsubst.pp b/closures/compiler/utils/fpcsubst.pp new file mode 100644 index 0000000000..df4456c6ef --- /dev/null +++ b/closures/compiler/utils/fpcsubst.pp @@ -0,0 +1,243 @@ +{$Mode objfpc} +{$H+} +program fpcsubst; + +uses SysUtils,Classes,Usubst; + +Const + BuildVersion={$I %FPCVERSION%}; + BuildTarget={$I %FPCTARGET%}; + +Resourcestring + SUsage00 = 'Usage: %s [options]'; + SUsage10 = 'Where options is one or more of'; + SUSage20 = ' -i filename Set input file. Default is standard input'; + SUSage30 = ' -o filename Set output file. Default is standard output.'; + SUsage40 = ' -d name=value define name=value pair.'; + SUsage50 = ' -h show this help and exit.'; + SUsage60 = ' -u name remove name from list of name/value pairs.'; + SUsage70 = ' -l filename read name/value pairs from filename'; + SUsage80 = ' -b show builtin list and exit.'; + SUsage90 = ' -v be verbose.'; + SErrUnknownOption = 'Error: Unknown option.'; + SErrArgExpected = 'Error: Option "%s" requires an argument.'; + SErrNoSuchFile = 'Error: File "%s" does not exist.'; + SErrBackupFailed = 'Error: Backup of file "%s" to "%s" failed.'; + SErrDelBackupFailed = 'Error: Delete of old backup file "%s" failed.'; + SWarnIgnoringFile = 'Warning: Ignoring non-existent file: '; + SWarnIgnoringPair = 'Warning: ignoring wrong name/value pair: '; + SStats = 'Replaced %d placeholders in %d lines.'; + SSubstInLine = 'Replaced %s placeholders in line %d.'; + SWarningDeprecated = 'Warning: This utility is deprecated and will be removed from fpc in the future. Please use fpcmkcfg instead.'; + + +Var + List : TStringList; + InputFileName : String; + OutputFileName : String; + Verbose : Boolean; + SkipBackup : Boolean; + + + + + +procedure Init; + +begin + Verbose:=False; + List:=TStringList.Create; + AddToList(List,'FPCVERSION',BuildVersion); + AddToList(List,'FPCTARGET',BuildTarget); + AddToList(List,'PWD',GetCurrentDir); + AddToList(List,'BUILDDATE',DateToStr(Date)); + AddToList(List,'BUILDTIME',TimeToStr(Time)); +end; + +Procedure Done; + +begin + FreeAndNil(List); +end; + +Procedure Usage; + +begin + Writeln(Format(SUsage00,[ExtractFileName(Paramstr(0))])); + Writeln(SUsage10); + Writeln(SUsage20); + Writeln(SUsage30); + Writeln(SUsage40); + Writeln(SUsage50); + Writeln(SUsage60); + Writeln(SUsage70); + Writeln(SUsage80); + Writeln(SUsage90); + Halt(1); +end; + +Procedure ShowBuiltIns; + +var + I : Integer; + +begin + for I:=0 to List.Count-1 do + Writeln(List[i]); +end; + + + + +Procedure AddFromFile(FN : String); + +Var + F : Text; + S : String; + +begin + If Not FileExists(FN) then + begin + Writeln(StdErr,SWarnIgnoringFile,FN); + Exit; + end; + Assign(F,FN); + Reset(F); + Try + While not EOF(F) do + begin + ReadLn(F,S); + If (Length(S)>0) and (not (S[1] in ['#',';'])) then + If not AddPair(List,S) then + If Verbose then + Writeln(StdErr,SWarnIgnoringPair,S) + end; + finally + Close(F); + end; +end; + +Procedure UnknownOption(Const S : String); + +begin + Writeln(SErrUnknownOption,S); + Usage; +end; + +Procedure ProcessCommandline; + +Var + I : Integer; + S : String; + + Function GetOptArg : String; + + begin + If I=ParamCount then + begin + Writeln(StdErr,Format(SErrArgExpected,[S])); + Halt(1); + end; + inc(I); + Result:=ParamStr(I); + end; + +begin + I:=1; + While( I<=ParamCount) do + begin + S:=Paramstr(i); + If (Length(S)<=1) or (S[1]<>'-') then + UnknownOption(S) + else + case S[2] of + 'v' : Verbose:=True; + 'h' : Usage; + 'b' : begin + ShowBuiltins; + halt(0); + end; + 'l' : AddFromFile(GetOptArg); + 'd' : AddPair(List,GetOptArg); + 'u' : AddPair(List,GetOptArg+'='); + 'i' : InputFileName:=GetOptArg; + 'o' : OutputFileName:=GetoptArg; + 's' : SkipBackup:=True; + else + UnknownOption(S); + end; + Inc(I); + end; +end; + + + +Procedure DoFile; + +Var + Fin,Fout : Text; + S,BFN : String; + N,LCount,RCount : Integer; + + +begin + If (InputFileName<>'') and not FileExists(InputFIleName) then + begin + Writeln(StdErr,Format(SErrNoSuchFile,[InputFileName])); + Halt(1) + end; + If (OutputFileName<>'') + and FileExists(OutputFileName) + and not SkipBackup then + begin + BFN:=ChangeFileExt(OutputFileName,'.bak'); + If FileExists(BFN) and not DeleteFile(BFN) then + begin + Writeln(StdErr,Format(SErrDelBackupFailed,[BFN])); + Halt(1); + end; + If not RenameFile(OutputFileName,BFN) then + begin + Writeln(StdErr,Format(SErrBackupFailed,[OutputFileName,BFN])); + Halt(1); + end; + end; + Assign(Fin,InputFileName); + Assign(Fout,OutputFileName); + Reset(Fin); + Try + Rewrite(FOut); + Try + LCount:=0; + RCount:=0; + While Not EOF(Fin) do + begin + Inc(LCount); + ReadLn(Fin,S); + N:=DoSubstitutions(List,S); + If Verbose and (N>0) then + Writeln(StdErr,Format(SSubstInLine,[N,LCount])); + Inc(RCount,N); + Writeln(Fout,S); + end; + If Verbose then + Writeln(StdErr,Format(SStats,[RCount,LCount])); + Finally + Close(Fout); + end; + Finally + Close(Fin); + end; + +end; + +begin + WriteLn(StdErr,SWarningDeprecated); + Init; + Try + ProcessCommandLine; + DoFile; + Finally + Done; + end; +end. diff --git a/closures/compiler/utils/fpimpdef.pp b/closures/compiler/utils/fpimpdef.pp new file mode 100644 index 0000000000..c5ad40bfd8 --- /dev/null +++ b/closures/compiler/utils/fpimpdef.pp @@ -0,0 +1,92 @@ +{$APPTYPE CONSOLE} +program FPimpdef; +{$DEFINE STANDALONE} +uses + DOS, + ImpDef; +var +binname:string; +function Ofound(const short,full:string):longint; +var + i:longint; +begin + Ofound:=-1; + for i:=1 to ParamCount do + if(paramstr(i)=short)or(paramstr(i)=full)then + begin + Ofound:=i; + exit; + end; +end; +function GetOption(const short,full:string):string; +var + i:longint; +begin + i:=Ofound(short,full); + if i>0 then + GetOption:=paramstr(succ(i)) + else + GetOption:=''; +end; +procedure help_info; +var + fn:string[255]; + jj:cardinal; +begin + fn:=paramstr(0); + for jj:=length(fn)downto 1 do + if fn[jj] in [':','\','/']then + begin + fn:=copy(fn,succ(jj),255); + break; + end; + writeln('Usage: ',fn,' [options]'); + writeln('Options:'); + writeln('-i | --input <file> - set input file;'); + writeln('-o | --output <file> - set output .def file'); + writeln('-l | --library <file> - set output static library'); + writeln('-s | --assembler <name> - use <name> for assembler (default asw)'); + writeln('-r | --archiver <name> - use <name> for archiver (default arw)'); + writeln('-h | --help - show this screen'); + halt; +end; +{$ifndef UNIX} +procedure AddExt(var s:string); + var + s1:string; + i:longint; + begin + s1:=copy(s,length(s)-3,4); + for i:=1 to length(s1)do + s1[i]:=upcase(s1[i]); + if s1<>'.EXE'then + s:=s+'.EXE'; + end; +{$endif} +var + EnvPath:string; +begin +binname:=GetOption('-i','--input'); +if(binname='')or(Ofound('-h','--help')>0)then + help_info; + as_name:=GetOption('-s','--assembler'); + if as_name='' then + as_name:='as'; + ar_name:=GetOption('-r','--archiver'); + if ar_name='' then + ar_name:='ar'; +{$ifndef UNIX} + AddExt(as_name); + AddExt(ar_name); +{$endif} + EnvPath:=GetEnv('Path'); + if EnvPath='' then + EnvPath:=GetEnv('PATH'); + as_name:=FSearch(as_name,EnvPath); + ar_name:=FSearch(ar_name,EnvPath); +if not makedef(binname,GetOption('-o','--output'),GetOption('-l','--library'))then + begin + writeln('Export names not found'); + halt(1); + end; +end. diff --git a/closures/compiler/utils/gia64reg.pp b/closures/compiler/utils/gia64reg.pp new file mode 100644 index 0000000000..1f84bb36b5 --- /dev/null +++ b/closures/compiler/utils/gia64reg.pp @@ -0,0 +1,14 @@ +{ generates iA-64 register dat templates } + +uses + sysutils; +var + i : longint; +begin + { generate int registers } + for i:=0 to 127 do + writeln(format('R%d,$01,%d,r%d,r%d',[i,i,i,i])); + { generate fp registers } + for i:=0 to 127 do + writeln(format('F%d,$02,%d,r%d,r%d',[i,i,i,i])); +end. diff --git a/closures/compiler/utils/gppc386.pp b/closures/compiler/utils/gppc386.pp new file mode 100644 index 0000000000..380012822d --- /dev/null +++ b/closures/compiler/utils/gppc386.pp @@ -0,0 +1,195 @@ +{ + Copyright (c) 2000-2002 by Pierre Muller + + This program allows to run the Makefiles + with the compiler running inside GDB + + GDB only stops if there is something special + + 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. + + ****************************************************************************} + +program fpc_with_gdb; + +{ + This program uses several files : + + -- 'gdb4fpc.ini' contains the standard breakpoints (see below) + + -- 'gdb.fpc' is an optional file that can contain any other + instruction that GDB should do before starting. + Note that if gdb.fpc is present, no "run" command is + inserted if gdb4fpc.ini is found + but it can be inserted in gdb.fpc itself. + + Use EXTDEBUG conditional to get debug information. +} + +uses + dos; + +const +{$ifdef Unix} + GDBExeName : String = 'gdbpas'; + GDBAltExeName = 'gdb'; + GDBIniName = '.gdbinit'; + DefaultCompilerName = 'ppc386'; + PathSep=':'; + DirSep = '/'; +{$else} + GDBExeName : String = 'gdbpas.exe'; + GDBAltExeName = 'gdb.exe'; + GDBIniName = 'gdb.ini'; + DefaultCompilerName = 'ppc386.exe'; + PathSep=';'; + DirSep = '\'; +{$endif not linux} + + { If you add a gdb.fpc file in a given directory } + { GDB will read it; this allows you to add } + { special tests in specific directories PM } + FpcGDBIniName = 'gdb.fpc'; + GDBIniTempName : string = 'gdb4fpc.ini'; + + +{ Dos/Windows GDB still need forward slashes } +procedure AdaptToGDB(var filename : string); +var + i : longint; +begin + for i:=1 to length(filename) do + if filename[i]='\' then + filename[i]:='/'; +end; + +var + fpcgdbini : text; + CompilerName,Dir,Name,Ext : String; + GDBError,GDBExitCode,i : longint; + +begin + + fsplit(paramstr(0),Dir,Name,Ext); + if (length(Name)>3) and (UpCase(Name[1])='G') then + CompilerName:=Copy(Name,2,255)+Ext + else + CompilerName:=DefaultCompilerName; + + CompilerName:=fsearch(CompilerName,Dir+PathSep+GetEnv('PATH')); + + { support for info functions directly : used in makefiles } + if (paramcount=1) and (pos('-i',Paramstr(1))=1) then + begin + Exec(CompilerName,Paramstr(1)); + exit; + end; + + {$ifdef EXTDEBUG} + writeln(stderr,'Using compiler "',CompilerName,'"'); + flush(stderr); + {$endif} + if fsearch(GDBIniTempName,'.')<>'' then + begin + Assign(fpcgdbini,GDBIniTempName); + {$ifdef EXTDEBUG} + writeln(stderr,'Erasing file "',GDBIniTempName,'"'); + flush(stderr); + {$endif} + erase(fpcgdbini); + end; + GDBIniTempName:=fexpand('.'+DirSep+GDBIniTempName); + Assign(fpcgdbini,GdbIniTempName); + {$ifdef EXTDEBUG} + writeln(stderr,'Creating file "',GDBIniTempName,'"'); + flush(stderr); + {$endif} + Rewrite(fpcgdbini); + + Writeln(fpcgdbini,'set language pascal'); + Write(fpcgdbini,'set args'); + + { this will not work correctly if there are " or '' inside the command line :( } + for i:=1 to Paramcount do + begin + if pos(' ',Paramstr(i))>0 then + Write(fpcgdbini,' "'+ParamStr(i)+'"') + else + Write(fpcgdbini,' '+ParamStr(i)); + end; + Writeln(fpcgdbini); + Writeln(fpcgdbini,'b SYSTEM_EXIT'); + Writeln(fpcgdbini,'cond 1 EXITCODE <> 0'); + Writeln(fpcgdbini,'set $_exitcode := -1'); + { b INTERNALERROR sometimes fails ... Don't know why. PM 2010-08-28 } + Writeln(fpcgdbini,'info fun INTERNALERROR'); + Writeln(fpcgdbini,'b INTERNALERROR'); + Writeln(fpcgdbini,'b HANDLEERRORADDRFRAME'); + { This one will fail unless sysutils unit is also loaded } + Writeln(fpcgdbini,'b RUNERRORTOEXCEPT'); + if fsearch(FpcGDBIniName,'./')<>'' then + begin + Writeln(fpcgdbini,'source '+FpcGDBIniName); + end + else + Writeln(fpcgdbini,'run'); + Writeln(fpcgdbini,'if ($_exitcode = -1)'); + Writeln(fpcgdbini,' echo Program not completed'); + Writeln(fpcgdbini,'else'); + Writeln(fpcgdbini,' quit'); + Writeln(fpcgdbini,'end'); + Close(fpcgdbini); + {$ifdef EXTDEBUG} + writeln(stderr,'Closing file "',GDBIniTempName,'"'); + flush(stderr); + {$endif} + + GDBExeName:=fsearch(GDBExeName,Dir+PathSep+GetEnv('PATH')); + if GDBExeName='' then + GDBExeName:=fsearch(GDBAltExeName,Dir+PathSep+GetEnv('PATH')); + + AdaptToGDB(CompilerName); + AdaptToGDB(GDBIniTempName); + {$ifdef EXTDEBUG} + Writeln(stderr,'Starting ',GDBExeName, +{$ifdef win32} + '--nw '+ +{$endif win32} + '--nx --command='+GDBIniTempName+' '+CompilerName); + flush(stderr); + {$endif} + DosError:=0; + Exec(GDBExeName, +{$ifdef win32} + '--nw '+ +{$endif win32} + '--nx --command='+GDBIniTempName+' '+CompilerName); + GDBError:=DosError; + GDBExitCode:=DosExitCode; + if (GDBError<>0) or (GDBExitCode<>0) then + begin + Writeln('Error running GDB'); + if (GDBError<>0) then + Writeln('DosError = ',GDBError); + if (GDBExitCode<>0) then + Writeln('DosExitCode = ',GDBExitCode); + if GDBExitCode<>0 then + RunError(GDBExitCode) + else + RunError(GDBError); + end + else + Erase(fpcgdbini); +end. diff --git a/closures/compiler/utils/mk68kreg.pp b/closures/compiler/utils/mk68kreg.pp new file mode 100644 index 0000000000..20538decdd --- /dev/null +++ b/closures/compiler/utils/mk68kreg.pp @@ -0,0 +1,308 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman and Florian Klaempfl + + Convert spreg.dat to several .inc files for usage with + the Free pascal compiler + + 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. + + **********************************************************************} +{$mode objfpc} +program mkspreg; + +const Version = '1.00'; + max_regcount = 200; + +var s : string; + i : longint; + line : longint; + regcount:byte; + regcount_bsstart:byte; + names, + regtypes, + supregs, + numbers, + stdnames, + gasnames, + stabs : array[0..max_regcount-1] of string[63]; + regnumber_index, + std_regname_index,gas_regname_index : array[0..max_regcount-1] of byte; + +function tostr(l : longint) : string; + +begin + str(l,tostr); +end; + +function readstr : string; + + begin + result:=''; + while (s[i]<>',') and (i<=length(s)) do + begin + result:=result+s[i]; + inc(i); + end; + end; + + +procedure readcomma; + begin + if s[i]<>',' then + begin + writeln('Missing "," at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(i); + end; + + +procedure skipspace; + + begin + while (s[i] in [' ',#9]) do + inc(i); + end; + +procedure openinc(out f:text;const fn:string); +begin + writeln('creating ',fn); + assign(f,fn); + rewrite(f); + writeln(f,'{ don''t edit, this file is generated from m68kreg.dat }'); +end; + + +procedure closeinc(var f:text); +begin + writeln(f); + close(f); +end; + +procedure build_regnum_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + regnumber_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if numbers[regnumber_index[j]]>=numbers[regnumber_index[i]] then + break; + t:=regnumber_index[i]; + regnumber_index[i]:=regnumber_index[j]; + regnumber_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_std_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + std_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if stdnames[std_regname_index[j]]>=stdnames[std_regname_index[i]] then + break; + t:=std_regname_index[i]; + std_regname_index[i]:=std_regname_index[j]; + std_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_gas_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + gas_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if gasnames[gas_regname_index[j]]>=gasnames[gas_regname_index[i]] then + break; + t:=gas_regname_index[i]; + gas_regname_index[i]:=gas_regname_index[j]; + gas_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure read_spreg_file; + +var infile:text; + +begin + { open dat file } + assign(infile,'m68kreg.dat'); + reset(infile); + while not(eof(infile)) do + begin + { handle comment } + readln(infile,s); + inc(line); + while (s[1]=' ') do + delete(s,1,1); + if (s='') or (s[1]=';') then + continue; + + i:=1; + names[regcount]:=readstr; + readcomma; + regtypes[regcount]:=readstr; + readcomma; + supregs[regcount]:=readstr; + readcomma; + stdnames[regcount]:=readstr; + readcomma; + gasnames[regcount]:=readstr; + readcomma; + stabs[regcount]:=readstr; + { Create register number } + if supregs[regcount][1]<>'$' then + begin + writeln('Missing $ before number, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + numbers[regcount]:=regtypes[regcount]+'0000'+copy(supregs[regcount],2,255); + if i<length(s) then + begin + writeln('Extra chars at end of line, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(regcount); + if regcount>max_regcount then + begin + writeln('Error: Too much registers, please increase maxregcount in source'); + halt(2); + end; + end; + close(infile); +end; + +procedure write_inc_files; + +var + norfile,stdfile,gasfile,supfile, + numfile,stabfile,confile, + rnifile,srifile,grifile:text; + first:boolean; + +begin + { create inc files } + openinc(confile,'r68kcon.inc'); + openinc(supfile,'r68ksup.inc'); + openinc(numfile,'r68knum.inc'); + openinc(stdfile,'r68kstd.inc'); + openinc(gasfile,'r68kgas.inc'); + openinc(stabfile,'r68ksta.inc'); + openinc(norfile,'r68knor.inc'); + openinc(rnifile,'r68krni.inc'); + openinc(srifile,'r68ksri.inc'); + openinc(grifile,'r68kgri.inc'); + first:=true; + for i:=0 to regcount-1 do + begin + if not first then + begin + writeln(numfile,','); + writeln(stdfile,','); + writeln(gasfile,','); + writeln(stabfile,','); + writeln(rnifile,','); + writeln(srifile,','); + writeln(grifile,','); + end + else + first:=false; + writeln(supfile,'RS_',names[i],' = ',supregs[i],';'); + writeln(confile,'NR_'+names[i],' = ','tregister(',numbers[i],')',';'); + write(numfile,'tregister(',numbers[i],')'); + write(stdfile,'''',stdnames[i],''''); + write(gasfile,'''',gasnames[i],''''); + write(stabfile,stabs[i]); + write(rnifile,regnumber_index[i]); + write(srifile,std_regname_index[i]); + write(grifile,gas_regname_index[i]); + end; + write(norfile,regcount); + close(confile); + close(supfile); + closeinc(numfile); + closeinc(stdfile); + closeinc(gasfile); + closeinc(stabfile); + closeinc(norfile); + closeinc(rnifile); + closeinc(srifile); + closeinc(grifile); + writeln('Done!'); + writeln(regcount,' registers procesed'); +end; + + +begin + writeln('Register Table Converter Version ',Version); + line:=0; + regcount:=0; + read_spreg_file; + regcount_bsstart:=1; + while 2*regcount_bsstart<regcount do + regcount_bsstart:=regcount_bsstart*2; + build_regnum_index; + build_std_regname_index; + build_gas_regname_index; + write_inc_files; +end. diff --git a/closures/compiler/utils/mkarmins.pp b/closures/compiler/utils/mkarmins.pp new file mode 100644 index 0000000000..a9fd0a4c57 --- /dev/null +++ b/closures/compiler/utils/mkarmins.pp @@ -0,0 +1,404 @@ +{ + Copyright (c) 1998-2005 by Peter Vreman and Florian Klaempfl + + Convert i386ins.dat from Nasm to a .inc file for usage with + the Free pascal compiler + + 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. + + **********************************************************************} +{$mode objfpc} + +program mkarmins; + +const + Version = '0.9'; + +var + s : string; + i : longint; + + function lower(const s : string) : string; + { + return lowercased string of s + } + var + i : longint; + begin + for i:=1 to length(s) do + if s[i] in ['A'..'Z'] then + lower[i]:=char(byte(s[i])+32) + else + lower[i]:=s[i]; + lower[0]:=s[0]; + end; + + function Replace(var s:string;const s1,s2:string):boolean; + var + i : longint; + begin + i:=pos(s1,s); + if i>0 then + begin + Delete(s,i,length(s1)); + Insert(s2,s,i); + Replace:=true; + end + else + Replace:=false; + end; + + +function formatop(s:string):string; + const + replaces=19; + replacetab : array[1..replaces,1..2] of string[32]=( + (':',' or ot_colon'), + ('mem8','mem or ot_bits8'), + ('mem16','mem or ot_bits16'), + ('mem32','mem or ot_bits32'), + ('mem64','mem or ot_bits64'), + ('mem80','mem or ot_bits80'), + ('mem','memory'), + ('memory_offs','mem_offs'), + ('imm8','imm or ot_bits8'), + ('imm16','imm or ot_bits16'), + ('imm32','imm or ot_bits32'), + ('imm64','imm or ot_bits64'), + ('imm80','imm or ot_bits80'), + ('imm','immediate'), + ('rm8','regmem or ot_bits8'), + ('rm16','regmem or ot_bits16'), + ('rm32','regmem or ot_bits32'), + ('rm64','regmem or ot_bits64'), + ('rm80','regmem or ot_bits80') + ); + var + i : longint; + begin + for i:=1to replaces do + replace(s,replacetab[i,1],replacetab[i,2]); + formatop:=s; + end; + + +function readnumber : longint; + + var + base : longint; + + begin + result:=0; + if s[i]='\' then + begin + base:=8; + inc(i); + if s[i]='x' then + begin + base:=16; + inc(i); + end; + end + else + base:=10; + s[i]:=upcase(s[i]); + while s[i] in ['0'..'9','A'..'F'] do + begin + case s[i] of + '0'..'9': + result:=result*base+ord(s[i])-ord('0'); + + 'A'..'F': + result:=result*base+ord(s[i])-ord('A')+10; + end; + inc(i); + end; + end; + +function tostr(l : longint) : string; + + var + hs : string; + + begin + str(l,hs); + tostr:=hs; + end; + +function readstr : string; + + begin + result:=''; + while (s[i] in ['0'..'9','A'..'Z','a'..'z','_']) and (i<=length(s)) do + begin + result:=result+s[i]; + inc(i); + end; + end; + +procedure skipspace; + + begin + while (s[i] in [' ',#9]) do + inc(i); + end; + +procedure openinc(out f:text;const fn:string); +begin + writeln('creating ',fn); + assign(f,fn); + rewrite(f); + writeln(f,'{ don''t edit, this file is generated from armins.dat }'); + writeln(f,'('); +end; + + +procedure closeinc(var f:text); +begin + writeln(f); + writeln(f,');'); + close(f); +end; + + +var + attsuffix, + hs : string; + j : longint; + firstopcode, + first : boolean; + maxinfolen, + code : byte; + insns : longint; + attsuffile,{propfile,}opfile, + nopfile,attfile, + infile,insfile : text; + { instruction fields } + skip : boolean; + {last,} + ops : longint; + attopcode, + opcode, + codes, + flags : string; + optypes : array[1..4] of string; +begin + writeln('Narm Instruction Table Converter Version ',Version); + insns:=0; + maxinfolen:=0; + { open dat file } + assign(infile,'../arm/armins.dat'); + { create inc files } + openinc(insfile,'armtab.inc'); + openinc(opfile,'armop.inc'); + assign(nopfile,'armnop.inc'); + openinc(attfile,'armatt.inc'); + openinc(attsuffile,'armatts.inc'); + { + openinc(intfile,'i386int.inc'); + openinc(propfile,'i386prop.inc'); + } + rewrite(nopfile); + writeln(nopfile,'{ don''t edit, this file is generated from armins.dat }'); + reset(infile); + first:=true; + opcode:=''; + firstopcode:=true; + while not(eof(infile)) do + begin + { handle comment } + readln(infile,s); + while (s[1]=' ') do + delete(s,1,1); + if (s='') or (s[1]=';') then + continue; + if (s[1]='[') then + begin + i:=pos(',',s); + j:=pos(']',s); + if i=0 then + begin + opcode:='A_'+Copy(s,2,j-2); + attopcode:=Copy(s,2,j-2); + { Conditional } + if (attopcode[length(attopcode)]='c') and + (attopcode[length(attopcode)-1]='c') then + begin + dec(byte(attopcode[0]),2); + dec(byte(opcode[0]),2); + end; + attsuffix:='attsufNONE'; + end + else + begin + opcode:='A_'+Copy(s,2,i-2); + { intel conditional } + if (opcode[length(attopcode)]='c') and + (opcode[length(attopcode)-1]='c') then + dec(byte(opcode[0]),2); + attopcode:=Copy(s,i+1,j-i-1); + { att Suffix } + case attopcode[length(attopcode)] of + 'X' : + begin + dec(attopcode[0]); + attsuffix:='attsufINT'; + end; + 'F' : + begin + dec(attopcode[0]); + attsuffix:='attsufFPU'; + end; + 'R' : + begin + dec(attopcode[0]); + attsuffix:='attsufFPUint'; + end; + else + attsuffix:='attsufNONE'; + end; + { att Conditional } + if (attopcode[length(attopcode)]='C') and + (attopcode[length(attopcode)-1]='C') then + dec(byte(attopcode[0]),2); + end; + attopcode:=Lower(attopcode); + if firstopcode then + firstopcode:=false + else + begin + writeln(opfile,','); + writeln(attfile,','); + writeln(attsuffile,','); +{ writeln(propfile,','); } + end; + write(opfile,opcode); + write(attfile,'''',attopcode,''''); + write(attsuffile,attsuffix); + { read the next line which contains the Change options } + { + repeat + readln(infile,s); + until eof(infile) or ((s<>'') and (s[1]<>';')); + write(propfile,'(Ch: ',s,')'); + } + continue; + end; + { we must have an opcode } + if opcode='' then + runerror(234); + { clear } + ops:=0; + optypes[1]:=''; + optypes[2]:=''; + optypes[3]:=''; + optypes[4]:=''; + codes:=''; + flags:=''; + skip:=false; + { ops and optypes } + i:=1; + repeat + hs:=readstr; + if (hs='void') or (hs='ignore') then + break; + inc(ops); + optypes[ops]:=optypes[ops]+'ot_'+formatop(hs); +{ if s[i]=':' then + begin + inc(i); + optypes[ops]:=optypes[ops]+' or ot_'+formatop(readstr); + end;} + while s[i]='|' do + begin + inc(i); + optypes[ops]:=optypes[ops]+' or ot_'+formatop(readstr); + end; + if s[i] in [',',':'] then + inc(i) + else + break; + until false; + for j:=1 to 4-ops do + optypes[4-j+1]:='ot_none'; + { codes } + skipspace; + j:=0; +(* last:=0;*) + if s[i] in ['\','0'..'9'] then + begin + while not(s[i] in [' ',#9]) do + begin + code:=readnumber; +(* + { for some codes we want also to change the optypes, but not + if the last byte was a 1 then this byte belongs to a direct + copy } + if last<>1 then + begin + case code of + 12,13,14 : + optypes[code-11]:=optypes[code-11]+' or ot_signed'; + end; + end; +*) + codes:=codes+'#'+tostr(code); +(* last:=code;*) + inc(j); + end; + end + else + begin + readstr; + codes:='#0'; + end; + if j>maxinfolen then + maxinfolen:=j; + { flags } + skipspace; + while not(s[i] in [' ',#9,#13,#10]) and (i<=length(s)) do + begin + hs:=readstr; + if hs<>'ND' then + begin + if flags<>'' then + flags:=flags+' or '; + flags:=flags+'if_'+lower(hs); + end; + if (s[i]=',') and (i<=length(s)) then + inc(i) + else + break; + end; + { write instruction } + if not skip then + begin + if not(first) then + writeln(insfile,',') + else + first:=false; + writeln(insfile,' ('); + writeln(insfile,' opcode : ',opcode,';'); + writeln(insfile,' ops : ',ops,';'); + writeln(insfile,' optypes : (',optypes[1],',',optypes[2],',',optypes[3],',',optypes[4],');'); + writeln(insfile,' code : ',codes,';'); + writeln(insfile,' flags : ',flags); + write(insfile,' )'); + inc(insns); + end; + end; + close(infile); + closeinc(insfile); + closeinc(attfile); + closeinc(attsuffile); + closeinc(opfile); + writeln(nopfile,insns,';'); + close(nopfile); +{ closeinc(propfile); } + writeln(insns,' nodes procesed (maxinfolen=',maxinfolen,')'); +end. diff --git a/closures/compiler/utils/mkarmreg.pp b/closures/compiler/utils/mkarmreg.pp new file mode 100644 index 0000000000..8095eb37e8 --- /dev/null +++ b/closures/compiler/utils/mkarmreg.pp @@ -0,0 +1,276 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman and Florian Klaempfl + + Convert spreg.dat to several .inc files for usage with + the Free pascal compiler + + 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. + + **********************************************************************} +{$mode objfpc} + +program mkspreg; + +const Version = '1.00'; + max_regcount = 200; + +var s : string; + i : longint; + line : longint; + regcount:byte; + regcount_bsstart:byte; + names, + regtypes, + subtypes, + supregs, + numbers, + stdnames, + stabs,dwarf : array[0..max_regcount-1] of string[63]; + regnumber_index, + std_regname_index : array[0..max_regcount-1] of byte; + +function tostr(l : longint) : string; + +begin + str(l,tostr); +end; + +function readstr : string; + + begin + result:=''; + while (s[i]<>',') and (i<=length(s)) do + begin + result:=result+s[i]; + inc(i); + end; + end; + + +procedure readcomma; + begin + if s[i]<>',' then + begin + writeln('Missing "," at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(i); + end; + + +procedure skipspace; + + begin + while (s[i] in [' ',#9]) do + inc(i); + end; + +procedure openinc(out f:text;const fn:string); +begin + writeln('creating ',fn); + assign(f,fn); + rewrite(f); + writeln(f,'{ don''t edit, this file is generated from armreg.dat }'); +end; + + +procedure closeinc(var f:text); +begin + writeln(f); + close(f); +end; + +procedure build_regnum_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + regnumber_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if numbers[regnumber_index[j]]>=numbers[regnumber_index[i]] then + break; + t:=regnumber_index[i]; + regnumber_index[i]:=regnumber_index[j]; + regnumber_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_std_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + std_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if stdnames[std_regname_index[j]]>=stdnames[std_regname_index[i]] then + break; + t:=std_regname_index[i]; + std_regname_index[i]:=std_regname_index[j]; + std_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + + +procedure read_spreg_file; + +var infile:text; + +begin + { open dat file } + assign(infile,'armreg.dat'); + reset(infile); + while not(eof(infile)) do + begin + { handle comment } + readln(infile,s); + inc(line); + while (s[1]=' ') do + delete(s,1,1); + if (s='') or (s[1]=';') then + continue; + + i:=1; + names[regcount]:=readstr; + readcomma; + regtypes[regcount]:=readstr; + readcomma; + subtypes[regcount]:=readstr; + readcomma; + supregs[regcount]:=readstr; + readcomma; + stdnames[regcount]:=readstr; + readcomma; + stabs[regcount]:=readstr; + readcomma; + dwarf[regcount]:=readstr; + { Create register number } + if supregs[regcount][1]<>'$' then + begin + writeln('Missing $ before number, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + numbers[regcount]:=regtypes[regcount]+copy(subtypes[regcount],2,255)+'00'+copy(supregs[regcount],2,255); + if i<length(s) then + begin + writeln('Extra chars at end of line, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(regcount); + if regcount>max_regcount then + begin + writeln('Error: Too much registers, please increase maxregcount in source'); + halt(2); + end; + end; + close(infile); +end; + +procedure write_inc_files; + +var + norfile,stdfile,supfile, + numfile,stabfile,dwarffile,confile, + rnifile,srifile:text; + first:boolean; + +begin + { create inc files } + openinc(confile,'rarmcon.inc'); + openinc(supfile,'rarmsup.inc'); + openinc(numfile,'rarmnum.inc'); + openinc(stdfile,'rarmstd.inc'); + openinc(stabfile,'rarmsta.inc'); + openinc(dwarffile,'rarmdwa.inc'); + openinc(norfile,'rarmnor.inc'); + openinc(rnifile,'rarmrni.inc'); + openinc(srifile,'rarmsri.inc'); + first:=true; + for i:=0 to regcount-1 do + begin + if not first then + begin + writeln(numfile,','); + writeln(stdfile,','); + writeln(stabfile,','); + writeln(dwarffile,','); + writeln(rnifile,','); + writeln(srifile,','); + end + else + first:=false; + writeln(supfile,'RS_',names[i],' = ',supregs[i],';'); + writeln(confile,'NR_'+names[i],' = ','tregister(',numbers[i],')',';'); + write(numfile,'tregister(',numbers[i],')'); + write(stdfile,'''',stdnames[i],''''); + write(stabfile,stabs[i]); + write(dwarffile,dwarf[i]); + write(rnifile,regnumber_index[i]); + write(srifile,std_regname_index[i]); + end; + write(norfile,regcount); + close(confile); + close(supfile); + closeinc(numfile); + closeinc(stdfile); + closeinc(stabfile); + closeinc(dwarffile); + closeinc(norfile); + closeinc(rnifile); + closeinc(srifile); + writeln('Done!'); + writeln(regcount,' registers procesed'); +end; + + +begin + writeln('Register Table Converter Version ',Version); + line:=0; + regcount:=0; + read_spreg_file; + regcount_bsstart:=1; + while 2*regcount_bsstart<regcount do + regcount_bsstart:=regcount_bsstart*2; + build_regnum_index; + build_std_regname_index; + write_inc_files; +end. diff --git a/closures/compiler/utils/mkavrreg.pp b/closures/compiler/utils/mkavrreg.pp new file mode 100644 index 0000000000..78105af293 --- /dev/null +++ b/closures/compiler/utils/mkavrreg.pp @@ -0,0 +1,272 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman and Florian Klaempfl + + Convert spreg.dat to several .inc files for usage with + the Free pascal compiler + + 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. + + **********************************************************************} +{$mode objfpc} +program mkspreg; + +const Version = '1.00'; + max_regcount = 200; + +var s : string; + i : longint; + line : longint; + regcount:byte; + regcount_bsstart:byte; + names, + regtypes, + supregs, + numbers, + stdnames, + stabs,dwarf : array[0..max_regcount-1] of string[63]; + regnumber_index, + std_regname_index : array[0..max_regcount-1] of byte; + +function tostr(l : longint) : string; + +begin + str(l,tostr); +end; + +function readstr : string; + + begin + result:=''; + while (s[i]<>',') and (i<=length(s)) do + begin + result:=result+s[i]; + inc(i); + end; + end; + + +procedure readcomma; + begin + if s[i]<>',' then + begin + writeln('Missing "," at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(i); + end; + + +procedure skipspace; + + begin + while (s[i] in [' ',#9]) do + inc(i); + end; + +procedure openinc(out f:text;const fn:string); +begin + writeln('creating ',fn); + assign(f,fn); + rewrite(f); + writeln(f,'{ don''t edit, this file is generated from avrreg.dat }'); +end; + + +procedure closeinc(var f:text); +begin + writeln(f); + close(f); +end; + +procedure build_regnum_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + regnumber_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if numbers[regnumber_index[j]]>=numbers[regnumber_index[i]] then + break; + t:=regnumber_index[i]; + regnumber_index[i]:=regnumber_index[j]; + regnumber_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_std_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + std_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if stdnames[std_regname_index[j]]>=stdnames[std_regname_index[i]] then + break; + t:=std_regname_index[i]; + std_regname_index[i]:=std_regname_index[j]; + std_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + + +procedure read_spreg_file; + +var infile:text; + +begin + { open dat file } + assign(infile,'avrreg.dat'); + reset(infile); + while not(eof(infile)) do + begin + { handle comment } + readln(infile,s); + inc(line); + while (s[1]=' ') do + delete(s,1,1); + if (s='') or (s[1]=';') then + continue; + + i:=1; + names[regcount]:=readstr; + readcomma; + regtypes[regcount]:=readstr; + readcomma; + supregs[regcount]:=readstr; + readcomma; + stdnames[regcount]:=readstr; + readcomma; + stabs[regcount]:=readstr; + readcomma; + dwarf[regcount]:=readstr; + { Create register number } + if supregs[regcount][1]<>'$' then + begin + writeln('Missing $ before number, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + numbers[regcount]:=regtypes[regcount]+'0000'+copy(supregs[regcount],2,255); + if i<length(s) then + begin + writeln('Extra chars at end of line, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(regcount); + if regcount>max_regcount then + begin + writeln('Error: Too much registers, please increase maxregcount in source'); + halt(2); + end; + end; + close(infile); +end; + +procedure write_inc_files; + +var + norfile,stdfile,supfile, + numfile,stabfile,dwarffile,confile, + rnifile,srifile:text; + first:boolean; + +begin + { create inc files } + openinc(confile,'ravrcon.inc'); + openinc(supfile,'ravrsup.inc'); + openinc(numfile,'ravrnum.inc'); + openinc(stdfile,'ravrstd.inc'); + openinc(stabfile,'ravrsta.inc'); + openinc(dwarffile,'ravrdwa.inc'); + openinc(norfile,'ravrnor.inc'); + openinc(rnifile,'ravrrni.inc'); + openinc(srifile,'ravrsri.inc'); + first:=true; + for i:=0 to regcount-1 do + begin + if not first then + begin + writeln(numfile,','); + writeln(stdfile,','); + writeln(stabfile,','); + writeln(dwarffile,','); + writeln(rnifile,','); + writeln(srifile,','); + end + else + first:=false; + writeln(supfile,'RS_',names[i],' = ',supregs[i],';'); + writeln(confile,'NR_'+names[i],' = ','tregister(',numbers[i],')',';'); + write(numfile,'tregister(',numbers[i],')'); + write(stdfile,'''',stdnames[i],''''); + write(stabfile,stabs[i]); + write(dwarffile,dwarf[i]); + write(rnifile,regnumber_index[i]); + write(srifile,std_regname_index[i]); + end; + write(norfile,regcount); + close(confile); + close(supfile); + closeinc(numfile); + closeinc(stdfile); + closeinc(stabfile); + closeinc(dwarffile); + closeinc(norfile); + closeinc(rnifile); + closeinc(srifile); + writeln('Done!'); + writeln(regcount,' registers procesed'); +end; + + +begin + writeln('Register Table Converter Version ',Version); + line:=0; + regcount:=0; + read_spreg_file; + regcount_bsstart:=1; + while 2*regcount_bsstart<regcount do + regcount_bsstart:=regcount_bsstart*2; + build_regnum_index; + build_std_regname_index; + write_inc_files; +end. diff --git a/closures/compiler/utils/mkmpsreg.pp b/closures/compiler/utils/mkmpsreg.pp new file mode 100644 index 0000000000..b3494a50c4 --- /dev/null +++ b/closures/compiler/utils/mkmpsreg.pp @@ -0,0 +1,318 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman and Florian Klaempfl + + Convert mipsreg.dat to several .inc files for usage with + the Free pascal compiler + + 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. + + **********************************************************************} +{$mode objfpc} +program mkmipsreg; + +const Version = '1.00'; + max_regcount = 200; + +var s : string; + i : longint; + line : longint; + regcount:byte; + regcount_bsstart:byte; + names, + regtypes, + supregs, + numbers, + stdnames, + gasnames, + dwarfs, + stabs : array[0..max_regcount-1] of string[63]; + regnumber_index, + std_regname_index, + gas_regname_index : array[0..max_regcount-1] of byte; + +function tostr(l : longint) : string; + +begin + str(l,tostr); +end; + +function readstr : string; + + begin + result:=''; + while (s[i]<>',') and (i<=length(s)) do + begin + result:=result+s[i]; + inc(i); + end; + end; + + +procedure readcomma; + begin + if s[i]<>',' then + begin + writeln('Missing "," at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(i); + end; + + +procedure skipspace; + + begin + while (s[i] in [' ',#9]) do + inc(i); + end; + +procedure openinc(out f:text;const fn:string); +begin + writeln('creating ',fn); + assign(f,fn); + rewrite(f); + writeln(f,'{ don''t edit, this file is generated from mipsreg.dat }'); +end; + + +procedure closeinc(var f:text); +begin + writeln(f); + close(f); +end; + +procedure build_regnum_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + regnumber_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if numbers[regnumber_index[j]]>=numbers[regnumber_index[i]] then + break; + t:=regnumber_index[i]; + regnumber_index[i]:=regnumber_index[j]; + regnumber_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_std_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + std_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if stdnames[std_regname_index[j]]>=stdnames[std_regname_index[i]] then + break; + t:=std_regname_index[i]; + std_regname_index[i]:=std_regname_index[j]; + std_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + + +procedure build_gas_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + gas_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if gasnames[gas_regname_index[j]]>=gasnames[gas_regname_index[i]] then + break; + t:=gas_regname_index[i]; + gas_regname_index[i]:=gas_regname_index[j]; + gas_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + + +procedure read_mipsreg_file; + +var infile:text; + +begin + { open dat file } + assign(infile,'mipsreg.dat'); + reset(infile); + while not(eof(infile)) do + begin + { handle comment } + readln(infile,s); + inc(line); + while (s[1]=' ') do + delete(s,1,1); + if (s='') or (s[1]=';') then + continue; + + i:=1; + names[regcount]:=readstr; + readcomma; + regtypes[regcount]:=readstr; + readcomma; + supregs[regcount]:=readstr; + readcomma; + stdnames[regcount]:=readstr; + readcomma; + gasnames[regcount]:=readstr; + readcomma; + stabs[regcount]:=readstr; + readcomma; + dwarfs[regcount]:=readstr; + { Create register number } + if supregs[regcount][1]<>'$' then + begin + writeln('Missing $ before number, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + numbers[regcount]:=regtypes[regcount]+'0000'+copy(supregs[regcount],2,255); + if i<length(s) then + begin + writeln('Extra chars at end of line, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(regcount); + if regcount>max_regcount then + begin + writeln('Error: Too much registers, please increase maxregcount in source'); + halt(2); + end; + end; + close(infile); +end; + +procedure write_inc_files; + +var + norfile,stdfile,supfile, + numfile,stabfile,confile,gasfile,dwarffile, + rnifile,srifile,grifile : text; + first:boolean; + +begin + { create inc files } + openinc(confile,'rmipscon.inc'); + openinc(supfile,'rmipssup.inc'); + openinc(numfile,'rmipsnum.inc'); + openinc(stdfile,'rmipsstd.inc'); + openinc(gasfile,'rmipsgas.inc'); + openinc(stabfile,'rmipssta.inc'); + openinc(dwarffile,'rmipsdwf.inc'); + openinc(norfile,'rmipsnor.inc'); + openinc(rnifile,'rmipsrni.inc'); + openinc(srifile,'rmipssri.inc'); + openinc(grifile,'rmipsgri.inc'); + first:=true; + for i:=0 to regcount-1 do + begin + if not first then + begin + writeln(numfile,','); + writeln(stdfile,','); + writeln(gasfile,','); + writeln(stabfile,','); + writeln(dwarffile,','); + writeln(rnifile,','); + writeln(srifile,','); + writeln(grifile,','); + end + else + first:=false; + writeln(supfile,'RS_',names[i],' = ',supregs[i],';'); + writeln(confile,'NR_'+names[i],' = ','tregister(',numbers[i],')',';'); + write(numfile,'tregister(',numbers[i],')'); + write(stdfile,'''',stdnames[i],''''); + write(gasfile,'''',gasnames[i],''''); + write(stabfile,stabs[i]); + write(dwarffile,dwarfs[i]); + write(rnifile,regnumber_index[i]); + write(srifile,std_regname_index[i]); + write(grifile,gas_regname_index[i]); + end; + write(norfile,regcount); + close(confile); + close(supfile); + closeinc(numfile); + closeinc(stdfile); + closeinc(gasfile); + closeinc(stabfile); + closeinc(dwarffile); + closeinc(norfile); + closeinc(rnifile); + closeinc(srifile); + closeinc(grifile); + writeln('Done!'); + writeln(regcount,' registers procesed'); +end; + + +begin + writeln('Register Table Converter Version ',Version); + line:=0; + regcount:=0; + read_mipsreg_file; + regcount_bsstart:=1; + while 2*regcount_bsstart<regcount do + regcount_bsstart:=regcount_bsstart*2; + build_regnum_index; + build_std_regname_index; + build_gas_regname_index; + write_inc_files; +end. diff --git a/closures/compiler/utils/mkppcreg.pp b/closures/compiler/utils/mkppcreg.pp new file mode 100644 index 0000000000..7a35f1d78d --- /dev/null +++ b/closures/compiler/utils/mkppcreg.pp @@ -0,0 +1,370 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman and Florian Klaempfl + + Convert ppcreg.dat to several .inc files for usage with + the Free pascal compiler + + 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. + + **********************************************************************} +{$mode objfpc} +program mkppcreg; + +const Version = '1.00'; + max_regcount = 200; + +var s : string; + i : longint; + line : longint; + regcount:byte; + regcount_bsstart:byte; + names, + regtypes, + supregs, + numbers, + stdnames, + gasnames, + gssnames, + motnames, + dwarfs, + stabs : array[0..max_regcount-1] of string[63]; + regnumber_index, + std_regname_index, + gas_regname_index, + mot_regname_index : array[0..max_regcount-1] of byte; + +function tostr(l : longint) : string; + +begin + str(l,tostr); +end; + +function readstr : string; + + begin + result:=''; + while (s[i]<>',') and (i<=length(s)) do + begin + result:=result+s[i]; + inc(i); + end; + end; + + +procedure readcomma; + begin + if s[i]<>',' then + begin + writeln('Missing "," at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(i); + end; + + +procedure skipspace; + + begin + while (s[i] in [' ',#9]) do + inc(i); + end; + +procedure openinc(out f:text;const fn:string); +begin + writeln('creating ',fn); + assign(f,fn); + rewrite(f); + writeln(f,'{ don''t edit, this file is generated from ppcreg.dat }'); +end; + + +procedure closeinc(var f:text); +begin + writeln(f); + close(f); +end; + +procedure build_regnum_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + regnumber_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if numbers[regnumber_index[j]]>=numbers[regnumber_index[i]] then + break; + t:=regnumber_index[i]; + regnumber_index[i]:=regnumber_index[j]; + regnumber_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_std_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + std_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if stdnames[std_regname_index[j]]>=stdnames[std_regname_index[i]] then + break; + t:=std_regname_index[i]; + std_regname_index[i]:=std_regname_index[j]; + std_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + + +procedure build_gas_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + gas_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if gasnames[gas_regname_index[j]]>=gasnames[gas_regname_index[i]] then + break; + t:=gas_regname_index[i]; + gas_regname_index[i]:=gas_regname_index[j]; + gas_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + + +procedure build_mot_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + mot_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if motnames[mot_regname_index[j]]>=motnames[mot_regname_index[i]] then + break; + t:=mot_regname_index[i]; + mot_regname_index[i]:=mot_regname_index[j]; + mot_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + + +procedure read_ppcreg_file; + +var infile:text; + +begin + { open dat file } + assign(infile,'ppcreg.dat'); + reset(infile); + while not(eof(infile)) do + begin + { handle comment } + readln(infile,s); + inc(line); + while (s[1]=' ') do + delete(s,1,1); + if (s='') or (s[1]=';') then + continue; + + i:=1; + names[regcount]:=readstr; + readcomma; + regtypes[regcount]:=readstr; + readcomma; + supregs[regcount]:=readstr; + readcomma; + stdnames[regcount]:=readstr; + readcomma; + gasnames[regcount]:=readstr; + readcomma; + gssnames[regcount]:=readstr; + readcomma; + motnames[regcount]:=readstr; + readcomma; + stabs[regcount]:=readstr; + readcomma; + dwarfs[regcount]:=readstr; + { Create register number } + if supregs[regcount][1]<>'$' then + begin + writeln('Missing $ before number, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + numbers[regcount]:=regtypes[regcount]+'0000'+copy(supregs[regcount],2,255); + if i<length(s) then + begin + writeln('Extra chars at end of line, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(regcount); + if regcount>max_regcount then + begin + writeln('Error: Too much registers, please increase maxregcount in source'); + halt(2); + end; + end; + close(infile); +end; + +procedure write_inc_files; + +var + norfile,stdfile,motfile,supfile, + numfile,stabfile,confile,gasfile,gssfile,dwarffile, + rnifile,srifile,mrifile,grifile : text; + first:boolean; + +begin + { create inc files } + openinc(confile,'rppccon.inc'); + openinc(supfile,'rppcsup.inc'); + openinc(numfile,'rppcnum.inc'); + openinc(stdfile,'rppcstd.inc'); + openinc(gasfile,'rppcgas.inc'); + openinc(gssfile,'rppcgss.inc'); + openinc(motfile,'rppcmot.inc'); + openinc(stabfile,'rppcstab.inc'); + openinc(dwarffile,'rppcdwrf.inc'); + openinc(norfile,'rppcnor.inc'); + openinc(rnifile,'rppcrni.inc'); + openinc(srifile,'rppcsri.inc'); + openinc(grifile,'rppcgri.inc'); + openinc(mrifile,'rppcmri.inc'); + first:=true; + for i:=0 to regcount-1 do + begin + if not first then + begin + writeln(numfile,','); + writeln(stdfile,','); + writeln(gasfile,','); + writeln(gssfile,','); + writeln(motfile,','); + writeln(stabfile,','); + writeln(dwarffile,','); + writeln(rnifile,','); + writeln(srifile,','); + writeln(grifile,','); + writeln(mrifile,','); + end + else + first:=false; + writeln(supfile,'RS_',names[i],' = ',supregs[i],';'); + writeln(confile,'NR_'+names[i],' = ','tregister(',numbers[i],')',';'); + write(numfile,'tregister(',numbers[i],')'); + write(stdfile,'''',stdnames[i],''''); + write(gasfile,'''',gasnames[i],''''); + write(gssfile,'''',gssnames[i],''''); + write(motfile,'''',motnames[i],''''); + write(stabfile,stabs[i]); + write(dwarffile,dwarfs[i]); + write(rnifile,regnumber_index[i]); + write(srifile,std_regname_index[i]); + write(grifile,gas_regname_index[i]); + write(mrifile,mot_regname_index[i]); + end; + write(norfile,regcount); + close(confile); + close(supfile); + closeinc(numfile); + closeinc(stdfile); + closeinc(gasfile); + closeinc(gssfile); + closeinc(motfile); + closeinc(stabfile); + closeinc(dwarffile); + closeinc(norfile); + closeinc(rnifile); + closeinc(srifile); + closeinc(grifile); + closeinc(mrifile); + writeln('Done!'); + writeln(regcount,' registers procesed'); +end; + + +begin + writeln('Register Table Converter Version ',Version); + line:=0; + regcount:=0; + read_ppcreg_file; + regcount_bsstart:=1; + while 2*regcount_bsstart<regcount do + regcount_bsstart:=regcount_bsstart*2; + build_regnum_index; + build_std_regname_index; + build_gas_regname_index; + build_mot_regname_index; + write_inc_files; +end. diff --git a/closures/compiler/utils/mkspreg.pp b/closures/compiler/utils/mkspreg.pp new file mode 100644 index 0000000000..668c152408 --- /dev/null +++ b/closures/compiler/utils/mkspreg.pp @@ -0,0 +1,275 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman and Florian Klaempfl + + Convert spreg.dat to several .inc files for usage with + the Free pascal compiler + + 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. + + **********************************************************************} +{$mode objfpc} +program mkspreg; + +const Version = '1.00'; + max_regcount = 200; + +var s : string; + i : longint; + line : longint; + regcount:byte; + regcount_bsstart:byte; + supregs, + subregs, + names, + regtypes, + numbers, + stdnames, + stabs, + dwarfs : array[0..max_regcount-1] of string[63]; + regnumber_index, + std_regname_index : array[0..max_regcount-1] of byte; + +function tostr(l : longint) : string; + +begin + str(l,tostr); +end; + +function readstr : string; + + begin + result:=''; + while (s[i]<>',') and (i<=length(s)) do + begin + result:=result+s[i]; + inc(i); + end; + end; + + +procedure readcomma; + begin + if s[i]<>',' then + begin + writeln('Missing "," at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(i); + end; + + +procedure skipspace; + + begin + while (s[i] in [' ',#9]) do + inc(i); + end; + +procedure openinc(out f:text;const fn:string); +begin + writeln('creating ',fn); + assign(f,fn); + rewrite(f); + writeln(f,'{ don''t edit, this file is generated from spreg.dat }'); +end; + + +procedure closeinc(var f:text); +begin + writeln(f); + close(f); +end; + +procedure build_regnum_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + regnumber_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if numbers[regnumber_index[j]]>=numbers[regnumber_index[i]] then + break; + t:=regnumber_index[i]; + regnumber_index[i]:=regnumber_index[j]; + regnumber_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_std_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + std_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if stdnames[std_regname_index[j]]>=stdnames[std_regname_index[i]] then + break; + t:=std_regname_index[i]; + std_regname_index[i]:=std_regname_index[j]; + std_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + + +procedure read_spreg_file; +var + infile:text; +begin + { open dat file } + assign(infile,'spreg.dat'); + reset(infile); + while not(eof(infile)) do + begin + { handle comment } + readln(infile,s); + inc(line); + while (s[1]=' ') do + delete(s,1,1); + if (s='') or (s[1]=';') then + continue; + + i:=1; + names[regcount]:=readstr; + readcomma; + regtypes[regcount]:=readstr; + readcomma; + subregs[regcount]:=readstr; + readcomma; + supregs[regcount]:=readstr; + readcomma; + stdnames[regcount]:=readstr; + readcomma; + stabs[regcount]:=readstr; + readcomma; + dwarfs[regcount]:=readstr; + { Create register number } + if supregs[regcount][1]<>'$' then + begin + writeln('Missing $ before number, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + numbers[regcount]:=regtypes[regcount]+copy(subregs[regcount],2,255)+'00'+copy(supregs[regcount],2,255); + if i<length(s) then + begin + writeln('Extra chars at end of line, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(regcount); + if regcount>max_regcount then + begin + writeln('Error: Too much registers, please increase maxregcount in source'); + halt(2); + end; + end; + close(infile); +end; + +procedure write_inc_files; + +var + norfile,stdfile,supfile, + numfile,stabfile,dwarffile,confile, + rnifile,srifile:text; + first:boolean; + +begin + { create inc files } + openinc(confile,'rspcon.inc'); + openinc(supfile,'rspsup.inc'); + openinc(numfile,'rspnum.inc'); + openinc(stdfile,'rspstd.inc'); + openinc(stabfile,'rspstab.inc'); + openinc(dwarffile,'rspdwrf.inc'); + openinc(norfile,'rspnor.inc'); + openinc(rnifile,'rsprni.inc'); + openinc(srifile,'rspsri.inc'); + first:=true; + for i:=0 to regcount-1 do + begin + if not first then + begin + writeln(numfile,','); + writeln(stdfile,','); + writeln(stabfile,','); + writeln(dwarffile,','); + writeln(rnifile,','); + writeln(srifile,','); + end + else + first:=false; + writeln(confile,'NR_',names[i],' = tregister(',numbers[i],');'); + writeln(supfile,'RS_',names[i],' = ',supregs[i],';'); + write(numfile,'NR_',names[i]); + write(stdfile,'''',stdnames[i],''''); + write(stabfile,stabs[i]); + write(dwarffile,dwarfs[i]); + write(rnifile,regnumber_index[i]); + write(srifile,std_regname_index[i]); + end; + write(norfile,regcount); + close(confile); + close(supfile); + closeinc(numfile); + closeinc(stdfile); + closeinc(stabfile); + closeinc(dwarffile); + closeinc(norfile); + closeinc(rnifile); + closeinc(srifile); + writeln('Done!'); + writeln(regcount,' registers procesed'); +end; + + +begin + writeln('Register Table Converter Version ',Version); + line:=0; + regcount:=0; + read_spreg_file; + regcount_bsstart:=1; + while 2*regcount_bsstart<regcount do + regcount_bsstart:=regcount_bsstart*2; + build_regnum_index; + build_std_regname_index; + write_inc_files; +end. diff --git a/closures/compiler/utils/mkx86ins.pp b/closures/compiler/utils/mkx86ins.pp new file mode 100644 index 0000000000..72cbc8b5cb --- /dev/null +++ b/closures/compiler/utils/mkx86ins.pp @@ -0,0 +1,442 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman and Florian Klaempfl + + Convert i386ins.dat from Nasm to a .inc file for usage with + the Free pascal compiler + + 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. + + **********************************************************************} +{$mode objfpc} +program mkx86ins; + +const + Version = '1.6.0'; + max_operands = 4; +var + s : string; + i : longint; + x86_64 : boolean; + + function lower(const s : string) : string; + { + return lowercased string of s + } + var + i : longint; + begin + for i:=1 to length(s) do + if s[i] in ['A'..'Z'] then + lower[i]:=char(byte(s[i])+32) + else + lower[i]:=s[i]; + lower[0]:=s[0]; + end; + + function Replace(var s:string;const s1,s2:string):boolean; + var + i : longint; + begin + i:=pos(s1,s); + if i>0 then + begin + Delete(s,i,length(s1)); + Insert(s2,s,i); + Replace:=true; + end + else + Replace:=false; + end; + + +function formatop(s:string;allowsizeonly:boolean):string; + const + replaces=26; + replacetab : array[1..replaces,1..2] of string[32]=( + (':',' or ot_colon'), + ('reg','regnorm'), + ('regmem','rm_gpr'), + ('rm8','rm_gpr or ot_bits8'), + ('rm16','rm_gpr or ot_bits16'), + ('rm32','rm_gpr or ot_bits32'), + ('rm64','rm_gpr or ot_bits64'), + ('rm80','rm_gpr or ot_bits80'), + ('mem8','memory or ot_bits8'), + ('mem16','memory or ot_bits16'), + ('mem32','memory or ot_bits32'), + ('mem64','memory or ot_bits64'), + ('mem80','memory or ot_bits80'), + ('mem','memory'), + ('memory_offs','mem_offs'), + ('imm8','immediate or ot_bits8'), + ('imm16','immediate or ot_bits16'), + ('imm32','immediate or ot_bits32'), + ('imm64','immediate or ot_bits64'), + ('imm80','immediate or ot_bits80'), + ('imm','immediate'), + ('8','bits8'), + ('16','bits16'), + ('32','bits32'), + ('64','bits64'), + ('80','bits80') + ); + var + i : longint; + begin + for i:=1to replaces do + begin + if s=replacetab[i,1] then + begin + s:=replacetab[i,2]; + break; + end; + end; + formatop:=s; + end; + + +function readnumber : longint; + + var + base : longint; + begin + result:=0; + if s[i]='\' then + begin + base:=8; + inc(i); + if s[i]='x' then + begin + base:=16; + inc(i); + end; + end + else + base:=10; + s[i]:=upcase(s[i]); + while s[i] in ['0'..'9','A'..'F'] do + begin + case s[i] of + '0'..'9': + result:=result*base+ord(s[i])-ord('0'); + + 'A'..'F': + result:=result*base+ord(s[i])-ord('A')+10; + end; + inc(i); + end; + end; + +function tostr(l : longint) : string; + + var + hs : string; + + begin + str(l,hs); + tostr:=hs; + end; + +function readstr : string; + + begin + result:=''; + while (s[i] in ['0'..'9','A'..'Z','a'..'z','_']) and (i<=length(s)) do + begin + result:=result+s[i]; + inc(i); + end; + end; + +procedure skipspace; + + begin + while (s[i] in [' ',#9]) do + inc(i); + end; + +procedure openinc(out f:text;const fn:string); +begin + writeln('creating ',fn); + assign(f,fn); + rewrite(f); + writeln(f,'{ don''t edit, this file is generated from x86ins.dat }'); + writeln(f,'('); +end; + + +procedure closeinc(var f:text); +begin + writeln(f); + writeln(f,');'); + close(f); +end; + + +var + attsuffix, + hs : string; + j : longint; + firstopcode, + first : boolean; + maxinfolen, + code : byte; + insns : longint; + attsuffile,propfile,opfile, + nopfile,attfile,intfile, + infile,insfile : text; + { instruction fields } + skip : boolean; + literalcount, + ops : longint; + intopcode, + attopcode, + opcode, + codes, + flags : string; + optypes : array[1..max_operands] of string; +begin + writeln('Nasm Instruction Table Converter Version ',Version); + x86_64:=paramstr(1)='x86_64'; + insns:=0; + maxinfolen:=0; + { open dat file } + assign(infile,'../x86/x86ins.dat'); + if x86_64 then + begin + { create inc files } + openinc(insfile,'x8664tab.inc'); + openinc(opfile,'x8664op.inc'); + assign(nopfile,'x8664nop.inc'); + openinc(attfile,'x8664att.inc'); + openinc(attsuffile,'x8664ats.inc'); + openinc(intfile,'x8664int.inc'); + openinc(propfile,'x8664pro.inc'); + end + else + begin + { create inc files } + openinc(insfile,'i386tab.inc'); + openinc(opfile,'i386op.inc'); + assign(nopfile,'i386nop.inc'); + openinc(attfile,'i386att.inc'); + openinc(attsuffile,'i386atts.inc'); + openinc(intfile,'i386int.inc'); + openinc(propfile,'i386prop.inc'); + end; + rewrite(nopfile); + writeln(nopfile,'{ don''t edit, this file is generated from x86ins.dat }'); + reset(infile); + first:=true; + opcode:=''; + firstopcode:=true; + while not(eof(infile)) do + begin + { handle comment } + readln(infile,s); + while (s[1]=' ') do + delete(s,1,1); + if (s='') or (s[1]=';') then + continue; + if (s[1]='[') then + begin + i:=pos(',',s); + j:=pos(']',s); + if i=0 then + begin + opcode:='A_'+Copy(s,2,j-2); + intopcode:=Copy(s,2,j-2); + { Conditional } + if (intopcode[length(intopcode)]='c') and + (intopcode[length(intopcode)-1]='c') then + dec(byte(intopcode[0]),2); + attopcode:=intopcode; + attsuffix:='attsufNONE'; + end + else + begin + opcode:='A_'+Copy(s,2,i-2); + intopcode:=Copy(s,2,i-2); + { intel conditional } + if (intopcode[length(intopcode)]='c') and + (intopcode[length(intopcode)-1]='c') then + dec(byte(intopcode[0]),2); + attopcode:=Copy(s,i+1,j-i-1); + { att Suffix } + case attopcode[length(attopcode)] of + 'X' : + begin + dec(attopcode[0]); + attsuffix:='attsufINT'; + end; + 'Y' : + begin + dec(attopcode[0]); + attsuffix:='attsufINTdual'; + end; + 'F' : + begin + dec(attopcode[0]); + attsuffix:='attsufFPU'; + end; + 'R' : + begin + dec(attopcode[0]); + attsuffix:='attsufFPUint'; + end; + else + attsuffix:='attsufNONE'; + end; + { att Conditional } + if (attopcode[length(attopcode)]='C') and + (attopcode[length(attopcode)-1]='C') then + dec(byte(attopcode[0]),2); + end; + intopcode:=Lower(intopcode); + attopcode:=Lower(attopcode); + if firstopcode then + firstopcode:=false + else + begin + writeln(opfile,','); + writeln(attfile,','); + writeln(attsuffile,','); + writeln(intfile,','); + writeln(propfile,','); + end; + write(opfile,opcode); + write(intfile,'''',intopcode,''''); + write(attfile,'''',attopcode,''''); + write(attsuffile,attsuffix); + { read the next line which contains the Change options } + repeat + readln(infile,s); + until eof(infile) or ((s<>'') and (s[1]<>';')); + write(propfile,'(Ch: ',s,')'); + continue; + end; + { we must have an opcode } + if opcode='' then + runerror(234); + { clear } + ops:=0; + for i:=low(optypes) to high(optypes) do + optypes[i]:=''; + codes:=''; + flags:=''; + skip:=false; + { ops and optypes } + i:=1; + repeat + hs:=readstr; + if (hs='void') or (hs='ignore') then + break; + inc(ops); + optypes[ops]:=optypes[ops]+'ot_'+formatop(hs,false); + while s[i]='|' do + begin + inc(i); + optypes[ops]:=optypes[ops]+' or ot_'+formatop(readstr,true); + end; + if s[i] in [',',':'] then + inc(i) + else + break; + until false; + for j:=1 to max_operands-ops do + optypes[max_operands-j+1]:='ot_none'; + { codes } + skipspace; + j:=0; + literalcount:=0; + if s[i] in ['\','0'..'9'] then + begin + while not(s[i] in [' ',#9]) do + begin + code:=readnumber; + { for some codes we want also to change the optypes, but not + if the code belongs to a literal sequence } + if (literalcount=0) and (code>=1) and (code<=3) then + literalcount:=code + else + begin + if literalcount>0 then + dec(literalcount) + else + begin + case code of + 12,13,14 : + optypes[code-11]:=optypes[code-11]+' or ot_signed'; + end; + end; + end; + codes:=codes+'#'+tostr(code); + inc(j); + end; + end + else + begin + readstr; + codes:='#0'; + end; + if j>maxinfolen then + maxinfolen:=j; + { flags } + skipspace; + while not(s[i] in [' ',#9,#13,#10]) and (i<=length(s)) do + begin + hs:=readstr; + if x86_64 then + begin + if (upcase(hs)='NOX86_64') then + skip:=true; + end + else + begin + if (upcase(hs)='X86_64') then + skip:=true; + end; + if hs<>'ND' then + begin + if flags<>'' then + flags:=flags+' or '; + flags:=flags+'if_'+lower(hs); + end; + if (s[i]=',') and (i<=length(s)) then + inc(i) + else + break; + end; + { write instruction } + if not skip then + begin + if not(first) then + writeln(insfile,',') + else + first:=false; + writeln(insfile,' ('); + writeln(insfile,' opcode : ',opcode,';'); + writeln(insfile,' ops : ',ops,';'); + writeln(insfile,' optypes : (',optypes[1],',',optypes[2],',',optypes[3],',',optypes[4],');'); + writeln(insfile,' code : ',codes,';'); + writeln(insfile,' flags : ',flags); + write(insfile,' )'); + inc(insns); + end; + end; + close(infile); + closeinc(insfile); + closeinc(intfile); + closeinc(attfile); + closeinc(attsuffile); + closeinc(opfile); + writeln(nopfile,insns,';'); + close(nopfile); + closeinc(propfile); + writeln(insns,' nodes processed (maxinfolen=',maxinfolen,')'); +end. diff --git a/closures/compiler/utils/mkx86reg.pp b/closures/compiler/utils/mkx86reg.pp new file mode 100644 index 0000000000..2a9e208c79 --- /dev/null +++ b/closures/compiler/utils/mkx86reg.pp @@ -0,0 +1,443 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman and Florian Klaempfl + + Convert i386reg.dat to several .inc files for usage with + the Free pascal compiler + + 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. + + **********************************************************************} +{$mode objfpc} +{$i+} +program mkx86reg; + +const Version = '1.00'; + max_regcount = 128; + +var s : string; + i : longint; + line : longint; + regcount:byte; + regcount_bsstart:byte; + names,numbers,stdnames,intnames,nasmnames,attnames,stabs,dwarf32,dwarf64,ots,ops: + array[0..max_regcount-1] of string[63]; + regnumber_index,std_regname_index,int_regname_index,att_regname_index, + nasm_regname_index:array[0..max_regcount-1] of byte; + x86_64 : boolean; + fileprefix : string; + +function tostr(l : longint) : string; + +begin + str(l,tostr); +end; + +function readstr : string; + begin + result:=''; + while (s[i]<>',') and (i<=length(s)) do + begin + result:=result+s[i]; + inc(i); + end; + readstr:=result; + end; + + +procedure readcomma; + begin + if s[i]<>',' then + begin + writeln('Missing "," at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + inc(i); + end; + + +procedure skipspace; + + begin + while (s[i] in [' ',#9]) do + inc(i); + end; + +procedure openinc(out f:text;const fn:string); +begin + writeln('creating ',fn); + assign(f,fn); + rewrite(f); + writeln(f,'{ don''t edit, this file is generated from x86reg.dat }'); +end; + + +procedure closeinc(var f:text); +begin + writeln(f); + close(f); +end; + +procedure build_regnum_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + regnumber_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if numbers[regnumber_index[j]]>=numbers[regnumber_index[i]] then + break; + t:=regnumber_index[i]; + regnumber_index[i]:=regnumber_index[j]; + regnumber_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_std_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + std_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if stdnames[std_regname_index[j]]>=stdnames[std_regname_index[i]] then + break; + t:=std_regname_index[i]; + std_regname_index[i]:=std_regname_index[j]; + std_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_int_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + int_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if intnames[int_regname_index[j]]>=intnames[int_regname_index[i]] then + break; + t:=int_regname_index[i]; + int_regname_index[i]:=int_regname_index[j]; + int_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_att_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + att_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if attnames[att_regname_index[j]]>=attnames[att_regname_index[i]] then + break; + t:=att_regname_index[i]; + att_regname_index[i]:=att_regname_index[j]; + att_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure build_nasm_regname_index; + +var h,i,j,p,t:byte; + +begin + {Build the registernumber2regindex index. + Step 1: Fill.} + for i:=0 to regcount-1 do + nasm_regname_index[i]:=i; + {Step 2: Sort. We use a Shell-Metzner sort.} + p:=regcount_bsstart; + repeat + for h:=0 to regcount-p-1 do + begin + i:=h; + repeat + j:=i+p; + if nasmnames[nasm_regname_index[j]]>=nasmnames[nasm_regname_index[i]] then + break; + t:=nasm_regname_index[i]; + nasm_regname_index[i]:=nasm_regname_index[j]; + nasm_regname_index[j]:=t; + if i<p then + break; + dec(i,p); + until false; + end; + p:=p shr 1; + until p=0; +end; + +procedure read_x86reg_file; + +var infile:text; + cpustr:string; + +begin + { open dat file } + assign(infile,'x86reg.dat'); + reset(infile); + while not(eof(infile)) do + begin + { handle comment } + readln(infile,s); + inc(line); + while (s[1]=' ') do + delete(s,1,1); + if (s='') or (s[1]=';') then + continue; + + i:=1; + names[regcount]:=readstr; + readcomma; + numbers[regcount]:=readstr; + readcomma; + stdnames[regcount]:=readstr; + readcomma; + attnames[regcount]:=readstr; + readcomma; + intnames[regcount]:=readstr; + readcomma; + nasmnames[regcount]:=readstr; + readcomma; + stabs[regcount]:=readstr; + readcomma; + dwarf32[regcount]:=readstr; + readcomma; + dwarf64[regcount]:=readstr; + readcomma; + ots[regcount]:=readstr; + readcomma; + ops[regcount]:=readstr; + if s[i]=',' then + begin + readcomma; + cpustr:=readstr; + end + else + cpustr:=''; + if i<length(s) then + begin + writeln('Extra chars at end of line, at line ',line); + writeln('Line: "',s,'"'); + halt(1); + end; + if (cpustr<>'64') or x86_64 then + begin + inc(regcount); + if regcount>max_regcount then + begin + writeln('Error: Too much registers, please increase maxregcount in source'); + halt(2); + end; + end; + end; + close(infile); +end; + +procedure write_inc_files; + +var attfile,intfile,otfile,opfile, + norfile,nasmfile,stdfile, + numfile,stabfile,dwrffile,confile, + rnifile,irifile,srifile, + arifile,nrifile:text; + first:boolean; + +begin + { create inc files } + openinc(confile,fileprefix+'con.inc'); + openinc(numfile,fileprefix+'num.inc'); + openinc(stdfile,fileprefix+'std.inc'); + openinc(attfile,fileprefix+'att.inc'); + openinc(intfile,fileprefix+'int.inc'); + openinc(nasmfile,fileprefix+'nasm.inc'); + openinc(stabfile,fileprefix+'stab.inc'); + openinc(dwrffile,fileprefix+'dwrf.inc'); + openinc(otfile,fileprefix+'ot.inc'); + openinc(opfile,fileprefix+'op.inc'); + openinc(norfile,fileprefix+'nor.inc'); + openinc(rnifile,fileprefix+'rni.inc'); + openinc(srifile,fileprefix+'sri.inc'); + openinc(arifile,fileprefix+'ari.inc'); + openinc(irifile,fileprefix+'iri.inc'); + openinc(nrifile,fileprefix+'nri.inc'); + first:=true; + for i:=0 to regcount-1 do + begin + if not first then + begin + writeln(numfile,','); + writeln(stdfile,','); + writeln(attfile,','); + writeln(intfile,','); + writeln(nasmfile,','); + writeln(stabfile,','); + writeln(dwrffile,','); + writeln(otfile,','); + writeln(opfile,','); + writeln(rnifile,','); + writeln(srifile,','); + writeln(arifile,','); + writeln(irifile,','); + writeln(nrifile,','); + end + else + first:=false; + writeln(confile,names[i],' = ','tregister(',numbers[i],')',';'); + write(numfile,'tregister(',numbers[i],')'); + write(stdfile,'''',stdnames[i],''''); + write(attfile,'''',attnames[i],''''); + write(intfile,'''',intnames[i],''''); + write(nasmfile,'''',nasmnames[i],''''); + { stabs uses the same register numbering as dwarf + for x86_64 CPU } + if x86_64 then + write(stabfile,dwarf64[i]) + else + write(stabfile,stabs[i]); + if x86_64 then + write(dwrffile,dwarf64[i]) + else + write(dwrffile,dwarf32[i]); + write(otfile,ots[i]); + write(opfile,ops[i]); + write(rnifile,regnumber_index[i]); + write(srifile,std_regname_index[i]); + write(arifile,att_regname_index[i]); + write(irifile,int_regname_index[i]); + write(nrifile,nasm_regname_index[i]); + end; + write(norfile,regcount); + close(confile); + closeinc(numfile); + closeinc(attfile); + closeinc(stdfile); + closeinc(intfile); + closeinc(nasmfile); + closeinc(stabfile); + closeinc(dwrffile); + closeinc(otfile); + closeinc(opfile); + closeinc(norfile); + closeinc(rnifile); + closeinc(srifile); + closeinc(arifile); + closeinc(irifile); + closeinc(nrifile); + writeln('Done!'); + writeln(regcount,' registers procesed'); +end; + + +begin + writeln('Register Table Converter Version ',Version); + if paramcount=0 then + begin + x86_64:=false; + end + else + begin + x86_64:=paramstr(1)='x86_64'; + if (paramcount<>1) or + ((paramstr(1)<>'i386') and (paramstr(1)<>'x86_64')) then + begin + writeln('Usage: ',paramstr(0)); + writeln('Only one optional parameter is allowed: i386 or x86_64'); + halt(1); + end; + end; + if x86_64 then + begin + fileprefix:='r8664'; + writeln('Processing for CPU x86_64'); + end + else + begin + fileprefix:='r386'; + writeln('Processing for CPU i386'); + end; + line:=0; + regcount:=0; + read_x86reg_file; + regcount_bsstart:=1; + while 2*regcount_bsstart<regcount do + regcount_bsstart:=regcount_bsstart*2; + build_regnum_index; + build_int_regname_index; + if not(x86_64) then + build_nasm_regname_index; + build_std_regname_index; + build_att_regname_index; + write_inc_files; +end. diff --git a/closures/compiler/utils/msg2inc.pp b/closures/compiler/utils/msg2inc.pp new file mode 100644 index 0000000000..ec624bb5ca --- /dev/null +++ b/closures/compiler/utils/msg2inc.pp @@ -0,0 +1,823 @@ +{ + This program is part of the Free Pascal run time library. + Copyright (c) 1998-2002 by Peter Vreman + + Convert a .msg file to an .inc file with a const array of char + And for the lazy docwriters it can also generate some TeX output + + 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. + + **********************************************************************} +program msg2inc; +uses + strings; + +{$ifdef unix} + {$define EOL_ONE_CHAR} +{$endif unix} +{$ifdef amiga} + {$define EOL_ONE_CHAR} +{$endif amiga} +{$ifdef morphos} + {$define EOL_ONE_CHAR} +{$endif} +{$ifdef macos} + {$define EOL_ONE_CHAR} +{$endif} + +const + version='1.00'; +{$ifdef EOL_ONE_CHAR} + eollen=1; +{$else} + eollen=2; +{$endif} + msgparts = 20; + +type + TMode=(M_Char,M_Tex,M_Intel,M_String,M_Renumber); +var + InFile, + OutFile, + OutName : string; + Mode : TMode; + TexHeader : boolean; + + MsgTxt : pchar; + EnumTxt : pchar; + enumsize, + msgsize : longint; + + msgidxmax : array[1..msgparts] of longint; + msgs : array[0..msgparts,0..999] of boolean; + +procedure LoadMsgFile(const fn:string); +var + f : text; + error, + multiline : boolean; + code : word; + numpart,numidx, + line,i,j,num : longint; + ptxt, + penum : pchar; + number, + s,s1 : string; + + procedure err(const msgstr:string); + begin + writeln('error in line ',line,': ',msgstr); + error:=true; + end; + +begin + Writeln('Loading messagefile ',fn); +{Read the message file} + assign(f,fn); + {$push} {$I-} + reset(f); + {$pop} + if ioresult<>0 then + begin + WriteLn('fatal error: '+fn+' not found'); + halt(1); + end; +{ First parse the file and count bytes needed } + fillchar(msgidxmax,sizeof(msgidxmax),0); + fillchar(msgs,sizeof(msgs),0); + 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'); + number:=Copy(s,i+1,j-i-1); + { update the max index } + val(number,num,code); + numpart:=num div 1000; + if numpart=0 then + err('number should be > 1000'); + numidx:=num mod 1000; + { duplicate ? } + if msgs[numpart,numidx] then + err('duplicate number found'); + msgs[numpart,numidx]:=true; + { check range } + if numpart > msgparts then + err('number is to large') + else + if numidx > msgidxmax[numpart] then + msgidxmax[numpart]:=numidx; + if s[j+1]='[' then + begin + inc(msgsize,j-i); + multiline:=true + end + else + inc(msgsize,length(s)-i+1); + inc(enumsize,j); + end + else + err('no = found'); + end; + end; + end; + if multiline then + err('still in multiline mode'); + if error then + begin + close(f); + writeln('aborting'); + halt(1); + end; +{ alloc memory } + getmem(msgtxt,msgsize); +{ no linebreak after last entry } + dec(msgsize); + ptxt:=msgtxt; + getmem(enumtxt,enumsize); + penum:=enumtxt; +{ now read the buffer in mem } + 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); + {enum} + move(s[1],penum^,i-1); + inc(penum,i-1); + penum^:='='; + inc(penum); + number:=Copy(s,i+1,j-i-1); + move(number[1],penum^,length(number)); + inc(penum,length(number)); + penum^:=#0; + inc(penum); + { 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); +end; + + +{***************************************************************************** + WriteEnumFile +*****************************************************************************} + +procedure WriteEnumFile(const fn,typename:string); +var + t : text; + i : longint; + p : pchar; + start : boolean; +begin + writeln('Writing enumfile '+fn); +{Open textfile} + assign(t,fn); + rewrite(t); + writeln(t,'const'); +{Parse buffer in msgbuf and create indexs} + p:=enumtxt; + start:=true; + for i:=1 to enumsize do + begin + if start then + begin + write(t,' '); + start:=false; + end; + if p^=#0 then + begin + writeln(t,';'); + start:=true; + end + else + begin + write(t,p^); + end; + inc(p); + end; + writeln(t,''); + { msgtxt size } + writeln(t,' MsgTxtSize = ',msgsize,';'); + writeln(t,''); + { max msg idx table } + writeln(t,' MsgIdxMax : array[1..20] of longint=('); + write(t,' '); + for i:=1 to 20 do + begin + write(t,msgidxmax[i]+1); + if i<20 then + write(t,','); + if i=10 then + begin + writeln(t,''); + write(t,' '); + end; + end; + writeln(t,''); + writeln(t,' );'); + close(t); +end; + + +{***************************************************************************** + WriteStringFile +*****************************************************************************} + +procedure WriteStringFile(const fn,constname:string); +const + maxslen=240; { to overcome aligning problems } + + function l0(l:longint):string; + var + s : string[16]; + begin + str(l,s); + while (length(s)<5) do + s:='0'+s; + l0:=s; + end; + +var + t : text; + f : file; + slen, + len,i : longint; + p : pchar; + s : string; + start, + quote : boolean; +begin + writeln('Writing stringfile ',fn); +{Open textfile} + assign(t,fn); + rewrite(t); + writeln(t,'{$ifdef Delphi}'); + writeln(t,'const '+constname+' : array[0..000000] of string[',maxslen,']=('); + writeln(t,'{$else Delphi}'); + writeln(t,'const '+constname+' : array[0..000000,1..',maxslen,'] of char=('); + write(t,'{$endif Delphi}'); +{Parse buffer in msgbuf and create indexs} + p:=msgtxt; + slen:=0; + len:=0; + quote:=false; + start:=true; + for i:=1 to msgsize do + begin + if slen>=maxslen then + begin + if quote then + begin + write(t,''''); + quote:=false; + end; + write(t,','); + slen:=0; + inc(len); + end; + if (len>70) or (start) then + begin + if quote then + begin + write(t,''''); + quote:=false; + end; + if slen>0 then + writeln(t,'+') + else + writeln(t); + len:=0; + start:=false; + end; + if (len=0) then + write(t,' '); + if (ord(p^)>=32) and (p^<>#39) then + begin + if not quote then + begin + write(t,''''); + quote:=true; + inc(len); + end; + write(t,p^); + inc(len); + end + else + begin + if quote then + begin + write(t,''''); + inc(len); + quote:=false; + end; + write(t,'#'+chr(ord(p^) div 100+48)+chr((ord(p^) mod 100) div 10+48)+chr(ord(p^) mod 10+48)); + inc(len,3); + end; + if p^ in [#0,#10] then + start:=true; + inc(slen); + inc(p); + end; + if quote then + write(t,''''); + writeln(t,''); + writeln(t,');'); + close(t); +{update arraysize} + s:=l0(msgsize div maxslen); { we start with 0 } + assign(f,fn); + reset(f,1); + seek(f,34+eollen+length(constname)); + blockwrite(f,s[1],5); + seek(f,90+3*eollen+2*length(constname)); + blockwrite(f,s[1],5); + close(f); +end; + + +{***************************************************************************** + WriteCharFile +*****************************************************************************} + +procedure WriteCharFile(const fn,constname:string); + + function l0(l:longint):string; + var + s : string[16]; + begin + str(l,s); + while (length(s)<5) do + s:='0'+s; + l0:=s; + end; + + function createconst(b:byte):string; + begin + if (b in [32..127]) and (b<>39) then + createconst:=''''+chr(b)+'''' + else + createconst:='#'+chr(b div 100+48)+chr((b mod 100) div 10+48)+chr(b mod 10+48) + end; + +var + t : text; + f : file; + cidx,i : longint; + p : pchar; + s : string; +begin + writeln('Writing charfile '+fn); +{Open textfile} + assign(t,fn); + rewrite(t); + writeln(t,'const ',constname,' : array[1..00000] of char=('); +{Parse buffer in msgbuf and create indexs} + p:=msgtxt; + cidx:=0; + for i:=1to msgsize do + begin + if cidx=15 then + begin + if cidx>0 then + writeln(t,',') + else + writeln(t,''); + write(t,' '); + cidx:=0; + end + else + if cidx>0 then + write(t,',') + else + write(t,' '); + write(t,createconst(ord(p^))); + inc(cidx); + inc(p); + end; + writeln(t,');'); + close(t); +{update arraysize} + s:=l0(msgsize); + assign(f,fn); + reset(f,1); + seek(f,18+length(constname)); + blockwrite(f,s[1],5); + close(f); +end; + + +{***************************************************************************** + WriteIntelFile +*****************************************************************************} + +procedure WriteIntelFile(const fn,constname:string); +var + t : text; + len,i : longint; + p : pchar; + start, + quote : boolean; +begin + writeln('Writing Intelfile ',fn); +{Open textfile} + assign(t,fn); + rewrite(t); + writeln(t,'procedure '+constname+';assembler;'); + writeln(t,'asm'); +{Parse buffer in msgbuf and create indexs} + p:=msgtxt; + len:=0; + start:=true; + quote:=false; + for i:=1to msgsize do + begin + if len>70 then + begin + if quote then + begin + write(t,''''); + quote:=false; + end; + writeln(t,''); + start:=true; + end; + if start then + begin + write(t,' db '''); + len:=0; + quote:=true; + end; + if (ord(p^)>=32) and (p^<>#39) then + begin + if not quote then + begin + write(t,','''); + quote:=true; + inc(len); + end; + write(t,p^); + inc(len); + end + else + begin + if quote then + begin + write(t,''''); + inc(len); + quote:=false; + end; + write(t,','+chr(ord(p^) div 100+48)+chr((ord(p^) mod 100) div 10+48)+chr(ord(p^) mod 10+48)); + inc(len,4); + end; + inc(p); + end; + if quote then + write(t,''''); + writeln(t,''); + writeln(t,'end;'); + close(t); +end; + + +{***************************************************************************** + RenumberFile +*****************************************************************************} + +procedure RenumberFile(const fn,name:string); +var + f,t : text; + i : longint; + s,s1 : string; +begin + Writeln('Renumbering ',fn); +{Read the message file} + assign(f,fn); + {$push} {$I-} + reset(f); + {$pop} + if ioresult<>0 then + begin + WriteLn('*** message file '+fn+' not found ***'); + exit; + end; + assign(t,'msg2inc.$$$'); + rewrite(t); + i:=0; + while not eof(f) do + begin + readln(f,s); + if (copy(s,1,length(Name))=Name) and (s[3] in ['0'..'9']) then + begin + inc(i); + str(i,s1); + while length(s1)<3 do + s1:='0'+s1; + writeln(t,Name+s1+Copy(s,6,255)); + end + else + writeln(t,s); + end; + close(t); + close(f); +{ rename new file } + erase(f); + rename(t,fn); +end; + + +{***************************************************************************** + WriteTexFile +*****************************************************************************} + +Function EscapeString (Const S : String) : String; +Var + I : longint; + hs : string; +begin + hs:=''; + for i:=1 to length(s) do + case S[i] of + '$' : + if (s[i+1] in ['0'..'9']) then + hs:=hs+'arg' + else + hs:=hs+'\$'; + '&','{','}','#','_','%': // Escape these characters + hs := hs + '\' + S[i]; + '~','^': + hs := hs + '\'+S[i]+' '; + '\': + hs:=hs+'$\backslash$' + else + hs := hs + S[i]; + end; + EscapeString:=hs; +end; + +procedure WriteTexFile(const infn,outfn:string); +var + t,f : text; + line, + i,k : longint; + s,s1 : string; + texoutput : boolean; +begin + Writeln('Loading messagefile ',infn); + writeln('Writing TeXfile ',outfn); +{ Open infile } + assign(f,infn); + {$push} {$I-} + reset(f); + {$pop} + if ioresult<>0 then + begin + WriteLn('*** message file '+infn+' not found ***'); + exit; + end; +{ Open outfile } + assign(t,outfn); + rewrite(t); + If texheader then + begin + writeln (t,'\documentclass{article}'); + writeln (t,'\usepackage{html}'); + writeln (t,'\usepackage{fpc}'); + writeln (t,'\begin{document}'); + end; +{ Parse } + line:=0; + TexOutput:=False; + while not eof(f) do + begin + readln(f,s); + inc(line); + If Pos ('# BeginOfTeX',S)=1 then + TexOutPut:=True + else if pos ('# EndOfTeX',S)=1 then + TexOutPut:=False; + if (s<>'') and not(s[1] in ['#',';']) and TeXOutPut then + begin + if s[1]='%' then + begin + Delete(s,1,1); + writeln(t,s); + end + else + begin + i:=pos('=',s); + if i>0 then + begin + inc(i); + while s[i] in ['0'..'9'] do + inc(i); + inc(i); + s1:=''; + k:=0; + while (k<5) and (s[i+k]<>'_') do + begin + case s[i+k] of + 'W' : s1:='Warning: '; + 'E' : s1:='Error: '; + 'F' : s1:='Fatal: '; + 'N' : s1:='Note: '; + 'I' : s1:='Info: '; + 'H' : s1:='Hint: '; + end; + inc(k); + end; + if s[i+k]='_' then + inc(i,k+1); + writeln(t,'\item ['+s1+escapestring(Copy(s,i,255))+']'); + end + else + writeln('error in line: ',line,' skipping'); + end; + end; + end; + If TexHeader then + writeln (t,'\end{document}'); + close(t); + close(f); +end; + + +{***************************************************************************** + Main Program +*****************************************************************************} + +procedure getpara; +var + ch : char; + para : string; + files,i : word; + + procedure helpscreen; + begin + writeln('usage : msg2inc [Options] <msgfile> <incfile> <constname>'); + writeln('<Options> can be : -T Create .doc TeX file'); + writeln(' -TS Create .doc TeX file (stand-alone)'); + writeln(' -I Intel style asm output'); + writeln(' -S array of string'); + writeln(' -C array of char'); + writeln(' -R renumber section <incfile>'); + writeln(' -V Show version'); + writeln(' -? or -H This HelpScreen'); + halt(1); + end; + +begin + Mode:=M_String; + FIles:=0; + for i:=1to paramcount do + begin + para:=paramstr(i); + if (para[1]='-') then + begin + ch:=upcase(para[2]); + delete(para,1,2); + case ch of + 'T' : begin + case upcase(para[1]) of + 'S' : TexHeader:=True; + end; + Mode:=M_Tex; + end; + 'I' : Mode:=M_Intel; + 'S' : Mode:=M_String; + 'C' : Mode:=M_Char; + 'R' : Mode:=M_Renumber; + 'V' : begin + Writeln('Msg2Inc ',version,' for Free Pascal (C) 1998-2002 Peter Vreman'); + Writeln; + Halt; + end; + '?','H' : helpscreen; + end; + end + else + begin + inc(Files); + if Files>3 then + HelpScreen; + case Files of + 1 : InFile:=Para; + 2 : OutFile:=Para; + 3 : OutName:=Para; + end; + end; + end; + case Mode of + M_Renumber, + M_Tex : if Files<2 then + Helpscreen; + else + if FIles<3 then + HelpScreen; + end; +end; + + +begin + GetPara; + case Mode of + M_Renumber : begin + Renumberfile(Infile,OutFile); + end; + M_Tex : begin + WriteTexFile(InFile,Outfile); + end; + M_Intel : begin + Loadmsgfile(InFile); + WriteEnumFile(OutFile+'idx.inc',OutName+'const'); + WriteIntelFile(OutFile+'txt.inc',OutName+'txt'); + end; + M_String : begin + Loadmsgfile(InFile); + WriteEnumFile(OutFile+'idx.inc',OutName+'const'); + WriteStringFile(OutFile+'txt.inc',OutName+'txt'); + end; + M_Char : begin + Loadmsgfile(InFile); + WriteEnumFile(OutFile+'idx.inc',OutName+'const'); + WriteCharFile(OutFile+'txt.inc',OutName+'txt'); + end; + end; +end. diff --git a/closures/compiler/utils/msgdif.pp b/closures/compiler/utils/msgdif.pp new file mode 100644 index 0000000000..4b49775bfb --- /dev/null +++ b/closures/compiler/utils/msgdif.pp @@ -0,0 +1,529 @@ +{ + This program is part of the Free Pascal run time library. + Copyright (c) 1998-2002 by Peter Vreman + + Show the differences between two .msg files + + 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. + + **********************************************************************} + +{ May be we need to compare a prefixes of option_help_pages too? + Currently this is not performed } + +Program messagedif; + +{$h+} {Huge strings} + +Uses + Strings; + +Type + TEnum = String; + TText = String; + + PMsg = ^TMsg; + TMsg = Record + Line, ctxt, cnb : Longint; + enum : TEnum; + text : TText; + comment : pchar; + Next,Prev : PMsg; + FileNext, + Equivalent : PMsg; + end; +Var + OrgFileName,DiffFileName : String; + OrgRoot,DiffRoot : PMsg; + OrgFirst,DiffFirst : PMsg; + Last : PMsg; + +const + NewFileName = 'new.msg'; + Is_interactive : boolean = false; + Auto_verbosity : boolean = false; + + +Procedure GetTranslation( p : PMsg); +var + s : string; + i,j,k : longint; +begin + i:=pos('_',p^.text); + if i>0 then + for j:=i+1 to Length(p^.text) do + if p^.text[j]='_' then + begin + i:=j; + break; + end; + if (i>0) and (i<=15) then + Writeln(P^.Enum,' type "',copy(p^.text,1,i-1),'" "',copy(p^.text,i+1,255),'"') + else + Writeln(P^.enum,' "',p^.text,'"'); + Writeln('Type translated error message in,'); + Writeln('Press return to keep it unchanged, or "q" to finish interactive mode'); + Readln(s); + if s='' then + exit; + if s='q' then + begin + Is_interactive:=false; + exit; + end; + j:=pos('_',s); + if j>0 then + for k:=j+1 to Length(s) do + if s[j]='_' then + begin + j:=k; + break; + end; + if (j>0) then + begin + if copy(p^.text,1,i)<>copy(s,1,j) then + Writeln('Warning : different verbosity !!'); + p^.text:=s; + end + else + p^.text:=copy(p^.text,1,i)+s; +end; + +Function NewMsg (Var RM : PMsg; L : Longint; Const E : TEnum;Const T : TText;C : pchar;NbLn,TxtLn : longint) : PMsg; + +Var + P,R : PMsg; + +begin + New(P); + with P^ do + begin + Line:=L; + Text:=T; + enum:=E; + comment:=c; + cnb:=NbLn; + ctxt:=TxtLn; + next:=Nil; + prev:=Nil; + filenext:=nil; + equivalent:=nil; + if assigned(last) then + last^.FileNext:=P; + last:=P; + end; + R:=RM; + While (R<>Nil) and (UpCase(R^.enum)>UpCase(P^.Enum)) do + begin + P^.Prev:=R; + R:=R^.next; + end; + if assigned(R) and (UpCase(R^.Enum)=UpCase(P^.Enum)) then + Writeln('Error ',R^.Enum,' duplicate'); + P^.Next:=R; + If R<>Nil then + R^.Prev:=P; + If P^.Prev<>Nil then + P^.Prev^.Next:=P + else + RM:=P; + NewMsg:=P; +end; + +Procedure PrintList(const name : string;R : PMsg); +var + P : PMsg; + f : text; +begin + P:=R; + Assign(f,name); + Rewrite(f); + while assigned(P) do + begin + Writeln(f,UpCase(P^.Enum)); + P:=P^.Next; + end; + Close(f); +end; + +Procedure Usage; + +begin + Writeln('Usage : msgdif [options] <org-file> <dif-file>'); + Writeln('Options:'); + Writeln(' -i allow to enter translated messages interactively'); + Writeln(' -y1 use <org-file> verbosity (do not query acknowledge)'); + Writeln(''); + Writeln('Generates "',NewFileName,'" that contain the messages from <dif-file>'); + Writeln('with a new messages from <org-file>'); + Writeln(''); + Writeln('Example:'); + Writeln(' msgdif errore.msg errorr.msg'); + halt(1) +end; + +Procedure ProcessOptions; +var + i,count : longint; +begin + Is_interactive:=false; + Auto_verbosity:=false; + + count:=paramcount; i:=1; + while (count>0) and (Paramstr(i)[1]='-') do + case UpCase(Paramstr(i)[2]) of + 'I': begin + Is_interactive:=true; + dec(count); Inc(i); + end; + 'Y': case Paramstr(i)[3] of + '1': begin + Auto_verbosity:=true; + dec(count); Inc(i); + end; + else + Writeln ('Error: unknown option ', Paramstr(i)); + Usage; + end; + else + Writeln ('Error: unknown option ', Paramstr(i)); + Usage; + end; + If Count<>2 then begin + Writeln ('Error: there must be exactly two message files'); + Usage; + end; + + OrgfileName:=Paramstr(i); + DiffFileName:=Paramstr(i+1); + if (OrgFileName=NewFileName) or (DiffFileName=NewFileName) then + begin + Writeln('The file names must be different from ',NewFileName); + Halt(1); + end; +end; + +Procedure ProcessFile (FileName : String; Var Root,First : PMsg); + +Const + ArrayLength = 65500; +Var F : Text; + S,prevS : String; + J,LineNo,Count,NbLn,TxtLn : Longint; + chararray : array[0..ArrayLength] of char; + currentindex : longint; + c : pchar; + multiline : boolean; +begin + Assign(F,FileName); + Reset(F); + Write ('Processing: ',Filename,'...'); + LineNo:=0; + NbLn:=0; + TxtLn:=0; + Count:=0; + currentindex:=0; + Root:=Nil; + First:=nil; + Last:=nil; + PrevS:=''; + multiline:=false; + While not eof(f) do + begin + Readln(F,S); + Inc(LineNo); + If multiline then + begin + PrevS:=PrevS+#10+S; Inc(TxtLn); + if (Length(S)<>0) and (S[1]=']') then + multiline:=false; + end + else + if (length(S)>0) and Not (S[1] in ['%','#']) Then + begin + J:=Pos('=',S); + If j<1 then + writeln (Filename,'(',LineNo,') : Invalid entry') + else + begin + chararray[currentindex]:=#0; + c:=strnew(@chararray); + if PrevS<>'' then + NewMsg(Root,LineNo,Copy(PrevS,1,Pos('=',PrevS)-1), + Copy(PrevS,Pos('=',PrevS)+1,Length(PrevS)),c,NbLn,TxtLn) + else + StrDispose(c); + currentindex:=0; + NbLn:=0; TxtLn:=0; + PrevS:=S; Inc(TxtLn); + if S[j+7]='[' then multiline:=true; + if First=nil then + First:=Root; + Inc(Count); + end; + end + else + begin + if currentindex+length(s)+1>ArrayLength then + Writeln('Comment too long : over ',ArrayLength,' chars') + else + begin + strpcopy(@chararray[currentindex],s+#10); + inc(currentindex,length(s)+1); + inc(NbLn); + end; + end; + end; + chararray[currentindex]:=#0; + c:=strnew(@chararray); + if PrevS<>'' then + NewMsg(Root,LineNo,Copy(PrevS,1,Pos('=',PrevS)-1), + Copy(PrevS,Pos('=',PrevS)+1,Length(PrevS)),c,NbLn,TxtLn); + Writeln (' Done. Read ',LineNo,' lines, got ',Count,' constants.'); + Close(f); +end; + +Procedure ShowDiff (POrg,PDiff : PMsg); + +Var + count,orgcount,diffcount : longint; + +Procedure NotFound (Org : Boolean; P : PMsg); + +begin + With P^ do + If Org Then + Writeln ('Not found in ',DiffFileName,' : ',Enum,' ',OrgFileName,'(',Line,')') + else + Writeln ('Extra in ',DiffFileName,'(',line,') : ',enum); + if org then + inc(orgcount) + else + inc(diffcount); +end; + +begin + orgcount:=0; + diffcount:=0; + count:=0; + While (Porg<>Nil) and (PDiff<>Nil) do + begin +// Writeln (POrg^.enum,'<=>',PDiff^.Enum); + If UpCase(Porg^.Enum)>UpCase(PDiff^.Enum) then + begin + NotFound (True,Porg); + POrg:=POrg^.Next + end + else If UpCase(POrg^.enum)=UpCase(PDiff^.Enum) then + begin + inc(count); + POrg^.Equivalent:=PDiff; + PDiff^.Equivalent:=POrg; + POrg:=POrg^.Next; + PDiff:=PDiff^.Next; + end + else + begin + NotFound (False,PDiff); + PDiff:=PDiff^.Next + end; + end; + While POrg<>Nil do + begin + NotFound(True,Porg); + POrg:=pOrg^.Next; + end; + While PDiff<>Nil do + begin + NotFound(False,PDiff); + PDiff:=PDiff^.Next; + end; + Writeln(count,' messages found in common to both files'); + Writeln(orgcount,' messages only in ',OrgFileName); + Writeln(diffcount,' messages only in ',DiffFileName); +end; + +type TArgSet = set of 0..31; + +function MsgToSet(const Msg, FileName: string; var R: TArgSet): Boolean; + var + i, j,l, num : integer; + code : word; + begin + R:=[]; + MsgToSet:=false; + for i:=1 to Length(Msg) do + if Msg[i]='$' then + begin + j:=i+1; l:=length(msg)+1; + while (j<l) and (Msg[j] in ['0'..'9']) do Inc(j); + if j > (i+1) then + begin + val(copy(Msg,i+1,j-i-1),num,code); + if num > high(TArgSet) then begin + WriteLn('Error in ', FileName,': ', Msg); + WriteLn(' number at position ', i); + WriteLn(' must be LE ', high(TArgSet)); + Exit; + end; + R:=R+[num]; + end; + end; + MsgToSet:=true; + end; + + +procedure CheckParm(const s1, s2: string); + var + R1, R2: TArgSet; + begin + if MsgToSet(s1,OrgFileName, R1) <> true then Exit; + if MsgToSet(s2,DiffFileName,R2) <> true then Exit; + if R1<>R2 then begin + WriteLn('Error: set of arguments is different'); + WriteLn(' ',s1); + WriteLn(' ',s2); + end; + end; + +procedure WriteReorderedFile(FileName : string;orgnext,diffnext : PMsg); + var t,t2,t3 : text; + i,ntcount : longint; + j : integer; + s,s2,s3 : string; + is_msg : boolean; + nextdiffkept : pmsg; + begin + ntcount:=0; + Assign(t,FileName); + Rewrite(t); + Writeln(t,'%%% Reordering of ',DiffFileName,' respective to ',OrgFileName); + Writeln(t,'%%% Contains all comments from ',DiffFileName); + Assign(t2,DiffFileName); + Reset(t2); + Assign(t3,OrgFileName); + Reset(t3); + i:=2; + s:='';s3:=''; + nextdiffkept:=diffnext; + while assigned(nextdiffkept) and (nextdiffkept^.equivalent=nil) do + nextdiffkept:=nextdiffkept^.filenext; + { First write the header of diff } + repeat + Readln(t2,s); + is_msg:=(pos('=',s)>1) and (s[1]<>'%') and (s[1]<>'#'); + if not is_msg then + begin + Writeln(t,s); + inc(i); + end; + until is_msg; + { Write all messages in Org order } + while assigned(orgnext) do + begin + if not assigned(orgnext^.equivalent) then + begin + { Insert a new error msg with the english comments } + Writeln('New error ',orgnext^.enum,' added'); + If Is_interactive then + GetTranslation(orgnext); + Writeln(t,orgnext^.enum,'=',orgnext^.text); + inc(i,orgnext^.ctxt); + Write(t,orgnext^.comment); + inc(i,orgnext^.cnb); + end + else + begin + inc(i); + if orgnext^.text=orgnext^.equivalent^.text then + begin + Writeln(FileName,'(',i,') ',orgnext^.enum,' not translated'); + If Is_interactive then + GetTranslation(orgnext^.equivalent); + if orgnext^.text=orgnext^.equivalent^.text then + inc(ntcount); + end; + s2:=orgnext^.text; + j:=pos('_',copy(s2,7,20)) + 6; + s2:=upcase(copy(s2,1,j)); + s3:=orgnext^.equivalent^.text; + j:=pos('_',copy(s3,7,20)) + 6; + s3:=upcase(copy(s3,1,j)); + { that are the conditions in verbose unit } + if (length(s3)<12) and (s2<>s3) then + begin + Writeln('Warning: different options for ',orgnext^.enum); + Writeln(' ',orgnext^.text); + Writeln(' ',orgnext^.equivalent^.text); + s:='N'; + if Auto_verbosity then + s:='Y' + else + If Is_interactive then + begin + Write('Use ',s2,' verbosity ? [y/n] '); + Readln(s); + end; + if UpCase(s[1])='Y' then + begin + orgnext^.equivalent^.text:=s2+copy(orgnext^.equivalent^.text, + length(s3)+1,Length(orgnext^.equivalent^.text)); + WriteLn(' Using ', s2); + end; + end; + + CheckParm(orgnext^.text, orgnext^.equivalent^.text); + + Writeln(t,orgnext^.enum,'=',orgnext^.equivalent^.text); + Dec(i); Inc(i,orgnext^.equivalent^.ctxt); + if assigned(orgnext^.equivalent^.comment) and + (strlen(orgnext^.equivalent^.comment)>0) then + begin + Write(t,orgnext^.equivalent^.comment); + inc(i,orgnext^.equivalent^.cnb); + end + else if assigned(orgnext^.comment) and + (strlen(orgnext^.comment)>0) then + begin + Writeln('Comment from ',OrgFileName,' for enum ',orgnext^.enum,' added'); + Write(t,orgnext^.comment); + inc(i,orgnext^.cnb); + end; + end; + orgnext:=orgnext^.filenext; + end; + + while assigned(diffnext) do + begin + if not assigned(diffnext^.Equivalent) then + begin + { Skip removed enum in errore.msg} + { maybe a renaming of an enum !} + Writeln(diffnext^.enum,' commented out'); + Writeln(t,'%%% ',diffnext^.enum,'=',diffnext^.text); + inc(i,diffnext^.ctxt); + Write(t,diffnext^.comment); + inc(i,diffnext^.cnb); + end; + diffnext:=diffnext^.filenext; + end; + Close(t); + Close(t2); + Close(t3); + Writeln(ntcount,' not translated items found'); + end; + +begin + ProcessOptions; + ProcessFile(OrgFileName,orgroot,orgfirst); + ProcessFile(DiffFileName,diffRoot,difffirst); + PrintList('org.lst',OrgRoot); + PrintList('diff.lst',DiffRoot); + ShowDiff (OrgRoot,DiffRoot); + WriteReorderedFile(NewFileName,orgfirst,difffirst); +end. diff --git a/closures/compiler/utils/msgused.pl b/closures/compiler/utils/msgused.pl new file mode 100644 index 0000000000..6ac46d655b --- /dev/null +++ b/closures/compiler/utils/msgused.pl @@ -0,0 +1,42 @@ +#!/usr/bin/perl +# +# find not used messages + +unlink("./msgidx.inc"); +unlink("./msgtxt.inc"); +@compiler_src = (glob("./*.inc"), + glob("./*.pas")); + +open(MESSAGE_FILE, "< ./msg/errore.msg") or + die "Couldn't open <./msg/errore.msg> for reading: $!\n"; + +open(FOUND, "> MSG-OK.TXT") or + die "Couldn't open <MSG-OK.TXT> for writing: $!\n"; + +select FOUND; $| = 1; + +open(NOT_FOUND, "> MSG_BAD.TXT") or + die "Couldn't open <MSG_BAD.TXT> for writing: $!\n"; + +select NOT_FOUND; $| = 1; + +while (<MESSAGE_FILE>) +{ + if (/^(\w\w\w*?_\w\w*?_\w\w*?)=/) + { + $msg = $1; + $found = `grep -il $msg @compiler_src`; + if ($found) { + print stderr "$msg\n"; + print FOUND $msg . "\n"; + } + else { + print stderr "NOT FOUND \t $msg\n"; + print NOT_FOUND $msg . "\n"; + } + } +} + +close(IN); +close(FOUND); +close(NOT_FOUND); diff --git a/closures/compiler/utils/ppudump.pp b/closures/compiler/utils/ppudump.pp new file mode 100644 index 0000000000..a5a8c9e3c3 --- /dev/null +++ b/closures/compiler/utils/ppudump.pp @@ -0,0 +1,3034 @@ +{ + Copyright (c) 1998-2002 by the FPC Development Team + + Dumps the contents of a FPC unit file (PPU File) + + 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. + + ****************************************************************************} +program ppudump; + +{$mode objfpc} +{$H+} + +{$define IN_PPUDUMP} +uses + { do NOT add symconst or globtype to make merging easier } + { do include symconst and globtype now before splitting 2.5 PM 2011-06-15 } + SysUtils, + constexp, + symconst, + ppu, + systems, + globals, + globtype, + widestr, + tokens; + +const + Version = 'Version 2.5.1'; + Title = 'PPU-Analyser'; + Copyright = 'Copyright (c) 1998-2010 by the Free Pascal Development Team'; + +{ verbosity } + v_none = $0; + v_header = $1; + v_defs = $2; + v_syms = $4; + v_interface = $8; + v_implementation = $10; +// v_browser = $20; + v_all = $ff; + +{ not needed anymore $i systems.inc } + +{ List of all supported cpus } +const + CpuTxt : array[tsystemcpu] of string[9]= + ( + { 0 } 'none', + { 1 } 'i386', + { 2 } 'm68k', + { 3 } 'alpha', + { 4 } 'powerpc', + { 5 } 'sparc', + { 6 } 'vis', + { 7 } 'ia64', + { 8 } 'x86_64', + { 9 } 'mips', + { 10 } 'arm', + { 11 } 'powerpc64', + { 12 } 'avr', + { 13 } 'mipsel' + ); + +{ List of all supported system-cpu couples } +const + Targets : array[tsystem] of string[18]=( + { 0 } 'none', + { 1 } 'GO32V1 (obsolete)', + { 2 } 'GO32V2', + { 3 } 'Linux-i386', + { 4 } 'OS/2', + { 5 } 'Win32', + { 6 } 'FreeBSD-i386', + { 7 } 'Amiga', + { 8 } 'Atari', + { 9 } 'MacOS-m68k', + { 10 } 'Linux-m68k', + { 11 } 'PalmOS-m68k', + { 12 } 'Linux-alpha', + { 13 } 'Linux-ppc', + { 14 } 'MacOS-ppc', + { 15 } 'Solaris-i386', + { 16 } 'BeOS-i386', + { 17 } 'NetBSD-i386', + { 18 } 'NetBSD-m68k', + { 19 } 'Netware-i386-clib', + { 20 } 'Qnx-i386', + { 21 } 'WDOSX-i386', + { 22 } 'Solaris-sparc', + { 23 } 'Linux-sparc', + { 24 } 'OpenBSD-i386', + { 25 } 'OpenBSD-m68k', + { 26 } 'Linux-x86-64', + { 27 } 'MacOSX-ppc', + { 28 } 'OS/2 via EMX', + { 29 } 'NetBSD-powerpc', + { 30 } 'OpenBSD-powerpc', + { 31 } 'Linux-arm', + { 32 } 'Watcom-i386', + { 33 } 'MorphOS-powerpc', + { 34 } 'FreeBSD-x86-64', + { 35 } 'Netware-i386-libc', + { 36 } 'Amiga-PowerPC', + { 37 } 'Win64-x64', + { 38 } 'WinCE-ARM', + { 39 } 'Win64-iA64', + { 40 } 'WinCE-i386', + { 41 } 'Linux-x64', + { 42 } 'GBA-arm', + { 43 } 'Linux-powerpc64', + { 44 } 'Darwin-i386', + { 45 } 'PalmOS-arm', + { 46 } 'MacOSX-powerpc64', + { 47 } 'NDS-arm', + { 48 } 'Embedded-i386', + { 49 } 'Embedded-m68k', + { 50 } 'Embedded-alpha', + { 51 } 'Embedded-powerpc', + { 52 } 'Embedded-sparc', + { 53 } 'Embedded-vm', + { 54 } 'Embedded-iA64', + { 55 } 'Embedded-x64', + { 56 } 'Embedded-mips', + { 57 } 'Embedded-arm', + { 58 } 'Embedded-powerpc64', + { 59 } 'Symbian-i386', + { 60 } 'Symbian-arm', + { 61 } 'MacOSX-x64', + { 62 } 'Embedded-avr', + { 63 } 'Haiku-i386', + { 64 } 'Darwin-ARM', + { 65 } 'Solaris-x86-64', + { 66 } 'Linux-MIPS', + { 67 } 'Linux-MIPSel', + { 68 } 'NativeNT-i386', + { 69 } 'iPhoneSim-i386', + { 70 } 'Wii-powerpc' + ); + +const +{ in widestr, we have the following definition + type + tcompilerwidechar = word; + thus widecharsize seems to always be 2 bytes } + + widecharsize : longint = 2; + cpu : tsystemcpu = cpu_no; + +{ This type is defined in scanner.pas unit } +type + tspecialgenerictoken = ( + ST_LOADSETTINGS, + ST_LINE, + ST_COLUMN, + ST_FILEINDEX, + ST_LOADMESSAGES); + + +var + ppufile : tppufile; + ppuversion : dword; + space : string; + verbose : longint; + derefdata : pbyte; + derefdatalen : longint; + + +{**************************************************************************** + Helper Routines +****************************************************************************} + +{**************************************************************************** + Routine to read 80-bit reals +**************************************************************************** +} +type + TSplit80bitReal = packed record + case byte of + 0: (bytes: Array[0..9] of byte); + 1: (words: Array[0..4] of word); + 2: (cards: Array[0..1] of cardinal; w: word); + end; +const + maxDigits = 17; + function Real80bitToStr(var e : TSplit80bitReal) : string; + var + Temp : string; + new : TSplit80bitReal; + fraczero, expmaximal, sign, outside_double : boolean; + exp : smallint; + ext : extended; + d : double; + i : longint; + mantval : qword; + begin + if ppufile.change_endian then + begin + for i:=0 to 9 do + new.bytes[i]:=e.bytes[9-i]; + e:=new; + end; + if sizeof(ext)=10 then + begin + ext:=pextended(@e)^; + str(ext,result); + exit; + end; + { extended, format (MSB): 1 Sign bit, 15 bit exponent, 64 bit mantissa } + sign := (e.w and $8000) <> 0; + expMaximal := (e.w and $7fff) = 32767; + exp:=(e.w and $7fff) - 16383 - 63; + fraczero := (e.cards[0] = 0) and + ((e.cards[1] and $7fffffff) = 0); + mantval := qword(e.cards[0]) or (qword(e.cards[1]) shl 32); + if expMaximal then + if fraczero then + if sign then + temp := '-Inf' + else temp := '+Inf' + else temp := 'Nan' + else + begin + d:=double(mantval); + if sign then + d:=-d; + outside_double:=false; + Try + if exp > 0 then + begin + for i:=1 to exp do + d:=d *2.0; + end + else if exp < 0 then + begin + for i:=1 to -exp do + d:=d /2.0; + end; + Except + outside_double:=true; + end; + if (mantval<>0) and (d=0.0) then + outside_double:=true; + if outside_double then + Temp:='Extended value outside double bound' + else + system.str(d,temp); + + end; + + result:=temp; + end; + +const has_errors : boolean = false; + has_more_infos : boolean = false; + +Procedure HasMoreInfos; +begin + Writeln('!! Entry has more information stored'); + has_more_infos:=true; +end; + +Procedure WriteError(const S : string); +Begin + Writeln(S); + has_errors:=true; +End; + +function Unknown(const st : string; val :longint) : string; +Begin + Unknown:='<!! Unknown'+st+' value '+tostr(val)+'>'; + has_errors:=true; +end; + +function ToStr(w:longint):String; +begin + Str(w,ToStr); +end; + +Function Target2Str(w:longint):string; +begin + if w<=ord(high(tsystem)) then + Target2Str:=Targets[tsystem(w)] + else + Target2Str:=Unknown('target',w); +end; + + +Function Cpu2Str(w:longint):string; +begin + if w<=ord(high(tsystemcpu)) then + begin + cpu:=tsystemcpu(w); + Cpu2Str:=CpuTxt[cpu]; + end + else + Cpu2Str:=Unknown('cpu',w); +end; + + +Function Varspez2Str(w:longint):string; +const + { in symconst unit + tvarspez = (vs_value,vs_const,vs_var,vs_out,vs_constref); } + varspezstr : array[tvarspez] of string[6]=('Value','Const','Var','Out','Hidden'); +begin + if w<=ord(high(varspezstr)) then + Varspez2Str:=varspezstr[tvarspez(w)] + else + Varspez2Str:=Unknown('varspez',w); +end; + +Function VarRegable2Str(w:longint):string; + { tvarregable type is defined in symconst unit } +const + varregableStr : array[tvarregable] of string[6]=('None','IntReg','FPUReg','MMReg','Addr'); +begin + if w<=ord(high(varregablestr)) then + Varregable2Str:=varregablestr[tvarregable(w)] + else + Varregable2Str:=Unknown('regable',w); +end; + + +Function Visibility2Str(w:longint):string; +const + { tvisibility type is defined in symconst unit } + + visibilityName : array[tvisibility] of string[16] = ( + 'hidden','strict private','private','strict protected','protected', + 'public','published' + ); +begin + if w<=ord(high(visibilityName)) then + result:=visibilityName[tvisibility(w)] + else + result:=Unknown('visibility',w); +end; + + +function PPUFlags2Str(flags:longint):string; +type + tflagopt=record + mask : longint; + str : string[30]; + end; +const + flagopts=24; + flagopt : array[1..flagopts] of tflagopt=( + (mask: $1 ;str:'init'), + (mask: $2 ;str:'final'), + (mask: $4 ;str:'big_endian'), + (mask: $8 ;str:'dbx'), +// (mask: $10 ;str:'browser'), + (mask: $20 ;str:'in_library'), + (mask: $40 ;str:'smart_linked'), + (mask: $80 ;str:'static_linked'), + (mask: $100 ;str:'shared_linked'), +// (mask: $200 ;str:'local_browser'), + (mask: $400 ;str:'no_link'), + (mask: $800 ;str:'has_resources'), + (mask: $1000 ;str:'little_endian'), + (mask: $2000 ;str:'release'), + (mask: $4000 ;str:'local_threadvars'), + (mask: $8000 ;str:'fpu_emulation_on'), + (mask: $210000 ;str:'has_debug_info'), + (mask: $10000 ;str:'stabs_debug_info'), + (mask: $200000 ;str:'dwarf_debug_info'), + (mask: $20000 ;str:'local_symtable'), + (mask: $40000 ;str:'uses_variants'), + (mask: $80000 ;str:'has_resourcefiles'), + (mask: $100000 ;str:'has_exports'), + (mask: $400000 ;str:'has_wideinits'), + (mask: $800000 ;str:'has_classinits'), + (mask: $1000000 ;str:'has_resstrinits') + ); +var + i,ntflags : longint; + first : boolean; + s : string; +begin + s:=''; + if flags<>0 then + begin + ntflags:=flags; + first:=true; + for i:=1to flagopts do + if (flags and flagopt[i].mask)<>0 then + begin + if first then + first:=false + else + s:=s+', '; + s:=s+flagopt[i].str; + ntflags:=ntflags and (not flagopt[i].mask); + end; + end + else + s:='none'; + if ntflags<>0 then + begin + s:=s+' unknown '+hexstr(ntflags,8); + has_errors:=true; + end; + PPUFlags2Str:=s; +end; + + + Function L0(l:longint):string; + { + return the string of value l, if l<10 then insert a zero, so + the string is always at least 2 chars '01','02',etc + } + var + s : string; + begin + Str(l,s); + if l<10 then + s:='0'+s; + L0:=s; + end; + + + function filetimestring( t : longint) : string; + { + convert dos datetime t to a string YY/MM/DD HH:MM:SS + } + var + DT : TDateTime; + hsec : word; + Year,Month,Day: Word; + hour,min,sec : word; + begin + if t=-1 then + begin + Result := 'Not Found'; + has_errors:=true; + exit; + end; + DT := FileDateToDateTime(t); + DecodeTime(DT,hour,min,sec,hsec); + DecodeDate(DT,year,month,day); + Result := L0(Year)+'/'+L0(Month)+'/'+L0(Day)+' '+L0(Hour)+':'+L0(min)+':'+L0(sec); + end; + + +{**************************************************************************** + Read Routines +****************************************************************************} + +procedure readrecsymtableoptions; +var + usefieldalignment : shortint; +begin + if ppufile.readentry<>ibrecsymtableoptions then + begin + has_errors:=true; + exit; + end; + writeln(space,' recordalignment: ',shortint(ppufile.getbyte)); + usefieldalignment:=shortint(ppufile.getbyte); + writeln(space,' usefieldalignment: ',usefieldalignment); + if (usefieldalignment=C_alignment) then + writeln(space,' fieldalignment: ',shortint(ppufile.getbyte)); +end; + +procedure readsymtableoptions(const s: string); +type + tsymtblopt=record + mask : tsymtableoption; + str : string[30]; + end; +const + symtblopts=ord(high(tsymtableoption)) + 1; + symtblopt : array[1..symtblopts] of tsymtblopt=( + (mask:sto_has_helper; str:'Has helper') + ); +var + options : tsymtableoptions; + first : boolean; + i : integer; +begin + if ppufile.readentry<>ibsymtableoptions then + begin + has_errors:=true; + exit; + end; + ppufile.getsmallset(options); + if space<>'' then + writeln(space,'------ ',s,' ------'); + write(space,'Symtable options: '); + if options<>[] then + begin + first:=true; + for i:=1 to symtblopts do + if (symtblopt[i].mask in options) then + begin + if first then + first:=false + else + write(', '); + write(symtblopt[i].str); + end; + end + else + write('none'); + writeln; +end; + +procedure readdefinitions(const s:string); forward; +procedure readsymbols(const s:string); forward; + +procedure readsymtable(const s: string); +begin + readsymtableoptions(s); + readdefinitions(s); + readsymbols(s); +end; + +Procedure ReadLinkContainer(const prefix:string); +{ + Read a serie of strings and write to the screen starting every line + with prefix +} + function maskstr(m:longint):string; + { link options are in globtype unit + const + link_none = $0; + link_always = $1; + link_static = $2; + link_smart = $4; + link_shared = $8; } + var + s : string; + begin + s:=''; + if (m and link_always)<>0 then + s:=s+'always '; + if (m and link_static)<>0 then + s:=s+'static '; + if (m and link_smart)<>0 then + s:=s+'smart '; + if (m and link_shared)<>0 then + s:=s+'shared '; + maskstr:=s; + end; + +var + s : string; + m : longint; +begin + while not ppufile.endofentry do + begin + s:=ppufile.getstring; + m:=ppufile.getlongint; + WriteLn(prefix,s,' (',maskstr(m),')'); + end; +end; + + +Procedure ReadContainer(const prefix:string); +{ + Read a serie of strings and write to the screen starting every line + with prefix +} +begin + while not ppufile.endofentry do + WriteLn(prefix,ppufile.getstring); +end; + + +procedure ReadLoadUnit; +var + ucrc,uintfcrc, indcrc : cardinal; +begin + while not ppufile.EndOfEntry do + begin + write('Uses unit: ',ppufile.getstring); + ucrc:=cardinal(ppufile.getlongint); + uintfcrc:=cardinal(ppufile.getlongint); + indcrc:=cardinal(ppufile.getlongint); + writeln(' (Crc: ',hexstr(ucrc,8),', IntfcCrc: ',hexstr(uintfcrc,8),', IndCrc: ',hexstr(indcrc,8),')'); + end; +end; + + +Procedure ReadDerefmap; +var + i,mapsize : longint; +begin + mapsize:=ppufile.getlongint; + writeln('DerefMapsize: ',mapsize); + for i:=0 to mapsize-1 do + writeln('DerefMap[',i,'] = ',ppufile.getstring); +end; + + +Procedure ReadImportSymbols; +var + extlibname : string; + j, + extsymcnt : longint; + extsymname : string; + extsymmangledname : string; + extsymordnr : longint; + extsymisvar : boolean; +begin + while not ppufile.endofentry do + begin + extlibname:=ppufile.getstring; + extsymcnt:=ppufile.getlongint; + writeln('External Library: ',extlibname,' (',extsymcnt,' imports)'); + for j:=0 to extsymcnt-1 do + begin + extsymname:=ppufile.getstring; + if ppuversion>130 then + extsymmangledname:=ppufile.getstring + else + extsymmangledname:=extsymname; + extsymordnr:=ppufile.getlongint; + extsymisvar:=ppufile.getbyte<>0; + writeln(' ',extsymname,' as ',extsymmangledname, + '(OrdNr: ',extsymordnr,' IsVar: ',extsymisvar,')'); + end; + end; +end; + + +Procedure ReadDerefdata; +begin + derefdatalen:=ppufile.entrysize; + if derefdatalen=0 then + begin + WriteError('!! Error: derefdatalen=0'); + exit; + end; + Writeln('Derefdata length: ',derefdatalen); + derefdata:=allocmem(derefdatalen); + ppufile.getdata(derefdata^,derefdatalen); +end; + +Procedure FreeDerefdata; +begin + if assigned(derefdata) then + begin + FreeMem(derefdata); + derefdata:=nil; + derefdatalen:=0; + end; +end; + + +Procedure ReadWpoFileInfo; +begin + Writeln('Compiled with input whole-program optimisation from ',ppufile.getstring,' ',filetimestring(ppufile.getlongint)); +end; + + +Procedure ReadAsmSymbols; +type + { Copied from aasmbase.pas } + TAsmsymbind=( + AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL,AB_WEAK_EXTERNAL, + { global in the current program/library, but not visible outside it } + AB_PRIVATE_EXTERN,AB_LAZY,AB_IMPORT); + + TAsmsymtype=( + AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION,AT_LABEL, + { + the address of this code label is taken somewhere in the code + so it must be taken care of it when creating pic + } + AT_ADDR + ); + +var + s, + bindstr, + typestr : string; + i : longint; +begin + writeln(space,'Number of AsmSymbols: ',ppufile.getlongint); + i:=0; + while (not ppufile.endofentry) and (not ppufile.error) do + begin + s:=ppufile.getstring; + case tasmsymbind(ppufile.getbyte) of + AB_EXTERNAL : + bindstr:='External'; + AB_COMMON : + bindstr:='Common'; + AB_LOCAL : + bindstr:='Local'; + AB_GLOBAL : + bindstr:='Global'; + AB_WEAK_EXTERNAL : + bindstr:='Weak external'; + AB_PRIVATE_EXTERN : + bindstr:='Private extern'; + AB_LAZY : + bindstr:='Lazy'; + AB_IMPORT : + bindstr:='Import'; + else + begin + bindstr:='<Error !!>'; + has_errors:=true; + end; + end; + case tasmsymtype(ppufile.getbyte) of + AT_FUNCTION : + typestr:='Function'; + AT_DATA : + typestr:='Data'; + AT_SECTION : + typestr:='Section'; + AT_LABEL : + typestr:='Label'; + AT_ADDR : + typestr:='Label (with address taken)'; + else + begin + typestr:='<Error !!>'; + has_errors:=true; + end; + end; + Writeln(space,' ',i,' : ',s,' [',bindstr,',',typestr,']'); + inc(i); + end; +end; + +function getexprint:Tconstexprint; + +begin + getexprint.overflow:=false; + getexprint.signed:=boolean(ppufile.getbyte); + getexprint.svalue:=ppufile.getint64; +end; + +Procedure ReadPosInfo; +var + info : byte; + fileindex,line,column : longint; +begin + with ppufile do + begin + { + info byte layout in bits: + 0-1 - amount of bytes for fileindex + 2-3 - amount of bytes for line + 4-5 - amount of bytes for column + } + info:=getbyte; + case (info and $03) of + 0 : fileindex:=getbyte; + 1 : fileindex:=getword; + 2 : fileindex:=(getbyte shl 16) or getword; + 3 : fileindex:=getlongint; + end; + case ((info shr 2) and $03) of + 0 : line:=getbyte; + 1 : line:=getword; + 2 : line:=(getbyte shl 16) or getword; + 3 : line:=getlongint; + end; + case ((info shr 4) and $03) of + 0 : column:=getbyte; + 1 : column:=getword; + 2 : column:=(getbyte shl 16) or getword; + 3 : column:=getlongint; + end; + Writeln(fileindex,' (',line,',',column,')'); + end; +end; + + +procedure readderef(const derefspace: string); +var + b : tdereftype; + first : boolean; + idx : longint; + i,n : byte; + pdata : pbyte; +begin + if not assigned(derefdata) then + exit; + first:=true; + idx:=ppufile.getlongint; + if (idx>derefdatalen) then + begin + writeln('!! Error: Deref idx ',idx,' > ',derefdatalen); + has_errors:=true; + exit; + end; + write(derefspace,'(',idx,') '); + pdata:=@derefdata[idx]; + i:=0; + n:=pdata[i]; + inc(i); + if n<1 then + begin + WriteError('!! Error: Deref len < 1'); + exit; + end; + while (i<=n) do + begin + if not first then + write(', ') + else + first:=false; + b:=tdereftype(pdata[i]); + inc(i); + case b of + deref_nil : + write('Nil'); + deref_symid : + begin + idx:=pdata[i] shl 24 or pdata[i+1] shl 16 or pdata[i+2] shl 8 or pdata[i+3]; + inc(i,4); + write('SymId ',idx); + end; + deref_defid : + begin + idx:=pdata[i] shl 24 or pdata[i+1] shl 16 or pdata[i+2] shl 8 or pdata[i+3]; + inc(i,4); + write('DefId ',idx); + end; + deref_unit : + begin + idx:=pdata[i] shl 8 or pdata[i+1]; + inc(i,2); + write('Unit ',idx); + end; + else + begin + writeln('!! unsupported dereftyp: ',ord(b)); + has_errors:=true; + break; + end; + end; + end; + writeln; +end; + + +procedure readpropaccesslist(const s:string); +{ type tsltype is in symconst unit } +const + slstr : array[tsltype] of string[12] = ( + '', + 'load', + 'call', + 'subscript', + 'vec', + 'typeconv', + 'absolutetype' + ); +var + sl : tsltype; +begin + readderef(''); + repeat + sl:=tsltype(ppufile.getbyte); + if sl=sl_none then + break; + write(s,'(',slstr[sl],') '); + case sl of + sl_call, + sl_load, + sl_subscript : + readderef(''); + sl_absolutetype, + sl_typeconv : + readderef(''); + sl_vec : + begin + writeln(ppufile.getlongint); + readderef(''); + end; + end; + until false; +end; + +(* + talignmentinfo = packed record + procalign, + loopalign, + jumpalign, + constalignmin, + constalignmax, + varalignmin, + varalignmax, + localalignmin, + localalignmax, + recordalignmin, + recordalignmax, + maxCrecordalign : longint; + end; + + + tsettings = packed record + alignment : talignmentinfo; + globalswitches : tglobalswitches; + moduleswitches : tmoduleswitches; + localswitches : tlocalswitches; + modeswitches : tmodeswitches; + optimizerswitches : toptimizerswitches; + { generate information necessary to perform these wpo's during a subsequent compilation } + genwpoptimizerswitches: twpoptimizerswitches; + { perform these wpo's using information generated during a previous compilation } + dowpoptimizerswitches: twpoptimizerswitches; + debugswitches : tdebugswitches; + { 0: old behaviour for sets <=256 elements + >0: round to this size } + setalloc, + packenum : shortint; + + packrecords : shortint; + maxfpuregisters : shortint; + + cputype, + optimizecputype : tcputype; + fputype : tfputype; + asmmode : tasmmode; + interfacetype : tinterfacetypes; + defproccall : tproccalloption; + sourcecodepage : tcodepagestring; + + minfpconstprec : tfloattype; + + disabledircache : boolean; + + { CPU targets with microcontroller support can add a controller specific unit } +{$if defined(ARM) or defined(AVR)} + controllertype : tcontrollertype; +{$endif defined(ARM) or defined(AVR)} + { WARNING: this pointer cannot be written as such in record token } + pmessage : pmessagestaterecord; + end; + +*) +procedure readprocinfooptions(space : string); +(* + tprocinfoflag=( + { procedure has at least one assembler block } + pi_has_assembler_block, + { procedure does a call } + pi_do_call, + { procedure has a try statement = no register optimization } + pi_uses_exceptions, + { procedure is declared as @var(assembler), don't optimize} + pi_is_assembler, + { procedure contains data which needs to be finalized } + pi_needs_implicit_finally, + { procedure has the implicit try..finally generated } + pi_has_implicit_finally, + { procedure uses fpu} + pi_uses_fpu, + { procedure uses GOT for PIC code } + pi_needs_got, + { references var/proc/type/const in static symtable, + i.e. not allowed for inlining from other units } + pi_uses_static_symtable, + { set if the procedure has to push parameters onto the stack } + pi_has_stackparameter, + { set if the procedure has at least one label } + pi_has_label, + { calls itself recursive } + pi_is_recursive, + { stack frame optimization not possible (only on x86 probably) } + pi_needs_stackframe, + { set if the procedure has at least one register saved on the stack } + pi_has_saved_regs, + { dfa was generated for this proc } + pi_dfaavailable, + { subroutine contains interprocedural used labels } + pi_has_interproclabel + ); *) + +type + tprocinfoopt=record + mask : tprocinfoflag; + str : string[80]; + end; +const + procinfoopts=ord(high(tprocinfoflag)) - ord(low(tprocinfoflag)); + procinfoopt : array[0..procinfoopts] of tprocinfoopt=( + (mask:pi_has_assembler_block; + str:' has at least one assembler block'), + (mask:pi_do_call; + str:' does a call'), + (mask:pi_uses_exceptions; + str:' has a try statement = no register optimization '), + (mask:pi_is_assembler; + str:' is declared as @var(assembler), don''t optimize'), + (mask:pi_needs_implicit_finally; + str:' contains data which needs to be finalized '), + (mask:pi_has_implicit_finally; + str:' has the implicit try..finally generated '), + (mask:pi_uses_fpu; + str:' uses fpu'), + (mask:pi_needs_got; + str:' uses GOT for PIC code '), + (mask:pi_uses_static_symtable; + str:' references var/proc/type/const in static symtable'), + (mask:pi_has_stackparameter; + str:' set if the procedure has to push parameters onto the stack '), + (mask:pi_has_label; + str:' set if the procedure has at least one label '), + (mask:pi_is_recursive; + str:' calls itself recursive '), + (mask:pi_needs_stackframe; + str:' stack frame optimization not possible (only on x86 probably) '), + (mask:pi_has_saved_regs; + str:' set if the procedure has at least one register saved on the stack '), + (mask:pi_dfaavailable; + str:' dfa was generated for this proc '), + (mask:pi_has_interproclabel; + str:' subroutine contains interprocedural used labels '), + (mask:pi_has_unwind_info; + str:' unwinding info was generated for this proc ') + ); +var + procinfooptions : tprocinfoflags; + i : longint; + first : boolean; +begin + ppufile.getsmallset(procinfooptions); + if procinfooptions<>[] then + begin + first:=true; + for i:=0 to procinfoopts do + if (procinfoopt[i].mask in procinfooptions) then + begin + if first then + first:=false + else + write(', '); + write(procinfoopt[i].str); + end; + end; + writeln; +end; + +procedure readsymoptions(space : string); +type + tsymopt=record + mask : tsymoption; + str : string[30]; + end; +const + symopts=ord(high(tsymoption)) - ord(low(tsymoption)); + { sp_none = 0 corresponds to nothing } + symopt : array[1..symopts] of tsymopt=( + (mask:sp_static; str:'Static'), + (mask:sp_hint_deprecated; str:'Hint Deprecated'), + (mask:sp_hint_platform; str:'Hint Platform'), + (mask:sp_hint_library; str:'Hint Library'), + (mask:sp_hint_unimplemented; str:'Hint Unimplemented'), + (mask:sp_hint_experimental; str:'Hint Experimental'), + (mask:sp_has_overloaded; str:'Has overloaded'), + (mask:sp_internal; str:'Internal'), + (mask:sp_implicitrename; str:'Implicit Rename'), + (mask:sp_generic_para; str:'Generic Parameter'), + (mask:sp_has_deprecated_msg; str:'Has Deprecated Message'), + (mask:sp_generic_dummy; str:'Generic Dummy') + ); +var + symoptions : tsymoptions; + i : longint; + first : boolean; +begin + ppufile.getsmallset(symoptions); + if symoptions<>[] then + begin + first:=true; + for i:=1to symopts do + if (symopt[i].mask in symoptions) then + begin + if first then + first:=false + else + write(', '); + write(symopt[i].str); + end; + end; + writeln; + if sp_has_deprecated_msg in symoptions then + writeln(space,'Deprecated : ', ppufile.getstring); +end; + + +procedure readcommonsym(const s:string); +begin + writeln(space,'** Symbol Id ',ppufile.getlongint,' **'); + writeln(space,s,ppufile.getstring); + write (space,' File Pos : '); + readposinfo; + writeln(space,' Visibility : ',Visibility2Str(ppufile.getbyte)); + write (space,' SymOptions : '); + readsymoptions(space+' '); +end; + + + +var + { needed during tobjectdef parsing... } + current_defoptions : tdefoptions; + current_objectoptions : tobjectoptions; + +procedure readcommondef(const s:string; out defoptions: tdefoptions); +type + tdefopt=record + mask : tdefoption; + str : string[30]; + end; + tdefstateinfo=record + mask : tdefstate; + str : string[30]; + end; + ptoken=^ttoken; + pmsgstate =^tmsgstate; +const + defopt : array[1..ord(high(tdefoption))] of tdefopt=( + (mask:df_unique; str:'Unique Type'), + (mask:df_generic; str:'Generic'), + (mask:df_specialization; str:'Specialization'), + (mask:df_copied_def; str:'Copied Typedef') + ); + defstate : array[1..ord(high(tdefstate))] of tdefstateinfo=( + (mask:ds_vmt_written; str:'VMT Written'), + (mask:ds_rtti_table_used; str:'RTTITable Used'), + (mask:ds_init_table_used; str:'InitTable Used'), + (mask:ds_rtti_table_written; str:'RTTITable Written'), + (mask:ds_init_table_written; str:'InitTable Written'), + (mask:ds_dwarf_dbg_info_used; str:'Dwarf DbgInfo Used'), + (mask:ds_dwarf_dbg_info_written;str:'Dwarf DbgInfo Written') + ); +var + defstates : tdefstates; + i, nb, msgvalue, mesgnb : longint; + first : boolean; + copy_size, min_size, tokenbufsize : longint; + tokenbuf : pbyte; + idtoken, + token : ttoken; + state : tmsgstate; + new_settings : Tsettings; + len : sizeint; + wstring : widestring; + astring : ansistring; + + function readtoken: ttoken; + var + b,b2 : byte; + begin + b:=tokenbuf[i]; + inc(i); + if (b and $80)<>0 then + begin + b2:=tokenbuf[i]; + inc(i); + result:=ttoken(((b and $7f) shl 8) or b2); + end + else + result:=ttoken(b); + end; + + function gettokenbufdword : dword; + var + var32 : dword; + begin + var32:=pdword(@tokenbuf[i])^; + inc(i,sizeof(dword)); + if ppufile.change_endian then + var32:=swapendian(var32); + result:=var32; + end; + + function gettokenbufword : word; + var + var16 : word; + begin + var16:=pword(@tokenbuf[i])^; + inc(i,sizeof(word)); + if ppufile.change_endian then + var16:=swapendian(var16); + result:=var16; + end; + + + function gettokenbufsizeint : int64; + var + var64 : int64; + var32 : longint; + var16 : smallint; + + begin + if CpuAddrBitSize[cpu]=64 then + begin + var64:=pint64(@tokenbuf[i])^; + inc(i,sizeof(int64)); + if ppufile.change_endian then + var64:=swapendian(var64); + result:=var64; + end + else if CpuAddrBitSize[cpu]=32 then + begin + var32:=plongint(@tokenbuf[i])^; + inc(i,sizeof(longint)); + if ppufile.change_endian then + var32:=swapendian(var32); + result:=var32; + end + else if CpuAddrBitSize[cpu]=16 then + begin + var16:=psmallint(@tokenbuf[i])^; + inc(i,sizeof(smallint)); + if ppufile.change_endian then + var16:=swapendian(var16); + result:=var16; + end + else + begin + WriteError('Wrong CpuAddrBitSize'); + result:=0; + end; + end; + +begin + writeln(space,'** Definition Id ',ppufile.getlongint,' **'); + writeln(space,s); + write (space,' Type symbol : '); + readderef(''); + write (space,' DefOptions : '); + ppufile.getsmallset(defoptions); + if defoptions<>[] then + begin + first:=true; + for i:=1to high(defopt) do + if (defopt[i].mask in defoptions) then + begin + if first then + first:=false + else + write(', '); + write(defopt[i].str); + end; + end; + writeln; + + write (space,' DefStates : '); + ppufile.getsmallset(defstates); + if defstates<>[] then + begin + first:=true; + for i:=1 to high(defstate) do + if (defstate[i].mask in defstates) then + begin + if first then + first:=false + else + write(', '); + write(defstate[i].str); + end; + end; + writeln; + + if df_generic in defoptions then + begin + tokenbufsize:=ppufile.getlongint; + writeln(space,' Tokenbuffer size : ',tokenbufsize); + tokenbuf:=allocmem(tokenbufsize); + ppufile.getdata(tokenbuf^,tokenbufsize); + i:=0; + write(space,' Tokens: '); + while i<tokenbufsize do + begin + token:=readtoken; + if token<>_GENERICSPECIALTOKEN then + begin + if token <= high(ttoken) then + write(arraytokeninfo[token].str) + else + begin + HasMoreInfos; + write('Error in Token List'); + break; + end; + idtoken:=readtoken; + end; + case token of + _CWCHAR, + _CWSTRING : + begin + len:=gettokenbufsizeint; + setlength(wstring,len); + move(tokenbuf[i],wstring[1],len*2); + write(' ',wstring); + inc(i,len*2); + end; + _CSTRING: + begin + len:=gettokenbufsizeint; + setlength(astring,len); + move(tokenbuf[i],astring[1],len); + write(' ',astring); + inc(i,len); + end; + _CCHAR, + _INTCONST, + _REALNUMBER : + begin + write(' ',pshortstring(@tokenbuf[i])^); + inc(i,tokenbuf[i]+1); + end; + _ID : + begin + write(' ',pshortstring(@tokenbuf[i])^); + inc(i,tokenbuf[i]+1); + end; + _GENERICSPECIALTOKEN: + begin + { Short version of column change, + byte or $80 used } + if (tokenbuf[i] and $80)<>0 then + begin + write('Col: ',tokenbuf[i] and $7f); + inc(i); + end + else + case tspecialgenerictoken(tokenbuf[i]) of + ST_LOADSETTINGS: + begin + inc(i); + write('Settings'); + { This does not load pmessage pointer } + new_settings.pmessage:=nil; + { TSettings size depends in target... + We first read the size of the copied part } + { Still not cross endian ready :( } + copy_size:=gettokenbufsizeint; + if copy_size < sizeof(tsettings)-sizeof(pointer) then + min_size:=copy_size + else + min_size:= sizeof(tsettings)-sizeof(pointer); + move(tokenbuf[i],new_settings, min_size); + inc(i,copy_size); + end; + ST_LOADMESSAGES: + begin + inc(i); + write('Messages:'); + mesgnb:=tokenbuf[i]; + inc(i); + for nb:=1 to mesgnb do + begin + msgvalue:=gettokenbufsizeint; + inc(i,sizeof(sizeint)); + state:=tmsgstate(gettokenbufsizeint); + end; + end; + ST_LINE: + begin + inc(i); + write('Line: ',gettokenbufdword); + end; + ST_COLUMN: + begin + inc(i); + write('Col: ',gettokenbufword); + end; + ST_FILEINDEX: + begin + inc(i); + write('File: ',gettokenbufword); + end; + end; + end; + end; + + if i<tokenbufsize then + write(','); + end; + writeln; + freemem(tokenbuf); + end; + if df_specialization in defoptions then + begin + write (space,' Orig. GenericDef : '); + readderef(''); + end; + current_defoptions:=defoptions; +end; + + +{ Read abstract procdef and return if inline procdef } +{ type tproccalloption is in globtype unit } +{ type tproctypeoption is in globtype unit } +{ type tprocoption is in globtype unit } + +procedure read_abstract_proc_def(var proccalloption:tproccalloption;var procoptions:tprocoptions); +type + tproccallopt=record + mask : tproccalloption; + str : string[30]; + end; + tproctypeopt=record + mask : tproctypeoption; + str : string[30]; + end; + tprocopt=record + mask : tprocoption; + str : string[30]; + end; +const + {proccalloptionStr is also in globtype unit } + proctypeopt : array[1..ord(high(tproctypeoption))] of tproctypeopt=( + (mask:potype_proginit; str:'ProgInit'), + (mask:potype_unitinit; str:'UnitInit'), + (mask:potype_unitfinalize; str:'UnitFinalize'), + (mask:potype_constructor; str:'Constructor'), + (mask:potype_destructor; str:'Destructor'), + (mask:potype_operator; str:'Operator'), + (mask:potype_procedure; str:'Procedure'), + (mask:potype_function; str:'Function'), + (mask:potype_class_constructor; str:'Class Constructor'), + (mask:potype_class_destructor; str:'Class Destructor'), + { Dispinterface property accessors } + (mask:potype_propgetter; str:'Property Getter'), + (mask:potype_propsetter; str:'Property Setter'), + (mask:potype_exceptfilter; str:'SEH filter') + ); + procopt : array[1..ord(high(tprocoption))] of tprocopt=( + (mask:po_classmethod; str:'ClassMethod'), + (mask:po_virtualmethod; str:'VirtualMethod'), + (mask:po_abstractmethod; str:'AbstractMethod'), + (mask:po_finalmethod; str:'FinalMethod'), + (mask:po_staticmethod; str:'StaticMethod'), + (mask:po_overridingmethod;str:'OverridingMethod'), + (mask:po_methodpointer; str:'MethodPointer'), + (mask:po_interrupt; str:'Interrupt'), + (mask:po_iocheck; str:'IOCheck'), + (mask:po_assembler; str:'Assembler'), + (mask:po_msgstr; str:'MsgStr'), + (mask:po_msgint; str:'MsgInt'), + (mask:po_exports; str:'Exports'), + (mask:po_external; str:'External'), + (mask:po_overload; str:'Overload'), + (mask:po_varargs; str:'VarArgs'), + (mask:po_internconst; str:'InternConst'), + (mask:po_addressonly; str:'AddressOnly'), + (mask:po_public; str:'Public'), + (mask:po_hascallingconvention;str:'HasCallingConvention'), + (mask:po_reintroduce; str:'ReIntroduce'), + (mask:po_explicitparaloc; str:'ExplicitParaloc'), + (mask:po_nostackframe; str:'NoStackFrame'), + (mask:po_has_mangledname; str:'HasMangledName'), + (mask:po_has_public_name; str:'HasPublicName'), + (mask:po_forward; str:'Forward'), + (mask:po_global; str:'Global'), + (mask:po_has_inlininginfo;str:'HasInliningInfo'), + (mask:po_syscall_legacy; str:'SyscallLegacy'), + (mask:po_syscall_sysv; str:'SyscallSysV'), + (mask:po_syscall_basesysv;str:'SyscallBaseSysV'), + (mask:po_syscall_sysvbase;str:'SyscallSysVBase'), + (mask:po_syscall_r12base; str:'SyscallR12Base'), + (mask:po_inline; str:'Inline'), + (mask:po_compilerproc; str:'CompilerProc'), + (mask:po_has_importdll; str:'HasImportDLL'), + (mask:po_has_importname; str:'HasImportName'), + (mask:po_kylixlocal; str:'KylixLocal'), + (mask:po_dispid; str:'DispId'), + (mask:po_weakexternal; str:'WeakExternal'), + (mask:po_objc; str:'ObjC'), + (mask:po_enumerator_movenext; str:'EnumeratorMoveNext'), + (mask:po_optional; str: 'Optional'), + (mask:po_delphi_nested_cc;str: 'Delphi-style nested frameptr'), + (mask:po_rtlproc; str: 'RTL procedure') + ); +var + proctypeoption : tproctypeoption; + i : longint; + first : boolean; + tempbuf : array[0..255] of byte; +begin + write(space,' Return type : '); + readderef(''); + writeln(space,' Fpu used : ',ppufile.getbyte); + proctypeoption:=tproctypeoption(ppufile.getbyte); + write(space,' TypeOption : '); + first:=true; + for i:=1 to high(proctypeopt) do + if (proctypeopt[i].mask=proctypeoption) then + begin + if first then + first:=false + else + write(', '); + write(proctypeopt[i].str); + end; + writeln; + proccalloption:=tproccalloption(ppufile.getbyte); + writeln(space,' CallOption : ',proccalloptionStr[proccalloption]); + ppufile.getnormalset(procoptions); + if procoptions<>[] then + begin + write(space,' Options : '); + first:=true; + for i:=1 to high(procopt) do + if (procopt[i].mask in procoptions) then + begin + if first then + first:=false + else + write(', '); + write(procopt[i].str); + end; + writeln; + end; + if (po_explicitparaloc in procoptions) then + begin + i:=ppufile.getbyte; + ppufile.getdata(tempbuf,i); + end; +end; + + +{ type tvaroption is in unit symconst } + { register variable } +{ type tvarregable is in unit symconst } +procedure readabstractvarsym(const s:string;var varoptions:tvaroptions); +type + tvaropt=record + mask : tvaroption; + str : string[30]; + end; +const + varopt : array[1..ord(high(tvaroption))] of tvaropt=( + (mask:vo_is_external; str:'External'), + (mask:vo_is_dll_var; str:'DLLVar'), + (mask:vo_is_thread_var; str:'ThreadVar'), + (mask:vo_has_local_copy; str:'HasLocalCopy'), + (mask:vo_is_const; str:'Constant'), + (mask:vo_is_public; str:'Public'), + (mask:vo_is_high_para; str:'HighValue'), + (mask:vo_is_funcret; str:'Funcret'), + (mask:vo_is_self; str:'Self'), + (mask:vo_is_vmt; str:'VMT'), + (mask:vo_is_result; str:'Result'), + (mask:vo_is_parentfp; str:'ParentFP'), + (mask:vo_is_loop_counter; str:'LoopCounter'), + (mask:vo_is_hidden_para; str:'Hidden'), + (mask:vo_has_explicit_paraloc;str:'ExplicitParaloc'), + (mask:vo_is_syscall_lib; str:'SysCallLib'), + (mask:vo_has_mangledname; str:'HasMangledName'), + (mask:vo_is_typed_const; str:'TypedConst'), + (mask:vo_is_range_check; str:'RangeCheckSwitch'), + (mask:vo_is_overflow_check; str:'OverflowCheckSwitch'), + (mask:vo_is_typinfo_para; str:'TypeInfo'), + (mask:vo_is_msgsel;str:'MsgSel'), + (mask:vo_is_weak_external;str:'WeakExternal'), + (mask:vo_is_first_field;str:'IsFirstField'), + (mask:vo_volatile;str:'Volatile'), + (mask:vo_has_section;str:'HasSection'), + (mask:vo_force_finalize;str:'ForceFinalize') + ); +var + i : longint; + first : boolean; +begin + readcommonsym(s); + writeln(space,' Spez : ',Varspez2Str(ppufile.getbyte)); + writeln(space,' Regable : ',Varregable2Str(ppufile.getbyte)); + writeln(space,' Addr Taken : ',(ppufile.getbyte<>0)); + write (space,' Var Type : '); + readderef(''); + ppufile.getsmallset(varoptions); + if varoptions<>[] then + begin + write(space,' Options : '); + first:=true; + for i:=1 to high(varopt) do + if (varopt[i].mask in varoptions) then + begin + if first then + first:=false + else + write(', '); + write(varopt[i].str); + if varopt[i].mask = vo_has_section then + writeln('Section name:',ppufile.getansistring); + end; + writeln; + end; +end; + + +procedure readobjectdefoptions; +type + tsymopt=record + mask : tobjectoption; + str : string[30]; + end; +const + symopt : array[1..ord(high(tobjectoption))] of tsymopt=( + (mask:oo_is_forward; str:'IsForward'), + (mask:oo_is_abstract; str:'IsAbstract'), + (mask:oo_is_sealed; str:'IsSealed'), + (mask:oo_has_virtual; str:'HasVirtual'), + (mask:oo_has_private; str:'HasPrivate'), + (mask:oo_has_protected; str:'HasProtected'), + (mask:oo_has_strictprivate; str:'HasStrictPrivate'), + (mask:oo_has_strictprotected;str:'HasStrictProtected'), + (mask:oo_has_constructor; str:'HasConstructor'), + (mask:oo_has_destructor; str:'HasDestructor'), + (mask:oo_has_vmt; str:'HasVMT'), + (mask:oo_has_msgstr; str:'HasMsgStr'), + (mask:oo_has_msgint; str:'HasMsgInt'), + (mask:oo_can_have_published; str:'CanHavePublished'), + (mask:oo_has_default_property;str:'HasDefaultProperty'), + (mask:oo_has_valid_guid; str:'HasValidGUID'), + (mask:oo_has_enumerator_movenext; str:'HasEnumeratorMoveNext'), + (mask:oo_has_enumerator_current; str:'HasEnumeratorCurrent'), + (mask:oo_is_external; str:'External'), + (mask:oo_is_formal; str:'Formal'), + (mask:oo_is_classhelper; str:'Class Helper/Category'), + (mask:oo_has_class_constructor; str:'HasClassConstructor'), + (mask:oo_has_class_destructor; str:'HasClassDestructor') + ); +var + i : longint; + first : boolean; +begin + ppufile.getsmallset(current_objectoptions); + if current_objectoptions<>[] then + begin + first:=true; + for i:=1 to high(symopt) do + if (symopt[i].mask in current_objectoptions) then + begin + if first then + first:=false + else + write(', '); + write(symopt[i].str); + end; + end; + writeln; +end; + + +procedure readarraydefoptions; +{ type tarraydefoption is in unit symconst } +type + tsymopt=record + mask : tarraydefoption; + str : string[30]; + end; +const + symopt : array[1..ord(high(tarraydefoption))] of tsymopt=( + (mask:ado_IsConvertedPointer;str:'ConvertedPointer'), + (mask:ado_IsDynamicArray; str:'IsDynamicArray'), + (mask:ado_IsVariant; str:'IsVariant'), + (mask:ado_IsConstructor; str:'IsConstructor'), + (mask:ado_IsArrayOfConst; str:'ArrayOfConst'), + (mask:ado_IsConstString; str:'ConstString'), + (mask:ado_IsBitPacked; str:'BitPacked') + ); +var + symoptions : tarraydefoptions; + i : longint; + first : boolean; +begin + ppufile.getsmallset(symoptions); + if symoptions<>[] then + begin + first:=true; + for i:=1 to high(symopt) do + if (symopt[i].mask in symoptions) then + begin + if first then + first:=false + else + write(', '); + write(symopt[i].str); + end; + end; + writeln; +end; + +(* options for properties + tpropertyoption=(ppo_none, + ppo_indexed, + ppo_defaultproperty, + ppo_stored, + ppo_hasparameters, + ppo_implements, + ppo_enumerator_current, + ppo_overrides, + ppo_dispid_write { no longer used } + ); + tpropertyoptions=set of tpropertyoption; +*) +function readpropertyoptions:tpropertyoptions; +{ type tarraydefoption is in unit symconst } +type + tpropopt=record + mask : tpropertyoption; + str : string[30]; + end; +const + symopt : array[1..ord(high(tpropertyoption))] of tpropopt=( + (mask:ppo_indexed;str:'indexed'), + (mask:ppo_defaultproperty;str:'default'), + (mask:ppo_stored;str:'stored'), + (mask:ppo_hasparameters;str:'has parameters'), + (mask:ppo_implements;str:'implements'), + (mask:ppo_enumerator_current;str:'enumerator current'), + (mask:ppo_overrides;str:'overrides'), + (mask:ppo_dispid_write;str:'dispid write') { no longer used } + ); +var + i : longint; + first : boolean; +begin + ppufile.getsmallset(result); + if result<>[] then + begin + first:=true; + for i:=1 to high(symopt) do + if (symopt[i].mask in result) then + begin + if first then + first:=false + else + write(', '); + write(symopt[i].str); + end; + end; + writeln; +end; + + +procedure readnodetree; +var + l : longint; + p : pointer; +begin + with ppufile do + begin + if space<>'' then + Writeln(space,'------ nodetree ------'); + if readentry=ibnodetree then + begin + l:=entrysize; + Writeln(space,'Tree size : ',l); + { Read data to prevent error that entry is not completly read } + getmem(p,l); + getdata(p^,l); + freemem(p); + end + else + begin + WriteError('!! ibnodetree not found'); + end; + end; +end; + + +procedure ReadCreatedObjTypes; +var + i,j, + len, + bssize: longint; + bs: pbyte; +begin + if ppufile.readentry<>ibcreatedobjtypes then + begin + writeln('!! ibcreatedobjtypes entry not found'); + ppufile.skipdata(ppufile.entrysize); + has_errors:=true; + exit + end; + writeln; + writeln(space,'WPO info'); + writeln(space,'--------'); + + len:=ppufile.getlongint; + writeln(space,'** Instantiated Object/Class types: ',len,' **'); + space:=space+' '; + for i:=0 to len-1 do + readderef(space); + setlength(space,length(space)-2); + + len:=ppufile.getlongint; + writeln(space,'** Instantiated ClassRef types: ',len,' **'); + space:=space+' '; + for i:=0 to len-1 do + readderef(space); + setlength(space,length(space)-2); + + len:=ppufile.getlongint; + writeln(space,'** Possibly instantiated ClassRef types : ',len,' **'); + space:=space+' '; + for i:=0 to len-1 do + readderef(space); + setlength(space,length(space)-2); + + len:=ppufile.getlongint; + writeln(space,'** Class types with called virtual methods info : ',len,' **'); + space:=space+' '; + for i:=0 to len-1 do + begin + write(space,'Class def : '); + readderef(''); + write(space+' ','Called vmtentries : '); + bssize:=ppufile.getlongint; + getmem(bs,bssize); + ppufile.readdata(bs^,bssize); + for j:=0 to bssize*8-1 do + if (((bs+j shr 3)^ shr (j and 7)) and 1) <> 0 then + write(j,', '); + writeln; + freemem(bs); + end; + setlength(space,length(space)-2); +end; + +{**************************************************************************** + Read Symbols Part +****************************************************************************} + +procedure readsymbols(const s:string); +type + pguid = ^tguid; + tguid = packed record + D1: LongWord; + D2: Word; + D3: Word; + D4: array[0..7] of Byte; + end; + +var + b : byte; + pc : pchar; + ch : dword; + startnewline : boolean; + i,j,len : longint; + prettyname : ansistring; + guid : tguid; + realvalue : ppureal; + doublevalue : double; + singlevalue : single; + extended : TSplit80bitReal; + tempbuf : array[0..127] of char; + pw : pcompilerwidestring; + varoptions : tvaroptions; + propoptions : tpropertyoptions; +begin + with ppufile do + begin + if space<>'' then + Writeln(space,'------ ',s,' ------'); + if readentry=ibstartsyms then + begin + Writeln(space,'Symtable datasize : ',getlongint); + Writeln(space,'Symtable alignment: ',getlongint); + end + else + Writeln('!! ibstartsym not found'); + repeat + b:=readentry; + case b of + + ibunitsym : + readcommonsym('Unit symbol '); + + ibnamespacesym : + begin + readcommonsym('NameSpace symbol '); + write(space,' Hidden Unit : '); + readderef(''); + end; + + iblabelsym : + readcommonsym('Label symbol '); + + ibtypesym : + begin + readcommonsym('Type symbol '); + write(space,' Result Type : '); + readderef(''); + prettyname:=getansistring; + if prettyname<>'' then + begin + write(space,' Pretty Name : '); + Writeln(prettyname); + end; + end; + + ibprocsym : + begin + readcommonsym('Procedure symbol '); + len:=ppufile.getword; + for i:=1 to len do + begin + write(space,' Definition : '); + readderef(''); + end; + end; + + ibconstsym : + begin + readcommonsym('Constant symbol '); + b:=getbyte; + case tconsttyp(b) of + constord : + begin + write (space,' OrdinalType : '); + readderef(''); + writeln(space,' Value : ',constexp.tostr(getexprint)); + end; + constpointer : + begin + write (space,' PointerType : '); + readderef(''); + writeln(space,' Value : ',getaint) + end; + conststring, + constresourcestring : + begin + len:=getlongint; + getmem(pc,len+1); + getdata(pc^,len); + (pc+len)^:= #0; + writeln(space,' Length : ',len); + writeln(space,' Value : "',pc,'"'); + freemem(pc,len+1); + end; + constreal : + begin + write(space,' Value : '); + if entryleft=sizeof(ppureal) then + begin + realvalue:=getrealsize(sizeof(ppureal)); + writeln(realvalue); + end + else if entryleft=sizeof(double) then + begin + doublevalue:=getrealsize(sizeof(double)); + writeln(doublevalue); + end + else if entryleft=sizeof(single) then + begin + singlevalue:=getrealsize(sizeof(single)); + writeln(singlevalue); + end + else if entryleft=10 then + begin + getdata(extended,entryleft); + writeln(Real80bitToStr(extended)); + end + else + begin + realvalue:=0.0; + writeln(realvalue,' Error reading real value'); + has_errors:=true; + end; + end; + constset : + begin + write (space,' Set Type : '); + readderef(''); + for i:=1to 4 do + begin + write (space,' Value : '); + for j:=1to 8 do + begin + if j>1 then + write(','); + write(hexstr(getbyte,2)); + end; + writeln; + end; + end; + constnil: + writeln(space,' NIL pointer.'); + constwstring : + begin + initwidestring(pw); + setlengthwidestring(pw,getlongint); + if widecharsize=2 then + { don't use getdata, because the compilerwidechars may have to + be byteswapped + } + begin + for i:=0 to pw^.len-1 do + pw^.data[i]:=ppufile.getword; + end + else if widecharsize=4 then + begin + for i:=0 to pw^.len-1 do + pw^.data[i]:=cardinal(ppufile.getlongint); + end + else + begin + WriteError('Unsupported tcompilerwidechar size'); + end; + Writeln(space,'Wide string type'); + startnewline:=true; + for i:=0 to pw^.len-1 do + begin + if startnewline then + begin + write(space); + startnewline:=false; + end; + ch:=pw^.data[i]; + if widecharsize=2 then + write(hexstr(ch,4)) + else + write(hexstr(ch,8)); + if (i mod 8)= 0 then + startnewline:=true + else + write(', '); + end; + donewidestring(pw); + end; + constguid: + begin + getdata(guid,sizeof(guid)); + write (space,' IID String: {',hexstr(guid.d1,8),'-',hexstr(guid.d2,4),'-',hexstr(guid.d3,4),'-'); + for i:=0 to 7 do + begin + write(hexstr(guid.d4[i],2)); + if i=1 then write('-'); + end; + writeln('}'); + end + else + Writeln ('!! Invalid unit format : Invalid const type encountered: ',b); + end; + end; + + ibabsolutevarsym : + begin + readabstractvarsym('Absolute variable symbol ',varoptions); + Write (space,' Relocated to '); + b:=getbyte; + case absolutetyp(b) of + tovar : + readpropaccesslist(space+' Sym : '); + toasm : + Writeln('Assembler name : ',getstring); + toaddr : + begin + Write('Address : ',getlongint); + if tsystemcpu(ppufile.header.cpu)=cpu_i386 then + WriteLn(' (Far: ',getbyte<>0,')'); + end; + else + Writeln ('!! Invalid unit format : Invalid absolute type encountered: ',b); + end; + end; + + ibfieldvarsym : + begin + readabstractvarsym('Field Variable symbol ',varoptions); + writeln(space,' Address : ',getaint); + end; + + ibstaticvarsym : + begin + readabstractvarsym('Global Variable symbol ',varoptions); + write (space,' DefaultConst : '); + readderef(''); + if (vo_has_mangledname in varoptions) then + writeln(space,' Mangledname : ',getstring); + end; + + iblocalvarsym : + begin + readabstractvarsym('Local Variable symbol ',varoptions); + write (space,' DefaultConst : '); + readderef(''); + end; + + ibparavarsym : + begin + readabstractvarsym('Parameter Variable symbol ',varoptions); + write (space,' DefaultConst : '); + readderef(''); + writeln(space,' ParaNr : ',getword); + writeln(space,' Univ : ',boolean(getbyte)); + writeln(space,' VarState : ',getbyte); + if (vo_has_explicit_paraloc in varoptions) then + begin + i:=getbyte; + getdata(tempbuf,i); + end; + end; + + ibenumsym : + begin + readcommonsym('Enumeration symbol '); + write (space,' Definition : '); + readderef(''); + writeln(space,' Value : ',getlongint); + end; + + ibsyssym : + begin + readcommonsym('Internal system symbol '); + writeln(space,' Internal Nr : ',getlongint); + end; + + ibmacrosym : + begin + readcommonsym('Macro symbol '); + writeln(space,' Name: ',getstring); + writeln(space,' Defined: ',getbyte); + writeln(space,' Compiler var: ',getbyte); + len:=getlongint; + writeln(space,' Value length: ',len); + if len > 0 then + begin + getmem(pc,len+1); + getdata(pc^,len); + (pc+len)^:= #0; + writeln(space,' Value: "',pc,'"'); + freemem(pc,len+1); + end; + end; + + ibpropertysym : + begin + readcommonsym('Property '); + propoptions:=readpropertyoptions; + if ppo_overrides in propoptions then + begin + write (space,' OverrideProp : '); + readderef(''); + end; + write (space,' Prop Type : '); + readderef(''); + writeln(space,' Index : ',getlongint); + writeln(space,' Default : ',getlongint); + write (space,' Index Type : '); + readderef(''); + { palt_none } + readpropaccesslist(''); + write (space,' Readaccess : '); + readpropaccesslist(space+' Sym: '); + write (space,' Writeaccess : '); + readpropaccesslist(space+' Sym: '); + write (space,' Storedaccess : '); + readpropaccesslist(space+' Sym: '); + if [ppo_hasparameters,ppo_overrides]*propoptions=[ppo_hasparameters] then + begin + space:=' '+space; + readsymtable('parast'); + delete(space,1,4); + end; + end; + + iberror : + begin + WriteError('!! Error in PPU'); + exit; + end; + + ibendsyms : + break; + + else + begin + WriteLn('!! Skipping unsupported PPU Entry in Symbols: ',b); + has_errors:=true; + end; + end; + if not EndOfEntry then + HasMoreInfos; + until false; + end; +end; + + +{**************************************************************************** + Read defintions Part +****************************************************************************} + +procedure readdefinitions(const s:string); +{ type tordtype is in symconst unit } +{ + uvoid, + u8bit,u16bit,u32bit,u64bit, + s8bit,s16bit,s32bit,s64bit, + bool8bit,bool16bit,bool32bit,bool64bit, + uchar,uwidechar,scurrency + ); } + +{ type tobjecttyp is in symconst unit } +{ type tvarianttype is in symconst unit } +var + b : byte; + l,j : longint; + calloption : tproccalloption; + procoptions : tprocoptions; + defoptions: tdefoptions; +begin + with ppufile do + begin + if space<>'' then + Writeln(space,'------ ',s,' ------'); + if readentry<>ibstartdefs then + Writeln('!! ibstartdefs not found'); + repeat + b:=readentry; + case b of + + ibpointerdef : + begin + readcommondef('Pointer definition',defoptions); + write (space,' Pointed Type : '); + readderef(''); + writeln(space,' Is Far : ',(getbyte<>0)); + writeln(space,' Has Pointer Math : ',(getbyte<>0)); + end; + + iborddef : + begin + readcommondef('Ordinal definition',defoptions); + write (space,' Base type : '); + b:=getbyte; + case tordtype(b) of + uvoid : writeln('uvoid'); + u8bit : writeln('u8bit'); + u16bit : writeln('u16bit'); + u32bit : writeln('s32bit'); + u64bit : writeln('u64bit'); + s8bit : writeln('s8bit'); + s16bit : writeln('s16bit'); + s32bit : writeln('s32bit'); + s64bit : writeln('s64bit'); + bool8bit : writeln('bool8bit'); + bool16bit : writeln('bool16bit'); + bool32bit : writeln('bool32bit'); + bool64bit : writeln('bool64bit'); + uchar : writeln('uchar'); + uwidechar : writeln('uwidechar'); + scurrency : writeln('ucurrency'); + else writeln('!! Warning: Invalid base type ',b); + end; + writeln(space,' Range : ',constexp.tostr(getexprint),' to ',constexp.tostr(getexprint)); + end; + + ibfloatdef : + begin + readcommondef('Float definition',defoptions); + writeln(space,' Float type : ',getbyte); + end; + + ibarraydef : + begin + readcommondef('Array definition',defoptions); + write (space,' Element type : '); + readderef(''); + write (space,' Range Type : '); + readderef(''); + writeln(space,' Range : ',getaint,' to ',getaint); + write (space,' Options : '); + readarraydefoptions; + readsymtable('symbols'); + end; + + ibprocdef : + begin + readcommondef('Procedure definition',defoptions); + read_abstract_proc_def(calloption,procoptions); + if (po_has_mangledname in procoptions) then + writeln(space,' Mangled name : ',getstring); + writeln(space,' Number : ',getword); + writeln(space,' Level : ',getbyte); + write (space,' Class : '); + readderef(''); + write (space,' Procsym : '); + readderef(''); + write (space,' File Pos : '); + readposinfo; + writeln(space,' Visibility : ',Visibility2Str(ppufile.getbyte)); + write (space,' SymOptions : '); + readsymoptions(space+' '); + if tsystemcpu(ppufile.header.cpu)=cpu_powerpc then + begin + { library symbol for AmigaOS/MorphOS } + write (space,' Library symbol : '); + readderef(''); + end; + if (po_has_importdll in procoptions) then + writeln(space,' Import DLL : ',getstring); + if (po_has_importname in procoptions) then + writeln(space,' Import Name : ',getstring); + writeln(space,' Import Nr : ',getword); + if (po_msgint in procoptions) then + writeln(space,' MsgInt : ',getlongint); + if (po_msgstr in procoptions) then + writeln(space,' MsgStr : ',getstring); + if (po_dispid in procoptions) then + writeln(space,' DispID: ',ppufile.getlongint); + if (po_has_inlininginfo in procoptions) then + begin + write (space,' FuncretSym : '); + readderef(''); + readprocinfooptions(space); + end; + b:=ppufile.getbyte; + if b<>0 then + begin + write (space,' Alias names : '); + for j:=1 to b do + begin + write(ppufile.getstring); + if j<b then + write(', '); + end; + writeln; + end; + if not EndOfEntry then + HasMoreInfos; + space:=' '+space; + { parast } + readsymtable('parast'); + { localst } + if (po_has_inlininginfo in procoptions) then + readsymtable('localst'); + if (po_has_inlininginfo in procoptions) then + readnodetree; + delete(space,1,4); + end; + + ibprocvardef : + begin + readcommondef('Procedural type (ProcVar) definition',defoptions); + read_abstract_proc_def(calloption,procoptions); + writeln(space,' Symtable level :',ppufile.getbyte); + if not EndOfEntry then + HasMoreInfos; + space:=' '+space; + { parast } + readsymtable('parast'); + delete(space,1,4); + end; + + ibshortstringdef : + begin + readcommondef('ShortString definition',defoptions); + writeln(space,' Length : ',getbyte); + end; + + ibwidestringdef : + begin + readcommondef('WideString definition',defoptions); + writeln(space,' Length : ',getaint); + end; + + ibunicodestringdef : + begin + readcommondef('UnicodeString definition',defoptions); + writeln(space,' Length : ',getaint); + end; + + ibansistringdef : + begin + readcommondef('AnsiString definition',defoptions); + writeln(space,' Length : ',getaint); + end; + + iblongstringdef : + begin + readcommondef('Longstring definition',defoptions); + writeln(space,' Length : ',getaint); + end; + + ibrecorddef : + begin + readcommondef('Record definition',defoptions); + writeln(space,' Name of Record : ',getstring); + write (space,' Options : '); + readobjectdefoptions; + writeln(space,' FieldAlign : ',shortint(getbyte)); + writeln(space,' RecordAlign : ',shortint(getbyte)); + writeln(space,' PadAlign : ',shortint(getbyte)); + writeln(space,'UseFieldAlignment : ',shortint(getbyte)); + writeln(space,' DataSize : ',getasizeint); + writeln(space,' PaddingSize : ',getword); + if df_copied_def in current_defoptions then + begin + writeln(' Copy of def: '); + readderef(''); + end; + + if not EndOfEntry then + HasMoreInfos; + {read the record definitions and symbols} + if not(df_copied_def in current_defoptions) then + begin + space:=' '+space; + readrecsymtableoptions; + readsymtable('fields'); + Delete(space,1,4); + end; + end; + + ibobjectdef : + begin + readcommondef('Object/Class definition',defoptions); + writeln(space,' Name of Class : ',getstring); + write (space,' Options : '); + readobjectdefoptions; + b:=getbyte; + write (space,' Type : '); + case tobjecttyp(b) of + odt_class : writeln('class'); + odt_object : writeln('object'); + odt_interfacecom : writeln('interfacecom'); + odt_interfacecorba : writeln('interfacecorba'); + odt_cppclass : writeln('cppclass'); + odt_dispinterface : writeln('dispinterface'); + odt_objcclass : writeln('objcclass'); + odt_objcprotocol : writeln('objcprotocol'); + odt_helper : writeln('helper'); + else writeln('!! Warning: Invalid object type ',b); + end; + writeln(space,' External name : ',getstring); + writeln(space,' Import lib : ',getstring); + writeln(space,' DataSize : ',getasizeint); + writeln(space,' PaddingSize : ',getword); + writeln(space,' FieldAlign : ',shortint(getbyte)); + writeln(space,' RecordAlign : ',shortint(getbyte)); + writeln(space,' Vmt offset : ',getlongint); + write (space, ' Ancestor Class : '); + readderef(''); + + if tobjecttyp(b) in [odt_interfacecom,odt_interfacecorba,odt_dispinterface] then + begin + { IIDGUID } + for j:=1to 16 do + getbyte; + writeln(space,' IID String : ',getstring); + end; + + if (tobjecttyp(b)=odt_helper) or + (oo_is_classhelper in current_objectoptions) then + begin + write(space,' Helper parent : '); + readderef(''); + end; + + l:=getlongint; + writeln(space,' VMT entries: ',l); + for j:=1 to l do + begin + write(space,' '); + readderef(''); + writeln(space,' Visibility: ',Visibility2Str(getbyte)); + end; + + if tobjecttyp(b) in [odt_class,odt_interfacecorba,odt_objcclass,odt_objcprotocol] then + begin + l:=getlongint; + writeln(space,' Impl Intf Count : ',l); + for j:=1 to l do + begin + write (space,' - Definition : '); + readderef(''); + writeln(space,' IOffset : ',getlongint); + end; + end; + + if df_copied_def in current_defoptions then + begin + writeln(' Copy of def: '); + readderef(''); + end; + + if not EndOfEntry then + HasMoreInfos; + if not(df_copied_def in current_defoptions) then + begin + {read the record definitions and symbols} + space:=' '+space; + readrecsymtableoptions; + readsymtable('fields'); + Delete(space,1,4); + end; + end; + + ibfiledef : + begin + ReadCommonDef('File definition',defoptions); + write (space,' Type : '); + case getbyte of + 0 : writeln('Text'); + 1 : begin + writeln('Typed'); + write (space,' File of Type : '); + readderef(''); + end; + 2 : writeln('Untyped'); + end; + end; + + ibformaldef : + begin + readcommondef('Generic definition (void-typ)',defoptions); + writeln(space,' Is Typed : ',(getbyte<>0)); + end; + + ibundefineddef : + readcommondef('Undefined definition (generic parameter)',defoptions); + + ibenumdef : + begin + readcommondef('Enumeration type definition',defoptions); + writeln(space,' Smallest element : ',getaint); + writeln(space,' Largest element : ',getaint); + writeln(space,' Size : ',getaint); + if df_copied_def in defoptions then + begin + write(space,'Base enumeration type : '); + readderef(''); + end + else + begin + space:=' '+space; + readsymtable('elements'); + delete(space,1,4); + end; + end; + + ibclassrefdef : + begin + readcommondef('Class reference definition',defoptions); + write (space,' Pointed Type : '); + readderef(''); + end; + + ibsetdef : + begin + readcommondef('Set definition',defoptions); + write (space,' Element type : '); + readderef(''); + writeln(space,' Size : ',getaint); + writeln(space,' Set Base : ',getaint); + writeln(space,' Set Max : ',getaint); + end; + + ibvariantdef : + begin + readcommondef('Variant definition',defoptions); + write (space,' Varianttype : '); + b:=getbyte; + case tvarianttype(b) of + vt_normalvariant : + writeln('Normal'); + vt_olevariant : + writeln('OLE'); + else + writeln('!! Warning: Invalid varianttype ',b); + end; + + end; + + iberror : + begin + WriteError('!! Error in PPU'); + exit; + end; + + ibenddefs : + break; + + else + begin + WriteLn('!! Skipping unsupported PPU Entry in definitions: ',b); + has_errors:=true; + end; + end; + if not EndOfEntry then + HasMoreInfos; + until false; + end; +end; + +procedure readmoduleoptions(space : string); +type +{ tmoduleoption type is in unit fmodule } + tmoduleoption = (mo_none, + mo_hint_deprecated, + mo_hint_platform, + mo_hint_library, + mo_hint_unimplemented, + mo_hint_experimental, + mo_has_deprecated_msg + ); + tmoduleoptions = set of tmoduleoption; + tmoduleopt=record + mask : tmoduleoption; + str : string[30]; + end; +const + moduleopts=ord(high(tmoduleoption)); + moduleopt : array[1..moduleopts] of tmoduleopt=( + (mask:mo_hint_deprecated; str:'Hint Deprecated'), + (mask:mo_hint_platform; str:'Hint Platform'), + (mask:mo_hint_library; str:'Hint Library'), + (mask:mo_hint_unimplemented; str:'Hint Unimplemented'), + (mask:mo_hint_experimental; str:'Hint Experimental'), + (mask:mo_has_deprecated_msg; str:'Has Deprecated Message') + ); +var + moduleoptions : tmoduleoptions; + i : longint; + first : boolean; +begin + ppufile.getsmallset(moduleoptions); + if moduleoptions<>[] then + begin + first:=true; + for i:=1to moduleopts do + if (moduleopt[i].mask in moduleoptions) then + begin + if first then + first:=false + else + write(', '); + write(moduleopt[i].str); + end; + end; + writeln; + if mo_has_deprecated_msg in moduleoptions then + writeln(space,'Deprecated : ', ppufile.getstring); +end; + +{**************************************************************************** + Read General Part +****************************************************************************} + +procedure readinterface; +var + b : byte; + sourcenumber : longint; +begin + with ppufile do + begin + repeat + b:=readentry; + case b of + + ibmodulename : + Writeln('Module Name: ',getstring); + + ibmoduleoptions: + readmoduleoptions(' '); + + ibsourcefiles : + begin + sourcenumber:=1; + while not EndOfEntry do + begin + Writeln('Source file ',sourcenumber,' : ',getstring,' ',filetimestring(getlongint)); + inc(sourcenumber); + end; + end; +{$IFDEF MACRO_DIFF_HINT} + ibusedmacros : + begin + while not EndOfEntry do + begin + Write('Conditional ',getstring); + b:=getbyte; + if boolean(b)=true then + write(' defined at startup') + else + write(' not defined at startup'); + b:=getbyte; + if boolean(b)=true then + writeln(' was used') + else + writeln; + end; + end; +{$ENDIF} + ibloadunit : + ReadLoadUnit; + + iblinkunitofiles : + ReadLinkContainer('Link unit object file: '); + + iblinkunitstaticlibs : + ReadLinkContainer('Link unit static lib: '); + + iblinkunitsharedlibs : + ReadLinkContainer('Link unit shared lib: '); + + iblinkotherofiles : + ReadLinkContainer('Link other object file: '); + + iblinkotherstaticlibs : + ReadLinkContainer('Link other static lib: '); + + iblinkothersharedlibs : + ReadLinkContainer('Link other shared lib: '); + + iblinkotherframeworks: + ReadLinkContainer('Link framework: '); + + ibmainname: + Writeln('Specified main program symbol name: ',getstring); + + ibImportSymbols : + ReadImportSymbols; + + ibderefdata : + ReadDerefData; + + ibderefmap : + ReadDerefMap; + + ibwpofile : + ReadWpoFileInfo; + + ibresources : + ReadLinkContainer('Resource file: '); + + iberror : + begin + WriteError('Error in PPU'); + exit; + end; + + ibendinterface : + break; + + else + begin + WriteLn('!! Skipping unsupported PPU Entry in General Part: ',b); + has_errors:=true; + end; + end; + until false; + end; +end; + + + +{**************************************************************************** + Read Implementation Part +****************************************************************************} + +procedure readimplementation; +var + b : byte; +begin + with ppufile do + begin + repeat + b:=readentry; + case b of + ibasmsymbols : + ReadAsmSymbols; + + ibloadunit : + ReadLoadUnit; + + iberror : + begin + WriteError('Error in PPU'); + exit; + end; + ibendimplementation : + break; + else + begin + WriteLn('!! Skipping unsupported PPU Entry in Implementation: ',b); + has_errors:=true; + end; + end; + until false; + end; +end; + + +procedure dofile (filename : string); +begin +{ reset } + space:=''; +{ fix filename } + if pos('.',filename)=0 then + filename:=filename+'.ppu'; + ppufile:=tppufile.create(filename); + if not ppufile.openfile then + begin + WriteError('IO-Error when opening : '+filename+', Skipping'); + exit; + end; +{ PPU File is open, check for PPU Id } + if not ppufile.CheckPPUID then + begin + writeln(Filename,' : Not a valid PPU file, Skipping'); + has_errors:=true; + exit; + end; +{ Check PPU Version } + ppuversion:=ppufile.GetPPUVersion; + + Writeln('Analyzing ',filename,' (v',PPUVersion,')'); + if PPUVersion<16 then + begin + writeln(Filename,' : Old PPU Formats (<v16) are not supported, Skipping'); + has_errors:=true; + exit; + end; +{ Write PPU Header Information } + if (verbose and v_header)<>0 then + begin + Writeln; + Writeln('Header'); + Writeln('-------'); + with ppufile.header do + begin + Writeln('Compiler version : ',ppufile.header.compiler shr 14,'.', + (ppufile.header.compiler shr 7) and $7f,'.', + ppufile.header.compiler and $7f); + WriteLn('Target processor : ',Cpu2Str(cpu)); + WriteLn('Target operating system : ',Target2Str(target)); + Writeln('Unit flags : ',PPUFlags2Str(flags)); + Writeln('FileSize (w/o header) : ',size); + Writeln('Checksum : ',hexstr(checksum,8)); + Writeln('Interface Checksum : ',hexstr(interface_checksum,8)); + Writeln('Indirect Checksum : ',hexstr(indirect_checksum,8)); + Writeln('Definitions stored : ',tostr(deflistsize)); + Writeln('Symbols stored : ',tostr(symlistsize)); + end; + end; +{read the general stuff} + if (verbose and v_interface)<>0 then + begin + Writeln; + Writeln('Interface section'); + Writeln('------------------'); + readinterface; + end + else + ppufile.skipuntilentry(ibendinterface); + Writeln; + Writeln('Interface symtable'); + Writeln('----------------------'); + readsymtableoptions('interface'); +{read the definitions} + if (verbose and v_defs)<>0 then + begin + Writeln; + Writeln('Interface definitions'); + Writeln('----------------------'); + readdefinitions('interface'); + end + else + ppufile.skipuntilentry(ibenddefs); +{read the symbols} + if (verbose and v_syms)<>0 then + begin + Writeln; + Writeln('Interface Symbols'); + Writeln('------------------'); + readsymbols('interface'); + end + else + ppufile.skipuntilentry(ibendsyms); + +{read the macro symbols} + if (verbose and v_syms)<>0 then + begin + Writeln; + Writeln('Interface Macro Symbols'); + Writeln('-----------------------'); + end; + if ppufile.readentry<>ibexportedmacros then + begin + WriteError('!! Error in PPU'); + exit; + end; + if boolean(ppufile.getbyte) then + begin + readsymtableoptions('interface macro'); + {skip the definition section for macros (since they are never used) } + ppufile.skipuntilentry(ibenddefs); + {read the macro symbols} + if (verbose and v_syms)<>0 then + readsymbols('interface macro') + else + ppufile.skipuntilentry(ibendsyms); + end + else + Writeln('(no exported macros)'); + +{read the implementation stuff} + if (verbose and v_implementation)<>0 then + begin + Writeln; + Writeln('Implementation section'); + Writeln('-----------------------'); + readimplementation; + end + else + ppufile.skipuntilentry(ibendimplementation); + {read the static symtable} + Writeln; + Writeln('Implementation symtable'); + Writeln('----------------------'); + readsymtableoptions('implementation'); + if (ppufile.header.flags and uf_local_symtable)<>0 then + begin + if (verbose and v_defs)<>0 then + begin + Writeln; + Writeln('Static definitions'); + Writeln('----------------------'); + readdefinitions('implementation'); + end + else + ppufile.skipuntilentry(ibenddefs); + {read the symbols} + if (verbose and v_syms)<>0 then + begin + Writeln; + Writeln('Static Symbols'); + Writeln('------------------'); + readsymbols('implementation'); + end + else + ppufile.skipuntilentry(ibendsyms); + end; + ReadCreatedObjTypes; + FreeDerefdata; +{shutdown ppufile} + ppufile.closefile; + ppufile.free; + Writeln; +end; + + + +procedure help; +begin + writeln('usage: ppudump [options] <filename1> <filename2>...'); + writeln; + writeln('[options] can be:'); + writeln(' -M Exit with ExitCode=2 if more information is available'); + writeln(' -V<verbose> Set verbosity to <verbose>'); + writeln(' H - Show header info'); + writeln(' I - Show interface'); + writeln(' M - Show implementation'); + writeln(' S - Show interface symbols'); + writeln(' D - Show interface definitions'); +// writeln(' B - Show browser info'); + writeln(' A - Show all'); + writeln(' -h, -? This helpscreen'); + halt; +end; + +var + startpara, + nrfile,i : longint; + para : string; +const + error_on_more : boolean = false; +begin + writeln(Title+' '+Version); + writeln(Copyright); + writeln; + if paramcount<1 then + begin + writeln('usage: dumpppu [options] <filename1> <filename2>...'); + halt(1); + end; +{ turn verbose on by default } + verbose:=v_all; +{ read options } + startpara:=1; + while copy(paramstr(startpara),1,1)='-' do + begin + para:=paramstr(startpara); + case upcase(para[2]) of + 'M' : error_on_more:=true; + 'V' : begin + verbose:=0; + for i:=3 to length(para) do + case upcase(para[i]) of + 'H' : verbose:=verbose or v_header; + 'I' : verbose:=verbose or v_interface; + 'M' : verbose:=verbose or v_implementation; + 'D' : verbose:=verbose or v_defs; + 'S' : verbose:=verbose or v_syms; + 'A' : verbose:=verbose or v_all; + end; + end; + 'H' : help; + '?' : help; + end; + inc(startpara); + end; +{ process files } + for nrfile:=startpara to paramcount do + dofile (paramstr(nrfile)); + if has_errors then + Halt(1); + if error_on_more and has_more_infos then + Halt(2); +end. diff --git a/closures/compiler/utils/ppufiles.pp b/closures/compiler/utils/ppufiles.pp new file mode 100644 index 0000000000..f2d164cedf --- /dev/null +++ b/closures/compiler/utils/ppufiles.pp @@ -0,0 +1,246 @@ +{ + Copyright (c) 1999-2002 by Peter Vreman + + List files needed by PPU + + 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. + + ****************************************************************************} +Program ppufiles; + +uses + dos, + ppu; + +const + Version = 'Version 1.00'; + Title = 'PPU-Files'; + Copyright = 'Copyright (c) 1999-2002 by the Free Pascal Development Team'; + + PPUExt = 'ppu'; + +type + poutfile = ^toutfile; + toutfile = record + name : string; + next : poutfile; + end; + +var + skipdup, + showstatic, + showshared, + showobjects : boolean; + + OutFiles : poutfile; + + +{***************************************************************************** + Helpers +*****************************************************************************} + +Procedure Error(const s:string;stop:boolean); +{ + Write an error message to stderr +} +begin + writeln(stderr,s); + if stop then + halt(1); +end; + + +Function ChangeFileExt(Const HStr,ext:String):String; +{ + Return a filename which will have extension ext added if no + extension is found +} +var + j : longint; +begin + j:=length(Hstr); + while (j>0) and (Hstr[j]<>'.') do + dec(j); + if j=0 then + ChangeFileExt:=Hstr+'.'+Ext + else + ChangeFileExt:=HStr; +end; + + +Function SplitPath(Const HStr:String):String; +var + i : longint; +begin + i:=Length(Hstr); + while (i>0) and not(Hstr[i] in ['\','/']) do + dec(i); + SplitPath:=Copy(Hstr,1,i); +end; + + +Procedure AddFile(const s:string); +var + p : poutfile; +begin + p:=nil; + if skipdup then + begin + p:=outfiles; + while assigned(p) do + begin + if s=p^.name then + break; + p:=p^.next; + end; + end; + if not assigned(p) then + begin + new(p); + p^.name:=s; + p^.next:=outfiles; + outfiles:=p; + end; +end; + + +Function DoPPU(const PPUFn:String):Boolean; +{ + Convert one file (in Filename) to library format. + Return true if successful, false otherwise. +} +Var + inppu : tppufile; + b : byte; + + procedure showfiles; + begin + while not inppu.endofentry do + begin + AddFile(inppu.getstring); + inppu.getlongint; + end; + end; + +begin + DoPPU:=false; + inppu:=tppufile.create(PPUFn); + if not inppu.openfile then + begin + inppu.free; + Error('Error: Could not open : '+PPUFn,false); + Exit; + end; +{ Check the ppufile } + if not inppu.CheckPPUId then + begin + inppu.free; + Error('Error: Not a PPU File : '+PPUFn,false); + Exit; + end; + if inppu.GetPPUVersion<CurrentPPUVersion then + begin + inppu.free; + Error('Error: Wrong PPU Version : '+PPUFn,false); + Exit; + end; +{ read until the object files are found } + repeat + b:=inppu.readentry; + case b of + ibendinterface, + ibend : + break; + iblinkunitstaticlibs : + if showstatic then + showfiles; + iblinkunitsharedlibs : + if showshared then + showfiles; + iblinkunitofiles : + if showobjects then + showfiles; + end; + until false; + inppu.free; + DoPPU:=True; +end; + + + +var + i,parafile : longint; + dir : SearchRec; + s,InFile : String; + p : poutfile; +begin +{ defaults } + skipdup:=true; +{ options } + i:=1; + while (i<=paramcount) do + begin + s:=paramstr(i); + if s[1]<>'-' then + break; + case upcase(s[2]) of + 'L' : showshared:=true; + 'S' : showstatic:=true; + 'O' : showobjects:=true; + 'A' : skipdup:=false; + '?','H' : + begin + writeln('usage: ppufiles [options] <files>'); + writeln('options:'); + writeln(' -A Show all files (don''t remove duplicates)'); + writeln(' -L Show only shared libraries'); + writeln(' -S Show only static libraries'); + writeln(' -O Show only object files'); + writeln(' -H This helpscreen'); + end; + end; + inc(i); + end; + { default shows everything } + if i=1 then + begin + showshared:=true; + showstatic:=true; + showobjects:=true; + end; +{ files } + parafile:=i; + for i:=parafile to ParamCount do + begin + InFile:=ChangeFileExt(ParamStr(i),PPUExt); + FindFirst(InFile,$20,Dir); + while (DosError=0) do + begin + DoPPU(SplitPath(InFile)+Dir.Name); + FindNext(Dir); + end; + FindClose(Dir); + end; +{ Display the files } + while assigned(outfiles) do + begin + p:=outfiles; + write(outfiles^.name); + outfiles:=outfiles^.next; + dispose(p); + if assigned(outfiles) then + write(' '); + end; +end. diff --git a/closures/compiler/utils/ppumove.pp b/closures/compiler/utils/ppumove.pp new file mode 100644 index 0000000000..3d11400655 --- /dev/null +++ b/closures/compiler/utils/ppumove.pp @@ -0,0 +1,651 @@ +{ + Copyright (c) 1999-2002 by the FPC Development Team + + Add multiple FPC units into a static/shared library + + 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. + + ****************************************************************************} +{$ifndef TP} + {$H+} +{$endif} +Program ppumove; +uses + +{$IFDEF MACOS} +{$DEFINE USE_FAKE_SYSUTILS} +{$ENDIF MACOS} + +{$IFNDEF USE_FAKE_SYSUTILS} + sysutils, +{$ELSE} + fksysutl, +{$ENDIF} + +{$ifdef unix} + Baseunix,Unix, UnixUtil, +{$else unix} + dos, +{$endif unix} + cutils,ppu,systems, + getopts; + +const + Version = 'Version 2.1.1'; + Title = 'PPU-Mover'; + Copyright = 'Copyright (c) 1998-2007 by the Free Pascal Development Team'; + + ShortOpts = 'o:e:d:i:qhsvb'; + BufSize = 4096; + PPUExt = 'ppu'; + ObjExt = 'o'; + StaticLibExt ='a'; +{$ifdef unix} + SharedLibExt ='so'; + BatchExt ='.sh'; +{$else} + SharedLibExt ='dll'; + BatchExt ='.bat'; +{$endif unix} + + { link options } + link_none = $0; + link_always = $1; + link_static = $2; + link_smart = $4; + link_shared = $8; + +Type + PLinkOEnt = ^TLinkOEnt; + TLinkOEnt = record + Name : string; + Next : PLinkOEnt; + end; + +Var + ArBin,LDBin,StripBin, + OutputFileForPPU, + OutputFile, + OutputFileForLink, { the name of the output file needed when linking } + InputPath, + DestPath, + PPLExt, + LibExt : string; + DoStrip, + Batch, + Quiet, + MakeStatic : boolean; + Buffer : Pointer; + ObjFiles : PLinkOEnt; + BatchFile : Text; + Libs : ansistring; + +{***************************************************************************** + Helpers +*****************************************************************************} + +Procedure Error(const s:string;stop:boolean); +{ + Write an error message to stderr +} +begin + writeln(stderr,s); + if stop then + halt(1); +end; + + +function Shell(const s:string):longint; +{ + Run a shell commnad and return the exitcode +} +begin + if Batch then + begin + Writeln(BatchFile,s); + Shell:=0; + exit; + end; +{$ifdef unix} + Shell:=unix.fpsystem(s); +{$else} + exec(getenv('COMSPEC'),'/C '+s); + Shell:=DosExitCode; +{$endif} +end; + + +Function FileExists (Const F : String) : Boolean; +{ + Returns True if the file exists, False if not. +} +Var +{$ifdef unix} + info : Stat; +{$else} + info : searchrec; +{$endif} +begin +{$ifdef unix} + FileExists:=FpStat(F,Info)=0; +{$else} + FindFirst (F,anyfile,Info); + FileExists:=DosError=0; +{$endif} +end; + + +Function ChangeFileExt(Const HStr,ext:String):String; +{ + Return a filename which will have extension ext added if no + extension is found +} +var + j : longint; +begin + j:=length(Hstr); + while (j>0) and (Hstr[j]<>'.') do + dec(j); + if j=0 then + ChangeFileExt:=Hstr+'.'+Ext + else + ChangeFileExt:=HStr; +end; + + +Function ForceExtension(Const HStr,ext:String):String; +{ + Return a filename which certainly has the extension ext +} +var + j : longint; +begin + j:=length(Hstr); + while (j>0) and (Hstr[j]<>'.') do + dec(j); + if j=0 then + j:=255; + ForceExtension:=Copy(Hstr,1,j-1)+'.'+Ext; +end; + + +Procedure AddToLinkFiles(const S : String); +{ + Adds a filename to a list of object files to link to. + No duplicates allowed. +} +Var + P : PLinKOEnt; +begin + P:=ObjFiles; + { Don't add files twice } + While (P<>nil) and (p^.name<>s) do + p:=p^.next; + if p=nil then + begin + new(p); + p^.next:=ObjFiles; + p^.name:=s; + ObjFiles:=P; + end; +end; + + +Function ExtractLib(const libfn:string):string; +{ + Extract a static library libfn and return the files with a + wildcard +} +var + n : namestr; + d : dirstr; + e : extstr; +begin +{ create the temp dir first } + fsplit(libfn,d,n,e); + {$push}{$I-} + mkdir(n+'.sl'); + {$pop} + if ioresult<>0 then; +{ Extract } + if Shell(arbin+' x '+libfn)<>0 then + Error('Fatal: Error running '+arbin,true); +{ Remove the lib file, it's extracted so it can be created with ease } + if PPLExt=PPUExt then + Shell('rm '+libfn); +{$ifdef unix} + ExtractLib:=n+'.sl/*'; +{$else} + ExtractLib:=n+'.sl\*'; +{$endif} +end; + + +Function DoPPU(const PPUFn,PPLFn:String):Boolean; +{ + Convert one file (in Filename) to library format. + Return true if successful, false otherwise. +} +Var + inppu, + outppu : tppufile; + b, + untilb : byte; + l,m : longint; + f : file; + ext, + s : string; + ppuversion : dword; +begin + DoPPU:=false; + If Not Quiet then + Write ('Processing ',PPUFn,'...'); + inppu:=tppufile.create(PPUFn); + if not inppu.openfile then + begin + inppu.free; + Error('Error: Could not open : '+PPUFn,false); + Exit; + end; +{ Check the ppufile } + if not inppu.CheckPPUId then + begin + inppu.free; + Error('Error: Not a PPU File : '+PPUFn,false); + Exit; + end; + ppuversion:=inppu.GetPPUVersion; + if ppuversion<CurrentPPUVersion then + begin + inppu.free; + Error('Error: Wrong PPU Version '+tostr(ppuversion)+' in '+PPUFn,false); + Exit; + end; +{ No .o file generated for this ppu, just skip } + if (inppu.header.flags and uf_no_link)<>0 then + begin + inppu.free; + If Not Quiet then + Writeln (' No files.'); + DoPPU:=true; + Exit; + end; +{ Already a lib? } + if (inppu.header.flags and uf_in_library)<>0 then + begin + inppu.free; + Error('Error: PPU is already in a library : '+PPUFn,false); + Exit; + end; +{ We need a static linked unit } + if (inppu.header.flags and uf_static_linked)=0 then + begin + inppu.free; + Error('Error: PPU is not static linked : '+PPUFn,false); + Exit; + end; +{ Check if shared is allowed } + if tsystem(inppu.header.target) in [system_i386_go32v2] then + begin + Writeln('Warning: shared library not supported for ppu target, switching to static library'); + MakeStatic:=true; + end; +{ Create the new ppu } + if PPUFn=PPLFn then + outppu:=tppufile.create('ppumove.$$$') + else + outppu:=tppufile.create(PPLFn); + outppu.createfile; +{ Create new header, with the new flags } + outppu.header:=inppu.header; + outppu.header.flags:=outppu.header.flags or uf_in_library; + if MakeStatic then + outppu.header.flags:=outppu.header.flags or uf_static_linked + else + outppu.header.flags:=outppu.header.flags or uf_shared_linked; +{ read until the object files are found } + untilb:=iblinkunitofiles; + repeat + b:=inppu.readentry; + if b in [ibendinterface,ibend] then + begin + inppu.free; + outppu.free; + Error('Error: No files to be linked found : '+PPUFn,false); + Exit; + end; + if b<>untilb then + begin + repeat + inppu.getdatabuf(buffer^,bufsize,l); + outppu.putdata(buffer^,l); + until l<bufsize; + outppu.writeentry(b); + end; + until (b=untilb); +{ we have now reached the section for the files which need to be added, + now add them to the list } + case b of + iblinkunitofiles : + begin + { add all o files, and save the entry when not creating a static + library to keep staticlinking possible } + while not inppu.endofentry do + begin + s:=inppu.getstring; + m:=inppu.getlongint; + if not MakeStatic then + begin + outppu.putstring(s); + outppu.putlongint(m); + end; + AddToLinkFiles(s); + end; + if not MakeStatic then + outppu.writeentry(b); + end; +{ iblinkunitstaticlibs : + begin + AddToLinkFiles(ExtractLib(inppu.getstring)); + if not inppu.endofentry then + begin + repeat + inppu.getdatabuf(buffer^,bufsize,l); + outppu.putdata(buffer^,l); + until l<bufsize; + outppu.writeentry(b); + end; + end; } + end; +{ just add a new entry with the new lib } + if MakeStatic then + begin + outppu.putstring(OutputfileForPPU); + outppu.putlongint(link_static); + outppu.writeentry(iblinkunitstaticlibs) + end + else + begin + outppu.putstring(OutputfileForPPU); + outppu.putlongint(link_shared); + outppu.writeentry(iblinkunitsharedlibs); + end; +{ read all entries until the end and write them also to the new ppu } + repeat + b:=inppu.readentry; + { don't write ibend, that's written automatically } + if b<>ibend then + begin + if b=iblinkothersharedlibs then + begin + while not inppu.endofentry do + begin + s:=inppu.getstring; + m:=inppu.getlongint; + + outppu.putstring(s); + + { strip lib prefix } + if copy(s,1,3)='lib' then + delete(s,1,3); + + { strip lib prefix } + if copy(s,1,3)='lib' then + delete(s,1,3); + ext:=ExtractFileExt(s); + if ext<>'' then + delete(s,length(s)-length(ext)+1,length(ext)); + + libs:=libs+' -l'+s; + + outppu.putlongint(m); + end; + end + else + repeat + inppu.getdatabuf(buffer^,bufsize,l); + outppu.putdata(buffer^,l); + until l<bufsize; + outppu.writeentry(b); + end; + until b=ibend; +{ write the last stuff and close } + outppu.flush; + outppu.writeheader; + outppu.free; + inppu.free; +{ rename } + if PPUFn=PPLFn then + begin + {$push}{$I-} + assign(f,PPUFn); + erase(f); + assign(f,'ppumove.$$$'); + rename(f,PPUFn); + {$pop} + if ioresult<>0 then; + end; +{ the end } + If Not Quiet then + Writeln (' Done.'); + DoPPU:=True; +end; + + +Function DoFile(const FileName:String):Boolean; +{ + Process a file, mainly here for wildcard support under Dos +} +{$ifndef unix} +var + dir : searchrec; +{$endif} +begin +{$ifdef unix} + DoFile:=DoPPU(InputPath+FileName,InputPath+ForceExtension(FileName,PPLExt)); +{$else} + DoFile:=false; + findfirst(filename,$20,dir); + while doserror=0 do + begin + if not DoPPU(InputPath+Dir.Name,InputPath+ForceExtension(Dir.Name,PPLExt)) then + exit; + findnext(dir); + end; + findclose(dir); + DoFile:=true; +{$endif} +end; + + +Procedure DoLink; +{ + Link the object files together to form a (shared) library +} +Var + Names : ansistring; + f : file; + Err : boolean; + P : PLinkOEnt; +begin + if not Quiet then + Write ('Linking '); + P:=ObjFiles; + names:=''; + While p<>nil do + begin + if Names<>'' then + Names:=Names+' '+InputPath+P^.name + else + Names:=InputPath+p^.Name; + p:=p^.next; + end; + if Names='' then + begin + If not Quiet then + Writeln('Error: no files found to be linked'); + exit; + end; + If not Quiet then + WriteLn(names+Libs); +{ Run ar or ld to create the lib } + If MakeStatic then + Err:=Shell(arbin+' rs '+outputfile+' '+names)<>0 + else + begin + Err:=Shell(ldbin+' -shared -E -o '+OutputFile+' '+names+' '+libs)<>0; + if (not Err) and dostrip then + Shell(stripbin+' --strip-unneeded '+OutputFile); + end; + If Err then + Error('Fatal: Library building stage failed.',true); +{ fix permission to 644, so it's not 755 } +{$ifdef unix} + FPChmod(OutputFile,420); +{$endif} +{ Rename to the destpath } + if DestPath<>'' then + begin + Assign(F, OutputFile); + Rename(F,DestPath+DirectorySeparator+OutputFile); + end; +end; + + +Procedure usage; +{ + Print usage and exit. +} +begin + Writeln(paramstr(0),': [-qhvbsS] [-e ext] [-o name] [-d path] file [file ...]'); + Halt(0); +end; + + + +Procedure processopts; +{ + Process command line opions, and checks if command line options OK. +} +var + C : char; +begin + if paramcount=0 then + usage; +{ Reset } + ObjFiles:=Nil; + Quiet:=False; + Batch:=False; + DoStrip:=False; + OutputFile:=''; + PPLExt:='ppu'; + ArBin:='ar'; + LdBin:='ld'; + StripBin:='strip'; + repeat + c:=Getopt (ShortOpts); + Case C of + EndOfOptions : break; + 'S' : MakeStatic:=True; + 'o' : OutputFile:=OptArg; + 'd' : DestPath:=OptArg; + 'i' : begin + InputPath:=OptArg; + if InputPath[length(InputPath)]<>DirectorySeparator then + InputPath:=InputPath+DirectorySeparator; + end; + 'e' : PPLext:=OptArg; + 'q' : Quiet:=True; + 'b' : Batch:=true; + 's' : DoStrip:=true; + '?' : Usage; + 'h' : Usage; + end; + until false; +{ Test filenames on the commandline } + if (OptInd>Paramcount) then + Error('Error: no input files',true); + if (OptInd<ParamCount) and (OutputFile='') then + Error('Error: when moving multiple units, specify an output name.',true); +{ alloc a buffer } + GetMem (Buffer,Bufsize); + If Buffer=Nil then + Error('Error: could not allocate memory for buffer.',true); +end; + + +var + i : longint; +begin + Libs:=''; + ProcessOpts; +{ Write Header } + if not Quiet then + begin + Writeln(Title+' '+Version); + Writeln(Copyright); + Writeln; + end; +{ fix the libext and outputfilename } + if Makestatic then + LibExt:=StaticLibExt + else + LibExt:=SharedLibExt; + if OutputFile='' then + OutputFile:=Paramstr(OptInd); + OutputFileForPPU:=OutputFile; +{ fix filename } +{$ifdef unix} + if Copy(OutputFile,1,3)<>'lib' then + OutputFile:='lib'+OutputFile; + { For unix skip replacing the extension if a full .so.X.X if specified } + i:=pos('.so.',Outputfile); + if i<>0 then + OutputFileForLink:=Copy(Outputfile,4,i-4) + else + begin + OutputFile:=ForceExtension(OutputFile,LibExt); + OutputFileForLink:=Copy(Outputfile,4,length(Outputfile)-length(LibExt)-4); + end; +{$else} + OutputFile:=ForceExtension(OutputFile,LibExt); + OutputFileForLink:=OutputFile; +{$endif} +{ Open BatchFile } + if Batch then + begin + Assign(BatchFile,'pmove'+BatchExt); + Rewrite(BatchFile); + end; +{ Process Files } + i:=OptInd; + While (i<=ParamCount) and Dofile(ChangeFileExt(Paramstr(i),PPUExt)) do + Inc(i); +{ Do Linking stage } + DoLink; +{ Close BatchFile } + if Batch then + begin + if Not Quiet then + Writeln('Writing pmove'+BatchExt); + Close(BatchFile); +{$ifdef unix} + FPChmod('pmove'+BatchExt,493); +{$endif} + end; +{ The End } + if Not Quiet then + Writeln('Done.'); +end. diff --git a/closures/compiler/utils/samplecfg b/closures/compiler/utils/samplecfg new file mode 100644 index 0000000000..93dc2c04e0 --- /dev/null +++ b/closures/compiler/utils/samplecfg @@ -0,0 +1,101 @@ +#!/bin/sh +# +# $Id: samplecfg,v 1.13 2005/02/19 18:50:20 florian Exp $ +# +# Generate Sample Free Pascal configuration file +# + +HOSTOS=`uname -s | tr A-Z a-z` +echo Running on $HOSTOS + +if [ $# = 0 ]; then + echo 'Usage :' + echo 'samplecfg fpcdir confdir' + echo 'fpcdir = Path where FPC is installed' + echo 'confdir = Path to /etc' + exit 1 +fi +if [ "$2" ]; then + sysdir="$2" + [ -d "$sysdir" ] || mkdir "$sysdir" +else + sysdir=/etc +fi +FPCBIN=`dirname "$1"`/../../bin/fpc +FPBIN=`dirname "$1"`/../../bin/fp +FPPKGBIN=`dirname "$1"`/../../bin/fppkg +FPCMKCFGBIN=`dirname "$1"`/../../bin/fpcmkcfg +# Look for one in the PATH, if no new one was installed. +if [ ! -f $FPCMKCFGBIN ]; then + FPCMKCFGBIN=fpcmkcfg +fi + +sysfpdirbase=`dirname "$1"`/`"$FPCBIN" -iV` +sysfpdirbase2=$sysfpdirbase/ide +sysfpdir=$sysfpdirbase2/text + +# Detect if we have write permission in sysdir. +if [ -w "$sysdir" ] ; then + echo Write permission in $sysdir. + fpccfgfile="$sysdir"/fpc.cfg + fppkgfile="$sysdir"/fppkg.cfg + defaultfile="$sysdir"/fppkg/default + compilerconfigdir="-d CompilerConfigDir=$sysdir/fppkg" +else + echo No write premission in $sysdir. + fpccfgfile="$HOME"/.fpc.cfg + fppkgfile="$HOME"/.config/fppkg.cfg + defaultfile="$HOME"/.fppkg/config/default +fi +# + +# Don't mess with IDE configuration if fp binary does not exist +if [ -f "$FPBIN" ] ; then + +# Assume local FP IDE configuration unless writing system-wide version possible + fpinifile="$HOME"/.fp/fp.ini + fpcfgfile="$HOME"/.fp/fp.cfg + +# Detect if we have write permission in sysfpdir, or that the directory can be made + if ( [ -d "$sysfpdirbase" ] && [ -w "$sysfpdirbase" ] && ! [ -d "$sysfpdirbase2" ] ) || + ( [ -d "$sysfpdirbase2" ] && [ -w "$sysfpdirbase2" ] && ! [ -d "$sysfpdir" ] ) || + ( [ -d "$sysfpdir" ] && [ -w "$sysfpdir" ] ) ; then + fpinifile="$sysfpdir"/fp.ini + fpcfgfile="$sysfpdir"/fp.cfg + fi +# +fi + +# set right path to FPC with $fpcversion +FPCPATH=`dirname "$1"`/\$fpcversion +# set right prefix to FPC +FPCGLOBALPREFIX=`dirname "$1"`/../../ + +# Write (.)fpc.cfg +echo Writing sample configuration file to $fpccfgfile +${FPCMKCFGBIN} -d "basepath=$FPCPATH" -o $fpccfgfile + +if ! [ -f "$FPBIN" ] ; then + exit +fi + +# Write fp.cfg +echo Writing sample configuration file to $fpcfgfile +${FPCMKCFGBIN} -p -1 -d "basepath=$FPCPATH" -o $fpcfgfile + +# Write fp.ini +echo Writing sample configuration file to $fpinifile +${FPCMKCFGBIN} -p -2 -o $fpinifile + +# Do not write fppkg configuration when fppkg is not available +if ! [ -f "$FPPKGBIN" ] ; then + exit +fi + +# Write fppkg.cfg +echo Writing sample configuration file to $fppkgfile +${FPCMKCFGBIN} -p -3 $compilerconfigdir -o $fppkgfile + +# Write default +echo Writing sample configuration file to $defaultfile +${FPCMKCFGBIN} -p -4 -d "GlobalPrefix=$FPCGLOBALPREFIX" -o $defaultfile diff --git a/closures/compiler/utils/usubst.pp b/closures/compiler/utils/usubst.pp new file mode 100644 index 0000000000..cf553ae373 --- /dev/null +++ b/closures/compiler/utils/usubst.pp @@ -0,0 +1,109 @@ +{$mode objfpc} +{$H+} +{ + This file is part of Free Pascal build tools + Copyright (c) 2005 by Michael Van Canneyt + + Implements string substitutions + + 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 usubst; + +interface + +uses SysUtils,Classes; + +// Add N=V pair to list. +Procedure AddToList(List : TStrings; Const N,V : String); +// Split NV to N/V and call AddToList +Function AddPair(List : TStrings; Const NV : String) : Boolean; +// Perform substitutions in S, from List. +Function DoSubStitutions(List : TStrings; Var S : String) : Integer; + +implementation + +Procedure AddToList(List : TStrings; Const N,V : String); + +var + I : Integer; + +begin + I:=List.IndexOfName(N); + If (V='') then + begin + If (I<>-1) then + List.Delete(I) + end + else + begin + If (I=-1) then + List.Add(N+'='+V) + else + List[I]:=N+'='+V; + end; +end; + +Function AddPair(List : TStrings; Const NV : String) : Boolean; + +Var + P : Integer; + N,V : string; + +begin + P:=Pos('=',NV); + Result:=(P<>0); + If Result then + begin + V:=NV; + N:=Copy(V,1,P-1); + Delete(V,1,P); + AddToList(List,N,V); + end; +end; + +Function DoSubstitutions(List : TStrings; Var S : String) : Integer; + +Var + N,T : String; + P : Integer; + +begin + Result:=0; + T:=S; + S:=''; + P:=Pos('%',T); + While (P>0) do + begin + S:=S+Copy(T,1,P-1); + Delete(T,1,P); + If (Length(T)>0) then + if (T[1]='%') then + begin + S:=S+'%'; + Delete(T,1,1); + end + else + begin + P:=Pos('%',T); + If (P=0) then + S:=S+'%' + else + begin + N:=Copy(T,1,P-1); + Delete(T,1,P); + S:=S+List.Values[N]; + end; + end; + P:=Pos('%',T); + end; + S:=S+T; +end; + +end. diff --git a/closures/compiler/verbose.pas b/closures/compiler/verbose.pas new file mode 100644 index 0000000000..12f013ef60 --- /dev/null +++ b/closures/compiler/verbose.pas @@ -0,0 +1,987 @@ +{ + Copyright (c) 1998-2002 by Peter Vreman + + This unit handles the verbose management + + 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 verbose; + +{$i fpcdefs.inc} + +interface + + uses +{$IFNDEF USE_FAKE_SYSUTILS} + sysutils, +{$ELSE} + fksysutl, +{$ENDIF} + cutils, + globtype,finput, + cmsgs; + +{$ifndef EXTERN_MSG} + {$i msgtxt.inc} +{$endif} + +{$i msgidx.inc} + + 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; + + var + msg : pmessage; + paraprintnodetree : byte; + + type + tmsgqueueevent = procedure(const s:TMsgStr;v,w:longint) of object; + + const + msgfilename : string = ''; + + procedure SetRedirectFile(const fn:string); + function SetVerbosity(const s:string):boolean; + procedure PrepareReport; + + function CheckVerbosity(v:longint):boolean; + function SetMessageVerbosity(v:longint;state:tmsgstate):boolean; + procedure RestoreLocalVerbosity(pstate : pmessagestaterecord); + procedure FreeLocalVerbosity(var fstate : pmessagestaterecord); + + function ChangeMessageVerbosity(s: string; var i: integer;state:tmsgstate): boolean; + procedure ShowStatus; + function ErrorCount:longint; + procedure SetErrorFlags(const s:string); + procedure GenerateError; + procedure Internalerror(i:longint); + procedure Comment(l:longint;s:ansistring); + function MessagePchar(w:longint):pchar; + procedure Message(w:longint;onqueue:tmsgqueueevent=nil); + procedure Message1(w:longint;const s1:TMsgStr;onqueue:tmsgqueueevent=nil); + procedure Message2(w:longint;const s1,s2:TMsgStr;onqueue:tmsgqueueevent=nil); + procedure Message3(w:longint;const s1,s2,s3:TMsgStr;onqueue:tmsgqueueevent=nil); + procedure Message4(w:longint;const s1,s2,s3,s4:TMsgStr;onqueue:tmsgqueueevent=nil); + procedure MessagePos(const pos:tfileposinfo;w:longint;onqueue:tmsgqueueevent=nil); + procedure MessagePos1(const pos:tfileposinfo;w:longint;const s1:TMsgStr;onqueue:tmsgqueueevent=nil); + procedure MessagePos2(const pos:tfileposinfo;w:longint;const s1,s2:TMsgStr;onqueue:tmsgqueueevent=nil); + procedure MessagePos3(const pos:tfileposinfo;w:longint;const s1,s2,s3:TMsgStr;onqueue:tmsgqueueevent=nil); + procedure MessagePos4(const pos:tfileposinfo;w:longint;const s1,s2,s3,s4:TMsgStr;onqueue:tmsgqueueevent=nil); + + { message calls with codegenerror support } + procedure cgmessage(t : longint); + procedure cgmessage1(t : longint;const s : TMsgStr); + procedure cgmessage2(t : longint;const s1,s2 : TMsgStr); + procedure cgmessage3(t : longint;const s1,s2,s3 : TMsgStr); + procedure CGMessagePos(const pos:tfileposinfo;t:longint); + procedure CGMessagePos1(const pos:tfileposinfo;t:longint;const s1:TMsgStr); + procedure CGMessagePos2(const pos:tfileposinfo;t:longint;const s1,s2:TMsgStr); + procedure CGMessagePos3(const pos:tfileposinfo;t:longint;const s1,s2,s3:TMsgStr); + + procedure FlushOutput; + + procedure InitVerbose; + procedure DoneVerbose; + + + +implementation + + uses + comphook,fmodule,constexp,globals,cfileutl,switches; + +{**************************************************************************** + Extra Handlers for default compiler +****************************************************************************} + + procedure DoneRedirectFile; + begin + if status.use_redir then + begin + close(status.redirfile); + status.use_redir:=false; + end; + if status.use_bugreport then + begin + close(status.reportbugfile); + status.use_bugreport:=false; + end; + end; + + + procedure SetRedirectFile(const fn:string); + begin + { close old redirection file because FileRedirection is handled in both passes } + if status.use_redir then + close(status.redirfile); + + assign(status.redirfile,fn); + {$push}{$I-} + append(status.redirfile); + if ioresult <> 0 then + begin + assign(status.redirfile,fn); + rewrite(status.redirfile); + end; + {$pop} + status.use_redir:=(ioresult=0); + end; + + + procedure PrepareReport; + var + fn : string; + begin + if status.use_bugreport then + exit; + fn:='fpcdebug.txt'; + assign(status.reportbugfile,fn); + {$push}{$I-} + append(status.reportbugfile); + if ioresult <> 0 then + rewrite(status.reportbugfile); + {$pop} + status.use_bugreport:=(ioresult=0); + if status.use_bugreport then + writeln(status.reportbugfile,'FPC bug report file'); + end; + + procedure RestoreLocalVerbosity(pstate : pmessagestaterecord); + begin + msg^.ResetStates; + while assigned(pstate) do + begin + SetMessageVerbosity(pstate^.value,pstate^.state); + pstate:=pstate^.next; + end; + end; + + procedure FreeLocalVerbosity(var fstate : pmessagestaterecord); + var pstate : pmessagestaterecord; + begin + pstate:=unaligned(fstate); + while assigned(pstate) do + begin + unaligned(fstate):=pstate^.next; + freemem(pstate); + pstate:=unaligned(fstate); + end; + end; + + function ChangeMessageVerbosity(s: string; var i : integer;state:tmsgstate): boolean; + var + tok : string; + msgnr, code : longint; + begin + { delete everything up to and including 'm' } + delete(s,1,i); + { the rest of the string must be message numbers } + inc(i,length(s)+1); + result:=false; + repeat + tok:=GetToken(s,','); + if (tok='') then + break; + val(tok, msgnr, code); + if (code<>0) then + exit; + if not msg^.setverbosity(msgnr,state) then + exit + else + recordpendingmessagestate(msgnr, state); + until false; + result:=true; + end; + + function SetMessageVerbosity(v:longint;state:tmsgstate):boolean; + begin + result:=msg^.setverbosity(v,state); + end; + + function CheckVerbosity(v:longint):boolean; + begin + result:=do_checkverbosity(v); + end; + + + function SetVerbosity(const s:string):boolean; + const + message_verbosity:array[boolean] of tmsgstate=(ms_off_global,ms_on_global); + var + m : Longint; + i : Integer; + inverse : boolean; + c : char; + begin + Setverbosity:=false; + val(s,m,i); + if (i=0) and (s<>'') then + status.verbosity:=m + else + begin + i:=1; + while i<=length(s) do + begin + c:=upcase(s[i]); + inverse:=false; + { on/off ? } + if (i<length(s)) then + case s[i+1] of + '-' : begin + inc(i); + inverse:=true; + end; + '+' : inc(i); + end; + { handle switch } + case c of + { Special cases } + '0' : status.verbosity:=V_Default; + 'A' : status.verbosity:=V_All; + 'B' : begin + if inverse then + status.print_source_path:=false + else + status.print_source_path:=true; + end; + 'M' : if not ChangeMessageVerbosity(s,i,message_verbosity[inverse]) then + begin + result:=false; + exit + end; + 'P' : begin + if inverse then + paraprintnodetree:=0 + else + paraprintnodetree:=1; + end; + 'Q' : begin + if inverse then + status.showmsgnrs:=false + else + status.showmsgnrs:=true; + end; + 'R' : begin + if inverse then + begin + status.use_gccoutput:=false; + status.use_stderr:=false; + end + else + begin + status.use_gccoutput:=true; + status.use_stderr:=true; + end; + end; + 'V' : PrepareReport; + 'Z' : begin + if inverse then + status.use_stderr:=false + else + status.use_stderr:=true; + end; + { Normal cases - do an or } + 'C' : if inverse then + status.verbosity:=status.verbosity and (not V_Conditional) + else + status.verbosity:=status.verbosity or V_Conditional; + 'D' : if inverse then + status.verbosity:=status.verbosity and (not V_Debug) + else + status.verbosity:=status.verbosity or V_Debug; + 'E' : if inverse then + status.verbosity:=status.verbosity and (not V_Error) + else + status.verbosity:=status.verbosity or V_Error; + 'H' : if inverse then + status.verbosity:=status.verbosity and (not V_Hint) + else + status.verbosity:=status.verbosity or V_Hint; + 'I' : if inverse then + status.verbosity:=status.verbosity and (not V_Info) + else + status.verbosity:=status.verbosity or V_Info; + 'L' : if inverse then + status.verbosity:=status.verbosity and (not V_Status) + else + status.verbosity:=status.verbosity or V_Status; + 'N' : if inverse then + status.verbosity:=status.verbosity and (not V_Note) + else + status.verbosity:=status.verbosity or V_Note; + 'S' : if inverse then + status.verbosity:=status.verbosity and (not V_TimeStamps) + else + status.verbosity:=status.verbosity or V_TimeStamps; + 'T' : if inverse then + status.verbosity:=status.verbosity and (not V_Tried) + else + status.verbosity:=status.verbosity or V_Tried; + 'U' : if inverse then + status.verbosity:=status.verbosity and (not V_Used) + else + status.verbosity:=status.verbosity or V_Used; + 'W' : if inverse then + status.verbosity:=status.verbosity and (not V_Warning) + else + status.verbosity:=status.verbosity or V_Warning; + 'X' : if inverse then + status.verbosity:=status.verbosity and (not V_Executable) + else + status.verbosity:=status.verbosity or V_Executable; + end; + inc(i); + end; + end; + if status.verbosity=0 then + status.verbosity:=V_Default; + setverbosity:=true; + end; + + + procedure Loadprefixes; + + function loadprefix(w:longint):string; + var + s : string; + idx : longint; + begin + s:=msg^.get(w,[]); + idx:=pos('_',s); + if idx>0 then + Loadprefix:=Copy(s,idx+1,255) + else + Loadprefix:=s; + end; + + begin + { Load the prefixes } + fatalstr:=Loadprefix(general_i_fatal); + errorstr:=Loadprefix(general_i_error); + warningstr:=Loadprefix(general_i_warning); + notestr:=Loadprefix(general_i_note); + hintstr:=Loadprefix(general_i_hint); + end; + + + procedure LoadMsgFile(const fn:string); + begin + { reload the internal messages if not already loaded } +{$ifndef EXTERN_MSG} + if not msg^.msgintern then + msg^.LoadIntern(@msgtxt,msgtxtsize); +{$endif} + if not msg^.LoadExtern(fn) then + begin +{$ifdef EXTERN_MSG} + writeln('Fatal: Cannot find error message file.'); + halt(3); +{$else} + msg^.LoadIntern(@msgtxt,msgtxtsize); +{$endif} + end; + { reload the prefixes using the new messages } + Loadprefixes; + end; + + + procedure MaybeLoadMessageFile; + begin + { Load new message file } + if (msgfilename<>'') then + begin + LoadMsgFile(msgfilename); + msgfilename:=''; + end; + end; + + + var + lastfileidx, + lastmoduleidx : longint; + + + Procedure UpdateStatus; + var + module : tmodulebase; + begin + { fix status } + status.currentline:=current_filepos.line; + status.currentcolumn:=current_filepos.column; + if (current_filepos.moduleindex <> lastmoduleidx) or + (current_filepos.fileindex <> lastfileidx) then + begin + module:=get_module(current_filepos.moduleindex); + if assigned(module) and assigned(module.sourcefiles) then + begin + { update status record } + status.currentmodule:=module.modulename^; + status.currentmodulestate:=ModuleStateStr[module.state]; + status.currentsource:=module.sourcefiles.get_file_name(current_filepos.fileindex); + status.currentsourcepath:=module.sourcefiles.get_file_path(current_filepos.fileindex); + { if currentsourcepath is relative, make it absolute } + if not path_absolute(status.currentsourcepath) then + status.currentsourcepath:=GetCurrentDir+status.currentsourcepath; + + { update lastfileidx only if name known PM } + if status.currentsource<>'' then + lastfileidx:=current_filepos.fileindex + else + lastfileidx:=0; + + lastmoduleidx:=module.unit_index; + end; + end; + end; + + + procedure ShowStatus; + begin + UpdateStatus; + if do_status() then + raise ECompilerAbort.Create; + end; + + + function ErrorCount:longint; + begin + ErrorCount:=status.errorcount; + end; + + + procedure SetErrorFlags(const s:string); + var + code : integer; + i,j,l : longint; + begin + { empty string means error count = 1 for backward compatibility (PFV) } + if s='' then + begin + status.maxerrorcount:=1; + exit; + end; + i:=0; + while (i<length(s)) do + begin + inc(i); + case s[i] of + '0'..'9' : + begin + j:=i; + while (j<=length(s)) and (s[j] in ['0'..'9']) do + inc(j); + val(copy(s,i,j-i),l,code); + if code<>0 then + l:=1; + status.maxerrorcount:=l; + i:=j-1; + end; + 'w','W' : + status.errorwarning:=true; + 'n','N' : + status.errornote:=true; + 'h','H' : + status.errorhint:=true; + end; + end; + end; + + + procedure GenerateError; + begin + inc(status.errorcount); + end; + + + procedure internalerror(i : longint); + begin + UpdateStatus; + do_internalerror(i); + inc(status.errorcount); + raise ECompilerAbort.Create; + end; + + + procedure Comment(l:longint;s:ansistring); + var + dostop : boolean; + begin + dostop:=((l and V_Fatal)<>0); + if ((l and V_Error)<>0) or + ((l and V_Fatal)<>0) or + (status.errorwarning and ((l and V_Warning)<>0)) or + (status.errornote and ((l and V_Note)<>0)) or + (status.errorhint and ((l and V_Hint)<>0)) then + inc(status.errorcount) + else + if l and V_Warning <> 0 then + inc(status.countWarnings) + else + if l and V_Note <> 0 then + inc(status.countNotes) + else + if l and V_Hint <> 0 then + inc(status.countHints); + { check verbosity level } + if not CheckVerbosity(l) then + exit; + if (l and V_LineInfoMask)<>0 then + l:=l or V_LineInfo; + { Create status info } + UpdateStatus; + { Fix replacements } + DefaultReplacements(s); + { show comment } + if do_comment(l,s) or dostop then + raise ECompilerAbort.Create; + if (status.errorcount>=status.maxerrorcount) and not status.skip_error then + begin + Message1(unit_f_errors_in_unit,tostr(status.errorcount)); + status.skip_error:=true; + raise ECompilerAbort.Create; + end; + end; + + function GetMessageState(m:longint):tmsgstate; + var + i: integer; + begin + i:=m div 1000; + { get the default state } + Result:=msg^.msgstates[i]^[m mod 1000]; + + { and search at the current unit settings } + { todo } + end; + + Procedure Msg2Comment(s:ansistring;w:longint;onqueue:tmsgqueueevent); + var + idx,i,v : longint; + dostop : boolean; + doqueue : boolean; + st : tmsgstate; + ch : char; + begin + {Reset} + dostop:=false; + doqueue:=false; + v:=0; + {Parse options} + idx:=pos('_',s); + if idx=0 then + v:=V_None + else + if (idx >= 1) And (idx <= 5) then + begin + for i:=1 to idx do + begin + ch:=upcase(s[i]); + case ch of + 'F' : + begin + v:=v or V_Fatal; + inc(status.errorcount); + dostop:=true; + end; + 'E','W','N','H': + begin + if ch='E' then + st:=ms_error + else + st:=GetMessageState(w); + { We only want to know about local value } + st:= tmsgstate(ord(st) and ms_local_mask); + if st=ms_error then + begin + v:=v or V_Error; + inc(status.errorcount); + end + else if st<>ms_off then + case ch of + 'W': + begin + v:=v or V_Warning; + if CheckVerbosity(V_Warning) then + if status.errorwarning then + inc(status.errorcount) + else + inc(status.countWarnings); + end; + 'N' : + begin + v:=v or V_Note; + if CheckVerbosity(V_Note) then + if status.errornote then + inc(status.errorcount) + else + inc(status.countNotes); + end; + 'H' : + begin + v:=v or V_Hint; + if CheckVerbosity(V_Hint) then + if status.errorhint then + inc(status.errorcount) + else + inc(status.countHints); + end; + end; + end; + 'O' : + v:=v or V_Normal; + 'I' : + v:=v or V_Info; + 'L' : + v:=v or V_LineInfo; + 'U' : + v:=v or V_Used; + 'T' : + v:=v or V_Tried; + 'C' : + v:=v or V_Conditional; + 'D' : + v:=v or V_Debug; + 'X' : + v:=v or V_Executable; + 'S' : + dostop:=true; + '_' : ; + end; + end; + end; + Delete(s,1,idx); + { check verbosity level } + if not CheckVerbosity(v) then + begin + doqueue := onqueue <> nil; + if not doqueue then + exit; + end; + if (v and V_LineInfoMask)<>0 then + v:=v or V_LineInfo; + { fix status } + UpdateStatus; + { Fix replacements } + DefaultReplacements(s); + if status.showmsgnrs then + s:='('+tostr(w)+') '+s; + if doqueue then + begin + onqueue(s,v,w); + exit; + end; + { show comment } + if do_comment(v,s) or dostop then + raise ECompilerAbort.Create; + if (status.errorcount>=status.maxerrorcount) and not status.skip_error then + begin + Message1(unit_f_errors_in_unit,tostr(status.errorcount)); + status.skip_error:=true; + raise ECompilerAbort.Create; + end; + end; + + + function MessagePchar(w:longint):pchar; + begin + MaybeLoadMessageFile; + MessagePchar:=msg^.GetPchar(w) + end; + + + procedure Message(w:longint;onqueue:tmsgqueueevent=nil); + begin + MaybeLoadMessageFile; + Msg2Comment(msg^.Get(w,[]),w,onqueue); + end; + + + procedure Message1(w:longint;const s1:TMsgStr;onqueue:tmsgqueueevent=nil); + + begin + MaybeLoadMessageFile; + Msg2Comment(msg^.Get(w,[s1]),w,onqueue); + end; + + + procedure Message2(w:longint;const s1,s2:TMsgStr;onqueue:tmsgqueueevent=nil); + begin + MaybeLoadMessageFile; + Msg2Comment(msg^.Get(w,[s1,s2]),w,onqueue); + end; + + + procedure Message3(w:longint;const s1,s2,s3:TMsgStr;onqueue:tmsgqueueevent=nil); + begin + MaybeLoadMessageFile; + Msg2Comment(msg^.Get(w,[s1,s2,s3]),w,onqueue); + end; + + + procedure Message4(w:longint;const s1,s2,s3,s4:TMsgStr;onqueue:tmsgqueueevent=nil); + begin + MaybeLoadMessageFile; + Msg2Comment(msg^.Get(w,[s1,s2,s3,s4]),w,onqueue); + end; + + + procedure MessagePos(const pos:tfileposinfo;w:longint;onqueue:tmsgqueueevent=nil); + var + oldpos : tfileposinfo; + begin + oldpos:=current_filepos; + current_filepos:=pos; + MaybeLoadMessageFile; + Msg2Comment(msg^.Get(w,[]),w,onqueue); + current_filepos:=oldpos; + end; + + + procedure MessagePos1(const pos:tfileposinfo;w:longint;const s1:TMsgStr;onqueue:tmsgqueueevent=nil); + var + oldpos : tfileposinfo; + begin + oldpos:=current_filepos; + current_filepos:=pos; + MaybeLoadMessageFile; + Msg2Comment(msg^.Get(w,[s1]),w,onqueue); + current_filepos:=oldpos; + end; + + + procedure MessagePos2(const pos:tfileposinfo;w:longint;const s1,s2:TMsgStr;onqueue:tmsgqueueevent=nil); + var + oldpos : tfileposinfo; + begin + oldpos:=current_filepos; + current_filepos:=pos; + MaybeLoadMessageFile; + Msg2Comment(msg^.Get(w,[s1,s2]),w,onqueue); + current_filepos:=oldpos; + end; + + + procedure MessagePos3(const pos:tfileposinfo;w:longint;const s1,s2,s3:TMsgStr;onqueue:tmsgqueueevent=nil); + var + oldpos : tfileposinfo; + begin + oldpos:=current_filepos; + current_filepos:=pos; + MaybeLoadMessageFile; + Msg2Comment(msg^.Get(w,[s1,s2,s3]),w,onqueue); + current_filepos:=oldpos; + end; + + + procedure MessagePos4(const pos:tfileposinfo;w:longint;const s1,s2,s3,s4:TMsgStr;onqueue:tmsgqueueevent=nil); + var + oldpos : tfileposinfo; + begin + oldpos:=current_filepos; + current_filepos:=pos; + MaybeLoadMessageFile; + Msg2Comment(msg^.Get(w,[s1,s2,s3,s4]),w,onqueue); + current_filepos:=oldpos; + end; + + +{***************************************************************************** + override the message calls to set codegenerror +*****************************************************************************} + + procedure cgmessage(t : longint); + var + olderrorcount : longint; + begin + if not(codegenerror) then + begin + olderrorcount:=Errorcount; + verbose.Message(t); + codegenerror:=olderrorcount<>Errorcount; + end; + end; + + procedure cgmessage1(t : longint;const s : TMsgStr); + var + olderrorcount : longint; + begin + if not(codegenerror) then + begin + olderrorcount:=Errorcount; + verbose.Message1(t,s); + codegenerror:=olderrorcount<>Errorcount; + end; + end; + + procedure cgmessage2(t : longint;const s1,s2 : TMsgStr); + var + olderrorcount : longint; + begin + if not(codegenerror) then + begin + olderrorcount:=Errorcount; + verbose.Message2(t,s1,s2); + codegenerror:=olderrorcount<>Errorcount; + end; + end; + + procedure cgmessage3(t : longint;const s1,s2,s3 : TMsgStr); + var + olderrorcount : longint; + begin + if not(codegenerror) then + begin + olderrorcount:=Errorcount; + verbose.Message3(t,s1,s2,s3); + codegenerror:=olderrorcount<>Errorcount; + end; + end; + + + procedure cgmessagepos(const pos:tfileposinfo;t : longint); + var + olderrorcount : longint; + begin + if not(codegenerror) then + begin + olderrorcount:=Errorcount; + verbose.MessagePos(pos,t); + codegenerror:=olderrorcount<>Errorcount; + end; + end; + + procedure cgmessagepos1(const pos:tfileposinfo;t : longint;const s1 : TMsgStr); + var + olderrorcount : longint; + begin + if not(codegenerror) then + begin + olderrorcount:=Errorcount; + verbose.MessagePos1(pos,t,s1); + codegenerror:=olderrorcount<>Errorcount; + end; + end; + + procedure cgmessagepos2(const pos:tfileposinfo;t : longint;const s1,s2 : TMsgStr); + var + olderrorcount : longint; + begin + if not(codegenerror) then + begin + olderrorcount:=Errorcount; + verbose.MessagePos2(pos,t,s1,s2); + codegenerror:=olderrorcount<>Errorcount; + end; + end; + + procedure cgmessagepos3(const pos:tfileposinfo;t : longint;const s1,s2,s3 : TMsgStr); + var + olderrorcount : longint; + begin + if not(codegenerror) then + begin + olderrorcount:=Errorcount; + verbose.MessagePos3(pos,t,s1,s2,s3); + codegenerror:=olderrorcount<>Errorcount; + end; + end; + + + procedure FlushOutput; + begin + if not (Status.Use_StdErr) then (* StdErr is flushed after every line *) + begin + if Status.Use_Redir then + Flush(Status.RedirFile) + else + Flush(Output); + end; + end; + + +{***************************************************************************** + Initialization +*****************************************************************************} + + procedure InitVerbose; + begin + { Init } + msg:=new(pmessage,Init(20,msgidxmax)); + if msg=nil then + begin + writeln('Fatal: MsgIdx Wrong'); + halt(3); + end; +{$ifndef EXTERN_MSG} + msg^.LoadIntern(@msgtxt,msgtxtsize); +{$else EXTERN_MSG} + LoadMsgFile(exepath+'errore.msg'); +{$endif EXTERN_MSG} + FillChar(Status,sizeof(TCompilerStatus),0); + status.verbosity:=V_Default; + Status.MaxErrorCount:=50; + Status.codesize:=aword(-1); + Status.datasize:=aword(-1); + Loadprefixes; + lastfileidx:=-1; + lastmoduleidx:=-1; + status.currentmodule:=''; + status.currentsource:=''; + status.currentsourcepath:=''; + { Register internalerrorproc for cutils/cclasses } + internalerrorproc:=@internalerror; + end; + + + procedure DoneVerbose; + begin + if assigned(msg) then + begin + dispose(msg,Done); + msg:=nil; + end; + DoneRedirectFile; + end; + + +initialization + constexp.internalerror:=@internalerror; +finalization + { Be sure to close the redirect files to flush all data } + DoneRedirectFile; +end. diff --git a/closures/compiler/version.pas b/closures/compiler/version.pas new file mode 100644 index 0000000000..e4f7442967 --- /dev/null +++ b/closures/compiler/version.pas @@ -0,0 +1,96 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Version/target constants + + 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 version; + +{$i fpcdefs.inc} + +interface + + const + { version string } + version_nr = '2'; + release_nr = '7'; + patch_nr = '1'; + minorpatch = ''; + + { word version for ppu file } + wordversion = ((ord(version_nr)-ord('0')) shl 14)+ + ((ord(release_nr)-ord('0')) shl 7)+ + (ord(patch_nr)-ord('0')); + + { date string } + date_string = {$I %DATE%}; + + { source cpu string } +{$ifdef cpu86} + source_cpu_string = 'i386'; +{$endif cpu86} +{$ifdef cpupowerpc32} + source_cpu_string = 'powerpc'; +{$endif cpupowerpc32} +{$ifdef cpupowerpc64} + source_cpu_string = 'powerpc64'; +{$endif cpupowerpc64} +{$ifdef cpum68k} + source_cpu_string = 'm68k'; +{$endif cpum68k} +{$ifdef cpuia64} + source_cpu_string = 'ia64'; +{$endif cpuia64} +{$ifdef cpux86_64} + source_cpu_string = 'x86_64'; +{$endif cpux86_64} +{$ifdef cpusparc} + source_cpu_string = 'sparc'; +{$endif cpusparc} +{$ifdef cpusalpha} + source_cpu_string = 'alpha'; +{$endif cpualpha} +{$ifdef cpuvis} + source_cpu_string = 'vis'; +{$endif cpuvis} +{$ifdef cpuarm} + source_cpu_string = 'arm'; +{$endif cpuarm} + +function version_string:string; +function full_version_string:string; + + +implementation + +function version_string:string; +begin + version_string := version_nr+'.'+release_nr+'.'+patch_nr; +end; + + +function full_version_string:string; +begin + full_version_string := version_nr+'.'+release_nr+'.'+patch_nr+minorpatch +{$ifdef REVINC} + +'-r'+{$i revision.inc} +{$endif REVINC} + ; +end; + +end. diff --git a/closures/compiler/vis/aasmcpu.pas b/closures/compiler/vis/aasmcpu.pas new file mode 100644 index 0000000000..18cfae02d6 --- /dev/null +++ b/closures/compiler/vis/aasmcpu.pas @@ -0,0 +1,248 @@ +{ + Copyright (c) 1998-2001 by Florian Klaempfl and Pierre Muller + + virtual instruction set family assembler instructions + + 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,aasmtai,aasmdata, + aasmbase,globals,verbose, + cpubase,cpuinfo; + + +type + + taicpu = class(taicpu_abstract) + opsize : topsize; + constructor op_none(op : tasmop;_size : topsize); + + constructor op_reg(op : tasmop;_size : topsize;_op1 : tregister); + constructor op_const(op : tasmop;_size : topsize;_op1 : longint); + constructor op_ref(op : tasmop;_size : topsize;_op1 : treference); + + constructor op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister); + constructor op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;_op2 : treference); + constructor op_ref_reg(op : tasmop;_size : topsize;_op1 : treference;_op2 : tregister); + + constructor op_const_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister); + constructor op_const_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : treference); + + + { this is for Jmp instructions } + constructor op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol); + + constructor op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol); + { for DBxx opcodes } + constructor op_reg_sym(op: tasmop; _size : topsize; _op1: tregister; _op2 :tasmsymbol); + constructor op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister); + + constructor op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint); + constructor op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference); + + private + procedure init(_size : topsize); { this need to be called by all constructor } + end; + + + tai_align = class(tai_align_abstract) + { nothing to add } + end; + + procedure InitAsm; + procedure DoneAsm; + + +implementation + + +{***************************************************************************** + Taicpu Constructors +*****************************************************************************} + + + + + procedure taicpu.init(_size : topsize); + begin + typ:=ait_instruction; + is_jmp:=false; + opsize:=_size; + ops:=0; + end; + + + constructor taicpu.op_none(op : tasmop;_size : topsize); + begin + inherited create(op);; + init(_size); + end; + + + constructor taicpu.op_reg(op : tasmop;_size : topsize;_op1 : tregister); + begin + inherited create(op);; + init(_size); + ops:=1; + loadreg(0,_op1); + end; + + + constructor taicpu.op_const(op : tasmop;_size : topsize;_op1 : longint); + begin + inherited create(op);; + init(_size); + ops:=1; + loadconst(0,aword(_op1)); + end; + + + constructor taicpu.op_ref(op : tasmop;_size : topsize;_op1 : treference); + begin + inherited create(op);; + init(_size); + ops:=1; + loadref(0,_op1); + end; + + + constructor taicpu.op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister); + begin + inherited create(op);; + init(_size); + ops:=2; + loadreg(0,_op1); + loadreg(1,_op2); + end; + + + + constructor taicpu.op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;_op2 : treference); + begin + inherited create(op);; + init(_size); + ops:=2; + loadreg(0,_op1); + loadref(1,_op2); + end; + + + constructor taicpu.op_const_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister); + begin + inherited create(op);; + init(_size); + ops:=2; + loadconst(0,aword(_op1)); + loadreg(1,_op2); + end; + + + + constructor taicpu.op_const_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : treference); + begin + inherited create(op);; + init(_size); + ops:=2; + loadconst(0,aword(_op1)); + loadref(1,_op2); + end; + + + constructor taicpu.op_ref_reg(op : tasmop;_size : topsize;_op1 : treference;_op2 : tregister); + begin + inherited create(op);; + init(_size); + ops:=2; + loadref(0,_op1); + loadreg(1,_op2); + end; + + + constructor taicpu.op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol); + begin + inherited create(op);; + init(_size); + ops:=1; + loadsymbol(0,_op1,0); + end; + + + constructor taicpu.op_reg_sym(op: tasmop; _size : topsize; _op1: tregister; _op2 :tasmsymbol); + begin + inherited create(op); + init(_size); + ops:=2; + loadreg(0,_op1); + loadsymbol(1,_op2,0); + end; + + + constructor taicpu.op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference); + begin + inherited create(op); + init(_size); + ops:=2; + loadsymbol(0,_op1,_op1ofs); + loadref(1,_op2); + end; + + + constructor taicpu.op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint); + begin + inherited create(op); + init(_size); + ops:=1; + loadsymbol(0,_op1,_op1ofs); + end; + + constructor taicpu.op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister); + begin + inherited create(op);; + init(_size); + ops:=2; + loadreg(0,_op2); + loadsymbol(1,_op1,_op1ofs); + end; + + + constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol); + begin + inherited create(op); + init(_size); + condition:=cond; + ops:=1; + loadsymbol(0,_op1,0); + end; + + + + procedure InitAsm; + begin + end; + + + procedure DoneAsm; + begin + end; + +end. diff --git a/closures/compiler/vis/cpubase.pas b/closures/compiler/vis/cpubase.pas new file mode 100644 index 0000000000..a701cf006a --- /dev/null +++ b/closures/compiler/vis/cpubase.pas @@ -0,0 +1,608 @@ +{ + Copyright (c) 1998-2002 by the Free Pascal dev. team + + Contains the base types for the virtual instruction set + + 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 base types for the Virtual Instruction machine +} +unit cpubase; + +{$i fpcdefs.inc} + +interface + +uses + strings,cutils,cclasses,aasmbase,cpuinfo,cginfo; + + +{***************************************************************************** + Assembler Opcodes +*****************************************************************************} + + type + TAsmOp=(a_none,a_beqs,a_bges,a_bgts,a_bles,a_blts,a_bnes, + a_bras,a_rets,a_bccs,a_bcss,a_bvcs,a_bvss,a_bbss, + a_bass,a_bats,a_bbts,a_beql,a_bgel,a_bgtl,a_blel, + a_bltl,a_bnel,a_bral,a_bsrl,a_bbsl,a_basl,a_batl, + a_bbtl,a_add,a_addc,a_and,a_asr,a_lsl,a_lsr,a_cmp, + a_sub,a_subb,a_divs,a_divu,a_mod,a_move,a_muls,a_mulu, + a_neg,a_not,a_or,a_xor,a_fadd,a_fcmp,a_fdiv,a_fmove, + a_fmul,a_fneg,a_fsub,a_fldd,a_flds,a_lbzx,a_lbsx,a_llsx, + a_llzx,a_lwsx,a_lwzx,a_fstd,a_fsts,a_stb,a_stl,a_stw, + a_syscall,a_nop,a_lims,a_orhi,a_lilo,a_call,a_popl, + a_pushl, + { these are simplified mnemonics } + a_lea,a_limm,a_bxx + ); + + {# This should define the array of instructions as string } + op2strtable=array[tasmop] of string[8]; + + Const + {# First value of opcode enumeration } + firstop = low(tasmop); + {# Last value of opcode enumeration } + lastop = high(tasmop); + +{***************************************************************************** + Registers +*****************************************************************************} + + type + toldregister = (R_NO,R_R0,R_R1,R_R2,R_R3, + R_R4,R_R5,R_R6,R_R7, + R_R8,R_R9,R_R10,R_R11, + R_CCR,R_SP,R_FP,R_PC, + R_FP0,R_FP1,R_FP2,R_FP3, + R_FP4,R_FP5,R_FP6,R_FP7, + R_FP8,R_FP9,R_FP10,R_FP11, + R_FP12,R_FP13,R_FP14,R_FP15, + R_INTREGISTER,R_FPUREGISTER + ); + + {# Set type definition for registers } + tregisterset = set of Toldregister; + Tnewregister=word; + + tregister=record + enum:toldregister; + number:Tnewregister; + end; + + { A type to store register locations for 64 Bit values. } + tregister64 = packed record + reglo,reghi : tregister; + end; + + Tsuperregister=byte; + Tsubregister=byte; + + Tsupregset=set of Tsuperregister; + + { alias for compact code } + treg64 = tregister64; + + {# Type definition for the array of string of register nnames } + treg2strtable = array[toldregister] of string[5]; + + Const + + {Special registers:} + NR_NO = $0000; {Invalid register} + + {Normal registers:} + + {General purpose registers:} + NR_R0 = $0100; NR_R1 = $0200; NR_R2 = $0300; + NR_R3 = $0400; NR_R4 = $0500; NR_R5 = $0600; + NR_R6 = $0700; NR_R7 = $0800; NR_R8 = $0900; + NR_R9 = $0A00; NR_R10 = $0B00; NR_R11 = $0C00; + NR_SP = $0D00; NR_FP = $0E00; + + {Super registers:} + RS_R0 = $01; RS_R1 = $02; RS_R2 = $03; + RS_R3 = $04; RS_R4 = $05; RS_R5 = $06; + RS_R6 = $07; RS_R7 = $08; RS_R8 = $09; + RS_R9 = $0A; RS_R10 = $0B; RS_R11 = $0C; + RS_SP = $0D; RS_FP = $0E; + + {Subregisters:} + R_SUBL = $00; + R_SUBW = $01; + R_SUBD = $02; + + {# First register in the tregister enumeration } + firstreg = low(toldregister); + {# Last register in the tregister enumeration } + lastreg = high(toldregister); + + first_supreg = $01; + last_supreg = $0c; + + + std_reg2str : treg2strtable = ('', + 'r0','r1','r2','r3','r4','r5','r6','r7','r8','r9','r10','r11','ccr', + 'sp','fp','pc','fp0','fp1','fp2','fp3','fp4','fp5','fp6','fp7', + 'fp8','fp9','fp10','fp11','fp12','fp13','fp14','fp15','','' + ); + + +{***************************************************************************** + Conditions +*****************************************************************************} + + type + TAsmCond=(C_None, + C_EQ, { equal } + C_NE, { not equal } + C_GE, { greater or equal (signed) } + C_GT, { greater than (signed) } + C_LE, { less or equal (signed) } + C_LT, { less than (signed) } + C_LS, { lower or same (unordered) } + C_AS, { above or same (unordered) } + C_AT, { above than (unordered) } + C_BT, { below than (unordered) } + C_CC, { carry clear } + C_CS { carry set } + ); + + + const + cond2str:array[TAsmCond] of string[3]=('', + 'eq','ne','ge','gt','le','lt','ls','as', + 'at','bt','cc','cs'); + + +{***************************************************************************** + Flags +*****************************************************************************} + + type + TResFlags = ( + F_E, { zero flag = equal } + F_NE, { !zero_flag = not equal } + F_G, { greater (signed) } + F_L, { less (signed) } + F_GE, + F_LE, + F_C, { carry flag } + F_NC, { !carry flag } + F_A, { greater (unsigned) } + F_AE, + F_B, { less (unsigned) } + F_BE + ); + +{***************************************************************************** + Reference +*****************************************************************************} + + type + trefoptions=(ref_none,ref_parafixup,ref_localfixup,ref_selffixup); + + { reference record } + preference = ^treference; + treference = packed record + base, + index : tregister; + offset : longint; + symbol : tasmsymbol; + offsetfixup : longint; + options : trefoptions; + alignment : byte; + end; + + { reference record } + pparareference = ^tparareference; + tparareference = packed record + index : tregister; + offset : aword; + end; + + +{***************************************************************************** + Operand +*****************************************************************************} + + type + toptype=(top_none,top_reg,top_ref,top_const,top_symbol,top_bool); + + toper=record + ot : longint; + case typ : toptype of + top_none : (); + top_reg : (reg:tregister); + top_ref : (ref:^treference); + top_const : (val:aword); + top_symbol : (sym:tasmsymbol;symofs:longint); + top_bool : (b: boolean); + end; + +{***************************************************************************** + Operand Sizes +*****************************************************************************} + { S_NO = No Size of operand } + { S_B = 8-bit size operand } + { S_W = 16-bit size operand } + { S_L = 32-bit size operand } + { Floating point types } + { S_FS = single type (32 bit) } + { S_FD = double/64bit integer } + { S_FX = Extended type } + topsize = (S_NO,S_B,S_W,S_L,S_FS,S_FD,S_FX,S_IQ); + + +{***************************************************************************** + Generic Location +*****************************************************************************} + + type + TLoc=( + { added for tracking problems} + LOC_INVALID, + { ordinal constant } + LOC_CONSTANT, + { in a processor register } + LOC_REGISTER, + { Constant register which shouldn't be modified } + LOC_CREGISTER, + { FPU register} + LOC_FPUREGISTER, + { Constant FPU register which shouldn't be modified } + LOC_CFPUREGISTER, + { multimedia register } + LOC_MMREGISTER, + { Constant multimedia reg which shouldn't be modified } + LOC_CMMREGISTER, + { in memory } + LOC_REFERENCE, + { in memory (constant) } + LOC_CREFERENCE, + { boolean results only, jump to false or true label } + LOC_JUMP, + { boolean results only, flags are set } + LOC_FLAGS + ); + + { 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; + { The location type where the parameter is passed, usually + LOC_REFERENCE,LOC_REGISTER or LOC_FPUREGISTER + } + loc : TLoc; + { The stack pointer must be decreased by this value before + the parameter is copied to the given destination. + This allows to "encode" pushes with tparalocation. + On the PowerPC, this field is unsed but it is there + because several generic code accesses it. + } + sp_fixup : longint; + case TLoc of + LOC_REFERENCE : (reference : tparareference); + LOC_FPUREGISTER, LOC_CFPUREGISTER, LOC_MMREGISTER, LOC_CMMREGISTER, + 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; + + treglocation = packed record + 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 + size : TCGSize; + loc : tloc; + case tloc of + LOC_CREFERENCE,LOC_REFERENCE : (reference : treference); + 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_FPUREGISTER, LOC_CFPUREGISTER, LOC_MMREGISTER, LOC_CMMREGISTER, + LOC_REGISTER,LOC_CREGISTER : ( + case longint of + 1 : (register64.reglo,register64.reghi : tregister); + 2 : (register : tregister); + { overlay a 64 Bit register type } + 3 : (reg64 : tregister64); + 4 : (register64 : tregister64); + ); + LOC_FLAGS : (resflags : tresflags); + end; + +{***************************************************************************** + Constants +*****************************************************************************} + + const + max_operands = 2; + + lvaluelocations = [LOC_REFERENCE, LOC_CREGISTER, LOC_CFPUREGISTER, + LOC_CMMREGISTER]; + + {# Constant defining possibly all registers which might require saving } + ALL_REGISTERS = [R_FP0..R_FP15]; + + general_registers = [R_R0..R_R11]; + + {# low and high of the available maximum width integer general purpose } + { registers } + LoGPReg = R_R0; + HiGPReg = R_R11; + + {# low and high of every possible width general purpose register (same as } + { above on most architctures apart from the 80x86) } + LoReg = R_R0; + HiReg = R_R11; + + maxintregs = 12; + maxfpuregs = 16; + maxaddrregs = 0; + + maxvarregs = 10; + varregs : Array [1..maxvarregs] of toldregister = + (R_R2,R_R3,R_R4,R_R5,R_R6,R_R7,R_R8,R_R9,R_R10,R_R11); + + maxfpuvarregs = 15; + fpuvarregs : Array [1..maxfpuvarregs] of toldregister = + (R_FP1,R_FP2,R_FP3, + R_FP4,R_FP5,R_FP6, + R_FP7,R_FP8,R_FP9, + R_FP10,R_FP11,R_FP12, + R_FP13,R_FP14,R_FP15); + + + max_param_regs_int = 0; + + max_param_regs_fpu = 0; + + max_param_regs_mm = 0; + + {# 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 Tsuperregister = (RS_R0,RS_R1); + +{***************************************************************************** + 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; + {# the maximum float size for a processor, } + OS_FLOAT = OS_F64; + {# the size of a vector register for a processor } + OS_VECTOR = OS_NO; + +{***************************************************************************** + GDB Information +*****************************************************************************} + + {# Register indexes for stabs information, when some + parameters or variables are stored in registers. + + Currently unsupported by abstract machine + } + + stab_regindex : array[toldregister] of shortint = + (-1, + { r0..r11 } + -1,-1,-1,-1,-1,-1, + -1,-1,-1,-1,-1,-1, + { sp,fp,ccr,pc } + -1,-1,-1,-1, + { FP0..FP7 } + -1,-1,-1,-1,-1,-1,-1,-1, + { FP8..FP15 } + -1,-1,-1,-1,-1,-1,-1,-1, + { invalid } + -1,-1 + ); + + +{***************************************************************************** + Generic Register names +*****************************************************************************} + + {# Stack pointer register } + stack_pointer_reg = R_SP; + NR_STACK_POINTER_REG = NR_SP; + RS_STACK_POINTER_REG = RS_SP; + {# Frame pointer register } + frame_pointer_reg = R_FP; + NR_FRAME_POINTER_REG = NR_FP; + RS_FRAME_POINTER_REG = RS_FP; + {# Self pointer register : contains the instance address of an + object or class. } + self_pointer_reg = R_R11; + NR_SELF_POINTER_REG = NR_R11; + RS_SELF_POINTER_REG = RS_R11; + {# Register for addressing absolute data in a position independant way, + such as in PIC code. The exact meaning is ABI specific. + } + pic_offset_reg = R_R10; + {# Results are returned in this register (32-bit values) } + accumulator = R_R0; + NR_ACCUMULATOR = NR_R0; + RS_ACCUMULATOR = RS_R0; + {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; + {# Hi-Results are returned in this register (64-bit value high register) } + accumulatorhigh = R_R1; + NR_ACCUMULATORHIGH = NR_R1; + RS_ACCUMULATORHIGH = RS_R1; + fpu_result_reg = R_FP0; + mmresultreg = R_NO; + +{***************************************************************************** + GCC /ABI linking information +*****************************************************************************} + + {# Registers which must be saved when calling a routine declared as + cppdecl, cdecl, stdcall, safecall, palmossyscall. The registers + saved should be the ones as defined in the target ABI and / or GCC. + + This value can be deduced from CALLED_USED_REGISTERS array in the + GCC source. + } + std_saved_registers = [RS_R0,RS_R1,RS_R10,RS_R11]; + {# 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; { for 32-bit version only } + + +{***************************************************************************** + Helpers +*****************************************************************************} + + function is_calljmp(o:tasmop):boolean; + + procedure inverse_flags(var r : TResFlags); + function flags_to_cond(const f: TResFlags) : TAsmCond; + procedure convert_register_to_enum(var r:Tregister); + function cgsize2subreg(s:Tcgsize):Tsubregister; + + +implementation + + uses + verbose; + +{***************************************************************************** + Helpers +*****************************************************************************} + + function is_calljmp(o:tasmop):boolean; + begin + is_calljmp := false; + if o in [a_bxx,a_call,a_beqs..a_bbtl] then + is_calljmp := true; + end; + + procedure inverse_flags(var r: TResFlags); + const flagsinvers : array[F_E..F_BE] of tresflags = + (F_NE,F_E, + F_LE,F_GE, + F_L,F_G, + F_NC,F_C, + F_BE,F_B, + F_AE,F_A); + begin + r:=flagsinvers[r]; + end; + + + + function flags_to_cond(const f: TResFlags) : TAsmCond; + const flags2cond : array[tresflags] of tasmcond = + ( + {F_E} C_EQ, + {F_NE} C_NE, + {F_G } C_GT, + {F_L } C_LT, + {F_GE} C_GE, + {F_LE} C_LE, + {F_C} C_CS, + {F_NC} C_CC, + {F_A} C_AT, + {F_AE} C_AS, + {F_B} C_BT, + {F_BE} C_LS); + begin + flags_to_cond := flags2cond[f]; + end; + + + procedure convert_register_to_enum(var r:Tregister); + + begin + if r.enum = R_INTREGISTER then + case r.number of + NR_NO: r.enum:= R_NO; + NR_R0: r.enum:= R_R0; + NR_R1: r.enum:= R_R1; + NR_R2: r.enum:= R_R2; + NR_R3: r.enum:= R_R3; + NR_R4: r.enum:= R_R4; + NR_R5: r.enum:= R_R5; + NR_R6: r.enum:= R_R6; + NR_R7: r.enum:= R_R7; + NR_R8: r.enum:= R_R8; + NR_R9: r.enum:= R_R9; + NR_R10: r.enum:= R_R10; + NR_R11: r.enum:= R_R11; + else + internalerror(200301082); + end; + end; + + function cgsize2subreg(s:Tcgsize):Tsubregister; + + begin + case s of + OS_8,OS_S8: + cgsize2subreg:=R_SUBL; + OS_16,OS_S16: + cgsize2subreg:=R_SUBW; + OS_32,OS_S32: + cgsize2subreg:=R_SUBD; + else + internalerror(200301231); + end; + end; + + +end. diff --git a/closures/compiler/vis/cpuinfo.pas b/closures/compiler/vis/cpuinfo.pas new file mode 100644 index 0000000000..ef0fa47113 --- /dev/null +++ b/closures/compiler/vis/cpuinfo.pas @@ -0,0 +1,56 @@ +{ + Copyright (c) 1998-2002 by the Free Pascal development team + + Basic Processor information for the virtual instruction set + + 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 + +Type + { Architecture word - Native unsigned type } + AWord = Longword; + PAWord = ^AWord; + + { this must be an ordinal type with the same size as a pointer } + { to allow some dirty type casts for example when using } + { tconstsym.value } + { 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 = Longword; + + bestreal = double; + ts32real = single; + ts64real = double; + ts80real = extended; + ts64comp = comp; + + pbestreal=^bestreal; + + { possible supported processors for this target } + tcputype = (cpu_none); + +Const + {# Size of native extended floating point type } + extended_size = 8; + {# Size of a pointer } + sizeof(aint) = 4; + {# Size of a multimedia register } + mmreg_size = 8; + { target cpu string (used by compiler options) } + target_cpu_string = 'vis'; + +Implementation + +end. diff --git a/closures/compiler/vis/cpunode.pas b/closures/compiler/vis/cpunode.pas new file mode 100644 index 0000000000..010879c0e5 --- /dev/null +++ b/closures/compiler/vis/cpunode.pas @@ -0,0 +1,47 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + Includes the Virtual instrution set 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. + + **************************************************************************** +} +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) + } +// nvisadd, +// nviscal, +// nviscon, +// nvisflw, +// nvismem, +// nvisinl, +// nvismat, +// nviscnv + ; + +end. diff --git a/closures/compiler/vis/cpupara.pas b/closures/compiler/vis/cpupara.pas new file mode 100644 index 0000000000..f55a93ced6 --- /dev/null +++ b/closures/compiler/vis/cpupara.pas @@ -0,0 +1,74 @@ +{ + Copyright (c) 2002 by Florian Klaempfl + + Generates the argument location information for the + virtual instruction set machine + + 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. + + **************************************************************************** +} +{ Generates the argument location information for 680x0. +} +unit cpupara; + +{$i fpcdefs.inc} + + interface + + uses + cpubase, + symdef,paramgr; + + type + { Returns the location for the nr-st 32 Bit int parameter + if every parameter before is an 32 Bit int parameter as well + and if the calling conventions for the helper routines of the + rtl are used. + } + tcpuparamanager = class(tparamanager) + function getintparaloc(nr : longint) : tparalocation;override; + procedure create_param_loc_info(p : tabstractprocdef);override; + function getselflocation(p : tabstractprocdef) : tparalocation;override; + end; + + implementation + + uses + verbose, + globals, + globtype, + systems, + cpuinfo,cginfo,cgbase, + defutil; + + function tcpuparamanager.getintparaloc(nr : longint) : tparalocation; + begin + end; + + procedure tcpuparamanager.create_param_loc_info(p : tabstractprocdef); + var + param_offset : integer; + hp : tparaitem; + begin + end; + + function tcpuparamanager.getselflocation(p : tabstractprocdef) : tparalocation; + begin + end; + +begin + paramanager:=tcpuparamanager.create; +end. diff --git a/closures/compiler/widestr.pas b/closures/compiler/widestr.pas new file mode 100644 index 0000000000..a1be761dec --- /dev/null +++ b/closures/compiler/widestr.pas @@ -0,0 +1,326 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + This unit contains basic functions for unicode support in the + compiler, this unit is mainly necessary to bootstrap widestring + support ... + + 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 widestr; + +{$i fpcdefs.inc} + + interface + + uses + {$if FPC_FULLVERSION<20700}ccharset{$else}charset{$endif},globtype; + + + type + tcompilerwidechar = word; + tcompilerwidecharptr = ^tcompilerwidechar; + pcompilerwidechar = ^tcompilerwidechar; + + pcompilerwidestring = ^_tcompilerwidestring; + _tcompilerwidestring = record + data : pcompilerwidechar; + maxlen,len : SizeInt; + end; + + procedure initwidestring(out r : pcompilerwidestring); + procedure donewidestring(var r : pcompilerwidestring); + procedure setlengthwidestring(r : pcompilerwidestring;l : SizeInt); + function getlengthwidestring(r : pcompilerwidestring) : SizeInt; + procedure concatwidestringchar(r : pcompilerwidestring;c : tcompilerwidechar); + procedure concatwidestrings(s1,s2 : pcompilerwidestring); + function comparewidestrings(s1,s2 : pcompilerwidestring) : SizeInt; + procedure copywidestring(s,d : pcompilerwidestring); + function asciichar2unicode(c : char) : tcompilerwidechar; + function unicode2asciichar(c : tcompilerwidechar) : char; + procedure ascii2unicode(p : pchar;l : SizeInt;cp : tstringencoding;r : pcompilerwidestring); + procedure unicode2ascii(r : pcompilerwidestring;p : pchar;cp : tstringencoding); + function hasnonasciichars(const p: pcompilerwidestring): boolean; + function getcharwidestring(r : pcompilerwidestring;l : SizeInt) : tcompilerwidechar; + function cpavailable(const s : string) : boolean; + function cpavailable(cp : word) : boolean; + procedure changecodepage( + s : pchar; l : SizeInt; scp : tstringencoding; + d : pchar; dcp : tstringencoding + ); + function codepagebyname(const s : string) : tstringencoding; + + implementation + + uses + cp8859_1,cp850,cp437,cp1252, + { cyrillic code pages } + cp1251,cp866,cp8859_5, + globals,cutils; + + + procedure initwidestring(out r : pcompilerwidestring); + + begin + new(r); + r^.data:=nil; + r^.len:=0; + r^.maxlen:=0; + end; + + procedure donewidestring(var r : pcompilerwidestring); + + begin + if assigned(r^.data) then + freemem(r^.data); + dispose(r); + r:=nil; + end; + + function getcharwidestring(r : pcompilerwidestring;l : SizeInt) : tcompilerwidechar; + + begin + getcharwidestring:=r^.data[l]; + end; + + function getlengthwidestring(r : pcompilerwidestring) : SizeInt; + + begin + getlengthwidestring:=r^.len; + end; + + procedure growwidestring(r : pcompilerwidestring;l : SizeInt); + + begin + if r^.maxlen>=l then + exit; + if assigned(r^.data) then + reallocmem(r^.data,sizeof(tcompilerwidechar)*l) + else + getmem(r^.data,sizeof(tcompilerwidechar)*l); + r^.maxlen:=l; + end; + + procedure setlengthwidestring(r : pcompilerwidestring;l : SizeInt); + + begin + r^.len:=l; + if l>r^.maxlen then + growwidestring(r,l); + end; + + procedure concatwidestringchar(r : pcompilerwidestring;c : tcompilerwidechar); + + begin + if r^.len>=r^.maxlen then + growwidestring(r,r^.len+16); + r^.data[r^.len]:=c; + inc(r^.len); + end; + + procedure concatwidestrings(s1,s2 : pcompilerwidestring); + begin + growwidestring(s1,s1^.len+s2^.len); + move(s2^.data^,s1^.data[s1^.len],s2^.len*sizeof(tcompilerwidechar)); + inc(s1^.len,s2^.len); + end; + + procedure copywidestring(s,d : pcompilerwidestring); + + begin + setlengthwidestring(d,s^.len); + move(s^.data^,d^.data^,s^.len*sizeof(tcompilerwidechar)); + end; + + function comparewidestrings(s1,s2 : pcompilerwidestring) : SizeInt; + var + maxi,temp : SizeInt; + begin + if pointer(s1)=pointer(s2) then + begin + comparewidestrings:=0; + exit; + end; + maxi:=s1^.len; + temp:=s2^.len; + if maxi>temp then + maxi:=Temp; + temp:=compareword(s1^.data^,s2^.data^,maxi); + if temp=0 then + temp:=s1^.len-s2^.len; + comparewidestrings:=temp; + end; + + function asciichar2unicode(c : char) : tcompilerwidechar; + var + m : punicodemap; + begin + if (current_settings.sourcecodepage <> CP_UTF8) then + begin + m:=getmap(current_settings.sourcecodepage); + asciichar2unicode:=getunicode(c,m); + end + else + result:=tcompilerwidechar(c); + end; + + function unicode2asciichar(c : tcompilerwidechar) : char; + {begin + if word(c)<128 then + unicode2asciichar:=char(word(c)) + else + unicode2asciichar:='?'; + end;} + begin + Result := getascii(c,getmap(current_settings.sourcecodepage))[1]; + end; + + procedure ascii2unicode(p : pchar;l : SizeInt;cp : tstringencoding;r : pcompilerwidestring); + var + source : pchar; + dest : tcompilerwidecharptr; + i : SizeInt; + m : punicodemap; + begin + m:=getmap(cp); + setlengthwidestring(r,l); + source:=p; + dest:=tcompilerwidecharptr(r^.data); + if (current_settings.sourcecodepage <> CP_UTF8) then + begin + for i:=1 to l do + begin + dest^:=getunicode(source^,m); + inc(dest); + inc(source); + end; + end + else + begin + for i:=1 to l do + begin + dest^:=tcompilerwidechar(source^); + inc(dest); + inc(source); + end; + end; + end; + + procedure unicode2ascii(r : pcompilerwidestring;p:pchar;cp : tstringencoding); + var + m : punicodemap; + source : tcompilerwidecharptr; + dest : pchar; + i : longint; + begin + if (cp = 0) or (cp=CP_NONE) then + m:=getmap(current_settings.sourcecodepage) + else + m:=getmap(cp); + // !!!! MBCS + source:=tcompilerwidecharptr(r^.data); + dest:=p; + for i:=1 to r^.len do + begin + dest^ := getascii(source^,m)[1]; + inc(dest); + inc(source); + end; + end; +(* + var + source : tcompilerwidecharptr; + dest : pchar; + i : longint; + begin + { This routine must work the same as the + the routine in the RTL to have the same compile time (for constant strings) + and runtime conversion (for variables) } + source:=tcompilerwidecharptr(r^.data); + dest:=p; + for i:=1 to r^.len do + begin + if word(source^)<128 then + dest^:=char(word(source^)) + else + dest^:='?'; + inc(dest); + inc(source); + end; + end; +*) + + function hasnonasciichars(const p: pcompilerwidestring): boolean; + var + source : tcompilerwidecharptr; + i : longint; + begin + source:=tcompilerwidecharptr(p^.data); + result:=true; + for i:=1 to p^.len do + begin + if word(source^)>=128 then + exit; + inc(source); + end; + result:=false; + end; + + + function cpavailable(const s : string) : boolean; + begin + cpavailable:=mappingavailable(lower(s)); + end; + + function cpavailable(cp : word) : boolean; + begin + cpavailable:=mappingavailable(cp); + end; + + procedure changecodepage( + s : pchar; l : SizeInt; scp : tstringencoding; + d : pchar; dcp : tstringencoding + ); + var + ms, md : punicodemap; + source : pchar; + dest : pchar; + i : longint; + begin + ms:=getmap(scp); + md:=getmap(dcp); + source:=s; + dest:=d; + for i:=1 to l do + begin + dest^ := getascii(getunicode(source^,ms),md)[1]; + inc(dest); + inc(source); + end; + end; + + function codepagebyname(const s : string) : tstringencoding; + var + p : punicodemap; + begin + Result:=0; + p:=getmap(s); + if (p<>nil) then + Result:=p^.cp; + end; + +end. diff --git a/closures/compiler/wpo.pas b/closures/compiler/wpo.pas new file mode 100644 index 0000000000..1d3cf4d6e4 --- /dev/null +++ b/closures/compiler/wpo.pas @@ -0,0 +1,79 @@ +{ + Copyright (c) 2008 by Jonas Maebe + + Collects all whole program optimization plugin untits + + 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 wpo; + +{$i fpcdefs.inc} + +interface + +uses + { all units with whole program optimisation components } + optvirt,optdead; + + + procedure InitWpo; + procedure DoneWpo; + +implementation + + uses + globals, + comphook, + wpobase, wpoinfo; + + { called after command line parameters have been parsed } + procedure InitWpo; + begin + { always create so we don't have to litter the source with if-tests } + wpoinfomanager:=twpoinfomanager.create; + + { register the classes we can/should potentially use } + wpoinfomanager.registerwpocomponentclass(tprogdevirtinfo); + wpoinfomanager.registerwpocomponentclass(twpodeadcodeinfofromexternallinker); + + { assign input/output feedback files } + if (wpofeedbackinput<>'') then + wpoinfomanager.setwpoinputfile(wpofeedbackinput); + if (wpofeedbackoutput<>'') then + wpoinfomanager.setwpooutputfile(wpofeedbackoutput); + + { parse input } + wpoinfomanager.parseandcheckwpoinfo; + + { abort if error } + if (codegenerror) then + raise ECompilerAbort.Create; + end; + + + procedure DoneWpo; + begin + wpoinfomanager.free; + wpoinfomanager:=nil; + wpofeedbackinput:=''; + wpofeedbackoutput:=''; + end; + + +end. + diff --git a/closures/compiler/wpobase.pas b/closures/compiler/wpobase.pas new file mode 100644 index 0000000000..8e637540d6 --- /dev/null +++ b/closures/compiler/wpobase.pas @@ -0,0 +1,829 @@ +{ + Copyright (c) 2008 by Jonas Maebe + + Whole program optimisation information collection base class + + 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 wpobase; + +{$i fpcdefs.inc} + +interface + +uses + globtype, + cclasses, + symtype; + +type + { the types of available whole program optimization } + twpotype = (wpo_devirtualization_context_insensitive,wpo_live_symbol_information); +const + wpo2str: array[twpotype] of string[16] = ('devirtualization','symbol liveness'); + +type + { ************************************************************************* } + { ******************** General base classes/interfaces ******************** } + { ************************************************************************* } + + { interface to reading a section from a file with wpo info } + twposectionreaderintf = interface + ['{51BE3F89-C9C5-4965-9C83-AE7490C92E3E}'] + function sectiongetnextline(out s: string): boolean; + end; + + + { interface to writing sections to a file with wpoinfo } + twposectionwriterintf = interface + ['{C056F0DD-62B1-4612-86C7-2D39944C4437}'] + procedure startsection(const name: string); + procedure sectionputline(const s: string); + end; + + + { base class for wpo information stores } + + { twpocomponentbase } + + twpocomponentbase = class + public + constructor create; reintroduce; virtual; + + { type of whole program optimization information collected/provided by + this class + } + class function getwpotype: twpotype; virtual; abstract; + + { whole program optimizations for which this class generates information } + class function generatesinfoforwposwitches: twpoptimizerswitches; virtual; abstract; + + { whole program optimizations performed by this class } + class function performswpoforswitches: twpoptimizerswitches; virtual; abstract; + + { returns the name of the section parsed by this class } + class function sectionname: shortstring; virtual; abstract; + + { checks whether the compiler options are compatible with this + optimization (default: don't check anything) + } + class procedure checkoptions; virtual; + + { loads the information pertinent to this whole program optimization from + the current section being processed by reader + } + procedure loadfromwpofilesection(reader: twposectionreaderintf); virtual; abstract; + + { stores the information of this component to a file in a format that can + be loaded again using loadfromwpofilesection() + } + procedure storewpofilesection(writer: twposectionwriterintf); virtual; abstract; + + { extracts the information pertinent to this whole program optimization + from the current compiler state (loaded units, ...) + } + procedure constructfromcompilerstate; virtual; abstract; + end; + + twpocomponentbaseclass = class of twpocomponentbase; + + + { forward declaration of overall wpo info manager class } + + twpoinfomanagerbase = class; + + { ************************************************************************* } + { ** Information created per unit for use during subsequent compilation *** } + { ************************************************************************* } + + { information about called vmt entries for a class } + tcalledvmtentries = class + protected + { the class } + fobjdef: tdef; + fobjdefderef: tderef; + { the vmt entries } + fcalledentries: tbitset; + public + constructor create(_objdef: tdef; nentries: longint); + constructor ppuload(ppufile: tcompilerppufile); + destructor destroy; override; + procedure ppuwrite(ppufile: tcompilerppufile); + + procedure buildderef; + procedure buildderefimpl; + procedure deref; + procedure derefimpl; + + property objdef: tdef read fobjdef write fobjdef; + property objdefderef: tderef read fobjdefderef write fobjdefderef; + property calledentries: tbitset read fcalledentries write fcalledentries; + end; + + + { base class of information collected per unit. Still needs to be + generalised for different kinds of wpo information, currently specific + to devirtualization. + } + + tunitwpoinfobase = class + protected + { created object types } + fcreatedobjtypes: tfpobjectlist; + { objectdefs pointed to by created classrefdefs } + fcreatedclassrefobjtypes: tfpobjectlist; + { objtypes potentially instantiated by fcreatedclassrefobjtypes + (objdectdefs pointed to by classrefdefs that are + passed as a regular parameter, loaded in a variable, ... + so they can end up in a classrefdef var and be instantiated) + } + fmaybecreatedbyclassrefdeftypes: tfpobjectlist; + + { called virtual methods for all classes (hashed by mangled classname, + entries bitmaps indicating which vmt entries per class are called -- + tcalledvmtentries) + } + fcalledvmtentries: tfphashlist; + public + constructor create; reintroduce; virtual; + destructor destroy; override; + + property createdobjtypes: tfpobjectlist read fcreatedobjtypes; + property createdclassrefobjtypes: tfpobjectlist read fcreatedclassrefobjtypes; + property maybecreatedbyclassrefdeftypes: tfpobjectlist read fmaybecreatedbyclassrefdeftypes; + property calledvmtentries: tfphashlist read fcalledvmtentries; + + procedure addcreatedobjtype(def: tdef); + procedure addcreatedobjtypeforclassref(def: tdef); + procedure addmaybecreatedbyclassref(def: tdef); + procedure addcalledvmtentry(def: tdef; index: longint); + + { resets the "I've been registered with wpo" flags for all defs in the + above lists } + procedure resetdefs; + end; + + { ************************************************************************* } + { **** Total information created for use during subsequent compilation **** } + { ************************************************************************* } + + { class to create a file with wpo information } + + { tavailablewpofilewriter } + + twpofilewriter = class(tobject,twposectionwriterintf) + private + { array of class *instances* that wish to be written out to the + whole program optimization feedback file + } + fsectioncontents: tfpobjectlist; + + ffilename: tcmdstr; + foutputfile: text; + + public + constructor create(const fn: tcmdstr); + destructor destroy; override; + + procedure writefile; + + { starts a new section with name "name" } + procedure startsection(const name: string); + { writes s to the wpo file } + procedure sectionputline(const s: string); + + { register a component instance that needs to be written + to the wpo feedback file + } + procedure registerwpocomponent(component: twpocomponentbase); + end; + + { ************************************************************************* } + { ************ Information for use during current compilation ************* } + { ************************************************************************* } + + { class to read a file with wpo information } + twpofilereader = class(tobject,twposectionreaderintf) + private + ffilename: tcmdstr; + flinenr: longint; + finputfile: text; + fcurline: string; + fusecurline: boolean; + + { destination for the read information } + fdest: twpoinfomanagerbase; + + function getnextnoncommentline(out s: string): boolean; + public + + constructor create(const fn: tcmdstr; dest: twpoinfomanagerbase); + destructor destroy; override; + + { processes the wpo info in the file } + procedure processfile; + + { returns next line of the current section in s, and false if no more + lines in the current section + } + function sectiongetnextline(out s: string): boolean; + end; + + + { ************************************************************************* } + { ******* Specific kinds of whole program optimization components ********* } + { ************************************************************************* } + + { method devirtualisation } + twpodevirtualisationhandler = class(twpocomponentbase) + { checks whether procdef (a procdef for a virtual method) can be replaced with + a static call when it's called as objdef.procdef, and if so returns the + mangled name in staticname. + } + function staticnameforcallingvirtualmethod(objdef, procdef: tdef; out staticname: string): boolean; virtual; abstract; + { checks whether procdef (a procdef for a virtual method) can be replaced with + a different procname in the vmt of objdef, and if so returns the new + mangledname in staticname + } + function staticnameforvmtentry(objdef, procdef: tdef; out staticname: string): boolean; virtual; abstract; + end; + + twpodeadcodehandler = class(twpocomponentbase) + { checks whether a mangledname was removed as dead code from the final + binary (WARNING: must *not* be called for functions marked as inline, + since if all call sites are inlined, it won't appear in the final + binary but nevertheless is still necessary!) + } + function symbolinfinalbinary(const s: shortstring): boolean; virtual; abstract; + end; + + + { ************************************************************************* } + { ************ Collection of all instances of wpo components ************** } + { ************************************************************************* } + + { class doing all the bookkeeping for everything } + + twpoinfomanagerbase = class + private + { array of classrefs of handler classes for the various kinds of whole + program optimizations that we support + } + fwpocomponents: tfphashlist; + + freader: twpofilereader; + fwriter: twpofilewriter; + public + { instances of the various optimizers/information collectors (for + information used during this compilation) + } + wpoinfouse: array[twpotype] of twpocomponentbase; + + { register a whole program optimization class type } + procedure registerwpocomponentclass(wpocomponent: twpocomponentbaseclass); + + { get the program optimization class type that can parse the contents + of the section with name "secname" in the wpo feedback file + } + function gethandlerforsection(const secname: string): twpocomponentbaseclass; + + { tell all instantiated wpo component classes to collect the information + from the global compiler state that they need (done at the very end of + the compilation process) + } + procedure extractwpoinfofromprogram; + + { set the name of the feedback file from which all whole-program information + to be used during the current compilation will be read + } + procedure setwpoinputfile(const fn: tcmdstr); + + { set the name of the feedback file to which all whole-program information + collected during the current compilation will be written + } + procedure setwpooutputfile(const fn: tcmdstr); + + { check whether the specified wpo options (-FW/-Fw/-OW/-Ow) are complete + and sensical, and parse the wpo feedback file specified with + setwpoinputfile + } + procedure parseandcheckwpoinfo; + + { routines accessing the optimizer information } + { 1) devirtualization at the symbol name level } + function can_be_devirtualized(objdef, procdef: tdef; out name: shortstring): boolean; virtual; abstract; + { 2) optimal replacement method name in vmt } + function optimized_name_for_vmt(objdef, procdef: tdef; out name: shortstring): boolean; virtual; abstract; + { 3) does a symbol appear in the final binary (i.e., not removed by dead code stripping/smart linking). + WARNING: do *not* call for inline functions/procedures/methods/... + } + function symbol_live(const name: shortstring): boolean; virtual; abstract; + + constructor create; reintroduce; + destructor destroy; override; + end; + + + var + wpoinfomanager: twpoinfomanagerbase; + +implementation + + uses + globals, + cutils, + sysutils, + symdef, + verbose; + + + { tcreatedwpoinfobase } + + constructor tunitwpoinfobase.create; + begin + fcreatedobjtypes:=tfpobjectlist.create(false); + fcreatedclassrefobjtypes:=tfpobjectlist.create(false); + fmaybecreatedbyclassrefdeftypes:=tfpobjectlist.create(false); + fcalledvmtentries:=tfphashlist.create; + end; + + + destructor tunitwpoinfobase.destroy; + var + i: longint; + begin + { don't call resetdefs here, because the defs may have been freed + already } + fcreatedobjtypes.free; + fcreatedobjtypes:=nil; + fcreatedclassrefobjtypes.free; + fcreatedclassrefobjtypes:=nil; + fmaybecreatedbyclassrefdeftypes.free; + fmaybecreatedbyclassrefdeftypes:=nil; + + { may not be assigned in case the info was loaded from a ppu and we + are not generating a wpo feedback file (see tunitwpoinfo.ppuload) + } + if assigned(fcalledvmtentries) then + begin + for i:=0 to fcalledvmtentries.count-1 do + tcalledvmtentries(fcalledvmtentries[i]).free; + fcalledvmtentries.free; + fcalledvmtentries:=nil; + end; + + inherited destroy; + end; + + + procedure tunitwpoinfobase.resetdefs; + var + i: ptrint; + begin + if assigned(fcreatedobjtypes) then + for i:=0 to fcreatedobjtypes.count-1 do + tobjectdef(fcreatedobjtypes[i]).created_in_current_module:=false; + if assigned(fcreatedclassrefobjtypes) then + for i:=0 to fcreatedclassrefobjtypes.count-1 do + tobjectdef(fcreatedclassrefobjtypes[i]).classref_created_in_current_module:=false; + if assigned(fmaybecreatedbyclassrefdeftypes) then + for i:=0 to fmaybecreatedbyclassrefdeftypes.count-1 do + tobjectdef(fmaybecreatedbyclassrefdeftypes[i]).maybe_created_in_current_module:=false; + end; + + + procedure tunitwpoinfobase.addcreatedobjtype(def: tdef); + begin + fcreatedobjtypes.add(def); + end; + + + procedure tunitwpoinfobase.addcreatedobjtypeforclassref(def: tdef); + begin + fcreatedclassrefobjtypes.add(def); + end; + + + procedure tunitwpoinfobase.addmaybecreatedbyclassref(def: tdef); + begin + fmaybecreatedbyclassrefdeftypes.add(def); + end; + + + procedure tunitwpoinfobase.addcalledvmtentry(def: tdef; index: longint); + var + entries: tcalledvmtentries; + key: shortstring; + begin + key:=tobjectdef(def).vmt_mangledname; + entries:=tcalledvmtentries(fcalledvmtentries.find(key)); + if not assigned(entries) then + begin + entries:=tcalledvmtentries.create(def,tobjectdef(def).vmtentries.count); + fcalledvmtentries.add(key,entries); + end; + entries.calledentries.include(index); + end; + + + { twpofilereader } + + function twpofilereader.getnextnoncommentline(out s: string): + boolean; + begin + if (fusecurline) then + begin + s:=fcurline; + fusecurline:=false; + result:=true; + exit; + end; + repeat + readln(finputfile,s); + if (s='') and + eof(finputfile) then + begin + result:=false; + exit; + end; + inc(flinenr); + until (s='') or + (s[1]<>'#'); + result:=true; + end; + + constructor twpofilereader.create(const fn: tcmdstr; dest: twpoinfomanagerbase); + begin + if not FileExists(fn) or + { FileExists also returns true for directories } + DirectoryExists(fn) then + begin + cgmessage1(wpo_cant_find_file,fn); + exit; + end; + assign(finputfile,fn); + ffilename:=fn; + + fdest:=dest; + end; + + destructor twpofilereader.destroy; + begin + inherited destroy; + end; + + procedure twpofilereader.processfile; + var + sectionhandler: twpocomponentbaseclass; + i: longint; + wpotype: twpotype; + s, + sectionname: string; + begin + cgmessage1(wpo_begin_processing,ffilename); + reset(finputfile); + flinenr:=0; + while getnextnoncommentline(s) do + begin + if (s='') then + continue; + { format: "% sectionname" } + if (s[1]<>'%') then + begin + cgmessage2(wpo_expected_section,tostr(flinenr),s); + break; + end; + for i:=2 to length(s) do + if (s[i]<>' ') then + break; + sectionname:=copy(s,i,255); + + { find handler for section and process } + sectionhandler:=fdest.gethandlerforsection(sectionname); + if assigned(sectionhandler) then + begin + wpotype:=sectionhandler.getwpotype; + cgmessage2(wpo_found_section,sectionname,wpo2str[wpotype]); + { do we need this information? } + if ((sectionhandler.performswpoforswitches * init_settings.dowpoptimizerswitches) <> []) then + begin + { did some other section already generate this type of information? } + if assigned(fdest.wpoinfouse[wpotype]) then + begin + cgmessage2(wpo_duplicate_wpotype,wpo2str[wpotype],sectionname); + fdest.wpoinfouse[wpotype].free; + end; + { process the section } + fdest.wpoinfouse[wpotype]:=sectionhandler.create; + twpocomponentbase(fdest.wpoinfouse[wpotype]).loadfromwpofilesection(self); + end + else + begin + cgmessage1(wpo_skipping_unnecessary_section,sectionname); + { skip the current section } + while sectiongetnextline(s) do + ; + end; + end + else + begin + cgmessage1(wpo_no_section_handler,sectionname); + { skip the current section } + while sectiongetnextline(s) do + ; + end; + end; + close(finputfile); + cgmessage1(wpo_end_processing,ffilename); + end; + + function twpofilereader.sectiongetnextline(out s: string): boolean; + begin + result:=getnextnoncommentline(s); + if not result then + exit; + { start of new section? } + if (s<>'') and + (s[1]='%') then + begin + { keep read line for next call to getnextnoncommentline() } + fcurline:=s; + fusecurline:=true; + result:=false; + end; + end; + + + { twpocomponentbase } + + constructor twpocomponentbase.create; + begin + { do nothing } + end; + + + class procedure twpocomponentbase.checkoptions; + begin + { do nothing } + end; + + { twpofilewriter } + + constructor twpofilewriter.create(const fn: tcmdstr); + begin + assign(foutputfile,fn); + ffilename:=fn; + fsectioncontents:=tfpobjectlist.create(true); + end; + + destructor twpofilewriter.destroy; + begin + fsectioncontents.free; + inherited destroy; + end; + + procedure twpofilewriter.writefile; + var + i: longint; + begin + {$push}{$i-} + rewrite(foutputfile); + {$pop} + if (ioresult <> 0) then + begin + cgmessage1(wpo_cant_create_feedback_file,ffilename); + exit; + end; + for i:=0 to fsectioncontents.count-1 do + twpocomponentbase(fsectioncontents[i]).storewpofilesection(self); + close(foutputfile); + end; + + procedure twpofilewriter.startsection(const name: string); + begin + writeln(foutputfile,'% ',name); + end; + + procedure twpofilewriter.sectionputline(const s: string); + begin + writeln(foutputfile,s); + end; + + procedure twpofilewriter.registerwpocomponent( + component: twpocomponentbase); + begin + fsectioncontents.add(component); + end; + +{ twpoinfomanagerbase } + + procedure twpoinfomanagerbase.registerwpocomponentclass(wpocomponent: twpocomponentbaseclass); + begin + fwpocomponents.add(wpocomponent.sectionname,wpocomponent); + end; + + + function twpoinfomanagerbase.gethandlerforsection(const secname: string + ): twpocomponentbaseclass; + begin + result:=twpocomponentbaseclass(fwpocomponents.find(secname)); + end; + + procedure twpoinfomanagerbase.setwpoinputfile(const fn: tcmdstr); + begin + freader:=twpofilereader.create(fn,self); + end; + + procedure twpoinfomanagerbase.setwpooutputfile(const fn: tcmdstr); + begin + fwriter:=twpofilewriter.create(fn); + end; + + procedure twpoinfomanagerbase.parseandcheckwpoinfo; + var + i: longint; + begin + { error if we don't have to optimize yet have an input feedback file } + if (init_settings.dowpoptimizerswitches=[]) and + assigned(freader) then + begin + cgmessage(wpo_input_without_info_use); + exit; + end; + + { error if we have to optimize yet don't have an input feedback file } + if (init_settings.dowpoptimizerswitches<>[]) and + not assigned(freader) then + begin + cgmessage(wpo_no_input_specified); + exit; + end; + + { if we have to generate wpo information, check that a file has been + specified and that we have something to write to it + } + if (init_settings.genwpoptimizerswitches<>[]) and + not assigned(fwriter) then + begin + cgmessage(wpo_no_output_specified); + exit; + end; + + if (init_settings.genwpoptimizerswitches=[]) and + assigned(fwriter) then + begin + cgmessage(wpo_output_without_info_gen); + exit; + end; + + { now read the input feedback file } + if assigned(freader) then + begin + freader.processfile; + freader.free; + freader:=nil; + end; + + { and for each specified optimization check whether the input feedback + file contained the necessary information + } + if (([cs_wpo_devirtualize_calls,cs_wpo_optimize_vmts] * init_settings.dowpoptimizerswitches) <> []) and + not assigned(wpoinfouse[wpo_devirtualization_context_insensitive]) then + begin + cgmessage1(wpo_not_enough_info,wpo2str[wpo_devirtualization_context_insensitive]); + exit; + end; + + if (cs_wpo_symbol_liveness in init_settings.dowpoptimizerswitches) and + not assigned(wpoinfouse[wpo_live_symbol_information]) then + begin + cgmessage1(wpo_not_enough_info,wpo2str[wpo_live_symbol_information]); + exit; + end; + + { perform pre-checking to ensure there are no known incompatibilities between + the selected optimizations and other switches + } + for i:=0 to fwpocomponents.count-1 do + if (twpocomponentbaseclass(fwpocomponents[i]).generatesinfoforwposwitches*init_settings.genwpoptimizerswitches)<>[] then + twpocomponentbaseclass(fwpocomponents[i]).checkoptions + end; + + procedure twpoinfomanagerbase.extractwpoinfofromprogram; + var + i: longint; + info: twpocomponentbase; + begin + { if don't have to write anything, fwriter has not been created } + if not assigned(fwriter) then + exit; + + { let all wpo components gather the necessary info from the compiler state } + for i:=0 to fwpocomponents.count-1 do + if (twpocomponentbaseclass(fwpocomponents[i]).generatesinfoforwposwitches*current_settings.genwpoptimizerswitches)<>[] then + begin + info:=twpocomponentbaseclass(fwpocomponents[i]).create; + info.constructfromcompilerstate; + fwriter.registerwpocomponent(info); + end; + { and write their info to disk } + fwriter.writefile; + fwriter.free; + fwriter:=nil; + end; + + constructor twpoinfomanagerbase.create; + begin + inherited create; + fwpocomponents:=tfphashlist.create; + end; + + destructor twpoinfomanagerbase.destroy; + var + i: twpotype; + begin + freader.free; + freader:=nil; + fwriter.free; + fwriter:=nil; + fwpocomponents.free; + fwpocomponents:=nil; + for i:=low(wpoinfouse) to high(wpoinfouse) do + if assigned(wpoinfouse[i]) then + wpoinfouse[i].free; + inherited destroy; + end; + + { tcalledvmtentries } + + constructor tcalledvmtentries.create(_objdef: tdef; nentries: longint); + begin + objdef:=_objdef; + calledentries:=tbitset.create(nentries); + end; + + + constructor tcalledvmtentries.ppuload(ppufile: tcompilerppufile); + var + len: longint; + begin + ppufile.getderef(fobjdefderef); + len:=ppufile.getlongint; + calledentries:=tbitset.create_bytesize(len); + if (len <> calledentries.datasize) then + internalerror(2009060301); + ppufile.readdata(calledentries.data^,len); + end; + + + destructor tcalledvmtentries.destroy; + begin + fcalledentries.free; + inherited destroy; + end; + + + procedure tcalledvmtentries.ppuwrite(ppufile: tcompilerppufile); + begin + ppufile.putderef(objdefderef); + ppufile.putlongint(calledentries.datasize); + ppufile.putdata(calledentries.data^,calledentries.datasize); + end; + + + procedure tcalledvmtentries.buildderef; + begin + objdefderef.build(objdef); + end; + + + procedure tcalledvmtentries.buildderefimpl; + begin + end; + + + procedure tcalledvmtentries.deref; + begin + objdef:=tdef(objdefderef.resolve); + end; + + + procedure tcalledvmtentries.derefimpl; + begin + end; + +end. diff --git a/closures/compiler/wpoinfo.pas b/closures/compiler/wpoinfo.pas new file mode 100644 index 0000000000..d43da1bf63 --- /dev/null +++ b/closures/compiler/wpoinfo.pas @@ -0,0 +1,329 @@ +{ + Copyright (c) 2008 by Jonas Maebe + + Whole program optimisation information collection + + 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 wpoinfo; + +{$i fpcdefs.inc} + +interface + +uses + cclasses, + symtype, + wpobase, + ppu; + +type + pderefarray = ^tderefarray; + tderefarray = array[0..1024*1024-1] of tderef; + + tunitwpoinfo = class(tunitwpoinfobase) + { devirtualisation information -- begin } + private + fcreatedobjtypesderefs: pderefarray; + fcreatedclassrefobjtypesderefs: pderefarray; + fmaybecreatedbyclassrefdeftypesderefs: pderefarray; + fcalledvmtentriestemplist: tfpobjectlist; + { devirtualisation information -- end } + + procedure clearderefinfo; + public + + destructor destroy; override; + + procedure ppuwrite(ppufile:tcompilerppufile); + constructor ppuload(ppufile:tcompilerppufile); + + procedure deref; + procedure derefimpl; + procedure buildderef; + procedure buildderefimpl; + end; + + + { twpoinfomanager } + + twpoinfomanager = class(twpoinfomanagerbase) + function can_be_devirtualized(objdef, procdef: tdef; out name: shortstring): boolean; override; + function optimized_name_for_vmt(objdef, procdef: tdef; out name: shortstring): boolean; override; + function symbol_live(const name: shortstring): boolean; override; + end; + + +implementation + + uses + globtype, + globals, + symdef, + verbose; + + procedure tunitwpoinfo.clearderefinfo; + begin + if assigned(fcreatedobjtypesderefs) then + begin + freemem(fcreatedobjtypesderefs); + fcreatedobjtypesderefs:=nil; + end; + if assigned(fcreatedclassrefobjtypesderefs) then + begin + freemem(fcreatedclassrefobjtypesderefs); + fcreatedclassrefobjtypesderefs:=nil; + end; + if assigned(fmaybecreatedbyclassrefdeftypesderefs) then + begin + freemem(fmaybecreatedbyclassrefdeftypesderefs); + fmaybecreatedbyclassrefdeftypesderefs:=nil; + end; + + if assigned(fcalledvmtentriestemplist) then + begin + fcalledvmtentriestemplist.free; + fcalledvmtentriestemplist:=nil; + end; + end; + + destructor tunitwpoinfo.destroy; + begin + clearderefinfo; + inherited destroy; + end; + + + procedure tunitwpoinfo.ppuwrite(ppufile:tcompilerppufile); + var + i: longint; + begin + { write the number of instantiated object types in this module, + followed by the derefs of those types + } + ppufile.putlongint(fcreatedobjtypes.count); + for i:=0 to fcreatedobjtypes.count-1 do + ppufile.putderef(fcreatedobjtypesderefs^[i]); + ppufile.putlongint(fcreatedclassrefobjtypes.count); + for i:=0 to fcreatedclassrefobjtypes.count-1 do + ppufile.putderef(fcreatedclassrefobjtypesderefs^[i]); + ppufile.putlongint(fmaybecreatedbyclassrefdeftypes.count); + for i:=0 to fmaybecreatedbyclassrefdeftypes.count-1 do + ppufile.putderef(fmaybecreatedbyclassrefdeftypesderefs^[i]); + + ppufile.putlongint(fcalledvmtentriestemplist.count); + for i:=0 to fcalledvmtentriestemplist.count-1 do + tcalledvmtentries(fcalledvmtentriestemplist[i]).ppuwrite(ppufile); + + ppufile.writeentry(ibcreatedobjtypes); + + { don't free deref arrays immediately after use, as the types may need + re-resolving in case a unit needs to be reloaded + } + end; + + + constructor tunitwpoinfo.ppuload(ppufile:tcompilerppufile); + var + i, len: longint; + begin + { load start of definition section, which holds the amount of defs } + if ppufile.readentry<>ibcreatedobjtypes then + cgmessage(unit_f_ppu_read_error); + + { don't load the wpo info from the units if we are not generating + a wpo feedback file (that would just take time and memory) + } + if (init_settings.genwpoptimizerswitches=[]) then + ppufile.skipdata(ppufile.entrysize) + else + begin + len:=ppufile.getlongint; + fcreatedobjtypes:=tfpobjectlist.create(false); + fcreatedobjtypes.count:=len; + getmem(fcreatedobjtypesderefs,len*sizeof(tderef)); + for i:=0 to len-1 do + ppufile.getderef(fcreatedobjtypesderefs^[i]); + + len:=ppufile.getlongint; + fcreatedclassrefobjtypes:=tfpobjectlist.create(false); + fcreatedclassrefobjtypes.count:=len; + getmem(fcreatedclassrefobjtypesderefs,len*sizeof(tderef)); + for i:=0 to len-1 do + ppufile.getderef(fcreatedclassrefobjtypesderefs^[i]); + + len:=ppufile.getlongint; + fmaybecreatedbyclassrefdeftypes:=tfpobjectlist.create(false); + fmaybecreatedbyclassrefdeftypes.count:=len; + getmem(fmaybecreatedbyclassrefdeftypesderefs,len*sizeof(tderef)); + for i:=0 to len-1 do + ppufile.getderef(fmaybecreatedbyclassrefdeftypesderefs^[i]); + + len:=ppufile.getlongint; + fcalledvmtentriestemplist:=tfpobjectlist.create(false); + fcalledvmtentriestemplist.count:=len; + fcalledvmtentries:=tfphashlist.create; + for i:=0 to len-1 do + fcalledvmtentriestemplist[i]:=tcalledvmtentries.ppuload(ppufile); + end; + end; + + + procedure tunitwpoinfo.buildderef; + var + i: longint; + begin + { ppuload may have already been called before -> deref info structures + may already have been allocated } + clearderefinfo; + + getmem(fcreatedobjtypesderefs,fcreatedobjtypes.count*sizeof(tderef)); + for i:=0 to fcreatedobjtypes.count-1 do + fcreatedobjtypesderefs^[i].build(fcreatedobjtypes[i]); + + getmem(fcreatedclassrefobjtypesderefs,fcreatedclassrefobjtypes.count*sizeof(tderef)); + for i:=0 to fcreatedclassrefobjtypes.count-1 do + fcreatedclassrefobjtypesderefs^[i].build(fcreatedclassrefobjtypes[i]); + + getmem(fmaybecreatedbyclassrefdeftypesderefs,fmaybecreatedbyclassrefdeftypes.count*sizeof(tderef)); + for i:=0 to fmaybecreatedbyclassrefdeftypes.count-1 do + fmaybecreatedbyclassrefdeftypesderefs^[i].build(fmaybecreatedbyclassrefdeftypes[i]); + + fcalledvmtentriestemplist:=tfpobjectlist.create(false); + fcalledvmtentriestemplist.count:=fcalledvmtentries.count; + for i:=0 to fcalledvmtentries.count-1 do + begin + tcalledvmtentries(fcalledvmtentries[i]).buildderef; + { necessary in case we have unit1 loads unit2, unit2 is recompiled, + then unit1 derefs unit2 -> in this case we have buildderef for unit2 + -> ppuwrite for unit2 -> deref for unit2 (without a load) -> ensure + that the fcalledvmtentriestemplist, normally constructed by ppuload, + is created here as well since deref needs it } + fcalledvmtentriestemplist[i]:=tobject(fcalledvmtentries[i]); + end; + end; + + + procedure tunitwpoinfo.buildderefimpl; + var + i: longint; + begin + for i:=0 to fcalledvmtentriestemplist.count-1 do + begin + tcalledvmtentries(fcalledvmtentriestemplist[i]).buildderefimpl; + end; + end; + + + procedure tunitwpoinfo.deref; + var + i: longint; + + begin + if (init_settings.genwpoptimizerswitches=[]) or + not assigned(fcalledvmtentriestemplist) then + exit; + + { don't free deref arrays immediately after use, as the types may need + re-resolving in case a unit needs to be reloaded + } + for i:=0 to fcreatedobjtypes.count-1 do + fcreatedobjtypes[i]:=fcreatedobjtypesderefs^[i].resolve; + + for i:=0 to fcreatedclassrefobjtypes.count-1 do + fcreatedclassrefobjtypes[i]:=fcreatedclassrefobjtypesderefs^[i].resolve; + + for i:=0 to fmaybecreatedbyclassrefdeftypes.count-1 do + fmaybecreatedbyclassrefdeftypes[i]:=fmaybecreatedbyclassrefdeftypesderefs^[i].resolve; + + { in case we are re-resolving, free previous batch } + if (fcalledvmtentries.count<>0) then + fcalledvmtentries.clear; + { allocate enough internal memory in one go } + fcalledvmtentries.capacity:=fcalledvmtentriestemplist.count; + { now resolve all items in the list and add them to the hash table } + for i:=0 to fcalledvmtentriestemplist.count-1 do + begin + with tcalledvmtentries(fcalledvmtentriestemplist[i]) do + begin + deref; + fcalledvmtentries.add(tobjectdef(objdef).vmt_mangledname, + fcalledvmtentriestemplist[i]); + end; + end; + end; + + + procedure tunitwpoinfo.derefimpl; + var + i: longint; + begin + if (init_settings.genwpoptimizerswitches=[]) or + not assigned(fcalledvmtentriestemplist) then + exit; + + for i:=0 to fcalledvmtentriestemplist.count-1 do + begin + tcalledvmtentries(fcalledvmtentriestemplist[i]).derefimpl; + end; + end; + + + { twpoinfomanager } + + { devirtualisation } + + function twpoinfomanager.can_be_devirtualized(objdef, procdef: tdef; out name: shortstring): boolean; + begin + if not assigned(wpoinfouse[wpo_devirtualization_context_insensitive]) or + not(cs_wpo_devirtualize_calls in current_settings.dowpoptimizerswitches) then + begin + result:=false; + exit; + end; + result:=twpodevirtualisationhandler(wpoinfouse[wpo_devirtualization_context_insensitive]).staticnameforcallingvirtualmethod(objdef,procdef,name); + end; + + + function twpoinfomanager.optimized_name_for_vmt(objdef, procdef: tdef; out name: shortstring): boolean; + begin + if not assigned(wpoinfouse[wpo_devirtualization_context_insensitive]) or + not(cs_wpo_optimize_vmts in current_settings.dowpoptimizerswitches) then + begin + result:=false; + exit; + end; + result:=twpodevirtualisationhandler(wpoinfouse[wpo_devirtualization_context_insensitive]).staticnameforvmtentry(objdef,procdef,name); + end; + + + { symbol liveness } + + function twpoinfomanager.symbol_live(const name: shortstring): boolean; + begin + if not assigned(wpoinfouse[wpo_live_symbol_information]) or + not(cs_wpo_symbol_liveness in current_settings.dowpoptimizerswitches) then + begin + { if we don't know, say that the symbol is live } + result:=true; + exit; + end; + result:=twpodeadcodehandler(wpoinfouse[wpo_live_symbol_information]).symbolinfinalbinary(name); + end; + + +end. diff --git a/closures/compiler/x86/aasmcpu.pas b/closures/compiler/x86/aasmcpu.pas new file mode 100644 index 0000000000..dc7d7cee8a --- /dev/null +++ b/closures/compiler/x86/aasmcpu.pas @@ -0,0 +1,2626 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl and Peter Vreman + + Contains the abstract assembler implementation for the i386 + + * Portions of this code was inspired by the NASM sources + The Netwide Assembler is Copyright (c) 1996 Simon Tatham and + Julian Hall. All rights reserved. + + 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 + globtype,verbose, + cpubase, + cgbase,cgutils, + symtype, + aasmbase,aasmtai,aasmdata,aasmsym, + ogbase; + + const + { "mov reg,reg" source operand number } + O_MOV_SOURCE = 0; + { "mov reg,reg" destination operand number } + O_MOV_DEST = 1; + + { Operand types } + OT_NONE = $00000000; + + { Bits 0..7: sizes } + OT_BITS8 = $00000001; + OT_BITS16 = $00000002; + OT_BITS32 = $00000004; + OT_BITS64 = $00000008; { x86_64 and FPU } + OT_BITS80 = $00000010; { FPU only } + OT_FAR = $00000020; { this means 16:16 or 16:32, like in CALL/JMP } + OT_NEAR = $00000040; + OT_SHORT = $00000080; + + { TODO: FAR/NEAR/SHORT are sizes too, they should be included into size mask, + but this requires adjusting the opcode table } + OT_SIZE_MASK = $0000001F; { all the size attributes } + OT_NON_SIZE = longint(not OT_SIZE_MASK); + + { Bits 8..11: modifiers } + OT_SIGNED = $00000100; { the operand need to be signed -128-127 } + OT_TO = $00000200; { reverse effect in FADD, FSUB &c } + OT_COLON = $00000400; { operand is followed by a colon } + OT_MODIFIER_MASK = $00000F00; + + { Bits 12..15: type of operand } + OT_REGISTER = $00001000; + OT_IMMEDIATE = $00002000; + OT_MEMORY = $0000C000; { always includes 'OT_REGMEM' bit as well } + OT_REGMEM = $00008000; { for r/m, ie EA, operands } + OT_TYPE_MASK = OT_REGISTER or OT_IMMEDIATE or OT_MEMORY or OT_REGMEM; + + OT_REGNORM = OT_REGISTER or OT_REGMEM; { 'normal' reg, qualifies as EA } + + { Bits 20..22, 24..26: register classes + otf_* consts are not used alone, only to build other constants. } + otf_reg_cdt = $00100000; + otf_reg_gpr = $00200000; + otf_reg_sreg = $00400000; + otf_reg_fpu = $01000000; + otf_reg_mmx = $02000000; + otf_reg_xmm = $04000000; + { Bits 16..19: subclasses, meaning depends on classes field } + otf_sub0 = $00010000; + otf_sub1 = $00020000; + otf_sub2 = $00040000; + otf_sub3 = $00080000; + OT_REG_SMASK = otf_sub0 or otf_sub1 or otf_sub2 or otf_sub3; + + { register class 0: CRx, DRx and TRx } +{$ifdef x86_64} + OT_REG_CDT = OT_REGISTER or otf_reg_cdt or OT_BITS64; +{$else x86_64} + OT_REG_CDT = OT_REGISTER or otf_reg_cdt or OT_BITS32; +{$endif x86_64} + OT_REG_CREG = OT_REG_CDT or otf_sub0; { CRn } + OT_REG_DREG = OT_REG_CDT or otf_sub1; { DRn } + OT_REG_TREG = OT_REG_CDT or otf_sub2; { TRn } + OT_REG_CR4 = OT_REG_CDT or otf_sub3; { CR4 (Pentium only) } + + { register class 1: general-purpose registers } + OT_REG_GPR = OT_REGNORM or otf_reg_gpr; + OT_RM_GPR = OT_REGMEM or otf_reg_gpr; + OT_REG8 = OT_REG_GPR or OT_BITS8; { 8-bit GPR } + OT_REG16 = OT_REG_GPR or OT_BITS16; + OT_REG32 = OT_REG_GPR or OT_BITS32; + OT_REG64 = OT_REG_GPR or OT_BITS64; + + { GPR subclass 0: accumulator: AL, AX, EAX or RAX } + OT_REG_ACCUM = OT_REG_GPR or otf_sub0; + OT_REG_AL = OT_REG_ACCUM or OT_BITS8; + OT_REG_AX = OT_REG_ACCUM or OT_BITS16; + OT_REG_EAX = OT_REG_ACCUM or OT_BITS32; +{$ifdef x86_64} + OT_REG_RAX = OT_REG_ACCUM or OT_BITS64; +{$endif x86_64} + { GPR subclass 1: counter: CL, CX, ECX or RCX } + OT_REG_COUNT = OT_REG_GPR or otf_sub1; + OT_REG_CL = OT_REG_COUNT or OT_BITS8; + OT_REG_CX = OT_REG_COUNT or OT_BITS16; + OT_REG_ECX = OT_REG_COUNT or OT_BITS32; +{$ifdef x86_64} + OT_REG_RCX = OT_REG_COUNT or OT_BITS64; +{$endif x86_64} + { GPR subclass 2: data register: DL, DX, EDX or RDX } + OT_REG_DX = OT_REG_GPR or otf_sub2 or OT_BITS16; + OT_REG_EDX = OT_REG_GPR or otf_sub2 or OT_BITS32; + + { register class 2: Segment registers } + OT_REG_SREG = OT_REGISTER or otf_reg_sreg or OT_BITS16; + OT_REG_CS = OT_REG_SREG or otf_sub0; { CS } + OT_REG_DESS = OT_REG_SREG or otf_sub1; { DS, ES, SS (non-CS 86 registers) } + OT_REG_FSGS = OT_REG_SREG or otf_sub2; { FS, GS (386 extended registers) } + + { register class 3: FPU registers } + OT_FPUREG = OT_REGISTER or otf_reg_fpu; + OT_FPU0 = OT_FPUREG or otf_sub0; { FPU stack register zero } + + { register class 4: MMX (both reg and r/m) } + OT_MMXREG = OT_REGNORM or otf_reg_mmx; + OT_MMXRM = OT_REGMEM or otf_reg_mmx; + + { register class 5: XMM (both reg and r/m) } + OT_XMMREG = OT_REGNORM or otf_reg_xmm; + OT_XMMRM = OT_REGMEM or otf_reg_xmm; + + { Memory operands } + OT_MEM8 = OT_MEMORY or OT_BITS8; + OT_MEM16 = OT_MEMORY or OT_BITS16; + OT_MEM32 = OT_MEMORY or OT_BITS32; + OT_MEM64 = OT_MEMORY or OT_BITS64; + OT_MEM80 = OT_MEMORY or OT_BITS80; + + OT_MEM_OFFS = OT_MEMORY or otf_sub0; { special type of EA } + { simple [address] offset } + + { Matches any type of r/m operand } + OT_MEMORY_ANY = OT_MEMORY or OT_RM_GPR or OT_XMMRM or OT_MMXRM; + + { Immediate operands } + OT_IMM8 = OT_IMMEDIATE or OT_BITS8; + OT_IMM16 = OT_IMMEDIATE or OT_BITS16; + OT_IMM32 = OT_IMMEDIATE or OT_BITS32; + OT_IMM64 = OT_IMMEDIATE or OT_BITS64; + + OT_ONENESS = otf_sub0; { special type of immediate operand } + OT_UNITY = OT_IMMEDIATE or OT_ONENESS; { for shift/rotate instructions } + + { Size of the instruction table converted by nasmconv.pas } +{$ifdef x86_64} + instabentries = {$i x8664nop.inc} +{$else x86_64} + instabentries = {$i i386nop.inc} +{$endif x86_64} + maxinfolen = 8; + MaxInsChanges = 3; { Max things a instruction can change } + + type + { What an instruction can change. Needed for optimizer and spilling code. + + Note: The order of this enumeration is should not be changed! } + TInsChange = (Ch_None, + {Read from a register} + Ch_REAX, Ch_RECX, Ch_REDX, Ch_REBX, Ch_RESP, Ch_REBP, Ch_RESI, Ch_REDI, + {write from a register} + Ch_WEAX, Ch_WECX, Ch_WEDX, Ch_WEBX, Ch_WESP, Ch_WEBP, Ch_WESI, Ch_WEDI, + {read and write from/to a register} + Ch_RWEAX, Ch_RWECX, Ch_RWEDX, Ch_RWEBX, Ch_RWESP, Ch_RWEBP, Ch_RWESI, Ch_RWEDI, + {modify the contents of a register with the purpose of using + this changed content afterwards (add/sub/..., but e.g. not rep + or movsd)} + Ch_MEAX, Ch_MECX, Ch_MEDX, Ch_MEBX, Ch_MESP, Ch_MEBP, Ch_MESI, Ch_MEDI, + Ch_CDirFlag {clear direction flag}, Ch_SDirFlag {set dir flag}, + Ch_RFlags, Ch_WFlags, Ch_RWFlags, Ch_FPU, + Ch_Rop1, Ch_Wop1, Ch_RWop1,Ch_Mop1, + Ch_Rop2, Ch_Wop2, Ch_RWop2,Ch_Mop2, + Ch_Rop3, Ch_WOp3, Ch_RWOp3,Ch_Mop3, + Ch_WMemEDI, + Ch_All, + { x86_64 registers } + Ch_RRAX, Ch_RRCX, Ch_RRDX, Ch_RRBX, Ch_RRSP, Ch_RRBP, Ch_RRSI, Ch_RRDI, + Ch_WRAX, Ch_WRCX, Ch_WRDX, Ch_WRBX, Ch_WRSP, Ch_WRBP, Ch_WRSI, Ch_WRDI, + Ch_RWRAX, Ch_RWRCX, Ch_RWRDX, Ch_RWRBX, Ch_RWRSP, Ch_RWRBP, Ch_RWRSI, Ch_RWRDI, + Ch_MRAX, Ch_MRCX, Ch_MRDX, Ch_MRBX, Ch_MRSP, Ch_MRBP, Ch_MRSI, Ch_MRDI + ); + + TInsProp = packed record + Ch : Array[1..MaxInsChanges] of TInsChange; + end; + + const + InsProp : array[tasmop] of TInsProp = +{$ifdef x86_64} + {$i x8664pro.inc} +{$else x86_64} + {$i i386prop.inc} +{$endif x86_64} + + type + TOperandOrder = (op_intel,op_att); + + tinsentry=packed record + opcode : tasmop; + ops : byte; + optypes : array[0..max_operands-1] of longint; + code : array[0..maxinfolen] of char; + flags : cardinal; + end; + pinsentry=^tinsentry; + + { alignment for operator } + tai_align = class(tai_align_abstract) + reg : tregister; + constructor create(b:byte);override; + constructor create_op(b: byte; _op: byte);override; + function calculatefillbuf(var buf : tfillbuffer;executable : boolean):pchar;override; + end; + + taicpu = class(tai_cpu_abstract_sym) + opsize : topsize; + constructor op_none(op : tasmop); + constructor op_none(op : tasmop;_size : topsize); + + constructor op_reg(op : tasmop;_size : topsize;_op1 : tregister); + constructor op_const(op : tasmop;_size : topsize;_op1 : aint); + constructor op_ref(op : tasmop;_size : topsize;const _op1 : treference); + + constructor op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister); + constructor op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;const _op2 : treference); + constructor op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: aint); + + constructor op_const_reg(op : tasmop;_size : topsize;_op1 : aint;_op2 : tregister); + constructor op_const_const(op : tasmop;_size : topsize;_op1,_op2 : aint); + constructor op_const_ref(op : tasmop;_size : topsize;_op1 : aint;const _op2 : treference); + + constructor op_ref_reg(op : tasmop;_size : topsize;const _op1 : treference;_op2 : tregister); + + constructor op_reg_reg_reg(op : tasmop;_size : topsize;_op1,_op2,_op3 : tregister); + constructor op_const_reg_reg(op : tasmop;_size : topsize;_op1 : aint;_op2 : tregister;_op3 : tregister); + constructor op_const_ref_reg(op : tasmop;_size : topsize;_op1 : aint;const _op2 : treference;_op3 : tregister); + constructor op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister; const _op3 : treference); + constructor op_const_reg_ref(op : tasmop;_size : topsize;_op1 : aint;_op2 : tregister;const _op3 : treference); + + { this is for Jmp instructions } + constructor op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol); + + constructor op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol); + constructor op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint); + constructor op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister); + constructor op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference); + + procedure changeopsize(siz:topsize); + + function GetString:string; + procedure CheckNonCommutativeOpcodes; + private + FOperandOrder : TOperandOrder; + procedure init(_size : topsize); { this need to be called by all constructor } + public + { the next will reset all instructions that can change in pass 2 } + procedure ResetPass1;override; + procedure ResetPass2;override; + function CheckIfValid:boolean; + function Pass1(objdata:TObjData):longint;override; + procedure Pass2(objdata:TObjData);override; + procedure SetOperandOrder(order:TOperandOrder); + function is_same_reg_move(regtype: Tregistertype):boolean;override; + { register spilling code } + function spilling_get_operation_type(opnr: longint): topertype;override; + private + { next fields are filled in pass1, so pass2 is faster } + insentry : PInsEntry; + insoffset : longint; + LastInsOffset : longint; { need to be public to be reset } + inssize : shortint; +{$ifdef x86_64} + rex : byte; +{$endif x86_64} + function InsEnd:longint; + procedure create_ot(objdata:TObjData); + function Matches(p:PInsEntry):boolean; + function calcsize(p:PInsEntry):shortint; + procedure gencode(objdata:TObjData); + function NeedAddrPrefix(opidx:byte):boolean; + procedure Swapoperands; + function FindInsentry(objdata:TObjData):boolean; + end; + + function spilling_create_load(const ref:treference;r:tregister):Taicpu; + function spilling_create_store(r:tregister; const ref:treference):Taicpu; + + procedure InitAsm; + procedure DoneAsm; + + +implementation + + uses + cutils, + globals, + systems, + procinfo, + itcpugas, + symsym; + +{***************************************************************************** + Instruction table +*****************************************************************************} + + const + {Instruction flags } + IF_NONE = $00000000; + IF_SM = $00000001; { size match first two operands } + IF_SM2 = $00000002; + IF_SB = $00000004; { unsized operands can't be non-byte } + IF_SW = $00000008; { unsized operands can't be non-word } + IF_SD = $00000010; { unsized operands can't be nondword } + IF_SMASK = $0000001f; + IF_AR0 = $00000020; { SB, SW, SD applies to argument 0 } + IF_AR1 = $00000040; { SB, SW, SD applies to argument 1 } + IF_AR2 = $00000060; { SB, SW, SD applies to argument 2 } + IF_ARMASK = $00000060; { mask for unsized argument spec } + IF_ARSHIFT = 5; { LSB of IF_ARMASK } + IF_PRIV = $00000100; { it's a privileged instruction } + IF_SMM = $00000200; { it's only valid in SMM } + IF_PROT = $00000400; { it's protected mode only } + IF_NOX86_64 = $00000800; { removed instruction in x86_64 } + IF_UNDOC = $00001000; { it's an undocumented instruction } + IF_FPU = $00002000; { it's an FPU instruction } + IF_MMX = $00004000; { it's an MMX instruction } + { it's a 3DNow! instruction } + IF_3DNOW = $00008000; + { it's a SSE (KNI, MMX2) instruction } + IF_SSE = $00010000; + { SSE2 instructions } + IF_SSE2 = $00020000; + { SSE3 instructions } + IF_SSE3 = $00040000; + { SSE64 instructions } + IF_SSE64 = $00080000; + { the mask for processor types } + {IF_PMASK = longint($FF000000);} + { the mask for disassembly "prefer" } + {IF_PFMASK = longint($F001FF00);} + { SVM instructions } + IF_SVM = $00100000; + { SSE4 instructions } + IF_SSE4 = $00200000; + { TODO: These flags were added to make x86ins.dat more readable. + Values must be reassigned to make any other use of them. } + IF_SSSE3 = $00200000; + IF_SSE41 = $00200000; + IF_SSE42 = $00200000; + + IF_8086 = $00000000; { 8086 instruction } + IF_186 = $01000000; { 186+ instruction } + IF_286 = $02000000; { 286+ instruction } + IF_386 = $03000000; { 386+ instruction } + IF_486 = $04000000; { 486+ instruction } + IF_PENT = $05000000; { Pentium instruction } + IF_P6 = $06000000; { P6 instruction } + IF_KATMAI = $07000000; { Katmai instructions } + { Willamette instructions } + IF_WILLAMETTE = $08000000; + { Prescott instructions } + IF_PRESCOTT = $09000000; + IF_X86_64 = $0a000000; + IF_CYRIX = $0b000000; { Cyrix-specific instruction } + IF_AMD = $0c000000; { AMD-specific instruction } + IF_CENTAUR = $0d000000; { centaur-specific instruction } + { added flags } + IF_PRE = $40000000; { it's a prefix instruction } + IF_PASS2 = $80000000; { if the instruction can change in a second pass } + + type + TInsTabCache=array[TasmOp] of longint; + PInsTabCache=^TInsTabCache; + + const +{$ifdef x86_64} + InsTab:array[0..instabentries-1] of TInsEntry={$i x8664tab.inc} +{$else x86_64} + InsTab:array[0..instabentries-1] of TInsEntry={$i i386tab.inc} +{$endif x86_64} + var + InsTabCache : PInsTabCache; + + const +{$ifdef x86_64} + { Intel style operands ! } + opsize_2_type:array[0..2,topsize] of longint=( + (OT_NONE, + OT_BITS8,OT_BITS16,OT_BITS32,OT_BITS64,OT_BITS16,OT_BITS32,OT_BITS32,OT_BITS64,OT_BITS64,OT_BITS64, + OT_BITS16,OT_BITS32,OT_BITS64, + OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_NONE, + OT_BITS64, + OT_NEAR,OT_FAR,OT_SHORT, + OT_NONE, + OT_NONE + ), + (OT_NONE, + OT_BITS8,OT_BITS16,OT_BITS32,OT_BITS64,OT_BITS8,OT_BITS8,OT_BITS16,OT_BITS8,OT_BITS16,OT_BITS32, + OT_BITS16,OT_BITS32,OT_BITS64, + OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_NONE, + OT_BITS64, + OT_NEAR,OT_FAR,OT_SHORT, + OT_NONE, + OT_NONE + ), + (OT_NONE, + OT_BITS8,OT_BITS16,OT_BITS32,OT_BITS64,OT_NONE,OT_NONE,OT_NONE,OT_NONE,OT_NONE,OT_NONE, + OT_BITS16,OT_BITS32,OT_BITS64, + OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_NONE, + OT_BITS64, + OT_NEAR,OT_FAR,OT_SHORT, + OT_NONE, + OT_NONE + ) + ); + + reg_ot_table : array[tregisterindex] of longint = ( + {$i r8664ot.inc} + ); +{$else x86_64} + { Intel style operands ! } + opsize_2_type:array[0..2,topsize] of longint=( + (OT_NONE, + OT_BITS8,OT_BITS16,OT_BITS32,OT_BITS64,OT_BITS16,OT_BITS32,OT_BITS32, + OT_BITS16,OT_BITS32,OT_BITS64, + OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_NONE, + OT_BITS64, + OT_NEAR,OT_FAR,OT_SHORT, + OT_NONE, + OT_NONE + ), + (OT_NONE, + OT_BITS8,OT_BITS16,OT_BITS32,OT_BITS64,OT_BITS8,OT_BITS8,OT_BITS16, + OT_BITS16,OT_BITS32,OT_BITS64, + OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_NONE, + OT_BITS64, + OT_NEAR,OT_FAR,OT_SHORT, + OT_NONE, + OT_NONE + ), + (OT_NONE, + OT_BITS8,OT_BITS16,OT_BITS32,OT_BITS64,OT_NONE,OT_NONE,OT_NONE, + OT_BITS16,OT_BITS32,OT_BITS64, + OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_NONE, + OT_BITS64, + OT_NEAR,OT_FAR,OT_SHORT, + OT_NONE, + OT_NONE + ) + ); + + reg_ot_table : array[tregisterindex] of longint = ( + {$i r386ot.inc} + ); +{$endif x86_64} + + { Operation type for spilling code } + type + toperation_type_table=array[tasmop,0..Max_Operands] of topertype; + var + operation_type_table : ^toperation_type_table; + + +{**************************************************************************** + TAI_ALIGN + ****************************************************************************} + + constructor tai_align.create(b: byte); + begin + inherited create(b); + reg:=NR_ECX; + end; + + + constructor tai_align.create_op(b: byte; _op: byte); + begin + inherited create_op(b,_op); + reg:=NR_NO; + end; + + + function tai_align.calculatefillbuf(var buf : tfillbuffer;executable : boolean):pchar; + const +{$ifdef x86_64} + alignarray:array[0..3] of string[4]=( + #$66#$66#$66#$90, + #$66#$66#$90, + #$66#$90, + #$90 + ); +{$else x86_64} + alignarray:array[0..5] of string[8]=( + #$8D#$B4#$26#$00#$00#$00#$00, + #$8D#$B6#$00#$00#$00#$00, + #$8D#$74#$26#$00, + #$8D#$76#$00, + #$89#$F6, + #$90); +{$endif x86_64} + var + bufptr : pchar; + j : longint; + localsize: byte; + begin + inherited calculatefillbuf(buf,executable); + if not(use_op) and executable then + begin + bufptr:=pchar(@buf); + { fillsize may still be used afterwards, so don't modify } + { e.g. writebytes(hp.calculatefillbuf(buf)^,hp.fillsize) } + localsize:=fillsize; + while (localsize>0) do + begin + for j:=low(alignarray) to high(alignarray) do + if (localsize>=length(alignarray[j])) then + break; + move(alignarray[j][1],bufptr^,length(alignarray[j])); + inc(bufptr,length(alignarray[j])); + dec(localsize,length(alignarray[j])); + end; + end; + calculatefillbuf:=pchar(@buf); + end; + + +{***************************************************************************** + Taicpu Constructors +*****************************************************************************} + + procedure taicpu.changeopsize(siz:topsize); + begin + opsize:=siz; + end; + + + procedure taicpu.init(_size : topsize); + begin + { default order is att } + FOperandOrder:=op_att; + segprefix:=NR_NO; + opsize:=_size; + insentry:=nil; + LastInsOffset:=-1; + InsOffset:=0; + InsSize:=0; + end; + + + constructor taicpu.op_none(op : tasmop); + begin + inherited create(op); + init(S_NO); + end; + + + constructor taicpu.op_none(op : tasmop;_size : topsize); + begin + inherited create(op); + init(_size); + end; + + + constructor taicpu.op_reg(op : tasmop;_size : topsize;_op1 : tregister); + begin + inherited create(op); + init(_size); + ops:=1; + loadreg(0,_op1); + end; + + + constructor taicpu.op_const(op : tasmop;_size : topsize;_op1 : aint); + begin + inherited create(op); + init(_size); + ops:=1; + loadconst(0,_op1); + end; + + + constructor taicpu.op_ref(op : tasmop;_size : topsize;const _op1 : treference); + begin + inherited create(op); + init(_size); + ops:=1; + loadref(0,_op1); + end; + + + constructor taicpu.op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister); + begin + inherited create(op); + init(_size); + ops:=2; + loadreg(0,_op1); + loadreg(1,_op2); + end; + + + constructor taicpu.op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: aint); + begin + inherited create(op); + init(_size); + ops:=2; + loadreg(0,_op1); + loadconst(1,_op2); + end; + + + constructor taicpu.op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;const _op2 : treference); + begin + inherited create(op); + init(_size); + ops:=2; + loadreg(0,_op1); + loadref(1,_op2); + end; + + + constructor taicpu.op_const_reg(op : tasmop;_size : topsize;_op1 : aint;_op2 : tregister); + begin + inherited create(op); + init(_size); + ops:=2; + loadconst(0,_op1); + loadreg(1,_op2); + end; + + + constructor taicpu.op_const_const(op : tasmop;_size : topsize;_op1,_op2 : aint); + begin + inherited create(op); + init(_size); + ops:=2; + loadconst(0,_op1); + loadconst(1,_op2); + end; + + + constructor taicpu.op_const_ref(op : tasmop;_size : topsize;_op1 : aint;const _op2 : treference); + begin + inherited create(op); + init(_size); + ops:=2; + loadconst(0,_op1); + loadref(1,_op2); + end; + + + constructor taicpu.op_ref_reg(op : tasmop;_size : topsize;const _op1 : treference;_op2 : tregister); + begin + inherited create(op); + init(_size); + ops:=2; + loadref(0,_op1); + loadreg(1,_op2); + end; + + + constructor taicpu.op_reg_reg_reg(op : tasmop;_size : topsize;_op1,_op2,_op3 : tregister); + begin + inherited create(op); + init(_size); + ops:=3; + loadreg(0,_op1); + loadreg(1,_op2); + loadreg(2,_op3); + end; + + + constructor taicpu.op_const_reg_reg(op : tasmop;_size : topsize;_op1 : aint;_op2 : tregister;_op3 : tregister); + begin + inherited create(op); + init(_size); + ops:=3; + loadconst(0,_op1); + loadreg(1,_op2); + loadreg(2,_op3); + end; + + + constructor taicpu.op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister;const _op3 : treference); + begin + inherited create(op); + init(_size); + ops:=3; + loadreg(0,_op1); + loadreg(1,_op2); + loadref(2,_op3); + end; + + + constructor taicpu.op_const_ref_reg(op : tasmop;_size : topsize;_op1 : aint;const _op2 : treference;_op3 : tregister); + begin + inherited create(op); + init(_size); + ops:=3; + loadconst(0,_op1); + loadref(1,_op2); + loadreg(2,_op3); + end; + + + constructor taicpu.op_const_reg_ref(op : tasmop;_size : topsize;_op1 : aint;_op2 : tregister;const _op3 : treference); + begin + inherited create(op); + init(_size); + ops:=3; + loadconst(0,_op1); + loadreg(1,_op2); + loadref(2,_op3); + end; + + + constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol); + begin + inherited create(op); + init(_size); + condition:=cond; + ops:=1; + loadsymbol(0,_op1,0); + end; + + + constructor taicpu.op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol); + begin + inherited create(op); + init(_size); + ops:=1; + loadsymbol(0,_op1,0); + end; + + + constructor taicpu.op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint); + begin + inherited create(op); + init(_size); + ops:=1; + loadsymbol(0,_op1,_op1ofs); + end; + + + constructor taicpu.op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister); + begin + inherited create(op); + init(_size); + ops:=2; + loadsymbol(0,_op1,_op1ofs); + loadreg(1,_op2); + end; + + + constructor taicpu.op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;const _op2 : treference); + begin + inherited create(op); + init(_size); + ops:=2; + loadsymbol(0,_op1,_op1ofs); + loadref(1,_op2); + end; + + + function taicpu.GetString:string; + var + i : longint; + s : string; + addsize : boolean; + begin + s:='['+std_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_XMMREG)=OT_XMMREG then + s:=s+'xmmreg' + else + if (ot and OT_MMXREG)=OT_MMXREG then + s:=s+'mmxreg' + 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_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; + 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+'16' + else + if (ot and OT_BITS32)<>0 then + s:=s+'32' + else + if (ot and OT_BITS64)<>0 then + s:=s+'64' + else + s:=s+'??'; + { signed } + if (ot and OT_SIGNED)<>0 then + s:=s+'s'; + end; + end; + end; + GetString:=s+']'; + end; + + + procedure taicpu.Swapoperands; + var + p : POper; + begin + { Fix the operands which are in AT&T style and we need them in Intel style } + case ops of + 0,1: + ; + 2 : begin + { 0,1 -> 1,0 } + p:=oper[0]; + oper[0]:=oper[1]; + oper[1]:=p; + end; + 3 : begin + { 0,1,2 -> 2,1,0 } + p:=oper[0]; + oper[0]:=oper[2]; + oper[2]:=p; + end; + 4 : begin + { 0,1,2,3 -> 3,2,1,0 } + p:=oper[0]; + oper[0]:=oper[3]; + oper[3]:=p; + p:=oper[1]; + oper[1]:=oper[2]; + oper[2]:=p; + end; + else + internalerror(201108141); + end; + end; + + + procedure taicpu.SetOperandOrder(order:TOperandOrder); + begin + if FOperandOrder<>order then + begin + Swapoperands; + FOperandOrder:=order; + end; + end; + + + procedure taicpu.CheckNonCommutativeOpcodes; + begin + { we need ATT order } + SetOperandOrder(op_att); + + if ( + (ops=2) and + (oper[0]^.typ=top_reg) and + (oper[1]^.typ=top_reg) and + { if the first is ST and the second is also a register + it is necessarily ST1 .. ST7 } + ((oper[0]^.reg=NR_ST) or + (oper[0]^.reg=NR_ST0)) + ) or + { ((ops=1) and + (oper[0]^.typ=top_reg) and + (oper[0]^.reg in [R_ST1..R_ST7])) or} + (ops=0) then + begin + if opcode=A_FSUBR then + opcode:=A_FSUB + else if opcode=A_FSUB then + opcode:=A_FSUBR + else if opcode=A_FDIVR then + opcode:=A_FDIV + else if opcode=A_FDIV then + opcode:=A_FDIVR + else if opcode=A_FSUBRP then + opcode:=A_FSUBP + else if opcode=A_FSUBP then + opcode:=A_FSUBRP + else if opcode=A_FDIVRP then + opcode:=A_FDIVP + else if opcode=A_FDIVP then + opcode:=A_FDIVRP; + end; + if ( + (ops=1) and + (oper[0]^.typ=top_reg) and + (getregtype(oper[0]^.reg)=R_FPUREGISTER) and + (oper[0]^.reg<>NR_ST) + ) then + begin + if opcode=A_FSUBRP then + opcode:=A_FSUBP + else if opcode=A_FSUBP then + opcode:=A_FSUBRP + else if opcode=A_FDIVRP then + opcode:=A_FDIVP + else if opcode=A_FDIVP then + opcode:=A_FDIVRP; + end; + end; + + +{***************************************************************************** + Assembler +*****************************************************************************} + + type + ea = packed record + sib_present : boolean; + bytes : byte; + size : byte; + modrm : byte; + sib : byte; +{$ifdef x86_64} + rex : byte; +{$endif x86_64} + end; + + procedure taicpu.create_ot(objdata:TObjData); + { + this function will also fix some other fields which only needs to be once + } + var + i,l,relsize : longint; + currsym : TObjSymbol; + 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_reg : + begin + ot:=reg_ot_table[findreg_by_number(reg)]; + end; + top_ref : + begin + if (ref^.refaddr=addr_no) +{$ifdef i386} + or ( + (ref^.refaddr in [addr_pic]) and + { allow any base for assembler blocks } + ((assigned(current_procinfo) and + (pi_has_assembler_block in current_procinfo.flags) and + (ref^.base<>NR_NO)) or (ref^.base=NR_EBX)) + ) +{$endif i386} +{$ifdef x86_64} + or ( + (ref^.refaddr in [addr_pic,addr_pic_no_got]) and + (ref^.base<>NR_NO) + ) +{$endif x86_64} + then + begin + { create ot field } + if (ot and OT_SIZE_MASK)=0 then + ot:=OT_MEMORY_ANY or opsize_2_type[i,opsize] + else + ot:=OT_MEMORY_ANY or (ot and OT_SIZE_MASK); + if (ref^.base=NR_NO) and (ref^.index=NR_NO) then + ot:=ot or OT_MEM_OFFS; + { fix scalefactor } + if (ref^.index=NR_NO) then + ref^.scalefactor:=0 + else + if (ref^.scalefactor=0) then + ref^.scalefactor:=1; + end + else + begin + { Jumps use a relative offset which can be 8bit, + for other opcodes we always need to generate the full + 32bit address } + if assigned(objdata) and + is_jmp then + begin + currsym:=objdata.symbolref(ref^.symbol); + l:=ref^.offset; + if assigned(currsym) then + inc(l,currsym.address); + { when it is a forward jump we need to compensate the + offset of the instruction since the previous time, + because the symbol address is then still using the + 'old-style' addressing. + For backwards jumps this is not required because the + address of the symbol is already adjusted to the + new offset } + if (l>InsOffset) and (LastInsOffset<>-1) then + inc(l,InsOffset-LastInsOffset); + { instruction size will then always become 2 (PFV) } + relsize:=(InsOffset+2)-l; + if (relsize>=-128) and (relsize<=127) and + ( + not assigned(currsym) or + (currsym.objsection=objdata.currobjsec) + ) then + ot:=OT_IMM8 or OT_SHORT + else + ot:=OT_IMM32 or OT_NEAR; + end + else + ot:=OT_IMM32 or OT_NEAR; + end; + end; + top_local : + begin + if (ot and OT_SIZE_MASK)=0 then + ot:=OT_MEMORY or opsize_2_type[i,opsize] + else + ot:=OT_MEMORY or (ot and OT_SIZE_MASK); + end; + top_const : + begin + { allow 2nd, 3rd or 4th operand being a constant and expect no size for shuf* etc. } + { further, allow AAD and AAM with imm. operand } + if (opsize=S_NO) and not((i in [1,2,3]) or ((i=0) and (opcode in [A_AAD,A_AAM]))) then + message(asmr_e_invalid_opcode_and_operand); + if (opsize<>S_W) and (aint(val)>=-128) and (val<=127) then + ot:=OT_IMM8 or OT_SIGNED + else + ot:=OT_IMMEDIATE or opsize_2_type[i,opsize]; + if (val=1) and (i=1) then + ot := ot or OT_ONENESS; + end; + top_none : + begin + { generated when there was an error in the + assembler reader. It never happends when generating + assembler } + end; + else + internalerror(200402261); + end; + end; + end; + + + function taicpu.InsEnd:longint; + begin + InsEnd:=InsOffset+InsSize; + end; + + + function taicpu.Matches(p:PInsEntry):boolean; + { * 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 + insot, + currot, + i,j,asize,oprs : longint; + insflags:cardinal; + siz : array[0..max_operands-1] of longint; + begin + result:=false; + + { Check the opcode and operands } + if (p^.opcode<>opcode) or (p^.ops<>ops) then + exit; + + for i:=0 to p^.ops-1 do + begin + insot:=p^.optypes[i]; + currot:=oper[i]^.ot; + { Check the operand flags } + if (insot and (not currot) and OT_NON_SIZE)<>0 then + exit; + { Check if the passed operand size matches with one of + the supported operand sizes } + if ((insot and OT_SIZE_MASK)<>0) and + ((insot and currot and OT_SIZE_MASK)<>(currot and OT_SIZE_MASK)) then + exit; + end; + + { Check operand sizes } + insflags:=p^.flags; + if insflags and IF_SMASK<>0 then + begin + { 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:=-1; + if (insflags and IF_SB)<>0 then + asize:=OT_BITS8 + else if (insflags and IF_SW)<>0 then + asize:=OT_BITS16 + else if (insflags and IF_SD)<>0 then + asize:=OT_BITS32; + if (insflags and IF_ARMASK)<>0 then + begin + siz[0]:=-1; + siz[1]:=-1; + siz[2]:=-1; + siz[((insflags and IF_ARMASK) shr IF_ARSHIFT)-1]:=asize; + end + else + begin + siz[0]:=asize; + siz[1]:=asize; + siz[2]:=asize; + end; + + if (insflags and (IF_SM or IF_SM2))<>0 then + begin + if (insflags 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 + insot:=p^.optypes[i]; + currot:=oper[i]^.ot; + if ((insot and OT_SIZE_MASK)=0) and + ((currot and OT_SIZE_MASK and (not siz[i]))<>0) and + { Immediates can always include smaller size } + ((currot and OT_IMMEDIATE)=0) and + (((insot and OT_SIZE_MASK) or siz[i])<(currot and OT_SIZE_MASK)) then + exit; + end; + end; + + result:=true; + 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 + result:=FindInsEntry(nil); + end; + + + function taicpu.FindInsentry(objdata:TObjData):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 + current_filepos:=fileinfo; + { We need intel style operands } + SetOperandOrder(op_intel); + { create the .ot fields } + create_ot(objdata); + { set the file postion } + 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) then + begin + result:=true; + exit; + end; + inc(insentry); + 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; + + + function taicpu.Pass1(objdata:TObjData):longint; + begin + Pass1:=0; + { Save the old offset and set the new offset } + InsOffset:=ObjData.CurrObjSec.Size; + { Error? } + if (Insentry=nil) and (InsSize=-1) then + exit; + { set the file postion } + current_filepos:=fileinfo; + { Get InsEntry } + if FindInsEntry(ObjData) then + begin + { Calculate instruction size } + InsSize:=calcsize(insentry); + if segprefix<>NR_NO then + inc(InsSize); + { Fix opsize if size if forced } + if (insentry^.flags and (IF_SB or IF_SW or IF_SD))<>0 then + begin + if (insentry^.flags and IF_ARMASK)=0 then + begin + if (insentry^.flags and IF_SB)<>0 then + begin + if opsize=S_NO then + opsize:=S_B; + end + else if (insentry^.flags and IF_SW)<>0 then + begin + if opsize=S_NO then + opsize:=S_W; + end + else if (insentry^.flags and IF_SD)<>0 then + begin + if opsize=S_NO then + opsize:=S_L; + end; + end; + end; + LastInsOffset:=InsOffset; + Pass1:=InsSize; + exit; + end; + LastInsOffset:=-1; + end; + + const + segprefixes: array[NR_CS..NR_GS] of Byte=( + //cs ds es ss fs gs + $2E, $3E, $26, $36, $64, $65 + ); + + procedure taicpu.Pass2(objdata:TObjData); + begin + { error in pass1 ? } + if insentry=nil then + exit; + current_filepos:=fileinfo; + { Segment override } + if (segprefix>=NR_CS) and (segprefix<=NR_GS) then + begin + objdata.writebytes(segprefixes[segprefix],1); + { fix the offset for GenNode } + inc(InsOffset); + end + else if segprefix<>NR_NO then + InternalError(201001071); + { Generate the instruction } + GenCode(objdata); + end; + + + function taicpu.needaddrprefix(opidx:byte):boolean; + begin + result:=(oper[opidx]^.typ=top_ref) and + (oper[opidx]^.ref^.refaddr=addr_no) and + {$ifdef x86_64} + (oper[opidx]^.ref^.base<>NR_RIP) and + {$endif x86_64} + ( + ( + (oper[opidx]^.ref^.index<>NR_NO) and + (getsubreg(oper[opidx]^.ref^.index)<>R_SUBADDR) + ) or + ( + (oper[opidx]^.ref^.base<>NR_NO) and + (getsubreg(oper[opidx]^.ref^.base)<>R_SUBADDR) + ) + ); + end; + + + function regval(r:Tregister):byte; + const + {$ifdef x86_64} + opcode_table:array[tregisterindex] of tregisterindex = ( + {$i r8664op.inc} + ); + {$else x86_64} + opcode_table:array[tregisterindex] of tregisterindex = ( + {$i r386op.inc} + ); + {$endif x86_64} + var + regidx : tregisterindex; + begin + regidx:=findreg_by_number(r); + if regidx<>0 then + result:=opcode_table[regidx] + else + begin + Message1(asmw_e_invalid_register,generic_regname(r)); + result:=0; + end; + end; + + +{$ifdef x86_64} + function rexbits(r: tregister): byte; + begin + result:=0; + case getregtype(r) of + R_INTREGISTER: + if (getsupreg(r)>=RS_R8) then + { Either B,X or R bits can be set, depending on register role in instruction. + Set all three bits here, caller will discard unnecessary ones. } + result:=result or $47 + else if (getsubreg(r)=R_SUBL) and + (getsupreg(r) in [RS_RDI,RS_RSI,RS_RBP,RS_RSP]) then + result:=result or $40 + else if (getsubreg(r)=R_SUBH) then + { Not an actual REX bit, used to detect incompatible usage of + AH/BH/CH/DH } + result:=result or $80; + R_MMREGISTER: + if getsupreg(r)>=RS_XMM8 then + result:=result or $47; + end; + end; + + function process_ea(const input:toper;out output:ea;rfield:longint):boolean; + var + sym : tasmsymbol; + md,s,rv : byte; + base,index,scalefactor, + o : longint; + ir,br : Tregister; + isub,bsub : tsubregister; + begin + process_ea:=false; + fillchar(output,sizeof(output),0); + {Register ?} + if (input.typ=top_reg) then + begin + rv:=regval(input.reg); + output.modrm:=$c0 or (rfield shl 3) or rv; + output.size:=1; + output.rex:=output.rex or (rexbits(input.reg) and $F1); + process_ea:=true; + + exit; + end; + {No register, so memory reference.} + if input.typ<>top_ref then + internalerror(200409263); + ir:=input.ref^.index; + br:=input.ref^.base; + isub:=getsubreg(ir); + bsub:=getsubreg(br); + s:=input.ref^.scalefactor; + o:=input.ref^.offset; + sym:=input.ref^.symbol; + if ((ir<>NR_NO) and (getregtype(ir)<>R_INTREGISTER)) or + ((br<>NR_NO) and (br<>NR_RIP) and (getregtype(br)<>R_INTREGISTER)) then + internalerror(200301081); + { it's direct address } + if (br=NR_NO) and (ir=NR_NO) then + begin + output.sib_present:=true; + output.bytes:=4; + output.modrm:=4 or (rfield shl 3); + output.sib:=$25; + end + else if (br=NR_RIP) and (ir=NR_NO) then + begin + { rip based } + output.sib_present:=false; + output.bytes:=4; + output.modrm:=5 or (rfield shl 3); + end + else + { it's an indirection } + begin + { 16 bit or 32 bit address? } + if ((ir<>NR_NO) and (isub<>R_SUBADDR)) or + ((br<>NR_NO) and (bsub<>R_SUBADDR)) then + message(asmw_e_16bit_32bit_not_supported); + { wrong, for various reasons } + if (ir=NR_ESP) or ((s<>1) and (s<>2) and (s<>4) and (s<>8) and (ir<>NR_NO)) then + exit; + + output.rex:=output.rex or (rexbits(br) and $F1) or (rexbits(ir) and $F2); + process_ea:=true; + + + { base } + case br of + NR_R8, + NR_RAX : base:=0; + NR_R9, + NR_RCX : base:=1; + NR_R10, + NR_RDX : base:=2; + NR_R11, + NR_RBX : base:=3; + NR_R12, + NR_RSP : base:=4; + NR_R13, + NR_NO, + NR_RBP : base:=5; + NR_R14, + NR_RSI : base:=6; + NR_R15, + NR_RDI : base:=7; + else + exit; + end; + { index } + case ir of + NR_R8, + NR_RAX : index:=0; + NR_R9, + NR_RCX : index:=1; + NR_R10, + NR_RDX : index:=2; + NR_R11, + NR_RBX : index:=3; + NR_R12, + NR_NO : index:=4; + NR_R13, + NR_RBP : index:=5; + NR_R14, + NR_RSI : index:=6; + NR_R15, + NR_RDI : index:=7; + else + exit; + end; + case s of + 0, + 1 : scalefactor:=0; + 2 : scalefactor:=1; + 4 : scalefactor:=2; + 8 : scalefactor:=3; + else + exit; + end; + { If rbp or r13 is used we must always include an offset } + if (br=NR_NO) or + ((br<>NR_RBP) and (br<>NR_R13) and (o=0) and (sym=nil)) then + md:=0 + else + if ((o>=-128) and (o<=127) and (sym=nil)) then + md:=1 + else + md:=2; + if (br=NR_NO) or (md=2) then + output.bytes:=4 + else + output.bytes:=md; + { SIB needed ? } + if (ir=NR_NO) and (br<>NR_RSP) and (br<>NR_R12) then + begin + output.sib_present:=false; + output.modrm:=(md shl 6) or (rfield shl 3) or base; + end + else + begin + output.sib_present:=true; + output.modrm:=(md shl 6) or (rfield shl 3) or 4; + output.sib:=(scalefactor shl 6) or (index shl 3) or base; + end; + end; + output.size:=1+ord(output.sib_present)+output.bytes; + process_ea:=true; + end; + + +{$else x86_64} + + function process_ea(const input:toper;out output:ea;rfield:longint):boolean; + var + sym : tasmsymbol; + md,s,rv : byte; + base,index,scalefactor, + o : longint; + ir,br : Tregister; + isub,bsub : tsubregister; + begin + process_ea:=false; + fillchar(output,sizeof(output),0); + {Register ?} + if (input.typ=top_reg) then + begin + rv:=regval(input.reg); + output.modrm:=$c0 or (rfield shl 3) or rv; + output.size:=1; + process_ea:=true; + exit; + end; + {No register, so memory reference.} + if (input.typ<>top_ref) then + internalerror(200409262); + if ((input.ref^.index<>NR_NO) and (getregtype(input.ref^.index)<>R_INTREGISTER)) or + ((input.ref^.base<>NR_NO) and (getregtype(input.ref^.base)<>R_INTREGISTER)) then + internalerror(200301081); + ir:=input.ref^.index; + br:=input.ref^.base; + isub:=getsubreg(ir); + bsub:=getsubreg(br); + s:=input.ref^.scalefactor; + o:=input.ref^.offset; + sym:=input.ref^.symbol; + { it's direct address } + if (br=NR_NO) and (ir=NR_NO) then + begin + { it's a pure offset } + output.sib_present:=false; + output.bytes:=4; + output.modrm:=5 or (rfield shl 3); + end + else + { it's an indirection } + begin + { 16 bit address? } + if ((ir<>NR_NO) and (isub<>R_SUBADDR)) or + ((br<>NR_NO) and (bsub<>R_SUBADDR)) then + message(asmw_e_16bit_not_supported); +{$ifdef OPTEA} + { make single reg base } + if (br=NR_NO) and (s=1) then + begin + br:=ir; + ir:=NR_NO; + end; + { convert [3,5,9]*EAX to EAX+[2,4,8]*EAX } + if (br=NR_NO) and + (((s=2) and (ir<>NR_ESP)) or + (s=3) or (s=5) or (s=9)) then + begin + br:=ir; + dec(s); + end; + { swap ESP into base if scalefactor is 1 } + if (s=1) and (ir=NR_ESP) then + begin + ir:=br; + br:=NR_ESP; + end; +{$endif OPTEA} + { wrong, for various reasons } + if (ir=NR_ESP) or ((s<>1) and (s<>2) and (s<>4) and (s<>8) and (ir<>NR_NO)) then + exit; + { base } + case br of + NR_EAX : base:=0; + NR_ECX : base:=1; + NR_EDX : base:=2; + NR_EBX : base:=3; + NR_ESP : base:=4; + NR_NO, + NR_EBP : base:=5; + NR_ESI : base:=6; + NR_EDI : base:=7; + else + exit; + end; + { index } + case ir of + NR_EAX : index:=0; + NR_ECX : index:=1; + NR_EDX : index:=2; + NR_EBX : index:=3; + NR_NO : index:=4; + NR_EBP : index:=5; + NR_ESI : index:=6; + NR_EDI : index:=7; + else + exit; + end; + case s of + 0, + 1 : scalefactor:=0; + 2 : scalefactor:=1; + 4 : scalefactor:=2; + 8 : scalefactor:=3; + else + exit; + end; + if (br=NR_NO) or + ((br<>NR_EBP) and (o=0) and (sym=nil)) then + md:=0 + else + if ((o>=-128) and (o<=127) and (sym=nil)) then + md:=1 + else + md:=2; + if (br=NR_NO) or (md=2) then + output.bytes:=4 + else + output.bytes:=md; + { SIB needed ? } + if (ir=NR_NO) and (br<>NR_ESP) then + begin + output.sib_present:=false; + output.modrm:=(longint(md) shl 6) or (rfield shl 3) or base; + end + else + begin + output.sib_present:=true; + output.modrm:=(longint(md) shl 6) or (rfield shl 3) or 4; + output.sib:=(scalefactor shl 6) or (index shl 3) or base; + end; + end; + if output.sib_present then + output.size:=2+output.bytes + else + output.size:=1+output.bytes; + process_ea:=true; + end; +{$endif x86_64} + + function taicpu.calcsize(p:PInsEntry):shortint; + var + codes : pchar; + c : byte; + len : shortint; + ea_data : ea; +{$ifdef x86_64} + omit_rexw : boolean; +{$endif x86_64} + begin + len:=0; + codes:=@p^.code[0]; +{$ifdef x86_64} + rex:=0; + omit_rexw:=false; +{$endif x86_64} + repeat + c:=ord(codes^); + inc(codes); + case c of + 0 : + break; + 1,2,3 : + begin + inc(codes,c); + inc(len,c); + end; + 8,9,10 : + begin +{$ifdef x86_64} + rex:=rex or (rexbits(oper[c-8]^.reg) and $F1); +{$endif x86_64} + inc(codes); + inc(len); + end; + 11 : + begin + inc(codes); + inc(len); + end; + 4,5,6,7 : + begin + if opsize=S_W then + inc(len,2) + else + inc(len); + end; + 12,13,14, + 16,17,18, + 20,21,22,23, + 40,41,42 : + inc(len); + 24,25,26, + 31, + 48,49,50 : + inc(len,2); + 28,29,30: + begin + if opsize=S_Q then + inc(len,8) + else + inc(len,4); + end; + 36,37,38: + inc(len,sizeof(pint)); + 44,45,46: + inc(len,8); + 32,33,34, + 52,53,54, + 56,57,58, + 172,173,174 : + inc(len,4); + 208,209,210 : + begin + case (oper[c-208]^.ot and OT_SIZE_MASK) of + OT_BITS16: + inc(len); +{$ifdef x86_64} + OT_BITS64: + begin + rex:=rex or $48; + end; +{$endif x86_64} + end; + end; + 200 : +{$ifndef x86_64} + inc(len); +{$else x86_64} + { every insentry with code 0310 must be marked with NOX86_64 } + InternalError(2011051301); +{$endif x86_64} + 201 : +{$ifdef x86_64} + inc(len) +{$endif x86_64} + ; + 212 : + inc(len); + 214 : + begin +{$ifdef x86_64} + rex:=rex or $48; +{$endif x86_64} + end; + 202, + 211, + 213, + 215, + 217,218: ; + 219,220,241 : + inc(len); + 221: +{$ifdef x86_64} + omit_rexw:=true +{$endif x86_64} + ; + 64..151 : + begin +{$ifdef x86_64} + if (c<127) then + begin + if (oper[c and 7]^.typ=top_reg) then + begin + rex:=rex or (rexbits(oper[c and 7]^.reg) and $F4); + end; + end; + +{$endif x86_64} + if not process_ea(oper[(c shr 3) and 7]^, ea_data, 0) then + Message(asmw_e_invalid_effective_address) + else + inc(len,ea_data.size); +{$ifdef x86_64} + rex:=rex or ea_data.rex; +{$endif x86_64} + + end; + else + InternalError(200603141); + end; + until false; +{$ifdef x86_64} + if ((rex and $80)<>0) and ((rex and $4F)<>0) then + Message(asmw_e_bad_reg_with_rex); + rex:=rex and $4F; { reset extra bits in upper nibble } + if omit_rexw then + begin + if rex=$48 then { remove rex entirely? } + rex:=0 + else + rex:=rex and $F7; + end; + if rex<>0 then + Inc(len); +{$endif} + calcsize:=len; + end; + + + procedure taicpu.GenCode(objdata:TObjData); + { + * the actual codes (C syntax, i.e. octal): + * \0 - terminates the code. (Unless it's a literal of course.) + * \1, \2, \3 - that many literal bytes follow in the code stream + * \4, \6 - the POP/PUSH (respectively) codes for CS, DS, ES, SS + * (POP is never used for CS) depending on operand 0 + * \5, \7 - the second byte of POP/PUSH codes for FS, GS, depending + * on operand 0 + * \10, \11, \12 - a literal byte follows in the code stream, to be added + * to the register value of operand 0, 1 or 2 + * \13 - a literal byte follows in the code stream, to be added + * to the condition code value of the instruction. + * \14, \15, \16 - a signed byte immediate operand, from operand 0, 1 or 2 + * \20, \21, \22 - a byte immediate operand, from operand 0, 1 or 2 + * \24, \25, \26, \27 - an unsigned byte immediate operand, from operand 0, 1, 2 or 3 + * \30, \31, \32 - a word immediate operand, from operand 0, 1 or 2 + * \34, \35, \36 - select between \3[012] and \4[012] depending on 16/32 bit + * assembly mode or the address-size override on the operand + * \37 - a word constant, from the _segment_ part of operand 0 + * \40, \41, \42 - a long immediate operand, from operand 0, 1 or 2 + * \44, \45, \46 - select between \3[012], \4[012] or \5[456] depending + on the address size of instruction + * \50, \51, \52 - a byte relative operand, from operand 0, 1 or 2 + * \54, \55, \56 - a qword immediate, from operand 0, 1 or 2 + * \60, \61, \62 - a word relative operand, from operand 0, 1 or 2 + * \64, \65, \66 - select between \6[012] and \7[012] depending on 16/32 bit + * assembly mode or the address-size override on the operand + * \70, \71, \72 - a long relative operand, from operand 0, 1 or 2 + * \1ab - a ModRM, calculated on EA in operand a, with the spare + * field the register value of operand b. + * \2ab - a ModRM, calculated on EA in operand a, with the spare + * field equal to digit b. + * \254,\255,\256 - a signed 32-bit immediate to be extended to 64 bits + * \300,\301,\302 - might be an 0x67, depending on the address size of + * the memory reference in operand x. + * \310 - indicates fixed 16-bit address size, i.e. optional 0x67. + * \311 - indicates fixed 32-bit address size, i.e. optional 0x67. + * \312 - (disassembler only) invalid with non-default address size. + * \320,\321,\322 - might be an 0x66 or 0x48 byte, depending on the operand + * size of operand x. + * \324 - indicates fixed 16-bit operand size, i.e. optional 0x66. + * \325 - indicates fixed 32-bit operand size, i.e. optional 0x66. + * \326 - indicates fixed 64-bit operand size, i.e. optional 0x48. + * \327 - indicates that this instruction is only valid when the + * operand size is the default (instruction to disassembler, + * generates no code in the assembler) + * \331 - instruction not valid with REP prefix. Hint for + * disassembler only; for SSE instructions. + * \332 - disassemble a rep (0xF3 byte) prefix as repe not rep. + * \333 - 0xF3 prefix for SSE instructions + * \334 - 0xF2 prefix for SSE instructions + * \335 - Indicates 64-bit operand size with REX.W not necessary + * \361 - 0x66 prefix for SSE instructions + } + + var + currval : aint; + currsym : tobjsymbol; + currrelreloc, + currabsreloc, + currabsreloc32 : TObjRelocationType; +{$ifdef x86_64} + rexwritten : boolean; +{$endif x86_64} + + procedure getvalsym(opidx:longint); + begin + case oper[opidx]^.typ of + top_ref : + begin + currval:=oper[opidx]^.ref^.offset; + currsym:=ObjData.symbolref(oper[opidx]^.ref^.symbol); +{$ifdef i386} + if (oper[opidx]^.ref^.refaddr=addr_pic) and + (tf_pic_uses_got in target_info.flags) then + begin + currrelreloc:=RELOC_PLT32; + currabsreloc:=RELOC_GOT32; + currabsreloc32:=RELOC_GOT32; + end + else +{$endif i386} +{$ifdef x86_64} + if oper[opidx]^.ref^.refaddr=addr_pic then + begin + currrelreloc:=RELOC_PLT32; + currabsreloc:=RELOC_GOTPCREL; + currabsreloc32:=RELOC_GOTPCREL; + end + else if oper[opidx]^.ref^.refaddr=addr_pic_no_got then + begin + currrelreloc:=RELOC_RELATIVE; + currabsreloc:=RELOC_RELATIVE; + currabsreloc32:=RELOC_RELATIVE; + end + else +{$endif x86_64} + begin + currrelreloc:=RELOC_RELATIVE; + currabsreloc:=RELOC_ABSOLUTE; + currabsreloc32:=RELOC_ABSOLUTE32; + end; + end; + top_const : + begin + currval:=aint(oper[opidx]^.val); + currsym:=nil; + currabsreloc:=RELOC_ABSOLUTE; + currabsreloc32:=RELOC_ABSOLUTE32; + end; + else + Message(asmw_e_immediate_or_reference_expected); + end; + end; + +{$ifdef x86_64} + procedure maybewriterex; + begin + if (rex<>0) and not(rexwritten) then + begin + rexwritten:=true; + objdata.writebytes(rex,1); + end; + end; +{$endif x86_64} + procedure objdata_writereloc(Data:aint;len:aword;p:TObjSymbol;Reloctype:TObjRelocationType); + begin +{$ifdef i386} + { Special case of '_GLOBAL_OFFSET_TABLE_' + which needs a special relocation type R_386_GOTPC } + if assigned (p) and + (p.name='_GLOBAL_OFFSET_TABLE_') and + (tf_pic_uses_got in target_info.flags) then + begin + { nothing else than a 4 byte relocation should occur + for GOT } + if len<>4 then + Message1(asmw_e_invalid_opcode_and_operands,GetString); + Reloctype:=RELOC_GOTPC; + { We need to add the offset of the relocation + of _GLOBAL_OFFSET_TABLE symbol within + the current instruction } + inc(data,objdata.currobjsec.size-insoffset); + end; +{$endif i386} + objdata.writereloc(data,len,p,Reloctype); + end; + + + const + CondVal:array[TAsmCond] of byte=($0, + $7, $3, $2, $6, $2, $4, $F, $D, $C, $E, $6, $2, + $3, $7, $3, $5, $E, $C, $D, $F, $1, $B, $9, $5, + $0, $A, $A, $B, $8, $4); + var + c : byte; + pb : pbyte; + codes : pchar; + bytes : array[0..3] of byte; + rfield, + data,s,opidx : longint; + ea_data : ea; + relsym : TObjSymbol; + begin + { safety check } + if objdata.currobjsec.size<>longword(insoffset) then + internalerror(200130121); + { load data to write } + codes:=insentry^.code; +{$ifdef x86_64} + rexwritten:=false; +{$endif x86_64} + { Force word push/pop for registers } + if (opsize=S_W) and ((codes[0]=#4) or (codes[0]=#6) or + ((codes[0]=#1) and ((codes[2]=#5) or (codes[2]=#7)))) then + begin + bytes[0]:=$66; + objdata.writebytes(bytes,1); + end; + repeat + c:=ord(codes^); + inc(codes); + case c of + 0 : + break; + 1,2,3 : + begin +{$ifdef x86_64} + maybewriterex; +{$endif x86_64} + objdata.writebytes(codes^,c); + inc(codes,c); + end; + 4,6 : + begin + case oper[0]^.reg of + NR_CS: + bytes[0]:=$e; + NR_NO, + NR_DS: + bytes[0]:=$1e; + NR_ES: + bytes[0]:=$6; + NR_SS: + bytes[0]:=$16; + else + internalerror(777004); + end; + if c=4 then + inc(bytes[0]); + objdata.writebytes(bytes,1); + end; + 5,7 : + begin + case oper[0]^.reg of + NR_FS: + bytes[0]:=$a0; + NR_GS: + bytes[0]:=$a8; + else + internalerror(777005); + end; + if c=5 then + inc(bytes[0]); + objdata.writebytes(bytes,1); + end; + 8,9,10 : + begin +{$ifdef x86_64} + maybewriterex; +{$endif x86_64} + bytes[0]:=ord(codes^)+regval(oper[c-8]^.reg); + inc(codes); + objdata.writebytes(bytes,1); + end; + 11 : + begin + bytes[0]:=ord(codes^)+condval[condition]; + inc(codes); + objdata.writebytes(bytes,1); + end; + 12,13,14 : + begin + getvalsym(c-12); + if (currval<-128) or (currval>127) then + Message2(asmw_e_value_exceeds_bounds,'signed byte',tostr(currval)); + if assigned(currsym) then + objdata_writereloc(currval,1,currsym,currabsreloc) + else + objdata.writebytes(currval,1); + end; + 16,17,18 : + begin + getvalsym(c-16); + if (currval<-256) or (currval>255) then + Message2(asmw_e_value_exceeds_bounds,'byte',tostr(currval)); + if assigned(currsym) then + objdata_writereloc(currval,1,currsym,currabsreloc) + else + objdata.writebytes(currval,1); + end; + 20,21,22,23 : + begin + getvalsym(c-20); + if (currval<0) or (currval>255) then + Message2(asmw_e_value_exceeds_bounds,'unsigned byte',tostr(currval)); + if assigned(currsym) then + objdata_writereloc(currval,1,currsym,currabsreloc) + else + objdata.writebytes(currval,1); + end; + 24,25,26 : // 030..032 + begin + getvalsym(c-24); + if (currval<-65536) or (currval>65535) then + Message2(asmw_e_value_exceeds_bounds,'word',tostr(currval)); + if assigned(currsym) then + objdata_writereloc(currval,2,currsym,currabsreloc) + else + objdata.writebytes(currval,2); + end; + 28,29,30 : // 034..036 + { !!! These are intended (and used in opcode table) to select depending + on address size, *not* operand size. Works by coincidence only. } + begin + getvalsym(c-28); + if opsize=S_Q then + begin + if assigned(currsym) then + objdata_writereloc(currval,8,currsym,currabsreloc) + else + objdata.writebytes(currval,8); + end + else + begin + if assigned(currsym) then + objdata_writereloc(currval,4,currsym,currabsreloc32) + else + objdata.writebytes(currval,4); + end + end; + 32,33,34 : // 040..042 + begin + getvalsym(c-32); + if assigned(currsym) then + objdata_writereloc(currval,4,currsym,currabsreloc32) + else + objdata.writebytes(currval,4); + end; + 36,37,38 : // 044..046 - select between word/dword/qword depending on + begin // address size (we support only default address sizes). + getvalsym(c-36); +{$ifdef x86_64} + if assigned(currsym) then + objdata_writereloc(currval,8,currsym,currabsreloc) + else + objdata.writebytes(currval,8); +{$else x86_64} + if assigned(currsym) then + objdata_writereloc(currval,4,currsym,currabsreloc32) + else + objdata.writebytes(currval,4); +{$endif x86_64} + end; + 40,41,42 : // 050..052 - byte relative operand + begin + getvalsym(c-40); + data:=currval-insend; + if assigned(currsym) then + inc(data,currsym.address); + if (data>127) or (data<-128) then + Message1(asmw_e_short_jmp_out_of_range,tostr(data)); + objdata.writebytes(data,1); + end; + 44,45,46: // 054..056 - qword immediate operand + begin + getvalsym(c-44); + if assigned(currsym) then + objdata_writereloc(currval,8,currsym,currabsreloc) + else + objdata.writebytes(currval,8); + end; + 52,53,54 : // 064..066 - select between 16/32 address mode, but we support only 32 + begin + getvalsym(c-52); + if assigned(currsym) then + objdata_writereloc(currval,4,currsym,currrelreloc) + else + objdata_writereloc(currval-insend,4,nil,currabsreloc32) + end; + 56,57,58 : // 070..072 - long relative operand + begin + getvalsym(c-56); + if assigned(currsym) then + objdata_writereloc(currval,4,currsym,currrelreloc) + else + objdata_writereloc(currval-insend,4,nil,currabsreloc32) + end; + 172,173,174 : // 0254..0256 - dword implicitly sign-extended to 64-bit (x86_64 only) + begin + getvalsym(c-172); +{$ifdef x86_64} + { for i386 as aint type is longint the + following test is useless } + if (currval<low(longint)) or (currval>high(longint)) then + Message2(asmw_e_value_exceeds_bounds,'signed dword',tostr(currval)); +{$endif x86_64} + + if assigned(currsym) then + objdata_writereloc(currval,4,currsym,currabsreloc32) + else + objdata.writebytes(currval,4); + end; + 200 : { fixed 16-bit addr } +{$ifndef x86_64} + begin + bytes[0]:=$67; + objdata.writebytes(bytes,1); + end; +{$else x86_64} + { every insentry having code 0310 must be marked with NOX86_64 } + InternalError(2011051302); +{$endif} + 201 : { fixed 32-bit addr } +{$ifdef x86_64} + begin + bytes[0]:=$67; + objdata.writebytes(bytes,1); + end +{$endif x86_64} + ; + 208,209,210 : + begin + case oper[c-208]^.ot and OT_SIZE_MASK of + OT_BITS16 : + begin + bytes[0]:=$66; + objdata.writebytes(bytes,1); + end; +{$ifndef x86_64} + OT_BITS64 : + Message(asmw_e_64bit_not_supported); +{$endif x86_64} + end; + end; + 211, + 213 : {no action needed}; + + 212, 241 : + begin + bytes[0]:=$66; + objdata.writebytes(bytes,1); + end; + 214 : + begin +{$ifndef x86_64} + Message(asmw_e_64bit_not_supported); +{$endif x86_64} + end; + 219 : + begin + bytes[0]:=$f3; + objdata.writebytes(bytes,1); + end; + 220 : + begin + bytes[0]:=$f2; + objdata.writebytes(bytes,1); + end; + 221: + ; + 202, + 215, + 217,218 : + begin + { these are dissambler hints or 32 bit prefixes which + are not needed } + end; + 31, + 48,49,50 : + begin + InternalError(777006); + end + else + begin + { rex should be written at this point } +{$ifdef x86_64} + if (rex<>0) and not(rexwritten) then + internalerror(200603191); +{$endif x86_64} + if (c>=64) and (c<=151) then // 0100..0227 + begin + if (c<127) then // 0177 + begin + if (oper[c and 7]^.typ=top_reg) then + rfield:=regval(oper[c and 7]^.reg) + else + rfield:=regval(oper[c and 7]^.ref^.base); + end + else + rfield:=c and 7; + opidx:=(c shr 3) and 7; + if not process_ea(oper[opidx]^,ea_data,rfield) then + Message(asmw_e_invalid_effective_address); + + pb:=@bytes[0]; + pb^:=ea_data.modrm; + inc(pb); + if ea_data.sib_present then + begin + pb^:=ea_data.sib; + inc(pb); + end; + + s:=pb-@bytes[0]; + objdata.writebytes(bytes,s); + + case ea_data.bytes of + 0 : ; + 1 : + begin + if (oper[opidx]^.ot and OT_MEMORY)=OT_MEMORY then + begin + currsym:=objdata.symbolref(oper[opidx]^.ref^.symbol); +{$ifdef i386} + if (oper[opidx]^.ref^.refaddr=addr_pic) and + (tf_pic_uses_got in target_info.flags) then + currabsreloc:=RELOC_GOT32 + else +{$endif i386} +{$ifdef x86_64} + if oper[opidx]^.ref^.refaddr=addr_pic then + currabsreloc:=RELOC_GOTPCREL + else +{$endif x86_64} + currabsreloc:=RELOC_ABSOLUTE; + objdata_writereloc(oper[opidx]^.ref^.offset,1,currsym,currabsreloc); + end + else + begin + bytes[0]:=oper[opidx]^.ref^.offset; + objdata.writebytes(bytes,1); + end; + inc(s); + end; + 2,4 : + begin + currsym:=objdata.symbolref(oper[opidx]^.ref^.symbol); + currval:=oper[opidx]^.ref^.offset; +{$ifdef x86_64} + if oper[opidx]^.ref^.refaddr=addr_pic then + currabsreloc:=RELOC_GOTPCREL + else + if oper[opidx]^.ref^.base=NR_RIP then + begin + currabsreloc:=RELOC_RELATIVE; + { Adjust reloc value by number of bytes following the displacement, + but not if displacement is specified by literal constant } + if Assigned(currsym) then + Dec(currval,InsEnd-objdata.CurrObjSec.Size-ea_data.bytes); + end + else +{$endif x86_64} +{$ifdef i386} + if (oper[opidx]^.ref^.refaddr=addr_pic) and + (tf_pic_uses_got in target_info.flags) then + currabsreloc:=RELOC_GOT32 + else +{$endif i386} + currabsreloc:=RELOC_ABSOLUTE32; + + if (currabsreloc=RELOC_ABSOLUTE32) and + (Assigned(oper[opidx]^.ref^.relsymbol)) then + begin + relsym:=objdata.symbolref(oper[opidx]^.ref^.relsymbol); + currabsreloc:=RELOC_PIC_PAIR; + currval:=relsym.offset; + end; + objdata_writereloc(currval,ea_data.bytes,currsym,currabsreloc); + inc(s,ea_data.bytes); + end; + end; + end + else + InternalError(777007); + end; + end; + until false; + end; + + + function taicpu.is_same_reg_move(regtype: Tregistertype):boolean; + begin + result:=(((opcode=A_MOV) or (opcode=A_XCHG)) and + (regtype = R_INTREGISTER) and + (ops=2) and + (oper[0]^.typ=top_reg) and + (oper[1]^.typ=top_reg) and + (oper[0]^.reg=oper[1]^.reg) + ) or + (((opcode=A_MOVSS) or (opcode=A_MOVSD) or (opcode=A_MOVQ) or + (opcode=A_MOVAPS) or (OPCODE=A_MOVAPD)) and + (regtype = R_MMREGISTER) and + (ops=2) and + (oper[0]^.typ=top_reg) and + (oper[1]^.typ=top_reg) and + (oper[0]^.reg=oper[1]^.reg) + ); + end; + + + procedure build_spilling_operation_type_table; + var + opcode : tasmop; + i : integer; + begin + new(operation_type_table); + fillchar(operation_type_table^,sizeof(toperation_type_table),byte(operand_read)); + for opcode:=low(tasmop) to high(tasmop) do + begin + for i:=1 to MaxInsChanges do + begin + case InsProp[opcode].Ch[i] of + Ch_Rop1 : + operation_type_table^[opcode,0]:=operand_read; + Ch_Wop1 : + operation_type_table^[opcode,0]:=operand_write; + Ch_RWop1, + Ch_Mop1 : + operation_type_table^[opcode,0]:=operand_readwrite; + Ch_Rop2 : + operation_type_table^[opcode,1]:=operand_read; + Ch_Wop2 : + operation_type_table^[opcode,1]:=operand_write; + Ch_RWop2, + Ch_Mop2 : + operation_type_table^[opcode,1]:=operand_readwrite; + Ch_Rop3 : + operation_type_table^[opcode,2]:=operand_read; + Ch_Wop3 : + operation_type_table^[opcode,2]:=operand_write; + Ch_RWop3, + Ch_Mop3 : + operation_type_table^[opcode,2]:=operand_readwrite; + end; + end; + end; + { Special cases that can't be decoded from the InsChanges flags } + operation_type_table^[A_IMUL,1]:=operand_readwrite; + end; + + + function taicpu.spilling_get_operation_type(opnr: longint): topertype; + begin + { the information in the instruction table is made for the string copy + operation MOVSD so hack here (FK) + } + if (opcode=A_MOVSD) and (ops=2) then + begin + case opnr of + 0: + result:=operand_read; + 1: + result:=operand_write; + else + internalerror(200506055); + end + end + else + result:=operation_type_table^[opcode,opnr]; + end; + + + function spilling_create_load(const ref:treference;r:tregister):Taicpu; + begin + case getregtype(r) of + R_INTREGISTER : + { we don't need special code here for 32 bit loads on x86_64, since + those will automatically zero-extend the upper 32 bits. } + result:=taicpu.op_ref_reg(A_MOV,reg2opsize(r),ref,r); + R_MMREGISTER : + case getsubreg(r) of + R_SUBMMD: + result:=taicpu.op_ref_reg(A_MOVSD,reg2opsize(r),ref,r); + R_SUBMMS: + result:=taicpu.op_ref_reg(A_MOVSS,reg2opsize(r),ref,r); + R_SUBMMWHOLE: + result:=taicpu.op_ref_reg(A_MOVQ,S_NO,ref,r); + else + internalerror(200506043); + end; + else + internalerror(200401041); + end; + end; + + + function spilling_create_store(r:tregister; const ref:treference):Taicpu; + var + size: topsize; + begin + case getregtype(r) of + R_INTREGISTER : + begin + size:=reg2opsize(r); +{$ifdef x86_64} + { even if it's a 32 bit reg, we still have to spill 64 bits + because we often perform 64 bit operations on them } + if (size=S_L) then + begin + size:=S_Q; + r:=newreg(getregtype(r),getsupreg(r),R_SUBWHOLE); + end; +{$endif x86_64} + result:=taicpu.op_reg_ref(A_MOV,size,r,ref); + end; + R_MMREGISTER : + case getsubreg(r) of + R_SUBMMD: + result:=taicpu.op_reg_ref(A_MOVSD,reg2opsize(r),r,ref); + R_SUBMMS: + result:=taicpu.op_reg_ref(A_MOVSS,reg2opsize(r),r,ref); + R_SUBMMWHOLE: + result:=taicpu.op_reg_ref(A_MOVQ,S_NO,r,ref); + else + internalerror(200506042); + end; + else + internalerror(200401041); + end; + end; + + +{***************************************************************************** + Instruction table +*****************************************************************************} + + 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 + build_spilling_operation_type_table; + if not assigned(instabcache) then + BuildInsTabCache; + end; + + + procedure DoneAsm; + begin + if assigned(operation_type_table) then + begin + dispose(operation_type_table); + operation_type_table:=nil; + end; + if assigned(instabcache) then + begin + dispose(instabcache); + instabcache:=nil; + end; + end; + + +begin + cai_align:=tai_align; + cai_cpu:=taicpu; +end. diff --git a/closures/compiler/x86/agx86att.pas b/closures/compiler/x86/agx86att.pas new file mode 100644 index 0000000000..0599eaee8a --- /dev/null +++ b/closures/compiler/x86/agx86att.pas @@ -0,0 +1,437 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements an asmoutput class for i386 AT&T syntax + + 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 asmoutput class for i386 AT&T syntax +} +unit agx86att; + +{$i fpcdefs.inc} + +interface + + uses + cclasses,cpubase, + globals,cgutils, + aasmbase,aasmtai,aasmdata,assemble,aggas; + + type + Tx86ATTAssembler=class(TGNUassembler) + constructor create(smart: boolean); override; + end; + + Tx86AppleGNUAssembler=class(TAppleGNUassembler) + constructor create(smart: boolean); override; + end; + + Tx86AoutGNUAssembler=class(TAoutGNUassembler) + constructor create(smart: boolean); override; + end; + + + Tx86InstrWriter=class(TCPUInstrWriter) + private + procedure WriteReference(var ref : treference); + procedure WriteOper(const o:toper); + procedure WriteOper_jmp(const o:toper); + public + procedure WriteInstruction(hp: tai);override; + end; + + + + implementation + + uses + globtype, + cutils,systems, + verbose, + itcpugas, + cgbase, + aasmcpu; + + +{**************************************************************************** + Tx86ATTAssembler + ****************************************************************************} + + constructor Tx86ATTAssembler.create(smart: boolean); + begin + inherited create(smart); + InstrWriter := Tx86InstrWriter.create(self); + end; + +{**************************************************************************** + Tx86AppleGNUAssembler + ****************************************************************************} + + constructor Tx86AppleGNUAssembler.create(smart: boolean); + begin + inherited create(smart); + InstrWriter := Tx86InstrWriter.create(self); + end; + +{**************************************************************************** + Tx86AoutGNUAssembler + ****************************************************************************} + + constructor Tx86AoutGNUAssembler.create(smart: boolean); + begin + inherited create(smart); + InstrWriter := Tx86InstrWriter.create(self); + end; + +{**************************************************************************** + Tx86InstrWriter + ****************************************************************************} + + procedure Tx86InstrWriter.WriteReference(var ref : treference); + begin + with ref do + begin + { do we have a segment prefix ? } + { These are probably not correctly handled under GAS } + { should be replaced by coding the segment override } + { directly! - DJGPP FAQ } + if segment<>NR_NO then + owner.AsmWrite(gas_regname(segment)+':'); + if assigned(symbol) then + owner.AsmWrite(symbol.name); + if assigned(relsymbol) then + owner.AsmWrite('-'+relsymbol.name); + if ref.refaddr=addr_pic then +{$ifdef x86_64} + begin + { local symbols don't have to (and in case of Mac OS X: cannot) + be accessed via the GOT + } + if not assigned(ref.symbol) or + (ref.symbol.bind<>AB_LOCAL) then + owner.AsmWrite('@GOTPCREL'); + end; +{$else x86_64} + owner.AsmWrite('@GOT'); +{$endif x86_64} + if offset<0 then + owner.AsmWrite(tostr(offset)) + else + if (offset>0) then + begin + if assigned(symbol) then + owner.AsmWrite('+'+tostr(offset)) + else + owner.AsmWrite(tostr(offset)); + end + else if (index=NR_NO) and (base=NR_NO) and (not assigned(symbol)) then + owner.AsmWrite('0'); + if (index<>NR_NO) and (base=NR_NO) then + begin + owner.AsmWrite('(,'+gas_regname(index)); + if scalefactor<>0 then + owner.AsmWrite(','+tostr(scalefactor)+')') + else + owner.AsmWrite(')'); + end + else + if (index=NR_NO) and (base<>NR_NO) then + owner.AsmWrite('('+gas_regname(base)+')') + else + if (index<>NR_NO) and (base<>NR_NO) then + begin + owner.AsmWrite('('+gas_regname(base)+','+gas_regname(index)); + if scalefactor<>0 then + owner.AsmWrite(','+tostr(scalefactor)); + owner.AsmWrite(')'); + end; + end; + end; + + + procedure Tx86InstrWriter.WriteOper(const o:toper); + begin + case o.typ of + top_reg : + owner.AsmWrite(gas_regname(o.reg)); + top_ref : + if o.ref^.refaddr in [addr_no,addr_pic,addr_pic_no_got] then + WriteReference(o.ref^) + else + begin + owner.AsmWrite('$'); + if assigned(o.ref^.symbol) then + owner.AsmWrite(o.ref^.symbol.name); + if o.ref^.offset>0 then + owner.AsmWrite('+'+tostr(o.ref^.offset)) + else + if o.ref^.offset<0 then + owner.AsmWrite(tostr(o.ref^.offset)) + else + if not(assigned(o.ref^.symbol)) then + owner.AsmWrite('0'); + end; + top_const : + owner.AsmWrite('$'+tostr(o.val)); + else + internalerror(10001); + end; + end; + + + procedure Tx86InstrWriter.WriteOper_jmp(const o:toper); + begin + case o.typ of + top_reg : + owner.AsmWrite('*'+gas_regname(o.reg)); + top_ref : + begin + if o.ref^.refaddr in [addr_no,addr_pic_no_got] then + begin + owner.AsmWrite('*'); + WriteReference(o.ref^); + end + else + begin + owner.AsmWrite(o.ref^.symbol.name); + if o.ref^.refaddr=addr_pic then + owner.AsmWrite('@PLT'); + if o.ref^.offset>0 then + owner.AsmWrite('+'+tostr(o.ref^.offset)) + else + if o.ref^.offset<0 then + owner.AsmWrite(tostr(o.ref^.offset)); + end; + end; + top_const : + owner.AsmWrite(tostr(o.val)); + else + internalerror(10001); + end; + end; + + + procedure Tx86InstrWriter.WriteInstruction(hp: tai); + var + op : tasmop; +{$ifdef x86_64} + val : aint; +{$endif} + calljmp : boolean; + need_second_mov : boolean; + i : integer; + begin + if hp.typ <> ait_instruction then + exit; + taicpu(hp).SetOperandOrder(op_att); + op:=taicpu(hp).opcode; + calljmp:=is_calljmp(op); + { constant values in the 32 bit range are sign-extended to + 64 bits, but this is not what we want. PM 2010-09-02 + the fix consists of simply setting only the 4-byte register + as the upper 4-bytes will be zeroed at the same time. } + need_second_mov:=false; +{$ifdef x86_64} + if (op=A_MOV) and (taicpu(hp).opsize=S_Q) and + (taicpu(hp).oper[0]^.typ = top_const) then + begin + val := taicpu(hp).oper[0]^.val; + if (val > int64($7fffffff)) and (val < int64($100000000)) then + begin + owner.AsmWrite(target_asm.comment); + owner.AsmWritePChar('Fix for Win64-GAS bug'); + owner.AsmLn; + taicpu(hp).opsize:=S_L; + if taicpu(hp).oper[1]^.typ = top_reg then + setsubreg(taicpu(hp).oper[1]^.reg,R_SUBD) + else if taicpu(hp).oper[1]^.typ = top_ref then + need_second_mov:=true + else + internalerror(20100902); + end; + end; +{$endif x86_64} + owner.AsmWrite(#9); + { movsd should not be translated to movsl when there + are (xmm) arguments } + if (op=A_MOVSD) and (taicpu(hp).ops>0) then + owner.AsmWrite('movsd') + else + owner.AsmWrite(gas_op2str[op]); + owner.AsmWrite(cond2str[taicpu(hp).condition]); + { suffix needed ? fnstsw,fldcw don't support suffixes + with binutils 2.9.5 under linux } +{ if (Taicpu(hp).oper[0]^.typ=top_reg) and + (Taicpu(hp).oper[0]^.reg.enum>lastreg) then + internalerror(200301081);} + + if (not calljmp) and + (gas_needsuffix[op]<>AttSufNONE) and + (op<>A_FNSTSW) and + (op<>A_FSTSW) and + (op<>A_FNSTCW) and + (op<>A_FSTCW) and + (op<>A_FLDCW) and + not( + (taicpu(hp).ops<>0) and + (taicpu(hp).oper[0]^.typ=top_reg) and + (getregtype(taicpu(hp).oper[0]^.reg)=R_FPUREGISTER) + ) then + owner.AsmWrite(gas_opsize2str[taicpu(hp).opsize]); + { process operands } + if taicpu(hp).ops<>0 then + begin + if calljmp then + begin + owner.AsmWrite(#9); + WriteOper_jmp(taicpu(hp).oper[0]^); + end + else + begin + for i:=0 to taicpu(hp).ops-1 do + begin + if i=0 then + owner.AsmWrite(#9) + else + owner.AsmWrite(','); + WriteOper(taicpu(hp).oper[i]^); + end; + end; + end; + owner.AsmLn; + if need_second_mov then + begin + taicpu(hp).oper[0]^.val:=0; + inc(taicpu(hp).oper[1]^.ref^.offset,4); + WriteInstruction(hp); + end; + end; + +{***************************************************************************** + Initialize +*****************************************************************************} + + const +{$ifdef x86_64} + as_x86_64_as_info : tasminfo = + ( + id : as_gas; + idtxt : 'AS'; + asmbin : 'as'; + asmcmd : '--64 -o $OBJ $ASM'; + supported_targets : [system_x86_64_linux,system_x86_64_freebsd,system_x86_64_win64,system_x86_64_embedded]; + flags : [af_allowdirect,af_needar,af_smartlink_sections,af_supports_dwarf]; + labelprefix : '.L'; + comment : '# '; + ); + + as_x86_64_gas_info : tasminfo = + ( + id : as_ggas; + idtxt : 'GAS'; + asmbin : 'gas'; + asmcmd : '--64 -o $OBJ $ASM'; + supported_targets : [system_x86_64_solaris]; + flags : [af_allowdirect,af_needar,af_smartlink_sections,af_supports_dwarf]; + labelprefix : '.L'; + comment : '# '; + ); + + + + as_x86_64_gas_darwin_info : tasminfo = + ( + id : as_darwin; + idtxt : 'AS-Darwin'; + asmbin : 'as'; + asmcmd : '-o $OBJ $ASM -arch x86_64'; + supported_targets : [system_x86_64_darwin]; + flags : [af_allowdirect,af_needar,af_smartlink_sections,af_supports_dwarf]; + labelprefix : 'L'; + comment : '# '; + ); + +{$else x86_64} + as_i386_as_info : tasminfo = + ( + id : as_gas; + idtxt : 'AS'; + asmbin : 'as'; + asmcmd : '--32 -o $OBJ $ASM'; + supported_targets : [system_i386_GO32V2,system_i386_linux,system_i386_Win32,system_i386_freebsd,system_i386_solaris,system_i386_beos, + system_i386_netbsd,system_i386_Netware,system_i386_qnx,system_i386_wdosx,system_i386_openbsd, + system_i386_netwlibc,system_i386_wince,system_i386_embedded,system_i386_symbian,system_i386_haiku,system_x86_6432_linux, + system_i386_nativent]; + flags : [af_allowdirect,af_needar,af_smartlink_sections,af_supports_dwarf]; + labelprefix : '.L'; + comment : '# '; + ); + + + as_i386_as_aout_info : tasminfo = + ( + id : as_i386_as_aout; + idtxt : 'AS_AOUT'; + asmbin : 'as'; + asmcmd : '-o $OBJ $ASM'; + supported_targets : [system_i386_linux,system_i386_OS2,system_i386_freebsd,system_i386_netbsd,system_i386_openbsd,system_i386_EMX,system_i386_embedded]; + flags : [af_allowdirect,af_needar,af_stabs_use_function_absolute_addresses]; + labelprefix : 'L'; + comment : '# '; + ); + + + as_i386_gas_darwin_info : tasminfo = + ( + id : as_darwin; + idtxt : 'AS-Darwin'; + asmbin : 'as'; + asmcmd : '-o $OBJ $ASM -arch i386'; + supported_targets : [system_i386_darwin,system_i386_iphonesim]; + flags : [af_allowdirect,af_needar,af_smartlink_sections,af_supports_dwarf,af_stabs_use_function_absolute_addresses]; + labelprefix : 'L'; + comment : '# '; + ); + + as_i386_gas_info : tasminfo = + ( + id : as_ggas; + idtxt : 'GAS'; + asmbin : 'gas'; + asmcmd : '--32 -o $OBJ $ASM'; + supported_targets : [system_i386_GO32V2,system_i386_linux,system_i386_Win32,system_i386_freebsd,system_i386_solaris,system_i386_beos, + system_i386_netbsd,system_i386_Netware,system_i386_qnx,system_i386_wdosx,system_i386_openbsd, + system_i386_netwlibc,system_i386_wince,system_i386_embedded,system_i386_symbian,system_i386_haiku,system_x86_6432_linux]; + flags : [af_allowdirect,af_needar,af_smartlink_sections,af_supports_dwarf]; + labelprefix : '.L'; + comment : '# '; + ); +{$endif x86_64} + +initialization +{$ifdef x86_64} + RegisterAssembler(as_x86_64_as_info,Tx86ATTAssembler); + RegisterAssembler(as_x86_64_gas_info,Tx86ATTAssembler); + RegisterAssembler(as_x86_64_gas_darwin_info,Tx86AppleGNUAssembler); +{$else x86_64} + RegisterAssembler(as_i386_as_info,Tx86ATTAssembler); + RegisterAssembler(as_i386_gas_info,Tx86ATTAssembler); + RegisterAssembler(as_i386_gas_darwin_info,Tx86AppleGNUAssembler); + RegisterAssembler(as_i386_as_aout_info,Tx86AoutGNUAssembler); +{$endif x86_64} +end. diff --git a/closures/compiler/x86/agx86int.pas b/closures/compiler/x86/agx86int.pas new file mode 100644 index 0000000000..3b9661ccdf --- /dev/null +++ b/closures/compiler/x86/agx86int.pas @@ -0,0 +1,1018 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements an asmoutput class for Intel syntax with Intel i386+ + + 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 asmoutput class for Intel syntax with Intel i386+ +} +unit agx86int; + +{$i fpcdefs.inc} + +interface + + uses + cpubase, + aasmbase,aasmtai,aasmdata,aasmcpu,assemble,cgutils; + + type + Tx86IntelAssembler = class(TExternalAssembler) + private + procedure WriteReference(var ref : treference); + procedure WriteOper(const o:toper;s : topsize; opcode: tasmop;dest : boolean); + procedure WriteOper_jmp(const o:toper;s : topsize); + public + procedure WriteTree(p:TAsmList);override; + procedure WriteAsmList;override; + Function DoAssemble:boolean;override; + procedure WriteExternals; + end; + + +implementation + + uses + SysUtils, + cutils,globtype,globals,systems,cclasses, + verbose,finput,fmodule,script,cpuinfo, + itx86int, + cgbase + ; + + const + line_length = 70; + + secnames : array[TAsmSectiontype] of string[4] = ('','', + 'CODE','DATA','DATA','DATA','BSS','TLS', + '','','','','','', + '','','','', + '', + '', + '', + '', + '', + '','','','', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '' + ); + + secnamesml64 : array[TAsmSectiontype] of string[7] = ('','', + '_TEXT','_DATA','_DATA','_DATA','_BSS','_TLS', + '','','','', + 'idata$2','idata$4','idata$5','idata$6','idata$7','edata', + '', + '', + '', + '', + '', + '','','','', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '', + '' + ); + + function single2str(d : single) : string; + var + hs : string; + p : byte; + begin + str(d,hs); + { nasm expects a lowercase e } + p:=pos('E',hs); + if p>0 then + hs[p]:='e'; + p:=pos('+',hs); + if p>0 then + delete(hs,p,1); + single2str:=lower(hs); + end; + + function double2str(d : double) : string; + var + hs : string; + p : byte; + begin + str(d,hs); + { nasm expects a lowercase e } + p:=pos('E',hs); + if p>0 then + hs[p]:='e'; + p:=pos('+',hs); + if p>0 then + delete(hs,p,1); + double2str:=lower(hs); + end; + + function extended2str(e : extended) : string; + var + hs : string; + p : byte; + begin + str(e,hs); + { nasm expects a lowercase e } + p:=pos('E',hs); + if p>0 then + hs[p]:='e'; + p:=pos('+',hs); + if p>0 then + delete(hs,p,1); + extended2str:=lower(hs); + end; + + + function comp2str(d : bestreal) : string; + type + pdouble = ^double; + var + c : comp; + dd : pdouble; + begin + c:=comp(d); + dd:=pdouble(@c); { this makes a bitwise copy of c into a double } + comp2str:=double2str(dd^); + end; + + { MASM supports aligns up to 8192 } + function alignstr(b : integer) : string; + begin + case b of + 1: result:='BYTE'; + 2: result:='WORD'; + 4: result:='DWORD'; + 16: result:='PARA'; + 256: result:='PAGE'; + else + result:='ALIGN('+tostr(b)+')'; + end; + end; + +{**************************************************************************** + tx86IntelAssembler + ****************************************************************************} + + procedure tx86IntelAssembler.WriteReference(var ref : treference); + var + first : boolean; + begin + with ref do + begin + first:=true; + if segment<>NR_NO then + AsmWrite(masm_regname(segment)+':[') + else + AsmWrite('['); + if assigned(symbol) then + begin + if (target_asm.id = as_i386_tasm) then + AsmWrite('dword ptr '); + AsmWrite(symbol.name); + first:=false; + end; + if (base<>NR_NO) then + begin + if not(first) then + AsmWrite('+') + else + first:=false; +{$ifdef x86_64} + { ml64 needs [$+foo] instead of [rip+foo] } + if (base=NR_RIP) and (target_asm.id=as_x86_64_masm) then + AsmWrite('$') + else +{$endif x86_64} + AsmWrite(masm_regname(base)); + end; + if (index<>NR_NO) then + begin + if not(first) then + AsmWrite('+') + else + first:=false; + AsmWrite(masm_regname(index)); + if scalefactor<>0 then + AsmWrite('*'+tostr(scalefactor)); + end; + if offset<0 then + begin + AsmWrite(tostr(offset)); + first:=false; + end + else if (offset>0) then + begin + AsmWrite('+'+tostr(offset)); + first:=false; + end; + if first then + AsmWrite('0'); + AsmWrite(']'); + end; + end; + + + procedure tx86IntelAssembler.WriteOper(const o:toper;s : topsize; opcode: tasmop;dest : boolean); + begin + case o.typ of + top_reg : + AsmWrite(masm_regname(o.reg)); + top_const : + AsmWrite(tostr(o.val)); + top_ref : + begin + if o.ref^.refaddr in [addr_no,addr_pic,addr_pic_no_got] then + begin + if ((opcode <> A_LGS) and (opcode <> A_LSS) and + (opcode <> A_LFS) and (opcode <> A_LDS) and + (opcode <> A_LES)) then + Begin + case s of + S_B : AsmWrite('byte ptr '); + S_W : AsmWrite('word ptr '); + S_L : AsmWrite('dword ptr '); + S_Q : AsmWrite('qword ptr '); + S_IS : AsmWrite('word ptr '); + S_IL : AsmWrite('dword ptr '); + S_IQ : AsmWrite('qword ptr '); + S_FS : AsmWrite('dword ptr '); + S_FL : AsmWrite('qword ptr '); + S_T, + S_FX : AsmWrite('tbyte ptr '); + S_BW : if dest then + AsmWrite('word ptr ') + else + AsmWrite('byte ptr '); + S_BL : if dest then + AsmWrite('dword ptr ') + else + AsmWrite('byte ptr '); + S_WL : if dest then + AsmWrite('dword ptr ') + else + AsmWrite('word ptr '); +{$ifdef x86_64} + S_BQ : if dest then + AsmWrite('qword ptr ') + else + AsmWrite('byte ptr '); + S_WQ : if dest then + AsmWrite('qword ptr ') + else + AsmWrite('word ptr '); + S_LQ : if dest then + AsmWrite('qword ptr ') + else + AsmWrite('dword ptr '); + S_XMM: AsmWrite('xmmword ptr '); + +{$endif x86_64} + end; + end; + WriteReference(o.ref^); + end + else + begin + AsmWrite('offset '); + if assigned(o.ref^.symbol) then + AsmWrite(o.ref^.symbol.name); + if o.ref^.offset>0 then + AsmWrite('+'+tostr(o.ref^.offset)) + else + if o.ref^.offset<0 then + AsmWrite(tostr(o.ref^.offset)) + else + if not(assigned(o.ref^.symbol)) then + AsmWrite('0'); + end; + end; + else + internalerror(2005060510); + end; + end; + + + procedure tx86IntelAssembler.WriteOper_jmp(const o:toper;s : topsize); + begin + case o.typ of + top_reg : + AsmWrite(masm_regname(o.reg)); + top_const : + AsmWrite(tostr(o.val)); + top_ref : + { what about lcall or ljmp ??? } + begin + if o.ref^.refaddr=addr_no then + begin + if (target_asm.id <> as_i386_tasm) then + begin + if s=S_FAR then + AsmWrite('far ptr ') + else +{$ifdef x86_64} + AsmWrite('qword ptr '); +{$else x86_64} + AsmWrite('dword ptr '); +{$endif x86_64} + end; + WriteReference(o.ref^); + end + else + begin + AsmWrite(o.ref^.symbol.name); + if o.ref^.offset>0 then + AsmWrite('+'+tostr(o.ref^.offset)) + else + if o.ref^.offset<0 then + AsmWrite(tostr(o.ref^.offset)); + end; + end; + else + internalerror(2005060511); + end; + end; + + const + ait_const2str : array[aitconst_128bit..aitconst_secrel32_symbol] of string[20]=( + #9''#9,#9'DQ'#9,#9'DD'#9,#9'DW'#9,#9'DB'#9, + #9'FIXMESLEB',#9'FIXEMEULEB', + #9'DD RVA'#9,#9'DD SECREL32'#9 + ); + + Function PadTabs(const p:string;addch:char):string; + var + s : string; + i : longint; + begin + i:=length(p); + if addch<>#0 then + begin + inc(i); + s:=p+addch; + end + else + s:=p; + if i<8 then + PadTabs:=s+#9#9 + else + PadTabs:=s+#9; + end; + + procedure tx86IntelAssembler.WriteTree(p:TAsmList); + var + s, + prefix, + suffix : string; + hp : tai; + counter, + lines, + InlineLevel : longint; + i,j,l : longint; + consttype : taiconst_type; + do_line,DoNotSplitLine, + quoted : boolean; + begin + if not assigned(p) then + exit; + { lineinfo is only needed for al_procedures (PFV) } + do_line:=((cs_asm_source in current_settings.globalswitches) or + (cs_lineinfo in current_settings.moduleswitches)) + and (p=current_asmdata.asmlists[al_procedures]); + InlineLevel:=0; + DoNotSplitLine:=false; + hp:=tai(p.first); + while assigned(hp) do + begin + prefetch(pointer(hp.next)^); + if not(hp.typ in SkipLineInfo) then + begin + current_filepos:=tailineinfo(hp).fileinfo; + { no line info for inlined code } + if do_line and (inlinelevel=0) and not DoNotSplitLine then + WriteSourceLine(hp as tailineinfo); + end; + DoNotSplitLine:=false; + + case hp.typ of + ait_comment : + Begin + AsmWrite(target_asm.comment); + AsmWritePChar(tai_comment(hp).str); + AsmLn; + End; + + ait_regalloc : + begin + if (cs_asm_regalloc in current_settings.globalswitches) then + AsmWriteLn(target_asm.comment+'Register '+masm_regname(tai_regalloc(hp).reg)+ + regallocstr[tai_regalloc(hp).ratype]); + end; + + ait_tempalloc : + begin + if (cs_asm_tempalloc in current_settings.globalswitches) then + WriteTempalloc(tai_tempalloc(hp)); + end; + + ait_section : + begin + if tai_section(hp).sectype<>sec_none then + begin + if target_asm.id=as_x86_64_masm then + begin + if LasTSecType<>sec_none then + AsmWriteLn(secnamesml64[LasTSecType]+#9#9'ENDS'); + AsmLn; + AsmWriteLn(secnamesml64[tai_section(hp).sectype]+#9+'SEGMENT') + end + else + begin + if LasTSecType<>sec_none then + AsmWriteLn('_'+secnames[LasTSecType]+#9#9'ENDS'); + AsmLn; + AsmWriteLn('_'+secnames[tai_section(hp).sectype]+#9#9+ + 'SEGMENT'#9+alignstr(tai_section(hp).secalign)+' PUBLIC USE32 '''+ + secnames[tai_section(hp).sectype]+''''); + end; + end; + LasTSecType:=tai_section(hp).sectype; + end; + ait_align : + begin + { CAUSES PROBLEMS WITH THE SEGMENT DEFINITION } + { SEGMENT DEFINITION SHOULD MATCH TYPE OF ALIGN } + { HERE UNDER TASM! } + if tai_align_abstract(hp).aligntype>1 then + AsmWriteLn(#9'ALIGN '+tostr(tai_align_abstract(hp).aligntype)); + end; + ait_datablock : + begin + if tai_datablock(hp).is_global then + AsmWriteLn(#9'PUBLIC'#9+tai_datablock(hp).sym.name); + AsmWriteLn(PadTabs(tai_datablock(hp).sym.name,#0)+'DB'#9+tostr(tai_datablock(hp).size)+' DUP(?)'); + end; + ait_const: + begin + consttype:=tai_const(hp).consttype; + case consttype of + aitconst_uleb128bit, + aitconst_sleb128bit, + aitconst_128bit, + aitconst_64bit, + aitconst_32bit, + aitconst_16bit, + aitconst_8bit, + aitconst_rva_symbol, + aitconst_secrel32_symbol : + begin + AsmWrite(ait_const2str[consttype]); + 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)); + if (l>line_length) or + (hp.next=nil) or + (tai(hp.next).typ<>ait_const) or + (tai_const(hp.next).consttype<>consttype) then + break; + hp:=tai(hp.next); + AsmWrite(','); + until false; + AsmLn; + end; + else + internalerror(200704253); + end; + end; + + ait_real_32bit : + AsmWriteLn(#9#9'DD'#9+single2str(tai_real_32bit(hp).value)); + ait_real_64bit : + AsmWriteLn(#9#9'DQ'#9+double2str(tai_real_64bit(hp).value)); + ait_real_80bit : + AsmWriteLn(#9#9'DT'#9+extended2str(tai_real_80bit(hp).value)); + ait_comp_64bit : + AsmWriteLn(#9#9'DQ'#9+extended2str(tai_comp_64bit(hp).value)); + ait_string : + begin + counter := 0; + lines := tai_string(hp).len div line_length; + { separate lines in different parts } + if tai_string(hp).len > 0 then + Begin + for j := 0 to lines-1 do + begin + AsmWrite(#9#9'DB'#9); + quoted:=false; + for i:=counter to counter+line_length-1 do + begin + { it is an ascii character. } + if (ord(tai_string(hp).str[i])>31) and + (ord(tai_string(hp).str[i])<128) and + (tai_string(hp).str[i]<>'"') then + begin + if not(quoted) then + begin + if i>counter then + AsmWrite(','); + AsmWrite('"'); + end; + AsmWrite(tai_string(hp).str[i]); + quoted:=true; + end { if > 31 and < 128 and ord('"') } + else + begin + if quoted then + AsmWrite('"'); + if i>counter then + AsmWrite(','); + quoted:=false; + AsmWrite(tostr(ord(tai_string(hp).str[i]))); + end; + end; { end for i:=0 to... } + if quoted then AsmWrite('"'); + AsmWrite(target_info.newline); + counter := counter+line_length; + end; { end for j:=0 ... } + { do last line of lines } + if counter<tai_string(hp).len then + AsmWrite(#9#9'DB'#9); + quoted:=false; + for i:=counter to tai_string(hp).len-1 do + begin + { it is an ascii character. } + if (ord(tai_string(hp).str[i])>31) and + (ord(tai_string(hp).str[i])<128) and + (tai_string(hp).str[i]<>'"') then + begin + if not(quoted) then + begin + if i>counter then + AsmWrite(','); + AsmWrite('"'); + end; + AsmWrite(tai_string(hp).str[i]); + quoted:=true; + end { if > 31 and < 128 and " } + else + begin + if quoted then + AsmWrite('"'); + if i>counter then + AsmWrite(','); + quoted:=false; + AsmWrite(tostr(ord(tai_string(hp).str[i]))); + end; + end; { end for i:=0 to... } + if quoted then + AsmWrite('"'); + end; + AsmLn; + end; + ait_label : + begin + if tai_label(hp).labsym.is_used then + begin + AsmWrite(tai_label(hp).labsym.name); + if assigned(hp.next) and not(tai(hp.next).typ in + [ait_const, + ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then + AsmWriteLn(':') + else + DoNotSplitLine:=true; + end; + end; + ait_symbol : + begin + if tai_symbol(hp).has_value then + internalerror(2009090802); + if tai_symbol(hp).is_global then + AsmWriteLn(#9'PUBLIC'#9+tai_symbol(hp).sym.name); + AsmWrite(tai_symbol(hp).sym.name); + if assigned(hp.next) and not(tai(hp.next).typ in + [ait_const, + ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then + AsmWriteLn(':') + end; + ait_symbol_end : + begin + end; + ait_instruction : + begin + taicpu(hp).CheckNonCommutativeOpcodes; + taicpu(hp).SetOperandOrder(op_intel); + { Reset } + suffix:=''; + prefix:= ''; + { We need to explicitely set + word prefix to get selectors + to be pushed in 2 bytes PM } + if (taicpu(hp).opsize=S_W) and + ( + ( + (taicpu(hp).opcode=A_PUSH) or + (taicpu(hp).opcode=A_POP) + ) and + (taicpu(hp).oper[0]^.typ=top_reg) and + is_segment_reg(taicpu(hp).oper[0]^.reg) + ) then + AsmWriteln(#9#9'DB'#9'066h'); + + { added prefix instructions, must be on same line as opcode } + if (taicpu(hp).ops = 0) and + ((taicpu(hp).opcode = A_REP) or + (taicpu(hp).opcode = A_LOCK) or + (taicpu(hp).opcode = A_REPE) or + (taicpu(hp).opcode = A_REPNZ) or + (taicpu(hp).opcode = A_REPZ) or + (taicpu(hp).opcode = A_REPNE)) then + Begin + prefix:=std_op2str[taicpu(hp).opcode]+#9; + { there can be a stab inbetween when the opcode was on + a different line in the source code } + repeat + hp:=tai(hp.next); + until (hp=nil) or (hp.typ=ait_instruction); + { this is theorically impossible... } + if hp=nil then + begin + AsmWriteLn(#9#9+prefix); + break; + end; + { nasm prefers prefix on a line alone + AsmWriteln(#9#9+prefix); but not masm PM + prefix:=''; } + if target_asm.id in [as_i386_nasmcoff,as_i386_nasmwin32,as_i386_nasmwdosx, + as_i386_nasmelf,as_i386_nasmobj,as_i386_nasmbeos,as_i386_nasmhaiku] then + begin + AsmWriteln(prefix); + prefix:=''; + end; + end + else + prefix:= ''; + if (target_asm.id = as_i386_wasm) and + (taicpu(hp).opsize=S_W) and + (taicpu(hp).opcode=A_PUSH) and + (taicpu(hp).oper[0]^.typ=top_const) then + begin + AsmWriteln(#9#9'DB 66h,68h ; pushw imm16'); + AsmWrite(#9#9'DW'); + end + else if (target_asm.id=as_x86_64_masm) and + (taicpu(hp).opcode=A_MOVQ) then + AsmWrite(#9#9'mov') + else + AsmWrite(#9#9+prefix+std_op2str[taicpu(hp).opcode]+cond2str[taicpu(hp).condition]+suffix); + if taicpu(hp).ops<>0 then + begin + if is_calljmp(taicpu(hp).opcode) then + begin + AsmWrite(#9); + WriteOper_jmp(taicpu(hp).oper[0]^,taicpu(hp).opsize); + end + else + begin + for i:=0to taicpu(hp).ops-1 do + begin + if i=0 then + AsmWrite(#9) + else + AsmWrite(','); + WriteOper(taicpu(hp).oper[i]^,taicpu(hp).opsize,taicpu(hp).opcode,(i=2)); + end; + end; + end; + AsmLn; + end; + + ait_stab, + ait_force_line, + ait_function_name : ; + + ait_cutobject : + begin + { only reset buffer if nothing has changed } + if AsmSize=AsmStartSize then + AsmClear + else + begin + if LasTSecType<>sec_none then + AsmWriteLn('_'+secnames[LasTSecType]+#9#9'ENDS'); + AsmLn; + AsmWriteLn(#9'END'); + 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 + lasTSecType:=tai_section(hp.next).sectype; + hp:=tai(hp.next); + end; + AsmWriteLn(#9'.386p'); + AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA'); + AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP'); + { I was told that this isn't necesarry because } + { the labels generated by FPC are unique (FK) } + { AsmWriteLn(#9'LOCALS '+target_asm.labelprefix); } + { TODO: PARA is incorrect, must use actual section align } + if lasTSectype<>sec_none then + AsmWriteLn('_'+secnames[lasTSectype]+#9#9+ + 'SEGMENT'#9'PARA PUBLIC USE32 '''+ + secnames[lasTSectype]+''''); + AsmStartSize:=AsmSize; + end; + ait_marker : + begin + if tai_marker(hp).kind=mark_NoLineInfoStart then + inc(InlineLevel) + else if tai_marker(hp).kind=mark_NoLineInfoEnd then + dec(InlineLevel); + end; + + ait_directive : + begin + case tai_directive(hp).directive of + asd_nasm_import : + AsmWrite('import '); + asd_extern : + AsmWrite('EXTRN '); + else + internalerror(200509192); + end; + if assigned(tai_directive(hp).name) then + AsmWrite(tai_directive(hp).name^); + AsmLn; + end; + ait_seh_directive : + { Ignore for now }; + else + internalerror(10000); + end; + hp:=tai(hp.next); + end; + end; + + + procedure tx86intelassembler.WriteExternals; + var + sym : TAsmSymbol; + i : longint; + begin + for i:=0 to current_asmdata.AsmSymbolDict.Count-1 do + begin + sym:=TAsmSymbol(current_asmdata.AsmSymbolDict[i]); + if sym.bind=AB_EXTERNAL then + begin + case target_asm.id of + as_i386_masm, + as_i386_wasm : + AsmWriteln(#9'EXTRN'#9+sym.name+': NEAR'); + as_x86_64_masm : + AsmWriteln(#9'EXTRN'#9+sym.name+': PROC'); + else + AsmWriteln(#9'EXTRN'#9+sym.name); + end; + end; + end; + end; + + + function tx86intelassembler.DoAssemble : boolean; + var + masmobjfn : string; + begin + DoAssemble:=Inherited DoAssemble; + { masm does not seem to recognize specific extensions and uses .obj allways PM } + if (target_asm.id in [as_i386_masm,as_i386_wasm]) then + begin + masmobjfn:=ChangeFileExt(objfilename,'.obj'); + if not(cs_asm_extern in current_settings.globalswitches) then + begin + if Not FileExists(objfilename) and + FileExists(masmobjfn) then + RenameFile(masmobjfn,objfilename); + end + else + AsmRes.AddAsmCommand('mv',masmobjfn+' '+objfilename,objfilename); + end; + end; + + + procedure tx86IntelAssembler.WriteAsmList; + var + hal : tasmlisttype; + begin +{$ifdef EXTDEBUG} + if assigned(current_module.mainsource) then + comment(v_info,'Start writing intel-styled assembler output for '+current_module.mainsource^); +{$endif} + if target_asm.id<>as_x86_64_masm then + begin + AsmWriteLn(#9'.386p'); + { masm 6.11 does not seem to like LOCALS PM } + if (target_asm.id = as_i386_tasm) then + begin + AsmWriteLn(#9'LOCALS '+target_asm.labelprefix); + end; + AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA'); + AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP'); + AsmLn; + end; + + WriteExternals; + + for hal:=low(TasmlistType) to high(TasmlistType) do + begin + AsmWriteLn(target_asm.comment+'Begin asmlist '+AsmListTypeStr[hal]); + writetree(current_asmdata.asmlists[hal]); + AsmWriteLn(target_asm.comment+'End asmlist '+AsmListTypeStr[hal]); + end; + + { better do this at end of WriteTree, but then there comes a trouble with + al_const which does not have leading ait_section and thus goes out of segment } + + if LastSecType <> sec_none then + begin + if target_asm.id=as_x86_64_masm then + AsmWriteLn(secnamesml64[LasTSecType]+#9#9'ENDS') + else + AsmWriteLn('_'+secnames[LasTSecType]+#9#9'ENDS'); + end; + LastSecType := sec_none; + + AsmWriteLn(#9'END'); + AsmLn; + +{$ifdef EXTDEBUG} + if assigned(current_module.mainsource) then + comment(v_info,'Done writing intel-styled assembler output for '+current_module.mainsource^); +{$endif EXTDEBUG} + end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + + const +{$ifdef i386} + as_i386_tasm_info : tasminfo = + ( + id : as_i386_tasm; + idtxt : 'TASM'; + asmbin : 'tasm'; + asmcmd : '/m2 /ml $ASM $OBJ'; + supported_targets : [system_i386_GO32V2,system_i386_Win32,system_i386_wdosx,system_i386_watcom,system_i386_wince]; + flags : [af_allowdirect,af_needar,af_labelprefix_only_inside_procedure]; + labelprefix : '@@'; + comment : '; '; + ); + + as_i386_masm_info : tasminfo = + ( + id : as_i386_masm; + idtxt : 'MASM'; + asmbin : 'masm'; + asmcmd : '/c /Cp $ASM /Fo$OBJ'; + supported_targets : [system_i386_GO32V2,system_i386_Win32,system_i386_wdosx,system_i386_watcom,system_i386_wince]; + flags : [af_allowdirect,af_needar]; + labelprefix : '@@'; + comment : '; '; + ); + + as_i386_wasm_info : tasminfo = + ( + id : as_i386_wasm; + idtxt : 'WASM'; + asmbin : 'wasm'; + asmcmd : '$ASM -6s -fp6 -ms -zq -Fo=$OBJ'; + supported_targets : [system_i386_watcom]; + flags : [af_allowdirect,af_needar]; + labelprefix : '@@'; + comment : '; '; + ); +{$endif i386} +{$ifdef x86_64} + as_x86_64_masm_info : tasminfo = + ( + id : as_x86_64_masm; + idtxt : 'MASM'; + asmbin : 'ml64'; + asmcmd : '/c /Cp $ASM /Fo$OBJ'; + supported_targets : [system_x86_64_win64]; + flags : [af_allowdirect,af_needar]; + labelprefix : '@@'; + comment : '; '; + ); +{$endif x86_64} + +initialization +{$ifdef x86_64} + RegisterAssembler(as_x86_64_masm_info,tx86IntelAssembler); +{$endif x86_64} +{$ifdef i386} + RegisterAssembler(as_i386_tasm_info,tx86IntelAssembler); + RegisterAssembler(as_i386_masm_info,tx86IntelAssembler); + RegisterAssembler(as_i386_wasm_info,tx86IntelAssembler); +{$endif i386} +end. diff --git a/closures/compiler/x86/agx86nsm.pas b/closures/compiler/x86/agx86nsm.pas new file mode 100644 index 0000000000..70c96e7493 --- /dev/null +++ b/closures/compiler/x86/agx86nsm.pas @@ -0,0 +1,1145 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements an asmoutput class for the Nasm assembler with + Intel syntax for the i386+ + + 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 agx86nsm; + +{$i fpcdefs.inc} + +interface + + uses + cpubase, + aasmbase,aasmtai,aasmdata,aasmcpu,assemble,cgutils; + + type + T386NasmAssembler = class(texternalassembler) + private + procedure WriteReference(var ref : treference); + procedure WriteOper(const o:toper;s : topsize; opcode: tasmop;ops:longint;dest : boolean); + procedure WriteOper_jmp(const o:toper; op : tasmop); + procedure WriteSection(atype:TAsmSectiontype;const aname:string); + public + procedure WriteTree(p:TAsmList);override; + procedure WriteAsmList;override; + procedure WriteExternals; + procedure WriteSmartExternals; + end; + + + + implementation + + uses + cutils,globtype,globals,systems,cclasses, + fmodule,finput,verbose,cpuinfo,cgbase + ; + + type +{$ifdef cpuextended} + t80bitarray = array[0..9] of byte; +{$endif cpuextended} + t64bitarray = array[0..7] of byte; + t32bitarray = array[0..3] of byte; + const + line_length = 64; + + nasm_regname_table : array[tregisterindex] of string[7] = ( + {r386nasm.inc contains the Nasm name of each register.} + {$i r386nasm.inc} + ); + + function nasm_regname(r:Tregister):string; + var + p : tregisterindex; + begin + p:=findreg_by_number(r); + if p<>0 then + result:=nasm_regname_table[p] + else + result:=generic_regname(r); + end; + + function single2str(d : single) : string; + var + hs : string; + p : longint; + begin + str(d,hs); + { nasm expects a lowercase e } + p:=pos('E',hs); + if p>0 then + hs[p]:='e'; + p:=pos('+',hs); + if p>0 then + delete(hs,p,1); + single2str:=lower(hs); + end; + + function double2str(d : double) : string; + var + hs : string; + p : longint; + begin + str(d,hs); + { nasm expects a lowercase e } + p:=pos('E',hs); + if p>0 then + hs[p]:='e'; + p:=pos('+',hs); + if p>0 then + delete(hs,p,1); + double2str:=lower(hs); + end; + + function extended2str(e : extended) : string; + var + hs : string; + p : longint; + begin + str(e,hs); + { nasm expects a lowercase e } + p:=pos('E',hs); + if p>0 then + hs[p]:='e'; + p:=pos('+',hs); + if p>0 then + delete(hs,p,1); + extended2str:=lower(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; + + + function comp2str(d : bestreal) : string; + type + pdouble = ^double; + var + c : comp; + dd : pdouble; + begin + c:=comp(d); + dd:=pdouble(@c); { this makes a bitwise copy of c into a double } + comp2str:=double2str(dd^); + end; + + + function sizestr(s:topsize;dest:boolean):string; + begin + case s of + S_B : sizestr:='byte '; + S_W : sizestr:='word '; + S_L : sizestr:='dword '; + S_Q : sizestr:='qword '; + S_IS : sizestr:='word '; + S_IL : sizestr:='dword '; + S_IQ : sizestr:='qword '; + S_FS : sizestr:='dword '; + S_FL : sizestr:='qword '; + S_FX : sizestr:='tword '; + S_BW : if dest then + sizestr:='word ' + else + sizestr:='byte '; + S_BL : if dest then + sizestr:='dword ' + else + sizestr:='byte '; + S_WL : if dest then + sizestr:='dword ' + else + sizestr:='word '; + else { S_NO } + sizestr:=''; + end; + end; + + + Function PadTabs(const p:string;addch:char):string; + var + s : string; + i : longint; + begin + i:=length(p); + if addch<>#0 then + begin + inc(i); + s:=p+addch; + end + else + s:=p; + if i<8 then + PadTabs:=s+#9#9 + else + PadTabs:=s+#9; + end; + + + type + PExternChain = ^TExternChain; + + TExternChain = Record + psym : pshortstring; + is_defined : boolean; + next : PExternChain; + end; + + const + FEC : PExternChain = nil; + + procedure AddSymbol(symname : string; defined : boolean); + var + EC : PExternChain; + begin + EC:=FEC; + while assigned(EC) do + begin + if EC^.psym^=symname then + begin + if defined then + EC^.is_defined:=true; + exit; + end; + EC:=EC^.next; + end; + New(EC); + EC^.next:=FEC; + FEC:=EC; + FEC^.psym:=stringdup(symname); + FEC^.is_defined := defined; + end; + + procedure FreeExternChainList; + var + EC : PExternChain; + begin + EC:=FEC; + while assigned(EC) do + begin + FEC:=EC^.next; + stringdispose(EC^.psym); + Dispose(EC); + EC:=FEC; + end; + end; + +{**************************************************************************** + T386NasmAssembler + ****************************************************************************} + + procedure T386NasmAssembler.WriteReference(var ref : treference); + var + first : boolean; + begin + with ref do + begin + AsmWrite('['); + first:=true; + if (segment<>NR_NO) then + AsmWrite(nasm_regname(segment)+':'); + if assigned(symbol) then + begin + AsmWrite(symbol.name); + if SmartAsm then + AddSymbol(symbol.name,false); + first:=false; + end; + if (base<>NR_NO) then + begin + if not(first) then + AsmWrite('+') + else + first:=false; + AsmWrite(nasm_regname(base)) + end; + if (index<>NR_NO) then + begin + if not(first) then + AsmWrite('+') + else + first:=false; + AsmWrite(nasm_regname(index)); + if scalefactor<>0 then + AsmWrite('*'+tostr(scalefactor)); + end; + if offset<0 then + begin + AsmWrite(tostr(offset)); + first:=false; + end + else if (offset>0) then + begin + AsmWrite('+'+tostr(offset)); + first:=false; + end; + if first then + AsmWrite('0'); + AsmWrite(']'); + end; + end; + + + procedure T386NasmAssembler.WriteOper(const o:toper;s : topsize; opcode: tasmop;ops:longint;dest : boolean); + begin + case o.typ of + top_reg : + AsmWrite(nasm_regname(o.reg)); + top_const : + begin + if (ops=1) and (opcode<>A_RET) then + AsmWrite(sizestr(s,dest)); + AsmWrite(tostr(longint(o.val))); + end; + top_ref : + begin + if o.ref^.refaddr=addr_no then + begin + if not ((opcode = A_LEA) or (opcode = A_LGS) or + (opcode = A_LSS) or (opcode = A_LFS) or + (opcode = A_LES) or (opcode = A_LDS) or + // (opcode = A_SHR) or (opcode = A_SHL) or + (opcode = A_SAR) or (opcode = A_SAL) or + (opcode = A_OUT) or (opcode = A_IN)) then + AsmWrite(sizestr(s,dest)); + WriteReference(o.ref^); + end + else + begin + asmwrite('dword '); + if assigned(o.ref^.symbol) then + begin + if SmartAsm then + AddSymbol(o.ref^.symbol.name,false); + asmwrite(o.ref^.symbol.name); + if o.ref^.offset=0 then + exit; + end; + if o.ref^.offset>0 then + asmwrite('+'); + asmwrite(tostr(o.ref^.offset)); + end; + end; + else + internalerror(10001); + end; + end; + + + procedure T386NasmAssembler.WriteOper_jmp(const o:toper; op : tasmop); + begin + case o.typ of + top_reg : + AsmWrite(nasm_regname(o.reg)); + top_ref : + if o.ref^.refaddr=addr_no then + WriteReference(o.ref^) + else + begin + if not( + (op=A_JCXZ) or (op=A_JECXZ) or +{$ifdef x86_64} + (op=A_JRCXZ) or +{$endif x86_64} + (op=A_LOOP) or (op=A_LOOPE) or + (op=A_LOOPNE) or (op=A_LOOPNZ) or + (op=A_LOOPZ) + ) then + AsmWrite('NEAR '); + AsmWrite(o.ref^.symbol.name); + if SmartAsm then + AddSymbol(o.ref^.symbol.name,false); + if o.ref^.offset>0 then + AsmWrite('+'+tostr(o.ref^.offset)) + else + if o.ref^.offset<0 then + AsmWrite(tostr(o.ref^.offset)); + end; + top_const : + AsmWrite(tostr(aint(o.val))); + else + internalerror(10001); + end; + end; + + + const + ait_const2str : array[aitconst_128bit..aitconst_secrel32_symbol] of string[20]=( + #9'FIXME_128BIT'#9,#9'FIXME_64BIT'#9,#9'DD'#9,#9'DW'#9,#9'DB'#9, + #9'FIXME_SLEB128BIT'#9,#9'FIXME_ULEB128BIT'#9, + #9'RVA'#9,#9'SECREL32'#9 + ); + + procedure T386NasmAssembler.WriteSection(atype:TAsmSectiontype;const aname:string); + const + secnames : array[TAsmSectiontype] of string[length('__DATA, __datacoal_nt,coalesced')] = ('','', + '.text', + '.data', + '.data', + '.rodata', + '.bss', + '.tbss', + '.pdata', + '.text','.data','.data','.data','.data', + '.stab', + '.stabstr', + '.idata2','.idata4','.idata5','.idata6','.idata7','.edata', + '.eh_frame', + '.debug_frame','.debug_info','.debug_line','.debug_abbrev', + '.fpc', + '', + '.init', + '.fini', + '.objc_class', + '.objc_meta_class', + '.objc_cat_cls_meth', + '.objc_cat_inst_meth', + '.objc_protocol', + '.objc_string_object', + '.objc_cls_meth', + '.objc_inst_meth', + '.objc_cls_refs', + '.objc_message_refs', + '.objc_symbols', + '.objc_category', + '.objc_class_vars', + '.objc_instance_vars', + '.objc_module_info', + '.objc_class_names', + '.objc_meth_var_types', + '.objc_meth_var_names', + '.objc_selector_strs', + '.objc_protocol_ext', + '.objc_class_ext', + '.objc_property', + '.objc_image_info', + '.objc_cstring_object', + '.objc_sel_fixup', + '__DATA,__objc_data', + '__DATA,__objc_const', + '.objc_superrefs', + '__DATA, __datacoal_nt,coalesced', + '.objc_classlist', + '.objc_nlclasslist', + '.objc_catlist', + '.obcj_nlcatlist', + '.objc_protolist' + ); + begin + AsmLn; + AsmWrite('SECTION '); + { go32v2 stub only loads .text and .data sections, and allocates space for .bss. + Thus, data which normally goes into .rodata and .rodata_norel sections must + end up in .data section } + if (atype in [sec_rodata,sec_rodata_norel]) and + (target_info.system=system_i386_go32v2) then + AsmWrite('.data') + else + AsmWrite(secnames[atype]); + if create_smartlink_sections and + (atype<>sec_bss) and + (aname<>'') then + begin + AsmWrite('.'); + AsmWrite(aname); + end; + AsmLn; + LasTSecType:=atype; + end; + + procedure T386NasmAssembler.WriteTree(p:TAsmList); +{$ifdef cpuextended} + type + t80bitarray = array[0..9] of byte; +{$endif cpuextended} + var + s : string; + hp : tai; + counter, + lines, + i,j,l : longint; + InlineLevel : longint; + consttype : taiconst_type; + do_line, + quoted : boolean; + co : comp; + sin : single; + d : double; +{$ifdef cpuextended} + e : extended; +{$endif cpuextended} + begin + if not assigned(p) then + exit; + InlineLevel:=0; + { lineinfo is only needed for al_procedures (PFV) } + do_line:=(cs_asm_source in current_settings.globalswitches) or + ((cs_lineinfo in current_settings.moduleswitches) + and (p=current_asmdata.asmlists[al_procedures])); + hp:=tai(p.first); + while assigned(hp) do + begin + prefetch(pointer(hp.next)^); + if not(hp.typ in SkipLineInfo) then + begin + current_filepos:=tailineinfo(hp).fileinfo; + { no line info for inlined code } + if do_line and (inlinelevel=0) then + WriteSourceLine(hp as tailineinfo); + end; + + case hp.typ of + ait_comment : + Begin + AsmWrite(target_asm.comment); + AsmWritePChar(tai_comment(hp).str); + AsmLn; + End; + + ait_regalloc : + begin + if (cs_asm_regalloc in current_settings.globalswitches) then + AsmWriteLn(#9#9+target_asm.comment+'Register '+nasm_regname(tai_regalloc(hp).reg)+ + regallocstr[tai_regalloc(hp).ratype]); + end; + + ait_tempalloc : + begin + if (cs_asm_tempalloc in current_settings.globalswitches) then + WriteTempalloc(tai_tempalloc(hp)); + end; + + ait_section : + begin + if tai_section(hp).sectype<>sec_none then + WriteSection(tai_section(hp).sectype,tai_section(hp).name^); + LasTSecType:=tai_section(hp).sectype; + end; + + ait_align : + begin + { nasm gives warnings when it finds align in bss as it + wants to store data } + if (lastsectype<>sec_bss) and + (tai_align(hp).aligntype>1) then + AsmWriteLn(#9'ALIGN '+tostr(tai_align(hp).aligntype)); + end; + + ait_datablock : + begin + if tai_datablock(hp).is_global then + begin + AsmWrite(#9'GLOBAL '); + AsmWriteLn(tai_datablock(hp).sym.name); + end; + AsmWrite(PadTabs(tai_datablock(hp).sym.name,':')); + if SmartAsm then + AddSymbol(tai_datablock(hp).sym.name,true); + AsmWriteLn('RESB'#9+tostr(tai_datablock(hp).size)); + end; + + ait_const: + begin + consttype:=tai_const(hp).consttype; + case consttype of + aitconst_64bit : + begin + if assigned(tai_const(hp).sym) then + internalerror(200404292); + AsmWrite(ait_const2str[aitconst_32bit]); + AsmWrite(tostr(longint(lo(tai_const(hp).value)))); + AsmWrite(','); + AsmWrite(tostr(longint(hi(tai_const(hp).value)))); + AsmLn; + end; + aitconst_uleb128bit, + aitconst_sleb128bit, + aitconst_128bit: + begin + end; + aitconst_32bit, + aitconst_16bit, + aitconst_8bit, + aitconst_rva_symbol, + aitconst_secrel32_symbol : + begin + AsmWrite(ait_const2str[tai_const(hp).consttype]); + l:=0; + repeat + if assigned(tai_const(hp).sym) then + begin + if SmartAsm then + begin + AddSymbol(tai_const(hp).sym.name,false); + if assigned(tai_const(hp).endsym) then + AddSymbol(tai_const(hp).endsym.name,false); + end; + 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)); + if (l>line_length) or + (hp.next=nil) or + (tai(hp.next).typ<>ait_const) or + (tai_const(hp.next).consttype<>consttype) then + break; + hp:=tai(hp.next); + AsmWrite(','); + until false; + AsmLn; + end; + else + internalerror(200704252); + end; + end; + +{$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)} + 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#9'DB'#9); + for i:=0 to 9 do + begin + if i<>0 then + AsmWrite(','); + AsmWrite(tostr(t80bitarray(e)[i])); + end; + for i:=11 to tai_real_80bit(hp).savesize do + AsmWrite(',0'); + AsmLn; + end; +{$else cpuextended} + ait_real_80bit : + AsmWriteLn(#9#9'DT'#9+extended2str(tai_real_80bit(hp).value)); +{$endif cpuextended} + + // ait_real_64bit : + // AsmWriteLn(#9#9'DQ'#9+double2str(tai_real_64bit(hp).value)); + 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#9'DB'#9); +{$ifdef arm} + 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 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 : + // AsmWriteLn(#9#9'DD'#9+single2str(tai_real_32bit(hp).value)); + 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#9'DB'#9); + for i:=0 to 3 do + begin + if i<>0 then + AsmWrite(','); + AsmWrite(tostr(t32bitarray(sin)[i])); + end; + AsmLn; + end; + // ait_comp_64bit : + // AsmWriteLn(#9#9'DQ'#9+comp2str(tai_real_80bit(hp).value)); + ait_comp_64bit : + begin + if do_line then + AsmWriteLn(target_asm.comment+'value: '+extended2str(tai_comp_64bit(hp).value)); + AsmWrite(#9#9'DB'#9); + co:=comp(tai_comp_64bit(hp).value); + { 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 + counter := 0; + lines := tai_string(hp).len div line_length; + { separate lines in different parts } + if tai_string(hp).len > 0 then + Begin + for j := 0 to lines-1 do + begin + AsmWrite(#9#9'DB'#9); + quoted:=false; + for i:=counter to counter+line_length-1 do + begin + { it is an ascii character. } + if (ord(tai_string(hp).str[i])>31) and + (ord(tai_string(hp).str[i])<128) and + (tai_string(hp).str[i]<>'"') then + begin + if not(quoted) then + begin + if i>counter then + AsmWrite(','); + AsmWrite('"'); + end; + AsmWrite(tai_string(hp).str[i]); + quoted:=true; + end { if > 31 and < 128 and ord('"') } + else + begin + if quoted then + AsmWrite('"'); + if i>counter then + AsmWrite(','); + quoted:=false; + AsmWrite(tostr(ord(tai_string(hp).str[i]))); + end; + end; { end for i:=0 to... } + if quoted then AsmWrite('"'); + AsmWrite(target_info.newline); + inc(counter,line_length); + end; { end for j:=0 ... } + { do last line of lines } + if counter<tai_string(hp).len then + AsmWrite(#9#9'DB'#9); + quoted:=false; + for i:=counter to tai_string(hp).len-1 do + begin + { it is an ascii character. } + if (ord(tai_string(hp).str[i])>31) and + (ord(tai_string(hp).str[i])<128) and + (tai_string(hp).str[i]<>'"') then + begin + if not(quoted) then + begin + if i>counter then + AsmWrite(','); + AsmWrite('"'); + end; + AsmWrite(tai_string(hp).str[i]); + quoted:=true; + end { if > 31 and < 128 and " } + else + begin + if quoted then + AsmWrite('"'); + if i>counter then + AsmWrite(','); + quoted:=false; + AsmWrite(tostr(ord(tai_string(hp).str[i]))); + end; + end; { end for i:=0 to... } + if quoted then + AsmWrite('"'); + end; + AsmLn; + end; + + ait_label : + begin + if tai_label(hp).labsym.is_used then + AsmWriteLn(tai_label(hp).labsym.name+':'); + if SmartAsm then + AddSymbol(tai_label(hp).labsym.name,true); + end; + + ait_symbol : + begin + if tai_symbol(hp).has_value then + internalerror(2009090803); + if tai_symbol(hp).is_global then + begin + AsmWrite(#9'GLOBAL '); + AsmWriteLn(tai_symbol(hp).sym.name); + end; + AsmWrite(tai_symbol(hp).sym.name); + if SmartAsm then + AddSymbol(tai_symbol(hp).sym.name,true); + if assigned(hp.next) and not(tai(hp.next).typ in + [ait_const, + ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then + AsmWriteLn(':') + end; + + ait_symbol_end : ; + + ait_instruction : + begin + taicpu(hp).CheckNonCommutativeOpcodes; + { We need intel order, no At&t } + taicpu(hp).SetOperandOrder(op_intel); + s:=''; + if ((taicpu(hp).opcode=A_FADDP) or + (taicpu(hp).opcode=A_FMULP)) + and (taicpu(hp).ops=0) then + begin + taicpu(hp).allocate_oper(2); + taicpu(hp).oper[0]^.typ:=top_reg; + taicpu(hp).oper[0]^.reg:=NR_ST1; + taicpu(hp).oper[1]^.typ:=top_reg; + taicpu(hp).oper[1]^.reg:=NR_ST; + end; + if taicpu(hp).opcode=A_FWAIT then + AsmWriteln(#9#9'DB'#9'09bh') + else + begin + { We need to explicitely set + word prefix to get selectors + to be pushed in 2 bytes PM } + if (taicpu(hp).opsize=S_W) and + ((taicpu(hp).opcode=A_PUSH) or + (taicpu(hp).opcode=A_POP)) and + (taicpu(hp).oper[0]^.typ=top_reg) and + (is_segment_reg(taicpu(hp).oper[0]^.reg)) then + AsmWriteln(#9#9'DB'#9'066h'); + AsmWrite(#9#9+std_op2str[taicpu(hp).opcode]+cond2str[taicpu(hp).condition]); + if taicpu(hp).ops<>0 then + begin + if is_calljmp(taicpu(hp).opcode) then + begin + AsmWrite(#9); + WriteOper_jmp(taicpu(hp).oper[0]^,taicpu(hp).opcode); + end + else + begin + for i:=0 to taicpu(hp).ops-1 do + begin + if i=0 then + AsmWrite(#9) + else + AsmWrite(','); + WriteOper(taicpu(hp).oper[i]^,taicpu(hp).opsize,taicpu(hp).opcode,taicpu(hp).ops,(i=2)); + end; + end; + end; + AsmLn; + end; + end; + + ait_stab, + 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 + if SmartAsm then + begin + WriteSmartExternals; + FreeExternChainList; + end; + 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 + lasTSectype:=tai_section(hp.next).sectype; + hp:=tai(hp.next); + end; + if lasTSectype<>sec_none then + WriteSection(lasTSectype,''); + AsmStartSize:=AsmSize; + end; + end; + + ait_marker : + if tai_marker(hp).kind=mark_NoLineInfoStart then + inc(InlineLevel) + else if tai_marker(hp).kind=mark_NoLineInfoEnd then + dec(InlineLevel); + + ait_directive : + begin + case tai_directive(hp).directive of + asd_nasm_import : + AsmWrite('import '); + asd_extern : + AsmWrite('EXTERN '); + else + internalerror(200509191); + end; + if assigned(tai_directive(hp).name) then + begin + + if SmartAsm then + AddSymbol(tai_directive(hp).name^,false); + + AsmWrite(tai_directive(hp).name^); + end; + AsmLn; + end; + ait_seh_directive : + { Ignore for now }; + else + internalerror(10000); + end; + hp:=tai(hp.next); + end; + end; + + + procedure T386NasmAssembler.WriteExternals; + var + sym : TAsmSymbol; + i : longint; + begin + for i:=0 to current_asmdata.AsmSymbolDict.Count-1 do + begin + sym:=TAsmSymbol(current_asmdata.AsmSymbolDict[i]); + if sym.bind=AB_EXTERNAL then + AsmWriteln('EXTERN'#9+sym.name); + end; + end; + + procedure T386NasmAssembler.WriteSmartExternals; + var + EC : PExternChain; + begin + EC:=FEC; + while assigned(EC) do + begin + if not EC^.is_defined then + AsmWriteln('EXTERN'#9+EC^.psym^); + EC:=EC^.next; + end; + end; + + + procedure T386NasmAssembler.WriteAsmList; + var + hal : tasmlisttype; + begin +{$ifdef EXTDEBUG} + if assigned(current_module.mainsource) then + comment(v_info,'Start writing nasm-styled assembler output for '+current_module.mainsource^); +{$endif} + AsmWriteLn('BITS 32'); + AsmLn; + + WriteExternals; + + for hal:=low(TasmlistType) to high(TasmlistType) do + begin + AsmWriteLn(target_asm.comment+'Begin asmlist '+AsmListTypeStr[hal]); + writetree(current_asmdata.asmlists[hal]); + AsmWriteLn(target_asm.comment+'End asmlist '+AsmListTypeStr[hal]); + end; + + AsmLn; + if SmartAsm then + begin + WriteSmartExternals; + FreeExternChainList; + end; +{$ifdef EXTDEBUG} + if assigned(current_module.mainsource) then + comment(v_info,'Done writing nasm-styled assembler output for '+current_module.mainsource^); +{$endif EXTDEBUG} + end; + + +{***************************************************************************** + Initialize +*****************************************************************************} + + const + as_i386_nasmcoff_info : tasminfo = + ( + id : as_i386_nasmcoff; + idtxt : 'NASMCOFF'; + asmbin : 'nasm'; + asmcmd : '-f coff -o $OBJ $ASM'; + supported_targets : [system_i386_go32v2]; + flags : [af_allowdirect,af_needar,af_no_debug]; + labelprefix : '..@'; + comment : '; '; + ); + + as_i386_nasmwin32_info : tasminfo = + ( + id : as_i386_nasmwin32; + idtxt : 'NASMWIN32'; + asmbin : 'nasm'; + asmcmd : '-f win32 -o $OBJ $ASM'; + supported_targets : [system_i386_win32]; + flags : [af_allowdirect,af_needar,af_no_debug]; + labelprefix : '..@'; + comment : '; '; + ); + + as_i386_nasmobj_info : tasminfo = + ( + id : as_i386_nasmobj; + idtxt : 'NASMOBJ'; + asmbin : 'nasm'; + asmcmd : '-f obj -o $OBJ $ASM'; + supported_targets : [system_i386_embedded]; + flags : [af_allowdirect,af_needar,af_no_debug]; + labelprefix : '..@'; + comment : '; '; + ); + + as_i386_nasmwdosx_info : tasminfo = + ( + id : as_i386_nasmwdosx; + idtxt : 'NASMWDOSX'; + asmbin : 'nasm'; + asmcmd : '-f win32 -o $OBJ $ASM'; + supported_targets : [system_i386_wdosx]; + flags : [af_allowdirect,af_needar,af_no_debug]; + labelprefix : '..@'; + comment : '; '; + ); + + + as_i386_nasmelf_info : tasminfo = + ( + id : as_i386_nasmelf; + idtxt : 'NASMELF'; + asmbin : 'nasm'; + asmcmd : '-f elf -o $OBJ $ASM'; + supported_targets : [system_i386_linux]; + flags : [af_allowdirect,af_needar,af_no_debug]; + labelprefix : '..@'; + comment : '; '; + ); + + as_i386_nasmbeos_info : tasminfo = + ( + id : as_i386_nasmbeos; + idtxt : 'NASMELF'; + asmbin : 'nasm'; + asmcmd : '-f elf -o $OBJ $ASM'; + supported_targets : [system_i386_beos]; + flags : [af_allowdirect,af_needar,af_no_debug]; + labelprefix : '..@'; + comment : '; '; + ); + + as_i386_nasmhaiku_info : tasminfo = + ( + id : as_i386_nasmhaiku; + idtxt : 'NASMELF'; + asmbin : 'nasm'; + asmcmd : '-f elf -o $OBJ $ASM'; + supported_targets : [system_i386_haiku]; + flags : [af_allowdirect,af_needar,af_no_debug]; + labelprefix : '..@'; + comment : '; '; + ); + + +initialization + RegisterAssembler(as_i386_nasmcoff_info,T386NasmAssembler); + RegisterAssembler(as_i386_nasmwin32_info,T386NasmAssembler); + RegisterAssembler(as_i386_nasmwdosx_info,T386NasmAssembler); + RegisterAssembler(as_i386_nasmobj_info,T386NasmAssembler); + RegisterAssembler(as_i386_nasmbeos_info,T386NasmAssembler); + RegisterAssembler(as_i386_nasmhaiku_info,T386NasmAssembler); + RegisterAssembler(as_i386_nasmelf_info,T386NasmAssembler); +end. diff --git a/closures/compiler/x86/cga.pas b/closures/compiler/x86/cga.pas new file mode 100644 index 0000000000..5eb62b49e4 --- /dev/null +++ b/closures/compiler/x86/cga.pas @@ -0,0 +1,132 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Helper routines for the i386 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. + + **************************************************************************** +} + +unit cga; + +{$i fpcdefs.inc} + +interface + + uses + globtype, + cpuinfo,cpubase,cgbase,cgutils, + symconst,symtype,symdef,aasmbase,aasmtai,aasmdata,aasmcpu; + + procedure emit_none(i : tasmop;s : topsize); + + procedure emit_reg(i : tasmop;s : topsize;reg : tregister); + procedure emit_ref(i : tasmop;s : topsize;ref : treference); + + procedure emit_const_reg(i : tasmop;s : topsize;c : aint;reg : tregister); + procedure emit_const_ref(i : tasmop;s : topsize;c : aint;ref : treference); + procedure emit_ref_reg(i : tasmop;s : topsize;ref : treference;reg : tregister); + procedure emit_reg_ref(i : tasmop;s : topsize;reg : tregister;ref : treference); + procedure emit_reg_reg(i : tasmop;s : topsize;reg1,reg2 : tregister); + + procedure emit_const_reg_reg(i : tasmop;s : topsize;c : longint;reg1,reg2 : tregister); + procedure emit_reg_reg_reg(i : tasmop;s : topsize;reg1,reg2,reg3 : tregister); + + + procedure emit_sym(i : tasmop;s : topsize;op : tasmsymbol); + + +implementation + + uses + cutils, + systems,verbose, + cgobj,cgx86; + + +{***************************************************************************** + Emit Assembler +*****************************************************************************} + + procedure emit_none(i : tasmop;s : topsize); + begin + current_asmdata.CurrAsmList.concat(Taicpu.Op_none(i,s)); + end; + + procedure emit_reg(i : tasmop;s : topsize;reg : tregister); + begin + current_asmdata.CurrAsmList.concat(Taicpu.Op_reg(i,s,reg)); + end; + + procedure emit_ref(i : tasmop;s : topsize;ref : treference); + begin + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,ref); + current_asmdata.CurrAsmList.concat(Taicpu.Op_ref(i,s,ref)); + end; + + procedure emit_const_reg(i : tasmop;s : topsize;c : aint;reg : tregister); + begin + current_asmdata.CurrAsmList.concat(Taicpu.Op_const_reg(i,s,c,reg)); + end; + + procedure emit_const_ref(i : tasmop;s : topsize;c : aint;ref : treference); + begin + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,ref); + current_asmdata.CurrAsmList.concat(Taicpu.Op_const_ref(i,s,c,ref)); + end; + + procedure emit_ref_reg(i : tasmop;s : topsize;ref : treference;reg : tregister); + begin + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,ref); + current_asmdata.CurrAsmList.concat(Taicpu.Op_ref_reg(i,s,ref,reg)); + end; + + procedure emit_reg_ref(i : tasmop;s : topsize;reg : tregister;ref : treference); + begin + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,ref); + current_asmdata.CurrAsmList.concat(Taicpu.Op_reg_ref(i,s,reg,ref)); + end; + + procedure emit_reg_reg(i : tasmop;s : topsize;reg1,reg2 : tregister); + + var instr:Taicpu; + + begin + if not ((reg1=reg2) and (i=A_MOV)) then + begin + instr:=Taicpu.op_reg_reg(i,s,reg1,reg2); + current_asmdata.CurrAsmList.concat(instr); + if i=A_MOV then + cg.add_move_instruction(instr); + end; + end; + + procedure emit_const_reg_reg(i : tasmop;s : topsize;c : longint;reg1,reg2 : tregister); + begin + current_asmdata.CurrAsmList.concat(Taicpu.Op_const_reg_reg(i,s,c,reg1,reg2)); + end; + + procedure emit_reg_reg_reg(i : tasmop;s : topsize;reg1,reg2,reg3 : tregister); + begin + current_asmdata.CurrAsmList.concat(Taicpu.Op_reg_reg_reg(i,s,reg1,reg2,reg3)); + end; + + procedure emit_sym(i : tasmop;s : topsize;op : tasmsymbol); + begin + current_asmdata.CurrAsmList.concat(Taicpu.Op_sym(i,s,op)); + end; + +end. diff --git a/closures/compiler/x86/cgx86.pas b/closures/compiler/x86/cgx86.pas new file mode 100644 index 0000000000..03a32f3faa --- /dev/null +++ b/closures/compiler/x86/cgx86.pas @@ -0,0 +1,2299 @@ +{ + Copyright (c) 1998-2005 by Florian Klaempfl + + This unit implements the common parts of the code generator for the i386 and the x86-64. + + 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 common parts of the code generator for the i386 and the x86-64. +} +unit cgx86; + +{$i fpcdefs.inc} + + interface + + uses + globtype, + cgbase,cgutils,cgobj, + aasmbase,aasmtai,aasmdata,aasmcpu, + cpubase,cpuinfo,rgobj,rgx86,rgcpu, + symconst,symtype,symdef; + + type + tcgx86 = class(tcg) + rgfpu : Trgx86fpu; + procedure done_register_allocators;override; + + function getfpuregister(list:TAsmList;size:Tcgsize):Tregister;override; + function getmmxregister(list:TAsmList):Tregister; + function getmmregister(list:TAsmList;size:Tcgsize):Tregister;override; + + procedure getcpuregister(list:TAsmList;r:Tregister);override; + procedure ungetcpuregister(list:TAsmList;r:Tregister);override; + procedure alloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset);override; + procedure dealloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset);override; + function uses_registers(rt:Tregistertype):boolean;override; + procedure add_reg_instruction(instr:Tai;r:tregister);override; + procedure dec_fpu_stack; + procedure inc_fpu_stack; + + procedure a_call_name(list : TAsmList;const s : string; weak: boolean);override; + procedure a_call_reg(list : TAsmList;reg : tregister);override; + procedure a_call_ref(list : TAsmList;ref : treference);override; + procedure a_call_name_static(list : TAsmList;const s : string);override; + + procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); override; + procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); override; + procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister); override; + procedure a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); override; + procedure a_op_reg_ref(list : TAsmList; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference); override; + + { move instructions } + procedure a_load_const_reg(list : TAsmList; tosize: tcgsize; a : tcgint;reg : tregister);override; + procedure a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference);override; + procedure a_load_reg_ref(list : TAsmList;fromsize,tosize: tcgsize; reg : tregister;const ref : treference);override; + procedure a_load_ref_reg(list : TAsmList;fromsize,tosize: tcgsize;const ref : treference;reg : tregister);override; + procedure a_load_reg_reg(list : TAsmList;fromsize,tosize: tcgsize;reg1,reg2 : tregister);override; + procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override; + + { bit scan instructions } + procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override; + + { fpu move instructions } + procedure a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); override; + procedure a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); override; + procedure a_loadfpu_reg_ref(list: TAsmList; fromsize, tosize: tcgsize; reg: tregister; const ref: treference); override; + + { vector register move instructions } + procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize : tcgsize;reg1, reg2: tregister;shuffle : pmmshuffle); override; + procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); override; + procedure a_loadmm_reg_ref(list: TAsmList; fromsize, tosize : tcgsize;reg: tregister; const ref: treference;shuffle : pmmshuffle); override; + procedure a_opmm_ref_reg(list: TAsmList; Op: TOpCG; size : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); override; + procedure a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size : tcgsize;src,dst: tregister;shuffle : pmmshuffle);override; + + { comparison operations } + procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; + l : tasmlabel);override; + procedure a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const ref : treference; + l : tasmlabel);override; + procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override; + procedure a_cmp_ref_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;const ref: treference; reg : tregister; l : tasmlabel); override; + procedure a_cmp_reg_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg : tregister; const ref: treference; l : tasmlabel); override; + + procedure a_jmp_name(list : TAsmList;const s : string);override; + procedure a_jmp_always(list : TAsmList;l: tasmlabel); override; + procedure a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); override; + + procedure g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister); override; + procedure g_flags2ref(list: TAsmList; size: TCgSize; const f: tresflags; const ref: TReference); override; + + procedure g_concatcopy(list : TAsmList;const source,dest : treference;len : tcgint);override; + + { entry/exit code helpers } + procedure g_profilecode(list : TAsmList);override; + procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override; + procedure g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean);override; + + procedure g_overflowcheck(list: TAsmList; const l:tlocation;def:tdef);override; + + procedure g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string); override; + + procedure make_simple_ref(list:TAsmList;var ref: treference); + protected + procedure a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel); + procedure check_register_size(size:tcgsize;reg:tregister); + + procedure opmm_loc_reg(list: TAsmList; Op: TOpCG; size : tcgsize;loc : tlocation;dst: tregister; shuffle : pmmshuffle); + + function get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol; + private + procedure sizes2load(s1,s2 : tcgsize;var op: tasmop; var s3: topsize); + + procedure floatload(list: TAsmList; t : tcgsize;const ref : treference); + procedure floatstore(list: TAsmList; t : tcgsize;const ref : treference); + procedure floatloadops(t : tcgsize;var op : tasmop;var s : topsize); + procedure floatstoreops(t : tcgsize;var op : tasmop;var s : topsize); + + end; + + const +{$ifdef x86_64} + TCGSize2OpSize: Array[tcgsize] of topsize = + (S_NO,S_B,S_W,S_L,S_Q,S_T,S_B,S_W,S_L,S_Q,S_Q, + S_FS,S_FL,S_FX,S_IQ,S_FXX, + S_NO,S_NO,S_NO,S_MD,S_T, + S_NO,S_NO,S_NO,S_NO,S_T); +{$else x86_64} + TCGSize2OpSize: Array[tcgsize] of topsize = + (S_NO,S_B,S_W,S_L,S_L,S_T,S_B,S_W,S_L,S_L,S_L, + S_FS,S_FL,S_FX,S_IQ,S_FXX, + S_NO,S_NO,S_NO,S_MD,S_T, + S_NO,S_NO,S_NO,S_NO,S_T); +{$endif x86_64} + +{$ifndef NOTARGETWIN} + winstackpagesize = 4096; +{$endif NOTARGETWIN} + + implementation + + uses + globals,verbose,systems,cutils, + defutil,paramgr,procinfo, + tgobj,ncgutil, + fmodule,symsym; + + const + TOpCG2AsmOp: Array[topcg] of TAsmOp = (A_NONE,A_MOV,A_ADD,A_AND,A_DIV, + A_IDIV,A_IMUL,A_MUL,A_NEG,A_NOT,A_OR, + A_SAR,A_SHL,A_SHR,A_SUB,A_XOR,A_ROL,A_ROR); + + TOpCmp2AsmCond: Array[topcmp] of TAsmCond = (C_NONE, + C_E,C_G,C_L,C_GE,C_LE,C_NE,C_BE,C_B,C_AE,C_A); + + procedure Tcgx86.done_register_allocators; + begin + rg[R_INTREGISTER].free; + rg[R_MMREGISTER].free; + rg[R_MMXREGISTER].free; + rgfpu.free; + inherited done_register_allocators; + end; + + + function Tcgx86.getfpuregister(list:TAsmList;size:Tcgsize):Tregister; + begin + result:=rgfpu.getregisterfpu(list); + end; + + + function Tcgx86.getmmxregister(list:TAsmList):Tregister; + begin + if not assigned(rg[R_MMXREGISTER]) then + internalerror(2003121214); + result:=rg[R_MMXREGISTER].getregister(list,R_SUBNONE); + end; + + + function Tcgx86.getmmregister(list:TAsmList;size:Tcgsize):Tregister; + begin + if not assigned(rg[R_MMREGISTER]) then + internalerror(2003121234); + case size of + OS_F64: + result:=rg[R_MMREGISTER].getregister(list,R_SUBMMD); + OS_F32: + result:=rg[R_MMREGISTER].getregister(list,R_SUBMMS); + OS_M64, + OS_M128: + result:=rg[R_MMREGISTER].getregister(list,R_SUBMMWHOLE); + else + internalerror(200506041); + end; + end; + + + procedure Tcgx86.getcpuregister(list:TAsmList;r:Tregister); + begin + if getregtype(r)=R_FPUREGISTER then + internalerror(2003121210) + else + inherited getcpuregister(list,r); + end; + + + procedure tcgx86.ungetcpuregister(list:TAsmList;r:Tregister); + begin + if getregtype(r)=R_FPUREGISTER then + rgfpu.ungetregisterfpu(list,r) + else + inherited ungetcpuregister(list,r); + end; + + + procedure Tcgx86.alloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset); + begin + if rt<>R_FPUREGISTER then + inherited alloccpuregisters(list,rt,r); + end; + + + procedure Tcgx86.dealloccpuregisters(list:TAsmList;rt:Tregistertype;const r:Tcpuregisterset); + begin + if rt<>R_FPUREGISTER then + inherited dealloccpuregisters(list,rt,r); + end; + + + function Tcgx86.uses_registers(rt:Tregistertype):boolean; + begin + if rt=R_FPUREGISTER then + result:=false + else + result:=inherited uses_registers(rt); + end; + + + procedure tcgx86.add_reg_instruction(instr:Tai;r:tregister); + begin + if getregtype(r)<>R_FPUREGISTER then + inherited add_reg_instruction(instr,r); + end; + + + procedure tcgx86.dec_fpu_stack; + begin + if rgfpu.fpuvaroffset<=0 then + internalerror(200604201); + dec(rgfpu.fpuvaroffset); + end; + + + procedure tcgx86.inc_fpu_stack; + begin + inc(rgfpu.fpuvaroffset); + end; + + +{**************************************************************************** + This is private property, keep out! :) +****************************************************************************} + + procedure tcgx86.sizes2load(s1,s2 : tcgsize; var op: tasmop; var s3: topsize); + + begin + { ensure to have always valid sizes } + if s1=OS_NO then + s1:=s2; + if s2=OS_NO then + s2:=s1; + case s2 of + OS_8,OS_S8 : + if S1 in [OS_8,OS_S8] then + s3 := S_B + else + internalerror(200109221); + OS_16,OS_S16: + case s1 of + OS_8,OS_S8: + s3 := S_BW; + OS_16,OS_S16: + s3 := S_W; + else + internalerror(200109222); + end; + OS_32,OS_S32: + case s1 of + OS_8,OS_S8: + s3 := S_BL; + OS_16,OS_S16: + s3 := S_WL; + OS_32,OS_S32: + s3 := S_L; + else + internalerror(200109223); + end; +{$ifdef x86_64} + OS_64,OS_S64: + case s1 of + OS_8: + s3 := S_BL; + OS_S8: + s3 := S_BQ; + OS_16: + s3 := S_WL; + OS_S16: + s3 := S_WQ; + OS_32: + s3 := S_L; + OS_S32: + s3 := S_LQ; + OS_64,OS_S64: + s3 := S_Q; + else + internalerror(200304302); + end; +{$endif x86_64} + else + internalerror(200109227); + end; + if s3 in [S_B,S_W,S_L,S_Q] then + op := A_MOV + else if s1 in [OS_8,OS_16,OS_32,OS_64] then + op := A_MOVZX + else +{$ifdef x86_64} + if s3 in [S_LQ] then + op := A_MOVSXD + else +{$endif x86_64} + op := A_MOVSX; + end; + + + procedure tcgx86.make_simple_ref(list:TAsmList;var ref: treference); + var + hreg : tregister; + href : treference; +{$ifndef x86_64} + add_hreg: boolean; +{$endif not x86_64} + begin + { make_simple_ref() may have already been called earlier, and in that + case make sure we don't perform the PIC-simplifications twice } + if (ref.refaddr in [addr_pic,addr_pic_no_got]) then + exit; + +{$ifdef x86_64} + { Only 32bit is allowed } + if ((ref.offset<low(longint)) or (ref.offset>high(longint))) then + begin + { Load constant value to register } + hreg:=GetAddressRegister(list); + list.concat(taicpu.op_const_reg(A_MOV,S_Q,ref.offset,hreg)); + ref.offset:=0; + {if assigned(ref.symbol) then + begin + list.concat(taicpu.op_sym_ofs_reg(A_ADD,S_Q,ref.symbol,0,hreg)); + ref.symbol:=nil; + end;} + { Add register to reference } + if ref.index=NR_NO then + ref.index:=hreg + else + begin + { don't use add, as the flags may contain a value } + reference_reset_base(href,ref.base,0,8); + href.index:=hreg; + if ref.scalefactor<>0 then + begin + reference_reset_base(href,ref.base,0,8); + href.index:=hreg; + list.concat(taicpu.op_ref_reg(A_LEA,S_Q,href,hreg)); + ref.base:=hreg; + end + else + begin + reference_reset_base(href,ref.index,0,8); + href.index:=hreg; + list.concat(taicpu.op_reg_reg(A_ADD,S_Q,ref.index,hreg)); + ref.index:=hreg; + end; + end; + end; + + if assigned(ref.symbol) and not((ref.symbol.bind=AB_LOCAL) and (ref.symbol.typ in [AT_LABEL,AT_FUNCTION])) then + begin + if cs_create_pic in current_settings.moduleswitches then + begin + { Local data symbols must not be accessed via the GOT on + darwin/x86_64 under certain circumstances (and do not + have to be in other cases); however, linux/x86_64 does + require it; don't know about others, so do use GOT for + safety reasons + } + if (ref.symbol.bind=AB_LOCAL) and + (ref.symbol.typ=AT_DATA) then + begin + { unfortunately, RIP-based addresses don't support an index } + if (ref.base<>NR_NO) or + (ref.index<>NR_NO) then + begin + reference_reset_symbol(href,ref.symbol,0,ref.alignment); + hreg:=getaddressregister(list); + href.refaddr:=addr_pic_no_got; + href.base:=NR_RIP; + list.concat(taicpu.op_ref_reg(A_LEA,S_Q,href,hreg)); + ref.symbol:=nil; + end + else + begin + ref.refaddr:=addr_pic_no_got; + hreg:=NR_NO; + ref.base:=NR_RIP; + end; + end + else + begin + reference_reset_symbol(href,ref.symbol,0,ref.alignment); + hreg:=getaddressregister(list); + href.refaddr:=addr_pic; + href.base:=NR_RIP; + list.concat(taicpu.op_ref_reg(A_MOV,S_Q,href,hreg)); + + ref.symbol:=nil; + end; + + if ref.base=NR_NO then + ref.base:=hreg + else if ref.index=NR_NO then + begin + ref.index:=hreg; + ref.scalefactor:=1; + end + else + begin + { don't use add, as the flags may contain a value } + reference_reset_base(href,ref.base,0,8); + href.index:=hreg; + list.concat(taicpu.op_ref_reg(A_LEA,S_Q,href,hreg)); + ref.base:=hreg; + end; + end + else + { Always use RIP relative symbol addressing for Windows and Darwin targets. } + if (target_info.system in (systems_all_windows+[system_x86_64_darwin])) and (ref.base<>NR_RIP) then + begin + if (ref.refaddr=addr_no) and (ref.base=NR_NO) and (ref.index=NR_NO) then + begin + { Set RIP relative addressing for simple symbol references } + ref.base:=NR_RIP; + ref.refaddr:=addr_pic_no_got + end + else + begin + { Use temp register to load calculated 64-bit symbol address for complex references } + reference_reset_symbol(href,ref.symbol,0,sizeof(pint)); + href.base:=NR_RIP; + href.refaddr:=addr_pic_no_got; + hreg:=GetAddressRegister(list); + list.concat(taicpu.op_ref_reg(A_LEA,S_Q,href,hreg)); + ref.symbol:=nil; + if ref.base=NR_NO then + ref.base:=hreg + else if ref.index=NR_NO then + begin + ref.index:=hreg; + ref.scalefactor:=0; + end + else + begin + { don't use add, as the flags may contain a value } + reference_reset_base(href,ref.base,0,8); + href.index:=hreg; + list.concat(taicpu.op_ref_reg(A_LEA,S_Q,href,hreg)); + ref.base:=hreg; + end; + end; + + end; + end; +{$else x86_64} + add_hreg:=false; + if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) then + begin + if assigned(ref.symbol) and + not(assigned(ref.relsymbol)) and + ((ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or + (cs_create_pic in current_settings.moduleswitches)) then + begin + if (ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or + ((cs_create_pic in current_settings.moduleswitches) and + (ref.symbol.bind in [AB_COMMON,AB_GLOBAL,AB_PRIVATE_EXTERN])) then + begin + hreg:=g_indirect_sym_load(list,ref.symbol.name,ref.symbol.bind=AB_WEAK_EXTERNAL); + ref.symbol:=nil; + end + else + begin + include(current_procinfo.flags,pi_needs_got); + hreg:=current_procinfo.got; + ref.relsymbol:=current_procinfo.CurrGOTLabel; + end; + add_hreg:=true + end + end + else if (cs_create_pic in current_settings.moduleswitches) and + assigned(ref.symbol) and + not((ref.symbol.bind=AB_LOCAL) and + (ref.symbol.typ in [AT_LABEL,AT_FUNCTION])) then + begin + reference_reset_symbol(href,ref.symbol,0,sizeof(pint)); + href.base:=current_procinfo.got; + href.refaddr:=addr_pic; + include(current_procinfo.flags,pi_needs_got); + hreg:=cg.getaddressregister(list); + list.concat(taicpu.op_ref_reg(A_MOV,S_L,href,hreg)); + ref.symbol:=nil; + add_hreg:=true; + end; + + if add_hreg then + begin + if ref.base=NR_NO then + ref.base:=hreg + else if ref.index=NR_NO then + begin + ref.index:=hreg; + ref.scalefactor:=1; + end + else + begin + { don't use add, as the flags may contain a value } + reference_reset_base(href,ref.base,0,8); + href.index:=hreg; + list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg)); + ref.base:=hreg; + end; + end; +{$endif x86_64} + end; + + + procedure tcgx86.floatloadops(t : tcgsize;var op : tasmop;var s : topsize); + begin + case t of + OS_F32 : + begin + op:=A_FLD; + s:=S_FS; + end; + OS_F64 : + begin + op:=A_FLD; + s:=S_FL; + end; + OS_F80 : + begin + op:=A_FLD; + s:=S_FX; + end; + OS_C64 : + begin + op:=A_FILD; + s:=S_IQ; + end; + else + internalerror(200204043); + end; + end; + + + procedure tcgx86.floatload(list: TAsmList; t : tcgsize;const ref : treference); + + var + op : tasmop; + s : topsize; + tmpref : treference; + begin + tmpref:=ref; + make_simple_ref(list,tmpref); + floatloadops(t,op,s); + list.concat(Taicpu.Op_ref(op,s,tmpref)); + inc_fpu_stack; + end; + + + procedure tcgx86.floatstoreops(t : tcgsize;var op : tasmop;var s : topsize); + + begin + case t of + OS_F32 : + begin + op:=A_FSTP; + s:=S_FS; + end; + OS_F64 : + begin + op:=A_FSTP; + s:=S_FL; + end; + OS_F80 : + begin + op:=A_FSTP; + s:=S_FX; + end; + OS_C64 : + begin + op:=A_FISTP; + s:=S_IQ; + end; + else + internalerror(200204042); + end; + end; + + + procedure tcgx86.floatstore(list: TAsmList; t : tcgsize;const ref : treference); + + var + op : tasmop; + s : topsize; + tmpref : treference; + begin + tmpref:=ref; + make_simple_ref(list,tmpref); + floatstoreops(t,op,s); + list.concat(Taicpu.Op_ref(op,s,tmpref)); + { storing non extended floats can cause a floating point overflow } + if (t<>OS_F80) and + (cs_fpu_fwait in current_settings.localswitches) then + list.concat(Taicpu.Op_none(A_FWAIT,S_NO)); + dec_fpu_stack; + end; + + + procedure tcgx86.check_register_size(size:tcgsize;reg:tregister); + begin + if TCGSize2OpSize[size]<>TCGSize2OpSize[reg_cgsize(reg)] then + internalerror(200306031); + end; + + +{**************************************************************************** + Assembler code +****************************************************************************} + + procedure tcgx86.a_jmp_name(list : TAsmList;const s : string); + var + r: treference; + begin + if (target_info.system <> system_i386_darwin) then + list.concat(taicpu.op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(s))) + else + begin + reference_reset_symbol(r,get_darwin_call_stub(s,false),0,sizeof(pint)); + r.refaddr:=addr_full; + list.concat(taicpu.op_ref(A_JMP,S_NO,r)); + end; + end; + + + procedure tcgx86.a_jmp_always(list : TAsmList;l: tasmlabel); + begin + a_jmp_cond(list, OC_NONE, l); + end; + + + function tcgx86.get_darwin_call_stub(const s: string; weak: boolean): tasmsymbol; + var + stubname: string; + begin + stubname := 'L'+s+'$stub'; + result := current_asmdata.getasmsymbol(stubname); + if assigned(result) then + exit; + + if current_asmdata.asmlists[al_imports]=nil then + current_asmdata.asmlists[al_imports]:=TAsmList.create; + + new_section(current_asmdata.asmlists[al_imports],sec_stub,'',0); + result := current_asmdata.RefAsmSymbol(stubname); + current_asmdata.asmlists[al_imports].concat(Tai_symbol.Create(result,0)); + { register as a weak symbol if necessary } + if weak then + current_asmdata.weakrefasmsymbol(s); + current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_indirect_symbol,s)); + current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_HLT)); + current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_HLT)); + current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_HLT)); + current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_HLT)); + current_asmdata.asmlists[al_imports].concat(taicpu.op_none(A_HLT)); + end; + + + procedure tcgx86.a_call_name(list : TAsmList;const s : string; weak: boolean); + var + sym : tasmsymbol; + r : treference; + begin + + if (target_info.system <> system_i386_darwin) then + begin + if not(weak) then + sym:=current_asmdata.RefAsmSymbol(s) + else + sym:=current_asmdata.WeakRefAsmSymbol(s); + reference_reset_symbol(r,sym,0,sizeof(pint)); + if (cs_create_pic in current_settings.moduleswitches) and + { darwin's assembler doesn't want @PLT after call symbols } + not(target_info.system in [system_x86_64_darwin,system_i386_iphonesim]) then + begin +{$ifdef i386} + include(current_procinfo.flags,pi_needs_got); +{$endif i386} + r.refaddr:=addr_pic + end + else + r.refaddr:=addr_full; + end + else + begin + reference_reset_symbol(r,get_darwin_call_stub(s,weak),0,sizeof(pint)); + r.refaddr:=addr_full; + end; + list.concat(taicpu.op_ref(A_CALL,S_NO,r)); + end; + + + procedure tcgx86.a_call_name_static(list : TAsmList;const s : string); + var + sym : tasmsymbol; + r : treference; + begin + sym:=current_asmdata.RefAsmSymbol(s); + reference_reset_symbol(r,sym,0,sizeof(pint)); + r.refaddr:=addr_full; + list.concat(taicpu.op_ref(A_CALL,S_NO,r)); + end; + + + procedure tcgx86.a_call_reg(list : TAsmList;reg : tregister); + begin + list.concat(taicpu.op_reg(A_CALL,S_NO,reg)); + end; + + + procedure tcgx86.a_call_ref(list : TAsmList;ref : treference); + begin + list.concat(taicpu.op_ref(A_CALL,S_NO,ref)); + end; + + +{********************** load instructions ********************} + + procedure tcgx86.a_load_const_reg(list : TAsmList; tosize: TCGSize; a : tcgint; reg : TRegister); + + begin + check_register_size(tosize,reg); + { the optimizer will change it to "xor reg,reg" when loading zero, } + { no need to do it here too (JM) } + list.concat(taicpu.op_const_reg(A_MOV,TCGSize2OpSize[tosize],a,reg)) + end; + + + procedure tcgx86.a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference); + var + tmpref : treference; + begin + tmpref:=ref; + make_simple_ref(list,tmpref); +{$ifdef x86_64} + { x86_64 only supports signed 32 bits constants directly } + if (tosize in [OS_S64,OS_64]) and + ((a<low(longint)) or (a>high(longint))) then + begin + a_load_const_ref(list,OS_32,longint(a and $ffffffff),tmpref); + inc(tmpref.offset,4); + a_load_const_ref(list,OS_32,longint(a shr 32),tmpref); + end + else +{$endif x86_64} + list.concat(taicpu.op_const_ref(A_MOV,TCGSize2OpSize[tosize],a,tmpref)); + end; + + + procedure tcgx86.a_load_reg_ref(list : TAsmList; fromsize,tosize: TCGSize; reg : tregister;const ref : treference); + var + op: tasmop; + s: topsize; + tmpsize : tcgsize; + tmpreg : tregister; + tmpref : treference; + begin + tmpref:=ref; + make_simple_ref(list,tmpref); + check_register_size(fromsize,reg); + sizes2load(fromsize,tosize,op,s); + case s of +{$ifdef x86_64} + S_BQ,S_WQ,S_LQ, +{$endif x86_64} + S_BW,S_BL,S_WL : + begin + tmpreg:=getintregister(list,tosize); +{$ifdef x86_64} + { zero extensions to 64 bit on the x86_64 are simply done by writting to the lower 32 bit + which clears the upper 64 bit too, so it could be that s is S_L while the reg is + 64 bit (FK) } + if s in [S_BL,S_WL,S_L] then + begin + tmpreg:=makeregsize(list,tmpreg,OS_32); + tmpsize:=OS_32; + end + else +{$endif x86_64} + tmpsize:=tosize; + list.concat(taicpu.op_reg_reg(op,s,reg,tmpreg)); + a_load_reg_ref(list,tmpsize,tosize,tmpreg,tmpref); + end; + else + list.concat(taicpu.op_reg_ref(op,s,reg,tmpref)); + end; + end; + + + procedure tcgx86.a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref: treference;reg : tregister); + var + op: tasmop; + s: topsize; + tmpref : treference; + begin + tmpref:=ref; + make_simple_ref(list,tmpref); + check_register_size(tosize,reg); + sizes2load(fromsize,tosize,op,s); + {$ifdef x86_64} + { zero extensions to 64 bit on the x86_64 are simply done by writting to the lower 32 bit + which clears the upper 64 bit too, so it could be that s is S_L while the reg is + 64 bit (FK) } + if s in [S_BL,S_WL,S_L] then + reg:=makeregsize(list,reg,OS_32); +{$endif x86_64} + list.concat(taicpu.op_ref_reg(op,s,tmpref,reg)); + end; + + + procedure tcgx86.a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister); + var + op: tasmop; + s: topsize; + instr:Taicpu; + begin + check_register_size(fromsize,reg1); + check_register_size(tosize,reg2); + if tcgsize2size[fromsize]>tcgsize2size[tosize] then + begin + reg1:=makeregsize(list,reg1,tosize); + s:=tcgsize2opsize[tosize]; + op:=A_MOV; + end + else + sizes2load(fromsize,tosize,op,s); +{$ifdef x86_64} + { zero extensions to 64 bit on the x86_64 are simply done by writting to the lower 32 bit + which clears the upper 64 bit too, so it could be that s is S_L while the reg is + 64 bit (FK) + } + if s in [S_BL,S_WL,S_L] then + reg2:=makeregsize(list,reg2,OS_32); +{$endif x86_64} + if (reg1<>reg2) then + begin + instr:=taicpu.op_reg_reg(op,s,reg1,reg2); + { Notify the register allocator that we have written a move instruction so + it can try to eliminate it. } + if (reg1<>current_procinfo.framepointer) and (reg1<>NR_STACK_POINTER_REG) then + add_move_instruction(instr); + list.concat(instr); + end; +{$ifdef x86_64} + { avoid merging of registers and killing the zero extensions (FK) } + if (tosize in [OS_64,OS_S64]) and (s=S_L) then + list.concat(taicpu.op_const_reg(A_AND,S_L,$ffffffff,reg2)); +{$endif x86_64} + end; + + + procedure tcgx86.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister); + var + tmpref : treference; + begin + with ref do + begin + if (base=NR_NO) and (index=NR_NO) then + begin + if assigned(ref.symbol) then + begin + if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) and + ((ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or + (cs_create_pic in current_settings.moduleswitches)) then + begin + if (ref.symbol.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL]) or + ((cs_create_pic in current_settings.moduleswitches) and + (ref.symbol.bind in [AB_COMMON,AB_GLOBAL,AB_PRIVATE_EXTERN])) then + begin + reference_reset_base(tmpref, + g_indirect_sym_load(list,ref.symbol.name,ref.symbol.bind=AB_WEAK_EXTERNAL), + offset,sizeof(pint)); + a_loadaddr_ref_reg(list,tmpref,r); + end + else + begin + include(current_procinfo.flags,pi_needs_got); + reference_reset_base(tmpref,current_procinfo.got,offset,ref.alignment); + tmpref.symbol:=symbol; + tmpref.relsymbol:=current_procinfo.CurrGOTLabel; + list.concat(Taicpu.op_ref_reg(A_LEA,tcgsize2opsize[OS_ADDR],tmpref,r)); + end; + end + else if (cs_create_pic in current_settings.moduleswitches) +{$ifdef x86_64} + and not((ref.symbol.bind=AB_LOCAL) and + (ref.symbol.typ in [AT_DATA,AT_LABEL,AT_ADDR])) +{$endif x86_64} + then + begin +{$ifdef x86_64} + reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment); + tmpref.refaddr:=addr_pic; + tmpref.base:=NR_RIP; + list.concat(taicpu.op_ref_reg(A_MOV,S_Q,tmpref,r)); +{$else x86_64} + reference_reset_symbol(tmpref,ref.symbol,0,ref.alignment); + tmpref.refaddr:=addr_pic; + tmpref.base:=current_procinfo.got; + include(current_procinfo.flags,pi_needs_got); + list.concat(taicpu.op_ref_reg(A_MOV,S_L,tmpref,r)); +{$endif x86_64} + if offset<>0 then + a_op_const_reg(list,OP_ADD,OS_ADDR,offset,r); + end +{$ifdef x86_64} + else if (target_info.system in (systems_all_windows+[system_x86_64_darwin])) + or (cs_create_pic in current_settings.moduleswitches) + then + begin + { Win64 and Darwin/x86_64 always require RIP-relative addressing } + tmpref:=ref; + tmpref.base:=NR_RIP; + tmpref.refaddr:=addr_pic_no_got; + list.concat(Taicpu.op_ref_reg(A_LEA,S_Q,tmpref,r)); + end +{$endif x86_64} + else + begin + tmpref:=ref; + tmpref.refaddr:=ADDR_FULL; + list.concat(Taicpu.op_ref_reg(A_MOV,tcgsize2opsize[OS_ADDR],tmpref,r)); + end + end + else + a_load_const_reg(list,OS_ADDR,offset,r) + end + else if (base=NR_NO) and (index<>NR_NO) and + (offset=0) and (scalefactor=0) and (symbol=nil) then + a_load_reg_reg(list,OS_ADDR,OS_ADDR,index,r) + else if (base<>NR_NO) and (index=NR_NO) and + (offset=0) and (symbol=nil) then + a_load_reg_reg(list,OS_ADDR,OS_ADDR,base,r) + else + begin + tmpref:=ref; + make_simple_ref(list,tmpref); + list.concat(Taicpu.op_ref_reg(A_LEA,tcgsize2opsize[OS_ADDR],tmpref,r)); + end; + if segment<>NR_NO then + begin + if (tf_section_threadvars in target_info.flags) then + begin + { Convert thread local address to a process global addres + as we cannot handle far pointers.} + case target_info.system of + system_i386_linux: + if segment=NR_GS then + begin + reference_reset_symbol(tmpref,current_asmdata.RefAsmSymbol('___fpc_threadvar_offset'),0,ref.alignment); + tmpref.segment:=NR_GS; + list.concat(Taicpu.op_ref_reg(A_ADD,tcgsize2opsize[OS_ADDR],tmpref,r)); + end + else + cgmessage(cg_e_cant_use_far_pointer_there); + system_i386_win32: + if segment=NR_FS then + begin + allocallcpuregisters(list); + a_call_name(list,'GetTls',false); + deallocallcpuregisters(list); + list.concat(Taicpu.op_reg_reg(A_ADD,tcgsize2opsize[OS_ADDR],NR_EAX,r)); + end + else + cgmessage(cg_e_cant_use_far_pointer_there); + + else + cgmessage(cg_e_cant_use_far_pointer_there); + end; + end + else + cgmessage(cg_e_cant_use_far_pointer_there); + end; + end; + end; + + + { all fpu load routines expect that R_ST[0-7] means an fpu regvar and } + { R_ST means "the current value at the top of the fpu stack" (JM) } + procedure tcgx86.a_loadfpu_reg_reg(list: TAsmList; fromsize, tosize: tcgsize; reg1, reg2: tregister); + + var + href: treference; + op: tasmop; + s: topsize; + begin + if (reg1<>NR_ST) then + begin + floatloadops(tosize,op,s); + list.concat(taicpu.op_reg(op,s,rgfpu.correct_fpuregister(reg1,rgfpu.fpuvaroffset))); + inc_fpu_stack; + end; + if (reg2<>NR_ST) then + begin + floatstoreops(tosize,op,s); + list.concat(taicpu.op_reg(op,s,rgfpu.correct_fpuregister(reg2,rgfpu.fpuvaroffset))); + dec_fpu_stack; + end; + { OS_F80 < OS_C64, but OS_C64 fits perfectly in OS_F80 } + if (reg1=NR_ST) and + (reg2=NR_ST) and + (tosize<>OS_F80) and + (tosize<fromsize) then + begin + { can't round down to lower precision in x87 :/ } + tg.gettemp(list,tcgsize2size[tosize],tcgsize2size[tosize],tt_normal,href); + a_loadfpu_reg_ref(list,fromsize,tosize,NR_ST,href); + a_loadfpu_ref_reg(list,tosize,tosize,href,NR_ST); + tg.ungettemp(list,href); + end; + end; + + + procedure tcgx86.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister); + begin + floatload(list,fromsize,ref); + a_loadfpu_reg_reg(list,fromsize,tosize,NR_ST,reg); + end; + + + procedure tcgx86.a_loadfpu_reg_ref(list: TAsmList; fromsize,tosize: tcgsize; reg: tregister; const ref: treference); + begin + { in case a record returned in a floating point register + (LOC_FPUREGISTER with OS_F32/OS_F64) is stored in memory + (LOC_REFERENCE with OS_32/OS_64), we have to adjust the + tosize } + if (fromsize in [OS_F32,OS_F64]) and + (tcgsize2size[fromsize]=tcgsize2size[tosize]) then + case tosize of + OS_32: + tosize:=OS_F32; + OS_64: + tosize:=OS_F64; + end; + if reg<>NR_ST then + a_loadfpu_reg_reg(list,fromsize,tosize,reg,NR_ST); + floatstore(list,tosize,ref); + end; + + + function get_scalar_mm_op(fromsize,tosize : tcgsize) : tasmop; + const + convertop : array[OS_F32..OS_F128,OS_F32..OS_F128] of tasmop = ( + (A_MOVSS,A_CVTSS2SD,A_NONE,A_NONE,A_NONE), + (A_CVTSD2SS,A_MOVSD,A_NONE,A_NONE,A_NONE), + (A_NONE,A_NONE,A_NONE,A_NONE,A_NONE), + (A_NONE,A_NONE,A_NONE,A_MOVQ,A_NONE), + (A_NONE,A_NONE,A_NONE,A_NONE,A_NONE)); + begin + { we can have OS_F32/OS_F64 (record in function result/LOC_MMREGISTER) to + OS_32/OS_64 (record in memory/LOC_REFERENCE) } + if (fromsize in [OS_F32,OS_F64]) and + (tcgsize2size[fromsize]=tcgsize2size[tosize]) then + case tosize of + OS_32: + tosize:=OS_F32; + OS_64: + tosize:=OS_F64; + end; + if (fromsize in [low(convertop)..high(convertop)]) and + (tosize in [low(convertop)..high(convertop)]) then + result:=convertop[fromsize,tosize] + { we can have OS_M64 (record in function result/LOC_MMREGISTER) to + OS_64 (record in memory/LOC_REFERENCE) } + else if (tcgsize2size[fromsize]=tcgsize2size[tosize]) and + (fromsize=OS_M64) then + result:=A_MOVQ + else + internalerror(2010060104); + if result=A_NONE then + internalerror(200312205); + end; + + + procedure tcgx86.a_loadmm_reg_reg(list: TAsmList; fromsize, tosize : tcgsize;reg1, reg2: tregister;shuffle : pmmshuffle); + var + instr : taicpu; + begin + if shuffle=nil then + begin + if fromsize=tosize then + { needs correct size in case of spilling } + case fromsize of + OS_F32: + instr:=taicpu.op_reg_reg(A_MOVAPS,S_NO,reg1,reg2); + OS_F64: + instr:=taicpu.op_reg_reg(A_MOVAPD,S_NO,reg1,reg2); + OS_M64: + instr:=taicpu.op_reg_reg(A_MOVQ,S_NO,reg1,reg2); + else + internalerror(2006091201); + end + else + internalerror(200312202); + add_move_instruction(instr); + end + else if shufflescalar(shuffle) then + begin + instr:=taicpu.op_reg_reg(get_scalar_mm_op(fromsize,tosize),S_NO,reg1,reg2); + case get_scalar_mm_op(fromsize,tosize) of + A_MOVSS, + A_MOVSD, + A_MOVQ: + add_move_instruction(instr); + end; + end + else + internalerror(200312201); + list.concat(instr); + end; + + + procedure tcgx86.a_loadmm_ref_reg(list: TAsmList; fromsize, tosize : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); + var + tmpref : treference; + begin + tmpref:=ref; + make_simple_ref(list,tmpref); + if shuffle=nil then + begin + if fromsize=OS_M64 then + list.concat(taicpu.op_ref_reg(A_MOVQ,S_NO,tmpref,reg)) + else +{$ifdef x86_64} + { x86-64 has always properly aligned data } + list.concat(taicpu.op_ref_reg(A_MOVDQA,S_NO,tmpref,reg)); +{$else x86_64} + list.concat(taicpu.op_ref_reg(A_MOVDQU,S_NO,tmpref,reg)); +{$endif x86_64} + end + else if shufflescalar(shuffle) then + list.concat(taicpu.op_ref_reg(get_scalar_mm_op(fromsize,tosize),S_NO,tmpref,reg)) + else + internalerror(200312252); + end; + + + procedure tcgx86.a_loadmm_reg_ref(list: TAsmList; fromsize, tosize : tcgsize;reg: tregister; const ref: treference;shuffle : pmmshuffle); + var + hreg : tregister; + tmpref : treference; + begin + tmpref:=ref; + make_simple_ref(list,tmpref); + if shuffle=nil then + begin + if fromsize=OS_M64 then + list.concat(taicpu.op_reg_ref(A_MOVQ,S_NO,reg,tmpref)) + else +{$ifdef x86_64} + { x86-64 has always properly aligned data } + list.concat(taicpu.op_reg_ref(A_MOVDQA,S_NO,reg,tmpref)) +{$else x86_64} + list.concat(taicpu.op_reg_ref(A_MOVDQU,S_NO,reg,tmpref)) +{$endif x86_64} + end + else if shufflescalar(shuffle) then + begin + if tcgsize2size[tosize]<>tcgsize2size[fromsize] then + begin + hreg:=getmmregister(list,tosize); + list.concat(taicpu.op_reg_reg(get_scalar_mm_op(fromsize,tosize),S_NO,reg,hreg)); + list.concat(taicpu.op_reg_ref(get_scalar_mm_op(tosize,tosize),S_NO,hreg,tmpref)); + end + else + list.concat(taicpu.op_reg_ref(get_scalar_mm_op(fromsize,tosize),S_NO,reg,tmpref)); + end + else + internalerror(200312252); + end; + + + procedure tcgx86.a_opmm_ref_reg(list: TAsmList; Op: TOpCG; size : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); + var + l : tlocation; + begin + l.loc:=LOC_REFERENCE; + l.reference:=ref; + l.size:=size; + opmm_loc_reg(list,op,size,l,reg,shuffle); + end; + + + procedure tcgx86.a_opmm_reg_reg(list: TAsmList; Op: TOpCG; size : tcgsize;src,dst: tregister;shuffle : pmmshuffle); + var + l : tlocation; + begin + l.loc:=LOC_MMREGISTER; + l.register:=src; + l.size:=size; + opmm_loc_reg(list,op,size,l,dst,shuffle); + end; + + + procedure tcgx86.opmm_loc_reg(list: TAsmList; Op: TOpCG; size : tcgsize;loc : tlocation;dst: tregister; shuffle : pmmshuffle); + const + opmm2asmop : array[0..1,OS_F32..OS_F64,topcg] of tasmop = ( + ( { scalar } + ( { OS_F32 } + A_NOP,A_NOP,A_ADDSS,A_NOP,A_DIVSS,A_NOP,A_NOP,A_MULSS,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_SUBSS,A_NOP,A_NOP,A_NOP + ), + ( { OS_F64 } + A_NOP,A_NOP,A_ADDSD,A_NOP,A_DIVSD,A_NOP,A_NOP,A_MULSD,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_SUBSD,A_NOP,A_NOP,A_NOP + ) + ), + ( { vectorized/packed } + { because the logical packed single instructions have shorter op codes, we use always + these + } + ( { OS_F32 } + A_NOP,A_NOP,A_ADDPS,A_NOP,A_DIVPS,A_NOP,A_NOP,A_MULPS,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_SUBPS,A_XORPS,A_NOP,A_NOP + ), + ( { OS_F64 } + A_NOP,A_NOP,A_ADDPD,A_NOP,A_DIVPD,A_NOP,A_NOP,A_MULPD,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_NOP,A_SUBPD,A_XORPD,A_NOP,A_NOP + ) + ) + ); + + var + resultreg : tregister; + asmop : tasmop; + begin + { this is an internally used procedure so the parameters have + some constrains + } + if loc.size<>size then + internalerror(200312213); + resultreg:=dst; + { deshuffle } + //!!! + if (shuffle<>nil) and not(shufflescalar(shuffle)) then + begin + internalerror(2010060101); + end + else if (shuffle=nil) then + asmop:=opmm2asmop[1,size,op] + else if shufflescalar(shuffle) then + begin + asmop:=opmm2asmop[0,size,op]; + { no scalar operation available? } + if asmop=A_NOP then + begin + { do vectorized and shuffle finally } + internalerror(2010060102); + end; + end + else + internalerror(200312211); + if asmop=A_NOP then + internalerror(200312216); + case loc.loc of + LOC_CREFERENCE,LOC_REFERENCE: + begin + make_simple_ref(current_asmdata.CurrAsmList,loc.reference); + list.concat(taicpu.op_ref_reg(asmop,S_NO,loc.reference,resultreg)); + end; + LOC_CMMREGISTER,LOC_MMREGISTER: + list.concat(taicpu.op_reg_reg(asmop,S_NO,loc.register,resultreg)); + else + internalerror(200312214); + end; + { shuffle } + if resultreg<>dst then + begin + internalerror(200312212); + end; + end; + + + procedure tcgx86.a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg: TRegister); + + var + opcode : tasmop; + power : longint; +{$ifdef x86_64} + tmpreg : tregister; +{$endif x86_64} + begin + optimize_op_const(op, a); +{$ifdef x86_64} + { x86_64 only supports signed 32 bits constants directly } + if not(op in [OP_NONE,OP_MOVE]) and + (size in [OS_S64,OS_64]) and + ((a<low(longint)) or (a>high(longint))) then + begin + tmpreg:=getintregister(list,size); + a_load_const_reg(list,size,a,tmpreg); + a_op_reg_reg(list,op,size,tmpreg,reg); + exit; + end; +{$endif x86_64} + check_register_size(size,reg); + case op of + OP_NONE : + begin + { Opcode is optimized away } + end; + OP_MOVE : + begin + { Optimized, replaced with a simple load } + a_load_const_reg(list,size,a,reg); + end; + OP_DIV, OP_IDIV: + begin + if ispowerof2(int64(a),power) then + begin + case op of + OP_DIV: + opcode := A_SHR; + OP_IDIV: + opcode := A_SAR; + end; + list.concat(taicpu.op_const_reg(opcode,TCgSize2OpSize[size],power,reg)); + exit; + end; + { the rest should be handled specifically in the code } + { generator because of the silly register usage restraints } + internalerror(200109224); + end; + OP_MUL,OP_IMUL: + begin + if not(cs_check_overflow in current_settings.localswitches) and + ispowerof2(int64(a),power) then + begin + list.concat(taicpu.op_const_reg(A_SHL,TCgSize2OpSize[size],power,reg)); + exit; + end; + if op = OP_IMUL then + list.concat(taicpu.op_const_reg(A_IMUL,TCgSize2OpSize[size],a,reg)) + else + { OP_MUL should be handled specifically in the code } + { generator because of the silly register usage restraints } + internalerror(200109225); + end; + OP_ADD, OP_AND, OP_OR, OP_SUB, OP_XOR: + if not(cs_check_overflow in current_settings.localswitches) and + (a = 1) and + (op in [OP_ADD,OP_SUB]) then + if op = OP_ADD then + list.concat(taicpu.op_reg(A_INC,TCgSize2OpSize[size],reg)) + else + list.concat(taicpu.op_reg(A_DEC,TCgSize2OpSize[size],reg)) + else if (a = 0) then + if (op <> OP_AND) then + exit + else + list.concat(taicpu.op_const_reg(A_MOV,TCgSize2OpSize[size],0,reg)) + else if (aword(a) = high(aword)) and + (op in [OP_AND,OP_OR,OP_XOR]) then + begin + case op of + OP_AND: + exit; + OP_OR: + list.concat(taicpu.op_const_reg(A_MOV,TCgSize2OpSize[size],aint(high(aword)),reg)); + OP_XOR: + list.concat(taicpu.op_reg(A_NOT,TCgSize2OpSize[size],reg)); + end + end + else + list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],TCgSize2OpSize[size],aint(a),reg)); + OP_SHL,OP_SHR,OP_SAR,OP_ROL,OP_ROR: + begin +{$ifdef x86_64} + if (a and 63) <> 0 Then + list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],TCgSize2OpSize[size],a and 63,reg)); + if (a shr 6) <> 0 Then + internalerror(200609073); +{$else x86_64} + if (a and 31) <> 0 Then + list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],TCgSize2OpSize[size],a and 31,reg)); + if (a shr 5) <> 0 Then + internalerror(200609071); +{$endif x86_64} + end + else internalerror(200609072); + end; + end; + + + procedure tcgx86.a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); + var + opcode: tasmop; + power: longint; +{$ifdef x86_64} + tmpreg : tregister; +{$endif x86_64} + tmpref : treference; + begin + optimize_op_const(op, a); + tmpref:=ref; + make_simple_ref(list,tmpref); +{$ifdef x86_64} + { x86_64 only supports signed 32 bits constants directly } + if not(op in [OP_NONE,OP_MOVE]) and + (size in [OS_S64,OS_64]) and + ((a<low(longint)) or (a>high(longint))) then + begin + tmpreg:=getintregister(list,size); + a_load_const_reg(list,size,a,tmpreg); + a_op_reg_ref(list,op,size,tmpreg,tmpref); + exit; + end; +{$endif x86_64} + Case Op of + OP_NONE : + begin + { Opcode is optimized away } + end; + OP_MOVE : + begin + { Optimized, replaced with a simple load } + a_load_const_ref(list,size,a,ref); + end; + OP_DIV, OP_IDIV: + Begin + if ispowerof2(int64(a),power) then + begin + case op of + OP_DIV: + opcode := A_SHR; + OP_IDIV: + opcode := A_SAR; + end; + list.concat(taicpu.op_const_ref(opcode, + TCgSize2OpSize[size],power,tmpref)); + exit; + end; + { the rest should be handled specifically in the code } + { generator because of the silly register usage restraints } + internalerror(200109231); + End; + OP_MUL,OP_IMUL: + begin + if not(cs_check_overflow in current_settings.localswitches) and + ispowerof2(int64(a),power) then + begin + list.concat(taicpu.op_const_ref(A_SHL,TCgSize2OpSize[size], + power,tmpref)); + exit; + end; + { can't multiply a memory location directly with a constant } + if op = OP_IMUL then + inherited a_op_const_ref(list,op,size,a,tmpref) + else + { OP_MUL should be handled specifically in the code } + { generator because of the silly register usage restraints } + internalerror(200109232); + end; + OP_ADD, OP_AND, OP_OR, OP_SUB, OP_XOR: + if not(cs_check_overflow in current_settings.localswitches) and + (a = 1) and + (op in [OP_ADD,OP_SUB]) then + if op = OP_ADD then + list.concat(taicpu.op_ref(A_INC,TCgSize2OpSize[size],tmpref)) + else + list.concat(taicpu.op_ref(A_DEC,TCgSize2OpSize[size],tmpref)) + else if (a = 0) then + if (op <> OP_AND) then + exit + else + a_load_const_ref(list,size,0,tmpref) + else if (aword(a) = high(aword)) and + (op in [OP_AND,OP_OR,OP_XOR]) then + begin + case op of + OP_AND: + exit; + OP_OR: + list.concat(taicpu.op_const_ref(A_MOV,TCgSize2OpSize[size],aint(high(aword)),tmpref)); + OP_XOR: + list.concat(taicpu.op_ref(A_NOT,TCgSize2OpSize[size],tmpref)); + end + end + else + list.concat(taicpu.op_const_ref(TOpCG2AsmOp[op], + TCgSize2OpSize[size],a,tmpref)); + OP_SHL,OP_SHR,OP_SAR,OP_ROL,OP_ROR: + begin + if (a and 31) <> 0 then + list.concat(taicpu.op_const_ref( + TOpCG2AsmOp[op],TCgSize2OpSize[size],a and 31,tmpref)); + if (a shr 5) <> 0 Then + internalerror(68991); + end + else internalerror(68992); + end; + end; + + + procedure tcgx86.a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister); + var + dstsize: topsize; + instr:Taicpu; + begin + check_register_size(size,src); + check_register_size(size,dst); + dstsize := tcgsize2opsize[size]; + case op of + OP_NEG,OP_NOT: + begin + if src<>dst then + a_load_reg_reg(list,size,size,src,dst); + list.concat(taicpu.op_reg(TOpCG2AsmOp[op],dstsize,dst)); + end; + OP_MUL,OP_DIV,OP_IDIV: + { special stuff, needs separate handling inside code } + { generator } + internalerror(200109233); + OP_SHR,OP_SHL,OP_SAR,OP_ROL,OP_ROR: + begin + { Use ecx to load the value, that allows better coalescing } + getcpuregister(list,NR_ECX); + a_load_reg_reg(list,size,OS_32,src,NR_ECX); + list.concat(taicpu.op_reg_reg(Topcg2asmop[op],tcgsize2opsize[size],NR_CL,dst)); + ungetcpuregister(list,NR_ECX); + end; + else + begin + if reg2opsize(src) <> dstsize then + internalerror(200109226); + instr:=taicpu.op_reg_reg(TOpCG2AsmOp[op],dstsize,src,dst); + list.concat(instr); + end; + end; + end; + + + procedure tcgx86.a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); + var + tmpref : treference; + begin + tmpref:=ref; + make_simple_ref(list,tmpref); + check_register_size(size,reg); + case op of + OP_NEG,OP_NOT,OP_IMUL: + begin + inherited a_op_ref_reg(list,op,size,tmpref,reg); + end; + OP_MUL,OP_DIV,OP_IDIV: + { special stuff, needs separate handling inside code } + { generator } + internalerror(200109239); + else + begin + reg := makeregsize(list,reg,size); + list.concat(taicpu.op_ref_reg(TOpCG2AsmOp[op],tcgsize2opsize[size],tmpref,reg)); + end; + end; + end; + + + procedure tcgx86.a_op_reg_ref(list : TAsmList; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference); + var + tmpref : treference; + begin + tmpref:=ref; + make_simple_ref(list,tmpref); + check_register_size(size,reg); + case op of + OP_NEG,OP_NOT: + begin + if reg<>NR_NO then + internalerror(200109237); + list.concat(taicpu.op_ref(TOpCG2AsmOp[op],tcgsize2opsize[size],tmpref)); + end; + OP_IMUL: + begin + { this one needs a load/imul/store, which is the default } + inherited a_op_ref_reg(list,op,size,tmpref,reg); + end; + OP_MUL,OP_DIV,OP_IDIV: + { special stuff, needs separate handling inside code } + { generator } + internalerror(200109238); + else + begin + list.concat(taicpu.op_reg_ref(TOpCG2AsmOp[op],tcgsize2opsize[size],reg,tmpref)); + end; + end; + end; + + procedure tcgx86.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); + var + opsize: topsize; + begin + opsize:=tcgsize2opsize[size]; + if not reverse then + list.concat(taicpu.op_reg_reg(A_BSF,opsize,src,dst)) + else + list.concat(taicpu.op_reg_reg(A_BSR,opsize,src,dst)); + end; + +{*************** compare instructructions ****************} + + procedure tcgx86.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; + l : tasmlabel); + +{$ifdef x86_64} + var + tmpreg : tregister; +{$endif x86_64} + begin +{$ifdef x86_64} + { x86_64 only supports signed 32 bits constants directly } + if (size in [OS_S64,OS_64]) and + ((a<low(longint)) or (a>high(longint))) then + begin + tmpreg:=getintregister(list,size); + a_load_const_reg(list,size,a,tmpreg); + a_cmp_reg_reg_label(list,size,cmp_op,tmpreg,reg,l); + exit; + end; +{$endif x86_64} + if (a = 0) then + list.concat(taicpu.op_reg_reg(A_TEST,tcgsize2opsize[size],reg,reg)) + else + list.concat(taicpu.op_const_reg(A_CMP,tcgsize2opsize[size],a,reg)); + a_jmp_cond(list,cmp_op,l); + end; + + + procedure tcgx86.a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const ref : treference; + l : tasmlabel); + + var +{$ifdef x86_64} + tmpreg : tregister; +{$endif x86_64} + tmpref : treference; + begin + tmpref:=ref; + make_simple_ref(list,tmpref); +{$ifdef x86_64} + { x86_64 only supports signed 32 bits constants directly } + if (size in [OS_S64,OS_64]) and + ((a<low(longint)) or (a>high(longint))) then + begin + tmpreg:=getintregister(list,size); + a_load_const_reg(list,size,a,tmpreg); + a_cmp_reg_ref_label(list,size,cmp_op,tmpreg,tmpref,l); + exit; + end; +{$endif x86_64} + list.concat(taicpu.op_const_ref(A_CMP,TCgSize2OpSize[size],a,tmpref)); + a_jmp_cond(list,cmp_op,l); + end; + + + procedure tcgx86.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp; + reg1,reg2 : tregister;l : tasmlabel); + + begin + check_register_size(size,reg1); + check_register_size(size,reg2); + list.concat(taicpu.op_reg_reg(A_CMP,TCgSize2OpSize[size],reg1,reg2)); + a_jmp_cond(list,cmp_op,l); + end; + + + procedure tcgx86.a_cmp_ref_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;const ref: treference; reg : tregister;l : tasmlabel); + var + tmpref : treference; + begin + tmpref:=ref; + make_simple_ref(list,tmpref); + check_register_size(size,reg); + list.concat(taicpu.op_ref_reg(A_CMP,TCgSize2OpSize[size],tmpref,reg)); + a_jmp_cond(list,cmp_op,l); + end; + + + procedure tcgx86.a_cmp_reg_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg : tregister;const ref: treference; l : tasmlabel); + var + tmpref : treference; + begin + tmpref:=ref; + make_simple_ref(list,tmpref); + check_register_size(size,reg); + list.concat(taicpu.op_reg_ref(A_CMP,TCgSize2OpSize[size],reg,tmpref)); + a_jmp_cond(list,cmp_op,l); + end; + + + procedure tcgx86.a_jmp_cond(list : TAsmList;cond : TOpCmp;l: tasmlabel); + var + ai : taicpu; + begin + if cond=OC_None then + ai := Taicpu.Op_sym(A_JMP,S_NO,l) + else + begin + ai:=Taicpu.Op_sym(A_Jcc,S_NO,l); + ai.SetCondition(TOpCmp2AsmCond[cond]); + end; + ai.is_jmp:=true; + list.concat(ai); + end; + + + procedure tcgx86.a_jmp_flags(list : TAsmList;const f : TResFlags;l: tasmlabel); + var + ai : taicpu; + begin + ai := Taicpu.op_sym(A_Jcc,S_NO,l); + ai.SetCondition(flags_to_cond(f)); + ai.is_jmp := true; + list.concat(ai); + end; + + + procedure tcgx86.g_flags2reg(list: TAsmList; size: TCgSize; const f: tresflags; reg: TRegister); + var + ai : taicpu; + hreg : tregister; + begin + hreg:=makeregsize(list,reg,OS_8); + ai:=Taicpu.op_reg(A_SETcc,S_B,hreg); + ai.setcondition(flags_to_cond(f)); + list.concat(ai); + if reg<>hreg then + a_load_reg_reg(list,OS_8,size,hreg,reg); + end; + + + procedure tcgx86.g_flags2ref(list: TAsmList; size: TCgSize; const f: tresflags; const ref: TReference); + var + ai : taicpu; + tmpref : treference; + begin + tmpref:=ref; + make_simple_ref(list,tmpref); + if not(size in [OS_8,OS_S8]) then + a_load_const_ref(list,size,0,tmpref); + ai:=Taicpu.op_ref(A_SETcc,S_B,tmpref); + ai.setcondition(flags_to_cond(f)); + list.concat(ai); +{$ifndef cpu64bitalu} + if size in [OS_S64,OS_64] then + begin + inc(tmpref.offset,4); + a_load_const_ref(list,OS_32,0,tmpref); + end; +{$endif cpu64bitalu} + end; + + +{ ************* concatcopy ************ } + + procedure Tcgx86.g_concatcopy(list:TAsmList;const source,dest:Treference;len:tcgint); + + const +{$ifdef cpu64bitalu} + REGCX=NR_RCX; + REGSI=NR_RSI; + REGDI=NR_RDI; +{$else cpu64bitalu} + REGCX=NR_ECX; + REGSI=NR_ESI; + REGDI=NR_EDI; +{$endif cpu64bitalu} + + type copymode=(copy_move,copy_mmx,copy_string); + + var srcref,dstref:Treference; + r,r0,r1,r2,r3:Tregister; + helpsize:tcgint; + copysize:byte; + cgsize:Tcgsize; + cm:copymode; + + begin + cm:=copy_move; + helpsize:=3*sizeof(aword); + if cs_opt_size in current_settings.optimizerswitches then + helpsize:=2*sizeof(aword); + if (cs_mmx in current_settings.localswitches) and + not(pi_uses_fpu in current_procinfo.flags) and + ((len=8) or (len=16) or (len=24) or (len=32)) then + cm:=copy_mmx; + if (len>helpsize) then + cm:=copy_string; + if (cs_opt_size in current_settings.optimizerswitches) and + not((len<=16) and (cm=copy_mmx)) and + not(len in [1,2,4{$ifdef x86_64},8{$endif x86_64}]) then + cm:=copy_string; + if (source.segment<>NR_NO) or + (dest.segment<>NR_NO) then + cm:=copy_string; + case cm of + copy_move: + begin + dstref:=dest; + srcref:=source; + copysize:=sizeof(aint); + cgsize:=int_cgsize(copysize); + 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 + else if len<8 then + begin + copysize:=4; + cgsize:=OS_32; + end +{$ifdef cpu64bitalu} + else if len<16 then + begin + copysize:=8; + cgsize:=OS_64; + end +{$endif} + ; + 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; + copy_mmx: + begin + dstref:=dest; + srcref:=source; + r0:=getmmxregister(list); + a_loadmm_ref_reg(list,OS_M64,OS_M64,srcref,r0,nil); + if len>=16 then + begin + inc(srcref.offset,8); + r1:=getmmxregister(list); + a_loadmm_ref_reg(list,OS_M64,OS_M64,srcref,r1,nil); + end; + if len>=24 then + begin + inc(srcref.offset,8); + r2:=getmmxregister(list); + a_loadmm_ref_reg(list,OS_M64,OS_M64,srcref,r2,nil); + end; + if len>=32 then + begin + inc(srcref.offset,8); + r3:=getmmxregister(list); + a_loadmm_ref_reg(list,OS_M64,OS_M64,srcref,r3,nil); + end; + a_loadmm_reg_ref(list,OS_M64,OS_M64,r0,dstref,nil); + if len>=16 then + begin + inc(dstref.offset,8); + a_loadmm_reg_ref(list,OS_M64,OS_M64,r1,dstref,nil); + end; + if len>=24 then + begin + inc(dstref.offset,8); + a_loadmm_reg_ref(list,OS_M64,OS_M64,r2,dstref,nil); + end; + if len>=32 then + begin + inc(dstref.offset,8); + a_loadmm_reg_ref(list,OS_M64,OS_M64,r3,dstref,nil); + end; + end + else {copy_string, should be a good fallback in case of unhandled} + begin + getcpuregister(list,REGDI); + if (dest.segment=NR_NO) then + a_loadaddr_ref_reg(list,dest,REGDI) + else + begin + dstref:=dest; + dstref.segment:=NR_NO; + a_loadaddr_ref_reg(list,dstref,REGDI); + list.concat(taicpu.op_reg(A_PUSH,S_L,NR_ES)); + list.concat(taicpu.op_reg(A_PUSH,S_L,dest.segment)); + list.concat(taicpu.op_reg(A_POP,S_L,NR_ES)); + end; + getcpuregister(list,REGSI); + if (source.segment=NR_NO) then + a_loadaddr_ref_reg(list,source,REGSI) + else + begin + srcref:=source; + srcref.segment:=NR_NO; + a_loadaddr_ref_reg(list,srcref,REGSI); + list.concat(taicpu.op_reg(A_PUSH,S_L,NR_DS)); + list.concat(taicpu.op_reg(A_PUSH,S_L,source.segment)); + list.concat(taicpu.op_reg(A_POP,S_L,NR_DS)); + end; + + getcpuregister(list,REGCX); +{$ifdef i386} + list.concat(Taicpu.op_none(A_CLD,S_NO)); +{$endif i386} + if (cs_opt_size in current_settings.optimizerswitches) and + (len>sizeof(aint)+(sizeof(aint) div 2)) then + begin + a_load_const_reg(list,OS_INT,len,REGCX); + list.concat(Taicpu.op_none(A_REP,S_NO)); + list.concat(Taicpu.op_none(A_MOVSB,S_NO)); + end + else + begin + helpsize:=len div sizeof(aint); + len:=len mod sizeof(aint); + if helpsize>1 then + begin + a_load_const_reg(list,OS_INT,helpsize,REGCX); + list.concat(Taicpu.op_none(A_REP,S_NO)); + end; + if helpsize>0 then + begin +{$ifdef cpu64bitalu} + list.concat(Taicpu.op_none(A_MOVSQ,S_NO)) +{$else} + list.concat(Taicpu.op_none(A_MOVSD,S_NO)); +{$endif cpu64bitalu} + end; + if len>=4 then + begin + dec(len,4); + list.concat(Taicpu.op_none(A_MOVSD,S_NO)); + end; + if len>=2 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; + ungetcpuregister(list,REGCX); + ungetcpuregister(list,REGSI); + ungetcpuregister(list,REGDI); + if (source.segment<>NR_NO) then + list.concat(taicpu.op_reg(A_POP,S_L,NR_DS)); + if (dest.segment<>NR_NO) then + list.concat(taicpu.op_reg(A_POP,S_L,NR_ES)); + end; + end; + end; + + +{**************************************************************************** + Entry/Exit Code Helpers +****************************************************************************} + + procedure tcgx86.g_profilecode(list : TAsmList); + + var + pl : tasmlabel; + mcountprefix : String[4]; + + begin + case target_info.system of + {$ifndef NOTARGETWIN} + system_i386_win32, + {$endif} + system_i386_freebsd, + system_i386_netbsd, +// system_i386_openbsd, + system_i386_wdosx : + begin + Case target_info.system Of + system_i386_freebsd : mcountprefix:='.'; + system_i386_netbsd : mcountprefix:='__'; +// system_i386_openbsd : mcountprefix:='.'; + else + mcountPrefix:=''; + end; + current_asmdata.getaddrlabel(pl); + new_section(list,sec_data,lower(current_procinfo.procdef.mangledname),sizeof(pint)); + list.concat(Tai_label.Create(pl)); + list.concat(Tai_const.Create_32bit(0)); + new_section(list,sec_code,lower(current_procinfo.procdef.mangledname),0); + list.concat(Taicpu.Op_reg(A_PUSH,S_L,NR_EDX)); + list.concat(Taicpu.Op_sym_ofs_reg(A_MOV,S_L,pl,0,NR_EDX)); + a_call_name(list,target_info.Cprefix+mcountprefix+'mcount',false); + list.concat(Taicpu.Op_reg(A_POP,S_L,NR_EDX)); + end; + + system_i386_linux: + a_call_name(list,target_info.Cprefix+'mcount',false); + + system_i386_go32v2,system_i386_watcom: + begin + a_call_name(list,'MCOUNT',false); + end; + system_x86_64_linux, + system_x86_64_darwin: + begin + a_call_name(list,'mcount',false); + end; + end; + end; + + + procedure tcgx86.g_stackpointer_alloc(list : TAsmList;localsize : longint); +{$ifdef x86} +{$ifndef NOTARGETWIN} + var + href : treference; + i : integer; + again : tasmlabel; +{$endif NOTARGETWIN} +{$endif x86} + begin + if localsize>0 then + begin +{$ifdef i386} +{$ifndef NOTARGETWIN} + { windows guards only a few pages for stack growing, + so we have to access every page first } + if (target_info.system in [system_i386_win32,system_i386_wince]) and + (localsize>=winstackpagesize) then + begin + if localsize div winstackpagesize<=5 then + begin + list.concat(Taicpu.Op_const_reg(A_SUB,S_L,localsize-4,NR_ESP)); + for i:=1 to localsize div winstackpagesize do + begin + reference_reset_base(href,NR_ESP,localsize-i*winstackpagesize,4); + list.concat(Taicpu.op_reg_ref(A_MOV,S_L,NR_EAX,href)); + end; + list.concat(Taicpu.op_reg(A_PUSH,S_L,NR_EAX)); + end + else + begin + current_asmdata.getjumplabel(again); + getcpuregister(list,NR_EDI); + list.concat(Taicpu.op_reg(A_PUSH,S_L,NR_EDI)); + list.concat(Taicpu.op_const_reg(A_MOV,S_L,localsize div winstackpagesize,NR_EDI)); + a_label(list,again); + list.concat(Taicpu.op_const_reg(A_SUB,S_L,winstackpagesize-4,NR_ESP)); + list.concat(Taicpu.op_reg(A_PUSH,S_L,NR_EAX)); + list.concat(Taicpu.op_reg(A_DEC,S_L,NR_EDI)); + a_jmp_cond(list,OC_NE,again); + list.concat(Taicpu.op_const_reg(A_SUB,S_L,localsize mod winstackpagesize - 4,NR_ESP)); + reference_reset_base(href,NR_ESP,localsize-4,4); + list.concat(Taicpu.op_ref_reg(A_MOV,S_L,href,NR_EDI)); + ungetcpuregister(list,NR_EDI); + end + end + else +{$endif NOTARGETWIN} +{$endif i386} +{$ifdef x86_64} +{$ifndef NOTARGETWIN} + { windows guards only a few pages for stack growing, + so we have to access every page first } + if (target_info.system=system_x86_64_win64) and + (localsize>=winstackpagesize) then + begin + if localsize div winstackpagesize<=5 then + begin + list.concat(Taicpu.Op_const_reg(A_SUB,S_Q,localsize,NR_RSP)); + for i:=1 to localsize div winstackpagesize do + begin + reference_reset_base(href,NR_RSP,localsize-i*winstackpagesize+4,4); + list.concat(Taicpu.op_reg_ref(A_MOV,S_L,NR_EAX,href)); + end; + reference_reset_base(href,NR_RSP,0,4); + list.concat(Taicpu.op_reg_ref(A_MOV,S_L,NR_EAX,href)); + end + else + begin + current_asmdata.getjumplabel(again); + getcpuregister(list,NR_R10); + list.concat(Taicpu.op_const_reg(A_MOV,S_Q,localsize div winstackpagesize,NR_R10)); + a_label(list,again); + list.concat(Taicpu.op_const_reg(A_SUB,S_Q,winstackpagesize,NR_RSP)); + reference_reset_base(href,NR_RSP,0,4); + list.concat(Taicpu.op_reg_ref(A_MOV,S_L,NR_EAX,href)); + list.concat(Taicpu.op_reg(A_DEC,S_Q,NR_R10)); + a_jmp_cond(list,OC_NE,again); + list.concat(Taicpu.op_const_reg(A_SUB,S_Q,localsize mod winstackpagesize,NR_RSP)); + ungetcpuregister(list,NR_R10); + end + end + else +{$endif NOTARGETWIN} +{$endif x86_64} + list.concat(Taicpu.Op_const_reg(A_SUB,tcgsize2opsize[OS_ADDR],localsize,NR_STACK_POINTER_REG)); + end; + end; + + + procedure tcgx86.g_proc_entry(list : TAsmList;localsize : longint;nostackframe:boolean); + var + stackmisalignment: longint; + para: tparavarsym; + begin +{$ifdef i386} + { interrupt support for i386 } + if (po_interrupt in current_procinfo.procdef.procoptions) and + { this messes up stack alignment } + not(target_info.system in [system_i386_darwin,system_i386_iphonesim]) then + begin + { .... also the segment registers } + list.concat(Taicpu.Op_reg(A_PUSH,S_W,NR_GS)); + list.concat(Taicpu.Op_reg(A_PUSH,S_W,NR_FS)); + list.concat(Taicpu.Op_reg(A_PUSH,S_W,NR_ES)); + list.concat(Taicpu.Op_reg(A_PUSH,S_W,NR_DS)); + { save the registers of an interrupt procedure } + list.concat(Taicpu.Op_reg(A_PUSH,S_L,NR_EDI)); + list.concat(Taicpu.Op_reg(A_PUSH,S_L,NR_ESI)); + list.concat(Taicpu.Op_reg(A_PUSH,S_L,NR_EDX)); + list.concat(Taicpu.Op_reg(A_PUSH,S_L,NR_ECX)); + list.concat(Taicpu.Op_reg(A_PUSH,S_L,NR_EBX)); + list.concat(Taicpu.Op_reg(A_PUSH,S_L,NR_EAX)); + end; +{$endif i386} + + { save old framepointer } + if not nostackframe then + begin + { return address } + stackmisalignment := sizeof(pint); + list.concat(tai_regalloc.alloc(current_procinfo.framepointer,nil)); + if current_procinfo.framepointer=NR_STACK_POINTER_REG then + CGmessage(cg_d_stackframe_omited) + else + begin + { push <frame_pointer> } + inc(stackmisalignment,sizeof(pint)); + include(rg[R_INTREGISTER].preserved_by_proc,RS_FRAME_POINTER_REG); + list.concat(Taicpu.op_reg(A_PUSH,tcgsize2opsize[OS_ADDR],NR_FRAME_POINTER_REG)); + if (target_info.system=system_x86_64_win64) then + begin + list.concat(cai_seh_directive.create_reg(ash_pushreg,NR_FRAME_POINTER_REG)); + include(current_procinfo.flags,pi_has_unwind_info); + end; + { Return address and FP are both on stack } + current_asmdata.asmcfi.cfa_def_cfa_offset(list,2*sizeof(pint)); + current_asmdata.asmcfi.cfa_offset(list,NR_FRAME_POINTER_REG,-(2*sizeof(pint))); + if current_procinfo.procdef.proctypeoption<>potype_exceptfilter then + list.concat(Taicpu.op_reg_reg(A_MOV,tcgsize2opsize[OS_ADDR],NR_STACK_POINTER_REG,NR_FRAME_POINTER_REG)) + else + begin + { load framepointer from hidden $parentfp parameter } + para:=tparavarsym(current_procinfo.procdef.paras[0]); + if not (vo_is_parentfp in para.varoptions) then + InternalError(201201142); + if (para.paraloc[calleeside].location^.loc<>LOC_REGISTER) or + (para.paraloc[calleeside].location^.next<>nil) then + InternalError(201201143); + list.concat(Taicpu.op_reg_reg(A_MOV,tcgsize2opsize[OS_ADDR], + para.paraloc[calleeside].location^.register,NR_FRAME_POINTER_REG)); + { Need only as much stack space as necessary to do the calls. + Exception filters don't have own local vars, and temps are 'mapped' + to the parent procedure. + maxpushedparasize is already aligned at least on x86_64. } + localsize:=current_procinfo.maxpushedparasize; + end; + current_asmdata.asmcfi.cfa_def_cfa_register(list,NR_FRAME_POINTER_REG); + { + TODO: current framepointer handling is not compatible with Win64 at all: + Win64 expects FP to point to the top or into the middle of local area. + In FPC it points to the bottom, making it impossible to generate + UWOP_SET_FPREG unwind code if local area is > 240 bytes. + So for now pretend we never have a framepointer. + } + end; + + { allocate stackframe space } + if (localsize<>0) or + ((target_info.system in systems_need_16_byte_stack_alignment) and + (stackmisalignment <> 0) and + ((pi_do_call in current_procinfo.flags) or + (po_assembler in current_procinfo.procdef.procoptions))) then + begin + if (target_info.system in systems_need_16_byte_stack_alignment) then + localsize := align(localsize+stackmisalignment,16)-stackmisalignment; + cg.g_stackpointer_alloc(list,localsize); + if current_procinfo.framepointer=NR_STACK_POINTER_REG then + current_asmdata.asmcfi.cfa_def_cfa_offset(list,localsize+sizeof(pint)); + current_procinfo.final_localsize:=localsize; + if (target_info.system=system_x86_64_win64) then + begin + if localsize<>0 then + list.concat(cai_seh_directive.create_offset(ash_stackalloc,localsize)); + include(current_procinfo.flags,pi_has_unwind_info); + end; + end; + end; + end; + + + { produces if necessary overflowcode } + procedure tcgx86.g_overflowcheck(list: TAsmList; const l:tlocation;def:tdef); + var + hl : tasmlabel; + ai : taicpu; + cond : TAsmCond; + begin + if not(cs_check_overflow in current_settings.localswitches) then + exit; + current_asmdata.getjumplabel(hl); + if not ((def.typ=pointerdef) or + ((def.typ=orddef) and + (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar, + pasbool8,pasbool16,pasbool32,pasbool64]))) then + cond:=C_NO + else + cond:=C_NB; + ai:=Taicpu.Op_Sym(A_Jcc,S_NO,hl); + ai.SetCondition(cond); + ai.is_jmp:=true; + list.concat(ai); + + a_call_name(list,'FPC_OVERFLOW',false); + a_label(list,hl); + end; + + procedure tcgx86.g_external_wrapper(list: TAsmList; procdef: tprocdef; const externalname: string); + var + ref : treference; + sym : tasmsymbol; + begin + if (target_info.system = system_i386_darwin) then + begin + { a_jmp_name jumps to a stub which is always pic-safe on darwin } + inherited g_external_wrapper(list,procdef,externalname); + exit; + end; + + sym:=current_asmdata.RefAsmSymbol(externalname); + reference_reset_symbol(ref,sym,0,sizeof(pint)); + + { create pic'ed? } + if (cs_create_pic in current_settings.moduleswitches) and + { darwin/x86_64's assembler doesn't want @PLT after call symbols } + not(target_info.system in [system_x86_64_darwin,system_i386_iphonesim]) then + ref.refaddr:=addr_pic + else + ref.refaddr:=addr_full; + list.concat(taicpu.op_ref(A_JMP,S_NO,ref)); + end; + +end. diff --git a/closures/compiler/x86/cpubase.pas b/closures/compiler/x86/cpubase.pas new file mode 100644 index 0000000000..056e571cf7 --- /dev/null +++ b/closures/compiler/x86/cpubase.pas @@ -0,0 +1,511 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl and Peter Vreman + + Contains the base types for the i386 and x86-64 architecture + + * This code was inspired by the NASM sources + The Netwide Assembler is Copyright (c) 1996 Simon Tatham and + Julian Hall. All rights reserved. + + 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, + cgbase + ; + + +{***************************************************************************** + Assembler Opcodes +*****************************************************************************} + + type +{$ifdef x86_64} + TAsmOp={$i x8664op.inc} +{$else x86_64} + TAsmOp={$i i386op.inc} +{$endif x86_64} + + { This should define the array of instructions as string } + op2strtable=array[tasmop] of string[15]; + + const + { First value of opcode enumeration } + firstop = low(tasmop); + { Last value of opcode enumeration } + lastop = high(tasmop); + +{***************************************************************************** + Registers +*****************************************************************************} + + const + { Invalid register number } + RS_INVALID = $ff; + + { Integer Super registers } + RS_RAX = $00; {EAX} + RS_RCX = $01; {ECX} + RS_RDX = $02; {EDX} + RS_RBX = $03; {EBX} + RS_RSI = $04; {ESI} + RS_RDI = $05; {EDI} + RS_RBP = $06; {EBP} + RS_RSP = $07; {ESP} + RS_R8 = $08; {R8} + RS_R9 = $09; {R9} + RS_R10 = $0a; {R10} + RS_R11 = $0b; {R11} + RS_R12 = $0c; {R12} + RS_R13 = $0d; {R13} + RS_R14 = $0e; {R14} + RS_R15 = $0f; {R15} + { create aliases to allow code sharing between x86-64 and i386 } + RS_EAX = RS_RAX; + RS_EBX = RS_RBX; + RS_ECX = RS_RCX; + RS_EDX = RS_RDX; + RS_ESI = RS_RSI; + RS_EDI = RS_RDI; + RS_EBP = RS_RBP; + RS_ESP = RS_RSP; + + { Number of first imaginary register } + first_int_imreg = $10; + + { Float Super registers } + RS_ST0 = $00; + RS_ST1 = $01; + RS_ST2 = $02; + RS_ST3 = $03; + RS_ST4 = $04; + RS_ST5 = $05; + RS_ST6 = $06; + RS_ST7 = $07; + + { Number of first imaginary register } + first_fpu_imreg = $08; + + { MM Super registers } + RS_XMM0 = $00; + RS_XMM1 = $01; + RS_XMM2 = $02; + RS_XMM3 = $03; + RS_XMM4 = $04; + RS_XMM5 = $05; + RS_XMM6 = $06; + RS_XMM7 = $07; + RS_XMM8 = $08; + RS_XMM9 = $09; + RS_XMM10 = $0a; + RS_XMM11 = $0b; + RS_XMM12 = $0c; + RS_XMM13 = $0d; + RS_XMM14 = $0e; + RS_XMM15 = $0f; + + { Number of first imaginary register } +{$ifdef x86_64} + first_mm_imreg = $10; +{$else x86_64} + first_mm_imreg = $08; +{$endif x86_64} + + { The subregister that specifies the entire register and an address } +{$ifdef x86_64} + { Hammer } + R_SUBWHOLE = R_SUBQ; + R_SUBADDR = R_SUBQ; +{$else x86_64} + { i386 } + R_SUBWHOLE = R_SUBD; + R_SUBADDR = R_SUBD; +{$endif x86_64} + + { Available Registers } +{$ifdef x86_64} + {$i r8664con.inc} +{$else x86_64} + {$i r386con.inc} +{$endif x86_64} + + type + { Number of registers used for indexing in tables } +{$ifdef x86_64} + tregisterindex=0..{$i r8664nor.inc}-1; +{$else x86_64} + tregisterindex=0..{$i r386nor.inc}-1; +{$endif x86_64} + + const +{ TODO: Calculate bsstart} + regnumber_count_bsstart = 64; + + regnumber_table : array[tregisterindex] of tregister = ( +{$ifdef x86_64} + {$i r8664num.inc} +{$else x86_64} + {$i r386num.inc} +{$endif x86_64} + ); + + regstabs_table : array[tregisterindex] of shortint = ( +{$ifdef x86_64} + {$i r8664stab.inc} +{$else x86_64} + {$i r386stab.inc} +{$endif x86_64} + ); + + regdwarf_table : array[tregisterindex] of shortint = ( +{$ifdef x86_64} + {$i r8664dwrf.inc} +{$else x86_64} + {$i r386dwrf.inc} +{$endif x86_64} + ); + + type + totherregisterset = set of tregisterindex; + + +{***************************************************************************** + Conditions +*****************************************************************************} + + 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 + ); + + const + cond2str:array[TAsmCond] of string[3]=('', + 'a','ae','b','be','c','e','g','ge','l','le','na','nae', + 'nb','nbe','nc','ne','ng','nge','nl','nle','no','np', + 'ns','nz','o','p','pe','po','s','z' + ); + +{***************************************************************************** + Flags +*****************************************************************************} + + type + TResFlags = (F_E,F_NE,F_G,F_L,F_GE,F_LE,F_C,F_NC, + F_A,F_AE,F_B,F_BE, + F_S,F_NS,F_O,F_NO); + + +{***************************************************************************** + Constants +*****************************************************************************} + + const + { declare aliases } + LOC_SSEREGISTER = LOC_MMREGISTER; + LOC_CSSEREGISTER = LOC_CMMREGISTER; + + max_operands = 4; + maxfpuregs = 8; + +{***************************************************************************** + CPU Dependent Constants +*****************************************************************************} + + {$i cpubase.inc} + +{***************************************************************************** + Helpers +*****************************************************************************} + + function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister; + function reg2opsize(r:Tregister):topsize; + function reg_cgsize(const reg: tregister): tcgsize; + function is_calljmp(o:tasmop):boolean; + procedure inverse_flags(var f: TResFlags); + function flags_to_cond(const f: TResFlags) : TAsmCond; + function is_segment_reg(r:tregister):boolean; + function findreg_by_number(r:Tregister):tregisterindex; + function std_regnum_search(const s:string):Tregister; + function std_regname(r:Tregister):string; + function dwarf_reg(r:tregister):shortint; + + 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} + +implementation + + uses + rgbase,verbose; + + const + {$ifdef x86_64} + std_regname_table : array[tregisterindex] of string[7] = ( + {$i r8664std.inc} + ); + + regnumber_index : array[tregisterindex] of tregisterindex = ( + {$i r8664rni.inc} + ); + std_regname_index : array[tregisterindex] of tregisterindex = ( + {$i r8664sri.inc} + ); + {$else x86_64} + std_regname_table : array[tregisterindex] of string[7] = ( + {$i r386std.inc} + ); + + regnumber_index : array[tregisterindex] of tregisterindex = ( + {$i r386rni.inc} + ); + + std_regname_index : array[tregisterindex] of tregisterindex = ( + {$i r386sri.inc} + ); + {$endif x86_64} + + +{***************************************************************************** + Helpers +*****************************************************************************} + + function cgsize2subreg(regtype: tregistertype; s:Tcgsize):Tsubregister; + begin + case s of + OS_8,OS_S8: + cgsize2subreg:=R_SUBL; + OS_16,OS_S16: + cgsize2subreg:=R_SUBW; + OS_32,OS_S32: + cgsize2subreg:=R_SUBD; + OS_64,OS_S64: + cgsize2subreg:=R_SUBQ; + OS_M64: + cgsize2subreg:=R_SUBNONE; + OS_F32,OS_F64,OS_C64: + case regtype of + R_FPUREGISTER: + cgsize2subreg:=R_SUBWHOLE; + R_MMREGISTER: + case s of + OS_F32: + cgsize2subreg:=R_SUBMMS; + OS_F64: + cgsize2subreg:=R_SUBMMD; + else + internalerror(2009071901); + end; + else + internalerror(2009071902); + end; + OS_M128,OS_MS128: + cgsize2subreg:=R_SUBMMWHOLE; + else + internalerror(200301231); + end; + 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_F32,OS_F64,OS_M128); + begin + case getregtype(reg) of + R_INTREGISTER : + reg_cgsize:=subreg2cgsize[getsubreg(reg)]; + R_FPUREGISTER : + reg_cgsize:=OS_F80; + R_MMXREGISTER: + reg_cgsize:=OS_M64; + R_MMREGISTER: + reg_cgsize:=subreg2cgsize[getsubreg(reg)]; + R_SPECIALREGISTER : + case reg of + NR_CS,NR_DS,NR_ES,NR_SS,NR_FS,NR_GS: + reg_cgsize:=OS_16; +{$ifdef x86_64} + NR_DR0..NR_TR7: + reg_cgsize:=OS_64; +{$endif x86_64} + else + reg_cgsize:=OS_32 + end + else + internalerror(200303181); + end; + end; + + + function reg2opsize(r:Tregister):topsize; + const + subreg2opsize : array[tsubregister] of topsize = + (S_NO,S_B,S_B,S_W,S_L,S_Q,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO); + begin + reg2opsize:=S_L; + case getregtype(r) of + R_INTREGISTER : + reg2opsize:=subreg2opsize[getsubreg(r)]; + R_FPUREGISTER : + reg2opsize:=S_FL; + R_MMXREGISTER, + R_MMREGISTER : + reg2opsize:=S_MD; + R_SPECIALREGISTER : + begin + case r of + NR_CS,NR_DS,NR_ES, + NR_SS,NR_FS,NR_GS : + reg2opsize:=S_W; + end; + end; + else + internalerror(200303181); + end; + end; + + + function is_calljmp(o:tasmop):boolean; + begin + case o of + A_CALL, +{$ifdef i386} + A_JCXZ, +{$endif i386} + A_JECXZ, +{$ifdef x86_64} + A_JRCXZ, +{$endif x86_64} + A_JMP, + A_LOOP, + A_LOOPE, + A_LOOPNE, + A_LOOPNZ, + A_LOOPZ, + A_LCALL, + A_LJMP, + A_Jcc : + is_calljmp:=true; + else + is_calljmp:=false; + end; + end; + + + procedure inverse_flags(var f: TResFlags); + const + inv_flags: array[TResFlags] of TResFlags = + (F_NE,F_E,F_LE,F_GE,F_L,F_G,F_NC,F_C, + F_BE,F_B,F_AE,F_A, + F_NS,F_S,F_NO,F_O); + begin + f:=inv_flags[f]; + end; + + + function flags_to_cond(const f: TResFlags) : TAsmCond; + const + flags_2_cond : array[TResFlags] of TAsmCond = + (C_E,C_NE,C_G,C_L,C_GE,C_LE,C_C,C_NC,C_A,C_AE,C_B,C_BE,C_S,C_NS,C_O,C_NO); + begin + result := flags_2_cond[f]; + end; + + + function is_segment_reg(r:tregister):boolean; + begin + result:=false; + case r of + NR_CS,NR_DS,NR_ES, + NR_SS,NR_FS,NR_GS : + result:=true; + end; + end; + + + function findreg_by_number(r:Tregister):tregisterindex; + var + hr : tregister; + begin + { for the name the sub reg doesn't matter } + hr:=r; + case getsubreg(hr) of + R_SUBMMS,R_SUBMMD,R_SUBMMWHOLE: + setsubreg(hr,R_SUBNONE); + end; + result:=findreg_by_number_table(hr,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 + if getregtype(r) in [R_MMREGISTER,R_MMXREGISTER] then + r:=newreg(getregtype(r),getsupreg(r),R_SUBNONE); + p:=findreg_by_number_table(r,regnumber_index); + if p<>0 then + result:=std_regname_table[p] + else + result:=generic_regname(r); + end; + + + function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE} + const + inverse: array[TAsmCond] of TAsmCond=(C_None, + C_NA,C_NAE,C_NB,C_NBE,C_NC,C_NE,C_NG,C_NGE,C_NL,C_NLE,C_A,C_AE, + C_B,C_BE,C_C,C_E,C_G,C_GE,C_L,C_LE,C_O,C_P, + C_S,C_Z,C_NO,C_NP,C_NP,C_P,C_NS,C_NZ + ); + begin + result := inverse[c]; + end; + + + function conditions_equal(const c1, c2: TAsmCond): boolean; {$ifdef USEINLINE}inline;{$endif USEINLINE} + begin + result := c1 = c2; + end; + + + function dwarf_reg(r:tregister):shortint; + begin + result:=regdwarf_table[findreg_by_number(r)]; + if result=-1 then + internalerror(200603251); + end; + + +end. diff --git a/closures/compiler/x86/itcpugas.pas b/closures/compiler/x86/itcpugas.pas new file mode 100644 index 0000000000..4280245f4d --- /dev/null +++ b/closures/compiler/x86/itcpugas.pas @@ -0,0 +1,167 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit contains the i386 AT&T 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 + cgbase,cpubase; + + type + TAttSuffix = (AttSufNONE,AttSufINT,AttSufFPU,AttSufFPUint,AttSufINTdual); + + const +{$ifdef x86_64} + {x86att.inc contains the name for each x86-64 mnemonic} + gas_op2str:op2strtable={$i x8664att.inc} + gas_needsuffix:array[tasmop] of TAttSuffix={$i x8664ats.inc} +{$else x86_64} + {x86att.inc contains the name for each i386 mnemonic} + gas_op2str:op2strtable={$i i386att.inc} + gas_needsuffix:array[tasmop] of TAttSuffix={$i i386atts.inc} +{$endif x86_64} + +{$ifdef x86_64} + gas_opsize2str : array[topsize] of string[2] = ('', + 'b','w','l','q','bw','bl','wl','bq','wq','lq', + 's','l','q', + 's','l','t','v','x', + 'd', + '','','', + 't', + '' + ); + { suffix-to-opsize conversion tables, used in asmreadrer } + { !! S_LQ excluded: movzlq does not exist, movslq is processed + as a separate instruction w/o suffix (aka movsxd), and there are + no more instructions needing it. } + att_sizesuffixstr : array[0..11] of string[2] = ( + '','BW','BL','WL','BQ','WQ',{'LQ',}'B','W','L','S','Q','T' + ); + att_sizesuffix : array[0..11] of topsize = ( + S_NO,S_BW,S_BL,S_WL,S_BQ,S_WQ,{S_LQ,}S_B,S_W,S_L,S_NO,S_Q,S_NO + ); + att_sizefpusuffix : array[0..11] of topsize = ( + S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,{S_NO,}S_NO,S_NO,S_FL,S_FS,S_NO,S_FX + ); + att_sizefpuintsuffix : array[0..11] of topsize = ( + S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,{S_NO,}S_NO,S_NO,S_IL,S_IS,S_IQ,S_NO + ); +{$else x86_64} + gas_opsize2str : array[topsize] of string[2] = ('', + 'b','w','l','q','bw','bl','wl', + 's','l','q', + 's','l','t','v','', + 'd', + '','','', + 't', + '' + ); + { suffix-to-opsize conversion tables, used in asmreadrer } + att_sizesuffixstr : array[0..9] of string[2] = ( + '','BW','BL','WL','B','W','L','S','Q','T' + ); + att_sizesuffix : array[0..9] of topsize = ( + S_NO,S_BW,S_BL,S_WL,S_B,S_W,S_L,S_NO,S_NO,S_NO + ); + att_sizefpusuffix : array[0..9] of topsize = ( + S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_FL,S_FS,S_NO,S_FX + ); + att_sizefpuintsuffix : array[0..9] of topsize = ( + S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_IL,S_IS,S_IQ,S_NO + ); +{$endif x86_64} + + + function gas_regnum_search(const s:string):Tregister; + function gas_regname(r:Tregister):string; + + +implementation + + uses + cutils,verbose; + + const + {$ifdef x86_64} + att_regname_table : array[tregisterindex] of string[7] = ( + {r8664att.inc contains the AT&T name of each register.} + {$i r8664att.inc} + ); + + att_regname_index : array[tregisterindex] of tregisterindex = ( + {r8664ari.inc contains an index which sorts att_regname_table by + ATT name.} + {$i r8664ari.inc} + ); + {$else x86_64} + att_regname_table : array[tregisterindex] of string[7] = ( + {r386att.inc contains the AT&T name of each register.} + {$i r386att.inc} + ); + + att_regname_index : array[tregisterindex] of tregisterindex = ( + {r386ari.inc contains an index which sorts att_regname_table by + ATT name.} + {$i r386ari.inc} + ); + {$endif x86_64} + + function findreg_by_attname(const s:string):byte; + var + i,p : tregisterindex; + begin + {Binary search.} + p:=0; + i:=regnumber_count_bsstart; + repeat + if (p+i<=high(tregisterindex)) and (att_regname_table[att_regname_index[p+i]]<=s) then + p:=p+i; + i:=i shr 1; + until i=0; + if att_regname_table[att_regname_index[p]]=s then + findreg_by_attname:=att_regname_index[p] + else + findreg_by_attname:=0; + end; + + + function gas_regnum_search(const s:string):Tregister; + begin + result:=regnumber_table[findreg_by_attname(s)]; + end; + + + function gas_regname(r:Tregister):string; + var + p : tregisterindex; + begin + p:=findreg_by_number(r); + if p<>0 then + result:=att_regname_table[p] + else + result:='%'+generic_regname(r); + end; + +end. diff --git a/closures/compiler/x86/itx86int.pas b/closures/compiler/x86/itx86int.pas new file mode 100644 index 0000000000..182938678d --- /dev/null +++ b/closures/compiler/x86/itx86int.pas @@ -0,0 +1,97 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit contains the i386 AT&T 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 itx86int; + +{$i fpcdefs.inc} + +interface + + uses + cgbase; + + function masm_regnum_search(const s:string):Tregister; + function masm_regname(r:Tregister):string; + + +implementation + + uses + cutils,verbose, + cpubase; + + const + {$ifdef x86_64} + int_regname_table : array[tregisterindex] of string[7] = ( + {$i r8664int.inc} + ); + + int_regname_index : array[tregisterindex] of tregisterindex = ( + {$i r8664iri.inc} + ); + {$else x86_64} + int_regname_table : array[tregisterindex] of string[7] = ( + {$i r386int.inc} + ); + + int_regname_index : array[tregisterindex] of tregisterindex = ( + {$i r386iri.inc} + ); + {$endif x86_64} + + + function findreg_by_intname(const s:string):byte; + var + i,p : tregisterindex; + begin + {Binary search.} + p:=0; + i:=regnumber_count_bsstart; + repeat + if (p+i<=high(tregisterindex)) and (int_regname_table[int_regname_index[p+i]]<=s) then + p:=p+i; + i:=i shr 1; + until i=0; + if int_regname_table[int_regname_index[p]]=s then + findreg_by_intname:=int_regname_index[p] + else + findreg_by_intname:=0; + end; + + + function masm_regnum_search(const s:string):Tregister; + begin + result:=regnumber_table[findreg_by_intname(s)]; + end; + + + function masm_regname(r:Tregister):string; + var + p : tregisterindex; + begin + p:=findreg_by_number(r); + if p<>0 then + result:=int_regname_table[p] + else + result:=generic_regname(r); + end; + +end. diff --git a/closures/compiler/x86/nx86add.pas b/closures/compiler/x86/nx86add.pas new file mode 100644 index 0000000000..b1285d29b8 --- /dev/null +++ b/closures/compiler/x86/nx86add.pas @@ -0,0 +1,1080 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + Common code generation for add nodes on the i386 and x86 + + 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 nx86add; + +{$i fpcdefs.inc} + + interface + + uses + cgbase, + cpubase, + node,nadd,ncgadd; + + type + tx86addnode = class(tcgaddnode) + protected + function getresflags(unsigned : boolean) : tresflags; + procedure left_must_be_reg(opsize:TCGSize;noswap:boolean); + procedure check_left_and_right_fpureg(force_fpureg: boolean); + procedure emit_op_right_left(op:TAsmOp;opsize:TCgSize); + procedure emit_generic_code(op:TAsmOp;opsize:TCgSize;unsigned,extra_not,mboverflow:boolean); + + procedure second_cmpfloatsse; + procedure second_addfloatsse; + public + procedure second_addfloat;override; + procedure second_addsmallset;override; + procedure second_add64bit;override; + procedure second_cmpfloat;override; + procedure second_cmpsmallset;override; + procedure second_cmp64bit;override; + procedure second_cmpordinal;override; +{$ifdef SUPPORT_MMX} + procedure second_opmmx;override; +{$endif SUPPORT_MMX} + procedure second_opvector;override; + end; + + + implementation + + uses + globtype,globals, + verbose,cutils, + cpuinfo, + aasmbase,aasmtai,aasmdata,aasmcpu, + symconst,symdef, + cgobj,cgx86,cga,cgutils, + paramgr,tgobj,ncgutil, + ncon,nset,ninl, + defutil; + + +{***************************************************************************** + Helpers +*****************************************************************************} + + procedure tx86addnode.emit_generic_code(op:TAsmOp;opsize:TCGSize;unsigned,extra_not,mboverflow:boolean); + var + power : longint; + hl4 : tasmlabel; + r : Tregister; + begin + { at this point, left.location.loc should be LOC_REGISTER } + if right.location.loc=LOC_REGISTER then + begin + { right.location is a LOC_REGISTER } + { when swapped another result register } + if (nodetype=subn) and (nf_swapped in flags) then + begin + if extra_not then + emit_reg(A_NOT,TCGSize2Opsize[opsize],left.location.register); + emit_reg_reg(op,TCGSize2Opsize[opsize],left.location.register,right.location.register); + { newly swapped also set swapped flag } + location_swap(left.location,right.location); + toggleflag(nf_swapped); + end + else + begin + if extra_not then + emit_reg(A_NOT,TCGSize2Opsize[opsize],right.location.register); + if (op=A_ADD) or (op=A_OR) or (op=A_AND) or (op=A_XOR) or (op=A_IMUL) then + location_swap(left.location,right.location); + emit_reg_reg(op,TCGSize2Opsize[opsize],right.location.register,left.location.register); + end; + end + else + begin + { right.location is not a LOC_REGISTER } + if (nodetype=subn) and (nf_swapped in flags) then + begin + if extra_not then + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NOT,opsize,left.location.register,left.location.register); + r:=cg.getintregister(current_asmdata.CurrAsmList,opsize); + cg.a_load_loc_reg(current_asmdata.CurrAsmList,opsize,right.location,r); + emit_reg_reg(op,TCGSize2Opsize[opsize],left.location.register,r); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,opsize,opsize,r,left.location.register); + end + else + begin + { Optimizations when right.location is a constant value } + if (op=A_CMP) and + (nodetype in [equaln,unequaln]) and + (right.location.loc=LOC_CONSTANT) and + (right.location.value=0) then + begin + emit_reg_reg(A_TEST,TCGSize2Opsize[opsize],left.location.register,left.location.register); + end + else + if (op=A_ADD) and + (right.location.loc=LOC_CONSTANT) and + (right.location.value=1) and + not(cs_check_overflow in current_settings.localswitches) then + begin + emit_reg(A_INC,TCGSize2Opsize[opsize],left.location.register); + end + else + if (op=A_SUB) and + (right.location.loc=LOC_CONSTANT) and + (right.location.value=1) and + not(cs_check_overflow in current_settings.localswitches) then + begin + emit_reg(A_DEC,TCGSize2Opsize[opsize],left.location.register); + end + else + if (op=A_IMUL) and + (right.location.loc=LOC_CONSTANT) and + (ispowerof2(int64(right.location.value),power)) and + not(cs_check_overflow in current_settings.localswitches) then + begin + emit_const_reg(A_SHL,TCGSize2Opsize[opsize],power,left.location.register); + end + else + begin + if extra_not then + begin + r:=cg.getintregister(current_asmdata.CurrAsmList,opsize); + cg.a_load_loc_reg(current_asmdata.CurrAsmList,opsize,right.location,r); + emit_reg(A_NOT,TCGSize2Opsize[opsize],r); + emit_reg_reg(A_AND,TCGSize2Opsize[opsize],r,left.location.register); + end + else + begin + emit_op_right_left(op,opsize); + end; + end; + end; + end; + + { only in case of overflow operations } + { produce overflow code } + { we must put it here directly, because sign of operation } + { is in unsigned VAR!! } + if mboverflow then + begin + if cs_check_overflow in current_settings.localswitches then + begin + current_asmdata.getjumplabel(hl4); + if unsigned then + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_AE,hl4) + else + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NO,hl4); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false); + cg.a_label(current_asmdata.CurrAsmList,hl4); + end; + end; + end; + + + procedure tx86addnode.left_must_be_reg(opsize:TCGSize;noswap:boolean); + begin + { left location is not a register? } + if (left.location.loc<>LOC_REGISTER) then + begin + { if right is register then we can swap the locations } + if (not noswap) and + (right.location.loc=LOC_REGISTER) then + begin + location_swap(left.location,right.location); + toggleflag(nf_swapped); + end + else + begin + { maybe we can reuse a constant register when the + operation is a comparison that doesn't change the + value of the register } + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,(nodetype in [ltn,lten,gtn,gten,equaln,unequaln])); + end; + end; + if (right.location.loc<>LOC_CONSTANT) and + (tcgsize2unsigned[right.location.size]<>tcgsize2unsigned[opsize]) then + location_force_reg(current_asmdata.CurrAsmList,right.location,opsize,true); + if (left.location.loc<>LOC_CONSTANT) and + (tcgsize2unsigned[left.location.size]<>tcgsize2unsigned[opsize]) then + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,false); + end; + + + procedure tx86addnode.check_left_and_right_fpureg(force_fpureg: boolean); + begin + if (right.location.loc<>LOC_FPUREGISTER) then + begin + if (force_fpureg) then + begin + location_force_fpureg(current_asmdata.CurrAsmList,right.location,false); + if (left.location.loc<>LOC_FPUREGISTER) then + location_force_fpureg(current_asmdata.CurrAsmList,left.location,false) + else + { left was on the stack => swap } + toggleflag(nf_swapped); + end + end + { the nominator in st0 } + else if (left.location.loc<>LOC_FPUREGISTER) then + begin + if (force_fpureg) then + location_force_fpureg(current_asmdata.CurrAsmList,left.location,false) + end + else + begin + { fpu operands are always in the wrong order on the stack } + toggleflag(nf_swapped); + end; + end; + + + procedure tx86addnode.emit_op_right_left(op:TAsmOp;opsize:TCgsize); +{$ifdef x86_64} + var + tmpreg : tregister; +{$endif x86_64} + begin + if (right.location.loc in [LOC_CSUBSETREG,LOC_SUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) then + location_force_reg(current_asmdata.CurrAsmList,right.location,def_cgsize(right.resultdef),true); + { left must be a register } + case right.location.loc of + LOC_REGISTER, + LOC_CREGISTER : + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,TCGSize2Opsize[opsize],right.location.register,left.location.register)); + LOC_REFERENCE, + LOC_CREFERENCE : + begin + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,right.location.reference); + current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(op,TCGSize2Opsize[opsize],right.location.reference,left.location.register)); + end; + LOC_CONSTANT : + begin +{$ifdef x86_64} + { x86_64 only supports signed 32 bits constants directly } + if (opsize in [OS_S64,OS_64]) and + ((right.location.value<low(longint)) or (right.location.value>high(longint))) then + begin + tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,opsize); + cg.a_load_const_reg(current_asmdata.CurrAsmList,opsize,right.location.value,tmpreg); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,TCGSize2Opsize[opsize],tmpreg,left.location.register)); + end + else +{$endif x86_64} + current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(op,TCGSize2Opsize[opsize],right.location.value,left.location.register)); + end; + else + internalerror(200203232); + end; + end; + + + function tx86addnode.getresflags(unsigned : boolean) : tresflags; + begin + case nodetype of + equaln : getresflags:=F_E; + unequaln : getresflags:=F_NE; + else + if not(unsigned) then + begin + if nf_swapped in flags then + case nodetype of + ltn : getresflags:=F_G; + lten : getresflags:=F_GE; + gtn : getresflags:=F_L; + gten : getresflags:=F_LE; + end + else + case nodetype of + ltn : getresflags:=F_L; + lten : getresflags:=F_LE; + gtn : getresflags:=F_G; + gten : getresflags:=F_GE; + end; + end + else + begin + if nf_swapped in flags then + case nodetype of + ltn : getresflags:=F_A; + lten : getresflags:=F_AE; + gtn : getresflags:=F_B; + gten : getresflags:=F_BE; + end + else + case nodetype of + ltn : getresflags:=F_B; + lten : getresflags:=F_BE; + gtn : getresflags:=F_A; + gten : getresflags:=F_AE; + end; + end; + end; + end; + + +{***************************************************************************** + AddSmallSet +*****************************************************************************} + + procedure tx86addnode.second_addsmallset; + var + setbase : aint; + opsize : TCGSize; + op : TAsmOp; + extra_not, + noswap : boolean; + all_member_optimization:boolean; + + begin + pass_left_right; + + noswap:=false; + extra_not:=false; + all_member_optimization:=false; + opsize:=int_cgsize(resultdef.size); + if (left.resultdef.typ=setdef) then + setbase:=tsetdef(left.resultdef).setbase + else + setbase:=tsetdef(right.resultdef).setbase; + case nodetype of + addn : + begin + { adding elements is not commutative } + if (nf_swapped in flags) and (left.nodetype=setelementn) then + swapleftright; + { are we adding set elements ? } + if right.nodetype=setelementn then + begin + { no range support for smallsets! } + if assigned(tsetelementnode(right).right) then + internalerror(43244); + { btsb isn't supported } + if opsize=OS_8 then + opsize:=OS_32; + { bts requires both elements to be registers } + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,false); + location_force_reg(current_asmdata.CurrAsmList,right.location,opsize,true); + register_maybe_adjust_setbase(current_asmdata.CurrAsmList,right.location,setbase); + op:=A_BTS; + noswap:=true; + end + else + op:=A_OR; + end; + symdifn : + op:=A_XOR; + muln : + op:=A_AND; + subn : + begin + op:=A_AND; + if (not(nf_swapped in flags) and (left.location.loc=LOC_CONSTANT) and (left.location.value=-1)) or + ((nf_swapped in flags) and (right.location.loc=LOC_CONSTANT) and (right.location.value=-1)) then + all_member_optimization:=true; + + if (not(nf_swapped in flags)) and + (right.location.loc=LOC_CONSTANT) then + right.location.value := not(right.location.value) + else if (nf_swapped in flags) and + (left.location.loc=LOC_CONSTANT) then + left.location.value := not(left.location.value) + else + extra_not:=true; + end; + xorn : + op:=A_XOR; + orn : + op:=A_OR; + andn : + op:=A_AND; + else + internalerror(2003042215); + end; + if all_member_optimization then + begin + {A set expression [0..31]-x can be implemented with a simple NOT.} + if nf_swapped in flags then + begin + { newly swapped also set swapped flag } + location_swap(left.location,right.location); + toggleflag(nf_swapped); + end; + location_force_reg(current_asmdata.currAsmList,right.location,opsize,false); + emit_reg(A_NOT,TCGSize2Opsize[opsize],right.location.register); + location:=right.location; + end + else + begin + { left must be a register } + left_must_be_reg(opsize,noswap); + emit_generic_code(op,opsize,true,extra_not,false); + location_freetemp(current_asmdata.CurrAsmList,right.location); + + { left is always a register and contains the result } + location:=left.location; + end; + + { fix the changed opsize we did above because of the missing btsb } + if opsize<>int_cgsize(resultdef.size) then + location_force_reg(current_asmdata.CurrAsmList,location,int_cgsize(resultdef.size),false); + end; + + + procedure tx86addnode.second_cmpsmallset; + var + opsize : TCGSize; + op : TAsmOp; + begin + pass_left_right; + opsize:=int_cgsize(left.resultdef.size); + case nodetype of + equaln, + unequaln : + op:=A_CMP; + lten,gten: + begin + if (not(nf_swapped in flags) and (nodetype = lten)) or + ((nf_swapped in flags) and (nodetype = gten)) then + swapleftright; + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,false); + emit_op_right_left(A_AND,opsize); + op:=A_CMP; + { warning: ugly hack, we need a JE so change the node to equaln } + nodetype:=equaln; + end; + else + internalerror(2003042215); + end; + { left must be a register } + left_must_be_reg(opsize,false); + emit_generic_code(op,opsize,true,false,false); + location_freetemp(current_asmdata.CurrAsmList,right.location); + location_freetemp(current_asmdata.CurrAsmList,left.location); + + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=getresflags(true); + end; + + +{***************************************************************************** + AddMMX +*****************************************************************************} + +{$ifdef SUPPORT_MMX} + procedure tx86addnode.second_opmmx; + var + op : TAsmOp; + cmpop : boolean; + mmxbase : tmmxtype; + hreg, + hregister : tregister; + begin + pass_left_right; + + cmpop:=false; + mmxbase:=mmx_type(left.resultdef); + location_reset(location,LOC_MMXREGISTER,def_cgsize(resultdef)); + case nodetype of + addn : + begin + if (cs_mmx_saturation in current_settings.localswitches) then + begin + case mmxbase of + mmxs8bit: + op:=A_PADDSB; + mmxu8bit: + op:=A_PADDUSB; + mmxs16bit,mmxfixed16: + op:=A_PADDSW; + mmxu16bit: + op:=A_PADDUSW; + end; + end + else + begin + case mmxbase of + mmxs8bit,mmxu8bit: + op:=A_PADDB; + mmxs16bit,mmxu16bit,mmxfixed16: + op:=A_PADDW; + mmxs32bit,mmxu32bit: + op:=A_PADDD; + end; + end; + end; + muln : + begin + case mmxbase of + mmxs16bit,mmxu16bit: + op:=A_PMULLW; + mmxfixed16: + op:=A_PMULHW; + end; + end; + subn : + begin + if (cs_mmx_saturation in current_settings.localswitches) then + begin + case mmxbase of + mmxs8bit: + op:=A_PSUBSB; + mmxu8bit: + op:=A_PSUBUSB; + mmxs16bit,mmxfixed16: + op:=A_PSUBSB; + mmxu16bit: + op:=A_PSUBUSW; + end; + end + else + begin + case mmxbase of + mmxs8bit,mmxu8bit: + op:=A_PSUBB; + mmxs16bit,mmxu16bit,mmxfixed16: + op:=A_PSUBW; + mmxs32bit,mmxu32bit: + op:=A_PSUBD; + end; + end; + end; + xorn: + op:=A_PXOR; + orn: + op:=A_POR; + andn: + op:=A_PAND; + else + internalerror(2003042214); + end; + + { left and right no register? } + { then one must be demanded } + if (left.location.loc<>LOC_MMXREGISTER) then + begin + if (right.location.loc=LOC_MMXREGISTER) then + begin + location_swap(left.location,right.location); + toggleflag(nf_swapped); + end + else + begin + { register variable ? } + if (left.location.loc=LOC_CMMXREGISTER) then + begin + hregister:=tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList); + emit_reg_reg(A_MOVQ,S_NO,left.location.register,hregister); + end + else + begin + if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then + internalerror(200203245); + + hregister:=tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList); + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,left.location.reference); + emit_ref_reg(A_MOVQ,S_NO,left.location.reference,hregister); + end; + + location_reset(left.location,LOC_MMXREGISTER,OS_NO); + left.location.register:=hregister; + end; + end; + + { at this point, left.location.loc should be LOC_MMXREGISTER } + if right.location.loc<>LOC_MMXREGISTER then + begin + if (nodetype=subn) and (nf_swapped in flags) then + begin + hreg:=tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList); + if right.location.loc=LOC_CMMXREGISTER then + begin + emit_reg_reg(A_MOVQ,S_NO,right.location.register,hreg); + emit_reg_reg(op,S_NO,left.location.register,hreg); + end + else + begin + if not(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then + internalerror(200203247); + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,right.location.reference); + emit_ref_reg(A_MOVQ,S_NO,right.location.reference,hreg); + emit_reg_reg(op,S_NO,left.location.register,hreg); + end; + location.register:=hreg; + end + else + begin + if (right.location.loc=LOC_CMMXREGISTER) then + emit_reg_reg(op,S_NO,right.location.register,left.location.register) + else + begin + if not(right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then + internalerror(200203246); + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,right.location.reference); + emit_ref_reg(op,S_NO,right.location.reference,left.location.register); + end; + location.register:=left.location.register; + end; + end + else + begin + { right.location=LOC_MMXREGISTER } + if (nodetype=subn) and (nf_swapped in flags) then + begin + emit_reg_reg(op,S_NO,left.location.register,right.location.register); + location_swap(left.location,right.location); + toggleflag(nf_swapped); + end + else + begin + emit_reg_reg(op,S_NO,right.location.register,left.location.register); + end; + location.register:=left.location.register; + end; + + location_freetemp(current_asmdata.CurrAsmList,right.location); + if cmpop then + location_freetemp(current_asmdata.CurrAsmList,left.location); + end; +{$endif SUPPORT_MMX} + + +{***************************************************************************** + AddFloat +*****************************************************************************} + + procedure tx86addnode.second_addfloatsse; + var + op : topcg; + sqr_sum : boolean; + tmp : tnode; + begin + sqr_sum:=false; + if (current_settings.fputype>=fpu_sse3) and + use_vectorfpu(resultdef) and + (nodetype in [addn,subn]) and + (left.nodetype=inlinen) and (tinlinenode(left).inlinenumber=in_sqr_real) and + (right.nodetype=inlinen) and (tinlinenode(right).inlinenumber=in_sqr_real) then + begin + sqr_sum:=true; + tmp:=tinlinenode(left).left; + tinlinenode(left).left:=nil; + left.free; + left:=tmp; + + tmp:=tinlinenode(right).left; + tinlinenode(right).left:=nil; + right.free; + right:=tmp; + end; + + pass_left_right; + check_left_and_right_fpureg(false); + + if (nf_swapped in flags) then + { can't use swapleftright if both are on the fpu stack, since then } + { both are "R_ST" -> nothing would change -> manually switch } + if (left.location.loc = LOC_FPUREGISTER) and + (right.location.loc = LOC_FPUREGISTER) then + emit_none(A_FXCH,S_NO) + else + swapleftright; + + case nodetype of + addn : + op:=OP_ADD; + muln : + op:=OP_MUL; + subn : + op:=OP_SUB; + slashn : + op:=OP_DIV; + else + internalerror(200312231); + end; + + location_reset(location,LOC_MMREGISTER,def_cgsize(resultdef)); + + if sqr_sum then + begin + if nf_swapped in flags then + swapleftright; + + location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,false); + location_force_mmregscalar(current_asmdata.CurrAsmList,right.location,true); + location:=left.location; + if is_double(resultdef) then + begin + current_asmdata.CurrAsmList.concat(taicpu.op_const_reg_reg(A_SHUFPD,S_NO,%00,right.location.register,location.register)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_MULPD,S_NO,location.register,location.register)); + case nodetype of + addn: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_HADDPD,S_NO,location.register,location.register)); + subn: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_HSUBPD,S_NO,location.register,location.register)); + else + internalerror(201108162); + end; + end + else + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_UNPCKLPS,S_NO,right.location.register,location.register)); + { ensure that bits 64..127 contain valid values } + current_asmdata.CurrAsmList.concat(taicpu.op_const_reg_reg(A_SHUFPD,S_NO,%00,location.register,location.register)); + { the data is now in bits 0..32 and 64..95 } + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_MULPS,S_NO,location.register,location.register)); + case nodetype of + addn: + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_HADDPS,S_NO,location.register,location.register)); + end; + subn: + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_HSUBPS,S_NO,location.register,location.register)); + end; + else + internalerror(201108163); + end; + end + end + { we can use only right as left operand if the operation is commutative } + else if (right.location.loc=LOC_MMREGISTER) and (op in [OP_ADD,OP_MUL]) then + begin + location.register:=right.location.register; + { force floating point reg. location to be written to memory, + we don't force it to mm register because writing to memory + allows probably shorter code because there is no direct fpu->mm register + copy instruction + } + if left.location.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER] then + location_force_mem(current_asmdata.CurrAsmList,left.location); + cg.a_opmm_loc_reg(current_asmdata.CurrAsmList,op,location.size,left.location,location.register,mms_movescalar); + end + else + begin + if (nf_swapped in flags) then + swapleftright; + + location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,false); + location.register:=left.location.register; + { force floating point reg. location to be written to memory, + we don't force it to mm register because writing to memory + allows probably shorter code because there is no direct fpu->mm register + copy instruction + } + if right.location.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER] then + location_force_mem(current_asmdata.CurrAsmList,right.location); + cg.a_opmm_loc_reg(current_asmdata.CurrAsmList,op,location.size,right.location,location.register,mms_movescalar); + end; + end; + + + procedure tx86addnode.second_cmpfloatsse; + var + op : tasmop; + begin + if is_single(left.resultdef) then + op:=A_COMISS + else if is_double(left.resultdef) then + op:=A_COMISD + else + internalerror(200402222); + pass_left_right; + + location_reset(location,LOC_FLAGS,def_cgsize(resultdef)); + { we can use only right as left operand if the operation is commutative } + if (right.location.loc=LOC_MMREGISTER) then + begin + { force floating point reg. location to be written to memory, + we don't force it to mm register because writing to memory + allows probably shorter code because there is no direct fpu->mm register + copy instruction + } + if left.location.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER] then + location_force_mem(current_asmdata.CurrAsmList,left.location); + case left.location.loc of + LOC_REFERENCE,LOC_CREFERENCE: + begin + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,left.location.reference); + current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(op,S_NO,left.location.reference,right.location.register)); + end; + LOC_MMREGISTER,LOC_CMMREGISTER: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,S_NO,left.location.register,right.location.register)); + else + internalerror(200402221); + end; + if nf_swapped in flags then + exclude(flags,nf_swapped) + else + include(flags,nf_swapped) + end + else + begin + location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,false); + { force floating point reg. location to be written to memory, + we don't force it to mm register because writing to memory + allows probably shorter code because there is no direct fpu->mm register + copy instruction + } + if right.location.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER] then + location_force_mem(current_asmdata.CurrAsmList,right.location); + case right.location.loc of + LOC_REFERENCE,LOC_CREFERENCE: + begin + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,right.location.reference); + current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(op,S_NO,right.location.reference,left.location.register)); + end; + LOC_MMREGISTER,LOC_CMMREGISTER: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,S_NO,right.location.register,left.location.register)); + else + internalerror(200402223); + end; + end; + location.resflags:=getresflags(true); + end; + + + procedure tx86addnode.second_opvector; + var + op : topcg; + begin + pass_left_right; + if (nf_swapped in flags) then + swapleftright; + + case nodetype of + addn : + op:=OP_ADD; + muln : + op:=OP_MUL; + subn : + op:=OP_SUB; + slashn : + op:=OP_DIV; + else + internalerror(200610071); + end; + + if fits_in_mm_register(left.resultdef) then + begin + location_reset(location,LOC_MMREGISTER,def_cgsize(resultdef)); + { we can use only right as left operand if the operation is commutative } + if (right.location.loc=LOC_MMREGISTER) and (op in [OP_ADD,OP_MUL]) then + begin + location.register:=right.location.register; + cg.a_opmm_loc_reg(current_asmdata.CurrAsmList,op,tfloat2tcgsize[tfloatdef(left.resultdef).floattype],left.location,location.register,nil); + end + else + begin + location_force_mmreg(current_asmdata.CurrAsmList,left.location,false); + location.register:=left.location.register; + cg.a_opmm_loc_reg(current_asmdata.CurrAsmList,op, + tfloat2tcgsize[tfloatdef(tarraydef(left.resultdef).elementdef).floattype],right.location,location.register,nil); + end; + end + else + begin + { not yet supported } + internalerror(200610072); + end + end; + + + procedure tx86addnode.second_addfloat; + var + op : TAsmOp; + begin + if use_vectorfpu(resultdef) then + begin + second_addfloatsse; + exit; + end; + + pass_left_right; + + case nodetype of + addn : + op:=A_FADDP; + muln : + op:=A_FMULP; + subn : + op:=A_FSUBP; + slashn : + op:=A_FDIVP; + else + internalerror(2003042214); + end; + + check_left_and_right_fpureg(true); + + { if we swaped the tree nodes, then use the reverse operator } + if nf_swapped in flags then + begin + if (nodetype=slashn) then + op:=A_FDIVRP + else if (nodetype=subn) then + op:=A_FSUBRP; + end; + + emit_reg_reg(op,S_NO,NR_ST,NR_ST1); + tcgx86(cg).dec_fpu_stack; + + location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); + location.register:=NR_ST; + end; + + + procedure tx86addnode.second_cmpfloat; + var + resflags : tresflags; + begin + if use_vectorfpu(left.resultdef) or use_vectorfpu(right.resultdef) then + begin + second_cmpfloatsse; + exit; + end; + + pass_left_right; + check_left_and_right_fpureg(true); + +{$ifndef x86_64} + if current_settings.cputype<cpu_Pentium2 then + begin + emit_none(A_FCOMPP,S_NO); + tcgx86(cg).dec_fpu_stack; + tcgx86(cg).dec_fpu_stack; + + { load fpu flags } + cg.getcpuregister(current_asmdata.CurrAsmList,NR_AX); + emit_reg(A_FSTSW,S_NO,NR_AX); + emit_none(A_SAHF,S_NO); + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_AX); + if nf_swapped in flags then + begin + case nodetype of + equaln : resflags:=F_E; + unequaln : resflags:=F_NE; + ltn : resflags:=F_A; + lten : resflags:=F_AE; + gtn : resflags:=F_B; + gten : resflags:=F_BE; + end; + end + else + begin + case nodetype of + equaln : resflags:=F_E; + unequaln : resflags:=F_NE; + ltn : resflags:=F_B; + lten : resflags:=F_BE; + gtn : resflags:=F_A; + gten : resflags:=F_AE; + end; + end; + end + else +{$endif x86_64} + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FCOMIP,S_NO,NR_ST1,NR_ST0)); + { fcomip pops only one fpu register } + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_FSTP,S_NO,NR_ST0)); + tcgx86(cg).dec_fpu_stack; + tcgx86(cg).dec_fpu_stack; + + { load fpu flags } + if nf_swapped in flags then + begin + case nodetype of + equaln : resflags:=F_E; + unequaln : resflags:=F_NE; + ltn : resflags:=F_A; + lten : resflags:=F_AE; + gtn : resflags:=F_B; + gten : resflags:=F_BE; + end; + end + else + begin + case nodetype of + equaln : resflags:=F_E; + unequaln : resflags:=F_NE; + ltn : resflags:=F_B; + lten : resflags:=F_BE; + gtn : resflags:=F_A; + gten : resflags:=F_AE; + end; + end; + end; + + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=resflags; + end; + + +{***************************************************************************** + Add64bit +*****************************************************************************} + + procedure tx86addnode.second_add64bit; + begin +{$ifdef cpu64bitalu} + second_addordinal; +{$else cpu64bitalu} + { must be implemented separate } + internalerror(200402042); +{$endif cpu64bitalu} + end; + + + procedure tx86addnode.second_cmp64bit; + begin +{$ifdef cpu64bitalu} + second_cmpordinal; +{$else cpu64bitalu} + { must be implemented separate } + internalerror(200402043); +{$endif cpu64bitalu} + end; + + +{***************************************************************************** + AddOrdinal +*****************************************************************************} + + procedure tx86addnode.second_cmpordinal; + var + opsize : tcgsize; + unsigned : boolean; + begin + unsigned:=not(is_signed(left.resultdef)) or + not(is_signed(right.resultdef)); + opsize:=def_cgsize(left.resultdef); + + pass_left_right; + + left_must_be_reg(opsize,false); + emit_generic_code(A_CMP,opsize,unsigned,false,false); + location_freetemp(current_asmdata.CurrAsmList,right.location); + location_freetemp(current_asmdata.CurrAsmList,left.location); + + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=getresflags(unsigned); + end; + +begin + caddnode:=tx86addnode; +end. diff --git a/closures/compiler/x86/nx86cnv.pas b/closures/compiler/x86/nx86cnv.pas new file mode 100644 index 0000000000..7884c5c803 --- /dev/null +++ b/closures/compiler/x86/nx86cnv.pas @@ -0,0 +1,378 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate for x86-64 and i386 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 nx86cnv; + +{$i fpcdefs.inc} + +interface + + uses + node,ncgcnv,defutil,defcmp; + + type + tx86typeconvnode = class(tcgtypeconvnode) + protected + function first_real_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; } + { procedure second_pointer_to_array;override; } + { procedure second_chararray_to_string;override; } + { procedure second_char_to_string;override; } + function first_int_to_real: tnode; 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_set_to_set;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,systems,globals,globtype, + aasmbase,aasmtai,aasmdata,aasmcpu, + symconst,symdef, + cgbase,cga,procinfo,pass_1,pass_2, + ncon,ncal,ncnv, + cpubase, + cgutils,cgobj,cgx86,ncgutil, + tgobj; + + + function tx86typeconvnode.first_real_to_real : tnode; + begin + first_real_to_real:=nil; + { comp isn't a floating type } + if (tfloatdef(resultdef).floattype=s64comp) and + (tfloatdef(left.resultdef).floattype<>s64comp) and + not (nf_explicit in flags) then + CGMessage(type_w_convert_real_2_comp); + if use_vectorfpu(resultdef) then + expectloc:=LOC_MMREGISTER + else + expectloc:=LOC_FPUREGISTER; + end; + + + procedure tx86typeconvnode.second_int_to_bool; + var +{$ifndef cpu64bitalu} + hreg2, + hregister : tregister; + href : treference; +{$endif not cpu64bitalu} + resflags : tresflags; + hlabel,oldTrueLabel,oldFalseLabel : tasmlabel; + newsize : tcgsize; + begin + oldTrueLabel:=current_procinfo.CurrTrueLabel; + oldFalseLabel:=current_procinfo.CurrFalseLabel; + current_asmdata.getjumplabel(current_procinfo.CurrTrueLabel); + current_asmdata.getjumplabel(current_procinfo.CurrFalseLabel); + secondpass(left); + if codegenerror then + exit; + { Explicit typecasts from any ordinal type to a boolean type } + { must not change the ordinal value } + if (nf_explicit in flags) and + not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) then + begin + location_copy(location,left.location); + newsize:=def_cgsize(resultdef); + { change of size? change sign only if location is LOC_(C)REGISTER? Then we have to sign/zero-extend } + if (tcgsize2size[newsize]<>tcgsize2size[left.location.size]) or + ((newsize<>left.location.size) and (location.loc in [LOC_REGISTER,LOC_CREGISTER])) then + location_force_reg(current_asmdata.CurrAsmList,location,newsize,true) + else + location.size:=newsize; + current_procinfo.CurrTrueLabel:=oldTrueLabel; + current_procinfo.CurrFalseLabel:=oldFalseLabel; + exit; + end; + + { Load left node into flag F_NE/F_E } + resflags:=F_NE; + + if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) then + location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,true); + + case left.location.loc of + LOC_CREFERENCE, + LOC_REFERENCE : + begin +{$ifndef cpu64bitalu} + if left.location.size in [OS_64,OS_S64] then + begin + hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.reference,hregister); + href:=left.location.reference; + inc(href.offset,4); + cg.a_op_ref_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,href,hregister); + end + else +{$endif not cpu64bitalu} + begin + location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,true); + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,left.location.size,left.location.register,left.location.register); + end; + end; + LOC_FLAGS : + begin + resflags:=left.location.resflags; + end; + LOC_REGISTER,LOC_CREGISTER : + begin +{$ifndef cpu64bitalu} + if left.location.size in [OS_64,OS_S64] then + begin + hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.register64.reglo,hregister); + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,left.location.register64.reghi,hregister); + end + else +{$endif not cpu64bitalu} + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_OR,left.location.size,left.location.register,left.location.register); + end; + LOC_JUMP : + begin + location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); + location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size); + current_asmdata.getjumplabel(hlabel); + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel); + if not(is_cbool(resultdef)) then + cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,1,location.register) + else + cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,-1,location.register); + cg.a_jmp_always(current_asmdata.CurrAsmList,hlabel); + cg.a_label(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + cg.a_load_const_reg(current_asmdata.CurrAsmList,location.size,0,location.register); + cg.a_label(current_asmdata.CurrAsmList,hlabel); + end; + else + internalerror(10062); + end; + if (left.location.loc<>LOC_JUMP) then + begin + { load flags to register } + location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); +{$ifndef cpu64bitalu} + if (location.size in [OS_64,OS_S64]) then + begin + hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + cg.g_flags2reg(current_asmdata.CurrAsmList,OS_32,resflags,hreg2); + if (is_cbool(resultdef)) then + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,OS_32,hreg2,hreg2); + location.register64.reglo:=hreg2; + location.register64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + if (is_cbool(resultdef)) then + { reglo is either 0 or -1 -> reghi has to become the same } + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_32,OS_32,location.register64.reglo,location.register64.reghi) + else + { unsigned } + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,0,location.register64.reghi); + end + else +{$endif not cpu64bitalu} + begin + location.register:=cg.getintregister(current_asmdata.CurrAsmList,location.size); + cg.g_flags2reg(current_asmdata.CurrAsmList,location.size,resflags,location.register); + if (is_cbool(resultdef)) then + cg.a_op_reg_reg(current_asmdata.CurrAsmList,OP_NEG,location.size,location.register,location.register); + end + end; + current_procinfo.CurrTrueLabel:=oldTrueLabel; + current_procinfo.CurrFalseLabel:=oldFalseLabel; + end; + + + function tx86typeconvnode.first_int_to_real : tnode; + + begin + first_int_to_real:=nil; + if (left.resultdef.size<4) then + begin + inserttypeconv(left,s32inttype); + firstpass(left) + end; + + if use_vectorfpu(resultdef) and + (torddef(left.resultdef).ordtype = s32bit) then + expectloc:=LOC_MMREGISTER + else + expectloc:=LOC_FPUREGISTER; + end; + + + procedure tx86typeconvnode.second_int_to_real; + + var + leftref, + href : treference; + l1,l2 : tasmlabel; + op: tasmop; + opsize: topsize; + signtested : boolean; + begin + if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_REFERENCE,LOC_CREFERENCE]) then + location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,false); + if use_vectorfpu(resultdef) and +{$ifdef cpu64bitalu} + (torddef(left.resultdef).ordtype in [s32bit,s64bit]) then +{$else cpu64bitalu} + (torddef(left.resultdef).ordtype=s32bit) then +{$endif cpu64bitalu} + begin + location_reset(location,LOC_MMREGISTER,def_cgsize(resultdef)); + location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size); + case location.size of + OS_F32: + op:=A_CVTSI2SS; + OS_F64: + op:=A_CVTSI2SD; + else + internalerror(2007120902); + end; + { don't use left.location.size, because that one may be OS_32/OS_64 + if the lower bound of the orddef >= 0 + } + case torddef(left.resultdef).ordtype of + s32bit: + opsize:=S_L; + s64bit: + opsize:=S_Q; + else + internalerror(2007120903); + end; + case left.location.loc of + LOC_REFERENCE, + LOC_CREFERENCE: + begin + href:=left.location.reference; + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,href); + current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(op,opsize,href,location.register)); + end; + LOC_REGISTER, + LOC_CREGISTER: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,opsize,left.location.register,location.register)); + end; + end + else + begin + location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); + if (left.location.loc=LOC_REGISTER) and (torddef(left.resultdef).ordtype=u64bit) then + begin + {$ifdef cpu64bitalu} + emit_const_reg(A_BT,S_Q,63,left.location.register); + {$else cpu64bitalu} + emit_const_reg(A_BT,S_L,31,left.location.register64.reghi); + {$endif cpu64bitalu} + signtested:=true; + end + else + signtested:=false; + + { We need to load from a reference } + location_force_mem(current_asmdata.CurrAsmList,left.location); + { don't change left.location.reference, because if it's a temp we + need the original location at the end so we can free it } + leftref:=left.location.reference; + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,leftref); + + { For u32bit we need to load it as comp and need to + make it 64bits } + if (torddef(left.resultdef).ordtype=u32bit) then + begin + tg.GetTemp(current_asmdata.CurrAsmList,8,8,tt_normal,href); + location_freetemp(current_asmdata.CurrAsmList,left.location); + cg.a_load_ref_ref(current_asmdata.CurrAsmList,left.location.size,OS_32,leftref,href); + inc(href.offset,4); + cg.a_load_const_ref(current_asmdata.CurrAsmList,OS_32,0,href); + dec(href.offset,4); + { could be a temp with an offset > 32 bit on x86_64 } + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,href); + leftref:=href; + end; + + { Load from reference to fpu reg } + case torddef(left.resultdef).ordtype of + u32bit, + scurrency, + s64bit: + begin + current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_FILD,S_IQ,leftref)); + end; + u64bit: + begin + { unsigned 64 bit ints are harder to handle: + we load bits 0..62 and then check bit 63: + if it is 1 then we add $80000000 000000000 + as double } + current_asmdata.getdatalabel(l1); + current_asmdata.getjumplabel(l2); + + if not(signtested) then + begin + inc(leftref.offset,4); + emit_const_ref(A_BT,S_L,31,leftref); + dec(leftref.offset,4); + end; + + current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_FILD,S_IQ,leftref)); + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NC,l2); + new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,l1.name,const_align(sizeof(pint))); + current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l1)); + { I got this constant from a test program (FK) } + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit(0)); + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit(longint ($80000000))); + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit($0000403f)); + reference_reset_symbol(href,l1,0,4); + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,href); + current_asmdata.CurrAsmList.concat(Taicpu.Op_ref(A_FLD,S_FX,href)); + current_asmdata.CurrAsmList.concat(Taicpu.Op_reg_reg(A_FADDP,S_NO,NR_ST,NR_ST1)); + cg.a_label(current_asmdata.CurrAsmList,l2); + end + else + begin + if left.resultdef.size<4 then + internalerror(2007120901); + current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_FILD,S_IL,leftref)); + end; + end; + tcgx86(cg).inc_fpu_stack; + location.register:=NR_ST; + end; + location_freetemp(current_asmdata.CurrAsmList,left.location); + end; + +begin + ctypeconvnode:=tx86typeconvnode +end. diff --git a/closures/compiler/x86/nx86con.pas b/closures/compiler/x86/nx86con.pas new file mode 100644 index 0000000000..90c1fca2f2 --- /dev/null +++ b/closures/compiler/x86/nx86con.pas @@ -0,0 +1,90 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate i386 assembler for constants + + 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 nx86con; + +{$i fpcdefs.inc} + +interface + + uses + node,ncon,ncgcon; + + type + tx86realconstnode = class(tcgrealconstnode) + function pass_1 : tnode;override; + procedure pass_generate_code;override; + end; + +implementation + + uses + systems,globals, + symdef, + defutil, + cpubase, + cga,cgx86,cgobj,cgbase,cgutils; + +{***************************************************************************** + TI386REALCONSTNODE +*****************************************************************************} + + function tx86realconstnode.pass_1 : tnode; + begin + result:=nil; + if is_number_float(value_real) and not(use_vectorfpu(resultdef)) and (value_real=1.0) or (value_real=0.0) then + expectloc:=LOC_FPUREGISTER + else + expectloc:=LOC_CREFERENCE; + end; + + procedure tx86realconstnode.pass_generate_code; + + begin + if is_number_float(value_real) then + begin + if (value_real=1.0) and not(use_vectorfpu(resultdef)) then + begin + emit_none(A_FLD1,S_NO); + location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); + location.register:=NR_ST; + tcgx86(cg).inc_fpu_stack; + end + else if (value_real=0.0) and not(use_vectorfpu(resultdef)) then + begin + emit_none(A_FLDZ,S_NO); + if (get_real_sign(value_real) < 0) then + emit_none(A_FCHS,S_NO); + location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); + location.register:=NR_ST; + tcgx86(cg).inc_fpu_stack; + end + else + inherited pass_generate_code; + end + else + inherited pass_generate_code; + end; + + +begin + crealconstnode:=tx86realconstnode; +end. diff --git a/closures/compiler/x86/nx86inl.pas b/closures/compiler/x86/nx86inl.pas new file mode 100644 index 0000000000..0aa25780df --- /dev/null +++ b/closures/compiler/x86/nx86inl.pas @@ -0,0 +1,534 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate x86 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 nx86inl; + +{$i fpcdefs.inc} + +interface + + uses + node,ninl,ncginl; + + type + tx86inlinenode = class(tcginlinenode) + { first pass override + so that the code generator will actually generate + these nodes. + } + function first_pi: tnode ; override; + function first_arctan_real: tnode; override; + function first_abs_real: tnode; override; + function first_sqr_real: tnode; override; + function first_sqrt_real: tnode; override; + function first_ln_real: tnode; override; + function first_cos_real: tnode; override; + function first_sin_real: tnode; override; + function first_round_real: tnode; override; + function first_trunc_real: tnode; override; + { second pass override to generate these nodes } + procedure second_IncludeExclude;override; + procedure second_pi; override; + procedure second_arctan_real; override; + procedure second_abs_real; override; + procedure second_round_real; override; + procedure second_sqr_real; override; + procedure second_sqrt_real; override; + procedure second_ln_real; override; + procedure second_cos_real; override; + procedure second_sin_real; override; + procedure second_trunc_real; override; + + procedure second_prefetch;override; + + procedure second_abs_long;override; + private + procedure load_fpu_location; + end; + +implementation + + uses + systems, + globtype,globals, + cutils,verbose, + symconst, + defutil, + aasmbase,aasmtai,aasmdata,aasmcpu, + symdef, + cgbase,pass_2, + cpuinfo,cpubase,paramgr, + nbas,ncon,ncal,ncnv,nld,ncgutil, + tgobj, + cga,cgutils,cgx86,cgobj; + + +{***************************************************************************** + TX86INLINENODE +*****************************************************************************} + + function tx86inlinenode.first_pi : tnode; + begin + expectloc:=LOC_FPUREGISTER; + first_pi := nil; + end; + + + function tx86inlinenode.first_arctan_real : tnode; + begin + expectloc:=LOC_FPUREGISTER; + first_arctan_real := nil; + end; + + function tx86inlinenode.first_abs_real : tnode; + begin + if use_vectorfpu(resultdef) then + expectloc:=LOC_MMREGISTER + else + expectloc:=LOC_FPUREGISTER; + first_abs_real := nil; + end; + + function tx86inlinenode.first_sqr_real : tnode; + begin + expectloc:=LOC_FPUREGISTER; + first_sqr_real := nil; + end; + + function tx86inlinenode.first_sqrt_real : tnode; + begin + expectloc:=LOC_FPUREGISTER; + first_sqrt_real := nil; + end; + + function tx86inlinenode.first_ln_real : tnode; + begin + expectloc:=LOC_FPUREGISTER; + first_ln_real := nil; + end; + + function tx86inlinenode.first_cos_real : tnode; + begin + expectloc:=LOC_FPUREGISTER; + first_cos_real := nil; + end; + + function tx86inlinenode.first_sin_real : tnode; + begin + expectloc:=LOC_FPUREGISTER; + first_sin_real := nil; + end; + + + function tx86inlinenode.first_round_real : tnode; + begin +{$ifdef x86_64} + if use_vectorfpu(left.resultdef) then + expectloc:=LOC_REGISTER + else +{$endif x86_64} + expectloc:=LOC_REFERENCE; + result:=nil; + end; + + + function tx86inlinenode.first_trunc_real: tnode; + begin + if (cs_opt_size in current_settings.optimizerswitches) +{$ifdef x86_64} + and not(use_vectorfpu(left.resultdef)) +{$endif x86_64} + then + result:=inherited + else + begin +{$ifdef x86_64} + if use_vectorfpu(left.resultdef) then + expectloc:=LOC_REGISTER + else +{$endif x86_64} + expectloc:=LOC_REFERENCE; + result:=nil; + end; + end; + + + procedure tx86inlinenode.second_Pi; + begin + location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); + emit_none(A_FLDPI,S_NO); + tcgx86(cg).inc_fpu_stack; + location.register:=NR_FPU_RESULT_REG; + end; + + { load the FPU into the an fpu register } + procedure tx86inlinenode.load_fpu_location; + begin + location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); + location.register:=NR_FPU_RESULT_REG; + secondpass(left); + case left.location.loc of + LOC_FPUREGISTER: + ; + LOC_CFPUREGISTER: + begin + cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.location.size, + left.location.size,left.location.register,location.register); + end; + LOC_REFERENCE,LOC_CREFERENCE: + begin + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList, + left.location.size,left.location.size, + left.location.reference,location.register); + end; + LOC_MMREGISTER,LOC_CMMREGISTER: + begin + location:=left.location; + location_force_fpureg(current_asmdata.CurrAsmList,location,false); + end; + else + internalerror(309991); + end; + end; + + + procedure tx86inlinenode.second_arctan_real; + begin + load_fpu_location; + emit_none(A_FLD1,S_NO); + emit_none(A_FPATAN,S_NO); + end; + + + procedure tx86inlinenode.second_abs_real; + var + href : treference; + begin + if use_vectorfpu(resultdef) then + begin + secondpass(left); + location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,false); + location:=left.location; + case tfloatdef(resultdef).floattype of + s32real: + reference_reset_symbol(href,current_asmdata.RefAsmSymbol('FPC_ABSMASK_SINGLE'),0,4); + s64real: + reference_reset_symbol(href,current_asmdata.RefAsmSymbol('FPC_ABSMASK_DOUBLE'),0,4); + else + internalerror(200506081); + end; + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList, href); + current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(A_ANDPS,S_XMM,href,location.register)) + end + else + begin + load_fpu_location; + emit_none(A_FABS,S_NO); + end; + end; + + + procedure tx86inlinenode.second_round_real; + begin +{$ifdef x86_64} + if use_vectorfpu(left.resultdef) then + begin + secondpass(left); + location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,false); + location_reset(location,LOC_REGISTER,OS_S64); + location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_S64); + case left.location.size of + OS_F32: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTSS2SI,S_Q,left.location.register,location.register)); + OS_F64: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTSD2SI,S_Q,left.location.register,location.register)); + else + internalerror(2007031402); + end; + end + else +{$endif x86_64} + begin + load_fpu_location; + location_reset_ref(location,LOC_REFERENCE,OS_S64,0); + tg.GetTemp(current_asmdata.CurrAsmList,resultdef.size,resultdef.alignment,tt_normal,location.reference); + emit_ref(A_FISTP,S_IQ,location.reference); + emit_none(A_FWAIT,S_NO); + end; + end; + + + procedure tx86inlinenode.second_trunc_real; + var + oldcw,newcw : treference; + begin +{$ifdef x86_64} + if use_vectorfpu(left.resultdef) and + not((left.location.loc=LOC_FPUREGISTER) and (current_settings.fputype>=fpu_sse3)) then + begin + secondpass(left); + location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,false); + location_reset(location,LOC_REGISTER,OS_S64); + location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_S64); + case left.location.size of + OS_F32: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTTSS2SI,S_Q,left.location.register,location.register)); + OS_F64: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTTSD2SI,S_Q,left.location.register,location.register)); + else + internalerror(2007031401); + end; + end + else +{$endif x86_64} + begin + if (current_settings.fputype>=fpu_sse3) then + begin + load_fpu_location; + location_reset_ref(location,LOC_REFERENCE,OS_S64,0); + tg.GetTemp(current_asmdata.CurrAsmList,resultdef.size,resultdef.alignment,tt_normal,location.reference); + emit_ref(A_FISTTP,S_IQ,location.reference); + end + else + begin + tg.GetTemp(current_asmdata.CurrAsmList,2,2,tt_normal,oldcw); + tg.GetTemp(current_asmdata.CurrAsmList,2,2,tt_normal,newcw); + emit_ref(A_FNSTCW,S_NO,newcw); + emit_ref(A_FNSTCW,S_NO,oldcw); + emit_const_ref(A_OR,S_W,$0f00,newcw); + load_fpu_location; + emit_ref(A_FLDCW,S_NO,newcw); + location_reset_ref(location,LOC_REFERENCE,OS_S64,0); + tg.GetTemp(current_asmdata.CurrAsmList,resultdef.size,resultdef.alignment,tt_normal,location.reference); + emit_ref(A_FISTP,S_IQ,location.reference); + emit_ref(A_FLDCW,S_NO,oldcw); + emit_none(A_FWAIT,S_NO); + tg.UnGetTemp(current_asmdata.CurrAsmList,oldcw); + tg.UnGetTemp(current_asmdata.CurrAsmList,newcw); + end; + end; + end; + + + procedure tx86inlinenode.second_sqr_real; + + begin + if use_vectorfpu(resultdef) then + begin + secondpass(left); + location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,false); + location:=left.location; + cg.a_opmm_loc_reg(current_asmdata.CurrAsmList,OP_MUL,left.location.size,left.location,left.location.register,mms_movescalar); + end + else + begin + load_fpu_location; + emit_reg_reg(A_FMUL,S_NO,NR_ST0,NR_ST0); + end; + end; + + + procedure tx86inlinenode.second_sqrt_real; + begin + if use_vectorfpu(resultdef) then + begin + secondpass(left); + location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,false); + location:=left.location; + case tfloatdef(resultdef).floattype of + s32real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_SQRTSS,S_XMM,location.register,location.register)); + s64real: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_SQRTSD,S_XMM,location.register,location.register)); + else + internalerror(200510031); + end; + end + else + begin + load_fpu_location; + emit_none(A_FSQRT,S_NO); + end; + end; + + procedure tx86inlinenode.second_ln_real; + begin + load_fpu_location; + emit_none(A_FLDLN2,S_NO); + emit_none(A_FXCH,S_NO); + emit_none(A_FYL2X,S_NO); + end; + + procedure tx86inlinenode.second_cos_real; + begin + load_fpu_location; + emit_none(A_FCOS,S_NO); + end; + + procedure tx86inlinenode.second_sin_real; + begin + load_fpu_location; + emit_none(A_FSIN,S_NO) + end; + + procedure tx86inlinenode.second_prefetch; + var + ref : treference; + r : tregister; + begin +{$ifdef i386} + if current_settings.cputype>=cpu_Pentium3 then +{$endif i386} + begin + secondpass(left); + case left.location.loc of + LOC_CREFERENCE, + LOC_REFERENCE: + begin + r:=cg.getintregister(current_asmdata.CurrAsmList,OS_ADDR); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.location.reference,r); + reference_reset_base(ref,r,0,left.location.reference.alignment); + current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_PREFETCHNTA,S_NO,ref)); + end; + else + internalerror(200402021); + end; + end; + end; + + + procedure tx86inlinenode.second_abs_long; + var + hregister : tregister; + opsize : tcgsize; + hp : taicpu; + begin +{$ifdef i386} + if current_settings.cputype<cpu_Pentium2 then + begin + opsize:=def_cgsize(left.resultdef); + secondpass(left); + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,false); + location:=left.location; + location.register:=cg.getintregister(current_asmdata.CurrAsmList,opsize); + emit_reg_reg(A_MOV,S_L,left.location.register,location.register); + emit_const_reg(A_SAR,tcgsize2opsize[opsize],31,left.location.register); + emit_reg_reg(A_XOR,S_L,left.location.register,location.register); + emit_reg_reg(A_SUB,S_L,left.location.register,location.register); + end + else +{$endif i386} + begin + opsize:=def_cgsize(left.resultdef); + secondpass(left); + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,true); + hregister:=cg.getintregister(current_asmdata.CurrAsmList,opsize); + location:=left.location; + location.register:=cg.getintregister(current_asmdata.CurrAsmList,opsize); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,opsize,opsize,left.location.register,hregister); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,opsize,opsize,left.location.register,location.register); + emit_reg(A_NEG,tcgsize2opsize[opsize],hregister); + hp:=taicpu.op_reg_reg(A_CMOVcc,tcgsize2opsize[opsize],hregister,location.register); + hp.condition:=C_NS; + current_asmdata.CurrAsmList.concat(hp); + end; + end; + +{***************************************************************************** + INCLUDE/EXCLUDE GENERIC HANDLING +*****************************************************************************} + + procedure tx86inlinenode.second_IncludeExclude; + var + hregister, + hregister2: tregister; + setbase : aint; + bitsperop,l : longint; + cgop : topcg; + asmop : tasmop; + opsize, + orgsize: tcgsize; + begin + if is_smallset(tcallparanode(left).resultdef) then + opsize:=int_cgsize(tcallparanode(left).resultdef.size) + else + opsize:=OS_32; + bitsperop:=(8*tcgsize2size[opsize]); + secondpass(tcallparanode(left).left); + secondpass(tcallparanode(tcallparanode(left).right).left); + setbase:=tsetdef(tcallparanode(left).left.resultdef).setbase; + if tcallparanode(tcallparanode(left).right).left.location.loc=LOC_CONSTANT then + begin + { calculate bit position } + l:=1 shl ((tcallparanode(tcallparanode(left).right).left.location.value-setbase) mod bitsperop); + + { determine operator } + if inlinenumber=in_include_x_y then + cgop:=OP_OR + else + begin + cgop:=OP_AND; + l:=not(l); + end; + case tcallparanode(left).left.location.loc of + LOC_REFERENCE : + begin + inc(tcallparanode(left).left.location.reference.offset, + ((tcallparanode(tcallparanode(left).right).left.location.value-setbase) div bitsperop)*tcgsize2size[opsize]); + cg.a_op_const_ref(current_asmdata.CurrAsmList,cgop,opsize,l,tcallparanode(left).left.location.reference); + end; + LOC_CREGISTER : + cg.a_op_const_reg(current_asmdata.CurrAsmList,cgop,tcallparanode(left).left.location.size,l,tcallparanode(left).left.location.register); + else + internalerror(200405022); + end; + end + else + begin + orgsize:=opsize; + if opsize in [OS_8,OS_S8] then + begin + opsize:=OS_32; + end; + { determine asm operator } + if inlinenumber=in_include_x_y then + asmop:=A_BTS + else + asmop:=A_BTR; + + location_force_reg(current_asmdata.CurrAsmList,tcallparanode(tcallparanode(left).right).left.location,opsize,true); + register_maybe_adjust_setbase(current_asmdata.CurrAsmList,tcallparanode(tcallparanode(left).right).left.location,setbase); + hregister:=tcallparanode(tcallparanode(left).right).left.location.register; + if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then + emit_reg_ref(asmop,tcgsize2opsize[opsize],hregister,tcallparanode(left).left.location.reference) + else + begin + { second argument can't be an 8 bit register either } + hregister2:=tcallparanode(left).left.location.register; + if (orgsize in [OS_8,OS_S8]) then + hregister2:=cg.makeregsize(current_asmdata.CurrAsmList,hregister2,opsize); + emit_reg_reg(asmop,tcgsize2opsize[opsize],hregister,hregister2); + end; + end; + end; + + +end. diff --git a/closures/compiler/x86/nx86mat.pas b/closures/compiler/x86/nx86mat.pas new file mode 100644 index 0000000000..37999b611f --- /dev/null +++ b/closures/compiler/x86/nx86mat.pas @@ -0,0 +1,309 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate x86 code 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 nx86mat; + +{$i fpcdefs.inc} + +interface + + uses + node,nmat,ncgmat; + + type + tx86unaryminusnode = class(tcgunaryminusnode) +{$ifdef SUPPORT_MMX} + procedure second_mmx;override; +{$endif SUPPORT_MMX} + procedure second_float;override; + function pass_1:tnode;override; + end; + + tx86notnode = class(tcgnotnode) + procedure second_boolean;override; +{$ifdef SUPPORT_MMX} + procedure second_mmx;override; +{$endif SUPPORT_MMX} + end; + + implementation + + uses + globtype, + systems, + cutils,verbose,globals, + symconst,symdef, + aasmbase,aasmtai,aasmdata,defutil, + cgbase,pass_1,pass_2, + ncon, + cpubase,procinfo, + cga,ncgutil,cgobj,cgx86,cgutils; + + +{***************************************************************************** + TI386UNARYMINUSNODE +*****************************************************************************} + + function tx86unaryminusnode.pass_1 : tnode; + begin + result:=nil; + firstpass(left); + if codegenerror then + exit; + + if (left.resultdef.typ=floatdef) then + begin + if use_vectorfpu(left.resultdef) then + expectloc:=LOC_MMREGISTER + else + expectloc:=LOC_FPUREGISTER; + end +{$ifdef SUPPORT_MMX} + else + if (cs_mmx in current_settings.localswitches) and + is_mmx_able_array(left.resultdef) then + begin + expectloc:=LOC_MMXREGISTER; + end +{$endif SUPPORT_MMX} + else + inherited pass_1; + end; + + +{$ifdef SUPPORT_MMX} + procedure tx86unaryminusnode.second_mmx; + var + op : tasmop; + hreg : tregister; + begin + secondpass(left); + location_reset(location,LOC_MMXREGISTER,OS_NO); + hreg:=tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList); + emit_reg_reg(A_PXOR,S_NO,hreg,hreg); + case left.location.loc of + LOC_MMXREGISTER: + begin + location.register:=left.location.register; + end; + LOC_CMMXREGISTER: + begin + location.register:=tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList); + emit_reg_reg(A_MOVQ,S_NO,left.location.register,location.register); + end; + LOC_REFERENCE, + LOC_CREFERENCE: + begin + location.register:=tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList); + emit_ref_reg(A_MOVQ,S_NO,left.location.reference,location.register); + end; + else + internalerror(200203225); + end; + if cs_mmx_saturation in current_settings.localswitches then + case mmx_type(resultdef) of + mmxs8bit: + op:=A_PSUBSB; + mmxu8bit: + op:=A_PSUBUSB; + mmxs16bit,mmxfixed16: + op:=A_PSUBSW; + mmxu16bit: + op:=A_PSUBUSW; + end + else + case mmx_type(resultdef) of + mmxs8bit,mmxu8bit: + op:=A_PSUBB; + mmxs16bit,mmxu16bit,mmxfixed16: + op:=A_PSUBW; + mmxs32bit,mmxu32bit: + op:=A_PSUBD; + end; + emit_reg_reg(op,S_NO,location.register,hreg); + emit_reg_reg(A_MOVQ,S_NO,hreg,location.register); + end; +{$endif SUPPORT_MMX} + + + procedure tx86unaryminusnode.second_float; + var + reg : tregister; + href : treference; + l1 : tasmlabel; + begin + secondpass(left); + + if expectloc=LOC_MMREGISTER then + begin + location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,false); + location_reset(location,LOC_MMREGISTER,def_cgsize(resultdef)); + + { make life of register allocator easier } + location.register:=cg.getmmregister(current_asmdata.CurrAsmList,def_cgsize(resultdef)); + cg.a_loadmm_reg_reg(current_asmdata.CurrAsmList,def_cgsize(resultdef),def_cgsize(resultdef),left.location.register,location.register,mms_movescalar); + + reg:=cg.getmmregister(current_asmdata.CurrAsmList,def_cgsize(resultdef)); + + current_asmdata.getdatalabel(l1); + new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,l1.name,const_align(sizeof(pint))); + current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l1)); + case def_cgsize(resultdef) of + OS_F32: + current_asmdata.asmlists[al_typedconsts].concat(tai_const.create_32bit(longint(1 shl 31))); + OS_F64: + begin + current_asmdata.asmlists[al_typedconsts].concat(tai_const.create_32bit(0)); + current_asmdata.asmlists[al_typedconsts].concat(tai_const.create_32bit(-(1 shl 31))); + end + else + internalerror(2004110215); + end; + + reference_reset_symbol(href,l1,0,resultdef.alignment); + cg.a_loadmm_ref_reg(current_asmdata.CurrAsmList,def_cgsize(resultdef),def_cgsize(resultdef),href,reg,mms_movescalar); + + cg.a_opmm_reg_reg(current_asmdata.CurrAsmList,OP_XOR,left.location.size,reg,location.register,nil); + end + else + begin + location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); + case left.location.loc of + LOC_REFERENCE, + LOC_CREFERENCE: + begin + location.register:=NR_ST; + cg.a_loadfpu_ref_reg(current_asmdata.CurrAsmList, + left.location.size,location.size, + left.location.reference,location.register); + emit_none(A_FCHS,S_NO); + end; + LOC_FPUREGISTER, + LOC_CFPUREGISTER: + begin + { "load st,st" is ignored by the code generator } + cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmList,left.location.size,location.size,left.location.register,NR_ST); + location.register:=NR_ST; + emit_none(A_FCHS,S_NO); + end; + else + internalerror(200312241); + end; + end; + end; + + +{***************************************************************************** + TX86NOTNODE +*****************************************************************************} + + procedure tx86notnode.second_boolean; + var + hl : tasmlabel; + opsize : tcgsize; + begin + opsize:=def_cgsize(resultdef); + + if left.expectloc=LOC_JUMP then + begin + location_reset(location,LOC_JUMP,OS_NO); + hl:=current_procinfo.CurrTrueLabel; + current_procinfo.CurrTrueLabel:=current_procinfo.CurrFalseLabel; + current_procinfo.CurrFalseLabel:=hl; + secondpass(left); + maketojumpbool(current_asmdata.CurrAsmList,left,lr_load_regvars); + hl:=current_procinfo.CurrTrueLabel; + current_procinfo.CurrTrueLabel:=current_procinfo.CurrFalseLabel; + current_procinfo.CurrFalseLabel:=hl; + end + else + begin + { the second pass could change the location of left } + { if it is a register variable, so we've to do } + { this before the case statement } + secondpass(left); + case left.expectloc of + LOC_FLAGS : + begin + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=left.location.resflags; + inverse_flags(location.resflags); + end; + LOC_CONSTANT, + LOC_REGISTER, + LOC_CREGISTER, + LOC_REFERENCE, + LOC_CREFERENCE, + LOC_SUBSETREG, + LOC_CSUBSETREG, + LOC_SUBSETREF, + LOC_CSUBSETREF : + begin + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,true); + emit_reg_reg(A_TEST,TCGSize2Opsize[opsize],left.location.register,left.location.register); + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=F_E; + end; + else + internalerror(200203224); + end; + end; + end; + + +{$ifdef SUPPORT_MMX} + procedure tx86notnode.second_mmx; + + var hreg,r:Tregister; + + begin + secondpass(left); + location_reset(location,LOC_MMXREGISTER,OS_NO); + r:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + emit_const_reg(A_MOV,S_L,longint($ffffffff),r); + { load operand } + case left.location.loc of + LOC_MMXREGISTER: + location_copy(location,left.location); + LOC_CMMXREGISTER: + begin + location.register:=tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList); + emit_reg_reg(A_MOVQ,S_NO,left.location.register,location.register); + end; + LOC_REFERENCE, + LOC_CREFERENCE: + begin + location.register:=tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList); + emit_ref_reg(A_MOVQ,S_NO,left.location.reference,location.register); + end; + end; + { load mask } + hreg:=tcgx86(cg).getmmxregister(current_asmdata.CurrAsmList); + emit_reg_reg(A_MOVD,S_NO,r,hreg); + { lower 32 bit } + emit_reg_reg(A_PXOR,S_NO,hreg,location.register); + { shift mask } + emit_const_reg(A_PSLLQ,S_B,32,hreg); + { higher 32 bit } + emit_reg_reg(A_PXOR,S_NO,hreg,location.register); + end; +{$endif SUPPORT_MMX} +end. diff --git a/closures/compiler/x86/nx86mem.pas b/closures/compiler/x86/nx86mem.pas new file mode 100644 index 0000000000..d29bbb62b0 --- /dev/null +++ b/closures/compiler/x86/nx86mem.pas @@ -0,0 +1,108 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate x86 assembler for in memory related 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 nx86mem; + +{$i fpcdefs.inc} + +interface + uses + globtype, + cgbase,cpuinfo,cpubase, + node,nmem,ncgmem; + + type + tx86vecnode = class(tcgvecnode) + procedure update_reference_reg_mul(maybe_const_reg:tregister;l:aint);override; + end; + +implementation + + uses + cutils,verbose, + aasmtai,aasmdata, + cgutils,cgobj; + +{***************************************************************************** + TX86VECNODE +*****************************************************************************} + + { this routine must, like any other routine, not change the contents } + { of base/index registers of references, as these may be regvars. } + { The register allocator can coalesce one LOC_REGISTER being moved } + { into another (as their live ranges won't overlap), but not a } + { LOC_CREGISTER moved into a LOC_(C)REGISTER most of the time (as } + { the live range of the LOC_CREGISTER will most likely overlap the } + { the live range of the target LOC_(C)REGISTER) } + { The passed register may be a LOC_CREGISTER as well. } + procedure tx86vecnode.update_reference_reg_mul(maybe_const_reg:tregister;l:aint); + var + l2 : integer; + hreg : tregister; + begin + { Optimized for x86 to use the index register and scalefactor } + if location.reference.index=NR_NO then + begin + { no preparations needed } + end + else if location.reference.base=NR_NO then + begin + if (location.reference.scalefactor > 1) then + hreg:=cg.getaddressregister(current_asmdata.CurrAsmList); + case location.reference.scalefactor of + 0,1 : hreg:=location.reference.index; + 2 : cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_ADDR,1,location.reference.index,hreg); + 4 : cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_ADDR,2,location.reference.index,hreg); + 8 : cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_ADDR,3,location.reference.index,hreg); + else + internalerror(2008091401); + end; + location.reference.base:=hreg; + end + else + begin + hreg:=cg.getaddressregister(current_asmdata.CurrAsmList); + cg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,location.reference,hreg); + reference_reset_base(location.reference,hreg,0,location.reference.alignment); + end; + { insert the new index register and scalefactor or + do the multiplication manual } + case l of + 1,2,4,8 : + begin + location.reference.scalefactor:=l; + hreg:=maybe_const_reg; + end; + else + begin + hreg:=cg.getaddressregister(current_asmdata.CurrAsmList); + if ispowerof2(l,l2) then + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SHL,OS_ADDR,l2,maybe_const_reg,hreg) + else + cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_IMUL,OS_ADDR,l,maybe_const_reg,hreg); + end; + end; + location.reference.index:=hreg; + end; + +begin + cvecnode:=tx86vecnode; +end. diff --git a/closures/compiler/x86/nx86set.pas b/closures/compiler/x86/nx86set.pas new file mode 100644 index 0000000000..9a8f5c3b2b --- /dev/null +++ b/closures/compiler/x86/nx86set.pas @@ -0,0 +1,649 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate x86 assembler for in/case 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 nx86set; + +{$i fpcdefs.inc} + +interface + + uses + globtype, + node,nset,pass_1,ncgset; + + type + tx86innode = class(tinnode) + procedure pass_generate_code;override; + function pass_1 : tnode;override; + end; + + tx86casenode = class(tcgcasenode) + function has_jumptable : boolean;override; + procedure genjumptable(hp : pcaselabel;min_,max_ : aint);override; + procedure genlinearlist(hp : pcaselabel);override; + end; + +implementation + + uses + systems,constexp, + verbose,globals, + symconst,symdef,defutil, + aasmbase,aasmtai,aasmdata,aasmcpu, + cgbase,pass_2,tgobj, + ncon, + cpubase, + cga,cgobj,cgutils,ncgutil, + cgx86, + procinfo; + +{***************************************************************************** + TX86CASENODE +*****************************************************************************} + + function tx86casenode.has_jumptable : boolean; + begin +{$ifdef i386} + has_jumptable:=true; +{$else} + has_jumptable:=false; +{$endif} + end; + + + procedure tx86casenode.genjumptable(hp : pcaselabel;min_,max_ : aint); + var + table : tasmlabel; + last : TConstExprInt; + indexreg : tregister; + href : treference; + jtlist: tasmlist; + sectype: TAsmSectiontype; + + procedure genitem(list:TAsmList;t : pcaselabel); + var + i : aint; + begin + if assigned(t^.less) then + genitem(list,t^.less); + { fill possible hole } + i:=last.svalue+1; + while i<=t^._low.svalue-1 do + begin + list.concat(Tai_const.Create_sym(elselabel)); + inc(i); + end; + i:=t^._low.svalue; + while i<=t^._high.svalue do + begin + list.concat(Tai_const.Create_sym(blocklabel(t^.blockid))); + inc(i); + end; + last:=t^._high; + if assigned(t^.greater) then + genitem(list,t^.greater); + end; + + begin + last:=min_; + if not(jumptable_no_range) then + begin + { a <= x <= b <-> unsigned(x-a) <= (b-a) } + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,opsize,aint(min_),hregister); + { case expr greater than max_ => goto elselabel } + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,OC_A,aint(max_)-aint(min_),hregister,elselabel); + min_:=0; + end; + current_asmdata.getdatalabel(table); + { make it a 32bit register } + indexreg:=cg.makeregsize(current_asmdata.CurrAsmList,hregister,OS_INT); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,opsize,OS_INT,hregister,indexreg); + { create reference } + reference_reset_symbol(href,table,0,sizeof(pint)); + href.offset:=(-aint(min_))*sizeof(aint); + href.index:=indexreg; + href.scalefactor:=sizeof(aint); + emit_ref(A_JMP,S_NO,href); + { generate jump table } + if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) then + begin + jtlist:=current_asmdata.asmlists[al_const]; + sectype:=sec_rodata; + end + else + begin + jtlist:=current_procinfo.aktlocaldata; + sectype:=sec_data; + end; + new_section(jtlist,sectype,current_procinfo.procdef.mangledname,sizeof(aint)); + jtlist.concat(Tai_label.Create(table)); + genitem(jtlist,hp); + end; + + procedure tx86casenode.genlinearlist(hp : pcaselabel); + var + first : boolean; + lastrange : boolean; + last : TConstExprInt; + cond_lt,cond_le : tresflags; + + procedure genitem(t : pcaselabel); + begin + if assigned(t^.less) then + genitem(t^.less); + { need we to test the first value } + if first and (t^._low>get_min_value(left.resultdef)) then + begin + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,jmp_lt,aint(t^._low.svalue),hregister,elselabel); + end; + if t^._low=t^._high then + begin + if t^._low-last=0 then + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList, opsize, OC_EQ,0,hregister,blocklabel(t^.blockid)) + else + begin + cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, aint(t^._low.svalue-last.svalue), hregister); + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_E,blocklabel(t^.blockid)); + end; + last:=t^._low; + lastrange:=false; + end + else + begin + { it begins with the smallest label, if the value } + { is even smaller then jump immediately to the } + { ELSE-label } + if first then + begin + { have we to ajust the first value ? } + if (t^._low>get_min_value(left.resultdef)) or (get_min_value(left.resultdef)<>0) then + cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, aint(t^._low.svalue), hregister); + end + else + begin + { if there is no unused label between the last and the } + { present label then the lower limit can be checked } + { immediately. else check the range in between: } + + cg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, aint(t^._low.svalue-last.svalue), hregister); + { no jump necessary here if the new range starts at } + { at the value following the previous one } + if ((t^._low-last) <> 1) or + (not lastrange) then + cg.a_jmp_flags(current_asmdata.CurrAsmList,cond_lt,elselabel); + end; + {we need to use A_SUB, because A_DEC does not set the correct flags, therefor + using a_op_const_reg(OP_SUB) is not possible } + emit_const_reg(A_SUB,TCGSize2OpSize[opsize],aint(t^._high.svalue-t^._low.svalue),hregister); + cg.a_jmp_flags(current_asmdata.CurrAsmList,cond_le,blocklabel(t^.blockid)); + last:=t^._high; + lastrange:=true; + end; + first:=false; + if assigned(t^.greater) then + genitem(t^.greater); + end; + + begin + if with_sign then + begin + cond_lt:=F_L; + cond_le:=F_LE; + end + else + begin + cond_lt:=F_B; + cond_le:=F_BE; + end; + { do we need to generate cmps? } + if (with_sign and (min_label<0)) then + genlinearcmplist(hp) + else + begin + last:=0; + lastrange:=false; + first:=true; + genitem(hp); + cg.a_jmp_always(current_asmdata.CurrAsmList,elselabel); + end; + end; + +{***************************************************************************** + TX86INNODE +*****************************************************************************} + + function tx86innode.pass_1 : tnode; + begin + result:=nil; + { this is the only difference from the generic version } + expectloc:=LOC_FLAGS; + + firstpass(right); + firstpass(left); + if codegenerror then + exit; + end; + + procedure tx86innode.pass_generate_code; + type + Tsetpart=record + range : boolean; {Part is a range.} + start,stop : byte; {Start/stop when range; Stop=element when an element.} + end; + var + hreg,hreg2, + pleftreg : tregister; + opsize : tcgsize; + orgopsize : tcgsize; + setparts : array[1..8] of Tsetpart; + setbase : aint; + adjustment : longint; + l,l2 : tasmlabel; + i,numparts : byte; + genjumps, + use_small, + ranges : boolean; +{$ifdef CORRECT_SET_IN_FPC} + AM : tasmop; +{$endif CORRECT_SET_IN_FPC} + + function analizeset(Aset:pconstset;is_small:boolean):boolean; + var + compares,maxcompares:word; + i:byte; + begin + if tnormalset(Aset^)=[] then + {The expression... + if expr in [] + ...is allways false. It should be optimized away in the + resultdef pass, and thus never occur here. Since we + do generate wrong code for it, do internalerror.} + internalerror(2002072301); + analizeset:=false; + ranges:=false; + numparts:=0; + compares:=0; + { Lots of comparisions take a lot of time, so do not allow + too much comparisions. 8 comparisions are, however, still + smalller than emitting the set } + if cs_opt_size in current_settings.optimizerswitches then + maxcompares:=8 + else + maxcompares:=5; + { when smallset is possible allow only 3 compares the smallset + code is for littlesize also smaller when more compares are used } + if is_small then + maxcompares:=3; + for i:=0 to 255 do + if i in tnormalset(Aset^) then + begin + if (numparts=0) or (i<>setparts[numparts].stop+1) then + begin + {Set element is a separate element.} + inc(compares); + if compares>maxcompares then + exit; + inc(numparts); + setparts[numparts].range:=false; + setparts[numparts].stop:=i; + end + else + {Set element is part of a range.} + if not setparts[numparts].range then + begin + {Transform an element into a range.} + setparts[numparts].range:=true; + setparts[numparts].start:=setparts[numparts].stop; + setparts[numparts].stop:=i; + ranges := true; + end + else + begin + {Extend a range.} + setparts[numparts].stop:=i; + end; + end; + analizeset:=true; + end; + + begin + { We check first if we can generate jumps, this can be done + because the resultdef is already set in firstpass } + + { check if we can use smallset operation using btl which is limited + to 32 bits, the left side may also not contain higher values or be signed !! } + use_small:=is_smallset(right.resultdef) and + not is_signed(left.resultdef) and + ((left.resultdef.typ=orddef) and (torddef(left.resultdef).high.svalue<32) or + (left.resultdef.typ=enumdef) and (tenumdef(left.resultdef).max<32)); + + { Can we generate jumps? Possible for all types of sets } + genjumps:=(right.nodetype=setconstn) and + analizeset(tsetconstnode(right).value_set,use_small); + { calculate both operators } + { the complex one first } + { not in case of genjumps, because then we don't secondpass } + { right at all (so we have to make sure that "right" really is } + { "right" and not "swapped left" in that case) } + if not(genjumps) then + firstcomplex(self); + secondpass(left); + { Only process the right if we are not generating jumps } + if not genjumps then + begin + secondpass(right); + end; + if codegenerror then + exit; + + { ofcourse not commutative } + if nf_swapped in flags then + swapleftright; + + orgopsize := def_cgsize(left.resultdef); + opsize := OS_32; + if is_signed(left.resultdef) then + opsize := tcgsize(ord(opsize)+(ord(OS_S8)-ord(OS_8))); + + if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_REFERENCE,LOC_CREFERENCE,LOC_CONSTANT]) then + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,true); + if (right.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG]) then + location_force_reg(current_asmdata.CurrAsmList,right.location,opsize,true); + + if genjumps then + begin + { It gives us advantage to check for the set elements + separately instead of using the SET_IN_BYTE procedure. + To do: Build in support for LOC_JUMP } + + { load and zero or sign extend as necessary } + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,false); + pleftreg:=left.location.register; + + { Get a label to jump to the end } + location_reset(location,LOC_FLAGS,OS_NO); + + { It's better to use the zero flag when there are + no ranges } + if ranges then + location.resflags:=F_C + else + location.resflags:=F_E; + + current_asmdata.getjumplabel(l); + + { how much have we already substracted from the x in the } + { "x in [y..z]" expression } + adjustment := 0; + + for i:=1 to numparts do + if setparts[i].range then + { use fact that a <= x <= b <=> cardinal(x-a) <= cardinal(b-a) } + begin + { is the range different from all legal values? } + if (setparts[i].stop-setparts[i].start <> 255) or not (orgopsize = OS_8) then + begin + { yes, is the lower bound <> 0? } + if (setparts[i].start <> 0) then + begin + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,false); + hreg:=left.location.register; + pleftreg:=hreg; + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_SUB,opsize,setparts[i].start-adjustment,pleftreg); + end; + + { new total value substracted from x: } + { adjustment + (setparts[i].start - adjustment) } + adjustment := setparts[i].start; + + { check if result < b-a+1 (not "result <= b-a", since } + { we need a carry in case the element is in the range } + { (this will never overflow since we check at the } + { beginning whether stop-start <> 255) } + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,OC_B,setparts[i].stop-setparts[i].start+1,pleftreg,l); + end + else + { if setparts[i].start = 0 and setparts[i].stop = 255, } + { it's always true since "in" is only allowed for bytes } + begin + current_asmdata.CurrAsmList.concat(taicpu.op_none(A_STC,S_NO)); + cg.a_jmp_always(current_asmdata.CurrAsmList,l); + end; + end + else + begin + { Emit code to check if left is an element } + current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,TCGSize2OpSize[opsize],setparts[i].stop-adjustment, + pleftreg)); + { Result should be in carry flag when ranges are used } + if ranges then + current_asmdata.CurrAsmList.concat(taicpu.op_none(A_STC,S_NO)); + { If found, jump to end } + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_E,l); + end; + if ranges and + { if the last one was a range, the carry flag is already } + { set appropriately } + not(setparts[numparts].range) then + current_asmdata.CurrAsmList.concat(taicpu.op_none(A_CLC,S_NO)); + { To compensate for not doing a second pass } + right.location.reference.symbol:=nil; + { Now place the end label } + cg.a_label(current_asmdata.CurrAsmList,l); + end + else + begin + location_reset(location,LOC_FLAGS,OS_NO); + setbase:=tsetdef(right.resultdef).setbase; + + { We will now generated code to check the set itself, no jmps, + handle smallsets separate, because it allows faster checks } + if use_small then + begin + if left.location.loc=LOC_CONSTANT then + begin + location.resflags:=F_NE; + case right.location.loc of + LOC_REGISTER, + LOC_CREGISTER: + begin + emit_const_reg(A_TEST,TCGSize2OpSize[right.location.size], + 1 shl ((left.location.value-setbase) and 31),right.location.register); + end; + LOC_REFERENCE, + LOC_CREFERENCE : + begin + emit_const_ref(A_TEST,TCGSize2OpSize[right.location.size],1 shl ((left.location.value-setbase) and 31), + right.location.reference); + end; + else + internalerror(200203312); + end; + end + else + begin + location_force_reg(current_asmdata.CurrAsmList,left.location,OS_32,true); + register_maybe_adjust_setbase(current_asmdata.CurrAsmList,left.location,setbase); + if (tcgsize2size[right.location.size] < 4) or + (right.location.loc = LOC_CONSTANT) then + location_force_reg(current_asmdata.CurrAsmList,right.location,OS_32,true); + hreg:=left.location.register; + + case right.location.loc of + LOC_REGISTER, + LOC_CREGISTER : + begin + emit_reg_reg(A_BT,S_L,hreg,right.location.register); + end; + LOC_CREFERENCE, + LOC_REFERENCE : + begin + emit_reg_ref(A_BT,S_L,hreg,right.location.reference); + end; + else + internalerror(2002032210); + end; + location.resflags:=F_C; + end; + end + else + begin + if right.location.loc=LOC_CONSTANT then + begin + location.resflags:=F_C; + current_asmdata.getjumplabel(l); + current_asmdata.getjumplabel(l2); + + { load constants to a register } + if (left.location.loc=LOC_CONSTANT) or + (setbase<>0) then + begin + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,true); + register_maybe_adjust_setbase(current_asmdata.CurrAsmList,left.location,setbase); + end; + + case left.location.loc of + LOC_REGISTER, + LOC_CREGISTER: + begin + hreg:=cg.makeregsize(current_asmdata.CurrAsmList,left.location.register,opsize); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,left.location.size,opsize,left.location.register,hreg); + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,OC_BE,31,hreg,l); + { reset carry flag } + current_asmdata.CurrAsmList.concat(taicpu.op_none(A_CLC,S_NO)); + cg.a_jmp_always(current_asmdata.CurrAsmList,l2); + cg.a_label(current_asmdata.CurrAsmList,l); + { We have to load the value into a register because + btl does not accept values only refs or regs (PFV) } + hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,right.location.value,hreg2); + emit_reg_reg(A_BT,S_L,hreg,hreg2); + end; + else + begin + emit_const_ref(A_CMP,TCGSize2OpSize[orgopsize],31,left.location.reference); + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_BE,l); + { reset carry flag } + current_asmdata.CurrAsmList.concat(taicpu.op_none(A_CLC,S_NO)); + cg.a_jmp_always(current_asmdata.CurrAsmList,l2); + cg.a_label(current_asmdata.CurrAsmList,l); + hreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + cg.a_load_ref_reg(current_asmdata.CurrAsmList,OS_32,OS_32,left.location.reference,hreg); + { We have to load the value into a register because + btl does not accept values only refs or regs (PFV) } + hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_32,right.location.value,hreg2); + emit_reg_reg(A_BT,S_L,hreg,hreg2); + end; + end; + cg.a_label(current_asmdata.CurrAsmList,l2); + end { of right.location.loc=LOC_CONSTANT } + { do search in a normal set which could have >32 elementsm + but also used if the left side contains values > 32 or < 0 } + else if left.location.loc=LOC_CONSTANT then + begin + if (left.location.value<setbase) or (((left.location.value-setbase) shr 3) >= right.resultdef.size) then + {should be caught earlier } + internalerror(2007020201); + + location.resflags:=F_NE; + case right.location.loc of + LOC_REFERENCE,LOC_CREFERENCE: + begin + inc(right.location.reference.offset,(left.location.value-setbase) shr 3); + emit_const_ref(A_TEST,S_B,1 shl (left.location.value and 7),right.location.reference); + end; + LOC_REGISTER,LOC_CREGISTER: + begin + emit_const_reg(A_TEST,TCGSize2OpSize[right.location.size],1 shl (left.location.value-setbase),right.location.register); + end; + else + internalerror(2007051901); + end; + end + else + begin + location_force_reg(current_asmdata.CurrAsmList,left.location,opsize,false); + register_maybe_adjust_setbase(current_asmdata.CurrAsmList,left.location,setbase); + if (right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then + location_force_reg(current_asmdata.CurrAsmList,right.location,opsize,true); + pleftreg:=left.location.register; + + if (opsize >= OS_S8) or { = if signed } + ((left.resultdef.typ=orddef) and + ((torddef(left.resultdef).low < int64(tsetdef(right.resultdef).setbase)) or + (torddef(left.resultdef).high > int64(tsetdef(right.resultdef).setmax)))) or + ((left.resultdef.typ=enumdef) and + ((tenumdef(left.resultdef).min < aint(tsetdef(right.resultdef).setbase)) or + (tenumdef(left.resultdef).max > aint(tsetdef(right.resultdef).setmax)))) then + begin + + { we have to check if the value is < 0 or > setmax } + + current_asmdata.getjumplabel(l); + current_asmdata.getjumplabel(l2); + + { BE will be false for negative values } + cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,OC_BE,tsetdef(right.resultdef).setmax-tsetdef(right.resultdef).setbase,pleftreg,l); + { reset carry flag } + current_asmdata.CurrAsmList.concat(taicpu.op_none(A_CLC,S_NO)); + cg.a_jmp_always(current_asmdata.CurrAsmList,l2); + + cg.a_label(current_asmdata.CurrAsmList,l); + + pleftreg:=left.location.register; + case right.location.loc of + LOC_REGISTER, LOC_CREGISTER : + emit_reg_reg(A_BT,S_L,pleftreg,right.location.register); + LOC_CREFERENCE, LOC_REFERENCE : + emit_reg_ref(A_BT,S_L,pleftreg,right.location.reference); + else + internalerror(2007020301); + end; + + cg.a_label(current_asmdata.CurrAsmList,l2); + + location.resflags:=F_C; + + end + else + begin + case right.location.loc of + LOC_REGISTER, LOC_CREGISTER : + emit_reg_reg(A_BT,S_L,pleftreg,right.location.register); + LOC_CREFERENCE, LOC_REFERENCE : + emit_reg_ref(A_BT,S_L,pleftreg,right.location.reference); + else + internalerror(2007020302); + end; + location.resflags:=F_C; + end; + end; + end; + end; + if not genjumps then + location_freetemp(current_asmdata.CurrAsmList,right.location); + end; + +begin + cinnode:=tx86innode; + ccasenode:=tx86casenode; +end. diff --git a/closures/compiler/x86/rax86.pas b/closures/compiler/x86/rax86.pas new file mode 100644 index 0000000000..51afa60ac5 --- /dev/null +++ b/closures/compiler/x86/rax86.pas @@ -0,0 +1,782 @@ +{ + Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman + + Handles the common x86 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. + + **************************************************************************** +} +{ + Contains the common x86 (i386 and x86-64) assembler reader routines. +} +unit rax86; + +{$i fpcdefs.inc} + +interface + +uses + aasmbase,aasmtai,aasmdata,aasmcpu, + cpubase,rautils,cclasses; + +{ Parser helpers } +function is_prefix(t:tasmop):boolean; +function is_override(t:tasmop):boolean; +Function CheckPrefix(prefixop,op:tasmop): Boolean; +Function CheckOverride(overrideop,op:tasmop): Boolean; +Procedure FWaitWarning; + +type + Tx86Operand=class(TOperand) + opsize : topsize; + Procedure SetSize(_size:longint;force:boolean);override; + Procedure SetCorrectSize(opcode:tasmop);override; + Function CheckOperand: boolean; override; + end; + + Tx86Instruction=class(TInstruction) + OpOrder : TOperandOrder; + opsize : topsize; + constructor Create(optype : tcoperand);override; + { Operand sizes } + procedure AddReferenceSizes; + procedure SetInstructionOpsize; + procedure CheckOperandSizes; + procedure CheckNonCommutativeOpcodes; + procedure SwapOperands; + { Additional actions required by specific reader } + procedure FixupOpcode;virtual; + { opcode adding } + function ConcatInstruction(p : TAsmList) : tai;override; + end; + +const + AsmPrefixes = 6; + AsmPrefix : array[0..AsmPrefixes-1] of TasmOP =( + A_LOCK,A_REP,A_REPE,A_REPNE,A_REPNZ,A_REPZ + ); + + AsmOverrides = 6; + AsmOverride : array[0..AsmOverrides-1] of TasmOP =( + A_SEGCS,A_SEGES,A_SEGDS,A_SEGFS,A_SEGGS,A_SEGSS + ); + + CondAsmOps=3; + CondAsmOp:array[0..CondAsmOps-1] of TasmOp=( + A_CMOVcc, A_Jcc, A_SETcc + ); + CondAsmOpStr:array[0..CondAsmOps-1] of string[4]=( + 'CMOV','J','SET' + ); + +implementation + +uses + globtype,globals,systems,verbose, + procinfo, + cpuinfo,cgbase,cgutils, + itcpugas,cgx86; + + +{***************************************************************************** + Parser Helpers +*****************************************************************************} + +function is_prefix(t:tasmop):boolean; +var + i : longint; +Begin + is_prefix:=false; + for i:=1 to AsmPrefixes do + if t=AsmPrefix[i-1] then + begin + is_prefix:=true; + exit; + end; +end; + + +function is_override(t:tasmop):boolean; +var + i : longint; +Begin + is_override:=false; + for i:=1 to AsmOverrides do + if t=AsmOverride[i-1] then + begin + is_override:=true; + exit; + end; +end; + + +Function CheckPrefix(prefixop,op:tasmop): Boolean; +{ Checks if the prefix is valid with the following opcode } +{ return false if not, otherwise true } +Begin + CheckPrefix := TRUE; +(* Case prefix of + A_REP,A_REPNE,A_REPE: + Case opcode Of + A_SCASB,A_SCASW,A_SCASD, + A_INS,A_OUTS,A_MOVS,A_CMPS,A_LODS,A_STOS:; + Else + Begin + CheckPrefix := FALSE; + exit; + end; + end; { case } + A_LOCK: + Case opcode Of + A_BT,A_BTS,A_BTR,A_BTC,A_XCHG,A_ADD,A_OR,A_ADC,A_SBB,A_AND,A_SUB, + A_XOR,A_NOT,A_NEG,A_INC,A_DEC:; + Else + Begin + CheckPrefix := FALSE; + Exit; + end; + end; { case } + A_NONE: exit; { no prefix here } + else + CheckPrefix := FALSE; + end; { end case } *) +end; + + +Function CheckOverride(overrideop,op:tasmop): Boolean; +{ Check if the override is valid, and if so then } +{ update the instr variable accordingly. } +Begin + CheckOverride := true; +{ Case instr.getinstruction of + A_MOVS,A_XLAT,A_CMPS: + Begin + CheckOverride := TRUE; + Message(assem_e_segment_override_not_supported); + end + end } +end; + + +Procedure FWaitWarning; +begin + if (target_info.system=system_i386_GO32V2) and (cs_fp_emulation in current_settings.moduleswitches) then + Message(asmr_w_fwait_emu_prob); +end; + +{***************************************************************************** + TX86Operand +*****************************************************************************} + +Procedure Tx86Operand.SetSize(_size:longint;force:boolean); +begin + inherited SetSize(_size,force); + { OS_64 will be set to S_L and be fixed later + in SetCorrectSize } + opsize:=TCGSize2Opsize[size]; +end; + + +Procedure Tx86Operand.SetCorrectSize(opcode:tasmop); +begin + if gas_needsuffix[opcode]=attsufFPU then + begin + case size of + OS_32 : opsize:=S_FS; + OS_64 : opsize:=S_FL; + end; + end + else if gas_needsuffix[opcode]=attsufFPUint then + begin + case size of + OS_16 : opsize:=S_IS; + OS_32 : opsize:=S_IL; + OS_64 : opsize:=S_IQ; + end; + end + else + begin + if size=OS_64 then + opsize:=S_Q; + end; +end; + +Function Tx86Operand.CheckOperand: boolean; + +begin + result:=true; + if (opr.typ=OPR_Reference) then + begin + if not hasvar then + begin + if (getsupreg(opr.ref.base)=RS_EBP) and (opr.ref.offset>0) then + begin + if current_procinfo.procdef.proccalloption=pocall_register then + message(asmr_w_no_direct_ebp_for_parameter) + else + message(asmr_w_direct_ebp_for_parameter_regcall); + end + else if (getsupreg(opr.ref.base)=RS_EBP) and (opr.ref.offset<0) then + message(asmr_w_direct_ebp_neg_offset) + else if (getsupreg(opr.ref.base)=RS_ESP) and (opr.ref.offset<0) then + message(asmr_w_direct_esp_neg_offset); + end; + if (cs_create_pic in current_settings.moduleswitches) and + assigned(opr.ref.symbol) and + not assigned(opr.ref.relsymbol) and + not(opr.ref.refaddr in [addr_pic,addr_pic_no_got]) then + begin + if (opr.ref.symbol.name <> '_GLOBAL_OFFSET_TABLE_') then + begin + message(asmr_e_need_pic_ref); + result:=false; + end + else + opr.ref.refaddr:=addr_pic; + end; + end; +end; + + +{***************************************************************************** + T386Instruction +*****************************************************************************} + +constructor Tx86Instruction.Create(optype : tcoperand); +begin + inherited Create(optype); + Opsize:=S_NO; +end; + + +procedure Tx86Instruction.SwapOperands; +begin + Inherited SwapOperands; + { mark the correct order } + if OpOrder=op_intel then + OpOrder:=op_att + else + OpOrder:=op_intel; +end; + + +procedure Tx86Instruction.AddReferenceSizes; +{ this will add the sizes for references like [esi] which do not + have the size set yet, it will take only the size if the other + operand is a register } +var + operand2,i : longint; + s : tasmsymbol; + so : aint; +begin + for i:=1 to ops do + begin + operands[i].SetCorrectSize(opcode); + if tx86operand(operands[i]).opsize=S_NO then + begin +{$ifdef x86_64} + if (opcode=A_MOVQ) and + (ops=2) and + (operands[1].opr.typ=OPR_CONSTANT) then + opsize:=S_Q + else +{$endif x86_64} + case operands[i].Opr.Typ of + OPR_LOCAL, + OPR_REFERENCE : + begin + { for 3-operand opcodes, operand #1 (in ATT order) is always an immediate, + don't consider it. } + if i=ops then + operand2:=i-1 + else + operand2:=i+1; + if operand2>0 then + begin + { Only allow register as operand to take the size from } + if operands[operand2].opr.typ=OPR_REGISTER then + begin + if ((opcode<>A_MOVD) and + (opcode<>A_CVTSI2SS)) then + tx86operand(operands[i]).opsize:=tx86operand(operands[operand2]).opsize; + end + else + begin + { if no register then take the opsize (which is available with ATT), + if not availble then give an error } + if opsize<>S_NO then + tx86operand(operands[i]).opsize:=opsize + else + begin + if (m_delphi in current_settings.modeswitches) then + Message(asmr_w_unable_to_determine_reference_size_using_dword) + else + Message(asmr_e_unable_to_determine_reference_size); + { recovery } + tx86operand(operands[i]).opsize:=S_L; + end; + end; + end + else + begin + if opsize<>S_NO then + tx86operand(operands[i]).opsize:=opsize + end; + end; + OPR_SYMBOL : + begin + { Fix lea which need a reference } + if opcode=A_LEA then + begin + s:=operands[i].opr.symbol; + so:=operands[i].opr.symofs; + operands[i].opr.typ:=OPR_REFERENCE; + Fillchar(operands[i].opr.ref,sizeof(treference),0); + operands[i].opr.ref.symbol:=s; + operands[i].opr.ref.offset:=so; + end; + {$ifdef x86_64} + tx86operand(operands[i]).opsize:=S_Q; + {$else x86_64} + tx86operand(operands[i]).opsize:=S_L; + {$endif x86_64} + end; + end; + end; + end; +end; + + +procedure Tx86Instruction.SetInstructionOpsize; +begin + if opsize<>S_NO then + exit; + if (OpOrder=op_intel) then + SwapOperands; + case ops of + 0 : ; + 1 : + begin + { "push es" must be stored as a long PM } + if ((opcode=A_PUSH) or + (opcode=A_POP)) and + (operands[1].opr.typ=OPR_REGISTER) and + is_segment_reg(operands[1].opr.reg) then + opsize:=S_L + else + opsize:=tx86operand(operands[1]).opsize; + end; + 2 : + begin + case opcode of + A_MOVZX,A_MOVSX : + begin + if tx86operand(operands[1]).opsize=S_NO then + begin + tx86operand(operands[1]).opsize:=S_B; + if (m_delphi in current_settings.modeswitches) then + Message(asmr_w_unable_to_determine_reference_size_using_byte) + else + Message(asmr_e_unable_to_determine_reference_size); + end; + case tx86operand(operands[1]).opsize of + S_W : + case tx86operand(operands[2]).opsize of + S_L : + opsize:=S_WL; + end; + S_B : + begin + case tx86operand(operands[2]).opsize of + S_W : + opsize:=S_BW; + S_L : + opsize:=S_BL; + end; + end; + end; + end; + A_MOVD : { movd is a move from a mmx register to a + 32 bit register or memory, so no opsize is correct here PM } + exit; + A_MOVQ : + opsize:=S_IQ; + A_OUT : + opsize:=tx86operand(operands[1]).opsize; + else + opsize:=tx86operand(operands[2]).opsize; + end; + end; + 3 : + opsize:=tx86operand(operands[3]).opsize; + end; +end; + + +procedure Tx86Instruction.CheckOperandSizes; +var + sizeerr : boolean; + i : longint; +begin + { Check only the most common opcodes here, the others are done in + the assembler pass } + case opcode of + A_PUSH,A_POP,A_DEC,A_INC,A_NOT,A_NEG, + A_CMP,A_MOV, + A_ADD,A_SUB,A_ADC,A_SBB, + A_AND,A_OR,A_TEST,A_XOR: ; + else + exit; + end; + { Handle the BW,BL,WL separatly } + sizeerr:=false; + { special push/pop selector case } + if ((opcode=A_PUSH) or + (opcode=A_POP)) and + (operands[1].opr.typ=OPR_REGISTER) and + is_segment_reg(operands[1].opr.reg) then + exit; + if opsize in [S_BW,S_BL,S_WL] then + begin + if ops<>2 then + sizeerr:=true + else + begin + case opsize of + S_BW : + sizeerr:=(tx86operand(operands[1]).opsize<>S_B) or (tx86operand(operands[2]).opsize<>S_W); + S_BL : + sizeerr:=(tx86operand(operands[1]).opsize<>S_B) or (tx86operand(operands[2]).opsize<>S_L); + S_WL : + sizeerr:=(tx86operand(operands[1]).opsize<>S_W) or (tx86operand(operands[2]).opsize<>S_L); + end; + end; + end + else + begin + for i:=1 to ops do + begin + if (operands[i].opr.typ<>OPR_CONSTANT) and + (tx86operand(operands[i]).opsize in [S_B,S_W,S_L]) and + (tx86operand(operands[i]).opsize<>opsize) then + sizeerr:=true; + end; + end; + if sizeerr then + begin + { if range checks are on then generate an error } + if (cs_compilesystem in current_settings.moduleswitches) or + not (cs_check_range in current_settings.localswitches) then + Message(asmr_w_size_suffix_and_dest_dont_match) + else + Message(asmr_e_size_suffix_and_dest_dont_match); + end; +end; + + +{ This check must be done with the operand in ATT order + i.e.after swapping in the intel reader + but before swapping in the NASM and TASM writers PM } +procedure Tx86Instruction.CheckNonCommutativeOpcodes; +begin + if (OpOrder=op_intel) then + SwapOperands; + if ( + (ops=2) and + (operands[1].opr.typ=OPR_REGISTER) and + (operands[2].opr.typ=OPR_REGISTER) and + { if the first is ST and the second is also a register + it is necessarily ST1 .. ST7 } + ((operands[1].opr.reg=NR_ST) or + (operands[1].opr.reg=NR_ST0)) + ) or + (ops=0) then + if opcode=A_FSUBR then + opcode:=A_FSUB + else if opcode=A_FSUB then + opcode:=A_FSUBR + else if opcode=A_FDIVR then + opcode:=A_FDIV + else if opcode=A_FDIV then + opcode:=A_FDIVR + else if opcode=A_FSUBRP then + opcode:=A_FSUBP + else if opcode=A_FSUBP then + opcode:=A_FSUBRP + else if opcode=A_FDIVRP then + opcode:=A_FDIVP + else if opcode=A_FDIVP then + opcode:=A_FDIVRP; + if ( + (ops=1) and + (operands[1].opr.typ=OPR_REGISTER) and + (getregtype(operands[1].opr.reg)=R_FPUREGISTER) and + (operands[1].opr.reg<>NR_ST) and + (operands[1].opr.reg<>NR_ST0) + ) then + if opcode=A_FSUBRP then + opcode:=A_FSUBP + else if opcode=A_FSUBP then + opcode:=A_FSUBRP + else if opcode=A_FDIVRP then + opcode:=A_FDIVP + else if opcode=A_FDIVP then + opcode:=A_FDIVRP; +end; + +procedure Tx86Instruction.FixupOpcode; +begin + { does nothing by default } +end; + +{***************************************************************************** + opcode Adding +*****************************************************************************} + +function Tx86Instruction.ConcatInstruction(p : TAsmList) : tai; +var + siz : topsize; + i,asize : longint; + ai : taicpu; +begin + if (OpOrder=op_intel) then + SwapOperands; + + ai:=nil; + for i:=1 to Ops do + if not operands[i].CheckOperand then + exit; + +{ Get Opsize } + if (opsize<>S_NO) or (Ops=0) then + siz:=opsize + else + begin + if (Ops=2) and (operands[1].opr.typ=OPR_REGISTER) then + siz:=tx86operand(operands[1]).opsize + else + siz:=tx86operand(operands[Ops]).opsize; + { MOVD should be of size S_LQ or S_QL, but these do not exist PM } + if (ops=2) and + (tx86operand(operands[1]).opsize<>S_NO) and + (tx86operand(operands[2]).opsize<>S_NO) and + (tx86operand(operands[1]).opsize<>tx86operand(operands[2]).opsize) then + siz:=S_NO; + end; + + if ((opcode=A_MOVD)or + (opcode=A_CVTSI2SS)) and + ((tx86operand(operands[1]).opsize=S_NO) or + (tx86operand(operands[2]).opsize=S_NO)) then + siz:=S_NO; + { NASM does not support FADD without args + as alias of FADDP + and GNU AS interprets FADD without operand differently + for version 2.9.1 and 2.9.5 !! } + if (ops=0) and + ((opcode=A_FADD) or + (opcode=A_FMUL) or + (opcode=A_FSUB) or + (opcode=A_FSUBR) or + (opcode=A_FDIV) or + (opcode=A_FDIVR)) then + begin + if opcode=A_FADD then + opcode:=A_FADDP + else if opcode=A_FMUL then + opcode:=A_FMULP + else if opcode=A_FSUB then + opcode:=A_FSUBP + else if opcode=A_FSUBR then + opcode:=A_FSUBRP + else if opcode=A_FDIV then + opcode:=A_FDIVP + else if opcode=A_FDIVR then + opcode:=A_FDIVRP; + message1(asmr_w_fadd_to_faddp,std_op2str[opcode]); + end; + + {It is valid to specify some instructions without operand size.} + if siz=S_NO then + begin + if (ops=1) and (opcode=A_INT) then + siz:=S_B; + if (ops=1) and (opcode=A_RET) or (opcode=A_RETN) or (opcode=A_RETF) then + siz:=S_W; + if (ops=1) and (opcode=A_PUSH) then + begin + {We are a 32 compiler, assume 32-bit by default. This is Delphi + compatible but bad coding practise.} + siz:=S_L; + message(asmr_w_unable_to_determine_reference_size_using_dword); + end; + if (opcode=A_JMP) or (opcode=A_JCC) or (opcode=A_CALL) then + if ops=1 then + siz:=S_NEAR + else + siz:=S_FAR; + end; + + { GNU AS interprets FDIV without operand differently + for version 2.9.1 and 2.10 + we add explicit args to it !! } + if (ops=0) and + ((opcode=A_FSUBP) or + (opcode=A_FSUBRP) or + (opcode=A_FDIVP) or + (opcode=A_FDIVRP) or + (opcode=A_FSUB) or + (opcode=A_FSUBR) or + (opcode=A_FADD) or + (opcode=A_FADDP) or + (opcode=A_FDIV) or + (opcode=A_FDIVR)) then + begin + message1(asmr_w_adding_explicit_args_fXX,std_op2str[opcode]); + ops:=2; + operands[1].opr.typ:=OPR_REGISTER; + operands[2].opr.typ:=OPR_REGISTER; + operands[1].opr.reg:=NR_ST0; + operands[2].opr.reg:=NR_ST1; + end; + if (ops=1) and + ( + (operands[1].opr.typ=OPR_REGISTER) and + (getregtype(operands[1].opr.reg)=R_FPUREGISTER) and + (operands[1].opr.reg<>NR_ST) and + (operands[1].opr.reg<>NR_ST0) + ) and + ( + (opcode=A_FSUBP) or + (opcode=A_FSUBRP) or + (opcode=A_FDIVP) or + (opcode=A_FDIVRP) or + (opcode=A_FADDP) or + (opcode=A_FMULP) + ) then + begin + message1(asmr_w_adding_explicit_first_arg_fXX,std_op2str[opcode]); + ops:=2; + operands[2].opr.typ:=OPR_REGISTER; + operands[2].opr.reg:=operands[1].opr.reg; + operands[1].opr.reg:=NR_ST0; + end; + + if (ops=1) and + ( + (operands[1].opr.typ=OPR_REGISTER) and + (getregtype(operands[1].opr.reg)=R_FPUREGISTER) and + (operands[1].opr.reg<>NR_ST) and + (operands[1].opr.reg<>NR_ST0) + ) and + ( + (opcode=A_FSUB) or + (opcode=A_FSUBR) or + (opcode=A_FDIV) or + (opcode=A_FDIVR) or + (opcode=A_FADD) or + (opcode=A_FMUL) + ) then + begin + message1(asmr_w_adding_explicit_second_arg_fXX,std_op2str[opcode]); + ops:=2; + operands[2].opr.typ:=OPR_REGISTER; + operands[2].opr.reg:=NR_ST0; + end; + + { I tried to convince Linus Torvalds to add + code to support ENTER instruction + (when raising a stack page fault) + but he replied that ENTER is a bad instruction and + Linux does not need to support it + So I think its at least a good idea to add a warning + if someone uses this in assembler code + FPC itself does not use it at all PM } + if (opcode=A_ENTER) and + (target_info.system in [system_i386_linux,system_i386_FreeBSD]) then + Message(asmr_w_enter_not_supported_by_linux); + + ai:=taicpu.op_none(opcode,siz); + ai.SetOperandOrder(OpOrder); + ai.Ops:=Ops; + ai.Allocate_oper(Ops); + for i:=1 to Ops do + case operands[i].opr.typ of + OPR_CONSTANT : + ai.loadconst(i-1,operands[i].opr.val); + OPR_REGISTER: + ai.loadreg(i-1,operands[i].opr.reg); + OPR_SYMBOL: + ai.loadsymbol(i-1,operands[i].opr.symbol,operands[i].opr.symofs); + OPR_LOCAL : + with operands[i].opr do + ai.loadlocal(i-1,localsym,localsymofs,localindexreg, + localscale,localgetoffset,localforceref); + OPR_REFERENCE: + begin + ai.loadref(i-1,operands[i].opr.ref); + if operands[i].size<>OS_NO then + begin + asize:=0; + case operands[i].size of + OS_8,OS_S8 : + asize:=OT_BITS8; + OS_16,OS_S16 : + asize:=OT_BITS16; + OS_32,OS_S32,OS_F32 : + asize:=OT_BITS32; + OS_64,OS_S64: + begin + { Only FPU operations know about 64bit values, for all + integer operations it is seen as 32bit + + this applies only to i386, see tw16622} + if gas_needsuffix[opcode] in [attsufFPU,attsufFPUint] then + asize:=OT_BITS64 +{$ifdef i386} + else + asize:=OT_BITS32 +{$endif i386} + ; + end; + OS_F64,OS_C64 : + asize:=OT_BITS64; + OS_F80 : + asize:=OT_BITS80; + end; + if asize<>0 then + ai.oper[i-1]^.ot:=(ai.oper[i-1]^.ot and not OT_SIZE_MASK) or asize; + end; + end; + end; + + { Condition ? } + if condition<>C_None then + ai.SetCondition(condition); + + { Set is_jmp, it enables asmwriter to emit short jumps if appropriate } + if (opcode=A_JMP) or (opcode=A_JCC) then + ai.is_jmp := True; + + { Concat the opcode or give an error } + if assigned(ai) then + p.concat(ai) + else + Message(asmr_e_invalid_opcode_and_operand); + result:=ai; +end; + +end. diff --git a/closures/compiler/x86/rax86att.pas b/closures/compiler/x86/rax86att.pas new file mode 100644 index 0000000000..e03c69641d --- /dev/null +++ b/closures/compiler/x86/rax86att.pas @@ -0,0 +1,920 @@ +{ + Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman + + Does the parsing for the x86 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 rax86att; + +{$i fpcdefs.inc} + +Interface + + uses + cpubase, + raatt,rax86; + + type + tx86attreader = class(tattreader) + ActOpsize : topsize; + function is_asmopcode(const s: string):boolean;override; + procedure handleopcode;override; + procedure BuildReference(oper : tx86operand); + procedure BuildOperand(oper : tx86operand); + procedure BuildOpCode(instr : tx86instruction); + procedure handlepercent;override; + protected + procedure MaybeGetPICModifier(var oper: tx86operand); + end; + + Tx86attInstruction = class(Tx86Instruction) + procedure FixupOpcode;override; + end; + +Implementation + + uses + { helpers } + cutils, + { global } + globtype,verbose, + systems, + { aasm } + aasmbase,aasmtai,aasmdata,aasmcpu, + { symtable } + symconst, + { parser } + scanner, + procinfo, + itcpugas, + rabase,rautils, + cgbase + ; + + { Tx86attInstruction } + + procedure Tx86attInstruction.FixupOpcode; + begin + if (OpOrder=op_intel) then + SwapOperands; + + case opcode of + A_MOVQ: + begin + { May be either real 'movq' or a generic 'mov' with 'q' suffix. Convert to mov + if source is a constant, or if neither operand is an mmx/xmm register } +{$ifdef x86_64} + if (ops=2) and + ( + (operands[1].opr.typ=OPR_CONSTANT) or not + ( + ((operands[1].opr.typ=OPR_REGISTER) and + (getregtype(operands[1].opr.reg) in [R_MMXREGISTER,R_MMREGISTER])) or + ((operands[2].opr.typ=OPR_REGISTER) and + (getregtype(operands[2].opr.reg) in [R_MMXREGISTER,R_MMREGISTER])) + ) + ) then + opcode:=A_MOV; +{$endif x86_64} + end; + end; + end; + + { Tx86attReader } + + procedure tx86attreader.handlepercent; + var + len : longint; + begin + len:=1; + actasmpattern[len]:='%'; + c:=current_scanner.asmgetchar; + { to be a register there must be a letter and not a number } + if c in ['0'..'9'] then + begin + actasmtoken:=AS_MOD; + end + else + begin + while c in ['a'..'z','A'..'Z','0'..'9'] do + Begin + inc(len); + actasmpattern[len]:=c; + c:=current_scanner.asmgetchar; + end; + actasmpattern[0]:=chr(len); + uppervar(actasmpattern); + if (actasmpattern = '%ST') and (c='(') then + Begin + actasmpattern:=actasmpattern+c; + c:=current_scanner.asmgetchar; + if c in ['0'..'9'] then + actasmpattern:=actasmpattern + c + else + Message(asmr_e_invalid_fpu_register); + c:=current_scanner.asmgetchar; + if c <> ')' then + Message(asmr_e_invalid_fpu_register) + else + Begin + actasmpattern:=actasmpattern + c; + c:=current_scanner.asmgetchar; { let us point to next character. } + end; + end; + if is_register(actasmpattern) then + exit; + Message(asmr_e_invalid_register); + actasmtoken:=raatt.AS_NONE; + end; + end; + + + Procedure tx86attreader.BuildReference(oper : tx86operand); + + procedure Consume_RParen; + begin + if actasmtoken <> AS_RPAREN then + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(true); + end + else + begin + Consume(AS_RPAREN); + if not (actasmtoken in [AS_COMMA,AS_SEPARATOR,AS_END]) then + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(true); + end; + end; + end; + + + procedure Consume_Scale; + var + l : aint; + begin + { we have to process the scaling } + l:=BuildConstExpression(false,true); + if ((l = 2) or (l = 4) or (l = 8) or (l = 1)) then + oper.opr.ref.scalefactor:=l + else + Begin + Message(asmr_e_wrong_scale_factor); + oper.opr.ref.scalefactor:=0; + end; + end; + + + begin + oper.InitRef; + Consume(AS_LPAREN); + Case actasmtoken of + AS_INTNUM, + AS_MINUS, + AS_PLUS: { absolute offset, such as fs:(0x046c) } + Begin + { offset(offset) is invalid } + If oper.opr.Ref.Offset <> 0 Then + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(true); + End + Else + Begin + oper.opr.Ref.Offset:=BuildConstExpression(false,true); + Consume_RParen; + end; + exit; + End; + AS_REGISTER: { (reg ... } + Begin + { Check if there is already a base (mostly ebp,esp) than this is + not allowed, because it will give crashing code } + if ((oper.opr.typ=OPR_REFERENCE) and (oper.opr.ref.base<>NR_NO)) or + ((oper.opr.typ=OPR_LOCAL) and (oper.opr.localsym.localloc.loc<>LOC_REGISTER)) then + message(asmr_e_cannot_index_relative_var); + oper.opr.ref.base:=actasmregister; +{$ifdef x86_64} + { non-GOT based RIP-relative accesses are also position-independent } + if (oper.opr.ref.base=NR_RIP) and + (oper.opr.ref.refaddr<>addr_pic) then + oper.opr.ref.refaddr:=addr_pic_no_got; +{$endif x86_64} + Consume(AS_REGISTER); + { can either be a register or a right parenthesis } + { (reg) } + if actasmtoken=AS_RPAREN then + Begin + Consume_RParen; + exit; + end; + { (reg,reg .. } + Consume(AS_COMMA); + if actasmtoken=AS_REGISTER then + Begin + oper.opr.ref.index:=actasmregister; + Consume(AS_REGISTER); + { check for scaling ... } + case actasmtoken of + AS_RPAREN: + Begin + Consume_RParen; + exit; + end; + AS_COMMA: + Begin + Consume(AS_COMMA); + Consume_Scale; + Consume_RParen; + end; + else + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end; + end; { end case } + end + else + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end; + end; {end case } + AS_COMMA: { (, ... can either be scaling, or index } + Begin + Consume(AS_COMMA); + { Index } + if (actasmtoken=AS_REGISTER) then + Begin + oper.opr.ref.index:=actasmregister; + Consume(AS_REGISTER); + { check for scaling ... } + case actasmtoken of + AS_RPAREN: + Begin + Consume_RParen; + exit; + end; + AS_COMMA: + Begin + Consume(AS_COMMA); + Consume_Scale; + Consume_RParen; + end; + else + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end; + end; {end case } + end + { Scaling } + else + Begin + Consume_Scale; + Consume_RParen; + exit; + end; + end; + else + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(false); + end; + end; + end; + + + Procedure tx86attreader.MaybeGetPICModifier(var oper: tx86operand); + var + relsym: string; + asmsymtyp: tasmsymtype; + l: aint; + begin + case actasmtoken of + AS_AT: + begin + { darwin/i386 needs a relsym instead, and we can't } + { generate this automatically } + if (target_info.system in [system_i386_darwin,system_i386_iphonesim]) then + Message(asmr_e_invalid_reference_syntax); + consume(AS_AT); + if actasmtoken=AS_ID then + begin +{$ifdef x86_64} + if (actasmpattern='GOTPCREL') or + (actasmpattern='PLT') then +{$endif x86_64} +{$ifdef i386} + if actasmpattern='GOT' then +{$endif i386} + begin + oper.opr.ref.refaddr:=addr_pic; +{$ifdef x86_64} + { local symbols don't have to + be accessed via the GOT + } + if (actasmpattern='GOTPCREL') and + assigned(oper.opr.ref.symbol) and + (oper.opr.ref.symbol.bind=AB_LOCAL) then + Message(asmr_w_useless_got_for_local); +{$endif x86_64} + consume(AS_ID); + end + else + Message(asmr_e_invalid_reference_syntax); + end + else + Message(asmr_e_invalid_reference_syntax); + end; + AS_MINUS: + begin + { relsym? } + Consume(AS_MINUS); + BuildConstSymbolExpression(true,true,false,l,relsym,asmsymtyp); + if (relsym<>'') then + if not assigned(oper.opr.ref.relsymbol) then + oper.opr.ref.relsymbol:=current_asmdata.RefAsmSymbol(relsym) + else + Message(asmr_e_invalid_reference_syntax) + else + dec(oper.opr.ref.offset,l); + end; + end; + end; + + + Procedure tx86attreader.BuildOperand(oper : tx86operand); + var + tempstr, + expr : string; + typesize,l,k : aint; + + + 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 + mangledname: string; + hasdot : boolean; + l, + toffset, + tsize : aint; + 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,mangledname,false); + if (oper.opr.typ<>OPR_CONSTANT) and + (mangledname<>'') then + Message(asmr_e_wrong_sym_type); + 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 + (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 : + if (mangledname<>'') then + begin + if (oper.opr.val<>0) then + Message(asmr_e_wrong_sym_type); + oper.opr.typ:=OPR_SYMBOL; + oper.opr.symbol:=current_asmdata.RefAsmSymbol(mangledname); + end + else + inc(oper.opr.val,l); + OPR_REFERENCE : + inc(oper.opr.ref.offset,l); + OPR_SYMBOL: + Message(asmr_e_invalid_symbol_ref); + else + internalerror(200309221); + end; + end; + + + function MaybeBuildReference:boolean; + { Try to create a reference, if not a reference is found then false + is returned } + var + mangledname: string; + begin + MaybeBuildReference:=true; + case actasmtoken of + AS_INTNUM: + Begin + { allow %segmentregister:number } + if oper.opr.ref.segment<>NR_NO then + begin + // already done before calling oper.InitRef; + if oper.opr.Ref.Offset <> 0 Then + Message(asmr_e_invalid_reference_syntax) + else + begin + oper.opr.Ref.Offset:=BuildConstExpression(true,false); + if actasmtoken=AS_LPAREN then + BuildReference(oper) + else if (oper.opr.ref.segment <> NR_FS) and + (oper.opr.ref.segment <> NR_GS) then + Message(asmr_w_general_segment_with_constant); + end; + end + else + begin + oper.opr.ref.offset:=BuildConstExpression(True,False); + BuildReference(oper); + end; + end; + 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 + 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,mangledname,false); + if (mangledname<>'') then + Message(asmr_e_invalid_reference_syntax); + inc(oper.opr.ref.offset,l); + end; + MaybeGetPICModifier(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; + hl : tasmlabel; + Begin + expr:=''; + case actasmtoken of + AS_LPAREN: { Memory reference or constant expression } + Begin + oper.InitRef; + BuildReference(oper); + end; + + AS_DOLLAR: { Constant expression } + Begin + Consume(AS_DOLLAR); + 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 + Message(asmr_e_invalid_reference_syntax) + else + BuildReference(oper); + end; + + AS_STAR: { Call from memory address } + Begin + Consume(AS_STAR); + if actasmtoken=AS_REGISTER then + begin + oper.opr.typ:=OPR_REGISTER; + oper.opr.reg:=actasmregister; + oper.SetSize(tcgsize2size[reg_cgsize(actasmregister)],true); + Consume(AS_REGISTER); + end + else + begin + oper.InitRef; + if not MaybeBuildReference then + Message(asmr_e_syn_operand); + end; + { this is only allowed for call's and jmp's } + if not is_calljmp(actopcode) then + Message(asmr_e_syn_operand); + 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 oper.SetupVar(expr,false) then + MaybeGetPICModifier(oper) + else + 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 oper.opr.typ<>OPR_NONE Then + begin + 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; + end; + { Do we have a indexing reference, then parse it also } + if actasmtoken=AS_LPAREN then + BuildReference(oper); + end; + + AS_REGISTER: { Register, a variable reference or a constant reference } + Begin + { save the type of register used. } + tempreg:=actasmregister; + Consume(AS_REGISTER); + if actasmtoken = AS_COLON then + Begin + Consume(AS_COLON); + oper.InitRef; + oper.opr.ref.segment:=tempreg; + { This must absolutely be followed by a reference } + if not MaybeBuildReference then + Begin + Message(asmr_e_invalid_seg_override); + Consume(actasmtoken); + end; + end + { Simple register } + else 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; + oper.SetSize(tcgsize2size[reg_cgsize(oper.opr.reg)],true); + end + else + Message(asmr_e_syn_operand); + end; + AS_END, + AS_SEPARATOR, + AS_COMMA: ; + else + Begin + Message(asmr_e_syn_operand); + Consume(actasmtoken); + end; + end; { end case } + end; + + + procedure tx86attreader.BuildOpCode(instr : tx86instruction); + var + operandnum : longint; + PrefixOp,OverrideOp: tasmop; + Begin + PrefixOp:=A_None; + OverrideOp:=A_None; + { prefix seg opcode / prefix opcode } + repeat + if is_prefix(actopcode) then + begin + PrefixOp:=ActOpcode; + with instr do + begin + opcode:=ActOpcode; + condition:=ActCondition; + opsize:=ActOpsize; + ConcatInstruction(curlist); + end; + Consume(AS_OPCODE); + end + else + if is_override(actopcode) then + begin + OverrideOp:=ActOpcode; + with instr do + begin + opcode:=ActOpcode; + condition:=ActCondition; + opsize:=ActOpsize; + ConcatInstruction(curlist); + end; + Consume(AS_OPCODE); + end + else + break; + { allow for newline as in gas styled syntax } + while actasmtoken=AS_SEPARATOR do + Consume(AS_SEPARATOR); + until (actasmtoken<>AS_OPCODE); + { 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; + opsize:=ActOpsize; + end; + + { Valid combination of prefix/override and instruction ? } + + if (prefixop<>A_NONE) and (NOT CheckPrefix(PrefixOp,actopcode)) then + Message1(asmr_e_invalid_prefix_and_opcode,actasmpattern); + + if (overrideop<>A_NONE) and (NOT CheckOverride(OverrideOp,ActOpcode)) then + Message1(asmr_e_invalid_override_and_opcode,actasmpattern); + { 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 operandnum > Max_Operands then + Message(asmr_e_too_many_operands) + else + Inc(operandnum); + Consume(AS_COMMA); + end; + AS_SEPARATOR, + AS_END : { End of asm operands for this opcode } + begin + break; + end; + else + BuildOperand(instr.Operands[operandnum] as tx86operand); + end; { end case } + until false; + instr.Ops:=operandnum; + end; + + + function tx86attreader.is_asmopcode(const s: string):boolean; + var + cond : string[4]; + cnd : tasmcond; + len, + j, + sufidx, + suflen : longint; + Begin + is_asmopcode:=FALSE; + + actopcode:=A_None; + actcondition:=C_None; + actopsize:=S_NO; + + { search for all possible suffixes } + for sufidx:=low(att_sizesuffixstr) to high(att_sizesuffixstr) do + begin + suflen:=length(att_sizesuffixstr[sufidx]); + len:=length(s)-suflen; + if copy(s,len+1,suflen)=att_sizesuffixstr[sufidx] then + begin + { Search opcodes } + if len>0 then + begin + actopcode:=tasmop(PtrUInt(iasmops.Find(copy(s,1,len)))); + + { two-letter suffix is allowed by just a few instructions (movsx,movzx), + and it is always required whenever allowed } + if (gas_needsuffix[actopcode]=attsufINTdual) xor (suflen=2) then + continue; + + if actopcode<>A_NONE then + begin + if gas_needsuffix[actopcode]=attsufFPU then + actopsize:=att_sizefpusuffix[sufidx] + else if gas_needsuffix[actopcode]=attsufFPUint then + actopsize:=att_sizefpuintsuffix[sufidx] + else + actopsize:=att_sizesuffix[sufidx]; + { only accept suffix from the same category that the opcode belongs to } + if (actopsize<>S_NO) or (suflen=0) then + begin + actasmtoken:=AS_OPCODE; + is_asmopcode:=TRUE; + exit; + end; + end; + end; + { not found, check condition opcodes } + j:=0; + while (j<CondAsmOps) do + begin + if Copy(s,1,Length(CondAsmOpStr[j]))=CondAsmOpStr[j] then + begin + cond:=Copy(s,Length(CondAsmOpStr[j])+1,len-Length(CondAsmOpStr[j])); + if cond<>'' then + begin + for cnd:=low(TasmCond) to high(TasmCond) do + if Cond=Upper(cond2str[cnd]) then + begin + actopcode:=CondASmOp[j]; + if gas_needsuffix[actopcode]=attsufFPU then + actopsize:=att_sizefpusuffix[sufidx] + else if gas_needsuffix[actopcode]=attsufFPUint then + actopsize:=att_sizefpuintsuffix[sufidx] + else + actopsize:=att_sizesuffix[sufidx]; + { only accept suffix from the same category that the opcode belongs to } + if (actopsize<>S_NO) or (suflen=0) then + begin + actcondition:=cnd; + actasmtoken:=AS_OPCODE; + is_asmopcode:=TRUE; + exit; + end; + end; + end; + end; + inc(j); + end; + end; + end; + end; + + + procedure tx86attreader.handleopcode; + var + instr : Tx86Instruction; + begin + instr:=Tx86attInstruction.Create(Tx86Operand); + instr.OpOrder:=op_att; + BuildOpcode(instr); + instr.AddReferenceSizes; + instr.SetInstructionOpsize; + instr.CheckOperandSizes; + instr.FixupOpcode; + instr.ConcatInstruction(curlist); + instr.Free; + end; + + +end. diff --git a/closures/compiler/x86/rax86int.pas b/closures/compiler/x86/rax86int.pas new file mode 100644 index 0000000000..e5536a1083 --- /dev/null +++ b/closures/compiler/x86/rax86int.pas @@ -0,0 +1,2238 @@ +{ + Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman + + Does the parsing process for the intel 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 Rax86int; + +{$i fpcdefs.inc} + + interface + + uses + cclasses, + cpubase, + globtype, + aasmbase, + rasm, + rax86; + + type + tasmtoken = ( + AS_NONE,AS_LABEL,AS_LLABEL,AS_STRING,AS_INTNUM, + AS_COMMA,AS_LBRACKET,AS_RBRACKET,AS_LPAREN, + AS_RPAREN,AS_COLON,AS_DOT,AS_PLUS,AS_MINUS,AS_STAR, + AS_SEPARATOR,AS_ID,AS_REGISTER,AS_OPCODE,AS_SLASH, + {------------------ Assembler directives --------------------} + AS_ALIGN,AS_DB,AS_DW,AS_DD,AS_DQ,AS_END, + {------------------ Assembler Operators --------------------} + AS_BYTE,AS_WORD,AS_DWORD,AS_QWORD,AS_TBYTE,AS_DQWORD,AS_NEAR,AS_FAR, + AS_HIGH,AS_LOW,AS_OFFSET,AS_SIZEOF,AS_VMTOFFSET,AS_SEG,AS_TYPE,AS_PTR,AS_MOD,AS_SHL,AS_SHR,AS_NOT, + AS_AND,AS_OR,AS_XOR); + + type + tx86intreader = class(tasmreader) + actasmtoken : tasmtoken; + prevasmtoken : tasmtoken; + ActOpsize : topsize; + constructor create;override; + function is_asmopcode(const s: string):boolean; + function is_asmoperator(const s: string):boolean; + function is_asmdirective(const s: string):boolean; + function is_register(const s:string):boolean; + function is_locallabel(const s:string):boolean; + function Assemble: tlinkedlist;override; + procedure GetToken; + function consume(t : tasmtoken):boolean; + procedure RecoverConsume(allowcomma:boolean); + procedure BuildRecordOffsetSize(const expr: string;var offset:aint;var size:aint; var mangledname: string; needvmtofs: boolean); + procedure BuildConstSymbolExpression(needofs,isref,startingminus:boolean;var value:aint;var asmsym:string;var asmsymtyp:TAsmsymtype); + function BuildConstExpression:aint; + function BuildRefConstExpression:aint; + procedure BuildReference(oper : tx86operand); + procedure BuildOperand(oper: tx86operand;istypecast:boolean); + procedure BuildConstantOperand(oper: tx86operand); + procedure BuildOpCode(instr : tx86instruction); + procedure BuildConstant(constsize: byte); + end; + + + implementation + + uses + { common } + cutils, + { global } + globals,verbose, + systems, + { aasm } + aasmtai,aasmdata,aasmcpu, + { symtable } + symconst,symbase,symtype,symsym,symdef,symtable, + { parser } + scanner, + { register allocator } + rabase,rautils,itx86int, + { codegen } + cgbase,cgobj,procinfo + ; + + type + tasmkeyword = string[9]; + + + const + { These tokens should be modified accordingly to the modifications } + { in the different enumerations. } + firstdirective = AS_ALIGN; + lastdirective = AS_END; + firstoperator = AS_BYTE; + lastoperator = AS_XOR; + + _count_asmdirectives = longint(lastdirective)-longint(firstdirective); + _count_asmoperators = longint(lastoperator)-longint(firstoperator); + + _asmdirectives : array[0.._count_asmdirectives] of tasmkeyword = + ('ALIGN','DB','DW','DD','DQ','END'); + + { problems with shl,shr,not,and,or and xor, they are } + { context sensitive. } + _asmoperators : array[0.._count_asmoperators] of tasmkeyword = ( + 'BYTE','WORD','DWORD','QWORD','TBYTE','DQWORD','NEAR','FAR','HIGH', + 'LOW','OFFSET','SIZEOF','VMTOFFSET','SEG','TYPE','PTR','MOD','SHL','SHR','NOT','AND', + 'OR','XOR'); + + token2str : array[tasmtoken] of string[10] = ( + '','Label','LLabel','String','Integer', + ',','[',']','(', + ')',':','.','+','-','*', + ';','identifier','register','opcode','/', + '','','','','','END', + '','','','','','','','','', + '','','sizeof','vmtoffset','','type','ptr','mod','shl','shr','not', + 'and','or','xor' + ); + + var + inexpression : boolean; + + constructor tx86intreader.create; + var + i : tasmop; + Begin + inherited create; + iasmops:=TFPHashList.create; + for i:=firstop to lastop do + iasmops.Add(upper(std_op2str[i]),Pointer(PtrInt(i))); + end; + + +{---------------------------------------------------------------------} +{ Routines for the tokenizing } +{---------------------------------------------------------------------} + + + function tx86intreader.is_asmopcode(const s: string):boolean; + var + cond : string[4]; + cnd : tasmcond; + j: longint; + Begin + is_asmopcode:=FALSE; + + actopcode:=A_None; + actcondition:=C_None; + actopsize:=S_NO; + + { Search opcodes } + actopcode:=tasmop(PtrUInt(iasmops.Find(s))); + if actopcode<>A_NONE then + begin + actasmtoken:=AS_OPCODE; + result:=TRUE; + exit; + end; + + { not found yet, check condition opcodes } + j:=0; + while (j<CondAsmOps) do + begin + if Copy(s,1,Length(CondAsmOpStr[j]))=CondAsmOpStr[j] then + begin + cond:=Copy(s,Length(CondAsmOpStr[j])+1,255); + if cond<>'' then + begin + for cnd:=low(TasmCond) to high(TasmCond) do + if Cond=Upper(cond2str[cnd]) then + begin + actopcode:=CondASmOp[j]; + actcondition:=cnd; + is_asmopcode:=TRUE; + actasmtoken:=AS_OPCODE; + exit + end; + end; + end; + inc(j); + end; + end; + + + function tx86intreader.is_asmoperator(const s: string):boolean; + var + i : longint; + Begin + for i:=0 to _count_asmoperators do + if s=_asmoperators[i] then + begin + actasmtoken:=tasmtoken(longint(firstoperator)+i); + is_asmoperator:=true; + exit; + end; + is_asmoperator:=false; + end; + + + Function tx86intreader.is_asmdirective(const s: string):boolean; + var + i : longint; + Begin + for i:=0 to _count_asmdirectives do + if s=_asmdirectives[i] then + begin + actasmtoken:=tasmtoken(longint(firstdirective)+i); + is_asmdirective:=true; + exit; + end; + is_asmdirective:=false; + end; + + + function tx86intreader.is_register(const s:string):boolean; + var + entry: TSymEntry; + begin + is_register:=false; + actasmregister:=masm_regnum_search(lower(s)); + if (actasmregister=NR_NO) and + (current_procinfo.procdef.proccalloption=pocall_register) and + (po_assembler in current_procinfo.procdef.procoptions) then + begin + entry:=current_procinfo.procdef.parast.Find(s); + if assigned(entry) and + (entry.typ=paravarsym) and + assigned(tparavarsym(entry).paraloc[calleeside].Location) and + (tparavarsym(entry).paraloc[calleeside].Location^.Loc=LOC_REGISTER) then + actasmregister:=tparavarsym(entry).paraloc[calleeside].Location^.register; + end; + if actasmregister<>NR_NO then + begin + is_register:=true; + actasmtoken:=AS_REGISTER; + end; + end; + + + function tx86intreader.is_locallabel(const s:string):boolean; + begin + is_locallabel:=(length(s)>1) and (s[1]='@'); + end; + + + Procedure tx86intreader.GetToken; + var + len : longint; + forcelabel : boolean; + srsym : tsym; + srsymtable : TSymtable; + begin + { save old token and reset new token } + prevasmtoken:=actasmtoken; + actasmtoken:=AS_NONE; + { reset } + forcelabel:=FALSE; + actasmpattern:=''; + { while space and tab , continue scan... } + while (c in [' ',#9]) do + c:=current_scanner.asmgetchar; + { get token pos } + if not (c in [#10,#13,'{',';']) then + current_scanner.gettokenpos; + { Local Label, Label, Directive, Prefix or Opcode } + if firsttoken and not (c in [#10,#13,'{',';']) then + begin + firsttoken:=FALSE; + len:=0; + while c in ['A'..'Z','a'..'z','0'..'9','_','@'] do + begin + { if there is an at_sign, then this must absolutely be a label } + if c = '@' then + forcelabel:=TRUE; + inc(len); + actasmpattern[len]:=c; + c:=current_scanner.asmgetchar; + end; + actasmpattern[0]:=chr(len); + uppervar(actasmpattern); + { allow spaces } + while (c in [' ',#9]) do + c:=current_scanner.asmgetchar; + { label ? } + if c = ':' then + begin + if actasmpattern[1]='@' then + actasmtoken:=AS_LLABEL + else + actasmtoken:=AS_LABEL; + { let us point to the next character } + c:=current_scanner.asmgetchar; + firsttoken:=true; + exit; + end; + { Are we trying to create an identifier with } + { an at-sign...? } + if forcelabel then + Message(asmr_e_none_label_contain_at); + { opcode ? } + If is_asmopcode(actasmpattern) then + Begin + { check if we are in an expression } + { then continue with asm directives } + if not inexpression then + exit; + end; + if is_asmdirective(actasmpattern) then + exit; + message1(asmr_e_unknown_opcode,actasmpattern); + actasmtoken:=AS_NONE; + exit; + end + else { else firsttoken } + begin + case c of + '@' : { possiblities : - local label reference , such as in jmp @local1 } + { - @Result, @Code or @Data special variables. } + begin + actasmpattern:=c; + c:=current_scanner.asmgetchar; + while c in ['A'..'Z','a'..'z','0'..'9','_','@'] do + begin + actasmpattern:=actasmpattern + c; + c:=current_scanner.asmgetchar; + end; + uppervar(actasmpattern); + actasmtoken:=AS_ID; + exit; + end; + + 'A'..'Z','a'..'z','_': { identifier, register, opcode, prefix or directive } + begin + actasmpattern:=c; + c:=current_scanner.asmgetchar; + while c in ['A'..'Z','a'..'z','0'..'9','_'] do + begin + actasmpattern:=actasmpattern + c; + c:=current_scanner.asmgetchar; + end; + uppervar(actasmpattern); + { after prefix we allow also a new opcode } + If is_prefix(actopcode) and is_asmopcode(actasmpattern) then + Begin + { if we are not in a constant } + { expression than this is an } + { opcode. } + if not inexpression then + exit; + end; + { support st(X) for fpu registers } + if (actasmpattern = 'ST') and (c='(') then + Begin + actasmpattern:=actasmpattern+c; + c:=current_scanner.asmgetchar; + { allow spaces } + while (c in [' ',#9]) do + c:=current_scanner.asmgetchar; + if c in ['0'..'7'] then + actasmpattern:=actasmpattern + c + else + Message(asmr_e_invalid_fpu_register); + c:=current_scanner.asmgetchar; + { allow spaces } + while (c in [' ',#9]) do + c:=current_scanner.asmgetchar; + if c <> ')' then + Message(asmr_e_invalid_fpu_register) + else + Begin + actasmpattern:=actasmpattern + c; + c:=current_scanner.asmgetchar; + end; + end; + if is_asmdirective(actasmpattern) then + exit; + if is_asmoperator(actasmpattern) then + exit; + if is_register(actasmpattern) then + exit; + { allow spaces } + while (c in [' ',#9]) do + c:=current_scanner.asmgetchar; + { if next is a '.' and this is a unitsym then we also need to + parse the identifier } + if (c='.') then + begin + asmsearchsym(actasmpattern,srsym,srsymtable); + if assigned(srsym) and + (srsym.typ=unitsym) and + (srsym.owner.symtabletype in [staticsymtable,globalsymtable]) and + srsym.owner.iscurrentunit then + begin + { Add . to create System.Identifier } + actasmpattern:=actasmpattern+c; + c:=current_scanner.asmgetchar; + { Delphi allows System.@Halt, just ignore the @ } + if c='@' then + c:=current_scanner.asmgetchar; + while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do + begin + actasmpattern:=actasmpattern + upcase(c); + c:=current_scanner.asmgetchar; + end; + end; + end; + actasmtoken:=AS_ID; + exit; + end; + + '''' : { string or character } + begin + actasmpattern:=''; + current_scanner.in_asm_string:=true; + repeat + if c = '''' then + begin + c:=current_scanner.asmgetchar; + if c in [#10,#13] then + begin + Message(scan_f_string_exceeds_line); + break; + end; + repeat + if c='''' then + begin + c:=current_scanner.asmgetchar; + if c='''' then + begin + actasmpattern:=actasmpattern+''''; + c:=current_scanner.asmgetchar; + if c in [#10,#13] then + begin + Message(scan_f_string_exceeds_line); + break; + end; + end + else + break; + end + else + begin + actasmpattern:=actasmpattern+c; + c:=current_scanner.asmgetchar; + if c in [#10,#13] then + begin + Message(scan_f_string_exceeds_line); + break + end; + end; + until false; { end repeat } + end + else + break; { end if } + until false; + current_scanner.in_asm_string:=false; + actasmtoken:=AS_STRING; + exit; + end; + + '"' : { string or character } + begin + current_scanner.in_asm_string:=true; + actasmpattern:=''; + repeat + if c = '"' then + begin + c:=current_scanner.asmgetchar; + if c in [#10,#13] then + begin + Message(scan_f_string_exceeds_line); + break; + end; + repeat + if c='"' then + begin + c:=current_scanner.asmgetchar; + if c='"' then + begin + actasmpattern:=actasmpattern+'"'; + c:=current_scanner.asmgetchar; + if c in [#10,#13] then + begin + Message(scan_f_string_exceeds_line); + break; + end; + end + else + break; + end + else + begin + actasmpattern:=actasmpattern+c; + c:=current_scanner.asmgetchar; + if c in [#10,#13] then + begin + Message(scan_f_string_exceeds_line); + break + end; + end; + until false; { end repeat } + end + else + break; { end if } + until false; + current_scanner.in_asm_string:=false; + actasmtoken:=AS_STRING; + exit; + end; + + '$' : + begin + c:=current_scanner.asmgetchar; + while c in ['0'..'9','A'..'F','a'..'f'] do + begin + actasmpattern:=actasmpattern + c; + c:=current_scanner.asmgetchar; + end; + actasmpattern:=tostr(ParseVal(actasmpattern,16)); + actasmtoken:=AS_INTNUM; + exit; + end; + + '&' : { identifier } + begin + actasmpattern:=''; + c:=current_scanner.asmgetchar; + while c in ['A'..'Z','a'..'z','0'..'9','_'] do + begin + actasmpattern:=actasmpattern + c; + c:=current_scanner.asmgetchar; + end; + uppervar(actasmpattern); + actasmtoken:=AS_ID; + exit; + end; + + ',' : + begin + actasmtoken:=AS_COMMA; + c:=current_scanner.asmgetchar; + exit; + end; + + '[' : + begin + actasmtoken:=AS_LBRACKET; + c:=current_scanner.asmgetchar; + exit; + end; + + ']' : + begin + actasmtoken:=AS_RBRACKET; + c:=current_scanner.asmgetchar; + exit; + end; + + '(' : + begin + actasmtoken:=AS_LPAREN; + c:=current_scanner.asmgetchar; + exit; + end; + + ')' : + begin + actasmtoken:=AS_RPAREN; + c:=current_scanner.asmgetchar; + exit; + end; + + ':' : + begin + actasmtoken:=AS_COLON; + c:=current_scanner.asmgetchar; + exit; + end; + + '.' : + begin + actasmtoken:=AS_DOT; + c:=current_scanner.asmgetchar; + exit; + end; + + '+' : + begin + actasmtoken:=AS_PLUS; + c:=current_scanner.asmgetchar; + exit; + end; + + '-' : + begin + actasmtoken:=AS_MINUS; + c:=current_scanner.asmgetchar; + exit; + end; + + '*' : + begin + actasmtoken:=AS_STAR; + c:=current_scanner.asmgetchar; + exit; + end; + + '/' : + begin + actasmtoken:=AS_SLASH; + c:=current_scanner.asmgetchar; + exit; + end; + + '0'..'9': + begin + actasmpattern:=c; + c:=current_scanner.asmgetchar; + { Get the possible characters } + while c in ['0'..'9','A'..'F','a'..'f'] do + begin + actasmpattern:=actasmpattern + c; + c:=current_scanner.asmgetchar; + end; + { Get ending character } + uppervar(actasmpattern); + c:=upcase(c); + { possibly a binary number. } + if (actasmpattern[length(actasmpattern)] = 'B') and (c <> 'H') then + Begin + { Delete the last binary specifier } + delete(actasmpattern,length(actasmpattern),1); + actasmpattern:=tostr(ParseVal(actasmpattern,2)); + actasmtoken:=AS_INTNUM; + exit; + end + else + Begin + case c of + 'O' : + Begin + actasmpattern:=tostr(ParseVal(actasmpattern,8)); + actasmtoken:=AS_INTNUM; + c:=current_scanner.asmgetchar; + exit; + end; + 'H' : + Begin + actasmpattern:=tostr(ParseVal(actasmpattern,16)); + actasmtoken:=AS_INTNUM; + c:=current_scanner.asmgetchar; + exit; + end; + else { must be an integer number } + begin + actasmpattern:=tostr(ParseVal(actasmpattern,10)); + actasmtoken:=AS_INTNUM; + exit; + end; + end; + end; + end; + ';','{',#13,#10 : + begin + c:=current_scanner.asmgetchar; + firsttoken:=TRUE; + actasmtoken:=AS_SEPARATOR; + exit; + end; + + else + current_scanner.illegal_char(c); + end; + end; + end; + + + function tx86intreader.consume(t : tasmtoken):boolean; + begin + Consume:=true; + if t<>actasmtoken then + begin + Message2(scan_f_syn_expected,token2str[t],token2str[actasmtoken]); + Consume:=false; + end; + repeat + gettoken; + until actasmtoken<>AS_NONE; + end; + + + procedure tx86intreader.RecoverConsume(allowcomma:boolean); + begin + While not (actasmtoken in [AS_SEPARATOR,AS_END]) do + begin + if allowcomma and (actasmtoken=AS_COMMA) then + break; + Consume(actasmtoken); + end; + end; + + +{***************************************************************************** + Parsing Helpers +*****************************************************************************} + + { This routine builds up a record offset after a AS_DOT + token is encountered. + On entry actasmtoken should be equal to AS_DOT } + Procedure tx86intreader.BuildRecordOffsetSize(const expr: string;var offset:aint;var size:aint; var mangledname: string; needvmtofs: boolean); + var + s: string; + Begin + offset:=0; + size:=0; + s:=expr; + while (actasmtoken=AS_DOT) do + begin + Consume(AS_DOT); + if actasmtoken in [AS_BYTE,AS_ID,AS_WORD,AS_DWORD,AS_QWORD,AS_REGISTER] then + begin + s:=s+'.'+actasmpattern; + consume(actasmtoken); + end + else + begin + Consume(AS_ID); + RecoverConsume(true); + break; + end; + end; + if not GetRecordOffsetSize(s,offset,size,mangledname,needvmtofs) then + Message(asmr_e_building_record_offset); + end; + + + Procedure tx86intreader.BuildConstSymbolExpression(needofs,isref,startingminus:boolean;var value:aint;var asmsym:string;var asmsymtyp:TAsmsymtype); + var + tempstr,expr,hs,mangledname : string; + parenlevel : longint; + l,k : aint; + hasparen, + errorflag, + needvmtofs : boolean; + prevtok : tasmtoken; + hl : tasmlabel; + hssymtyp : Tasmsymtype; + def : tdef; + sym : tsym; + srsymtable : TSymtable; + Begin + { reset } + value:=0; + asmsym:=''; + asmsymtyp:=AT_DATA; + errorflag:=FALSE; + tempstr:=''; + expr:=''; + if startingminus then + expr:='-'; + inexpression:=TRUE; + parenlevel:=0; + sym:=nil; + needvmtofs:=FALSE; + Repeat + { Support ugly delphi constructs like: [ECX].1+2[EDX] } + if isref and (actasmtoken=AS_LBRACKET) then + break; + Case actasmtoken of + AS_LPAREN: + Begin + Consume(AS_LPAREN); + expr:=expr + '('; + inc(parenlevel); + end; + AS_RPAREN: + Begin + { Keep the AS_PAREN in actasmtoken, it is maybe a typecast } + if parenlevel=0 then + break; + Consume(AS_RPAREN); + expr:=expr + ')'; + dec(parenlevel); + end; + AS_SHL: + Begin + Consume(AS_SHL); + expr:=expr + '<'; + end; + AS_SHR: + Begin + Consume(AS_SHR); + expr:=expr + '>'; + end; + AS_SLASH: + Begin + Consume(AS_SLASH); + expr:=expr + '/'; + end; + AS_MOD: + Begin + Consume(AS_MOD); + expr:=expr + '%'; + end; + AS_STAR: + Begin + Consume(AS_STAR); + if isref and (actasmtoken=AS_REGISTER) then + break; + expr:=expr + '*'; + end; + AS_PLUS: + Begin + Consume(AS_PLUS); + if isref and (actasmtoken=AS_REGISTER) then + break; + expr:=expr + '+'; + end; + AS_MINUS: + Begin + Consume(AS_MINUS); + expr:=expr + '-'; + end; + AS_AND: + Begin + Consume(AS_AND); + expr:=expr + '&'; + end; + AS_NOT: + Begin + Consume(AS_NOT); + expr:=expr + '~'; + end; + AS_XOR: + Begin + Consume(AS_XOR); + expr:=expr + '^'; + end; + AS_OR: + Begin + Consume(AS_OR); + expr:=expr + '|'; + end; + AS_INTNUM: + Begin + expr:=expr + actasmpattern; + Consume(AS_INTNUM); + end; + AS_VMTOFFSET, + AS_OFFSET: + begin + if (actasmtoken = AS_OFFSET) then + needofs:=true + else + needvmtofs:=true; + Consume(actasmtoken); + if actasmtoken<>AS_ID then + Message(asmr_e_offset_without_identifier); + end; + AS_SIZEOF, + AS_TYPE: + begin + l:=0; + hasparen:=false; + Consume(actasmtoken); + if actasmtoken=AS_LPAREN then + begin + hasparen:=true; + Consume(AS_LPAREN); + end; + if actasmtoken<>AS_ID then + Message(asmr_e_type_without_identifier) + else + begin + tempstr:=actasmpattern; + Consume(AS_ID); + if actasmtoken=AS_DOT then + begin + BuildRecordOffsetSize(tempstr,k,l,mangledname,false); + if mangledname<>'' then + { procsym } + Message(asmr_e_wrong_sym_type); + end + else + begin + asmsearchsym(tempstr,sym,srsymtable); + if assigned(sym) then + begin + case sym.typ of + staticvarsym, + localvarsym, + paravarsym : + l:=tabstractvarsym(sym).getsize; + typesym : + l:=ttypesym(sym).typedef.size; + else + Message(asmr_e_wrong_sym_type); + end; + end + else + Message1(sym_e_unknown_id,tempstr); + end; + end; + str(l, tempstr); + expr:=expr + tempstr; + if hasparen then + Consume(AS_RPAREN); + end; + AS_PTR : + begin + { Support ugly delphi constructs like <constant> PTR [ref] } + break; + end; + AS_STRING: + begin + l:=0; + case Length(actasmpattern) of + 1 : + l:=ord(actasmpattern[1]); + 2 : + l:=ord(actasmpattern[2]) + ord(actasmpattern[1]) shl 8; + 3 : + l:=ord(actasmpattern[3]) + + Ord(actasmpattern[2]) shl 8 + ord(actasmpattern[1]) shl 16; + 4 : + l:=ord(actasmpattern[4]) + ord(actasmpattern[3]) shl 8 + + Ord(actasmpattern[2]) shl 16 + ord(actasmpattern[1]) shl 24; + else + Message1(asmr_e_invalid_string_as_opcode_operand,actasmpattern); + end; + str(l, tempstr); + expr:=expr + tempstr; + Consume(AS_STRING); + end; + AS_ID: + begin + hs:=''; + hssymtyp:=AT_DATA; + def:=nil; + tempstr:=actasmpattern; + prevtok:=prevasmtoken; + { stop parsing a constant expression if we find an opcode after a + non-operator like "db $66 mov eax,ebx" } + if (prevtok in [AS_ID,AS_INTNUM,AS_RPAREN]) and + is_asmopcode(actasmpattern) then + break; + consume(AS_ID); + if SearchIConstant(tempstr,l) then + begin + str(l, tempstr); + expr:=expr + tempstr; + end + else + begin + if is_locallabel(tempstr) then + begin + CreateLocalLabel(tempstr,hl,false); + hs:=hl.name; + hssymtyp:=AT_FUNCTION; + end + else + if SearchLabel(tempstr,hl,false) then + begin + hs:=hl.name; + hssymtyp:=AT_FUNCTION; + end + else + begin + asmsearchsym(tempstr,sym,srsymtable); + if assigned(sym) then + begin + case sym.typ of + staticvarsym : + begin + hs:=tstaticvarsym(sym).mangledname; + def:=tstaticvarsym(sym).vardef; + end; + localvarsym, + paravarsym : + begin + Message(asmr_e_no_local_or_para_allowed); + end; + procsym : + begin + if Tprocsym(sym).ProcdefList.Count>1 then + Message(asmr_w_calling_overload_func); + hs:=tprocdef(tprocsym(sym).ProcdefList[0]).mangledname; + hssymtyp:=AT_FUNCTION; + end; + typesym : + begin + if not(ttypesym(sym).typedef.typ in [recorddef,objectdef]) then + Message(asmr_e_wrong_sym_type); + end; + fieldvarsym : + begin + tempstr:=upper(tdef(sym.owner.defowner).GetTypeName)+'.'+tempstr; + end; + else + Message(asmr_e_wrong_sym_type); + end; + end + else + Message1(sym_e_unknown_id,tempstr); + end; + { symbol found? } + if hs<>'' then + begin + if asmsym='' then + begin + asmsym:=hs; + asmsymtyp:=hssymtyp; + end + else + Message(asmr_e_cant_have_multiple_relocatable_symbols); + if (expr='') or (expr[length(expr)]='+') then + begin + { don't remove the + if there could be a record field } + if actasmtoken<>AS_DOT then + delete(expr,length(expr),1); + end + else + if needofs then + begin + if (prevtok<>AS_OFFSET) then + Message(asmr_e_need_offset); + end + else + Message(asmr_e_only_add_relocatable_symbol); + end; + if (actasmtoken=AS_DOT) or + (assigned(sym) and + (sym.typ = fieldvarsym)) then + begin + BuildRecordOffsetSize(tempstr,l,k,hs,needvmtofs); + if hs <> '' then + hssymtyp:=AT_FUNCTION + else + begin + str(l, tempstr); + expr:=expr + tempstr; + end + end + else + begin + if (expr='') or (expr[length(expr)] in ['+','-','/','*']) then + delete(expr,length(expr),1); + end; + if (actasmtoken=AS_LBRACKET) and + assigned(def) and + (def.typ=arraydef) then + begin + consume(AS_LBRACKET); + l:=BuildConstExpression; + if l<tarraydef(def).lowrange then + begin + Message(asmr_e_constant_out_of_bounds); + l:=0; + end + else + l:=(l-tarraydef(def).lowrange)*tarraydef(def).elesize; + str(l, tempstr); + expr:=expr + '+' + tempstr; + consume(AS_RBRACKET); + end; + end; + { check if there are wrong operator used like / or mod etc. } + if (hs<>'') and not(actasmtoken in [AS_MINUS,AS_PLUS,AS_COMMA,AS_SEPARATOR,AS_END,AS_RBRACKET]) then + Message(asmr_e_only_add_relocatable_symbol); + end; + AS_ALIGN, + AS_DB, + AS_DW, + AS_DD, + AS_DQ, + AS_END, + AS_RBRACKET, + AS_SEPARATOR, + AS_COMMA, + AS_COLON: + break; + else + begin + { write error only once. } + if not errorflag then + Message(asmr_e_invalid_constant_expression); + { consume tokens until we find COMMA or SEPARATOR } + Consume(actasmtoken); + errorflag:=TRUE; + end; + end; + Until false; + { calculate expression } + if not ErrorFlag then + value:=CalculateExpression(expr) + else + value:=0; + { no longer in an expression } + inexpression:=FALSE; + end; + + + Function tx86intreader.BuildConstExpression:aint; + var + l : aint; + hs : string; + hssymtyp : TAsmsymtype; + begin + BuildConstSymbolExpression(false,false,false,l,hs,hssymtyp); + if hs<>'' then + Message(asmr_e_relocatable_symbol_not_allowed); + BuildConstExpression:=l; + end; + + + Function tx86intreader.BuildRefConstExpression:aint; + var + l : aint; + hs : string; + hssymtyp : TAsmsymtype; + begin + BuildConstSymbolExpression(false,true,false,l,hs,hssymtyp); + if hs<>'' then + Message(asmr_e_relocatable_symbol_not_allowed); + BuildRefConstExpression:=l; + end; + + + procedure tx86intreader.BuildReference(oper : tx86operand); + var + scale : byte; + k,l : aint; + tempstr,hs : string; + tempsymtyp : tasmsymtype; + code : integer; + hreg : tregister; + GotStar,GotOffset,HadVar, + GotPlus,Negative : boolean; + hl : tasmlabel; + Begin + Consume(AS_LBRACKET); + if not(oper.opr.typ in [OPR_LOCAL,OPR_REFERENCE]) then + oper.InitRef; + GotStar:=false; + GotPlus:=true; + GotOffset:=false; + Negative:=false; + Scale:=0; + repeat + if GotOffset and (actasmtoken<>AS_ID) then + Message(asmr_e_invalid_reference_syntax); + + Case actasmtoken of + AS_ID, { Constant reference expression OR variable reference expression } + AS_VMTOFFSET: + Begin + if not GotPlus then + Message(asmr_e_invalid_reference_syntax); + GotStar:=false; + GotPlus:=false; + if (actasmtoken = AS_VMTOFFSET) or + (SearchIConstant(actasmpattern,l) or + SearchRecordType(actasmpattern)) then + begin + l:=BuildRefConstExpression; + GotPlus:=(prevasmtoken=AS_PLUS); + GotStar:=(prevasmtoken=AS_STAR); + case oper.opr.typ of + OPR_LOCAL : + begin + if GotStar then + Message(asmr_e_invalid_reference_syntax); + if negative then + Dec(oper.opr.localsymofs,l) + else + Inc(oper.opr.localsymofs,l); + end; + OPR_REFERENCE : + begin + if GotStar then + oper.opr.ref.scalefactor:=l + else + begin + if negative then + Dec(oper.opr.ref.offset,l) + else + Inc(oper.opr.ref.offset,l); + end; + end; + end; + end + else + Begin + if negative and not oper.hasvar then + Message(asmr_e_only_add_relocatable_symbol) + else if oper.hasvar and not GotOffset and + (not negative or assigned(oper.opr.ref.relsymbol)) then + Message(asmr_e_cant_have_multiple_relocatable_symbols); + HadVar:=oper.hasvar and GotOffset; + tempstr:=actasmpattern; + Consume(AS_ID); + { typecasting? } + if (actasmtoken=AS_LPAREN) and + SearchType(tempstr,l) then + begin + oper.hastype:=true; + oper.typesize:=l; + Consume(AS_LPAREN); + BuildOperand(oper,true); + Consume(AS_RPAREN); + end + else + if is_locallabel(tempstr) then + begin + CreateLocalLabel(tempstr,hl,false); + oper.InitRef; + if not negative then + begin + oper.opr.ref.symbol:=hl; + oper.hasvar:=true; + end + else + oper.opr.ref.relsymbol:=hl; + end + else + if oper.SetupVar(tempstr,GotOffset) then + begin + { force OPR_LOCAL to be a reference } + if oper.opr.typ=OPR_LOCAL then + oper.opr.localforceref:=true; + end + else + Message1(sym_e_unknown_id,tempstr); + { record.field ? } + if actasmtoken=AS_DOT then + begin + BuildRecordOffsetSize(tempstr,l,k,hs,false); + if (hs<>'') then + Message(asmr_e_invalid_symbol_ref); + case oper.opr.typ of + OPR_LOCAL : + inc(oper.opr.localsymofs,l); + OPR_REFERENCE : + inc(oper.opr.ref.offset,l); + end; + end; + if GotOffset then + begin + if oper.hasvar and (oper.opr.ref.base=current_procinfo.framepointer) then + begin + if (oper.opr.typ=OPR_REFERENCE) then + oper.opr.ref.base:=NR_NO; + oper.hasvar:=hadvar; + end + else + begin + if oper.hasvar and hadvar then + Message(asmr_e_cant_have_multiple_relocatable_symbols); + { should we allow ?? } + end; + end; + end; + GotOffset:=false; + end; + + AS_PLUS : + Begin + Consume(AS_PLUS); + Negative:=false; + GotPlus:=true; + GotStar:=false; + Scale:=0; + end; + + AS_DOT : + Begin + { Handle like a + } + Consume(AS_DOT); + Negative:=false; + GotPlus:=true; + GotStar:=false; + Scale:=0; + end; + + AS_MINUS : + begin + Consume(AS_MINUS); + Negative:=true; + GotPlus:=true; + GotStar:=false; + Scale:=0; + end; + + AS_STAR : { Scaling, with eax*4 order } + begin + Consume(AS_STAR); + hs:=''; + l:=0; + case actasmtoken of + AS_LPAREN : + l:=BuildConstExpression; + AS_INTNUM: + Begin + hs:=actasmpattern; + Consume(AS_INTNUM); + end; + AS_REGISTER : + begin + case oper.opr.typ of + OPR_REFERENCE : + begin + if oper.opr.ref.scalefactor=0 then + begin + if scale<>0 then + begin + oper.opr.ref.scalefactor:=scale; + scale:=0; + end + else + Message(asmr_e_wrong_scale_factor); + end + else + Message(asmr_e_invalid_reference_syntax); + end; + OPR_LOCAL : + begin + if oper.opr.localscale=0 then + begin + if scale<>0 then + begin + oper.opr.localscale:=scale; + scale:=0; + end + else + Message(asmr_e_wrong_scale_factor); + end + else + Message(asmr_e_invalid_reference_syntax); + end; + end; + end; + else + Message(asmr_e_invalid_reference_syntax); + end; + if actasmtoken<>AS_REGISTER then + begin + if hs<>'' then + val(hs,l,code); + case oper.opr.typ of + OPR_REFERENCE : + oper.opr.ref.scalefactor:=l; + OPR_LOCAL : + oper.opr.localscale:=l; + end; + if l>9 then + Message(asmr_e_wrong_scale_factor); + end; + GotPlus:=false; + GotStar:=false; + end; + + AS_REGISTER : + begin + if not((GotPlus and (not Negative)) or + GotStar) then + Message(asmr_e_invalid_reference_syntax); + hreg:=actasmregister; + Consume(AS_REGISTER); + { this register will be the index: + 1. just read a * + 2. next token is a * + 3. base register is already used } + case oper.opr.typ of + OPR_LOCAL : + begin + if (oper.opr.localindexreg<>NR_NO) then + Message(asmr_e_multiple_index); + oper.opr.localindexreg:=hreg; + if scale<>0 then + begin + oper.opr.localscale:=scale; + scale:=0; + end; + end; + OPR_REFERENCE : + begin + if (GotStar) or + (actasmtoken=AS_STAR) or + (oper.opr.ref.base<>NR_NO) then + begin + if (oper.opr.ref.index<>NR_NO) then + Message(asmr_e_multiple_index); + oper.opr.ref.index:=hreg; + if scale<>0 then + begin + oper.opr.ref.scalefactor:=scale; + scale:=0; + end; + end + else + oper.opr.ref.base:=hreg; + end; + end; + GotPlus:=false; + GotStar:=false; + end; + + AS_OFFSET : + begin + Consume(AS_OFFSET); + GotOffset:=true; + end; + + AS_TYPE, + AS_NOT, + AS_STRING, + AS_INTNUM, + AS_LPAREN : { Constant reference expression } + begin + if not GotPlus and not GotStar then + Message(asmr_e_invalid_reference_syntax); + BuildConstSymbolExpression(true,true,GotPlus and negative,l,tempstr,tempsymtyp); + { already handled by BuildConstSymbolExpression(); must be + handled there to avoid [reg-1+1] being interpreted as + [reg-(1+1)] } + negative:=false; + + if tempstr<>'' then + begin + if GotStar then + Message(asmr_e_only_add_relocatable_symbol); + if not assigned(oper.opr.ref.symbol) then + oper.opr.ref.symbol:=current_asmdata.RefAsmSymbol(tempstr) + else + Message(asmr_e_cant_have_multiple_relocatable_symbols); + end; + case oper.opr.typ of + OPR_REFERENCE : + begin + if GotStar then + oper.opr.ref.scalefactor:=l + else if (prevasmtoken = AS_STAR) then + begin + if scale<>0 then + scale:=l*scale + else + scale:=l; + end + else + Inc(oper.opr.ref.offset,l); + end; + OPR_LOCAL : + begin + if GotStar then + oper.opr.localscale:=l + else if (prevasmtoken = AS_STAR) then + begin + if scale<>0 then + scale:=l*scale + else + scale:=l; + end + else + Inc(oper.opr.localsymofs,l); + end; + end; + GotPlus:=(prevasmtoken=AS_PLUS) or + (prevasmtoken=AS_MINUS); + if GotPlus then + negative := prevasmtoken = AS_MINUS; + GotStar:=(prevasmtoken=AS_STAR); + end; + + AS_RBRACKET : + begin + if GotPlus or GotStar then + Message(asmr_e_invalid_reference_syntax); + Consume(AS_RBRACKET); + break; + end; + + else + Begin + Message(asmr_e_invalid_reference_syntax); + RecoverConsume(true); + break; + end; + end; + until false; + end; + + + Procedure tx86intreader.BuildConstantOperand(oper: tx86operand); + var + l : aint; + tempstr : string; + tempsymtyp : tasmsymtype; + begin + if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then + Message(asmr_e_invalid_operand_type); + BuildConstSymbolExpression(true,false,false,l,tempstr,tempsymtyp); + if tempstr<>'' then + begin + oper.opr.typ:=OPR_SYMBOL; + oper.opr.symofs:=l; + oper.opr.symbol:=current_asmdata.RefAsmSymbol(tempstr); + end + else + if oper.opr.typ=OPR_NONE then + begin + oper.opr.typ:=OPR_CONSTANT; + oper.opr.val:=l; + end + else + inc(oper.opr.val,l); + end; + + + Procedure tx86intreader.BuildOperand(oper: tx86operand;istypecast:boolean); + + procedure AddLabelOperand(hl:tasmlabel); + begin + if (oper.opr.typ=OPR_NONE) 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; + + var + expr, + hs : string; + tempreg : tregister; + l : aint; + hl : tasmlabel; + toffset, + tsize : aint; + begin + expr:=''; + repeat + if actasmtoken=AS_DOT then + begin + if expr<>'' then + begin + BuildRecordOffsetSize(expr,toffset,tsize,hs,false); + if (oper.opr.typ<>OPR_NONE) and + (hs<>'') then + Message(asmr_e_wrong_sym_type); + oper.SetSize(tsize,true); + { we have used the size of a field. Reset the typesize of the record } + oper.typesize:=0; + 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 + and when the parameter is in a register (delphi compatible) } + if (not oper.hastype) and + (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,toffset) + end; + OPR_CONSTANT : + inc(oper.opr.val,toffset); + OPR_REFERENCE : + inc(oper.opr.ref.offset,toffset); + OPR_NONE : + begin + if (hs <> '') then + begin + oper.opr.typ:=OPR_SYMBOL; + oper.opr.symbol:=current_asmdata.RefAsmSymbol(hs); + end + else + begin + oper.opr.typ:=OPR_CONSTANT; + oper.opr.val:=toffset; + end; + end; + OPR_REGISTER : + Message(asmr_e_invalid_reference_syntax); + OPR_SYMBOL: + Message(asmr_e_invalid_symbol_ref); + else + internalerror(200309222); + end; + expr:=''; + end + else + begin + { See it as a separator } + Consume(AS_DOT); + end; + end; + + case actasmtoken of + AS_OFFSET, + AS_SIZEOF, + AS_VMTOFFSET, + AS_TYPE, + AS_NOT, + AS_STRING, + AS_PLUS, + AS_MINUS, + AS_LPAREN, + AS_INTNUM : + begin + case oper.opr.typ of + OPR_REFERENCE : + if (actasmtoken=AS_OFFSET) and + (cs_create_pic in current_settings.moduleswitches) then + begin + Consume(AS_OFFSET); + oper.opr.ref.refaddr:=addr_pic; + BuildOperand(oper,false); + end + else + inc(oper.opr.ref.offset,BuildRefConstExpression); + OPR_LOCAL : + inc(oper.opr.localsymofs,BuildConstExpression); + OPR_NONE, + OPR_CONSTANT : + BuildConstantOperand(oper); + else + Message(asmr_e_invalid_operand_type); + end; + end; + + AS_PTR : + begin + if not oper.hastype then + begin + if (oper.opr.typ=OPR_CONSTANT) then + begin + oper.typesize:=oper.opr.val; + { reset constant value of operand } + oper.opr.typ:=OPR_NONE; + oper.opr.val:=0; + end + else + Message(asmr_e_syn_operand); + end; + Consume(AS_PTR); + oper.InitRef; + { if the operand subscripts a record, the typesize will be + rest -> save it here and restore it afterwards } + l:=oper.typesize; + BuildOperand(oper,false); + oper.setsize(l,true); + end; + + AS_ID : { A constant expression, or a Variable ref. } + Begin + { Label or Special symbol reference? } + if actasmpattern[1] = '@' then + Begin + if actasmpattern = '@RESULT' then + Begin + oper.SetupResult; + Consume(AS_ID); + end + else + if (actasmpattern = '@CODE') or (actasmpattern = '@DATA') then + begin + Message(asmr_w_CODE_and_DATA_not_supported); + Consume(AS_ID); + end + else + { Local Label } + begin + CreateLocalLabel(actasmpattern,hl,false); + Consume(AS_ID); + AddLabelOperand(hl); + end; + end + else + { support result for delphi modes } + if (m_objpas in current_settings.modeswitches) and (actasmpattern='RESULT') then + begin + oper.SetUpResult; + Consume(AS_ID); + end + { probably a variable or normal expression } + { or a procedure (such as in CALL ID) } + else + Begin + { is it a constant ? } + if SearchIConstant(actasmpattern,l) then + Begin + case oper.opr.typ of + OPR_REFERENCE : + inc(oper.opr.ref.offset,BuildRefConstExpression); + OPR_LOCAL : + inc(oper.opr.localsymofs,BuildRefConstExpression); + OPR_NONE, + OPR_CONSTANT : + BuildConstantOperand(oper); + else + Message(asmr_e_invalid_operand_type); + end; + end + else + { Check for pascal label } + if SearchLabel(actasmpattern,hl,false) then + begin + Consume(AS_ID); + AddLabelOperand(hl); + end + else + { is it a normal variable ? } + Begin + expr:=actasmpattern; + Consume(AS_ID); + { typecasting? } + if SearchType(expr,l) then + begin + oper.hastype:=true; + oper.typesize:=l; + case actasmtoken of + AS_LPAREN : + begin + { Support Type([Reference]) } + Consume(AS_LPAREN); + BuildOperand(oper,true); + { Delphi also supports Type(Register) and + interprets it the same as Type([Register]). } + if (oper.opr.typ = OPR_REGISTER) then + { This also sets base to the register. } + oper.InitRef; + Consume(AS_RPAREN); + end; + AS_LBRACKET : + begin + { Support Var.Type[Index] } + { Convert @label.Byte[1] to reference } + if oper.opr.typ=OPR_SYMBOL then + oper.initref; + end; + end; + end + else + begin + if not oper.SetupVar(expr,false) then + Begin + { not a variable, check special variables.. } + if expr = 'SELF' then + oper.SetupSelf + else + Message1(sym_e_unknown_id,expr); + expr:=''; + end; + { indexed access to variable? } + if actasmtoken=AS_LBRACKET then + begin + { ... then the operand size is not known anymore } + oper.size:=OS_NO; + BuildReference(oper); + end; + end; + end; + end; + end; + + AS_REGISTER : { Register, a variable reference or a constant reference } + begin + { save the type of register used. } + tempreg:=actasmregister; + Consume(AS_REGISTER); + if actasmtoken = AS_COLON then + Begin + Consume(AS_COLON); + oper.InitRef; + oper.opr.ref.segment:=tempreg; + BuildReference(oper); + end + else + { Simple register } + begin + if (oper.opr.typ <> OPR_NONE) then + Message(asmr_e_syn_operand); + oper.opr.typ:=OPR_REGISTER; + oper.opr.reg:=tempreg; + oper.SetSize(tcgsize2size[reg_cgsize(oper.opr.reg)],true); + end; + end; + + AS_LBRACKET: { a variable reference, register ref. or a constant reference } + Begin + BuildReference(oper); + end; + + AS_SEG : + Begin + Message(asmr_e_seg_not_supported); + Consume(actasmtoken); + end; + + AS_DWORD, + AS_BYTE, + AS_WORD, + AS_TBYTE, + AS_DQWORD, + AS_QWORD : + begin + { Type specifier } + oper.hastype:=true; + oper.typesize:=0; + case actasmtoken of + AS_DWORD : oper.typesize:=4; + AS_WORD : oper.typesize:=2; + AS_BYTE : oper.typesize:=1; + AS_QWORD : oper.typesize:=8; + AS_DQWORD : oper.typesize:=16; + AS_TBYTE : oper.typesize:=10; + else + internalerror(2010061101); + end; + Consume(actasmtoken); + if (actasmtoken=AS_LPAREN) then + begin + { Support "xxx ptr [Reference]" } + { in case the expression subscripts a record, the typesize + is reset, so save the explicit size we set above } + l:=oper.typesize; + Consume(AS_LPAREN); + BuildOperand(oper,true); + Consume(AS_RPAREN); + oper.setsize(l,true); + end; + end; + + AS_SEPARATOR, + AS_END, + AS_COMMA, + AS_COLON: + begin + break; + end; + + AS_RPAREN: + begin + if not istypecast then + begin + Message(asmr_e_syn_operand); + Consume(AS_RPAREN); + end + else + break; + end; + + else + begin + Message(asmr_e_syn_operand); + RecoverConsume(true); + break; + end; + end; + until false; + { End of operand, update size if a typecast is forced } + if (oper.typesize<>0) and + (oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL]) then + oper.SetSize(oper.typesize,true); + end; + + + Procedure tx86intreader.BuildOpCode(instr : tx86instruction); + var + PrefixOp,OverrideOp: tasmop; + operandnum : longint; + is_far_const:boolean; + i:byte; + begin + PrefixOp:=A_None; + OverrideOp:=A_None; + is_far_const:=false; + { prefix seg opcode / prefix opcode } + repeat + if is_prefix(actopcode) then + with instr do + begin + OpOrder:=op_intel; + PrefixOp:=ActOpcode; + opcode:=ActOpcode; + condition:=ActCondition; + opsize:=ActOpsize; + ConcatInstruction(curlist); + consume(AS_OPCODE); + end + else + if is_override(actopcode) then + with instr do + begin + OpOrder:=op_intel; + OverrideOp:=ActOpcode; + opcode:=ActOpcode; + condition:=ActCondition; + opsize:=ActOpsize; + ConcatInstruction(curlist); + consume(AS_OPCODE); + end + else + break; + { allow for newline after prefix or override } + while actasmtoken=AS_SEPARATOR do + consume(AS_SEPARATOR); + until (actasmtoken<>AS_OPCODE); + { opcode } + if (actasmtoken <> AS_OPCODE) then + begin + Message(asmr_e_invalid_or_missing_opcode); + RecoverConsume(false); + exit; + end; + { Fill the instr object with the current state } + with instr do + begin + OpOrder:=op_intel; + Opcode:=ActOpcode; + condition:=ActCondition; + opsize:=ActOpsize; + + { Valid combination of prefix/override and instruction ? } + if (prefixop<>A_NONE) and (NOT CheckPrefix(PrefixOp,actopcode)) then + Message1(asmr_e_invalid_prefix_and_opcode,actasmpattern); + if (overrideop<>A_NONE) and (NOT CheckOverride(OverrideOp,ActOpcode)) then + Message1(asmr_e_invalid_override_and_opcode,actasmpattern); + end; + { pushf/popf/pusha/popa have to default to 16 bit in Intel mode + (Intel manual and Delphi-compatbile) -- setting the opsize for + these instructions doesn't change anything in the internal assember, + so change the opcode } + if (instr.opcode=A_POPF) then + instr.opcode:=A_POPFW + else if (instr.opcode=A_PUSHF) then + instr.opcode:=A_PUSHFW + else if (instr.opcode=A_PUSHA) then + instr.opcode:=A_PUSHAW + else if (instr.opcode=A_POPA) then + instr.opcode:=A_POPAW; + { We are reading operands, so opcode will be an AS_ID } + operandnum:=1; + is_far_const:=false; + Consume(AS_OPCODE); + { Zero operand opcode ? } + if actasmtoken in [AS_SEPARATOR,AS_END] then + begin + operandnum:=0; + exit; + end; + { Read Operands } + repeat + case actasmtoken of + { End of asm operands for this opcode } + AS_END, + AS_SEPARATOR : + break; + + { Operand delimiter } + AS_COMMA : + begin + if operandnum > Max_Operands then + Message(asmr_e_too_many_operands) + else + Inc(operandnum); + Consume(AS_COMMA); + end; + + {Far constant, i.e. jmp $0000:$11111111.} + AS_COLON: + begin + is_far_const:=true; + if operandnum>1 then + message(asmr_e_too_many_operands) + else + inc(operandnum); + consume(AS_COLON); + end; + + { Type specifier } + AS_NEAR, + AS_FAR : + begin + if actasmtoken = AS_NEAR then + begin + Message(asmr_w_near_ignored); + instr.opsize:=S_NEAR; + end + else + begin + Message(asmr_w_far_ignored); + instr.opsize:=S_FAR; + end; + Consume(actasmtoken); + if actasmtoken=AS_PTR then + begin + Consume(AS_PTR); + instr.Operands[operandnum].InitRef; + end; + BuildOperand(instr.Operands[operandnum] as tx86operand,false); + end; + else + BuildOperand(instr.Operands[operandnum] as tx86operand,false); + end; { end case } + until false; + instr.ops:=operandnum; + { Check operands } + for i:=1 to operandnum do + begin + if is_far_const and + (instr.operands[i].opr.typ<>OPR_CONSTANT) then + message(asmr_e_expr_illegal) + else + if instr.operands[i].opr.typ=OPR_NONE then + Message(asmr_e_syntax_error); + end; + { e.g. for "push dword 1", "push word 6" } + if (instr.ops=1) and + (instr.operands[1].typesize<>0) then + instr.operands[1].setsize(instr.operands[1].typesize,false); + end; + + + Procedure tx86intreader.BuildConstant(constsize: byte); + var + asmsymtyp : tasmsymtype; + asmsym, + expr: string; + value : aint; + Begin + Repeat + Case actasmtoken of + AS_STRING: + Begin + { DD and DW cases } + if constsize <> 1 then + Begin + if Not PadZero(actasmpattern,constsize) then + Message(scan_f_string_exceeds_line); + end; + expr:=actasmpattern; + Consume(AS_STRING); + Case actasmtoken of + AS_COMMA: + Consume(AS_COMMA); + AS_END, + AS_SEPARATOR: ; + else + Message(asmr_e_invalid_string_expression); + end; + ConcatString(curlist,expr); + end; + AS_PLUS, + AS_MINUS, + AS_LPAREN, + AS_NOT, + AS_INTNUM, + AS_ID : + Begin + BuildConstSymbolExpression(false,false,false,value,asmsym,asmsymtyp); + if asmsym<>'' then + begin + if constsize<>sizeof(pint) then + Message1(asmr_w_const32bit_for_address,asmsym); + ConcatConstSymbol(curlist,asmsym,asmsymtyp,value) + end + else + ConcatConstant(curlist,value,constsize); + end; + AS_COMMA: + begin + Consume(AS_COMMA); + end; + AS_ALIGN, + AS_DB, + AS_DW, + AS_DD, + AS_DQ, + AS_OPCODE, + AS_END, + AS_SEPARATOR: + break; + else + begin + Message(asmr_e_syn_constant); + RecoverConsume(false); + end + end; + Until false; + end; + + + function tx86intreader.Assemble: tlinkedlist; + Var + hl : tasmlabel; + instr : Tx86Instruction; + Begin + Message1(asmr_d_start_reading,'intel'); + inexpression:=FALSE; + firsttoken:=TRUE; + { sets up all opcode and register tables in uppercase + done in the construtor now + if not _asmsorted then + Begin + SetupTables; + _asmsorted:=TRUE; + end; + } + curlist:=TAsmList.Create; + { setup label linked list } + LocalLabelList:=TLocalLabelList.Create; + { we might need to know which parameters are passed in registers } + current_procinfo.generate_parameter_info; + { start tokenizer } + c:=current_scanner.asmgetcharstart; + gettoken; + { main loop } + repeat + case actasmtoken of + AS_LLABEL: + Begin + if CreateLocalLabel(actasmpattern,hl,true) then + ConcatLabel(curlist,hl); + Consume(AS_LLABEL); + end; + + AS_LABEL: + Begin + if SearchLabel(upper(actasmpattern),hl,true) then + ConcatLabel(curlist,hl) + else + Message1(asmr_e_unknown_label_identifier,actasmpattern); + Consume(AS_LABEL); + end; + + AS_DW : + Begin + inexpression:=true; + Consume(AS_DW); + BuildConstant(2); + inexpression:=false; + end; + + AS_DB : + Begin + inexpression:=true; + Consume(AS_DB); + BuildConstant(1); + inexpression:=false; + end; + + AS_DD : + Begin + inexpression:=true; + Consume(AS_DD); + BuildConstant(4); + inexpression:=false; + end; + +{$ifdef cpu64bitaddr} + AS_DQ: + Begin + inexpression:=true; + Consume(AS_DQ); + BuildConstant(8); + inexpression:=false; + end; +{$endif cpu64bitaddr} + + AS_ALIGN: + Begin + Consume(AS_ALIGN); + ConcatAlign(curlist,BuildConstExpression); + if actasmtoken<>AS_SEPARATOR then + Consume(AS_SEPARATOR); + end; + + AS_OPCODE : + Begin + instr:=Tx86Instruction.Create(Tx86Operand); + BuildOpcode(instr); + with instr do + begin + { We need AT&T style operands } + Swapoperands; + { Must be done with args in ATT order } + CheckNonCommutativeOpcodes; + AddReferenceSizes; + SetInstructionOpsize; + CheckOperandSizes; + ConcatInstruction(curlist); + end; + instr.Free; + end; + + AS_SEPARATOR : + Begin + Consume(AS_SEPARATOR); + end; + + AS_END : + break; { end assembly block } + + else + Begin + Message(asmr_e_syntax_error); + RecoverConsume(false); + end; + end; { end case } + until false; + { Check LocalLabelList } + LocalLabelList.CheckEmitted; + LocalLabelList.Free; + { Return the list in an asmnode } + assemble:=curlist; + Message1(asmr_d_finish_reading,'intel'); + end; + + +end. diff --git a/closures/compiler/x86/rgx86.pas b/closures/compiler/x86/rgx86.pas new file mode 100644 index 0000000000..b0688e7f23 --- /dev/null +++ b/closures/compiler/x86/rgx86.pas @@ -0,0 +1,413 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements the x86 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 rgx86; + +{$i fpcdefs.inc} + + interface + + uses + cclasses,globtype, + cpubase,cpuinfo,cgbase,cgutils, + aasmbase,aasmtai,aasmdata,aasmcpu, + rgobj; + + type + trgx86 = class(trgobj) + function get_spill_subreg(r : tregister) : tsubregister;override; + function do_spill_replace(list:TAsmList;instr:taicpu;orgreg:tsuperregister;const spilltemp:treference):boolean;override; + end; + + tpushedsavedloc = record + case byte of + 0: (pushed: boolean); + 1: (ofs: longint); + end; + + tpushedsavedfpu = array[tsuperregister] of tpushedsavedloc; + + trgx86fpu = class + { The "usableregsxxx" contain all registers of type "xxx" that } + { aren't currently allocated to a regvar. The "unusedregsxxx" } + { contain all registers of type "xxx" that aren't currently } + { allocated } + unusedregsfpu,usableregsfpu : Tsuperregisterset; + { these counters contain the number of elements in the } + { unusedregsxxx/usableregsxxx sets } + countunusedregsfpu : byte; + + { Contains the registers which are really used by the proc itself. + It doesn't take care of registers used by called procedures + } + used_in_proc : tcpuregisterset; + + {reg_pushes_other : regvarother_longintarray; + is_reg_var_other : regvarother_booleanarray; + regvar_loaded_other : regvarother_booleanarray;} + + fpuvaroffset : byte; + + constructor create; + + function getregisterfpu(list: TAsmList) : tregister; + procedure ungetregisterfpu(list: TAsmList; r : tregister); + + { pushes and restores registers } + procedure saveusedfpuregisters(list:TAsmList; + var saved:Tpushedsavedfpu; + const s:Tcpuregisterset); + procedure restoreusedfpuregisters(list:TAsmList; + const saved:Tpushedsavedfpu); + + { corrects the fpu stack register by ofs } + function correct_fpuregister(r : tregister;ofs : byte) : tregister; + end; + + +implementation + + uses + systems, + verbose; + + const + { This value is used in tsaved. If the array value is equal + to this, then this means that this register is not used.} + reg_not_saved = $7fffffff; + + +{****************************************************************************** + Trgcpu +******************************************************************************} + + function trgx86.get_spill_subreg(r : tregister) : tsubregister; + begin + result:=getsubreg(r); + end; + + + function trgx86.do_spill_replace(list:TAsmList;instr:taicpu;orgreg:tsuperregister;const spilltemp:treference):boolean; + + {Decide wether a "replace" spill is possible, i.e. wether we can replace a register + in an instruction by a memory reference. For example, in "mov ireg26d,0", the imaginary + register ireg26d can be replaced by a memory reference.} + + var + n,replaceoper : longint; + begin + result:=false; + with instr do + begin + replaceoper:=-1; + case ops of + 1 : + begin + if (oper[0]^.typ=top_reg) and + (getregtype(oper[0]^.reg)=regtype) then + begin + if get_alias(getsupreg(oper[0]^.reg))<>orgreg then + internalerror(200410101); + replaceoper:=0; + end; + end; + 2,3 : + begin + { We can handle opcodes with 2 and 3 operands the same way. The opcodes + with 3 registers are shrd/shld, where the 3rd operand is const or CL, + that doesn't need spilling. + However, due to AT&T order inside the compiler, the 3rd operand is + numbered 0, so look at operand no. 1 and 2 if we have 3 operands by + adding a "n". } + n:=0; + if ops=3 then + n:=1; + if (oper[n+0]^.typ=top_reg) and + (oper[n+1]^.typ=top_reg) and + ((getregtype(oper[n+0]^.reg)<>regtype) or + (getregtype(oper[n+1]^.reg)<>regtype) or + (get_alias(getsupreg(oper[n+0]^.reg))<>get_alias(getsupreg(oper[n+1]^.reg)))) then + begin + if (getregtype(oper[n+0]^.reg)=regtype) and + (get_alias(getsupreg(oper[n+0]^.reg))=orgreg) then + replaceoper:=0+n + else if (getregtype(oper[n+1]^.reg)=regtype) and + (get_alias(getsupreg(oper[n+1]^.reg))=orgreg) then + replaceoper:=1+n; + end + else if (oper[n+0]^.typ=top_reg) and + (oper[n+1]^.typ=top_const) then + begin + if (getregtype(oper[0+n]^.reg)=regtype) and + (get_alias(getsupreg(oper[0+n]^.reg))=orgreg) then + replaceoper:=0+n + else + internalerror(200704282); + end + else if (oper[n+0]^.typ=top_const) and + (oper[n+1]^.typ=top_reg) then + begin + if (getregtype(oper[1+n]^.reg)=regtype) and + (get_alias(getsupreg(oper[1+n]^.reg))=orgreg) then + replaceoper:=1+n + else + internalerror(200704283); + end; + case replaceoper of + 0 : + begin + { Some instructions don't allow memory references + for source } + case instr.opcode of + A_BT, + A_BTS, + A_BTC, + A_BTR, + + { shufp* would require 16 byte alignment for memory locations so we force the source + operand into a register } + A_SHUFPD, + A_SHUFPS : + replaceoper:=-1; + end; + end; + 1 : + begin + { Some instructions don't allow memory references + for destination } + case instr.opcode of + A_CMOVcc, + A_MOVZX, + A_MOVSX, + A_MOVSXD, + A_MULSS, + A_MULSD, + A_SUBSS, + A_SUBSD, + A_ADDSD, + A_ADDSS, + A_DIVSD, + A_DIVSS, + A_SHLD, + A_SHRD, + A_CVTDQ2PD, + A_CVTDQ2PS, + A_CVTPD2DQ, + A_CVTPD2PI, + A_CVTPD2PS, + A_CVTPI2PD, + A_CVTPS2DQ, + A_CVTPS2PD, + A_CVTSD2SI, + A_CVTSD2SS, + A_CVTSI2SD, + A_CVTSS2SD, + A_CVTTPD2PI, + A_CVTTPD2DQ, + A_CVTTPS2DQ, + A_CVTTSD2SI, + A_CVTPI2PS, + A_CVTPS2PI, + A_CVTSI2SS, + A_CVTSS2SI, + A_CVTTPS2PI, + A_CVTTSS2SI, + A_IMUL, + A_XORPD, + A_XORPS, + A_ORPD, + A_ORPS, + A_ANDPD, + A_ANDPS, + A_UNPCKLPS, + A_UNPCKHPS, + A_SHUFPD, + A_SHUFPS: + + replaceoper:=-1; +{$ifdef x86_64} + A_MOV: + { 64 bit constants can only be moved into registers } + if (oper[0]^.typ=top_const) and + (oper[1]^.typ=top_reg) and + ((oper[0]^.val<low(longint)) or + (oper[0]^.val>high(longint))) then + replaceoper:=-1; +{$endif x86_64} + end; + end; + end; + end; + end; + + {$ifdef x86_64} + { 32 bit operations on 32 bit registers on x86_64 can result in + zeroing the upper 32 bits of the register. This does not happen + with memory operations, so we have to perform these calculations + in registers. } + if (instr.opsize=S_L) then + replaceoper:=-1; + {$endif x86_64} + + { Replace register with spill reference } + if replaceoper<>-1 then + begin + oper[replaceoper]^.typ:=top_ref; + new(oper[replaceoper]^.ref); + oper[replaceoper]^.ref^:=spilltemp; + { memory locations aren't guaranteed to be aligned } + case opcode of + A_MOVAPS: + opcode:=A_MOVSS; + A_MOVAPD: + opcode:=A_MOVSD; + end; + result:=true; + end; + end; + end; + + +{****************************************************************************** + Trgx86fpu +******************************************************************************} + + constructor Trgx86fpu.create; + begin + used_in_proc:=[]; + unusedregsfpu:=usableregsfpu; + end; + + + function trgx86fpu.getregisterfpu(list: TAsmList) : tregister; + begin + { note: don't return R_ST0, see comments above implementation of } + { a_loadfpu_* methods in cgcpu (JM) } + result:=NR_ST; + end; + + + procedure trgx86fpu.ungetregisterfpu(list : TAsmList; r : tregister); + begin + { nothing to do, fpu stack management is handled by the load/ } + { store operations in cgcpu (JM) } + end; + + + + function trgx86fpu.correct_fpuregister(r : tregister;ofs : byte) : tregister; + begin + correct_fpuregister:=r; + setsupreg(correct_fpuregister,ofs); + end; + + + procedure trgx86fpu.saveusedfpuregisters(list: TAsmList; + var saved : tpushedsavedfpu; + const s: tcpuregisterset); + { var + r : tregister; + hr : treference; } + begin + used_in_proc:=used_in_proc+s; + +{ TODO: firstsavefpureg} +(* + { don't try to save the fpu registers if not desired (e.g. for } + { the 80x86) } + if firstsavefpureg <> R_NO then + for r.enum:=firstsavefpureg to lastsavefpureg do + begin + saved[r.enum].ofs:=reg_not_saved; + { if the register is used by the calling subroutine and if } + { it's not a regvar (those are handled separately) } + if not is_reg_var_other[r.enum] and + (r.enum in s) and + { and is present in use } + not(r.enum in unusedregsfpu) then + begin + { then save it } + tg.GetTemp(list,extended_size,tt_persistent,hr); + saved[r.enum].ofs:=hr.offset; + cg.a_loadfpu_reg_ref(list,OS_FLOAT,OS_FLOAT,r,hr); + cg.a_reg_dealloc(list,r); + include(unusedregsfpu,r.enum); + inc(countunusedregsfpu); + end; + end; +*) + end; + + + procedure trgx86fpu.restoreusedfpuregisters(list : TAsmList; + const saved : tpushedsavedfpu); +{ + var + r,r2 : tregister; + hr : treference; +} + begin +{ TODO: firstsavefpureg} +(* + if firstsavefpureg <> R_NO then + for r.enum:=lastsavefpureg downto firstsavefpureg do + begin + if saved[r.enum].ofs <> reg_not_saved then + begin + r2.enum:=R_INTREGISTER; + r2.number:=NR_FRAME_POINTER_REG; + reference_reset_base(hr,r2,saved[r.enum].ofs); + cg.a_reg_alloc(list,r); + cg.a_loadfpu_ref_reg(list,OS_FLOAT,OS_FLOAT,hr,r); + if not (r.enum in unusedregsfpu) then + { internalerror(10) + in n386cal we always save/restore the reg *state* + using save/restoreunusedstate -> the current state + may not be real (JM) } + else + begin + dec(countunusedregsfpu); + exclude(unusedregsfpu,r.enum); + end; + tg.UnGetTemp(list,hr); + end; + end; +*) + end; + +(* + procedure Trgx86fpu.saveotherregvars(list: TAsmList; const s: totherregisterset); + var + r: Tregister; + begin + if not(cs_opt_regvar in current_settings.optimizerswitches) then + exit; + if firstsavefpureg <> NR_NO then + for r.enum := firstsavefpureg to lastsavefpureg do + if is_reg_var_other[r.enum] and + (r.enum in s) then + store_regvar(list,r); + end; +*) + +end. diff --git a/closures/compiler/x86/x86ins.dat b/closures/compiler/x86/x86ins.dat new file mode 100644 index 0000000000..662ac07f0c --- /dev/null +++ b/closures/compiler/x86/x86ins.dat @@ -0,0 +1,3439 @@ +; +; Table of assembler instructions for Free Pascal +; adapted from Netwide Assembler by Peter Vreman +; +; The Netwide Assembler is copyright (C) 1996 Simon Tatham and +; Julian Hall. All rights reserved. +; +; Layout +; [OPCODE,attnameX] (X means suffix in att name) +; arguments bytes flags +; + +[NONE] +(Ch_None, Ch_None, Ch_None) +void void none + +[AAA] +(Ch_MEAX, Ch_WFlags, Ch_None) +void \1\x37 8086,NOX86_64 + +[AAD,aadX] +(Ch_MEAX, Ch_WFlags, Ch_None) +void \2\xD5\x0A 8086,NOX86_64 +imm \1\xD5\24 8086,SB,NOX86_64 + +[AAM,aamX] +(Ch_MEAX, Ch_WFlags, Ch_None) +void \2\xD4\x0A 8086,NOX86_64 +imm \1\xD4\24 8086,SB,NOX86_64 + +[AAS] +(Ch_MEAX, Ch_WFlags, Ch_None) +void \1\x3F 8086,NOX86_64 + +[ADC,adcX] +(Ch_Mop2, Ch_Rop1, Ch_RWFlags) +regmem,reg16|32|64 \320\1\x11\101 8086,SM +reg16|32|64,regmem \320\1\x13\110 8086,SM +rm8,reg8 \1\x10\101 8086 +reg8,rm8 \1\x12\110 8086 +rm16|32|64,imm8 \320\1\x83\202\15 8086 +reg_eax,imm \325\1\x15\41 386,SM +reg_rax,imm \326\1\x15\255 X86_64,SM +rm32,imm \325\1\x81\202\41 386,SM +rm64,imm \326\1\x81\202\255 X86_64,SM +reg_ax,imm \324\1\x15\31 8086,SW +rm16,imm \324\1\x81\202\31 8086,SW +reg_al,imm \1\x14\21 8086,SB +rm8,imm \1\x80\202\21 8086,SB + +[ADD,addX] +(Ch_Mop2, Ch_Rop1, Ch_WFlags) +regmem,reg16|32|64 \320\1\x01\101 8086,SM +reg16|32|64,regmem \320\1\x03\110 8086,SM +rm8,reg8 \1\x00\101 8086 +reg8,rm8 \1\x02\110 8086,SM +rm16|32|64,imm8 \320\1\x83\200\15 8086 +reg_eax,imm \320\1\x05\41 386,SM +reg_rax,imm \326\1\x05\255 X86_64,SM +rm32,imm \325\1\x81\200\41 386,SM +rm64,imm \326\1\x81\200\255 X86_64,SM +reg_ax,imm \324\1\x05\31 8086,SW +rm16,imm \324\1\x81\200\31 8086,SW +reg_al,imm \1\x04\21 8086,SB +rm8,imm \1\x80\200\21 8086,SB + +[AND,andX] +(Ch_Mop2, Ch_Rop1, Ch_WFlags) +regmem,reg16|32|64 \320\1\x21\101 8086,SM +reg16|32|64,regmem \320\1\x23\110 8086,SM +rm8,reg8 \1\x20\101 8086 +reg8,rm8 \1\x22\110 8086 +rm16|32|64,imm8 \320\1\x83\204\15 8086 +reg_eax,imm \325\1\x25\41 386,SM +reg_rax,imm \326\1\x25\255 X86_64,SM +rm32,imm \325\1\x81\204\41 386,SM +rm64,imm \326\1\x81\204\255 X86_64,SM +reg_ax,imm \324\1\x25\31 8086,SW +rm16,imm \324\1\x81\204\31 8086,SW +reg_al,imm \1\x24\21 8086,SB +rm8,imm \1\x80\204\21 8086,SB + +[ARPL,arplX] +(Ch_WFlags, Ch_None, Ch_None) +reg16,reg16 \1\x63\101 286,PROT,NOX86_64 +mem,reg16 \1\x63\101 286,PROT,SM,NOX86_64 + +[BOUND,boundX] +(Ch_Rop1, Ch_None, Ch_None) +reg16|32,mem \320\1\x62\110 186,NOX86_64 + +[BSF,bsfX] +(Ch_Wop2, Ch_WFlags, Ch_Rop1) +reg16|32|64,regmem \320\2\x0F\xBC\110 386,SM + +[BSR,bsrX] +(Ch_Wop2, Ch_WFlags, Ch_Rop1) +reg16|32|64,regmem \320\2\x0F\xBD\110 386,SM + +[BSWAP,bswapX] +(Ch_MOp1, Ch_None, Ch_None) +reg32|64 \320\1\x0F\10\xC8 486 + +[BT,btX] +(Ch_WFlags, Ch_Rop1, Ch_Rop2) +regmem,reg16|32|64 \320\2\x0F\xA3\101 386,SM +rm16|32|64,imm \320\2\x0F\xBA\204\25 386,SB + +[BTC,btcX] +(Ch_Mop2, Ch_Rop1, Ch_WFlags) +regmem,reg16|32|64 \320\2\x0F\xBB\101 386,SM +rm16|32|64,imm \320\2\x0F\xBA\207\25 386,SB + +[BTR,btrX] +(Ch_Mop2, Ch_Rop1, Ch_WFlags) +regmem,reg16|32|64 \320\2\x0F\xB3\101 386,SM +rm16|32|64,imm \320\2\x0F\xBA\206\25 386,SB + +[BTS,btsX] +(Ch_Mop2, Ch_Rop1, Ch_WFlags) +regmem,reg16|32|64 \320\2\x0F\xAB\101 386,SM +rm16|32|64,imm \320\2\x0F\xBA\205\25 386,SB + +[CALL,call] +; don't know value of any register +(Ch_ROp1, Ch_All, Ch_None) +; Compiler emits CALL/JMP with opsize=S_NO which matches any size, +; and will match the first entry in sequence. +; Therefore rm16 must be placed after rm32/rm64 +rm32 \325\1\xFF\202 386,NOX86_64 +rm64 \335\1\xFF\202 X86_64 +rm16 \324\1\xFF\202 8086 +imm \320\1\xE8\64 8086 +imm|near \320\1\xE8\64 8086 +imm|far \320\1\x9A\34\37 8086,ND,NOX86_64 +mem|near \320\1\xFF\202 8086 +mem|far \320\1\xFF\203 8086 +imm:imm \327\1\x9A\35\30 8086,NOX86_64 +imm16:imm \324\1\x9A\31\30 8086,NOX86_64 +imm:imm16 \324\1\x9A\31\30 8086,NOX86_64 +imm32:imm \325\1\x9A\41\30 386,NOX86_64 +imm:imm32 \325\1\x9A\41\30 386,NOX86_64 + +[CBW,cbtw] +(Ch_MEAX, Ch_None, Ch_None) +void \324\1\x98 8086 + +[CDQ,cltd] +(Ch_MEAX, Ch_WEDX, Ch_None) +void \325\1\x99 386 + +[CLC] +(Ch_WFlags, Ch_None, Ch_None) +void \1\xF8 8086 + +[CLD] +(Ch_CDirFlag, Ch_None, Ch_None) +void \1\xFC 8086 + +[CLI] +(Ch_WFlags, Ch_None, Ch_None) +void \1\xFA 8086 + +[CLTS] +(Ch_None, Ch_None, Ch_None) +void \2\x0F\x06 286,PRIV + +[CMC] +(Ch_WFlags, Ch_None, Ch_None) +void \1\xF5 8086 + +[CMP,cmpX] +(Ch_ROp1, Ch_ROp2, Ch_WFlags) +regmem,reg16|32|64 \320\1\x39\101 8086,SM +reg16|32|64,regmem \320\1\x3B\110 8086,SM +rm8,reg8 \1\x38\101 8086 +reg8,rm8 \1\x3A\110 8086 +rm16|32|64,imm8 \320\1\x83\207\15 8086 +reg_eax,imm \325\1\x3D\41 386,SM +reg_rax,imm \326\1\x3D\255 X86_64,SM +rm32,imm \325\1\x81\207\41 386,SM +rm64,imm \326\1\x81\207\255 X86_64,SM +reg_ax,imm \324\1\x3D\31 8086,SW +rm16,imm \324\1\x81\207\31 8086,SW +reg_al,imm \1\x3C\21 8086,SB +rm8,imm \1\x80\207\21 8086,SB +mem,imm32 \325\1\x81\207\41 386,SD +mem,imm16 \324\1\x81\207\31 8086,SW +mem,imm8 \1\x80\207\21 8086,SB + +[CMPSB] +(Ch_All, Ch_None, Ch_None) +void \332\1\xA6 8086 + +[CMPSD,cmpsl] +(Ch_All, Ch_None, Ch_None) +void \332\325\1\xA7 386 +xmmreg,xmmrm,imm \334\2\x0F\xC2\110\26 WILLAMETTE,SSE2,SM2,SB,AR2 + +[CMPSW] +(Ch_All, Ch_None, Ch_None) +void \332\324\1\xA7 8086 + +[CMPXCHG,cmpxchgX] +(Ch_All, Ch_None, Ch_None) +regmem,reg16|32|64 \320\2\x0F\xB1\101 PENT,SM +rm8,reg8 \2\x0F\xB0\101 PENT + +[CMPXCHG486,cmpxchg486X] +(Ch_All, Ch_None, Ch_None) +regmem,reg16|32|64 \320\2\x0F\xA7\101 486,SM +rm8,reg8 \2\x0F\xA6\101 486,UNDOC + +[CMPXCHG8B,cmpxchg8b] +(Ch_All, Ch_None, Ch_None) +mem \2\x0F\xC7\201 PENT + +[CPUID] +(Ch_All, Ch_None, Ch_none) +void \2\x0F\xA2 PENT + +[CWD] +(Ch_MEAX, Ch_WEDX, Ch_None) +void \324\1\x99 8086 + +[CWDE,cwtl] +(Ch_MEAX, Ch_None, Ch_None) +void \325\1\x98 386 + +[DAA] +(Ch_MEAX, Ch_None, Ch_None) +void \1\x27 8086,NOX86_64 + +[DAS] +(Ch_MEAX, Ch_None, Ch_None) +void \1\x2F 8086,NOX86_64 + +[DEC,decX] +(Ch_Mop1, Ch_WFlags, Ch_None) +reg16|32 \320\10\x48 8086,NOX86_64 +rm16|32|64 \320\1\xFF\201 8086 +rm8 \1\xFE\201 8086 + +[DIV,divX] +(Ch_RWEAX, Ch_WEDX, Ch_WFlags) +rm16|32|64 \320\1\xF7\206 8086 +rm8 \1\xF6\206 8086 + +[EMMS] +(Ch_FPU, Ch_None, Ch_None) +void \2\x0F\x77 PENT,MMX + +[ENTER,enterX] +(Ch_RWESP, Ch_None, Ch_None) +imm,imm \1\xC8\30\25 186 + +[F2XM1] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xF0 8086,FPU + +[FABS] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xE1 8086,FPU + +[FADD,faddF] +(Ch_FPU, Ch_ROp1, Ch_None) +mem32 \1\xD8\200 8086,FPU +mem64 \1\xDC\200 8086,FPU +void \2\xDE\xC1 8086,FPU +fpureg|to \1\xDC\10\xC0 8086,FPU +fpureg,fpu0 \1\xDC\10\xC0 8086,FPU +fpureg \1\xD8\10\xC0 8086,FPU +fpu0,fpureg \1\xD8\11\xC0 8086,FPU + +[FADDP,faddpF] +(Ch_FPU, Ch_ROp1, Ch_None) +void \2\xDE\xC1 8086,FPU +fpureg \1\xDE\10\xC0 8086,FPU +fpureg,fpu0 \1\xDE\10\xC0 8086,FPU + +[FBLD,fbldF] +(Ch_Rop1, Ch_FPU, Ch_None) +mem80 \1\xDF\204 8086,FPU +mem \1\xDF\204 8086,FPU + +[FBSTP,fbstpF] +(Ch_Wop1, Ch_FPU, Ch_None) +mem80 \1\xDF\206 8086,FPU +mem \1\xDF\206 8086,FPU + +[FCHS] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xE0 8086,FPU + +[FCLEX] +(Ch_FPU, Ch_None, Ch_None) +void \3\x9B\xDB\xE2 8086,FPU + +[FCMOVB,fcmovbF] +(Ch_FPU, Ch_RFLAGS, Ch_None) +void \2\xDA\xC1 P6,FPU +fpureg \1\xDA\10\xC0 P6,FPU +fpu0,fpureg \1\xDA\11\xC0 P6,FPU + +[FCMOVBE,fcmovbeF] +(Ch_FPU, Ch_RFLAGS, Ch_None) +void \2\xDA\xD1 P6,FPU +fpureg \1\xDA\10\xD0 P6,FPU +fpu0,fpureg \1\xDA\11\xD0 P6,FPU + +[FCMOVE,fcmoveF] +(Ch_FPU, Ch_RFLAGS, Ch_None) +void \2\xDA\xC9 P6,FPU +fpureg \1\xDA\10\xC8 P6,FPU +fpu0,fpureg \1\xDA\11\xC8 P6,FPU + +[FCMOVNB,fcmovnbF] +(Ch_FPU, Ch_RFLAGS, Ch_None) +void \2\xDB\xC1 P6,FPU +fpureg \1\xDB\10\xC0 P6,FPU +fpu0,fpureg \1\xDB\11\xC0 P6,FPU + +[FCMOVNBE,fcmovnbeF] +(Ch_FPU, Ch_RFLAGS, Ch_None) +void \2\xDB\xD1 P6,FPU +fpureg \1\xDB\10\xD0 P6,FPU +fpu0,fpureg \1\xDB\11\xD0 P6,FPU + +[FCMOVNE,fcmovneF] +(Ch_FPU, Ch_RFLAGS, Ch_None) +void \2\xDB\xC9 P6,FPU +fpureg \1\xDB\10\xC8 P6,FPU +fpu0,fpureg \1\xDB\11\xC8 P6,FPU + +[FCMOVNU,fcmovnuF] +(Ch_FPU, Ch_RFLAGS, Ch_None) +void \2\xDB\xD9 P6,FPU +fpureg \1\xDB\10\xD8 P6,FPU +fpu0,fpureg \1\xDB\11\xD8 P6,FPU + +[FCMOVU,fcmovuF] +(Ch_FPU, Ch_RFLAGS, Ch_None) +void \2\xDA\xD9 P6,FPU +fpureg \1\xDA\10\xD8 P6,FPU +fpu0,fpureg \1\xDA\11\xD8 P6,FPU + +[FCOM,fcomF] +(Ch_FPU, Ch_None, Ch_None) +mem32 \1\xD8\202 8086,FPU +mem64 \1\xDC\202 8086,FPU +void \2\xD8\xD1 8086,FPU +fpureg \1\xD8\10\xD0 8086,FPU +fpu0,fpureg \1\xD8\11\xD0 8086,FPU + +[FCOMI,fcomiF] +(Ch_WFLAGS, Ch_None, Ch_None) +void \2\xDB\xF1 P6,FPU +fpureg \1\xDB\10\xF0 P6,FPU +fpu0,fpureg \1\xDB\11\xF0 P6,FPU + +[FCOMIP,fcomipF] +(Ch_FPU, Ch_WFLAGS, Ch_None) +void \2\xDF\xF1 P6,FPU +fpureg \1\xDF\10\xF0 P6,FPU +fpu0,fpureg \1\xDF\11\xF0 P6,FPU + +[FCOMP,fcompF] +(Ch_FPU, Ch_None, Ch_None) +mem32 \1\xD8\203 8086,FPU +mem64 \1\xDC\203 8086,FPU +void \2\xD8\xD9 8086,FPU +fpureg \1\xD8\10\xD8 8086,FPU +fpu0,fpureg \1\xD8\11\xD8 8086,FPU + +[FCOMPP] +(Ch_FPU, Ch_None, Ch_None) +void \2\xDE\xD9 8086,FPU + +[FCOS] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xFF 386,FPU + +[FDECSTP] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xF6 8086,FPU + +[FDISI] +(Ch_FPU, Ch_None, Ch_None) +void \3\x9B\xDB\xE1 8086,FPU + +[FDIV,fdivF] +(Ch_FPU, Ch_ROp1, Ch_None) +mem32 \1\xD8\206 8086,FPU +mem64 \1\xDC\206 8086,FPU +void \2\xDC\xF1 8086,FPU +fpureg|to \1\xDC\10\xF0 8086,FPU +fpureg,fpu0 \1\xDC\10\xF0 8086,FPU +fpureg \1\xD8\10\xF0 8086,FPU +fpu0,fpureg \1\xD8\11\xF0 8086,FPU + +[FDIVP,fdivpF] +(Ch_FPU, Ch_ROp1, Ch_None) +void \2\xDE\xF1 8086,FPU +fpureg,fpu0 \1\xDE\10\xF0 8086,FPU +fpureg \1\xDE\10\xF0 8086,FPU + +[FDIVR,fdivrF] +(Ch_FPU, Ch_ROp1, Ch_None) +mem32 \1\xD8\207 8086,FPU +mem64 \1\xDC\207 8086,FPU +void \2\xDC\xF9 8086,FPU +fpureg|to \1\xDC\10\xF8 8086,FPU +fpureg,fpu0 \1\xDC\10\xF8 8086,FPU +fpureg \1\xD8\10\xF8 8086,FPU +fpu0,fpureg \1\xD8\11\xF8 8086,FPU + +[FDIVRP,fdivrpF] +(Ch_FPU, Ch_ROp1, Ch_None) +void \2\xDE\xF9 8086,FPU +fpureg \1\xDE\10\xF8 8086,FPU +fpureg,fpu0 \1\xDE\10\xF8 8086,FPU + +[FEMMS] +(Ch_All, Ch_None, Ch_None) +void \2\x0F\x0E PENT,3DNOW + +[FENI] +(Ch_FPU, Ch_None, Ch_None) +void \3\x9B\xDB\xE0 8086,FPU + +[FFREE] +(Ch_FPU, Ch_None, Ch_None) +fpureg \1\xDD\10\xC0 8086,FPU + +[FIADD,fiaddR] +(Ch_FPU, Ch_ROp1, Ch_None) +mem16 \1\xDE\200 8086,FPU +mem32 \1\xDA\200 8086,FPU + +[FICOM,ficomR] +(Ch_FPU, Ch_None, Ch_None) +mem16 \1\xDE\202 8086,FPU +mem32 \1\xDA\202 8086,FPU + +[FICOMP,ficompR] +(Ch_FPU, Ch_None, Ch_None) +mem16 \1\xDE\203 8086,FPU +mem32 \1\xDA\203 8086,FPU + +[FIDIV,fidivR] +(Ch_FPU, Ch_ROp1, Ch_None) +mem16 \1\xDE\206 8086,FPU +mem32 \1\xDA\206 8086,FPU + +[FIDIVR,fidivrR] +(Ch_FPU, Ch_ROp1, Ch_None) +mem16 \1\xDE\207 8086,FPU +mem32 \1\xDA\207 8086,FPU + +[FILD,fildR] +(Ch_FPU, Ch_ROp1, Ch_None) +mem32 \1\xDB\200 8086,FPU +mem16 \1\xDF\200 8086,FPU +mem64 \1\xDF\205 8086,FPU + +[FIMUL,fimulR] +(Ch_FPU, Ch_ROp1, Ch_None) +mem16 \1\xDE\201 8086,FPU +mem32 \1\xDA\201 8086,FPU + +[FINCSTP] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xF7 8086,FPU + +[FINIT] +(Ch_FPU, Ch_None, Ch_None) +void \3\x9B\xDB\xE3 8086,FPU + +[FIST,fistR] +(Ch_Wop1, Ch_None, Ch_None) +mem32 \1\xDB\202 8086,FPU +mem16 \324\1\xDF\202 8086,FPU + +[FISTP,fistpR] +(Ch_Wop1, Ch_None, Ch_None) +mem32 \1\xDB\203 8086,FPU +mem16 \324\1\xDF\203 8086,FPU +mem64 \1\xDF\207 8086,FPU + +[FISTTP,fisttpR] +(Ch_Wop1, Ch_None, Ch_None) +mem32 \1\xDB\201 PRESCOTT,FPU +mem16 \1\xDF\201 PRESCOTT,FPU +mem64 \1\xDD\201 PRESCOTT,FPU + +[FISUB,fisubR] +(Ch_FPU, Ch_ROp1, Ch_None) +mem16 \1\xDE\204 8086,FPU +mem32 \1\xDA\204 8086,FPU + +[FISUBR,fisubrR] +(Ch_FPU, Ch_ROp1, Ch_None) +mem16 \1\xDE\205 8086,FPU +mem32 \1\xDA\205 8086,FPU + +[FLD,fldF] +(Ch_Rop1, Ch_FPU, Ch_None) +mem32 \1\xD9\200 8086,FPU +mem64 \1\xDD\200 8086,FPU +mem80 \1\xDB\205 8086,FPU +fpureg \1\xD9\10\xC0 8086,FPU + +[FLD1] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xE8 8086,FPU + +[FLDCW,fldcwX] +(Ch_FPU, Ch_None, Ch_None) +mem \1\xD9\205 8086,FPU,SW + +[FLDENV,fldenv] +(Ch_FPU, Ch_None, Ch_None) +mem \1\xD9\204 8086,FPU + +[FLDL2E] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xEA 8086,FPU + +[FLDL2T] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xE9 8086,FPU + +[FLDLG2] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xEC 8086,FPU + +[FLDLN2] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xED 8086,FPU + +[FLDPI] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xEB 8086,FPU + +[FLDZ] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xEE 8086,FPU + +[FMUL,fmulF] +(Ch_ROp1, Ch_FPU, Ch_None) +mem32 \1\xD8\201 8086,FPU +mem64 \1\xDC\201 8086,FPU +void \2\xDC\xC9 8086,FPU +fpureg|to \1\xDC\10\xC8 8086,FPU +fpureg,fpu0 \1\xDC\10\xC8 8086,FPU +fpureg \1\xD8\10\xC8 8086,FPU +fpu0,fpureg \1\xD8\11\xC8 8086,FPU + +[FMULP,fmulpF] +(Ch_ROp1, Ch_FPU, Ch_None) +void \2\xDE\xC9 8086,FPU +fpureg \1\xDE\10\xC8 8086,FPU +fpureg,fpu0 \1\xDE\10\xC8 8086,FPU + +[FNCLEX] +(Ch_FPU, Ch_None, Ch_None) +void \2\xDB\xE2 8086,FPU + +[FNDISI] +(Ch_FPU, Ch_None, Ch_None) +void \2\xDB\xE1 8086,FPU + +[FNENI] +(Ch_FPU, Ch_None, Ch_None) +void \2\xDB\xE0 8086,FPU + +[FNINIT] +(Ch_FPU, Ch_None, Ch_None) +void \2\xDB\xE3 8086,FPU + +[FNOP] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xD0 8086,FPU + +[FNSAVE,fnsave] +(Ch_FPU, Ch_None, Ch_None) +mem \1\xDD\206 8086,FPU + +[FNSTCW,fnstcwX] +(Ch_Wop1, Ch_None, Ch_None) +mem \1\xD9\207 8086,FPU,SW + +[FNSTENV,fnstenv] +(Ch_Wop1, Ch_None, Ch_None) +mem \1\xD9\206 8086,FPU + +[FNSTSW,fnstswX] +(Ch_Wop1, Ch_None, Ch_None) +mem \1\xDD\207 8086,FPU,SW +reg_ax \2\xDF\xE0 286,FPU + +[FPATAN] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xF3 8086,FPU + +[FPREM] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xF8 8086,FPU + +[FPREM1] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xF5 386,FPU + +[FPTAN] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xF2 8086,FPU + +[FRNDINT] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xFC 8086,FPU + +[FRSTOR,frstor] +(Ch_FPU, Ch_None, Ch_None) +mem \1\xDD\204 8086,FPU + +[FSAVE,fsave] +(Ch_Wop1, Ch_None, Ch_None) +mem \2\x9B\xDD\206 8086,FPU + +[FSCALE] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xFD 8086,FPU + +[FSETPM] +(Ch_FPU, Ch_None, Ch_None) +void \2\xDB\xE4 286,FPU + +[FSIN] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xFE 386,FPU + +[FSINCOS] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xFB 386,FPU + +[FSQRT] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xFA 8086,FPU + +[FST,fstF] +(Ch_Wop1, Ch_None, Ch_None) +mem32 \1\xD9\202 8086,FPU +mem64 \1\xDD\202 8086,FPU +fpureg \1\xDD\10\xD0 8086,FPU + +[FSTCW,fstcwX] +(Ch_Wop1, Ch_None, Ch_None) +mem \2\x9B\xD9\207 8086,FPU,SW + +[FSTENV,fstenv] +(Ch_Wop1, Ch_None, Ch_None) +mem \2\x9B\xD9\206 8086,FPU + +[FSTP,fstpF] +(Ch_Wop1, Ch_FPU, Ch_None) +mem32 \1\xD9\203 8086,FPU +mem64 \1\xDD\203 8086,FPU +mem80 \1\xDB\207 8086,FPU +fpureg \1\xDD\10\xD8 8086,FPU + +[FSTSW,fstswX] +(Ch_Wop1, Ch_None, Ch_None) +mem \2\x9B\xDD\207 8086,FPU,SW +void \3\x9B\xDF\xE0 286,FPU +reg_ax \3\x9B\xDF\xE0 286,FPU + +[FSUB,fsubF] +(Ch_ROp1, Ch_FPU, Ch_None) +mem32 \1\xD8\204 8086,FPU +mem64 \1\xDC\204 8086,FPU +void \2\xDC\xE1 8086,FPU +fpureg|to \1\xDC\10\xE0 8086,FPU +fpureg,fpu0 \1\xDC\10\xE0 8086,FPU +fpureg \1\xD8\10\xE0 8086,FPU +fpu0,fpureg \1\xD8\11\xE0 8086,FPU + +[FSUBP,fsubpF] +(Ch_ROp1, Ch_FPU, Ch_None) +void \2\xDE\xE1 8086,FPU +fpureg \1\xDE\10\xE0 8086,FPU +fpureg,fpu0 \1\xDE\10\xE0 8086,FPU + +[FSUBR,fsubrF] +(Ch_ROp1, Ch_FPU, Ch_None) +mem32 \1\xD8\205 8086,FPU +mem64 \1\xDC\205 8086,FPU +void \2\xDC\xE9 8086,FPU +fpureg|to \1\xDC\10\xE8 8086,FPU +fpureg,fpu0 \1\xDC\10\xE8 8086,FPU +fpureg \1\xD8\10\xE8 8086,FPU +fpu0,fpureg \1\xD8\11\xE8 8086,FPU + +[FSUBRP,fsubrpF] +(Ch_ROp1, Ch_FPU, Ch_None) +void \2\xDE\xE9 8086,FPU +fpureg \1\xDE\10\xE8 8086,FPU +fpureg,fpu0 \1\xDE\10\xE8 8086,FPU + +[FTST] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xE4 8086,FPU + +[FUCOM,fucomF] +(Ch_None, Ch_None, Ch_None) +void \2\xDD\xE1 386,FPU +fpureg \1\xDD\10\xE0 386,FPU +fpu0,fpureg \1\xDD\11\xE0 386,FPU + +[FUCOMI,fucomiF] +(Ch_WFLAGS, Ch_None, Ch_None) +void \2\xDB\xE9 P6,FPU +fpureg \1\xDB\10\xE8 P6,FPU +fpu0,fpureg \1\xDB\11\xE8 P6,FPU + +[FUCOMIP,fucomipF] +(Ch_FPU, Ch_WFLAGS, Ch_None) +void \2\xDF\xE9 P6,FPU +fpureg \1\xDF\10\xE8 P6,FPU +fpu0,fpureg \1\xDF\11\xE8 P6,FPU + +[FUCOMP,fucompF] +(Ch_FPU, Ch_None, Ch_None) +void \2\xDD\xE9 386,FPU +fpureg \1\xDD\10\xE8 386,FPU +fpu0,fpureg \1\xDD\11\xE8 386,FPU + +[FUCOMPP] +(Ch_FPU, Ch_None, Ch_None) +void \2\xDA\xE9 386,FPU + +[FWAIT] +(Ch_FPU, Ch_None, Ch_None) +void \1\x9B 8086,FPU + +[FXAM] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xE5 8086,FPU + +[FXCH,fxchF] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xC9 8086,FPU +fpureg \1\xD9\10\xC8 8086,FPU +fpureg,fpu0 \1\xD9\10\xC8 8086,FPU +fpu0,fpureg \1\xD9\11\xC8 8086,FPU + +[FXTRACT] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xF4 8086,FPU + +[FYL2X] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xF1 8086,FPU + +[FYL2XP1] +(Ch_FPU, Ch_None, Ch_None) +void \2\xD9\xF9 8086,FPU + +[HLT] +(Ch_None, Ch_None, Ch_None) +void \1\xF4 8086,PRIV + +[IBTS,ibtsX] +(Ch_All, Ch_None, Ch_None) +regmem,reg16|32|64 \320\2\x0F\xA7\101 386,SM,UNDOC,ND + +[ICEBP] +(Ch_All, Ch_None, Ch_None) +void \1\xF1 386,ND + +[IDIV,idivX] +(Ch_RWEAX, Ch_WEDX, Ch_WFlags) +rm16|32|64 \320\1\xF7\207 8086 +rm8 \1\xF6\207 8086 + +[IMUL,imulX] +(Ch_RWEAX, Ch_WEDX, Ch_WFlags) +reg16|32|64,regmem \320\2\x0F\xAF\110 386,SM +rm16|32|64 \320\1\xF7\205 8086 +reg32|64,regmem,imm8 \320\1\x6B\110\16 286,SM +reg32|64,regmem,imm \320\1\x69\110\42 286,SM,SD,AR2 +reg32|64,imm8 \320\1\x6B\100\15 286 +reg32,imm \325\1\x69\100\41 286,SD +reg64,imm \326\1\x69\100\255 X86_64 +reg16,regmem,imm8 \324\1\x6B\110\16 286,SM +reg16,regmem,imm \324\1\x69\110\32 286,SM,SW,AR2 +reg16,imm8 \324\1\x6B\100\15 286 +reg16,imm \324\1\x69\100\31 286,SW +rm8 \1\xF6\205 8086 + +; 64-bit variant does not exist +[IN,inX] +(Ch_Wop2, Ch_Rop1, Ch_None) +reg_al,imm \1\xE4\25 8086,SB +reg_ax|32,imm \320\1\xE5\25 8086,SB +reg_al,reg_dx \1\xEC 8086 +reg_ax|32,reg_dx \320\1\xED 8086 + +[INC,incX] +(Ch_Mop1, Ch_WFlags, Ch_None) +reg16|32 \320\10\x40 8086,NOX86_64 +rm16|32|64 \320\1\xFF\200 8086 +rm8 \1\xFE\200 8086 + +[INSB] +(Ch_WMemEDI, Ch_RWEDI, Ch_REDX) +void \1\x6C 186 + +[INSD,insl] +(Ch_WMemEDI, Ch_RWEDI, Ch_REDX) +void \325\1\x6D 386 + +[INSW] +(Ch_WMemEDI, Ch_RWEDI, Ch_REDX) +void \324\1\x6D 186 + +[INT] +(Ch_All, Ch_None, Ch_None) +imm \1\xCD\24 8086,SB + +[INT01] +(Ch_All, Ch_None, Ch_None) +void \1\xF1 386,ND + +[INT1] +(Ch_All, Ch_None, Ch_None) +void \1\xF1 386 + +[INT03] +(Ch_None, Ch_None, Ch_None) +void \1\xCC 8086,ND + +[INT3] +(Ch_None, Ch_None, Ch_None) +void \1\xCC 8086 + +[INTO] +(Ch_All, Ch_None, Ch_None) +void \1\xCE 8086,NOX86_64 + +[INVD] +(Ch_All, Ch_None, Ch_None) +void \2\x0F\x08 486,PRIV + +[INVLPG,invlpgX] +(Ch_All, Ch_None, Ch_None) +mem \2\x0F\x01\207 486,PRIV + +[IRET] +(Ch_All, Ch_None, Ch_None) +void \327\1\xCF 8086 + +[IRETD,iret] +(Ch_All, Ch_None, Ch_None) +void \325\1\xCF 386 + +[IRETW] +(Ch_All, Ch_None, Ch_None) +void \324\1\xCF 8086 + +[IRETQ] +(Ch_All, Ch_None, Ch_None) +void \326\1\xCF X86_64 + +[JCXZ] +(Ch_RECX, Ch_None, Ch_None) +imm \310\1\xE3\50 8086,NOX86_64 + +[JECXZ] +(Ch_RECX, Ch_None, Ch_None) +imm \311\1\xE3\50 386 + +[JRCXZ] +(Ch_RECX, Ch_None, Ch_None) +imm \1\xE3\50 X86_64 + +[JMP,jmpX] +(Ch_ROp1, Ch_None, Ch_None) +; rm16 should be after rm32/rm64, see comments for CALL. +imm8 \1\xEB\50 8086,PASS2 +imm16|32 \320\1\xE9\64 8086,PASS2 +rm32 \325\1\xFF\204 386,NOX86_64 +rm64 \335\1\xFF\204 X86_64 +rm16 \324\1\xFF\204 8086 +imm|short \1\xEB\50 8086,PASS2 +imm|near \320\1\xE9\64 8086,ND,PASS2 +imm|far \320\1\xEA\34\37 8086,ND,PASS2,NOX86_64 +mem|near \320\1\xFF\204 8086 +mem|far \320\1\xFF\205 8086 +imm:imm \327\1\xEA\35\30 8086,NOX86_64 +imm:imm16 \324\1\xEA\31\30 8086,NOX86_64 +imm:imm32 \325\1\xEA\41\30 386,NOX86_64 + +; SAHF/LAHF are valid in x86_64 only if CPUID.80000001h:ECX.0=1 +[LAHF] +(Ch_WEAX, Ch_RFlags, Ch_None) +void \1\x9F 8086 + +[LAR,larX] +(Ch_Wop2, Ch_None, Ch_None) +reg16|32|64,regmem \320\2\x0F\x02\110 286,PROT,SM + +[LCALL,lcall] +; don't know value of any register +; Far call, AT&T only (there are no near/far modifiers in AT&T syntax, so separate mnemonic is needed) +(Ch_All, Ch_None, Ch_None) +mem32 \325\1\xFF\203 386,NOX86_64 +mem64 \335\1\xFF\203 X86_64 +mem16 \324\1\xFF\203 8086 + +[LDS,ldsX] +(Ch_Wop2, Ch_Rop1, Ch_None) +reg16|32,mem \320\1\xC5\110 8086,NOX86_64 + +[LEA,leaX] +(Ch_Wop2, Ch_Rop1, Ch_None) +reg32|64,mem \320\1\x8D\110 8086 +reg32|64,imm \320\1\x8D\110 8086,SD + +[LEAVE] +(Ch_RWESP, Ch_WEBP, Ch_None) +void \1\xC9 186 + +[LES,lesX] +(Ch_Wop2, Ch_Rop1, Ch_None) +reg16|32,mem \320\1\xC4\110 8086,NOX86_64 + +[LFS,lfsX] +(Ch_Wop2, Ch_Rop1, Ch_None) +reg16|32,mem \320\2\x0F\xB4\110 386 + +[LGDT,lgdtX] +(Ch_None, Ch_None, Ch_None) +mem \2\x0F\x01\202 286,PRIV + +[LGS,lgsX] +(Ch_Wop2, Ch_Rop1, Ch_None) +reg16|32,mem \320\2\x0F\xB5\110 386 + +[LIDT,lidtX] +(Ch_None, Ch_None, Ch_None) +mem \2\x0F\x01\203 286,PRIV + +[LJMP,ljmp] +(Ch_ROp1, Ch_None, Ch_None) +mem32 \325\1\xFF\205 386,NOX86_64 +mem64 \335\1\xFF\205 X86_64 +mem16 \324\1\xFF\205 8086 + +[LLDT,lldtX] +(Ch_None, Ch_None, Ch_None) +rm16 \2\x0F\x00\202 286,PROT,PRIV + +[LMSW,lmswX] +(Ch_None, Ch_None, Ch_None) +rm16 \2\x0F\x01\206 286,PRIV + +[LOADALL] +(Ch_All, Ch_None, Ch_None) +void \2\x0F\x07 386,UNDOC + +[LOADALL286] +(Ch_All, Ch_None, Ch_None) +void \2\x0F\x05 286,UNDOC + +[LOCK] +(Ch_None, Ch_None, Ch_None) +void \1\xF0 8086,PRE + +[LODSB] +(Ch_WEAX, Ch_RWESI, Ch_None) +void \1\xAC 8086 + +[LODSD,lodsl] +(Ch_WEAX, Ch_RWESI, Ch_None) +void \325\1\xAD 386 + +[LODSW] +(Ch_WEAX, Ch_RWESI, Ch_None) +void \324\1\xAD 8086 + +[LOOP] +(Ch_RWECX, Ch_None, Ch_None) +imm \312\1\xE2\50 8086 +imm,reg_cx \310\1\xE2\50 8086,NOX86_64 +imm,reg_ecx|64 \311\1\xE2\50 386 + +[LOOPE] +(Ch_RWECX, Ch_RFlags, Ch_None) +imm \312\1\xE1\50 8086 +imm,reg_cx \310\1\xE1\50 8086,NOX86_64 +imm,reg_ecx|64 \311\1\xE1\50 386 + +[LOOPNE] +(Ch_RWECX, Ch_RFlags, Ch_None) +imm \312\1\xE0\50 8086 +imm,reg_cx \310\1\xE0\50 8086,NOX86_64 +imm,reg_ecx|64 \311\1\xE0\50 386 + +[LOOPNZ] +(Ch_RWECX, Ch_RFlags, Ch_None) +imm \312\1\xE0\50 8086 +imm,reg_cx \310\1\xE0\50 8086,NOX86_64 +imm,reg_ecx|64 \311\1\xE0\50 386 + +[LOOPZ] +(Ch_RWECX, Ch_RFlags, Ch_None) +imm \312\1\xE1\50 8086 +imm,reg_cx \310\1\xE1\50 8086,NOX86_64 +imm,reg_ecx|64 \311\1\xE1\50 386 + +[LSL,lslX] +(Ch_Wop2, Ch_WFlags, Ch_None) +reg16|32|64,regmem \320\2\x0F\x03\110 286,PROT,SM + +[LSS,lssX] +(Ch_Wop2, Ch_ROP1, Ch_None) +reg16|32|64,mem \320\2\x0F\xB2\110 386 + +[LTR,ltrX] +(Ch_None, Ch_None, Ch_None) +rm16 \2\x0F\x00\203 286,PROT,PRIV + +[MONITOR] +(Ch_None, Ch_None, Ch_None) +void \3\x0F\x01\xC8 PRESCOTT +reg_eax,reg_ecx,reg_edx \3\x0F\x01\xC8 PRESCOTT,ND + +[MOV,movX] +(Ch_Wop2, Ch_Rop1, Ch_None) +mem_offs,reg_ax \324\1\xA3\44 8086,SM +mem_offs,reg_eax \325\1\xA3\44 386,SM +mem_offs,reg_rax \326\1\xA3\44 X86_64,SM +regmem,reg16|32|64 \320\1\x89\101 8086,SM +reg_ax,mem_offs \324\1\xA1\45 8086,SM +reg_eax,mem_offs \325\1\xA1\45 386,SM +reg_rax,mem_offs \326\1\xA1\45 X86_64,SM +reg16|32|64,regmem \320\1\x8B\110 8086,SM +reg32,imm \325\10\xB8\41 386,SD +reg64,imm \326\10\xB8\55 X86_64,SM +rm32,imm \325\1\xC7\200\41 386,SM +rm64,imm \326\1\xC7\200\255 X86_64,SM +reg16,imm \324\10\xB8\31 8086,SW +rm16,imm \324\1\xC7\200\31 8086,SW +mem_offs,reg_al \1\xA2\44 8086,SM +rm8,reg8 \1\x88\101 8086 +reg_al,mem_offs \1\xA0\45 8086,SM +reg8,rm8 \1\x8A\110 8086,SM +reg8,imm \10\xB0\21 8086,SB +rm8,imm \1\xC6\200\21 8086,SB +rm16|32,reg_cs \320\1\x8C\201 8086 +rm16|32,reg_dess \320\1\x8C\101 8086 +rm16|32,reg_fsgs \320\1\x8C\101 386 +reg_dess,rm16|32 \321\1\x8E\110 8086,SM +reg_fsgs,rm16|32 \321\1\x8E\110 386,SM +reg32,reg_cr4 \2\x0F\x20\204 PENT,PRIV,NOX86_64 +reg32,reg_creg \2\x0F\x20\101 386,PRIV,NOX86_64 +reg32,reg_dreg \2\x0F\x21\101 386,PRIV,NOX86_64 +reg32,reg_treg \2\x0F\x24\101 386,PRIV,NOX86_64 +reg64,reg_cr4 \2\x0F\x20\204 PENT,PRIV,X86_64 +reg64,reg_creg \2\x0F\x20\101 386,PRIV,X86_64 +reg64,reg_dreg \2\x0F\x21\101 386,PRIV,X86_64 +reg64,reg_treg \2\x0F\x24\101 386,PRIV,X86_64 +reg_cr4,reg32 \2\x0F\x22\214 PENT,PRIV,NOX86_64 +reg_creg,reg32 \2\x0F\x22\110 386,PRIV,NOX86_64 +reg_dreg,reg32 \2\x0F\x23\110 386,PRIV,NOX86_64 +reg_treg,reg32 \2\x0F\x26\110 386,PRIV,NOX86_64 +reg_cr4,reg64 \2\x0F\x22\214 PENT,PRIV,X86_64 +reg_creg,reg64 \2\x0F\x22\110 386,PRIV,X86_64 +reg_dreg,reg64 \2\x0F\x23\110 386,PRIV,X86_64 +reg_treg,reg64 \2\x0F\x26\110 386,PRIV,X86_64 + +[MOVD,movd] +(Ch_Rop1, Ch_Wop2, Ch_None) +mmxreg,rm32 \2\x0F\x6E\110 PENT,MMX,SD +rm32,mmxreg \2\x0F\x7E\101 PENT,MMX,SD +xmmreg,rm32 \361\2\x0F\x6E\110 WILLAMETTE,SSE2 +rm32,xmmreg \361\2\x0F\x7E\101 WILLAMETTE,SSE2 + +[MOVQ,movq] +(Ch_Rop1, Ch_Wop2, Ch_None) +mmxreg,mmxrm \2\x0F\x6F\110 PENT,MMX,SM +mmxrm,mmxreg \2\x0F\x7F\101 PENT,MMX,SM +mmxreg,rm64 \326\2\x0F\x6E\110 X86_64,MMX +rm64,mmxreg \326\2\x0F\x7E\101 X86_64,MMX +xmmreg,xmmrm \333\2\x0F\x7E\110 WILLAMETTE,SSE2 +xmmrm,xmmreg \361\2\x0F\xD6\101 WILLAMETTE,SSE2 +xmmreg,reg64 \361\326\2\x0F\x6E\110 WILLAMETTE,SSE2,X86_64 +reg64,xmmreg \361\326\2\x0F\x7E\101 WILLAMETTE,SSE2,X86_64 + +[MOVSB] +(Ch_All, Ch_None, Ch_None) +void \1\xA4 8086 + +[MOVSD,movsl] +; Ch_All isn't correct for the sse move, but how can it be solved? (FK) +(Ch_All, Ch_None, Ch_None) +void \325\1\xA5 386 +xmmreg,xmmrm \334\2\x0F\x10\110 WILLAMETTE,SSE2 +xmmrm,xmmreg \334\2\x0F\x11\101 WILLAMETTE,SSE2 + +[MOVSQ] +(Ch_All, Ch_None, Ch_None) +void \326\1\xA5 X86_64 + +[MOVSW] +(Ch_All, Ch_None, Ch_None) +void \324\1\xA5 8086 + +[MOVSX,movsY] +(Ch_Wop2, Ch_Rop1, Ch_None) +reg32|64,rm16 \320\2\x0F\xBF\110 386 +reg16|32|64,rm8 \320\2\x0F\xBE\110 386 + +[MOVZX,movzY] +(Ch_Wop2, Ch_Rop1, Ch_None) +reg32|64,rm16 \320\2\x0F\xB7\110 386 +reg16|32|64,rm8 \320\2\x0F\xB6\110 386 + +[MUL,mulX] +(Ch_RWEAX, Ch_WEDX, Ch_WFlags) +rm16|32|64 \320\1\xF7\204 8086 +rm8 \1\xF6\204 8086 + +[MWAIT] +(Ch_None, Ch_None, Ch_None) +void \3\x0F\x01\xC9 PRESCOTT +reg_eax,reg_ecx \3\x0F\x01\xC9 PRESCOTT,ND + + +[NEG,negX] +(Ch_Mop1, Ch_None, Ch_None) +rm16|32|64 \320\1\xF7\203 8086 +rm8 \1\xF6\203 8086 + +[NOP] +(Ch_None, Ch_None, Ch_None) +void \1\x90 8086 + +[NOT,notX] +(Ch_Mop1, Ch_WFlags, Ch_None) +rm16|32|64 \320\1\xF7\202 8086 +rm8 \1\xF6\202 8086 + +[OR,orX] +(Ch_Mop2, Ch_Rop1, Ch_WFlags) +regmem,reg16|32|64 \320\1\x09\101 8086,SM +reg16|32|64,regmem \320\1\x0B\110 8086,SM +rm8,reg8 \1\x08\101 8086 +reg8,rm8 \1\x0A\110 8086,SM +rm16|32|64,imm8 \320\1\x83\201\15 8086 +reg_eax,imm \325\1\x0D\41 386,SM +reg_rax,imm \326\1\x0D\255 X86_64,SM +rm32,imm \325\1\x81\201\41 386,SM +rm64,imm \326\1\x81\201\255 X86_64,SM +reg_ax,imm \324\1\x0D\31 8086,SW +rm16,imm \324\1\x81\201\31 8086,SW +reg_al,imm \1\x0C\21 8086,SB +rm8,imm \1\x80\201\21 8086,SB + +[OUT,outX] +(Ch_Rop1, Ch_Rop2, Ch_None) +imm,reg_al \1\xE6\24 8086,SB +imm,reg_ax \324\1\xE7\24 8086,SB +imm,reg_eax \325\1\xE7\24 386,SB +reg_dx,reg_al \1\xEE 8086 +reg_dx,reg_ax \324\1\xEF 8086 +reg_dx,reg_eax \325\1\xEF 386 + +[OUTSB] +(Ch_All, Ch_None, Ch_None) +void \1\x6E 186 + +[OUTSD,outsl] +(Ch_All, Ch_None, Ch_None) +void \325\1\x6F 386 + +[OUTSW] +(Ch_All, Ch_None, Ch_None) +void \324\1\x6F 186 + +[PACKSSDW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x6B\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\x6B\110 WILLAMETTE,SSE2,SM + +[PACKSSWB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x63\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\x63\110 WILLAMETTE,SSE2,SM + +[PACKUSWB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x67\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\x67\110 WILLAMETTE,SSE2,SM + +[PADDB] +(Ch_Mop2, Ch_Rop1, Ch_None) +mmxreg,mmxrm \2\x0F\xFC\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xFC\110 WILLAMETTE,SSE2,SM + +[PADDD] +(Ch_Mop2, Ch_Rop1, Ch_None) +mmxreg,mmxrm \2\x0F\xFE\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xFE\110 WILLAMETTE,SSE2,SM + +[PADDSB] +(Ch_Mop2, Ch_Rop1, Ch_None) +mmxreg,mmxrm \2\x0F\xEC\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xEC\110 WILLAMETTE,SSE2,SM + +[PADDSIW] +(Ch_Mop2, Ch_Rop1, Ch_None) +mmxreg,mmxrm \2\x0F\x51\110 PENT,MMX,SM,CYRIX + +[PADDSW] +(Ch_Mop2, Ch_Rop1, Ch_None) +mmxreg,mmxrm \2\x0F\xED\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xED\110 WILLAMETTE,SSE2,SM + +[PADDUSB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xDC\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xDC\110 WILLAMETTE,SSE2,SM + +[PADDUSW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xDD\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xDD\110 WILLAMETTE,SSE2,SM + +[PADDW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xFD\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xFD\110 WILLAMETTE,SSE2,SM + +[PAND] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xDB\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xDB\110 WILLAMETTE,SSE2,SM + +[PANDN] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xDF\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xDF\110 WILLAMETTE,SSE2,SM + +[PAVEB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x50\110 PENT,MMX,SM,CYRIX + +[PAVGUSB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\xBF PENT,3DNOW,SM + +[PCMPEQB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x74\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\x74\110 WILLAMETTE,SSE2,SM + +[PCMPEQD] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x76\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\x76\110 WILLAMETTE,SSE2,SM + +[PCMPEQW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x75\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\x75\110 WILLAMETTE,SSE2,SM + +[PCMPGTB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x64\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\x64\110 WILLAMETTE,SSE2,SM + +[PCMPGTD] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x66\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\x66\110 WILLAMETTE,SSE2,SM + +[PCMPGTW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x65\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\x65\110 WILLAMETTE,SSE2,SM + +[PDISTIB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mem \2\x0F\x54\110 PENT,MMX,SM,CYRIX + +[PF2ID] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\x1D PENT,3DNOW,SM + +[PFACC] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\xAE PENT,3DNOW,SM + +[PFADD] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\x9E PENT,3DNOW,SM + +[PFCMPEQ] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\xB0 PENT,3DNOW,SM + +[PFCMPGE] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\x90 PENT,3DNOW,SM + +[PFCMPGT] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\xA0 PENT,3DNOW,SM + +[PFMAX] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\xA4 PENT,3DNOW,SM + +[PFMIN] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\x94 PENT,3DNOW,SM + +[PFMUL] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\xB4 PENT,3DNOW,SM + +[PFRCP] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\x96 PENT,3DNOW,SM + +[PFRCPIT1] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\xA6 PENT,3DNOW,SM + +[PFRCPIT2] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\xB6 PENT,3DNOW,SM + +[PFRSQIT1] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\xA7 PENT,3DNOW,SM + +[PFRSQRT] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\x97 PENT,3DNOW,SM + +[PFSUB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\x9A PENT,3DNOW,SM + +[PFSUBR] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\xAA PENT,3DNOW,SM + +[PI2FD] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\x0D PENT,3DNOW,SM + +[PMACHRIW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mem \2\x0F\x5E\110 PENT,MMX,SM,CYRIX + +[PMADDWD] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xF5\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xF5\110 WILLAMETTE,SM,SSE2 + +[PMAGW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x52\110 PENT,MMX,SM,CYRIX + +[PMULHRIW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x5D\110 PENT,MMX,SM,CYRIX + +[PMULHRWA] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\1\xB7 PENT,3DNOW,SM + +[PMULHRWC] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x59\110 PENT,MMX,SM,CYRIX + +[PMULHW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xE5\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xE5\110 WILLAMETTE,SSE2,SM + +[PMULLW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xD5\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xD5\110 WILLAMETTE,SSE2,SM + +[PMVGEZB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mem \2\x0F\x5C\110 PENT,MMX,SM,CYRIX + +[PMVLZB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mem \2\x0F\x5B\110 PENT,MMX,SM,CYRIX + +[PMVNZB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mem \2\x0F\x5A\110 PENT,MMX,SM,CYRIX + +[PMVZB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mem \2\x0F\x58\110 PENT,MMX,SM,CYRIX + +[POP,popX] +(Ch_Wop1, Ch_RWESP, Ch_None) +reg16 \324\10\x58 8086 +reg32 \325\10\x58 386,NOX86_64 +reg64 \335\10\x58 X86_64 +rm16 \324\1\x8F\200 8086 +rm32 \325\1\x8F\200 386,NOX86_64 +rm64 \335\1\x8F\200 X86_64 +reg_cs \1\x0F 8086,UNDOC,ND +reg_dess \4 8086,NOX86_64 +reg_fsgs \1\x0F\5\335 386 + +[POPA,popaX] +(Ch_All, Ch_None, Ch_None) +void \327\1\x61 186,NOX86_64 + +[POPAD,popal] +(Ch_All, Ch_None, Ch_None) +void \325\1\x61 386,NOX86_64 + +[POPAW] +(Ch_All, Ch_None, Ch_None) +void \324\1\x61 186,NOX86_64 + +[POPF] +(Ch_RWESP, Ch_WFlags, Ch_None) +void \327\1\x9D 186,NOX86_64 +void \326\1\x9D X86_64 + +[POPFD,popfl] +(Ch_RWESP, Ch_WFlags, Ch_None) +void \325\1\x9D 386,NOX86_64 + +[POPFW] +(Ch_RWESP, Ch_WFLAGS, Ch_None) +void \324\1\x9D 186,NOX86_64 +void \1\x9D X86_64 + +[POPFQ] +(Ch_RWESP, Ch_WFlags, Ch_None) +void \326\1\x9D X86_64 + +[POR] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xEB\110 PENT,MMX,SM +xmmreg,xmmreg \361\2\x0F\xEB\110 WILLAMETTE,SSE2,SM + +[PREFETCH,prefetchX] +(Ch_All, Ch_None, Ch_None) +mem \2\x0F\x0D\200 PENT,3DNOW,SM + +[PREFETCHW,prefetchwX] +(Ch_All, Ch_None, Ch_None) +mem \2\x0F\x0D\201 PENT,3DNOW,SM + +[PSLLD] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xF2\110 PENT,MMX,SM +mmxreg,imm \2\x0F\x72\206\25 PENT,MMX,SB,AR1 +xmmreg,xmmrm \361\2\x0F\xF2\110 WILLAMETTE,SSE2,SM +xmmreg,imm \361\2\x0F\x72\206\25 WILLAMETTE,SSE2,SB,AR1 + +[PSLLDQ] +(Ch_All, Ch_None, Ch_None) +xmmreg,imm \361\2\x0F\x73\207\25 WILLAMETTE,SSE2,SB,AR1 + +[PSLLQ] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xF3\110 PENT,MMX,SM +mmxreg,imm \2\x0F\x73\206\25 PENT,MMX,SB,AR1 +xmmreg,xmmrm \361\2\x0F\xF3\110 WILLAMETTE,SSE2,SM +xmmreg,imm \361\2\x0F\x73\206\25 WILLAMETTE,SSE2,SB,AR1 + +[PSLLW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xF1\110 PENT,MMX,SM +mmxreg,imm \2\x0F\x71\206\25 PENT,MMX,SB,AR1 +xmmreg,xmmrm \361\2\x0F\xF1\110 WILLAMETTE,SSE2,SM +xmmreg,imm \361\2\x0F\x71\206\25 WILLAMETTE,SSE2,SB,AR1 + +[PSRAD] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xE2\110 PENT,MMX,SM +mmxreg,imm \2\x0F\x72\204\25 PENT,MMX,SB,AR1 +xmmreg,xmmrm \361\2\x0F\xE2\110 WILLAMETTE,SSE2,SM +xmmreg,imm \361\2\x0F\x72\204\25 WILLAMETTE,SSE2,SB,AR1 + +[PSRAW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xE1\110 PENT,MMX,SM +mmxreg,imm \2\x0F\x71\204\25 PENT,MMX,SB,AR1 +xmmreg,xmmrm \361\2\x0F\xE1\110 WILLAMETTE,SSE2,SM +xmmreg,imm \361\2\x0F\x71\204\25 WILLAMETTE,SSE2,SB,AR1 + +[PSRLD] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xD2\110 PENT,MMX,SM +mmxreg,imm \2\x0F\x72\202\25 PENT,MMX,SB,AR1 +xmmreg,xmmrm \361\2\x0F\xD2\110 WILLAMETTE,SSE2,SM +xmmreg,imm \361\2\x0F\x72\202\25 WILLAMETTE,SSE2,SB,AR1 + +[PSRLQ] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xD3\110 PENT,MMX,SM +mmxreg,imm \2\x0F\x73\202\25 PENT,MMX,SB,AR1 +xmmreg,xmmrm \361\2\x0F\xD3\110 WILLAMETTE,SSE2,SM +xmmreg,imm \361\2\x0F\x73\202\25 WILLAMETTE,SSE2,SB,AR1 + +[PSRLW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xD1\110 PENT,MMX,SM +mmxreg,imm \2\x0F\x71\202\25 PENT,MMX,SB,AR1 +xmmreg,xmmrm \361\2\x0F\xD1\110 WILLAMETTE,SSE2,SM +xmmreg,imm \361\2\x0F\x71\202\25 WILLAMETTE,SSE2,SB,AR1 + +[PSUBB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xF8\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xF8\110 WILLAMETTE,SSE2,SM + +[PSUBD] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xFA\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xFA\110 WILLAMETTE,SSE2,SM + +[PSUBSB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xE8\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xE8\110 WILLAMETTE,SSE2,SM + +[PSUBSIW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mem \2\x0F\x55\110 PENT,MMX,SM,CYRIX +mmxreg,mmxreg \2\x0F\x55\110 PENT,MMX,CYRIX + +[PSUBSW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xE9\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xE9\110 WILLAMETTE,SSE2,SM + +[PSUBUSB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xD8\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xD8\110 WILLAMETTE,SSE2,SM + +[PSUBUSW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xD9\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xD9\110 WILLAMETTE,SSE2,SM + +[PSUBW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xF9\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xF9\110 WILLAMETTE,SSE2,SM + +[PUNPCKHBW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x68\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\x68\110 WILLAMETTE,SSE2,SM + +[PUNPCKHDQ] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x6A\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\x6A\110 WILLAMETTE,SSE2,SM + +[PUNPCKHWD] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x69\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\x69\110 WILLAMETTE,SSE2,SM + +[PUNPCKLBW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x60\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\x60\110 WILLAMETTE,SSE2,SM + +[PUNPCKLDQ] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x62\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\x62\110 WILLAMETTE,SSE2,SM + +[PUNPCKLWD] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x61\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\x61\110 WILLAMETTE,SSE2,SM + +[PUSH,pushX] +(Ch_Rop1, Ch_RWESP, Ch_None) +reg16 \324\10\x50 8086 +reg32 \325\10\x50 386,NOX86_64 +reg64 \335\10\x50 X86_64 +rm16 \324\1\xFF\206 8086 +rm32 \325\1\xFF\206 386,NOX86_64 +rm64 \335\1\xFF\206 X86_64 +imm32 \325\1\x68\40\335 386 +imm16 \324\1\x68\30\335 286 +imm8 \1\x6A\14\335 286 +reg_fsgs \1\x0F\7\335 386,NOX86_64 +reg_sreg \6 8086,NOX86_64 + +[PUSHA,pushaX] +(Ch_All, Ch_None, Ch_None) +void \327\1\x60 186,NOX86_64 + +[PUSHAD,pushal] +(Ch_All, Ch_None, Ch_None) +void \325\1\x60 386,NOX86_64 + +[PUSHAW] +(Ch_All, Ch_None, Ch_None) +void \324\1\x60 186,NOX86_64 + +[PUSHF] +(Ch_RWESP, Ch_RFlags, Ch_None) +void \327\1\x9C 186 + +[PUSHFD,pushfl] +(Ch_RWESP, Ch_RFlags, Ch_None) +void \325\1\x9C 386,NOX86_64 + +[PUSHFW] +(Ch_RWESP, Ch_RFLAGS, Ch_None) +void \324\1\x9C 186 + +[PUSHFQ] +(Ch_RWESP, Ch_RFlags, Ch_None) +void \326\1\x9C X86_64 + +[PXOR] +(Ch_Mop2, Ch_Rop1, Ch_None) +mmxreg,mmxrm \2\x0F\xEF\110 PENT,MMX,SM +xmmreg,xmmrm \361\2\x0F\xEF\110 WILLAMETTE,SSE2,SM + +[RCL,rclX] +(Ch_Mop2, Ch_Rop1, Ch_RWFlags) +rm16|32|64,unity \320\1\xD1\202 8086 +rm16|32|64,reg_cl \320\1\xD3\202 8086 +rm16|32|64,imm \320\1\xC1\202\25 8086,SB +rm8,unity \1\xD0\202 8086 +rm8,reg_cl \1\xD2\202 8086 +rm8,imm \1\xC0\202\25 186,SB + +[RCR,rcrX] +(Ch_Mop2, Ch_Rop1, Ch_RWFlags) +rm16|32|64,unity \320\1\xD1\203 8086 +rm16|32|64,reg_cl \320\1\xD3\203 8086 +rm16|32|64,imm \320\1\xC1\203\25 8086,SB +rm8,unity \1\xD0\203 8086 +rm8,reg_cl \1\xD2\203 8086 +rm8,imm \1\xC0\203\25 186,SB + +[RDSHR] +(Ch_All, Ch_None, Ch_None) +void \2\x0F\x36 P6,CYRIX,SMM + +[RDMSR] +(Ch_WEAX, Ch_WEDX, Ch_None) +void \2\x0F\x32 PENT,PRIV + +[RDPMC] +(Ch_WEAX, Ch_WEDX, Ch_None) +void \2\x0F\x33 P6 + +[RDTSC] +(Ch_WEAX, Ch_WEDX, Ch_None) +void \2\x0F\x31 PENT + +[REP] +(Ch_RWECX, Ch_RWFlags, Ch_None) +void \1\xF3 8086,PRE + +[REPE] +(Ch_RWECX, Ch_RWFlags, Ch_None) +void \1\xF3 8086,PRE + +[REPNE] +(Ch_RWECX, Ch_RWFlags, Ch_None) +void \1\xF2 8086,PRE + +[REPNZ] +(Ch_RWECX, Ch_RWFLAGS, Ch_None) +void \1\xF2 8086,PRE + +[REPZ] +(Ch_RWECX, Ch_RWFLAGS, Ch_None) +void \1\xF3 8086,PRE + +[RET] +(Ch_All, Ch_None, Ch_None) +void \1\xC3 8086 +imm \1\xC2\30 8086,SW + +[RETF,lret] +(Ch_All, Ch_None, Ch_None) +void \1\xCB 8086 +imm \1\xCA\30 8086,SW + +[RETN,ret] +(Ch_All, Ch_None, Ch_None) +void \1\xC3 8086 +imm \1\xC2\30 8086,SW + +[ROL,rolX] +(Ch_Mop2, Ch_Rop1, Ch_RWFlags) +rm16|32|64,unity \320\1\xD1\200 8086 +rm16|32|64,reg_cl \320\1\xD3\200 8086 +rm16|32|64,imm \320\1\xC1\200\25 8086,SB +rm8,unity \1\xD0\200 8086 +rm8,reg_cl \1\xD2\200 8086 +rm8,imm \1\xC0\200\25 186,SB + +[ROR,rorX] +(Ch_Mop2, Ch_Rop1, Ch_RWFlags) +rm16|32|64,unity \320\1\xD1\201 8086 +rm16|32|64,reg_cl \320\1\xD3\201 8086 +rm16|32|64,imm \320\1\xC1\201\25 8086,SB +rm8,unity \1\xD0\201 8086 +rm8,reg_cl \1\xD2\201 8086 +rm8,imm \1\xC0\201\25 186,SB + +[RSDC] +(Ch_All, Ch_None, Ch_None) +reg_sreg,mem80 \2\x0F\x79\101 486,CYRIX,SMM + +[RSLDT] +(Ch_All, Ch_None, Ch_None) +mem80 \2\x0F\x7B\200 486,CYRIX,SMM + +[RSM] +(Ch_All, Ch_None, Ch_None) +void \2\x0F\xAA PENT,SMM + +; SAHF/LAHF are valid in x86_64 only if CPUID.80000001h:ECX.0=1 +[SAHF] +(Ch_WFlags, Ch_REAX, Ch_None) +void \1\x9E 8086 + +[SAL,salX] +(Ch_Mop2, Ch_Rop1, Ch_RWFlags) +rm16|32|64,unity \320\1\xD1\204 8086,ND +rm16|32|64,reg_cl \320\1\xD3\204 8086,ND +rm16|32|64,imm \320\1\xC1\204\25 8086,ND,SB +rm8,unity \1\xD0\204 8086,ND +rm8,reg_cl \1\xD2\204 8086,ND +rm8,imm \1\xC0\204\25 186,ND,SB + +[SALC] +(Ch_WEAX, Ch_RFLAGS, Ch_None) +void \1\xD6 8086,UNDOC,NOX86_64 + +[SAR,sarX] +(Ch_Mop2, Ch_Rop1, Ch_WFlags) +rm16|32|64,unity \320\1\xD1\207 8086 +rm16|32|64,reg_cl \320\1\xD3\207 8086 +rm16|32|64,imm \320\1\xC1\207\25 8086,SB +rm8,unity \1\xD0\207 8086 +rm8,reg_cl \1\xD2\207 8086 +rm8,imm \1\xC0\207\25 186,SB + +[SBB,sbbX] +(Ch_Mop2, Ch_Rop1, Ch_RWFlags) +regmem,reg16|32|64 \320\1\x19\101 8086,SM +reg16|32|64,regmem \320\1\x1B\110 8086,SM +rm16|32|64,imm8 \320\1\x83\203\15 8086 +rm8,reg8 \1\x18\101 8086 +reg8,rm8 \1\x1A\110 8086,SM +reg_eax,imm \325\1\x1D\41 386,SM +reg_rax,imm \326\1\x1D\255 X86_64,SM +rm32,imm \320\1\x81\203\41 386,SM +rm64,imm \326\1\x81\203\255 X86_64,SM +reg_ax,imm \324\1\x1D\31 8086,SW +rm16,imm \320\1\x81\203\31 8086,SW +reg_al,imm \1\x1C\21 8086,SB +rm8,imm \1\x80\203\21 8086,SB + +[SCASB] +(Ch_All, Ch_None, Ch_None) +void \332\1\xAE 8086 + +[SCASD,scasl] +(Ch_All, Ch_None, Ch_None) +void \332\325\1\xAF 386 + +[SCASQ] +(Ch_All, Ch_None, Ch_None) +void \332\326\1\xAF X86_64 + +[SCASW] +(Ch_All, Ch_None, Ch_None) +void \332\324\1\xAF 8086 + +[SEGCS,cs] +(Ch_None, Ch_None, Ch_None) +void \1\x2E 8086,PRE + +[SEGDS,ds] +(Ch_None, Ch_None, Ch_None) +void \1\x3E 8086,PRE + +[SEGES,es] +(Ch_None, Ch_None, Ch_None) +void \1\x26 8086,PRE + +[SEGFS,fs] +(Ch_None, Ch_None, Ch_None) +void \1\x64 8086,PRE + +[SEGGS,gs] +(Ch_None, Ch_None, Ch_None) +void \1\x65 8086,PRE + +[SEGSS,ss] +(Ch_None, Ch_None, Ch_None) +void \1\x36 8086,PRE + +[SGDT] +(Ch_Wop1, Ch_None, Ch_None) +mem \2\x0F\x01\200 286 + +[SHL,shlX] +(Ch_Mop2, Ch_Rop1, Ch_WFlags) +rm16|32|64,unity \320\1\xD1\204 8086 +rm16|32|64,reg_cl \320\1\xD3\204 8086 +rm16|32|64,imm \320\1\xC1\204\25 186,SW +rm8,unity \1\xD0\204 8086 +rm8,reg_cl \1\xD2\204 8086 +rm8,imm \1\xC0\204\25 186,SB + +[SHLD,shldX] +(Ch_MOp3, Ch_RWFlags, Ch_Rop2) +rm16|32|64,reg16|32|64,imm \321\2\x0F\xA4\101\26 386,SM2,SB,AR2 +rm16|32|64,reg16|32|64,reg_cl \321\2\x0F\xA5\101 386,SM + +[SHR,shrX] +(Ch_Mop2, Ch_Rop1, Ch_WFlags) +rm16|32|64,unity \320\1\xD1\205 8086 +rm16|32|64,reg_cl \320\1\xD3\205 8086 +rm16|32|64,imm \320\1\xC1\205\25 186,SW +rm8,unity \1\xD0\205 8086 +rm8,reg_cl \1\xD2\205 8086 +rm8,imm \1\xC0\205\25 186,SB + +[SHRD,shrdX] +(Ch_MOp3, Ch_RWFlags, Ch_Rop2) +rm16|32|64,reg16|32|64,imm \321\2\x0F\xAC\101\26 386,SM2,SB,AR2 +rm16|32|64,reg16|32|64,reg_cl \321\2\x0F\xAD\101 386,SM + +[SIDT,sidtX] +(Ch_Wop1, Ch_None, Ch_None) +mem \2\x0F\x01\201 286 + +[SLDT,sldtX] +(Ch_Wop1, Ch_None, Ch_None) +mem \2\x0F\x00\200 286 +reg16|32|64 \320\2\x0F\x00\200 286 + +[SMI] +(Ch_All, Ch_None, Ch_None) +void \1\xF1 386,UNDOC + +[SMINT] +(Ch_All, Ch_None, Ch_None) +void \2\x0F\x38 P6,CYRIX + +[SMINTOLD] +(Ch_All, Ch_None, Ch_None) +void \2\x0F\x7E 486,CYRIX,ND + +[SMSW,smswX] +(Ch_Wop1, Ch_None, Ch_None) +rm16|32|64 \320\2\x0F\x01\204 286 + +[STC] +(Ch_WFlags, Ch_None, Ch_None) +void \1\xF9 8086 + +[STD] +(Ch_SDirFlag, Ch_None, Ch_None) +void \1\xFD 8086 + +[STI] +(Ch_WFlags, Ch_None, Ch_None) +void \1\xFB 8086 + +[STOSB] +(Ch_REAX, Ch_WMemEDI, Ch_RWEDI) +void \1\xAA 8086 + +[STOSD,stosl] +(Ch_REAX, Ch_WMemEDI, Ch_RWEDI) +void \325\1\xAB 386 + +[STOSW] +(Ch_REAX, Ch_WMemEDI, Ch_RWEDI) +void \324\1\xAB 8086 + +[STR,strX] +(Ch_Wop1, Ch_None, Ch_None) +mem \2\x0F\x00\201 286,PROT +reg16|32|64 \320\2\x0F\x00\201 286,PROT + +[SUB,subX] +(Ch_Mop2, Ch_Rop1, Ch_WFlags) +regmem,reg16|32|64 \320\1\x29\101 8086,SM +reg16|32|64,regmem \320\1\x2B\110 8086,SM +rm8,reg8 \1\x28\101 8086 +reg8,rm8 \1\x2A\110 8086,SM +rm16|32|64,imm8 \320\1\x83\205\15 8086 +reg_eax,imm \325\1\x2D\41 386,SM +reg_rax,imm \326\1\x2D\255 X86_64,SM +rm32,imm \320\1\x81\205\41 386,SM +rm64,imm \326\1\x81\205\255 X86_64,SM +reg_ax,imm \324\1\x2D\31 8086,SW +rm16,imm \324\1\x81\205\31 8086,SW +reg_al,imm \1\x2C\21 8086,SB +rm8,imm \1\x80\205\21 8086,SB + +[SVDC,svdcX] +(Ch_All, Ch_None, Ch_None) +mem80,reg_sreg \2\x0F\x78\101 486,CYRIX,SMM + +[SVLDT,svldtX] +(Ch_All, Ch_None, Ch_None) +mem80 \2\x0F\x7A\200 486,CYRIX,SMM + +[SVTS,svtsX] +(Ch_All, Ch_None, Ch_None) +mem80 \2\x0F\x7C\200 486,CYRIX,SMM + +[SYSCALL] +(Ch_All, Ch_None, Ch_None) +void \2\x0F\x05 P6,AMD + +[SYSENTER] +(Ch_All, Ch_None, Ch_None) +void \2\x0F\x34 P6 + +[SYSEXIT] +(Ch_All, Ch_None, Ch_None) +void \2\x0F\x35 P6,PRIV + +[SYSRET] +(Ch_All, Ch_None, Ch_None) +void \2\x0F\x07 P6,PRIV,AMD + +[TEST,testX] +(Ch_WFlags, Ch_Rop1, Ch_Rop2) +regmem,reg16|32|64 \320\1\x85\101 8086,SM +reg16|32|64,mem \320\1\x85\110 8086,SM +reg8,reg8 \1\x84\101 8086 +rm8,reg8 \1\x84\101 8086,SM +reg_rax,imm \326\1\xA9\255 X86_64,SM +reg_eax,imm \325\1\xA9\41 386,SM +reg_ax,imm \324\1\xA9\31 8086,SM +reg_al,imm \1\xA8\21 8086,SM +rm64,imm \326\1\xF7\200\255 X86_64,SM +rm32,imm \325\1\xF7\200\41 386,SM +rm16,imm \324\1\xF7\200\31 8086,SM +rm8,imm \1\xF6\200\21 8086,SM +mem,imm32 \325\1\xF7\200\41 386,SM +mem,imm16 \324\1\xF7\200\31 8086,SM +mem,imm8 \1\xF6\200\21 8086,SM + +[UD1] +(Ch_All, Ch_None, Ch_None) +void \2\x0F\xB9 286,UNDOC + +[UD2] +(Ch_All, Ch_None, Ch_None) +void \2\x0F\x0B 286 + +[UMOV,umovX] +(Ch_All, Ch_None, Ch_None) +regmem,reg16|32|64 \320\2\x0F\x11\101 386,UNDOC,SM +reg16|32|64,mem \320\2\x0F\x13\110 386,UNDOC,SM +rm8,reg8 \2\x0F\x10\101 386,UNDOC +reg8,rm8 \2\x0F\x12\110 386,UNDOC + +[VERR,verrX] +(Ch_WFlags, Ch_None, Ch_None) +mem \2\x0F\x00\204 286,PROT +mem16 \2\x0F\x00\204 286,PROT +reg16 \2\x0F\x00\204 286,PROT + +[VERW] +(Ch_WFlags, Ch_None, Ch_None) +mem \2\x0F\x00\205 286,PROT +mem16 \2\x0F\x00\205 286,PROT +reg16 \2\x0F\x00\205 286,PROT + +[WAIT] +(Ch_None, Ch_None, Ch_None) +void \1\x9B 8086 + +[WBINVD] +(Ch_None, Ch_None, Ch_None) +void \2\x0F\x09 486,PRIV + +[WRSHR] +(Ch_All, Ch_None, Ch_None) +void \2\x0F\x37 P6,CYRIX,SMM + +[WRMSR] +(Ch_All, Ch_None, Ch_None) +void \2\x0F\x30 PENT,PRIV + +[XADD,xaddX] +(Ch_All, Ch_None, Ch_None) +mem,reg16|32|64 \320\2\x0F\xC1\101 486,SM +rm8,reg8 \2\x0F\xC0\101 486 + +[XBTS,xbtsX] +(Ch_All, Ch_None, Ch_None) +reg16,mem \324\2\x0F\xA6\110 386,SW,UNDOC,ND +reg16,reg16 \324\2\x0F\xA6\110 386,UNDOC,ND +reg32,mem \325\2\x0F\xA6\110 386,SD,UNDOC,ND +reg32,reg32 \325\2\x0F\xA6\110 386,UNDOC,ND + +[XCHG,xchgX] +(Ch_RWop1, Ch_RWop2, Ch_None) +reg_ax,reg16 \324\11\x90 8086 +reg_eax,reg32 \325\11\x90 386 +reg_rax,reg64 \326\11\x90 X86_64 +reg16,reg_ax \324\10\x90 8086 +reg32,reg_eax \325\10\x90 386 +reg64,reg_rax \326\10\x90 X86_64 +reg16|32|64,regmem \320\1\x87\110 8086,SM +mem,reg16|32|64 \320\1\x87\101 8086,SM +reg8,rm8 \1\x86\110 8086 +mem8,reg8 \1\x86\101 8086 + +[XLAT] +(Ch_WEAX, Ch_REBX, Ch_None) +void \1\xD7 8086 + +[XLATB] +(Ch_WEAX, Ch_REBX, Ch_None) +void \1\xD7 8086 + +[XOR,xorX] +(Ch_Mop2, Ch_Rop1, Ch_WFlags) +regmem,reg16|32|64 \320\1\x31\101 8086,SM +reg16|32|64,regmem \320\1\x33\110 8086,SM +rm8,reg8 \1\x30\101 8086 +reg8,rm8 \1\x32\110 8086 +rm16|32|64,imm8 \320\1\x83\206\15 8086 +reg_eax,imm \325\1\x35\41 386,SM +reg_rax,imm \326\1\x35\255 X86_64,SM +rm32,imm \320\1\x81\206\41 386,SM +rm64,imm \326\1\x81\206\255 X86_64,SM +reg_ax,imm \324\1\x35\31 8086,SW +rm16,imm \324\1\x81\206\31 8086,SW +reg_al,imm \1\x34\21 8086,SB +rm8,imm \1\x80\206\21 8086,SB + +[XSTORE] +(Ch_All, Ch_None, Ch_None) +void \3\x0F\xA7\xC0 P6,CYRIX + +[XCRYPTECB] +(Ch_All, Ch_None, Ch_None) +void \333\3\x0F\xA7\xC8 P6,CYRIX + +[XCRYPTCBC] +(Ch_All, Ch_None, Ch_None) +void \333\3\x0F\xA7\xD0 P6,CYRIX + +[XCRYPTCFB] +(Ch_All, Ch_None, Ch_None) +void \333\3\x0F\xA7\xE0 P6,CYRIX + +[XCRYPTOFB] +(Ch_All, Ch_None, Ch_None) +void \333\3\x0F\xA7\xE8 P6,CYRIX + +[CMOVcc,cmovCCX] +(Ch_ROp1, Ch_WOp2, Ch_RFLAGS) +reg16|32|64,regmem \320\1\x0F\13\x40\110 P6,SM + +[Jcc] +(Ch_RFLAGS, Ch_None, Ch_None) +imm8 \13\x70\50 8086 +imm16|32 \320\1\x0F\13\x80\64 386,PASS2 +imm|short \13\x70\50 8086 +imm|near \320\1\x0F\13\x80\64 386,PASS2 + +[SETcc,setCCX] +(Ch_RFLAGS, Ch_WOp1, Ch_None) +rm8 \1\x0F\13\x90\200 386 + +; +; Katmai Streaming SIMD instructions (SSE -- a.k.a. KNI, XMM, MMX2) +; + +[ADDPS] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \331\2\x0F\x58\110 KATMAI,SSE + +[ADDSS] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \333\2\x0F\x58\110 KATMAI,SSE + +[ANDNPS] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \2\x0F\x55\110 KATMAI,SSE + +[ANDPS] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \2\x0F\x54\110 KATMAI,SSE + +[CMPEQPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \331\2\x0F\xC2\110\1\x00 KATMAI,SSE + +[CMPEQSS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \333\2\x0F\xC2\110\1\x00 KATMAI,SSE + +[CMPLEPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \331\2\x0F\xC2\110\1\x02 KATMAI,SSE + +[CMPLESS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \333\2\x0F\xC2\110\1\x02 KATMAI,SSE + +[CMPLTPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \331\2\x0F\xC2\110\1\x01 KATMAI,SSE + +[CMPLTSS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \333\2\x0F\xC2\110\1\x01 KATMAI,SSE + +[CMPNEQPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \331\2\x0F\xC2\110\1\x04 KATMAI,SSE + +[CMPNEQSS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \333\2\x0F\xC2\110\1\x04 KATMAI,SSE + +[CMPNLEPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \331\2\x0F\xC2\110\1\x06 KATMAI,SSE + +[CMPNLESS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \333\2\x0F\xC2\110\1\x06 KATMAI,SSE + +[CMPNLTPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \331\2\x0F\xC2\110\1\x05 KATMAI,SSE + +[CMPNLTSS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \333\2\x0F\xC2\110\1\x05 KATMAI,SSE + +[CMPORDPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \331\2\x0F\xC2\110\1\x07 KATMAI,SSE + +[CMPORDSS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \333\2\x0F\xC2\110\1\x07 KATMAI,SSE + +[CMPUNORDPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \331\2\x0F\xC2\110\1\x03 KATMAI,SSE + +[CMPUNORDSS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \333\2\x0F\xC2\110\1\x03 KATMAI,SSE + +; +; CMPPS/CMPSS must come after the specific ops; that way the disassembler will find the +; specific ops first and only disassemble illegal ones as cmpps. +; + +[CMPPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \331\2\x0F\xC2\110\22 KATMAI,SSE,SB,AR2 + +[CMPSS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \333\2\x0F\xC2\110\22 KATMAI,SSE,SB,AR2 + +[COMISS] +(Ch_Rop1, Ch_Rop2, Ch_WFlags) +xmmreg,xmmrm \2\x0F\x2F\110 KATMAI,SSE + +[CVTPI2PS] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,mem \331\2\x0F\x2A\110 KATMAI,SSE,MMX +xmmreg,mmxreg \331\2\x0F\x2A\110 KATMAI,SSE,MMX + +[CVTPS2PI] +(Ch_Wop2, Ch_Rop1, Ch_None) +mmxreg,mem \331\2\x0F\x2D\110 KATMAI,SSE,MMX +mmxreg,xmmreg \331\2\x0F\x2D\110 KATMAI,SSE,MMX + +[CVTSI2SS,cvtsi2ssX] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,mem \333\321\2\x0F\x2A\110 KATMAI,SSE +xmmreg,reg32|64 \333\321\2\x0F\x2A\110 KATMAI,SSE + +[CVTSS2SI,cvtss2siX] +(Ch_Wop2, Ch_Rop1, Ch_None) +reg32|64,mem \333\320\2\x0F\x2D\110 KATMAI,SSE +reg32|64,xmmreg \333\320\2\x0F\x2D\110 KATMAI,SSE + +[CVTTPS2PI] +(Ch_Wop2, Ch_Rop1, Ch_None) +mmxreg,mem \331\2\x0F\x2C\110 KATMAI,SSE,MMX +mmxreg,xmmreg \331\2\x0F\x2C\110 KATMAI,SSE,MMX + +[CVTTSS2SI,cvttss2siX] +(Ch_Wop2, Ch_Rop1, Ch_None) +reg32|64,mem \333\320\2\x0F\x2C\110 KATMAI,SSE +reg32|64,xmmreg \333\320\2\x0F\x2C\110 KATMAI,SSE + +[DIVPS] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \331\2\x0F\x5E\110 KATMAI,SSE + +[DIVSS] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \333\2\x0F\x5E\110 KATMAI,SSE + +[LDMXCSR] +(Ch_All, Ch_None, Ch_None) +mem \2\x0F\xAE\202 KATMAI,SSE,SD + +[MAXPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \331\2\x0F\x5F\110 KATMAI,SSE + +[MAXSS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \333\2\x0F\x5F\110 KATMAI,SSE + +[MINPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \331\2\x0F\x5D\110 KATMAI,SSE + +[MINSS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \333\2\x0F\x5D\110 KATMAI,SSE + +[MOVAPS] +(Ch_ROp1, Ch_WOp2, Ch_None) +xmmreg,xmmrm \2\x0F\x28\110 KATMAI,SSE +xmmrm,xmmreg \2\x0F\x29\101 KATMAI,SSE + +[MOVHPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,mem \2\x0F\x16\110 KATMAI,SSE +mem,xmmreg \2\x0F\x17\101 KATMAI,SSE + +[MOVLHPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmreg \2\x0F\x16\110 KATMAI,SSE + +[MOVLPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,mem \2\x0F\x12\110 KATMAI,SSE +mem,xmmreg \2\x0F\x13\101 KATMAI,SSE + +[MOVHLPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmreg \2\x0F\x12\110 KATMAI,SSE + +[MOVMSKPS] +(Ch_All, Ch_None, Ch_None) +reg32,xmmreg \2\x0F\x50\110 KATMAI,SSE + +[MOVNTPS] +(Ch_All, Ch_None, Ch_None) +mem,xmmreg \2\x0F\x2B\101 KATMAI,SSE + +[MOVSS] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \333\2\x0F\x10\110 KATMAI,SSE +xmmrm,xmmreg \333\2\x0F\x11\101 KATMAI,SSE + +[MOVUPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \331\2\x0F\x10\110 KATMAI,SSE +xmmrm,xmmreg \331\2\x0F\x11\101 KATMAI,SSE + +[MULPS] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \2\x0F\x59\110 KATMAI,SSE + +[MULSS] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \333\2\x0F\x59\110 KATMAI,SSE + +[ORPS] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \2\x0F\x56\110 KATMAI,SSE + +[RCPPS] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \331\2\x0F\x53\110 KATMAI,SSE + +[RCPSS] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \333\2\x0F\x53\110 KATMAI,SSE + +[RSQRTPS] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \331\2\x0F\x52\110 KATMAI,SSE + +[RSQRTSS] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \333\2\x0F\x52\110 KATMAI,SSE + +[SHUFPS] +(Ch_Mop3, Ch_Rop2, Ch_None) +xmmreg,xmmrm,imm \2\x0F\xC6\110\22 KATMAI,SSE,SB,AR2 + +[SQRTPS] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \331\2\x0F\x51\110 KATMAI,SSE + +[SQRTSS] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \333\2\x0F\x51\110 KATMAI,SSE + +[STMXCSR] +(Ch_All, Ch_None, Ch_None) +mem \2\x0F\xAE\203 KATMAI,SSE,SD + +[SUBPS] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \331\2\x0F\x5C\110 KATMAI,SSE + +[SUBSS] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \333\2\x0F\x5C\110 KATMAI,SSE + +[UCOMISS] +(Ch_Rop1, Ch_Rop2, Ch_WFlags) +xmmreg,xmmrm \2\x0F\x2E\110 KATMAI,SSE + +[UNPCKHPS] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \2\x0F\x15\110 KATMAI,SSE + +[UNPCKLPS] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \2\x0F\x14\110 KATMAI,SSE + +[XORPS] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \2\x0F\x57\110 KATMAI,SSE + +; +; Introduced in Dechutes but necessary for SSE support +; + +[FXRSTOR] +(Ch_All, Ch_None, Ch_None) +mem \2\x0F\xAE\201 P6,SSE,FPU + +[FXSAVE] +(Ch_All, Ch_None, Ch_None) +mem \2\x0F\xAE\200 P6,SSE,FPU + +; +; These instructions aren't SSE-specific; they are generic memory operations +; and work even if CR4.OSFXFR == 0 +; + +[PREFETCHNTA] +(Ch_All, Ch_None, Ch_None) +mem \2\x0F\x18\200 KATMAI + +[PREFETCHT0] +(Ch_All, Ch_None, Ch_None) +mem \2\x0F\x18\201 KATMAI + +[PREFETCHT1] +(Ch_All, Ch_None, Ch_None) +mem \2\x0F\x18\202 KATMAI + +[PREFETCHT2] +(Ch_All, Ch_None, Ch_None) +mem \2\x0F\x18\203 KATMAI + +[SFENCE] +(Ch_All, Ch_None, Ch_None) +void \3\x0F\xAE\xF8 KATMAI + +; +; New MMX instructions introduced in Katmai +; + +[MASKMOVQ] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxreg \2\x0F\xF7\110 KATMAI,MMX + +[MOVNTQ] +(Ch_All, Ch_None, Ch_None) +mem,mmxreg \2\x0F\xE7\101 KATMAI,MMX,SM + +[PAVGB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xE0\110 KATMAI,MMX,SM +xmmreg,xmmrm \361\2\x0F\xE0\110 WILLAMETTE,SSE2,SM + +[PAVGW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xE3\110 KATMAI,MMX,SM +xmmreg,xmmrm \361\2\x0F\xE3\110 WILLAMETTE,SSE2,SM + +[PEXTRW] +(Ch_All, Ch_None, Ch_None) +reg32,mmxreg,imm \2\x0F\xC5\110\22 KATMAI,MMX,SB,AR2 +reg32,xmmreg,imm \361\2\x0F\xC5\110\26 SSE41 +mem32,xmmreg,imm \361\3\x0F\x3A\x15\101\26 SSE41 + + +[PINSRW] +(Ch_All, Ch_None, Ch_None) +; PINSRW is documented as using a reg32, but it's really using only 16 bit +; -- accept either, but be truthful in disassembly +mmxreg,reg16,imm \2\x0F\xC4\110\22 KATMAI,MMX,SB,AR2 +mmxreg,reg32,imm \2\x0F\xC4\110\22 KATMAI,MMX,SB,AR2,ND +mmxreg,mem,imm \2\x0F\xC4\110\22 KATMAI,MMX,SB,AR2 +mmxreg,mem16,imm \2\x0F\xC4\110\22 KATMAI,MMX,SB,AR2,ND +xmmreg,reg16,imm \361\2\x0F\xC4\110\26 WILLAMETTE,SSE2,SB,AR2 +xmmreg,reg32,imm \361\2\x0F\xC4\110\26 WILLAMETTE,SSE2,SB,AR2,ND +xmmreg,mem,imm \361\2\x0F\xC4\110\26 WILLAMETTE,SSE2,SB,AR2 +xmmreg,mem16,imm \361\2\x0F\xC4\110\26 WILLAMETTE,SSE2,SB,AR2,ND + +[PMAXSW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xEE\110 KATMAI,MMX,SM +xmmreg,xmmrm \361\2\x0F\xEE\110 WILLAMETTE,SSE2,SM + +[PMAXUB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xDE\110 KATMAI,MMX,SM +xmmreg,xmmrm \361\2\x0F\xDE\110 WILLAMETTE,SSE2,SM + +[PMINSW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xEA\110 KATMAI,MMX,SM +xmmreg,xmmrm \361\2\x0F\xEA\110 WILLAMETTE,SSE2,SM + +[PMINUB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xDA\110 KATMAI,MMX,SM +xmmreg,xmmrm \361\2\x0F\xDA\110 WILLAMETTE,SSE2,SM + +[PMOVMSKB] +(Ch_All, Ch_None, Ch_None) +reg32,mmxreg \2\x0F\xD7\110 KATMAI,MMX +reg32,xmmreg \361\2\x0F\xD7\110 WILLAMETTE,SSE2 + +[PMULHUW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xE4\110 KATMAI,MMX,SM +xmmreg,xmmrm \361\2\x0F\xE4\110 WILLAMETTE,SSE2,SM + +[PSADBW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xF6\110 KATMAI,MMX,SM +xmmreg,xmmrm \361\2\x0F\xF6\110 WILLAMETTE,SSE2,SM + +[PSHUFW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm,imm \2\x0F\x70\110\22 KATMAI,MMX,SM2,SB,AR2 + +; +; New Athlon Instructions +; + +[PFNACC] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\x8A PENT,3DNOW,SM + +[PFPNACC] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\x8E PENT,3DNOW,SM + +[PI2FW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\x0C PENT,3DNOW,SM + +[PF2IW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\x1C PENT,3DNOW,SM + +[PSWAPD] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\x0F\110\01\xBB PENT,3DNOW,SM + +[FFREEP] +(Ch_All, Ch_None, Ch_None) +fpureg \1\xDF\10\xC0 PENT,3DNOW,FPU + +; Willamette SSE2 Cacheability Instructions +[MASKMOVDQU] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmreg \361\2\x0F\xF7\110 WILLAMETTE,SSE2 + +; CLFLUSH needs its own feature flag implemented one day +[CLFLUSH] +(Ch_All, Ch_None, Ch_None) +mem \2\x0F\xAE\207 WILLAMETTE,SSE2 + +[MOVNTDQ] +(Ch_All, Ch_None, Ch_None) +mem,xmmreg \361\2\x0F\xE7\101 WILLAMETTE,SSE2,SM + +[MOVNTI,movntiX] +(Ch_All, Ch_None, Ch_None) +mem,reg32|64 \320\2\x0F\xC3\101 WILLAMETTE,SSE2,SM + +[MOVNTPD] +(Ch_All, Ch_None, Ch_None) +mem,xmmreg \361\2\x0F\x2B\101 WILLAMETTE,SSE2,SM + +[PAUSE] +(Ch_All, Ch_None, Ch_None) +void \333\1\x90 WILLAMETTE,SSE2 + +[LFENCE] +(Ch_All, Ch_None, Ch_None) +void \3\x0F\xAE\xE8 WILLAMETTE,SSE2 + +[MFENCE] +(Ch_All, Ch_None, Ch_None) +void \3\x0F\xAE\xF0 WILLAMETTE,SSE2 + +; +; Willamette MMX instructions (SSE2 SIMD Integer Instructions) +; +[MOVDQA] +(Ch_All, Ch_None, Ch_None) +xmmrm,xmmreg \361\2\x0F\x7F\101 WILLAMETTE,SSE2,SM +xmmreg,xmmrm \361\2\x0F\x6F\110 WILLAMETTE,SSE2,SM + +[MOVDQU] +(Ch_All, Ch_None, Ch_None) +xmmrm,xmmreg \333\2\x0F\x7F\101 WILLAMETTE,SSE2,SM +xmmreg,xmmrm \333\2\x0F\x6F\110 WILLAMETTE,SSE2,SM + +[MOVDQ2Q] +(Ch_All, Ch_None, Ch_None) +mmxreg,xmmreg \334\2\x0F\xD6\110 WILLAMETTE,SSE2 + +[MOVQ2DQ] +(Ch_All, Ch_None, Ch_None) +xmmreg,mmxreg \333\2\x0F\xD6\110 WILLAMETTE,SSE2 + +[PADDQ] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xD4\110 WILLAMETTE,SSE2,SM +xmmreg,xmmrm \361\2\x0F\xD4\110 WILLAMETTE,SSE2,SM + +[PMULUDQ] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xF4\110 WILLAMETTE,SSE2,SM +xmmreg,xmmrm \361\2\x0F\xF4\110 WILLAMETTE,SSE2,SM + +[PSHUFD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \361\2\x0F\x70\110\22 WILLAMETTE,SSE2,SM2,SB,AR2 + +[PSHUFHW] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \333\2\x0F\x70\110\22 WILLAMETTE,SSE2,SM2,SB,AR2 + +[PSHUFLW] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \334\2\x0F\x70\110\22 WILLAMETTE,SSE2,SM2,SB,AR2 + +[PSRLDQ] +(Ch_All, Ch_None, Ch_None) +xmmreg,imm \361\2\x0F\x73\203\25 WILLAMETTE,SSE2,SB,AR1 + +[PSUBQ] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \2\x0F\xFB\110 WILLAMETTE,SSE2,SM +xmmreg,xmmrm \361\2\x0F\xFB\110 WILLAMETTE,SSE2,SM + +[PUNPCKHQDQ] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\2\x0F\x6D\110 WILLAMETTE,SSE2,SM + +[PUNPCKLQDQ] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\2\x0F\x6C\110 WILLAMETTE,SSE2,SM + +; +; Willamette Streaming SIMD instructions (SSE2) +; +[ADDPD] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \361\2\x0F\x58\110 WILLAMETTE,SSE2,SM + +[ADDSD] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \334\2\x0F\x58\110 WILLAMETTE,SSE2 + +[ANDNPD] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \361\2\x0F\x55\110 WILLAMETTE,SSE2,SM + +[ANDPD] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \361\2\x0F\x54\110 WILLAMETTE,SSE2,SM + +[CMPEQPD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\2\x0F\xC2\110\1\x00 WILLAMETTE,SSE2,SM + +; note: no SM flag on CMPxxSD, they use 64-bit memory location, not 128-bit +[CMPEQSD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \334\2\x0F\xC2\110\1\x00 WILLAMETTE,SSE2 + +[CMPLEPD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\2\x0F\xC2\110\1\x02 WILLAMETTE,SSE2,SM + +[CMPLESD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \334\2\x0F\xC2\110\1\x02 WILLAMETTE,SSE2 + +[CMPLTPD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\2\x0F\xC2\110\1\x01 WILLAMETTE,SSE2,SM + +[CMPLTSD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \334\2\x0F\xC2\110\1\x01 WILLAMETTE,SSE2 + +[CMPNEQPD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\2\x0F\xC2\110\1\x04 WILLAMETTE,SSE2,SM + +[CMPNEQSD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \334\2\x0F\xC2\110\1\x04 WILLAMETTE,SSE2 + +[CMPNLEPD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\2\x0F\xC2\110\1\x06 WILLAMETTE,SSE2,SM + +[CMPNLESD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \334\2\x0F\xC2\110\1\x06 WILLAMETTE,SSE2 + +[CMPNLTPD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\2\x0F\xC2\110\1\x05 WILLAMETTE,SSE2,SM + +[CMPNLTSD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \334\2\x0F\xC2\110\1\x05 WILLAMETTE,SSE2 + +[CMPORDPD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\2\x0F\xC2\110\1\x07 WILLAMETTE,SSE2,SM + +[CMPORDSD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \334\2\x0F\xC2\110\1\x07 WILLAMETTE,SSE2 + +[CMPUNORDPD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\2\x0F\xC2\110\1\x03 WILLAMETTE,SSE2,SM + +[CMPUNORDSD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \334\2\x0F\xC2\110\1\x03 WILLAMETTE,SSE2 + +; CMPPD/CMPSD must come after the specific ops; that way the disassembler will find the +; specific ops first and only disassemble illegal ones as cmppd/cmpsd. +[CMPPD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \361\2\x0F\xC2\110\26 WILLAMETTE,SSE2,SM2,SB,AR2 + +[COMISD] +(Ch_Rop1, Ch_Rop2, Ch_WFlags) +xmmreg,xmmrm \361\2\x0F\x2F\110 WILLAMETTE,SSE2 + +[CVTDQ2PD] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \333\2\x0F\xE6\110 WILLAMETTE,SSE2 + +[CVTDQ2PS] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \2\x0F\x5B\110 WILLAMETTE,SSE2,SM + +[CVTPD2DQ] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \334\2\x0F\xE6\110 WILLAMETTE,SSE2,SM + +[CVTPD2PI] +(Ch_Wop2, Ch_Rop1, Ch_None) +mmxreg,xmmrm \361\2\x0F\x2D\110 WILLAMETTE,SSE2 ;,SO + +[CVTPD2PS] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \361\2\x0F\x5A\110 WILLAMETTE,SSE2,SM + +[CVTPI2PD] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,mmxrm \361\2\x0F\x2A\110 WILLAMETTE,SSE2 ;,SO + +[CVTPS2DQ] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \361\2\x0F\x5B\110 WILLAMETTE,SSE2,SM + +[CVTPS2PD] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \2\x0F\x5A\110 WILLAMETTE,SSE2 ;,SQ + +[CVTSD2SI,cvtsd2siX] +(Ch_Wop2, Ch_Rop1, Ch_None) +reg32|64,xmmreg \334\320\2\x0F\x2D\110 WILLAMETTE,SSE2 +reg32|64,mem \334\320\2\x0F\x2D\110 WILLAMETTE,SSE2 + +[CVTSD2SS] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \334\2\x0F\x5A\110 WILLAMETTE,SSE2 ;,SQ + +[CVTSI2SD,cvtsi2sdX] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,reg32|64 \334\321\2\x0F\x2A\110 WILLAMETTE,SSE2 +xmmreg,mem \334\321\2\x0F\x2A\110 WILLAMETTE,SSE2 + +[CVTSS2SD] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \333\2\x0F\x5A\110 WILLAMETTE,SSE2 ;,SD + +[CVTTPD2PI] +(Ch_Wop2, Ch_Rop1, Ch_None) +mmxreg,xmmreg \361\2\x0F\x2C\110 WILLAMETTE,SSE2 +mmxreg,mem \361\2\x0F\x2C\110 WILLAMETTE,SSE2 + +[CVTTPD2DQ] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \361\2\x0F\xE6\110 WILLAMETTE,SSE2,SM + +[CVTTPS2DQ] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \333\2\x0F\x5B\110 WILLAMETTE,SSE2,SM + +[CVTTSD2SI,cvttsd2siX] +(Ch_Wop2, Ch_Rop1, Ch_None) +reg32|64,xmmreg \334\320\2\x0F\x2C\110 WILLAMETTE,SSE2 +reg32|64,mem \334\320\2\x0F\x2C\110 WILLAMETTE,SSE2 + +[DIVPD] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \361\2\x0F\x5E\110 WILLAMETTE,SSE2,SM + +[DIVSD] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \334\2\x0F\x5E\110 WILLAMETTE,SSE2 + +[MAXPD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\2\x0F\x5F\110 WILLAMETTE,SSE2,SM + +[MAXSD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \334\2\x0F\x5F\110 WILLAMETTE,SSE2 + +[MINPD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\2\x0F\x5D\110 WILLAMETTE,SSE2,SM + +[MINSD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \334\2\x0F\x5D\110 WILLAMETTE,SSE2 + +[MOVAPD] +(Ch_ROp1, Ch_WOp2, Ch_None) +xmmrm,xmmreg \361\2\x0F\x29\101 WILLAMETTE,SSE2,SM +xmmreg,xmmrm \361\2\x0F\x28\110 WILLAMETTE,SSE2,SM + +[MOVHPD] +(Ch_All, Ch_None, Ch_None) +mem,xmmreg \361\2\x0F\x17\101 WILLAMETTE,SSE2 +xmmreg,mem \361\2\x0F\x16\110 WILLAMETTE,SSE2 + +[MOVLPD] +(Ch_All, Ch_None, Ch_None) +mem,xmmreg \361\2\x0F\x13\101 WILLAMETTE,SSE2 +xmmreg,mem \361\2\x0F\x12\110 WILLAMETTE,SSE2 + +[MOVMSKPD] +(Ch_All, Ch_None, Ch_None) +reg32,xmmreg \361\2\x0F\x50\110 WILLAMETTE,SSE2 + +[MOVUPD] +(Ch_All, Ch_None, Ch_None) +xmmrm,xmmreg \361\2\x0F\x11\101 WILLAMETTE,SSE2,SM +xmmreg,xmmrm \361\2\x0F\x10\110 WILLAMETTE,SSE2,SM + +[MULPD] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \361\2\x0F\x59\110 WILLAMETTE,SSE2,SM + +[MULSD] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \334\2\x0F\x59\110 WILLAMETTE,SSE2 + +[ORPD] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \361\2\x0F\x56\110 WILLAMETTE,SSE2,SM + +[SHUFPD] +(Ch_Mop3, Ch_Rop2, Ch_None) +xmmreg,xmmrm,imm \361\2\x0F\xC6\110\26 WILLAMETTE,SSE2,SM2,SB,AR2 + +[SQRTPD] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \361\2\x0F\x51\110 WILLAMETTE,SSE2,SM + +[SQRTSD] +(Ch_Wop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \334\2\x0F\x51\110 WILLAMETTE,SSE2 + + +[SUBPD] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \361\2\x0F\x5C\110 WILLAMETTE,SSE2,SM + +[SUBSD] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \334\2\x0F\x5C\110 WILLAMETTE,SSE2 + +[UCOMISD] +(Ch_Rop1, Ch_Rop2, Ch_WFlags) +xmmreg,xmmrm \361\2\x0F\x2E\110 WILLAMETTE,SSE2 + +[UNPCKHPD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\2\x0F\x15\110 WILLAMETTE,SSE2,SM + +[UNPCKLPD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\2\x0F\x14\110 WILLAMETTE,SSE2,SM + +[XORPD] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \361\2\x0F\x57\110 WILLAMETTE,SSE2,SM + +; +; Prescott New Instructions (SSE3) +; +[ADDSUBPD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\2\x0F\xD0\110 PRESCOTT,SSE3,SM + +[ADDSUBPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \334\2\x0F\xD0\110 PRESCOTT,SSE3,SM + +[HADDPD] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \361\2\x0F\x7C\110 PRESCOTT,SSE3,SM + +[HADDPS] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \334\2\x0F\x7C\110 PRESCOTT,SSE3,SM + +[HSUBPD] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \361\2\x0F\x7D\110 PRESCOTT,SSE3,SM + +[HSUBPS] +(Ch_Mop2, Ch_Rop1, Ch_None) +xmmreg,xmmrm \334\2\x0F\x7D\110 PRESCOTT,SSE3,SM + +[LDDQU] +(Ch_All, Ch_None, Ch_None) +xmmreg,mem \334\2\x0F\xF0\110 PRESCOTT,SSE3 + +[MOVDDUP] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \334\2\x0F\x12\110 PRESCOTT,SSE3 + +[MOVSHDUP] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \333\2\x0F\x16\110 PRESCOTT,SSE3,SM + +[MOVSLDUP] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \333\2\x0F\x12\110 PRESCOTT,SSE3,SM + +; +; Intel VT +; +[VMREAD] +(Ch_All, Ch_None, Ch_None) +reg32,reg32 \2\x0F\x78\101 386,PRIV,PROT +mem,reg32 \2\x0F\x78\101 386,PRIV,PROT,SM + +[VMWRITE] +(Ch_All, Ch_None, Ch_None) +reg32,reg32 \2\x0F\x79\110 386,PRIV,PROT +reg32,mem \2\x0F\x79\110 386,PRIV,PROT,SM + +[VMCALL] +(Ch_All, Ch_None, Ch_None) +void \3\x0F\x01\xC1 386,PRIV,PROT + +[VMLAUNCH] +(Ch_All, Ch_None, Ch_None) +void \3\x0F\x01\xC2 386,PRIV,PROT + +[VMRESUME] +(Ch_All, Ch_None, Ch_None) +void \3\x0F\x01\xC3 386,PRIV,PROT + +[VMXOFF] +(Ch_All, Ch_None, Ch_None) +void \3\x0F\x01\xC4 386,PRIV,PROT + +; note: ideally the following should be tagged with SQ + +[VMXON] +(Ch_All, Ch_None, Ch_None) +mem \333\2\x0F\xC7\206 PRIV,PROT + +[VMCLEAR] +(Ch_All, Ch_None, Ch_None) +mem \361\2\x0F\xC7\206 PRIV,PROT + +[VMPTRLD] +(Ch_All, Ch_None, Ch_None) +mem \2\x0F\xC7\206 PRIV,PROT + +[VMPTRST] +(Ch_All, Ch_None, Ch_None) +mem \2\x0F\xC7\207 PRIV,PROT + +; +; AMD SVM +; +[VMRUN] +(Ch_All, Ch_None, Ch_None) +void \3\x0F\x01\xD8 386,SVM,PRIV,PROT + +[VMMCALL] +(Ch_All, Ch_None, Ch_None) +void \3\x0F\x01\xD9 386,SVM + +[VMLOAD] +(Ch_All, Ch_None, Ch_None) +void \3\x0F\x01\xDA 386,SVM,PRIV,PROT + +[VMSAVE] +(Ch_All, Ch_None, Ch_None) +void \3\x0F\x01\xDB 386,SVM,PRIV,PROT + +[STGI] +(Ch_All, Ch_None, Ch_None) +void \3\x0F\x01\xDC 386,SVM,PRIV,PROT + +[CLGI] +(Ch_All, Ch_None, Ch_None) +void \3\x0F\x01\xDD 386,SVM,PRIV,PROT + +[SKINIT] +(Ch_All, Ch_None, Ch_None) +void \3\x0F\x01\xDE 386,SVM,PRIV,PROT + +[INVLPGA] +(Ch_All, Ch_None, Ch_None) +void \3\x0F\x01\xDF 386,SVM,PRIV,PROT + +; +; Centaur +; +[MONTMUL] +(Ch_All, Ch_None, Ch_None) +void \333\3\x0F\xA6\xC0 CENTAUR + +[XSHA1] +(Ch_All, Ch_None, Ch_None) +void \333\3\x0F\xA6\xC8 CENTAUR + +[XSHA256] +(Ch_All, Ch_None, Ch_None) +void \333\3\x0F\xA6\xD0 CENTAUR + +; +; Geode +; +[DMINT] +(Ch_All, Ch_None, Ch_None) +void \2\x0F\x39 P6,CYRIX + +[RDM] +(Ch_All, Ch_None, Ch_None) +void \2\x0F\x3A P6,CYRIX + +; +; GAS specific x86-64 instructions +; +[MOVABS] +(Ch_Wop2, Ch_Rop1, Ch_None) +reg_al,mem_offs \1\xA0\45 X86_64,SM +reg_ax|32|64,mem_offs \320\1\xA1\45 X86_64,SM +mem_offs,reg_al \1\xA2\44 X86_64,SM +mem_offs,reg_ax|32|64 \321\xA3\44 X86_64,SM +reg64,imm \326\10\xB8\55 X86_64 + +[MOVSXD,movslq] +(Ch_Wop2, Ch_Rop1, Ch_None) +reg64,mem \326\1\x63\110 X86_64 +reg64,reg32 \326\1\x63\110 X86_64 + +[CQO,cqto] +(Ch_MRAX, Ch_WRDX, Ch_None) +void \326\1\x99 X86_64 + +[CMPXCHG16B,cmpxchg16bX] +(Ch_All, Ch_None, Ch_None) +mem \326\2\x0F\xC7\201 X86_64 + +; +; SSE4a (AMD Barcelona CPUs, n/a on Intel) +; +[MOVNTSS] +(Ch_All, Ch_None, Ch_None) +mem,xmmreg \333\2\x0F\x2B\101 SSE4,SD + +[MOVNTSD] +(Ch_All, Ch_None, Ch_None) +mem,xmmreg \334\325\2\x0F\x2B\101 SSE4 ;,SQ + +[INSERTQ] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmreg \334\2\x0F\x79\110 SSE4 +xmmreg,xmmreg,imm,imm \334\2\x0F\x78\110\26\27 SSE4,SB + +[EXTRQ] +(Ch_All, Ch_None, Ch_None) +xmmreg,imm,imm \361\2\x0F\x78\200\25\26 SSE4,SB +xmmreg,xmmreg \361\2\x0F\x79\110 SSE4 + +[LZCNT,lzcntX] +(Ch_All, Ch_None, Ch_None) +reg16,regmem \320\333\2\x0F\xBD\110 386,SM,SSE4 +reg32|64,regmem \321\333\2\x0F\xBD\110 386,SM,SSE4 + +;******************************************************************************* +;**********SSSE3**************************************************************** +;******************************************************************************* +[PABSB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \331\3\x0F\x38\x1C\110 SSSE3,MMX,SM +xmmreg,xmmrm \361\3\x0F\x38\x1C\110 SSSE3,SM + +[PABSW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \331\3\x0F\x38\x1D\110 SSSE3,MMX,SM +xmmreg,xmmrm \361\3\x0F\x38\x1D\110 SSSE3,SM + +[PABSD] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \331\3\x0F\x38\x1E\110 SSSE3,MMX,SM +xmmreg,xmmrm \361\3\x0F\x38\x1E\110 SSSE3,SM + +[PALIGNR] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm,imm \331\3\x0F\x3A\x0F\110\26 SSSE3,MMX,SM2,SB,AR2 +xmmreg,xmmrm,imm \361\3\x0F\x3A\x0F\110\26 SSSE3,SM2,SB,AR2 + +[PHADDW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \331\3\x0F\x38\x01\110 SSSE3,MMX,SM +xmmreg,xmmrm \361\3\x0F\x38\x01\110 SSSE3,SM + +[PHADDD] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \331\3\x0F\x38\x02\110 SSSE3,MMX,SM +xmmreg,xmmrm \361\3\x0F\x38\x02\110 SSSE3,SM + +[PHADDSW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \331\3\x0F\x38\x03\110 SSSE3,MMX,SM +xmmreg,xmmrm \361\3\x0F\x38\x03\110 SSSE3,SM + +[PHSUBW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \331\3\x0F\x38\x05\110 SSSE3,MMX,SM +xmmreg,xmmrm \361\3\x0F\x38\x05\110 SSSE3,SM + +[PHSUBD] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \331\3\x0F\x38\x06\110 SSSE3,MMX,SM +xmmreg,xmmrm \361\3\x0F\x38\x06\110 SSSE3,SM + +[PHSUBSW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \331\3\x0F\x38\x07\110 SSSE3,MMX,SM +xmmreg,xmmrm \361\3\x0F\x38\x07\110 SSSE3,SM + +[PMADDUBSW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \331\3\x0F\x38\x04\110 SSSE3,MMX,SM +xmmreg,xmmrm \361\3\x0F\x38\x04\110 SSSE3,SM + +[PMULHRSW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \331\3\x0F\x38\x0B\110 SSSE3,MMX,SM +xmmreg,xmmrm \361\3\x0F\x38\x0B\110 SSSE3,SM + +[PSHUFB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \331\3\x0F\x38\x00\110 SSSE3,MMX,SM +xmmreg,xmmrm \361\3\x0F\x38\x00\110 SSSE3,SM + +[PSIGNB] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \331\3\x0F\x38\x08\110 SSSE3,MMX,SM +xmmreg,xmmrm \361\3\x0F\x38\x08\110 SSSE3,SM + +[PSIGNW] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \331\3\x0F\x38\x09\110 SSSE3,MMX,SM +xmmreg,xmmrm \361\3\x0F\x38\x09\110 SSSE3,SM + +[PSIGND] +(Ch_All, Ch_None, Ch_None) +mmxreg,mmxrm \331\3\x0F\x38\x0A\110 SSSE3,MMX,SM +xmmreg,xmmrm \361\3\x0F\x38\x0A\110 SSSE3,SM + +;******************************************************************************* +;**********SSE4.1*************************************************************** +;******************************************************************************* +[BLENDPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \361\3\x0F\x3A\x0C\110\26 SSE41,SM2,SB,AR2 + +[BLENDPD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \361\3\x0F\x3A\x0D\110\26 SSE41,SM2,SB,AR2 + +[BLENDVPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x14\110 SSE41,SM + +[BLENDVPD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x15\110 SSE41,SM + +[DPPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \361\3\x0F\x3A\x40\110\26 SSE41,SM2,SB,AR2 + +[DPPD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \361\3\x0F\x3A\x41\110\26 SSE41,SM2,SB,AR2 + +[EXTRACTPS] +(Ch_All, Ch_None, Ch_None) +mem,xmmreg,imm \361\325\3\x0F\x3A\x17\101\26 SSE41,SB,AR2 +reg32|64,xmmreg,imm \361\3\x0F\x3A\x17\101\26 SSE41,SB,AR2 + +[INSERTPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \361\3\x0F\x3A\x21\110\26 SSE41,SM2,SB,AR2 + +[MOVNTDQA] +(Ch_All, Ch_None, Ch_None) +xmmreg,mem \361\3\x0F\x38\x2A\110 SSE41,SM + +[MPSADBW] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \361\3\x0F\x3A\x42\110\26 SSE41,SM2,SB,AR2 + +[PACKUSDW] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x2B\110 SSE41,SM + +[PBLENDVB] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x10\110 SSE41,SM + +[PBLENDW] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \361\3\x0F\x3A\x0E\110\26 SSE41,SM2,SB,AR2 + +[PCMPEQQ] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x29\110 SSE41,SM + +[PEXTRB] +(Ch_All, Ch_None, Ch_None) +reg32|64,xmmreg,imm \361\3\x0F\x3A\x14\101\26 SSE41,SB,AR2 +mem8,xmmreg,imm \361\3\x0F\x3A\x14\101\26 SSE41,SB,AR2 + +;PEXTRW - Look is prev. implementation + +[PEXTRD] +(Ch_All, Ch_None, Ch_None) +reg32,xmmreg,imm \361\3\x0F\x3A\x16\101\26 SSE41,SB,AR2 +mem32,xmmreg,imm \361\3\x0F\x3A\x16\101\26 SSE41,SB,AR2 + +[PEXTRQ] +(Ch_All, Ch_None, Ch_None) +reg64,xmmreg,imm \361\326\3\x0F\x3A\x16\101\26 SSE41,X86_64,SB,AR2 +mem64,xmmreg,imm \361\326\3\x0F\x3A\x16\101\26 SSE41,X86_64,SB,AR2 + +[PHMINPOSUW] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x41\110 SSE41,SM + +[PINSRB] +(Ch_All, Ch_None, Ch_None) +xmmreg,reg32|64,imm \361\3\x0F\x3A\x20\110\26 SSE41,SB,AR2 +xmmreg,mem8,imm \361\3\x0F\x3A\x20\110\26 SSE41,SB,AR2 + +[PINSRD] +(Ch_All, Ch_None, Ch_None) +xmmreg,reg32,imm \361\3\x0F\x3A\x22\110\26 SSE41,SB,AR2 +xmmreg,mem32,imm \361\3\x0F\x3A\x22\110\26 SSE41,SB,AR2 + +[PINSRQ] +(Ch_All, Ch_None, Ch_None) +xmmreg,reg64,imm \361\326\3\x0F\x3A\x22\110\26 SSE41,X86_64,SB,AR2 +xmmreg,mem64,imm \361\326\3\x0F\x3A\x22\110\26 SSE41,X86_64,SB,AR2 + +[PMAXSB] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x3C\110 SSE41,SM + +[PMAXSD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x3D\110 SSE41,SM + +[PMAXUD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x3F\110 SSE41,SM + +[PMAXUW] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x3E\110 SSE41,SM + +[PMINSB] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x38\110 SSE41,SM + +[PMINSD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x39\110 SSE41,SM + +[PMINUW] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x3A\110 SSE41,SM + +[PMINUD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x3B\110 SSE41,SM + +[PMOVSXBW] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x20\110 SSE41,SM + +[PMOVSXBD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x21\110 SSE41,SM + +[PMOVSXBQ] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x22\110 SSE41,SM + +[PMOVSXWD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x23\110 SSE41,SM + +[PMOVSXWQ] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x24\110 SSE41,SM + +[PMOVSXDQ] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x25\110 SSE41,SM + +[PMOVZXBW] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x30\110 SSE41,SM + +[PMOVZXBD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x31\110 SSE41,SM + +[PMOVZXBQ] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x32\110 SSE41,SM + +[PMOVZXWD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x33\110 SSE41,SM + +[PMOVZXWQ] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x34\110 SSE41,SM + +[PMOVZXDQ] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x35\110 SSE41,SM + +[PMULDQ] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x28\110 SSE41,SM + +[PMULLD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x40\110 SSE41,SM + +[PTEST] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x17\110 SSE41,SM + +[ROUNDPS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \361\3\x0F\x3A\x08\110\26 SSE41,SM2,SB,AR2 + +[ROUNDPD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \361\3\x0F\x3A\x09\110\26 SSE41,SM2,SB,AR2 + +[ROUNDSS] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \361\3\x0F\x3A\x0A\110\26 SSE41,SM2,SB,AR2 + +[ROUNDSD] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \361\3\x0F\x3A\x0B\110\26 SSE41,SM2,SB,AR2 + +;******************************************************************************* +;**********SSE4.2*************************************************************** +;******************************************************************************* + +[CRC32,crc32X] +(Ch_Mop1, Ch_Rop2, Ch_None) +reg32,rm8 \334\3\x0F\x38\xF0\110 SSE42 +reg32,rm16|32 \321\334\3\x0F\x38\xF1\110 SSE42 +reg64,rm8 \334\326\3\x0F\x38\xF0\110 SSE42,X86_64 +reg64,rm64 \334\326\3\x0F\x38\xF1\110 SSE42,X86_64 + +[PCMPESTRI] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \361\3\x0F\x3A\x61\110\26 SSE42,SM2,SB,AR2 + +[PCMPESTRM] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \361\3\x0F\x3A\x60\110\26 SSE42,SM2,SB,AR2 + +[PCMPISTRI] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \361\3\x0F\x3A\x63\110\26 SSE42,SM2,SB,AR2 + +[PCMPISTRM] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \361\3\x0F\x3A\x62\110\26 SSE42,SM2,SB,AR2 + +[PCMPGTQ] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\x37\110 SSE42,SM + +[POPCNT,popcntX] +(Ch_All, Ch_None, Ch_None) +reg16,rm16 \333\320\2\x0F\xB8\110 386,SM,SSE4 +reg32,rm32 \333\320\2\x0F\xB8\110 386,SM,SSE4 +reg64,rm64 \333\320\2\x0F\xB8\110 386,SM,SSE4,X86_64 + +;******************************************************************************* +;**********AES****************************************************************** +;******************************************************************************* +;Use SSE4, but need special flag for AES insructions set + +[AESENC] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\xDC\110 SSE4,SM + +[AESENCLAST] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\xDD\110 SSE4,SM + +[AESDEC] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\xDE\110 SSE4,SM + +[AESDECLAST] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\xDF\110 SSE4,SM + +[AESIMC] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm \361\3\x0F\x38\xDB\110 SSE4,SM + +[AESKEYGENASSIST] +(Ch_All, Ch_None, Ch_None) +xmmreg,xmmrm,imm \361\3\x0F\x3A\xDF\110\26 SSE4,SB,AR2 + +;******************************************************************************* +;******************************************************************************* +;******************************************************************************* +[STOSQ] +(Ch_RRAX, Ch_WMemEDI, Ch_RWRDI) +void \326\1\xAB X86_64 + +[LODSQ] +(Ch_WRAX, Ch_RWRSI, Ch_None) +void \326\1\xAD X86_64 + +[CMPSQ] +(Ch_All, Ch_None, Ch_None) +void \326\1\xA7 X86_64 diff --git a/closures/compiler/x86/x86reg.dat b/closures/compiler/x86/x86reg.dat new file mode 100644 index 0000000000..1ebea360b3 --- /dev/null +++ b/closures/compiler/x86/x86reg.dat @@ -0,0 +1,140 @@ +; +; x86 registers +; +; layout +; <name>,<value>,<stdname>,<attname>,<masmname>,<nasmname>,<stabidx>,<dwarf32idx>,<dwarf64idx>,<ot value>,<opcode value>,[AMD64 specific] +; +; For stab/dwarf numbers see gdb/i386-tdep.c and gdb/amd64-tdep.c +; +NR_NO,$00000000,INVALID,INVALID,INVALID,INVALID,-1,-1,-1,OT_NONE,0 +NR_AL,$01010000,al,%al,al,al,0,0,0,OT_REG_AL,0 +NR_AH,$01020000,ah,%ah,ah,ah,0,0,0,OT_REG8,4 +NR_AX,$01030000,ax,%ax,ax,ax,0,0,0,OT_REG_AX,0 +NR_EAX,$01040000,eax,%eax,eax,eax,0,0,0,OT_REG_EAX,0 +NR_RAX,$01050000,rax,%rax,rax,rax,0,0,0,OT_REG_RAX,0,64 +NR_CL,$01010001,cl,%cl,cl,cl,1,1,2,OT_REG_CL,1 +NR_CH,$01020001,ch,%ch,ch,ch,1,1,2,OT_REG8,5 +NR_CX,$01030001,cx,%cx,cx,cx,1,1,2,OT_REG_CX,1 +NR_ECX,$01040001,ecx,%ecx,ecx,ecx,1,1,2,OT_REG_ECX,1 +NR_RCX,$01050001,rcx,%rcx,rcx,rcx,1,1,2,OT_REG_RCX,1,64 +NR_DL,$01010002,dl,%dl,dl,dl,2,2,1,OT_REG8,2 +NR_DH,$01020002,dh,%dh,dh,dh,2,2,1,OT_REG8,6 +NR_DX,$01030002,dx,%dx,dx,dx,2,2,1,OT_REG_DX,2 +NR_EDX,$01040002,edx,%edx,edx,edx,2,2,1,OT_REG32,2 +NR_RDX,$01050002,rdx,%rdx,rdx,rdx,2,2,1,OT_REG64,2,64 +NR_BL,$01010003,bl,%bl,bl,bl,3,3,3,OT_REG8,3 +NR_BH,$01020003,bh,%bh,bh,bh,3,3,3,OT_REG8,7 +NR_BX,$01030003,bx,%bx,bx,bx,3,3,3,OT_REG16,3 +NR_EBX,$01040003,ebx,%ebx,ebx,ebx,3,3,3,OT_REG32,3 +NR_RBX,$01050003,rbx,%rbx,rbx,rbx,3,3,3,OT_REG64,3,64 +NR_SIL,$01010004,sil,%sil,sil,sil,6,6,4,OT_REG8,6,64 +NR_SI,$01030004,si,%si,si,si,6,6,4,OT_REG16,6 +NR_ESI,$01040004,esi,%esi,esi,esi,6,6,4,OT_REG32,6 +NR_RSI,$01050004,rsi,%rsi,rsi,rsi,6,6,4,OT_REG64,6,64 +NR_DIL,$01010005,dil,%dil,dil,dil,7,7,5,OT_REG8,7,64 +NR_DI,$01030005,di,%di,di,di,7,7,5,OT_REG16,7 +NR_EDI,$01040005,edi,%edi,edi,edi,7,7,5,OT_REG32,7 +NR_RDI,$01050005,rdi,%rdi,rdi,rdi,7,7,5,OT_REG64,7,64 +NR_BPL,$01010006,bpl,%bpl,bpl,bpl,5,5,6,OT_REG8,5,64 +NR_BP,$01030006,bp,%bp,bp,bp,5,5,6,OT_REG16,5 +NR_EBP,$01040006,ebp,%ebp,ebp,ebp,5,5,6,OT_REG32,5 +NR_RBP,$01050006,rbp,%rbp,rbp,rbp,5,5,6,OT_REG64,5,64 +NR_SPL,$01010007,spl,%spl,spl,spl,4,4,7,OT_REG8,4,64 +NR_SP,$01030007,sp,%sp,sp,sp,4,4,7,OT_REG16,4 +NR_ESP,$01040007,esp,%esp,esp,esp,4,4,7,OT_REG32,4 +NR_RSP,$01050007,rsp,%rsp,rsp,rsp,4,4,7,OT_REG64,4,64 +NR_R8,$01050008,r8,%r8,r8,r8,-1,-1,8,OT_REG64,0,64 +NR_R8L,$01010008,r8b,%r8b,r8b,r8b,-1,-1,8,OT_REG8,0,64 +NR_R8W,$01030008,r8w,%r8w,r8w,r8w,-1,-1,8,OT_REG16,0,64 +NR_R8D,$01040008,r8d,%r8d,r8d,r8d,-1,-1,8,OT_REG32,0,64 +NR_R9,$01050009,r9,%r9,r9,r9,-1,-1,9,OT_REG64,1,64 +NR_R9L,$01010009,r9b,%r9b,r9b,r9b,-1,-1,9,OT_REG8,1,64 +NR_R9W,$01030009,r9w,%r9w,r9w,r9w,-1,-1,9,OT_REG16,1,64 +NR_R9D,$01040009,r9d,%r9d,r9d,r9d,-1,-1,9,OT_REG32,1,64 +NR_R10,$0105000a,r10,%r10,r10,r10,-1,-1,10,OT_REG64,2,64 +NR_R10L,$0101000a,r10b,%r10b,r10b,r10b,-1,-1,10,OT_REG8,2,64 +NR_R10W,$0103000a,r10w,%r10w,r10w,r10w,-1,-1,10,OT_REG16,2,64 +NR_R10D,$0104000a,r10d,%r10d,r10d,r10d,-1,-1,10,OT_REG32,2,64 +NR_R11,$0105000b,r11,%r11,r11,r11,-1,-1,11,OT_REG64,3,64 +NR_R11L,$0101000b,r11b,%r11b,r11b,r11b,-1,-1,11,OT_REG8,3,64 +NR_R11W,$0103000b,r11w,%r11w,r11w,r11w,-1,-1,11,OT_REG16,3,64 +NR_R11D,$0104000b,r11d,%r11d,r11d,r11d,-1,-1,11,OT_REG32,3,64 +NR_R12,$0105000c,r12,%r12,r12,r12,-1,-1,12,OT_REG64,4,64 +NR_R12L,$0101000c,r12b,%r12b,r12b,r12b,-1,-1,12,OT_REG8,4,64 +NR_R12W,$0103000c,r12w,%r12w,r12w,r12w,-1,-1,12,OT_REG16,4,64 +NR_R12D,$0104000c,r12d,%r12d,r12d,r12d,-1,-1,12,OT_REG32,4,64 +NR_R13,$0105000d,r13,%r13,r13,r13,-1,-1,13,OT_REG64,5,64 +NR_R13L,$0101000d,r13b,%r13b,r13b,r13b,-1,-1,13,OT_REG8,5,64 +NR_R13W,$0103000d,r13w,%r13w,r13w,r13w,-1,-1,13,OT_REG16,5,64 +NR_R13D,$0104000d,r13d,%r13d,r13d,r13d,-1,-1,13,OT_REG32,5,64 +NR_R14,$0105000e,r14,%r14,r14,r14,-1,-1,14,OT_REG64,6,64 +NR_R14L,$0101000e,r14b,%r14b,r14b,r14b,-1,-1,14,OT_REG8,6,64 +NR_R14W,$0103000e,r14w,%r14w,r14w,r14w,-1,-1,14,OT_REG16,6,64 +NR_R14D,$0104000e,r14d,%r14d,r14d,r14d,-1,-1,14,OT_REG32,6,64 +NR_R15,$0105000f,r15,%r15,r15,r15,-1,-1,15,OT_REG64,7,64 +NR_R15L,$0101000f,r15b,%r15b,r15b,r15b,-1,-1,15,OT_REG8,7,64 +NR_R15W,$0103000f,r15w,%r15w,r15w,r15w,-1,-1,15,OT_REG16,7,64 +NR_R15D,$0104000f,r15d,%r15d,r15d,r15d,-1,-1,15,OT_REG32,7,64 + +; EIP is needed for DWARF call frame info return address (RA) +NR_RIP,$05000000,rip,%rip,rip,rip,-1,8,16,OT_NONE,0,64 +NR_EIP,$05000000,eip,%eip,eip,eip,-1,8,16,OT_NONE,0 +NR_CS,$05000001,cs,%cs,cs,cs,-1,-1,-1,OT_REG_CS,1 +NR_DS,$05000002,ds,%ds,ds,ds,-1,-1,-1,OT_REG_DESS,3 +NR_ES,$05000003,es,%es,es,es,-1,-1,-1,OT_REG_DESS,0 +NR_SS,$05000004,ss,%ss,ss,ss,-1,-1,-1,OT_REG_DESS,2 +NR_FS,$05000005,fs,%fs,fs,fs,-1,-1,-1,OT_REG_FSGS,4 +NR_GS,$05000006,gs,%gs,gs,gs,-1,-1,-1,OT_REG_FSGS,5 + +NR_DR0,$05000007,dr0,%dr0,dr0,dr0,-1,-1,-1,OT_REG_DREG,0 +NR_DR1,$05000008,dr1,%dr1,dr1,dr1,-1,-1,-1,OT_REG_DREG,1 +NR_DR2,$05000009,dr2,%dr2,dr2,dr2,-1,-1,-1,OT_REG_DREG,2 +NR_DR3,$0500000a,dr3,%dr3,dr3,dr3,-1,-1,-1,OT_REG_DREG,3 +NR_DR6,$0500000b,dr6,%dr6,dr6,dr6,-1,-1,-1,OT_REG_DREG,6 +NR_DR7,$0500000c,dr7,%dr7,dr7,dr7,-1,-1,-1,OT_REG_DREG,7 +NR_CR0,$0500000d,cr0,%cr0,cr0,cr0,-1,-1,-1,OT_REG_CREG,0 +NR_CR2,$0500000e,cr2,%cr2,cr2,cr2,-1,-1,-1,OT_REG_CREG,2 +NR_CR3,$0500000f,cr3,%cr3,cr3,cr3,-1,-1,-1,OT_REG_CREG,3 +NR_CR4,$05000010,cr4,%cr4,cr4,cr4,-1,-1,-1,OT_REG_CR4,4 +NR_TR3,$05000011,tr3,%tr3,tr3,tr3,-1,-1,-1,OT_REG_TREG,3 +NR_TR4,$05000012,tr4,%tr4,tr4,tr4,-1,-1,-1,OT_REG_TREG,4 +NR_TR5,$05000013,tr5,%tr5,tr5,tr5,-1,-1,-1,OT_REG_TREG,5 +NR_TR6,$05000014,tr6,%tr6,tr6,tr6,-1,-1,-1,OT_REG_TREG,6 +NR_TR7,$05000015,tr7,%tr7,tr7,tr7,-1,-1,-1,OT_REG_TREG,7 + +NR_ST0,$02000000,st(0),%st(0),st(0),st0,12,11,33,OT_FPU0,0 +NR_ST1,$02000001,st(1),%st(1),st(1),st1,13,12,34,OT_FPUREG,1 +NR_ST2,$02000002,st(2),%st(2),st(2),st2,14,13,35,OT_FPUREG,2 +NR_ST3,$02000003,st(3),%st(3),st(3),st3,15,14,36,OT_FPUREG,3 +NR_ST4,$02000004,st(4),%st(4),st(4),st4,16,15,37,OT_FPUREG,4 +NR_ST5,$02000005,st(5),%st(5),st(5),st5,17,16,38,OT_FPUREG,5 +NR_ST6,$02000006,st(6),%st(6),st(6),st6,18,17,39,OT_FPUREG,6 +NR_ST7,$02000007,st(7),%st(7),st(7),st7,19,18,40,OT_FPUREG,7 +; Special code to that will map to %st(0) +NR_ST,$02000008,st,%st,st,st0,12,11,33,OT_FPU0,0 + +NR_MM0,$03000000,mm0,%mm0,mm0,mm0,29,29,41,OT_MMXREG,0 +NR_MM1,$03000001,mm1,%mm1,mm1,mm1,30,30,42,OT_MMXREG,1 +NR_MM2,$03000002,mm2,%mm2,mm2,mm2,31,31,43,OT_MMXREG,2 +NR_MM3,$03000003,mm3,%mm3,mm3,mm3,32,32,44,OT_MMXREG,3 +NR_MM4,$03000004,mm4,%mm4,mm4,mm4,33,33,45,OT_MMXREG,4 +NR_MM5,$03000005,mm5,%mm5,mm5,mm5,34,34,46,OT_MMXREG,5 +NR_MM6,$03000006,mm6,%mm6,mm6,mm6,35,35,47,OT_MMXREG,6 +NR_MM7,$03000007,mm7,%mm7,mm7,mm7,36,36,48,OT_MMXREG,7 + +NR_XMM0,$04000000,xmm0,%xmm0,xmm0,xmm0,21,21,17,OT_XMMREG,0 +NR_XMM1,$04000001,xmm1,%xmm1,xmm1,xmm1,22,22,18,OT_XMMREG,1 +NR_XMM2,$04000002,xmm2,%xmm2,xmm2,xmm2,23,23,19,OT_XMMREG,2 +NR_XMM3,$04000003,xmm3,%xmm3,xmm3,xmm3,24,24,20,OT_XMMREG,3 +NR_XMM4,$04000004,xmm4,%xmm4,xmm4,xmm4,25,25,21,OT_XMMREG,4 +NR_XMM5,$04000005,xmm5,%xmm5,xmm5,xmm5,26,26,22,OT_XMMREG,5 +NR_XMM6,$04000006,xmm6,%xmm6,xmm6,xmm6,27,27,23,OT_XMMREG,6 +NR_XMM7,$04000007,xmm7,%xmm7,xmm7,xmm7,28,28,24,OT_XMMREG,7 +NR_XMM8,$04000008,xmm8,%xmm8,xmm8,xmm8,-1,-1,25,OT_XMMREG,0,64 +NR_XMM9,$04000009,xmm9,%xmm9,xmm9,xmm9,-1,-1,26,OT_XMMREG,1,64 +NR_XMM10,$0400000a,xmm10,%xmm10,xmm10,xmm10,-1,-1,27,OT_XMMREG,2,64 +NR_XMM11,$0400000b,xmm11,%xmm11,xmm11,xmm11,-1,-1,28,OT_XMMREG,3,64 +NR_XMM12,$0400000c,xmm12,%xmm12,xmm12,xmm12,-1,-1,29,OT_XMMREG,4,64 +NR_XMM13,$0400000d,xmm13,%xmm13,xmm13,xmm13,-1,-1,30,OT_XMMREG,5,64 +NR_XMM14,$0400000e,xmm14,%xmm14,xmm14,xmm14,-1,-1,31,OT_XMMREG,6,64 +NR_XMM15,$0400000f,xmm15,%xmm15,xmm15,xmm15,-1,-1,32,OT_XMMREG,7,64 diff --git a/closures/compiler/x86_64/aoptcpu.pas b/closures/compiler/x86_64/aoptcpu.pas new file mode 100644 index 0000000000..cb656af36e --- /dev/null +++ b/closures/compiler/x86_64/aoptcpu.pas @@ -0,0 +1,41 @@ +{ + Copyright (c) 1998-2004 by Jonas Maebe + + This unit calls the optimization procedures to optimize the assembler + code for sparc + + 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, aoptobj, aoptcpub, aopt; + + Type + TCpuAsmOptimizer = class(TAsmOptimizer) + End; + + Implementation + +begin + casmoptimizer:=TCpuAsmOptimizer; +end. diff --git a/closures/compiler/x86_64/aoptcpub.pas b/closures/compiler/x86_64/aoptcpub.pas new file mode 100644 index 0000000000..de9031add3 --- /dev/null +++ b/closures/compiler/x86_64/aoptcpub.pas @@ -0,0 +1,120 @@ + { + Copyright (c) 1998-2004 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 sparc 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_JMP; + aopt_condjmp = A_Jcc; + +Implementation + +{ ************************************************************************* } +{ **************************** TCondRegs ********************************** } +{ ************************************************************************* } +Constructor TCondRegs.init; +Begin +End; + +Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl} +Begin +End; + +End. diff --git a/closures/compiler/x86_64/aoptcpud.pas b/closures/compiler/x86_64/aoptcpud.pas new file mode 100644 index 0000000000..cb8c5d319f --- /dev/null +++ b/closures/compiler/x86_64/aoptcpud.pas @@ -0,0 +1,36 @@ +{ + Copyright (c) 1998-2004 by Jonas Maebe, member of the Free Pascal + Development Team + + 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. diff --git a/closures/compiler/x86_64/cgcpu.pas b/closures/compiler/x86_64/cgcpu.pas new file mode 100644 index 0000000000..8c20107361 --- /dev/null +++ b/closures/compiler/x86_64/cgcpu.pas @@ -0,0 +1,368 @@ +{ + Copyright (c) 2002 by Florian Klaempfl + + This unit implements the code generator for the x86-64. + + 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 + cgbase,cgutils,cgobj,cgx86, + aasmbase,aasmtai,aasmdata,aasmcpu, + cpubase,cpuinfo,cpupara,parabase, + symdef, + node,symconst,rgx86,procinfo; + + type + tcgx86_64 = class(tcgx86) + procedure init_register_allocators;override; + + procedure g_proc_entry(list : TAsmList; parasize:longint; nostackframe:boolean);override; + procedure g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean);override; + procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override; + procedure g_local_unwind(list: TAsmList; l: TAsmLabel);override; + + procedure a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize : tcgsize;intreg, mmreg: tregister; shuffle: pmmshuffle); override; + procedure a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize : tcgsize;mmreg, intreg: tregister;shuffle : pmmshuffle); override; + end; + + procedure create_codegen; + + implementation + + uses + globtype,globals,verbose,systems,cutils,cclasses, + symsym,defutil,paramgr,fmodule,cpupi, + rgobj,tgobj,rgcpu; + + + procedure Tcgx86_64.init_register_allocators; + const + win64_saved_std_regs : array[0..6] of tsuperregister = (RS_RBX,RS_RDI,RS_RSI,RS_R12,RS_R13,RS_R14,RS_R15); + others_saved_std_regs : array[0..4] of tsuperregister = (RS_RBX,RS_R12,RS_R13,RS_R14,RS_R15); + saved_regs_length : array[boolean] of longint = (5,7); + + win64_saved_xmm_regs : array[0..9] of tsuperregister = (RS_XMM6,RS_XMM7, + RS_XMM8,RS_XMM9,RS_XMM10,RS_XMM11,RS_XMM12,RS_XMM13,RS_XMM14,RS_XMM15); + var + i : longint; + framepointer : tsuperregister; + begin + inherited init_register_allocators; + + if (length(saved_standard_registers)<>saved_regs_length[target_info.system=system_x86_64_win64]) then + begin + if target_info.system=system_x86_64_win64 then + begin + SetLength(saved_standard_registers,Length(win64_saved_std_regs)); + SetLength(saved_mm_registers,Length(win64_saved_xmm_regs)); + + for i:=low(win64_saved_std_regs) to high(win64_saved_std_regs) do + saved_standard_registers[i]:=win64_saved_std_regs[i]; + + for i:=low(win64_saved_xmm_regs) to high(win64_saved_xmm_regs) do + saved_mm_registers[i]:=win64_saved_xmm_regs[i]; + end + else + begin + SetLength(saved_standard_registers,Length(others_saved_std_regs)); + SetLength(saved_mm_registers,0); + + for i:=low(others_saved_std_regs) to high(others_saved_std_regs) do + saved_standard_registers[i]:=others_saved_std_regs[i]; + end; + end; + if assigned(current_procinfo) then + framepointer:=getsupreg(current_procinfo.framepointer) + else + { in intf. wrapper code generation } + framepointer:=RS_FRAME_POINTER_REG; + if target_info.system=system_x86_64_win64 then + rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_RAX,RS_RDX,RS_RCX,RS_R8,RS_R9,RS_R10, + RS_R11,RS_RBX,RS_RSI,RS_RDI,RS_R12,RS_R13,RS_R14,RS_R15],first_int_imreg,[framepointer]) + else + rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE,[RS_RAX,RS_RDX,RS_RCX,RS_RSI,RS_RDI,RS_R8, + RS_R9,RS_R10,RS_R11,RS_RBX,RS_R12,RS_R13,RS_R14,RS_R15],first_int_imreg,[framepointer]); + + rg[R_MMREGISTER]:=trgcpu.create(R_MMREGISTER,R_SUBWHOLE,[RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7, + RS_XMM8,RS_XMM9,RS_XMM10,RS_XMM11,RS_XMM12,RS_XMM13,RS_XMM14,RS_XMM15],first_mm_imreg,[]); + rgfpu:=Trgx86fpu.create; + end; + + + procedure tcgx86_64.g_proc_entry(list : TAsmList;parasize:longint;nostackframe:boolean); + var + hitem: tlinkedlistitem; + r: integer; + href: treference; + templist: TAsmList; + frame_offset: longint; + suppress_endprologue: boolean; + begin + hitem:=list.last; + { pi_has_unwind_info may already be set at this point if there are + SEH directives in assembler body. In this case, .seh_endprologue + is expected to be one of those directives, and not generated here. } + suppress_endprologue:=(pi_has_unwind_info in current_procinfo.flags); + inherited g_proc_entry(list,parasize,nostackframe); + + if not (pi_has_unwind_info in current_procinfo.flags) then + exit; + { Generate unwind data for x86_64-win64 } + list.insertafter(cai_seh_directive.create_name(ash_proc,current_procinfo.procdef.mangledname),hitem); + templist:=TAsmList.Create; + + { We need to record postive offsets from RSP; if registers are saved + at negative offsets from RBP we need to account for it. } + if current_procinfo.framepointer=NR_FRAME_POINTER_REG then + frame_offset:=current_procinfo.final_localsize + else + frame_offset:=0; + + { There's no need to describe position of register saves precisely; + since registers are not modified before they are saved, and saves do not + change RSP, 'logically' all saves can happen at the end of prologue. } + 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 + templist.concat(cai_seh_directive.create_reg_offset(ash_savereg, + newreg(R_INTREGISTER,saved_standard_registers[r],R_SUBWHOLE), + href.offset+frame_offset)); + inc(href.offset,sizeof(aint)); + end; + if uses_registers(R_MMREGISTER) then + begin + if (href.offset mod tcgsize2size[OS_VECTOR])<>0 then + inc(href.offset,tcgsize2size[OS_VECTOR]-(href.offset mod tcgsize2size[OS_VECTOR])); + + for r:=low(saved_mm_registers) to high(saved_mm_registers) do + begin + if saved_mm_registers[r] in rg[R_MMREGISTER].used_in_proc then + begin + templist.concat(cai_seh_directive.create_reg_offset(ash_savexmm, + newreg(R_MMREGISTER,saved_mm_registers[r],R_SUBNONE), + href.offset+frame_offset)); + inc(href.offset,tcgsize2size[OS_VECTOR]); + end; + end; + end; + if not suppress_endprologue then + templist.concat(cai_seh_directive.create(ash_endprologue)); + if assigned(current_procinfo.endprologue_ai) then + current_procinfo.aktproccode.insertlistafter(current_procinfo.endprologue_ai,templist) + else + list.concatlist(templist); + templist.free; + end; + + + procedure tcgx86_64.g_proc_exit(list : TAsmList;parasize:longint;nostackframe:boolean); + var + href : treference; + begin + { Release PIC register } + if cs_create_pic in current_settings.moduleswitches then + list.concat(tai_regalloc.dealloc(NR_PIC_OFFSET_REG,nil)); + + { Prevent return address from a possible call from ending up in the epilogue } + { (restoring registers happens before epilogue, providing necessary padding) } + if (current_procinfo.flags*[pi_has_unwind_info,pi_do_call,pi_has_saved_regs])=[pi_has_unwind_info,pi_do_call] then + list.concat(Taicpu.op_none(A_NOP)); + { remove stackframe } + if not nostackframe then + begin + if (current_procinfo.framepointer=NR_STACK_POINTER_REG) or + (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then + begin + if (current_procinfo.final_localsize<>0) then + cg.a_op_const_reg(list,OP_ADD,OS_ADDR,current_procinfo.final_localsize,NR_STACK_POINTER_REG); + if (current_procinfo.procdef.proctypeoption=potype_exceptfilter) then + list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[OS_ADDR],NR_FRAME_POINTER_REG)); + end + else if (target_info.system=system_x86_64_win64) then + begin + { Comply with Win64 unwinding mechanism, which only recognizes + 'add $constant,%rsp' and 'lea offset(FPREG),%rsp' as belonging to + the function epilog. + Neither 'leave' nor even 'mov %FPREG,%rsp' are allowed. } + reference_reset_base(href,current_procinfo.framepointer,0,sizeof(pint)); + list.concat(Taicpu.op_ref_reg(A_LEA,tcgsize2opsize[OS_ADDR],href,NR_STACK_POINTER_REG)); + list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[OS_ADDR],current_procinfo.framepointer)); + end + else + list.concat(Taicpu.op_none(A_LEAVE,S_NO)); + list.concat(tai_regalloc.dealloc(NR_FRAME_POINTER_REG,nil)); + end; + + list.concat(Taicpu.Op_none(A_RET,S_NO)); + if (pi_has_unwind_info in current_procinfo.flags) then + begin + tx86_64procinfo(current_procinfo).dump_scopes(list); + list.concat(cai_seh_directive.create(ash_endproc)); + end; + end; + + + procedure tcgx86_64.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); + var + make_global : boolean; + href : treference; + sym : tasmsymbol; + r : treference; + begin + if not(procdef.proctypeoption in [potype_function,potype_procedure]) then + Internalerror(200006137); + if not assigned(procdef.struct) 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 create_smartlink 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); + + if (po_virtualmethod in procdef.procoptions) and + not is_objectpascal_helper(procdef.struct) then + begin + if (procdef.extnumber=$ffff) then + Internalerror(200006139); + { load vmt from first paramter } + { win64 uses a different abi } + if target_info.system=system_x86_64_win64 then + reference_reset_base(href,NR_RCX,0,sizeof(pint)) + else + reference_reset_base(href,NR_RDI,0,sizeof(pint)); + cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_RAX); + { jmp *vmtoffs(%eax) ; method offs } + reference_reset_base(href,NR_RAX,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),sizeof(pint)); + list.concat(taicpu.op_ref_reg(A_MOV,S_Q,href,NR_RAX)); + list.concat(taicpu.op_reg(A_JMP,S_Q,NR_RAX)); + end + else + begin + sym:=current_asmdata.RefAsmSymbol(procdef.mangledname); + reference_reset_symbol(r,sym,0,sizeof(pint)); + if (cs_create_pic in current_settings.moduleswitches) and + { darwin/x86_64's assembler doesn't want @PLT after call symbols } + (target_info.system<>system_x86_64_darwin) then + r.refaddr:=addr_pic + else + r.refaddr:=addr_full; + + list.concat(taicpu.op_ref(A_JMP,S_NO,r)); + end; + + List.concat(Tai_symbol_end.Createname(labelname)); + end; + + procedure tcgx86_64.g_local_unwind(list: TAsmList; l: TAsmLabel); + var + para1,para2: tcgpara; + href:treference; + begin + if (target_info.system<>system_x86_64_win64) then + begin + inherited g_local_unwind(list,l); + exit; + end; + para1.init; + para2.init; + paramanager.getintparaloc(pocall_default,1,para1); + paramanager.getintparaloc(pocall_default,2,para2); + reference_reset_symbol(href,l,0,1); + { TODO: using RSP is correct only while the stack is fixed!! + (true now, but will change if/when allocating from stack is implemented) } + a_load_reg_cgpara(list,OS_ADDR,NR_STACK_POINTER_REG,para1); + a_loadaddr_ref_cgpara(list,href,para2); + paramanager.freecgpara(list,para2); + paramanager.freecgpara(list,para1); + g_call(current_asmdata.CurrAsmList,'_FPC_local_unwind'); + para2.done; + para1.done; + end; + + procedure tcgx86_64.a_loadmm_intreg_reg(list: TAsmList; fromsize, tosize : tcgsize; intreg, mmreg: tregister; shuffle: pmmshuffle); + var + opc: tasmop; + begin + { this code can only be used to transfer raw data, not to perform + conversions } + if (tcgsize2size[fromsize]<>tcgsize2size[tosize]) or + not(tosize in [OS_F32,OS_F64,OS_M64]) then + internalerror(2009112505); + case fromsize of + OS_32,OS_S32: + opc:=A_MOVD; + OS_64,OS_S64: + opc:=A_MOVQ; + else + internalerror(2009112506); + end; + if assigned(shuffle) and + not shufflescalar(shuffle) then + internalerror(2009112517); + list.concat(taicpu.op_reg_reg(opc,S_NO,intreg,mmreg)); + end; + + + procedure tcgx86_64.a_loadmm_reg_intreg(list: TAsmList; fromsize, tosize : tcgsize; mmreg, intreg: tregister;shuffle : pmmshuffle); + var + opc: tasmop; + begin + { this code can only be used to transfer raw data, not to perform + conversions } + if (tcgsize2size[fromsize]<>tcgsize2size[tosize]) or + not (fromsize in [OS_F32,OS_F64,OS_M64]) then + internalerror(2009112507); + case tosize of + OS_32,OS_S32: + opc:=A_MOVD; + OS_64,OS_S64: + opc:=A_MOVQ; + else + internalerror(2009112408); + end; + if assigned(shuffle) and + not shufflescalar(shuffle) then + internalerror(2009112515); + list.concat(taicpu.op_reg_reg(opc,S_NO,mmreg,intreg)); + end; + + + procedure create_codegen; + begin + cg:=tcgx86_64.create; + end; + +end. diff --git a/closures/compiler/x86_64/cpubase.inc b/closures/compiler/x86_64/cpubase.inc new file mode 100644 index 0000000000..5ad43262b3 --- /dev/null +++ b/closures/compiler/x86_64/cpubase.inc @@ -0,0 +1,134 @@ +{ + Copyright (c) 1998-2000 by Florian Klaempfl and Peter Vreman + + Contains the basic declarations for the x86-64 architecture + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +{ This include file contains the basic declarations for the x86-64 architecture. +} + +{***************************************************************************** + Operand Sizes +*****************************************************************************} + +type + topsize = (S_NO, + S_B,S_W,S_L,S_Q,S_BW,S_BL,S_WL,S_BQ,S_WQ,S_LQ, + S_IS,S_IL,S_IQ, + S_FS,S_FL,S_FX,S_FV,S_FXX, + S_MD, + S_NEAR,S_FAR,S_SHORT, + S_T, + S_XMM + ); + +{***************************************************************************** + Registers +*****************************************************************************} + +const + { Standard opcode string table (for each tasmop enumeration). The + opcode strings should conform to the names as defined by the + processor manufacturer. + } + std_op2str:op2strtable={$i x8664int.inc} + +{***************************************************************************** + GDB Information +*****************************************************************************} + + {# Register indexes for stabs information, when some + parameters or variables are stored in registers. + + Taken from i386.c (dbx_register_map) and i386.h + (FIXED_REGISTERS) from GCC 3.x source code + + } + stab_regindex : array[tregisterindex] of shortint = ( + {$i r8664stab.inc} + ); + +{***************************************************************************** + 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; + OS_SINT = OS_S64; + { the maximum float size for a processor, } + OS_FLOAT = OS_F80; + { the size of a vector register for a processor } + OS_VECTOR = OS_M128; + +{***************************************************************************** + Generic Register names +*****************************************************************************} + + {# Stack pointer register } + RS_STACK_POINTER_REG = RS_RSP; + NR_STACK_POINTER_REG = NR_RSP; + {# Frame pointer register } + RS_FRAME_POINTER_REG = RS_RBP; + NR_FRAME_POINTER_REG = NR_RBP; + { Return address for DWARF } + NR_RETURN_ADDRESS_REG = NR_EIP; + { 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_RBX; + { Results are returned in this register (both 32 and 64 bits } + NR_FUNCTION_RETURN_REG = NR_RAX; + RS_FUNCTION_RETURN_REG = RS_RAX; + NR_FUNCTION_RETURN_REG_HIGH = NR_RDX; + RS_FUNCTION_RETURN_REG_HIGH = RS_RDX; + { 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; + NR_FUNCTION_RESULT_REG_HIGH = NR_FUNCTION_RETURN_REG_HIGH; + RS_FUNCTION_RESULT_REG_HIGH = RS_FUNCTION_RETURN_REG_HIGH; + + { WARNING: don't change to R_ST0!! See comments above implementation of } + { a_loadfpu* methods in rgcpu (JM) } + NR_FPU_RESULT_REG = NR_ST; + NR_MM_RESULT_REG = NR_XMM0; + RS_MM_RESULT_REG = RS_XMM0; + NR_MM_RESULT_REG_HIGH = NR_XMM1; + RS_MM_RESULT_REG_HIGH = RS_XMM1; + + { Offset where the parent framepointer is pushed } + PARENT_FRAMEPOINTER_OFFSET = 16; + +{***************************************************************************** + GCC /ABI linking information +*****************************************************************************} + + const + { these arrays differ between unix and win64 } + saved_standard_registers : array of tsuperregister = nil; + saved_mm_registers : array of tsuperregister = nil; + { 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; diff --git a/closures/compiler/x86_64/cpuinfo.pas b/closures/compiler/x86_64/cpuinfo.pas new file mode 100644 index 0000000000..3b44c3c906 --- /dev/null +++ b/closures/compiler/x86_64/cpuinfo.pas @@ -0,0 +1,103 @@ +{ + Copyright (c) 1998-2000 by Florian Klaempfl + + Basic Processor information + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +Unit cpuinfo; + +{$i fpcdefs.inc} + +Interface + + uses + globtype; + +Type + bestreal = extended; + ts32real = single; + ts64real = double; + ts80real = extended; + ts128real = type extended; + ts64comp = type extended; + + pbestreal=^bestreal; + + tcputype = + (cpu_none, + cpu_athlon64 + ); + + tfputype = + (fpu_none, +// fpu_soft, { generic } + fpu_sse64, + fpu_sse3 + ); + +Const + { Size of native extended type } + extended_size = 10; + { Size of a multimedia register } + mmreg_size = 16; + { target cpu string (used by compiler options) } + target_cpu_string = 'x86_64'; + + { calling conventions supported by the code generator } + supported_calling_conventions : tproccalloptions = [ + pocall_internproc, +{ pocall_compilerproc, + pocall_inline,} + pocall_register, + pocall_safecall, + pocall_stdcall, + pocall_cdecl, + pocall_cppdecl, + pocall_mwpascal + ]; + + cputypestr : array[tcputype] of string[10] = ('', + 'ATHLON64' + ); + + fputypestr : array[tfputype] of string[6] = ('', +// 'SOFT', + 'SSE64', + 'SSE3' + ); + + sse_singlescalar : set of tfputype = [fpu_sse64,fpu_sse3]; + sse_doublescalar : set of tfputype = [fpu_sse64,fpu_sse3]; + + { Supported optimizations, only used for information } + supported_optimizerswitches = genericlevel1optimizerswitches+ + genericlevel2optimizerswitches+ + genericlevel3optimizerswitches- + { no need to write info about those } + [cs_opt_level1,cs_opt_level2,cs_opt_level3]+ + [cs_opt_regvar,cs_opt_loopunroll,cs_opt_stackframe, + cs_opt_tailrecursion,cs_opt_nodecse]; + + level1optimizerswitches = genericlevel1optimizerswitches; + level2optimizerswitches = genericlevel2optimizerswitches + level1optimizerswitches + + [cs_opt_regvar,cs_opt_stackframe,cs_opt_tailrecursion,cs_opt_nodecse]; + level3optimizerswitches = genericlevel3optimizerswitches + level2optimizerswitches + [{,cs_opt_loopunroll}]; + +Implementation + +end. diff --git a/closures/compiler/x86_64/cpunode.pas b/closures/compiler/x86_64/cpunode.pas new file mode 100644 index 0000000000..4567381f6e --- /dev/null +++ b/closures/compiler/x86_64/cpunode.pas @@ -0,0 +1,63 @@ +{ + Copyright (c) 2000 by Florian Klaempfl + + Includes the x86-64 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 is a helper unit to include the necessary code generator units + for the x86-64 processor. +} +unit cpunode; + +{$i fpcdefs.inc} + + interface + + implementation + + uses + { generic nodes } + ncgbas, + ncgld, + ncgflw, + ncgcnv, + ncgmem, + ncgmat, + ncgcon, + ncgcal, + ncgset, + ncgopt, + ncgobjc, + // n386con,n386flw,n386mat,n386mem, + // n386set,n386inl,n386opt, + { the cpu specific node units must be used after the generic ones to + get the correct class pointer } + nx86set, + nx86con, + nx86mem, + nx64add, + nx64cal, + nx64cnv, + nx64mat, +{$ifdef TEST_WIN64_SEH} + nx64flw, +{$endif TEST_WIN64_SEH} + nx64inl + ; + +end. diff --git a/closures/compiler/x86_64/cpupara.pas b/closures/compiler/x86_64/cpupara.pas new file mode 100644 index 0000000000..bf785edcfa --- /dev/null +++ b/closures/compiler/x86_64/cpupara.pas @@ -0,0 +1,1251 @@ +{ + Copyright (c) 2002 by Florian Klaempfl + + Generates the argument location information for x86-64 target + + 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 cpupara; + +{$i fpcdefs.inc} + + interface + + uses + globtype, + cpubase,cgbase,cgutils, + symconst,symtype,symsym,symdef, + aasmtai,aasmdata, + parabase,paramgr; + + type + tx86_64paramanager = class(tparamanager) + private + procedure create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); + procedure create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;paras:tparalist; + var intparareg,mmparareg,parasize:longint;varargsparas: boolean); + public + function param_use_paraloc(const cgpara:tcgpara):boolean;override; + function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override; + function ret_in_param(def : tdef;calloption : tproccalloption) : boolean;override; + procedure getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara);override; + function get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset;override; + function get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset;override; + function get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset;override; + function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override; + function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint;override; + function get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara;override; + end; + + implementation + + uses + cutils,verbose, + systems, + defutil, + symtable; + + const + paraintsupregs : array[0..5] of tsuperregister = (RS_RDI,RS_RSI,RS_RDX,RS_RCX,RS_R8,RS_R9); + parammsupregs : array[0..7] of tsuperregister = (RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3,RS_XMM4,RS_XMM5,RS_XMM6,RS_XMM7); + + paraintsupregs_winx64 : array[0..3] of tsuperregister = (RS_RCX,RS_RDX,RS_R8,RS_R9); + parammsupregs_winx64 : array[0..3] of tsuperregister = (RS_XMM0,RS_XMM1,RS_XMM2,RS_XMM3); + +{ + The argument classification code largely comes from libffi: + + ffi64.c - Copyright (c) 2002, 2007 Bo Thorsen <bo@suse.de> + Copyright (c) 2008 Red Hat, Inc. + + x86-64 Foreign Function Interface + + Permission is hereby granted, free of charge, to any person obtaining + a copy of this software and associated documentation files (the + ``Software''), to deal in the Software without restriction, including + without limitation the rights to use, copy, modify, merge, publish, + distribute, sublicense, and/or sell copies of the Software, and to + permit persons to whom the Software is furnished to do so, subject to + the following conditions: + + The above copyright notice and this permission notice shall be included + in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED ``AS IS'', WITHOUT WARRANTY OF ANY KIND, + EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF + MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND + NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT + HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, + WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, + OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER + DEALINGS IN THE SOFTWARE. + ----------------------------------------------------------------------- *) +} + + const + MAX_PARA_CLASSES = 4; + + type + tx64paraclass = ( + X86_64_NO_CLASS, + X86_64_INTEGER_CLASS,X86_64_INTEGERSI_CLASS, + X86_64_SSE_CLASS,X86_64_SSESF_CLASS,X86_64_SSEDF_CLASS,X86_64_SSEUP_CLASS, + X86_64_X87_CLASS,X86_64_X87UP_CLASS, + X86_64_COMPLEX_X87_CLASS, + X86_64_MEMORY_CLASS + ); + tx64paraclasses = array[0..MAX_PARA_CLASSES-1] of tx64paraclass; + + { Win64-specific helper } + function aggregate_in_registers_win64(varspez:tvarspez;size:longint):boolean; + begin + { TODO: Temporary hack: vs_const parameters are always passed by reference for win64} + result:=(varspez=vs_value) and (size in [1,2,4,8]) + end; + + (* x86-64 register passing implementation. See x86-64 ABI for details. Goal + of this code is to classify each 8bytes of incoming argument by the register + class and assign registers accordingly. *) + + (* Return the union class of CLASS1 and CLASS2. + See the x86-64 PS ABI for details. *) + + function merge_classes(class1, class2: tx64paraclass): tx64paraclass; + begin + (* Rule #1: If both classes are equal, this is the resulting class. *) + if (class1=class2) then + exit(class1); + + (* Rule #2: If one of the classes is NO_CLASS, the resulting class is + the other class. *) + if (class1=X86_64_NO_CLASS) then + exit(class2); + if (class2=X86_64_NO_CLASS) then + exit(class1); + + (* Rule #3: If one of the classes is MEMORY, the result is MEMORY. *) + if (class1=X86_64_MEMORY_CLASS) or + (class2=X86_64_MEMORY_CLASS) then + exit(X86_64_MEMORY_CLASS); + + (* Rule #4: If one of the classes is INTEGER, the result is INTEGER. *) + { 32 bit } + if ((class1=X86_64_INTEGERSI_CLASS) and + (class2=X86_64_SSESF_CLASS)) or + ((class2=X86_64_INTEGERSI_CLASS) and + (class1=X86_64_SSESF_CLASS)) then + exit(X86_64_INTEGERSI_CLASS); + { 64 bit } + if (class1 in [X86_64_INTEGER_CLASS,X86_64_INTEGERSI_CLASS]) or + (class2 in [X86_64_INTEGER_CLASS,X86_64_INTEGERSI_CLASS]) then + exit(X86_64_INTEGER_CLASS); + + (* Rule #5: If one of the classes is X87, X87UP, or COMPLEX_X87 class, + MEMORY is used. *) + if (class1 in [X86_64_X87_CLASS,X86_64_X87UP_CLASS,X86_64_COMPLEX_X87_CLASS]) or + (class2 in [X86_64_X87_CLASS,X86_64_X87UP_CLASS,X86_64_COMPLEX_X87_CLASS]) then + exit(X86_64_MEMORY_CLASS); + + (* Rule #6: Otherwise class SSE is used. *) + result:=X86_64_SSE_CLASS; + end; + + (* Classify the argument of type TYPE and mode MODE. + CLASSES will be filled by the register class used to pass each word + of the operand. The number of words is returned. In case the parameter + should be passed in memory, 0 is returned. As a special case for zero + sized containers, classes[0] will be NO_CLASS and 1 is returned. + + real_size contains either def.size, or a value derived from + def.bitpackedsize and the field offset denoting the number of bytes + spanned by a bitpacked field + + See the x86-64 PS ABI for details. + *) + function classify_as_integer_argument(real_size: aint; var classes: tx64paraclasses; byte_offset: aint): longint; + var + size: aint; + begin + size:=byte_offset+real_size; + if size<=4 then + classes[0]:=X86_64_INTEGERSI_CLASS + else + classes[0]:=X86_64_INTEGER_CLASS; + if size<=8 then + result:=1 + else + begin + if size<=12 then + classes[1]:=X86_64_INTEGERSI_CLASS + else if (size<=16) then + classes[1]:=X86_64_INTEGER_CLASS + else + internalerror(2010021401); + result:=2; + end + end; + + + function classify_argument(def: tdef; varspez: tvarspez; real_size: aint; var classes: tx64paraclasses; byte_offset: aint): longint; forward; + + function init_aggregate_classification(def: tdef; varspez: tvarspez; out words: longint; out classes: tx64paraclasses): longint; + var + i: longint; + begin + words:=0; + { win64 follows a different convention here } + if (target_info.system=system_x86_64_win64) then + begin + if aggregate_in_registers_win64(varspez,def.size) then + begin + classes[0]:=X86_64_INTEGER_CLASS; + result:=1; + end + else + result:=0; + exit; + end; + + (* If the struct is larger than 32 bytes, pass it on the stack. *) + if def.size > 32 then + exit(0); + + words:=(def.size+7) div 8; + + (* Zero sized arrays or structures are NO_CLASS. We return 0 to + signal memory class, so handle it as special case. *) + if (words=0) then + begin + classes[0]:=X86_64_NO_CLASS; + exit(1); + end; + + { we'll be merging the classes elements with the subclasses + elements, so initialise them first } + for i:=low(classes) to high(classes) do + classes[i]:=X86_64_NO_CLASS; + result:=words; + end; + + + function classify_aggregate_element(def: tdef; varspez: tvarspez; real_size: aint; var classes: tx64paraclasses; new_byte_offset: aint): longint; + var + subclasses: tx64paraclasses; + i, + pos: longint; + begin + result:=classify_argument(def,varspez,real_size,subclasses,new_byte_offset mod 8); + if (result=0) then + exit; + pos:=new_byte_offset div 8; + if result-1+pos>high(classes) then + internalerror(2010053108); + for i:=0 to result-1 do + begin + classes[i+pos] := + merge_classes(subclasses[i],classes[i+pos]); + end; + end; + + + function finalize_aggregate_classification(def: tdef; words: longint; var classes: tx64paraclasses): longint; + var + i: longint; + begin + if (words>2) then + begin + (* When size > 16 bytes, if the first one isn't + X86_64_SSE_CLASS or any other ones aren't + X86_64_SSEUP_CLASS, everything should be passed in + memory. *) + if (classes[0]<>X86_64_SSE_CLASS) then + exit(0); + + for i:=1 to words-1 do + if (classes[i]<>X86_64_SSEUP_CLASS) then + exit(0); + end; + + (* Final merger cleanup. *) + (* The first one must never be X86_64_SSEUP_CLASS or + X86_64_X87UP_CLASS. *) + if (classes[0]=X86_64_SSEUP_CLASS) or + (classes[0]=X86_64_X87UP_CLASS) then + internalerror(2010021402); + for i:=0 to words-1 do + begin + (* If one class is MEMORY, everything should be passed in + memory. *) + if (classes[i]=X86_64_MEMORY_CLASS) then + exit(0); + + (* The X86_64_SSEUP_CLASS should be always preceded by + X86_64_SSE_CLASS or X86_64_SSEUP_CLASS. *) + if (classes[i]=X86_64_SSEUP_CLASS) and + (classes[i-1]<>X86_64_SSE_CLASS) and + (classes[i-1]<>X86_64_SSEUP_CLASS) then + classes[i]:=X86_64_SSE_CLASS; + + (* If X86_64_X87UP_CLASS isn't preceded by X86_64_X87_CLASS, + everything should be passed in memory. *) + if (classes[i]=X86_64_X87UP_CLASS) and + (classes[i-1]<>X86_64_X87_CLASS) then + exit(0); + end; + + { FIXME: in case a record contains empty padding space, e.g. a + "single" field followed by a "double", then we have a problem + because the cgpara helpers cannot figure out that they should + skip 4 bytes after storing the single (LOC_MMREGISTER with size + OS_F32) to memory before storing the double -> for now scale + such locations always up to 64 bits, although this loads/stores + some superfluous data } + { 1) the first part is 32 bit while there is still a second part } + if (classes[1]<>X86_64_NO_CLASS) then + case classes[0] of + X86_64_INTEGERSI_CLASS: + classes[0]:=X86_64_INTEGER_CLASS; + X86_64_SSESF_CLASS: + classes[0]:=X86_64_SSE_CLASS; + end; + { 2) the second part is 32 bit, but the total size is > 12 bytes } + if (def.size>12) then + case classes[1] of + X86_64_INTEGERSI_CLASS: + classes[1]:=X86_64_INTEGER_CLASS; + X86_64_SSESF_CLASS: + classes[1]:=X86_64_SSE_CLASS; + end; + + result:=words; + end; + + + function classify_record(def: tdef; varspez: tvarspez; var classes: tx64paraclasses; byte_offset: aint): longint; + var + vs: tfieldvarsym; + size, + new_byte_offset: aint; + i, + words, + num: longint; + begin + result:=init_aggregate_classification(def,varspez,words,classes); + if (words=0) then + exit; + + (* Merge the fields of the structure. *) + for i:=0 to tabstractrecorddef(def).symtable.symlist.count-1 do + begin + if tsym(tabstractrecorddef(def).symtable.symlist[i]).typ<>fieldvarsym then + continue; + vs:=tfieldvarsym(tabstractrecorddef(def).symtable.symlist[i]); + num:=-1; + if not tabstractrecordsymtable(tabstractrecorddef(def).symtable).is_packed then + begin + new_byte_offset:=byte_offset+vs.fieldoffset; + size:=vs.vardef.size; + end + else + begin + new_byte_offset:=byte_offset+vs.fieldoffset div 8; + if (vs.vardef.typ in [orddef,enumdef]) then + { calculate the number of bytes spanned by + this bitpacked field } + size:=((vs.fieldoffset+vs.vardef.packedbitsize+7) div 8)-(vs.fieldoffset div 8) + else + size:=vs.vardef.size + end; + num:=classify_aggregate_element(vs.vardef,varspez,size,classes,new_byte_offset); + if (num=0) then + exit(0); + end; + + result:=finalize_aggregate_classification(def,words,classes); + end; + + + function classify_normal_array(def: tarraydef; varspez: tvarspez; var classes: tx64paraclasses; byte_offset: aint): longint; + var + i, elecount: aword; + size, + elesize, + new_byte_offset, + bitoffset: aint; + words, + num: longint; + isbitpacked: boolean; + begin + result:=init_aggregate_classification(def,varspez,words,classes); + if (words=0) then + exit; + + isbitpacked:=is_packed_array(def); + if not isbitpacked then + begin + elesize:=def.elesize; + size:=elesize; + end + else + begin + elesize:=def.elepackedbitsize; + bitoffset:=0; + end; + + (* Merge the elements of the array. *) + i:=0; + elecount:=def.elecount; + repeat + if not isbitpacked then + begin + { size does not change } + new_byte_offset:=byte_offset+i*elesize; + end + else + begin + { calculate the number of bytes spanned by this bitpacked + element } + size:=((bitoffset+elesize+7) div 8)-(bitoffset div 8); + new_byte_offset:=byte_offset+(elesize*i) div 8; + { bit offset of next element } + inc(bitoffset,elesize); + end; + num:=classify_aggregate_element(def.elementdef,varspez,size,classes,new_byte_offset); + if (num=0) then + exit(0); + inc(i); + until (i=elecount); + + result:=finalize_aggregate_classification(def,words,classes); + end; + + + function classify_argument(def: tdef; varspez: tvarspez; real_size: aint; var classes: tx64paraclasses; byte_offset: aint): longint; + begin + case def.typ of + orddef, + enumdef, + pointerdef, + classrefdef: + result:=classify_as_integer_argument(real_size,classes,byte_offset); + formaldef: + result:=classify_as_integer_argument(voidpointertype.size,classes,byte_offset); + floatdef: + begin + case tfloatdef(def).floattype of + s32real: + begin + if byte_offset=0 then + classes[0]:=X86_64_SSESF_CLASS + else + { if we have e.g. a record with two successive "single" + fields, we need a 64 bit rather than a 32 bit load } + classes[0]:=X86_64_SSE_CLASS; + result:=1; + end; + s64real: + begin + classes[0]:=X86_64_SSEDF_CLASS; + result:=1; + end; + s80real, + sc80real: + begin + classes[0]:=X86_64_X87_CLASS; + classes[1]:=X86_64_X87UP_CLASS; + result:=2; + end; + s64comp, + s64currency: + begin + classes[0]:=X86_64_INTEGER_CLASS; + result:=1; + end; + s128real: + begin + classes[0]:=X86_64_SSE_CLASS; + classes[1]:=X86_64_SSEUP_CLASS; + result:=2; + end; + else + internalerror(2010060301); + end; + end; + recorddef: + result:=classify_record(def,varspez,classes,byte_offset); + objectdef: + begin + if is_object(def) then + { pass by reference, like ppc and i386 } + result:=0 + else + { all kinds of pointer types: class, objcclass, interface, ... } + result:=classify_as_integer_argument(voidpointertype.size,classes,byte_offset); + end; + setdef: + begin + if is_smallset(def) then + result:=classify_as_integer_argument(def.size,classes,byte_offset) + else + result:=0; + end; + stringdef: + begin + if (tstringdef(def).stringtype in [st_shortstring,st_longstring]) then + result:=0 + else + result:=classify_as_integer_argument(def.size,classes,byte_offset); + end; + arraydef: + begin + { a dynamic array is treated like a pointer } + if is_dynamic_array(def) then + result:=classify_as_integer_argument(voidpointertype.size,classes,byte_offset) + { other special arrays are passed on the stack } + else if is_open_array(def) or + is_array_of_const(def) then + result:=0 + else + { normal array } + result:=classify_normal_array(tarraydef(def),varspez,classes,byte_offset); + end; + { the file record is definitely too big } + filedef: + result:=0; + procvardef: + begin + if (po_methodpointer in tprocvardef(def).procoptions) then + begin + { treat as TMethod record } + def:=search_system_type('TMETHOD').typedef; + result:=classify_argument(def,varspez,def.size,classes,byte_offset); + end + else + { pointer } + result:=classify_as_integer_argument(def.size,classes,byte_offset); + end; + variantdef: + begin + { same as tvardata record } + def:=search_system_type('TVARDATA').typedef; + result:=classify_argument(def,varspez,def.size,classes,byte_offset); + end; + else + internalerror(2010021405); + end; + end; + + + procedure getvalueparaloc(varspez:tvarspez;def:tdef;var loc1,loc2:tx64paraclass); + var + size: aint; + i: longint; + classes: tx64paraclasses; + numclasses: longint; + begin + { init the classes array, because even if classify_argument inits only + one element we copy both to loc1/loc2 in case "1" is returned } + for i:=low(classes) to high(classes) do + classes[i]:=X86_64_NO_CLASS; + { def.size internalerrors for open arrays and dynamic arrays, since + their size cannot be determined at compile-time. + classify_argument does not look at the realsize argument for arrays + cases, but we obviously do have to pass something... } + if is_special_array(def) then + size:=-1 + else + size:=def.size; + numclasses:=classify_argument(def,varspez,size,classes,0); + case numclasses of + 0: + begin + loc1:=X86_64_MEMORY_CLASS; + loc2:=X86_64_NO_CLASS; + end; + 1,2: + begin + { If the class is X87, X87UP or COMPLEX_X87, it is passed in memory } + if classes[0] in [X86_64_X87_CLASS,X86_64_X87UP_CLASS,X86_64_COMPLEX_X87_CLASS] then + classes[0]:=X86_64_MEMORY_CLASS; + if classes[1] in [X86_64_X87_CLASS,X86_64_X87UP_CLASS,X86_64_COMPLEX_X87_CLASS] then + classes[1]:=X86_64_MEMORY_CLASS; + loc1:=classes[0]; + loc2:=classes[1]; + end + else + { 4 can only happen for _m256 vectors, not yet supported } + internalerror(2010021501); + end; + end; + + + function tx86_64paramanager.ret_in_param(def : tdef;calloption : tproccalloption) : boolean; + var + classes: tx64paraclasses; + numclasses: longint; + begin + if (tf_safecall_exceptions in target_info.flags) and + (calloption=pocall_safecall) then + begin + result := true; + exit; + end; + case def.typ of + { for records it depends on their contents and size } + recorddef, + { make sure we handle 'procedure of object' correctly } + procvardef: + begin + numclasses:=classify_argument(def,vs_value,def.size,classes,0); + result:=(numclasses=0); + end; + else + result:=inherited ret_in_param(def,calloption); + end; + end; + + + function tx86_64paramanager.param_use_paraloc(const cgpara:tcgpara):boolean; + var + paraloc : pcgparalocation; + begin + if not assigned(cgpara.location) then + internalerror(200410102); + result:=true; + { All locations are LOC_REFERENCE } + paraloc:=cgpara.location; + while assigned(paraloc) do + begin + if (paraloc^.loc<>LOC_REFERENCE) then + begin + result:=false; + exit; + end; + paraloc:=paraloc^.next; + end; + end; + + + { true if a parameter is too large to copy and only the address is pushed } + function tx86_64paramanager.push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean; + var + classes: tx64paraclasses; + numclasses: longint; + begin + result:=false; + { var,out,constref always require address } + if varspez in [vs_var,vs_out,vs_constref] then + begin + result:=true; + exit; + end; + { Only vs_const, vs_value here } + case def.typ of + formaldef : + result:=true; + recorddef : + begin + { MetroWerks Pascal: const records always passed by reference + (for Mac OS X interfaces) } + if (calloption=pocall_mwpascal) and + (varspez=vs_const) then + result:=true + { Win ABI depends on size to pass it in a register or not } + else if (target_info.system=system_x86_64_win64) then + result:=not aggregate_in_registers_win64(varspez,def.size) + { pass constant parameters that would be passed via memory by + reference for non-cdecl/cppdecl, and make sure that the tmethod + record (size=16) is passed the same way as a complex procvar } + else if ((varspez=vs_const) and + not(calloption in [pocall_cdecl,pocall_cppdecl])) or + (def.size=16) then + begin + numclasses:=classify_argument(def,vs_value,def.size,classes,0); + result:=numclasses=0; + end + else + { SysV ABI always passes it as value parameter } + result:=false; + end; + arraydef : + begin + { cdecl array of const need to be ignored and therefor be puhsed + as value parameter with length 0 } + if ((calloption in [pocall_cdecl,pocall_cppdecl]) and + is_array_of_const(def)) or + is_dynamic_array(def) then + result:=false + else + { pass all arrays by reference to be compatible with C (passing + an array by value (= copying it on the stack) does not exist, + because an array is the same as a pointer there } + result:=true + end; + objectdef : + begin + { don't treat objects like records, because we only know wheter + or not they'll have a VMT after the entire object is parsed + -> if they are used as function result from one of their own + methods, their size can still change after we've determined + whether this function result should be returned by reference or + by value } + if is_object(def) then + result:=true; + end; + variantdef, + stringdef, + procvardef, + setdef : + begin + numclasses:=classify_argument(def,vs_value,def.size,classes,0); + result:=numclasses=0; + end; + end; + end; + + + function tx86_64paramanager.get_volatile_registers_int(calloption : tproccalloption):tcpuregisterset; + begin + if target_info.system=system_x86_64_win64 then + result:=[RS_RAX,RS_RCX,RS_RDX,RS_R8,RS_R9,RS_R10,RS_R11] + else + result:=[RS_RAX,RS_RCX,RS_RDX,RS_RSI,RS_RDI,RS_R8,RS_R9,RS_R10,RS_R11]; + end; + + + function tx86_64paramanager.get_volatile_registers_mm(calloption : tproccalloption):tcpuregisterset; + begin + if target_info.system=system_x86_64_win64 then + result:=[RS_XMM0..RS_XMM5] + else + result:=[RS_XMM0..RS_XMM15]; + end; + + + function tx86_64paramanager.get_volatile_registers_fpu(calloption : tproccalloption):tcpuregisterset; + begin + result:=[RS_ST0..RS_ST7]; + end; + + + procedure tx86_64paramanager.getintparaloc(calloption : tproccalloption; nr : longint;var cgpara:TCGPara); + var + paraloc : pcgparalocation; + begin + cgpara.reset; + cgpara.size:=OS_ADDR; + cgpara.intsize:=sizeof(pint); + cgpara.alignment:=get_para_align(calloption); + paraloc:=cgpara.add_location; + with paraloc^ do + begin + size:=OS_INT; + if target_info.system=system_x86_64_win64 then + begin + if nr<1 then + internalerror(200304303) + else if nr<=high(paraintsupregs_winx64)+1 then + begin + loc:=LOC_REGISTER; + register:=newreg(R_INTREGISTER,paraintsupregs_winx64[nr-1],R_SUBWHOLE); + end + else + begin + loc:=LOC_REFERENCE; + reference.index:=NR_STACK_POINTER_REG; + reference.offset:=(nr-6)*sizeof(aint); + end; + end + else + begin + if nr<1 then + internalerror(200304303) + else if nr<=high(paraintsupregs)+1 then + begin + loc:=LOC_REGISTER; + register:=newreg(R_INTREGISTER,paraintsupregs[nr-1],R_SUBWHOLE); + end + else + begin + loc:=LOC_REFERENCE; + reference.index:=NR_STACK_POINTER_REG; + reference.offset:=(nr-6)*sizeof(aint); + end; + end; + end; + end; + + + procedure tx86_64paramanager.create_funcretloc_info(p : tabstractprocdef; side: tcallercallee); + begin + p.funcretloc[side]:=get_funcretloc(p,side,p.returndef); + end; + + + function tx86_64paramanager.get_funcretloc(p : tabstractprocdef; side: tcallercallee; def: tdef): tcgpara; + const + intretregs: array[0..1] of tregister = (NR_FUNCTION_RETURN_REG,NR_FUNCTION_RETURN_REG_HIGH); + mmretregs: array[0..1] of tregister = (NR_MM_RESULT_REG,NR_MM_RESULT_REG_HIGH); + var + classes: tx64paraclasses; + i, + numclasses: longint; + intretregidx, + mmretregidx: longint; + retcgsize : tcgsize; + paraloc : pcgparalocation; + begin + result.init; + result.alignment:=get_para_align(p.proccalloption); + { void has no location } + if is_void(def) then + begin + paraloc:=result.add_location; + result.size:=OS_NO; + result.intsize:=0; + paraloc^.size:=OS_NO; + paraloc^.loc:=LOC_VOID; + exit; + end; + { Constructors return self instead of a boolean } + if (p.proctypeoption=potype_constructor) then + begin + retcgsize:=OS_ADDR; + result.intsize:=sizeof(pint); + end + else + begin + retcgsize:=def_cgsize(def); + { integer sizes < 32 bit have to be sign/zero extended to 32 bit on + the callee side (caller can expect those bits are valid) } + if (side=calleeside) and + (retcgsize in [OS_8,OS_S8,OS_16,OS_S16]) then + begin + retcgsize:=OS_S32; + result.intsize:=4; + end + else + result.intsize:=def.size; + end; + result.size:=retcgsize; + { Return is passed as var parameter } + if ret_in_param(def,p.proccalloption) then + begin + paraloc:=result.add_location; + paraloc^.loc:=LOC_REFERENCE; + paraloc^.size:=retcgsize; + exit; + end; + + { Return in FPU register? -> don't use classify_argument(), because + currency and comp need special treatment here (they are integer class + when passing as parameter, but LOC_FPUREGISTER as function result) } + if def.typ=floatdef then + begin + paraloc:=result.add_location; + case tfloatdef(def).floattype of + s32real: + begin + paraloc^.loc:=LOC_MMREGISTER; + paraloc^.register:=newreg(R_MMREGISTER,RS_MM_RESULT_REG,R_SUBMMS); + paraloc^.size:=OS_F32; + end; + s64real: + begin + paraloc^.loc:=LOC_MMREGISTER; + paraloc^.register:=newreg(R_MMREGISTER,RS_MM_RESULT_REG,R_SUBMMD); + paraloc^.size:=OS_F64; + end; + { the first two only exist on targets with an x87, on others + they are replace by int64 } + s64currency, + s64comp, + s80real, + sc80real: + begin + paraloc^.loc:=LOC_FPUREGISTER; + paraloc^.register:=NR_FPU_RESULT_REG; + paraloc^.size:=retcgsize; + end; + else + internalerror(200405034); + end; + end + else + { Return in register } + begin + numclasses:=classify_argument(def,vs_value,def.size,classes,0); + { this would mean a memory return } + if (numclasses=0) then + internalerror(2010021502); + { this would mean an _m256 vector (valid, but not yet supported) } + if (numclasses>2) then + internalerror(2010021503); + intretregidx:=0; + mmretregidx:=0; + for i:=0 to numclasses-1 do + begin + paraloc:=result.add_location; + case classes[i] of + X86_64_INTEGERSI_CLASS, + X86_64_INTEGER_CLASS: + begin + paraloc^.loc:=LOC_REGISTER; + paraloc^.register:=intretregs[intretregidx]; + if classes[i]=X86_64_INTEGER_CLASS then + paraloc^.size:=OS_64 + else if result.intsize in [1,2,4] then + paraloc^.size:=retcgsize + else + paraloc^.size:=OS_32; + setsubreg(paraloc^.register,cgsize2subreg(R_INTREGISTER,paraloc^.size)); + inc(intretregidx); + end; + X86_64_SSE_CLASS, + X86_64_SSEUP_CLASS, + X86_64_SSESF_CLASS, + X86_64_SSEDF_CLASS: + begin + paraloc^.loc:=LOC_MMREGISTER; + paraloc^.register:=mmretregs[mmretregidx]; + case classes[i] of + X86_64_SSESF_CLASS: + begin + setsubreg(paraloc^.register,R_SUBMMS); + paraloc^.size:=OS_F32; + end; + X86_64_SSEDF_CLASS: + begin + setsubreg(paraloc^.register,R_SUBMMD); + paraloc^.size:=OS_F64; + end; + else + begin + setsubreg(paraloc^.register,R_SUBMMWHOLE); + paraloc^.size:=OS_M64; + end; + end; + inc(mmretregidx); + end; + X86_64_NO_CLASS: + begin + { empty record/array } + if (i<>0) or + (numclasses<>1) then + internalerror(2010060302); + paraloc^.loc:=LOC_VOID; + end; + else + internalerror(2010021504); + end; + end; + end; + end; + + + procedure tx86_64paramanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee;paras:tparalist; + var intparareg,mmparareg,parasize:longint;varargsparas: boolean); + var + hp : tparavarsym; + paraloc : pcgparalocation; + subreg : tsubregister; + pushaddr : boolean; + paracgsize : tcgsize; + loc : array[1..2] of tx64paraclass; + needintloc, + needmmloc, + paralen, + locidx, + i, + varalign, + paraalign : longint; + begin + paraalign:=get_para_align(p.proccalloption); + { Register parameters are assigned from left to right } + for i:=0 to paras.count-1 do + begin + hp:=tparavarsym(paras[i]); + pushaddr:=push_addr_param(hp.varspez,hp.vardef,p.proccalloption); + if pushaddr then + begin + loc[1]:=X86_64_INTEGER_CLASS; + loc[2]:=X86_64_NO_CLASS; + paracgsize:=OS_ADDR; + paralen:=sizeof(pint); + end + else + begin + getvalueparaloc(hp.varspez,hp.vardef,loc[1],loc[2]); + paralen:=push_size(hp.varspez,hp.vardef,p.proccalloption); + paracgsize:=def_cgsize(hp.vardef); + { integer sizes < 32 bit have to be sign/zero extended to 32 bit + on the caller side } + if (side=callerside) and + (paracgsize in [OS_8,OS_S8,OS_16,OS_S16]) then + begin + paracgsize:=OS_S32; + paralen:=4; + end; + end; + + { cheat for now, we should copy the value to an mm reg as well (FK) } + if varargsparas and + (target_info.system = system_x86_64_win64) and + (hp.vardef.typ = floatdef) then + begin + loc[2]:=X86_64_NO_CLASS; + if paracgsize=OS_F64 then + begin + loc[1]:=X86_64_INTEGER_CLASS; + paracgsize:=OS_64 + end + else + begin + loc[1]:=X86_64_INTEGERSI_CLASS; + paracgsize:=OS_32; + end; + end; + + hp.paraloc[side].reset; + hp.paraloc[side].size:=paracgsize; + hp.paraloc[side].intsize:=paralen; + hp.paraloc[side].Alignment:=paraalign; + if paralen>0 then + begin + { Enough registers free? } + needintloc:=0; + needmmloc:=0; + for locidx:=low(loc) to high(loc) do + case loc[locidx] of + X86_64_INTEGER_CLASS, + X86_64_INTEGERSI_CLASS: + inc(needintloc); + X86_64_SSE_CLASS, + X86_64_SSESF_CLASS, + X86_64_SSEDF_CLASS, + X86_64_SSEUP_CLASS: + inc(needmmloc); + end; + { the "-1" is because we can also use the current register } + if ((target_info.system=system_x86_64_win64) and + ((intparareg+needintloc-1 > high(paraintsupregs_winx64)) or + (mmparareg+needmmloc-1 > high(parammsupregs_winx64)))) or + ((target_info.system<>system_x86_64_win64) and + ((intparareg+needintloc-1 > high(paraintsupregs)) or + (mmparareg+needmmloc-1 > high(parammsupregs)))) then + begin + { If there are no registers available for any + eightbyte of an argument, the whole argument is + passed on the stack. } + loc[low(loc)]:=X86_64_MEMORY_CLASS; + for locidx:=succ(low(loc)) to high(loc) do + loc[locidx]:=X86_64_NO_CLASS; + end; + + locidx:=1; + while (paralen>0) do + begin + if locidx>2 then + internalerror(200501283); + { Allocate } + case loc[locidx] of + X86_64_INTEGER_CLASS, + X86_64_INTEGERSI_CLASS: + begin + paraloc:=hp.paraloc[side].add_location; + paraloc^.loc:=LOC_REGISTER; + if (paracgsize=OS_NO) or (loc[2]<>X86_64_NO_CLASS) then + begin + if loc[locidx]=X86_64_INTEGER_CLASS then + begin + paraloc^.size:=OS_INT; + subreg:=R_SUBWHOLE; + end + else + begin + paraloc^.size:=OS_32; + subreg:=R_SUBD; + end; + end + else + begin + paraloc^.size:=paracgsize; + { s64comp is pushed in an int register } + if paraloc^.size=OS_C64 then + paraloc^.size:=OS_64; + subreg:=cgsize2subreg(R_INTREGISTER,paraloc^.size); + end; + + { winx64 uses different registers } + if target_info.system=system_x86_64_win64 then + paraloc^.register:=newreg(R_INTREGISTER,paraintsupregs_winx64[intparareg],subreg) + else + paraloc^.register:=newreg(R_INTREGISTER,paraintsupregs[intparareg],subreg); + + { matching mm register must be skipped } + if target_info.system=system_x86_64_win64 then + inc(mmparareg); + + inc(intparareg); + dec(paralen,tcgsize2size[paraloc^.size]); + end; + X86_64_SSE_CLASS, + X86_64_SSESF_CLASS, + X86_64_SSEDF_CLASS, + X86_64_SSEUP_CLASS: + begin + paraloc:=hp.paraloc[side].add_location; + paraloc^.loc:=LOC_MMREGISTER; + + case loc[locidx] of + X86_64_SSESF_CLASS: + begin + subreg:=R_SUBMMS; + paraloc^.size:=OS_F32; + end; + X86_64_SSEDF_CLASS: + begin + subreg:=R_SUBMMD; + paraloc^.size:=OS_F64; + end; + else + begin + subreg:=R_SUBMMWHOLE; + paraloc^.size:=OS_M64; + end; + end; + + { winx64 uses different registers } + if target_info.system=system_x86_64_win64 then + paraloc^.register:=newreg(R_MMREGISTER,parammsupregs_winx64[mmparareg],subreg) + else + paraloc^.register:=newreg(R_MMREGISTER,parammsupregs[mmparareg],subreg); + + { matching int register must be skipped } + if target_info.system=system_x86_64_win64 then + inc(intparareg); + + inc(mmparareg); + dec(paralen,tcgsize2size[paraloc^.size]); + end; + X86_64_MEMORY_CLASS : + begin + paraloc:=hp.paraloc[side].add_location; + paraloc^.loc:=LOC_REFERENCE; + {Hack alert!!! We should modify int_cgsize to handle OS_128, + however, since int_cgsize is called in many places in the + compiler where only a few can already handle OS_128, fixing it + properly is out of the question to release 2.2.0 in time. (DM)} + if paracgsize=OS_128 then + if paralen=8 then + paraloc^.size:=OS_64 + else if paralen=16 then + paraloc^.size:=OS_128 + else + internalerror(200707143) + else if paracgsize in [OS_F32,OS_F64,OS_F80,OS_F128] then + paraloc^.size:=int_float_cgsize(paralen) + else + paraloc^.size:=int_cgsize(paralen); + if side=callerside then + paraloc^.reference.index:=NR_STACK_POINTER_REG + else + paraloc^.reference.index:=NR_FRAME_POINTER_REG; + varalign:=used_align(size_2_align(paralen),paraalign,paraalign); + paraloc^.reference.offset:=parasize; + parasize:=align(parasize+paralen,varalign); + paralen:=0; + end; + else + internalerror(2010053113); + end; + if (locidx<2) and + (loc[locidx+1]<>X86_64_NO_CLASS) then + inc(locidx); + end; + end + else + begin + paraloc:=hp.paraloc[side].add_location; + paraloc^.loc:=LOC_VOID; + end; + end; + { Register parameters are assigned from left-to-right, but the + offsets on the stack are right-to-left. There is no need + to reverse the offset, only adapt the calleeside with the + start offset of the first param on the stack } + if side=calleeside then + begin + for i:=0 to paras.count-1 do + begin + hp:=tparavarsym(paras[i]); + paraloc:=hp.paraloc[side].location; + while paraloc<>nil do + begin + with paraloc^ do + if (loc=LOC_REFERENCE) then + inc(reference.offset,target_info.first_parm_offset); + paraloc:=paraloc^.next; + end; + end; + end; + end; + + + function tx86_64paramanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint; + var + intparareg,mmparareg, + parasize : longint; + begin + intparareg:=0; + mmparareg:=0; + if target_info.system=system_x86_64_win64 then + parasize:=4*8 + else + parasize:=0; + { calculate the registers for the normal parameters } + create_paraloc_info_intern(p,callerside,p.paras,intparareg,mmparareg,parasize,false); + { append the varargs } + create_paraloc_info_intern(p,callerside,varargspara,intparareg,mmparareg,parasize,true); + { store used no. of SSE registers, that needs to be passed in %AL } + varargspara.mmregsused:=mmparareg; + result:=parasize; + end; + + + function tx86_64paramanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint; + var + intparareg,mmparareg, + parasize : longint; + begin + intparareg:=0; + mmparareg:=0; + if target_info.system=system_x86_64_win64 then + parasize:=4*8 + else + parasize:=0; + create_paraloc_info_intern(p,side,p.paras,intparareg,mmparareg,parasize,false); + { Create Function result paraloc } + create_funcretloc_info(p,side); + { We need to return the size allocated on the stack } + result:=parasize; + end; + + +begin + paramanager:=tx86_64paramanager.create; +end. diff --git a/closures/compiler/x86_64/cpupi.pas b/closures/compiler/x86_64/cpupi.pas new file mode 100644 index 0000000000..b259f9647f --- /dev/null +++ b/closures/compiler/x86_64/cpupi.pas @@ -0,0 +1,166 @@ +{ + Copyright (c) 2002-2006 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 + psub,procinfo,aasmbase,aasmdata; + + type + tx86_64procinfo = class(tcgprocinfo) + private + scopes: TAsmList; + scopecount: longint; + unwindflags: byte; + public + procedure set_first_temp_offset;override; + procedure generate_parameter_info;override; + function calc_stackframe_size:longint;override; + procedure add_finally_scope(startlabel,endlabel,handler:TAsmSymbol;implicit:Boolean); + procedure add_except_scope(trylabel,exceptlabel,endlabel,filter:TAsmSymbol); + procedure dump_scopes(list:TAsmList); + destructor destroy;override; + end; + + +implementation + + uses + systems, + globtype, + globals, + cutils, + symconst, + aasmtai, + tgobj; + + const + SCOPE_FINALLY=0; + SCOPE_CATCHALL=1; + SCOPE_IMPLICIT=2; + + procedure tx86_64procinfo.set_first_temp_offset; + begin + if target_info.system=system_x86_64_win64 then + begin + { Fixes the case when there are calls done by low-level means + (cg.a_call_name) but no child callnode } + if (pi_do_call in flags) then + allocate_push_parasize(32); + + if not(po_assembler in procdef.procoptions) and + (tg.direction > 0) then + { maxpushedparasize already contains 32 bytes of spilling area } + tg.setfirsttemp(tg.direction*maxpushedparasize); + end + else + tg.setfirsttemp(tg.direction*maxpushedparasize); + end; + + + procedure tx86_64procinfo.generate_parameter_info; + begin + inherited generate_parameter_info; + if target_info.system=system_x86_64_win64 then + para_stack_size:=0; + end; + + + function tx86_64procinfo.calc_stackframe_size:longint; + begin + maxpushedparasize:=align(maxpushedparasize,max(current_settings.alignment.localalignmin,16)); + { Note 1: when tg.direction>0, tg.lasttemp is already offset by maxpushedparasize + (because tg.setfirsttemp also sets lasttemp) + Note 2: Align to 8 bytes here. The final 16-byte alignment is handled in + tcgx86.g_proc_entry, which considers saved rbp and the misalignment + caused by the call itself. } + if (tg.direction>0) then + result:=Align(tg.lasttemp,8) + else + result:=Align(tg.direction*tg.lasttemp+maxpushedparasize,8); + end; + + procedure tx86_64procinfo.add_finally_scope(startlabel,endlabel,handler:TAsmSymbol;implicit:Boolean); + begin + unwindflags:=unwindflags or 2; + if implicit then { also needs catch functionality } + unwindflags:=unwindflags or 1; + inc(scopecount); + if scopes=nil then + scopes:=TAsmList.Create; + + if implicit then + scopes.concat(tai_const.create_32bit(SCOPE_IMPLICIT)) + else + scopes.concat(tai_const.create_32bit(SCOPE_FINALLY)); + scopes.concat(tai_const.create_rva_sym(startlabel)); + scopes.concat(tai_const.create_rva_sym(endlabel)); + scopes.concat(tai_const.create_rva_sym(handler)); + end; + + procedure tx86_64procinfo.add_except_scope(trylabel,exceptlabel,endlabel,filter:TAsmSymbol); + begin + unwindflags:=unwindflags or 3; + inc(scopecount); + if scopes=nil then + scopes:=TAsmList.Create; + + if Assigned(filter) then + scopes.concat(tai_const.create_rva_sym(filter)) + else + scopes.concat(tai_const.create_32bit(SCOPE_CATCHALL)); + scopes.concat(tai_const.create_rva_sym(trylabel)); + scopes.concat(tai_const.create_rva_sym(exceptlabel)); + scopes.concat(tai_const.create_rva_sym(endlabel)); + end; + + procedure tx86_64procinfo.dump_scopes(list: TAsmList); + var + hdir: tai_seh_directive; + begin + if (scopecount=0) then + exit; + hdir:=cai_seh_directive.create_name(ash_handler,'__FPC_specific_handler'); + hdir.data.flags:=unwindflags; + list.concat(hdir); + list.concat(cai_seh_directive.create(ash_handlerdata)); + list.concat(tai_const.create_32bit(scopecount)); + list.concatlist(scopes); + { return to text, required for GAS compatibility } + { This creates a tai_align which is redundant here (although harmless) } + new_section(list,sec_code,lower(procdef.mangledname),0); + end; + + destructor tx86_64procinfo.destroy; + begin + scopes.free; + inherited destroy; + end; + +begin + cprocinfo:=tx86_64procinfo; +end. diff --git a/closures/compiler/x86_64/cputarg.pas b/closures/compiler/x86_64/cputarg.pas new file mode 100644 index 0000000000..b69184c509 --- /dev/null +++ b/closures/compiler/x86_64/cputarg.pas @@ -0,0 +1,94 @@ +{ + Copyright (c) 2001 by Peter Vreman + + Includes the x86-64 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. + + **************************************************************************** +} +{ This unit includes the x86-64 dependent target units. } +unit cputarg; + +{$i fpcdefs.inc} + +interface + + +implementation + + uses + systems { prevent a syntax error when nothing is included } + +{************************************** + Targets +**************************************} + + {$ifndef NOTARGETLINUX} + ,t_linux + {$endif} + {$ifndef NOTARGETFREEBSD} + ,t_bsd + {$endif} + {$ifndef NOTARGETWIN} + ,t_win + ,win64unw + {$endif} + {$ifndef NOTARGETSUNOS} + ,t_sunos + {$endif} + +{************************************** + Assemblers +**************************************} + + {$ifndef NOAGX86_64INT} + ,agx86int + {$endif} + {$ifndef NOAGX86_64ATT} + ,agx86att + {$endif} + + ,ogcoff + ,ogelf + +{************************************** + Assembler Readers +**************************************} + + {$ifndef NoRax64att} + ,rax64att + {$endif NoRax64att} + {$ifndef NoRax64int} + ,rax64int + {$endif NoRax64int} + +{************************************** + Debuginfo +**************************************} + + {$ifndef NoCFIDwarf} + ,cfidwarf + {$endif NoCFIDwarf} + {$ifndef NoDbgStabs} + ,dbgstabs + {$endif NoDbgStabs} + {$ifndef NoDbgDwarf} + ,dbgdwarf + {$endif NoDbgDwarf} + + ; + +end. diff --git a/closures/compiler/x86_64/nx64add.pas b/closures/compiler/x86_64/nx64add.pas new file mode 100644 index 0000000000..2888b7f326 --- /dev/null +++ b/closures/compiler/x86_64/nx64add.pas @@ -0,0 +1,126 @@ +{ + Copyright (c) 2000-2002 by Florian Klaempfl + + Code generation for add nodes on the x86-64 + + 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 nx64add; + +{$i fpcdefs.inc} + +interface + + uses + node,nadd,cpubase,nx86add; + + type + tx8664addnode = class(tx86addnode) + procedure second_addordinal; override; + procedure second_mul; + end; + + implementation + + uses + globtype,globals, + aasmbase,aasmtai,aasmdata, + defutil, + cgbase,cgutils,cga,cgobj, + tgobj; + +{***************************************************************************** + Addordinal +*****************************************************************************} + + procedure tx8664addnode.second_addordinal; + begin + { filter unsigned MUL opcode, which requires special handling } + if (nodetype=muln) and + (not(is_signed(left.resultdef)) or + not(is_signed(right.resultdef))) then + begin + second_mul; + exit; + end; + + inherited second_addordinal; + end; + +{***************************************************************************** + MUL +*****************************************************************************} + + procedure tx8664addnode.second_mul; + + var reg:Tregister; + ref:Treference; + use_ref:boolean; + hl4 : tasmlabel; + + begin + pass_left_right; + + { The location.register will be filled in later (JM) } + location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); + { Mul supports registers and references, so if not register/reference, + load the location into a register} + use_ref:=false; + if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then + reg:=left.location.register + else if left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then + begin + ref:=left.location.reference; + use_ref:=true; + end + else + begin + {LOC_CONSTANT for example.} + reg:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_INT,left.location,reg); + end; + { Allocate RAX. } + cg.getcpuregister(current_asmdata.CurrAsmList,NR_RAX); + { Load the right value. } + cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_INT,right.location,NR_RAX); + { Also allocate RDX, since it is also modified by a mul (JM). } + cg.getcpuregister(current_asmdata.CurrAsmList,NR_RDX); + if use_ref then + emit_ref(A_MUL,S_Q,ref) + else + emit_reg(A_MUL,S_Q,reg); + if cs_check_overflow in current_settings.localswitches then + begin + current_asmdata.getjumplabel(hl4); + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_AE,hl4); + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_OVERFLOW',false); + cg.a_label(current_asmdata.CurrAsmList,hl4); + end; + { Free RDX,RAX } + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_RDX); + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_RAX); + { Allocate a new register and store the result in RAX in it. } + location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + emit_reg_reg(A_MOV,S_Q,NR_RAX,location.register); + location_freetemp(current_asmdata.CurrAsmList,left.location); + location_freetemp(current_asmdata.CurrAsmList,right.location); + end; + + +begin + caddnode:=tx8664addnode; +end. diff --git a/closures/compiler/x86_64/nx64cal.pas b/closures/compiler/x86_64/nx64cal.pas new file mode 100644 index 0000000000..1217282463 --- /dev/null +++ b/closures/compiler/x86_64/nx64cal.pas @@ -0,0 +1,82 @@ +{ + Copyright (c) 2002 by Florian Klaempfl + + Implements the x86-64 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 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 nx64cal; + +{$i fpcdefs.inc} + +interface + + uses + symdef, + ncal,ncgcal; + + type + tx8664callnode = class(tcgcallnode) + protected + procedure extra_call_code;override; + procedure set_result_location(realresdef: tstoreddef);override; + end; + + +implementation + + uses + globtype, + systems, + cpubase,cgbase,cgutils,cgobj, + aasmtai,aasmdata,aasmcpu; + + procedure tx8664callnode.extra_call_code; + var + mmregs : aint; + begin + { x86_64 requires %al to contain the no. SSE regs passed } + if (cnf_uses_varargs in callnodeflags) and (target_info.system<>system_x86_64_win64) then + begin + if assigned(varargsparas) then + mmregs:=varargsparas.mmregsused + else + mmregs:=0; + current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_MOV,S_Q,mmregs,NR_RAX)) + end; + end; + + + procedure tx8664callnode.set_result_location(realresdef: tstoreddef); + begin + { avoid useless "movq %xmm0,%rax" and "movq %rax,%xmm0" instructions + (which moreover for some reason are not supported by the Darwin + x86-64 assembler) } + if assigned(retloc.location) and + not assigned(retloc.location^.next) and + (retloc.location^.loc in [LOC_MMREGISTER,LOC_CMMREGISTER]) then + begin + location_reset(location,LOC_MMREGISTER,retloc.location^.size); + location.register:=cg.getmmregister(current_asmdata.CurrAsmList,retloc.location^.size); + end + else + inherited + end; + +begin + ccallnode:=tx8664callnode; +end. diff --git a/closures/compiler/x86_64/nx64cnv.pas b/closures/compiler/x86_64/nx64cnv.pas new file mode 100644 index 0000000000..e79dcd021e --- /dev/null +++ b/closures/compiler/x86_64/nx64cnv.pas @@ -0,0 +1,175 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate x86-64 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 nx64cnv; + +{$i fpcdefs.inc} + +interface + + uses + node,ncgcnv,defutil,defcmp,pass_1, + nx86cnv; + + type + tx8664typeconvnode = class(tx86typeconvnode) + protected + { 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; } + { procedure second_pointer_to_array;override; } + { procedure second_chararray_to_string;override; } + { procedure second_char_to_string;override; } + { function first_int_to_real: tnode; override; } + function first_int_to_real : tnode;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,systems,globals,globtype, + aasmbase,aasmtai,aasmdata,aasmcpu, + symconst,symdef, + cgbase,cga,procinfo,pass_2, + ncon,ncal,ncnv, + cpubase, + cgutils,cgobj,cgx86,ncgutil, + tgobj; + + + function tx8664typeconvnode.first_int_to_real : tnode; + begin + result:=nil; + if use_vectorfpu(resultdef) and + (torddef(left.resultdef).ordtype=u32bit) then + begin + inserttypeconv(left,s64inttype); + firstpass(left); + end + else + result:=inherited first_int_to_real; + if use_vectorfpu(resultdef) then + expectloc:=LOC_MMREGISTER; + end; + + + procedure tx8664typeconvnode.second_int_to_real; + var + href : treference; + l1,l2 : tasmlabel; + op : tasmop; + begin + if use_vectorfpu(resultdef) then + begin + if is_double(resultdef) then + op:=A_CVTSI2SD + else if is_single(resultdef) then + op:=A_CVTSI2SS + else + internalerror(200506061); + + location_reset(location,LOC_MMREGISTER,def_cgsize(resultdef)); + location.register:=cg.getmmregister(current_asmdata.CurrAsmList,location.size); + + case torddef(left.resultdef).ordtype of + u64bit: + begin + { unsigned 64 bit ints are harder to handle: + we load bits 0..62 and then check bit 63: + if it is 1 then we add $80000000 000000000 + as double } + current_asmdata.getdatalabel(l1); + current_asmdata.getjumplabel(l2); + + { Get sign bit } + if not(left.location.loc in [LOC_REGISTER,LOC_REFERENCE]) then + location_force_reg(current_asmdata.CurrAsmList,left.location,left.location.size,false); + case left.location.loc of + LOC_REGISTER : + begin + emit_const_reg(A_BT,S_Q,63,left.location.register); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,S_Q,left.location.register,location.register)); + end; + LOC_REFERENCE : + begin + href:=left.location.reference; + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,href); + inc(href.offset,4); + emit_const_ref(A_BT,S_L,31,href); + dec(href.offset,4); + current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(op,S_Q,href,location.register)); + end; + else + internalerror(200710181); + end; + + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NC,l2); + new_section(current_asmdata.asmlists[al_typedconsts],sec_rodata_norel,l1.name,const_align(sizeof(pint))); + current_asmdata.asmlists[al_typedconsts].concat(Tai_label.Create(l1)); + reference_reset_symbol(href,l1,0,4); + { simplify for PIC } + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,href); + + { I got these constant from a test program (FK) } + if is_double(resultdef) then + begin + { double (2^64) } + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit(0)); + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit($43f00000)); + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,href); + current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(A_ADDSD,S_NO,href,location.register)); + end + else if is_single(resultdef) then + begin + { single(2^64) } + current_asmdata.asmlists[al_typedconsts].concat(Tai_const.Create_32bit($5f800000)); + current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(A_ADDSS,S_NO,href,location.register)); + end + else + internalerror(200506071); + cg.a_label(current_asmdata.CurrAsmList,l2); + end + else + inherited second_int_to_real; + end; + end + else + inherited second_int_to_real; + end; + + +begin + ctypeconvnode:=tx8664typeconvnode; +end. diff --git a/closures/compiler/x86_64/nx64flw.pas b/closures/compiler/x86_64/nx64flw.pas new file mode 100644 index 0000000000..15be927383 --- /dev/null +++ b/closures/compiler/x86_64/nx64flw.pas @@ -0,0 +1,559 @@ +{ + Copyright (c) 2011 by Free Pascal development team + + Generate Win64-specific exception handling code + + 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 nx64flw; + +{$i fpcdefs.inc} + +interface + + uses + node,nflw,ncgflw,psub; + + type + tx64raisenode=class(tcgraisenode) + procedure pass_generate_code;override; + end; + + tx64onnode=class(tcgonnode) + procedure pass_generate_code;override; + end; + + tx64tryexceptnode=class(tcgtryexceptnode) + procedure pass_generate_code;override; + end; + + tx64tryfinallynode=class(tcgtryfinallynode) + finalizepi: tcgprocinfo; + constructor create(l,r:TNode);override; + constructor create_implicit(l,r,_t1:TNode);override; + function simplify(forinline: boolean): tnode;override; + procedure pass_generate_code;override; + end; + +implementation + + uses + cutils,globtype,globals,verbose,systems, + nbas,ncal,nmem,nutils, + symconst,symbase,symtable,symsym,symdef, + cgbase,cgobj,cgcpu,cgutils,tgobj, + cpubase,htypechk, + parabase,paramgr,pdecsub,pass_1,pass_2,ncgutil,cga, + aasmbase,aasmtai,aasmdata,aasmcpu,procinfo,cpupi; + + var + endexceptlabel: tasmlabel; + + +{ tx64raisenode } + +procedure tx64raisenode.pass_generate_code; + begin + { difference from generic code is that address stack is not popped on reraise } + if (target_info.system<>system_x86_64_win64) or assigned(left) then + inherited pass_generate_code + else + cg.g_call(current_asmdata.CurrAsmList,'FPC_RERAISE'); + end; + +{ tx64onnode } + +procedure tx64onnode.pass_generate_code; + var + oldflowcontrol : tflowcontrol; + exceptvarsym : tlocalvarsym; + begin + if (target_info.system<>system_x86_64_win64) then + begin + inherited pass_generate_code; + exit; + end; + + location_reset(location,LOC_VOID,OS_NO); + + oldflowcontrol:=flowcontrol; + flowcontrol:=[fc_inflowcontrol]; + + { RTL will put exceptobject into RAX when jumping here } + cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG); + + { Retrieve exception variable } + if assigned(excepTSymtable) then + exceptvarsym:=tlocalvarsym(excepTSymtable.SymList[0]) + else + exceptvarsym:=nil; + + if assigned(exceptvarsym) then + begin + exceptvarsym.localloc.loc:=LOC_REFERENCE; + exceptvarsym.localloc.size:=OS_ADDR; + tg.GetLocal(current_asmdata.CurrAsmList,sizeof(pint),voidpointertype,exceptvarsym.localloc.reference); + cg.a_load_reg_ref(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,exceptvarsym.localloc.reference); + end; + cg.a_reg_dealloc(current_asmdata.CurrAsmList,NR_FUNCTION_RESULT_REG); + + if assigned(right) then + secondpass(right); + + { deallocate exception symbol } + if assigned(exceptvarsym) then + begin + tg.UngetLocal(current_asmdata.CurrAsmList,exceptvarsym.localloc.reference); + exceptvarsym.localloc.loc:=LOC_INVALID; + end; + cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION'); + cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel); + + flowcontrol:=oldflowcontrol+(flowcontrol-[fc_inflowcontrol]); + end; + +{ tx64tryfinallynode } +var + seq: longint=0; + + +function create_pd: tprocdef; + var + st:TSymTable; + checkstack: psymtablestackitem; + sym:tprocsym; + begin + { get actual procedure symtable (skip withsymtables, etc.) } + st:=nil; + checkstack:=symtablestack.stack; + while assigned(checkstack) do + begin + st:=checkstack^.symtable; + if st.symtabletype in [staticsymtable,globalsymtable,localsymtable] then + break; + checkstack:=checkstack^.next; + end; + { Create a nested procedure, even from main_program_level. } + result:=tprocdef.create(max(normal_function_level,st.symtablelevel)+1); + result.struct:=current_procinfo.procdef.struct; + result.proctypeoption:=potype_exceptfilter; + handle_calling_convention(result); + sym:=tprocsym.create('$fin$'+tostr(seq)); + st.insert(sym); + inc(seq); + + result.procsym:=sym; + proc_add_definition(result); + result.forwarddef:=false; + result.aliasnames.insert(result.mangledname); + alloc_proc_symbol(result); + end; + +function reset_regvars(var n: tnode; arg: pointer): foreachnoderesult; + begin + case n.nodetype of + temprefn: + make_not_regable(n,[]); + calln: + include(tprocinfo(arg).flags,pi_do_call); + end; + result:=fen_true; + end; + +function copy_parasize(var n: tnode; arg: pointer): foreachnoderesult; + begin + case n.nodetype of + calln: + tcgprocinfo(arg).allocate_push_parasize(tcallnode(n).pushed_parasize); + end; + result:=fen_true; + end; + +constructor tx64tryfinallynode.create(l, r: TNode); + begin + inherited create(l,r); + if (target_info.system<>system_x86_64_win64) then + exit; + finalizepi:=tcgprocinfo(cprocinfo.create(current_procinfo)); + finalizepi.force_nested; + finalizepi.procdef:=create_pd; + finalizepi.entrypos:=r.fileinfo; + finalizepi.entryswitches:=r.localswitches; + finalizepi.exitpos:=current_filepos; // last_endtoken_pos? + finalizepi.exitswitches:=current_settings.localswitches; + { Regvar optimization for symbols is suppressed when using exceptions, but + temps may be still placed into registers. This must be fixed. } + foreachnodestatic(r,@reset_regvars,finalizepi); + end; + +constructor tx64tryfinallynode.create_implicit(l, r, _t1: TNode); + begin + inherited create_implicit(l, r, _t1); + if (target_info.system<>system_x86_64_win64) then + exit; + finalizepi:=tcgprocinfo(cprocinfo.create(current_procinfo)); + finalizepi.force_nested; + finalizepi.procdef:=create_pd; + + finalizepi.entrypos:=current_filepos; + finalizepi.exitpos:=current_filepos; // last_endtoken_pos? + finalizepi.entryswitches:=r.localswitches; + finalizepi.exitswitches:=current_settings.localswitches; + include(finalizepi.flags,pi_do_call); + finalizepi.allocate_push_parasize(32); + end; + +function tx64tryfinallynode.simplify(forinline: boolean): tnode; + begin + result:=inherited simplify(forinline); + if (target_info.system<>system_x86_64_win64) then + exit; + if (result=nil) then + begin + finalizepi.code:=right; + foreachnodestatic(right,@copy_parasize,finalizepi); + right:=ccallnode.create(nil,tprocsym(finalizepi.procdef.procsym),nil,nil,[]); + firstpass(right); + { For implicit frames, no actual code is available at this time, + it is added later in assembler form. So store the nested procinfo + for later use. } + if implicitframe then + begin + current_procinfo.finalize_procinfo:=finalizepi; + { don't leave dangling pointer } + tcgprocinfo(current_procinfo).final_asmnode:=nil; + end; + end; + end; + +procedure emit_nop; + var + dummy: TAsmLabel; + begin + { To avoid optimizing away the whole thing, prepend a jumplabel with increased refcount } + current_asmdata.getjumplabel(dummy); + dummy.increfs; + cg.a_label(current_asmdata.CurrAsmList,dummy); + current_asmdata.CurrAsmList.concat(Taicpu.op_none(A_NOP,S_NO)); + end; + +procedure tx64tryfinallynode.pass_generate_code; + var + trylabel, + endtrylabel, + finallylabel, + endfinallylabel, + oldexitlabel: tasmlabel; + oldflowcontrol: tflowcontrol; + catch_frame: boolean; + begin + if (target_info.system<>system_x86_64_win64) then + begin + inherited pass_generate_code; + exit; + end; + + location_reset(location,LOC_VOID,OS_NO); + + { Do not generate a frame that catches exceptions if the only action + would be reraising it. Doing so is extremely inefficient with SEH + (in contrast with setjmp/longjmp exception handling) } + catch_frame:=implicitframe and ((not has_no_code(t1)) or + (current_procinfo.procdef.proccalloption=pocall_safecall)); + + oldflowcontrol:=flowcontrol; + flowcontrol:=[fc_inflowcontrol]; + + current_asmdata.getjumplabel(trylabel); + current_asmdata.getjumplabel(endtrylabel); + current_asmdata.getjumplabel(finallylabel); + current_asmdata.getjumplabel(endfinallylabel); + oldexitlabel:=current_procinfo.CurrExitLabel; + if implicitframe then + current_procinfo.CurrExitLabel:=finallylabel; + + { Start of scope } + { Padding with NOP is necessary here because exceptions in called + procedures are seen at the next instruction, while CPU/OS exceptions + like AV are seen at the current instruction. + + So in the following code + + raise_some_exception; //(a) + try + pchar(nil)^:='0'; //(b) + ... + + without NOP, exceptions (a) and (b) will be seen at the same address + and fall into the same scope. However they should be seen in different scopes. + } + + emit_nop; + cg.a_label(current_asmdata.CurrAsmList,trylabel); + + { try code } + if assigned(left) then + begin + { fc_unwind tells exit/continue/break statements to emit special + unwind code instead of just JMP } + if not implicitframe then + include(flowcontrol,fc_unwind); + secondpass(left); + exclude(flowcontrol,fc_unwind); + if codegenerror then + exit; + end; + + { If the immediately preceding instruction is CALL, + its return address must not end up outside the scope, so pad with NOP. } + if catch_frame then + cg.a_jmp_always(current_asmdata.CurrAsmList,finallylabel) + else + emit_nop; + + cg.a_label(current_asmdata.CurrAsmList,endtrylabel); + + { Handle the except block first, so endtrylabel serves both + as end of scope and as unwind target. This way it is possible to + encode everything into a single scope record. } + if catch_frame then + begin + flowcontrol:=[fc_inflowcontrol]; + secondpass(t1); + { note 1: this is not a 'finally' block, no flow restrictions apply + note 2: it contains autogenerated sequential code, flow away is impossible } + if flowcontrol<>[fc_inflowcontrol] then + CGMessage(cg_e_control_flow_outside_finally); + if codegenerror then + exit; + + if (current_procinfo.procdef.proccalloption=pocall_safecall) then + begin + handle_safecall_exception; + cg.a_jmp_always(current_asmdata.CurrAsmList,endfinallylabel); + end + else + cg.a_call_name(current_asmdata.CurrAsmList,'FPC_RERAISE_IMPLICIT',false); + end; + + flowcontrol:=[fc_inflowcontrol]; + cg.a_label(current_asmdata.CurrAsmList,finallylabel); + { generate finally code as a separate procedure } + if not implicitframe then + tcgprocinfo(current_procinfo).generate_exceptfilter(finalizepi); + { right is a call to finalizer procedure } + secondpass(right); + + if codegenerror then + exit; + + { normal exit from safecall proc must zero the result register } + if implicitframe and (current_procinfo.procdef.proccalloption=pocall_safecall) then + cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,0,NR_FUNCTION_RESULT_REG); + + cg.a_label(current_asmdata.CurrAsmList,endfinallylabel); + + { generate the scope record in .xdata } + tx86_64procinfo(current_procinfo).add_finally_scope(trylabel,endtrylabel, + current_asmdata.RefAsmSymbol(finalizepi.procdef.mangledname),catch_frame); + + if implicitframe then + current_procinfo.CurrExitLabel:=oldexitlabel; + flowcontrol:=oldflowcontrol; + end; + +{ tx64tryexceptnode } + +procedure tx64tryexceptnode.pass_generate_code; + var + trylabel, + exceptlabel,oldendexceptlabel, + lastonlabel, + exitexceptlabel, + continueexceptlabel, + breakexceptlabel, + oldCurrExitLabel, + oldContinueLabel, + oldBreakLabel : tasmlabel; + onlabel, + filterlabel: tasmlabel; + oldflowcontrol,tryflowcontrol, + exceptflowcontrol : tflowcontrol; + hnode : tnode; + hlist : tasmlist; + onnodecount : tai_const; + label + errorexit; + begin + if (target_info.system<>system_x86_64_win64) then + begin + inherited pass_generate_code; + exit; + end; + location_reset(location,LOC_VOID,OS_NO); + + oldflowcontrol:=flowcontrol; + flowcontrol:=[fc_inflowcontrol]; + { this can be called recursivly } + oldBreakLabel:=nil; + oldContinueLabel:=nil; + oldendexceptlabel:=endexceptlabel; + + { save the old labels for control flow statements } + oldCurrExitLabel:=current_procinfo.CurrExitLabel; + current_asmdata.getjumplabel(exitexceptlabel); + if assigned(current_procinfo.CurrBreakLabel) then + begin + oldContinueLabel:=current_procinfo.CurrContinueLabel; + oldBreakLabel:=current_procinfo.CurrBreakLabel; + current_asmdata.getjumplabel(breakexceptlabel); + current_asmdata.getjumplabel(continueexceptlabel); + end; + + current_asmdata.getjumplabel(exceptlabel); + current_asmdata.getjumplabel(endexceptlabel); + current_asmdata.getjumplabel(lastonlabel); + filterlabel:=nil; + + { start of scope } + current_asmdata.getjumplabel(trylabel); + emit_nop; + cg.a_label(current_asmdata.CurrAsmList,trylabel); + + { control flow in try block needs no special handling, + just make sure that target labels are outside the scope } + secondpass(left); + tryflowcontrol:=flowcontrol; + if codegenerror then + goto errorexit; + + { jump over except handlers } + cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel); + + { end of scope } + cg.a_label(current_asmdata.CurrAsmList,exceptlabel); + + { set control flow labels for the except block } + { and the on statements } + current_procinfo.CurrExitLabel:=exitexceptlabel; + if assigned(oldBreakLabel) then + begin + current_procinfo.CurrContinueLabel:=continueexceptlabel; + current_procinfo.CurrBreakLabel:=breakexceptlabel; + end; + + flowcontrol:=[fc_inflowcontrol]; + { on statements } + if assigned(right) then + begin + { emit filter table to a temporary asmlist } + hlist:=TAsmList.Create; + current_asmdata.getdatalabel(filterlabel); + new_section(hlist,sec_rodata_norel,filterlabel.name,4); + cg.a_label(hlist,filterlabel); + onnodecount:=tai_const.create_32bit(0); + hlist.concat(onnodecount); + + hnode:=right; + while assigned(hnode) do + begin + if hnode.nodetype<>onn then + InternalError(2011103101); + { TODO: make it done without using global label } + current_asmdata.getglobaljumplabel(onlabel); + hlist.concat(tai_const.create_rva_sym(current_asmdata.RefAsmSymbol(tonnode(hnode).excepttype.vmt_mangledname))); + hlist.concat(tai_const.create_rva_sym(onlabel)); + cg.a_label(current_asmdata.CurrAsmList,onlabel); + secondpass(hnode); + inc(onnodecount.value); + hnode:=tonnode(hnode).left; + end; + { add 'else' node to the filter list, too } + if assigned(t1) then + begin + hlist.concat(tai_const.create_32bit(-1)); + hlist.concat(tai_const.create_rva_sym(lastonlabel)); + inc(onnodecount.value); + end; + { now move filter table to permanent list all at once } + maybe_new_object_file(current_asmdata.asmlists[al_typedconsts]); + current_asmdata.asmlists[al_typedconsts].concatlist(hlist); + hlist.free; + end; + + cg.a_label(current_asmdata.CurrAsmList,lastonlabel); + if assigned(t1) then + begin + { here we don't have to reset flowcontrol } + { the default and on flowcontrols are handled equal } + secondpass(t1); + cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION'); + if (flowcontrol*[fc_exit,fc_break,fc_continue]<>[]) then + cg.a_jmp_always(current_asmdata.CurrAsmList,endexceptlabel); + end; + exceptflowcontrol:=flowcontrol; + + if fc_exit in exceptflowcontrol then + begin + { do some magic for exit in the try block } + cg.a_label(current_asmdata.CurrAsmList,exitexceptlabel); + cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION'); + cg.a_jmp_always(current_asmdata.CurrAsmList,oldCurrExitLabel); + end; + + if fc_break in exceptflowcontrol then + begin + cg.a_label(current_asmdata.CurrAsmList,breakexceptlabel); + cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION'); + cg.a_jmp_always(current_asmdata.CurrAsmList,oldBreakLabel); + end; + + if fc_continue in exceptflowcontrol then + begin + cg.a_label(current_asmdata.CurrAsmList,continueexceptlabel); + cg.g_call(current_asmdata.CurrAsmList,'FPC_DONEEXCEPTION'); + cg.a_jmp_always(current_asmdata.CurrAsmList,oldContinueLabel); + end; + + emit_nop; + cg.a_label(current_asmdata.CurrAsmList,endexceptlabel); + tx86_64procinfo(current_procinfo).add_except_scope(trylabel,exceptlabel,endexceptlabel,filterlabel); + +errorexit: + { restore all saved labels } + endexceptlabel:=oldendexceptlabel; + + { restore the control flow labels } + current_procinfo.CurrExitLabel:=oldCurrExitLabel; + if assigned(oldBreakLabel) then + begin + current_procinfo.CurrContinueLabel:=oldContinueLabel; + current_procinfo.CurrBreakLabel:=oldBreakLabel; + end; + + { return all used control flow statements } + flowcontrol:=oldflowcontrol+(exceptflowcontrol + + tryflowcontrol - [fc_inflowcontrol]); + end; + +initialization + craisenode:=tx64raisenode; + connode:=tx64onnode; + ctryexceptnode:=tx64tryexceptnode; + ctryfinallynode:=tx64tryfinallynode; +end. + diff --git a/closures/compiler/x86_64/nx64inl.pas b/closures/compiler/x86_64/nx64inl.pas new file mode 100644 index 0000000000..2c322f897c --- /dev/null +++ b/closures/compiler/x86_64/nx64inl.pas @@ -0,0 +1,42 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate x86-64 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 nx64inl; + +{$i fpcdefs.inc} + +interface + + uses + nx86inl; + + type + tx8664inlinenode = class(tx86inlinenode) + end; + +implementation + + uses + ninl; + +begin + cinlinenode:=tx8664inlinenode; +end. diff --git a/closures/compiler/x86_64/nx64mat.pas b/closures/compiler/x86_64/nx64mat.pas new file mode 100644 index 0000000000..3085872c88 --- /dev/null +++ b/closures/compiler/x86_64/nx64mat.pas @@ -0,0 +1,213 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + Generate x86-64 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 nx64mat; + +{$i fpcdefs.inc} + +interface + + uses + node,nmat,ncgmat,nx86mat; + + type + tx8664moddivnode = class(tmoddivnode) + procedure pass_generate_code;override; + end; + + tx8664shlshrnode = class(tshlshrnode) + procedure pass_generate_code;override; + end; + + tx8664unaryminusnode = class(tx86unaryminusnode) + end; + + tx8664notnode = class(tx86notnode) + end; + +implementation + + uses + globtype,systems,constexp, + cutils,verbose,globals, + symconst,symdef,aasmbase,aasmtai,aasmdata,defutil, + pass_1,pass_2, + ncon, + cpubase,cpuinfo, + cgbase,cgutils,cga,cgobj,cgx86, + ncgutil; + +{***************************************************************************** + TX8664MODDIVNODE +*****************************************************************************} + + procedure tx8664moddivnode.pass_generate_code; + var + hreg1,hreg2:Tregister; + power:longint; + op:Tasmop; + begin + secondpass(left); + if codegenerror then + exit; + secondpass(right); + if codegenerror then + exit; + + { put numerator in register } + location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); + location_force_reg(current_asmdata.CurrAsmList,left.location,location.size,false); + hreg1:=left.location.register; + + if (nodetype=divn) and (right.nodetype=ordconstn) and + ispowerof2(int64(tordconstnode(right).value),power) then + begin + { for signed numbers, the numerator must be adjusted before the + shift instruction, but not wih unsigned numbers! Otherwise, + "Cardinal($ffffffff) div 16" overflows! (JM) } + if is_signed(left.resultdef) Then + begin + { use a sequence without jumps, saw this in + comp.compilers (JM) } + { no jumps, but more operations } + hreg2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + emit_reg_reg(A_MOV,S_Q,hreg1,hreg2); + {If the left value is signed, hreg2=$ffffffff, otherwise 0.} + emit_const_reg(A_SAR,S_Q,63,hreg2); + {If signed, hreg2=right value-1, otherwise 0.} + { (don't use emit_const_reg, because if value>high(longint) + then it must first be loaded into a register) } + cg.a_op_const_reg(current_asmdata.CurrAsmList,OP_AND,OS_S64,tordconstnode(right).value-1,hreg2); + { add to the left value } + emit_reg_reg(A_ADD,S_Q,hreg2,hreg1); + { do the shift } + emit_const_reg(A_SAR,S_Q,power,hreg1); + end + else + emit_const_reg(A_SHR,S_Q,power,hreg1); + location.register:=hreg1; + end + else + begin + {Bring denominator to a register.} + cg.getcpuregister(current_asmdata.CurrAsmList,NR_RAX); + emit_reg_reg(A_MOV,S_Q,hreg1,NR_RAX); + cg.getcpuregister(current_asmdata.CurrAsmList,NR_RDX); + {Sign extension depends on the left type.} + if torddef(left.resultdef).ordtype=u64bit then + emit_reg_reg(A_XOR,S_Q,NR_RDX,NR_RDX) + else + emit_none(A_CQO,S_NO); + + {Division depends on the right type.} + if Torddef(right.resultdef).ordtype=u64bit then + op:=A_DIV + else + op:=A_IDIV; + + if right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then + emit_ref(op,S_Q,right.location.reference) + else if right.location.loc in [LOC_REGISTER,LOC_CREGISTER] then + emit_reg(op,S_Q,right.location.register) + else + begin + hreg1:=cg.getintregister(current_asmdata.CurrAsmList,right.location.size); + cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_64,right.location,hreg1); + emit_reg(op,S_Q,hreg1); + end; + + { Copy the result into a new register. Release RAX & RDX.} + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_RDX); + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_RAX); + location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + if nodetype=divn then + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_RAX,location.register) + else + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,NR_RDX,location.register); + end; + end; + + +{***************************************************************************** + TX8664SHLRSHRNODE +*****************************************************************************} + + + procedure tx8664shlshrnode.pass_generate_code; + var + op : Tasmop; + opsize : tcgsize; + mask : aint; + begin + secondpass(left); + secondpass(right); + + { determine operator } + if nodetype=shln then + op:=A_SHL + else + op:=A_SHR; + + { special treatment of 32bit values for backwards compatibility } + { mul optimizations require to keep the sign (FK) } + if left.resultdef.size<=4 then + begin + if is_signed(left.resultdef) then + opsize:=OS_S32 + else + opsize:=OS_32; + mask:=31; + end + else + begin + if is_signed(left.resultdef) then + opsize:=OS_S64 + else + opsize:=OS_64; + mask:=63; + end; + + { load left operators in a register } + location_copy(location,left.location); + location_force_reg(current_asmdata.CurrAsmList,location,opsize,false); + + { shifting by a constant directly coded: } + if (right.nodetype=ordconstn) then + emit_const_reg(op,tcgsize2opsize[opsize],tordconstnode(right).value and mask,location.register) + else + begin + { load right operators in a RCX } + cg.getcpuregister(current_asmdata.CurrAsmList,NR_RCX); + cg.a_load_loc_reg(current_asmdata.CurrAsmList,OS_INT,right.location,NR_RCX); + + { right operand is in ECX } + cg.ungetcpuregister(current_asmdata.CurrAsmList,NR_RCX); + emit_reg_reg(op,tcgsize2opsize[opsize],NR_CL,location.register); + end; + end; + + +begin + cunaryminusnode:=tx8664unaryminusnode; + cmoddivnode:=tx8664moddivnode; + cshlshrnode:=tx8664shlshrnode; + cnotnode:=tx8664notnode; +end. diff --git a/closures/compiler/x86_64/r8664ari.inc b/closures/compiler/x86_64/r8664ari.inc new file mode 100644 index 0000000000..bdce69ce50 --- /dev/null +++ b/closures/compiler/x86_64/r8664ari.inc @@ -0,0 +1,126 @@ +{ don't edit, this file is generated from x86reg.dat } +2, +1, +3, +17, +16, +30, +29, +18, +7, +6, +83, +84, +85, +86, +71, +8, +12, +26, +25, +11, +77, +78, +79, +80, +81, +82, +72, +13, +4, +31, +19, +9, +27, +14, +70, +73, +23, +35, +75, +76, +101, +102, +103, +104, +105, +106, +107, +108, +45, +46, +48, +47, +49, +50, +52, +51, +53, +54, +56, +55, +57, +58, +60, +59, +61, +62, +64, +63, +65, +66, +68, +67, +37, +38, +40, +39, +41, +42, +44, +43, +5, +32, +20, +10, +28, +15, +69, +24, +36, +22, +21, +34, +33, +74, +100, +92, +93, +94, +95, +96, +97, +98, +99, +87, +88, +89, +90, +91, +109, +110, +119, +120, +121, +122, +123, +124, +111, +112, +113, +114, +115, +116, +117, +118, +0 diff --git a/closures/compiler/x86_64/r8664att.inc b/closures/compiler/x86_64/r8664att.inc new file mode 100644 index 0000000000..f9539b56f8 --- /dev/null +++ b/closures/compiler/x86_64/r8664att.inc @@ -0,0 +1,126 @@ +{ don't edit, this file is generated from x86reg.dat } +'INVALID', +'%al', +'%ah', +'%ax', +'%eax', +'%rax', +'%cl', +'%ch', +'%cx', +'%ecx', +'%rcx', +'%dl', +'%dh', +'%dx', +'%edx', +'%rdx', +'%bl', +'%bh', +'%bx', +'%ebx', +'%rbx', +'%sil', +'%si', +'%esi', +'%rsi', +'%dil', +'%di', +'%edi', +'%rdi', +'%bpl', +'%bp', +'%ebp', +'%rbp', +'%spl', +'%sp', +'%esp', +'%rsp', +'%r8', +'%r8b', +'%r8w', +'%r8d', +'%r9', +'%r9b', +'%r9w', +'%r9d', +'%r10', +'%r10b', +'%r10w', +'%r10d', +'%r11', +'%r11b', +'%r11w', +'%r11d', +'%r12', +'%r12b', +'%r12w', +'%r12d', +'%r13', +'%r13b', +'%r13w', +'%r13d', +'%r14', +'%r14b', +'%r14w', +'%r14d', +'%r15', +'%r15b', +'%r15w', +'%r15d', +'%rip', +'%eip', +'%cs', +'%ds', +'%es', +'%ss', +'%fs', +'%gs', +'%dr0', +'%dr1', +'%dr2', +'%dr3', +'%dr6', +'%dr7', +'%cr0', +'%cr2', +'%cr3', +'%cr4', +'%tr3', +'%tr4', +'%tr5', +'%tr6', +'%tr7', +'%st(0)', +'%st(1)', +'%st(2)', +'%st(3)', +'%st(4)', +'%st(5)', +'%st(6)', +'%st(7)', +'%st', +'%mm0', +'%mm1', +'%mm2', +'%mm3', +'%mm4', +'%mm5', +'%mm6', +'%mm7', +'%xmm0', +'%xmm1', +'%xmm2', +'%xmm3', +'%xmm4', +'%xmm5', +'%xmm6', +'%xmm7', +'%xmm8', +'%xmm9', +'%xmm10', +'%xmm11', +'%xmm12', +'%xmm13', +'%xmm14', +'%xmm15' diff --git a/closures/compiler/x86_64/r8664con.inc b/closures/compiler/x86_64/r8664con.inc new file mode 100644 index 0000000000..ae6a0d28e3 --- /dev/null +++ b/closures/compiler/x86_64/r8664con.inc @@ -0,0 +1,126 @@ +{ don't edit, this file is generated from x86reg.dat } +NR_NO = tregister($00000000); +NR_AL = tregister($01010000); +NR_AH = tregister($01020000); +NR_AX = tregister($01030000); +NR_EAX = tregister($01040000); +NR_RAX = tregister($01050000); +NR_CL = tregister($01010001); +NR_CH = tregister($01020001); +NR_CX = tregister($01030001); +NR_ECX = tregister($01040001); +NR_RCX = tregister($01050001); +NR_DL = tregister($01010002); +NR_DH = tregister($01020002); +NR_DX = tregister($01030002); +NR_EDX = tregister($01040002); +NR_RDX = tregister($01050002); +NR_BL = tregister($01010003); +NR_BH = tregister($01020003); +NR_BX = tregister($01030003); +NR_EBX = tregister($01040003); +NR_RBX = tregister($01050003); +NR_SIL = tregister($01010004); +NR_SI = tregister($01030004); +NR_ESI = tregister($01040004); +NR_RSI = tregister($01050004); +NR_DIL = tregister($01010005); +NR_DI = tregister($01030005); +NR_EDI = tregister($01040005); +NR_RDI = tregister($01050005); +NR_BPL = tregister($01010006); +NR_BP = tregister($01030006); +NR_EBP = tregister($01040006); +NR_RBP = tregister($01050006); +NR_SPL = tregister($01010007); +NR_SP = tregister($01030007); +NR_ESP = tregister($01040007); +NR_RSP = tregister($01050007); +NR_R8 = tregister($01050008); +NR_R8L = tregister($01010008); +NR_R8W = tregister($01030008); +NR_R8D = tregister($01040008); +NR_R9 = tregister($01050009); +NR_R9L = tregister($01010009); +NR_R9W = tregister($01030009); +NR_R9D = tregister($01040009); +NR_R10 = tregister($0105000a); +NR_R10L = tregister($0101000a); +NR_R10W = tregister($0103000a); +NR_R10D = tregister($0104000a); +NR_R11 = tregister($0105000b); +NR_R11L = tregister($0101000b); +NR_R11W = tregister($0103000b); +NR_R11D = tregister($0104000b); +NR_R12 = tregister($0105000c); +NR_R12L = tregister($0101000c); +NR_R12W = tregister($0103000c); +NR_R12D = tregister($0104000c); +NR_R13 = tregister($0105000d); +NR_R13L = tregister($0101000d); +NR_R13W = tregister($0103000d); +NR_R13D = tregister($0104000d); +NR_R14 = tregister($0105000e); +NR_R14L = tregister($0101000e); +NR_R14W = tregister($0103000e); +NR_R14D = tregister($0104000e); +NR_R15 = tregister($0105000f); +NR_R15L = tregister($0101000f); +NR_R15W = tregister($0103000f); +NR_R15D = tregister($0104000f); +NR_RIP = tregister($05000000); +NR_EIP = tregister($05000000); +NR_CS = tregister($05000001); +NR_DS = tregister($05000002); +NR_ES = tregister($05000003); +NR_SS = tregister($05000004); +NR_FS = tregister($05000005); +NR_GS = tregister($05000006); +NR_DR0 = tregister($05000007); +NR_DR1 = tregister($05000008); +NR_DR2 = tregister($05000009); +NR_DR3 = tregister($0500000a); +NR_DR6 = tregister($0500000b); +NR_DR7 = tregister($0500000c); +NR_CR0 = tregister($0500000d); +NR_CR2 = tregister($0500000e); +NR_CR3 = tregister($0500000f); +NR_CR4 = tregister($05000010); +NR_TR3 = tregister($05000011); +NR_TR4 = tregister($05000012); +NR_TR5 = tregister($05000013); +NR_TR6 = tregister($05000014); +NR_TR7 = tregister($05000015); +NR_ST0 = tregister($02000000); +NR_ST1 = tregister($02000001); +NR_ST2 = tregister($02000002); +NR_ST3 = tregister($02000003); +NR_ST4 = tregister($02000004); +NR_ST5 = tregister($02000005); +NR_ST6 = tregister($02000006); +NR_ST7 = tregister($02000007); +NR_ST = tregister($02000008); +NR_MM0 = tregister($03000000); +NR_MM1 = tregister($03000001); +NR_MM2 = tregister($03000002); +NR_MM3 = tregister($03000003); +NR_MM4 = tregister($03000004); +NR_MM5 = tregister($03000005); +NR_MM6 = tregister($03000006); +NR_MM7 = tregister($03000007); +NR_XMM0 = tregister($04000000); +NR_XMM1 = tregister($04000001); +NR_XMM2 = tregister($04000002); +NR_XMM3 = tregister($04000003); +NR_XMM4 = tregister($04000004); +NR_XMM5 = tregister($04000005); +NR_XMM6 = tregister($04000006); +NR_XMM7 = tregister($04000007); +NR_XMM8 = tregister($04000008); +NR_XMM9 = tregister($04000009); +NR_XMM10 = tregister($0400000a); +NR_XMM11 = tregister($0400000b); +NR_XMM12 = tregister($0400000c); +NR_XMM13 = tregister($0400000d); +NR_XMM14 = tregister($0400000e); +NR_XMM15 = tregister($0400000f); diff --git a/closures/compiler/x86_64/r8664dwrf.inc b/closures/compiler/x86_64/r8664dwrf.inc new file mode 100644 index 0000000000..27f736cb5c --- /dev/null +++ b/closures/compiler/x86_64/r8664dwrf.inc @@ -0,0 +1,126 @@ +{ don't edit, this file is generated from x86reg.dat } +-1, +0, +0, +0, +0, +0, +2, +2, +2, +2, +2, +1, +1, +1, +1, +1, +3, +3, +3, +3, +3, +4, +4, +4, +4, +5, +5, +5, +5, +6, +6, +6, +6, +7, +7, +7, +7, +8, +8, +8, +8, +9, +9, +9, +9, +10, +10, +10, +10, +11, +11, +11, +11, +12, +12, +12, +12, +13, +13, +13, +13, +14, +14, +14, +14, +15, +15, +15, +15, +16, +16, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +33, +34, +35, +36, +37, +38, +39, +40, +33, +41, +42, +43, +44, +45, +46, +47, +48, +17, +18, +19, +20, +21, +22, +23, +24, +25, +26, +27, +28, +29, +30, +31, +32 diff --git a/closures/compiler/x86_64/r8664int.inc b/closures/compiler/x86_64/r8664int.inc new file mode 100644 index 0000000000..55ea578074 --- /dev/null +++ b/closures/compiler/x86_64/r8664int.inc @@ -0,0 +1,126 @@ +{ don't edit, this file is generated from x86reg.dat } +'INVALID', +'al', +'ah', +'ax', +'eax', +'rax', +'cl', +'ch', +'cx', +'ecx', +'rcx', +'dl', +'dh', +'dx', +'edx', +'rdx', +'bl', +'bh', +'bx', +'ebx', +'rbx', +'sil', +'si', +'esi', +'rsi', +'dil', +'di', +'edi', +'rdi', +'bpl', +'bp', +'ebp', +'rbp', +'spl', +'sp', +'esp', +'rsp', +'r8', +'r8b', +'r8w', +'r8d', +'r9', +'r9b', +'r9w', +'r9d', +'r10', +'r10b', +'r10w', +'r10d', +'r11', +'r11b', +'r11w', +'r11d', +'r12', +'r12b', +'r12w', +'r12d', +'r13', +'r13b', +'r13w', +'r13d', +'r14', +'r14b', +'r14w', +'r14d', +'r15', +'r15b', +'r15w', +'r15d', +'rip', +'eip', +'cs', +'ds', +'es', +'ss', +'fs', +'gs', +'dr0', +'dr1', +'dr2', +'dr3', +'dr6', +'dr7', +'cr0', +'cr2', +'cr3', +'cr4', +'tr3', +'tr4', +'tr5', +'tr6', +'tr7', +'st(0)', +'st(1)', +'st(2)', +'st(3)', +'st(4)', +'st(5)', +'st(6)', +'st(7)', +'st', +'mm0', +'mm1', +'mm2', +'mm3', +'mm4', +'mm5', +'mm6', +'mm7', +'xmm0', +'xmm1', +'xmm2', +'xmm3', +'xmm4', +'xmm5', +'xmm6', +'xmm7', +'xmm8', +'xmm9', +'xmm10', +'xmm11', +'xmm12', +'xmm13', +'xmm14', +'xmm15' diff --git a/closures/compiler/x86_64/r8664iri.inc b/closures/compiler/x86_64/r8664iri.inc new file mode 100644 index 0000000000..67d9df19f9 --- /dev/null +++ b/closures/compiler/x86_64/r8664iri.inc @@ -0,0 +1,126 @@ +{ don't edit, this file is generated from x86reg.dat } +0, +2, +1, +3, +17, +16, +30, +29, +18, +7, +6, +83, +84, +85, +86, +71, +8, +12, +26, +25, +11, +77, +78, +79, +80, +81, +82, +72, +13, +4, +31, +19, +9, +27, +14, +70, +73, +23, +35, +75, +76, +101, +102, +103, +104, +105, +106, +107, +108, +45, +46, +48, +47, +49, +50, +52, +51, +53, +54, +56, +55, +57, +58, +60, +59, +61, +62, +64, +63, +65, +66, +68, +67, +37, +38, +40, +39, +41, +42, +44, +43, +5, +32, +20, +10, +28, +15, +69, +24, +36, +22, +21, +34, +33, +74, +100, +92, +93, +94, +95, +96, +97, +98, +99, +87, +88, +89, +90, +91, +109, +110, +119, +120, +121, +122, +123, +124, +111, +112, +113, +114, +115, +116, +117, +118 diff --git a/closures/compiler/x86_64/r8664nor.inc b/closures/compiler/x86_64/r8664nor.inc new file mode 100644 index 0000000000..7b3502fb2e --- /dev/null +++ b/closures/compiler/x86_64/r8664nor.inc @@ -0,0 +1,2 @@ +{ don't edit, this file is generated from x86reg.dat } +125 diff --git a/closures/compiler/x86_64/r8664num.inc b/closures/compiler/x86_64/r8664num.inc new file mode 100644 index 0000000000..01e0b0dfa7 --- /dev/null +++ b/closures/compiler/x86_64/r8664num.inc @@ -0,0 +1,126 @@ +{ don't edit, this file is generated from x86reg.dat } +tregister($00000000), +tregister($01010000), +tregister($01020000), +tregister($01030000), +tregister($01040000), +tregister($01050000), +tregister($01010001), +tregister($01020001), +tregister($01030001), +tregister($01040001), +tregister($01050001), +tregister($01010002), +tregister($01020002), +tregister($01030002), +tregister($01040002), +tregister($01050002), +tregister($01010003), +tregister($01020003), +tregister($01030003), +tregister($01040003), +tregister($01050003), +tregister($01010004), +tregister($01030004), +tregister($01040004), +tregister($01050004), +tregister($01010005), +tregister($01030005), +tregister($01040005), +tregister($01050005), +tregister($01010006), +tregister($01030006), +tregister($01040006), +tregister($01050006), +tregister($01010007), +tregister($01030007), +tregister($01040007), +tregister($01050007), +tregister($01050008), +tregister($01010008), +tregister($01030008), +tregister($01040008), +tregister($01050009), +tregister($01010009), +tregister($01030009), +tregister($01040009), +tregister($0105000a), +tregister($0101000a), +tregister($0103000a), +tregister($0104000a), +tregister($0105000b), +tregister($0101000b), +tregister($0103000b), +tregister($0104000b), +tregister($0105000c), +tregister($0101000c), +tregister($0103000c), +tregister($0104000c), +tregister($0105000d), +tregister($0101000d), +tregister($0103000d), +tregister($0104000d), +tregister($0105000e), +tregister($0101000e), +tregister($0103000e), +tregister($0104000e), +tregister($0105000f), +tregister($0101000f), +tregister($0103000f), +tregister($0104000f), +tregister($05000000), +tregister($05000000), +tregister($05000001), +tregister($05000002), +tregister($05000003), +tregister($05000004), +tregister($05000005), +tregister($05000006), +tregister($05000007), +tregister($05000008), +tregister($05000009), +tregister($0500000a), +tregister($0500000b), +tregister($0500000c), +tregister($0500000d), +tregister($0500000e), +tregister($0500000f), +tregister($05000010), +tregister($05000011), +tregister($05000012), +tregister($05000013), +tregister($05000014), +tregister($05000015), +tregister($02000000), +tregister($02000001), +tregister($02000002), +tregister($02000003), +tregister($02000004), +tregister($02000005), +tregister($02000006), +tregister($02000007), +tregister($02000008), +tregister($03000000), +tregister($03000001), +tregister($03000002), +tregister($03000003), +tregister($03000004), +tregister($03000005), +tregister($03000006), +tregister($03000007), +tregister($04000000), +tregister($04000001), +tregister($04000002), +tregister($04000003), +tregister($04000004), +tregister($04000005), +tregister($04000006), +tregister($04000007), +tregister($04000008), +tregister($04000009), +tregister($0400000a), +tregister($0400000b), +tregister($0400000c), +tregister($0400000d), +tregister($0400000e), +tregister($0400000f) diff --git a/closures/compiler/x86_64/r8664op.inc b/closures/compiler/x86_64/r8664op.inc new file mode 100644 index 0000000000..2681385b44 --- /dev/null +++ b/closures/compiler/x86_64/r8664op.inc @@ -0,0 +1,126 @@ +{ don't edit, this file is generated from x86reg.dat } +0, +0, +4, +0, +0, +0, +1, +5, +1, +1, +1, +2, +6, +2, +2, +2, +3, +7, +3, +3, +3, +6, +6, +6, +6, +7, +7, +7, +7, +5, +5, +5, +5, +4, +4, +4, +4, +0, +0, +0, +0, +1, +1, +1, +1, +2, +2, +2, +2, +3, +3, +3, +3, +4, +4, +4, +4, +5, +5, +5, +5, +6, +6, +6, +6, +7, +7, +7, +7, +0, +0, +1, +3, +0, +2, +4, +5, +0, +1, +2, +3, +6, +7, +0, +2, +3, +4, +3, +4, +5, +6, +7, +0, +1, +2, +3, +4, +5, +6, +7, +0, +0, +1, +2, +3, +4, +5, +6, +7, +0, +1, +2, +3, +4, +5, +6, +7, +0, +1, +2, +3, +4, +5, +6, +7 diff --git a/closures/compiler/x86_64/r8664ot.inc b/closures/compiler/x86_64/r8664ot.inc new file mode 100644 index 0000000000..7db67465fe --- /dev/null +++ b/closures/compiler/x86_64/r8664ot.inc @@ -0,0 +1,126 @@ +{ don't edit, this file is generated from x86reg.dat } +OT_NONE, +OT_REG_AL, +OT_REG8, +OT_REG_AX, +OT_REG_EAX, +OT_REG_RAX, +OT_REG_CL, +OT_REG8, +OT_REG_CX, +OT_REG_ECX, +OT_REG_RCX, +OT_REG8, +OT_REG8, +OT_REG_DX, +OT_REG32, +OT_REG64, +OT_REG8, +OT_REG8, +OT_REG16, +OT_REG32, +OT_REG64, +OT_REG8, +OT_REG16, +OT_REG32, +OT_REG64, +OT_REG8, +OT_REG16, +OT_REG32, +OT_REG64, +OT_REG8, +OT_REG16, +OT_REG32, +OT_REG64, +OT_REG8, +OT_REG16, +OT_REG32, +OT_REG64, +OT_REG64, +OT_REG8, +OT_REG16, +OT_REG32, +OT_REG64, +OT_REG8, +OT_REG16, +OT_REG32, +OT_REG64, +OT_REG8, +OT_REG16, +OT_REG32, +OT_REG64, +OT_REG8, +OT_REG16, +OT_REG32, +OT_REG64, +OT_REG8, +OT_REG16, +OT_REG32, +OT_REG64, +OT_REG8, +OT_REG16, +OT_REG32, +OT_REG64, +OT_REG8, +OT_REG16, +OT_REG32, +OT_REG64, +OT_REG8, +OT_REG16, +OT_REG32, +OT_NONE, +OT_NONE, +OT_REG_CS, +OT_REG_DESS, +OT_REG_DESS, +OT_REG_DESS, +OT_REG_FSGS, +OT_REG_FSGS, +OT_REG_DREG, +OT_REG_DREG, +OT_REG_DREG, +OT_REG_DREG, +OT_REG_DREG, +OT_REG_DREG, +OT_REG_CREG, +OT_REG_CREG, +OT_REG_CREG, +OT_REG_CR4, +OT_REG_TREG, +OT_REG_TREG, +OT_REG_TREG, +OT_REG_TREG, +OT_REG_TREG, +OT_FPU0, +OT_FPUREG, +OT_FPUREG, +OT_FPUREG, +OT_FPUREG, +OT_FPUREG, +OT_FPUREG, +OT_FPUREG, +OT_FPU0, +OT_MMXREG, +OT_MMXREG, +OT_MMXREG, +OT_MMXREG, +OT_MMXREG, +OT_MMXREG, +OT_MMXREG, +OT_MMXREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG, +OT_XMMREG diff --git a/closures/compiler/x86_64/r8664rni.inc b/closures/compiler/x86_64/r8664rni.inc new file mode 100644 index 0000000000..3ab0a735ab --- /dev/null +++ b/closures/compiler/x86_64/r8664rni.inc @@ -0,0 +1,126 @@ +{ don't edit, this file is generated from x86reg.dat } +0, +1, +6, +11, +16, +21, +25, +29, +33, +38, +42, +46, +50, +54, +58, +62, +66, +2, +7, +12, +17, +3, +8, +13, +18, +22, +26, +30, +34, +39, +43, +47, +51, +55, +59, +63, +67, +4, +9, +14, +19, +23, +27, +31, +35, +40, +44, +48, +52, +56, +60, +64, +68, +5, +10, +15, +20, +24, +28, +32, +36, +37, +41, +45, +49, +53, +57, +61, +65, +92, +93, +94, +95, +96, +97, +98, +99, +100, +101, +102, +103, +104, +105, +106, +107, +108, +109, +110, +111, +112, +113, +114, +115, +116, +117, +118, +119, +120, +121, +122, +123, +124, +69, +70, +71, +72, +73, +74, +75, +76, +77, +78, +79, +80, +81, +82, +83, +84, +85, +86, +87, +88, +89, +90, +91 diff --git a/closures/compiler/x86_64/r8664sri.inc b/closures/compiler/x86_64/r8664sri.inc new file mode 100644 index 0000000000..67d9df19f9 --- /dev/null +++ b/closures/compiler/x86_64/r8664sri.inc @@ -0,0 +1,126 @@ +{ don't edit, this file is generated from x86reg.dat } +0, +2, +1, +3, +17, +16, +30, +29, +18, +7, +6, +83, +84, +85, +86, +71, +8, +12, +26, +25, +11, +77, +78, +79, +80, +81, +82, +72, +13, +4, +31, +19, +9, +27, +14, +70, +73, +23, +35, +75, +76, +101, +102, +103, +104, +105, +106, +107, +108, +45, +46, +48, +47, +49, +50, +52, +51, +53, +54, +56, +55, +57, +58, +60, +59, +61, +62, +64, +63, +65, +66, +68, +67, +37, +38, +40, +39, +41, +42, +44, +43, +5, +32, +20, +10, +28, +15, +69, +24, +36, +22, +21, +34, +33, +74, +100, +92, +93, +94, +95, +96, +97, +98, +99, +87, +88, +89, +90, +91, +109, +110, +119, +120, +121, +122, +123, +124, +111, +112, +113, +114, +115, +116, +117, +118 diff --git a/closures/compiler/x86_64/r8664stab.inc b/closures/compiler/x86_64/r8664stab.inc new file mode 100644 index 0000000000..27f736cb5c --- /dev/null +++ b/closures/compiler/x86_64/r8664stab.inc @@ -0,0 +1,126 @@ +{ don't edit, this file is generated from x86reg.dat } +-1, +0, +0, +0, +0, +0, +2, +2, +2, +2, +2, +1, +1, +1, +1, +1, +3, +3, +3, +3, +3, +4, +4, +4, +4, +5, +5, +5, +5, +6, +6, +6, +6, +7, +7, +7, +7, +8, +8, +8, +8, +9, +9, +9, +9, +10, +10, +10, +10, +11, +11, +11, +11, +12, +12, +12, +12, +13, +13, +13, +13, +14, +14, +14, +14, +15, +15, +15, +15, +16, +16, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +-1, +33, +34, +35, +36, +37, +38, +39, +40, +33, +41, +42, +43, +44, +45, +46, +47, +48, +17, +18, +19, +20, +21, +22, +23, +24, +25, +26, +27, +28, +29, +30, +31, +32 diff --git a/closures/compiler/x86_64/r8664std.inc b/closures/compiler/x86_64/r8664std.inc new file mode 100644 index 0000000000..55ea578074 --- /dev/null +++ b/closures/compiler/x86_64/r8664std.inc @@ -0,0 +1,126 @@ +{ don't edit, this file is generated from x86reg.dat } +'INVALID', +'al', +'ah', +'ax', +'eax', +'rax', +'cl', +'ch', +'cx', +'ecx', +'rcx', +'dl', +'dh', +'dx', +'edx', +'rdx', +'bl', +'bh', +'bx', +'ebx', +'rbx', +'sil', +'si', +'esi', +'rsi', +'dil', +'di', +'edi', +'rdi', +'bpl', +'bp', +'ebp', +'rbp', +'spl', +'sp', +'esp', +'rsp', +'r8', +'r8b', +'r8w', +'r8d', +'r9', +'r9b', +'r9w', +'r9d', +'r10', +'r10b', +'r10w', +'r10d', +'r11', +'r11b', +'r11w', +'r11d', +'r12', +'r12b', +'r12w', +'r12d', +'r13', +'r13b', +'r13w', +'r13d', +'r14', +'r14b', +'r14w', +'r14d', +'r15', +'r15b', +'r15w', +'r15d', +'rip', +'eip', +'cs', +'ds', +'es', +'ss', +'fs', +'gs', +'dr0', +'dr1', +'dr2', +'dr3', +'dr6', +'dr7', +'cr0', +'cr2', +'cr3', +'cr4', +'tr3', +'tr4', +'tr5', +'tr6', +'tr7', +'st(0)', +'st(1)', +'st(2)', +'st(3)', +'st(4)', +'st(5)', +'st(6)', +'st(7)', +'st', +'mm0', +'mm1', +'mm2', +'mm3', +'mm4', +'mm5', +'mm6', +'mm7', +'xmm0', +'xmm1', +'xmm2', +'xmm3', +'xmm4', +'xmm5', +'xmm6', +'xmm7', +'xmm8', +'xmm9', +'xmm10', +'xmm11', +'xmm12', +'xmm13', +'xmm14', +'xmm15' diff --git a/closures/compiler/x86_64/rax64att.pas b/closures/compiler/x86_64/rax64att.pas new file mode 100644 index 0000000000..5f5ac9ccf9 --- /dev/null +++ b/closures/compiler/x86_64/rax64att.pas @@ -0,0 +1,243 @@ +{ + Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman + + Does the parsing for the i386 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 rax64att; + +{$i fpcdefs.inc} + + interface + + uses + raatt,rax86att,aasmtai; + + type + tx8664attreader = class(tx86attreader) + actsehdirective: TAsmSehDirective; + procedure handleopcode;override; + function is_targetdirective(const s:string):boolean;override; + procedure handletargetdirective;override; + end; + + + implementation + + uses + cutils,globtype,rabase,systems,rax86,aasmcpu,cgbase,procinfo,symconst,verbose; + + procedure tx8664attreader.handleopcode; + var + instr : Tx86Instruction; + begin + instr:=Tx86attInstruction.Create(Tx86Operand); + instr.OpOrder:=op_att; + BuildOpcode(instr); + instr.AddReferenceSizes; + instr.SetInstructionOpsize; + instr.CheckOperandSizes; + instr.FixupOpcode; + instr.ConcatInstruction(curlist); + instr.Free; + end; + + const + { x86_64 subset of SEH directives. .seh_proc and .seh_endproc excluded + because they are generated automatically when needed. } + recognized_directives: set of TAsmSehDirective=[ + ash_endprologue,ash_handler,ash_handlerdata, + ash_setframe,ash_stackalloc,ash_pushreg, + ash_savereg,ash_savexmm,ash_pushframe + ]; + + { max offset and bitmask for .seh_savereg and .seh_setframe } + maxoffset: array[boolean] of aint=(high(dword), 240); + modulo: array[boolean] of integer=(7, 15); + + function tx8664attreader.is_targetdirective(const s:string):boolean; + var + i: TAsmSehDirective; + begin + result:=false; + if target_info.system<>system_x86_64_win64 then + exit; + + for i:=low(TAsmSehDirective) to high(TAsmSehDirective) do + begin + if not (i in recognized_directives) then + continue; + if s=sehdirectivestr[i] then + begin + actsehdirective:=i; + result:=true; + break; + end; + end; + { allow SEH directives only in pure assember routines } + if result and not (po_assembler in current_procinfo.procdef.procoptions) then + begin + Message(asmr_e_seh_in_pure_asm_only); + result:=false; + end; + end; + + procedure tx8664attreader.handletargetdirective; + var + hreg: TRegister; + hnum: aint; + flags: integer; + ai: tai_seh_directive; + hs: string; + err: boolean; + begin + if actasmtoken<>AS_TARGET_DIRECTIVE then + InternalError(2011100201); + Consume(AS_TARGET_DIRECTIVE); + Include(current_procinfo.flags,pi_has_unwind_info); + + case actsehdirective of + { TODO: .seh_pushframe is supposed to have a boolean parameter, + but GAS 2.21 does not support it. } + ash_endprologue, + ash_pushframe, + ash_handlerdata: + curlist.concat(cai_seh_directive.create(actsehdirective)); + + ash_handler: + begin + hs:=actasmpattern; + Consume(AS_ID); + flags:=0; + err:=false; + while actasmtoken=AS_COMMA do + begin + Consume(AS_COMMA); + if actasmtoken=AS_AT then + begin + Consume(AS_AT); + if actasmtoken=AS_ID then + begin + uppervar(actasmpattern); + if actasmpattern='EXCEPT' then + flags:=flags or 1 + else if actasmpattern='UNWIND' then + flags:=flags or 2 + else + err:=true; + Consume(AS_ID); + end + else + err:=true; + end + else + err:=true; + if err then + begin + Message(asmr_e_syntax_error); + RecoverConsume(false); + exit; + end; + end; + + ai:=cai_seh_directive.create_name(ash_handler,hs); + ai.data.flags:=flags; + curlist.concat(ai); + end; + ash_stackalloc: + begin + hnum:=BuildConstExpression(false,false); + if (hnum<0) or (hnum>high(dword)) or ((hnum and 7)<>0) then + Message1(asmr_e_bad_seh_directive_offset,sehdirectivestr[ash_stackalloc]) + else + curlist.concat(cai_seh_directive.create_offset(ash_stackalloc,hnum)); + end; + ash_pushreg: + begin + hreg:=actasmregister; + Consume(AS_REGISTER); + if (getregtype(hreg)<>R_INTREGISTER) or (getsubreg(hreg)<>R_SUBQ) then + Message1(asmr_e_bad_seh_directive_register,sehdirectivestr[ash_pushreg]) + else + curlist.concat(cai_seh_directive.create_reg(ash_pushreg,hreg)); + end; + ash_setframe, + ash_savereg: + begin + hreg:=actasmregister; + Consume(AS_REGISTER); + if (getregtype(hreg)<>R_INTREGISTER) or (getsubreg(hreg)<>R_SUBQ) then + Message1(asmr_e_bad_seh_directive_register,sehdirectivestr[actsehdirective]); + Consume(AS_COMMA); + hnum:=BuildConstExpression(false,false); + if (hnum<0) or (hnum>maxoffset[actsehdirective=ash_setframe]) or + ((hnum mod modulo[actsehdirective=ash_setframe])<>0) then + Message1(asmr_e_bad_seh_directive_offset,sehdirectivestr[actsehdirective]) + else + curlist.concat(cai_seh_directive.create_reg_offset(actsehdirective,hreg,hnum)); + end; + ash_savexmm: + begin + hreg:=actasmregister; + Consume(AS_REGISTER); + if (getregtype(hreg)<>R_MMREGISTER) then + Message1(asmr_e_bad_seh_directive_register,sehdirectivestr[ash_savexmm]); + Consume(AS_COMMA); + hnum:=BuildConstExpression(false,false); + if (hnum<0) or (hnum>high(dword)) or ((hnum and 15)<>0) then + Message1(asmr_e_bad_seh_directive_offset,sehdirectivestr[ash_savexmm]) + else + curlist.concat(cai_seh_directive.create_reg_offset(actsehdirective,hreg,hnum)); + end; + + else + InternalError(2011100202); + end; + if actasmtoken<>AS_SEPARATOR then + Consume(AS_SEPARATOR); + end; + + +const + asmmode_x86_64_gas_info : tasmmodeinfo = + ( + id : asmmode_x86_64_gas; + idtxt : 'GAS'; + casmreader : tx8664attreader; + ); + + { Added to be compatible with i386 } + asmmode_x86_64_att_info : tasmmodeinfo = + ( + id : asmmode_x86_64_att; + idtxt : 'ATT'; + casmreader : tx8664attreader; + ); + + asmmode_x86_64_standard_info : tasmmodeinfo = + ( + id : asmmode_standard; + idtxt : 'STANDARD'; + casmreader : tx8664attreader; + ); + +initialization + RegisterAsmMode(asmmode_x86_64_gas_info); + RegisterAsmMode(asmmode_x86_64_att_info); + RegisterAsmMode(asmmode_x86_64_standard_info); +end. diff --git a/closures/compiler/x86_64/rax64int.pas b/closures/compiler/x86_64/rax64int.pas new file mode 100644 index 0000000000..0241cde5e6 --- /dev/null +++ b/closures/compiler/x86_64/rax64int.pas @@ -0,0 +1,70 @@ +{ + Copyright (c) 1998-2006 by Carl Eric Codere and Peter Vreman + + Does the parsing for the x86-64 intel 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 rax64int; + +{$i fpcdefs.inc} + + interface + + uses + rax86int; + + type + tx8664intreader = class(tx86intreader) + // procedure handleopcode;override; + end; + + + implementation + + uses + rabase,systems,rax86,aasmcpu; + +(* + procedure tx8664intreader.handleopcode; + var + instr : Tx86Instruction; + begin + instr:=Tx86Instruction.Create(Tx86Operand); + instr.OpOrder:=op_att; + BuildOpcode(instr); + instr.AddReferenceSizes; + instr.SetInstructionOpsize; + { + instr.CheckOperandSizes; + } + instr.ConcatInstruction(curlist); + instr.Free; + end; +*) + +const + asmmode_x86_64_intel_info : tasmmodeinfo = + ( + id : asmmode_x86_64_intel; + idtxt : 'INTEL'; + casmreader : tx8664intreader; + ); + +initialization + RegisterAsmMode(asmmode_x86_64_intel_info); +end. diff --git a/closures/compiler/x86_64/rgcpu.pas b/closures/compiler/x86_64/rgcpu.pas new file mode 100644 index 0000000000..566d15aa41 --- /dev/null +++ b/closures/compiler/x86_64/rgcpu.pas @@ -0,0 +1,53 @@ +{ + Copyright (c) 1998-2002 by Florian Klaempfl + + This unit implements the x86-64 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 + cgbase,rgx86; + + type + trgcpu = class(trgx86) + procedure add_constraints(reg:Tregister); override; + end; + + implementation + + uses + cpubase; + + procedure trgcpu.add_constraints(reg:Tregister); + var + supreg : tsuperregister; + begin + supreg:=getsupreg(reg); + { All registers conflict with rsp/rbp } + add_edge(supreg,RS_RSP); + add_edge(supreg,RS_RBP); + end; + +end. diff --git a/closures/compiler/x86_64/win64unw.pas b/closures/compiler/x86_64/win64unw.pas new file mode 100644 index 0000000000..63ca259fee --- /dev/null +++ b/closures/compiler/x86_64/win64unw.pas @@ -0,0 +1,408 @@ +{ + Copyright (c) 2011 by Free Pascal development team + + Support for win64 unwind data + + 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 win64unw; + +{$i fpcdefs.inc} + +interface + +uses + cclasses,globtype,aasmbase,aasmdata,aasmtai,cgbase,ogbase; + +type + TWin64CFI=class + private + FFrameOffs, FFrameReg: Integer; + FFlags: Integer; + FHandler: TObjSymbol; + FCount: Integer; + FElements:TLinkedList; + FFrameStartSym:TObjSymbol; + FFrameStartSec:TObjSection; + FXdataSym:TObjSymbol; + FXdataSec:TObjSection; + FPrologueEndPos:aword; + FPrologueEndSeen:Boolean; + FName: pshortstring; + procedure AddElement(objdata:TObjData;aCode,aInfo:Integer;aOffs:dword); + public + constructor create; + destructor destroy;override; + procedure generate_prologue_data(objdata:TObjData); + procedure start_frame(objdata:TObjData; const name: string); + procedure end_frame(objdata:TObjData); + procedure end_prologue(objdata:TObjData); + procedure push_reg(objdata:TObjData;reg:tregister); + procedure save_reg(objdata:TObjData;reg:tregister;ofs:dword); + procedure save_xmm(objdata:TObjData;reg:tregister;ofs:dword); + procedure set_frame(objdata:TObjData; reg:tregister;ofs:dword); + procedure stack_alloc(objdata:TObjData;ofs:dword); + procedure switch_to_handlerdata(objdata:TObjData); + end; + + +implementation + +uses + cutils,globals,verbose,cpubase; + +const + UWOP_PUSH_NONVOL = 0; { info = register number } + UWOP_ALLOC_LARGE = 1; { no info, alloc size in next 2 slots } + UWOP_ALLOC_SMALL = 2; { info = size of allocation / 8 - 1 } + UWOP_SET_FPREG = 3; { no info, FP = RSP + UNWIND_INFO.FPRegOffset*16 } + UWOP_SAVE_NONVOL = 4; { info = register number, offset in next slot } + UWOP_SAVE_NONVOL_FAR = 5; { info = register number, offset in next 2 slots } + UWOP_SAVE_XMM = 6; + UWOP_SAVE_XMM_FAR = 7; + UWOP_SAVE_XMM128 = 8; { info = XMM reg number, offset in next slot } + UWOP_SAVE_XMM128_FAR = 9; { info = XMM reg number, offset in next 2 slots } + UWOP_PUSH_MACHFRAME = 10; { info = 0: no error-code, 1: error-code } + + UNW_FLAG_EHANDLER = $01; { exceptiion handler } + UNW_FLAG_UHANDLER = $02; { termination handler } + UNW_FLAG_FHANDLER = UNW_FLAG_EHANDLER or UNW_FLAG_UHANDLER; + UNW_FLAG_CHAININFO = $04; { mutually exclusive with the above } + + +type + tai_seh_directive_x64=class(tai_seh_directive) + procedure generate_code(objdata:TObjData);override; + end; + + TPrologueElement=class(TLinkedListItem) + public + opcode: Integer; { =(info shl 4) or code } + ofs: dword; + addr: aword; + end; + +var + current_unw: TWin64Cfi; + +function EncodeReg(r: TRegister): integer; +begin + case r of + NR_RAX: result:=0; + NR_RCX: result:=1; + NR_RDX: result:=2; + NR_RBX: result:=3; + NR_RSP: result:=4; + NR_RBP: result:=5; + NR_RSI: result:=6; + NR_RDI: result:=7; + NR_R8: result:=8; + NR_R9: result:=9; + NR_R10: result:=10; + NR_R11: result:=11; + NR_R12: result:=12; + NR_R13: result:=13; + NR_R14: result:=14; + NR_R15: result:=15; + else + InternalError(2011072305); + end; +end; + +function EncodeXMM(r: TRegister): integer; +begin + if getregtype(r)=R_MMREGISTER then + result:=getsupreg(r) + else + InternalError(2011072308); +end; + + +{ TWin64CFI } + +constructor TWin64CFI.create; +begin + inherited create; + FElements:=TLinkedList.Create; +end; + +destructor TWin64CFI.destroy; +begin + FElements.Free; + stringdispose(FName); + inherited destroy; +end; + +procedure TWin64CFI.AddElement(objdata:TObjData;aCode,aInfo:Integer;aOffs:dword); +var + el:TPrologueElement; +begin + el:=TPrologueElement.Create; + FElements.concat(el); + el.opcode:=(aInfo shl 4) or aCode; + el.ofs:=aOffs; + el.addr:=objdata.CurrObjSec.Size; + + { a single element may occupy 1,2 or 3 word-sized slots } + case aCode of + UWOP_ALLOC_LARGE: + Inc(FCount,2+ord(aInfo<>0)); + + UWOP_SAVE_NONVOL_FAR, + UWOP_SAVE_XMM128_FAR: + Inc(FCount,3); + + UWOP_SAVE_NONVOL, + UWOP_SAVE_XMM128: + Inc(FCount,2); + + else + inc(FCount); + end; +end; + +{ Changes objdata.CurrObjSec to .xdata, so generation of + handler data may continue } +procedure TWin64CFI.generate_prologue_data(objdata:TObjData); +var + hp: TPrologueElement; + uwcode: array [0..1] of byte; + uwdata: array [0..3] of byte; + zero: word; +begin + if FCount>255 then + InternalError(2011072301); + if not FPrologueEndSeen then + CGMessage(asmw_e_missing_endprologue); + if (FPrologueEndPos-FFrameStartSym.address) > 255 then + CGMessage(asmw_e_prologue_too_large); + if codegenerror then + exit; + + FXdataSec:=objdata.createsection('.xdata.n_'+lower(FName^),4,[oso_data,oso_load]); + FXdataSym:=objdata.symboldefine('$unwind$'+FName^,AB_GLOBAL,AT_DATA); + uwdata[0]:=(FFlags shl 3) or 1; + uwdata[1]:=FPrologueEndPos-FFrameStartSym.address; + uwdata[2]:=FCount; + { Offset is multiple of 16, so it is already shifted into correct position } + uwdata[3]:=FFrameOffs or FFrameReg; + objdata.writebytes(uwdata,4); + + { write elements in reverse order (offset descending) } + hp:=TPrologueElement(FElements.Last); + while Assigned(hp) do + begin + uwcode[0]:=hp.addr-FFrameStartSym.address; + uwcode[1]:=hp.opcode; + objdata.writebytes(uwcode,2); + case hp.opcode and $0F of + UWOP_PUSH_NONVOL, + UWOP_ALLOC_SMALL, + UWOP_SET_FPREG, + UWOP_PUSH_MACHFRAME: ; { These have no extra data } + + UWOP_ALLOC_LARGE: + if (hp.opcode and $F0)<>0 then + objdata.writebytes(hp.ofs,4) + else + objdata.writebytes(hp.ofs,2); + + UWOP_SAVE_NONVOL_FAR, + UWOP_SAVE_XMM128_FAR: + objdata.writebytes(hp.ofs,4); + + UWOP_SAVE_NONVOL, + UWOP_SAVE_XMM128: + objdata.writebytes(hp.ofs,2); + else + InternalError(2011072302); + end; + + hp:=TPrologueElement(hp.Previous); + end; + { pad with zeros to dword boundary } + zero:=0; + if odd(FCount) then + objdata.writebytes(zero,2); + if Assigned(FHandler) then + objdata.writereloc(0,sizeof(longint),FHandler,RELOC_RVA); +end; + +procedure TWin64CFI.start_frame(objdata:TObjData;const name:string); +begin + if assigned(FName) then + internalerror(2011072306); + FName:=stringdup(name); + FFrameStartSym:=objdata.symbolref(name); + FFrameStartSec:=objdata.CurrObjSec; + FCount:=0; + FFrameReg:=0; + FFrameOffs:=0; + FPrologueEndPos:=0; + FPrologueEndSeen:=false; + FHandler:=nil; + FXdataSec:=nil; + FXdataSym:=nil; + FFlags:=0; +end; + +procedure TWin64CFI.switch_to_handlerdata(objdata:TObjData); +begin + if not assigned(FName) then + internalerror(2011072310); + + if FHandler=nil then + CGMessage(asmw_e_handlerdata_no_handler); + + if FXdataSec=nil then + generate_prologue_data(objdata) + else + objdata.SetSection(FXdataSec); +end; + +procedure TWin64CFI.end_frame(objdata:TObjData); +var + pdatasym:TObjSymbol; +begin + if not assigned(FName) then + internalerror(2011072307); + + if FXdataSec=nil then + generate_prologue_data(objdata); + + if not codegenerror then + begin + objdata.createsection(sec_pdata,lower(FName^)); + pdatasym:=objdata.symboldefine('$pdata$'+FName^,AB_LOCAL,AT_DATA); + objdata.writereloc(0,4,FFrameStartSym,RELOC_RVA); + objdata.writereloc(FFrameStartSec.Size,4,FFrameStartSym,RELOC_RVA); + objdata.writereloc(0,4,FXdataSym,RELOC_RVA); + { restore previous state } + objdata.SetSection(FFrameStartSec); + { create a dummy relocation, so pdata is not smartlinked away } + objdata.writereloc(0,0,pdatasym,RELOC_NONE); + end; + FElements.Clear; + FFrameStartSym:=nil; + FHandler:=nil; + FXdataSec:=nil; + FXdataSym:=nil; + FFlags:=0; + stringdispose(FName); +end; + +procedure TWin64CFI.end_prologue(objdata:TObjData); +begin + if not assigned(FName) then + internalerror(2011072312); + FPrologueEndPos:=objdata.CurrObjSec.Size; + FPrologueEndSeen:=true; +end; + +procedure TWin64CFI.push_reg(objdata:TObjData;reg:tregister); +begin + AddElement(objdata,UWOP_PUSH_NONVOL,EncodeReg(reg),0); +end; + +procedure TWin64CFI.save_reg(objdata:TObjData;reg:tregister;ofs:dword); +var + info: Integer; +begin + info:=EncodeReg(reg); + if ((ofs and 7) = 0) and (ofs<=$ffff*8) then + AddElement(objdata,UWOP_SAVE_NONVOL,info,ofs shr 3) + else + AddElement(objdata,UWOP_SAVE_NONVOL_FAR,info,ofs); +end; + +procedure TWin64CFI.save_xmm(objdata:TObjData;reg:tregister;ofs:dword); +var + info: Integer; +begin + info:=EncodeXMM(reg); + if ((ofs and 15)=0) and (ofs<=$ffff*16) then + AddElement(objdata,UWOP_SAVE_XMM128, info, ofs shr 4) + else + AddElement(objdata,UWOP_SAVE_XMM128_FAR, info, ofs); +end; + +procedure TWin64CFI.set_frame(objdata:TObjData;reg:tregister;ofs:dword); +var + info: Integer; +begin + info:=EncodeReg(reg); + if FFrameReg<>0 then + InternalError(2011072303); + if info=0 then { frame register cannot be RAX } + InternalError(2011072304); + if (ofs>240) or ((ofs and 15)<>0) then + InternalError(2011072310); + FFrameReg:=info; + FFrameOffs:=ofs; + { !! looks like docs aren't correct and info should be set to register } + AddElement(objdata,UWOP_SET_FPREG,0,0); +end; + +procedure TWin64CFI.stack_alloc(objdata:TObjData;ofs:dword); +begin + if ((ofs and 7)=0) and (ofs<=128) then + AddElement(objdata,UWOP_ALLOC_SMALL,(ofs-8) shr 3,0) + else if ((ofs and 7) = 0) and (ofs<=$ffff * 8) then + AddElement(objdata,UWOP_ALLOC_LARGE,0,ofs shr 3) + else + AddElement(objdata,UWOP_ALLOC_LARGE,1,ofs); +end; + +procedure tai_seh_directive_x64.generate_code(objdata:TObjData); +begin + case kind of + ash_proc: + current_unw.start_frame(objdata,data.name^); + ash_endproc: + current_unw.end_frame(objdata); + ash_endprologue: + current_unw.end_prologue(objdata); + ash_handler: + begin + current_unw.FHandler:=objdata.symbolref(data.name^); + current_unw.FFlags:=data.flags; + end; + ash_handlerdata: + current_unw.switch_to_handlerdata(objdata); + ash_eh,ash_32,ash_no32: ; { these are not for x86_64 } + ash_setframe: + current_unw.set_frame(objdata,data.reg,data.offset); + ash_stackalloc: + current_unw.stack_alloc(objdata,data.offset); + ash_pushreg: + current_unw.push_reg(objdata,data.reg); + ash_savereg: + current_unw.save_reg(objdata,data.reg,data.offset); + ash_savexmm: + current_unw.save_xmm(objdata,data.reg,data.offset); + ash_pushframe: {TBD}; + end; +end; + + +initialization + cai_seh_directive:=tai_seh_directive_x64; + current_unw:=TWin64CFI.Create; +finalization + current_unw.Free; +end. + diff --git a/closures/compiler/x86_64/x8664ats.inc b/closures/compiler/x86_64/x8664ats.inc new file mode 100644 index 0000000000..31bc9cd421 --- /dev/null +++ b/closures/compiler/x86_64/x8664ats.inc @@ -0,0 +1,688 @@ +{ don't edit, this file is generated from x86ins.dat } +( +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufNONE, +attsufNONE, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufNONE, +attsufNONE, +attsufNONE, +attsufFPUint, +attsufFPUint, +attsufFPUint, +attsufFPUint, +attsufFPUint, +attsufFPUint, +attsufFPUint, +attsufNONE, +attsufNONE, +attsufFPUint, +attsufFPUint, +attsufFPUint, +attsufFPUint, +attsufFPUint, +attsufFPU, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufFPU, +attsufFPU, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufFPU, +attsufINT, +attsufNONE, +attsufFPU, +attsufINT, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufNONE, +attsufFPU, +attsufFPU, +attsufFPU, +attsufFPU, +attsufNONE, +attsufNONE, +attsufNONE, +attsufFPU, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufINT, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufINT, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINTdual, +attsufINTdual, +attsufINT, +attsufNONE, +attsufINT, +attsufNONE, +attsufINT, +attsufINT, +attsufINT, +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, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufINT, +attsufINT, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufINT, +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, +attsufINT, +attsufINT, +attsufNONE, +attsufINT, +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, +attsufINT, +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, +attsufINT, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +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, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +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, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufINT, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE, +attsufNONE +); diff --git a/closures/compiler/x86_64/x8664att.inc b/closures/compiler/x86_64/x8664att.inc new file mode 100644 index 0000000000..a591dad220 --- /dev/null +++ b/closures/compiler/x86_64/x8664att.inc @@ -0,0 +1,688 @@ +{ don't edit, this file is generated from x86ins.dat } +( +'none', +'aaa', +'aad', +'aam', +'aas', +'adc', +'add', +'and', +'arpl', +'bound', +'bsf', +'bsr', +'bswap', +'bt', +'btc', +'btr', +'bts', +'call', +'cbtw', +'cltd', +'clc', +'cld', +'cli', +'clts', +'cmc', +'cmp', +'cmpsb', +'cmpsl', +'cmpsw', +'cmpxchg', +'cmpxchg486', +'cmpxchg8b', +'cpuid', +'cwd', +'cwtl', +'daa', +'das', +'dec', +'div', +'emms', +'enter', +'f2xm1', +'fabs', +'fadd', +'faddp', +'fbld', +'fbstp', +'fchs', +'fclex', +'fcmovb', +'fcmovbe', +'fcmove', +'fcmovnb', +'fcmovnbe', +'fcmovne', +'fcmovnu', +'fcmovu', +'fcom', +'fcomi', +'fcomip', +'fcomp', +'fcompp', +'fcos', +'fdecstp', +'fdisi', +'fdiv', +'fdivp', +'fdivr', +'fdivrp', +'femms', +'feni', +'ffree', +'fiadd', +'ficom', +'ficomp', +'fidiv', +'fidivr', +'fild', +'fimul', +'fincstp', +'finit', +'fist', +'fistp', +'fisttp', +'fisub', +'fisubr', +'fld', +'fld1', +'fldcw', +'fldenv', +'fldl2e', +'fldl2t', +'fldlg2', +'fldln2', +'fldpi', +'fldz', +'fmul', +'fmulp', +'fnclex', +'fndisi', +'fneni', +'fninit', +'fnop', +'fnsave', +'fnstcw', +'fnstenv', +'fnstsw', +'fpatan', +'fprem', +'fprem1', +'fptan', +'frndint', +'frstor', +'fsave', +'fscale', +'fsetpm', +'fsin', +'fsincos', +'fsqrt', +'fst', +'fstcw', +'fstenv', +'fstp', +'fstsw', +'fsub', +'fsubp', +'fsubr', +'fsubrp', +'ftst', +'fucom', +'fucomi', +'fucomip', +'fucomp', +'fucompp', +'fwait', +'fxam', +'fxch', +'fxtract', +'fyl2x', +'fyl2xp1', +'hlt', +'ibts', +'icebp', +'idiv', +'imul', +'in', +'inc', +'insb', +'insl', +'insw', +'int', +'int01', +'int1', +'int03', +'int3', +'into', +'invd', +'invlpg', +'iret', +'iret', +'iretw', +'iretq', +'jcxz', +'jecxz', +'jrcxz', +'jmp', +'lahf', +'lar', +'lcall', +'lds', +'lea', +'leave', +'les', +'lfs', +'lgdt', +'lgs', +'lidt', +'ljmp', +'lldt', +'lmsw', +'loadall', +'loadall286', +'lock', +'lodsb', +'lodsl', +'lodsw', +'loop', +'loope', +'loopne', +'loopnz', +'loopz', +'lsl', +'lss', +'ltr', +'monitor', +'mov', +'movd', +'movq', +'movsb', +'movsl', +'movsq', +'movsw', +'movs', +'movz', +'mul', +'mwait', +'neg', +'nop', +'not', +'or', +'out', +'outsb', +'outsl', +'outsw', +'packssdw', +'packsswb', +'packuswb', +'paddb', +'paddd', +'paddsb', +'paddsiw', +'paddsw', +'paddusb', +'paddusw', +'paddw', +'pand', +'pandn', +'paveb', +'pavgusb', +'pcmpeqb', +'pcmpeqd', +'pcmpeqw', +'pcmpgtb', +'pcmpgtd', +'pcmpgtw', +'pdistib', +'pf2id', +'pfacc', +'pfadd', +'pfcmpeq', +'pfcmpge', +'pfcmpgt', +'pfmax', +'pfmin', +'pfmul', +'pfrcp', +'pfrcpit1', +'pfrcpit2', +'pfrsqit1', +'pfrsqrt', +'pfsub', +'pfsubr', +'pi2fd', +'pmachriw', +'pmaddwd', +'pmagw', +'pmulhriw', +'pmulhrwa', +'pmulhrwc', +'pmulhw', +'pmullw', +'pmvgezb', +'pmvlzb', +'pmvnzb', +'pmvzb', +'pop', +'popa', +'popal', +'popaw', +'popf', +'popfl', +'popfw', +'popfq', +'por', +'prefetch', +'prefetchw', +'pslld', +'pslldq', +'psllq', +'psllw', +'psrad', +'psraw', +'psrld', +'psrlq', +'psrlw', +'psubb', +'psubd', +'psubsb', +'psubsiw', +'psubsw', +'psubusb', +'psubusw', +'psubw', +'punpckhbw', +'punpckhdq', +'punpckhwd', +'punpcklbw', +'punpckldq', +'punpcklwd', +'push', +'pusha', +'pushal', +'pushaw', +'pushf', +'pushfl', +'pushfw', +'pushfq', +'pxor', +'rcl', +'rcr', +'rdshr', +'rdmsr', +'rdpmc', +'rdtsc', +'rep', +'repe', +'repne', +'repnz', +'repz', +'ret', +'lret', +'ret', +'rol', +'ror', +'rsdc', +'rsldt', +'rsm', +'sahf', +'sal', +'salc', +'sar', +'sbb', +'scasb', +'scasl', +'scasq', +'scasw', +'cs', +'ds', +'es', +'fs', +'gs', +'ss', +'sgdt', +'shl', +'shld', +'shr', +'shrd', +'sidt', +'sldt', +'smi', +'smint', +'smintold', +'smsw', +'stc', +'std', +'sti', +'stosb', +'stosl', +'stosw', +'str', +'sub', +'svdc', +'svldt', +'svts', +'syscall', +'sysenter', +'sysexit', +'sysret', +'test', +'ud1', +'ud2', +'umov', +'verr', +'verw', +'wait', +'wbinvd', +'wrshr', +'wrmsr', +'xadd', +'xbts', +'xchg', +'xlat', +'xlatb', +'xor', +'xstore', +'xcryptecb', +'xcryptcbc', +'xcryptcfb', +'xcryptofb', +'cmov', +'j', +'set', +'addps', +'addss', +'andnps', +'andps', +'cmpeqps', +'cmpeqss', +'cmpleps', +'cmpless', +'cmpltps', +'cmpltss', +'cmpneqps', +'cmpneqss', +'cmpnleps', +'cmpnless', +'cmpnltps', +'cmpnltss', +'cmpordps', +'cmpordss', +'cmpunordps', +'cmpunordss', +'cmpps', +'cmpss', +'comiss', +'cvtpi2ps', +'cvtps2pi', +'cvtsi2ss', +'cvtss2si', +'cvttps2pi', +'cvttss2si', +'divps', +'divss', +'ldmxcsr', +'maxps', +'maxss', +'minps', +'minss', +'movaps', +'movhps', +'movlhps', +'movlps', +'movhlps', +'movmskps', +'movntps', +'movss', +'movups', +'mulps', +'mulss', +'orps', +'rcpps', +'rcpss', +'rsqrtps', +'rsqrtss', +'shufps', +'sqrtps', +'sqrtss', +'stmxcsr', +'subps', +'subss', +'ucomiss', +'unpckhps', +'unpcklps', +'xorps', +'fxrstor', +'fxsave', +'prefetchnta', +'prefetcht0', +'prefetcht1', +'prefetcht2', +'sfence', +'maskmovq', +'movntq', +'pavgb', +'pavgw', +'pextrw', +'pinsrw', +'pmaxsw', +'pmaxub', +'pminsw', +'pminub', +'pmovmskb', +'pmulhuw', +'psadbw', +'pshufw', +'pfnacc', +'pfpnacc', +'pi2fw', +'pf2iw', +'pswapd', +'ffreep', +'maskmovdqu', +'clflush', +'movntdq', +'movnti', +'movntpd', +'pause', +'lfence', +'mfence', +'movdqa', +'movdqu', +'movdq2q', +'movq2dq', +'paddq', +'pmuludq', +'pshufd', +'pshufhw', +'pshuflw', +'psrldq', +'psubq', +'punpckhqdq', +'punpcklqdq', +'addpd', +'addsd', +'andnpd', +'andpd', +'cmpeqpd', +'cmpeqsd', +'cmplepd', +'cmplesd', +'cmpltpd', +'cmpltsd', +'cmpneqpd', +'cmpneqsd', +'cmpnlepd', +'cmpnlesd', +'cmpnltpd', +'cmpnltsd', +'cmpordpd', +'cmpordsd', +'cmpunordpd', +'cmpunordsd', +'cmppd', +'comisd', +'cvtdq2pd', +'cvtdq2ps', +'cvtpd2dq', +'cvtpd2pi', +'cvtpd2ps', +'cvtpi2pd', +'cvtps2dq', +'cvtps2pd', +'cvtsd2si', +'cvtsd2ss', +'cvtsi2sd', +'cvtss2sd', +'cvttpd2pi', +'cvttpd2dq', +'cvttps2dq', +'cvttsd2si', +'divpd', +'divsd', +'maxpd', +'maxsd', +'minpd', +'minsd', +'movapd', +'movhpd', +'movlpd', +'movmskpd', +'movupd', +'mulpd', +'mulsd', +'orpd', +'shufpd', +'sqrtpd', +'sqrtsd', +'subpd', +'subsd', +'ucomisd', +'unpckhpd', +'unpcklpd', +'xorpd', +'addsubpd', +'addsubps', +'haddpd', +'haddps', +'hsubpd', +'hsubps', +'lddqu', +'movddup', +'movshdup', +'movsldup', +'vmread', +'vmwrite', +'vmcall', +'vmlaunch', +'vmresume', +'vmxoff', +'vmxon', +'vmclear', +'vmptrld', +'vmptrst', +'vmrun', +'vmmcall', +'vmload', +'vmsave', +'stgi', +'clgi', +'skinit', +'invlpga', +'montmul', +'xsha1', +'xsha256', +'dmint', +'rdm', +'movabs', +'movslq', +'cqto', +'cmpxchg16b', +'movntss', +'movntsd', +'insertq', +'extrq', +'lzcnt', +'pabsb', +'pabsw', +'pabsd', +'palignr', +'phaddw', +'phaddd', +'phaddsw', +'phsubw', +'phsubd', +'phsubsw', +'pmaddubsw', +'pmulhrsw', +'pshufb', +'psignb', +'psignw', +'psignd', +'blendps', +'blendpd', +'blendvps', +'blendvpd', +'dpps', +'dppd', +'extractps', +'insertps', +'movntdqa', +'mpsadbw', +'packusdw', +'pblendvb', +'pblendw', +'pcmpeqq', +'pextrb', +'pextrd', +'pextrq', +'phminposuw', +'pinsrb', +'pinsrd', +'pinsrq', +'pmaxsb', +'pmaxsd', +'pmaxud', +'pmaxuw', +'pminsb', +'pminsd', +'pminuw', +'pminud', +'pmovsxbw', +'pmovsxbd', +'pmovsxbq', +'pmovsxwd', +'pmovsxwq', +'pmovsxdq', +'pmovzxbw', +'pmovzxbd', +'pmovzxbq', +'pmovzxwd', +'pmovzxwq', +'pmovzxdq', +'pmuldq', +'pmulld', +'ptest', +'roundps', +'roundpd', +'roundss', +'roundsd', +'crc32', +'pcmpestri', +'pcmpestrm', +'pcmpistri', +'pcmpistrm', +'pcmpgtq', +'popcnt', +'aesenc', +'aesenclast', +'aesdec', +'aesdeclast', +'aesimc', +'aeskeygenassist', +'stosq', +'lodsq', +'cmpsq' +); diff --git a/closures/compiler/x86_64/x8664int.inc b/closures/compiler/x86_64/x8664int.inc new file mode 100644 index 0000000000..b6cc4caa78 --- /dev/null +++ b/closures/compiler/x86_64/x8664int.inc @@ -0,0 +1,688 @@ +{ don't edit, this file is generated from x86ins.dat } +( +'none', +'aaa', +'aad', +'aam', +'aas', +'adc', +'add', +'and', +'arpl', +'bound', +'bsf', +'bsr', +'bswap', +'bt', +'btc', +'btr', +'bts', +'call', +'cbw', +'cdq', +'clc', +'cld', +'cli', +'clts', +'cmc', +'cmp', +'cmpsb', +'cmpsd', +'cmpsw', +'cmpxchg', +'cmpxchg486', +'cmpxchg8b', +'cpuid', +'cwd', +'cwde', +'daa', +'das', +'dec', +'div', +'emms', +'enter', +'f2xm1', +'fabs', +'fadd', +'faddp', +'fbld', +'fbstp', +'fchs', +'fclex', +'fcmovb', +'fcmovbe', +'fcmove', +'fcmovnb', +'fcmovnbe', +'fcmovne', +'fcmovnu', +'fcmovu', +'fcom', +'fcomi', +'fcomip', +'fcomp', +'fcompp', +'fcos', +'fdecstp', +'fdisi', +'fdiv', +'fdivp', +'fdivr', +'fdivrp', +'femms', +'feni', +'ffree', +'fiadd', +'ficom', +'ficomp', +'fidiv', +'fidivr', +'fild', +'fimul', +'fincstp', +'finit', +'fist', +'fistp', +'fisttp', +'fisub', +'fisubr', +'fld', +'fld1', +'fldcw', +'fldenv', +'fldl2e', +'fldl2t', +'fldlg2', +'fldln2', +'fldpi', +'fldz', +'fmul', +'fmulp', +'fnclex', +'fndisi', +'fneni', +'fninit', +'fnop', +'fnsave', +'fnstcw', +'fnstenv', +'fnstsw', +'fpatan', +'fprem', +'fprem1', +'fptan', +'frndint', +'frstor', +'fsave', +'fscale', +'fsetpm', +'fsin', +'fsincos', +'fsqrt', +'fst', +'fstcw', +'fstenv', +'fstp', +'fstsw', +'fsub', +'fsubp', +'fsubr', +'fsubrp', +'ftst', +'fucom', +'fucomi', +'fucomip', +'fucomp', +'fucompp', +'fwait', +'fxam', +'fxch', +'fxtract', +'fyl2x', +'fyl2xp1', +'hlt', +'ibts', +'icebp', +'idiv', +'imul', +'in', +'inc', +'insb', +'insd', +'insw', +'int', +'int01', +'int1', +'int03', +'int3', +'into', +'invd', +'invlpg', +'iret', +'iretd', +'iretw', +'iretq', +'jcxz', +'jecxz', +'jrcxz', +'jmp', +'lahf', +'lar', +'lcall', +'lds', +'lea', +'leave', +'les', +'lfs', +'lgdt', +'lgs', +'lidt', +'ljmp', +'lldt', +'lmsw', +'loadall', +'loadall286', +'lock', +'lodsb', +'lodsd', +'lodsw', +'loop', +'loope', +'loopne', +'loopnz', +'loopz', +'lsl', +'lss', +'ltr', +'monitor', +'mov', +'movd', +'movq', +'movsb', +'movsd', +'movsq', +'movsw', +'movsx', +'movzx', +'mul', +'mwait', +'neg', +'nop', +'not', +'or', +'out', +'outsb', +'outsd', +'outsw', +'packssdw', +'packsswb', +'packuswb', +'paddb', +'paddd', +'paddsb', +'paddsiw', +'paddsw', +'paddusb', +'paddusw', +'paddw', +'pand', +'pandn', +'paveb', +'pavgusb', +'pcmpeqb', +'pcmpeqd', +'pcmpeqw', +'pcmpgtb', +'pcmpgtd', +'pcmpgtw', +'pdistib', +'pf2id', +'pfacc', +'pfadd', +'pfcmpeq', +'pfcmpge', +'pfcmpgt', +'pfmax', +'pfmin', +'pfmul', +'pfrcp', +'pfrcpit1', +'pfrcpit2', +'pfrsqit1', +'pfrsqrt', +'pfsub', +'pfsubr', +'pi2fd', +'pmachriw', +'pmaddwd', +'pmagw', +'pmulhriw', +'pmulhrwa', +'pmulhrwc', +'pmulhw', +'pmullw', +'pmvgezb', +'pmvlzb', +'pmvnzb', +'pmvzb', +'pop', +'popa', +'popad', +'popaw', +'popf', +'popfd', +'popfw', +'popfq', +'por', +'prefetch', +'prefetchw', +'pslld', +'pslldq', +'psllq', +'psllw', +'psrad', +'psraw', +'psrld', +'psrlq', +'psrlw', +'psubb', +'psubd', +'psubsb', +'psubsiw', +'psubsw', +'psubusb', +'psubusw', +'psubw', +'punpckhbw', +'punpckhdq', +'punpckhwd', +'punpcklbw', +'punpckldq', +'punpcklwd', +'push', +'pusha', +'pushad', +'pushaw', +'pushf', +'pushfd', +'pushfw', +'pushfq', +'pxor', +'rcl', +'rcr', +'rdshr', +'rdmsr', +'rdpmc', +'rdtsc', +'rep', +'repe', +'repne', +'repnz', +'repz', +'ret', +'retf', +'retn', +'rol', +'ror', +'rsdc', +'rsldt', +'rsm', +'sahf', +'sal', +'salc', +'sar', +'sbb', +'scasb', +'scasd', +'scasq', +'scasw', +'segcs', +'segds', +'seges', +'segfs', +'seggs', +'segss', +'sgdt', +'shl', +'shld', +'shr', +'shrd', +'sidt', +'sldt', +'smi', +'smint', +'smintold', +'smsw', +'stc', +'std', +'sti', +'stosb', +'stosd', +'stosw', +'str', +'sub', +'svdc', +'svldt', +'svts', +'syscall', +'sysenter', +'sysexit', +'sysret', +'test', +'ud1', +'ud2', +'umov', +'verr', +'verw', +'wait', +'wbinvd', +'wrshr', +'wrmsr', +'xadd', +'xbts', +'xchg', +'xlat', +'xlatb', +'xor', +'xstore', +'xcryptecb', +'xcryptcbc', +'xcryptcfb', +'xcryptofb', +'cmov', +'j', +'set', +'addps', +'addss', +'andnps', +'andps', +'cmpeqps', +'cmpeqss', +'cmpleps', +'cmpless', +'cmpltps', +'cmpltss', +'cmpneqps', +'cmpneqss', +'cmpnleps', +'cmpnless', +'cmpnltps', +'cmpnltss', +'cmpordps', +'cmpordss', +'cmpunordps', +'cmpunordss', +'cmpps', +'cmpss', +'comiss', +'cvtpi2ps', +'cvtps2pi', +'cvtsi2ss', +'cvtss2si', +'cvttps2pi', +'cvttss2si', +'divps', +'divss', +'ldmxcsr', +'maxps', +'maxss', +'minps', +'minss', +'movaps', +'movhps', +'movlhps', +'movlps', +'movhlps', +'movmskps', +'movntps', +'movss', +'movups', +'mulps', +'mulss', +'orps', +'rcpps', +'rcpss', +'rsqrtps', +'rsqrtss', +'shufps', +'sqrtps', +'sqrtss', +'stmxcsr', +'subps', +'subss', +'ucomiss', +'unpckhps', +'unpcklps', +'xorps', +'fxrstor', +'fxsave', +'prefetchnta', +'prefetcht0', +'prefetcht1', +'prefetcht2', +'sfence', +'maskmovq', +'movntq', +'pavgb', +'pavgw', +'pextrw', +'pinsrw', +'pmaxsw', +'pmaxub', +'pminsw', +'pminub', +'pmovmskb', +'pmulhuw', +'psadbw', +'pshufw', +'pfnacc', +'pfpnacc', +'pi2fw', +'pf2iw', +'pswapd', +'ffreep', +'maskmovdqu', +'clflush', +'movntdq', +'movnti', +'movntpd', +'pause', +'lfence', +'mfence', +'movdqa', +'movdqu', +'movdq2q', +'movq2dq', +'paddq', +'pmuludq', +'pshufd', +'pshufhw', +'pshuflw', +'psrldq', +'psubq', +'punpckhqdq', +'punpcklqdq', +'addpd', +'addsd', +'andnpd', +'andpd', +'cmpeqpd', +'cmpeqsd', +'cmplepd', +'cmplesd', +'cmpltpd', +'cmpltsd', +'cmpneqpd', +'cmpneqsd', +'cmpnlepd', +'cmpnlesd', +'cmpnltpd', +'cmpnltsd', +'cmpordpd', +'cmpordsd', +'cmpunordpd', +'cmpunordsd', +'cmppd', +'comisd', +'cvtdq2pd', +'cvtdq2ps', +'cvtpd2dq', +'cvtpd2pi', +'cvtpd2ps', +'cvtpi2pd', +'cvtps2dq', +'cvtps2pd', +'cvtsd2si', +'cvtsd2ss', +'cvtsi2sd', +'cvtss2sd', +'cvttpd2pi', +'cvttpd2dq', +'cvttps2dq', +'cvttsd2si', +'divpd', +'divsd', +'maxpd', +'maxsd', +'minpd', +'minsd', +'movapd', +'movhpd', +'movlpd', +'movmskpd', +'movupd', +'mulpd', +'mulsd', +'orpd', +'shufpd', +'sqrtpd', +'sqrtsd', +'subpd', +'subsd', +'ucomisd', +'unpckhpd', +'unpcklpd', +'xorpd', +'addsubpd', +'addsubps', +'haddpd', +'haddps', +'hsubpd', +'hsubps', +'lddqu', +'movddup', +'movshdup', +'movsldup', +'vmread', +'vmwrite', +'vmcall', +'vmlaunch', +'vmresume', +'vmxoff', +'vmxon', +'vmclear', +'vmptrld', +'vmptrst', +'vmrun', +'vmmcall', +'vmload', +'vmsave', +'stgi', +'clgi', +'skinit', +'invlpga', +'montmul', +'xsha1', +'xsha256', +'dmint', +'rdm', +'movabs', +'movsxd', +'cqo', +'cmpxchg16b', +'movntss', +'movntsd', +'insertq', +'extrq', +'lzcnt', +'pabsb', +'pabsw', +'pabsd', +'palignr', +'phaddw', +'phaddd', +'phaddsw', +'phsubw', +'phsubd', +'phsubsw', +'pmaddubsw', +'pmulhrsw', +'pshufb', +'psignb', +'psignw', +'psignd', +'blendps', +'blendpd', +'blendvps', +'blendvpd', +'dpps', +'dppd', +'extractps', +'insertps', +'movntdqa', +'mpsadbw', +'packusdw', +'pblendvb', +'pblendw', +'pcmpeqq', +'pextrb', +'pextrd', +'pextrq', +'phminposuw', +'pinsrb', +'pinsrd', +'pinsrq', +'pmaxsb', +'pmaxsd', +'pmaxud', +'pmaxuw', +'pminsb', +'pminsd', +'pminuw', +'pminud', +'pmovsxbw', +'pmovsxbd', +'pmovsxbq', +'pmovsxwd', +'pmovsxwq', +'pmovsxdq', +'pmovzxbw', +'pmovzxbd', +'pmovzxbq', +'pmovzxwd', +'pmovzxwq', +'pmovzxdq', +'pmuldq', +'pmulld', +'ptest', +'roundps', +'roundpd', +'roundss', +'roundsd', +'crc32', +'pcmpestri', +'pcmpestrm', +'pcmpistri', +'pcmpistrm', +'pcmpgtq', +'popcnt', +'aesenc', +'aesenclast', +'aesdec', +'aesdeclast', +'aesimc', +'aeskeygenassist', +'stosq', +'lodsq', +'cmpsq' +); diff --git a/closures/compiler/x86_64/x8664nop.inc b/closures/compiler/x86_64/x8664nop.inc new file mode 100644 index 0000000000..011999b15f --- /dev/null +++ b/closures/compiler/x86_64/x8664nop.inc @@ -0,0 +1,2 @@ +{ don't edit, this file is generated from x86ins.dat } +1215; diff --git a/closures/compiler/x86_64/x8664op.inc b/closures/compiler/x86_64/x8664op.inc new file mode 100644 index 0000000000..4070734e54 --- /dev/null +++ b/closures/compiler/x86_64/x8664op.inc @@ -0,0 +1,688 @@ +{ don't edit, this file is generated from x86ins.dat } +( +A_NONE, +A_AAA, +A_AAD, +A_AAM, +A_AAS, +A_ADC, +A_ADD, +A_AND, +A_ARPL, +A_BOUND, +A_BSF, +A_BSR, +A_BSWAP, +A_BT, +A_BTC, +A_BTR, +A_BTS, +A_CALL, +A_CBW, +A_CDQ, +A_CLC, +A_CLD, +A_CLI, +A_CLTS, +A_CMC, +A_CMP, +A_CMPSB, +A_CMPSD, +A_CMPSW, +A_CMPXCHG, +A_CMPXCHG486, +A_CMPXCHG8B, +A_CPUID, +A_CWD, +A_CWDE, +A_DAA, +A_DAS, +A_DEC, +A_DIV, +A_EMMS, +A_ENTER, +A_F2XM1, +A_FABS, +A_FADD, +A_FADDP, +A_FBLD, +A_FBSTP, +A_FCHS, +A_FCLEX, +A_FCMOVB, +A_FCMOVBE, +A_FCMOVE, +A_FCMOVNB, +A_FCMOVNBE, +A_FCMOVNE, +A_FCMOVNU, +A_FCMOVU, +A_FCOM, +A_FCOMI, +A_FCOMIP, +A_FCOMP, +A_FCOMPP, +A_FCOS, +A_FDECSTP, +A_FDISI, +A_FDIV, +A_FDIVP, +A_FDIVR, +A_FDIVRP, +A_FEMMS, +A_FENI, +A_FFREE, +A_FIADD, +A_FICOM, +A_FICOMP, +A_FIDIV, +A_FIDIVR, +A_FILD, +A_FIMUL, +A_FINCSTP, +A_FINIT, +A_FIST, +A_FISTP, +A_FISTTP, +A_FISUB, +A_FISUBR, +A_FLD, +A_FLD1, +A_FLDCW, +A_FLDENV, +A_FLDL2E, +A_FLDL2T, +A_FLDLG2, +A_FLDLN2, +A_FLDPI, +A_FLDZ, +A_FMUL, +A_FMULP, +A_FNCLEX, +A_FNDISI, +A_FNENI, +A_FNINIT, +A_FNOP, +A_FNSAVE, +A_FNSTCW, +A_FNSTENV, +A_FNSTSW, +A_FPATAN, +A_FPREM, +A_FPREM1, +A_FPTAN, +A_FRNDINT, +A_FRSTOR, +A_FSAVE, +A_FSCALE, +A_FSETPM, +A_FSIN, +A_FSINCOS, +A_FSQRT, +A_FST, +A_FSTCW, +A_FSTENV, +A_FSTP, +A_FSTSW, +A_FSUB, +A_FSUBP, +A_FSUBR, +A_FSUBRP, +A_FTST, +A_FUCOM, +A_FUCOMI, +A_FUCOMIP, +A_FUCOMP, +A_FUCOMPP, +A_FWAIT, +A_FXAM, +A_FXCH, +A_FXTRACT, +A_FYL2X, +A_FYL2XP1, +A_HLT, +A_IBTS, +A_ICEBP, +A_IDIV, +A_IMUL, +A_IN, +A_INC, +A_INSB, +A_INSD, +A_INSW, +A_INT, +A_INT01, +A_INT1, +A_INT03, +A_INT3, +A_INTO, +A_INVD, +A_INVLPG, +A_IRET, +A_IRETD, +A_IRETW, +A_IRETQ, +A_JCXZ, +A_JECXZ, +A_JRCXZ, +A_JMP, +A_LAHF, +A_LAR, +A_LCALL, +A_LDS, +A_LEA, +A_LEAVE, +A_LES, +A_LFS, +A_LGDT, +A_LGS, +A_LIDT, +A_LJMP, +A_LLDT, +A_LMSW, +A_LOADALL, +A_LOADALL286, +A_LOCK, +A_LODSB, +A_LODSD, +A_LODSW, +A_LOOP, +A_LOOPE, +A_LOOPNE, +A_LOOPNZ, +A_LOOPZ, +A_LSL, +A_LSS, +A_LTR, +A_MONITOR, +A_MOV, +A_MOVD, +A_MOVQ, +A_MOVSB, +A_MOVSD, +A_MOVSQ, +A_MOVSW, +A_MOVSX, +A_MOVZX, +A_MUL, +A_MWAIT, +A_NEG, +A_NOP, +A_NOT, +A_OR, +A_OUT, +A_OUTSB, +A_OUTSD, +A_OUTSW, +A_PACKSSDW, +A_PACKSSWB, +A_PACKUSWB, +A_PADDB, +A_PADDD, +A_PADDSB, +A_PADDSIW, +A_PADDSW, +A_PADDUSB, +A_PADDUSW, +A_PADDW, +A_PAND, +A_PANDN, +A_PAVEB, +A_PAVGUSB, +A_PCMPEQB, +A_PCMPEQD, +A_PCMPEQW, +A_PCMPGTB, +A_PCMPGTD, +A_PCMPGTW, +A_PDISTIB, +A_PF2ID, +A_PFACC, +A_PFADD, +A_PFCMPEQ, +A_PFCMPGE, +A_PFCMPGT, +A_PFMAX, +A_PFMIN, +A_PFMUL, +A_PFRCP, +A_PFRCPIT1, +A_PFRCPIT2, +A_PFRSQIT1, +A_PFRSQRT, +A_PFSUB, +A_PFSUBR, +A_PI2FD, +A_PMACHRIW, +A_PMADDWD, +A_PMAGW, +A_PMULHRIW, +A_PMULHRWA, +A_PMULHRWC, +A_PMULHW, +A_PMULLW, +A_PMVGEZB, +A_PMVLZB, +A_PMVNZB, +A_PMVZB, +A_POP, +A_POPA, +A_POPAD, +A_POPAW, +A_POPF, +A_POPFD, +A_POPFW, +A_POPFQ, +A_POR, +A_PREFETCH, +A_PREFETCHW, +A_PSLLD, +A_PSLLDQ, +A_PSLLQ, +A_PSLLW, +A_PSRAD, +A_PSRAW, +A_PSRLD, +A_PSRLQ, +A_PSRLW, +A_PSUBB, +A_PSUBD, +A_PSUBSB, +A_PSUBSIW, +A_PSUBSW, +A_PSUBUSB, +A_PSUBUSW, +A_PSUBW, +A_PUNPCKHBW, +A_PUNPCKHDQ, +A_PUNPCKHWD, +A_PUNPCKLBW, +A_PUNPCKLDQ, +A_PUNPCKLWD, +A_PUSH, +A_PUSHA, +A_PUSHAD, +A_PUSHAW, +A_PUSHF, +A_PUSHFD, +A_PUSHFW, +A_PUSHFQ, +A_PXOR, +A_RCL, +A_RCR, +A_RDSHR, +A_RDMSR, +A_RDPMC, +A_RDTSC, +A_REP, +A_REPE, +A_REPNE, +A_REPNZ, +A_REPZ, +A_RET, +A_RETF, +A_RETN, +A_ROL, +A_ROR, +A_RSDC, +A_RSLDT, +A_RSM, +A_SAHF, +A_SAL, +A_SALC, +A_SAR, +A_SBB, +A_SCASB, +A_SCASD, +A_SCASQ, +A_SCASW, +A_SEGCS, +A_SEGDS, +A_SEGES, +A_SEGFS, +A_SEGGS, +A_SEGSS, +A_SGDT, +A_SHL, +A_SHLD, +A_SHR, +A_SHRD, +A_SIDT, +A_SLDT, +A_SMI, +A_SMINT, +A_SMINTOLD, +A_SMSW, +A_STC, +A_STD, +A_STI, +A_STOSB, +A_STOSD, +A_STOSW, +A_STR, +A_SUB, +A_SVDC, +A_SVLDT, +A_SVTS, +A_SYSCALL, +A_SYSENTER, +A_SYSEXIT, +A_SYSRET, +A_TEST, +A_UD1, +A_UD2, +A_UMOV, +A_VERR, +A_VERW, +A_WAIT, +A_WBINVD, +A_WRSHR, +A_WRMSR, +A_XADD, +A_XBTS, +A_XCHG, +A_XLAT, +A_XLATB, +A_XOR, +A_XSTORE, +A_XCRYPTECB, +A_XCRYPTCBC, +A_XCRYPTCFB, +A_XCRYPTOFB, +A_CMOVcc, +A_Jcc, +A_SETcc, +A_ADDPS, +A_ADDSS, +A_ANDNPS, +A_ANDPS, +A_CMPEQPS, +A_CMPEQSS, +A_CMPLEPS, +A_CMPLESS, +A_CMPLTPS, +A_CMPLTSS, +A_CMPNEQPS, +A_CMPNEQSS, +A_CMPNLEPS, +A_CMPNLESS, +A_CMPNLTPS, +A_CMPNLTSS, +A_CMPORDPS, +A_CMPORDSS, +A_CMPUNORDPS, +A_CMPUNORDSS, +A_CMPPS, +A_CMPSS, +A_COMISS, +A_CVTPI2PS, +A_CVTPS2PI, +A_CVTSI2SS, +A_CVTSS2SI, +A_CVTTPS2PI, +A_CVTTSS2SI, +A_DIVPS, +A_DIVSS, +A_LDMXCSR, +A_MAXPS, +A_MAXSS, +A_MINPS, +A_MINSS, +A_MOVAPS, +A_MOVHPS, +A_MOVLHPS, +A_MOVLPS, +A_MOVHLPS, +A_MOVMSKPS, +A_MOVNTPS, +A_MOVSS, +A_MOVUPS, +A_MULPS, +A_MULSS, +A_ORPS, +A_RCPPS, +A_RCPSS, +A_RSQRTPS, +A_RSQRTSS, +A_SHUFPS, +A_SQRTPS, +A_SQRTSS, +A_STMXCSR, +A_SUBPS, +A_SUBSS, +A_UCOMISS, +A_UNPCKHPS, +A_UNPCKLPS, +A_XORPS, +A_FXRSTOR, +A_FXSAVE, +A_PREFETCHNTA, +A_PREFETCHT0, +A_PREFETCHT1, +A_PREFETCHT2, +A_SFENCE, +A_MASKMOVQ, +A_MOVNTQ, +A_PAVGB, +A_PAVGW, +A_PEXTRW, +A_PINSRW, +A_PMAXSW, +A_PMAXUB, +A_PMINSW, +A_PMINUB, +A_PMOVMSKB, +A_PMULHUW, +A_PSADBW, +A_PSHUFW, +A_PFNACC, +A_PFPNACC, +A_PI2FW, +A_PF2IW, +A_PSWAPD, +A_FFREEP, +A_MASKMOVDQU, +A_CLFLUSH, +A_MOVNTDQ, +A_MOVNTI, +A_MOVNTPD, +A_PAUSE, +A_LFENCE, +A_MFENCE, +A_MOVDQA, +A_MOVDQU, +A_MOVDQ2Q, +A_MOVQ2DQ, +A_PADDQ, +A_PMULUDQ, +A_PSHUFD, +A_PSHUFHW, +A_PSHUFLW, +A_PSRLDQ, +A_PSUBQ, +A_PUNPCKHQDQ, +A_PUNPCKLQDQ, +A_ADDPD, +A_ADDSD, +A_ANDNPD, +A_ANDPD, +A_CMPEQPD, +A_CMPEQSD, +A_CMPLEPD, +A_CMPLESD, +A_CMPLTPD, +A_CMPLTSD, +A_CMPNEQPD, +A_CMPNEQSD, +A_CMPNLEPD, +A_CMPNLESD, +A_CMPNLTPD, +A_CMPNLTSD, +A_CMPORDPD, +A_CMPORDSD, +A_CMPUNORDPD, +A_CMPUNORDSD, +A_CMPPD, +A_COMISD, +A_CVTDQ2PD, +A_CVTDQ2PS, +A_CVTPD2DQ, +A_CVTPD2PI, +A_CVTPD2PS, +A_CVTPI2PD, +A_CVTPS2DQ, +A_CVTPS2PD, +A_CVTSD2SI, +A_CVTSD2SS, +A_CVTSI2SD, +A_CVTSS2SD, +A_CVTTPD2PI, +A_CVTTPD2DQ, +A_CVTTPS2DQ, +A_CVTTSD2SI, +A_DIVPD, +A_DIVSD, +A_MAXPD, +A_MAXSD, +A_MINPD, +A_MINSD, +A_MOVAPD, +A_MOVHPD, +A_MOVLPD, +A_MOVMSKPD, +A_MOVUPD, +A_MULPD, +A_MULSD, +A_ORPD, +A_SHUFPD, +A_SQRTPD, +A_SQRTSD, +A_SUBPD, +A_SUBSD, +A_UCOMISD, +A_UNPCKHPD, +A_UNPCKLPD, +A_XORPD, +A_ADDSUBPD, +A_ADDSUBPS, +A_HADDPD, +A_HADDPS, +A_HSUBPD, +A_HSUBPS, +A_LDDQU, +A_MOVDDUP, +A_MOVSHDUP, +A_MOVSLDUP, +A_VMREAD, +A_VMWRITE, +A_VMCALL, +A_VMLAUNCH, +A_VMRESUME, +A_VMXOFF, +A_VMXON, +A_VMCLEAR, +A_VMPTRLD, +A_VMPTRST, +A_VMRUN, +A_VMMCALL, +A_VMLOAD, +A_VMSAVE, +A_STGI, +A_CLGI, +A_SKINIT, +A_INVLPGA, +A_MONTMUL, +A_XSHA1, +A_XSHA256, +A_DMINT, +A_RDM, +A_MOVABS, +A_MOVSXD, +A_CQO, +A_CMPXCHG16B, +A_MOVNTSS, +A_MOVNTSD, +A_INSERTQ, +A_EXTRQ, +A_LZCNT, +A_PABSB, +A_PABSW, +A_PABSD, +A_PALIGNR, +A_PHADDW, +A_PHADDD, +A_PHADDSW, +A_PHSUBW, +A_PHSUBD, +A_PHSUBSW, +A_PMADDUBSW, +A_PMULHRSW, +A_PSHUFB, +A_PSIGNB, +A_PSIGNW, +A_PSIGND, +A_BLENDPS, +A_BLENDPD, +A_BLENDVPS, +A_BLENDVPD, +A_DPPS, +A_DPPD, +A_EXTRACTPS, +A_INSERTPS, +A_MOVNTDQA, +A_MPSADBW, +A_PACKUSDW, +A_PBLENDVB, +A_PBLENDW, +A_PCMPEQQ, +A_PEXTRB, +A_PEXTRD, +A_PEXTRQ, +A_PHMINPOSUW, +A_PINSRB, +A_PINSRD, +A_PINSRQ, +A_PMAXSB, +A_PMAXSD, +A_PMAXUD, +A_PMAXUW, +A_PMINSB, +A_PMINSD, +A_PMINUW, +A_PMINUD, +A_PMOVSXBW, +A_PMOVSXBD, +A_PMOVSXBQ, +A_PMOVSXWD, +A_PMOVSXWQ, +A_PMOVSXDQ, +A_PMOVZXBW, +A_PMOVZXBD, +A_PMOVZXBQ, +A_PMOVZXWD, +A_PMOVZXWQ, +A_PMOVZXDQ, +A_PMULDQ, +A_PMULLD, +A_PTEST, +A_ROUNDPS, +A_ROUNDPD, +A_ROUNDSS, +A_ROUNDSD, +A_CRC32, +A_PCMPESTRI, +A_PCMPESTRM, +A_PCMPISTRI, +A_PCMPISTRM, +A_PCMPGTQ, +A_POPCNT, +A_AESENC, +A_AESENCLAST, +A_AESDEC, +A_AESDECLAST, +A_AESIMC, +A_AESKEYGENASSIST, +A_STOSQ, +A_LODSQ, +A_CMPSQ +); diff --git a/closures/compiler/x86_64/x8664pro.inc b/closures/compiler/x86_64/x8664pro.inc new file mode 100644 index 0000000000..4a8f2f7fa4 --- /dev/null +++ b/closures/compiler/x86_64/x8664pro.inc @@ -0,0 +1,688 @@ +{ don't edit, this file is generated from x86ins.dat } +( +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_MEAX, Ch_WFlags, Ch_None)), +(Ch: (Ch_MEAX, Ch_WFlags, Ch_None)), +(Ch: (Ch_MEAX, Ch_WFlags, Ch_None)), +(Ch: (Ch_MEAX, Ch_WFlags, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_RWFlags)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_WFlags, Ch_None, Ch_None)), +(Ch: (Ch_Rop1, Ch_None, Ch_None)), +(Ch: (Ch_Wop2, Ch_WFlags, Ch_Rop1)), +(Ch: (Ch_Wop2, Ch_WFlags, Ch_Rop1)), +(Ch: (Ch_MOp1, Ch_None, Ch_None)), +(Ch: (Ch_WFlags, Ch_Rop1, Ch_Rop2)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_ROp1, Ch_All, Ch_None)), +(Ch: (Ch_MEAX, Ch_None, Ch_None)), +(Ch: (Ch_MEAX, Ch_WEDX, Ch_None)), +(Ch: (Ch_WFlags, Ch_None, Ch_None)), +(Ch: (Ch_CDirFlag, Ch_None, Ch_None)), +(Ch: (Ch_WFlags, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_WFlags, Ch_None, Ch_None)), +(Ch: (Ch_ROp1, Ch_ROp2, Ch_WFlags)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_none)), +(Ch: (Ch_MEAX, Ch_WEDX, Ch_None)), +(Ch: (Ch_MEAX, Ch_None, Ch_None)), +(Ch: (Ch_MEAX, Ch_None, Ch_None)), +(Ch: (Ch_MEAX, Ch_None, Ch_None)), +(Ch: (Ch_Mop1, Ch_WFlags, Ch_None)), +(Ch: (Ch_RWEAX, Ch_WEDX, Ch_WFlags)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_RWESP, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_Rop1, Ch_FPU, Ch_None)), +(Ch: (Ch_Wop1, Ch_FPU, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_WFLAGS, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_WFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_FPU, Ch_ROp1, Ch_None)), +(Ch: (Ch_Rop1, Ch_FPU, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_ROp1, Ch_FPU, Ch_None)), +(Ch: (Ch_ROp1, Ch_FPU, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_FPU, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_ROp1, Ch_FPU, Ch_None)), +(Ch: (Ch_ROp1, Ch_FPU, Ch_None)), +(Ch: (Ch_ROp1, Ch_FPU, Ch_None)), +(Ch: (Ch_ROp1, Ch_FPU, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_WFLAGS, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_WFLAGS, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_FPU, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_RWEAX, Ch_WEDX, Ch_WFlags)), +(Ch: (Ch_RWEAX, Ch_WEDX, Ch_WFlags)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop1, Ch_WFlags, Ch_None)), +(Ch: (Ch_WMemEDI, Ch_RWEDI, Ch_REDX)), +(Ch: (Ch_WMemEDI, Ch_RWEDI, Ch_REDX)), +(Ch: (Ch_WMemEDI, Ch_RWEDI, Ch_REDX)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_RECX, Ch_None, Ch_None)), +(Ch: (Ch_RECX, Ch_None, Ch_None)), +(Ch: (Ch_RECX, Ch_None, Ch_None)), +(Ch: (Ch_ROp1, Ch_None, Ch_None)), +(Ch: (Ch_WEAX, Ch_RFlags, Ch_None)), +(Ch: (Ch_Wop2, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_RWESP, Ch_WEBP, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_ROp1, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_WEAX, Ch_RWESI, Ch_None)), +(Ch: (Ch_WEAX, Ch_RWESI, Ch_None)), +(Ch: (Ch_WEAX, Ch_RWESI, Ch_None)), +(Ch: (Ch_RWECX, Ch_None, Ch_None)), +(Ch: (Ch_RWECX, Ch_RFlags, Ch_None)), +(Ch: (Ch_RWECX, Ch_RFlags, Ch_None)), +(Ch: (Ch_RWECX, Ch_RFlags, Ch_None)), +(Ch: (Ch_RWECX, Ch_RFlags, Ch_None)), +(Ch: (Ch_Wop2, Ch_WFlags, Ch_None)), +(Ch: (Ch_Wop2, Ch_ROP1, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Rop1, Ch_Wop2, Ch_None)), +(Ch: (Ch_Rop1, Ch_Wop2, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_RWEAX, Ch_WEDX, Ch_WFlags)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_Mop1, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_Mop1, Ch_WFlags, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_Rop1, Ch_Rop2, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_RWESP, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_RWESP, Ch_WFlags, Ch_None)), +(Ch: (Ch_RWESP, Ch_WFlags, Ch_None)), +(Ch: (Ch_RWESP, Ch_WFLAGS, Ch_None)), +(Ch: (Ch_RWESP, Ch_WFlags, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Rop1, Ch_RWESP, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_RWESP, Ch_RFlags, Ch_None)), +(Ch: (Ch_RWESP, Ch_RFlags, Ch_None)), +(Ch: (Ch_RWESP, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_RWESP, Ch_RFlags, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_RWFlags)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_RWFlags)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_WEAX, Ch_WEDX, Ch_None)), +(Ch: (Ch_WEAX, Ch_WEDX, Ch_None)), +(Ch: (Ch_WEAX, Ch_WEDX, Ch_None)), +(Ch: (Ch_RWECX, Ch_RWFlags, Ch_None)), +(Ch: (Ch_RWECX, Ch_RWFlags, Ch_None)), +(Ch: (Ch_RWECX, Ch_RWFlags, Ch_None)), +(Ch: (Ch_RWECX, Ch_RWFLAGS, Ch_None)), +(Ch: (Ch_RWECX, Ch_RWFLAGS, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_RWFlags)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_RWFlags)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_WFlags, Ch_REAX, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_RWFlags)), +(Ch: (Ch_WEAX, Ch_RFLAGS, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_RWFlags)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_MOp3, Ch_RWFlags, Ch_Rop2)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_MOp3, Ch_RWFlags, Ch_Rop2)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_WFlags, Ch_None, Ch_None)), +(Ch: (Ch_SDirFlag, Ch_None, Ch_None)), +(Ch: (Ch_WFlags, Ch_None, Ch_None)), +(Ch: (Ch_REAX, Ch_WMemEDI, Ch_RWEDI)), +(Ch: (Ch_REAX, Ch_WMemEDI, Ch_RWEDI)), +(Ch: (Ch_REAX, Ch_WMemEDI, Ch_RWEDI)), +(Ch: (Ch_Wop1, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_WFlags, Ch_Rop1, Ch_Rop2)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_WFlags, Ch_None, Ch_None)), +(Ch: (Ch_WFlags, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_None, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_RWop1, Ch_RWop2, Ch_None)), +(Ch: (Ch_WEAX, Ch_REBX, Ch_None)), +(Ch: (Ch_WEAX, Ch_REBX, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_WFlags)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_ROp1, Ch_WOp2, Ch_RFLAGS)), +(Ch: (Ch_RFLAGS, Ch_None, Ch_None)), +(Ch: (Ch_RFLAGS, Ch_WOp1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Rop1, Ch_Rop2, Ch_WFlags)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_ROp1, Ch_WOp2, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop3, Ch_Rop2, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Rop1, Ch_Rop2, Ch_WFlags)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Rop1, Ch_Rop2, Ch_WFlags)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_ROp1, Ch_WOp2, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop3, Ch_Rop2, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Rop1, Ch_Rop2, Ch_WFlags)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Mop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_Wop2, Ch_Rop1, Ch_None)), +(Ch: (Ch_MRAX, Ch_WRDX, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_Mop1, Ch_Rop2, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)), +(Ch: (Ch_RRAX, Ch_WMemEDI, Ch_RWRDI)), +(Ch: (Ch_WRAX, Ch_RWRSI, Ch_None)), +(Ch: (Ch_All, Ch_None, Ch_None)) +); diff --git a/closures/compiler/x86_64/x8664tab.inc b/closures/compiler/x86_64/x8664tab.inc new file mode 100644 index 0000000000..188e47e1ca --- /dev/null +++ b/closures/compiler/x86_64/x8664tab.inc @@ -0,0 +1,8508 @@ +{ don't edit, this file is generated from x86ins.dat } +( + ( + opcode : A_NONE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #0; + flags : if_none + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#17#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#19#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#16#65; + flags : if_8086 + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#18#72; + flags : if_8086 + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #208#1#131#130#13; + flags : if_8086 + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_reg_eax,ot_immediate,ot_none,ot_none); + code : #213#1#21#33; + flags : if_386 or if_sm + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_reg_rax,ot_immediate,ot_none,ot_none); + code : #214#1#21#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #213#1#129#130#33; + flags : if_386 or if_sm + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_rm_gpr or ot_bits64,ot_immediate,ot_none,ot_none); + code : #214#1#129#130#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_reg_ax,ot_immediate,ot_none,ot_none); + code : #212#1#21#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#129#130#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#20#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_ADC; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#128#130#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#1#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#3#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#0#65; + flags : if_8086 + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#2#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #208#1#131#128#13; + flags : if_8086 + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_reg_eax,ot_immediate,ot_none,ot_none); + code : #208#1#5#33; + flags : if_386 or if_sm + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_reg_rax,ot_immediate,ot_none,ot_none); + code : #214#1#5#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #213#1#129#128#33; + flags : if_386 or if_sm + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_rm_gpr or ot_bits64,ot_immediate,ot_none,ot_none); + code : #214#1#129#128#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_reg_ax,ot_immediate,ot_none,ot_none); + code : #212#1#5#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#129#128#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#4#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_ADD; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#128#128#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#33#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#35#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#32#65; + flags : if_8086 + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#34#72; + flags : if_8086 + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #208#1#131#132#13; + flags : if_8086 + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_reg_eax,ot_immediate,ot_none,ot_none); + code : #213#1#37#33; + flags : if_386 or if_sm + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_reg_rax,ot_immediate,ot_none,ot_none); + code : #214#1#37#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #213#1#129#132#33; + flags : if_386 or if_sm + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_rm_gpr or ot_bits64,ot_immediate,ot_none,ot_none); + code : #214#1#129#132#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_reg_ax,ot_immediate,ot_none,ot_none); + code : #212#1#37#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#129#132#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#36#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_AND; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#128#132#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_BSF; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#2#15#188#72; + flags : if_386 or if_sm + ), + ( + opcode : A_BSR; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#2#15#189#72; + flags : if_386 or if_sm + ), + ( + opcode : A_BSWAP; + ops : 1; + optypes : (ot_reg32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#1#15#8#200; + flags : if_486 + ), + ( + opcode : A_BT; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#163#65; + flags : if_386 or if_sm + ), + ( + opcode : A_BT; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#2#15#186#132#21; + flags : if_386 or if_sb + ), + ( + opcode : A_BTC; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#187#65; + flags : if_386 or if_sm + ), + ( + opcode : A_BTC; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#2#15#186#135#21; + flags : if_386 or if_sb + ), + ( + opcode : A_BTR; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#179#65; + flags : if_386 or if_sm + ), + ( + opcode : A_BTR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#2#15#186#134#21; + flags : if_386 or if_sb + ), + ( + opcode : A_BTS; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#171#65; + flags : if_386 or if_sm + ), + ( + opcode : A_BTS; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#2#15#186#133#21; + flags : if_386 or if_sb + ), + ( + opcode : A_CALL; + ops : 1; + optypes : (ot_rm_gpr or ot_bits64,ot_none,ot_none,ot_none); + code : #221#1#255#130; + flags : if_x86_64 + ), + ( + opcode : A_CALL; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none); + code : #212#1#255#130; + flags : if_8086 + ), + ( + opcode : A_CALL; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #208#1#232#52; + flags : if_8086 + ), + ( + opcode : A_CALL; + ops : 1; + optypes : (ot_immediate or ot_near,ot_none,ot_none,ot_none); + code : #208#1#232#52; + flags : if_8086 + ), + ( + opcode : A_CALL; + ops : 1; + optypes : (ot_memory or ot_near,ot_none,ot_none,ot_none); + code : #208#1#255#130; + flags : if_8086 + ), + ( + opcode : A_CALL; + ops : 1; + optypes : (ot_memory or ot_far,ot_none,ot_none,ot_none); + code : #208#1#255#131; + flags : if_8086 + ), + ( + opcode : A_CBW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#152; + flags : if_8086 + ), + ( + opcode : A_CDQ; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#153; + flags : if_386 + ), + ( + opcode : A_CLC; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#248; + flags : if_8086 + ), + ( + opcode : A_CLD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#252; + flags : if_8086 + ), + ( + opcode : A_CLI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#250; + flags : if_8086 + ), + ( + opcode : A_CLTS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#6; + flags : if_286 or if_priv + ), + ( + opcode : A_CMC; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#245; + flags : if_8086 + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#57#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#59#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#56#65; + flags : if_8086 + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#58#72; + flags : if_8086 + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #208#1#131#135#13; + flags : if_8086 + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_reg_eax,ot_immediate,ot_none,ot_none); + code : #213#1#61#33; + flags : if_386 or if_sm + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_reg_rax,ot_immediate,ot_none,ot_none); + code : #214#1#61#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #213#1#129#135#33; + flags : if_386 or if_sm + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_rm_gpr or ot_bits64,ot_immediate,ot_none,ot_none); + code : #214#1#129#135#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_reg_ax,ot_immediate,ot_none,ot_none); + code : #212#1#61#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#129#135#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#60#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#128#135#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_memory,ot_immediate or ot_bits32,ot_none,ot_none); + code : #213#1#129#135#33; + flags : if_386 or if_sd + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_memory,ot_immediate or ot_bits16,ot_none,ot_none); + code : #212#1#129#135#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_CMP; + ops : 2; + optypes : (ot_memory,ot_immediate or ot_bits8,ot_none,ot_none); + code : #1#128#135#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_CMPSB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #218#1#166; + flags : if_8086 + ), + ( + opcode : A_CMPSD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #218#213#1#167; + flags : if_386 + ), + ( + opcode : A_CMPSD; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #220#2#15#194#72#22; + flags : if_willamette or if_sse2 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_CMPSW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #218#212#1#167; + flags : if_8086 + ), + ( + opcode : A_CMPXCHG; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#177#65; + flags : if_pent or if_sm + ), + ( + opcode : A_CMPXCHG; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #2#15#176#65; + flags : if_pent + ), + ( + opcode : A_CMPXCHG486; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#167#65; + flags : if_486 or if_sm + ), + ( + opcode : A_CMPXCHG486; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #2#15#166#65; + flags : if_486 or if_undoc + ), + ( + opcode : A_CMPXCHG8B; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#199#129; + flags : if_pent + ), + ( + opcode : A_CPUID; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#162; + flags : if_pent + ), + ( + opcode : A_CWD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#153; + flags : if_8086 + ), + ( + opcode : A_CWDE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#152; + flags : if_386 + ), + ( + opcode : A_DEC; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#1#255#129; + flags : if_8086 + ), + ( + opcode : A_DEC; + ops : 1; + optypes : (ot_rm_gpr or ot_bits8,ot_none,ot_none,ot_none); + code : #1#254#129; + flags : if_8086 + ), + ( + opcode : A_DIV; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#1#247#134; + flags : if_8086 + ), + ( + opcode : A_DIV; + ops : 1; + optypes : (ot_rm_gpr or ot_bits8,ot_none,ot_none,ot_none); + code : #1#246#134; + flags : if_8086 + ), + ( + opcode : A_EMMS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#119; + flags : if_pent or if_mmx + ), + ( + opcode : A_ENTER; + ops : 2; + optypes : (ot_immediate,ot_immediate,ot_none,ot_none); + code : #1#200#24#21; + flags : if_186 + ), + ( + opcode : A_F2XM1; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#240; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FABS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#225; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADD; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#216#128; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADD; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#220#128; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#222#193; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADD; + ops : 1; + optypes : (ot_fpureg or ot_to,ot_none,ot_none,ot_none); + code : #1#220#8#192; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADD; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#220#8#192; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADD; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#216#8#192; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADD; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#216#9#192; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADDP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#222#193; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADDP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#222#8#192; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FADDP; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#222#8#192; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FBLD; + ops : 1; + optypes : (ot_memory or ot_bits80,ot_none,ot_none,ot_none); + code : #1#223#132; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FBLD; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #1#223#132; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FBSTP; + ops : 1; + optypes : (ot_memory or ot_bits80,ot_none,ot_none,ot_none); + code : #1#223#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FBSTP; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #1#223#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCHS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#224; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCLEX; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#155#219#226; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCMOVB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#218#193; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVB; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#218#8#192; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVB; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#218#9#192; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVBE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#218#209; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVBE; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#218#8#208; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVBE; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#218#9#208; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#218#201; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVE; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#218#8#200; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVE; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#218#9#200; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#193; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNB; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#219#8#192; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNB; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#219#9#192; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNBE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#209; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNBE; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#219#8#208; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNBE; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#219#9#208; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#201; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNE; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#219#8#200; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNE; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#219#9#200; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNU; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#217; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNU; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#219#8#216; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVNU; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#219#9#216; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVU; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#218#217; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVU; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#218#8#216; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCMOVU; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#218#9#216; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCOM; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#216#130; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOM; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#220#130; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOM; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#216#209; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOM; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#216#8#208; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOM; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#216#9#208; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOMI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#241; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCOMI; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#219#8#240; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCOMI; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#219#9#240; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCOMIP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#223#241; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCOMIP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#223#8#240; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCOMIP; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#223#9#240; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FCOMP; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#216#131; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOMP; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#220#131; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOMP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#216#217; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOMP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#216#8#216; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOMP; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#216#9#216; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOMPP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#222#217; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FCOS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#255; + flags : if_386 or if_fpu + ), + ( + opcode : A_FDECSTP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#246; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDISI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#155#219#225; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIV; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#216#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIV; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#220#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIV; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#220#241; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIV; + ops : 1; + optypes : (ot_fpureg or ot_to,ot_none,ot_none,ot_none); + code : #1#220#8#240; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIV; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#220#8#240; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIV; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#216#8#240; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIV; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#216#9#240; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#222#241; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVP; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#222#8#240; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#222#8#240; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVR; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#216#135; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVR; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#220#135; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVR; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#220#249; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVR; + ops : 1; + optypes : (ot_fpureg or ot_to,ot_none,ot_none,ot_none); + code : #1#220#8#248; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVR; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#220#8#248; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVR; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#216#8#248; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVR; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#216#9#248; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVRP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#222#249; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVRP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#222#8#248; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FDIVRP; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#222#8#248; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FEMMS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#14; + flags : if_pent or if_3dnow + ), + ( + opcode : A_FENI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#155#219#224; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FFREE; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#221#8#192; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIADD; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#222#128; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIADD; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#218#128; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FICOM; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#222#130; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FICOM; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#218#130; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FICOMP; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#222#131; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FICOMP; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#218#131; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIDIV; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#222#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIDIV; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#218#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIDIVR; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#222#135; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIDIVR; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#218#135; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FILD; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#219#128; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FILD; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#223#128; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FILD; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#223#133; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIMUL; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#222#129; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIMUL; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#218#129; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FINCSTP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#247; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FINIT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#155#219#227; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIST; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#219#130; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FIST; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #212#1#223#130; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FISTP; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#219#131; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FISTP; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #212#1#223#131; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FISTP; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#223#135; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FISTTP; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#219#129; + flags : if_prescott or if_fpu + ), + ( + opcode : A_FISTTP; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#223#129; + flags : if_prescott or if_fpu + ), + ( + opcode : A_FISTTP; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#221#129; + flags : if_prescott or if_fpu + ), + ( + opcode : A_FISUB; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#222#132; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FISUB; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#218#132; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FISUBR; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #1#222#133; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FISUBR; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#218#133; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLD; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#217#128; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLD; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#221#128; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLD; + ops : 1; + optypes : (ot_memory or ot_bits80,ot_none,ot_none,ot_none); + code : #1#219#133; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLD; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#217#8#192; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLD1; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#232; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLDCW; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #1#217#133; + flags : if_8086 or if_fpu or if_sw + ), + ( + opcode : A_FLDENV; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #1#217#132; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLDL2E; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#234; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLDL2T; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#233; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLDLG2; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#236; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLDLN2; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#237; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLDPI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#235; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FLDZ; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#238; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMUL; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#216#129; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMUL; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#220#129; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMUL; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#220#201; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMUL; + ops : 1; + optypes : (ot_fpureg or ot_to,ot_none,ot_none,ot_none); + code : #1#220#8#200; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMUL; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#220#8#200; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMUL; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#216#8#200; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMUL; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#216#9#200; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMULP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#222#201; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMULP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#222#8#200; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FMULP; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#222#8#200; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FNCLEX; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#226; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FNDISI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#225; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FNENI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#224; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FNINIT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#227; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FNOP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#208; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FNSAVE; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #1#221#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FNSTCW; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #1#217#135; + flags : if_8086 or if_fpu or if_sw + ), + ( + opcode : A_FNSTENV; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #1#217#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FNSTSW; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #1#221#135; + flags : if_8086 or if_fpu or if_sw + ), + ( + opcode : A_FNSTSW; + ops : 1; + optypes : (ot_reg_ax,ot_none,ot_none,ot_none); + code : #2#223#224; + flags : if_286 or if_fpu + ), + ( + opcode : A_FPATAN; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#243; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FPREM; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#248; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FPREM1; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#245; + flags : if_386 or if_fpu + ), + ( + opcode : A_FPTAN; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#242; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FRNDINT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#252; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FRSTOR; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #1#221#132; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSAVE; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#155#221#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSCALE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#253; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSETPM; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#228; + flags : if_286 or if_fpu + ), + ( + opcode : A_FSIN; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#254; + flags : if_386 or if_fpu + ), + ( + opcode : A_FSINCOS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#251; + flags : if_386 or if_fpu + ), + ( + opcode : A_FSQRT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#250; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FST; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#217#130; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FST; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#221#130; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FST; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#221#8#208; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSTCW; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#155#217#135; + flags : if_8086 or if_fpu or if_sw + ), + ( + opcode : A_FSTENV; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#155#217#134; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSTP; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#217#131; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSTP; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#221#131; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSTP; + ops : 1; + optypes : (ot_memory or ot_bits80,ot_none,ot_none,ot_none); + code : #1#219#135; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSTP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#221#8#216; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSTSW; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#155#221#135; + flags : if_8086 or if_fpu or if_sw + ), + ( + opcode : A_FSTSW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#155#223#224; + flags : if_286 or if_fpu + ), + ( + opcode : A_FSTSW; + ops : 1; + optypes : (ot_reg_ax,ot_none,ot_none,ot_none); + code : #3#155#223#224; + flags : if_286 or if_fpu + ), + ( + opcode : A_FSUB; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#216#132; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUB; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#220#132; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#220#225; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUB; + ops : 1; + optypes : (ot_fpureg or ot_to,ot_none,ot_none,ot_none); + code : #1#220#8#224; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUB; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#220#8#224; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUB; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#216#8#224; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUB; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#216#9#224; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#222#225; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#222#8#224; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBP; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#222#8#224; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBR; + ops : 1; + optypes : (ot_memory or ot_bits32,ot_none,ot_none,ot_none); + code : #1#216#133; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBR; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #1#220#133; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBR; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#220#233; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBR; + ops : 1; + optypes : (ot_fpureg or ot_to,ot_none,ot_none,ot_none); + code : #1#220#8#232; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBR; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#220#8#232; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBR; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#216#8#232; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBR; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#216#9#232; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBRP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#222#233; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBRP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#222#8#232; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FSUBRP; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#222#8#232; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FTST; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#228; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FUCOM; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#221#225; + flags : if_386 or if_fpu + ), + ( + opcode : A_FUCOM; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#221#8#224; + flags : if_386 or if_fpu + ), + ( + opcode : A_FUCOM; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#221#9#224; + flags : if_386 or if_fpu + ), + ( + opcode : A_FUCOMI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#219#233; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FUCOMI; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#219#8#232; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FUCOMI; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#219#9#232; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FUCOMIP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#223#233; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FUCOMIP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#223#8#232; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FUCOMIP; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#223#9#232; + flags : if_p6 or if_fpu + ), + ( + opcode : A_FUCOMP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#221#233; + flags : if_386 or if_fpu + ), + ( + opcode : A_FUCOMP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#221#8#232; + flags : if_386 or if_fpu + ), + ( + opcode : A_FUCOMP; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#221#9#232; + flags : if_386 or if_fpu + ), + ( + opcode : A_FUCOMPP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#218#233; + flags : if_386 or if_fpu + ), + ( + opcode : A_FWAIT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#155; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FXAM; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#229; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FXCH; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#201; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FXCH; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#217#8#200; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FXCH; + ops : 2; + optypes : (ot_fpureg,ot_fpu0,ot_none,ot_none); + code : #1#217#8#200; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FXCH; + ops : 2; + optypes : (ot_fpu0,ot_fpureg,ot_none,ot_none); + code : #1#217#9#200; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FXTRACT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#244; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FYL2X; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#241; + flags : if_8086 or if_fpu + ), + ( + opcode : A_FYL2XP1; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#217#249; + flags : if_8086 or if_fpu + ), + ( + opcode : A_HLT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#244; + flags : if_8086 or if_priv + ), + ( + opcode : A_IBTS; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#167#65; + flags : if_386 or if_sm or if_undoc + ), + ( + opcode : A_ICEBP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#241; + flags : if_386 + ), + ( + opcode : A_IDIV; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#1#247#135; + flags : if_8086 + ), + ( + opcode : A_IDIV; + ops : 1; + optypes : (ot_rm_gpr or ot_bits8,ot_none,ot_none,ot_none); + code : #1#246#135; + flags : if_8086 + ), + ( + opcode : A_IMUL; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#2#15#175#72; + flags : if_386 or if_sm + ), + ( + opcode : A_IMUL; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#1#247#133; + flags : if_8086 + ), + ( + opcode : A_IMUL; + ops : 3; + optypes : (ot_reg32 or ot_bits64,ot_rm_gpr,ot_immediate or ot_bits8 or ot_signed,ot_none); + code : #208#1#107#72#14; + flags : if_286 or if_sm + ), + ( + opcode : A_IMUL; + ops : 3; + optypes : (ot_reg32 or ot_bits64,ot_rm_gpr,ot_immediate,ot_none); + code : #208#1#105#72#34; + flags : if_286 or if_sm or if_sd or if_ar2 + ), + ( + opcode : A_IMUL; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #208#1#107#64#13; + flags : if_286 + ), + ( + opcode : A_IMUL; + ops : 2; + optypes : (ot_reg32,ot_immediate,ot_none,ot_none); + code : #213#1#105#64#33; + flags : if_286 or if_sd + ), + ( + opcode : A_IMUL; + ops : 2; + optypes : (ot_reg64,ot_immediate,ot_none,ot_none); + code : #214#1#105#64#173; + flags : if_x86_64 + ), + ( + opcode : A_IMUL; + ops : 3; + optypes : (ot_reg16,ot_rm_gpr,ot_immediate or ot_bits8 or ot_signed,ot_none); + code : #212#1#107#72#14; + flags : if_286 or if_sm + ), + ( + opcode : A_IMUL; + ops : 3; + optypes : (ot_reg16,ot_rm_gpr,ot_immediate,ot_none); + code : #212#1#105#72#26; + flags : if_286 or if_sm or if_sw or if_ar2 + ), + ( + opcode : A_IMUL; + ops : 2; + optypes : (ot_reg16,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #212#1#107#64#13; + flags : if_286 + ), + ( + opcode : A_IMUL; + ops : 2; + optypes : (ot_reg16,ot_immediate,ot_none,ot_none); + code : #212#1#105#64#25; + flags : if_286 or if_sw + ), + ( + opcode : A_IMUL; + ops : 1; + optypes : (ot_rm_gpr or ot_bits8,ot_none,ot_none,ot_none); + code : #1#246#133; + flags : if_8086 + ), + ( + opcode : A_IN; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#228#21; + flags : if_8086 or if_sb + ), + ( + opcode : A_IN; + ops : 2; + optypes : (ot_reg_ax or ot_bits32,ot_immediate,ot_none,ot_none); + code : #208#1#229#21; + flags : if_8086 or if_sb + ), + ( + opcode : A_IN; + ops : 2; + optypes : (ot_reg_al,ot_reg_dx,ot_none,ot_none); + code : #1#236; + flags : if_8086 + ), + ( + opcode : A_IN; + ops : 2; + optypes : (ot_reg_ax or ot_bits32,ot_reg_dx,ot_none,ot_none); + code : #208#1#237; + flags : if_8086 + ), + ( + opcode : A_INC; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#1#255#128; + flags : if_8086 + ), + ( + opcode : A_INC; + ops : 1; + optypes : (ot_rm_gpr or ot_bits8,ot_none,ot_none,ot_none); + code : #1#254#128; + flags : if_8086 + ), + ( + opcode : A_INSB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#108; + flags : if_186 + ), + ( + opcode : A_INSD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#109; + flags : if_386 + ), + ( + opcode : A_INSW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#109; + flags : if_186 + ), + ( + opcode : A_INT; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #1#205#20; + flags : if_8086 or if_sb + ), + ( + opcode : A_INT01; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#241; + flags : if_386 + ), + ( + opcode : A_INT1; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#241; + flags : if_386 + ), + ( + opcode : A_INT03; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#204; + flags : if_8086 + ), + ( + opcode : A_INT3; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#204; + flags : if_8086 + ), + ( + opcode : A_INVD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#8; + flags : if_486 or if_priv + ), + ( + opcode : A_INVLPG; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#1#135; + flags : if_486 or if_priv + ), + ( + opcode : A_IRET; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #215#1#207; + flags : if_8086 + ), + ( + opcode : A_IRETD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#207; + flags : if_386 + ), + ( + opcode : A_IRETW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#207; + flags : if_8086 + ), + ( + opcode : A_IRETQ; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #214#1#207; + flags : if_x86_64 + ), + ( + opcode : A_JECXZ; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #201#1#227#40; + flags : if_386 + ), + ( + opcode : A_JRCXZ; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #1#227#40; + flags : if_x86_64 + ), + ( + opcode : A_JMP; + ops : 1; + optypes : (ot_immediate or ot_bits8,ot_none,ot_none,ot_none); + code : #1#235#40; + flags : if_8086 or if_pass2 + ), + ( + opcode : A_JMP; + ops : 1; + optypes : (ot_immediate or ot_bits16 or ot_bits32,ot_none,ot_none,ot_none); + code : #208#1#233#52; + flags : if_8086 or if_pass2 + ), + ( + opcode : A_JMP; + ops : 1; + optypes : (ot_rm_gpr or ot_bits64,ot_none,ot_none,ot_none); + code : #221#1#255#132; + flags : if_x86_64 + ), + ( + opcode : A_JMP; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none); + code : #212#1#255#132; + flags : if_8086 + ), + ( + opcode : A_JMP; + ops : 1; + optypes : (ot_immediate or ot_short,ot_none,ot_none,ot_none); + code : #1#235#40; + flags : if_8086 or if_pass2 + ), + ( + opcode : A_JMP; + ops : 1; + optypes : (ot_immediate or ot_near,ot_none,ot_none,ot_none); + code : #208#1#233#52; + flags : if_8086 or if_pass2 + ), + ( + opcode : A_JMP; + ops : 1; + optypes : (ot_memory or ot_near,ot_none,ot_none,ot_none); + code : #208#1#255#132; + flags : if_8086 + ), + ( + opcode : A_JMP; + ops : 1; + optypes : (ot_memory or ot_far,ot_none,ot_none,ot_none); + code : #208#1#255#133; + flags : if_8086 + ), + ( + opcode : A_LAHF; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#159; + flags : if_8086 + ), + ( + opcode : A_LAR; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#2#15#2#72; + flags : if_286 or if_prot or if_sm + ), + ( + opcode : A_LCALL; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #221#1#255#131; + flags : if_x86_64 + ), + ( + opcode : A_LCALL; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #212#1#255#131; + flags : if_8086 + ), + ( + opcode : A_LEA; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_memory,ot_none,ot_none); + code : #208#1#141#72; + flags : if_8086 + ), + ( + opcode : A_LEA; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#1#141#72; + flags : if_8086 or if_sd + ), + ( + opcode : A_LEAVE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#201; + flags : if_186 + ), + ( + opcode : A_LFS; + ops : 2; + optypes : (ot_reg16 or ot_bits32,ot_memory,ot_none,ot_none); + code : #208#2#15#180#72; + flags : if_386 + ), + ( + opcode : A_LGDT; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#1#130; + flags : if_286 or if_priv + ), + ( + opcode : A_LGS; + ops : 2; + optypes : (ot_reg16 or ot_bits32,ot_memory,ot_none,ot_none); + code : #208#2#15#181#72; + flags : if_386 + ), + ( + opcode : A_LIDT; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#1#131; + flags : if_286 or if_priv + ), + ( + opcode : A_LJMP; + ops : 1; + optypes : (ot_memory or ot_bits64,ot_none,ot_none,ot_none); + code : #221#1#255#133; + flags : if_x86_64 + ), + ( + opcode : A_LJMP; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #212#1#255#133; + flags : if_8086 + ), + ( + opcode : A_LLDT; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none); + code : #2#15#0#130; + flags : if_286 or if_prot or if_priv + ), + ( + opcode : A_LMSW; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none); + code : #2#15#1#134; + flags : if_286 or if_priv + ), + ( + opcode : A_LOADALL; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#7; + flags : if_386 or if_undoc + ), + ( + opcode : A_LOADALL286; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#5; + flags : if_286 or if_undoc + ), + ( + opcode : A_LOCK; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#240; + flags : if_8086 or if_pre + ), + ( + opcode : A_LODSB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#172; + flags : if_8086 + ), + ( + opcode : A_LODSD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#173; + flags : if_386 + ), + ( + opcode : A_LODSW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#173; + flags : if_8086 + ), + ( + opcode : A_LOOP; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #202#1#226#40; + flags : if_8086 + ), + ( + opcode : A_LOOP; + ops : 2; + optypes : (ot_immediate,ot_reg_ecx or ot_bits64,ot_none,ot_none); + code : #201#1#226#40; + flags : if_386 + ), + ( + opcode : A_LOOPE; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #202#1#225#40; + flags : if_8086 + ), + ( + opcode : A_LOOPE; + ops : 2; + optypes : (ot_immediate,ot_reg_ecx or ot_bits64,ot_none,ot_none); + code : #201#1#225#40; + flags : if_386 + ), + ( + opcode : A_LOOPNE; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #202#1#224#40; + flags : if_8086 + ), + ( + opcode : A_LOOPNE; + ops : 2; + optypes : (ot_immediate,ot_reg_ecx or ot_bits64,ot_none,ot_none); + code : #201#1#224#40; + flags : if_386 + ), + ( + opcode : A_LOOPNZ; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #202#1#224#40; + flags : if_8086 + ), + ( + opcode : A_LOOPNZ; + ops : 2; + optypes : (ot_immediate,ot_reg_ecx or ot_bits64,ot_none,ot_none); + code : #201#1#224#40; + flags : if_386 + ), + ( + opcode : A_LOOPZ; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #202#1#225#40; + flags : if_8086 + ), + ( + opcode : A_LOOPZ; + ops : 2; + optypes : (ot_immediate,ot_reg_ecx or ot_bits64,ot_none,ot_none); + code : #201#1#225#40; + flags : if_386 + ), + ( + opcode : A_LSL; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#2#15#3#72; + flags : if_286 or if_prot or if_sm + ), + ( + opcode : A_LSS; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_memory,ot_none,ot_none); + code : #208#2#15#178#72; + flags : if_386 + ), + ( + opcode : A_LTR; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none); + code : #2#15#0#131; + flags : if_286 or if_prot or if_priv + ), + ( + opcode : A_MONITOR; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#200; + flags : if_prescott + ), + ( + opcode : A_MONITOR; + ops : 3; + optypes : (ot_reg_eax,ot_reg_ecx,ot_reg_edx,ot_none); + code : #3#15#1#200; + flags : if_prescott + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_mem_offs,ot_reg_ax,ot_none,ot_none); + code : #212#1#163#36; + flags : if_8086 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_mem_offs,ot_reg_eax,ot_none,ot_none); + code : #213#1#163#36; + flags : if_386 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_mem_offs,ot_reg_rax,ot_none,ot_none); + code : #214#1#163#36; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#137#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_ax,ot_mem_offs,ot_none,ot_none); + code : #212#1#161#37; + flags : if_8086 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_eax,ot_mem_offs,ot_none,ot_none); + code : #213#1#161#37; + flags : if_386 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_rax,ot_mem_offs,ot_none,ot_none); + code : #214#1#161#37; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#139#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg32,ot_immediate,ot_none,ot_none); + code : #213#8#184#33; + flags : if_386 or if_sd + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg64,ot_immediate,ot_none,ot_none); + code : #214#8#184#45; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #213#1#199#128#33; + flags : if_386 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_rm_gpr or ot_bits64,ot_immediate,ot_none,ot_none); + code : #214#1#199#128#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg16,ot_immediate,ot_none,ot_none); + code : #212#8#184#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#199#128#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_mem_offs,ot_reg_al,ot_none,ot_none); + code : #1#162#36; + flags : if_8086 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#136#65; + flags : if_8086 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_al,ot_mem_offs,ot_none,ot_none); + code : #1#160#37; + flags : if_8086 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#138#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg8,ot_immediate,ot_none,ot_none); + code : #8#176#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#198#128#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32,ot_reg_cs,ot_none,ot_none); + code : #208#1#140#129; + flags : if_8086 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32,ot_reg_dess,ot_none,ot_none); + code : #208#1#140#65; + flags : if_8086 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32,ot_reg_fsgs,ot_none,ot_none); + code : #208#1#140#65; + flags : if_386 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_dess,ot_rm_gpr or ot_bits16 or ot_bits32,ot_none,ot_none); + code : #209#1#142#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_fsgs,ot_rm_gpr or ot_bits16 or ot_bits32,ot_none,ot_none); + code : #209#1#142#72; + flags : if_386 or if_sm + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg64,ot_reg_cr4,ot_none,ot_none); + code : #2#15#32#132; + flags : if_pent or if_priv or if_x86_64 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg64,ot_reg_creg,ot_none,ot_none); + code : #2#15#32#65; + flags : if_386 or if_priv or if_x86_64 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg64,ot_reg_dreg,ot_none,ot_none); + code : #2#15#33#65; + flags : if_386 or if_priv or if_x86_64 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg64,ot_reg_treg,ot_none,ot_none); + code : #2#15#36#65; + flags : if_386 or if_priv or if_x86_64 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_cr4,ot_reg64,ot_none,ot_none); + code : #2#15#34#140; + flags : if_pent or if_priv or if_x86_64 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_creg,ot_reg64,ot_none,ot_none); + code : #2#15#34#72; + flags : if_386 or if_priv or if_x86_64 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_dreg,ot_reg64,ot_none,ot_none); + code : #2#15#35#72; + flags : if_386 or if_priv or if_x86_64 + ), + ( + opcode : A_MOV; + ops : 2; + optypes : (ot_reg_treg,ot_reg64,ot_none,ot_none); + code : #2#15#38#72; + flags : if_386 or if_priv or if_x86_64 + ), + ( + opcode : A_MOVD; + ops : 2; + optypes : (ot_mmxreg,ot_rm_gpr or ot_bits32,ot_none,ot_none); + code : #2#15#110#72; + flags : if_pent or if_mmx or if_sd + ), + ( + opcode : A_MOVD; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_mmxreg,ot_none,ot_none); + code : #2#15#126#65; + flags : if_pent or if_mmx or if_sd + ), + ( + opcode : A_MOVD; + ops : 2; + optypes : (ot_xmmreg,ot_rm_gpr or ot_bits32,ot_none,ot_none); + code : #241#2#15#110#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVD; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#126#65; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#111#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_MOVQ; + ops : 2; + optypes : (ot_mmxrm,ot_mmxreg,ot_none,ot_none); + code : #2#15#127#65; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_MOVQ; + ops : 2; + optypes : (ot_mmxreg,ot_rm_gpr or ot_bits64,ot_none,ot_none); + code : #214#2#15#110#72; + flags : if_x86_64 or if_mmx + ), + ( + opcode : A_MOVQ; + ops : 2; + optypes : (ot_rm_gpr or ot_bits64,ot_mmxreg,ot_none,ot_none); + code : #214#2#15#126#65; + flags : if_x86_64 or if_mmx + ), + ( + opcode : A_MOVQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#126#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVQ; + ops : 2; + optypes : (ot_xmmrm,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#214#65; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVQ; + ops : 2; + optypes : (ot_xmmreg,ot_reg64,ot_none,ot_none); + code : #241#214#2#15#110#72; + flags : if_willamette or if_sse2 or if_x86_64 + ), + ( + opcode : A_MOVQ; + ops : 2; + optypes : (ot_reg64,ot_xmmreg,ot_none,ot_none); + code : #241#214#2#15#126#65; + flags : if_willamette or if_sse2 or if_x86_64 + ), + ( + opcode : A_MOVSB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#164; + flags : if_8086 + ), + ( + opcode : A_MOVSD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#165; + flags : if_386 + ), + ( + opcode : A_MOVSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#16#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVSD; + ops : 2; + optypes : (ot_xmmrm,ot_xmmreg,ot_none,ot_none); + code : #220#2#15#17#65; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVSQ; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #214#1#165; + flags : if_x86_64 + ), + ( + opcode : A_MOVSW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#165; + flags : if_8086 + ), + ( + opcode : A_MOVSX; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_rm_gpr or ot_bits16,ot_none,ot_none); + code : #208#2#15#191#72; + flags : if_386 + ), + ( + opcode : A_MOVSX; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #208#2#15#190#72; + flags : if_386 + ), + ( + opcode : A_MOVZX; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_rm_gpr or ot_bits16,ot_none,ot_none); + code : #208#2#15#183#72; + flags : if_386 + ), + ( + opcode : A_MOVZX; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #208#2#15#182#72; + flags : if_386 + ), + ( + opcode : A_MUL; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#1#247#132; + flags : if_8086 + ), + ( + opcode : A_MUL; + ops : 1; + optypes : (ot_rm_gpr or ot_bits8,ot_none,ot_none,ot_none); + code : #1#246#132; + flags : if_8086 + ), + ( + opcode : A_MWAIT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#201; + flags : if_prescott + ), + ( + opcode : A_MWAIT; + ops : 2; + optypes : (ot_reg_eax,ot_reg_ecx,ot_none,ot_none); + code : #3#15#1#201; + flags : if_prescott + ), + ( + opcode : A_NEG; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#1#247#131; + flags : if_8086 + ), + ( + opcode : A_NEG; + ops : 1; + optypes : (ot_rm_gpr or ot_bits8,ot_none,ot_none,ot_none); + code : #1#246#131; + flags : if_8086 + ), + ( + opcode : A_NOP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#144; + flags : if_8086 + ), + ( + opcode : A_NOT; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#1#247#130; + flags : if_8086 + ), + ( + opcode : A_NOT; + ops : 1; + optypes : (ot_rm_gpr or ot_bits8,ot_none,ot_none,ot_none); + code : #1#246#130; + flags : if_8086 + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#9#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#11#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#8#65; + flags : if_8086 + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#10#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #208#1#131#129#13; + flags : if_8086 + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_reg_eax,ot_immediate,ot_none,ot_none); + code : #213#1#13#33; + flags : if_386 or if_sm + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_reg_rax,ot_immediate,ot_none,ot_none); + code : #214#1#13#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #213#1#129#129#33; + flags : if_386 or if_sm + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits64,ot_immediate,ot_none,ot_none); + code : #214#1#129#129#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_reg_ax,ot_immediate,ot_none,ot_none); + code : #212#1#13#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#129#129#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#12#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_OR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#128#129#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_OUT; + ops : 2; + optypes : (ot_immediate,ot_reg_al,ot_none,ot_none); + code : #1#230#20; + flags : if_8086 or if_sb + ), + ( + opcode : A_OUT; + ops : 2; + optypes : (ot_immediate,ot_reg_ax,ot_none,ot_none); + code : #212#1#231#20; + flags : if_8086 or if_sb + ), + ( + opcode : A_OUT; + ops : 2; + optypes : (ot_immediate,ot_reg_eax,ot_none,ot_none); + code : #213#1#231#20; + flags : if_386 or if_sb + ), + ( + opcode : A_OUT; + ops : 2; + optypes : (ot_reg_dx,ot_reg_al,ot_none,ot_none); + code : #1#238; + flags : if_8086 + ), + ( + opcode : A_OUT; + ops : 2; + optypes : (ot_reg_dx,ot_reg_ax,ot_none,ot_none); + code : #212#1#239; + flags : if_8086 + ), + ( + opcode : A_OUT; + ops : 2; + optypes : (ot_reg_dx,ot_reg_eax,ot_none,ot_none); + code : #213#1#239; + flags : if_386 + ), + ( + opcode : A_OUTSB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#110; + flags : if_186 + ), + ( + opcode : A_OUTSD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#111; + flags : if_386 + ), + ( + opcode : A_OUTSW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#111; + flags : if_186 + ), + ( + opcode : A_PACKSSDW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#107#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PACKSSDW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#107#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PACKSSWB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#99#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PACKSSWB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#99#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PACKUSWB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#103#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PACKUSWB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#103#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PADDB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#252#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PADDB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#252#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PADDD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#254#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PADDD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#254#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PADDSB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#236#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PADDSB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#236#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PADDSIW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#81#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PADDSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#237#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PADDSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#237#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PADDUSB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#220#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PADDUSB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#220#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PADDUSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#221#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PADDUSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#221#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PADDW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#253#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PADDW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#253#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PAND; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#219#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PAND; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#219#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PANDN; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#223#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PANDN; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#223#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PAVEB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#80#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PAVGUSB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#191; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PCMPEQB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#116#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PCMPEQB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#116#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PCMPEQD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#118#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PCMPEQD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#118#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PCMPEQW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#117#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PCMPEQW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#117#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PCMPGTB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#100#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PCMPGTB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#100#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PCMPGTD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#102#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PCMPGTD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#102#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PCMPGTW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#101#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PCMPGTW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#101#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PDISTIB; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #2#15#84#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PF2ID; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#29; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFACC; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#174; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFADD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#158; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFCMPEQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#176; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFCMPGE; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#144; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFCMPGT; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#160; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFMAX; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#164; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFMIN; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#148; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFMUL; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#180; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFRCP; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#150; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFRCPIT1; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#166; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFRCPIT2; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#182; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFRSQIT1; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#167; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFRSQRT; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#151; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFSUB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#154; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFSUBR; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#170; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PI2FD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#13; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PMACHRIW; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #2#15#94#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PMADDWD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#245#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PMADDWD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#245#72; + flags : if_willamette or if_sm or if_sse2 + ), + ( + opcode : A_PMAGW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#82#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PMULHRIW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#93#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PMULHRWA; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#183; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PMULHRWC; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#89#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PMULHW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#229#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PMULHW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#229#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PMULLW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#213#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PMULLW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#213#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PMVGEZB; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #2#15#92#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PMVLZB; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #2#15#91#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PMVNZB; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #2#15#90#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PMVZB; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #2#15#88#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_POP; + ops : 1; + optypes : (ot_reg16,ot_none,ot_none,ot_none); + code : #212#8#88; + flags : if_8086 + ), + ( + opcode : A_POP; + ops : 1; + optypes : (ot_reg64,ot_none,ot_none,ot_none); + code : #221#8#88; + flags : if_x86_64 + ), + ( + opcode : A_POP; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none); + code : #212#1#143#128; + flags : if_8086 + ), + ( + opcode : A_POP; + ops : 1; + optypes : (ot_rm_gpr or ot_bits64,ot_none,ot_none,ot_none); + code : #221#1#143#128; + flags : if_x86_64 + ), + ( + opcode : A_POP; + ops : 1; + optypes : (ot_reg_cs,ot_none,ot_none,ot_none); + code : #1#15; + flags : if_8086 or if_undoc + ), + ( + opcode : A_POP; + ops : 1; + optypes : (ot_reg_fsgs,ot_none,ot_none,ot_none); + code : #1#15#5#221; + flags : if_386 + ), + ( + opcode : A_POPF; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #214#1#157; + flags : if_x86_64 + ), + ( + opcode : A_POPFW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#157; + flags : if_x86_64 + ), + ( + opcode : A_POPFQ; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #214#1#157; + flags : if_x86_64 + ), + ( + opcode : A_POR; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#235#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_POR; + ops : 2; + optypes : (ot_xmmreg,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#235#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PREFETCH; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#13#128; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PREFETCHW; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#13#129; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PSLLD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#242#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSLLD; + ops : 2; + optypes : (ot_mmxreg,ot_immediate,ot_none,ot_none); + code : #2#15#114#134#21; + flags : if_pent or if_mmx or if_sb or if_ar1 + ), + ( + opcode : A_PSLLD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#242#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSLLD; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#114#134#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSLLDQ; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#115#135#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSLLQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#243#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSLLQ; + ops : 2; + optypes : (ot_mmxreg,ot_immediate,ot_none,ot_none); + code : #2#15#115#134#21; + flags : if_pent or if_mmx or if_sb or if_ar1 + ), + ( + opcode : A_PSLLQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#243#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSLLQ; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#115#134#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSLLW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#241#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSLLW; + ops : 2; + optypes : (ot_mmxreg,ot_immediate,ot_none,ot_none); + code : #2#15#113#134#21; + flags : if_pent or if_mmx or if_sb or if_ar1 + ), + ( + opcode : A_PSLLW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#241#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSLLW; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#113#134#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSRAD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#226#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSRAD; + ops : 2; + optypes : (ot_mmxreg,ot_immediate,ot_none,ot_none); + code : #2#15#114#132#21; + flags : if_pent or if_mmx or if_sb or if_ar1 + ), + ( + opcode : A_PSRAD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#226#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSRAD; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#114#132#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSRAW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#225#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSRAW; + ops : 2; + optypes : (ot_mmxreg,ot_immediate,ot_none,ot_none); + code : #2#15#113#132#21; + flags : if_pent or if_mmx or if_sb or if_ar1 + ), + ( + opcode : A_PSRAW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#225#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSRAW; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#113#132#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSRLD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#210#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSRLD; + ops : 2; + optypes : (ot_mmxreg,ot_immediate,ot_none,ot_none); + code : #2#15#114#130#21; + flags : if_pent or if_mmx or if_sb or if_ar1 + ), + ( + opcode : A_PSRLD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#210#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSRLD; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#114#130#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSRLQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#211#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSRLQ; + ops : 2; + optypes : (ot_mmxreg,ot_immediate,ot_none,ot_none); + code : #2#15#115#130#21; + flags : if_pent or if_mmx or if_sb or if_ar1 + ), + ( + opcode : A_PSRLQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#211#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSRLQ; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#115#130#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSRLW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#209#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSRLW; + ops : 2; + optypes : (ot_mmxreg,ot_immediate,ot_none,ot_none); + code : #2#15#113#130#21; + flags : if_pent or if_mmx or if_sb or if_ar1 + ), + ( + opcode : A_PSRLW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#209#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSRLW; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#113#130#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSUBB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#248#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSUBB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#248#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSUBD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#250#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSUBD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#250#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSUBSB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#232#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSUBSB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#232#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSUBSIW; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #2#15#85#72; + flags : if_pent or if_mmx or if_sm or if_cyrix + ), + ( + opcode : A_PSUBSIW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxreg,ot_none,ot_none); + code : #2#15#85#72; + flags : if_pent or if_mmx or if_cyrix + ), + ( + opcode : A_PSUBSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#233#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSUBSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#233#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSUBUSB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#216#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSUBUSB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#216#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSUBUSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#217#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSUBUSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#217#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSUBW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#249#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PSUBW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#249#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PUNPCKHBW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#104#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PUNPCKHBW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#104#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PUNPCKHDQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#106#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PUNPCKHDQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#106#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PUNPCKHWD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#105#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PUNPCKHWD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#105#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PUNPCKLBW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#96#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PUNPCKLBW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#96#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PUNPCKLDQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#98#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PUNPCKLDQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#98#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PUNPCKLWD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#97#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PUNPCKLWD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#97#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PUSH; + ops : 1; + optypes : (ot_reg16,ot_none,ot_none,ot_none); + code : #212#8#80; + flags : if_8086 + ), + ( + opcode : A_PUSH; + ops : 1; + optypes : (ot_reg64,ot_none,ot_none,ot_none); + code : #221#8#80; + flags : if_x86_64 + ), + ( + opcode : A_PUSH; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16,ot_none,ot_none,ot_none); + code : #212#1#255#134; + flags : if_8086 + ), + ( + opcode : A_PUSH; + ops : 1; + optypes : (ot_rm_gpr or ot_bits64,ot_none,ot_none,ot_none); + code : #221#1#255#134; + flags : if_x86_64 + ), + ( + opcode : A_PUSH; + ops : 1; + optypes : (ot_immediate or ot_bits32,ot_none,ot_none,ot_none); + code : #213#1#104#32#221; + flags : if_386 + ), + ( + opcode : A_PUSH; + ops : 1; + optypes : (ot_immediate or ot_bits16,ot_none,ot_none,ot_none); + code : #212#1#104#24#221; + flags : if_286 + ), + ( + opcode : A_PUSH; + ops : 1; + optypes : (ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none,ot_none); + code : #1#106#12#221; + flags : if_286 + ), + ( + opcode : A_PUSHF; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #215#1#156; + flags : if_186 + ), + ( + opcode : A_PUSHFW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#156; + flags : if_186 + ), + ( + opcode : A_PUSHFQ; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #214#1#156; + flags : if_x86_64 + ), + ( + opcode : A_PXOR; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#239#72; + flags : if_pent or if_mmx or if_sm + ), + ( + opcode : A_PXOR; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#239#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_RCL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_unity,ot_none,ot_none); + code : #208#1#209#130; + flags : if_8086 + ), + ( + opcode : A_RCL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none,ot_none); + code : #208#1#211#130; + flags : if_8086 + ), + ( + opcode : A_RCL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#1#193#130#21; + flags : if_8086 or if_sb + ), + ( + opcode : A_RCL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_unity,ot_none,ot_none); + code : #1#208#130; + flags : if_8086 + ), + ( + opcode : A_RCL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg_cl,ot_none,ot_none); + code : #1#210#130; + flags : if_8086 + ), + ( + opcode : A_RCL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#192#130#21; + flags : if_186 or if_sb + ), + ( + opcode : A_RCR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_unity,ot_none,ot_none); + code : #208#1#209#131; + flags : if_8086 + ), + ( + opcode : A_RCR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none,ot_none); + code : #208#1#211#131; + flags : if_8086 + ), + ( + opcode : A_RCR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#1#193#131#21; + flags : if_8086 or if_sb + ), + ( + opcode : A_RCR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_unity,ot_none,ot_none); + code : #1#208#131; + flags : if_8086 + ), + ( + opcode : A_RCR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg_cl,ot_none,ot_none); + code : #1#210#131; + flags : if_8086 + ), + ( + opcode : A_RCR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#192#131#21; + flags : if_186 or if_sb + ), + ( + opcode : A_RDSHR; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#54; + flags : if_p6 or if_cyrix or if_smm + ), + ( + opcode : A_RDMSR; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#50; + flags : if_pent or if_priv + ), + ( + opcode : A_RDPMC; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#51; + flags : if_p6 + ), + ( + opcode : A_RDTSC; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#49; + flags : if_pent + ), + ( + opcode : A_REP; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#243; + flags : if_8086 or if_pre + ), + ( + opcode : A_REPE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#243; + flags : if_8086 or if_pre + ), + ( + opcode : A_REPNE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#242; + flags : if_8086 or if_pre + ), + ( + opcode : A_REPNZ; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#242; + flags : if_8086 or if_pre + ), + ( + opcode : A_REPZ; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#243; + flags : if_8086 or if_pre + ), + ( + opcode : A_RET; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#195; + flags : if_8086 + ), + ( + opcode : A_RET; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #1#194#24; + flags : if_8086 or if_sw + ), + ( + opcode : A_RETF; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#203; + flags : if_8086 + ), + ( + opcode : A_RETF; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #1#202#24; + flags : if_8086 or if_sw + ), + ( + opcode : A_RETN; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#195; + flags : if_8086 + ), + ( + opcode : A_RETN; + ops : 1; + optypes : (ot_immediate,ot_none,ot_none,ot_none); + code : #1#194#24; + flags : if_8086 or if_sw + ), + ( + opcode : A_ROL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_unity,ot_none,ot_none); + code : #208#1#209#128; + flags : if_8086 + ), + ( + opcode : A_ROL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none,ot_none); + code : #208#1#211#128; + flags : if_8086 + ), + ( + opcode : A_ROL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#1#193#128#21; + flags : if_8086 or if_sb + ), + ( + opcode : A_ROL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_unity,ot_none,ot_none); + code : #1#208#128; + flags : if_8086 + ), + ( + opcode : A_ROL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg_cl,ot_none,ot_none); + code : #1#210#128; + flags : if_8086 + ), + ( + opcode : A_ROL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#192#128#21; + flags : if_186 or if_sb + ), + ( + opcode : A_ROR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_unity,ot_none,ot_none); + code : #208#1#209#129; + flags : if_8086 + ), + ( + opcode : A_ROR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none,ot_none); + code : #208#1#211#129; + flags : if_8086 + ), + ( + opcode : A_ROR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#1#193#129#21; + flags : if_8086 or if_sb + ), + ( + opcode : A_ROR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_unity,ot_none,ot_none); + code : #1#208#129; + flags : if_8086 + ), + ( + opcode : A_ROR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg_cl,ot_none,ot_none); + code : #1#210#129; + flags : if_8086 + ), + ( + opcode : A_ROR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#192#129#21; + flags : if_186 or if_sb + ), + ( + opcode : A_RSDC; + ops : 2; + optypes : (ot_reg_sreg,ot_memory or ot_bits80,ot_none,ot_none); + code : #2#15#121#65; + flags : if_486 or if_cyrix or if_smm + ), + ( + opcode : A_RSLDT; + ops : 1; + optypes : (ot_memory or ot_bits80,ot_none,ot_none,ot_none); + code : #2#15#123#128; + flags : if_486 or if_cyrix or if_smm + ), + ( + opcode : A_RSM; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#170; + flags : if_pent or if_smm + ), + ( + opcode : A_SAHF; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#158; + flags : if_8086 + ), + ( + opcode : A_SAL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_unity,ot_none,ot_none); + code : #208#1#209#132; + flags : if_8086 + ), + ( + opcode : A_SAL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none,ot_none); + code : #208#1#211#132; + flags : if_8086 + ), + ( + opcode : A_SAL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#1#193#132#21; + flags : if_8086 or if_sb + ), + ( + opcode : A_SAL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_unity,ot_none,ot_none); + code : #1#208#132; + flags : if_8086 + ), + ( + opcode : A_SAL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg_cl,ot_none,ot_none); + code : #1#210#132; + flags : if_8086 + ), + ( + opcode : A_SAL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#192#132#21; + flags : if_186 or if_sb + ), + ( + opcode : A_SAR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_unity,ot_none,ot_none); + code : #208#1#209#135; + flags : if_8086 + ), + ( + opcode : A_SAR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none,ot_none); + code : #208#1#211#135; + flags : if_8086 + ), + ( + opcode : A_SAR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#1#193#135#21; + flags : if_8086 or if_sb + ), + ( + opcode : A_SAR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_unity,ot_none,ot_none); + code : #1#208#135; + flags : if_8086 + ), + ( + opcode : A_SAR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg_cl,ot_none,ot_none); + code : #1#210#135; + flags : if_8086 + ), + ( + opcode : A_SAR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#192#135#21; + flags : if_186 or if_sb + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#25#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#27#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #208#1#131#131#13; + flags : if_8086 + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#24#65; + flags : if_8086 + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#26#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_reg_eax,ot_immediate,ot_none,ot_none); + code : #213#1#29#33; + flags : if_386 or if_sm + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_reg_rax,ot_immediate,ot_none,ot_none); + code : #214#1#29#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #208#1#129#131#33; + flags : if_386 or if_sm + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits64,ot_immediate,ot_none,ot_none); + code : #214#1#129#131#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_reg_ax,ot_immediate,ot_none,ot_none); + code : #212#1#29#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #208#1#129#131#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#28#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_SBB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#128#131#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_SCASB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #218#1#174; + flags : if_8086 + ), + ( + opcode : A_SCASD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #218#213#1#175; + flags : if_386 + ), + ( + opcode : A_SCASQ; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #218#214#1#175; + flags : if_x86_64 + ), + ( + opcode : A_SCASW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #218#212#1#175; + flags : if_8086 + ), + ( + opcode : A_SEGCS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#46; + flags : if_8086 or if_pre + ), + ( + opcode : A_SEGDS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#62; + flags : if_8086 or if_pre + ), + ( + opcode : A_SEGES; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#38; + flags : if_8086 or if_pre + ), + ( + opcode : A_SEGFS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#100; + flags : if_8086 or if_pre + ), + ( + opcode : A_SEGGS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#101; + flags : if_8086 or if_pre + ), + ( + opcode : A_SEGSS; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#54; + flags : if_8086 or if_pre + ), + ( + opcode : A_SGDT; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#1#128; + flags : if_286 + ), + ( + opcode : A_SHL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_unity,ot_none,ot_none); + code : #208#1#209#132; + flags : if_8086 + ), + ( + opcode : A_SHL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none,ot_none); + code : #208#1#211#132; + flags : if_8086 + ), + ( + opcode : A_SHL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#1#193#132#21; + flags : if_186 or if_sw + ), + ( + opcode : A_SHL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_unity,ot_none,ot_none); + code : #1#208#132; + flags : if_8086 + ), + ( + opcode : A_SHL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg_cl,ot_none,ot_none); + code : #1#210#132; + flags : if_8086 + ), + ( + opcode : A_SHL; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#192#132#21; + flags : if_186 or if_sb + ), + ( + opcode : A_SHLD; + ops : 3; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg16 or ot_bits32 or ot_bits64,ot_immediate,ot_none); + code : #209#2#15#164#65#22; + flags : if_386 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_SHLD; + ops : 3; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none); + code : #209#2#15#165#65; + flags : if_386 or if_sm + ), + ( + opcode : A_SHR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_unity,ot_none,ot_none); + code : #208#1#209#133; + flags : if_8086 + ), + ( + opcode : A_SHR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none,ot_none); + code : #208#1#211#133; + flags : if_8086 + ), + ( + opcode : A_SHR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate,ot_none,ot_none); + code : #208#1#193#133#21; + flags : if_186 or if_sw + ), + ( + opcode : A_SHR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_unity,ot_none,ot_none); + code : #1#208#133; + flags : if_8086 + ), + ( + opcode : A_SHR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg_cl,ot_none,ot_none); + code : #1#210#133; + flags : if_8086 + ), + ( + opcode : A_SHR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#192#133#21; + flags : if_186 or if_sb + ), + ( + opcode : A_SHRD; + ops : 3; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg16 or ot_bits32 or ot_bits64,ot_immediate,ot_none); + code : #209#2#15#172#65#22; + flags : if_386 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_SHRD; + ops : 3; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_reg16 or ot_bits32 or ot_bits64,ot_reg_cl,ot_none); + code : #209#2#15#173#65; + flags : if_386 or if_sm + ), + ( + opcode : A_SIDT; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#1#129; + flags : if_286 + ), + ( + opcode : A_SLDT; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#0#128; + flags : if_286 + ), + ( + opcode : A_SLDT; + ops : 1; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#2#15#0#128; + flags : if_286 + ), + ( + opcode : A_SMI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#241; + flags : if_386 or if_undoc + ), + ( + opcode : A_SMINT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#56; + flags : if_p6 or if_cyrix + ), + ( + opcode : A_SMINTOLD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#126; + flags : if_486 or if_cyrix + ), + ( + opcode : A_SMSW; + ops : 1; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#2#15#1#132; + flags : if_286 + ), + ( + opcode : A_STC; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#249; + flags : if_8086 + ), + ( + opcode : A_STD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#253; + flags : if_8086 + ), + ( + opcode : A_STI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#251; + flags : if_8086 + ), + ( + opcode : A_STOSB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#170; + flags : if_8086 + ), + ( + opcode : A_STOSD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #213#1#171; + flags : if_386 + ), + ( + opcode : A_STOSW; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #212#1#171; + flags : if_8086 + ), + ( + opcode : A_STR; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#0#129; + flags : if_286 or if_prot + ), + ( + opcode : A_STR; + ops : 1; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none,ot_none); + code : #208#2#15#0#129; + flags : if_286 or if_prot + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#41#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#43#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#40#65; + flags : if_8086 + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#42#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #208#1#131#133#13; + flags : if_8086 + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_reg_eax,ot_immediate,ot_none,ot_none); + code : #213#1#45#33; + flags : if_386 or if_sm + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_reg_rax,ot_immediate,ot_none,ot_none); + code : #214#1#45#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #208#1#129#133#33; + flags : if_386 or if_sm + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits64,ot_immediate,ot_none,ot_none); + code : #214#1#129#133#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_reg_ax,ot_immediate,ot_none,ot_none); + code : #212#1#45#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#129#133#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#44#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_SUB; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#128#133#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_SVDC; + ops : 2; + optypes : (ot_memory or ot_bits80,ot_reg_sreg,ot_none,ot_none); + code : #2#15#120#65; + flags : if_486 or if_cyrix or if_smm + ), + ( + opcode : A_SVLDT; + ops : 1; + optypes : (ot_memory or ot_bits80,ot_none,ot_none,ot_none); + code : #2#15#122#128; + flags : if_486 or if_cyrix or if_smm + ), + ( + opcode : A_SVTS; + ops : 1; + optypes : (ot_memory or ot_bits80,ot_none,ot_none,ot_none); + code : #2#15#124#128; + flags : if_486 or if_cyrix or if_smm + ), + ( + opcode : A_SYSCALL; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#5; + flags : if_p6 or if_amd + ), + ( + opcode : A_SYSENTER; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#52; + flags : if_p6 + ), + ( + opcode : A_SYSEXIT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#53; + flags : if_p6 or if_priv + ), + ( + opcode : A_SYSRET; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#7; + flags : if_p6 or if_priv or if_amd + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#133#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_memory,ot_none,ot_none); + code : #208#1#133#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_reg8,ot_reg8,ot_none,ot_none); + code : #1#132#65; + flags : if_8086 + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#132#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_reg_rax,ot_immediate,ot_none,ot_none); + code : #214#1#169#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_reg_eax,ot_immediate,ot_none,ot_none); + code : #213#1#169#33; + flags : if_386 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_reg_ax,ot_immediate,ot_none,ot_none); + code : #212#1#169#25; + flags : if_8086 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#168#17; + flags : if_8086 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_rm_gpr or ot_bits64,ot_immediate,ot_none,ot_none); + code : #214#1#247#128#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #213#1#247#128#33; + flags : if_386 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#247#128#25; + flags : if_8086 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#246#128#17; + flags : if_8086 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_memory,ot_immediate or ot_bits32,ot_none,ot_none); + code : #213#1#247#128#33; + flags : if_386 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_memory,ot_immediate or ot_bits16,ot_none,ot_none); + code : #212#1#247#128#25; + flags : if_8086 or if_sm + ), + ( + opcode : A_TEST; + ops : 2; + optypes : (ot_memory,ot_immediate or ot_bits8,ot_none,ot_none); + code : #1#246#128#17; + flags : if_8086 or if_sm + ), + ( + opcode : A_UD1; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#185; + flags : if_286 or if_undoc + ), + ( + opcode : A_UD2; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#11; + flags : if_286 + ), + ( + opcode : A_UMOV; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#17#65; + flags : if_386 or if_undoc or if_sm + ), + ( + opcode : A_UMOV; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_memory,ot_none,ot_none); + code : #208#2#15#19#72; + flags : if_386 or if_undoc or if_sm + ), + ( + opcode : A_UMOV; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #2#15#16#65; + flags : if_386 or if_undoc + ), + ( + opcode : A_UMOV; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #2#15#18#72; + flags : if_386 or if_undoc + ), + ( + opcode : A_VERR; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#0#132; + flags : if_286 or if_prot + ), + ( + opcode : A_VERR; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #2#15#0#132; + flags : if_286 or if_prot + ), + ( + opcode : A_VERR; + ops : 1; + optypes : (ot_reg16,ot_none,ot_none,ot_none); + code : #2#15#0#132; + flags : if_286 or if_prot + ), + ( + opcode : A_VERW; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#0#133; + flags : if_286 or if_prot + ), + ( + opcode : A_VERW; + ops : 1; + optypes : (ot_memory or ot_bits16,ot_none,ot_none,ot_none); + code : #2#15#0#133; + flags : if_286 or if_prot + ), + ( + opcode : A_VERW; + ops : 1; + optypes : (ot_reg16,ot_none,ot_none,ot_none); + code : #2#15#0#133; + flags : if_286 or if_prot + ), + ( + opcode : A_WAIT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#155; + flags : if_8086 + ), + ( + opcode : A_WBINVD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#9; + flags : if_486 or if_priv + ), + ( + opcode : A_WRSHR; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#55; + flags : if_p6 or if_cyrix or if_smm + ), + ( + opcode : A_WRMSR; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#48; + flags : if_pent or if_priv + ), + ( + opcode : A_XADD; + ops : 2; + optypes : (ot_memory,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#193#65; + flags : if_486 or if_sm + ), + ( + opcode : A_XADD; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #2#15#192#65; + flags : if_486 + ), + ( + opcode : A_XBTS; + ops : 2; + optypes : (ot_reg16,ot_memory,ot_none,ot_none); + code : #212#2#15#166#72; + flags : if_386 or if_sw or if_undoc + ), + ( + opcode : A_XBTS; + ops : 2; + optypes : (ot_reg16,ot_reg16,ot_none,ot_none); + code : #212#2#15#166#72; + flags : if_386 or if_undoc + ), + ( + opcode : A_XBTS; + ops : 2; + optypes : (ot_reg32,ot_memory,ot_none,ot_none); + code : #213#2#15#166#72; + flags : if_386 or if_sd or if_undoc + ), + ( + opcode : A_XBTS; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #213#2#15#166#72; + flags : if_386 or if_undoc + ), + ( + opcode : A_XCHG; + ops : 2; + optypes : (ot_reg_ax,ot_reg16,ot_none,ot_none); + code : #212#9#144; + flags : if_8086 + ), + ( + opcode : A_XCHG; + ops : 2; + optypes : (ot_reg_eax,ot_reg32,ot_none,ot_none); + code : #213#9#144; + flags : if_386 + ), + ( + opcode : A_XCHG; + ops : 2; + optypes : (ot_reg_rax,ot_reg64,ot_none,ot_none); + code : #214#9#144; + flags : if_x86_64 + ), + ( + opcode : A_XCHG; + ops : 2; + optypes : (ot_reg16,ot_reg_ax,ot_none,ot_none); + code : #212#8#144; + flags : if_8086 + ), + ( + opcode : A_XCHG; + ops : 2; + optypes : (ot_reg32,ot_reg_eax,ot_none,ot_none); + code : #213#8#144; + flags : if_386 + ), + ( + opcode : A_XCHG; + ops : 2; + optypes : (ot_reg64,ot_reg_rax,ot_none,ot_none); + code : #214#8#144; + flags : if_x86_64 + ), + ( + opcode : A_XCHG; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#135#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_XCHG; + ops : 2; + optypes : (ot_memory,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#135#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_XCHG; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#134#72; + flags : if_8086 + ), + ( + opcode : A_XCHG; + ops : 2; + optypes : (ot_memory or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#134#65; + flags : if_8086 + ), + ( + opcode : A_XLAT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#215; + flags : if_8086 + ), + ( + opcode : A_XLATB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #1#215; + flags : if_8086 + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_rm_gpr,ot_reg16 or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #208#1#49#65; + flags : if_8086 or if_sm + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#51#72; + flags : if_8086 or if_sm + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_reg8,ot_none,ot_none); + code : #1#48#65; + flags : if_8086 + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_reg8,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #1#50#72; + flags : if_8086 + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16 or ot_bits32 or ot_bits64,ot_immediate or ot_bits8 or ot_signed,ot_none,ot_none); + code : #208#1#131#134#13; + flags : if_8086 + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_reg_eax,ot_immediate,ot_none,ot_none); + code : #213#1#53#33; + flags : if_386 or if_sm + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_reg_rax,ot_immediate,ot_none,ot_none); + code : #214#1#53#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits32,ot_immediate,ot_none,ot_none); + code : #208#1#129#134#33; + flags : if_386 or if_sm + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits64,ot_immediate,ot_none,ot_none); + code : #214#1#129#134#173; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_reg_ax,ot_immediate,ot_none,ot_none); + code : #212#1#53#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits16,ot_immediate,ot_none,ot_none); + code : #212#1#129#134#25; + flags : if_8086 or if_sw + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_reg_al,ot_immediate,ot_none,ot_none); + code : #1#52#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_XOR; + ops : 2; + optypes : (ot_rm_gpr or ot_bits8,ot_immediate,ot_none,ot_none); + code : #1#128#134#17; + flags : if_8086 or if_sb + ), + ( + opcode : A_XSTORE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#167#192; + flags : if_p6 or if_cyrix + ), + ( + opcode : A_XCRYPTECB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #219#3#15#167#200; + flags : if_p6 or if_cyrix + ), + ( + opcode : A_XCRYPTCBC; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #219#3#15#167#208; + flags : if_p6 or if_cyrix + ), + ( + opcode : A_XCRYPTCFB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #219#3#15#167#224; + flags : if_p6 or if_cyrix + ), + ( + opcode : A_XCRYPTOFB; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #219#3#15#167#232; + flags : if_p6 or if_cyrix + ), + ( + opcode : A_CMOVcc; + ops : 2; + optypes : (ot_reg16 or ot_bits32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #208#1#15#11#64#72; + flags : if_p6 or if_sm + ), + ( + opcode : A_Jcc; + ops : 1; + optypes : (ot_immediate or ot_bits8,ot_none,ot_none,ot_none); + code : #11#112#40; + flags : if_8086 + ), + ( + opcode : A_Jcc; + ops : 1; + optypes : (ot_immediate or ot_bits16 or ot_bits32,ot_none,ot_none,ot_none); + code : #208#1#15#11#128#52; + flags : if_386 or if_pass2 + ), + ( + opcode : A_Jcc; + ops : 1; + optypes : (ot_immediate or ot_short,ot_none,ot_none,ot_none); + code : #11#112#40; + flags : if_8086 + ), + ( + opcode : A_Jcc; + ops : 1; + optypes : (ot_immediate or ot_near,ot_none,ot_none,ot_none); + code : #208#1#15#11#128#52; + flags : if_386 or if_pass2 + ), + ( + opcode : A_SETcc; + ops : 1; + optypes : (ot_rm_gpr or ot_bits8,ot_none,ot_none,ot_none); + code : #1#15#11#144#128; + flags : if_386 + ), + ( + opcode : A_ADDPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#88#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_ADDSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#88#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_ANDNPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#85#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_ANDPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#84#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPEQPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#194#72#1#0; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPEQSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#194#72#1#0; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPLEPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#194#72#1#2; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPLESS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#194#72#1#2; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPLTPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#194#72#1#1; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPLTSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#194#72#1#1; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPNEQPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#194#72#1#4; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPNEQSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#194#72#1#4; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPNLEPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#194#72#1#6; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPNLESS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#194#72#1#6; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPNLTPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#194#72#1#5; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPNLTSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#194#72#1#5; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPORDPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#194#72#1#7; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPORDSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#194#72#1#7; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPUNORDPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#194#72#1#3; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPUNORDSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#194#72#1#3; + flags : if_katmai or if_sse + ), + ( + opcode : A_CMPPS; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #217#2#15#194#72#18; + flags : if_katmai or if_sse or if_sb or if_ar2 + ), + ( + opcode : A_CMPSS; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #219#2#15#194#72#18; + flags : if_katmai or if_sse or if_sb or if_ar2 + ), + ( + opcode : A_COMISS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#47#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_CVTPI2PS; + ops : 2; + optypes : (ot_xmmreg,ot_memory,ot_none,ot_none); + code : #217#2#15#42#72; + flags : if_katmai or if_sse or if_mmx + ), + ( + opcode : A_CVTPI2PS; + ops : 2; + optypes : (ot_xmmreg,ot_mmxreg,ot_none,ot_none); + code : #217#2#15#42#72; + flags : if_katmai or if_sse or if_mmx + ), + ( + opcode : A_CVTPS2PI; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #217#2#15#45#72; + flags : if_katmai or if_sse or if_mmx + ), + ( + opcode : A_CVTPS2PI; + ops : 2; + optypes : (ot_mmxreg,ot_xmmreg,ot_none,ot_none); + code : #217#2#15#45#72; + flags : if_katmai or if_sse or if_mmx + ), + ( + opcode : A_CVTSI2SS; + ops : 2; + optypes : (ot_xmmreg,ot_memory,ot_none,ot_none); + code : #219#209#2#15#42#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_CVTSI2SS; + ops : 2; + optypes : (ot_xmmreg,ot_reg32 or ot_bits64,ot_none,ot_none); + code : #219#209#2#15#42#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_CVTSS2SI; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_memory,ot_none,ot_none); + code : #219#208#2#15#45#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_CVTSS2SI; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_xmmreg,ot_none,ot_none); + code : #219#208#2#15#45#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_CVTTPS2PI; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #217#2#15#44#72; + flags : if_katmai or if_sse or if_mmx + ), + ( + opcode : A_CVTTPS2PI; + ops : 2; + optypes : (ot_mmxreg,ot_xmmreg,ot_none,ot_none); + code : #217#2#15#44#72; + flags : if_katmai or if_sse or if_mmx + ), + ( + opcode : A_CVTTSS2SI; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_memory,ot_none,ot_none); + code : #219#208#2#15#44#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_CVTTSS2SI; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_xmmreg,ot_none,ot_none); + code : #219#208#2#15#44#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_DIVPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#94#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_DIVSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#94#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_LDMXCSR; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#174#130; + flags : if_katmai or if_sse or if_sd + ), + ( + opcode : A_MAXPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#95#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MAXSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#95#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MINPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#93#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MINSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#93#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVAPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#40#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVAPS; + ops : 2; + optypes : (ot_xmmrm,ot_xmmreg,ot_none,ot_none); + code : #2#15#41#65; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVHPS; + ops : 2; + optypes : (ot_xmmreg,ot_memory,ot_none,ot_none); + code : #2#15#22#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVHPS; + ops : 2; + optypes : (ot_memory,ot_xmmreg,ot_none,ot_none); + code : #2#15#23#65; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVLHPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmreg,ot_none,ot_none); + code : #2#15#22#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVLPS; + ops : 2; + optypes : (ot_xmmreg,ot_memory,ot_none,ot_none); + code : #2#15#18#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVLPS; + ops : 2; + optypes : (ot_memory,ot_xmmreg,ot_none,ot_none); + code : #2#15#19#65; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVHLPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmreg,ot_none,ot_none); + code : #2#15#18#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVMSKPS; + ops : 2; + optypes : (ot_reg32,ot_xmmreg,ot_none,ot_none); + code : #2#15#80#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVNTPS; + ops : 2; + optypes : (ot_memory,ot_xmmreg,ot_none,ot_none); + code : #2#15#43#65; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#16#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVSS; + ops : 2; + optypes : (ot_xmmrm,ot_xmmreg,ot_none,ot_none); + code : #219#2#15#17#65; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVUPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#16#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MOVUPS; + ops : 2; + optypes : (ot_xmmrm,ot_xmmreg,ot_none,ot_none); + code : #217#2#15#17#65; + flags : if_katmai or if_sse + ), + ( + opcode : A_MULPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#89#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_MULSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#89#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_ORPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#86#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_RCPPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#83#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_RCPSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#83#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_RSQRTPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#82#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_RSQRTSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#82#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_SHUFPS; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #2#15#198#72#18; + flags : if_katmai or if_sse or if_sb or if_ar2 + ), + ( + opcode : A_SQRTPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#81#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_SQRTSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#81#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_STMXCSR; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#174#131; + flags : if_katmai or if_sse or if_sd + ), + ( + opcode : A_SUBPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #217#2#15#92#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_SUBSS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#92#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_UCOMISS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#46#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_UNPCKHPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#21#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_UNPCKLPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#20#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_XORPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#87#72; + flags : if_katmai or if_sse + ), + ( + opcode : A_FXRSTOR; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#174#129; + flags : if_p6 or if_sse or if_fpu + ), + ( + opcode : A_FXSAVE; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#174#128; + flags : if_p6 or if_sse or if_fpu + ), + ( + opcode : A_PREFETCHNTA; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#24#128; + flags : if_katmai + ), + ( + opcode : A_PREFETCHT0; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#24#129; + flags : if_katmai + ), + ( + opcode : A_PREFETCHT1; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#24#130; + flags : if_katmai + ), + ( + opcode : A_PREFETCHT2; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#24#131; + flags : if_katmai + ), + ( + opcode : A_SFENCE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#174#248; + flags : if_katmai + ), + ( + opcode : A_MASKMOVQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxreg,ot_none,ot_none); + code : #2#15#247#72; + flags : if_katmai or if_mmx + ), + ( + opcode : A_MOVNTQ; + ops : 2; + optypes : (ot_memory,ot_mmxreg,ot_none,ot_none); + code : #2#15#231#65; + flags : if_katmai or if_mmx or if_sm + ), + ( + opcode : A_PAVGB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#224#72; + flags : if_katmai or if_mmx or if_sm + ), + ( + opcode : A_PAVGB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#224#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PAVGW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#227#72; + flags : if_katmai or if_mmx or if_sm + ), + ( + opcode : A_PAVGW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#227#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PEXTRW; + ops : 3; + optypes : (ot_reg32,ot_mmxreg,ot_immediate,ot_none); + code : #2#15#197#72#18; + flags : if_katmai or if_mmx or if_sb or if_ar2 + ), + ( + opcode : A_PEXTRW; + ops : 3; + optypes : (ot_reg32,ot_xmmreg,ot_immediate,ot_none); + code : #241#2#15#197#72#22; + flags : if_sse41 + ), + ( + opcode : A_PEXTRW; + ops : 3; + optypes : (ot_memory or ot_bits32,ot_xmmreg,ot_immediate,ot_none); + code : #241#3#15#58#21#65#22; + flags : if_sse41 + ), + ( + opcode : A_PINSRW; + ops : 3; + optypes : (ot_mmxreg,ot_reg16,ot_immediate,ot_none); + code : #2#15#196#72#18; + flags : if_katmai or if_mmx or if_sb or if_ar2 + ), + ( + opcode : A_PINSRW; + ops : 3; + optypes : (ot_mmxreg,ot_reg32,ot_immediate,ot_none); + code : #2#15#196#72#18; + flags : if_katmai or if_mmx or if_sb or if_ar2 + ), + ( + opcode : A_PINSRW; + ops : 3; + optypes : (ot_mmxreg,ot_memory,ot_immediate,ot_none); + code : #2#15#196#72#18; + flags : if_katmai or if_mmx or if_sb or if_ar2 + ), + ( + opcode : A_PINSRW; + ops : 3; + optypes : (ot_mmxreg,ot_memory or ot_bits16,ot_immediate,ot_none); + code : #2#15#196#72#18; + flags : if_katmai or if_mmx or if_sb or if_ar2 + ), + ( + opcode : A_PINSRW; + ops : 3; + optypes : (ot_xmmreg,ot_reg16,ot_immediate,ot_none); + code : #241#2#15#196#72#22; + flags : if_willamette or if_sse2 or if_sb or if_ar2 + ), + ( + opcode : A_PINSRW; + ops : 3; + optypes : (ot_xmmreg,ot_reg32,ot_immediate,ot_none); + code : #241#2#15#196#72#22; + flags : if_willamette or if_sse2 or if_sb or if_ar2 + ), + ( + opcode : A_PINSRW; + ops : 3; + optypes : (ot_xmmreg,ot_memory,ot_immediate,ot_none); + code : #241#2#15#196#72#22; + flags : if_willamette or if_sse2 or if_sb or if_ar2 + ), + ( + opcode : A_PINSRW; + ops : 3; + optypes : (ot_xmmreg,ot_memory or ot_bits16,ot_immediate,ot_none); + code : #241#2#15#196#72#22; + flags : if_willamette or if_sse2 or if_sb or if_ar2 + ), + ( + opcode : A_PMAXSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#238#72; + flags : if_katmai or if_mmx or if_sm + ), + ( + opcode : A_PMAXSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#238#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PMAXUB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#222#72; + flags : if_katmai or if_mmx or if_sm + ), + ( + opcode : A_PMAXUB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#222#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PMINSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#234#72; + flags : if_katmai or if_mmx or if_sm + ), + ( + opcode : A_PMINSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#234#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PMINUB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#218#72; + flags : if_katmai or if_mmx or if_sm + ), + ( + opcode : A_PMINUB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#218#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PMOVMSKB; + ops : 2; + optypes : (ot_reg32,ot_mmxreg,ot_none,ot_none); + code : #2#15#215#72; + flags : if_katmai or if_mmx + ), + ( + opcode : A_PMOVMSKB; + ops : 2; + optypes : (ot_reg32,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#215#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_PMULHUW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#228#72; + flags : if_katmai or if_mmx or if_sm + ), + ( + opcode : A_PMULHUW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#228#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSADBW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#246#72; + flags : if_katmai or if_mmx or if_sm + ), + ( + opcode : A_PSADBW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#246#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSHUFW; + ops : 3; + optypes : (ot_mmxreg,ot_mmxrm,ot_immediate,ot_none); + code : #2#15#112#72#18; + flags : if_katmai or if_mmx or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PFNACC; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#138; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PFPNACC; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#142; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PI2FW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#12; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PF2IW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#28; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_PSWAPD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#15#72#1#187; + flags : if_pent or if_3dnow or if_sm + ), + ( + opcode : A_FFREEP; + ops : 1; + optypes : (ot_fpureg,ot_none,ot_none,ot_none); + code : #1#223#8#192; + flags : if_pent or if_3dnow or if_fpu + ), + ( + opcode : A_MASKMOVDQU; + ops : 2; + optypes : (ot_xmmreg,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#247#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CLFLUSH; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#174#135; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVNTDQ; + ops : 2; + optypes : (ot_memory,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#231#65; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MOVNTI; + ops : 2; + optypes : (ot_memory,ot_reg32 or ot_bits64,ot_none,ot_none); + code : #208#2#15#195#65; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MOVNTPD; + ops : 2; + optypes : (ot_memory,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#43#65; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PAUSE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #219#1#144; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_LFENCE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#174#232; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MFENCE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#174#240; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVDQA; + ops : 2; + optypes : (ot_xmmrm,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#127#65; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MOVDQA; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#111#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MOVDQU; + ops : 2; + optypes : (ot_xmmrm,ot_xmmreg,ot_none,ot_none); + code : #219#2#15#127#65; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MOVDQU; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#111#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MOVDQ2Q; + ops : 2; + optypes : (ot_mmxreg,ot_xmmreg,ot_none,ot_none); + code : #220#2#15#214#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVQ2DQ; + ops : 2; + optypes : (ot_xmmreg,ot_mmxreg,ot_none,ot_none); + code : #219#2#15#214#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_PADDQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#212#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PADDQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#212#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PMULUDQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#244#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PMULUDQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#244#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSHUFD; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#2#15#112#72#18; + flags : if_willamette or if_sse2 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PSHUFHW; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #219#2#15#112#72#18; + flags : if_willamette or if_sse2 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PSHUFLW; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #220#2#15#112#72#18; + flags : if_willamette or if_sse2 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PSRLDQ; + ops : 2; + optypes : (ot_xmmreg,ot_immediate,ot_none,ot_none); + code : #241#2#15#115#131#21; + flags : if_willamette or if_sse2 or if_sb or if_ar1 + ), + ( + opcode : A_PSUBQ; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #2#15#251#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PSUBQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#251#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PUNPCKHQDQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#109#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_PUNPCKLQDQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#108#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_ADDPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#88#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_ADDSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#88#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_ANDNPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#85#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_ANDPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#84#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CMPEQPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#194#72#1#0; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CMPEQSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#194#72#1#0; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CMPLEPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#194#72#1#2; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CMPLESD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#194#72#1#2; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CMPLTPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#194#72#1#1; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CMPLTSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#194#72#1#1; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CMPNEQPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#194#72#1#4; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CMPNEQSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#194#72#1#4; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CMPNLEPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#194#72#1#6; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CMPNLESD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#194#72#1#6; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CMPNLTPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#194#72#1#5; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CMPNLTSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#194#72#1#5; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CMPORDPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#194#72#1#7; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CMPORDSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#194#72#1#7; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CMPUNORDPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#194#72#1#3; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CMPUNORDSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#194#72#1#3; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CMPPD; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#2#15#194#72#22; + flags : if_willamette or if_sse2 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_COMISD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#47#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTDQ2PD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#230#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTDQ2PS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#91#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CVTPD2DQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#230#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CVTPD2PI; + ops : 2; + optypes : (ot_mmxreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#45#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTPD2PS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#90#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CVTPI2PD; + ops : 2; + optypes : (ot_xmmreg,ot_mmxrm,ot_none,ot_none); + code : #241#2#15#42#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTPS2DQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#91#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CVTPS2PD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #2#15#90#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTSD2SI; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_xmmreg,ot_none,ot_none); + code : #220#208#2#15#45#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTSD2SI; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_memory,ot_none,ot_none); + code : #220#208#2#15#45#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTSD2SS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#90#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTSI2SD; + ops : 2; + optypes : (ot_xmmreg,ot_reg32 or ot_bits64,ot_none,ot_none); + code : #220#209#2#15#42#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTSI2SD; + ops : 2; + optypes : (ot_xmmreg,ot_memory,ot_none,ot_none); + code : #220#209#2#15#42#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTSS2SD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#90#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTTPD2PI; + ops : 2; + optypes : (ot_mmxreg,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#44#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTTPD2PI; + ops : 2; + optypes : (ot_mmxreg,ot_memory,ot_none,ot_none); + code : #241#2#15#44#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTTPD2DQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#230#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CVTTPS2DQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#91#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_CVTTSD2SI; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_xmmreg,ot_none,ot_none); + code : #220#208#2#15#44#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_CVTTSD2SI; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_memory,ot_none,ot_none); + code : #220#208#2#15#44#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_DIVPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#94#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_DIVSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#94#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MAXPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#95#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MAXSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#95#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MINPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#93#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MINSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#93#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVAPD; + ops : 2; + optypes : (ot_xmmrm,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#41#65; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MOVAPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#40#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MOVHPD; + ops : 2; + optypes : (ot_memory,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#23#65; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVHPD; + ops : 2; + optypes : (ot_xmmreg,ot_memory,ot_none,ot_none); + code : #241#2#15#22#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVLPD; + ops : 2; + optypes : (ot_memory,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#19#65; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVLPD; + ops : 2; + optypes : (ot_xmmreg,ot_memory,ot_none,ot_none); + code : #241#2#15#18#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVMSKPD; + ops : 2; + optypes : (ot_reg32,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#80#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_MOVUPD; + ops : 2; + optypes : (ot_xmmrm,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#17#65; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MOVUPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#16#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MULPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#89#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_MULSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#89#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_ORPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#86#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_SHUFPD; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#2#15#198#72#22; + flags : if_willamette or if_sse2 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_SQRTPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#81#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_SQRTSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#81#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_SUBPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#92#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_SUBSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#92#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_UCOMISD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#46#72; + flags : if_willamette or if_sse2 + ), + ( + opcode : A_UNPCKHPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#21#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_UNPCKLPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#20#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_XORPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#87#72; + flags : if_willamette or if_sse2 or if_sm + ), + ( + opcode : A_ADDSUBPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#208#72; + flags : if_prescott or if_sse3 or if_sm + ), + ( + opcode : A_ADDSUBPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#208#72; + flags : if_prescott or if_sse3 or if_sm + ), + ( + opcode : A_HADDPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#124#72; + flags : if_prescott or if_sse3 or if_sm + ), + ( + opcode : A_HADDPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#124#72; + flags : if_prescott or if_sse3 or if_sm + ), + ( + opcode : A_HSUBPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#2#15#125#72; + flags : if_prescott or if_sse3 or if_sm + ), + ( + opcode : A_HSUBPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#125#72; + flags : if_prescott or if_sse3 or if_sm + ), + ( + opcode : A_LDDQU; + ops : 2; + optypes : (ot_xmmreg,ot_memory,ot_none,ot_none); + code : #220#2#15#240#72; + flags : if_prescott or if_sse3 + ), + ( + opcode : A_MOVDDUP; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #220#2#15#18#72; + flags : if_prescott or if_sse3 + ), + ( + opcode : A_MOVSHDUP; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#22#72; + flags : if_prescott or if_sse3 or if_sm + ), + ( + opcode : A_MOVSLDUP; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #219#2#15#18#72; + flags : if_prescott or if_sse3 or if_sm + ), + ( + opcode : A_VMREAD; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #2#15#120#65; + flags : if_386 or if_priv or if_prot + ), + ( + opcode : A_VMREAD; + ops : 2; + optypes : (ot_memory,ot_reg32,ot_none,ot_none); + code : #2#15#120#65; + flags : if_386 or if_priv or if_prot or if_sm + ), + ( + opcode : A_VMWRITE; + ops : 2; + optypes : (ot_reg32,ot_reg32,ot_none,ot_none); + code : #2#15#121#72; + flags : if_386 or if_priv or if_prot + ), + ( + opcode : A_VMWRITE; + ops : 2; + optypes : (ot_reg32,ot_memory,ot_none,ot_none); + code : #2#15#121#72; + flags : if_386 or if_priv or if_prot or if_sm + ), + ( + opcode : A_VMCALL; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#193; + flags : if_386 or if_priv or if_prot + ), + ( + opcode : A_VMLAUNCH; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#194; + flags : if_386 or if_priv or if_prot + ), + ( + opcode : A_VMRESUME; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#195; + flags : if_386 or if_priv or if_prot + ), + ( + opcode : A_VMXOFF; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#196; + flags : if_386 or if_priv or if_prot + ), + ( + opcode : A_VMXON; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #219#2#15#199#134; + flags : if_priv or if_prot + ), + ( + opcode : A_VMCLEAR; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #241#2#15#199#134; + flags : if_priv or if_prot + ), + ( + opcode : A_VMPTRLD; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#199#134; + flags : if_priv or if_prot + ), + ( + opcode : A_VMPTRST; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #2#15#199#135; + flags : if_priv or if_prot + ), + ( + opcode : A_VMRUN; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#216; + flags : if_386 or if_svm or if_priv or if_prot + ), + ( + opcode : A_VMMCALL; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#217; + flags : if_386 or if_svm + ), + ( + opcode : A_VMLOAD; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#218; + flags : if_386 or if_svm or if_priv or if_prot + ), + ( + opcode : A_VMSAVE; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#219; + flags : if_386 or if_svm or if_priv or if_prot + ), + ( + opcode : A_STGI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#220; + flags : if_386 or if_svm or if_priv or if_prot + ), + ( + opcode : A_CLGI; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#221; + flags : if_386 or if_svm or if_priv or if_prot + ), + ( + opcode : A_SKINIT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#222; + flags : if_386 or if_svm or if_priv or if_prot + ), + ( + opcode : A_INVLPGA; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #3#15#1#223; + flags : if_386 or if_svm or if_priv or if_prot + ), + ( + opcode : A_MONTMUL; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #219#3#15#166#192; + flags : if_centaur + ), + ( + opcode : A_XSHA1; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #219#3#15#166#200; + flags : if_centaur + ), + ( + opcode : A_XSHA256; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #219#3#15#166#208; + flags : if_centaur + ), + ( + opcode : A_DMINT; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#57; + flags : if_p6 or if_cyrix + ), + ( + opcode : A_RDM; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #2#15#58; + flags : if_p6 or if_cyrix + ), + ( + opcode : A_MOVABS; + ops : 2; + optypes : (ot_reg_al,ot_mem_offs,ot_none,ot_none); + code : #1#160#37; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_MOVABS; + ops : 2; + optypes : (ot_reg_ax or ot_bits32 or ot_bits64,ot_mem_offs,ot_none,ot_none); + code : #208#1#161#37; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_MOVABS; + ops : 2; + optypes : (ot_mem_offs,ot_reg_al,ot_none,ot_none); + code : #1#162#36; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_MOVABS; + ops : 2; + optypes : (ot_mem_offs,ot_reg_ax or ot_bits32 or ot_bits64,ot_none,ot_none); + code : #209#163#36; + flags : if_x86_64 or if_sm + ), + ( + opcode : A_MOVABS; + ops : 2; + optypes : (ot_reg64,ot_immediate,ot_none,ot_none); + code : #214#8#184#45; + flags : if_x86_64 + ), + ( + opcode : A_MOVSXD; + ops : 2; + optypes : (ot_reg64,ot_memory,ot_none,ot_none); + code : #214#1#99#72; + flags : if_x86_64 + ), + ( + opcode : A_MOVSXD; + ops : 2; + optypes : (ot_reg64,ot_reg32,ot_none,ot_none); + code : #214#1#99#72; + flags : if_x86_64 + ), + ( + opcode : A_CQO; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #214#1#153; + flags : if_x86_64 + ), + ( + opcode : A_CMPXCHG16B; + ops : 1; + optypes : (ot_memory,ot_none,ot_none,ot_none); + code : #214#2#15#199#129; + flags : if_x86_64 + ), + ( + opcode : A_MOVNTSS; + ops : 2; + optypes : (ot_memory,ot_xmmreg,ot_none,ot_none); + code : #219#2#15#43#65; + flags : if_sse4 or if_sd + ), + ( + opcode : A_MOVNTSD; + ops : 2; + optypes : (ot_memory,ot_xmmreg,ot_none,ot_none); + code : #220#213#2#15#43#65; + flags : if_sse4 + ), + ( + opcode : A_INSERTQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmreg,ot_none,ot_none); + code : #220#2#15#121#72; + flags : if_sse4 + ), + ( + opcode : A_INSERTQ; + ops : 4; + optypes : (ot_xmmreg,ot_xmmreg,ot_immediate,ot_immediate); + code : #220#2#15#120#72#22#23; + flags : if_sse4 or if_sb + ), + ( + opcode : A_EXTRQ; + ops : 3; + optypes : (ot_xmmreg,ot_immediate,ot_immediate,ot_none); + code : #241#2#15#120#128#21#22; + flags : if_sse4 or if_sb + ), + ( + opcode : A_EXTRQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmreg,ot_none,ot_none); + code : #241#2#15#121#72; + flags : if_sse4 + ), + ( + opcode : A_LZCNT; + ops : 2; + optypes : (ot_reg16,ot_rm_gpr,ot_none,ot_none); + code : #208#219#2#15#189#72; + flags : if_386 or if_sm or if_sse4 + ), + ( + opcode : A_LZCNT; + ops : 2; + optypes : (ot_reg32 or ot_bits64,ot_rm_gpr,ot_none,ot_none); + code : #209#219#2#15#189#72; + flags : if_386 or if_sm or if_sse4 + ), + ( + opcode : A_PABSB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#28#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PABSB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#28#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PABSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#29#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PABSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#29#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PABSD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#30#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PABSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#30#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PALIGNR; + ops : 3; + optypes : (ot_mmxreg,ot_mmxrm,ot_immediate,ot_none); + code : #217#3#15#58#15#72#22; + flags : if_ssse3 or if_mmx or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PALIGNR; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#15#72#22; + flags : if_ssse3 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PHADDW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#1#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PHADDW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#1#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PHADDD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#2#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PHADDD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#2#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PHADDSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#3#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PHADDSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#3#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PHSUBW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#5#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PHSUBW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#5#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PHSUBD; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#6#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PHSUBD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#6#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PHSUBSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#7#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PHSUBSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#7#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PMADDUBSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#4#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PMADDUBSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#4#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PMULHRSW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#11#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PMULHRSW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#11#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PSHUFB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#0#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PSHUFB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#0#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PSIGNB; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#8#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PSIGNB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#8#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PSIGNW; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#9#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PSIGNW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#9#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_PSIGND; + ops : 2; + optypes : (ot_mmxreg,ot_mmxrm,ot_none,ot_none); + code : #217#3#15#56#10#72; + flags : if_ssse3 or if_mmx or if_sm + ), + ( + opcode : A_PSIGND; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#10#72; + flags : if_ssse3 or if_sm + ), + ( + opcode : A_BLENDPS; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#12#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_BLENDPD; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#13#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_BLENDVPS; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#20#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_BLENDVPD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#21#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_DPPS; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#64#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_DPPD; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#65#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_EXTRACTPS; + ops : 3; + optypes : (ot_memory,ot_xmmreg,ot_immediate,ot_none); + code : #241#213#3#15#58#23#65#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_EXTRACTPS; + ops : 3; + optypes : (ot_reg32 or ot_bits64,ot_xmmreg,ot_immediate,ot_none); + code : #241#3#15#58#23#65#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_INSERTPS; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#33#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_MOVNTDQA; + ops : 2; + optypes : (ot_xmmreg,ot_memory,ot_none,ot_none); + code : #241#3#15#56#42#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_MPSADBW; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#66#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PACKUSDW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#43#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PBLENDVB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#16#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PBLENDW; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#14#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PCMPEQQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#41#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PEXTRB; + ops : 3; + optypes : (ot_reg32 or ot_bits64,ot_xmmreg,ot_immediate,ot_none); + code : #241#3#15#58#20#65#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_PEXTRB; + ops : 3; + optypes : (ot_memory or ot_bits8,ot_xmmreg,ot_immediate,ot_none); + code : #241#3#15#58#20#65#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_PEXTRD; + ops : 3; + optypes : (ot_reg32,ot_xmmreg,ot_immediate,ot_none); + code : #241#3#15#58#22#65#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_PEXTRD; + ops : 3; + optypes : (ot_memory or ot_bits32,ot_xmmreg,ot_immediate,ot_none); + code : #241#3#15#58#22#65#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_PEXTRQ; + ops : 3; + optypes : (ot_reg64,ot_xmmreg,ot_immediate,ot_none); + code : #241#214#3#15#58#22#65#22; + flags : if_sse41 or if_x86_64 or if_sb or if_ar2 + ), + ( + opcode : A_PEXTRQ; + ops : 3; + optypes : (ot_memory or ot_bits64,ot_xmmreg,ot_immediate,ot_none); + code : #241#214#3#15#58#22#65#22; + flags : if_sse41 or if_x86_64 or if_sb or if_ar2 + ), + ( + opcode : A_PHMINPOSUW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#65#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PINSRB; + ops : 3; + optypes : (ot_xmmreg,ot_reg32 or ot_bits64,ot_immediate,ot_none); + code : #241#3#15#58#32#72#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_PINSRB; + ops : 3; + optypes : (ot_xmmreg,ot_memory or ot_bits8,ot_immediate,ot_none); + code : #241#3#15#58#32#72#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_PINSRD; + ops : 3; + optypes : (ot_xmmreg,ot_reg32,ot_immediate,ot_none); + code : #241#3#15#58#34#72#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_PINSRD; + ops : 3; + optypes : (ot_xmmreg,ot_memory or ot_bits32,ot_immediate,ot_none); + code : #241#3#15#58#34#72#22; + flags : if_sse41 or if_sb or if_ar2 + ), + ( + opcode : A_PINSRQ; + ops : 3; + optypes : (ot_xmmreg,ot_reg64,ot_immediate,ot_none); + code : #241#214#3#15#58#34#72#22; + flags : if_sse41 or if_x86_64 or if_sb or if_ar2 + ), + ( + opcode : A_PINSRQ; + ops : 3; + optypes : (ot_xmmreg,ot_memory or ot_bits64,ot_immediate,ot_none); + code : #241#214#3#15#58#34#72#22; + flags : if_sse41 or if_x86_64 or if_sb or if_ar2 + ), + ( + opcode : A_PMAXSB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#60#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMAXSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#61#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMAXUD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#63#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMAXUW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#62#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMINSB; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#56#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMINSD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#57#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMINUW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#58#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMINUD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#59#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVSXBW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#32#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVSXBD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#33#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVSXBQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#34#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVSXWD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#35#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVSXWQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#36#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVSXDQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#37#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVZXBW; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#48#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVZXBD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#49#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVZXBQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#50#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVZXWD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#51#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVZXWQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#52#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMOVZXDQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#53#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMULDQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#40#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PMULLD; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#64#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_PTEST; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#23#72; + flags : if_sse41 or if_sm + ), + ( + opcode : A_ROUNDPS; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#8#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_ROUNDPD; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#9#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_ROUNDSS; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#10#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_ROUNDSD; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#11#72#22; + flags : if_sse41 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_CRC32; + ops : 2; + optypes : (ot_reg32,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #220#3#15#56#240#72; + flags : if_sse42 + ), + ( + opcode : A_CRC32; + ops : 2; + optypes : (ot_reg32,ot_rm_gpr or ot_bits16 or ot_bits32,ot_none,ot_none); + code : #209#220#3#15#56#241#72; + flags : if_sse42 + ), + ( + opcode : A_CRC32; + ops : 2; + optypes : (ot_reg64,ot_rm_gpr or ot_bits8,ot_none,ot_none); + code : #220#214#3#15#56#240#72; + flags : if_sse42 or if_x86_64 + ), + ( + opcode : A_CRC32; + ops : 2; + optypes : (ot_reg64,ot_rm_gpr or ot_bits64,ot_none,ot_none); + code : #220#214#3#15#56#241#72; + flags : if_sse42 or if_x86_64 + ), + ( + opcode : A_PCMPESTRI; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#97#72#22; + flags : if_sse42 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PCMPESTRM; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#96#72#22; + flags : if_sse42 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PCMPISTRI; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#99#72#22; + flags : if_sse42 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PCMPISTRM; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#98#72#22; + flags : if_sse42 or if_sm2 or if_sb or if_ar2 + ), + ( + opcode : A_PCMPGTQ; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#55#72; + flags : if_sse42 or if_sm + ), + ( + opcode : A_POPCNT; + ops : 2; + optypes : (ot_reg16,ot_rm_gpr or ot_bits16,ot_none,ot_none); + code : #219#208#2#15#184#72; + flags : if_386 or if_sm or if_sse4 + ), + ( + opcode : A_POPCNT; + ops : 2; + optypes : (ot_reg32,ot_rm_gpr or ot_bits32,ot_none,ot_none); + code : #219#208#2#15#184#72; + flags : if_386 or if_sm or if_sse4 + ), + ( + opcode : A_POPCNT; + ops : 2; + optypes : (ot_reg64,ot_rm_gpr or ot_bits64,ot_none,ot_none); + code : #219#208#2#15#184#72; + flags : if_386 or if_sm or if_sse4 or if_x86_64 + ), + ( + opcode : A_AESENC; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#220#72; + flags : if_sse4 or if_sm + ), + ( + opcode : A_AESENCLAST; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#221#72; + flags : if_sse4 or if_sm + ), + ( + opcode : A_AESDEC; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#222#72; + flags : if_sse4 or if_sm + ), + ( + opcode : A_AESDECLAST; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#223#72; + flags : if_sse4 or if_sm + ), + ( + opcode : A_AESIMC; + ops : 2; + optypes : (ot_xmmreg,ot_xmmrm,ot_none,ot_none); + code : #241#3#15#56#219#72; + flags : if_sse4 or if_sm + ), + ( + opcode : A_AESKEYGENASSIST; + ops : 3; + optypes : (ot_xmmreg,ot_xmmrm,ot_immediate,ot_none); + code : #241#3#15#58#223#72#22; + flags : if_sse4 or if_sb or if_ar2 + ), + ( + opcode : A_STOSQ; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #214#1#171; + flags : if_x86_64 + ), + ( + opcode : A_LODSQ; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #214#1#173; + flags : if_x86_64 + ), + ( + opcode : A_CMPSQ; + ops : 0; + optypes : (ot_none,ot_none,ot_none,ot_none); + code : #214#1#167; + flags : if_x86_64 + ) +); -- cgit v1.2.1